PushT (SkipType(type)) ;
PushT (expr) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction ;
+ BuildConvertFunction (Convert, FALSE) ;
PopT (expr)
END ;
RETURN( expr )
*)
PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL;
- message: ARRAY OF CHAR; internal: BOOLEAN) ;
+ message: ARRAY OF CHAR) ;
VAR
const: CARDINAL ;
BEGIN
PushT (type) ;
PushTFtok (MakeConstLit (tok, MakeKey ('1'), ZType), ZType, tok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, TRUE)
END
ELSE
const := MakeConstLit (tok, MakeKey ('1'), type) ;
PushTtok (type, tok) ;
PushTtok (MakeConstLit (tok, MakeKey ('0'), ZType), tok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, TRUE)
ELSE
PushTFtok (MakeConstLit (tok, MakeKey ('0'), type), type, tok)
END
type := ZType
END ;
PushOne (dotok, type,
- 'the implied {%kFOR} loop increment will cause an overflow {%1ad}', TRUE)
+ 'the implied {%kFOR} loop increment will cause an overflow {%1ad}')
END BuildPseudoBy ;
PushT (dtype) ;
PushT (expr) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction ;
+ BuildConvertFunction (Convert, FALSE) ;
doBuildBinaryOp (FALSE, TRUE)
ELSE
IF tok=PlusTok
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
PushOne (proctok, dtype,
- 'the {%EkINC} will cause an overflow {%1ad}', FALSE) ;
+ 'the {%EkINC} will cause an overflow {%1ad}') ;
PopT (OperandSym)
END ;
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
PushOne (proctok, dtype,
- 'the {%EkDEC} will cause an overflow {%1ad}', FALSE) ;
+ 'the {%EkDEC} will cause an overflow {%1ad}') ;
PopT (OperandSym)
END ;
IF IsUnknown (ProcSym)
THEN
paramtok := OperandTtok (1) ;
- combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
+ combinedtok := MakeVirtual2Tok (functok, paramtok) ;
MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym) ;
PopN (NoOfParam + 2) ;
(* Fake return value to continue compiling. *)
IsPseudoBaseFunction (ProcSym)
THEN
ManipulatePseudoCallParameters ;
- BuildPseudoFunctionCall
+ BuildPseudoFunctionCall (ConstExpr)
ELSE
BuildRealFunctionCall (functok, ConstExpr)
END
PushTtok (ProcSym, functok) ;
PushTtok (ConstExpression, paramtok) ;
PushT (2) ; (* Two parameters. *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, TRUE)
ELSE
MetaErrorT0 (functok, '{%E}a constant type conversion can only have one argument')
END
*)
-PROCEDURE BuildPseudoFunctionCall ;
+PROCEDURE BuildPseudoFunctionCall (ConstExpr: BOOLEAN) ;
VAR
NoOfParam,
ProcSym : CARDINAL ;
ProcSym := OperandT (NoOfParam+1) ;
ProcSym := SkipConst (ProcSym) ;
PushT (NoOfParam) ;
- (* Compile time stack restored to entry state *)
+ (* Compile time stack restored to entry state. *)
IF ProcSym = High
THEN
BuildHighFunction
ELSIF ProcSym = LengthS
THEN
- BuildLengthFunction
+ BuildLengthFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Adr
THEN
BuildAdrFunction
BuildTBitSizeFunction
ELSIF ProcSym = Convert
THEN
- BuildConvertFunction
+ BuildConvertFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Odd
THEN
- BuildOddFunction
+ BuildOddFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Abs
THEN
- BuildAbsFunction
+ BuildAbsFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Cap
THEN
- BuildCapFunction
+ BuildCapFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Val
THEN
- BuildValFunction
+ BuildValFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Chr
THEN
- BuildChrFunction
+ BuildChrFunction (ProcSym, ConstExpr)
ELSIF IsOrd (ProcSym)
THEN
- BuildOrdFunction (ProcSym)
+ BuildOrdFunction (ProcSym, ConstExpr)
ELSIF IsInt (ProcSym)
THEN
- BuildIntFunction (ProcSym)
+ BuildIntFunction (ProcSym, ConstExpr)
ELSIF IsTrunc (ProcSym)
THEN
- BuildTruncFunction (ProcSym)
+ BuildTruncFunction (ProcSym, ConstExpr)
ELSIF IsFloat (ProcSym)
THEN
- BuildFloatFunction (ProcSym)
+ BuildFloatFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Min
THEN
BuildMinFunction
BuildMaxFunction
ELSIF ProcSym = AddAdr
THEN
- BuildAddAdrFunction
+ BuildAddAdrFunction (ProcSym, ConstExpr)
ELSIF ProcSym = SubAdr
THEN
- BuildSubAdrFunction
+ BuildSubAdrFunction (ProcSym, ConstExpr)
ELSIF ProcSym = DifAdr
THEN
- BuildDifAdrFunction
+ BuildDifAdrFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Cast
THEN
- BuildCastFunction
+ BuildCastFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Shift
THEN
BuildShiftFunction
BuildMakeAdrFunction
ELSIF ProcSym = Re
THEN
- BuildReFunction
+ BuildReFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Im
THEN
- BuildImFunction
+ BuildImFunction (ProcSym, ConstExpr)
ELSIF ProcSym = Cmplx
THEN
- BuildCmplxFunction
+ BuildCmplxFunction (ProcSym, ConstExpr)
ELSE
InternalError ('pseudo function not implemented yet')
END
|----------------| |------------|
*)
-PROCEDURE BuildAddAdrFunction ;
+PROCEDURE BuildAddAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
functok,
+ vartok,
optok : CARDINAL ;
opa,
ReturnVar,
IF NoOfParam=2
THEN
VarSym := OperandT (2) ;
+ vartok := OperandTok (2) ;
OperandSym := OperandT (1) ;
optok := OperandTok (1) ;
- combinedtok := MakeVirtualTok (functok, functok, optok) ;
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
PopN (NoOfParam + 1) ;
- IF IsVar (VarSym)
+ IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR
+ ConstExprError (ProcSym, OperandSym, optok, ConstExpr)
+ THEN
+ (* Fake return result. *)
+ PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address),
+ Address, combinedtok)
+ ELSIF IsVar (VarSym)
THEN
IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
THEN
PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
END
ELSE
- MetaErrorT0 (functok, '{%E}SYSTEM procedure ADDADR expects 2 parameters') ;
- PopN (NoOfParam + 1) ;
- PushTFtok (MakeConstLit (functok, MakeKey ('0'), Address), Address, functok)
+ MetaErrorT0 (functok,
+ '{%E}SYSTEM procedure {%EkADDADR} expects 2 parameters') ;
+ PopN (NoOfParam+1) ;
+ PushTFtok (MakeConstLit (functok, MakeKey('0'), Address), Address, functok)
END
END BuildAddAdrFunction ;
|----------------| |------------|
*)
-PROCEDURE BuildSubAdrFunction ;
+PROCEDURE BuildSubAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
functok,
combinedtok,
BEGIN
PopT (NoOfParam) ;
functok := OperandTtok (NoOfParam + 1) ;
- OperandSym := OperandT (1) ;
- optok := OperandTok (1) ;
IF NoOfParam = 2
THEN
+ optok := OperandTok (1) ;
+ OperandSym := OperandT (1) ;
VarSym := OperandT (2) ;
vartok := OperandTok (2) ;
combinedtok := MakeVirtualTok (functok, functok, optok) ;
PopN (NoOfParam + 1) ;
- IF IsVar (VarSym)
+ IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR
+ ConstExprError (ProcSym, OperandSym, optok, ConstExpr)
+ THEN
+ (* Fake return result. *)
+ PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address),
+ Address, combinedtok)
+ ELSIF IsVar (VarSym)
THEN
IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
THEN
PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Address), Address, combinedtok)
END
ELSE
- combinedtok := MakeVirtualTok (functok, functok, optok) ;
MetaErrorT0 (functok,
'{%E}SYSTEM procedure {%EkSUBADR} expects 2 parameters') ;
PopN (NoOfParam+1) ;
- PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
+ PushTFtok (MakeConstLit (functok, MakeKey('0'), Address), Address, functok)
END
END BuildSubAdrFunction ;
|----------------| |------------|
*)
-PROCEDURE BuildDifAdrFunction ;
+PROCEDURE BuildDifAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
functok,
optok,
BEGIN
PopT (NoOfParam) ;
functok := OperandTtok (NoOfParam + 1) ;
- OperandSym := OperandT (1) ;
- optok := OperandTok (1) ;
+ IF NoOfParam >= 1
+ THEN
+ OperandSym := OperandT (1) ;
+ optok := OperandTok (1)
+ ELSE
+ optok := functok
+ END ;
IF NoOfParam = 2
THEN
VarSym := OperandT (2) ;
vartok := OperandTok (2) ;
combinedtok := MakeVirtualTok (functok, functok, optok) ;
PopN (NoOfParam + 1) ;
- IF IsVar (VarSym)
+ IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR
+ ConstExprError (ProcSym, OperandSym, optok, ConstExpr)
+ THEN
+ (* Fake return result. *)
+ PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer),
+ Integer, combinedtok)
+ ELSIF IsVar (VarSym)
THEN
IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
THEN
PushTtok (Integer, functok) ;
PushTtok (TempVar, vartok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaError1 ('the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
OperandSym) ;
PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
END
ELSE
- combinedtok := MakeVirtualTok (functok, functok, optok) ;
- MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters') ;
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
+ MetaErrorT0 (combinedtok, '{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters') ;
PopN (NoOfParam+1) ;
PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
END
END GetQualidentImport ;
+(*
+ ConstExprError - return TRUE if a constant expression is being built and Var is a variable.
+*)
+
+PROCEDURE ConstExprError (Func, Var: CARDINAL; optok: CARDINAL; ConstExpr: BOOLEAN) : BOOLEAN ;
+BEGIN
+ IF ConstExpr AND IsVar (Var)
+ THEN
+ MetaErrorT2 (optok,
+ 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2da}',
+ Func, Var) ;
+ RETURN TRUE
+ ELSE
+ RETURN FALSE
+ END
+END ConstExprError ;
+
+
(*
DeferMakeLengthConst - creates a constant which contains the length of string, sym.
*)
*)
-PROCEDURE BuildLengthFunction ;
+PROCEDURE BuildLengthFunction (Function: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
paramtok,
END ;
IF NoOfParam >= 1
THEN
- combinedtok := MakeVirtualTok (paramtok, functok, paramtok) ;
+ combinedtok := MakeVirtual2Tok (functok, paramtok) ;
IF IsConst (Param) AND (GetSType (Param) = Char)
THEN
PopT (NoOfParam) ;
IF (ProcSym # NulSym) AND IsProcedure (ProcSym)
THEN
PopT (NoOfParam) ;
- IF IsConst (OperandT (1))
+ IF IsConst (Param)
THEN
- (* we can fold this in M2GenGCC. *)
+ (* This can be folded in M2GenGCC. *)
ReturnVar := MakeTemporary (combinedtok, ImmediateValue) ;
PutVar (ReturnVar, Cardinal) ;
- GenQuad (StandardFunctionOp, ReturnVar, ProcSym, OperandT (1)) ;
+ GenQuad (StandardFunctionOp, ReturnVar, ProcSym, Param) ;
PopN (NoOfParam + 1) ;
PushTtok (ReturnVar, combinedtok)
+ ELSIF ConstExprError (Function, Param, paramtok, ConstExpr)
+ THEN
+ (* Fake a result as we have detected and reported an error. *)
+ PopN (NoOfParam + 1) ;
+ ReturnVar := MakeConstLit (combinedtok, MakeKey ('1'), Cardinal) ;
+ PushTtok (ReturnVar, combinedtok)
ELSE
- (* no we must resolve this at runtime or in the GCC optimizer. *)
+ (* We must resolve this at runtime or in the GCC optimizer. *)
PopTF (Param, Type);
PopN (NoOfParam) ;
PushTtok (ProcSym, functok) ;
|----------------|
*)
-PROCEDURE BuildOddFunction ;
+PROCEDURE BuildOddFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
optok,
Var := OperandT (1) ;
optok := OperandTok (1) ;
combinedtok := MakeVirtualTok (functok, functok, optok) ;
- IF IsVar(Var) OR IsConst(Var)
+ IF ConstExprError (ProcSym, Var, optok, ConstExpr)
+ THEN
+ (* Nothing to do. *)
+ PushTtok (False, combinedtok)
+ ELSIF IsVar(Var) OR IsConst(Var)
THEN
PopN (NoOfParam + 1) ;
(*
|----------------|
*)
-PROCEDURE BuildAbsFunction ;
+PROCEDURE BuildAbsFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
vartok,
functok,
combinedtok: CARDINAL ;
NoOfParam,
- ProcSym,
Res, Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
THEN
Var := OperandT (1) ;
vartok := OperandTok (1) ;
+ PopN (NoOfParam + 1) ;
combinedtok := MakeVirtualTok (functok, functok, vartok) ;
- IF IsVar(Var) OR IsConst(Var)
+ IF ConstExprError (ProcSym, Var, vartok, ConstExpr)
+ THEN
+ (* Create fake result. *)
+ Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (Res, GetSType (Var)) ;
+ PushTFtok (Res, GetSType (Var), combinedtok)
+ ELSIF IsVar(Var) OR IsConst(Var)
THEN
- ProcSym := OperandT (NoOfParam + 1) ;
- PopN (NoOfParam + 1) ;
-
Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
PutVar (Res, GetSType (Var)) ;
|----------------| |-------------|
*)
-PROCEDURE BuildCapFunction ;
+PROCEDURE BuildCapFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
optok,
functok,
combinedtok: CARDINAL ;
NoOfParam,
- ProcSym,
Res, Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
THEN
Var := OperandT (1) ;
optok := OperandTok (1) ;
- IF IsVar (Var) OR IsConst (Var)
+ PopN (NoOfParam + 1) ;
+ IF ConstExprError (ProcSym, Var, optok, ConstExpr)
THEN
- ProcSym := OperandT (NoOfParam + 1) ;
- PopN (NoOfParam + 1) ;
-
- combinedtok := MakeVirtualTok (functok, functok, optok) ;
+ (* Create fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
+ Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (Res, Char) ;
+ PushTFtok (Res, Char, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
+ THEN
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
PutVar (Res, Char) ;
GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ;
|----------------|
*)
-PROCEDURE BuildChrFunction ;
+PROCEDURE BuildChrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
functok,
+ combinedtok,
optok : CARDINAL ;
+ ReturnVar,
NoOfParam,
Var : CARDINAL ;
BEGIN
THEN
Var := OperandT (1) ;
optok := OperandTok (1) ;
- IF IsVar (Var) OR IsConst (Var)
+ PopN (NoOfParam + 1) ;
+ IF ConstExprError (ProcSym, Var, optok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Char) ;
+ PushTFtok (ReturnVar, Char, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
THEN
- PopN (NoOfParam + 1) ;
(*
Build macro: CONVERT( CHAR, Var )
*)
PushTtok (Char, functok) ;
PushTtok (Var, optok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaErrorT1 (optok,
'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}',
|----------------|
*)
-PROCEDURE BuildOrdFunction (Sym: CARDINAL) ;
+PROCEDURE BuildOrdFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
+ combinedtok,
functok,
- optok : CARDINAL ;
+ optok : CARDINAL ;
+ ReturnVar,
NoOfParam,
- Type, Var: CARDINAL ;
+ Type, Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
functok := OperandTok (NoOfParam + 1) ;
THEN
Var := OperandT (1) ;
optok := OperandTok (1) ;
- IF IsVar (Var) OR IsConst (Var)
+ PopN (NoOfParam + 1) ;
+ IF ConstExprError (Sym, Var, optok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Cardinal) ;
+ PushTFtok (ReturnVar, Cardinal, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
THEN
Type := GetSType (Sym) ;
- PopN (NoOfParam + 1) ;
(*
Build macro: CONVERT( CARDINAL, Var )
*)
PushTtok (Type, optok) ;
PushTtok (Var, optok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaErrorT2 (optok,
'the parameter to {%1Aa} must be a variable or constant, seen {%2ad}',
|----------------|
*)
-PROCEDURE BuildIntFunction (Sym: CARDINAL) ;
+PROCEDURE BuildIntFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
functok,
optok : CARDINAL ;
+ ReturnVar,
NoOfParam,
Type, Var : CARDINAL ;
BEGIN
THEN
Var := OperandT (1) ;
optok := OperandTok (1) ;
- IF IsVar (Var) OR IsConst (Var)
+ PopN (NoOfParam + 1) ;
+ IF ConstExprError (Sym, Var, optok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, optok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Integer) ;
+ PushTFtok (ReturnVar, Integer, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
THEN
Type := GetSType (Sym) ; (* return type of function *)
- PopN (NoOfParam + 1) ;
(* Build macro: CONVERT( CARDINAL, Var ). *)
PushTFtok (Convert, NulSym, functok) ;
PushTtok (Type, functok) ;
PushTtok (Var, optok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
combinedtok := MakeVirtualTok (functok, optok, optok) ;
MetaErrorT2 (optok,
|----------------|
*)
-PROCEDURE BuildValFunction ;
+PROCEDURE BuildValFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
- functok : CARDINAL ;
+ combinedtok,
+ functok : CARDINAL ;
+ ReturnVar,
NoOfParam,
- ProcSym,
- Exp, Type: CARDINAL ;
+ Exp, Type : CARDINAL ;
tok, r,
typetok,
- exptok : CARDINAL ;
+ exptok : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
functok := OperandTok (NoOfParam + 1) ;
'undeclared type found in builtin procedure function {%AkVAL} {%1ad}',
Type)
(* non recoverable error. *)
+ ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtualTok (functok, functok, exptok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR
IsType (Type) OR IsPointer (Type) OR IsProcType (Type)) AND
(IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp))
PushTtok (Type, typetok) ;
PushTtok (Exp, exptok) ;
PushT (2) ; (* Two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
(* not sensible to try and recover when we dont know the return type. *)
MetaErrorT0 (functok,
|----------------|
*)
-PROCEDURE BuildCastFunction ;
+PROCEDURE BuildCastFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
+ exptok,
typetok,
- functok,
- vartok : CARDINAL ;
- n : Name ;
+ functok : CARDINAL ;
ReturnVar,
NoOfParam,
- Var, Type : CARDINAL ;
+ Exp, Type : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
functok := OperandTok (NoOfParam + 1) ;
THEN
Type := OperandT (2) ;
typetok := OperandTok (2) ;
- Var := OperandT (1) ;
- vartok := OperandTok (1) ;
+ Exp := OperandT (1) ;
+ exptok := OperandTok (1) ;
IF IsUnknown (Type)
THEN
- n := GetSymName (Type) ;
- WriteFormat1 ('undeclared type found in CAST (%a)', n)
+ (* we cannot recover if we dont have a type. *)
+ MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST}', Type)
+ (* non recoverable error. *)
+ ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtualTok (functok, functok, exptok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
ELSIF IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR IsType (Type) OR
IsPointer (Type) OR IsArray (Type) OR IsProcType (Type)
THEN
- IF IsConst (Var)
+ IF IsConst (Exp)
THEN
PopN (NoOfParam+1) ;
(*
Build macro: Type( Var )
*)
PushTFtok (Type, NulSym, typetok) ;
- PushTtok (Var, vartok) ;
+ PushTtok (Exp, exptok) ;
PushT (1) ; (* one parameter *)
BuildTypeCoercion
- ELSIF IsVar (Var) OR IsProcedure (Var)
+ ELSIF IsVar (Exp) OR IsProcedure (Exp)
THEN
PopN (NoOfParam + 1) ;
- combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+ combinedtok := MakeVirtual2Tok (functok, exptok) ;
ReturnVar := MakeTemporary (combinedtok, RightValue) ;
PutVar (ReturnVar, Type) ;
- GenQuadO (combinedtok, CastOp, ReturnVar, Type, Var, FALSE) ;
+ GenQuadO (combinedtok, CastOp, ReturnVar, Type, Exp, FALSE) ;
PushTFtok (ReturnVar, Type, combinedtok)
ELSE
(* not sensible to try and recover when we dont know the return type. *)
with a type Param1.
*)
-PROCEDURE BuildConvertFunction ;
+PROCEDURE BuildConvertFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
combinedtok,
functok,
exptok : CARDINAL ;
t, r,
Exp, Type,
- ProcSym,
NoOfParam,
ReturnVar : CARDINAL ;
BEGIN
(* we cannot recover if we dont have a type. *)
MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}', Exp)
(* non recoverable error. *)
+ ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtualTok (functok, functok, exptok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR
IsType (Type) OR IsPointer (Type) OR IsProcType (Type) OR IsRecord (Type)) AND
(IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp))
|----------------|
*)
-PROCEDURE BuildTruncFunction (Sym: CARDINAL) ;
+PROCEDURE BuildTruncFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
+ combinedtok,
vartok,
- functok : CARDINAL ;
- NoOfParam: CARDINAL ;
+ functok : CARDINAL ;
+ NoOfParam : CARDINAL ;
+ ReturnVar,
ProcSym,
Type,
- Var : CARDINAL ;
+ Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
Assert (IsTrunc (OperandT (NoOfParam+1))) ;
vartok := OperandTtok (1) ;
Type := GetSType (Sym) ;
PopN (NoOfParam + 1) ; (* destroy arguments to this function *)
- IF IsVar (Var) OR IsConst (Var)
+ IF ConstExprError (Sym, Var, vartok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, vartok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
THEN
IF IsRealType (GetSType (Var))
THEN
PushTtok (Type, functok) ;
PushTtok (Var, vartok) ;
PushT (2) ; (* two parameters *)
- BuildConvertFunction
+ BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaErrorT1 (functok,
'argument to {%1Ead} must be a float point type', Sym) ;
|----------------|
*)
-PROCEDURE BuildFloatFunction (Sym: CARDINAL) ;
+PROCEDURE BuildFloatFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
+ combinedtok,
vartok,
- functok : CARDINAL ;
- NoOfParam: CARDINAL ;
+ functok : CARDINAL ;
+ NoOfParam : CARDINAL ;
+ ReturnVar,
Type,
Var,
- ProcSym : CARDINAL ;
+ ProcSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
functok := OperandTtok (NoOfParam + 1) ;
THEN
Var := OperandT (1) ;
vartok := OperandTtok (1) ;
- IF IsVar (Var) OR IsConst (Var)
+ PopN (NoOfParam + 1) ; (* destroy arguments to this function. *)
+ IF ConstExprError (Sym, Var, vartok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, vartok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
+ ELSIF IsVar (Var) OR IsConst (Var)
THEN
- PopN (NoOfParam + 1) ; (* destroy arguments to this function. *)
(* build macro: CONVERT (REAL, Var). *)
PushTFtok (ProcSym, NulSym, functok) ;
PushTtok (Type, functok) ;
PushTtok (Var, vartok) ;
PushT(2) ; (* two parameters. *)
- BuildConvertFunction
+ BuildConvertFunction (ProcSym, ConstExpr)
ELSE
MetaErrorT1 (vartok,
'argument to {%1Ead} must be a variable or constant', ProcSym) ;
InternalError ('CONVERT procedure not found for FLOAT substitution')
END
ELSE
+ PopN (NoOfParam + 1) ; (* destroy arguments to this function. *)
MetaErrorT1 (functok,
'the builtin procedure function {%1Ead} only has one parameter',
Sym) ;
|----------------|
*)
-PROCEDURE BuildReFunction ;
+PROCEDURE BuildReFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
func,
combinedtok,
functok : CARDINAL ;
NoOfParam : CARDINAL ;
ReturnVar,
+ Type,
Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
Var := OperandT (1) ;
vartok := OperandTok (1) ;
combinedtok := MakeVirtualTok (functok, functok, vartok) ;
- IF IsVar(Var) OR IsConst(Var)
+ Type := ComplexToScalar (GetDType (Var)) ;
+ PopN (NoOfParam+1) ; (* destroy arguments to this function *)
+ IF ConstExprError (Sym, Var, vartok, ConstExpr)
THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, vartok) ;
ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
- PutVar (ReturnVar, ComplexToScalar (GetDType (Var))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
+ ELSIF IsVar(Var) OR IsConst(Var)
+ THEN
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Type) ;
GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Re, Var, FALSE) ;
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
- PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
+ PushTFtok (ReturnVar, Type, combinedtok)
ELSE
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
MetaErrorT2 (vartok,
'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
|----------------|
*)
-PROCEDURE BuildImFunction ;
+PROCEDURE BuildImFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
func,
combinedtok,
functok : CARDINAL ;
NoOfParam : CARDINAL ;
ReturnVar,
+ Type,
Var : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
THEN
Var := OperandT (1) ;
vartok := OperandTok (1) ;
+ Type := ComplexToScalar (GetDType (Var)) ;
combinedtok := MakeVirtualTok (functok, functok, vartok) ;
- IF IsVar(Var) OR IsConst(Var)
+ PopN (NoOfParam+1) ; (* destroy arguments to this function *)
+ IF ConstExprError (Sym, Var, vartok, ConstExpr)
+ THEN
+ (* Generate fake result. *)
+ combinedtok := MakeVirtual2Tok (functok, vartok) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+ PutVar (ReturnVar, Type) ;
+ PushTFtok (ReturnVar, Type, combinedtok)
+ ELSIF IsVar(Var) OR IsConst(Var)
THEN
ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
PutVar (ReturnVar, ComplexToScalar (GetDType (Var))) ;
GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Im, Var, FALSE) ;
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
ELSE
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
MetaErrorT2 (vartok,
'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
|----------------|
*)
-PROCEDURE BuildCmplxFunction ;
+PROCEDURE BuildCmplxFunction (func: CARDINAL; ConstExpr: BOOLEAN) ;
VAR
+ failure : BOOLEAN ;
functok,
- endtok,
+ rtok, ltok,
combinedtok: CARDINAL ;
NoOfParam : CARDINAL ;
- func,
+ type,
ReturnVar,
l, r : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
functok := OperandTtok (NoOfParam + 1) ;
- func := OperandT (NoOfParam + 1) ;
IF NoOfParam = 2
THEN
l := OperandT (2) ;
+ ltok := OperandTtok (2) ;
r := OperandT (1) ;
- endtok := OperandTok (1) ;
- combinedtok := MakeVirtualTok (functok, functok, endtok) ;
- IF (IsVar(l) OR IsConst(l)) AND
- (IsVar(r) OR IsConst(r))
+ rtok := OperandTtok (1) ;
+ combinedtok := MakeVirtual2Tok (functok, rtok) ;
+ PopN (NoOfParam+1) ; (* Destroy arguments to this function. *)
+ type := GetCmplxReturnType (GetDType (l), GetDType (r)) ;
+ ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (l) AND IsConst (r))) ;
+ PutVar (ReturnVar, type) ;
+ failure := FALSE ;
+ IF ConstExprError (func, l, ltok, ConstExpr)
+ THEN
+ (* ConstExprError has generated an error message we will fall through
+ and check the right operand. *)
+ failure := TRUE
+ END ;
+ IF ConstExprError (func, r, rtok, ConstExpr)
+ THEN
+ (* Right operand is in error as a variable. *)
+ failure := TRUE
+ END ;
+ IF failure
+ THEN
+ (* Generate a fake result if either operand was a variable (and we
+ are in a const expression). *)
+ PushTFtok (ReturnVar, type, combinedtok)
+ ELSIF (IsVar (l) OR IsConst (l)) AND
+ (IsVar (r) OR IsConst (r))
THEN
CheckExpressionCompatible (combinedtok, GetSType(l), GetSType(r)) ;
- ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (l) AND IsConst (r))) ;
- PutVar (ReturnVar, GetCmplxReturnType (GetDType (l), GetDType (r))) ;
GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Cmplx, Make2Tuple (l, r), TRUE) ;
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
- PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
+ PushTFtok (ReturnVar, type, combinedtok)
ELSE
IF IsVar (l) OR IsConst (l)
THEN
'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}',
func, l)
END ;
- PopN (NoOfParam+1) ; (* destroy arguments to this function *)
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType, combinedtok)
END
ELSE
PushT (Address) ;
PushTtok (sym, tokpos) ;
PushT(2) ; (* Two parameters *)
- BuildConvertFunction ;
+ BuildConvertFunction (Convert, FALSE) ;
PopT (adr) ;
RETURN adr
END
PushT (Cardinal) ;
PushTtok (idx, indexTok) ;
PushT(2) ; (* Two parameters *)
- BuildConvertFunction ;
+ BuildConvertFunction (Convert, FALSE) ;
PopT (idx)
END ;
PutVar (tj, Cardinal) ;
typepos,
Type : CARDINAL ;
NulSet : CARDINAL ;
- tok : CARDINAL ;
BEGIN
PopTtok (Type, typepos) ; (* type of set we are building *)
IF (Type = NulSym) AND Pim
PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
VAR
- typetok,
value, valtok: CARDINAL ;
BEGIN
IF DebugTokPos
PushT(type) ;
PushT(sym) ;
PushT(2) ; (* Two parameters *)
- BuildConvertFunction ;
+ BuildConvertFunction (Convert, FALSE) ;
PopT(sym)
END ;
RETURN( sym )
projects / thirdparty / gcc.git / commitdiff
