(******************************************************************) (* *) (* Copyright (c) 1978 Regents of the University of California. *) (* Permission to copy or distribute this software or documen- *) (* tation in hard or soft copy granted only by written license *) (* obtained from the Institute for Information Systems. *) (* *) (******************************************************************) { * Phase3 of the linker does all the real work of code * massaging. For each segment in seginfo to be placed * into the output code file, all referenced procedures * and functions are found, globals and other refs are * resolved, and finally the final code segment is built. * In the case of a SEPRTSEG host (eg an interpreter), then * all the procs in it are put in the unresolved list and * the host seg is made to appear as just another sep seg. * This drags along all the original procedures and maintains * their original ordering for possible ASECT integrity. } procedure phase3; type workp = ^workrec; { all seg work is driven by these lists } workrec = record next: workp; { list link } refsym, { symtab entry of unresolved name } defsym: symp; { " " " resolving entry } refseg, { seg refls point into, refrange only } defseg: segp; { seg where defsym was found } case litypes of { same as litype in refsym^.entry } SEPPREF, SEPFREF, GLOBREF: (defproc: workp); { work item of homeproc } UNITREF: (defsegnum: segrange); { resolved seg #, def = ref } PRIVREF: (newoffset: lcrange); { newly assigned base offset } EXTPROC, EXTFUNC, SEPPROC, SEPFUNC: (needsrch: boolean; { refs haven't been found } newproc: 0..MAXPROC) { proc #, comp or link chosen } end { workrec } ; { 0 implies added proc } var s: segindex; segbase: codep; { address of current seg being crunched } segleng, { final code seg length for writeout } nextblk: integer; { next available output code block } uprocs, { unresolved external proc/func work list } procs, { resolved list of above items } ulocal, { unresolved list of updates for seginfo entry } local, { resolved list of fixups that came along with seg } uother, { unresolved work list of things other than procs } other: workp; { resolved list of above } sephost: boolean; { flag for interpreter host case (only seg #1) } fname: string[39];{ output code file name } segtbl: I5segtbl; { output code's seg table } map: text; { map text output file } { * Buildworklists is called for all segments which need to * be copied, and maybe need to have sepprocs or others stuff * fixed up within them. The idea here is to get a list * of procs and other item needing attention, with * all the subtle implications of global defs falling * in procs which are not yet selected for linking etc. * In fact, three lists are built: * The procs list with all procs and func to be grabbed * from the various sep segs. * The local list of refs in the original segment which must * ALL be fixed up such as public or private refs in a unit seg. * The other list which has work items which have at least one * ref occuring in the procs or funcs in the procs list. } procedure buildworklists; var sp: segp; wp: workp; { * Findprocs goes through symtab and builds a list of * procedure and functions which occur in the tree and * whose litype is in the okset. The resulting list * is not ordered in any particular fashion. It is * called to build initial uproc list. } function findprocs(okset: liset; symtab: symp): workp; var work: workp; { * procsrch recursivly searches subtrees to pick out * those symbols which are in the okset, generates * new work nodes, and puts them into local work list. } procedure procsrch(sym: symp); var wp: workp; begin if sym <> NIL then begin procsrch(sym^.llink); procsrch(sym^.rlink); procsrch(sym^.slink); if sym^.entry.litype in okset then begin { place new node in list } new(wp); wp^.refsym := sym; wp^.refseg := NIL; wp^.defsym := NIL; wp^.defseg := NIL; wp^.needsrch := TRUE; if sephost then wp^.newproc := 0 { see readsrcseg! } else wp^.newproc := sym^.entry.srcproc; wp^.next := work; work := wp end end end { procsrch } ; begin { findprocs } work := NIL; procsrch(symtab); findprocs := work end { findprocs } ; { * Findnewprocs is called to place new procedures into the * uprocs work list that are needed to resolve GLOBDEFs, * SEPPREFs, and SEPFREFs. The other list is traversed and * for each element whose defining proc has not been added * into the uprocs list, the defining proc is located and * added into uprocs. } procedure findnewprocs; var wp, wp1: workp; pnum: integer; { * Findnadd finds the procedure numbered pnum in the * symbol table symtab. An error is given if the * required proc cannot be found. It returns a work * node for the proc once it has been found. This * node is also added into the uprocs list. Any procs * added this way are "invisible", dragged along because * of global refs/defs. } function findnadd(symtab: symp): workp; { * procsrch recursivly searches the sym tree looking * for the actual symbol containing pnum. This does * most of the work of findnadd. } procedure procsrch(sym: symp); var wp: workp; begin if sym <> NIL then begin procsrch(sym^.llink); procsrch(sym^.rlink); procsrch(sym^.slink); if sym^.entry.litype in [SEPPROC, SEPFUNC] then if sym^.entry.srcproc = pnum then begin new(wp); wp^.refsym := sym; wp^.refseg := NIL; wp^.defsym := NIL; wp^.defseg := NIL; wp^.needsrch := TRUE; wp^.newproc := 0; wp^.next := uprocs; uprocs := wp; findnadd := wp; exit(findnadd) end end end { procsrch } ; begin { findnadd } findnadd := NIL; procsrch(symtab); { if we get here then didnt find it } error('missing proc') end { findnadd } ; begin { findnewprocs } wp := other; { assume only globref, seppref, sepfref in list } while wp <> NIL do begin if wp^.defproc = NIL then begin { find proc/func needed } if wp^.refsym^.entry.litype = GLOBREF then pnum := wp^.defsym^.entry.homeproc else { assume a SEP proc/func } pnum := wp^.defsym^.entry.srcproc; wp1 := procs; while wp1 <> NIL do if wp^.defseg = wp1^.defseg then if wp1^.defsym^.entry.srcproc = pnum then begin { already gonna be linked } wp^.defproc := wp1; wp1 := NIL end else wp1 := wp1^.next else wp1 := wp1^.next; if wp^.defproc = NIL then { forcibly link it } wp^.defproc := findnadd(wp^.defseg^.symtab) end; wp := wp^.next end { while } end { findnewprocs } ; { * Resolve removes work items from inlist, searches symtabs * for its corresponding definition symbol (error if not found), * and moves the work item into the output list. Each flavor * of work item needs some special handling to collect extra * info related to specific things. In general, defsym and * defseg are filled in. The insert algorithm is special for * procedure types to make life easier on refsrch. } procedure resolve(var inlist, outlist: workp); var seg: segrange; err: boolean; wp: workp; { * Sepsrch sequentially search the symtabs in the seplist * to resolve the refsym of inlist^. It basically just * calls symsrch repetively and fixes up defsym and * defseg fields. If the name of the refsym could * not be found, an error is given. } procedure sepsrch(oktype: litypes); var syp: symp; sp: segp; begin sp := seplist; while sp <> NIL do begin syp := symsrch(inlist^.refsym^.entry.name, oktype, sp^.symtab); if syp <> NIL then begin inlist^.defsym := syp; inlist^.defseg := sp; sp := NIL end else sp := sp^.next end end { sepsrch } ; { * Procinsert is called to insert work into the procs * list using a special set of sort keys so that copyin- * procs will run reasonably fast and use the disk * efficiently. The procs list is sorted by segment, * srcbase keys. The seg ordering is dictated by the * seplist, so user ASECTS etc will retain their original * ordering. } procedure procinsert(work: workp); label 1; var crnt, prev: workp; sp: segp; begin prev := NIL; sp := seplist; while sp <> outlist^.defseg do if sp = work^.defseg then goto 1 else sp := sp^.next; crnt := outlist; repeat if crnt^.defseg = work^.defseg then repeat if work^.defsym^.entry.place^.srcbase < crnt^.defsym^.entry.place^.srcbase then goto 1; prev := crnt; crnt := crnt^.next; if crnt = NIL then goto 1 until crnt^.defseg <> work^.defseg else begin prev := crnt; crnt := crnt^.next; if crnt <> NIL then while sp <> crnt^.defseg do if sp = work^.defseg then goto 1 else sp := sp^.next end until crnt = NIL; 1: if prev = NIL then begin work^.next := outlist; outlist := work end else begin work^.next := prev^.next; prev^.next := work end end { procinsert } ; begin { resolve } while inlist <> NIL do begin with inlist^, refsym^.entry do case litype of GLOBREF: begin sepsrch(GLOBDEF); defproc := NIL end; CONSTREF: if hostsp <> NIL then begin defsym := symsrch(name, CONSTDEF, hostsp^.symtab); defseg := hostsp end; PUBLREF: if hostsp <> NIL then begin defsym := symsrch(name, PUBLDEF, hostsp^.symtab); defseg := hostsp end; PRIVREF: begin newoffset := nextbaselc; nextbaselc := nextbaselc+nwords; if hostsp <> NIL then defsym := refsym; defseg := hostsp end; EXTPROC, SEPPROC, SEPPREF: begin sepsrch(SEPPROC); if litype = SEPPREF then defproc := NIL; err := FALSE; if defsym <> NIL then if litype = SEPPREF then err := defsym^.entry.nparams <> nwords else err := defsym^.entry.nparams <> nparams; if err then begin write('Proc ', name); error(' param mismatch') end end; EXTFUNC, SEPFUNC, SEPFREF: begin sepsrch(SEPFUNC); if litype = SEPFREF then defproc := NIL; err := FALSE; if defsym <> NIL then if litype = SEPFREF then err := defsym^.entry.nparams <> nwords else err := defsym^.entry.nparams <> nparams; if err then begin write('Func ', name); error(' param mismatch') end end; UNITREF: if unitsrch(hostfile, name, seg) = hostfile then begin { will be found in host } defsym := refsym; defsegnum := seg end else { "impossible" } error('unit err') end { cases } ; wp := inlist; inlist := wp^.next; if wp^.defsym = NIL then with wp^.refsym^.entry do begin case litype of GLOBREF: write('Global '); PUBLREF: write('Public '); CONSTREF: write('Const '); SEPPREF, EXTPROC: write('Proc '); SEPFREF, EXTFUNC: write('Func ') end { cases } ; write(name); error(' undefined') end else if (wp^.defsym^.entry.litype in [SEPPROC, SEPFUNC]) and (outlist <> NIL) then procinsert(wp) else begin wp^.next := outlist; outlist := wp end end { while } end { resolve } ; { * Refsrch slowly goes through all reference lists in symbols * which are in the okset to see if any "occur" within the * procedures/functions selected to be linked, that is contained * in procs list. It is assumed that procs is sorted by defseg * so only the procs between ipl and lpl are searched. * Any symbols which have any refs in selected procs are given * work nodes and are placed in the uother list in no certain * order so resolve can be called right away. } procedure refsrch(okset: liset; sp: segp); var lpl, ipl: workp; diffseg: boolean; { * Checkrefs recursivly searches sym tree to kind names * in the okset. When one is found, each of its ref pointers * are checked to see if they fall in one of the procs * to-be-linked (between ipl & lpl). If so, a new work item * is generated and it's put on the uother list. } procedure checkrefs(sym: symp); label 1, 2; var pl, wp: workp; i, n, ref: integer; rp: refp; begin if sym <> NIL then begin checkrefs(sym^.llink); checkrefs(sym^.rlink); checkrefs(sym^.slink); with sym^.entry do if litype in okset then begin n := nrefs; rp := reflist; while rp <> NIL do begin if n > 8 then begin i := 7; n := n-8 end else i := n-1; repeat { for each ref } ref := rp^.refs[i]; pl := ipl; repeat { search proc list } if pl^.needsrch then with pl^.defsym^.entry.place^ do if ref < srcbase then goto 2 { terminate proc search } else if ref < srcbase+length then begin { occurs in proc } new(wp); wp^.refsym := sym; wp^.refseg := sp; wp^.defsym := NIL; wp^.defseg := NIL; wp^.next := uother; uother := wp; goto 1 end; pl := pl^.next until pl = lpl; 2: i := i-1 until i < 0; rp := rp^.next end { while } end end; 1: end { checkrefs } ; begin { refsrch } ipl := NIL; lpl := procs; while lpl <> NIL do if (lpl^.defseg = sp) and lpl^.needsrch then begin ipl := lpl; lpl := NIL end else lpl := lpl^.next; if ipl <> NIL then begin lpl := ipl; repeat diffseg := lpl^.defseg <> ipl^.defseg; if not diffseg then lpl := lpl^.next until diffseg or (lpl = NIL); checkrefs(sp^.symtab); repeat ipl^.needsrch := FALSE; ipl := ipl^.next until ipl = lpl end end { refsrch } ; { * findlocals recursivly searches the main segs symtab to * place any unresolved things like public refs in unit * segs into the ulocal list so they can be fixed up in * fixuprefs in addition to the sep proc things. } procedure findlocals(sym: symp); var wp: workp; begin if sym <> NIL then begin findlocals(sym^.llink); findlocals(sym^.rlink); findlocals(sym^.slink); if sym^.entry.litype in [UNITREF, PUBLREF, PRIVREF] then begin new(wp); wp^.refsym := sym; wp^.refseg := NIL; wp^.defsym := NIL; wp^.defseg := NIL; wp^.next := ulocal; ulocal := wp end end end { findlocals } ; begin { buildworklists } procs := NIL; local := NIL; other := NIL; uprocs := NIL; ulocal := NIL; uother := NIL; with seginfo[s]^ do if segkind <> LINKED then begin sephost := segkind = SEPRTSEG; if sephost then begin next := seplist; seplist := seginfo[s]; uprocs := findprocs([SEPPROC, SEPFUNC], symtab) end else uprocs := findprocs([EXTPROC, EXTFUNC], symtab); while uprocs <> NIL do begin resolve(uprocs, procs); sp := seplist; while sp <> NIL do begin refsrch([GLOBREF, SEPPREF, SEPFREF], sp); sp := sp^.next end; resolve(uother, other); findnewprocs end; if not sephost then begin findlocals(symtab); resolve(ulocal, local) end; wp := procs; while wp <> NIL do begin wp^.needsrch := TRUE; wp := wp^.next end; sp := seplist; while sp <> NIL do begin refsrch([PUBLREF, PRIVREF, CONSTREF], sp); sp := sp^.next end; resolve(uother, other) end end { buildworklists } ;