// 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 ] ] ]