ibm:vm370-lib:cms:dmslbm.assemble_src
Table of Contents
DMSLBM Source
References
- Fixes Applied : 4
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSLBM.ASSEMBLE.txt
- LBM TITLE 'DMSLBM (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * 00004000
- * 00005000
- * 00006000
- * MODULE NAME: 00007000
- * 00008000
- * DMSLBM (MACLIB) 00009000
- * 00010000
- * FUNCTION: 00011000
- * 00012000
- * TO GENERATE A MACRO LIBRARY, TO ADD MACROS TO AN 00013000
- * EXISTING LIBRARY, TO DELETE OR REPLACE MEMBERS OF AN 00013100
- * EXISTING LIBRARY, TO COMPRESS THE SPACE OCCUPIED BY AN 00013200
- * EXISTING LIBRARY, AND TO LIST THE DICTIONARY OF AN 00014000
- * EXISTING MACRO LIBRARY. 00015000
- * 00016000
- * ATTRIBUTES: 00017000
- * 00018000
- * DISK RESIDENT 00019000
- * 00020000
- * ENTRY POINTS: 00021000
- * 00022000
- * DMSLBM 00023000
- * 00024000
- * ENTRY CONDITIONS: 00025000
- * 00026000
- * GPR1 = A(PLIST) 00027000
- * DS 0D 00028000
- * PLIST DC CL8'MACLIB' 00029000
- * COMP 00030000
- * GEN 00031000
- * ADD 00032000
- * DC CL8' MAP ' 00033000
- * REP 00034000
- * DEL 00035000
- * DC CL8' ' MACRO LIBRARY NAME 00036000
- * DC CL8' ' NAME 1 00037000
- * . 00038000
- * . 00039000
- * . 00040000
- * DC CL8' ' NAME N 00041000
- * 00042000
- * IF MAP IS SPECIFIED: 00043000
- * DC CL8'(' 00044000
- * DC CL8'TERM'|'PRINT'|'DISK' 00045000
- * 00046000
- * EXIT CONDITIONS: 00047000
- * 00048000
- * GPR15 = 0 NO ERRORS 00049000
- * GPR15 = XX ERRORS: 00050000
- * 4 MEMBER NOT FOUND 00051000
- * FILE NOT FOUND 00052000
- * LIBRARY NOT CREATED 00053000
- * LIBRARY IS ERASED IF LAST MEMBER IS DELETED @VA12809 00053500
- * 24 INVALID PARAMETER 00054000
- * NO LIBRARY NAME 00055000
- * NO FUNCTION 00056000
- * INVALID OPTION 00057000
- * NO FILENAME 00058000
- * INVALID FUNCTION 00058100
- * 28 LIBRARY NOT FOUND 00059000
- * 32 INVALID RECORDS 00060000
- * 36 DISK IS READ/ONLY 00061100
- * DISK IS NOT ATTACHED 00061150
- * 88 UNPREDICTABLE MACLIB FORMAT 00062000
- * MACLIB LIMIT EXCEEDED 00063000
- * 100 READ OR WRITE ERROR 00064000
- * 104 STORAGE CAPACITY EXCEEDED 00065000
- * 256 POINT ERROR 00066000
- * EXTERNAL REFERENCES: 00067000
- * 00068000
- * DMSNUC 00069000
- * 00070000
- * TABLES/WORK 00071000
- * 00072000
- * MACTBLLC - DICTIONARY BUFFER 00073000
- * 00074000
- * REGISTER USAGE: 00075000
- * 00076000
- * R4,R5 BASES 00077000
- * REST WORK 00078000
- * 00079000
- * NOTES: 00080000
- * NONE 00081000
- * 00082000
- * CALLS TO OTHER ROUTINES: 00083000
- * 00084000
- * DMSERS, DMSBWR, DMSSTT, DMSBRD, 00085000
- * DMSFNS,DMSPNT,DMSRNM,DMSERR,DMSCWR,DMSPRT 00086000
- * 00087000
- * OPERATION: 00088000
- * 00089000
- * THE OPERATION OF THE MACLIB COMMAND PROGRAM DEPENDS 00090000
- * ON WHETHER THE CALLING PROGRAM SPECIFIES GEN, ADD, 00091000
- * COMP, MAP, REP, OR DEL. 00092000
- * 00093000
- * GEN: DMSLBM CALLS THE ERASE COMMAND PROGRAM TO ERASE 00094000
- * ANY OLD LIBRARY WITH THE SAME NAME. THEN CALL DMSBWR 00095000
- * TO WRITE A TEMPORARY HEADER RECORD IN THE 00096000
- * MACRO LIBRARY. THIS DUMMY RECORD WILL LATER BE 00097000
- * REPLACED BY A MACRO DIRECTORY 00098000
- * DESCRIPTOR RECORD. NEXT, DMSLBM INITIALIZES THE 00099000
- * INDEX, WHICH 00100000
- * CORRESPONDS TO THE ITEM NUMBER, TO ONE. THEN IT 00101000
- * CALLS THE STATE FUNCTION PROGRAM TO LOCATE THE FILE 00102000
- * STATUS TABLE FOR THE FIRST MACRO 00103000
- * FILE - FILETYPE MUST BE MACRO OR COPY. DMSLBM NEXT 00104000
- * CALLS DMSBRD TO READ THE FIRST RECORD IN THE FIRST 00105000
- * MACRO FILE, CALLS DMSBWR TO WRITE IT INTO THE 00106000
- * MACRO LIBRARY BEING CREATED, AND INCREMENTS THE 00107000
- * INDEX. IF THE CARD IS A ./ CARD OR CMS EOF CARD IT IS 00108000
- * NOT WRITTEN TO THE MACLIB. AFTER WRITING 00109000
- * THE FIRST (OR ANY) RECORD, THE ACTION TAKEN BY DMSLBM 00110000
- * DEPENDS ON THE 00111000
- * NATURE OF THE RECORD. 00112000
- * 00113000
- * IF THE RECORD IS A MACRO HEADER RECORD DMSLBM 00114000
- * SAVES THE CURRENT INDEX VALUE 00115000
- * THEN IT STORES 00116000
- * THE INDEX VALUE IN THE APPROPRIATE ENTRY IN THE MACRO 00117000
- * DICTIONARY (REFER TO "TABLE/RECORD FORMATS" LATER IN 00118000
- * THIS SECTION), READS THE NEXT RECORD, WHICH IS THE 00119000
- * PROTOTYPE RECORD, OBTAINS THE MACRO NAME FROM THAT 00120000
- * RECORD, MOVES THE NAME TO THE APPROPRIATE ENTRY IN 00121000
- * THE MACRO DICTIONARY, WRITES THE PROTOTYPE RECORD 00122000
- * INTO THE MACRO LIBRARY, INCREMENTS THE INDEX, AND 00123000
- * READS AND PROCESSES THE NEXT RECORD. 00124000
- * 00125000
- * IF THE RECORD READ IS EITHER A COMMENT OR AN ELEMENT 00126000
- * OF THE BODY OF THE 00127000
- * MACRO, DMSLBM MERELY READS AND PROCESSES THE NEXT 00128000
- * RECORD. 00129000
- * 00130000
- * IF THE RECORD IS A MACRO TRAILER RECORD (THAT IS, IT 00131000
- * CONTAINS THE CHARACTERS 00132000
- * MEND STARTING IN COLUMN 10, DMSLBM INCREMENTS 00133000
- * A POINTER TO POINT TO THE NEXT 00134000
- * ENTRY IN THE MACRO DICTIONARY, AND RETURNS TO READ 00135000
- * AND PROCESSES THE NEXT ENTRY. 00136000
- * 00137000
- * DMSLBM REPEATS THIS PROCESS FOR ALL RECORDS IN THE 00138000
- * FIRST MACRO FILE. WHEN AN END-OF-FILE IS 00139000
- * ENCOUNTERED, IT CALLS DMSFNSA TO CLOSE 00140000
- * THAT FILE, AND PROCESSES THE NEXT MACRO FILE 00141000
- * SIMILARLY. 00142000
- * 00143000
- * WHEN ALL MACRO FILES ARE PROCESSED, DMSLBM WRITES THE 00144000
- * MACRO DICTIONARY OUT AT 00145000
- * THE END OF THE MACRO LIBRARY, OVERLAYS THE DUMMY 00146000
- * RECORD AT THE START OF THE MACRO LIBRARY WITH A 00147000
- * DICTIONARY HEADER RECORD (REFERS TO "TABLE/RECORD 00148000
- * FORMATS"), CLOSES THE NEWLY CREATED MACRO LIBRARY, 00149000
- * AND RETURNS TO THE CALLING PROGRAM, WHICH IS 00150000
- * USUALLY DMSINT. 00151000
- * 00152000
- * NOTE: 00153000
- * THROUGHOUT ITS PROCESSING, DMSLBM CHECKS TO ENSURE 00154000
- * THAT THE RECORDS IN EACH 00155000
- * MACRO DEFINITION ARE IN CORRECT SEQUENCE. IF THEY 00156000
- * ARE NOT, IT SIGNALS THE ERROR BY MEANS OF A TERMINAL 00157000
- * MESSAGE (ERROR CODE 32), AND RETURNS TO THE CALLING 00158000
- * PROGRAM. 00159000
- * 00160000
- * ADD: DMSLBM CALLS DMSSTT TO DETERMINE IF THE MACRO 00161000
- * LIBRARY TO 00162000
- * WHICH THE MACROS ARE TO BE ADDED EXISTS. IF IT DOES 00163000
- * NOT, IT SIGNALS THE ERROR 00164000
- * AND RETURNS TO THE CALLING PROGRAM. IF THE MACRO 00165000
- * LIBRARY EXISTS, DMSLBM CALLS DMSBRD TO READ THE 00166000
- * DICTIONARY HEADER RECORD INTO MAIN STORAGE 00167000
- * SO THAT IT CAN GET THE STARTING LOCATION OF THE MACRO 00168000
- * DICTIONARY. IT THEN SETS THE READ POINTER IN THE 00169000
- * FILE STATUS TABLE TO POINT TO THE START OF THE MACRO 00170000
- * DICTIONARY AND REPEATEDLY CALLS DMSLBM TO READ THE 00171000
- * MACRO DICTIONARY INTO STORAGE. DMSLBM NEXT CALLS 00172000
- * DMSFNSA TO CLOSE THE MACRO LIBRARY. HAVING CLOSED 00173000
- * THE LIBRARY, MACLIB CALLS DMSPNT TO SET THE WRITE 00174000
- * POINTER TO THE START OF THE OLD MACRO DICTIONARY. 00175000
- * NEXT, DMSLBM SETS A POINTER TO THE NEXT AVAILABLE 00176000
- * LOCATION IN THE MACRO DICTIONARY 00177000
- * AND THEN PROCEEDS TO ADD THE MACROS IN THE SAME 00178000
- * MANNER AS IT DOES IF GEN IS SPECIFIED. 00179000
- * 00180000
- * DEL: THE SPECIFIED MACRO NAME IS DELETED FROM THE 00181000
- * MACRO LIBRARY DICTIONARY BY MOVING ALL 00182000
- * DICTIONARY ENTRIES BEYOND IT DOWN 12 00183000
- * BYTES IN THE DICTIONARY BUFFER. 00184000
- * THE ACTUAL MACRO STATEMENTS 00185000
- * REMAIN IN THE LIBRARY FILE UNTIL COMPACTED. THE @VA12809 00186000
- * LIBRARY IS ERASED IF THE LAST MEMBER IS DELETED. @VA12809 00186500
- * 00187000
- * REP: THE MACRO NAME THAT IS OBTAINED FROM WITHIN THE 00188000
- * SPECIFIED FILE (WITH A FILETYPE OF MACRO OR COPY) IS 00189000
- * USED AS THE NAME OF THE MACRO TO BE REPLACED. THE 00190000
- * OLD MACRO IS DELETED FROM THE LIBRARY AND 00191000
- * THE NEW ONE ADDED TO THE END OF THE MACLIB. 00192000
- * 00193000
- * COMP: THE MACRO DICTIONARY IS READ INTO STORAGE, AND 00194000
- * EACH MACRO FROM THE LIBRARY IS WRITTEN INTO A 00195000
- * TEMPORARY FILE (MACLIB CMSUT1) FOR EACH VALID ENTRY 00196000
- * WITHIN THE DICTIONARY. 00197000
- * 00198000
- * MAP: DMSLBM READS THE MACRO DICTIONARY INTO MAIN 00199000
- * STORAGE AS IT DOES FOR ADD. NEXT, DMSLBM OBTAINS THE 00200000
- * FIRST ENTRY IN THE DICTIONARY, MOVES THE NAME, INDEX, 00201000
- * AND SIZE TO A BUFFER, AND CALLS THE APPROPRIATE 00202000
- * ROUTINE (DMSCWR, DMSPIO, DMSBWR) TO OUTPUT THE 00203000
- * CONTENTS OF THE BUFFER, AT THE TERMINAL, PRINTER OR 00204000
- * ONTO DISK. DMSLBM REPEATS THIS FOR EACH ENTRY IN THE 00205000
- * DICTIONARY. WHEN ALL ENTRIES ARE PROCESSED, DMSLBM 00206000
- * RETURNS TO THE CALLING PROGRAM. 00207000
- * 00208000
- * TABLE/RECORD/FORMATS: THE FORMATS OF THE MACRO 00209000
- * DICTIONARY AND THE DICTIONARY HEADER RECORD ARE 00210000
- * DESCRIBED BELOW. 00211000
- * 00212000
- * MACRO DICTIONARY: IN THE MACRO DICTIONARY 00213000
- * EACH ENTRY IS TWELVE BYTES IN LENGTH AND 00214000
- * CONTAINS TWO FIELDS. THE NAME FIELD (EIGHT BYTES) 00215000
- * CONTAINS THE NAME OF THE MACRO. THE INDEX FIELD (2 00216000
- * BYTES) INDICATES WHERE, WITHIN THE MACRO LIBRARY, THE 00217000
- * FIRST RECORD (ITEM) IN THE MACRO IS LOCATED. THE 00218000
- * INDEX FIELD (2 BYTES) IS EXPRESSED AS AN ITEM NUMBER. 00219000
- * 00220000
- * DICTIONARY HEADER RECORD: THE DICTIONARY HEADER 00221000
- * RECORD DEFINES THE LOCATION AND SIZE 00222000
- * OF THE MACRO DICTIONARY. IT IS AN 80-BYTE RECORD AND 00223000
- * CONTAINS THREE MEANINGFUL FIELDS. THE FIRST FIELD 00224000
- * (BYTES 1-6) CONTAINS THE CHARACTERS 'MACLIB'. THE 00225000
- * SECOND FIELD (BYTES 7 AND 8) IS A POINTER TO THE 00226000
- * START OF THE MACRO DICTIONARY. IT IS EXPRESSED AS AN 00227000
- * ITEM NUMBER. THE THIRD FIELD (BYTES 11 AND 12) 00228000
- * CONTAINS THE SIZE OF THE MACRO DICTIONARY (IN BYTES). 00229000
- * 00230000
- * 00231000
- * 00232000
- * ------------------------------------------ 00233000
- * | NAME OF FIRST MACRO INDEX | 00234000
- * ------------------------------------------ 00235000
- * | NAME OF SECOND MACRO INDEX | 00236000
- * ------------------------------------------ 00237000
- * | | 00238000
- * ------------------------------------------ 00239000
- * | NAME OF NTH MACRO | 00240000
- * ------------------------------------------ 00241000
- * 00242000
- * MACRO DICTIONARY FORMAT 00243000
- * 00244000
- * 00245000
- * ------------------------------------------- 00246000
- * | BYTES | CONTENTS | 00247000
- * ------------------------------------------- 00248000
- * | 1-6 | DMSLIB 00249000
- * | | | 00250000
- * | 7-8 | POINTER TO START OF MACRO | 00251000
- * | | DICTIONARY | 00252000
- * | | | 00253000
- * | 9-10 | NOT USED | 00254000
- * | | | 00255000
- * | 11-12 | SIZE OF MACRO DICTIONARY | 00256000
- * | | | 00257000
- * | 13-80 | NOT USED | 00258000
- * ------------------------------------------- 00259000
- * 00260000
- * DICTIONARY HEADER RECORD FORMAT 00261000
- *. 00262000
- EJECT 00263000
- *********************************************************************** 00264000
- * 00265000
- * INITIALIZE 00266000
- * 00267000
- *********************************************************************** 00268000
- DMSLBM START 00269000
- BALR R4,0 SET ADDRESSABILITY 00270000
- BCTR R4,0 00271000
- BCTR R4,0 00272000
- USING DMSLBM,R4,R5 00273000
- LA R5,4095(R4) SET SECOND BASE V0516 00274000
- LA R5,1(,R5) V0516 00275000
- REGEQU 00276000
- USING NUCON,R0 00277000
- LR PLIST,1 SAVE PARAMETER LIST POINTER 00278000
- ST R14,R14SAVE SAVE A LINKAGE REGISTER @VA04691 00278100
- XC ERRCODE(2),ERRCODE INIT EROR FILED 00279000
- MVC INTYPE,=CL8'MACRO' 00280000
- MVC OUTTYPE,=CL8'MACLIB' ... 00281000
- MVC INITNO,=H'0' ... 00282000
- MVC OUTITNO,=H'0' ... 00283000
- MVC INMODE(2),=2C' ' CHECK ALL MODES 00284000
- MVC OUTMODE,=CL2'A1' 00285000
- LA TEMP,BUFFER ... 00286000
- ST TEMP,INBUFF ... 00287000
- ST TEMP,OUTBUFF ... 00288000
- LA TEMP,80 ... 00289000
- ST TEMP,INSIZE ... 00290000
- ST TEMP,OUTSIZE ... 00291000
- MVI INFV,C'F' ... 00292000
- MVI OUTFV,C'F' ... 00293000
- MVC INNOIT,=H'1' ... 00294000
- MVC OUTNOIT,=H'1' ... 00295000
- LA MACTBL,MACTBLLC ... 00296000
- ST MACTBL,MACTBLSV ... 00297000
- LA TEMP,MACBUF ... 00298000
- O TEMP,=X'01000000' ... 00299000
- ST TEMP,MACPRT+8 ... 00300000
- MVC MACPRT+12(4),MACPRTX ... 00301000
- CLI 8(PLIST),X'FF' IS COMMAND SPECIFIED 00302000
- BE ERR047E NO, ERROR 00303000
- CLI 16(PLIST),X'FF' IS LIBRARY NAME SPECIFIED? @VA02856 00304000
- BE ERR046E YES, ERROR @VA02856 00305000
- MVC OUTNAME,16(PLIST) SET MACLIB FILE NAME 00306000
- CLI OUTNAME,C'*' * FOR MACLIB NAME V0516 00307000
- BE ERR046E YES, ERROR @VA02856 00308000
- LM RG7,RG9,COMLOOK LOOK UP COMMAND 00309000
- SR SWT,SWT CLEAR SWITCH (LIST/PRINT) 00310000
- LOOK CLC 0(8,RG7),8(PLIST) ... 00311000
- BE COMOK COMMAND FOUND,OK 00312000
- BXLE RG7,RG8,LOOK NOT FOUND YET, KEEP LOOKING 00313000
- LA PLIST,8(PLIST) POINT TO INVALID FUNCTION 00314000
- B ERR014E COMMAND NOT FOUND, ERROR 00315000
- COMOK CLI 16(PLIST),X'FF' LIBRARY NAME SPECIFIED 00316000
- BE ERR046E NO, ERROR 00317000
- L TEMP,8(0,RG7) GET ADDRESS OF COMMAND 00318000
- LA PLIST,24(0,PLIST) SET UP PLIST 00319000
- BR TEMP AND AWAY WE GO ... 00320000
- EJECT 00321000
- *********************************************************************** 00322000
- * 00323000
- * GENERATE NEW MACLIB 00324000
- * 00325000
- *********************************************************************** 00326000
- GEN EQU * 00327000
- LA R1,OUT ERASE OLD MACLIB 00328000
- MVC 0(8,R1),=CL8'STATE' 00329000
- SVC 202 CHECK FOR LIBRARY 00330000
- DC AL4(GENSTER) 00331000
- MVC 0(8,R1),=CL8'ERASE' 00332000
- SVC 202 00333000
- DC AL4(*+4) 00334000
- B WRDUM 00335000
- GENSTER CH R15,=H'28' FILE NOT FOUND 00336000
- BE WRDUM YES 00337000
- B ERRETRN SOMETHING WRONG 00338000
- WRDUM LA INDEX,1 SET INDEX 00339000
- MVC OUTBUFF,INBUFF RESTORE BUFFER ADDRESS 00340000
- XC 0(12,MACTBL),0(MACTBL) ZERO 1ST ENTRY V0516 00341000
- MVC 8(2,MACTBL),=H'2' INITIALIZE 1ST MEMBER INDEX V0516 00342000
- MVC BUFFER+3(3),=CL3'***' INDICATE LIBRARY IS VULNERV0516 00343000
- MVC 0(8,R1),=CL8'WRBUF' WRITE DUMMY RECORD 00344000
- SVC 202 00345000
- DC AL4(ERR105S) 00346000
- OI FLAGS1,X'20' INDICATE ADDITIONS BEING MADE V0516 00347000
- GLOOP1 SR SWT,SWT CLEAR SWITCH REGISTER 00348000
- CLI 0(PLIST),X'FF' ANY MORE IN FILES ? 00349000
- BE GFINI YES, FINISH UP 00350000
- NI FLAGS1,255-X'40' RESET END BIT 00351000
- MVC IN+8(8),0(PLIST) NO, GET NEXT FILE NAME 00352000
- LA PLIST,8(0,PLIST) ADV. PLIST PTR. FOR NEXT TIME DL 00353000
- MVC INMODE(2),=2C' ' CHECK ALL MODES 00354000
- MVC INTYPE,=CL8'MACRO' CHECK FOR FILETYPE OF MACRO 00355000
- LA R1,IN CHECK FOR INPUT MACRO FILE 00356000
- MVC 0(8,R1),=CL8'STATE' 00357000
- SVC 202 00358000
- DC AL4(INSTER) 00359000
- BAL R8,VALIDITY CHECK THIS MACRO FILE V0516 00360000
- MVC FPNAM(18),INNAME SET FN FT FM V0516 00361000
- MVC INITNO,=H'0' RE-INITIALIZE.. 00362000
- MVC INNOIT,=H'1' 00363000
- MVI FLAGS,MACNXT MACRO CARD NEXT 00364000
- GLOOP2 LA R1,IN READ FROM INPUT FILE 00365000
- MVC 0(8,R1),=CL8'RDBUF' 00366000
- SVC 202 00367000
- DC AL4(GEOF) 00368000
- GLOOP2A CLI FLAGS,MACNXT ARE WE BETWEEN MACROS V0516 00369000
- BNE GLOOP2B NO, OMIT CHECKS V0516 00370000
- CLC BUFFER(2),=CL2'./' IEBUPDTE CARD ? V0516 00371000
- BE GLOOP2 YES, IGNORE IT 00372000
- CLC BUFFER(4),=XL4'61FFFF61' MACLIB EOF CARD V0516 00373000
- BE GLOOP2 YES, IGNORE IT V0516 00374000
- CLC BUFFER+9(6),CATALS CATALS CARD? @VM03253 00375000
- BE GLOOP2 YES, SKIP RECORD @VM03253 00376000
- CLC BUFFER+9(3),END END CARD @VM03253 00377000
- BNE NEXTCK @VA05421 00378100
- CLI BUFFER,C'*' IS THIS BY CHANCE A COMMENT CARD @VA05421 00378200
- BNE GLOOP2 NO AN END CARD @VA05421 00378300
- * VA05421 00378400
- NEXTCK EQU * @VA05421 00378500
- CLC BUFFER(2),SLASHAST '/*'? @VM03253 00379000
- BE GLOOP2 YES, SKIP RECORD @VM03253 00380000
- GLOOP2B LA R1,OUT WRITE THIS RECORD V0516 00381000
- MVC 0(8,R1),=CL8'WRBUF' 00382000
- SVC 202 00383000
- DC AL4(ERR105S) 00384000
- LTR SWT,SWT MULTIPLE COPIES? @VA04600 00384250
- BNP ADVANCE NO; SKIP @VA04600 00384500
- CLC BUFFER(6),CSCOPY COPY CONTROL STATEMENT? @VA04690 00385100
- BE COPYNXT YES, PROCESS IT 00386000
- LTR SWT,SWT IS THIS A COPY FILE? @VA04600 00387000
- ADVANCE LA INDEX,1(,INDEX) (ADVANCE INDEX) @VA04600 00388000
- BNZ GLOOP2 YES, PROCESS NEXT CARD 00389000
- CLI BUFFER,C'*' IS IT A COMMENT CARD 00390000
- BE GLOOP2 YES 00391000
- CLI BUFFER+1,C'*' IS COL 2 AN ASTERISK DL 00392000
- BE GLOOP2 DL 00393000
- BAL SUBR,SCAN GO SCAN FOR AN OPERATION CODE 00394000
- LTR RG7,RG7 WAS ONE FOUND? 00395000
- BNZ CKMAC YES, GO CHECK FOR 'MACRO' CARD 00396000
- CLI FLAGS,MACNXT NO, WAS A 'MACRO' CARD EXPECTED? 00397000
- BE ERR056W YES, ERROR P3043 00398000
- B GLOOP2 NO, COPY THE CARD INTO THE MACLIB FILE 00399000
- INSTER CH R15,=H'28' FILE NOT FOUND 00400000
- BE CKCPY YES, CHECK FOR COPY FILE 00401000
- CH R15,=H'20' RETURN CODE OF 20 FROM STATE @VA01845 00402000
- * FOR INVALID '(' 00403000
- BNE ERRETRN STATE INVALIDTYPE? @VA02822 00404000
- STH R15,ERRCODE @VA02822 00405000
- B GLOOP1 @VA02822 00406000
- * INDICATION 00407000
- CKMAC CLI CONFLG,X'80' IS CONTINUATION FLAG ON? @VA02823 00408000
- BNE CCKMAC NO, THEN CONTINUE NORMALLY @VA02823 00409000
- CLI BUFFER+71,X'40' CONTINUATION CARD? @VA02823 00410000
- BNE GLOOP2 NO, THEN CONTINUE @VA02823 00411000
- MVI CONFLG,X'00' TURN FLAG OFF @VA02823 00412000
- B GLOOP2 @VA02823 00413000
- CCKMAC CLC 0(6,RG7),=CL6'MACRO' IS IT MACRO? @VA02823 00414000
- BE GMACRO YES 00415000
- CLI FLAGS,MACNXT ARE WE IN PHASE 00416000
- BE ERR056W DECK NOT IN ORDER P3043 00417000
- CLC 0(5,RG7),=CL5'MEND' IS IT A MEND CARD? 00418000
- BNE GLOOP2 NO, TRANSFER TO GLOOP2 00419000
- CKMAC1 EQU * 00420000
- MVI BUFFER,X'40' 00421000
- MVC BUFFER+1(79),BUFFER 00422000
- MVC BUFFER(4),=XL4'61FFFF61' MOVE IN SLASH CARD 00423000
- LA R1,OUT GO WRITE IT OUT 00424000
- MVC 0(8,R1),=CL8'WRBUF' 00425000
- SVC 202 00426000
- DC AL4(ERR105S) 00427000
- B GMEND 00428000
- GMACRO CLI FLAGS,MENDNXT ARE WE IN ORDER V0516 00429000
- BE ERR056W DECK NOT IN ORDER P3043 00430000
- MVI FLAGS,MENDNXT SET FLAG 00431000
- LA R1,IN READ FROM INPUT 00432000
- MVC 0(8,R1),=CL8'RDBUF' 00433000
- SVC 202 00434000
- DC AL4(GEOF) 00435000
- BAL SUBR,SCAN GO SCAN FOR MACRO TITLE 00436000
- LTR RG7,RG7 IS THERE ONE? 00437000
- BZ ERR056W NO, ERROR 00438000
- TRT 0(9,RG7),BLFIND YES, FIND TRAILING BLANK 00439000
- BC 8,ERR056W MACRO NAME LONGER THAN 8 LETTERS 00440000
- SR 1,RG7 COMPUTE NAME LENGTH FOR MOVE 00441000
- BCTR 1,0 00442000
- MVC 0(8,MACTBL),=CL8' ' ... 00443000
- EX 1,MOVE MOVE NAME TO DICTIONARY 00444000
- TM FLAGS1,X'80' ARE WE REPPING ? 00445000
- BNO *+8 NO,SKIP CHECK 00446000
- BAL SUBR,REPCHECK DELETE THIS ENTRY IF IT EXISTS 00447000
- B GLOOP2A CARD ALREADY READ, CONTINUE 00448000
- MOVE MVC 0(0,MACTBL),0(RG7) THIS INSTRUCTION IS EXECUTED.. 00449000
- EJECT 00450100
- SCAN LA RG7,BUFFER+1 SET INDEXES FOR SCAN DL 00451000
- LA RG8,1 00452000
- LA RG9,BUFFER+71 00453000
- CLI 0(RG9),X'40' IS THIS A CONTINUATION ? @VA02823 00454000
- BE NOCNT NO, CONTINUE NORMALLY @VA02823 00455000
- MVI CONFLG,X'80' SET CONFLG FOR CONT CHECK @VA02823 00456000
- NOCNT CLI BUFFER,C' ' DOES A SYMBOL EXIST? @VA02823 00457000
- BE SCAN3 NO, GO SCAN FOR OP CODE 00458000
- SCAN1 CLI 0(RG7),C' ' YES, LOOK FOR END OF SYMBOL 00459000
- BE FNDOP END FOUND, GO SCAN FOR OP CODE 00460000
- BXLE RG7,RG8,SCAN1 NOT FOUND, INCREMENT AND LOOP 00461000
- SCAN2 SR RG7,RG7 OP CODE NOT FOUND, SET USER FLAG 00462000
- OPFND BR SUBR RETURN TO CALLER 00463000
- FNDOP LA RG7,1(,RG7) ADVANCE BUFFER ADDRESS TO NEXT CHAR. 00464000
- SCAN3 CLI 0(RG7),C' ' SCAN FOR FIRST NON-BLANK CHAR. 00465000
- BNE OPFND NOT BLANK, BRANCH 00466000
- BXLE RG7,RG8,SCAN3 ELSE INCREMENT AND LOOP 00467000
- B SCAN2 OP CODE NOT FOUND, GO CK PHASE ERR 00468000
- EJECT 00468100
- GMEND LA INDEX,1(0,INDEX) INCREMENT INDEX FOR 'XL4'61FFFF61'CARD 00469000
- LA MACTBL,12(0,MACTBL) ADVANCE TO NEXT ENTRY IN DICTIONARY 00470000
- LR R15,MACTBL GET CURRENT DICTIONARY SLOT V0516 00471000
- S R15,MACTBLSV DETERMINE CURRENT LENGTH V0516 00472000
- ST R15,MACTBLLG SAVE LENGTH V0516 00473000
- C MACTBL,FREELOWE WILL IN STOR. DICT EXCEED LIMITV0516 00474000
- BH ERR109S BRANCH IF EXCEEDS V0516 00475000
- XC 0(12,MACTBL),0(MACTBL) CLEAR ENTRY TO ZERO V0516 00476000
- LTR SWT,SWT IS THIS A COPY FILE ? 00477000
- BZ GMEND1 NOPE 00478000
- TM FLAGS1,X'40' END FLAG ON ? 00479000
- BO GMENDA YES, FINISH UP 00480000
- MVC 0(8,MACTBL),COPYSAVE NO, MOVE IN SAVED COPY FILE NA 00481000
- BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00482100
- TM FLAGS1,X'80' IS THIS A REP FUNCTION ? 00483000
- BNO GLOOP2 NO 00484000
- BAL SUBR,REPCHECK CHECK THE ENTRY NAME 00485000
- B GLOOP2 PROCESS NEXT COPY ENTRY 00486000
- GMENDA BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00487100
- BCTR INDEX,0 ADJUST INDEX COUNTER V0516 00488000
- B GEOF2 GO CLOSE FILE 00489000
- GMEND1 LA INDEX,1(,INDEX) SET MACRO INDEX IN DICT. V0516 00490000
- BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00491100
- BCTR INDEX,0 V0516 00492000
- MVI FLAGS,MACNXT SET FLAGS 00493000
- B GLOOP2 CONTINUE 00494000
- GEOF C 15,=F'12' IS IT AN EOF 00495000
- BNE ERR104S NO, ERROR 00496000
- LTR SWT,SWT IS THIS A COPY FILE 00497000
- BZ GEOF1 NO, CLOSE THE FILE 00498000
- OI FLAGS1,X'40' TURN ON END BIT 00499000
- B CKMAC1 FINISH UP THE MACRO LIBRARY 00500000
- EJECT 00501000
- GEOF1 EQU * 00502000
- CLI FLAGS,MACNXT DID EOF OCCUR IN MIDDLE OF MACRO 00503000
- BNE ERR056W DECK NOT IN ORDER P3043 00504000
- GEOF2 LA R1,IN CLOSE THE IN FILE 00505000
- MVC 0(8,R1),=CL8'FINIS' 00506000
- SVC 202 00507000
- DC AL4(ERR907T) 00508000
- B GLOOP1 CONTINUE 00509000
- GFINI CLC MACTBLLG(4),=4X'00' NULL DICTIONARY V0516 00510000
- BNE GFINI3 NO V0516 00511000
- LA R1,OUT ERASE MACLIB 00512000
- MVC 0(8,R1),=CL8'ERASE' 00513000
- SVC 202 00514000
- DC AL4(*+4) 00515000
- B ERR213W 00516000
- GFINI3 EQU * COMPACT ROUTINE JOINS HERE 00517000
- L RG7,MACTBLSV SET INDEXES TO WRITE DICTIONARY ON DISK 00518000
- LA RG8,72 00519000
- L RG9,MACTBLLG ... 00520000
- LA RG9,0(RG7,RG9) ... 00521000
- GWRDICT CR RG7,RG9 AT END OF DICT. V0516 00522000
- BE WRTHDR YES V0516 00523000
- MVC BUFFER(72),0(RG7) GET PART OF DICTIONARY V0516 00524000
- XC BUFFER+72(8),BUFFER+72 ZERO UNUSED PORTION V0516 00525000
- LA R1,OUT WRITE IT 00526000
- MVC 0(8,R1),=CL8'WRBUF' 00527000
- SVC 202 00528000
- DC AL4(ERR105S) 00529000
- BXLE RG7,RG8,GWRDICT ... 00530000
- WRTHDR MVI BUFFER,X'40' CLEAR BUFFER V0516 00531000
- MVC BUFFER+1(79),BUFFER 00532000
- MVC BUFFER(6),=CL6'DMSLIB' SET DICTIONARY HEADER NAME 00533000
- LA INDEX,1(0,INDEX) CALCULATE LOC. OF DICTIONARY 00534000
- STH INDEX,BUFFER+6 LOC OF DICTIONARY 00535000
- MVC BUFFER+8(4),MACTBLLG LENGTH OF DICTIONARY 00536000
- MVC OUTITNO(2),=H'1' AT FRONT OF FILE 00537000
- SVC 202 WRITE DICTIONARY HEADER 00538000
- DC AL4(ERR105S) 00539000
- B RETURN DL 00540000
- EJECT 00540100
- CKCPY MVC INTYPE,=CL8'COPY' 00541000
- LA R1,IN CHECK FOR COPY FILE 00542000
- SVC 202 00543000
- DC AL4(ERR002W) 00544000
- BAL R8,VALIDITY CHECK THIS COPY FILE V0516 00545000
- LA R1,IN READ A CARD 00546000
- MVC 0(8,R1),=CL8'RDBUF' 00547000
- SVC 202 00548000
- DC AL4(ERR104S) 00549000
- LA INDEX,1(,INDEX) SET BEGINNING INDEX NO 00550000
- BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00551100
- CLC BUFFER(6),CSCOPY COPY FILE NAME CARD? @VA04690 00552100
- BNE COPY03 NO, THIS IS SINGLE ENTRY COPY FL. 00553000
- LA SWT,1 YES, INDICATE MULTI ENTRY COPY FILE 00554000
- BAL SUBR,SCAN LOOK FOR COPY MEMBER NAME 00555000
- LTR R7,R7 WAS ONE FOUND 00556000
- BZ ERR056W NO 00557000
- MVC 0(8,MACTBL),0(R7) YES, ENTER INTO DICTIONARY 00558000
- TM FLAGS1,X'80' IS THIS A REP FUNCTION ? 00559000
- BNO GLOOP2 NO 00560000
- BAL SUBR,REPCHECK YES, CHECK COPY NAME 00561000
- B GLOOP2 GET NEXT CARD 00562000
- COPY03 L SWT,=4X'FF' INDICATE SINGLE ENTRY COPY FILE @VA04600 00563000
- MVC 0(8,MACTBL),INNAME USE FILE NAME FROM USER COMMAND 00564000
- TM FLAGS1,X'80' IS THIS A REP FUNCTION ? 00565000
- BNO *+8 NO 00566000
- BAL SUBR,REPCHECK YES CHECK THE COPY NAME 00567000
- B GLOOP2A WRITE OUT THIS CARD 00568000
- COPYNXT LA R1,OUT GET CURRENT WRITE POINTER 00569000
- MVC 0(8,R1),=CL8'STATE' 00570000
- SVC 202 00571000
- L R11,OUTBUFF ADDRESS OF FST COPY 00572000
- L R11,20(,R11) GET WRITE AND READ POINTERS 00573000
- S R11,=X'00010000' DECREMENT WRITE POINTER BY ONE 00574000
- ST R11,TEMST PUT IN TEMPORARY STOR 00575000
- MVC WRPT(4),TEMST MOVE WRITE READ POINTERS TO POINT PLIST 00576000
- MVC FPNAM(18),OUTNAME NAME,TYPE,MODE TO P-LIST @VA04691 00577100
- LA R1,PNT POINT PLIST TO R1 00580000
- SVC 202 POINT THE IN FILE WR PTR BACK ONE 00581000
- DC AL4(*+4) 00582000
- MVC OUTBUFF(4),INBUFF RESTORE READ PLIST 00583000
- BAL SUBR,SCAN LOOK FOR MEMBER NAME 00584000
- LTR R7,R7 FOUND 00585000
- BZ ERR056W NO 00586000
- MVC COPYSAVE(8),0(R7) YES, SAVE IT 00587000
- B CKMAC1 FINISH THIS COPY ENTRY V0516 00588000
- EJECT 00589000
- ****************************************************************** 00590000
- * 00591000
- * CHECK INPUT FILE FOR FIXED 80 BYTE RECORDS. 00592000
- * CHECK THAT NEW ADDITION WILL NOT CAUSE MACLIB TO EXCEED 65K 00593000
- * ITEMS. 00594000
- * CHECK THAT NEW ADDITION WILL FIT ON OUTPUT DISK. 00595000
- * 00596000
- ****************************************************************** 00597000
- USING FSTSECT,TEMP V0516 00598000
- VALIDITY L TEMP,INBUFF GET FST ADDRESS V0516 00599000
- MVC INBUFF,OUTBUFF RESET READ PLIST @VA0516 00600000
- MVC INMODE,FSTM SET FILEMODE IN READ PLIST V0516 00601000
- CLI FSTFV,C'F' FIXED FORMAT V0516 00602000
- BNE ERR056W NO, THIS FILE INELIGIBLE V0516 00603000
- CLC FSTIL,=F'80' 80 BYTE RECORDS V0516 00604000
- BNE ERR056W NO V0516 00605000
- L R1,MACTBLLG DICTIONARY LENGTH V0516 00606000
- LA R1,156(,R1) PLUS 12 PLUS EOF REC. PLUS OVFL V0516 00607000
- SR R0,R0 CLEAR FOR DIVIDE V0516 00608000
- D R0,=F'72' GET NO. OF RECORDS THIS IS V0516 00609000
- LH R0,FSTIC NO. RECORDS THIS INPUT FILE V0516 00610000
- N R0,MAXHW CLEAR PROPAGATION V0516 00611000
- AR R1,R0 TOTAL NEW RECORDS THIS FILE V0516 00612000
- LR R7,R1 SAVE COUNT V0516 00613000
- DROP TEMP V0516 00614000
- USING ADTSECT,TEMP V0516 00615000
- TM FLAGS2,CKVAL HAVE WE BEEN HERE BEFORE? @VA03532 00616000
- BO GETNUM YES, SO GO DON'T DO IT AGAIN @VA03532 00617000
- OI FLAGS2,CKVAL SET BEEN HERE FLAG @VA03532 00618000
- LA R1,OUT CALL ADT LOOK UP FOR MACLIB V0516 00619000
- L R15,AADTLKW @VA03532 00621000
- BALR R14,R15 V0516 00622000
- LTR R15,R15 CHECK COD CODE @VA03532 00623000
- BNZ ERR157S NOT OK THEN ERROR @VA03532 00624000
- BCTR R0,0 SAVE 1 BLOCK FOR ME @VA03532 00625000
- LR TEMP,R0 GET NO BLOCKS LEFT @VA03532 00627000
- MH TEMP,=H'10' TIMES TEN REC/BLOCK V0516 00628000
- ST TEMP,TOTAL SAVE NO RECORDS @VA03532 00629000
- GETNUM L R15,TOTAL GET TOTAL ROOM LEFT @VA03532 00630000
- CR R7,R15 DO WE HAVE ENOUGH? @VA03532 00631000
- BNL ERR157S NO, THEN ERROR @VA03532 00632000
- SR R15,R7 SUBTRACT AMOUNT FROM TOTAL @VA03532 00633000
- ST R15,TOTAL AND PUT BACK CORRECTED AMOUNT @VA03532 00634000
- AR R7,INDEX COMPUTE HIGHEST ITEM NO. THIS ADDITIV0516 00635000
- C R7,=X'0000FFFD' CHECK 65K MAX @VA03532 00636000
- BH ERR157S WON'T FIT IF HIGHER V0516 00637000
- BR R8 SUCCESSFUL RETURN V0516 00638000
- EJECT 00639000
- ********************************************************************** 00640000
- * 00641000
- * ADD MACROS TO EXISTING MACLIB 00642000
- * 00643000
- ********************************************************************** 00644000
- ADD CLI 0(PLIST),X'FF' ANY INPUT NAMES V0516 00645000
- BE ERR001E NO, ERROR V0516 00646000
- BAL SUBR,READICT READ IN DICTIONARY 00647000
- OI FLAGS1,X'20' INDICATE ADD IN PROGRESS V0273 00648000
- XC OUTITNO(4),OUTITNO CLEAR ITEM NUMBER 00649000
- LA R1,OUT CLOSE MACLIB 00650000
- MVC 0(8,R1),=CL8'FINIS' 00651000
- SVC 202 00652000
- DC AL4(ERR907T) 00653000
- XC OUTITNO(4),OUTITNO CLEAR 'POINT' READ/WRITE POINTERS 00654000
- STH INDEX,OUTITNO SET TO WRITE MODE AT RIGHT PLACE 00655000
- LA R1,OUT POINT TO END OF MACLIB 00656000
- MVC 0(8,R1),=CL8'POINT' 00657000
- SVC 202 00658000
- DC AL4(ERR907T) 00659000
- XC OUTITNO,OUTITNO RESET ITEM NUMBER 00660000
- MVC OUTBUFF,INBUFF RESET BUFFER ADDRESS 00661000
- L MACTBL,MACTBLSV SET MACRO DICTIONARY POINTER 00662000
- A MACTBL,MACTBLLG ... 00663000
- BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00664100
- BCTR INDEX,0 ADJUST INDEX 00665000
- B GLOOP1 PRETEND THAT WE ARE CREATING THE FILE 00666000
- EJECT 00667000
- ********************************************************************** 00668000
- * 00669000
- * REPLACE A MACRO IN AN EXISTING MACLIB 00670000
- * 00671000
- ********************************************************************** 00672000
- * 00673000
- REPLACE EQU * 00674000
- OI FLAGS1,X'80' INDICATE REP FUNCTION 00675000
- B ADD TREAT AS ADD 00676000
- REPCHECK ST SUBR,TEMST+4 SAVE RETURN ADDRESS 00677000
- ST PLIST,TEMST SAVE PLIST POINTER 00678000
- LR PLIST,MACTBL POINT TO MACRO OR COPY NAME 00679000
- BAL SUBR,MACSEEK SEE IF IT ALREADY EXISTS 00680000
- L PLIST,TEMST RESTOR PLIST PTR 00681000
- L SUBR,TEMST+4 RESTORE RETURN REG 00682000
- BC 7,ERR013W MSG IF NAME NOT FOUND 00683000
- XC 0(8,RG7),0(RG7) DELETED DICTIONARY ENTRY 00684000
- BR SUBR RETURN 00685000
- * 00686000
- DCTWR EQU * PREPARE TO WRITE DICTIONARY 00687000
- L MACTBL,MACTBLLG 00688000
- XC OUTITNO(4),OUTITNO CLEAR 'POINT' READ/WRITE POINTERS 00689000
- STH INDEX,OUTITNO MOVE THE WRITE POINTER OUT TO 00690000
- LA R1,OUT OLD DICTIONARY 00691000
- MVC 0(8,R1),=CL8'POINT' 00692000
- SVC 202 00693000
- DC AL4(ERR907T) 00694000
- XC OUTITNO,OUTITNO CLEAR THE ITEMNO AGAIN FOR DICT WRT 00695000
- MVC OUTBUFF,INBUFF RESET THE BUFFER ADDRESS 00696000
- BCT INDEX,GFINI3 REDUCE INDEX, WRITE DICTIONARY V0516 00697000
- * SHOULD NEVER DROP THRU HERE 00698000
- EJECT 00699000
- ********************************************************************** 00700000
- * 00701000
- * DELETE A MACRO FROM AN EXISTING FILE 00702000
- * 00703000
- ********************************************************************** 00704000
- DELETE CLI 0(PLIST),X'FF' ANY NAMES TO DELETE V0516 00705000
- BE ERR001E NO, ERROR V0516 00706000
- BAL SUBR,READICT READ IN THE DICTIONARY 00707000
- DELEMAC BAL SUBR,MACSEEK SEE IF IT'S REALLY THERE 00708000
- LR R6,PLIST IN CASE MEMBER NOT FOUND 00709000
- BE DELMEM YES, DELETE IT 00710000
- LA SUBR,DELMEM1 SET RETURN FROM ERROR MESSAGE 00711000
- B ERR013W ISSUE WARNING 00712000
- DELMEM XC 0(8,RG7),0(RG7) BLANK DICTIONARY MEMBER NAME 00713000
- DELMEM1 LA PLIST,8(PLIST) POINT TO NEXT SPECIFIED NAME 00714000
- CLI 0(PLIST),X'FF' IS THIS THE END 00715000
- BNE DELEMAC BR ON NO TO DO MORE 00716000
- TM FLAG,NOMEMBER HAVE WE FOUND A MEMBER YET? @VA12809 00716010
- BNO SRCHOVER YES, DON'T SEARCH ANY FURTHER @VA12809 00716020
- CR RG7,RG9 ARE WE AT END OF DICTIONARY? @VA12809 00716030
- BNL ERASELIB YES, NO MEMBERS LEFT, DELETE LIB @VA12809 00716040
- SEEKMEMB EQU * @VA12809 00716050
- CLC 0(8,RG7),=8X'00' IS THIS A NULL ENTRY? @VA12809 00716060
- BE SKPRESET YES, GO SET UP FOR THE NEXT ONE @VA12809 00716070
- NI FLAG,255-NOMEMBER NO, LIBRARY IS NOT EMPTY @VA12809 00716080
- B SRCHOVER MEMBER FOUND, SEARCH OVER @VA12809 00716090
- SKPRESET EQU * @VA12809 00716100
- BXLE RG7,RG8,SEEKMEMB GO TRY THE NEXT ONE @VA12809 00716110
- ERASELIB EQU * @VA12809 00716120
- LA R1,OUT POINT TO OUTPUT FILE @VA12809 00716130
- MVC 0(8,R1),=CL8'ERASE' SET UP TO ERASE LIBRARY @VA12809 00716140
- SVC 202 AND DO IT @VA12809 00716150
- DC AL4(*+4) @VA12809 00716160
- B ERR213W GO TELL USER LIBRARY ERASED @VA12809 00716170
- SRCHOVER EQU * @VA12809 00716180
- XC OUTITNO(4),OUTITNO CLEAR READ/WRITE POINTERS 00717000
- LA R1,OUT CLOSE OUT FILE 00718000
- MVC 0(8,R1),=CL8'FINIS' 00719000
- SVC 202 00720000
- DC AL4(ERR907T) 00721000
- XC OUTITNO(4),OUTITNO CLEAR READ/WRITE AGAIN FOR POINT 00722000
- B DCTWR NOW GO WRITE DICTIONARY 00723000
- EJECT 00724000
- ********************************************************************** 00725000
- * 00726000
- * LIST MACRO DICTIONARY 00727000
- * 00728000
- ********************************************************************** 00729000
- LIST BAL SUBR,READICT GET MACLIB DICTIONARY IN CORE 00730000
- WRTERM MAPHDR,L'MAPHDR DISPLAY THE HEADINGS @VA04691 00731100
- SKPTYPE L RG7,MACTBLSV SET INDEXES 00732000
- L RG9,MACTBLLG ... 00733000
- LA RG8,12 ... 00734000
- LA RG9,0(RG7,RG9) ... 00735000
- SR RG9,RG8 ... 00736000
- LLOOP MVC PMAC,0(RG7) GET MACRO NAME 00737000
- MVC PMAC+8(L'MASK),MASK SET MASK FOR ED INSTRUCTION 00738000
- LH TEMP,8(0,RG7) GET INDEX OF MACRO IN PARTIONED DS 00739000
- N TEMP,MAXHW CLEAR PROPAGATION V0516 00740000
- LTR TEMP,TEMP NULL ENTRY? 00741000
- BZ LSTJN YES, THEN IGNORE 00742000
- CLI 0(RG7),X'00' DELETED ENTRY ? 00743000
- BE LSTJN YES, OMIT THIS ENTRY 00744000
- CVD TEMP,DOUBLE ... 00745000
- ED PNDX-1(6),DOUBLE+5 ... 00746000
- CR RG7,RG9 LAST NAME IN DICTIONARY 00747000
- BE ENDED YES 00748000
- LH TEMP,20(0,R7) INDEX OF NEXT MEMBER 00749000
- B STOR 00750000
- ENDED LH TEMP,DICITEM USE DICTIONARY ITEM NUMBER 00751000
- STOR N TEMP,MAXHW CLEAR PROPAGATION V0516 00752000
- LH R1,8(0,R7) CURRENT INDEX V0516 00753000
- N R1,MAXHW CLEAR PROPAGATION V0516 00754000
- SR TEMP,R1 LESS CURRENT INDEX V0516 00755000
- BCTR TEMP,0 ADJUST FOR EOF CARD 00756000
- CVD TEMP,DOUBLE ... 00757000
- ED PSZE(6),DOUBLE+5 ... DL 00758000
- LTR SWT,SWT IS IT REALLY A 'PRINT' REQUEST? 00759000
- BNZ MAP YES, GO DO A 'WRBUF' INSTEAD OF 'TYPLIN' 00760000
- LA R1,MACPRT TYPE DICTIONARY INFO 00761000
- MVC 0(8,R1),=CL8'TYPLIN' 00762000
- SVC 202 00763000
- LSTJN BXLE RG7,RG8,LLOOP CONTINUE THROUGH THE DICTIONARY 00764000
- B OFFPRINT CLOSE FILES 00765000
- * 00766000
- MAP LA R1,IN WRITE A LINE TO DISK 00767000
- MVC 0(8,R1),=CL8'WRBUF' 00768000
- SVC 202 00769000
- DC AL4(ERR105S) 00770000
- B LSTJN RETURN TO LOOP 00771000
- EJECT 00772000
- ******************************************************************* 00773000
- * 00774000
- * CREATE A PRINT FILE WITH FILETYPE=MAP 00775000
- * 00776000
- ******************************************************************* 00777000
- SPACE 1 @VA04590 00783000
- PRINT BAL SUBR,READICT READ IN MACRO DICTIONARY @VA04590 00784000
- LA TEMP,MAPHDR 00785000
- ST TEMP,INBUFF SET HEADER ADDRESS IN DISK PLIST 00786000
- LA TEMP,20 DL 00787000
- ST TEMP,INSIZE IN DISK PLIST 00788000
- LA R1,IN WRITE HEADER 00789000
- MVC 0(8,R1),=CL8'WRBUF' 00790000
- SVC 202 00791000
- DC AL4(ERR105S) @VA07183 00792100
- LA TEMP,MACBUF SET NORMAL BUFFER ADDRESS 00793000
- ST TEMP,INBUFF IN DISK PLIST 00794000
- B SKPTYPE NOW ENTER AS IF A 'LIST' CALL 00795000
- OFFPRINT EQU * OFFLINE PRINT COPY OF LIB MAP TR 00800000
- LA R1,IN CLOSE MAP FILE 00801000
- MVC 0(8,R1),=CL8'FINIS' 00802000
- SVC 202 00803000
- DC AL4(*+4) 00804000
- LTR SWT,SWT IS THIS PRINT PARAMETER 00805000
- BNP RETURN NO, RETURN 00806000
- MVC OP+8(18),INNAME SET MAP FILE ID 00807000
- MVC OP(8),=CL8'PRINT' SET TO PRINT ON SYSTEM PRINTER 00808000
- LA 1,OP POINT TO OFFLINE PLIST DL 00809000
- SVC 202 00810000
- DC AL4(*+4) @VA04590 00810200
- LA R1,IN @VA04590 00810400
- MVC 0(8,R1),=CL8'ERASE' ERASE MAP FILE @VA04590 00810600
- SVC 202 @VA04590 00810800
- DC AL4(RETURN) 00811000
- B RETURN TR 00812000
- MAP1 MVC INTYPE,=CL8'MAP' 00813000
- L SWT,=4X'FF' SET DEFAULT OPTION 'DISK' 00814000
- CLI 0(PLIST),X'FF' ANY OPTIONS 00815000
- BE OPEND NO 00816000
- CLI 0(PLIST),C'(' ANY OPTIONS 00817000
- BNE ERR070E UNEXPECTED PARAMETER 00818000
- NEXTOP LA PLIST,8(PLIST) POINT TO FIRST OPTION 00819000
- CLI 0(PLIST),X'FF' END OF OPTIONS 00820000
- BE OPEND YES 00821000
- CLI 0(PLIST),C')' END OF OPTIONS 00822000
- BE OPEND YES 00823000
- CLC 0(8,PLIST),=CL8'DISK' DISK OPTION 00824000
- BE DSK YES 00825000
- CLC 0(8,PLIST),=CL8'TERM' TERM OPTION 00826000
- BE TRM YES 00827000
- CLC 0(8,PLIST),=CL8'PRINT' PRINT OPTION 00828000
- BE PRT YES 00829000
- B ERR003E INVALID OPTION 00830000
- DSK L SWT,=4X'FF' SET FOR DISK 00831000
- B NEXTOP CHECK MORE OPTIONS 00832000
- TRM SR SWT,SWT SET FOR TERM 00833000
- B NEXTOP CHECK MORE OPTIONS 00834000
- PRT LA SWT,1 SET FOR PRINT 00835000
- B NEXTOP CHECK MORE OPTIONS 00836000
- OPEND MVC INNAME,OUTNAME MAP NAME = MACLIB NAME @VA04590 00836250
- MVC INMODE,=CL2'A1' MAP MODE IS A1 @VA04590 00836500
- DMSKEY NUCLEUS SET NUCLEUS KEY @VA07183 00836550
- LA R1,IN POINT TO PLIST @VA07183 00836600
- L R15,AADTLKP GET DMSLAD ADDRESS @VA07183 00836650
- BALR R14,R15 AND GO SEARCH ADT FOR DISK @VA07183 00836700
- DMSKEY RESET RESTORE USERS KEY @VA07183 00836750
- LTR R15,R15 WERE THERE ANY ERRORS? @VA07183 00836800
- BZ OPERASE BRANCH IF NOT @VA07183 00836850
- LTR SWT,SWT DO WE NEED DISK? @VA07183 00836900
- BZ LIST BRANCH IF NOT @VA07183 00836950
- B ERR104S ERROR IF NEEDED @VA07183 00837000
- OPERASE EQU * @VA07183 00837050
- DROP TEMP @VA07183 00837100
- USING ADTSECT,R1 @VA07183 00837150
- TM ADTFLG1,ADTFRW IS IT A R/W DISK? @VA07183 00837200
- BO SETPLIST BRANCH IF YES @VA07183 00837250
- LTR SWT,SWT DO WE NEED DISK? @VA07183 00837300
- BZ LIST BRANCH IF NOT @VA07183 00837350
- TM ADTFLG1,ADTFRO IS DISK R/O? @VA07183 00837400
- BZ ERR069 BRANCH IF NOT ATTACHED @VA07183 00837450
- LA R3,IN+TWO4 POINT TO FILEMODE @VA07183 00837500
- B ERR37 AND STATE R/0 DISK @VA07183 00837550
- DROP R1 @VA07183 00837600
- USING ADTSECT,TEMP @VA07183 00837650
- SETPLIST EQU * @VA07183 00837700
- LA R1,IN POINT TO PLIST AGAIN @VA07183 00837750
- MVC 0(EIGHT,R1),ERASE INDICATE ERASE @VA07183 00837800
- SVC 202 @VA07183 00837850
- DC AL4(*+4) @VA07183 00837900
- LTR SWT,SWT CHECK OPTION SWITCH @VA07183 00837950
- BZ LIST BRANCH IF TERM OPTION 00838000
- B PRINT BRANCH FOR DISK OR PRINT 00839000
- EJECT 00840000
- ********************************************************************** 00841000
- * 00842000
- * COMPACT A MACLIB WHICH HAS SOME GAPS 00843000
- * 00844000
- ********************************************************************** 00845000
- COMPACT NI FLAGS2,X'00' RESET FLAGS2 00846000
- CLI 0(PLIST),X'FF' END OF PARAMETERS 00847000
- BNE ERR070E NO, ERROR 00848000
- BAL SUBR,READICT GET OLD DICTIONARY 00849000
- XC OUTITNO(2),OUTITNO CLEAR ITEM NUMBER FOR SEQ. WRITES 00850000
- MVC IN(44),OUT GET BLOCK FOR INPUT 00851000
- L MACTBL,MACTBLSV GET DICTIONARY ADDRESS @VA04691 00852100
- L RG9,MACTBLLG AND ITS LENGTH 00853000
- LA RG8,12 ENTRY WIDTH 00854000
- ALR RG9,MACTBL POINT TO DICTIONARY END @VA04691 00855100
- SR RG9,RG8 AND NOW TO LAST ENTRY 00856000
- MVC OUTNAME(16),TEMPNAME USE TEMPORARY FILE @VA04105 00858100
- * NOW ERASE ANY OLD TEMPORARY FILE 00859000
- LA R1,OUT 00860000
- MVC 0(8,R1),=CL8'ERASE' 00861000
- SVC 202 00862000
- DC AL4(*+4) 00863000
- * WRITE A DUMMY DICTIONARY POINTER 00864000
- MVC 0(8,R1),=CL8'WRBUF' 00865000
- SVC 202 00866000
- DC AL4(TEMPERR) 00867000
- LA INDEX,2 POINTER TO FIRST RECORD @VA04691 00868500
- SPACE 1 00869000
- CCLOOP EQU * @VA04691 00869500
- LH SINDEX,8(,MACTBL) GET FIRST INPUT ITEM @VA04691 00870000
- N SINDEX,MAXHW CLEAR PROPAGATION @VA04691 00870500
- CLI 0(MACTBL),X'00' IS THIS A DELETED ENTRY? @VA04691 00871000
- BNE CLOOP2 NO 00872000
- L R10,MACTBLLG DECREMENT DICTIONARY LENGTH 00873000
- SR R10,RG8 00874000
- ST R10,MACTBLLG 00875000
- CLR MACTBL,RG9 LAST ENTRY IN DICTIONARY? @VA04691 00876100
- BE CCEXIT YES, FINISH UP 00877000
- LR R10,RG9 COMPRESS THIS ENTRY FROM DICTIONARY 00878000
- SLR R10,MACTBL REMAINING LENGTH @VA04691 00879100
- STM R6,R9,BUFFER SAVE SOME REGS P3011 00880000
- LA R8,12(,MACTBL) MOVE FROM ADDRESS @VA04691 00881100
- LR R7,R10 LENGTH OF TO LOCATION P3011 00883000
- LR R9,R10 LENGTH OF FROM PLUS PADDING P3011 00884000
- MVCL R6,R8 COMPRESS ENTRY FROM DICTIONARY P3011 00885000
- LM R6,R9,BUFFER GET REGS BACK P3011 00886000
- SR RG9,RG8 POINT TO NEW END OF DICTIONARY 00887000
- B CCLOOP PROCESS NEXT ENTRY 00888000
- SPACE 1 00889100
- CLOOP2 EQU * @VA04691 00889200
- BAL R14,XCHECK SET AND CHECK INDEX @VA04691 00889300
- TM FLAGS2,OLDLIB CONVERTING AN OLD LIBRARY FORMAT 00891000
- BNO CNOLD NO 00892000
- XC 10(2,MACTBL),10(MACTBL) YES, CLEAR OLD SIZE @VA04691 00893100
- CNOLD DS 0H 00894000
- CLOOP STH SINDEX,INITNO STORE READ ITEM NUMBER 00895000
- * READ FROM OLD MACLIB 00896000
- LA R1,IN READ FROM OLD MACLIB 00897000
- MVC 0(8,R1),=CL8'RDBUF' 00898000
- SVC 202 00899000
- DC AL4(ERR104S) 00900000
- * WRITE ONTO TEMP MACLIB 00901000
- LA R1,OUT 00902000
- MVC 0(8,R1),=CL8'WRBUF' 00903000
- SVC 202 00904000
- DC AL4(ERR105S) 00905000
- LA INDEX,1(,INDEX) ADVANCE WRITE COUNTER @VA04691 00906100
- LA SINDEX,1(,SINDEX) AND READ POINTER 00907000
- CLC BUFFER(4),=XL4'61FFFF61' END OF MEMBER 00908000
- BNE CLOOP NO, GET NEXT RECORD 00909000
- BXLE MACTBL,RG8,CCLOOP TRY NEXT MACRO @VA04691 00910100
- SPACE 1 00910200
- CCEXIT EQU * @VA04691 00910300
- BCT INDEX,GFINI3 CUT POINTER FOR DICT WRITE AND DO IT 00912000
- * SHOULD NOT DROP THROUGH HERE 00913000
- TEMPERR CH R15,=H'12' TRYING TO WRITE ON R/O DISK 00914000
- BNE ERR105S NO, SOME OTHER WRITE ERROR 00915000
- B ERR037E YES, TERMINATE WITH MESSAGE 00916000
- EJECT 00917000
- ********************************************************************** 00918000
- * 00919000
- * UTILITY ROUTINE TO READ MACRO DICTIONARY 00920000
- * 00921000
- ********************************************************************** 00922000
- READICT EQU * 00923000
- MVC OUTMODE(2),=CL2' ' DETERMINE IF MACLIB EXISTS 00924000
- LA R1,OUT 00925000
- MVC 0(8,R1),=CL8'STATE' 00926000
- SVC 202 00927000
- DC AL4(NODICT) 00928000
- L TEMP,OUTBUFF GET LOC. OF FST COPY 00929000
- MVC OUTMODE,24(TEMP) SET MODE 00930000
- L TEMP,FVSFSTAD-STATEFST(TEMP) Get ADT for file HRC015DS 00931100
- MVC OUTMODE(1),ADTM SET CORRECT MODE IN PLIST P3043 00932000
- CLC INTYPE(8),=CL8'MAP' IS THIS MAP FUNCTION 00933000
- BE AROUND DON'T CHECK R/W STATUS 00934000
- TM ADTFLG1,ADTFRW IS DISK READ/WRITE 00935000
- BNO ERR037E NO, ERROR 00936000
- AROUND EQU * 00937000
- MVC OUTBUFF,INBUFF RESET BUFFER ADDRESS 00938000
- MVC 0(8,R1),=CL8'RDBUF' READ 1ST RECORD 00939000
- SVC 202 00940000
- DC AL4(ERR104S) 00941000
- CLC BUFFER+3(3),=CL3'***' WAS MACLIB FUNCTION V0516 00942000
- * PREMATURELY ENDED 00943000
- BE ERR167S YES, NOTE THAT FACT V0516 00944000
- CLC BUFFER+3(3),=CL3'LIB' IS IT A LIB FILE 00945000
- BNE ERR456E NO, ERROR 00946000
- CLC BUFFER(3),=CL3'DMS' NEW FORMAT P3043 00947000
- BE NOTOLD YES P3043 00948000
- OI FLAGS2,OLDLIB YES, SET FLAG IN CASE OF COMPACT 00949000
- NOTOLD CLC INTYPE(8),=CL8'MAP' MAP FUNCTION V0516 00950000
- BE AROUND1 YES V0516 00951000
- CLI 0(PLIST),X'FF' COMPRESS FUNCTION V0516 00952000
- BE AROUND1 YES V0516 00953000
- MVC 0(8,R1),=CL8'FINIS' CLOSE FILE FOR READING V0516 00954000
- SVC 202 V0516 00955000
- DC AL4(ERR907T) V0516 00956000
- MVC 0(8,R1),=CL8'WRBUF' SET TO OVERWRITE HEADER OF MACLV0516 00957000
- LA R15,1 SET TO WRITE ITEM 1 V0516 00958000
- STH R15,OUTITNO V0516 00959000
- MVC BUFFER+3(3),=CL3'***' INDICATE MACLIB IS VULNERAV0516 00960000
- SVC 202 V0516 00961000
- DC AL4(ERR105S) V0516 00962000
- MVC 0(8,R1),=CL8'FINIS' RESET FOR READING V0516 00963000
- SVC 202 V0516 00964000
- DC AL4(ERR907T) V0516 00965000
- MVC 0(8,R1),=CL8'RDBUF' RESET COMMAND V0516 00966000
- AROUND1 EQU * V0516 00967000
- SR RG9,RG9 INITIALIZE REG 9 @VA08993 00967100
- ICM RG9,3,BUFFER+10 GET LENGTH OF MACRO DICT. @VA08993 00968100
- ST RG9,MACTBLLG ... 00969000
- L RG7,MACTBLSV GET LOC. OF MACRO DICTIONARY 00970000
- LA RG9,0(RG7,RG9) SET INDEXES 00971000
- LA RG8,72 00972000
- LH INDEX,BUFFER+6 ... 00973000
- N INDEX,MAXHW CLEAR PROPAGATION V0516 00974000
- STH INDEX,DICITEM SAVE INDEX OF DICTIONARY 00975000
- LR SINDEX,INDEX ... 00976000
- RDLOOP CR RG7,RG9 AT END OF DICTIONARY V0516 00977000
- BCR 8,SUBR YES, RETURN V0516 00978000
- STH SINDEX,OUTITNO SET ITEM NO. FOR DICTIONARY V0516 00979000
- SVC 202 00980000
- DC AL4(ERR104S) 00981000
- LA R15,72(,RG7) CHECK FOR TOP OF STORAGE V0516 00982000
- C R15,FREELOWE V0516 00983000
- BH ERR109S ERROR IF ABOVE V0516 00984000
- MVC 0(72,RG7),BUFFER MOVE INTO MACRO DICTIONARY 00985000
- LA SINDEX,1(0,SINDEX) ADVANCE INDEX 00986000
- BXLE RG7,RG8,RDLOOP GET THE ENTIRE DICTIONARY 00987000
- BR SUBR RETURN TO CALLER 00988000
- NODICT CH R15,=H'28' FILE NOT FOUND 00989000
- BE ERR002E YES 00990000
- B ERRETRN 00991000
- EJECT 00992000
- ********************************************************************** 00993000
- * 00994000
- * UTILITY ROUTINE TO SEARCH FOR A MACRO 00995000
- * 00996000
- ********************************************************************** 00997000
- MACSEEK EQU * 00998000
- OI FLAG,NOMEMBER IN CASE WE DELETE LAST MEMBER @VA12809 00998500
- L RG7,MACTBLSV POINT TO MACLIB DICTIONARY 00999000
- LA RG8,12 ENTRY WIDTH 01000000
- L RG9,MACTBLLG GET TABLE LENGTH 01001000
- LA RG9,0(RG7,RG9) POINT TO END OF TABLE 01002000
- SR RG9,RG8 POINT TO LAST ENTRY 01003000
- SEEKLP EQU * @VA13802 01004000
- CLC 0(8,RG7),=8X'00' NO, THEN IS THIS A NULL ENTRY? @VA12809 01005200
- BE CONTSEEK YES, KEEP LOOKING @VA12809 01005400
- NI FLAG,255-NOMEMBER NO, SHOW LIB IS NOT EMPTY @VA12809 01005600
- CONTSEEK EQU * @VA12809 01005800
- CLC 0(8,RG7),0(PLIST) IS THIS THE ONE @VA13802 01005900
- BCR 8,SUBR BR ON YES @VA13802 01005950
- BXLE RG7,RG8,SEEKLP CYCLE UNTIL DONE 01006000
- BR SUBR NOT THERE - COND. CODE STILL SET 01007000
- EJECT 01008000
- XCHECK EQU * @VA04691 01008050
- SPACE 1 01008100
- * THIS SUBROUTINE SETS AN INDEX VALUE IN A DICTIONARY 01008150
- * ENTRY. IT THEN DETERMINES IF PROBLEMS COULD ARISE 01008200
- * FOR OS MACRO SIMULATION (IE, A MEMBER STARTING ON 01008250
- * A RELATIVE ITEM NUMBER WHICH IS A MULTIPLE OF 256). 01008300
- * IF SO, THE RIGHT BYTE OF THE ADDR FIELD IS SET TO 01008350
- * A NON-ZERO VALUE, AND THE WRITE POINTER IS ADJUSTED 01008400
- * ACCORDINGLY. 01008450
- * 01008500
- STH INDEX,8(,MACTBL) SET NEW ITEM NUMBER @VA04691 01008550
- CLI 9(MACTBL),X'00' POTENTIAL PROBLEM? @VA04691 01008600
- BNER R14 EXIT, STAGE RIGHT @VA04691 01008650
- SPACE 1 01008700
- MVI 9(MACTBL),X'01' YES, FIX IT @VA04691 01008750
- LA INDEX,1(,INDEX) ADJUST THE INDEX VALUE @VA04691 01008800
- SPACE 1 01008850
- LA R1,OUT GET THE CURRENT WRITE POINTER @VA04691 01008900
- MVC 0(8,R1),=CL8'STATE' @VA04691 01008950
- SVC 202 @VA04691 01009000
- L R1,OUTBUFF GET FST COPY ADDRESS @VA04691 01009050
- L R1,20(,R1) GET READ AND WRITE POINTERS @VA04691 01009100
- A R1,=X'00010000' RE-ADJUST FOR OS MACRO SIM @VA04691 01009150
- STCM R1,X'F',WRPT MOVE PTRS TO POINT P-LIST @VA04691 01009200
- MVC FPNAM(18),OUTNAME GET NAME, TYPE, AND MODE @VA04691 01009250
- LA R1,PNT SET PARM REGISTER @VA04691 01009300
- SVC 202 ADVANCE THE WRITE POINTER @VA04691 01009350
- DC AL4(ERR105S) ERROR RETURN @VA04691 01009400
- MVC OUTBUFF(4),INBUFF RESTORE P-LIST @VA04691 01009450
- BR R14 RETURN @VA04691 01009500
- EJECT 01009550
- ********************************************************************** 01010000
- * 01011000
- * ERROR ROUTINES 01012000
- * 01013000
- ********************************************************************** 01014000
- SPACE 01015000
- ERR056W LA R3,IN+8 POINT TO MACRO NAME 01016000
- ERR056 DMSERR TEXT=('FILE ''....................'' ', P3080X01017000
- 'CONTAINS INVALID RECORD FORMATS'), P3080X01018000
- NUM=56,LET=E,SUB=(CHAR8A,(R3)) P3080 01019000
- LA ERROR,32 01020000
- STH ERROR,ERRCODE SAVE ERROR CODE V0273 01021000
- TM FLAGS1,X'20' ADD OR REP FUNCTION V0273 01022000
- BNO ERRETRN NO, EXIT V0516 01023000
- LA R1,OUT MACLIB PLIST V0516 01024000
- MVC 0(8,R1),=CL8'POINT' SET FOR POINT FUNCTION V0516 01025000
- XC OUTITNO(4),OUTITNO CLEAR FOR POINT V0516 01026000
- LH INDEX,8(MACTBL) DETERMINE END OF MACLIB MEMBERSV0516 01027000
- N INDEX,MAXHW V0516 01028000
- STH INDEX,OUTITNO SET FOR POINT V0516 01029000
- BCTR INDEX,0 ADJUST FOR GFINI V0516 01030000
- SVC 202 V0516 01031000
- DC AL4(ERR907T) V0516 01032000
- XC OUTITNO(2),OUTITNO V0516 01033000
- MVC OUTBUFF,INBUFF RESTORE BUFFER ADDRESS V0516 01034000
- MVC 0(8,R1),=CL8'WRBUF' RESET FUNCTION NAME V0516 01035000
- B GFINI V0516 01036000
- SPACE 01037000
- ERR213W LA R2,8(0,R1) POINT TO NAME 01038000
- DMSERR TEXT='LIBRARY ''........'' MACLIB NOT CREATED, OR ERASEX01039000
- D IF NO MEMBERS LEFT', @VA12809X01039500
- SUB=(CHARA,(R2)),NUM=213,LET=W 01040000
- LA ERROR,4 01041000
- CH ERROR,ERRCODE WAS THERE A HIGHER CODE V0516 01042000
- BL RETURN YES, USE IT V0516 01043000
- B ERRETRN 01044000
- SPACE 01045000
- ERR001E DMSERR TEXT='NO FILENAME SPECIFIED',NUM=1,LET=E 01046000
- LA ERROR,24 01047000
- B ERRETRN 01048000
- SPACE 01049000
- ERR002E CH R15,=H'28' WAS IT FILE NOT FOUND 01050000
- BNE ERRETRN NO 01051000
- LA R2,8(0,R1) POINT TO NAME 01052000
- DMSERR TEXT='FILE ''........'' MACLIB NOT FOUND', X01053000
- SUB=(CHARA,(R2)),NUM=2,LET=E 01054000
- LA ERROR,28 01055000
- B ERRETRN 01056000
- SPACE 01057000
- ERR003E DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, X01058000
- SUB=(CHARA,(R3)) 01059000
- LA ERROR,24 01060000
- B ERRETRN 01061000
- SPACE 01062000
- ERR002W CH R15,=H'28' FILE NOT FOUND 01063000
- BNE ERRETRN NO 01064000
- LA R10,8(R1) POINT TO NAME 01065000
- DMSERR TEXT='FILE ''........'' NOT FOUND',NUM=2, X01066000
- LET=W,SUB=(CHARA,(R10)) 01067000
- MVC ERRCODE(2),=H'4' SET ERROR CODE 4 01068000
- B GLOOP1 CHECK NEXT INPUT FILE 01069000
- SPACE 01070000
- ERR013W LA R2,OUTNAME MACLIB NAME 01071000
- DMSERR TEXT=('MEMBER ''........'' NOT FOUND IN ', @VA00822X01072000
- 'LIBRARY ''....................'''), @VA00822X01073000
- NUM=13,LET=W,MF=(E,MACERR), @VA00822X01074000
- SUB=(CHAR8A,(R6),CHAR8A,(R2)) @VA00822 01075000
- MVC ERRCODE(2),=H'4' SET ERROR CODE 4 01076000
- BR SUBR RETURN 01077000
- SPACE 01078000
- ERR014E DMSERR TEXT='INVALID FUNCTION ''........''',LET=E,NUM=14, X01079000
- SUB=(CHARA,(R3)) 01080000
- LA ERROR,24 01081000
- B ERRETRN 01082000
- SPACE 01083000
- ERR037E LA R3,OUTMODE POINT TO MODE 01084000
- ERR37 DMSERR TEXT='DISK ''..'' IS READ/ONLY',NUM=37, X01085000
- LET=E,SUB=(CHARA,((R3),1)) 01086000
- LA ERROR,36 01087000
- B ERRETRN 01088000
- SPACE 01089000
- SPACE 01090000
- ERR047E DMSERR TEXT='NO FUNCTION SPECIFIED',NUM=47,LET=E 01091000
- LA ERROR,24 01092000
- B ERRETRN 01093000
- SPACE 01094000
- ERR046E DMSERR TEXT='NO LIBRARY NAME SPECIFIED',NUM=46,LET=E 01095000
- LA ERROR,24 01096000
- B ERRETRN 01097000
- SPACE 01098000
- ERR456E LA R3,OUTNAME POINT TO FILE NAME 01099000
- B ERR056 01100000
- SPACE 1 @VA07183 01100100
- ERR069 EQU * @VA07183 01100200
- LA R3,IN+TWO4 GET ADDRESS OF MODE @VA07183 01100300
- DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, C01100400
- LET=E,SUB=(CHARA,((R3),1)) @VA07183 01100500
- LA ERROR,THREE6 SET ERROR CODE @VA07183 01100600
- B LASTGO AND EXIT @VA07183 01100700
- SPACE 1 @VA07183 01100800
- ERR070E DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70, X01101000
- LET=E,SUB=(CHAR8A,(PLIST)) 01102000
- LA ERROR,24 01103000
- B ERRETRN 01104000
- SPACE 01105000
- SPACE 01106000
- ERR104S LA R2,8(0,R1) POINT TO FILE ID V0314 01107000
- LR R10,R15 V0314 01108000
- DMSERR TEXT=('ERROR ''..'' READING FILE ', V0314X01109000
- '''..................'' FROM DISK'), V0314X01110000
- NUM=104,LET=S, V0314X01111000
- SUB=(DEC,(R10),CHAR8A,(R2)),MF=(E,MACERR) V0314 01112000
- LA ERROR,100 01113000
- B ERRETRN 01114000
- SPACE 01115000
- ERR105S LA R2,OUTNAME ADDR OF FILE NAME 01116000
- LR R3,R15 ERROR CODE FROM WRBUF 01117000
- DMSERR TEXT='ERROR ''...'' WRITING FILE ''..................''X01118000
- ON DISK',NUM=105,LET=S,SUB=(DEC,(R3),CHAR8A,(R2)), X01119000
- MF=(E,MACERR) 01120000
- LA ERROR,100 01121000
- B ERRETRN 01122000
- SPACE 01123000
- ERR109S DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED', V0516X01124000
- NUM=109,LET=S V0516 01125000
- LA ERROR,104 V0516 01126000
- TM FLAGS1,X'20' WERE ADDITIONS BEING MADE V0516 01127000
- BNO ERRETRN NO, EXIT V0516 01128000
- STH ERROR,ERRCODE SAVE ERROR CODE V0516 01129000
- B GFINI WRITE OUT DICTIONARY V0516 01130000
- ERR907T DMSERR TEXT='I/O ERROR ON FILE ''..................''', X01131000
- NUM=907,LET=T,SUB=(CHAR8A,(R2)) 01132000
- LA ERROR,256 01133000
- B ERRETRN 01134000
- ERR157S SH MACTBL,=H'12' BACK UP TO LAST ADD V0516 01135000
- LA R15,LONGMSG LENGTH FOR FULL ERROR MSG V0516 01136000
- C MACTBL,MACTBLSV WAS THIS 1ST ADDITION V0516 01137000
- BNL SETLNTH NO V0516 01138000
- LA R15,SHRTMSG YES, SET FOR SHORT MSG V0516 01139000
- SETLNTH STC R15,MSG157 SET LENGTH V0516 01140000
- DMSERR TEXTA=MSG157,LET=S,NUM=157, V0516X01141000
- SUB=(CHAR8A,(MACTBL)) V0516 01142000
- LA ERROR,88 V0516 01143000
- STH ERROR,ERRCODE V0516 01144000
- B GFINI WRITE OUT DICTIONARY V0516 01145000
- MSG157 DC X'00' LENGTH BYTE V0516 01146000
- BEGIN157 DC C'MACLIB LIMIT EXCEEDED' V0516 01147000
- MID157 DC C', LAST MEMBER ADDED WAS ''........''' V0516 01148000
- SHRTMSG EQU MID157-BEGIN157 V0516 01149000
- LONGMSG EQU *-BEGIN157 V0516 01150000
- ERR167S DMSERR TEXT='PREVIOUS MACLIB FUNCTION NOT FINISHED', V0516X01151000
- NUM=167,LET=S V0516 01152000
- LA ERROR,88 V0516 01153000
- B ERRETRN EXIT V0516 01154000
- EJECT 01155100
- ********************************************************************** 01156000
- * 01157000
- * RETURN ROUTINES 01158000
- * 01159000
- ********************************************************************** 01160000
- RETURN LH ERROR,ERRCODE SET ANY ERROR CODE 01161000
- ERRETRN EQU * 01162000
- XC OUTITNO(4),OUTITNO CLEAR ITEM NUMBER 01163000
- LA R1,OUT CLOSE OUT FILE 01164000
- MVC 0(8,R1),=CL8'FINIS' 01165000
- SVC 202 01166000
- DC AL4(*+4) 01167000
- XC OUTITNO(4),OUTITNO CLEAR ITEM NUMBER 01168000
- CLC OUTNAME(16),TEMPNAME WAS THIS A COMPACT 01169000
- BE COMPFIN BR ON YES TO END IT 01170000
- LASTGO EQU * COMPACT REJOINS HERE 01171000
- LR 15,ERROR SET ERROR CODE 01172000
- L R14,R14SAVE RESTORE LINKAGE REGISTER @VA04691 01172100
- DMSEXS OI,MISFLAGS,RELPAGES INDICATE PAGE RELEASE 01173000
- BR 14 RETURN 01174000
- * 01175000
- COMPFIN EQU * 01176000
- LA R1,IN CLOSE IN FILE 01177000
- MVC 0(8,R1),=CL8'FINIS' 01178000
- SVC 202 01179000
- DC AL4(*+4) 01180000
- LTR ERROR,ERROR WERE THERE ANY ERRORS 01181000
- BNZ LASTGO BR ON YES - DO NOTHING 01182000
- LA R1,IN 01184000
- MVC 0(8,R1),=CL8'ERASE' 01185000
- SVC 202 01186000
- DC AL4(*+4) 01187000
- MVC OUT+32(17),IN+8 GET OLD MACLIB NAME,TYPE AND MODE JR 01188000
- MVC OUT+49(1),IN+25 MOVE IN FILEMODE NUMBER @VA02961 01189000
- MVC OUT+56(4),=4X'FF' SEAL OFF PLIST 01190000
- LA R1,OUT DO RENAME 01191000
- MVC 0(8,R1),=CL8'RENAME' 01192000
- SVC 202 01193000
- DC AL4(*+4) 01194000
- B LASTGO ALL DONE - READY TO LEAVE 01195000
- EJECT 01196000
- *********************************************************************** 01197000
- * 01198000
- * DEFINITIONS + CONSTANTS 01199000
- * 01200000
- *********************************************************************** 01201000
- * 01202000
- * INPUT DISK PARAMETER LIST 01203000
- * 01204000
- DS 0D 01205000
- IN EQU * 01206000
- INCOMM DC CL8'*' COMMAND 01207000
- INNAME DC CL8'*' FILE NAME 01208000
- INTYPE DC CL8'MACRO' FILE TYPE 01209000
- INMODE DC CL2'A1' FILE MODE 01210000
- INITNO DC H'0' ITEM NUMBER 01211000
- INBUFF DC A(BUFFER) BUFFER AREA 01212000
- INSIZE DC A(80) BUFFER SIZE 01213000
- INFV DC CL2'F' FIXED/VARIABLE FLAG 01214000
- INNOIT DC H'1' NUMBER OF ITEMS 01215000
- INNORD DC F'0' NUMBER OF BYTES ACTUALLY READ 01216000
- * 01217000
- * OUTPUT DISK PARAMTER LIST 01218000
- * 01219000
- DS 0D 01220000
- OUT EQU * 01221000
- OUTCOMM DC CL8'*' 01222000
- OUTNAME DC CL8'*' 01223000
- OUTTYPE DC CL8'MACLIB' 01224000
- OUTMODE DC CL2'A1' 01225000
- OUTITNO DC H'0' 01226000
- OUTBUFF DC A(BUFFER) 01227000
- OUTSIZE DC A(80) 01228000
- OUTFV DC CL2'F' 01229000
- OUTNOIT DC H'1' 01230000
- OUTORD DC F'0' 01231000
- SLASHAST DC CL2'/*' @VM03253 01232000
- END DC CL3'END' @VM03253 01233000
- CATALS DC CL6'CATALS' @VM03253 01234000
- * 01235000
- * POINT PLIST 01236000
- * 01237000
- DS 0F 01238000
- PNT DC CL8'POINT' 01239000
- FPNAM DC CL8' ' FILENAME 01240000
- FPTYP DC CL8' ' FILETYPE 01241000
- FPMOD DC CL2' ' FILEMODE 01242000
- WRPT DC H'0' WRITE POINTER.. 01243000
- RDPT DC H'1' READ POINTER.. 01244000
- * 01245000
- DS 0D 01246000
- * 01247000
- * CARD BUFFER 01248000
- * 01249000
- DS 0F 01250000
- BUFFER DS CL80 01251000
- * 01252000
- * OFFLINE PRINT LINBAME MAP PLIST 01253000
- * 01254000
- OP DS 3D 01255000
- DC CL8' ' @VA03054 01256000
- DC 8X'FF' FENCE @VA03054 01257000
- ERRCODE DS H 01258000
- * 01259000
- * 01260000
- * MACRO DICTIONARY PRINT AREA 01261000
- * 01262000
- DS 0D 01263000
- MACPRT DC CL8'TYPLIN' 01264000
- DC AL1(1) 01265000
- DC AL3(MACBUF) 01266000
- DC C'B' 01267000
- DC AL3(L'MACBUF) 01268000
- MACBUF DC CL20' ' DL 01269000
- PMAC EQU MACBUF 01270000
- PNDX EQU MACBUF+9 01271000
- PSZE EQU MACBUF+14 01272000
- DOUBLE DS 1D 01273000
- * 01274000
- MAXHW DC X'0000FFFF' V0516 01275000
- ERASE DC CL8'ERASE' @VA07183 01275200
- EIGHT EQU 8 @VA07183 01275400
- TWO4 EQU 24 @VA07183 01275600
- THREE6 EQU 36 @VA07183 01275800
- FLAG DC X'00' FLAG BYTE @VA12809 01275830
- NOMEMBER EQU X'08' NO MEMBERS LEFT IN LIBRARY @VA12809 01275860
- EJECT DL 01276000
- ADFREE DC A(DMSLBM+4096) 01277000
- LTORG DL 01278000
- EJECT 01279000
- * 01280000
- * DEFINITIONS 01281000
- * 01282000
- TEMP EQU 2 01283000
- PLIST EQU 3 01284000
- MACTBL EQU 6 01285000
- RG7 EQU 7 01286000
- RG8 EQU 8 01287000
- RG9 EQU 9 01288000
- ERROR EQU 10 01289000
- SWT EQU 10 01290000
- SUBR EQU 11 01291000
- INDEX EQU 12 01292000
- SINDEX EQU 13 01293000
- * 01294000
- * COMMAND TABLE 01295000
- * 01296000
- COMDS DS 0F 01297000
- DC CL8'GEN' 01298000
- DC A(GEN) 01299000
- DC CL8'ADD' 01300000
- DC A(ADD) 01301000
- DC CL8'REP' 01302000
- DC A(REPLACE) 01303000
- DC CL8'COMP' 01304000
- DC A(COMPACT) 01305000
- DC CL8'DEL' 01306000
- DC A(DELETE) 01307000
- DC CL8'MAP' 01308000
- DC A(MAP1) 01309000
- COMDSN EQU * 01310000
- COMLOOK DC A(COMDS,12,COMDSN-12) 01311000
- COPYSAVE DC D'0' NAME OF COPY ENTRY SAVE HERE 01312000
- TEMST DC D'0' WRITE READ POINTERS SAVED HERE 01313000
- R14SAVE DS F LINKAGE REGISTER SAVED HERE @VA04691 01313100
- * 01314000
- * FLAGS 01315000
- * 01316000
- CONFLG DC CL1'0' IN CASE A CONTINUATION CARD @VA02823 01317000
- FLAGS DS CL1 01318000
- FLAGS1 DC X'00' 01319000
- MACNXT EQU X'80' 01320000
- MENDNXT EQU X'40' 01321000
- FLAGS2 DC X'00' @VA03532 01322000
- OLDLIB EQU X'80' LIBRARY IS OLD FORMAT 01323000
- CKVAL EQU X'40' VALIDITY CHECK (ROOM LEFT ON @VA03532 01324000
- * DISK) 01325000
- TEMPST DS H 01326000
- TOTAL DC F'0' SAVE AREA FOR ROOM LEFT ON DISK @VA03532 01327000
- EJECT 01328000
- * CONSTANTS 01329000
- * 01330000
- MACPRTX DC C'B',AL3(L'MACBUF) 01331000
- MASK DC X'402020202021402020202021' DL 01332000
- MAPHDR DC CL20'MACRO INDEX SIZE' DL 01333000
- TEMPNAME DC CL8'MACLIB' 01334000
- DC CL8'CMSUT1' 01335000
- DC CL2'A1' MODE FOR TEMPORARY FILE JR 01336000
- MACERR DMSERR MAXSUBS=2,MF=L ERROR PARAMETER AREA 01337000
- DICITEM DC H'0' INDEX OF DICTIONARY 01338000
- BLFIND DC 256X'00' BLANK TRANSLATE-TEST TABLE 01339000
- ORG BLFIND+C' ' 01340000
- DC X'FF' 01341000
- ORG BLFIND+256 01342000
- CSCOPY DC CL6'*COPY ' COPY CONTROL STATEMENT DEFINITION@VA04690 01342100
- MACTBLSV DC A(MACTBLLC) 01343000
- MACTBLLG DC F'0' TR 01344000
- MACTBLLC EQU * DICTIONARY BUFFER V0516 01345000
- EJECT 01346000
- NUCON 01347000
- SPACE 01348000
- ADT 01349000
- FSTB V0516 01350000
- FVS HRC015DS 01350100
- END 01351000
ibm/vm370-lib/cms/dmslbm.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator