TMA TITLE 'DMSTMA (CMS) VM/370 - RELEASE 6' 00001000
*. 00002000
* MODULE NAME: 00003000
* 00004000
* DMSTMA (TAPEMAC) 00005000
* 00006000
* FUNCTION: 00007000
* 00008000
* READ AN IEHMOVE UNLOADED PDS FROM TAPE AND PLACE IT IN 00009000
* CMS MACLIB(S). 00010000
* 00011000
* ATTRIBUTES: 00012000
* 00013000
* DISK RESIDENT 00014000
* 00015000
* ENTRY POINTS: 00016000
* 00017000
* DMSTMA 00018000
* 00019000
* ENTRY CONDITIONS: 00020000
* 00021000
* R1 = A(PLIST) 00022000
* PLIST DC CL8'MODULE NAME' 00023000
* DC CL8'FNAME' 00024000
* DC CL8'(' INDICATES START OF OPTIONS 00025000
* DC CL8'TAP1|TAPF|ITEMCT XXXXX' HRC002DS 00026490
* 00027000
* EXIT CONDITIONS: 00028000
* NORMAL 00029000
* R15 = 0 - NO ERRORS 00030000
* R15 ¬= 0 - ERROR AS DESCRIBED BELOW 00031000
* 00032000
* MESSAGES: RETURN CODES: 00033000
* 00034000
* DMSTMA001E NO FILENAME SPECIFIED 24 00035000
* DMSTMA003E INVALID OPTION OPT 24 00036000
* DMSTMA057E INVALID RECORD FORMAT 32 00037000
* DMSTMA070E INVALID PARAMETER PARM 24 00038000
* DMSTMA105S ERROR XXX WRITING FILE FN FT ON DISK 100 00039000
* DMSTMA109S VIRTUAL STORAGE CAPACITY EXCEEDED 104 00040000
* DMSTMA110S ERROR READING TAPX 100 00041000
* DMSTMA137S ERROR XXX ON STATE FOR FN FT 100 00042000
* DMSTMA138S ERROR XXX ERASING FN FT BEFORE LOADING TAPE 100 00043000
* DMSTMA139S TAPE FILE EXCEEDS 9 CMS MACLIBS 104 00044000
* 00045000
* CALLS TO OTHER ROUTINES: 00046000
* 00047000
* DMSBWR, DMSFNS, DMSAUD, DMSERS, DMSCWR, DMSERR, DMSTIO 00048000
* 00049000
* EXTERNAL REFERENCES: 00050000
* 00051000
* NONE 00052000
* 00053000
* TABLES/WORKAREAS 00054000
* 00055000
* PLISTS FOR VARIOUS CALLS TO OTHER ROUTINES 00056000
* BUFFERS FOR TAPE READS, RECORD DEBLOCKING, DISK WRITES 00057000
* 00058000
* REGISTER USAGE 00059000
* 00060000
* R1 = A(PLIST) 00061000
* R3 = A(IEHMOVE RECORD BEING PROCESSED) 00062000
* R5 = A(NEXT AVAILABLE DICTIONARY ENTRY) 00063000
* R9 = LENGTH OF CURRENT IEHMOVE RECORD 00064000
* R10 = INTERNAL LINKAGE 00065000
* R11 = CMS FILE ITEM NUMBERS 00066000
* R12 = BASE REGISTER 00067000
* 00068000
* OPERATION: 00069000
* 00070000
* 1. VALIDATE PARAMETERS AND OPTIONS PASSED BY THE USER. IF 00071000
* ALL OK, ISSUE A GETMAIN FOR UP TO 32768 BYTES OF STORAGE. 00072000
* FROM STORAGE OBTAINED, BREAK OFF A 4096 BYTE SECTION 00073000
* FOR MAINTAINING THE MACLIB DICTIONARY. REMAINDER OF THE 00074000
* BUFFER WILL BE SPLIT FURTHER INTO A BUFFER FOR TAPE I/O 00075000
* AND IEHMOVE RECORD RECONSTRUCTION. 00076000
* 00077000
* 2. READ THE TAPE, DISPLAYING ANY 'VOL' AND 'HDR' RECORDS 00078000
* AT THE USER'S TERMINAL, UNTIL A NON-LABEL TYPE RECORD IS 00079000
* FOUND. VERIFY THAT THE TAPE CONTAINS AN UNLOADED PDS 00080000
* CREATED BY IEHMOVE AND RETRIEVE PERTINENT INFO FROM THE 00081000
* DSCB. CONTINUE TO SCAN THE TAPE UNTIL A MEMBER HEADER 00082000
* RECORD IS FOUND. 00083000
* 00084000
* 3. SET UP NECESSARY PARAMETER INFO TO WRITE THE DISK FILE 00085000
* AND WRITE A DUMMY 80 BYTE HEADER RECORD TO THE FILE. 00086000
* 00087000
* 4. MOVE THE MEMBER NAME FROM THE MEMBER HDR RECORD ON 00088000
* TAPE INTO THE CURRENT DICTIONARY ENTRY AND SAVE THE ITEM 00089000
* NUMBER OF THE FIRST DATA RECORD TO BE WRITTEN IN THE 00090000
* DICTIONARY ENTRY. 00091000
* 00092000
* 5. RECONSTRUCT THE NEXT IEHMOVE RECORD IN CORE AND TEST 00093000
* IT'S TYPE. IF IT IS A DATA RECORD, WRITE THE RESULTING 80 00094000
* BYTE DATA RECORDS TO THE DISK FILE. IF IT IS A MEMBER 00095000
* HEADER RECORD GO TO STEP 3. OTHERWISE, IGNORE THE RECORD 00096000
* AND REPEAT THIS STEP. 00097000
* 00098000
* 6. IF THE NUMBER OF ITEMS (80 BYTE RECORDS) EXCEEDS 00099000
* THE VALUE OF ITEMCT (DEFAULT = 50000), 00100000
* OR THE DICTIONARY BUFFER BECOMES FULL, THE CHARACTER '2' IS 00101000
* APPENDED TO THE FILE NAME (OVERLAYS LAST CHARACTER IF FN=8 00102000
* CHARACTERS) AND PROCESSING CONTINUES. IF 9 MACLIBS ARE 00103000
* THUSLY FILLED UP, PROCESSING TERMINATES WITH AN ERROR 00104000
* MESSAGE. 00105000
* 00106000
* 7. AFTER DETERMINING THE NEXT NAME TO USE, THE DICTIONARY 00107000
* FOR THE CURRENT LIBRARY IS PREPARED AND WRITTEN AT THE END 00108000
* OF THE FILE AND THE MACLIB HEADER RECORD IS BUILT AND 00109000
* WRITTEN OVER THE DUMMY HEADER RECORD PUT OUT AT THE 00110000
* BEGINNING. A CHECK IS MADE TO SEE IF THIS STEP WAS ENTERED 00111000
* AS A RESULT OF AN EOF ON TAPE. IF SO, PROGRAM EXECUTION 00112000
* RETURNS CONTROL TO THE USER. IF NOT, EXECUTION PROCEEDS 00113000
* STEP 3. 00114000
* 00115000
*. 00116000
EJECT 00117000
DMSTMA CSECT @V305238 00118000
USING DMSTMA,R12 @V305238 00119000
LR R12,R15 GET ADDRESSABILITY @V305238 00120000
LA R1,8(,R1) STEP OVER THE MODULE NM @V305238 00121000
TM 0(R1),X'FF' ANY PARMS AT ALL? @V305238 00122000
BO ERROR01 NO ERROR MSG AND EXIT @V305238 00123000
CLI 0(R1),C'(' WILL TAPE ADDR BE NEXT @V305238 00124000
BE ERROR01 THAT'S ALSO AN ERROR @V305238 00125000
MVC FN1(8),0(R1) MOVE IN THE NAME @V305238 00126000
LA R1,8(,R1) ADVANCE TO NEXT PARM @V305238 00127000
CLI 0(R1),X'FF' ANYMORE ANYTHING? @V305238 00128000
BE GETCORE NO - GO GET SOME STORAGE @V305238 00129000
CLI 0(R1),C'(' BETTER BE OPTIONS FOLLOWING @V305238 00130000
BNE ERROR70 ILLEGAL CALLING SEQUENCE @VM03122 00131000
SPACE 2 00132000
SRCHOPT LA R1,8(R1) REPOSITION ON THE OPTION @V305238 00133000
LA R3,OPTABB @V305238 00134000
LA R4,OPTABL @V305238 00135000
LA R5,OPTABE @V305238 00136000
SPACE 00137000
FINDOPT CLC 0(8,R1),0(R3) IS THIS THE OPTION? @V305238 00138000
BNE BXLE1 NOPE, KEEP LOOKIN @V305238 00139000
LH R3,8(R3) GET DISPLACEMENT TO ROUTINE @V305238 00140000
B 0(R3,R12) AND GO TO IT. @V305238 00141000
BXLE1 BXLE R3,R4,FINDOPT CONTINUE TO SEARCH @V305238 00142000
B ERROR03 INVALID OPTION @V305238 00143000
SPACE 3 00144000
OPTABB DC C'TAP0 ',AL2(SETTPAD-DMSTMA) HRC002DS 00145290
DC C'TAP1 ',AL2(SETTPAD-DMSTMA) HRC002DS 00145580
DC C'TAP2 ',AL2(SETTPAD-DMSTMA) @V305238 00146000
DC C'TAP3 ',AL2(SETTPAD-DMSTMA) @V305238 00147000
DC C'TAP4 ',AL2(SETTPAD-DMSTMA) @V305238 00148000
DC C'TAP5 ',AL2(SETTPAD-DMSTMA) HRC002DS 00148080
DC C'TAP6 ',AL2(SETTPAD-DMSTMA) HRC002DS 00148160
DC C'TAP7 ',AL2(SETTPAD-DMSTMA) HRC002DS 00148240
DC C'TAP8 ',AL2(SETTPAD-DMSTMA) HRC002DS 00148320
DC C'TAP9 ',AL2(SETTPAD-DMSTMA) HRC002DS 00148400
DC C'TAPA ',AL2(SETTPAD-DMSTMA) HRC002DS 00148480
DC C'TAPB ',AL2(SETTPAD-DMSTMA) HRC002DS 00148560
DC C'TAPC ',AL2(SETTPAD-DMSTMA) HRC002DS 00148640
DC C'TAPD ',AL2(SETTPAD-DMSTMA) HRC002DS 00148720
DC C'TAPE ',AL2(SETTPAD-DMSTMA) HRC002DS 00148800
DC C'TAPF ',AL2(SETTPAD-DMSTMA) HRC002DS 00148880
DC C'ITEMCT ',AL2(SETITEM-DMSTMA) @V305238 00149000
DC C') ',AL2(GETCORE-DMSTMA) @V305238 00150000
OPTABE DC 8X'FF',AL2(GETCORE-DMSTMA) @V305238 00151000
OPTABL EQU *-OPTABE SIZE OF AN ENTRY @V305238 00152000
EJECT 00153000
SETTPAD EQU * @V305238 00154000
MVC TAPEID(4),0(R1) OK - SAVE IN THE PLIST @V305238 00155000
B SRCHOPT KEEP LOOKIN' FOR OPTIONS @V305238 00156000
SPACE 2 00157000
SETITEM LA R1,8(R1) INCREMENT TO THE ITEM COUNT @V305238 00158000
BAL R15,SCANUMB GO SCAN THE ITEM COUNT @V305238 00159000
BNZ ERROR70 NONE THERE, TOO BAD @VM03122 00160000
CL R2,=F'4' MORE THAN 5 DIGITS ENTERED? @V305238 00161000
BH ERROR70 YUP, TOOBAD. @VM03122 00162000
LA R2,X'70'(R2) FOR PACK INSTRUCTION, L1 @V305238 00163000
EX R2,PACK PACK THE ITEM COUNT @V305238 00164000
CVB R2,PACKED CONVERT IT TO BINARY @V305238 00165000
CL R2,=F'62500' CAN'T BE TOO BIG... @V305238 00166000
BH ERROR70 TOOBAD. @VM03122 00167000
ST R2,CUTOFF SAVE IT @V305238 00168000
B SRCHOPT CONTINUE WITH NEXT OPTION @V305238 00169000
SPACE 00170000
PACK PACK PACKED(*-*),0(*-*,R1) PACK OPTION COUNT @V305238 00171000
SPACE 3 00172000
SCANUMB LA R3,8 MAX SIZE OF COUNT @V305238 00173000
LR R2,R1 SET BEGINNING ADDRESS @V305238 00174000
NEXTCHAR CLI 0(R2),C' ' IS IT THE END OF THE FIELD? @V305238 00175000
BE FNDBLK YUP, BR @V305238 00176000
CLI 0(R2),C'0' IS IT LESS THAN A ZERO? @V305238 00177000
BL SETCC3 YUP, BAD NEWS @V305238 00178000
CLI 0(R2),C'9' BIGGER THAN A NINE? @V305238 00179000
BH SETCC3 YUP, BAD NEWS @V305238 00180000
LA R2,1(R2) INCREMENT TO NEXT CHARACTER @V305238 00181000
BCT R3,NEXTCHAR KEEP LOOKING @V305238 00182000
SPACE 00183000
FNDBLK SR R2,R1 GET THE FIELD SIZE @V305238 00184000
BZ SETCC1 ITS NULL, SO INDICATE @V305238 00185000
BCTR R2,0 DECREMENT BY ONE FOR USE WITH EX @V305238 00186000
SETCC0 TM *+1,X'00' SET CONDITION CODE 0 @V305238 00187000
BR R15 AND RETURN @V305238 00188000
SETCC1 TM *+0,X'FF' SET CONDITION CODE 1 @V305238 00189000
BR R15 AND RETURN @V305238 00190000
SETCC2 CLI *+0,X'00' SET CONDITION CODE 2 @V305238 00191000
BR R15 AND RETURN @V305238 00192000
SETCC3 TM *+1,X'FF' SET CONDITION CODE 3 @V305238 00193000
BR R15 AND RETURN @V305238 00194000
EJECT 00195000
GETCORE EQU * @V305238 00196000
GETMAIN VC,LA=SZLIST,A=GMBUFF @V305238 00197000
L R3,GMBUFF GET BUFFER ADDRESS @V305238 00198000
ST R3,DICTBUFF SAVE AS DICT STRT ADDR @V305238 00199000
LA R4,(4096-12)(,R3) ADDRESS OF LAST ENTRY @V305238 00200000
ST R4,ENDDICT SAVE IT @V305238 00201000
LA R4,12(,R4) END OF DICTIONARY AREA @V305238 00202000
STCM R4,7,TPBUFFAD SAVE AS TAPE BUFF STRT @V305238 00203000
A R3,GMBUFF+4 CALC END OF GETMAIN AREA @V305238 00204000
ST R3,TPBUFFND SAVE IT FOR LATER @V305238 00205000
SR R3,R4 GETMAIN AREA - DICT AREA @V305238 00206000
ST R3,TPBUFFSZ SAVE IN TAPE PLIST @V305238 00207000
* 00208000
* READ TAPE UNTIL NON-HEADER RECORD FOUND 00209000
* 00210000
RDHDR EQU * @V305238 00211000
LA R1,TAPLIST LOAD PLIST ADDR @V305238 00212000
SVC 202 CALL DMSTIO @V305238 00213000
DC AL4(ERROR110) ERROR RETURN ADDRESS @V305238 00214000
TM CSW+5(R0),ILI INCORRECT LENGTH??? @V305238 00215000
BZ NOTILI NO @V305238 00216000
CLC CSW+6(2,R0),H0 YES - ANYTHING READ AT ALL? @V305238 00217000
BE GIVE110 NO - ARGH! @V305238 00218000
NOTILI EQU * @V305238 00219000
ICM R6,7,TPBUFFAD GET BUFFER ADDRESS @V305238 00220000
CLC 0(3,R6),VOL VOLUME HEADER? @V305238 00221000
BE RDHDR YES - 'HDR' DUE NEXT @V305238 00222000
CLC 0(3,R6),HDR IS IT 'HDR' RECORD? @V305238 00223000
BNE CHKIEHMV NO - SEE IF IEHMOVE HDR @V305238 00224000
LA R1,TYPLIST YES - DISPLAY THE HDR @V305238 00225000
STCM R6,7,TYPBUFAD STORE BUFFER ADDR IN LIST @V305238 00226000
MVC TYPCNT(3),TPCNT+1 LENGTH OF THE DATA @V305238 00227000
SVC 202 @V305238 00228000
DC AL4(*+4) ASSUME NO ERRORS @V305238 00229000
B RDHDR GO READ NEXT RECORD @V305238 00230000
EJECT 00231000
* 00232000
* AFTER VERIFYING TAPE WAS CREATED BY IEHMOVE, WRITE A DUMMY 80 BYTE 00233000
* MACLIB HEADER RECORD, READ FROM TAPE AND RECONSTRUCT IEHMOVE 00234000
* INFORMATION IN CORE. WHEN COMPLETE RECORD IS ASSEMBLED, WRITE 00235000
* RESULTANT NUMBER OF 80 BYTE DATA RECORDS TO THE CMS FILE. 00236000
* 00237000
CHKIEHMV EQU * @V305238 00238000
OI SWITCHES,NHDR SHOW NON HDR REC READ @V305238 00239000
CLC 0(2,R6),H1 LOOK LIKE AN UNLOADED PDS? @V305238 00240000
BNE ERROR57 NO - MSG TO USER & EXIT @V305238 00241000
L R4,TPCNT YES - GET TAPE RECORD SIZE @V305238 00242000
LA R4,0(R4,R6) CALC END OF REC IN CORE @V305238 00243000
ST R4,BLDBUFF SAVE AS START OF BUILD AREA @V305238 00244000
ST R4,BLDEND SAVE HERE TOO @V305238 00245000
BAL R10,STRIP2 GO STRIP OFF UNWANTED CHARS @V305238 00246000
* IF RECORD N.G. STRIP2 WILL NOT RETURN HERE 00247000
L R3,BLDBUFF POINT TO STRT OF BLD AREA @V305238 00248000
LA R9,75 GET EXPECTED REC LENGTH @V305238 00249000
CH R9,0(,R3) MATCH?? @V305238 00250000
BNE ERROR57 NOPE - THATS TOO BAD @V305238 00251000
LA R9,3(,R9) YES - BUMP LENGTH @V305238 00252000
CLC 3(75,R3),IEHMVHDR IS HDR INFO THERE? @V305238 00253000
BNE ERROR57 NO - MSG TO USER AND PUNT @V305238 00254000
BAL R10,NEXTR GET NEXT IEHMOVE RECORD @V305238 00255000
* (IT SHOULD BE THE DSCB) 00256000
TM 87(R3),FXD FIXED LENGTH RECORDS?? @V305238 00257000
BZ ERROR57 NO - CAN'T USE IT THEN @V305238 00258000
TM 87(R3),BLK ARE THE RECORDS BLOCKED? @V305238 00259000
BZ LOCMEM NOPE @V305238 00260000
OI SWITCHES,BLK YES - REMEMBER IT @V305238 00261000
CLC 91(2,R3),F80+2 IS LRECL 80?? @V305238 00262000
BNE ERROR57 GULP! @V305238 00263000
LOCMEM EQU * LOCATE FIRST MEMBER HDR @V305238 00264000
BAL R10,NEXTR GET THE NEXT RECORD @V305238 00265000
TM 2(R3),MEMREC IS THIS A MEMBER HDR? @V305238 00266000
BZ LOCMEM NO - KEEP LOOKING @V305238 00267000
SPACE 2 00268000
STRTLIB EQU * @V305238 00269000
MVC MACFN(8),FN1 PUT FILENAME IN PLISTS @V305238 00270000
MVC STATELST+8(8),FN1 . . . @V305238 00271000
MVC STATELST(8),STATEW CHANGE CMD TO 'STATEW' @V305238 00272000
LA R1,STATELST CALL DMSSTT TO SEE IF @V305238 00273000
SVC 202 THE FILE ALREADY EXITS @V305238 00274000
DC AL4(*+4) RETURN HERE REGARDLESS @V305238 00275000
CH R15,H28 DID FILE EXIST? @V305238 00276000
BE NEWLIB NO - START THE PROCESS @V305238 00277000
LTR R15,R15 ANY OTHER ERRORS? @V305238 00278000
BNZ ERROR137 YES - GAK @V305238 00279000
MVC STATELST(8),ERASE ERASE THE OLD FILE @V305238 00280000
SVC 202 (R1 ALREADY SET UP) @V305238 00281000
DC AL4(ERROR138) MAYBE READ ONLY DISK??? @V305238 00282000
EJECT 00283000
* 00284000
* START BY WRITING A DUMMY 80 BYTE HEADER RECORD 00285000
* 00286000
NEWLIB EQU * @V305238 00287000
BAL R10,LMSG GO TELL HIM WHAT MACLIB WERE BLDG@VM03122 00288000
MVI REC1BUF,X'40' CLEAR BUFFER @V305238 00289000
MVC REC1BUF+1(79),REC1BUF . . . @V305238 00290000
MVC REC1BUF(3),ASTERS INVALID HDR IN CASE PROBS @V305238 00291000
LA R1,REC1BUF SO MACLIB UNUSABLE @V305238 00292000
ST R1,MACBUFF SET DATA ADDRESS @V305238 00293000
LA R1,MACWRT PLIST ADDRESS @V305238 00294000
SVC 202 CALL DMSBWR @V305238 00295000
DC AL4(ERROR105) ERROR RETURN ADDRESS @V305238 00296000
L R5,DICTBUFF GET START OF DICT. BUFFER @V305238 00297000
LA R11,2 SET ITEM COUNT TO 2 @V305238 00298000
NEWMAC EQU * @V305238 00299000
TM SWITCHES,AT1MAC HAS A MACRO BEEN WRITTEN? @V305238 00300000
BZ NEWMAC1 NO - BYPASS NEXT SECTION @V305238 00301000
MVI REC1BUF,X'40' YES - CLEAR 80 BYTE BUFFER @V305238 00302000
MVC REC1BUF+1(79),REC1BUF . . . @V305238 00303000
MVC REC1BUF(4),SLASHREC WRITE SPEC ENDING REC @V305238 00304000
LA R1,REC1BUF @V305238 00305000
ST R1,MACBUFF @V305238 00306000
MVC MACNOIT(2),H1 ONLY WRITING 1 RECORD @V305238 00307000
MVC MACSZ(4),F80 RESET REC SIZE IN PLIST @V305238 00308000
LA R1,MACWRT @V305238 00309000
SVC 202 @V305238 00310000
DC AL4(ERROR105) @V305238 00311000
LA R11,1(,R11) BUMP THE ITEM COUNT @V305238 00312000
C R11,CUTOFF NO. OF ITEMS > CUTOFF? @V305238 00313000
BNL CHKFNS YES - GET A NEW NAME @V305238 00314000
SPACE 00315000
C R5,ENDDICT DICTIONARY OVRFLOW?? @V305238 00316000
BNL CHKFNS YES - TRY FOR ANOTHER NAME @V305238 00317000
NEWMAC1 EQU * @V305238 00318000
OI SWITCHES,AT1MAC AT LEAST 1 MACRO WRITTEN @V305238 00319000
MVC 0(8,R5),6(R3) MEMBER NAME = MACRO NAME @V305238 00320000
STH R11,8(,R5) SAVE ITEM NO. OF 1ST REC @V305238 00321000
CLI 9(R5),X'00' MOD START ON 256-ITEM BDRY? @VA04691 00321050
BNE NOTAPROB NOT A POTENTIAL OS PROBLEM @VA04691 00321100
MVI 9(R5),X'01' MAKE IT AN ACCEPTABLE TTR @VA04691 00321150
LA R11,1(,R11) NO CHK REQ'D IF CUTOFF UNCHANGED @VA04691 00321200
LA R1,* GET SOME KIND OF ADDRESS @VA04691 00321250
ST R1,MACBUFF LET IT BE OUR WRITE BUFFER @VA04691 00321300
LA R1,80 CALL IT 80 BYTES LONG @VA04691 00321350
ST R1,MACSZ AND TELL WRBUF ABOUT IT @VA04691 00321400
XC MACNOIT,MACNOIT DEFAULT THE ITEM COUNT @VA04691 00321450
LA R1,MACWRT ADDRESS THE P-LIST @VA04691 00321500
SVC 202 CALL DMSBWR @VA04691 00321550
DC AL4(ERROR105) ERROR RETURN @VA04691 00321600
NOTAPROB EQU * @VA04691 00321650
MVC 10(2,R5),H0 CLEAR REMAINDER OF ENTRY @V305238 00322000
LA R5,12(,R5) POINT TO NEXT DICT. SLOT @V305238 00323000
SPACE 2 00324000
NEWMAC2 EQU * @V305238 00325000
BAL R10,NEXTR GET NEXT IEHMOVE REC @V305238 00326000
TM 2(R3),NOTEDUM NOTELIST OR DUMMY REC? @V305238 00327000
BM NEWMAC2 YES - SKIP IT @V305238 00328000
TM 2(R3),MEMREC MEMBER HEADER RECORD? @V305238 00329000
BO NEWMAC YES - HANDLE IT @V305238 00330000
TM 2(R3),DATAREC IS IT A DATA RECORD? @V305238 00331000
BZ NEWMAC2 NO - TRY ANOTHER @V305238 00332000
EJECT 00333000
* 00334000
* WRITE OUT APPROPRIATE NUMBER OF 80 BYTE RECORDS TO THE DISK FILE 00335000
* 00336000
LA R6,3(,R3) POINT TO DATA (MAYBE) @V305238 00337000
TM 2(R3),TTR ANY TTR INFO? @V305238 00338000
BZ NOTTR NO @V305238 00339000
LA R6,3(,R6) YES - SKIP OVER IT @V305238 00340000
NOTTR EQU * @V305238 00341000
ST R6,MACBUFF SET DATA ADDR IN PLIST @V305238 00342000
LH R6,0(,R3) GET RECORD LENGTH @V305238 00343000
ST R6,MACSZ SAVE IN THE PLIST @V305238 00344000
XC MACNOIT(2),MACNOIT CLEAR CNT OF ITEMS TO WRT @V305238 00345000
TM SWITCHES,BLK TAPE INPUT BLOCKED? @V305238 00346000
BZ DSKWRT NO @V305238 00347000
SRDA R6,32 YES - SET REGS FOR DIVIDE @V305238 00348000
D R6,F80 BY LRECL @V305238 00349000
LTR R6,R6 ANY REMAINDER? @V305238 00350000
BNZ ERROR57 YES - TAPE BAD @V305238 00351000
STH R7,MACNOIT NO - SAVE NO. OF ITEMS @V305238 00352000
DSKWRT EQU * @V305238 00353000
LA R1,MACWRT GET PLIST ADDR @V305238 00354000
SVC 202 CALL DMSBWR @V305238 00355000
DC AL4(ERROR105) @V305238 00356000
LA R11,0(R7,R11) ADD NEW RECS TO ITEM COUNT @V305238 00357000
* 00358000
* HERE R10 POINTS TO FIRST TEST AFTER 'NEWMAC2' FOR USE IN NEXTR RTN 00359000
* 00360000
EJECT 00361000
* 00362000
* ROUTINE TO BUILD THE NEXT COMPLETE IEHMOVE RECORD IN CORE. LAST 00363000
* RECORD'S LENGTH IS IN R9, START ADDRESS IN R3, RETURN ADDRESS IN R10 00364000
* 00365000
NEXTR EQU * @V305238 00366000
AR R3,R9 GET NEXT RECORD'S START @V305238 00367000
CHKR EQU * @V305238 00368000
LH R9,0(,R3) GET LENGTH OF NEW REC @V305238 00369000
LA R9,3(,R9) BUMP BY THREE @V305238 00370000
TM 2(R3),TTR ANY TTR INFORMATION? @V305238 00371000
BZ CHKR1 NO @V305238 00372000
LA R9,3(,R9) YES - BYPASS IT @V305238 00373000
CHKR1 EQU * @V305238 00374000
LA R6,0(R3,R9) POINT TO END OF RECORD @V305238 00375000
C R6,BLDEND IS WHOLE THING IN CORE? @V305238 00376000
BLR R10 YES - RETURN @V305238 00377000
* 00378000
* IF BEGINNING OF THE IEHMOVE RECORD IS NOT AT THE BEGINNING OF 00379000
* BLDBUFF MOVE IT DOWN AND CONTINUE TO BUILD THE RECORD 00380000
* 00381000
L R6,BLDBUFF GET BUFFER START ADDR @V305238 00382000
CR R3,R6 REC & BUFFER START SAME? @V305238 00383000
BE SVR10 YES - ALL SET - READ TAPE @V305238 00384000
L R7,BLDEND NO - GET CURR DATA END @V305238 00385000
SR R7,R3 LENGTH OF DATA TO BE MOVED @V305238 00386000
LR R0,R3 GET RECORD START @V305238 00387000
LR R1,R7 AND LENGTH @V305238 00388000
MVCL R6,R0 MOVE THE DATA DOWN @V305238 00389000
ST R6,BLDEND SAVE NEW END ADDR @V305238 00390000
SVR10 EQU * @V305238 00391000
ST R10,SAVER10 SAVE RETURN ADDRESS @V305238 00392000
BAL R10,RDTAPE READ ANOTHER TAPE RECORD @V305238 00393000
L R10,SAVER10 RESTORE RETURN ADDR @V305238 00394000
L R3,BLDBUFF GET REC START ADDR @V305238 00395000
B CHKR SEE IF ALL IN CORE NOW @V305238 00396000
EJECT 00397000
* 00398000
* ROUTINE TO READ A TAPE RECORD AND STRIP OFF UNWANTED CHARACTERS 00399000
* FROM THE DATA READ. 00400000
* 00401000
RDTAPE EQU * @V305238 00402000
LA R1,TAPLIST PLIST ADDR @V305238 00403000
SVC 202 CALL DMSTIO @V305238 00404000
DC AL4(ERROR110) ERROR RETURN ADDRESS @V305238 00405000
STRIP2 EQU * @V305238 00406000
L R6,TPCNT GET BYTE COUNT READ IN @V305238 00407000
C R6,F80 SHORTER THAN LRECL? @V305238 00408000
BL ERROR57 YES - TAPE IS BAD @V305238 00409000
SRDA R6,32 NO - PREPARE FOR DIVIDE @V305238 00410000
D R6,F80 GET NUMBER OF 80 BYTE RECS @V305238 00411000
LR R4,R7 PUT QUOTIENT IN R4 @V305238 00412000
SLL R4,1 MULTIPLY BY 2 @V305238 00413000
L R6,TPCNT GET BYTE COUNT AGAIN @V305238 00414000
SR R6,R4 MINUS CHARS TO BE STRIPPED @V305238 00415000
L R3,BLDEND SET UP DATA TARGET @V305238 00416000
LA R8,0(R6,R3) PLUS NEW DATA LENGTH @V305238 00417000
C R8,TPBUFFND WILL THIS OVERFLOW @V305238 00418000
BH ERROR109 YES - LET USER KNOW @V305238 00419000
ST R8,BLDEND SAVE NEW END ADDR @V305238 00420000
ICM R2,7,TPBUFFAD GET TAPE BUFFER ADDR @V305238 00421000
MVC78 EQU * @V305238 00422000
MVC 0(78,R3),2(R2) MOVE DATA - SKIP 1ST 2 BYTES@V305238 00423000
LA R2,80(,R2) NEXT LRECL FROM TAPE @V305238 00424000
LA R3,78(,R3) WHERE TO MOVE IT TO @V305238 00425000
BCT R7,MVC78 DO IT 'TIL FINISHED @V305238 00426000
BR R10 RETURN TO CALLER @V305238 00427000
EJECT 00428000
* 00429000
* HERE TO GET ANOTHER FILENAME TO USE. IF THIS HASN' BEEN DONE BEFORE 00430000
* THEN LOCATE THE END OF THE FILE NAME SPECIFIED IN THE COMMAND LINE. 00431000
* IF NO BLANK IS FOUND BEFORE THE END OF THE NAME (NAME = 8 CHARS), 00432000
* USE THE LAST CHARACTER OF THE NAME. WHEREVER THE END IS FOUND, APPEND 00433000
* (OVERLAY) THE DIGIT 2. 00434000
* SUBSEQUENTLY, APPEND THE DITIT 3, 4, ... 9. 00435000
* IF WE HAVE BEEN THROUGH HERE SO MANY TIMES THAT WE ARE APPENDING 00436000
* A DIGIT > 9, THEN SKIDOODLE OFF TO ERROR139. 00437000
* ONCE THE NEW NUMBER HAS BEEN DETERMINED, WRITE OUT THE DICTIONARY 00438000
* AT THE END OF THE FILE, THEN BUILD AND WRITE OUT THE MACLIB 00439000
* HEADER RECORD AT THE BEGINNING OF THE FILE. AFTER ALL THIS IS DONE, 00440000
* GO BACK AND BEGIN PROCESSING THE TAPE INTO THE NEXT FILE NAME. 00441000
* 00442000
CHKFNS EQU * @V305238 00443000
L R6,NUMPTR GET ADDR OF APPENDED DIGIT @V305238 00444000
LTR R6,R6 HAS THE ADDR BEEN FOUND YET? @V305238 00445000
BNZ NEXTNUM YES, BEEN HERE BEFORE... @V305238 00446000
LA R6,FN1 ADDR OF THE FILE NAME @V305238 00447000
LA R1,7 NUMBER OF INTERATIONS @V305238 00448000
FINDBLK LA R6,1(R6) ADVANCE TO NEXT POSITION @V305238 00449000
CLI 0(R6),C' ' IS THIS THE END OF THE FILE NAME?@V305238 00450000
BE *+8 YES, SKIP @V305238 00451000
BCT R1,FINDBLK NOPE, KEEP LOOKING @V305238 00452000
ST R6,NUMPTR SAVE THE POINTER @V305238 00453000
MVI CURNUM,C'1' FIRST DIGIT APPENDED = 2... @V305238 00454000
NEXTNUM IC R1,CURNUM GET CURRENT NUMBER (1 TO START) @V305238 00455000
LA R1,1(R1) INCREMENT @V305238 00456000
STC R1,CURNUM AND RE-SAVE @V305238 00457000
STC R1,0(R6) PUT NEW DIGIT IN THE RIGHT PLACE @V305238 00458000
* 00459000
* WRITE OUT THE DICTIONARY AT THE END OF THE FILE 00460000
* 00461000
WRAPMAC EQU * @V305238 00462000
LA R1,REC1BUF ADDR OF OUT 80 BYTE AREA @V305238 00463000
ST R1,MACBUFF SAVE IN BWR PLIST @V305238 00464000
MVC MACNOIT(2),H1 WRITE ONE ITEM AT A TIME @V305238 00465000
MVC MACSZ(4),F80 BUFFER SIZE IS 80 @V305238 00466000
MVI REC1BUF,X'40' CLEAR THE BUFFER @V305238 00467000
MVC REC1BUF+1(79),REC1BUF . . . @V305238 00468000
MVC REC1BUF(4),SLASHREC MOVE IN LAST MACRO 'EOF' @V305238 00469000
LA R1,MACWRT POINT TO PLIST @V305238 00470000
SVC 202 CALL DMSBWR @V305238 00471000
DC AL4(ERROR105) ERROR RETURN ADDRESS @V305238 00472000
LA R11,1(,R11) BUMP ITEM NO. BY ONE @V305238 00473000
L R4,DICTBUFF ADDR OF DICTIONARY AREA @V305238 00474000
LA R6,72 INDEX FOR BXLE @V305238 00475000
LR R7,R5 END OF DICTIONARY INFO @V305238 00476000
CR R4,R5 EMPTY DICTIONARY?? @V305238 00477000
BNE DICTWRT NOPE @V305238 00478000
BAL R10,EMERS YES - GET RID OF CURR FILE @V305238 00479000
B ERROR57 BAD FORMAT MSG TOO @V305238 00480000
EJECT 00481000
DICTWRT EQU * @V305238 00482000
MVC REC1BUF(72),0(R4) MOVE IN SIX ENTRIES @V305238 00483000
XC REC1BUF+72(8),REC1BUF+72 CLEAR REMAINDER @V305238 00484000
LA R1,MACWRT PLIST ADDRESS @V305238 00485000
SVC 202 @V305238 00486000
DC AL4(ERROR105) @V305238 00487000
BXLE R4,R6,DICTWRT DO IT ALL @V305238 00488000
* 00489000
* BUILD AND WRITE COMPLETE MACLIB HEADER RECORD 00490000
* 00491000
MVI REC1BUF,X'40' CLEAR THE BUFFER 1ST @V305238 00492000
MVC REC1BUF+1(79),REC1BUF . . . @V305238 00493000
MVC REC1BUF(6),DMSLIB MOVE IN THE HEADER @V305238 00494000
STH R11,REC1BUF+6 SAVE ITEM NO OF DICT STRT @V305238 00495000
S R5,DICTBUFF GET DICTIONARY LENGTH @V305238 00496000
ST R5,REC1BUF+8 PUT IT IN THE HEADER @V305238 00497000
MVC MACITEM(2),H1 THIS WILL BE ITEM 1 @V305238 00498000
SVC 202 @V305238 00499000
DC AL4(ERROR105) @V305238 00500000
MVC STATELST(8),FINIS SET UP TO CLOSE THE FILE @V305238 00501000
LA R1,STATELST . . . @V305238 00502000
SVC 202 DO IT @V305238 00503000
DC AL4(*+4) @V305238 00504000
TM SWITCHES,TPEOF TAPE FINISHED? @V305238 00505000
BZ FSET NOPE @V305238 00506000
SR R8,R8 YES - ZERO RETURN CODE @V305238 00507000
B FREX EXIT AFTER FREEMAIN @V305238 00508000
* 00509000
* FINALLY, SET UP NECESSARY INFO TO START A NEW LIBRARY 00510000
* 00511000
FSET EQU * @V305238 00512000
CLI CURNUM,C'9' HAVE WE FILLED UP 9 MACLIBS? @V305238 00513000
BH ERROR139 YES, TOO BAD. @V305238 00514000
NI SWITCHES,255-AT1MAC RESET THIS SWITCH @V305238 00515000
MVC MACITEM(2),H0 RESET THE ITEM NUMBER @V305238 00516000
B STRTLIB GO START THE NEW LIBRARY @V305238 00517000
EJECT 00518000
* 00519000
* VARIOUS ERROR RETURN POINTS AND WHATNOT 00520000
* 00521000
SPACE 00522000
LMSG LINEDIT TEXT='LOADING ''........ MACLIB''',SUB=(CHARA,FN1) 00523000
BR R10 RETURN TO CALLER @VM03122 00524000
EMERS EQU * @V305238 00525000
MVC STATELST(8),FINIS CLOSE THE FILE FIRST @V305238 00526000
LA R1,STATELST @V305238 00527000
SVC 202 @V305238 00528000
DC AL4(+4) @V305238 00529000
MVC STATELST(8),ERASE THEN ERASE IT @V305238 00530000
SVC 202 @V305238 00531000
DC AL4(*+4) @V305238 00532000
BR R10 RETURN TO CALLER @V305238 00533000
SPACE 00534000
ERROR01 EQU * @V305238 00535000
DMSERR TEXT='NO FILENAME SPECIFIED',NUM=1,LET=E @V305238 00536000
LA R8,24 RETURN CODE FOR THIS ERROR @V305238 00537000
B EXIT EXIT - NO FREEMAIN @V305238 00538000
SPACE 00539000
ERROR03 EQU * @V305238 00540000
LR R4,R1 POINT TO OPTION IN ERROR @V305238 00541000
DMSERR TEXT='INVALID OPTION ''........''',NUM=3,LET=E, X00542000
SUB=(CHARA,(R4)) @V305238 00543000
LA R8,24 ERROR CODE @V305238 00544000
B EXIT EXIT - NO FREEMAIN @V305238 00545000
SPACE 00546000
ERROR70 EQU * @VM03122 00547000
LR R4,R1 POINT TO PARM IN ERROR @V305238 00548000
DMSERR TEXT='INVALID PARAMETER ''........''',NUM=70, @VM03122X00549000
LET=E,SUB=(CHARA,(R4)) @V305238 00550000
LA R8,24 RETURN CODE TO USER @V305238 00551000
B EXIT @V305238 00552000
SPACE 00553000
ERROR57 EQU * @V305238 00554000
DMSERR TEXT='INVALID RECORD FORMAT',NUM=57,LET=E @V305238 00555000
LA R8,32 RETURN CODE @V305238 00556000
B FREX FREEMAIN AND EXIT @V305238 00557000
SPACE 00558000
ERROR105 EQU * @V305238 00559000
LA R2,MACFN POINT TO FILENAME AND TYPE @V305238 00560000
LR R4,R15 SAVE CODE FROM BWR @V305238 00561000
DMSERR TEXT=('ERROR ... WRITING FILE ..............', @V305238X00562000
'.... ON DISK'),NUM=105,LET=S,SUB=(DEC,(R4), @V305238X00563000
CHAR8A,(R2)),MF=(E,REC1BUF) @V305238 00564000
LA R8,100 RETURN CODE @V305238 00565000
B FREX FREEMAIN AND EXIT @V305238 00566000
SPACE 00567000
ERROR109 EQU * @V305238 00568000
DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED', @V305238X00569000
NUM=109,LET=S @V305238 00570000
LA R8,104 RETURN CODE @V305238 00571000
B FREX FREEMAIN AND EXIT @V305238 00572000
SPACE 00573000
ERROR110 EQU * @V305238 00574000
CH R15,H2 IS IT EOF ON TAPE?? @V305238 00575000
BNE GIVE110 NO - GIVE THE MSG @V305238 00576000
TM SWITCHES,NHDR ANY DATA READ?? @V305238 00577000
BZ RDHDR NOPE - GO BACK AND TRY AGAIN@V305238 00578000
OI SWITCHES,TPEOF YES - SET FLAG FOR WRAPMAC @V305238 00579000
B WRAPMAC AND CLOSE UP SHOP @V305238 00580000
SPACE 00581000
GIVE110 EQU * @V305238 00582000
DMSERR TEXT='ERROR READING ''....''',NUM=110,LET=S, @V305238X00583000
SUB=(CHARA,TAPEID) @V305238 00584000
LA R8,100 RETURN CODE @V305238 00585000
B FREX @V305238 00586000
SPACE 00587000
ERROR137 EQU * @V305238 00588000
LR R2,R15 SAVE 'STATE' ERROR CODE @V305238 00589000
LA R4,MACFN POINT TO FILE NAME & TYPE @V305238 00590000
DMSERR TEXT=('ERROR ... ON ''STATE'' FOR ..........', @V305238X00591000
'........'),NUM=137,LET=S,SUB=(DEC,(R2),CHAR8A, @V305238X00592000
(R4)),MF=(E,REC1BUF) @V305238 00593000
LA R8,100 ERROR CODE FOR USER @V305238 00594000
B FREX DO FREEMAIN AND EXIT @V305238 00595000
ERROR138 LR R2,R15 SAVE THE ERASE ERROR CODE @V305238 00596000
LA R4,MACFN POINT TO FILE TRYING TO ERASE @V305238 00597000
DMSERR TEXT=('ERROR ... ERASING .................. BEFORE', X00598000
' LOADING TAPE'),NUM=138,LET=S,SUB=(DEC,(R2),CHAR8A, X00599000
(R4)),MF=(E,REC1BUF) @V305238 00600000
LA R8,100 ERROR CODE @V305238 00601000
B FREX DO FREEMAIN AND BEATIT @V305238 00602000
SPACE 00603000
ERROR139 EQU * @V305238 00604000
DMSERR TEXT='TAPE FILE EXCEEDS 9 CMS MACLIBS',NUM=139, X00605000
LET=S @V305238 00606000
LA R8,104 @V305238 00607000
EJECT 00608000
* 00609000
* ISSUE FREEMAIN TO RETURN STORAGE AND EXIT USING RETURN CODE IN R8 00610000
* 00611000
FREX EQU * @V305238 00612000
FREEMAIN V,A=GMBUFF @V305238 00613000
EXIT EQU * @V305238 00614000
LR R15,R8 PUT CODE IN R15 @V305238 00615000
BR R14 RETURN TO CMS @V305238 00616000
EJECT 00617000
* 00618000
* CONSTANTS, PARAMETER LISTS, BUFFERS, ETC. 00619000
* 00620000
MACWRT DS 0D @V305238 00621000
DC CL8'WRBUF' @V305238 00622000
MACFN DC CL8' ' FILENAME PUT HERE @V305238 00623000
DC CL8'MACLIB' @V305238 00624000
DC CL2'A1' @V305238 00625000
MACITEM DC H'0' ITEM NO. OF NEXT REC. @V305238 00626000
MACBUFF DC F'0' BUFFER START ADDRESS @V305238 00627000
MACSZ DC F'80' AND SIZE @V305238 00628000
DC CL2'F' @V305238 00629000
MACNOIT DC H'1' NO. OF ITEMS TO WRITE @V305238 00630000
SPACE 00631000
TAPLIST DS 0D @V305238 00632000
DC CL8'TAPEIO' @V305238 00633000
DC CL8'READ' @V305238 00634000
TAPEID DC CL4'TAP1' LOGICAL TAPE ADDRESS @V305238 00635000
DC X'00' NO MODE FOR TAPEIO @VA12288 00636000
TPBUFFAD DC AL3(0) BUFFER ADDRESS @V305238 00637000
TPBUFFSZ DC F'0' AND SIZE @V305238 00638000
TPCNT DC F'0' COUNT OF BYTES READ @V305238 00639000
DC F'-1' @V305238 00640000
SPACE 00641000
TYPLIST DS 0D @V305238 00642000
DC CL8'TYPLIN' @V305238 00643000
DC AL1(1) @V305238 00644000
TYPBUFAD DC AL3(0) ADDR OF OUTPUT INFO @V305238 00645000
DC C'B' @V305238 00646000
TYPCNT DC AL3(0) LENGTH OF OUTPUT @V305238 00647000
SPACE 00648000
STATELST DS 0D @V305238 00649000
DC CL16' ' OPERATION AND NAME SUPPLIED @V305238 00650000
DC CL8'MACLIB' @V305238 00651000
DC CL8'A1' @V305238 00652000
SPACE 00653000
PACKED DC D'0' WORK AREA FOR PACKED DATA @V305238 00654000
FN1 DC CL8' ' FILENAME FROM USER PUT HERE @V305238 00655000
F80 DC F'80' STD LOGICAL RECORD LENGTH @V305238 00656000
GMBUFF DC 2F'0' GETMAIN RETURNS INFO HERE @V305238 00657000
SZLIST DC F'12288' MIN SIZE REQUESTED @V305238 00658000
DC F'32768' MAX SIZE REQUESTED @V305238 00659000
DICTBUFF DC F'0' START OF DICTIONARY BUFFER @V305238 00660000
ENDDICT DC F'0' END OF SAME @V305238 00661000
TPBUFFND DC F'0' END OF GETMAIN'D AREA @V305238 00662000
BLDBUFF DC F'0' START OF REC. BUILD AREA @V305238 00663000
BLDEND DC F'0' CURRENT END OF DATA ADDR @V305238 00664000
CUTOFF DC F'50000' MACLIB ITEM CUTOFF BDY @V305238 00665000
SAVER10 DC F'0' SAVE R10 ACROSS INTERNAL CALLS @V305238 00666000
NUMPTR DC F'0' ADDR OF NUMBER APPENDED BYTE@V305238 00667000
STATEW DC CL8'STATEW' @V305238 00668000
ERASE DC CL8'ERASE' @V305238 00669000
FINIS DC CL8'FINIS' @V305238 00670000
VOL DC C'VOL' @V305238 00671000
HDR DC C'HDR' @V305238 00672000
DMSLIB DC C'DMSLIB' @V305238 00673000
SLASHREC DC X'61FFFF61' @V305238 00674000
REC1BUF DC CL80' ' @V305238 00675000
H0 EQU F80 @V305238 00676000
H1 DC H'1' @V305238 00677000
H2 DC H'2' @V305238 00678000
H28 DC H'28' @V305238 00679000
IEHMVHDR DC C'THIS IS AN UNLOADED DATA SET PRODUCED BY' @V305238 00680000
DC X'80' @V305238 00681000
DC C'THE IBM UTILITY, SYSMOVE.OMMBRLDWB' @V305238 00682000
ASTERS DC C'***' @V305238 00683000
CURNUM DC C'1' CURRENT FILE NUMBER APPENDED @V305238 00684000
SWITCHES DC X'00' @V305238 00685000
* 00686000
* BITS DEFINED IN 'SWITCHES' 00687000
* 00688000
NHDR EQU X'80' NON-HDR TAPE REC READ @V305238 00689000
AT1MAC EQU X'40' AT LEAST 1 MACRO WRITTEN @V305238 00690000
BLK EQU X'10' DATA ON TAPE IS BLOCKED @V305238 00691000
TPEOF EQU X'08' EOF ON TAPE @V305238 00692000
* REMAINING BITS IN 'SWITCHES' NOT USED 00693000
* 00694000
* OTHER EQUATES 00695000
CSW EQU X'40' LOW CORE CSW ADDR @V305238 00696000
ILI EQU X'40' BIT IN CSW+5 @V305238 00697000
FXD EQU X'80' @V305238 00698000
MEMREC EQU X'08' @V305238 00699000
NOTEDUM EQU X'14' @V305238 00700000
DATAREC EQU X'20' @V305238 00701000
TTR EQU X'80' @V305238 00702000
SPACE 2 00703000
REGEQU @V305238 00704000
LTORG @V305238 00705000
END 00706000