*********************************
*				*
*  Function 59 -- Program Load	*
*   Assembly language version	*
*				*
*        June  8, 1982		*
*				*
*********************************

.globl  _pgmld		* this routine is public

secsize = 128		* CP/M sector size

* d0 always contains the return parameter from pgmld
* d1 is the return register from local subroutines
* a0 contains the pointer to the Load Parm Block passed to pgmld

* Return parameters in d0 are:
*	00 - function successful
*	01 - insufficient memory or bad header in file
*	02 - read error on file
*	03 - bad relocation information in file


* Entry point for Program Load routine
_pgmld:
	movem.l	d1-d7/a0-a6, -(sp) * save everything, just to be safe
	move.l	60(sp),a0	* get pointer to LPB
	clr.l	d0		* start with return parm cleared
	bsr	gethdr		* get header
	tst	d0
	bne	lddone		* if unsuccessful, return
	bsr	setaddr		* set up load addresses
	tst	d0
	bne	lddone		* if unsuccessful, return
	bsr	rdtxt		* read code and data text segments into mem
	tst	d0
	bne	lddone		* if unsuccessful, return
	move.l	tstart,d7
	cmp.l	cseg,d7
	beq	noreloc
	bsr	reloc		* do relocation if necessary
noreloc:
	tst	d0
	bne	lddone
	bsr	setrtn		* set up return parameters
lddone:
	move.l	64(sp), d1
	bsr	setdma		* restore dma address
	movem.l	(sp)+,d1-d7/a0-a6
	rts

* Subroutines

readseq:
* CP/M read sequential function
	move.l	d0,-(sp)	* save return parm
	move.l	FCBPtr(a0),d1
	moveq	#20,d0		* read seq function
	trap	#2		* call bdos
	move.l	d0,d1		* return parm in d1
	move.l	(sp)+,d0
	rts


setdma:
* CP/M set dma function
	move.l	d0,-(sp)	* save return parm
	moveq	#26,d0		* set dma function
	trap	#2		* call bdos
	move.l	(sp)+,d0	* restore d0
	rts


gethdr:
* Get header into buffer in data segment
	move.l	LoAdr(a0),d1
	bsr	setdma
	bsr	readseq
	tst	d1		* read ok?
	bne	badhdr		* if no, return bad
	moveq	#18,d7
	movea.l	LoAdr(a0),a5
	movea.l	#hdr,a6
geth1:	move.w	(a5)+,(a6)+	* move header into hdr
	dbf	d7,geth1
	rts
badhdr:	moveq	#2,d0
	rts


conflict:
* input parms: d2, d3 = 4 * segment nmbr
* if segment d2/4 overlaps segment d3/4, then return 1 in d1
* else return 0 in d1
* uses d7, a2, a3
	clr.l	d1		* assume it will work
	movea.l	#cseg,a2	* a2 points to start of segment addresses
	movea.l	#csize,a3	* a3 points to start of segment lengths
	move.l	0(a2,d2),d7	* get 1st seg start
	cmp.l	0(a2,d3),d7	* is 1st seg above 2nd seg?
	bge	conf1
	add.l	0(a3,d2),d7	* yes, find top of 1st seg
	cmp.l	0(a2,d3),d7	* above start of 2nd seg?
	bgt	confbd		* if yes, we have a conflict
	rts			* else, return good
conf1:
	move.l	0(a2,d3),d7
	add.l	0(a3,d3),d7	* find top of 2nd seg
	cmp.l	0(a2,d2),d7	* above start of 1st seg?
	ble	confgd		* if no, we're ok
confbd:	moveq.l	#1,d1
confgd:	rts


trymemtp:
* entry: d2 is a segment nmbr [0..4]
* try to fit it at top of memory
* uses d3, d6, d7, a5, a6
* returns 0 in d1 if ok
	move.l	d2,d6		* d6 is loop counter for chksegs
	subq	#1,d6
	lsl	#2,d2		* multiply d2 by 4
	move.l	HiAdr(a0),d7	* top of mem to d7

chksegs:
* entry: d2 = 4 * (segment nmbr to try)
*	 d6 = (d2/4) - 1  (loop counter)
*	 d7 = address below which to try it
* check for conflicts with segments [0..d6] and low memory boundary
* return 0 in d1 if no conflicts, else d1 = 1
* uses d3, a5, a6
	movea.l	#cseg,a5
	movea.l	#csize,a6
	sub.l	0(a6,d2),d7	* subtract size of segment to try
	bclr	#0,d7		* make it even address
	move.l	d7,0(a5,d2)	* insert address in segment table
	cmp.l	LoAdr(a0),d7	* check for conflict with low memory
	blt	confbd
	clr.l	d3		* check for conflicts with 0..d6
