PDP-10.its/src/sysen3/comify.41

title COMIFY - Convert Hex to Com format
A=:1   	;general purpose
B=:2
C=:3
D=:4
E=:5

;;lowest level general purpose -- Used in NxtTkn, GetMem, Snarf
TTA=:11
TTB=:12
TTC=:13

;;super-temps, clobberable by macros and everybody.
TT=:14
TT1=:15

SBR=:16  ;used mostly for JSP linkage.
P=:17    ;el stacko

dsk==:1		;disk channel
ttyo==:2	;terminal output for errors and such
ttyi==:3	;terminal input for idiot-proofing confirmation

call=:PUSHJ P,
return=:POPJ P,
calret==:JRST

pdllen==:50.		;stack
.vector pdl(pdllen)


define DBP ac
	Add ac,[70000,,]
	Skipge ac
	  Sub ac,[430000,,1]
termin


define syscal op,args
	.call [setz ? sixbit /op/ ? args ((setz))]
termin

define Type &string
	Movei TT,<.Length string>
	Move TT1,[440700,,[Ascii string]]
	.call typsiot
	  .Lose %LsSys
termin

Define TypeL *string
Type string

Termin

Define Plural Ac
   caie Ac,1
     .iot ttyo,["s]
Termin

typsiot: setz
	 sixbit/SIOT/
	 %Climm,,ttyo
	 TT1
	 TT ((setz))

Define FallThru label
	if2 ifn .-label,.ERR "FallThru label not falling thru"
Termin

jcllen==:100.
JclBuf:	block jcllen

IFDev: sixbit/DSK/
IFNm1: 0
IFNm2: sixbit/HEX/
IFSnm: 0		;hsname

OFDev:	sixbit/DSK/
OFNm1:	0
OFNm2:	sixbit/COM/
OFSnm:	0		;hsname

OutBuf:	block 16.*2000	;16K, for 4*16K bytes worth of address space

.Scalar IFLen	;(in chars) filled in by snarf, used by RdChr
.Scalar IFBP	;(ildb ptr) filled in by snart, used by RdChr

.Scalar Lines	;Number of CRLFs encountered - maintained by RdChr
.Scalar BadChs	;number of other non-hex non-: chars - maintained by RdChr
.Scalar OFBP	;Byte pointer to output buffer while comifying


.Scalar RecNum	;Number of full records written
.scalar LoadAd	;gets set to load address of data (once get some data)

.Scalar LEOF	;whether hit type 01 or length 0 record (and typed out a
		;message to that effect)
.Scalar DataLen ;length of data written so far, not including current record
		;This is only for error message if truncated record.
		;The actual correct data length is in D
.Scalar ChkSum	;for adding  up record checksum


define ERROR *msg
    push p,TTA
    Type "** Warning - Line "
    move TTA,Lines ? call DecTyp
    Type " Record "
    move TTA,RecNum ? call DecTyp
    Type ":
  ===>> msg
"
    pop p,TTA
Termin

FType:	move TTA,0(A)
	call SixTyp
	.iot ttyo,[":]
	move TTA,3(A)
	call SixTyp
	.iot ttyo,[";]
	move TTA,1(A)
	call SixTyp
	.iot ttyo,[" ]
	move TTA,2(A)
	FallThru SixTyp

SixTyp:	move TT,TTA
SixT0:	Setz TT1,
	Rotc TT,6
	Addi TT1,40
	.iot ttyo,TT1
	Jumpn TT,SixT0
	Return

HexTyp:	hrroi TT1,-12.
HexT0:	move TT,TTA
	lsh TT,(TT1)
	andi TT,17
	addi TT,"0
	caile TT,"9
	  addi TT,"A-10.-"0
	.iot ttyo,TT
	addi TT1,4
	jumple TT1,HexT0
	return

DecTyp:	push p,TTA
	move TT,TTA
	setz TTA,
DecT1:	idivi TT,10.
	push p,TT1
	aoj TTA,
	jumpn TT,DecT1
DecT2:	pop p,TT
	addi TT,"0
	.iot ttyo,TT
	sojn TTA,DecT2
	pop p,TTA
	return


;Memory allocation
;(This is much more general than needed because snarft from another program)

;;Free is -n,,X where locations X, X+1, ... X+n-1 are available locations in
;;our memory, while X+n (which is on page boundary) is the first location
;;not mapped in yet.
Free:	<EndProg&1777>-1777,,EndProg+1	;EndProg=last location of program

;;GetMem: TTA must have # words to get, returns address in TTA
;;TTB clobbered
GetMem:	hrls TTA
	add TTA,Free
	jumple TTA,GetMe0	;have enough words available, ok
	push p,TTA		;TTA is <#extra words,,next free>
	hlrz TTB,TTA		;TTB is # extra words needed
	sub TTA,TTB
	tlz TTA,-1
	lsh TTA,-12		;TTA is # first page to map
	trze TTB,1777
	  addi TTB,2000
	lsh TTB,-12		;TTB is # pages need to map
	movns TTB		;TTB is -<# pages need to map>
	hrl TTA,TTB
	syscal corblk,[%Climm,,%Cbprv		;Get fresh pages
		       %Climm,,%Jself
		       TTA
		       %Climm,,%Jsnew]
	  jrst [type "Can't get enough fresh pages"
		jrst Die]
	imuli TTB,2000
	hrlzs TTB		;TTB is -#words mapped,,0
	pop p,TTA
	add TTA,TTB		;TTA is new Free
GetMe0:	exch TTA,Free
	jrst (SBR)

;;Snarf an input file (into memory)
;; Skip return if success, normal return means file-open failed
;There is are filled in by caller, replaced by truename by us.

snarf:	syscall open,[%Clbit,,.uii ? %Climm,,dsk
		      IFDev ? IFNm1 ? IFNm2 ? IFSnm]
	  return
	syscall rfname,[%Climm,,dsk
			%Clout,,IFDev ? %Clout,,IFNm1 ? %Clout,,IFNm2
			%Clout,,IFSnm]
	  .Lose %LsFil
	syscall fillen,[%Climm,,dsk ? %Clout,,TTC]
	  .Lose %LsFil

	jumpe TTC,SnarfE	  ;don't do this stuff if empty file

	;maybe should map in the file directly -- learn how to.

	move TTA,TTC ? jsp SBR,GetMem 	;TTA = address of TTC words
	hrli TTA,440700 ? movem TTA,IFBP  ;save ascii BP to start
	hrli TTA,444400		;make full-word BP to start
	move TTB,TTC
	syscal siot,[%Climm,,dsk ? TTA ? TTB]	;Inhale file
	  .Lose %LsFil

	;flush final ^Cs in file, compute remaining IFLen in chars.
	move TTB,IFBP
	add TTB,TTC ? soj TTB, ? hrli TTB,010700  ;TTB: BP to last char
	imuli TTC,5	;TTC: number of characters
Snarf1:	ldb TTA,TTB
	cain TTA,^C
	  sojg TTC,[DBP TTB
		    jrst Snarf1]

SnarfE:	.close dsk,
	movem TTC,IFLen
	aos (p)		;skip return for success.
	return

;jsp SBR,RdChr  -- read char from IFBP/IFLen
;  jrst eof
;A has 0-15 or -1 meaning ":". Nothing clobbered

BadChr:	aos BadChs
	caie A,^M
	 jrst RdChr
	sosge IFLen
	  jrst (SBR)
	ildb A,IFBP
	caie A,^J
	 jrst RdChr0
	sos BadChs
	aos Lines
	;jrst RdChr

RdChr:	sosge IFLen
	  jrst (SBR)
	ildb A,IFBP
RdChr0:	cail A,"0
	 caile A,":	;":" is just after "9"
	   jrst [cail A,"A
		  caile A,"Z
		   jrst BadChr
		 subi A,"A-10.
		 jrst 1(SBR)]
	subi A,"0
	cail A,10.
	  seto A,
	jrst 1(SBR)

;call RdByte (into A, and added to ChkSum)

RdByte: jsp SBR,RdChr
	  jrst EOF
	jumpl A,[ERROR "Stray : ignored"
		 jrst RdByte]
	imuli A,16.
	move TTA,A
RdByt0:	jsp SBR,RdChr
	  jrst EOF
	jumpl A,[ERROR "Stray : ignored"
		jrst RdByt0]
	add A,TTA
	addm A,ChkSum
	return


Help:	.iot ttyo,[":]
	.suset [.rxjname,,TTA]
	call SixTyp
	Type " input_file,output_file
Converts input_file, which must be in the intel hex format, to COM format.
Gaps are filled with zeros.  Record addresses must be in ascending order.
Input filename defaults to UNAME "
	move TTA,IFNm2
	call SixTyp
	Type " on your home directory, output filename
defaults to FNAME1 "
	move TTA,OFNm2
	call SixTyp
	Type " on your directory, where FNAME1 is the first name of
input file"
	jrst Die

$$rfn==1
rsixtp:	cain a,",
	 aos (p)
	return
.insrt dsk:syseng;rfn

begin:	move p,[-pdllen,,pdl-1]
	syscall open,[%Clbit,,.uao ? %Climm,,ttyo ? [sixbit/TTY/]]
	  .Lose %LsFil
	syscall open,[%Clbit,,.uai ? %Climm,,ttyi ? [Sixbit /TTY/]]
	  .Lose %LsFil
	.suset [-2,,[.rhsname,,A ? .rxuname,,B]]
	movem A,IFSnm ? movem A,OFSnm
	movem B,IFNm1
	.Break 12,[..rjcl,,JclBuf]
	move TT,JclBuf
	skipe TT
	 camn TT,[ascii/?<3F>/]
	    jrst Help
	move D,[440700,,JclBuf]
	movei B,IFDev
	call rfn"rfn
	movei B,OFDev
	cain A,",
	 call rfn"rfn
	skipn OFNm1
	  jrst [move TT,IFNm1 ? movem TT,OFNm1 ? jrst .+1]
	move TT,OFnm2
	came TT,[sixbit/>/]
	  camn TT,[sixbit/</]
	    skipa
	syscall open,[%Clbit,,.uii ? %climm,,dsk
		       OFDev ? OFNm1 ? OFNm2 ? OFSnm]
	   jrst Start
	syscall rfname,[%Climm,,dsk
			%Clout,,OFDev ? %Clout,,OFNm1 ? %Clout,,OFNm2
			%Clout,,OFSnm]
	  .Lose %LsFil
	.close dsk,
	Type "File "
	movei A,OFDev
	call FType
	Type " already exists.  Overwrite it"
OutAns:	Type " (Y or N)?"
	.iot ttyi,A
	caie A,"Y
	  cain A,"y
	    jrst EndPars
	caie A,"N
	  cain A,"n
	    jrst Die
	.iot ttyo,[^G]
	jrst OutAns
EndPars:TypeL ""
	FallThru Start

Start:	call Snarf	;get input file
	  jrst [Type "Can't open file "
		movei A,IFDev
		call FType
		jrst Die]
	Type "Comifying file "
	movei A,IFDev
	call FType
	TypeL "."
	FallThru Comify


Comify:	setzm LEOF
	setzm RecNum
	setzm Lines
	setzm BadChs
	move TT,[441000,,Outbuf]
	movem TT,OFBP
	setz D,		;D is the accurate-at-all-times DataLen

RdLine:	jsp SBR,RdChr
	  jrst [skipe LEOF ? jrst Done
		ERROR "EOF, but last record not length 0 or type 01"
		jrst Done]
	jumpge A,[ERROR "Stray hex digit ignored"
		  jrst RdLine]
	skipe LEOF
	  jrst [ERROR "Data after logical end of file"
		setzm LEOF
		jrst RdRec]
RdRec:	setzm ChkSum
	movem D,DataLen
	;read length
	call RdByte
	move C,A
	;read address
	call RdByte
	imuli A,256.
	move E,A
	call RdByte
	add E,A
	;read type
	call RdByte
	;A has type, E has address, C has length
	caile A,1
	  jrst [ERROR "Record type other than 00/01"
		jrst RdDat]
	cain A,1
	  jrst [Type "Type 01 record"
		jrst LeolRec]
	jumpe C,[Type "Length 0 record"
		 jrst LeolRec]
RdDat:	call RdByte	;get first byte, just to make sure there is one
	skipg DataLen
	  movem E,LoadAd	;initialize LoadAd if this is first byte
	sub E,LoadAd
	camge E,DataLen		;if E<0, backingup before LoadAd, else just
	  jrst [		;backing up within same area. Barf anyhow
		TypeL "*****   Records not in ascending order    *****"
		TypeL "*****  Can't handle that (yet), aborting  *****"
		jrst Die]
	came E,DataLen
	  jrst Fill
RdDat0:	move D,E
	skipa
RdDat1:	call RdByte
	idpb A,OFBP
	aoj D,
	sojg C,RdDat1
RdChk:	call RdByte	;read off  the checksum, adding it in
	aos RecNum
	move A,ChkSum
	andi A,377
	jumpe A,RdLine
	ERROR "Checksum doesn't match"
	jrst RdLine

Fill:	Type "Zero-filling gap at "
	move TTA,LoadAd ? add TTA,DataLen ? call HexTyp
	Type "H-"
	move TTA,LoadAd ? add TTA,E ? soj TTA, ? call HexTyp
	TypeL "H"
	move TTA,E ? sub TTA,DataLen
	idivi TTA,4
	sojge TTB,[ibp OFBP ? jrst .]
	addm TTA,OFBP
	movem E,DataLen
	jrst RdDat0

LeolRec:setom LEOF
	Type " indicating execution address --> "
	move TTA,E ? call HexTyp
	TypeL "H"
	jumpg C,[ERROR "Data in type 01 record"
		 jrst RdDat]
	jrst RdChk

;Come here when hit end of file in middle of record. D has real DataLen
EOF:	Type "EOF inside record:  Record aborted after "
	move TTA,D ? sub TTA,DataLen ? call DecTyp
	TypeL ". data bytes"
	FallThru Done


Done:	TypeL ""
	move TTA,Lines ? call DecTyp
	Type ". line"
	Plural TTA
	Type ", "
	skiple TTA,BadChs
	  jrst [call DecTyp
		Type ". illegal character"
		Plural TTA
		TypeL "."
		jrst .+1]
	jumple D,[TypeL "No data bytes."
		  Type "File not written"
		  jrst Die]
	move TTA,RecNum ? call DecTyp
	Type ". complete record"
	Plural TTA
	Type ", "
	move TTA,D ? call DecTyp
	Type ". ("
	move TTA,D ? call HexTyp
	Type "H) data bytes.
Load Address: "	
	move TTA,LoadAd ? call HexTyp
	Type "H   Last Address: "
	move TTA,LoadAd ? add TTA,D ? soj TTA, ? call HexTyp
	TypeL "H."
	FallThru Output


	;write out file. D has number of bytes
Output: syscall open,[%Clbit,,.uio ? %Climm,,dsk
		      OFDev ? OFNm1 ? OFNm2 ? OFSnm]
	  .Lose %LsFil
	.iot dsk,[sixbit/DSK8/]
	move A,D
	idivi A,4
	jumpn B,[Type "Adding "
		 movei TTA,4 ? sub TTA,B ? call DecTyp
		 type " zero byte"
		 caie B,3 ? .iot ttyo,["s]
		 TypeL " at end of file"
		 aoj A,
		 jrst .+1]
	move B,[444400,,OutBuf]
	syscal siot,[%Climm,,dsk ? B ? A]	;Exhale file
	  .Lose %LsFil
	syscall rfname,[%Climm,,dsk
			%Clout,,OFDev ? %Clout,,OFNm1 ? %Clout,,OFNm2
			%Clout,,OFSnm]
	  .Lose %LsFil
	.close dsk,
	Type "Wrote "
	movei A,OFDev
	call FType
Die:	.logout 1,



Variables

junk:	;name for benefit of DDT

Constants

EndProg== .-1		;Last location in program

	END Begin