!***********************************************************************
!*
!* LINK - object file linker
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constant integer maxfiles= 256; ! Maximum number of input files
constant integer ssobjfiletype= 1
constant integer sscharfiletype= 3
constant integer sspdfiletype= 6
constant integer instream= 81; ! Control input stream
constant byte integer array hex(0:15)= c
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
constant string (1) snl= "
"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
record format af(integer start, len, props)
record format l1f(integer link, loc, string (31) iden)
record format l4f(integer link, disp, l, a, string (31) iden)
record format l78f(integer link, refloc, string (31) iden)
record format l9f(integer link, refarray, l, string (31) iden)
record format l13f(integer link, a, disp, len, rep, addr)
record format l14f(integer link, n)
record format ofmf(integer n, record (af) array area(1:7))
record format ohf(integer dataend, datastart, filesize, filetype, sum, datetime, lda, ofm)
record format rf(integer conad, filetype, datastart, dataend)
!
own integer array format ldataf(0:14)
own integer array format reflocaf(1:32768)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
external routine spec changefilesize alias "S#CHANGEFILESIZE"(string (31) file, integer newsize,
integer name flag)
external integer map spec comreg alias "S#COMREG"(integer i)
external routine spec connect alias "S#CONNECT"(string (31) file, integer mode, hole, prot,
record (rf) name r, integer name flag)
external routine spec define alias "S#DEFINE"(integer chan, string (31) iden, integer name afd, flag)
external routine spec disconnect alias "S#DISCONNECT"(string (31) file, integer name flag)
external string function spec failuremessage alias "S#FAILUREMESSAGE"(integer mess)
external routine spec lput alias "S#LPUT"(integer type, p1, p2, p3)
external routine spec move alias "S#MOVE"(integer length, from, to)
external routine spec outfile alias "S#OUTFILE"(string (31) file, integer size, hole, prot,
integer name conad, flag)
external integer function spec parmap alias "S#PARMAP"
external routine spec prompt(string (255) s)
external routine spec psysmes alias "S#PSYSMES"(integer root, mess)
external routine spec setfname alias "S#SETFNAME"(string (63) s)
external routine spec setpar alias "S#SETPAR"(string (255) s)
external routine spec set return code(integer i)
external routine spec setwork alias "S#SETWORK"(integer name ad, flag)
external string function spec spar alias "S#SPAR"(integer n)
external routine spec uctranslate alias "S#UCTRANSLATE"(integer ad, len)
external string function spec uinfs(integer entry)
!
!
!***********************************************************************
!*
!* Common routines
!*
!***********************************************************************
!
routine phex(integer i, width)
integer j
!
for j = width-4, -4, 0 cycle
printsymbol(hex((i>>j)&x'f'))
repeat
end ; ! of phex
!
!-----------------------------------------------------------------------
!
integer function linker(integer nfiles, integer array name b, string (31) array name c, string (31) file)
integer i, l, link, total, fbase, newsize, map, flag, histot
integer pr, fillsize, lh, p, p1, res
integer array base, size, start, totalsize, props(1:7)
integer array histbeg, histlength, dt(1:nfiles)
integer array t(1:8)
integer array name ldata
record (rf) rr
record (ohf) name r
record (l1f) name r1, r1c
record (l4f) name r4, r4c
record (ofmf) name ofm
string name iden
routine spec generate load data(integer lbase, fbase)
!
res = 0
map = comreg(27)&x'20000'
lput(0, 0, 0, 0); ! Open object file
total = 0
histot = 5; ! Size of basic history data
if map#0 then start
newline
printstring(" File CODE GLA PLT SST UST ICMN ISTK")
newline
finish
for i = 1, 1, 7 cycle
base(i) = 0
size(i) = 0
start(i) = 0
totalsize(i) = 0
props(i) = 0
repeat
!
for i = 1, 1, nfiles cycle
fbase = b(i)
r == record(fbase)
dt(i) = r_datetime
ldata == array(fbase+r_lda, ldataf)
ofm == record(fbase+r_ofm)
p = fbase+ldata(12); ! Points to start of file history
histbeg(i) = p
p1 = p; ! Find end of history data
while byteinteger(p1)#0 cycle
p1 = p1+2+byteinteger(p1+1)
repeat
histlength(i) = p1-p
histot = histot+histlength(i)+length(c(i))+8
! Space for name and other odd bits
t(l) = 0 for l = 1, 1, 8
!
for l = 1, 1, 7 cycle
start(l) = ofm_area(l)_start
size(l) = ofm_area(l)_len
props(l) = props(l)!ofm_area(l)_props
if l=1 then start ; ! Look for code going over segment boundary
if (base(l)+16)&x'fffc0000'#(base(l)+size(l)+16)&x'fffc0000' then start
fillsize = x'40000'-((base(l)+16)&x'3ffff')
lput(31, fillsize, 0, 0); ! Fill up to end of segment with zeros
t(1) = fillsize
t(8) = fillsize
totalsize(l) = totalsize(l)+fillsize
lput(6, 32, 0, addr(t(1))); ! Write out dummy component
t(8) = 0; ! Reset for real code area
base(l) = base(l)+fillsize
finish
if map#0 then start ; ! Defer listing, in case base increased by filler
write(i, 3)
spaces(2)
for pr = 1, 1, 7 cycle
phex(base(pr), 24)
spaces(2)
repeat
printstring(c(i).snl)
finish
finish
lput(30+l, size(l), 0, start(l)+fbase)
base(l) = base(l)+size(l)
t(l) = size(l)
totalsize(l) = totalsize(l)+t(l)
t(8) = t(8)+t(l)
repeat
!
generate load data(fbase+r_lda, fbase)
lput(6, 32, 0, addr(t(1))); ! Terminate this set of areas
repeat
!
if map#0 then start
printstring(snl."Totals".snl)
t(8) = 0
spaces(6)
for l = 1, 1, 7 cycle
phex(totalsize(l), 24)
t(8) = t(8)+totalsize(l)
spaces(2)
repeat
printstring(file.snl)
finish
lput(7, 32, 0, addr(t(1))); ! Finish off object file
!
! Now check for duplicate procedure and data entries, and add the file history
!
connect(file, 0, 0, 0, rr, flag); ! Get connect address of file
if flag=0 then start ; ! Only do all this if file connected OK
fbase = rr_conad
r == record(fbase)
ldata == array(fbase+r_lda, ldataf)
!
link = ldata(1); ! List 1 - procedure entries
while link#0 cycle
r1 == record(fbase+link)
iden == r1_iden; ! Test against this one
l = r1_link
while l#0 cycle
r1c == record(fbase+l)
if iden=r1c_iden then start
printstring("Warning - Duplicate procedure entry - ".iden)
res = 290
newline
finish
l = r1c_link
repeat
link = r1_link
repeat
!
link = ldata(4); ! List 4 - data entries
while link#0 cycle
r4 == record(fbase+link)
iden == r4_iden; ! Test against this one
l = r4_link
while l#0 cycle
r4c == record(fbase+l)
if iden=r4c_iden then start
printstring("Warning - Duplicate data entry - ".iden)
res = 290
newline
finish
l = r4c_link
repeat
link = r4_link
repeat
!
if map#0 then start ; ! Print file header at end of map
printstring(snl."Header".snl)
for i = fbase, 4, fbase+28 cycle
phex(integer(i), 32)
space
repeat
newline
finish
!
! Add the file history
!
p = r_dataend
newsize = r_filesize
if newsize<p+histot then start
! Need to extend file
newsize = p+histot
changefilesize(file, newsize, flag)
if flag=261 then start ; ! VM hole too small
disconnect(file, flag)
changefilesize(file, newsize, flag)
finish
finish
if flag=0 then connect(file, 3, 0, 0, rr, flag)
! Connect in write mode
if flag#0 then start
printstring("Warning - Cannot include file history or property codes".snl." -")
printstring(failuremessage(flag))
res = flag
->err
finish
fbase = rr_conad; ! File may have moved
r == record(fbase)
r_filesize = (newsize+4095)//4096*4096
! In case it changed
ofm == record(fbase+r_ofm)
ofm_area(i)_props = props(i) for i = 1, 1, 7
! Fill in revised property codes
ldata == array(fbase+r_lda, ldataf)
ldata(12) = r_dataend; ! Point to end of file, where history will go
lh = fbase+r_dataend; ! Insert history header
byteinteger(lh) = 3; ! Initialise - "COMPONENTS"
byteinteger(lh+1) = 0; ! Zero length for information part
lh = lh+2
for i = 1, 1, nfiles cycle ; ! For each file
byteinteger(lh) = 4; ! Object name
string(lh+1) = c(i)
lh = lh+2+length(c(i))
if byteinteger(histbeg(i))=3 then start
byteinteger(lh) = 5; ! Linked object - date linked
finish else byteinteger(lh) = 6
! Object file - date compiled
byteinteger(lh+1) = 4; ! Length of date
move(4, addr(dt(i)), lh+2); ! Date from file header
lh = lh+6
if histlength(i)>0 then move(histlength(i), histbeg(i), lh)
lh = lh+histlength(i)
repeat
byteinteger(lh) = 7; ! "END" of components
byteinteger(lh+1) = 0; ! Zero length for information part
byteinteger(lh+2) = 0; ! End of history data - terminate
lh = lh+3
r_dataend = lh-fbase; ! Set new length of file
finish
!
err:
!
result = res
!
!
routine generate load data(integer lbase, fbase)
integer i, l, area, refarray, link
integer array name refloc
integer array name ldata
record (l1f) name r1
record (l4f) name r4
record (l78f) name r78
record (l9f) name r9
record (l13f) name r13
record (l14f) name r14
!
ldata == array(lbase, ldataf)
!
! Process procedure and data entries
!
link = ldata(1); ! List 1 - procedure entries
while link#0 cycle
r1 == record(fbase+link)
lput(11, (r1_loc&x'80000000')!(r1_loc>>24), r1_loc&x'00ffffff', addr(r1_iden))
link = r1_link
repeat
!
link = ldata(4); ! List 4 - data entries
while link#0 cycle
r4 == record(fbase+link)
lput(14, (r4_a<<24)!r4_l, r4_disp, addr(r4_iden))
link = r4_link
repeat
!
! Now deal with data references
!
link = ldata(9); ! List 9 - data references
while link#0 cycle
r9 == record(link+fbase)
if r9_refarray&x'80000000'#0 then l = 10 else l = 15
! See if 'common' area
refarray = r9_refarray&x'7fffffff'
! Remove bit
refloc == array(fbase+refarray+4, reflocaf)
for i = 1, 1, integer(fbase+refarray) cycle
! Count of pointers to this reference
area = refloc(i)&x'ff000000'
lput(l, area!r9_l, refloc(i)&x'00ffffff', addr(r9_iden))
repeat
link = r9_link
repeat
!
! Process static and dynamic procedure references
!
for i = 7, 1, 8 cycle
link = ldata(i); ! Lists 7 and 8 - procedure references
while link#0 cycle
r78 == record(fbase+link)
l = r78_refloc
lput(i+5, l>>24, l&x'00ffffff', addr(r78_iden))
link = r78_link
repeat
repeat
!
! Process initialisation data
!
link = ldata(13); ! List 13 - initialisation data
while link#0 cycle
r13 == record(fbase+link)
l = r13_len
if l=1 then start
lput(r13_a+30, r13_rep, r13_disp, r13_addr)
else
lput(r13_a+40, (l<<24)!r13_rep, r13_disp, fbase+r13_addr)
finish
link = r13_link
repeat
!
! Process generalised relocation blocks
!
link = ldata(14); ! List 14 - generalised relocation blocks
while link#0 cycle
r14 == record(fbase+link)
lput(26, ((r14_n<<1)+1)<<2, 0, addr(r14_n))
link = r14_link
repeat
end ; ! of generate load data
end ; ! of linker
!
!-----------------------------------------------------------------------
!
routine readline(string name s)
integer c
!
on event 9 start ; ! Trap 'Input Ended'
if s="" then s = ".END"
uctranslate(addr(s)+1, length(s))
return
finish
!
s = ""
cycle
cycle
readsymbol(c)
exit if c=nl
continue if c=' '
s <- s.tostring(c)
repeat
exit unless s=""
repeat
uctranslate(addr(s)+1, length(s))
end ; ! of readline
!
!
!***********************************************************************
!*
!* L I N K
!*
!***********************************************************************
!
external routine link(string (255) parms)
integer nfiles, flag2, conad, total, i, ad, flag, afd
string (6) owner
string (31) object, file
record (rf) rr
record (ohf) name h
integer array name ldata
integer array inadds(1:maxfiles)
string (31) array inputs(1:maxfiles)
!
set return code(272); ! In case of catastrophic failure
owner = uinfs(1)
prompt("Link: ")
total = 0
nfiles = 0
flag = 0
!
setpar(parms)
if parmap>1 then start
flag = 263; ! Wrong number of parameters
->merr
finish
!
! Use non-default input if requested
!
file = spar(1); ! Control input file
if file#"" then start
if "*"#file#".IN" then start
connect(file, 1, 0, 0, rr, flag)
->merr if flag#0
if rr_filetype#sscharfiletype then start
setfname(file)
flag = 267; ! Invalid filetype
->merr
finish
finish
define(instream, file, afd, flag)
->merr if flag#0
selectinput(instream)
finish
!
cycle
readline(file)
exit if file=".END"
if nfiles=maxfiles then start
flag = 277; ! Too many input files
->merr
finish
connect(file, 1, 0, 0, rr, flag2)
if flag2#0 then start
psysmes(8, flag2)
flag = flag2
continue
finish
conad = rr_conad
h == record(conad)
if h_filetype#ssobjfiletype then start
setfname(file)
printstring("Warning -".failuremessage(267))
! Invalid filetype
flag = 267
continue
finish
ldata == array(conad+h_lda, ldataf)
if ldata(5)#0 then start
printstring("Warning - Cannot link bound object file ".file.snl)
flag = 267
continue
finish
unless length(file)>7 and charno(file, 7)='.' then start
file = owner.".".file
finish
nfiles = nfiles+1
inputs(nfiles) = file
inadds(nfiles) = conad
repeat
!
if nfiles=0 then start
flag = 305; ! No input files
->merr
finish
!
prompt("Object: ")
readline(object)
unless length(object)>7 and charno(object, 7)='.' then start
object = owner.".".object
finish
for i = 1, 1, nfiles cycle
if object=inputs(i) then start
flag = 266; ! Inconsistent file use
->merr
finish
repeat
connect(object, 1, 0, 0, rr, flag2); ! Check for PD overwrite
if flag2=0 then start
if rr_filetype=sspdfiletype then start
flag = 310; ! Attempt to overwrite PD file
->merr
finish
finish
!
outfile(object, -4096, 0, 0, conad, flag2); ! Try to create output file
if flag2#0 then start
psysmes(10, flag2); ! Create file failed
flag = flag2
->err
finish
comreg(52) = addr(object); ! Picked up by 'lput'
ad = x'40000'
setwork(ad, flag2); ! Create 'lput' workfile
if flag2#0 then start
psysmes(10, flag2); ! Create workfile failed
flag = flag2
->err
finish
!
i = linker(nfiles, inadds, inputs, object)
if flag=0 then flag = i
disconnect(object, flag); ! This is vital for diagnostics to work
newline
write(nfiles, 1)
printstring(" Files linked successfully")
newline
->err
!
merr:
psysmes(28, flag)
!
err:
set return code(flag)
end ; ! of link
end of file