{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: SCRATCH866)}}
====== SCRATCH866 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:CAPCA|CAPCA]], [[george:macro:CHECKEXT|CHECKEXT]], [[george:macro:CHNUMCON|CHNUMCON]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERR|COMERR]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:EXOFILE|EXOFILE]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HLSXONCH|HLSXONCH]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:PARABEG|PARABEG]], [[george:macro:PARALYSE|PARALYSE]], [[george:macro:PARANUMB|PARANUMB]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|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