// BNCG8.bcpl - BCPL Compiler -- NCG part 8 -- Qualifier Ocode items // Copyright Xerox Corporation 1980 get "bncgx" let CGqual(Op) = valof [ let wordoffset, bitoffset, bitlength = nil, nil, nil switchon Op into [ default: CGreport(-20) case BSUB: [ let n = Nval(ReadN()) CGload01() CG(Imulplus) if SWCode do [ WriteS("// AC0 = AC0 + AC1 ** ") WriteOct(n) ] CGn(n) Pop1() resultis -1 ] case WSUB: [ let n = Nval(ReadN()) Op = Readop() CGload01() CG(Imulplus) if SWCode do [ test Op eq WQUAL then WriteS("// X") or WriteS("// AC0") WriteS(" = AC0 + AC1**") WriteOct(n) ] CGn(n) Pop1() unless Op eq WQUAL resultis Op n = Nval(ReadN()) unless (n & #177600) eq 0 % (n & #177600) eq #177600 do [ Push(NUMBER, 0, n) CGloadac(arg1) CGae(Iadd, loc!arg1, X) Pop1() n = 0 ] type!arg1, loc!arg1, ref!arg1 = XR, X, (n & #377) + #40000 CGnqual() resultis -1 ] case WQUAL: [ wordoffset = Nval(ReadN()) Push(NUMBER, 0, wordoffset) CGsubscr(0) CGnqual() resultis -1 ] case NQUAL: [ CGnqual() resultis -1 ] case STWQUAL: [ wordoffset = Nval(ReadN()) CGloadac(arg2) Push(NUMBER, 0, wordoffset) CGsubscr(0) CGstnqual() resultis -1 ] case STNQUAL: [ bitoffset = Nval(ReadN()) bitlength = Nval(ReadN()) let lastbit = bitoffset + bitlength - 1 let mask = MaskWord(bitoffset, bitlength) let constval = false if type!arg2 eq NUMBER do [ constval = true loc!arg2 = (loc!arg2 lshift (15-lastbit)) & mask ] CGloadboth() unless constval % (lastbit gr 7) do CGae(Imovs, loc!arg2, loc!arg2) test constval % (lastbit eq 7 % lastbit eq 15) then [ CG(loc!arg2 eq 0 ? Istnqual0, Istnqual1) ] or [ let n = lastbit gr 7 ? lastbit-7, lastbit+1 CG( (Istnqual + loc!arg2) + (n-1)*2 ) ] if SWCode do [ WriteS("// ") WriteWqual(loc!arg1, ">>", bitoffset, bitlength) WriteS(" = AC") WriteOct(loc!arg2) ] CGn(mask) Pop2() resultis -1 ] case YQUAL: [ bitlength = Nval(ReadN()) unless bitlength eq 8 do CGreport(-12) CGloadboth() CG(loc!arg2 eq 0 ? Iyqual01, Iyqual10) if SWCode do [ WriteS("// AC"); WriteOct(loc!arg2) WriteS(" = AC"); WriteOct(loc!arg2) WriteS(">>[byte AC"); WriteOct(loc!arg1); WW($]) ] Pop1() resultis -1 ] case XQUAL: case WBQUAL: [ if Op eq XQUAL do [ bitoffset = Nval(ReadN()) Push(NUMBER, 0, bitoffset) ] bitlength = Nval(ReadN()) CGloadboth() CG(loc!arg2 eq 0 ? Iwbqual01, Iwbqual10) if SWCode do [ WriteS("// AC") WriteOct(loc!arg2) WriteS(" = ") WriteWBqual(loc!arg2, ">>", loc!arg1, bitlength) ] CGn(bitlength) Pop1() resultis -1 ] case STYQUAL: [ bitlength = Nval(ReadN()) unless bitlength eq 8 do CGreport(-12) CGstoreintempN(arg3, SSPtemp3) CGloadboth() CG(loc!arg2 eq 0 ? Istyqual01, Istyqual10) if SWCode do [ WriteS("// AC"); WriteOct(loc!arg2) WriteS(">>[byte AC"); WriteOct(loc!arg1) WriteS("] = TEMP"); WriteOct(loc!arg3) ] Pop2() Pop1() resultis -1 ] case STXQUAL: case STWBQUAL: [ if Op eq STXQUAL do [ bitoffset = Nval(ReadN()) Push(NUMBER, 0, bitoffset) ] bitlength = Nval(ReadN()) CGstoreintempN(arg3, SSPtemp3) CGloadboth() CG(loc!arg2 eq 0 ? Istwbqual01, Istwbqual10) if SWCode do [ WriteS("// ") WriteWBqual(loc!arg2, ">>", loc!arg1, bitlength) WriteS(" = TEMP") WriteOct(loc!arg3) ] CGn(bitlength) Pop2() Pop1() resultis -1 ] ] ] and CGnqual() be [ let bitoffset = Nval(ReadN()) let bitlength = Nval(ReadN()) let lastbit = bitoffset + bitlength - 1 let mask = MaskWord(bitoffset, bitlength) if bitoffset eq 0 & bitlength eq 16 do [ if type!arg1 eq XR do CGloadac(arg1) return ] CGloadac(arg1) if bitlength eq 1 do [ test bitoffset eq 15 then [ CGae(Imovr, loc!arg1, loc!arg1) CGae(Isubcl, loc!arg1, loc!arg1) if SWCode do [ WriteNqual(bitoffset, bitlength) ] return ] or test bitoffset eq 0 then [ CGae(Imovl, loc!arg1, loc!arg1) CGae(Isubcl, loc!arg1, loc!arg1) if SWCode do [ WriteNqual(bitoffset, bitlength) ] return ] or [ Push(NUMBER, 0, mask) CGloadreg(arg1) CGae(Iandszr, loc!arg1, loc!arg2) Pop1() if SWCode do [ WriteNqual(bitoffset, bitlength) ] CGae(Isubzl, loc!arg1, loc!arg1) return ] ] // bitlength ne 1 [ Push(NUMBER, 0, mask) CGloadreg(arg1) let I = lastbit eq 15 ? Iand, lastbit gr 7 ? Iandzr, Iands CGae(I, loc!arg1, loc!arg2) Pop1() unless lastbit eq 15 % lastbit eq 14 % lastbit eq 7 do [ let n = lastbit gr 7 ? lastbit-7, lastbit let J = Inqual + loc!arg1 test n eq 6 then CGae(Imovzr, loc!arg1, loc!arg1) or CG(J + (n-1)*2) ] if SWCode do [ WriteNqual(bitoffset, bitlength) ] return ] ] and CGstnqual() be [ let bitoffset = Nval(ReadN()) let bitlength = Nval(ReadN()) unless bitoffset eq 0 & bitlength eq 16 do CGreport(-11) CGloadac(arg2) CGstore(loc!arg2, arg1) Pop2() ] and CGfield(bitoffset, bitlength) be [ CGn((bitoffset lshift 8) + bitlength) ] and MaskWord(bitoffset, bitlength) = valof [ let lastbit = bitoffset + bitlength - 1 let m = 1 lshift (15 - lastbit) let mask = 0 for i = bitoffset to lastbit do [ mask = mask + m; m = m lshift 1 ] resultis mask ] and WriteNqual(bitoffset, bitlength) be [ WriteS("// AC") WriteOct(loc!arg1) WriteS(" = ") WriteWqual(loc!arg1, "<<", bitoffset, bitlength) ] and WriteWqual(ac, lump, bitoffset, bitlength) be [ WriteS("AC") WriteOct(ac) WriteS(lump) WriteS("[bit ") WriteN(bitoffset) unless bitlength eq 1 do [ WriteS(" thru ") WriteN(bitoffset + bitlength - 1) ] WriteS("]") ] and WriteWBqual(ac, lump, bitac, bitlength) be [ WriteS("AC") WriteOct(ac) WriteS(lump) WriteS("[bit (AC") WriteOct(bitac) unless bitlength eq 1 do [ WriteS(") thru (AC") WriteOct(bitac) WriteS("+") WriteN(bitlength - 1) ] WriteS(")]") ]