// BTRN4.bcpl - BCPL Compiler -- Part 4 of Trans.
// Copyright Xerox Corporation 1980
//  Last modified on Tue 24 Oct 72 2324.20 by  jec.
//  Swinehart, 5-10-77: docase exp

//	Transswitch	Translate a "switchon" or a "branchon".
//	*Simpass		Process an individual assignment - called by Assign.
//	Assign		Translate an assignment statement.
//  * local to this file.

get "btrnx"

let Transswitch(x) be
 [  let P = CaseP   //  Save the current pointer into the case table.
    and DL, EL, DCL = Defaultlabel, Endcaselabel, Docaselabel
    let SB = SwitchBlock   //  Were we in a switch block?
    SwitchBlock = true   //  Now we are.

    let L = Nextparam()   //  Label for the switching code.
    Endcaselabel = Nextparam()   //  Label for exiting from the whole thing.

    Compjump(L)   //  Jump to the switching code.
    Defaultlabel, Docaselabel = 0,0   //  There is as yet no default or docase.
    Trans(H3!x)   //  Translate the body.
    Compjump(Endcaselabel)   //  Jump to the next peice of code.
    Complab(L)   //  Place the label for the switch.
    SwitchBlock = false
    Load(H2!x)   //  That on which we are about to switch.
    if Defaultlabel eq 0 do Defaultlabel = Endcaselabel
    let C = (CaseP - P) / CaseN   //  The number of case labels.
    if C eq 0 do [ TRNreport(9); return ]   //  We can"t do switches without cases.
    Out1(SWITCHLOAD)
    if Docaselabel then Complab(Docaselabel) // home docase jumps
    Out3P(SWITCHON, C, Defaultlabel)

    for i = P step CaseN to CaseP - CaseN do
     [	OutN(Casetable!i); OutL(Casetable!(i+1))
	for j = i + CaseN step CaseN to CaseP - CaseN do
	 [  if Casetable!j eq Casetable!i do
		[ Curline = Casetable!(j+2); TRNreport(11) ]
	 ]
      ]

    SSP = SSP - 1
    Complab(Endcaselabel)   //  Place the label to leave the whole thing.
    Endcaselabel, Defaultlabel, Docaselabel = EL, DL, DCL
    SwitchBlock = SB
    CaseP = P
  ]

and Simpass(x, y) be   //  Assign y to x
 [  if (x & NameBit) ne 0 do
	 [  unless y eq 0 do [ Load(y); SSP = SSP - 1 ]   //  Load the right side.
	    let d = x & PtrMask
	    let N = d!1		//  The datum associated with the name.
	    let n = d!0 & NameMask
	    switchon d!0 & TypeMask into   //  What sort of name is it?
	     [  default:
		    TRNreport(14)   //  Bad sort of name.
		    return

		case LOCAL:
		    Out2(SP, N); OutL(n)
		    return

  		case EXTLABEL: case INTLABEL:   //  Storing into an external.
		case LABEL:   //  Storing into a label.
		    Out2P(SL, N); OutL(n)
		    return

		case ZEXTLABEL: case ZINTLABEL:
		case ZLABEL:
		    Out2P(SZ, N); OutL(n)
		    return


	      ]
	  ]

    //  branch on the principal operator on the left side.
    switchon H1!x into
     [	case RV:
	    unless y eq 0 do Load(y)
	    Load(H2!x)
	    Out1(STIND)
	    SSP  =  SSP - (y eq 0 ? 1, 2)
	    return

	case VECAP:
	 [  unless y eq 0 do Load(y)
	    let A, B = H2!x, H3!x
	    test (A & NameBit) ne 0
	    then [ let t = A & PtrMask
		   if (t!0 & TypeMask) eq CONSTANT do A, B = H3!x, H2!x
		  ]
	    or if H1!A eq NUMBER do A, B = H3!x, H2!x
	    Load(A); Load(B); Out1(STVECAP)
	    SSP = SSP - (y eq 0 ? 2, 3)
	    return
	  ]

	case COND:   //  A conditional on the left side.
	 [  let L, M = Nextparam(), Nextparam()   //  Label exit, false arm.
	    and S = SSP
	    unless y eq 0 do Load(y)
	    Jumpcond(H2!x, false, M)   //  Jump if the boolean is false.
	    Simpass(H3!x, 0)   //  Compile the store for the true arm.
	    Compjump(L)   //  Hop out.
	    SSP = y eq 0 ? S, S+1
	    Complab(M)
	    Simpass(H4!x, 0)   //  The store for the false arm.
	    Complab(L)
	    SSP = S
	    return
	  ]

	case LEFTLUMP:
	case RIGHTLUMP:
	 [  let S = SSP
	    unless y eq 0 do Load(y)
	    test H1!x eq RIGHTLUMP
	    then Load(H2!x)
	    or	[ let d = H3!x
		  let t = H2!x
		  test H1!t eq LEFTLUMP % H1!t eq RIGHTLUMP then TRNreport(17)
		  or if d!0 ge WordSizeOb % (d!0+d!1-1) ge WordSizeOb % d!2 gr 0 do
		    unless H1!t eq VECAP % H1!t eq RV do TRNreport(14)
		  LoadLV(H2!x)
	         ]
	    let qualvec = vec 3
	    DoQual(H3!x, qualvec, true)
	    switchon qualvec!0 into
	     [	case WQUAL:
			test qualvec!2 eq 0 & qualvec!3 eq WordSizeOb
			then qualvec!0 = STWQUAL
			or [ Out2(LN, qualvec!1); OutL(0)
			     Out1(PLUS)
			     qualvec!1 = 0
			     qualvec!0 = STNQUAL
			   ]
			endcase
		case XQUAL:
			qualvec!0 = STXQUAL
			endcase
		case YQUAL:
			qualvec!0 = STYQUAL
			endcase
		case WBQUAL:
			qualvec!0 = STWBQUAL
			endcase
	      ]
	    OutQual(qualvec)
	    SSP = S
	    return
	  ]

	default:
	    TRNreport(14)
      ]
  ]


and Assign(x, y) = valof
 [  if x eq 0 % y eq 0 do
     [  unless x eq 0 & y eq 0 do TRNreport(3)
	resultis 0
      ]
    unless (y & NameBit) ne 0 do
    [ if H1!y eq COMMA do
     [  unless H1!x eq COMMA do
	 [  TRNreport(3)
	    resultis 0
	  ]
	resultis Assign(Assign(x, H2!y), H3!y)
      ]
    ]
    unless (x & NameBit) ne 0 do
    [ if H1!x eq COMMA do
     [  Simpass(H2!x, y)
	resultis H3!x
      ]
    ]
    Simpass(x, y)
    resultis 0
  ]