; Utilities for running, patching and examining the TSB-E system
;
"Loading TSB-E utilities 3/8/07" $PRINT CRLF
"Setting allocation to 4 blocks" $PRINT CRLF
4 ALLOCATE
;
; Setup for TSB-E / HP-IPL/OS combo system...
; Start with recent DMS/DISK/7900/XDOS/XUTILS build of HP-IPL/OS
;  configured for TSB-E's slot assignments, with the TSB-E disk attached
;  as drive 0 and a blank disk attached as drive 1.
; Add !D1F defined as 5 CHDRV to make sure HP-IPL/OS defaults to
;  drive 1 fixed platter, 2 RUN (or run 2 from sim prompt) to make
;  sure everything inits. Should be before this file to ensure correct
;  disk drive/platter is set before the !SIM word runs. 
; XINIT and specify 1 volume of 44 (octal) files.
; "LIB" MKVOL "LIB" CHVOL to make default volume.
; DGEN to save boot system to disk.
; Attach "24286-60001_1438.bin" to PTR then "TSBELOADER" ABS2F to import.
; Run recent 7900bext.out with proper s parms (101101) to make bootable.
; Boot using 7900_bd1.out (can be embedded in startup script).
;
; Can also be used with single-disk combo setup.. get rid of all TSB-E files
; on subchannel 1 and DISK-DN,1 to remove from system, run 7900bext.out with
; 001100 in s to put boot extension on drive 0 removeable platter, and change
; the !D1F word to !D0R defined as 0 CHDRV - to do this RENAME !D1F !D0R then
; WHEREIS !DOR then x y DUMP to find addr of the "000005" then addr 0 PUT
; 2 RUN to reset XDIR to make sure current drive is right then DGEN to update.
; Boot from sim using boot -r dpc
;
"Loading TSBE" $PRINT CRLF
;  
; TSBE - this word resets the "sleep" flag and runs the
; TSB-E loader, stored as "TSBELOADER" in volume "LIB".
; Does idiot-checks to make sure TSB-E is mounted, 1KW block 1
; offset 1 must be 5127 and offset 1211 must be 0.
; 3/4/07 - discovered that TSB-E is picky about SR so clears,
; for better awareness now doesn't automatically "fix" unslept system
;
OCTAL DEFINE TSBE
DRV GET ;push current drive
4 CHDRV ;change to TSB-E drive 0 fixed
#0 #1 SBLA WKBUF R-1K ;load block 1
WKBUF 40 ADD GET 5127 SUB IFZ ;make sure it's really TSB-E
 WKBUF 1211 ADD ;push address to check
 DUP GET IFNZ
  "System not slept, use EUTL then check files" $PRINT
 ENDIF
 SWAP ;address for current drive
 CHDRV ;go back to hpiplos drive
 GET IFZ ;if sleep flag correct value then
  #0 S>SR ;make TSB-E happy
  "LIB" CHVOL "TSBELOADER" XLOAD ;run the TSB-E loader
 ENDIF
ELSE ;not a compatible disk
 CHDRV ;restore current drive
 "ALIEN DISK" $PRINT
