(George Source)
Macros used: ACROSS, ALTLEN, CLOSEST, COMBRKIN, DOWN, EXMESS, EXOFILE, FINDCORE, FREECORE, GEOERR, GETCORE, MENDAREA, MFINDEXOF, MFINDSU, MFREE, MHUNTW, MONOUT, MOVLONG, MUSEST, OPENST, OUTPARAM, PROGBRKIN, READST, RELST, SEGENTRY, SETNCORE, STEPBACK, TESTREP, TESTREPNOT, TRACE, TWAIT, UNLOCKSU, USEST
22FL ...#SEG SCEX70 [FRANK BLUNDELL 22^= #LIS K0SCEX 23DW 8HSCEX 23YG # THIS SEGMENT DOES EXTEND AND OPEN SCRATCH FILE 24D6 # IT IS ENTERED FROM SEGMENTS EXTEND AND SCRATCH,IN CPA, 24XQ # WITH PERI OR COMMAND CHECKED AND /GEXD BLOCK SET UP 25CB # 25X2 # 26BL SEGENTRY K1SCEX 26W= MHUNTW 3,EWDAS,GEXD 27*W #SKI K6SCEX>99-99 27TG TRACE BREQ(3),SCEX 28*6 #SKI K6SCEX>299-299 28SQ ( 29#B TRACE EMARK(3),SCEXMARK 29S2 TRACE CEFN(3),SCEXCEFN 2=?L ) 2=R= LDN 0 1 2?=W STO 0 BAVAIL(3) [SET DEFAULT 'LARGEST AREA' 2?QG LDX 0 EMARK(3) 2#=6 BNG 0 SCR [J IF SCRATCH FILE 2#PQ # S-TRUSTED CHECK 2*9B RFIP 2*P2 MFINDEXOF 1,CEFN(3) [FIND OUR EXOF 2B8L LDCT 4 4 2BN= ANDX 4 EXMARK(1) 2C7W SLL 4 6 [GET S-TRUSTED MARKER IN B0 2CMG ORX 4 ALOGLEN(1) [ 2D76 CALL 7 XHOME [GET HOME UNIT ONLINE 2DLQ LDXC 4 4 2F6B BCC REX [J IF NOT S-TRUSTED,ELSE REREAD FIP 2FL2 GETCORE 4,1 2G5L FINDCORE 2 2GK= MHUNTW 3,EWDAS,GEXD 2H4W MFINDEXOF 1,CEFN(3) 2HJG LDN 5 ATYPE(1) 2J46 LDN 6 ATYPE(2) 2JHQ ... ADN 4 A1-ATYPE [COPY OUR EXOF 2K3B ... MOVLONG 5,6,4 [INTO ACTIVITY CHAIN 2KH2 LDN 0 BOPEN+BSPEC+BSERL+BLOCK 2L2L STO 0 EXMARK(2) [SET MARKER,OPEN,GEN/SER SPECIFIEDETC 2LG= LDX 4 EMARK(3) [SAVE EMARK AND 2L^W LDX 5 HMUNIT(3) 2MFG STOZ EMARK(3) [CLEAR FOR 2M^6 DOWN EXOPEN,1 [EXOPEN - FIND FILE 2NDQ TESTREP EXFAIL,XN9 [J IF NOT FOUND OR ERROR 2NYB MHUNTW 3,EWDAS,GEXD 2PD2 MHUNTW 1,EWDAS,EXOF 2PXL LDX 5 HOME(1) [ELSE 2QC= FREECORE 1 [FREE EXOF IN ACTIVITY CHAIN 2QWW MFINDEXOF 1,CEFN(3) 2RBG STO 5 HOME(1) [RESET HOME IN OUR EXOF 2RW6 STO 4 EMARK(3) [RESTORE EMARK 2S*Q REX 2STB MHUNTW 3,EWDAS,GEXD 2T*2 MFINDSU 1,HMUNIT(3) [FIND ITS ASTUC 2TSL LDX 7 CEXTEND(1) 2W#= ADN 7 1 2WRW STO 7 CEXTEND(1) [ADD 1 TO COUNT OF EXTENDS 2X?G OPENST HMUNIT(3) [OPEN HOME UNIT FOR TRANSFERS 2XR6 LDN 4 140 2Y=Q XC2 READST 4,XC1 [READ HEAD OF VACANT CHAIN/NEXT CELL 2YQB TESTREPNOT OK,XN11 [J IF FAIL 2^=2 LDX 1 ECOR(3) 2^PL XC1 LDX 4 0(1) [POINTER TO NEXT CELL 329= BZE 4 XN10 [J IF ZERO,SCA FULL 32NW BCT 7 XC2 [ELSE REDUCE COUNT AND GET NEXT 338G LDX 7 HMUNIT(3) [OK,[COUNT OF EXTENDS] VACANT CELLS 33N6 CLOSEST XC3 [CLOSE DOWN HOME UNIT 347Q #SKI K6SCEX>399-399 34MB ( 3572 TESTREP OK,XC3 35LL XC4 GEOERR 1,CLFAIL? 366= ) 36KW XC3 UNLOCKSU 7 [UNLOCK,BUT DONT RELEASE 375G # 37K6 MHUNTW 3,EWDAS,GEXD [AND 384Q BRN XALT [GO TO ADD AREA 38JB SCR SLL 0 3 3942 BPZ 0 XALT [J UNLESS OPEN 39HL LDX 6 BKSIZE(3) 3=3= SETNCORE FDCELLS-A1+6,1,EWDAS,EXOF [SET UP EXOF FOR NEW SCRFILE 3=GW STOZ A1(1) 3?2G LDN 4 A1(1) 3?G6 LDN 5 A1+1(1) 3?^Q MOVE 4 FDCELLS-A1+5 [ZEROISE 3#FB STOZ BACK1(1) 3#^2 LDN 7 1 3*DL STO 7 COPEN(1) [COUNT OF OPENS=1 3*Y= LDCT 0 #600 3BCW STO 0 EXMARK(1) [MARKER=SCRATCH,OPEN FOR WRITING 3BXG LDCT 0 #200 [IC=1 3CC6 ADN 0 1 [AREAS=1 3CWQ STO 0 FIP+5(1) 3DBB STO 6 FIP+8(1) [BUCKET SIZE 3DW2 STO 7 FBUK(1) [FBUK=1 3F*L LDX 6 1 3FT= EXOFILE 6 [CHAIN IN NEW EXOF 3G#W LDX 1 6 3GSG #SKI K6SCEX>299-299 3H#6 TRACE BACK2(1),SCR EFN 3HRQ LDX 6 BACK2(1) 3J?B MHUNTW 3,EWDAS,GEXD 3JR2 STO 6 CEFN(3) [SAVE EXOFILE NUMBER 3K=L BRN SUNIT [GO TO GET AREA UNIT 3KQ= # 3L9W XALT 3LPG MFINDEXOF 1,CEFN(3) [FIND OUR EXOF 3M96 LDEX 4 FIP+5(1) 3M*3 ... STO 4 5 3MDY ... SBN 5 511 3MJT ... BPZ 5 XN16 3MNQ SLL 4 1 3N8B LDX 5 4 3NN2 SLL 4 1 3P7L ADX 4 5 [AREAS*6 3PM= LDX 5 CEFN(3) 3Q6W LDX 3 4 3QLG ADN 4 FDCELLS-A1+5 3R66 TXL 4 ALOGLEN(1) 3RKQ BCS XAOK [J IF LONG ENOUGH FOR ANOTHER AREA 3S5B #SKI K6SCEX>299-299 3SK2 ( 3T4L SBN 4 6 3TJ= TXL 4 ALOGLEN(1) 3W3W BCS XALT1 3WHG GEOERR 1,EXOFLEN? 3X36 XALT1 ADN 4 6 3XGQ ) 3Y2B ADN 4 1 3YG2 LDX 6 1 3Y^L ALTLEN 6,4 [ELSE ALTLEN 3^F= MFINDEXOF 1,5 3^YW XAOK LDN 0 1 42DG ADS 0 FIP+5(1) [ADD 1 TO COUNT OF AREAS 42Y6 ADN 3 FDCELLS(1) 43CQ LDN 4 1(3) 43XB STOZ 0(3) 44C2 MOVE 3 5 [ZEROISE NEW CELL 44WL SUNIT 45B= ACROSS NEXTUNIT,1 [GO TO GET AREA UNIT 45TW # 46*G # 46T6 # 47#Q # S/R TO GET HOME UNIT ONLINE AND LOCKED 47SB # 48#2 XHOME 48RL SBX 7 FX1 49?= MHUNTW 3,EWDAS,GEXD 49QW LDX 5 HMUNIT(3) [GET SUSN 4==G LDCT 6 #10 4=Q6 ANDX 6 EMARK(3) [AND MODE *4000 MARKER 4?6L ...#UNS IPBD 4?H6 ...XH5A USEST 5,XH1,,XH5,XH4A [GET UNIT LOCKED IF ONLINE 4?XL ...#UNS IPBD 4##6 ...#SKI 4#NL USEST 5,XH1,,XH5,XH4 [IS UNIT ONLINE,LOCK IF SO 4*8= XH2 ADX 7 FX1 [EXIT 4*MW EXIT 7 0 4B7G XH1 BZE 6 XH3 [NOT ONLINE,J UNLESS SUPRESS LOAD 4BM6 LDCT 7 #400 4C6Q ORN 7 6 [SET REPLY 6 4CLB BRN XN7 [AND END 4D2W ...#UNS IPBD 4DCB ...XH3 MUSEST 5,XH4,XH5,,XH4A [DEMAND UNIT 4DRW ...#UNS IPBD 4F8B ...#SKI 4FJW XH3 MUSEST 5,XH4,XH5,,XH4 [GET UNIT ONLINE 4G4G BRN XH2 [EXIT IF GOT 4G64 ...#UNS IPBD 4G7L ...( 4G98 ...# 4G=Q ...# IPB DOWN 4G## ...# 4G*W ...XH4A TWAIT 5,XH5 [WAIT FOR IPB 4GCD ... BRN XH5A [TRY AGAIN 4GF2 ...# 4GGJ ...) 4GJ6 XH4 LDCT 7 #440 [REPLY FAIL IF CANTDO 4H3Q BRN XN7 4HHB XH5 MHUNTW 3,EWDAS,GEXD [IF BREAKIN 4J32 LDCT 6 #100 4JGL ANDX 6 EMARK(3) 4K2= FREECORE 3 [FREE GEXD 4KFW BZE 6 XH6 [J PERI 4K^G COMBRKIN [AND 4LF6 XH6 STEPBACK [ACKNOWLEDGE 4LYQ PROGBRKIN [BREAKIN 4MDB # 4MY2 # 4NCL # 4NX= # FAIL TO GET HOME UNIT,REPLY IN X7 4PBW XN7 MHUNTW 3,EWDAS,GEXD 4PWG LDX 4 CNR(3) 4QB6 LDX 5 EXCHNL(3) 4QTQ FREECORE 3 [FREE GEXD 4R*B XN13 EXMESS ALL [MESSAGES 4RT2 ACROSS NEXTUNIT,4 [SET REPLIES AND END 4S#L # FAIL IN REREADING FIP (S-TRUSTED) 4SS= XN9 MFREE EWDAS,EXOF [FREE COPY OF EXOF IN ACTIVITY CHAIN 4T?W UNLOCKSU 5 [UNLOCK AND 4TRG RELST 5 [RELEASE HOME UNIT 4W?6 LDCT 7 #440 [SET FAIL REPLY 4WQQ BRN XN7 [AND END 4X=B # 4XQ2 XN10 LDCT 7 #400 [SET REPLY SCA FULL 4Y9L MHUNTW 3,EWDAS,GEXD 4YP= CLOSEST XN12 [CLOSE DOWN 4^8W #SKI K6SCEX>399-399 4^NG TESTREPNOT OK,XC4 5286 BRN XN12 [AND GO TO END (EVEN IF FAIL) 52MQ # 537B XN11 LDCT 7 #440 [SET FAIL REPLY 53M2 XN12 MHUNTW 3,EWDAS,GEXD 546L MFINDSU 1,HMUNIT(3) [FIND ASTUC FOR HOME UNIT 54L= LDN 0 1 555W SBS 0 CEXTEND(1) [SUBTRACT 1 FROM COUNT OF EXTENDS 55KG #SKI K6SCEX>399-399 5656 ( 56JQ LDX 0 CEXTEND(1) 574B BNG 0 XC4 57J2 ) 583L LDX 4 CNR(3) 58H= LDX 5 EXCHNL(3) 592W LDX 6 HMUNIT(3) 59GG FREECORE 3 [FREE GEXD 5=26 UNLOCKSU 6 [UNLOCK 5=FQ RELST 6 [AND RELEASE HOME UNIT 5=^B BRN XN13 [AND END 5?98 ...# ROUTINE TO OUTPUT MESSAGE + ERROR CODE FOR > 511 FILE AREAS 5?F2 5?YL # 5#D= # 5#DT ...REP1 #40000003 5#FD ...XN16 MHUNTW 3,EWDAS,GEXD 5#G3 ... LDX 4 CNR(3) 5#GL ... LDX 5 EXCHNL(3) 5#H9 ... LDX 0 EMARK(3) 5#HS ... BNG 0 XN18 5#JC ... LDX 6 HMUNIT(3) 5#K2 ... MFINDSU 1,6 5#KK ... LDN 0 1 5#L8 ... SBS 0 CEXTEND(1) 5#LR ... RELST 6 5#MB ... LDX 2 FX2 5#M^ ... MFINDEXOF 1,CEFN(3) 5#NJ ... LDN 7 FIP(1) 5#P7 ... LDN 0 ACOMMUNE1(2) 5#PQ ... MOVE 7 3 5#Q* ... LDN 7 12 5#QY ... OUTPARAM 7,ACOMMUNE1 5#RH ... MONOUT EWTMFI 5#RS ... MHUNTW 3,EWDAS,GEXD 5#S6 ... FREECORE 3 5#SP ...XN17 LDX 7 REP1(1) 5#T# ... BRN XN13 5#TX ...XN18 FREECORE 3 5#WG ... MONOUT EWTMSC 5#X5 ... BRN XN17 5#XW MENDAREA 40,K99SCEX 5*CG #END ^^^^ ...01375113000300000000