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