;
; CONGEN - sysgen to console - 5/10/04, last mod 9/30/07
; startadr endadr ALTENC - encodes alternate memory to console
; Format..
; BEGIN octal_startadr
; END octal_endadr
; encoded text
; CHECK octal_checksum
; [eof or next BEGIN]
; Encoded format is the same as used by the MKLDR utility for encoding
; binary code into IPL text (as used by the octapus IPLs), each word
; is encoded to 3 characters, 60 characters per line for neatness.
; Mod - uses location 150 for transfer, renamed from CONOUT to ALTENC
; CONGEN modified to save to alt then use ALTENC to encode
; Added ALTGEN to prompt for ranges then encode from alt mem
;
; CONALT - permit copy/paste encoded binary to alt mem, 8/19/07
; Must slow down (HyperTerminal) paste char and line delay to allow
; time for processing, 10ms char, 300ms line delay should be OK.
; Once binary is loaded PRESET 77000 RUN to execute from loc 2.
; 9/30/07 - changed text wording to indicate new RUNALT word.
;
OCTAL
"Loading ALTENC" $PRINT CRLF
DEFINE ALTENC
 RADIX SWAP ROT ; push current radix below startadr, endadr
 OCTAL ; all our numeric output in octal
 SWAP ; tos = startadr, endadr below that
 #0 SWAP ROT ;checksum below endadr (radix below checksum)
;stack = radix, checksum, endadr, startadr <--top
 "BEGIN " $PRINT DUP PNUM CRLF ;print BEGIN line
 "END " $PRINT OVER PNUM CRLF ;print END line
;encode until address = endadr...
;pointer on stack, endadr over that
 DO
  OVER OVER SUB INC ;calculate remaining size
  DUP CASE > 24 DROP 24 ENDCASE ;max 20 words if not at end
  #1 SWAP +DO  ;loop the indicated number of words
;now pointer back at top of stack
;add word to checksum...
   DUP 150 #1 A>CCOPY ;get word from alt mem
   150 GET DUP S>Y ;save word on Y stack
   S>Z ROT SWAP Z>S ADD SWAP ROT
;output word as three characters...
   Y>S ;restore very same word to avoid checksum error
   DUP 77 AND 74 ADD PCHR  ;encode
   ASR ASR ASR ASR ASR ASR DUP 77 AND 74 ADD PCHR
   ASR ASR ASR ASR ASR ASR 17 AND 74 ADD PCHR
   INC  ;inc mem pointer
  +LOOP ;until string is 60 chars long (or remaining)
  CRLF ;output end of line
;pointer on stack, endadr over that.. exit if pointer > endadr
  OVER OVER SUB IF<0 #1 ELSE #0 ENDIF
 UNTIL ;done
 DROP DROP ; drop pointer and endadr
 "CHECK " $PRINT PNUM CRLF ;output checksum
 CASE ;restore radix...
  = 2 BINARY
  = 12 DECIMAL
  DEFAULT OCTAL
 ENDCASE
END
;
"Loading CONGEN" $PRINT CRLF
DEFINE CONGEN
 OCTAL ALTSAVE
 "----- Start CONGEN output -------" $PRINT CRLF
 2 EOD ALTENC             ;save HP-IPL/OS and dictionary
 70000 72377 ALTENC       ;save OCTAPUS
 CRLF  ;output blank line to terminate when reloading via papertape
 "----- End of CONGEN output ------" $PRINT
END
;
"Loading ALTGEN" $PRINT CRLF
DEFINE ALTGEN
OCTAL
"Enter each range as (say): 00002 75700" $PRINT CRLF
"Just enter to process" $PRINT CRLF
#0 ;number of strings on stack
DO ;until just enter entered
 $IN $LEN IFZ
  #1 $DROP
 ELSE
  $LEN 13 SUB IFNZ
   "Invalid entry" $PRINT CRLF $DROP
  ELSE INC ENDIF #0
 ENDIF
UNTIL
DUP IFZ DROP "Nothing to do" $PRINT ELSE
 "----- Start CONGEN output -------" $PRINT CRLF
 #1 SWAP +DO ;loop through all ranges on X stack
  #0 4 $SLICE $VAL 6 12 $SLICE $VAL ALTENC
  $DROP
 +LOOP
 CRLF
 "----- End of CONGEN output ------" $PRINT
ENDIF
END
;
"Loading CONALT" $PRINT CRLF
DEFINE CONALT
OCTAL MS_SAVE ;save ms vectors (altered by ZEROBLOCK)
ALTSAVE ;put swap prog at 77000
;zero alternate memory...
#0 ZEROBLOCK #0 37 +DO @BLK GET INDEX 2000 MUL DUP
IFZ DROP 2 ENDIF 2000 C>ACOPY +LOOP
MS_RESTORE ;restore ms vectors
"Start console transfer" $PRINT CRLF
$IN   ;get input string to prime
DO ;for all blocks
 #0  ;checksum for read
 DO ;until start address > 0
  #0 5 $SLICE ;push first 6 chars
  "BEGIN " $EQUAL $DROP ;CHECK FOR BEGIN and drop temp string
  IFZ ;if NOT equal
   $DROP
   $IN  ;get next line
   #0
  ELSE ;if BEGIN found
   6 $LEN DEC $SLICE ;push string containing start address
   $VAL ;push startadr
   #1 ;found
  ENDIF
 UNTIL
 $DROP ;the BEGIN line
 ;checksum, starting address on stack
 ;get and push endadr..
 $IN
 4 $LEN DEC $SLICE $VAL $DROP
 $IN   ;load 1st line to process
 +DO  ;loop thru all values
  ; get encoded data... string on stack
  $LEN IFZ ;if empty
   $DROP
   $IN   ;get next string
  ENDIF
  ;decode 3 chars and push to stack...
  $HEAD 74 SUB $HEAD 74 SUB 100 MUL ADD
  $HEAD 74 SUB 10000 MUL ADD
  DUP 150 SWAP PUT ;put in location 150
  150 INDEX #1 C>ACOPY ;put loc 150 into alt at index
  ADD ;to file checksum on stack
 +LOOP
 $DROP ;input line (now empty)
 $IN   ;load CHECK line
 6 $LEN DEC $SLICE $VAL $DROP ;get value from file
 OVER OVER SUB IFNZ ;compare
  CRLF "Checksum error - expected " $PRINT PNUM
  "but calculated " $PRINT PNUM CRLF
  ;keep going anyway
 ELSE
  DROP DROP ;drop checksums
 ENDIF
 $IN   ;get next line, either next BEGIN or empty line
 $TRIM $LEN ;terminate when empty line received
WHILE ;stop when line is empty
$DROP ;the empty next-line string
CRLF "Binary loaded, RUNALT to run" $PRINT
END
;
CONSOLE