ENDIF
END
; 
"Loading EUTL" $PRINT CRLF
;
; HP2000E DISK IMAGE PATCH UTILITY
; This HP-IPL/OS program permits configuring backspace preference
; and general disk browsing and modification. It is specific to
; the version of HP2000E configured by Mike Gemeny, if attempting
; to use with other versions of E then you'll have to track down
; where the BKSPC constant is (probably somewhere close by) and
; modify the 61622 mem addresses (offset by 60000, really offset 1622)
; in the patch code. If not in block 1 of fixed platter (but should be)
; then change the "1"s before the SBLA words in the patch code (all 4).
;
; Initial version 9/9/06 WTN
; modified 2/25/07... renamed to EUTL, fixed typos :)
; added function to "fix" unslept disk by resetting sleep flag
; 2/28/07 added functions to patch/unpatch SLEEP to exit to HP-IPL/OS...
; this requires that TSB-E was started from HP-IPL/OS, exit at 77000.
; The sleep patch runs only if N entered at the MAG TAPE SLEEP? prompt,
;  if doing a mag tape sleep the loader utility * prompt comes up,
;  ctrl-e and exit, or run 77000 to return to HP-IPL/OS
; 3/4/07 added caution to fix option
;
OCTAL DEFINE EUTL
OCTAL
DRV GET ;push current drive to restore when done
"*** HP2000E DISK PATCH UTILITY ***" $PRINT CRLF
"1) PATCH TO USE CTRL-H BACKSPACE" $PRINT CRLF
"2) RESTORE STOCK RUBOUT (_)"      $PRINT CRLF
"3) FIX UNSLEPT SYSTEM"            $PRINT CRLF
"4) ACCESS RAW DISK BLOCKS"        $PRINT CRLF
"5) PATCH SLEEP/N TO RUN 77000"    $PRINT CRLF
"6) RESTORE STOCK SLEEP COMMAND"   $PRINT CRLF
"WHAT TO DO? " $PRINT $IN $VAL 
CASE
= 1 ;patch for backspace
 DRV 4 PUT #0 #1 SBLA 60000 R-1K
 61622 GET 137 SUB IFZ
  "PATCHING TO USE CTRL-H" $PRINT
  61622 10 PUT #0 #1 SBLA 60000 W-1K
 ELSE
  61622 GET 10 SUB IFZ
   "ALREADY CONFIGURED FOR CTRL-H" $PRINT
  ELSE
   "ALIEN DISK" $PRINT
  ENDIF
 ENDIF
= 2 ;unpatch backspace
 DRV 4 PUT #0 #1 SBLA 60000 R-1K
 61622 GET 10 SUB IFZ
  "PATCHING TO USE RUBOUT" $PRINT
  61622 137 PUT #0 #1 SBLA 60000 W-1K
 ELSE
  61622 GET 137 SUB IFZ
   "ALREADY CONFIGURED FOR RUBOUT" $PRINT
  ELSE
   "ALIEN DISK" $PRINT
  ENDIF
 ENDIF
= 3 ;patch unslept system
 DRV 4 PUT #0 #1 SBLA 60000 R-1K
 61211 GET 100000 SUB IFZ
  "RESETTING SLEEP FLAG" $PRINT CRLF
  61211 #0 PUT #0 #1 SBLA 60000 W-1K
  "CAUTION! CHECK FOR FILE SYSTEM DAMAGE!" $PRINT CRLF
  "IF ADDED FILES NO LONGER SORT REPLACE THE DISK" $PRINT
 ELSE
  61211 GET IFZ
   "SLEEP FLAG ALREADY RESET" $PRINT
  ELSE
   "ALIEN DISK" $PRINT
  ENDIF
 ENDIF
