// BNCG4.bcpl - BCPL Compiler
// Nova Code Generator, Instruction generation routines
// Copyright Xerox Corporation 1980
// Last modified on Sat 28 Oct 72 0246.15 by jec.
get "bncgx"
let CGlda(reg, arg) be
[ CGmemref(Ilda + (reg lshift 11), arg)
]
and CGsta(reg, arg) be
[ CGmemref(Ista + (reg lshift 11), arg)
]
and CGmemref(op, arg) be
[ let addr = 0
test ref!arg ne 0
then [ unless type!arg eq XR do
[ let a = vec argsize-1
type!a, ref!a, loc!a, name!a = type!arg, 0, loc!arg, name!arg
CGlda(X, a)
]
if (ref!arg & #100000) ne 0 do addr = addr + Ideferbit
addr = addr + (X lshift 8) + (ref!arg & #377)
]
or switchon type!arg into
[ case RVNUMBER:
if (loc!arg & #177400) eq 0 do
[ addr = addr + loc!arg
endcase
]
if (not SWAlto)&(loc!arg & #177400) eq #100000 do
[ addr = addr + (loc!arg & #377) + Ideferbit
endcase
]
addr = addr + Ideferbit
case NUMBER:
addr = addr + (R lshift 8) + CGconst(Nconst, loc!arg, name!arg)
endcase
case RVLOCAL:
addr = addr + Ideferbit
case LOCAL:
addr = addr + (P lshift 8) + Bval(loc!arg + SSPoffset)
if loc!arg gr MaxSSP do CGreport(1)
endcase
case LABEL:
addr = addr + Ideferbit
case LVLABEL:
addr = addr + (R lshift 8) + CGconst(Lconst, loc!arg, name!arg)
endcase
case RVLABEL:
if SWAlto do CGreport(-99)
addr = addr + Ideferbit + (R lshift 8) + CGconst(Dconst, loc!arg, name!arg)
endcase
case LVCOMMON:
addr = addr + (R lshift 8) + CGconst(Zconst, loc!arg, name!arg)
endcase
case RVCOMMON:
addr = addr + Ideferbit
case COMMON:
addr = addr + (Z lshift 8) + CGzchain(loc!arg)
endcase
default: CGreport(-3)
]
CG(op + addr)
unless SWCode return
if ref!arg ne 0 return
test (addr & Ideferbit) eq 0 then WriteS(" ")
or test type!arg eq LABEL then WriteS(" ")
or WriteS(" @")
WW($()
switchon type!arg into
[ case RVNUMBER:
case NUMBER:
if name!arg ne 0 do [ WriteName(name!arg); WriteS(" = ") ]
WW($#); WriteOct(loc!arg)
endcase
case RVLOCAL:
case LOCAL:
test name!arg eq 0
then [ WriteS("TEMP")
WriteOct(loc!arg)
]
or WriteName(name!arg)
endcase
case LVLABEL:
WriteS("lv ")
case RVLABEL:
case LABEL:
WriteName(name!arg)
endcase
case LVCOMMON:
WriteS("lv ")
case RVCOMMON:
case COMMON:
WriteName(name!arg)
endcase
]
WW($))
]
and CGjumpandsave() be
[
if SWAlto & (type!arg1 eq RVCOMMON & ref!arg1 eq 0) do
// @<common> becomes <common>!0 on Alto
// (CGrv() already does this for non-common <static> )
[ type!arg1 = COMMON
ref!arg1 = #40000
]
if SWNoxios & SWAlto
& (type!arg1 ne XR & ref!arg1 eq #40000) do
// @<static> or <simple-expression>!0 on Alto should generate
// JSRII temp,2 for Noxios.
[ ref!arg1 = 0 //remove the indirection
unless type!arg1 eq LOCAL do CGstoreintemp(arg1) //store in frame
type!arg1 = RVLOCAL //restore the indirection
]
unless ref!arg1 eq 0 do
// Other complex things are done normally
[ CGrv()
CGmemref(Ijsr, arg1)
return
]
if type!arg1 eq RVNUMBER & (loc!arg1 & #177400) eq 0 do
// @<constant page-zero address> is special
[ CGmemref(Ijsr+Ideferbit, arg1)
return
]
unless SWAlto &
(type!arg1 eq RVNUMBER % type!arg1 eq LABEL
% (SWNoxios & type!arg1 eq RVLOCAL)) do
// Unless we can do a JSRII, do it normally
// (JSRII .+n for any Alto if <static> or <constant>
// JSRII n,2 for Noxios only)
[ CGrv()
CGmemref(Ijsr, arg1)
return
]
let op = type!arg1 eq RVLOCAL ? Ajsr2, Ajsr1
let addr = type!arg1 eq LABEL ? CGconst(Lconst, loc!arg1, name!arg1),
type!arg1 eq RVNUMBER ? CGconst(Nconst, loc!arg1, name!arg1),
loc!arg1
CG(op+addr)
if SWCode do
[ WriteS(" @(")
unless name!arg1 eq 0 do [ WriteName(name!arg1); WW($*s) ]
if type!arg1 eq RVNUMBER do
[ WW($#); WriteOct(loc!arg1) ]
WW($))
]
]
and CGmakememref(arg) be
[ if type!arg eq AC do CGreport(-9)
if ref!arg ne 0 do
unless type!arg eq XR do
[ let r = ref!arg
ref!arg = 0
CGloadxr(arg)
ref!arg = r
]
]
and CGae(op, reg1, reg2) be
[ reg1 = reg1 lshift 13
reg2 = reg2 lshift 11
CG(op + reg1 + reg2)
]
and CGconst(ctype, cdata, cname) = valof
[ let p = 0
while p ls ctablep do
[ if ctypetable!p eq ctype & cdatatable!p eq cdata do
unless (caddrtable!p & #100000) eq 0 & PC - caddrtable!p ge #200 break
p = p + 1
]
test p eq ctablep
then [ ctypetable!p = ctype
cdatatable!p = cdata
caddrtable!p = PC + #100000
cnametable!p = cname
ctablep = ctablep + 1
if ctablep ge ctablesize do CGreport(-5)
constcount = constcount + (ctype eq Jconst ? 2, 1)
if constreflimit gr PC do constreflimit = PC
resultis 0
]
or test (caddrtable!p & #100000) eq 0
then [ resultis Bval(caddrtable!p - PC)
]
or [ let pc = caddrtable!p & #77777
[ if PassTwo break
let t = Code!pc & #377
if t eq 0 break
pc = pc + Wval(t)
] repeat
unless PassTwo do Code!pc = (Code!pc & #177400) + Bval(PC - pc)
resultis 0
]
]
and CGoutconstants(n) be
[ if constcount eq 0 return
if n eq 0 do n = PCparameter
let l = PC + constcount + 1 + n
constreflimit = #77777
let firstconst = true
let p = 0
while p ls ctablep do
[ if (caddrtable!p & #100000) ne 0 do
[ let pc = caddrtable!p & #77777
if l - pc le #177 - Cparameter do
[ if constreflimit gr pc do constreflimit = pc
p = p + 1; loop
]
[ if PassTwo break
let t = Code!pc & #377
Code!pc = (Code!pc & #177400) + Bval(PC - pc)
if t eq 0 break
pc = pc + Wval(t)
] repeat
caddrtable!p = PC
if SWCode & firstconst do WriteS("*n*n*t// literals //*n")
firstconst = false
test ctypetable!p eq Nconst
then [ CGn(cdatatable!p)
if SWCode do
[ WriteS(" = ")
if cnametable!p ne 0 do [ WriteName(cnametable!p); WriteS(" = ") ]
WW($#); WriteOct(cdatatable!p)
]
]
or test ctypetable!p eq Lconst
then [ CGn(CGlchain(cdatatable!p))
if SWCode do
[ WriteS(" = "); WriteName(cnametable!p) ]
]
or test ctypetable!p eq Dconst
then [ CGn(CGlchain(cdatatable!p) + #100000)
if SWAlto do CGreport(-98)
if SWCode do
[ WriteS(" ="); WW($@); WriteName(cnametable!p) ]
]
or test ctypetable!p eq Zconst
then [ CGn(CGzchain(cdatatable!p))
if SWCode do
[ WriteS(" = "); WriteName(cnametable!p) ]
]
or test ctypetable!p eq Jconst
then [ CG(Ilongjump)
if SWCode do
[ WriteS(" = LONGJUMP to LAB")
WriteOct(plabdefvec!(cdatatable!p))
]
CGn(CGpchain(cdatatable!p))
]
or CGreport(-4)
constcount = constcount - (ctypetable!p eq Jconst ? 2, 1)
]
p = p + 1
]
if SWCode do WW($*n)
p = 0
while (caddrtable!p & #100000) eq 0 & PC - caddrtable!p gr #200 do p = p + 1
unless p eq 0 do
[ for q = p to ctablep-1 do
[ ctypetable!(q-p) = ctypetable!q
cdatatable!(q-p) = cdatatable!q
caddrtable!(q-p) = caddrtable!q
cnametable!(q-p) = cnametable!q
]
ctablep = ctablep - p
]
]
and CGcheckconstants(n) be
[ if constcount eq 0 return
if constreflimit eq #77777 do CGreport(-6)
if n eq 0 do n = PCparameter
let l = PC + constcount + 1 + n
if l - constreflimit le #177 return
let pc = PC
CG(Ijmp + (R lshift 8) + 0)
CGoutconstants(n)
unless PassTwo do Code!pc = Code!pc + Bval(PC - pc)
]
and CGjmp(l) be
[ if PassTwo do
[ if -#200 le (plabdefvec!l - PC) & (plabdefvec!l - PC) le #177 do
Code!PC = (Code!PC & #177400) + Bval(plabdefvec!l - PC)
]
test pchainvec!l ne 0 & (pchainvec!l & #100000) eq 0 & PC-pchainvec!l le #200
then [ CG(Ijmp + (R lshift 8) + Bval(pchainvec!l - PC))
]
or [ CG(Ijmp + (R lshift 8) + CGconst(Jconst, l, 0))
]
if SWCode do WriteLabel(l)
]
and CGtest(skip, ac1, ac2, l) be
[ CGae(skip, ac1, ac2)
if SWCode do WriteSkip(Code!(PC-1))
CGjmp(l)
]
and CGlabdef(l) be
[ if pchainvec!l ne 0 & (pchainvec!l & #100000) ne 0 do
[ unless PassTwo do
[ let pc = pchainvec!l & #77777
[ let t = Code!pc
Code!pc = Nval(PC - pc)
if t eq 0 break
pc = t
] repeat
]
]
pchainvec!l = PC
plabdefvec!l = PC
if constcount eq 0 return
let p = 0
while p ls ctablep do
[ if ctypetable!p eq Jconst & cdatatable!p eq l do
if (caddrtable!p & #100000) ne 0 do
[ let pc = caddrtable!p & #77777
[ if PassTwo break
let t = Code!pc & #377
Code!pc = (Code!pc & #177400) + Bval(PC - pc)
if t eq 0 break
pc = pc + Wval(t)
] repeat
ctablep = ctablep - 1
for q = p to ctablep - 1 do
[ ctypetable!q = ctypetable!(q+1)
cdatatable!q = cdatatable!(q+1)
caddrtable!q = caddrtable!(q+1)
cnametable!q = cnametable!(q+1)
]
constcount = constcount - 2
constreflimit = #77777
for q = 0 to ctablep-1 do
[ if (caddrtable!q & #100000) eq 0 loop
if (caddrtable!q & #77777) ls constreflimit do
[ constreflimit = caddrtable!q & #77777 ]
]
break
]
p = p + 1
]
]
and CGpchain(l) = valof
[ if pchainvec!l eq 0 do
[ pchainvec!l = PC+ #100000
resultis 0
]
if (pchainvec!l & #100000) ne 0 do
[ let pc = pchainvec!l & #77777
pchainvec!l = PC + #100000
resultis pc
]
resultis Nval(pchainvec!l - PC)
]
and CGlchain(l) = valof
[ let pc = lchainvec!l
lchainvec!l = PC
resultis pc
]
and CGzchain(l) = valof
[ if lchainvec!l eq 0 do
[ lchainvec!l = PC + #100000
resultis 0
]
let n = PC - (lchainvec!l & #77777)
if n le #377 do
[ lchainvec!l = PC + #100000
resultis n
]
PCmax = PCmax - 2
if PCmax le PC do CGreport(0)
zlabelt = zlabelt + 1
Code!PCmax = l
Code!(PCmax+1) = lchainvec!l
lchainvec!l = PC + #100000
resultis 0
]
and CGrv() be
[ unless type!arg1 eq AC do
[ if ref!arg1 eq 0 do
switchon type!arg1 into
[ case LVLABEL: type!arg1 = LABEL; return
case LVCOMMON: type!arg1 = COMMON; return
case NUMBER: type!arg1 = RVNUMBER; return
case LOCAL: type!arg1 = RVLOCAL; return
case COMMON: type!arg1 = RVCOMMON; return
case LABEL: test SWAlto
then ref!arg1 = #40000
or type!arg1 = RVLABEL
return
default:
]
if (ref!arg1 & #140000) eq #40000 do
[ ref!arg1 = ref!arg1 + #100000; return ]
]
CGstoreintemp(arg1)
type!arg1 = RVLOCAL
]
and CGsubscr(j) be
[ if j eq 0 do
if type!arg1 eq NUMBER do
if (loc!arg1 & #177600) eq 0 % (loc!arg1 & #177600) eq #177600 do
[ let i = (loc!arg1 & #377) + #40000
if ref!arg2 eq 0 do switchon type!arg2 into
[ case RVLABEL: if SWAlto do CGreport(-97)
case RVNUMBER:
case LOCAL:
case RVLOCAL:
case LVLABEL:
case LABEL:
case LVCOMMON:
case COMMON:
case RVCOMMON:
Pop1()
ref!arg1 = i
return
case NUMBER:
[ let a = loc!arg1 + loc!arg2
if SWAlto % (a & #100000) eq 0 do
[ Pop1()
type!arg1 = RVNUMBER
loc!arg1 = a
return
]
]
default:
]
CGloadxr(arg2)
Pop1()
ref!arg1 = i
return
]
test type!arg2 eq AC
then
[ CGloadxr(arg1)
CGae(Iadd, loc!arg2, X)
]
or
[ CGloadac(arg1)
CGloadxr(arg2)
CGae(Iadd, loc!arg1, X)
]
Pop2()
Push(XR, (j eq 0 ? #40000, j), X)
]