3151 lines
59 KiB
NASM
3151 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 #$1DFF
|
|
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
|
|
beq 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
|
|
|