{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ORELEND860)}}
====== ORELEND860 ======
(George Source)
**Macros used:** [[george:macro:ANSOK|ANSOK]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSESET|CLOSESET]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:FCAJO|FCAJO]], [[george:macro:FDRMAUTX|FDRMAUTX]], [[george:macro:FINDWN|FINDWN]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GDRPTRS|GDRPTRS]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETFCB|GETFCB]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INITLFCA|INITLFCA]], [[george:macro:JBC|JBC]], [[george:macro:JMBS|JMBS]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LONGON|LONGON]], [[george:macro:MAPBOREL|MAPBOREL]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:REWRITE|REWRITE]], [[george:macro:RINGFILE|RINGFILE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SETUPFCA|SETUPFCA]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTMODE|TESTMODE]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:WHATBACK|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