// BTRN5.bcpl - BCPL Compiler -- Part 5 of Trans.
// Copyright Xerox Corporation 1980
// Last modified on Sat 28 Oct 72 0127.02 by jec.
// Paxton, 9-14-78: unsigned compares
// Load Load the value of an expression.
// LoadLV Load the L-value of an expression.
get "btrnx"
let Load(x) be
[ if x eq 0 do [ TRNreport(15); SSP = SSP + 1; CheckSSP(); return ]
if (x & NameBit) ne 0 do
[ let t = x & PtrMask
let N = t!1 // The datum associated with the name.
SSP = SSP + 1; CheckSSP()
let n = t!0 & NameMask
switchon t!0 & TypeMask into // What type of name is it?
[ default:
TRNreport(-7)
return
case CONSTANT:
Out2(LN, N); OutL(n)
return
case LOCAL:
Out2(LP, N); OutL(n)
return
case EXTLABEL: case INTLABEL:
case LABEL:
Out2P(LL, N); OutL(n)
return
case ZEXTLABEL: case ZINTLABEL:
case ZLABEL:
Out2P(LZ, N); OutL(n)
return
]
]
if H1!x eq NIL do [ SSP = SSP + 1; CheckSSP(); Out2(STACK, SSP); return ]
let Op = H1!x
switchon Op into
[ default:
TRNreport(15)
SSP = SSP + 1; CheckSSP()
return
// Following are the non-commutative infix binary operators.
case LS: case GR: case LE: case GE:
case ULS: case UGR: case ULE: case UGE:
[ let lx = CheckConst(H2+x)
if lx ne 0 do
[ Load(H3!x)
Load(H2!x)
Out1(selecton Op into
[ case LS: GR
case GR: LS
case LE: GE
case GE: LE
case ULS: UGR
case UGR: ULS
case ULE: UGE
default: ULE
])
SSP = SSP - 1
return
]
]
case DIV: case REM:
case MINUS:
case LSHIFT: case RSHIFT:
Load(H2!x)
Load(H3!x)
Out1(Op)
SSP = SSP - 1
return
// Following are the commutative infix binary operators.
case VECAP: case MULT: case PLUS: case EQ: case NE:
case LOGAND: case LOGOR: case EQV: case NEQV:
[ let A, B = H2!x, H3!x
test (A & NameBit) ne 0
then [ let t = A & PtrMask
if (t!0 & TypeMask) eq CONSTANT do A, B = H3!x, H2!x
]
or if H1!A eq NUMBER do A, B = H3!x, H2!x
Load(A)
Load(B)
Out1(Op)
SSP = SSP - 1
return
]
case RIGHTLUMP:
[ let S = SSP
Load(H2!x)
let qualvec = vec 3
DoQual(H3!x, qualvec, true)
OutQual(qualvec)
SSP = S + 1; CheckSSP()
return
]
case LEFTLUMP:
[ let S = SSP
let d = H3!x
let qualvec = vec 3
test d!0 ge WordSizeOb % (d!0+d!1-1) ge WordSizeOb % d!2 gr 0
then [ let t = H2!x
unless H1!t eq VECAP % H1!t eq RV do TRNreport(14)
LoadLV(H2!x)
DoQual(H3!x, qualvec, true)
]
or [ Load(H2!x)
qualvec!0 = NQUAL
qualvec!1 = 0
qualvec!2 = d!0
qualvec!3 = d!1
]
OutQual(qualvec)
SSP = S + 1; CheckSSP()
return
]
case SIZE:
[ let d = H2!x
Out2(LN, d!1); OutL(0)
SSP = SSP + 1; CheckSSP()
return
]
case OFFSET:
[ let S = SSP
let d = H2!x
let qualvec = vec 3
test d!2 eq 0
then [ Out2(LN, d!0); OutL(0)
]
or [ DoQual(H2!x, qualvec, false)
switchon qualvec!0 into
[ case WBQUAL: case MWBQUAL:
endcase
default:
TRNreport(-11)
]
]
SSP = S + 1; CheckSSP()
return
]
case NEG: case NOT: case RV:
Load(H2!x)
Out1(Op)
return
case TRUE: case FALSE:
Out1(Op)
SSP = SSP + 1; CheckSSP()
return
case LV:
LoadLV(H2!x)
return
case NUMBER:
Out2(LN, H2!x); OutL(0)
SSP = SSP + 1; CheckSSP()
return
case CHARCONST:
Out2(LC, H2!x)
SSP = SSP + 1; CheckSSP()
return
case STRINGCONST:
[ Out1(LSTR)
Out1(Length(H2+x))
for i = 1 to Length(H2+x) do OutC(Char(H2+x, i))
SSP = SSP + 1; CheckSSP()
return
]
case TABLE:
[ Out1(TABLE)
OutN(H2!x)
for i = 1 to H2!x do OutN((H2+i)!x)
SSP = SSP + 1; CheckSSP()
return
]
case VALOF:
[ let RL = Resultlabel
and VB = ValofBlock
Resultlabel = Nextparam()
ValofBlock = true
Trans(H2!x)
Complab(Resultlabel)
Out2(RSTACK, SSP)
SSP = SSP + 1; CheckSSP()
Resultlabel = RL
ValofBlock = VB
return
]
case FNAP:
Transcall(x)
return
case COND:
[ let L, M = Nextparam(), Nextparam()
let S = SSP
Jumpcond(H2!x, false, M)
Load(H3!x)
Out2P(RES, L)
SSP = S
Complab(M)
Load(H4!x)
Out2P(RES, L)
Complab(L)
Out2(RSTACK, S)
SSP = S+1
return
]
]
]
// Load the L-value of a suitable expression. This routine is called from
// Simpass, for RV, VECAP or LEFTLUMP to the left of an assignment
// Load, for case LV
and LoadLV(x) be
[ if x eq 0 do
Err:
[ TRNreport(14) // Error in operand of lv.
SSP = SSP + 1
return
]
if (x & NameBit) ne 0 do
[ let t = x & PtrMask
SSP = SSP + 1
let N = t!1 // The datum associated with the name.
let n = t!0 & NameMask
switchon t!0 & TypeMask into // Branch on the type of name it is.
[ case LOCAL:
Out2(LLP, N); OutL(n)
return
case EXTLABEL: case INTLABEL:
case LABEL:
Out2P(LLL, N); OutL(n)
return
case ZEXTLABEL: case ZINTLABEL:
case ZLABEL:
Out2P(LLZ, N); OutL(n)
return
default:
TRNreport(14) // Bad sort of name
return
]
]
switchon H1!x into
[ default:
goto Err
case RV:
Load(H2!x)
Out1(LVRV)
return
case VECAP:
[ let A, B = H2!x, H3!x
if (A & NameBit) ne 0 do A, B = H3!x, H2!x
Load(A)
Load(B)
Out1(PLUS)
SSP = SSP - 1
return
]
case COND: // lv of a conditional expression.
[ let S = SSP
and ResLabel, FalseArm = Nextparam(), Nextparam()
Jumpcond(H2!x, false, FalseArm) // Hop to the false arm if conditional is false.
LoadLV(H3!x) // Load the lv of the true arm expression.
Out2P(RES, ResLabel) // Hop to the RESlabel with the value in hand.
SSP = S
Complab(FalseArm) // Place the label for the false arm.
LoadLV(H4!x) // Load the lv of the false arm expression.
Out2P(RES, ResLabel) // Hop to the RESlabel with the value in hand.
Complab(ResLabel) // Place the RESlabel.
Out2(RSTACK, S) // Restore the code generator"s simulated stack pointer.
SSP = S + 1
return
]
case LEFTLUMP:
case RIGHTLUMP:
[ let S = SSP
let qualvec = vec 3
test H1!x eq RIGHTLUMP
then Load(H2!x)
or LoadLV(H2!x)
DoQual(H3!x, qualvec, true)
switchon qualvec!0 into
[ case WQUAL:
case MWQUAL:
Out2(LN, qualvec!1); OutL(0)
Out1(PLUS)
endcase
case XQUAL:
endcase
case YQUAL:
Out2(LN, WordSizeOb/ByteSizeOb); OutL(0)
SSP = SSP + 1; CheckSSP()
Out1(DIV)
SSP = SSP - 1
Out1(PLUS)
endcase
case WBQUAL:
case MWBQUAL:
Out2(LN, WordSizeOb); OutL(0)
SSP = SSP + 1; CheckSSP()
Out1(DIV)
SSP = SSP - 1
Out1(PLUS)
endcase
default:
TRNreport(-12)
]
SSP = S + 1; CheckSSP()
return
]
]
]