(George Source)
Macros used: ACROSS, CAPCA, CHECKEXT, CHNUMCON, COMBRKIN, COMERR, COMERRX, ENDCOM, EXOFILE, FOUTMOVE, FREECORE, GEOERR, HLSXONCH, ILLEGAL, MENDAREA, MFREEW, MHUNT, MHUNTW, MONOUT, OUTNUM, OUTPACK, PARABEG, PARALYSE, PARANUMB, PARAPASS, PHOTO, PROGBRKIN, SEGENTRY, SETNCORE, SETUPCORE, STEPBACK, TESTMOVE, TESTREP, TESTREPNOT
22FL ...#SEG SCRATCH70 [FRANK BLUNDELL 22^= #LIS K0SCRATCH 23DW 8HSCRATCH 23YG # 24D6 # THIS ROUTINE ANALYSES THE ONLINE COMMAND AND OPEN 24XQ # PERI FOR A SCRATCH 25CB # IF IT IS A ZERO LENGTH FILE IT SETS UP AN EXOF 25X2 # AND GOES TO ANTIC TO CONNECT THE FILE 26BL # IF NOT IT GOES ACROSS 26W= # TO GET AN AREA 27*W # 27TG # K1SCRATCH DEALS WITH PERI 28*6 # ON ENTRY:- 28SQ # X4 B0-B9 TYPE 29#B # B14-B23 UNIT NO. 29S2 # 2=?L # X5 COPY OF FIRST WORD OF C/A 2=R= # EVENT2 (XCA) CONTAIN CONTROL ARE ADDRESS 2?=W # 2?QG #DEF XCA=EVENT2 2#=6 # 2#PQ SEGENTRY K1SCRATCH,QK1SCRATCH 2*9B SEGENTRY K2SCRATCH,QK2SCRATCH 2*P2 # 2B8L # 2BN= XMASK #777777 2C7W XGIVE +4,4HGIVE 2CMG XMAYBE +5,5HMAYBE 2D76 # 2DLQ # COMMAND ERROR MESSAGES 2F6B XERTAB 2FL2 +JPARMIS [PARAMETER MISSING 2G5L +JEXNOB [NO BLOCKS PARAMETER 2GK= +JEXBLK [-VE BLOCKS 2H4W +JEXCSN [ILLEGAL SERIAL NO. 2HJG +JEXBUK [BUCKET SIZE OUT OF RANGE 2J46 +ERUNPAIR [UNPAIRED BRACKETS 2JHQ # 2K3B # 2KH2 QK1SCRATCH 2L2L #SKI K6SCRATCH>199-199 [CHECK DATA 2LG= ( 2L^W LDX 0 5 [CHECK TYPE 2MFG SRL 0 15 2M^6 ANDN 0 #377 2NDQ SBN 0 6 [6,7,13 2NYB BZE 0 YA 2PD2 SBN 0 1 2PXL BZE 0 YA 2QC= SBN 0 6 2QWW BZE 0 YA 2RBG SBN 0 13 2RW6 BZE 0 YA 2S*Q YAA GEOERR 1,SCRPERI 2STB YA 2T*2 ) 2TSL LDN 7 5 2W#= CHECKEXT XCA(2),7,XVIOL,,W,YB,HLOCK1 [CHECK RESERVATIONS 2WRW YB SETNCORE GEXDLENX,3,EWDAS,GEXD 2X?G STOZ A1(3) 2XR6 LDN 5 A1(3) [SET UP AND ZEROIZE GEXD 2Y=Q LDN 6 A1+1(3) 2YQB MOVE 5 GEXDLENX-1 2^=2 #SKI GENIE<1$1 2^PL ( 329= SRL 4 9 32NW DEX 4 EXCHNL(3) [STORE CHANNEL 338G ) 33N6 #SKI GENIE 347Q ( 34MB ANDN 4 #1777 3572 STO 4 EXCHNL(3) [STORE CHANNEL 35LL ) 366= LDN 0 1 36KW STO 0 GIVEX(3) [GIVE MARKER 375G LDN 0 #600 37K6 STO 0 EOPMODE(3) [STORE OPEN MODE 384Q LDX 4 XCA(2) 38JB STO 4 CNR(3) [CONTROL AREA ADDRESS 3942 LDCT 0 #640 39HL STO 0 EMARK(3) [SCRATCH,NOT #1500,OPEN MARKERS 3=3= LDN 5 ACOMMUNE1(2) 3=GW FOUTMOVE 2,4,5,7,HLOCK1 [MOVE OUT C/A 3?2G LDX 0 ACOMMUNE1(2) 3?G6 ANDN 0 #6000 3?^Q SLL 0 7 3#FB ORS 0 EMARK(3) [ADDITIVE MODE SETTINGS 3#^2 LDN 5 3 [WORD 3 OF C/A 3*DL LDX 0 ACOMMUNE4(2) [BLOCKS REQUIRED 3*Y= BNG 0 YC [JUMP IF BLOCKS -VE 3BCW ADN 0 7 3BXG NGN 4 #10 [ROUND UP TO MULTIPLE OF 8 3CC6 ANDX 0 4 3CWQ STO 0 BREQ(3) 3DBB LDN 4 4 3DW2 LDN 5 1 [CHECK BUCKET SIZE 1,2,4,8 3F*L YD TXU 5 ACOMMUNE3(2) 3FT= BCC YE 3G#W SLL 5 1 3GSG BCT 4 YD 3H#6 LDN 5 2 [WORD 2 OF C/A 3HRQ YC FREECORE 3 [FREE GEXD 3J?B CAPCA [TO OUTPUT PARAMETER 3JR2 OUTNUM 5,0 [OUTPUT ADDRESS 3K=L #SKIP ILL7<1$1 3KQ= PCACA 3L9W ILLEGAL EDEXT 3LPG # 3M96 YE STO 5 BKSIZE(3) 3MNQ LDX 0 ACOMMUNE5(2) [GET SERIAL NUMBER 3N8B ANDX 0 XMASK(1) 3NN2 STO 0 CSNTAB(3) [STORE IN GEXD 3P7L YG CAPCA EWDAS,GEXD [TO CPA TAKING GEXD 3PM= MHUNTW 3,EWDAS,GEXD 3Q6W BRN YH 3QLG # 3R66 XVIOL ILLEGAL NOCA 3RKQ # 3S5B # 3SK2 # 3T4L # K2SCRATCH IMPLEMENTS ONLINE COMMAND FOR SCRATCH FILES 3TJ= # FIRST PARAMETER HAS BEEN ANALYZED AND RESULT IS IN CPAR/GPERCON 3W3W # BLOCK:- 3WHG # A1 B0-B5 TYPE 3X36 # B18-B23 CHANNEL 3XGQ # A1+1 MODE (#600) 3Y2B # 3YG2 # 3Y^L # 3^F= QK2SCRATCH 3^YW MHUNTW 3,CPAR,GPERCON 42DG #SKI K6SCRATCH>199-199 42Y6 ( 43CQ LDX 0 A1(3) [CHECK TYPE 43XB #SKI GENIE 44C2 SRL 0 15 44WL #SKI GENIE<1$1 45B= SRL 0 18 [6,OR 13 45TW SBN 0 6 46*G BZE 0 XA 46T6 SBN 0 7 47#Q BZE 0 XA 47SB XB GEOERR 1,SCRONL 48#2 XA LDX 0 A1+1(3) [AND MODE 48RL SBN 0 #600 49?= BNZ 0 XB 49QW ) 4==G LDX 4 A1(3) 4=Q6 FREECORE 3 4?9Q SETNCORE GEXDLENX,3,EWDAS,GEXD 4?PB LDN 6 A1(3) [ZEROIZE GEXD 4#92 LDN 7 A1+1(3) 4#NL STOZ A1(3) 4*8= MOVE 6 GEXDLENX-1 4*MW #SKI GENIE 4B7G ANDX 4 BSP16 4BM6 #SKI GENIE<1$1 4C6Q ANDN 4 #77 4CLB STO 4 EXCHNL(3) 4D62 LDN 0 #600 4DKL STO 0 EOPMODE(3) [OPEN MODE 4F5= LDCT 0 #740 4FJW STO 0 EMARK(3) [MARKERS-SCRATCH,NOT#1500,ONLINE,OPEN 4G4G LDN 6 0 [TO HOLD GIVE,MAYBE MARKERS 4GJ6 PHOTO 7 4H3Q LDN 4 0 [ANALYSIS LEVEL 4HHB LDN 5 2 [PARAMETER 2 4J32 PARALYSE ,4,5 4JGL ... TESTREP UNPAIR,XC,TOOMANY,XC 4K2= LDN 4 1 [LEVEL 1 4KFW PARANUMB 5,4 [X5 CONTAINS NUMBER OF PARAMETERS 4K^G BPZ 5 XD 4LF6 GEOERR 1,SCRMULT [ERROR IF NO MULTI BLOCK 4LYQ XD BZE 5 XE [COMERR IF NO 2ND PARAMETER 4MDB SBN 5 1 [JUMP IF ONLY 1 PARAMETER 4MY2 BZE 5 XF [-NO QUALIFIERS 4NCL # 4NX= LDN 5 2 4PBW PARALYSE #34,4,5 4PWG ... TESTREP UNPAIR,XC,TOOMANY,XC [ANALYSE QUALIFIERS 4QB6 LDN 4 2 [LEVEL 2 -EACH PARAMETER IS A 4QTQ [QUALIFIER 4R*B PARABEG 1,XMAYBE(1),,4 [LOOK FOR MAYBE 4RT2 MHUNT 1,CPB,CUNI 4S#L LDX 0 ANUM(1) 4SS= BNG 0 XG [JUMP IF NO MAYBE QUALIFIER 4T?W LDCT 6 #400 4TRG XG LDX 1 FX1 4W?6 PARABEG 1,XGIVE(1),,4 [LOOK FOR GIVE 4WQQ MHUNT 1,CPB,CUNI 4X=B LDX 0 ANUM(1) 4XQ2 BNG 0 XH [JUMP IF NOT THERE 4Y9L ORN 6 1 4YP= XH LDN 4 1 4^8W LDN 5 1 [LEVEL 1,PARAMETER 1 4^NG PARALYSE ,4,5 5286 ... TESTREP UNPAIR,XC,TOOMANY,XC 52MQ LDN 4 2 537B XF PARAPASS 4 [GET NUMBER STRING IN UNI BLOCK 53M2 MHUNT 1,CPB,CUNI 546L LDX 0 ANUM(1) 54L= BZE 0 XE [JUMP IF 2ND PARAMETER NULL 555W BNG 0 XE [OR NONEXISTANT 55KG CHNUMCON [CONVERT STRING 5656 TESTMOVE 7,XJ 56JQ MHUNTW 3,EWDAS,GEXD 574B XJ TESTREPNOT OK,XK [JUMP IF REPLY NOT OK 57J2 STO 6 GIVEX(3) [STORE GIVE MARKER 583L LDCT 0 #400 58H= ORS 0 GIVEX(3) [SET ONLINE MARKER 592W SRL 6 4 59GG ORS 6 EMARK(3) [SET MAYBE MARKER 5=26 MHUNT 1,CPAR,GNUMCON 5=FQ LDX 7 A1(1) 5=^B SBN 7 2 5?F2 LDN 6 1 [MARKER-NO BLOCKS PARAMETER 5?YL BNG 7 XL [JUMP IF NO BLOCKS 5#D= LDN 0 6 5#XW SBX 0 7 [ 5*CG BPZ 0 XMA [JUMP IF 6 OR LESS SERIAL NOS 5*X6 LDN 7 6 [IGNORE ANY OVER SIX 5BBQ XMA STO 7 CSNCT(3) [STORE COUNT OF SUSNS 5BWB LDN 6 2 [ERROR- -VE BLOCKS MARKER 5CB2 LDX 0 A1+1(1) 5CTL BNG 0 XL 5D*= NGN 4 #10 5DSW ADN 0 7 [ROUND UP TO MULTIPLE OF 8 5F#G ANDX 0 4 5FS6 STO 0 BREQ(3) 5G?Q LDN 4 4 5GRB LDN 5 1 5H?2 LDN 6 4 [CHECK BUCKET SIZE 1,2,4,8 5HQL XN TXU 5 A1+2(1) 5J== BCC XM 5JPW SLL 5 1 5K9G BCT 4 XN 5KP6 BRN XL [ERROR IF NOT 5L8Q XM STO 5 BKSIZE(3) 5LNB BZE 7 XP [JUMP IF NO SERIAL NO.S 5M82 LDN 6 3 [MARKER- ILLEGAL SERIAL NO. 5MML XQ SMO 7 5N7= LDX 0 A1+2(1) [MOVE SERIAL NOS TO GEXD 5NLW SMO 7 5P6G STO 0 CSNTAB-1(3) 5PL6 BZE 0 XL [ERROR IF ZERO 5Q5Q SRL 0 18 5QKB BNZ 0 XL [OR MORE THAN 6 OCTAL DIGITS 5R52 BCT 7 XQ 5RJL XP FREECORE 1 [FREE GNUMCON BLOCK 5S4= # 5SHW # 5SLN ...YH 5SPG ...#UNS JWPHASE4 5SS# ...( 5SX6 ... LDCT 5 6 [*DA 5S^Y ... ADX 5 EXCHNL(3) [TYPE-UNIT NO 5T4Q ... LDX 7 GIVEX(3) [X7 -VE IF COMMAND 5T7J ... HLSXONCH XBRK,5,XER1 [SEE IF OK WITH HLS TO CARRY ON 5T=B ... MHUNTW 3,EWDAS,GEXD 5T*8 ...) 5T*M ...#UNS ES2 5TB6 ...( 5TBK ... LDCT 0 #400 [SET B0=1 TO INDICATE THAT 5TC4 ... STO 0 EXOTRAP(3) [EXOFILE IS INSECURE 5TCH ...) 5TD2 ... LDX 0 BREQ(3) 5TH6 BZE 0 ZA [JUMP IF ZERO LENGTH FILE 5TJ9 ...#UNS IPBD 5TK# ...( 5TLC ... LDCT 0 #100 5TMG ... ANDX 0 EMARK(3) 5TNK ... BZE 0 NOL 5TPN ... SETUPCORE ALOGLEN(3),3,EWDAS,ASCOL [COPY GEXD 5TQR ... MHUNTW 1,EWDAS,GEXD 5TRW ... LDN 2 A1(1) 5TS^ ... LDN 3 A1(3) 5TW4 ... SMO ALOGLEN(1) 5TX7 ... MOVE 2 0 5TY= ...NOL 5T^* ...) 5W2Q ACROSS SCEX,1 5WGB # 5X22 # SET UP EXOF FOR ZERO LENGTH FILE 5XFL # 5X^= ZA PHOTO 7 5YDW SETNCORE FDCELLS-A1,2,EWDAS,EXOF [GET EXOF 5YYG TESTMOVE 7,ZB 5^D6 MHUNTW 3,EWDAS,GEXD 5^XQ ZB LDN 6 A1(2) 62CB LDN 7 A1+1(2) 62X2 STOZ A1(2) 63BL MOVE 6 FDCELLS-A1-1 [AND ZEROIZE 63W= LDCT 0 #200 64*W STO 0 EXMARK(2) [SET SCRATCH BIT 64TG LDN 0 1 65*6 STO 0 COPEN(2) [COUNT OF OPENS=1 65SQ STO 0 FBUK(2) [LAST LBN 66#B LDX 0 BKSIZE(3) 66S2 STO 0 FIP+8(2) [BUCKET SIZE 67?L LDX 7 2 67R= EXOFILE 7 [CHAIN INTO EXOF CHAIN 68=W SMO 7 68QG LDX 0 BACK2 [EXOFILE NUMBER 69=6 STO 0 CEFN(3) [SAVE IN GEXD 69PQ ACROSS ANTIC,1 [GO TO CONNECT FILE1 TO PROGRAM 6=9B # 6=P2 # 6?8L # ERROR CASES 6?N= # 6#7W XE LDN 6 0 [PARAMETER MISSING 6#MG BRN XEA 6*76 XC LDN 6 5 [UNPAIRED BRACKETS 6*LQ XEA TESTMOVE 7,XCB 6B6B MHUNTW 3,EWDAS,GEXD 6BL2 BRN XCB 6C5L XL FREECORE 1 [GNUMCON BLOCK 6CK= XCB FREECORE 3 [GEXD 6D4W SMO 6 6DJG LDX 6 XERTAB(1) [GET COMMAND ERROR MESSAGE IDENTIFIER 6F46 COMERRX 6 6FHQ # 6FJ# ...#UNS JWPHASE4 6FJW ...( 6FKD ...XBRK 6FL2 ... NGNC 6 1 [X6 -VE FOR BREAKIN 6FLJ ...XER1 6FM6 ... LDN 6 0 [X6=0 FOR REJECT 6FMN ... MFREEW EWDAS,GEXD 6FN= ... BZE 6 XER2 [J IF REJECT 6FNS ... BNG 7 VCOM [J IF COMMAND 6FPB ... STEPBACK 6FPY ... PROGBRKIN 6FQG ...VCOM 6FR4 ... COMBRKIN 6FRL ...[ 6FS8 ...[ HLS HAS DENIED ACQUISITION 6FSQ ...[ 6FT# ...XER2 6FTW ... BNG 7 XER3 6FWD ... MONOUT EWHLSRJ 6FX2 ...XPAR 6FXJ ... OUTPACK 5,1,PERINAME,XPAR [*DA 6FY6 ... ILLEGAL PERFAIL 6FYN ...XER3 6F^= ... COMERR ERHLSONL 6F^S ...# 6G2B ...) 6G3B XK TESTREPNOT CHNUMERR,XKA 6GH2 FREECORE 3 6H2L ENDCOM 6HG= # 6H^W XKA GEOERR 1,SCRCHUM 6JFG # 6J^6 # 6KDQ MENDAREA 30,K99SCRATCH 6KYB #END ^^^^ ...25546107000100000000