/*
*****************************************************************************
*									    *
*  Copyright (c) 1978, 1993	                                            *
*  by DIGITAL Equipment Corporation, Maynard, Mass.			    *
* 									    *
*  This software is furnished under a license and may be used and  copied   *
*  only  in  accordance  with  the  terms  of  such  license and with the   *
*  inclusion of the above copyright notice.  This software or  any  other   *
*  copies  thereof may not be provided or otherwise made available to any   *
*  other person.  No title to and ownership of  the  software  is  hereby   *
*  transferred.							 	    *
* 									    *
*  The information in this software is subject to change  without  notice   *
*  and  should  not  be  construed  as  a commitment by DIGITAL Equipment   *
*  Corporation.							   	    *
* 									    *
*  DIGITAL assumes no responsibility for the use or  reliability  of  its   *
*  software on equipment which is not supplied by DIGITAL.		    *
*									    *
*****************************************************************************

facility:

	SDL (Structure Definition Language)


author:
	Paul A. Calato

*/

/*			C H A N G E    L O G

      Date	! Name	! Description
________________!_______!______________________________________________________
   		!  	! 					
    23-Nov-1985	|  pc	| Adding copyright header and change log.
________________!_______!______________________________________________________
    17-Jun-1986	|  pc	| Adding BASIC$ to QUADWORD and OCTAWORD.
________________!_______!______________________________________________________
     9-Apr-1987	|  jw	| X3.1-0  Added BASIC$F_, BASIC$D_, BASIC$G_ and
		|	|	  BASIC$H_FLOATING COMPLEX data types.
________________!_______!______________________________________________________
     1-Feb-1988	|  jg	| X3.2-0  User defined types
________________!_______!______________________________________________________
    30-Sep-1993	|  pjh  | X3.?-?  Added INTEGER*, POINTER*, and HARDWARE*, as 
                |       |         well as added a BASIC$H_FLOATING_COMPLEX_AXP
________________!_______!______________________________________________________
    01-OCT-1993 |  bjm  | V3.?-?+1 Use a global to pass bitfield for alpha
________________!_______!______________________________________________________
*/


/****************************************************************/
/*								*/
/* GET_TYPE get the type of an item and puts it in a buffer	*/
/*								*/
/****************************************************************/

get_type: proc(cur_node, typ_buf);

					    /********************/
					    /*			*/
					    /* GET_TYPE		*/
					    /*			*/
					    /********************/
%include 'sdl$library:sdlnodef.in';
%include 'sdl$library:sdltypdef.in';
%include 'sdl$library:sdlshr.in';

/* decalre variables */
declare
    alpha_opt bit (1) aligned globalref,

    cur_node pointer,			    /* pointer to the current node  */
    typ_buf char(*) var;		    /* buffer to put the type in    */

/* declare external routines */


