Module Decl_plit =
Begin

Require 'bliss.req';

Own
	PLLBRAC		: Integer,
	PLHEAD		: Vector[8,Byte] Initial('P$AAA');

Forward Routine
	PLITARG;

Routine LSORLE =
Begin
    Local
	N		: Integer,
	P		: Ref GT;

    If .SYM[gt_type] Eql T_STRING Then
	N = (.SYM[tx_size] + 1) / 2
    Else
	Begin
	Case WHICHBIND() From 0 To 2 Of Set
	    [0]:
		Begin
		WARNEM(.pos_sym,B11$_WANT_LTCE);
		FreeSym();
		SYM = MakeLit(0)
		End;
	    [1]:
		0;
	    [2]:
		If .SYM[gt_type] Neq T_VARIABLE Or Not LOADCONST(SYM) Then
		    Begin
		    WARNEM(.pos_sym,B11$_WANT_LTCE);
		    FreeSym();
		    SYM = MakeLit(0)
		    End
	Tes;
	N = 2
	End;
    P = GETSPACE(SZ_PLIT);
    P[pl_type]  = T_PLIT;
    P[pl_count] = 1;
    P[pl_size]  = .N;
    P[pl_data]  = .SYM;
    Return .P
End;

! parse a plit item within '()'

Routine TUPLEITEM =
Begin
    Local
	N		: Integer,
	R		: Ref GT,
	pos		: Integer;

! check for replication factor

    POS = .pos_sym;
    If .SYM Neq NIL Or .DEL Neq TK_REP Then
	Return LSORLE();
    RUND(QL_LEXEME);
    N = Ctce();
    If .DEL Neq TK_OF Then
	Begin
	ERROR(.pos,.pos_del,0,B11$_MISSING_OF);
	Return 0
	End;
    R = PLITARG(R[pl_data]);
    R[pl_count] = .N;
    R[pl_size]  = .R[pl_size] * .N;
    Return .R
End;

Routine PLITARG =
Begin
    Local
	N		: Integer,
	SLBRAC		: Integer,
	SAVEL		: Integer,
	HEAD		: Ref GT,
	TAIL		: Ref GT,
	R		: Ref GT;

! skip over the word PLIT, telling RUND that strings are acceptable

    RUND(QL_STRING);

! if not a sub-list then it is just a simple expression

    If .SYM Neq NIL Or (.DEL Neq TK_CALL And .DEL Neq TK_LPAREN) Then
	Return LSORLE();

! setup for parsing a tuple

    savel = .lastend;
    lastend[PS_PAREN] = TRUE;
    lastend[PS_COMMA] = TRUE;
    SLBRAC  = .PLLBRAC;
    PLLBRAC = .pos_del;
    N   = 0;

! loop for all tuple elements

    HEAD = 0;
    Do
	Begin
	RUND(QL_STRING);
	R = TUPLEITEM();
	If .R Eqla 0 Then
	    Return 0;
	If .HEAD Eqla 0 Then
	    HEAD = .R
	Else
	    TAIL[pl_next] = .R;
	TAIL = .R;
	R = GETSPACE(SZ_PLIT);
	N = .N + .R[pl_size];
	End
    While .DEL Eql TK_COMMA; 
    lastend = .savel;
    HEAD[pl_size] = .N;

! check for closing ')'

    If .DEL Neq TK_RPAREN Then
	Begin
	ERROR(.PLLBRAC,.pos_del,0,B11$_MISSING_PAREN);
	Return 0
	End;

! skip the ')' and disallow any symbol after it.

    RUNDE();
    PLLBRAC = .SLBRAC;
    Return .HEAD
End;

! parse a plit expression

Global Routine SPLITB =
Begin
    Local
	HEAD		: Ref GT,
	SLBRAC		: Integer;

! save our context and note that we are in a plit to RUND

    SLBRAC   = .PLLBRAC;
    PLLBRAC  = .pos_del;
    flg_plit = TRUE;

! allocate the head of this plit and parse the plit expression

    HEAD = PLITARG();

! note the plit length in the head and return the head.

    PLLBRAC  = .SLBRAC;
    flg_plit = FALSE;
    Return .HEAD
End;

!
!    PLIT SYNTAX PROCESSING ROUTINES.  THE SYNTAX FOR PLITS IS AS
!  FOLLOWS:
!
!    <PLIT> ::= PLIT <PLITARG>
!    <PLITARG> ::= <LOAD TIME EXPRESSION> !
!                  <STRING> !
!                  <TUPLE>
!    <TUPLE> ::= (<TUPLE ITEM LIST>)
!    <TUPLE ITEM LIST> ::= <TUPLE ITEM> !
!                          <TUPLE ITEM>,<TUPLE ITEM LIST>
!    <TUPLE ITEM> ::= <LOAD TIME EXPRESSION> !
!                     <STRING> !
!                     <DUPLICATION FACTOR>:<PLITARG>
!    <DUPLICATION FACTOR> ::= <COMPILE TIME EXPRESSION>
!
!     [NOTE: <LOAD TIME EXPRESSION> ::= <PLIT> ! ...]
!

Global Routine decl_plit : Novalue =
Begin
    Macro MAKENEWNAME=
		PLHEAD[4] = .PLHEAD[4] + 1;
		If .PLHEAD[4] Gtr 'Z' Then
		    Begin
		    PLHEAD[4] = 'A';
		    PLHEAD[3] = .PLHEAD[3] + 1;
		    If .PLHEAD[3] Gtr 'Z' Then
			Begin
			PLHEAD[3] = 'A';
			PLHEAD[2] = .PLHEAD[2] + 1
			End
		    End %;
    Local
	S		: Ref ST,
	P		: Ref GT,
	ISCOUNTED	: Boolean;

! remember whether this is PLIT or UPLIT

    ISCOUNTED = (.DEL Eql TK_PLIT);

! generate a name for this plit

    MAKENEWNAME;

! make the plit a global (why global and not own?)

    S = STINSERT(SEARCH(PLHEAD),S_GLOBAL);

! now parse the plit value

    P = SPLITB();

! fill in the defaults for this plit symbol

    S[st_var_size]    = .P[pl_size] * 2;
    S[gt_pos]         = 0;
    S[gt_len]         = 16;
    S[st_v_no_acts]   = TRUE;
    S[st_var_linkage] = .sym_linkage;
    S[st_var_actuals] = .sym_vector;

! note that this is a plit and whether it is counted

    S[st_v_plit]    = TRUE;
    S[st_v_counted] = .ISCOUNTED;

! assign the value to the symbol and give it an address

    DEFGLO(.S,TRUE,TRUE,.P);
    SYM = .S
End;

End
Eludom