ALWAYS	23MAR4	WRITE	<WRITE AN OBJECT FILE>				;23MAR4
	.MCALL	DIR$,PUT$S,CLOSE$,OPEN$,FDAT$R,CALLR				;**-1

.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.	*
;*									*
;*	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
;************************************************************************

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
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	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,%3
	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	10$		; Output hi byte
10$:	SWAB	%1		; Swap bytes (back)
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 %1/%2 to LOBOUND+ADDVAL = first real store address.
ADD1ST:	MOV	LOBOUND,%2	; Fetch first address
	MOV	LOBOUND+2,%1	; including offset
	ADD	ADDVAL,%2	; and ADDVAL
	ADC	%1
	ADD	ADDVAL+2,%1
	RETURN

; 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. Compute length, write to file, with error
; check, and return if OK.

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 = end, no SA, 02 = end, SA
;	dd...dd = data bytes
;	cc	= checksum, -(bb+aa+aa+tt+dd+...+dd)
	.ENABL	LSB
H.INTEL=NOOP			; No special file start

S.INTEL:			; Record start
	CLR	%2		; Default record type is 0
10$:	MOVB	#':,(%0)+	; Begin with colon
	CMPB	(%0)+,(%0)+	; Leave byte count for E.INTEL
	CALL	PUTWRD		; Put address into record (lo word only)
	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
	MOV	#1,%2		; Record type is 1
	TST	%1		; If no SA
	BEQ	20$
	INC	%2		; 2 if SA given
20$:	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
	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
	BEQ	PUTWRD		; Just output 16 bits and return
	INCB	RECORD+1	; S2 if 24-bit
	BR	PUT24		; Output 24-bit address

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	ENDCSM		; Append to end of record, output, and return
	.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

;	aaaa dd dd dd ...dd ;
; where:
;	aaaa	= load address
;	dd ...	= data
; individual items end with spaces, end of record is a semicolon.

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

S.RCA:				; Record start
	CALL	PUTHX4		; Write address
	BR	10$		; Then space and return

B.RCA:				; Write byte
	CALL	PUTHX2		; Just the byte itself
10$:	MOVB	#SPACE,(%0)+	; And a trailing space
	RETURN

E.RCA:				; Record end
	MOVB	#';,(%0)+	; Just append a semicolon
	CALLR	PUTREC		; Output and return

T.RCA=NOOP			; No file trailer
	.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.
; Output a // abort block if there isn't a trailer.
T.TEKHEX:			; File trailer
	BIS	%1,%2		; See if there is a transfer address
	BEQ	ABOTKH		; Do abort block if not
20$:	CALL	S.TEKHEX	; Start record in the normal way
	CLR	%1		; Byte count 0
	BR	10$		; Complete record (header only) and return

; 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
	.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
	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
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	%2,@%0		; Copy lo, hi in %1
	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	%1,@%0		; Yes, store second
	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, ', 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
	MOV	(PC)+,%2	; Start:
	.BYTE	'B&37,'A	; Control/B and 'A'
	CALL	100$
; 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
	PUSH	%2		; Save %2
	MOV	(PC)+,%2	; Start:
	.BYTE	'C&37,'S	; Control/C and 'S'
	CALL	100$
	POP	%2		; Restore %2
; 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
	MOV	#RECORD,%0	; Address buffer
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$:	MOVB	%2,(%0)+	; Output control code
	MOVB	#'$,(%0)+	; '$',
	SWAB	%2
	MOVB	%2,(%0)+	; and A/S
	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	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
	CALL	BINWRD		; Output address (lo word), adding to c/sum
	RETURN			; Return

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
	.IFF									;23MAR4
ENTRY	INTEL		16.		250.					;23MAR4
ENTRY	MOTOROLA	16.		252.					;23MAR4
ENTRY	ROCKWELL	16.		252.					;23MAR4
ENTRY	RCA		16.		169.					;23MAR4
ENTRY	TEKHEX		16.		250.					;23MAR4
ENTRY	EXTENDED	16.		250.					;23MAR4
ENTRY	TEXAS		16.		200.					;23MAR4
ENTRY	MOSTEK		16.		250.					;23MAR4
ENTRY	WHITESMITHS	100000!1	100000!1	; WIDTH = 1 always	;23MAR4
ENTRY	RIM		64.		254.					;23MAR4
ENTRY	BIN		128.		254.					;23MAR4
ENTRY	HEX		1024.		16384.		; WIDTH = PROM size	;23MAR4
ENTRY	OCTAL		1024.		16384.		; ditto			;23MAR4
ENTRY	TCI		16.		253.
	.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>

ABOBLK:	.ASCII	"// No transfer address"	; TekHex abort block
ABOLEN=.-ABOBLK
	.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:
; Rockwell format
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