ALWAYS	29MAR5	WRITE	<WRITE AN OBJECT FILE>				;29MAR5
	.MCALL	DIR$,PUT$S,CLOSE$,OPEN$,FDAT$R,CALLR

.MACRO	NOTIMP	FORMAT
H.'FORMAT=ILLFMT
S.'FORMAT=ILLFMT
B.'FORMAT=ILLFMT
E.'FORMAT=ILLFMT
T.'FORMAT=ILLFMT
.ENDM

;************************************************************************
;*									*
;*	MODULE:	WRITE							*
;*									*
;*	FUNCTION:  WRITE A HEX OUTPUT FILE				*
;*									*
;*	INCLUDES:  APPEND to existing file				*
;*									*
;*	INPUT PARAMETERS:						*
;*									*
;*	R0 POINTS TO COMMAND LINE IN PROCESS				*
;*									*
;*	OUTPUT PARAMETERS:						*
;*									*
;*	DESTROYS ALL REGISTERS						*
;*									*
;*	AUTHOR:  KEVIN ANGLEY						*
;*									*
;*	DATE:  30-AUG-82						*
;*									*
;*	MODIFIED BY: Chris Doran, Sira Ltd.				*
;*									*
;*	DATE:	Jan 84							*
;*									*
;*		Make WIDTH default format-dependent.			*
;*		Change PUT$'s to PUT$S's for non-FCSRES overlaid	*
;*		  version as READ and WRITE are in different overlays.	*
;*		Major re-write for additional formats.			*
;*		Add APPEND option.					*
;*		Suppress statistics report if NOECHO mode selected.	*
;*	17-Feb-84 CJD							*
;*		Correct addition of ADDVAL to record start address.	*
;*		Add a * record to HEX and OCTAL outputs for Sira PROM	*
;*		 programmer driver program.				*
;*	2-Mar-84 CJD							*
;*		Add FAIRCHILD format.					*
;*		Correct RCA format by adding !M before addresses, no	*
;*		  ; on last record, and $P for transfer address.	*
;*		Support SMS option for HEX and OCTAL.			*
;*									*
;*	23MAR4	Scott Smith, Telex Computer Products, Raleigh, NC	*	;23MAR4
;*		Included a conditional assembly block that changes all	*	;23MAR4
;*		16 byte default output widths to 32 bytes		*	;23MAR4
;*									*	;23MAR4
;*	25-Mar-85 CJD							*	;29MAR5
;*		Merge Feb/Mar 84 with 23MAR4.				*	;29MAR5
;*		Make no transfer address record for Tektronix just	*	;29MAR5
;*		  /00000000 instead of abort block, which Data I/O	*	;29MAR5
;*		  programmer doesn't recognise (hangs).  Doesn't	*	;22MAR85
;*		  affect Tektronix emulators as they seem to ignore the	*	;29MAR5
;*		  transfer block anyway.				*	;29MAR5
;*		Do the equivalent for extended Tekhex, although this	*	;29MAR5
;*		  isn't acceptable to the programmer anyway.		*	;29MAR5
;*		Code for Tek mods is conditionalised on TEKABO and	*	;29MAR5
;*		  EXTABO in case it has to go back in later.		*	;29MAR5
;*		Write Intel "extended address" (02) record when reqd.	*	;29MAR5
;*		Change Intel "transfer address" record type to 03	*	;29MAR5
;*		  (was 02) following new Intel standard.		*	;29MAR5
;*		Make ADD1ST return registers in same order as PUTHXn	*	;29MAR5
;*		  and GETHXn, correcting bug that TASK output didn't	*	;29MAR5
;*		  store load address, and unreported bugs in EXTENDED	*	;29MAR5
;*		  and MOSTEK formats. Needs mods to usage at START and	*	;29MAR5
;*		  in WHITESMITHS.					*	;29MAR5
;*		Minor code optimisations.				*	;29MAR5
;*									*
;************************************************************************

