(George Source)
Macros used: ANSOK, BACKSPACE, BS, BXE, BXGE, BXU, CHAIN, CLOSESET, CLOSETOP, FCAJO, FDRMAUTX, FINDWN, FREECORE, GDRPTRS, GEOERR, GETFCB, HUNT, HUNTW, INITLFCA, JBC, JMBS, JOBLOCK, LONGON, MAPBOREL, MENDAREA, MFREE, MHUNTW, NAME, PSTAC, REWRITE, RINGFILE, SEGENTRY, SETMODE, SETNCORE, SETREP, SETUPCORE, SETUPFCA, STEPAGAIN, TESTMODE, TOPFCA, TOPFCB, TRACE, UP, UPPLUS, WHATBACK
22FL #SEG ORELEND70 [G. PORTER 22^= #OPT K0ORELEND=K0OPEN>K0FILESTORE>K0ALLGEO 23DW #LIS K0ORELEND 23YG #OPT K6ORELEND=K6OPEN>K6FILESTORE>K6ALLGEO 24D6 8HORELEND 24XQ SEGENTRY K1ORELEND,Z1ORELEND 25CB SEGENTRY K2ORELEND,Z2ORELEND 25X2 # THIS ROUTINE WRITES A NEW DIRECTORY ENTRY FOR THE EMPTY WITH CREA 26BL # TIDIES UP BLOCKS AND WRITES A NEW FCA AREA IN THE ACTIVITY BLOCK 26W= # FILE WHICH IS NOW OPEN TO THIS ACTIVITY. A FILE/FPUSH BLOCK IS SE 27*W # NECESSARY ,FOR FILES ALREADY OPEN TO THIS ACTIVITY. 27TG # 28*6 # 28SQ [ON ENTRY X5 & X6 CONTAIN HOME PAIR OF FCR & X7 = MODE. 29#B [FIRST TEST FOR THE MUTUALLY EXCLUSIVE THAW AND EMPTY CASE, IF NEITHER 29S2 [OF THESE TURNS UP, WE SKIP TO SPAREFCB. 2=?L SHALF +AHALFOPEN 2=R= MCL +AUSERCLEAN 2?=W ...XEINF1INCL #10020016 [THESE WORDS ARE TO BE UPDATED 2?QG XEINF2INCL #70750002 2#=6 XWFM #77770000 [WRITE-FROZEN COUNT MASK 2#PQ XRFM #7777 [READ-FROZEN COUNT MASK 2*9B [IN EINF1 AND EINF2 2*P2 XRDDM +FCBAPPWAIT 2B8L XAPDM +FCBSTEPWAIT 2BN= [ 2BQT ... 2BTD ...XGETFCB 2BY3 ... STO 0 GEN6 2C2L ... GETFCB 5,2 2C59 ... BRN (GEN6) 2C7W Z1ORELEND 2CMG [ 2D76 STOZ AWORK4(2) 2DLQ XJN 2F6B #SKI K6ORELEND>999-999 2FL2 ( 2G5L TRACE 5,ORELEND 2GK= TRACE 6,HOMEPAIR 2H4W TRACE 7,MODE 2HJG ) 2J46 SETMODE 4,THAW 2JHQ ANDX 4 7 [TEST FOR THAW CASE 2K3B BZE 4 NTHAW [J IF NOT THAW 2KH2 [IN THE THAW CASE WE HAVE TO ADJUST THE FREEZE COUNT AND 2L2L [FREE WAITING ACTIVITIES IF THE COUNT BECOMES ZERO 2LG= ... CALL 0 XGETFCB [FIND FCB 2L^W NWFCB 2MFG #SKI K6ORELEND>49-49 2M^6 ( 2NDQ LDX 0 FREEZECOUNT(2) [DONT GO NEGATIVE 2NYB BZE 0 XTHAW 2PD2 ) 2PXL LDN 0 1 2QC= SBS 0 FREEZECOUNT(2) [THAW FCB ONCE 2QWW HUNT 1,FILE,ENT 2RBG LDN 0 1 2RW6 SBS 0 EAUTOCOUNT(1) [THAW DIRENT ONCE 2S*Q #SKI K6ORELEND>49-49 2STB ( 2T*2 LDX 0 EAUTOCOUNT(1) 2TSL SBX 0 FREEZECOUNT(2) 2W#= BZE 0 XTHAWOK 2WRW XTHAW 2X?G GEOERR 1,XTHAWD 2XR6 XTHAWOK 2Y=Q ) 2YQB XTR 2^=2 NAME 1,FILE,FWB 2^PL LDX 0 ECOPS(1) [IF FILE HAS NOT BEEN RETRIEVED 329= ANDN 0 1 [BECAUSE FCB FOUND & IT STILL HAS 32NW BZE 0 NBACK [NOT BEEN RESTORED DON'T BACKSPACE 338G BACKSPACE [REPOSITION DIRECTORY 33N6 NBACK 347Q REWRITE [REWRITE DIRENT 34MB HUNT 1,FILE,FWB 3572 NAME 1,FILE,ENT [RENAME DIRENT 35BS ... LONGON 6,ELOC1(1) [WAKE UP WAITERS TO EMPTY FILE. 35LL BRN SPAREFCB 366= NTHAW 36KW SETMODE 0,REOPEN [IF REOPEN MODE IS SET EITHER READ- 375G ANDX 0 7 [OR WRITE-FROZEN COUNT MUST BE DECREM 37K6 BZE 0 NREOP [J NOT REOPEN 384Q LDX 0 7 [TEST FOR OPENING IN READ OR WRITE 38JB ANDN 0 #7000 [MODE SO THAT THE APPROPIATE COUNT 3942 SBN 0 #3000 [IS DECREMENTED 39HL BNG 0 NWFR [J NOT WRITE 3=3= LDX 3 BIT11 [SET X3 TO SUBTRACT 1 FROM WRITEFR CT 3=GW LDN 4 0 [SET X4 TO MASK OUT RELEVANT COUNT 3?2G ...XDEC CALL 0 XGETFCB 3?G6 #SKI K6ORELEND>49-49 3?^Q ( 3#FB LDX 0 FSVCT(2) [ERROR IF THE APPROPIATE COUNT IS 3#^2 LDX 1 4 [ZERO 3*DL SMO FX1 3*Y= ANDX 0 XWFM(1) 3BCW BZE 0 XREOP 3BXG ) 3CC6 SBS 3 FSVCT(2) [DECREMENT APPROPIATE COUNT IN FCB 3CWQ HUNT 1,FILE,ENT 3DBB SBS 3 ESVCT(1) [DECREMENT APPROPIATE COUNT IN ENT 3DW2 #SKI K6ORELEND>49-49 3F*L ( 3FT= LDX 0 ESVCT(1) [CHECK THAT THE COUNTS IN FCB 2 ENT 3G#W SBX 0 FSVCT(2) [ARE NOW EQUAL. ERROR IF NOT 3GSG BZE 0 XTR 3H#6 XREOP 3HRQ GEOERR 1,XREOPEN 3J?B ) 3JR2 BRN XTR [J TO REWRITE DIRENT 3K=L NWFR 3KQ= LDN 3 1 3L9W LDN 4 1 [SET X4 TO MASK OUT RELEVANT COUNT 3LPG BRN XDEC 3M96 NREOP 3MNQ SETMODE 4,EMPTY 3N8B ANDX 4 7 3NN2 BZE 4 SETE2 [J IF NOT EMPTY 3NXS ... TESTMODE 7,SETE2,,ERASING [IGNORE CREATE BLOCK IF ERASING 3P7L [IN THE EMPTY CASE, IF THERE IS A FILE CREATE BLOCK IN THE CHAIN, WE 3PM= [COPY THINGS FROM IT INTO THE DIRENT. 3Q6W HUNT 2,FILE,CREATE 3QLG [CARRY ON IF EXISTS A CREATE BLOCK 3R66 SMO FX2 3RKQ LDX 0 AWORK4 3S5B ANDN 0 1 [IF OPENWORK J TO PUT CREATE BLOCK 3SK2 BNZ 0 WFEP [INFORMATION IN FEXTRA AS NO ENT 3T4L HUNT 3,FILE,ENT 3TJ= NAME 3,FILE,FWB 3W3W BNG 2 RWRB 3WHG JMBS NOTDA,3,BESERIAL,BEMT 3X36 LDX 0 CEORG(2) 3XGQ BZE 0 SIZEG [ASSIGN CASE 3XMY LDX 0 CEINF3(2) 3XT6 STO 0 EINF3(3) 3Y2B NOTDA 3YG2 LDX 0 CETM(2) 3Y^L STO 0 ETM(3) 3^F= SMO FX1 3^YW LDX 0 XEINF2INCL [MASK OFF THESE PROPERTY BITS 42DG ANDX 0 EINF2(3) [SO THAT THE OVERWRITTEN FILE 42Y6 ORS 0 CEINF2(2) [RETAINS THESE PROPERTIES 43CQ SMO FX1 [RETAIN PRORERTY BITS IN OVERWRITTEN 43XB LDX 0 XEINF1INCL [FILE 44C2 ANDX 0 EINF1(3) 44WL ORS 0 CEINF1(2) 45B= LDN 0 CEINF1(2) [TRANSFER ALL THE APPROPRIATE WORDS. 45TW LDN 1 EINF1(3) 46*G MOVE 0 3 46T6 LDX 0 CEORG(2) 47#Q STO 0 EORG(3) 47SB LDX 0 CEKEY(2) 48#2 STO 0 EKEY(3) 48RL LDX 0 CEENDBUCK(2) 49?= STO 0 EENDBUCK(3) 49QW LDX 0 CEVERSION(2) 4==G STO 0 EVERSION(3) 4=Q6 LDX 0 CEFLOW(2) [OVERFLOW QUALIFIER 4?9Q STO 0 EFLOW(3) 4?PB LDN 0 CEUSE1(2) 4#92 LDN 1 EUSE1(3) 4#NL MOVE 0 3 4*8= LDX 0 7 [MODE WORD 4*MW ANDN 0 #1000 [ZERO IF RANDOM MODE 4B7G ADN 0 #400 [A1=LAST REEL 4BM6 SETMODE 1,CAREFUL 4C6Q ANDX 1 7 4CLB BNZ 1 XCFL 4D62 ADN 0 4 [DIRECTORY ENTRY 4DKL XCFL 4F5= SRC 0 10 [SHIFT TO BITS 0,1 AND 7 4FJW ORS 0 EINF1(3) 4G4G LDX 0 EINF3(3) 4GJ6 SLL 0 9 4H3Q SRL 0 9 4HHB BNZ 0 SIZEG [OK IF SIZE ALREADY GIVEN 4J32 LDN 0 FILESIZE [OTHERWISE PUT IN HIGHEST POSSIBLE 4JGL DLA 0 EINF3(3) 4K2= SIZEG 4KFW MFREE FILE,CREATE [RID OF CREATE BLOCK 4K^G [IN THE EMPTY-WITH-CREATEB CASE, WE MUST REWRITE DIRENT,SO THE 4LF6 [DIRECTORY HAS TO BE OPEN IN CLEAN OR GENERAL MODE. 4LYQ RWRB 4MDB LDCT 0 1 [SET BLOCKS<512 WORDS BIT 4MY2 ORS 0 EINF2(3) 4NCL REWRITE [REPLACE FRDE 4NX= HUNT 3,FILE,FWB 4PBW NAME 3,FILE,ENT [RESTORE NAME OF DIRENT 4PWG BRN SETE2 4QB6 [IN THE EMPTY CASE, REGARDLESS OF THE PRESENCE OF A CREATEB, WE MUST 4QTQ [USE A WHATBACK OR A FULLB TO SET UP BSPRE. 4R*B WB WHATBACK 2 4RT2 NOCREATEB 4S#L SETE2 4SS= SMO FX2 4T?W LDX 0 AWORK4 4TRG ANDN 0 1 4W?6 BNZ 0 WFEMT [J TO FIND WORKFILE FCB IF OPENWORK 4WQQ SPAREFCB 4X=B [THERE MAY BE AN FCB LVING AROUND THE ACTIVITY CHAIN,TO BE FREED.ALSO 4XQ2 HUNT 1,FILE,FCB [IS THERE AN FCB IN CORE? 4Y9L BNG 1 OUT [J IF NO FCB 4YP= FREECORE 1 [FREE FCB 4^8W MHUNTW 1,FI,FINDEXF [IF SPARE FINDEXF FREE IT 4^NG BNG 1 OUT 5286 FREECORE 1 52MQ OUT 537B [FIRST SEE WHETHER WE NEED TO CLOSE THE DIRECTORY,THEN SEE WHETHER THE 53M2 [FILE CONTOL AREA NEEDS TO BE UPDATED 546L BNG 7 NOCLOSE [DIR ALREADY CLOSED OR DIROPEN SPECIF 54L= SETMODE 0,CAREFUL 555W ANDX 0 7 [IF CAREFUL MODE IS SET THEN AN 55KG BNZ 0 YCFL [AUTONOMOUS CLOSE IS OKAY 5656 LDX 0 7 [IF NOT CAREFUL MODE & UNCLEAN 56JQ ANDN 0 #7777 [MODE,THEN A NON-AUTONOMOUS CLOSE 574B LDN 4 #2777 [IS REQUIRED TO ENSURE BLOCKS 57J2 BXGE 4 0,YCFL [INFORMATION IS UP-TO-DATE 583L LDN 4 #7000 58H= BXGE 0 4,YCFL 592W CLOSESET 59GG BRN NOCLOSE 5=26 YCFL 5=FQ CLOSETOP [CLOSE AND DON'T GO UP UNLESS WE MUST 5=^B NOCLOSE 5?F2 [X5 AND X6 CONTAIN THE BS HOME PAIR OF THE FCB TO BE RINGED INTO THE 5?YL [FILERING OF THIS ACTIVITY. THE FCB HAS ALREADY BEEN UPDATED.X7 CONTAINS 5#D= [THE MODE WORD 5#XW ... CALL 0 XGETFCB [FIND FCB OF FILE BEING OPENED 5*CG SWFCB 5*X6 SETMODE 0,EMPTY 5BBQ ANDX 0 7 [IN THE EMPTY MODE CASE UPDATE 5BWB BZE 0 NEST [THE FCB FROM THE NEWTY UPDATED 5CB2 HUNT 1,FILE,ENT [DIRENT AS THE FILE MAY NOW HAVE 5CTL LDX 0 EINF1(1) [BECME A STREAM COMPONENT 5D*= SRL 0 16 5DSW ANDN 0 #30 5F#G ORS 0 COMM(2) 5FS6 LDX 0 ETM(1) 5G?Q STO 0 FETM(2) 5GRB LDX 0 EENDBUCK(1) [ALSO SIMILARLY UPDATE THE RANDOM 5H?2 STO 0 FENDBUCK(2) [ACCESS EILE INFOMATINO AS IT 5HQL LDX 0 EVERSION(1) [MAY HAVE CHANGED 5J== STO 0 FVERSION(2) 5JPW LDEX 0 EINF3(1) [PICK UP MAX SIZE 5K9G STO 0 FSIZE(2) 5KP6 BRN NEST 5L8Q REFINDFCB 5LNB LDN 0 1 5M82 ANDX 0 AWORK4(2) 5MML BZE 0 REFINDFCB1 5N7= CALL 6 XFCB 5NLW BRN NEST 5P6G REFINDFCB1 5PL6 ... CALL 0 XGETFCB 5Q5Q NEST 5QKB LDX 3 FPTR(2) [PICK UP -> TO NEXT BLOCK 5R52 LDX 0 ATYPE(3) 5RJL SRL 0 12 5S4= SBN 0 FILE+FSTACK 5SHW BZE 0 YSTAK [J IF FSTACK BLOCK 5T3G [IF THERE IS NO FSTACK BLOCK WE SET ONE UP 5TH6 SETNCORE FELLEN,3,FILE,FSTACK 5W2Q LDN 0 1 5WGB SMO FX2 5X22 ANDX 0 AWORK4 [IF WORKFILES J TO LOCATE FCB IN 5XFL BNZ 0 WFLOC1 [WORKFILE RING 5X^= WNOF1 5YDW ... CALL 0 XGETFCB [GET -> TO FCB IN X2 AGAIN 5YYG WFCON1 5^D6 SMO FPTR(2) 5^XQ LDX 0 ATYPE 62CB SRL 0 12 62X2 SBN 0 FILE+FSTACK [J IF SOMEONE ELSE HAS GOT IN MEAN- 63BL BZE 0 NEWSTAC [WHILE - SET UP FSTACK BLOCK 63W= CHAIN 3,2 [CHAIN FSTACK BLOCK AFTER FCB 64*W LDCT 0 FELLEN [LENGTH OF RING ELEMENT IN TOP 9 BITS 64TG STO 0 ARINGNO(3) [OF ARINGNO 65*6 BRN STACKFILL 65SQ NEWSTAC 66#B LDX 1 3 [TO FREECORE FSTACK 66S2 LDX 3 2 [PTR TO FCB OVER FREECORE(NON-COOR) 67?L FREECORE 1 67R= LDX 3 FPTR(3) [X3 -> FSTACK NOW 68=W LDX 2 BPTR(3) [X2 -> FCB 68QG YSTAK 69=6 SETUPFCA 3,2,REFINDFCB,4 69PQ STACKFILL 6=9B LDN 0 1 6=P2 SMO FX2 6?8L ANDX 0 AWORK4 [IF OPENWORK J TO LOCATE FCB IN 6?N= BNZ 0 WFLOC2 [WORKFILE RING 6#7W WNOF2 6#G? ... CALL 0 XGETFCB 6#SN ... LDX 3 2 6*76 WFCON2 6*LQ LDX 2 FPTR(3) [X2 -> FSTACK 6B6B INITLFCA [TIDY UP FCB AND NEW ELEMENT 6BL2 SETMODE 0,GDESTR 6C5L ANDX 0 7 6CK= BZE 0 NGDR 6D4W LDX 0 7 6DJG ANDN 0 #7000 [IF THE MODES GDR & READ ARE GIVEN 6F46 SBN 0 #1000 [THEN THE READ POINTERS SHOULD NOT 6FHQ BNZ 0 NGDR [BE NEGATED BUT SHOULD BE CALCULATED 6G3B GDRPTRS 2,3,4 [FROM POSITION OF OTHER ACCESSORS IN 6GH2 BRN SFGEN [THE FILE. 6H2L NGDR 6HG= NGS 2 FREADWORD(2) 6H^W NGS 2 FREADBLOCK(2) 6JFG SFGEN 6J^6 STOZ FGENERAL2(2) 6KDQ LDX 3 7 6KYB ANDN 3 #7777 6LD2 SRL 3 9 [ISOLATE THE MAIN MODE: 6LXL ANDN 3 7 6MC= LDN 0 1 [LOAD ONE BIT 6MWW SRC 0 0(3) [POSITION OF BIT INDICATES MODE OPEN: 6NBG SETMODE 3,COMMUNE 6NW6 ANDX 3 7 6P*Q SLL 3 5 [POSITION IT FOR FCA5 6PTB ORS 3 0 6Q*2 LDX 3 7 6QSL SMO FX1 6R#= ANDX 3 MCL 6RRW BZE 3 NOCLN 6S?G LDN 3 CACLNBIT 6SR6 ORS 3 0 [SET CLEAN BIT IF NECESSARY 6T=Q NOCLN 6TQB #SKI K6ORELEND>100-100 6W=2 TRACE 0,ORENDFCA 6WPL STO 0 FGENERAL1(2) [PUT ALL INFORMATION IN FGENERAL1 6X9= RINGFILE 2 [PUT THIS FCA IN THE FILERING 6XNW SMO FX2 6Y8G LDX 0 AWORK4 [IF ENTERED FROM SETFCA OR SETFCAWF 6YN6 ANDN 0 4 [MACRO, EXIT AT THIS POINT 6^7Q BNZ 0 UPP 6^MB TOPFCB 3 7272 LDX 0 7 72LL ANDN 0 #7000 [IF COPY MODE , SET OPEN IN 736= SBN 0 #6000 [COPY MODE BRT 73KW BNZ 0 NCOP 745G LDN 0 #2000 74K6 ORS 0 FCOMM(3) 754Q LDX 0 BIT9 [UNSET 'DON'T MOVE FCB' BIT AS 75JB ERS 0 FCOMM(3) [FCB NOW MARKED AS OPEN 7642 NCOP 76== ... TOPFCA 2 76DG ... LDX 0 FREADWORD(2) 76LQ ... BNG 0 NGDREAD 76T2 ... STEPAGAIN 773= ... BNZ 3 NOTEND 779G ... BACKSPACE 77CQ ...NOTEND 77L2 ... TOPFCB 3 77S= ...NGDREAD 782G LDN 0 4 78G6 ANDX 0 FCOMM(3) 78^Q BNZ 0 NCARX 794W ... 7982 ... SETMODE 0,CAREFUL 79?6 ... ANDX 0 7 79B= ... BZE 0 NCAR 7=DL NCM 7=Y= LDX 4 FUSEBL(3) [CATCULATE LENGTH OF FMAP 7?CW SBN 4 FCBLEN [BLOCK AS NUMBER OF BLOCKS/24 7?XG LDX 5 4 7#C6 LDN 3 24 7#WQ DVS 3 3 7*BB ADN 4 FBITS-A1+1 7*W2 SETUPCORE 4,1,FILE,FMAPP [SET UP FMAPP BLOCK 7B*L STO 5 FBITMOD(1) 7BT= STOZ FBCOMM(1) 7C#W BZE 5 ZERLEN 7CSG STOZ FBITS(1) 7D#6 LDN 0 24 7DRQ TXL 5 0 7F?B BCS ZERLEN 7FR2 ADN 1 FBITS 7G=L LDN 2 1(1) 7GQ= SMO 4 7H9W MOVE 1 511-FBITS+A1 7HPG SBN 1 FBITS 7J96 ZERLEN 7JNQ LDN 5 0 7K8B TOPFCA 2 [CHAIN FMAPP BLOCK BETWEEN 7KN2 PSTAC 2,2 [THE FSTACK BLOCK AND THE 7L7L PFMA 7LM= SMO FPTR(2) 7M6W LDX 0 ATYPE [THE FMAPP BLOCK SHOULD BE CHAINED 7MLG BXE 0 FILEPLUSFCB,PFM [BEFORE THE FIRST FCB OR BSTB/FULLB 7N66 SRL 0 12 [WHICH IS CHAINED AFTER THIS FILE'S 7NKQ SBN 0 BSTB+FULLB [FCB. IF END OF FILE CHAIN IS REACHED 7P5B BZE 0 PFM [BEFORE EITHER OF ABOVE TWO BLOCKS, 7PK2 LDX 2 FPTR(2) [FMAPP BLOCK SHOULD BE CHAINED AT 7Q4L SBN 2 BFILE [END OF FILE CHAIN. 7QJ= BZE 2 PFME 7R3W ADN 2 BFILE 7R94 ... ADN 0 BSTB+FULLB 7RB= ... SBN 0 FILE+FMAPP 7RHD ... BNZ 0 PFMA 7RNL ... FREECORE 1 7RR9 ... TOPFCB 3 7RTS ... BRN NCARX 7S36 PFME 7SGQ LDX 2 BFILE+1 7T2B PFM 7TG2 CHAIN 1,2 7T^L TOPFCB 3 7W9D ... BS 3,BFCARE 7WF= NCARZ 7WYW LDCT 0 #200 7XDG ANDX 0 COMM(3) 7XY6 BZE 0 NCAR 7YCQ LDX 4 FUSEBL(3) 7YXB SBN 4 FBLKS-A1 7^C2 LDN 0 FILE+FMAPP 7^WL SLL 0 12 82B= XNP LDX 3 FPTR(3) 82TW TXU 0 ATYPE(3) 83*G BCS XNP 83T6 LDN 0 3 84#Q STO 0 FBCOMM(3) 84FY ... LDX 1 FBITMOD(3) [J IF FBITMOD UPDATED IN FILEMAP 84M6 ... BNZ 1 XNP1 84SB STO 4 FBITMOD(3) 8548 ...XNP1 85#2 TESTMODE 7,MAPBOREL,,EMPTY,CREATE 85RL HUNTW 1,FILE,ENT 86?= BNG 1 NCAR 86QW LDX 0 ECOPS(1) 87=G BNZ 0 NCAR 87Q6 MAPBOREL 889Q MAPBOREL 3 [SET BLOCKS SWAPPED BITS 88PB BRN NCAR 8992 NCARX 89NL SMO FX2 8=8= LDX 0 AWORK1 8=MW ANDN 0 2 8?7G BZE 0 NCARZ 8?M6 LDN 0 FILE+FMAPP [IF LENGTH OF FILE CHANGED MAPKERSET 8#6Q SLL 0 12 [THE FMAPP WILL REQUIRE CHANGEING 8#LB LDX 2 FPTR(3) 8*62 NFM1 8*KL BXE 0 ATYPE(2),NFM2 8B5= LDX 2 FPTR(2) 8BJW BRN NFM1 8C4G NFM2 8CJ6 FREECORE 2 8D3Q BRN NCM 8DHB NCAR 8F32 TOPFCB 3 8FGL SETMODE 0,COMMUNE 8G2= ANDX 0 7 8GFW BZE 0 NTIK [MODE NOT COMMUNE MEANS NO WAITERS 8G^G LDX 0 7 8HF6 ANDN 0 #7000 8HYQ SBN 0 #3000 8JDB BZE 0 YADR 8JY2 BPZ 0 NTIK 8KCL LDX 2 CTOPEN(3) 8KX= ANDN 2 #7777 8LBW LDX 4 CTOPEN(3) 8LWG SRL 4 12 [IF MODE IS READ, THIS IS THE ONLY 8MB6 ANDN 4 #1777 [READER & THERE ARE APPENDERS, THE 8MTQ LDN 1 0 [APPENDERS MAY BE WAITING ON A SUSIN 8N*B BRN YRDR [& THUS SHOULD BE WOKEN UP 8NT2 YADR 8P#L LDX 2 CTOPEN(3) [IF MODE IS APPEND, THIS IS THE NOLY 8PS= SRL 2 12 [APPENDER & THERE ARE READERS, THE 8Q?W ANDN 2 #1777 [READERS MAY BE WAITING NO A SUSIN 8QRG LDX 4 CTOPEN(3) [& THUS SHOULD BE WOKENUP 8R?6 ANDN 4 #7777 8RQQ LDN 1 1 8S=B YRDR 8SQ2 SBN 2 1 8T9L BNZ 2 NTIK 8TP= BZE 4 NTIK 8W8W SMO FX1 8WNG LDX 4 XRDDM(1) 8X86 FDRMAUTX 4 [WAKE UP WAITERS 8XMQ NTIK 8Y7B LDN 0 1 8YM2 SMO FX2 8^6L ANDX 0 AWORK4 [J TO OMIT OPENMAS,HALFOPEN & 8^L= BNZ 0 MLEAVE [DIRECTORY TEST FOR OPENWORK 925W SMO FX2 [J IF HALFOPEN 92KG LDX 0 AWORK1 9356 SBN 0 4 93JQ BZE 0 MAST 944B LDX 1 BFILE 94J2 BXU 6 BACK2(1),NOTMAST [TEST BS HOME 953L BXE 5 BACK1(1),MAST 95H= NOTMAST 962W HUNT 1,FILE,ENT 96GG LDX 0 EUSE1(1) 9726 BNZ 0 MAST [J IF A DIRECTORY 97FQ LDCT 0 #004 97^B ANDX 0 EINF2(1) [TEST FOR BIT MEANING DONT BREAK IN 98F2 BZE 0 NSPECIAL [J IF NOT THERE 98YL MAST 99D= TOPFCA 2 [RELOCATE FSTACK 99XW LDN 0 #2000 9=CG ORS 0 FGENERAL1(2) [PUT NO WAITING WITH FILE OPEN BIT IN 9=X6 [IN FCA5, ALSO MEANS ACTIVITY IS BS P 9?BQ NSPECIAL 9?WB SETMODE 0,LEAVE 9#B2 ANDX 0 7 9#TL BNZ 0 MLEAVE 9**= FREECORE 1 9*SW MLEAVE 9*XF ... TOPFCB 3 9B24 ... JBC YOK,3,BFCLOSEAB [IF FILE MARKED TO BE CLOSEABANDONE 9B4M ... SETREP CLOSEAB [MUST WARN OPENER (HLS OR LISTFILE 9B7= ... BRN UP 9B9T ...YOK 9B#G ANSOK [SET REPLY OK 9BS6 #SKI K6ORELEND>999-999 9C?Q TRACE 4(2),ORELEND 9CRB UP UPPLUS 1 9GP6 [ 9GQN ...XFINDWN1 9GS= ... SMO FX2 9GTS ... LDN 1 BWORKRING 9GXB ...XFINDWN2 9GYY ... STO 0 GEN1 9H2G ... STO 2 GEN6 9H44 ... FINDWN 1,2,0,GEN6 9H5L ... TESTREPN OK,(GEN1) 9H78 ...XIT EXIT 6 0 9H8Q Z2ORELEND 9HNB [ 9J82 [ 9JML [THIS IS THE ENTRY FROM THE OPENWORK SEGMENT. IT IS MORE OR LESS THE 9K7= [SAME AS THE K1 ENTRY,EXCEPT THAT INFORMATION FROM THE CREATE BLOCK 9KLW [GOES TO THE FCB AS THERE IS NO ENT, ANY OTHER UPDATING OF THE ENT 9L6G [IS OMITTED,AS ARE TESTS FOR OPENMAS,HALFOPEN & DIRECTORY. FINALLY 9LL6 [THE METHOD OF LOCATING THE FCB IS DIFFERENT FROM THAT OF AN ORDINARY 9M5Q [OPEN. 9MKB [ 9N52 LDN 0 1 9NJL STO 0 AWORK4(2) [SET OPENWORK MARKER 9P4= SETMODE 0,THAW 9PHW ANDX 0 7 [WHEN THAW MODE IS SET J TO DIFFERENT 9Q3G BNZ 0 YTHW [IF MODE IS THAW OR 9QH6 LDCH 0 ATYPE(2) [ACT AN ACTLF THE WFILE WILL 9R2Q SBN 0 ACTLF/64 [NOT BE IN CURRENT ACT'S WFRING 9RGB BNZ 0 NTHAW 9S22 YTHW 9SFL CALL 6 XTHW 9S^= BRN NEST 9TDW BRN NOCLOSE 9TYG XFCB [S/R TO LOCATE FCB 9WD6 SETMODE 0,THAW 9WXQ ANDX 0 7 [IF NOT OPENTHAW LOOK FOR FCB IN 9XCB BNZ 0 XTHW [IF MODE IS THAW OR 9XX2 LDX 2 FX2 [ACT AN ACTLF THE WFILE WILL 9YBL LDCH 0 ATYPE(2) [NOT BE IN CURRENT ACT'S WFRING 9YW= SBN 0 ACTLF/64 9^*W BNZ 0 NOTH 9^TG XTHW =2*6 LDX 5 AWORK1(2) [PICK UP JOBNO TO LOCATE CPAT =2SQ NXCP =3#B JOBLOCK 5,3 =3S2 BNG 3 NOCP =4?L FCAJO 3,,N =4R= LDX 0 ATYPE(3) [IF EITHER OF JOBLOCK OR CPAT =5=W SRL 0 12 [DO NOT EXIST CARRY ON WITH AN ORD- =5QG SBN 0 CPAT [INARY OPEN =6=6 BNZ 0 NOCP =6PQ LDN 5 BWORKRING(3) =79B ... LDN 2 1 [CAN BE TO BE ERASED =7P2 ... LDX 1 5 [LOCATE FCB =88L ... CALL 0 XFINDWN2 [XIT 6 IF FOUND =8N= NOCP =97W LDX 2 FX2 =9MG LDN 0 1 ==76 ERS 0 AWORK4(2) [REMOVE WORKFILE MARKER FOR SEGMENT ==LQ LDX 3 6 [PRESERVE S/R LINK =?6B LDX 5 AWORK2(2) [PICK UP B.S.HOME OF FCB & FROM NOW =?L2 LDX 6 AWORK3(2) [ON LOCATE FCB IN FILE CHAIN. =#5L EXIT 3 1 =#K= NFCB GEOERR 1,NOWFFCB [ERROR IF FCB MISSING =*4W NOTH =*JG SETMODE 0,ERASING [IF ERASING MODE IS SET,THEN TO-BE- =B46 ANDX 0 7 [ERASED FCBS ARE ALLOWED FOR, =BHQ BNZ 0 XFN [OTHERWISE THEY ARE IGNORED =BY= ... LDN 2 0 [NOT TO BE ERASED =C#Q ...XFIND =CP= ... CALL 0 XFINDWN1 [EXIT 6 IF FOUND =D5Q ... BRN NFCB [NOT FOUND =DG= XFN =D^W ... LDN 2 1 [TO BE ERASED ALLOWED =FFG ... BRN XFIND =GDQ WFSER =GYB CALL 6 NOTH =HD2 BRN NEST =HXL WFCRE =JC= LDX 4 2 [PRESERVE CREATE BLOCK POINTER =JWW CALL 6 NOTH [LOCATE FCB =KBG LDX 3 4 =KW6 XNYW =L*Q LDX 1 0(2) [GET PTR TO NEXT BLOCK =LTB XFEX =M*2 LDX 0 ATYPE(1) =MSL SRL 0 12 =N#= SBN 0 FILE+FEXTRA [BRANCH BACK TO MAIN PATH IF FEXTRA =NRW BZE 0 XEFT [BLOCKHSA BEEN FOUND =P?G LDX 0 ATYPE(1) =PR6 SBX 0 FILEPLUSFCB [IF NEXT FCB HAS BEEN REACHED THEN =Q=Q BZE 0 XGER [THERE IS NO FEXTRA BLOCK =QQB LDX 1 0(1) [LOCATE NEXT BLOCK =R=2 BRN XFEX =RPL XGER GEOERR 1,NOFEXTRA =S9= XEFT =SNW LDX 0 CETM(3) [TAKE PERI TYPE/MODE FROM CREATEBLOCK =T8G STO 0 FTM(1) [BLOCK & STORE IN FEXTRA. =TN6 STO 0 FETM(2) =TR= JMBS NOTDAWORK,2,BFMT,BFSER =TS? ... LDX 0 CEORG(3) =TT# ... BZE 0 NOTDAWORK [J IF ASSIGN CASE. =TWB LDEX 0 CEINF3(3) =T^G STO 0 FSIZE(2) =W4L NOTDAWORK =W7Q FREECORE 3 =WMB CALL 6 NOTH [LOCATE FCB =X72 NYWB =XLL LDX 0 7 =Y6= ADN 0 #1000 =YKW ANDN 0 #4000 =^5G BZE 0 NEST [IF UNCLEAN MODE REMOVE THE NOT =^K6 LDN 0 #1000 [YET WRITTEN TO BIT ?24Q ORS 0 FCOMM(2) ?2JB ERS 0 FCOMM(2) ?342 BRN NEST ?3HL WFEMT ?43= CALL 6 NOTH ?4GW LDX 0 FCOMM(2) [IF NOT YET WRITTEN TO BIT SET ?52G ANDN 0 #1000 [UPDATE PERI TYPE/MODE WORD ?5G6 BZE 0 NEST ?5^Q HUNT 3,FILE,CREATE ?6FB BNG 3 NYWB ?6^2 BRN XNYW ?7DL WFLOC1 ?7Y= CALL 6 XFCB ?8CW BRN WNT1 [J TO CARRY ON AS FCB FOUND ?8XG HUNT 3,FILE,FSTACK ?9C6 BRN WNOF1 [J TO LOCATE FCB IN FILE CHAIN ?9WQ WNT1 ?=BB HUNT 3,FILE,FSTACK ?=W2 BRN WFCON1 ??*L WFLOC2 ??T= CALL 6 XFCB ?##W BRN WNT2 [J TO CARRY ON AS FCB FOUND ?#SG BRN WNOF2 [J TO LOCATE FCB IN FILE CHAIN ?*#6 WNT2 ?*RQ LDX 3 2 ?B?B BRN WFCON2 ?BR2 WFEP ?C=L BNG 2 WFEMT ?CQ= BRN WFCRE ?D9W UPP UP ?DPG [ ?F96 MENDAREA GAPOPEN,K99ORELEND ?FNQ #END ^^^^ ...45515712000900000000