chk1:
	bsr	conflict
	addq.l	#4,d3
	tst.l	d1		* conflict with this seg?
	dbne	d6,chk1		* if no, try next
	rts


fndseg:
* entry: d2 is a segment nmbr [0..4]
* try to fit segment d2 directly below segments 0..(d2-1)
* uses d3-d7, a5, a6
	move.l	d2,d5		* d5 is loop counter to find fit
	subq.l	#1,d5
	move.l	d5,temp
	lsl.l	#2,d2		* multiply segment by 4
	clr.l	d4		* d4 is segment to try to fit below
fnd1:
	move.l	temp,d6		* d6 is loop counter for chksegs
	movea.l	#cseg,a5
	move.l	0(a5,d4),d7	* segment address to d7
	bsr	chksegs		* check for conflicts
	addq.l	#4,d4
	tst.l	d1
	dbeq	d5,fnd1		* if conflict, try next
	rts


setaddr:
* Set up load addresses for cseg, dseg, bss, basepg, and stack
	move.w	magic,d6
	andi.w	#$fffe,d6
	cmpi.w	#$601a,d6
	bne	badadr		* if magic nmbr <> 601a or 601b, skip
	move.l	bpsize,symsize
	move.l	#256,d7
	move.l	d7,bpsize	* base page is 256 bytes
	lea	stksize,a2
	cmp	(a2),d7
	blt	set0		* if stack size < 256, set to 256
	move.l	d7,(a2)
set0:	cmpi.w	#$601b,magic
	beq	seta
	tst.w	rlbflg
	beq	set1
seta:	move.l	tstart,cseg	* if not relocatable or hdr = $601b,
	bra	set2		* cseg starts at tstart
set1:	btst	#0,Flags(a0)
	bne	sldhi
* relocatable, load low
	move.l	LoAdr(a0),d7
	add.l	#$101,d7	* leave room for base page
	bclr	#0,d7
	move.l	d7,cseg		* cseg is bottom of mem + $100 (even boundary)
	bra	set2
sldhi:
* relocatable, load high
	move.l	HiAdr(a0),d7
	sub.l	csize,d7
	sub.l	dsize,d7
	sub.l	bsize,d7
	subq.l	#4,d7
	bclr	#0,d7		* put cseg at next even address below
	move.l	d7,cseg		*  high memory - (sum of sizes)
set2:
* Cseg has been set up.  Now do dseg, bseg
	cmpi.w	#$601b,magic
	bne	set3
* if magic # = 601b, take addr from hdr
	move.l	dstart,dseg
	move.l	bstart,bseg
	bra	set4
set3:
* if short header, dseg and bseg follow cseg
	move.l	cseg,d7
	add.l	csize,d7
	addq.l	#1,d7
	bclr	#0,d7
	move.l	d7,dseg
	add.l	dsize,d7
	addq.l	#1,d7
	bclr	#0,d7
	move.l	d7,bseg
set4:
* cseg, dseg, bseg set up
* now find a place for the base page and stack
	moveq.l	#3,d2
	bsr	fndseg		* try to fit base page below cseg, dseg, bseg
	tst.l	d1
	beq	set5		* if found, skip
	moveq.l	#3,d2
	bsr	trymemtp	* else, try top of memory
	tst.l	d1
	bne	badadr		* if fail, exit
set5:	moveq.l	#4,d2
	bsr	trymemtp	* try to fit stack at top of memory
	tst.l	d1
	beq	set6		* if ok, skip
	moveq.l	#4,d2
	bsr	fndseg		* else, try to fit below other segs
	tst.l	d1
	bne	badadr
set6:
* now check all segments for conflicts with low and high memory boundaries
	movea.l	#cseg,a5
	movea.l	#csize,a6
	clr.l	d2
	moveq	#4,d3		* loop counter
set7:	move.l	0(a5,d2),d7	* get segment base
	cmp.l	LoAdr(a0),d7	* above bottom of memory?
	blt	badadr
	add.l	0(a6,d2),d7	* find top of segment
	cmp.l	HiAdr(a0),d7	* below top of memory?
	bgt	badadr
	addq.l	#4,d2		* point to next segment
	dbf	d3,set7
	rts
badadr:	moveq.l	#1,d0
	rts


movebuf:
* move (d3) bytes from the base page buffer to (a2)
* uses d6
	movea.l	basepg,a1
	move.l	#secsize,d6
	sub.w	bufbyts,d6	* address to move from =
	adda.w	d6,a1		*	(basepg) + secsize - (bufbyts)
	sub.w	d3,bufbyts	* update # bytes buffered
	bra	moveb2
