! ! Linker for DEIMOS ! (Shared perm version) ! ! 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 fatal error = 16_1000002c; ! Error code to EXIT (VMS) !!{E} %const %integer fatal error = 13; ! %Signal (EMAS) !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) help file = "U1:[MT.11.DEIMOS]LINKHELP" {D} %own %string(maxf) help file = "0.LKHELP(77)" !E! %own %string(maxf) help file = "ERCM11.IMP11PD_LINKHELP" !V! %own %string(maxf) dflt com = "U1:[MT.11.DEIMOS]LINK.DEF" {D} %own %string(maxf) dflt com = "0.LKDEFS(77)" !E! %own %string(maxf) dflt com = "ERCM11.IMP11PD_LINKDEFS" !E! %own %string(2) 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 %const %integer tty in = 0, com in = 1, obj in = 2 %const %integer report = 0, obj out = 1, map out = 2 !V! %system %routine %spec EXIT (%integer status) !V! %external %routine %spec PRINT RECORD (%integer n, start) !VE!%external %routine %spec SET DEFAULT EXTENSION (%string(127) def) {DV}%external %string(max clp) %function %spec CLI PARAM %external %string(maxf) %function %spec BASE NAME (%string(maxf) file) %external %string(255) %function %spec LAST STREAM ERROR !E! %external %routine %spec SET EVENT !E!%include "ERCM11.IMP77_SPECS" {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 bad share = 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 file err = 11 %const %integer last com error = 11 ! CRASH numbers %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 = 21 ! 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 = 15 %const %integer gla bit = 1 %const %integer abs bit = 8 %const %integer unknown = 0; ! GAWM %const %integer code def = 2; ! %externalroutine jim %const %integer glap def = 3; ! %externalinteger fred %const %integer code ref = 4; ! %externalpredicatespec pete %const %integer glap ref = 5; ! %externalstring(3)%spec s %const %integer abs def = 8; ! .globl X = 8_20030 %const %integer abs ref = 9; ! .globl Y %const %integer abs idef = 10; ! Z = @8_160040 (fixup) %const %string(4) %array types (0 : 15) = " -- ", "????", "Code", "Glap", "Cref", "Gref", "????", "????", "Abs ", "Aref", "AbsI", "????"(*) ! Flags in top of TYPE field (internal) %const %integer plug bit = 32 %const %integer used bit = 64 ! Actions for the MARK routine %const %integer get sizes = 1 %const %integer set adr = 2 ! Predefined externals %const %integer xds = max table %const %integer xsp = max table - 1 %const %integer xevent = max table - 2 %const %integer xstrms = max table - 3 %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) %own %string(maxf) perm file = "" %string(maxf) %array lib file (1 : max lib) %string(maxf) %array fix file (1 : max fix) %own %integer %array seg type (0 : 7) %own %integer %array 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 = 0, pass = 0 %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 ca = 0, ga = 0 %own %integer nlib = 0, nfix = 0 %own %integer file no = 0, mdl no = 0, file limit = 0 %own %integer clmap = 0, clobj = 0; ! Override def flags %own %integer perm = 0, perm ep = 0 %own %integer impure = 0, ep module = 0 %own %integer source = cline, smap = 0 %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 %own %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 = 29 %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", "xxxx", "DEFINE", "MONITOR", "HELP", "SHORTMAP", "LONGMAP", "END" ! # 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, 1, 1, 1, 0 %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 QUIT !V! exit (fatal error) !E! %signal {fatal error}13 {D} %stop %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(bad share): print string (".SHARE and .ALONE/.ENTRY incompatible") -> out r(invalid streams):print string ("Invalid number of streams"); -> out r(file err): print string ("Failed to open input file") newline; print string (reason); -> 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 quit %if source # tty %end %routine CRASH (%integer why) %switch x (2 : 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") newline; -> ptext x(bad filename): print string ("invalid filename ") 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 reading 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 quit %end ! File handling utilities %routine OPEN (%integer streamno, %string(*) %name file, %string(4) ext) %on 9 %start reason = last stream error com error (file err) %if source # tty select output (report) print string (reason); newline file = ""; ! Mark failure %return %finish %return %if file = "" !VE! set default extension (ext) open input (streamno, file) 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 %routine GETB (%integername b) %on 9 %start crash (in EOF) %finish read symbol (b) %end %integer %function WORD %integer s1, s2 getb (s1); getb (s2) %result = s1 + s2<<8 %end %routine GET (%integername w) %integer h, l getb (l); getb (h) w = l + h<<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 get (sym_addr) getb (n); sym_type = n getb (n) %for j = 1, 1, n %cycle getb (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 get (n); count = n %cycle n = n - 1 %return %if n < 0 get record (mode) %repeat %end %routine PREPARE SPECS (%integer loading, %integername flag) %integer mode, x flag = errors get group (def, dummy) mode = ref mode = ref ! insert ! satisfy %if loading # 0 get group (mode, dummy) flag = errors - flag get (x); ! code size get (x); ! 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, type, 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 type = abs idef %and readsym %c %else type = abs def 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 = type 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 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 get (modules) 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) b = m_code b = m_gla %if t_type&gla bit # 0 b = 0 %if t_type&abs bit # 0 t_addr = t_addr + b %repeat %end %routine FIX NAMES %routine MODIFY (%string(*)%name from, to) %integer n %cycle n = find (ref, from) %return %if n < 0 table(n)_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 %if n # 0 %finish %result = -err %end %routine GIVE HELP INFO %string(maxf) hf %integer s %on 9 %start close input -> out %finish hf = help file; open (obj in, hf, "HLP") %if hf # "" %start %cycle read symbol (s) print symbol (s) %repeat %finish %else %start print string ("Sorry - help info not available at the moment!") newline %finish out: select input (com in) %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) %if 0 <= n <= max streams %then streams = n %c %else com error (Invalid streams) %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 com error (bad share) %and %return %if alone # 0 prompt ("Segment: "); get number (n) com error (bad seg) %and %return %unless 0 <= n <= 2; ! segment?? seg type(n) = Shared; code base = (n+1) << 13 %return key(22): ! .NOSHARE seg type(n) = 0 %for n = 0, 1, 7 code base = 0 %if alone = 0 %return key(23): ! was .CODEBASE ! get octal (code base); %return key(24): ! .DEFINE get defs; %return key(25): ! .MONITOR monf = \monf; %return key(26): ! .HELP give help info; %return key(27): ! .SHORTMAP smap = 1; %return key(28): ! .LONGMAP smap = 0 key(*): ! .END ?????????? %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 = -1; ! .TT %finish %finish %repeat %result = s %end %cycle param = next parameter %return %if param = "" %if charno(param,1) = '.' %start; ! Keyword param -> (".") . keyword k = find keyword %if k < 0 %start com error (-k) %finish %else %if k = last key %start; ! .END %return %if input = "" %or source = tty ! Otherwise just end of current file %finish %else %start handle keyword (k) %finish %finish %else %start process (param) %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(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 %on 9 %start reason = last stream error crash (bad output) %finish %if object = "" %start select input (com in); source = tty prompt ("Object file: ") get word (object, maxf) %finish !VE! set default extension ("ABS") open output (obj out, object) select (obj out) object = out file name %return %if alone # 0; ! No need to fiddle with name %if task = 0 %start name = base name (object) %finish name = name . " " length(name) = 4 task id = name %end %routine GENERATE LOAD FILE %integer nmod {DV} %own %short %array cbuf (-2 : bufflimit+1) {DV} %own %short %array gbuf (-2 : buff limit+1) !E! %own %integer %array cbuf (-2 : buff limit+1) !E! %own %integer %array gbuf (-2 : buff limit+1) %own %integer cp = 0, gp = 0, last code = 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 symbol (0) %for bp = 1, 1, 4 {DE} %for bp = -2, 1, p %cycle {DE} w = b(bp); print symbol (w&255); print symbol (w>>8&255) {DE} %repeat {DE} print symbol (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 getb (s) %until s = 16_E0 getb (s) %if s = 16_E0 %start getb (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 getb (key) -> s (key) %if 1 <= key <= 11 s(3): crash (corrupt obj) s(1): get (n); cput (n+mod); mod = 0; %continue s(2): get (n); gput (n+mod); mod = 0; %continue s(7): get (index) %unless 0 < index <= max ref %start crash (bad ext ref) %finish t == table(index+base) %if t_type & type mask = abs idef %start %if last code = 8_004767 %start; ! jsr pc,fred plug code (8_004777); ! -> jsr pc,@fred %finish %else %start sym = t; error (indirect fail) t_type = 0 %finish %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); ! event chain? getb (n); getb (n); getb (n); ! 16_E0E0E0 %end %routine LOAD (%integer modules) %integer flag, use, base %record(modfm) %name m %own %integer need = 0 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 print string ("? No modules loaded from ".this file_name) newline %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 !E! %string(127) x, y %record(tabfm) %name t %record(modfm) %name m %record(filefm) %name filep %integer %array sort (1 : max table) %routine PRINT UL (%string(80) s) %integer j print string (s); newline %for j = 1, 1, length(s) %cycle charno(s,j) = '=' %if charno(s,j) # ' ' %or %c (1 < j < length(s) %and charno(s,j-1) # ' ' # charno(s,j+1)) %repeat print string (s); newline %end %on 9 %start reason = last stream error crash (bad output) %finish %return %if map = "" !VE! set default extension ("MAP") 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); m == mtab(t_index) %if (m_use # 0 %or t_type&used bit # 0) %and %c (smap = 0 %or m_srce <= last user file) %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 = sort(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 ul ("File Usage"); newline print ul (" No. Modules Loaded C/base G/base File name"); newline j = file limit; j = last user file %if smap # 0 %for j = 1, 1, j %cycle filep == file(j) write (j, 2) i = filep_n mod; k = filep_load f = filep_m base write (i, 6); write (k, 8) spaces (4); %if k = 1 %start octal (m tab(f)_code); spaces (2); octal (m tab(f)_gla) %finish %else %start print string ("- -- - - -- -") %finish spaces (3) print string (filep_name) newline %repeat newlines (2) print ul ("Symbol Table"); newline print ul (" Symbol Type Value File Module"); new line %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 ul ("Segments"); newline print ul (" No. Length Mode") %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 (xds, "_$DS" ) set up (xsp, "_$SP" ) set up (xevent, "_$EVENT" ) 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 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 !E!%on {fatal error}13 %start; %return; %finish; ! Get-out for EMAS 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