// BNCG7.bcpl - BCPL Compiler -- More CG routines
// Copyright Xerox Corporation 1980
// last modified by Butterfield, May 9, 1979 6:53 PM
// - CGothers LSTR: and TABLE:, SWStackStrings - 5/9/79
get "bncgx"
let CGplus(Op) = valof
[ Op = Readop()
if Op eq STWQUAL % Op eq WQUAL do
[ let n = Nval(ReadN())
if Op eq STWQUAL do CGloadac(arg3)
test type!arg1 eq NUMBER
then [ loc!arg1 = Nval(loc!arg1 + n)
CGsubscr(0)
]
or test (n & #177600) eq 0 % (n 𫗀) eq #177600
then [ CGsubscr((n & #377) + #40000)
]
or [ CGadd()
Push(NUMBER, 0, n)
CGsubscr(0)
]
test Op eq STWQUAL then CGstnqual() or CGnqual()
resultis -1
]
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 Op eq VECAP do
[ Pop1()
CGsubscr(i)
CGloadac(arg1)
resultis -1
]
if Op eq STVECAP do
[ Pop1()
CGloadac(arg3)
CGsubscr(i)
unless type!arg2 eq AC do CGloadac(arg2)
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
if loc!arg1 eq 0 do
[ Pop1()
resultis Op
]
if loc!arg1 eq 1 do
[ CGloadac(arg2)
CGae(Iinc, loc!arg2, loc!arg2)
Pop1()
resultis Op
]
if loc!arg1 eq #177777 do
[ Pop1()
CGloadac(arg1)
CGae(Ineg, loc!arg1, loc!arg1)
CGae(Inot, loc!arg1, loc!arg1)
resultis Op
]
]
CGadd()
resultis Op
]
and CGrel(Op) = valof
[ let skip = 0
let ac1, ac2 = nil, nil
if type!arg1 eq NUMBER do
test loc!arg1 eq 0
then skip = selecton Op into
[ case EQ: Isne0
case NE: Iseq0
case LS: Isge0
case LE: Isgr0
case GR: Isle0
case GE: Isls0
default: 0
]
or if loc!arg1 eq #177777
then skip = selecton Op into
[ case EQ: Isne1
case NE: Iseq1
default: 0
]
Clearstack(SSP-3)
CGloadac(arg2)
ac2 = loc!arg2
test skip eq 0
then [
let flip = false
skip = selecton Op into
[
case EQ: Isne
case NE: Iseq
case LS: Isge
case LE: Isgr
case GR: Isle
case GE: Isls
case ULS: valof [ flip=true; resultis Isuge ]
case ULE: valof [ flip=true; resultis Isugr ]
case UGR: valof [ flip=true; resultis Isule ]
case UGE: valof [ flip=true; resultis Isuls ]
]
CGloadreg(arg1)
ac1 = loc!arg1
if flip then [ flip = ac1; ac1 = ac2; ac2 = flip ]
]
or [ ac1 = ac2
]
Initstack(SSP-2)
Op = Readop()
test Op eq JT % Op eq JF
then [ unless Op eq JT do skip = skip neqv Iskpbit
CGtest(skip, ac1, ac2, ReadL())
resultis -1
]
or [ CGae(skip, ac1, ac2)
if SWCode do WriteSkip(Code!(PC-1))
CGae(Iset1+Iskpbit, ac2, ac2)
if SWCode do WriteS("// load TRUE and skip")
CGae(Iset0 , ac2, ac2)
if SWCode do WriteS("// load FALSE")
Push(AC, 0, ac2)
resultis Op
]
]
and CGcall(Op) = valof switchon Op into
[
case RTCALL:
case FNCALL:
[ Clearstack(SSP-1)
Initstack(SSP)
Push(LOCAL, 0, SSP)
resultis -1
]
case PARAM:
[ let i = ReadC()
let n = ReadC()
let l = ReadL()
if n le 3 resultis -1
if i ls 3 resultis -1
CGstoreintemp(arg1)
if SWCode do
[ WriteS("// arg "); WriteN(i); WriteS(" of "); WriteN(n)
if l ne 0 do [ WriteS(" to "); WriteName(l) ]
]
resultis -1
]
case RTAP:
case FNAP:
[ let n = ReadC()
let ssp = ReadN()
unless ssp + n + 2 eq SSP do CGreport(-19)
if type!arg1 eq AC % type!arg1 eq XR do
CGstoreintempN(arg1, ssp)
let argf = vec argsize-1
Copyarg(arg1, argf)
Pop1()
if n gr 3 do
[ for i = 3 to n do
[ unless type!arg1 eq LOCAL & ref!arg1 eq 0 & loc!arg1 eq pos!arg1 do
CGreport(-18)
Pop1()
]
Push(NUMBER, 0, ssp + SSPoffset)
]
if n ge 3 do
[ CGstoreintempN(arg1, SSPtemp3)
if SWCode do
test n eq 3
then [ WriteS(" holds arg 3")
]
or [ WriteS(" holds offset of arg list at TEMP")
WriteOct(ssp)
]
Pop1()
]
test n ge 2
then [ CGload01()
Pop2()
]
or if n eq 1
then [ CGloadac0(arg1)
Pop1()
]
unless type!arg1 eq LOCAL & ref!arg1 eq 0 & loc!arg1 eq pos!arg1 do
CGreport(-17)
unless ssp + 1 eq SSP do
CGreport(-16)
Copyarg(argf, arg1)
CGjumpandsave()
if SWCode do
[ WriteS(" "); WriteN(n)
WriteS(" arg"); unless n eq 1 do WW($s)
]
CGn(n)
Pop1()
if Op eq FNAP do Push(AC, 0, 0)
resultis -1
]
]
and CGothers(Op) = valof
switchon Op into
[
case LN:
[ let n = Nval(ReadN())
Push(NUMBER, 0, n); SetName(ReadL())
resultis -1
]
case LC:
[ Push(NUMBER, 0, ReadN())
resultis -1
]
case TRUE:
[ Push(NUMBER, 0, #177777)
resultis -1
]
case FALSE:
[ Push(NUMBER, 0, 0)
resultis -1
]
case LP:
[ Push(LOCAL, 0, ReadN()); SetName(ReadL())
resultis -1
]
case LL:
[ Push(LABEL, 0, ReadL()); SetName(ReadL())
resultis -1
]
case LZ:
[ Push(COMMON, 0, ReadL()); SetName(ReadL())
resultis -1
]
case LLP:
[ let n = Nval(ReadN())
let vname = ReadL()
let Op1 = Readop()
unless Op1 eq STWQUAL % Op1 eq WQUAL do
[ Push(NUMBER, 0, Nval(n + SSPoffset))
CGloadac(arg1)
CGae(Iadd, P, loc!arg1)
if SWCode do
[ WriteS(" (lv ")
WriteName(vname); WW($))
]
resultis Op1
]
if Op1 eq STWQUAL do CGloadac(arg1)
let w = Nval(ReadN())
let l = Nval(n + SSPoffset + w)
test w eq 0
then [ Push(LOCAL, 0, n)
SetName(vname)
]
or [ Push(NUMBER, 0, l)
CGloadxr(arg1)
CGae(Iadd, P, X)
ref!arg1 = #40000
if SWCode do
[ WriteS(" lv "); WriteName(vname)
WW($+); WriteOct(w); WW($))
]
]
test Op1 eq STWQUAL then CGstnqual() or CGnqual()
resultis -1
]
case LLVP:
[ Push(NUMBER, 0, Nval(ReadN() + MaxSSP + SSPoffset))
CGloadac(arg1)
CGae(Iadd, P, loc!arg1)
resultis -1
]
case LLL:
case LLZ:
[ let l = ReadL()
let vname = ReadL()
let Op1 = Readop()
unless Op1 eq STWQUAL % Op1 eq WQUAL do
[ Push((Op eq LLL ? LVLABEL, LVCOMMON), 0, l)
SetName(vname)
resultis Op1
]
if Op1 eq STWQUAL do CGloadac(arg1)
let w = Nval(ReadN())
test w eq 0
then [ Push((Op eq LLL ? LABEL, COMMON), 0, l)
SetName(vname)
]
or [ Push((Op eq LLL ? LVLABEL, LVCOMMON), 0, l)
SetName(vname)
Push(NUMBER, 0, w)
CGsubscr(0)
]
test Op1 eq STWQUAL then CGstnqual() or CGnqual()
resultis -1
]
case LSTR:
[ let s = vec 128
let n = ReadC()
s!0 = n lshift 8
let i, j = 0, 1
[ if j gr n break
s!i = s!i + ReadC()
j = j + 1
if j gr n break
i = i + 1
s!i = ReadC() lshift 8
j = j + 1
] repeat
CGcheckconstants(i+4)
test SWStackStrings ne 0
ifso
[
CG(Istring); CGn(SWStackStrings);
if not PassTwo then SWStackStrings = PC - 1;
]
ifnot CG(Ijsr + (R lshift 8) + Bval(i+2))
if SWCode do WriteS("// load X with string pointer")
for j = 0 to i do CGn(s!j)
Op = Readop()
switchon Op into
[ case SP:
case SL:
case SZ:
Push(AC, 0, X)
resultis Op
]
let ac = freeac()
CGae(Imov, X, ac)
Push(AC, 0, ac)
resultis Op
]
case TABLE:
[ let n = ReadN()
if n ge #177 do
[ Push(NUMBER, 0, n+2)
CGloadac(arg1)
]
CGcheckconstants(n+4)
test SWStackStrings ne 0
ifso
[
CG(Istring); CG(SWStackStrings); CGn(n);
if not PassTwo then SWStackStrings = PC - 2 + Codelimit;
]
ifnot test n ls #177
ifso CG(Ijsr + (R lshift 8) + Bval(n+1))
ifnot
[
CG(Ijsr + (R lshift 8) + 1)
CGae(Iadd, loc!arg1, X)
CG(Ijsr + (X lshift 8) + 0)
Pop1()
]
if SWCode do WriteS("// load X with table pointer")
for j = 0 to n-1 do CGn(Nval(ReadN()))
Op = Readop()
switchon Op into
[ case SP:
case SL:
case SZ:
Push(AC, 0, X)
resultis Op
]
let ac = freeac()
CGae(Imov, X, ac)
Push(AC, 0, ac)
resultis Op
]
case RV:
[ CGrv()
resultis -1
]
case LVRV:
[ CGloadac0(arg1)
if SWAlto resultis -1
CG(Igetlv)
if SWCode do WriteS(" ( LV)")
resultis -1
]
case VECAP:
[ CGsubscr(0)
if type!arg1 eq XR do CGloadac(arg1)
resultis -1
]
case NEWLOCAL:
[ let n = ReadL()
if type!arg1 eq LOCAL & ref!arg1 eq 0 & loc!arg1 eq pos!arg1 resultis -1
Push(LOCAL, 0, pos!arg1); SetName(n)
CGloadreg(arg2)
CGstore(loc!arg2, arg1)
Pop1()
Setarg(arg1, LOCAL, 0, pos!arg1, pos!arg1, n)
resultis -1
]
case SP:
[ Push(LOCAL, 0, ReadN()); SetName(ReadL())
CGloadreg(arg2)
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
case SL:
[ Push(LABEL, 0, ReadL()); SetName(ReadL())
CGloadreg(arg2)
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
case SZ:
[ Push(COMMON, 0, ReadL()); SetName(ReadL())
CGloadreg(arg2)
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
case STIND:
[ CGloadac(arg2)
CGrv()
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
case STVECAP:
[ CGloadac(arg3)
CGsubscr(0)
unless type!arg2 eq AC do CGloadac(arg2)
CGstore(loc!arg2, arg1)
Pop2()
resultis -1
]
default: CGreport(-8)
]