fortran.ssl

开放源码的编译器open watcom 1.6.0版的源代码

	      | *:
		>>
	    ]
	}
    ;


    additive:
	[
	  | ET_PLUS:
	    @multiplicative
	  | ET_MINUS:
	    @multiplicative
	    [SkipCount
	      | 0:
		@negate
	      | *:
	    ]
	  | *:
	    @multiplicative
	]
	{
	    [
	      | ET_PLUS:
		@multiplicative
		[SkipCount
		  | 0:
		    @perform_add
		  | *:
		]
	      | ET_MINUS:
		@multiplicative
		[SkipCount
		  | 0:
		    @perform_minus
		  | *:
		]
	      | *:
		>>
	    ]
	}
    ;



    multiplicative:
	@exponentiation
	{
	    [
	      | ET_MUL:
		@exponentiation
		[SkipCount
		  | 0:
		    DoMul
		  | *:
		]
	      | ET_DIV:
		@exponentiation
		[SkipCount
		  | 0:
		    DoDiv
		  | *:
		]
	      | ET_MOD:
		@exponentiation
		[SkipCount
		  | 0:
		    DoMod
		  | *:
		]
	      | *:
		>>
	    ]
	}
    ;



    exponentiation:
	@unary
%   not implemented (yet ?)
%	[
%	  | ET_EXP:
%	    @exponentiation
%	    [SkipCount
%	      | 0:
%		DoExp
%	      | *:
%	    ]
%	  | *:
%	]
    ;



    unary:
	[
	  | ET_PLUS_PLUS:
	    @unary
	    SwitchOn( sw_side_effect )
	    [SkipCount
	      | 0:
		PushDup
		PushInt( 1 )
		@perform_add
		DoAssign
	      | *:
	    ]
	  | ET_MINUS_MINUS:
	    @unary
	    SwitchOn( sw_side_effect )
	    [SkipCount
	      | 0:
		PushDup
		PushInt( -1 )
		@perform_add
		DoAssign
	      | *:
	    ]
	  | ET_AND:
	    @unary
	    [SkipCount
	      | 0:
		DoAddr
	      | *:
	    ]
	  | ET_MUL:
	    @unary
	    [SkipCount
	      | 0:
	        @do_points_unsigned
	      | *:
	    ]
	  | ET_MOD:
	    @unary
	    [SkipCount
	      | 0:
	        @do_points_addr
	      | *:
	    ]
	  | ET_NOT:
	    @unary
	    [SkipCount
	      | 0:
		PushInt( -1 )
		DoXor
	      | *:
	    ]
	  | *:
	    @postfix
	]
    ;

  

    stack_info >> info_type:
        [SSLVersion( version_dip )
    	  | false:
	    [StackClass( 0 )	%OBSOLETE
	      | stk_array, stk_near_ptr, stk_far_ptr: 
	          >>INFO_ARRAY
	      | stk_func, stk_addr: 
	          >>INFO_FUNC
	      | stk_string: 
	          >>INFO_STRING
	      | *:
	          >>INFO_OTHER
	      ]
	  | *:
	      [StackKind( 0 ) 
	        | TK_POINTER, TK_ARRAY:
		    >>INFO_ARRAY
		| TK_FUNCTION, TK_CODE:
		    >>INFO_FUNC
		| TK_STRING:
		    >>INFO_STRING
	        | *:
		    >>INFO_OTHER
		]
	  ]
    ;


    postfix:
	@segmented
	{
	    ScanSave
	    [
	      | ET_LEFT_PAREN:
		[SkipCount
		  | 0:
		    [@stack_info
		      | INFO_ARRAY:
			[SkipCount
			  | 0:
			    StartSubscript
			  | *:
			]
			{
			    @nest_callexpr
			    [SkipCount
			      | 0:
				AddSubscriptIndex
			      | *:
			    ]
			    [
			      | ET_COMMA:
				% null statement
			      | ET_RIGHT_PAREN:
				>
			      | *:
				ET_RIGHT_PAREN	% cause an error
			    ]
			}
			[SkipCount
			  | 0:
			    EndSubscript
			  | *:
			]
		      | INFO_FUNC:
			[ExprIsCall
			  | true:
			    ScanRestore	% unget '(' token
			    >>
			  | *:
			]
			NextNestedCall
			NumSet( 0 )
			[
			  | ET_RIGHT_PAREN:
			    % endchoice
			  | *:
			    {
				NumPush
				@nest_callexpr
				[SkipCount
				  | 0:
				    StackSwap( 1 )
				  | *:
				]
				NumPop
				NumAdd( 1 )
				[
				  | ET_COMMA:
				    % null statement
				  | ET_RIGHT_PAREN:
				    >
				  | *:
				    ET_RIGHT_PAREN % cause error
				]
			    }
			]
			SwitchOn( sw_side_effect )
			[SkipCount
			  | 0:
			    DoCall( true )
			  | *:
			]
		      | INFO_STRING:
			SetEvalSubstring( true )
			[
			  | ET_COLON:
			    @substring_index_2
			  | *:
			    @nest_callexpr
			    ET_COLON
			    UseSubstringIndex1
			    @substring_index_2
			]
		      | *:
			#err_ill_type
		    ]
		  | *:
		    [ExprIsCall
		      | true:
			ScanRestore     % unget '(' token
			>>
		      | *:
		    ]
		    [
		      | ET_RIGHT_PAREN:
			% endchoice
		      | *:
			{
			    @nest_callexpr
			    [
			      | ET_COMMA, ET_COLON:
				% null statement
			      | ET_RIGHT_PAREN:
				>
			      | *:
				ET_RIGHT_PAREN % cause error
			    ]
			}
		    ]
		]
	      | ET_DOT:
		@field_name
	      | ET_RIGHT_ARROW:
		[SkipCount
		  | 0:
		    @do_points_unsigned
		  | *:
		]
		@field_name
	      | ET_PLUS_PLUS:
		SwitchOn( sw_side_effect )
		[SkipCount
		  | 0:
		    PushDup
		    StackRValue( 0 )
		    StackSwap( 1 )
		    PushDup
		    PushInt( 1 )
		    @perform_add
		    DoAssign
		    PopEntry
		  | *:
		]
	      | ET_MINUS_MINUS:
		SwitchOn( sw_side_effect )
		[SkipCount
		  | 0:
		    PushDup
		    StackRValue( 0 )
		    StackSwap( 1 )
		    PushDup
		    PushInt( -1 )
		    @perform_add
		    DoAssign
		    PopEntry
		  | *:
		]
	      | *:
		ScanPop
		>>
		SwitchOn( sw_side_effect )
	    ]
	    ScanPop
	}
    ;

    substring_index_2:
	[
	  | ET_RIGHT_PAREN:
	    % null statement
	  | *:
	    @nest_callexpr
	    ET_RIGHT_PAREN
	    UseSubstringIndex2
	]
	SetEvalSubstring( false )
    ;


    field_name:
        @push_name
	[SkipCount
	  | 0:
	    DoField
	  | *:
	]
    ;


    segmented:
	[
	  | ET_DOT:
	    [SkipCount
	      | 0:
		PushDot
	      | *:
	    ]
	  | ET_VAR_EXIST:
	    @primary
	    [SkipCount
	      | 0:
		DoTstExist( 1 )
	      | *:
	    ]
	  | *:
	    @primary
	    [EvalSubstring
	      | false:
		[
		  | ET_COLON:
		    @primary
		    [SkipCount
		      | 0:
			DoMakeAddr
		      | *:
		    ]
		  | *:
		]
	      | *:
	    ]
	]
    ;


    not_complex_constant:
	ScanRestore
	@nest_expr
	@req_right_paren
    ;

    complex_constant_or_nested_expression:
	ScanSave
	[
	  | ET_PLUS:
	    PushInt( 1 )
	  | ET_MINUS:
	    PushInt( -1 )
	  | *:
	    PushInt( 1 )
	]
	[PushNum
	  | true:
	    DoMul
	  | *:
	    PopEntry
	    @not_complex_constant
	    >>
	]
	[
	  | ET_COMMA:
	    [
	      | ET_PLUS:
		PushInt( 1 )
	      | ET_MINUS:
		PushInt( -1 )
	      | *:
		PushInt( 1 )
	    ]
	    [PushNum
	      | true:
		DoMul
	      | *:
		PopEntry
		PopEntry
		@not_complex_constant
		>>
	    ]
	    [
	      | ET_RIGHT_PAREN:
		[SkipCount
		  | 0:
		    DoMakeComplex
		  | *:
		    PopEntry
		    PopEntry
		]
		ScanPop
		>>
	      | *:
		PopEntry
		PopEntry
		@not_complex_constant
		>>
	    ]
	  | *:
	    PopEntry
	    @not_complex_constant
	    >>
	]
    ;

    push_type_i4:
        [SSLVersion( version_dip )
	| false:
	    PushScalarType( type_s4 )
	| *:
	    PushType( TI_integer_signed_4 )
	]
    ;
    
    push_type_f8:
        [SSLVersion( version_dip )
	| false:
	    PushScalarType( type_f8 )
	| *:
	    PushType( TI_real_8 )
	]
    ;
    
    push_type_z16:
        [SSLVersion( version_dip )
	| false:
	    PushScalarType( type_z16 )
	| *:
	    PushType( TI_complex_16 )
	]
    ;

    primary:
	[
	  | ET_INT:
	    ET_LEFT_PAREN
	    @push_type_i4
	    @nest_callexpr
	    @req_right_paren
	    [SkipCount
	      | 0:
		DoConvert
	      | *:
		PopEntry
	    ]
	  | ET_REAL, ET_DBLE:
	    ET_LEFT_PAREN
	    @push_type_f8
	    @nest_callexpr
	    @req_right_paren
	    [SkipCount
	      | 0:
		DoConvert
	      | *:
		PopEntry
	    ]
	  | ET_CMPLX, ET_DCMPLX:
	    ET_LEFT_PAREN
	    @nest_callexpr
	    [
	      | ET_RIGHT_PAREN:
		[SkipCount
		  | 0:
		    @push_type_z16
		    StackSwap( 1 )
		    DoConvert
		  | *:
		]
	      | ET_COMMA:
		@nest_callexpr
		@req_right_paren
		[SkipCount
		  | 0:
		    DoMakeComplex
		  | *:
		]
	      | *:
		ET_COMMA    % cause error
	    ]
	  | ET_LEFT_PAREN:
	    @complex_constant_or_nested_expression
	  | ET_LEFT_BRACKET:
	    [PushRegSet
	      | false:
		#err_loc_and_want_reg_name
	      | *:
	        @skip_pop
	    ]
	    ET_RIGHT_BRACKET
	  | *:
	    @push_token
	    @skip_pop
	]
    ;