;
; More AltMem utilities...                             9/15/07 9/29/07
; _FLG _XFR _LNZ _CNT - variables used by these words
; _MCZ - variable containing max consecutive zeros for FCAM
; FCAM - find Code in Alt Mem
; address value APUT - puts value into altmem
; address AGET - pushes value from altmem
; ?MSOUT - prints current MS out redirection - default MS out = PTP
; _PAD - variable containing # of pad words for AM2ABS
; _CBD - variable containing code boundary for AM2ABS
; _TRA - variable containing transition address between pad/boundary
; AM2ABS - saves contents of altmem to ABS file attached to MS out
; F2ABS - wrapper for AM2ABS that loads file into altmem then runs AM2ABS
;
; AM2ABS/F2ABS requires AAOUT HLT from altutil.ipl
;
;
; FCAM - find code in alt mem (from 2 to 75777)
; this word outputs FROM xxxxxx TO yyyyyy [crlf]
; for every non-zero extent it finds with up to
; 1024 dec embedded consecutive zeros. The addresses
; of the first and last non-zero values are listed.
; Change contents of _MCZ to change max# consec.zeros.
;
VARIABLE _FLG
VARIABLE _XFR
VARIABLE _LNZ
VARIABLE _CNT
VARIABLE _MCZ
OCTAL _MCZ 2000 PUT ;set max # imbedded zeros to 1024 dec
DEFINE FCAM
2  ;starting location
_FLG #0 PUT ;flag, zero for in-between non-zero values
;_XFR used for transfer
;_LNZ used for last non-zero loc (to)
;_CNT used for count of consecutive zeros
DO
 DUP _XFR #1 A>CCOPY ;get word
 _XFR GET IFNZ  ;if word not zero
  _LNZ OVER PUT ;save address
  _CNT #0 PUT ;clear count
  _FLG GET IFZ ;if flag zero
   "FROM " $PRINT DUP PNUM
   _FLG #1 PUT ;set flag
  ENDIF
 ELSE ;word is zero
  _CNT GET _MCZ GET SUB IF<0  ;if less than max zeros
   _CNT DUP GET INC PUT ;increment count
  ELSE
   _FLG GET IFNZ ;if flag set
    "TO " $PRINT _LNZ GET PNUM CRLF
    _FLG #0 PUT ;reset flag
   ENDIF
  ENDIF
 ENDIF
 INC ;address
 DUP 76000 SUB IF<0 #0 ELSE #1 ENDIF
UNTIL ;address reaches 76000
DROP ;address
_FLG GET IFNZ ;if flag still set
 "TO 075777" $PRINT CRLF
