{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: OPENWORK866)}}
====== OPENWORK866 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:DOWN|DOWN]], [[george:macro:FCAJO|FCAJO]], [[george:macro:FINDWFN|FINDWFN]], [[george:macro:FINDWN|FINDWN]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETDIRWORK|GETDIRWORK]], [[george:macro:HUNT|HUNT]], [[george:macro:JBS|JBS]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LONGOFF|LONGOFF]], [[george:macro:LONGON|LONGON]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LONGSTOP|LONGSTOP]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:OCTCON|OCTCON]], [[george:macro:OPENTEST|OPENTEST]], [[george:macro:OPENWORK|OPENWORK]], [[george:macro:READ|READ]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:THAWWF|THAWWF]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACE|TRACE]], [[george:macro:UNOPCH|UNOPCH]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:USERCRWF|USERCRWF]], [[george:macro:VFREE|VFREE]]
22FL ...#SEG OPENWORK [ROB RUSHTON
22^= #OPT K0OPENWORK=0
23DW #LIS K0OPENWORK>K0WORK>K0FILESTORE>K0ALLGEO
23YG #OPT K6OPENWORK=K6WORK>K6FILESTORE>K6ALLGEO
24D6 8HOPENWORK
24XQ SEGENTRY K1OPENWORK,OPENWORK
25CB SEGENTRY K2OPENWORK,OPENWORK2
25X2 SEGENTRY K3OPENWORK,ZGETDIRWORK
26BL SEGENTRY K13OPENWORK,ZGETDIRWORA
26W= SEGENTRY K4OPENWORK,THAWWF
27*W SEGENTRY K5OPENWORK,OPENTEST
27TG SEGENTRY K8OPENWORK,USERCRWF
28*6 [
28SQ [THIS SEGMENT CONTAINS THE CODING FOR SOME SUPER FAST WORKFILE MACROS,
29#B [AS FOLLOWS:-
29S2 [ K1 - OPENWORK
2=?L [ K3 - GETDIRWORK (%A ABSENT)
2=R= [ K13 - GETDIRWORK (%A PRESENT)
2?=W [ K4 - THAWWF
2?QG [ K5 - OPENTEST
2#=6 [ K7 - FREEZEWF
2#PQ [ K8 - USERCRWF
2*9B [
2*F8 ...XWORK 4HWORK
2*P2 XMODES +ADIROPEN+ALEAVE
2B8L TCLUDGE +ACLUDGE
2BN= MCL +AUSERCLEAN
2C7W SERAZADD #40000 [BIT 9 FOR ERASE ADDITIVE MODE
2CMG XFCB SETMODE 0,THAW [S/R TO LOCATE FCB IN ALL CASES
2D76 LDX 2 FX2
2DLQ ANDX 0 7 [J TO LOOK FOR FILE IN CURRENT
2F6B BNZ 0 YETH [IF MODE NOT THAW OR
2FL2 LDCH 0 ATYPE(2) [ACT NOT ACTLF WORKFILE MUST
2G5L SBN 0 ACTLF/64 [BE IN CURRENT ACT'S WFRING
2GK= BNZ 0 NOTH
2H4W YETH
2HJG LDX 5 AWORK1(2) [IF JOBNO IS ALREADY CALCULATED PICK
2J46 BNZ 5 NXCP [IT UP FROM AWORK1, OTHERWISE CALCULA
2JHQ XJC
2K3B MHUNT 1,FILE,FABSNB
2KH2 OCTCON A1+5(1) [CONVERT JOBNO IN NAME TO BINARY
2L2L SMO FX2
2LG= STO 5 AWORK1 [PRESERVE JOBNO FOR FUTURE USE
2L^W NXCP
2MFG JOBLOCK 5,2 [LOCATE JOB BLOCK &
2M^6 BNG 2 NOFF [J IF NO O JOBLOCK
2NDQ FCAJO 2,,N
2NYB LDCH 0 ATYPE(2)
2PD2 SBN 0 CPAT/64
2PXL BNZ 0 NOFF [J IF NO CPAT
2QC= LDN 5 BWORKRING(2)
2QWW XFN
2RBG FINDWN 5,3,1 [LOCATE FCB ALLOWING TO-BE-ERASED
2RW6 TESTREPN OK,NOCP
2S*Q LDX 0 7 [J IF NOT OPEN ENTRY
2STB ANDN 0 #7000
2T*2 BZE 0 XIT
2TSL LDX 0 BACK1(3) [PICK UP THE BACKING STORE HOME OF
2W#= STO 0 AWORK2(2) [FCB & STORE IN CASE FCB IS REMOVED
2WRW LDX 0 BACK2(3) [TO FILE CHAIN DURING THE OPENWORK
2X?G STO 0 AWORK3(2)
2XR6 XIT EXIT 6 0 [EXIT IF FCB FOUND
2Y=Q NFCB GEOERR 1,NOWFFCB [ERROR IF FROZEN FILE MISSING
2YQB NJO GEOERR 1,NOJOBNO
2^=2 NOTH
2^PL SMO FX2
329= LDN 5 BWORKRING
32NW SETMODE 0,ERASING [IF ERASING MODE IS SET ALLOW FOR
338G ANDX 0 7 [TO-BE-ERASED FCBS.
33N6 BNZ 0 XFN
347Q FINDWN 5,3
34MB TESTREPN OK,NOFF
3572 EXIT 6 0
35LL NOCP
366= NOFF
36KW LDX 2 FX2
375G SETREP2 NOFILE
37K6 LDX 0 7
384Q ANDN 0 #7000
38JB BZE 0 UP [J TO GO UP IF NO MAIN MIDE(I.E.GDEW)
3942 LDEX 0 CLONG1(2) [IF LONG-EVENT FIELD SET, IT MUST
39HL BZE 0 NLS [BE UNSET BEFORE ABANDINING THE
3=3= LONGOFF [OPENWORK TO DO AN OPENREL
3=GW NLS
3?2G UPPLUS 1
3?G6 UP
3?^Q SBN 7 1 [IF GETDIRWORK ENTRY THE ENT SHOULD
3#FB BZE 7 UPP [BE FREED
3#^2 MFREEW FILE,ENT
3*DL UPP
3*Y= UP
3*^S ...#
3B3B ...# THIS SUBROUTINE REDUCES A JOB'S ONLINE BS COUNT FOR A ! FILE.
3B4Y ...# ON ENTRY, X0= SIZE OF DECREMEMT IN BLOCKS. X6 IS LINK.
3B6G ...# ON EXIT, X1=FX1, X2=FX2. USES X0. NO COORDINATION.
3B84 ...#
3B9L ...SUBCUBS
3B?8 ... SUBCUBS NOTOPEN,0,JOB
3B#Q ... EXIT 6 0
3BB# ...#
3BCW [THIS ROUTINE TESTS WHETHER THE FCB INDICATED BY X2 CAN BE OPENED
3BXG TRYREEL
3CC6 LDN 0 AEMPTY [IF IT IS EMPTY MODE,
3CWQ ANDX 0 7
3DBB BZE 0 ORDINARY
3DW2 LDX 4 FWAITCOUNT(2) [WE MUST MAKE SURE THAT
3F*L ORX 4 CTOPEN(2) [THE FILE IS UTTERLY UNUSED.
3FT= SLC 4 1
3G#W SLL 4 1 [COMMUNE BIT DOESN'T MATTER.
3GSG ORX 4 FREEZECOUNT(2) [NO GOOD IF FROZEN
3H#6 BZE 4 OK
3HRQ SETMODE 0,REPLY [TEST MODE WORD FOR REPLY BIT
3J?B ANDX 0 7
3JR2 BNZ 0 SAYCANT [IF THERE DONT WAIT
3K=L LDN 5 0 [SET FCB B.S. HOME PAIR (I.E. ZERO &
3KQ= LDX 6 BACK2(2) [UNIQUW N0.) FOR LONGSTOP
3L9W LONGSET 6,XSET,6
3LPG LDN 0 #400
3M96 ORS 0 COMM(3) [SET WAITING TO EMPTY BIT IN FCB
3MNQ DOWN OPENWAIT,3 [GO DOWN TO OPENWAIT FOR CLUDGETEST
3N8B BRN NOCL [J IF NO CLUDGE
3NN2 NGN 4 1
3P7L CALL 6 XFCB [RELOCATE FCB
3PM= LDN 0 #400
3Q6W ERS 0 COMM(3) [UNSET WAITING TO EMPTY BIT IN FCB
3QLG BRN SAYCANT
3R66 NOCL
3RDH ...#UNS EWAITFILE
3RQY ... LDX 6 XWORK(1) [WORKFILE SWITCH FOR WHATSTATE
3S5B LONGSTOP XBRK2,,FWFREE
3TJ= CALL 6 XFCB [WAIT
3W3W LDN 0 #400
3WHG ERS 0 COMM(3) [UNSET WAITING TO EMPTY BIT IN FCB
3X36 BRN ONEREEL
3XGQ XBRK [BREAKIN DURING OPENWAIT OR LONGSTOP
3Y2B CALL 6 XFCB [RELOCATE FCB
3YG2 LDN 0 1
3Y^L SBS 0 FWAITCOUNT(3) [BROKEN IN SO NO LONGER WAITING
3^F= BRN NLFT
3^YW XBRK2
42DG CALL 6 XFCB [RELOCATE FCB
42Y6 LDN 0 #400
43CQ ERS 0 COMM(3) [UNSET WAITING TO EMPTY BIT IN FCB
43XB LONGON 6,5 [WAKE UP OTHER WAITERS
44C2 NLFT HUNT 1,BSTB,FULLB [SEE IF THERE IS A BSTB/FULLB LYING A
44WL BNG 1 NBSTB [J IF NOT
45B= FREEBAX [FREE IT AND ITS BLOCKS IF THERE IS
45TW MFREE BSTB,EMPTYB
46*G NBSTB
46T6 UP
47#Q OPDIR GEOERR 1,DIREMPTY [OPENREL EMPTY ON A DIRECT-ORY
47SB [NO ONE CAN BE USING THE FILE IN ANY SENSE IN THE MULTI-REEL/EMPTY CASE.
48#2 [WE MIGHT AS WELL DO THE SAME FOR ONE REEL.
48RL ORDINARY
49?= LDX 4 CTOPEN(2) [PICK UP OPEN MODE:
49QW #SKI K6OPENWORK>599-599
4==G TRACE 4,WKCTOPEN
4=Q6 [FORMAT IS; L.S. 12 BITS,COUNT OF READ OPENERS. NEXT L.S. 9 BITS,COUNT
4?9Q [OF APPEND OPENERS. B0=SOLE OPENER BIT B1=COMMUNAL BIT.
4?PB LDX 0 FREEZECOUNT(2)
4#92 BZE 0 NOFRZ [OK IF NOT FROZEN
4#NL LDN 0 #7000
4*8= ANDX 0 7 [TEST MODE WORD FOR READ
4*MW SBN 0 #3000
4B7G BPZ 0 WAIT [WAIT IF IT ISNT
4BM6 NOFRZ
4C6Q BZE 4 OK [CARRY ON IF FCB OPEN
4CLB LDN 0 #7000
4D62 ANDX 0 7 [ISOLATE MAIN PART OF MODE
4DKL SBN 0 #3000 [TEST FOR READ
4F5= BPZ 0 S31 [SKIP IF NOT READ
4FJW LDX 0 4
4G4G SRL 0 12 [ISOLATE APPEND COUNT & SOLE BIT
4GJ6 ANDN 0 #5777 [RID OF COMMUNE BIT.
4H3Q BNZ 0 TBC [TRY FOR COMMUNE MODE & FILE
4HHB BRN OK
4J32 S31
4JGL LDEX 0 FREEZECOUNT(2)
4K2= BNZ 0 WAIT [MUST NOT IF FROZEN
4KFW TBC
4K^G LDX 4 FCOMMCT(2)
4LF6 ANDN 4 #7777 [CT OF CLEAN OPENERS
4LYQ BZE 4 RCOMM [J IF NONE
4MDB SMO FX1
4MY2 LDX 0 MCL
4NCL ANDX 0 7
4NX= BZE 0 WAIT [J IF NOT CLEAN
4PBW LDX 0 CTOPEN(2)
4PWG BPZ 0 RDCT [J IF NO WRITER
4QB6 LDX 0 7
4QTQ ANDN 0 #7000 [MAIN MODE
4R*B SBN 0 #3000
4RT2 #SKI K6OPENWORK>599-599
4S#L TRACE 0,WORKMODE
4SS= BPZ 0 WAIT [J IF NOT READER
4T?W OK EXIT 6 0
4TRG RCOMM
4W?6 LDX 4 FCOMMCT(2)
4WQQ #SKI K6OPENWORK>599-599
4X=B TRACE 4,WORKCOMM
4XQ2 BZE 4 WAIT [WAIT IF NO COMMUNERS
4Y9L LDN 0 ACOMMUNE
4YP= ANDX 0 7
4^8W #SKI K6OPENWORK>599-599
4^NG TRACE 0,COMMODE
5286 BZE 0 WAIT [J IF NOT COMMUNE MODE
52MQ LDX 0 CTOPEN(2)
537B SRL 0 12
53M2 ANDN 0 #1777 [EXTRACT APPEND CT
546L #SKI K6OPENWORK>599-599
54L= TRACE 0,WORKAPP
555W BNZ 0 OK [J IF APPENDERS
55KG SRL 4 12 [CT OF COMMUNES
5656 RDCT
56JQ LDX 0 CTOPEN(2)
574B ANDN 0 #7777 [CT OF READERS
57J2 ERX 4 0
583L #SKI K6OPENWORK>599-599
58H= TRACE 4,WORKRDCM
592W BZE 4 OK [J IF EQUAL
59GG BRN WAIT
5=26 [
5=FQ [THIS IS THE ENTRY FROM THE OPENWORK MACRO. THIS OPENS A WORKFILE
5=^B OPENWORK
5?F2 STOZ AWORK1(2) [ZEROIZE JOBNO MARKER
5?YL LDX 7 EXEC1(2) [MODE WORD IN X7
5#D= #SKI K6OPENWORK
5#XW TRACE 7,OPENWORK
5*CG CALL 6 XFCB [LOCATE FCB
5*X6 SMO FX1
5BBQ ORX 7 XMODES [ADD DIROPEN AND LEAVE MODES
5BWB BRN ONEREEL
5CB2 WAIT
5CTL LDN 4 0
5D*= SETMODE 0,REPLY
5DSW ANDX 0 7 [TEST THE REPLY BIT IN THE MODE WORD:
5F#G BZE 0 OOR3 [IF NOT THERE WAIT:
5FS6 SAYCANT
5G?Q BNG 4 SCLD [J IF CLUDGE
5GRB SETREP CANT
5H?2 BRN REPG [REPLY SET
5HQL SCLD SETREP CLUDGE
5J== TOPFCB 2 [X2 -> FCB OF FILE OPEN AT TOP LEVEL
5JPW LDX 6 BACK2(3)
5K9G BXU 6 BACK2(2),REPG [TEST FOR CLUDGE AT TOP LEVEL
5KP6 SMO FX1
5L8Q LDX 0 TCLUDGE [IF IT IS, SET BIT FOR COPY
5LNB TOPFCA 2
5M82 ORS 0 FGENERAL1(2) [MARK1 ONLY ****
5MML REPG UPPLUS 1
5N7= XSET GEOERR 1,OPENWORK
5NLW OOR3
5P6G LDN 0 1
5PL6 ADS 0 FWAITCOUNT(3) [ADD ONE TO THE COUNT OF WAITERS
5Q5Q LDN 5 0 [SET UP B.S. HOME PAIR FOR FCB (I.E.
5QKB LDX 6 BACK2(3) [ZERO & UNIQUE NO.) FOR LONGSTOP
5R52 LONGSET 6,XSET,6 [SET WAITING STYLE
5RJL DOWN OPENWAIT,3 [TEST FOR CLUDGE
5S4= BRN NCLD [NO CLUDGE IF COMES STRAIGHT UP
5SHW NGN 4 1 [SET CLUDGE MARKER
5T3G CALL 6 XFCB [RELOCATE FCB
5TH6 LDN 0 1
5W2Q SBS 0 FWAITCOUNT(3) [NO LONGER GOING TO WAIT
5WGB BRN SAYCANT [REMOVE UNCLEAN BIT AND CLEAR UP
5X22 NCLD
5XFL CALL 6 XFCB [RELOCATE FCB
5X^= LDX 0 7
5YDW ADN 0 #1000 [TEST FOR AN UNCLEAN MODE
5YYG ANDN 0 #4000
5^D6 BZE 0 TSTRP [J IF IT ISNT
5^XQ LDCT 0 2
62CB ORS 0 COMM(3) [OTHERWISE PUT BIT INTO FCB
62X2 TSTRP
63BL #SKI K6OPENWORK>599-599
63W= TRACE 6,WORKSTOP
648M ...#UNS EWAITFILE
64H4 ... LDX 6 XWORK(1) [WORKFILE SWITCH FOR WHATSTATE
64TG LONGSTOP XBRK,,FWFREE
66#B OPENWORK2
66S2 CALL 6 XFCB [LOCATE FCB
67?L SFCBA
67R= LDN 0 1 [REMOVE THIS ACTIVITY FROM THE
68=W SBS 0 FWAITCOUNT(3) [COUNT OF WAITERS.
68QG ONEREEL
69=6 LDX 2 3 [X2 -> REEL TO BE OPENED:
69PQ CALL 6 TRYREEL
6=9B [
6=P2 [N.B.THE ERASING MODE WILL NEVER BE SET IN OPENWORK SINCE THIS CASE IS
6?8L [DEALT WITH BY ERASEWORK MACRO
6?N= [
6#7W SETMODE 0,EMPTY [IF EMPTY MODE IS SET THE POINTER
6#MG ANDX 0 7 [WITHIN FCB (FBLMOD) SHOULD BE SET
6*76 BZE 0 NEMP [TO INDICATE FILE HAS BEEN EMPTIED
6*BY ... LDX 0 FBLMOD(2)
6*LQ ... SBN 0 FBLKS-A1 [X0= NO. OF BLOCKS TO FREE
6*WJ ... LDN 1 FBLKS-A1
6B6B ... STO 1 FBLMOD(2)
6BB8 ... CALL 6 SUBCUBS [DO SUBCUBS TO REDUCE JOB'S ONLINE BS
6BL2 NEMP
6C5L LDX 1 7
6CK= SMO FX1
6D4W ANDX 1 MCL
6DJG BZE 1 NOBL1 [J IF NOT CLEAN
6F46 LDN 0 1
6FHQ BRN NOBL2
6G3B NOBL1
6GH2 LDX 1 7
6H2L ANDN 1 ACOMMUNE
6HG= BZE 1 PLUS [J IF NOT COMMUNE
6H^W LDCT 0 #200 [SET COMMUNE BRT
6JFG ORS 0 CTOPEN(3)
6J^6 LDN 0 #4000
6KDQ SLL 0 1
6KYB NOBL2
6LD2 ADS 0 FCOMMCT(3)
6LXL PLUS
6MC= LDX 4 7
6MWW ANDN 4 #7777 [ISOLATE BOTTOM HALF OF MODE WORD
6NBG [X3 -> FCB , MODE IN X7
6NW6 LDN 0 #2777
6P*Q BXGE 0 4,READ [MAIN MODE 1 OR 2 FOR A READER
6PTB LDN 0 #7000
6Q*2 BXGE 4 0,SOLE [CLEAN IS SOLE BUT NOT UMCLEAN BIT
6QSL LDCT 1 #2 [BEING WRITTEN BIT GOES
6R#= ORS 1 COMM(3) [INTO FCB.
6RRW LDN 0 #3777
6S?G BXGE 0 4,RAPP [3 FOR AN APPENDER
6SR6 SOLE LDCT 0 #400 [SOLE OPENER, JUST ONE BIT TO STORE
6T=Q ORS 0 CTOPEN(3)
6TQB BRN OPENFCBED
6W=2 READ LDN 0 1
6WPL ADS 0 CTOPEN(3) [INCREASE COUNT OF READERS.
6X9= BRN OPENFCBED [[CHECK IT IS SMALL?
6XNW RAPP LDN 0 #4000
6Y8G ADX 0 0
6YN6 ADS 0 CTOPEN(3) [INCREASE COUNT OF APPENDERS. <1024
6^7Q OPENFCBED
6^MB SMO FX1
7272 LDX 0 SERAZADD
72LL ANDX 0 7
736= BZE 0 NERAD [J IF NO ERASE ADDITIVE MODE
73KW ... LDN 0 4
745G ORS 0 COMM(3) [SET BEING ERASED BIT IN COMM
74K6 NERAD
754Q SETMODE 0,THAW
75JB ANDX 0 7 [IF THAW MODE IS SET SUBTRACT 1 FROM
7642 BZE 0 ORE [FREEZECOUNT OF FCB
76HL LDN 0 1
773= SBS 0 FREEZECOUNT(3)
77GW ORE
782G ACROSS ORELEND,2
78G6 [
78^Q [THIS IS THE ENTRY FROM GETDIRWORK MACRO. ITS PURPOSE IS TO SET UP A
79FB [FILE/ENT BLOCK FOR A WORKFILE,RESEMBLING A USUAL DIRENT AS FAR AS IS
79^2 [POSSIBLE.
7=DL ZGETDIRWORK
7=Y= LDN 7 0 [ZEROISE X7 TO INDICATE GDEWORK ENTRY
7?CW XSC
7?XG SETNCORE FRDE,1,FILE,ENT
7#C6 LDCH 0 ATYPE(2) [FI ACT AN ACTLF WORKFILE WILL NOT BE
7#WQ SBN 0 ACTLF/64 [IN CURRENT ACT'S WFRING
7*BB BNZ 0 NLF
7*W2 CALL 6 XJC [LOCATE CPAT & THEN FCB
7B*L BRN XLF
7BT= NLF CALL 6 NOTH [LOCATE CPAT IN THIS ACT'S WORKFILERI
7C#W XLF
7CSG LDX 2 3
7D#6 HUNT 3,FILE,FABSNB
7DRQ HUNT 1,FILE,ENT
7F?B STOZ A1(1) [ZEROIZE ENT BLOCK
7FR2 LDN 5 A1(1)
7G=L LDN 6 A1+1(1)
7GQ= MOVE 5 FRDE-1
7H9W LDN 5 FRDE [SET ENT HEADER
7HPG STO 5 A1(1)
7J96 LDN 5 FLOC1(2) [MOVE LOCAL NAME TO DIRENT
7JNQ LDN 6 ELOC1(1)
7K8B MOVE 5 5
7KN2 LDCT 4 #20
7L7L ANDX 4 FCOMM(2)
7LM= LDX 3 0(2)
7M6W XEF LDX 0 ATYPE(3)
7MLG SRL 0 12
7N66 SBN 0 FILE+FEXTRA [TEST IF NEXT BLOCK IS FEXTRA
7NKQ BZE 0 XFE
7P5B LDX 0 ATYPE(3) [IF NOT FEXTRA TEST IF NEXT FCB HAS
7PK2 SBX 0 FILEPLUSFCB [BEEN REACHED. ERROR IF IT HAS
7Q4L BZE 0 XGE
7QJ= LDX 3 0(3) [PICK PTR TO NEXT BLOCK
7R3W BRN XEF
7RHG XGE GEOERR 1,NOFEXTRA
7S36 XFE
7SGQ LDX 5 FWRITDAY(3) [TAKE DATE & TIME FILE LAST WRITTEN
7T2B STO 5 EWRITDAY(1) [TO FROM FEXTRA & PUT IN ENT BLOCK.
7TG2 LDX 5 FWRITTIME(3)
7T^L STO 5 EWRITTIME(1)
7WF= LDX 5 FTM(3)
7WYW STO 5 ETM(1)
7XDG BNZ 4 SER [J II SERIAL
7XY6 LDX 0 FENDBUCK(2)
7YCQ STO 0 EENDBUCK(1)
7YXB LDN 0 #20 [IF MT SET MT BIT & UPDATE AS SERIAL
7^C2 ANDX 0 FCOMM(2) [FILE FROM HERE,OTHERWISE FILE IS
7^WL BZE 0 XMT [RANDOM.
82B= LDCT 0 4
82TW ORS 0 EINF1(1)
83*G BRN YMT
83T6 XMT
84#Q LDX 0 FVERSION(2) [UPDATE D.A. INFORMATION
84SB STO 0 EVERSION(1)
85#2 LDX 4 FSIZE(2) [SET SIZE IN EINF3 & ECOPS AS FOUND
85RL STO 4 EINF3(1) [IN FSIZE
86?= SRC 4 9
86QW ADN 4 1
87=G STO 4 ECOPS(1)
87Q6 LDN 5 FFLOW(3)
889Q LDN 6 EFLOW(1)
88PB MOVE 5 3
8992 BRN SOR
89NL SER
8=8= LDCT 0 #400 [SET SERIAL FILE BIT
8=MW ORS 0 EINF1(1)
8?7G YMT
8?M6 LDN 0 FILESIZE [SET MAX SIZE IN ENT AS DEFINED BY
8#6Q STO 0 EINF3(1) [FILESIZE
8#LB LDX 0 FBLMOD(2) [SET SIZE IN ECOPS AS CALCULATED
8*62 SBN 0 FBLKS-A1 [FROM FBLMOD
8*KL SRC 0 9
8B5= ADN 0 1 [SET FILE ONLINE BIT
8BJW STO 0 ECOPS(1)
8C4G SOR
8CJ6 LDN 0 #1000 [IF THE 'WRITE ACCESS ALLOWED BY
8D3Q ANDX 0 FCOMM(2) [PROPER USER' BIT IS SET IN THE
8DHB BZE 0 NWA [FCB, SET IT IN THE DIRENT ALSO
8F32 LDN 0 #20
8FGL ORS 0 EINF2(1)
8G2= NWA
8HF6 LDCT 0 #200 [SET LAST REEL BIT
8HYQ ORS 0 EINF1(1)
8JDB LDCT 0 #40
8JY2 ANDX 0 FCOMM(2)
8KCL BZE 0 NLNK [J IF NOT LINK DEF FILE
8KX= LDCT 0 #100 [SET LINK DEF BIT IN ENT
8LBW ORS 0 EINF1(1)
8LWG NLNK LDN 0 1
8MB6 ANDX 0 FCOMM(2)
8MTQ BZE 0 NER [J IF NOT TO BE ERASED
8N*B LDCT 0 #40 [SET TO- BE-ERASED BIT
8NT2 NER
8P#L ADN 0 #40 [SET WORKFILE MARKER
8PS= ORS 0 EINF2(1) [SET TEMP FILE BIT
8Q?W LDCT 0 2
8QRG ANDX 0 COMM(2) [TRANSFER UNCLEAN WRITING BIT TO
8R?6 ORS 0 EINF1(1) [ENT IF IN FCB
8RQQ LDX 0 FREEZECOUNT(2) [PUT FREEZECOUNT IN ENT
8S=B STO 0 EAUTOCOUNT(1)
8SQ2 LDX 0 FLAN(2) [SET LANG
8T9L STO 0 ELAN(1)
8TP= #SKI K6OPENWORK>599-599
8W8W TRACE 2,FCBLEVEL
8WNG SETREP OK
8X86 UP
8XMQ [
8Y7B [THIS IS THE ENTRY FROM THE GETDIRWORK MACRO, ITS PURPOSE IS TO SET
8YM2 [UP A FILE/ENT BLOCK FOR A WORKFILE EVEN IF IF IT IS TO-BE-ERSED,
8^6L [RESEMBLING A USUAL DIRENT AS FAR AS IS POSSIBLE
8^L= ZGETDIRWORA
925W SETMODE 7,ERASING
92KG BRN XSC
9356 [
93JQ [THIS IS THE ENTRY FROM THE THAWWF MACRO. ITS PURPOSE IS TO THAW A
944B [WORKFILE WITHOUT OPENING IT.
94J2 THAWWF
953L LDN 7 1 [SET NOT-OPENWORK MARKER
95H= CALL 6 XJC [LOCATE FCB FOR WORKFILE
962W LDX 0 FREEZECOUNT(3)
96GG SBN 0 1 [DECREMENT FREEZECOUNT BY 1
9726 BNG 0 NFRZ [CHECK THAT IT DOES NOT GO -VE
97FQ STO 0 FREEZECOUNT(3)
97^B LDX 6 BACK2(3)
98F2 LONGON 6,6 [FREE ANY WAITERS
98YL UPPLUS 1
99D= NFRZ GEOERR 1,NOFROST
99XW [
9=CG [THIS IS THE ENTRY FOM THE OPENTEST MACRO. IT IS USED BY LISTFILE TO
9=X6 [LOCATE THE FCB FOR A WORKFILE AND TEST IF ANYONE HAS IT OPEN IN
9?BQ [AN UNCLEAN MODE
9?WB OPENTEST
9#B2 LDN 7 1 [SET NOT-OPENWORK MARKER
9#TL CALL 6 XJC [LOCATE FCB IF THERE
9**= UNOPCH 3,OFW [J IF OPEN FOR WRITING
9*SW UPPLUS 2
9B#G OFW UPPLUS 1
9BS6 [THIS IS THE ENTRY FROM THE USERCRWF MACRO. IT IS USED BY USEROPEN TO
9C?Q [UPDATE A WORKFILE'S FCB & FEXTRA FROM THE FEXTRA BLOCK.
9CRB USERCRWF
9D?2 HUNT 3,FILE,CREATE
9DQL BNG 3 XCR
9F== CALL 6 XLW [LOCATE FCB
9FPW LDCT 0 #20 [FILE CAN ONLY BE CHANGED IF IT IS
9G9G ANDX 0 FCOMM(1) [SERIAL
9GP6 BZE 0 UNS
9GYY ... JBS XCR,3,CESERIAL [J IF SERIAL.
9H8Q LDX 0 CETM(3)
9HNB SLC 0 9
9J82 ANDN 0 #377 [FILE DOES NOT NEED CHANGING IF
9JML LDN 4 5 [CHANGE IS TO SERIAL.
9KLW LDCT 5 #20
9L6G ERS 5 FCOMM(1) [UNSET SERIAL BIT
9LL6 BXU 0 4,NMT [J IF NOT MT
9M5Q LDN 0 #20
9MKB ORS 0 FCOMM(1) [SET MT BIT
9N52 NMT
9NJL LDX 0 CETM(3)
9P4= STO 0 FETM(1)
9PHW LDX 0 CEENDBUCK(3) [UPDATE FENDBUCK & FVERSION IF
9Q3G STO 0 FENDBUCK(1)
9QH6 NC1 LDX 0 CEVERSION(3)
9R2Q STO 0 FVERSION(1)
9RGB LDX 2 FPTR(1) [LOCATE FEXTRA
9S22 LDX 0 ATYPE(2)
9SFL SRL 0 12
9S^= SBN 0 FILE+FEXTRA
9TDW BZE 0 NOST
9TYG LDX 2 FPTR(2)
9WD6 NOST LDX 0 CETM(3) [UPDATE PERI TYPE/MODE.
9WXQ STO 0 FTM(2)
9XCB LDN 4 CEFLOW(3)
9XX2 LDN 5 FFLOW(2)
9YBL MOVE 4 3
9YW= LDN 0 #20
9^*W ANDX 0 FCOMM(1) [IF MT SIZE OF FILE IS SET TO MAX
9^TG BNZ 0 XBLOK [THUS NO BLOCKS TO BE FREED
=2*6 LDX 4 CEINF3(3) [UPDATE FSIZE FOR DA FILE
=2SQ ANDX 4 BITS22LS
=3#B STO 4 FSIZE(1)
=3S2 SBX 4 FUSEBL(1) [IF FCB ALREADY HAS MORE BLOCKS
=4?L ADN 4 FBLKS-A1 [ALLOCATED TO IT THAN ARE ALLOWED
=4R= BPZ 4 XBLOK [IN NEW FILE SIZE THE EXCESS BLOCKS
=5=W NGX 4 4 [MUST BE FREED.
=5QG ADN 4 2
=6=6 SETUPCORE 4,3,BSTB,FULLB
=6PQ STO 4 A1(3)
=79B CALL 6 XLW
=7P2 LDX 0 BSPRE(1)
=88L STO 0 A1+1(3)
=8N= ADX 1 FUSEBL(1)
=97W ADN 1 A1+2
=9MG SBX 1 4
==76 LDN 2 A1+2(3)
==LQ SMO 4
=?6B MOVE 1 510
=?L2 FREEBAX
=#5L MFREE BSTB,EMPTYB
=#K= CALL 6 XLW
=*4W SBN 4 2
=*JG SBS 4 ALOGLEN(1) [RESET ALOGLEN & FBLMOD IF SOME
=B46 LDX 4 ALOGLEN(1) [BLOCKS FREED
=B?Y ... LDX 0 FBLMOD(1)
=BHQ STO 4 FBLMOD(1)
=BQ2 ... STO 4 FUSEBL(1) [UPDATE FUSEBL
=BY= ... SBX 0 FBLMOD(1) [X0= CHANGE IN SIZE OF FBLMOD
=C6G ... CALL 6 SUBCUBS [ADJUST JOB'S ONLINE BS COUNT (WILL A
=C#Q ... [ IF X0 IS -IVE !!!!, WHICH HELPS SI
=CH2 XBLOK VFREE FILE,ENT
=D2L GETDIRWORK
=DG= XCR UP
=D^W UNS UPPLUS 1
=FFG XLW FINDWFN ,1
=F^6 TESTREPN OK,XGEO
=GDQ EXIT 6 0
=GYB XGEO GEOERR 1,NOWORKF
=HD2 [
=HXL MENDAREA GAPOPEN,K99OPENWORK
=JC= #END
^^^^ ...07770215000100000000