! Object module linker
! Suitable for FE02 format object modules
! RWT February 1985

! Parameters are PAMmed:
! Group 1: Mainfile (major), a certain number of Auxfiles
! Group 2: Outfile (default: same as mainfile)
! Group 3: Include, Exclude

! Object module formats

%recordformat obj header f(%byte type,version,%half flags,export,import,
  %integer code,%half reset,main,%integer own,stack,spare1,spare2)

%recordformat obj entry f(%half flags,ptype,%integer type,disp,
                          %string(255)name)

! _FLAGS values

%constinteger present=16_8000,extbit=16_4000,procmask=16_3000,
              system=16_1000,external=16_2000,dynamic=16_3000

! Input Reset Routines must look like this or like the output one
! 1 = place holder for number of data words -1

%constinteger irmax=8
%constshortarray ir(0:irmax)=%c
16_224C,         {     move.l a4,a1
16_41FA,16_000E, {     lea glap,a0
16_303C,      1, {     move.w #1,d0
16_32D8,         {loop move.w (a0)+,(a1)+
16_51C8,     -4, {     dbra d0,loop
16_4E75          {     rts
                 {glap equ *
                 {     end

! Output reset routine will look like this
! 1-4 place holders for data and code sizes

%constinteger ormax=34
%consthalfarray or(0:ormax)=%C
16_45FA,16_FFFE,         {  lea *,a2
16_95FC,      4,      3, {  sub.l #$40003,a2    code base
16_41FA,16_003A,         {  lea glap,a0         glap base
16_224C,                 {  move.l a4,a1
16_220A,                 {  move.l a2,d1        code base for later
16_2409,                 {  move.l a1,d2        gla base for later
16_203C,      2,      1, {  move.l #$20001,d0   glap word count
16_6712,                 {  beq.s a
16_4840,                 {  swap d0
16_4840,                 {m swap d0
16_32D8,                 {l move.w (a0)+,(a1)+  copy glap to gla
16_51C8,16_FFFC,         {  dbra d0,l
16_4840,                 {  swap d0
16_51C8,16_FFF4,         {  dbra d0,m
16_224C,                 {  move.l a4,a1        perform relocation
16_3018,                 {a move.w (a0)+,d0
16_6712,                 {  beq.s c             no more
16_0880,16_0000,         {  bclr #0,d0
16_6706,                 {  beq.s b
16_D2C0,                 {  add.w d0,a1
16_D591,                 {  add.l d2,(a1)       data
16_60F0,                 {  bra a
16_D2C0,                 {b add.w d0,a1
16_D391,                 {  add.l d1,(a1)       code
16_60EA,                 {  bra a
16_4E75                  {c rts
                         {glap equ *
%include "inc:util.imp"

%begin
%constinteger debugbit=16_80000000,dynbit=16_40000000
%owninteger control=0

%constinteger relocmax=500
%integer relocp=0
%integerarray reloc(1:relocmax)

%recordformat mdf(%record(mdf)%name next,%record(obj header f)%name header,
                  %integer ca,da, {code, data address as connected now}
                           co,do) {code, data offset wrt combined area}

%record(mdf)%name headers==nil
%record(obj header f) output header = 0
%integer codesize=0, datasize=0, exportcount=0, importcount=0

%constinteger ok=1, hopeless=0
%integer situation = ok

%integerfn entrysize(%record(obj entry f)%name e)
%integer n
  n = sizeof(e)-255+length(e_name)
  %result = (n+1)>>1<<1
%end

%routine suck in(%string(21)%name input file)

! Read the module in file INPUTFILE, making sure it is of
! the form expected.  Make an entry for it in the global
! HEADERS list.  Adjust its export displacements.

%owninteger f=0
%integer start,size
%record(mdf)%name md,m
%record(obj header f)%name header
%record(obj entry f)%name entry
%integer export,import,code,p,i
%conststring(31)%array reason(1:5)=%c
  "not an FE02 object module",
  "non-null reset routine",
  "data size does not tally",
  "incompatible reset routine",
  "does not contain exports"

  %on 3,9,15 %start
    %if event_event=15 %start
      printstring(" unsuitable for linking - ")
      printstring(reason(event_sub))
    %else
      printstring(event_message)
      %if event_message="" %start
        printstring("Trouble with ".input file.": ")
        %if event_event=9 %start
          printstring("End of file reached")
        %else
          printstring("Event 3 ")
          write(event_sub,0); write(event_extra,1)
        %finish
      %finish
    %finish
    newline
    situation = hopeless
    %return
  %finish

  %returnif input file=""
  toupper(input file)
  input file = input file.".MOB" %unless input file -> (".MOB")
  write(f,0) %and space %and f = f+1 %unless control&debugbit=0
  printstring("Reading ".inputfile)
  connectfile(input file,0,start,size)

  header == record(start)
  md == new(md)
  md_header == header
  %signal 15,1 %unless header_type=16_fe %and header_version=2
  export = start+sizeof(header)
  import = export+header_export
  code = import+header_import
  p = header_reset<<1+code
  %if header_own=0 %start
    header_code = header_code-header_own
    md_da = 0
    %signal 15,2 %unless shortinteger(p)=ir(irmax)
    %signal 15,4 %unless header_reset = 0
  %elseif shortinteger(p)=ir(0)
    header_code = p-code
    %for i = 0,1,irmax %cycle
      %if ir(i)=1 %start
        %signal 15,3 %unless (shortinteger(p)&65535)<<1+2=header_own
      %else
        %signal 15,4 %unless ir(i)=shortinteger(p)
      %finish
      p = p+2
    %repeat
    md_da = p
  %elseif shortinteger(p)=or(0)
    header_code = p-code
    %for i = 0,1,ormax %cycle
      %if or(i)=1 %start
        %signal 15,3 %unless (header_own>>1-1-shortinteger(p))&65535=0
      %elseif or(i)=2
        %signal 15,3 %unless (header_own>>1-1)>>16-shortinteger(p)=0
      %elseif 3#or(i)#4
        %signal 15,4 %unless or(i)=shortinteger(p)
      %finish
      p = p+2
    %repeat
    md_da = p
  %finishelsesignal 15,4
  md_ca = code
  md_do = datasize
  md_co = codesize
  md_next == nil
  %if headers==nil %start          {first module: start list
    headers == md
    output header = header
    output header_import = 0
    output header_export = 0
  %else                            {tag on to end of list
    m == headers
    m == m_next %while m_next##nil
    m_next == md
    %signal 15,5 %if header_export=0
  %finish
{spaces(20-length(inputfile))
{phex(md_co); space
{phex(md_do)
  newline
  %unless header_export=0 %start
    p = export
    %cycle
      entry == record(p); %exitif entry_flags&present=0
      %if entry_flags&procmask=0 %start {data object
        entry_disp = entry_disp+datasize
      %else                             {code object
        entry_disp = entry_disp+codesize
      %finish
      output header_export = output header_export+entrysize(entry)
      exportcount = exportcount+1
      p = p+entrysize(entry)
      %unless control&debugbit=0 %start
        phex(entry_disp); space; printstring(entry_name); newline
      %finish
    %repeat
  %finish
  %unless control&debugbit=0 %start
    phex(codesize); space; phex(datasize); space
    phex(header_code); space; phex(header_own); newline
  %finish
  codesize = codesize+header_code
  datasize = datasize+header_own
%end

%constinteger zapped = present

%routine satisfy everything

! For each module which has been read in, see if each of its
! imports can be satisfied internally.  If so, do it, otherwise
! note that it is still required in the output module.

%integer i,j

  %routine locate(%record(objentryf)%name want,%integername address,gla)

  ! Try to satisfy entry WANT internally.  If successful, set ADDRESS
  ! to the offset of the desired object relative to the start of its
  ! area (code/data), and set GLA to the start of the submodule's GLA.
  ! If unsuccessful, set both to 0.

  %record(objentryf)%name got
  %record(mdf)%name md
  %record(objheaderf)%name h
  %integer w,g,p
    md == headers
    %cycle
      h == md_header
      %if h_export#0 %start
        p = addr(h)+sizeof(h)
        %cycle
          got == record(p); %exitif got_flags&present=0
          %if got_name=want_name %start     {name match
            %if got_type=0 %or want_type=0 %c
            %or got_type=want_type %start   {type match
              g = got_flags&procmask; w = want_flags&procmask
              w = external %if w=dynamic
              g = system %if g = external %and h_own=0
              %if g=w %or (g=system %and w=external) %start  {flag match
                %if got_flags&extbit#0 %start
                  got_flags = got_flags-extbit  {suppress export
                  output header_export = output header_export-entrysize(got)
                  exportcount = exportcount-1
                %finish
                i = got_disp; j = md_do; %return
              %finish
            %finish
          %finish
          p = p+entrysize(got)
        %repeat
      %finish
      md == md_next
    %repeatuntil md==nil
    address = 0; gla = 0
  %end

  %routine relocate(%integer x)
  ! Add entry X to the relocation table
    relocp = relocp+1; reloc(relocp) = x
  %end

%record(mdf)%name md
%record(obj header f)%name h
%record(obj entry f)%name e
%integer f=0
%integer t
%integer p

  printstring("Linking")
  t = cputime
  situation = hopeless %andreturnif headers==nil
!
! Process each module's import list
!
  md == headers
  %cycle
    h == md_header
    %unless control&debugbit=0 %start
      printstring("File"); write(f,2); newline; f = f+1
    %finish
    %unless h_import=0 %start
      p = addr(h)+sizeof(h)+h_export
      %cycle
        e == record(p); %exitif e_flags&present=0
        locate(e,i,j)
        %if i=0 %start      {leave as import requirement
          output header_import = output header_import+entrysize(e)
          importcount = importcount+1
          e_disp = e_disp+md_do
          %unless control&debugbit=0 %start
            printstring(" Import: "); phex(e_disp)
          %finish
        %else               {satisfy internally
          e_flags = e_flags&procmask
          %if e_flags=0 %start         {data object
            relocate(md_do+e_disp+1)
            integer(md_da+e_disp) = i
            %unless control&debugbit=0 %start
              spaces(9); phex(i)
            %finish
          %elseif e_flags=system
            shortinteger(md_da+e_disp) = 16_4ef9
            relocate(md_do+e_disp+2)
            integer(md_da+e_disp+2) = i
            %unless control&debugbit=0 %start
              phex(i); spaces(9)
            %finish
          %else
            shortinteger(md_da+e_disp) = 16_287c
            relocate(md_do+e_disp+3)
            integer(md_da+e_disp+2) = j
            shortinteger(md_da+e_disp+6) = 16_4ef9
            relocate(md_do+e_disp+8)
            integer(md_da+e_disp+8) = i
            %unless control&debugbit=0 %start
              phex(i); space; phex(j)
            %finish
          %finish
          e_flags = zapped
        %finish
        %unless control&debugbit=0 %start
          space; printstring(e_name); newline
        %finish
        p = p+entrysize(e)
      %repeat
    %finish
    md == md_next
  %repeatuntil md==nil
  t = cputime-t
  printstring(" completed in "); write(t,0); printstring("ms")
  newline
  output header_code = codesize+datasize+ormax<<1+2+relocp<<1+2
  output header_own = datasize
  output header_reset = codesize>>1
  %if datasize=0 %start
    %signal 15 %unless shortinteger(headers_ca)=16_4e75 %and relocp=0
    output header_reset = 0
    output header_code = output header_code-ormax<<1-4
  %finish
%end

%routine deal with(%string(21)x,%integer inc)
%record(mdf)%name md
%record(obj header f)%name h
%record(obj entry f)%name e
%integer p
  %on 3,9 %start
    printstring(event_message) %and newline %unless event_event=9
    %return
  %finish
  %returnif x=""
  %unless x="*" %start
    %if inc=0 %then prompt("Export:") %else prompt("Import:")
    %if x=":" %then selectinput(0) %elsestart
      openinput(1,x); selectinput(1)
    %finish
    read(x)
  %finish
  %cycle
    md == headers
    %cycle
      h == md_header
      %unless h_export=0 %start
        p = addr(h)+sizeof(h)
        %cycle
          e == record(p); %exitif e_flags&present=0
          %if x="*" %or x=e_name %start
            %if inc#0 %and e_flags&extbit=0 %start
              e_flags = e_flags+extbit
              output header_export = output header_export+entrysize(e)
              exportcount = exportcount+1
            %elseif inc=0 %and e_flags&extbit#0
              e_flags = e_flags-extbit
              output header_export = output header_export-entrysize(e)
              exportcount = exportcount-1
            %finish
          %finish
          p = p+entrysize(e)
        %repeat
      %finish
      md == md_next
    %repeatuntil md==nil
    %exitif x="*"
    read(x)
  %repeatuntil x=":"
%end

%routine spit out(%string(21)%name outfile)
%record(mdf)%name md
%record(objheaderf)%name h
%record(objentryf)%name e
%integer i,j,p

  %routine order(%integer p,q)
  ! Swop reloc(p) and reloc(q) if reloc(p)>reloc(q)
  %integer t
    t = reloc(p)
    %if t>reloc(q) %start
      reloc(p) = reloc(q); reloc(q) = t
    %finish
  %end

  toupper(outfile)
  outfile = outfile.".MOB" %unless outfile -> (".MOB")
  printstring("Writing ".outfile); newline
  openoutput(1,outfile); selectoutput(1)
!
! Output header
!
  output header_export = output header_export+2 %unless output header_export=0
  output header_import = output header_import+2 %unless output header_import=0
  %for i = 0,1,sizeof(output header)-1 %cycle
    printsymbol(byteinteger(addr(output header)+i))
  %repeat
!
! Output exports
!
  %unless output header_export=0 %start
    md == headers
    %cycle
      h == md_header
      %unless h_export=0 %start
        p = addr(h)+sizeof(h)
        %cycle
          e == record(p); %exitif e_flags&present=0
          %if e_flags&extbit#0 %start
            %for i = 0,1,entrysize(e)-1 %cycle
              printsymbol(byteinteger(addr(e)+i))
            %repeat
          %finish
          p = p+entrysize(e)
        %repeat
      %finish
      md == md_next
    %repeatuntil md==nil
    printsymbol(0); printsymbol(0)
  %finish
!
! Output import requirements
!
  %unless output header_import=0 %start
    md == headers
    %cycle
      h == md_header
      %unless h_import=0 %start
        p = addr(h)+sizeof(h)+h_export
        %cycle
          e == record(p); %exitif e_flags&present=0
          %unless e_flags=zapped %start
{selectoutput(0)
{printstring("Still need ".e_name); newline
{selectoutput(1)
            %if e_flags&procmask=dynamic %and control&dynbit=0 %start
              e_flags = e_flags!!dynamic!!external
            %finish
            %for i = 0,1,entrysize(e)-1 %cycle
              printsymbol(byteinteger(addr(e)+i))
            %repeat
{%else
{selectoutput(0)
{printstring("Don't need ".e_name); newline
{selectoutput(1)
          %finish
          p = p+entrysize(e)
        %repeat
      %finish
      md == md_next
    %repeatuntil md==nil
    printsymbol(0); printsymbol(0)
  %finish
!
! Output code
!
  md == headers
  %cycle
    j = md_ca; i = md_header_code
    %while i>0 %cycle
      i = i-1; printsymbol(byteinteger(j)); j = j+1
    %repeat
    md == md_next
  %repeatuntil md==nil
!
! Output reset routine
!
  %unless output header_reset=0 %start
    %for i = 0,1,ormax %cycle
      j = or(i)
      %if j=1 %start
        j = data size>>1-1
      %elseif j=2
        j = (data size>>1-1)>>16
      %elseif j=3
        j = code size
      %elseif j=4
        j = code size>>16
      %finish
      printsymbol(j>>8); printsymbol(j)
    %repeat
  %finish
!
! Output data
!
  md == headers
  %cycle
    j = md_da; i = md_header_own
    %while i>0 %cycle
      i = i-1; printsymbol(byteinteger(j)); j = j+1
    %repeat
    md == md_next
  %repeatuntil md==nil

! Sort and output relocation data

  %if relocp>1 %start
    %for j = relocp,-1,2 %cycle
      %for i = 1,1,j-1 %cycle
        order(i,j)
      %repeat
    %repeat
  %finish
  p = 0
  %for i = 1,1,relocp %cycle
    j = reloc(i)-p; p = reloc(i)>>1<<1
    printsymbol(j>>8); printsymbol(j)
  %repeat
  printsymbol(0); printsymbol(0)
%end

!  Main program

%integer i
%string(21)mainfile=""
%string(21)outfile=""
%string(21)include=""
%string(21)exclude=""
%constinteger auxmax=19
%string(21)%array auxfile(1:auxmax)

auxfile(i) = "" %for i = 1,1,auxmax
define param ("Mainfile",mainfile,pammajor)
define param ("Auxfile".itos(i,0),auxfile(i),0) %for i = 1,1,auxmax
define param ("Outfile",outfile,pamnewgroup)
define param ("Include",include,pamnewgroup)
define param ("Exclude",exclude,0)
define boolean params("DEbug,DYnamic",control,pamnewgroup)
process parameters (cli param)
%stopif mainfile=""
outfile = mainfile %if outfile = ""

suck in (main file);       %stopif situation=hopeless
%for i = 1,1,auxmax %cycle
  suck in (aux file(i));   %stopif situation=hopeless
%repeat

satisfy everything;        %stopif situation=hopeless

deal with(include,1) %if include="*"
deal with(exclude,0)
deal with(include,1) %unless include="*"

spit out(outfile)

selectoutput(0)
printstring("Code="); write(codesize,0)
printsymbol('+') %and write(ormax<<1+2,0) %unless datasize=0
printstring(", Data="); write(datasize,0)
printsymbol('+') %and write(relocp<<1+2,0) %unless datasize=0
printstring(" bytes;  Exports="); write(exportcount,0)
printstring(", Imports="); write(importcount,0)
newline

%endofprogram