Module Struct =
Begin

Require 'bliss.req';

! called from RUND if inside a structure definition.  takes sym and del
! and copies them to the structure definition stream.

Global Routine struct_copy : Novalue =
Begin
    Local
	P		: Ref GT,
	s		: Ref ST,
	i		: Integer;

    i = -1;
    s = .sym;
    If .s[gt_type] Eql T_VARIABLE Then
	s = .s[gt_disp];
    If .s[gt_type] Eql T_SYMBOL Then
	Begin
	If .s[st_code] Eql S_STRUCT_ARG Then
	    i = .s[st_which]
	Else If .s Eqla .sym_define Then
	    i = 0
	End;
    If .i Geq 0 Then
	Begin
	If .OLDDEL Eql TK_DOT Then
	    Begin
	    If .flg_size_expr Then
		WARNEM(.pos_sym,B11$_NO_DOTS)
	    Else If .i Gtr 1 Then
		i = .i + .sym_define[st_str_argc]
	    End
	Else
	    Begin
	    If .i Eql 0 Then
		WARNEM(.pos_sym,B11$_WANT_DOT)
	    End;
	If .OLDDEL Eql TK_DOT Then
	    Begin
	    P = prm_buff[strm_data(.prm_buff[strm_size] - 1)];
	    p[lex_delim] = 0
	    End;
	p = stream_append(prm_buff,SZ_PRM_BUFF);
	p[lex_addr]  = .i;
	p[lex_type]  = T_STRUCT_ARG;
	P[lex_delim] = .DEL;
	P[lex_attr]  = 0;
	FreeSym();
	SYM = MakeLit(0);
	Return
	End;

! append sym and del to the structure definition stream

!    p = stream_append(prm_buff,SZ_PRM_BUFF);
    If .s[gt_type] Eql T_SYMBOL And .s[st_scope] Gtr .level_structure Then
	s = .s[st_name]
    Else If .s[gt_type] Eql T_STRING Then
	s = DupString(.s);
    StoreLexeme(prm_buff,SZ_PRM_BUFF,.s,.del)
End;

! parse a structure body.
!
! input
!	SIZEPRED	TRUE if parsing structure size expression.
!			FALSE if parsing structure access expression

Global Routine struct_parse(SIZEPRED : Boolean) =
Begin 
    Local
	SAVEDEL		: Integer,
	P		: Ref GT;

! just parsing so no code generation.

    NOCODE;

! indicate that we are parsing a structure expression declaration
! and note whether it is the size or access expression

    flg_struct_body = TRUE;
    flg_size_expr   = .SIZEPRED;

! we do not know whether we are parsing the size or access
! expression until we see the first token of it.  because of
! this, the first token was not stored in the structure
! definition stream and so we do it here.

! only raw tokens are stored in the stream so we need to
! save the cooked one and retrieve the old raw one.

    SAVEDEL = .DEL;
    DEL = (If .DEL Eql TK_LPAREN Then '(' Else .OLDDELI);
    struct_copy();
    DEL = .SAVEDEL;

! now parse the expression

    EXPRESSION();

! the last delimiter was hopefully either a ']', a ',', or a
! ';'.  replace it with a '>'

    P = prm_buff[strm_data(.prm_buff[strm_size] - 1)];
    P[lex_delim] = '>';			! OVERWRITE CLOSING DELIMITER

! no longer in a structure expression definition and re-enable
! code generation.

    flg_struct_body = FALSE;
    RESNOTREE;

! return the stream created

    Return stream_quit(prm_buff)
End;

! CHANGE THE STRUCTURE FORMAL IN SYM TO A 'REAL' LEXEME.
!
! notes:
!	in order to avoid side effects, structure arguments
!	are treated as if they are BIND expressions. e.g.:
!
!		structure x[i,j] = (x+.i*10+.j)<0,8>;
!
!	is treated like:
!
!		structure x[i,j] = (Bind ii = .i, jj = .j; (x+ii*10+jj)<0,8>);

Global Routine struct_expand_formal(I : Integer) : Novalue =
Begin
    Local
	P		: Ref GT,
	S		: Ref GT;

    P = mac_actuals[act_data(.I)];
    S = .P[lex_addr];
    If .P[lex_type] Eql T_NODE Then
	S = FAKECSE(.S)
    Else If .P[lex_type] Eql T_STRING Then
	S = DupString(.S);
    PushLexeme(.P[lex_type],.S,0)
End;

! expand a structure

