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