"Loading SFS Fast Library System" $PRINT CRLF ;11/19/07 ; ; *** EXPERIMENTAL!!! *** scary code that seems to work but may be buggy ; ; This is an enhancement of the old SFS library system. Same exact format, ; "files" within the library file separated by ;;;FILE:filename: markers, ; R L D2L LFORGET LDIR work the same. Differences are this version adds a ; SETLIB word to define which file is the library and open it, LIB opens ; whatever was last set by SETLIB (setting sticks with XSAVE DGEN etc), ; added a word to close and release the library buffer, and the buffer ; used by the library is a variable. Defaults to buffer 3 to be compatible ; with old software (specifically the MS2L utility which assumes buffer 3). ; ; The main difference is this version is magnitudes faster by machine-coding ; a sub that searches for ";;" words in alt-mem, thus redirecting only the ; portions of the file which might contain a file tag. Also making it faster, ; the main search function is in one sub so it doesn't have to switch between ; file alt and user alt with every byte like the FILE redirectors have to ; do - which seems like a bad feature of those words but it's absolutely vital ; that they work that way (for starters so that ABSLOAD can be used to load an ; ABS file into alt-mem, among many other very important reasons). ; ; LIB - opens library defined by SETLIB, creates if it doesn't exist ; "Volume" "File" SETLIB - sets/opens library file on current drive ; "Name" R - runs "Name" from buffered library then forgets it ; "Name" L - loads "Name" from buffered library into dictionary ; "Name" D2L - saves definition to buffered library ; "Name" LFORGET - removes "Name" and everything after it ; LDIR - lists library names ; LCLOSE - closes library file, saving changes to disk ; VARIABLE LBUF ;buffer used by the library LBUF 3 PUT ;default to buffer 3 ; ;speedup code... ;[word value] [buffer] BSRCH - scans from current file pointer to EOF ;if found pushes byte pointer of next word, else pushes 177777 for not found. ;does not affect pointer value, calling code has to do that. ;note... even offsets only! ;FPA at 204+buf, FSA at 210+buf ; OCTAL CREATE BSRCH JSB ZSPOP,I get buffer number AND CON3 for safety, buffer 0-3 only STA SBUF save it INA increment to point to SFS buffer JSB USPAC make that buffer alt JSB ZSPOP,I get word value to search for STA AVAL save it LDB SFPA get loc of FPA ADB SBUF add buffer# LDA 1,I get byte pointer RAR rotate right AND B15C clear bit 15 INA INA offset by 2 STA APTR save for pointer LDB SFSA get loc of FSA ADB SBUF add buffer# LDA 1,I get byte pointer RAR rotate right AND B15C clear bit 15 INA INA offset by 2 STA ATERM save for terminate location * main search loop BSLOO LDA APTR get pointer LDB ATERM get end of file word CMB,INB 2's comp end to subtract ADA 1 A = pointer - end of file SSA skip if sign of A is zero JMP BSDOS negative, not at end yet, do search LDA APTR get errant pointer STA ATERM make terminate equal to force fail JMP BSDON exit and push search fail value BSDOS CLA,INA CAX count = 1 LDA APTR source = word pointer LDB AMT dest address = MYTMP MWF move word from alt mem to MYTMP LDA MYTMP get that word CPA AVAL is it the word being searched for? JMP BSDON yes - quit searching and push pointer ISZ APTR no - inc pointer and keep looking JMP BSLOO * exit BSDON CLA clear A JSB USPAC restore normal altmem LDA APTR get pointer CPA ATERM at end? JMP BSNF yes - not found ADA CMI1 subtract 1 RAL mult by 2 for even byte pointer BSPR JSB ZSPSH,I push it JMP ZNXT,I exit machine code BSNF LDA CMI1 get not found value JMP BSPR push that instead * simplified USPACE sub... alt page in A USPAC NOP AND DMSK2 RAL,RAL RAL,RAL RAL ADA DCON1 STA MYTMP LDA DMSK2 CAX LDA DCON1 LDB MYTMP XMS JMP USPAC,I DCON1 OCT 000040 DMSK2 OCT 000037 MYTMP OCT 0 CON3 OCT 3 APTR OCT 0 altmem pointer ATERM OCT 0 terminate here AVAL OCT 0 word value to look for SBUF OCT 0 SFS buffer SFPA OCT 204 SFS file pointer array SFSA OCT 210 SFS file size array B15C OCT 77777 bit 15 clear CMI1 OCT 177777 not found value/ -1 AMT DEF MYTMP address of MYTMP END ; ; more speedup code... ; "string" MSASCAN - replaces MSSCAN, hardcoded to begin with ";;" ; if string found pushes 1 and leaves file pointer (MS) positioned ; after last char, pushes 0 if not found. Next MS stream val after ; ";;" must be either ";" or first char of match. ; If 128 dec encountered terminates w/ not found. ; DEFINE MSASCAN #0 S>Z ;found flag on Z DO ;until end of library 35473 LBUF GET BSRCH ;seach for ";;" DUP INC IFZ ;if not found INC ;inc 177777 error to make 0 to terminate ELSE ;see if it's a match LBUF GET SWAP SEEK ;set file pointer MSBIN ;get byte from MS DUP 73 SUB IFZ ;if another ";" char DROP MSBIN ;drop it and get next byte ENDIF $DUP ;search string DO DUP 200 SUB IFZ ;if 128 dec terminator DROP ;the 128 $DROP "" ;replace w/ empty to terminate outer loop #0 ;stop looping ELSE $HEAD SUB IFZ ;if char matches $LEN IFNZ ;if more to do MSBIN ;get next byte #1 ;keep looping ELSE ;matched #0 ;stop looping Z>S DROP #1 S>Z ;set found flag ENDIF ELSE ;no match #0 ;stop looping ENDIF ENDIF WHILE ;more to do $LEN $DROP ;terminate if match/end occured ENDIF WHILE ;more to do $DROP ;search string Z>S ;push not found/found flag END ; ;RUN&DEL - execute word in string on X stack then delete it ;modified 5/27/05 to use RCTL to save address ; VARIABLE RCTL DEFINE RUN&DEL $DEFADR DUP IFZ "Word not found" $PRINT DROP ELSE DUP RCTL SWAP PUT ;save forget address EXECUTE ;run it ;word must not change RCTL or else RCTL GET 4 SUB #0 PUT ;delete it RCTL #0 PUT ;clear RCTL to avoid inadvertent op CRLF ;to make it look neat ENDIF END ; ;"file" LIBLOAD searches for the specified file then loads it ;modified 5/28/05 to pop str from Y if not found and RCTL set ; DEFINE LIBLOAD "FILE:" $SWAP $CAT ":" $CAT MSASCAN IFZ "Not found" $PRINT RCTL GET IFNZ Y>>X $DROP ENDIF ELSE LOAD ENDIF END ; ; LIBEND - used to terminate library chunks. Does CONSOLE ; then if RCTL <> 0 runs and deletes word on Y stack ; DEFINE LIBEND CONSOLE RCTL GET IFNZ RCTL #0 PUT Y>>X RUN&DEL ENDIF END ; VARIABLE LFIL 21 ;array to save library file and volume names ;offset 0 to 7 - 16 char filename ;offset 10 to 17 octal - library volume name ;offset 20 octal - library drive number ; ; LIB - open library specified by SETLIB (in LFIL array) ; DEFINE LIB LFIL GET IFZ "SETLIB not run" $PRINT ELSE LBUF GET CWA ADD GET IFNZ "Buffer busy" $PRINT ELSE ;push volume name string to X 10 17 +DO LFIL INDEX ADD GET S>X +LOOP 20 S>X 11 S>X LBUF GET LFIL 20 ADD GET DIRECTORY FSS GET IFNZ LBUF GET RELEASE ;directory command prints Volume not found msg ELSE ;push filename string to X #0 7 +DO LFIL INDEX ADD GET S>X +LOOP 20 S>X 11 S>X $DUP ;in case creating LBUF GET OPEN FSS GET IFZ $DROP ELSE " creating " $PRINT $DUP LBUF GET DUP CNF $DUP DUP OPEN MS_SAVE DUP >FILE 200 MSBOUT MS_RESTORE DUP CLOSE OPEN ENDIF ENDIF ENDIF ENDIF END ; ; "Volume" "File" SETLIB - copies strings and current drive ; into LFIL array, then runs LIB to open it ; DEFINE SETLIB ;copy filename to LFIL 16Pad #0 7 +DO LFIL INDEX ADD $ADR INDEX ADD GET PUT +LOOP $DROP ;copy volume name to LFIL 16Pad #0 7 +DO LFIL INDEX ADD 10 ADD $ADR INDEX ADD GET PUT +LOOP $DROP ;copy current drive to LFIL LFIL 20 ADD DRV GET PUT LIB ;try to open it END ; ; LCLOSE - close the library file, saving changes ; DEFINE LCLOSE LBUF GET DUP CLOSE RELEASE END ; ; "name" R - runs word from open library then forgets it ; name is stored on Y stack for LIBEND to run/forget ; DEFINE R CWA LBUF GET ADD GET #1 AND IFZ "No library" $PRINT $DROP ELSE LBUF GET DUP >Y LIBLOAD ENDIF END ; ; "name" L - loads word from open library ; DEFINE L CWA LBUF GET ADD GET #1 AND IFZ "No library" $PRINT $DROP ELSE LBUF GET DUP FILE >MS FSA ADD GET DEC SEEK ";;;FILE:" $PRINT $DUP $PRINT ":" $PRINT CRLF $DEFADR PDEF "LIBEND" $PRINT CRLF 000200 MSBOUT <>CON MS_RESTORE ENDIF ENDIF END ; ; "Name" LFORGET - removes "Name" and everything after it ; DEFINE LFORGET LBUF GET #0 SEEK FSS GET IFNZ $DROP ELSE "FILE:" $SWAP $CAT ;form search string $LEN 3 ADD ;push length of search string + 3 to count ";;;" MS_SAVE LBUF GET FILE ;redirect output to library 200 MSBOUT ;write terminator byte "Done" $PRINT ENDIF ELSE $PRINT " not found" $PRINT ENDIF DROP ;length MS_RESTORE ENDIF END ; ; LDIR - lists words in library ; DEFINE LDIR LBUF GET #0 SEEK FSS GET IFZ ;if library open MS_SAVE ;save existing MS vectors "Library size: " $PRINT FSA LBUF GET ADD GET PNUM CRLF #0 ;char counter LBUF GET 70 CRLF ;print return SWAP DROP #0 SWAP ;zero counter ENDIF $PRINT ENDIF ENDIF WHILE DROP ;counter MS_RESTORE ;restore prev MS vectors ENDIF END ;------------ CONSOLE ; changes... ; 7/19/07 renamed LDEL to LFORGET and added confirmation ; 7/18/07 added BSRCH machine-coded ";;" search, replaced MSSCAN w/ MSASCAN ; 7/17/07 removed old LIB, replaced w/ SETLIB, stores in LFIL array ; new LIB opens whatever set by SETLIB, added LCLOSE to close ; modified R L D2L LDEL LDIR and new stuff to use buffer var LBUF ; 5/31/05 modified LDIR to avoid false hits, rearranged ; 5/30/05 added LDEL, made LDIR neater ; 5/28/05 cleaned up Y when R word not found ; 5/28/05 added LDIR ; 5/27/05 initial version