// BTRN3.bcpl - BCPL Compiler -- Trans, Part 3.
// Copyright Xerox Corporation 1980
//  Last modified on Tue 17 Oct 72 0251.27 by  jec.

//	Jumpcond	Compile a conditional jump.
//	Transcall	Compile a call
//     *LoadListItem	Utility for Transcall
//     *ListLength	Utility for Transcall
//	DoQual
//	OutQual
//  * local to this file.


get "btrnx"		//  Declarations for Trans.

let Jumpcond(x, B, L) be
 [  let lx = CheckConst(lv x)
    if lx > 0 do
     [  test rv lx
	then if B do Compjump(L)
	or if not B do Compjump(L)
	return
      ]

    switchon ( (x & NameBit) eq 0 ? H1!x, 0)  into
     [  case NOT:
	    Jumpcond(H2!x, not B, L)
	    return

	case LOGAND:
	    test B
	    then
	     [  let M = Nextparam()
		Jumpcond(H2!x, false, M)
		Jumpcond(H3!x, true, L)
		Complab(M)
	      ]

	    or
	     [  Jumpcond(H2!x, false, L)
		Jumpcond(H3!x, false, L)
	      ]
	    return

	case LOGOR:
	    test B then
	     [  Jumpcond(H2!x, true, L)
		Jumpcond(H3!x, true, L)
	      ]

	    or
	     [  let M = Nextparam()
		Jumpcond(H2!x, true, M)
		Jumpcond(H3!x, false, L)
		Complab(M)
	      ]
	    return

	case COND:
	 [  let M, N = Nextparam(), Nextparam()
	    Jumpcond(H2!x, false, M)
	    Jumpcond(H3!x, B, L)
	    Compjump(N)
	    Complab(M)
	    Jumpcond(H4!x, B, L)
	    Complab(N)
	    return
	  ]

	default:
	    Load(x)
	    Out2P(B ? JT, JF, L)
	    SSP = SSP - 1
	    return
      ]
  ]


and Transcall(x) be
 [  let s = SSP
    let n = (H3!x eq 0 ? 0, ListLength(H3!x))
    Out1(H1!x eq RTAP ? RTCALL, FNCALL)
    SSP = SSP + 1; CheckSSP()
    let L = 0
    if (H2!x & NameBit) ne 0 do
	[ let t = H2!x & PtrMask
	  L = t!0 & NameMask
	]
    for i = 1 to n do
     [	LoadListItem(H3!x, i)
	Out1(PARAM); OutC(i); OutC(n); OutL(L)
      ]
    Load(H2!x)
    Out1(H1!x); Out1(n); OutN(s)
    SSP = s
    if H1!x eq FNAP do [ SSP = SSP + 1; CheckSSP() ]
  ]

//  Return the length of a list made up of COMMA.  Called from
//	Trans, case RTAP (from Transcall)
//	Load, case FNAP (from Transcall)

and ListLength(x) = valof
 [  if (x & NameBit) ne 0 resultis 1
    if H1!x eq COMMA   do resultis ListLength(H2!x) + ListLength(H3!x)
    resultis 1
  ]

and LoadListItem(x, n) be
 [  if n le 0 return
    if (x & NameBit) ne 0 do
      [	if n eq 1 do Load(x)
	return
       ]
    if H1!x eq COMMA do
      [	let l = ListLength(H2!x)
	test n le l
	then	LoadListItem(H2!x, n)
	or	LoadListItem(H3!x, n-l)
	return
       ]
    if n eq 1 do Load(x)
    return
  ]

and CheckConst(LVX) = valof
 [  let x = rv LVX
    if x eq 0 resultis 0
    if (x & NameBit) ne 0 do
      [	let d = x & PtrMask
	test (d!0 & TypeMask) eq CONSTANT
	then resultis lv d!1
	or   resultis 0
       ]
    switchon H1!x into
      [	case NUMBER:
	case CHARCONST:
	case TRUE:
	case FALSE:
	case NIL:
	    resultis lv H2!x

	default:
	    resultis 0
       ]
  ]

and GetConst(LVX) = valof
 [  let x = CheckConst(LVX)
    if x gr 0 resultis rv x
    TRNreport(13)
    rv LVX = ZERONODE
    resultis 0
  ]