ENDIF
END
;
; ?MSOUT - prints "PTP " if loc [351] = [345]
; otherwise prints "MS out [contents of 351] "
;
OCTAL DEFINE ?MSOUT
351 GET 345 GET SUB IFZ "PTP " $PRINT
ELSE "MS out " $PRINT 351 GET PNUM
ENDIF
END
;
; AM2ABS - saves alt mem to an ABS file attached to MS output
; using information returned by FCAM plus a little extra
; smarts to save some of the surrounding zeros in case
; they are necessary for proper operation. The rules are..
; End addresses below 67000 increased by 100 octal
; End addresses >=67000 increased to nearest 100 octal boundary minus 1
; Beginning addresses above 100 lowered to nearest 100 octal boundary
;
; Requires HLT FCAM, plus words from altutil.ipl
; Uses _XFR var, AAOUT uses locations 152/153 for temps
; _PAD var contains TO address pad amount (100 octal)
; _CBD var contains code boundary (power of 2 - 1 inverted, 177700 octal)
; _TRA var contains transition address between pad/boundary behavior
;
; Note... this amounts to guessing where the programmer stored variables,
; and is designed to work only with the cases I have encountered. This
; word is an attempt to automate the process to simplify documenting
; "how to save a HP-IPL/OS disk binary to an ABS file" without having
; to write page after page explaining the guesswork involved, but there
; may come a time where it's required to manually determine the save
; ranges and use tools like ALTABS or PTHEADER/AAOUT/PTZERO. On disk
; HP-IPL/OS avoids all this mess by clearing memory before loading or
; importing ABS files, and saves all 31KW to disk, zeros and all.
;
VARIABLE _PAD
VARIABLE _CBD
VARIABLE _TRA
OCTAL
_PAD 100 PUT
_CBD 177700 PUT
_TRA 67000 PUT
DEFINE AM2ABS
MS_SAVE ;save current MS redirection
CRLF "Scanning alt mem..." $PRINT
#0 OUTBLOCK >MS FCAM CRLF ;run FCAM output to block 0, extra crlf
<>CON ;restore normal console output
CRLF "Detected extents:" $PRINT
#0 INBLOCK ;redirect MS in to read back data
177777 ;push terminate value to stack
DO ;loop through entries
 MS$IN ;get line
 $LEN IFZ ;if empty
  $DROP ;line
  #1 ;terminate loop
 ELSE
  ;line in the form of "FROM xxxxxx TO xxxxxx "
  5 12 $SLICE $VAL ;push from address
  DUP _CBD GET NOT INC SUB IF<0 ELSE  ;if >= code boundary
   _CBD GET AND ;lower to nearest boundary
  ENDIF
  17 24 $SLICE $VAL ;push to address
  DUP _TRA GET SUB IF<0 ELSE  ;if >= transition address
   _CBD GET AND _CBD GET NOT ADD ;raise to boundary minus 1
  ELSE
   _PAD GET ADD ;just add pad amount
  ENDIF
  $DROP ;FROM/TO line
  CRLF "From " $PRINT OVER PNUM "to " $PRINT DUP PNUM
  #0 ;keep looping
 ENDIF
UNTIL ;all extends found and processed
MS_RESTORE ;restore previous MS redirections
DUP 177777 SUB IFZ ;if nothing...
 CRLF "Nothing in alt to save. " $PRINT
ELSE ;do it...
 CRLF "Save as ABS? " $PRINT
 CHRIN CRLF 131 SUB IFNZ ;if not confirmed...
  ;clean up stack...
  DO DROP DROP DUP 177777 SUB WHILE
 ELSE ;prompt to attach and save...
  "Halt for attaching/detaching files? " $PRINT
  CHRIN CRLF 131 SUB _FLG SWAP PUT ;if _FLG = 0 then halt
  _FLG GET IFZ
   "Attach " $PRINT ?MSOUT
   "file.abs then continue" $PRINT CRLF HLT
  ENDIF
  "Saving... " $PRINT
  PTHEADER ;write header
  DO
   AAOUT ;write segment
   DUP 177777 SUB
  WHILE ;still more segments
  PTZERO ;write trailer
  CRLF "Done. " $PRINT
  _FLG GET IFZ
   "Detach " $PRINT ?MSOUT
   "then continue" $PRINT CRLF HLT
  ENDIF
 ENDIF
ENDIF
DROP ;terminator
END
;
; address value APUT - puts value into alt mem
; uses _XFR var
;
OCTAL DEFINE APUT
_XFR SWAP PUT _XFR SWAP #1 C>ACOPY
END
;
; address AGET - gets value from alt mem and pushes to stack
; uses _XFR var
;
OCTAL DEFINE AGET
_XFR #1 A>CCOPY _XFR GET
END
;
; "FILE" F2ABS - file wrapper for AM2ABS
;
OCTAL DEFINE F2ABS
F2AM ;load file into alt mem
DirInfo GET 177777 SUB IFNZ ;if file loaded...
 2 AGET 124003 SUB IFZ
  AM2ABS ;save it
 ELSE
  "Not a system binary" $PRINT
 ENDIF
ENDIF
END
;
CONSOLE