(George Source)
Macros used: AWAITSS, BOOKSS, CAPCA, CHECKB, CHECKBX, DERINGD, DOWN, EVENTFIN, FINDPUC, FINMOVE, FJOPCA, FOUTMOVE, FPCACA, GETACT, HUNT2, ILLEGAL, INMOVE, LINKSET, LOCKC, MACCS, MELRING, MENDAREA, MONOUT, NAME, OUTBLOCN, OUTMOVE, OUTPACKC, OUTPARC, PCAPLUG, PROGBRKIN, PUCST, RINGPUC, RUNPROG, SEGENTRY, SETRCTP, STEPBACK, TESTRT, TESTTP, TRACE, TRUSTED, UNPLUG
22FL #OPT K0TPINS=0 22^= #LIS K0TPINS 23DW #OPT K6TPINS=K6ALLGEO 23YG ...#SEG TPINS60 [JOHN P. TITORENKO 24D6 8HTPINS 24XQ SEGENTRY K1TPINS,XENT1 25CB SEGENTRY K2TPINS,XENT2 25X2 # THIS SEGMENT IS ENTERED TO DEAL WITH THE 26BL # TWO INSTRUCTIONS ISSUED BY TRUSTED PROGRAMS 26W= # K1TPINS IS THE ENTRY POINT FOR THE 167/0 ORDER 27*W # WHICH DEFINES THE PUC 27TG # K2TPINS IS THE ENTRY POINT FOR THE 164/7 ORDER 28*6 # WHICH PASSES CONTROL FROM TP TO PUC SUSPENDING THE TP. 28SQ XMASK #37774777 29#B #SKIP G4 29S2 ( 2=?L Q2 +2 2=R= XB8T23 #177777 2?=W XB0T7 #77600000 2?QG MAXSIZE #20000001 2#=6 ) 2##* ...[ 2#BJ ...[SUBROUTINE TO REFIND PUC PCA FOR LOCKC ASSUMES X2->TP PCA 2#DR ...[ 2#H2 ...REFIND 2#K9 ... FINDPUC 2,2 2#MD ... EXIT 1 0 2#PQ # 2*9B # REPORT ILLEGALS 2*P2 # 2*W8 ...#SKI G3 2B3B ...XILL 2B8L XILL1 UNPLUG 2BDD ...#SKI G4 2BN= ...XILL 2BY4 ... ILLEGAL ILLINS 2C7W # 2CMG # THIS SECTION DEALS WITH SPP(167/0) EXTRACODE 2D76 # 2DLQ XENT1 2F6B TRUSTED FX2,XILL,R 2FL2 #SKIP G3 2G5L ( 2GK= LDX 4 EVENT3(2) 2H4W SLC 4 3 2HJG ANDN 4 7 [ILLEGAL IF X NZ 2J46 BNZ 4 XILL 2JHQ LDN 3 2 2K3B XST CHECKB EVENT2(2),3,XILL,,W,XST 2KH2 LDN 7 4 2L2L LDN 6 2 2LG= OUTMOVE FX2,EVENT2(2),7,6 [ACCESS 167 PARAMETERS 2L^W #SKI K6TPINS>499-499 2MFG ( 2M^6 TRACE 4,TP7P 2NDQ TRACE 5,TP7P+1 2NYB ) 2PD2 ADN 4 63 [ROUND UP 2PXL ADN 5 63 [DATUM 2QC= ANDX 4 CMIN64 [AND 2QWW ANDX 5 CMIN64 [SIZE OF PUC. 2RBG BNG 4 XILL [ILLEGAL IF 2RW6 BZE 4 XILL [DATUM/SIZE ARE 2S*Q BNG 5 XILL [ZERO OR NEGATIVE. 2STB BZE 5 XILL 2T*2 LDN 6 64 2TSL TXU 6 4 2W#= BCS XM 2WRW LDXC 6 ASU3(2) [ILLEGAL IF TP HAS MS 2/3 2X?G BCC XILL 2XR6 LDXC 6 ASU4(2) [ROOM FOR MEMBER SWAPPING 2Y=Q BCC XILL 2YQB XM LDX 3 4 2^=2 ADX 3 5 [ILLEGAL IF PUC DATUM PLUS 2^PL LDX 6 ALIMIT(2) [SIZE MORE THAN TP SIZE 329= TXL 6 3 32NW BCS XILL 338G LDN 6 2 33N6 INMOVE FX2,EVENT2(2),7,6 347Q MACCS ,FX2,7 [FORM PUC DATUM 34MB ADX 7 4 [FOR PCA 3572 TESTTP ,XFPUC [J IF PROG ALREADY A TP. 35LL GETACT APET,APUC,1 366= FINDPUC ,3 [GET AND LOCK PUC PCA. 36#G ... LOCKC 3,REFIND 36GQ ... FINDPUC ,3 36S6 ... LINKSET 3,GVFN [SET PUC LINK TO K1OPCA 375G LDX 4 JOBNO(2) [SET JOBNO. OF PUC 37K6 STO 4 JOBNO(3) 384Q LDX 4 ASU1(2) 38JB STO 4 ASU1(3) 3942 LDCT 4 #600 39HL STO 4 ASU2(3) [SET PUC MS 1 3=3= STO 4 ASU3(3) [2 AND 3 NON EXISTENT 3=GW STO 4 ASU4(3) 3?2G LDN 4 #1000 [SET B14 IN 3?G6 STO 4 ASTOP(3) [PUC STOP WORD 3?L3 ...#UNS IMR 3?PY ...#SKI 3?TT ...( 3?^Q LDX 4 APR1(2) 3#FB STO 4 APR1(3) 3#P8 ...) 3#RR ... LDX 4 AMR1(2) [TP MILL PRIORITY 3#WB ... STO 4 AMR1(3) [PUC MILL PRIORITY 3#^2 ... LDX 1 APRB(2) 3BCW XL1 LDX 4 0(1) 3BXG BNG 4 XL2 3CC6 ... BDX 1 XL1 [X1->NEXT IN PRB 3DW2 XL2 3F9P ... STO 1 APRB(3) [SET PUCS PRB POINTER TO END OF TPS P 3FKD ...XL3A 3FT= STO 7 ADATUM(3) [SET DATUM 3G#W STO 5 ALIMIT(3) [AND LIMIT. 3H#6 ADX 7 GEODATUM 3HRQ STO 7 ADTM(3) 3J?B LDCT 0 #600 3JR2 ADX 7 ALIMIT(3) 3K=L ORX 7 0 3KQ= STO 7 ALMT(3) 3L9W LDN 0 CHAINADD(3) 3LPG STO 0 AECA(3) 3M96 LDN 0 ASTOP(3) 3MNQ STO 0 APD1(3) 3N8B STO 0 APD2(3) 3NN2 STO 0 APD3(3) 3P7L STO 0 APD4(3) 3PM= ... LDN 5 K61*3 3Q6W LDN 4 3 3QLG ...SETNM SMO 5 3R66 DCH 4 ARM1(3) [SET MEMBER NO. 3RKQ ... SBN 5 K61 [RESET MEMBER PTR. 3S5B SBN 4 1 [RESET MEMBER NO. 3SK2 BNZ 4 SETNM 3SQ8 ... LDX 0 ABW1(3) 3SXB ... BNZ 0 NPUCRING [J IF PUC ALREADY ON MEL RING 3T4J ... MELRING 3 3T9Q ...NPUCRING 3TBY ... SETRCTP FX2 [SET JOB RCTP 3TJ= NAME FX2,APET,ATP [RENAME TP PCA 3W3W ...XRP EVENTFIN 3WHG XFPUC FINDPUC ,3 [IF TP ALREADY 3X36 LDN 0 1 3XGQ SBS 0 CTRCTP 3Y2B [KEEP MODES BECAUSE CHARGESC MIGHT MESS THINGS UP 3YG2 SMO 7 3Y^L LDX 0 9 3^F= SLC 0 8 3^YW SMO 3 42DG DCH 0 ARM1 42Y6 SMO 3 43CQ DCH 0 ALMT 43XB ... BRN XL3A 44C2 ) 44WL # 45B= # 45TW # THIS SECTION DEALS WITH THE SPP(167) EXTRACODE IN GEORGE 4. 46*G # IN GEORGE 4 A PUC MUST START ON A 64K BOUNDARY & CONSIST OF A 46T6 # WHOLE NO. OF QUIRES SO IT ENDS ON A 64K BOUNDARY OR AT THE 47#Q # END OF THE PROGRAM. 47SB # IF THE EXTRACODE IS ATTEMPTING TO SET UP A PUC AT THE VERY END 48#2 # OF A DENSE TP THEN THE PUC DATUM IS ROUNDED UP TO 64K & THE SIZE 48RL # OF THE TP IS INCREASED TO ACCONMADATE THE PUC 49?= # OTHERWISE THE PUC IS SET UP TO OCCUPPY THE WHOLE SEGMENTS 49QW # CONTAINNED IN THE AREA GIVEN IN THE 167 EXTRACODE 4==G # 4=Q6 #SKIP G4 4?9Q ( 4?FJ ...NLARGED 4?PB LDX 4 EVENT2(2) 4#92 LDN 1 2 4#NL CALL 6 ZT101 [CHECK RESERVATIONS 4*8= BRN XILL 4*MW LDX 6 4 4B7G LDN 7 4 4BM6 FOUTMOVE 2,6,7,Q2(1),HLOCK1 4C6Q BNG 4 XILL [ACC SWAPPING NOT ALLOWED AT PUCDATUM 4CLB ANDX 4 BITS22LS 4D62 ANDX 5 BITS22LS 4DKL BZE 4 XILL [ZERO DATUM OR LENGTH ILLEGAL 4F5= BZE 5 XILL 4FJW CHECKBX 4,5,XILL [CHECK THAT AREA SPEC IS WITHIN PROG 4G4G ADX 5 4 4GJ6 TXU 5 ALIMIT(2) [J IF PUC EXTENDS TO END OF TP 4H3Q BCC ZT50 4HHB ZT18 ADX 4 XB8T23(1) [CALC WHOLE QUIRE WITHIN AREA 4J32 ANDX 4 XB0T7(1) 4JGL ANDX 5 XB0T7(1) 4K2= SBX 5 4 4KFW BZE 5 XILL [ILLEGAL IF NONE 4K^G ZT19 CALL 6 ZT100 [CHECK PAGE 0 OF PUC 4LF6 BRN XILL 4LYQ ZT21 TESTTP 2,ZT60 [J IF THERE IS A PUC ALREADY 4MDB # 4MY2 # SET UP PUCS PCA 4NCL # 4NX= GETACT APET,APUC,1 [GET PUC'S APET 4PBW ... LOCKC BPTR(2),REFIND [LOCK IT IF PROG IS SWAPPED IN 4PWG ZT22 LDX 1 BPTR(2) 4QB6 DERINGD JOBRING(1) 4QTQ LDX 1 BPTR(2) 4R*B LDX 0 JOBNO(2) [INITIALISE PUC'S PCA 4RT2 STO 0 JOBNO(1) [JOB NO. 4S#L LDX 0 ASU1(2) 4SS= STO 0 ASU1(1) [SUSPENSIONS 4T?W LDCT 0 #600 4TRG STO 0 ASU2(1) 4W?6 STO 0 ASU3(1) 4WQQ STO 0 ASU4(1) 4X=B LDN 0 #1000 4XQ2 STO 0 ASTOP(1) [STOP WORD 4XTX ...#UNS IMR 4X^S ...#SKI 4Y5P ...( 4Y9L LDX 0 APR1(2) 4YP= STO 0 APR1(1) [PRIORITIES 4Y^4 ...) 4^3M ... LDX 0 AMR1(2) [TP MILL PRIORITY 4^6= ... STO 0 AMR1(1) [PUC MILL PRIORITY 4^8W HUNT2 2,APERI,APERIRES [FIND PRB 4^NG LDX 7 2 5286 ZT26 LDX 0 A1(2) 52MQ BNG 0 ZT27 537B ADN 2 2 53M2 BRN ZT26 546L ZT27 SBX 2 7 54L= STO 2 APRB(1) [PERIPH LIST PTR 555W LDN 0 CHAINADD(1) 55KG STO 0 AECA(1) 5656 LDN 0 ASTOP(1) 56JQ STO 0 APD1(1) 574B STO 0 APD2(1) 57J2 STO 0 APD3(1) 583L STO 0 APD4(1) 58H= LDN 2 K61*3 592W LDN 6 3 59GG SETNM SMO 2 5=26 DCH 6 ARM1(1) [SET MEMBER NO. 5=FQ SBN 2 K61 [RESET MEMBER PTR 5=^B BCT 6 SETNM [RESET MEMBER NO. 5?F2 LDCT 0 #600 5?YL STO 0 ALMT(1) [INHIBIT MENITORING 5#D= LDX 2 FX2 5#XW CALL 7 ZT200 [OBEY COMMON CODE 5*CG ZT29 NAME 2,APET,ATP [RENAME TP'S PCA 5*X6 SETRCTP 2 [MARK JOB AS RCTP 5BBQ # 5BWB # STORE PUC DATUM & LENGTH IN OBJ.PROG 5CB2 # 5CTL ZT30 LDN 6 4 5D*= LDX 7 EVENT2(2) 5DSW LDX 1 FX1 5F#G FINMOVE 2,7,6,Q2(1),HLOCK1 [SET REPLIES 5FS6 RUNPROG [RESTART PROG 5G?Q # 5GRB # IF THE PUC EXTENDS TO THE END OF THE TP WE INCREASE THE SIZE 5H?2 # OF THE TP - THIS IS OF COURSE ONLY DONE FOR DENSE TPS 5HQL # 5J== ZT50 HUNT2 3,BSTB,BSCB,2 [IF PROG SPARSE TAKE WHOLE QUIRES 5JPW LDX 0 AMAXSIZE(3) 5K9G BNG 0 ZT18 5KP6 SBX 5 4 [REGAIN SPEC LENGTH OF PUC 5L8Q ADN 5 1023 [ROUND UP TO 1K TO OBTAIN ACTUAL 5LNB ANDX 5 B0T13 [LENGTH OF PUC 5M82 ADX 4 XB8T23(1) 5MML ANDX 4 XB0T7(1) [ROUND DATUM UP TO 64K BOUNDARY 5N7= LDX 7 4 5NLW ADX 7 5 5P6G TXU 7 ALIMIT(2) 5PL6 BCC ZT19 [J IF NO INCREASE IN SIZE 5Q5Q TXL 7 MAXSIZE(1) 5QKB BCC XILL [ERROR UNLESS LESS THAN 4M 5R52 FJOPCA 1,2 [CALC MAX SIZE ALLOWED TO PROG 5RJL TESTRT XILL,1 [ERROR IF REALTIME 5S4= LDX 0 JSIZE(1) [THIS IS'MAXSIZE'OR COREDEFAULT 5SHW BNZ 0 ZT52 5T3G LDX 0 COREDEFAULT 5TH6 ZT52 TXL 0 AOBJCORES [BUT MUST NOT EXCEED COREOBJECT 5W2Q BCS ZT53 5WGB LDX 0 AOBJCORES 5X22 ZT53 TXL 0 7 [ERROR IF REQD SIZE EXCEEDS THIS 5XFL BCS XILL 5X^= LDX 3 ALIMIT(2) 5YDW ... CAPCA 5YYG SBX 7 3 [INCREASE IN SIZE 5^D6 SRL 7 10 [CONVERT TO PAGES 5^XQ ZT56 BOOKSS 7,ZT58 [BOOK SWAPPING SPACE 62CB SLL 7 10 62X2 ADX 7 3 63BL OUTBLOCN 9 [SET UP ASET 63W= OUTPACKC 7,1,PROGCORE [SIZE GIVEN 64*W OUTPARC JOBMILL,TIMENOW 64TG MONOUT COREG4 65*6 ... FPCACA 2 65SQ STO 7 ALIMIT(2) [UPDATE ADDRESSING RANGE 66#B SRL 7 10 66S2 HUNT2 1,BSTB,BSCB,2 67?L DLA 7 AMAXSIZE(1) [UPDATE SIZE 67D4 ...[ IF BREAK IN OCCURS WE HAVE INCREASED SIZE 67JG ...[BUT NOT IMPLEMENTED EXTRACODE:- DOESNT MATTTER 67NY ... PCAPLUG ZT59 67TB ... UNPLUG [FOR COMPATIBILTY 67^S ... BRN NLARGED [JOIN MAIN PATH 686= ...[ TO REPEAT NECESSARY CODE 68=W ZT58 AWAITSS ZT59 [WAIT FOR SWAPPING SPACE 68QG BRN ZT56 69=6 ZT59 STEPBACK 69PQ PROGBRKIN 6=9B # 6=P2 # THIS SECTION IS ENTERED IF THERE IS A PUC ALREADY SET UP 6?8L # 6?N= ZT60 FINDPUC 2,1 6#7W LDX 1 ADATUM(1) 6#MG SRC 1 11 6*76 LDN 0 8 6*LQ BNG 1 ZT61 6B6B SLL 0 12 6BL2 ZT61 SMO BGLOT 6C5L SBS 0 0(1) 6CK= ZT62 CALL 7 ZT200 [OBEY COMMON CODE 6D4W ... BRN ZT30 6DJG # 6F46 # THIS SUBR CONTAINS THE USE OF THE CHECKB MACRO 6FHQ # 6G3B ZT100 LDN 1 1 [ENTRY PT TO CHECK ONE WORD 6GH2 ZT101 SBX 6 FX1 [ENTRY PT TO CHECK SPECIFIED AREA 6H2L CHECKB 4,1,ZT103,2,W,ZT102 6HG= LDX 1 FX1 6H^W ZT102 ADX 6 1 6JFG EXIT 6 1 [NORMAL EXIT +1 6J^6 ZT103 SBN 6 1 [IF RES VIOL EXIT +0 6KDQ BRN ZT102 6KYB # 6LD2 # THIS SECTION IS WRITTEN AS A SUBR BECAUSE IT IS OBEYED ON 6LXL # TWO DIFFERENT PATHS THRO' THE 167/0 EXTRACODE 6MC= # ASSUMES THAT IF PROG IS SWAPPED IN BOTH PCAS ARE LOCKED 6MWW # 6NBG ZT200 SBX 7 FX1 6NW6 FINDPUC 2,1 6P*Q STO 5 ALIMIT(1) [SET PUC LIMIT 6PTB LDX 0 HLOCK2+2(2) [ADDRESS OF PAGE 0 6Q*2 STO 0 ADATUM(1) [SET PTR TO PUC WORD 0 6QSL STOZ HLOCK2(2) [CLEAR LOCK DOWN LIST ENTRY 6R#= [KEEP MODES BECAUSE CHARGESC MIGHT MESS THINGS UP 6RRW SMO 0 6S?G LDX 0 9 6SR6 SLC 0 8 6T=Q SMO 1 6TQB DCH 0 ARM1 6W=2 SMO 1 6WPL DCH 0 ALMT 6X9= SRL 4 16 6XNW PUCST 2,4 [ADJUST OR SET UP PUC S T 6Y8G SLL 4 16 6YN6 SBN 7 1 6^7Q ...ZT204 ADX 7 FX1 6^MB ... EXIT 7 1 7272 ) 72LL # 736= # THIS SECTION DEALS WITH 164/7 EXTRACODE 73KW # 745G XENT2 74K6 #SKI K6TPINS>499-499 754Q TRACE EVENT3(2),TP4EV3 75JB TESTTP ,XNM 7642 BRN XILL1 [ILLEGAL IF ISSUED BY NON TP 76HL XNM LDX 3 EVENT2(2) 773= BNZ 3 XILL1 [ILLEGAL IF N(M) NZ 77GW MACCS ,FX2,4 782G SMO 4 78G6 LDX 5 31 78^Q #SKI K6TPINS>499-499 79FB TRACE 5,TP4W31 79^2 BNZ 5 XEVFN [J IF TP WD 31 NZ 7=DL #SKI G4 7=Y= DOWN SWAPOUT,4 [AWAIT ANX OUTSTANDING BS TRANS 7?CW 7?XG FINDPUC ,6 7#C6 MACCS ,6,3 7#WQ LDCT 5 #120 7*BB ANDX 5 9(3) 7*W2 ERS 5 9(3) 7B*L SLC 5 8 7BT= LDX 3 6 7C#W LDX 7 ALMT(3) [MODES OF CURRENT/LAST 7CSG ANDN 7 #77 [MEMBER RUN 7D#6 TXU 7 5 [J IF 7DRQ BCC XRGPC [MODES AS BEFORE 7F?B SMO 3 7FR2 DCH 5 ALMT [CHANGE MODES 7G=L SMO 3 7GQ= DCH 5 ARM1 7H9W XRGPC RINGPUC FX2 7HPG LDX 4 ASTOP(2) 7J96 ANDX 4 XMASK(1) [TRANSFER TP STOP WD TO PUC 7JNQ ADN 4 #1000 [SETTING B14 IN FORMER 7K8B ERS 4 ASTOP(2) [CLEARING IT IN LATTER. 7KN2 SBN 4 #2000 7L7L ADS 4 ASTOP(3) 7LM= XEVFN EVENTFIN 7M6W MENDAREA 40,K100TPINS 7MLG #END ^^^^ ...72043732000200000000