Linker/linker.asm
Stephen Heumann 085c7c46ca Add support for auto-segmentation.
This is a new feature where the linker will automatically divide the code into load segments, creating as many segments as necessary to fit it. This relieves the programmer from the need to manually figure out how a large program can be divided into segments.

Auto-segmentation is triggered by the use of the special load segment name AUTOSEG~~~. Using this approach (rather than a flag in the OMF header) allows auto-segmentation to be used with all existing languages that provide a mechanism for specifying load segment names.
2022-08-30 19:32:09 -05:00

726 lines
15 KiB
NASM

mcopy linker.mac
keep obj/linker
****************************************************************
*
* Linker 2.0
*
* Link editor for ORCA/M.
*
****************************************************************
*
* 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 B1',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