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 * 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