moveb1:	move.b	(a1)+,(a2)+	* do the move
moveb2:	dbf	d3,moveb1
	rts


rdtxt:
* Read code and data text into memory
* during this routine, a2 is always the load address,
*		       d2 is number of bytes left to load
	moveq	#63,d7
	movea.l	LoAdr(a0),a5
	movea.l	basepg,a6
rdtxt1:	move.w	(a5)+,(a6)+	* move header sector to base page
	dbf	d7,rdtxt1
	move.w	#secsize-28,d7
	cmpi.w	#$601a,magic	* short header?
	beq	rdtxt2
	subq.w	#8,d7
rdtxt2:	move.w	d7,bufbyts	* indicate # bytes of text in buffer
	move.w	#2,loop		* do for code, data segments
	move.l	cseg,a2		* start at cseg
	move.l	csize,d2	* for csize bytes
rdtxt3:
	clr.l	d3
	move.w	bufbyts,d3
	cmp.l	d2,d3		* # bytes in buffer >= # bytes to load?
	blt	rdtxt4
	move.l	d2,d3
	bsr	movebuf		* if yes, move # bytes to load
	bra	finrd
rdtxt4:
	sub.l	d3,d2		* if no, update # bytes to load
	bsr	movebuf		* move remainder of buffer
	move.l	#secsize,d3	* d3 = secsize fo following loop
rdtxt5:
	cmp.l	d3,d2		* have at least one more full sector?
	blt	rdtxt6
	move.l	a2,d1
	bsr	setdma		* if yes, set up dma address
	bsr	readseq		* read next sector
	tst.w	d1
	bne	rdbad		* if no good, exit
	sub.l	d3,d2		* decrement # bytes to load
	adda.l	#secsize,a2	* increment dma address
	bra	rdtxt5
rdtxt6:
	tst.l	d2		* any more bytes to read?
	beq	finrd
	move.l	basepg,d1
	bsr	setdma
	bsr	readseq		* if yes, read into base page
	tst.w	d1
	bne	rdbad
	move.w	d3,bufbyts	* indicate that we've buffered a sector
	move.l	d2,d3
	bsr	movebuf		* move remainder of segment
finrd:
	move.l	dseg,a2		* set up to load data segment
	move.l	dsize,d2
	sub.w	#1,loop
	bne	rdtxt3
	move.l	bseg,a2		* clear the bss segment
	move.l	bsize,d2
	beq	rdtxt8
rdtxt7:	clr.b	(a2)+
	subq.l	#1,d2
	bne	rdtxt7
rdtxt8:	rts

rdbad:	moveq.l	#2,d0
	rts


relocword:
* relocate word at (a2) based on reloc bits at (a3)
* lsb of d2 indicates whether previous word was 1st half of long-word
	move.w	(a3)+,d7	* get relocation info
	andi.w	#7,d7		* strip off symbol table bits
	lsl	#1,d7		* multiply by 2
	jmp	2(pc,d7)

	bra	relabs
	bra	reldata
	bra	relcode
	bra	relbss
	bra	relbad
	bra	rellong
	bra	relbad
	bra	relop

relbad:	move.l	(sp)+,d0	* pop return address
	moveq	#3,d0		* return bad relocation to main routine
	rts

relabs:
relop:	bclr	#0,d2		* reset long word flag
	tst.w	(a2)+		* point to next word of segment
	rts

rellong:
	bset	#0,d2		* set long word flag
	tst.w	(a2)+		* point to next word of segment
	rts

reldata:
relbss:
relcode:
	bclr	#0,d2		* long word flag set?
	bne	relc1		* if yes, skip
	move.w	(a2),d6
	add.w	d5,d6
	move.w	d6,(a2)+
	rts

relc1:	tst.w	-(a2)		* point to first word of long
	move.l	(a2),d6
	add.l	d5,d6
	move.l	d6,(a2)+	* note that a2 points past long word
	rts


reloc:
* Modify address references of code and data segments based on relocation bits
* During this routine,
* a2 points to text file to relocate
* a3 points to relocation word in basepg
* lsb of d2 is long word flag (set on reloc type 5, reset on next word)
* d3 is # words in relocation buffer
* d4 is nmbr of words left to relocate
* d5 is relocation offset

	move.l	basepg,d1
	bsr	setdma		* we will always read into base page
* skip past the symbol table
	move.l	symsize,d7
	divu	#secsize,d7	* calculate how many sectors to skip
