! ! 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