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