WORKFILE860
(George Source)
Macros used: ALTLEN, BACKSPACE, BXE, BXGE, BXU, CHECKLFN, CLOSESET, COOR3, DELETE, DOWN, ERROR, FCAJO, FINDWFL, FINDWFN, FREEBAX, FREECORE, GEOERR, GETDIR, GETDIRWORK, HUNT, INSERT, JBSS, JOBLOCK, JOBLOCKC, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, OCTCON, OP, OPEN, READBACK, RERING, REWRITE, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SPARABEG, SUBCUBS, TESTREP, TOPFCB, TOPFCB2, TRACE, TRANSFCB, TRF, UP, VFREE, WORKNAME, WORKNUMB
- WORKFILE860.txt
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