/* implement a case statement with goto's (yuc)		    */
/* depending on the item's data type goto a particular case */

    goto case(cur_node->nod$w_datatype);

	CASE(TYP$k_BYTE):
	    typ_buf = 'BYTE';
	    goto END_CASE;

	CASE(TYP$k_WORD):
	    typ_buf = 'WORD';
	    goto END_CASE;

	CASE(TYP$k_LONGWORD):
	    typ_buf = 'LONG';
	    goto END_CASE;

	CASE(TYP$k_QUADWORD):
	    typ_buf = 'BASIC$QUADWORD';
	    goto END_CASE;

	CASE(TYP$k_OCTAWORD):
	    typ_buf = 'BASIC$OCTAWORD';
	    goto END_CASE;

	CASE(TYP$k_FLOAT):
	    typ_buf = 'SINGLE';
	    goto END_CASE;

	CASE(TYP$k_DOUBLE):
	    typ_buf = 'DOUBLE';
	    goto END_CASE;

	CASE(TYP$k_GRAND):
	    typ_buf = 'GFLOAT';
	    goto END_CASE;

	CASE(TYP$k_HUGE):
             if alpha_opt then
                typ_buf = 'BASIC$HFLOAT_AXP';
             else
                typ_buf = 'HFLOAT';
	    goto END_CASE;

	CASE(TYP$k_FLOAT_COMPLEX):
	    typ_buf = 'BASIC$F_FLOATING_COMPLEX';
	    goto END_CASE;

	CASE(TYP$k_DOUBLE_COMPLEX):
	    typ_buf = 'BASIC$D_FLOATING_COMPLEX';
	    goto END_CASE;

	CASE(TYP$k_GRAND_COMPLEX):
	    typ_buf = 'BASIC$G_FLOATING_COMPLEX';
	    goto END_CASE;

	CASE(TYP$k_HUGE_COMPLEX):
             if alpha_opt then
                typ_buf = 'BASIC$H_FLOATING_COMPLEX_AXP';
             else
        	typ_buf = 'BASIC$H_FLOATING_COMPLEX';
	    goto END_CASE;

	CASE(TYP$k_DECIMAL):
	    typ_buf = 'DECIMAL (' || trim(cur_node->nod$l_typeinfo) ||
		       ',' || trim(cur_node->nod$l_typeinfo2) || ')';
	    goto END_CASE;

	case(TYP$K_BOOLEAN): 
	    typ_buf = 'BYTE';
	    goto END_CASE;

	case(TYP$K_VIELD):
 /*************** TEMPERARY FIX FOR BITS ******************/

	    if( cur_node->nod$l_fldsiz >= 1 & cur_node->nod$l_fldsiz <= 8 )
	    then
		typ_buf = 'BYTE';
	    else
	    if( cur_node->nod$l_fldsiz > 9 & cur_node->nod$l_fldsiz <= 16 )
	    then
		typ_buf = 'WORD';
	    else
	    if( cur_node->nod$l_fldsiz > 16  & cur_node->nod$l_fldsiz <= 32)
	    then
		typ_buf = 'LONG';
	    else do;
		/* calculate byte array */
		typ_buf = 'BYTE(' || trim(ceil(cur_node->nod$l_fldsiz/8) )  || ')';
	    end;

	    goto END_CASE;


	case(TYP$K_CHAR):
	    typ_buf = 'STRING';
	    goto END_CASE;

	case(TYP$K_ANY):
	    typ_buf = 'ANY';
	    goto END_CASE;

	case(TYP$K_ADDRESS):
	    typ_buf = 'LONG';
	    goto END_CASE;

	case(TYP$K_UNION): ;
	case(TYP$K_STRUCTURE):
	    typ_buf = cur_node->nod$a_typeinfo2->nod$t_name;
	    goto END_CASE;

	case(TYP$K_USER):
	    typ_buf = cur_node->nod$a_typeinfo2->nod$a_flink->nod$t_name;
	    goto END_CASE;


        case(TYP$K_INTEGER_BYTE):
	    typ_buf = 'BYTE';
	    goto END_CASE;

        case(TYP$K_INTEGER_WORD):
	    typ_buf = 'WORD';
	    goto END_CASE;

        case(TYP$K_INTEGER): ;
        case(TYP$K_INTEGER_LONG): ;
        case(TYP$K_POINTER): ;
        case(TYP$K_POINTER_LONG):
	    typ_buf = 'LONG';
	    goto END_CASE;

        case(TYP$K_INTEGER_QUAD): ;
        case(TYP$K_POINTER_QUAD):
	    typ_buf = 'BASIC$QUADWORD';
	    goto END_CASE;

        case(TYP$K_INTEGER_HW): ;
        case(TYP$K_POINTER_HW): ;
        case(TYP$K_HARDWARE_INTEGER): ;
        case(TYP$K_HARDWARE_ADDRESS):
             if alpha_opt then
                typ_buf = 'BASIC$QUADWORD';
             else
        	typ_buf = 'LONG';
	    goto END_CASE;

	END_CASE:

end get_type;