%externalroutinespec destroy(%string(255) s)
%externalroutinespec prompt(%string(15) s)
%externalroutinespec link11(%string(255) s)
%externalroutinespec define(%string(255) s)
%begin

%recordformat sbf((%string(255) s) %or (%byteintegerarray b(0:255)))
%record(sbf) sb, f, g

%integer n,i
%constinteger maxvec=100

%routine putw(%integer n)

  print ch(n&x'ff')
  print ch((n>>8)&x'ff')
  
%end

%routine putb(%integer n)

  print ch(n&x'ff')

%end

%routine puts(%record(sbf)%name s)

%integer i,n
  
  n=s_b(0)
  %for i=0,1,n %cycle
    print ch(s_b(i))
  %repeat

%end

%routine octal(%integer n)
%integer i

  %for i=15,-3,0 %cycle
    printsymbol('0'+(n>>i)&7)
  %repeat

%end
%routine reads(%record(sbf)%name s)
%integer i,ch

  i=0
  %cycle
    readsymbol(ch)
    %if ch=nl %then %exit
    i=i+1
    %if 'a'<=ch<='z' %then ch=ch+'A'-'a'
    s_b(i)=ch
  %repeat
  s_b(0)=i

%end

!
! setup various files, including the linker drive file
!
  prompt("Build file:")
  reads(f)
  define("2,T#LINK")
  define("3,".f_s."#FIX")
  select output(2)
  printstring(".ENTRY DISPATCHVECTOR"); newline
  printstring(".ALONE 0 20000"); newline
  printstring(".SQUEEZE"); NEWLINE
  printstring(".STACK 0"); newline
  printstring(".FIXUP IMP#FIX"); newline
  printstring(".NOPERM"); newline
  printstring("T#".f_s); newline
  %cycle
   prompt("Library (REL) file:")
   reads(g)
   %exit %if g_s=".END"
   printstring(g_s); newline
  %repeat
  printstring(".END"); newline
  printstring(f_s); newline
  select output(0)
  close stream(2)
  define("1,".f_s)
  define("2,T#".f_s)
  %begin
  %integer ch
    %on %event 9 %start
      select input(0)
      select output(0)
      close stream(5)
      -> x
    %finish

    define("5,IMP#FIX")
    select input(5)
    select output(3)
    %cycle
      read symbol(ch)
      print symbol(ch)
    %repeat
x:
  %end
  n=0


!first find out how many externals there are in the file

select input(1)
  %cycle
    reads(sb)
    %exit %if sb_s=".END"
    n=n+1
  %repeat
! module preamble

  select output(2)
  putw(0);          !last module
  putw(2*n+2); !length of read only area
  putw(0);          !length of read/write area
  putw(0);          !length of diagnostic area
  putw(0);          !length of line number area
  putw(0);          !length of event area


! module name

  g_s="Shared Perm"
  puts(g)

!one "entry point"

  putw(1)
  putb(5);          !read only area
  putw(0);          !at location 0
  sb_s="DISPATCHVECTOR"
  puts(sb)

!now read externals and plant them



  select input(0)
  close stream(1)
  select input(1)
  putw(n);           !no of externals
  select output(3)
  %for i=1,1,n %cycle
    reads(sb)
    select output(2)
    puts(sb)
    select output(3)
    printstring(sb_s." @")
    octal(2*i)
    newline
  %repeat

!now plant "code"

  select output(2)
  putb(1); putw(0);   !set current address to start of read only area
  putb(12);putw(0);   !set location 0 to 0

  %for i=1,1,n %cycle
    putb(9);          !modify next location by adding actual address 
    putw(i);          !of external number i
    putb(12);         !location is
    putw(0);          !zero
  %repeat

  putb(15);           !end of module
  select output(0)
  select input(0)
  close stream(1)
  close stream(2)
  select output(0)
  close stream(3)
  link11("T#LINK/".f_s."#MAP")
  select output(0)
  destroy("T#LINK,T#".f_s)
  
  printstring("Shared library file ".f_s."#ABS written"); newline
  printstring("Fixup file ".f_s."#FIX written"); newline
  printstring("Map file ".f_s."#MAP written"); newline
  printstring("Temp files destroyed"); newline

%endofprogram