CHCH865
(George Source)
Macros used: BLOCKCOPY, BXL, BXU, CHCHCOOR, ENRING, ENTRUST, FINDCORE, FIXTRA, GEOERR, GETLINK, LABFIX, SQOSS2, SQUMP, SUNDUMP, TRANSFIX, UNTRUST
- CHCH865.txt
22FL # 22^= #OPT K0CHCH=0 23DW #LIS K0CHCH>K0KERNEL>K0ALLGEO 23YG #SEG CHCH [RUTH PORTER 24D6 # 24XQ # CHAPTER CHANGER DEALS WITH ACROSS(VAR), DOWN AND UP(PLUS) 25CB # CHAPTER CHANGES 25X2 # 26BL #OPT K6CHCH=K6KERNEL>K6ALLGEO 26W= #SKI IGP 27*W ( 27TG # ENTRY FOR GETPROC IF MACRO DISCOVERS CHAPTER NOT IN CORE 28*6 LABFIX HTPROC 28SQ TPROC LDN 0 2(1) [X0 -> INST AFTER LINK PAIR 29#B LABFIX HTPROX 29S2 TPROX 2=?L SQUMP [DUMP ACCUMULATORS 2=R= SQOSS2 [CALCULATE & DEPOSIT LINK 2?=W LDX 0 ALINK1(2) 2?QG STO 0 ACOMMUNE9(2) [SAVE LINK 2#=6 LDX 0 0(1) 2#PQ STO 0 ALINK1(2) [GETPROC LINK 2*9B LDCT 0 #20 2*P2 ORS 0 CLONG1(2) [SET GETPROC MARKER 2B8L TRANSFIX BRN,BCHR 2BN= ) 2C7W [ENTRY FOR THE ACROSS CHAPTER CHANGE. DUMP ACCUMULATORS AND NEW LINK, 2CMG [THEN ENTER CHAPTER ENTRY ROUTINE. 2D76 LABFIX HTCHAP 2DLQ TCHAP SQUMP [ DUMP ACCUMULATORS & SET X2. 2F6B LDX 0 0(1) 2FL2 STO 0 ALINK1(2) [SET LINK 2G5L FIXTRA CHSTAC 2GK= BRN TENT [GO TO CHAPTER ENTERING ROUTINE. 2H4W [ENTRY FOR THE UP CHAPTER CHANGE. RESTORE THE ACCUMULATORS AND LINK FROM 2HJG [THE LINK BLOCK, THEN ENTER THE CHAPTER ENTRY ROUTINE. 2J46 LABFIX HTCHAPUP 2JHQ TCHAPUP 2K3B LDN 0 0 2KH2 LABFIX HTUP2 2L2L TUP2 2LG= LDX 2 FX2 2L^W LDX 3 ALINKRING(2) [ADDRESS OF LINKSTACK 2MFG #SKI K6CHCH [ CHECK TYPE WORD. 2M^6 ( 2NDQ BXU 3 0(3),T6 [OK IF LINKSTACK BLOCK EXISTS 2NYB GEOERR BRIEFPM,CHCH4 [ACTIVITY BLOCK IS ILLEGAL 2PD2 T6 2PXL ) 2QC= SBN 3 BLINKRING [GET TO START OF LINK BLK 2QPM ... LDX 4 ALOGLEN(3) 2R44 ... SBN 4 ALINK [NEW LOG LEN 2RBF ... BNG 4 (GEOERR) [J IF UP TOO OFTEN 2RNW ... STO 4 ALOGLEN(3) [UPDATE LOG LEN 2S3? ... ADX 3 4 [PTR TO START OF LINK 2S*Q ADN 3 A1 [START OF CURRENT LINK 2STB LDN 4 ACC3(2) 2T*2 MOVE 3 ALINK [MOVE LINK TO ACTIVITY BLOCK 2TSL ADS 0 ALINK1(2) [STEP LINK AS REQUIRED 2W#= FIXTRA CHSTUP 2WRW BRN TENT 2X?G [ENTRY FOR THE DOWN CHAPTER CHANGE. DUMP THE ACCUMULATORS AND LINKS IN 2XR6 [THE ACTIVITY BLOCK AND A LINK BLOCK, THEN TRY TO ENTER THE CHAPTER. 2Y=Q LABFIX HTCHAPDOWN 2YQB TCHAPDOWN SQUMP [X2 -> ACTIVITY BLOCK. 2^=2 LDN 0 HLINK(1) [STEP PAST LINK 2^PL SQOSS2 329= #SKI K6CHCH>2-2 32NW ( 338G BPZ 0 T2 33N6 GEOERR BRIEFPM,CHCH5 347Q T2 SBN 0 #7777 34MB BNG 0 T3 3572 GEOERR BRIEFPM,CHCH6 35LL T3 366= ) 36KW LABFIX CHCHSPEC 375G LDX 0 0(1) [X0 CONTAINS LINK 37K6 LDX 3 ALINKRING(2) [POINTER TO LINKSTACK BLOCK 384Q BXU 3 0(3),QD1 [J IF IT EXISTS 38JB LDN 4 ALINK+2 3942 QD3 39HL STO 0 CHTPRIV1 [KEEP COPY 3=3= GETLINK [OF REQUIRED LENGTH IN X4 3=GW FINDCORE 3 [ADDR OF NEW LINK BLK 3?2G LDCT 0 BLINK/8 3?G6 STO 0 ATYPE(3) [NAME LINK BLOCK 3?^Q LDX 2 ALINKRING(2) 3#FB TXU 2 0(2) 3#^2 BCC QD2 3*DL SBN 2 BLINKRING [ADJUST ->START 3*Y= BLOCKCOPY [COPY ACROSS 3BCW FIXTRA CHSTFL 3BXG BRN QD5 3CC6 QD2 3CWQ LDN 1 BLINKRING(3) 3DBB ENRING 1,2 3DW2 FIXTRA CHSTFLB 3F*L QD5 3FT= LDX 4 ALOGLEN(3) 3G#W LDX 0 CHTPRIV1 3GSG FIXTRA CHSTGL 3H#6 BRN QD4 3HRQ QD1 3J?B SBN 3 BLINKRING [GET TO START OF LINK BLK 3JR2 LDX 4 ALOGLEN(3) 3K=L ADN 4 ALINK [NEW LOGICAL LENGTH REQUIRED 3KQ= LDX 5 ASIZE(3) 3L9W SBN 5 A1 [MAXIMUM POSSIBLE LOGICAL LENGTH NOW 3LPG BXL 5 4,QD3 [J NOT ENOUGH 3M96 STO 4 ALOGLEN(3) [SET NEW LOGICAL LENGTH 3MNQ FIXTRA CHSTGLB 3N8B QD4 3NN2 SBN 4 ALINK 3P7L ADN 4 A1(3) [DESTINATION ADDR OF NEW LINK 3PM= LDN 3 ACC3(2) 3Q6W MOVE 3 ALINK 3QLG STO 0 ALINK1(2) 3QW# ... LABFIX TENT 3R66 TENT 3R=3 ...#UNS ICTON 3R*Y ...#SKI 3RFT ...( 3RKQ LDN 1 K8 3S5B TXU 1 K8 3SK2 TRANSFIX BCS,FLIST 3T4L #SKI ANEWTENT 3TJ= ( 3W3W LDN 1 K3 3WHG TXU 1 K3 3X36 TRANSFIX BCS,FLIST 3XGQ ) 3XK* ...) 3XMY ...#UNS ICTON 3XQH ...( 3XT6 ... CHCHCOOR 3XXP ...) 3Y2B FIXTRA FZCO 3YG2 LABFIX FZCO 3Y^L [WHEN IT WANTS TO ENTER THE CHAPTER 3^F= [OF AN ACTIVITY 3^YW NULL [GAP FOR MENDS 42DG LDX 1 ALINK1(2) [GET SEGMENT NUMBER 42Y6 #SKI K6CHCH>9-9 43CQ ( 43XB BZE 1 (GEOERR) 44C2 SKO 44WL ) 45B= FIXTRA CHSTLK 45TW SRL 1 12 [X1 NOW HAS CHAPTER NUMBER 46*G FIXTRA ADPCHCH [FOR DATAPASS 46T6 LDXC 1 KTAB(1) 47#Q TRANSFIX BCC,BCHR 47SB BZE 1 SFIXED [NO CHAINING IF FIXED CORE 48#2 #SKI IGP 48RL ( 49?= LDCT 0 #20 49QW ANDX 0 CLONG1(2) 4==G BZE 0 XOK 4=Q6 ERS 0 CLONG1(2) 4?9Q LDX 0 ACOMMUNE9(2) 4?PB STO 0 ALINK1(2) 4#92 TRANSFIX BRN,FZCO 4#NL ) 4*8= XOK 4*MW TXU 1 BCHAP 4B7G BCC XCHN [DONT BOTHER TO RECHAIN IF AT FRONT 4BM6 LDX 2 FPTR(1) [CHAIN AT FRONT OF CH CHAIN 4C6Q LDX 3 BPTR(1) 4CLB STO 2 FPTR(3) 4D62 STO 3 BPTR(2) 4DKL LDX 2 BCHAP 4F5= STO 1 BPTR(2) 4FJW STO 2 FPTR(1) 4G4G LDN 0 BCHAP 4GJ6 STO 0 BPTR(1) 4H3Q STO 1 BCHAP 4HHB LDX 2 FX2 4HJH ...XCHN 4HTR ... FIXTRA CURFIX1 [ LABEL FOR MACRO "CONCURR" 4J73 ... LABFIX CURFIX1 4JD? ...# 4JFD ... LDN 1 A1(1) [GET X1 FOR FX1 4JGL SFIXED 4K2= STO 1 FX1 4KFW LDN 3 1 4K^G LDN 0 #7777 4LF6 ADSC 3 CHCHCOUNT [UPDATE CT FO CHCHS 4LYQ ANDX 0 ALINK1(2) 4M8J ... FIXTRA CHKP 4MDB ADS 3 ACTCHCH(2) 4MY2 SUNDUMP [UNDUMP ACCUMULATORS 4NCL ADX 0 1 [DATUMIZE 4NX= EXIT 0 0 [EXIT 4NX? ...# 4NX# ...# 2960 DUAL DME EXEC/G3 CONCURRENCY ENHANCEMENT 4NX* ...# SWITCHED ON BY RESTORE TIME MACRO "CONCURR" 4NXB ...# 4NXC ...# BIT 9 OF KTAB ENTRY IF SET INDICATES CHAPTER 4NXD ...# NOT ALLOWED TO RUN CONCURRENTLY WITH EXECUTIVE 4NXF ...# 4NXG ... FIXTRA CURFIX2 4NXH ... LABFIX CURFIX2 4NXJ ... LDX 0 BACK2(1) 4NXK ... SLL 0 9 4NXL ... BPZ 0 NEXECFLAG [ JIF NEW CHAPTER IS UNTRUSTED 4NXM ... STO 0 FBIDMEM [REMEMBER WE ARE TRUSTED 4NXN ... ENTRUST RUNIT,XECRUNS [ MAKE US "TRUSTED"-JIF CAN'T TO 'XECR 4NXP ...NEXECFLAG 4NXQ ... STOZ FBIDMEM [REMEMBER WE ARE UNTRUSTED 4NXR ... UNTRUST [ MAKE US "UNTRUSTED" 4NXS ...RUNIT 4NXT ... NGS 1 ACTMEMORY [ FORGET ANY ACT. NO. BEING REMEMBERED 4NXW ... LDN 1 A1(1) [GET X1 FOR FX1 4NXX ... BRN SFIXED 4NXY ...# 4NYJ ...# EXECUTIVE IS RUNNING SO WE CANT RUN THIS ACTIVITY 4N^9 ...# REMEMBER ACT NO. IF FIRST ONE THIS CHAPTER CHANGE 4N^W ...# AND PUT IT BACK ON LIST. GET NEXT ACTIVITY. 4P2H ...# IF FAILS AGAIN, RETURN HERE BUT NOW ACTMEMORY IS +VE 4P38 ...# SO CHECK IF WE'RE BACK TO STARTING ACTIVITY. IF NOT, 4P3T ...# GET NEXT ACTIVITY AGAIN, ELSE GIVE UP BY DOING 4P4G ...# UNCONDITIONAL "ENTRUST". 4P57 ...# 4P5S ...XECRUNS 4P6F ... LDX 0 ACNUM(2) [ CHECK ACT. NUMBER 4P76 ... TXU 0 ACTMEMORY [ WITH FIRST ONE THIS CH.CH. 4P7R ... BCS TRYNEXT [ JIF NOT GOT TO 'END' OF LIST 4P8D ... ENTRUST [ ELSE GIVE UP 4P95 ... BRN RUNIT [ WE NOW KNOW EXEC IS NOT RUNNING 4P9Q ...TRYNEXT 4P=4 ... STOZ FBIDMEM [REMEMBER WE ARE STILL UNTRUSTED 4P=C ... LDX 1 ACTMEMORY [ CHECK IF FIRST TIME THROUGH 4P?4 ... BPZ 1 NOTFIRST [ JIF NOT 4P?P ... STO 0 ACTMEMORY [ ELSE REMEMBER STARTING ACT. NO. 4P#B ...NOTFIRST 4P*3 ... TRANSFIX BRN,CURFIX3 [ APPROX = 'FPUT' + 'COOR1' 4P*N ...# 4PBW # 4PWG # 4QB6 # 4QTQ # 4R*B # 4RT2 # 4S#L #END ^^^^ ...72023204001300000000