// BNCG4.bcpl - BCPL Compiler // Nova Code Generator, Instruction generation routines // Copyright Xerox Corporation 1980 // Last modified on Sat 28 Oct 72 0246.15 by jec. get "bncgx" let CGlda(reg, arg) be [ CGmemref(Ilda + (reg lshift 11), arg) ] and CGsta(reg, arg) be [ CGmemref(Ista + (reg lshift 11), arg) ] and CGmemref(op, arg) be [ let addr = 0 test ref!arg ne 0 then [ unless type!arg eq XR do [ let a = vec argsize-1 type!a, ref!a, loc!a, name!a = type!arg, 0, loc!arg, name!arg CGlda(X, a) ] if (ref!arg & #100000) ne 0 do addr = addr + Ideferbit addr = addr + (X lshift 8) + (ref!arg & #377) ] or switchon type!arg into [ case RVNUMBER: if (loc!arg & #177400) eq 0 do [ addr = addr + loc!arg endcase ] if (not SWAlto)&(loc!arg & #177400) eq #100000 do [ addr = addr + (loc!arg & #377) + Ideferbit endcase ] addr = addr + Ideferbit case NUMBER: addr = addr + (R lshift 8) + CGconst(Nconst, loc!arg, name!arg) endcase case RVLOCAL: addr = addr + Ideferbit case LOCAL: addr = addr + (P lshift 8) + Bval(loc!arg + SSPoffset) if loc!arg gr MaxSSP do CGreport(1) endcase case LABEL: addr = addr + Ideferbit case LVLABEL: addr = addr + (R lshift 8) + CGconst(Lconst, loc!arg, name!arg) endcase case RVLABEL: if SWAlto do CGreport(-99) addr = addr + Ideferbit + (R lshift 8) + CGconst(Dconst, loc!arg, name!arg) endcase case LVCOMMON: addr = addr + (R lshift 8) + CGconst(Zconst, loc!arg, name!arg) endcase case RVCOMMON: addr = addr + Ideferbit case COMMON: addr = addr + (Z lshift 8) + CGzchain(loc!arg) endcase default: CGreport(-3) ] CG(op + addr) unless SWCode return if ref!arg ne 0 return test (addr & Ideferbit) eq 0 then WriteS(" ") or test type!arg eq LABEL then WriteS(" ") or WriteS(" @") WW($() switchon type!arg into [ case RVNUMBER: case NUMBER: if name!arg ne 0 do [ WriteName(name!arg); WriteS(" = ") ] WW($#); WriteOct(loc!arg) endcase case RVLOCAL: case LOCAL: test name!arg eq 0 then [ WriteS("TEMP") WriteOct(loc!arg) ] or WriteName(name!arg) endcase case LVLABEL: WriteS("lv ") case RVLABEL: case LABEL: WriteName(name!arg) endcase case LVCOMMON: WriteS("lv ") case RVCOMMON: case COMMON: WriteName(name!arg) endcase ] WW($)) ] and CGjumpandsave() be [ if SWAlto & (type!arg1 eq RVCOMMON & ref!arg1 eq 0) do // @ becomes !0 on Alto // (CGrv() already does this for non-common ) [ type!arg1 = COMMON ref!arg1 = #40000 ] if SWNoxios & SWAlto & (type!arg1 ne XR & ref!arg1 eq #40000) do // @ or !0 on Alto should generate // JSRII temp,2 for Noxios. [ ref!arg1 = 0 //remove the indirection unless type!arg1 eq LOCAL do CGstoreintemp(arg1) //store in frame type!arg1 = RVLOCAL //restore the indirection ] unless ref!arg1 eq 0 do // Other complex things are done normally [ CGrv() CGmemref(Ijsr, arg1) return ] if type!arg1 eq RVNUMBER & (loc!arg1 & #177400) eq 0 do // @ is special [ CGmemref(Ijsr+Ideferbit, arg1) return ] unless SWAlto & (type!arg1 eq RVNUMBER % type!arg1 eq LABEL % (SWNoxios & type!arg1 eq RVLOCAL)) do // Unless we can do a JSRII, do it normally // (JSRII .+n for any Alto if or // JSRII n,2 for Noxios only) [ CGrv() CGmemref(Ijsr, arg1) return ] let op = type!arg1 eq RVLOCAL ? Ajsr2, Ajsr1 let addr = type!arg1 eq LABEL ? CGconst(Lconst, loc!arg1, name!arg1), type!arg1 eq RVNUMBER ? CGconst(Nconst, loc!arg1, name!arg1), loc!arg1 CG(op+addr) if SWCode do [ WriteS(" @(") unless name!arg1 eq 0 do [ WriteName(name!arg1); WW($*s) ] if type!arg1 eq RVNUMBER do [ WW($#); WriteOct(loc!arg1) ] WW($)) ] ] and CGmakememref(arg) be [ if type!arg eq AC do CGreport(-9) if ref!arg ne 0 do unless type!arg eq XR do [ let r = ref!arg ref!arg = 0 CGloadxr(arg) ref!arg = r ] ] and CGae(op, reg1, reg2) be [ reg1 = reg1 lshift 13 reg2 = reg2 lshift 11 CG(op + reg1 + reg2) ] and CGconst(ctype, cdata, cname) = valof [ let p = 0 while p ls ctablep do [ if ctypetable!p eq ctype & cdatatable!p eq cdata do unless (caddrtable!p & #100000) eq 0 & PC - caddrtable!p ge #200 break p = p + 1 ] test p eq ctablep then [ ctypetable!p = ctype cdatatable!p = cdata caddrtable!p = PC + #100000 cnametable!p = cname ctablep = ctablep + 1 if ctablep ge ctablesize do CGreport(-5) constcount = constcount + (ctype eq Jconst ? 2, 1) if constreflimit gr PC do constreflimit = PC resultis 0 ] or test (caddrtable!p & #100000) eq 0 then [ resultis Bval(caddrtable!p - PC) ] or [ let pc = caddrtable!p & #77777 [ if PassTwo break let t = Code!pc & #377 if t eq 0 break pc = pc + Wval(t) ] repeat unless PassTwo do Code!pc = (Code!pc & #177400) + Bval(PC - pc) resultis 0 ] ] and CGoutconstants(n) be [ if constcount eq 0 return if n eq 0 do n = PCparameter let l = PC + constcount + 1 + n constreflimit = #77777 let firstconst = true let p = 0 while p ls ctablep do [ if (caddrtable!p & #100000) ne 0 do [ let pc = caddrtable!p & #77777 if l - pc le #177 - Cparameter do [ if constreflimit gr pc do constreflimit = pc p = p + 1; loop ] [ if PassTwo break let t = Code!pc & #377 Code!pc = (Code!pc & #177400) + Bval(PC - pc) if t eq 0 break pc = pc + Wval(t) ] repeat caddrtable!p = PC if SWCode & firstconst do WriteS("*n*n*t// literals //*n") firstconst = false test ctypetable!p eq Nconst then [ CGn(cdatatable!p) if SWCode do [ WriteS(" = ") if cnametable!p ne 0 do [ WriteName(cnametable!p); WriteS(" = ") ] WW($#); WriteOct(cdatatable!p) ] ] or test ctypetable!p eq Lconst then [ CGn(CGlchain(cdatatable!p)) if SWCode do [ WriteS(" = "); WriteName(cnametable!p) ] ] or test ctypetable!p eq Dconst then [ CGn(CGlchain(cdatatable!p) + #100000) if SWAlto do CGreport(-98) if SWCode do [ WriteS(" ="); WW($@); WriteName(cnametable!p) ] ] or test ctypetable!p eq Zconst then [ CGn(CGzchain(cdatatable!p)) if SWCode do [ WriteS(" = "); WriteName(cnametable!p) ] ] or test ctypetable!p eq Jconst then [ CG(Ilongjump) if SWCode do [ WriteS(" = LONGJUMP to LAB") WriteOct(plabdefvec!(cdatatable!p)) ] CGn(CGpchain(cdatatable!p)) ] or CGreport(-4) constcount = constcount - (ctypetable!p eq Jconst ? 2, 1) ] p = p + 1 ] if SWCode do WW($*n) p = 0 while (caddrtable!p & #100000) eq 0 & PC - caddrtable!p gr #200 do p = p + 1 unless p eq 0 do [ for q = p to ctablep-1 do [ ctypetable!(q-p) = ctypetable!q cdatatable!(q-p) = cdatatable!q caddrtable!(q-p) = caddrtable!q cnametable!(q-p) = cnametable!q ] ctablep = ctablep - p ] ] and CGcheckconstants(n) be [ if constcount eq 0 return if constreflimit eq #77777 do CGreport(-6) if n eq 0 do n = PCparameter let l = PC + constcount + 1 + n if l - constreflimit le #177 return let pc = PC CG(Ijmp + (R lshift 8) + 0) CGoutconstants(n) unless PassTwo do Code!pc = Code!pc + Bval(PC - pc) ] and CGjmp(l) be [ if PassTwo do [ if -#200 le (plabdefvec!l - PC) & (plabdefvec!l - PC) le #177 do Code!PC = (Code!PC & #177400) + Bval(plabdefvec!l - PC) ] test pchainvec!l ne 0 & (pchainvec!l & #100000) eq 0 & PC-pchainvec!l le #200 then [ CG(Ijmp + (R lshift 8) + Bval(pchainvec!l - PC)) ] or [ CG(Ijmp + (R lshift 8) + CGconst(Jconst, l, 0)) ] if SWCode do WriteLabel(l) ] and CGtest(skip, ac1, ac2, l) be [ CGae(skip, ac1, ac2) if SWCode do WriteSkip(Code!(PC-1)) CGjmp(l) ] and CGlabdef(l) be [ if pchainvec!l ne 0 & (pchainvec!l & #100000) ne 0 do [ unless PassTwo do [ let pc = pchainvec!l & #77777 [ let t = Code!pc Code!pc = Nval(PC - pc) if t eq 0 break pc = t ] repeat ] ] pchainvec!l = PC plabdefvec!l = PC if constcount eq 0 return let p = 0 while p ls ctablep do [ if ctypetable!p eq Jconst & cdatatable!p eq l do if (caddrtable!p & #100000) ne 0 do [ let pc = caddrtable!p & #77777 [ if PassTwo break let t = Code!pc & #377 Code!pc = (Code!pc & #177400) + Bval(PC - pc) if t eq 0 break pc = pc + Wval(t) ] repeat ctablep = ctablep - 1 for q = p to ctablep - 1 do [ ctypetable!q = ctypetable!(q+1) cdatatable!q = cdatatable!(q+1) caddrtable!q = caddrtable!(q+1) cnametable!q = cnametable!(q+1) ] constcount = constcount - 2 constreflimit = #77777 for q = 0 to ctablep-1 do [ if (caddrtable!q & #100000) eq 0 loop if (caddrtable!q & #77777) ls constreflimit do [ constreflimit = caddrtable!q & #77777 ] ] break ] p = p + 1 ] ] and CGpchain(l) = valof [ if pchainvec!l eq 0 do [ pchainvec!l = PC+ #100000 resultis 0 ] if (pchainvec!l & #100000) ne 0 do [ let pc = pchainvec!l & #77777 pchainvec!l = PC + #100000 resultis pc ] resultis Nval(pchainvec!l - PC) ] and CGlchain(l) = valof [ let pc = lchainvec!l lchainvec!l = PC resultis pc ] and CGzchain(l) = valof [ if lchainvec!l eq 0 do [ lchainvec!l = PC + #100000 resultis 0 ] let n = PC - (lchainvec!l & #77777) if n le #377 do [ lchainvec!l = PC + #100000 resultis n ] PCmax = PCmax - 2 if PCmax le PC do CGreport(0) zlabelt = zlabelt + 1 Code!PCmax = l Code!(PCmax+1) = lchainvec!l lchainvec!l = PC + #100000 resultis 0 ] and CGrv() be [ unless type!arg1 eq AC do [ if ref!arg1 eq 0 do switchon type!arg1 into [ case LVLABEL: type!arg1 = LABEL; return case LVCOMMON: type!arg1 = COMMON; return case NUMBER: type!arg1 = RVNUMBER; return case LOCAL: type!arg1 = RVLOCAL; return case COMMON: type!arg1 = RVCOMMON; return case LABEL: test SWAlto then ref!arg1 = #40000 or type!arg1 = RVLABEL return default: ] if (ref!arg1 & #140000) eq #40000 do [ ref!arg1 = ref!arg1 + #100000; return ] ] CGstoreintemp(arg1) type!arg1 = RVLOCAL ] and CGsubscr(j) be [ if j eq 0 do 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 ref!arg2 eq 0 do switchon type!arg2 into [ case RVLABEL: if SWAlto do CGreport(-97) case RVNUMBER: case LOCAL: case RVLOCAL: case LVLABEL: case LABEL: case LVCOMMON: case COMMON: case RVCOMMON: Pop1() ref!arg1 = i return case NUMBER: [ let a = loc!arg1 + loc!arg2 if SWAlto % (a & #100000) eq 0 do [ Pop1() type!arg1 = RVNUMBER loc!arg1 = a return ] ] default: ] CGloadxr(arg2) Pop1() ref!arg1 = i return ] test type!arg2 eq AC then [ CGloadxr(arg1) CGae(Iadd, loc!arg2, X) ] or [ CGloadac(arg1) CGloadxr(arg2) CGae(Iadd, loc!arg1, X) ] Pop2() Push(XR, (j eq 0 ? #40000, j), X) ]