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