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