(George Source)
Macros used: ACROSS, ADDMODE, APVSF, BACKSPACE, BASEFCB, BC, BS, BXE, BXU, CHAIN, CLOSETOP, COOR3, DOWN, FREECORE, GEOERR, GFCBC, HUNT, JBC, JBS, JMBAC, LONGOFF, LONGON, LONGSET, LONGSTOP, MBS, MFREE, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, NEXTFCB, NXFCA, OPEN, OUTPACK, READ, REOPEN, REWRITE, SEG, SEGENTRY, SETNCORE, SETREP, SETREP2, TESTMODE, TESTNAMX, TESTREP2, TOPFCA, TOPFCB, TRACE, TRACEIF, TRANSFCB, TRF, UP, UPPLUS, VFREEBAX, VFREEW
22FL ... SEG ORELMAIN,70,ROB RUSHTON ,OPEN [8OPAE 22KH ...[ 22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 22T* ...[ 22^= SEGENTRY K1ORELMAIN,Z1ORELMAIN 23DW SEGENTRY K4ORELMAIN,Z4ORELMAIN 23YG [ 24D6 XCMM #30200040 [MASKS FOR PRESERVING COMM& FCOMM FRO 24XQ XFCMM #42357 [FILE CHAIN FCB WHEN IT IS BEING 25CB [OVERWRITTEN BY ACTIVITY CHAIN FCB IN 25X2 [EMPTY MODE CASE 26BL WTFR +FWFREE 26W= ...# 27*W ...# 2#PQ XGETFCB 2*9B ... BVCI £ 2B8L [ THIS ROUTINE FINDS FCB WHOSE UNIQUE NUMBER IS IN X6 & EXITS + 0 IF 2BN= [ FCB NOT FOUND & +1 IF IT IS 2C7W XGFCB 2CMG GFCBC 6,3,NF 2CT* ... BVCR X1 2D38 ...X0 2D93 ... EXIT 2 0 2DBW ...X1 2DJP ... EXIT 2 1 2DQJ ...NF BVC X0 2DYC ... GEOERR 1,FCB MISS 2F6B [THIS ROUTINE TESTS WHETHER THE FCB INDICATED BY X2 CAN BE OPENED 2FL2 YCOP 2G5L JMBAC OK,2,BFFCB,BFMCOP [WAIT IF OPEN OR BEING OPENED IN COPY 2GK= BRN WAIT [IS ALREADY OPEN 2H4W TRYREEL 2HJG TESTMAIN 7,YCOP,,COPY [DO EXTRA TESTS IF COPY MODE 2J46 TESTMODE 7,ORDINARY,NOT,EMPTY[J UNLESS EMPTY MODE 2JHQ JBS OPDIR,2,BFDIR [J IF A DIRECTORY 2K3B LDX 4 FWAITCOUNT(2) [WE MUST MAKE SURE THAT 2KH2 ORX 4 CTOPEN(2) [THE FILE IS UTTERLY UNUSED. 2L2L SLC 4 1 2LG= SLL 4 1 [COMMUNE BIT DOESN'T MATTER. 2L^W ORX 4 FREEZECOUNT(2) [NO GOOD IF FROZEN 2MFG ORX 4 FSVCT(2) [OR SAVED 2M^6 BNZ 4 NOK 2NYB JMBAC OK,2,BFFCB,BFMCOP [& FILE OPEN OR BEING OPENED IN COPY 2PD2 NOK 2PXL LDN 4 0 [ZEROISE REPLY MARKER 2QC= TESTMODE 7,SAYCANT,,REPLY [DON'T WAIT IF REPLY MODE 2QWW LDX 5 BACK1(2) [KEEP BACKING STORE HOME PAIR 2RBG LDX 6 BACK2(2) 2RW6 LONGSET 6,XSET,6 2S*Q LDX 0 WTFR(1) 2STB STO 0 AWORK4(2) 2T*2 TESTMODE 7,NOUWB,,CAREFUL [DON'T SET UWB IF CAREFUL MODE 2TSL BS 3,BFUWB 2W#= NOUWB 2WRW BS 3,BFEMPTY [SET WAITING TE EMPTY BIT ANYWAY 2X?G DOWN OPENWAIT,2 [GO DOWN TO WAIT FOR FILE TO BE FREE 2XR6 BRN XBR 2Y=Q CALL 2 XGFCB 2YQB BRN NF1 2^=2 BC 3,BFEMPTY [CLEAR 'WAITING TO EMPTY'BIT (WHO SET 2^PL NF1 329= LDX 2 FX2 32NW TESTREP2 DIRCLOSE,XDC,CLUDGE,UPCLD,OK,REOP 338G SETREP2 NAME 347Q UPPLUS 1 34MB XBRK [BREAKIN DURING OPENWAIT OR LONGSTOP 3572 CALL 2 XGFCB 35LL BRN XBRK2 366= LDN 0 1 36KW SBS 0 FWAITCOUNT(3) [BROKEN IN SO NO LONGER WAITING 375G XBRK2 37K6 VFREEW FILE,FCB [FREE FCB IF PRESENT 384Q VFREEBAX 38JB UP 3942 XBR 39HL CALL 2 XGFCB 3=3= BRN NF2 3=GW BC 3,BFEMPTY [UNSET 'WAITING TO EMPTY'BIT (?) 3?2G NF2 3?G6 LONGON 6,6 [WAKE UP ANY OTHER WAITERS 3?^Q BRN XBRK2 3#FB UPCLD 3#^2 NGN 4 1 [SET CLUDGE MARKER 3*DL CALL 2 XGETFCB [FIND FCB AGAIN 3*Y= BRN SAYCANT [CLEAR UP 3BCW REOP 3BXG [BEFORE GOING BACK TO OPENREL MUST CHECK GEN NO AND IF ZERO SET BIT 2 3CC6 MHUNT 1,FILE,FLOCNB [BUG 1860 3CWQ LDX 0 A1+4(1) 3DBB BNZ 0 REOPEN [J IF NOT ZERO 3DW2 LDCT 0 #100 3F*L STO 0 A1+4(1) [OTHERWISE SET BIT 2 OF GEN 3FT= REOPEN 3G#W ACROSS OPENREL,5 [START RE-OPENING THE FILE 3GSG OPDIR GEOERR 1,DIREMPTY [OPENREL EMPTY ON A DIRECT-ORY 3H#6 [NO ONE CAN BE USING THE FILE IN ANY SENSE IN THE MULTI-REEL/EMPTY CASE. 3HRQ [WE MIGHT AS WELL DO THE SAME FOR ONE REEL. 3J?B ORDINARY 3JR2 LDX 4 CTOPEN(2) [PICK UP OPEN MODE: 3K=L TRACEIF K6ORELMAIN,199,299,4,CTOPEN 3KQ= [FORMAT IS; L.S. 12 BITS,COUNT OF READ OPENERS. NEXT L.S. 9 BITS,COUNT 3L9W [OF APPEND OPENERS. B0=SOLE OPENER BIT B1=COMMUNAL BIT. 3LPG LDX 0 FREEZECOUNT(2) 3M96 BZE 0 NOFRZ [OK IF NOT FROZEN 3MNQ TESTMAIN 7,TSYC,NOT,READING [IF NOT READER J TO TEST FOR SYSTCOMM 3N8B ... TESTMODE 7,WAIT,,DESTRUCT,GDESTR [WAIT IF READ + DESTRUCT OR GDR. 3NN2 BRN NOFRZ 3P7L TSYC 3PM= TESTMODE 7,WAIT,NOT,SYSTCOMM [WAIT UNLESS SYSTCOMM TO ALLOW LOGANA 3Q6W [WRITE TO FROZEN MONFILE 3QLG [ALLOW SOMEONE TO LF MONILE & 3R66 [THEN OL AN OUTPUT PERI TO IT 3RKQ NOFRZ 3S5B LDX 0 FSVCT(2) [J IF THE FILE IS NEITHER READ- NOR 3SK2 BZE 0 NOSFZ [WRITE-FROZEN 3T4L ANDN 0 #7777 3TJ= BZE 0 NRF [J IF NOT READ-FROZEN 3W3W LDX 0 FSVCT(2) 3WHG ANDX 0 HALFTOP 3X36 BNZ 0 RWF [ERROR IF ALSO WRITE-FROZEN 3XGQ TESTMAIN 7,NOSFZ,,READING [OK IF READER 3Y2B BRN WAIT 3YG2 RWF GEOERR 1,REWRFROZ 3Y^L NRF 3^F= TESTMAIN 7,WAIT,NOT,UNCLEAN 3^YW TESTMODE 7,WAIT,NOT,REOPEN [WAIT UNLESS REOPEN MODE 42DG NOSFZ 42Y6 BZE 4 OK [CARRY ON IF FCB OPEN 43CQ TESTMAIN 7,S31,NOT,READING 43XB LDX 0 4 44C2 SRL 0 12 [ISOLATE APPEND COUNT & SOLE BIT 44WL ANDN 0 #5777 [RID OF COMMUNE BIT. 45B= BNZ 0 TBC [TRY FOR COMMUNE MODE & FILE 45TW TESTMODE 7,WAIT,,DESTRUCT [WAIT IF FILE DESTRUCT OR GDR & MODE 46*G JBS WAIT,2,BFDCF 46T6 TESTMODE 7,NDR1,NOT,GDESTR 47#Q JBC WAIT,2,BFGDR 47SB LDX 1 FCOMMCT(2) 48#2 SRL 1 12 48RL TESTMODE 7,NC1,NOT,COMMUNE [J UNLESS COMMUNE 49?= BZE 1 WAIT [J IF NOT OPEN IN COMMUNE 49QW BRN OK [OK SINCE FILE OPEN IN GDR & COMMUNE, 4==G [& MODES GDR & COMMUNE GIVEN 4=Q6 NC1 4?9Q BNZ 1 WAIT [J IF OPEN IN COMMUNE 4?PB BRN OK [OK SINCE FILE OPEN IN GDR & NOT 4#92 NDR1 [COMMUNE & GDR GIVEN BUT NOT COMMUNE 4#NL JBS WAIT,2,BFGDR [WAIT IF OPEN IN GDR & GDR MODE ABSEN 4*8= BRN OK 4*MW S31 4B7G LDEX 0 FREEZECOUNT(2) 4BM6 BZE 0 TBC [IF FROZEN WAIT UNLESS SYSTCOMM 4C6Q TESTMODE 7,WAIT,NOT,SYSTCOMM [ALLOWS LF MONFILE THEN OL MONFILE (B 4CLB TBC 4D62 LDX 4 FCOMMCT(2) 4DKL ANDN 4 #7777 [CT OF CLEAN OPENERS 4F5= BZE 4 RCOMM [J IF NONE 4FJW TESTMODE 7,WAIT,NOT,USERCLEAN[WAIT UNLESS USERCLEAN 4G4G LDX 0 CTOPEN(2) 4GJ6 BPZ 0 RDCT [J IF NO WRITER 4H3Q TESTMAIN 7,WAIT,NOT,READING 4H?J ...OK 4H?L ... JBC NABOK,2,BFCLOSEAB [J IF FILE NOT TO BE CLOSEABANDONED 4H?N ... TESTMODE 7,NABOK,,REOPEN 4H?Q ... SMO FX2 [ONLY ALLOW FILE TO BE OPENED BY 4H?S ... LDX 0 ATYPE [LISTFILE OR HLS / JOBWELL 4H?W ... SRL 0 18 4H?Y ... SBN 0 ACTLF/64 4H#2 ... BNZ 0 WAIT [OTHERWISE WAIT FOR CLOSEABANDON TO F 4H#4 ...NABOK 4H#B ...# 4H#R ...# 4HR8 ... EXIT 6 0 4J32 RCOMM 4JGL LDX 4 FCOMMCT(2) 4K2= BZE 4 WAIT [WAIT IF NO COMMUNERS 4KFW JBC NOSYS,3,BFSYSCOMM [J IF FILE NOT OPEN IN SYSTCOMM MODE 4K^G TESTMODE 7,WAIT,NOT,SYSTCOMM [WAIT UNLESS MODE ALSO SYSTCOMM 4LF6 BRN TDES [J TO TEST FOR APPENDERS IF IT IS 4LYQ NOSYS 4MDB TESTMODE 7,WAIT,NOT,COMMUNE [WAIT UNLESS COMMUNE MODE GIVEN 4MY2 TESTMODE 7,NOTDESTRUCT,NOT,DESTRUCT 4NCL JBC WAIT,2,BFDCF [WAIT IF MODE GIVEN IS DESTRUCT & FIL 4NX= BRN TDES 4PBW NOTDESTRUCT 4PWG JBS WAIT,2,BFDCF [WAIT IF MODE GIVEN NOT DESTRUCT & FI 4QB6 TDES 4QTQ TESTMODE 7,NGD2,NOT,GDESTR [J UNLESS GDR MODE 4R*B JBS OK,2,BFGDR [OK IF GDR MODE & FILE OPEN IN GDR 4RT2 BRN WAIT [OTHERWISE WAIT 4S#L NGD2 4SS= JBS WAIT,2,BFGDR [WAIT IF FILE GDR & GDR MODE NOT GIVE 4T?W [BUT FILE OPEN IN GDR 4TRG LDX 0 CTOPEN(2) 4W?6 SRL 0 12 4WQQ ANDN 0 #1777 [EXTRACT APPEND CT 4X=B BZE 0 RDCT1 [J IF NO APPENDERS 4XQ2 JBC OK,2,BFDCF [FOR MULTIPLE APPENDERS (SEE ALSO CLO 4Y9L TESTMAIN 7,WAIT,,APPEND 4YP= BRN OK [ 4^8W RDCT1 4^NG SRL 4 12 5286 RDCT 52MQ LDX 0 CTOPEN(2) 537B ANDN 0 #7777 [CT OF READERS 53M2 ERX 4 0 546L BZE 4 OK [J IF EQUAL 54L= BRN WAIT 555W [ 55KG Z1ORELMAIN 55T# STOZ AWORK4(2) 5656 MHUNTW 2,FILE,FCB [PICK UP VERSION IN ACTIVITY CHAIN 592W [AN FCB HAS BEEN FORMED WITH THE CORRECT SHORT NAME 59GG [SEARCH THE FILE CHAIN TO SEE IF THIS FCB IS ALREADY THERE 5=26 [SOME OF THE WORDS TO BE COMPARED ARE CONTAINED IN X4,X5,X6&X0 5=FQ [FOR HALFOPEN FILES WE MUST SEARCH BOTH OPEN AND HALFOPEN FILE CHAINS 5=^B [ FOR THE FCB. IF THE FCB IS FOUND IN THE HALFOPEN CHAIN IT IS RECHAINE 5?F2 [ IN THE OPEN FILE CHAIN 5?YL ... 5#D= ... STOZ GEN0 5#XW ... LDX 4 FLOC1(2) 5*CG ... LDX 0 BACK2(2) [DIR OR TERM FILE 5*X6 ... BNG 0 ZDIRS [B IF DIR 5BBQ ... BASEFCB 3,FILE,ZNF,6 [FILE SEARCH 5BWB ...ZLOOPF 5CB2 ... BXE 4 FLOC1-FCBRING(3),ZSOK 5CTL ...ZRETSF 5D*= ... NEXTFCB 3,FILE,ZLOOPF,6 5DSW ... BRN ZNF 5F#G ...ZRETSQ 5FS6 ... LDX 0 BACK2(2) 5G?Q ... BPZ 0 ZRETSF 5GRB ... BRN ZRETS 5H?2 ... 5HQL ...ZLOOP 5J== ... BXE 4 FLOC1-FCBRING(3),ZSOK [COMPARE FIRST WORD 5JPW ...ZRETS 5K9G ... NEXTFCB 3,DIR,ZLOOP,6 [TRY NEXT FCB 5KP6 ... LDX 1 GEN0 [HAVE WE SEARCHED BOTH CHAINS 5L8Q ... BNZ 1 ZNF [YES JUST SEARCHED HALF 5LNB ...ZNODIR 5M82 ... STO 2 GEN0 [SET GEN0 NON ZERO 5MML ... BASEFCB 3,HALF,ZNF,6 [PREPARE TO SEARCH HALF OPEN CHAIN 5N7= ... BRN ZLOOP 5NLW ...ZDIRS 5P6G ... BASEFCB 3,DIR,ZNODIR,6 [PREPARE TO SEARCH DIR CHAIN 5PL6 ... BRN ZLOOP 5Q5Q ...ZSOK [FIRST NAME NOW AGREES 5QKB ... TESTNAMX 9,FUSER1-FCBRING(3),FUSER1(2),ZRETSQ,1 5R52 ... SBN 3 FCBRING [COMPLETE NAAME AGREES 5RJL ... LDX 1 GEN0 5S4= ... BZE 1 ONEREEL [B IF FOUND ON FILE CHAIN 5SHW ... 5T3G ... LDX 2 3 [FOUND ON HALF THEREFORE RECHAIN 5TH6 ... LDX 3 FPTR(2) 5W2Q ... TRANSFCB 2,HALF,FILE 5WGB ... CHAIN 3,BFILE+1 [CHAIN FINDEXF BLOCK AS WELL 5X22 ... LDX 3 BFILE+1 5XFL ... LDX 3 BPTR(3) 5X^= ... BRN ONEREEL 5YDW ...ZNF [NOT FOUND ON FILE CHAINS 5YYG ... TRANSFCB 2,ACT,FILE 5^D6 ... LDX 3 BFILE+1 65*6 LDX 0 FINFC(3) [IF FILE IS INDEXED THE FINDEXF 65SQ ANDN 0 #77 [IN THE ACTIVITY CHAIN MUST BE 66#B BZE 0 ONEREEL [CHAINED AFTER FCB JUST PUT IN 66S2 HUNT 1,FI,FINDEXF [FIEL CHAIN 67?L CHAIN 1,3 67R= BRN ONEREEL 68=W WAIT 68QG LDN 4 0 69=6 TESTMODE 7,OOR3,NOT,REPLY [WAIT UNLESS REPLY MODE 69PQ SAYCANT 69^J ... TESTMAIN 7,POSN,,COPY 6=9B TESTMAIN 7,UNCLMODE,,UNCLEAN 6=P2 TESTMODE 7,UNCLMODE,,GDESTR [GDESTR MODE IS UNCLEAN - JUMP 6?8L POSN 6?N= TESTMODE 7,NREWR,,EMPTY [J IF EMPTY MODE 6#7W MHUNTW 1,FILE,ENT [IF FILEHAS NOT BEEN RETRIEVED 6#MG LDX 0 ECOPS(1) [BECAUSE FCB FOUND & IT STILL HAS 6*76 ANDN 0 1 [NOT BEEN RESTORED DON'T BACKSPACE 6*LQ BZE 0 NREWR 6B6B BACKSPACE [POINTERS POSITIONED ON COPIES REC 6BL2 BRN NREWR [AND WE MUST BACKSPACE (BUG 1913) 6C5L UNCLMODE 6CK= JBS POSN,3,BFUWB [J IF FILE ALREADY OPEN UNCLEANLY 6D4W TESTMODE 7,POSN,,CAREFUL [J IF CAREFUL 6DJG MHUNTW 1,FILE,ENT 6F46 NAME 1,FILE,FWB 6FHQ BC 1,BEUWB [REMOVE UWB PUT THERE IN OPENREL 6GH2 TESTMODE 7,NBACK,,EMPTY [NO NEED TO BACKSPACE IF EMPTY MODE 6H2L LDX 0 ECOPS(1) [IF FILE HAS NOT BEEN RETRIEVED 6HG= ANDN 0 1 [BECAUSE FCB FOUND & IT STILL HAS 6H^W BZE 0 NBACK [NOT BEEN RESTORED DON'T BACKSPACE 6JFG BACKSPACE [REPOSITION (LAST RECORD READ WAS BLO 6J^6 NBACK 6KDQ REWRITE [REWRITE RECORD AS WE CANT OPEN THIS 6KYB MHUNTW 1,FILE,FWB 6LD2 NAME 1,FILE,ENT [RENAME BLOCK AGAIN 6LXL NREWR 6MC= TESTMODE 7,NOCLOSE2,,DIROPEN 6MWW CLOSETOP 6NBG NOCLOSE2 6P*Q TESTMODE 7,MENT,,LEAVE [DONT FREE ENT IF LEAVE GIVEN 6PTB MFREEW FILE,ENT 6Q*2 MENT 6QSL VFREEW FILE,FCB 6R#= BNG 4 SCLD [J IF CLUDGE 6RRW SETREP CANT 6S?G BRN REPG [REPLY SET 6SR6 SCLD SETREP CLUDGE 6T=Q TOPFCB 2 [X2 -> FCB OF FILE OPEN AT TOP LEVEL 6TQB BXU 6 BACK2(2),REPG [TEST FOR CLUDGE AT TOP LEVEL 6W=2 TOPFCA 2 6WPL BS 2,BACLUDGE [???? FOR COPY (COMMAND?) 6X9= REPG UPPLUS 1 6XNW OOR3 6Y8G LDN 0 1 6YN6 ADS 0 FWAITCOUNT(3) [ADD ONE TO THE COUNT OF WAITERS 6^7Q LDX 5 BACK1(3) 6^MB LDX 6 BACK2(3) [PICK UP BACKING STORE HOME PAIR 7272 LONGSET 6,XSET,6 [SET WAITING STYLE 72LL TESTMAIN 7,NCLD,,COPY [CLUDGE TEST UNNECCESSARY IF COPY MOD 736= DOWN OPENWAIT,3 [TEST FOR CLUDGE 73KW BRN NCLD [NO CLUDGE IF COMES STRAIGHT UP 745G NGN 4 1 [SET CLUDGE MARKER 74K6 CALL 2 XGETFCB [FIND FCB AGAIN 754Q LDN 0 1 75JB SBS 0 FWAITCOUNT(3) [NO LONGER GOING TO WAIT 7642 BRN SAYCANT [REMOVE UNCLEAN BIT AND CLEAR UP 76HL NCLD 76RD LDN 4 0 [ZEROISE LONGSTOP MARKER. 773= MHUNTW 1,FILE,ENT 77GW LDX 0 EUSE1(1) [IF THE FILE IS A DIRECTORY 782G BNZ 0 PAR [OR ONE SUCH THAT ACTIVITY 78G6 JBC RAP,1,BECOOR [CAN'T LONGSTOP WITH IT OPEN, DO LONG 78^Q PAR 79FB LDEX 0 CLONG1(2) [IF LONGWAIT HAS BEEN UNSET(WHO BY?), 79^2 BZE 0 SFCBA [DON'T TRY TO WAIT 7=DL LONGOFF 2 7=G* LDX 0 AWORK4(2) 7=J4 BNZ 0 RAP 7=KR CALL 2 XGETFCB 7=MG JBC WCOOR,3,BFFREZ [J IF FILE NOT FROZEN BY DUMPER. 7=P9 OUTPACK FME1(3),3,USERNAME [PREPARE USERNAME OF DIRECTORY AS 7=QY MONOUT INCFREZD [OUTPUT PARAM. OUTPUT 'WAITING' MESSA 7=SM LDN 4 1 7=WB STO 4 AWORK4(2) 7=Y= RAP 7?CW CALL 2 XGETFCB [FIND FCB AGAIN 7?XG WCOOR 7#7# ... TESTMAIN 7,TSTRP,,COPY 7#C6 TESTMAIN 7,UNCLE,,UNCLEAN 7#WQ TESTMODE 7,TSTRP,NOT,GDESTR [J IF GDR-ELSE SET UWB EVEN IF READ 7*BB UNCLE 7*W2 TESTMODE 7,TSTRP,,CAREFUL [IF CAREFUL MODE, DON'T SET UWB 7B*L BS 3,BFUWB 7BT= TSTRP 7CSG MHUNTW 1,FILE,ENT 7D#6 JBS WTDIR,1,BECOOR [MUST DO COOR3 IF CANT LONGSTOP BIT S 7DRQ LDX 0 EUSE1(1) 7F?B BNZ 0 WTDIR [J IF A DIRECTORY 7FR2 LDN 4 2 [MARKER FOR LONGSTOP 7G=L TESTMODE 7,YCLOSE,NOT,DIROPEN[CLOSE DIR IF NOT ALREADY CLOSED 7GQ= BRN NOCLOSE 7H9W WTDIR 7HPG TESTMODE 7,NOCLOSE,,DIROPEN [DON'T CLOSE IF DIROPEN MODE GIVEN 7J96 ADDMODE 7,DIROPEN [TO ENSURE IT DOESN'T GET CLOSED AGAI 7JNQ CLOSETOP [CLOSE DIRECTORY 7KN2 LDN 4 1 [MARKER FOR DIR WHOSE DIR HAS JUST BE 7L7L BRN NOCLOSE 7LM= XSET GEOERR 1,ORELMAIN [LONGSET FIELD ALREADY SET 7M6W YCLOSE 7MLG ADDMODE 7,DIROPEN [TO ENSURE DIR CLOSED ONLY ONCE 7N66 TOPFCB 3 7NKQ SMO FX2 [PRESERVE DIR'S NAME IN CASE DIR 7P5B LDN 1 AWORK2 [NEEDS TO BE REOPENED 7PK2 LDN 0 FME1(3) 7Q4L MOVE 0 3 7QJ= CLOSETOP 7R3W CALL 2 XGETFCB [FIND FCB 7RHG LDX 0 CTOPEN(3) [SEE IF FILE IS NOW UNUSED 7S36 BNZ 0 NOCLOSE [IF NOT, GO WAITING 7SGQ LONGOFF [IF IT IS, CLEAR THE LONGSET 7T2B BRN SFCBA 7TG2 NOCLOSE 7T^L BNZ 4 NOWT 7WF= #SKI K6ORELMAIN>199-199 7WYW ( 7XDG [ 7XY6 [THIS WAS PUT RN TO CORRECT BUG 2889. THIS CODE IS ONLY REQIRED FOR 7YCQ [LISTING LEVEL > OR = 200, SINCE AT THIS LEVEL ONLY CLUDGE IS TESTED 7YXB [FOR ON DIRECTORIES. IF THIS CODE IS NOT INCLUDED AN ACTIVITY CAN GO 7^C2 [WAITING FOR A FILE WHICH IS NOT OPEN, BECAUSE THERE ARE COORDINATIONS 7^WL [BETWEEN TESTING FOR A FRLE FREE AND WAITING FOR FILE TO BE FREE 82B= [ 82TW CALL 2 XGETFCB 83*G LDX 0 CTOPEN(3) [TEST IF FILE HAS BECOME FREE 83T6 BZE 0 SDFCB 84#Q ) 84SB COOR3 6 [WAIT FOR OBSTRUCTION TO CLEAR: 85#2 TESTMODE 7,SFCBA,NOT,REPWAIT [J UNLESS REPWAIT 85RL SETDIRC 86?= CALL 2 XGFCB 86QW BRN NF3 87=G LDN 0 1 87Q6 SBS 0 FWAITCOUNT(3) [REPLY DIRECTORY HAS BEEN CLOSED 889Q NF3 88PB SETREP DIRCLOSE 8992 XDC 89NL TESTMODE 7,XUP,,LEAVE [DON'T FREE ENT IF LEAVE MODE GIVEN 8=8= VFREEW FILE,ENT 8=MW XUP 8?7G UPPLUS 1 8?M6 NF6 8#6Q VFREEW FILE,ENT 8#LB VFREEW FILE,FCB 8#W8 ... VFREEW FI,FINDEXF 8*62 SETNCORE 4,1,FILE,FABSNB 8*KL LDN 0 4 8B5= STO 0 A1(1) [PICK UP DIR'S NAME & REOPEN IT. 8BJW LDN 0 AWORK2(2) 8C4G ADN 1 A1+1 8CJ6 MOVE 0 3 8D3Q OPEN NF5,GENERAL,QUERY 8DHB MFREE FILE,FABSNB 8DNJ ... CLEARMOD 7,DIROPEN [CLEAR SWITCH SET WHEN DIRECTORY 8DTQ ... [CLOSED BEFORE LONGSTOP 8F32 TESTREP2 OK,REOP 8FGL SETREP2 NAME 8G2= UPPLUS 1 8GFW NF5 GEOERR 1,DIRREOP 8G^G NOWT SBN 4 2 8HF6 BNZ 4 SFCBA [J IF WAITING FOR DIRECTORY TO SEE IF 8HYQ SMO FX2 8JDB LDN 2 FILERING 8JY2 NXFCA 2,2,WTOK [J IF NO FILES OPEN, THUS OK. 8KCL JBC WTOK,2,BANOWAIT [J UNLESS DIR 8KX= GEOERR 1,DIROPENW [OTHERWISE ERROR 8LBW WTOK 8LWG LONGSTOP XBRK,,FWFREE 8MB6 TESTMODE 7,SETDIRC,,REPWAIT [J IF REPWAIT 8MTQ CALL 2 XGFCB 8N*B BRN NF6 8P4S ... LDX 2 FX2 8P#L [ 8PS= Z4ORELMAIN 8Q44 STOZ AWORK4(2) 8Q?W SFCBA 8QRG CALL 2 XGETFCB [GET X3 -> FCB AGAIN 8R?6 SDFCB 8RQQ LDN 0 1 [REMOVE THIS ACTIVITY FROM THE 8S=B SBS 0 FWAITCOUNT(3) [COUNT OF WAITERS. 8SQ2 ONEREEL 8T9L LDX 2 3 [X2 -> REEL TO BE OPENED: 8TP= TESTMODE 7,NR,NOT,ERASE 8W8W BS 2,BFERASE [SET 'TO BE ERASED' BIT IF ERASE MODE 8WNG NR 8X86 CALL 6 TRYREEL 8XMQ TESTMODE 7,OFCB,NOT,GDESTR 8Y7B TESTMODE 7,OFCB,NOT,REPWAIT 8YM2 MHUNTW 1,FILE,FCB [IF GDESTR MODE IS SET & THERE WAS 8^6L BNG 1 OFCB [ALREADY AN FCB IN THE FILE CHAIN 8^L= JBC OFCB,3,BFCARE [COULD BE FMAPP AS GDR FILE CANT BE O 925W [CAREFULLY IF FILE ALREADY OPEN 92KG LDX 0 CTOPEN(3) [OR BEING CLOSED THE DIR MUST BE 9356 BNZ 0 XGD1 [CLOSED, THE REPTY REPWAIT GIVEN & 93JQ LDX 1 FPTR(3) [UP+1 OBEYED 944B LDX 0 ATYPE(1) [IF THERE IS A FMAPP BUT FILE NOT 94J2 SRL 0 12 [BEING ACCESSED THE FMAPP CAN BE 953L SBN 0 FILE+FSTACK [FREED, CAREFUL BIT UNSET & THE 95H= BNZ 0 XGD2 [OPEN CAN CONTRNUE 962W LDX 0 ALOGLEN(1) 96GG BZE 0 XGD2 9726 XGD1 979Y ... TESTMODE 7,NF3,,DIROPEN 97#H ... LDCT 0 2 97C6 ... ORS 0 COMM(3) [SET UWB IN FCB AS SET IN ENT. 97FQ CLOSETOP 97^B BRN NF3 98F2 XGD2 98YL BC 3,BFCARE 99D= LDX 1 FPTR(3) 99XW XGD3 LDX 0 ATYPE(1) 9=CG SRL 0 12 9=X6 SBN 0 FILE+FMAPP 9?BQ BZE 0 XGD4 9?WB LDX 1 FPTR(1) 9#B2 BRN XGD3 9#TL XGD4 9**= FREECORE 1 9*SW OFCB 9B#G TESTMODE 7,NOBLK,NOT,EMPTY 9BS6 MHUNTW 2,FILE,FCB [IF THERE IS AN FCB IN THE ACTIVITY C 9C?Q BNG 2 NOTTWO [B. IF ONLY ONE FCB 9CRB LDN 4 BSPRE-FBLMOD 9D?2 LDX 1 FX1 9DQL LDX 0 COMM(3) [WHEN WVERWRITING FCB IN FILE CHAIN 9F== ANDX 0 XCMM(1) [WITH FCB IN ACTIVITY CHAIN IT IS 9FPW ORS 0 COMM(2) [NECESSARY TO PRESERVE SOME BITS 9G9G LDX 0 FCOMM(3) [IN COMM & FCOMM FROM FCB IN FILE 9GP6 ANDX 0 XFCMM(1) [CHAIN 9H8Q ORS 0 FCOMM(2) 9HNB ... TRF 3,FFAUTCLCT,2,FFAUTCLCT [COPY AUTOCLOSE COUNT TO NEW FCB 9JML LDX 0 FUSEBL(3) [PRESERVE FUSEBL FROM LOD FCB 9K7= STO 0 FUSEBL(2) 9KLW LDN 0 FBLMOD(2) [OVERWRITE"OLD" FCB IN FILE CHAIN 9L6G LDN 1 FBLMOD(3) [BY "NEW" FCB IN ACTIVITY CHAIN,AS 9LL6 SMO 4 [THE LATTER IS MORE UP-TO-DATE. 9M5Q MOVE 0 0 9MKB NOTTWO 9N52 ... LDN 4 FBLKS-A1 [RESET FBLMOD IN FILE CHAIN FCB TO 9NJL STO 4 FBLMOD(3) [INDICATE EMPTY FILE 9P4= NOBLK 9PHW LDX 5 BACK1(3) [PICK UP HOME PAIR OF FCB. 9Q3G LDX 6 BACK2(3) 9QH6 TESTMAIN 7,NCOP,NOT,COPY [ENSURE FCB KEPT IN CHAIN IF COPY MOD 9R2Q BS 3,BFFCB 9RGB BRN NOSC 9S22 NCOP 9SFL TESTMODE 7,NOBL1,NOT,USERCLEAN [J IF NOT CLE 9S^= LDN 0 1 9TDW BRN NOBL2 9YW= NOBL1 9^*W TESTMODE 7,PLUS,NOT,COMMUNE,SYSTCOMM [DON'T INCREMENT COMMUNE COUN 9^TG LDCT 0 #200 [SET COMMUNE BIT =2*6 ORS 0 CTOPEN(3) =2SQ LDX 0 BIT11 =3#B NOBL2 =3S2 ADS 0 FCOMMCT(3) =4?L PLUS =4R= TESTMAIN 7,READ,,READING =5=W BC 3,BFNODUMP [CLEAR 'NOT TO BE REDUMPED' BIT. =5QG TESTMAIN 7,SOLE,,CLEAN =6=6 TESTMODE 7,NUWB,,CAREFUL [NO UWB IF CAREFUL =6PQ BS 3,BFUWB =79B NUWB =7P2 TESTMAIN 7,RAPP,,APPEND =88L SOLE LDCT 0 #400 [SOLE OPENER, JUST ONE BIT TO STORE =8N= ORS 0 CTOPEN(3) =97W BRN OPENFCBED =9MG READ LDN 0 1 ==76 ADS 0 CTOPEN(3) [INCREASE COUNT OF READERS. ==LQ TESTMODE 7,OPENFCBED,NOT,GDESTR =?6B BS 3,BFUWB [SET UWB IF GDESTR READER =?L2 BRN OPENFCBED [[CHECK IT IS SMALL? =#5L RAPP =#K= LDX 0 BIT11 =*4W ADS 0 CTOPEN(3) [INCREASE COUNT OF APPENDERS. <1024 =*JG OPENFCBED =B46 TESTMODE 7,NOSC,NOT,SYSTCOMM =BHQ BS 3,BFSYSCOMM [SET SYSTCOMM BIT =C3B NOSC =CH2 TESTMODE 7,NDS,NOT,DESTRUCT =D2L MBS 3,BFCORE,BFDCF [SET DCF BIT & KEEP USAGE BLOCKS IN C =DG= NDS =D^W TESTMODE 7,NGD3,NOT,GDESTR =FFG BS 3,BFGDR [SET GDR BIT IF GDR MODE =F^6 NGD3 =GDQ TESTMODE 7,NERAD,NOT,ERASE =GYB ... BS 3,BFOPENERASE [SET BIT IF ERASE ???? =HD2 NERAD =HXL TESTMODE 7,NCOM,NOT,COMMUNE =JC= LONGON FOPENWT,BACK2(3) [OTHERWISE WAKE UP WAITERS =JWW NCOM =KBG MHUNTW 1,FILE,ENT =KW6 JBC NONLINEBIT,1,BEONLINE =L*Q BS 3,BFVSF [TRANSFER BIT =LGY ... APVSF UP [ADJUST ACT PRI =LN6 ... MHUNTW 1,FILE,ENT [X1->ENT =LTB NONLINEBIT =M*2 JBC NOTMDF,1,BEMDF =MSL BS 3,BFSDF [TRANSFER BIT =N#= NOTMDF =NRW JBC NOTMULT,1,BEMULT =P?G BS 3,BFMULT [TRANSFER BIT =PR6 NOTMULT =Q=Q LDX 0 ECOPS(1) [IF FILE OFFLINE BUT NOTEMPTY =QQB BNZ 0 TEMM [AND ERASING HO TO ORELEMPT =R=2 TESTMODE 7,TEM1,NOT,EMPTY =RPL TESTMODE 7,S33,,ERASING =S9= TEM1 =SNW MHUNTW 1,BSTB,FULLB [IF FILE OFFLINE & NO FULLB =T8G BNG 1 S33 [DON'T GO TO ORELEMPT =TN6 BRN XEOM =W7Q TEMM =WMB TESTMODE 7,S33,NOT,EMPTY [IF EMPTY & CAREFUL OR ERASING GO TO =X72 TESTMODE 7,XEOM,,ERASING,CAREFUL [TO FREE OR A =XLL MHUNTW 1,BSTB,FULLB [IF EMPTY BUT NOT CAREFUL OR ERASING =Y6= BNG 1 S33 [& NO FULLB NOT GO TO ORELEMPT =YKW XEOM =^5G #SKI K6ORELMAIN>100-100 =^K6 TRACE 6,LOOKBS ?24Q ACROSS ORELEMPT,1 ?342 S33 ?3HL ACROSS ORELEND,1 ?52G [ ?5^Q #END ^^^^ ...62777320000200000000