ibm:vm370-lib:cms:dmsprt.assemble_src
Table of Contents
DMSPRT Source
References
- Fixes Applied : 2
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R12416DS]
Source Listing
- DMSPRT.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsprt.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator