!PRIMGEN: Generate const arrays for IMP/PASCAL PRIM + PERM
!         using PRIM.OBJ and PRIM.LIS
%include "INC:UTIL.IMP"
@16_3F00-192 %routine         closeinput
@16_3F00-198 %routine         closeoutput
%begin
%constinteger compiler=1, obj=2, list=3;  !input streams
%constinteger ignore=17 {words to ignore at outset},
              rts=16_4E75,
              sign16=-32768
%integer i,max,first,count,procs=0,total=0

%constinteger CODEBOUND=2000
%shortarray CODE(1:codebound)
%constinteger CHARBOUND=2000
%bytearray CHAR(0:charbound)
%integer CHARBASE,CHARLIM1,CHARLIM=1

%recordformat OBJINFO %C
  (%short FLAGS,TYPE,
   (%short LINK %or %short XTYPE %or %short SIZE %or %short ACT),
   %byte REG,MODE,
   %integer VAL)
%recordformat IDENTINFO %C
  ((%short FLAGS,TYPE,
   (%short LINK %or %short XTYPE %or %short SIZE %or %short ACT),
   %byte REG,MODE,
   %integer VAL %or %record(objinfo) DETAILS),
   (%short   TEXT,HLINK %or %short X,Y))
!M68000 addressing modes:-
%constinteger DREGMODE=0, AREGMODE=2_001000,
              INDMODE=2_010000, POSTMODE=2_011000, PREMODE=2_100000,
              DISPMODE=2_101000, INDEXMODE=2_110000, ABSMODE=2_111000,
              PCMODE=2_111010, LITMODE=2_111100
%constinteger INDIR=indmode-aregmode, POST=postmode-aregmode,
              PRE=premode-aregmode
!Additional source-related modes:
%constinteger LABMODE=2_10000000+pcmode,
              PROCMODE=2_11000000+pcmode,
              CONSTMODE=2_01000000+pcmode,
              FRAMEMODE=2_10000000+dispmode

%constinteger DICTMIN=41
%constinteger DICTBOUND=300
%record(identinfo)%array DICT(0:dictbound)
%integer DLIM=0
%record(identinfo)%name DP
!
%integer CURID=0,IDMAX=0
%constinteger IDBOUND=100
! IMP or PASCAL required names:-
%string(15)%array IDENTS(1:idbound+idbound)
%ownbytearray OK(1:idbound)=0(*)

%routine READ CODE FILE
%integer i,j,k
  %on %event 9 %start
    write(max,1);  printstring(" words of code read")
    newline
    %return
  %finish
  max = -ignore
  %cycle
    read symbol(j)
    read symbol(k)
    max = max+1
    code(max) = j<<8+k %if max > 0
  %repeat
%end

%routine REPORT(%string(255) s)
%integer j=outstream
  select output(0)
  print line(s)
  select output(j)
%end

%routine LOCATE(%string(255) s)
%integer j,k
%on %event 9 %start
  report("*Premature end of program") %if s # "%endofprogram"
  select input(j)
  %return
%finish
  j = instream
  select input(compiler)
  %cycle
    read symbol(k);  printsymbol(k)
    %if k = charno(s,1) %start
      i = 1
      %cycle
        i = i+1
        %if i > length(s) %start;  !all matched
          read symbol(k) %until k = nl %and nextsymbol = nl;  !skip to blank line
          select input(j)
          %return
        %finish
        read symbol(k);  printsymbol(k)
      %repeat %until charno(s,i) # k
    %finish
    %while k # nl %cycle
      read symbol(k);  printsymbol(k)
    %repeat
  %repeat
%end

%integer SYM
%routine SKIP REST
  read symbol(sym) %while sym # nl
%end

%routine READ MARK
  read symbol(sym) %until sym > ' '
%end

%routine READ SEPARATOR
  read symbol(sym) %until sym = '|'
%end

%routine READ TYPE(%shortname t)
  skip symbol %while next symbol = ' '
  read(t)
%end

%routine READ DICT INFO
! Read through listing file to obtain DICT dump
!Dict info format: "___ident ..."
!                   ident | flags | type | link | cat | mode | value

%constbytearray catsym(0:15) =
  'I', 'C', 'B', 'E', '@', 'X', '6', '7',
  'S', 'A', 'Z', ':', 'R', 'F', '!', '?'

