!
! Linker for DEIMOS
!
! Takes PSR relocatable format object files
! and produces absolute loader format file.
!
! Adapted by Mark Taunton, 80/81, from
! original program by Peter S. Robertson.
!
! CCUTIL comments: D - DEIMOS E - EMAS V - VMS
!
! System-dependent configuration parameters
!V! %const %integer tty type = 1; ! Value from IN TYPE
{DE}%const %integer tty type = 0
!V! %const %integer fatal = 16_1000002c; ! Error code to EXIT (VMS)
!V! %const %integer max f = 127; ! Length of file name
!D! %const %integer max f = 12
{E} %const %integer max f = 31
!V! %const %integer max clp = 127; ! Max size of CLIPARAM
!D! %const %integer max clp = 79
{E} %const %integer max clp = 255
{VE}%const %integer max table = 511; ! No. of symbols
!D! %const %integer max table = 450
{VE}%const %integer max modules = 250; ! No. of modules examined
!D! %const %integer max modules = 150
{VE}%const %integer max files = 40; ! No. of files opened
!D! %const %integer max files = 20
!V! %own %string(maxf) dflt com = "U1:[MT.11.DEIMOS]LINKDEFS"
!D! %own %string(maxf) dflt com = "0.LKDEFS(77)"
{E} %own %string(maxf) dflt com = "ERCM11.IMP11PD_LINKDEFS"
{E} %own %string(1) cmd sep = ":"
!V! %own %string(1) cmd sep = " "
!D! %own %string(3) cmd sep = ";: "
%const %integer max lib = 6; ! allowable library defs
%const %integer max fix = 4; ! allowable fix-up files
! Stream defs - compatible across all machines.
! Note that on EMAS open input and output streams
! must have unique numbers (except for 0 = TTY)
%const %integer tty in = 0
%const %integer com in = 1
%const %integer obj in = 2
%const %integer report = 0
%const %integer obj out = 3
%const %integer map out = 3
!V! %system %routine %spec EXIT (%integer status)
!V! %external %routine %spec PRINT RECORD (%integer n, start)
{VE}%external %routine %spec SET DEFAULT (%string(127) def)
!DV!%external %string(maxf) %function %spec EXPAND (%string(127) file)
!DV!%external %string(max clp) %function %spec CLI PARAM
!DV!%external %string(127) %function %spec SYS MESS (%integer errno)
!DV!%external %string(maxf) %function %spec BASE NAME (%string(127) file)
{E} %external %integer %function %spec IN TYPE
{E} %external %integer %function %spec OUT TYPE
{E} %external %string(maxf) %function %spec OUT FILE NAME
{E} %external %string(maxf) %function %spec IN FILE NAME
{E} %include "ECSC17.IMP77SPECS"
!DV!%begin
{E}%external %routine LINK11 (%string(255) cliparam)
! Maximum values
%const %integer max streams = 10; ! permitted task stream buffers
%const %integer max text = 10; ! Sig chars in symbol
%const %integer buff limit = 128; ! Code/gla buffer size
! Segment 7 sizes: dependent on I/O package
%const %integer seg 7 base = 600; ! required area of seg 7 with 0 streams
%const %integer seg 7 sb = 570; ! bytes per extra stream block
%const %integer seg 7 min = 180; ! Minimum size of Seg 7 (no .TT)
! Linker modes
%const %integer init = 0
%const %integer user = 1
! Possible command sources
%const %integer tty = 1
%const %integer cline = 2
%const %integer cqual = 3
%const %integer cfile = 4
! ERROR numbers
%const %integer inconsistent = 1
%const %integer duplicate = 2
%const %integer unsat ref = 3
%const %integer indirect fail = 4
%const %integer no equals = 5
%const %integer bad address = 6
%const %integer last error = 6
! COMMAND ERROR numbers
%const %integer param too long = 1
%const %integer bad oct val = 2
%const %integer unknown key = 3
%const %integer ambiguous key = 4
%const %integer no file = 5
%const %integer invalid streams = 6
%const %integer no tty streams = 7
%const %integer bad dec val = 8
%const %integer bad seg = 9
%const %integer bad fixup = 10
%const %integer last com error = 10
! CRASH numbers
%const %integer file err = 1
%const %integer sym tab ovf = 2
%const %integer mod tab ovf = 3
%const %integer file tab ovf = 4
%const %integer com EOF = 5
%const %integer in EOF = 6
%const %integer no modules = 7
%const %integer bad output = 8
%const %integer bad ext ref = 9
%const %integer no main ep = 10
%const %integer prog too big = 11
%const %integer no qual val = 12
%const %integer bad qual val = 13
%const %integer x qual val = 14
%const %integer bad qual = 15
%const %integer bad filename = 16
%const %integer lib tab ovf = 17
%const %integer fix tab ovf = 18
%const %integer seg error = 19
%const %integer errs = 20
%const %integer corrupt obj = 21
%const %integer last crash = 20
! Table element types
%const %integer ref = 0
%const %integer def = 1
! Flags OR'ed in with type param to GET RECORD
%const %integer insert = 64
%const %integer satisfy = 128
! Segment type magic numbers (for header)
%const %integer No Access = 4
%const %integer Read Only = 5
%const %integer Read Write = 6
%const %integer Shared = 7
! Segment access modes
%const %string(10) %array seg mode (No access : Shared) =
"No Access", "Read Only", "Read/Write", "Shared"
! Mask for TYPE field of symbol table entry
%const %integer type mask = 7
%const %string(4) %array types (0 : 7) =
" -- ", "Glap", "Code", "Glap",
"Code", "Glap", "????", "????"
! Flags in top of TYPE field (internal)
%const %integer plug bit = 64
%const %integer used bit = 32
! Actions for the MARK routine
%const %integer get sizes = 1
%const %integer set adr = 2
! 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 xstrms = max table - 4
%const %integer last predef = xstrms
%record %format tabfm (%integer addr, index, %c
%byte type, %string(max text) text)
%record %format filefm (%integer m base, n mod, load, %c
%string(maxf) name)
%record %format modfm (%integer code, gla, nrefs, ref base, %c
%byte use, srce)
%record(tabfm) %array table (0 : max table)
%record(modfm) %array m tab (0 : max modules)
%record(filefm) %array file (0 : max files)
%ownstring(maxf) perm file = ""
%string(maxf) %array lib file (1 : max lib)
%string(maxf) %array fix file (1 : max fix)
%integer %array seg type, seg len (0 : 7)
%own %integer monf = 0; ! diagnostic control
%own %integer Brians fiddle = 255; ! tweak header checksum
%own %integer code base = 0, event ad, sp
%own %integer end store = 7<<13; ! end of seg 6 by default
%own %integer dummy; ! for poking at..
%own %integer records = 0, mode, pass
%own %integer last user file = 0, stack flag = 0
%own %integer alone = 0, main ep = -1, entry = 0
%own %integer stack = 1024, streams = 2
%own %integer errors = 0, stream, refs, defs
%own %integer last code = 0, ca = 0, ga = 0
%own %integer nlib = 0, nfix = 0
%own %integer file no = 0, mdl no = 0, file limit
%own %integer clmap = 0, clobj = 0; ! Override def flags
%own %integer perm = 0, perm ep = 0
%own %integer impure = 0, ep module
%own %integer source = cline
%own %integer code size, data size, stack size
%own %string(4) task id = " "
%own %integer task = 0
%own %integer prog mode = 2, io mode = 1
%own %string(max text) imp entry, entry ref = "IMP$IN"
%own %string(max text) imp exit, exit ref = "IMP$OUT"
%own %string(maxf) com file
%string(maxclp) keyword, qvalue
%own %string(127) reason
%string(maxf) object, map
%own %record(tabfm) sym
%own %record(filefm) %name this file
%own %record(tabfm) %name sym2, t
%const %integer max key = 8, last key = 25
%const %string(max key) %array keys (1 : last key) =
"STACK", "NAME", "FIXUP", "IMPURE", "PURE",
"ENTRY", "ALONE", "STREAMS", "NOLIB", "NOPERM",
"OBJECT", "MAP",
"NOIO", "NOTTY", "NOSETUP", "SETUP","PROGRAM",
"MAXSTACK", "PERM", "LIBRARY",
"SHARE", "NOSHARE", "CODEBASE", "DEFINE", "MONITOR"
! # 0 => may be a qualifier on command line (without '.'), 2 => has value
%const %byte %array qual key (1 : last key) =
2, 2, 0, 1, 1,
0, 0, 2, 0, 0,
0, 0,
1, 1, 1, 1, 1,
1, 0, 0,
0, 1, 0, 0, 1
%routine OCTAL (%integer w)
%integer p
w = w & 16_FFFF
print symbol (w>>p&7+'0') %for p = 15, -3, 0
%end
%routine MON (%string(127) mess)
select output (report)
print string (mess)
newline
select output (stream)
%end
%routine ERROR (%integer what)
%switch e (1 : last error)
select output (report)
print string ("* ")
-> e (what)
e(inconsistent): print string ("Inconsistent use of """); -> conflict
e(duplicate): print string ("Duplicate definition of """)
conflict: print string (sym_text); print symbol ('"')
newline; print string ("Occurence 1: ")
print string (file(mtab(sym2_index)_srce)_name)
newline; print string ("Occurence 2: ")
print string (this file_name); -> out
e(unsat ref): print string ("File "); print string (this file_name)
print string (" references undefined symbol "); -> psym
e(no equals): print string ("No '=' in fixup for symbol "); -> psym
e(bad address): print string ("Invalid address for fixup of "); -> psym
e(indirect fail):print string ("Unable to indirectly reference symbol ")
psym: print symbol ('"'); print string (sym_text);
print symbol ('"')
out:
newline
errors = errors + 1
select output (stream)
%end
%routine COM ERROR (%integer what)
%switch r (1 : last com error)
%if source # tty %start
print string ("** Command ")
%if source = cfile %then print string ("file") %c
%else print string ("line")
print string (" error -- ")
%finish
-> r (what)
r(param too long): print string ("Parameter too long"); -> out
r(bad fixup): print string ("Bad syntax for definition of symbol """)
print string (sym_text); print symbol ('"'); -> out
r(bad seg): print string ("Invalid seg. number for .SHARE"); -> out
r(bad oct val):
r(bad dec val): print string ("Invalid")
print string (" octal") %if what = bad oct val
print string (" constant"); -> out
r(unknown key): print string ("Unknown"); -> key
r(ambiguous key): print string ("Ambiguous")
key: print string (" keyword ""."); print string (keyword)
print symbol ('"'); -> out
r(no file): print string ("File "); print string (reason)
print string (" does not exist"); -> out
r(invalid streams):print string ("Invalid number of streams"); -> out
r(no tty streams): print string (".STREAMS not allowed with .NOTTY/.NOIO")
out:
newline
%if source = cfile %start
print string ("Source of error is ")
print string (com file)
new line
%finish
%monitor %if monf # 0
!V! exit (fatal) %if source # tty
{DE} %stop %if source # tty
%end
%routine CRASH (%integer why)
%switch x (1 : last crash)
select output (report)
%if mode = init %start
print string ("** Linker initialisation failure - seek help **")
newline; print string (" -- ")
%finish %else %start
print string ("** Linker fails -- ")
%finish
-> x (why)
x(bad output): print string ("unable to create output file"); -> nptext
x(file err): print string ("error opening input file"); -> nptext
x(bad filename): print string ("invalid filename "); -> ptext
nptext: newline
ptext: print string (reason); -> out
x(sym tab ovf): print string ("symbol"); -> tab ovf
x(mod tab ovf): print string ("module"); -> tab ovf
x(file tab ovf): print string ("file"); -> tab ovf
x(fix tab ovf): print string ("fix file"); -> tab ovf
x(lib tab ovf): print string ("library")
tab ovf: print string (" table overflow"); -> pfile
x(com EOF):
x(in EOF): print string ("unexpected EOF ")
%if why = in EOF %start
print string ("while loading object file")
-> pfile
%finish
print string ("from command stream"); -> out
x(no modules): print string ("no modules to load!"); -> out
x(no main ep): print string ("no main entry point found"); -> out
x(no qual val): print string ("value required"); -> pqual
x(bad qual val): print string ("invalid value given"); -> pqual
x(x qual val): print string ("value not allowed")
pqual: print string (" for "); print string (keyword)
print string (" qualifier"); -> out
x(bad qual): print string ("unknown qualifier keyword """)
print string (keyword); print symbol ('"'); -> out
x(prog too big): print string ("program is too big!!"); -> out
x(errs): write (errors, 0); print string (" error")
print symbol ('s') %if errors # 1
print string (" detected"); -> out
x(bad ext ref): print string ("invalid reference - ")
x(corrupt obj): print string ("object file is corrupt")
pfile: newline
print string ("Current input file is ")
print string (in file name)
out:
newline
%monitor %if monf # 0
!V! exit (fatal)
{DE} %stop
%end
! File handling utilities
%routine OPEN (%integer streamno, %string(*) %name file, %string(4) ext)
{E} %string(maxf) x1, x2
%string(maxf) filename
%on 9 %start
{E} reason = filename . " --" . event_message
!DV! reason = file name . " -- " . sys mess (event_extra)
crash (file err) %if source # tty
select output (report)
print string (reason); newline
file = ""; ! Mark failure
%return
%finish
%return %if file = ""
filename = file
!V! ext = ".".ext
{E} ext = "#".ext
{VE} set default (ext)
!DV! filename = expand (file)
open input (streamno, filename)
select input (stream no)
file = in file name; ! Full filename returned
%end
%routine SELECT (%integer st)
stream = st
select output (stream)
%end
! Text input stuff
%routine SKIP LINE
skip symbol %while next symbol # nl
skip symbol
%end
%routine READ WORD (%string(*) %name s, %integer max)
%integer sym
%on 9 %start
s = ""
%return
%finish
%cycle
s = ""
skip symbol %while %not ' ' # next symbol # nl
%cycle
%return %if next symbol = ' ' %or next symbol = nl
read symbol (sym)
%exit %if s = "" %and sym = '!'; ! Comment
sym = sym - 'a' + 'A' %if 'a' <= sym <= 'z'
%if length(s) = max %start; ! Too long!
com error (Param too long)
%exit
%finish
s = s . tostring (sym)
%repeat
skip line
%repeat
%end
%routine GET WORD (%string(*) %name s, %integer max)
%if source = cqual %start
com error (Param too long) %if length(qvalue) > max
s = qvalue
%finish %else %start
read word (s, max)
crash (com EOF) %if s = ""
%finish
%end
%routine GET OCTAL (%integer %name n)
%integer c, p, len
%on 9 %start
crash (com EOF)
%finish
n = 0
%if source = cqual %start
len = length(qvalue)
error (no qual val) %if len = 0
%for p = 1, 1, len %cycle
c = charno (qvalue, p)
crash (bad qual val) %unless '0' <= c <= '7' %and p <= 6
n = n <<3 ! (c - '0')
%repeat
%finish %else %start; ! read from terminal/file
%cycle
skip symbol %while %not ' ' # next symbol # nl
read symbol (c)
%exit %if '0' <= c <= '7'
com error (bad oct val)
skip line
%repeat
%cycle
n = n<<3 ! (c - '0')
read symbol (c)
%return %unless '0' <= c <= '7'
%repeat
%finish
%end
%routine GET NUMBER (%integer %name n)
!
! Read a (decimal) number from the input stream,
! catching symbol-in-data and EOF errors...
!
%integer len, c, p
%on 9, 3 %start
{E} set event
crash (com EOF) %if event_event = 9
com error (bad dec val)
skip line
%finish
%if source = cqual %start
len = length(qvalue)
crash (no qual val) %if len = 0
%for p = 1, 1, len %cycle
c = charno(qvalue, p)
crash (bad qual val) %unless '0' <= c <= '9' %and p <= 5
n = n * 10 + c - '0'
%repeat
%finish %else %start
read (n)
%finish
%end
! Symbol manipulation
%integer %function FIND (%integer type, %string(*) %name text)
%integer lim, n, inc
%if type = ref %start
n = 1; lim = refs + 1; inc = 1
%finish %else %start
n = max table; lim = defs - 1; inc = -1
%finish
crash (sym tab ovf) %if defs - 1 <= refs; ! Would overwrite
table(lim)_text = text; ! Be sure to find it
n = n + inc %while table(n)_text # text; ! go hunting..
%result = -1 %if n = lim; ! Not found
%result = n
%end
%routine ENTER (%integer type, %record(tabfm) %name t)
%integer n
%if type = ref %start
refs = refs + 1
n = refs
t_index = 0
%finish %else %start
defs = defs - 1
n = defs
t_index = mdl no
%if t_text = "$GO$" %start
perm ep = mdl no
t_type = t_type!used bit
%finish
%finish
crash (sym tab ovf) %if refs = defs
table (n) = t
%end
%integer %function WORD
%integer s1, s2
!V! read symbol (s1); read symbol (s2)
{DE} read ch (s1); read ch (s2)
%result = s1 + s2<<8
%end
%routine GET RECORD (%integer flags)
%integer type, mode, j, n, s
%record(tabfm) %name x
type = flags & 7; mode = flags - type
%if type = ref %then sym_addr = 0 %c
%else sym_addr = word
!V! read symbol (sym_type); read symbol (n)
{DE} read ch (sym_type); read ch (n)
%for j = 1, 1, n %cycle
!V! read symbol (s)
{DE} read ch (s)
charno (sym_text, j) = s %if j <= max text
%repeat
n = max text %if n > max text
length(sym_text) = n
%if pass = 2 %and type = ref %start
%if sym_text = entry ref %start
sym_text = imp entry
%finish %else %if sym_text = exit ref %start
sym_text = imp exit
%finish
%finish
n = find (type, sym_text)
%if n >= 0 %start; ! In already
sym2 == table(n)
%if type = ref %start
j = sym2_type & type mask
error (inconsistent) %if pass = 1 %and j # sym_type %and %c
j # 0 # sym_type
%finish %else %start; ! MUL DEF
error (duplicate) %if perm = 0
%return
%finish
%finish
%if mode & satisfy # 0 %start; ! Fill in reference
n = find (def, sym_text)
%if n < 0 %start
error (unsat ref)
%finish %else %start
x == table(n)
sym_addr = x_addr; sym_type = x_type
x_type = x_type ! used bit
%finish
%finish
enter (type, sym); ! Put it in
%end
%routine GET GROUP (%integer mode, %integer %name count)
%integer n
n = word; count = n
%cycle
n = n - 1
%return %if n < 0
get record (mode)
%repeat
%end
%routine PREPARE SPECS (%integer loading, %integername flag)
%integer mode
flag = errors
get group (def, dummy)
mode = ref
mode = ref ! insert ! satisfy %if loading # 0
get group (mode, dummy)
flag = errors - flag
dummy = word; ! code size
dummy = word; ! gla size
%end
%routine GET MODULE (%record(modfm) %name m)
%integer n
get group (def ! insert, dummy)
m_ref base = refs
get group (ref ! insert, n)
m_n refs = n
m_code = word
m_gla = word
%end
! User input processing
%routine GET DEFS
%integer ch, j, at, adr
%on 9 %start
crash (com EOF)
%finish
%routine READSYM
read symbol (ch) %until ch # ' '
ch = ch - 32 %if 'a' <= ch <= 'z'
%end
%integerfn READ OCTAL
%integer j
%if ch = '@' %then at = plug bit %and readsym %c
%else at = 0
adr = 0
%for j = 1, 1, 6 %cycle
%result=0 %unless '0' <= ch <= '7'
adr = adr<<3+(ch-'0')
readsym
%result=1 %if ch = nl
%repeat
%result=0
%end
prompt ("Define: ")
%cycle
read word (sym_text, max text)
%exit %if sym_text = "" %or sym_text = ".END" %or %c
sym_text = ".ENDDEF"
readsym
%if ch = '=' %start
readsym
%if read octal=1 %start
j = find (def, sym_text)
%if j < 0 %start; ! Not otherwise defined
sym_index = 0
sym_addr = adr; sym_type = at
enter (def, sym)
%finish
%continue
%finish
%finish
com error (bad fixup)
readsym %while ch # nl
%repeat
%end
%routine HANDLE FIXUPS
%integer j
%return %if nfix = 0
source = cfile
%for j = nfix, -1, 1 %cycle; ! Reverse order
com file = fixfile(j)
open (com in, com file, "FIX")
get defs
%repeat
%end
%routine PROCESS (%string(*) %name obj file)
%record(modfm) %name mod
%integer modules
%on 9 %start
crash (in EOF)
%finish
open (obj in, obj file, "REL")
%return %if obj file = ""
file no = file no + 1
crash (file tab ovf) %if file no > max files
this file == file(fileno)
this file_name = obj file
modules = word
this file_m base = mdl no + 1
this file_n mod = modules
%cycle
modules = modules - 1
%exit %if modules < 0
mdl no = mdl no + 1
crash (mod tab ovf) %if mdl no > max modules
mod == m tab(mdl no)
mod_srce = file no
get module (mod)
%repeat
close input
select input (com in)
%end
%routine FILL REFS
%record(tabfm) %name rr
%integer r, i
%for r = 1, 1, refs %cycle
rr == table(r)
i = find (def, rr_text)
%if i >= 0 %start
rr_index = table(i)_index
%finish
%repeat
%end
%routine MARK (%integer module index, mark action)
%integer r, c, g, n
%record(modfm) %name m; m == m tab(module index)
%record(tabfm) %name t
%return %if module index = 0 %or m_use = mark action
m_use = mark action
c = ca; ca = ca + m_code
g = ga; ga = ga + m_gla
%if mark action = set adr %start
m_code = c
m_gla = g
%finish
r = m_ref base; n = m_n refs
%cycle
n = n - 1
%exit %if n < 0
r = r + 1
t == table(r)
mark (t_index, mark action)
%repeat
%end
%routine FIX ADDRESSES
%integer j, b
%record(tabfm) %name t
%record(modfm) %name m
mark (ep module, set adr)
%for j = defs, 1, max table %cycle
t == table(j); m == m tab(t_index)
%if t_type & 1 # 0 %then b = m_gla %c
%else b = m_code
t_addr = t_addr + b
%repeat
%end
%routine FIX NAMES
%record(tabfm) %name t
%routine MODIFY (%string(*)%name from, to)
%integer n
%cycle
n = find (ref, from)
%return %if n < 0
t == table(n)
t_text = to
%repeat
%end
! Set up requested program entry mode
! i.e. Change all refs to IMP$IN/OUT to refer to appropriate entry
%if prog mode < 3 %start
imp entry = "IMP$GO?"
charno(imp entry, 7) = prog mode+'0';! IMPGO? => IMPGO0, IMPGO1 etc
%finish %else %start
imp entry = "PROGRAM"; ! from .PROGRAM qualifier
%finish
imp exit = "IMP$STOP1"
charno(imp exit, 9) = '0' %if io mode = 0; ! No clean up req'd
modify (entry ref, imp entry)
modify (exit ref, imp exit)
%end
%integer %function FIND KEYWORD
%string(max key) extra1, extra2
%integer n, err, k, j
n = 0; err = unknown key
%if length(keyword) <= max key %start
j = 1
%cycle
%if keys(j) -> extra1 . (keyword) . extra2 %and extra1 = "" %start
n = n + 1; k = j
%exit %if extra2 = ""
%finish
j = j + 1
%repeat %until j > last key
keyword = keys(k) %and %result = k %if n = 1
err = ambiguous key
%finish
%result = -err
%end
%routine HANDLE KEYWORD (%integer n)
%string(127) text
%switch key (1 : last key)
%integerfn GET FILE (%string(21) prmpt, %string(4) ext)
prompt (prmpt)
get word (text, maxf)
open (obj in, text, ext)
select input (com in)
%result=0 %if text = ""
%result=1
%end
-> key (n)
key(1): ! .STACK
prompt ("Stack size: ")
get number (stack size)
stack flag = 0
%return
key(2): ! .NAME
prompt ("Task name: ")
get word (text, 4)
task = 1; task id = text; %return
key(3): ! .FIXUP
%if get file ("Fix file: ", "FIX")=1 %start
nfix = nfix + 1
crash (fix tab ovf) %if nfix > max fix
fix file(nfix) = text
%finish
%return
key(4): ! .IMPURE
impure = 1; %return
key(5): ! .PURE
impure = 0; %return
key(6): ! .ENTRY
prompt (" Entry point: ")
get octal (main ep)
entry = 1; ! Drop through to....
key(7): ! .ALONE
prompt ("Start of store: "); get octal (code base)
prompt (" End of store: "); get octal (end store)
alone = 1; Brians fiddle = 0; %return
key(8): ! .STREAMS
%if io mode = 0 %start; ! ??? NO IO ???
com error (no tty streams)
%return
%finish
prompt ("No. of streams: ")
get number (n)
%unless 0 <= n <= max streams %start
com error (Invalid streams)
%finish %else %start
streams = n
%finish
%return
key(9): ! .NOLIB
nlib = 0
lib file(n) = "" %for n = 1, 1, max lib; %return
key(10): ! .NOPERM
perm file = ""; %return
key(11): ! .OBJECT
prompt ("Object file: ")
get word (text, maxf)
object = text %if clobj = 0 %or source # cfile; ! Over-ride ?
%return
key(12): ! .MAP
prompt ("Map file: ")
get word (text, maxf)
map = text %if clmap = 0 %or source = tty
%return
key(13): ! .NOIO
io mode = 0; %return; ! => minimal seg 7 size
key(14): ! .NOTTY
io mode = 0
key(15): ! .NOSETUP
key(16): ! .SETUP
key(17): ! .PROGRAM
prog mode = n - 14; %return
key(18): ! .MAXSTACK
stack flag = 1; %return
key(19): ! .PERM
%if get file ("Perm file: ", "REL")=1 %start
perm file = text
%finish
%return
key(20): ! .LIBRARY
%if get file ("Library: ", "REL")=1 %start
nlib = nlib + 1
crash (lib tab ovf) %if nlib > max lib
lib file(nlib) = text
%finish
%return
key(21): ! .SHARE
prompt ("Segment: "); get number (n)
com error (bad seg) %and %return %unless 0 <= n <= 6; ! segment??
seg type(n) = Shared
%return
key(22): ! .NOSHARE
seg type(n) = 0 %for n = 0, 1, 7
%return
key(23): ! .CODEBASE
get octal (code base); %return
key(24):
get defs; %return
key(25): ! .MONITOR
monf = \monf
%end
%routine HANDLE QUALIFIERS (%string(*) %name qualifiers)
%integer n, k, eq
%string(maxclp) qual
qualifiers = qualifiers . ","
source = cqual
%cycle
qualifiers -> qual . (",") . qualifiers
%if qual # "" %start
eq = 0; qvalue = ""
eq = 1 %if qual -> qual . ("=") . qvalue
crash (bad qual val) %if eq # 0 %and qvalue = ""
keyword = qual
k = find keyword
crash (bad qual) %if k < 0
n = qual key(k);
crash (bad qual) %if n = 0
crash (x qual val) %if qvalue # "" %and n = 1
crash (no qual val) %if qvalue = "" %and n = 2
handle keyword (k)
%finish
%repeat %until qualifiers = ""
%end
%routine HANDLE PARAMETERS (%string(max clp) input)
%string(maxclp) param
%integer k
%string(maxclp) %function NEXT PARAMETER
%integer c, j
%string(maxclp) s
%cycle
s = ""
%if source # cline %start
prompt ("Link: ")
read word (s, maxclp)
%exit %if s # ""; ! Got a name/keyword
%finish
source = cline
%exit %if input = ""; ! That's the lot...
s = input %and input = "" %unless input -> s . (",") . input
%if s # "" %start
%for j = 1, 1, length(s) %cycle
c = charno(s,j)
charno(s,j) = c - 'a' + 'A' %if 'a' <= c <= 'z'
%repeat
%exit %if charno(s,1) # '@'
s -> ("@") . com file
open (com in, com file, "CMD")
%if com file # "" %start; ! File opened OK
source = cfile; source = tty %if in type = tty type
%finish
%finish
%repeat
%result = s
%end
%cycle
param = next parameter
%return %if param = ""
%if param = ".END" %start
%return %if input = "" %or source = tty
! Otherwise just end of current file
%finish %else %start
%if charno(param,1) = '.' %start
param -> (".") . keyword
k = find keyword
com error (-k) %if k < 0
handle keyword (k)
%finish %else %start
process (param)
%finish
%finish
%repeat
%end
%routine FIDDLE SIZES
%integer end code, round, ds, gla base, e, stack
ca = 0; ga = 0
ep module = perm ep
ep module = 1 %if entry # 0
mark (ep module, get sizes)
end code = code base + ca
event ad = end code - 2
round = 7; round = 8191 %if impure = 0
gla base = (end code + round) & (\round)
ds = (gla base + ga + 2) & (\1)
sp = (ds + stack size + 31) & (\31) - 2; ! Ensure (sp) mapped in
%if sp>>1 > end store>>1 {full stack not poss.} %or %c
stack flag # 0 {maximum possible stack} %start
sp = end store-2
%finish %else %start
stack = sp - ds
e = sp & 8_17777; ! Extension into segment
%if (stack>>2) // (e>>2) > 20 %start;! ie. < 5% overflow
sp = sp & (\e) - 2; ! To top of prev seg.
%finish
%finish
crash (prog too big) %if ds>>1 > sp>>1
table(xtop)_addr = code base; ! code top
table(xsp)_addr = sp
table(xds)_addr = ds
table(xevent)_addr = event ad
table(xstrms)_addr = streams
code size = event ad - code base
data size = ds - gla base
stack size = sp - ds; ! Actual stack available
ca = code base; ga = gla base
main ep = ca %if entry = 0; ! Start at $GO$
%end
%routine OPEN LOADFILE
%string(maxf) name
{E} %string(6) user
%on 9 %start
{E} reason = object . " --" . event_message
!DV! reason = object . " -- " . sysmess (event_extra)
crash (bad output)
%finish
%if object = "" %start
select input (com in); source = tty
prompt ("Object file: ")
get word (object, maxf)
%finish
!V! set default (".ABS")
{E} set default ("")
open output (obj out, object)
object = out file name
%if task = 0 %start
!DV! name = base name (object)
{E} name = object %unless object -> user . (".") . name
length(name) = 4
task id = name
%finish
select (obj out)
%end
%routine GENERATE LOAD FILE
%integer nmod
!DV! %own %short %array cbuf (-2 : buff limit)
!DV! %own %short %array gbuf (-2 : buff limit)
{E} %own %integer %array cbuf (-2 : buff limit)
{E} %own %integer %array gbuf (-2 : buff limit)
%own %integer cp = 0, gp = 0
!DV! %routine FLUSH (%short %array %name b,
!DV! %integer %name p, %integer new)
{E} %routine FLUSH (%integer %array %name b, %c
{E} %integer %name p, %integer new)
%integer check, w, bp, bc
check = 0; bc = p + p + 6
b(-2) = 1
b(-1) = bc
%for bp = -2, 1, p %cycle
w = b(bp)
check = check + w&255 + w>>8&255
%repeat
b(p+1) = (-check)&255 ! Brians fiddle
Brians fiddle = 0
!V! print record (bc+1, addr(b(-2)))
{DE} print ch (0) %for bp = 1, 1, 4
{DE} %for bp = -2, 1, p %cycle
{DE} w = b(bp); print ch (w&255); print ch (w>>8&255)
{DE} %repeat
{DE} print ch (b(p+1)&255)
p = 0
b(0) = new
records = records + 1
%end
%routine CPUT (%integer n)
last code = n
cp = cp + 1; cbuf(cp) = n
ca = ca + 2
flush (cbuf, cp, ca) %if cp = buff limit
%end
%routine GPUT (%integer n)
gp = gp + 1; gbuf(gp) = n
ga = ga + 2
flush (gbuf, gp, ga) %if gp = buff 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 HEADER
%integer e, t, end, seg
%routine SET SEG (%integer type, length)
%if seg type(seg) = Shared %start
crash (seg error) %if type # No Access
type = Shared
%finish
seg type(seg) = type
cput (type)
length = (length + 31) & (\31)
seg len(seg) = length
cput (length)
%end
locate (0)
cput (charno(task id,1)+charno(task id,2)<<8)
cput (charno(task id,3)+charno(task id,4)<<8)
cput (sp); ! initial SP
e = event ad; ! Address of last code word
seg = code base>>13
%if seg > 0 %start
set seg (No Access, 0) %for seg = 0, 1, seg-1
%finish
t = Read Only; ! Default for code seg
%cycle
end = e>>13
%if end > seg %start
set seg (t, 8 * 1024); ! whole segment used
%finish %else %if end = seg %start
%if t = Read Write %or impure = 0 %start
set seg (t, e - seg<<13); ! short seg
%finish %else %start
seg = seg - 1; ! re-jig this segment
%finish
e = sp; t = Read Write; ! - full access to rest of data
%finish %else %start
set seg (No Access, 0); ! Segment unused
%finish
seg = seg + 1
%repeat %until seg = 7
%if io mode = 0 %then t = seg 7 min %c
%else t = seg 7 base + streams * seg 7 sb
set seg (Read Write, t); ! I/O segment
cput (main ep); ! For new version of loader...
locate (code base)
%end
%routine SKIP MODULE
%integer s
%cycle
!V! read symbol (s) %until s = 16_e0; read symbol (s)
{DE} read ch (s) %until s = 16_E0; read ch (s)
%if s = 16_E0 %start
!V! read symbol (s)
{DE} read ch (s)
%return %if s = 16_E0
%finish
%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 MODULE (%integer base, max ref)
%integer cb, gb, key, n, index, line, mod
%record(tabfm) %name t
%switch s(1:11)
this file_load = this file_load + 1
cb = ca; gb = ga; mod = 0
%cycle
!DV! read symbol (key)
{E} read ch (key)
-> s (key) %if 1 <= key <= 11
s(3): crash (corrupt object)
s(1): n = word; cput (n+mod); mod = 0; %continue
s(2): n = word; gput (n+mod); mod = 0; %continue
s(7): index = word
%unless 0 < index <= max ref %start
crash (bad ext ref)
%finish
t == table(index+base); sym = t
%if t_type & plug bit # 0 %start
%if last code # 8_004767 %start; ! jsr pc,fred
error (indirect fail)
t_type = 0
%finish
plug code (8_004777); ! jsr pc,@fred
%finish
mod = mod + t_addr
%continue
s(4): n = word; index = word
plug gla (n+cb, index+gb)
%continue
s(5): n = word; 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): line = word
%repeat
s(8):
n = word; ! event chain?
skip symbol; skip symbol; skip symbol; ! 16_E0E0E0
%end
%routine LOAD (%integer modules)
%integer flag, use, base
%record(modfm) %name m
%own %integer need = 0
%on 9 %start
crash (in EOF)
%finish
mdl no = mdl no + 1
m == m tab(mdl no); use = m_use
base = refs
prepare specs (use, flag)
%if use # 0 = flag %start
need = need + 1
%finish %else %start
use = 0
%finish
load (modules-1) %if modules > 1
%return %if need = 0; ! Save reading rest of file...
%if use = 0 %start
skip module
%finish %else %start
reset (m_code, m_gla)
load module (base, m_n refs)
need = need - 1
%finish
%end
header %if alone = 0
pass = 2
file limit = file no
file no = 0; mdl no = 0
%while file no < file limit %cycle
file no = file no + 1
this file == file(file no)
open input (obj in, this file_name)
select input (obj in)
nmod = word
this file_load = 0
refs = 0
load (nmod)
%if this file_load = 0 %and fileno <= last user file %start
mon ("? No modules loaded from ".this file_name)
%finish
close input
%repeat
flush (gbuf, gp, ga) %if gp # 0
locate (main ep)
flush (cbuf, cp, ca)
close output
%end
%routine REPORT FIGURES (%integer stream)
%routine FULL OCTAL (%integer n)
%integer k
write (n, 0)
%return %if 0 <= n <= 7
print string (" (8_")
n = n & 16_FFFF
k = 15; k = k - 3 %while n>>k = 0 %and k > 0
%for k = k, -3, 0 %cycle
print symbol (n>>k & 7 + '0')
%repeat
print symbol (')')
%end
select output (stream)
%if stream # 0 %start
print string ("Total code space = "); full octal (code size)
print string (" bytes"); newline
print string ("Total data space = "); full octal (data size)
print string (" bytes"); newline
print string ("Net stack space = "); full octal (stack size)
print string (" bytes")
%finish %else %start
print string ("Code: "); write (code size, 0)
print string (" Data: "); write (data size, 0)
print string (" Stack: "); write (stack size, 0)
%finish
newline
print string (object); print string (": ")
write (records, 0); print string (" load records")
newline
%end
%routine GENERATE MAP
%integer f, i, n, j, k, tt
%record(tabfm) %name t
%record(filefm) %name filep
%integer %array sort (1 : max table)
%on 9 %start
{E} reason = map . " --" . event_message
!DV! reason = map . " -- " . sys mess (event_extra)
crash (bad output)
%finish
%return %if map = ""
!V! set default (".MAP")
{E} set default ("")
open output (map out, map)
select output (map out)
new line
print string ("Linkage map of file ")
print string (object); newlines (2)
n = 0
%for j = max table, -1, defs %cycle
t == table(j)
%if mtab(t_index)_use # 0 %or t_type&used bit # 0 %start
n = n + 1; sort(n) = j
%finish
%repeat
%for j = 1, 1, n %cycle
%for k = 1, 1, n-j %cycle
t == table(sort(k)); tt = k
%if t_addr>>1 > table(sort(k+1))_addr>>1 %start
sort(k) = sort(k+1)
sort(k+1) = tt
%finish
%repeat
%repeat
print string ("File Usage"); newline
print string ("=========="); newlines (2)
print string (" No. Modules Loaded Address File name"); newline
print string (" === ======= ====== ======= ========="); newlines (2)
%for j = 1, 1, file limit %cycle
filep == file(j)
write (j, 2)
i = filep_n mod; k = filep_load
f = filep_m base
write (i, 6); write (k, 9)
spaces (4);
%if k = 1 %then octal (m tab(f)_code) %c
%else print string ("- -- -")
spaces (3)
print string (filep_name)
newline
%repeat
newlines (2)
print string ("Symbol Table"); new line
print string ("============"); new lines (2)
print string (" Symbol Type Value File Module"); new line
print string (" ====== ==== ===== ==== ======"); new lines (2)
%for j = 1, 1, n %cycle
t == table(sort(j))
%if t_type&used bit = 0 %then print symbol ('?') %c
%else space
print string (t_text)
spaces (max text+3 - length(t_text))
print string (types(t_type&type mask))
spaces (2)
octal (t_addr)
spaces (2)
%if t_index # 0 %start
i = t_index; f = m tab(i)_srce
k = file(f)_m base
write (f, 2)
write (i-k+1, 7)
%finish %else %start
print string ("Linker-defined")
%finish
new line
%repeat
%if alone = 0 %start
new lines (2)
print string ("Segments"); new line
print string ("========"); new lines(2)
print string (" No. Length Mode"); new line
print string (" === ====== ===="); new line
%for j = 0, 1, 7 %cycle
write (j, 2); spaces (5)
octal (seg len(j)); spaces (5);
print string (seg mode(seg type(j)))
new line
%repeat
%finish
newline
report figures (2)
new lines (2)
%end
%routine INITIALISE THINGS
%integer j
%routine SET UP (%integer n, %string(max text) s)
table(n) = 0; table(n)_text = s
%end
m tab(j) = 0 %for j = 0, 1, max modules
table(0) = 0
lib file(j) = "" %for j = 1, 1, max lib
seg type(j) = 0 %for j = 0, 1, 7
set up (xtop, "$TOP" )
set up (xevent, "$EVENT" )
set up (xds, "$DS" )
set up (xsp, "$SP" )
set up (xstrms, "$NSTREAMS")
refs = 0; defs = last predef
mdl no = 0; file no = 0
mode = init; pass = 1
%end
%routine SET UP DEFAULTS
source = cfile
com file = dflt com
open (com in, com file, "CMD")
handle parameters ("")
%end
%routine SPLIT COMMAND LINE (%string(*) %name in, qual)
%string(maxclp) objf, mapf
%integer j, s
objf = ""; mapf = ""; qual = ""
%for j = 1, 1, length(cmd sep) %cycle
s = charno(cmd sep,j)
%exit %if in -> in . (tostring(s)) . qual
%repeat
%if in -> in . ("/") . objf %and %c
objf -> objf . (",") . mapf %start; %finish
reason = ""
reason = mapf %if length(mapf) > maxf
reason = objf %if length(objf) > maxf
crash (bad filename) %if reason # ""
object = objf; map = mapf
{E} in = "@.IN" %if in = ""
!DV! in = "@.TT" %if in = ""
clobj = 0; clobj = 1 %if object # ""; ! For possible override later
clmap = 0; clmap = 1 %if map # ""
%end
%routine GET USER INPUTS
%string(maxclp) input, quals
mode = user
input = cliparam
split command line (input, quals)
handle qualifiers (quals)
handle parameters (input)
last user file = fileno
%end
%routine GET DEFAULT INPUTS
%integer j
perm = 1
process (perm file)
%return %if nlib = 0
process (lib file(j)) %for j = nlib, -1, 1; ! backwards(!)
%end
! M A I N C O D E
initialise things
set up defaults
get user inputs
crash (no modules) %if mdl no = 0; ! Silly user!!!
get default inputs
fix names
handle fixups
fill refs
crash (errs) %if errors # 0
crash (no main ep) %if perm ep = 0 = entry
fiddle sizes
fix addresses
open loadfile
mon ("About to generate load file") %if monf # 0
generate load file
mon ("Load file generated OK") %if monf # 0
crash (errs) %if errors # 0
report figures (0)
mon ("About to generate map") %if monf # 0
generate map
mon ("Map generated OK") %if monf # 0
%end
%end %of %file