DSV TITLE 'DMSDSV (CMS) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 00002000
* IBM DISK OPERATING SYSTEM 00003000
* LIBRARIAN - 5745-SC-LBR 00004000
*. 00005000
* 00006000
* MODULE NAME: 00007000
* 00008000
* DMSDSV (DSERV) 00009000
* 00010000
* FUNCTION: 00011000
* 00012000
* DMSDSV WILL LIST THE DIRECTORIES OF DOS PRIVATE 00013000
* OR SYSTEM PACKS. 00014000
* 00015000
* ATTRIBUTES: 00016000
* 00017000
* NON-REUSABLE NON-REENTRANT 00018000
* 00019000
* ENTRY POINT: 00020000
* 00021000
* DMSDSV 00022000
* 00023000
* ENTRY CONDITION: 00024000
* 00025000
* R1 - PLIST 00026000
* 00027000
* PLIST: 00028000
* CL8'DSERV' 00029000
* CL8'DIRECTORY' 00030000
* CL8'DIRECTORY' OPTIONAL 00031000
* CL8'PHASE' OPTIONAL WITH 'CD' 00032000
* CL8'PHASENAME' DITTO 00033000
* CL8'NUMBER' DITTO 00034000
* CL8'(' IF OPTIONS DESIRED 00035000
* CL8'SORT' IF ALPHAMERIC SORT WANTED 00036000
* CL8'TERM','DISK','PRINT' 00037000
* 00038000
* DIRECTORY - SPECIFIES TYPES OF DIRECTORIES 00039000
* TO BE DISPLAYED. THE ALLOWED TYPES ARE 00040000
* 'CD' (CORE IMAGE DIRECTORY), 'RD' (RELOCATABLE 00041000
* DIRECTORY), 'SD' (SOURCE STATEMENT DIRECTORY), 00042000
* 'TD' (TRANSIENT DIRECTORY), 00043000
* 'PD' (PROCEDURE DIRECTORY) OR 'ALL'. 00044000
* THE USER PRIVATE LIBRARIES WILL 00045000
* TAKE PRECEDENCE OVER SYSTEM DIRECTORIES. 00046000
* 00047000
* PHASE - SPECIFIES THAT THE NEXT ENTRY WILL 00048000
* BE THE PHASENAME (VALID ONLY WITH CD). 00049000
* 00050000
* PHASENAME - THE NAME OF THE PHASE TO BE 00051000
* LISTED. IF THE PHASENAME ENDS WITH AN 00052000
* ASTERISK, ALL PHASES THAT START WITH THE 00053000
* LETTERS BEFORE THE ASTERISK WILL BE 00054000
* DISPLAYED. 00055000
* 00056000
* NUMBER - THE OFFSET WITHIN THE PHASE WHERE 00057000
* THE VERSION AND MOD LEVEL ARE TO BE FOUND 00058000
* (DEFAULT IS TWELVE). 00059000
* 00060000
* SORT - SPECIFIES THAT THE ENTRIES ARE TO BE 00061000
* SORTED ALPHAMERICALLY, OTHERWISE THE ORDER 00062000
* WILL BE THE ORDER THEY WERE CATALOGED. 00063000
* 00064000
* TERM - THE OUTPUT WILL BE DISPLAYED ON THE 00065000
* USERS TERMINAL. 00066000
* 00067000
* DISK - THE OUTPUT WILL BE STORED ON A CMS 00068000
* DISK WITH A FILENAME OF DSERV AND A FILETYPE 00069000
* OF MAP (THIS IS THE DEFAULT). 00070000
* 00071000
* PRINT - THE OUTPUT WILL BE PRINTED ON THE 00072000
* SYSTEM OUTPUT DEVICE. 00073000
* 00074000
* EXIT CONDITIONS: 00075000
* 00076000
* NORMAL - RETURN TO CMS VIA R14, R15=ZERO. 00077000
* ERROR - RETURN TO CMS VIA R14, R15=NON-ZERO. 00078000
* 00079000
* CALLS TO OTHER ROUTINES: 00080000
* 00081000
* DMSERR, DMSPRT 00082000
* 00083000
* EXTERNAL REFERENCES: 00084000
* 00085000
* NONE 00086000
* 00087000
* TABLES/WORKAREAS: 00088000
* 00089000
* PNBUCKET - PHASE NAME BUCKET USED TO SELECT THE 00090000
* SPECIFIC PHASES(S) IN CORE IMAGE LIBRARY. 00091000
* 00092000
* LIBAREA - 1024-BYTE CD LIBRARY READIN AREA FOR 00093000
* SEARCHING VERSION AND MOD LEVEL. 00094000
* 00095000
* RLAREA - 80-BYTE REL DIR INFORMATION RECORD READIN AREA CMS 00096000
* 00097000
* SLAREA - 80-BYTE SS DIR INFORMATION RECORD READIN AREA 00098000
* 00099000
* PLAREA - 80-BYTE PROC DIR INFORMATION REC READIN AREA 00100000
* 00101000
* REGISTER USAGE: 00102000
* 00103000
* R1 - INPUT PLIST 00104000
* R2-R11 - WORK REGISTERS 00105000
* R12 - WORK AREAS, COMMON ROUTINES 00106000
* R13 - ROUTINE BASE 00107000
* R14-R15 - WORK REGISTERS 00108000
* 00109000
* OPERATION: 00110000
* 00111000
* CONTROL ENTERS DSERV AT THE LOCATION STARTA. 00112000
* A CHECK IS MADE TO DETERMINE DOS IS ACTIVE AND CONTROL 00113000
* IS THEN PASSED TO DSERV1 TO CHECK FOR PLIST ERRORS 00114000
* AND THE OPERATIONS DESIRED. ALSO, TESTS ARE MADE TO 00115000
* DETERMINE IF SYSTEM OR PRIVATE LIBRARIES ARE ASSIGNED 00116000
* AND APPROPRIATE INDICATORS ARE SET. THE BRANCH TABLE 00117000
* IS SET TO PASS CONTROL TO THE ROUTINE THAT PERFORMS 00118000
* THE DESIRED OPERATION. AT THE CONCLUSION OF THE 00119000
* OPERATION, CONTROL RETURNS TO DSERV1 TO CHECK FOR 00120000
* ANOTHER OPERATION OR, IF NONE, TO TERMINATE THE 00121000
* PROGRAM. 00122000
* 00123000
* DSERV2 RECEIVES CONTROL IF THE DESIRED OPERATION 00124000
* IS TO PRINT THE TRANSIENT OR CORE IMAGE DIRECTORY. 00125000
* THE HEADER IS INITIALIZED AND A RECORD IS READ. IF 00126000
* A CD REQUEST WAS MADE WITH A PHASENAME, THE DIRECTORY 00127000
* IS SEARCHED FOR THE SPECIFIED PHASENAME. THE HEADER 00128000
* IS THEN PRINTED AND THE DIRECTORY ENTRIES ARE MASSAGED 00129000
* TO FIT THE OUTPUT FORMAT. ADDITIONAL RECORDS ARE READ 00130000
* AND PRINTED UNTIL THE REQUEST IS SATISFIED, THEN 00131000
* CONTROL RETURNS TO DSERV1. 00132000
* 00133000
* DSERV3 RECEIVES CONTROL IF THE DESIRED OPERATION 00134000
* IS TO PRINT THE RELOCATABLE, SOURCE STATEMENT, OR 00135000
* PROCEDURE DIRECTORY. THE RECORDS ARE READ INTO CORE 00136000
* AND SORTED IF SORT WAS SPECIFIED. IF NOT ENOUGH CORE 00137000
* IS AVAILABLE, THE ADDITIONAL RECORDS WILL BE READ IN 00138000
* SUBSEQUENT PASSES UNTIL ALL ARE PROCESSED. CONTROL 00139000
* IS THEN PASSED TO THE PROPER PRINT ROUTINE. 00140000
* 00141000
* DSERV4 RECEIVES CONTROL IF THE RELOCATABLE OR 00142000
* SOURCE STATEMENT DIRECTORY IS TO BE PRINTED. RELOC- 00143000
* ATABLE DIRECTORY ENTRIES ARE FORMATTED TO RESEMBLE 00144000
* SOURCE STATEMENT DIRECTORY ENTRIES FOR COMMON PRINT 00145000
* ROUTINE AND THE ENTRIES ARE TRANSLATED TO PRINTABLE 00146000
* CHARACTERS. WHEN ALL THE RECORDS ARE PRINTED, A 00147000
* CHECK IS MADE TO DETERMINE IF MORE ARE AVAILABLE. 00148000
* IF SO, A SWITCH IS SET TO INDICATE TO DSERV1 TO 00149000
* RETURN TO DSERV3. 00150000
* 00151000
* DSERV5 RECEIVES CONTROL IF THE PROCEDURE 00152000
* DIRECTORY IS TO BE PRINTED. THE DIRECTORY ENTRIES 00153000
* ARE TRANSLATED TO PRINTABLE CHARACTERS AND PRINTED. 00154000
* WHEN COMPLETE, A CHECK IS MADE TO DETERMINE IF MORE 00155000
* ENTRIES ARE AVAILABLE. IF SO, A SWITCH IS SET TO 00156000
* INDICATE TO DSERV1 TO RETURN TO DSERV3. 00157000
* 00158000
*. 00159000
EJECT 00160000
USING NUCON,R0 @V305096 00161000
DMSDSV CSECT @V305065 00162000
SPACE 1 00163000
* THE FOLLOWING ENTRY IS NOT USED BY DSERV, IT IS ONLY USED 00164000
* TO FULFILL STANDARD REQUIREMENTS. 00165000
ENTRY IJJCPD3 DUMMY ENTRY @V305096 00166000
SPACE 00167000
ROOTPH DC C'DSERV ' PHASE NAME @V305096 00168000
SPACE 00169000
*********************************************************************** 00170000
***** ***** 00171000
***** CURRENT VERSION AND MOD LEVEL - THESE TWO BYTES MUST BE ***** 00172000
***** UPDATED FOR EACH RELEASE ***** 00173000
***** ***** 00174000
VERSION DC X'2900' VERSION AND MOD. LEVEL @V305096 00175000
MODLEVEL EQU VERSION+1 MOD LEVEL BYTE @V305096 00176000
***** ***** 00177000
*********************************************************************** 00178000
SPACE 2 00179000
*********************************************************************** 00180000
***** INITIALIZE THE BASE REG AND OVERLAY PHASES BASE REG * 00181000
***** LOAD NEXT PROCESSING OVERLAY PHASE * 00182000
*********************************************************************** 00183000
SPACE 00184000
STARTA BALR R12,R0 LOAD BASE REG @V305096 00185000
USING *,R12 SPECIFY BASE REG TO ASSEMBLER@V305096 00186000
SL R12,VMDISP BASE REG TO START OF CSECT @V305096 00187000
USING ROOTPH,R12 SPECIFY LOCATION TO ASSEMBLR @V305096 00188000
ST R14,R14SAVE SAVE RETURN REGISTER @V305065 00189000
DMSKEY NUCLEUS @V305065 00190000
TM DOSFLAGS,DOSMODE IS DOS ACTIVE? @V305065 00191000
BZ NODOS BRANCH IF NOT @V305065 00192000
L R13,20 POINT TO COMM. REGION @V305065 00193000
USING BGCOM,R13 @V305065 00194000
MVC COMNAME(8),ROOTPH MOVE IN PROGRAM NAME @V305065 00195000
DROP R13 @V305096 00196000
DMSKEY RESET @V305065 00197000
SPACE 2 00198000
FETCH L R13,PHASNAME ADDR OF PHASE TO LOAD @V305096 00199000
SLL R13,2 GET OFFSET @V305065 00200000
L R13,PHASNAME(R13) GET PHASE ADDRESS @V305065 00201000
BR R13 GO TO PHASE @V305065 00202000
SPACE 2 00203000
FINAL EQU * @V305065 00204000
FSCLOSE ,FSCB=MAP CLOSE MAP FILE(IF ONE) @V305065 00205000
DMSKEY NUCLEUS @V305065 00206000
FINAL1 EQU * @V305065 00207000
TM CMSSWT,PRTOPT WAS PRINTER SPECIFIED? @V305065 00208000
BZ FINALA BRANCH IF NOT @V305065 00209000
LA R1,CLSPLST POINT TO PLIST @V305065 00210000
SVC 202 ISSUE CP CLOSE FOR PRINTER @V305065 00211000
DC AL4(FINALA) @V305065 00212000
FINALA EQU * @V305065 00213000
TM DOSFLAGS,DOSMODE IS DOS ACTIVE? @VA06147 00213300
BZ FINALB BRANCH IF NOT @VA06147 00213700
L R1,20 POINT TO COMM. REGION @V305065 00214000
USING BGCOM,R1 @V305065 00215000
MVC COMNAME(8),=CL8'CMS/DOS' MOVE IN DEFAULT NAME @V305065 00216000
DROP R1 @V305096 00217000
FINALB EQU * @VA06147 00217500
DMSKEY RESET @V305065 00218000
L R14,R14SAVE RESTORE RETURN REGISTER @V305065 00219000
SR R15,R15 CLEAR REGISTER @V305065 00220000
IC R15,ERCODE GET ERROR CODE @V305065 00221000
BR R14 RETURN TO CMS @V305065 00222000
EJECT 00223000
SPACE 3 00224000
*********************************************************************** 00225000
***** ROUTINE TO PRINT ERROR MESSAGES OR A DIRECTORY LISTING * 00226000
*********************************************************************** 00227000
SPACE 00228000
PRINT SR R0,R0 CLEAR LINE COUNTER REG @V305096 00229000
IC R0,LINES GET REMAINING LINES @V305096 00230000
TM SWA,HEADIND NEED A HEADER FOR NEW PAGE @V305096 00231000
BZ REDUCE NO @V305096 00232000
XI SWA,HEADIND RESET NEED HEADER IND @V305096 00233000
MVI PRINTA,SKIP1 SET ASA CODE TO SKIP TO 1 @V305096 00234000
REDUCE EQU * @V305065 00235000
TM CMSSWT,PRTOPT WAS PRINT SPECIFIED? @V305065 00236000
BZ SAVER0 BRANCH IF NOT @V305065 00237000
BCT R0,SAVER0 IF ZERO, GET NEW LINE COUNT @V305096 00240000
IC R0,LINECTR REINIT LINE COUNTER REG @V305096 00241000
OI SWA,HEADIND SET NEED HEADER IND @V305096 00242000
SAVER0 STC R0,LINES SAVE LINE COUNT @V305096 00243000
TM CMSSWT,PRTOPT WAS PRINT SPECIFIED? @V305065 00244000
BZ TYPE BRANCH IF NOT @V305065 00245000
PRTLINE EQU * @V305065 00246000
PRINTL PRINTA,121,ERROR=PRTERR @V305065 00247000
PRTCLEAR EQU * @V305065 00248000
SPACE 00249000
MVC PRINTA,BLANKER CLEAR PRINT AREA @V305096 00250000
BR R9 EXIT TO CALLER @V305096 00251000
EJECT 00252000
TYPE EQU * @V305065 00253000
TM CMSSWT,TYPOPT WAS TYPE SPECIFIED? @V305065 00254000
BZ DISK BRANCH IF NOT @V305065 00255000
WRTERM PRINTB,121 TYPE LINE @V305065 00256000
B PRTCLEAR AND RETURN @V305065 00257000
EJECT 1 00258000
DISK EQU * @V305065 00259000
FSWRITE ,FSCB=MAP,ERROR=WRITERR @V305065 00260000
B PRTCLEAR RETURN @V305065 00261000
EJECT 1 00262000
WRITERR EQU * @V305065 00263000
LR R3,R15 SAVE ERROR CODE @V305065 00264000
LA R6,8(,R1) POINT TO FILENAME @V305065 00265000
DMSERR MF=(E,ERRLIST),NUM=105,TEXT='ERROR ''..'' WRITING FILE X00266000
''....................'' ON DISK',LET=S, @V305065X00267000
SUB=(DEC,(3),CHARA,(6)) @V305065 00268000
MVI ERCODE,HUND SET ERROR CODE @V305065 00269000
B FINAL @V305065 00270000
EJECT 1 00271000
PRTERR EQU * @V305065 00272000
MVI PRINTA,C'+' SUPPRESS SPACE @V305065 00273000
CH R15,=H'3' CHANNEL 9? @V305065 00274000
BE PRTLINE REPRINT LINE IF SO @V305065 00275000
OI SWA,HEADIND INDICATE NEW HEADER @V305065 00276000
CH R15,=H'2' CHANNEL 12 SENSED? @V305065 00277000
BE PRTLINE REPRINT LINE IF SO @V305065 00278000
LR R3,R15 GET ERROR CODE @V305065 00279000
DMSERR NUM=245,LET=S,SUB=(DEC,(R3)), @V305065X00280000
TEXT='ERROR ''...'' ON PRINTER' @V305065 00281000
MVI ERCODE,HUND SET ERROR CODE @V305065 00282000
B FINAL @V305065 00283000
EJECT 1 00284000
NODOS EQU * @V305065 00285000
DMSERR NUM=099,LET=E, @V305065X00286000
TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE' @V305065 00287000
MVI ERCODE,FORTY RETURN CODE = 40 @V305066 00288000
B FINAL1 @V305065 00289000
EJECT 1 00290000
***** CONSTANTS - COMMON TO ALL PHASES, LOCATED IN THE ROOT PHASE 00291000
***** SAVE AREAS, BUCKETS, FLAGS, ETC FOR FOLLOWING PHASES 00292000
SPACE 1 00293000
SAVEREGS DC 2F'0' REGISTER SAVE AREA @V305096 00294000
R14SAVE DC F'0' @V305065 00295000
SORTSTRT DC A(ENDDSERV) START OF SORT AREA ADDR @V305096 00296000
VMDISP DC F'12' INIT STANDARD VM LOCATION @V305096 00297000
PNBUCKET DC CL8' ' PHASE NAME BUCKET @V305096 00298000
PHASNAME DC F'1' PHASE NAME TO BE FETCHED@V305096 00299000
PHASENO EQU PHASNAME+3 PHASE CHARACTER NAME @V305096 00300000
PHASE DC A(DSERV1) PHASE ADDRESSES @V305065 00301000
DC A(DSERV2) @V305065 00302000
DC A(DSERV3) @V305065 00303000
DC A(DSERV4) @V305065 00304000
DC A(DSERV5) @V305065 00305000
ENTRIES DC F'0' NO. OF ENTRIES ON FULL PAGES @V305096 00306000
SORTEND DC F'0' END OF SORT AREA ADDR @V305096 00307000
TRCYLCIL DC F'0' TRACKS/CYL IN (P)CIL @V305096 00308000
RESBLOCK DC H'1024' CIL BLOCK SIZE @V305096 00309000
REMAINS DC H'0' NO. OF ENTRIES ON LAST PAGE @V305096 00310000
RECORDS DC H'0' NUMBER OF RECORDS SORTED@V305096 00311000
HALFW9 DC H'9' CONSTANT OF 9 @V305096 00312000
DISKCID DC X'0000000201' CORE IMAGE DIR DISK ADDR@V305096 00313000
DISKRLD DC X'0000000000' RELOC DIR DISK ADDR @V305096 00314000
DISKSLD DC X'0000000000' SOURC STMT DIR DISK ADDR@V305096 00315000
DISKPLD DC XL5'0' PROCEDURE DIR. ADDRESS @V305096 00316000
DISKSAVE DC X'0000000000' DISK ADDR SAVE AREA @V305096 00317000
LINECTR DC X'00' SYSLST LINE COUNTER @V305096 00318000
LINES DC X'00' LINES REMAINING ON PAGE @V305096 00319000
DS 0D @V305065 00320000
CLSPLST DC CL8'CP' @V305065 00321000
DC CL8'CLOSE' @V305065 00322000
DC CL8'PRINTER' @V305065 00323000
DC 8X'FF' @V305065 00324000
ACTLINES DC H'0' LINES(HEADER EXCLUDED) @V305096 00325000
NAMELNG DC X'0' PHASE NAME LENGTH @V305096 00326000
PASSCTR DC C'1' SORT PASS COUNTER @V305096 00327000
PAGECTR DC X'01' PAGE COUNTER @V305096 00328000
ERCODE DC X'0' CMS ERROR CODE @V305065 00329000
SPACE 2 00330000
BLANKER DC C' ' BLANK TO CLEAR PRINT AREA @V305096 00331000
PRINTA DC CL121' ' PRINT AREA @V305096 00332000
PRINTB EQU PRINTA+1 BEGINNING OF PRINT AREA @V305096 00333000
DC C' ' *** WORK AREA FOR SECOND *** @V305096 00334000
* *** COLUMN DIR. THIS BYTE *** 00335000
* *** MUST NOT BE REMOVED *** 00336000
ERRLIST DMSERR MF=L,SUB=(HEX,0,CHAR,0) @V305065 00337000
MAP FSCB 'DSERV MAP A5',RECFM=F,BUFFER=PRINTB,BSIZE=120 @V305065 00338000
EJECT 00339000
CMSSWT DC X'0' CMS SWITCH @V305065 00340000
PRTOPT EQU X'40' PRINT OPTION SPECIFIED @V305065 00341000
TYPOPT EQU X'20' TERM OPTION SPECIFIED @V305065 00342000
DSKOPT EQU X'80' DISK OPTION SPECIFIED @V305065 00343000
PRT3211 EQU X'10' 3211 PRINTER SPECIFIED @V305065 00344000
SPACE 1 00345000
SWA DC X'0' DISPLAY SWITCH A @V305096 00346000
SPACE 1 00347000
VMIND EQU X'80' VER AND MOD LEVEL IND @V305096 00348000
HEADIND EQU X'40' HEADER NEEDED IND @V305096 00349000
NONAME EQU X'20' PHASE NAME NOT FOUND IND@V305096 00350000
ALLIND EQU X'1F' DISPLAY ALL INDICATORS @V305096 00351000
PDIND EQU X'10' DISPLAY PROCEDURE DIRECTORY @V305096 00352000
SDIND EQU X'08' DISPLAY SOURCE STMNT DIRECTORY @V305096 00353000
RDIND EQU X'04' DISPLAY RELOCATABLE DIRECTORY @V305096 00354000
CDIND EQU X'02' DISPLAY CORE IMAGE DIRECTORY @V305096 00355000
TDIND EQU X'01' DISPLAY TRANSIENT DIRECTORY @V305096 00356000
SPACE 2 00357000
SWB DC X'0' SWITCH BYTE B @V305096 00358000
SPACE 1 00359000
SYSTD EQU X'80' DISPLAY TRANSIENT DIRECTORY @V305096 00360000
SYSCL EQU X'40' DISPLAY SYSTEM CORE IMAGE DIR@V305096 00361000
SYSRL EQU X'20' DISPLAY SYSTEM REL DIR @V305096 00362000
SYSSL EQU X'10' DISPLAY SYSTEM SOURCE DIR @V305096 00363000
SYSPL EQU X'08' DISPLAY SYSTEM PROC. DIR. @V305096 00364000
ANYMORE EQU X'F8' ANY DIRECTORY DISPLAY MASK @V305096 00365000
SPACE 1 00366000
SWB1 DC X'0' DISPLAY SWITCH B1 @V305096 00367000
SPACE 1 00368000
PCLB EQU X'40' DISPLAY PRIVATE CORE IMAGE D.@V305096 00369000
PRLB EQU X'20' DISPLAY PRIVATE REL DIR @V305096 00370000
PSLB EQU X'10' DISPLAY PRIVATE SOURCE DIR. @V305096 00371000
PTD EQU X'80' PRIVATE TRANSIENT DIR IND @V305096 00372000
RESERVE EQU X'08' RESERVED @V305096 00373000
FIRST EQU X'01' FIRST TIME IND @V305096 00374000
SPACE 1 00375000
SWC DC X'0' SWITCH BYTE C @V305096 00376000
SPACE 00377000
FULLTBL EQU X'80' FULL TABLE IND @V305096 00378000
RELOOP EQU X'40' GO THROUGH SORT LOOP AGAIN @V305096 00379000
ONEIND EQU X'10' DISPLAY SINGLE PHASE @V305096 00380000
LEVELNO EQU X'08' NEED LEVEL NO. FROM NEXT RECORD @V305096 00381000
SKIPNAME EQU X'04' DO NOT SCAN PHASE NAME IND. @V305096 00382000
DUMYCNT EQU X'02' DUMY LOOP-COUNT RECDS LEFT IND. @V305096 00383000
DISPLACE EQU X'01' DISPLACEMENT SEPECIFIED IND. @V305096 00384000
SPACE 2 00385000
SWD DC X'0' SWITCH BYTE D @V305096 00386000
SPACE 00387000
SORT EQU X'80' ALPHANUMERICALLY DISPLAY@V305096 00388000
SVADIR EQU X'40' SVA PRESENT INDICATOR @V305096 00389000
PCST EQU X'20' PRIVATE CORE IMAGE STATUS IND@V305096 00390000
PRST EQU X'10' PRIVATE REL STATUS IND @V305096 00391000
PSST EQU X'08' PRIVATE SOURCE STATUS IND @V305096 00392000
SECOND EQU X'04' SECOND TIME INDICATOR @V305096 00393000
DIREND EQU X'02' IND END OF DIR REACHED @V305096 00394000
SYSST EQU X'01' SYSRES IND @V305065 00395000
SPACE 2 00396000
SWE DC X'00' SWITCH BYTE E @V305096 00397000
SPACE 00398000
ERR3 EQU X'80' NO SYSTEM REL ACTIVE ENTRIES @V305096 00399000
ERR4 EQU X'40' NO SYSTEM SOR ACTIVE ENTRIES IND @V305096 00400000
ERR5 EQU X'20' NO PRI CI ACTIVE ENTRIES IND @V305096 00401000
ERR6 EQU X'10' NO PRI REL ACTIVE ENTRIES IND @V305096 00402000
ERR7 EQU X'08' NO PRI SOR ACTIVE ENTRIES IND @V305096 00403000
ERR8 EQU X'04' NO PRIV TD ACTIVE ENTRIES IND @V305096 00404000
ERR9 EQU X'02' NO SYSTEM PROC LIBRARY @V305096 00405000
ERR10 EQU X'01' SYTEM PROC LIB CANNOT BE USED @V305096 00406000
SPACE 2 00407000
*********************************************************************** 00408000
***** EQUATES -- COMMON TO ALL PHASES, LOCATED IN ROOT PHASE * 00409000
*********************************************************************** 00410000
SPACE 2 00411000
***** REGISTER EQUATES 00412000
SPACE 1 00413000
R0 EQU 0 WORK REG @V305096 00414000
R1 EQU 1 I/O AND WORK REG @V305096 00415000
R2 EQU 2 WORK REG @V305096 00416000
R3 EQU 3 WORK REG @V305096 00417000
R4 EQU 4 WORK REG @V305096 00418000
R5 EQU 5 WORK REG @V305096 00419000
R6 EQU 6 WORK REG @V305096 00420000
R7 EQU 7 WORK REG @V305096 00421000
R8 EQU 8 WORK AND ERROR MESSG POINTER @V305096 00422000
R9 EQU 9 LINK REG TO SUBROUTINES @V305096 00423000
R10 EQU 10 WORK REG @V305096 00424000
R11 EQU 11 WORK REG @V305096 00425000
R12 EQU 12 BASE REG FOR OVERLAY PHASES @V305096 00426000
R13 EQU 13 PROGRAM BASE REG - ASERV ROOT PH @V305096 00427000
R14 EQU 14 GET/PUT REG FOR LIOCS @V305096 00428000
R15 EQU 15 LIOCS BASE REG @V305096 00429000
EJECT 00430000
***** CCW OP CODE AND FLAG EQUATES 00431000
SPACE 1 00432000
SEEK EQU X'07' SEEK BBCCHH COMMAND @V305096 00433000
SIDE EQU X'31' SEARCH ID EQUAL COMMAND @V305096 00434000
TIC EQU X'08' TRANSFER IN CHANNEL COMMAND @V305096 00435000
READ EQU X'06' READ DATA COMMAND @V305096 00436000
RDCNT EQU X'92' READ COUNT/MULTI TRACK COMMAND @V305096 00437000
SPACE 2 00438000
SLI EQU X'20' SUPPRESS WRONG LNG CCW IND @V305096 00439000
CCSLI EQU X'60' CHAIN AND WRONG LNG CCW IND @V305096 00440000
WRNGLN EQU X'40' WRONG LENGTH BIT IN CCB @V305096 00441000
SPACE 3 00442000
RES EQU X'06' SYSRES LOGICAL UNIT @V305096 00443000
SLB EQU X'07' SYSSLB LOGICAL UNIT NUMBER @V305096 00444000
RLB EQU X'08' SYSRLB LOGICAL UNIT NUMBER @V305096 00445000
VMDISP1 EQU VMDISP+3 VERSION BYTE @V305096 00446000
EJECT 00447000
***** CONSTANT EQUATES 00448000
SPACE 2 00449000
ZERO EQU 0 @V305096 00450000
ONE EQU 1 @V305096 00451000
TWO EQU 2 @V305096 00452000
THREE EQU 3 @V305096 00453000
FOUR EQU 4 @V305096 00454000
FIVE EQU 5 @V305096 00455000
SIX EQU 6 @V305096 00456000
SEVEN EQU 7 @V305096 00457000
EIGHT EQU 8 @V305096 00458000
NINE EQU 9 @V305096 00459000
TEN EQU 10 @V305096 00460000
ELEVEN EQU 11 @V305096 00461000
TWELVE EQU 12 @V305096 00462000
FOURTEEN EQU 14 @V305096 00463000
SIXTEEN EQU 16 @V305096 00464000
SEVETEEN EQU 17 @V305096 00465000
EIGHTEEN EQU 18 @V305096 00466000
TWENTY EQU 20 @V305096 00467000
TWENTY1 EQU 21 @V305096 00468000
TWENTY2 EQU 22 @V305096 00469000
TWENTY3 EQU 23 @V305096 00470000
TWENTY4 EQU 24 @V305096 00471000
TWENTY5 EQU 25 @V305096 00472000
TWENTY6 EQU 26 @V305096 00473000
TWENTY7 EQU 27 DISP OF 27 @V305096 00474000
TWENTY9 EQU 29 @V305096 00475000
THIRTY2 EQU 32 @V305096 00476000
THIRTY3 EQU 33 @V305096 00477000
THIRTY4 EQU 34 @V305096 00478000
THIRTY5 EQU 35 @V305096 00479000
THIRTY6 EQU 36 DISP OF 36 @V305096 00480000
THIRTY9 EQU 39 @V305096 00481000
FORTY EQU 40 @V305096 00482000
FORTY2 EQU 42 @V305096 00483000
FORTY3 EQU 43 @V305096 00484000
FORTY5 EQU 45 @V305096 00485000
FIFTY EQU 50 @V305096 00486000
FIFTY2 EQU 52 @V305096 00487000
FIFTY5 EQU 55 @V305096 00488000
FIFTY7 EQU 57 @V305096 00489000
FIFTY6 EQU 56 @V305065 00490000
SIXTY6 EQU 66 @V305096 00491000
SEVENTY8 EQU 78 DISP OF 78 @V305096 00492000
EIGHTY EQU 80 @V305096 00493000
EIGHTY1 EQU 81 @V305096 00494000
EIGHTY9 EQU 89 @V305096 00495000
NINETY1 EQU 91 DISP OF 91 @V305096 00496000
NINETY2 EQU 92 DISP OF 92 @V305096 00497000
NINETY6 EQU 96 @V305096 00498000
LCILH EQU 101 LENGTH CIL HEADER @V305096 00499000
LDASH EQU 60 NO. OF DASHES IN HEADER @V305096 00500000
FORTY6 EQU 46 @V305096 00501000
SIXTY3 EQU 63 @V305096 00502000
SIXTY5 EQU 65 @V305096 00503000
SEVENTY1 EQU 71 @V305096 00504000
HUND EQU 100 @V305065 00505000
ONE03 EQU 103 @V305096 00506000
ONE18 EQU 118 @V305096 00507000
ONE19 EQU 119 @V305096 00508000
SPACE 1 00509000
DEV2314 EQU X'62' @V305065 00510000
DEV3330 EQU X'63' @V305065 00511000
DEV333B EQU X'65' PUB DEV CODE FOR 3330-11@V505098 00511300
DEV3350 EQU X'67' PUB DEV CODE FOR 3350 @V505098 00511600
DEV3343 EQU X'69' @V305065 00512000
DEV3347 EQU X'6A' @V305065 00513000
SPACE 1 00514000
DASH EQU C'-' @V305096 00515000
BLANK EQU C' ' @V305096 00516000
SKIP1 EQU C'1' SKIP TO 1 ASA CHAR @V305096 00517000
F1 EQU C'1' SCAN CARD ROUTINE PHASE NO. @V305096 00518000
F2 EQU C'2' TD/CD PRINT SGL COL @V305096 00519000
F3 EQU C'3' RD/SD PHASE NO. @V305096 00520000
F4 EQU C'4' RD AND SD PRINT PHASE @V305096 00521000
F5 EQU C'5' PD PRINT PHASE @V305096 00522000
SPACE 1 00523000
CLB EQU X'0B' SYSCLB SYMBOLIC UNIT @V305096 00524000
EOC EQU X'20' END OF CYLINDER INDICATOR @V305096 00525000
RELPHASE EQU X'40' REL PHASE INDICATOR @V305096 00526000
HEX00 EQU X'00' @V305096 00527000
HEX3F EQU X'3F' @V305096 00528000
HEXF0 EQU X'F0' @V305096 00529000
HEXFE EQU X'FE' @V305065 00530000
HEXFF EQU X'FF' @V305096 00531000
SPACE 1 00532000
LASTREC DS 2D HOLD LAST RECORD FOR NEXT PASS @V305096 00533000
LTORG @V305065 00534000
DS 0F @V305065 00535000
DSERV1 EQU * @V305065 00537000
USING *,R13 SPECIFY BASE REG TO ASSE@V305096 00538000
TM SWB1,FIRST IS IT FIRST TIME THROUGH? @V305065 00539000
BO GETCOM BRANCH IF YES @V305065 00540000
BAL R14,PLIST GO CHECK PLIST @V305065 00541000
TM CMSSWT,DSKOPT WAS DISK SPECIFIED? @V305065 00542000
BZ GETCOM BRANCH IF NOT @V305065 00543000
FSERASE ,FSCB=MAP ERASE OLD MAP @V305065 00544000
FSOPEN ,FSCB=(1) OPEN NEW MAP @V305065 00545000
GETCOM EQU * @V305065 00546000
SPACE 2 00547000
*********************************************************************** 00548000
***** GET ADDR OF COMMUNICATION REGION * 3-10 00549000
*********************************************************************** 00550000
SPACE 2 00551000
COMRG ADDR OF COMMUNICATION REGION @V305096 00552000
SPACE 2 00553000
*************************************************************** 00554000
* INITIALIZE PRINTER CONTROL FIELD. 00555000
* INDICATE THAT HEADER IS TO BE PRINTED. 00556000
*************************************************************** 00557000
SPACE 2 00558000
OI SWA,HEADIND INDICATE HEADER @V305065 00559000
SR R2,R2 CLEAR REGISTER @V305096 00562000
IC R2,SEVENTY8(R1) GET NO.OF LINES/PAGE @V305096 00563000
STC R2,LINECTR SAVE IT IN PRINTER @V305096 00564000
STC R2,LINES CONTROL FIELDS @V305096 00565000
SH R2,CON8 SUBTR.8 HEADER LINES @V305096 00566000
STH R2,ACTLINES NO. OF DATA LINES @V305096 00567000
SPACE 2 00568000
*********************************************************************** 00569000
***** ROUTINE TO GET PARTITION ENDING ADDRESS 00570000
*********************************************************************** 00571000
SPACE 2 00572000
FNDADDR L R4,FREELOWE GET PARTITION END ADDR @V305096 00573000
LA R4,ONE(R4) PARTITION END ADDR + 1 @V305096 00574000
ST R4,SORTEND SAVE PARTITION END ADDR +1 @V305096 00575000
EJECT 00576000
************************************************************** 00577000
* AT FIRST TIME THROUGH: * 00578000
* OPEN PRIVATE LIBRARIES IF THEY ARE ASSIGNED AND SETUP * 00579000
* APPROPRIATE INDICATORS OF SWD. * 00580000
* CALCULATE START ADDRESSES OF PRIVATE LIBRARIES. * 00581000
* CHECK FOR ACTIVE ENTRIES IN RLB,SLB,PLIB,PRLB,PSLB. * 00582000
* SET INDICATORS IF NO ACTIVE ENTRIES IN THESE LIBRARIES. * 00583000
* ACTIVE ENTRIES IN PCIL WILL BE CHECKED IN DSERV2. * 00584000
* MOVE THE START ADDRESS OF OF THE LIBRARIES IN THE STATUS * 00585000
* TABLE. * 00586000
************************************************************** 00587000
SPACE 2 00588000
TM SWB1,FIRST IS IT FIRST TIME THROUGH@V305096 00589000
BO GETPASS NO @V305096 00590000
SPACE 1 00591000
OI SWB1,FIRST SET FIRST TIME SWITCH @V305096 00592000
SPACE 1 00593000
GETLUB SYSIR (R1,R2,R3,R4),LUB,FG POINT TO LUB @V305096 00594000
LR R5,R1 SAVE LUB PTR FOR PRI DIR COMP@V305096 00595000
EJECT 00596000
TM LUBRES,HEXFE IS THERE A SYSRES? @V305065 00597000
BO NOSYSRES BRANCH IF NOT @V305065 00598000
SR R3,R3 @V305065 00599000
IC R3,LUBRES GET PUB FOR SYSRES @V305065 00600000
BAL R9,TRKCYL GET TRACKS / CYLINDER @V305065 00601000
OI SWD,SYSST INDICATE SYSRES PRESENT @V305065 00602000
NOSYSRES EQU * @V305065 00603000
TM LUBCLB,HEXFE IS PCIL ASSIGNED? @V305065 00604000
BO CHKRLB BRANCH IF NOT @V305065 00605000
SR R3,R3 CLEAR RGISTER @V305065 00606000
ICM R3,7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305065 00607000
USING DOSSECT,R3 @V305065 00608000
NXTSYSCL EQU * @V305065 00609000
BZ CHKRLB NO MORE DOSCB IF ZERO @V305065 00610000
CLC DOSDD,IJSYSCL+22 MATCHING DSNAME? @V305065 00611000
BE OPSYSCL BRANCH IF YES @V305065 00612000
ICM R3,7,1(R3) GET NEXT DOSCB ADDRESS @V305065 00613000
B NXTSYSCL AND LOOP @V305065 00614000
OPSYSCL EQU * @V305065 00615000
SR R3,R3 @V305065 00616000
IC R3,LUBCLB GET PUB FOR SYSCLB @V305065 00617000
BAL R9,TRKCYL GET TRACKS / CYLINDER @V305065 00618000
LA R6,IJSYSCL POINT TO PCIL DTF @V305065 00619000
OPENR (R6) OPEN PRIVATE CORE IMAGE LIB @V305065 00620000
MVC DISKCID(FOUR),IJCLL GET PCIL START ADDRESS @V305065 00621000
OI SWD,PCST SETUP PCIL ASSIGNED IND @V305096 00622000
EJECT 00623000
CHKRLB EQU * @V305065 00624000
TM SWD,SYSST SYSRES ASSIGNED? @V305065 00625000
BZ CHKRLBA BRANCH IF NOT @V305065 00626000
BAL R9,READDIR GET SYSTEM DIR RECS @V305096 00627000
CHKRLBA EQU * @V305065 00628000
MVI CCW4FLAG,SLI BRAKE CHAIN OFF @V305096 00629000
LR R1,R5 RESTORE LUB PTR @V305096 00630000
CLI LUBRLB+LUBP,HEXFF IS SYSRLB ASSIGNED @V305096 00631000
BE CHKRL NO @V305096 00632000
SR R3,R3 CLEAR REGISTER @V305065 00633000
ICM R3,7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305065 00634000
NXTSYSRL EQU * @V305065 00635000
BZ CHKRL NO MORE DOSCB IF ZERO @V305065 00636000
CLC DOSDD,IJSYSRL+22 MATCHING DDNAME? @V305065 00637000
BE OPSYSRL BRANCH IF YES @V305065 00638000
ICM R3,7,1(R3) GET NEXT DOSCB ADDRESS @V305065 00639000
B NXTSYSRL AND LOOP @V305065 00640000
OPSYSRL EQU * @V305065 00641000
LA R6,IJSYSRL ADDR OF PRIV REL LIB @V305096 00642000
SPACE 00643000
OPENR (R6) OPEN PRIVATE RELOCATE LIB @V305096 00644000
SPACE 00645000
MVI CCBSYM2,RLB SET SYSRLB SYMBOLIC UNIT IN CCB @V305096 00646000
MVC SEEKCC(FIVE),IJRLL CCHH TO SEEK BUCKET @V305096 00647000
BAL R9,READDIR READ PRI RD 80 BYTES DIR REC @V305096 00648000
MVI CCBSYM2,RES SET SYSRES LOGICAL UNIT @V305096 00649000
OI SWD,PRST SETUP PREL ASSIGNED IND @V305096 00650000
SR R0,R0 ZERO REG FOR COMPARE @V305096 00651000
C R0,RACTENT ANY PRI REL ACTIVE ENTRIES @V305096 00652000
BNE SAVERLD YES @V305096 00653000
OI SWE,ERR6 NO, SETUP NO PRI REL ERROR IND @V305096 00654000
B CHKSLB CHECK SYSSLB IF IT WAS ASSIGNED @V305096 00655000
CHKRL CLI RLAREA,BLANK IS THERE A SYSTEM REL @V305096 00656000
BE NORLB NO @V305096 00657000
TM SWD,SYSST IS THERE A SYSRES? @V305065 00658000
BZ NORLB BRANCH IF NOT @V305065 00659000
MVC SEEKCC(FIVE),RLAREA2 CCHHR TO SEEK BUCKET @V305096 00660000
BAL R9,READDIR READ SYSDIR REC OF REL @V305096 00661000
SR R0,R0 ZERO REG FOR COMPARE @V305096 00662000
C R0,RACTENT ANY ACTIVE ENTR IN REL @V305096 00663000
BNE SAVERLD YES @V305096 00664000
NORLB OI SWE,ERR3 INDICATE 'NO SYS REL ' @V305096 00665000
B CHKSLB CHECK FOR SYSSLB ASSIGN @V305096 00666000
SAVERLD MVC DISKRLD,RLAREA2 SAVE PRIV REL DIR DISK ADDR @V305096 00667000
EJECT 00668000
CHKSLB LR R1,R5 RESTORE LUB PTR FOR PRI DIR COMP @V305096 00669000
MVC CCW4(EIGHT),CCW5 MODIFY CCW TO READ 1ST @V305096 00670000
* REC OF PRIV SSL 00671000
MVI CCW4FLAG,SLI BRAKE CHAIN OFF @V305096 00672000
CLI LUBSLB+LUBP,HEXFF IS SYSSLB ASSIGNED @V305096 00673000
BE CHKSL NO @V305096 00674000
SR R3,R3 CLEAR REGISTER @V305065 00675000
ICM R3,7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305065 00676000
NXTSYSSL EQU * @V305065 00677000
BZ CHKSL NO MORE DOSCB IF ZERO @V305065 00678000
CLC DOSDD,IJSYSSL+22 MATCHING DDNAMES? @V305065 00679000
BE OPSYSSL BRANCH IF YES @V305065 00680000
ICM R3,7,1(R3) GET NEXT DOSCB ADDRESS @V305065 00681000
B NXTSYSSL AND LOOP @V305065 00682000
DROP R3 @V305065 00683000
OPSYSSL EQU * @V305065 00684000
LA R6,IJSYSSL ADDR OF PRIV SOURCE LIB @V305096 00685000
SPACE 00686000
OPENR (R6) OPEN PRIVATE SOURCE LIB @V305096 00687000
SPACE 00688000
MVI CCBSYM2,SLB SET SYSSLB SYMBOLIC UNIT IN CCB @V305096 00689000
MVC SEEKCC(FIVE),IJSLL CCHH TO SEEK BUCKET @V305096 00690000
BAL R9,READDIR READ PRI SOURCE 80 BYTES DIR REC @V305096 00691000
MVI CCBSYM2,RES SET SYSRES LOGICAL UNIT @V305096 00692000
OI SWD,PSST SETUP PRIVATE SD STATUS IND @V305096 00693000
SR R0,R0 ZERO REG FOR COMPARE @V305096 00694000
C R0,SACTENT ANY PRI SOURCE ACTIVE ENTRIES @V305096 00695000
BNE SAVESLD YES @V305096 00696000
OI SWE,ERR7 NO, SETUP NO PRI SOR ERROR IND @V305096 00697000
B CHKPL CHECK PROC LIB @V305096 00698000
CHKSL CLI SLAREA,BLANK IS THERE A SYSTEM SSL @V305096 00699000
BE NOSSL NO @V305096 00700000
TM SWD,SYSST IS THERE A SYSRES? @V305065 00701000
BZ NOSSL BRANCH IF NOT @V305065 00702000
MVC SEEKCC(FIVE),SLAREA2 CCHHR TO SEEK BUCKET @V305096 00703000
BAL R9,READDIR READ 1ST REC OF SSL DIR @V305096 00704000
SR R0,R0 ZERO REG FOR COMPARE @V305096 00705000
C R0,SACTENT ANY SSL ACTIVE ENTRIES @V305096 00706000
BNE SAVESLD YES @V305096 00707000
NOSSL OI SWE,ERR4 INDICATE 'NO SSL ' @V305096 00708000
B CHKPL CHECK PROC LIB @V305096 00709000
SAVESLD MVC DISKSLD,SLAREA2 SAVE ADDR OF PRIV SOURCE DIR @V305096 00710000
CHKPL EQU * * @V305096 00711000
TM SWD,SYSST IS THERE A SYSRES? @V305065 00712000
BZ NOPLB BRANCH IF NOT @V305065 00713000
CLI PLAREA,BLANK IS THERE A PROC LIBR @V305096 00714000
BE NOPLB NO - POST ERROR ERR9 @V305096 00715000
CLI PLAREA+SIX,HEX00 REALLY A PROCLIB @V305096 00716000
BE NOPLB NO - POST ERROR ERR9 @V305096 00717000
MVC CCW4(EIGHT),CCW6 MODIFY CCW TO READ FIRST@V305096 00718000
* 80 BYTES OF PROC. DIR. 00719000
MVC SEEKCC(FIVE),PLAREA2 CCHHR TO SEEK BUCKET @V305096 00720000
BAL R9,READDIR READ PROC. DIR. HEADER @V305096 00721000
MVC DISKPLD,PLAREA2 SAVE PD ADDR FOR LATER @V305096 00722000
SR R0,R0 @V305096 00723000
C R0,PACTENT ANY ENTRY OF ACTIVE @V305096 00724000
BNE SETUP YES - @V305096 00725000
NOPLB OI SWE,ERR9 POST NO PROC LIBR IND @V305096 00726000
B SETUP @V305065 00727000
EJECT 00728000
*********************************************************************** 00729000
***** INITIALIZATION OF SORT STARTING ADDRESS, PASS AND PAGE * 00730000
***** COUNTERS, RESET INDICATORS * 00731000
*********************************************************************** 00732000
SPACE 2 00733000
GETPASS IC R2,PASSCTR GET CURRENT PASS NUMBER @V305096 00734000
LA R2,ONE(R2) INCREMENT TO NEXT PASS @V305096 00735000
STC R2,PASSCTR STORE NEW PASS NUMBER @V305096 00736000
TM SWC,FULLTBL DID WE DO A PARTIAL SORT@V305096 00737000
BO TESTANY YES @V305096 00738000
MVI PASSCTR,F1 NO, RESET PASS COUNTER TO 1 @V305096 00739000
MVI PAGECTR,ONE RESET PAGE COUNTER TO 1 @V305096 00740000
TM SWE,ERR5 ANY PCIL ACT ENTRIES @V305096 00741000
BNO TESTTD YES, TEST TD ACT ENTRIES@V305096 00742000
BAL R9,PCDERR GO PRINT MESSAGE @V305065 00743000
NI SWE,HEXFF-ERR5 RESET NO PCIL ERROR IND @V305096 00744000
B TESTSWA CONTINUE @V305096 00745000
TESTTD TM SWE,ERR8 ANY TD ENTRIES @V305096 00746000
BZ TESTSWA YES @V305096 00747000
LA R15,PV1 POINT TO PRIVATE @V305065 00748000
TM SWD,PCST PRIV. CIL DIRECTORY DISPLAY @V305096 00749000
BO PRTMSG9 YES, PRINT PRIV. CIL MESSAGE @V305096 00750000
LA R15,ST1 POINT TO SYSTEM @V305065 00751000
PRTMSG9 EQU * @V305065 00752000
BAL R9,PTDERR GO PRINT MESSAGE @V305065 00753000
NI SWE,HEXFF-ERR8 RESET NO PRIVATE TD ERROR IND@V305096 00754000
B TESTANY CONTINUE PROCESS @V305096 00755000
SPACE 2 00756000
TESTSWA TM SWA,NONAME WAS PHASE NAME FOUND @V305096 00757000
BZ TESTANY YES @V305096 00758000
NI SWA,HEXFF-NONAME-VMIND RESET DISPLAY INDICATOR @V305096 00759000
LA R15,PNBUCKET POINT TO NAME @V305065 00760000
BAL R9,BADNAME GO PRINT MESSAGE @V305065 00761000
NI SWB,HEXFF-SYSCL NO, RESET DISPLAY CD IND@V305096 00762000
NI SWB1,HEXFF-PCLB =============== @V305096 00763000
TESTANY TM SWB,ANYMORE ANY DIRECTORIES LEFT TO DISPLAY @V305096 00764000
BNZ LOADF2 YES @V305096 00765000
TM SWB1,ANYMORE ANY DIRECTORIES TO DISPLAY @V305096 00766000
BNZ LOADF2 YES - @V305096 00767000
B FINAL @V305065 00768000
EJECT 00769000
************************************************************ 00770000
* CMS ROUTINE TO DEFINE TRACKS / CYLINDER 00771000
************************************************************ 00772000
USING PUBADR,R3 @V305065 00773000
USING BGCOM,R4 @V305065 00774000
TRKCYL EQU * @V305065 00775000
MH R3,=Y(PUBWIT) MULTIPLY WITH LENGTH OF PUB @V305065 00776000
AH R3,PUBPT ADD PUB TABLE ADDRESS @V305065 00777000
LA R6,(DEVEND-DEVSTART)/LDEVTAB NO. OF DEVICES @V305065 00778000
LA R2,DEVSTART GET START ADDRESS @V305065 00779000
TRKCYLOP EQU * @V305065 00780000
CLC 0(1,R2),4(R3) IS THIS THE DEVICE? @V305065 00781000
BE TRKCYLFD BRANCH IF YES @V305065 00782000
LA R2,LDEVTAB(R2) POINT TO NEXT DEVICE @V305065 00783000
BCT R6,TRKCYLOP AND TRY AGAIN @V305065 00784000
B INVDEV NOT FOUND @V305065 00785000
TRKCYLFD EQU * @V305065 00786000
MVC TRCYLCIL+2(TWO),1(R2) MOVE IN CONSTANT @V305065 00787000
BR R9 RETURN @V305065 00788000
DROP R3 @V305065 00789000
DROP R4 @V305065 00790000
EJECT 1 00791000
********************************************************** 00792000
* CMS SUBROUTINE FOR CHECKING PLIST 00793000
********************************************************* 00794000
PLIST EQU * @V305065 00795000
LA R1,8(,R1) POINT TO PLIST @V305065 00796000
CLI ZERO(R1),X'FF' IS THERE A PLIST? @V305065 00797000
BE NODIR BRANCH IF NOT, ERROR @V305065 00798000
CLI ZERO(R1),C'(' IS THIS THE OPTION? @V305065 00799000
BE NODIR BRANCH IF YES, ERROR @V305065 00800000
PLISTLOP EQU * @V305065 00801000
LR R2,R1 POINT TO DIRECTORY @V305065 00802000
BAL R5,RESCAN1 CHECK DIRECTORY ACTION @V305065 00803000
PLISTLP1 EQU * @V305065 00804000
BAL R5,RESCAN CHECK NEXT TOKEN @V305065 00805000
B PLISTEND END OF PLIST @V305065 00806000
B PLISTOPT GO CHECK OPTIONS @V305065 00807000
CLC KCD,ZERO(R2) WAS LAST CD? @V305065 00808000
BNE PLISTLOP BRANCH IF NOT @V305065 00809000
CLC KPHASE,ZERO(R1) YES, WAS PHASE SPECIFIED? @V305065 00810000
BNE PLISTLOP BRANCH IF NOT @V305065 00811000
LA R1,8(,R1) POINT TO PHASE NAME @V305065 00812000
BAL R9,GETNAME GET NAME AND DISPLACEMENT @V305065 00813000
B PLISTLP1 @V305065 00814000
SPACE 2 00815000
PLISTOPT EQU * @V305065 00816000
BAL R5,RESCAN CHECK NEXT TOKEN @V305065 00817000
B PLISTEND END OF PLIST @V305065 00818000
B BADOPT TWO L PARENS ARE BAD @V305065 00819000
CLI ZERO(R1),C')' RIGHT PARENS? @V305065 00820000
BNE PLISTOP2 BRANCH IF NOT @V305065 00821000
LA R1,8(,R1) POINT PAST PARENS @V305065 00822000
CLI ZERO(R1),X'FF' YES, END OF PLIST? @V305065 00823000
BNE BADPARM BRANCH IF NOT, ERROR @V305065 00824000
B PLISTEND @V305065 00825000
PLISTOP2 EQU * @V305065 00826000
LA R15,OPTIONS GET OPTION LIST @V305065 00827000
LA R6,OPTIONN AND NUMBER OF OPTIONS @V305065 00828000
PLISTOP3 EQU * @V305065 00829000
CLC 0(8,R15),0(R1) IS THIS THE OPTION? @V305065 00830000
BNE PLISTOP4 BRANCH IF NOT @V305065 00831000
L R4,8(,R15) GET OPTION ROUTINE ADDRESS @V305065 00832000
BALR R5,R4 AND PROCESS OPTION @V305065 00833000
B PLISTOPT @V305065 00834000
PLISTOP4 EQU * @V305065 00835000
LA R15,OPTIONL(,R15) POINT TO NEXT OPTION @V305065 00836000
BCT R6,PLISTOP3 AND TRY AGAIN @V305065 00837000
B BADOPT @V305065 00838000
PLISTEND EQU * @V305065 00839000
TM CMSSWT,PRTOPT+TYPOPT EITHER OPTION SPECIFIED? @V305065 00840000
BNZ PLISTND1 BRANCH IF YES @V305065 00841000
OI CMSSWT,DSKOPT INSURE DISK INDICATED @V305065 00842000
PLISTND1 EQU * @V305065 00843000
BR R14 RETURN @V305065 00852000
EJECT 00853000
RESCAN1 LA R10,ALLIND INDICATOR TO DISPLAY ALL@V305096 00854000
CLC KALL,ZERO(R2) IS OPERAND ALL @V305096 00855000
BE SETSWA YES @V305096 00856000
LA R10,TDIND INDICATOR TO DISPLAY TD @V305096 00857000
CLC KTD,ZERO(R2) IS OPERAND TD @V305096 00858000
BE SETSWA YES @V305096 00859000
LA R10,CDIND INDICATOR TO DISPLAY CD @V305096 00860000
CLC KCD,ZERO(R2) IS OPERAND CD @V305096 00861000
BE SETSWA YES @V305096 00862000
LA R10,RDIND INDICATOR TO DISPLAY RD @V305096 00863000
CLC KRD,ZERO(R2) IS OPERAND RD @V305096 00864000
BE SETSWA YES @V305096 00865000
LA R10,SDIND INDICATOR TO DISPLAY SD @V305096 00866000
CLC KSD,ZERO(R2) IS OPERAND SD @V305096 00867000
BE SETSWA YES @V305096 00868000
LA R10,PDIND INDICATOR TO DISPLAY PD @V305096 00869000
CLC KPD(L'KPD),ZERO(R2) IS OPERAND PD @V305096 00870000
BE SETSWA YES - @V305096 00871000
B BADPARM NO, ERROR @V305096 00872000
SETSWA EX R10,SETIND EXECUTE SET IND INSTR. @V305096 00873000
BR R5 @V305065 00874000
EJECT 00875000
*********************************************************************** 00876000
***** SETUP APPROPRIATE INDICATORS OF SWB * 00877000
***** PRINT ERROR MESSAGES IF ANY * 00878000
*********************************************************************** 00879000
SETUP EQU * @V305096 00880000
SPACE 1 00881000
TM SWA,TDIND DISPLAY TRANSIENT DIR SPECD @V305096 00882000
BZ CHKCD NO @V305096 00883000
OI SWB,SYSTD SETUP DISPLAY TD DIR IND@V305096 00884000
TM SWD,PCST WAS SYSCLB ASSIGNED @V305096 00885000
BZ CHKTD1 NO @V305096 00886000
NI SWB,HEXFF-SYSTD SET SYSTD IND OFF @V305096 00887000
OI SWB1,PTD SETUP PRIVATE TD IND @V305096 00888000
B CHKCD @V305065 00889000
CHKTD1 EQU * @V305065 00890000
TM SWD,SYSST WAS SYSRES ASSIGNED? @V305065 00891000
BO CHKCD BRANCH IF YES @V305065 00892000
BAL R9,TDERR NO, PRINT ERROR MSG @V305065 00893000
NI SWA,HEXFF-TDIND REMOVE TD INDICATOR @V305065 00894000
NI SWB,HEXFF-SYSTD REMOVE SYSTD IND @V305065 00895000
SPACE 00896000
CHKCD TM SWA,CDIND+VMIND DISPLAY CORE IMAGE DIR SPECD @V305096 00897000
BZ CHKRD NO @V305096 00898000
OI SWB,SYSCL SETUP DSPL CD IND @V305096 00899000
TM SWD,PCST WAS SYSCLB ASSIGNED @V305096 00900000
BZ CHKCD1 NO @V305096 00901000
NI SWB,HEXFF-SYSCL SET SYSCL IND OFF @V305096 00902000
OI SWB1,PCLB SET DISPLAY PRIVATE SYSCLB @V305096 00903000
B CHKRD @V305065 00904000
CHKCD1 EQU * @V305065 00905000
TM SWD,SYSST WAS SYSRES ASSIGNED? @V305065 00906000
BO CHKRD BRANCH IF YES @V305065 00907000
BAL R9,CDERR PRINT ERROR MSG @V305065 00908000
NI SWA,HEXFF-CDIND-VMIND REMOVE CD INDICATOR @V305065 00909000
NI SWB,HEXFF-SYSCL REMOVE SYSCL IND @V305065 00910000
SPACE 00911000
CHKRD TM SWA,RDIND DISPLAY REL SPECIFIED @V305096 00912000
BZ CHKSD NO @V305096 00913000
TM SWD,PRST WAS SYSRLB ASSIGNED @V305096 00914000
BZ CHKRLB1 NO @V305096 00915000
TM SWE,ERR6 ANY PRI REL ACTIVE ENTRIES @V305096 00916000
BO ERROR6 NO @V305096 00917000
OI SWB1,PRLB SET DISPLAY PRI REL DIR IND @V305096 00918000
SPACE 00919000
CHKSD TM SWA,SDIND DISPLAY SD SPECIFIED @V305096 00920000
BZ CHKPD NO @V305096 00921000
TM SWD,PSST WAS SYSSL ASSIGNED @V305096 00922000
BZ CHKSLB1 NO @V305096 00923000
TM SWE,ERR7 ANY PRI SOURCE ACTIVE ENTRIES @V305096 00924000
BO ERROR7 NO @V305096 00925000
OI SWB1,PSLB SETUP DISPLAY SYSRLD DIR @V305096 00926000
SPACE 1 00927000
CHKPD EQU * * @V305096 00928000
TM SWA,PDIND DISPLAY PD SPECIFIED @V305096 00929000
BZ LOADF2 NO - @V305096 00930000
TM SWE,ERR9 ANY ENTRY ACTIVE @V305096 00931000
BO DPL06 NO - @V305096 00932000
OI SWB,SYSPL POST DISPLAY PD @V305096 00933000
SPACE 1 00934000
B LOADF2 INITIALIZE PHASE NAME TO LOAD@V305096 00935000
EJECT 00936000
CHKRLB1 EQU * @V305065 00937000
TM SWE,ERR3 ANY SYSTEM REL. ACTIVE ENT? @V305065 00938000
BZ SETRDIND BRANCH IF YES @V305065 00939000
ERROR6 EQU * @V305065 00940000
BAL R9,RDERR EXIT TO PRINT ROUTINE @V305096 00941000
B CHKSD CHECK IF SD IS SPECIFIED @V305096 00942000
SETRDIND OI SWB,SYSRL SET DISPLAY SYSTEM REL DIR IND @V305096 00943000
B CHKSD GO TO TEST IF SD SPECIFIED @V305096 00944000
SPACE 1 00945000
CHKSLB1 EQU * @V305065 00946000
TM SWE,ERR4 ANY SYSTEM SOURCE ACTIVE ENT?@V305065 00947000
BZ SETSDIND BRANCH IF YES @V305065 00948000
ERROR7 EQU * @V305065 00949000
BAL R9,SDERR PRINT ERROR MSG 7 @V305096 00950000
B CHKPD GO READ ANOTHER CARD @V305096 00951000
SETSDIND OI SWB,SYSSL SET DISPLAY SYS SOURCE DIR IN@V305096 00952000
B CHKPD @V305096 00953000
SPACE 2 00954000
DPL06 EQU * @V305096 00955000
BAL R9,PDERR PRINT ERROR MESSAGE @V305096 00956000
EJECT 00957000
*********************************************************************** 00958000
***** INITIALIZATION OF NEXT PROCESSING OVERLAY PHASE * 00959000
*********************************************************************** 00960000
SPACE 1 00961000
LOADF2 MVI PHASENO,TWO INIT TO FETCH TD/CD PHASE @V305096 00962000
TM SWB,SYSTD+SYSCL DISPLAY SYSTEM TD/CD @V305096 00963000
BNZ FETCH GO TO FETCH PHASE TWO @V305096 00964000
TM SWB1,PTD+PCLB DISPLAY PRIVATE TD OR PD@V305096 00965000
BNZ FETCH YES - @V305096 00966000
MVI PHASENO,THREE INIT TO FETCH SD/RD/PD P@V305096 00967000
TM SWB,SYSPL+SYSRL+SYSSL DISPLAY SD, RD OR PD @V305096 00968000
BNZ FETCH YES - @V305096 00969000
TM SWB1,PRLB+PSLB DISPLAY PRLB OR PSLB @V305096 00970000
BZ FINAL NO - @V305096 00971000
B FETCH YES @V305096 00972000
EJECT 00973000
*********************************************************************** 00974000
***** SCAN THE CD OPERAND WITH A SPECIFIC PHASE NAME * 00975000
*********************************************************************** 00976000
SPACE 00977000
GETNAME EQU * @V305096 00978000
LA R3,8 MAXIMUM TOKEN LENGTH @V305065 00979000
LR R4,R1 GET PLIST POINTER @V305065 00980000
LR R5,R4 R5, TOO @V305065 00981000
COMP1 EQU * @V305096 00982000
CLI ZERO(R4),ASTER IS DELIMITER AN ASTERISK? @V305096 00983000
BE COMMART YES @V305096 00984000
CLI ZERO(R4),BLANK IS BLANK AT END OF NAME? @V305096 00985000
BE COMMART BRANCH IF YES @V305065 00986000
COMP1B LA R4,ONE(R4) INCREMENT TO NEXT COLUMN@V305096 00987000
BCT R3,COMP1 DUNK BYTES AND CONTINUE SEARCH @V305096 00988000
SPACE 00989000
COMMART EQU * @V305096 00990000
SR R4,R5 LENGTH OF PHASE NAME @V305096 00991000
BCTR R4,R0 DECREMENT FOR MOVE INSTRUCTION @V305096 00992000
STC R4,NAMELNG SAVE LENGTH @V305065 00993000
MVC PNBUCKET,PRINTB CLEAR PHASE NAME BUCKET @V305096 00994000
EX R4,MOVENAME MOVE PHASENAME TO BUCKET@V305096 00995000
MVI VMDISP1,TWELVE SET STANDARD VM LOCATION@V305096 00996000
AR R4,R5 POINT TO END OF NAME @V305065 00997000
LA R4,1(,R4) @V305065 00998000
CLI ZERO(R4),ASTER WAS ASTERISK SPECIFIED? @V305065 00999000
BE COMP1C BRANCH IF YES @V305065 01000000
OI SWC,ONEIND INDICATE ONE PHASE @V305065 01001000
COMP1C EQU * @V305065 01002000
LA R4,8(,R1) LOOK AT NEXT TOKEN @VA14978 01003000
CLI ZERO(R4),HEXFF CHECK FOR FENCE @VA14978 01003250
BE COMP3 BRANCH IF YES @VA14978 01003500
TM ZERO(R4),HEXF0 IS IT NUMERIC @VA14978 01003750
BO GETDISP BRANCH IF YES @V305065 01005000
COMP3 EQU * @V305065 01006000
OI SWA,VMIND SET VER AND MOD LEVEL IND @V305065 01007000
BR R9 @V305065 01008000
EJECT 01009000
GETDISP EQU * @V305065 01010000
LA R3,8 MAXIMUM TOKEN SIZE @V305065 01011000
LA R1,8(,R1) POINT TO NEXT TOKEN @V305065 01012000
LR R5,R3 SAVE BYTE COUNTER @V305096 01013000
COMP2 CLI ZERO(R4),BLANK IS DELIMITER A BLANK @V305096 01014000
BE CALDISP YES, CALCULATE DISP @V305096 01015000
TM ZERO(R4),HEXF0 IS CHARACTER NUMERIC @V305096 01016000
BNO BADADD NO, ERROR @V305096 01017000
LA R4,ONE(R4) INCREMENT TO NEXT COLUMN@V305096 01018000
BCT R3,COMP2 DUNK BYTES AND CONTINUE SEARCH @V305096 01019000
CALDISP EQU * @V305065 01020000
SR R5,R3 LENGTH OF NUMERIC FIELD @V305096 01021000
BCTR R5,R0 DECREMENT FOR PACK INSTR. @V305096 01022000
EX R5,PACK1 EXECUTE PACK INSTRUCTION@V305096 01023000
CVB R3,DBLWORD CONVERT DISP TO BINARY @V305096 01024000
CL R3,MAXADDR DISP WITHIN ADDR RANGE @V305096 01025000
BH BADADD NO, ERROR @V305096 01026000
ST R3,VMDISP SAVE VM DISP FOR CD PHASE @V305096 01027000
OI SWC,DISPLACE TURN ON DISP SEPECIFIED IND @V305096 01028000
B COMP3 CONTINUE SCAN @V305096 01029000
EJECT 1 01030000
************************************************************ 01031000
* CMS ROUTINE TO GET NEXT TOKEN ON PLIST 01032000
************************************************************ 01033000
RESCAN EQU * @V305065 01034000
LA R1,8(,R1) POINT TO NEXT TOKEN @V305065 01035000
CLI ZERO(R1),X'FF' END OF PLIST? @V305065 01036000
BCR 8,R5 BRANCH IF YES @V305065 01037000
CLI ZERO(R1),LPAREN START OF OPTIONS? @V305065 01038000
BE 4(,R5) BRANCH IF YES @V305065 01039000
B 8(,R5) @V305065 01040000
EJECT 1 01041000
************************************************************ 01042000
* CMS OPTION SUBROUTINES 01043000
************************************************************ 01044000
TERMOP EQU * @V305065 01045000
TM CMSSWT,PRTOPT+DSKOPT OTHER DEVICES SPECIFIED? @V305065 01046000
BNZ OTHDEV BRANCH IF YES @V305065 01047000
TM CMSSWT,TYPOPT THIS DEVICE SPECIFIED? @V305065 01048000
BO DUPOPT BRANCH IF YES @V305065 01049000
OI CMSSWT,TYPOPT INDICATE TERM @V305065 01050000
BR R5 @V305065 01051000
SPACE 2 01052000
PRNTOP EQU * @V305065 01053000
TM CMSSWT,TYPOPT+DSKOPT OTHERDEVICES SPECIFIED? @V305065 01054000
BNZ OTHDEV BRANCH IF YES @V305065 01055000
TM CMSSWT,PRTOPT THIS DEVICE SPECIFIED? @V305065 01056000
BO DUPOPT BRANCH IF YES @V305065 01057000
OI CMSSWT,PRTOPT INDICATE PRINT @V305065 01058000
BR R5 @V305065 01059000
SPACE 2 01060000
DISKOP EQU * @V305065 01061000
TM CMSSWT,PRTOPT+TYPOPT OTHER DEVICES SPECIFIED? @V305065 01062000
BNZ OTHDEV BRANCH IF YES @V305065 01063000
TM CMSSWT,DSKOPT THIS DEVICE SPECIFIED? @V305065 01064000
BO DUPOPT BRANCH IF YES @V305065 01065000
OI CMSSWT,DSKOPT INDICATE DISK @V305065 01066000
BR R5 @V305065 01067000
SPACE 2 01068000
SORTOP EQU * @V305065 01069000
TM SWD,SORT WAS SORT SPECIFIED? @V305065 01070000
BO DUPOPT BRANCH IF YES @V305065 01071000
OI SWD,SORT INDICATE SORT @V305065 01072000
BR R5 @V305065 01073000
EJECT 1 01074000
DUPOPT EQU * @V305065 01075000
LR R2,R1 POINT TO OPTION @V305065 01076000
DMSERR NUM=065,LET=E,SUB=(CHARA,(R2)), @V305065X01077000
TEXT='''........'' OPTION SPECIFIED TWICE' @V305065 01078000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01079000
B FINAL @V305065 01080000
EJECT 1 01081000
OTHDEV EQU * @V305065 01082000
LA R2,OPTIONL GET OPTION LENGTH @V305065 01083000
STH R2,RECORDS AND SAVE IT @V305065 01084000
SR R2,R2 CLEAR REGISTER @V305065 01085000
IC R2,CMSSWT GET OPTION SWITCH @V305065 01086000
SRL R2,6 SHIFT OUT LOW BITS @V305065 01087000
MH R2,RECORDS TIMES LENGTH OF OPTIONS TABLE@V305065 01088000
LA R2,OPTIONS(R2) POINT TO PROPER OPTION @V305065 01089000
LR R3,R1 POINT TO CURRENT OPTION @V305065 01090000
DMSERR NUM=066,LET=E,SUB=(CHARA,(R3),CHARA,(R2)), @V305065X01091000
MF=(E,ERRLIST), @V305065X01092000
TEXT='''........'' AND ''........'' ARE CONFLICTING OPTIX01093000
ONS' @V305065 01094000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01095000
B FINAL @V305065 01096000
EJECT 1 01097000
INVDEV EQU * @V305065 01098000
SR R6,R6 @V305065 01099000
IC R6,4(R3) GET DEVICE CODE @V305065 01100000
DMSERR NUM=027,LET=E,SUB=(HEX,(R6)), @V305065X01101000
TEXT='INVALID DEVICE ''..''' @V305065 01102000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01103000
B FINAL @V305065 01104000
EJECT 1 01105000
NODIR EQU * @V305065 01106000
DMSERR NUM=047,LET=E,TEXT='NO FUNCTION SPECIFIED' @V305065 01107000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01108000
B FINAL @V305065 01109000
EJECT 1 01110000
BADADD EQU * @V305065 01111000
LR R2,R1 SAVE PLIST POINTER @V305065 01112000
DMSERR NUM=095,LET=E,SUB=(CHARA,(R2)), @V305065X01113000
TEXT='INVALID ADDRESS ''........''' @V305065 01114000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01115000
B FINAL @V305065 01116000
EJECT 1 01117000
BADPARM EQU * @V305065 01118000
LR R2,R1 SAVE PLIST POINTER @V305065 01119000
DMSERR NUM=070,LET=E,SUB=(CHARA,(R2)), @V305065X01120000
TEXT='INVALID PARAMETER ''........''' @V305065 01121000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01122000
B FINAL @V305065 01123000
EJECT 1 01124000
BADOPT EQU * @V305065 01125000
LR R2,R1 SAVE PLIST POINTER @V305065 01126000
DMSERR NUM=003,LET=E,SUB=(CHARA,(R2)), @V305065X01127000
TEXT='INVALID OPTION ''........''' @V305065 01128000
MVI ERCODE,TWENTY4 SET ERROR CODE @V305065 01129000
B FINAL @V305065 01130000
EJECT 1 01131000
TDERR EQU * @V305065 01132000
DMSERR NUM=021,LET=W, @V305065X01133000
TEXT='NO TRANSIENT DIRECTORY ' @V305065 01134000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01135000
BR R9 @V305065 01136000
EJECT 1 01137000
CDERR EQU * @V305065 01138000
DMSERR NUM=022,LET=W, @V305065X01139000
TEXT='NO CORE IMAGE DIRECTORY ' @V305065 01140000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01141000
BR R9 @V305065 01142000
EJECT 1 01143000
RDERR EQU * @V305065 01144000
DMSERR NUM=023,LET=W, @V305065X01145000
TEXT='NO RELOCATABLE DIRECTORY ' @V305065 01146000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01147000
BR R9 @V305065 01148000
EJECT 1 01149000
PDERR EQU * @V305065 01150000
DMSERR NUM=024,LET=W, @V305065X01151000
TEXT='NO PROCEDURE DIRECTORY ' @V305065 01152000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01153000
BR R9 @V305065 01154000
EJECT 1 01155000
SDERR EQU * @V305065 01156000
DMSERR NUM=025,LET=W, @V305065X01157000
TEXT='NO SOURCE STATEMENT DIRECTORY ' @V305065 01158000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01159000
BR R9 @V305065 01160000
EJECT 1 01161000
BADNAME EQU * @V305065 01162000
DMSERR NUM=026,LET=W,SUB=(CHARA,(R15)), @V305065X01163000
TEXT='''........'' NOT IN LIBRARY' @V305065 01164000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01165000
BR R9 @V305065 01166000
EJECT 1 01167000
PCDERR EQU * @V305065 01168000
DMSERR NUM=027,LET=W, @V305065X01169000
TEXT='NO PRIVATE CORE IMAGE LIBRARY' @V305065 01170000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01171000
BR R9 @V305065 01172000
EJECT 1 01173000
PTDERR EQU * @V305065 01174000
DMSERR NUM=028,LET=W,SUB=(CHARA,(R15)), @V305065X01175000
TEXT='NO ........ TRANSIENT DIRECTORY ENTRIES' @V305065 01176000
MVI ERCODE,FOUR SET ERROR CODE @V305065 01177000
BR R9 @V305065 01178000
EJECT 1 01179000
*********************************************************************** 01180000
***** DIRECTORY READ ROUTINE * 01181000
*********************************************************************** 01182000
SPACE 1 01183000
READDIR LA R1,RDCCB ADDR OF CCB FOR EXCP @V305096 01184000
SVC 0 @V305066 01185000
BR R9 RETURN TO CALLER @V305096 01186000
EJECT 01187000
*********************************************************************** 01188000
***** INSTRUCTIONS TO BE EXECUTED VIA THE EX INSTRUCTION * 01189000
*********************************************************************** 01190000
SPACE 2 01191000
SETIND OI SWA,ZERO SET DISPLAY INDICATOR INSTR. @V305096 01192000
SPACE 1 01193000
MOVENAME MVC PNBUCKET(ZERO),ZERO(R1) MOVE SPECIFIED PHASENAME@V305096 01194000
SPACE 1 01195000
PACK1 PACK DBLWORD(EIGHT),ZERO(ZERO,R2) CONVERT DATA TYPE @V305096 01196000
EJECT 01197000
*********************************************************************** 01198000
* DTF'S, CCB'S, CCW'S, DC'S AND DS'S * 01199000
*********************************************************************** 01200000
SPACE 2 01201000
***** DTF FOR OPENING PRIVATE RELOCATABLE LIBRARY 01202000
SPACE 2 01203000
IJSYSRL DTFCP TYPEFLE=INPUT, @V305096X01204000
DISK=YES, @V305096X01205000
DEVADDR=SYSRLB, @V305096X01206000
EOFADDR=*, @V305096X01207000
IOAREA1=* @V305096 01208000
SPACE 2 01209000
* THE LABEL 'IJJCPD3' IS ONLY USED TO PROVIDE THE PROGRAM 01210000
* WITH A DUMMY ENTRY, SO THAT THERE WILL BE NOT 01211000
* UNRESOLVED ADDRESS CONSTANTS DURING LINK EDITING. 01212000
SPACE 1 01213000
IJJCPD3 EQU * @V305096 01214000
SPACE 2 01215000
***** DTF FOR OPENING PRIVATE CORE IMAGE LIBRARY 01216000
SPACE 2 01217000
IJSYSCL DTFCP TYPEFLE=INPUT, @V305065C01218000
DISK=YES, @V305065C01219000
DEVADDR=SYSCLB, @V305065C01220000
EOFADDR=*, @V305065C01221000
IOAREA1=* @V305065 01222000
SPACE 3 01223000
***** DTF FOR OPENING PRIVATE SOURCE STATEMENT LIBRARY 01224000
SPACE 2 01225000
IJSYSSL DTFCP TYPEFLE=INPUT, @V305096X01226000
DISK=YES, @V305096X01227000
DEVADDR=SYSSLB, @V305096X01228000
EOFADDR=*, @V305096X01229000
IOAREA1=* @V305096 01230000
SPACE 3 01231000
LTORG @V305096 01232000
DS 0F @V305096 01233000
EJECT 01234000
***** CCB FOR READING SYSTEM DIRECTORIES 01235000
SPACE 1 01236000
RDCCB CCB SYSRES,CCW1 CCB FOR READING SYSTEM DIRECTORY @V305096 01237000
SPACE 3 01238000
***** CCW CHAIN TO READ 4 - 80 BYTE SYSTEM RECORDS 01239000
SPACE 1 01240000
CCW1 CCW SEEK,SEEKBB,CCSLI,SIX SEEK BBCCHH @V305096 01241000
CCW2 CCW SIDE,SEEKCC,CCSLI,FIVE SEARCH ID EQUAL @V305096 01242000
CCW TIC,CCW2,CCSLI,ONE TRANSFER IN CHANNEL @V305096 01243000
CCW4 CCW READ,RLAREA,CCSLI,EIGHTY READ DATA @V305096 01244000
CCW5 CCW READ,SLAREA,CCSLI,EIGHTY READ DATA @V305096 01245000
CCW6 CCW READ,PLAREA,SLI,EIGHTY READ DATA @V305096 01246000
SPACE 3 01247000
***** DISK ADDRESS SEEK BUCKET TO READ SYSTEM RECORDS 01248000
SPACE 1 01249000
SEEKBB DC H'0' BB PORTION OF SEEK ADDR @V305096 01250000
SEEKCC DC X'0000' CC PORTION OF SEEK ADDR @V305096 01251000
DC X'0001' HH PORTION OF SEEK ADDR @V305096 01252000
DC X'02' R - RECORD NO. @V305096 01253000
EJECT 01254000
***** CONSTANTS - COMMON TO THIS PHASE ONLY 01255000
SPACE 1 01256000
DBLWORD DC D'0' DOUBLE WORD WORK AREA @V305096 01257000
MAXADDR DC F'16777214' MAX. VM LOCATION IN A PHASE @V305096 01258000
R1SAVE DC F'0' SAVE AREA REGISTER 1 @V305096 01259000
R24SAVE DC F'0' SAVE AREA FOR @V305096 01260000
R34SAVE DC F'0' REGISTERS @V305096 01261000
DC F'0' R2, R3 AND R4 @V305096 01262000
SAVEIN DC F'0' READIN SAVE AREA @V305096 01263000
CON8 DC H'8' CONSTANT OF 8 @V305096 01264000
HALFW20 DC H'20' CONSTANT OF 20 @V305096 01265000
KALL DC C'ALL' DISPLAY CARD OPERAND @V305096 01266000
KTD DC C'TD' DISPLAY CARD OPERAND @V305096 01267000
KCD DC C'CD' DISPLAY CARD OPERAND @V305096 01268000
KRD DC C'RD' DISPLAY CARD OPERAND @V305096 01269000
KSD DC C'SD' DISPLAY CARD OPERAND @V305096 01270000
KPD DC C'PD' DISPLAY CARD OPERAND @V305096 01271000
KPHASE DC CL8'PHASE' @V305065 01272000
ZEROS DC XL4'0' ZEROS @V305096 01273000
SPACE 1 01274000
ST1 DC CL8'SYSTEM' @V305096 01275000
PV1 DC CL8'PRIVATE' @V305065 01276000
SPACE 2 01277000
OPTIONS DS 0F @V305065 01278000
DC CL8'TERM' @V305065 01279000
DC A(TERMOP) @V305065 01280000
OPTIONL EQU *-OPTIONS LENGTH OF OPTION ENTRY @V305065 01281000
DC CL8'PRINT' @V305065 01282000
DC A(PRNTOP) @V305065 01283000
DC CL8'DISK' @V305065 01284000
DC A(DISKOP) @V305065 01285000
DC CL8'SORT' @V305065 01286000
DC A(SORTOP) @V305065 01287000
OPTIONN EQU (*-OPTIONS)/OPTIONL NUMBER OF OPTIONS @V305065 01288000
SPACE 2 01289000
DS 0F ALIGN AREAS ON FULL WORD@V305096 01290000
RLAREA DC XL80'0' RELOCATABLE DIR READ IN @V305096 01291000
SLAREA DC XL80'0' SOURCE DIRECTORY READ IN@V305096 01292000
PLAREA DC XL80'0' PROCEDURE DIRECTORY READ IN @V305096 01293000
EJECT 01294000
************************************************************ 01295000
* CMS DEVICE TABLE FOR TRACKS / CYLINDER 01296000
************************************************************ 01297000
DEVSTART EQU * @V305065 01298000
* 01299000
* 2314 01300000
* 01301000
TAB2314 EQU * @V305065 01302000
DC AL1(DEV2314) @V305065 01303000
DC X'0014' @V305065 01304000
LDEVTAB EQU *-TAB2314 @V305065 01305000
* 01306000
* 3330 01307000
* 01308000
DC AL1(DEV3330) @V305065 01309000
DC X'0013' @V305065 01310000
* 01311000
* 3330-11 01311150
* 01311300
DC AL1(DEV333B) @V505098 01311450
DC X'0013' @V505098 01311600
* 01311750
* 3340,36MB 01312000
* 01313000
DC AL1(DEV3343) @V305065 01314000
DC X'000C' @V305065 01315000
* 01316000
* 3340,70MB 01317000
* 01318000
DC AL1(DEV3347) @V305065 01319000
DC X'000C' @V305065 01320000
* 01321000
* 3350 01321150
* 01321300
DC AL1(DEV3350) @V505098 01321450
DC X'001E' @V505098 01321600
* 01321750
DEVEND EQU * @V305065 01322000
EJECT 01323000
*********************************************************************** 01324000
***** EQUATES -- COMMON TO THIS PHASE ONLY * 01325000
*********************************************************************** 01326000
SPACE 1 01327000
CCBSYM2 EQU RDCCB+7 2ND BYTE OF SYMBOLIC UNIT @V305096 01328000
CCW4FLAG EQU CCW4+4 CCW FLAG BYTE @V305096 01329000
IJRLL EQU IJSYSRL+60 LOC OF LOWER LIMIT IN DTF @V305096 01330000
IJSLL EQU IJSYSSL+60 LOC OF LOWER LIMIT IN DTF @V305096 01331000
IJCLL EQU IJSYSCL+60 DITTO @V305065 01332000
RLAREA2 EQU RLAREA+2 STARTING ADDR OF RD DIR @V305096 01333000
SLAREA2 EQU SLAREA+2 STARTING ADDR OF SD DIR @V305096 01334000
PLAREA2 EQU PLAREA+2 STARTING ADDRESS OF PD DIR @V305096 01335000
RACTENT EQU RLAREA+44 ACTIVE ENTRY BYTE OF RD REC @V305096 01336000
SACTENT EQU SLAREA+44 ACTIVE ENTRY BYTE OF SD REC @V305096 01337000
PACTENT EQU PLAREA+44 ACTIVE ENTRY BYTE OF PD REC @V305096 01338000
SEVEN1 EQU 71 @V305096 01339000
SPACE 1 01340000
COMMA EQU C',' @V305096 01341000
LPAREN EQU C'(' FOR PARAENTHESIS CHECK @V305096 01342000
RPAREN EQU C')' FOR PARENTHESIS CHECK @V305096 01343000
SPACE 01344000
THIRTY1 EQU 31 @V305096 01345000
DS 0F @V305065 01346000
DSERV2 EQU * @V305065 01348000
USING *,R13 SPECIFY BASE REG TO ASSEMBLER @V305096 01349000
SPACE 2 01350000
************************************************************** 01351000
* INITIALIZE HEADINGS FOR THE DIFFERENT DIRECTORIES. * 01352000
************************************************************** 01353000
SPACE 1 01354000
MVC LINE21(FIFTY6),LINE2A INITIALIZE HEADERS @V305065 01355000
MVC LINE31(FIFTY6),LINE3A @V305065 01356000
MVC LINES,LINECTR INIT LINE COUNTER @V305096 01357000
OI SWA,HEADIND INDICATE HEADER PRINT @V305096 01358000
MVI PHASENO,ONE INIT FOR FETCH DSERV1 @V305096 01359000
MVC TCSEEKCC(FIVE),DISKCID INIT DIR SEEK ADDR @V305096 01360000
MVC TCCOUNT(FIVE),DISKCID INIT DIR SEEK ADDR @V305096 01361000
TM SWB,SYSTD ASK TO DISPLAY SYS TD @V305096 01362000
BO ST YES @V305096 01363000
TM SWB,SYSCL ASK TO DISPLAY SYS CIL @V305096 01364000
BO SC YES @V305096 01365000
TM SWB1,PTD ASK TO DISPLAY PRIV TD @V305096 01366000
BZ PC NO @V305096 01367000
MVC TW(L'T2),T2 'PRIVATE' TO TITLE @V305096 01368000
ST MVC TW+EIGHT(L'T1),T1 'TRANSIENT' TO TITLE @V305096 01369000
MVC TW+EIGHTEEN(L'T4),T4 'DIRECTORY' TO TITLE @V305096 01370000
B MVCLINE2 'LOAD ENTRY' TO TITLE @V305096 01371000
PC MVC TW(L'T2),T2 'PRIVATE' TO TITLE @V305096 01372000
SC MVC TW+EIGHT(L'T3+L'T4),T3 'CORE IMAGE DIRECTORY' @V305096 01373000
* TO TITLE AREA 01374000
TM SWA,VMIND VM SPECIFIED @V305096 01375000
BO TC1 GO TO PRINT DIRECTORY @V305096 01376000
MVCLINE2 MVC LINE21(FIFTY4),LINE2B DO NOT PRINT 'VER MOD' @V305096 01377000
MVCLINE3 MVC LINE31(FIFTY4),LINE3B DO NOT PRINT 'LEV LEV' @V305096 01378000
TC1 TM SWB1,PTD+PCLB DISPL PRIV TD OR CD @V305096 01379000
BZ PROCESS NO @V305096 01380000
MVI VMCBSYM,CLB SET SYMB UNIT IN VM CCB @V305096 01381000
MVI TCCBSYM,CLB SET SYMB UNIT TO SYSCLB @V305096 01382000
MVI VMDIRSYM,CLB SET SYMB UNIT TO SYSCLB @V305096 01383000
EJECT 01384000
************************************************************** 01385000
* READ THE CORE IMAGE LIBRARY DESCRIPTOR RECORD AND * 01386000
* CHECK FOR ACTIVE ENTRIES IF PPRIV CD REQUEST * 01387000
* CHECK FOR $-PHASES FOR PRIV TD REQUEST * 01388000
* CHECK FOR VM DSPL AND IF SO READ THE RIGHT BLOCK * 01389000
* IMMEDIATELY, OTHERWISE READ THE DIRECTORY SEQUENTIAL. * 01390000
* UPDATE TO NEXT ENTRY AND CHECK FOR END OF DIR. * 01391000
************************************************************** 01392000
SPACE 1 01393000
PROCESS BAL R9,TCEXCP READ LIBR DESCR REC @V305096 01394000
BAL R9,SETPTRS INITIALIZE POINTERS @V305096 01395000
TM SWB1,PCLB REQUEST FOR PRIV CD @V305096 01396000
BZ TDREQ NO, CHECK TD REQUEST @V305096 01397000
SR R0,R0 ZERO REG FOR COMPARE @V305096 01398000
CH R0,EIGHTEEN(R6) ACTIVE ENTRIES @V305096 01399000
BNE TDREQ YES, CHECK TD REQUEST @V305096 01400000
OI SWE,ERR5 INDICATE 'NO PRIVATE CD'@V305096 01401000
B RESETCD RESET SWITCHES @V305096 01402000
TDREQ BAL R9,ADDENTR UPDATE TO NEXT ENTRY @V305096 01403000
TM SWB1,PTD REQUEST FOR PRIV TD @V305096 01404000
BZ READCHK NO @V305096 01405000
CLI ZERO(R6),DOLLAR FIRST ENTRY $ ENTRY @V305096 01406000
BE READCHK YES @V305096 01407000
OI SWE,ERR8 INDICATE 'NO PRIVATE TD'@V305096 01408000
B RESETTD RESET SWITCHES @V305096 01409000
SPACE 1 01410000
READCHK TM SWA,VMIND VM SPECIFIED @V305096 01411000
BNO HEADS PROCESS FIRST ENTRY @V305096 01412000
READKEY LA R1,VMDIRCCB ADDR OF CCB FOR EXCP @V305096 01413000
BAL R9,EXCP READ THE RIGHT BLOCK @V305096 01414000
TM THREE(R1),EOC END OF CYL POSTED @V305096 01415000
BZ INITPTR NO, INIT PTRS @V305096 01416000
MVC TCSEEKCC,TCCOUNT GET ADDR OF NXT REC @V305096 01417000
LA R9,TICCCW CCW AFTER SRCH ON KEY @V305096 01418000
L R10,VMDIRCCB+12 ADDR NXT CCW TO BE EXEC @V305096 01419000
LA R10,ZERO(R10) CLEAR HIGH ORDER BYTE @V305096 01420000
CR R9,R10 BROKEN ON SRCH ON KEY @V305096 01421000
BE READKEY YES, REISSUE I/O @V305096 01422000
INITPTR BAL R9,SETPTRS INITIALIZE POINTERS @V305096 01423000
IC R10,NAMELNG GET PHASE NAME LENGTH @V305096 01424000
EXCOMP EX R10,VMCOMP THIS THE RIGHT PHASE @V305096 01425000
BE HEADS PROCESS IF EQUAL @V305096 01426000
BH PHNOTFND PHASE NOT FOUND IF HIGH @V305096 01427000
BAL R9,ADDENTR UPDATE TO NEXT ENTRY @V305096 01428000
CR R6,R8 ALL ENTRIES PROCESSED? @V305065 01429000
BL EXCOMP BRANCH IF NOT @V305065 01430000
BAL R7,SEQREAD GO GET NEXT RECORD @V305065 01431000
B EXCOMP COMPARE PHASENAMES @V305096 01432000
PHNOTFND OI SWA,NONAME PHASE NOT FOUND COND @V305096 01433000
B FETCH GO TO DSERV1 @V305096 01434000
EJECT 01435000
SETPTRS LA R6,TCAREA+2 PTR TO FIRST ENT IN BLK @V305096 01436000
LA R8,TCAREA CALCULATE PTR TO FIRST @V305096 01437000
AH R8,ZERO(R8) UNUSED BYTE IN BLOCK @V305096 01438000
BR R9 BACK TO CALLER @V305096 01439000
SPACE 1 01440000
SEQREAD BAL R9,TCEXCP READ A DIR BLOCK @V305096 01441000
BAL R9,SETPTRS INITIALIZE POINTERS @V305096 01442000
BR R7 TEST FOR END OF DIR @V305096 01443000
SPACE 1 01444000
NEXTENTR BAL R9,ADDENTR UPDATE TO NEXT ENTRY @V305096 01445000
ENDCHK CR R6,R8 ALL ENTRIES PROCESSED @V305096 01446000
BL ENDCHK1 BRANCH IF NOT @V305065 01447000
BAL R7,SEQREAD YES, READ ANOTHER BLOCK @V305096 01448000
ENDCHK1 EQU * @V305065 01449000
TM SWB,SYSTD REQUEST FOR SYS TD @V305096 01450000
BO $CHECK YES TEST END OF $-PHASES@V305096 01451000
TM SWB1,PTD REQUEST FOR PRV TD @V305096 01452000
BZ ENDCHK2 NO, TEST END OF DIR @V305096 01453000
$CHECK CLI ZERO(R6),DOLLAR END OF TD PRINT REACHED @V305096 01454000
BE HEADS NO, GO ON @V305096 01455000
RESETTD NI SWB,HEXFF-SYSTD RESET TD SWITCHES @V305096 01456000
NI SWB1,HEXFF-PTD * @V305096 01457000
B FETCH GO TO DSERV1 @V305096 01458000
ENDCHK2 CLC ZERO(EIGHT,R6),ENDDIR END OF DIR REACHED @V305096 01459000
BE RESETCD YES, TEST END OF SDL @V305096 01460000
TM SWA,VMIND VM SPECIFIED @V305096 01461000
BNO HEADS NO, CONTINUE @V305096 01462000
IC R10,NAMELNG GET PHASENAME LENGTH @V305096 01463000
EX R10,VMCOMP HAS PHASE TO BE DISPL @V305096 01464000
BH RESETCD NO, RESET SWITCHES @V305096 01465000
B HEADS CONTINUE PROCESSING @V305096 01466000
RESETCD NI SWB,HEXFF-SYSCL RESET CD SWITCHES @V305096 01467000
NI SWB1,HEXFF-PCLB * @V305096 01468000
B FETCH GO TO DSERV1 @V305096 01469000
SPACE 1 01470000
ADDENTR SR R5,R5 CLEAR REGISTER @V305096 01471000
IC R5,ELEVEN(R6) GET NUMBER OF HALFWORDS @V305096 01472000
LA R5,TWELVE(R5,R5) CALCULATE ENTRY LENGTH @V305096 01473000
AR R6,R5 ADD THIS TO ENTRY PTR @V305096 01474000
BR R9 RETURN TO CALLER @V305096 01475000
EJECT 01476000
************************************************************** 01477000
* PRINT HEADINGS FOR TD & CD DIRECTORY * 01478000
************************************************************** 01479000
SPACE 1 01480000
SETDIRSW OI SWD,DIREND IND END OF DISK DIR @V305096 01481000
HEADS TM SWA,HEADIND NEED HEADER FOR NEW PAGE@V305096 01482000
BZ TCLINE NO @V305096 01483000
LA R2,PRINT GET ADDR OF PRINT ROUT @V305096 01484000
LA R7,PRINTB GET ADDR OF PRINT AREA @V305096 01485000
MVI ZERO(R7),DASH MOVE DASH TO PRINT AREA @V305096 01486000
MVC ONE(SIXTY9,R7),ZERO(R7) PROPAGATE DASH @V305096 01487000
MVC ZERO(TWENTY8,R7),TW TITLE TO PRINT AREA @V305096 01488000
TM SWA,VMIND DISPLAY CD WITH VM @V305096 01489000
BNO DATECNV CONVERT DATE @V305096 01490000
MVC SEVENTY(NINE,R7),SIXTY9(R7) EXTEND DASHES @V305096 01491000
DATECNV EQU * @V305065 01492000
TM CMSSWT,TYPOPT WAS TERMINAL SPECIFIED? @V305065 01493000
BO PTHEADS BRANCH IF YES @V305065 01494000
COMRG GET ADDR COMMUNICAT REG @V305096 01495000
MVC ONE02(EIGHT,R7),ZERO(R1) DATE TO PRINT AREA @V305096 01496000
ZEROR1 SR R1,R1 ZERO WORK REGISTER @V305096 01497000
IC R1,PAGECTR GET CURRENT PAGE NUMBER @V305096 01498000
CVD R1,DW CONVERT TO DECIMAL @V305096 01499000
LA R1,ONE(R1) BUMP PAGE NO. BY 1 @V305096 01500000
STC R1,PAGECTR SAVE NEW PAGE NUMBER @V305096 01501000
UNPK ONE18(TWO,R7),DW+SIX(TWO) CONVERT PAGE NO. TO @V305096 01502000
OI ONE19(R7),HEXF0 PRINTABLE CHARACTER @V305096 01503000
CLI ONE18(R7),HEXF0 PAGE NO. LEADING ZERO @V305096 01504000
BNE MVCT7 NO @V305096 01505000
MVI ONE18(R7),BLANK SUPPRESS LEADING ZERO @V305096 01506000
MVCT7 MVC ONE11(FOUR,R7),T7 PAGE NO. TO PRINT AREA @V305096 01507000
PTHEADS EQU * @V305065 01508000
BALR R9,R2 PRINT TITLE,DATE AND @V305096 01509000
BALR R9,R2 PAGENO, SKIP ONE LINE @V305096 01510000
MVC TWO(LCILH,R7),LINE2 HEADING LINE2 TO AREA @V305096 01511000
BALR R9,R2 PRINT HEADING LINE 2 @V305096 01512000
MVC TWO(LCILH,R7),LINE3 HEADING LINE3 TO AREA @V305096 01513000
BALR R9,R2 PRINT HEADING LINE 3 @V305096 01514000
BALR R9,R2 SKIP ONE LINE @V305096 01515000
MVI TEN(R7),DASH MOVE DASH TO PRINT AREA @V305096 01516000
MVC ELEVEN(LDASH,R7),TEN(R7) PROPOGATE DASH @V305096 01517000
TM SWA,VMIND DISPLAY CD WITH VM @V305096 01518000
BO VMLINE4 YES @V305096 01519000
MVCHEX MVC FIFTY9(THREE,R7),HEX MOVE 'HEX' TO PR AREA @V305096 01520000
MVC FORTY6(THREE,R7),BLANKS BLANK UNUSED FIELD @V305096 01521000
MVC TWENTY8(THREE,R7),DEC MOVE 'DEC' TO PR AREA @V305096 01522000
B LINE4 GO PRINT LINE @V305096 01523000
VMLINE4 MVC THIRTY2(THREE,R7),DEC MOVE 'DEC' TO PR AREA @V305096 01524000
MVC FIFTY5(THREE,R7),BLANKS BLANK UNUSED FIELD @V305096 01525000
MVC SEVENTY(NINE,R7),SIXTY9(R7) PROPOGATE DASH @V305096 01526000
MVC SIXTY8(THREE,R7),HEX MOVE 'HEX' TO PR AREA @V305096 01527000
LINE4 BALR R9,R2 PRINT HEADING LINE4 @V305096 01528000
BALR R9,R2 SKIP ONE LINE @V305096 01529000
LA R7,PRINTB REINIT PR AREA PTR @V305096 01530000
MVC ELEVEN(L'T6,R7),T6 MOVE 'CHR' TO PR AREA @V305096 01531000
BALR R9,R2 PRINT CHR LINE @V305096 01532000
SPACE 1 01533000
************************************************************** 01534000
* MOVE THE DIRECTORY ENTRY TO A TEMPORARY LOCATION TO GET * 01535000
* THE LOAD AND ENTRY ADDRESSES WITHOUT SEVERAL TESTS. * 01536000
* RESET R6 TO ITS ORIGINAL VALUE AT THE END OF THIS ROUTINE. * 01537000
************************************************************** 01538000
SPACE 1 01539000
TCLINE ST R6,SAVEPTR SAVE REG 6 @V305096 01540000
IC R5,ELEVEN(R6) GET NUMBER OF HALFWORDS @V305096 01541000
LA R5,TWELVE(R5,R5) CALCULATE ENTRY LENGTH @V305096 01542000
BCTR R5,0 MINUS 1 FOR EXECUTE @V305096 01543000
EX R5,MOVEENTR INSERT ENTRY LENGTH @V305096 01544000
LA R6,TEMPENTR GET ADDR OF ENTRY @V305096 01545000
LA R7,PRINTB REINITIALIZE PRINT PTR @V305096 01546000
TM SWA,VMIND DISPLY CD WITH VM @V305096 01547000
BNO SUBADDR NO, GET SUBROUTINE ADDR @V305096 01548000
LA R7,NINE(R7) UPDATE OUTPUT PTR @V305096 01549000
SUBADDR LA R4,FULL LOAD ADDR OF SUBROUTINE @V305096 01550000
EJECT 01551000
************************************************************** 01552000
* PRINT PHASE NAME AND PHASE INFORMATION FROM (P)CIL. * 01553000
************************************************************** 01554000
SPACE 1 01555000
ELIGIBLE TM SWA,VMIND DISPLY CD WITH VM @V305096 01556000
BNO MOVEPHAS NO, MOVE PHASENAME @V305096 01557000
SH R7,HALFW9 SUBTR 9 FROM PTR @V305096 01558000
MOVEPHAS MVC ZERO(EIGHT,R7),ZERO(R6) PHASE NAME TO PR AREA @V305096 01559000
MVC FW3(ONE),TEN(R6) GET REC NO FROM TTR @V305096 01560000
MVC VMSEEKR(ONE),TEN(R6) SAVE R FOR VM LIB SEEK @V305096 01561000
BALR R9,R4 CONVERT R TO ZONED @V305096 01562000
MVC SEVETEEN(TWO,R7),ZND4 R TO PRINT AREA @V305096 01563000
SR R2,R2 CLEAR REG FOR DIVIDE @V305096 01564000
LH R3,EIGHT(R6) ADD HH FROM TTR AND @V305096 01565000
AH R3,DISKCID+TWO HH FROM DIR START ADDR @V305096 01566000
D R2,TRCYLCIL DIVIDE BY TRACKS/CYL @V305096 01567000
STH R2,FW2 STORE HH FOR CONVERTING @V305096 01568000
STH R2,VMSEEKH SAVE HH FOR LIB SEEK @V305096 01569000
BALR R9,R4 CONVERT HH TO ZONED @V305096 01570000
MVC FOURTEEN(TWO,R7),ZND4 HH TO PRINT AREA @V305096 01571000
AH R3,DISKCID ADD DIR START ADDR CC @V305096 01572000
STH R3,FW2 STORE CC FOR CONVERTING @V305096 01573000
STH R3,VMSEEKCC SAVE CC FOR LIB SEEK @V305096 01574000
BALR R9,R4 CONVERT CC TO ZONED @V305096 01575000
MVC TEN(THREE,R7),ZND3 CC TO PRINT AREA @V305096 01576000
MVC FW2(TWO),TWELVE(R6) NUMBER OF REC TO FULLW @V305096 01577000
BALR R9,R4 CONVERT IT TO ZONED @V305096 01578000
MVC TWENTY1(THREE,R7),ZND3 NO OF REC TO PRINT AREA @V305096 01579000
TM SIXTEEN(R6),RELPHASE IS PHASE RELOCATABLE @V305096 01580000
BZ NOTREL1 NO, BRANCH @V305096 01581000
MVC FW2(TWO),TWENTY4(R6) RLD ITEMS TO FULL WORD @V305096 01582000
BALR R9,R4 CONVERT IT TO ZONED @V305096 01583000
MVC FORTY1(FIVE,R7),ZND1 MOVE TO OUTPUT AREA @V305096 01584000
MVC FW3(ONE),TWENTY6(R6) ADD. RLD BLKS TO FULLW @V305096 01585000
BALR R9,R4 CONVERT IT TO ZONED @V305096 01586000
MVC THIRTY5(THREE,R7),ZND3 MOVE TO PRINT AREA @V305096 01587000
NOTREL1 MVC FW2(TWO),FOURTEEN(R6) BTS LAST REC TO FULLW @V305096 01588000
BALR R9,R4 CONVERT IT TO ZONED @V305096 01589000
MVC TWENTY7(FOUR,R7),ZND2 BTS IN LAST REC TO PR @V305096 01590000
TM SWA,VMIND VM SPECIFIED @V305096 01591000
BZ TC2 NO @V305096 01592000
LA R7,NINE(R7) YES, BUMP R7 FOR VM @V305096 01593000
TC2 UNPK FORTY9(SEVEN,R7),EIGHTEEN(FOUR,R6) UNPK LOAD ADR@V305096 01594000
TR FORTY9(SIX,R7),TABLET TRANSLATE IT @V305096 01595000
MVI FIFTY5(R7),BLANK BLANK UNUSED 7TH POS @V305096 01596000
UNPK FIFTY7(SEVEN,R7),TWENTY1(FOUR,R6) UNPK ENT ADDR @V305096 01597000
TR FIFTY7(SIX,R7),TABLET TRANSLATE IT @V305096 01598000
MVI SIXTY3(R7),BLANK BLANK UNUSED 7TH POS @V305096 01599000
TM SIXTEEN(R6),RELPHASE IS PHASE RELOCATABLE @V305096 01600000
BZ TC4 NO, BRANCH @V305096 01601000
UNPK SIXTY5(SEVEN,R7),TWENTY7(FOUR,R6) @V305096 01602000
* PART ADDR TO PRINT AREA 01603000
TR SIXTY5(SIX,R7),TABLET TRANSLATE IT @V305096 01604000
MVI SEVENTY1(R7),BLANK BLANK UNUSED 7TH POS @V305096 01605000
TC4 XC ZERO(THIRTY4,R6),ZERO(R6) ZERO OUT 'TEMPENTR' @V305096 01606000
L R6,SAVEPTR GET ORIG ENTR ADDR @V305096 01607000
TM SWA,VMIND VM SPECIFIED @V305096 01608000
BO VMROUT YES @V305096 01609000
BAL R9,PRINT PRINT A LINE @V305096 01610000
B NEXTENTR PROCESS NEXT ENTRY @V305096 01611000
SPACE 2 01612000
FULL L R1,FW PASS FULLW TO WORK REG @V305096 01613000
CVD R1,DW CONVERT TO PACKED FORM @V305096 01614000
UNPK ZND(SIX),DW+FOUR(FOUR) CONVERT TO ZONED @V305096 01615000
OI ZND+FIVE,HEXF0 MAKE LAST BYTE PRINTABLE@V305096 01616000
XC FW(FOUR),FW CLEAR FULLWORD @V305096 01617000
BR R9 RETURN @V305096 01618000
SPACE 1 01619000
MOVEENTR MVC TEMPENTR(ZERO),ZERO(R6) MOVE ENTR OVER 34 ZEROS @V305096 01620000
SPACE 1 01621000
SDLSTEP SR R10,R10 CLEAR REGISTER @V305096 01622000
IC R10,ELEVEN(R11) GET NUMBER OF HALFWORDS @V305096 01623000
LA R10,TWELVE(R10,R10) CALCULATE ENTRY LENGTH @V305096 01624000
AR R11,R10 ADD THIS TO ENTRY PTR @V305096 01625000
BR R9 RETURN TO CALLER @V305096 01626000
EJECT 01627000
************************************************************** 01628000
***** ROUTINE TO HANDLE QUALIFIED PHASE(S) SPECIFIED * 01629000
***** IN THE CD OPERAND * 01630000
***** MOVE THE V/M LEVEL IN 'VM' AREA. * 01631000
************************************************************** 01632000
SPACE 1 01633000
VMROUT TM SWC,DISPLACE WAS V/M DISPL SPECIFIED @V305096 01634000
BO CHECKA NO @V305096 01635000
MVI VMDISP1,TWELVE SET DEFAULT VALUE TO 12 @V305096 01636000
CHECKA CLC DOLLARA(THREE),ZERO(R6) IS IT A $$A PHASE @V305096 01637000
BE DOLLARAB YES @V305096 01638000
CLC DOLLARB(THREE),ZERO(R6) IS IT A $$B PHASE @V305096 01639000
BE DOLLARAB YES @V305096 01640000
TM SWC,DISPLACE WAS V/M DISPLACEMENT SEPECIFIED? @V305096 01641000
BO VMBLANKR YES @V305096 01642000
MVI VMDISP1,EIGHT SET 2ND DEFAULT VALUE TO 8 @V305096 01643000
VMBLANKR MVC VM(TWO),BLANK2 PUT BLANKS IN VERS NO. @V305096 01644000
VMSKADR L R5,VMDISP INIT VERSION LOCATE REG @V305096 01645000
LH R10,TWELVE(R6) GET NO OF TXT BLOCKS @V305096 01646000
VMRDCIL LA R2,LIBAREA GET ADDR OF LIB AREA @V305096 01647000
BAL R9,VMEXCP READ CORE IMAGE LIBRARY BLOCK@V305096 01648000
TM SWC,LEVELNO NEED LEVEL NUMBER ONLY @V305096 01649000
BO VMGETLVL YES @V305096 01650000
TM SWA,NONAME PHASE NAME FOUND? @V305096 01651000
BO VMSKSCAN NO @V305096 01652000
TM SWC,SKIPNAME IS IT TRANSIENT PHASE? @V305096 01653000
BO VMSKSCAN YES @V305096 01654000
LA R4,ONE28 INIT PH NAME SRCH FACT @V305096 01655000
COMP CLC ZERO(EIGHT,R6),ZERO(R2) IS IT PHASE NAME? @V305096 01656000
BE NAMEFOND YES @V305096 01657000
LA R2,EIGHT(R2) INCREMENT LIB PTR BY 8 @V305096 01658000
BCT R4,COMP CONTINUE UNTIL WHOLE BLOCK COMP @V305096 01659000
BCT R10,VMRDCIL CONTINUE UNTIL WHOLE PHASE SR @V305096 01660000
OI SWA,NONAME SET NO PHASE NAME IND. @V305096 01661000
CLC TWELVE(TWO,R6),HALFW1 IS PHASE IN 1 BLOCK @V305096 01662000
BNE VMSKADR NO, REREAD LIBRARY @V305096 01663000
VMSKSCAN LH R4,RESBLOCK INIT BLOCK SIZE REG. @V305096 01664000
B GETVM GO TO GET V/M BYTE @V305096 01665000
SPACE 1 01666000
DOLLARAB OI SWC,SKIPNAME SET SKIP SEARCHING PH NAME IND. @V305096 01667000
CLI VMDISP1,TWELVE WAS VERSION DISP SPECIFIED @V305096 01668000
BH VMBLANKR YES @V305096 01669000
MVI VMDISP1,TWELVE NO, SET DEFAULT VALUE TO 12 @V305096 01670000
NI SWC,HEXFF-DISPLACE TURN OFF DISP SEPECIFIED IND @V305096 01671000
B VMBLANKR GO TO READ PHASE FROM LIB @V305096 01672000
SPACE 1 01673000
NAMEFOND OI SWC,SKIPNAME SET SKIP SEARCHING PH NAME IND. @V305096 01674000
LH R4,FOURTEEN(R6) GET LAST RECORD SIZE @V305096 01675000
LPR R4,R4 BE SURE IT IS POSITIVE @V305096 01676000
BCTR R10,R0 DECREMENT NO OF BLOCKS BY ONE@V305096 01677000
LTR R10,R10 IS IT IN LAST BLOCK @V305096 01678000
BZ LASTBLK YES @V305096 01679000
BCTR R10,R0 DECREMENT NO OF BLOCKS BY ONE@V305096 01680000
LTR R10,R10 IS IT IN 2ND LAST BLOCK @V305096 01681000
BZ LASTBLK2 YES @V305096 01682000
MH R10,RESBLOCK NO, GET TOTAL LEN OF FULL BLO@V305096 01683000
LASTBLK2 AR R10,R4 ADD LAST RECORD SIZE @V305096 01684000
LH R4,RESBLOCK INIT ENDING ADDR OF @V305096 01685000
LASTBLK LA R4,LIBAREA(R4) LIBRARY AREA @V305096 01686000
SR R4,R2 CALC REMAINING BYTES @V305096 01687000
* IN LIBAREA 01688000
AR R10,R4 TOTAL LENGTH OF PHASE @V305096 01689000
BCTR R10,R0 DECREMENT LENGTH OF @V305096 01690000
BCTR R10,R0 PHASE BY TWO @V305096 01691000
CR R10,R5 IS SPEC DISP IN PHASE @V305096 01692000
BL VMONEPH NO, BYPASS VERSION @V305096 01693000
GETVM BCTR R4,R0 DECREMENT BLOCK SIZE BY ONE @V305096 01694000
CR R5,R4 VERS NO IN THIS BLOCK @V305096 01695000
BE VM1BYTE YES, BUT ONLY FIRST BYTE@V305096 01696000
BL VMCALC YES, BOTH BYTE @V305096 01697000
SR R5,R4 SUBTR VERS ADDR 1 BLK @V305096 01698000
B VMRDCIL READ ANOTHER BLOCK @V305096 01699000
VMCALC AR R5,R2 ADDR OF VERSION NUMBER @V305096 01700000
MVC VM(TWO),ZERO(R5) MOVE VERS NO TO DIR ENTR@V305096 01701000
VMTRANS TR VM(TWO),VMTBL TRANSLATE TO HEX NUMBER @V305096 01702000
TM SWC,DISPLACE WAS DISP SEPCIFIED @V305096 01703000
BO VMONEPH YES @V305096 01704000
CLI VM,ZERO IS VERSION NO. ZERO @V305096 01705000
BE VMKLEER YES, INVALID VERSION NUMBER @V305096 01706000
CLC VM(TWO),VERSION VER. NO. GT CURRENT @V305096 01707000
BH VMKLEER INVALID LEVEL @V305096 01708000
VMONEPH NI SWA,HEXFF-NONAME RESET NO PH NAME IND. @V305096 01709000
NI SWC,HEXFF-SKIPNAME RESET INDICATOR @V305096 01710000
MVI THIRTY9(R7),DASH MOVE '-' TO VERSION @V305096 01711000
MVC FORTY(SIX,R7),THIRTY9(R7) PROPAGATE DASH @V305096 01712000
MVI FORTY2(R7),BLANK BLANK UNUSED FIELD @V305096 01713000
CLI VM,BLANK VERS AND MOD VALID? @V305096 01714000
BE VMPRINT NO @V305096 01715000
MVC FW3(ONE),VM VERSION LEV TO FULLWORD @V305096 01716000
BAL R9,FULL CONVERT IT TO ZONED @V305096 01717000
MVC THIRTY9(THREE,R7),ZND3 VERSION TO PRINT AREA @V305096 01718000
MVC FW3(ONE),VML MODULE LEV TO FULLWORD @V305096 01719000
BAL R9,FULL CONVERT IT TO ZONED @V305096 01720000
MVC FORTY3(THREE,R7),ZND3 MOD LEVEL TO PRINT @V305096 01721000
VMPRINT BAL R9,PRINT PRINT A LINE @V305096 01722000
TM SWC,ONEIND DISPLAYIND ONLY 1 PHASE @V305096 01723000
BO RESETCD YES, GO TO DSERV1 @V305096 01724000
B NEXTENTR GET NEXT ENTRY @V305096 01725000
SPACE 2 01726000
VMKLEER EX R0,VMBLANKR CLEAR INVALID VERSION NUMBERS@V305096 01727000
B VMONEPH GO TEST FOR MORE PHASES @V305096 01728000
SPACE 2 01729000
VM1BYTE LA R5,LIBAREA(R5) ADDR OF VERSION NUMBER @V305096 01730000
MVC VM(ONE),ZERO(R5) MOVE VERS NO. TO VM @V305096 01731000
OI SWC,LEVELNO SET 'NEED LEVEL NO. ONLY' IND@V305096 01732000
B VMRDCIL GO SETUP TO READ NEXT BLOCK @V305096 01733000
SPACE 2 01734000
VMGETLVL MVC VML(ONE),ZERO(R2) MOVE LEVEL NO. TO VM @V305096 01735000
XI SWC,LEVELNO RESET 'NEED LEVEL NO. ONLY' IND @V305096 01736000
B VMTRANS GO TRANSLATE SAME @V305096 01737000
SPACE 2 01738000
VMCOMP CLC ZERO(ZERO,R6),PNBUCKET COMP SPECIFIED PHASE @V305096 01739000
EJECT 01740000
*********************************************************************** 01741000
***** DIRECTORY READ ROUTINE * 01742000
*********************************************************************** 01743000
SPACE 1 01744000
TCEXCP MVC TCSEEKCC,TCCOUNT GET ADDR OF NEXT RECORD @V305096 01745000
LA R1,TCCCB ADDR OF CCB FOR EXCP @V305096 01746000
EXCP SVC 0 @V305066 01747000
SPACE 1 01748000
TM THREE(R1),EOC END OF CYLINDER POSTED @V305096 01749000
BCR EIGHT,R9 NO, EXIT TO CALLER @V305096 01750000
LH R4,TCSEEKCC UPDATE @V305096 01751000
LA R4,ONE(R4) CYLINDER @V305096 01752000
STH R4,TCCOUNT NUMBER @V305096 01753000
MVC TCCOUNT+THREE(TWO),TCHR SET HEAD & RECD TO 1'S@V305096 01754000
BR R9 EXIT TO CALLER @V305096 01755000
SPACE 1 01756000
***** CCB AND CCW'S FOR TRANSIENT AND CORE IMAGE DIRECTORY 01757000
DS 0D @V305096 01758000
TCCCB CCB SYSRES,TCCCW1 CCB FOR TD AND CD @V305096 01759000
TCCCW1 CCW SEEK,TCSEEKBB,CCSLI,SIX SEEK BBCCHH @V305096 01760000
TCCCW2 CCW SIDE,TCSEEKCC,CCSLI,FIVE SEARCH ID EQUAL @V305096 01761000
CCW TIC,TCCCW2,CCSLI,ONE TRANSFER IN CHANNEL @V305096 01762000
CCW READ,TCAREA,CCSLI,TWO56 READ DATA - 1024 BYTES @V305096 01763000
CCW RDCNT,TCCOUNT,SLI,FIVE READ COUNT OF NEXT REC @V305096 01764000
SPACE 1 01765000
TCSEEKBB DC X'0000' BB PORTION OF SEEK ADDR @V305096 01766000
TCSEEKCC DC X'0000000201' CCHHR OF SEEK ADDR @V305096 01767000
DS 0H @V305096 01768000
TCCOUNT DC X'0000000201' COUNT FIELD READIN AREA @V305096 01769000
DS 0H @V305096 01770000
TCAREA DS CL256 DIR READ-IN AREA @V305096 01771000
EJECT 01772000
***** CCB & CCW'S FOR READING DIRECTORY FOR VM 01773000
SPACE 1 01774000
DS 0D @V305096 01775000
VMDIRCCB CCB SYSRES,VMDIRCCW CCB FOR VM DIR READ @V305096 01776000
SPACE 1 01777000
VMDIRCCW CCW SEEK,TCSEEKBB,CCSLI,SIX SEEK BBCCHH @V305096 01778000
DIRCCW2 CCW SIDE,TCSEEKCC,CCSLI,FIVE SEARCH FOR RECORD 1 @V305096 01779000
CCW TIC,DIRCCW2,CCSLI,ONE TRANSFER IN CHANNEL @V305096 01780000
DIRCCW4 CCW SKEH,SRCHKEY,CCSLI,EIGHT SEARCH KEY HIGH OR EQ @V305096 01781000
TICCCW CCW TIC,DIRCCW4,CCSLI,ONE TRANSFER IN CHANNEL @V305096 01782000
CCW READ,TCAREA,CCSLI,TWO56 READ DATA-256 BYTES @V305096 01783000
CCW RDCNT,TCCOUNT,SLI,FIVE READ COUNT NEXT REC @V305096 01784000
SPACE 1 01785000
SRCHKEY EQU PNBUCKET KEY IS SPEC PHASE @V305096 01786000
SKEH EQU X'E9' SEARCH ON KEY H OR E @V305096 01787000
EJECT 01788000
***** CONSTANTS - COMMON TO THIS PHASE ONLY 01789000
SPACE 1 01790000
DS 0F ALIGN WORKAREA ON FULL WORD @V305096 01791000
TCHR DC X'0001' HEAD AND RECORD RESET CONSTANT @V305096 01792000
ENDDIR DC 8X'FF' END OF DIRECTORY @V305096 01793000
BLANK2 DC C' ' BLANKS IF INVALID VM @V305096 01794000
DOLLARA DC C'$$A' PREFIX TRANSIENT A PHASE NAME@V305096 01795000
DOLLARB DC C'$$B' PREFIX TRANSIENT B PHASE NAME@V305096 01796000
T1 DC C'TRANSIENT' HEADINGS FOR @V305096 01797000
T2 DC C'PRIVATE ' CD/TD @V305096 01798000
T3 DC C'CORE IMAGE ' SVA DISPLAY @V305096 01799000
T4 DC C'DIRECTORY' * @V305096 01800000
T6 DC C'C H R' * @V305096 01801000
T7 DC C'PAGE' * @V305096 01802000
DEC DC C'DEC' * @V305096 01803000
HEX DC C'HEX' * @V305096 01804000
SPACE 2 01805000
LINE2 DC C'PHASE DISK TXT BTS LST RLD ' @V305096 01806000
DC C'RLD ' @V305096 01807000
LINE21 DS 56C @V305065 01808000
LINE2A DC C'VER MOD ' @V305096 01809000
LINE2B DC C' LOAD ENTRY PART' @V305096 01810000
DC CL34' ' *** BLANK UNUSED FIELD @V305065 01811000
* *** THIS AREA MUST NOT 01812000
* *** BE REMOVED 01813000
LINE3 DC C'NAME ADDR RCDS TXT RCD RCDS ' @V305096 01814000
DC C'ITEMS ' @V305096 01815000
LINE31 DS 56C @V305065 01816000
LINE3A DC C'LEV LEV ' @V305096 01817000
LINE3B DC C' ADDR ADDR ADDR' @V305096 01818000
BLANKS DC CL34' ' *** BLANK UNUSED FIELD @V305065 01819000
* *** THIS AREA MUST NOT 01820000
* *** BE REMOVED 01821000
SPACE 1 01822000
TW DC C'SYSTEM ' TITLE WORK AREA@V305096 01823000
ZND DC CL6' ' @V305096 01824000
DW DC D'0' DOUBLE WORD WORK AREA @V305096 01825000
FW DC F'0' WORKAREA @V305096 01826000
SAVEPTR DS F SAVE AREA FOR R6 @V305096 01827000
HALFW1 DC H'1' CONSTANT OF 1 @V305096 01828000
VM DC X'4040' VERSION AND MOD LEVEL @V305096 01829000
TEMPENTR DC XL34'0' TEMP AREA FOR ENTRY @V305096 01830000
EJECT 01831000
***** TRANSLATE TABLES 01832000
SPACE 1 01833000
VMTBL DC X'000102030405060708090A0B0C0D0E0F' @V305096 01834000
DC X'101112131415161718191A1B1C1D1E1F' @V305096 01835000
DC X'202122232425262728292A2B2C2D2E2F' @V305096 01836000
DC X'303132333435363738393A3B3C3D3E3F' @V305096 01837000
DC X'404142434445464748494A4B4C4D4E4F' @V305096 01838000
DC X'505152535455565758595A5B5C5D5E5F' @V305096 01839000
DC X'606162636465666768696A6B6C6D6E6F' @V305096 01840000
DC X'707172737475767778797A7B7C7D7E7F' @V305096 01841000
DC X'808182838485868788898A8B8C8D8E8F' @V305096 01842000
DC X'909192939495969798999A9B9C9D9E9F' @V305096 01843000
DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' @V305096 01844000
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' @V305096 01845000
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' @V305096 01846000
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' @V305096 01847000
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' @V305096 01848000
DC X'00010203040506070809FAFBFCFDFEFF' @V305096 01849000
SPACE 3 01850000
TABLE DC C'0123456789ABCDEF' @V305096 01851000
EJECT 01852000
DS 0F ALIGN READIN AREA ON FW @V305096 01853000
SPACE 1 01854000
************************************************************** 01855000
* READ CIL BLOCK TO FIND VERSION AND MODIFICATION LEVEL * 01856000
************************************************************** 01857000
SPACE 1 01858000
VMEXCP LA R1,VMCCB ADDR OF CCB FOR EXCP @V305096 01859000
SVC 0 @V305066 01860000
SPACE 1 01861000
TM THREE(R1),EOC END OF CYLINDER POSTED @V305096 01862000
BCR CC0,R9 NO, EXIT TO CALLER @V305096 01863000
LH R1,VMSEEKCC UPDATE @V305096 01864000
LA R1,ONE(R1) CYLINDER @V305096 01865000
STH R1,VMSEEKCC NUMBER @V305096 01866000
XC VMSEEKH1(TWO),VMSEEKH1 SET HR TO ZEROS @V305096 01867000
B VMEXCP DO READ ON NEXT CYL @V305096 01868000
SPACE 1 01869000
**** CCW'S TO READ CORE IMAGE LIBRARY PHASES 01870000
VMCCW1 CCW SEEK,VMSEEKBB,CCSLI,SIX SEEK @V305096 01871000
VMCCW2 CCW SIDE,VMSEEKCC,CCSLI,FIVE SEARCH @V305096 01872000
CCW TIC,VMCCW2,CCSLI,ONE TIC @V305096 01873000
CCW READ,LIBAREA,CCSLI,ONE024 READ DATA @V305096 01874000
CCW RDCNT,VMSEEKCC,SLI,FIVE READ COUNT @V305096 01875000
SPACE 1 01876000
**** CCB TO READ CORE IMAGE LIBRARY PHASES 01877000
VMCCB CCB SYSRES,VMCCW1 @V305096 01878000
SPACE 1 01879000
**** SEEK ADDRESS BUCKET 01880000
VMSEEKBB DC X'0000' BB PORTION SEEK ADDRESS@V305096 01881000
VMSEEKCC DC X'000000000000' CCHHR PORTION SEEK ADDRESS @V305096 01882000
EJECT 01883000
LIBAREA DS 1024C START CD LIBRARY READIN AREA @V305096 01884000
SPACE 1 01885000
*********************************************************************** 01886000
***** EQUATES -- COMMON TO THIS PHASE ONLY * 01887000
*********************************************************************** 01888000
SPACE 1 01889000
TCCBSYM EQU TCCCB+7 LOC OF SYMBOLIC UNIT IN CCB @V305096 01890000
VMCBSYM EQU VMCCB+7 LOC OF SYMBOLIC UNIT IN CCB @V305096 01891000
VMDIRSYM EQU VMDIRCCB+7 SYM UNIT IN CCB @V305096 01892000
VMSEEKH1 EQU VMSEEKCC+3 USING TRACK NUMBER @V305096 01893000
VMSEEKH EQU VMSEEKCC+2 USING TRACK NUMBER @V305096 01894000
VMSEEKR EQU VMSEEKCC+4 USING RECORD NUMBER @V305096 01895000
VML EQU VM+1 LEVEL NUMBER @V305096 01896000
CC0 EQU 8 BRANCH ON CC=0 @V305096 01897000
SPACE 01898000
TWENTY8 EQU 28 DISP OF 28 @V305096 01899000
FIFTY4 EQU 54 DISP OF 54 @V305096 01900000
FIFTY9 EQU 59 DISP OF 59 @V305096 01901000
SEVENTY EQU 70 DISP OF 70 @V305096 01902000
SEVENTY3 EQU 73 DISP OF 73 @V305096 01903000
SEVENTY7 EQU 77 DISP OF 77 @V305096 01904000
SEVENTY9 EQU 79 DISP OF 79 @V305096 01905000
EIGHTY2 EQU 82 DISP OF 82 @V305096 01906000
EIGHTY8 EQU 88 DISP OF 88 @V305096 01907000
ONE02 EQU 102 DISP OF 102 @V305096 01908000
ONE11 EQU 111 DISP OF 111 @V305096 01909000
ONE28 EQU 128 PH NAME SEARCH FACTOR @V305096 01910000
FORTY1 EQU 41 DISP OF 41 @V305096 01911000
FORTY9 EQU 49 DISP OF 49 @V305096 01912000
TWO56 EQU 256 LENGTH OF 256 @V305096 01913000
ONE024 EQU 1024 LENGTH OF 1024 @V305096 01914000
DOLLAR EQU C'$' $ INDISCATOR @V305096 01915000
ZND1 EQU ZND+1 WORKFIELDS FOR @V305096 01916000
ZND2 EQU ZND+2 CONVERT AND UNPACK @V305096 01917000
ZND3 EQU ZND+3 * @V305096 01918000
ZND4 EQU ZND+4 * @V305096 01919000
FW2 EQU FW+2 * @V305096 01920000
FW3 EQU FW+3 * @V305096 01921000
TABLET EQU TABLE-240 @V305096 01922000
DSERV3 EQU * @V305065 01924000
USING *,R13 SPECIFY BASE REG TO ASSEMBLER @V305096 01925000
SPACE 2 01926000
******************************************************************** 01927000
***** FIND NO. OF ENTRIES WHICH CAN BE HANDLED IN ONE PASS 01928000
******************************************************************** 01929000
SPACE 1 01930000
LA R1,SIXTEEN INIT SD/RD ENTRY SIZE @V305096 01931000
L R3,SORTEND CALCULATE SIZE OF @V305096 01932000
S R3,SORTSTRT SORT AREA @V305096 01933000
SPACE 2 01934000
SR R2,R2 ZERO REG FOR DIVIDE @V305096 01935000
DR R2,R1 CALCULATE THE @V305096 01936000
SR R2,R2 NUMBER OF FULL @V305096 01937000
LH R1,ACTLINES PAGES THAT @V305096 01938000
AR R1,R1 THE ALLOCATED @V305096 01939000
DR R2,R1 SORT AREA @V305096 01940000
STH R2,REMAINS SAVE REMAINDER OF ENTRIES @V305096 01941000
MR R2,R1 NO. OF ENTRIES ON FULL PAGES @V305096 01942000
ST R3,ENTRIES SAVE FOR NEXT PHASE @V305096 01943000
MVC LINES,LINECTR INIT LINE COUNTER FOR PRINT P@V305096 01944000
OI SWA,HEADIND INDICATE HEADER PRINT @V305096 01945000
L R6,SORTSTRT GET SORT AREA START ADDR@V305096 01946000
LR R7,R3 NO. OF RECDS THAT CAN BE SORT@V305096 01947000
MVI RSRECDS1,TWENTY SET DEFAULT NO. OF RECORDS @V305065 01948000
EJECT 01949000
******************************************************************** 01950000
***** READ DIRECTORY ENTRIES AND 01951000
***** MOVE THEM INTO THE SORT AREA * 01952000
*********************************************************************** 01953000
SPACE 01954000
SR R5,R5 ZERO RECORD COUNTER @V305096 01955000
TM SWB,SYSRL DISPLAYING SYSTEM REL DIR. @V305096 01956000
BO RSMOVEDA YES, SET UP DISK ADDR @V305096 01957000
TM SWB,SYSSL DISPLAYING SYSTEM SOURCE DIR.@V305096 01958000
BO RSSOURCE YES @V305096 01959000
TM SWB,SYSPL DISPLAY SYSTEM PROC DIRECTORY@V305096 01960000
BO RSMOVEPL YES - @V305096 01961000
SPACE 1 01962000
MVI RSCBSYM,RLB SET SYSRLB LOGICAL UNIT IN CCB @V305096 01963000
TM SWB1,PRLB DISPLAYING PRIVATE REL DIR. @V305096 01964000
BZ RSSETSLB NO, HAS TO BE PRIVATE SOURCE @V305096 01965000
RSMOVEDA MVC RSSEEKCC,DISKRLD INIT SEEK BUCKET RLD ADDR @V305096 01966000
B RSFULL GO CHECK FOR RE-ENTRY @V305096 01967000
SPACE 3 01968000
RSMOVEPL EQU * @V305096 01969000
MVC RSSEEKCC,DISKPLD INIT SEEK BUCKET PLD ADDR @V305096 01970000
B RSFULL0 @V305096 01971000
SPACE 3 01972000
RSSETSLB MVI RSCBSYM,SLB SET SYSSLB LOGICAL UNIT IN CCB @V305096 01973000
RSSOURCE MVC RSSEEKCC,DISKSLD INIT SEEK BUCKET SRCE STMT DR@V305096 01974000
RSFULL0 EQU * @V305096 01975000
MVI RSRECDS1,TEN NO. OF RECORDS IN SOURCE BLOCK @V305096 01976000
RSFULL LH R2,RSRECDS NO. OF RECDS IN A BLOCK @V305096 01977000
SH R2,RSFIVE NO. OF RECORDS IN 1ST BLOCK @V305096 01978000
LA R3,RSAREA+EIGHTY ADDR OF 6TH RECD IN 1ST BLOCK@V305096 01979000
SPACE 1 01980000
TM SWC,FULLTBL SORT AREA PREVIOUSLY FILLED @V305096 01981000
BZ RSREAD NO @V305096 01982000
XI SWC,FULLTBL RESET FULL TABLE IND @V305096 01983000
MVC RSSEEKCC,DISKSAVE GET CURRENT DISK ADDRESS@V305096 01984000
LM R2,R3,SAVEREGS RESTORE POINTERS @V305096 01985000
RSREAD BAL R9,RSEXCP READ LAST BLOCK PROCESSED @V305096 01986000
B RSCOMP CONTINUE WHERE LEFT OFF @V305096 01987000
SPACE 2 01988000
RSREAD1 BAL R9,RSEXCP READ A DIRECTORY BLOCK @V305096 01989000
LH R2,RSRECDS 10/20 RECORDS PER BLOCK @V305096 01990000
LA R3,RSAREA ADDR OF READIN AREA @V305096 01991000
RSCOMP CLI ZERO(R3),ASTER THIS THE END OF THE DIR.@V305096 01992000
BE RSALLIN YES @V305096 01993000
CLC ZERO(SIXTEEN,R3),LASTREC IF ENC OF LAST PASS @V305096 01994000
BE RSNEXT SKIP THIS ENTRY @V305096 01995000
CLI ZERO(R3),BLANK IS THIS A DELETED ENTRY @V305096 01996000
BNE RSMOVE1 NO, MOVE TO SORT AREA @V305096 01997000
RSNEXT LA R3,SIXTEEN(R3) BUMP TO NEXT ENTRY IN BLOCK @V305096 01998000
BCT R2,RSCOMP CONTINUE UNTIL BLOCK IS DONE @V305096 01999000
MVC RSSEEKCC,RSCOUNT GET NEXT RECORD ADDR @V305096 02000000
B RSREAD1 GO TO READ SAME @V305096 02001000
SPACE 2 02002000
EJECT 02003000
SPACE 3 02004000
RSMOVE1 TM SWC,DUMYCNT ARE WE IN A DUMMY COUNT LOOP @V305096 02005000
BO RSADDR5 YES, DONT MOVE RECORD NOW @V305096 02006000
MVC LASTREC(SIXTEEN),ZERO(R3) SAVE REC FOR COMPARE @V305096 02007000
MVC ZERO(SIXTEEN,R6),ZERO(R3) MOVE REC TO SORT AREA @V305096 02008000
LA R6,SIXTEEN(R6) BUMP TO NEXT SRT STR POSITION@V305096 02009000
RSADDR5 LA R5,ONE(R5) INCREMENT RECORD COUNTER@V305096 02010000
CR R5,R7 IS SORT AREA FULL WITH RECORDS @V305096 02011000
BL RSNEXT NO, GET NEXT RECORD @V305096 02012000
TM SWC,DUMYCNT WENT THROUGH DUMMY COUNT LOOP@V305096 02013000
BZ RSSTM NO, START IT @V305096 02014000
XI SWC,DUMYCNT YES, RESET DUMMY LOOP CNT IND@V305096 02015000
OI SWC,FULLTBL SET FULL TABLE IND @V305096 02016000
LH R5,RECORDS SAVE TOTAL RECDS MOVED IN 1 PASS @V305096 02017000
B RSSORT GO START SORT @V305096 02018000
SPACE 2 02019000
RSSTM STM R2,R3,SAVEREGS SAVE REGS FOR RE-ENTRY @V305096 02020000
MVC SVECCHHR,RSSEEKCC SAVE CURRENT RECORD ADDR@V305096 02021000
MVC DISKSAVE,RSSEEKCC SAVE CURRENT RECORD ADDR@V305096 02022000
STH R5,RECORDS SAVE RECORDS MOVED THUS FAR @V305096 02023000
OI SWC,DUMYCNT SET IND TO FIND RECORDS LEFT @V305096 02024000
AH R7,REMAINS TOTAL RECDS THAT FIT IN 1 PASS @V305096 02025000
B RSNEXT START DUMMY COUNT LOOP @V305096 02026000
SPACE 2 02027000
RSALLIN TM SWC,DUMYCNT WERE WE IN A DUMMY COUNT LOOP@V305096 02028000
BZ RSSORT NO, SORT RECORDS @V305096 02029000
LH R5,RECORDS RESTORE RECORD COUNT @V305096 02030000
XI SWC,DUMYCNT RESET DUMMY COUNT LOOP IND @V305096 02031000
MVC RSSEEKCC,SVECCHHR RESTORE CURRENT RECORD ADDR @V305096 02032000
LM R2,R3,SAVEREGS RESTORE POINTERS @V305096 02033000
BAL R9,RSEXCP READ LAST BLOCK PROCESSED @V305096 02034000
B RSNEXT CONTINUE WHERE LEFT OFF @V305096 02035000
EJECT 02036000
*********************************************************************** 02037000
***** SORT ROUTINE FOR RELOCATABLE AND SOURCE STATEMENT DIRECTORY * 02038000
***** RECORDS * 02039000
***** REGISTER R5 CONTAINS NUMBER OF RECORDS TO BE SORTED * 02040000
*********************************************************************** 02041000
SPACE 2 02042000
RSSORT STH R5,RECORDS SAVE NO. OF RECDS FOR PRINT PH @V305096 02043000
LA R8,SIXTEEN GET RECORD LENGTH FACTOR@V305096 02044000
TM SWD,SORT DSPLYS SPECIFIED @V305096 02045000
BZ RSFETCH5 NO @V305096 02046000
CH R5,HW2 ARE THERE AT LEAST 2 RECORDS @V305096 02047000
BL RSFETCH5 NO, FETCH PRINT PHASE @V305096 02048000
RSSORT1 BCTR R5,R0 DUNK RECDS TO SORT ON EACH PASS @V305096 02049000
LTR R5,R5 ARE WE IN THE LAST SORT PASS @V305096 02050000
BZ RSFETCH5 YES @V305096 02051000
STH R5,RSRECNO SAVE COUNT FOR NEXT PASS@V305096 02052000
L R6,SORTSTRT GET ADDR OF 1ST RECORD TO SORT @V305096 02053000
LA R7,SIXTEEN(R6) ADDR OF 2ND RECORD @V305096 02054000
SPACE 1 02055000
RSSORT2 TM SWB,SYSRL IF SORTING SYST.REL @V305096 02056000
BO RSSORT3 LIBRARY ,BRANCH @V305096 02057000
TM SWB,SYSSL SORTING S. SOURCE DIR. @V305096 02058000
BO RSSORT2A YES @V305096 02059000
TM SWB,SYSPL SORT PROCEDURE LIBRARY @V305096 02060000
BO RSSORT3 YES. @V305096 02061000
TM SWB1,PRLB SORTING PRIVATE REL. DIR. @V305096 02062000
BO RSSORT3 YES @V305096 02063000
RSSORT2A CLC ZERO(NINE,R6),ZERO(R7) COMP. REC. PHASE NAMES @V305096 02064000
BL RSSORT5 BUMP TO NEXT RECORD IF LOW @V305096 02065000
B RSSORT4 SWAP THE TWO RECORDS AROUND @V305096 02066000
SPACE 1 02067000
RSSORT3 CLC ZERO(EIGHT,R6),ZERO(R7) COMPARE RCD PHASE NAMES @V305096 02068000
BL RSSORT5 BUMP TO NEXT RECORD IF LOW @V305096 02069000
SPACE 1 02070000
RSSORT4 MVC RSWORK(SIXTEEN),ZERO(R6) HIGH RECORD TO SAVAREA @V305096 02071000
MVC ZERO(SIXTEEN,R6),ZERO(R7) REPLACE WITH 2ND RECOR@V305096 02072000
MVC ZERO(SIXTEEN,R7),RSWORK REPLACE WITH 1ST RECD @V305096 02073000
OI SWC,RELOOP SET IND TO RELOOP COMPARE AGAIN @V305096 02074000
RSSORT5 AR R6,R8 BUMP COMPARE REGISTERS @V305096 02075000
AR R7,R8 TO NEXT RECORD @V305096 02076000
BCT R5,RSSORT2 CONTINUE UNTIL ALL RECDS CHECKED @V305096 02077000
SPACE 1 02078000
TM SWC,RELOOP NEED TO GO THROUGH LOOP AGAIN @V305096 02079000
BZ RSFETCH5 NO, SORT DONE @V305096 02080000
XI SWC,RELOOP RESET RELOOP COMPARE IND@V305096 02081000
LH R5,RSRECNO GET CURRENT NO. OF RECDS TO SORT @V305096 02082000
B RSSORT1 GO THROUGH LOOP AGAIN @V305096 02083000
SPACE 1 02084000
RSFETCH5 MVI PHASENO,FOUR INIT TO FETCH PRINT PHASE@V305096 02085000
TM SWB,SYSSL+SYSRL PROCEDURE DIRECTORY TO PRINT @V305096 02086000
BNZ FETCH NO - @V305096 02087000
MVI PHASENO,FIVE PROC DIRECTORY PRINTOUT @V305096 02088000
TM SWB,SYSPL PROCEDURE DISPLAY @V305096 02089000
BO FETCH YES - @V305096 02090000
MVI PHASENO,FOUR PRIVATE SSL OR RL @V305096 02091000
B FETCH FETCH SAME @V305096 02092000
EJECT 02093000
*********************************************************************** 02094000
***** DIRECTORY READ ROUTINE * 02095000
*********************************************************************** 02096000
SPACE 2 02097000
RSEXCP LA R1,RSCCB ADDR OF CCB FOR EXCP @V305096 02098000
SVC 0 @V305066 02099000
SPACE 1 02100000
TM RSCCB3,EOC END OF CYLINDER @V305096 02101000
BCR EIGHT,R9 NO, EXIT TO CALLER @V305096 02102000
LH R1,RSSEEKCC GET OLD CC OF SEEK ADDRESS @V305096 02103000
LA R1,ONE(R1) INCREMENT TO NEXT CYLINDER @V305096 02104000
STH R1,RSCOUNT STORE UPDATE CC OF SEEK ADDR.@V305096 02105000
MVC RSCOUNT3(TWO),RSHR SET HEAD AND RECD TO ONES @V305096 02106000
BR R9 EXIT TO CALLER @V305096 02107000
EJECT 02108000
*********************************************************************** 02109000
* CCB'S, CCW'S, DC'S AND DS'S * 02110000
*********************************************************************** 02111000
SPACE 2 02112000
***** CCB FOR RELOCATABLE AND SOURCE STATEMENT DIRECTORIES 02113000
SPACE 1 02114000
DS 0D @V305096 02115000
RSCCB CCB SYSRES,RSCCW1 CCB FOR RELOCATABLE/SOURCE DIR. @V305096 02116000
SPACE 3 02117000
***** CCW,S TO READ RELOCATABLE AND SOURCE STATEMENT DIRECTORIES 02118000
SPACE 1 02119000
RSCCW1 CCW SEEK,RSSEEKBB,CCSLI,SIX SEEK BBCCHH @V305096 02120000
RSCCW2 CCW SIDE,RSSEEKCC,CCSLI,FIVE SEARCH ID EQUAL @V305096 02121000
CCW TIC,RSCCW2,CCSLI,ONE TRANSFER IN CHANNEL@V305096 02122000
CCW READ,RSAREA,CCSLI,THREE20 READ DATA - 320 BYTES @V305096 02123000
CCW RDCNT,RSCOUNT,SLI,EIGHT READ COUNT OF NEXT RCD @V305096 02124000
SPACE 3 02125000
***** SEEK ADDRESS BUCKET 02126000
SPACE 1 02127000
RSSEEKBB DC X'0000' BB PORTION OF SEEK ADDR @V305096 02128000
RSSEEKCC DC XL5'00' CCHHR PORTION OF SEEK ADDR @V305096 02129000
SVECCHHR DC XL5'00' CCHHR SAVE AREA @V305096 02130000
SPACE 3 02131000
***** DISK COUNT READIN FIELD 02132000
SPACE 1 02133000
RSCOUNT DC XL8'00' COUNT FIELD READIN AREA @V305096 02134000
SPACE 3 02135000
***** RELOCATABLE AND SOURCE STATEMENT DIRECTORY READIN AREA 02136000
SPACE 1 02137000
RSAREA DS 320C' ' DIRECTORY READIN AREA @V305096 02138000
EJECT 02139000
***** CONSTANTS - COMMON TO THIS PHASE ONLY 02140000
SPACE 1 02141000
RSWORK DC 4F'0' DIRECTORY MOVE WORK AREA@V305096 02142000
RSRECNO DC H'0' RECORD COUNT SAVE AREA @V305096 02143000
RSHR DC X'0001' HEAD AND RECORD RESET CONSTANT @V305096 02144000
RSFIVE DC H'5' STATEMENT 1ST 5 RECORDS @V305096 02145000
RSRECDS DC H'20' RECORDS IN RELOCATABLE BLOCK @V305096 02146000
HW2 DC H'2' MIN. NUMBER TO BE SORTED@V305096 02147000
DS 0D DW ALIGNMENT @V305096 02148000
SPACE 3 02149000
*********************************************************************** 02150000
***** EQUATES -- COMMON TO THIS PHASE ONLY * 02151000
*********************************************************************** 02152000
SPACE 1 02153000
RSCCB3 EQU RSCCB+3 BYTE 2 OF TRANSFERRED INFO @V305096 02154000
RSCBSYM EQU RSCCB+7 LOC OF SYMBOLIC UNIT IN CCB @V305096 02155000
RSCOUNT3 EQU RSCOUNT+3 USING TRACK IN COUNT FIELD @V305096 02156000
RSRECDS1 EQU RSRECDS+1 LOCATION OF BLOCK BYTE @V305096 02157000
THREE20 EQU 320 @V305096 02158000
ASTER EQU C'*' END OF LIBRARY RECORD IN@V305096 02159000
DSERV4 EQU * @V305065 02161000
USING *,R13 SPECIFY BASE REG TO ASSEMBLER @V305096 02162000
SPACE 2 02163000
*********************************************************************** 02164000
***** INITIALIZE SORT AREA POINTER AND NUMBER OF RECORDS * 02165000
*********************************************************************** 02166000
SPACE 2 02167000
BGSERV4 L R5,SORTSTRT POINT TO OF SORT AREA @V305096 02168000
LH R8,RECORDS GET NUMBER OF SORTED RECORDS @V305096 02169000
SPACE 2 02170000
*********************************************************************** 02171000
***** FIND OUT WHAT DIRECTORY TO PRINT AND GO TO PRINT IT * 02172000
*********************************************************************** 02173000
SPACE 2 02174000
MVC RSTW(L'RST9),RST9 SET 'SYSTEM' @V305065 02175000
TM SWB,SYSRL ASK TO DISPLAY SYSTEM RD@V305096 02176000
BO REL YES @V305096 02177000
TM SWB,SYSSL ASK TO DISPLAY SYSTEM SD@V305096 02178000
BO SORA YES @V305096 02179000
TM SWB1,PRLB ASK TO DISPLAY PRIVATE RD @V305096 02180000
BZ SOR NO @V305096 02181000
EJECT 02182000
*********************************************************************** 02183000
***** ROUTINE TO PRINT RELOCATABLE DIRECTORY * 02184000
*********************************************************************** 02185000
SPACE 2 02186000
MVC RSTW(L'RST2),RST2 'PRIVATE' TO TITLE WORK AREA @V305096 02187000
REL MVC RSTW+EIGHT(L'RST1),RST1 'RELOCATABLE' @V305096 02188000
MVC RSTW+TWENTY(L'RST4),RST4 'DIRECTORY' @V305096 02189000
SPACE 2 02190000
MVC RSLINE21(SIX),RSLINE2 BLANK @V305096 02191000
MVC RSLINE31(SIX),RSLINE3 UNUSED @V305096 02192000
MVC RLINE2A1(THREE),RSLINE2A FIELD @V305096 02193000
MVC RLINE3A1(THREE),RSLINE3A @V305096 02194000
MVC RSLINE2M(L'RST8),RST8 'MODULE' TO HEADING LINE2 @V305096 02195000
SPACE 2 02196000
REL2 BAL R4,RSHEAD PRINT A HEADER IF NEEDED@V305096 02197000
LA R7,PRINTB GET ADDR OF PRINT AREA @V305096 02198000
ST R5,RSR5SAVE SAVE CURRENT SORT AREA POINTER @V305096 02199000
REL3 MVC TWELVE(EIGHT,R7),ZERO(R5) MODULE NAME TO PRTAREA@V305096 02200000
SPACE 2 02201000
* FORMAT RELOCATABLE DIRECTORY ENTRY TO LOOK LIKE SOURCE STATEMENT * 02202000
* DIRECTORY ENTRY FOR COMMON ROUTINE AND PRINT IT * 02203000
SPACE 2 02204000
MVC RSW(ONE),TEN(R5) C TO WORK AREA @V305096 02205000
MVC RSW+ONE(TWO),TWELVE(R5) HR TO WORK AREA @V305096 02206000
IC R4,ELEVEN(R5) OBTAIN C1 FIELD OF C2C1HR @V305096 02207000
SLL R4,SIX LOW ORDER 2 BITS HIGH ORDER @V305096 02208000
EX R4,CCINIT BRING IT TO CHR FORMAT @V305096 02209000
MVC RSW+THREE(TWO),EIGHT(R5) NO. OF RCDS TO WORKAREA@V305096 02210000
MVC RSW+FIVE(TWO),FOURTEEN(R5) VM TO WORK AREA @V305096 02211000
SPACE 02212000
BAL R10,RELSOR REMAINING BYTES TO PRINT AREA@V305096 02213000
TM SWD,SECOND DO WE NEED TO MOVE 2ND COLUMN@V305096 02214000
BO REL3 YES @V305096 02215000
BCT R8,REL2 PRINT UNTIL ALL RECORDS BE PRINT @V305096 02216000
TM SWC,FULLTBL FULL TABLE BIT ON @V305096 02217000
BO FETCH1A YES, RETURN TO ROOT PHASE @V305096 02218000
NI SWB,HEXFF-SYSRL AT LAST REC TURN OFF RL SW BIT @V305096 02219000
NI SWB1,HEXFF-PRLB ============== @V305096 02220000
FETCH1A MVI PHASENO,ONE INIT TO FETCH PHASE 1 @V305096 02221000
MVC RSTW,PRINTA CLEAR HEADER @V305065 02222000
B FETCH RETURN TO ROOT PHASE @V305096 02223000
SPACE 1 02224000
CCINIT OI RSW+ONE,HEX00 SET CORRECT CYL. NO. @V305096 02225000
EJECT 02226000
*********************************************************************** 02227000
***** ROUTINE TO PRINT SOURCE STATMENT DIRECTORY * 02228000
*********************************************************************** 02229000
SPACE 2 02230000
SOR MVC RSTW(L'RST2),RST2 'PRIVATE' TO TITLE WORK AREA @V305096 02231000
SORA MVC RSTW+EIGHT(L'RST3+L'RST4),RST3 @V305096 02232000
* 'SOURCE STATEMENT DIR' TO WORK 02233000
SPACE 02234000
SOR1 BAL R4,RSHEAD PRINT A HEADER IF NEEDED@V305096 02235000
LA R7,PRINTB REINITIALIZE PRINT AREA POINTER @V305096 02236000
ST R5,RSR5SAVE SAVE CURRENT SORT AREA POINTER @V305096 02237000
SOR2 MVC FIVE(ONE,R7),ZERO(R5) PREFIX CHAR TO PRINT AREA@V305096 02238000
MVC TWELVE(EIGHT,R7),ONE(R5) BOOK NAME TO PRT AREA @V305096 02239000
MVC RSW(SEVEN),NINE(R5) REMAINING BYTES TO WORK AREA@V305096 02240000
TM RSW+FIVE,CHGLEV CHANGE-LEVEL VERIFY BIT ON @V305096 02241000
BZ SOR3 NO @V305096 02242000
MVI FIFTY(R7),C CHANGE-LEVEL CHAR TO PRINT @V305096 02243000
SPACE 02244000
SOR3 BAL R10,RELSOR REMAINING TO PRINT AREA @V305096 02245000
TM SWD,SECOND DO WE NEED TO MOVE 2ND COLUMN@V305096 02246000
BO SOR2 YES @V305096 02247000
BCT R8,SOR1 PRINT UNTIL ALL RCDS BE PRINTED @V305096 02248000
TM SWC,FULLTBL FULL TABLE BIT ON @V305096 02249000
BO FETCH1A YES, RETURN TO ROOT PHASE @V305096 02250000
NI SWB,HEXFF-SYSSL AT LAST REC TURN OFF SL SW BIT @V305096 02251000
NI SWB1,HEXFF-PSLB ============ @V305096 02252000
B FETCH1A RETURN TO ROOT PHASE @V305096 02253000
EJECT 02254000
*********************************************************************** 02255000
* CONVERT RELOCATABLE AND SOURCE STATMENT DIRECTORIES TO PRINTABLE * 02256000
* FORM * 02257000
*********************************************************************** 02258000
SPACE 2 02259000
RELSOR MVC RSCHR(THREE),RSW CHR TO WORK AREA FOR COMMON RT.@V305096 02260000
BAL R3,RSCVTCHR CHR TO PRINT AREA @V305096 02261000
MVC RSFW2(TWO),RSW+THREE NO. OF RECORDS TO FUKKWORD @V305096 02262000
BALR R4,R2 CONVERT IT TO ZONED @V305096 02263000
MVC THIRTY3(FIVE,R7),RSZND1 NO. OF RECORDS TO PRINT @V305096 02264000
MVC RSFW3(ONE),RSW+FIVE VERSION LEVEL TO FULLWORD @V305096 02265000
NI RSFW3,HEXFF-CHGLEV TURN OFF CHG-LEV VERIFY BIT @V305096 02266000
BALR R4,R2 CONVERT IT TO ZONED @V305096 02267000
MVC FORTY(THREE,R7),RSZND3 VERSION LEV TO PRINT AREA@V305096 02268000
MVC RSFW3(ONE),RSW+SIX MOD LEVEL TO FULLWORD @V305096 02269000
BALR R4,R2 CONVERT IT TO ZONED @V305096 02270000
MVC FORTY5(THREE,R7),RSZND3 MOD LEVEL TO PRINT AREA@V305096 02271000
SPACE 02272000
TM SWD,SECOND ARE WE MOVING SECOND COLUMN @V305096 02273000
BO RELSORA YES @V305096 02274000
LTR R11,R11 DO WE NEED TWO COLUMNS @V305096 02275000
BM RELSORA NO @V305096 02276000
LA R4,SIXTEEN BUMP SORT AREA POINTER @V305096 02277000
MH R4,ACTLINES FOR SECOND @V305096 02278000
AR R5,R4 COLUMN @V305096 02279000
OI SWD,SECOND SET SECOND COLUMN INDICATOR @V305096 02280000
LA R7,SIXTY6(R7) BUMP PRINT AREA POINTER @V305096 02281000
BCTR R11,R0 DUNK NO. OF RECORDS BY ONE @V305096 02282000
LTR R11,R11 ANY RECORD LEFT TO BE PRINTED@V305096 02283000
BM RELSORA NO @V305096 02284000
BCTR R8,R0 DUNK NO. OF RECORDS BY ONE @V305096 02285000
BR R10 RETURN TO CALLER @V305096 02286000
SPACE 2 02287000
RELSORA NI SWD,HEXFF-SECOND RESET SECOND COLUMN INDICATOR@V305096 02288000
BAL R9,PRINT PRINT A LINE @V305096 02289000
TM SWA,HEADIND END OF PAGE @V305096 02290000
BO RSBUMP YES @V305096 02291000
L R5,RSR5SAVE RESTORE SORT AREA POINTER @V305096 02292000
RSBUMP LA R5,SIXTEEN(R5) BUMP SORT AREA POINTER @V305096 02293000
BR R10 RETURN TO CALLER @V305096 02294000
EJECT 02295000
*********************************************************************** 02296000
* SUBROUTINE TO CONVERT CHR FROM BINARY TO ZONED AND MOVE IT INTO * 02297000
* PRINT AREA * 02298000
*********************************************************************** 02299000
SPACE 2 02300000
RSCVTCHR LA R2,RSFULLA GET ADDR OF FULL ROUTINE@V305096 02301000
SR R4,R4 CLEAR WORK REGISTER @V305096 02302000
IC R4,RSCHR+ONE INSERT H BYTE OF CHR FIELD @V305096 02303000
SLL R4,TWO OBTAIN TWO HIGH ORDER BITS @V305096 02304000
IC R4,RSCHR OBTAIN C BYTE OF CHR FIELD @V305096 02305000
STH R4,RSFW2 PASS CYL. NO. TO SUBROUTINE @V305096 02306000
BALR R4,R2 CONVERT C TO ZONED @V305096 02307000
MVC TWENTY2(THREE,R7),RSZND3 C TO PRINT AREA @V305096 02308000
MVC RSFW3(ONE),RSCHR+ONE PASS H TO SUBROUTINE @V305096 02309000
NI RSFW3,HEX3F CLEAR HIGH ORDER BITS H FIELD@V305096 02310000
BALR R4,R2 CONVERT H TO ZONED @V305096 02311000
MVC TWENTY6(TWO,R7),RSZND4 H TO PRINT AREA @V305096 02312000
MVC RSFW3(ONE),RSCHR+TWO PASS R TO SUBROUTINE @V305096 02313000
BALR R4,R2 CONVERT R TO ZONED @V305096 02314000
MVC TWENTY9(TWO,R7),RSZND4 R TO PRINT AREA @V305096 02315000
BR R3 RETURN TO CALLER @V305096 02316000
SPACE 2 02317000
*********************************************************************** 02318000
* SUBROUTINE TO CONVERT FULLWORD BINARY TO 6 DIGITS ZONED IN 'RSZND' * 02319000
*********************************************************************** 02320000
SPACE 2 02321000
RSFULLA L R1,RSFW PASS FULLWORD TO WORK AREA @V305096 02322000
CVD R1,RSDW CONVERT IT TO PACKED FORM @V305096 02323000
UNPK RSZND(SIX),RSDW+FOUR(FOUR) CONVERT IT TO ZONED@V305096 02324000
OI RSZND+FIVE,HEXF0 MODIFY LAST BYTE TO PRINTABLE@V305096 02325000
XC RSFW(FOUR),RSFW CLEAR FULLWORD @V305096 02326000
BR R4 RETURN TO CALLER @V305096 02327000
EJECT 02328000
*********************************************************************** 02329000
* SUBROUTINE TO PRINT HEADERS FOR DIRECTORY PRINTOUTS * 02330000
*********************************************************************** 02331000
SPACE 2 02332000
RSHEAD TM SWA,HEADIND NEED A HEADER FOR NEW PAGE @V305096 02333000
BCR EIGHT,R4 NO @V305096 02334000
LA R2,PRINT GET ADDR OF PRINT REOUTINE @V305096 02335000
LA R7,PRINTB GET ADDR OF PRINT AREA @V305096 02336000
LR R11,R8 DO WE NEED @V305096 02337000
SH R11,ACTLINES TO PRINT @V305096 02338000
TM CMSSWT,TYPOPT WAS TERM SPECIFIED? @V305065 02339000
BZ RSHEAD2 BRANCH IF NOT @V305065 02340000
LNR R11,R4 SET R11 NEGATIVE @V305065 02341000
RSHEAD2 EQU * @V305065 02342000
LTR R11,R11 TWO HEADERS @V305096 02343000
BNP RSONE NO @V305096 02344000
TM CMSSWT,DSKOPT WAS DISK SPECIFIED? @V305065 02345000
BZ RSHEAD1 BRANCH IF NOT @V305065 02346000
LR R11,R8 GET NUMBER OF RECORDS @V305065 02347000
LA R11,ONE(,R11) ROUND OFF TO EVEN NO. @V305065 02348000
SRL R11,ONE DIVIDE BY TWO @V305065 02349000
STH R11,ACTLINES SAVE HALF OF NO. OF RECS. @V305065 02350000
LR R11,R8 GET NUMBER OF RECORDS @V305065 02351000
SRL R11,ONE AND DIVIDE BY TWO FOR 2ND COL@V305065 02352000
RSHEAD1 EQU * @V305065 02353000
MVC FORTY3(THIRTY4,R7),RSTW TITLE TO WORK AREA @V305096 02354000
RSDATE COMRG GET COMMUNICATION REGION@V305096 02355000
MVC EIGHTY1(EIGHT,R7),ZERO(R1) DATE TO PRINT AREA @V305096 02356000
TM SWD,SORT WAS 'DSPLYS' SPECIFIED @V305096 02357000
BZ RSZEROR1 NO @V305096 02358000
MVC NINETY6(FOUR,R7),RST5 MOVE 'PASS' TO PRINT AREA@V305096 02359000
MVC ONE03(ONE,R7),PASSCTR MOVE PASS NO. TO PRINT @V305096 02360000
RSZEROR1 SR R1,R1 ZERO REGISTER @V305096 02361000
IC R1,PAGECTR GET CURRENT PAGE NUMBER @V305096 02362000
CVD R1,RSDW CONVERT PAGE NO. TO DECIMAL @V305096 02363000
LA R1,ONE(R1) BUMP PAGE NO. BY 1 @V305096 02364000
STC R1,PAGECTR SAVE NEW PAGE NUMBER @V305096 02365000
UNPK ONE18(TWO,R7),RSDW+SIX(TWO) CONVERT PAGE NO. @V305096 02366000
OI ONE19(R7),HEXF0 TO PRINTABLE CHAR @V305096 02367000
CLI ONE18(R7),HEXF0 PAGE NO. LEADING ZERO @V305096 02368000
BNE MVCRST7 NO @V305096 02369000
MVI ONE18(R7),BLANK SUPPRESS LEADING ZERO @V305096 02370000
MVCRST7 MVC ONE11(FOUR,R7),RST7 MOVE 'PAGE' TO PRINT AREA@V305096 02371000
BALR R9,R2 PRINT TITLE,DATE,PAGE AND PASS @V305096 02372000
BALR R9,R2 SKIP ONE LINE @V305096 02373000
EJECT 02374000
MVC TWO(FIFTY2,R7),RSLINE2 HEADING LINE2 TO PRINT @V305096 02375000
LTR R11,R11 DO WE NEED TWO HEADERS @V305096 02376000
BNP PRSLINE2 NO @V305096 02377000
MVC SIXTY8(FIFTY2,R7),RSLINE2 HEADING LINE2 TO PRINT@V305096 02378000
PRSLINE2 BALR R9,R2 PRINT HEADING LINE2 @V305096 02379000
MVC TWO(FIFTY2,R7),RSLINE3 HEADING LINE3 TO PRTAREA@V305096 02380000
LTR R11,R11 DO WE NEED TWO HEADERS @V305096 02381000
BNP PRSLINE3 NO @V305096 02382000
MVC SIXTY8(FIFTY2,R7),RSLINE3 HEADING LINE3 TO PRT@V305096 02383000
PRSLINE3 BALR R9,R2 PRINT HEADING LINE3 @V305096 02384000
BALR R9,R2 SKIP A LINE @V305096 02385000
RSDASH MVI TWENTY2(R7),DASH DASH TO PRINT AREA @V305096 02386000
MVC TWENTY3(TWENTY5,R7),TWENTY2(R7) PROPAGATE DASH@V305096 02387000
MVC THIRTY4(THREE,R7),RSDEC 'DEC' TO PRINT AREA @V305096 02388000
TM SWD,SECOND ARE WE MOVING SECOND COL. @V305096 02389000
BO RSLINE4 YES @V305096 02390000
LTR R11,R11 DO WE NEED TWO HEADERS @V305096 02391000
BNP RSLINE4 NO @V305096 02392000
OI SWD,SECOND SET SECOND COLUMN IND. @V305096 02393000
LA R7,SIXTY6(R7) BUMP PRINT AREA POINTER @V305096 02394000
B RSDASH GO TO MOVE 2ND COLUMN @V305096 02395000
RSLINE4 BALR R9,R2 PRINT HEADING LINE4 @V305096 02396000
BALR R9,R2 SKIP ONE LINE @V305096 02397000
LA R7,PRINTB REINITIALIZE PRINT AREA POINTER @V305096 02398000
MVC TWENTY3(L'RST6,R7),RST6 'CHR' TO PRINT AREA @V305096 02399000
TM SWD,SECOND DO WE NEED TWO HEADERS @V305096 02400000
BZ RSLINE5 NO @V305096 02401000
MVC EIGHTY9(L'RST6,R7),RST6 'CHR' TO PRINT AREA @V305096 02402000
RSLINE5 BALR R9,R2 PRINT CHR LINE @V305096 02403000
NI SWD,HEXFF-SECOND RESET SECOND COLUMN IND @V305096 02404000
BR R4 RETURN TO CALLER @V305096 02405000
SPACE 2 02406000
RSONE MVC ZERO(THIRTY4,R7),RSTW TITLE TO PRINT AREA= @V305096 02407000
B RSDATE GO TO MOVE DATE @V305096 02408000
EJECT 02409000
*********************************************************************** 02410000
* DC'S * 02411000
*********************************************************************** 02412000
SPACE 2 02413000
SPACE 2 02415000
RST1 DC C'RELOCATABLE' @V305096 02416000
RST2 DC C'PRIVATE ' @V305096 02417000
RST3 DC C'SOURCE STATEMENT ' @V305096 02418000
RST4 DC C'DIRECTORY' @V305096 02419000
RST5 DC C'PASS' @V305096 02420000
RST6 DC C'C H R' @V305096 02421000
RST7 DC C'PAGE' @V305096 02422000
RST8 DC C'MODULE' @V305096 02423000
RST9 DC C'SYSTEM' @V305065 02424000
RSDEC DC C'DEC' @V305096 02425000
SPACE 2 02426000
RSLINE2 DC C' SUBLIB BOOK DISK NO. VER MOD ' 02427000
RSLINE2A DC C' LEV' @V305096 02428000
RSLINE3 DC C' PREFIX NAME ADDR RCDS LEV LEV ' 02429000
RSLINE3A DC C' CHK' @V305096 02430000
SPACE 2 02431000
***** WORK AREA 02432000
SPACE 02433000
RSTW DC C'SYSTEM ' TITLE WKAR@V305096 02434000
RSCHR DC CL3' ' CONVERT DISK ADDR WORK AREA @V305096 02435000
RSZND DC CL6' ' CONVERT DISK ADDR WORK AREA @V305096 02436000
RSW DC CL7' ' FORMAT DIR ENTRY WORK AREA @V305096 02437000
RSFW DC F'0' FULLWORD WORK AREA @V305096 02438000
RSDW DC D'0' DOUBLE WORD WORK AREA @V305096 02439000
RSR5SAVE DC F'0' CURRENT SORT AREA PTR SAVE @V305096 02440000
EJECT 02441000
*********************************************************************** 02442000
* EQUATES * 02443000
*********************************************************************** 02444000
SPACE 2 02445000
***** CONSTANT EQUATES 02446000
SPACE 2 02447000
SIXTY8 EQU 68 @V305096 02448000
SEVEN68 EQU 768 INCREMENT FACTOR FOR SECOND COL. @V305096 02449000
SPACE 02450000
CHGLEV EQU X'80' @V305096 02451000
C EQU C'C' @V305096 02452000
SPACE 2 02453000
***** ADDRESS EQUATES 02454000
SPACE 2 02455000
RSLINE21 EQU RSLINE2+1 @V305096 02456000
RSLINE31 EQU RSLINE3+1 @V305096 02457000
RLINE2A1 EQU RSLINE2A+1 @V305096 02458000
RLINE3A1 EQU RSLINE3A+1 @V305096 02459000
RSZND1 EQU RSZND+1 @V305096 02460000
RSZND3 EQU RSZND+3 @V305096 02461000
RSZND4 EQU RSZND+4 @V305096 02462000
RSFW2 EQU RSFW+2 @V305096 02463000
RSFW3 EQU RSFW+3 @V305096 02464000
RSLINE2M EQU RSLINE2+11 @V305096 02465000
DSERV5 EQU * @V305065 02467000
USING *,R13 SPECIFY BASE REG TO ASSEMBLER @V305096 02468000
SPACE 2 02469000
********************************************************************* 02470000
***** INITIALIZE SORT AREA POINTER AND NUMBER OF RECORDS 02471000
********************************************************************* 02472000
SPACE 2 02473000
BGSERV5 L R5,SORTSTRT POINT TO BEGINNING OF SO@V305096 02474000
LH R8,RECORDS GET NUMBER OF SORTED RECORDS @V305096 02475000
SPACE 2 02476000
******************************************************************* 02477000
**** TEST DIRECTORY TO PRINT 02478000
******************************************************************* 02479000
SPACE 2 02480000
TM SWB,SYSPL SYSTEM PROCEDURE DIRECTORY @V305096 02481000
BNO FTCH7A NO - @V305096 02482000
EJECT 02483000
******************************************************************* 02484000
***** MAIN ROUTINE 02485000
******************************************************************* 02486000
SPACE 2 02487000
DS702 EQU * @V305096 02488000
BAL R4,PHEAD PRINT HEADER IF NEEDED @V305096 02489000
LA R7,PRINTB GET ADDR OF PRINTAREA @V305096 02490000
ST R5,PR5SAVE SAVE CURRENT SORT AREA VALUE @V305096 02491000
DS704 EQU * * @V305096 02492000
MVC TEN(EIGHT,R7),0(R5) PROC NAME TO PRINT AREA @V305096 02493000
MVC PSAV(EIGHT),EIGHT(R5) @V305096 02494000
BAL R10,PFORM FORMAT PROCEDURE DIRECTORY @V305096-02495000
ENTRY @V305096 02496000
TM SWD,SECOND DO WE NEED TO MOVE 2ND COL @V305096 02497000
BO DS704 YES - @V305096 02498000
BCT R8,DS702 ANY ENTRY IN SORT AREA @V305096 02499000
SPACE 2 02500000
TM SWC,FULLTBL FULL TABLE BIT POSTED @V305096 02501000
BO FTCH7A YES - @V305096 02502000
NI SWB,HEXFF-SYSPL RESET SYSPL FLAG @V305096 02503000
* DIRECTORY OUTPUT COMPLETE 02504000
FTCH7A MVI PHASENO,ONE INIT TO FETCH PHASE @V305096 02505000
B FETCH RETURN TO ROOT @V305096 02506000
SPACE 2 02507000
******************************************************************* 02508000
EJECT 02509000
******************************************************************* 02510000
***** PFORM SUBROUTINE - 02511000
***** FORMATS THE PROCEDURE DIRECTORY ENTRIES 02512000
******************************************************************* 02513000
SPACE 2 02514000
PFORM DS 0H ENTRY POINT @V305096 02515000
TM PSAV+DFLAG,PDATA PROCEDURE WITH SYSIPT DATA @V305096 02516000
BZ PF02 NO - @V305096 02517000
MVI TWENTY2(R7),C'X' POST X INTO PRINT ARAE @V305096 02518000
PF02 EQU * @V305096 02519000
MVC PCHR(THREE),PSAV+TWO CHR TO WORK AREA @V305096 02520000
BAL R3,PCVTCHR CONVERT CHR AND POST IT @V305096 02521000
MVC PFW2(TWO),PSAV NO. OF BLOCKS @V305096 02522000
BALR R4,R2 CONVERT IT @V305096 02523000
MVC FORTY2(FIVE,R7),PZND1 NO OF BLOCKS TO PRINT AREA@V305096 02524000
MVC PFW3(ONE),PSAV+SIX VERSION LEVEL TO WORKAREA @V305096 02525000
BALR R4,R2 CONVERT IT @V305096 02526000
MVC FIFTY(THREE,R7),PZND3 VERSION LEVEL TO PRINTAREA@V305096 02527000
MVC PFW3(ONE),PSAV+SEVEN MOD. LEVEL TO WORK AREA @V305096 02528000
BALR R4,R2 CONVERT IT @V305096 02529000
MVC FIFTY5(THREE,R7),PZND3 MOD. LEVEL TO PRINT AREA@V305096 02530000
SPACE 2 02531000
TM SWD,SECOND ARE WE MOVING SECOND COLUMN @V305096 02532000
BO PF04 YES @V305096 02533000
LTR R11,R11 DO WE NEED TWO COLUMNS @V305096 02534000
BM PF04 NO @V305096 02535000
LA R4,SIXTEEN BUMP SORT @V305096 02536000
MH R4,ACTLINES AREA @V305096 02537000
AR R5,R4 POINTER @V305096 02538000
OI SWD,SECOND SET SECOND COLUMN INDICATOR @V305096 02539000
LA R7,SIXTY(R7) BUMP PRINT AREA POINTER @V305096 02540000
BCTR R11,R0 DUNK NO. OF RECORDS BY ONE @V305096 02541000
LTR R11,R11 ANY RECORD LEFT TO BE PRINTED @V305096 02542000
BM PF04 NO @V305096 02543000
BCTR R8,R0 DUNK NO. OF RECORDS BY ONE @V305096 02544000
BR R10 RETURN TO CALLER @V305096 02545000
SPACE 2 02546000
PF04 NI SWD,HEXFF-SECOND RESET SECOND COLUMN INDICATOR@V305096 02547000
BAL R9,PRINT PRINT A LINE @V305096 02548000
TM SWA,HEADIND END OF PAGE @V305096 02549000
BO PF05 YES @V305096 02550000
L R5,PR5SAVE RESTORE SORT AREA POINTER@V305096 02551000
PF05 LA R5,SIXTEEN(R5) BUMP SORT AREA POINTER @V305096 02552000
BR R10 RETURN TO CALLER @V305096 02553000
SPACE 2 02554000
******************************************************************** 02555000
EJECT 02556000
***************************************************************** 02557000
***** SUBROUTINE FOR CONVERTING CHR FROM BINARY TO ZONED DECIMAL 02558000
***** THE RESULT IS MOVED INTO THE PRINTAREA 02559000
***************************************************************** 02560000
SPACE 2 02561000
PCVTCHR DS 0H ENTRY POINT @V305096 02562000
LA R2,PFULLA GET ADDRESS OF FULL ROUTINE @V305096 02563000
SR R4,R4 @V305096 02564000
IC R4,PCHR+ONE GET H BYTE OF CHR FIELD @V305096 02565000
SLL R4,TWO SEPARATE HIGH ORDER BITS@V305096 02566000
IC R4,PCHR GET C BYTE OF CHR FIELD @V305096 02567000
STH R4,PFW2 PASS CYLINDER NO. TO SUBR. @V305096 02568000
BALR R4,R2 CONVERT C TO ZONED @V305096 02569000
MVC TWENTY8(THREE,R7),PZND3 POST C INTO PRINT AREA @V305096 02570000
MVC PFW3(ONE),PCHR+ONE PASS H TO SUBROUTINE @V305096 02571000
NI PFW3,HEX3F CLEAR HIGH ORDER BITS @V305096 02572000
BALR R4,R2 CONVERT H TO ZONED @V305096 02573000
MVC THIRTY3(TWO,R7),PZND4 H TO PRINT AREA @V305096 02574000
MVC PFW3(ONE),PCHR+TWO PASS R TO SUBROUTINE @V305096 02575000
BALR R4,R2 CONVERT R TO ZONED @V305096 02576000
MVC THIRTY7(TWO,R7),PZND4 POST R TO PRINT AREA @V305096 02577000
BR R3 RETURN @V305096 02578000
SPACE 3 02579000
***************************************************************** 02580000
***** SUBROUTINE TO CONVERT FULLWORD BINARY TO 6 DIGITS ZONED 02581000
***** IN 'PZND'. 02582000
******************************************************************* 02583000
SPACE 2 02584000
PFULLA L R1,PFW PASS FULLWORD TO WORK AREA @V305096 02585000
CVD R1,PDW CONVERT IT TO PACKED FORM @V305096 02586000
UNPK PZND(SIX),PDW+FOUR(FOUR) CONVERT IT TO ZONED @V305096 02587000
OI PZND+FIVE,HEXF0 MODIFY LAST BYTE TO PRINTABLE@V305096 02588000
XC PFW(FOUR),PFW CLEAR FULLWORD @V305096 02589000
BR R4 RETURN TO CALLER @V305096 02590000
SPACE 2 02591000
******************************************************************** 02592000
EJECT 02593000
******************************************************************** 02594000
***** SUBROUTINE TO PRINT HEADERS FOR DIRECTORY PRINTOUTS 02595000
******************************************************************** 02596000
SPACE 2 02597000
PHEAD DS 0H ENTRY POINT @V305096 02598000
TM SWA,HEADIND HEADER REQUIRED @V305096 02599000
BCR EIGHT,R4 NO - RETURN TO CALLER @V305096 02600000
LA R2,PRINT GET ADDRESS OF PRINT ROUT @V305096 02601000
LA R7,PRINTB GET ADDRESS OF PRINT AREA @V305096 02602000
LR R11,R8 ) @V305096 02603000
TM CMSSWT,TYPOPT WAS TERM SPECIFIED? @V305065 02604000
BZ PHEAD1 BRANCH IF NOT @V305065 02605000
LNR R11,R4 SET R11 NEGATIVE @V305065 02606000
B PH100 @V305065 02607000
PHEAD1 EQU * @V305065 02608000
SH R11,ACTLINES ) TWO HEADERS REQUIRED @V305096 02609000
BNP PH100 ) NO - @V305096 02610000
TM CMSSWT,DSKOPT WAS DISK SPECIFIED? @V305065 02611000
BZ PHEAD2 BRANCH IF NOT @V305065 02612000
LR R11,R8 GET NUM OF RECORDS @V305065 02613000
LA R11,ONE(,R11) ROUND OFF TO EVEN NUMBER @V305065 02614000
SRL R11,ONE DIVIDE BY TWO @V305065 02615000
STH R11,ACTLINES SET FOR PRINTOUT @V305065 02616000
LR R11,R8 GET NUM OF RECORDS @V305065 02617000
SRL R11,ONE AND DIVIDE BY TWO FOR 2ND COL@V305065 02618000
PHEAD2 EQU * @V305065 02619000
MVC FORTY3(THIRTY4,R7),PTW TITLE TO PRINT AREA @V305096 02620000
PH010 EQU * @V305096 02621000
COMRG @V305096 02622000
MVC EIGHTY1(EIGHT,R7),0(R1) DATE TO PRINT AREA @V305096 02623000
TM SWD,SORT WAS 'DSPLYS' SPECIFIED @V305096 02624000
BZ PH020 NO - @V305096 02625000
MVC NINETY6(FOUR,R7),PT5 MOVE 'PASS' TO PRINTAREA@V305096 02626000
MVC ONE03(ONE,R7),PASSCTR MOVE PASS NO. TO PRINT @V305096 02627000
PH020 EQU * @V305096 02628000
SR R1,R1 @V305096 02629000
IC R1,PAGECTR GET CURRENT PAGE NUMBER @V305096 02630000
CVD R1,PDW CONVERT PAGE NUMBER TO DEC @V305096 02631000
LA R1,ONE(R1) UPDATE @V305096 02632000
STC R1,PAGECTR SAVE NEW VALUE @V305096 02633000
UNPK ONE18(TWO,R7),PDW+SIX(TWO) CONVERT PAGE NO. TO @V305096-02634000
PRINTABLE FORMAT @V305096 02635000
OI ONE19(R7),X'F0' =============== @V305096 02636000
SPACE 1 02637000
CLI ONE18(R7),X'F0' LEADING ZERO @V305096 02638000
BNE PH030 NO - @V305096 02639000
MVI ONE18(R7),BLANK SUPPRESS LEADING ZERO @V305096 02640000
PH030 EQU * @V305096 02641000
MVC ONE11(FOUR,R7),PT7 MOVE 'PAGE' INTO PRINT AREA @V305096 02642000
BALR R9,R2 PRINT HEADER LINE 1 @V305096 02643000
BALR R9,R2 SKIP ONE LINE @V305096 02644000
MVC NINE(L'PLINE2,R7),PLINE2 HEADER LINE2 TO PRINT @V305096 02645000
LTR R11,R11 TWO COLUMNS REQUIRED @V305096 02646000
BNP PH040 NO - @V305096 02647000
MVC SIXTY9(L'PLINE2,R7),PLINE2 HDR LINE2 TO PRT AREA@V305096 02648000
PH040 EQU * @V305096 02649000
BALR R9,R2 PRINT HEADING LINE 2 @V305096 02650000
MVC NINE(L'PLINE3,R7),PLINE3 HEADER LINE3 TO PRINT @V305096 02651000
LTR R11,R11 TWO COLUMNS REQUIRED @V305096 02652000
BNP PH050 NO - @V305096 02653000
MVC SIXTY9(L'PLINE3,R7),PLINE3 HEADER LINE3 TO PRINT@V305096 02654000
PH050 EQU * @V305096 02655000
BALR R9,R2 PRINT HEADING LINE 3 @V305096 02656000
BALR R9,R2 SKIP ONE LINE @V305096 02657000
SPACE 2 02658000
PH060 EQU * @V305096 02659000
MVI TWENTY1(R7),DASH ) BUILD @V305096 02660000
MVC TWENTY2(THIRTY5,R7),TWENTY1(R7) @V305096 02661000
MVC THIRTY9(THREE,R7),PDEC ) DASH LINE @V305096 02662000
TM SWD,SECOND ARE WE MOVING SECOND COL. @V305096 02663000
BO PH070 YES - @V305096 02664000
LTR R11,R11 TWO HEADERS REQUIRED @V305096 02665000
BNP PH070 NO - @V305096 02666000
OI SWD,SECOND SET SECOND COL. FLAG @V305096 02667000
LA R7,SIXTY(R7) UPDATE PRINT AREA POINTER @V305096 02668000
B PH060 @V305096 02669000
SPACE 2 02670000
PH070 EQU * @V305096 02671000
BALR R9,R2 PRINT HEADING LINE 4 @V305096 02672000
BALR R9,R2 SKIP 1 LINE @V305096 02673000
LA R7,PRINTB REINITIALIZE PRINT AREA POINT@V305096 02674000
MVC TWENTY8(L'PT6,R7),PT6 'CHR' TO PRINT AREA @V305096 02675000
TM SWD,SECOND TWO COLUMNS REQUIRED @V305096 02676000
BZ PH080 NO - @V305096 02677000
MVC EIGHTY8(L'PT6,R7),PT6 'CHR' TO PRINT AREA @V305096 02678000
PH080 EQU * @V305096 02679000
BALR R9,R2 PRINT LINE @V305096 02680000
NI SWD,HEXFF-SECOND RESET SECOND COLUMN FLAG@V305096 02681000
BR R4 RETURN TO CALLER @V305096 02682000
SPACE 3 02683000
PH100 EQU * @V305096 02684000
MVC ZERO(THIRTY4,R7),PTW TITLE TO PRINT AREA @V305096 02685000
B PH010 @V305096 02686000
SPACE 2 02687000
******************************************************************** 02688000
EJECT 02689000
******************************************************************* 02690000
***** CONSTANTS AND SAVE AREAS 02691000
******************************************************************* 02692000
SPACE 2 02693000
PDW DC D'0' @V305096 02694000
PFW DC F'0' @V305096 02695000
PR5SAVE DC F'0' @V305096 02696000
SPACE 3 02697000
PTW DC C' PROCEDURE DIRECTORY' @V305096 02698000
DC CL10' ' @V305096 02699000
PCHR DC CL3' ' @V305096 02700000
PZND DC CL6' ' @V305096 02701000
PSAV DC XL8'0' @V305096 02702000
PDEC DC C'DEC' @V305096 02703000
PT5 DC C'PASS' @V305096 02704000
PT6 DC C' C H R' @V305096 02705000
PT7 DC C'PAGE' @V305096 02706000
SPACE 3 02707000
PLINE2 DC C'PROCEDURE DATA DISK NO. VER MOD ' 02708000
PLINE3 DC C' NAME FLAG ADDR RECDS LEV LEV ' 02709000
ENDDSERV EQU * @V305065 02710000
EJECT 02711000
******************************************************************* 02712000
***** EQUATES 02713000
******************************************************************* 02714000
SPACE 2 02715000
DFLAG EQU 5 @V305096 02716000
PZND1 EQU PZND+1 @V305096 02717000
PZND2 EQU PZND+2 @V305096 02718000
PZND3 EQU PZND+3 @V305096 02719000
PZND4 EQU PZND+4 @V305096 02720000
PFW2 EQU PFW+2 @V305096 02721000
PFW3 EQU PFW+3 @V305096 02722000
THIRTY7 EQU 37 @V305096 02723000
SIXTY EQU 60 @V305096 02724000
SIXTY9 EQU 69 @V305096 02725000
PDATA EQU X'80' @V305096 02726000
EJECT 02727000
SYSIR DSECT @V305096 02728000
BGCOM , @V305065 02729000
MAPPUB , @V305065 02730000
PUBWIT EQU *-PUBCUU @V305065 02731000
DOSCB , @V305065 02732000
EJECT 02733000
NUCON , @V305065 02734000
END STARTA 02735000