Module decl_routine =
Begin

Require 'bliss.req';

Global Routine PROCPARMS(RNAME : Ref ST)=
Begin
    Own
	PCPS		: Vector[2,Long] Preset(
				[0] = AZ('OLDPC'),
				[1] = AZ('OLDPS'));
    Local
	T		: Ref ST,
	LNKG		: Ref ST,
	LNKT		: Ref ST,
	FORMAL		: Ref ST Alias,
	FT,FL,FNO,LSF;
    Label
	aaa;

    LSF = 0;
    FNO = 0;
    LNKG = .RNAME[st_var_linkage];
    LNKT = .LNKG[st_lnk_type];
    LNKG = .LNKG[st_lnk_desc];
    RNAME[st_var_reg_list] = MAKHDR(PARAMREMOVE,PARAMENTER);

! if parameters...

    If .DEL Eql TK_CALL Then
	Begin

! loop for each parameter

	While .DEL Neq TK_RPAREN Do
	    aaa: Begin

! get and declare the parameter name

	    RUND(QL_NAME);
	    If Not DECLARESYM(FORMAL,S_FORMAL,0) Then
		Leave aaa;
	    FORMAL[st_var_size]    = 2;
	    FORMAL[gt_pos]         = 0;
	    FORMAL[gt_len]         = 16;
	    FORMAL[st_var_linkage] = .sym_linkage;
	    FORMAL[st_var_actuals] = .sym_vector;
	    FORMAL[st_v_no_acts]   = TRUE;

! get the formal parameter descriptor from the linkage and declare
! the formal as described.

	    FNO = .FNO + 1;
	    If .FNO Gtr .LNKG[parm_size] Then
		FT = PARM_STACK
	    Else
		Begin
		FT = .LNKG[parm_type(.FNO)];
		FL = .LNKG[parm_loc(.FNO)]
		End;
	    If .FT Eql PARM_STACK Then
		Begin
		FORMAL[gt_disp] = .LSF;
		FORMAL[gt_reg]  = SP;
		FORMAL[gt_mode] = INDEXED;
		LSF = .FORMAL;
		End
	    Else
		Begin
		FORMAL[gt_mode]          = GENREG;
		FORMAL[st_var_reg_index] = .FL;
		T = FORMAL[gt_reg] = GETTN();
		T[tn_depth]  = .LOOPDEPTH;
		T[tn_lon_fu] = 1;
		T[tn_lon_lu] = 1;
		T[tn_fon_fu] = 1;
		T[tn_fon_lu] = 1;  ! SPAN MUST START AT 1
		ENLST(.RNAME[st_var_reg_list],MAKITEM(.FL^32+.FORMAL))
		End;

! up-level references for formals not allowed

	    FORMAL[st_v_nouplevel] = TRUE;
	    If .DEL Neq TK_RPAREN And .DEL Neq TK_COMMA Then
		Begin
		ERROR(.pos_open,.pos_del,0,B11$_MISSING_COMMA);
		Return 0
		End;
	    INITSYMLSTS(.FORMAL)
	    End
	End;

! for trap-type linkages, declare as the first two parameters the
! symbols OLDPS and OLDPC.

    If ONEOF(.LNKT,LNK_EMT,LNK_INTERRUPT,LNK_TRAP,LNK_IOT) Then
	Begin
	Local
	    SSYM;

	SSYM = .SYM;
	Decr I From 1 To 0 Do
	    Begin
	    SYM = SEARCH(.PCPS[.I]);
	    DECLARESYM(FORMAL,S_FORMAL,0);
	    FORMAL[st_var_size]    = 2;
	    FORMAL[gt_pos]         = 0;
	    FORMAL[gt_len]         = 16;
	    FORMAL[st_var_linkage] = .sym_linkage;
	    FORMAL[st_var_actuals] = .sym_vector;
	    FORMAL[st_v_no_acts]   = 1;
	    FORMAL[gt_disp]        = .LSF;
	    FORMAL[gt_reg]         = SP;
	    FORMAL[gt_mode]        = INDEXED;
	    LSF = .FORMAL
	    End;
	SYM = .SSYM;
	FNO = -2
	End
    Else
	FNO = 0;
    While .LSF Neqa 0 Do
	Begin
	FORMAL = .LSF;
	LSF = .FORMAL[gt_disp];
	FORMAL[gt_disp] = FNO = .FNO+2
	End;
    If .DEL Eql TK_RPAREN Then
	RUNDE();
    Return TRUE
End;

Routine do_routine(type : Integer,mode : Integer) : Novalue =
Begin
    Local
	S		: Ref ST,
	LNKGNM		: Ref ST;

    Do
	Begin
	RUND(QL_NAME);
	LNKGNM = GETLNKG();
	S = .SYM[nt_symb];
	If .S Neq 0 And .S[st_scope] Eql .level_block
			And .S[st_code] Eql S_FORWARD Then
	    Begin
	    S[st_code]    = .type;
	    S[st_v_debug] = .swit_debug
	    End
	Else
	    Begin
	    If Not DECLARESYM(S,.type,TRUE) Then
		Return;
	    S[gt_pos] = 0;
	    S[gt_len] = 16
	    End;
	S[st_v_no_acts]   = TRUE;
	S[st_var_actuals] = .sym_vector;
	S[st_var_linkage] = .LNKGNM;
	S[gt_reg]         = PC;
	S[gt_mode]        = .mode;
	RNAMEFOLLOWS(.S)
	End
    While .DEL Eql TK_COMMA

End;

Global Routine decl_gbl_routine : Novalue =
Begin
    do_routine(S_GBL_ROUTINE,ABSOLUTE)
End;

Global Routine decl_routine : Novalue =
Begin
   do_routine(S_ROUTINE,(If .swit_pic Then RELATIVE Else ABSOLUTE))
End;

End
Eludom