Module Expand =
Begin

Require 'Bliss.req';

Macro
    INITNS =
		Local SAVT,SAVOD,SAVSTCP,SAVMACP;
		SAVT     = .mac_v_trace;
		SAVOD    = .OLDDEL;
		SAVSTCP  = .flg_struct_body;
		SAVMACP  = .flg_macro_body;
		If .mac_v_trace Then
		    trace_append(.mac_mode);
		mac_v_trace = FALSE;
		flg_struct_body   = FALSE;
		flg_macro_body   = FALSE;
		SCANFOR(FALSE,QL_LEXEME);
		OLDDELI  = ','  %,
    WINDUPNS =
		mac_v_trace = .SAVT;
		OLDDEL   = .SAVOD;
		flg_struct_body   = .SAVSTCP;
		flg_macro_body   = .SAVMACP %;

! get a string for $NAME or $STRING

Routine GETSTRING(BUFF : Ref Vector[,Byte]) =
Begin
    Local
	N		: Integer,
	K		: Integer,
	M		: Integer,
	S		: Ref Vector[,Byte],
	TEMP		: Vector[16,Byte];

    N = 0;
    Do
	Begin
	Rund(QL_STRING);
	If .DEL Neq TK_COMMA And .DEL Neq TK_RPAREN Then
	    Begin
	    ERROR(.pos_del,.pos_del,PS_PAREN,B11$_MISSING_PAREN);
	    Return -1
	    End;
	SYM = BINDBIND(.SYM);
	Case .SYM[gt_type] From 0 To T_STRING Of Set
	    [Inrange,Outrange]:
		Begin
		WARNEM(.pos_sym,B11$_WANT_LITERAL);
		K = 0;
		S = 0
		End;

	    [T_DELIMITER]:
		Begin
		K = 0;
		S = 0
		End;

	    [T_LITERAL]:
		Begin
		M = .SYM[gt_disp];
		temp[0] = .M<15,1> + '0';
		temp[1] = .M<12,3> + '0';
		temp[2] = .M< 9,3> + '0';
		temp[3] = .M< 6,3> + '0';
		temp[4] = .M< 3,3> + '0';
		temp[5] = .M< 0,3> + '0';
		K = 6;
		S = temp
		End;

	    [T_VARIABLE]:
		Begin
		S = Block[.Block[.SYM[gt_disp],st_name],nt_data];
		K = strlen(.s)
		End;

	    [T_STRING]:
		Begin
		S = SYM[tx_data];
		K = .SYM[tx_size]
		End
	Tes;
	ch$move(.K,.S,BUFF[.N]);
	N = .N + .K
	End
    While .DEL Eql TK_COMMA;
    Return .N
End;

Global Routine lex_quote(S : Ref ST) : Novalue =
Begin
    Case .S[st_which] From 0 To 2 Of Set
	[0]:
	    flg_quoted = TRUE;
	[1]:
	    flg_unquote = TRUE;
	[2]:
	    flg_expand = TRUE
    Tes
End;

Routine SFASCII(LEX : Ref GT) : Novalue =
Begin
    PushLexeme(T_STRING,.LEX,0)
End;

Routine SFASCIZ(LEX : Ref GT) : Novalue =
Begin
    Local
	S		: Ref GT;

    S = SAVESTRING(LEX[tx_data],.LEX[tx_size]+1);
    (S[tx_data]+.LEX[tx_size])<0,8> = 0;
    FREESTRING(.LEX);
    PushLexeme(T_STRING,.S,0)
End;

Routine SFNAME : Novalue =
Begin
    Local
	BUFF		: Vector[1024,Byte],
	N		: Integer,
	S		: Ref GT;

    INITNS;
    N = GETSTRING(BUFF);
    WINDUPNS;
    If .N Leq 0 Then
	Return;
    BUFF[.N] = 0;
    Incr I From 0 To .N-1 Do
	If .BUFF[.I] Geq 'a' And .BUFF[.I] Leq 'z' Then
	    BUFF[.I] = .BUFF[.I] - 32;
    S = SEARCH(BUFF);
    If .s[nt_code] Neq 0 Then
	PushLexeme(T_DELIMITER,0,s[nt_code])
    Else
	PushLexeme(T_NAME,.S,0)
End;

Routine SFSTRING : Novalue =
Begin
    Local
	BUFF		: Vector[1024,Byte],
	N		: Integer;

    INITNS;
    N = GETSTRING(BUFF);
    WINDUPNS;
    If .N Geq 0 Then
	PushLexeme(T_STRING,SAVESTRING(BUFF,.N),0)
End;

Routine SFCOUNT : Novalue =
Begin
    Local
	N		: Integer;

    If .mac_mode Eql MAC_RECURSIVE Then
	N = .mac_name[st_mac_depth]
    Else
	N = .mac_iteration;
    PushLexeme(T_LITERAL,.N,0)
End;

Routine SFLENGTH : Novalue =
Begin
    PushLexeme(T_LITERAL,.mac_length,0)
End;

Global Routine lex_function(S : Ref ST,QUOTELEVEL) : Novalue =
Begin

! ACTUAL BODY OF SFCONVERT

    Own
	SPECF	: Vector[8,Long] Preset(
			[0] = SFASCII,
			[1] = SFASCIZ,
			[4] = SFNAME,
			[5] = SFSTRING,
			[6] = SFCOUNT,
			[7] = SFLENGTH);

    If .S[st_which] Leq 2 Then		! STRING CONVERSIONS
	Begin
	SCANFOR(TRUE,QL_STRING);
	If .SYM[gt_type] Neq T_STRING Then
	    Begin
	    WARNEM(.pos_sym,B11$_MISSING_STRING);
	    Return
	    End
	End;
    Bliss(.SPECF[.S[st_which]],.SYM);
End;

Global Routine lex_conditional(S : Ref ST) : Novalue =
Begin
    0
End;

End
Eludom