"Loading SFS Library System" $PRINT CRLF ;8/30/08 ; ; The SFS library system permits storing multiple IPL file segments into a ; single disk file. The system can also be used to store text-based data and ; load into alternate memory for access, space-padded upon load for direct ; access to specific lines (same format used by the AEDIT editor). The main ; use for the library system is to permit storing lesser-used utilities (such ; as the words in xutils.ipl) in a library file to permit removing them from ; the dictionary while still keeping them available for use. Another use is ; to temporarily store words while rearranging the dictionary. Single words ; can be placed directly into the library, when reloading everything the word ; needs must be already present in the dictionary. Words which require other ; words or variables, or CREATE words, can composed using AEDIT or printed ; to alternate memory (or a file) then added to the library. ; ; Nothing is actually written to disk until the library is closed, if a ; problem occurs just -SFS to abandon changes then LIB to reopen the library. ; ; Before the library can be used the library file must be defined by entering ; "Volume" "File" SETLIB (substituting the desired volume and file names). ; This setting is saved when the build is saved. If the file exists then it ; is opened, otherwise an empty library is created. At least 192KW memory ; must be installed to use the library system as configured, otherwise set ; the LBUF variable to the SFS buffer to use for the library. For example ; if 128KW is installed the maximum SFS buffer is 1 so enter: LBUF 1 PUT ; then save the build. ; ; Words for using the library system... ; ; LIB - opens library defined by SETLIB, creates it if it doesn't exist ; "Volume" "File" SETLIB - sets/opens/creates library file on current drive ; "Name" LFORGET - removes "Name" and everything after it from the library ; LDIR - lists the library filename and names of library segments ; LCLOSE - closes the library file, saving changes to disk if modified ; "Name" R - runs "Name" from the library then forgets it ; "Name" L - loads "Name" from the library into dictionary ; "Name" D>L - saves dictionary definition to the library ; "Name" A>L - copies IPL/text data from alt mem to the library ; "Name" L>A - copies library file to alt mem, space-padding for AEDIT ; "Name" MS>A - copies MS input to the library (1st 0 after text terminates) ; ; A>L uses location 150 for transient temp storage for A>CCOPY. ; The R and L words cannot (easily) be used in programs as they redirect ; IPL code into the HP-IPL/OS console (thus no words can be running, as with ; any other IPL load operation). L cannot be placed in the library and run ; by R since both manipulate the RCTL (run control) variable, but D>L A>L and ; L>A can be run from the library, MS>A too if the segment includes A>L (see ; procedure for copying a multi-word app to the library). The other words can ; be used by programs if desired provided they're already in the dictionary ; or included in the library segment, in particular L>A for loading data from ; the library into alt mem - because of the padding individual lines can be ; accessed using code like (octal): line# 50 MUL 2 ADD MSUSER MS$IN ; ...but L>A isn't speedy, large data segments can take some time to load. ; ; Library file format... ; ;;;FILE:NAME: ; [text/IPL code] ; LIBEND ; [additional ;;;FILE:NAME: segments] ; ; The library words automatically add the ;;;FILE:NAME: tags. ; All segments within the library must end with LIBEND on its own line with ; no leading spaces, D>L for saving a single word automatically adds it but ; if using A>L it must be present in the segment being added. The ending ; CONSOLE in existing IPL files must be changed to LIBEND before including ; into the library. So long as the library words are present it's OK to ; use XLOAD to load IPL's that end in LIBEND for testing. ; ; Possible format for a run-and-forget segment... ; ;;;FILE:NAME: ; OCTAL DEFINE NAME [must be the same name as the segment name] ; "MAIN" $DEFADR DUP IFZ DROP ELSE EXECUTE ENDIF END ; [all variables and words required by MAIN definition] ; DEFINE MAIN ; [main app definition] ; END ; LIBEND ; ; Procedure for copying multi-word (high-level) app from the dictionary ; to an open library file... (NAME=the name of the word that runs the app) ; ; RENAME NAME MAIN ;rename main app word to MAIN (or whatever but adjust) ; DEFINE NAME ;define a new app word that runs MAIN... ; "MAIN" $DEFADR DUP IFZ DROP ELSE EXECUTE ENDIF END ; ZAM ;clear alt mem ; 2 MSUSER >MS ;redirect printed output to altmem ; EXPLAIN NAME ;put new app word 1st ; "VARIABLE VARNAME" $PRINT CRLF ;do for each variable used by the app ; EXPLAIN SUBWORD ;do for each word required by the app ; EXPLAIN MAIN ;add the renamed main app word ; "LIBEND" $PRINT CRLF ;terminate the segment ; CONSOLE ;restore console and MS to default ; "NAME" A>L ;add segment to the library ; ; If any error occurs during A>L do -SFS immediately to abandon changes, ; otherwise LDIR, test-run by doing "NAME" R, if all is well then LCLOSE ; to save 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. ; mod 8/30/08 - if zero byte encountered terminates w/ not found (not 128) ; 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 IFZ ;if terminator zero DROP ;the 0 $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 ;mod 8/30/08 more efficient forming of file tag string ; DEFINE LIBLOAD "FILE:" $SWAP $CAT 72 $APPEND 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) ; mod 8/30/08 to remove terminating byte (simplified) ; 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 OPEN ;SFS error messages displayed if file can't be created/opened 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 ; ; "Name" LFORGET - removes "Name" and everything after it ; mod 8/30/08 to fix bugs, remove terminator byte ; DEFINE LFORGET LBUF GET #0 SEEK FSS GET IFNZ $DROP ELSE "FILE:" $SWAP $CAT 72 $APPEND ;form search string $LEN 3 ADD ;push length of search string + 3 to count ";;;" MS_SAVE 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 ; ; 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 L - writes definition to library, must be open ; note - writes to buffer only, does not save to disk. ; run LCLOSE LIB to save changes then reopen the library. ; mod 8/30/08 to remove terminator byte, optimize ; DEFINE D>L $DUP $DEFADR IFZ $PRINT " not found" $PRINT ELSE CWA LBUF GET ADD GET #1 AND IFZ $DROP "No library" $PRINT ELSE MS_SAVE LBUF GET DUP DUP >FILE >MS FSA ADD GET SEEK ";;;FILE:" $PRINT $DUP $PRINT 72 PCHR CRLF $DEFADR PDEF "LIBEND" $PRINT CRLF <>CON MS_RESTORE ENDIF ENDIF END ; ; Utilities for copying editable data to/from open SFS library ; "NAME" A>L - copies AEDIT (or any) data from alt mem to the library ; "NAME" L>A - copies library file to altmem, space-padding for AEDIT ; mods 8/30/08 to remove terminator byte from A>L, optimized L>A A>L ; ; Notes... if using to import existing IPL code the CONSOLE at the end ; of IPL packages must be changed to LIBEND to properly terminate! ; LIBEND should be the last line and have no leading spaces! ; Alt.mem data after the last line must be zero! ; A>L uses location 150 as a temp. [comment corrected 1/1/12] ; ; Example usage to edit last file in the library... ; [LIB to open library] ; "NAME" L>A AEDIT - load file NAME for editing ; "NAME" LFORGET - remove last file from library ; "NAME" A>L - save edited file to library ; ; Example usage to add existing AEDIT-format file to the library... ; "FILE" LDFILE (or LDTXT if not AEDIT format) ; AEDIT and go to end of IPL file, change CONSOLE to LIBEND ; "NAME" A>L - save edited file to library ; ; These examples assume AEDIT is already in the dictionary, load ; it first if not already loaded (or make an EDIT/LIB build with ; these utilities to use when activities like these are needed). ; Do LCLOSE to actually commit the library change to disk, ; otherwise added in buffer memory only (handy for testing). ; Note... little checking to make sure alt mem is valid IPL, use wisely! ; If error occurs, 2 RUN to restart HP-IPL/OS, -SFS LIB to reload library ; DEFINE A>L CWA LBUF GET ADD GET #1 AND IFZ $DROP "No library" $PRINT ELSE $TRIM $LEN IFZ $DROP "No name " $PRINT ELSE -1 2 52 +DO INDEX 150 #1 A>CCOPY 150 GET ;check first 41 words of data DUP 377 AND 15 SUB IFZ SWAP INC SWAP ENDIF ;inc flag if CR in low byte DUP 177400 AND 6400 SUB IFZ SWAP INC SWAP ENDIF ;inc if CR in high byte DUP 100000 AND IFNZ SWAP DEC SWAP ENDIF ;dec flag if bit 15 set IFZ DEC ENDIF ;pop value, dec flag if a zero - that should at least ;discourage accidental use from doing anything too drastic but could ;still end up with non-IPL garbage in the library and if any text ;does not end in CRLF then a corrupted library results. Tricky stuff! +LOOP IF<0 "Not text " $PRINT ELSE MS_SAVE ;save current MS vectors 2 MSUSER ;redirect MS I/O from/to alt mem LBUF GET >FILE ;redirect MS out to library LBUF GET FSA LBUF GET ADD GET SEEK ;seek to end ";;;FILE:" MS$OUT MS$OUT 72 MSBOUT MSCRLF ;write header CRLF "Copying altmem to library: " $PRINT #0 ;line count... print a * every 16 lines DO ;until a zero word detected in alt mem UPTR GET 150 #1 A>CCOPY ;copy current altmem word to location 150 150 GET DUP IFNZ ;if not zero... MS$IN ;input line from altmem SWAP INC SWAP OVER 17 AND IFZ 52 PCHR ENDIF ;print progress ;remove trailing spaces... DO $LEN DEC $GET 40 SUB IFZ $TAIL DROP #0 ELSE #1 ENDIF UNTIL ;leading spaces can't be removed as that breaks CREATE code MS$OUT MSCRLF ;write trimmed line to library ENDIF WHILE ;last line was non-zero, loop until all of altmem copied DROP ;line counter MS_RESTORE ;restore MS vectors CRLF "Done" $PRINT CRLF ENDIF ENDIF ENDIF END ; DEFINE L>A CWA LBUF GET ADD GET #1 AND IFZ $DROP "No library" $PRINT ELSE $LEN DROP ;fail if "NAME" not specified ZAM ;clear alt memory MS_SAVE ;save MS vectors 2 MSUSER ;redirect MS I/O from/to alt memory LBUF GET DUP L - copies text from MS input to an open library ; Skips leading zero bytes, terminates on next 0 received after text ; Does not attempt to change CONSOLE to LIBEND like previous MS2L utility ; (which was slow and subject to not work depending on code), source text ; must already be library-compatible. ; DEFINE MS>L $LEN IFNZ ;make sure name string specified MS_SAVE ;save vectors ZAM ;clear alt mem 350 DUP GET ;push MS in vector addr/value 2 MSUSER ;redirect MS in/out to alt mem PUT ;restore MS in vector, leaving out redirected to alt mem DO ;skip leading 0's... MSBIN DUP IFNZ MSBOUT #1 ENDIF ;write 1st non-zero byte to file UNTIL ;loop until non-zero data received DO ;copy rest of the file until 0 received MSBIN DUP IFNZ MSBOUT #1 ENDIF ;write remaining non-zero bytes WHILE ;loop while non-zero data received MS_RESTORE ;restore MS vectors A>L ;copy alt mem to library ENDIF END ;------------ ; changes... ; 8/30/08 modified MSASCAN to terminate on 0 (not previous 128 terminator) ; fixed LFORGET to use full search string (was matching partial) ; modified LIB D>L LFORGET A>L to not add/skip terminator byte ; (now the library is just a plain-text file) ; optimized tag string in LIBLOAD D>L A>L L>A ; 8/29/08 dropped extra DROPs in A>L and L>A (if no library open) ; 8/26/08 comment tweaks and stuff ; 8/25/08 added MS>L word, modified LDIR to display library filename ; 8/24/08 renamed D2L to D>L, added A>L and L>A (prev.A2L/L2A from a2l.ipl) ;11/19/07 1st "official" use, added LBUF to use with any SFS buffer ; 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 CONSOLE ~TERMINATE~