= 4 ;access disk blocks
 DRV 4 PUT ;default to drive 0 fixed platter
 CRLF
 "WARNING!!! EXPERTS ONLY!!! CAN MAKE A MESS!!!" $PRINT CRLF
 "THIS UTILITY USES 1KW DISK BLOCKS, EACH BLOCK CONTAINS 8" $PRINT CRLF
 "128W SECTORS. BLOCKS ARE NUMBERED SO THAT EACH CYLINDER" $PRINT CRLF
 "GROUP OF 6 BLOCKS CONSISTS OF 3 1KW BLOCKS ON THE EVEN" $PRINT CRLF
 "HEAD FOLLOWED BY 3 MORE 1KW BLOCKS ON THE ODD HEAD." $PRINT CRLF
 "MAX BLOCK IS 2301 OCTAL, OR 1218 DECIMAL KW PER PLATTER." $PRINT CRLF
 CRLF
 #0 ;current block
 DO
  #0 ;exit flag
  ?DRV CRLF
  "CURRENT BLOCK: " $PRINT OVER PNUM CRLF
  "1) CHANGE BLOCK NUMBER"        $PRINT CRLF
  "2) CHANGE DRIVE/PLATTER"       $PRINT CRLF
  "3) READ DISK BLOCK INTO MEM"   $PRINT CRLF
  "4) DUMP MEMORY TO CONSOLE"     $PRINT CRLF
  "5) CHANGE MEMORY LOCATIONS"    $PRINT CRLF
  "6) WRITE MEM TO DISK BLOCK"    $PRINT CRLF
  "7) ERASE MEMORY BUFFER"        $PRINT CRLF
  "WHAT TO DO? " $PRINT $IN $VAL
  CASE
  = 1 "NEW BLOCK NUMBER? " $PRINT 
   $IN $DUP $VAL CASE
   < 0 #1
   > 2301 #1
   DEFAULT #0
   ENDCASE
   IFZ
    SWAP DROP $VAL SWAP
    "LOAD AND DISPLAY? " $PRINT
    $IN $LEN IFZ $DROP ELSE ;if string not empty
     $HEAD $DROP 131 SUB IFZ ;if 1st letter Y
      OVER #0 SWAP SBLA 60000 R-1K 60000 61777 DUMP CRLF
     ENDIF
    ENDIF
   ELSE
    $DROP "BLOCK NUMBER MUST BE 0-2301 OCTAL" $PRINT CRLF
   ENDIF
  = 2
   "LOGICAL DRIVE 0-3 REM 4-7 FIXED: " $PRINT $IN $VAL
   7 AND DRV SWAP PUT
  = 3 "READING DISK BLOCK INTO MEMORY..." $PRINT
   OVER #0 SWAP SBLA 60000 R-1K 
   "DONE" $PRINT CRLF
  = 4 
   60000 61777 DUMP CRLF
  = 5 "LOCATION: " $PRINT $IN 
   $LEN IFZ $DROP ELSE
    $VAL DUP CASE
     < 60000 "TOO SMALL, MUST BE 60000-61777" $PRINT CRLF DROP
     > 61777 "TOO BIG, MUST BE 60000-61777" $PRINT CRLF DROP
     DEFAULT
      DUP GET "CURRENTLY " $PRINT PNUM
      "NEW VALUE? " $PRINT $IN 
      $LEN IFNZ
       $VAL PUT "DONE" $PRINT CRLF
      ELSE 
       $DROP DROP "NOT CHANGED" $PRINT CRLF
      ENDIF
     ENDIF
   ENDCASE
  = 6
   "WRITE MEMORY TO DISK BLOCK..ARE YOU SURE? (YES/NO) " $PRINT
   $IN "YES" $EQUAL $DROP IFNZ
    "WRITING MEMORY TO DISK BLOCK..." $PRINT
    OVER #0 SWAP SBLA 60000 W-1K 
    "DONE" $PRINT
   ELSE "NOTHING WRITTEN" $PRINT ENDIF CRLF
  = 7
   "ERASE MEMORY BUFFER..ARE YOU SURE (YES/NO) " $PRINT
   $IN "YES" $EQUAL $DROP IFNZ
    "ERASING MEMORY BUFFER..." $PRINT
    60000 61777 +DO INDEX #0 PUT +LOOP
    "DONE" $PRINT
   ELSE "NOTHING ERASED" $PRINT ENDIF CRLF
  DEFAULT DROP #1 ;exit
  ENDCASE
 UNTIL 
 DROP
= 5 ; patch SLEEP/N to return to HP-IPL/OS
 DRV 4 PUT #0 36 SBLA 60000 R-1K ;READ BLOCK 36
 60632 GET 6002 SUB IFZ ;check to make sure it's stock
  61634 GET 63531 SUB IFZ
   61635 GET 67532 SUB IFZ
    "PATCHING SLEEP/N TO RUN 77000" $PRINT
    60632 #0 PUT ;CHANGE SZB (6002) TO NOP TO SKIP DISK-DN,1 CHECK
    61634 127335 PUT ;CHANGE LDA (63531) TO JMP 37335,I
    61635 77000 PUT ;CHANGE LDB (67532) TO HPIPLOS RETURN ADDR
    #0 36 SBLA 60000 W-1K ;WRITE CHANGES TO BLOCK 36
   ENDIF
  ENDIF
 ELSE
  61635 GET 77000 SUB IFZ
   "ALREADY PATCHED" $PRINT
  ELSE
   "ALIEN DISK" $PRINT
  ENDIF
 ENDIF
