{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WORKFILE860)}}
====== WORKFILE860 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHECKLFN|CHECKLFN]], [[george:macro:CLOSESET|CLOSESET]], [[george:macro:COOR3|COOR3]], [[george:macro:DELETE|DELETE]], [[george:macro:DOWN|DOWN]], [[george:macro:ERROR|ERROR]], [[george:macro:FCAJO|FCAJO]], [[george:macro:FINDWFL|FINDWFL]], [[george:macro:FINDWFN|FINDWFN]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETDIR|GETDIR]], [[george:macro:GETDIRWORK|GETDIRWORK]], [[george:macro:HUNT|HUNT]], [[george:macro:INSERT|INSERT]], [[george:macro:JBSS|JBSS]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:JOBLOCKC|JOBLOCKC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OCTCON|OCTCON]], [[george:macro:OP|OP]], [[george:macro:OPEN|OPEN]], [[george:macro:READBACK|READBACK]], [[george:macro:RERING|RERING]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARABEG|SPARABEG]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSFCB|TRANSFCB]], [[george:macro:TRF|TRF]], [[george:macro:UP|UP]], [[george:macro:VFREE|VFREE]], [[george:macro:WORKNAME|WORKNAME]], [[george:macro:WORKNUMB|WORKNUMB]]
22FL #SEG WORKFILE [GEORGE PORTER
22^= #OPT K0WORKFILE=0
23DW #LIS K0WORKFILE>K0WORK>K0FILESTORE>K0ALLGEO
23YG #OPT K6WORKFILE=K6WORK>K6FILESTORE>K6ALLGEO
24D6 8HWORKFILE
24XQ SEGENTRY K1WORKFILE,WORKNAME
25CB SEGENTRY K2WORKFILE,ZERASEWORK
25X2 SEGENTRY K3WORKFILE,ZDELETEWORK
26BL SEGENTRY K13WORKFILE,ZDELWORK
26W= SEGENTRY K4WORKFILE,ZERALLWF
27*W [
27TG [THIS SEGMENT DEALS WITH VARIOUS MACROS FOR SUPER-FAST WORKFILES
28*6 [ K1 - WORKNAME
28SQ [ K2 - ERASEWORK
29#B [ K3 - DELETEWORK
29S2 [
2=?L SHR 1,4H!
2=R= XMSK #77777
2?=W QUAL #30
2?QG XMIN #35
2#=6 SHRE 1,4H!
2#PQ NDE 1,1,4HC1
2*9B [
2*P2 [THIS IS THE ENTRY FROM THE WORKNAME MACRO. IT SETS UP A FILE/FABSNB
2B8L [BLOCK FOR A WORKFILE FROM A CPB,CUNI BLOCK. THE LEVEL & JOB NUMBER
2BN= [ARE SET IN THE FABSNB & THE FCB NUMBER IS ZEROIZED.
2C7W WORKNAME
2CMG LDN 4 7 [SET UP DIFFERENT SORT OF FABSNB IN
2D76 BXU 7 4,NTAP [THE WORKTAPE CASE
2DLQ YTAP
2F6B SPARABEG 1,SHRE(1) [GET TAPENAME PARAMETER
2FL2 CHECKLFN NWR,NWR [CHECK FORMAT OF NAME
2G5L HUNT 3,CPB,CUNI [RENAME UNI BLOCK TO AVOID
2GK= SETNCORE 16,3,FILE,FABSNB [SET UP WORKTAPE FABSNB
2H4W LDX 4 JOBNO(2) [ERROR IF NO JOB NUMBER SINCE WORKTAP
2HJG BZE 4 NOJ [NOT ALLOWED IN NOUSER CONTEXT
2J46 JOBLOCKC 2
2JHQ LDX 4 ALOGLEN(2) [ERROR IF SHORT JBBLK SINCE WKTAPES
2K3B SBN 4 2 [NOT ALLOWED IN NOUSER CONTEXT
2KH2 BZE 4 NOJ
2L2L LDN 4 16 [SET FABSNB HEADER
2LG= STO 4 A1(3)
2L^W LDN 4 JUSER(2) [MOVE USER NAME OF JOB TO FABSNB
2MFG LDN 5 A1+1(3)
2M^6 MOVE 4 3
2NDQ LDN 4 JNAME(2) [MOVE JONAME TO FABSNB
2NYB LDN 5 A1+4(3)
2PD2 MOVE 4 3
2PXL LDN 4 NDE(1) [SET DETAILS FOR JOBNAME TO INDICATE
2QC= LDN 5 A1+7(3) [TEMPORARY DIRECTORY
2QWW MOVE 4 3
2RBG HUNT 2,CPB,CUNI
2RW6 LDX 1 ANUM(2)
2S*Q ANDN 1 #7777
2STB ADN 1 3 [CALCULATE NUMBER OF WORDS IN
2T*2 SRL 1 2 [PARAMETER
2TSL LDN 4 APARA(2)
2W#= LDN 5 A1+10(3)
2WRW LDX 0 ACES
2X?G STO 0 A1+11(3)
2XR6 STO 0 A1+12(3) [MOVE PARAMETER TO FILENAME AREA IN
2Y=Q MOVE 4 0(1) [FABSNB , SPACE-FILLING EXCESS WORDS
2YQB STOZ A1+13(3) [ZEROISE DETAILS
2^=2 STOZ A1+14(3)
2^PL STOZ A1+15(3)
329= LDN 4 #201 [SET TEMP & NON-FILESTORE MARKERS
32NW ORS 4 ATYPE(3)
338G FREECORE 2
33N6 DOWN NORMALUS,3
347Q TESTREPN OK,XAD
34MB SETREP OK
3572 UP
35LL NTAP
366= HUNT 2,CPB,CUNI
36KW #SKI K6WORKFILE>599-599
375G TRACE APARA(2),WORKPAR
37K6 LDEX 3 ANUM(2)
384Q SBN 3 1 [SUBTRACT 1 TO ALLOW FOR !
38JB BZE 3 ZER [J IF NO CHARACTERS AFTER !
3942 LDCT 5 #200 [ADD 1 CHARACTER POSITION TO
39HL ADS 5 2 [MODIFIER TO ALLOW FOR !
3=3= LDCH 6 APARA(2)
3=GW BXE 6 XMIN(1),XMIN1 [BRANCH IF -
3?2G BXE 6 QUAL(1),ZER [BRANCH IF (
3?G6 SCDB
3?^Q LDN 4 0 [ZEROIZE WORDS TO HOLD CONVERTED
3#FB LDN 5 0 [NUMBER
3#^2 NCDB
3*DL LDCH 0 APARA(2)
3*Y= BXE 0 QUAL(1),XOUT [BRANCH TO END CONVERT IF ( REACHED
3BCW CDB 4 APARA(2) [CONVERT NUMBER
3BXG BCS NNUM [J IF NOT NUMBER
3CC6 BCHX 2 £
3CWQ BCT 3 NCDB
3DBB XOUT
3DW2 #SKI K6WORKFILE>599-599
3F*L TRACE 5,WORKCON
3FT= LDN 4 5 [GO UP IF STOPLIST
3G#W BXE 4 7,UPP
3GSG LDN 4 1 [ONLY CHECK FOR ZERO IF CRAETE
3H#6 BXE 4 7,XCRE
3HRQ WORKNUMB 4
3J?B BZE 5 XZ
3JR2 BXE 6 XMIN(1),XMIN2 [J IF NUMBER NEGATIVE
3K=L XZ
3KQ= BXGE 5 4,NFER [CHECK !N WITHIN RANGE
3L9W XSET
3LPG SETNCORE 10,3,FILE,FABSNB [SET UP WORKFILE FABSNB
3M96 STOZ A1+2(3) [ZEROIZE FCBNO.
3MNQ SMO FX2
3N8B LDX 0 JOBNO
3NN2 STO 0 A1+3(3) [STORE JOBNO IN FABSNB
3P7L STO 5 A1+1(3) [STORE LEVEL IN FABSNB
3PM= #SKI K6WORKFILE>599-599
3Q6W TRACE 5,LEVELNUM
3QLG LDN 0 4
3R66 STO 0 A1(3) [STORE HEADER IN FABSNB
3RKQ LDN 0 #200
3S5B ORS 0 ATYPE(3) [SET WORKFILE MARKER IN FABNSB
3SK2 LDX 0 7
3T4L ANDN 0 2 [IF A 10-SIG WORD FSBSNB IS REQUIRED
3TJ= BZE 0 NTEN [THE FCB MUST BE LOCATED BY USING THE
3W3W FINDWFL 3 [4-SIG WORD FABSNB & COPYING USER &
3WHG TESTREPN OK,NFER
3X36 MHUNT 1,FILE,FABSNB [FILE NAMES TO FABSNB
3XGQ LDN 0 10
3Y2B STO 0 A1(1)
3YG2 LDN 0 FUSER1(3)
3Y^L ADN 1 A1+1
3^F= MOVE 0 9
3^YW NTEN
42DG LDX 0 7 [J TO AVOID GOING DOWN TO NORMALUS
42Y6 ANDN 0 1 [IF ADJUNCTS BIT NOT SET
43CQ BZE 0 UPP
43XB DOWN NORMALUS,3
44C2 TESTREPN OK,UP
44WL UPP
45B= SETREP OK
45TW UP
46*G UP
46T6 SETREP NOMESS
47#Q XERR1
47SB UP
48#2 XMIN1
48RL BCHX 2 £ [STEP OVER -
49?= BCT 3 SCDB [DECREMENT COUNT TO IGNORE -
49QW BRN NERR [BRANCH TO ERROR IF '!-' ONLY
4==G XMIN2
4=Q6 SBX 4 5 [CONVERT -VE HEIGHT TO +VE DEPTH
4?9Q BNG 4 NFER [& CHECK WITHIN RANGE
4?PB LDX 5 4
4#92 BRN XSET [J TO CONTINUE
4#NL XCRE
4*8= BZE 5 XSET [MUST BE ! OR !0 FOR CREATE
4*MW ERROR ERDEPTH
4B7G BRN UP
4BM6 ZER
4C6Q LDN 5 0 [SET NUMBER ZERO
4CLB BRN XOUT
4D62 NNUM
4DKL LDN 0 8
4F5= ANDX 0 7 [ERROR UNLESS ENTRANS CAN BE
4FJW BZE 0 NERR [NON-FILESTORE
4G4G LDEX 0 ANUM(2)
4GJ6 SBN 0 1 [ERROR NLESS 1ST CHAR AFTER !
4H3Q SBX 0 3 [IS NON-NUMERIC
4HHB BZE 0 YTAP
4J32 NERR
4JGL SETREP NAMEFORM [SET ERROR REPLY
4K2= UP
4KFW NFER
4K^G LDN 0 #20 [IF 'DON'T REPORT ERROR' BIT IS
4LF6 ANDX 0 7 [SET GIVE REPLY INSTEAD
4LYQ BZE 0 RNF
4MDB SETREP NOFILE
4MY2 UP
4NCL RNF
4NX= LDN 0 #40 [IF WORKFILEMOVE CASE A DIFFERENT
4PBW ANDX 0 7 [ERROR MESSAGE MUST BE GIVE
4PWG BNZ 0 RWF
4QB6 ERROR ERNOFILE
4QTQ BRN UP
4R*B RWF ERROR ERWFMOVE
4RT2 BRN UP
4S#L NWR ERROR ERWTDESC
4SS= NFR
4T?W MFREE CPB,CUNI
4TRG NOM SETREP NOMESS
4W?6 UP
4WQQ NOJ ERROR ERWFCONT
4X=B FREECORE 3
4XQ2 BRN NFR
4Y9L XAD
4YP= MFREE FILE,FABSNB
4^8W BRN NOM
4^NG [
5286 [THIS IS THE ENTRY FROM THE ERASEWORK MACRO. IT MOVES THE FCB AND ITS
52MQ [ASSOCIATED DATA BLOCK FOR THE GIVEN WORKFILE TO THE TO-BE-ERASED RING.
537B [IF THE FILE IS CLOSED & NOT FROZEN THE THESE BLOCKS & THE BACKING
53M2 [STORE BLOCK FOR THE FILE ARE FREED,OTHERWISE THE ROUTINE EXITS.
546L ZERASEWORK
54L= STOZ AWORK1(2) [ZEROIZE ERALLWF MARKER
555W CALL 4 YFN [LOCATE FCB
55KG LDN 4 1 [SET TO-BE-ERASED PTR
5656 ORS 4 FCOMM(2)
56JQ RET
574B LDX 4 CTOPEN(2)
57J2 #SKI K6WORKFILE>599-599
583L TRACE 4,ERCTOPEN
58H= BNZ 4 TOP [J IF FILE OPEN
592W TRF
59GG LDX 4 FREEZECOUNT(2)
5=26 #SKI K6WORKFILE>599-599
5=FQ TRACE 4,ERFRCT
5=^B SMO FX1
5?F2 ANDX 4 XMSK
5?YL BNZ 4 TOP [J IF FROZEN
5#D= ... JBSS TOP,2,BFERALLWF
5*CG XER
5*X6 LDX 6 FBLMOD(2) [CALCULATE NO. OF B.S. BLOCKS TO BE
5BBQ SBN 6 FBLKS-A1 [SUBTRACTED FROM OBS COUNT
5BWB LDX 7 ALOGLEN(2) [CALCULATE NUMBER OF B.S. BLOCKS
5CB2 SBN 7 FBLKS-A1 [ALLOCATED TO FILE
5CTL BZE 7 XREM [J IF NO BLOCKS
5D*= ADN 7 2 [ADD 2 FOR FULLB LENGTH
5DSW #SKI K6WORKFILE>599-599
5F#G TRACE 3,WORKBLKS
5FS6 BZE 6 NSUB [J NO B.S. TO BE SUBTRACTED
5G?Q XDW SMO FX2
5GRB LDX 0 ATYPE
5H?2 SRL 0 12
5HQL SBN 0 CPAT
5J== BNZ 0 NCP [J NOT CPAT
5JPW SMO FX2 [IF CPAT JOBNUM IN ACTBLOCK
5K9G LDX 5 JOBNO
5KP6 BRN SUBC
5L8Q NCP
5LNB LDX 1 2
5M82 OCTCON FLOC2(1) [CALCULATE JOBNO FROM WFNAME
5MML SUBC
5N7= SUBCUBS NOTOPEN,6,5 [SUBTRACT B.S. FROM JOB'S COUNT
5NLW NSUB
5P6G BZE 7 YDW [X7=0 IF DELWORK ENTRY
5PL6 SETUPCORE 7,1,BSTB,FULLB
5Q5Q CALL 4 YFN
5QKB RCA
5R52 HUNT 1,BSTB,FULLB
5RJL LDN 5 BSPRE(2)
5S4= LDN 6 A1+1(1)
5SHW STO 7 A1(1) [COPY B.S. BLOCK LIST FROM FCB TO
5T3G SMO 7 [FULLB
5TH6 MOVE 5 511
5W2Q FREEBAX [FREE BLOCKS
5WGB MFREE BSTB,EMPTYB
5X22 CALL 4 YFN
5XFL XREM
5X^= LDX 3 2 [REMEMBER FCB PTR
5YDW WDY
5YYG SMO FX2
5^D6 LDN 4 BWORKRING
5^XQ XFR
62CB LDX 2 0(3)
62X2 BXE 2 4,XFCB [J IF END OF RING
63BL LDX 0 ATYPE(2)
63W= SBX 0 FILEPLUSFCB
64*W BZE 0 XFCB [J IF END OF ASSOCIATED DATA BLOCKS
64TG #SKI K6WORKFILE>599-599
65*6 TRACE 2,WORKFREE
65SQ FREECORE 2 [FREE ASSOCIATED DATA BLOCKS
66#B BRN XFR
66S2 XFCB
67?L FREECORE 3 [FREE FCB
67R= TOP
68=W LDX 2 FX2
68QG LDX 0 AWORK1(2) [J TO ERASE NEXT FILE IF ERWFALL
69=6 BNZ 0 REALL
69PQ OP
6=9B SETREP OK
6=P2 UP
6?8L YFN
6?N= FINDWFN ,2,1 [LOCATE FCB BY NAME
6#7W TESTREPN OK,NOF
6#MG EXIT 4 0
6*76 NOF SETREP NOFILE
6*LQ UP
6B6B YDW
6BL2 SMO FX2
6C5L LDCH 0 ATYPE
6CK= SBN 0 CPAT/64 [IF CURRENT ACTIVITY NOT A CPAT
6D4W BNZ 0 NCT1 [THEN CPAT MUST BE LOCATED SO THAT
6DJG SMO FX2 [END OF WORKFILE RING CAN BE FOUND
6F46 LDN 4 BWORKRING
6FHQ BRN NCT2
6G3B NCT1
6GH2 JOBLOCK 5,2
6H2L BNG 2 NCT3
6HG= FCAJO 2
6H^W LDN 4 BWORKRING(2)
6JFG NCT2
6J^6 TOPFCB 3
6KDQ BRN XFR
6KYB NCT3 GEOERR 1,NJBERWF
6LD2 [
6LXL [THIS IS THE ENTRY FROM THE DELETE WORK MACRO. IT DELETES FROM CORE
6MC= [THE FCB AND ASSOCIATED BLOCKS AND FREES BACKING STORE BLOCKS OF A
6MWW [CLOSED TO-BE-ERASED WORKFILE IF IT IS NOT FROZEN. OTHERWISE IT RETURNS
6NBG [TO THE CALLING ROUTINE WITHOUT FREEING THE BLOCKS.
6NW6 ZDELETEWORK
6P*Q STOZ AWORK1(2) [ZEROIZE ERALLWF MARKER
6PTB CALL 4 YFN
6Q*2 BRN TRF
6QSL [
6R#= [THIS IS THE ENTRY FROM THE DELWORK MACRO. IT IS USED BY CLOSE WHEN
6RRW [CLOSING A TO-BE-ERASED WORKFILE WHICH IS NOT OPEN OR FROZEN OR BEING
6S?G [DEALT WITH BE ERALLWF.
6SR6 ZDELWORK
6T=Q LDN 7 0 [SET NO. OF B.S. BLOCKS TO BE FREED=0
6TQB LDN 0 FILERING(2)
6W=2 BXE 0 FILERING(2),OP
6WPL LDX 6 AWORK1(2)
6X9= STOZ AWORK1(2)
6XNW TOPFCB2 2
6Y8G JBSS OP,2,BFERALLWF
6YN6 BRN XDW
6^7Q [
6^MB [THIS IS THE ENTRY FOR THE ERALLWF MACRO. ALL THE FILES IN THE CURRENT
7272 [ACTIVITY'S WORKFILE RING ARE ERASED.
72LL ZERALLWF
736= LDN 0 1 [SET ERALLWF MARKER
73KW STO 0 AWORK1(2)
745G LDN 3 BWORKRING(2) [J TO END IF WORKFILE RING EMPTY
74K6 LDX 2 BWORKRING(2)
754Q BXE 2 3,OPP
75JB SETNCORE 10,1,FILE,FABSNB
7642 REALL LDN 3 BWORKRING(2)
76HL LDX 2 BWORKRING(2)
773= BXE 2 3,OPP [J TO END IF NO MORE WORKFILES
77GW LDX 0 BIT11
782G ANDX 0 FCOMM(2)
78G6 BZE 0 RELL
78^Q ... COOR3 #41
79FB BRN REALL
79^2 RELL
7=DL LDX 0 BIT11 [SET BEING ERASED BIT
7=Y= ORS 0 FCOMM(2)
7?CW LDX 0 CTOPEN(2) [IF WORKFILE IS NOT OPEN OR FROZEN
7?XG ORX 0 FREEZECOUNT(2) [J TO EITHER DELETE ENTRIES FROM
7#C6 BZE 0 THCL [DIRECTORY OR FREE ALL BS & CORE BLKS
7#WQ SMO FX2 [OTHERWISE TEST 'DIRENT SET UP' SWITC
7*BB LDX 0 AWORK1
7*W2 ANDN 0 2
7B*L BZE 0 NSW [J TO SETUP DIRENT IS SWITCH NOT SET
7BT= SMO FX2
7C#W ERS 0 AWORK1 [UNSET SWITCH
7CSG LDX 3 FBLMOD(2)
7D#6 SBN 3 FBLKS-A1
7DRQ SUBCUBS NOTOPEN,3,JOB [DECREMENT ONLINE BS COUNT
7F?B SMO FX2
7FR2 LDX 2 BWORKRING
7G=L LDX 0 CTOPEN(2)
7GQ= BZE 0 YFR [J IF FROZEN TO FREE CORE BLOCKS
7H9W LDCT 0 #10 [OTHERWISE UNSET WORKEILE BIT IN FCB
7HPG ERS 0 FCOMM(2)
7J96 LDX 6 FREEZECOUNT(2) [SAVE FREEZECOUNT
7JNQ LDN 0 1 [SET TO-BE-ERASED MAKER
7K8B ORS 0 FCOMM(2)
7KD8 ... TRANSFCB 2,WORK,FILE[TRANSFER FCB FROM WORK FILE TO FILE CHAIN
7KN2 SMO FX2 [THEN MOVE FCB & ASSOCIATED DATA
7L7L LDN 5 BWORKRING
7LCD ... BRN RENX
7LM= RER
7M6W LDX 4 BFILE+1 [RING THE NEXT BLOCK IN WORKFILE RING
7MLG RERING 2,4 [AFTER LAST BLOCK IN FILE CHAIN
7N66 RENX
7NKQ LDX 2 BWORKRING(2) [PICK UP PTR TO NEXT BLOCK IN WKFRING
7P5B BXE 2 5,XRIN [J IF NO MORE BLOCKS
7PK2 LDX 0 ATYPE(2)
7Q4L SRL 0 12 [IF NEXT BLOCK FEXTRA, FREE IT
7QJ= SBN 0 FILE+FEXTRA [INSTEAD OF RERINGING IT.
7R3W BNZ 0 NFX
7RHG FREECORE 2
7S36 BRN RENX
7SGQ NFX
7T2B LDX 0 ATYPE(2)
7TG2 SBX 0 FILEPLUSFCB
7T^L BNZ 0 RER [IF NEXT BLOCK NOT FCB J TO RERING IT
7WF= XRIN
7WYW BACKSPACE
7XDG READBACK [READ NAME RECORD
7XY6 HUNT 1,FILE,FRB
7YCQ LDX 0 EAUTOCOUNT(1) [CHECK THAT FREEZECOUNT IN FCB &
7YXB ANDN 0 #7777 [DIRENT ARE STILL EQUAL
7^C2 SBX 0 6
7^WL BZE 0 XCS
82B= STO 6 EAUTOCOUNT(1) [IF THEY ARE NOT REWRITE THE DIRENT
82TW NAME 1,FILE,FWB [SO THAT IT CONTAINS FREEZECOUNT FROM
83*G REWRITE [FCB
83T6 MFREE FILE,FWB
84#Q BRN WRN
84SB XCS
85#2 MFREE FILE,FRB
85RL WRN
86?= CLOSESET [CLOSE DIR :WORKFILES
86QW BRN REALL [J BACK TO DEAL WITH NEXT WORKFILE
87=G YFR
87Q6 SMO FX2
889Q LDN 5 BWORKRING
88PB LDX 3 2
8992 LDX 6 FREEZECOUNT(2) [REMEMBER FREEZECOUNT FOR LATER CHECK
89NL RFR
8=8= LDX 2 0(3) [PICK UP NEXT BLOCK AFTER FCB
8=MW BXE 2 5,XFF [J IF END OF WORKRING
8?7G LDX 0 ATYPE(2)
8?M6 SBX 0 FILEPLUSFCB [J IF FCB REACHED
8#6Q BZE 0 XFF
8#LB FREECORE 2 [FREE DATA BLOCK
8*62 BRN RFR [J BACK TO DEAL WITH NEXT DATA BLOCK
8*KL XFF
8B5= FREECORE 3 [FREE FCB
8BJW BRN XRIN
8C4G NSW
8CJ6 HUNT 1,FILE,FABSNB [IF A FABSNB ALREADY EXISTS OVERWRITE
8D3Q BPZ 1 YFA [THIS WITH :SYSTEM.WORKFILE
8DHB SETNCORE 10,1,FILE,FABSNB [OTHERWISE SET UP FABSNB
8F32 YFA
8FGL LDN 0 10
8G2= STO 0 A1(1)
8GFW SMO FX1
8G^G LDN 5 WKF
8HF6 LDN 6 A1+1(1)
8HYQ MOVE 5 9
8JDB OPEN XBR,GENERAL
8JY2 TESTREPN OK,NOP
8KCL LDN 5 10
8KX= HUNT 1,FILE,FABSNB
8LBW ALTLEN 1,5,FILE,FABSNB [ALTER LENGTH OF FABSNB FOR WORKFOLE
8LWG HUNT 1,FILE,FABSNB
8MB6 STO 5 A1(1)
8MTQ ADN 1 A1+1 [OVERWRITE FABSNB WITH WORKFILE NAME
8N*B LDX 2 BWORKRING(2)
8NT2 LDN 0 FUSER1(2)
8P#L MOVE 0 9
8PS= SETNCORE 6,2,FILE,FLOCNB
8Q?W HUNT 1,FILE,FABSNB
8QRG ADN 2 A1 [SET UP A FLOCNB FOR WORKFILE, SO
8R?6 ADN 1 A1+4 [THAT DIRECTORY CAN BE POSITIONED
8RQQ MOVE 1 6 [CORRECTLY FOR NEW DIRENT
8S=B GETDIR 2
8SQ2 TESTREP NOFILE,YES
8T9L GEOERR 1,WFALRDY [ERROR IF FILE ALREADY EXISTS.
8TP= YES
8W8W MFREEW FILE,FLOCNB
8WNG GETDIRWORK 1 [SET UP DIRENT
8X86 TESTREPN OK,NOG
8XMQ HUNT 1,FILE,ENT
8Y7B LDCT 0 #40 [SET TO-BE-ERASED BIT IN DIRENT
8YM2 ORS 0 EINF2(1)
8^6L NAME 1,FILE,FWB
8^L= INSERT [INSERT NAME RECORD FOR WORKFILE
925W MFREEW FILE,FWB
92KG LDX 2 BWORKRING(2)
9356 LDX 4 FBLMOD(2)
93JQ SBN 4 FBLKS-A1 [SET NO. OF BS BLOCKS
944B ADN 4 2 [ADD 2 TO GIVE LENGTH OF BLOCKS REC
94J2 SETUPCORE 4,1,FILE,FWB [SET UP A WRITE BLOCK TO CONTAIN
953L STO 4 A1(1) [BLOCKS RECORD
95H= LDX 2 BWORKRING(2) [COPY BLOCKS INFORMATION FROM FCB
962W LDN 5 BSPRE(2)
96GG LDN 6 A1+1(1)
9726 SMO 4
97FQ MOVE 5 511
97^B INSERT [INSERT BLOCKS RECORD
98F2 MHUNTW 1,FILE,FWB
98YL FREECORE 1
99D= LDN 0 2 [SET THE 'DIRENT SET UP' MARKER
99XW ORS 0 AWORK1(2)
9=CG LDX 2 BWORKRING(2) [GET PTR TO FIRST BLOCK IN WKFRING
9=X6 BRN RELL
9?BQ THCL
9?WB SMO FX2
9#B2 LDX 0 AWORK1
9#TL ANDN 0 2 [IF 'DIRENT SET UP' MARKER IS NOT SET
9**= BZE 0 NWEN [J TO FREE B.S. & CORE BLOCKS
9*SW LDN 4 2
9B#G BACKSPACE
9BS6 XDL DELETE [DELETE RECORDS FOR DIRENT
9C?Q BCT 4 XDL
9CRB CLOSESET
9D?2 LDN 0 2
9DQL ERS 0 AWORK1(2) [UNSET 'DIRENT SETUP' BIT
9F== LDX 2 BWORKRING(2)
9FPW NWEN
9G9G HUNT 1,FILE,FABSNB [IF A FABSNB DOES NOT EXIST CREATE IT
9GP6 BPZ 1 NFAB
9H8Q SETNCORE 10,1,FILE,FABSNB
9HNB LDX 2 BWORKRING(2)
9J82 NFAB
9JML LDN 0 10
9K7= STO 0 A1(1)
9KLW LDN 5 FUSER1(2)
9L6G LDN 6 A1+1(1)
9LL6 MOVE 5 9
9M5Q BRN XER [J TO FREE BS & CORE BLOCKS
9MKB OPP
9N52 VFREE FILE,FABSNB
9NJL BRN OP
9P4= WKF 12HSYSTEM
9PHW 16H :WORKFILE
9Q3G 0,0
9QH6 NOG
9R2Q GEOERR 1,NOWKFCB
9RGB NOP
9S22 GEOERR 1,NOWKDIR
9SFL XBR
9S^= GEOERR 1,BRERALWF
9TDW [
9TYG MENDAREA GAPOPEN,K99WORKFILE
9WD6 #END
^^^^ ...31762706000300000000