mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-22 16:04:18 +00:00
538 lines
13 KiB
ArmAsm
538 lines
13 KiB
ArmAsm
|
|
*********************************
|
|
* *
|
|
* 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
|