// BSAE3.bcpl - BCPL Compiler -- SAE Part 3 - Expression scanning
// Copyright Xerox Corporation 1980
// Last modified on Sun 29 Oct 72 0245.41 by jec.
// gmcd 18 sept 74
// last modified by Butterfield, May 9, 1979 1:15 PM
// - EvalBinop, restore unsigned compares - 5/9
// - EvalBinop, comment out unsigned compares to bootstrap - 5/8
// - incorporate Paxton's unsigned compares - 5/8/79
// Lookat Attempt to evaluate a piece of tree at compile time.
// *EvalBinop Evaluate a binary operator, at compile time.
// *EvalUnop Evaluate a unary operator, at compile time.
// EvalConst Evaluate a constant expression.
// * local to this compilation.
get "bsaex"
// Lookat is applied to the address of a tree node (i.e., with Lookat(H2+x) ).
// Let LVX be Lookat"s argument, and let x = rv LVX . There are three cases...
// 1. The node can be evaluated at compile time. Then replace rv LVX by a NUMBER node
// and return the address of a word containing the computed value
// 2. The node can be simplified, as for a COND with constant condition or a table subscripted
// by a constant. Then replace rv LVX by the simpler node and return Lookat(node)
// 3. No simplification is possible. Lookat has been applied recursively to all sons of
// the node that might be part of an expression.
// Lookat also does the declarations for VALOF blocks
// and looks up all names in the tree,replacing the name with
// a pointer to its declaration node
let Lookat(LVX) = valof
[ let x = rv LVX // The usual sort of node.
if x eq 0 resultis 0 // Nothing to do.
let Value = nil // Put a computed value here if we get one.
and Node = 0 // Put a new node here if we get one.
and LValue = 0 // Put the addr of the value of a new node here
// if we know its value
if (x & NameBit) ne 0 do
[ Node = CellWithName(x)
if Node eq 0 do
[ let xname = x & NameMask
let p = UvecN
while p le UvecP do
[ if (Uvec!p & NameMask) eq xname break
p = p + UvecN
]
if p gr UvecP do
[ SAEreport(10, xname)
test p ls UvecT
ifnot p = 0
ifso [ Uvec!p = xname + LABEL; Uvec!(p+1) = 0; UvecP = p ]
]
Uvec!(p+1) = Uvec!(p+1) + 1
Node = lv Uvec!p
]
rv LVX = Node + NameBit
LValue = Node!0 & TypeMask
if LValue eq LOCAL do
[ if DvecLoc ls DvecP do
[ SAEreport(8, x & NameMask)
resultis 0
]
]
if LValue eq EXTLABEL % LValue eq ZEXTLABEL do
[ if Node!1 eq 0 do
[ Node!1 = Nextstatic()
OutputStatic(Node)
resultis 0
]
]
test LValue eq CONSTANT
ifso resultis lv Node!1
ifnot resultis 0
]
let Op = H1!x
switchon Op into
[ case NUMBER: case CHARCONST:
case TRUE: case FALSE:
case NIL:
resultis H2+x // It is a simple constant
case PLUS: case MINUS: case MULT:
case EQ: case NE: case GR: case LS: case GE: case LE:
case UGR: case ULS: case UGE: case ULE:
case LSHIFT: case RSHIFT:
case LOGAND: case LOGOR: case EQV: case NEQV:
case DIV: case REM:
[ let L, R = Lookat(H2+x), Lookat(H3+x) // Look at the two sons.
unless L > 0 % R > 0 resultis 0 // Return if neither was evaluated.
if L > 0 & R > 0 do // Both were evaluated.
[ Value = EvalBinop(Op, rv L, rv R) // Compute the value.
endcase
]
let LC, RC = L > 0, R > 0 // Switches for L and R being constant.
and LX, RX = nil, nil // For the values.
and L0, L1, LT, LF, R0, R1, RT, RF =
false,false,false,false,false,false,false,false
if LC do // Left operand has been evaluated.
[ LX = rv L // Value of the operand.
if LX eq 0 do L0 = true // L0 is true if LX is +0 or -0
if LX eq 1 do L1 = true // LX is 1
if LX eq true do LT = true // LX is true
if LX eq false do LF = true // LX is false
]
if RC do // Right operand has been evaluated.
[ RX = rv R // The value of the operand.
if RX eq 0 do R0 = true // R0 is true if RX is +0 or -0
if RX eq 1 do R1 = true
if RX eq true do RT = true
if RX eq false do RF = true
]
switchon Op into
[ case PLUS:
if L0 do [ Node = H3!x; endcase ] // 0+x ? x
if R0 do [ Node = H2!x; endcase ] // x+0 ? x
resultis 0
case MINUS:
if L0 do [ Node = x; H1!Node = NEG
H2!Node = H3!x; endcase
] // 0-x ? neg x
if R0 do [ Node = H2!x; endcase ] // x-0 ? x
resultis 0
case MULT:
if L0 % R0 do [ Value = 0; endcase ] // 0*x ? 0,. x*0 ? 0
if L1 do [ Node = H3!x; endcase ] // 1*x ? x
if R1 do [ Node = H2!x; endcase ] // x*1 ? x
resultis 0
case DIV:
if L0 do [ Value = 0; endcase ] // 0/x ? 0
if R1 do [ Node = H2!x; endcase ] // x/1 ? x
// If SCALE ocode ever exists, check for RX = 2n and replace by shift.
resultis 0
case LOGAND:
if LF % RF do [ Value = false; endcase ] // false&x ? false,. x&false ? false
if LT do [ Node = H3!x; endcase ] // true&x ? x
if RT do [ Node = H2!x; endcase ] // x&true ? x
resultis 0
case LOGOR:
if LT % RT do [ Value = true; endcase ] // true%x ? true x%true ? true
if LF do [ Node = H3!x; endcase ] // false%x ? x
if RF do [ Node = H2!x; endcase ] // x%false ? x
resultis 0
case LSHIFT: case RSHIFT:
if R0 do [ Node = H2!x; endcase ] // Don"t shift by zero.
resultis 0
case EQV:
if LF do [ Node = x; H1!Node = NOT
H2!Node = H3!x; endcase ] // false eqv x ? not x
if RF do [ Node = x; H1!Node = NOT
H2!Node = H2!x; endcase ] // x eqv false ? not x
if LT do [ Node = H3!x; endcase ] // true eqv x ? x
if RT do [ Node = H2!x; endcase ] // x eqv true ? x
resultis 0
case NEQV:
if LF do [ Node = H3!x; endcase ] // false neqv x ? x
if RF do [ Node = H2!x; endcase ] // x neqv false ? x
if LT do [ Node = x; H1!Node = NOT
H2!Node = H3!x; endcase ] // true neqv x ? not x
if RT do [ Node = x; H1!Node = NOT
H2!Node = H2!x; endcase ] // x neqv true ? not x
resultis 0
default:
resultis 0
]
endcase // Take all above "endcase"s to the end of this function.
]
case NEG: case NOT:
[ let L = Lookat(H2+x) // Examine the son.
unless L > 0 resultis 0 // Done if not evaluated.
Value = EvalUnop(Op, rv L)
endcase
]
case COND:
[ let B = Lookat(H2+x) // Examine the conditional arm.
unless B > 0 do [ Lookat(H3+x); Lookat(H4+x); resultis 0 ]
Node = (rv B ? H3, H4)!x // The selected arm.
LValue = Lookat(lv Node)
endcase
]
case VECAP:
[ let A, B, LA, LB = nil,nil,nil,nil
LA = Lookat(H2+x); LB = Lookat(H3+x)
A = H2!x; B = H3!x
if LA > 0 do [ let t, Lt = A, LA; A = B; LA = LB; B, LB = t, Lt ]
resultis 0
]
case LV:
[ let y = H2!x
unless (y & NameBit) ne 0
do
[
if H1!y eq RV do
[ Node=H2!y; LValue=Lookat(lv Node); endcase ]
if H1!y eq VECAP do
[ Node=y; H1!Node = PLUS; H2!Node = H2!y; H3!Node = H3!y
LValue=Lookat(lv Node); endcase ]
]
Lookat(H2+x)
resultis 0
]
case RV:
Lookat(H2+x)
resultis 0
case VALOF:
[ let DE, DS = DvecE, DvecS
Decllabels(H2!x)
Declvars(H2!x)
DvecE, DvecS = DE, DS
resultis 0
]
case TABLE:
[ let n = H2!x
for i = 1 to n do (H2+i)!x = EvalConst(H2+i+x)
resultis 0
]
case SIZE:
[ let L = LookatQual(H3+x)
resultis lv H2!L
]
case OFFSET:
[ let L = LookatQual(H3+x)
unless H3!L eq 0 resultis 0
resultis lv H1!L
]
case LEFTLUMP:
case RIGHTLUMP:
[ let LA = Lookat(H2+x)
let L = LookatQual(H4+x)
resultis 0
]
case FNAP:
case COMMA:
Lookat(H2+x)
Lookat(H3+x)
resultis 0
case VEC:
Lookat(H2+x)
resultis 0
case STRINGCONST:
resultis 0
default:
SAEreport(-5)
resultis 0
]
// Come here for all the above ""endcase""s.
// We have either a new Node or a Value
if Node ne 0 do
[ rv LVX = Node // A new Node--replace the tree node with it
resultis LValue // and return the addr of its value if we have it
]
Node = x; H1!Node = NUMBER; H2!Node = Value // A Value
rv LVX = Node // so replace the tree node with a NUMBER node
resultis H2 + Node // and return the addr of its value
]
and EvalBinop(Op, a, b) = valof
switchon Op into
[ case PLUS: resultis a + b
case MINUS: resultis a - b
case EQ: resultis a eq b
case NE: resultis a ne b
case LS: resultis a < b
case GR: resultis a > b
case LE: resultis a le b
case GE: resultis a ge b
case ULS: resultis a uls b
case UGR: resultis a ugr b
case ULE: resultis a ule b
case UGE: resultis a uge b
case MULT: resultis a * b
case DIV: resultis a / b
case REM: resultis a rem b
case LSHIFT: resultis a lshift b
case RSHIFT: resultis a rshift b
case LOGAND: resultis a & b
case LOGOR: resultis a % b
case EQV: resultis a eqv b
case NEQV: resultis a neqv b
default: SAEreport(-6); resultis 0
]
and EvalUnop(Op, a) = valof
switchon Op into
[ case NEG: resultis - a
case NOT: resultis not a
default: SAEreport(-7); resultis 0
]
// This routine is used when the node MUST be evaluable at compile time.
and EvalConst(LVX) = valof
[ let x = rv LVX
let lx = nil
lx = Lookat(LVX)
x = rv LVX
if lx > 0 resultis rv lx
SAEreport(9, -1)
rv LVX = ZERONODE
resultis 0
]