Module decl_linkage =
Begin

Require 'bliss.req';

Global Routine decl_linkage : Novalue =
Begin
    Literal
	MAX_PARAM	= 30;
    Local
	S		: Ref ST,
	T		: Ref ST,
	LP		: Ref ST,
	P		: Vector[MAX_PARAM],
	N		: Integer,
	LT		: Integer,
	K		: Integer,
	SAVENME		: Ref ST;
    Macro
	RERR(EN)=
		Begin
		ERROR(.pos_open,.pos_sym,0,(EN));
		Return
		End %;
    Macro
	RERRD(EN)=
		Begin
		ERROR(.pos_open,.pos_sym,PS_PAREN,(EN));
		Exitloop
		End %;

! loop for each linkage to declare

    Do
	Begin

! get the linkage name

	N = 0;
	RUND(QL_NAME);
	SAVENME = .SYM;
	If Not DECLARESYM(S,S_LINKAGE,TRUE) Then
	    Return;

! look for a '=' followed by the linkage type name

	If .DEL Neq TK_EQUAL Then
	    RERR(B11$_MISSING_EQUAL);
	RUND(QL_LEXEME);
	If .SYM[gt_type] Neq T_VARIABLE Then
	    RERR(B11$_MISSING_LINKAGE);
	If .SYM[st_code] Neq S_LINKAGE Then
	    RERR(B11$_MISSING_LINKAGE);
	t = .SYM[gt_disp];
	FreeSym();
	LT = .t[st_lnk_type];

! if this is a redeclaration of the BLISS linkage, note it.

	If .SAVENME Eql .sym_bliss[st_name] Then
	    sym_bliss = .S;

! if there is a description of the arguments...

	If .DEL Eql TK_CALL Then

! loop for each argument

	    While TRUE Do
		Begin

! bump the count and check for too many parameters

		N = .N + 1;
		If .N Gtr MAX_PARAM Then
		    RERRD(B11$_TOO_MANY_PARAMS);

! get the parameter type.

		RUND(QL_NAME);

! if 'REGISTER=ctce'

		K = PARM_STACK ^ 32;
		If .SYM Eqla NIL Then
		    Begin
		    If .DEL Neq TK_REGISTER Then
			RERRD(B11$_INVALID_LINKAGE_PARAM);
		    RUND(QL_LEXEME);
		    If .DEL Neq TK_EQUAL Then
			RERRD(B11$_MISSING_EQUAL);
		    RUND(QL_LEXEME);
		    SYM = BINDBIND(.SYM);
		    K = .SYM[gt_disp];
		    If .SYM[gt_type] Neq T_LITERAL Or .K Gtru 6 Then
			Begin
			WARNEM(.pos_sym,B11$_INVALID_REGISTER);
			K = 1
			End;
		    FreeSym();
		    K = (PARM_REGISTER ^ 32) + .K
		    End

! if not 'STACK'

		Else If .sym Neqa .sym_stack Then
		    RERRD(B11$_INVALID_LINKAGE_PARAM);
		P[.N] = .K;
		If .DEL Eql TK_RPAREN Then
		    Begin
		    RUND(QL_LEXEME);
		    Exitloop
		    End;
		If .DEL Neq TK_COMMA Then
		    RERRD(B11$_MISSING_PAREN)
		End;

! save the parameters

	LP = GETSPACE(.N+1);
	LP[parm_size] = .N;
	MoveCore(.P,LP[parm_data(0)],.N);
	S[st_lnk_type] = .LT;
	S[st_lnk_desc] = .LP
	End
    Until .DEL Neq TK_COMMA
End;

End
Eludom