%constbytearray flagsym(0:15) =
  'W','R','V','A','w','r','o','m','S','T','K','?','P','p','E','*'

%integer i,j,k
%record(identinfo)%name dp

%routine READ IDENT
!First char in SYM
%integer cl
  charlim1 = charlim;  charlim = charlim+1
  %cycle
    char(charlim) = sym;  charlim = charlim+1
    read symbol(sym)
  %repeat %until %not ('a' <= sym!32 <= 'z' %or '0' <= sym <= '9')
  char(charlim1) = charlim-charlim1-1
  %return %unless sym = ':';  !alias
  read symbol(sym)
  cl = charlim;  charlim = charlim+1
  %cycle
    char(charlim) = sym;  charlim = charlim+1
    read symbol(sym)
  %repeat %until %not ('a' <= sym!32 <= 'z' %or '0' <= sym <= '9')
  char(cl) = charlim-cl-1+128
%end

%on %event 9 %start
  report("*Unexpected end of listing file reading DICT info")
  %return
%finish
  %cycle
    read mark
    %exit %if sym = '_' = nextsymbol
    skip rest
  %repeat
  skip rest
  %cycle
    read symbol(sym) %until sym > ' ' %and %not '0' <= sym <= '9'
    %exit %if sym # '|'
    dp == dict(dlim);  dp = 0
    read mark
    %if sym > '9' %and sym # '|' %start;  !"*anon*"
      read ident
      dp_text = charlim1
    %finish
    read symbol(sym) %while sym # '|'
    read symbol(sym)
    %if sym # ' ' %start;  !category
      i = 16
      i = i-1 %until i < 0 %or catsym(i) = sym
      %if i < 0 %then report("*Unknown category ".tostring(sym)) %c
      %else dp_flags = i
    %finish
    read mark
    %while sym # '|' %cycle
      i = 16
      i = i-1 %until i < 0 %or flagsym(i) = sym
      %if i < 0 %start
report("*Unknown flag sym ".tostring(sym)." for ".string(addr(char(dp_text))))
      %else
        dp_flags = dp_flags!1<<i
      %finish
      read mark
    %repeat
    read type(dp_type);  read separator
    read type(dp_link);  read separator
    read(dp_reg);  read separator
    read(dp_mode);  read separator
    read(dp_val)
    skip rest
    dlim = dlim+1
  %repeat
%end

%routine READ LIST INFO
! Required names introduced by '{'
! Map info format:  "routname"     | Code: n  Entry: m
%integer size=0,entry=0,i,j,k,first,curid,lastid,closed
%string(31) s,t
%routine READ IDENT(%string(31)%name s)
  closed = 0
  %cycle
    read symbol(sym)
    closed = 1 %if sym = '}'
  %repeat %until 'a' <= sym!32 <= 'z' %or sym = '@'
  s = ""
  %if sym = '@' %then read symbol(sym) %else %start
    %cycle
      s = s.tostring(sym)
      read symbol(sym)
    %repeat %until %not ('a' <= sym!32 <= 'z' %or '0' <= sym <= '9')
  %finish
%end
%predicate FOUND
%string(255)%name d
%integer i,l
  i = dict(curid)_text
  %unless 0 <= i < charlim %start
    j = outstream
    select output(0)
    printstring("Text (");  write(i,0)
    printstring(") unsound for ");  write(curid,0)
    newline
    select output(j)
    %false
  %finish
  d == string(charbase+i)
  l = length(d)
  %false %unless l = length(t)
  %for i = 1,1,l %cycle
    %false %if charno(d,i)!32 # charno(t,i)!32
  %repeat
  d = t;  !take case from T *NB*
  %true
%end
%on %event 9 %start
  report("*Unexpected end of listing file reading LIST info")
  %return
