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