{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: STEP864)}}
====== STEP864 ======
(George Source)
**Macros used:** [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:ANSOK|ANSOK]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:FDRMCHECK|FDRMCHECK]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:LABFIX|LABFIX]], [[george:macro:LONGON|LONGON]], [[george:macro:MAPBCH|MAPBCH]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SETREP|SETREP]], [[george:macro:SFUB|SFUB]], [[george:macro:SKIPTRACE|SKIPTRACE]], [[george:macro:STEP|STEP]], [[george:macro:TESTUSEJ|TESTUSEJ]], [[george:macro:TOPFCA2|TOPFCA2]]
22FL ...#SEG STEP [M.J.VELLACOTT
22^= ...#OPT K0STEP=0
23DW ...#LIS K0STEP>K0ACCESS>K0FILE>K0KERNEL>K0ALLGEO
23YG ...#OPT K6STEP=K6ACCESS>K6FILESTORE>K6KERNEL>K6ALLGEO
24D6 #
24XQ # THIS FIXED CORE SEGMENT IMPLEMENTS THE "STEP" MACROS
25CB # IN THE "READ" CASE IT SETS A POINTER IN X3 TO THE NEXT RECORD IN
25X2 # THE FILE OPEN AT DEPTH %A (0 IF %A MISSING).X3=0 IF WE STEP OFF
26BL # THE END OF FILE. THE STEP(APPEND)CASE INVOLVES MAKING SURE THE
26W= # LAST BLOCK OF THE FILE IS IN CORE,OR A NEW ONE,IF NEEDED.AS WE
27*W # GIVE THE CALLING ROUTINE A PTR. TO WHERE HE CAN APPEND A RECORD
27TG # OF LENGTH %B. IF WE HAVE TO READ A BLOCK DOWN, IN THE"READ"CASE
28*6 # WE GO TO 'READFILE', IN THE"APPEND"CASE TO 'APPEND'.
28SQ #
29#B # ON ENTRY IN X3,B0-8=DEPTH,B9-23=0 IN READ CASE
29S2 # =LENGTH OF RECORD TO BE APPENDED
2=?L # IN APPEND CASE
2=R= # THE ROUTINE USES X0,X1,X2,X3 ONLY. ON EXIT X1=FX1,X2=FX2
2?=W #
2?QG #DEF MCOMCOM=COMCOM [#01000100
2#=6 #DEF MCOMUNI=COMUNI [#17770000
2#PQ ZGEOER1B
2*9B LDN 0 1
2*P2 ADS 0 FFX3
2B8L ZGEOER1A
2BN= LDX 0 HVSKIP [J TO GEOERR IF NOT VSKIP
2C7W BPZ 0 ZGEOER1
2CMG LDN 3 -1
2D76 ANDX 3 FFX3 [SET X3 = UNEXPIRED COUNT OF RECORDS
2DLQ SETREP ENDFILE [TO BE SKIPPED
2F6B BRN TIDYUP [GO TO END
2FL2 ZGEOER1
2G5L GEOERR 0,ENDFILE
2GK= ZGEOER2
2H4W GEOERR 0,REC BIT
2HJG ZGEOER3
2J46 GEOERR 0,SKIPZERO
2JHQ ZGEOER5
2K3B GEOERR 0,STEPDEEP
2KH2 ZGEOER6
2L2L GEOERR 0,BEG FILE
2LG= ZGEOER7
2L^W GEOERR 0,APP REC!
2MFG ZGEOER8
2M^6 GEOERR 0,RECHD!
2NDQ #
2NF8 ...# THIS CHECKS A BLOCK OF A SERIAL FILE FOR CORRUPTNESS
2NFL ...# ON ENTRY X1->FCB ,X2->USAGE BLOCK
2NG4 ...XACHBL
2NGG ... LABFIX ACHBL
2NGY ... FIXTRA K1STEP
2NHB ... STO 0 GEN0
2NHS ... BRN XACHBLMERGE
2NJ= ... NULL
2NJN ... NULL
2NK6 ... BRN XACHBLMERGE
2NKJ ...XACHBLW
2NL2 ... LABFIX ACHBLW
2NLD ... FIXTRA K2STEP
2NLW ... STO 0 GEN0
2NM# ...XACHBLMERGE
2NMQ ... JBC (GEN0),1,BFSER [J IF NON-SERIAL FILE
2NN8 ... LDN 1 0
2NNL ...XGETNXT
2NP4 ... SMO 2
2NPG ... LDXC 0 A1(1)
2NPY ... BCC RHADD [J IFNOT DUMMY
2NQB ... ANDX 0 BRHMASK
2NQS ... BNZ 0 XITA [ILLEGAL BITS SET
2NR= ... SMO 2
2NRN ... LDEX 0 A1(1)
2NS6 ... BZE 0 XITA [J IF B0 ONLY SET
2NSJ ...RHADD
2NT2 ... BZE 0 (GEN0) [J ,OK AT END OF BLOCK
2NTD ... ADX 1 0
2NTW ... BXGE 1 BSBS,XITA [J IF X1 +512
2NW# ... BRN XGETNXT
2NWQ ...XITA
2NX8 ... LDX 0 GEN0
2NXL ... EXIT 0 1
2NYB # SUBROUTINE TO SEARCH FORWARD ALONG THE RING
2PD2 # DEPTH IN X3
2PXL SFFORWARD
2QC= LABFIX ASFSTACKF
2QWW LDX 2 FILERING(2) [PICK UP PTR. IN ACT. BLK.
2RBG BZE 3 SFEXIT1 [J IF ZERO DEPTH
2RW6 SFFORLP
2S*Q LDX 2 FPTRF(2) [PICK UP NEX POINTER IN RING
2STB BCT 3 SFFORLP [AND LOP FOR NEXT PTR
2T*2 SFEXIT1
2TSL EXIT 0 1 [EXIT ROUND OTHER CALL
2W#= # SUBROUTINE TO SEARCH BACKWARD DOWN RING
2WRW #
2X?G SFBAKWARD
2XR6 LABFIX ASFSTACKB
2Y=Q LDX 2 FILERING+1(2) [PICK UP BPTR.OF FILERING IN ACT.BLK.
2YQB SFBAKLP
2^=2 ADN 3 1 [NEG. LOOPING
2^PL BZE 3 SFEXIT2 [EXIT IF FOUND RIGHT ELEMENT
329= LDX 2 BPTRF(2) [LOAD BACK. PTR.
32NW BRN SFBAKLP
338G SFEXIT2
33N6 EXIT 0 0
347Q #
34MB # CHECKS DEPTH IS OK
3572 #
35LL #SKI K6STEP
366= (
36KW SCHEEP
375G STO 1 GEN0 [STORE LINK
37K6 STO 3 GEN6
384Q BPZ 3 NONG
38JB NGX 3 3
3942 BRN NONG1
39HL NONG
3=3= ADN 3 1
3=GW NONG1
3?2G FILENUMB 0 [X0 = NO OF FILES OPEN
3?G6 SBX 0 3
3?^Q BNG 0 ZGEOER5
3#FB LDX 3 GEN6
3#^2 BRN (GEN0)
3*DL )
3*Y= #
3BCW #
3BXG QLASTBL
3CC6 # EXITS NORMALLY IF FREADBLOCK -> LAST BLOCK
3CWQ # EXITS +1 O/W.
3DBB # ON ENTRY X3 -> FCB,X2->FCA
3DW2 LDN 0 A1-1
3F*L ADX 0 FBLMOD(3)
3FT= SBX 0 FREADBLOCK(2)
3G#W BZE 0 (1)
3GSG EXIT 1 1
3H#6 #
3HRQ PSTFCB
3J?B # SETS X1-> FSTACK;X3 ->FCB.
3JR2 # ON ENTRY X2 -> FCA
3K=L PSTAC 1,2
3KQ= BFCBX 3,1
3L9W EXIT 0 0
3LPG # USE OF GEN WORDS
3M96 #
3MNQ # ALL MACROS
3N8B # GEN0 - OVERWRITTEN BY SCHEEP S/R.
3NN2 #
3P7L # STEP
3PM= #
3Q6W # GEN0 - POINTER TO USAGE BLOCK
3QLG # GEN2 - SAVES X2 OVER TESTUSEJ MACRO
3R66 # GEN3 - R.H. OF RECORD LAST READ
3RKQ #
3S5B # STEP (APPEND)
3SK2 #
3T4L # GEN0 - POINTER TO USAGE BLOCK
3TJ= # GEN1 - POINTER TO FCB
3W3W # GEN2 - IF CMOD<0 ON ENTRY,THE LOOP THAT CALCULATES IT OVER-
3WHG # - WRITES IT
3X36 # GEN3 - PRESERVES PTR TO FCA OVER LONGON. NB - LONGON USES GEN6
3XGQ # GEN4 - THE VALUE OF CMOD ON ENTRY.
3Y2B # GEN6 - PRESERVES THE POINTER TO THE FCA OVER THE MAPBCH MACRO.
3YG2 #
3Y^L # STEPAGAIN
3^F= #
3^YW # GEN0 - POINTER TO USAGE BLOCK
42DG #
42Y6 # VSKIP PRE & POST COORDINATION ENTRIES
43CQ LABFIX AVSKIP1
43XB # BEFORE COORDINATINO
44C2 NGS 1 HVSKIP [SET HVSKIP MARKER
44WL BRN SKIPMERJ
45B= LABFIX AVSKIP2
45TW # AFTER COORDINATINO
46*G NGS 1 HVSKIP
46T6 BRN VSKRED
47#Q #
47SB # SKIP MACRO ENTRIES.POST COORDINATION ENTRIES MADE AT ASTEP2&4
48#2 LABFIX ASKIP1
48RL # ENTRY - ANY DEPTH,NOT YET COORDINATED
49?= STOZ HVSKIP [UNSET MARKER
49QW SKIPMERJ
4==G LDX 3 0
4=Q6 #SKI K6STEP
4?9Q (
4?PB ANDN 0 -1
4#92 BZE 0 ZGEOER3
4#NL ADDSKIP I516A,ISKIP
4*8= )
4*MW ANSOK [SET OK REPLY
4B7G ADN 1 ASTEPQ [STEP ON LINK
4BM6 LDX 2 FX2
4C6Q VSKJN
4CLB SBN 3 1 [DOWNDATE COUNT OF
4D62 BRN VSKRED
4DKL #
4F5= #
4FJW LABFIX AREAD3
4G4G # ENTRY: DEPTH %A;NOT YET COORDINATED.
4GJ6 ANSOK
4H3Q ADN 1 ASTEPQ [LINK TO JUMP OVER REST OF MACRO
4HHB LDX 2 FX2
4J32 LABFIX AREAD4
4JGL # ENTRY: DEPTH %A;JUST READ A BLOCK DOWN.
4K2= STOZ HVSKIP [UNSET MARKER
4KFW VSKRED
4K^G STO 3 FFX3 [PRESERVE DEPTH
4LF6 STO 1 FFWORKLINK [PRESERVE LINK
4LYQ SRA 3 15 [CONVERT DEPTH
4MDB BZE 3 STNZZER [J IF SKIP 0,1 OR STEP 0
4MY2 #SKI K6STEP
4NCL CALL 1 SCHEEP [CHECK DEPTH
4NX= BNG 3 SHUNTBACK [J IF DEPTH NEGATIVE
4PBW CALL 0 SFFORWARD [HUNT FORWARD IF POS
4PWG SHUNTBACK
4QB6 CALL 0 SFBAKWARD [HUNT BACKWARD IF NEG
4QTQ BRN STEPTOGETHR
4R*B LABFIX AREAD1
4RT2 # ENTRY %A MISSING;NOT YET COORDINATED
4S#L ANSOK [REPLY OK
4SS= ADN 1 ASTEPQ [ADJUST LINK
4T?W LDX 2 FX2
4TRG LABFIX AREAD2
4W?6 # ENTRY %A MISSING;JUST READ BLOCK DOWN
4WQQ STO 1 FFWORKLINK [STORE LINK
4X=B STOZ FFX3 [ZEROISE DEPTH
4XQ2 STOZ HVSKIP
4Y9L STNZZER
4YP= TOPFCA2 2 [X2 -> FCA
4^8W STEPTOGETHR
4^NG ADDSKIP I516A,ISTEP
5286 PSTAC 1,2 [X1-> FSTACK
52MQ PIKFUBNO
537B LDX 3 FREADBLOCK(2) [BLOCK POINTER
53M2 BPZ 3 T59 [J IF READ FROM FILE BEFORE
546L # THIS LAST LINE WORKS FOR A "STEPPED ON" EMPTY FILE,FOR EITHER
54L= # THE FILE'S LAST RECORD HAS JUST BEEN DELETED(IN WHICH CASE THERE
555W # WILL BE NO USAGE BLOCK) OR THE BLOCK DOESN'T BELONG TO THE FILE,OR
55KG # ISN'T A LEGAL BLOCK NUMBER
5656 LDN 3 FBLKS [SET EQUAL TO FBLKS
56JQ STO 3 FREADBLOCK(2)
574B T59
57J2 # ! ASSUMES FSTACK BEHIND FCB
583L ADX 3 BPTR(1) [ADD POINTER TO FCB X3-> BLOCK NUM.
58H= SKIPTRACE 699 ,FREADBLOCK(2),THISBLK
592W PIKF
59GG SFUB 1,0(3),1,MUSTCOOR [FIND USAGE BLOCK,JUMP TO"MUSTCOOR" IF ABSE
5=26 # X1 -> USAGE BLOCK
5=FQ # X2 => ELEMENT
5=^B #
5?F2 STO 1 GEN0 [PRESERVE
5?YL LDX 3 FREADWORD(2)
5#D= BPZ 3 STEPPED [CANNOT BE ZERO-J IF HAVE ALREADY READ FR
5#XW LDN 3 A1 [THIS BLOCK. OTHERWISE SET FREADWORD & X3
5*CG STO 3 FREADWORD(2) [TO 1ST RECORD IN BLOCK
5*X6 ADX 3 1 [-> 1ST RECORD IN BLOCK
5BBQ STO 3 GEN3
5BWB BRN ZEMPTYBL
5CB2 STEPPED
5CTL ADX 3 1 [X3 -> LAST RECORD READ.
5D*= SKIPSTEP
5DSW LDXC 0 FRH(3)
5F#G BCC NDUM9 [J IF NOT DUMMY
5FS6 YDUM9
5G?Q ANDX 0 BRHMASK
5GRB BNZ 0 ZGEOER8 [OR T99 IF FDUD.
5H?2 LDEX 0 FRH(3)
5HQL #SKI K6STEP [FIRST NON-DUMMY RECORD
5J== BZE 0 ZGEOER2
5JPW ADS 0 FREADWORD(2) [INCREMENT FREADWORD MEANWHILE.
5K9G ADX 3 0 [STEP ON CORE PTR
5KP6 LDXC 0 FRH(3)
5L8Q BCS YDUM9 [J IF DUMMY
5LNB NDUM9
5M82 BZE 0 QGEOBL
5MML ADS 0 FREADWORD(2) [UPDATE FREADWORD
5N7= STO 0 GEN3 [PRESERVE IN CASE NEXT R.H.IS ZERO
5NLW [(SO WE CAN DOWNDATE FREADWORD)
5P6G ADX 3 0 [X3=> NEXT RECORD
5PL6 ZEMPTYBL
5Q5Q YDUM8
5QKB LDXC 0 FRH(3) [IF NEXT RECORD IS A DUMMY,CHUG
5R52 BCC NDUM8 [ON LOOKING FOR NEXT NON-DUMMY
5RJL ANDX 0 BRHMASK
5S4= BNZ 0 ZGEOER8 [OR T97 IF FDUD.
5SHW LDEX 0 FRH(3)
5T3G #SKI K6STEP
5TH6 BZE 0 ZGEOER2 [ERROR IF 0
5W2Q ADS 0 FREADWORD(2) [INCREMENT FREADWORD
5WGB ADS 0 GEN3 [& GEN3,FOR THERE MAY BE ONLY DUMMY
5X22 ADX 3 0 [RECORDS LEFT IN THE FILE.
5XFL BRN YDUM8 [STEP ON PTR & GO BACK.
5X^= NDUM8
5YDW SKIPTRACE 199,0,NEXTREC
5YYG BNZ 0 TIDYUP1 [J TO END IF NOT E.O.BLOCK
5^D6 # THIS SECTION FREES THE USAGE BLOCK IF NOT USED BY ANYONE ELSE
5^XQ # & IS A FURB. IF A FUWB, GOES DOWN TO READFILE.
62CB CALL 0 PSTFCB [X3 ->FCB
62X2 CALL 1 QLASTBL [LAST BLOCK ?
63BL BRN SENDFILE [YES
63W= LDX 1 FPTR(3) [X1-> FSTACK
64*W # NB.DESTRUCTIVE COMMUNICATION -> LEAVE BIT SET !!
64TG JBS STEPDC,3,BFCORE [J IF 'LEAVE BLKS IN CORE' BIT SET.
65*6 JBS YENDBLK,3,BFGDR [J IF A GDR FILE
65SQ STO 2 GEN2 [
66#B TESTUSEJ 2,WAITING,1 [J IF SOMEONE WAITING FOR THIS BLOCK
66S2 # UNFORTUNATELY WE HAVE TO FREE BLOCKS WHEN THEY'RE NO LONGER
67?L # USEFUL-OTHERWISE CORE GETS CLOGGED UP & USEFUL BLOCKS AEE THROWN
67R= # AWAY,WE CAN FREE READ BLOCKS EASILY BUT WRITE BLOCKS HAVE TO
68=W # WRITTEN BACK BY READFILE(WE CAN'T ISSUE EVEN AN AUTONOMOUS
68QG # BACKWRITE,ELSE THE FILE MAY BE CLOSED BEFORE ALL ITS BLOCKS
69=6 # ARE WRITTEN AWAY.
69PQ LDX 0 FFSFUWB [= #HAL +FILE+FUWB,0
6=9B SMO GEN0 [GEN0 => USAGE BLOCK
6=P2 BXE 0 ATYPE,YENDBLK [J IF FUWB
6?8L FREECORE GEN0 [FREE USAGE BLOCK
6?N= ADDSKIP I516A,ARDFR
6#7W LDX 2 GEN2 [ PICK
6#MG WAITING [ UP
6*76 PSTAC 1,2 [ PTRS AGAIN
6*LQ NOFRBLK
6B6B NGS 1 FREADWORD(2) [UPDATE RECORD PTR.
6BL2 UPDATEBL
6C5L LDN 0 1
6CK= ADS 0 FREADBLOCK(2) [UPADTE BLOCK PTR
6D4W BRN PIKFUBNO
6DJG QGEOBL
6F46 CALL 0 PSTFCB [X1 -> FSTACK,X3 ->FCB
6FHQ #SKI K6STEP
6G3B (
6GH2 CALL 1 QLASTBL [LAST BLOCK ?
6H2L BRN ZGEOER1B [YES
6HG= )
6H^W LDN 0 A1
6JFG STO 0 FREADWORD(2)
6J^6 PSTAC 1,2
6KDQ BRN UPDATEBL
6KYB SENDFILE [E.O.FILE
6LD2 ... LDX 0 FCOMMCT(3)
6LXL ... BZE 0 SENDFIS [J IF NOT COMMUNALLY OPEN
6MJD ... LDX 0 HVSKIP
6MPL ... BNG 0 SENDFIS [DONT WAIT FOR APPENDERIF VSKIP
6MWW JBS T97,3,BFDCF [J IF A DC FILE.
6NBG LDX 0 CTOPEN(3) [J IF NO APPNDERS
6NW6 ANDX 0 MCOMUNI
6P*Q BZE 0 SENDFIS
6PTB SRL 0 1
6Q*2 SBN 0 #4000 [J FI MORE THAN 1 APPENDER
6QSL BNZ 0 T97
6R#= JBS SENDFIS,2,BAMAPP [J IF ONLY ONE APPENDER & IT'S ME.
6RRW T97
6S?G LDX 0 GEN3
6SR6 SBS 0 FREADWORD(2) [DOWNDATE FREADWORD
6T=Q BRN T99
6TQB TIDYUP1
6W=2 #SKI I516A
6WPL (
6X9= ILSTA [REENTRY IF OVERFLOW OCCURS
6XNW PSTAC 1,2 [THIS SECTION OF CODE TRIES TO
6Y8G BFCBX 1,1 [GIVE STATISTICS ON THE AVEIAGE
6YN6 LDXC 1 COMM(1) [SIZE OF RECORDS IN (A) SYSTEM
6^7Q BCS YDIR
6^MB ANDN 1 1 [FILES & (B) USER FILES. WE USE
7272 [THE DIRECTORY BIT AND
72LL BNZ 1 YDIR [THE L/WT BRT IN THE FCB TO DISTINGUI
736= ADS 0 IUSER [WE MAY BE ADVISED TO CHANGE THIS TO
73KW BVSR ISTRU [J TO STEPSTAT IF OVERFLOW
745G LDN 0 1 [DOUBLE LENGTH WORKING.
74K6 ADS 0 IUSEN
754Q BRN NDIR
75JB YDIR
7642 ADS 0 IDIRR
76HL BVSR ISTRD [J TO STEPSTAT IF OVERFLOW
773= LDN 1 1
77GW ADS 1 IDIRN
782G NDIR
78G6 INDIR
78^Q )
79FB #SKI K6STEP
79^2 (
7=DL LDX 0 FREADWORD(2)
7=Y= BXGE 0 BSBSA1,T97 [J IF FREADWORD CORRUPT.
7?CW )
7?XG LDN 0 -1 [J IF NOT
7#C6 ANDX 0 FFX3 [YET FINISHED
7#WQ BNZ 0 SKIPCT [SKIPPING
7*BB TIDYUP
7*W2 LDX 2 FX2 [RESET X1 & X2
7B*L LDX 1 FX1
7BT= BRN (FFWORKLINK) [EXIT
7C#W SKIPCT
7CSG LDN 0 1 [DECREMENT COUNT
7D#6 SBS 0 FFX3 [OF STEPS YET TO BE
7DRQ BRN SKIPSTEP [DONE
7F?B STEPDC
7FR2 JBC NOFRBLK,3,BFDCF [J IF NOT A D.C.F. IF IT IS ,MUST EN
7G=L [READFILE TO RESHUFFLE BLOCK NUMBERS.
7GQ= YENDBLK
7H9W LDX 0 GEN3 [R.H.OF LAST REC READ
7HPG SBS 0 FREADWORD(2) [DOWNDATE FREADWORD
7J96 MUSTCOOR
7JNQ CALL 0 PSTFCB [X3 -> FCB
7K8B LDX 0 FBLMOD(3)
7KN2 SBX 0 FREADBLOCK(2) [TEST IF BL.NUM IS "NON-EXISTENT"
7L7L ADN 0 A1 [I E OFF END OF BLOCKLIST
7LM= BNZ 0 T99 [JIF 'LEGAL' BLOCK NO.
7M6W #SKI K6STEP
7MLG (
7N66 LDX 0 FREADWORD(2) [ERROR IF ILLEGAL BL.NO. & READ E.O.F
7NKQ BPZ 0 ZGEOER1B
7P5B )
7PK2 ... LDX 0 FCOMMCT(3)
7Q4L ... BZE 0 SENDFIS1 [J IF NOT COMMUNALLY OPEN
7QPD ... LDX 0 HVSKIP
7QWL ... BNG 0 SENDFIS1 [DONT WAIT FOR APPENDER IF VSKIP
7R3W JBS T99,3,BFDCF [J IF A DC FILE
7RHG LDX 0 CTOPEN(3)
7S36 ANDX 0 MCOMUNI
7SGQ BZE 0 SENDFIS1 [ J IF NO APPENDERS
7T2B SRL 0 1
7TG2 SBN 0 #4000
7T^L BNZ 0 T99 [J IF MORE THAN ONE APPENDER
7WF= JBC T99,2,BAMAPP [J IF APPENDER NOT ME
7WYW SENDFIS1
7XDG LDN 0 A1 [AS F'WORD INDICATED"ABOUT TO READ
7XY6 STO 0 FREADWORD(2) [E.O.F",DO SO
7YCQ SENDFIS
7YXB LDN 3 0 [END OF FILE , X3=0
7^C2 LDN 0 -1
7^WL ANDX 0 FFX3 [ERROR IF NOT YET FINISHED SKIPPING
82B= BNZ 0 ZGEOER1A
82TW BRN TIDYUP
83*G T99A
83T6 NGN 1 ASTEPR [ADJUST LINK TO GO
84#Q BRN T99B [DOWN TO APPEND.
84SB T99
85#2 NGN 1 ASTEPQ [ADJUST LINK FOR READFILE.
85RL T99B
86?= ADX 1 FFWORKLINK [ADJUST LINK
86QW LDX 3 FFX3 [PRESERVE DEPTH
87=G EXIT 1 0
87Q6 #
889Q # STEP "APPEND" CASE,HERE WE HAVE 2 PARAMS TO THE MACRO,THE DEPTH
88PB # IN THE TOP 9 BITS & THE LENGTH OF RECORD TO BE APPENDED IN THE
8992 # BOTTOM 9 BITS[N.B. MAX LENGTH OF RECORD =511 WDS & EVERY BLOCK
89NL # ENDS IN A ZERO RECORD. ]
8=8= #
8=MW LABFIX ASAPP4
8?7G TESTREPN FILEFULL,SAPSTOR1 [J IF REPLY NOT "FILE FULL"
8?M6 SAPEX
8#6Q STO 1 FFWORKLINK [SET LINK FOR QUICK GETAWAY
8#LB BRN TIDYUP [END & EXIT
8*62 LABFIX ASAPP3
8*KL LDX 2 FX2
8B5= ANSOK [FAT CHANCE !
8BJW ADN 1 ASTEPR [SET LINK TO BYPASS APPEND ENTRY.
8C4G SAPSTOR1
8CJ6 STO 3 FFX3 [STORE PARAMS
8D3Q STO 1 FFWORKLINK [& LINK
8DHB SRA 3 15 [CONVERT DEPTH
8F32 BZE 3 SAPPZ3 [J IF ZERO
8FGL #SKI K6STEP
8G2= CALL 1 SCHEEP [CHECK DEPTH
8GFW BNG 3 SAPBAK [DEPTH NEG-BACKWARD HUNT FOR ELEMENT
8G^G CALL 0 SFFORWARD [SEARCH FORWARD DOWN RING
8HF6 SAPBAK
8HYQ CALL 0 SFBAKWARD [JUMPED OVER BY OTHER S/R.
8JDB BRN SAPMERJ [X2 -> ELEMENT
8JY2 LABFIX ASAPP2
8KCL TESTREPN FILEFULL,SAPSTOR2 [J IF FILE NOT FULL
8KX= BRN SAPEX [O/W EXIT
8LBW LABFIX ASAPP1
8LWG LDX 2 FX2
8MB6 ADN 1 ASTEPR [SET LINK ON.
8MTQ ANSOK (HUNH!
8N*B SAPSTOR2
8NT2 STO 1 FFWORKLINK [STORE LINK
8P#L STO 3 FFX3 [& LENGTH OF RECORD
8PS= SAPPZ3
8Q?W TOPFCA2 2 [X2 -> FCA
8QRG SAPMERJ [ALL TOGETHER NOW !
8R?6 ADDSKIP I516A,ISTAP
8RQQ CALL 0 PSTFCB [X1 -> FSTACK,X3 -> FCB
8S=B STO 3 GEN1 [GEN1 -> FCB
8SQ2 FDRMCHECK 3,T99A
8T9L LDX 0 FBLMOD(3)
8TP= SBN 0 FBLKS-A1
8W8W BZE 0 T99A [J IF EMPTY FILE.
8WNG ADX 3 FBLMOD(3) [X3 -> BLOCK NUMBER(ALMOST)
8X86 SFUB 1,A1-1(3),1,T99A [X1->USAGE BLK,UNLESS NOT THERE
8XMQ [WHEN WE BRANCH TO"MUSTCOOR"
8Y7B LDX 3 GEN1
8YM2 STO 1 GEN0 [PTR TO USAPE BLOCK
8^6L JBC NOCAR,3,BFCARE [J IF NOT A 'CAREFUL'FILE.
8^L= JBS NOCAR,2,BAAPP [J IF APPEND ALREADY BEEN DONE ON FIL
925W [AS BIT IN FMAPP BLOCK WILL BE SET.
92KG LDX 0 FBLMOD(3) [BIT FOR THIS BLOCK IN THE FMAP BLOCK
9356 STO 2 GEN6 [PRESERVE
93JQ SBN 0 FBLKS-A1
944B MAPBCH 0,3
94J2 BZE 0 T99A [J IF BIT NOT SET,TO SET IT IN APPEND
953L LDX 2 GEN6
95H= LDX 1 GEN0
962W NOCAR
96GG LDX 0 CMOD(3) [J IF APPEND ALREADY
9726 BPZ 0 SAPPSCHON [DONE ON FILE
97FQ ADN 1 A1 [PTRS REL TO START OF BLOCK
97^B LDX 0 FRH(1) [NEXT R.H.
98F2 BZE 0 NDUM52 [J IF END
98YL BPZ 0 SMOR [J IF NOT DUMMY
99D= LDCT 0 #100
99XW ANDX 0 FRH(1) [J IF "UNAPPENDED RECORD";WHICH IS
9=CG BNZ 0 NDUM52 [EQUIVALENT TO END OF FILE.
9=X6 LDEX 0 FRH(1) [BOTTOM 9 BITS OF R.H.
9?BQ BRN SMOR
9?WB NDUM52
9#B2 LDN 1 A1 [X1 IS RELATIVE PTR TO AREA IN BLOCK
9#TL [WHERE WE CAN APPEND RECORD.
9**= NGS 1 GEN4
9*SW BRN QFIT [IN THIS CASE :- AT START OF FUWB
9B#G SMOR
9BS6 STO 0 GEN2 [TEMP.WORK WORD,CONTAINS R.H OF LAST
9C?Q ADX 1 0 [RECORD
9CRB LDX 0 FRH(1) [NEXT R.H.
9D?2 BZE 0 NDUM55 [J IF END OF BLOCK
9DQL BPZ 0 SMOR [J IF NOT DUMMY.
9F== LDCT 0 #100 [J IF "NOT YET APPENDED RECORD"
9FPW ANDX 0 FRH(1) [THIS IS EQUIVALENT TO END OF BLOCK
9G9G BNZ 0 NDUM55
9GP6 LDEX 0 FRH(1) [BOTTOM 9 BITS
9H8Q BRN SMOR
9HNB NDUM55
9J82 SBX 1 GEN0 [RELATIVISE RECORD POINTER
9JML LDX 0 1 [CALCULATE "OLD" CMOD IN CASE WE NEED
9K7= SBX 0 GEN2 [IT TO UPDATE READ PTRS.
9KLW STO 0 GEN4 [STORE'OLD' CMOD
9L6G BRN QFIT
9LL6 SAPPSCHON
9M5Q STO 0 GEN4 [STORE'OLD' CMOD
9MKB ADX 1 0 [ADD IN APPEND PTR
9N52 LDCT 0 #100 [J IF "UNAPPENDED RECORD" WHICH IS
9NJL ANDX 0 FRH(1) [EQUIVALENT TO END OF FILE.
9P4= BNZ 0 QFIT1
9PHW LDEX 0 FRH(1) [BOTTOM 9 BITS
9Q3G ADX 1 0
9QH6 QFIT1
9R2Q SBX 1 GEN0 [RELATIVISE
9RGB QFIT [NOW CHECK IF RECORD WILL FIT
9S22 SKIPTRACE 199,GEN4,OLD CMOD
9SFL LDEX 0 FFX3 [X0 CONTAINS LENGTH OF RECORD
9S^= ADX 0 1 [ADD PTR.TO ZERO REC [LAST IN BLOCK]
9TDW [(N.B.RELATIVE PTR
9TYG BXGE 0 BSBSA1,T99A [J IF RECORD WON'T FIT.
9WD6 STO 1 CMOD(3) [CMOD
9WXQ ADX 1 GEN0 [NOW IS OF POINTER
9XCB ADX 0 GEN0 [POINTS TO R.H.OF NEXT RECORD
9XX2 SMO 0 [STOZ IT
9YBL STOZ 0 [NOW HAVE"HOLE"WITH ZERO R.H.& ZERO
9YW= [RECORD AFTER LAST WORD WHICH
9^*W [IS BIG ENOUGH FOR RECORD REQUESTED
9^TG BS 3,BFALTR [SET 'REEL ALTERED' BIT IN COMM
=2*6 LDX 0 MCOMCOM [WAITING BITS FOR COMMUNICATION
=2SQ ANDX 0 COMM(3) [IF THEY ARE SET,SONEONE(PROBABLY A
=3#B BZE 0 NOWAIT [READER)IS WAITING FOR US TO APPEND
=3S2 ERS 0 COMM(3) [TO THIS FILE
=4?L [ WE UNSET THE BIT(5) THAT WERE SET & WAKE UP WAITERS IN STYLE #5
=4R= STO 2 GEN3
=5=W LDX 2 3
=5QG LDX 3 1 [X3 ^ RECORD POSITION
=6=6 LONGON 5,BACK2(2) [RELEASE WAITERS
=6PQ LDX 2 GEN3
=79B BRN R209
=7P2 NOWAIT
=88L LDX 3 1 [X3 ^ RECORD POSITION
=8N= R209
=97W BS 2,BAAPP [SET 'APPEND BEEN DONE' BIT.
=9MG LDX 1 GEN0 [USAGE BLOCK
==76 LDX 0 FFSFUWB [MAKE USAGE BLOCK
==LQ STO 0 ATYPE(1) [A WRITE BLOCK
=?6B LDX 1 GEN1 [X1 & GEN1 -> FCB
=?L2 LDX 0 FREADBLOCK(2)
=#5L SBX 0 FBLMOD(1) [DOES F'BLOCK ->'UNUSED' BLOCK NO?
=#K= SBN 0 A1
=*4W BNG 0 TIDYUPA
=*JG LDX 0 FREADWORD(2)
=B46 BNG 0 STOGEN4 [J IF WAS"ABOUT TO READ EOF"
=BHQ LDX 0 CMOD(1) [RECORD PTR = NEW CMOD
=C3B STONUPT
=CH2 STO 0 FREADWORD(2) [STORE APPROPRIATE RECORD PTR.
=D2L LDX 0 FBLMOD(1) [BLOCK PTR = FBLMOD
=DG= ADN 0 A1-1
=D^W STO 0 FREADBLOCK(2)
=FFG TIDYUPA
=F^6 LDEX 1 FFX3 [R.H.
=GDQ LDCT 0 #500 [DUMMY & UNAPPENDED RECORD BITS.
=GYB ADX 1 0
=HD2 STO 1 FRH(3) [STORE IN R.H.
=HXL BRN TIDYUP
=JC= STOGEN4
=JWW LDX 0 GEN4 [RECORD PTR = OLD CMOD,PRESERVED IN
=KBG BRN STONUPT [GEN4 FOR THIS VERY EVENTUALITY
=KW6 #
=L*Q # ENTRIES FOR STEPAGAIN
=LTB #
=M*2 LABFIX ASTAG3
=MSL ANSOK
=N#= ADN 1 ASTEPQ [TO STEP OVER READFILE ENTRY
=NRW LDX 2 FX2
=P?G LABFIX ASTAG4
=PR6 STO 3 FFX3
=Q=Q STO 1 FFWORKLINK
=QQB SRA 3 15 [CONVERT DEPTH
=R=2 BZE 3 STAGZ3 [J IF ZERO
=RPL #SKI K6STEP
=S9= CALL 1 SCHEEP [CHECK DEPTH
=SNW BNG 3 SGBAK [J IF DEPTH RELATIVE TO BOTTOM
=T8G CALL 0 SFFORWARD [FSTACK OTRS FORWARD SEARCH
=TN6 SGBAK
=W7Q CALL 0 SFBAKWARD [FSTACK POINTERS:BACKWARD SEARCH
=WMB BRN SGETHR
=X72 LABFIX ASTAG1
=XLL ANSOK
=Y6= LDX 2 FX2
=YKW ADN 1 ASTEPQ [TO JUMP OVER READFILE REENTRY
=^5G LABFIX ASTAG2
=^K6 STO 1 FFWORKLINK
?24Q STOZ FFX3
?2JB STAGZ3
?342 TOPFCA2 2 [X2 -> FCA AT TOP LEVEL
?3HL SGETHR
?43= ADDSKIP I516A,ISTAG
?4GW STNOK1
?52G PSTAC 1,2 [X1 -> FSTACK
?5G6 LDX 3 FREADBLOCK(2)
?5^Q #SKI K6STEP
?6FB BNG 3 ZGEOER6 [MUSTN'T BE AT BEGINNING OF FILE
?6^2 LDX 0 FREADWORD(2) [FWORD
?7DL BPZ 0 STOK1 [J IF NONNEGATIVE
?7Y= #SKI K6STEP
?8CW (
?8XG SBN 3 FBLKS [IS IT 1ST BLOCK ?
?9C6 BZE 3 ZGEOER6
?9WQ LDX 3 FREADBLOCK(2)
?=BB )
?=W2 LDX 0 BSBSA1 [RECORD PTR GIVEN SPECIAL SETTING
??*L STO 0 FREADWORD(2) [(=GSBS+A1) AS A SPECIAL SETTING
??T= SBN 3 1 [BACK ONE BLOCK
?##W STO 3 FREADBLOCK(2) [STORE NEW BLOCK POINTER
?#SG STOK1
?*#6 # ! ASSUMES FSTACK BEHIND FCB
?*RQ SMO BPTR(1)
?B?B LDX 0 FBLMOD [J TO GIVE EOF REPLY
?BR2 SBN 0 FBLKS-A1 [IF EMPTY
?C=L BZE 0 SENDFIS [FILE
?CQ= SMO BPTR(1)
?D9W LDX 0 FBLMOD
?DPG ADN 0 A1
?F96 SBX 0 3
?FNQ BZE 0 SENDFIS [J IF PTS TO UNUSED BLOCK NO
?G8B ADX 3 BPTR(1) [POINTS TO BLOCK NUMBER
?GN2 SFUB 1,0(3),3,MUSTCOOR [SE3 X3->FURB,J TO MUSTCOOR WHEN
?H7L [ABSENT
?HM= LDX 0 FREADWORD(2) [RECORD PTR
?J6W BXU 0 BSBSA1,STOK2 [JFI NOT SPECIAL SETTING
?JLG STOK4
?K66 STO 1 GEN0 [PRESERVEPTO
?KKQ LDN 1 A1 [INITIALISE
?L5B STO 1 GEN5 [GEN5 CONTAINS"LAST R.H.",IN THIS CAS
?LK2 STOK3
?M4L ADX 3 GEN5 [ADD IN LAST R.H.
?MJ= LDXC 0 FRH(3) [NEXT R.H.
?N3W BCC NDUM36 [J IF NOT DUMMY
?NHG LDN 1 0 [INITIALISE X1-COUNT OF RECORD
?P36 YDUM36 [HEADERS OF DUMMY RECORDS
?PGQ LDEX 0 0 [BOTTOM 9 BITS
?Q2B ADX 1 0 [CT. OF DUMMY R.H.'S
?QG2 ADX 3 0 [UPDATE PTR
?Q^L LDX 0 FRH(3) [NEXT REC.HDR.
?RF= BZE 0 STAGSUBDUM [J IF END OF BLOCK
?RYW BNG 0 YDUM36 [BACK IF DUMMY
?SDG NDUM36
?SY6 BZE 0 STAGSUB [J IF E.O. BLOCK
?TCQ STO 0 GEN5 [PRESERVE LAST R.H.
?TXB BRN STOK3
?WC2 STAGSUBDUM
?WWL SBX 3 1 [SUB CT. OF DUMMY R.H'S.
?XB= STAGSUB
?XTW SBX 3 GEN5 [SUB R.H.AGAIN
?Y*G LDX 0 3 [FREADWORD
?YT6 SBX 0 GEN0 [
?^#Q STO 0 FREADWORD(2) [J IF NOT EMPTY BLOCK OR ONLY
?^SB BNZ 0 TIDYUP [DUMMY RECORDS @ BEGINNING
#2#2 STOK6
#2RL NGS 3 FREADWORD(2) [PTRS TO END OF PREVIOUS BLOCK
#3?= BRN STNOK1 [BACK & TRY AGAIN
#3QW STOK2
#4=G ADX 3 0 [ADD IN F'WORD
#4Q6 YDUM48 [J IF NOT EOF
#59Q LDXC 0 FRH(3) [NEXT R.H.
#5PB BCC NDUM48 [IGNORE IF DUMMY
#692 LDEX 0 0 [9 BITS
#6NL ADX 3 0 [LOOP DOWN TO NEXT NONZERO
#78= ADS 0 FREADWORD(2) [R.H.
#7MW BRN YDUM48
#87G NDUM48
#8M6 BNZ 0 TIDYUP
#96Q CALL 0 PSTFCB [X3 -> FCB
#9LB CALL 1 QLASTBL [LAST BLOCK ?
#=62 BRN SENDFIS [YES
#=KL LDN 0 1 [MOVE READ PTRS TO "HAVE READ"
#?5= ADS 0 FREADBLOCK(2) [1ST RECORD IN NEXT BLOCK
#?JW LDN 0 A1 [
##4G STO 0 FREADWORD(2) [NO NEED TO TIDY UP USAGE BLOCK,
##J6 BRN SGETHR [AS THIS PATH IS INFREQUENT
#*3Q #END
^^^^ ...06762233000100000000