Global Routine struct_expand_struct(STREAM : Ref Vector,ACTUALS : Ref Vector,
			STRUCT : Ref ST) =
Begin
    Local
	SAVEL		: Integer;

! if inside the definition of a structure or code generation is
! turned off then just return a zero.

    If .flg_struct_body Or .NOTREE Then
	Return MakeLit(0);

! set DEL to a ';' in order to be in the right context.

    DEL = TK_SEMICOLON;

! setup for error recovery

    savel = .lastend;
    lastend[PS_RANGLE] = TRUE;

! establish the structure expression/allocation body as the current
! stream.

    MACRSWAP(SRC_STRUCTURE,MAC_SIMPLE,.STREAM);

! fill in the rest of the stream information

    mac_v_trace = FALSE;
    mac_actuals = .ACTUALS;
    mac_name    = .STRUCT;

! prime the scanner and parse the expression

    RUND(QL_LEXEME);
    EXPRESSION();

! at this point, DEL should be the '>' generated by struct_parse above.

    lastend = .savel;
    Return .SYM
End;

Routine StoreActual(V : Ref GT) : Novalue =
Begin
    Local
	S	: Ref GT,
	K	: Integer;

    S = .SYM;
    K = .S[gt_type];
    If .K Eql T_VARIABLE Or .K Eql T_LITERAL Then
	Begin
	S = .S[gt_disp];
	FreeSym()
	End;
    V[lex_type] = .K;
    V[lex_addr] = .S
End;

Routine DC : Novalue =
Begin
    Local
	P		: Ref GT;

    SYM = BINDBIND(.SYM);
    If .SYM[gt_type] Eql T_NODE Then
	Begin
	P = .SYM[gt_csparent];
	P[gt_occ] = .P[gt_occ] - 1;
	If .p[gt_occ] Eql 0 Then
	    SYM = .P
	End
End;

! collect structure reference arguments

Global Routine STRUPICKOFF(CLOSEDEL, ACTUALS : Ref Vector, MAXSIZE, F_LIT)
			: Novalue =
Begin
    Local
	INDEX		: Integer,
	pos_open	: Integer,
	SAVEL		: Integer;

    pos_open = .pos_del;
    savel = .lastend;
    INDEX = 0;
    lastend[PS_COMMA] = TRUE;
    If .CLOSEDEL Eql TK_RBRACKET Then
	lastend[PS_RBRACKET] = TRUE
    Else
	lastend[PS_SEMICOLON] = TRUE;

! loop while more arguments are needed or there are more arguments

    Do
	Begin
	If .DEL Neq .CLOSEDEL Then
	    Begin
	    RUND(QL_LEXEME);
	    If .SYM Neq NIL Or (.DEL Neq .CLOSEDEL And .DEL Neq TK_COMMA) Then
		Begin
		If .INDEX Geq .MAXSIZE And .MANYACTS Eql 0 Then
		    Begin
		    WARNEM(.pos_sym,B11$_EXTRA_ACTUALS);
		    MANYACTS<1,1> = TRUE
		    End;
		EXPRESSION();
		DC();
		If .F_LIT Then
		    Begin
		    If .SYM[gt_type] Neq T_LITERAL Then
			Begin
			WARNEM(.pos_sym,B11$_WANT_CTCE);
			FreeSym();
			SYM = MakeLit(1)
			End
		    End;
		If .DEL Neq .CLOSEDEL And .DEL Neq TK_COMMA Then
		    Begin
		    lastend = .savel;
		    ERROR(.pos_open,.pos_del,0,B11$_MISSING_COMMA);
		    Return
		    End
		End
	    End
	Else
	    SYM = NIL;

	If .INDEX Lss .MAXSIZE Then
	    Begin
	    StoreActual(ACTUALS[.INDEX]);
	    INDEX = .INDEX + 1
	    End
	End
    While .INDEX Lss .MAXSIZE Or .DEL Neq .CLOSEDEL;
    MANYACTS<1,1> = FALSE;
    lastend = .savel
End;

Global Routine stmt_bracket : Novalue =
Begin
    Local
	STRUCT		: Ref ST,
	INCACTS		: Ref Vector,
	V		: Vector[SZ_STREAM(64)],
	N		: Integer,
	SVMNACTS	: Integer,
	s		: Ref GT,
	R		: Ref GT,
	f		: Boolean;

    INCACTS  = 0;
    SVMNACTS = .MANYACTS;
    MANYACTS = 0;
    f = FALSE;

