!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