ibm:vm370-lib:cms:dmslbt.assemble_src
Table of Contents
DMSLBT Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R13116DS]
Source Listing
- DMSLBT.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmslbt.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator