%external %routine link11(%string (63) param)
%string (63) map
%own %integer brians fiddle= 255
%const %integer limit= 128
%own %integer code base= 2<<13, gla base = 0, spbase = 7<<13
%own %integer alone= 0, main ep = -1, entry = 0
%own %string (31) task id= ""
%own %string (31) fix file= ""
%own %integer streams= 2
%own %string (31) perm file= ":imp119y.PERM11#REL",
lib file = ":imp119y.LIB11#REL",
object = ""
%own %integer stack= 8*1024
%const %integer plug bit= 64
%external %integer %function %spec exist %alias "S#EXIST"(%string %c
(255) file)
%routine define(%string (255) s)
%external %routine %spec emas3(%string %name command,params,
%integer %name flag)
%integer flag
emas3("DEFINE",s,flag)
%end; ! Of %routine define.
%external %string (6) %fn %spec IMP11HOST
%external %routine %spec prompt %alias "S#PROMPT"(%string (255) s)
%record %format tabfm(%integer addr,index, %byte %integer type,
%string (63) text)
%const %integer max table= 400
%const %integer max files= 50
%record (tabfm) %array table(0:max table)
%string (63) %array file(1:max files)
%integer %array filecode,filegla,specs,speclist(0:max files)
%byte %integer %array used(1:max files)
%integer errors
%integer stream
%integer refs,defs,module count
%integer last code
%integer ca,ga
%integer file no,file limit
%own %integer perm= 0, perm ep = 0
%string (63) file name
%integer j
%record (tabfm) %name t
%integer cp,gp,total ca,sp,ds
%integer %array cbuf,gbuf(0:limit)
!Predefined externals
%const %integer xtop= max table
%const %integer xevent= max table-1
%const %integer xds= max table-2
%const %integer xsp= max table-3
%const %integer xgo= max table-4
!
table(xtop)_text = "$TOP"; table(xtop)_type = 0; table(xtop)_index = 0
table(xevent)_text = "$EVENT"; table(xevent)_type = 0; table(xevent) %c
_index = 0
table(xds)_text = "$DS"; table(xds)_type = 0; table(xds)_index = 0
table(xsp)_text = "$SP"; table(xsp)_type = 0; table(xsp)_index = 0
table(xgo)_text = "$$$"; table(xgo)_type = 0; table(xgo)_index = 0
!
PERM FILE = IMP11HOST.PERM FILE
LIB FILE = IMP11HOST.LIB FILE
!
%routine octal(%integer n)
%integer j
%cycle j = 15,-3,0
printsymbol(n>>j&7+'0')
%repeat
%end
%routine select(%integer st)
stream = st
selectoutput(stream)
%end
%routine get(%integer %name n)
%integer s1,s2
readch(s1); readch(s2)
n = s1+s2<<8
%end
%routine read word(%string %name s)
%integer sym
s = ""
skipsymbol %while nextsymbol=' ' %or nextsymbol=nl
%cycle
sym = nextsymbol
%return %if sym=' ' %or sym=nl %or sym='='
sym = sym-32 %if 'a'<=sym<='z'
s = s.tostring(sym)
skipsymbol
%repeat
%end
%routine error(%string (100) text)
selectoutput(0)
printstring("* ")
printstring(text); newline
errors = errors+1
selectoutput(stream)
%end
%routine get record(%record (tabfm) %name r, %integer spec)
!NOTIMP80 %recordspec R(TABFM)
%integer j,n,s
%if spec#0 %then r_addr = 0 %else get(r_addr)
r_index = file no
readch(r_type)
readch(n)
r_text = ""
%cycle j = 1,1,n
readch(s)
r_text = r_text.tostring(s)
%repeat
%end
%routine get spec
%integer j
%record (tabfm) r
%record (tabfm) %name t
get record(r,1)
r_index = 0
refs = refs+1; table(refs) = r
%cycle j = 1,1,refs
%exit %if table(j)_text=r_text
%repeat
t == table(j)
%if r_type#0 %and t_type#r_type %start
error("inconsistent use of ".r_text)
defs = defs-1; table(defs) = r
%return
%finish
%end
%routine get def
%integer j
%record (tabfm) r
get record(r,0)
r_index = file no
perm ep = file no %if r_text="$GO$"
defs = defs-1; table(defs) = r
%cycle j = max table,-1,defs
%exit %if table(j)_text=r_text
%repeat
%return %if j=defs
defs = defs+1
error("duplicate ".r_text) %if perm=0
%end
%routine satisfy(%record (tabfm) %name r)
!NOTIMP80 %recordspec R(TABFM)
%record (tabfm) %name t
%integer j
%cycle j = max table,-1,defs
t == table(j)
%if t_text=r_text %start
r_addr = t_addr; r_type = t_type
t_type = t_type!32; !SHOW USED
%return
%finish
%repeat
error("unsatisfied reference ".r_text." in file ".file name)
%end
%routine prepare specs(%integer insert, %integer %name flag)
%record (tabfm) r
%integer n
flag = errors
get(n)
%while n>0 %cycle
get record(r,0)
n = n-1
%repeat
get(n)
%while n>0 %cycle
n = n-1
get record(r,1)
%continue %if insert=0
satisfy(r)
refs = refs+1; table(refs) = r
%repeat
flag = errors-flag
get(n); !CODE SIZE
get(n); !GLA SIZE
%end
%routine skip module
%integer s
%cycle
readch(s) %until s=x'E0'
readch(s)
%if s=x'E0' %start
readch(s)
%return %if s=x'E0'
%finish
%repeat
%end
%routine flush(%integer %array %name b, %integer %name p, %integer new)
%integer j,check
%routine put(%integer n)
printch(n&255); printch(n>>8)
check = check+n+n>>8
%end
%cycle j = 1,1,10
printch(0)
%repeat
check = 0
put(1)
put(p*2+6)
%cycle j = 0,1,p
put(b(j))
%repeat
printch((-check)&255!brians fiddle)
brians fiddle = 0
p = 0
b(0) = new
%end
%routine cput(%integer n)
last code = n
cp = cp+1; cbuf(cp) = n
ca = ca+2
flush(cbuf,cp,ca) %if cp=limit
%end
%routine gput(%integer n)
gp = gp+1; gbuf(gp) = n
ga = ga+2
flush(gbuf,gp,ga) %if gp=limit
%end
%routine plug gla(%integer what,where)
flush(gbuf,gp,where) %if gp#0
gbuf(0) = where
gbuf(1) = what
gp = 1
flush(gbuf,gp,ga)
%end
%routine locate(%integer at)
flush(cbuf,cp,at) %if cp#0
cbuf(0) = at
ca = at
%end
%routine plug code(%integer what)
%if cp#0 %start
cbuf(cp) = what
%finish %else %start
locate(ca-2)
cput(what)
%finish
%end
%routine load module(%integer base)
%integer cb,gb,key,n,index,line,mod
%record (tabfm) %name t
%switch s(1:12)
cb = ca; gb = ga; mod = 0
%cycle
readch(key)
->s(key)
s(1): get(n); cput(n+mod); mod = 0; %continue
s(2): get(n); gput(n+mod); mod = 0; %continue
s(7): get(index)
t == table(index+base)
%if t_type&plug bit#0 %start
%if last code#k'004737' %start; !JSR_PC,#???
error("Cannot fixup ".t_text)
t_type = 0
%finish
plug code(k'004777'); !JSR_PC,@#???
mod = mod-ca-2
%finish
mod = mod+t_addr
%continue
s(4): get(n); get(index)
plug gla(n+cb,index+gb)
%continue
s(5): get(n); locate(n+cb); %continue
s(9): mod = mod+cb; %continue
s(10): mod = mod+gb; %continue
s(11): mod = mod-ca-2; %continue
s(6): get(line)
%repeat
s(8): get(n); n = n+cb; !EVENT CHAIN?
readch(n); readch(n); readch(n)
%end
%routine header
%integer total ca,j,g
%routine strip(%integer seg)
%routine add(%integer %name n)
n = n-8*1024
%if n>=0 %then cput(8*1024) %else cput(n+8*1024)
%end
%if total ca>0 %start
cput(5); add(total ca)
%finish %else %start
%if ga>0 %and seg>=g %start
cput(6); add(ga)
%finish %else %start
cput(4); cput(0)
%finish
%finish
%end
total ca = ca-codebase
ga = sp-glabase
g = glabase>>13
locate(0)
!
task id = task id." "
cput(charno(task id,1)+charno(task id,2)<<8)
cput(charno(task id,3)+charno(task id,4)<<8)
cput(sp); !INITIAL SP
cput(4); cput(0); !SEG 0
cput(7); cput(0); !SEG 1
strip(2); !SEG 2
strip(3); !SEG 3
strip(4); !SEG 4
strip(5); !SEG 5
strip(6); !SEG 6
cput(6); cput(streams*x'280'+x'140'); !SEG 7
locate(code base)
%cycle j = 1,1,8
cput(0)
%repeat
%end
%routine reset(%integer c,g)
flush(cbuf,cp,ca) %unless cp=0
flush(gbuf,gp,ga) %unless gp=0
cbuf(0) = c; ca = c
gbuf(0) = g; ga = g
%end
%routine load(%integer modules)
%integer flag,base,no,use
no = file no
use = used(no)
base = refs
prepare specs(use,flag)
file no = file no+1 %and load(modules-1) %if modules>1
reset(filecode(no),filegla(no))
%if flag#0 %or use=0 %start
skip module
%finish %else %start
load module(base)
%finish
%end
%routine get module(%integer %name codesize,glasize)
%integer n
get(n); !NO OF DEFINITIONS
%while n>0 %cycle
n = n-1
get def
%repeat
get(n); !NO OF REFERENCES
speclist(file no) = refs
specs(file no) = n
%while n>0 %cycle
n = n-1
get spec
%repeat
get(code size)
get(gla size)
%end
%routine examine(%integer modules)
%cycle
file no = file no+1
file(file no) = file name; file name = ""
get module(file code(file no),file gla(file no))
modules = modules-1
%return %if modules=0
%repeat
%end
%routine fill refs
%record (tabfm) %name r
%integer ref,def
%return %if refs=0 %or defs=0
%cycle ref = 1,1,refs
r == table(ref)
%cycle def = max table,-1,defs
%if table(def)_text=r_text %start
r_index = table(def)_index
%exit
%finish
%repeat
%repeat
%end
%routine mark(%integer module index)
%integer p,n,c,g
%return %if module index=0 %or used(module index)#0
used(module index) = 1
c = ca
ca = ca+file code(module index)
file code(module index) = c
g = ga
ga = ga+file gla(module index)
file gla(module index) = g
p = spec list(module index)
n = specs(module index)
%while n>0 %cycle
n = n-1
p = p+1
mark(table(p)_index)
%repeat
%end
%routine fix addresses
%integer j,b
%record (tabfm) %name t
%return %if defs>max table
%cycle j = defs,1,max table
t == table(j)
%if t_type&1#0 %then b = file gla(t_index) %else %c
b = file code(t_index)
t_addr = t_addr+b
%repeat
%end
%routine handle fixups(%string (63) fix file)
%string (63) fixup
%integer sym,j,at,n
%record (tabfm) %name t
%routine readsym
readsymbol(sym) %until sym#' '
sym = sym-32 %if 'a'<=sym<='z'
%end
%routine read octal(%integer %name n)
%integer j
%if sym='@' %then at = plug bit %and readsym %else at = 0
n = 0
%cycle j = 1,1,6
%exit %unless '0'<=sym<='7'
n = n<<3+(sym-'0')
readsym
%return %if sym=nl
%repeat
error("Bad address for fixup ".fixup)
%end
!
%return %if fix file=""
%if exist(fixfile)=0 %start
printstring(fixfile." does not exist"); newline
%return
%finish
define("ST2,".fixfile); selectinput(2)
%cycle
read word(fixup); %exit %if fixup=".END"
readsym
%if sym#'=' %start
error("No = in fixup for ".fixup)
%finish %else %start
readsym; read octal(n)
defs = defs-1; t == table(defs)
t_text = fixup; t_index = 0; t_addr = n; t_type = 128!at
%cycle j = max table,-1,defs
%exit %if table(j)_text=fixup
%repeat
defs = defs+1 %if j#defs
%finish
readsym %while sym#nl
%repeat
selectinput(1); close stream(2)
%end
%routine get octal(%integer %name n)
%integer s
n = 0
readsymbol(s) %until '0'<=s<='7'
%cycle
n = n<<3!(s-'0')
readsymbol(s)
%return %unless '0'<=s<='7'
%repeat
%end
%routine process(%string (63) file)
file name = file
%return %if file=""
%if exist(file name)=0 %start
file name = file name."#REL"
%if exist(file name)=0 %start
printstring(file." does not exist"); newline
%return
%finish
%finish
define("ST2,".file name)
select input(2)
get(module count)
examine(module count)
select input(1)
close stream(2)
%end
!
map = ".OUT" %unless param->param.("/").map %or param->param.(",").map
param = ".IN" %if param=""
define("ST1,".param)
%cycle j = 1,1,max files
used(j) = 0
%repeat
table(0) = 0; filecode(0) = 0; filegla(0) = 0
ca = code base+16; ga = 16; !LEAVE SPACE FOR ENTRY INSTRUCTIONS
errors = 0
file no = 0
refs = 0; defs = max table-4
!
select(0)
selectinput(1)
%cycle
prompt("Link: ")
read word(file name)
%if charno(file name,1)='.' %start
%exit %if file name=".END"
%if file name=".STACK" %start
get octal(stack); %continue
%finish
%if file name=".NAME" %start
prompt("Task name:")
read word(file name)
length(file name) = 4 %if length(file name)>4
task id = file name
%continue
%finish
%if file name=".FIXUP" %start
read word(fix file)
handle fixups(fix file)
%continue
%finish
%if file name=".ENTRY" %start
prompt("Entry point: "); get octal(main ep)
entry = 1
file name = ".ALONE"
%finish
%if file name=".ALONE" %start
prompt("Start of store:"); get octal(code base)
prompt(" End of store:"); get octal(sp base)
ca = code base; ga = 0
alone = 1
brians fiddle = 0
%continue
%finish
%if file name=".STREAMS" %start
get octal(streams); %continue
%finish
%if file name=".NOLIB" %start
lib file = ""
%continue
%finish
%if file name=".NOPERM" %start
perm file = ""; %continue
%finish
printstring("Unknown keyword ".file name)
newline
%continue
%finish
process(file name)
%repeat
perm = 1
process(lib file)
process(perm file)
%return %if errors#0
cp = 0; gp = 0; gbuf(0) = ga
table(xtop)_addr = ca+2; !CODE TOP
!!!HANDLE FIXUPS(FIX FILE)
fill refs
ca = code base
%if entry#0 %start
mark(1); !LOAD THE MAIN PROGRAM
%finish %else %start
ca = code base+16 %if alone=0
main ep = ca
error("No main entry point!") %if perm ep=0
mark(perm ep); !LOAD $GO$
%finish
table(xgo)_addr = 0
sp = spbase&(\1)
glabase = ca
glabase = (7<<13-ga-stack)&k'160000' %if alone=0
ds = (glabase+ga+7)&(\7)
sp = (ds+stack)&(\1) %if alone=0
table(xsp)_addr = sp
error("No space for stack") %if sp>spbase %or ds>=sp
%cycle j = 0,1,file no
file gla(j) = file gla(j)+gla base
%repeat
table(xds)_addr = ds
table(xevent)_addr = ca-2
fix addresses
prompt("Object: ")
read word(object)
define("ST3,".object)
task id = object %if task id=""
select(3)
header %if alone=0
file limit = file no
file no = 0
%while file no<file limit %cycle
file no = file no+1
file name = file(file no)
%if file name="" %start
error("Linker phase error!!!"); %return
%finish
define("ST2,".file name)
select input(2)
get(module count)
refs = 0
load(module count)
select input(1)
close stream(2)
%repeat
flush(gbuf,gp,ga) %if gp#0
locate(main ep)
flush(cbuf,cp,ca)
%return %if errors#0
select output(0)
printstring("Linking complete"); newline
define("ST2,".map); select output(2)
!MAP
newline
ca = 0; ga = 0
%cycle j = max table,-1,defs
t == table(j)
%if t_type&32#0 %start
%if ca&3=0 %then newline %else spaces(ga)
ca = ca+1
octal(t_addr)
space
printstring(t_text)
ga = 12-length(t_text)
%finish
%repeat
newline
newline
%cycle j = 1,1,file no
%continue %if used(j)=0 %or file(j)=""
octal(file code(j)); space
octal(file gla(j)); space
printstring(file(j))
newline
%repeat
newline
printstring("SP = "); octal(sp); newline
printstring("DS = "); octal(ds); newline
%end
%end %of %file