%finish
  first = 1;  lastid = dictmin-1
  %cycle
    %cycle
      read mark
      %exit %if sym = '"'
      %if sym # '?' %and sym # '*' %start
        read symbol(sym) %until (sym = '{' %and nextsymbol = '|') %c
                         %or sym < ' '
      %finish %else skip rest
      %exit %if sym = '{'
    %repeat
    %if sym = '{' %start
      read ident(s)
      %if s # "" %start
        %if first # 0 %start
          printstring("%constinteger ")
          first = 0
        %else
          printsymbol(',');  newline;  spaces(14)
        %finish
        %for i = 1,1,length(s) %cycle
          k = charno(s,i);  k = k-32 %if k >= 'a'
          printsymbol(k)
        %repeat
        printstring("=")
      %finish
      t = s
      read ident(t) %if closed = 0
      curid = lastid
      curid = curid+1 %until curid >= dlim %or found
      %if curid >= dlim %start
        report("*Unknown name ".t)
      %else
        lastid = curid
      %finish
      %if s # "" %start
        write(curid,0)
        first = 0
      %finish
      skip rest
    %else
      read symbol(sym)
      %exit %if sym < 'a'
      read ident(t)
      read mark
      %if sym = '|' %start
        procs = procs+1
        skip symbol %while %not '0' <= nextsymbol <= '9'
        read(j)
        skip symbol %while %not '0' <= nextsymbol <= '9'
        read(entry);  skip symbol
        entry = size+entry>>1
        size = size+j>>1
        %if curid < dlim %start
          dict(curid)_mode = absmode
          dict(curid)_val = (16_8000+total+1)<<16 + entry<<8 + size
        %finish
        total = total+size
        entry = 0;  size = 0
      %finish
    %finish
  %repeat
  newline
%end;  !read list info

%ownstring(127) oldfile="",
                objfile="PRIM.MOB", lisfile="PRIM.LIS",
                newfile=""
  define param("Old compiler",oldfile,pamnodefault+paminfile)
  define param("Object file",objfile,paminfile)
  define param("Listing file",lisfile,paminfile)
  define param("New compiler",newfile,pamnewgroup)
  process parameters(cliparam)
  newfile = oldfile %if newfile = ""
  open output(1,newfile)
  select output(0)

  char(0) = 0
  charbase = addr(char(0))
  select input(obj)
  read code file
  select input(list)
  select output(1)
  locate("!* PRIMGEN marker 1");  newline
  read dict info
  reset input
  read list info
!
  locate("!* PRIMGEN marker 2");  newline
  printstring("%const%integer CMAX=");  write(charlim,0);  newline
  printstring("%const%byte%array CHARINIT(0:CMAX) = ")
  i = 0
  %cycle
    %if char(i) <= 32 %or char(i) >= 128 %start
      newline %and space %if char(i) <= 32;  write(char(i),1)
    %else
      printsymbol('''');  printsymbol(char(i));  printsymbol('''')
    %finish
    printsymbol(',')
    i = i+1
  %repeat %until i = charlim
  newline;  printsymbol('0');  newline
  
!** To use record array when available: present approach requires
!   different PUT WORD and PUT LONGWORD for Vax
%routine PUT WORD(%integer v)
%short k<-v
l: write(k,0)
%end
%routine PUT LONGWORD(%integer v)
  put word(v>>16)
  printsymbol(',')
  put word(v)
%end

  printstring("%constinteger PREMAX=");  write(dlim-1,0);  newline
  printstring("%const%short%array DICTINIT(")
  write(dictmin,0)
  printstring("*6:PREMAX*6+5) = ")
  i = dictmin
  %cycle
    dp == dict(i)
    newline;  space
    put word(dp_flags);  printsymbol(',')
    %if dp_text = 0 %then put word(\dp_type) %c
    %else put word(dp_type);  printsymbol(',')
    put word(dp_link);  printsymbol(',')
    put word(dp_reg<<8+dp_mode);  printsymbol(',')
    put longword(dp_val)
    i = i+1
    %exit %if i >= dlim
    printsymbol(',')
  %repeat
  newline

  locate("!* PRIMGEN marker 3");  newline
  printstring("%const%short%array PRIMCODE(1:")
  write(total,0);  printstring(") <- ");  newline
  first = 1;  count = 0
  i = 1
  %cycle
    newline %and count = 0 %if count >= 8
    count = count+1
    count = 8 %if code(i) = rts
    printstring("16_");  phex4(code(i))
    i = i+1
    %exit %if i > total
    printsymbol(',')
  %repeat
  newline

  locate("%endofprogram")
  newline

  select output(0)
  write(total,1);  printstring(" words in")
  write(procs,1);  printstring(" procedures")
  newline
%endofprogram