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