"Loading XDOS Version 1.27" $PRINT CRLF
;created 4/23/05 last mod 9/29/07
;requires dms.ipl, disk.ipl, [driver].ipl
;requires PRESET, added to HP-IPL/OS' 1.11 create.ipl
;
;Volume functions...
;WKBUF         constant defining work buffer
;XCV           variable defining current volume number for XDOS
;$VOL          pushes string containing current volume name
;MKVOL         makes a new volume.. "vol" MKVOL
;FindEntry     subroutine that finds an entry in vol/dir table
;16Pad         subroutine that pads string to 16 characters
;ChkSFS        subroutine that detects buffered SFS dirs or modified files
;DELVOL        deletes a volume.. "vol" DELVOL (confirms)
;RENVOL        renames a volume.. "vol" "newname" RENVOL
;CHVOL         changes XCV to new current volume.. "vol" CHVOL
;LSVOL         lists volume index
;File functions... (operate on current volume defined by XCV)
;VolInfo       5 word array containing current volume specs (after GetVol)
;DirInfo       6 word array containing directory specs (after GetFile)
;GetVol        reads volume index and updates VolInfo
;GetFile       finds existing file and updates DirInfo, returns start block
;PutFile       creates new dir entry from DirInfo, returns start block
;ZAM           zero alternate memory, useful for importing/creating files
;AM2F          copy alt memory to a new file.. "file" bytes AM2F
;F2AM          copy file to alt memory.. "file" F2AM
;XSAVE         save current system to a new file (size 62KB).. "file" XSAVE
;XLOAD         load an ipl or system binary file.. "file" XLOAD
;XSHOW         show file on screen, if LA is not 0 (text) then hexdumps file
;XDIR          lists current volume name and the files it contains
;XREN          renames a file.. "file" "newname" XREN
;XDEL          deletes a file.. "file" XDEL (confirms)
;
;Disk layout specs... (octal numbers, blocks are 1KW)
;Blocks 0 to 5        bootext code for 7900 etc drives
;Block 6              volume index
;Block 7              directory for volume 0
;Blocks 10-46         31K system binary for booting
;Blocks 47-106        vol 0 file 0
;....
;Blocks 4007-4046     vol 0 file 63 dec
;Block 4047           directory for volume 1
;Blocks 4050-10047    next 64 dec files
;Block 10050          directory for volume 2
;Blocks 10051-14050   next 64 dec files
;.... etc
;The only fixed locations are the volume index in block 6
;and the boot binary in blocks 10-46, everything else is
;defined by the numbers in block 6 as initialized. The above
;layout is recommended for large disks and created by XINIT.
;Smaller disks can be formatted for less files per directory
;to permit use of volumes, XI79 formats a 7900 like...
;Blocks 0-46 same as above
;Blocks 47-106        vol 0 file 0
;...
;Blocks 607-646       vol 0 file 11 dec
;Blocks 647-1446      vol 1 file space
;Blocks 1447-2246     vol 2 file space
;Block 2247           vol 1 directory
;Block 2250           vol 2 directory
;
;The volume index table contains 64 entries of 16 words each...
;word offset 0-7 contain a 16-character space-padded volume name
;word offset 13 octal contains Size of Directory Block (how many files max)
;word offset 14 octal contains Directory Block Pointer Low
;word offset 15 octal contains Directory Block Pointer High
;word offset 16 octal contains File Space Pointer Low
;word offset 17 octal contains File Space Pointer High
;
;A volume entry name that begins with 0 marks the end of useable
;disk space. Unused or deleted entries have spaces in at least
;the first two characters of the volume name.
;
;Each directory block has 64 entries of 16 words each...
;word offset 0-7 contain a 16-character space-padded file name
;word offset 13 octal contains the binary file load address
;word offset 14 octal contains the binary file run address
;word offset 15 octal contains the Last Access Pointer
;word offset 16 octal contains the File Length in bytes
;word offset 17 octal contains the File Control Word (not specified yet)
;
;Unused or deleted directory entries can be zero or spaces,
;to permit starting with an all-zero directory block.
;
;---------------------------------------
"Constant WKBUF, Variable XCV" $PRINT CRLF
OCTAL CONSTANT WKBUF 66000
VARIABLE XCV
XCV #0 PUT    ;start in volume 0
;---------------------------------------
"Loading 16Pad" $PRINT CRLF
DEFINE 16Pad
20 40 $CREATE $CAT #0 17 $SLICE $SWAP $DROP ;space-pad string
END
;---------------------------------------
"Loading ChkSFS" $PRINT CRLF
; pushes 1 if SFS is buffering directories or modified files
; else pushes 0 if safe to do direct manipulations
; (except to the open file of course, just don't do it)
DEFINE ChkSFS
#0 ;push a 0
200 203 +DO
 #1 INDEX GET SUB IF<0 ;if any CWA numbers are >=2
  DROP #1 ;make the 0 a 1
 ENDIF 
+LOOP
DUP IFNZ
 "SFS running" $PRINT
ENDIF
END
;---------------------------------------
"Loading MKVOL" $PRINT CRLF
; MKVOL - finds the first vol index entry that begins
; with spaces, then names it and creates an empty directory
; usage: "name" MKVOL
DEFINE MKVOL
ChkSFS IFNZ ;if SFS running
 $DROP      ;don't run
ELSE
 16Pad ;space-pad string
 #0 6 SBLA WKBUF R-1K    ;read in volume index table
 <IDE IFNZ               ;get interface status
  "Disk read error" $PRINT $DROP
 ELSE
  ; find first entry containing space, if none available
  ; print Disk Full otherwise make the entry and dir block
  WKBUF  ;push mem pointer
  DO  ;until entry found or no more entries
   DUP GET IFZ ;if offset 0 is 0 then out of entries
    "Index full" $PRINT ;print error message
    DROP $DROP #1 ;remove ptr and name, terminate until loop
   ELSE
    DUP WKBUF 1777 ADD SWAP SUB IF<0 ;if past last entry
     "Index full" $PRINT ;print error message
     DROP $DROP #1 ;remove ptr and name, terminate until loop
    ELSE
     DUP GET 20040 SUB IFZ ;if entry begins with space
      ;found an empty entry, fill it in
      #0 7 +DO ;loop for each word in name string
       DUP INDEX ADD ;push address of entry name word
       $ADR INDEX ADD GET ;push word from string
       PUT ;write to vol index entry (in mem)
      +LOOP
      $DROP ;don't need name string anymore
      #0 6 SBLA WKBUF W-1K   ;write updated volume index
      <IDE IFNZ              ;if error
       "Disk write error" $PRINT
       DROP ;mem pointer
      ELSE
       ;get location of directory block...
       DUP 15 ADD GET ;push dir ptr high
       SWAP 14 ADD GET ;push dir ptr low, removing ptr from stack
       "Clearing dir block " $PRINT OVER PNUM DUP PNUM
       SBLA ;seek to it, nothing left on stack
       WKBUF DUP 1777 ADD +DO INDEX #0 PUT +LOOP ;clear work buffer
       WKBUF W-1K ;write work buffer to disk
       <IDE IFNZ " error" $PRINT ENDIF
      ENDIF
      #1 ;terminate until loop
     ELSE
      20 ADD ;point to next entry
      #0 ;keep looping
     ENDIF
    ENDIF
   ENDIF
  UNTIL ;loop until
 ENDIF ;read error
ENDIF ;SFS error
END
;---------------------------------------
"Loading FindEntry" $PRINT CRLF
;"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
$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
;---------------------------------------
"Loading DELVOL" $PRINT CRLF
; "name" DELVOL - removes volume entry
DEFINE DELVOL
ChkSFS IFNZ ;if SFS running
 $DROP      ;don't run
ELSE
 "Delete volume " $PRINT $DUP $PRINT "? (Y/N) " $PRINT
 CHRIN "Y" $HEAD $DROP SUB CRLF IFNZ
  $DROP
 ELSE
  #0 6 SBLA WKBUF R-1K ;read volume index
  <IDE IFNZ ;if disk error
   "Disk read error" $PRINT
   $DROP ;name
  ELSE
   WKBUF FindEntry ;search for name
   DUP IFZ ;if not found
    "Not found" $PRINT
    DROP
   ELSE
    20040 PUT ;erase vol index entry
    #0 6 SBLA WKBUF W-1K ;write updated index
    <IDE IFNZ "Disk write error" ELSE "Done" ENDIF
    $PRINT
   ENDIF
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading RENVOL" $PRINT CRLF
;"oldname" "newname" RENVOL - renames volume
DEFINE RENVOL
ChkSFS IFNZ ;if SFS running
 $DROP $DROP ;don't run
ELSE
 $SWAP "Renaming " $PRINT $DUP $PRINT " to " $PRINT
 $SWAP $DUP $PRINT $SWAP
 ;newname, oldname on X
 #0 6 SBLA WKBUF R-1K <IDE IFNZ
  CRLF "Disk read error" $PRINT $DROP $DROP
 ELSE
  WKBUF FindEntry
  DUP IFZ
   CRLF "Not found" $PRINT
   DROP $DROP
  ELSE
   16Pad ;space-pad string
   $ADR ;push address of string
   ;entry address, string address on stack
   #0 7 +DO  ;copy 8 words
    OVER INDEX ADD ;push entry word address
    OVER INDEX ADD GET ;push string word
    PUT ;overwrite name with new name
   +LOOP
   DROP DROP $DROP ;string/entry addresses, name string
   #0 6 SBLA WKBUF W-1K
   <IDE IFNZ "Disk write error" ELSE "Done" ENDIF
   CRLF $PRINT
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading CHVOL" $PRINT CRLF
;"name" CHVOL - sets current volume
DEFINE CHVOL
#0 6 SBLA WKBUF R-1K <IDE IFNZ
 "Disk read error" $PRINT $DROP
ELSE
 WKBUF FindEntry DUP IFZ
  "Not found" $PRINT DROP
 ELSE
  WKBUF SUB 20 DIV ;turn into volume number
  XCV SWAP PUT     ;set current volume
 ENDIF
ENDIF
END
;---------------------------------------
"Loading LSVOL" $PRINT CRLF
;LSVOL - list volume index table
DEFINE LSVOL
#0 6 SBLA WKBUF R-1K <IDE IFNZ
 "Disk read error" $PRINT
ELSE
 "Name              Size   DB_lo  DB_hi  FS_lo  FS_hi" $PRINT
 #0 77 +DO  ;loop for each entry
  INDEX 20 MUL WKBUF ADD ;push entry address
  DUP GET IFNZ
   DUP GET 20040 SUB IFNZ
    CRLF
    #0 7 +DO  ;loop for each word in name
     DUP INDEX ADD GET PWRD ;print double-char
    +LOOP
    "  " $PRINT
    13 ADD DUP GET PNUM ;print #dir entries
    INC DUP GET PNUM ;print dir block low
    INC DUP GET PNUM ;print dir block high
    INC DUP GET PNUM ;print filespace low
    INC DUP GET PNUM ;print filespace high
   ENDIF
  ENDIF
  DROP ;mem pointer
 +LOOP 
ENDIF
END
;---------------------------------------
"Variables VolInfo and DirInfo" $PRINT CRLF
VARIABLE VolInfo 5
VARIABLE DirInfo 6
; VolInfo contains dirsize, dir ptr low/high, file space low/high
; DirInfo contains LA RA LAP bytelength controlword entry#
;---------------------------------------
"Loading GetVol" $PRINT CRLF
;reads XCV variable and sets VolInfo array
;if error occurs first word of VolInfo is 0
DEFINE GetVol
#0 6 SBLA WKBUF R-1K ;read volume index
<IDE IFNZ
 VolInfo #0 PUT ;return error if disk error
ELSE
 XCV GET 20 MUL WKBUF ADD ;point to current volume
 DUP GET IFZ ;if zero entry
  DROP VolInfo #0 PUT ;drop ptr and return error
 ELSE
  DUP GET 20040 SUB IFZ ;if entry begins with spaces
   DROP VolInfo #0 PUT  ;error
  ELSE
   13 ADD ;point to good stuff
   #0 4 +DO ;loop 5 times
    VolInfo INDEX ADD
    OVER INDEX ADD GET PUT ;copy vol entry data to VolInfo
   +LOOP
   DROP
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading GetFile" $PRINT CRLF
;finds a specific file specified by string on X
;if the file is found then updates DirInfo and pushes high/low
;location of the file and 1 for success. If the file is not found
;or other error occurs then pushes a single 0.
DEFINE GetFile
GetVol
VolInfo GET IFZ ;if volume error
 #0 ;push 0 for bummed
ELSE
 VolInfo 2 ADD GET ;push dir block high
 VolInfo 1 ADD GET ;push dir block low
 SBLA WKBUF R-1K   ;read directory block
 <IDE IFNZ #0 ELSE ;if error push 0 else
  WKBUF FindEntry  ;look for file
  DUP IFNZ ;if error return zero from FindEntry else
   ;update DirInfo (leave dir entry start on stack)
   DUP 13 ADD ;point to entry data
   #0 4 +DO
    DirInfo INDEX ADD
    OVER INDEX ADD GET PUT ;copy dir entry data to DirInfo
   +LOOP DROP
   ;infer file block offset from directory entry location
   WKBUF SUB 20 DIV ;get offset number
   DirInfo 5 ADD OVER PUT ;stash in DirInfo
   40 MUL ;get block offset
   #0 SWAP ;make it a 32 bit quantity
   VolInfo 4 ADD GET ;push filespace high
   VolInfo 3 ADD GET ;push filespace low
   DADD ;add to offset
   #1   ;push 1 for success
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading PutFile" $PRINT CRLF
;"filename" NewFile - creates new directory entry using info in DirInfo
;if successful then updates directory, pushes new file location high/low,
;and pushes 1 for success. If error or if file already exists pushes 0.
DEFINE PutFile
GetVol
VolInfo GET IFZ ;if volume error
 $DROP #0 ;drop name string, push 0 for bummed
ELSE
 VolInfo 2 ADD GET ;push dir block high
 VolInfo 1 ADD GET ;push dir block low
 SBLA WKBUF R-1K   ;read directory block
 <IDE IFNZ #0 ELSE ;if error push 0 else
  $DUP WKBUF FindEntry  ;look for file, keep string
  IFNZ $DROP #0 ELSE ;if file exists drop string and push 0 for error
   ;look for a place to add the new file
   WKBUF ;mem ptr
   DO ;until slot found or no space for file
    DUP GET ;push 1st word of dir entry
    #0 OVER IFZ DROP #1 ENDIF ;push 1 if zero entry, 0 if not
    OVER 20040 SUB IFZ DROP #1 ENDIF ;replace with 1 if spaces
    SWAP DROP ;don't need 1st word anymore
    IFZ ;if not empty
     20 ADD ;point to next entry
     DUP ;dup ptr for test
     VolInfo GET 20 MUL DEC WKBUF ADD ;push end of dir mem
     SWAP SUB IF<0 ;if past the end of directory
      DROP ;mem ptr
      $DROP ;filename string
      #0 ;push a zero to indicate error 
      #1 ;get out of here
     ELSE
      #0 ;keep looping
     ENDIF
    ELSE ;found...
     16Pad ;space-pad string
     $ADR ;push address of string
     #0 7 +DO ;loop for 8 words
      OVER INDEX ADD ;push address of entry in mem
      OVER INDEX ADD GET ;get word from string
      PUT ;write string to mem
     +LOOP
     DROP ;string address
     DUP 13 ADD ;point to data (keep orig ptr to entry beginning)
     #0 4 +DO ;loop for 5 words
      DUP INDEX ADD ;push location in memory
      DirInfo INDEX ADD GET ;push data from DirInfo
      PUT ;write DirInfo to memory
     +LOOP
     DROP ;don't need offset ptr anymore
     $DROP ;filename string
     VolInfo 2 ADD GET ;push dir block high
     VolInfo 1 ADD GET ;push dir block low
     SBLA WKBUF W-1K   ;write updated directory block
     <IDE IFNZ ;if error
      DROP ;mem ptr
      #0   ;push 0 for error
      #1   ;push 1 to terminate     
     ELSE       ;if no error
      WKBUF SUB ;turn mem ptr into word offset
      20 DIV    ;turn into entry offset
      40 MUL    ;turn into block offset
      #0 SWAP   ;make 32 bit
      VolInfo 4 ADD GET ;push filespace high
      VolInfo 3 ADD GET ;push filespace low
      DADD ;add to offset
      #1 ;push 1 for success
      #1 ;push 1 to terminate
     ENDIF
    ENDIF
   UNTIL ;slot found or no space for file
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading $VOL" $PRINT CRLF
;
; $VOL - pushes string containing current volume name
; always 16 chars long, no error-checking if invalid
; performs read of block 6 via GetVol, setting VolInfo entries
; If not valid 1st word of VolInfo will be zero
;
DEFINE $VOL
GetVol ;read volume index and set VolInfo to current dir
XCV GET 20 MUL WKBUF ADD ;point to current volume name
#0 7 +DO ;loop thru all chars of name
 DUP INDEX ADD GET ;push word from work buffer
 S>X ;push to X stack
+LOOP
DROP ;mem ptr
20 S>X ;string is 16 bytes long
11 S>X ;9 words including byte count
END
;---------------------------------------
"Loading ZAM" $PRINT CRLF
;ZAM - Zero Alternate Memory
DEFINE ZAM
WKBUF DUP 1777 ADD +DO INDEX #0 PUT +LOOP ;clear work buffer
#0 37 +DO ;32 blocks
 WKBUF           ;source
 INDEX 2000 MUL  ;dest
 DUP IFZ DROP 2 ENDIF ;if block 0 start at loc 2
 2000 C>ACOPY      ;copy 2000 octal words to alt
+LOOP
END
;---------------------------------------
"Loading AM2F" $PRINT CRLF
;"filename" bytes AM2F - save alt mem to file
DEFINE AM2F
ChkSFS IFNZ ;if SFS running
 $DROP DROP ;don't run
ELSE
 "Saving alt " $PRINT
 ;determine type by context, if loc 2 contains 124003
 ;then assume alt contains a system binary, otherwise
 ;set load/run addresses to zero, file length on stack
 2 DirInfo 1 A>CCOPY  ;get location 2 from alt mem
 DirInfo GET 124003 SUB IFZ 2 ELSE #0 ENDIF
 DirInfo OVER PUT      ;load address = 2 if bin, or 0
 DirInfo INC SWAP PUT  ;run address = 2 if bin, or 0
 DirInfo INC INC #0 PUT   ;last access = 0
 DirInfo 3 ADD OVER PUT   ;length = specified
 DirInfo 4 ADD #0 PUT     ;control = 0
 PutFile ;attempt to make new dir entry
 IFZ "error" $PRINT DROP ELSE
  ;bytelen, high/low block start of file on stack
  "to " $PRINT OVER PNUM DUP PNUM
  SBLA ;set block address to start of file
  ;bytelen on stack
  INC ;in case odd
  4000 DIV ;turn into #blocks
  2 ;mem ptr
  OVER #0 SWAP +DO ;loop for up to 32 dec 1KW blocks
   DUP ;push alt mem loc source
   WKBUF ;push destination
   2000 ;size of first 31 blocks
   INDEX 37 SUB IFZ DROP 1777 ENDIF ;size of last block
   A>CCOPY ;copy 1K to work buffer
   WKBUF W-1K ;write to disk
   2000 ADD ;increment mem ptr to next block
   "*" $PRINT
  +LOOP
  DROP ;mem ptr
  DROP ;block length
  <IDE IFNZ " error" $PRINT ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading F2AM" $PRINT CRLF
;"filename" F2AM - load alt mem from file
;DirInfo word 0 set to 177777 if error
DEFINE F2AM
"Loading alt mem: " $PRINT
ZAM ;clear alt mem
GetFile ;search for file
IFZ ;if not found or error..
 "not found" $PRINT
 DirInfo 177777 PUT ;indicate a failure
ELSE ;ok to load
 SBLA ;seek to file
 DirInfo 3 ADD GET ;byte size
 INC ;in case odd
 4000 DIV ;# blocks
 2    ;alt mem pointer
 OVER #0 SWAP +DO ;loop for 32 blocks
  WKBUF R-1K ;read 1KW of file
  WKBUF ;push source
  OVER  ;push destination
  2000 ;size of first 31 blocks
  INDEX 37 SUB IFZ DROP 1776 ENDIF ;size of last block
  C>ACOPY ;copy 1K to alt mem
  2000 ADD ;inc ptr to next block  
  "*" $PRINT
 +LOOP
 DROP ;alt mem ptr
 DROP ;#blocks
 <IDE IFNZ " error" $PRINT ENDIF
ENDIF
END
;---------------------------------------
"Loading XSAVE" $PRINT CRLF
;"filename" XSAVE - saves system to a system binary file
DEFINE XSAVE
ChkSFS IFNZ ;if SFS running
 $DROP      ;don't run
ELSE
 "Saving " $PRINT
 DirInfo 2 PUT            ;load address = 2
 DirInfo INC 2 PUT        ;run address = 2
 DirInfo 2 ADD #0 PUT     ;last access = 0
 DirInfo 3 ADD 174000 PUT ;length = 62KB
 DirInfo 4 ADD #0 PUT     ;control = 0
 PutFile ;attempt to make new dir entry
 IFZ "error" $PRINT ELSE
  ;high/low block start of file on stack
  "to " $PRINT OVER PNUM DUP PNUM
  SBLA ;set block address to start of file
  2 ;starting address
  #0 36 +DO ;loop for 31 dec 1KW blocks
   DUP W-1K 2000 ADD ;write block (driver must self-inc)
   "*" $PRINT
  +LOOP
  DROP ;pointer
  <IDE IFNZ " error" $PRINT ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading XLOAD" $PRINT CRLF
;"filename" XLOAD - whatever it is, loads it
DEFINE XLOAD
$DUP ;to preserve fn
GetFile ;search for file
IFZ "Not found" $PRINT $DROP ELSE
 DirInfo GET 2 SUB IFZ ;if it's a sys binary
  SBLA  ;seek to file
  "Loading system binary..." $PRINT CRLF
  ALTSAVE ;save current system to alt mem
  PRESET ;9/29/07 - PRESET instead of -IRQ
         ;removed code to do -TBG, this covers it
  LDFB ;seek to file and boot it (does not clear mem)
  ; no need to clean up stack
 ELSE
  DirInfo GET IFZ ;if it's text
   DROP DROP ;dont need to seek
   F2AM CRLF ;copy file to alt
   MS_SAVE 2 MSUSER <MS ;cause ipl to load
  ELSE
   DROP DROP $DROP
   "Unknown file type" $PRINT
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading XSHOW" $PRINT CRLF
;"filename" XSHOW - lists file to screen
DEFINE XSHOW
F2AM CRLF  ;load file into alt mem
"---- B F Q or space for next ---- " ;push prompt string
DirInfo GET IFZ ;load address 0 for text and no error
 MS_SAVE 2 MSUSER ;redirect MS to alt map loc 2
 #0 ;line counter
 DO
  MSBIN ;read from alt
  DUP PCHR
  13 SUB IF<0 INC ENDIF ;inc line count if <=LF
  DUP 27 SUB IFZ ;if 23 lines... (2/19/07 for 24 line terms)
   DROP #0
   $DUP $PRINT ;print prompt
   CHRIN CASE
   = 102 ;back to beginning...
   2 MSUSER CRLF   ;set pointer to 2
   = 106 ;skip forward 64 crlf's
   DROP 100 DO
    UPTR GET 77776 SUB IF<0  ;if pointer < max
     MSBIN 12 SUB IFZ DEC ENDIF ;get byte, if LF dec count
    ELSE DROP #0 ENDIF       ;else count=0 to terminate
   DUP WHILE CRLF
   = 121 ;quit...
   UPTR 77777 PUT      ;force pointer to max
   DEFAULT #0 42 +DO 4010 PWRD 40 PCHR +LOOP 10 PCHR ;erase prompt
   ENDCASE
  ENDIF
  UPTR GET 77776 SUB IF<0 #0 ELSE #1 ENDIF ;term. if >=end
 UNTIL
 MS_RESTORE DROP
ELSE
 DirInfo GET 177777 SUB IFNZ ;if not because of error
  ;dump alt mem as hex... (fixed 2/21/07)
  #0 ;alt mem ptr
  DO ;until quit
   DUP WKBUF 200 A>CCOPY ;copy 128 alt words to work buf
   WKBUF ;work buffer ptr
   #0 17 +DO ;do 16 dec lines at a time
    OVER $STR $HEAD DROP $PRINT ":" $PRINT
    #0 7 +DO ;do 8 words per line
     DUP INDEX ADD GET PNUM
    +LOOP
    SWAP 10 ADD SWAP ;inc alt-mem ptr
    10 ADD ;inc wkbuf ptr
    CRLF
   +LOOP
   DROP ;wkbuf ptr
   $DUP $PRINT ;print prompt
   CHRIN CASE
   = 102 DROP #0 #0 ;move to begining
   = 106 2000 ADD #0 ;move forward
   = 121 #1 ;quit
   DEFAULT #0 42 +DO 4010 PWRD 40 PCHR +LOOP 10 PCHR ;erase prompt
           #0 ;keep going
   ENDCASE
  UNTIL
  DROP ;alt mem pointer  
 ENDIF ;DirInfo error
ENDIF ;txt/bin test
$DROP ;prompt string
END
;---------------------------------------
"Loading XDIR" $PRINT CRLF
;XDIR - lists files in current directory block
DEFINE XDIR
$VOL ;read volume index and set VolInfo to current dir, push cv name
"Drive: " $PRINT DRV GET PNUM "    Volume: " $PRINT
VolInfo GET IFZ ;if something went wrong
 " invalid" $PRINT $DROP
ELSE
 $PRINT ;print drive and volume
 VolInfo INC INC GET ;push dirblock high
 VolInfo INC GET     ;push dirblock low
 SBLA WKBUF R-1K     ;read dirblock
 <IDE IFNZ ;if error..
  " error" $PRINT
 ELSE
  WKBUF ;push ptr
  #0 S>Y ;push printed-legend flag
  #0 VolInfo GET DEC +DO ;loop thru all dir entries
   DUP GET IFNZ ;if not zero
    DUP GET 20040 SUB IFNZ ;if not spaces
     Y>S DUP S>Y IFZ ;if not printed yet
      CRLF ;print legend...
      "Filename          " $PRINT
      "LA     RA     LAP    BSIZ   CW     BLKL   BLKH   Slot"
      $PRINT Y>S DROP #1 S>Y ;flip flag to print only once
     ENDIF
     CRLF #0 7 +DO DUP INDEX ADD GET PWRD +LOOP ;print filename
     "  " $PRINT 13 17 +DO DUP INDEX ADD GET PNUM +LOOP ;print numbers
     #0 INDEX 40 MUL ;push 32 bit file offset
     VolInfo 4 ADD GET ;push filespace high
     VolInfo 3 ADD GET ;push filespace low
     DADD ;make 32 bit starting block of file
     PNUM PNUM ;print BLKH BLKL
     INDEX PNUM ;print slot#
    ENDIF
   ENDIF
   20 ADD ;increment ptr
  +LOOP
  DROP ;ptr
  Y>S IFZ CRLF "No files" $PRINT ENDIF
 ENDIF ;read error
ENDIF ;volume error
END
;---------------------------------------
"Loading XREN" $PRINT CRLF
;"filename" "newname" XREN - renames file
DEFINE XREN
ChkSFS IFNZ ;if SFS running
 $DROP $DROP ;don't run
ELSE
 $SWAP $DUP ;swap strings, save filename
 ;newname oldname oldname on X
 GetFile ;look up dir/vol stats
 IFZ ;if error
  $PRINT " not found" $PRINT $DROP
 ELSE ;VolInfo/DirInfo valid (as disk is), loc hi/lo on stack
  DROP DROP ;don't need to know
  DirInfo 5 ADD GET ;push entry#
  20 MUL WKBUF ADD ;turn into address
  ;sanity check...
  DUP WKBUF SUB IF<0 #1 ELSE #0 ENDIF
  DUP WKBUF 1777 ADD SWAP SUB IF<0 DROP #1 ENDIF
  IFNZ
   "Bad error! check file " $PRINT $PRINT $DROP DROP
  ELSE
   ;newname oldname on X, mem ptr on stack
   "Renaming " $PRINT $PRINT " to " $PRINT $DUP $PRINT "... " $PRINT
   16Pad ;space-pad string
   $ADR ;push address of new name string
   #0 7 +DO ;loop for 8 words
    OVER INDEX ADD ;push address in dir entry
    OVER INDEX ADD GET ;push string word
    PUT ;copy string to mem
   +LOOP
   DROP DROP $DROP ;string adr, mem ptr, new name string
   VolInfo INC INC GET ;push dirblock high
   VolInfo INC GET ;push dirblock low
   SBLA WKBUF W-1K ;update dir block
   <IDE IFZ "Done" ELSE "Error" ENDIF $PRINT
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------
"Loading XDEL" $PRINT CRLF
;"filename" XDEL - deletes file
DEFINE XDEL
ChkSFS IFNZ ;if SFS running
 $DROP      ;don't run
ELSE
 $DUP ;for confirmation
 GetFile
 IFZ $PRINT " not found" $PRINT ELSE
  DROP DROP ;don't need location
  DirInfo 5 ADD GET ;push entry#
  20 MUL WKBUF ADD ;turn into address
  ;sanity check...
  DUP WKBUF SUB IF<0 #1 ELSE #0 ENDIF
  DUP WKBUF 1777 ADD SWAP SUB IF<0 DROP #1 ENDIF
  IFNZ
   "Bad error! check file " $PRINT $PRINT DROP
  ELSE
   "Delete " $PRINT $PRINT "? (Y/N) " $PRINT
   CHRIN "Y" $HEAD $DROP SUB CRLF IFZ
    20040 PUT ;make it a space
    VolInfo INC INC GET ;push dirblock high
    VolInfo INC GET ;push dirblock low
    SBLA WKBUF W-1K ;update dir block
    <IDE IFZ "Done" ELSE "Error" ENDIF $PRINT
   ELSE
    DROP ;address, bugfix 8/22/07
   ENDIF
  ENDIF
 ENDIF
ENDIF
END
;---------------------------------------------------

CONSOLE

;Change log...
;9/29/07 Version 1.27 - XLOAD uses new PRESET instead of shenanegans
;8/22/07 Version 1.26 - fixed XDEL, XLOAD disables clock when loading bin
;2/21/07 Version 1.25 - changed XSHOW for 24 line terminals, fixed bin-dump
;5/29/05 Version 1.24 - modified ChkSFS to allows open unmodified files
;5/24/05 Version 1.23 - changed XDIR to list current drive instead of dir numbers
;5/15/05 Version 1.22 - fixed XSHOW, added $CV, modified DIR to use $CV
;5/8/05  Version 1.2 - moved string pad to subroutine 16Pad,
; added SFS safety checks.. if 200-203 not zero then read-only
;5/4/05  Version 1.11 - fixed BLKL BLKH labels in XDIR
;4/28/05 Version 1.1 - modified AM2F to take byte size on stack
; modified other words to be size-aware, fixed AM2F/F2AM bugs
;4/26/05 Version 1.0 - system save/load only