RAND864
(George Source)
Macros used: ALTLEN, BXE, BXGE, BXL, BXU, CHAIN, FILEAUTW, FILEREAD, FILETRAN, FREEBACK, FREEBAX, FREECORE, GEOERR, GETBACK, GETBAX, JBC, JMBAC, JMBS, MAPBCH, MAPBIN, MAPBSE, MBS, MHUNTW, NAME, OVER, READ, READED, SEG, SEGENTRY, SETNCORE, SETREP, SETREP2, TOPFCB2, UP, WRITED
- RAND864.txt
22FL SEG RAND,,FILE 22^= [ 23DW [ THIS CHAPTER IMPLEMENTS THE RANDOM ACCESS MACROS READED & WRITED. 23YG [ REF G.I.M. 5.6 24D6 [ 24XQ SEGENTRY K1RAND,READED [READED MACRO ENTRY POINT 25CB SEGENTRY K2RAND,WRITED [WRITED MACRO ENTRY POINT 25X2 [ 26BL FILETRAN [SUBROUTINES FOR FILEAUTW & FILEREAD 26W= [ 27*W SEEKFULLB [GET POINTER TO FULLB IN FILE CHAIN IN X1 GIVEN X2->FCB 27TG [ EXIT+0 IF NOT FOUND: EXIT+1 IF FOUND: LINK X7 28*6 [ X0 DESTROYED: X2-X6 UNALTERED 28SQ LDX 1 FPTR(2) [X1->FSTACK 29#B SFULLB 29S2 LDX 1 FPTR(1) [X1->NEXT BLOCK 2=?L BXE 1 CXFI,(7) [EXIT OF END OF FILE CHAIN 2=R= LDX 0 ATYPE(1) 2?=W BXE 0 FFSFCB,(7) [EXIT IF NEXT FCB 2?QG BXU 0 FFSFULLB,SFULLB [GO BACK IF NOT FULLB 2#=6 LDX 0 A1+1(1) [PICK UP RESIDENCE NUMBER 2#PQ BXU 0 BSPRE(2),SFULLB [GO BACK IF WRONG FULLB 2*9B EXIT 7 1 [OK 2*P2 [ 2B8L [ 2BN= READED 2C7W [ [ENTRY FROM READED MACRO 2CMG [ 2D76 LDN 4 0 [=> READED MACRO 2DLQ LDX 7 ACOMMUNE7(2) [%C= TRANSFER LENGTH IN WORDS 2F6B JMBS OKM,FILERING(2),BAMREAD,BAMREADR,BAMWRITE,BAMGEN,BAMCLEAN 2FL2 BRN (GEOERR) [FILE NOT OPEN IN SUITABLE MODE 2G5L [ 2GK= WRITED 2H4W [ [ENTRY FROM WRITED MACRO 2HJG [ 2J46 LDN 4 1 [X4 NON-ZERO => WRITED MACRO 2JHQ JMBAC (GEOERR),FILERING(2),BAMWRITE,BAMGEN [J UNLESS OPEN FOR R 2K3B [ 2KH2 OKM 2L2L LDX 5 ACOMMUNE8(2) [BUCKET NUMBER 2LG= SBN 5 1 2L^W BNG 5 (GEOERR) [BUCKET NUMBER NEGATIVE OR ZERO 2MFG LDX 3 ACOMMUNE9(2) [BUCKET SIZE (MUST BE 1,2 OR 4) 2M^6 SRL 3 1 [=> 0,1 OR 2 2NDQ SLL 5 7(3) [CONVERT BUCKET NUMBER TO WORDS 2NYB LDEX 6 5 [X6 HAS ODD BLOCKLETS*128 2PD2 SRL 5 GSBSLOG [BLOCK MOD. 2PXL SRC 6 9 [BLOCKLET MOD TO B0/1 FOR FILETRAN 2QC= TOPFCB2 2 2QWW ADN 5 FBLKS [TURN BLOCK MOD INTO FREADBLOCK FORMA 2RBG LDX 0 5 2RW6 SBN 0 A1 [TURN INTO FBLMOD FORMAT 2S*Q BXL 0 FUSEBL(2),ZEC2 [J IF WITHIN LIMIT OF ALLOCATED BLOCK 2STB ADN 0 1 2T*2 LDX 1 FSIZE(2) [MAXIMUM PERMITTED SIZE IN BLOCKS 2TSL ADN 1 FBLKS-A1 2W#= BXGE 1 0,ZEC1 [J IF MAY GET BLOCKS 2WRW SETREP OVERFILE 2X?G UP 2XR6 [ 2Y=Q [ 2YQB ZEC1 2^=2 BZE 4 ZEC5 [J IF READED - NORIT CASE 2^PL LDX 7 0 329= SBX 0 FUSEBL(2) [GIVES EXTRA BLOCKS REQUIRED 32NW SMO FX2 338G STO 0 AWORK2 33N6 LDX 3 2 347Q ALTLEN 3,7 [ENSURE ROOM FOR EXTRA BLOCKS IN FCB 34MB LDX 3 AWORK2(2) 3572 SBX 5 3 [->LAST USED BLOCK POSITION 35LL ADN 5 1 [->FIRST UNUSED BLOCK POSITION 366= ADN 3 2 [FOR EMPTYB RECORD HEADER 36KW SETUPCOR 3,1,BSTB,EMPTYB 375G STO 3 A1(1) 37K6 [ 384Q MOVED [LOOP BACK LABEL IF FILE COPIED DURING GETBAX 38JB [ 3942 TOPFCB2 2 39HL LDX 7 BSPRE(2) 3=3= STO 7 A1+1(1) [RESIDENCE NO. IN EMPTYB 3=GW GETBAX 3?2G TOPFCB2 2 3?G6 BXE 7 BSPRE(2),ZEC11 [J IF NOT COPIED 3?^Q FREEBAX [GIVE IT BACK 3#FB MHUNTW 1,BSTB,EMPTYB 3#^2 BRN MOVED [FILE MOVED : TRY AGAIN 3*DL [ 3*Y= ZEC11 3BCW MHUNTW 1,BSTB,FULLB 3BXG ADN 1 A1+2 [X1->NEW BLOCKS 3CC6 ADX 2 5 [X5->SPACE IN FCB 3CWQ MOVE 1 510(3) [[X3]-2 BLOCKS MOVED 3DBB SBN 1 A1+2 3DW2 FREECORE 1 [FULLB 3F*L TOPFCB2 2 3FT= SBN 3 2 [NO OF NEW BLOCKS 3G#W JBC NOTCARE,2,BFCARE [J UNLESS CAREFUL FILE 3GSG LDX 0 FBLMOD(2) 3H#6 SBN 0 BSPRE-A1 [POSN TO INSERT BITS 3HRQ MAPBIN 0,,3 [EXTEND FMAPP BY [X3] BITS 3J?B TOPFCB2 2 3JR2 NOTCARE 3K=L ADS 3 FUSEBL(2) [UPDATE FUSEBL 3KQ= LDX 0 FUSEBL(2) [FOR FBLMOD UPDATE 3L9W ADX 5 3 3LPG SBN 5 1 [RECOVER FREADBLOCK POINTER 3M96 BRN UPCUBS 3MNQ [ 3N8B ZEC2 3NN2 BXL 0 FBLMOD(2),ZEC40 [J IF WITHIN LIMIT OF WRITTEN BLOCKS 3P7L BZE 4 ZEC5 [J IF READ - NORIT CASE 3PM= ADN 0 1 3Q6W UPCUBS 3QLG SBX 0 FBLMOD(2) [GIVES FBLMOD INCREMENT 3R66 LDX 3 0 3RKQ INCRECUB FORCED,,3 [UPDATE CUBS FORCIBLY 3RTJ ... TOPFCB2 2 3S5B ADS 3 FBLMOD(2) [UPDATE FBLMOD 3SK2 [ 3T4L ZEC40 3TJ= ADX 5 6 [ADD BLOCKLET MOD INTO FREADBLOCK POI 3W3W BZE 4 READ [J IF READ 3WHG MBS 2,BFALTR,BFALTB 3X36 JBC NOTCAREFUL,2,BFCARE [J UNLESS CAREFUL 3XGQ BNZ 6 WRONGCARE [J IF NOT STARTING ON BLOCK BOUNDARY 3Y2B MHUNTW 3,FILE,FRWB 3YG2 LDX 0 ALOGLEN(3) 3Y^L BXE 0 BSBS,WHOLEBLOCK [J IF NOT WHOLE BLOCK TRANSFER 3^F= WRONGCARE 3^YW GEOERR 1,CAREFUL? [CODE CAN ONLY DEAL WITH SIMPLE 42DG [CASES. SUFFICIENT FOR IDF UPDATING 42Y6 [WHICH IS ONLY CAREFUL RANDOM FILE 43CQ [(LEXICON HAS OWN UPDATE CODE) 43XB WHOLEBLOCK 44C2 LDX 3 5 [FREADBLOCK TYPE POINTER 44WL SBN 3 BSPRE [GET BL NO REL BSPRE 45B= MAPBCH 3,2 [CHECK FMAPP BIT 45TW BNZ 0 NOTCAREFUL [J IF BLOCK ALREADY SWAPPED 46*G TOPFCB2 2 46T6 CALL 7 SEEKFULLB [GET X1->FULLB 47#Q BRN SETUPFULLB [J IF NOT FOUND 47SB LDX 7 ALOGLEN(1) 48#2 ADN 7 1 48RL LDX 6 1 49?= ALTLEN 6,7 [LENGTHEN BY 1 FOR SWAPPED BLOCK 49QW BRN TRYAGAIN 4==G [ 4=Q6 SETUPFULLB 4?9Q SETNCORE 3,1,BSTB,FULLB [REDTAPE+1 FOR SWAPPED BLOCK 4?PB LDN 0 2 4#92 STO 0 A1(1) [RECORD HEADER(=NO BLOCKS) 4#NL TOPFCB2 2 4*8= LDX 0 BSPRE(2) 4*MW STO 0 A1+1(1) [RESIDENCE NUMBER 4B7G LDX 0 FFSFMAPP 4BM6 SFMAPP 4C6Q LDX 2 FPTR(2) [NEXT BLOCK FROM FCB 4CLB BXU 0 ATYPE(2),SFMAPP [J BACK UNLESS FMAPP 4D62 CHAIN 1,2 [CHAIN NEW FULLB ON FPTR OF FMAPP 4DKL [ 4F5= TRYAGAIN 4FJW TOPFCB2 2 4G4G LDX 6 BSPRE(2) 4GJ6 GETBACK 6 4H3Q LDX 7 ACOMMUNE7(2) [LOAD BLOCK NO OBTAINED BY GETBACK 4HHB TOPFCB2 2 4J32 BXE 6 BSPRE(2),UNCHANGED [J UNLESS COPYFILE HAS MOVED FILE 4JGL FREEBACK 6,7 [GIVE IT BACK 4K2= BRN TRYAGAIN 4KFW [ 4K^G UNCHANGED 4LF6 SMO 5 4LYQ LDX 6 0(2) [PICK UP OLD BLOCK NUMBER 4MDB SMO 5 4MY2 STO 7 0(2) [REPLACE WITH NEW BLOCK 4NCL CALL 7 SEEKFULLB 4NX= BRN (GEOERR) [WAS THERE A MOMENT AGO! 4PBW SMO A1(1) 4PWG STO 6 A1(1) [PUT SWAPPED BLOCK ON END OF RECORD 4QB6 LDN 0 1 4QTQ ADS 0 A1(1) [INCREMENT RECORD HEADER 4R*B MAPBSE 3,2 [MARK BLOCK SWAPPED 4RT2 [ 4S#L NOTCAREFUL 4SS= [ 4T?W MHUNTW 3,FILE,FRWB [FIND BUFFER 4TRG LDX 6 ALOGLEN(3) [PICK UP DATA LENGTH 4W?6 CHAIN 3,FX2 [CHAIN BUFFER IN FRONT OF ACTIVITY 4WQQ ... FILEAUTW ,FREE+FAIL,EX6,5,,,NOCHECK 4X=B BRN OVER 4XQ2 [ 4Y9L READ 4YP= ... FILEREAD ,FAIL,EX7,5,,,NOCHECK 4^8W MHUNTW 1,BSTB,BREAD [FIND READ BUFFER 4^NG NAME 1,FILE,FRRB [ & RENAME IT 5286 OVER 52MQ SETREP2 OK 537B UP 53M2 [ 546L [ 54L= ZEC5 [BUCKET NUMBER WITHIN FILE BUT BLOCK NOT WRITTEN 555W SETUPCOR 7,1,FILE,FRRB [SET UP BUFFER OF REQUESTED LENGTH 55KG SETREP2 NORIT 5656 STOZ A1(1) [ & ZEROISE IT 56JQ ADN 1 A1 574B LDN 2 1(1) 57J2 SMO 7 583L MOVE 1 511 [[X7]-1 WORDS 58H= UP 592W [ 59GG #END ^^^^ ...544745000001