%include "inc:util.imp"
%option "-nodiag"
%begin; !8086 Linker

!Object format
%constinteger setcode=1
%constinteger setdata=2
%constinteger setloc=3
%constinteger append=4
%constinteger patch=5
%constinteger def=6
%constinteger sref=7
%constinteger ref=8
%constinteger endmodule=9
%constinteger endfile=10

%constinteger maxsym=100
%constinteger maxref=300
%constinteger maxmod=100

%recordformat symfm(%string(15)name,%integer module,segment,offset)
%recordformat modfm(%integer cbase,dbase,cloc,dloc,ref)
%recordformat reffm(%integer sym,next)

%record(symfm)%array symbol(1:maxsym)
%record(modfm)%array module(1:maxmod)
%record(reffm)%array refs(1:maxref)

%string(15)codesegs="16_c000",datasegs="16_d000"
%integer codebase,database,codeseg,dataseg
%integer modules,lastsymbol,nextref,futile

%integerfn stoi(%string(255)s)
%integer rad=10,num=0,sign=0,pos,sym
%bytename l
  l == length(s); pos = 1
  %cycle
    %result = num %if pos>l; sym = l[pos]; pos = pos+1
    %if sym='-' %or sym='\' %start
      sign = sym
    %elseif sym='_'
      rad = num; num = 0
    %elseif '0'<=sym<='9'
      num = num*rad-'0'+sym
    %elseif 'a'<=sym!32<='z'
      num = num*rad-'a'+10+(sym!32)
    %finishelseresult = num
  %repeat
%end

%routine phex(%integer n)
%integer i,s
  %for i=12,-4,0 %cycle
    s=n>>i&15; s=s+7 %if s>9; printsymbol(s+'0')
  %repeat
%end

%integerfn w
%integer h,l
  readsymbol(l); readsymbol(h); %result=h<<8+l
%end

%integerfn locate
%ownstring(15)s=""
%record(symfm)%name n
%integer sym,i
  readsymbol(i)
  %if i>0 %start
    s=""
    %while i>0 %cycle
      i=i-1; readsymbol(sym)
      sym=sym-32 %if 'a'<=sym<='z'; s=s.tostring(sym)
    %repeat
  %finish
  %for i=1,1,lastsymbol %cycle
    n==symbol(i); %result=i %if n_name=s
  %repeat
  %signal 15,1 %if lastsymbol=maxsym
  lastsymbol=lastsymbol+1; n==symbol(lastsymbol)
  n=0; n_name=s; %result=lastsymbol
%end

%routine scan stream(%integer stream)
%onevent 9 %start
  resetinput
  %return
%finish

%routine scan module(%record(modfm)%name module)
%integer sym,seg,i
%integername cloc,dloc,loc
%switch s(setcode:endfile)

  %routine define(%integer sym)
  %record(symfm)%name s
    s==symbol(sym)
    s_module=modules+1; s_segment=seg; s_offset=loc
  %end

  %integerfn newref
    %signal 15,3 %if nextref>maxref
    nextref = nextref+1; %result = nextref-1
  %end

  %routine refer(%integer sym)
  %integer ref
  %record(symfm)%name s
  %record(reffm)%name r
    s==symbol(sym)
    ref=newref; r==refs(ref)
    r_next=module_ref; module_ref=ref; r_sym=sym
  %end

   module=0
  cloc==module_cloc; dloc==module_dloc
  loc==cloc; seg=codeseg
loop: readsymbol(sym) %until 0#sym#255; ->s(sym)
s(setcode): loc==cloc; seg=codeseg; ->loop
s(setdata): loc==dloc; seg=dataseg; ->loop
s(setloc): loc=w; ->loop
s(append): i=w; loc=loc+i; readsymbol(sym) %and i=i-1 %while i#0; ->loop
s(patch):  sym=w; sym=w; ->loop
s(def):     define(locate); ->loop
s(sref):
s(ref): loc=loc+2; refer(locate); ->loop
s(endmodule): modules=modules+1; %return
s(endfile): modules=modules+1; %signal 9
%end

  selectinput(stream)
  %cycle
    scan module(module(modules+1))
  %repeat
%end

%routine require module(%integer n)
%record(modfm)%name m
%record(symfm)%name s
%record(reffm)%name r
%integer ref,i

  %routine require symbol(%integer n)
  %record(symfm)%name s
    s==symbol(n); n=s_module
    %if n=0 %start
      printstring("*No "); printstring(s_name)
      futile=1
      newline; %return
    %finish
    require module(n)
  %end

  m==module(n)
  %returnif m_cbase#0
  m_cbase=codeseg; m_dbase=dataseg
  %for i=1,1,lastsymbol %cycle
    s==symbol(i)
    %if s_module=n %start
      %if (s_segment!!codeseg)>>12=0 %then s_segment=codeseg %c
                                     %else s_segment=dataseg
      selectoutput(2)
      phex(s_segment); printsymbol('_'); phex(s_offset)
      space; printstring(s_name); newline
      selectoutput(0)
    %finish
  %repeat
  codeseg=(m_cloc+15)>>4+codeseg; dataseg=(m_dloc+15)>>4+dataseg
  ref=m_ref
  %while ref#0 %cycle
    r==refs(ref); require symbol(r_sym); ref=r_next
  %repeat
