!
! ALIST for IMP-11 programs.
!
! Takes the relocatable object file and the source file,
! producing a listing matching code addresses (relative to
! the file code-base) with the corresponding source lines.
!

{E} %include "ERCM11.IMP77_SPECS"

! stream usage:
%const %integer  source = 1, object = 2
%const %integer  listing = 1


!DV!%begin
{E} %external %routine  ALIST11 (%string(255) param)

   %switch  c (1:11)
   %integer  n, modules, module, ca, code, gla
   %const %string(39)  form err = "Form:  ALIST source,object/listing"

   %routine  FAIL (%string(30) why)
      select output (0)
      print string ("**");  space %unless charno(why,1) = ' '
      print string (why)
      newline
      %stop
   %end

   %routine  GET (%integer %name n)
      %integer s1, s2
      read symbol (s1);  read symbol (s2)
      n = s2<<8 + s1
   %end

   %routine  OCTAL (%integer n)
      %integer j
      n = n & 16_FFFF
      %for j = 15, -3, 0 %cycle
         print symbol (n>>j & 7 + '0')
      %repeat
   %end

   %routine  ENTRY (%integer mode)
      %integer s, n, l, t
      %string(30) text;  text = ""
      %if mode # 0 %start
         get (n)
      %finish
      read symbol (t);  read symbol (l)
      %while l > 0 %cycle
         read symbol (s)
         text = text . tostring(s)
         l = l - 1
      %repeat
      %if module = 1 %start;    ! This to be printed
         spaces (12 - length(text))
         print string (text)
         write (t, 1)
         %if mode # 0 %start
            space;  octal( n)
         %finish
         newline
      %finish
   %end

   %routine  COPY LINE (%integer to)
      %own %integer line no = 0, eof = 0
      %integer s
      %on 9 %start
         eof = 1
         %return
      %finish
      %return %if eof # 0
      select input (1)
      %while line no < to %and eof = 0 %cycle
         line no = line no + 1
         write (line no, -4);  spaces(2);  octal (ca);  spaces(2)
         %cycle
            read symbol (s)
            print symbol (s) 
         %repeat %until s = nl
      %repeat
      select input (2)
   %end



{EV}%routine  OPEN UP
{EV}  %string(255) obj, list
{EV}  %string(255) %name file
{EV}  %on 9 %start
!EV!      fail (last stream error)
{EV}  %finish
{E}   fail (form err) %unless param -> param . (",") . obj
{E}   list = ".OUT" %unless obj -> obj . ("/") . list %or %c
{E}                         obj -> obj . (",") . list
!V!   param = cli param
!V!   list = ".tt" %unless param -> param . ("/") . list
!V!   obj = param %unless param -> obj . (",") . param
{E}   set default ("#IMP")
!V!   set default (".IMP")
{EV}  open input (source, param)
{E}   set default ("#REL")
!V!   set default (".REL")
{EV}  open input (object, obj)
{E}   set default ("")
!V!   set default (".ALS")
{EV}  open output (listing, list)
{EV}%end

   %on 9 %start
      fail ("EOF while reading object file")
   %finish


!D!select input (source);   fail (form err) %if in type <= 0

   select input (object);  select output (listing)

!D!fail (form err) %if in type <= 0 %or out type < 0 

   newline
   print string ("ALIST of file ");  print string (in file name)
   newlines (2)

   get (modules);                       ! but only first module examined
   print string ("Entry points:");  newlines(2)
   %for module = 1, 1, modules %cycle
      get (n);                          ! No of definitions
      entry (1) %for n = 1, 1, n
      get (n)
      entry (0) %for n = 1, 1, n
      get (code);  get (gla)
      %if module = 1 %start
         newline;  print string ("Code size "); octal (code)
         newline;  print string (" Gla size "); octal (gla)
         newlines (2)
      %finish
   %repeat
   ca = 0
   %cycle
      read symbol (n)
      -> c(n) %if 1 <= n <= 11
      select output (0)
      printstring ("Corrupt object!"); newline
      %stop

c(1): ! Code word
      ca = ca + 2
      get (n)
      %continue
c(5): ! Change code base
      get (ca)
      %continue
c(6): ! Set line number
      get (n)
      copy line (n)
      %continue
c(4): ! Patch
      get (n)
c(2): ! Gla word
c(7): ! External index
      get(n)
c(9): ! Code base offset 
c(10):! Gla base offset
c(11):! PC offset
c(3): ! ???
   %repeat
c(8): ! end

   copy line (32767);  ! Should be enough????
   newline

%end %of %program