ibm:vm370-lib:cms:dmstyp.assemble_src
Table of Contents
DMSTYP Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC013DS]
Source Listing
- DMSTYP.ASSEMBLE.txt
- TYP TITLE 'DMSTYP (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00010000
- * MODULE NAME: 00011000
- * 00012000
- * DMSTYP (TYPE) 00013000
- * 00014000
- * FUNCTION: 00015000
- * 00016000
- * TYPE COMMAND. TO TYPE ALL OR A SPECIFIED PART OF A 00017000
- * GIVEN FILE ON THE USER'S CONSOLE. 00018000
- * 00019000
- * ATTRIBUTES: 00020000
- * 00021000
- * DISK RESIDENT, TRANSIENT 00022000
- * NOTE: TYPE MUST BE GENMOD'D WITH THE SYSTEM OPTION 00022100
- * 00023000
- * ENTRY POINTS: 00024000
- * 00025000
- * TYPE 00026000
- * 00027000
- * ENTRY CONDITIONS: 00028000
- * 00029000
- * TYPE - 00030000
- * 00031000
- * GPR1 = A(PLIST) 00032000
- * PLIST = CL8 - CALLED ROUTINE 00033000
- * CL8 - FILENAME 00034000
- * CL8 - FILETYPE 00035000
- * <CL8 - FILEMODE> 00036000
- * CL8 - BEGINNING RECORD NUMBER, DEFAULT = FIRST RECORD 00037000
- * CL8 - ENDING RECORD NUMBER, DEFAULT = LAST RECORD 00038000
- * 00039000
- * OPTIONAL - 00040000
- * CL8'(' 00041000
- * CL8'COL' MARGIN KEYWORD 00042000
- * CL8'LL-RR' "LEFT" AND "RIGHT" MARGINS 00043000
- * CL8'MEMBER',CL8'NAME/*' 00044000
- * CL8'HEX' 00045000
- * 00046000
- * XL8 - FENCE 00047000
- * 00048000
- * EXIT CONDITIONS: 00049000
- * 00050000
- * NORMAL - 00051000
- * GPR15 = 0 00052000
- * 00053000
- * ERROR - 00054000
- * GPR15 = 20: ILLEGAL CHAR. IN FILEID V0025 00055100
- * 24: INVALID PARAMETER V0025 00055200
- * INCOMPLETE FILEID V0025 00055300
- * INVALID LINE NUMBER V0025 00055400
- * NO OPTION SPECIFIED V0025 00055500
- * COL. EXCEEDS RECORD LENGTH V0025 00055600
- * 28: FILE NOT FOUND V0025 00055700
- * 32: FILE NOT A LIBRARY V0025 00055800
- * NO ENTRIES IN LIBRARY V0025 00055900
- * 100: ERROR READING FILE V0025 00056000
- *| 00068000
- *|CALLS TO OTHER ROUTINES: 00069000
- *| 00070000
- *| DMSSTT,DMSBRD,DMSCWR,DMSFNS,DMSFRE 00071000
- *| 00072000
- *|EXTERNAL REFERENCES: 00073000
- *| 00074000
- *| NUCON 00075000
- *| 00076000
- *|TABLES/WORKAREAS: 00077000
- *| GETMAIN 00078000
- *| 00079000
- *| 00080000
- *|REGISTER USAGE: 00081000
- *| 00082000
- *| GPR1 = A(PLIST) 00083000
- *| GPR12 = ADDRESSABILITY 00084000
- *| 00085000
- *| GPR3- INTERNAL POINTER 00086000
- *| GPR2,4-10 - WORK REGS 00087000
- *| GPR14 - LINKAGE AND RETURN 00088000
- *| GPR15 - RETURN CODE 00089000
- *|NOTES: 00090000
- *| 00091000
- *| NONE 00092000
- *| 00093000
- *|OPERATION: 00094000
- *| 00095000
- *| TYPE CHECKS THE FILENAME AND FILETYPE TO ENSURE THEY 00096000
- *| ARE BOTH PRESENT AND NOT ASTERISKS. THEN THE STATE 00097000
- *| FUNCTION PROGRAM IS CALLED TO VERIFY THE EXISTENCE OF 00098000
- *| THE GIVEN FILE AND TO DETERMINE THE NUMBER OF ITEMS, 00099000
- *| FIXED OR VARIABLE FILETYPE, ETC. IF STATE CANNOT 00100000
- *| FIND THE FILE, A MESSAGE IS GIVEN. 00101000
- *| 00102000
- *| 00103000
- *| IF THE STARTING AND/OR ENDING ITEM NUMBER HAS BEEN 00104000
- *| SUPPLIED, TYPE SETS THE DMSBRD PARAMETER LIST AS 00105000
- *| NEEDED TO READ THE ITEMS DESIRED. 00106000
- *| 00107000
- *| TYPE THEN CALLS DMSBRD TO READ ITEMS ONE AT A TIME 00108000
- * INTO THE BUFFER. THESE ITEMS ARE THEN 00109000
- *| PRINTED ONLINE VIA CALLS TO CONWRITE 00110000
- *| WITH THE DESIRED OR ACTUAL LINE-LENGTH USED, UNTIL THE 00111000
- * PRINTING IS COMPLETE. 00112000
- *| 00113000
- *| IF THE OPTION MEMBER IS SPECIFIED, IT WILL BE ASSUMED 00114000
- *| THAT THE SPECIFIED FILE IS A SIMULATED PARTITIONED 00115000
- *| DATA SET (PDS). THE DICTIONARY FOR THE DATA SET IS 00116000
- *| READ TO PROVIDE THE SPECIFIED MEMBER NAME, UNLESS 00117000
- *| 'MEMBER *' IS SPECIFIED, WHICH CAUSES THE 00118000
- *| ENTIRE LIBRARY TO BE TYPED. IF "NAME IS SPECIFIED 00119000
- * THE DICTIONARY IS SEARCHED AND THE LOCATION OF 00120000
- * "NAME" IS SET INTO THE DMSBRD PARAMETER LIST. 00121000
- * READING AND TYPING PROCEED AS ABOVE. 00122000
- *| 00123000
- *| 00124000
- *| IF THE OPTION HEX IS ENTERED, EACH BUFFER LINE WILL 00125000
- * CONVERTED TO EBCDIC, A HEADER IN THE FORM 00126000
- * RECORD XXX LENGTH= XXX 00127000
- * WILL BE TYPED AND THE FILE WILL BE TYPED 00128000
- * IN AN HEXADECIMAL FORMAT. 00129000
- *| IN AN HEXADECIMAL FORMAT 00130000
- *| 00131000
- *. 00132000
- *| 00133000
- **********************************************************************, 00134000
- *. 00135000
- EJECT 00136000
- ********************************************************************** 00137000
- * 00138000
- * PROCESS PARAMETER LIST 00139000
- * 00140000
- ********************************************************************** 00141000
- DMSTYP START X'E000' TRANSIENT AREA 00142000
- TYPE EQU DMSTYP 00143000
- ENTRY TYPE COMMON NAME 00144000
- BALR BASE,0 00145000
- USING *,BASE 00146000
- USING NUCON,R0 00147000
- SSM =X'FF' ENABLE INTERRUPTS 00148000
- ST R14,SAVRET 00149000
- LA R2,0 CLEAR WORK AREA 00150000
- ST R2,START * 00151000
- STC R2,SWS * AND SWITCHES 00152000
- MVC RECNO(4),=F'1' INITIALIZE RECORD COUNT 00153000
- LR PARAM,1 SAVE PARAMETER LIST 00154000
- MVI COLSET,X'00' SET COL OPTION SW OFF. @VA04892 00154500
- CLI 8(1),X'FF' CHECK IF NAME SUPPLIED 00155000
- BC 8,ERR1 00156000
- CLI 8(R1),C'*' CHECK FOR '*' (ILLEGAL) 00157000
- BE ERR7 ILLEGAL IF = '*' . 00158000
- CLI 16(1),X'FF' 00159000
- BC 8,ERR8 00160000
- CLI 16(R1),C'*' CHECK FOR '*' (ILLEGAL) 00161000
- BE ERR7 ILLEGAL IF = '*' 00162000
- MVC FNAME(16),8(1) GET NAME AND TYPE 00163000
- TM 24(R1),X'F0' IS IT NUMERIC OR FENCE 00164000
- BO CK1 YES 00165000
- CLI 24(R1),C'*' IS IT ASTERISK 00166000
- BO CK1A YES 00167000
- CLI 24(R1),C'(' IS IT START OF OPTS 00168000
- BE CK1 YES 00169000
- CK1A MVC FMODE(2),24(R1) INITIALIZE MODE 00170000
- LA PARAM,32(R1) INCR POINTER 00171000
- B CK2 00172000
- CK1 MVC FMODE(2),=CL2'A ' INITIALIZE MODE TO A 00173000
- LA PARAM,24(R1) SET POINTER 00174000
- CK2 MVC SVCLST,=CL8'STATE' CALL STATE 00175000
- LA 1,SVCLST 00176000
- SSM TYPDIS DISABLE INTERRUPTS @VA06258 00176500
- L R15,ASTATE STATE @V305066 00177000
- BALR R14,R15 ... @V305066 00177100
- SSM TYPENA ENABLE INTERRUPTS @VA06258 00177150
- BNZ ERR3 FILE NOT FOUND @V305066 00177200
- L AC,ADD1 GET LOC. OF FST COPY 00179000
- MVC FMODE(2),24(AC) GET MODE 00180000
- MVC FVFLAG(1),30(AC) SAVE FIXED-VARIABLE FLAG 00181000
- MVC BUFSZ(4),32(AC) STORE ACTUAL LENGTH OF ITEM 00182000
- MVC JLENGTH(4),32(AC) AND 'DESIRED' LENGTH OF ITEM. 00183000
- * GET STORAGE FOR RECORD 00184000
- L R1,32(AC) SIZE OF RECORD 00185000
- LA R0,7(R1) ROUND NUMBER UP 00186000
- SRL R0,3 IN DOUBLE WORDS 00187000
- ST R0,STRG SAVE LENGTH 00188000
- DMSFREE DWORDS=(0) 00189000
- ST R1,AREA SAVE ADDRESS OF STORAGE 00190000
- LA FIRST,1 SET TO START WITH LINE 1, 00191000
- STH FIRST,NUMITEMS SET FOR 1 ITEM IN CASE NECESSARY FOR V 00192000
- LH LAST,26(,AC) SET TO END WITH LAST ITEM IN FILE. 00193000
- N LAST,=F'65535' DON'T GET FOOLED BY LARGE HALFWORD 00194000
- CLI 0(PARAM),X'FF' IS STARTING LINE SUPPLIED 00195000
- BC 8,CKLIM1 NO, START TYPING @VA01053 00196100
- CLI 0(PARAM),C'(' IS IT START OF OPTIONS 00197000
- BNE CK3 NO 00198000
- LA PARAM,8(PARAM) INCR POINTER 00199000
- B CKOPTS1 GO TO SET UP OPTIONS 00200000
- CK3 CLI 0(PARAM),C'*' IS IT = * ? 00201000
- BE CHEKENDL BE IF YES, CHECK END-LINE. 00202000
- LA AC,0(,PARAM) CALL INTERNAL ROUTINE TO CONVERT 00203000
- BAL RET,CONVRT ... 00204000
- CR AC,LAST CHECK AGAINST DATA END 00205000
- BH ERR11A GIVE ERROR MSG 00206000
- LTR AC,AC WAS NUMBER SPECIFIED AS ZERO 00207000
- BZ ERR11A ERROR IF IT WAS 00208000
- LR FIRST,AC SET STARTING LINE NO. 00211000
- ST AC,RECNO INTITIALIZE RECORD NUMBER 00212000
- CHEKENDL EQU * CHECK FOR END-LINE... 00213000
- CLI 8(PARAM),X'FF' IS LAST LINE SUPPLIED 00214000
- BC 8,PSTART NO, START PRINTING 00215000
- CLI 8(PARAM),C'(' IS BEGINNING OPTIONS 00216000
- BNE CHEK NO 00217000
- LA PARAM,16(PARAM) 00218000
- B CKOPTS1 GO SEE WHAT OPTIONS THERE ARE 00219000
- CHEK LA PARAM,8(PARAM) INCR POINTER 00220000
- CLI 0(PARAM),C'*' IS IT = '*' ? 00221000
- BE CHEKLIM BE IF YES, GO CHECK LINE LIMIT 00222000
- LA AC,0(,PARAM) CALL CONVERT.... 00223000
- BAL RET,CONVRT ... 00224000
- LTR AC,AC ZERO? 00225000
- BE ERR11A ERROR IF IT IS 00226000
- C AC,=F'65535' IS LINE WITHIN LIMIT? V0696 00227100
- BH ERR11A ERROR IF IT IS NOT P0933 00228000
- CR FIRST,AC IS FIRST RECNO > LAST RECNO? @VA03455 00228100
- BH ERR11A YES, ERROR... @VA03455 00228200
- OI SWS,EOFWNT INDICATE WE WANT EOF MESSAGE V0695 00229100
- LR LAST,AC SET LAST LINE NO. 00231000
- CHEKLIM CLI 8(PARAM),X'FF' IS THIS END OF LIST? 00232000
- BE PSTART BE IF YES, START PRINTING. 00233000
- EJECT 00234000
- LA PARAM,8(PARAM) UPDATE POINTER 00235000
- CLI 0(PARAM),C'(' START OF OPTIONS ? 00236000
- BNE ERR9 NO-THEN ERROR 00237000
- LA PARAM,8(PARAM) UPDATE POINTER TO 1ST OPTION 00238000
- B CKOPTS1 00239000
- B ERR9 ERROR IF HERE 00240000
- * 00241000
- CKOPTS LA PARAM,24(PARAM) POINT TO OPTIONS 00242000
- CKOPTS1 CLI 0(PARAM),C')' END OF PARMS 00243000
- BE CKLIM1 YES 00244000
- CLI 0(PARAM),X'FF' END 00245000
- BE CKLIM1 YES 00246000
- CLC 0(8,PARAM),=CL8'COL' IS KEYWORD="COL" 00247000
- BE SETCOL YES 00248000
- CLC 0(8,PARAM),=CL8'MEMBER' IS KEYWORD="MEMBER" 00249000
- BE SETMEMB YES 00250000
- CLC 0(8,PARAM),=CL8'MEM' 00251000
- BE SETMEMB 00252000
- CLC 0(8,PARAM),=CL8'HEX' IS KEYWORD ="HEX" 00253000
- BNE ERR9 IF NOT IT IS ERROR 00254000
- ********************************************************************** 00255000
- * 00256000
- * "HEX"OPTION WANTED 00257000
- SETHEX OI SWS,HEX TURN ON HEX SWITCH 00258000
- LA PARAM,8(PARAM) INCR POINTER 00259000
- B CKOPTS1 CONTINUE SCAN 00260000
- ********************************************************************** 00261000
- * 00262000
- * "COL" KEYWORD PRESENT - OPTION CAN ASSUME 2 FORMS @VA01248 00263000
- * 1. LIMITS SPECIFIED IN L-R FORM. @VA01248 00263100
- * SCAN FOR DELIMITER OF "-" OR OF BLANK - IF @VA01248 00263200
- * BLANK - ASSUME AS END LENGTH LRECL @VA01248 00263300
- * 2. FOR LARGE RECS L-R FORM MAY EXCEED 8 POS. @VA01248 00263400
- * "COL" OPTION MAY USE 2 PARAMETER DOUBLE WORDS. @VA01248 00263500
- * FIRST PARM SPECIFIES START COLUMN AND SECOND @VA01248 00263600
- * PARM SPECIFIES STOP LOCATION. @VA01248 00263700
- ********************************************************************** 00266000
- SETCOL LA R7,6 SET COUNTER @VA01248 00267000
- CLI COLSET,X'01' COL SPECIFIED ALREADY? @VA10595 00267100
- BE ERR9 YES, ERROR. @VA10595 00267200
- MVI COLSET,X'01' SET COL OPTION SW ON. @VA04892 00267500
- MVC COLTEMP,8(PARAM) COPY FIELD 00268000
- LA R10,COLTEMP POINT TO COPY FIELD 00269000
- CLI 0(R10),X'FF' IS IT FENCE 00270000
- BE ERR10 YES 00271000
- CLI 0(R10),C')' IS IT END 00272000
- BE ERR10 YES 00273000
- LA PARAM,8(PARAM) UPDATE POINTER 00274000
- SETCOL1 CLI 0(R10),C'-' IS IT DELIMITER 00275000
- BE SETCOL2 YES 00276000
- CLI 0(R10),X'40' IS IT BLANK 00277000
- BE NEXTPARM TWO FORMS FOR 'COL' OPTION @VA01248 00278000
- MVI FIRSTSW,X'01' INDICATE IF CODE EXECUTED @VA01248 00278100
- LA R10,1(R10) INCR POINTER 00279000
- BCT R7,SETCOL1 00280000
- LA R0,COLTEMP POINT TO ERROR FIELD 00281000
- B ERR9B GO TELL USER ABOUT MISTAKE 00282000
- NEXTPARM CLI FIRSTSW,X'01' VALID OR INVALID DELIMITER? @VA01248 00282100
- BNE SETCOL3 INVALID @VA01248 00282200
- CLI 8(PARAM),X'FF' @VA01248 00282300
- BE SETCOL3 L-R FORM @VA01248 00282400
- CLI 8(PARAM),X'F0' NUMERIC? @VA01248 00282500
- BL SETCOL3 'COL' OPTION IN FORM L-R @VA01248 00282600
- MVI PARM2SW,X'01' SW INDICATING SECOND FORM @VA01248 00282700
- B SETCOL3 @VA01248 00282800
- * 00283000
- SETCOL2 MVI 0(R10),X'40' SET LIMIT FOR CONVERT ROUTINE 00284000
- MVI FIRSTSW,X'00' TURN OFF @VA01248 00284100
- SETCOL3 LA AC,COLTEMP POINT TO FIELD 00285000
- BAL RET,CONVRT 00286000
- LTR AC,AC IS START = 0 00287000
- BZ ERR9B YES,ERROR 00288000
- C AC,JLENGTH IS REQUEST GREATER THAN LRECL? 00289000
- BH ERR12 ERROR IF IT IS 00290000
- BCTR AC,0 DECR FOR START LOCATION 00291000
- ST AC,START CONVERTED START LINE LOCATION 00292000
- CLI PARM2SW,X'01' @VA01248 00292100
- BE NEWFORM @VA01248 00292200
- CLI 1(R10),C' ' IS END COL SPECIFIED? 00293000
- BE SETCOL4 NO, USE LRECL 00294000
- LA AC,1(R10) POINT TO NEXT 00295000
- CVTSEC BAL RET,CONVRT CONVERT STOP LINE LOC @VA01248 00296000
- C AC,START END LESS THAN START? @VA08704 00296250
- BH CKRECL NO, CONTINUE @VA10594 00296500
- CLI PARM2SW,X'01' SECOND FORM USED? @VA08704 00296750
- BNE ERR9B NO, DISPLAY ERROR @VA08704 00297000
- MVI PARM2SW,X'00' RESET INDICATOR @VA08704 00297250
- LR R4,R3 POINT TO END PARAMETER @VA08704 00297500
- SH R4,H8 RETURN TO START PARAMETER @VA08704 00297750
- B ERR9C WRITE ERROR MESSAGE @VA08704 00298000
- CKRECL EQU * @VA08704 00298250
- MVI PARM2SW,X'00' RESET INDICATOR @VA08704 00298500
- C AC,JLENGTH IS REQUEST GREATER THAN LRECL 00299000
- BH ERR12 ERROR IF IT IS 00300000
- ST AC,JLENGTH 00301000
- SETCOL4 LA PARAM,8(PARAM) NEXT LOCATION 00302000
- B CKOPTS1 CONTINUE 00303000
- NEWFORM EQU * @VA08704 00303100
- LA PARAM,8(PARAM) INCREM PTR @VA01248 00303200
- MVC COLTEMP,0(PARAM) @VA01248 00303300
- LA AC,COLTEMP @VA01248 00303400
- B CVTSEC CONVERT STOP LINE LOC @VA01248 00303500
- ********************************************************************** 00304000
- * 00305000
- ** "MEMBER" OPTION SPECIFIED- TURN ON SWITCHES FOR MEMBER, IF NAME 00306000
- * SPECIFIED SAVE 00307000
- * 00308000
- SETMEMB OI SWS,MEMB TURN ON SWITCH 00309000
- CLI 8(PARAM),C'*' ALL MEMBERS WANTED ? 00310000
- BE SETMEMB1 YES 00311000
- MVC NAME1(8),8(PARAM) SAVE NAME 00312000
- CLI 8(PARAM),X'FF' IS IT FENCE 00314000
- BE ERR10 YES 00315000
- CLI 8(PARAM),C')' IS IT END 00316000
- BE ERR10 YES 00317000
- OI SWS,NAME TURN ON NAME SWITCH 00318000
- SETMEMB1 LA PARAM,16(PARAM) ADVANCE POINTER 00319000
- B CKOPTS1 00320000
- * 00321000
- CKLIM1 L R4,JLENGTH GET LERECL OR SPECIFIED LENGTH 00322000
- TM SWS,HEX PRINTING HEX RECORDS? P3058 00323000
- BO CKLIM2 YES,SKIP CHECKING P3058 00324000
- S R4,START CALCULATE LENGTH @VA01248 00325000
- C R4,M133 IS IT GREATER THAN 133 @VA01248 00325100
- BNH STLEN NO @VA01248 00325200
- LA R4,133 YES @VA01248 00325300
- B STLEN @VA01248 00325400
- CKLIM2 S R4,START CALCULATE LENGTH 00328000
- STLEN ST R4,JLENGTH THIS IS LENGTH FOR TYPE OUT @VA01248 00329000
- EJECT 00330000
- ********************************************************************** 00331000
- * 00332000
- * START PRINTING 00333000
- * 00334000
- ********************************************************************** 00335000
- PSTART L R1,AREA SET UP STARTING ARES 00336000
- MVC ADD2(3),AREA+1 SET IN PARM LIST 00337000
- ST 1,ADD1 FOR RDBUF. 00338000
- A R1,START ADD BEGINNING COLUMN 00339000
- ST R1,ADD2-1 TYPE OUT AREA 00340000
- * (NOT NECESSARY TO CALL 'POINT') 00341000
- MVC SVCLST,=CL8'RDBUF' SET P-LIST TO CALL RDBUF 00342000
- * 00343000
- MVI CARCNT,00 INITIALIZE TO PRINT CARRIAGE RETURN 00344000
- LA 1,CARET CARRIAGE RETURN BEFORE PRINTING 00345000
- SVC X'CA' ... 00346000
- * 00347000
- LOOP0A TM SWS,MEMB PROCESSING A REQUEST TO READ MEMBER? 00348000
- BO MEMBS YES, GO SET UP 00349000
- LOOP1 L EVEN,AREA START WITH BEGINNING OF BUFFER 00350000
- A EVEN,START ADJUST TO FIRST REQUESTED COLUMN 00351000
- N FIRST,=F'65535' CLEAR PROPAGATION V0696 00351100
- STH FIRST,FITEMNO STORE 'FIRST' ITEM NUMBER, 00352000
- LOOP2 LA 1,SVCLST 'RDBUF' A LARGE CHUNK OF THE INPUT FILE 00353000
- SSM TYPDIS DISABLE INTERRUPTS @VA06258 00353500
- L R15,ARDBUF ... @V305066 00354000
- BALR R14,R15 ... @V305066 00354100
- SSM TYPENA ENABLE INTERRUPTS @VA06258 00354150
- BNZ DSKERR DISK ERROR ON EOF @V305066 00354200
- * 00356000
- O EVEN,HI1 'OR' IN '01' AS NEEDED LATER. 00357000
- LR ODD,EVEN AND 00358000
- A ODD,NUMBYT REMEMBER END OF DATA. 00359000
- L AC,NUMBYT PICK UP ACTUAL LENGTH OF INPUT LINE 00360000
- BE STORE NULL LINE JUST STORE 00360010
- CLI FVFLAG,C'V' IS IT A VARIABLE FILE? @VA02754 00361100
- BNE ACO NO, CONTINUE AS USUAL @VA02754 00361200
- C AC,START IS IT LESS? @VA02754 00361300
- BNL ACOO NO, CONTINUE @VA02754 00361400
- SR AC,AC ZERO IT OUT @VA02754 00361500
- B ACOK CONTINUE @VA02754 00361600
- ACOO S AC,START GET REAL NUMBER OF BYTES @VA02754 00361700
- ACO C AC,JLENGTH IF WAS GREATER, USE 'JLENGTH' @VA02754 00361800
- BNH ACOK OK IF NOT GREATER. 00362000
- L AC,JLENGTH IF WAS GREATER, USE 'JLENGTH' INSTEAD 00363000
- ACOK TM SWS,HEX HEX CONVERT WANTED? @VA01248 00364000
- BZ CHKEQ NO @VA01248 00364100
- STORE STH AC,TYPLIN+14 STORE LENGTH IN TYPLIN PLIST @VA01248 00364200
- * 00365000
- TLOOP TM SWS,HEX HEX CONVERSION WANTED? 00366000
- BZ TLOOP1 00367000
- TM MSGFLAGS,NOTYPING IS TYPING SUPPRESSED? @VA08117 00367300
- BO CLOSE1 YES, EXIT IMMEDIATELY @VA08117 00367600
- BAL R14,HEXRTN DO HEX CONVERSION AND PRINTING IN HEX RTN 00368000
- B HEXRET RETURN FROM HEX ROUTINE 00369000
- CHKEQ C AC,JLENGTH COMPARE WITH 'DESIRED LENGTH' @VA01248 00369100
- BE EQUAL EQUAL @VA01248 00369200
- B STORE NOT EQUAL @VA01248 00369300
- EQUAL C AC,M133 TYPLIN LINES < OR = 133 @VA01248 00369400
- BNH STORE @VA01248 00369500
- L AC,M133 DEFAULT TO 133 @VA01248 00369600
- B STORE @VA01248 00369700
- TLOOP1 CLC FTYPE(8),=CL8'LISTING' IS 'FILE-TYPE' = LISTING? 00370000
- BNE FIRSTOK BNE IF NOT, FIRST CHARACTER IS OK AS IS. 00371000
- CLI 0(EVEN),X'0B' IS CONTROL CHARACTER SPC, NOPRT 00372000
- BNE KPGNG NO, GO ON 00373000
- MVI 0(EVEN),X'40' YES, MOVE IN A BLANK IN COL 1 00374000
- L R1,JLENGTH 00375000
- EX R1,CLRMVC MOVE BLANK THROUGHT LENGTH OF REC 00376000
- KPGNG EQU * @VA04892 00381000
- CLI COLSET,X'01' IS COLSET SW SET? @VA04892 00381100
- BE FIRSTOK YES,KEEP 1ST CHAR. @VA04892 00381200
- MVI 0(EVEN),X'17' REP 1ST CHAR WITH 'IDLE' FOR @VA04892 00381300
- * LIST. 00381400
- FIRSTOK TM MSGFLAGS,NOTYPING TYPING SUPPRESSED? @VA00956 00382100
- BO CLOSE1 YES, EXIT IMMEDIATELY @VA00956 00382200
- XR R1,R1 CLEAR R1. @VA14716 00382207
- LH R1,TYPLIN+14 GET LENGTH OF LINE. @VA14716 00382214
- CR R1,R1 NULL LINE JUST STORE 00382215
- BE CHKDN0 NULL LINE JUST STORE 00382216
- CHKSPCHR EQU * @VA14716 00382221
- CLI 0(EVEN),X'15' IS IT A NEW LINE CHARACTER? @VA14716 00382228
- BNE CHK1D NO, GO TRY 1D. @VA14716 00382235
- MVI 0(EVEN),X'40' YES, SET IT TO BLANK. @VA14716 00382242
- B CHKNEXT GO SET UP TO CHECK NEXT COLUMN. @VA14716 00382249
- CHK1D EQU * @VA14716 00382256
- CLI 0(EVEN),X'1D' IS IT A START LINE CHARACTER? @VA14716 00382263
- BNE CHKNEXT NO, GO SET UP TO CHECK NEXT COL. @VA14716 00382270
- MVI 0(EVEN),X'40' YES, SET IT TO BLANK. @VA14716 00382277
- CHKNEXT EQU * @VA14716 00382284
- LA EVEN,1(EVEN) POINT R1 TO NEXT COLUMN. @VA14716 00382291
- BCT R1,CHKSPCHR IF THERE'S MORE, CHECK NEXT COL. @VA14716 00382298
- CHKDN0 EQU * 00382299
- LA R1,TYPLIN NO, GO AHEAD AND TYPE LINE @VA00956 00382300
- SVC X'CA' ... 00383000
- HEXRET LA FIRST,1(,FIRST) INCREMENT COUNTER 00384000
- TM SWS,MEMB PROCESSING A LIBRARY 00385000
- BNO HEXRET1 NO 00386000
- L R1,AREA POINT TO BUFFER AREA 00387000
- * CHECK FOR DELIMITERS FOR TXTLIB AND MACLIBS 00388000
- CLC 0(4,R1),=X'61FFFF61' IS IT END OF MEMBER ? 00389000
- BE NONELEFT END BY GETTING 'EOF' V0695 00390100
- HEXRET1 CR FIRST,LAST COMPARE COUNTERS, 00391000
- BH CLOSE BH IF WE'RE ALL FINISHED. 00392000
- B LOOP1 OTHERWISE,CONTINUE V0695 00393100
- * 00395000
- CLRMVC MVC 1(0,EVEN),0(EVEN) THIS INSTR EXECUTED AT KPGNG-4 00396000
- * 00397000
- DSKERR C 15,=F'12' IF RDBUF ERROR, IS IT 12 (EOF) ? 00398000
- BNE ERR2 BNE IF NOT (SOME STRANGE ERROR) 00399000
- * 00400000
- NONELEFT TM SWS,EOFWNT DO WE WANT EOF MESSAGE? V0695 00401100
- BZ NOEOF NO, JUST GIVE HIM CARR RET. V0695 00401200
- MVI CARCNT,EOFCNT YES, PREPARE EOF MESSAGE V0695 00401300
- NOEOF LA R1,CARET SET FOR CARR RET WITH POSS. EOF V0695 00401400
- SVC 202 ... V0695 00401500
- * 00402000
- CLOSE TM SWS,MEMB 00403000
- BZ CLOSE1 IF NOT MEMBER 00404000
- TM SWS,NAME IS NAME BEING PRINTED 00405000
- BO CLOSE1 YES, THEN FINISHED 00406000
- MVI CARCNT,X'00' INITIALIZE TO PRINT CARR RET V0695 00406100
- LA R1,CARET PUT BLANK LINE BETWEEN MEMBERS V0695 00406200
- SVC 202 ... V0695 00406300
- CKLP1 L R1,DICTADR GET NEXT DICTIONARY ADDR 00407000
- LA R1,12(R1) ANOTHER MEMBER 00408000
- C R1,DICTEND END OF ALL MEMBS 00409000
- BE CLOSE1 YES 00410000
- ST R1,DICTADR NEXT DICTIONARY ADDR 00411000
- CLI 0(R1),X'00' NULL DICTIONARY ENTRY? V0695 00412100
- BE CKLP1 IF SO, LOOK AGAIN V0695 00412200
- LR FIRST,R1 FREE R1 FOR MESSAGE V0695 00412300
- LA LAST,DOTS USE LAST FOR MESSAGE V0695 00412400
- LINEDIT TEXT='MEMBER ''........''....', *00412500
- SUB=(CHARA,(FIRST),CHARA,(LAST)),DOT=NO,RENT=NO 00412600
- LR R1,FIRST RESTORE R1 V0695 00412700
- LH FIRST,8(,R1) GET STARTING LOCATION V0695 00412800
- BCTR FIRST,0 DECREMENT TO 'ITEM 0' OF MEMBER V0695 00412900
- N FIRST,=F'65535' CLEAR THOSE BYTES @VA03130 00412950
- A FIRST,SAVFRST GET STARTING ITEM NO. IN MEMBER V0695 00413000
- BYALIAS LA LAST,12(,R1) ADDRESS OF NEXT DICTIONARY ENTRY @VA00956 00413100
- C LAST,DICTEND WAS THIS THE LAST ENTRY V0695 00413200
- BE LASTDCT YES,DO IT ACCORDINGLY V0695 00413300
- LH LAST,8(,LAST) ITEM NUMBER JUST BEYOND THIS MEMBER V0695 00413400
- CH LAST,8(,R1) NEXT DICT ENTRY FOR SAME MEMBER? @VA00956 00413425
- BNE COMPO NO, IT IS NOT AN ALIAS @VA00956 00413450
- LA R1,12(,R1) YES, PROMOTE NEXT DICT ENTRY... @VA00956 00413475
- ST R1,DICTADR ...TO CURRENT @VA00956 00413500
- B BYALIAS AND RECOMPUTE ENDING ITEM NO. @VA00956 00413525
- LASTDCT LH LAST,DICTITEM ITEM NUMBER OF DICTIONARY V0695 00413600
- COMPO N LAST,=F'65535' CLEAR HIGH ORDER BYTES @VA03130 00413730
- CR FIRST,LAST IS REQUESTED ITEM BEYOND MEMBER @VA03130 00413760
- BNL CLOSE YES, SEE IF THERE IS ANOTHER MEMBER V0695 00413800
- L LAST,SAVFRST RESTORE RECNO TO STARTING NUM. V0695 00413900
- ST LAST,RECNO ... V0695 00414000
- LH LAST,8(,R1) CALCULATE ENDING RECORD WANTED V0695 00414100
- BCTR LAST,0 DECREMENT TO 'ITEM 0' OF MEMBER V0695 00414200
- N LAST,=F'65535' CLEAR THOSE BYTES @VA03130 00414250
- A LAST,SAVLAST INCREMENT TO ENDING ITEM NUMBER V0695 00414300
- B LOOP1 AND GO TYPE IT V0695 00414400
- CLOSE1 SR R15,R15 RETURN CODE 00421000
- CLOSE1A LR R6,R15 SAVE RETURN CODE 00422000
- MVC SVCLST,=CL8'FINIS' CLOSE FILE 00423000
- LA 1,SVCLST ... 00424000
- SSM TYPDIS DISABLE INTERRUPTS @VA06258 00424500
- L R15,AFINIS FINIS @V305066 00425000
- BALR R14,R15 ... @V305066 00425100
- SSM TYPENA ENABLE INTERRUPTS @VA06258 00426000
- * 00427000
- MVI CARCNT,X'00' PREPARE FOR CARRIAGE RET. V0695 00427100
- LA 1,CARET CARRIAGE RETURN AFTER PRINTING 00428000
- SVC X'CA' ... 00429000
- LR R15,R6 RESTORE CODE 00430000
- TM SWS,MEMB PROCESSING MEMBER? 00431000
- BZ CLOSE2 NO 00432000
- L R1,STRADR 00436000
- L R0,STRLEN LENGTH OF STORAGE 00437000
- DMSFRET DWORDS=(0),LOC=(1) 00438000
- LR R15,R6 RESTORE CODE 00439000
- * 00440000
- RETURN EQU * 00441000
- CLOSE2 LR R6,R15 00442000
- L R0,STRG LENGTH 00443000
- L R1,AREA ADDRESS 00444000
- DMSFRET DWORDS=(0),LOC=(1) 00445000
- LR R15,R6 RESTORE RETURN CODE 00446000
- L R14,SAVRET RESTORE RETURN ADDR 00447000
- BR 14 RETURN TO CALLER. 00448000
- EJECT 00449000
- ********************************************************************** 00450000
- * 00451000
- * INTERNAL CONVERSION ROUTINE 00452000
- * 00453000
- ********************************************************************** 00454000
- * 00455000
- * AT ENTRY, 'AC' POINTS TO BEGINNING OF NUMERIC FIELD 00456000
- * AT EXIT, 'AC' MUST HOLD THE ANSWER. 00457000
- * 00458000
- * HANDLE UP TO 8 BYTES ... 00459000
- * (JAS - 29 MAY 1969) 00460000
- * 00461000
- * (MIGHT AS WELL CONVERT WHILE SCANNING FOR 00462000
- * BLANK AND POSSIBLE ILLEGAL CHARACTERS) 00463000
- * 00464000
- CONVRT SR EVEN,EVEN CLEAR PARTIAL SUM 00465000
- SR ODD,ODD CLEAR A REGISTER 00466000
- LA 15,8 NO MORE THAN 8 BYTES 00467000
- CVTLOOP CLI 0(AC),C' ' BLANK ? 00468000
- BE CVTDONE WE'RE DONE IF YES 00469000
- IC ODD,0(,AC) PICK UP BYTE, 00470000
- SH ODD,K0 SUBTRACT C'0', 00471000
- BM ERR9A ERROR IF NOT 0-9 00472000
- MH EVEN,TEN MULTIPLY OLD PARTIAL SUM BY TEN, 00473000
- AR EVEN,ODD ADD NEW DIGIT 00474000
- LA AC,1(,AC) BUMP 'AC' FOR NEXT DIGIT 00475000
- BCT 15,CVTLOOP ITERATE TO BLANK OR 8TH CHARACTER 00476000
- CVTDONE LR AC,EVEN ANSWER INTO 'AC' 00477000
- BR RET AND RETURN TO CALLER. 00478000
- TEN DC H'10' ... 00479000
- K0 DC X'00',C'0' C'0' FOR SUBTRACT 00480000
- EJECT 00481000
- * 00482000
- * READ AND CHECK FOR 'LIB' LIBRARY. GET STORAGE AND READ DICTIONARY 00483000
- * INTO IT. IF MEMBER NAME WANTER SEARCH FOR IT AND SET REGS. 00484000
- *R2-LENGTH,R4-DICTIONARY LOCATION OF CURRENT NAME. 00485000
- * DICTIONARY FORM- 00486000
- * CL8'NAME' 00487000
- * CL2'INDEX' 00488000
- * CL2'LENGTH' 00489000
- * 00490000
- MEMBS L R7,ADD1 GET BUFFER ADDR 00491000
- MVC FITEMNO(2),=XL2'0001' INITIALIZE ITEM NUMBER 00492000
- LA R1,SVCLST READ DICTIONARY POINTER 00493000
- SSM TYPDIS DISABLE INTERRUPTS @VA06258 00493500
- L R15,ARDBUF READ DICTIONARY POINTER @V305066 00494000
- BALR R14,R15 ... @V305066 00494100
- SSM TYPENA ENABLE INTERRUPTS @VA06258 00494150
- BNZ MEMBEOF ERROR RETURN @V305066 00494200
- CLC 3(3,R7),=CL3'LIB' IS IT A LIBRARY FILE 00496000
- BNE ERR6 NOT A LIB FILE 00497000
- ST FIRST,SAVFRST SAVE STARTING RECORD NUMBER 00498000
- ST LAST,SAVLAST AND ALSO THE LAST ONE 00499000
- L R0,8(R7) GET LEN OF DICTIONARY 00500000
- ST R0,DICTLEN SAVE 00501000
- LTR R0,R0 IF LENGTH IS ZERO... 00502000
- BZ ERR4 NO ENTRIES IN LIBRARY 00503000
- LA R1,60 INSURE MINIMUM NUMBER DOUBLE WORDS 00504000
- AR R0,R1 00505000
- SRL R0,3 TO GET DOUBLE WORDS 00506000
- ST R0,STRLEN STORE AMOUNT OF SPACE REQUESTED 00507000
- DMSFREE DWORDS=(0) 00508000
- ST R1,STRADR STORAGE ADDRESS 00509000
- ST R1,DICTADR SAVE STORAGE START 00510000
- L R6,DICTLEN A(START)+LEN=A(END) 00511000
- LA R3,0(R1,R6) SET END 00512000
- LA R2,72 SET INDEX FACTOR 00513000
- ST R3,DICTEND SAVE END OF DICTIONARY 00514000
- BCTR R3,R0 DECR FOR BXLE 00515000
- LH R4,6(R7) GET INDEX FOR READ 00516000
- LR R6,R1 00517000
- B RDLOOP 00518000
- * 00519000
- RDLOOP STH R4,FITEMNO SET ITEM NO 00520000
- STH R4,DICTITEM SAVE STARTING ITEM NO FOR LATER V0695 00520100
- LA R1,SVCLST READ PARM LIST 00521000
- SSM TYPDIS DISABLE INTERRUPTS @VA06258 00521500
- L R15,ARDBUF RDBUF @V305066 00522000
- BALR R14,R15 ... @V305066 00522100
- SSM TYPENA ENABLE INTERRUPTS @VA06258 00522150
- BNZ ERR2 ... @V305066 00522200
- MVC 0(72,R6),0(R7) MOVE TO DICTIONARY 00524000
- LA R4,1(,R4) INCR INDEX 00525000
- BXLE R6,R2,RDLOOP GET EVERY ONE 00526000
- * 00527000
- RDLOOPA L R3,DICTEND END OF DICTIONARY V0695 00528100
- L R4,DICTADR GET START ADDR 00529000
- LA R2,12 00530000
- BCTR R3,0 DECREMENT FOR BXLE V0695 00531100
- RDLOOP1 CLI 0(R4),X'00' NULL ENTRY? V0011 00532100
- BNE NAMLOOP2 NO V0011 00532200
- BXLE R4,R2,RDLOOP1 LOOK AGAIN 00535000
- B ERR4 ERROR NO ENTRIES 00536000
- * 00537000
- NAMLOOP2 ST R4,DICTADR 00538000
- TM SWS,NAME ONLY ONE MEMBER WANTED? 00539000
- BNO NAMLOOP1 NO, THEN WE CAN START 00540000
- LA R2,12 00541000
- NAMLOOP CLC 0(8,R4),NAME1 IS IT NAME 00542000
- BE NAMLOOP1 YES, FOUND IT 00543000
- BXLE R4,R2,NAMLOOP LOOK AT NEXT 00544000
- B ERR5 NAME NOT FOUND 00545000
- * 00546000
- NAMLOOP1 ST R4,DICTADR ENSURE DICTADR UP TO DATE V0695 00547000
- CLI 0(R4),X'00' NULL DICTIONARY ENTRY? V0695 00548000
- BNE NAMLOOP3 NO V0695 00549000
- LA R4,12(,R4) POINT TO NEXT ENTRY V0695 00550000
- B NAMLOOP2 V0695 00551000
- SPACE 1 V0695 00552000
- NAMLOOP3 L R4,DICTADR SET DICTADR BACK 12 FOR CORRECT... V0695 00553000
- S R4,=F'12' ...ENTRY INTO TYPING LOOP V0695 00554000
- ST R4,DICTADR ... V0695 00555000
- B CKLP1 AND GO TYPE IT V0695 00556000
- SPACE 1 V0695 00557000
- MEMBEOF NI SWS,255-MEMB TREAT AS NOT MEMB, NO FREE STG YET V0695 00558000
- B DSKERR V0695 00559000
- * 00568000
- EJECT 00569000
- * 00570000
- ********************************************************************** 00571000
- * HEX CONVERSION ROUTINE 00572000
- * 00573000
- * ON ENTRY- 00574000
- * UNIT+8 HAS BUFFER START ADDR 00575000
- * UNIT+12 HAS LENGTH OF RECORD 00576000
- * 00578000
- HEXRTN STM R4,R9,HEXSAVE+8 SAVE REGS USED HERE 00579000
- L R6,TYPLIN+8 GET BUFFER START 00580000
- LH R7,NUMBYT+2 GET LENGTH V0156 00581100
- N R7,=F'65535' CLEAR PROPAGATION @VA01053 00581110
- * PRINT HEADER IN FORM: V0024 00584100
- * RECORD XXXXX LENGTH = XXXX V0024 00584200
- HEX1 CVD R7,DECD 00585000
- MVC RSZF(6),RSZM SET EDIT MASK V0024 00586100
- ED RSZF(6),DECD+5 EDIT MEMBER TO MSG V0024 00586200
- L R5,RECNO GET RECORD NO FOR TYPE HEADING 00588000
- CVD R5,DECD CONVERT RECORD COUNT FOR PRINT 00589000
- LA R5,1(R5) INCR COUNT 00590000
- ST R5,RECNO SAVE FOR NEXT TIME 00591000
- MVC RNOF(6),RNOM SET EDIT MASK 00592000
- ED RNOF(6),DECD+5 EDIT REC NUM TO MSG 00593000
- LA R1,HDRMSG PRINT HEADER 00594000
- SVC 202 CALL CMS 00595000
- DC AL4(ERR3) ERROR RETURN 00596000
- LH R7,TYPLIN+14 SET LEN TO BE TYPED V0156 00596100
- N R7,=F'65535' CLEAR PROPAGATION @VA01053 00596200
- * DEBLOCK AND CONVERT EACH WORD IN INPUT RECORD AND 00597000
- * OUTPUT IT 00598000
- * R6=BUFFER ADDR 00599000
- * R7=LENGTH IN BYTES 00600000
- * 00601000
- * 00602000
- OUTER1 LA R8,4 00603000
- SR R6,R8 REDUCE R6 FOR BXH 00604000
- LA R9,0(R7,R6) SET END OF REQUESTED BUFFER 00608000
- OUTER LA R3,PBUF+1 00609000
- LA R4,10 00610000
- MVI PBUF,C' ' CLEAR BUFFER 00611000
- MVC PBUF+1(129),PBUF * 00612000
- INNER BXH R6,R8,ENDREC 00613000
- STM R14,R15,HEXSAVE 00614000
- LA R14,0(R3) 00615000
- LA R15,0(R6) 00616000
- UNPK HEXUNPK(9),0(5,R15) 00617000
- TR HEXUNPK(9),HEXTRTBL 00618000
- MVC 0(8,R14),HEXUNPK 00619000
- LM R14,R15,HEXSAVE 00620000
- LA R3,10(,R3) 00621000
- BCT R4,INNER 00622000
- LA R1,UNIT1 TYPE HEX RECORD 00623000
- SVC 202 CALL CMS 00624000
- B OUTER CONTINUE PROCESSING 00625000
- * 00626000
- ENDREC SR R6,R9 ANY BYTES LEFT TO DO 00627000
- SR R8,R6 00628000
- AR R6,R9 00629000
- LTR R8,R8 CHECK REMAINDER 00630000
- BNZ ENDREC1 GO FINISH 00631000
- LTR R4,R4 WAS LINE FINISHED? 00632000
- BZ LSTWRT1 NO, FINISH PRINTING 00633000
- B LSTWRT YES 00634000
- ENDREC1 SR R9,R9 00635000
- IC R9,UNPKTBL-1(8) GET THE EX MASK 00636000
- SLL R8,1 READY FOR TR MASK 00637000
- BCTR R8,0 00638000
- EX R9,UNPK DO UNPACK 00639000
- EX R8,TR AND TRANSLATE 00640000
- EX R8,MVC AND MVC 00641000
- * 00642000
- LSTWRT LA R1,UNIT1 WRITE PARM LIST 00643000
- SVC 202 CALL CMS 00644000
- LSTWRT1 LM 4,9,HEXSAVE+8 00645000
- BR R14 RETURN 00646000
- TYPDIS DC X'00' @VA06258 00646300
- TYPENA DC X'FF' @VA06258 00646600
- EJECT 00647000
- ********************************************************************** 00648000
- * 00649000
- * ERROR MESSAGES 00650000
- * 00651000
- ********************************************************************** 00652000
- ERR1 DMSERR NUM=054,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00653000
- LA R15,24 00654000
- B RETURN1 00655000
- ERR2 LA R0,8(R1) POINT TO FILE ID 00656000
- DMSERR NUM=104,LET=S, V0024X00657100
- TEXT=('ERROR ''...'' READING FILE', V0024X00657200
- ' ''....................'' FROM DISK.'), V0024X00657300
- SUB=(DEC,(15),CHAR8A,(0)),RENT=NO @VA09105 00657400
- LA R15,100 00659000
- B CLOSE1A 00660000
- ERR3 EQU * @VA09572 00661000
- C R15,=F'36' WAS DISK NOT ACCESSED? @VA09572 00661250
- BE ERROR36 GIVE MSG @VA09572 00661500
- C R15,=F'28' FILE NOT FOUND? @VA09572 00661750
- BNZ RETURN1 NO,MSG GIVEN BY STATE P0350 00662000
- LA R0,8(R1) FIX POINTER 00663000
- DMSERR NUM=2,LET=E,TEXT='FILE ''....................'' NOT X00664000
- FOUND',SUB=(CHAR8A,(0)) 00665000
- ERR3A LA R15,28 ERROR CODE 00666000
- B RETURN1 00667000
- ERR4 LA R0,FNAME 00668000
- DMSERR NUM=039,LET=E,TEXT='NO ENTRIES IN LIBRARY ''...........X00669000
- .......''',SUB=(CHAR8A,(0)) 00670000
- NI SWS,255-MEMB RESET SWITCH TO AVOID CALL TO DMSFRE 00671000
- LA R15,32 SET RETURN CODE 00672000
- B CLOSE1A 00673000
- ERR5 LA R0,NAME1 POINT TO PARAMETER 00674000
- DMSERR NUM=013,LET=E,TEXT='MEMBER ''........'' NOT FOUND IN X00675000
- LIBRARY',SUB=(CHARA,(0)) 00676000
- LA R15,32 SET RETURN CODE 00677000
- B CLOSE1A 00678000
- ERROR36 EQU * @VA09572 00678150
- LA R0,FMODE POINT TO MODE LETTER @VA09572 00678300
- DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00678450
- LET=E,SUB=(CHARA,((R0),1)),TYPCALL=SVC @VA09572 00678600
- LA R15,36 GIVE RETCODE @VA09572 00678750
- RETURN1 L R14,SAVRET RETURN ADDRESS 00679000
- BR R14 00680000
- ERR6 LA R0,8(R1) POINT TO FILE 00681000
- DMSERR NUM=033,LET=E,TEXT='FILE ''..................'' IS NOT X00682000
- A LIBRARY ',SUB=(CHAR8A,(0)) 00683000
- LA R15,32 SET RETURN CODE 00684000
- B RETURN 00685000
- * 00686000
- ERR7 DMSERR NUM=062,LET=E,TEXT='INVALID * IN FILEID' 00687100
- LA R15,20 SET RETURN CODE P0766 00688000
- B RETURN1 RETURN 00689000
- * 00690000
- ERR8 EQU ERR1 00691000
- * 00692000
- ERR9 DMSERR NUM=3,LET=E,TEXT='INVALID OPTION ''........''', X00693000
- SUB=(CHARA,(3)) 00694000
- LA R15,24 SET RETURN CODE 00695000
- B RETURN 00696000
- ERR9A DMSERR NUM=29,LET=E,TEXT='INVALID PARAMETER ''........''', X00697000
- SUB=(CHARA,(3)) 00698000
- LA R15,024 00699000
- B RETURN 00700000
- ERR9B LR R4,R3 POINT TO THE PARAMETER 00701000
- ERR9C EQU * @VA08704 00701050
- MVI FIRSTSW,X'00' TURN OFF @VA01248 00701100
- S R4,=F'8' POINT TO OPTION 00702000
- DMSERR NUM=29,LET=E,TEXT='INVALID PARAMETER ''........'' IN THE00703000
- E OPTION ''........'' FIELD',SUB=(CHARA,(3),CHARA,(4)),RX00704000
- ENT=NO @VA08704 00705000
- LA R15,24 SET RETURN CODE 00706000
- B RETURN RETURN 00707000
- * 00708000
- ERR10 LA R10,0(PARAM) SET OPTION POINTER @VA02476 00709300
- DMSERR NUM=005,LET=E,TEXT='NO ''........'' SPECIFIED', X00709600
- SUB=(CHARA,(10)) 00710000
- LA R15,24 00711000
- B RETURN 00712000
- * 00713000
- ERR11 LA R3,8(PARAM) POINT TO ERROR 00714000
- ERR11A DMSERR NUM=49,LET=E,TEXT='INVALID LINE NUMBER ''........''', X00715000
- SUB=(CHARA,(3)) 00716000
- LA R15,24 SET RETURN CODE 00717000
- B RETURN RETURN 00718000
- ERR12 DMSERR NUM=9,LET=E,TEXT='COLUMN ''........'' EXCEEDS RECORD LEX00719000
- NGTH',SUB=(DEC,(4)) 00720000
- LA R15,24 SET RETURN CODE 00721000
- B RETURN RETURN 00722000
- LA R15,24 00723000
- B RETURN 00724000
- DS 0F 00725000
- CARET DC CL8'TYPLIN' TYPE A CARRIAGE RETURN ... 00726000
- DC AL1(1) 00727000
- DC AL3(EOF) 00728000
- DC C'K' 00729000
- DC X'0000' (FIRST 2 BYTES OF COUNT) 00730000
- CARCNT DC AL1(*-*) 07 FOR EOF & CAR. RTN., 00 FOR CAR. RTN. ONLY 00731000
- EOF DC X'40164016',C'-EOF-' EOF WITH JIGGLE V0695 00732100
- EOFCNT EQU *-EOF (COUNT FOR MVI) 00733000
- * 00734000
- EJECT 00735000
- ********************************************************************** 00736000
- * 00737000
- * SVC PARAMETER LISTS 00738000
- * 00739000
- ********************************************************************** 00740000
- DS 0F 00741000
- * 00742000
- SVCLST DC CL8' ' ROUTINE 00743000
- FNAME DC CL8' ' FILE NAME 00744000
- FTYPE DC CL8' ' FILE TYPE 00745000
- FMODE DC CL2' ' MODE 00746000
- FITEMNO DC H'1' ITEM NO. 00747000
- ADD1 DC A(*-*) USER MEMORY ADDRESS, FILLED BY STATE, THEN=ADD2. 00748000
- BUFSZ DC F'2000' NO OF BYTES TO READ 00749000
- FVFLAG DC CL2'F' FIXED/VARIABLE FLAG 00750000
- NUMITEMS DC H'1' NO. OF ITEMS 00751000
- NUMBYT DC A(*-*) NO. OF BYTES ACTUALLY READ 00752000
- * 00753000
- TYPLIN DC CL8'TYPLIN' ROUTINE 00754000
- DC AL1(1) 00755000
- ADD2 DC AL3(*) I/O BUFFER-LOCATION 00756000
- DC C'B' 00757000
- DC AL3(*-*) NO. OF BYTES 00758000
- H8 DC H'8' FOR SHIFT TO NEXT PLIST ENTRY @VA08704 00759000
- JLENGTH DC F'0' ANTICIPATED OR TRUNCATED LENGTH OF INPUT 00760000
- ACTUAL DC F'80' ACTUAL ITEM-LENGTH IS FILLED IN HERE. 00761000
- HI1 DC AL1(1),AL3(0) FOR FILLING IN TYPLIN PLIST 00762000
- * 00763000
- UNIT1 DS 0F 00764000
- DC CL8'TYPLIN' UNIT 00765000
- DC A(PBUF) BUFFER 00766000
- DC A(L'PBUF) LENGTH 00767000
- DS 2H 00768000
- * 00769000
- PBUF DC CL130' ' PRINT BUFFER 00770000
- NAME1 DS 8C MEMBER NAME SAVE AREA 00771000
- SWS DS 1C SWITCHES FOR PROGRAM CONTROL 00772000
- FIRSTSW DC X'00' SW FOR NEW FORMAT OF COL OPT @VA01248 00772100
- PARM2SW DC X'00' SW FOR NEW FORMAT OF COL OPT @VA01248 00772200
- COLSET DC X'00' SW TO INDICATE COL OPTION USED. @VA04892 00772600
- MEMB EQU X'01' MEMBER REQUEST 00773000
- NAME EQU X'02' NAME OF MEMBER GIVEN 00774000
- HEX EQU X'04' HEX CONVERSION WANTED 00775000
- EOFWNT EQU X'08' WANT 'EOF' MSG - END RECNO GIVEN V0695 00775100
- * 00776000
- STRG DS 1F NUMBER DOUBLE WORDS 00777000
- AREA DC A(IOAREA) ADDRESS OF I/O BUFFER 00778000
- START DS 1F START COL LOCATION 00779000
- STOP DS 1F ENDING COL LOCATION 00780000
- M133 DC F'133' MAX REC LEN FOR REGULAR TYPE P3058 00781000
- * 00782000
- SAVRET DS 1F RETURN ADDR 00783000
- HEXSAVE DS 8F 00784000
- COLTEMP DS CL8 'SETCOL' TEMP STORAGE 00785000
- BUFZONE DC CL4' ' BLANKS MUST FOLLOW DECIMAL FIELD @VA08758 00785500
- RECNO DS 1F 00786000
- RSZM DC XL6'402020202021' RECSIZE FIELD EDIT MASK V0024 00787100
- RNOM DC XL6'402020202021' RECORD NUMBER FIELD EDIT MASK 00788000
- DEC DS 1F 00790000
- DECD DS 1D 00791000
- HEXUNPK DS 4F 00792000
- HEXTRN DC C'0123456789ABCDEF' 00793000
- HEXTRTBL EQU HEXTRN-240 00794000
- UNPK UNPK HEXUNPK(0),0(0,R6) EXECUTED 00795000
- TR TR HEXUNPK(0),HEXTRTBL EXECUTED 00796000
- MVC MVC 0(0,3),HEXUNPK 00797000
- UNPKTBL DC XL3'214263' FOR EX OF UNPK 00798000
- DICTLEN DS 1F 00799000
- DICTADR DS 1F 00800000
- DICTEND DS 1F END ADDR OF DICTIONARY 00801000
- HDRMSG DS 0F 00802000
- DC CL8'TYPLIN' UNIT 00803000
- DC A(HDR) BUFFER ADDR 00804000
- DC A(L'HDR) LENGTH 00805000
- DS 2H 00806000
- HDR DC CL27' RECORD XXXXX LENGTH= XXXX ' HDR FOR HEX V0024 00807100
- RNOF EQU HDR+7 00808000
- RSZF EQU HDR+21 00809000
- SAVFRST DS 1F SAVE FIRST RECORD 00810000
- SAVLAST DS 1F SAVE LAST RECORD NUMBER 00811000
- DICTITEM DS 1H SAVE START OF DICTIONARY FOR MEMB V0695 00811100
- DS 0F 00811200
- DOTS DC X'4B4B4B4B' DOTS FOR MESSAGE V0695 00811300
- STRADR DS 1F 00812000
- STRLEN DS 1F AMT OF STORAGE FROM FREE 00813000
- * 00814000
- EJECT 00815000
- ********************************************************************** 00816000
- * 00817000
- * STORAGE AND DEFINITIONS 00818000
- * 00819000
- ********************************************************************** 00820000
- * 00821000
- * DEFINITIONS 00822000
- * 00823000
- BASE EQU 12 00824000
- PARAM EQU 3 00825000
- AC EQU 4 00826000
- FIRST EQU 5 00827000
- LAST EQU 6 00828000
- RET EQU 7 00829000
- EVEN EQU 8 00830000
- ODD EQU 9 00831000
- REGEQU 00832000
- * 00833000
- LTORG PUT LITERALS HERE ... 00834000
- IOAREA DS 3200C I/O BUFFER 00835000
- * 00836000
- NUCON 00837000
- * 00838000
- END 00839000
ibm/vm370-lib/cms/dmstyp.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator