TITLE	'GENMOD - MP/M RELOCATABLE MODULE GENERATOR 9/81'
;	RELOCATING LOADER PROGRAM WITH MODULE GENERATION
;
;	COPYRIGHT (C) 1979, 1980, 1981
;	DIGITAL RESEARCH
;	BOX 579, PACIFIC GROVE
;	CALIFORNIA, 93950
;
;
;	Revised:
;	  14 Sept 81  by Thomas Rolander

	ORG	000H	;BASE OF RELOCATABLE SEGMENT
BASE	EQU	$

	ORG	100H	;BASE OF MP/M PROGRAM AREA
	JMP	START

	DB	' COPYRIGHT (C) 1980, DIGITAL RESEARCH '
;
STKSIZ	EQU	64	;32 LEVEL WORKING STACK
;
;	MISCELLANEOUS ADDRESS CONSTANTS
BOOT	EQU	BASE+0		;SYSTEM REBOOT
BDOS	EQU	BASE+5		;DOS ENTRY POINT
TOP	EQU	BASE+6		;CONTAINS TOP OF MEMORY
DFCB	EQU	BASE+5CH	;DEFAULT FILE CONTROL BLOCK
DBF	EQU	BASE+80H	;DEFAULT BUFFER
RWORK	EQU	BASE+700H	;BASE OF RELOCATION WORK AREA
RMOD	EQU	BASE+600H	;MODULE RELOCATOR BASE
RSIZE	EQU	RMOD+1		;MODULE SIZE FIELD
DSIZE	EQU	RMOD+4		;DATA SIZE FIELD
;
;	BDOS ENTRY FUNCTIONS
CONOF	EQU	2	;CONSOLE OUTPUT
OPF	EQU	15	;FILE OPEN FUNCTION
CLF	EQU	16	;FILE CLOSE FUNCTION
DLF	EQU	19	;FILE DELETE FUNCTION
RDF	EQU	20	;READ DISK
WRF	EQU	21	;WRITE DISK
MKF	EQU	22	;MAKE FILE
PRF	EQU	9	;PRINT BUFFER
DMF	EQU	26	;SET DMA ADDRESS
;
;	NON GRAPHIC CHARACTERS
CR	EQU	0DH	;CARRIAGE RETURN
LF	EQU	0AH	;LINE FEED
DEOF	EQU	1AH	;END OF FILE
;
START:
	LXI	SP,STACK
;
	CALL	SETUP	;SET UP FILES
	XRA	A	;ZERO IN ACCUM
	STA	PASS	;PASS = 0
	LXI	H,0
	SHLD	HLOC	;HLOC = 0
	CALL	HREAD
	LHLD	HLOC	;HIGH ADDRESS TO H,L
	INX	H	;+1
	PUSH	H
;	CLEAR THE RELOCATION BIT MAP
	CALL	FINDBYTE	;HLOC+1 IS TRANSLATED TO AN ABS ADDR
;	MOVE H,L TO NEXT PARAGRAPH BOUNDARY
ADJ0:	MOV	A,L
	ANI	7FH
	JZ	ADJ1
	INX	H	;TO NEXT ADDRESS
	JMP	ADJ0
ADJ1:	DCX	H
	SHLD	LBYTE	;LAST BYTE TO WRITE
	XCHG			;LAST BYTE TO ZERO IS IN D,E
	POP	H		;RECALL HLOC+1
;	CLEAR ALL BYTES FROM H,L THROUGH D,E
CLER0:	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JC	CLER1
	MVI	M,0	;CLEAR ANOTHER BYTE
	INX	H
	JMP	CLER0
CLER1:	;BIT VECTOR CLEARED
;	THE RELOCATION BIT VECTOR IS BUILT DURING THE SECOND PASS
	LXI	H,PASS
	INR	M	;PASS = 1
	CALL	HREAD
;	BIT VECTOR BUILT, WRITE THE MODULE
	CALL	TERMINATE
	LXI	D,OKMSG	;OPERATION COMPLETE
	CALL	PRINT
	JMP	FINIS
OKMSG:	DB	CR,LF,'MODULE CONSTRUCTED$'
;
;	UTILITY SUBROUTINES
;
HREAD:	;HEX FORMAT READ SUBROUTINE
;	INPUT RECORDS TAKE THE FORM:
;	:NNLLLLTTD1D2D3...DNCC
;	WHERE -
;		NN	IS THE RECORD LENGTH (00-FF)
;		LLLL	IS THE LOAD ADDRESS (0000-FFFF)
;		TT	IS THE RECORD TYPE (ALWAYS 00)
;		D1-DN	ARE THE DATA BYTES
;		CC	IS THE CHECKSUM
;	THE LAST RECORD HAS A LENGTH OF ZERO, AND LLLL IS THE
;	STARTING ADDRESS FOR THE MODULE (IGNORED HERE)
;
	CALL	DISKR	;NEXT INPUT CHARACTER TO ACCUM
	CPI	DEOF	;PAST END OF TAPE?
	JZ	CERROR
	SBI	':'
	JNZ	HREAD	;LOOKING FOR START OF RECORD
;
;	START FOUND, CLEAR CHECKSUM
	MOV	D,A
	CALL	RBYTE
	MOV	E,A	;SAVE LENGTH
	CALL	RBYTE	;HIGH ORDER ADDR
	PUSH	PSW
	CALL	RBYTE	;LOW ORDER ADDR
	POP	B	;HIGH ORDER ADDRESS TO B
	MOV	C,A	;LOW ORDER ADDRESS TO C
	LDA	BBOOL
	ORA	A
	JNZ	HVBIAS
	MVI	A,0FFH
	STA	BBOOL
	MVI	A,LOW(RWORK)
	SUB	C
	MOV	L,A
	MVI	A,HIGH(RWORK)
	SBB	B
	MOV	H,A
	SHLD	BRWRK	;BRWRK = RWORK-BIAS
	MOV	A,C
	SUI	LOW(RWORK)
	MOV	L,A
	MOV	A,B
	SBI	HIGH(RWORK)
	MOV	H,A
	SHLD	NBRWRK	;NBRWRK = BIAS-RWORK
HVBIAS:
	LHLD	BRWRK	;ADDRESS INTO WORK AREA (BIASED)
	DAD	B	;BIAS ADDRESS IN H,L
;
;	IF ON SECOND PASS, THEN ADDRESSES ARE OFF BY ONE PAGE
	LDA	PASS
	ORA	A
	JZ	CHKLEN
;	SECOND PASS, DECREMENT ADDRESS TO PREVIOUS PAGE
	DCR	H
CHKLEN:
;	CHECK THE LENGTH FIELD FOR END OF HEX FILE
	MOV	A,E	;CHECK FOR LAST RECORD
	ORA	A
	JNZ	RDTYPE
;	END OF HEX INPUT
	RET
;
RDTYPE:
	CALL	RBYTE	;RECORD TYPE = 0
;
;	LOAD THE RECORD ON PASS 0, SET REL BITS ON PASS 1
RED1:	CALL	RBYTE
	MOV	B,A	;SAVE DATA BYTE FOR COMPARE
	LDA	PASS
	ORA	A
	JNZ	COMP	;COMPARE ON PASS 1
;
;	PASS 0, STORE DATA BYTE TO MEMORY
	XCHG		;COMPARE WITH MEMORY TOP ADDRESS
	PUSH	H
	LHLD	TOP
	MOV	A,D
	SUB	H
	JC	SIZEOK
	JNZ	SZERR
	MOV	A,E
	SUB	L
	JNC	SZERR
SIZEOK:
	POP	H
	XCHG
	MOV	M,B
;	COMPUTE HIGH ADDRESS
	PUSH	H
	PUSH	D
	XCHG		;CURRENT ADDRESS TO H,L
	LHLD	HLOC	;CURRENT HIGH LOCATION
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	POP	D
	POP	H
	JNC	RED2	;NO CARRY IF HLOC HIGH
	SHLD	HLOC	;NEW HLOC OTHERWISE
	JMP	RED2
;
COMP:	;PASS 1, COMPUTE RELOCATION BITS
	MOV	C,M	;GET DATA FROM MEMORY
	MOV	A,B
	ora	a
	jnz	comp1	; jump if non-zero byte
	lda	igz
	ora	a
	jnz	red2	; jump if ignoring zeroes on pass 1
	mov	a,b
comp1:
	SUB	C	;DIFFERENT?
	JZ	RED2	;SKIP IF SAME DATA
	PUSH	D
	PUSH	H
;	DIFFERENT, MUST BE BY 1
	CPI	1
	JZ	RELOK	;OK TO RELOCATE
	CPI	-1	; OR BY -1
	JZ	RELOK	;ALSO OK TO RELOCATE
;	PRINT ERROR IN FORM -
;	REL ERROR AT XXXX IMAGE X
	LXI	D,RELMSG
	CALL	PRINT
	POP	D	;ADDRESS
	PUSH	D
	LHLD	NBRWRK	;BIASED ADDRESS
	DAD	D	;REAL ADDRESS TO HL
	CALL	PADDR	;ADDRESS PRINTED
	POP	H
	PUSH	H	;HL READY FOR SETBIT
	JMP	RELOK
;
;	INLINE  RELOCATION ERROR MESSAGE
RELMSG:	DB	CR,LF,'RELOC ERROR AT $'
;
RELOK:	CALL	SETBIT	;RELOCATION BIT SET/RESET
	POP	H
	POP	D
RED2:	INX	H
	DCR	E
	JNZ	RED1	;FOR ANOTHER BYTE
;	OTHERWISE AT END OF RECORD - CHECKSUM
	CALL	RBYTE
	JNZ	CERROR
	JMP	HREAD	;FOR ANOTHER RECORD
;
RBYTE:	;READ ONE BYTE FROM BUFF AT WBP TO REG-A
;	COMPUTE CHECKSUM IN REG-D
	PUSH	B
	PUSH	H
	PUSH	D
;
	CALL	DISKR	;GET ONE MORE CHARACTER
	CALL	HEXCON	;CONVERT TO HEX (OR ERROR)
;
;	SHIFT LEFT AND MASK
	RLC
	RLC
	RLC
	RLC
	ANI	0F0H
	PUSH	PSW	;SAVE FOR A FEW STEPS
	CALL	DISKR
	CALL	HEXCON
;
;	OTHERWISE SECOND NIBBLE OK, SO MERGE
	POP	B	;PREVIOUS NIBBLE TO REG-B
	ORA	B
	MOV	B,A	;VALUE IS NOW IN B TEMPORARILY
	POP	D	;CHECKSUM
	ADD	D	;ACCUMULATING
	MOV	D,A	;BACK TO CS
;	ZERO FLAG REMAINS SET
	MOV	A,B	;BRING BYTE BACK TO ACCUMULATOR
	POP	H
	POP	B	;BACK TO INITIAL STATE WITH ACCUM SET
	RET
REND:
	;NORMAL END OF LOAD
	RET
;
;
DISKR:	;DISK READ
	PUSH	H
	PUSH	D
	PUSH	B
;
RDI:	;READ DISK INPUT
	LDA	DBP
	ANI	7FH
	JZ	NDI	;GET NEXT DISK INPUT RECORD
;
;	READ CHARACTER
RDC:
	MVI	D,0
	MOV	E,A
	LXI	H,DBF
	DAD	D
	MOV	A,M
	CPI	DEOF
	JZ	RRET	;END OF FILE
	LXI	H,DBP
	INR	M
	JMP	RRET
;
NDI:	;NEXT BUFFER IN
	MVI	C,RDF
	LXI	D,DFCB
	CALL	BDOS
	ORA	A
	JNZ	DEF
;
;	BUFFER READ OK
	STA	DBP	;STORE 00H
	JMP	RDC
;
DEF:	;DISK END OF FILE
	MVI	A,DEOF
RRET:
	POP	B
	POP	D
	POP	H
;	TRANSLATE TO UPPER CASE
TRAN:
	CPI	7FH	;RUBOUT?
	RZ
	CPI	('A' OR 010$0000B)	;UPPER CASE A
	RC
	ANI	101$1111B		;CLEAR UPPER CASE BIT
	RET
;
SETBIT:
	;SET THE BIT POSITION GIVEN BY H,L TO 1
	CALL	FINDBYTE
;	ROTATE A 1 BIT BY THE AMOUNT GIVEN BY B - 1
	MVI	A,1
SET0:	DCR	B
	JZ	SET1
	ORA	A	;CLEAR CY
	RAL
	JMP	SET0
;
;	BIT IS IN POSITION
SET1:	ORA	M	;OR'ED TO BIT PATTERN IN MEMORY
	MOV	M,A	;BACK TO BIT VECTOR
	RET
;
FINDBYTE:
;	H,L ADDRESSES A BYTE POSITION, CHANGE H,L TO BIT VECTOR
;	POSITION, SET B TO NUMBER OF SHIFTS REQUIRED TO SELECT
;	PROPER BIT AT RESULTING H,L POSITION
	LXI	D,-RWORK
	DAD	D
	XCHG			;BIT ADDRESS IN D,E
	MOV	A,E
	ANI	111B		;VALUE X = 0,1,...,7
;	CHANGE TO 8-X (8,7,...,1) TO SIMPLIFY BIT SHIFTING LATER
	CMA			;VALUE X = -1,-2,...,-8
	ADI	9		;VALUE X = 8,7, ...,1
	MOV	B,A
	MVI	C,3		;SHIFT COUNT IS 3
SHRL:	;SHIFT RIGHT LOOP
	XRA	A		;CLEAR FLAGS
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	DCR	C
	JNZ	SHRL
;
;	END OF SHIFT, H,L ADDRESS RELATIVE BYTE POSITION
	LHLD	HLOC		;LAST MEMORY ADDRESS FOR CODE
	INX	H
	DAD	D		;ABSOLUTE ADDRESS IS IN H,L
	RET
;
PCHAR:	;PRINT CHARACTER IN A
	PUSH	H
	PUSH	D
	PUSH	B
	MOV	E,A
	MVI	C,CONOF
	CALL	BDOS
	POP	B
	POP	D
	POP	H
	RET
;
PNIB:	;PRINT NIBBLE IN REG A
	ANI	0FH
	CPI	10
	JNC	P10
;	<= 9
	ADI	'0'
	JMP	PRN
P10:	ADI	'A' - 10
PRN:	CALL	PCHAR
	RET
;
PHEX:	;PRINT HEX CHAR IN REG-A
	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	CALL	PNIB
	POP	PSW
	CALL	PNIB
	RET
;
PADDR:	;PRINT ADDRESS IN H,L
	MOV	A,H
	CALL	PHEX
	MOV	A,L
	CALL	PHEX
	RET
;
CRLF:	;CARRIAGE RETURN - LINE FEED
	MVI	A,CR
	CALL	PCHAR
	MVI	A,LF
	CALL	PCHAR
	RET
;
TERMINATE:
	;WRITE MODULE TO DISK
	LXI	D,-(RWORK-1)
	LHLD	HLOC	;HIGH MODULE ADDRESS
	DAD	D	;MODULE RELATIVE END IN H,L
	SHLD	RSIZE	;STORE MODULE SIZE IN RELOCATOR
	PUSH	H
	LXI	D,RELEMSG	;REL MOD END
	CALL	PRINT
	POP	H
	CALL	PADDR	;REL MOD END  XXXX
	LHLD	LBYTE	;LAST POSITION TO WRITE
	PUSH	H
	LXI	D,-RWORK
	DAD	D
	PUSH	H
	LXI	D,RELSMSG
	CALL	PRINT
	POP	H
	CALL	PADDR	;REL MOD SIZE XXXX
	LXI	D,RELDMSG
	CALL	PRINT
	LHLD	DSIZE
	CALL	PADDR	;REL DAT SIZE XXXX
	POP	H
	LXI	D,RMOD	;D,E ADDRESS FIRST POSITION TO WRITE
WLOOP:	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D	;CARRY GENERATED IF D,E > H,L
	JC	CLOS
;	WRITE ANOTHER RECORD
	PUSH	H
	PUSH	D	;FIRST AND LAST SAVED
	MVI	C,DMF	;SET DMA ADDRESS
	CALL	BDOS
	MVI	C,WRF	;WRITE TO FILE
	LXI	D,OFCB
	CALL	BDOS	;WRITTEN
	ORA	A
	JNZ	OFERR
;	WRITE OK, INCREMENT DMA ADDRESS
	LXI	H,128
	POP	D
	DAD	D
	XCHG
	POP	H	;STATE RESTORED FOR ANOTHER WRITE
	JMP	WLOOP
CLOS:	;CLOSE OUTPUT FILE
;	MOVE DMA ADDRESS BACK TO 80H SO DATA IS NOT DESTROYED
;	(THERE MAY BE A SUBSEQUENT SAVE OF THE ENTIRE MEM IMAGE)
	MVI	C,DMF
	LXI	D,DBF
	CALL	BDOS
	MVI	C,CLF
	LXI	D,OFCB
	CALL	BDOS
	CPI	255
	JZ	OFERR
	RET
;
RELEMSG:
	DB	CR,LF,'REL MOD END  $'
RELSMSG:
	DB	CR,LF,'REL MOD SIZE $'
RELDMSG:
	DB	CR,LF,'REL DAT SIZE $'
;
HEXCON:
	;CONVERT ACCUMULATOR TO PURE BINARY FROM EXTERNAL ASCII
	SUI	'0'
	CPI	10
	RC		;MUST BE 0-9
	ADI	('0'-'A'+10) AND 0FFH
	CPI	16
	RC		;MUST BE A-F
	LXI	D,HEXMSG
	CALL	PRINT
	JMP	FINIS
HEXMSG:	DB	CR,LF,'BAD HEX DIGIT'
INHEX:	DB	' '
	DB	'IN DATA SIZE SPECIFICATION$'
;
SETUP:
	;SETUP FILES FOR PROCESSING
;	SCAN FOR DATA SIZE SPECIFICATION
	LXI	D,DBF
SCNDLR:
	LDAX	D
	INX	D
	ORA	A
	JZ	NODTSZ
	CPI	'$'
	JNZ	SCNDLR
	LXI	H,0
	MVI	B,0
	ldax	d
	call	tran
	cpi	'Z'
	jnz	scnend
	mvi	a,0ffh
	sta	igz
	inx	d
SCNEND:
	LDAX	D
	INX	D
	ORA	A
	JZ	ENDTSZ
	CALL	TRAN	;CONVERT TO UPPER CASE
	CALL	HEXCON
	JNC	ENDTSZ
OKDIGIT:
	MOV	C,A
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	B
	JMP	SCNEND
NODTSZ:
	LXI	H,0
ENDTSZ:
	LXI	D,RMOD
	MVI	B,0
	XRA	A
ZEROBP:
	STAX	D
	INX	D
	DCR	B
	JNZ	ZEROBP
	SHLD	DSIZE
	MVI	A,'$'
	STA	INHEX
;	SET DMA ADDRESS TO DBF
	LXI	D,DBF
	MVI	C,DMF
	CALL	BDOS
;	LOOK FOR VALID FILE NAMES
	LDA	DFCB+1
	CPI	' '
	JZ	FNERR
	LDA	DFCB+17
	CPI	' '
	JZ	FNERR
;	NAMES ARE PRESENT, COPY SECOND NAME TO OFCB
	LXI	H,OFCB
	LXI	D,DFCB+16
	MVI	B,16
FLOOP:	LDAX	D	;GET CHARACTER
	MOV	M,A
	INX	H
	INX	D
	DCR	B
	JNZ	FLOOP
;
;	NAME COPIED, DELETE CURRENT VERSIONS, MAKE NEW FILE
	LXI	D,OFCB
	PUSH	D
	MVI	C,DLF
	CALL	BDOS
	POP	D
	MVI	C,MKF
	CALL	BDOS
	CPI	255
	JZ	OFERR
	XRA	A
	STA	OFR	;CLEAR RECORD NUMBER
;
;	NEW FILE HAS BEEN CREATED, NOW OPEN INPUT FILE
	MVI	C,OPF	;FILE OPEN FUNCTION
	LXI	D,DFCB	;FILE CONTROL BLOCK ADDRESS
	CALL	BDOS
	CPI	255	;ERROR IF NOT FOUND
	JZ	OPERR	;ERROR MESSAGE AND ABORT IF NOT FOUND
	LXI	H,DBP	;DATA BUFFER POINTER
	MVI	M,0	;CAUSES IMMEDIATE DATA READ
	RET
;
OPERR:	;OPEN ERROR
	LXI	D,OPMSG
	CALL	PRINT
	JMP	FINIS
;
OPMSG:	DB	CR,LF,'INPUT FILE NOT PRESENT$'
;
BERROR:
	LXI	D,BASMSG
	CALL	PRINT
	JMP	FINIS
BASMSG: DB	CR,LF,'INVALID RELOCATION BASE$'
;
;
CERROR:
	;ERROR IN INPUT, ABORT THE LOAD
	LXI	D,ERMSG
	CALL	PRINT
	JMP	FINIS
ERMSG:	DB	CR,LF,'BAD INPUT RECORD$'
;
FNERR:
	LXI	D,FNMSG
	CALL	PRINT
	JMP	FINIS
FNMSG:	DB	'MISSING FILE NAME$'
;
OFERR:
	LXI	D,OFMSG
	CALL	PRINT
	JMP	FINIS
OFMSG:	DB	'CANNOT CREATE OUTPUT FILE$'
;
SZERR:
	LXI	D,SZMSG
	CALL	PRINT
	JMP	FINIS
SZMSG:	DB	'HEX FILE SIZE TOO LARGE$'
;
PRINT:	;PRINT MESSAGE ADDRESSED BY D,E
	MVI	C,PRF
	CALL	BDOS
	RET
;
FINIS:	;END OF PROCESSING
	JMP	BOOT
;
DBP:	DS	1	;DISK BUFFER POINTER
RBASE:	DS	1	;RELOCATION BASE
PASS:	DS	1	;PASS 0,1
;
;
HLOC:	DS	2	;HIGH ADDRESS IN MODULE
LBYTE:	DS	2	;LAST BIT VECTOR BYTE POSITION
;
;
BRWRK:	DS	2	;BIASED RWORK
NBRWRK:	DS	2	;NEGATIVE BIASED RWORK
;
OFCB:	DS	32	;OUTPUT FILE CONTROL BLOCK
OFR:	DS	1	;OUTPUT FILE RECORD NUMBER
;
	DS	STKSIZ	;STACK SIZE
STACK:
;
igz:	db	0	;ignore zeroes on pass 1, boolean
BBOOL:	DB	0	;BIAS COMPUTED, BOOLEAN
;			;THIS DB GUARANTEES MODULE SIZE
	END