(George Source)
Macros used: BXU, COOR4, GEOPACK, INFORMX, JBS, LGEOG, MENDAREA, OUTNUM, OUTPACK, SEGENTRY, UP, UPPLUS
22FL ...#SEG COREALLH [DEK BEASLEY : CENT 22^= #OPT K0COREALLH=0 23DW #LIS K0COREALLH>K0KERNEL>K0ALLGEO 23YG 8HCOREALLH 24D6 SEGENTRY K1COREALLH,QENTRY1 24XQ [ EACH LABEL HAS ONLY ONE BRANCH TO IT (EXCEPT FOR SUBROUTINES) 25CB PPRINT +AUNTERM 25X2 QPRINT +ASTORIMP 26BL TWO +2 26W= QENTRY1 273D ... LDX 0 ACOMMUNE3(2) [SAVE SIZE OF PROGRAM AS WE RETURN 278L ... STO 0 AWORK4(2) [ TO DO ANOTHER STARTSTRAT IN G3 27*W STOZ ACOMMUNE1(2) [ 27TG LDN 7 15 28*6 WAIT1 COOR4 #62 [ WAIT 1 MINUTE 28SQ BCT 7 WAIT1 29#B LDX 1 FCORES 29S2 STEPUP1 [ STEP UP TO THN FREEZE AREA 2=?L LDX 3 1 2=R= #SKI CAMK7<5-5 2?=W ( 2?QG SMO ASIZE(1) 2#=6 ADN 1 0 2#PQ ) 2*9B #SKI CAMK7>4-4 2*P2 ADX 1 ASIZE(1) 2B8L ... TXL 4 1 [ X4 -> START OF EXTENDED FREEZE 2BN= ... BCC STEPUP1 [ J IF NOT YET PAST START OF FREEZE 2C7W TESTLOK 2CMG #SKI CAMK7<5-5 2D76 ( 2DLQ LDCT 0 #200 2F6B ANDX 0 ASIZE(3) 2FL2 ) 2G5L #SKI CAMK7>4-4 2GK= ( 2H4W LDN 0 #10 2HJG ANDX 0 AFLAG(3) [ IS BLOCK LOCKED 2J46 ) 2JHQ BZE 0 STEPUP2 [ JUMP IF NO, TO STEP TO NEXT BLOCK 2JK^ ...#SKI G4 2JN8 ...( 2JQC ... LDCH 0 ATYPE(3) [OBJECT PROGRAM BLOCKS ALWAYS 2JSL ... SBN 0 AOBJPROG/64 [ LOCKED ,BUT MAY BE IN FREEZE AREA 2JWT ... BZE 0 STEPUP2 [ IN G4 2J^4 ...) 2J^D ...#UNS ISTDP 2J^S ...( 2K28 ...#SKI G3 2K2J ... JBS STEPUP2,3,AFFPB [FPB'S MAY BE IN FREEZE AREA 2K2Y ...) 2K34 ... LDX 0 ATYPE(3) 2K38 ... BXU 0 ACOMMUNE9(2),STEPUP2 [J IF WRONG BLOCK 2K3B STO 3 ACOMMUNE1(2) [ POINT TO BLOCK 2KH2 STOZ ACOMMUNE2(2) 2L2L LDX 3 FPTR(3) [ THE BLOCK TO STOP AT 2LG= LDX 1 3 2L^W STEPBAK 2MFG LDX 1 BPTR(1) [ STEP BACK 2M^6 LDX 0 ATYPE(1) [ IS THIS THE ACTIVITY BLOCK? 2NDQ TXL 0 CACT 2NYB BCC TESTACTY [ YES 2PD2 TXU 1 3 [ SEARCH COMPLETED? 2PXL BCS STEPBAK [ JUMP IF NO. 2QC= BRN NOACTY 2QWW OCTALPRINT 2RBG LDX 0 ALINK1(1) 2RW6 STO 0 ACOMMUNE3(2) [SAVE NAUGHTY ACT'S LINK 2S*Q SMO ACOMMUNE2(2) [ CHANGE PARAMETERS FOR OCTALPRINT 2STB LDX 1 ATYPE 2T*2 STO 1 ACOMMUNE2(2) 2TSL NOACTY 2W#= SMO ACOMMUNE1(2) 2WRW LDX 1 ATYPE 2X?G STO 1 ACOMMUNE1(2) 2XR6 NGN 7 1 2Y=Q Y8 ADN 7 1 2YQB ADX 2 7 2^=2 OUTNUM ACOMMUNE1(2),OCTAL 2^PL LDX 0 ACOMMUNE2(2) 329= BZE 0 Y9 32NW TXL 7 TWO(1) 338G BCS Y8 33N6 Y9 LDX 7 QPRINT(1) 347Q BRN QEXIT 34MB TESTACTY 3572 STO 1 ACOMMUNE2(2) 35LL SRL 0 12 366= SBN 0 BSA 36KW BNZ 0 WHATPRINT [ ELSE LOOK FOR ANOTHER LOKD BLOCK 36TN ... LDX 3 BPTR(3) [ADDR OF LOCKED BLOCK 375G STEPUP2 [ STEP UP THROUGH THE FREEZE AREA 37K6 #SKI CAMK7<5-5 384Q ( 38JB SMO ASIZE(3) 3942 ADN 3 0 39HL ) 3=3= #SKI CAMK7>4-4 3=GW ADX 3 ASIZE(3) 3?2G TXL 3 AWORK3(2) [ STILL IN FREEZE AREA? 3?G6 BCS TESTLOK [ JUMP IF YES 3?^Q LDX 1 ACOMMUNE1(2) [ LOCKED BLOCK FOUND? 3#FB BZE 1 X7 [ EXIT IF NO 3#^2 WHATPRINT 3*DL LDX 1 ACOMMUNE2(2) 3*Y= LDX 0 CPRW1(1) 3*^7 ... BNG 0 UNTERTR [ IF UNTERMINATED TRANSFER, JUMP 3B24 ... ADN 1 CHAINADD 3B2^ ... LDX 4 1 [STORE ADDRESS OF CHAIN 3B3W ... LDX 1 BBAC [LOAD ADDRESS OF HIGHEST BSA 3B4R ...TESTUNTR 3B5N ... LDX 3 CPRW1(1) 3B6K ... BPZ 3 NOUNTR [TEST FOR UNTERMINATED TRANSFER 3B7G ... LDN 6 1 [LOOP COUNTER 3B8C ... LDX 3 1 3B9# ... ADN 3 JOBRING [STORE ACTIVITIES RING ADDRESS 3B=9 ...NALKENT 3B?6 ... LDX 5 3 [STORE ACTIVITIES RING ADDRESS 3B#3 ...TRAVRING 3B#Y ... LDX 3 FPTR(3) [TRAVERSE RING OF BSA 3B*T ... TXU 3 4 3BBQ ... BCC UNTERTR [REACHED ACTIVITY :- UNTER TRANS 3BCM ... TXU 3 5 [HAVE WE REACHED BSA AGAIN 3BDJ ... BCS TRAVRING [NO - CONTINUE TRAVERSING RING 3BFF ... SBN 6 1 3BGB ... BNZ 6 NOUNTR [ONLY TWO RINGS TO SEARCH 3BH? ... LDX 3 1 3BJ8 ... ADN 3 ALINKRING 3BK5 ... BRN NALKENT [SEARCH LINK RING 3BL2 ...NOUNTR 3BLX ... LDX 1 ACTRING(1) 3BMS ... SBN 1 ACTRING [LOAD ADDRESS OF NEXT BLOCK 3BNP ... LDX 3 ATYPE(1) 3BPL ... SRL 3 12 3BQH ... SBN 3 BSA [IS BLOCK A BSA 3BRD ... BZE 3 TESTUNTR [IF YES TEST TRANSFERS 3BS* ... LDX 1 ACOMMUNE2(2) [LOAD ACTIVITY ADDRESS 3BT= ... BRN OCTALPRINT [LOCKED BLOCK IS TRUE STORE IMPEDIMEN 3BW7 ...UNTERTR 3BXG LGEOG CPPTR(1),3 3CC6 GEOPACK 3,3,3 3CWQ OUTPACK 3,1,GEOPER 3DBB LDX 7 PPRINT(1) 3DW2 QEXIT 3F*L LDN 3 1 [ LOAD ROUTING PARAMETER IN ACC. 3FT= INFORMX 3,7,1 3G2D ...X7 3G47 ... LDX 0 AWORK4(2) [RELOAD SIZE OF PROGRAM 3G5W ... STO 0 ACOMMUNE3(2) 3G7L ...#SKI G3 3G#S ... UPPLUS 2 [STARTSTRAT TYPE EXIT 3GG2 ...#SKI G4 3GGT ...( 3GHN ...[ WE NEED TO SET LOCKED BLOCK FOUND BIT IN ACOMMUNE2 AS REPLY 3GJH ...[ FROM COREFREEZE TO GETPROGCORE & STARTSTRAT 3GKB ... LDN 0 #4 3GL9 ... STO 0 ACOMMUNE2(2) 3GM8 ... UP [GETPROGCORE TYPE EXIT 3GPT ...) 3GSG MENDAREA 30,K99COREALLH 3H#6 #END ^^^^ ...22061434000300000000