// BCAE1.bcpl - BCPL Compiler -- CAE Part 1.
// Copyright Xerox Corporation 1980
//  Last modified on Fri 20 Oct 72 2008.41 by  jec.

//  last modified by Butterfield, February 1, 1979  12:09 PM
//  - Readblockbody, additions to END - 1/25/79
//  - Readblockbody, skip END at end of declarations - 2/1

//	Readblockbody   Read the body of a block.
//	Rblock          Read a block.
//	Rnamelist       Read a name list.
//	EqVec           Test two vectors for equality.
//  * local to this file.

get "bcaex"

let Readblockbody() = valof
 [  let A, B, Cdefs, Op = 0, nil, 0, nil
    let Thisline = LinePtr()
    switchon Symb into
     [  case MANIFEST:
	case EXT:
	case STATIC:
         [	let V1 = -1
		Op = Symb
		Nextsymb()
		if Symb eq SECTBRA do 
		[ test V!0 eq 0 then V1 = 0
		  or [ V1 = Newvec(Length(V)/Bytesperword)
		       for k = 0 to Length(V)/Bytesperword do V1!k = V!k
		      ]
		  Nextsymb()
		]
		let n = 0
		 [readn
		    let CommonSW = false
		    if Symb eq RV do 
			[ CommonSW = true; Nextsymb() ]
		    unless Symb eq NAME do 
			[ CAEskip(1); goto Err ]
		    TempV!n = V!0
		    Nextsymb()
		    switchon Op into
		     [readv
			case EXT:
			  TempV!n = TempV!n + (CommonSW ? ZEXTLABEL, EXTLABEL)
			  TempV!(n+1) = 0
			  endcase

			case STATIC:
			  TempV!n = TempV!n + (CommonSW ? ZLABEL, LABEL)
			  test Symb eq ASS
			  then [ Nextsymb(); TempV!(n+1) = Rexp(0) ]
			  or   [ TempV!(n+1) = NILNODE ]
			  endcase

			case MANIFEST:
			  if CommonSW do CAEreport(1)
			  TempV!n = TempV!n + CONSTANT
			  unless Symb eq ASS do
			    [ CAEskip(1); goto Err ]
			  Nextsymb()
			  TempV!(n+1) = Rexp(0)
			  endcase

		       ]readv
		    n = n + TempN
		    if n ge TempT do
			 [ CAEreport(3)
			   until Symb eq SECTKET % Symb eq END do Nextsymb()
			 ]
	Err:	    test V1 eq -1 then break or if Symb ne SEMICOLON break
		    Nextsymb() repeatwhile Symb eq SEMICOLON
		    if Symb eq SECTKET break
		  ]readn repeat
		test V1 eq -1
		ifnot [ test Symb eq SECTKET
			then [ unless EqVec(V1) do CAEreport(4)
			       Nextsymb()
			     ]
			or   CAEskip(4)
		       ]
		ifso  [ if Symb eq END then Nextsymb();  // skip over END
			test Symb eq SEMICOLON
			then Nextsymb()
			or   CAEskip(4)
		       ]

		A = Newvec(n + 2)
		A!0 = Op
		A!2 = n
		for k = 0 to n-1 do A!(3+k) = TempV!k
		A!1 = Readblockbody()
		resultis List3(LINE, Thisline, A)
	  ]


	case STRUCTURE:
	    Nextsymb()
	    A = Rstruct(0)
	    B = Readblockbody()
	    A = List3(STRUCTURE, B, A)
	    resultis List3(LINE, Thisline, A)

	case AND:
	    CAEreport(26)
	case LET:
	    Nextsymb()
	    A = Rdef()
	    B = Readblockbody()
	    A = List3(LET, A, B)
	    resultis List3(LINE, Thisline, A)

	case SECTKET:
	    resultis A

	case END:
	    if V!0 eq 0 resultis A;
	    A = V!0; Nextsymb(); resultis List3(END, A, Readblockbody());

	case SEMICOLON:
	    while Symb eq SEMICOLON do Nextsymb()
	    resultis Readblockbody()

///*DCS* Conditional Compilation (wenn, probieren) at top level.
	case COMPILEIF:
	case COMPILETEST:
	   resultis List3(LINE, Thisline, Rcompileif(Symb))
	default:
	    A = Rcom(Readblockbody)
	    while Symb eq SEMICOLON do
	     [  while Symb eq SEMICOLON do Nextsymb()
		B = Readblockbody()
		A = List3(SEQ, A, B)
	      ]
	    resultis A
      ]
  ]

