// BNCG6.bcpl - BCPL Compiler
// Nova Code Generator, Instruction generation routines
// Copyright Xerox Corporation 1980
///*DCS* Last modified on Sat 02 Nov 74 by DCS.
// Paxton, 9-14-78: unsigned compares
get "bncgx"
static [
opcode = nil
defer = nil
addrsign = nil
addrval = nil
star = nil
indx = nil
cary = nil
shft = nil
noload = nil
reg1 = nil
reg2 = nil
skip = nil
]
let CG(op) be
[ test PassTwo then op = Code!PC or Code!PC = op
if SWCode do
[ WW($*n)
WriteO(op); WW($*t)
test LabelDef then WriteS("LAB") or WriteS(" "); LabelDef = false
WriteO(PC)
WW($*t)
WriteInstr(op)
WW($*t)
]
PC = PC + 1
if PC ge PCmax do CGreport(0)
]
and CGn(n) be
[ test PassTwo then n = Code!PC or Code!PC = n
if SWCode do
[ WW($*n)
WriteO(n); WW($*t)
test LabelDef then WriteS("LAB") or WriteS(" "); LabelDef = false
WriteO(PC)
WW($*t)
WriteS(" ")
WriteO(n)
WW($*t)
]
PC = PC + 1
if PC ge PCmax do CGreport(0)
]
and WriteInstr(op) be
[winst
test (op & #100000) eq 0
then
[mref
opcode = selecton (op & #074000) rshift 11 into
[ case #00: "jmp "
case #01: "jsr "
case #02: "isz "
case #03: "dsz "
case #04: "lda 0 "
case #05: "lda 1 "
case #06: "lda P "
case #07: "lda X "
case #10: "sta 0 "
case #11: "sta 1 "
case #12: "sta P "
case #13: "sta X "
case #14: SWAlto?"ALTO ","IO 0 "
case #15: SWAlto?"JSRII","IO 1 "
case #16: SWAlto?"ALTO ","IO P "
case #17: SWAlto?"ALTO ","IO X "
]
defer = ((op & #002000) eq 0 ? " ", " @")
let paddr = op & #377; let maddr = Wval(paddr)
addrsign = (paddr eq maddr ? 0, $-)
maddr = (maddr gr 0 ? maddr, maddr eq 0 ? 0, -maddr)
star = 0
switchon (op & #001400) rshift 8 into
[ case 0: indx = ",Z"; addrval = paddr; addrsign = 0; endcase
case 1: indx = " "; star = $.; addrval = maddr
if addrsign eq 0 do addrsign = $+; endcase
case 2: indx = ",P"; addrval = maddr; endcase
case 3: indx = ",X"; addrval = maddr; endcase
]
WriteS(opcode)
WriteS(defer)
if star ne 0 do WW(star)
if addrsign ne 0 do WW(addrsign)
WriteOct(addrval)
WriteS(indx)
return
]mref
or
[regop
opcode = selecton (op & #003400) rshift 8 into
[ case 0: "com"
case 1: "neg"
case 2: "mov"
case 3: "inc"
case 4: "adc"
case 5: "sub"
case 6: "add"
case 7: "and"
]
cary = selecton (op & #000060) rshift 4 into
[ case 0: 0
case 1: $z
case 2: $o
case 3: $c
]
shft = selecton (op & #000300) rshift 6 into
[ case 0: 0
case 1: $l
case 2: $r
case 3: $s
]
noload = ((op & #000010) eq 0 ? 0, $#)
reg1 = selecton (op & #060000) rshift 13 into
[ case 0: $0
case 1: $1
case 2: $P
case 3: $X
]
reg2 = selecton (op & #014000) rshift 11 into
[ case 0: $0
case 1: $1
case 2: $P
case 3: $X
]
skip = selecton (op & #000007) into
[ case 0: " "
case 1: "skp"
case 2: "szc"
case 3: "snc"
case 4: "szr"
case 5: "snr"
case 6: "sez"
case 7: "sbn"
]
WriteS(opcode)
if cary ne 0 do WW(cary)
if shft ne 0 do WW(shft)
if noload ne 0 do WW(noload)
WW($*s)
WW(reg1)
WW($*s)
WW(reg2)
WW($*s)
WriteS(skip)
return
]regop
]winst
and WriteLabel(l) be
[ WriteS(" (LAB")
WriteOct(plabdefvec!l)
WW($))
]
and WriteName(n) be
[ if n eq 0 do [ WriteS("??"); return ]
///*DCS* Better Symbol Table
WriteS(LookForSym(n))
]
and WriteSkip(op) be
[ let ac1 = (op rshift 13) & #3
let ac2 = (op rshift 11) & #3
op = op & #103777
let skip = selecton op into
[ case Isne0: "ne 0"
case Iseq0: "eq 0"
case Isge0: "ge 0"
case Isgr0: "gr 0"
case Isle0: "le 0"
case Isls0: "ls 0"
case Isne: "ne"
case Iseq: "eq"
case Isge: "ge"
case Isgr: "gr"
case Isle: "le"
case Isls: "ls"
case Isuge: "uge"
case Isugr: "ugr"
case Isule: "ule"
case Isuls: "uls"
case Isne1: "ne -1"
case Iseq1: "eq -1"
default: "??"
]
WriteS("// skip if ")
test ac2 eq X then WriteS("X ")
or [ WriteS("AC"); WriteOct(ac2); WW($*s) ]
WriteS(skip)
unless ac1 eq ac2 do
test ac1 eq X then WriteS(" X")
or [ WriteS(" AC"); WriteOct(ac1); WW($*s) ]
]