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