and DoQual(d, qualvec, dowordsub) = valof
 [  let Op = nil
    let wordoffset, bitoffset = d!0/WordSizeOb, d!0 rem WordSizeOb
    let wboffset = 0
    let nosub = d!2 eq 0
    let wordsub, bytesub, bitsub = false, false, false
    unless nosub do
     [ let p = 3
       for i = 1 to d!2 do
	[  let lowlim = (d!(p+2))!0
	   wboffset = wboffset + d!(p+0) - lowlim*d!(p+3)
	   test d!(p+3) rem WordSizeOb eq 0
	   then wordsub = true
	   or test d!(p+3) eq ByteSizeOb
	   then bytesub = true
	   or   bitsub  = true
	   p = p + 4
	 ]
      ]

    if bitsub do bytesub = false
    if not dowordsub do
	[ bitsub = bitsub % bytesub % wordsub
	  bytesub, wordsub = false, false
	]
    if bytesub do
	[ unless d!1 eq ByteSizeOb do bitsub, bytesub = true, false
	  unless (d!0 + wboffset) rem ByteSizeOb eq 0 do bitsub, bytesub = true, true
	]

    if wordsub do
	[ let p = 3
	  for i = 1 to d!2 do
	   [  if d!(p+3) rem WordSizeOb eq 0 do
		[ Load(d!(p+1))
		  let n = d!(p+3)/WordSizeOb
		  test n eq 1
		  then Out1(PLUS)
		  or [ Out1(WSUB); OutN(d!(p+3)/WordSizeOb) ]
		  SSP = SSP - 1
		 ]
	      p = p + 4
	    ]
	 ]

    test bitsub
    ifso
     [	Out2(LN, d!0 + wboffset); OutL(0)
	SSP = SSP + 1; CheckSSP()
	let p = 3
	for i = 1 to d!2 do
	 [  if d!(p+3) rem WordSizeOb ne 0 % not dowordsub do
	     [	Load(d!(p+1))
		let n = d!(p+3)
		test n eq 1
		then Out1(PLUS)
		or [ Out1(BSUB); OutN(d!(p+3)) ]
		SSP = SSP - 1
	      ]
	    p = p + 4
	  ]
	test d!1 le WordSizeOb
	then Op = WBQUAL
	or   Op = MWBQUAL
	wordoffset, bitoffset = 0, 0
      ]
    or test bytesub
    ifso
     [	let b = (d!0 + wboffset)/ByteSizeOb
	let firstone = true
	let p = 3
	for i = 1 to d!2 do
	 [  if d!(p+3) eq ByteSizeOb do
		[ Load(d!(p+1))
		  test firstone then firstone = false or
		  [ Out1(PLUS)
		    SSP = SSP - 1
		  ]
		]
	    p = p + 4
	  ]
	unless b eq 0 do
	[ Out2(LN, b); OutL(0)
	  SSP = SSP + 1; CheckSSP()
	  Out1(PLUS)
	  SSP = SSP - 1
	]
	Op = YQUAL
	wordoffset, bitoffset = 0, 0
      ]
    ifnot
     [	wordoffset = wordoffset + wboffset/WordSizeOb
	let lastbit = bitoffset + d!1 - 1
	test lastbit ls WordSizeOb
	then [	Op = WQUAL
	      ]
	or test d!1 le WordSizeOb
	then [	Out2(LN, wordoffset); OutL(0)
		Out1(PLUS)
		Op = XQUAL
		wordoffset = 0
	      ]
	or test d!1 rem WordSizeOb eq 0 & bitoffset eq 0
	then [	Op = MWQUAL
	      ]
	or   [	Out2(LN, d!0 + wboffset); OutL(0)
		SSP = SSP + 1; CheckSSP()
		Op = MWBQUAL
		wordoffset, bitoffset = 0, 0
	      ]
      ]

    qualvec!0 = Op
    qualvec!1 = wordoffset
    qualvec!2 = bitoffset
    qualvec!3 = d!1
    resultis Op
  ]

and OutQual(q) be
 [  Out1(q!0)
    switchon q!0 into
     [	default:
	    TRNreport(-10)

	case MWQUAL:
	case MWBQUAL:
	    TRNreport(16)
	    return

	case WQUAL:
	case STWQUAL:	OutN(q!1)
	case NQUAL:
	case XQUAL:
	case STNQUAL:
	case STXQUAL:	OutN(q!2)
	case YQUAL:
	case STYQUAL:
	case WBQUAL:
	case STWBQUAL:	OutN(q!3)
      ]
  ]