PRT TITLE 'DMSPRT (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME: DMSPRT 00004000
* 00005000
* FUNCTION: TO PRINT CMS FILES 00006000
* 00007000
* ATTRIBUTES: DISK RESIDENT, TRANSIENT, SERIALLY REUSABLE 00008000
* NOTE: PRINT MUST BE GENMOD'D WITH THE SYSTEM OPTION 00008100
* 00009000
* ENTRY POINT: DMSPRT(PRINT) 00010000
* 00011000
* ENTRY CONDITIONS: UPON ENTRY, R13 POINTS TO A 24-FULLWORD SAVE 00012000
* AREA PROVIDED BY DMSITS, AND R1 POINTS TO A PARAMETER LIST 00013000
* IN THE FOLLOWING FORMAT: 00014000
* DS 0F 00015000
* PLIST DC CL8'PRINT' 00016000
* DC CL8'FILENAME' MUST BE GIVEN 00017000
* DC CL8'FILETYPE' MUST BE GIVEN 00018000
* <DC CL8'FILEMODE'> IF NOT GIVEN, 'A ' IS USED 00019000
* <DC CL8'('> NEEDED IF OPTIONS GIVEN 00020000
* <DC CL8'OPTION1'> (OPTIONS IN SUCCESSIVE 00021000
* <DC CL8'OPTION N'> 'CL8' GROUPS) 00022000
* <DC CL8')'> OPTION END - NOT REQUIRED 00023000
* DC 8X'FF' 00024000
* 00025000
* THE VALID OPTIONS ARE: 00026000
* CC - THE FIRST BYTE OF EACH RECORD IS USED FOR CCW 00027000
* COMMAND BUILDING 00028000
* NOCC - X'09' IS USED AS THE FIRST BYTE OF THE LINE 00029000
* MEMBER OR MEM - A 'MACLIB' OR 'TXTLIB' IS TO BE 00030000
* SEARCHED, AND ONE OR ALL MEMBERS ARE 00031000
* TO BE PRINTED. (MUST BE FOLLOWED BY 00032000
* THE MEMBER NAME OR '*') 00033000
* HEX - EACH RECORD IS TO BE PRINTED IN EBCDIC FORM 00034000
* UPCASE OR UP - EACH LOWER CASE ALPHABETIC 00035000
* CHARACTER IS CHANGED 00035500
* TO UPPERCASE. 00036000
* LINECOUN OR LI - THE NUMBER OF LINES TO BE @V2D4921 00036150
* PRINTED ON EACH PAGE. IF ZERO @V2D4921 00036300
* IS SPECIFIED, NO PAGE EJECTS @V2D4921 00036450
* WILL BE PERFORMED FOR THE @V2D4921 00036600
* DURATION OF THE COMMAND. @V2D4921 00036750
* 00037000
* OVERRIDING OPTIONS: 00038000
* IF THE FILETYPE IS 'LISTING', THE CC OPTION IS THE 00039000
* DEFAULT. OTHERWISE, NOCC IS THE DEFAULT. 00040000
* IF NOCC OR HEX IS SPECIFIED, THE CC OPTION IS 00041000
* OVERRIDDEN, EVEN IF CC WAS SPECIFIED 00042000
* OR THE FILETYPE IS 'LISTING' 00043000
* IF HEX IS SPECIFIED, UPCASE IS IGNORED 00044000
* IF LINECOUN IS NOT SPECIFIED, 55 IS THE @V2D4921 00044150
* DEFAULT. IF CC IS IN EFFECT, @V2D4921 00044300
* THE OPTION HAS NO EFFECT, SINCE @V2D4921 00044450
* FORMATTING IS UNDER CONTROL OF @V2D4921 00044600
* CARRIAGE CONTROL IN THE FILE. @V2D4921 00044750
* 00045000
* EXIT CONDITIONS: AT EXIT R15 CONTAINS ONE OF THE FOLLOWING CODES: 00046000
* CODE: MEANING: 00047000
* 0 NO ERRORS - NORMAL COMPLETION 00048000
* 20 ILLEGAL * IN FILEID (FN AND FT MUST BE GIVEN) 00049000
* 24 OPTION ERROR, INCOMPLETE FILEID 00050000
* 28 FILE NOT FOUND 00051000
* 32 LIBRARY ERROR, RECORD TOO LONG 00052000
* 36 PRINTER DEVICE NONEXISTENT OR NOT SUPPORTED 00053000
* 36 TARGET DISK NOT ACCESSED @VA12416 00053500
* 100 DISK ERROR, PRINT ERROR 00054000
* 00055000
EJECT 00056000
* CALLS TO OTHER ROUTINES: DMSSTT - GET FST COPY 00057000
* DMSBRD - READ NEXT RECORD FROM FILE 00058000
* DMSCPF - CLOSE PRINTER 00059000
* DMSFNS - CLOSE FILE 00060000
* DMSFRE - GET, RELEASE FREE STORAGE 00061000
* DMSPIOCC - BUILD CCWS, FILL BUFFER 00062000
* DMSPIOSI - PRINT BUFFER 00063000
* DMSERR - PROCESS ERROR MESSAGES 00064000
* 00065000
* EXTERNAL REFERENCES: NUCON 00066000
* 00067000
* TABLES/WORKAREAS: R13 AREA PROVIDED BY DMSITS 00068000
* (USED WITH UIOSECT DSECT) 00069000
* 00070000
* REGISTER USAGE: 00071000
* R1 PLIST POINTER AT ENTRY 00072000
* R2 PLIST POINTER SAVE 00073000
* R5 INTERNAL RETURN REGISTER 00074000
* R6 ADDRESS OF RECORD BEING PROCESSED 00075000
* R7 LENGTH OF RECORD BEING PROCESSED 00076000
* R11 BASE REG IN BUFFER 00077000
* R12 BASE REG IN CODE 00078000
* R13 BASE REG IN UIOSECT 00079000
* R14 RETURN REG AT ENTRY, INTERNAL RETURN REG 00080000
* R15 RETURN CODE 00081000
* 00082000
* NOTES: DMSPRT PROVIDES A 4096-BYTE BUFFER ON A PAGE BOUNDARY FOR 00083000
* PRINTING. DMSPIOCC IS CALLED TO FILL THIS BUFFER WITH 00084000
* CHAINED CCWS, TIC CCWS, AND DATA. DMSPIOSI IS CALLED TO 00085000
* ISSUE A START I/O AGAINST THE CCW CHAIN IN THE BUFFER. 00086000
* THIS PROCEDURE IS MUCH MORE EFFICIENT THAN ISSUING A 00087000
* SEPARATE START I/O FOR EACH LINE BEING PRINTED. 00088000
* DMSPRT EXECUTES IN THE TRANSIENT AREA, WHICH IS TWO PAGES 00089000
* LONG. THE EXECUTABLE CODE OCCUPIES THE FIRST PAGE, AND 00090000
* THE BUFFER OCCUPIES THE SECOND PAGE. 00091000
* 00092000
* OPERATION: 00093000
* SET UP - 00094000
* 1) CHECK TO INSURE A VIRTUAL 1403, 3211, OR 3203 IS 00095000
* AVAILABLE. IF A 3211 OR 3203, LOAD VIRTUAL FORMS 00096000
* CONTROL BUFFER TO SUIT THIS COMMAND. (THIS FORMS CONTROL 00097000
* BUFFER CONFIGURATION WILL MINIMIZE BREAKING THE CCW CHAIN 00098000
* FOR 'CHAN 9' OR 'CHAN 12', WHILE ALLOWING ALL FUNCTIONS 00099000
* THAT ARE ALLOWED WITH THE DEFAULT CONFIGURATION). 00100000
* 2) SCAN OPTIONS AND SET SWITCHES. 00101000
* 3) CALL DMSSTT(STATE) TO VERIFY EXISTENCE OF FILE. 00102000
* 4) CHECK LARGEST REC LEN AGT ALLOWABLE MAX (132 FOR A 00103000
* 1403 OR 3203 AND 150 FOR A 3211. IF CC IS IN EFFECT 00104000
* LENGTH CAN BE ONE GREATER TO ALLOW FOR CC CHARACTER. 00105000
* IF HEX IS SPECIFIED, RECORD CAN BE UP TO 65,535, THE 00106000
* CMS MAXIMUM). 00107000
* 5) CALL DMSFRE TO GET STORAGE AREA EQUAL TO LARGEST RECORD. 00108000
* 6) SET UP PAGE HEADING, DO INITIAL PAGE EJECT. 00109000
EJECT 00110000
* 7) IF MEMBER OPTION, GO TO ROUTINE 'MEMBS', WHICH READS THE 00111000
* LIBRARY DICTIONARY AND LOCATES THE FIRST, OR ONLY, 00112000
* MEMBER TO BE PRINTED. 00113000
* 00114000
* MAIN LOOP - 00115000
* 8) CALL DMSBRD(RDBUF) TO READ A RECORD FROM THE FILE INTO 00116000
* THE FREE STORAGE AREA PREVIOUSLY OBTAINED. IF 'END OF 00117000
* FILE' RETURNED, GO TO 18. 00118000
* 9) PREPARE THE RECORD FOR PRINTING AS DETERMINED BY THE 00119000
* OPTIONS IN EFFECT: 00120000
* A) HEX - IF HEX PRINT IS WANTED, GO TO 15. 00121000
* B) UP OR UPCASE - TRANSLATE LOWER CASE ALPHA- 00122000
* BETIC CHARACTERS TO UPPER CASE. ALL OTHER 00122500
* CHARACTERS REMAIN UNCHANGED. TRANSLATE 00123000
* TABLE (UPTRTBL) IS USED. 00123500
* C) CC - THE CARRIAGE CONTROL OPTION MEANS THAT THE 00124000
* FIRST CHARACTER OF THE RECORD IS USED TO DETERMINE 00125000
* WHAT PRINT, SPACE, AND SKIP CCWS WILL BE GENERATED. 00126000
* IF CC IS NOT IN EFFECT, USE A X'09' TO PRINT AND 00127000
* SPACE 1 AS THE FIRST BYTE OF THE RECORD, AND ADJUST 00128000
* THE POINTER TO THE RECORD AND THE LENGTH OF THE 00129000
* RECORD TO INCLUDE IT. 00130000
* 10) GO TO 11, AND RETURN TO 8. 00131000
* 00132000
* FILBUF ROUTINE - 00133000
* 11) CALL DMSPIOCC TO GENERATE CCWS FOR THE LINE, AND PUT 00134000
* THE CCWS AND DATA INTO THE BUFFER. 00135000
* 12) IF THE BUFFER IS FULL, CALL DMSPIOSI TO PRINT IT. 00136000
* 13) IF LINECOUN HAS BEEN SATISFIED OR 55 LINES @V2D4921 00136600
* HAVE BEEN PROCESSED, AND CC IS NOT IN @V2D4921 00137200
* EFFECT, DO PAGE EJECT. 00138000
* 14) RETURN TO THE MAIN LOOP (8) OR THE HEX ROUTINE (15) 00139000
* TO PREPARE THE NEXT LINE. 00140000
* 00141000
* HEX ROUTINE - 00142000
* 15) UNPACK 10 GROUPS OF 4 BYTES FROM THE RECORD INTO A 00143000
* LOCAL BUFFER. 00144000
* 16) IF RECORD IS EXHAUSTED, GO TO 11 AND RETURN TO 8. 00145000
* 17) IF MORE OF THE RECORD TO BE TRANSLATED, 00146000
* GO TO 11 AND RETURN TO 15. 00147000
* 00148000
* RETURNS - 00149000
* 18) IF BUFFER NOT EMPTY, CALL DMSPIOSI TO PRINT IT. 00150000
* 19) CALL CP CLOSE TO CLOSE THE PRINTER. 00151000
* 20) CALL DMSFNS TO CLOSE THE FILE. 00152000
* 21) CALL DMSFRE TO RELEASE FREE STORAGE. 00153000
* 22) RETURN TO CMS. 00154000
* 00155000
* NOTE: IF AN ERROR IS DETECTED, DMSERR IS CALLED TO PROCESS 00156000
* AN ERROR MESSAGE, AND THEN THE 'RETURNS' SECTION IS 00157000
* ENTERED AT AN APPROPRIATE POINT TO CLOSE ONLY 00158000
* THOSE THINGS THAT HAD BEEN OPENED AT THE TIME OF 00159000
* THE ERROR. 00160000
* 00161000
*. 00162000
********************************************************************** 00163000
EJECT 00164000
********************************************************************** 00165000
* 00166000
* SETUP 00167000
* 00168000
********************************************************************** 00169000
SPACE 1 00170000
DMSPRT START X'E000' 00171000
PRINT EQU DMSPRT 00172000
ENTRY PRINT 00173000
USING *,R12,R11 00174000
LR R12,R15 ESTABLISH ADDRESSABILITY 00175000
L R11,=A(PRINT+4096) 00176000
USING UIOSECT,R13 00177000
USING NUCON,R0 00178000
ST R14,UIOSAVE SAVE RETURN ADDRESS 00179000
SPACE 1 00180000
LA R3,BUFDATA SET COUNTER TO BEGINNING OF BUFFER 00181000
SR R4,R4 AND ZERO BATCTR 00182000
STM R3,R4,BUFCTR ... 00183000
SPACE 1 00184000
LA R2,132 SET 1403 OR 3203 CARRIAGE SIZE @V386298 00185000
STH R2,CARRSZ ... 00186000
LA R2,14 ASSUME DEVICE '00E' 00187000
DC X'83',X'23',XL2'0024' ISSUE DEVICE TYPE DIAGNOSE 00188000
BC 1,ERR008A DEVICE NOT ATTACHED - ERROR 08 00189000
ST R3,UIODIAG RESULTS STORED 00190000
CLI UIOVTYPC,CLASURO UNIT RECORD OUTPUT CLASS? 00191000
BNE ERR008 NO, ERROR 08 00192000
CLI UIOVTYPE,TYP1403 IS IT A 1403? 00193000
BE DEVOK IF SO, CONTINUE 00194000
CLI UIOVTYPE,TYP3203 IS IT A 3203 PRINTER?? @V386298 00194100
BE LDVFCB YES--LOAD VIRTUAL FCB @V386298 00194200
CLI UIOVTYPE,TYP3211 IS IT A 3211? 00195000
BNE ERR008 NEITHER 1403/3203/3211 00196000
LA R2,150 IT'S A 3211 - SET CARRIAGE SIZE 00197000
STH R2,CARRSZ ... 00198000
LDVFCB EQU * @V386298 00198100
MVC BUFDATA(88),CCWLFCB LOAD VIRT. 3203 OR 3211 @V386298 00199000
LA R3,BUFDATA+88 SET COUNTER TO NEXT ADDRESS 00200000
ST R3,BUFCTR ... 00201000
SPACE 1 00202000
DEVOK EQU * WE HAVE A SUPPORTED PRINTER... 00203000
LR R2,R1 SAVE PLIST POINTER TO FREE R1 00204000
MVI SWS,FIRST CLEAR SWITCHES TO FIRST PASS SWITCH 00205000
LA R3,55 SET DEFAULT LINE COUNT @V2D4921 00205300
ST R3,KOUNT ... @V2D4921 00205600
* 00206000
* DETERMINE FILEID OF FILE TO BE PRINTED 00207000
* 00208000
LM R3,R7,8(R2) REGS CONTAIN GIVEN FILEID 00209000
LM R8,R10,SCANFO R8=X'FF', R9=C'*', R10=C'(' 00210000
CLR R3,R8 NO FILEID GIVEN? 00211000
BE ERR054 INCOMPLETE FILEID 00212000
CLR R3,R9 IS FILENAME GIVEN AS '*'? 00213000
BE ERR062 ILLEGAL * 00214000
CLR R3,R10 OPTION START? 00215000
BE ERR054 INCOMPLETE FILEID 00216000
CLR R5,R8 NO FILETYPE GIVEN? 00217000
BE ERR054 INCOMPLETE FILEID 00218000
CLR R5,R9 FILETYPE GIVEN AS '*'? 00219000
BE ERR062 ILLEGAL * 00220000
CLR R5,R10 OPTION START? 00221000
BE ERR054 INCOMPLETE FILEID 00222000
LR R9,R7 SAVE 24(PLIST) IN R9 00223000
CLR R7,R8 FILEMODE NOT GIVEN? 00224000
BE MODEA ASSUME FM=A 00225000
CLR R7,R10 OPTION START? 00226000
BE MODEA MODE NOT GIVEN - ASSUME FM=A 00227000
CLI 26(R2),C' ' IS FILEMODE > 2 CHARACTERS? @V2D4921 00227100
BNE ERR048 BRANCH IF YES @V2D4921 00227200
CLI 25(R2),C' ' IS FILEMODE 2 CHARACTERS? @V2D4921 00227300
BE MODE BRANCH IF NOT @V2D4921 00227400
CLI 25(R2),X'F0' IS SECOND CHAR < 0? @V2D4921 00227500
BL ERR048 BRANCH IF YES @V2D4921 00227600
CLI 25(R2),X'F5' IS SECOND CHAR > 5? @V2D4921 00227700
BH ERR048 BRANCH IF YES @V2D4921 00227800
MODE EQU * @V2D4921 00227900
ICM R7,B'0011',BITS FILEMODE GIVEN - USE IT 00228000
B SETLIST 00229000
MODEA L R7,AMODE ASSUME FILEMODE OF 'A ' 00230000
SETLIST STM R3,R7,FILENAME SET FILE SYSTEM PLIST WITH FILEID 00231000
L R1,BITS INITIALIZE OTHER FIELDS TO '0001' 00232000
ST R1,RECNO ... 00233000
STH R1,FILENOIT ... 00234000
MVC FILE(8),=CL8'STATE' SET FILE PLIST FOR STATE CALL 00235000
* 00236000
* SCAN OPTIONS, SET APPROPRIATE SWITCHES 00237000
* 00238000
CLR R9,R8 24(PLIST) = X'FF'? 00239000
BE CKEXIST IF SO,END OF PLIST 00240000
CLR R9,R10 24(PLIST) = C'('? 00241000
BNE SCAN6 IF NOT, FILEMODE WAS GIVEN 00242000
LA R9,32(,R2) POINT TO PARMS 00243000
SCAN1 CLI 0(R9),C')' END OF PARMS 00244000
BE CKEXIST YES 00245000
CLI 0(R9),X'FF' END OF OPTIONS 00246000
BE CKEXIST YES 00247000
CLC 0(4,R9),=CL4'CC' CONTROL WANTED? @V2D4921 00248000
BNE SCAN2 NO 00249000
OI SWS,CC YES 00250000
LA R9,8(,R9) INCR POINTER 00251000
B SCAN1 00252000
SCAN2 CLC 0(8,R9),=CL8'NOCC' 00253000
BNE SCAN2A @V2D4921 00254000
OI SWS,NOCC SET NOT-CC SWITCH 00255000
LA R9,8(,R9) INCR POINTER 00256000
B SCAN1 00257000
SCAN2A CLC 0(8,R9),=CL8'LINECOUN' @V2D4921 00257060
BE SCAN2B @V2D4921 00257120
CLC 0(4,R9),=CL4'LI' @V2D4921 00257180
BNE SCAN3 @V2D4921 00257240
SCAN2B CLI 8(R9),C')' WAS A NUMBER GIVEN? @V2D4921 00257300
BE ERR029 NO, ERROR @V2D4921 00257360
CLI 8(R9),X'FF' OR IF THIS IS THE END OF THE LINE@V2D4921 00257420
BE ERR029 IT'S THE SAME ERROR @V2D4921 00257480
CLI 10(R9),C' ' MORE THAN TWO DIGITS? @V2D4921 00257540
BNE ERR029 BRANCH IF YES, ERROR @V2D4921 00257600
MVC KOUNT(2),8(R9) MOVE CHARACTER FORM NUMBER @V2D4921 00257660
CLI KOUNT,X'F0' @V2D4921 00257720
BL ERR029 NOT A VALID NUMBER @V2D4921 00257780
CLI KOUNT,X'F9' GREATER THAN NINE? @V2D4921 00257840
BH ERR029 NOT A VALID NUMBER @V2D4921 00257900
NI KOUNT,X'0F' REMOVE ZONE FROM NUMBER @V2D4921 00257960
SR R1,R1 CLEAR A REGISTER @V2D4921 00258020
IC R1,KOUNT GET HIGH ORDER DIGIT OF NUMBER @V2D4921 00258080
CLI KOUNT+1,X'40' WAS THERE ONLY ONE DIGIT? @V2D4921 00258140
BE ONLYONE YES, GO @V2D4921 00258200
CLI KOUNT+1,X'F0' NUMBER LESS THAN ZERO? @V2D4921 00258260
BL ERR029 BRANCH IF YES @V2D4921 00258320
CLI KOUNT+1,X'F9' GREATER THAN NINE? @V2D4921 00258380
BH ERR029 BRANCH IF YES @V2D4921 00258440
MH R1,=H'10' MULTIPLY HIGH ORDER DIGIT @V2D4921 00258500
NC KOUNT(2),=X'000F' KEEP ONLY LOW ORDER DIGIT @V2D4921 00258560
AH R1,KOUNT AND ADD IN LOW ORDER DIGIT @V2D4921 00258620
ONLYONE ST R1,KOUNT SET LINE COUNT VALUE @V2D4921 00258680
LA R9,16(,R9) GO TO NEXT OPTION @V2D4921 00258740
B SCAN1 ... @V2D4921 00258800
SCAN3 EQU * @V2D4921 00258860
CLC 0(4,R9),=CL4'UP' UPPER CASE? @V2D4921 00258920
BE SCAN3A 00259000
CLC 0(8,R9),=CL8'UPCASE' UPPER CASE? 00260000
BNE SCAN4 00261000
SCAN3A OI SWS,UPRCS YES 00262000
LA R9,8(,R9) INCR POINTER 00263000
B SCAN1 00264000
SCAN4 EQU * @V2D4921 00264600
CLC 0(4,R9),=CL4'MEM' MEMBER WANTED? @V2D4921 00265200
BE SCAN4B 00266000
CLC 0(8,R9),=CL8'MEMBER' MEMBER WANTED 00267000
BNE SCAN5 00268000
SCAN4B OI SWS,MEMB TURN ON MEMBER PRESENT 00269000
CLC 8(4,R9),SCANFO+4 ALL MEMBERS? @V2D4921 00270000
BE SCAN4A YES 00271000
CLI 8(R9),C')' IS IT END OF LINE 00272000
BE ERR029 ERROR IF IT IS 00273000
CLI 8(R9),X'FF' END OF LIST 00274000
BE ERR029 ERROR IF IT IS 00275000
MVC NAME1(8),8(R9) SAVE NAME 00276000
OI SWS,NAME TURN ON MEMB NAME 00277000
SCAN4A LA R9,16(,R9) 00278000
B SCAN1 00279000
SCAN5 EQU * @V2D4921 00279600
CLC 0(4,R9),=CL4'HEX' HEX WANTED? @V2D4921 00280200
BNE ERR003 END OF LINE,DON'T KNOW WHAT IT IS 00281000
OI SWS,HEX TURN ON HEX PRINT 00282000
LA R9,8(,R9) INCR PTR 00283000
B SCAN1 GO BACK 00284000
SCAN6 CLI 32(R2),X'FF' END OF PLIST? 00285000
BE CKEXIST YES 00286000
CLI 32(R2),C'(' BEGINNING OF PARAMETERS 00287000
BNE SCAN6A DON'T KNOW WHAT IT IS 00288000
LA R9,40(,R2) 00289000
B SCAN1 00290000
SCAN6A LA R9,32(R2) POINT TO STRANGE PARM 00291000
B ERR070 @V2D4921 00292000
SPACE 1 00293000
CKEXIST EQU * 00294000
CLC FILETYPE(8),=CL8'LISTING' IS IT A LISTING FILE? 00295000
BNE CK1 BRANCH IF NOT 00296000
OI SWS,CC LISTING FILE DEFAULTS TO CC 00297000
CK1 TM SWS,NOCC UNLESS OVERRIDDEN... 00298000
BZ CK2 00299000
NI SWS,255-CC ...IN WHICH CASE TURN IT OFF 00300000
CK2 TM SWS,HEX ...OR UNLESS HEX SPECIFIED... 00301000
BZ CK3 00302000
NI SWS,255-CC ...IN WHICH CASE ALSO TURN IT OFF 00303000
* 00304000
* CHECK EXISTENCE OF FILE 00305000
* 00306000
CK3 EQU * 00307000
LA R1,FILE POINT TO FILE PLIST 00308000
L R15,ASTATE @V305066 00309000
BALR R14,R15 ... @V305066 00309100
BNZ STATERR ERROR RETURN @V305066 00309200
L R3,FILEBUFF LOCATION OF FST COPY 00311000
L R1,32(,R3) RECORD LENGTH IN R1 00312000
TM SWS,HEX IF HEX WANTED... 00313000
BO RECLOK ...SKIP LENGTH CHECK 00314000
LH R4,CARRSZ PRINTER CARRIAGE SIZE IN R4 00315000
TM SWS,CC IF CARRIAGE CONTROL SUPPLIED... 00316000
BZ CKRECL ... 00317000
LA R4,1(,R4) ...RECORD LENGTH CAN BE 1 MORE 00318000
CKRECL CR R1,R4 RECORD LENGTH OK? 00319000
BH ERR044 ERROR IF TOO LONG 00320000
SPACE 1 00321000
RECLOK MVC FILECOMM,=CL8'RDBUF' SET FILE PLIST FOR READING 00322000
ST R1,FILESIZE RECORD LENGTH INTO FILE PLIST 00323000
LA R1,7(,R1) ROUND NUMBER UP... 00324000
SRL R1,3 ...IN DOUBLEWORDS... 00325000
LA R0,1(,R1) ...PLUS ONE 00326000
ST R0,STRG SAVE LENGTH 00327000
DMSFREE DWORDS=(0) 00328000
ST R1,AREA SAVE ADDRESS OF STORAGE 00329000
TM SWS,CC CARRIAGE CONTROL PROVIDED? 00330000
BO STSTG BRANCH IF SO 00331000
MVI 0(R1),X'09' MOVE IN DEFAULT CARRIAGE CONTROL 00332000
LA R1,1(,R1) INCREASE BUFFER ADDRESS PAST X'09' 00333000
STSTG ST R1,FILEBUFF BUFFER ADDRESS FOR RDBUF 00334000
SPACE 1 00335000
* 00336000
* SET UP TITLE 00337000
* 00338000
LA R3,INSTALID V(INSTALLATION HEADING) 00339000
MVC FILEHD+22(64),0(R3) MOVE HEADING TO LOCAL BUFFER 00340000
MVC FILEHD(8),FILENAME SET UP FILEID 00341000
MVC FILEHD+9(8),FILETYPE ... 00342000
MVC FILEHD+18(2),FILEMODE ... 00343000
ZAP PAGCNT,H12 INITIALIZE PAGE NUMBER COUNT 00344000
LA R14,MEMBS SET RETURN FROM 1ST PAGE EJECT 00345000
TM SWS,MEMB PRINTING FROM A LIBRARY? 00346000
BO SETUPEND YES, CHECK PAGE EJECT @V2D4921 00347000
LA R14,MAINLOOP NO, CHANGE RETURN FROM 1ST PAGE EJECT 00348000
SETUPEND EQU * @V2D4921 00348500
TM SWS,CC CARRIAGE CONTROL PROVIDED? @V2D4921 00349000
BOR R14 YES, SKIP INITIAL EJECT @V2D4921 00349500
EJECT 00350000
********************************************************************** 00351000
* 00352000
* PAGE EJECT ROUTINE 00353000
* 00354000
********************************************************************** 00355000
SPACE 1 00356000
PAGE EQU * 00357000
NI SWS,255-EJEC REMOVE EJECT FLAG 00357500
AP PAGCNT,=PL2'1' INCREMENT PAGE NUMBER 00358000
UNPK HDCNT(3),PAGCNT(2) SET NEW PAGE NUMBER 00359000
OI HDCNT+2,X'F0' ... 00360000
LM R6,R7,PABUF SET TO SKIP, PRINT HEADING 00361000
BAL R5,FILBUF 00362000
LM R6,R7,PASPACE AND SPACE 3 00363000
BAL R5,FILBUF 00364000
L LINCNT,KOUNT INITIALIZE LINE COUNT @V2D4921 00365000
BR R14 RETURN 00366000
EJECT 00367000
********************************************************************** 00368000
* MAIN LOOP 00369000
* 00370000
********************************************************************** 00371000
SPACE 1 00372000
MAINLOOP EQU * 00373000
TM SWS,MEMB PRINTING A LIBRARY MEMBER? 00374000
BZ MAINRD NO, READ A RECORD 00375000
L R1,FILEBUFF POINT TO RECORD 00376000
CLC 0(4,R1),=X'61FFFF61' END OF MEMBER RECORD? 00377000
BE MEMEND BRANCH IF SO 00378000
LA R4,1(,R4) INCREMENT ITEM NUMBER 00379000
STH R4,FILEITNO AND SET IN FILE PLIST 00380000
B MAINRD READ NEXT RECORD 00381000
SPACE 1 00382000
MEMEND LA R15,12 SIMULATE EOF IN CASE FINISHED 00383000
TM SWS,NAME MEMBER NAME GIVEN? 00384000
BO READERR YES, PRINTING SINGLE MEMBER ONLY 00385000
SPACE 1 00386000
MEMFIND L R1,DICTADR PREPARE TO LOCATE NEXT MEMBER 00387000
LA R1,12(,R1) POINT TO NEXT DICTIONARY ENTRY 00388000
C R1,DICTEND END OF ALL MEMBERS? 00389000
BNL READERR YES, END 00390000
ST R1,DICTADR NO, STORE NEW ADDRESS 00391000
CLI 0(R1),X'00' NULL DICTIONARY ENTRY? 00392000
BE MEMFIND IF SO, LOOK AGAIN 00393000
LH R4,8(,R1) IF NOT, GET STARTING LOCATION 00394000
STH R4,FILEITNO AND SET IT IN PLIST 00395000
SPACE 1 00396000
MAINRD EQU * 00397000
LA R1,FILE SET TO READ A RECORD 00398000
L R15,ARDBUF RDBUF @V305066 00399000
BALR R14,R15 ... @V305066 00399100
BNZ READERR ERROR RETURN @V305066 00399200
TM SWS,EJEC WAS EJECT WANTED? 00400200
BZ NOEJEC BRANCH IF NOT 00400400
BAL R14,PAGE GO EJECT 00400600
NOEJEC EQU * 00400800
L R6,FILEBUFF BUFFER LOCATION TO R6 00401000
L R7,FILENORD BYTE COUNT TO R7 00402000
TM SWS,HEX IF HEX WANTED... 00403000
BO HEXRTN ...GO TO HEX ROUTINE 00404000
TM SWS,CC CARRIAGE CONTROL PROVIDED? 00405000
BO CTROK BRANCH IF SO 00406000
BCTR R6,0 REDUCE LOCATION TO INCLUDE OUR CC 00407000
LA R7,1(,R7) AND INCREASE COUNT 00408000
SPACE 1 00409000
CTROK TM SWS,UPRCS TRANSLATE TO UPPERCASE? 00410000
BZ CASEOK BRANCH IF NOT 00411000
LA R3,1(,R6) POINT TO DATA (1 PAST CC CHAR) 00412000
LR R5,R7 CALCULATE BYTE COUNT FOR EX 00413000
BCTR R5,0 SUBTRACT 1 FOR NOT XLATING CC CHAR 00414000
LTR R5,R5 ONLY 1 BYTE IN RECORD? @VA05422 00414100
BZ TRANS YES DON'T DECREMENT FURTHER @VA05422 00414200
BCTR R5,0 SUBTRACT 1 FOR EXECUTE INSTRUCTION 00415000
TRANS EQU * @VA05422 00415100
LA R8,UPTRTBL GET UPCASE XLATE TABLE ADDR @VA10604 00415200
EX R5,UPTRANS TRANSLATE TO UPPERCASE 00416000
SPACE 1 00417000
CASEOK TM SWS,CC+FIRST IS THIS FIRST PASS WITH CC GIVEN? 00418000
BNO PRTOK BRANCH IF NOT 00419000
NI SWS,255-FIRST TURN OFF SW - IF NOT CC, NOT USED 00420000
CLI 0(R6),C'1' IS THIS ASA CHAR FOR EJECT? 00421000
BE PRTOK YES, GOOD 00422000
CLI 0(R6),X'8B' OR EJECT IMMEDIATE? 00425000
BE PRTOK YES, GOOD 00426000
L R5,BUFCTR MOVE IN OUR OWN EJECT 00427000
MVC 0(8,R5),CCWEJCT ... 00428000
LA R5,8(,R5) UPDATE BUFCTR 00429000
ST R5,BUFCTR ... 00430000
SPACE 1 00431000
PRTOK BAL R5,FILBUF GO FILL BUFFER 00432000
LA R14,MAINLOOP SET RETURN TO GET ANOTHER RECORD 00433000
TM SWS,CC IF CARRIAGE CONTROL PROVIDED... 00434000
BCR B'0001',R14 ...GO GET NEXT RECORD IMMEDIATELY 00435000
BCTR LINCNT,R14 OTHERWISE, DECREMENT LINE COUNT 00436000
OI SWS,EJEC IF EXHAUSTED, SET EJECT WANTED 00436600
BR R14 00437200
SPACE 1 00438000
* 00439000
* FOLLOWING INSTRUCTION IS THE SUBJECT INSTRUCTION OF EX 00440000
* 00441000
UPTRANS TR 0(0,R3),0(R8) TRANSLATE TO UPPERCASE @VA10604 00442000
EJECT 00443000
********************************************************************* 00444000
* 00445000
* SUBROUTINE TO CALL DMSPIO TO FILL BUFFER AND PRINT BUFFER. 00446000
* R6 = LINE LOCATION 00447000
* R7 = LINE BYTE COUNT 00448000
* R5 = RETURN ADDRESS 00449000
* LINE STARTS WITH A CARRIAGE CONTROL CHARACTER 00450000
* 00451000
********************************************************************** 00452000
SPACE 1 00453000
FILBUF EQU * 00454000
STM R0,R14,LSAVE SAVE REGISTERS 00455000
L R15,ADMSPIOC ADDRESS OF DMSPIOCC 00456000
STM R6,R7,BLDCCW+8 LINE LOC AND LENGTH TO DMSPIO PLIST 00457000
LA R1,BLDCCW ADDRESS OF DMSPIOCC PLIST 00458000
BALR R14,R15 CALL DMSPIO 00459000
BALR R15,0 REGAIN ADDRESSABILITY 00460000
USING *,R15 ... 00461000
LM R0,R14,LSAVE RESTORE REGS 00462000
DROP R15 00463000
SPACE 1 00464000
L R8,BUFCTR DETERMINE IF BUFFER IS FULL 00465000
L R9,LIMIT ... 00466000
CR R8,R9 ... 00467000
BL BUFRESM BUFFER NOT FULL - RETURN 00468000
SPACE 1 00469000
BUFFUL LM R3,R4,CCWNOP PUT NOP AT END OF BUFFER 00470000
STM R3,R4,0(R8) ... 00471000
LA R1,PRTBUF ADDRESS OF PLIST TO PRINT BUFFER 00472000
SVC 202 00473000
DC AL4(BUFERR) 00474000
LA R3,BUFDATA RESTORE BUFCTR TO BEGINNING OF BUFFER 00475000
SR R4,R4 AND ZERO BATCTR 00476000
STM R3,R4,BUFCTR ... 00477000
SPACE 1 00478000
BUFRESM LM R0,R14,LSAVE RESTORE REGISTERS AGAIN 00479000
BR R5 RETURN 00480000
EJECT 00481000
********************************************************************** 00482000
* HEX CONVERSION ROUTINE 00483000
* ON ENTRY- 00484000
* R6 HAS BUFFER START ADDRESS 00485000
* R7 HAS LENGTH OF RECORD 00486000
* 00487000
********************************************************************** 00488000
SPACE 1 00489000
HEXRTN EQU * 00490000
* PRINT HEADER IN FORM: RECORD= XXXXX LENGTH= XXXXX 00491000
HEX1 CVD R7,DECD 00492000
MVC RSZF(6),RSZM SET EDIT MASK 00493000
ED RSZF(6),DECD+5 EDIT NUMBER TO MSG 00494000
L R5,RECNO *UPDATE RECORD COUNT 00495000
CVD R5,DECD 00496000
LA R5,1(R5) INCR COUNT 00497000
ST R5,RECNO SAVE FOR NEXT TIME 00498000
MVC RNOF(6),RNOM SET EDIT MASK 00499000
ED RNOF(6),DECD+5 EDIT REC NUM TO MSG 00500000
SPACE 1 00501000
STM R6,R7,HXSAVE SAVE RECORD ADDR/LENGTH 00502000
LM R6,R7,PHDR SET FOR PRINTING HEADER 00503000
BAL R5,FILBUF PUT HEADER IN BUFFER 00504000
BCT LINCNT,HEX1A DECREMENT LINE COUNT 00505000
BAL R14,PAGE ...AND IF EXHAUSTED DO PAGE EJECT 00506000
HEX1A LM R6,R7,HXSAVE RESTORE RECORD ADDR/LENGTH 00507000
SPACE 1 00508000
* DEBLOCK AND CONVERT EACH WORD IN INPUT RECORD AND 00509000
* OUTPUT IT 00510000
* R6=BUFFER ADDR 00511000
* R7=LENGTH IN BYTES 00512000
* 00513000
SPACE 1 00514000
OUTER1 LA R8,4 INCREMENT VALUE IN R8 00515000
SR R6,R8 REDUCE R6 FOR BXH 00516000
LA R7,0(,R7) INSURE HIGH ORDER BYTE IS ZERO 00517000
LA R9,0(R7,R6) SET END OF REQUESTED BUFFER 00518000
OUTER LA R3,PBUF 00519000
LA R2,10 00520000
MVI PBUF,C' ' CLEAR BUFFER 00521000
MVC PBUF+1(129),PBUF * 00522000
INNER BXH R6,R8,ENDREC 00523000
LA R14,0(R3) 00524000
LA R15,0(R6) 00525000
UNPK HEXUNPK(9),0(5,R15) 00526000
TR HEXUNPK(9),HEXTRTBL 00527000
MVC 0(8,R14),HEXUNPK 00528000
LA R3,10(,R3) 00529000
BCT R2,INNER 00530000
SPACE 1 00531000
STM R6,R7,HXSAVE 00532000
LM R6,R7,PHEX 00533000
BAL R5,FILBUF PUT LINE IN BUFFER 00534000
BCT LINCNT,HEX1B DECREMENT LINE COUNT 00535000
LA R3,4 EXHAUSTED, CHECK IF RECORD LEFT 00535200
A R3,HXSAVE SET FOR NEXT WORD 00535400
CR R3,R9 IS THERE ONE? 00535600
BNL HEX1C BRANCH IF NOT 00535800
BAL R14,PAGE ...AND IF EXHAUSTED DO PAGE EJECT 00536000
B HEX1B 00536100
* 00536200
* RESTORE LINCNT FOR LATER BCT AND POSS. EJECT 00536300
* 00536400
HEX1C EQU * 00536500
LA LINCNT,1 00536600
HEX1B LM R6,R7,HXSAVE 00537000
B OUTER 00538000
SPACE 1 00539000
ENDREC LA R14,MAINLOOP SET RETURN IN CASE PAGE EJECT NEEDED 00540000
SR R6,R9 SEE IF ANY BYTES LEFT TO TRANSLATE 00541000
SR R8,R6 (R8 HAD A 4 IN IT) 00542000
AR R6,R9 00543000
LTR R8,R8 REMAINDER - MUST BE 0,1,2, OR 3 00544000
BNZ ENDREC1 WE HAVE 1,2, OR 3 BYTES TO TRANSLATE 00545000
LA R8,10 SEE IF ANYTHING IN PBUF 00546000
CR R2,R8 IF R2=10, WAS 1ST PASS IN INNER 00547000
BE SPACER ...AND NOTHING YET IN CLEARED PBUF 00548000
B LSTWRT OTHERWISE, MOVE PBUF TO MAIN BUFFER 00549000
SPACE 1 00550000
ENDREC1 SR R9,R9 PUT INTO R9 LENGTHS FOR EX SUBJECTS 00551000
IC R9,UNPKTBL(R8) ...BY INDEXING NO. BYTES LEFT INTO TAB 00552000
SLL R8,1 READY FOR TR MASK 00553000
BCTR R8,0 00554000
EX R9,UNPK DO UNPACK 00555000
EX R8,TR AND TRANSLATE 00556000
EX R8,MVC AND MVC 00557000
SPACE 1 00558000
LSTWRT LM R6,R7,PHEX SET REGS TO FILL BUFFER 00559000
BAL R5,FILBUF PUT LAST LINE IN BUFFER 00560000
BCT LINCNT,SPACER DECREMENT LINE COUNT, SPACE 1 00561000
OI SWS,EJEC SET EJECT WANTED 00561600
BR R14 00562200
SPACE 1 00563000
SPACER LM R6,R7,HXSPACE SET REGS TO SPACE 1 00564000
BAL R5,FILBUF SPACE 1 00565000
BCTR LINCNT,R14 DECREMENT LINE COUNT, GET NEXT RECORD 00566000
OI SWS,EJEC SET EJECT WANTED 00566600
BR R14 00567200
EJECT 00568000
********************************************************************** 00569000
* READ AND CHECK FOR 'LIB' LIBRARY. GET STORAGE AND READ DICTIONARY 00570000
* INTO IT. IF MEMBER NAME WANTED SEARCH FOR IT AND SET REGS. 00571000
* R2-LENGTH,R4-DICTIONARY LOCATION OF CURRENT NAME. 00572000
* DICTIONARY FORM- 00573000
* CL8'NAME' 00574000
* CL2'INDEX' 00575000
* CL2'LENGTH' 00576000
* 00577000
********************************************************************** 00578000
SPACE 1 00579000
MEMBS EQU * 00580000
L R7,AREA POINT TO BUFFER 00581000
ST R7,FILEBUFF STORE IN PLIST 00582000
LA R5,1 00583000
STCM R5,B'0011',FILEITNO SET ITEM NUMBER TO 1ST RECORD 00584000
LA R1,FILE READ DICTIONARY POINTER 00585000
L R15,ARDBUF RDBUF @V305066 00586000
BALR R14,R15 ... @V305066 00586100
BNZ LIBRERR ERROR RETURN @V305066 00586200
CLC 3(3,R7),=CL3'LIB' IS IT A LIBRARY FILE 00588000
BNE ERR033 NOT A LIB FILE 00589000
L R0,8(R7) GET LENGTH OF DICTIONARY 00590000
ST R0,DICTLEN SAVE 00591000
LTR R0,R0 IF LENGTH IS ZERO... 00592000
BZ ERR039 THERE ARE NO ENTRIES IN LIBRARY 00593000
LA R1,60 FIX FOR MINIMUM NUMBER DOUBLE WORDS 00594000
AR R0,R1 * 00595000
SRL R0,3 * 00596000
ST R0,STRLEN SAVE AMOUNT REQUESTED 00597000
DMSFREE DWORDS=(0) 00598000
ST R1,STRADR SAVE ADDRESS 00599000
ST R1,DICTADR SAVE STORAGE START 00600000
L R6,DICTLEN GET BUF AREA ADDR 00601000
LA R3,0(R1,R6) SET END 00602000
LA R2,72 SET INDEX FACTOR 00603000
ST R3,DICTEND SAVE END OF DICTIONARY 00604000
BCTR R3,R0 DECR FOR BXLE 00605000
LH R4,6(R7) GET INDEX FOR READ 00606000
LR R6,R1 00607000
* 00608000
RDLOOP STH R4,FILEITNO SET ITEM NO 00609000
LA R1,FILE READ PARM LIST 00610000
L R15,ARDBUF RDBUF @V305066 00611100
BALR R14,R15 ... @V305066 00611200
BNZ READERR ERROR RETURN @V305066 00611300
MVC 0(72,R6),0(R7) MOVE TO DICTIONARY 00613000
LA R4,1(,R4) INCR INDEX 00614000
BXLE R6,R2,RDLOOP GET EVERY ONE 00615000
* 00616000
L R3,DICTEND END OF DICTIONARY 00617000
L R4,DICTADR GET START ADDR 00618000
LA R2,12 00619000
BCTR R3,0 DECREMENT FOR BXLE 00620000
RDLOOP1 CLI 0(R4),X'00' NULL ENTRY? 00621000
BNZ NAMLOOP2 NO 00622000
BXLE R4,R2,RDLOOP1 LOOK AGAIN 00623000
B ERR039A ERROR NO ENTRIES 00624000
* 00625000
NAMLOOP2 ST R4,DICTADR 00626000
TM SWS,NAME ONLY ONE MEMBER WANTED? 00627000
BNO NAMLOOP1 NO,THEN WE CAN START 00628000
LA R2,12 00629000
NAMLOOP CLC 0(8,R4),NAME1 IS IT NAME 00630000
BE NAMLOOP1 YES, FOUND IT 00631000
BXLE R4,R2,NAMLOOP LOOK AT NEXT 00632000
B ERR013 NAME NOT FOUND 00633000
* 00634000
NAMLOOP1 CLC 0(2,R4),BITS IS FIRST SLOT EMPTY? 00635000
BNE NAMLOOP3 NO 00636000
LA R4,12(R4) POINT TO NEXT IF FIRST EMPTY 00637000
B NAMLOOP2 00638000
NAMLOOP3 EQU * 00639000
LH R4,8(R4) GET STARTING ITEM NO 00640000
BCTR R4,R0 FIX FOR FIRST PASS 00641000
LA R1,1(R7) RESET BUFFER ADDR 00642000
ST R1,FILEBUFF AND STORE 00643000
MVI 0(R7),X'09' FOR SINGLE SPACE 00644000
B MAINLOOP 00645000
EJECT 00646000
********************************************************************** 00647000
* 00648000
* ERROR MESSAGES 00649000
* 00650000
********************************************************************** 00651000
SPACE 1 00652000
ERRMSG1 LA R0,FILENAME 00653000
DMSERR MF=(E,'SYS'),LET=S,NUM=(4),TEXTA=(3), *00654000
SUB=(DEC,(15),CHAR8A,(0)) 00655000
BR R5 00656000
SPACE 1 00657000
LIBRERR NI SWS,255-MEMB CONSIDER AS NOT MEMB, FREE STG NOT GOT 00658000
READERR CH R15,H12 IS IT EOF? 00659000
BE NORMRET YES, ALL DONE 00660000
SPACE 1 00661000
ERR104 LA R3,BRDERR 00662000
LA R4,104 00663000
BAL R5,ERRMSG1 00664000
LA R15,100 00665000
B CLOSRET 00666000
SPACE 1 00667000
BUFERR EQU * 00668000
ERR123 C R15,=F'100' MSG GIVEN BY DMSPIO? 00669000
BE CLOSRET1 BRANCH IF SO 00670000
LA R3,PIOERR 00671000
LA R4,123 00672000
BAL R5,ERRMSG1 00673000
LA R15,100 00674000
B CLOSRET1 00675000
ERRMSG36 EQU * @VA12416 00675150
LA R0,FILEMODE POINT TO MODE LETTER @VA12416 00675300
DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00675450
LET=E,SUB=(CHARA,((R0),1)),TYPCALL=SVC @VA12416 00675600
LA R15,36 GIVE RETCODE @VA12416 00675750
B ERRET AND GO RETURN TO CALLER @VA12416 00675900
SPACE 1 00676000
ERRMSG2 LA R0,FILENAME 00677000
DMSERR MF=(E,'SYS'),LET=E,NUM=(4),TEXTA=(3), *00678000
SUB=(CHAR8A,(0)) 00679000
BR R5 00680000
SPACE 1 00681000
STATERR EQU * @VA12416 00682000
C R15,=F'36' WAS DISK NOT ACCESSED? @VA12416 00682250
BE ERRMSG36 GIVE MSG @VA12416 00682500
C R15,=F'28' FILE NOT FOUND FROM STATE? @VA12416 00682750
BNE ERRET NO, MESSAGE GIVEN BY STATE 00683000
ERR002 LA R3,NOFILE 00684000
LA R4,2 00685000
BAL R5,ERRMSG2 00686000
LA R15,28 00687000
B ERRET 00688000
SPACE 1 00689000
ERR008 LA R3,UNS 00690000
LA R4,8 00691000
BAL R5,ERRMSG2 00692000
LA R15,36 00693000
B ERRET 00694000
SPACE 1 00695000
ERR008A LA R3,INV 00696000
LA R4,8 00697000
BAL R5,ERRMSG2 00698000
LA R15,36 00699000
B ERRET 00700000
SPACE 1 00701000
ERR039 NI SWS,255-MEMB 00702000
ERR039A LA R3,NOMEMB 00703000
LA R4,39 00704000
BAL R5,ERRMSG2 00705000
LA R15,32 00706000
B FINRET 00707000
SPACE 1 00708000
ERR033 LA R3,NOTLIB 00709000
LA R4,33 00710000
BAL R5,ERRMSG2 00711000
NI SWS,255-MEMB 00712000
LA R15,32 00713000
B FINRET 00714000
SPACE 1 00715000
ERR062 LA R3,ASTER 00716000
LA R4,62 00717000
BAL R5,ERRMSG2 00718000
LA R15,20 00719000
B ERRET 00720000
SPACE 1 00721000
ERR044 LA R3,EXCED 00722000
LA R4,44 00723000
BAL R5,ERRMSG2 00724000
LA R15,32 00725000
B ERRET 00726000
SPACE 1 00727000
ERR054 LA R3,INCID 00728000
LA R4,54 00729000
BAL R5,ERRMSG2 00730000
LA R15,24 00731000
B ERRET 00732000
SPACE 1 00733000
ERRMSG3 DMSERR MF=(E,'SYS'),LET=E,NUM=(4),TEXTA=(3), *00734000
SUB=(CHARA,(9),CHARA,(6)) 00735000
BR R5 00736000
SPACE 1 00737000
ERR003 LA R3,BADOPT 00738000
LA R4,3 00739000
BAL R5,ERRMSG3 00740000
LA R15,24 00741000
B ERRET 00742000
SPACE 1 00743000
ERR013 LA R9,NAME1 00744000
LA R3,MEMNF 00745000
LA R4,13 00746000
BAL R5,ERRMSG3 00747000
LA R15,32 00748000
B FINRET 00749000
SPACE 1 00750000
ERR029 LR R6,R9 00751000
LA R9,8(,R9) 00752000
LA R3,BADPARM 00753000
LA R4,29 00754000
BAL R5,ERRMSG3 00755000
LA R15,24 00756000
B ERRET 00757000
SPACE 1 @V2D4921 00757060
ERR048 EQU * @V2D4921 00757120
LA R3,NOTMODE GET ERROR MSG ADDRESS @V2D4921 00757180
LA R4,48 SET ERROR NUMBER @V2D4921 00757240
LA R9,24(R2) POINT TO 'MODE' @V2D4921 00757300
BAL R5,ERRMSG3 GO PRINT ERROR @V2D4921 00757360
LA R15,24 SET ERROR CODE @V2D4921 00757420
B ERRET @V2D4921 00757480
SPACE 1 @V2D4921 00757540
ERR070 EQU * @V2D4921 00757600
LA R3,NOTPARM GET ERROR MSG ADDRESS @V2D4921 00757660
LA R4,70 SET ERROR NUMBER @V2D4921 00757720
BAL R5,ERRMSG3 GO PRINT ERROR @V2D4921 00757780
LA R15,24 SET ERROR CODE @V2D4921 00757840
B ERRET @V2D4921 00757900
EJECT 00758000
NOFILE DC AL1(L'NOFILEMS) 00759000
NOFILEMS DC C'FILE ''....................'' NOT FOUND' 00760000
SPACE 1 00761000
NOMEMB DC AL1(L'NOMEMBMS) 00762000
NOMEMBMS DC C'NO ENTRIES IN LIBRARY ''....................''' 00763000
SPACE 1 00764000
NOTLIB DC AL1(L'NOTLIBMS) 00765000
NOTLIBMS DC C'FILE ''....................'' IS NOT A LIBRARY' 00766000
SPACE 1 00767000
INCID DC AL1(L'INCIDMS) 00768000
INCIDMS DC C'INCOMPLETE FILEID SPECIFIED' 00769000
SPACE 1 00770000
EXCED DC AL1(L'EXCEDMS) 00771000
EXCEDMS DC C'RECORD EXCEEDS ALLOWABLE MAXIMUM' 00772000
SPACE 1 00773000
ASTER DC AL1(L'ASTERMS) 00774000
ASTERMS DC C'INVALID * IN FILEID' 00775000
SPACE 1 00776000
BRDERR DC AL1(L'BRDERRMS) 00777000
BRDERRMS DC C'ERROR ''...'' READING FILE ''....................'' FR*00778000
OM DISK' 00779000
SPACE 1 00780000
PIOERR DC AL1(L'PIOERRMS) 00781000
PIOERRMS DC C'ERROR ''...'' PRINTING FILE ''....................''' 00782000
SPACE 1 00783000
INV DC AL1(L'INVMS) 00784000
INVMS DC C'DEVICE ''00E'' INVALID OR NONEXISTENT' 00785000
SPACE 1 00786000
UNS DC AL1(L'UNSMS) 00787000
UNSMS DC C'DEVICE ''00E'' UNSUPPORTED DEVICE TYPE' 00788000
SPACE 1 00789000
BADOPT DC AL1(L'BADOPTMS) 00790000
BADOPTMS DC C'INVALID OPTION ''........''' 00791000
SPACE 1 00792000
BADPARM DC AL1(L'BADPARMS) 00793000
BADPARMS DC C'INVALID PARAMETER ''........'' IN THE OPTION ''.......*00794000
.'' FIELD' 00795000
SPACE 1 00796000
MEMNF DC AL1(L'MEMNFMS) 00797000
MEMNFMS DC C'MEMBER ''........'' NOT FOUND' 00798000
SPACE 1 @V2D4921 00798100
NOTMODE DC AL1(L'NOTMODE1) @V2D4921 00798200
NOTMODE1 DC C'INVALID MODE ''...''' @V2D4921 00798300
SPACE 1 @V2D4921 00798400
NOTPARM DC AL1(L'NOTPARM1) @V2D4921 00798500
NOTPARM1 DC C'INVALID PARAMETER ''........''' @V2D4921 00798600
EJECT 00799000
********************************************************************** 00800000
* 00801000
* RETURNS 00802000
* 00803000
********************************************************************** 00804000
SPACE 1 00805000
NORMRET SR R15,R15 CLEAR RETURN FOR NORMAL END 00806000
SPACE 1 00807000
CLOSRET LR R6,R15 SAVE RETURN CODE IN R6 00808000
L R8,BUFCTR ADDR OF NEXT LOC IN BUFFER 00809000
LA R3,BUFDATA ADDR OF START OF BUFFER 00810000
CR R3,R8 IS BUFFER EMPTY? 00811000
BE BUFMT YES, NO RESIDUAL DATA TO PUNCH 00812000
LM R3,R4,CCWNOP NO, PUT NOP AT END OF BUFFER 00813000
STM R3,R4,0(R8) ... 00814000
LA R1,PRTBUF ADDRESS OF PLIST TO PRINT BUFFER 00815000
SVC 202 00816000
DC AL4(BUFERR) 00817000
BUFMT LA R3,BUFDATA RESTORE COUNTER TO BUFFER BEGINNING 00818000
SR R4,R4 AND ZERO BATCTR 00819000
STM R3,R4,BUFCTR ... 00820000
LR R15,R6 00821000
SPACE 1 00822000
CLOSRET1 LR R6,R15 SAVE RETURN CODE IN R6 00823000
LA R1,CLOSIO SET UP TO CLOSE PRINTER 00824000
MVC CLOSION(16),FILENAME NAME OF FILE BEING OUTPUT 00825000
SVC 202 00826000
DC AL4(*+4) IGNORE ERRORS 00827000
LR R15,R6 00828000
SPACE 1 00829000
FINRET LR R6,R15 SAVE RETURN CODE IN R6 00830000
MVC FILECOMM(8),=CL8'FINIS' SET TO CLOSE FILE 00831000
LA R1,FILE ADDRESS OF FILE PLIST 00832000
L R15,AFINIS FINIS @V305066 00833000
BALR R14,R15 ... @V305066 00833100
TM SWS,MEMB IF MEMBER OPTION, RELEASE STG 00835000
BZ MAINFRET 00836000
L R1,STRADR ADDRESS OF MEMBER STG 00837000
L R0,STRLEN LENGTH OF MEMBER STG 00838000
DMSFRET DWORDS=(0),LOC=(1) 00839000
SPACE 1 00840000
MAINFRET L R1,AREA ADDRESS OF STG 00841000
L R0,STRG LENGTH OF STG 00842000
DMSFRET DWORDS=(0),LOC=(1) 00843000
LR R15,R6 RESTORE RETURN CODE 00844000
SPACE 1 00845000
ERRET L R14,UIOSAVE RESTORE RETURN ADDRESS 00846000
BR R14 00847000
EJECT 00848000
********************************************************************** 00849000
* 00850000
* STORAGE AREAS AND PLISTS 00851000
* 00852000
********************************************************************** 00853000
LTORG @VA10604 00853600
SPACE 1 00854000
FILE DS 0D 00855000
FILECOMM DC CL8' ' FILE SYSTEM COMMAND 00856000
FILENAME DC CL8' ' FILENAME 00857000
FILETYPE DC CL8' ' FILETYPE 00858000
FILEMODE DC CL2' ' FILEMODE 00859000
FILEITNO DC H'0' RECORD NUMBER 00860000
FILEBUFF DC A(*-*) BUFFER ADDRESS 00861000
FILESIZE DC A(80) BUFFER SIZE 00862000
FILEFV DC CL2'F' FIXED/VARIABLE FLAG 00863000
FILENOIT DC H'1' NUMBER OF RECORDS 00864000
FILENORD DC F'0' NUMBER OF BYTES READ 00865000
DC 8X'FF' 00866000
SPACE 1 00867000
CLOSIO DS 0D 00868000
DC CL8'CP' 00869000
DC CL8'CLOSE' 00870000
DC CL8'00E' 00871000
DC CL8'NAME' 00872000
CLOSION DS 16C 00873000
DC 8X'FF' 00874000
SPACE 1 00875000
DS 0D 00876000
BLDCCW DC CL8'DMSPIOCC' 00877000
DC A(*-*) ADDRESS OF LINE 00878000
DC A(*-*) LENGTH OF LINE 00879000
DC A(BUFCTR) ADDRESS OF BUFFER FOR DMSPIOCC 00880000
DC 8X'FF' 00881000
SPACE 1 00882000
PRTBUF DC CL8'DMSPIOSI' 00883000
DC A(BUFCTR) ADDRESS OF BUFFER FOR DMSPIOSI 00884000
DC A(*-*) 00885000
DC 8X'FF' 00886000
SPACE 1 00887000
CCWNOP CCW X'03',0,X'20',1 00888000
CCWEJCT CCW X'8B',0,X'60',1 00889000
SPACE 1 00890000
SCANFO DS 0F 00891000
DC X'FFFFFFFF5C4040404D404040' WORDS OF FF,*,( 00892000
CARRSZ DS 1H 00893000
H12 DC H'12' 00894000
AMODE DC X'C1400000' 00895000
BITS DC F'1' 00896000
KOUNT DC F'55' NUMBER OF PRINT LINES PER PAGE @V2D4921 00896500
STRG DS 1F STORAGE LENGTH 00897000
AREA DS 1F STORAGE ADDRESS 00898000
PAGCNT DS CL2 PAGE NUMBER IN PACKED DEC 00899000
LINCNT EQU 10 00900000
SWS DS 1C SWITCHES 00901000
CC EQU X'80' CARRIAGE CONTROL SUPPLIED BY CALLER 00902000
NOCC EQU X'40' USE OUR OWN CARRIAGE CONTROL 00903000
HEX EQU X'20' TRANSLATE TO HEXADECIMAL, FORMATTED 00904000
UPRCS EQU X'10' TRANSLATE TO UPPER CASE 00905000
MEMB EQU X'08' PRINT LIBRARY MEMBER(S) 00906000
NAME EQU X'04' MEMBER NAME GIVEN 00907000
FIRST EQU X'02' FIRST PASS SW - USED ONLY WITH CC 00908000
EJEC EQU X'01' EJECT WANTED 00908500
NAME1 DS 8C NAME OF MEMBER 00909000
SPACE 1 00910000
DS 0F 00911000
HEADING DS 0CL120 00912000
DC C'1FILE: ' 00913000
FILEHD DC CL93' ' 00914000
DC C'PAGE ' 00915000
HDCNT DC CL20'XXX' 00916000
SPACE 1 00917000
PABUF DC A(HEADING,L'HEADING) 00918000
SPACE 1 00919000
SPACE3 DC X'1B' CHARACTER TO SPACE 3 00920000
PASPACE DC A(SPACE3,L'SPACE3) 00921000
SPACE1 DC X'0B' CARACTER TO SPACE 1 00922000
HXSPACE DC A(SPACE1,L'SPACE1) 00923000
SPACE 1 00924000
EJECT 00925000
* 00925010
UPTRTBL EQU * UPPERCASE TRANSLATE TABLE @VA10604 00925020
* 00925030
DC X'000102030405060708090A0B0C0D0E0F' @VA10604 00925040
DC X'101112131415161718191A1B1C1D1E1F' @VA10604 00925050
DC X'202122232425262728292A2B2C2D2E2F' @VA10604 00925060
DC X'303132333435363738393A3B3C3D3E3F' @VA10604 00925070
DC X'404142434445464748494A4B4C4D4E4F' @VA10604 00925080
DC X'505152535455565758595A5B5C5D5E5F' @VA10604 00925090
DC X'606162636465666768696A6B6C6D6E6F' @VA10604 00925100
DC X'707172737475767778797A7B7C7D7E7F' @VA10604 00925110
DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' @VA10604 00925120
DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' @VA10604 00925130
DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' @VA10604 00925140
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' @VA10604 00925150
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' @VA10604 00925160
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' @VA10604 00925170
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' @VA10604 00925180
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' @VA10604 00925190
* 00925200
LSAVE DS 16F 00926000
LIMIT DC X'0000FF48' 00927000
RECNO DS 1F 00928000
DECD DS 1D 00929000
RSZM DC XL6'402020202021' 00930000
RNOM DC XL6'402020202021' 00931000
HDR DS 0CL30 00932000
DC X'09',CL29'RECORD XXXXX LENGTH= XXXXX' 00933000
HXSAVE DS 1D 00934000
PHDR DC A(HDR,L'HDR) 00935000
MAXCC DC F'65535' 00936000
PBFR DS 0CL131 00937000
DC X'09' 00938000
PBUF DC CL130' ' 00939000
PHEX DC A(PBFR,L'PBFR) 00940000
HEXUNPK DS 4F 00941000
HEXTRN DC C'0123456789ABCDEF' 00942000
HEXTRTBL EQU HEXTRN-240 00943000
UNPK UNPK HEXUNPK(0),0(0,R6) EXECUTED 00944000
TR TR HEXUNPK(0),HEXTRTBL EXECUTED 00945000
MVC MVC 0(0,3),HEXUNPK EXECUTED 00946000
UNPKTBL DC XL4'00214263' FOR EX OF UNPK 00947000
SPACE 1 00948000
RSZF EQU HDR+21 00949000
RNOF EQU HDR+7 00950000
SPACE 1 00951000
DICTLEN DS 1F 00952000
DICTADR DS 1F 00953000
DICTEND DS 1F 00954000
STRADR DS 1F 00955000
STRLEN DS 1F 00956000
DS 0D 00957000
CCWLFCB DS 0CL88 00958000
CCW X'63',DYFCBUFF,X'40',66 @VA10604 00959000
CCW X'08',DYTICTO,X'60',1 @VA10604 00960000
FCBUFF DC X'01020304050607080A0B' @VA10604 00961000
DC XL53'00' 00962000
DC X'0C0910000000000000' 00963000
SPACE 1 00964000
ENDFCB EQU * @VA10604 00965000
EJECT 00966000
ORG PRINT+4096 00967000
PAGETWO EQU * 00968000
BUFCTR DC A(BUFDATA) 00969000
BATCTR DC A(*-*) 00970000
DS 2F 00971000
BUFDATA EQU * USE FROM HERE TO 'LIMIT' @VA10604 00972000
DYFCBUFF EQU BUFDATA+(FCBUFF-CCWLFCB) @VA10604 00972100
DYTICTO EQU BUFDATA+(ENDFCB-CCWLFCB) @VA10604 00972200
EJECT 00973000
********************************************************************** 00974000
* 00975000
* DSECTS 00976000
* 00977000
********************************************************************** 00978000
SPACE 1 00979000
UIOSECT DSECT 00980000
UIOSAVE DS 1F RETURN REGISTER SAVE AREA 00981000
UIODIAG DS 0F DIAGNOSE 24 STORAGE AREA 00982000
UIOVTYPC DS 1C VIRTUAL DEVICE TYPE CLASS 00983000
CLASURI EQU X'20' UNIT RECORD INPUT DEVICE 00984000
CLASURO EQU X'10' UNIT RECORD OUTPUT DEVICE 00985000
UIOVTYPE DS 1C VIRTUAL DEVICE TYPE 00986000
TYPRDR EQU X'80' CARD READER 00987000
TYPPUN EQU X'80' CARD PUNCH 00988000
TYP1403 EQU X'41' PRINTER - 1403 00989000
TYP3211 EQU X'42' PRINTER - 3211 00990000
TYP3203 EQU X'43' PRINTER - 3203 @V386298 00990100
UIOVSTAT DS 1C VIRTUAL DEVICE STATUS 00991000
UIOVFLAG DS 1C VIRTUAL DEVICE FLAGS 00992000
EJECT 00993000
FVS 00994000
NUCON 00995000
REGEQU 00996000
END 00997000