%end


%routine load stream(%integer n)
%owninteger m=1
%integername loc,base

%onevent 9 %start
  %return
%finish

  %routine skipmodule
  %integer sym,i
  %switch s(setcode:endfile)
s(setcode):s(setdata):
loop: readsymbol(sym) %until 0#sym#255; ->s(sym)
s(patch): i=w
s(setloc): i=w; ->loop
s(append): i=w
skip: %while i>0 %cycle
        i=i-1; readsymbol(sym)
      %repeat
      ->loop
s(def):s(ref):s(sref): readsymbol(i); ->skip
s(endfile): m=m+1; %signal 9
s(endmodule): m=m+1
  %end

  %routine loadmodule
  %record(symfm)%name s
  %integer sym,i,cloc,dloc
  %switch sw(setcode:endfile)

     %routine pw(%integer x)
         printsymbol(x&255); printsymbol(x>>8&255)
     %end

     %routine pad(%integername base,%integer loc,set)
       %if loc&15#0 %start
         printsymbol(set); printsymbol(append); set=16-(loc&15); pw(set)
         printsymbol(255) %and set=set-1 %while set>0
       %finish
       base=(loc+15)>>4+base
     %end

     cloc=0; dloc=0; loc==cloc; base==codeseg
loop: readsymbol(sym) %until 0#sym#255; ->sw(sym)
sw(setcode): loc==cloc; base==codeseg
echo: printsymbol(sym); ->loop
sw(setdata): loc==dloc; base==dataseg; ->echo
sw(setloc):  printsymbol(setloc); sym=w; pw(sym); loc=sym; ->loop
sw(append): i=w; printsymbol(append); pw(i)
      loc=loc+i
      %while i>0 %cycle
         i=i-1; readsymbol(sym); printsymbol(sym)
      %repeat
      ->loop
sw(patch): printsymbol(patch); pw(w); pw(w); ->loop
sw(def):   s==symbol(locate)
      %unless base=s_segment %and loc=s_offset %start
         selectoutput(0); printstring("Phase error: Base=")
         phex(base); printstring(",Loc="); phex(loc); printsymbol(',')
         printstring(s_name); printsymbol('=')
         phex(s_segment); printsymbol('_'); phex(s_offset)
         newline; selectoutput(1)
      %finish
      ->loop
sw(ref): i=symbol(locate)_offset; ->reffed
sw(sref):i=symbol(locate)_segment
reffed: printsymbol(append); pw(2); pw(i); loc=loc+2; ->loop
sw(endfile):
sw(endmodule): m=m+1
      pad(codeseg,cloc,setcode); pad(dataseg,dloc,setdata)
      %signal 9 %if sym=endfile
  %end

  selectinput(n)
  %cycle
    %if module(m)_cbase=0 %then skipmodule %else loadmodule
  %repeat
%end

%routine showmax(%integer stream)
  selectoutput(stream)
  printstring("Code"); write((codeseg&16_fff)<<4,1)
  printstring(", Data"); write((dataseg&16_fff)<<4,1)
  printstring(" bytes
")
%end

%string(255)one,two="",three="",out
%integer map=0
  defineparam("Main",one,pamnodefault)
  defineparam("Ext1",two,0)
  defineparam("Ext2",three,0)
  defineparam("Out",out,pamnewgroup!pamnodefault)
  defineparam("Codeseg",codesegs,pamnewgroup)
  defineparam("Dataseg",datasegs,0)
  definebooleanparams("Map",map,0)
  processparameters(cliparam)
  codeseg = stoi(codesegs); codebase = codeseg
  dataseg = stoi(datasegs); database = dataseg
  openinput(1,one.".iob")
  %if two="" %then two = ":n" %else two = two.".iob"
  openinput(2,two)
  %if three="" %then three = ":n" %else three = three.".iob"
  openinput(3,three)
  openoutput(1,out.".iob")
  %if map=0 %then openoutput(2,":n") %else openoutput(2,out.".map")

modules=0; nextref=1; lastsymbol=0; futile=0
selectoutput(0)
scanstream(1)
scanstream(2)
scanstream(3)
%stopif modules=0
require module(1)
showmax(2);!showmax(0)
%stopunless futile=0
selectoutput(1)
codeseg=codebase; dataseg=database
loadstream(1)
loadstream(2)
loadstream(3)
printsymbol(endfile)
showmax(2);!showmax(0)
%endofprogram