and Rcompileif(Op) = valof
	   [
	   Nextsymb()
	   let A = Newvec(5)
	   A!0 = COMPILEIF
	   A!2 = Rexp(0)
	   A!3, A!4 = 0,0
	   let B = Rcompilethen(A+3)
	   test Op eq COMPILETEST
	      ifso Rcompilethen(A+3)
	      ifnot if B then CAEreport(25)
	   A!1 = Readblockbody()
	   resultis A
	   ]

and Rcompilethen(nodeptr) = valof
	   [
	   while Symb eq SEMICOLON do Nextsymb()
	   let idx = selecton Symb into
	      [
	      case DO: case IFSO: 0
	      case OR: case IFNOT: 1
	      default: -1
	      ]
	   test idx ge 0
	      ifnot
	         [
	         CAEreport(20)
	         idx = 0
	         ]
	      ifso Nextsymb()
	   test Symb eq SECTBRA
	      ifnot CAEreport(28)
	      ifso Nextsymb()
    if idx!nodeptr then CAEreport(25)
	   idx!nodeptr = Readblockbody()
	   while Symb eq SEMICOLON do Nextsymb()
	   test Symb eq SECTKET
	      ifnot CAEreport(7)
	      ifso Nextsymb()
	   resultis idx
	   ]

and Rblock() = valof
 [  let A = nil
    let V1 = 0
    if Symb eq SECTBRA do
	[ if V!0 ne 0 do
	  [ V1 = Newvec(Length(V)/Bytesperword)
	    for k = 0 to Length(V)/Bytesperword do V1!k = V!k
	  ]
	  Nextsymb()
	]
    A = Readblockbody()
    test Symb eq SECTKET
    then if EqVec(V1) do Nextsymb()
    or   CAEskip(Symb eq END ? 6, 7)
    resultis A
  ]

and Rnamelist() = valof
 [  let A, B = nil, nil
    test Symb eq NIL
    then
     [  A = NILNODE
	Nextsymb()
      ]
    or
     [  unless Symb eq NAME do
	 [  CAEreport(8)
	    V!0 = ERRORNAME
	  ]
	A = List2(V!0 + LOCAL, 0)
	Nextsymb()
      ]
    unless Symb eq COMMA % Symb eq NAME resultis A
    test Symb eq NAME
    then CAEreport(9)
    or Nextsymb()
    B = Rnamelist()
    resultis List3(COMMA, A, B)
  ]


and EqVec(v) = valof
 [  if v eq 0 resultis V!0 eq 0
    for k = 0 to Length(v)/Bytesperword if v!k ne V!k resultis false
    resultis true
  ]

and Rtable() = valof
 [  let V1 = 0
    unless Symb eq SECTBRA do CAEskip(5)
    if V!0 ne 0 do
	[ V1 = Newvec(Length(V)/Bytesperword)
	  for k = 0 to Length(V)/Bytesperword do V1!k = V!k
	]
    Nextsymb()
    let v = vec TableMax
    let n = 0
    [	v!n = Rexp(0)
	n = n + 1
	if n gr TableMax do [ CAEreport(27); n = 0 ]
	if Symb ne SEMICOLON break
	Nextsymb() repeatwhile Symb eq SEMICOLON
	if Symb eq SECTKET break
    ] repeat
    test Symb eq SECTKET
    then [ unless EqVec(V1) do CAEreport(7)
	   Nextsymb()
	 ]
    or CAEskip(7)
    let A = Newvec(n+1)
    A!0 = TABLE
    A!1 = n
    for k = 0 to n-1 do A!(2+k) = v!k
    resultis A
   ]