mirror of
https://github.com/byteworksinc/Linker.git
synced 2024-11-21 13:31:57 +00:00
aa9a585d19
This would happen if a later object segment had a more restrictive alignment than previous object segments that contribute to the same load segment, as in the following example:
s1 start
jsl s2
rtl
end
align 256
s2 start
rtl
end
These alignment requirements can be satisfied by just giving the load segment the most restrictive alignment of any object segment (since all alignments are powers of 2) and inserting space as necessary to align the code from each object segment.
3150 lines
59 KiB
NASM
3150 lines
59 KiB
NASM
keep obj/out
|
|
mcopy out.mac
|
|
****************************************************************
|
|
*
|
|
* Ouput Module
|
|
*
|
|
* This module handles writing the output file and locating the
|
|
* proper load segment for code segments.
|
|
*
|
|
****************************************************************
|
|
copy directPage
|
|
****************************************************************
|
|
*
|
|
* OutCommon - global data for the segment module
|
|
*
|
|
****************************************************************
|
|
*
|
|
OutCommon data
|
|
;
|
|
; Constants
|
|
;
|
|
nameSize equ 10 size of a load segment name
|
|
dictGrowSize equ 4096 grow size for the dictionary buffer
|
|
dynGrowSize equ 1024 grow size for synamic segment buffer
|
|
;
|
|
; global variables
|
|
;
|
|
expressSegment ds 2 express segment number
|
|
keepRefnum ds 2 keep file reference number
|
|
lastLoadNumber ds 4 last load number allocated
|
|
loadList ds 4 head of load segment list
|
|
loadNamePtr ds 4 pointer to the name of the load segment
|
|
;
|
|
; Dynamic segment information
|
|
;
|
|
dynHandle ds 4 handle of the dynamic segment buffer
|
|
dynSize ds 2 bytes left in the buffer
|
|
dynBuffSize ds 4 total memory in the segment buffer
|
|
dynStart ds 4 ptr to the start of the buffer
|
|
dynSegment ds 2 dynamic segment number
|
|
;
|
|
; Current load segment information
|
|
;
|
|
loadNext ds 4 pointer to the next load segment
|
|
loadLast ds 4 pointer to the last load segment
|
|
loadPtr ds 4 pointer to the storage location for this record
|
|
loadNumber ds 2 number of this load segment
|
|
loadType ds 2 load segment type
|
|
loadORG ds 4 load segment origin
|
|
loadAlign ds 4 load segment aligment
|
|
loadBankSize ds 4 load segment bank size
|
|
loadName ds nameSize name of the load segment
|
|
loadSeg ds 4 handle of the segment buffer
|
|
loadSegStart ds 4 start of the segment buffer
|
|
loadPC ds 4 size of the load segment
|
|
loadOp ds 4 op disp for the segment buffer
|
|
loadOpSt ds 4 op at start of current lConst
|
|
loadDict ds 4 handle of the dictionary buffer
|
|
loadDictStart ds 4 start of the dictionary buffer
|
|
loadDictSize ds 2 bytes left in the dictionary buffer
|
|
loadDp ds 4 dp disp for the dictionary buffer
|
|
loadPass2 ds 2 are we ready for pass 2?
|
|
|
|
loadEnd anop end of the record
|
|
|
|
loadSize equ loadEnd-loadNext size of a load module record (even!)
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* AddEnd - add an end record to the dictionary
|
|
*
|
|
* Inputs:
|
|
* loadNext... - load segment record
|
|
*
|
|
****************************************************************
|
|
*
|
|
AddEnd private
|
|
using OutCommon
|
|
|
|
lda loadDictSize make sure there is room in the dictionary
|
|
bne lb1
|
|
jsr ExpandDictBuffer
|
|
lb1 short M save the end marker
|
|
lda #0
|
|
sta [dp]
|
|
long M
|
|
inc4 dp update dp
|
|
dec loadDictSize update loadDictSize
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* AddSegment - add a segment to the expressload table
|
|
*
|
|
* Inputs:
|
|
* r8 - pointer to the segment to add
|
|
* r4,r8 - expressload list pointers
|
|
* expOffset - segment offset pointer
|
|
* expMap - segment map pointer
|
|
* expHeader - segment header map
|
|
* expressSegment - express segment number
|
|
*
|
|
****************************************************************
|
|
*
|
|
AddSegment private
|
|
using OutCommon
|
|
|
|
jsr MoveSegment move the segment ot the new list
|
|
|
|
sub4 expHeader,expOffset,r12 set the segment offset
|
|
lda r12
|
|
sta [expOffset]
|
|
ldy #6 zero the reserved words
|
|
lda #0
|
|
lb1 sta [expOffset],Y
|
|
dey
|
|
dey
|
|
bne lb1
|
|
add4 expOffset,#8 update the offset pointer
|
|
|
|
ldy #loadNumber-loadNext get the old segment number
|
|
lda [r4],Y
|
|
dec A set it's mapped segment
|
|
asl A
|
|
tay
|
|
lda expressSegment
|
|
sta [expMap],Y
|
|
ldy #loadNumber-loadNext set the new segment number
|
|
sta [r4],Y
|
|
inc expressSegment update segment number
|
|
|
|
add4 fMark,#69+5 allow for the segment header & lconst
|
|
move4 fMark,mark1 set the lconst mark
|
|
ldy #loadPC-loadNext find the segment size
|
|
lda [r4],Y
|
|
sta len1
|
|
iny
|
|
iny
|
|
lda [r4],Y
|
|
sta len1+2
|
|
add4 fMark,len1 allow for the segment body
|
|
move4 fMark,mark2 set the reloc mark
|
|
ldy #loadDp-loadNext find the reloc size
|
|
lda [r4],Y
|
|
sta len2
|
|
iny
|
|
iny
|
|
lda [r4],Y
|
|
sta len2+2
|
|
ora len2 if len2 = 0 then
|
|
bne lb1a
|
|
stz mark2 mark2 = 0
|
|
stz mark2+2
|
|
lb1a add4 fMark,len2 allow for the dictionary
|
|
inc4 fMark allow for the end mark
|
|
ldy #loadBankSize-loadNext set the bank size
|
|
lda [r4],Y
|
|
sta bankSize
|
|
iny
|
|
iny
|
|
lda [r4],Y
|
|
sta bankSize+2
|
|
ldy #loadType-loadNext set the segment type
|
|
lda [r4],Y
|
|
sta kind
|
|
ldy #loadOrg-loadNext set the origin
|
|
lda [r4],Y
|
|
sta org
|
|
iny
|
|
iny
|
|
lda [r4],Y
|
|
sta org+2
|
|
ldy #loadAlign-loadNext set the alignment factor
|
|
lda [r4],Y
|
|
sta align
|
|
iny
|
|
iny
|
|
lda [r4],Y
|
|
sta align+2
|
|
ldy #loadNumber-loadNext set the segment number
|
|
lda [r4],Y
|
|
sta segNum
|
|
ldx #nameSize-2 set the segment name
|
|
ldy #loadName-loadNext+nameSize-2
|
|
lb2 lda [r4],Y
|
|
sta name,X
|
|
dey
|
|
dey
|
|
dex
|
|
dex
|
|
bpl lb2
|
|
|
|
ldy #segEnd-mark1-1 move the header to the express segment
|
|
short M
|
|
lb3 lda mark1,Y
|
|
sta [expHeader],Y
|
|
dey
|
|
bpl lb3
|
|
long M
|
|
add4 expHeader,#69 update the segment header pointer
|
|
rts
|
|
|
|
mark1 ds 4 lConst file mark
|
|
len1 ds 4 lConst length
|
|
mark2 ds 4 reloc file mark
|
|
len2 ds 4 reloc length
|
|
dc i1'0' undefined
|
|
dc i1'0' label length
|
|
dc i1'4' number length
|
|
dc i1'2' version
|
|
bankSize ds 4 bank size
|
|
kind ds 2 segment type
|
|
dc i'0' undefined
|
|
org ds 4 origin
|
|
align ds 4 alignment
|
|
dc i1'0' numsex
|
|
dc i1'0' undefined
|
|
segNum ds 2 segment number
|
|
dc i4'0' segment entry
|
|
dc i'lname-len1' disp to name
|
|
dc i'segend-mark1' disp to body
|
|
lname dc 10c' ' load name
|
|
dc i1'10' segment name length
|
|
name ds 10 segment name
|
|
segend anop
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CheckHeader - check the header parameters
|
|
*
|
|
* Inputs:
|
|
* segOrg - origin for this segment
|
|
* segAlign - alignment for this segment
|
|
* segType - type for this segment
|
|
* segBanksize - banksize for this segment
|
|
* loadType - load segment type
|
|
* loadORG - load segment origin
|
|
* loadAlign - load segment aligment
|
|
* loadBankSize - load segment bank size
|
|
*
|
|
* Outputs:
|
|
* loadType - load segment type
|
|
* loadORG - load segment origin
|
|
* loadAlign - load segment aligment
|
|
* loadBankSize - load segment bank size
|
|
*
|
|
****************************************************************
|
|
*
|
|
CheckHeader private
|
|
using OutCommon
|
|
using Common
|
|
;
|
|
; Set the load segment type
|
|
;
|
|
lda loadPC if at the start of the segment then
|
|
ora loadPC+2
|
|
bne st1
|
|
lda segType use segType
|
|
and #$FEFF
|
|
sta loadType
|
|
bra st4 else
|
|
st1 lda segType or in the or flags
|
|
and #$1D00
|
|
ora loadType
|
|
sta loadType
|
|
lda segType mask out missing and flags
|
|
and #$E200
|
|
ora #$3DFF
|
|
and loadType
|
|
sta loadType
|
|
lda loadType get the type without flags
|
|
and #$007F
|
|
sta r0
|
|
lda segType
|
|
and #$007F
|
|
cmp r0 if they do not match then
|
|
beq st4
|
|
cmp #1 if seg is data then
|
|
bne st2
|
|
lda r0 if not load in [code,init,dp] then
|
|
beq st4
|
|
cmp #$10
|
|
beq st4
|
|
cmp #$12
|
|
beq st4
|
|
err15 ph4 #0 flag segment conflict
|
|
ph2 #15
|
|
jsr Error
|
|
bra st4
|
|
st2 cmp #0 else if seg in [code,init,dp] then
|
|
beq st3
|
|
cmp #$10
|
|
beq st3
|
|
cmp #$12
|
|
bne err15
|
|
st3 lda r0 if load = data then
|
|
cmp #1
|
|
bne err15
|
|
lda loadType use seg type
|
|
and #$FF00
|
|
sta loadType
|
|
lda segType
|
|
and #$007F
|
|
ora loadType
|
|
sta loadType
|
|
! else flag the error
|
|
st4 anop endif
|
|
|
|
lda bankOrg if bankOrg then
|
|
beq st5
|
|
lda loadType bank org the program
|
|
ora #$0100
|
|
sta loadType
|
|
st5 anop endif
|
|
;
|
|
; Set the load segment origin (pass 1)
|
|
;
|
|
lda pass branch if pass 2
|
|
cmp #2
|
|
beq or0
|
|
lda segOrg skip if org is 0
|
|
ora segOrg+2
|
|
jeq or4
|
|
|
|
lda loadPC if at the start of the segment then
|
|
ora loadPC+2
|
|
ora loadOrg
|
|
ora loadOrg+2
|
|
bne po1
|
|
move4 segOrg,loadOrg loadOrg = segOrg
|
|
bra po3 else
|
|
po1 sub4 segOrg,loadOrg,r0 update the pc
|
|
lda r2
|
|
bmi po3
|
|
cmpl r0,pc
|
|
blt po3
|
|
move4 r0,pc
|
|
po3 anop endif
|
|
bra or4
|
|
;
|
|
; Set the load segment origin (pass 2)
|
|
;
|
|
or0 lda segOrg skip if org is 0
|
|
ora segOrg+2
|
|
beq or4
|
|
|
|
lda loadPC if at the start of the segment then
|
|
ora loadPC+2
|
|
ora loadOrg
|
|
ora loadOrg+2
|
|
bne or1
|
|
move4 segOrg,loadOrg loadOrg = segOrg
|
|
bra or3 else
|
|
or1 sub4 segOrg,loadOrg,r0 update the pc
|
|
sub4 r0,pc
|
|
lda r2
|
|
bpl or2 if disp is negative then
|
|
ph4 #0 Error(NULL,3)
|
|
ph2 #3
|
|
jsr Error
|
|
bra or3 else
|
|
or2 lda r0 define DS bytes to fill space
|
|
ora r2
|
|
beq or3
|
|
jsr DefineDS
|
|
or3 anop endif
|
|
jsr CheckAlignOrg check for conflicts between align,org
|
|
or4 anop
|
|
;
|
|
; Set the load segment alignment (pass 1)
|
|
;
|
|
lda pass branch if pass 2
|
|
cmp #2
|
|
beq sa0
|
|
lda segAlign skip if alignment is 0
|
|
ora segAlign+2
|
|
jeq sa4
|
|
|
|
lda loadPC if at the start of the segment then
|
|
ora loadPC+2
|
|
ora loadAlign
|
|
ora loadAlign+2
|
|
bne la1
|
|
move4 segAlign,loadAlign loadAlign = segAlign
|
|
bra la3 else
|
|
la1 cmpl loadAlign,segAlign if loadAlign < segAlign then
|
|
bge la2
|
|
move4 segAlign,loadAlign loadAlign = segAlign
|
|
la2 move4 segAlign,r0 PrepareAlign(segAlign)
|
|
jsr PrepareAlign
|
|
la3 anop endif
|
|
bra sa4
|
|
;
|
|
; Set the load segment alignment (pass 2)
|
|
;
|
|
sa0 lda segAlign skip if alignment is 0
|
|
ora segAlign+2
|
|
beq sa4
|
|
|
|
ph4 segAlign make sure the align is a power of 2
|
|
jsr CheckAlign
|
|
lda loadPC if at the start of the segment then
|
|
ora loadPC+2
|
|
ora loadAlign
|
|
ora loadAlign+2
|
|
bne sa1
|
|
move4 segAlign,loadAlign loadAlign = segAlign
|
|
bra sa3 else
|
|
sa1 cmpl loadAlign,segAlign if loadAlign < segAlign then
|
|
bge sa2
|
|
move4 segAlign,loadAlign loadAlign = segAlign
|
|
sa2 move4 segAlign,r0 DefineAlign(segAlign)
|
|
jsr DefineAlign
|
|
sa3 anop endif
|
|
jsr CheckAlignOrg check for conflicts between align,org
|
|
sa4 anop
|
|
;
|
|
; Set the load segment bank size
|
|
;
|
|
lda pass branch if pass 2
|
|
cmp #2
|
|
beq rt1
|
|
lda loadBankSize if loadBanksize = 0
|
|
ora loadBanksize+2
|
|
beq bs1
|
|
cmpl segBanksize,loadBanksize or ((segBanksize < loadBanksize)
|
|
bge bs2 and (segBanksize <> 0)) then
|
|
lda segBanksize
|
|
ora segBanksize+2
|
|
beq bs2
|
|
bs1 move4 segBankSize,loadBankSize loadBankSize = segBankSize
|
|
bs2 anop
|
|
|
|
rt1 rts
|
|
;
|
|
; CheckAlignOrg - make sure the align and org do not conflict
|
|
;
|
|
CheckAlignOrg anop
|
|
|
|
lda loadAlign if loadAlign <> 0 then
|
|
ora loadAlign+2
|
|
beq ca2
|
|
sub4 loadAlign,#1,r0 if loadOrg & (loadAlign-1) then
|
|
lda r0
|
|
and loadOrg
|
|
bne ca1
|
|
lda r2
|
|
and loadOrg+2
|
|
beq ca2
|
|
ca1 ph4 #0 Error(NULL,21)
|
|
ph2 #21
|
|
jsr Error
|
|
ca2 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CompactCInterseg - compact a cInterseg record
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the cInterseg record
|
|
* r4 - ptr to the end of the dictionary
|
|
* dp - ptr to the next free byte in the dictionary
|
|
*
|
|
****************************************************************
|
|
*
|
|
CompactCInterseg private
|
|
using Common
|
|
using OutCommon
|
|
;
|
|
; See if the record can be compacted
|
|
;
|
|
lda [r0] length must be 2 or 3
|
|
xba
|
|
and #$00FF
|
|
cmp #2
|
|
beq ck1
|
|
cmp #3
|
|
jne nc1
|
|
ck1 sta length
|
|
cmp #3 if length = 3 then
|
|
bne ck2
|
|
ldy #2 shift count must be 0
|
|
lda [r0],Y
|
|
and #$00FF
|
|
jne nc1
|
|
stz shift
|
|
lda #2 set the record type
|
|
sta recordType
|
|
ldy #5 set the segment number
|
|
lda [r0],Y
|
|
and #$00FF
|
|
sta segment
|
|
bra ck3 else {if length = 2 then}
|
|
ck2 ldy #5 segment number must be <= 12
|
|
lda [r0],Y
|
|
and #$00FF
|
|
sta segment
|
|
cmp #13
|
|
jge nc1
|
|
ldx express if express then
|
|
beq ck2a
|
|
cmp #12 don't use 12, either
|
|
jeq nc1
|
|
ck2a clc set the record type for shift 0
|
|
lda segment
|
|
adc #13
|
|
sta recordType
|
|
ldy #2 shift must be 0 or -16
|
|
lda [r0],Y
|
|
and #$00FF
|
|
sta shift
|
|
beq ck3
|
|
cmp #$00F0
|
|
jne nc1
|
|
add2 recordType,#12 set the record type for shift -16
|
|
ck3 anop
|
|
;
|
|
; Create a Super record
|
|
;
|
|
lda #13 create the record header
|
|
cmp loadDictSize make sure there is room in the
|
|
blt sp1 dictionary
|
|
jsr ExpandDictBuffer
|
|
sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field
|
|
sub4 recordLengthPtr,loadDictStart
|
|
short M set the op code
|
|
lda #$F7
|
|
sta [dp]
|
|
ldy #5 set the super record type
|
|
lda recordType
|
|
sta [dp],Y
|
|
long M
|
|
add4 dp,#6 skip the super record header
|
|
sub2 loadDictSize,#6
|
|
|
|
ldy #4 set the segment offset page
|
|
lda [r0],Y
|
|
and #$00FF
|
|
sta page
|
|
beq pg3 if page <> 0 then
|
|
sta r12 while (r12 := page) > $7F do
|
|
pg1 lda r12
|
|
cmp #$80
|
|
blt pg2
|
|
short M write a skip page for $7F pages
|
|
lda #$FF
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
sub2 r12,#$7F r12 -= $7F
|
|
bra pg1 endwhile
|
|
pg2 lda r12 if r12 <> 0 then
|
|
beq pg3
|
|
short M write a skip page for r12 pages
|
|
ora #$80
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
pg3 anop
|
|
move4 dp,r12 initialize the page counter
|
|
short M
|
|
lda #$FF
|
|
sta [r12]
|
|
long M
|
|
inc4 dp skip the page counter
|
|
dec loadDictSize
|
|
|
|
move4 r0,r8 for each dictionary record do
|
|
sp2 cmpl r8,r4
|
|
jeq sp14
|
|
lda [r8] if it is a Reloc then
|
|
and #$00FF
|
|
cmp #$E2
|
|
bne sp3
|
|
add4 r8,#11 skip the record
|
|
bra sp2 loop
|
|
sp3 cmp #$75 if it is a skipped cReloc or
|
|
beq sp4 cReloc then
|
|
cmp #$F5
|
|
bne sp5
|
|
sp4 add4 r8,#7 skip the record
|
|
bra sp2 loop
|
|
sp5 cmp #$76 if it is a skipped cInterseg then
|
|
bne sp6
|
|
add4 r8,#8 skip the record
|
|
bra sp2 loop
|
|
sp6 cmp #$E3 if it is an Interseg then
|
|
bne sp7
|
|
add4 r8,#15 skip the record
|
|
bra sp2 loop
|
|
sp7 ldy #2 if the cInterseg is a different type
|
|
short M then
|
|
lda [r8],Y
|
|
cmp shift
|
|
bne sp7a
|
|
dey
|
|
lda [r8],Y
|
|
cmp length
|
|
bne sp7a
|
|
cmp #3
|
|
beq sp8
|
|
ldy #5
|
|
lda [r8],Y
|
|
cmp segment
|
|
beq sp8
|
|
sp7a long M skip the record
|
|
add4 r8,#8
|
|
brl sp2 loop
|
|
|
|
sp8 long M make sure there is room in the
|
|
lda #5 dictionary
|
|
cmp loadDictSize
|
|
blt sp9
|
|
sub4 r12,loadDictStart
|
|
jsr ExpandDictBuffer
|
|
add4 r12,loadDictStart
|
|
sp9 short M if r8^.page <> page then
|
|
sec
|
|
ldy #4
|
|
lda [r8],Y
|
|
sbc page
|
|
beq sp13
|
|
dec A if r8^.page - page > 1 then
|
|
beq sp12
|
|
sp10 cmp #$80 record a page skip
|
|
blt sp11
|
|
tax
|
|
lda #$FF
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
txa
|
|
sec
|
|
sbc #$7F
|
|
bra sp10
|
|
sp11 cmp #0
|
|
beq sp12
|
|
ora #$80
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
sp12 ldy #4 record the new page
|
|
lda [r8],Y
|
|
sta page
|
|
lda #$FF set up a record count
|
|
sta [dp]
|
|
long M
|
|
move4 dp,r12
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
sp13 lda [r12] increment the record count
|
|
inc A
|
|
sta [r12]
|
|
ldy #3 set the offset
|
|
lda [r8],Y
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M mark the record
|
|
lda [r8]
|
|
and #$7F
|
|
sta [r8]
|
|
long M
|
|
add4 r8,#8 skip the record
|
|
brl sp2 loop
|
|
|
|
sp14 anop set the super record length
|
|
add4 recordLengthPtr,loadDictStart,r12
|
|
sub4 dp,r12,recordLengthPtr
|
|
sub4 recordLengthPtr,#4
|
|
ldy #2
|
|
lda recordLengthPtr
|
|
sta [r12]
|
|
lda recordLengthPtr+2
|
|
sta [r12],Y
|
|
rts
|
|
;
|
|
; Cannot compact - put the unchanged record in the dictionary
|
|
;
|
|
nc1 lda #8 make sure there is room in the
|
|
cmp loadDictSize dictionary
|
|
blt nc2
|
|
jsr ExpandDictBuffer
|
|
nc2 ldy #6 move the record
|
|
nc3 lda [r0],Y
|
|
sta [dp],Y
|
|
dey
|
|
dey
|
|
bpl nc3
|
|
add4 dp,#8 skip the record
|
|
sub2 loadDictSize,#8
|
|
add4 r0,#8
|
|
rts
|
|
;
|
|
; Local data
|
|
;
|
|
recordLengthPtr ds 4 pointer to the super record length field
|
|
page ds 2 current cReloc page number
|
|
length ds 2 length of the cReloc fields
|
|
shift ds 2 shift count
|
|
segment ds 2 segment number
|
|
recordType ds 2 type of the Super record
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CompactCReloc - compact a cReloc record
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the cReloc record
|
|
* r4 - ptr to the end of the dictionary
|
|
* dp - ptr to the next free byte in the dictionary
|
|
*
|
|
****************************************************************
|
|
*
|
|
CompactCReloc private
|
|
using OutCommon
|
|
;
|
|
; See if the record can be compacted
|
|
;
|
|
lda [r0] length must be 2 or 3
|
|
xba
|
|
and #$00FF
|
|
cmp #2
|
|
beq ck1
|
|
cmp #3
|
|
jne nc1
|
|
ck1 sta length
|
|
ldy #2 shift count must be 0
|
|
lda [r0],Y
|
|
and #$00FF
|
|
jne nc1
|
|
;
|
|
; Create a Super record
|
|
;
|
|
lda #13 create the record header
|
|
cmp loadDictSize make sure there is room in the
|
|
blt sp1 dictionary
|
|
jsr ExpandDictBuffer
|
|
sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field
|
|
sub4 recordLengthPtr,loadDictStart
|
|
short M set the op code
|
|
lda #$F7
|
|
sta [dp]
|
|
ldy #5 set the super record type
|
|
lda length
|
|
and #$01
|
|
sta [dp],Y
|
|
long M
|
|
add4 dp,#6 skip the super record header
|
|
sub2 loadDictSize,#6
|
|
|
|
ldy #4 set the segment offset page
|
|
lda [r0],Y
|
|
and #$00FF
|
|
sta page
|
|
beq pg3 if page <> 0 then
|
|
sta r12 while (r12 := page) > $7F do
|
|
pg1 lda r12
|
|
cmp #$80
|
|
blt pg2
|
|
short M write a skip page for $7F pages
|
|
lda #$FF
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
sub2 r12,#$7F r12 -= $7F
|
|
bra pg1 endwhile
|
|
pg2 lda r12 if r12 <> 0 then
|
|
beq pg3
|
|
short M write a skip page for r12 pages
|
|
ora #$80
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
pg3 anop
|
|
move4 dp,r12 initialize the page counter
|
|
short M
|
|
lda #$FF
|
|
sta [r12]
|
|
long M
|
|
inc4 dp skip the page counter
|
|
dec loadDictSize
|
|
|
|
move4 r0,r8 for each dictionary record do
|
|
sp2 cmpl r8,r4
|
|
jeq sp14
|
|
lda [r8] if it is a Reloc then
|
|
and #$00FF
|
|
cmp #$E2
|
|
bne sp3
|
|
add4 r8,#11 skip the record
|
|
bra sp2 loop
|
|
sp3 cmp #$75 if it is a skipped cReloc then
|
|
bne sp4
|
|
add4 r8,#7 skip the record
|
|
bra sp2 loop
|
|
sp4 cmp #$F6 if it is a cInterseg or skipped
|
|
beq sp5 cInterseg then
|
|
cmp #$76
|
|
bne sp6
|
|
sp5 add4 r8,#8 skip the record
|
|
bra sp2 loop
|
|
sp6 cmp #$E3 if it is an Interseg then
|
|
bne sp7
|
|
add4 r8,#15 skip the record
|
|
bra sp2 loop
|
|
sp7 ldy #1 if the cReloc is a different type then
|
|
lda [r8],Y
|
|
cmp length (checks length and shift=0)
|
|
beq sp8
|
|
add4 r8,#7 skip the record
|
|
bra sp2 loop
|
|
|
|
sp8 lda #5 make sure there is room in the
|
|
cmp loadDictSize dictionary
|
|
blt sp9
|
|
sub4 r12,loadDictStart
|
|
jsr ExpandDictBuffer
|
|
add4 r12,loadDictStart
|
|
sp9 short M if r8^.page <> page then
|
|
sec
|
|
ldy #4
|
|
lda [r8],Y
|
|
sbc page
|
|
beq sp13
|
|
dec A if r8^.page - page > 1 then
|
|
beq sp12
|
|
sp10 cmp #$80 record a page skip
|
|
blt sp11
|
|
tax
|
|
lda #$FF
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
txa
|
|
sec
|
|
sbc #$7F
|
|
bra sp10
|
|
sp11 cmp #0
|
|
beq sp12
|
|
ora #$80
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
sp12 ldy #4 record the new page
|
|
lda [r8],Y
|
|
sta page
|
|
lda #$FF set up a record count
|
|
sta [dp]
|
|
long M
|
|
move4 dp,r12
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M
|
|
sp13 lda [r12] increment the record count
|
|
inc A
|
|
sta [r12]
|
|
ldy #3 set the offset
|
|
lda [r8],Y
|
|
sta [dp]
|
|
long M
|
|
inc4 dp
|
|
dec loadDictSize
|
|
short M mark the record
|
|
lda [r8]
|
|
and #$7F
|
|
sta [r8]
|
|
long M
|
|
add4 r8,#7 skip the record
|
|
brl sp2 loop
|
|
|
|
sp14 anop set the super record length
|
|
add4 recordLengthPtr,loadDictStart,r12
|
|
sub4 dp,r12,recordLengthPtr
|
|
sub4 recordLengthPtr,#4
|
|
ldy #2
|
|
lda recordLengthPtr
|
|
sta [r12]
|
|
lda recordLengthPtr+2
|
|
sta [r12],Y
|
|
rts
|
|
;
|
|
; Cannot compact - put the unchanged record in the dictionary
|
|
;
|
|
nc1 lda #8 make sure there is room in the
|
|
cmp loadDictSize dictionary
|
|
blt nc2
|
|
jsr ExpandDictBuffer
|
|
nc2 ldy #6 move the record
|
|
nc3 lda [r0],Y
|
|
sta [dp],Y
|
|
dey
|
|
dey
|
|
bpl nc3
|
|
add4 dp,#7 skip the record
|
|
sub2 loadDictSize,#7
|
|
add4 r0,#7
|
|
rts
|
|
;
|
|
; Local data
|
|
;
|
|
recordLengthPtr ds 4 pointer to the super record length field
|
|
page ds 2 current cReloc page number
|
|
length ds 2 length of the cReloc fields
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CompactSegment - compact a single segment
|
|
*
|
|
* Inputs:
|
|
* LoadNext... - segment record
|
|
*
|
|
****************************************************************
|
|
*
|
|
CompactSegment private
|
|
using OutCommon
|
|
using Common
|
|
|
|
lda loadDict if there is no dictionary then
|
|
ora loadDict+2
|
|
bne lb1
|
|
rts return
|
|
|
|
lb1 move4 loadDict,dictHandle save the dictionary handle
|
|
move4 loadDictStart,r0 get a pointer to the dictionary
|
|
move4 dp,r4 get a pointer to the dictionary end
|
|
stz loadDictStart zero the current load dictionary
|
|
stz loadDictStart+2
|
|
stz loadDict
|
|
stz loadDict+2
|
|
stz loadDp
|
|
stz loadDp+2
|
|
stz dp
|
|
stz dp+2
|
|
stz loadDictSize
|
|
stz loadDictSize+2
|
|
lb2 cmpl r0,r4 for each dictionary entry do
|
|
jeq lb12
|
|
lda [r0] if r0^ = cReloc then
|
|
and #$00FF
|
|
cmp #$00F5
|
|
bne lb3
|
|
jsr CompactCReloc compact the record
|
|
bra lb2 loop
|
|
lb3 cmp #$75 if r0^ = skipped cReloc then
|
|
bne lb4
|
|
add4 r0,#7 skip the record
|
|
bra lb2 loop
|
|
lb4 cmp #$E2 if r0^ = Reloc then
|
|
bne lb7
|
|
lda #12 make sure there is room in the
|
|
cmp loadDictSize dictionary
|
|
blt lb5
|
|
jsr ExpandDictBuffer
|
|
lb5 ldy #10 move the record
|
|
lb6 lda [r0],Y
|
|
sta [dp],Y
|
|
dey
|
|
dey
|
|
bpl lb6
|
|
add4 dp,#11 skip the record
|
|
sub2 loadDictSize,#11
|
|
add4 r0,#11
|
|
bra lb2 loop
|
|
lb7 cmp #$F6 if r0^ = cInterseg then
|
|
bne lb8
|
|
jsr CompactCInterseg compact the record
|
|
bra lb2 loop
|
|
lb8 cmp #$76 if r0^ = skipped cInterseg then
|
|
bne lb9
|
|
add4 r0,#8 skip the record
|
|
brl lb2 loop
|
|
! (condition must be true) if r0^ = Interseg then
|
|
lb9 lda #16 make sure there is room in the
|
|
cmp loadDictSize dictionary
|
|
blt lb10
|
|
jsr ExpandDictBuffer
|
|
lb10 ldy #14 move the record
|
|
lb11 lda [r0],Y
|
|
sta [dp],Y
|
|
dey
|
|
dey
|
|
bpl lb11
|
|
add4 dp,#15 skip the record
|
|
sub2 loadDictSize,#15
|
|
add4 r0,#15
|
|
brl lb2 loop
|
|
|
|
lb12 ph4 dictHandle free the old dictionary buffer
|
|
_DisposeHandle
|
|
rts
|
|
|
|
dictHandle ds 4 old dictionary handle
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CreateDynamicSegment - create the dynamic segment (if any)
|
|
*
|
|
* Inputs:
|
|
* dynSegment - dynmaic segment number; 0 if none
|
|
* dynStart - start of the dynamic segment
|
|
* dy - next byte in the buffer
|
|
*
|
|
****************************************************************
|
|
*
|
|
CreateDynamicSegment private
|
|
using OutCommon
|
|
|
|
lda dynSegment quit if there is no segment
|
|
bne lb0
|
|
rts
|
|
lb0 lda dynSize write the trailing 4 bytes
|
|
cmp #4
|
|
bge lb1
|
|
jsr ExpandDynamicBuffer
|
|
lb1 ldy #2
|
|
lda #0
|
|
sta [dy]
|
|
sta [dy],Y
|
|
add4 dy,#4
|
|
sub4 dy,dynStart,r0 set the size of the lConst
|
|
sub4 r0,#5
|
|
move4 dynStart,r4
|
|
lda #$F2
|
|
sta [r4]
|
|
ldy #1
|
|
lda r0
|
|
sta [r4],Y
|
|
iny
|
|
iny
|
|
lda r2
|
|
sta [r4],Y
|
|
|
|
move #0,loadNext,#loadSize clear all entries
|
|
lda dynSegment set the segment number
|
|
sta loadNumber
|
|
lda #2 set the segment type
|
|
sta loadType
|
|
lla loadBankSize,$10000 set the load segment bank size
|
|
move jumpName,loadName,#nameSize set the segment name
|
|
move4 dynHandle,loadSeg set the segment buffer handle
|
|
move4 dynStart,loadSegStart set the load segment start
|
|
sub4 dy,dynStart,loadPc set the segment size
|
|
sub4 loadPc,#5
|
|
move4 loadPc,pc
|
|
move4 dy,op set the segment pointer
|
|
sub4 dy,dynStart,loadOp set the segment displacement
|
|
inc loadPass2 ready for pass 2
|
|
stz dp no dictionary pointer
|
|
stz dp+2
|
|
jsr SaveSegment
|
|
rts
|
|
|
|
jumpName dc c'~JumpTable'
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CreateFile - make sure an output file exists
|
|
*
|
|
* Inputs:
|
|
* kname - keep file name
|
|
*
|
|
****************************************************************
|
|
*
|
|
CreateFile private
|
|
using OutCommon
|
|
|
|
move4 kname,giPathname see if a file exists
|
|
OSGet_File_Info giRec
|
|
bcs lb1
|
|
lda giFiletype yes -> make sure it is an OBJ file
|
|
cmp #$B3
|
|
blt err7
|
|
cmp #$BF+1
|
|
bge err7
|
|
rts
|
|
|
|
lb1 move4 kname,crPathname no file exists, so create one
|
|
OSCreate crRec
|
|
bcs err12
|
|
rts
|
|
|
|
err12 lda #12 file write error
|
|
jmp TermError
|
|
|
|
err7 lda #7 Could not overwrite existing file
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
giRec dc i'3' GetFileInfo record
|
|
giPathname ds 4
|
|
ds 2
|
|
giFiletype ds 2
|
|
|
|
crRec dc i'4'
|
|
crPathname ds 4
|
|
dc i'$C3'
|
|
dc i'EXE'
|
|
dc i4'$0100'
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* DecimalVariable - convert an OS string to a decimal value
|
|
*
|
|
* Inputs:
|
|
* r0 - pointer to the shell variable value
|
|
*
|
|
* Outputs:
|
|
* C - set if all characters are digits, else clear
|
|
* X-A - value (if C set); least sig. 32 bits only
|
|
*
|
|
****************************************************************
|
|
*
|
|
DecimalVariable private
|
|
|
|
lda [r0] get a loop counter
|
|
sta r12
|
|
stz r8 set the initial value
|
|
stz r10
|
|
add4 r0,#2,r4 get a character pointer
|
|
|
|
lb1 lda [r4] if the character is not a digit then
|
|
and #$00FF return false
|
|
cmp #'0'
|
|
blt lb3
|
|
cmp #'9'+1
|
|
bge lb3
|
|
mul4 r8,#10 r8 = r8*10 + value(r4^)
|
|
lda [r4]
|
|
and #$000F
|
|
clc
|
|
adc r8
|
|
sta r8
|
|
bcc lb2
|
|
inc r10
|
|
lb2 inc4 r4 loop
|
|
dec r12
|
|
bne lb1
|
|
|
|
lda r8 return value
|
|
ldx r10
|
|
sec
|
|
rts
|
|
|
|
lb3 clc return false
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* DoCompact - compact the dictionaries
|
|
*
|
|
****************************************************************
|
|
*
|
|
DoCompact private
|
|
using OutCommon
|
|
using Common
|
|
|
|
jsr SaveSegment save the current segment
|
|
lda #1 set the segment number
|
|
sta segment
|
|
lb1 move4 loadList,r0 find the proper segment
|
|
lb2 ldy #loadNumber-loadNext
|
|
lda [r0],Y
|
|
cmp segment
|
|
bne lb3
|
|
jsr GetSegment get the segment
|
|
jsr CompactSegment compact the segment
|
|
jsr SaveSegment save the segment
|
|
inc segment next segment
|
|
bra lb1 start the search over
|
|
|
|
lb3 ldy #2 next segment pointer
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
ora r2
|
|
bne lb2
|
|
|
|
move4 loadList,r0 done - get a segment back
|
|
jsr GetSegment
|
|
rts return
|
|
|
|
segment ds 2 segment number
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* DynamicCheck - if any segment is dynamic, set up a jump table
|
|
*
|
|
* Inputs:
|
|
* loadList - list of current load segments
|
|
* loadNext... - active load segment
|
|
* lastLoadNumber - last load number allocated
|
|
*
|
|
* Outputs: (if there is a dynamic segment)
|
|
* dynHandle - handle of the synamic segment
|
|
* dynStart - start of the dynamic segment
|
|
* dynSize - size of the dynamic segment
|
|
* dy - pointer to the next spot in the dynamic segment
|
|
* dynSegment - dynamic segment number
|
|
*
|
|
****************************************************************
|
|
*
|
|
DynamicCheck start
|
|
using OutCommon
|
|
;
|
|
; See if any segment is dynamic
|
|
;
|
|
lda loadType check the current segment
|
|
bmi pr1
|
|
move4 loadList,r0 check the segments in the segment list
|
|
cs1 lda r0
|
|
ora r2
|
|
beq cs2
|
|
ldy #loadType-loadNext
|
|
lda [r0],Y
|
|
bmi pr1
|
|
ldy #2
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
bra cs1
|
|
|
|
cs2 rts
|
|
;
|
|
; Prepare for dynamic segment output
|
|
;
|
|
pr1 stz dy zero the pointer
|
|
stz dy+2
|
|
stz dynSize zero the size
|
|
stz dynBuffSize no memory in the buffer
|
|
stz dynBuffSize+2
|
|
stz dynHandle no handle, yet
|
|
stz dynHandle+2
|
|
stz dynStart initialize the field
|
|
stz dynStart+2
|
|
jsr ExpandDynamicBuffer get an initial buffer
|
|
add4 dy,#5 create space for the lConst opcode
|
|
ldy #6 insert the 8 leading zeros
|
|
lda #0
|
|
pr2 sta [dy],Y
|
|
dey
|
|
dey
|
|
bpl pr2
|
|
sub2 dynSize,#13
|
|
add4 dy,#8
|
|
lda lastLoadNumber get a segment number
|
|
inc A
|
|
sta lastLoadNumber
|
|
sta dynSegment
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* ExpandDictBuffer - expand the dictionary buffer
|
|
*
|
|
* Inputs:
|
|
* loadDict - handle of the dictionary buffer, nil for none
|
|
* loadDictSize - size of the dictionary buffer
|
|
*
|
|
* Outputs:
|
|
* loadDict - handle of the dictionary buffer
|
|
* loadDictStart - start of the dictionary buffer
|
|
* loadDictSize - size of the dictionary buffer
|
|
* dp - start of the dictionary buffer
|
|
*
|
|
* Notes:
|
|
* Other than dp, direct page is not disturbed.
|
|
*
|
|
****************************************************************
|
|
*
|
|
ExpandDictBuffer start
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda loadDict if there is no buffer then
|
|
ora loadDict+2
|
|
bne lb1
|
|
la loadDictSize,dictGrowSize set the dictionary size
|
|
pha get a new buffer
|
|
pha
|
|
ph4 #dictGrowSize
|
|
ph2 userID
|
|
ph2 #$8000
|
|
ph4 #0
|
|
_NewHandle
|
|
jcs oom
|
|
pl4 loadDict
|
|
stz loadDP loadDP = 0
|
|
stz loadDP+2
|
|
brl lb2 else
|
|
lb1 sub4 dp,loadDictStart,loadDP get the displacement
|
|
ph4 loadDict unlock the handle
|
|
_HUnlock
|
|
pha get the current handle size
|
|
pha
|
|
ph4 loadDict
|
|
_GetHandleSize
|
|
clc set the new size
|
|
lda 1,S
|
|
adc #dictGrowSize
|
|
sta 1,S
|
|
lda 3,S
|
|
adc #^dictGrowSize
|
|
sta 3,S
|
|
ph4 loadDict expand the buffer
|
|
_SetHandleSize
|
|
bcs oom
|
|
ph4 loadDict lock the handle
|
|
_HLock
|
|
add2 loadDictSize,#dictGrowSize update the free space
|
|
lb2 anop endif
|
|
|
|
move4 loadDict,dp dereference the handle
|
|
ldy #2
|
|
lda [dp]
|
|
sta loadDictStart
|
|
lda [dp],Y
|
|
sta loadDictStart+2
|
|
add4 loadDictStart,loadDP,dp set dp
|
|
rts
|
|
|
|
oom lda #5
|
|
jmp TermError
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* ExpandDynamicBuffer - expand the dynamic segment buffer
|
|
*
|
|
* Inputs:
|
|
* dynHandle - handle of the buffer, nil for none
|
|
* dynBuffSize - size of the buffer
|
|
* synSize - bytes left in the current buffer
|
|
* dy - pointer to the current buffer
|
|
* dynStart - start of the buffer
|
|
*
|
|
* Outputs:
|
|
* dynHandle - handle of the buffer, nil for none
|
|
* dynBuffSize - size of the buffer
|
|
* synSize - bytes left in the current buffer
|
|
* dy - pointer to the current buffer
|
|
* dynStart - start of the buffer
|
|
*
|
|
****************************************************************
|
|
*
|
|
ExpandDynamicBuffer private
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda dynHandle if there is no buffer then
|
|
ora dynHandle+2
|
|
bne lb1
|
|
pha get a new buffer
|
|
pha
|
|
ph4 #dynGrowSize
|
|
ph2 userID
|
|
ph2 #$8000
|
|
ph4 #0
|
|
_NewHandle
|
|
jcs oom
|
|
pl4 dynHandle
|
|
lla dynBuffSize,dynGrowSize set the size
|
|
bra lb2 else
|
|
lb1 ph4 loadDict unlock the handle
|
|
_HUnlock
|
|
add4 dynBuffSize,#dynGrowSize get the new size
|
|
ph4 dynBuffSize set the new size
|
|
ph4 dynHandle expand the buffer
|
|
_SetHandleSize
|
|
bcs oom
|
|
ph4 dynHandle lock the handle
|
|
_HLock
|
|
lb2 anop endif
|
|
|
|
add2 dynSize,#dynGrowSize update the free space
|
|
sub4 dy,dynStart convert dy to a displacement
|
|
move4 dynHandle,r0 dereference the handle
|
|
ldy #2
|
|
lda [r0]
|
|
sta dynStart
|
|
lda [r0],Y
|
|
sta dynStart+2
|
|
add4 dy,dynStart set dy
|
|
rts
|
|
|
|
oom lda #5
|
|
jmp TermError
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* ExpressLoad - Handle express loading
|
|
*
|
|
* Inputs:
|
|
* express - is the program express loaded?
|
|
*
|
|
****************************************************************
|
|
*
|
|
ExpressLoad private
|
|
using OutCommon
|
|
using Common
|
|
;
|
|
; Sort the segments by number
|
|
;
|
|
lda #1 set the initial segment number
|
|
sta expressSegment
|
|
stz r0 nothing in the output list
|
|
stz r2
|
|
sn1 move4 loadList,r8 for each segment number
|
|
sn2 lda r8 for each segment
|
|
ora r10
|
|
beq sn4
|
|
ldy #loadNumber-loadNext if this is the right segment then
|
|
lda [r8],Y
|
|
cmp expressSegment
|
|
bne sn3
|
|
jsr MoveSegment move the segment to the new list
|
|
bra sn4
|
|
sn3 ldy #2 next segment
|
|
lda [r8],Y
|
|
tax
|
|
lda [r8]
|
|
sta r8
|
|
stx r10
|
|
bra sn2
|
|
sn4 inc expressSegment next segment number
|
|
lda loadList
|
|
ora loadList+2
|
|
bne sn1
|
|
move4 r0,loadList replace the list
|
|
;
|
|
; Build the expressload segment
|
|
;
|
|
pha get memory for the lConst record
|
|
pha
|
|
mul4 lastLoadNumber,#79,r0
|
|
add4 r0,#7
|
|
ph4 r0
|
|
ph2 userID
|
|
ph2 #$8000
|
|
ph4 #0
|
|
_NewHandle
|
|
bcc ex1
|
|
lda #5
|
|
jmp TermError
|
|
ex1 pl4 r0 recover the handle
|
|
ldy #2 recover the start pointer
|
|
lda [r0]
|
|
sta expStart
|
|
lda [r0],Y
|
|
sta expStart+2
|
|
add4 expStart,#6,expOffset set the initial offset pointer
|
|
mul4 lastLoadNumber,#8,r0 set the initial map pointer
|
|
add4 r0,expOffset,expMap
|
|
mul4 lastLoadNumber,#2,r0 set the initial header pointer
|
|
add4 r0,expMap,expHeader
|
|
lda #2 start with segment 2
|
|
sta expressSegment
|
|
mul4 lastLoadNumber,#79,fMark set the initial file mark
|
|
add4 fMark,#67+5+4+2+1
|
|
;
|
|
; Add all static segments to the expressload segment
|
|
;
|
|
stz r0 nothing in the output list
|
|
stz r2
|
|
st1 move4 loadList,r8 for each segment do
|
|
st2 lda r8
|
|
ora r10
|
|
beq dy1
|
|
ldy #loadType-loadNext if it is a static segment then
|
|
lda [r8],Y
|
|
bmi st3
|
|
jsr AddSegment add the segment to the express list
|
|
bra st1 loop
|
|
st3 ldy #2 next segment
|
|
lda [r8],Y
|
|
tax
|
|
lda [r8]
|
|
sta r8
|
|
stx r10
|
|
bra st2
|
|
;
|
|
; Add all remaining segments to the expressload segment
|
|
;
|
|
dy1 lda loadList for each segment do
|
|
ora loadList+2
|
|
beq dn1
|
|
move4 loadList,r8 add the segment to the express list
|
|
jsr AddSegment
|
|
bra dy1
|
|
;
|
|
; Adjust the dynamic segment number
|
|
;
|
|
dn1 anop
|
|
lda dynSegment get the old segment number
|
|
beq fe1 skip if there isn't one
|
|
dec A set its mapped segment
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
sta dynSegment set the new segment number
|
|
;
|
|
; Finish off the express record
|
|
;
|
|
fe1 move4 r0,loadList replace the load list pointer
|
|
lda #0 put and end mark after the record
|
|
short M
|
|
sta [expHeader]
|
|
long M
|
|
ldy #2 zero the reserved space for the link
|
|
sta [expStart]
|
|
sta [expStart],Y
|
|
ldy #4 set the number of segments
|
|
lda lastLoadNumber
|
|
dec A
|
|
sta [expStart],Y
|
|
;
|
|
; Write the expressload segment
|
|
;
|
|
! set the size of the segment
|
|
sub4 expHeader,expStart,length
|
|
add4 length,#headerEnd-header+1,byteCnt
|
|
move4 length,length2 set the length of the lCost record
|
|
|
|
lda keepRefnum write the header
|
|
sta wrRefnum
|
|
sta wsRefnum
|
|
OSWrite wrRec
|
|
bcs lb1
|
|
move4 expStart,wsBuff write the body
|
|
add4 length,#1,wsLen
|
|
OSWrite wsRec
|
|
bcs lb1
|
|
rts
|
|
|
|
lb1 lda #12
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
wsRec dc i'4' write the body
|
|
wsRefnum ds 2
|
|
wsBuff ds 4
|
|
wsLen ds 4
|
|
ds 4
|
|
|
|
wrRec dc i'4' write the segment header
|
|
wrRefnum ds 2
|
|
da 'header'
|
|
dc i4'headerEnd-header'
|
|
ds 4
|
|
|
|
header anop segment header model
|
|
byteCnt ds 4 length of the segment, in bytes
|
|
dc i4'0' reserved space at the end of the segment
|
|
length ds 4 length of the segment
|
|
dc i1'0' undefined
|
|
dc i1'0' label length
|
|
dc i1'4' number length
|
|
dc i1'2' OMF version
|
|
dc i4'$10000' bank size
|
|
dc i'$8001' segment kind
|
|
dc i'0' undefined
|
|
dc i4'0' origin
|
|
dc i4'0' alignment factor
|
|
dc i1'0' numSex; set to LSB first
|
|
dc i1'0' undefined
|
|
dc i'1' segment number
|
|
dc i4'0' entry point
|
|
dc i'ldName-header' disp to the segment name
|
|
dc i'data-header' disp to the segment image
|
|
ldName dc 10c' ' load segment name; unused in load segs
|
|
dc i1'12' length of the segment name
|
|
dc c'~ExpressLoad' segment name
|
|
data dc i1'$F2' lConst header
|
|
length2 ds 4
|
|
headerEnd anop
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* FindLoadSegment - find the proper load segment for a file
|
|
*
|
|
* Inputs:
|
|
* loadNamePtr - pointer to the load segment name
|
|
* segOrg - origin for this segment
|
|
* segAlign - alignment for this segment
|
|
* segType - type for this segment
|
|
* segBanksize - banksize for this segment
|
|
*
|
|
* Outputs:
|
|
* loadNumber - load segment number
|
|
*
|
|
* Additional outputs if pass = 2:
|
|
* op - pointer to the next output segment byte
|
|
* dp - pointer to the next dictionary segment byte
|
|
* dictSize - remaining bytes in the dictionary segment
|
|
* dictStart - pointer to the first byte in the dictionary
|
|
*
|
|
****************************************************************
|
|
*
|
|
FindLoadSegment start
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda loadNumber if there is an existing segment then
|
|
bmi lb3
|
|
move4 loadNamePtr,r0 if we need this segment then
|
|
ldy #nameSize-2
|
|
lb1 lda [r0],Y
|
|
cmp loadName,Y
|
|
bne lb2
|
|
dey
|
|
dey
|
|
bpl lb1
|
|
move4 pc,loadPC save the program counter
|
|
jsr Pass2Prep make sure we are "pass 2 ready"
|
|
jsr CheckHeader check header parameters
|
|
rts return
|
|
lb2 jsr SaveSegment save the current segment info
|
|
|
|
lb3 move4 loadList,r0 find the correct segment
|
|
move4 loadNamePtr,r8
|
|
lb4 lda r0
|
|
ora r2
|
|
beq lb6
|
|
add4 r0,#loadName-loadNext,r4
|
|
ldy #nameSize-2
|
|
lb5 lda [r4],Y
|
|
cmp [r8],Y
|
|
bne lb5a
|
|
dey
|
|
dey
|
|
bpl lb5
|
|
jsr GetSegment recover the segment
|
|
jsr CheckHeader check header parameters
|
|
rts
|
|
|
|
lb5a ldy #2 next segment
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
bra lb4
|
|
|
|
lb6 jsr NewSegment create a new segment
|
|
jsr CheckHeader
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* FinishLconst - finish the current lconst record
|
|
*
|
|
* Inputs:
|
|
* op - current ptr in buffer
|
|
* opst - op at the start of this record
|
|
*
|
|
* Outputs:
|
|
* opst - set to op
|
|
*
|
|
****************************************************************
|
|
*
|
|
FinishLConst start
|
|
|
|
sub4 op,opSt,r0
|
|
sub4 r0,#5
|
|
lda #$F2
|
|
sta [opSt]
|
|
ldy #1
|
|
lda r0
|
|
sta [opSt],Y
|
|
lda r2
|
|
iny
|
|
iny
|
|
sta [opSt],Y
|
|
move4 op,opSt
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* GetSegment - get a segment from storage
|
|
*
|
|
* Inputs:
|
|
* r0 - pointer to the segment to get
|
|
* pass - current pass number
|
|
*
|
|
* Outputs:
|
|
* loadNext... - filled in
|
|
* pc - set to last value
|
|
* op,opst,dp,dpSize - set as appropriate
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetSegment private
|
|
using Common
|
|
using OutCommon
|
|
|
|
ldy #loadSize-2 recover the segment
|
|
lb0 lda [r0],Y
|
|
sta loadNext,Y
|
|
dey
|
|
dey
|
|
bpl lb0
|
|
lda loadSeg if there is a segment buffer then
|
|
ora loadSeg+2
|
|
beq lb1
|
|
ph4 loadSeg lock the buffer
|
|
_HLock
|
|
move4 loadSeg,r0 dereference the segment
|
|
ldy #2
|
|
lda [r0]
|
|
sta loadSegStart
|
|
lda [r0],Y
|
|
sta loadSegStart+2
|
|
add4 loadOp,loadSegStart,op set the segment pointer
|
|
add4 loadOpSt,loadSegStart,opst set the lConst pointer
|
|
bra lb3 else if pass = 2 then
|
|
lb1 lda pass
|
|
cmp #2
|
|
bne lb3
|
|
move4 loadPC,pc save the program counter
|
|
jsr Pass2Prep prepare for pass2
|
|
lb3 anop endif
|
|
move4 loadPC,pc reset the program counter
|
|
lda loadDict if there is a dictionary then
|
|
ora loadDict+2
|
|
beq lb4
|
|
ph4 loadDict lock the buffer
|
|
_HLock
|
|
move4 loadDict,r0 dereference the segment
|
|
ldy #2
|
|
lda [r0]
|
|
sta loadDictStart
|
|
lda [r0],Y
|
|
sta loadDictStart+2
|
|
add4 loadDp,loadDictStart,dp set the segment pointer
|
|
|
|
lb4 lda loadLast break the back link
|
|
ora loadLast+2
|
|
beq lb5
|
|
move4 loadLast,r0
|
|
ldy #2
|
|
lda loadNext
|
|
sta [r0]
|
|
lda loadNext+2
|
|
sta [r0],Y
|
|
bra lb6
|
|
lb5 move4 loadNext,loadList
|
|
lb6 lda loadNext break the forward link
|
|
ora loadNext+2
|
|
beq lb7
|
|
move4 loadNext,r0
|
|
ldy #loadLast-loadNext
|
|
lda loadLast
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
lda loadLast+2
|
|
sta [r0],Y
|
|
lb7 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* HexVariable - convert an OS string to a value
|
|
*
|
|
* Inputs:
|
|
* r0 - pointer to the shell variable value
|
|
*
|
|
* Outputs:
|
|
* C - set if all characters are hex digits, else clear
|
|
* X-A - value (if C set); least sig. 32 bits only
|
|
*
|
|
****************************************************************
|
|
*
|
|
HexVariable private
|
|
|
|
lda [r0] get a loop counter
|
|
sta r12
|
|
stz r8 set the initial value
|
|
stz r10
|
|
add4 r0,#2,r4 get a character pointer
|
|
|
|
lda [r4] the first char must be '$'
|
|
and #$00FF
|
|
cmp #'$'
|
|
bne lb3
|
|
inc4 r4
|
|
dec r12
|
|
beq lb2a
|
|
lb1 lda [r4] if the character is not a digit then
|
|
and #$00FF return false
|
|
cmp #'0'
|
|
blt lb3
|
|
cmp #'9'+1
|
|
blt lb1a
|
|
and #$005F
|
|
cmp #'F'+1
|
|
bge lb3
|
|
cmp #'A'
|
|
blt lb3
|
|
lb1a pha r8 = r8*16 + value(r4^)
|
|
mul4 r8,#16
|
|
pla
|
|
and #$007F
|
|
cmp #'9'+1
|
|
blt lb1b
|
|
sbc #7
|
|
lb1b and #$000F
|
|
clc
|
|
adc r8
|
|
sta r8
|
|
bcc lb2
|
|
inc r10
|
|
lb2 inc4 r4 loop
|
|
dec r12
|
|
bne lb1
|
|
|
|
lb2a lda r8 return value
|
|
ldx r10
|
|
sec
|
|
rts
|
|
|
|
lb3 clc return false
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* InitOut - initialize the output buffer variables
|
|
*
|
|
****************************************************************
|
|
*
|
|
InitOut start
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda #-1 no load segment is active
|
|
sta loadNumber
|
|
stz lastLoadNumber no load segments created
|
|
stz loadList no load segments in the list
|
|
stz loadList+2
|
|
stz dynSegment no dynamic segment
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* IsDynamic - is the segment dynamic?
|
|
*
|
|
* Inputs:
|
|
* A - segment to check
|
|
*
|
|
* Outputs:
|
|
* C - set if the segment is dynamic, else clear
|
|
*
|
|
****************************************************************
|
|
*
|
|
IsDynamic start
|
|
using OutCommon
|
|
|
|
cmp loadNumber if A = current segment then
|
|
bne lb2
|
|
lda loadType return dynamic(loadType)
|
|
lb0 bpl lb1
|
|
sec
|
|
rts
|
|
lb1 clc
|
|
rts
|
|
|
|
lb2 sta r4 save the segment number
|
|
move4 loadList,r0 for each segment in the list do
|
|
lb3 lda r0
|
|
ora r2
|
|
beq lb1
|
|
ldy #loadNumber-loadNext if this is the correct segment then
|
|
lda [r0],Y
|
|
cmp r4
|
|
bne lb4
|
|
ldy #loadType-loadNext return dynamic(r0^.loadType)
|
|
lda [r0],Y
|
|
bra lb0
|
|
lb4 ldy #2 next segment
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
bra lb3
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* JumpTable - create/reuse a jump table entry
|
|
*
|
|
* Inputs:
|
|
* expValue - disp into the dynamic segment
|
|
* expSegment - dynamic segment number
|
|
* shiftFlag - shift flag for the expression
|
|
*
|
|
* Outputs:
|
|
* expValue - disp into the segment buffer
|
|
* expSegment - dynamic segment number
|
|
*
|
|
****************************************************************
|
|
*
|
|
JumpTable start
|
|
using OutCommon
|
|
using ExpCommon
|
|
userID equ 0 disp to the user ID field
|
|
file equ 2 disp to the file number
|
|
seg equ 4 disp to the segment number
|
|
offset equ 6 disp to the offset (expr value)
|
|
jsl equ 10 disp to the jsl to the loader
|
|
|
|
length equ 14 length of a record
|
|
|
|
header equ 8+5 bytes in the buffer header
|
|
|
|
add4 dynStart,#header,r0 check for an existing entry
|
|
lb1 cmpl r0,dy
|
|
bge lb3
|
|
ldy #seg
|
|
lda [r0],Y
|
|
cmp expSegment
|
|
bne lb2
|
|
ldy #offset
|
|
lda [r0],Y
|
|
cmp expValue
|
|
bne lb2
|
|
iny
|
|
iny
|
|
lda [r0],Y
|
|
cmp expValue+2
|
|
beq lb5
|
|
lb2 add4 r0,#length
|
|
bra lb1
|
|
|
|
lb3 lda dynSize no existing entry; create a new one
|
|
cmp #length
|
|
bge lb4
|
|
jsr ExpandDynamicBuffer
|
|
lb4 move4 dy,r0
|
|
add4 dy,#length
|
|
lda #0
|
|
sta [r0]
|
|
ldy #file
|
|
lda #1
|
|
sta [r0],Y
|
|
ldy #seg
|
|
lda expSegment
|
|
sta [r0],Y
|
|
ldy #offset
|
|
lda expValue
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
lda expValue+2
|
|
sta [r0],Y
|
|
ldy #jsl
|
|
lda #$0022
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
lda #0
|
|
sta [r0],Y
|
|
|
|
lb5 sub4 r0,dynStart,expValue set the new expValue
|
|
add4 expValue,#jsl-5
|
|
lda dynSegment set the new segment value
|
|
sta expSegment
|
|
lda shiftFlag check for an illegal shift
|
|
beq lb6
|
|
ph4 #0
|
|
ph2 #20
|
|
jsr Error
|
|
lb6 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* KeepFile - write the segments to the file
|
|
*
|
|
* Inputs:
|
|
* loadList - head of the load list
|
|
* kname - pointer to the output name
|
|
*
|
|
****************************************************************
|
|
*
|
|
KeepFile start
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda #1 set the segment number
|
|
sta segment
|
|
jsr CreateFile create/check the file
|
|
move4 kname,opPathname open the file
|
|
OSOpen opRec
|
|
bcc lb0
|
|
err12 lda #12
|
|
jmp TermError
|
|
|
|
lb0 lda opRefnum save the keep refnum
|
|
sta keepRefnum
|
|
sta clRefnum
|
|
sta mkRefnum
|
|
OSSet_EOF mkRec erase the old file contents
|
|
bcs err12
|
|
lda compact if compact then
|
|
beq lb0a
|
|
jsr DoCompact compact the dictionaries
|
|
lb0a jsr SaveSegment save the current segment
|
|
jsr CreateDynamicSegment create the dynamic segment
|
|
lda express if express then
|
|
beq lb1
|
|
jsr ExpressLoad write the expressload segment (if any)
|
|
inc segment first segment to process is 2
|
|
|
|
lb1 move4 loadList,r0 find the proper segment
|
|
lb2 ldy #loadNumber-loadNext
|
|
lda [r0],Y
|
|
cmp segment
|
|
beq lb3
|
|
ldy #2
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
ora r2
|
|
bne lb2
|
|
OSClose clRec none left -- close the file
|
|
move4 loadList,r0 get a segment back
|
|
jsr GetSegment
|
|
jsr SetFileType
|
|
rts
|
|
|
|
lb3 jsr GetSegment get and lock the segment
|
|
jsr AddEnd add an end record to the dictionary
|
|
jsr FinishLConst finish the current lconst record
|
|
lda express if express then
|
|
beq lb4
|
|
jsr Remap remap the segment numbers
|
|
bra lb5 else
|
|
lb4 jsr OptimizeDS optimize the DS, LConst records
|
|
lb5 jsr WriteHeader write the header
|
|
jsr WriteBody write the segment image
|
|
jsr WriteDictionary write the dictionary
|
|
jsr SaveSegment save the segment
|
|
inc segment next segment
|
|
bra lb1
|
|
;
|
|
; Local data
|
|
;
|
|
clRec dc i'1' close record
|
|
clRefnum ds 2
|
|
|
|
opRec dc i'2' open record
|
|
opRefnum ds 2
|
|
opPathname ds 4
|
|
|
|
mkRec dc i'3' set mark record
|
|
mkRefnum ds 2
|
|
dc i'0'
|
|
dc i4'0'
|
|
|
|
segment ds 2 segment number
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* MoveSegment - move a segment record
|
|
*
|
|
* Inputs:
|
|
* r0 - pointer to the head of the new list
|
|
* r4 - pointer to the last record in the new list (if r0 <> nil)
|
|
* r8 - pointer to the record to move
|
|
* loadList - pointer to the first record in the old list
|
|
*
|
|
* Outputs:
|
|
* input pointers are modified
|
|
*
|
|
****************************************************************
|
|
*
|
|
MoveSegment private
|
|
using OutCommon
|
|
;
|
|
; Break the back link
|
|
;
|
|
ldy #loadLast-loadNext if r8^.last = nil then
|
|
lda [r8],Y
|
|
iny
|
|
iny
|
|
ora [r8],Y
|
|
bne lb1
|
|
ldy #2 loadList := r8^.next
|
|
lda [r8]
|
|
sta loadList
|
|
lda [r8],Y
|
|
sta loadList+2
|
|
bra lb2 else
|
|
lb1 ldy #loadLast-loadNext r12 := r8^.last
|
|
lda [r8],Y
|
|
sta r12
|
|
iny
|
|
iny
|
|
lda [r8],Y
|
|
sta r14
|
|
ldy #2 r12^.next := r8^.next
|
|
lda [r8]
|
|
sta [r12]
|
|
lda [r8],Y
|
|
sta [r12],Y
|
|
lb2 anop endif
|
|
;
|
|
; Break the forward link
|
|
;
|
|
ldy #2 if r8^.next <> nil then
|
|
lda [r8]
|
|
ora [r8],Y
|
|
beq lb3
|
|
lda [r8] r12 := r8^.next
|
|
sta r12
|
|
lda [r8],Y
|
|
sta r14
|
|
ldy #loadLast-loadNext r12^.last := r8^.last
|
|
lda [r8],Y
|
|
sta [r12],Y
|
|
iny
|
|
iny
|
|
lda [r8],Y
|
|
sta [r12],Y
|
|
lb3 anop endif
|
|
;
|
|
; Add the record to the new list
|
|
;
|
|
ldy #2 r8^.next := nil
|
|
lda #0
|
|
sta [r8]
|
|
sta [r8],Y
|
|
lda r0 if r0 = nil then
|
|
ora r2
|
|
bne lb4
|
|
ldy #loadLast-loadNext r8^.last := nil
|
|
lda #0
|
|
sta [r8],Y
|
|
iny
|
|
iny
|
|
sta [r8],Y
|
|
move4 r8,r0 r0 := r8
|
|
bra lb5 else
|
|
lb4 ldy #2 r4^.next := r8
|
|
lda r8
|
|
sta [r4]
|
|
lda r10
|
|
sta [r4],Y
|
|
ldy #loadLast-loadNext r8^.last := r4
|
|
lda r4
|
|
sta [r8],Y
|
|
iny
|
|
iny
|
|
lda r6
|
|
sta [r8],Y
|
|
lb5 anop endif
|
|
move4 r8,r4 r4 := r8
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* NamedVariable - see if the variable is a file type
|
|
*
|
|
* Inputs:
|
|
* r0 - pointer to the shell variable value
|
|
*
|
|
* Outputs:
|
|
* C - set if we have a match, else clear
|
|
* X-A - variable value (if C is set)
|
|
*
|
|
****************************************************************
|
|
*
|
|
NamedVariable private
|
|
|
|
lda [r0] if length <> 3 then
|
|
cmp #3
|
|
bne lb3 return false
|
|
lda #nameEnd-name-3 index into the name array
|
|
sta r4
|
|
lda #$BD initial file number
|
|
sta r6
|
|
lb1 ldx r4 check for match
|
|
ldy #2
|
|
short M
|
|
lb1a lda [r0],Y
|
|
cmp name,X
|
|
beq lb1b
|
|
and #$5F
|
|
cmp name,X
|
|
bne lb2
|
|
lb1b inx
|
|
iny
|
|
cpy #5
|
|
bne lb1a
|
|
long M
|
|
lda r6 return the file type
|
|
ldx #0
|
|
sec
|
|
rts
|
|
|
|
lb2 long M no match - loop
|
|
dec r6
|
|
sec
|
|
lda r4
|
|
sbc #3
|
|
sta r4
|
|
bpl lb1
|
|
|
|
lb3 clc return false
|
|
rts
|
|
;
|
|
; Local data
|
|
;
|
|
name dc c'S16' file type mnemonics
|
|
dc c'RTL'
|
|
dc c'EXE'
|
|
dc c'PIF'
|
|
dc c'TIF'
|
|
dc c'NDA'
|
|
dc c'CDA'
|
|
dc c'TOL'
|
|
dc c'DVR'
|
|
dc c'LDF'
|
|
dc c'FST'
|
|
nameEnd anop
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* NewSegment - create a new segment record
|
|
*
|
|
* Inputs:
|
|
* loadNamePtr - pointer to the load name
|
|
* lastLoadNumber - load number for the last segment created
|
|
*
|
|
* Outputs:
|
|
* loadNumber - number of this load segment
|
|
* loadName - name of the load segment
|
|
* pc - 0
|
|
* * - all other load record variables are set to 0
|
|
*
|
|
****************************************************************
|
|
*
|
|
NewSegment private
|
|
using Common
|
|
using OutCommon
|
|
|
|
move #0,loadNext,#loadSize
|
|
move4 loadNamePtr,r0
|
|
ldy #nameSize-2
|
|
lb1 lda [r0],Y
|
|
sta loadName,Y
|
|
dey
|
|
dey
|
|
bpl lb1
|
|
inc lastLoadNumber
|
|
lda lastLoadNumber
|
|
sta loadNumber
|
|
stz pc
|
|
stz pc+2
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* OptimizeDS - optimize DS and LConst records
|
|
*
|
|
* This subroutine removes LConst records that have a length
|
|
* of zero, and combines adjacent DS records.
|
|
*
|
|
* Inputs:
|
|
* op - ptr to the end of the load segment body
|
|
* opst - copy of op
|
|
* loadSegStart - start of the load segment body
|
|
*
|
|
* Outputs:
|
|
* op - ptr to the end of the load segment body
|
|
* opst - copy of op
|
|
*
|
|
****************************************************************
|
|
*
|
|
OptimizeDS private
|
|
using Common
|
|
using OutCommon
|
|
LConst equ $F2 long contanst op-code
|
|
DS equ $F0 DS op-code
|
|
|
|
lda loadSegStart r0 = to address
|
|
ldx loadSegStart+2 r4 = from address
|
|
sta r0
|
|
stx r2
|
|
sta r4
|
|
stx r6
|
|
stz r8 r8 = false {r0, r4 are the same}
|
|
lb2 cmpl r4,op while r4 <> op do
|
|
jge lb12
|
|
lda [r4] if r4^ = LConst then
|
|
and #$00FF
|
|
cmp #LConst
|
|
bne lb3
|
|
ldy #1 if length = 0 then
|
|
lda [r4],Y
|
|
ldy #3
|
|
ora [r4],Y
|
|
bne lb4
|
|
add4 r4,#5 skip the record
|
|
lda #1 r8 := true
|
|
sta r8
|
|
bra lb2
|
|
lb3 add4 r4,#5,r10 else {if r4^ = DS then}
|
|
lb3a cmpl r10,op if (r10 = r4+5) < op then
|
|
bge lb4
|
|
lda [r10] if r10^ = LConst then
|
|
and #$00FF
|
|
cmp #LConst
|
|
bne lb3b
|
|
ldy #1 if r10^.length = 0 then
|
|
lda [r10],Y
|
|
ldy #3
|
|
ora [r10],Y
|
|
bne lb4
|
|
add4 r10,#5 skip the lconst
|
|
lda #1 r8 := true
|
|
sta r8
|
|
bra lb3a try again
|
|
lb3b ldy #1 else if r10^ = DS then
|
|
clc r10^.length += r4^.length
|
|
lda [r10],Y
|
|
adc [r4],Y
|
|
sta [r10],Y
|
|
ldy #3
|
|
lda [r10],Y
|
|
adc [r4],Y
|
|
sta [r10],Y
|
|
move4 r10,r4 r4 := r10
|
|
lda #1 r8 := true
|
|
sta r8
|
|
bra lb3 try again
|
|
lb4 lda r8 {move the record to the new spot}
|
|
beq lb10 if the record needs to be moved then
|
|
lda [r4] if r4^ = LConst then
|
|
and #$00FF
|
|
cmp #Lconst
|
|
bne lb9
|
|
ldy #1
|
|
lda [r4],Y
|
|
sta r10
|
|
ldy #3
|
|
lda [r4],Y
|
|
sta r12
|
|
add4 r10,#5
|
|
ldx r12
|
|
beq lb6
|
|
ldy #0
|
|
lb5 lda [r4],Y
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
bne lb5
|
|
inc r2
|
|
inc r6
|
|
dex
|
|
bne lb5
|
|
lb6 lda r10
|
|
beq lb10
|
|
ldy #0
|
|
lsr A
|
|
tax
|
|
bcc lb7
|
|
short M
|
|
lda [r4]
|
|
sta [r0]
|
|
long M
|
|
iny
|
|
lb7 txa
|
|
beq lb10
|
|
lb8 lda [r4],Y
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
dex
|
|
bne lb8
|
|
bra lb10 else {if r4^ = DS then}
|
|
lb9 lda [r4]
|
|
sta [r0]
|
|
ldy #2
|
|
lda [r4],Y
|
|
sta [r0],Y
|
|
iny
|
|
lda [r4],Y
|
|
sta [r0],Y
|
|
lb10 lda [r0] {next record}
|
|
and #$00FF
|
|
cmp #LConst
|
|
bne lb11
|
|
clc
|
|
ldy #1
|
|
lda [r0],Y
|
|
adc r4
|
|
tax
|
|
ldy #3
|
|
lda [r0],Y
|
|
adc r6
|
|
sta r6
|
|
stx r4
|
|
clc
|
|
ldy #1
|
|
lda [r0],Y
|
|
adc r0
|
|
tax
|
|
ldy #3
|
|
lda [r0],Y
|
|
adc r2
|
|
sta r2
|
|
stx r0
|
|
lb11 add4 r0,#5
|
|
add4 r4,#5
|
|
brl lb2 endwhile
|
|
|
|
lb12 lda r0 op = opst = r0
|
|
ldx r2
|
|
sta op
|
|
stx op+2
|
|
sta opst
|
|
stx opst+2
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Pass2Prep - prepare a buffer for the first call to pass2
|
|
*
|
|
* Inputs:
|
|
* loadPass2 - has the buffer been prepared for pass 2?
|
|
*
|
|
****************************************************************
|
|
*
|
|
Pass2Prep private
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda pass if this is not pass 2
|
|
cmp #2
|
|
bne lb1
|
|
lda loadPass2 or the buffer has already been prepared
|
|
beq lb2
|
|
lb1 rts return
|
|
|
|
lb2 add4 length,loadPC update the length of the program
|
|
lda loadBanksize check for a bank overflow
|
|
ora loadBanksize+2
|
|
beq lb2a
|
|
cmpl loadPC,loadBanksize
|
|
blt lb2a
|
|
ph4 #0
|
|
ph2 #18
|
|
jsr Error
|
|
lb2a pha get memory for the output buffer
|
|
pha
|
|
clc
|
|
lda loadPC
|
|
adc #5
|
|
tax
|
|
lda loadPC+2
|
|
adc #0
|
|
pha
|
|
phx
|
|
ph2 userID
|
|
ph2 #$8000
|
|
ph4 #0
|
|
_NewHandle
|
|
bcc lb3
|
|
lda #5
|
|
jmp TermError
|
|
lb3 pl4 loadSeg
|
|
move4 loadSeg,r0 dereference the segment
|
|
ldy #2
|
|
lda [r0]
|
|
sta loadSegStart
|
|
sta op
|
|
sta opst
|
|
lda [r0],Y
|
|
sta loadSegStart+2
|
|
sta op+2
|
|
sta opst+2
|
|
add4 op,#5 skip the space for the lConst header
|
|
stz loadPC loadPC = 0
|
|
stz loadPC+2
|
|
stz loadOrg loadOrg = 0
|
|
stz loadOrg+2
|
|
stz loadAlign loadAlign = 0
|
|
stz loadAlign+2
|
|
stz pc pc = 0
|
|
stz pc+2
|
|
inc loadPass2 loadPass2 = true
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* PrintSegmentInfo - print the segment statistics
|
|
*
|
|
* Inputs:
|
|
* loadList - head of the load list
|
|
*
|
|
****************************************************************
|
|
*
|
|
PrintSegmentInfo start
|
|
using Common
|
|
using OutCommon
|
|
|
|
puts #'Segment Information:',cr=t write segment header
|
|
putcr
|
|
puts #' Number Name Type Length Org',cr=t
|
|
putcr
|
|
jsr SaveSegment save the current segment
|
|
lda #1 set the segment number
|
|
sta segment
|
|
lda kflag
|
|
beq lb1
|
|
lda express
|
|
beq lb1
|
|
inc segment
|
|
|
|
lb1 move4 loadList,r0 find the proper segment
|
|
lb2 ldy #loadNumber-loadNext
|
|
lda [r0],Y
|
|
cmp segment
|
|
beq lb3
|
|
ldy #2
|
|
lda [r0],Y
|
|
tax
|
|
lda [r0]
|
|
sta r0
|
|
stx r2
|
|
ora r2
|
|
bne lb2
|
|
|
|
move4 loadList,r0 done - get a segment back
|
|
jsr GetSegment
|
|
rts
|
|
|
|
lb3 put2 segment,#6 print the segment number
|
|
putc #' ',#6
|
|
inc segment
|
|
ldy #loadName-loadNext print the segment name
|
|
short I,M
|
|
ldx #0
|
|
lb3a lda [r0],Y
|
|
beq lb3b
|
|
sta name+1,X
|
|
iny
|
|
inx
|
|
cpx #10
|
|
bne lb3a
|
|
lb3b stx name
|
|
sec
|
|
lda #13
|
|
sbc name
|
|
sta fw
|
|
long I,M
|
|
puts name-1
|
|
putc #'$',fw print the type
|
|
pea 0
|
|
ldy #loadType-loadNext
|
|
lda [r0],Y
|
|
pha
|
|
ph2 #2
|
|
ph2 #0
|
|
jsr PrintHex
|
|
puts #' $' print the length
|
|
ldy #loadPC-loadNext+2
|
|
lda [r0],Y
|
|
pha
|
|
dey
|
|
dey
|
|
lda [r0],Y
|
|
pha
|
|
ph2 #8
|
|
ph2 #0
|
|
jsr PrintHex
|
|
puts #' '
|
|
ldy #loadORG-loadNext+2 print the org
|
|
lda [r0],Y
|
|
sta r6
|
|
dey
|
|
dey
|
|
lda [r0],Y
|
|
sta r4
|
|
ora r6
|
|
beq lb4
|
|
putc #'$'
|
|
ph4 r4
|
|
ph2 #8
|
|
ph2 #0
|
|
jsr PrintHex
|
|
putcr
|
|
brl lb1
|
|
lb4 puts #'Relocatable',cr=t
|
|
brl lb1
|
|
|
|
segment ds 2 segment number
|
|
name dc i1'10',10c' ' segment name
|
|
fw dc i'0' field width for spaces after name
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Remap - remap the segment numbers in interseg references
|
|
*
|
|
* Inputs:
|
|
* loadDictStart - start of the dictionary
|
|
*
|
|
* Notes:
|
|
* This remapping is needed when express loading a segment
|
|
* changes the segment numbers.
|
|
*
|
|
****************************************************************
|
|
*
|
|
Remap private
|
|
using OutCommon
|
|
|
|
move4 loadDictStart,r0
|
|
|
|
lb1 lda [r0] get an op code
|
|
and #$00FF
|
|
jeq lb5 quit if it is the end
|
|
|
|
cmp #$E2 skip reloc
|
|
bne lb2
|
|
add4 r0,#11
|
|
bra lb1
|
|
|
|
lb2 cmp #$E3 remap interseg
|
|
bne lb3
|
|
ldy #9
|
|
lda [r0],Y
|
|
dec A
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
ldy #9
|
|
sta [r0],Y
|
|
add4 r0,#15
|
|
bra lb1
|
|
|
|
lb3 cmp #$F5 skip cReloc
|
|
bne lb4
|
|
add4 r0,#7
|
|
bra lb1
|
|
|
|
lb4 cmp #$F7 remap Super
|
|
jne lb4a
|
|
ldy #5 if r0^.type = 2 {interseg1} then
|
|
lda [r0],Y
|
|
and #$00FF
|
|
cmp #2
|
|
jne sp7
|
|
add4 r0,#6,r4 r4 = disp to 1st subrecord
|
|
sec r8 = page offset
|
|
lda loadSegStart
|
|
sbc #$0100-7
|
|
sta r8
|
|
lda loadSegStart+2
|
|
sbc #0
|
|
sta r10
|
|
ldy #1 r12 = # bytes to process
|
|
lda [r0],Y
|
|
dec A
|
|
sta r12
|
|
sp1 lda [r4] repeat
|
|
and #$00FF if r4^ & $80 <> 0 then
|
|
bit #$0080
|
|
beq sp4
|
|
and #$007F add in the page displacement
|
|
bne sp2
|
|
lda #$0080
|
|
sp2 xba
|
|
clc
|
|
adc r8
|
|
sta r8
|
|
bcc sp3
|
|
inc r10
|
|
sp3 inc4 r4 ++r4
|
|
dec r12 --r12
|
|
bra sp6 next entry
|
|
sp4 sta r14 else r14 = #bytes + 1
|
|
inc4 r4 skip the count byte
|
|
dec r12
|
|
lda r8 new page
|
|
clc
|
|
adc #$100
|
|
sta r8
|
|
bcc sp5
|
|
inc r10
|
|
sp5 short I,M repeat
|
|
lda [r4] remap one segment
|
|
tay
|
|
tax
|
|
lda [r8],Y
|
|
dec A
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
txy
|
|
sta [r8],Y
|
|
long I,M
|
|
inc4 r4 ++r4
|
|
dec r12 --r12
|
|
dec r14 --r14
|
|
bpl sp5 until r14 < 0
|
|
sp6 lda r12 until r12 = 0
|
|
bne sp1
|
|
bra sp9
|
|
sp7 cmp #14 else if r0^.type in [14..25] then
|
|
blt sp9
|
|
cmp #26
|
|
bge sp8
|
|
short I,M remap the segment number
|
|
sec
|
|
sbc #14
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
clc
|
|
adc #13
|
|
ldy #5
|
|
sta [r0],Y
|
|
long I,M
|
|
bra sp9 else if r0^.type in [26..37] then
|
|
sp8 short I,M remap the segment number
|
|
sec
|
|
sbc #26
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
clc
|
|
adc #25
|
|
ldy #5
|
|
sta [r0],Y
|
|
long I,M
|
|
sp9 anop endif
|
|
ldy #1 skip the record
|
|
clc
|
|
lda [r0],Y
|
|
adc r0
|
|
tax
|
|
iny
|
|
iny
|
|
lda [r0],Y
|
|
adc r2
|
|
sta r2
|
|
stx r0
|
|
add4 r0,#5
|
|
brl lb1
|
|
|
|
lb4a short I,M remap cInterseg
|
|
ldy #5
|
|
lda [r0],Y
|
|
dec A
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
ldy #5
|
|
sta [r0],Y
|
|
long I,M
|
|
add4 r0,#8
|
|
brl lb1
|
|
|
|
lb5 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* RemapJumpTable - remap the segment numbers in the jump table
|
|
*
|
|
* Inputs:
|
|
* loadSegStart - start of the jump table buffer
|
|
*
|
|
* Notes:
|
|
* This remapping is needed when express loading a segment
|
|
* changes the segment numbers.
|
|
*
|
|
****************************************************************
|
|
*
|
|
RemapJumpTable private
|
|
using OutCommon
|
|
|
|
add4 loadSegStart,#8+5,r0
|
|
|
|
lb1 ldy #2 quit if file = 0
|
|
lda [r0],Y
|
|
beq lb2
|
|
|
|
ldy #4 remap a segment
|
|
lda [r0],Y
|
|
dec A
|
|
asl A
|
|
tay
|
|
lda [expMap],Y
|
|
ldy #4
|
|
sta [r0],Y
|
|
add4 r0,#14
|
|
bra lb1
|
|
|
|
lb2 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* SaveSegment - save the current load segment record
|
|
*
|
|
****************************************************************
|
|
*
|
|
SaveSegment private
|
|
using OutCommon
|
|
|
|
move4 loadList,loadNext insert the record in the linked list
|
|
stz loadLast
|
|
stz loadLast+2
|
|
move4 pc,loadPC save the current pc
|
|
lda loadSeg if there is a segment buffer then
|
|
ora loadSeg+2
|
|
beq lb1
|
|
sub4 op,loadSegStart,loadOp save the op displacement
|
|
sub4 opst,loadSegStart,loadOpSt save the opst displacement
|
|
ph4 loadSeg unlock the segment buffer
|
|
_HUnlock
|
|
lb1 lda loadDict if there is a dictionary buffer then
|
|
ora loadDict+2
|
|
beq lb2
|
|
sub4 dp,loadDictStart,loadDP save the dp displacement
|
|
ph4 loadDict unlock the dictionary buffer
|
|
_HUnlock
|
|
lb2 lda loadPtr if there is no spot reserved then
|
|
ora loadPtr+2
|
|
bne lb3
|
|
ph2 #loadSize get some space
|
|
jsr GetSymbolMemory
|
|
sta loadPtr
|
|
stx loadPtr+2
|
|
lb3 move4 loadPtr,r0 save the record
|
|
ldy #loadSize-2
|
|
lb4 lda loadNext,Y
|
|
sta [r0],Y
|
|
dey
|
|
dey
|
|
bpl lb4
|
|
lda loadList if loadList <> nil then
|
|
ora loadList+2
|
|
beq lb5
|
|
move4 loadList,r0 loadList^.loadLast = loadPtr
|
|
ldy #loadLast-loadNext
|
|
lda loadPtr
|
|
sta [r0],Y
|
|
iny
|
|
iny
|
|
lda loadPtr+2
|
|
sta [r0],Y
|
|
lb5 move4 loadPtr,loadList point the head to this segment
|
|
rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* SetFileType - set the file type and aux type
|
|
*
|
|
* Inputs:
|
|
* kname - keep name pointer
|
|
*
|
|
****************************************************************
|
|
*
|
|
SetFileType private
|
|
;
|
|
; Get the current file info
|
|
;
|
|
move4 kname,giPathName
|
|
OSGet_File_Info giRec
|
|
;
|
|
; Set the file type
|
|
;
|
|
ph4 #FileType read the file type variable
|
|
jsr ReadVariable
|
|
sta r0
|
|
stx r2
|
|
lda [r0] if the variable exists then
|
|
beq lb2
|
|
jsr NamedVariable handle a named variable
|
|
bcs lb1
|
|
jsr DecimalVariable handle a decimal variable
|
|
bcs lb1
|
|
jsr HexVariable handle a hex variable
|
|
bcs lb1
|
|
err13 ph4 #0 flag a bad file name error
|
|
ph2 #13
|
|
jsr Error
|
|
bra lb2
|
|
lb1 txy check for a file type out of range
|
|
bne err13
|
|
cmp #$B3
|
|
blt err13
|
|
cmp #$BF+1
|
|
bge err13
|
|
sta giFileType set the file type
|
|
bra lb3 else
|
|
lb2 lda #EXE use the default file type
|
|
sta giFileType
|
|
lb3 anop endif
|
|
ph4 r0 Free(r0)
|
|
jsr Free
|
|
;
|
|
; Set the aux type
|
|
;
|
|
ph4 #AuxType read the file type variable
|
|
jsr ReadVariable
|
|
sta r0
|
|
stx r2
|
|
lda [r0] if the variable exists then
|
|
beq ax2
|
|
jsr DecimalVariable handle a decimal variable
|
|
bcs ax1
|
|
jsr HexVariable handle a hex variable
|
|
bcs ax1
|
|
ph4 #0 flag a bad file name error
|
|
ph2 #19
|
|
jsr Error
|
|
bra ax2
|
|
ax1 stx giAuxType+2 save the aux type
|
|
sta giAuxType
|
|
bra ax3 else
|
|
ax2 lla giAuxType,$100 use the default aux type
|
|
ax3 anop endif
|
|
ph4 r0 Free(r0)
|
|
jsr Free
|
|
;
|
|
; Update the file info
|
|
;
|
|
OSSet_File_Info giRec
|
|
bcs fi1
|
|
rts
|
|
|
|
fi1 lda #12
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
giRec dc i'4' get/set file info record
|
|
giPathname ds 4
|
|
ds 2
|
|
giFileType ds 2
|
|
giAuxType ds 4
|
|
|
|
FileType dos KeepType filetype shell variable name
|
|
AuxType dos AuxType auxtype shell variable name
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* WriteBody - write the body of a load segment
|
|
*
|
|
* Inputs:
|
|
* loadNext... - load segment record
|
|
* keepRefnum - keep file reference number
|
|
*
|
|
****************************************************************
|
|
*
|
|
WriteBody private
|
|
using Common
|
|
using OutCommon
|
|
|
|
lda express if express then
|
|
beq lb0
|
|
lda loadNumber if loadNumber = dynSegment then
|
|
cmp dynSegment
|
|
bne lb0
|
|
jsr RemapJumpTable remap the dynamic jump table
|
|
lb0 move4 loadSegStart,wrBuff set the buffer address
|
|
sub4 op,loadSegStart,wrLength set the length
|
|
lda keepRefnum set the refnum
|
|
sta wrRefnum
|
|
OSWrite wrRec write the segment
|
|
bcs lb1
|
|
rts
|
|
|
|
lb1 lda #12
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
wrRec dc i'4' write the segment
|
|
wrRefnum ds 2
|
|
wrBuff ds 4
|
|
wrLength ds 4
|
|
ds 4
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* WriteDictionary - write the dictionary for a load segment
|
|
*
|
|
* Inputs:
|
|
* loadNext... - load segment record
|
|
* keepRefnum - keep file reference number
|
|
*
|
|
****************************************************************
|
|
*
|
|
WriteDictionary private
|
|
using Common
|
|
using OutCommon
|
|
|
|
sub4 dp,loadDictStart,wrLength set the length
|
|
move4 loadDictStart,wrBuff set the buffer address
|
|
lda keepRefnum set the refnum
|
|
sta wrRefnum
|
|
OSWrite wrRec write the segment
|
|
bcs lb1
|
|
rts
|
|
|
|
lb1 lda #12
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
wrRec dc i'4' write the segment
|
|
wrRefnum ds 2
|
|
wrBuff ds 4
|
|
wrLength ds 4
|
|
ds 4
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* WriteHeader - write the segment header for a load segment
|
|
*
|
|
* Inputs:
|
|
* loadNext... - load segment record
|
|
* keepRefnum - keep file reference number
|
|
*
|
|
* Notes:
|
|
* This subroutine also writes the lConst opcode and
|
|
* length field for the code image that will be written
|
|
* by WriteBody.
|
|
*
|
|
****************************************************************
|
|
*
|
|
WriteHeader private
|
|
using OutCommon
|
|
|
|
! set the size of the segment
|
|
sub4 opst,loadSegStart,byteCnt
|
|
add4 byteCnt,#headerEnd-header
|
|
sub4 dp,loadDictStart,r0
|
|
add4 byteCnt,r0
|
|
move4 loadPC,length set the length of the segment
|
|
move4 loadBankSize,bankSize set the bankSize of the segment
|
|
lda loadType set the kind of the segment
|
|
sta kind
|
|
move4 loadORG,org set the org of the segment
|
|
move4 loadAlign,align set the alignment factor of the segment
|
|
lda loadNumber set the segment number
|
|
sta segNum
|
|
move loadName,segName,#nameSize set the segment name
|
|
|
|
lda keepRefnum write the header
|
|
sta wrRefnum
|
|
OSWrite wrRec
|
|
bcs lb1
|
|
rts
|
|
|
|
lb1 lda #12
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
wrRec dc i'4' write the segment
|
|
wrRefnum ds 2
|
|
da 'header'
|
|
dc i4'headerEnd-header'
|
|
ds 4
|
|
|
|
header anop segment header model
|
|
byteCnt ds 4 length of the segment, in bytes
|
|
dc i4'0' reserved space at the end of the segment
|
|
length ds 4 length of the segment
|
|
dc i1'0' undefined
|
|
dc i1'0' label length
|
|
dc i1'4' number length
|
|
dc i1'2' OMF version
|
|
bankSize ds 4 bank size
|
|
kind ds 2 segment kind
|
|
dc i'0' undefined
|
|
org ds 4 origin
|
|
align ds 4 alignment factor
|
|
dc i1'0' numSex; set to LSB first
|
|
dc i1'0' undefined
|
|
segnum ds 2 segment number
|
|
ds 4 entry point
|
|
dc i'ldName-header' disp to the segment name
|
|
dc i'headerEnd-header' disp to the segment image
|
|
dc i4'0' temp ORG
|
|
ldName dc 10c' ' load segment name; unused in load segs
|
|
dc i1'10' length of the segment name
|
|
segName ds 10 segment name
|
|
headerEnd anop
|
|
end
|
|
|