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