OCTAL "Loading SFS version 0.71" $PRINT CRLF ; ; An implementation of Bob Shannon's Simple File System for HP-IPL/OS ; Created 5/3/05 Last modified 8/1/08 by Terry Newton ; NOTE! Work in progress... subject to change... ; ; This code supports a maximum of 4 buffers. Memory requirements are from ; 96KW to 192KW (1 to 4 buffers). Normal alternate memory is not used to ; avoid conflict with other DMS-using fuctions like magtape, TDOS, XDOS etc. ; Zero page locations from 200 to 237 are reserved for SFS variables... ; 200-203 CWA Control Word Array ; 204-207 FPA File Pointer Array ; 210-213 FSA File Size Array ; 214 FSS File System Status ; 215-217 temp nameless variables (hard coded addresses!) ; 220 contains previous DRV value to restore after it was changed ; 221-226 used by DirUpdate, DIRECTORY ; 227-237 unspecified for now. ; ; Command words... ; ; "volname" buffer drive DIRECTORY - (re)loads a directory block for a buffer ; "filename" buffer OPEN - loads a file into a buffer for read/write access ; "filename" buffer REOPEN - opens a file into a buffer at last access point ; buffer FILE - redirects MS output to a buffered file for writing ; buffer bytepos SEEK - sets file pointer in a buffer to specified byte ; buffer CLOSE - closes specified buffer (reloading dir block) ; "filename" buffer CNF - creates new file in specified buffer ; "filename" buffer DEL - deletes a file in specified buffer ; srcbuf destbuf BCOPY - copies buffer to buffer, both must be open ; buffer RELEASE - releases specified buffer (marks buffer as unused) ; ; Note - don't perform direct manipulation of disk structures unless all related ; buffers are released first. Otherwise SFS will have stale data in memory. ; For safety, SFS programs should RELEASE buffers when done with them. ; ; Other useful words... ; x y UCOMP - pushes 1 if x > y else pushes 0 (unsigned comparison) ; -SFS - turns off SFS, abandoning all buffered directories and files ; ?SFS - shows status of SFS buffers ; ; Visible variables... ; ; CWA - Control Word Array containing control words for each buffer ; FPA - File Pointer Array containing byte pointers for buffered files ; FSA - File Size Array containing byte file sizes for buffered files ; FCA - File Control Array containing FCW's for buffered files ; LAA - Load Address Array containing LA's for buffered files ; RAA - Run Address Array containing RA's for buffered files ; FNA - File Number Array containing file numbers of buffered files ; DNA - Drive Number Array containing drive numbers of buffered files or directories ; VNA - Volume Number Array containing volume numbers of buffered files or directories ; FSS - File System Status variable containing status of last operation (0=ok) ; NDEA - Number of Directory Entries Array (from block 6) ; DBLA - Directory Block Low Array (from block 6) ; DBHA - Directory Block High Array (from block 6) ; FSLA - File Space Low Array (from block 6) ; FSHA - File Space High Array (from block 6) ; ; CWA, FPA, FSA and FSS are actually located in zero page, the high level "variables" ; are constants that push zp addresses, ie FPA INC GET pushes file ptr for buffer 1. ; ; CWA bits... ; (1) Bit 0 - if 1 then a file is loaded into buffer (busy) ; (2) Bit 1 - if 1 then a directory block is loaded into buffer ; (4) Bit 2 - if 1 then a volume index block is loaded into the buffer (when???) ; (8) Bit 3 - if 1 then buffer is dirty (file changed, needs writing upon close) ; ; FSS values... ; ; 177777 - programming error (incorrect parms) ; 171717 - buffer memory not present ; 000010 - file not open error ; 000011 - DMS not enabled error ; 000012 - buffer busy error ; 000013 - dir not loaded error ; 000014 - file already open in another buffer error ; 000015 - file already exists error ; 000016 - invalid directory error ; 004XXX - device error, XXX = error code from FSA(buffer) (210-213) then returns 0, doesn't ; increment and sets FSS (214) to error code 601 (max file size reached) ; This can be used by programs to detect end of file, if after a read FSS ; is not 0 then discard 0 and terminate. Simpler/text-based code could ; simply quit processing when 0 is returned. If FSS is not 0 upon entry ; to the subroutine, it returns 0. ; ; If DMS is not enabled, garbage from memory is returned but unless DMS ; was disabled after opening a file it won't get the chance. The >FILE ; word has to be more careful since it writes to DMS memory. ; CREATE B returns 1 in A else returns 0 in A COMPW NOP STA CWRA save A STB CWRB save B LDB CWIM get initial mask STB CWRM save in rotating mask CWLOO LDA CWRA get value A AND CWRM isolate bit STA 1 save in B LDA CWRB get value B AND CWRM isolate bit XOR 1 compare bits SZA skip if bits equal JMP CWFOU jump to determine results LDA CWRM get rotating mask CLE,ERA shift right STA CWRM save back SZA skip if zero JMP CWLOO loop if another bit to check CWRE0 CLA JMP COMPW,I return 0 in A, A<=B CWRE1 CLA,INA JMP COMPW,I return 1 in A, A>B CWFOU SZB found, skip if Breg (bit from A) is 0 JMP CWRE1 return 1 if bit from A is 1 JMP CWRE0 return 0 if bit from A is 0 CWRA OCT 0 A CWRB OCT 0 B CWIM OCT 100000 initial mask, bit 15 CWRM OCT 0 rotating mask * initialize... FFBEG JSB ZSPOP,I pop buffer# off stack STA RBUFF save in read buffer number var JSB FCHEK error check buffer# in A LDA MSISA get MS-input-handler sub address STA ZMINP put in MS input vector JMP ZNXT,I exit back to HP-IPL/OS * MS input handler subroutine MSISA DEF *+1 MSIS NOP LDA FSS get error status SZA,RSS if not zero skip JMP NOFSE jump if no error ZEROE CLA JMP MSIS,I return 0 to reader FTBER LDA EOFE file-too-big error STA FSS JMP ZEROE NOFSE LDB RBUFF get read buffer number ADB FSA add to file size array start LDA 1,I get filesize STA FS save it LDB RBUFF get read buffer number ADB FPA add to FPA location LDA 1,I get byte pointer STA BP save it * detect end of file LDA FS A = filesize LDB BP B = byte ptr JSB COMPW compare words, make A=1 if A > B SZA,RSS skip if A > B (normal JMP FTBER error if filesize <= byte ptr * get word containing byte from alt * this isn't exactly efficient LDA RBUFF get read buffer number INA increment it JSB USPAC switch in proper buffer CLA,INA put a 1 in A CAX copy A to X, count=1 LDA BP get byte pointer CLE,ERA turn into word pointer (/2) ADA TWO add 2 for offset for source in A LDB FWA destination - address of FW MWF move word from alt to FW CLA JSB USPAC restore normal alt memory LDA BP get file pointer AND ONE isolate bit one SZA skip if 0, even JMP MSIOD jump if 1, odd * even addresses point to high word LDA FW ALF,ALF swap bytes STA FB JMP MSIEX * odd addresses point to low word MSIOD LDA FW STA FB don't swap bytes * increment file pointer and return byte MSIEX LDB RBUFF get read buffer number ADB FPA add to FPA location for addr LDA BP get current file pointer INA increment it STA 1,I update FPA entry LDA FB get result byte in A AND C377 mask off junk in high word JMP MSIS,I exit subroutine END ; ; buffer >FILE - redirects MS output to a buffered file for writing ; ; Places pointer to internal sub in location ZMOUT (predefined) ; If MSBOUT MSWOUT MS$OUT MSCRLF etc used then calls internal sub ; for each byte written. The buffer parm must refer to an open ; file, if not sets FSS to 10 (file not open). If buffer number ; is not 0-3 returns FSS=177777 (prog err). In all cases the ; internal sub is connected but if error occurs won't do anything. ; ; The internal MS output handler subroutine first saves A, the byte ; to write, then checks FSS, if error exits without doing anything. ; DMS status is checked, must be 120000 otherwise exits, setting FSS ; to 11 (DMS error). Size/pointer is obtained from the FSA and FPA ; zp arrays, and word containing the byte obtained from the buffer. ; The pointer must be less than 177774 or exits with FSS=601 (EOF) ; If pointer is even, puts byte to write in high byte, else low byte, ; then word is written back to the buffer in alt mem. Restores normal ; alt and increments pointer, writing back to FPA. If pointer value ; (after inc) exceeds filesize, makes filesize=pointer and writes that ; back to file size array. ; CREATE >FILE /K JSB ZSPOP,I pop buffer# off stack STA WBUFF save in write buffer number var * reuses subs and vars from B set A to 1 SZA,RSS skip if A not zero JMP MSOS,I exit if BP<=size LDB WBUFF get buffer number ADB FSA get address of size entry LDA BP get pointer STA 1,I store in FSA array JMP MSOS,I exit sub END ; ; x y UCOMP - pushes 1 if x > y else pushes 0 (unsigned comparison) ; Any comparisons done to byte pointers that exceed 32K must use ; this or other unsigned methods, this makes it easy... ; (ptr) (maxptr) UCOMP IFNZ "too big" etc ; CREATE UCOMP /K JSB ZSPOP,I STA CWRB JSB ZSPOP,I LDB CWRB JSB COMPW JSB ZSPSH,I END ;------------------------------------------------------ ; the following code was scarfed from XDOS ; uncomment below if XDOS is NOT loaded.... ;CONSTANT WKBUF 66000 ;; 16Pad - pads string on stack to exactly 16 characters ;DEFINE 16Pad ;20 40 $CREATE $CAT #0 17 $SLICE $SWAP $DROP ;space-pad string ;END ;;"name" address FindEntry - pushes address of entry if it exists ;;if entry doesn't exist pushes 0 ;;matches the 1st 8 words on 16 word boundaries for searching ;;SFS-style directory and volume blocks ;DEFINE FindEntry ;DUP 1777 ADD S>Z ;put last valid address onto Z stack ;16PAD ;space-pad string (modified to use sub) ;$ADR ;push address of string ;SWAP ;swap with address ptr ;DO ;until match is found or no more entries to look at ; DUP ;pointer for test ; Z>S DUP S>Z SWAP SUB IF<0 ;if past the end ; DROP ;mem ptr ; DROP ;address of string ; $DROP ;name string ; #0 ;return 0 for failure ; #1 ;terminate loop ; ELSE ; ;see if first two chars match.. (str adr, mem ptr on stack) ; OVER GET ;push 1st word of string ; OVER GET ;push 1st word of mem entry ; SUB IFNZ ;if they don't match ; 20 ADD ;next entry ; #0 ;keep looking ; ELSE ;check the remaining 7 words.. ; #1 S>Y ;flag on Y, any mismatch clears ; #1 7 +DO ;loop 7 times ; OVER INDEX ADD GET ;push word from string ; OVER INDEX ADD GET ;push word from mem ; SUB IFNZ Y>S DROP #0 S>Y ENDIF ;clear flag if not equal ; +LOOP ; Y>S ;get flag ; IFZ ;if no match.. ; 20 ADD #0 ;next entry ; ELSE ;found it! ; SWAP DROP ;string address ; $DROP ;string ; #1 ;stop looping ; ;leaving entry address on stack ; ENDIF ; ENDIF ; ENDIF ;UNTIL ;Z>S DROP ;clean up Z stack ;END ;------- end stuff swiped from XDOS ------- ; CONSTANT FSS 214 CONSTANT CWA 200 VARIABLE LAA 4 VARIABLE RAA 4 CONSTANT FPA 204 CONSTANT FSA 210 VARIABLE FCA 4 VARIABLE FNA 4 VARIABLE DNA 4 VARIABLE VNA 4 VARIABLE NDEA 4 VARIABLE DBLA 4 VARIABLE DBHA 4 VARIABLE FSLA 4 VARIABLE FSHA 4 ; ; SFS-specific subwords... ; ; buffer DupCheck - pushes 0 if all ok, 1 if a file is already open ; in another buffer. Compares drive number, vol number and file number. ; This is called by OPEN/REOPEN and DEL - shouldn't be able to delete ; a file that's open by something else. OK I see why Bob specified that ; only one file in one volume can be open... but wouldn't enforcing ; that take just about as much code? almost the same kind of test. ; Notes... uses hard-coded ZP memory 215-217 for temps ; triggers if bit 0 of CW=1 so don't set busy before calling to ; avoid detecting your own file, no code added to skip self. ; DEFINE DupCheck 215 OVER DNA ADD GET PUT ;put drive number entry in 215 216 OVER VNA ADD GET PUT ;put volume number entry in 216 217 OVER FNA ADD GET PUT ;put file number entry in 217 DROP ;got specifics so drop buffer number #0 ;push zero instead for return. If dup detected make it 1. #0 3 +DO ;4 buffers to check CWA INDEX ADD GET #1 AND IFNZ ;if bit 0 of CW is 1 then DNA INDEX ADD GET 215 GET SUB IFZ ;if drive number is the same VNA INDEX ADD GET 216 GET SUB IFZ ;if volume number is the same FNA INDEX ADD GET 217 GET SUB IFZ ;if file number is the same DROP #1 ;make the 0 on the stack a 1, duplicate detected ENDIF ENDIF ENDIF ENDIF +LOOP END ; ; SCDRV - Save Current DRV value to location 220 ; DEFINE SCDRV 220 DRV GET PUT END ; ; RCDRV - Restore Current DRV to contents of location 220 ; DEFINE RCDRV DRV 220 GET PUT END ; ; n ChkBuf - Check Buffer number ; If n is between 0 and 3, pushes 0 and exits otherwise ; pushes 1 for error, prints "Bad buffer number" and sets ; FSS var to 177777 to indicate programming error. ; DEFINE ChkBuf 177774 AND IFNZ "Bad buffer number" $PRINT #1 FSS 177777 PUT ELSE #0 ;buffer number ok ENDIF END ; ; ChkDMS - if DMS enabled pushes 0 else pushes 1 and prints error message ; Sets FSS to 11 if error. ; DEFINE ChkDMS DMSTATUS 077777 AND ;ignore bit 15 20000 SUB IFNZ "DMS not enabled" $PRINT #1 FSS 11 PUT ELSE #0 ENDIF END ; ; "volname" buffer drive DIRECTORY - (re)loads a directory block for a buffer ; CWA entry for buffer must not have bit 0 set or returns FSS error 12 (busy). ; FSS error 11 if DMS not enabled, FSS error 177777 if bad buffer number, ; FSS error 004XXX if read error, FSS error 000001 if volume not found. ; FSS error 171717 if buffer memory bad ; ; Uses z.p. location 221 for temp. ; DEFINE DIRECTORY ChkDMS IFNZ ;if DMS not enabled DROP DROP $DROP ELSE OVER ChkBuf IFNZ ;if bad buffer DROP DROP $DROP ELSE SCDRV ;save current drive number DUP CHDRV ;change to specified drive ; I tried to use SPAGE to trick R-1K W-1K etc into accessing VM, didn't work ; going for plan B, read the block and C>ACOPY where it belongs #0 6 SBLA WKBUF R-1K ;read volume index into work buffer Z ;save ptr to Z, now buffer, drive on stack OVER DNA ADD OVER PUT ;update DNA entry OVER VNA ADD ;push VNA entry address Z>S DUP S>Z WKBUF SUB 20 DIV ;push entry number PUT ;update VNA entry DROP ;don't need drive number any more ;buffer number on stack Z>S ;push back mem pointer 13 ADD ;point to #entries in dir OVER NDEA ADD ;push NDEA entry address OVER GET PUT ;push NDE value and put INC OVER DBLA ADD OVER GET PUT ;do DBLA INC OVER DBHA ADD OVER GET PUT ;do DBHA INC OVER FSLA ADD OVER GET PUT ;do FSLA INC OVER FSHA ADD OVER GET PUT ;do FSHA DROP ;memptr, buffer# still on stack DUP DBHA ADD GET ;push dir block high OVER DBLA ADD GET ;push dir block low SBLA WKBUF R-1K ;read directory block ACOPY ;write 171717 to buffer loc 2000 2000 221 #1 A>CCOPY ;read back into temp loc 221 GET FSS GET SUB IFZ ;if memory good... WKBUF 2000 2000 C>ACOPY ;put in alt mem CWA ADD 2 PUT ;CW=directory loaded (pop buffer#) FSS #0 PUT ;no error ELSE ;memory bad CWA ADD #0 PUT ;CW = 0 (pop buffer#) "Memory Bad! " $PRINT ENDIF #0 USPACE ;restore normal altmem ENDIF ;dir block error ENDIF ;volume not found ENDIF ;buffer busy error ENDIF ;read error RCDRV ;restore current drive ENDIF ;buffer number error ENDIF ;DMS error END ; ; "filename" buffer REOPEN - opens a file into a buffer at last access point ; FSS error 11 if DMS not enabled, error 13 if dir not loaded, ; error 2 if file not found, error 14 if already open in another buffer, ; error 177777 if buffer invalid or other error. ; DEFINE REOPEN ChkDMS IFNZ ;if DMS not enabled DROP $DROP ELSE DUP ChkBuf IFNZ ;if buffer number not 0-3 then DROP $DROP ELSE DUP CWA ADD GET ;get CW entry 2 SUB IFNZ ;if not = 2 (dir block loaded) then "Dir not loaded" $PRINT DROP $DROP ;buffer#, filename FSS 13 PUT ;dir not loaded error ELSE SCDRV ;save current drive number DUP DNA ADD GET CHDRV ;change to drive specified by drive number array DUP INC USPACE ;set altmem to specified buffer 2000 WKBUF 2000 A>CCOPY ;get dir block into work buffer WKBUF FindEntry ;search for file DUP IFZ ;if not found "Not found" $PRINT DROP DROP ;0 ptr, buffer# FSS 2 PUT ;file not found error ELSE ;file was found ;buffer#, memptr on stack OVER CWA ADD #0 PUT ;clear CWA entry until file loaded (in case of failure) FSS 177777 PUT ;prog error until cleared ;update FNA LAA RAA FPA FSA FCA entries... DUP WKBUF SUB 20 DIV ;push entry number SWAP S>Z ;stash memptr on Z ; buffer#, entry# on stack OVER FNA ADD SWAP PUT ;update FNA entry, pop entry# Z>S ;push memptr 13 ADD ;point it to load address OVER LAA ADD OVER GET PUT ;update LAA INC OVER RAA ADD OVER GET PUT ;update RAA INC OVER FPA ADD OVER GET PUT ;update FPA INC OVER FSA ADD OVER GET PUT ;update FSA INC OVER FCA ADD OVER GET PUT ;update FCA DROP ;memptr ;ensure file isn't open in another buffer... DUP DupCheck IFNZ ;if duplicate detected "Already open" $PRINT DROP ;buffer #, leave buffer free FSS 14 PUT ;file open error ELSE ;buffer# on stack DUP S>Z ;stash dup on Z DUP FSHA ADD GET ;push filespace high OVER FSLA ADD GET ;push filespace low #0 ;push a zero Z>S FNA ADD GET ;push file number (popping Z) 40 MUL ;turn into file offset DADD ;form block address of file SBLA ;seek to file ; optimized open, less reads for small files ; DUP FSA ADD GET ;push size in bytes ; ;not wasting code for 0-byte files, always read at least 1 block ; 4000 DIV ;turn byte size into # blocks (2048 bytes per 1KW block) ; DUP ;save top block to clear next block ; #0 SWAP +DO ;loop for all blocks in file (skipping blocks past end) ; WKBUF R-1K ;read next block of file into work buffer ; WKBUF ;push source, work buffer ; INDEX 2000 MUL 2 ADD ;push dest, location in alt mem ; 2000 INDEX 37 SUB IFZ DROP 1776 ENDIF ;push 2000 or 1776 if last ; C>ACOPY ;put in alt mem ; +LOOP ;until all blocks copied to buffer ; but can cause problems with recovery utilities unless additional ; code is added to ensure there's always zeros after the file data. ; The following always loads 32 blocks into the buffer... #0 37 +DO ;loop through all 32 blocks WKBUF R-1K ;read next block of file into work buffer WKBUF ;push source, work buffer INDEX 2000 MUL 2 ADD ;push dest, location in alt mem 2000 INDEX 37 SUB IFZ DROP 1776 ENDIF ;push 2000 or 1776 if last C>ACOPY ;put in alt mem +LOOP ;until all blocks copied to buffer ; 177773 then "Too big" $PRINT FSS 601 PUT ELSE OVER CWA ADD GET #1 AND IFZ ;if file isn't open "Not open" $PRINT FSS 10 PUT ;file not open error ELSE OVER FPA ADD OVER PUT ;write to FPA, leave buffer#, bytepos on stack FSS #0 PUT ;successful ENDIF ;file not open error ENDIF ;too big error ENDIF ;buffer number error DROP DROP ;buffer and bytepos END ; ; buffer DirUpdate - updates a modified directory block by writing ; to disk, also updating any buffered copies of the directory. The ; new dir block must already be in WKBUF. When done dir block will ; be in specified buffer with directory-loaded flag set. ; This allows multiple files to be opened in the same directory ; without causing consistency problems. Called by CLOSE DEL CNF ; and anything else that updates a directory (in SFS anyway...) ; If directory in WKBUF appears to be invalid then sets FSS to 16, ; prints an error message and exits without writing data. ; If buffer number invalid then sets FSS to 177777 with err msg. ; If DMS is not enabled then sets FSS to 11 with err msg. ; IF CWA(buffer)=0 then sets FSS to 13 with err msg. ; Note... this sub does Not preserve current DRV, it is up to ; the calling word to SCDRV/RCDRV. Does restore USPACE 0 for safety. ; ; Uses zp locations 221-224, hard-coded. ; DEFINE DirUpdate ChkDMS IFNZ DROP ELSE ;if DMS enabled DUP ChkBuf IFNZ DROP ELSE ;if buffer number correct DUP CWA ADD GET IFZ ;if CW entry is zero "Buffer error" $PRINT DROP FSS 177777 PUT ;drop buffer number, programmer error ELSE #0 ;push validate flag WKBUF GET IFZ DROP #1 ENDIF ;error if 1st word is 0 ;SFS can begin with a zero'd directory block but by the time ;it gets here there has to be either an entry or deleted entry ;8/1/08 - added optional check for all zero entries.. disabled ;by default as DirUpdate is not a user-callable function. Having ;this check would do nothing for preventing memory error, since ;even if read back blank the new entry will still be present. ;Modified mem check to flag if either bit 7 or bit 15 set. ; #0 S>Z ;non-zero count on Z stack OVER NDEA ADD GET DEC #0 SWAP +DO ;loop thru all entries INDEX 20 MUL WKBUF ADD GET ;push first word of dir entry ; DUP IFNZ Z>S INC S>Z ENDIF ;if non-zero increment non-zero count 100200 AND IFNZ INC ENDIF ;if bit 15 or bit 7 set flag error +LOOP ; Z>S IFZ INC ENDIF ;if all zeros flag error IFNZ ;if error "Dir corrupt!" $PRINT FSS 16 PUT DROP ELSE ;buffer# on stack 221 OVER DBLA ADD GET PUT ;set 221 to dirblock low 222 OVER DBHA ADD GET PUT ;set 222 to dirblock high 223 OVER DNA ADD GET PUT ;set 223 to drive number 224 OVER VNA ADD GET PUT ;set 224 to volume number #0 ;error flag to check dirblock, set to 1 if H/L=0.. 221 GET IFZ 222 GET IFZ DROP #1 ENDIF ENDIF IFNZ ;if dir loc 0 then bad error... DROP FSS 177777 PUT "Bad error" $PRINT ELSE ;should be safe now... CWA ADD 2 PUT ;set dir loaded bit, pop buffer# #0 3 +DO ;loop thru all buffers CWA INDEX ADD GET 2 SUB IFZ ;if CW entry = 2 (dir loaded) DNA INDEX ADD GET 223 GET SUB IFZ ;if drive number matches VNA INDEX ADD GET 224 GET SUB IFZ ;if volume number matches INDEX INC USPACE ;set alt to that buffer WKBUF 2000 2000 C>ACOPY ;copy dir block to buffer ENDIF ;vol match ENDIF ;drive match ENDIF ;CW entry 2 +LOOP ;next buffer #0 USPACE ;restore normal alt ;write directory to disk 223 GET CHDRV ;change to drive containing directory 222 GET 221 GET SBLA ;seek to directory Z ;push dir slot # to Z DUP FSHA ADD GET ;push filespace high OVER FSLA ADD GET ;push filespace low #0 Z>S 40 MUL DADD ;calculate file location SBLA ;seek to it consuming location words CCOPY ;to work buffer WKBUF W-1K ;write to disk +LOOP #0 USPACE ;back to normal alt FILE to redirect MS output and write to MS. ; DEFINE CNF ChkDMS IFNZ DROP $DROP ELSE ;DMS must be enabled DUP ChkBuf IFNZ DROP $DROP ELSE ;buffer number must be valid DUP CWA ADD GET 2 SUB IFNZ ;if dir not loaded "Dir not loaded" $PRINT DROP $DROP FSS 13 PUT ;error ELSE DUP INC USPACE ;set alt to buffer 2000 WKBUF 2000 A>CCOPY ;get dir block into work buffer #0 USPACE ;restore normal alt $DUP WKBUF FindEntry ;search for filename IFNZ ;if found "Already exists" $PRINT DROP $DROP FSS 15 PUT ELSE ;look for a place to create file... -1 ;new entry # OVER NDEA ADD GET DEC #0 SWAP +DO ;loop thru all entries INDEX 20 MUL WKBUF ADD GET ;get 1st word of entry CASE = 0 #1 = 20040 #1 DEFAULT #0 ENDCASE ;push 1 if 0 or 20040 IFNZ DUP IF<0 DROP INDEX ENDIF ENDIF ;set to first available +LOOP ;buffer #, entry # on stack DUP IF<0 ;if no room in dir "Dir full" $PRINT $DROP DROP DROP FSS 602 PUT ELSE DUP S>Z ;save entry # on Z 20 MUL WKBUF ADD ;turn entry# into address 16Pad ;space pad filename $ADR ;push address of string #0 7 +DO ;loop for 8 words OVER INDEX ADD ;push dest address OVER INDEX ADD GET ;push word from string PUT ;write filename +LOOP DROP $DROP ;string address and string 13 17 +DO ;loop thru numbers DUP INDEX ADD #0 PUT ;clear numbers +LOOP DROP ;entry address, buffer # still on stack ;new entry created in dir in WKBUF, update it... FSS #0 PUT ;clear leftover errors from prev operations SCDRV ;save current DRV DUP DirUpdate ;write new directory back to buffer(s) and disk FSS GET IFNZ ;if error DROP ;buffer Z>S DROP ;clean up Z ELSE DUP DNA ADD GET CHDRV ;change to proper drive (shouldn't have to) DUP FSHA ADD GET ;push filespace high OVER FSLA ADD GET ;push filespace low #0 Z>S 40 MUL ;push offset (conv to 32 bit) DADD ;double-add to get starting block of file SBLA ;seek to it CCOPY ;get dir block into work buffer #0 USPACE ;restore normal alt WKBUF FindEntry ;search for entry in work buffer DUP IFZ ;if file not found "Not found" $PRINT FSS 2 PUT DROP DROP ELSE ;file found, buffer#, memptr on stack 20040 PUT ;write spaces to filename, popping memptr DirUpdate ;write updated directory to all, popping buffer# FSS #0 PUT ;successful ENDIF ;file found RCDRV ;restore current DRV ENDIF ;dir loaded ENDIF ;buffer number valid ENDIF ;DMS enabled END ; ; srcbuffer destbuffer BCOPY - copies one buffer to another ; both buffers buffers must be open files, CWA(x)=xxxxx1 ; FSS must be zero on entry, updates LAA RAA FSA FPA FCA OCTAL DEFINE BCOPY ChkDMS IFZ ;if DMS enabled DUP ChkBuf DROP OVER ChkBuf DROP ;check buffer numbers FSS GET IFZ ;if no error (or prev errors) DUP CWA ADD GET #1 AND IFZ ;if dest not open "Dest not open" $PRINT FSS 177777 PUT ELSE OVER CWA ADD GET #1 AND IFZ ;if source not open "Src not open" $PRINT FSS 177777 PUT ELSE #0 37 +DO ;copy 32 1KW blocks OVER INC USPACE ;select source buffer INDEX 2000 MUL 2 ADD ;push source address WKBUF ;push destination address 2000 INDEX 37 SUB IFZ DROP 1776 ENDIF ;push #words A>CCOPY ;copy file buffer to work buffer DUP INC USPACE ;select destination buffer WKBUF ;push source address INDEX 2000 MUL 2 ADD ;push destination address 2000 INDEX 37 SUB IFZ DROP 1776 ENDIF ;push #words C>ACOPY ;copy work buffer to file buffer +LOOP #0 USPACE ;restore normal alt map OVER LAA ADD GET OVER LAA ADD SWAP PUT ;copy LAA OVER RAA ADD GET OVER RAA ADD SWAP PUT ;copy RAA OVER FSA ADD GET OVER FSA ADD SWAP PUT ;copy FSA OVER FPA ADD GET OVER FPA ADD SWAP PUT ;copy FPA OVER FCA ADD GET OVER FCA ADD SWAP PUT ;copy FCA DUP CWA ADD 11 PUT ;set destination dirty flag ENDIF ENDIF ENDIF ENDIF DROP DROP ;dest src buffer numbers END ; ; buffer RELEASE - set CW entry of buffer to 0, releasing buffer ; FSS set to 177777 if buffer number invalid. If used on open ; files then abandons all changes including last access pointer. ; DEFINE RELEASE DUP ChkBuf IFNZ DROP ELSE ;if bad buffer drop buffer number else CWA ADD #0 PUT ;add CWA address to buffer number and clear CW ENDIF END ; ; ?SFS - prints SFS status ; DEFINE ?SFS "FSS: " $PRINT FSS GET PNUM ;print FSS value " CW Drive Volume File Size Ptr" $PRINT CRLF #0 3 +DO ;loop thru all buffers "Buffer " $PRINT #0 INDEX $DSTR $PRINT ": " $PRINT INDEX CWA ADD GET DUP PNUM IFNZ ;if buffer in use INDEX DNA ADD GET PNUM ;print drive# INDEX VNA ADD GET PNUM ;print vol# INDEX CWA ADD GET 1 AND IFNZ ;if a file INDEX FNA ADD GET PNUM ;print file# INDEX FSA ADD GET PNUM ;print buffer file size INDEX FPA ADD GET PNUM ;print buffer pointer ENDIF ENDIF INDEX 3 SUB IFNZ CRLF ENDIF +LOOP END ; ; -SFS - effectively turns SFS off, all open files are abandoned. ; DEFINE -SFS "Shutting down SFS " $PRINT #0 3 +DO INDEX RELEASE +LOOP ;release all buffers END ;------------------------------------------------------------------ CONSOLE ; ; Changes... ; 8/1/08 Version 0.71 - modified DIRECTORY to fail if buffer memory ; isn't present, altered corruption detection code in DirUpdate. ; 3/7/06 placed FILE first to ease prediction of page errors ; 8/13/05 Version 0.70 - added BCOPY (was in utils package) ; 5/29/05 Version 0.69 - added LAA and RAA arrays, modified open/close to ; use them, fixed ChkDMS to allow SFS commands to work from !startup words ; 5/26/05 Version 0.68 - fixed FILE bug, added ?SFS size/ptr info ; 5/15/05 Version 0.67 - comments, added ?SFS ; 5/11/05 Version 0.66 - initial release