{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: REWRITE864)}}
====== REWRITE864 ======
(George Source)
**Macros used:** [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:APPCUBS|APPCUBS]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FILEREAD|FILEREAD]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:KEYREC|KEYREC]], [[george:macro:MAPBCH|MAPBCH]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MAPBSE|MAPBSE]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OFF|OFF]], [[george:macro:PSTAC|PSTAC]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETBIT|SETBIT]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SFMAP|SFMAP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SFUB|SFUB]], [[george:macro:SKIPTRACE|SKIPTRACE]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VARIADNR|VARIADNR]], [[george:macro:VARIADNW|VARIADNW]], [[george:macro:VFREE|VFREE]], [[george:macro:WIND|WIND]], [[george:macro:WRITEB|WRITEB]]
22FL #SEG REWRITE
22^= #OPT K0REWRITE=K0ACCESS>K0FILESTORE>K0ALLGEO
23DW #LIS K0REWRITE
23YG #OPT K6REWRITE=K6DELETE
24D6 8HREWRITE
24XQ #
25CB SEGENTRY K3REWRITE,REWRITE
25X2 SEGENTRY K4REWRITE,WIND
26BL SEGENTRY K5REWRITE,WRITEB
26W= SEGENTRY K7REWRITE,SUBS
27*W SEGENTRY K33REWRITE,ZREWRITE
27TG SEGENTRY K44REWRITE,ZWIND
28*6 SEGENTRY K51REWRITE,WRITBREAK
28SQ SEGENTRY K52REWRITE,WRITANS
29#B SEGENTRY K53REWRITE,WRITFORCE
29S2 SEGENTRY K55REWRITE,ZWRITEB
2=?L SEGENTRY K56REWRITE,ZWRITBREAK
2=R= SEGENTRY K57REWRITE,ZWRITANS
2?=W SEGENTRY K58REWRITE,ZWRITFORCE
2?QG SEGENTRY K77REWRITE,ZSUBS
2#=6 #
2#PQ ZGEOER1
2*9B GEOERR 1,FULLBGON [NO FULLB IN FILE CHAIN
2*P2 ZEN
2B8L GEOERR 1,ENDFILE
2BN= ZGEOER3
2C7W GEOERR 1,RECORD? [SOMETHING ODD ABOUT READ PTRS
2CMG ZGEOER6
2D76 GEOERR 1,ALTERED?
2DLQ #
2F6B # THIS SEGMENT IMPLEMENTS THE ACCESS MACROS:-
2FL2 # REWRITE (ENTRY POINTS K3 AND K33)
2G5L # WIND (ENTRY POINTS K4 AND K44)
2GK= # WRITEB (ENTRY POINTS K5 AND K55)
2H4W # STEPWRITE (ENTRY POINTS K7 AND K77)
2HJG # IN CONJUCTION WITH THE FILESTORE RING SYSTEM
2J46 #
2JHQ #
2JNY ...#SKI IFS<1$1
2JW6 ...(
2K3B SFULLB
2KH2 #HAL BSTB+FULLB,0
2L2L SFMAP
2LG= #HAL FILE+FMAPP,0
2LQ4 ...)
2L^W #
2MFG FILETRAN [SUBROUTINES FOR SPECAIL FILESTORE
2M^6 [B.S. TRANFER ROUTINES.
2N2# ...# THIS READS CURRENT BLOCK OF FILE INTO BSTB-BREAD
2N3G ...# IN CORE
2N4N ...SFREAD
2N5W ... SBX 6 FX1
2N74 ... LDX 2 FX2
2N8= ... LDX 7 AWORK4(2)
2N9D ...#SKI JSKI33<1$1
2N=L ... FILEREAD 7
2N?S ...#SKI JSKI33
2N*2 ... FILEREAD 7,FAIL
2NB8 ... ADX 6 FX1
2NCB ... EXIT 6 0
2NDQ PARAPOINT
2NYB [THIS SUBROUTINE VALIDATES THE FILE LEVEL PARAMETER AND MAKES POSITIVE
2PD2 [IF NECESSARY AND GIVES POINTERS:-
2PXL [ X1-> TO TOP OF FSTACK BLOCK OF THIS FILE
2QC= [ X2-> FCB OF THIS FILE
2QWW [ X3-> TO RING ELEMENT OF FCA OF FILE OPEN AT LEVEL IN X6
2RBG LDX 6 ACOMMUNE7(2) [DEPTH
2RW6 SRA 6 15 [CONVERT
2S*Q FILENUMB 4 [X4= NO FILES OPEN
2STB TOPFCA 3 [X3 -> FCA OF TOP FILE
2T*2 BPZ 6 POSLV [J IF DEPTH POSITIVE
2TSL ADX 6 4 [IF NEGATIVE ADD NUMBER OF FILES OPEN
2W#= #SKI K6REWRITE
2WRW (
2X?G BPZ 6 NOWP1 [ERROR IF STILL <0
2XR6 NOTENUF
2Y=Q GEOERR 1,NOPENDEL
2YQB )
2^=2 POSLV
2^PL #SKI K6REWRITE
329= BXGE 6 4,NOTENUF
32NW NOWP1
338G STO 6 AWORK4(2) [STORE DEPTH
33N6 NOWP
347Q LDX 2 FX2
34MB SFSTACK AWORK4(2),3,1 [GET X3 -> FCA
3572 [AND -> IN X1 TO TOP OF FSTACK BLOCK
35LL BFCBX 2,1
366= EXIT 7 0
36KW #
375G SFSTACK
37K6 LDX 3 FX2
384Q SFSTACK AWORK4(3),3 [X3 -> FCA
38JB EXIT 7 0
3942 #
39HL XKEYREC
3=3= # THIS ROUTINE CALCULATES THE KEY OF THE REC. POINTED TO BY X4 AND
3=GW # STORES IT IN X7,THEN EXITS NORMALLY. IF FILE NOT INDEXED OR REC.
3?2G # HAS NO KEY IT EXITS PLUS 1. ON ENTRY X2-> FCB.
3?G6 KEYREC 2,,1,NOKEY,7
3?^Q EXIT 6 0
3#FB NOKEY
3#^2 EXIT 6 1
3*DL #
3*Y= SWITCHBLOCK
3BCW # THIS ROUTINE DOES ALL THE NORMAL'CAREFUL'UPDATING.
3BXG #
3CC6 JBS (7),3,BAMCLEAN [J IF FILE OPEN IN CLEAN MODE.
3CWQ JBC (7),2,BFCARE [J IF FILE NOT CAREFUL
3DBB SMO FX2
3DW2 STO 1 ACOMMUNE1 [STORE PTR TO USAGEB.
3F*L LDX 0 FREADBLOCK(3) [CALCULATE APPROPRIATE BIT
3FT= SBN 0 FBLKS-1
3G#W MAPBCH 0,2 [WAS BIT SET
3GSG BNZ 0 YSET [J IF BIT SET
3H#6 SBX 7 FX1
3HRQ STO 7 AWORK1(2) [PRESERVE LINK
3J?B PSTAC 1,3 [X1 -> FSTACK BLOCK
3JR2 BFCBX 2,1 [X2 -> FCB
3K=L JBC NEWFULLB,2,BFALTB [DON'T LOOK FOR FULLB,SET ONE UP,IF
3KQ= ['BLOCK NOS. ALTERED' BIT UNSET.
3L9W CALL 7 SEEKFULLB [X1-> FULLB
3LPG BRN NEWFULLB [J IF NOT THERE
3M96 LDX 7 ALOGLEN(1)
3MNQ ADN 7 1
3N8B LDX 3 1
3NN2 ALTLEN 3,7 [ALTLEN BLOCK
3P7L CALL 6 SGETBACK [GET A B.S.BLOCK ON RIGHT RESIDENCE
3PM= BRN SGOT
3Q6W NEWFULLB
3QLG SETNCORE 3,1,BSTB,FULLB
3R66 LDN 0 2
3RKQ STO 0 A1(1) [R.H
3S5B LDN 0 63
3SK2 STO 0 A1+1(1) [RANDOM B.S.PREFIX
3T4L CALL 6 SGETBACK [GET B.S.
3TJ= NOFULLB
3TMB ...#SKI IFS
3TQG ... SFMAPP 2,2,ZGEOER1
3TTL ...#SKI IFS<1$1
3TYQ ...(
3W3W LDX 2 FPTR(2) [JOVER FSTACK
3WHG SLZ
3X36 LDX 2 FPTR(2) [NEXT BLOCK
3XGQ LDX 0 ATYPE(2)
3Y2B SMO FX1
3YG2 BXU 0 SFMAP,SLZ
3YPS ...)
3Y^L LDX 2 FPTR(2)
3^F= MHUNTW 1,BSTB,FULLB
3^YW LDX 7 1
42DG CHAIN 7,BPTR(2) [CHAIN FULLB IN
42Y6 LDX 1 7
43CQ PSTAC 2,3
43XB BFCBX 2,2 [X2 -> FCB
44C2 LDX 0 BSPRE(2) [RIGHT B.S.PREFIX
44WL STO 0 A1+1(1)
45B= LDX 1 FPTR(2) [->FSTBLK
45TW SGOT
46*G SMO FREADBLOCK(3)
46T6 LDX 6 0(2) [OLD B.N.
47#Q SFUB 1,6,1,NOTFURBA [J IF FURB NOT AROUND
47SB YGOTFURB
48#2 STO 4 BACK1(1) [UPDATE B.S.HOME
48RL STO 5 BACK2(1)
49?= NAME 1,FILE,FUWB [SO IT GOES TO B.S.
49QW STO 1 4 [-> USAGE BLOCK
4==G SMO FREADBLOCK(3) [STORE IN FCB
4=Q6 STO 5 0(2)
4?9Q CALL 7 SEEKFULLB [X1 -> FU-LB
4?PB BRN ZGEOER1
4#92 SMO A1(1)
4#NL STO 6 A1(1) [STORE OLD B.N.
4*8= LDN 0 1
4*MW ADS 0 A1(1) [UPDATE BLOCK COUNT
4B7G LDX 0 FREADBLOCK(3)
4BM6 SBN 0 FBLKS-1 [SET BIT FOR THIS BLOCK
4C6Q MAPBSE 0,2 [SET BIT
4CLB PSTAC 2,3
4D62 BFCBX 2,2 [X2 -> FCB
4DKL MBS 2,BFALTB,BFALTR [SET FILE AND BLOCK NOS ALTERED BITS.
4F5= LDX 1 4 [-> USAGE BLOCK
4FJW LDX 7 FX1
4G4G SMO FX2
4GJ6 ADX 7 AWORK1 [X7 = EXIT
4H3Q EXIT 7 0
4HHB YSET
4J32 LDX 1 ACOMMUNE1(2) [X1 -> USAGE BLOCK
4JGL PSTAC 2,3
4K2= BFCBX 2,2 [RESET X2 ->FCB
4K=4 ... FSHSKIP B,YB1
4KFW JBC ZGEOER6,2,BFALTB [ERROR IF 'BLOCK NOS. ALTERED' BIT UN
4KKR ...YB1 [OMIT CHECK ON 'B' MACHINE SINCE BFAL
4KPN ... [ CLEARED WHEN FCB TAKEN TO 'B' & WHO
4KTK ... [ (WITH BITS SET) MAY BE TAKEN TO 'B'
4K^G EXIT 7 0
4LF6 #
4LYQ #
4MDB NOTFURBA
4MY2 VARIADNR 2
4NCL ... CALL 6 SFREAD
4PWG CALL 6 SCHBSP [CHECK B.S.PREFIX
4QB6 ADDSKIP I516A,ADLRD
4QTQ MHUNTW 1,BSTB,BREAD [BUFFER BLOCK
4R*B NAME 1,FILE,FUWB
4RT2 CHAIN 1,FPTR(2) [CHAIN AFTER FSTACK
4S#L PSTAC 1,3 [X1 -> FSTACK
4SS= BFCBX 2,1 [X2 -> FCB
4T?W LDX 1 FPTR(1) [X1 -> USAGE BLOCK
4TRG SMO FREADBLOCK(3)
4W?6 LDX 6 0(2) [OLD B.S.NUMBER
4WQQ BRN YGOTFURB
4X=B #
4XQ2 # TWO SUBROUTINES,
4Y9L # 1)SCHBSP:CHECKS B.N. IN X5 IS STILL OK,IF NOT,GETS RID OF IT & GETS
4YP= # A NEW ONE.B.S.P AT TIME OF 1ST GETBAX IN X4 .
4^8W # 2)SGETBAC: GETS B.S, CHECKS B.S.P. STILL OK, IF NOT AS ABOVE
4^NG #
5286 SCHBSP
52MQ SBX 6 FX1
537B CALL 7 NOWP [PTRS.
53M2 BRN PREFCH
546L SGETBACK
54L= SGETBAC
555W CALL 7 NOWP
55KG SBX 6 FX1
5656 SGBACK
56JQ LDX 4 BSPRE(2) [B.S.PREFIY CURRENTLY
574B RGBACK
57J2 GETBACK 4 [GET B.S.
583L ADDSKIP I516A,BSGET
58H= LDX 5 EXEC1(2) [PRESERVE B.N.
592W CALL 7 NOWP [PTRS
59GG PREFCH
5=26 BXE 4 BSPRE(2),OKBSHO [J IF B.S.PREFIX UNCHANGED
5=FQ LDX 7 4 [OLD B.S.P.
5=^B LDX 4 BSPRE(2) [NEXT ONE TO TRY
5?F2 ADDSKIP I516A,ADLFBL
5?YL FREEBACK 7,5 [FREE OLD BLOCK
5#D= BRN RGBACK
5#XW OKBSHO
5*CG ADX 6 FX1
5*X6 EXIT 6 0
5BBQ #
5BWB #
5CB2 # S/R TO SEEK FULLB. ON EXIT X2 -> FCB
5CTL #
5D*= SEEKFULLB
5DDB ...#SKI IFS
5DHG ... SFULLB 2,1,(7)
5DLL ...#SKI IFS<1$1
5DPQ ...(
5DSW LDX 1 FPTR(2)
5F#G SKFULLB
5FS6 LDX 1 FPTR(1)
5G?Q BXE 1 CXFI,(7)
5GRB LDX 0 ATYPE(1)
5H?2 BXE 0 FILEPLUSFCB,(7)
5HQL SMO FX1
5J== BXU 0 SFULLB,SKFULLB
5JPW LDX 0 A1+1(1)
5K9G BXU 0 BSPRE(2),SKFULLB
5KF# ...)
5KP6 EXIT 7 1
5L8Q #
5LNB SEEKBLOCK
5M82 [THIS SUBROUTINE WILL GIVE A POINTER IN X1 TO THE USAGE BLOCK OF B.S.
5MML [BLOCK CURRENTLY BEING READ AND READ IT DOWN FROM B.S. IF NECESSARY
5N7= [IT ALSO CHECKS THAT THE FILE HAS BEEN READ
5NLW SBX 7 FX1
5P6G SMO FX2
5PL6 STO 7 AWORK1 [STORE LINK.
5Q5Q LDX 4 FREADBLOCK(3)
5QKB #SKI K6REWRITE
5R52 BNG 4 OFF [ERROR IF NOT READ ANY OF FILE
5RJL LDX 5 FREADWORD(3)
5S4= BPZ 5 SAMBL [J IF -> NOT TO END OF PREVIOUS BLOCK
5SHW #SKI K6REWRITE
5T3G (
5TH6 LDN 0 FBLKS+1 [CHECK NOT MOVING BACK BEYOND START
5W2Q BXGE 4 0,NOTSTART [OF FILE
5WGB OFF GEOERR 1,BEG FILE
5X22 )
5XFL NOTSTART
5X^= SMO 4
5YDW LDX 4 0(2) [PIC- UP BLOCK NUMBER
5YYG SFUB 1,4,1,NOLDFUB [1 J IF USAGE BLOCK NOT IN CASE
5^D6 YFRENULB
5^XQ CALL 4 VFREE [DEAL WITH SPENT BLOCK
62CB NOLFU
62X2 LDX 4 FREADBLOCK(3) [X4 CORRUPTED BY CALL
63BL SBN 4 1 [MOVE BLOCK -> BACK BY ONE
63W= STO 4 FREADBLOCK(3)
64*W SAMBL
64TG SMO 4
65*6 LDX 4 0(2) [PICK UP BLOCK NO OF REQUIRED BLOCK
65SQ SFUB 1,4,1,NOFUB [FIND ITS USAGE BLOCK IF IN CORE
66#B YFUB
66S2 BPZ 5 NONUFUB [J IF NO NEED TO RESET READ POINTER
67?L LDN 4 A1
67R= SBLMD
68=W SMO 4 [BLOCK
68QG LDX 0 FRH(1) [NEXT R.H.
69=6 BZE 0 YZE [J IF END OF BLOCK
69PQ BPZ 0 YPOS [J IF NOT DUMMY
6=9B LDEX 0 0 [9 BITS
6=P2 ADX 4 0 [STEP ON PTR.
6?8L BRN SBLMD [J BACK TO PICK UP R.H.
6?N= YPOS [STEP ON PTR & J BACK TO STEP ON PTR.
6#7W LDX 5 4
6#MG ADX 4 0 [TO PREVIOUS REC. & TO PICK UP NEXT.
6*76 BRN SBLMD
6*LQ YZE
6B6B BNG 5 YFRENULB [GO & FREE BLOCK IF NULL(FULL OF DUMM
6BL2 STO 5 FREADWORD(3)
6C5L NONUFUB
6CK= SMO FX2
6D4W LDX 7 AWORK1 [PICK UP LINK.
6DJG ADX 7 FX1
6F46 EXIT 7 0
6FHQ NOLDFUB
6G3B CALL 4 VEXITA
6GH2 BRN NOLFU
6H2L NOFUB
6HG= VARIADNR 2
6H^W ADDSKIP I516A,ADLRD
6JFG ... CALL 6 SFREAD
6KYB #SKI K6REWRITE<99$99
6LD2 TRACE 4,DINFUB
6LXL MHUNT 1,BSTB,BREAD
6MC= NAME 1,FILE,FURB [RENAME AS A USAGE BLOCK
6MWW CALL 7 SFSTACK [X3->FCA
6NBG PSTAC 2,3
6NW6 LDX 4 2 [X4->FSTACK.
6P*Q CHAIN 1,4
6PTB SMO 4
6Q*2 LDX 1 FPTR [X1-> TO USAGE BLOCK AGAIN
6QSL SMO 4
6R#= LDX 2 BPTR [X2-> TO FCB AGAIN
6RRW LDX 0 BSPRE(2) [SWAP ROUND B.S.
6S?G STO 0 BACK1(1) [HOME OF BLOCK
6SR6 SMO FREADBLOCK(3) [IN CASE IT HAS
6T=Q LDX 0 0(2) [CHANGED
6TQB STO 0 BACK2(1)
6W=2 BRN YFUB
6WPL #
6X9= #
6XNW #
6Y8G # THIS ROUTINE DEALS WITH BLOCK POINTED TO BY X1
6YN6 # CALLED BY X4,ON EXIT X3-> FCA,X2->FCB,X1-> FSTACK
6^7Q VFREE
72LL JBS VEXITA,2,BFCORE [EXIT IF 'LEAVE BLOCKS IN CORE' BIT S
736= LDX 0 ATYPE(1)
73KW BXE 0 FFSFUWB,UWRITE [J IF WRITE BLOCK
745G FREECORE 1 [FREE
74K6 ADDSKIP I516A,ADLFR
754Q BRN VEXITA
75JB UWRITE
7642 VARIADNW 2
76HL SBX 4 FX1
773= CHAIN 1,FX2 [CHAIN NEXT TO ACT BLK.
77GW LDX 2 FX2
782G LDX 6 AWORK4(2)
78G6 FILEAUTW 6,FAIL+FREE
78^Q ADDSKIP I516A,ADLWR
79FB #SKI K6REWRITE<99$99
79^2 TRACE 4,D WRITE
7=DL ADX 4 FX1
7=Y= VFREA
7?CW CALL 7 SFSTACK [X3->FCA
7?XG VEXITA
7#C6 PSTAC 1,3
7#WQ BFCBX 2,1
7*BB EXIT 4 0
7*W2 UP
7B*L UP
7BT= #
7C#W #
7CSG [
7D#6 REWRITE [REWRITE ENTRY,N/Z DEPTH.
7DRQ [
7F?B CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK
7FR2 BRN MERGERWR
7G=L [
7GQ= ZREWRITE [REWRITE ENTRY,ZERO DEPTH
7H9W [
7HPG LDN 6 0 [DEPTH
7J96 CALL 7 NOWP1 [X3 -> FCA,X2->FCB,X1->FSTACK
7JNQ MERGERWR
7K8B #SKI K6REWRITE
7KN2 (
7L7L JMBS SREW,3,BAMGEN,BAMCLEAN [CHECK FILE OPEN IN GENERAL
7LM= [OR CLEAN MODE.
7M6W GEOERR 1,CANTREWR
7MLG SREW
7N66 LDX 0 FBLMOD(2)
7NKQ SBN 0 FBLKS-A1 [GEOERR IF EMPTY FILE.
7P5B BZE 0 ZEN
7PK2 )
7Q4L ADDSKIP I516A,IREWR
7QJ= CALL 7 SEEKBLOCK [SET X1 ->USAGE BLOCK
7R3W SCHLP
7RHG SMO 5 [J IF R.H OF RECORD TO BE REWRITTEN
7S36 LDX 0 FRH(1) [NEXT RECORD
7SGQ BZE 0 YENDB1 [J IF END.
7T2B BPZ 0 REN [J FI NOT DUMMY
7TG2 LDEX 0 0 [BOTTOM 9 BITS
7T^L #SKI K6REWRITE
7WF= BZE 0 ZGEOER3
7WYW ADX 5 0 [ADD TO PTR
7XDG BRN SCHLP
7XY6 YENDB1
7YCQ #SKI K6REWRITE
7YXB (
7^C2 LDX 0 FREADBLOCK(3) [LAST BLOCK
7^WL SBX 0 FBLMOD(2) [OF FILE
82B= SBN 0 A1-1 [IF SO
82TW BZE 0 ZEN [GEOERR ENDFILE
83*G )
83T6 LDN 0 1 [WE MAY HAVE STEPPED TO E.O.F &
84#Q ADS 0 FREADBLOCK(3) [THEN APPENDED, SO DO A "PSEUDO" STEP
84SB LDN 0 A1 [TO THE NEXT BLOCK & GO &
85#2 STO 0 FREADWORD(3) [GET IT
85RL ADDSKIP I516A,ARWFR
86?= CALL 4 VFREE [DEAL WITH SPENT BLOCK
86QW CALL 7 SEEKBLOCK
87=G REN
87Q6 STO 5 FREADWORD(3) [STORE REC PTR.
889Q CALL 7 SWITCHBLOCK [DO 'CAREFUL' UPDATING
88PB LDX 5 FREADWORD(3)
8992 MHUNTW 3,FILE,FWB [FIND FWB
89NL #SKI K6REWRITE
8=8= (
8=MW LDX 0 A1+FRH(3)
8?7G ANDX 0 BRHMASK
8?M6 BNZ 0 WRHD
8#6Q LDEX 0 A1+FRH(3)
8#LB SMO 5
8*62 LDX 7 FRH(1)
8*KL LDEX 4 7
8B5= ANDX 7 BRHMASK
8BJW BNZ 7 WRHD
8C4G BXE 4 0,SAMEHD
8CJ6 WRHD
8D3Q GEOERR 1,FWBRECHD [OLD ONE
8DHB )
8F32 SAMEHD
8FGL STO 1 GEN6 [STORE USAGE BLK POINTER.
8G2= ADX 1 5 [X1->CURRENT REC
8GFW NGS 2 GEN4 [NITIALIZE KEY LOCATION.
8G^G CALL 6 XKEYREC
8HF6 STO 7 GEN4 [STORE KEY
8HYQ LDX 1 3 [X1->FWB
8JDB ADN 1 A1 [X1->REC IN FWB
8JY2 CALL 6 XKEYREC
8KCL BRN TESTKEY [X7 CONTAINS KEY
8KX= NGS 2 7 [INDICATES NO KEY
8LBW TESTKEY
8LWG BXE 7 GEN4,YKEYSOK [J IF BOTH RECS HAVE SAME KEY
8MB6 GEOERR 1,ALTKEY
8MTQ YKEYSOK
8N*B LDX 1 GEN6
8NT2 NAME 1,FILE,FUWB
8P#L LDN 4 A1(3) [MOVING RECORD FROM
8PS= ADX 5 1 [MOVING RECORD TO
8Q?W SMO A1(3) [MOVE NUMBER OF WORDS IN RECORD
8QRG MOVE 4 0
8R?6 BS 2,BFALTR [SET 'REEL ALTERED' BIT.
8RQQ UP
8S=B #
8SQ2 #
8T9L [
8TP= WIND [WIND ENTRY,N/Z DEPTH
8W8W [
8WNG CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCBYX1->FSTACK
8X86 BRN MERGEWIND
8XMQ [
8Y7B ZWIND [WIND ENTRY,ZERO DEPTH
8YM2 [
8^6L LDN 6 0
8^L= CALL 7 NOWP1 [X3->FCA,X2->FCB,X1->FSTACK.
925W MERGEWIND
92KG #SKI K6REWRITE
9356 (
93JQ JMBS SWIND,3,BAMREAD,BAMAPP,BAMGEN,BAMCLEAN [CHECK FILE OPEN
944B [IN READ,APPEND,GENERAL OR CLEAN MODE.
94J2 GEOERR 1,CANTWIND [ERROR IF NOT
953L )
95H= SWIND
962W LDX 4 FBLMOD(2) [PICK UP -> TO LAST BLOCK OF FILE
96GG ADN 4 A1-1
9726 LDN 0 BSPRE
97FQ BXE 4 0,UPGO [J IF FILE IS EMPTY
97^B STO 4 FREADBLOCK(3) [TO POINT TO LAST BLOCK
98F2 LDX 0 CMOD(2) [IF APPEND -> IS POSITIVE JUST USE
98YL BNG 0 MUSTLOOK [THIS AS END OF FILE POINTER
99D= STO 0 FREADWORD(3)
99XW UP
9=CG MUSTLOOK
9=X6 LDN 0 1 [STEP O FBLOCK TW POINT TW
9?BQ ADS 0 FREADBLOCK(3) [AN "UNUSED" BL. NO.
9?WB NGS 0 FREADWORD(3) [END OF FILE"
9#B2 UP
9#TL UPGO
9**= NGS 2 FREADWORD(3)
9*SW UP
9B#G #
9BS6 #
9C?Q [
9CRB WRITBREAK [WRITEB. N/Z DEPTH PLUS BREAKIN PARAM
9D?2 [
9DQL LDCT 0 #400
9F== BRN XLOBS1
9FPW [
9G9G WRITANS [WRITEB. N/Z DEPTH PLUS ANSWER PARAME
9GP6 [
9H8Q LDCT 0 #200
9HNB BRN XLOBS1
9J82 [
9JML WRITFORCE [WRITEB. N/Z DEPTH PLUS FORCED PARAME
9K7= [
9KLW LDCT 0 #100
9L6G BRN XLOBS1
9LL6 [
9M5Q WRITEB [WRITEB. N/Z DEPTH
9MKB [
9N52 LDN 0 0
9NJL XLOBS1
9P4= STO 0 ACOMMUNE1(2)
9PHW CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK
9Q3G BRN MERGEWRB
9QH6 [
9R2Q ZWRITBREAK [WRITEB. ZERO DEPTH PLUS BREAKIN PARA
9RGB [
9S22 LDCT 0 #400
9SFL BRN XLOBS2
9S^= [
9TDW ZWRITANS [WRITEB. ZERO DEPTH PLUS ANSWER PARAM
9TYG [
9WD6 LDCT 0 #200
9WXQ BRN XLOBS2
9XCB [
9XX2 ZWRITFORCE [WRITEB. ZERO DEPTH PLUS FORCED PARAM
9YBL [
9YW= LDCT 0 #100
9^*W BRN XLOBS2
9^TG [
=2*6 ZWRITEB [WRITEB. ZERO DEPTH.
=2SQ [
=3#B LDN 0 0
=3S2 XLOBS2
=4?L STO 0 ACOMMUNE1(2)
=4R= LDN 6 0 [ZERO DEPTH
=5=W CALL 7 NOWP1 [X3 ->FCA,X-->FCB,X1->FSTACK.
=5QG MERGEWRB
=6=6 #SKI K6REWRITE
=6PQ (
=747 ... JMBS SWRITE,3,BAMWRITE,BAMGEN,BAMAPP [CHECK FILE OPEN IN WR
=7BJ ...
=7P2 [OR GENERAL MODE.
=88L WRAP
=8N= GEOERR 1,CAN'TAPP [ERROR IF NOT
=97W SWRITE
=9MG )
=9RC ... JBS WRAP,3,BACOMM
=9X# ...[ ERROR IF FILE OPEN IN COMMUNE MODE
==39 ...[ N.B. THIS CAN ONLY HAPPEN WITH *FH PERIS
==76 LDN 0 #77 [B18-23 OF FINFC NON-ZERO,
==LQ ANDX 0 FINFC(2) [IMPLIES INDEXED FILE.
=?6B BZE 0 NOTINDEX [ERROR IF SO.
=?L2 GEOERR 1,INDEXED!
=#5L NOTINDEX
=#K= LDN 0 2
=*4W NGS 0 CMOD(2)
=*JG ADDSKIP I516A,IWRIT
=B46 LDX 5 FBLMOD(2) [LENGTH OF FCB BEING USED
=BHQ LDX 0 5
=C3B SBN 0 FBLKS-A1 [NUMBER OF BLOCKS IN FILE BEING USED
=CH2 BXU 0 FSIZE(2),NOTFULL [J IF FILE NOT FULL
=D2L [THIS SECTION DEALS WITH PROCEEDURE WHEN FILE IS FULL
=DG= #SKI K6REWRITE>99-99
=D^W TRACE FLOC1(2),FILEFULL
=FFG SETREP FILEFULL
=F^6 UPPLUS
=GDQ UPPLUS 1
=GYB XBRK
=HD2 UP
=HXL NOTFULL
=JC= LDX 2 FX2
=JWW LDX 6 AWORK4(2) [DEPTH
=KBG APPCUBS XBRK,3 [ARE WE ALLOWED ANY MORE BLOCKS?
=KW6 TESTREPN OK,UPPLUS [J IF NOT
=L*Q CALL 7 NOWP
=LTB BXGE 5 FUSEBL(2),NEWFCB
=M*2 STOZ 7 [INDICATES NOT LENGTHENING FCB.
=MSL ADN 5 1 [ADD ONE TO LENGTH OF FCB USED
=N#= BRN UPFCB
=NRW NEWFCB
=P?G LDX 5 ALOGLEN(2)
=PR6 ADN 5 1
=Q=Q LDX 3 2
=QQB ALTLEN 3,5 [ALTLEN FCB
=R=2 CALL 6 SGETBACK [GET A B.S.BLOCK(IN ACC 5)
=RPL SMO FBLMOD(2)
=S9= STO 5 A1(2) [STORE NEW BLOCK IN FCB
=SNW ... LDX 7 6 [SET 'LENGTHENING FCB' SWITCH
=T8G LDN 5 1
=TN6 ADS 5 FUSEBL(2)
=W7Q ADX 5 FBLMOD(2)
=WMB UPFCB
=X72 MBS 2,BFALTB,BFALTR [SET BITS FOR BLOCKS AND FILE ALTERED
=XLL MHUNT 3,FILE,FWB [FIND THE FWB
=Y6= #SKI K6REWRITE
=YKW (
=^5G LDX 0 ALOGLEN(3)
=^K6 BXGE 0 BSBS,NOTSHORT [J IF FWB LONG ENOUGH
?24Q WRITERR
?2JB GEOERR 1,FWBSHORT
?342 )
?3HL NOTSHORT
?43= SMO FX2
?4GW LDX 6 AWORK4
?52G JBC NOTCARE,2,BFCARE [J IF NOT A 'CAREFUL' FILE.
?5G6 BZE 7 SETBIT [J IF FCB NOT LENGTHENED.
?5^Q LDX 0 FBLMOD(2)
?6FB SBN 0 FBLKS-A1-1
?6^2 MAPBIN 0,6 [INSERT BIT AT END(I.E APPEND BIT
?7DL BRN XPOINT
?7Y= SETBIT
?8CW LDX 0 FBLMOD(2)
?8XG SBN 0 FBLKS-A1-1
?9C6 MAPBSE 0,2
?9WQ XPOINT
?=BB CALL 7 NOWP [PTRS.
?=W2 MHUNT 3,FILE,FWB
??*L NOTCARE
??T= STO 5 FBLMOD(2) [WE CANT UPDATE FBLMOD UNTIL NOW
?##W [BECAUSE OF COPYFILE(MAPBIN &GETBAX
?#SG [COORDINATE). WE MUST ALSO RENAME WRI
?*#6 [BLOCK A FILE/FUWB WHEN WE B/WRITE IT
?*RQ SMO FBLMOD(2)
?B?B LDX 7 A1-1(2) [PICK UP BLOCK NO.(WHICH MAX HAVE CHA
?BR2 STO 7 BACK2(3) [OVER THE COORDINATION )
?C=L #SKI K6REWRITE
?CQ= (
?D9W BPZ 7 OKBSA
?DPG GEOERR 1,BACKADDR
?F96 OKBSA
?FNQ )
?G8B LDX 0 BSPRE(2) [OTHER GALF OF B.S.HOME PAIR
?GN2 STO 0 BACK1(3)
?H7L LDX 7 FBLMOD(2)
?HM= SBX 7 FSIZE(2)
?J6W VARIADNW 2
?JLG LDX 4 FBLMOD(2)
?K66 ADN 4 A1-1
?KKQ CHAIN 3,FX2
?L5B NAME 3,FILE,FUWB
?LK2 FILEAUTW 6,FAIL+FREE,,4
?M4L SBN 7 AF2-A1+FNEARLY
?MJ= BPZ 7 SETFNRP
?N3W SETREP OK
?NHG BRN UPPLUS
?P36 SETFNRP
?PGQ SKIPTRACE 99,7,FNEARLY
?Q2B SETREP FNEARLY
?QG2 BRN UPPLUS
?Q^L #
?RF= #
?RYW [
?SDG SUBS [SUBSTITUTE ENTRY,N/Z DEPTH
?SY6 [
?TCQ CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK
?TXB BRN MERGESTW
?WC2 [
?WWL ZSUBS [SUBSTITUTE ENTRY,ZERO DEPTH.
?XB= [
?XTW LDN 6 0 [DEPTH
?Y*G CALL 7 NOWP1 [X3 ->FCA,X2 ->FCB,X1 ->FSTACK
?YT6 MERGESTW
?^#Q #SKI K6REWRITE
?^SB (
#2#2 JMBS STWOK,3,BAMREAD,BAMAPP,BAMWRITE,BAMGEN [CHECK FILE OPEN
#2RL [IN READ,APPEND,WRITE OR GENERAL MODE
#3?= GEOERR 1,CANTSUBS
#3QW STWOK
#4=G )
#4Q6 ADDSKIP I516A,ISTPW
#59Q CALL 7 SEEKBLOCK [X1->USAGE BLOCK.
#5PB CALL 7 SWITCHBLOCK [CAREFUL UPDATING
#692 UP
#6NL #
#78= MENDAREA 50,K99REWRITE
#7MW #END
^^^^ ...00021622000100000000