(George Source)
Macros used: ALTLENG, CLOBJPERIS, DECANTCT, FINDPUC, FJOCA, FPCACA, HLSINFORM, HUNT2, HUNTW, JMT, KEEPCHAP, LADDP, LGEOG, LOBJPERIS, LTYPE, MENDAREA, MONOUT, NEWPERI, OUTBLOCN, OUTPACKC, OUTPARC, PHOTO, RELPERENT, SEGENTRY, SETNCORE, TESTMOVE, TESTRCTP, TRACE, UP, VFREEW
22FL #SEG PUTPER [JOHN BAILEY. 22^= #LIS K0PUTPER>K0RELPER>K0ALLGEO 23DW 8HPUTPER 23YG # 24D6 SEGENTRY K1PUTPER,SK1PUTPER 24XQ # 25CB # ON ENTRY TO THIS SEGMENT,THE PRB BLOCK IS HUNTED FOR AND WHEN FOUND 25X2 # A CHECK IS MADE THAT THE ENTRY TO BE INSERTED IN THE PRB IS NOT 26BL # ALREADY PRESENT 26W= # IF THE ENTRY IS PRESENT,THEN THIS IS RELEASED AND THE ROUTINE GOES 27*W # BACK TO THE BEGINNING 27TG # THE LENGTH OF THE BLOCK IS THEN INCREASED BY 2 WORDS TO HOLD 28*6 # THE NEW ENTRY, WHICH IS APPENDED TO THE LIST. 28SQ # IF THE ENTRY IS FOR AN ONLINE PERIPHERAL A SUITABLE LOGGING 29#B # MESSAGE IS OUTPUT, AND THE REPLY IS SET ZERO, OTHERWISE THE 29S2 # OFFLINE PERIPHERAL COUNT IS SET AS A REPLY AND THE ROUTINE GOES UP. 2=?L # 2=R= # 2?=W # SUBROUTINE TO FIND THE PRB (APERI/APERIRES BLOCK) 2?QG # 2#=6 TFIND FPCACA 3,2 2#PQ STO 3 AWORK3(2) [SAVE THE PCA ADDRESS 2*9B HUNT2 3,APERI,APERIRES 2*P2 STO 3 AWORK1(2) [SAVE THE PRB ADDRESS 2B8L EXIT 6 0 2BN= # 2C7W # SUBROUTINE TO RE-FIND THE PRB AFTER CORE MOVES DURING ALTLENG 2CMG # 2D76 THUNT CALL 6 TFIND 2DLQ LDX 2 3 [ALTLENG NEEDS ADDRESS IN X2 2F6B EXIT 1 0 2FL2 # 2FLP ...#UNS JWPHASE4 2FMD ...( 2FN7 ...SETSUP [SUB TO GIVE HLS AN ADATA SETSUP BLOC 2FNW ... BZE 3 (7) [ALREADY THERE IF NO DELIST POINTER 2FP9 ... SBX 7 FX1 2FPK ... SETNCORE 3,1,ADATA,ASUP 2FQ# ... LGEOG 3,0 2FR3 ... STO 0 A1+1(1) [STORE GEOG NO. 2FRQ ... LTYPE 3,0 2FSF ... STO 0 A1(1) 2FT8 ...[ STORE DEVICE TYPE 2FTX ... ERN 0 5 2FWL ... BNZ 0 NMTLS [J IF NOT MT 2FX* ... LADDP 3,2 2FY4 ... BNG 2 NMTLS 2FYR ... LDX 2 2(2) [GET TSN FROM APIA ENTRY 2F^G ... BRN YMTLS 2G29 ...NMTLS LDN 2 0 2G2Y ...YMTLS STO 2 A1+2(1) [STORE TSN IF ANY 2G3? ... ADX 7 FX1 2G3M ... EXIT 7 0 2G4B ...) 2G5L SK1PUTPER 2GK= STO 6 AWORK2(2) [POINTER TO DEV LIST AND/OR B0 SET 2H4W LDX 5 ACOMMUNE7(2) [TYPE/UNIT NO. 2HJG P1 CALL 6 TFIND [GET PRB ADDRESS IN X3 2J46 LDN 4 1 [SET OFFLINE PERI COUNT = 1 2JHQ P2 LDX 0 A1(3) [NEXT ENTRY. 2K3B BNG 0 P5 [LAST WORD < 0 : NO MORE ENTRIES 2KH2 ERX 0 5 2L2L BZE 0 P4 [BRANCH IF ENTRY ALREADY PRESENT 2LG= LDXC 0 A1+1(3) [B0 SET IF OFFLINE 2L^W ADN 4 0 2MFG BDX 3 P2 [GO TO CHECK NEXT ENTRY 2M^6 P4 LDX 0 5 2NDQ RELPERENT 0 [DELETE THE ENTRY. 2NYB BRN P1 [BRANCH TO SET UP MARKERS 2PD2 # 2PXL P5 SMO AWORK1(2) [ADDRESS OF PRB 2QC= LDX 0 ALOGLEN [LENGTH OF PRB 2QWW LDN 7 3(3) 2RBG SBX 7 AWORK1(2) [NEW LENGTH NEEDED FOR NEW ENTRY 2STB PHOTO 6 2T2J ... TXL 0 7 2T7Q ... BCC P7X [ALREADY LONG ENOUGH 2T*2 ALTLENG AWORK1(2),7,THUNT [INCREASE THE PRB LENGTH BY 2 WORDS 2TG8 ... SEGENTRY JKCPUTPER [USED TO NULL BRANCH IN NEWPERI 2TH9 ...#UNS KEEPCHAP 2TJ= ...#SKI 2TK? ...P7X 2TL# ...#UNS KEEPCHAP 2TMB ...P7X NEWPERI 5 [FOR KEPT CHAPTERS 2TSL TESTMOVE 6,P7 2W#= CALL 6 TFIND [CORE MOVED : REFIND PRB 2WRW ADX 3 7 2X?G SBN 3 3 [POINT TO WORD EQUIVALENT TO AT P5 2XR6 # 2Y=Q P7 LDX 0 AWORK2(2) [POINTER TO DEV LIST AND/OR B0 SET 2YQB BPZ 0 P7A 2^=2 LDCT 0 #400 [STORE ONLY B0 IF OFFLINE 2^PL P7A STO 5 A1(3) [STORE FIRST WORD OF ENTRY 329= STO 0 A1+1(3) [SET FOR ASSISTE REPEATS. 32NW LDCT 0 #400 338G STO 0 A1+2(3) [SET END OF LIST MARKER 33N6 FJOCA 1,2 [FIND THE JOB BLOCK. 347Q TESTRCTP 1,P10 [J. IF TRUSTED PROGRAM. 34MB BRN P8 3572 P10 FINDPUC AWORK3(2),1 [FIND PUC'S PCA 35LL LDN 0 2 366= ADS 0 APRB(1) [UPDATE POINTER TO LAST REC IN TP PRB 36KW # 375G P8 LDXC 3 AWORK2(2) 37K6 BCC P8A [B0 NOT SET IF ONLINE 37N= ...#UNS JWPHASE4 37RB ... BZE 3 P9Q [ZERO IF NO MESSAGE TO BE OUTPUT 37WG ...#UNS JWPHASE4 37^L ...#SKI 384Q BZE 3 P9 [ZERO IF NO MESSAGE TO BE OUTPUT 38JB ...P8A JMT 3,SWCT [J. IF MAG. TAPE 3942 LGEOG 3,7 39HL OUTBLOCN 7 [SET UP A PARAMETER BLOCK. 3=3= OUTPARC TIMENOW [TIME 3=GW OUTPACKC 7,1,GEOPER [GEOGRAPHIC NUMBER 3?2G OUTPACKC 5,1,PERINAME [PERIPHERAL NAME 3?G6 MONOUT JPER 3?^Q LDX 0 AWORK2(2) 3#FB BNG 0 P9 [NEG. IF OFFLINE 3#^2 LDN 4 0 [NO OLPAS IF ONLINE 3*DL TAPE CLOBJPERIS 3 [ZEROISE EXEC'S SCHEDULING COUNT 3*G8 ...VRSW 3*HQ ...#UNS JWPHASE4 3*K# ...( 3*LW ...TELLHLS 3*ND ... HLSINFORM (GEOERR),ONLINE,JOBNO(2),,SETSUP 3*Q2 ... BNZ 3 P9 3*RJ ... VFREEW ADATA,ASUP 3*T6 ...P9M1 LDX 2 FX2 3*WN ...) 3*Y= P9 3BCW STO 4 ACOMMUNE7(2) [NO. OF OLPAS FOR ROLPA 3BXG #SKI K6ALLGEO>99-99 3CC6 TRACE 5,PUTPER 3CWQ UP [FINISH 3DBB # 3DD# ...SWCT 3DG= ... LOBJPERIS 3,0 3DJ8 ...[ GET ANY PROGRAM TRANSFERS 3DL6 ... DECANTCT 3,0,OBJECT [REMOVE THEM 3DN4 ... NGX 0 0 3DQ2 ... DECANTCT 3,0,GEORGE [AND ADD IN TO GEORGE COUNT 3DRY ... BRN VRSW 3DW2 # 3F*L # 3FBM ...#UNS JWPHASE4 3FCN ...( 3FDP ...P9Q LDX 0 5 3FFQ ... SRL 0 15 3FGR ... ERN 0 6 3FHS ... BNZ 0 P9 [J IF NOT DISC 3FJT ... HUNTW 2,ADATA,ASUP [ASUP ALREADY SET UP FOR REAL DISC 3FKW ... BNG 2 P9M1 [SO DONT TELL HLS IF THERE ISNT ONE 3FLX ... LDX 0 A1(2) 3FMY ... ERN 0 6 3FN^ ... BNZ 0 P9M1 3FQ2 ... LDX 2 FX2 3FR3 ... BRN TELLHLS [TELL HLS DISC ONLINED 3FS4 ...) 3FT= MENDAREA 10,K100PUTPER 3G#W # 3GSG # 3H#6 # 3HRQ #END ^^^^ ...24364256001000000000