730 lines
15 KiB
NASM
730 lines
15 KiB
NASM
mcopy linker.mac
|
|
keep obj/linker
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0
|
|
*
|
|
* Link editor for ORCA/M.
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.1.0 prepared Jun 23 by Stephen Heumann
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0.6 prepared Aug 21 by Stephen Heumann
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0.5 prepared Sep 18 by Stephen Heumann
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0.4 prepared Oct 17 by Stephen Heumann
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0.3 prepared Mar 96 by Mike Westerfield
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Linker 2.0.2 prepared Jul 94 by Mike Westerfield
|
|
*
|
|
****************************************************************
|
|
*
|
|
Linker start
|
|
using Common
|
|
|
|
phk use our data bank
|
|
plb
|
|
tsx save the stack register
|
|
stx sreg
|
|
ora #$0100 set our user ID
|
|
sta userID
|
|
jsl SysIOStartup start the I/O system
|
|
jsr Initialize set up the linker
|
|
bcs exit
|
|
jsr DoPass1 do pass 1
|
|
bcs exit
|
|
jsr DoPass2 do pass 2
|
|
bcs exit
|
|
lda kflag if kflag then
|
|
beq lb1
|
|
jsr KeepFile write the keep file
|
|
lb1 jsr Terminate do final processing
|
|
|
|
exit entry
|
|
jsr PurgePlusM purge memory only files
|
|
jsr SetLInfo pass parameters back to the shell
|
|
jsl SysIOShutdown shut down the I/O system
|
|
lda #0 return to the caller
|
|
rtl
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Common - global data
|
|
*
|
|
****************************************************************
|
|
*
|
|
copy DirectPage
|
|
Common data
|
|
;
|
|
; Memory locations
|
|
;
|
|
keyboard equ $C000 keyboard value
|
|
strobe equ $C010 keyboard strobe
|
|
kflags equ $C025 keyboard flags
|
|
;
|
|
; Constants
|
|
;
|
|
flagB equ %01000000000000000000000000000000 command line flag masks
|
|
flagC equ %00100000000000000000000000000000
|
|
flagL equ %00000000000100000000000000000000
|
|
flagM equ %00000000000010000000000000000000
|
|
flagP equ %00000000000000010000000000000000
|
|
flagS equ %00000000000000000010000000000000
|
|
flagW equ %00000000000000000000001000000000
|
|
flagX equ %00000000000000000000000100000000
|
|
flagAll equ flagB+flagC+flagL+flagM+flagP+flagS+flagW+flagX
|
|
|
|
RETURN equ $0D key codes
|
|
TAB equ $09
|
|
;
|
|
; Symbol flags (bit masks for symFlag)
|
|
;
|
|
pass1Resolved equ 1 label defined on pass 1
|
|
pass2Resolved equ 2 label defined on pass 2
|
|
pass1Requested equ 4 label has been requested on pass1
|
|
pass2Requested equ 8 label has been requested on pass2
|
|
! (see also, subroutine Reference2)
|
|
isConstant equ 16 is the value a constant?
|
|
isDataArea equ 32 is the symbol a data area?
|
|
isSegmentFlag equ 64 is the symbol a segment name?
|
|
;
|
|
; global scalars
|
|
;
|
|
bankOrg ds 2 bank org the program?
|
|
compact ds 2 compact the object files?
|
|
dataAreas ds 256 data area array
|
|
dpReg ds 2 default DP register
|
|
eoln ds 2 script end of line flag
|
|
express ds 2 expressload the file?
|
|
length ds 4 length of the output file
|
|
libFromShell ds 2 did the shell have a variable?
|
|
libIndex ds 2 next library index
|
|
libSeg ds 4 pointer to the current library segment
|
|
lineNumber ds 2 script line number
|
|
list ds 2 list segment info?
|
|
memory ds 2 is this a +m link?
|
|
numerror ds 2 number of linker errors found
|
|
pass ds 2 pass number (1 or 2)
|
|
pause ds 2 pause on error?
|
|
progress ds 2 write progress info?
|
|
sreg ds 2 stack register in main
|
|
symbols ds 2 list the symbol table?
|
|
userID ds 2 user ID; for memory manager calls
|
|
;
|
|
; Current code segment information
|
|
;
|
|
segLength ds 4 length of the code in the segment
|
|
segDisp ds 4 disp to the next segment in the file
|
|
segSpace ds 4 reserved space at the end of the segment
|
|
segType ds 2 segment type
|
|
segName ds 4 pointer to the name of the segment
|
|
segEntry ds 4 disp to entry point in segment
|
|
segAlign ds 4 segment alignment factor
|
|
segVersion ds 2 segment version number
|
|
segOrg ds 4 origin for this segment
|
|
segBanksize ds 4 banksize for this segment
|
|
|
|
startpc ds 4 pc at the start of the segment
|
|
|
|
fileNumber ds 2 source file number
|
|
dataNumber ds 2 data area number (0 for code segments)
|
|
|
|
lastDataNumber ds 2 last data area number used
|
|
lastFileNumber ds 2 last file number used
|
|
;
|
|
; Scalars passed to and from the shell
|
|
;
|
|
merr ds 2 maximum error level allowed
|
|
merrf ds 2 maxiumum error level found so far
|
|
lops ds 2 language operations
|
|
kflag ds 2 keep flag
|
|
mflags ds 4 minus flags
|
|
pflags ds 4 plus flags
|
|
org ds 4 origin
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* GetCh - get the current character from the script
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the start of a file
|
|
* r4 - length of the file
|
|
*
|
|
* Outputs:
|
|
* A - character read
|
|
*
|
|
* Notes:
|
|
* 1. All whitespace characters are converted to spaces.
|
|
* 2. A null is returned if there are no more characters
|
|
* in the file.
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetCh private
|
|
using Common
|
|
|
|
lb1 lda r4 quit if at eof
|
|
ora r6
|
|
beq lb3
|
|
lda [r0] A = r0^
|
|
and #$00FF
|
|
cmp #RETURN if A in [RETURN,TAB] then
|
|
beq lb2
|
|
cmp #TAB else if A = TAB then
|
|
bne lb3
|
|
lb2 lda #' ' return a space
|
|
lb3 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Initialize - get ready to do a link
|
|
*
|
|
* Outputs:
|
|
* C - set if an error occurred
|
|
*
|
|
****************************************************************
|
|
*
|
|
Initialize private
|
|
using Common
|
|
;
|
|
; Get the command line inputs
|
|
;
|
|
tdc set our DP register
|
|
sta dpReg
|
|
jsr GetLInfo get the command line inputs
|
|
jcs rts
|
|
jsr GetLibList read and handle {Libraries}
|
|
;
|
|
; Initialize the global scalars
|
|
;
|
|
jsr InitSymbol initialize the symbol table
|
|
jsr InitOut initialize the output module
|
|
stz length no bytes in the program
|
|
stz length+2
|
|
stz fname no file name buffer allocated
|
|
stz fname+2
|
|
stz basename no base name buffer allocated
|
|
stz basename+2
|
|
stz numerror no errors so far
|
|
stz libSeg no library segment buffer allocated
|
|
stz libSeg+2
|
|
;
|
|
; Read the script file
|
|
;
|
|
lda lops if this is a scripted link then
|
|
lsr A
|
|
bcc sf0
|
|
stz sdisp initialize the command line disp
|
|
jsr GetName get the script file name
|
|
jsr CopybaseName
|
|
jsr GetName make sure there is only one file
|
|
bcc rs1
|
|
lda #13
|
|
jsr TermError
|
|
sec
|
|
brl rts
|
|
rs1 jsr Read read the script file
|
|
jsr Script process the script file
|
|
jsr Purge purge the file
|
|
;
|
|
; Set the various flags
|
|
;
|
|
sf0 stz list list = false
|
|
lda #^flagL if +L then
|
|
and pflags+2
|
|
beq sf1
|
|
inc list list = true
|
|
|
|
sf1 stz symbols symbols = false
|
|
lda #flagS if +S then
|
|
and pflags
|
|
beq sf2
|
|
inc symbols symbols = true
|
|
|
|
sf2 lda #1 express = true
|
|
sta express
|
|
lda #flagX if -X then
|
|
and mflags
|
|
beq sf3
|
|
stz express express = false
|
|
|
|
sf3 stz pause pause = false
|
|
lda #flagW if +W then
|
|
and pflags
|
|
beq sf4
|
|
inc pause pause = true
|
|
|
|
sf4 stz memory memory = false
|
|
lda #^flagM if +M then
|
|
and pflags+2
|
|
beq sf5
|
|
inc memory memory = true
|
|
|
|
sf5 lda #1 compact = true
|
|
sta compact
|
|
lda #^flagC if -C then
|
|
and mflags+2
|
|
beq sf6
|
|
stz compact compact = false
|
|
|
|
sf6 stz bankOrg bankOrg = false
|
|
lda #^flagB if +B then
|
|
and pflags+2
|
|
beq sf7
|
|
inc bankOrg bankOrg = true
|
|
|
|
sf7 lda #1 progress = true
|
|
sta progress
|
|
lda #^flagP if -P then
|
|
and mflags+2
|
|
beq sf8
|
|
stz progress progress = false
|
|
|
|
sf8 anop
|
|
;
|
|
; Write the header
|
|
;
|
|
lda progress
|
|
beq wh1
|
|
puts #'Link Editor 2.1.0',cr=t
|
|
putcr
|
|
wh1 anop
|
|
;
|
|
; Return to main
|
|
;
|
|
clc
|
|
rts rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* NextCh - get the next character from the script
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the start of a file
|
|
* r4 - length of the file
|
|
* eoln - was the last character an eoln?
|
|
*
|
|
* Outputs:
|
|
* A - character read
|
|
* eoln - was the last character an eoln?
|
|
* r8 - set to the start of any new line
|
|
*
|
|
* Notes:
|
|
* 1. All whitespace characters are converted to spaces.
|
|
* 2. A null is returned if there are no more characters
|
|
* in the file.
|
|
* 3. Comments are skipped
|
|
*
|
|
****************************************************************
|
|
*
|
|
NextCh private
|
|
using Common
|
|
;
|
|
; Check for EOF
|
|
;
|
|
lda r4 quit if at eof
|
|
ora r6
|
|
jeq lb5
|
|
;
|
|
; Handle comments
|
|
;
|
|
lda eoln if eoln then
|
|
beq lb3
|
|
stz eoln eoln = false
|
|
lb1 lda [r0] if r0[1] in ['*','!',';'] then
|
|
and #$FF00
|
|
xba
|
|
cmp #'*'
|
|
beq lb2
|
|
cmp #'!'
|
|
beq lb2
|
|
cmp #';'
|
|
bne lb3
|
|
lb2 inc4 r0 skip this line
|
|
dec4 r4
|
|
lda r4
|
|
ora r6
|
|
beq lb5
|
|
lda [r0]
|
|
and #$00FF
|
|
cmp #RETURN
|
|
bne lb2
|
|
bra lb1 check for adjacent comments
|
|
;
|
|
; Return the next character
|
|
;
|
|
lb3 inc4 r0 next char
|
|
dec4 r4
|
|
lda r4 quit if at eof
|
|
ora r6
|
|
beq lb5
|
|
lda [r0] A = r0^
|
|
and #$00FF
|
|
cmp #RETURN if A = RETURN then
|
|
bne lb4
|
|
add4 r0,#1,r8 set the line start
|
|
lda #1 eoln = true
|
|
sta eoln
|
|
inc lineNumber ++lineNumber
|
|
lda #' ' return a space
|
|
bra lb5
|
|
lb4 cmp #TAB else if A = TAB then
|
|
bne lb5
|
|
lda #' ' return a space
|
|
lb5 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Script - read and process a script file
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the start of a file
|
|
* r4 - length of the file
|
|
* mflags,pflags - current file flags
|
|
* kname - keep file name
|
|
* kflag - keep file flag
|
|
*
|
|
* Outputs:
|
|
* mflags,pflags - file flags
|
|
* kname - keep file name
|
|
* kflag - keep file flag
|
|
* slist - pointer to the file name list
|
|
*
|
|
****************************************************************
|
|
*
|
|
Script private
|
|
using Common
|
|
;
|
|
; Set up the script
|
|
;
|
|
lda #1 eoln = true {starting a new line}
|
|
sta eoln
|
|
sta lineNumber current line # = 1
|
|
move4 r0,r8 set the first line pointer
|
|
dec4 r0 get the first char (skipping comments)
|
|
jsr NextCh
|
|
;
|
|
; Process flags
|
|
;
|
|
fl0 jsr SkipBlanks skip leading blanks
|
|
fl1 jsr GetCh if GetCh in ['+','-'] then
|
|
cmp #'+'
|
|
beq fl2
|
|
cmp #'-'
|
|
bne pn1
|
|
fl2 sta flagCh save the flag sign
|
|
jsr NextCh get the flag character
|
|
and #$5F uppercase the character
|
|
sec form the flag bit
|
|
sbc #'@'
|
|
bmi fl4
|
|
tax
|
|
stz r12
|
|
stz r14
|
|
sec
|
|
fl3 ror r14
|
|
ror r12
|
|
dex
|
|
bne fl3
|
|
lda r12 make sure the flag is legal
|
|
and #flagAll
|
|
bne fl5
|
|
lda r14
|
|
and #^flagAll
|
|
bne fl5
|
|
fl4 lda #1 flag an illegal flag error
|
|
jmp ScriptError
|
|
fl5 jsr NextCh skip the flag character
|
|
lda r12 if this flag was set from the CL then
|
|
bit pFlags
|
|
bne fl0 skip the flag
|
|
bit mFlags
|
|
bne fl0
|
|
lda r14
|
|
bit pFlags+2
|
|
bne fl0
|
|
bit mFlags+2
|
|
bne fl0
|
|
lda flagCh if flagCh = '+' then
|
|
cmp #'+'
|
|
bne fl6
|
|
lda r12 pFlags |= r12
|
|
ora pFlags
|
|
sta pFlags
|
|
lda r14
|
|
ora pFlags+2
|
|
sta pFlags+2
|
|
bra fl0 else
|
|
fl6 lda r12 mFlags |= r12
|
|
ora mFlags
|
|
sta mFlags
|
|
lda r14
|
|
ora mFlags+2
|
|
sta mFlags+2
|
|
brl fl0 get the next flag
|
|
;
|
|
; Process file names
|
|
;
|
|
pn1 ph4 slist free the old list
|
|
jsr Free
|
|
add4 r4,#4,r12 reserve plenty of space for the file list
|
|
ph4 r12
|
|
jsr MLalloc
|
|
sta slist
|
|
stx slist+2
|
|
stz r16 no characters written
|
|
add4 slist,#2,r12 set next char pointer
|
|
pn2 jsr SkipBlanks skip any blanks
|
|
jsr GetCh if at eof then
|
|
tax
|
|
beq pn6 done
|
|
lda r6 if r4 > 5 then
|
|
bne pn2a
|
|
lda r4
|
|
cmp #6
|
|
blt pn4
|
|
pn2a ldy #4 if r0^ = "keep=" then
|
|
pn3 lda [r0],Y
|
|
and #$00FF
|
|
jsr ToUpper
|
|
short M
|
|
cmp keep,Y
|
|
long M
|
|
bne pn4
|
|
dey
|
|
bpl pn3 done
|
|
bra pn6
|
|
pn4 jsr GetCh while not GetCh in [' ', chr(0)] do
|
|
tax
|
|
beq pn5
|
|
cmp #' '
|
|
beq pn5
|
|
short M save the character
|
|
sta [r12]
|
|
long M
|
|
inc4 r12
|
|
inc r16 update the line length
|
|
jsr NextCh skip to the next character
|
|
bra pn4 endwhile
|
|
pn5 short M add a trailing space
|
|
lda #' '
|
|
sta [r12]
|
|
long M
|
|
inc4 r12
|
|
inc r16
|
|
bra pn2 next name
|
|
pn6 lda r16 set the list length
|
|
beq pn7
|
|
dec A
|
|
pn7 sta [slist]
|
|
;
|
|
; Process a keep name
|
|
;
|
|
lda kname skip this step if we have a kname
|
|
ora kname+2
|
|
beq kn0
|
|
lda [kname]
|
|
jne kn5
|
|
kn0 jsr NextCh skip the keep name
|
|
jsr NextCh
|
|
jsr NextCh
|
|
jsr NextCh
|
|
jsr NextCh
|
|
kn1 ph4 kname free the old list
|
|
jsr Free
|
|
lda #1 kflag = true
|
|
sta kflag
|
|
add4 r4,#4,r12 reserve plenty of space for the file list
|
|
ph4 r12
|
|
jsr MLalloc
|
|
sta kname
|
|
stx kname+2
|
|
stz r16 no characters written
|
|
add4 kname,#2,r12 set next char pointer
|
|
jsr GetCh if at eof then
|
|
tax
|
|
beq kn3 done
|
|
kn2 jsr GetCh while not GetCh in [' ', chr(0)] do
|
|
tax
|
|
beq kn3
|
|
cmp #' '
|
|
beq kn3
|
|
short M save the character
|
|
sta [r12]
|
|
long M
|
|
inc4 r12
|
|
inc r16 update the line length
|
|
jsr NextCh skip to the next character
|
|
bra kn2 endwhile
|
|
kn3 lda r16 set the list length
|
|
bne kn4
|
|
lda #2 missing keep name
|
|
jmp ScriptError
|
|
kn4 sta [kname]
|
|
|
|
jsr SkipBlanks skip trailing blanks and comments
|
|
jsr GetCh make sure there are no more chars
|
|
tax
|
|
beq kn5
|
|
lda #3 unknow parameters
|
|
jmp ScriptError
|
|
kn5 rts
|
|
;
|
|
; Local data
|
|
;
|
|
flagCh ds 2 flag character
|
|
keep dc c'KEEP=' keep preamble
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* ScriptError - flag an error in a script file
|
|
*
|
|
* Inputs:
|
|
* r0 - ptr to the char where the error occurred
|
|
* r4 - # chars left in the script
|
|
* r8 - ptr to the start of the line
|
|
* A - error number
|
|
*
|
|
****************************************************************
|
|
*
|
|
ScriptError private
|
|
using Common
|
|
|
|
sta err save the error number
|
|
sub4 r0,r8,disp get the disp to the error
|
|
add4 r4,disp move back to the start of the line
|
|
move4 r8,r0
|
|
put2 lineNumber,#5,errout=t print the line number
|
|
putc #' ',errout=t print one space
|
|
lb1 jsr GetCh print the line
|
|
tax
|
|
beq lb2
|
|
sta ch
|
|
putc ch,errout=t
|
|
jsr NextCh
|
|
lda eoln
|
|
beq lb1
|
|
lb2 putcr errout=t
|
|
add4 disp,#6 print the error pointer
|
|
lb3 putc #' ',errout=t
|
|
dec4 disp
|
|
lda disp
|
|
ora disp+2
|
|
bne lb3
|
|
puts #'^ ',errout=t
|
|
|
|
dec err print the error message
|
|
bne lb4
|
|
puts #'Illegal flag',errout=t,cr=t
|
|
bra lb6
|
|
lb4 dec err
|
|
bne lb5
|
|
puts #'Missing keep name',errout=t,cr=t
|
|
bra lb6
|
|
lb5 dec err
|
|
bne lb6
|
|
puts #'Unrecognized parameter',errout=t,cr=t
|
|
|
|
lb6 lda #14 stop the link
|
|
jmp TermError
|
|
;
|
|
; Local data
|
|
;
|
|
ch ds 2 character from script
|
|
err ds 2 error number
|
|
disp ds 4 # chars to the error
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* SkipBlanks - skip whitespace in a script file
|
|
*
|
|
****************************************************************
|
|
*
|
|
SkipBlanks private
|
|
|
|
jsr GetCh
|
|
bra lb2
|
|
lb1 jsr NextCh
|
|
lb2 tax
|
|
beq lb3
|
|
cmp #' '
|
|
beq lb1
|
|
lb3 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Terminate - do terminal processing
|
|
*
|
|
****************************************************************
|
|
*
|
|
Terminate private
|
|
using OutCommon
|
|
using Common
|
|
;
|
|
; Write the link statistics
|
|
;
|
|
jsr PrintSymbols print the symbol table
|
|
|
|
lda list if list then
|
|
beq sg1
|
|
jsr PrintSegmentInfo write the segment table
|
|
|
|
sg1 lda numError if there are errors then
|
|
jeq er3
|
|
putcr errout=t write the error summary
|
|
lda numError
|
|
dec A
|
|
bne er1
|
|
puts #'1 error',errout=t
|
|
bra er2
|
|
er1 put2 numError,errout=t
|
|
puts #' errors',errout=t
|
|
er2 puts #' found during link',cr=t,errout=t
|
|
put2 merrf,errout=t
|
|
puts #' was the highest error level',cr=t,errout=t
|
|
|
|
er3 lda progress if progress or list then
|
|
bne er4
|
|
lda list
|
|
jeq er5
|
|
er4 putcr write the number, size of segments
|
|
puts #'There '
|
|
lda lastLoadNumber
|
|
dec A
|
|
bne lb1
|
|
puts #'is 1 segment'
|
|
bra lb2
|
|
lb1 puts #'are '
|
|
put2 lastLoadNumber
|
|
puts #' segments'
|
|
lb2 puts #', for a length of $'
|
|
ph4 length
|
|
ph2 #8
|
|
ph2 #0
|
|
jsr PrintHex
|
|
puts #' bytes.',cr=t
|
|
er5 anop endif
|
|
rts
|
|
end
|