// BTRN2.bcpl - BCPL Compiler -- Trans, Part 2.
// Copyright Xerox Corporation 1980
//  Last modified on Fri 27 Oct 72 0114.17 by  jec.

//	TransLET	Translate the left son of a LET node.
//	*Transdef1	Load the right sides of definitions other than VALDEFs.
//	*TD1		Do the work for Transdef1

//	*DeclNames	Declare names.
//	*DeclDyn		Declare dynamic variables.

//	ListLength	Return the length of a list.
//  * local to this file.

get "btrnx"		//  Declarations for Trans.

//  Translate the left son of a LET node.
let TransLET(x) be
 [  let S, V = SSP, VecSSP
    and SB = SwitchBlock
    SwitchBlock = false
    let Def = H2!x   //  The definition.
    while H1!Def eq LINE do [ Curline = H2!Def
			       if SWList do [ if SWOcode do WW($*n); WriteLine(Curline) ]
			       Out2(PLINE, Curline); Def = H3!Def ]
    DeclNames(Def)
    SSP = S
    Transdef1(Def)
    Out2(STACK, SSP)
    Out1(STORE)
    Trans(H3!x)
    SSP, VecSSP = S, V
    SwitchBlock = SB
    Out2(STACK, SSP)
    return
  ]


and Transdef1(x) be   //  Load right side(s) of a definition.  Called from TransLET.
 [  if x eq 0 return
    while H1!x eq LINE do [ Curline = H2!x
			    if SWList do [ if SWOcode do WW($*n); WriteLine(Curline) ]
			    Out2(PLINE, Curline); x = H3!x; if x eq 0 return ]
    switchon H1!x into
     [  case AND:
	    Transdef1(H2!x)
	    Transdef1(H3!x)
	    return

	case VALDEF:
	 [  let S = SSP
	    TD1(H2!x, H3!x)
	    let n = (SSP - S) - H4!x   //  Difference between number of names and of values.
	    if n eq 0 return   //  All is well if they are the same.
	    TRNreport(3)   //  Oops.
	    return
	  ]

	case FNDEF: case RTDEF:   //  Function or routine definition.
	 [  let L = nil
	    unless FrameLevel eq 0 do [ L = Nextparam()
				        Compjump(L) ]    //  Compile jump round body.
	    FrameLevel = FrameLevel + 1
	    let S, V, MS, MV = SSP, VecSSP, MaxSSP, MaxVecSSP
	    let VB, SB, RB = ValofBlock, SwitchBlock, RepeatBlock
	    ValofBlock, SwitchBlock, RepeatBlock = false, false, false
	    let EL = Endcaselabel
	    Endcaselabel = 0
	    let RBody = RoutineBody
	    RoutineBody = H1!x eq RTDEF   //  Are we in a routine body?
	    //  Compile the entry point.  H5!x was set in DeclNames to the label of this routine.
	    Compentry(H5!x, H6!x)  
	    let EntryPos = Position(OcodeStream)
	    OutN(0); OutN(0)
	    SSP = Savespacesize   //  Start a new stack frame.
	    VecSSP = 0
	    MaxSSP = SSP
	    MaxVecSSP = VecSSP

	    DeclDyn(H3!x)   //  Declare the formal parameter list.

	    //  Compile the body of the thing.
	    Out2(SAVE, SSP)
	    if H7!x ne 0 do
		[ DeclDyn(H7!x)
		  let n = H7!x
		  Out1(NUMARGS); OutL(H1!n & NameMask)
		]
	    test  RoutineBody
	    ifso
	     [  let S = SSP
		Trans(H4!x)
		unless SSP eq S do TRNreport(-3)
		Out1(RTRN)
	      ]
	    ifnot 
	     [ 	let S = SSP
		Load(H4!x)
		unless SSP eq S + 1 do TRNreport(-4)
		Out1(FNRN)
	       ]

	    Out1(ENDFRAME)
	    let EndPos = Position(OcodeStream)
	    Reposition(OcodeStream, EntryPos)
	    OutN(MaxSSP); OutN(MaxVecSSP)
	    Reposition(OcodeStream, EndPos)

	    SSP, VecSSP, MaxSSP, MaxVecSSP = S, V, MS, MV
	    Out2(STACK, SSP)

	    FrameLevel = FrameLevel - 1
	    unless FrameLevel eq 0 do [ Complab(L) ]   //  The jump around the body.
	    ValofBlock, RepeatBlock, SwitchBlock = VB, RB, SB
	    Endcaselabel = EL
	    RoutineBody = RBody
	    return
	  ]

	default:
	    return
      ]
  ]


//  TD1 is called by
//	Transdef, case VALDEF, to process the right side.
//  In general, it loads the relevant value(s) into the stack, but VEC"s are special.
//  For these only the label is loaded and VecSSP is incremented by the space needed.

and TD1(n, x) be
 [  if (H1!n & TypeMask) ne 0 do n = H1!n & NameMask
    switchon ( (x & NameBit) eq 0 ? H1!x, 0)  into
     [  default:
	    Load(x)
	    Out1(NEWLOCAL); OutL(n)
	    return
	case VEC:
	    Out2(LLVP, VecSSP)
	    Out1(NEWLOCAL); OutL(n)
	    SSP = SSP + 1; CheckSSP()
	    VecSSP = VecSSP + 1 + GetConst(H2+x); CheckVecSSP()
	    return
	case COMMA:
	    TD1((n eq 0 ? 0, H2!n), H2!x)
	    TD1((n eq 0 ? 0, H3!n), H3!x)
	    return
      ]
  ]


//  Declare the names in a set of declarations.  Dynamic names (case VALDEF) are processed by
//  DeclDyn, which steps SSP by the number of names declared.  Names of functions and routines
//  are declared as static items by DeclStat.  Leave symbol table offset in FNDEF and RTDEF nodes.
//  This routine is called only from TransLET.

and DeclNames(x) be
 [  if x  eq  0 return
    if H1!x eq LINE do [ Curline = H2!x; Out2(LINE, Curline); x = H3!x ]
    switchon H1!x into
     [  case AND:
	    DeclNames(H2!x)
	    DeclNames(H3!x)
	    return

	case VALDEF:
	 [  let S = SSP
	    DeclDyn(H2!x)
	    H4!x = SSP - S   //  Record number of names declared.
	    return
	  ]

	case RTDEF:
	case FNDEF: 
	 [  return
	  ]

	default:
	    TRNreport(-5)   //  Compiler error.
      ]
  ]


//  Declare 1 or more dynamic names, in a formal parameter list or on the left side of a
//  VALDEF.  Step SSP as appropriate.  This routine is called from
//	DeclNames, case VALDEF, to process the names being declared.
//	Transdef1, case FNDEF and RTDEF to process the formal parameters.

and DeclDyn(x) be
 [  if x eq 0 return
    if (H1!x & TypeMask) ne 0 do
     [  H2!x = SSP
        SSP = SSP + 1; CheckSSP()
        return
      ]
    switchon H1!x into
     [  case NIL:
	    SSP = SSP + 1; CheckSSP()
	    return

	case COMMA:
	    DeclDyn(H2!x)
	    DeclDyn(H3!x)
	    return

	default:
	    TRNreport(-6)   //  Compiler error.
	    return
      ]
  ]