= 6 ; restore stock sleep command
 DRV 4 PUT #0 36 SBLA 60000 R-1K ;READ BLOCK 36
 60632 GET IFZ ;check to make sure it's patched
  61634 GET 127335 SUB IFZ
   61635 GET 77000 SUB IFZ
    "RESTORING STOCK SLEEP COMMAND" $PRINT
    60632 6002 PUT
    61634 63531 PUT
    61635 67532 PUT
    #0 36 SBLA 60000 W-1K
   ENDIF
  ENDIF
 ELSE
  61635 GET 67532 SUB IFZ
   "ALREADY STOCK" $PRINT
  ELSE
   "ALIEN DISK" $PRINT
  ENDIF
 ENDIF
;
ENDCASE
DRV SWAP PUT ;restore current drive
END
;
"Loading SDSK" $PRINT CRLF
;
; SDSK - this word permits searching the current drive for a binary
; sequence. Before using n CHDRV to the drive/platter to search (n=4
; for TSB-E), don't forget to change back to the HP-IPL/OS disk after
; using (do a 2 RUN if autostarting default-drive word defined).
; After running SDSK enter a list of 16-bit values to search for
; (just enter when done) then specify the starting and ending blocks.
; Displayed offsets are offset by 60000.
;
OCTAL DEFINE SDSK
"Logical drive = " $PRINT DRV GET PNUM CRLF
100 #0 PUT ;number of words to search for
;numbers added to 103+, 101 is found flag, 102 for list ptr
DO
 "Number(s) to find (enter when done): " $PRINT $IN
 $LEN IFZ $DROP #1 ELSE #0 ;drop/exit if empty, if not
  $VAL 100 GET 103 ADD SWAP PUT ;add to number list
  100 DUP GET INC PUT ;increment word count
  100 GET 74 SUB IFZ
   "Geez that's enough!" $PRINT CRLF DROP #1
  ENDIF
 ENDIF
UNTIL ;list is entered
100 GET IFNZ ;if at least one number was entered
 "Starting block: " $PRINT $IN $VAL
 "Ending block  : " $PRINT $IN $VAL
 OVER OVER SWAP SUB IF<0
  DROP DROP "End must be > start" $PRINT
 ELSE
  +DO ;loop thru all blocks
   101 #0 PUT ;reset match flag
   "Searching block # " $PRINT INDEX PNUM
   33 PCHR "[1G" $PRINT ;back up cursor
   #0 INDEX SBLA 60000 R-1K ;read in block
   INDEX ;push current block
   60000 61777 +DO ;loop thru block mem
    INDEX GET 103 GET SUB IFZ ;if 1st match then
     101 #1 PUT ;set found flag
     100 GET DEC IFNZ ;if more than one number then
      INDEX INC ;push start
      DUP 100 GET DEC DEC ADD ;calculate last
      102 104 PUT ;set list pointer to next value
      DUP 61777 SWAP SUB IF<0 ;if it overflows into next block
       S>Z S>Z ;save from/to numbers, block# at top
       DUP INC #0 SWAP SBLA 62000 R-1K ;load next block
       ;error if already at last block - oh well
       Z>S Z>S ;restore from/to numbers
      ENDIF
      +DO ;search through remaining memory to verify match
       INDEX GET ;push # from mem
       102 GET GET ;push # from list       
       SUB IFNZ ;if no match
        101 #0 PUT ;reset found flag
       ENDIF
       102 DUP GET INC PUT ;increment list pointer
      +LOOP
     ENDIF       
     101 GET IFNZ ;if match flag still set
      "Block " $PRINT DUP PNUM "Offset " $PRINT INDEX PNUM
      ": " $PRINT
      INDEX INDEX 6 ADD +DO ;print 7 numbers from loc
       INDEX GET PNUM
      +LOOP CRLF
     ENDIF ;match flag
    ENDIF ;1st match
   +LOOP ;next loc
  DROP ;block number
  +LOOP ;next block
 ENDIF ;invalid block range
ENDIF ;valid number
END
;
"Loading !SIM" $PRINT CRLF
;
; !SIM - this ensures remaining writes get flushed to disk
; 3/8/07 - read-only version
;
DEFINE !SIM
#0 #0 SBLA WKBUF R-1K ;read current drive block 0
DRV GET ;push current logical drive number
DUP IFNZ ;if not drive 0
 4 CHDRV ;change to drive 0 fixed platter
 #0 #0 SBLA WKBUF R-1K ;read a block there
ENDIF
CHDRV ;restore current drive
END
;
"Done." $PRINT CRLF
;
CONSOLE