; Define one or both of the following symbols if Tektronix files should	end	;29MAR5
; with abort (//) block when there is no transfer address. If undefined, no	;29MAR5
; transfer address is treated as transfer address = 0.				;29MAR5
;TEKABO=0		; Define to use abort block on normal Tekhex		;29MAR5
;EXTABO=0		; Define to use abort block on extended Tekhex		;29MAR5

APPEND::
	CMP	RWFORMAT,#F.TASK ; Append mode is illegal for TASK
	BEQ	10$
	CMP	RWFORMAT,#F.WHITESMITHS ; and Whitesmiths' formats
	BEQ	10$
	MOVB	#FO.APD,FDB+F.FACC ; Set to open for append
	BR	WACOM		; Join common code

10$:	OUTPUT	IAP		; Can't append in current format
	BR	ERRORX		; Return with cs = error

WRITE::	MOVB	#FO.WRT,FDB+F.FACC ; Require new file
WACOM:	MOV	SP,RETSP	; Save pointer to return addr for error exits
	MOVB	#377,ERRFLG	; Set exit status to error
	CLRL	ADDVAL		; ASSUME NO OFFSETTING UPON READING ADDRESSES
	CLRB	PART		; ASSUME NO PARTIAL WRITE
	CLR	BCOUNT		; Clear total counter
	CLR	TOTCSM		; Clear total checksum
	MOV	RWFORMAT,%4	; Get file format
	BMI	ILLFMT		; QA check that it's legal. -ve isn't
	CMP	%4,#F.MAX
	BHI	ILLFMT		; > F.MAX isn't
	BIT	#1,%4		; and odd isn't
	BEQ	GETSUB		; OK, continue
ILLFMT:	OUTPUT	UFS		; Else "unsupported format"
ERRORX:	SEC			; Say error
	CALLR	EXTRA		; Give up

; Get addresses of common output subroutines:
GETSUB:
.IF DF M$$EIS
	MUL	#7,%4		; Table is 7 entries wide
	MOV	%5,%4		; Keep (lo) index in %4
.IFF
	PUSH	%4		; Table is 7 entries wide
	ASL	%4		; Multiply %5 by 7
	ASL	%4		;  which is same as
	ASL	%4		;  multiplying by 8
	SUB	(SP)+,%4	; and subtracting once
.ENDC
	ADD	#TABLE,%4	; Point into table
	MOV	(%4)+,HSUB	; Start of file output
	MOV	(%4)+,SSUB	; Start of record output
	MOV	(%4)+,BSUB	; Byte-by-byte output
	MOV	(%4)+,ESUB	; End-of-record output
	MOV	(%4)+,TSUB	; End of file output
	.PAGE
	.SBTTL	COLLECT KEYWORDS

	CALL	FROMTH		; COLLECT FROM/THRU
	BCS	ERRORX		; TAKE ERROR EXIT

	GETKEY	PLUS		; TRY FOR PLUS KEYWORD
	BNE	141$		;  NE: NO GOTS
	CALL	GETHXL		; GET THE PLUS ADDRESS
	BCS	ERRORX		; TAKE ERROR EXIT
	BR	144$		; or set up ADDVAL
141$:
	GETKEY	MINUS		; TRY FOR MINUS KEYWORD
	BNE	146$		;  NE: NO GOTS
	CALL	GETHXL		; GET THE MINUS ADDRESS
	BCS	ERRORX		; TAKE ERROR EXIT
	NEG	R2		; NEGATE THE MINUS ADDRESS
	NEG	R1
	SBC	R2
144$:
	MOV	R1,ADDVAL	; SET UP ADDVAL
	MOV	R2,ADDVAL+2
146$:
	MOV	(%4)+,%5	; Get default bytes/record
	BMI	149$		; not allowed for TASK or Whitesmith's format
	GETKEY	WIDTH		; Get WIDTH keyword
	BNE	149$		; Default if not given
	TSTB	-1(%4)		; For big records (HEX and OCTAL types)
	BEQ	147$		; default WIDTH > 256.
	CALL	GETHX4		; Need a 4-byte number
	BR	148$
147$:	CLR	%1		; Others need only 2 digits, clear hi byte
	CALL	GETHX2		; Get lo
148$:	BCS	ERRORX		; Trap conversion error
	MOV	%1,%5		; OK, copy result
149$:	BIC	#100000,%5	; Strip no-WIDTH flag
	BEQ	150$		; ZERO IS ILLEGAL
	CMP	@%4,R5		; CANNOT EXCEED MAXIMUM WIDTH
	BHIS	151$		; LOS: DOES NOT
150$:
	OUTPUT	BDW		; BAD WIDTH
	BR	ERRORX		; TAKE ERROR EXIT
151$:
	MOV	%5,WIDTH	; SAVE THE WIDTH

	GETKEY	PARTIAL		; TRY FOR PARTIAL READ
	BNE	153$		;  NE: NO GOTS
	INCB	PART		; SET PARTIAL FLAG
153$:
	GETKEY	FILE		; GET FILE KEYWORD
	BEQ	154$		;  EQ: GOT IT
	OUTPUT	MSK		; MISSING KEYWORD
	BR	ERRORX		; TAKE ERROR EXIT
154$:
	CALL	PARSE		; PARSE THE FILE DESCRIPTOR
	BCS	ERRORX		;  CS: PARSE FAILURE - TAKE ERROR EXIT
	FDAT$R	#FDB,,,WIDTH	; Set F.RSIZ for fixed record files
				;   (Whitesmith's and task)
	OPEN$			; Open the file for WRITE or APPEND
	BCC	START		;  CC: OPENED O.K.
OPENERR:
	MOV	#FOE+FOELEN-4,%0 ; Address space for error code
	MOV	FDB+F.ERR,%1	; Fetch it
	CALL	PUTHX4		; Insert hex code
	MOV	#FOE,OUTDIR+Q.IOPL
	MOV	#FOELEN,OUTDIR+Q.IOPL+2
	JMP	ERRMSG		; Print message and close it (if FCS didn't)
	.PAGE
	.SBTTL	FILE GENERATION
; File generation consists of five operations:
;	1.	File header output -- H.xxx entries
;	2.	Start record of WIDTH bytes -- S.xxx entries
;	3.	Output WIDTH bytes -- B.xxx entries
;	4.	End record -- E.xxx entries
; Repeat from 2 until all done, then:
;	5.	Trailer output -- T.xxx entries
; All of these are format-dependent, selected by RWFORMAT.
;
; REGISTER USAGES:
;
; Headers, H.xxx entries:-
;	%0 -> start of output buffer
;    %1/%2 =  real transfer address, excluding ADDVAL
;	%3 -> PRGNAM
;	%4 =  length of PRGNAM, excluding trailing blanks
;	%5 =  length of first record
;    carry is set if appending to old file (when header may be suppressed)
;	      clear when creating new one.
; %5 should be updated (if necessary) for required first record length. No
; other registers need be preserved.
;
; Record start, S.xxx entries:-
;	%0 -> start of output buffer
;    %1/%2 =  real address, including ADDVAL
;    %3/%4 =  ditto
;    2(SP) =  offsetted address
;	%5 =  bytes left in (max length) record
;     CSUM =  0, ready for checksum
; %1 & %2 may be destroyed, %0 updated, %3-%5 must be preserved.
; 
; Byte output, B.xxx entries:-
;	%0 -> current location in record
;	%1 =  value to be written (low byte, hi byte clear)
;	%2 =  offsetted address (pointer into MEMORY)
;    %3/%4 =  real current address, including ADDVAL
;	%5 =  contains decrementing data count for current record
;     CSUM =  checksum
;   RECBYT =  number of bytes output in current record, including this
;   BCOUNT =  grand total of bytes output, including this
; %1 may be destroyed, %0 updated, %2-%5 must be preserved.
;
; End of record, E.xxx entries:-
;	%0 -> current location in output buffer
;	%1 =  no of data bytes output in this record
;	%2 =  offsetted address of next data byte
;    %3/%4 =  real address of next byte
; %0, %1 and %5 may be destroyed, %2-%4 must be preserved.
;
; End of file, T.xxx entries:-
;	%0 -> start of output buffer
;    %1/%2 =  transfer address, excluding ADDVAL
; No registers need be preserved.
; 
; Set byte count of first record so that subsequent ones will start at addresses
; which are exact multiples of WIDTH. First record length is therefore
;	WIDTH - ((FROM DIV STEP) MOD WIDTH)
; Any format (e.g. TASK) which doesn't like this should reset %5.
; Note: this is more than cosmetic -- HEX and OCTAL formats require it for
; PROM padding.
START:	CALL	ADD1ST		; Get first address, including ADDVAL, to %1/%2
	MOV	R1,R0		; Reverse hi/lo word order, for $DDIV		;29MAR5
	MOV	R2,R1								;29MAR5
	MOV	R0,R2								;29MAR5
	MOV	STEP,%0		; Get STEP
	CALL	$DDIV		; Divide (unsigned) quotient still in %1/%2
	MOV	%5,%0		; Get WIDTH to %0
	CALL	$DDIV		; Divide unsigned again
	SUB	%0,%5		; Subtract remainder for short first record

; 1. FILE HEADER
	MOV	FDB+F.NRBD+2,%0	; Address buffer start
	MOV	TRNSFR,%1	; May need start address
	MOV	TRNSFR+2,%2
	MOV	#PRGNAM,%3	; or program name
	MOV	#PRGNAM+8.,%4	; Max 8 chars
13$:	CMPB	-(%4),#SPACE	; Trim trailing spaces
	BNE	14$		; Until non-space character found,
	CMP	%4,%3		; Or we reach start of name (with space prefix)
	BHIS	13$		; (Back 1 too far compensates for up-coming INC)
14$:	SUB	%3,%4		; Compute length
	INC	%4		; Including char we point to
	CLR	CSUM		; Clear (header) checksum
	CLR	COMMON		; Clear common workspace (RIMWRD/RECCNT etc)
	CLR	RECBYT		; Clear record bytes
	CMPB	FDB+F.FACC,#FO.APD ; Set carry if open for append
	CLC			; else clear it
	BNE	15$		; For WRITE
	SEC
15$:	CALL	@HSUB		; Do header record

	MOV	LOBOUND,R3	; Get FROM addr
	MOV	LOBOUND+2,%4	; including offset
	ADD	ADDVAL,%3	; and ADDVAL
	ADC	%4
	ADD	ADDVAL+2,%4
	MOV	FROM,%2		; Get offsetted value 

; 2. START RECORD
20$:	MOV	FDB+F.NRBD+2,%0	; Address buffer
	CLR	CSUM		; Clear record checksum
	CLR	RECBYT		; Clear record bytes
	PUSH	%2		; Save offsetted address
	MOV	%3,%1		; Copy real address to %1
	MOV	%4,%2		; and %2 for PUTHXx
	CALL	@SSUB		; Output record start code
	POP	%2		; Restore offsetted address

; 3. OUTPUT WIDTH BYTES
30$:	CLR	%1		; Get a byte
	BISB	MEMORY(%2),%1	; Lo only
	ADD	%1,TOTCSM	; Add to WRITE's checksum
	INC	BCOUNT		; Count total bytes output
	INC	RECBYT		; and in this record
	CALL	@BSUB		; Write it out
	INCR34	STEP		; Advance real address,
	ADD	STEP,%2		; and memory pointer by STEP
	CMP	%2,THRU		; Reached very last?
	BHI	50$		; Yes, end file
	SOB	%5,30$		; No, repeat through this record

; 4. END RECORD
	MOV	RECBYT,%1	; End of record, load no of bytes output
	CALL	@ESUB		; Complete record, and output
	CLR	RECBYT		; Clear bytes in record counter
	MOV	WIDTH,%5	; Re-load max record length
	BR	20$		; Go start another

; 5. END FILE
50$:	MOV	RECBYT,%1	; See if partial record written
	BEQ	55$		; No, just end here
	CALL	@ESUB		; and complete final, short, record
55$:	TSTB	PART		; Trailer to be suppressed?
	BNE	57$		; Yes, just report
	MOV	TRNSFR,%1	; May need start address for trailer
	MOV	TRNSFR+2,%2
	MOV	FDB+F.NRBD+2,%0	; Address buffer
	CLR	CSUM		; Clear checksum
	CALL	@TSUB		; Output file trailer
	.PAGE
	.SBTTL	REPORT
57$:
	CLRB	ERRFLG		; Success if we come back here!
	TST	QUIET		; No-echo mode on command file selected?
	BEQ	CLOSE		; Yes, suppress statistics display. Just exit
571$:	MOV	#RSMLEN-RDTLEN-2,OUTDIR+Q.IOPL+2 ; Length w/o TRNSFR
	MOV	TRNSFR+2,R2	; Get transfer address
	MOV	TRNSFR,R1
	BNE	58$		; Go output if there is one: lo <> 0
	TST	%2		; or hi <> 0
	BEQ	60$		; Don't print transfer if there isn't one
58$:	MOV	#RDT+RDTLEN-8.,R0
	CALL	PUTHXJ
	ADD	#RDTLEN+2,OUTDIR+Q.IOPL+2 ; Add to length
60$:	MOV	LOBOUND,R1
	MOV	LOBOUND+2,R2
	MOV	#RDL+RDLLEN-9.,R0
	CALL	PUTHXJ
	TST	BCOUNT		; WAS THERE ANY DATA REALLY WRITTEN?
	BNE	228$		;  NE: ABSOLUTELY
	CLRL	LOBOUND		;  EQ: NOT ANY, MUST CLEAR STATISTICS
				;      (LONG WORD)
228$:
	MOV	HIBOUND,R1	; PUT HIGHEST ADDR ENCOUNTERED IN MESSAGE
	MOV	HIBOUND+2,R2
	MOV	#RDH+RDHLEN-9.,R0
	CALL	PUTHXJ
	MOV	BCOUNT,R1	; PUT BYTE COUNT INTO MESSAGE
	MOV	#RDC+RDCLEN-5,R0
	CALL	PUTHX4
	MOV	TOTCSM,R1	; PUT CHECKSUM IN MESSAGE
	MOV	#RDS+RDSLEN-5,R0
	CALL	PUTHX4
	MOV	#RDL,OUTDIR+Q.IOPL	; SET UP OUTPUT STATISTICS
ERRMSG:	DIR$	#OUTDIR

CLOSE:
	CLOSE$	#FDB

ERREXIT:
	MOV	RETSP,SP	; Purge stack on error
	RORB	ERRFLG		; Copy error flag to carry
NOOP:				; RETURN for formatting routines which do nothing
	RETURN
	.PAGE
	.SBTTL	BYTE/WORD WRITE ROUTINES

; Write byte or word in %1 where %0 points, updating checksum in %5 according
; to file format.


	.ENABL	LSB
; Intel and similar writes -- add byte(s) to checksum and output hex value.
; Do a proper 16-bit sum, for Rockwell use.

; Output 32-bit address if MODE<>16.
PUT32:	CMP	MODE,#16.	; If 16-bit mode
	BEQ	PUTWRD		; Just output 16 bits and return
	PUSH	%1		; Else save lo word
	MOV	%2,%1		; Copy hi
	CALL	PUTWRD		; Output that
	BR	5$		; Go pop lo and write that too

; Output 24-bit address if MODE<>16.
PUT24:	CMP	MODE,#16.	; If 16-bit mode
	BEQ	PUTWRD		; Just output 16 bits and return
	PUSH	%1		; Save lo word
	MOVB	%2,%1		; Get hi 8 bits
	CALL	PUTBYT		; Output bits 16-23
5$:	POP	%1		; Restore lo 16
;	BR	PUTWRD		; Store and return

; Output hex word, hi byte first.
PUTWRD:	CALL	(PC)		; Output hi byte				;29MAR5
	SWAB	%1		; Swap bytes (back)				;29MAR5
PUTBYT:	PUSH	%1		; Save whole word
	BIC	#^C377,%1	; Clear hi byte
	ADD	%1,CSUM		; Add byte
	POP	%1		; Restore whole word
PUTHE2:	CALLR	PUTHX2		; Output and return
	.DSABL	LSB	

; Output binary word from %1, adding bytes to (8-bit) checksum.
BINWRD:	CALL	BINBYT		; Lo byte first
	SWAB	%1		; Swap bytes for hi
;	CALLR	BINBYT		; Output hi and return

; Output binary byte, adding to (8-bit) checksum.
BINBYT:				; Byte write
	MOVB	%1,(%0)+	; Copy into buffer
	ADD	%1,CSUM		; Add to checksum
	RETURN			; and return
	.PAGE
	.SBTTL	MISCELLANEOUS SUBROUTINES

; Set %2/%1 to LOBOUND+ADDVAL = first real store address.			;29MAR5
ADD1ST:	MOV	LOBOUND,%1	; Fetch first address				;29MAR5
	MOV	LOBOUND+2,%2	; including offset				;29MAR5
	ADD	ADDVAL,%1	; and ADDVAL					;29MAR5
	ADC	%2								;29MAR5
	ADD	ADDVAL+2,%2							;29MAR5
	RETURN									;29MAR5

; Make sure record widths, including that of first record (in %5) are even.
; Called by H.XXX for formats that output words not bytes.
; Makes sure WIDTH and %5 are even by adding 1 if necessary.
; Preserves state of carry and all other registers.
EVENWIDTH:
	INC	WIDTH		; Make sure WIDTH is even
	BIC	#1,WIDTH	; For storing words
	INC	%5		; Same goes for first record counter
	BIC	#1,%5
	RETURN
	.PAGE
	.SBTTL	WRITE RECORD

; Enter with %0-> end of record + 1. Compute length, write to file, with error
; check, and return if OK, with %0 reset for next record.

ENDCSM:				; Enter here to append c/sum byte in %5
	MOV	CSUM,%1		; Copy checksum
	CALL	PUTHX2		; Append to record
;	BR	PUTREC		; Output record and return

PUTREC:	SUB	FDB+F.NRBD+2,%0	; Compute no of bytes in record
PUTCNT:	MOV	%0,FDB+F.NRBD	; Put it into FDB
PUTBLK:	PUT$S	#FDB		; Output record
	MOV	FDB+F.NRBD+2,%0	; Re-address buffer for next time
	BCC	NOOP		; RETURN to caller if OK
	MOV	#IOE+IOELEN-4,%0 ; Address space for error code
	MOV	FDB+F.ERR,%1	; Fetch it
	CALL	PUTHX4		; Insert hex code
	MOV	#IOE,OUTDIR+Q.IOPL
	MOV	#IOELEN,OUTDIR+Q.IOPL+2
	BR	ERRMSG		; Close file and exit
	.PAGE
	.SBTTL	INTEL FORMAT OUTPUT

;	:bbaaaattdddd...ddcc
; where:
;	bb	= byte count
;	aaaa	= address
;	tt	= block type:	00 = data,
;				01 = trailer,					;29MAR5
;				02 = extended address				;29MAR5
;				03 = transfer address				;29MAR5
;	dd...dd = data bytes
;	cc	= checksum, -(bb+aa+aa+tt+dd+...+dd)
;										;29MAR5
; If the current mode is > 16 bits, a segment base address of OFFST&FFFFFFF0	;29MAR5
; is set on startup, and all addresses in data records are relative to this.	;29MAR5
	.ENABL	LSB
H.INTEL:			; File start					;29MAR5
	CLR	SBA		; No segment base address used if		;29MAR5
	CMP	MODE,#^D16	; < 16 bits?					;29MAR5
	BHI	5$		; Yes, branch					;29MAR5
	RETURN			; No extended address record if so		;29MAR5
5$:	MOV	OFFST,R3	; Else fetch OFFSET				;29MAR5
	MOV	OFFST+2,R2	; with lo nybble clear				;29MAR5
	BIC	#^B1111,R3	; which will be added onto record addresses	;29MAR5	
	MOV	R3,SBA		; Save lo word					;29MAR5
.IF DF M$$EIS									;29MAR5
	ASHC	#-4,R2		; Shift right 4 bits giving USBA		;29MAR5
.IFF										;29MAR5
	.REPT	4		; Shift right 4 bits				;29MAR5
	ASR	R2								;29MAR5
	ROR	R3		; giving USBA					;29MAR5
	.ENDR									;29MAR5
.ENDC										;29MAR5
	MOV	#02,R2		; Need a type 02 record				;29MAR5
	CLR	R1		; But "address" 0000				;29MAR5
	CALL	10$		; Start it					;29MAR5
	MOV	R3,R1		; Get USBA					;29MAR5
	CALL	PUTWRD		; as data entry					;29MAR5
	MOV	R2,R1		; Length is 2 too				;29MAR5
	BR	E.INTEL		; Finish record					;29MAR5

S.INTEL:			; Record start
	CLR	%2		; Default record type is 0
	SUB	SBA,R1		; Adjust address for SBA (if used)			;29MAR5
10$:	MOVB	#':,(%0)+	; Begin with colon
	CMPB	(%0)+,(%0)+	; Leave byte count for E.INTEL
	CALL	PUTWRD		; Put address into record
	MOV	%2,%1		; Get record type
	BR	PUTBYT		; Load type and return, addressing data

B.INTEL=PUTBYT			; Byte write done directly

T.INTEL:			; File trailer
	BIS	R2,R1		; Is there a transfer address?			;29MAR5
	BEQ	20$		; No, no 03 record required			;29MAR5
	MOV	#03,R2		; Else set type 03				;29MAR5
	CLR	R1		; "Address" entry is 0000			;29MAR5
	CALL	10$		; Start record					;29MAR5
	MOV	TRNSFR+2,R1	; Load transfer hi as "CS"			;29MAR5
.IF DF M$$EIS									;29MAR5
	ASH	#^D12,R1	; Make it a USBA				;29MAR5
.IFF										;29MAR5
	SWAB	R1		; Make it a USBA				;29MAR5	
	.REPT	4								;29MAR5
	ASL	R1								;29MAR5
	.ENDR									;29MAR5
.ENDC										;29MAR5
	CALL	PUTWRD		; Output CS					;29MAR5
	MOV	TRNSFR,R1	; Get lo word complete, as "IP"			;29MAR5
	CALL	PUTWRD								;29MAR5
	MOV	#04,R1		; Byte count is 04				;29MAR5
	CALL	E.INTEL		; Complete record and output			;29MAR5
	CLR	CSUM		; Reclear checksum				;29MAR5

20$:	CLR	R1		; Trailer record is "address" 0			;29MAR5
	MOV	#1,%2		; Record type 1
	CALL	10$		; Start record with address
	CLR	%1		; Byte count is 0
;	BR	E.INTEL		; Do checksum like E.INTEL

E.INTEL:			; Record end
	PUSH	%0		; Save end of record pointer
	MOV	#RECORD+1,%0	; Whilst addressing byte count point
	CALL	PUTBYT		; Write byte count
	POP	%0		; Restore end of record pointer
	NEG	CSUM		; Checksum is - byte sum
JENDCSM:									;29MAR5
	BR	ENDCSM		; Append to end of record, output, and return
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE MOTOROLA FORMAT FILE

;	Stbbaaaadddd...ddcc
; where:
;	t	= block type: 0 = header, 1 = data, 9 = EOF
;	bb	= byte count, aa...cc inclusive
;	aaaa	= load address
;	dd...dd = data bytes
;	cc	= checksum such that bb+aa+aa+tt+dd+...+dd+cc = $FF

; Header record:	S0bbaaaannnn...nncc
;	nn...nn is program NAM, hex-encoded ASCII
H.MOTOROLA:			; File start
	BCS	10$		; No header if appending
	TST	%4		; or no name
	BEQ	10$
	MOV	#"S0,(%0)+	; Header starts S0
	TST	(%0)+		; Byte count done later
	CLR	%1		; "Address" is 0000
	CALL	PUTHX4		; PUTHX4 is easiest way to do it
	PUSH	%4		; Save length of name
5$:	MOVB	(%3)+,%1	; Fetch a byte of name
	CALL	PUTBYT		; Output as a hex byte
	SOB	%4,5$		; Until all done
	POP	%1		; Load byte count = length of name
	CALLR	EMR		; Complete and output record and return
10$:	RETURN			; For normal data start

S.MOTOROLA:			; Record start
	MOV	#"S1,(%0)+	; Record type is S1
	TST	(%0)+		; Skip count for the present
	CMP	MODE,#16.	; If 16-bit mode
	BNE	10$								;29MAR5
	CALLR	PUTWRD		; Just output 16 bits and return		;29MAR5
10$:	INCB	RECORD+1	; S2 if 24-bit
	CALLR	PUT24		; Output 24-bit address				;29MAR5

B.MOTOROLA=PUTBYT		; Byte write done directly

; Trailer record is S903aaaacc or S804aaaaaacc.
T.MOTOROLA:			; File trailer
	MOV	#"S9,(%0)+	; Assume record type is 9
	TST	(%0)+		; Skip count for the moment
	CMP	MODE,#16.	; If not 16-bit mode
	BEQ	10$
	DECB	RECORD+1	; Record type is S8
10$:	CALL	PUT24		; Output 16 or 24-bits as necessary
	CLR	%1		; No data bytes
;	BR	E.MOTOROLA	; End like any other record

E.MOTOROLA:			; Record end
	CMP	MODE,#16.	; If 24-bit mode
	BEQ	EMR
	INC	%1		; Address is 1 byte more 
EMR:	ADD	#3,%1		; Byte count = data + address + checksum
	PUSH	%0		; Save end of record pointer
	MOV	#RECORD+2,%0	; Whilst addressing byte count point
	CALL	PUTBYT		; Write byte count there
	POP	%0		; Restore end of record pointer
	COM	CSUM		; Checksum is ~ byte sum
	BR	JENDCSM		; Append to end of record, output, and return	;29MAR5
	.PAGE
	.SBTTL	WRITE ROCKWELL FORMAT FILE

;	;bbaaaadddd...ddcccc
; where:
;	bb	= no of data bytes, dd...dd
;	aaaa	= start address
;	cccc	= checksum bb+aa+aa+dd+...+dd
;
H.ROCKWELL=NOOP			; No special file start (RECCNT cleared above)

S.ROCKWELL:			; Record start
	MOVB	#';,(%0)+	; with semicolon
	CMPB	(%0)+,(%0)+	; Skip byte count
	CALLR	PUTWRD		; Store address (lo)

B.ROCKWELL=PUTBYT		; Byte write done directly

T.ROCKWELL:			; File trailer is
	MOV	RECCNT,%1	; aaaa = no of records output
	CALL	S.ROCKWELL	; Start record
	CLR	%1		; 0 data bytes
;	BR	E.ROCKWELL	; Finish and return, as usual

E.ROCKWELL:			; Record end
	PUSH	%0		; Save end of record pointer
	MOV	#RECORD+1,%0	; Whilst addressing byte count point
	CALL	PUTBYT		; Write byte count there
	POP	%0		; Restore end of record pointer
	INC	RECCNT		; Count records
	MOV	CSUM,%1		; Checksum is whole word sum
	CALL	PUTHX4
	CALLR	PUTREC		; Output and return
	.PAGE
	.SBTTL	WRITE RCA FORMAT FILE

; Data records:
;	!Maaaa dd dd dd ...dd;
; !M only appears on first records, no ; on final record.
;
; Trailer:
;	$P{ssss}
; where:
;	aaaa	= load address
;	dd ...	= data
;	ssss	= transfer address (omitted if none)

	.ENABL	LSB
H.RCA=NOOP			; No special file start

S.RCA:				; Record start
	CMP	2(SP),FROM	; If very first record
	BNE	10$
	MOV	#"!M,(%0)+	; address starts !M
10$:	CALLR	PUTHX4		; Write address anyway

B.RCA:				; Write byte
	MOVB	#SPACE,(%0)+	; preceded by space
	CALLR	PUTHX2		; Then the byte itself

E.RCA:				; Record end
	CMP	%2,THRU		; Unless very last byte just done
	BHI	20$		; so now addressing last+1
	MOVB	#';,(%0)+	; append a semicolon
	BR	20$ ; (PUTREC)	; Output record and return

T.RCA:	MOV	#"$P,(%0)+	; Flag trailer with $P
	TST	%1		; Transfer address?
	BEQ	20$		; No, no trailer record
	CALL	PUTHX4		; Output lo word
20$:	CALLR	PUTREC		; Output and return
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE TEKTRONIX (TEKHEX) FORMAT FILE

;	/aaaabbhhdddd...ddcc
; where:
;	aaaa	= start address
;	bb	= no of data bytes, dd...dd
;	hh	= header checksum a+a+a+a+b+b
;	cc	= data checksum d+d+...+d+d

H.TEKHEX=NOOP			; No special file start

S.TEKHEX:			; Record start
	MOVB	#'/,(%0)+	; Start line with slash
	CALL	10$		; Write word
	MOV	CSUM,HDCSUM	; Save header checksum so far
	ADD	#4,%0		; Skip byte count and checksum, for data start
	CLR	CSUM		; Clear data checksum
	RETURN

10$:				; Write word, adding nybbles to checksum
	CALL	@PC		; Call following code twice:
	SWAB	%1		; Swap bytes
B.TEKHEX:			; Write byte, adding nybbles to checksum
	PUSH	%1		; Save value
	ASH	#-4,%1		; Shift down hi nybble
	CALL	10$		; Write, adding to checksum
	MOV	@SP,%1		; Fetch back
	CALL	10$		; For lo nybble
	POP	%1		; Restore original value
	RETURN			; and return

10$:	BIC	#^C^B1111,%1	; Select lo nybble only
	ADD	%1,CSUM		; Add to checksum
	CALLR	PUTHX1		; Output hex digit and return

	.ENABL	LSB
E.TEKHEX:			; Record end
	PUSH	%1		; Save data byte count
	MOV	CSUM,%1		; Get data checksum
	CALL	PUTHX2		; Append to record
	POP	%1		; Restore byte count
10$:	PUSH	%0		; Save end of record pointer
	MOV	#RECORD+5,%0	; Whilst addressing byte count point
	MOV	HDCSUM,CSUM	; Get header checksum so far (address only)
	CALL	B.TEKHEX	; Write byte count
	MOV	CSUM,%1		; Get header checksum
	CALL	PUTHX2		; Store that too
	POP	%0		; Restore end of record pointer
	CALLR	PUTREC		; Output record and return

; Trailer is start address (if any), and byte count 0.
.IF DF TEKABO									;29MAR5
; Output a // abort block if there isn't a trailer.
.IFTF										;29MAR5
T.TEKHEX:			; File trailer
.IFT										;29MAR5
	BIS	%1,%2		; See if there is a transfer address
	BEQ	ABOTKH		; Do abort block if not
.IFTF										;29MAR5
20$:	CALL	S.TEKHEX	; Start record in the normal way
	CLR	%1		; Byte count 0
	BR	10$		; Complete record (header only) and return
.ENDC										;29MAR5
.IF DF TEKABO!EXTABO								;29MAR5

; No start address, end with an abort block instead.
ABOTKH:	MOV	#ABOBLK,FDB+F.NRBD+2 ; Set message address
	MOV	#ABOLEN,%0	; and length
	CALLR	PUTCNT		; Output and return
.ENDC										;29MAR5
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE EXTENDED TEKHEX FORMAT FILE

;	%bbtccna...addd...dd
;
; where:
;	bb	is character count, bb (inclusive) to end
;	t	is type: 3 = symbol definition (header), 6 = data, 8 = trailer.
;	cc	is checksum, sum of all bytes except itself and %, with special
;		character coding, see CKSUM.
;	na...a	is a variable-length address
;	d...d	is data bytes
	.ENABL	LSB

; File header is a type 3 block, with special format:
;	%bb3ccn<name>0n<lobound>n<count>

H.EXTENDED:
	BCC	5$		; No header if appending
1$:	RETURN
5$:	TST	%4		; or no name
	BEQ	1$
	ADD	#6,%0		; Else start at byte 6
	MOV	%4,%1		; with length of name
	CALL	PUTHX1		; 1 hex digit
10$:	MOVB	(%3)+,(%0)+	; Copy name itself
	SOB	%4,10$
	MOVB	#'0,(%0)+	; 0 to introduce section definition field
	CALL	ADD1ST		; Which is lo address of module, inc ADDVAL
	CALL	PUTHXV		; Variable-length hex number
	MOV	COUNT,%1	; Get count
	CLR	%2		; Single-precision
	CALL	PUTHXV		; Variable-length again
	MOVB	#'3,ETKTYP	; Type 3 block
	BR	100$		; Go complete and output

S.EXTENDED:			; Start data record
	ADD	#6,%0		; Leave header for later
	CALLR	PUTHXV		; Insert variable-length load address and return

B.EXTENDED=PUTHE2		; Output byte direct

E.EXTENDED:			; End data record
	MOVB	#'6,ETKTYP	; Load record type flag

; End of (any) record -- fill in header, computing checksum.
100$:	PUSH	%0		; Save end pointer
	PUSH	%3		; and %3
	MOV	%0,%3		; Copy pointer
	MOV	#RECORD,%0	; Point back to start of record
	MOVB	#'%,(%0)+	; All records begin %
	SUB	%0,%3		; Set %3 = record length, excluding %
	MOV	%3,%1		; Insert record length
	CALL	PUTHX2
	MOVB	ETKTYP,(%0)+	; and block type
	MOVB	#'0,@%0		; Then two zeroes
	MOVB	(%0)+,(%0)+	; For checksum not included in itself
	SUB	#5,%0		; Point back to start of record
110$:	MOVB	(%0)+,%1	; Get a character
	CALL	CKSUM		; Convert code and add to checksum
	SOB	%3,110$		; Repeat for all string
	MOV	CSUM,%1		; Load checksum
	MOV	#RECORD+4,%0	; Point to space for it
	CALL	PUTHX2		; Store it there
	POP	%3		; Restore %3
	POP	%0		; and end-of-record pointer
	CALLR	PUTREC		; Output and return

T.EXTENDED:			; Trailer block
.IFDF EXTABO									;29MAR5
	PUSH	%1		; See if we have a start address
	BIS	%2,(SP)+
	BNE	120$		; Yes, store it
	JMP	ABOTKH		; No, end with abort block instead
.ENDC										;29MAR5
120$:	CALL	S.EXTENDED	; Put in start address
	MOVB	#'8,ETKTYP	; Block type is 8
	BR	100$		; End file
	.DSABL	LSB

; Find character value corresponding to ASCII code of char in %1, and add it to
; CSUM. This is more-or-less a copy of the routine of the same name in READ.

CKSUM:	CMPB	#'0,R1		; COMPARE LOW BYTE OF R1 WITH '0'
	BGT	SPCLOW		; CHECK TO SEE IF BYTE IS A '$','%','.', OR '_'
	SUB	#'0,R1		; COMMENCE TO CONVERTING
	CMPB	#9.,R1		; CHECK RANGE 0. THRU 9.
	BGE	OK		; GOOD TEK HEX CHARACTER
	SUB	#7.,R1		; TAKE A SECOND CONVERSION STEP
	CMPB	#10.,R1		; CHECK FOR 'A' (UPPER CASE)
	BGT	BAD		; NOT VALID TEK HEX
	CMPB	#35.,R1		; CHECK FOR 'Z' (UPPER CASE)
	BGE	OK		; VALID BETWEEN 'A' AND 'Z'
	SUB	#2.,R1		; ADJUST FOR LOWER CASE
	CMPB	#40.,R1		; CHECK FOR 'a' (LOWER CASE)
	BGT	SPCHI		; CHECK FOR '_' (UNDERLINE)
	CMPB	#65.,R1		; CHECK FOR 'z' (LOWER CASE)
	BGE	OK		; VALID BETWEEN 'a' THRU 'z' (LOWER CASE)
	BR	BAD		; NOT VALID TEK HEX
SPCLOW: CMPB	#'$,R1		; CHECK FOR '$'
	BEQ	OK		; $ IS VALID TEK HEX
	CMPB	#'%,R1		; CHECK FOR '%'
	BEQ	OK		; % IF VALID TEK HEX
	SUB	#8.,R1		; ADJUST TO CHECK '.' (PERIOD)
	CMPB	#38.,R1		; CHECK FOR '.'
	BEQ	OK		; '.' IS VALID TEK HEX
	BR	BAD		; NOT VALID TEK HEX
SPCHI:	INC	R1		; ADJUST TO CHECK '_'
	CMPB	#39.,R1		; CHECK FOR '_' (UNDERSCORE)
	BEQ	OK		; '_' IS VALID TEK HEX
BAD:	OUTPUT	BET		; BAD CHAR IN EXTENDED TEK HEX
	JMP	CLOSE		; GET OUT
OK:	ADD	R1,CSUM		; ADD TO CHECK SUM
	RETURN
	.PAGE
	.SBTTL	WRITE TEXAS FORMAT FILE

;	tddddtddddtdddd...
; where:
;	t	= record type ("tag character"):
;			0 = program name (00000nnnnnnnn)
;			1 = start address
;			7 = checksum, -(sum of all ASCII chars since last csum)
;			9 = load address
;			B = data
;			F = end of record (no dddd)
;			: = end of file
;		others are defined, but not supported by HEX
;	dddd	= address or data, always a full word.
;
; Addresses should be even, since whole words are stored, but don't check this,
; in case hi or lo bytes only are being written.
	.ENABL	LSB
H.TEXAS:			; File start
	CALL	EVENWIDTH	; Make sure widths are even
	BCS	4$		; No header record if appending
	TST	%4		; or no program name
	BNE	5$		; Yes, go store it
4$:	RETURN			; No header record if no name
5$:	MOVB	#'0,(%0)+	; Else header type 0
	CLR	%1		; + relocatable code length 0000 (none)
	CALL	PUTHX4
	MOV	#8.,%4		; Load byte count for name, always full 8 chars
10$:	MOVB	(%3)+,(%0)+	; Copy character of name
	SOB	%4,10$		; Repeat until all done
;	BR	E.TEXAS		; Complete and output record

E.TEXAS:			; Record end
	CLR	%1		; Clear %1 for checksum or dummy null
	BIT	#1,RECBYT	; Should have ended on a full word
	BEQ	60$		; OK if so
	CALL	PUTHX2		; Else insert a dummy null
	INC	COUNT		; Count it
60$:	MOVB	#'7,(%0)+	; Checksum tag is '7'
; Record checksum is -(sum of ASCII characters up to here).
	PUSH	%3		; Save %3
	MOV	%0,%3		; Copy end of record pointer
	MOV	#RECORD,%0	; Load start
	CLR	%1		; Clear checksum
	SUB	%0,%3		; Compute length
	CLR	-(SP)		; Make space on stack
70$:	MOVB	(%0)+,@SP	; Fetch character
	SUB	@SP,%1		; Subtract from checksum
	SOB	%3,70$		; Repeat through record
	POP			; Purge stack
	POP	%3		; Restore %3
	CALL	PUTHX4		; Append checksum to record
	MOVB	#'F,(%0)+	; Finally, an F
	CALLR	PUTREC		; Output record and return

S.TEXAS:			; Record start
	MOVB	#'9,(%0)+	; Always have an address
	CALLR	PUTHX4		; Put it into record and return

; Only whole words are stored, even bytes first, preceded by B.
B.TEXAS:			; Byte write
	BIT	#1,RECBYT	; Is this an odd byte?
	BEQ	50$		; Yes if bit clear, just put in byte
	MOVB	#'B,(%0)+	; No, even, start with a B
50$:	CALLR	PUTHX2		; Then data byte

T.TEXAS:			; File trailer
	BIS	%1,%2		; See if we have a transfer address
	BEQ	80$		; No, just do EOF record
	MOVB	#'1,(%0)+	; Yes, tag character is 1
	CALL	PUTHX4		; Output transfer address (lo word only)
	CALL	60$		; Do checksum	
80$:				; EOF record -- : and HFE version no
	MOV	#IDT+1,FDB+F.NRBD+2 ; Address ident & version number
	MOV	#IDTLEN-1,%0	; Load length, excluding CR prefix
	CALLR	PUTCNT		; Output and return
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE MOSTEK FORMAT FILE

; General record has the form:
;	ttbbbbdd...ddcc
; where:
;	tt	is type: F0 = header, F2 = "enumerated" (contiguous) data,
;			 F4 = iterated data, F6 = trailer.
;	bbbb	is no of bytes, dd...cc
;	cc	is checksum = -(tt+bb+bb+dd+...dd)

; Header record is:
;	F0bbbbnnss...ssaappmmllllhhhhcc
; where:
;	nn	is length of module name
;	ss	is nn hex-encoded ASCII bytes of name
;	aa	is address size, 16 or 32 bits
;	pp	is processor ID, always written as 00 (unknown)
;	mm	is module type: 02 = no transfer address, 03 = transfer address
;	llll	is low load address (LOBOUND+ADDVAL lo word)
;	hhhh	is high load address (HIBOUND+ADDVAL hi word)

H.MOSTEK:
	BCS	MOSTKX ; (RETURN) ; No header if APPENDing
	MOVB	#360,MOSTYP	; Record type is F0
	ADD	#6,%0		; Put that and length in later
	MOV	%4,%1		; Load module name length
	CALL	PUTBYT		; Output as nn
	TST	%4		; Was there a name?
	BEQ	20$		; No, bypass copy
10$:	MOVB	(%3)+,%1	; Yes, get ASCII byte
	CALL	PUTBYT		; Output
	SOB	%4,10$		; whole of name
20$:	MOVB	MODE,%1		; Get address size
	CMPB	%1,#16.		; If not 16.
	BEQ	30$
	MOV	#32.,%1		; Make it 32. (only other option)
30$:	CALL	PUTBYT		; Output address size
	CLR	%1		; Don't know processor
	CALL	PUTBYT		; so say 00
	TST	(%1)+		; Type 2
	TSTB	PART		; if partial
	BNE	40$
	INC	%1		; Else type 3
40$:	CALL	PUTBYT		; Output file type
	CALL	ADD1ST		; Get low load address + ADDVAL
	CALL	PUTWRD		; Output 4 lo digits
	ADD	COUNT,%1	; Hi is low + count
	DEC	%1		; - 1
	CALL	PUTWRD		; Output that
;	BR	E.MOSTEK	; End record and return

E.MOSTEK:			; End of record
	PUSH	%0		; Save end pointer
	MOV	#RECORD,%0	; Point to start of record
	MOVB	MOSTYP,%1	; For record type
	CALL	PUTBYT		; Store that
	MOV	@SP,%1		; Compute no of characters in record
	SUB	#RECORD+4,%1	; Less ttbbbb, but including checksum
	ASR	%1		; Convert to bytes
	CALL	PUTWRD		; Put it in
	POP	%0		; Restore pointer to checksum
	NEG	CSUM		; Negate it
	CALLR	ENDCSM		; Append to record, output and return

; Start of record. Do an enumerated type, i.e. byte-by-byte, unless all the
; %5 (>5) bytes from here on have the same value, when a simple iterated
; block is done instead.
S.MOSTEK:			; Start record
	MOVB	#362,MOSTYP	; Assume "enumerated" type
	ADD	#6,%0		; Type and count done later
	CALL	PUT32		; Output 16- or 32-bit address according to MODE
	CMP	%5,#5		; Would it be shorter to do an iterated record
	BLOS	MOSTKX		; taking 5 bytes? Not if <= 5 left to do
	MOV	2(SP),%2	; Yes, get offsetted address of upcoming byte
	MOVB	MEMORY(%2),%1	; Get byte value
	PUSH	%5		; Save count
	DEC	%5		; Don't need to check first
20$:	ADD	STEP,%2		; Address next byte
	CMPB	MEMORY(%2),%1	; Same as first?
	BNE	30$		; No, don't use iterated record
	SOB	%5,20$		; Yes, keep checking
; If we reach here, all bytes were the same. Output iterated record as:
;	nnnn0001dd
; where:
;	nnnn	is the repeat count, from %5
;	00	indicates no inner iteration blocks
;	01	indicates 1 byte in repeat pattern
	MOVB	#364,MOSTYP	; Note record type is F4, not F2
	POP	%1		; Get count
	CALL	PUTWRD		; Output word
	DEC	%1		; Include repeat count-1
	ADD	%1,BCOUNT	; in total file byte count
	MOV	#0001,%1	; Output inner block flag and count
	CALL	PUTWRD
; Update real and offsetted addresses and set %5 = 1, so following call of
; B.MOSTEK will show the data byte and complete the record normally.
	MOV	%2,%1		; Copy new offsetted address
	SUB	2(SP),%1	; Find how many STEPs we changed by
	INCR34	%1		; and so update real address
	MOV	%2,2(SP)	; Update offsetted address
	PUSH	#1		; Just one last byte of record to do
30$:	POP	%5		; Get (revised) count from stack
MOSTKX:	RETURN			; Go for byte output

B.MOSTEK=PUTBYT			; Byte output is just a that

T.MOSTEK:			; File trailer
	MOVB	#366,MOSTYP	; Record type is F6
	ADD	#6,%0		; Skip that and byte count as usual
	PUSH	%1		; See if we have a transfer address
	BIS	%2,(SP)+
	BEQ	E.MOSTEK	; Not if zero, just end record
	CALL	PUT32		; We do, output 16- or 32- bits as reqd by MODE
	BR	E.MOSTEK	; End record
	.PAGE
	.SBTTL	WHITESMITH'S V2.1 LINKER OUTPUT (XEQ. FILE)

; File consists of single-byte, fixed-length records, written by HEX as:
;
; bytes		value		function
; -----		-----		--------
; 1		231		ident byte, always 99H
; 2		220		configuration byte:
;				bit3:	0 = ints are 2 bytes, 1 = 4 bytes
;				bit4:	1 = ints stored lsb first
;				bit 7:	1 = no relocation information supplied
; 3-4		0		size of symbol table (0=none)
; Next have 6 ints, 2- or 4-bytes according to MODE=16 or 32.
; int1		COUNT		number of text (program code) bytes
; int2		0		number of data bytes (0=none)
; int3		0		no of bss bytes (unitialised variables) (0=none)
; int4		0		size of stack+heap (0=none)
; int5		LOBOUND		text area start address
; int6		0		data area start address (0=none)
; rest		ddd ...		output data FROM ... TO
;
; See READ for full meaning of those entries which are dummies here. Note that
; there is no way for HEX to distinguish between text and data, so everything
; is taken as text.
;
; CAUTION: Whitesmiths set the file record size to 1, but write to every byte
; in the file, whereas since FCS forces records to start at even addresses,
; it only writes to every other byte in these circumstances. Since we are in
; locate mode, it is quite possible to write into the gaps in the same way,
; but this may not work on later releases of RSX-11M (OK for V4.0).
H.WHITESMITHS:
	MOV	#2,%5		; Always write data bytes in pairs
	MOV	%5,WIDTH
	MOV	(PC)+,@%0	; First byte is
	.BYTE	231,220		; 99H, and second configuration byte, as above
	MOV	MODE,%4		; Clear flag on MODE
	SUB	#16.,%4		; if 16-bits, set <>0 if 32
	BEQ	10$		; Leave bit 3 clear if 16 bits
	BIS	(PC)+,@%0	; Else if 24 or 32 bits
	.BYTE	0,^B1000	; then set it
10$:	CALL	PUTBLK		; Output the pair
	CLR	@%0		; No symbols
	CALL	PUTBLK
	MOV	COUNT,@%0	; Total text size COUNT
	CLR	%1		; 16 bits only
	CALL	30$		; Output text size
	CALL	20$		; 3 dummy null words
	CALL	20$
	CALL	20$
	CALL	ADD1ST		; First address is LOBOUND+ADDVAL
	MOV	%1,@%0		; Copy lo, hi in %2				;29MAR5
	CALL	30$		; Output address
20$:	CLR	@%0		; Null int
	CLR	%1
30$:	CALL	PUTBLK		; Output lo word already in buffer
	TST	%4		; See if there should be a hi one
	BEQ	40$		; No, return
	MOV	%2,@%0		; Yes, store second				;29MAR5
	CALLR	PUTBLK		; Output and return
40$:	RETURN

B.WHITESMITHS=B.OBJECT		; Byte output: MOVB %1,(%0)+

S.WHITESMITHS=NOOP		; No special record start

E.WHITESMITHS=PUTBLK		; Finish by outputting "1"-byte (really 2)

T.WHITESMITHS=NOOP		; No file trailer
	.PAGE
	.SBTTL	WRITE PDP-8/IM6100 RIM/BIN FORMAT FILE

; File consists of binary records of byte pairs in the form:
;	tthhhhhh 00llllll
;
;	tt = record type: 10 = leader, 01 = address, 00 = data
;
; RIM (Read-In-Mode) has addresses prefixing each byte pair.
; BIN has addresses only at beginnings of records.

	.ENABL	LSB
H.RIM:				; Headers
H.BIN:	CALL	EVENWIDTH	; Make sure widths are even
	BCS	30$ ; (RETURN)	; No leader if APPENDING

T.RIM:				; Trailer = header,
T.BIN:	MOV	#50.,%4		; are just 5"
10$:	MOVB	#200,(%0)+	; of track 7 set
	SOB	%4,10$
12$:	CALLR	PUTREC		; Output and return

S.RIM=NOOP			; No special start for RIM records

B.RIM:
	BIT	#1,RECBYT	; First byte of a pair?
	BEQ	15$		; No, second, go output value
	MOVB	%1,RIMWRD+1	; Yes, just save it for second
	MOV	%3,%1		; Get address lo word
;	CALLR	S.BIN		; Required to prefix each byte pair

S.BIN:	ASR	%1		; Output address, halved for words
	BIC	#^C^B111111111111,%1 ; Forgetting values > 12 bits
	BIS	#10000,%1	; Set address flag
	BR	20$		; Go store it

B.BIN:	BIT	#1,RECBYT	; First byte of a pair?
	BEQ	15$		; No, second, have a word to output
	MOVB	%1,RIMWRD+1	; Yes, first, just save it
	RETURN			; Until we have other half

15$:	CLRB	RIMWRD		; Now have lo byte, clear mask
	BIS	RIMWRD,%1	; OR in hi
	BIC	#^C^B111111111111,%1 ; Select lo 12 bits only
20$:	PUSH	%1		; Save word
	BIC	#^C^B111111,@SP	; For lo 6 bits
	ASL	%1		; Shift up 2 bits to align hi 6+flag
	ASL	%1
	SWAB	%1		; Get hi byte
	MOVB	%1,(%0)+	; Store it
	MOVB	(SP)+,(%0)+	; followed by lo 6 bits
30$:	RETURN			; and exit

E.RIM:	ROR	%1		; See if we ended on an odd byte (%1 is odd)
	BCC	12$ ; (PUTREC)	; Output record now if not
	CLR	%1		; Load a dummy null byte
	CALL	B.RIM		; and output that first
	BR	12$

E.BIN:	ROR	%1		; Check for odd byte count
	BCC	12$
	CLR	%1		; Else need a padding null again
	CALL	B.BIN
	BR	12$
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE HEX-CHAR AND OCTAL-CHAR FORMATS

;	^B$Abbbb,
;	aaaa-ddxddxddx...ddx
;	^C$Sssss,
; where:
;	bbbb	is PROM base address
;	aaaa	is load address
;	dd	is data
;	x	is separator, in SEPTOR, usually space, comma, ', or %
;	ssss	is checksum = dd+dd+...
;
; See READ, and manual for discussion of the difference between addresses
; bbbb and aaaa.

	.ENABL	LSB
H.OCTAL:			; File start
	MOV	#200$,PUTBSB	; Put byte routine is local 200$
	MOV	#220$,PUTWSB	; Put word is 220$
	MOV	#220$,PUTASB	; Put address is 20$,
	CMP	MODE,#16.	; if 16 bits
	BEQ	1$
	MOV	#240$,PUTASB	; Else 240$
	BR	1$		; Join common code
H.HEX:
	MOV	#PUTHX2,PUTBSB	; Put byte routine is PUTHX2
	MOV	#PUTHX4,PUTWSB	; Put word is PUTHX4
	MOV	#PUTHXL,PUTASB	; Put address may need more, according to MODE
1$:	MOVB	#'-,ADREND	; Set up flag char for aaaa-
	CMPB	SEPTOR,#'-	; Use -, unless that's the separator
	BNE	2$
	MOVB	#'=,ADREND	; When use = instead
; If there is one, output program name as first (comment) line.
2$:	TST	%4		; Any name?
	BEQ	6$		; No, just return
3$:	MOVB	(%3)+,(%0)+	; Copy bytes
	SOB	%4,3$
	BR	40$ ; (PUTREC)	; Output name and return

S.HEX:				; Record start
S.OCTAL:CLR	%1		; Dummy address of 0
	MOVB	BEGFLG,(%0)+	; Start with begin data control code
	MOVB	#'$,(%0)+	; '$'
	MOVB	#'A,(%0)+	; and 'A'
	CALL	100$		; Then address, and output record
	CALL	PUTSTAR		; Separate address and data with a '*' record
; Output padding null bytes, if necessary, between load address and PROM base.
; %4 = number in first record, WIDTH-%5 = no of nulls (always zero on all but
; first PROM block).
	MOV	WIDTH,%2	; Compute no of padding bytes required
	SUB	%5,%2
	BEQ	6$		; 0 means at base of PROM already
	MOV	STEP,%1		; <>0. Get STEP
.IF DF M$$EIS
	MUL	%2,%1		; Step back address by no of pad bytes * STEP
.IFF
	PUSH	%0
	MOV	%2,%0		; Step back address
	CALL	$MUL		; by number of padding bytes * STEP
	POP	%0
.ENDC
	DECR34	%1
5$:	CLR	%1		; Store nulls
	INC	COUNT		; Include in total
	INC	RECBYT		; and record counters
	CALL	B.HEX		; just like standard output would
	INCR34	STEP		; Advance address
	SOB	%2,5$		; Repeat until required no done
6$:	RETURN			; and return

B.HEX:				; Byte write
B.OCTAL:CMP	%0,FDB+F.NRBD+2	; At start of line?
	BNE	7$		; No, just output byte
	PUSH	%1		; Yes, save byte
	PUSH	%2		; and offsetted address
	MOV	%3,%1		; Get real address
	MOV	%4,%2
	CALL	@PUTASB		; Output in required radix
	MOVB	ADREND,(%0)+	; with end mark, '-' or '='
	POP	%2		; Restore offsetted address
	POP	%1		; and byte value
7$:	ADD	%1,CSUM		; Add to checksum
	CALL	@PUTBSB		; Output byte
	MOVB	SEPTOR,(%0)+	; and terminator
	BIT	#17,RECBYT	; 16 bytes on this line?
	BEQ	40$		; Write out line if so
20$:	RETURN			; More this line if not

E.HEX:				; Record end
E.OCTAL:CMP	%0,FDB+F.NRBD+2	; Just done newline?
	BEQ	25$		; Yes, line currently blank
	CALL	PUTREC		; No, write out last line
25$:	MOV	CSUM,%1		; Get checksum
	MOVB	ENDFLG,(%0)+	; Start with end data control char
	MOVB	#'$,(%0)+	; '$'
	MOVB	#'S,(%0)+	; and 'S'
	CALL	100$		; Output checksum, and record
; Separate blocks by line of 20 spaces, then ^S^Q so Data I/O programmer
; doesn't concatenate blocks. ^S turns off (some) tape readers, following
; ^Q prevents clagging up VT100 keyboard.
	MOV	#20.,%5		; Load counter
30$:	MOVB	#SPACE,(%0)+	; Output spaces
	SOB	%5,30$
	MOVB	#'S&37,(%0)+	; Then control/S
	MOVB	#'Q&37,(%0)+	; and control Q
40$:	CALLR	PUTREC		; Output record and start again

T.HEX=NOOP			; No file trailer
T.OCTAL=NOOP

; Output header or checksum: control code, $, A/S, hex/octal no, and comma:
100$:	CALL	@PUTWSB		; Output number -- hex or octal
	MOVB	#',,(%0)+	; Complete with comma
	BR	40$ ; (PUTREC)	; Output record and return

; Output octal byte/word, using Syslib routines
200$:	PUSH	%2		; Output byte: save %2
	MOV	SP,%2		; Non-z-sup indicator for $CBTMG
	CALL	$CBTMG		; Store byte
	BR	230$		; Restore %2 and return

220$:	PUSH	%2		; Output word: save %2
	SETNZ	%2		; Non-z-sup indicator
	CALL	$CBOMG		; Output octal word
230$:	POP	%2		; Restore %2
	RETURN			; and return

; Output zero-suppressed 24- or 32-bit octal address from %1/%2 (destroyed).
240$:	CMP	MODE,#24.	; 24-bits?
	BGT	250$		; No, 32
	BIC	#^C377,%2	; Yes, lose bits 25-31
250$:	CLR	-(SP)		; Clear end-of-number flag
260$:	PUSH	%1		; Push lo word onto LIFO stack
	BIC	#^C7,@SP	; Bits 0-2 only
	ADD	#'0,@SP		; Make into an ASCII digit (clears carry
	.REPT	3		; for unsigned) shift %2/%1 3 bits right
	ROR	%1
	ROR	%2
	.ENDR
	BNE	260$		; Repeat while either word
	TST	%1
	BNE	260$		; <> 0
270$:	MOVB	(SP)+,(%0)+	; Done: pop bytes off stack into record
	BNE	270$		; Until flag is met
	DEC	%0		; Lose flag
	RETURN			; and return
	.DSABL	LSB
	.PAGE
	.SBTTL	WRITE TCI FORMAT
;
;	@aaaadddd...dd
; where:
;	aaaa	= address
;	dd...dd is data bytes
;
.IF NDF TCI
NOTIMP	TCI
.IFF
H.TCI=NOOP			; No special file start

S.TCI:				; Record start
	MOVB	#'@,(%0)+	; Start line with @
	CALLR	PUTHX4		; and address

B.TCI=PUTHE2			; Byte write done directly

E.TCI=PUTREC			; Record end, just output

T.TCI=NOOP			; No file trailer
.ENDC
	.PAGE
	.SBTTL	FAIRCHILD FAIRBUG FORMAT

;	Saaaa
;	Xddddddddddddddc
;	*
; where:
;	aaaa	= address
;	dd...dd	= data bytes
;	c	= checksum, lo nybble of sum of data byte nybbles
	.ENABL	LSB
H.FAIRCHILD:			; File start
	MOVB	#'S,(%0)+	; begin line with 'S'
	MOV	LOBOUND,%1	; Get address + offset (only lo word needed)
	ADD	ADDVAL,%1	; + ADDVAL
	CALL	PUTHX4		; Output address
	BR	10$		; and record


S.FAIRCHILD:			; Data records start
	MOVB	#'X,(%0)+	; with X
	RETURN
	
B.FAIRCHILD=B.TEKHEX		; Byte write as TekHex -- add nybbles to checksum
	
E.FAIRCHILD:			; Record end
	MOV	CSUM,%1		; Fetch checksum
	CALL	PUTHX1		; Append lo nybble only to output
	BR	10$		; Output record and return

T.FAIRCHILD:			; File trailer
PUTSTAR:MOVB	#'*,(%0)+	; is just a * record (also used by HEX/OCTAL)
10$:	CALLR	PUTREC		; Output, and return
	.DSABL	LSB
	.PAGE
	.SBTTL	SIRA BINARY FORMAT

;	1aatbbdddd...ddc
; where (bytes):
;	aa	= address -- lo/hi
;	t	= type: 0=data, 1=EOF, 2=autostart
;	bb	= byte count -- lo/hi
;	dd...dd = data bytes
;	c	= checksum, a+a+t+b+b+d+...d

H.SIRA=NOOP			; No special file start

S.SIRA:				; Record start
	MOVB	#1,(%0)+	; Store 1 flag
	CALL	BINWRD		; Output address, adding to c/sum
	MOVB	SIRTYP,%1	; Load type (preset 0 for data blocks)
	CALL	BINBYT		; Output type
	CMPB	(%0)+,(%0)+	; Bypass byte count filled in later
	RETURN			; Return
	
B.SIRA=BINBYT			; Byte write

T.SIRA:				; File trailer
	INCB	SIRTYP		; 1 is no autostart, change 0 to 1
	BIS	%1,%2		; if %1/%2=0
	BEQ	30$
	INCB	SIRTYP		; 2 is autostart
30$:	CALL	S.SIRA		; Start record
	CLR	%1		; No data bytes
;	CALLR	E.SIRA		; End as usual

E.SIRA:				; Record end
	PUSH	%0		; Save end of record pointer
	MOV	#RECORD+4,%0	; address byte count point
	CALL	BINWRD		; Write byte count there
	POP	%0		; Restore end of record pointer
	MOVB	CSUM,(%0)+	; Append checksum byte to end of record
	CALLR	PUTREC		; Output, and return
	.PAGE
	.SBTTL	DEC ABSOLUTE BINARY FORMAT

; As MACRO assembly with .ENABL ABS, or /EN:ABS. See READ for further notes.
;
; Records are just:
;	aaaadddd...
; where:
;	aaaa	= load/start address
;	dd...	= data bytes

H.OBJECT=NOOP			; No special file start

S.OBJECT:			; Record start
	MOVB	%1,(%0)+	; Copy address lo
	SWAB	%1		; Swap for hi
;	CALLR	B.OBJECT	; Output and return

B.OBJECT:			; Byte write
	MOVB	%1,(%0)+	; Copy byte
	RETURN			; and return

E.OBJECT=PUTREC			; Record end -- just write it out

T.OBJECT:			; File trailer
	TST	%1		; is just address if <>0 (start address)
	BNE	10$
	INC	%1		; or 1 if not
10$:	CALL	S.OBJECT	; Write address into record
	CALLR	PUTREC		; Then write out record
	.PAGE
	.SBTTL	WRITE PDP-11 PAPER-TAPE ABSOLUTE LOADER FORMAT FILE

;	10bbaadddd...dc
; where (bytes):
;	bb	= byte count -- lo/hi
;	aa	= address -- lo/hi
;	t	= type: 0=data, 1=EOF, 2=autostart
;	dd...dd = data bytes
;	c	= checksum, -(1+b+b+a+a+d+...d)

H.ABSOLUTE=NOOP			; No special file start

S.ABSOLUTE:			; Record start
	MOV	#1,(%0)+	; Store flag 1, + null
	TST	(%0)+		; Bypass byte count filled in later
	CALLR	BINWRD		; Output address (lo word), adding to c/sum	;29MAR5
	
B.ABSOLUTE=BINBYT		; Byte write

T.ABSOLUTE:			; File trailer
	BIS	%1,%2		; OR words
	BNE	30$		; <>0 is address given
	INC	%1		; 0 is none, flagged with 1
30$:	CALL	S.ABSOLUTE	; Start record
	CLR	%1		; No data bytes
;	CALLR	E.ABSOLUTE	; End as usual

E.ABSOLUTE:			; Record end
	PUSH	%0		; Save end of record pointer
	ADD	#6,%1		; Count includes 10bbaa
	MOV	#RECORD+2,%0	; Address byte count point
	CALL	BINWRD		; Write it there
	POP	%0		; Restore end of record pointer
	MOVB	CSUM,@%0	; Get checksum
	COMB	(%0)+		; Add 1, and negate (=complement) so total is 0
	CALLR	PUTREC		; Output, and return
	.PAGE
	.SBTTL	TASK FILE FORMAT
;
; See READ for full details. First block is file header containing:
;
;	L$BTSK (0-3)	task name, radix-50
;	L$BSA (10)	lo load addr
;	L$BHGV (12)	hi load addr
;	L$BXFR (350)	start address
;	L$BHRB (356)	offset to task data block from this block
;
; This can be read back in by HFE (or SSE) but some of the restrictions of
; TKB are removed, so it is no longer TKB compatible. No second label block
; is written, so L$BHRB=0.
.IF NDF TASK
NOTIMP	TASK
.IFF

	.MCALL	LBLDF$
	LBLDF$			; Define task header block offsets
	.PSECT	WRITE	I,RO

H.TASK:				; Write label block
	CALL	S.TASK		; Clear block and point to start
	BIS	%1,%2		; See if there is a transfer address
	BNE	5$		; OK if so
	MOV	#1,%1		; Make it 1 if not
5$:	MOV	%1,L$BXFR(%0)	; Store transfer address, or 1
	CALL	ADD1ST		; Get lo load address + ADDVAL
	MOV	%1,L$BSA(%0)	; lo word only
	MOV	HIBOUND,L$BHGV(%0) ; and end
	ADD	ADDVAL,L$BHGV(%0)
	INC	L$BHRB(%0)	; Data starts in next block (no 2nd label block)
	MOV	%0,%4		; Copy pointer to file header
	MOV	%3,%0		; Load pointer to program name
	MOV	#2,%3		; (Even if none = spaces, becomes 0/0)
10$:	SETNZ	%1		; Allow .'s in program name
	CALL	$CAT5B		; on converting ASCII to Radix-50
	BCS	20$		; Ignore if it failed (non Radix-50 char)
	MOV	%1,(%4)+	; Store first word
	SOB	%3,10$		; Repeat for second
20$:	CALLR	PUTBLK		; Label block complete. Write it and return

E.TASK=PUTBLK			; Record end -- just write out block

; Clear file block, to make it easier to understand DMP's.
S.TASK:				; Record start
	MOV	#512.,%5	; All blocks are 512. bytes
	MOV	#256.,%1	; Load block size in words
10$:	CLR	(%0)+		; Clear 2 bytes at a time
	SOB	%1,10$		; Until done, leaving %0 addressing block
	SUB	%5,%0		; Point back to start of block
	RETURN			; and return

B.TASK=B.OBJECT			; Byte write is simple MOVB

T.TASK=NOOP			; No special file trailer
.ENDC
	.PAGE
	.PSECT	PURE	D,RO

; Set up table of format processing routines and default/maximum widths.
.MACRO	ENTRY	FORMAT	DWIDTH	MWIDTH
	.WORD	H.'FORMAT,S.'FORMAT,B.'FORMAT,E.'FORMAT,T.'FORMAT
	.WORD	DWIDTH,MWIDTH
.ENDM	ENTRY

TABLE:
;	Format		def width	max width
	.IF	DF	TCP							;23MAR4
ENTRY	INTEL		32.		250.					;23MAR4
ENTRY	MOTOROLA	32.		252.					;23MAR4
ENTRY	ROCKWELL	32.		252.					;23MAR4
ENTRY	RCA		32.		169.					;23MAR4
ENTRY	TEKHEX		32.		250.					;23MAR4
ENTRY	EXTENDED	32.		250.					;23MAR4
ENTRY	TEXAS		32.		200.					;23MAR4
ENTRY	MOSTEK		32.		250.					;23MAR4
ENTRY	WHITESMITHS	100000!1	100000!1	; WIDTH = 1 always	;**-8
ENTRY	RIM		64.		254.
ENTRY	BIN		128.		254.
ENTRY	HEX		1024.		16384.		; WIDTH = PROM size
ENTRY	OCTAL		1024.		16384.		; ditto
ENTRY	TCI		32.		253.					;23MAR4
ENTRY	FAIRCHILD	32.		254.					;29MAR5
	.IFF									;23MAR4
ENTRY	INTEL		16.		250.
ENTRY	MOTOROLA	16.		252.
ENTRY	ROCKWELL	16.		252.
ENTRY	RCA		16.		168.
ENTRY	TEKHEX		16.		250.
ENTRY	EXTENDED	16.		250.
ENTRY	TEXAS		16.		200.
ENTRY	MOSTEK		16.		250.
ENTRY	WHITESMITHS	100000!1	100000!1	; WIDTH = 1 always
ENTRY	RIM		64.		254.
ENTRY	BIN		128.		254.
ENTRY	HEX		1024.		16384.		; WIDTH = PROM size
ENTRY	OCTAL		1024.		16384.		; ditto
ENTRY	TCI		16.		253.
ENTRY	FAIRCHILD	16.		254.
	.ENDC									;23MAR4
ENTRY	SIRA		64.		505.
ENTRY	OBJECT		64.		510.
ENTRY	ABSOLUTE	64.		510.
ENTRY	TASK		100000!512.	100000!512.	; WIDTH = 512. always

	KEY	WIDTH

	DEFM	IAP	<Can't append in current format>
	DEFM	BDW	<Invalid width parameter>
.IF DF TEKABO!EXTABO								;29MAR5

	ABOBLK:	.ASCII	"// No transfer address"	; TekHex abort block
	ABOLEN=.-ABOBLK
.ENDC										;29MAR5
	.EVEN

	.PSECT	DATA	D,RW

; Output routines for this format:
HSUB:	.BLKW	1		; Start of file
SSUB:	.BLKW	1		; Start of record output
BSUB:	.BLKW	1		; Byte-by-byte output
ESUB:	.BLKW	1		; End-of-record output
TSUB:	.BLKW	1		; End of file output

ADDVAL:	.BLKL			; Value to be added to addresses output
RECBYT:	.BLKW	1		; Bytes in current record
BCOUNT:	.BLKW	1		; Grand total of bytes output
CSUM:	.BLKW	1		; Current checksum
TOTCSM:	.BLKW	1		; Sum of bytes values written
RETSP:	.BLKW	1		; Entry SP, for abnormal exits
WIDTH:	.BLKW	1		; Bytes/output record
PART:	.BLKB	1		; No trailer flag
ERRFLG:	.BLKB	1		; Error flag
	.EVEN

; Remaining space used for different purposes by different output routines
; First word is always cleared before header output.
COMMON:
; Intel format									;29MAR5
SBA:	.BLKW	1		; Current segment base address			;29MAR5
; Rockwell format
.=COMMON									;29MAR5
RECCNT:	.BLKW	1		; Records output count
; PROM formats
.=COMMON
PUTBSB:	.BLKW	1		; Byte output routine
PUTWSB:	.BLKW	1		; Word output routine
PUTASB:	.BLKW	1		; Address output routine
ADREND:	.BLKB	1		; aaaa address end flag byte ('-' or '=')
	.EVEN
; RIM and BIN formats
.=COMMON
RIMWRD:	.BLKW	1		; Temporary storage of hi byte
; TekHex format
.=COMMON
HDCSUM:	.BLKW	1		; Temporary storage of header checksum
; Extended TekHex format
.=COMMON
ETKTYP:	.BLKB	1		; Record type
; Sira format
.=COMMON
SIRTYP:	.BLKB	1		; Record type
; Mostek format
.=COMMON
MOSTYP:	.BLKB	1		; Record type

	.END