hla.hhf

High Level assembly language(HLA)软件

		?@global:hla._valid_ := true;		

		// Okay, determine if the caller supplied a field width
		// value with this parameter.
		
		
		?@global:hla._fieldCnt_ := @elements( @global:hla._parmArray_ );
		?@global:hla._width_ := "-1";		// Default width value.
		?@global:hla._decpts_ := "-1";		// Default fractional value.
		?@global:hla._sizeParms_ := "";		// Assume no size parameter(s)
		?@global:hla._typename_	 := @global:hla.ptypeStrs[ @global:hla._pType_ ];
		?@global:hla._valid_ := true;		
		
		#if( @global:hla._fieldCnt_ = 1 )
		
			#if( !_package_.validPutType[ @global:hla._pType_ ] )
			
				?@global:hla._valid_ := false;		
				#error( "This output type is not supported" )
				
			#else
			
				?@global:hla._func_	:string := 
					@global:hla._prefix_ + 
						_package_.putFunc[ @global:hla._pType_ ];
						
			#endif
			
		
		#elseif( @global:hla._fieldCnt_ = 2 )

			#if( !_package_.validPutSizeType[ @global:hla._pType_ ] )
			
				?@global:hla._valid_ := false;		
				#error( "This type does not support an output width" )
				
			#else
				
				?@global:hla._func_	:string := 
					@global:hla._prefix_ + 
						_package_.putSizeFunc[ @global:hla._pType_ ];

				?@global:hla._width_ := @trim( @global:hla._parmArray_[ 1 ], 0 );
				?@global:hla._sizeParms_ := "," + @global:hla._width_ + ",' '";
				
			#endif

		#elseif( @global:hla._fieldCnt_ = 3 )

			// Determine if the user supplied a fractional width
			// value with this parameter.
	

			#if( !_package_.validPutSize2Type[ @global:hla._pType_ ] )
			
				?@global:hla._valid_ := false;		
				#error
				( 
					"This type does not support a second (decpts) output width" 
				)
				
			#else
			
				?@global:hla._func_	:string := 
					@global:hla._prefix_ + 
						_package_.putSize2Func[ @global:hla._pType_ ];

				?@global:hla._width_ := @trim( @global:hla._parmArray_[ 1 ], 0 );
				?@global:hla._decpts_ := @trim( @global:hla._parmArray_[ 2 ], 0 );
				?@global:hla._sizeParms_:string := 
										"," 
									+	@global:hla._width_ 
									+	"," 
									+	@global:hla._decpts_
									+	", ' '";
						
			#endif

		#else

			?@global:hla._valid_ := false;		
			#error
			( 
				"<<" + _parameter_[0] + ">>" +
				" has too many width fields" 
			);

		#endif

		// Based on the type, call the appropriate library
		// routine to print this value.

		?@global:hla._valid_ := 
				@global:hla._valid_
			&	(
						(
								@global:hla._pType_ >= @global:hla.ptBoolean 
							&	@global:hla._pType_ <= @global:hla.ptPointer
						)
					|	@global:hla._pType_ = @global:hla.ptClass
				);
			

		#if( @global:hla._valid_ )	

			#if( @global:hla._pType_ = @global:hla.ptClass )
			
				#if( @defined( @text(@global:hla._arg_ + ".a_toString")))
				
					push( esi );
					push( edi );
					push( eax );
					
					@text( @global:hla._arg_ + ".a_toString();" )
					@text
					(
						@global:hla._prefix_ + 
						_package_.putFunc[ @global:hla.ptString ]
						+ "("
							#if( _dest_ <> "" )
								+ _dest_ +","
							#endif 
							"(type string eax)" +
						");"
					)
					str.free( eax );
					pop( eax );
					pop( edi );
					pop( esi );
				
				#else
				
					#error( "Class does not have an 'a_toString' method/procedure" );
					
				#endif
				
			#elseif
			( 
					@isconst( @text( @global:hla._arg_ )) 
				&	@global:hla._typename_ = "string"
				&	@global:hla._arg_ = "#13 #10"
				&	@defined( @text( @global:hla._prefix_ + "newln" ))
			)
				@text( @global:hla._prefix_ + "newln" )
				(
					#if( _dest_ <> "" )
						@text( _dest_ )
					#endif 
				);

			#elseif( @isconst( @text( @global:hla._arg_ )) )

				@text( @global:hla._func_ )
				(
					#if( _dest_ <> "" )
						@text( _dest_ ),
					#endif 
					@text( @global:hla._arg_ ) 
					@text( @global:hla._sizeParms_ )
				);

			#else


				@text
				(
					@global:hla._func_
					+ "("
						#if( _dest_ <> "" )
							+ _dest_ +","
						#endif 
						"(type " + @global:hla._typename_ + 
						" " + @global:hla._arg_ +
						" )" + 
						@global:hla._sizeParms_ +
					");"
				)
			

			#endif
			

		#else

			#error
			(
				@string:_package_ + 
				".put: Unknown data type "
				nl
				"(" +
				_parameter_[0] +
				" is type """ +
				@typename( @text( @global:hla._id_ )) +
				""")"
			);

		#endif

	#endmacro
	
	
	///////////////////////////////////////////////////////////////////////////////
	//
	// Macros used to handle overloaded procedures
	//
	// 
	// #macro overloadingName( parms[] );
	//
	//		overload( parms )
	//
	//			signature( procname1( int32) );
	//			signature( procname2( int32, int32 ) );
	//			signature( procname1s( string ) );
	//
	//		endoverload;
	//
	// #endmacro
	
	
	// Internal use only!
				
	val
		_ps_parameters	:string := "";
		_ps_parmArray	:string;
		_ps_procName	:string := "";
		_junk_			:string;
		_ovld_count		:uns32;
		_ovld_index		:uns32;
		_ovld_curSig	:string;
		_ovld_matched	:boolean;
		_ovld_parmStr	:string;
		_ptypeFormal	:byte;
		_ptypeActual	:byte;
		_typeStr		:string;
	
	// Internal use only!
		
	#macro _parseSignature_( string _parm_ );
	
		#if
		( 
			@uptoChar
			( 
				_parm_, 
				'(', 
				@global:hla._ps_parameters, 
				@global:hla._ps_procName 
			)
		)
			// Strip the leading '(' char:
			
			?@global:hla._ps_parameters :=
				@substr
				( 
					@global:hla._ps_parameters, 
					1, 
					@length(@global:hla._ps_parameters)-1 
				);
			
			// Ensure we have a trailing ')' char:
				
			#if
			(
				@upToChar
				(
					@global:hla._ps_parameters,
					')',
					@global:hla._junk_,
					@global:hla._ps_parameters
				)
			)
				// Return an array of strings with the last element
				// containing the name of the procedure and the remaining
				// elements containing the type signatures.
				
				?@global:hla._ps_parmArray := 
					@tokenize( @global:hla._ps_parameters, 0, {" ,"}, {} );

				[
					#if
					( 
							@elements(@global:hla._ps_parmArray) <> 1
						|	@global:hla._ps_parmArray[0] <> "" 
					)
						@global:hla._ps_parmArray,
					#endif
					@global:hla._ps_procName
				]
				
			#else
			
				#error( "Ill-formed signature, expected ')'" )
				[
					@global:hla._ps_procName
				]
				
			#endif
			
		#else
				
				#error( "Ill-formed signature, expected '('" )
				[
					""
				]
				
		#endif
		
	#endmacro
	
	
	// This is the macro to be used inside a user-written macro
	// to overload a bunch of different procedure names with
	// the user-written macro.
	//
	// Usage:
	//
	//	overload( <parms passed to user-written macro> )
	//
	//		signature( usrProc1( <list of zero or more HLA types> ))
	//		signature( usrProc2( <list of zero or more HLA types> ))
	//		signature( usrProc3( <list of zero or more HLA types> ))
	//		etc.
	//
	//	endoverload
	//
	// The above invocation template would generate code to match
	// the user-supplied parameter list against one of the signatures
	// and make a call to the matching function.
	//
	// Example:
	//
	//	const
	//		i:int32 := -1;
	//		k:uns32 :=  2;
	//		s:string := "";
	//		
	//	const
	//
	//	#macro proc1( __i );
	//		#print( "int32=", __i )
	//	#endmacro
	//
	//	#macro proc2( __i, __j );
	//		#print( "int32=", __i, " uns32=", __j )
	//	#endmacro
	//
	//	#macro proc3( _dummy[] );
	//		#print( "Invoked proc3" )
	//	#endmacro
	//
	//		
	//	#macro somename( parms[] );
	//
	//		hla.overload( parms )
	//		
	//			hla.signature( proc1( int32 ))
	//			hla.signature( proc2( int32, uns32))
	//			hla.signature( proc3() )
	//			
	//		hla.endoverload
	//		
	//	#endmacro
	//
	//	somename( i );
	//	somename( i, k );
	//	somename( );

				
		// The following table maps ptypes for the unsigned, hex, and
		// signed integer types from an actual type to a promoted type.
		//
		// The mapping is done as follows:
		//
		//	1.	Take a constant's ptype value (this only works for constants!)
		//
		//	2.	Take the formal parameter's ptype.
		//
		//	3.	if both ptypes are in the range ptBoolean..ptString, then
		//		subtract ptBoolean from both values.
		//	3a.	The entry _ovld_const_type_promotion[ actual, formal]
		//		produces the promoted ptype, which is used as the actual type.
		//
		//	4.	If either ptype is not in the range ptBoolean..ptString,
		//		then just use the original types. (Note: the ptPointer type
		//		is handled as a special case to reduce the size of the
		//		following table). 
		 
		_ovld_const_type_promotion:
			uns8[ 25, 25 ] :=	//[actualconst, formalType] 
			[
				ptBoolean, ptBoolean,							// Boolean->
				ptBoolean, ptBoolean, ptBoolean, ptBoolean, ptBoolean,
				ptByte, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptBoolean, ptBoolean, ptBoolean, ptBoolean, ptBoolean,
				ptBoolean, ptBoolean,
				ptBoolean, ptBoolean, ptBoolean, ptBoolean, 
				ptBoolean,
				
				ptEnum, ptEnum,									// Enum->
				ptEnum, ptEnum, ptEnum, ptEnum, ptEnum,
				ptByte, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptEnum, ptEnum, ptEnum, ptEnum, ptEnum,
				ptEnum, ptEnum,
				ptEnum, ptEnum, ptEnum, ptEnum, 
				ptEnum,
				
				ptUns8, ptUns8,
				ptUns8, ptUns16, ptUns32, ptUns64, ptUns128,	// Uns8->
				ptByte, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptUns8, ptUns16, ptUns32, ptUns64, ptUns128,
				ptUns8, ptUns8,
				ptReal32, ptReal64, ptReal80, ptUns8,
				ptUns8,
				
				ptUns16, ptUns16, 
				ptUns16, ptUns16, ptUns32, ptUns64, ptUns128,	// Uns16->
				ptWord, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptUns16, ptUns16, ptUns32, ptUns64, ptUns128,
				ptUns16, ptUns16, 
				ptReal32, ptReal64, ptReal80, ptUns16,
				ptUns16,
				
				ptUns32, ptUns32, 
				ptUns32, ptUns32, ptUns32, ptUns64, ptUns128,	// Uns32->
				ptDWord, ptDWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptUns32, ptUns32, ptUns32, ptUns64, ptUns128,
				ptUns32, ptUns32, 
				ptReal32, ptReal64, ptReal80, ptUns32,
				ptUns32,
				
				ptUns64, ptUns64, 
				ptUns64, ptUns64, ptUns64, ptUns64, ptUns128,	// Uns64->
				ptQWord, ptQWord, ptQWord, ptQWord, ptTByte, ptLWord,
				ptUns64, ptUns64, ptUns64, ptUns64, ptUns128,
				ptUns64, ptUns64, 
				ptReal32, ptReal64, ptReal80, ptUns64,
				ptUns64,
				
				ptUns128, ptUns128, 
				ptUns128, ptUns128, ptUns128, ptUns128, ptUns128,	// Uns128->
				ptLWord, ptLWord, ptLWord, ptLWord, ptLWord, ptLWord,
				ptUns128, ptUns128, ptUns128, ptUns128, ptUns128, 
				ptUns128, ptUns128, 
				ptReal32, ptReal64, ptReal80, ptUns128,	
				ptUns128,
								
				
				
				ptBoolean, ptEnum, 
				ptUns8, ptUns16, ptUns32, ptUns64, ptUns128,	// Byte->
				ptByte, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptInt8, ptInt16, ptInt32, ptInt64, ptInt128,
				ptChar, ptByte,
				ptReal32, ptReal64, ptReal80, ptByte,
				ptByte,

				
				ptWord, ptWord, 
				ptUns16, ptUns16, ptUns32, ptUns64, ptUns128,	// Word->
				ptWord, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptInt16, ptInt16, ptInt32, ptInt64, ptInt128,
				ptWord, ptWChar,
				ptReal32, ptReal64, ptReal80, ptWord,
				ptWord,

				
				ptDWord, ptDWord, 
				ptUns32, ptUns32, ptUns32, ptUns64, ptUns128,	// DWord->
				ptDWord, ptDWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptInt32, ptInt32, ptInt32, ptInt64, ptInt128,
				ptDWord, ptDWord, 
				ptReal32, ptReal64, ptReal80, ptDWord,
				ptString,

				
				ptQWord, ptQWord, 
				ptUns64, ptUns64, ptUns64, ptUns64, ptUns128,	// QWord->
				ptQWord, ptQWord, ptQWord, ptQWord, ptTByte, ptLWord,
				ptInt64, ptInt64, ptInt64, ptInt64, ptInt128,
				ptQWord, ptQWord, 
				ptReal32, ptReal64, ptReal80, ptQWord,
				ptQWord,
				
				ptTByte, ptTByte, 
				ptTByte, ptTByte, ptTByte, ptTByte, ptUns128,	// TByte->
				ptTByte, ptTByte, ptTByte, ptTByte, ptTByte, ptLWord,
				ptTByte, ptTByte, ptTByte, ptTByte, ptInt128,
				ptTByte, ptTByte, 
				ptReal32, ptReal64, ptReal80, ptTByte,
				ptTByte,
				
				ptLWord, ptLWord, 
				ptUns128, ptUns128, ptUns128, ptUns128, ptUns128,	// LWord->
				ptLWord, ptLWord, ptLWord, ptLWord, ptLWord, ptLWord,
				ptInt128, ptInt128, ptInt128, ptInt128, ptInt128,
				ptLWord, ptLWord, 
				ptReal32, ptReal64, ptReal80, ptLWord,
				ptLWord,

														  
										
														  
				ptInt8, ptInt8, 
				ptInt8, ptInt16, ptInt32, ptInt64, ptInt128,	// Int8->
				ptByte, ptWord, ptDWord, ptQWord, ptTByte, ptLWord,
				ptInt8, ptInt16, ptInt32, ptInt64, ptInt128,
				ptInt8, ptInt8, 
				ptReal32, ptReal64, ptReal80, ptInt8,
				ptInt8,