// BCAE4.bcpl - BCPL Compiler -- Part 4 of CAE. // Copyright Xerox Corporation 1980 // Last modified on Tue 07 Mar 72 1725.24 by AE. // Rstruct -- Read a structure declaration. // Rqualname -- Read a qualified name (a structure reference). // *Rsubscr -- Read a subscript pair // * local to this compilation only. get "bcaex" let Rstruct(P) = valof [ let S = 0 switchon Symb into [firstitem case SECTBRA: [fieldlist let V1 = 0 if V!0 ne 0 do [ V1 = Newvec(Length(V)/Bytesperword) for k = 0 to Length(V)/Bytesperword do V1!k = V!k ] let v = vec FieldMax let p = 0 [ Nextsymb() let s = Rstruct(0) unless s eq 0 do [ p = p + 1 if p gr FieldMax do [ CAEreport(3); p = 1 ] v!p = s ] ] repeatwhile Symb eq SEMICOLON test Symb eq SECTKET then if EqVec(V1) do Nextsymb() or CAEskip(7) v!0 = p S = Newvec(p+1) H1!S = FIELDLIST for i = 0 to p do (H2+i)!S = v!i while Symb eq UPLUMP do S = Rsubscr(S) endcase ]fieldlist case SECTKET: case SEMICOLON: endcase case RV: [structname Nextsymb() unless Symb eq NAME do [ CAEskip(8); endcase ] S = List2(RV, V!0 + NameBit) Nextsymb() while Symb eq UPLUMP do S = Rsubscr(S) endcase ]structname case NAME: case BLANK: [name let T = List2(Symb, 0); S = T if Symb eq NAME do H1!T = V!0 + NameBit let U = nil Nextsymb() while Symb eq UPLUMP do S = Rsubscr(S) if Symb eq COLON do Nextsymb() switchon Symb into [namedef case BIT: case BYTE: case WORD: U = List2(Symb, 0) Nextsymb() if Symb ne ASS do if Symb ne SEMICOLON do if Symb ne SECTKET do H2!U = Rexp(0) H2!T = U endcase case SECTBRA: case RV: H2!T = Rstruct(1) endcase ]namedef endcase ]name ]firstitem if P eq 1 resultis S if Symb eq ASS do [moreitems let v = vec FieldMax let p = 0 p = p + 1; v!p = S [ Nextsymb() let s = Rstruct(1) unless s eq 0 do [ p = p + 1 if p gr FieldMax do [ CAEreport(3); p = 2 ] v!p = s ] ] repeatwhile Symb eq ASS v!0 = p S = Newvec(p+1) H1!S = OVERLAYLIST for i = 0 to p do (H2+i)!S = v!i ]moreitems resultis S ] and Rsubscr(s) = valof [ let S = List4(Symb, s, 0, 0) Nextsymb() H3!S = Rexp(12) test Symb eq COMMA then [ Nextsymb(); H4!S = Rexp(12) ] or [ H4!S = H3!S; H3!S = 0 ] resultis S ] and Rqualname(n) = valof [ let S = 0 let v = vec QualMax*2 v!0 = 0 let p = 1 [nextname Nextsymb() unless Symb eq NAME do [ CAEskip(8) S = Newvec(n); S!n = 0 resultis S ] v!p = V!0 + NameBit v!(p+1) = 0 let q = p+2 Nextsymb() if Symb eq UPLUMP do [nextsubscr Nextsymb() v!q = Rexp(41) v!(p+1) = v!(p+1) + 1 q = q + 1 ]nextsubscr repeatwhile Symb eq UPLUMP v!0 = v!0 + 1 p = q ]nextname repeatwhile Symb eq DOT S = Newvec(n+p-1) for i = 0 to p-1 do (n+i)!S = v!i resultis S ]