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