LBT TITLE 'DMSLBT (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME: 00004000 * 00005000 * DMSLBT (TXTLIB) 00006000 * 00007000 * FUNCTION: 00008000 * 00009000 * TO CREATE A TEXT LIBRARY, TO ADD TEXT FILES TO AN 00010000 * EXISTING TEXT LIBRARY, TO DELETE TEXT FILES FROM AN 00011000 * EXISTING TEXT LIBRARY, TO CREATE A DISK FILE THAT LISTS 00012000 * THE CONTROL SECTION AND ENTRY POINT NAMES IN A TEXT 00013000 * LIBRARY, OR TO TYPE AT THE TERMINAL THE CONTROL SECTION 00014000 * AND ENTRY POINT NAMES IN A TEXT LIBRARY. 00015000 * 00016000 * ATTRIBUTES: 00017000 * 00018000 * DISK RESIDENT, USER AREA ROUTINE 00019000 * 00020000 * ENTRY POINTS: 00021000 * 00022000 * DMSLBT,TXTLIB 00023000 * 00024000 * ENTRY CONDITIONS: 00025000 * 00026000 * GPR = A(R2) 00027000 * DS 0D 00028000 * PLIST DC CL8'TXTLIB' 00029000 * GEN 00030000 * ADD 00031000 * DC CL8' MAP ' 00032000 * DEL 00033000 * DC CL8' ' LIBRARY NAME 00034000 * DC CL8' ' FILENAME/CSECTNAME 00035000 * DC CL8'(', CL8'TERM'|'PRINT' 'DISK' (FOR MAP ONLY) 00036000 * 00037000 * EXIT CONDITIONS: 00038000 * 00039000 * 00040000 * NORMAL - 00041000 * GPR15 = 000: NO ERRORS 00042000 * 00043000 * ERROR - 00044000 * GPR15 = COMPLETION CODES 00045000 * 004: SPECIFIED FILES NOT FOUND OR 00046000 * LIBRARY FILE DELETED/NOT CREATED 00047000 * 024: NO LIBRARY NAMES SPECIFIED, NO TEXT FILE 00048000 * NAMES SPECIFIED, NO FUNCTION SPECIFIED, AN 00049000 * INVALID FUNCTION OR AN INVALID OPTION 00050000 * 032: A SPECIFIED MEMBER TO BE DELETED WAS NOT FOUND, 00051000 * A TEXT FILE CONTAINS INVALID RECORD 00052000 * FORMATS 00053000 * 036: SPECIFIED DISK NOT AVAILABLE FOR THE MAP FILE, 00054000 * SPECIFIED DISK FOR MAP FILE IS R/O 00055000 * 088: CSECT NAMES EXCEEDED THE MAXIMUM 00056000 * 100: I/O ERRORS READING OR WRITING A FILE 00057000 * 00058000 * 00059000 * EXTERNAL REFERENCES: 00060000 * 00061000 * NONE 00062000 * 00063000 * 00064000 * CALLS TO OTHER ROUTINES: 00065000 * 00066000 * NONE 00067000 * 00068000 * 00069000 * TABLES / WORKAREAS: 00070000 * 00071000 * TABLE - THE GENERATED OR EXISTING DICTIONARY TABLE 00072000 * TABLE2 - THE MODIFIED DICTIONARY USED BY DELETE FOR UPDATING 00073000 * OPTBL - BRANCH TABLE FOR LINK EDIT OPERANDS 00074000 * OPTLIST - COMMAND OPTION LIST BRANCH TABLE 00075000 * DELTBL - LIST OF MEMBERS TO BE DELETED 00076000 * EPTBL - TABLE OF ENTRY POINTS IN A TEXT DECK 00077000 * 00078000 * 00079000 * REGISTER USAGE: 00080000 * 00081000 * R5 - FILE ITEM POINTER 00082000 * R7,R9 - DICTIONARY POINTERS 00083000 * R8,R14 - LINKAGE REGISTERS 00084000 * R12,R13 - BASE REGISTERS 00085000 * 00086000 * 00087000 * NOTES: 00088000 * 00089000 * NONE 00090000 * 00091000 * 00092000 * OPERATION: 00093000 * 00094000 * THE OPERATION OF TXTLIB DEPENDS ON WHETHER THE CALLING 00095000 * PROGRAM SPECIFIES GENERATE, ADD, MAP, OR DELETE. 00096000 * 00097000 * GENERATE: 00098000 * TXTLIB CALLS THE ERASE COMMAND PROGRAM TO ERASE THE 00099000 * EXISTING TEXT LIBRARY (IF ANY) WITH THE SAME NAME AS 00100000 * THE ONE TO BE CREATED. NEXT, TXTLIB INITIALIZES THE 00101000 * INDEX AND SAVES IT FOR SUBSEQUENT USE TO CALCULATE THE 00102000 * SIZE OF THE FIRST CONTROL SECTION. THEN TXTLIB CALLS 00103000 * THE STATE FUNCTION PROGRAM TO DETERMINE IF THE FIRST 00104000 * INPUT TEXT FILE SPECIFIED EXISTS. IF IT DOES NOT, 00105000 * TXTLIB SIGNALS AN ERROR BY MEANS OF A TERMINAL MESSAGE 00106000 * AND PROCESSES THE NEXT INPUT TEXT FILE. 00107000 * 00108000 * IF THE TEXT FILE EXISTS, TXTLIB CALLS THE RDBUF 00109000 * FUNCTION PROGRAM TO READ THE FIRST RECORD IN THE FILE 00110000 * AND CHECKS THE FIRST COLUMN FOR A BLANK ( INDICATING 00111000 * THAT IT MAY BE AN OS LINKAGE EDITOR CONTROL CARD) AND 00112000 * IF IT IS NOT, THE RECORD IS PASSED ON TO BE WRITTEN OUT 00113000 * (THIS PROCESS IS FURTHER DESCRIBED LATER). IF THE FIRST 00114000 * COLUMN IS BLANK AND A LINKAGE EDITOR OPERATOR IS DETECTED, 00115000 * CONTROL IS PASSED TO THE APPROPRIATE PROCESSING 00116000 * ROUTINE, OTHERWISE THE CARD WILL BE WRITTEN TO THE TEXT DECK 00117000 * AND PROCESSED IN THE STANDARD FASHION. 00118000 * 00119000 * THE LINKAGE EDITOR OPERATORS THAT ARE PROCESSED CONSIST 00120000 * OF THREE: ENTRY, ALIAS AND NAME. THE FOLLOWING DESCRIBES 00121000 * THE EFFECT OF EACH OPERATOR. 00122000 * 00123000 * ENTRY - THE FIRST VALID ENTRY CARD ENCOUNTERED SETS THE ENTRY 00124000 * POINT NAME FIELD IN THE LDT CARD, WHICH IS TO 00125000 * BE PUT OUT WHEN THE TEXT DECK IS COMPLETED. 00126000 *| ERRONEOUS ENTRY FORMATS OR INVALID ENTRY POINTS P3098 00127000 *| WILL RESULT IN A WARNING MESSAGE TYPED AT THE TERMIP3098 00128000 * ALIAS - ALL VALID ALIAS NAMES ARE STACKED IN A TABLE, (A MAX OF 00129000 * 16, PER LINKAGE EDITOR LIMITS) AS ENCOUNTERED. 00130000 * NAME - THE NAME CARD IS USED AS ONE OF TWO MEANS OF DELIMITING 00131000 * A TEXT DECK(THE OTHER IS DESCRIBED UNDER 'END' CARD 00132000 * PROCESSING). IF THE NAME CARD CONTAINS AN INVALID 'NAME', 00133000 * THE TEXT DECK IS NOT ADDED TO THE LIBRARY, AND THE 00134000 * USER IS INFORMED VIA A CONSOLE MESSAGE. 00135000 * IF THE NAME CARD IS VALID, AN LTD CARD AND A FILE 00136000 * DELIMITER RECORD ARE ADDED TO THE FILE, AND AN ENTRY 00137000 * IS MADE IN THE DICTIONARY FOR THE 'NAME', WITH THE 00138000 * 'C' BYTE ALIAS FLAG INITIALIZED TO X'00', AND THE 00139000 * MEMBER POINTER SET TO THE PROPER ITEM 00140000 * NUMBER. THE ALIAS TABLE IS THEN CHECKED TO SEE IF ANY 00141000 * ALIAS NAMES WERE INCLUDED. IF SO, THE NAMES ARE ENTERED 00142000 * IN THE DICTIONARY, WITH THE SAME MEMBER POINTER AS THE 00143000 * 'NAME' ENTRY, BUT THE 'C' BYTE SET TO X'80' 00144000 * TO INDICATE AN ALIAS. ALL ENTRIES IN THE ENTRY POINT 00145000 * TABLE ARE IGNORED, ALL SWITCHES AND TABLE 00146000 * POINTERS ARE RE-INITIALIZED AND THE RECORD IS 00147000 * READ IN AND PROCESSED. 00148000 *| NOTE: ERRONEOUS NAME AND ALIAS CARD FORMATS WILL CAUP3098 00149000 *| AN ERROR MESSAGE TO BE GENERATED, AND THE P3098 00150000 *| MEMBER WILL NOT BE ADDED TO THE DICTIONARY. P3098 00151000 *| SETSSI - THE SSI INFORMATION (8 CHARACTER MAX) IS MOVED INTP3098 00152000 *| THE LDT CARD FOR RETENTION. IF FORMAT ERRORS ARE P3098 00153000 *| DETECTED, THE CARD IGNORED AND NO MESSAGES ARE P3098 00154000 *| GENERATED. P3098 00155000 * 00156000 * IF THE FIRST COLUMN IS NOT BLANK, OR IS NOT ONE OF THE 00157000 * ABOVE, THE PROGRAM INCREMENTS THE OUTPUT RECORD 00158000 * POINTER AND WRITES OUT THE RECORD. THE FOLLOWING OPERATIONS 00159000 * ARE THEN PERFORMED ACCORDING TO THE RECORD TYPES: 00160000 *| LDT - THE RECORD IS IGNORED (I.E. THE OUTPUT FILE POINTER P3098 00161000 * IS SET TO THE POSITION BEFORE THIS 00162000 * RECORD WAS WRITTEN) SINCE THE PROGRAM WILL PUT OUT 00163000 *| IT'S OWN LDT RECORD. A SWITCH IS TURNED ON TO P3098 00164000 *| INDICATE THE SITUATION, SINCE LDT CARDS CAN BE USED P3098 00165000 *| DELIMIT CMS-TYPE TEXT DECKS. P3098 00166000 * END - A SWITCH IS TURNED ON TO INDICATE THAT AN 'END' 00167000 * CARD HAS BEEN READ. THE PROCESSING OF 00168000 * A NAME CARD OR THE NEXT VALID TEXT DECK CARD, 00169000 * OTHER THAN AN END OR LTD CARD WILL RESET THIS SWITCH. 00170000 * NOTE - AT THIS POINT, A CHECK IS MADE TO DETERMINE 00171000 * IF THE RECORD BEING PROCESSED IS A TEXT DECK 00172000 * RECORD(COL. 1 = X'02'). IF NOT THE PROGRAM RETURNS 00173000 *| TO GET THE NEXT RECORD. OTHERWISE, THE LDT SWITCH IP3098 00174000 * CHECKED, AND, IF ON, IT IS INDICATIVE OF 00175000 * A CMS TYPE TEXT DECK(I.E. ALL ENTRY 00176000 * POINTS ARE TO BE ENTERED IN THE DICTIONARY). THE 00177000 * PROGRAM PUTS ALL TABLED ENTRY POINTS IN THE 00178000 * DICTIONARY, PUTTING IN THE PROPER MEMBER POINTER 00179000 * AND SETTING THE 'C' BYTE TO INDICATE AN ALIAS (X'80'), 00180000 * AFTER THE LTD CARD AND DELIMITER RECORD HAVE 00181000 * BEEN PUT AT THE END OF THE MEMBER. PROCESSING IS 00182000 * THEN RESUMED AFTER THE SWITCHES AND TABLES HAVE BEEN 00183000 * RESET. 00184000 * ESD - IF THE RECORD IS AN ESD RECORD, TXTLIB GETS THE FIRST 00185000 * ESD DATA ITEM IN THE RECORD. IF THIS DATA ITEM IS FOR 00186000 * A SECTION DEFINITION (SD) OR LABEL DEFINITION (LD), 00187000 * TXTLIB PUTS THE ASSOCIATED NAME INTO THE NEXT AVAILABLE 00188000 * ENTRY IN THE ENTRY POINT TABLE, UP TO A MAXIMUM OF 00189000 *| 255 ENTRIES PER MEMBER. IT THEN OBTAINS AND P3098 00190000 * SIMILARLY PROCESSES THE NEXT ESD DATA ITEM IN THE 00191000 * RECORD. IF THE OBTAINED DATA ITEM IS NEITHER FOR A 00192000 * SECTION DEFINITION NOR FOR A LABEL DEFINITION, TXTLIB 00193000 * SKIPS IT AND OBTAINS THE NEXT DATA ITEM. WHEN ALL THE 00194000 * DATA ITEMS IN THE ESD RECORD ARE PROCESSED, TXTLIB 00195000 * READS AND PROCESSES THE NEXT RECORD IN THE INPUT FILE. 00196000 * THIS TABLE IS USED TO VERIFY THE 'ENTRY POINT' 00197000 * SPECIFIED IN THE ENTRY CARD, OR TO FILL IN THE DICTIONARY 00198000 * ENTRIES IF THE CMS TYPE DICTIONARY IS USED. 00199000 * 00200000 * WHEN AN END-OF-FILE ON THE INPUT TEXT FILE IS 00201000 * ENCOUNTERED, TXTLIB CALLS THE FINIS COMMAND PROGRAM TO 00202000 * CLOSE THAT FILE, OBTAINS THE NEXT FILE, AND ADDS ITS 00203000 * CONTENTS TO THE TEXT LIBRARY IN A SIMILAR FASHION. 00204000 * 00205000 * WHEN THE LAST INPUT FILE HAS BEEN PROCESSED, TXTLIB 00206000 * SUCCESSIVELY CALLS THE WRBUF FUNCTION PROGRAM TO WRITE 00207000 * THE DICTIONARY (72 BYTES AT A TIME) AT THE END OF THE 00208000 * TEXT LIBRARY, CONSTRUCTS A DICTIONARY HEADER RECORD, 00209000 * AND WRITES THE HEADER RECORD AT THE BEGINNING OF THE 00210000 * TEXT LIBRARY. (TXTLIB HAS LEFT ROOM AT THE BEGINNING 00211000 * OF THE LIBRARY FOR THE HEADER RECORD.) FINALLY, TXTLIB 00212000 * CALLS THE FINIS COMMAND PROGRAM TO CLOSE THE TEXT 00213000 * LIBRARY AND RETURNS TO THE CALLING PROGRAM. 00214000 * 00215000 * OVERFLOW: THE MAXIMUM NUMBER OF ENTRIES ALLOWED IN THE 00216000 * DICTIONARY IS 1000. EACH TIME AN ENTRY 00217000 * IS MADE, THE TOTAL IS CHECKED. IF THE NUMBER 00218000 * EXCEEDS 1000, THE POINTER TO THE END OF THE FILE IS SET 00219000 * BACK TO THE END OF THE LAST COMPLETE CSECT, THE 00220000 * DICTIONARY IS WRITTEN OUT, AND THE PROGRAM COMPLETES IN 00221000 * THE NORMAL WAY , ISSUING A MESSAGE TO INDICATE 00222000 * WHICH CSECT CAUSED AN OVERLOW. 00223000 * 00224000 * ADD: TXTLIB CALLS THE STATE FUNCTION PROGRAM TO 00225000 * DETERMINE WHETHER THE TEXT LIBRARY TO BE ADDED TO 00226000 * EXISTS. IF IT DOES NOT, TXTLIB TYPES A MESSAGE AT THE 00227000 * TERMINAL TO THAT EFFECT AND RETURNS TO THE CALLING 00228000 * PROGRAM. IF THE LIBRARY EXISTS, TXTLIB CALLS THE RDBUF 00229000 * FUNCTION PROGRAM TO READ THE HEADER RECORD INTO MAIN 00230000 * STORAGE. FROM THE HEADER RECORD, TXTLIB OBTAINS THE 00231000 * LOCATION AND SIZE OF THE DICTIONARY. IT AGAIN CALLS 00232000 * RDBUF TO READ THE ENTIRE DICTIONARY INTO MAIN STORAGE. 00233000 * THEN, TXTLIB SETS THE WRITE POINTER TO THE LOCATION OF 00234000 * THE DICTIONARY IN THE TEXT LIBRARY. THIS IS DONE SO 00235000 * THAT THE DICTIONARY WILL BE WRITTEN OVER WHEN THE NEW 00236000 * TEXT FILES ARE ADDED TO THE LIBRARY. IT THEN ADDS THE 00237000 * NEW TEXT FILES TO THE END OF THE LIBRARY BY BRANCHING TO 00238000 * THE GENERATE ROUTINE 00239000 * 00240000 * MAP: TXTLIB CALLS THE STATE FUNCTION PROGRAM TO 00241000 * DETERMINE WHETHER THE TEXT LIBRARY WHOSE CONTROL 00242000 * SECTION AND ENTRY POINT NAMES ARE TO BE PLACED INTO A 00243000 * DISK FILE EXISTS. IF IT DOES NOT, TXTLIB TYPES A 00244000 * MESSAGE AT THE TERMINAL TO THAT EFFECT AND RETURNS TO 00245000 * THE CALLING PROGRAM. IF THE LIBRARY EXISTS, TXTLIB 00246000 * READS THE HEADER RECORD INTO MAIN STORAGE AND THEN 00247000 * READS THE DICTIONARY INTO MAIN STORAGE. NEXT, IT CALLS 00248000 * THE FINIS COMMAND PROGRAM TO CLOSE THE LIBRARY. TXTLIB 00249000 * THEN CALLS THE ERASE COMMAND PROGRAM TO ERASE THE 00250000 * PREVIOUSLY CREATED DISK FILE (THAT IS, THE MAP FILE), 00251000 * IF ONE EXISTS. NEXT, TXTLIB CALLS THE WRBUF FUNCTION 00252000 * PROGRAM TO WRITE A HEADING INTO THE NEW MAP FILE BEING 00253000 * CREATED. SUBSEQUENTLY, TXTLIB REPEATEDLY CALLS THE 00254000 * WRBUF FUNCTION PROGRAM TO WRITE A RECORD INTO THE NEW 00255000 * MAP FILE FOR EACH ENTRY IN THE DICTIONARY. IF THE 00256000 * DICTIONARY ENTRY REPRESENTS THE ITEM IN A CONTROL SECTION 00257000 * OR A NAME, THE CORRESPONDING RECORD CONSISTS OF THE NAME 00258000 * OF THE CONTROL SECTION AND THE LOCATION OF THE CONTROL 00259000 * SECTION WITHIN THE TEXT LIBRARY IN TERMS OF AN INDEX VALUE. 00260000 * IF THE DICTIONARY ENTRY IS FOR AN ENTRY POINT (THAT IS, A 00261000 * LD OR ALIAS), THE CORRESPONDING RECORD CONSISTS 00262000 * ONLY OF THE ENTRY POINT OR ALIAS NAME. WHEN ALL DICTIONARY 00263000 * ENTRIES ARE PROCESSED, TXTLIB WRITES A RECORD 00264000 * CONTAINING A COUNT OF THE NUMBER OF ENTRIES IN THE 00265000 * DICTIONARY INTO THE MAP FILE. IT THEN CALLS THE FINIS 00266000 * COMMAND PROGRAM TO CLOSE THE MAP AND RETURNS TO THE 00267000 * CALLING PROGRAM. THE ABOVE PROCEDURE IS VALID IF THE 00268000 * OPTION "DISK" HAD BEEN SPECIFIED ALONG WITH "MAP". IF 00269000 * "TERM" IS SPECIFIED, TXTLIB CALLS THE CONWRITE FUNCTION 00270000 * PROGRAM, RATHER THAN WRBUF, TO TYPE THE RECORDS 00271000 * PRODUCED FOR THE ENTRIES IN THE DICTIONARY AT THE 00272000 * TERMINAL. IF "PRINT" IS SPECIFIED, TXTLIB CALLS PRINTIO 00273000 * TO OUTPUT THE DICTIONARY RECORDS TO THE PRINTER. 00274000 * 00275000 * DELETE: TXTLIB TAKES A FILENAME OF FILETYPE TXTLIB AND 00276000 * A LIST OF MEMBER NAMES IN THE TXTLIB FILE TO BE DELETED. 00277000 * TXTLIB SCANS THE DICTIONARY AND COPIES EVERYTHING NOT 00278000 * FOUND IN THE LIST OF MEMBER NAMES TO BE DELETED INTO A 00279000 * NEW DUMMY FILE, TXTLIB CMSUT1. A NEW DICTIONARY IS 00280000 * CREATED FOR THIS NEW TXTLIB FILE. WHEN THE OPERATION 00281000 * IS COMPLETE, THE ORIGINAL TXTLIB FILE IS ERASED AND THE 00282000 * TXTLIB CMSUT1 HAS ITS NAME ALTERED TO THAT OF THE 00283000 * ORIGINAL FILE. IF THE NEW FILE (TXTLIB CMSUT1) IS A @VA13116 00284000 * NULL FILE AS A RESULT OF THE LAST MEMBER HAVING BEEN @VA13116 00284250 * DELETED THEN IT WILL BE ERASED AND A WARNING MESSAGE @VA13116 00284500 * WILL BE ISSUED TO THE USER. @VA13116 00284750 * 00285000 * NOTE: IF A MEMBER NAME OCCURS TWICE WITHIN THE TXTLIB 00286000 * FILE, ONLY THE FIRST OCCURRENCE IS DELETED. A MEMBER 00287000 * NAME MAY BE ENTERED INTO THE ARGUMENT LIST TWO OR MORE 00288000 * TIMES TO DELETE TWO OR MORE MEMBERS WITH THE SAME MEMBER 00289000 * NAME. MEMBERS MUST BE DELETED BY THEIR INITIAL ENTRY IN 00290000 * THE DICTIONARY(I.E. THEIR 'NAME' OR THE FIRST SD NAME) 00291000 * ANY ATTEMPT TO DELETE A SPECIFIC ALIAS 00292000 * OR ENTRY POINT WITHIN A MEMBER WILL RESULT IN A NOT 00293000 * FOUND MESSAGE. THE ENTIRE MEMBER AND ALL IT'S REFERENCES 00294000 * WILL BE DELETED. 00295000 * 00296000 * TABLE/RECORD FORMATS: THE FORMATS OF THE TEXT LIBRARY 00297000 * DICTIONARY AND THE DICTIONARY HEADER RECORD ARE 00298000 * DESCRIBED BELOW. TABLES ARE CONSTRUCTED FOR ENTRY POINTS 00299000 * AND ALIAS NAMES IN EACH TEXT DECK. 00300000 * 00301000 * TEXT LIBRARY DICTIONARY: THIS DICTIONARY HAS ROOM FOR 00302000 * 1000 ENTRIES. EACH ENTRY IS ASSOCIATED WITH EITHER A 00303000 * LINKAGE EDITOR NAME OR ALIAS CONTROL CARD 'NAME', 00304000 * CONTROL SECTION NAME (SECTION DEFINITION ESD ITEM) OR 00305000 * AN ENTRY POINT NAME (LABEL DEFINITION ESD ITEM). AN 00306000 * ENTRY IS 12 BYTES IN LENGTH AND CONTAINS FOUR FIELDS. 00307000 * THE NAME FIELD (8 BYTES) CONTAINS EITHER THE NAME 00308000 * OR ALIAS 'NAME' FROM THE LINKEDIT CONTROL CARD, THE CONTROL 00309000 * SECTION OR ENTRY POINT NAME. THE INDEX FIELD (2 BYTES) 00310000 * CONTAINS THE LOCATION OF THE CORRESPONDING CONTROL 00311000 * SECTION FROM THE START OF THE TEXT LIBRARY. THIS FIELD 00312000 * IS EXPRESSED AS AN ITEM NUMBER. ONE BYTE IS RESERVED, 00313000 * AND THE LAST FIELD, THE 'C' BYTE, IS USED TO INDICATE 00314000 * WHETHER THE ENTRY IS THAT OF A NAME 00315000 * OR AN ALIAS/ENTRY POINT. 00316000 * TEXT LIBRARY DICTIONARY IS ILLUSTRATED IN FIGURE 32. 00317000 * 00318000 * DICTIONARY HEADER RECORD: THE DICTIONARY HEADER RECORD 00319000 * DEFINES THE LOCATION AND SIZE OF THE TEXT LIBRARY 00320000 * DICTIONARY. IT IS AN 80-BYTE RECORD AND CONTAINS THREE 00321000 * MEANINGFUL FIELDS. THE FIRST FIELD (BYTES 01-06) IS A 00322000 * CMS PDS IDENTIFIER, 'DMSLIB'. THE SECOND 00323000 * FIELD(BYTES 07-08) CONTAINS THE POINTER TO THE FIRST 00324000 * RECORD IN THE FILE CONTAINING THE DICTIONARY. THE THIRD FIELD, 00325000 * (BYTES 09-12), CONTAINS THE SIZE OF THE DICTIONARY 00326000 * IN BYTES. THE DICTIONARY HEADER RECORD IS ILLUSTRATED 00327000 * IN FIGURE 33. 00328000 * 00329000 * 00330000 * 1 9-10 11 12 00331000 * <-------------12 BYTES--------------------> 00332000 * 00333000 * ----------------------------------------- 00334000 * | | | | | ' 00335000 * | NAME1 | INDEX1 |RES |CBYT1| ' 00336000 * | | | | | ' 00337000 * ----------------------------------------- ' 00338000 * | | | | | ' 00339000 * | NAME2 | INDEX2 |RES |CBYT2| ' 00340000 * | | | | | ' 00341000 * ----------------------------------------- > MAXIMUM OF 00342000 * | | | | | ' 1000 ENTRIES 00343000 * | | | | | ' 00344000 * | | | | | ' 00345000 * ----------------------------------------- ' 00346000 * | | | | | ' 00347000 * | NAMEN | INDEXN |RES |CBYTN| ' 00348000 * | | | | | ' 00349000 * ----------------------------------------- ' 00350000 * 00351000 * FIGURE 32. TEXT LIBRARY DICTIONARY FORMAT 00352000 * 00353000 * ---------------------------------------- 00354000 * | BYTES | CONTENTS | 00355000 * ---------------------------------------- 00356000 * | | | 00357000 * | 01-06 | FILE I.D. | 00358000 * | | | 00359000 * | 07-08 | POINTER TO START OF | 00360000 * | | DICTIONARY | 00361000 * | | | 00362000 * | 09-12 | SIZE OF DICTIONARY - 12 | 00363000 * | | IN BYTES | 00364000 * | | | 00365000 * | 13-80 | NOT USED | 00366000 * | | | 00367000 * ---------------------------------------- 00368000 * 00369000 * FIGURE 33. TEXT LIBRARY DICTIONARY HEADER RECORD FORMAT 00370000 *. 00371000 DMSLBT CSECT 00372000 ENTRY TXTLIB P3128 00373000 TXTLIB EQU DMSLBT 00374000 USING TXTLIB,R15 TEMP ADDRESSABILITY 00375000 STM R0,R15,SAVEREG SAVE REGISTERS 00376000 B REGSAVED BRANCH AROUND SAVEAREA @VA04699 00377000 SPACE 1 00378000 * SAVE AREA WAS REPLACED HERE TO MAINTAIN COMPATABILITY AND TO ALLOW 00379000 * GREATER EASE IN MODIFICATION OF THE CODE IN THE FIRST 4K OF DMSLBT 00380000 SPACE 1 00381000 SAVEREG DC 16F'0' REGISTER SAVEAREA @VA04699 00382000 SPACE 1 00383000 REGSAVED EQU * @VA04699 00384000 DROP R15 00385000 LR R12,R15 ESTABLISH ADDRESSABILITY 00386000 LA R13,2048(,R12) SET UP SECOND BASE REG 00387000 LA R13,2048(,R13) 00388000 USING TXTLIB,R12,R13 00389000 USING NUCON,R0 00390000 USING DICTDS,R7 SET UP ADDR FOR NEW DICT. DSECT 00391000 SPACE 2 00392000 *************************************************************** 00393000 * 00394000 * CHECK P-LIST FOR BASIC ELEMENTS 00395000 * 00396000 CLI 8(R1),X'FF' CHECK FOR FENCE IN FUNCT. POSIT. 00397000 BE NOFUNCT ERROR..NO FUNCTION SPECIFIED P3128 00398000 CLI 8(R1),C'(' IS IT OPEN PARENS ? P3128 00399000 BNE VERFUNCT IF NOT, VERIFY VALIDITY P3128 00400000 NOFUNCT DMSERR MF=(E,ERLIST),NUM=MSG47ID,LET=E,TEXTA=MSG47 00401000 MVI RETCODE,MSG47RC SET RETURN CODE 00402000 B FINISH WRAP UP THE JOB 00403000 EJECT P3128 00404000 VERFUNCT EQU * 00405000 LA R2,8(,R1) GET THE ADDR OF,FUNCTION 00406000 LA R3,FUNCTABC GET NUMBER OF ELEMENTS IN TABLE 00407000 LA R5,FUNCTAB INITIAL ADDR OF FUNCTION TABLE 00408000 VERLOOP EQU * 00409000 CLC 0(8,R5),0(R2) CHECK ALL CHARS IN FUNCT. 00410000 BE FUNCTOK IF IT MATCHES, OK 00411000 LA R5,8(,R5) BUMP TABLE POINTER 00412000 BCT R3,VERLOOP CHECK ALL THE FUNCTIONS IN TABLE 00413000 * 00414000 MVC MSG14FCT(8),0(R2) SET FUNCTION IN MSG 00415000 DMSERR MF=(E,ERLIST),NUM=MSG14ID,LET=E,TEXTA=MSG14 00416000 MVI RETCODE,MSG14RC SET RETURN CODE 00417000 B FINISH END THE JOB 00418000 FUNCTOK EQU * 00419000 CLI 16(R1),X'FF' CHECK FOR SPECIFIED FILE TXTLIB 00420000 BE ERR46 ERROR..NO LIBRARY NAME SPECIFIED P3128 00421000 CLI 16(R1),C'(' IS IT OPEN PARENS ? P3128 00422000 BNE PROCESS IF NOT, OK FOR NOW P3128 00423000 ERR46 EQU * P3128 00424000 DMSERR MF=(E,ERLIST),NUM=MSG46ID,LET=E,TEXTA=MSG46 00425000 MVI RETCODE,MSG46RC SET RETURN CODE 00426000 B FINISH WRAP UP JOB 00427000 EJECT P3128 00428000 PROCESS EQU * 00429000 LA R0,TABLE COMPUTE THE ADDR OF THE END OF TABLE 00430000 A R0,TBLSZ ADD LENGTH 00431000 ST R0,ATBL2 USE AS ADDRESS OF TABLE2 00432000 MVC TYPLIN(108),SETFREE MOVE VARIABLES TO FREEST 00433000 LD FINIS,FINISET SET REGS FOR SVC'S 00434000 LD STATE,STSET ... 00435000 LD RDBUF,RDSET ... 00436000 LA R5,1 SET TO CONTROL ITEMNO FOR LIBR 00437000 LD FILE,8(,R2) GET NAME OF LIBRARY 00438000 STD FILE,LIBNAM PUT IN P LIST 00439000 ST R2,PPP STORE FOR FUTURE REFERENCE 00440000 CLI 0(R2),C'G' WAS GENLIB CALLED 00441000 BNE LIBMOD NO, MODIFY LIBRARY 00442000 MVC WRLIB(5),ERASET ERASE ANY PREVIOUS LIBRARY 00443000 LA R1,WRLIB ... 00444000 SVC X'CA' ... 00445000 DC AL4(*+4) 00446000 MVC WRLIB(5),WRSET RESET CALL TO WRBUF 00447000 LA R7,TABLE-INDEXL SET TO STORE FIRST ENTRY 00448000 SPACE 2 00449000 GENGO LA R2,8(0,R2) INCREMENT PLIST PTR 00450000 CLI 8(R2),X'FF' CHECK FOR FENCE IN FILE NAME 00451000 BE ERR01 ERROR..NO FILENAME SPECIFIED P3128 00452000 CLI 8(R2),C'(' IS IT OPEN PARENS ? P3128 00453000 BNE FNAMEOK IF NOT, PROCEDE WITH ADD OR GEN P3128 00454000 ERR01 EQU * P3128 00455000 MVC MSG01NME(5),=CL5'FILE' SET UP MSG NAME NOT FOUND 00456000 B SHRTLIST P-LIST IS SHORT, FILE NAME MISSING 00457000 FNAMEOK EQU * 00458000 LA R6,1(0,R5) SET INDEX FOR NO OF PRESENT FL 00459000 MVC LIBADD(4),=AL4(BUFF) ADDRESS OF BUFFER FOR 00460000 SR R14,R14 SET FOR NO ERRORS 00461000 LA R1,ALIASTBL-8 INIT. TBLS. TO PREV. POSIT. 00462000 ST R1,LASTSAVE STORE IN ALIAS ITEM PTR. 00463000 LA R1,EPTBL-8 LOAD INIT. OF ENTRY POINT TABLE 00464000 ST R1,EPEND STORE IN ALIAS TABLE PTR. 00465000 MVI SWS,X'00' SET ALL SWITCHES TO ZERO @VA04662 00466000 MVC LDTNAME(8),LDTNAME-1 INITIALIZE LDT NAME TO BLANKS 00467000 MVC FIRSTSD(8),LDTNAME RE-INIT SD ENTRY 00468000 MVC LDTSSI(8),LDTSSI-1 SET SSI FIELD TO BLANKS P3098 00469000 EJECT 00470000 FILCHK LA R2,8(0,R2) INCREMENT PLIST PTR 00471000 CLI 0(R2),X'FF' END OF PLIST? 00472000 BE WRDICT YES, WRITE DICTIONARY 00473000 CLI 0(R2),C'(' END OF PLIST? P3128 00474000 BE WRDICT YES, WRITE DICTIONARY P3128 00475000 STM R6,R7,SAVE SAVE IN CASE OF OVERFLOW 00476000 LD FILE,0(,R2) GET INPUT FILE NAME 00477000 STD FILE,RNAME SET NAME FOR READIN 00478000 MVC RMODE(2),SETMODE RESET MODE TO ' ' 00479000 STD STATE,RDISK SEE IF FILE EXISTS 00480000 LA R1,RDISK 00481000 SVC X'CA' ... 00482000 DC AL4(NOFILE) ... 00483000 TM FLAGS,SPACE SPACE CHECK DONE? @VA04662 00484000 BO CKDONE YES, DON'T DO AGAIN @VA04662 00485000 BAL R10,XSAVE NO, GO CHECK @VA03771 00486000 CKDONE L R10,FSTLOC GET LOCATION OF FILE STAT TAB @VA03771 00487000 LH R4,26(R10) GET RECORD THIS FILE @VA03771 00488000 N R4,MAXHW CLEAN TOP @VA04662 00489000 L R9,TOTAL GET TOTAL RECORDS LEFT @VA03771 00490000 CR R9,R4 ENOUGH ROOM FOR THIS FILE? @VA03771 00491000 BNH WRERRA NO, THEN ERROR @VA03771 00492000 SR R9,R4 SUBTRACT THIS FILE FROM TOTAL @VA03771 00493000 ST R9,TOTAL RESET TOTAL @VA03771 00494000 OI FLAGS,STFD SET FLAG FOR NONERROR FROM STATE @VA04662 00495000 MVC RMODE(2),FMODE(R10) SET MODE OF FILE 00496000 CLC FSIZE(4,R10),RSIZE CHECK LENGTH OF FILE 00497000 BNE BADSIZE WRONG RECORD SIZE 00498000 CLI FFORM(R10),C'F' IS IT FIXED FORMAT 00499000 BNE BADSIZE SAME DIFFERENCE, REJECT IT 00500000 MVC RADD(4),=AL4(BUFF) RESET BUFFER ADDR 00501000 STD RDBUF,RDISK RESET SVC NAME 00502000 CLM R5,M1,HFF IS THIS 'FF' BOUNDARY? @VA04072 00503000 BNE RDCRD BRANCH IF NOT @VA04072 00504000 LA R5,M1(,R5) DO NOT ALLOW 'FF' BOUNDARY @VA04072 00505000 LA R6,M1(,R6) ALSO FOR DICTIONARY @VA04072 00506000 SPACE 2 00507000 RDCRD EQU * 00508000 LA R1,RDISK 00509000 SVC X'CA' ... 00510000 DC AL4(EOFCHK) ... 00511000 CLI BUFF,C' ' CHECK FOR BLANK IN COL. 1 00512000 BNE WRCRD IF NOT, IT IS NOT A LKED. CTL. CRD. 00513000 LA R1,BUFF+1 LOAD ADDR. OF FIRST CHAR. TO SCAN 00514000 BAL R14,SCANOP LINK TO SCAN ROUTINE FOR FIRST PARM 00515000 LTR R15,R15 CHECK IF VALID OPERAND FOUND 00516000 BNZ WRCRD IF NOT, PUT IT IN DECK 00517000 LA R1,OPTBL SET BASE OF OPERAND DSECT 00518000 LA R3,OPTBLQTY LOAD NO. OF OPERANDS IN TABLE 00519000 USING OPTBLDS,R1 EST. ADDRESSABILITY FOR OPERAND DSECT 00520000 OPTSRCH EQU * 00521000 CLC OPERAND(8),OPNAME COMP. OPER. IN CARD TO TABLE 00522000 BE OPRTNAD IF EQUAL, GO TO APPROP. ROUTINE 00523000 LA R1,12(,R1) BUMP DSECT BASE TO NEXT TABLE ENTRY 00524000 BCT R3,OPTSRCH LOOP THROUGH TABLE 00525000 B WRCRD IF NOT FOUND, WRITE CARD TO TEXT FILE 00526000 XSAVE L R15,AADTLKW ADDRESS OF LOOKUP @VA03771 00527000 LR R9,R14 PRESERVE R14 @VA03771 00528000 LA R1,XLIST LOAD ADDR PLIST FOR LOOKUP @VA03771 00529000 BALR R14,R15 @VA03771 00530000 LR R14,R9 RESTORE R14 @VA03771 00531000 LTR R15,R15 ERROR FROM LOOKUP? @VA03771 00532000 BNZ WRERRA YES, ERROR @VA03771 00533000 SH R0,=H'3' SAVE SOME FOR INDEX/HDR @VA03771 00534000 BM WRERRA NO, THEN SAY SO @VA03771 00535000 LR R4,R0 GET DISK SPACE FROMLOOKUP @VA03771 00536000 MH R4,=H'10' CONVERT TO RECORDS/BLOCK @VA03771 00537000 ST R4,TOTAL SAVE IN TOTAL FIELD @VA03771 00538000 OI FLAGS,SPACE SET SPACE CHECK BIT @VA04662 00539000 BR R10 @VA03771 00540000 EJECT P3128 00541000 NAME EQU * 00542000 TM SWS,FLUSH CHECK IF ERRORS DETECTED IN DECK @VA04662 00543000 BO NAMENG IF SO, SEND MSG AND DROP DECK @VA04662 00544000 TM SWS,END+INCL END OR INCLUDE CARD READ? @VA04662 00545000 BZ NAMEIGN NO, WARN USER AND IGNORE CARD @VA04662 00546000 L R1,OPEND LOAD ADDR OF DELIMITER AFTER 'NAME' 00547000 LA R1,1(,R1) BUMP TO NEXT POSITION FOR SCAN 00548000 BAL R14,SCANOP GET NEXT OPERADN 00549000 B *+4(R15) BRANCH ON R.C. 00550000 B NAMEOK R.C.=0, O.K. 00551000 B NAMENG1 R.C.=4, COMMA DELIMITER, NO GOOD 00552000 B NAMEOK R.C.=8, LONG OPERAND, COULD BE O.K. 00553000 B NAMENG1 R.C.=12, NOT FOUND 00554000 NAMEOK EQU * 00555000 NI SWS,X'FF'-(END+INCL) RESET END & INCL SWITCHES @VA04662 00556000 LA R1,OPERAND SET FOR REPLACE '(R)' CHECK 00557000 LR R3,R0 GET LENGTH OF OPERAND 00558000 REPCHK EQU * 00559000 CLC 0(3,R1),=C'(R)' CHECK FOR REPLACE OPTION 00560000 BE GOTREP 00561000 LA R1,1(,R1) BUMP POINTER BY ONE 00562000 BCT R3,REPCHK LOOP THRU OPENAND 00563000 LTR R15,R15 CHECK IF A LONG NAME WAS PASSED BACK 00564000 BNZ NAMENG1 IF SO, AND NO '(R)' FND., IT NO GOOD 00565000 B OPERSET OPERAND IS READY 00566000 GOTREP EQU * 00567000 SR R0,R3 LOCATION OFFSET 00568000 LA R3,MAXSIZ GET MAXIMUM LENGTH ALLOWED 00569000 SR R3,R0 CALCULATE NO. OF CHAR. TO BLANK 00570000 EX R3,BLKREP BLANK OUT '(R)' PLUS ANYTHING ELSE FOL. 00571000 EJECT P3128 00572000 OPERSET EQU * 00573000 * PUT OUT LDT CARD 00574000 LA R5,1(,R5) BUMP TO NEXT RCD. POINTER 00575000 STH R5,LIBITEM SET POINTER IN P-LIST 00576000 LA R1,LDTAREA GET ADDR OF LDT WORK AREA 00577000 ST R1,LIBADD SET I/O AREA IN P-LIST 00578000 LA R1,WRLIB GET ADDR OF WRITE P-LIST 00579000 SVC 202 WRITE RECORD TO LIBRARY 00580000 DC AL4(WRERR) 00581000 LA R1,EOFMARK GET ADDR OF EOF INDICATOR 00582000 ST R1,LIBADD SET WRITE ADDR PTR TO EOF INDIC. 00583000 LA R5,1(,R5) BUMP ITEM POINTER 00584000 STH R5,LIBITEM SET POINTER TO NEXT RCD. 00585000 LA R1,WRLIB GET ADDR OF WRITE P-LIST 00586000 SVC 202 WRITE RECORD 00587000 DC AL4(WRERR) 00588000 LA R1,BUFF GET NORMAL I/O AREA 00589000 ST R1,LIBADD RESTORE P-LIST 00590000 LA R7,INDEXL(,R7) BUMP POINTER TO DICT. 00591000 C R7,ATBL2 CHECK IF TABLE FULL 00592000 BNL OVRFLO IF SO FORGET THIS ENTRY AND QUIT 00593000 MVC INDXNAME,OPERAND MOVE NAME TO DICT 00594000 XC INDXSPAR(3),INDXSPAR ZAP THE LOW ORD. POSITS. 00595000 STH R6,INDXADDR PUT POINTER TO MEMBER IN DICT 00596000 L R3,LASTSAVE LOAD ADDR OF LAST ENTRY IN ALIAS TBL. 00597000 LA R1,ALIASTBL-8 LOAD ADDR OF INITIAL ALIAS PTR 00598000 SR R3,R1 FIND DIFFERENCE 00599000 BNP ALIASCMP IF ZERO, NONE STACKED FOR THIS DECK 00600000 LA R1,8(R1) POSITION TO FIRST ENTRY 00601000 SRA R3,3 DIVIDE BY 8 TO GET NO. OF ENTRIES 00602000 ALIASDIC EQU * 00603000 LA R7,INDEXL(,R7) BUMP THE POINTER TO THE DICT. 00604000 C R7,ATBL2 CHECK IF OFF DEEP END 00605000 BNL OVRFLO IF SO RESTORE THE DICT. AND QUIT 00606000 MVC INDXNAME,0(R1) MOVE ALIAS NAME INTO DICTIONARY 00607000 STH R6,INDXADDR STORE INDEX INTO DICTIONARY PREV. SET-UP 00608000 MVI INDXCBYT,ALIASID IDENTIFY ITEM AS ALIAS 00609000 MVI INDXSPAR,X'00' ZAP SPARE POSIT 00610000 LA R1,8(,R1) BUMP TO NEXT ITEM IN ALIAS TABLE 00611000 BCT R3,ALIASDIC SET UP EACH ALIAS 00612000 EJECT P3128 00613000 ALIASCMP EQU * 00614000 LA R6,1(,R5) SET FWD. PTR. TO NEXT ITEM TO BE WRITTEN 00615000 RESET EQU * 00616000 STM R6,R7,SAVE UPDATE ITEM AND DICT. PTR SAVE AREA 00617000 LA R1,ALIASTBL-8 GET ADDR OF ALIAS TABLE 00618000 ST R1,LASTSAVE RE-INITIALIZE ALIAS TABLE POINTER 00619000 LA R1,EPTBL-8 RESET E.P. TABLE TO IND. NO ENTRIES 00620000 ST R1,EPEND BY SETTING END = BEGINNING 00621000 MVC LDTNAME(8),LDTNAME-1 INITIALIZE LDT NAME TO BLANKS 00622000 MVC FIRSTSD(8),LDTNAME REINIT SD ENTRY 00623000 MVC LDTSSI(8),LDTSSI-1 SET SSI FIELD TO BLANKS P3098 00624000 NI SWS,X'FF'-(FLUSH+ENTR+LDT) RESET VAR SWITCHES @VA04662 00625000 TM SWS,EOD CHECK IF EOF SENT CTL HERE @VA04662 00626000 BZ CHREAD IF NOT EOF, CHECK END W/ NOTHING @VA04662 00627000 NI SWS,X'FF'-(END+INCL+EOD) RESET SWITCHES @VA04662 00628000 BAL R8,CLOSEIN CLOSE INPUT FILE 00629000 B FILCHK LOOK FOR ANOTHER FILE 00630000 CHREAD EQU * 00631000 TM SWS,END HAS END CARD BEEN READ? @VA04662 00632000 BZ NAMERET IF NAME CARD READ, SW=0 @VA04662 00633000 NI SWS,X'FF'-END ELSE CTL MUST RETURN TO WRITE RCD@VA04662 00634000 B WRCRD SINCE NAME ROUTINE FAKED 00635000 NAMENG1 EQU * 00636000 MVC MSG56RTP(5),NAMEOP SET RCD. TYPE IN MSG 00637000 NAMENG EQU * 00638000 LR R5,R6 IF AN ERROR DETECTED IN TEXT OR NAME CARD 00639000 BCTR R5,0 RESET LIB. PTR. TO PREVIOUS LOCATION 00640000 MVC MSG56NME(8),0(R2) MOVE IN NAME @VA03139 00641000 DMSERR MF=(E,ERLIST),NUM=MSG56ID,LET=E,TEXTA=MSG56 00642000 MVI RETCODE,MSG56RC SET RETURN CODE 00643000 B RESET RESET FOR NEXT TEXT DECK 00644000 EJECT P3128 00645000 NAMEIGN MVC MSG56RTP(5),NAMEOP SET RCD. TYPE IN MSG @VMT3234 00646000 IGNRCD MVC MSG56NME(8),0(R2) MOVE IN NAME @VA03139 00647000 DMSERR MF=(E,ERLIST),NUM=MSG56ID,LET=W,TEXTA=MSG56 @VMT3234 00648000 MVI RETCODE,MSG56RCW SET RETURN CODE @VMT3234 00649000 EJECT @VMT3234 00650000 NAMERET EQU * 00651000 B RDCRD BRANCH TO GET NEXT RECORD 00652000 BLKREP MVC 0(1,R1),BLANKS EXEC. TO GET RID OF REP. OPTION 00653000 * 00654000 ENTRY EQU * ENTRY CARD PROCESSING ROUTINE 00655000 TM SWS,ENTR CHECK IF ENTRY CARD PROCESSED @VA04662 00656000 BO ENTRYCMP IF SO, IGNORE SUBSEQUENT ONES @VA04662 00657000 L R1,OPEND LOAD THE ADDR. OF DELIMITER IN CARD 00658000 LA R1,1(,R1) BUMP TO FIRST POSIT. FOR SCAN 00659000 BAL R14,SCANOP GO TO SCAN FOR ENTRY NAME 00660000 LTR R15,R15 CHECK RET. CODE 00661000 BNZ EPNG IF NOT PROPER E.P. NAME, IT'S NO GOOD 00662000 LA R1,EPTBL GET ADDR OF ENTRY POINT TABLE 00663000 L R3,EPEND GET THE ADDR OF THE LAST E.P. ENTRY 00664000 SR R3,R1 FIND DIFFERENCE 00665000 LA R3,8(,R3) BUMP ONE INDEX FOR ZERO OFFSET 00666000 LTR R3,R3 CHECK IF ANY ENTRIES 00667000 BNP EPNG IF NO ENTRIES, ENTRY CARD INVALID 00668000 SRA R3,3 DIVIDE DIFF. BY 8 FOR NO. OF ENTRIES 00669000 SCANEP EQU * 00670000 CLC 0(8,R1),OPERAND COMPARE TABLE ENTRY TO FOUND OPERAND 00671000 BE EPOK ENTRY NAME MUST MATCH VALID E.P. 00672000 LA R1,8(R1) BUMP TO NEXT POSITION P3098 00673000 BCT R3,SCANEP LOOP THRU E.P. TABLE 00674000 EPNG EQU * 00675000 CLC OPERAND(8),FIRSTSD CHECK FOR FIRST SD, IT IS NOT P0929 00676000 BE EPOK IN TABLE OF ENTRY POINTS P0929 00677000 MVC MSG56RTP(5),ENTRYOP SET TYPE OF ERROR P3098 00678000 B IGNRCD ISSUE MSG AND IGNORE THIS RECORD @VA04662 00679000 EPOK EQU * 00680000 MVC LDTNAME,OPERAND MOVE OPERAND + BLKS. TO LDT CARD 00681000 OI SWS,ENTR SET ENTRY CARD SWITCH @VA04662 00682000 ENTRYCMP EQU * 00683000 B RDCRD GO TO GET NEXT CARD, DO NOT WRITE 00684000 INCLUDE EQU * @VMT8660 00685000 OI SWS,INCL SET INCLUDE SWITCH @VA04662 00686000 B WRCRD GO WRITE IT @VMT8660 00687000 EJECT P3128 00688000 ALIASRT EQU * 00689000 ALIASTST L R1,OPEND POINT TO POSS ALIAS NAME @VMT3234 00690000 LA R1,1(,R1) BUMP TO THE NEXT POSIT FOR SCAN 00691000 BAL R14,SCANOP SCAN THE CARD FOR OPERAND 00692000 B *+4(R15) BRANCH ON R.C. 00693000 B ALIASFND R.C. 0, BLANK DELIMITER 00694000 B ALIASFND R.C. 4, COMMA DELIMITER 00695000 B ALIASRET R.C. 8, LONG OPERAND IS NO GOOD 00696000 B ALIASRET R.C. 12, NOT FOUND 00697000 ALIASFND EQU * 00698000 L R3,LASTSAVE LOAD ADDR OF LAST ALIAS ENTRY 00699000 LA R3,8(,R3) BUMP TO NEXT POSIT 00700000 C R3,ALIASMAX CHECK IF TOO MANY 00701000 BH ALIASRET IF SO IGNORE 00702000 ST R3,LASTSAVE SAVE LAST ENTRY ADDR 00703000 MVC 0(8,R3),OPERAND SET THE OPERAND 00704000 LTR R15,R15 CHECK IF END OF STRING(BLANK DELIM.) 00705000 BZ RDCRD IF SO GET NEXT RECORD 00706000 B ALIASRT LOOP THRU CARD FOR ALIAS'. LOOP 00707000 * WILL BE TERM. BY R.C. FROM SCAN 00708000 * 00709000 ALIASRET EQU * 00710000 OI SWS,FLUSH SET SW TO FLUSH THIS TEXT DECK @VA04662 00711000 MVC MSG56RTP(5),ALIASOP SET MSG RCD TYPE TO ALIAS 00712000 B RDCRD GET NEXT CARD, DO NOT WRITE 00713000 SETSSI EQU * P3098 00714000 L R1,OPEND GET ADDR OF LAST CHAR IN OPERAND P3098 00715000 LA R1,1(,R1) BUMP TO NEXT CHAR. P3098 00716000 BAL R14,SCANOP GET THE SSI INFO. P3098 00717000 LTR R15,R15 IS THERE ANY VALID DATA P3098 00718000 BNZ RDCRD ANY ERRORS AT ALL, IGNORE P3098 00719000 MVC LDTSSI,OPERAND MOVE THE DATA INTO THE LDT CARD P3098 00720000 B RDCRD GET NEXT RECORD P3098 00721000 EJECT 00722000 SCANOP EQU * 00723000 LA R3,BUFFEND LOAD THE ADDR. OF LAST POSIT IN CARD 00724000 SR R3,R1 R1 CONTAINS 1ST CHAR., GET DIFFERENCE 00725000 BNP OPNFND IF NOT, SET R.C. AND RETURN 00726000 LA R15,0 INITIALIZE R.C. TO FOUND 00727000 SCAN EQU * 00728000 CLI 0(R1),C' ' CHECK FOR BLANK 00729000 BNE OPFND IF NON-BLANK, IT'S BEGINING OF FIELD 00730000 LA R1,1(,R1) BUMP TO NEXT POSIT. IN CARD 00731000 BCT R3,SCAN LOOP THROUGH CARD FOR FIELD 00732000 * NO FIELD FOUND 00733000 B OPNFND NP MORE OPERANDS FOUND IN CARD 00734000 OPFND EQU * 00735000 ST R1,OPBEGIN SAVE STARTING LOCATION OF OPERAND 00736000 LA R1,1(,R1) BUMP POINTER TO NEXT LOC. 00737000 BCTR R3,0 DECREMENT CARD COUNT TOO 00738000 SCANBLNK EQU * 00739000 CLI 0(R1),C' ' CHECK FOR NEXT BLANK CHAR. 00740000 BE ENDOP IF FOUND, IT IS END OF FIELD 00741000 CLI 0(R1),C',' CHECK FOR COMMA 00742000 BE DELFND IT IS A VALID DELIM., BUT DIF. R.C. 00743000 LA R1,1(,R1) BUMP TO NEXT CHARACTER 00744000 BCT R3,SCANBLNK LOOP THROUGH CARD 00745000 * NO BREAK FOUND FOR REMAINING OPERAND 00746000 B OPNFND TREAT IT AS THOUGH IT WAS NOT FOUND 00747000 DELFND EQU * 00748000 LA R15,4 SET R.C. TO INDICATE A COMMA DELIMITER 00749000 ENDOP EQU * 00750000 ST R1,OPEND SAVE ENDING POSIT. OF OPERAND 00751000 L R3,OPBEGIN GET BEGINING OF ITEM 00752000 SR R1,R3 GET THE LENGTH OF OPERAND 00753000 CH R1,MAXLEN COMP. TO MAXIMUM ALLOWABLE LENGTH 00754000 BH OPNFND IF OPERAND TOO LARGE, IT'S N.G. 00755000 MVC OPERAND(MAXSIZ),OPERINIT INITIALIZE OPERAND FIELD 00756000 BCTR R1,R0 REDUCE COUNT FOR EXECUTE 00757000 EX R1,MOVOPER MOVE OPERAND FOUND TO SET FIELD 00758000 CLI OPERAND+8,C' ' CHECK FOR G.T. EIGHT CHARACTERS P0929 00759000 BE RCODESET IF EIGHT OR LESS, RCODE OK P0929 00760000 LA R15,8 ELSE SET COND CODE FOR LONG OPERAND P0929 00761000 RCODESET EQU * P0929 00762000 LA R0,1(,R1) SET R0 EQ TO ORIG. LENGTH 00763000 LR R1,R3 CONVENTIONS OF R0= LENG., R1= ADDR. 00764000 BR R14 RETURN TO CALLER 00765000 OPNFND LA R15,12 SET CONDITION CODE TO NOT FOUND 00766000 BR R14 RETURN TO CALLER 00767000 MOVOPER MVC OPERAND(1),0(R3) EXECUTED TO MOVE OPERAND FOUND 00768000 EJECT 00769000 WRCRD EQU * 00770000 LA R5,1(0,R5) INCREMENT ITEM NUMBER AND 00771000 STH R5,LIBITEM STORE IN LIB P LIST 00772000 LA R1,WRLIB WRITE CARD ON LIBRARY 00773000 SVC X'CA' ... 00774000 DC AL4(WRERR) ... 00775000 L R1,BUFF GET CARD TYPE 00776000 CL R1,XLDT "LDT" CONTROL CARD? 00777000 BE PLDT YES. 00778000 CL R1,XEND IS IT AN END CARD 00779000 BE PEND IF SO GO PROCESS END CARD 00780000 CLI BUFF,X'02' IS CARD A A VALID TEXT CARD 00781000 BNE RDCRD IF NOT GET NEXT CARD 00782000 TM SWS,LDT HAS AN LDT CARD BEEN READ? @VA04662 00783000 BO EPDICT IF SO, IT'S A CMS-TYPE DECK @VA04662 00784000 CL R1,XESD IS IT AN ESD CARD P3098 00785000 BE PESD IF SO, PROCESS IT P3098 00786000 B RDCRD ELSE GET NEXT RECORD P3098 00787000 EJECT P3128 00788000 EPDICT EQU * 00789000 * 00790000 * IF AN END CARD HAS BEEN READ, AND A TEXT CARD OTHER THAN A 00791000 * LDT OR END CARD IS READ, ALL ENTRY POINTS ARE 00792000 * PUT INTO THE DICTIONARY, PER THE CMS MODE. 00793000 * THE EXCEPTION BEING IF ALIAS CARDS(I.E. 00794000 * OS TYPE TEXT DECK) HAVE BEEN INCLUDED. THEN THE DECK IS 00795000 * REJECTED. 00796000 * 00797000 ********************************************************************** 00798000 L R3,LASTSAVE GET PTR SAVE FOR ALIAS TABLE 00799000 LA R1,ALIASTBL-8 GET INITIAL LOCATION OF PTR 00800000 SR R3,R1 CHECK IF THERE ARE ANY ENTRIES 00801000 BNP GOODTYPE HAVE A NAME CARD FOR A TERMINATOR 00802000 OI SWS,FLUSH SET SWITCH TO FLUSH IT @VA04662 00803000 MVC MSG56RTP(5),=CL5'NAME' SET 'NAME' AS INVALID CARD 00804000 B NAMENG GO TO PRINT MSG AND RESET 00805000 GOODTYPE EQU * 00806000 STH R5,LIBITEM SET WRITE POINTER IN P-LIST 00807000 LA R1,LDTAREA GET ADDR OF LDT WORK AREA 00808000 ST R1,LIBADD SET I/O AREA IN P-LIST 00809000 LA R1,WRLIB GET ADDR OF WRITE P-LIST 00810000 SVC 202 WRITE OVER CURRENT RCD, IT IS REWRITTEN 00811000 DC AL4(WRERR) 00812000 LA R1,EOFMARK GET ADDR OF EOF INDICATOR 00813000 ST R1,LIBADD SET WRITE ADDR PTR TO EOF INDIC. 00814000 LA R5,1(,R5) BUMP ITEM POINTER 00815000 STH R5,LIBITEM SET POINTER TO NEXT RCD. 00816000 LA R1,WRLIB GET ADDR OF WRITE P-LIST 00817000 SVC 202 WRITE RECORD 00818000 DC AL4(WRERR) 00819000 LA R1,BUFF RESET THE WRITE ADDR 00820000 ST R1,LIBADD IN WRBUFF P-LIST 00821000 L R3,EPEND GET ENTRY POINT TABLE PTR 00822000 LA R1,EPTBL-8 GET INITIAL TABLE PTR 00823000 SR R3,R1 FIND DIFFERENCE 00824000 SRA R3,3 DIVIDE BY 8 FOR COUNT OF ENTRIES 00825000 CLI FIRSTSD,C' ' CHECK IF ANY ENTRIES 00826000 BNE GOTEPS IF SD IN DECK, IT'S GOOD 00827000 OI SWS,FLUSH FOR RECORD, SET TO FLUSH DECK @VA04662 00828000 MVC MSG56RTP(5),=CL5'ESD' SET RECORD TYPE 00829000 B NAMENG GO TO MSG/RESET RTNE. 00830000 EJECT P3128 00831000 GOTEPS EQU * 00832000 TM SWS,FLUSH CHECK IF ERRORS PREV ENCOUNTERED @VA04662 00833000 BO NAMENG IF SO, SEND MSG AND RESET @VA04662 00834000 LA R7,INDEXL(,R7) BUMP TO NEXT SLOT IN DICT. 00835000 C R7,ATBL2 CHECK IF MORE THAN MAX ALLOWABLE 00836000 BNL OVRFLO IF SO, SCRAP THIS DECK AND SALVAGE 00837000 MVC INDXNAME(8),FIRSTSD START DICT. OFF WITH FIRST SD 00838000 STH R6,INDXADDR SET STARTING ITEM OF MEMBER 00839000 MVI INDXCBYT,ALIASID FLAG AS ALIAS 00840000 MVI INDXSPAR,X'00' ZAP SPARE BYTE 00841000 LTR R3,R3 CHECK IF ANY OTHER ENTRIES 00842000 BNP OLDEND IF NOT, DECK IS FINISHED 00843000 LA R1,8(,R1) SET PTR TO BEGINNING OF TABLE 00844000 OLDLOOP EQU * 00845000 LA R7,INDEXL(,R7) BUMP DICT. INDEX TO NEXT POSIT. 00846000 C R7,ATBL2 CHECK IF MORE THAN MAX ALLOWABLE 00847000 BNL OVRFLO IF SO, SCRAP THIS DECK AND SALVAGE 00848000 MVC INDXNAME,0(R1) MOVE NAME INTO DICTIONARY 00849000 STH R6,INDXADDR STORE FIRST ITEM OF MEMBER IN DICT. 00850000 MVI INDXCBYT,ALIASID FLAG ESD ENTRIES AS ALIAS'S 00851000 MVI INDXSPAR,X'00' ZAP THE SPARE POSIT 00852000 LA R1,8(,R1) BUMP TO NEXT ENTRY POINT 00853000 BCT R3,OLDLOOP PUT ALL ENTRY POINTS IN TABLE 00854000 OLDEND EQU * 00855000 LA R6,1(,R5) SET FWD. PTR. TO NEXT ITEM TO BE WRITTEN 00856000 B RESET WHEN FINISHED, RESET FOR NEXT 00857000 SPACE 2 00858000 EOFCHK LA R1,12 SEE IF ERROR IS END OF FILE 00859000 CR 15,1 IS IT? 00860000 BNE RDERR NO, GO TYPE ERROR MESSAGE 00861000 TM SWS,END CHECK IF LAST FILE COMPLETED @VA04662 00862000 BZ CLOSNGO IF END CARD PROCESSED, IT'S OK @VA04662 00863000 OI SWS,EOD INDICATE SITUATION @VA04662 00864000 LA R5,1(,R5) BUMP ITEM POINTER FOR LDT 00865000 B EPDICT IF END CARD READ, TREAT AS CMS TEXT LIB 00866000 CLOSNGO EQU * 00867000 CLI FIRSTSD,C' ' CHECK IF A DECK HAS BEEN STARTED P3098 00868000 BE NODECK IF NO SD, THEN NOTHING VALID P3098 00869000 MVC MSG56RTP(5),=CL5'END' OTHERWISE, A PARTIAL DECK P3098 00870000 OI SWS,EOD SET FOR RESET TO HANDLE SITUATION@VA04662 00871000 B NAMENG PUT OUT ERROR MESSAGE P3098 00872000 NODECK EQU * P3098 00873000 BAL R8,CLOSEIN EOF, CLOSE INPUT FILE 00874000 B FILCHK LOOK FOR ANOTHER FILE 00875000 EJECT 00876000 PLDT EQU * 00877000 OI SWS,LDT INDICATE LDT CARD IN INPUT STREAM@VA04662 00878000 BCTR R5,0 FORGET THAT IT WAS WRITTEN P3098 00879000 B RDCRD READ NEXT CARD 00880000 SPACE 2 00881000 PEND EQU * 00882000 OI SWS,END SET END CARD READ @VA04662 00883000 B RDCRD FOR NOW JUST SET SW AND RET 00884000 SPACE 2 00885000 PESD LA R9,BUFF+16 GET NAME OF ENTRY 00886000 LA R10,16 SETUP BXLE FOR CARD 00887000 LA R11,BUFF ... 00888000 AH R11,BUFF+10 ADD NUM OF BYTES ON CARD 00889000 TSTESD TM 8(R9),X'0E' IS IT ESD 0 OR 1 00890000 BNZ NXTESD NO, LOOK AT NEXT 00891000 L R3,EPEND LOAD ADDR OF LAST TABLE ITEM 00892000 LA R3,8(,R3) BUMP TO NEXT TABLE ELEMENT 00893000 LA R1,EPTBLEND LOAD ADDR OF EP TABLE 00894000 CR R3,R1 CHECK IF OUT OF SPACE 00895000 BNH ESDOK IF MORE, INSERT IT 00896000 OI SWS,FLUSH SET TO FLUSH DECK @VA04662 00897000 MVC MSG56RTP(5),=CL5'ESD' ASSEM LIMIT OF 255 EP'S, DECK 00898000 B RDCRD IS BAD. READ THROUGH THE DECK 00899000 ESDOK EQU * 00900000 ST R3,EPEND UPDATE TABLE POINTER 00901000 MVC 0(8,R3),0(R9) MOVE NAME INTO TABLE 00902000 TM 8(R9),SDFLAG CHECK IF SD ENTRY 00903000 BNZ NXTESD IF NOT GO ON TO NEXT ENTRY 00904000 CLI FIRSTSD,C' ' CHECK IF PREVIOUS SD ENCOUNTERED 00905000 BNE NXTESD IF ALREADY INIT.,GO ON TO NEXT 00906000 MVC FIRSTSD(8),0(R9) ELSE INIT. WITH FIRST SD ENTRY 00907000 S R3,=F'8' BACK OFF LAST ENTRY TABLE ITEM 00908000 ST R3,EPEND AND UPDATE PTR TO IGNORE FIRST SD 00909000 NXTESD BXLE R9,R10,TSTESD BACK FOR ANOTHER, OR... 00910000 B RDCRD DONE, GET ANOTHER CARD 00911000 EJECT 00912000 WRDICT EQU * @VA04662 00913000 TM FLAGS,STFD IS TXTLIB NULL? @VA04662 00914000 BO DICTOK IF EXISTENT, WRITE OUT DICT @VA04662 00915000 L R3,SAVEREG+4 GET ADDR OF P-LIST FROM REG SAVE 00916000 CLI 8(R3),C'G' CHECK TO MAKE SURE THAT IT IS GEN 00917000 BNE FINISH IF NOT, DON'T PUT OUT MSG, LIB IS SAME 00918000 NOLIBGEN EQU * 00919000 MVC MSG213NM(8),LIBNAM SET LIBRARY FILE NAME 00920000 DMSERR MF=(E,ERLIST),NUM=MSG213ID,LET=W,TEXTA=MSG213 00921000 MVI RETCODE,MSG213RC SET RETURN CODE 00922000 B FINISH 00923000 EJECT P3128 00924000 DICTOK EQU * 00925000 LR R5,R6 GET NEXT AVAILABLE ITEM 00926000 STH R5,HITEM PUT IN HEADER 00927000 LA R9,TABLE SET FOR BXLE 00928000 LR R11,R7 SET COMP REG FOR BXLE 00929000 LA R7,INDEXL(,R7) BUMP FOR NEG. ORIGIN 00930000 WRDICT3 EQU * ENTRY FROM DELETE @VA04662 00931000 XC 0(80,R7),0(R7) ZAP THE NEXT 80 BYTES FOR CONSIST. 00932000 SR R7,R9 GET DISPLACEMENT FOR HLST 00933000 ST R7,HLST PUT IN HEADER 00934000 LA R10,DICRCDL LOAD NO. OF CHARS. USED PER RCD. 00935000 STH R5,LIBITEM SET ITEM NUMBER 00936000 LA R1,WRLIB ADDRESS OF SVC P LIST 00937000 WRTAB ST R9,LIBADD ADDRESS TO WRITE FROM 00938000 SVC X'CA' WRITE ENTRYS 00939000 DC AL4(WRERR) ... 00940000 LA R5,1(0,R5) UPDATE ITEMNO 00941000 STH R5,LIBITEM ... 00942000 BXLE R9,R10,WRTAB BACK FOR ANOTHER 00943000 SR R2,R2 CLEAR REG FOR H/W INSERTION @VA08982 00943500 ICM R2,M3,HITEM GET FIRST DICT RECORD @VA08982 00944000 SR R5,R2 NUM OF ITEMS WRITTEN @VA08982 00944500 ST R5,HITEMNO PUT IN HEADER 00945000 MH R5,=H'12' GET NUM DBL WRDS USED 00946000 ST R5,NUMFREE PUT IN HEADER 00947000 LA R5,1 SET TO WRITE HEADER 00948000 STH R5,LIBITEM ... 00949000 MVC HNAME,=C'DMSLIB' MOVE DATA SET I.D. INTO HEADER 00950000 MVI BUFF+20,X'40' BLANK OUT REMAINDER OF BUFFER @VA05059 00951000 MVC BUFF+21(59),BUFF+20 @VA05059 00952000 MVC LIBADD(4),=AL4(BUFF) ADDRESS OF BUFF TO P 00953000 SVC X'CA' WRITE HEADER 00954000 DC AL4(WRERR) .... 00955000 L R2,PPP 00956000 CLI 0(R2),C'D' 00957000 BE DUMERASE 00958000 CLOSE STD FINIS,WRLIB SET TO CLOSE LIBE FILE 00959000 LA R1,WRLIB ... 00960000 CLOSE2 EQU * 00961000 SVC X'CA' FINIS IT 00962000 DC AL4(*+4) ... 00963000 FINISH EQU * 00964000 TM FLAGS,KEYSET WAS DMSKEY NUCLEUS DONE @VA05571 00965000 BNO CLRELPAG NO. SKIP RESET,THEN @VA05571 00966000 DMSKEY RESET @VA05571 00967000 CLRELPAG DMSEXS OI,MISFLAGS,RELPAGES @VA05571 00968000 SR R15,R15 ZAP REGISTER FOR RETURN 00969000 IC R15,RETCODE SET RETURN CODE 00970000 LM R0,R14,SAVEREG RESTORE REGS 00971000 * 00972000 BR 14 RETURN TO CALLER 00973000 EJECT 00974000 LIBMOD STD STATE,WRLIB SEE IF LIBE FILE EXISTS 00975000 MVC LMODE(2),SETMODE ... 00976000 LA R1,WRLIB ... 00977000 SVC X'CA' ... 00978000 DC AL4(NOLIBE) ... 00979000 L R10,FSTLOCL ... 00980000 CLI 0(R2),C'M' MAP REQUESTED? @VA04791 00981000 BE ROEXTOK YES - R/O DISK IS OK @VA04791 00982000 TM 31(R10),X'40' READ ONLY EXT? @VA04531 00983000 BO RODISK YES, INDICATE R/O MSG37 @VA11614 00984000 ROEXTOK EQU * @VA04791 00985000 MVC XMODE(2),FMODE(R10) GET CORRECT MODE FOR SPACE @VA04531 00986000 * CHECK 00987000 CLC FSIZE(4,R10),RSIZE IS THE LRECL 80 BYTES 00988000 BNE BADLIBR IF NOT REJECT IT 00989000 CLI FFORM(R10),C'F' CHECK IF FIXED LENGTH RECORDS 00990000 BE LIBROK IF SO, CONTINUE PROCESSING 00991000 BADLIBR MVC MSG56NME,LIBNAM MOVE LIBRARY NAME INTO MSG 00992000 MVC MSG56TYP,LTYPE MOVE IN LIBR FILE TYPE 00993000 MVC MSG56RTP(5),MSG56RTP-1 BLANK OUT RECORD TYPE 00994000 B BADFORM TYPE OUT MSG 00995000 LIBROK EQU * 00996000 MVC LMODE(2),FMODE(R10) ... 00997000 STD RDBUF,WRLIB RESET CALL TO RDBUF 00998000 MVC LIBADD(4),=AL4(BUFF) RESET BUFF ADDRESS 00999000 SVC X'CA' READ HEADER 01000000 DC AL4(RDERROP) ... 01001000 CLC BUFF(6),=C'DMSLIB' CHECK THE LIBRARY IDENTIFIER @VA04662 01002000 BNE BADLIBR IF NOT REJECT FILE P0929 01003000 L R7,HLST SET REGS FROM HEADER 01004000 LA R7,TABLE(R7) ... 01005000 ST R7,ENDDIC SAVE END ON OLD DICT. 01006000 S R7,INDXLCON SET PTR TO LAST ENTRY 01007000 SR R5,R5 CLEAR REG FOR H/W INSERTION @VA08982 01007600 ICM R5,M3,HITEM GET FIRST DICT RECORD @VA08982 01008200 LR R6,R5 SAVE POINTER TO 1ST AVAIL. RCD 01009000 L R10,GETSIZE ... 01010000 ST R10,LIBLENG ... 01011000 LA R9,DICRCDL GET NO. OF CHARS. PER RCD. 01012000 SR R10,R10 ZAP EVEN REG 01013000 L R11,HLST GET NO. OF BYTES IN DICTIONARY 01014000 DR R10,R9 FIND OUT HOW MANY WHOLE RCDS FOR DICT. 01015000 LTR R10,R10 CHECK IF ANY LEFT OVER 01016000 BZ USEASIS IF NOT DICT. IS AN EVEN NO. OF RCDS. 01017000 LA R11,1(,R11) IF NOT, ADD ONE FO RESIDUAL 01018000 EJECT P3128 01019000 USEASIS LR R10,R11 SET UP FOR LOOP CTL. 01020000 LA R9,TABLE ADDRESS OF DICTIONARY TABLE 01021000 DICTLOOP EQU * 01022000 STH R5,LIBITEM SET ITEM # IN P LIST 01023000 ST R9,LIBADD SET ADDRESS TO READ LIBE 01024000 SVC X'CA' READ LIBE DICT 01025000 DC AL4(RDERROP) ... 01026000 LA R5,1(,R5) BUMP ITEM POINTER 01027000 LA R9,DICRCDL(R9) BUMP I/O ADDR BY LENGTH OF DICT READ 01028000 BCT R10,DICTLOOP READ IN ENTIRE DICTIONARY 01029000 LA R9,1 RESET NUM ITEMS TO 1 01030000 STH R9,LIBNOIT ... 01031000 LA R9,80 RESET BUFFER SIZE TO 80 01032000 ST R9,LIBLENG ... 01033000 CLI 0(R2),C'D' COMMAND STARTS WITH 'D'? 01034000 BE TDSTART YES, GO DELETE 01035000 LR R5,R6 RESET FILE POINTER TO 1ST AVAIL. RCD 01036000 BCTR R5,0 GET NEW ITEM # FOR WRITE 01037000 STH R5,LIBITEM ... 01038000 STD FINIS,WRLIB CLOSE FILE AFTER READING 01039000 SVC X'CA' ... 01040000 DC AL4(*+4) ... 01041000 CLI 0(R2),C'A' WAS ADDLIB CALLED? 01042000 BNE LIBLIST NO, TRY LIBLIST. 01043000 MVC WRLIB(5),WRSET SET TO WRITE ON LIBE FILE 01044000 B GENGO RETURN TO GENERATION ROUTINE 01045000 SPACE 2 01046000 EJECT 01047000 * 01048000 * CHECK FOR ABSENCE OF CSECTNAMES 01049000 * 01050000 TDSTART EQU * 01051000 CLI 16(R2),X'FF' END OF PLIST? 01052000 BNE DUMGEN NO, OK ... CARRY ON 01053000 MVC MSG01NME(5),=CL5'CSECT' SET NAME DESCRIPTOR 01054000 SHRTLIST EQU * 01055000 * THIS ERROR ROUTINE IS USED WHEN NO TEXT FILES ARE SPECIFIED 01056000 * IN ADDITION TO THE ABOVE IN-LINE USE 01057000 DMSERR MF=(E,ERLIST),NUM=MSG01ID,LET=E,TEXTA=MSG01 01058000 MVI RETCODE,MSG01RC SET RETURN CODE 01059000 B CLOSE CLOSE FILE 01060000 EJECT P3128 01061000 DUMGEN EQU * @VA04662 01062000 SPACE 1 01063000 * PHASE 1 OF TEXT LIBRARY DICTIONARY ENTRY DELETION: 01064000 * THIS ROUTINE WILL CYCLE THROUGH THE OLD DICTIONARY 01065000 * IN SEARCH OF NAMES CORRESPONDING TO THE GIVEN 01066000 * P-LIST TOKENS. IF IT FINDS A MATCHING ENTRY, IT 01067000 * REPLACES ITS NAME (AS WELL AS ITS ALIASES' NAMES) 01068000 * WITH A ZERO. IF NO ENTRY IS FOUND, AN ERROR 01069000 * MESSAGE IS SCHEDULED. 01070000 * 01071000 SLR R0,R0 CLEAR A REGISTER FOR ZERO @VA04662 01072000 LA R2,16(,R2) SET PTR TO FIRST DEL NAME @VA04662 01073000 LA R4,INDEXL SET DICTIONARY ENTRY WIDTH @VA04662 01074000 L R5,ENDDIC SET END OF DICTIONARY MARKER @VA04662 01075000 SLR R5,R4 ADDRESS VERY LAST ENTRY @VA04662 01076000 L R6,MAXHW MASK FOR CLEARING TOP HALF @VA04662 01077000 NI FLAGS,X'FF'-DOCOPY NOT COPYING @VA04662 01078000 USING ODICTDS,R8 ESTABLISH ADDRESSABILITY @VA04662 01079000 SPACE 1 01080000 MAINPH1 EQU * @VA04662 01081000 LA R8,TABLE ADDRESS THE OLD DICTIONARY @VA04662 01082000 NI FLAGS,X'FF'-CONT NOT CONTINUING @VA04662 01083000 SPACE 1 01084000 TOP EQU * @VA04662 01085000 LH R7,ODICADDR SAVE (NEXT) ITEM NUMBER @VA04662 01086000 NR R7,R6 CLEAR PROPAGATION @VA04662 01087000 CLC ODICNAME,0(R2) DOES NAME IN P-LIST MATCH ENTRY? @VA04662 01088000 BNE NOTFOUND NO, BUT LET'S KEEP TRYING @VA04662 01089000 OI FLAGS,CONT+DOCOPY MATCH, CONTINUE AND COPY @VA04662 01090000 SPACE 1 01091000 CLEARNAM EQU * @VA04662 01092000 ST R0,ODICNAME CLEAR THIS DIRECTORY ENTRY @VA04662 01093000 SPACE 1 01094000 NOTFOUND EQU * @VA04662 01095000 BXH R8,R4,CHECKER ADVANCE TO NEXT @VA04662 01096000 SPACE 1 01097000 LH R9,ODICADDR CHECK PREVIOUS VS THIS OFFSET @VA12858 01098000 NR R9,R6 (CLEAR PROPAGATION) @VA12858 01098100 CR R7,R9 (CHECK) @VA12858 01098200 BNE CHEKCONT MATCH, BRANCH DEP ON CONT FLAG @VA04662 01099000 TM FLAGS,CONT NEW NAME, WERE WE ZAPPING? @VA04662 01100000 BZ NOTFOUND NO, GO GET NEXT DICTIONARY ENTRY @VA04662 01101000 B CLEARNAM YES, THEN MUST CLEAR THIS NAME @VA04662 01102000 SPACE 1 01103000 CHEKCONT EQU * @VA04662 01104000 TM FLAGS,CONT WERE WE ZAPPING? @VA04662 01105000 BZ TOP NO, GO SEE IF THIS IS ON THE LIST@VA04662 01106000 B NEXTP FINISHED THIS P-LIST TOKEN; MORE?@VA04662 01107000 EJECT 01108000 CHECKER EQU * @VA04662 01109000 TM FLAGS,CONT WERE WE ZAPPING? @VA04662 01110000 BO NEXTP RARE CASE: DELETED LAST DECK @VA04662 01111000 BAL R9,MEMNTFND GO SEND ERROR MSG NOW @VA04662 01112000 SPACE 2 01113000 NEXTP EQU * @VA04662 01114000 LA R2,8(,R2) BUMP TO NEXT TOKEN @VA04662 01115000 CLI 0(R2),X'FF' WAS THAT THE LAST TOKEN? @VA04662 01116000 BNE MAINPH1 NOPE, MORE TO GO @VA04662 01117000 SPACE 1 01118000 * ENTER SECOND DELETE PHASE 01119000 EJECT 01120000 * PHASE 2 OF DELETE PROCESS 01121000 * 01122000 * SIMULTANEOUSLY CREATE NEW LIBRARY AND DIRECTORY 01123000 * 01124000 TM FLAGS,DOCOPY ANYTHING WORTH COPYING? @VA04662 01125000 BZ DUMERASE NO, WE DIDN'T DELETE ANYTHING @VA04662 01126000 SPACE 1 01127000 * INITIALIZATION 01128000 * 01129000 LA R8,TABLE ADDRESS START OF DIRECTORY @VA04662 01130000 L R7,ATBL2 ADDRESS THE NEW DIRECTORY @VA04662 01131000 ST R0,DISPLACE SET ADJUSTMENT FACTOR TO ZERO @VA04662 01132000 MVC ONXTADDR-ODICTDS(2,R5),HITEM FAKE LAST+1 ENTRY @VA04662 01133000 LA R1,2 FIRST RECORD OF TEXT DATA @VA04662 01134000 LR R2,R1 SAVE IN A COUNTER REG (2) @VA04662 01135000 STH R1,RITEM INITIALIZE AS FIRST ITEM TO WRITE@VA04662 01136000 STH R1,LIBITEM INITIALIZE AS FIRST ITEM TO READ @VA04662 01137000 L R1,ABUFFER GET THE BUFFER ADDRESS @VA04662 01138000 ST R1,LIBADD STASH IT IN INPUT P-LIST @VA04662 01139000 ST R1,RADD ALSO IN OUTPUT P-LIST @VA04662 01140000 MVC RNAME(16),DUMMYSET SET WORK FILE NAME, TYPE @VA04662 01141000 MVC RMODE(2),LMODE GET CORRECT MODE @VA04662 01142000 MVC RDISK(8),WRSET SET TO DO WRBUF @VA04662 01143000 LA R9,PH2RESET SET THE RETURN ADDRESS @VA04662 01144000 LA R10,10 DET DEFAULT BLOCKING FACTOR @VA04662 01145000 DMSKEY NUCLEUS PROCEED WITH EXTREME CAUTION @VA04662 01146000 OI FLAGS,KEYSET SIGNAL DMSKEY NUCLEUS DONE @VA05571 01147000 SPACE 1 01148000 MAINPH2 EQU * @VA04662 01149000 CL R0,ODICNAME WAS THIS ENTRY DELETED? @VA04662 01150000 BNE PH2NDEL NO, SO COPY IT @VA04662 01151000 SPACE 1 01152000 * CALCULATE THE DISPLACEMENT FOR FUTURE VALID ENTRIES. 01153000 * 01154000 L R3,DISPLACE GET CURRENT DISPLACEMENT @VA04662 01155000 SLR R1,R1 CLEAR A SCRATCH REGISTER @VA04662 01156000 ICM R1,B'0011',ONXTADDR GET NEXT ADDR @VA04662 01157000 ALR R3,R1 DETERMINE END OF GAP @VA04662 01158000 ICM R1,B'0011',ODICADDR @VA04662 01159000 SLR R3,R1 LESS START OF GAP @VA04662 01160000 ST R3,DISPLACE THIS IS NEW DISPLACEMENT @VA04662 01161000 SPACE 1 01162000 PH2RESET EQU * @VA04662 01163000 BXLE R8,R4,MAINPH2 LOOP @VA04662 01164000 SPACE 1 01165000 DMSKEY RESET RETURN TO NORMALCY @VA04662 01166000 NI FLAGS,X'FF'-KEYSET SIGNAL DMSKEY RESET DONE @VA05571 01167000 EJECT 01168000 * WE HAVE ENDED THE SCAN OF THE DICTIONARY, AND 01169000 * MUST NOW APPEND IT TO THE FILE. 01170000 * 01171000 * FIRST, WE MUST ENSURE THAT THE NEW LIBRARY CONTAINS 01172000 * SOME MEMBERS. 01173000 * 01174000 LA R1,2 GET A TWO @VA04662 01175000 CLR R1,R2 DID WE COPY ANYTHING? @VA04662 01176000 BNE PH3PASS YES, SET UP TO APPEND DICTIONARY @VA04662 01177000 SPACE 1 01178000 MVC WRLIB(5),ERASET NO, THEN ERASE THE NULL LIB @VA04662 01179000 LA R1,WRLIB ADDRESS THE PARMS @VA04662 01180000 SVC X'CA' DOITTOIT @VA04662 01181000 B NOLIBGEN GO ISSUE ERROR MESSAGE @VA04662 01182000 SPACE 1 01183000 PH3PASS EQU * @VA04662 01184000 MVC RNAME(18),LIBNAM SWAP PLISTS @VA04229 01185000 MVC WRLIB(5),WRSET SET UP TO WRITE 01186000 MVC LIBNAM(16),DUMMYSET PUT IN WORK FILE NAME AND TYPE 01187000 L R9,ATBL2 01188000 LR R5,R2 COPY THE COUNTER @VA04662 01189000 STH R5,HITEM SET THE ITEM COUNT IN HEADER @VA04662 01190000 LR R11,R7 @VA04662 01191000 LA R1,BUFF GET BUFFER ADDRESS @VA04662 01192000 ST R1,LIBADD STORE INTO P-LIST @VA04662 01193000 LA R1,80 80-BYTE RECORD @VA04662 01194000 ST R1,LIBLENG SET IN P-LIST @VA04662 01195000 LA R1,1 ONE ITEM AT A TIME @VA04662 01196000 STH R1,LIBNOIT SET NUMBER TO 1 IN LIST @VA04662 01197000 B WRDICT3 TIME TO SUMMARIZE @VA04662 01198000 SPACE 3 01199000 DUMERASE EQU * 01200000 LA R1,WRLIB MAKE SURE JS 01201000 STD FINIS,0(R1) NEW TXTLIB FILE JS 01202000 SVC X'CA' IS CLOSED JS 01203000 DC AL4(*+4) (NO PROBLEM IF CLOSED ALREADY) 01204000 MVC RDISK(5),ERASET ERASE 01205000 LA R1,RDISK USE PLIST1 01206000 SVC X'CA' ERASE OLD TXTLIB FILE 01207000 DC AL4(*+4) IGNORE ERRORS 01208000 TM FLAGS,DOCOPY DID WE COPY THE FILE? @VA04662 01209000 BZ FINISH NO WORK, LET'S GO HOME @VA04662 01210000 MVC LIBLENG(18),RNAME SWAP ROLES OF PLISTS 01211000 MVC WRLIB,ALTERSET RENAME THE FILE @VA12799 01212000 MVI RNMFENCE,X'FF' SET UP THE FENCE FOR RENAME 01213000 MVC RNMFENCE+1(7),RNMFENCE PROPAGATE FOR DOUBLE WD. 01214000 LA R1,WRLIB USE SECOND PLIST 01215000 SVC X'CA' ALTER .DUMMY TO FILENAME 01216000 DC AL4(ALTERBAD) 01217000 EJECT P3128 01218000 * 01219000 * NOW PREPARE TO FINIS TXTLIB FILE 01220000 * 01221000 CLOSE1 EQU * 01222000 STD FINIS,RDISK 01223000 LA R1,RDISK 01224000 B CLOSE2 GO TO FINIS 01225000 CLOSEIN EQU * 01226000 LA R1,RDISK 01227000 STD FINIS,RDISK FINIS INPUT FILE 01228000 SVC X'CA' ... 01229000 DC AL4(*+4) ... 01230000 STD RDBUF,RDISK RESET READ 01231000 BR R8 BACK TO CALLER 01232000 EJECT 01233000 PH2NDEL EQU * @VA04662 01234000 SPACE 1 01235000 * COPY THAT PORTION OF THE OLD DIRECTORY WHICH HAS NOT 01236000 * BEEN DELETED TO THE NEW DIRECTORY. 01237000 * 01238000 MVC DICTDS(12),ODICTDS COPY THE DICTIONARY ENTRY @VA04662 01239000 SPACE 1 01240000 * THE FOLLOWING SECTION OF CODE UPDATES THE POINTERS 01241000 * FOUND IN THE NEW DIRECTORY TO REFLECT THE ACTUAL 01242000 * STARTING ITEM NUMBER FOR EACH OF THE MEMBERS. 01243000 * 01244000 L R3,DISPLACE GET DIFF BETWEEN OLD AND NEW @VA04662 01245000 LH R1,ODICADDR GET OLD ADDR @VA04662 01246000 NR R1,R6 CLEAR PROLIFERATION @VA04662 01247000 SR R1,R3 ADJUST FOR COMPRESSION @VA04662 01248000 STH R1,INDXADDR SET NEW ADDRESS @VA04662 01249000 LA R7,INDEXL(,R7) ADVANCE NEW DICTIONARY CURSOR @VA04662 01250000 SPACE 1 01251000 * SEE IF SUBSEQUENT ENTRIES REFER TO THE SAME CSECT 01252000 * 01253000 CLC ODICADDR,ONXTADDR DO ADDRS MATCH? @VA04662 01254000 BNE PH2NSAME NO, NOW GO MOVE MEMBER @VA04662 01255000 SPACE 1 01256000 LA R8,INDEXL(,R8) ADVANCE OLD DICT POINTER @VA04662 01257000 B PH2NDEL TAKE IT FROM TOP @VA04662 01258000 SPACE 1 01259000 PH2NSAME EQU * @VA04662 01260000 SPACE 1 01261000 * COMPUTE THE NUMBER OF ITEMS TO COPY FROM THE OLD 01262000 * TEXT LIBRARY TO THE NEW ONE. WE MUST ALSO GET 01263000 * THE OLD LIBRARY STARTING RECORD NUMBER. 01264000 * 01265000 LH R1,ODICADDR @VA04662 01266000 NR R1,R6 CLEAR PROPAGATION @VA04662 01267000 STH R1,LIBITEM SET THE STARTING READ ITEM NUMBER@VA04662 01268000 LH R3,ONXTADDR DETERMINE LENGTH OF MEMBER @VA04662 01269000 NR R3,R6 CLEAR PROLIFERATION @VA04662 01270000 SLR R3,R1 NUMBER OF ITEMS TO COPY @VA04662 01271000 BAL R11,WRITER GO PUT OUT TEXT RECORDS @VA04662 01272000 BR R9 @VA04662 01273000 EJECT 01274000 WRITER EQU * @VA04662 01275000 SPACE 1 01276000 * THIS SUBROUTINE IS USED TO MOVE DATA FROM ONE FILE 01277000 * TO ANOTHER. IT DOES SO IN BLOCKS OF TEN IN ORDER TO 01278000 * CAPITALIZE ON THE CMS FILE CHARACTERISTICS. 01279000 * 01280000 * INPUTS: 01281000 * INPUT P-LIST HAS STARTING ITEM NUMBER IN IT. 01282000 * OUTPUT P-LIST HAS STARTING ITEM NUMBER IN IT. 01283000 * R3 - NUMBER OF ITEMS TO COPY (MUST BE POSITIVE) 01284000 * R6 - MASK FOR CLEAR TOP HALFWORD (0000FFFF) 01285000 * R10 - DEFAULT BLOCKING FACTOR (USU 10) 01286000 * R11 - RETURN ADDRESS 01287000 * 01288000 MORETODO EQU * @VA04662 01289000 LR R1,R10 ASSUME AT LEAST 10 ITEMS LEFT @VA04662 01290000 CLR R3,R10 FULL BUFFER? @VA04662 01291000 BNL SETTORD AT LEAST! @VA04662 01292000 LR R1,R3 NOT QUITE @VA04662 01293000 SPACE 1 01294000 SETTORD EQU * @VA04662 01295000 STH R1,LIBNOIT STORE THE NUMBER OF ITEMS TO READ@VA04662 01296000 STH R1,RNOIT ALSO NUMBER OF ITEMS TO WRITE @VA04662 01297000 ALR R2,R1 KEEP AN ACCURATE COUNT @VA04662 01298000 MH R1,H80 MULTIPLY BY LRECL @VA04662 01299000 ST R1,LIBLENG STASH THE BUFFER LENGTH @VA04662 01300000 ST R1,RMORE SET ALSO IN WRITE P-LIST @VA04662 01301000 LA R1,WRLIB ADDRESS THE READ P-LIST @VA04662 01302000 L R15,ARDBUF GET RDBUF ROUTINE ADDRESS @VA04662 01303000 BALR R14,R15 ISSUE RDBUF @VA04662 01304000 BNZ RDERR ERROR RETURN AND ANALYSIS @VA04662 01305000 LA R1,RDISK WRITE P-LIST @VA04662 01306000 L R15,AWRBUF GET WRBUF ROUTINE ADDRESS @VA04662 01307000 BALR R14,R15 ISSUE WRBUF @VA04662 01308000 BNZ WRERR ERROR RETURN AND ANALYSIS @VA04662 01309000 L R1,LIBITEM-2 GET LAST STARTING ITEM NUMBER @VA04662 01310000 L R15,LIBNOIT-2 GET NUMBER JUST WRITTEN @VA04662 01311000 ALR R1,R15 ADD TO DETERMINE NEXT @VA04662 01312000 NR R1,R6 CLEAR HIGH BITS @VA04662 01313000 STH R1,LIBITEM RESET THE STARTING ITEM NUMBER @VA04662 01314000 STH R2,RITEM RESTORE NEW ITEM NUMBER @VA04662 01315000 SR R3,R10 DETERMINE THE RESIDUAL ITEM COUNT@VA04662 01316000 BP MORETODO POSITIVE, GO DO MORE @VA04662 01317000 SPACE 1 01318000 * BEFORE RETURNING TO THE CALLER, WE SET UP THE NEXT 01319000 * ITEM NUMBER TO BE WRITTEN TO BE A NON-MULTIPLE 01320000 * OF 256 FOR OS MACRO SIMULATION CONSIDERATIONS. 01321000 * 01322000 CLI RITEM+1,X'00' ON NON-READABLE ITEM? @VA04662 01323000 BNER R11 LET'S RETURN @VA04662 01324000 LA R2,1(,R2) REFLECT ADJUSTMENT IN COUNTER @VA04662 01325000 MVI RITEM+1,X'01' NEXT ITEM OK @VA04662 01326000 L R15,DISPLACE GET DIFFERENCE @VA05154 01327000 BCTR R15,0 SET FOR BYPASSED RECORD @VA05154 01328000 ST R15,DISPLACE AND RESTORE IT @VA05154 01329000 BR R11 AND RETURN @VA05154 01330000 EJECT 01331000 MEMNTFND EQU * @VA04662 01332000 SPACE 1 01333000 * THIS ROUNTINE SENDS AN ERROR MESSAGE TO THE USER 01334000 * INDICATING THOSE MEMBER NAMES SPECIFIED IN HIS 01335000 * COMMAND LINE WHICH DID NOT EXIST IN THE TEXT LIBRARY 01336000 * DIRECTORY. 01337000 * 01338000 MVC MEMBNME(8),0(R2) MOVE MEM NAME INTO MSG @VA04662 01339000 MVC MSG13NME(8),LIBNAM SET FILE NAME IN MESSAGE @VA04662 01340000 DMSERR MF=(E,ERLIST),NUM=MSG13ID,LET=E,TEXTA=MSG13 @VA04662 01341000 MVI RETCODE,MSG13RC SET RETURN CODE @VA04662 01342000 BR R9 RETURN TO CALLER @VA04662 01343000 EJECT 01344000 LIBLIST EQU * @VA07183 01345000 LA R2,16(,R2) BUMP TO BEGINNING OF OPTIONS @VA07183 01346000 CLI 0(R2),C'(' OPTIONS SPECIFIED @VA07183 01347000 BE CKOPTS IF LEFT PAREN, CHECK OPTIONS @VA07183 01348000 CLI 0(R2),X'FF' CHECK TO ENSURE A FENCE @VA07183 01349000 BNE FORMODD IF NOT WHO KNOWS WHAT IT IS @VA07183 01350000 LA R5,0 SET REG TO INDICATE DEFAULT @VA07183 01351000 B SETDISK SET UP DEFAULT OF DISK @VA07183 01352000 CKOPTS EQU * @VA07183 01353000 LA R2,8(,R2) BUMP TO OPTION @VA07183 01354000 CLI 0(R2),X'FF' CHECK FOR FENCE @VA07183 01355000 BE SETDISK IF SO, DEFAULT @VA07183 01356000 LA R5,OPTLIST GET ADDR OF OPTION LIST @VA07183 01357000 LA R3,OPTLCT GET NO. OF ENTRIES IN LIST @VA07183 01358000 USING OPTBLDS,R5 ADDR FOR DSECT @VA07183 01359000 OPTLOOP EQU * @VA07183 01360000 CLC OPNAME(8),0(R2) COMP FULL OPTION @VA07183 01361000 BE OPRTNAD IF EQ. GO TO PROCESSING RTNE @VA07183 01362000 LA R5,12(,R5) BUMP TO NEXT OPTION @VA07183 01363000 BCT R3,OPTLOOP CHECK ALL OPTIONS @VA07183 01364000 B FORMODD IF IT ISN'T THERE, TELL USER @VA07183 01365000 SETTYPE LA R3,0 TYPE CODE IS 0 @VA07183 01366000 B MAPFIND GO FIND MAP FILE (IF THERE) @VA07183 01367000 SETDISK LA R3,4 CODE FOR DISK=4 @VA07183 01368000 B MAPFIND GO FIND MAP FILE (IF THERE) @VA07183 01369000 SETPRINT LA R3,8 PRINT CODE= 8 @VA07183 01370000 EJECT 1 @VA07183 01371000 MAPFIND EQU * @VA07183 01372000 MVC LTYPE,MAP SET LISTING FILE TYPE @VA07183 01373000 MVC LMODE,MODESET RESET MODE IN PLIST @VA07183 01374000 DMSKEY NUCLEUS SET NUCLEUS KEY @VA07183 01375000 L R15,AADTLKP GET DMSLAD ADDRESS @VA07183 01376000 BALR R14,R15 AND GO SEARCH ADT FOR DISK @VA07183 01377000 DMSKEY RESET RESTORE USERS KEY @VA07183 01378000 LTR R15,R15 WERE THERE ANY ERRORS? @VA07183 01379000 BZ MAPERASE BRANCH IF NOT @VA07183 01380000 LTR R3,R3 DO WE NEED DISK? @VA07183 01381000 BZ MAPLIST BRANCH IF NOT @VA07183 01382000 B RDERROP BRANCH IF NEEDED @VA07183 01383000 MAPERASE EQU * @VA07183 01384000 USING ADTSECT,R1 @VA07183 01385000 TM ADTFLG1,ADTFRW IS IT A R/W DISK? @VA07183 01386000 BO SETPLIST BRANCH IF YES @VA07183 01387000 LTR R3,R3 DO WE NEED R/W DISK? @VA07183 01388000 BZ MAPLIST BRANCH IF NOT @VA07183 01389000 TM ADTFLG1,ADTFRO IS DISK R/O? @VA07183 01390000 BZ NODISK BRANCH IF NOT ATTACHED @VA07183 01391000 B RODISK INDICATE R/O @VA07183 01392000 DROP R1 @VA07183 01393000 SETPLIST EQU * @VA07183 01394000 LA R1,WRLIB POINT TO PLIST @VA07183 01395000 MVC WRLIB,ERASET ERASE PREVIOUS LIB MAP @VA07183 01396000 SVC X'CA' ... 01397000 DC AL4(*+4) ... 01398000 MAPLIST EQU * @VA07183 01399000 MVC WRLIB(5),WRSET RESET CALL TO WRBUF 01400000 SR R6,R6 ZERO ENTRY COUNT @VA07183 01401000 STH R6,LIBITEM ZERO ITEM NUMBER @VA07183 01402000 ST R6,LSTWRD ZERO LSTWRD @VA07183 01403000 LA R10,30 SET ITEM LENG TO 30 01404000 ST R10,LIBLENG ... 01405000 ST R10,TYPLIN+12 ... 01406000 MVI TYPLIN+12,C'B' TYPE IN BLACK 01407000 LA R9,BUFF SET BUFFER ADDRESS 01408000 ST R9,LIBADD ... 01409000 ST R9,TYPLIN+8 ... 01410000 MVI TYPLIN+8,X'01' RESET CONSOLE NUM 01411000 LA R9,TABLE SET BXLE 01412000 USING ODICTDS,R9 01413000 LA R10,INDEXL ... 01414000 LR R11,R7 ... 01415000 SPACE 01416000 MVC BUFF(24),SETHDR WRITE HEADER 01417000 DISK1 LA R1,WRLIB DISK PARAMETER LIST 01418000 LTR R3,R3 TERM REQUEST? @VA07183 01419000 BNZ DSKHDR BRANCH IF NOT @VA07183 01420000 LA R1,TYPLIN SET UP THE SVC POINTER @VA07183 01421000 DSKHDR EQU * 01422000 LTR R5,R5 IS IT A DEFAULT SETTING 01423000 BZ WRTHDR YES, DON'T BOTHER CHECKING AFTERMATH 01424000 LA R2,8(,R2) BUMP PLIST PTR TO NEXT POSITION 01425000 CLI 0(R2),X'FF' CHECK FOR A FENCE 01426000 BE WRTHDR IF SO, IT'S O. K. 01427000 CLI 0(R2),C')' CHECK FOR RIGHT PAREN 01428000 BNE FORMODD IF NEITHER, IT'S JUNK, SO ERROR 01429000 WRTHDR EQU * 01430000 SVC X'CA' WRITE HEADER 01431000 DC AL4(*+4) ... 01432000 BAL R14,MAPERROR CHECK FOR ANY ERRORS @VA04699 01433000 EJECT 01434000 SPACE 01435000 FORBUF MVC BUFF+1(24),BUFF ... 01436000 MVC BUFF+2(8),ODICNAME PUR NAME IN OUTPUT BUFFER 01437000 LA R6,1(0,R6) INCREMENT COUNT 01438000 CLC ODICADDR(2),LSTWRD CHECK TO SEE IF NEW CSECT 01439000 BE DSKWRT NO - WRITE NAME ONLY 01440000 MVC LSTWRD(2),ODICADDR PUT NEW PARAMS IN LSTWRD 01441000 MVC BUFF+10(7),PATTERN EDIT PATTERN INTO BUFF 01442000 SR R5,R5 SET REG TO ZERO @VA11805 01442400 ICM R5,3,ODICADDR CONVERT ITEM TO DECIMAL @VA11805 01442800 CVD R5,PDOUT ... 01444000 ED BUFF+10(7),PDOUT+5 EDIT ITEM NO. 01445000 SPACE 01446000 DSKWRT SVC X'CA' EITHER WRITE OR TYPE 01447000 DC AL4(*+4) DON'T ADMOT ERRORS 01448000 BAL R14,MAPERROR CHECK FOR ANY ERRORS @VA04699 01449000 BXLE R9,R10,FORBUF 01450000 SPACE 01451000 MVC BUFF+9(20),CNTMESS PRINT ENTRY COUNT 01452000 MVC BUFF+2(7),PATTERN ... 01453000 CVD R6,PDOUT ... 01454000 ED BUFF+2(7),PDOUT+5 ... 01455000 SVC X'CA' ... 01456000 DC AL4(*+4) ... 01457000 BAL R14,MAPERROR CHECK FOR ANY ERRORS @VA04699 01458000 SRL R3,3 SHIFT SO THAT '8' BIT LEFT 01459000 LTR R3,R3 CHECK IF BIT IS ON 01460000 BP OFFPRT IF SO OFFLINE PRINT FILE 01461000 ENDOK SR R14,R14 SHOW NO ERRORS 01462000 B CLOSE DONE, BACK TO CALLER 01463000 OFFPRT EQU * 01464000 STD FINIS,WRLIB SET FOR CLOSE 01465000 SVC 202 TO CMS 01466000 DC AL4(*+4) 01467000 MVC WRLIB(8),=CL8'PRINT' SET TO PRINT 01468000 MVI LMODE,X'FF' START FENCE FOR ERASE 01469000 MVC LMODE+1(7),LMODE PROPAGATE FENCE 01470000 SVC 202 01471000 DC AL4(*+4) 01472000 MVC WRLIB(8),=CL8'ERASE' ERASE THE MAP FILE 01473000 SVC 202 01474000 DC AL4(*+4) 01475000 B ENDOK 01476000 SPACE 1 01477000 MAPERROR LTR R15,R15 WAS RETURN-CODE = ZERO? @VA04699 01478000 BZR R14 YES. THERE WERE NO ERRORS @VA04699 01479000 LTR R3,R3 IS A MAP FILE BEING WRITTEN? @VA04699 01480000 BZR R14 NO. TERMINAL OUTPUT @VA04699 01481000 LR R14,R15 DON'T RETURN; SAVE RETURN CODE @VA04699 01482000 MVC WRLIB(8),=CL8'ERASE' ERASE THE MAP FILE @VA04699 01483000 SVC 202 @VA04699 01484000 DC AL4(*+4) @VA04699 01485000 LR R15,R14 RESTORE RETURN CODE @VA04699 01486000 B WRERR PRINT DISK ERROR MESSAGE @VA04699 01487000 EJECT 01488000 NOFILE EQU * 01489000 MVC MSGFNAME(8),0(R2) MOVE FILE NAME INTO NOT FND. MSG. 01490000 DMSERR MF=(E,ERLIST),NUM=MSG2ID,LET=W,TEXTA=MSG002 01491000 MVI RETCODE,MSG2RC SET RETURN CODE 01492000 B FILCHK GO TO CHECK THE NEXT FILE 01493000 ERLIST DMSERR MF=L 01494000 SPACE 2 01495000 NOLIBE EQU * 01496000 MVC MSGFNAM2(8),LIBNAM MOVE LIBRARY NAME INTO MSG 01497000 DMSERR MF=(E,ERLIST),NUM=MSG2EID,LET=E,TEXTA=MSG002E 01498000 MVI RETCODE,MSG2ERC SET RETURN CODE 01499000 B FINISH TERMINATE PROGRAM 01500000 EJECT P3128 01501000 BADSIZE EQU * 01502000 MVC MSG56NME(8),0(R2) SET FILE NAME 01503000 BADFORM EQU * 01504000 DMSERR MF=(E,ERLIST),NUM=MSG56ID,LET=E,TEXTA=MSG56 01505000 MVI RETCODE,MSG56RC SET RETURN CODE 01506000 B CLOSE END PROCESSING 01507000 SPACE 2 01508000 OVRFLO EQU * 01509000 MVC MSG106NM(8),FIRSTSD SET FIRST SD ENTRY AS NAME 01510000 DMSERR MF=(E,ERLIST),NUM=MSG106ID,LET=E,TEXTA=MSG106 01511000 MVI RETCODE,MSG106RC SET ERROR CODE 01512000 BAL R8,CLOSEIN CLOSE INPUT FILE @VA07118 01513000 LM R6,R7,SAVE RESTORE POINTERS 01514000 B WRDICT SAVE WHATEVER IS POSSIBLE 01515000 EJECT P3128 01516000 RDERROP EQU * 01517000 MVC MSG104NM(8),LIBNAM IN SPECIAL CASE READ IS FROM WRITE 01518000 MVC MSG104TP(8),LTYPE P-LIST, SO GET ID FROM THERE 01519000 B RDERMSG BYPASS NORMAL MOVE 01520000 RDERR EQU * 01521000 MVC MSG104NM(8),RNAME SET FILE NAME 01522000 MVC MSG104TP(8),RTYPE SET FILE TYPE 01523000 RDERMSG EQU * 01524000 CVD R15,DOUBLE CONVERT RETURN CODE V0314 01525000 OI DOUBLE+7,X'0F' SET ZONE V0314 01526000 UNPK MSG104NO(4),DOUBLE(8) PUT RC IN MSG V0314 01527000 DMSERR MF=(E,ERLIST),NUM=MSG104ID,LET=S,TEXTA=MSG104 01528000 MVI RETCODE,MSG104RC SET ERROR CODE P3128 01529000 B CLOSE END PROCESSING 01530000 WRERRA EQU * @VA03771 01531000 OI FLAGS,NOROOM SET NO ROOM BIT @VA04662 01532000 LA R15,13 @VA03771 01533000 SPACE 2 01534000 WRERR EQU * 01535000 MVC MSG105NM(8),LIBNAM SET FILE NAME 01536000 MVC MSG105TP(8),LTYPE 01537000 CVD R15,DOUBLE SET MSG RETURN CODE 01538000 OI DOUBLE+7,X'0F' SET ZONE 01539000 UNPK MSG105NO(4),DOUBLE(8) PUT RC IN MSG 01540000 DMSERR MF=(E,ERLIST),NUM=MSG105ID,LET=S,TEXTA=MSG105 01541000 MVI RETCODE,MSG105RC SET RETURN CODE 01542000 TM FLAGS,NOROOM OUT OF ROOM? @VA04662 01543000 BO WRDICT YES, TRF @VA04662 01544000 B CLOSE END JOB 01545000 EJECT P3128 01546000 ALTERBAD EQU * 01547000 STC R15,RETCODE SET RETURN ERROR CODE FROM RENAME 01548000 B CLOSE1 END JOB 01549000 SPACE 2 01550000 FORMODD EQU * 01551000 MVC MSG03OPT(8),0(R2) SET BAD OPTION 01552000 DMSERR MF=(E,ERLIST),NUM=MSG03ID,LET=E,TEXTA=MSG03 01553000 MVI RETCODE,MSG03RC SET RETURN CODE 01554000 B CLOSE END THE JOB 01555000 EJECT 1 @VA07183 01556000 NODISK EQU * @VA07183 01557000 LA R5,LMODE POINT TO DISK MODE @VA07183 01558000 DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X01559000 LET=E,SUB=(CHARA,((R5),1)) @VA07183 01560000 MVI RETCODE,MSG069RC SET RETURN CODE @VA07183 01561000 B CLOSE AND GO FINISH UP @VA07183 01562000 MSG069RC EQU 36 @VA07183 01563000 SPACE 1 @VA07183 01564000 RODISK EQU * @VA07183 01565000 LA R5,LMODE POINT TO DISK MODE @VA07183 01566000 DMSERR TEXT='DISK ''..'' IS READ/ONLY',NUM=37, X01567000 LET=E,SUB=(CHARA,((R5),1)) @VA07183 01568000 MVI RETCODE,MSG037RC SET RETURN CODE @VA07183 01569000 B CLOSE AND GO FINISH UP @VA07183 01570000 MSG037RC EQU 36 @VA07183 01571000 EJECT 01572000 LTORG 01573000 EJECT P3128 01574000 DS 0D 01575000 SETFREE DC CL8'TYPLIN' 01576000 DC AL1(1) 01577000 DC AL3(0) 01578000 DC C'R' 01579000 DC AL3(0) 01580000 RDSET DC CL8'RDBUF' 01581000 FINISET DC CL8'FINIS' 01582000 DC CL8'TEXT' 01583000 SETMODE DC CL2' ' 01584000 DC H'0' 01585000 DC AL4(0) 01586000 RSIZE DC AL4(80) 01587000 DC CL2'F' 01588000 DC H'1' 01589000 DC F'0' 01590000 DS 0D 01591000 WRSET DC CL8'WRBUF' 01592000 STSET DC CL8'STATE' 01593000 DC CL8'TXTLIB' 01594000 MODESET DC CL2'A1' 01595000 DC H'1' 01596000 DC AL4(0) 01597000 DC AL4(80) 01598000 DC CL2'F' 01599000 DC H'1' 01600000 DC F'0' 01601000 MAP DC CL8'MAP' @VA07183 01602000 ERASET DC CL8'ERASE' @VA07183 01603000 DUMMYSET DC CL8'TXTLIB' 01604000 DUMTYPE DC CL8'CMSUT1' 01605000 ALTERSET DC CL8'RENAME' 01606000 TBUFF DS D TYPE FROM HERE 01607000 EJECT P3128 01608000 DS 0F 01609000 XESD DC X'02' 01610000 DC C'ESD' 01611000 XEND DC X'02' 01612000 DC C'END' 01613000 XLDT DC X'02' 01614000 DC C'LDT' 01615000 SPACE 2 01616000 GETSIZE DC A(ENDFREE-FREEST) SIZE OF GETMAIN AREA IN BYTES 01617000 TBLSIZE EQU 1000 MAX NUMBER OF ENTRIES IN LIBE 01618000 TBLSZ DC A(12*TBLSIZE) SIZE OF TABLE IN BYTES 01619000 SPACE 2 01620000 SETHDR DC C' ENTRY INDEX ' 01621000 CNTMESS DC CL20' ENTRIES IN LIBRARY' 01622000 PATTERN DC X'4040202020202040' 01623000 TOTAL DC F'0' TOTAL DISK SPACE SAVE AREA @VA03771 01624000 XLIST DS 0D @VA03771 01625000 XXLIST DC CL24' ' @VA03771 01626000 XMODE DC CL2'A1' @VA03771 01627000 SPACE 2 01628000 FLAGS DC X'00' CONTROL FLAGS FOR DMSLBT @VA04662 01629000 * 01630000 * BITS DEFINED IN FLAGS: 01631000 NOROOM EQU X'01' INDICATES DISK FULL CONDITION @VA04662 01632000 DOCOPY EQU X'02' INDICATES SOME CSECTS DELETED @VA04662 01633000 SPACE EQU X'04' INDICATES SPACE COND DETERMINED @VA04662 01634000 STFD EQU X'08' INDICATES NON-ERROR FROM STATE @VA04662 01635000 CONT EQU X'10' INDS SCAN'G FOR UNIQUE DIR ENTR'S@VA04662 01636000 KEYSET EQU X'20' @VA05571 01637000 SPACE 2 01638000 H80 DC H'80' HALFWORD 80 @VA05571 01639000 MAXHW DC F'65535' 16 UNSIGNED BITS @VA05571 01640000 EJECT P3128 01641000 ********************************************************************** 01642000 * 01643000 * 01644000 EOFMARK DC X'61FFFF61' END OF FILE MARKER 01645000 LDTAREA DS 0CL80 01646000 LDTID DC X'02' 01647000 DC C'LDT' 01648000 DC CL12' ' 01649000 LDTNAME DC CL8' ' NAME BEGINS IN COL 17, PER LOADER(DMSLDR 01650000 DC CL1' ' P3098 01651000 LDTSSI DC CL8' ' SETSSI DATA IF PRESENT P3098 01652000 DC CL47' ' P3098 01653000 OPERINIT DC CL1' ' INITIALIZING FIELD FOR 'OPERAND' 01654000 OPERAND DC CL11' ' OPERAND RETURNED FROM SCAN 01655000 OPBEGIN DS F BEGINNING OF OPERAND FOUND BY SCAN 01656000 OPEND DS F END OF OPERAND FOUND BY SCAN 01657000 EPEND DS F END OF ENTRY POINT TABLE 01658000 LASTSAVE DS F POINTER TO LAST ELEMENT IN ALIAS TBL 01659000 DISPLACE DS F DISPLACEMENT APPLIED TO ODICADDRS@VA04662 01660000 INDXLCON DC AL4(INDEXL) CONSTANT FULL WORD FOR INDEX LGTH 01661000 ALIASTBL DS 16D ALIAS TABLE, MAX. 16 ENTRIES 01662000 ALIASMAX DC AL4(*-8) LAST ELEMENT IN TABLE P0929 01663000 FIRSTSD DC CL8' ' NAME OF FIRST CSECT NAME IN DECK 01664000 MAXLEN DC H'11' MAXIMUM LENGTH OF OPERAND 01665000 * 01666000 BLANKS DC CL11' ' BLANK AREA 01667000 OPTBL DS 0F 01668000 NAMEOP DC CL8'NAME' NAME OPERATOR 01669000 B NAME PROCESSING ROUTINE 01670000 ALIASOP DC CL8'ALIAS' ALIAS OPERATOR 01671000 B ALIASRT PROCESSING ROUTINE 01672000 ENTRYOP DC CL8'ENTRY' ENTRY OPERATOR 01673000 B ENTRY PROCESSING ROUTINE 01674000 SSIOP DC CL8'SETSSI' P3098 01675000 B SETSSI P3098 01676000 INCLOP DC CL8'INCLUDE' @VMT8660 01677000 B INCLUDE @VMT8660 01678000 OPTBLEND EQU * 01679000 OPTBLQTY EQU (OPTBLEND-OPTBL)/12 01680000 * 01681000 * OPTION TABLE 01682000 * 01683000 OPTLIST DS 0F 01684000 DC CL8'DISK' 01685000 B SETDISK PROCESSING ROUTINE BR. INSTR. 01686000 DC CL8'PRINT' 01687000 B SETPRINT 01688000 DC CL8'TERM' 01689000 B SETTYPE 01690000 ENDOPLST DS 0CL1 01691000 OPTLCT EQU ((ENDOPLST-OPTLIST)/12) NO. OF ELEMENTS IN LIST 01692000 DOUBLE DS D USED FOR CONV. TO DECIMAL 01693000 EJECT P3128 01694000 * 01695000 * SWITCHES 01696000 * 01697000 SWS DC X'00' SWITCHES FOR TEXT DECK PROCESSING@VA04662 01698000 * 01699000 * BITS DEFINED IN SWS: 01700000 END EQU X'01' INDICATES END CARD READ @VA04662 01701000 ENTR EQU X'02' INDICATES ENTRY CARD READ @VA04662 01702000 INCL EQU X'04' INDICATES INCLUDE CARD READ @VA04662 01703000 LDT EQU X'08' INDICATES LDT CARD READ @VA04662 01704000 EOD EQU X'10' INDICATES END OF FILE ENCOUNTERED@VA04662 01705000 FLUSH EQU X'80' IND'S ERROR SITUATION, DROP DECK @VA04662 01706000 EJECT 01707000 * ERROR MESSAGES 01708000 * 01709000 ********************************************************************** 01710000 SPACE 2 01711000 MSG002 DC AL1(MSG2L-1) LENGTH BYTE 01712000 DC C'FILE '' ' 01713000 MSGFNAME DC CL8' ' FILE NAME OF TEXT FILE NOT FND. 01714000 DC C' TEXT '' NOT FOUND' 01715000 MSG2FIN DS 0CL1 END OF MSG 01716000 MSG2L EQU (MSG2FIN-MSG002) LENGTH OF MESSAGE 01717000 MSG2ID EQU 2 MSG I. D. 01718000 MSG2RC EQU 4 MSG. R. C. 01719000 * 01720000 SPACE 01721000 * 01722000 MSG002E DC AL1(MSG2EL-1) LENGTH BYTE 01723000 DC C'FILE '' ' 01724000 MSGFNAM2 DC CL8' ' NAME OF LIBRARY FILE NOT FOUND 01725000 DC C' TXTLIB '' NOT FOUND' 01726000 MSG2EFIN DS 0CL1 END OF MESSAGE 01727000 MSG2EL EQU (MSG2EFIN-MSG002E) LENGTH OF MESSAGE 01728000 MSG2EID EQU 2 MSG I.D. 01729000 MSG2ERC EQU 28 MSG R.C. 01730000 * 01731000 MSG01 DC AL1(MSG01L-1) LENGTH BYTE 01732000 DC C'NO ' 01733000 MSG01NME DC CL5' ' EITHER 'FILE' OR 'CSECT' DEP ON OPER 01734000 DC C' NAMES SPECIFIED' 01735000 MSG01FIN DS 0CL1 END OF MSG 01736000 MSG01L EQU (MSG01FIN-MSG01) LENGTH OF MSG 01737000 MSG01ID EQU 1 MSG I. D. 01738000 MSG01RC EQU 24 01739000 * 01740000 * 01741000 MSG03 DC AL1(MSG03L-1) LENGTH BYTE 01742000 DC C'INVALID OPTION '' ' 01743000 MSG03OPT DC CL8' ' OPTION THAT IS INVALID 01744000 DC C' '' ' 01745000 MSG03FIN DS 0CL1 END OF MSG 01746000 MSG03L EQU (MSG03FIN-MSG03) LENGTH OF MSG 01747000 MSG03ID EQU 3 MSG I. D. 01748000 MSG03RC EQU 24 01749000 EJECT P3128 01750000 * 01751000 * 01752000 MSG13 DC AL1(MSG13L-1) LENGTH BYTE 01753000 DC C'MEMBER '' ' 01754000 MEMBNME DC CL8' ' MISSING MEMBER NAME 01755000 DC C' '' NOT FOUND IN FILE ''' 01756000 MSG13NME DC CL8' ' FILE NAME OF TXTLIB 01757000 DC C' TXTLIB''' 01758000 MSG13FIN DS 0CL1 END OF MSG 01759000 MSG13L EQU (MSG13FIN-MSG13) LENGTH OF MSG 01760000 MSG13ID EQU 13 MSG I. D. 01761000 MSG13RC EQU 32 MSG RET. CODE @VA02968 01762000 * 01763000 * 01764000 MSG14 DC AL1(MSG14L-1) LENGTH BYTE 01765000 DC C'INVALID FUNCTION ''' @VA05070 01766000 MSG14FCT DC CL8' ' 01767000 DC C'''' 01768000 MSG14FIN DS 0CL1 END OF MSG 01769000 MSG14L EQU (MSG14FIN-MSG14) LENGTH OF MSG 01770000 MSG14ID EQU 14 MSG I.D. 01771000 MSG14RC EQU 24 MSG RET. CODE 01772000 * 01773000 * 01774000 MSG46 DC AL1(MSG46L-1) LENGTH BYTE 01775000 DC C'NO LIBRARY NAME SPECIFIED' 01776000 MSG46FIN DS 0CL1 END OF MSG 01777000 MSG46L EQU (MSG46FIN-MSG46) LENGTH OF MSG 01778000 MSG46ID EQU 46 MSG I.D. 01779000 MSG46RC EQU 24 RET. CODE 01780000 * 01781000 * 01782000 MSG47 DC AL1(MSG47L-1) LENGTH BYTE 01783000 DC C'NO FUNCTION SPECIFIED' 01784000 MSG47FIN DS 0CL1 END OF MSG 01785000 MSG47L EQU (MSG47FIN-MSG47) LENGTH OF MSG 01786000 MSG47ID EQU 47 MSG I.D. 01787000 MSG47RC EQU 24 MSGRET.CODE 01788000 * 01789000 * 01790000 MSG56 DC AL1(MSG56L-1) LENGTH BYTE 01791000 DC C'FILE ''' 01792000 MSG56NME DC CL8' ' FILE NAME 01793000 DC CL1' ' 01794000 MSG56TYP DC CL8' ' FILE TYPE 01795000 DC C''' CONTAINS INVALID ' 01796000 MSG56RTP DC CL5' ' TYPE OF RECORD IN ERROR 01797000 DC C' RECORD FORMATS' 01798000 MSG56FIN DS 0CL1 END OF MSG 01799000 MSG56L EQU (MSG56FIN-MSG56) LENGTH OF MSG 01800000 MSG56ID EQU 56 MSG I.D. 01801000 MSG56RC EQU 32 01802000 MSG56RCW EQU 4 RET. CODE FOR WARNING MESSAGES P3098 01803000 EJECT P3128 01804000 * 01805000 * 01806000 MSG104 DC AL1(MSG104L-1) LENGTH BYTE 01807000 DC C'ERROR ''' V0314 01808000 MSG104NO DC CL4' ' V0314 01809000 DC C''' READING FILE ''' V0314 01810000 MSG104NM DC CL8' ' FILE NAME 01811000 DC CL1' ' 01812000 MSG104TP DC CL8' ' FILE TYPE 01813000 DC C''' FROM DISK' 01814000 MSG104FN DS 0CL1 END OF MSG 01815000 MSG104L EQU (MSG104FN-MSG104) MSG LENGTH 01816000 MSG104ID EQU 104 01817000 MSG104RC EQU 100 RET. CODE. 01818000 * 01819000 * 01820000 MSG105 DC AL1(MSG105L-1) LENGTH BYTE 01821000 DC C'ERROR ''' 01822000 MSG105NO DC CL4' ' 01823000 DC C''' WRITING FILE ''' 01824000 MSG105NM DC CL8' ' FILE NAME 01825000 DC CL1' ' 01826000 MSG105TP DC CL8' ' FILE TYPE 01827000 DC C''' TO DISK' 01828000 MSG105FN DS 0CL1 END OF MSG 01829000 MSG105L EQU (MSG105FN-MSG105) LENGTH OF MSG 01830000 MSG105ID EQU 105 MSG I.D. 01831000 MSG105RC EQU 100 MSG. R.C. 01832000 * 01833000 * 01834000 MSG106 DC AL1(MSG106L-1) LENGTH BYTE 01835000 DC C'NUMBER OF MEMBER NAMES EXCEED MAX ''' 01836000 MSG106CT DC CL4'1000' DICTIONARY MAXIMUM CAPACITY 01837000 DC C'''. FILE ''' 01838000 MSG106NM DC CL8' ' FILE NAME 01839000 DC CL1' ' 01840000 DC C'TEXT'' NOT ADDED' 01841000 MSG106FN DS CL1 END OF MSG 01842000 MSG106L EQU (MSG106FN-MSG106) LENGTH OF MSG 01843000 MSG106ID EQU 106 MSG. I.D. 01844000 MSG106RC EQU 88 MSG R.C. 01845000 * 01846000 * 01847000 MSG213 DC AL1(MSG213L-1) LENGTH BYTE 01848000 DC C'LIBRARY ''' 01849000 MSG213NM DC CL8' ' FILE NAME 01850000 DC C' TXTLIB'' NOT CREATED, OR ERASED IF EMPTY.' @VA13116 01851000 MSG213FN DS 0CL1 END OF MSG 01852000 MSG213L EQU (MSG213FN-MSG213) LENGTH OF MSG 01853000 MSG213ID EQU 213 MSG I. D. 01854000 MSG213RC EQU 4 MSG R.C. 01855000 EJECT P3128 01856000 * 01857000 * 01858000 FUNCTAB EQU * 01859000 DC CL8'DEL' 01860000 DC CL8'GEN' 01861000 DC CL8'ADD' 01862000 DC CL8'MAP' 01863000 FUNCTABE DS 0CL1 01864000 FUNCTABC EQU ((FUNCTABE-FUNCTAB)/8) 01865000 RETCODE DC X'00' P3128 01866000 * 01867000 EPTBL DS 255D ENTRY POINT TABLE, MAX ENTRIES 255 01868000 EPTBLEND EQU * 01869000 * 01870000 *EQUATES 01871000 MAXSIZ EQU 11 MAX SIZE OF OPERAND IN SCAN 01872000 SDFLAG EQU X'01' SD INDICATOR ON ESD CARD 01873000 ALIASID EQU X'80' ALIAS INDIC. IN QUANTITY FIELD 01874000 INDEXL EQU 12 LENGTH OF INDEX BUCKET 01875000 HFF DC X'FF' @VA04072 01876000 M1 EQU 1 MASK FOR CLM @VA04072 01877000 M3 EQU 3 MASK FOR ICM @VA08982 01877500 * 01878000 EJECT 01879000 ********************************************************************** 01880000 * 01881000 * 01882000 * I/O WORK SECTION 01883000 * 01884000 FREEST EQU * 01885000 BUFF DS 0D I/O BUFFER 01886000 HNAME DS CL6 HEADER I.D., FOR HEADER ONLY 01887000 HITEM DS CL2 POINTER TO FIRST DICT RCD 01888000 HLST DS CL4 NUMBER OF BYTES IN DICTIONARY 01889000 HITEMNO DS CL4 NUMBER OF RECORD ITEMS IN DICTIONARY 01890000 NUMFREE DS CL4 NUMBER OF DOUBLE WORDS IN DICT (N.A.) 01891000 DS CL60 REMAINDER OF I/O BUFFER 01892000 BUFFEND EQU BUFF+72 LAST DIGIT TO BE SEARCHED BY SCAN 01893000 LSTWRD EQU BUFF+76 USED AS SAVE AREA FOR LIB. LIST 01894000 TYPLIN DS 2D 01895000 DICRCDL EQU 72 LENGTH OF 80 BYTE RCD USED BY DICT 01896000 SPACE 1 01897000 RDISK DS D 01898000 RNAME DS D 01899000 RTYPE DS D 01900000 RMODE DS H 01901000 RITEM DS H 01902000 FSTLOC EQU * 01903000 RADD DS F 01904000 RMORE DS F @VA04662 01905000 DS H @VA04662 01906000 RNOIT DS H @VA04662 01907000 SAVRET DS F 01908000 SPACE 1 01909000 WRLIB DS D 01910000 LIBNAM DS D 01911000 LTYPE DS D 01912000 LMODE DS H 01913000 LIBITEM DS H 01914000 FSTLOCL EQU * 01915000 LIBADD DS F 01916000 LIBLENG DS F 01917000 LIBFLAG DS H 01918000 LIBNOIT DS H 01919000 LIBIRD DS F 01920000 DS 3H SPACE USED BY ALTER 01921000 RNMFENCE DS 2F FENCE FOR RENAME PLIST 01922000 SPACE 1 01923000 PPP DS F POINTER TO COMMAND TYPE 01924000 ENDDIC DS F 01925000 SAVE DS 2F POINTERS FOR OVERFLOW 01926000 ABUFFER DC A(BUFFER) @VA04662 01927000 PDOUT DS 0D 01928000 ATBL2 DS F ADDRESS OF TABLE2 01929000 TABLE DS (TBLSIZE)XL12 12-BYTES PER ENTRY 01930000 TABLE2 DS (TBLSIZE)XL12 ... 01931000 BUFFER DS CL800 LARGE BUFFER FOR BLOCKED I/O @VA04662 01932000 ENDFREE DS 0D 01933000 EJECT P3128 01934000 DICTDS DSECT 01935000 INDXNAME DS CL8 NEW INDEX MEMBER NAME 01936000 INDXADDR DS CL2 STARTING ITEM NUMBER 01937000 INDXSPAR DS CL1 RESERVED 01938000 INDXCBYT DS CL1 C-BYTE 01939000 * 01940000 * 01941000 ODICTDS DSECT 01942000 ODICNAME DS CL8 OLD DICTIONARY MEMBER NAME 01943000 ODICADDR DS CL2 STARTING ITEM NUMBER 01944000 ODICSPAR DS CL1 RESERVED 01945000 ODICCBYT DS CL1 C-BYTE 01946000 ONXTADDR EQU ODICADDR+INDEXL NEXT INDEX ADDR FIELD @VA04662 01947000 * 01948000 * 01949000 OPTBLDS DSECT DSECT FOR OPERAND BRANCH TABLE 01950000 OPNAME DS CL8 OPERATOR NAME 01951000 OPRTNAD DS CL4 BRANCH INSTR. FOR PROC. RTNE 01952000 * 01953000 * 01954000 EJECT 01955000 SPACE 2 01956000 REGEQU 01957000 ADT @VA07183 01958000 NUCON 01959000 STATE EQU 0 01960000 RDBUF EQU 2 01961000 FINIS EQU 4 01962000 FILE EQU 6 01963000 SPACE 2 01964000 FMODE EQU 24 01965000 FSIZE EQU 32 01966000 FFORM EQU 30 FST OFFSET FOR THE FILE FORMAT 01967000 SPACE 3 01968000 END 01969000