! structure reference through a non-variable uses the default
! structure 'VECTOR'

    If .SYM[gt_type] Neq T_VARIABLE Then
	Begin
	STRUCT = .sym_vector;
	f = TRUE
	End

! if a general structure reference

    Else If .sym[gt_code] Eql S_STRUCTURE Then
	Begin
	s = .SYM[gt_disp];
	FreeSym();
	STRUCT = .S;
	RUND(QL_LEXEME);
	EXPRESSION();
	f = FALSE
	End

! if a reference through a variable

    Else
	Begin
	s = .SYM[gt_disp];
	MANYACTS<0,1> = .s[st_v_unlim_acts];
	If .s[st_v_no_acts] Then
	    STRUCT = (If .s[st_var_actuals] Eql 0
			Then .sym_vector
			Else .s[st_var_actuals])
	Else
	    Begin
	    INCACTS = .s[st_var_actuals];
	    STRUCT  = .INCACTS[act_symb]
	    End;
	f = TRUE
	End;

! the first actual is the LHS of the '['

    DC();
    StoreActual(V[act_data(0)]);

! the second actual is the value of 'BYTES' which is defaulted
! here to 2 bytes.

    R = V[act_data(1)];
    R[lex_type] = T_LITERAL;
    R[lex_addr] = 2;
    N = .STRUCT[st_str_argc];

! if a reference through a variable or a expression

    If .f Then
	Begin
	If .INCACTS Eqla 0 Then
	    Begin
	    Incr I From 0 To .N-1 Do
		V[act_data(.I+2)] = 0
	    End
	Else
	    MOVECORE(INCACTS[act_data(0)],V[act_data(1)],.N+1)
	End

! if a reference through a structure

    Else
	Begin
	STRUPICKOFF(TK_SEMICOLON,V[act_data(2)],.N,FALSE)
	End;
    STRUPICKOFF(TK_RBRACKET,V[act_data(.N+2)],.N,FALSE);
    MANYACTS = .SVMNACTS;
    s = struct_expand_struct(.STRUCT[st_str_body],V,.STRUCT);

! skip over the ']'

    RUNDE();
    SYM = .s
End;

Global Routine struct_get_size(p : Ref GT,OTYPE : Integer,DECLSIZE : Integer) =
Begin
    Local
	NOBRAC		: Boolean,
	NSTART		: Integer,
	SAVMNACTS	: Integer,
	SAVDEL		: Integer,
	S		: Ref GT,
	R		: Ref GT,
	V		: Vector[SZ_STREAM(64)];

! allocate space for actuals

    NSTART = .pos_del;
    ptr_actuals = GETSPACE(SZ_STREAM(.p[st_str_argc]+1));
    ptr_actuals[act_size] = .p[st_str_argc]+1;

! if a structure allocation expression was given...

    If .DEL Eql TK_LBRACKET Then
	Begin
	If .OTYPE Eql S_LABEL Then
	    WARNEM(.pos_del,B11$_LABEL_SIZE);
	SAVMNACTS = .MANYACTS;
	MANYACTS  = FALSE;
	STRUPICKOFF(TK_RBRACKET,ptr_actuals[act_data(1)],
			.p[st_str_argc],TRUE);
	MANYACTS  = .SAVMNACTS;
	NOBRAC    = FALSE
	End
    Else

! no structure allocation expression explicitly given.  use the default.
!
! note: setting lex_type and lex_addr at the same time!

	Begin
	Incr I From 1 To .ptr_actuals[act_size] Do
	    ptr_actuals[act_data(.I)] = 0;
	NOBRAC = TRUE
	End;
    R = ptr_actuals[act_data(0)];
    R[lex_type] = T_LITERAL;
    R[lex_addr] = .DECLSIZE;
    If .p[st_str_alloc] Neq 0 Then
	Begin
	If .NOBRAC Then
	    SAVDEL = .DEL;
	V[act_data(0)] = 0;
	MoveCore(ptr_actuals[act_data(0)],V[act_data(1)],.p[st_str_argc]+1);
	s = struct_expand_struct(.p[st_str_alloc],v,.p);
	If .NOBRAC Then
	    DEL = .SAVDEL
	Else
	    RUNDE();
	SYM = BINDBIND(.S);
	If .SYM[gt_type] Neq T_LITERAL Then
	    Begin
	    WARNEM(.NSTART,B11$_WANT_CTCE);
	    unit_size = 1
	    End
	Else
	    unit_size = .SYM[gt_disp];
	FreeSym()
	End
    Else If Not .NOBRAC Then
	RUNDE();
    Return FALSE
End;

End
Eludom