(George Source)
Macros used: BACKWAIT, BFCBX, BXE, BXGE, BXL, CHAIN, DERING, FILENUMB, GEOERR, JBC, JBS, MENDAREA, MHUNT, RERING, RINGFILE, SEG, SEGENTRY, SETNCORE, SFSTACK, SHORTEN, TRACEIF, UP
22FL [ 22^= [THIS VERSION INCLUDES: 23DW [1. CHANGES FOR OFFLINE MT USAGE BLOCKS IN FILE CHAIN ONLY 23YG [ 24D6 SEG CHANFILE,5,GEORGE PORTER,FILESTORE 24XQ SEGENTRY K1CHANFILE,ZCHANGEFILE 25CB SEGENTRY K2CHANFILE,ZCHANGESTRM 25X2 SEGENTRY K3CHANFILE,ZFILEMOVE 26BL SEGENTRY K4CHANFILE,ZGETFNAME 26W= SEGENTRY K24CHANFILE,ZGETFNAMEZ 27*W # 27TG # IMPLEMENTS MACROS WHOSE ENTRY POINTS ARE AS FOLLOWS:- 28*6 # 28SQ # K1 - CHANGEFILE 29#B # K2 - CHANGESTREAM 29S2 # K3 - FILEMOVE 2=?L # K4 - GETFNAME 2=R= # K24 - GETFNAME (ZERO DEPTH) 2?=W # 2?QG # 2#=6 # ON ENTRY THE OLD LEVEL IS STORED IN ACOMMUNE1,THE NEW LEVEL IN 2#PQ # ACOMMUNE2 & THE NEW ACTIVITY POINTER IN ACOMMUNE3 2*9B ZCHANGEFILE [K1 ENTRY 2*P2 LDX 0 ACOMMUNE2(2) [NEW LEVEL 2B8L STO 0 AWORK2(2) 2BN= LDX 0 ACOMMUNE3(2) [TARGET ACTIVITY 2C7W STO 0 AWORK3(2) 2CMG FILENUMB 3 [FIND NO OF FILES IN CURRENT ACTRING 2D76 LDX 7 ACOMMUNE1(2) [CONSIDER OLD LEVEL 2DLQ CALL 4 PARAM [ANALYSE & CHECK IT 2F6B LDX 6 7 [SET OLD LEVEL IN X6 2FL2 LDX 7 AWORK2(2) 2G5L LDX 4 AWORK3(2) 2GK= FILENUMB 3,4 2H4W ADN 3 1 [TO ALLOW FOR NEW FILE 2HJG CALL 4 PARAM [LEAVE ANALYZED DEPTH IN X7 2J46 SFSTACK 6,3 [FIND OLD LEVEL FSTACK ELEMENT 2JHQ DERING 3 [DERING ELEMENT 2K3B LDX 4 AWORK3(2) 2KH2 RINGFILE 3,4 2L2L LDN 6 0 [SET OLD LEVEL TO ZERO FOR S/R 2LG= BZE 7 UPP 2L^W CALL 5 RFIMOVE 2MFG UPP 2M^6 ... BACKWAIT [WAIT FOR ALL BS TRANSFERS FROM THIS 2NDQ ... [ ACT. TO FINISH (E.G. IF AOLPT, 2NYB ... [ ENSURES BUFFERS WRITTEN BACK BEFORE 2PD2 ... [ CHANGE TO CPAT & CLOSE FILE - 2PXL ... [ NEEDED BECAUSE CLOSE ONLY WAITS FOR 2QC= ... [ TRANSFERS FROM CURRENT ACT.) 2TSL UP 2W#= [ 2WRW # ON ENTRY THE NEW ACTIVITY IS STORED IN ACCOMUNE1. 2X?G ZCHANGESTRM [K2 ENTRY - CHANGESTREAM 2XR6 LDX 4 ACOMMUNE1(2) 2Y=Q LDN 5 0 [SET INITIAL LEVEL TO ZERO 2YQB LDN 6 2 [NO. OF FILES IN 'STREAM' 2^=2 SFSTACK ,3,2 [GET PTRS TO EL'T & FSTACKB 2^PL JBS STCH,3,BAMULT 329= BFCBX 1,2 [GET PTR TO FILE/FCB 32NW LDN 6 1 [ONLY 1 FILE IF NOT MULTIFILE ELEMENT 338G JBC STA,1,BFSDF [J IF NOT MDF 33N6 STCH MHUNT 1,FILE,FABSNB [A STREAM MUST TAKE ITS 347Q CHAIN 1,4 [FABSNB WITH IT 34MB STA LDX 2 5 [LOAD LEVEL WORD 3572 CHANGEFI 4,0(2) [CHANGE TOP FILE OF CURRENT ACT 35LL ADN 5 1 366= BCT 6 STA [LOOP TO BO 2 CHANGEFILES IF MULTIFIL 36B4 ... UP 36KW [ 375G # ON ENTRY THE OLD LEVEL OF FILE IS STORED IN ACOMMUNE1 AND 37K6 # THE NEW LEVEL IN ACOMMUNE2. 384Q ZFILEMOVE [K3 ENTRY - FILEMOVE 38JB LDX 4 ACOMMUNE3(2) 3942 BNZ 4 NA [IF NO ACTIVITY POINTER ASSUME 39HL LDX 4 FX2 [CURRENT ACTIVITY 3=3= NA 3=GW FILENUMB 3,4 3?2G LDX 7 ACOMMUNE1(2) [CONSIDER OLD LEVEL 3?G6 CALL 4 PARAM [ANALYSE & CHECK IT 3?^Q LDX 6 7 [STORE OLD LEVEL IN X6 3#FB LDX 7 ACOMMUNE2(2) [CONSIDER NEW LEVEL 3#^2 CALL 4 PARAM [ANALYSE & CHECK IT,LEAVE IN X7 3*DL BXE 6 7,UP [BRANCH IF LEVELS EQUAL 3*Y= LDX 4 ACOMMUNE3(2) 3BCW BNZ 4 NB [IF NO ACTIVITY PARAMETER ASSUME 3BXG LDX 4 FX2 [CURRENT ONE 3CC6 NB 3CWQ CALL 5 RFIMOVE [CALL ROUTINE TO MOVE EL'T ALONG RING 3DBB UP UP 3DW2 # 3F*L # THIS ROUTINE IS USED BY ALL ENTRY POINTS. 3FT= # ITS FUNCTION IS TO DERING A FSTACK ELEMENT FROM ITS CURRENT PLACE 3G#W # IN THE RING & RERING IT IN A SPECIFIED POSITION 3GSG # 3H#6 RFIMOVE 3HRQ SBX 5 FX1 3J?B SFSTACK 6,1,,4 3JR2 SFSTACK 7,2,,4 3K=L BXL 6 7,NOM 3KQ= LDX 2 BPTRF(2) [FIND PREVIOUS EL'T IN RING 3L9W NOM 3LPG LDX 3 1 [PRESERVE FCA PTR 3M96 RERING 1,2 [RERING FILE TO NEW POS'N 3MNQ ADX 5 FX1 3N8B EXIT 5 0 3NN2 # 3P7L # THIS ROUTINE LOOKS AT THE LEVEL SPECIFIED,IF IT IS -VE (I.E.THE HEIGHT 3PM= # FROM BOTTOM OF STACK OF THIS FILE) IT CONVERTS IT TO A +VE DEPTH,AFTER 3Q6W # ENSURING WHOLE WORD IS -VE (PARAMETER MAY HAVE BEEN GIVEN IN BOTTOM 3QLG # 12 BITS ONLY). IT ALSO CHECKS THAT THIS LEVEL DOES EXIST ALREADY. 3R66 # 3RKQ PARAM 3S5B LDX 1 7 [LOAD PARAMETER 3SK2 SLL 1 12 [TEST LOWER 12 BITS FOR -VE 3T4L BPZ 1 POS 3TJ= ORX 7 HALFTOP [MAKE WORD FULLY -VE 3W3W ADX 7 3 [CONVERT TO +VE DEPTH 3WHG BPZ 7 ZEXIT [JUMP IF WITHIN RANGE TO EXIT 3X36 ORANG GEOERR 1,FILEMOVE 3XGQ POS BXGE 7 3,ORANG [JUMP IF OUT OF RANGE 3Y2B ZEXIT EXIT 4 0 3YG2 ZGEOER1 3Y^L GEOERR 1,READDEEP 3^F= # 3^YW # 42DG ZDEEP 42Y6 # SPECIAL ROUTINE FOR CHECKING & CONVERTING DEPTH 43CQ # 43XB LDX 7 EXEC1(2) [PARAMETER 44C2 SRA 7 15 44WL LDX 5 7 45B= BPZ 5 ZIN1 45TW NGX 5 5 46*G SBN 5 1 46T6 ZIN1 47#Q FILENUMB 0 47SB BXGE 5 0,ZGEOER1 48#2 EXIT 6 0 48RL ZFSTACK 49?= # DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [X7] & ALSO GIVESA'POINT 49QW # ER TO THE FSTACK BLOCK 4==G SFSTACK 7,3,2 4=Q6 EXIT 4 0 4?9Q # 4?PB # 4#92 # THIS MACRO GETS A FILE/FABSNB FOR A FILE OPEN AT A SPECIFIED 4#NL # LEVEL. THIS LEVEL IS IN ACOMMUNE1. 4*8= # 4*MW ZGETFNAME [K4 ENTRY - GETFNAME 4B7G [ 4BM6 CALL 6 ZDEEP [CHECK DEPTH 4C6Q BRN MGETFN 4CLB ZGETFNAMEZ [K24 ENTRY - GETFNAME @ ZERO DEPTH 4D62 STOZ 7 4DKL MGETFN 4F5= TRACEIF K6CHANFILE,199,299,7,GETFNAME 4FJW SETNCORE 10,3,FILE,FABSNB [CORE 4G4G STO 3 5 [PRESERVE PTR TO ABS.N. BLK 4GJ6 CALL 4 ZFSTACK [POINTERS 4H3Q LDX 1 BPTR(2) [X1 ^ FCB 4HHB LDX 2 5 4J32 LDCT 0 #10 4JGL ANDX 0 FCOMM(1) [IF FILE IS A WORKFULE SET MARKER 4K2= BZE 0 NWF [IN FABSNB 4KFW LDN 0 #200 4K^G ORS 0 ATYPE(2) 4LF6 NWF 4LYQ LDX 0 COMM(1) [BO OF COMM ^ DIRECTORY 4MDB BPZ 0 NGETFN [J IF TERMINAL FILE 4MY2 TRACEIF K6CHANFILE,199,299,FME1(1),GET USN 4NCL LDN 3 4 [R.H. 4NX= SHORTEN 2,4 4PBW ADN 1 FME1 ['FROM' PTR. FOR'MOVE'ORDER 4PWG BRN PGETFN 4QB6 NGETFN 4QTQ TRACEIF K6CHANFILE,199,299,FUSER1(1),GET SUPN 4R*B TRACEIF K6CHANFILE,199,299,FLOC1(1),GET LOCN 4RT2 LDN 3 10 [R.H 4S#L ADN 1 FUSER1 ['FROM' POINTER 4SS= PGETFN 4T?W STO 3 A1(2) [R.H 4TRG ADN 2 A1+1 ['TO' PTR. 4W?6 MOVE 1 511(3) [MOVE ONE WD LESS 4WQQ UP 4X=B # 4XQ2 MENDAREA 20,K99CHANFILE 4Y9L #END ^^^^ ...53501316000600000000