// BNCG5.bcpl - BCPL Compiler // Nova Code Generator, Instruction generation routines // Copyright Xerox Corporation 1980 // Last modified on Sat 28 Oct 72 0132.32 by jec. // Swinehart, 5-11-77: docase exp get "bncgx" let CGmul() be [ if type!arg1 eq NUMBER do [ test loc!arg1 eq 0 then [ Pop2() Push(NUMBER, 0, 0) return ] or test loc!arg1 eq 1 then [ Pop1() return ] or test loc!arg1 eq #177777 then [ Pop1() CGloadac(arg1) CGae(Ineg, loc!arg1, loc!arg1) return ] or [ let n = 1 for i = 1 to 15 do [ n = n lshift 1 if loc!arg1 eq n do [ loc!arg1 = i name!arg1 = 0 CGlsh() return ] ] ] ] CGloadboth() CG(Imul) if SWCode do WriteS(" (MUL)") Pop2() Push(AC, 0, 1) ] and CGdiv() be [ CGload01() CG(Idiv) if SWCode do WriteS(" (DIV)") Pop2() Push(AC, 0, 1) ] and CGrem() be [ CGload01() CG(Irem) if SWCode do WriteS(" (REM)") Pop2() Push(AC, 0, 0) ] and CGand() be [ CGregop(Iand) ] and CGior() be [ CGloadboth() CG(Iior) if SWCode do WriteS(" (IOR)") Pop2() Push(AC, 0, 0) ] and CGeqv() be [ CGloadboth() CG(Ieqv) if SWCode do WriteS(" (EQV)") Pop2() Push(AC, 0, 0) ] and CGxor() be [ CGloadboth() CG(Ixor) if SWCode do WriteS(" (XOR)") Pop2() Push(AC, 0, 0) ] and CGneg() be [ CGloadac(arg1) CGae(Ineg, loc!arg1, loc!arg1) ] and CGnot() be [ CGloadac(arg1) CGae(Inot, loc!arg1, loc!arg1) ] and CGadd() be [ CGregop(Iadd) ] and CGsub() be [ CGregop(Isub) ] and CGregop(op) be [ CGloadac(arg2) CGloadreg(arg1) CGae(op, loc!arg1, loc!arg2) Pop1() ] and CGlsh() be [ CGshift(Ilsh) ] and CGrsh() be [ CGshift(Irsh) ] and CGshift(op) be [ if type!arg1 eq NUMBER do [ test loc!arg1 le 2 then [ CGloadac(arg2) for i = 1 to loc!arg1 do CGae(op eq Ilsh ? Imovzl, Imovzr, loc!arg2, loc!arg2) Pop1() return ] or test loc!arg1 eq 8 then [ CGloadac(arg2) loc!arg1 = (op eq Ilsh ? #377, #177400) name!arg1 = 0 CGloadreg(arg1) CGae(Iands, loc!arg1, loc!arg2) Pop1() return ] or if loc!arg1 eq 15 do [ CGloadac(arg2) CGae((op eq Ilsh ? Imovr, Imovl), loc!arg2, loc!arg2) CGae((op eq Ilsh ? Isubcr, Isubcl), loc!arg2, loc!arg2) Pop1() return ] ] CGload01() CG(op) if SWCode do WriteS(op eq Ilsh ? " (LSH)", " (RSH)") Pop2() Push(AC, 0, 0) ] and CGswitch() be [ let n = ReadN() let deflabel = ReadL() let vv, vl = vec 150, vec 150 casev, casel = vv, vl casev!0 = Nval(ReadN()); casel!0 = ReadL() for i = 1 to n-1 do [readnext let v = Nval(ReadN()) let l = ReadL() let p = i for j = 0 to i-1 do [insert test (v & #100000) ne 0 then [ if (casev!j & #100000) eq 0 loop if (Nval(v - casev!j) & #100000) ne 0 loop p = j; break ] or [ if (casev!j & #100000) ne 0 do [ p = j; break ] if (Nval(v - casev!j) & #100000) eq 0 do [ p = j; break ] loop ] ]insert for j = i-1 step -1 to p do [ casev!(j+1) = casev!j; casel!(j+1) = casel!j ] casev!p = v; casel!p = l ]readnext let i, j = 0, 1 until j eq n do [ if ((casev!i xor casev!j) & #100000) eq 0 do if (casev!i - casev!j) - (j - i) le 4 do [ j = j + 1; loop ] test (j - i) gr 2 then [ CGbranch(i, (j - 1), deflabel) i = j j = i + 1 ] or [ i = i + 1 j = i + 1 ] ] if (j - i) gr 2 do CGbranch(i, (j - 1), deflabel) CGlookup(n, deflabel) ] and CGbranch(i, j, deflabel) be [ CG(Ibranch) if SWCode do [ WriteS(" (BRANCH)// cases ") WriteOct(casev!i); WriteS(" thru "); WriteOct(casev!j) ] CGn(Nval(casev!i)) CGn(Nval(casev!i - casev!j + 1)) for k = casev!i to casev!j by -1 do [ test k eq casev!i then [ CGn(CGpchain(casel!i)) if SWCode do WriteLabel(casel!i) casel!i = 0 i = i + 1 ] or [ CGn(CGpchain(deflabel)) if SWCode do [ WriteLabel(deflabel); WriteS("// default") ] ] ] ] and CGlookup(n, deflabel) be [ let k = 0 for i = 0 to n-1 do [ unless casel!i eq 0 do k = k + 1 ] test k eq 0 then [ CGjmp(deflabel) if SWCode do WriteS("// default") ] or [ CG(Ilookup) if SWCode do [ WriteS(" (LOOKUP)"); WriteOct(k); WriteS(" cases") ] CGn(k) for i = 0 to n-1 do unless casel!i eq 0 do [ CGn(Nval(casev!i)) if SWCode do [ WriteS("// case "); WriteOct(casev!i) ] CGn(CGpchain(casel!i)) if SWCode do WriteLabel(casel!i) ] CGjmp(deflabel) if SWCode do WriteS("// default") ] ]