{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: FHOBJIND860)}}
====== FHOBJIND860 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BBUS|BBUS]], [[george:macro:BC|BC]], [[george:macro:BCONTEXT|BCONTEXT]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BRINDEX|BRINDEX]], [[george:macro:BS|BS]], [[george:macro:BWZ|BWZ]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLEAR|CLEAR]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:CURTAIL|CURTAIL]], [[george:macro:DOWN|DOWN]], [[george:macro:FCAPCA|FCAPCA]], [[george:macro:FINDACTX|FINDACTX]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FRITE|FRITE]], [[george:macro:GETDIR|GETDIR]], [[george:macro:GETJOB|GETJOB]], [[george:macro:GETSOUT|GETSOUT]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:KEYRECI|KEYRECI]], [[george:macro:LOCKCA|LOCKCA]], [[george:macro:MBC|MBC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:PAIR|PAIR]], [[george:macro:READDICT|READDICT]], [[george:macro:REWIND|REWIND]], [[george:macro:REWRITE|REWRITE]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SSEARCH|SSEARCH]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:UNPLUG|UNPLUG]], [[george:macro:VFREEW|VFREEW]], [[george:macro:VSKIP|VSKIP]], [[george:macro:WHICHMOP|WHICHMOP]], [[george:macro:WIND|WIND]]
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 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