{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSEFUL867)}}
====== CLOSEFUL867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:FC|FC]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JBC|JBC]], [[george:macro:JBCC|JBCC]], [[george:macro:JBS|JBS]], [[george:macro:JBSC|JBSC]], [[george:macro:JMBS|JMBS]], [[george:macro:LF|LF]], [[george:macro:LONGCOOR|LONGCOOR]], [[george:macro:LONGSET|LONGSET]], [[george:macro:MBC|MBC]], [[george:macro:MBS|MBS]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SFCA|SFCA]], [[george:macro:SFCAB|SFCAB]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPREWRITE|STEPREWRITE]], [[george:macro:TOPFCAB|TOPFCAB]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACEIF|TRACEIF]]
22FL ... SEG CLOSEFUL,860,SECTION FILE,CLOSE
24XQ #
257J ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
25CB '170 7 BRIEFPM
25X2 SEGENTRY K1CLOSEFUL,XENT1
26BL #
26W= # UPDATES THE DIRECTORY ENTRY
27*W # IF NO BLOCK NUMBERS HAVE CHANGED, JUST UPDATE THE NAME RECORD,
27TG # FREE ANY BS WE MAY HAVE BEEN GIVEN AND CLOSE THE DIRECTORY
28*6 # IF ONE BLOCK ONLY HAS CHANGED, THIS IS THE LAST STAGE OF THE
28SQ # CAREFUL UPDATE - WE DO A NON-AUTONOMOUS FILE WRITE FOR THE
29#B # NEW DIRECTORY ENTRY, FREE THE BS, DERING THE TRAILING FILES,
29S2 # RELEASE ANY CLOSESET WAITERS ON THESE FILES AND CLOSE THE
2=?L # DIRECTORY
2=R= # IF MORE THAN ONE BLOCK NUMBER HAS CHANGED, WE REWRITE THE BLOCKS
2?=W # RECORD BY A STEPWRITE, AND THEN GO ACROSS TO K8CLOSEDIR TO
2?QG # CLOSE THE DIRECTORY JUST UPDATED
2#=6 # IF THE LENGTH OF THE BLOCKS RECORD HAS ALTERED, WE REWRITE BY
2#PQ # INSERT/REPLACE BEFORE GOING ACROSS TO K8CLOSEDIR
2*9B #
2B8L MASKWRIT #57770000
2BBD ...MASKRV #177777 [BOTTOM 16 BITS =SIZE OF FEGMTRV
2BDB ...VALBIT16 65536 [=2**16 OR BIT 7
2BH? ...N4AST 4H****
2DLQ SINX
2F6B #HAL FI+FINDEXF,0
2F?J ...#
2FDQ ...#
2FL2 OLDFCB
2G5L LDN 0 1
2GK= SFCAB 0,2,2 [X2->FCB AT LEVEL 1
2H4W EXIT 7 0
2H#N ...#
2HJG OLDFCAB
2J46 LDN 0 1
2JHQ SFCAB 0,3,2 [X2->FCB X3->FCA AT LEVEL 1
2K3B EXIT 7 0
2K?8 ...#
2KH2 TOPFCAB
2L2L SFCAB ,3,2 [X2->FCB X3->FCA
2LG= EXIT 7 0
2L^W #
2MFG # FIND THE FMAPP AFTER THE BLOCK ADDRESSED BY X2
2M^6 SFMAPP
2NDQ ... LDX 0 FFSFMAPP
2PD2 XAGMAP
2PXL LDX 2 FPTR(2)
2QC= ... BXU 0 ATYPE(2),XAGMAP [J IF FMAPP NOT FOUND
2RBG EXIT 7 0
2RL# ...#
2RW6 # FIND FINDEXF BLOCK AFTER BLOCK ADDRESSED BY X2
2S*Q SFINX
2STB SMO FX1
2T*2 LDX 0 SINX
2TSL XINX
2W#= LDX 2 FPTR(2)
2WRW ... BXU 0 ATYPE(2),XINX [J IF NOT FINDEXF
2XR6 EXIT 7 0
2Y=Q #
2YQB # LOOK AT THE FILE BEING CLOSED (AT LEVEL 1) AND IF SOMEONE IS
2^=2 # COPYING IT, OR WRITING TO IT UNCLEANLY, CLOSE THE DIRECTORY AND
2^PL # WAIT UNTIL THEY'VE FINISHED. THEN GO BACK TO CLOSEONE TO REOPEN
329= # THE DIRECTORY AND TRY AGAIN
32NW [
338G [ UNCLEAN ACCESSORS, NOT MACROISED CODE, SHOULD BE!
33N6 WRITCLOSE
347Q JMBS XWT,2,BFMCOP,BFDCF,BFGDR
34MB LDX 0 CTOPEN(2)
3572 SMO FX1
35LL ANDX 0 MASKWRIT
366= BZE 0 (6) [EXIT UNLESS OPEN FOR WRITING
36KW STO 2 GEN2
375G STO 6 GEN6
37K6 LDCT 6 #004
384Q CALL 7 SEARCHFCA [LOOK FOR A CLEAN OPENER
38JB BRN XCLEAN [DONT WAIT IF CLEAN
3942 LDX 2 GEN2
39HL LDX 6 GEN6
3=3= ... BRN XWT
3=GW XCLEAN
3?2G LDX 2 GEN2
3?G6 LDX 6 GEN6
3?^Q EXIT 6 0
3#FB XWT
3#^2 BS 2,BFCLEANW
3*DL [ GOING TO WAIT IN STYLE CLOSEFREE
3*Y= LDX 1 2
3BCW ... TRACEIF K6CLOSEFUL,99,299,FLOC1(2),WT CLFR
3CC6 LONGSET CLOSEFREE,XBRK,BACK2(1)
3CWQ MFREEW FILE,ENT
3DBB CLOSETOP [CLOSE THE DIRECTORY FOR THE WAIT
3F*L LONGCOOR
3FT= ACROSS CLOSEONE,3 [TO OPEN THE DIRECTORY AGAIN
3TJ= #
4BM6 #
4C6Q # LOOK FOR AN FCA, IN THE FSTACK CONTAINING THE FCA ADDRESSED BY X3,
4CLB # WITH THE SAME BIT SET IN FGENERAL1 AS IN X6, AND LEAVE ITS
4D62 # ADDRESS IN X2
4DKL SEARCHFCA
4F5= SMO FBACKPOINT(3)
4FJW LDN 2 0(3)
4G4G LDEX 4 ARINGNO(2) [PICK COUNT OF ELEMENTS
4GJ6 ADN 2 A1 [SET X2-> FIRST ELEMENT
4H3Q SFCAPT
4HHB TXU 2 3
4J32 BCC OURFCA [J.IF OWN FCA
4JGL LDX 0 FGENERAL1(2)
4K2= ANDX 0 6 [CHECK AGAINST MASK
4KFW BNZ 0 (7) [AND EXIT IF FIT
4K^G OURFCA
4LF6 ADN 2 FELLEN [STEP TO NEXT ELEMENT
4MDB BCT 4 SFCAPT [EXIT +1 WHEN NOMORE FCAS IN STACK
4MY2 EXIT 7 1
4NCL #
4NX= # ANY FULLB'S BEHIND THE FMAPP ADDRESSED BY X6 ARE RECHAINED AFTER
4PBW # THE FMAPP ADDRESSED BY X5, OR AFTER THE FIRST FULLB IF PRESENT
4PWG MOVEFULLBS
4QB6 ... BXE 6 5,(7) [EXIT IF SAME FMAPP - SAME FILE
4QTQ ... LDX 4 FFSFULLB
4S#L SMO 5
4SS= LDX 2 FPTR
4T?W ... BXU 4 ATYPE(2),MVFLBS [J IF NO CURRENT FULLB
4W?6 LDX 5 2
4X=B MVFLBS
4XQ2 SMO 6 [X6->OLD FMAPP
4Y9L LDX 2 FPTR [X2->NEXT BLOCK
4YP= ... BXU 4 ATYPE(2),(7) [EXIT IF NO MORE FULLBS TO MOVE
4^NG CHAIN 2,5 [A FULLB
5286 BRN MVFLBS
52MQ #
537B # UPDATE THE COPY OF THE NAME RECORD IN THE ENT BLOCK
53M2 [ IF THE FOLLOWING CONDITIONS THEN EXIT 0+ => NAME RECORD UPDATE
546L [ NO OF BLOCKS CHANGED
54L= [ UWB SET
555W [ REVERED FILE
55KG [ NOT A VSF & REEL ALTERED IE UPDATE DATE WRITTEN CAREFULLY, THIS
5656 [ IS VITAL INFORMATION
56JQ # WE MAKE THE FOLLOWING CHANGES TO THE ENT AND THE FCB:
574B # RESET THE AVERAGE ACCESS TIME, DATE AND TIME LAST ACCESSED
57J2 # AND, IF WRITTEN TO, THE DATE AND TIME LAST WRITTEN
583L # AND THE TO-BE-DUMPED BIT
58H= # RESET EINF1 B4,5, EENDBUCK, EVERSION AND PUT FSIZE IN EINF3
592W # UNSET COMM B1,2,18,22 - BLOCKS ALT, FILE ALT, AUTOCLOSE-ON-
59GG # -THIS-FILE AND DONT-DUMP BITS
5=26 # UNSET FCOMM B20 - THE NOT-A-SYSTEM-CLOSE BIT
5=FQ # UNSET FGENERAL1 B17 - SHOWS THAT THE NAME REC.UPDATE IS DONE
5=^B # UNSET UNCLEAN WB'S IN COMM AND EINF1, AND CHECK CONSISTENCY
5??Q ...# CLEAR FEGMTRV IF NECESSARY
5?F2 UDATEDIR
5?YL MHUNTW 2,FILE,FINTER3
5#D= MHUNTW 3,FILE,ENT
5#QL ... TOPFCB 1 [DIR'S FCB
5#XW SMO A1(2)
5*CG LDCT 6 #776
5*X6 ADN 6 1
5BBQ LDN 0 1
5BWB ... SFCAB 0,2,2 [X2-> FCB AT DEPTH 1
5CB2 TXU 6 ECOPS(3)
5CTL BCS XCARE
5D*= JMBS XCARE,3,BEUWB,BEREVERE
5DSW JBS XNOTCARE,2,BFVSF
5F#G JBC XNOTCARE,2,BFALTR
5FLX ...XCARE
5F^# ... SBN 7 1
5G?Q XNOTCARE
5GRB ERS 6 ECOPS(3)
5H?2 ERX 6 ECOPS(3)
5HQL ERS 6 ECOPS(3) [OLD & NEW SWITCHED.
5J== SMO FX2
5JPW STO 6 AWORK3 [KEEP OLD ECOPS.
5K9G #
5KP6 # CALCULATE EAVACC
5LNB LDX 0 EAVACC(3)
5M82 BNZ 0 NZEAVACC [J IF EAVACC SET AT LAST CLOSE
5MML LDX 0 EWRITDAY(3)
5N7= BZE 0 SETEAVACC [J. NOT PREVIOUSLY WRITTEN TO.
5NLW LDX 0 GMTNOW
5P6G SBX 0 EGMTLA(3) [TIME BETWEEN ACESSES
5PL6 BRN TESTZERO
5Q5Q [ EAVACC= TIME BETWEEN ACESSES FOR 2ND ACCESS.
5QKB NZEAVACC
5R52 [ EAVACC= EXP FNC. OF OLD EAVACC & TIME SINCE LAST ACCESS.
5RJL LDX 0 EAVACC(3)
5S4= ADX 0 0
5SHW ADX 0 EAVACC(3) [3XEAVACC
5T3G SBX 0 EGMTLA(3)
5TH6 ADX 0 GMTNOW [+TIME BETWEEN ACCESSES.
5W2Q SRL 0 2 [= AVE ACCESS TIME
5WGB TESTZERO
5X22 BNZ 0 SETEAVACC
5XFL LDN 0 1 [1 UNIT OF GMT = EAVACC
5X^= SETEAVACC
5YDW STO 0 EAVACC(3)
5YH# ... LF 3,FEGMTRV,0 [GMT AT TIME OF LAST RETRIEVE
5YJ6 ... BZE 0 NOTRET [J IF UNSET
5YJY ... LDX 6 GMTNOW [THE CURRENT VALUE OF GMT
5YKQ ... SMO FX1
5YLJ ... ANDX 6 MASKRV [MASK OFF BOTTOM 16BITS
5YMB ... BXGE 6 0,NOVERF [J IF 16 BITS HAVE NOT OVERFLOWN
5YN8 ... SMO FX1 [COPE WITH OVERFLOW OF 16 BIT FIELD
5YP2 ... ADX 6 VALBIT16 [BY ADDING VALUE OF THE OVERFLOW BIT
5YPS ...NOVERF
5YQL ... SBX 6 0 [GET GMT SINCE RETRIEVE
5YR3 ... LDX 0 6
5YRD ... SEGENTRY K99CLOSEFUL [SEGENTRY FOR RETAINRV RESTORE TIME M
5YS= ... SBN 0 150 [DEFAULT 150 MINUTES
5YT4 ... BNG 0 NOTRET [J IF STILL WITHIN PROTECTED PERIOD
5YTW ... FC 3,FEGMTRV [ELSE CLEAR THE FIELD
5YWN ...NOTRET
5YYG LDX 0 EDATE
5^D6 STO 0 EDLA(3) [DATE LAST ACCESSED
5^XQ LDX 0 CLEANCT
62CB STO 0 ETLA(3) [TIME LAST ACCESSED
62X2 LDX 0 GMTNOW
63BL STO 0 EGMTLA(3)
63W= JBC NOTDUMP,2,BFALTR
64*W LDX 0 EDATE
64TG STO 0 EWRITDAY(3) [DATE LAST WRITTEN
65*6 LDX 0 CLEANCT
65SQ STO 0 EWRITTIME(3) [TIME LAST WRITTEN
66GB ... JBS NOTDUMP,2,BFDIR
66HB ... LDX 0 ELAN(3)
66JB ... SMO FX1
66KB ... SBX 0 N4AST
66LB ... BZE 0 USERJOBLIST
66MB ... BS 3,BEDUMP [IN ENT BLOCK FOR SUP
66NB ... JBC NODUMPER,,BDUMPING [IF DUMPER NOT ACTIVE
66PB ... HUNTMISB 3,FI,FDUMPCOM [DUMPER CLOSE COMMUNICATION BLOCK
66QB ... LDX 5 FUSE1(1)
66RB ... LDX 6 FUSE2(1)
66SB ... LDX 0 FUSE1(1)
66TB ... TXU 0 FDUMPUSER+2(3)
66WB ... TXU 6 FDUMPUSER+1(3)
66XB ... TXU 5 FDUMPUSER(3)
66YB ... BCS NSTDUMCOMBT
66^B ... BS 3,BFDUMPCOM
672B ...NSTDUMCOMBT
673B ... MHUNTW 3,FILE,ENT
674B ...NODUMPER
675B ... MBS 1,BFDUMP,BFDIRUPDATE
676B ... BRN NOMOREFNSAD
678B ...USERJOBLIST
679B ... LDX 0 ECOPS(3)
67=B ... SRL 0 15
67?B ... BZE 0 UJLEMPTY [IF JOBLIST IS EMPTY
67#B ... JBS NOMOREFNSAD,1,BFJOB4ASTR
67*B ... MBS 1,BFJOB4ASTR,BFDIRUPDATE
67BB ... BRN NOMOREFNSAD
67CB ...UJLEMPTY
67DB ... JBCC NOMOREFNSAD,1,BFJOB4ASTR
67FB ... BS 1,BFDIRUPDATE
67GB ... BRN NOMOREFNSAD
67HB ...NOTDUMP
67JB ... JBCC NOUPDATEDIR,2,BFDIRUPDATE
67KB ... JBC M1,2,BFDIRBELOW
67LB ... BS 3,BEDIRBELOW
67MB ... BRN M2
67NB ...M1
67PB ... BC 3,BEDIRBELOW
67QB ...M2
67RB ... JBC M3,2,BFDUMP
67SB ... BS 3,BEDUMP
67TB ...M3
67WB ... JBC M4,2,BFJOB4ASTR
67XB ... BS 3,BEJOB4ASTR
67YB ... BRN M5
67^B ...M4
682B ... BC 3,BEJOB4ASTR
683B ...M5
684B ... JBC M6,2,BFALLINCS
685B ... BS 3,BEALLINCS
686B ...M6
687B ...NOUPDATEDIR
688B ...NOMOREFNSAD
68=W MBC 3,BEMULT,BEFOPENER
68QG LDX 0 COMM(2)
69=6 ANDN 0 #14 [STREAM-MEMBER AND OPEN-TO-ERASE BITS
69PQ SRC 0 8
6=9B ORS 0 EINF1(3) [AND REPLACE BY B20-21 FROM COMM
6=P2 LDX 0 FENDBUCK(2)
6?8L STO 0 EENDBUCK(3)
6?N= LDX 0 FVERSION(2)
6#7W STO 0 EVERSION(3)
6#*4 ... LDX 0 FETM(2) [TYPE-MODE WORD
6#G= ... STO 0 ETM(3) [FCB=>DIR ENT
6#MG LDX 0 FSIZE(2)
6*76 DEX 0 EINF3(3)
6*?3 ... JBC NOTABD,2,BFCLOSEAB
6*BY ... BS 3,BECLOSEAB
6*GT ...NOTABD
6*SK ... MBC 2,BFALTB,BFALTR,BFSOLE,BFAUTO
6B6B JBSC XINDALT,2,BFINDEXALT
6BL2 LDX 0 FINFC(2)
6C5L ANDN 0 #77
6CK= ... BZE 0 XINDALT [NO CFINDEXF BLOCK
6D4W MFREE FI,CFINDEXF [FREE IF INDEX NOT ALTERED.
6DJG XINDALT
6JFG LDX 0 CTOPEN(2)
6J^6 SMO FX1
6KDQ ANDX 0 MASKWRIT
6KYB ... BNZ 0 NOUNCL
6LHX ... JBCC NREVERE,2,BFREV
6LMS ... BC 3,BEREVERE [CLEAR 'REVERE' BIT
6LRP ...NREVERE
6LT2 ... LDX 0 FWAITCOUNT(2)
6LW? ... BNZ 0 NOUNCL
6LXL JBCC SAME,2,BFUWB
6MC= JBSC NOUNCL,3,BEUWB
6MWW GEOERR BRIEFPM,CLEAN???
6NBG SAME
6NW6 JBC NOUNCL,3,BEUWB
6P*Q GEOERR BRIEFPM,UNCLEAN
6PTB NOUNCL
6P^? ... LDN 0 1
6Q58 ... SFCA 0,1 [X1-> FCA AT LEVEL 1
6Q7R ... BC 1,BASOLE [CLEAR 'AUTONOMOUS CLOSE HAS FILE
6Q=B ... [ OPEN' BIT
6Q*2 EXIT 7 1
6S?G #
6SR6 # ENTRY FROM CLOSEONE TO UPDATE THE DIRECTORY
6T=Q # THE DIRECTORY IS OPEN AT LEVEL 0, THE FILE BEING CLOSED AT LEVEL 1
6TQB # AND THERE COULD BE CONVERTED FILES AT HIGHER LEVELS, RINGED
6W=2 # IN UNTIL THE CAREFUL UPDATE ENDS
6WPL XENT1
6XNW STEPAGAIN
6Y8G STO 3 AWORK4(2) [STORE POINTER TO NAME REC.
6YN6 ... CALL 7 OLDFCAB [RELOCATE FCB (X2->FCB,X3->FCA AT
6^7Q ... [ DEPTH 1)
7272 CALL 6 WRITCLOSE [WAIT IF THERE'S A WRITER OR COPIER
72LL #
736= # MOVE THE FILE'S BLOCK NUMBERS INTO THE FINTER3, CHECKING FIRST
73KW # THAT THE FINTER3 IS STILL THE RIGHT LENGTH - THE FCB MAY
745G # HAVE CHANGED IN LENGTH OVER THE LAST COORDINATION
74K6 # THIS IS THE NEW BLOCKS RECORD. FROM NOW ON ANY CHANGES IN THE FCB
754Q # WILL HAVE TO BE TAKEN CARE OF BY ANOTHER CLOSE
75JB #
7642 MHUNTW 3,FILE,FINTER3
76HL LDX 4 FBLMOD(2)
773= SBN 4 FBLKS-A1-2
77GW TXU 4 ALOGLEN(3)
782G BCC OKBLKS [J IF FINTER STILL RIGHT LENGTH
78G6 ... TRACEIF K6CLOSEFUL,99,299,4,ALT FIN3
79FB ALTLEN 3,4 [ALTER IF NOT
79^2 HUNTW 3,FI,CFINDEXF [IF EXIST IN THE
7=DL ... BNG 3 XENT1 [ACTIVITY CHAIN ITS LENGTH WILL
7=Y= ADN 4 1 [HAVE CHANGED AS WELL AS THE
7?CW NOWALT
7?XG ... ALTLEN 3,4
7#C6 ... BRN XENT1
7#WQ OKBLKS
7*BB STO 4 A1(3) [STORE BLOCKS RECORD HEADER
7*W2 ADN 3 A1+1
7B*L ADN 2 BSPRE
7BT= SMO 4
7C#W MOVE 2 511 [SET UP THE BLOCKS RECORD
7CSG #
7D#6 # IF THIS IS AN INDEXED FILE AND THE INDEX HAS BEEN ALTERED, COPY
7DRQ # THE FINDEXF IN THE FILE CHAIN TO THAT IN THE ACTIVITY CHAIN
7F?B #
7FR2 HUNTW 3,FI,CFINDEXF
7G=L BNG 3 NFIN [J NOT INDEXED.
7GQ= CALL 7 OLDFCB
7H9W JBC NFIN,2,BFINDEXALT
7J96 CALL 7 SFINX
7JNQ LDN 2 A1(2) [X2->FINDEXF IN FILE CHAIN
7K8B ... LDN 3 A1(3) [X3->CFINDEXF IN ACTIVITY CHAIN
7KN2 SMO FRH(2)
7L7L MOVE 2 0
7LM= NFIN
7M6W #
7MLG # PUT ANY SPARE BLOCKS IN A FULLB AND CHAIN IT AFTER
7N66 # THE DIRECTORY'S FMAPP
7NKQ #
7P5B CALL 7 OLDFCAB [X2->FCB, X3->FCA OF FILE AT LEVEL 1
7PK2 LDN 0 #20
7Q4L ANDX 0 FGENERAL2(3) [X0=1 IF THERE'S AN EMPTYB
7QJ= LDX 4 FUSEBL(2)
7R3W SBX 4 FBLMOD(2)
7RHG BNZ 4 SPARE1 [J IF SPARE BLOCKS
7S36 BZE 0 NOSPARE1 [J IF NO EMPTYB NOR SPARE BLOCKS
7SGQ MFREEW BSTB,EMPTYB
7T2B BRN NOSPARE2
7TG2 SPARE1
7T^L ADN 4 2
7WF= BNZ 0 SPARE2 [J IF SPARE BLOCKS AND EMPTYB
7WYW SETUPCORE 4,2,BSTB,EMPTYB
7XDG ... CALL 7 OLDFCAB [X2->FCB, X3->FCA OF FILE AT DEPTH 1
7XY6 BS 3,BAEMPTYB
7YCQ ... BRN XENT1
7YXB SPARE2
7^C2 MHUNTW 3,BSTB,EMPTYB
7^WL TXU 4 ALOGLEN(3)
82B= BCS NOWALT [J TO ALTLEN IF LENGTH CHANGED
82TW NAME 3,BSTB,FULLB
83*G STO 4 A1(3)
83T6 SBN 4 2
84#Q JBC NOTCAREFUL,2,BFCARE
84SB [ NOW UP-DATE FBITMOD IN THE FMAPP BLOCK.
85#2 [ RESET NO OF BLOCKS IN FILE IN THE FMAPP BLOCK.
85RL LDX 6 2 [COPY OF LEVEL 1 FCB ADDR.
86?= CALL 7 SFMAPP [X2-> FMAPP
86QW SMO 6 [X6->FCB
87=G LDX 0 FUSEBL
87Q6 SBN 0 FBLKS-A1
889Q STO 0 FBITMOD(2) [NO OF BLOCKS ALLOCATED.
88PB LDX 2 6 [RESET X2-> FCB1
8992 NOTCAREFUL
89NL LDX 0 BSPRE(2)
8=8= STO 0 A1+1(3) [FILE RESIDENCE
8=MW ADX 2 FBLMOD(2)
8?7G ADN 2 A1
8?M6 ADN 3 A1+2
8#6Q SMO 4
8#LB MOVE 2 0 [MOVE IN THE SPARE BLOCKS
8*62 SBN 3 A1+2 [X3->FULLB
8*KL LDX 6 3
8B5= CALL 7 TOPFCAB [X2->FCB OF DIRECTORY AT LEVEL 0
8BJW CALL 7 SFMAPP [X2->FMAPP
8C4G LDX 2 FPTR(2)
8CJ6 LDX 7 ATYPE(2)
8CRY ... TXU 7 FFSFULLB
8DHB BCC YFULLB [J IF FULLB AFTER FMAPP
8F32 LDX 2 BPTR(2)
8FGL YFULLB
8G2= CHAIN 6,2 [CHAIN AFTER FMAPP, OR FULLB IF THERE
8GFW CALL 7 OLDFCB [X2->FCB AT LEVEL 1
8G^G SBS 4 FUSEBL(2)
8HF6 NOSPARE2
8HYQ CALL 7 OLDFCAB [X2->FCB, X3->FCA OF FILE AT LEVEL 1
8JDB #
8JY2 # INDICATE, IN AWORK2, HOW MANY BLOCK NUMBERS HAVE CHANGED:
8KCL # IF CAREFUL, FBCOMM IN THE FMAPP HAS
8KX= # B22 SET IF MORE THAN ONE BLOCK HAS CHANGED
8LBW # B23 SET IF ONLY ONE HAS CHANGED
8LWG # IF NOT CAREFUL, AND BLOCKS ALT BIT SET, SET AS IF MORE THAN
8MB6 # ONE BLOCK CHANGED
8MTQ # REINITIALISE THE FMAPP AND GIVE ANY FULLB'S TO THE DIRECTORY, IF
8N*B # WE'RE CLOSING A CAREFUL FILE
8NT2 NOSPARE1
8P#L JBC NOMAP,2,BFCARE
8PS= CALL 7 SFMAPP [LOCATE FMAPP WITH X2
8Q?W LDX 0 FBCOMM(2)
8QRG ANDN 0 3
8R?6 SMO FX2
8RQQ STO 0 AWORK2 [KEEP FBCOMM B22,23
8S=B ERS 0 FBCOMM(2) [RECOVER AND INITIALISE FBCOMM
8SQ2 LDX 6 2
8T9L LDX 2 ALOGLEN(2)
8TP= SBN 2 FBITS-A1 [NO OF FBITS WORDS
8W8W BZE 2 MVBS [J IF NO FBITS
8WH? ...MORB
8WTN ... SMO 6
8X86 STOZ FBITS-1(2)
8XMQ BCT 2 MORB
8Y27 ...MVBS
8Y#J ... LDX 2 6
8YM2 LDX 2 FPTR(2)
8^6L ... LDX 4 FFSFULLB
8^L= TXU 4 ATYPE(2)
925W BCS MAPHAS [J IF NO BS TO MOVE
92KG TOPFCB 2
9356 CALL 7 SFMAPP [LOCATE NEW FMAPP
93JQ LDX 5 2
944B CALL 7 MOVEFULLBS [AND MOVE THE BS
94J2 BRN MAPHAS
953L NOMAP
95H= LDCT 0 #200
962W ANDX 0 COMM(2)
96GG SLC 0 3
9726 SMO FX2
97FQ STO 0 AWORK2 [B22 SET IF ANY BLOCKS ALT
97^B MAPHAS
98F2 CALL 7 UDATEDIR [UPDATE THE ENT BLOCK
98YL BRN NUMCHANG [J.IF ECOPS IS ALTERED
99D= LDX 2 FX2
99XW LDX 0 AWORK2(2)
9=CG ANDN 0 2
9=X6 BNZ 0 MANYALT [J IF MORE THAN ONE BLOCK NO CHANGED
9?BQ LDX 4 AWORK4(2) [POINTER TO NAME REC IN USAGE BLOCK
9?WB ADN 3 A1
9#B2 LDEX 1 FRH(3)
9#TL MOVE 3 0(1) [MOVE IN THE UPDATED NAME RECORD
9**= LDX 3 4
9*SW STEPREWRITE
9B#G LDX 0 AWORK2(2)
9BS6 BNZ 0 ONEALT [J IF ONLY ONE BLOCK NO.CHANGED
9C?Q [ NOTE THAT THE CASE WHERE A FILE THAT WAS OPEN NON-CAREFULLY BUT
9CRB [ IS NOW OPEN CAREFULLY, AND WAS PREVIOUSLY ALTERED IS CATERED FOR
9D?2 [ BY UPDATEDIR.
9FPW ACROSS CLOSEALT,1
9G9G NUMCHANG
9GP6 ACROSS CLOSEALT,2
9H8Q MANYALT
9HNB ACROSS CLOSEALT,3
9J82 ONEALT
9JML ACROSS CLOSEALT,4
9N52 XBRK
9NJL GEOERR BRIEFPM,CL BRKIN
9P4= ...#
9Q3G #END
^^^^ ...02302746000200000000