* note that max # symbols is 8k, which is 896 sectors of 128 bytes
	move.w	d7,d6		* d6 is nmbr sectors to skip
	swap	d7		* d7 is nmbr bytes to skip
	move.w	bufbyts,d3
	sub.w	d7,d3		* subtract bytes to skip from buffer
	bge	skip1
	addi	#secsize,d3	*if amt in buffer < # bytes to skip,
	addq	#1,d6		*  read in 1 extra sector
skip1:	move.l	basepg,a3
	adda	#secsize,a3
	suba.w	d3,a3		* set up a3 to point to buffer
	lsr	#1,d3		* d3 is nmbr words in buffer
	bra	skip3
skip2:
	bsr	readseq		* read next symbol table sector
	tst.w	d1
	bne	rdbad
skip3:	dbf	d6,skip2
* we got past symbol table
* a3, d3 are set up
	move.l	cseg,d5
	move.l	d5,a2		* relocate cseg first
	sub.l	tstart,d5	* d5 contains the relocation offset
	move.l	csize,d4	* nmbr of bytes to relocate
	move.w	#2,loop		* we're going to relocate 2 segments
reloc1:
* relocate one segment
	clr.l	d2		* clear long word flag
	lsr.l	#1,d4		* make d4 indicate # words
	bra	reloc4
reloc2:
	subq.w	#1,d3
	bpl	reloc3
	bsr	readseq		* if no more words in buffer, refill it
	tst.w	d1
	bne	rdbad
	move.l	basepg,a3
	move.w	#(secsize/2)-1,d3
reloc3:
	bsr	relocword	* relocate one word
	subq.l	#1,d4
reloc4:
	tst.l	d4		* any more to relocate in this segment?
	bne	reloc2		* if yes, do it
	move.l	dseg,a2		* else, set up for dseg
	move.l	dsize,d4
	sub.w	#1,loop
	bne	reloc1
	rts


setrtn:
* Set up the return parameters in Ld Parm Blk and Base Page
	move.l	basepg,BasPage(a0)
	move.l	stk,d7
	add.l	stksize,d7
	bclr	#0,d7
	move.l	d7,Stack(a0)
	move.l	basepg,a1
	move.l	LoAdr(a0),(a1)+
	move.l	HiAdr(a0),(a1)+
	move.l	cseg,(a1)+
	move.l	csize,(a1)+
	move.l	dseg,(a1)+
	move.l	dsize,(a1)+
	move.l	bseg,(a1)+
	move.l	bsize,(a1)
* find size of free memory after bss segment
	move.l	HiAdr(a0),d7	* d7 contains next segment above bss
	move.l	-4(a1),d6
	add.l	(a1)+,d6	* d6 points to start of free mem after bss
	movea.l	#cseg,a6	* a6 points to segment to try
	moveq	#4,d5		* try for all segments
	clr.l	bseg		*    but force bss not to appear
setb1:	cmp.l	(a6),d6		* segment above bss?
	bhi	setb2
	cmp.l	(a6),d7		* segment is above bss. Is it below previous?
	bls	setb2
	move.l	(a6),d7
setb2:	tst.l	(a6)+		* point to next segment
	dbf	d5,setb1
	sub.l	d6,d7		* diff between bss top and next segment abv
	move.l	d7,(a1)+
*			now put disk number that we loaded from into base page
	movea.l FCBPtr(a0),a2
	move.b	(a2),d0		* get disk select byte
	bne	setb3		* if not auto-select, skip
	move	#25,d0
	trap	#2		* get default disk
	addq	#1,d0		* we want it in range of 1..16
setb3:	move.b	d0,(a1)+	* move disk number into base page
	clr.l	d0		* function OK
	rts


	.bss

* offsets from start of parameter block
FCBPtr  = 0
LoAdr   = 4
HiAdr   = 8
BasPage = 12		* return parameters
Stack   = 16
Flags   = 21

hdr:
				* load file header is read into here
magic:		.ds.w	1
csize:		.ds.l	1
dsize:		.ds.l	1
bsize:		.ds.l	1
bpsize:		.ds.l	1	* symb tbl size is swapped with base page size
stksize:	.ds.l	1
tstart:		.ds.l	1
rlbflg:		.ds.w	1
dstart:		.ds.l	1
bstart:		.ds.l	1

cseg:		.ds.l	1
dseg:		.ds.l	1
bseg:		.ds.l	1
basepg:		.ds.l	1
stk:		.ds.l	1

symsize:	.ds.l	1
temp:		.ds.l	1
loop:		.ds.w	1
bufbyts:	.ds.w	1

	.end