{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: TPINS861)}}
====== TPINS861 ======
(George Source)
**Macros used:** [[george:macro:AWAITSS|AWAITSS]], [[george:macro:BOOKSS|BOOKSS]], [[george:macro:CAPCA|CAPCA]], [[george:macro:CHECKB|CHECKB]], [[george:macro:CHECKBX|CHECKBX]], [[george:macro:DERINGD|DERINGD]], [[george:macro:DOWN|DOWN]], [[george:macro:EVENTFIN|EVENTFIN]], [[george:macro:FINDPUC|FINDPUC]], [[george:macro:FINMOVE|FINMOVE]], [[george:macro:FJOPCA|FJOPCA]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FPCACA|FPCACA]], [[george:macro:GETACT|GETACT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:INMOVE|INMOVE]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LOCKC|LOCKC]], [[george:macro:MACCS|MACCS]], [[george:macro:MELRING|MELRING]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTMOVE|OUTMOVE]], [[george:macro:OUTPACKC|OUTPACKC]], [[george:macro:OUTPARC|OUTPARC]], [[george:macro:PCAPLUG|PCAPLUG]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:PUCST|PUCST]], [[george:macro:RINGPUC|RINGPUC]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETRCTP|SETRCTP]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:TESTRT|TESTRT]], [[george:macro:TESTTP|TESTTP]], [[george:macro:TRACE|TRACE]], [[george:macro:TRUSTED|TRUSTED]], [[george:macro:UNPLUG|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