FHOBJIND860
(George Source)
Macros used: ACROSS, BACKSPACE, BBUS, BC, BCONTEXT, BITDEFS, BRINDEX, BS, BWZ, BXE, BXU, CHAIN, CLEAR, CLOSETOP, CURTAIL, DOWN, FCAPCA, FINDACTX, FOUTMOVE, FRITE, GETDIR, GETJOB, GETSOUT, JBC, JBS, KEYRECI, LOCKCA, MBC, MENDAREA, MFREE, MFREEW, MHUNTW, NAME, OPENDIR, PAIR, READDICT, REWIND, REWRITE, RUNPROG, SEG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SFSTACK, SSEARCH, STEP, STEPAGAIN, STEPBACK, TESTNAMX, TESTREP2, TESTRPN2, TOPCA1, TOPFCB, TOPFCB2, UNPLUG, VFREEW, VSKIP, WHICHMOP, WIND
- FHOBJIND860.txt
22FL SEG FHOBJIND,860,FILESTORE 22^= # 23DW # THIS FILEHANDLER SEGMENT HOLDS ALL INDEXING ROUTINES AND IMPLEMENTS 23YG # SOME RARE AND/OR BULKY RECORD MODES. ALL ENTRIES AND EXITS ARE BY 24D6 # 'ACROSS' TO OR FROM THE MASTER SEGMENT FHOBJ. 24XQ # 25CB SEGENTRY K1FHOBJIND,MODE0 [SUBROUTINE TO LOCATE RECORD FOR MODE 25X2 [#0 26BL SEGENTRY K3FHOBJIND,MODE3 [SUBROUTINE TO DO CHECKS FOR MODE #3 26W= SEGENTRY K4FHOBJIND,MODE4 [SUBROUTINE TO POSITION FILE FOR MODE 27*W [#4 27TG SEGENTRY K56FHOBJIND,MODE6 [IMPLEMENTATION OF MODE #6 28*6 [WOULD BE K6 BUT THIS IS 28SQ [RESERVED FOR TRACING LEVELS 29#B SEGENTRY K7FHOBJIND,MODE7 [IMPLEMENTATION OF MODE #7 29S2 SEGENTRY K11FHOBJIND,MODE11 [IMPLEMENTATION OF MODE #11 2=?L SEGENTRY K12FHOBJIND,MODE12 [SUBROUTINE TO SET UP FRB WITH DATA 2=R= [FOR MODE #12 2?=W SEGENTRY K50FHOBJIND,M11DIRRET [LINK USED IN MODE #11 2?QG # 2#=6 # AWORK AND ACC CONVENTIONS ARE AS FOR MASTER SEGMENT FHOBJ (Q.V.) 2#PQ # 2*9B # AWORK4 BIT DEFINITIONS:- 2*P2 BITDEFS AWORK4,23,MFHEOFMULT [WE'VE RUN OFF THE END OF A 2B8L [MULTIFILE. NO FURTHER PERIS 2BN= [CAN BE IMPLEMENTED. 2C7W BITDEFS AWORK4,22,MFHDIRMOD [THIS IS A DIRECTORY MODE WE'RE 2CMG [IMPLEMENTING 2D76 BITDEFS AWORK4,21,MFHRECEOF [LAST READ PERI LEFT US 2DLQ [AFTER EOF. 2F6B BITDEFS AWORK4,20,MFHBLOCKEOF [SIMILAR BIT FOR BLOCK PERIS. 2FL2 [HAS TO BE HANDLED SEPARATELY 2G5L [OWING TO DIFFERENT POINTER 2GK= [CONVENTIONS. 2H4W BITDEFS AWORK4,19,MFHNOT1ST [THIS IS NOT THE 1ST PERI. 2HJG BITDEFS AWORK4,18,MFHDIROWN [USER OWNS THE FILES IN 2J46 [THIS DIRECTORY 2JHQ BITDEFS AWORK4,17,MFHNONSER [THIS IS A DA,DR, OR MT FILE 2K3B BITDEFS AWORK4,16,MFHCHUCKOFF [WE ARE THROWING THIS FILE 2KH2 [OFFLINE (SET DURING MODE #33). 2L2L BITDEFS AWORK4,15,MFHTRAPSALT [WE ARE ALTERING THIS FILE'S 2LG= [TRAPS (SET DURING MODE #33). 2L^W BITDEFS AWORK4,14,MFHTABSSET [THE TAB SYSTEM HAS BEEN 2MFG [INITIALISED. 2M^6 # 2NDQ # 2NYB # SUBROUTINE TO MOVE BUFFER OUT OF PROGRAM TO A FILE/FWB . 2PD2 # A SUITABLE RECORD HEADER WILL BE ADDED TO THE FWB. 2PXL # CALLED ON X6, COORDINATES, LEAVES X3->FWB. 2QC= # 2QWW SETUPFWB 2RBG SBX 6 FX1 [RELATIVISE LINK 2RW6 LDX 4 ACA3(2) [SIZE OF DATA BUFFER 2S*Q ADN 4 1 [PLUS 1 FOR RECORD HEADER 2STB SETUPCORE 4,3,FILE,FWB [X3->FWB 2T*2 STO 4 A1(3) [STORE RECORD HEADER 2TSL LDX 4 AWORK2(2) [ADDR WITHIN PROGRAM 2W#= LDN 5 A1+1(3) [X5->DESTINATION. 2WRW FOUTMOVE APETADDR(2),4,5,ACA3(2),HLOCK2,2 [DO MOVE 2X?G ADX 6 FX1 2XR6 EXIT 6 0 [AND EXIT 2Y=Q # 2YQB # ******************* 2^=2 # 2^PL # SUBROUTINE TO DO AN INDEXED SEARCH USING A RECORD SUPPLIED. 329= # CALLED ON X6 WITH X3->RECORD IN FWB. IF A MODE #4 IS BEING IMPLEMENTE 32NW # SUBKEYS ARE TAKEN INTO ACCOUNT OTHERWISE THEY ARE IGNORED. 338G # IF A REPLY 'OK' IS GIVEN EXIT +1 OCCURS, OTHERWISE EXIT 0 IS 33N6 # TAKEN 347Q # 34MB POSITION 3572 SBX 6 FX1 [RELATIVISE LINK 35LL BC 2,MFHRECEOF [CLEAR EOF CONDITION SINCE 366= [WE ARE GOING TO REPOSTION THE 36KW [FILE. IF WE LEAVE IT AFTER EOF 375G [WE WILL RESET THE SWITCH. 37K6 TOPFCB2 2 [BRANCH TO INDIVIDUAL CODE 384Q BRINDEX FINFC(2),(GEOERR),MGETDIR,READDICT,SSEARCH,(GEOERR),MGET- 38JB SOUT,MGETSYS,MGETJOB 3942 # 39HL # ********** 3=3= # 3=GW # THE DIRECTORY CASE. WE SET UP A FILE/FLOCNB AND DO A GETDIR. WE NEVER 3?2G # BOTHER ABOUT SUBKEYS AS A MODE #4 IS NOT ALLOWED WITH DIRECTORIES. 3?G6 # 3?^Q MGETDIR 3#FB SETNCORE 6,2,FILE,FLOCNB [X2->FLOCNB 3#^2 STOZ A1+3(2) [CLEAR SUBKEYS 3*DL STOZ A1+4(2) 3*Y= STOZ A1+5(2) 3BCW MHUNTW 3,FILE,FWB 3BXG LDN 4 ELOC1(3) [TRANSFER LOCAL NAME 3CC6 LDN 5 A1(2) 3CWQ MOVE 4 3 3DBB BS 2,BFABANY [SHOW ANY ENTRANT ACCEPTABLE 3DW2 GETDIR 6 [DO A GETDIR 3F*L VFREEW FILE,ENT 3FT= MFREE FILE,FLOCNB 3G#W BRN POSITIONED [J TO END OF S/R 3GSG # 3H#6 # ********** 3HRQ # 3J?B # THE DICTIONARY CASE. WE SIMPLY DO A READDICT, UNLESS THE KEY IS ZERO 3JR2 # (A CIRCUMSTANCE WHICH BREAKS READDICT) IN WHICH CASE WE DO A REWIND 3K=L # AND STEP TO READ THE LIST ENTRY (1ST RECORD). 3KQ= # 3L9W READDICT 3LPG BWZ CUSER(3),READ1STREC [J IF ZERO KEY 3M96 READDICT ,CUSER(3),NOADICT [LOCATE RECORD 3MNQ BRN POSITIONED [J TO ANALYSE REPLY 3N8B READ1STREC 3NN2 REWIND 3P7L STEP 3PM= BRN POSITOK [NO NEED TO ANALYSE REPLY 3Q6W # 3QLG # ********** 3R66 # 3RKQ # THE :SYSTEM.SERIAL CASE. WE USE SSEARCH. 3S5B # 3SK2 SSEARCH 3T4L LDX 0 A1+1(3) [PICK UP TSN 3TJ= SSEARCH NOTFOUND,0 [J TO NOTFOUND IF NOT FOUND 3W3W BRN POSITOK [NO NEED TO ANALYSE REPLY 3WHG # 3X36 # ********** 3XGQ # 3Y2B # THE :SYSTEM.OUTPUT CASE. WE DO A GETSOUT. IF THE MODE IS NOT #4 WE 3YG2 # ZEROISE THE SUBKEY FIRST. 3Y^L # 3^F= MGETSOUT 3^YW LDX 2 FX2 42DG LDCT 0 #020 [BIT 4 42Y6 ANDX 0 AWORK1(2) 43CQ BNZ 0 YESM4 [J IF MODE #4 43XB STOZ GOUTKEY2(3) [CLEAR SUBKEY 44C2 YESM4 44WL GETSOUT ,GOUTKEY1(3),GOUTKEY2(3) 45B= BRN POSITIONED [J TO ANALYSE REPLY 45TW # 46*G # ********** 46T6 # 47#Q # THE :SYSTEM.JOBLIST CASE. WE DO A GETJOB WITH THE 'SYSTEM' PARAMETER 47SB # 48#2 MGETSYS 48RL GETJOB JLJOBNO+A1(3),SYSTEM 49?= BRN POSITIONED [J TO ANALYSE REPLY 49QW # 4==G # ********** 4=Q6 # 4?9Q # THE USER JOBLIST CASE. THIS TIME THE GETJOB HAS THE 'USER' PARAMETER. 4?PB # 4#92 MGETJOB 4#NL LDN 2 JLJOBNAME+A1(3) [X2->KEY 4*8= GETJOB 2,USER 4*MW # 4B7G # ********** 4BM6 # 4C6Q # THE VARIOUS PATHS NOW MERGE. IF THE REPLY IS OK WE JUST EXIT 6 1. 4CLB # OTHERWISE WE DO A STEPAGAIN AND IF THE REPLY REVEALS WE ARE 4D62 # POSITIONED AFTER EOF WE SET THE 'HAVING JUST READ EOF' SWITCH. 4DKL # WE THEN EXIT 6 0 4F5= # 4FJW POSITIONED 4G4G TESTREPN OK,NOTFOUND [J IF NONOK REPLY 4GJ6 POSITOK 4H3Q LDX 2 FX2 [CORRUPTED IN MOST PATHS 4HHB ADX 6 FX1 [DE RELATIVISE LINK 4J32 EXIT 6 1 [AND EXIT 4JGL NOTFOUND 4K2= STEPAGAIN 4KFW BNZ 3 NOTEOFEXIT [J UNLESS END OF FILE 4K^G BS 2,MFHRECEOF 4LF6 NOTEOFEXIT 4LYQ ADX 6 FX1 4MDB EXIT 6 0 4MY2 # 4NCL # ********************************************************************* 4NX= # 4PBW # THIS SECTION IS A SUBROUTINE CALLED BY MODE #0 TO LOCATE A RECORD. 4PWG # IT RETURNS TO K3FHOBJ IN THE OK CASE AND K4FHOBJ OTHERWISE. 4QB6 # 4QTQ # WE SET UP A FWB AND CALL POSITION TO DO THE SEARCH. WHATEVER THE 4R*B # RESULT WE FREE THE FWB AND EXIT ACROSS TO THE RELEVANT ENTRY POINT 4RT2 # IN FHOBJ. 4S#L # 4SS= MODE0 4T?W CALL 6 SETUPFWB [SET UP FWB WITH DATA AREA 4TRG CALL 6 POSITION [POSITION FILE 4W?6 BRN M30NOTFOUND [NON-OK EXIT 4WQQ MFREEW FILE,FWB [FREE FWB 4X=B ACROSS FHOBJ,3 [OK RETURN 4XQ2 4Y9L M30NOTFOUND 4YP= MFREEW FILE,FWB 4^8W ACROSS FHOBJ,4 4^NG # 5286 # ******************************************************************** 52MQ # 537B # THIS SECTION CARRIES OUT THE INDEXED FILE CHECKS FOR A MODE #3. ON 53M2 # ENTRY THERE EXISTS A FILE/FWB CONTAINING THE NEW RECORD AND X6 546L # CONTAINS THE INDEX NUMBER. 54L= # THE CHECK APPLIED IS THAT THE USER IS NOT ATTEMPTING TO ALTER THE 555W # KEY OR SUBKEYS OF THE RECORD IN ANY WAY. 55KG # WE USE THE INDEX NUMBER TO SWITCH TO A RELEVANT PIECE OF CODE. 5656 # 56JQ MODE3 574B STEPAGAIN [X3->OLD RECORD 57J2 MHUNTW 2,FILE,FWB [X2->NEW RECORD 583L BRINDEX 6,(GEOERR),M3DIR,M3DICT,M3SER,M3INC,M3OUT,M3SYSJOB,M3USE- 58H= JOB 592W # 59GG # ********** 5=26 # 5=FQ # IN THE DICTIONARY CASE WE ENSURE THE USERNAME OF THE DIR HAS NOT 5=^B # CHANGED. 5?F2 # 5?YL M3DICT 5#D= TESTNAMX 3,CUSER(2),CUSER-A1(3),NILDATA,4 [ILLEGAL IF HAS CHANGED 5#XW BRN M3OK 5*CG # 5*X6 # ********** 5BBQ # 5BWB # :SYSTEM.SERIAL REQUIRES A SIMPLE COMPARISION OF TSNS. 5CB2 # 5CTL M3SER 5D*= LDX 0 A1+1(2) 5DSW BXU 0 FRH+1(3),NILDATA [ILLEGAL IF TSNS CHANGED 5F#G BRN M3OK 5FS6 # 5G?Q # ********** 5GRB # 5H?2 # :SYSTEM.OUTPUT REQUIRES THAT BOTH OF WORDS GOUTKEY1 AND GOUTKEY2 5HQL # BE UNCHANGED , UNLESS WORD GOUTYPE IS NOT #40000000 WHICH IMPLIES 5J== # THAT THIS IS NOT A KEYED RECORD. HOWEVER IN THIS CASE NEITHER RECORD 5JPW # MAY BE KEYED. 5K9G # 5KP6 M3OUT 5L8Q LDX 0 GOUTYPE(2) 5LNB BXU 0 GSIGN,M3OUTNOKEY [J IF NEW REC UNKEYED 5LTJ ... LDX 0 GOUTYPE-A1(3) 5M2Q ... BXU 0 GSIGN,NILDATA 5M82 LDX 0 GOUTKEY1(2) 5MML BXU 0 GOUTKEY1-A1(3),NILDATA 5N7= LDX 0 GOUTKEY2(2) 5NLW BXU 0 GOUTKEY2-A1(3),NILDATA 5P6G BRN M3OK 5PL6 M3OUTNOKEY 5Q5Q LDX 0 GOUTYPE-A1(3) [ILLEGAL IF OLD REC KEYED 5QKB BXE 0 GSIGN,NILDATA [AND NEW REC UNKEYED 5R52 BRN M3OK 5RJL # 5S4= # ********** 5SHW # 5T3G # IN THE :SYSTEM.JOBLIST CASE WE ENSURE THAT THE JOB NUMBER REMAINS 5TH6 # UNCHANGED. A NEGATIVE JOB NUMBER IS TREATED AS ZERO (B0 OF THE JOB 5W2Q # NUMBER IS SET FOR THE TEMPLATE RECORD AT THE START OF :SYSTEM.JOBLIST 5WGB # 5X22 M3SYSJOB 5XFL LDX 0 JLJOBNO+A1(2) 5X^= BPZ 0 NNGJNO 5YDW LDN 0 0 5YYG NNGJNO 5^D6 LDX 4 JLJOBNO(3) 5^XQ BPZ 4 NNGJNO2 62CB LDN 4 0 62X2 NNGJNO2 63BL BXU 0 4,NILDATA 63W= BRN M3OK 64*W # 64TG # ********** 65*6 # 65SQ # IN THE :USER.JOBLIST(/****) CASE THE KEY IS THE 3 WDS STARTING AT 66#B # JLJOBNAME. 66S2 # 67?L M3USEJOB 67R= LDX 0 JLJOBNAME+A1(2) 68=W BXU 0 JLJOBNAME(3),NILDATA 68QG LDX 0 JLJOBNAME+A1+1(2) 69=6 BXU 0 JLJOBNAME+1(3),NILDATA 69PQ LDX 0 JLJOBNAME+A1+2(2) 6=9B BXU 0 JLJOBNAME+2(3),NILDATA 6=P2 # 6?8L # ********** 6?N= # 6#7W # THE KEYS ARE UNCHANGED. 6#MG # 6*76 M3DIR [NEITHER DIRS NOR INCINDEX ARE EXPECT 6*LQ M3INC 6B6B M3OK 6BL2 ACROSS FHOBJ,5 [RETURN TO FHOBJ 6C5L # 6CK= # ******************************************************************** 6D4W # 6DJG # THIS SECTION IS OBEYED BY MODE #4 TO POSITION AN INDEXED FILE READY 6F46 # FOR THE INSERTION OF A RECORD. 6FHQ # ON ENTRY A FILE/FWB EXISTS WITH THE RECORD IN IT AND X6=INDEX NUMBER. 6G3B # WE INVOKE KEYRECI TO TELL US IF THE RECORD IS KEYED AND IF IT IS WE 6GH2 # CALL POSITION TO POSITION THE FILE. RETURN IS ACROSS TO FHOBJ 56 IF 6H2L # THE RECORD IS KEYED AND ACROSS TO FHOBJ 7 IF IT ISNT. 6HG= # 6H^W MODE4 6JFG MHUNTW 3,FILE,FWB [ 6J^6 LDN 2 A1(3) [X2->1ST WD OF RECORD 6KDQ KEYRECI 6,,2,NOKEY,1 [J TO NOKEY IF NO KEY 6KYB LDX 2 FX2 6LD2 LDX 1 FX1 6LXL CALL 6 POSITION [POSITION FILE 6MC= NULL [REPLY IRRELEVANT 6MGB ... LDCT 7 #100 [SET BIT IN REPLY TO SHOW THIS IS 6MKG ... [AN INDEXED FILE AND A KEYED RECORD 6MNL ... [AND THAT THE FILE HAS THEREFORE BEEN 6MRQ ... [REPOSITIONED DURING THE PERI. 6MWW ACROSS FHOBJ,56 6NBG NOKEY 6NW6 ACROSS FHOBJ,7 6P*Q # 6PTB # ******************************************************************** 6Q*2 # 6QSL # THIS SECTION IMPLEMENTS MODE #6. IT IS IN THIS SEGMENT BECAUSE IT IS 6R#= # VERY RARE AND INVOKES A HUGE MACRO. 6R#T ...# THIS MODE SHOULD CONSIST SIMPLY OF A 'CURTAIL'. HOWEVER 6R*D ...# CURTAIL HAS TWO SERIOUS DEFICIENCIES AND UNTIL THESE ARE CORRECTED 6RB3 ...# 'TEMPORARY' FRIGS HERE ARE NECESSARY. 6RBL ...# 6RC9 ...# 1)CURTAIL DOES NOT WRITE AWAY ANY USAGE BLOCKS FOR THE AREA WHICH 6RCS ...# HAS BEEN TRUNCATED OUT OF EXISTENCE. THUS IF RECORDS ARE APPENDED 6RDC ...# AND TRUNCATED AWAY WITHOUT BEING READ A FILE/FUWB MAY BE LEFT IN THE 6RF2 ...# FILE CHAIN WHICH DOES NOT BELONG WITHIN THE FILE. THIS WILL BREAK 6RFK ...# CLOSE AND ANYONE ELSE WHO TRIES TO WRITE IT AWAY. 6RG8 ...# THE TEMPORARY SOLUTION IS FOR FILEHANDLER TO ISSUE A FRITE MACRO. 6RGR ...# THIS WRITES AWAY ALL USAGE WRITE BLOCKS. THE FRITE HAS TO BE 6RHB ...# NONAUTONOMOUS SINCE IF A WRITE FAIL OCCURS AFTER THE FILE HAS 6RH^ ...# BEEN TRUNCATED READFAIL WILL BREAK BECAUSE THE FILE DOES NOT 6RJJ ...# CONTAIN THE BLOCK. 6RK7 ...# 6RKQ ...# 2)CURTAIL DOES NOT PUT A ZERO WORD ON THE END OF THE NEW 'LAST 6RL* ...# BLOCK'. THE FILEHANDLER DOES A DUMMY STEP(APPEND) AND THIS DOES IT. 6RLY ...# THIS IS NASTY SINCE IF THE USER DOES NOT APPEND ANYTHING TO THE FILE 6RMH ...# THE DUMMY RECORD WILL BE LEFT, WHICH MAY CONFUSE USERS AND HAS 6RN6 ...# BEEN KNOWN TO BREAK ROUTINES WHICH DIDNT EXPECT IT. 6RNP ...# 6RP# ...# THE MAIN OBSTACLE TO A REWRITE OF CURTAIL IS THAT THE EDITOR USES 6RPX ...# IT IN A RIDICULOUS AND EXTREMELY INEFFICIENT FASHION. WE CANNOT 6RQG ...# REWRITE IT UNTIL THIS IS CHANGED, I.E. NEVER. 6RR5 ...# 6RRW # 6S?G MODE6 6SH# ... FRITE ,NONAUT 6SR6 CURTAIL [TRUNCATE FILE 6T=Q STEP ,1,ANSWER [THIS IS NEEDED TO PUT THE ZERO 6TQB [AT END OF FILE 6W28 ... STOZ 0(3) 6W=2 BRN SETREP [J TO WINDUP CODE 6WPL # 6X9= # ********************************************************************* 6XNW # 6Y8G # THIS SECTION HANDLES MODE #7. FIRST WE VALIDATE THE COUNT/SUBMODE WOR 6YN6 # AND JUMP TO THE INDIVIDUAL IMPLEMENTATION CODE. 6^7Q # 6^MB MODE7 7272 LDX 0 ACA3(2) [PICK UP COUNT/SUBMODES 72LL SLL 0 1 736= BNG 0 WINDREWIND [J IF WIND/REWIND 73KW BZE 0 NILCOUNT [REMAINING MODES EXPECT COUNT 0<X<409 745G SRL 0 13 74K6 BNZ 0 NILCOUNT [J IF COUNT > 4095 754Q LDXC 3 ACA3(2) [PICK OUT COUNT AND SET C IF BACKSPAC 75JB BCS M7BSP [J IF BACKSPACE 7642 BRN M7SKIP [OTHERWISE SKIP 76HL WINDREWIND 773= SLL 0 1 77GW BNZ 0 NILCOUNT [ILLEGAL TO HAVE NONZERO COUNT FOR 782G [WIND OR REWIND 78G6 MBC 2,MFHRECEOF,MFHBLOCKEOF [BOTH MODES CLEAR EOF CONDITIONS 78^Q LDX 0 ACA3(2) 79FB BPZ 0 M7WIND [J IF IT'S WIND 79^2 # 7=DL # ********** 7=Y= # 7?CW # 'REWIND'. THIS IS TRIVIAL. 7?XG # 7#C6 REWIND 7#WQ BRN SETREP [J TO WINDUP CODE 7*BB # 7*W2 # ********** 7B*L # 7BT= # 'WIND' IS JUST AS TRIVIAL. 7C#W # 7CSG M7WIND 7D#6 WIND 7DRQ BRN SETREP [J TO WINDUP CODE 7F?B # 7FR2 # *********** 7G=L # 7GQ= # 'BACKSPACE'. THIS CLEARS THE RECORD END OF FILE CONDITION. THE BLOCK 7H9W # END OF FILE CONDITION REMAINS SET TILL THE NEXT MODE #22 AS WE CANNOT 7HPG # EASILY TELL HERE WHETHER THE CONDITION HAS BEEN CLEARED OWING TO A 7J96 # DIFFERENCE BETWEEN THE RECORD AND BLOCK POINTER CONVENTIONS. MODE #22 7JNQ # VERIFIES THAT THE CONDITION HAS NOT BEEN CLEARED BEFORE ACTING ON IT 7K8B # ANYWAY. 7KN2 # THE BACKSPACE IS ACCOMPLISHED VIA A SPECIAL ENTRY TO PERUSFIL. 7L7L # 7LM= M7BSP 7M6W BC 2,MFHRECEOF [CLEAR ONE END OF FILE CONDITION 7MLG STO 3 ACOMMUNE8(2) [PUT COUNT IN ACOMMUNE8 7N66 DOWN PERUSFIL,84 [DO BACKSPACE 7NKQ TESTREP2 BEGFILE,M7BEGFILE [JUMP TO EXCEPTION CODE IF BEGFILE 7P5B [FOUND. 7PK2 BRN SETREP [J TO WINDUP CODE 7Q4L # 7QJ= # ********** 7R3W # 7RHG # 'SKIP'. IF WE ARE IN AN END OF FILE CONDITION WE PROCEED DIRECT TO 7S36 # THE EXCEPTION CODE SINCE ACCORDING TO THE WRITEUP 'VSKIP' MAY GEOERR. 7SGQ # OTHERWISE WE CALL VSKIP TO DO THE SKIP. 7T2B # 7TG2 M7SKIP 7T^L JBS M7EOF,2,MFHRECEOF [J IF ALREADY AT EOF 7WF= VSKIP 0,0(3) [DO SKIP 7WKG ... TESTREP2 ENDFILE,M7EOF [JUMP TO EXCEPTION CODE IF HIT EOF 7WPQ ... [WITH AN UNEXPIRED SKIP COUNT. 7WW2 ... BNZ 3 SETREP [J TO WIND UP CODE UNLESS WE 7X2= ... [HIT END OF FILE EXACTLY (WITHOUT 7X6G ... [AN UNEXPIRED SKIP COUNT). 7X=Q ... BS 2,MFHRECEOF [SET 'RECORD EOF' MARKER. 7XC2 ... CALL 6 MCHOWN [SET OWN MONITORING EVENT BITS IF 7XH= ... [OWNMON IN USE (SEE 'MCHOWN' DEFN 7XMG ... [BELOW). 7XRQ ... BRN SETREP [J TO WINDUP CODE. 7XY6 # 7YCQ # ********** 7YXB # 7^C2 # 7^WL # MODE #11. THIS IS ONLY ALLOWED FOR DA,DR, AND MT FILES. THE DATA 82B= # AREA IS 7 WORDS LONG AND IS TO BE USED TO UPDATE REDTAPE IN THE FCB 82TW # AND THE DIRECTORY ENTRY. 83*G # 83T6 # FIRST WE CHECK THAT THE COUNT IS 7 WORDS, MOVE THE DATA OUT INTO A 84#Q # FILE/FWB, AND ENSURE THAT THE FIRST DATA WORD IS THE SAME AS THE 84SB # TYPE/MODE OF THE FILE. 85#2 # 85RL MODE11 86?= LDX 0 ACA3(2) 86QW SBN 0 7 87=G BNZ 0 NILCOUNT [ILLEGAL IF COUNT OUT OF RANGE 87Q6 CALL 6 SETUPFWB [MOVE BUFFER OUT 889Q TOPFCB2 2 88PB LDX 0 A1+1(3) [PICK UP T/M FROM BUFFER 8992 BXU 0 FETM(2),NILDATA [ILLEGAL IF NOT T/M OF FILE 89NL LDX 2 FX2 8=8= # 8=MW # ********** 8?7G # 8?M6 # IF ANY OF THE FOLLOWING FIELDS ARE NONZERO IN THE BUFFER WE ARE 8#6Q # GOING TO HAVE TO UPDATE THE DIRECTORY AS WELL AS THE FCB OTHERWISE WE 8#LB # CAN GET BY WITH JUST UPDATING THE FCB. 8*62 # 8*KL # MS 2 BITS OF SECOND DATA WORD, 3RD, 4TH, 5TH DATA WORDS. 8B5= # 8BJW LDCT 0 #600 8C4G ANDX 0 A1+2(3) [PICK MS2 BITS OF 2ND WORD OF DATA 8CJ6 ORX 0 A1+3(3) [OR IN REST OF DIR ONLY DATA WDS 8D3Q ORX 0 A1+4(3) 8DHB ORX 0 A1+5(3) 8F32 BZE 0 M11NODIRUPD [J IF NO DIR UPDATE NEEDED 8FGL # 8G2= # ********** 8GFW # 8G^G # WE ARE GOING TO HAVE TO UPDATE THE DIRECTORY. SINCE ANY OPEN CAN 8HF6 # TAKE A LONG TIME THE PROGRAM MUST BE SWAPPABLE FOR THE DURATION. 8HYQ # SO, WE ADOPT THE FOLLOWING TORTUOUS APPROACH:- 8JDB # 1) SET UP A FABSNB FOR THE FILE AND CLEAR ALL OBJECT PROGRAM LOCKS. 8JY2 # 2) TRANSFER TO THE PCA AND UNPLUG THE PROGRAM. 8KCL # 3) TRANSFER TO THE CPA , LOCATE THE OLPA AND PICK UP THE FABSNB AND 8KX= # THE FWB. 8LBW # 4) DO AN OPENDIR, FREE THE FABSNB, UPDATE THE DIRENT, CLOSE THE DIR, 8LWG # REFIND THE OLPA AND GIVE IT BACK THE FWB. 8MB6 # 5) STEP BACK THE PROGRAM COUNTER AND RESTART THE PROGRAM. THIS WILL 8MTQ # MAKE THE PROGRAM REPEAT THE PERI, AND THE OLPA WILL BE WOKEN UP 8N*B # AND WILL CONTINUE OBEYING THIS CHAPTER AT THE LINK WE SET IN IT 8NT2 # BEFORE TRANSFERRNG TO THE PCA. 8P#L # 6) ON REACTIVATION THE OLPA WILL RELOCK THE CONTROL AREA FOR THE REPL 8PS= # 8Q?W # FIRST WE SET UP THE FABSNB AND CLEAR THE LOCKS. 8QRG # 8R?6 SETNCORE 10,3,FILE,FABSNB [SET UP A FABSNB 8RQQ LDN 0 10 [RECORD HEADER 8S=B STO 0 A1(3) 8SQ2 TOPFCB2 1 [X1->FCB 8T9L LDN 4 FUSE1(1) [X4->START OF NAME 8TP= LDN 5 A1+1(3) [X5->DESTINATION 8W8W MOVE 4 9 [MOVE NAME IN 8WNG CLEAR APETADDR(2),0 [CLEAR ALL LOCKED DOWN MARKERS 8X86 LDX 1 FX1 8XMQ # 8Y7B # ********** 8YM2 # 8^6L # NEXT WE PICK UP THE ACTIVITY NUMBER OF THE OLPA SO WE CAN REFIND 8^L= # IT, TRANSFER TO THE PCA AND UNPLUG THE PROGRAM, MAKING IT SWAPPABLE. 925W # 92KG LDX 4 ACTNUM(2) [X4=OLPA ACTNUM 9356 TOPCA1 M11RETLINK(1) [CHANGE TO PCA SETTING UP LINK IN OLP 93JQ UNPLUG 944B # 94J2 # ********** 953L # 95H= # NOW TO THE CPA. ONCE THERE WE REFIND THE OLPA AND STEAL THE FIRST 962W # TWO BLOCKS IN ITS CHAIN, WHICH WILL BE THE FABSNB AND THE FWB. 96GG # 9726 FCAPCA 3,2 [X3->CPA 97FQ CHANGEAC 3 [CHANGE TO IT 97^B FINDACTX 3,4 [X3->OLPA 98F2 CHAIN FPTR(3),2 [RECHAIN 1ST 2 BLOCKS 98YL CHAIN FPTR(3),2 99D= # 99XW # ********** 9=CG # 9=X6 # HERE WE ARE IN THE CPA WITH THE FWB AND THE FABSNB. WE OPEN THE DIR 9?BQ # SPECIFYING 'ERASING' SUBMODE, AND GEOERRING IF A NON-OK REPLY IS 9?WB # GIVEN. 9#B2 # 9#TL OPENDIR (GEOERR),GENERAL,ERASING 9**= TESTRPN2 OK,(GEOERR) 9*SW # 9B#G # ********** 9BS6 # 9C?Q # WE NOW UPDATE THE FILE/ENT FROM THE FWB, NAME IT A FWB, REPOSITION 9CRB # THE DIRECTORY, AND REWRITE IT. 9D?2 # WE THEN FREE THE RENAMED ENT AND THE FABSNB. 9DQL # 9F== MHUNTW 3,FILE,ENT 9FPW MHUNTW 2,FILE,FWB 9G9G LDX 0 A1+1(2) [TRANSFER TM AND OTHER DATA 9GP6 STO 0 ETM(3) 9H8Q LDX 0 A1+2(2) 9HNB STO 0 EINF3(3) 9J82 LDX 0 A1+3(2) 9JML STO 0 EFLOW(3) 9K7= LDX 0 A1+4(2) 9KLW STO 0 EORG(3) 9L6G LDX 0 A1+5(2) 9LL6 STO 0 EKEY(3) 9M5Q LDX 0 A1+6(2) 9MKB STO 0 EENDBUCK(3) 9N52 LDX 0 A1+7(2) 9NJL STO 0 EVERSION(3) 9P4= NAME 3,FILE,FWB [RENAME THE ENT FOR REWRITING 9PHW BBUS 23,ECOPS(3),NOBLOCK [J IF NO BLOCKS REC TO BACKSPACE OVER 9Q3G BACKSPACE [BACKSPACE OVER BLOCKS REC 9QH6 NOBLOCK 9R2Q REWRITE [REWRITE NAME REC 9RGB MFREEW FILE,FWB [FREE ENT 9S22 MFREEW FILE,FABSNB 9SFL # 9S^= # ********** 9TDW # 9TYG # NOW WE CLOSE THE DIRECTORY, REFIND THE OLPA AND GIVE IT BACK ITS FWB. 9WD6 # 9WXQ CLOSETOP [CLOSE DIRECTORY 9XCB FINDACTX 2,4 [X2->OLPA 9XX2 MHUNTW 3,FILE,FWB [X3->FWB 9YBL CHAIN 3,2 [GIVE FWB TO OLPA 9YW= # 9^*W # ********** 9^TG # =2*6 # WE CANNOT JUST CHANGE BACK TO THE OLPA AS WE HAVE UNPLUGGED THE PROGR =2SQ # AND MUCKED UP THE CPA'S LINK. WE GET ROUND THE PROBLEM BY STEPPING =3#B # BACK THE PROGRAM COUNTER , RESTARTING THE PROGRAM SO THAT THE OLPA =3S2 # WILL IMMEDIATELY BE WOKEN BY THE REPEATED PERI. WE DUMPED THE LINK TO =4?L # THE CONTINUATION WHEN WE TRANSFERRED OUT OF THE OLPA. =4R= # =5=W STEPBACK [STEP BACK PROG COUNTER =5QG RUNPROG [RESTART PROGRAM =6=6 # =6PQ # =79B # ********** =7P2 # =88L # WE HAVE JUST REURNED FROM REWRITING THE DIRECTORY ENTRY IN THE CPAT. =8N= # WE RELOCK THE CONTROL AREA SINCE THIS HAS BEEN UNLOCKED . =97W # =9MG M11RETLINK ==76 PAIR FHOBJIND,50 [RETURN LINK (BRNS TO M11DIRRET) ==LQ M11DIRRET =?6B LDX 3 APETADDR(2) [X3->PCA =?L2 LOCKCA 3,ACAP(2) [LOCK CONTROL AREA =#5L MHUNTW 3,FILE,FWB [REFIND FWB =#K= # =*4W # ********** =*JG # =B46 # NOW WE UPDATE THE FCB. THE PATH WHICH SKIPPED THE DIRECTORY UPDATE =BHQ # REJOINS HERE. =C3B # =CH2 M11NODIRUPD =D2L TOPFCB2 2 [X2->FCB =DG= LDX 0 A1+1(3) =D^W STO 0 FETM(2) =FFG LDX 0 A1+2(3) =F^6 DEX 0 FSIZE(2) =GDQ LDX 0 A1+6(3) =GYB STO 0 FENDBUCK(2) =HD2 LDX 0 A1+7(3) =HXL STO 0 FVERSION(2) =JC= LDX 2 FX2 =JWW # =KBG # ********** =KW6 # =L*Q # FINALLY WE FREE THE FWB AND RETURN TO SET A ZERO REPLY. =LTB # =M*2 MFREEW FILE,FWB =MSL BRN SETREP [J TO WINDUP CODE =N#= # =NRW # ********************************************************************* =P?G # =PR6 # MODE #12. THIS SECTION SETS UP A FILE/FRB WITH A RECORD CONTAINING =Q=Q # TYPE/MODE DATA ETC FOR THE FILE. ON RETURN TO FHOBJ THIS RECORD WILL =QQB # BE USED IN THE NORMAL READ MODE CODE AND THE DATA TRANSFERRED TO =R=2 # THE PROGRAM. =RPL # IF THE FILE IS SERIAL WE HAVE ONLY ONE WORD OF DATA SO THE FRB IS =S9= # 2 WORDS LONG. OTHERWISE WE HAVE 7 WORDS OF DATA AND NEED AN 8 WORD =SNW # FRB. =T8G # =TN6 MODE12 =W7Q LDN 4 2 [SIZE OF FRB FOR SERIAL CASE =WMB JBC M12SER,2,MFHNONSER [J UNLESS NONSERIAL FILE =X72 LDN 4 8 [SIZE FOR NON SERIAL FILE =XLL M12SER =Y6= SETUPCORE 4,3,FILE,FRB [SET UP FRB =YKW STO 4 A1(3) [INITIALISE RECORD HEADER =^5G # =^K6 # ********** ?24Q # ?2JB # IF THIS IS THE SERIAL CASE WE PICK UP THE TYPE/MODE AND STORE IT IN ?342 # THE FRB. THIS IS OBTAINED FROM WORD FSCTM OF THE OLPA IN THE NORMAL ?3HL # CASE. FOR AN ONLINED FILEHANDLER WE GET IT FROM THE JDF FCB (BACKGROU ?43= # CASE) OR ASSUME IT TO BE GRAPHIC (MOP CASE). ?4GW # ?52G JBS M12NONSER,2,MFHNONSER [J IF NONSERIAL CASE ?5G6 WHICHMOP M12NORMAL [J IF NOT OL *FH ?5^Q FCAPCA 1,APETADDR(2) [X1->CPA ?6FB BCONTEXT M12ONLINE,1,MOP [J IF MOP OL CASE ?6^2 NGN 4 2 [DEPTH OF JDF FCB IN CPA FILERING ?7DL SFSTACK 4,2,1,1 [X1->FSTACK OF JDF ?7Y= LDX 2 FX2 [X2 CORRUPTED BY MACRO ?8CW LDX 1 BPTR(1) [X1->FCB OF FILE ?8XG LDX 4 FETM(1) [TYPE MODE ?8^D ... ?93B ...SETB1 ?95# ... SEGENTRY K80FHOBJIND ?97= ... BRN K81FHOBJIND [NULL IF FHONLINE ON ?998 ... LDCT 1 #200 ?9?6 ... ORX 4 1 [ONLINE FH SO SET BIT 1 ?9*4 ... SEGENTRY K81FHOBJIND ?9C6 STORETM ?9WQ STO 4 A1+1(3) [PUT VALUE IN BUFFER ?=BB LDX 1 FX1 ?=W2 BRN M12WINDUP [J TO WINDUP CODE ??*L M12ONLINE [MOP CASE ??T= LDN 4 #12 [ASSEMBLE GRAPHIC T/M ?##W ORX 4 GSIGN ?#SG ... BRN SETB1 ?*#6 M12NORMAL [NORMAL CASE ?*RQ LDX 4 FSCTM(2) [X4= T/M FROM OLPA ?B?B BRN STORETM ?BR2 # ?C=L # ********** ?CQ= # ?D9W # IN THE NONSERIAL CASE MUCH MORE DATA IS INVOLVED. SOME OF THIS IS ?DPG # TAKEN FROM THE FCB, SOME FROM THE FILE/ENT THOUGHTFULLY CHAINED TO ?F96 # THE OLPA BY ASSIGN. WE CAN'T GET ALL THE DATA FROM THE ENT AS THE ?FNQ # INFORMATION IN THE FCB IS VOLATILE AND MAY HAVE CHANGED SINCE THE ?G8B # ENT WAS SET UP DURING THE USEROPEN. ?GN2 # ?H7L M12NONSER ?HM= MHUNTW 2,FILE,ENT [X2->ENT ?J6W LDCT 0 #600 [TRANSFER TOP 2 BITS OF EINF3 ?JLG ANDX 0 EINF3(2) ?K66 STO 0 A1+2(3) ?KKQ LDX 0 EFLOW(2) ?L5B STO 0 A1+3(3) ?LK2 LDX 0 EORG(2) ?M4L STO 0 A1+4(3) ?MJ= LDX 0 EKEY(2) ?N3W STO 0 A1+5(3) ?NHG TOPFCB 2 [X2->FCB ?P36 LDX 0 FETM(2) [TRANSFER TYPE MODE ?PGQ STO 0 A1+1(3) ?Q2B LDX 0 FSIZE(2) ?QG2 DEX 0 A1+2(3) [DEX TO AVOID CLEARING MS 2 BITS ?Q^L LDX 0 FENDBUCK(2) ?RF= STO 0 A1+6(3) ?RYW LDX 0 FVERSION(2) ?SDG STO 0 A1+7(3) ?SY6 LDX 2 FX2 ?TCQ # ?TXB # ********** ?WC2 # ?WWL # MODE #12 IS NOW COMPLETE. WE EXIT ACROSS TO FHOBJ (Q.V.) WHICH TREATS ?XB= # THE FRB AS THOUGH IT HAD JUST READ IT FROM THE FILE. ?XTW # ?Y*G M12WINDUP ?YT6 ACROSS FHOBJ,8 ?^#Q # ?^SB # ********************************************************************* #2#2 # #2RL # #3?= # THE WINDUP CODE SIMPLY GOES ACROSS TO FHOBJ TO SET THE REPLY. #3QW # #4=G SETREP #4Q6 ACROSS FHOBJ,2 #59Q # #5PB # ********************************************************************* #692 # #6NL # THIS IS THE EXCEPTION SECTION. MOST EXCEPTIONS ARE HANDLED IN FHOBJ. #78= # #7MW # ILLEGAL DATA ERROR #87G # #8M6 NILDATA #8WY ... VFREEW FILE,FWB #96Q ACROSS FHOBJ,9 [GET FHOBJ TO ILLEGAL #9LB # #=62 # ILLEGAL COUNT OUT OF RANGE #=KL # #?5= NILCOUNT #?JW ACROSS FHOBJ,10 [GET FHOBJ TO ILLEGAL ##4G # ##J6 # ******************** #*3Q # #*HB # THE ONLY EXCEPTIONS REQUIRNG ACTION IN FHOBJIND ARE THE END OF FILE #B32 # AND BEGINNING OF FILE CONDITIONS WHICH ARISE DURING MODE #7. #BGL # IN BOTH CASES A REPLY OF #0500XXXX IS SET IF OWN-MON IS IN USE, #C2= # WHERE #XXXX IS THE REMAINDER COUNT FROM THE SKIP/BACKSPACE. #CFW # OTHERWISE A SUITABLE ILLEGAL TAKES PLACE IN FHOBJ. #C^G # #DF6 # SUBROUTINE TO SET X7 = #05000000 IF OWN-MON IS IN USE AND ZERO #DYQ # OTHERWISE. #FDB # CALLED ON X6. #FY2 # #GCL MCHOWN #GX= LDN 7 0 [CLEAR REPLY #HBW LDX 0 ACA1(2) #HWG SRL 0 6 #JB6 ANDN 0 #777 [EXTRACT ADDITIVE MODE #JTQ SBN 0 #300 #K*B BNZ 0 (6) [EXIT IF #30000 NOT USED #KT2 LDCT 7 #050 [SET OWN MON REPLY #L#L EXIT 6 0 [EXIT #LS= # #M?W # MODE #7 BEG FILE CONDITION. THE REMAINDER COUNT IS IN ACOMMUNE8. #MRG # #N?6 M7BEGFILE #NQQ BC 2,MFHRECEOF [ENSURE SWITCH CLEAR #P=B CALL 6 MCHOWN [SET OWN MON REPLY IF OWN MON #PQ2 BNZ 7 NOTILLBOF [J IF OWN MON #Q9L ACROSS FHOBJ,11 [GET FHOBJ TO ILLEGAL #QP= NOTILLBOF #R8W ORX 7 ACOMMUNE8(2) [OR REMAINDER COUNT INTO REPLY #RNG BRN SETREP [JUMP TO WINDUP CODE #S86 # #SMQ # MODE #7 END FILE CONDITION. THE REMAINDER COUNT IS IN X3. #T7B # #TM2 M7EOF #W6L BS 2,MFHRECEOF [ENSURE SWITCH SET #WL= CALL 6 MCHOWN [SET REPLY IF OWNMON #X5W BNZ 7 NOTILLEOF [J IF OWNMON #XKG ACROSS FHOBJ,12 [GET FHOBJ TO ILLEGAL #Y56 NOTILLEOF #YJQ ORX 7 3 [OR REMAINDER COUNT INTO REPLY #^4B BRN SETREP [JUMP TO WINDUP CODE #^J2 # *23L # *2H= # *32W MENDAREA 30,K99FHOBJIND *3GG # *426 #END ^^^^ ...552515340009