// BNCG0.bcpl - BCPL Compiler -- Nova Code Generator, Main program
// Copyright Xerox Corporation 1980
///*DCS* BNCG Symbol Table Compaction
get "bncgx"
external InitToRead
static
[ PassTwo = false
LabelDef = false
Cparameter = 32
PCparameter = 16
plabdefvec = nil
pchainvec = nil
plabelt = 0
lchainvec = nil
llabelt = 0
elabelvec = nil
eaddrvec = nil
elabelt = 0
vlabelt = 0
zlabelt = 0
ctypetable = nil
cdatatable = nil
caddrtable = nil
cnametable = nil
ctablep = 0
constcount = 0
constreflimit = #77777
casev = nil
casel = nil
argvec = nil
arg1 = nil
arg2 = nil
arg3 = nil
framestack = nil
framestackp = 0
Dict = nil
///*DCS*
DictPtr = nil
VirginSym = 0
PC = nil
PCmax = nil
]
///*DCS*
structure SYMPTR:
[
Virgin bit 1 ///* if on, symbol useless
link bit 15 ///* => next symbol, no longer needed.
]
manifest
[
Vsymsize = 64
]
let GenerateCode() be
[ if SWDebug do WriteS("NCG*n")
Code = Newvec(Codelimit)
PC, PCmax = 1, Codelimit
vlabelt = 0
zlabelt = 0
plabelt = Nextparam() - 1
pchainvec = Newvec(plabelt)
plabdefvec = Newvec(plabelt)
for i = 0 to plabelt do plabdefvec!i = 0
llabelt = Nextstatic() - 1
lchainvec = Newvec(llabelt)
elabelt = Nextentry() - 1
elabelvec = Newvec(elabelt)
eaddrvec = Newvec(elabelt)
for i = 0 to elabelt do elabelvec!i, eaddrvec!i = 0, 0
ctypetable = Newvec(ctablesize)
cdatatable = Newvec(ctablesize)
caddrtable = Newvec(ctablesize)
cnametable = Newvec(ctablesize)
argvec = Newvec(argvecsize)
framestack = Newvec(framestacksize)
Reposition(DictStream, 0)
InitToRead(DictStream)
///*DCS* Dict = Newvec(DictLength) ///* old code
///* for i = 0 to DictLength-1 do Readword(DictStream, lv Dict!i)
///* Look at each Symbol. There exist virgin symbols (entered,
///* but never referenced) and others. Virgin symbols have the
///* virgin bit on in the now unused pointer word (word 0). Read
///* in only non-virgin symbols. Record their file indices in the
///* DictPtr table, for use by binary search.
Dict = Newvec(RealSymSize) // Size of non-virgin symbols
DictPtr = Newvec(RealSymCount) // Number of same
///* dump first letter dispatch table
let symptr, symct, onewd = 0, 0, nil
for i = 0 to ($z-$a+1)*2+1-1 do Readword(DictStream,lv onewd)
for i = ($z-$a+1)*2+1 to DictLength-1 do
[readasymbol
Readword(DictStream, lv onewd) ///* link word, w/virgin bit
Readword(DictStream, lv Dict!(symptr+1)) ///* 1st word, w/count
///* sz is index rel symptr of last word in symbol
let sz = (((Dict!(symptr+1)) rshift 8)/Bytesperword)+1
for j=2 to sz do
Readword(DictStream, lv Dict!(symptr+j))
unless onewd<<SYMPTR.Virgin do
[
DictPtr!symct = symptr
symct = symct + 1
Dict!symptr = i+1 ///* the internal rep. of this symbol
symptr = symptr+sz+1
if symct eq RealSymCount then break
]
i = i + sz
]readasymbol
///*DCS* End of Modified Symbol Table Read
for p = Code to Code + Codelimit do rv p = 0
Writeword(CodeStream, Version)
let head = vec #16
let headpos = Position(CodeStream)
for i = 0 to #16-1 do [ head!i = 0; Writeword(CodeStream, head!i) ]
head!2 = BP()
SWList = SWPassOneList
SWCode = SWPassOneCode
PassTwo = false
ResetStream(OcodeStream, $c)
InitToRead(OcodeStream)
let ocodepos = Position(OcodeStream)
[ for i = 0 to plabelt do pchainvec!i = 0
for i = 0 to llabelt do lchainvec!i = 0
for i = 0 to ctablesize do
ctypetable!i, cdatatable!i, caddrtable!i, cnametable!i = 0, 0, 0, 0
ctablep = 0
constreflimit = #77777
constcount = 0
for i = 0 to argvecsize do argvec!i = 0
SSP = 1
MaxSSP, MaxVecSSP = SSP, SSP
Initstack(SSP)
for i = 0 to framestacksize do framestack!i = 0
framestackp = 0
PC, PCmax = 1, Codelimit
vlabelt = 0
zlabelt = 0
ScanImpures()
ScanPures()
if PassTwo break
PassTwo, SWList, SWCode = true, SWPassTwoList, SWPassTwoCode
Reposition(OcodeStream, ocodepos)
] repeat
CloseTemp(OcodeStream, $c)
head!4 = BP()
if PassTwo do WB(elabelt)
for i = 1 to elabelt do
[ if PassTwo do WB(elabelvec!i); if PassTwo do WB(eaddrvec!i) ]
head!6 = BP()
if PassTwo do WB(PC)
Code!0 = PC
for i = 0 to PC-1 do if PassTwo do WB(Code!i)
head!#10 = BP()
if PassTwo do WB(llabelt)
for i = 1 to llabelt do if PassTwo do WB(lchainvec!i)
head!#12 = BP()
if PassTwo do WB(zlabelt)
let p = lv Code!PCmax
for i = 1 to zlabelt do if PassTwo do
[ WB(p!0); WB(p!1); p = p + 2 ]
head!0 = BP()
let endpos = Position(CodeStream)
Reposition(CodeStream, headpos)
for i = 0 to #16-1 do if PassTwo do WB(head!i)
Reposition(CodeStream, endpos)
CloseTemp(DictStream, $d)
]
///*DCS* Binary Search for symbol N
and LookForSym(N) = valof
[
let pos = RealSymCount rshift 1
let inc = pos
///* repeat
[
let ptr = Dict+(DictPtr!pos)
let val = @ptr
if val eq N then resultis ptr+1
if inc eq 1 then break ///* No more chances
inc = (inc+1) rshift 1
test val gr N
ifso
[
pos = pos-inc
if pos ls 0 then pos = 0
]
ifnot
[
pos = pos+inc
if pos ge RealSymCount then pos = RealSymCount-1
]
] repeat
if N eq Dict!0 then resultis Dict+1 ///* Special test for 0
///* Referenced but once -- Go get from Complete Dictionary
resultis SymFromDict(N)
]
and SymFromDict(N) = valof
[
if VirginSym eq 0 then
VirginSym = Newvec(Vsymsize)
Reposition(DictStream, N*Bytesperword)
Readword(DictStream, lv VirginSym!0)
for i = 1 to Length(VirginSym)/Bytesperword do
Readword(DictStream, lv VirginSym!i)
resultis VirginSym
]
and CGreport(n) be
[ Ostream = ErrorStream
WW($*n)
WriteLine(Curline)
let m = selecton n into
[ default: 0
case 0: "TOO MUCH CODE GENERATED"
case 1: "BAD FRAME REFERENCE -- PROBABLY A COMPILER BUG"
case 2: "STATEMENT TOO BIG"
]
BCPLreport(n, m)
if SWHelp do Help("NCG REPORT")
goto Abort
]
and Readop() = valof
[ let op = nil
Readch(OcodeStream, lv op)
//WriteS("Readop="); WW(op);WriteO(op);WW($*N)
resultis op
]
and ReadC() = valof
[ let c = nil
Readch(OcodeStream, lv c)
//WriteS("ReadC="); WW(c);WriteO(c);WW($*N)
resultis c
]
and ReadL() = valof
[ let l = nil
Readaddr(OcodeStream, lv l)
//WriteS("ReadL="); WW(l);WriteO(l);WW($*N)
resultis l
]
and ReadN() = valof
[ let n = nil
Readword(OcodeStream, lv n)
//WriteS("ReadN="); WW(n);WriteO(n);WW($*N)
resultis n
]
and WriteOct(n) be
[ let zsw = true
for i = 15 to 3 by -3 do
[ let d = (n rshift i) & #7
unless zsw & (d eq 0) do
[ WW(d+$0); zsw = false ]
]
WW((n & #7)+$0)
]
and WB(n) be Writeword(CodeStream, n)
and BP() = Position(CodeStream)/2
and Nval(n) = n
and Bval(n) = n & #377
and Wval(n) = (n & #200) eq 0 ? n, n % #177400
and STRval(u, p) = valof
[ Packstring(u, p); resultis u!0/2 ]