paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-24 03:51:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add no-fpu support to compiler/rtl for powerpc-linux (-Cfnone)

Browse Source 
git-svn-id: trunk@10422 -
This commit is contained in:
micha 2008-03-02 12:59:02 +00:00
parent d80d3f36d2
commit 83b7f81f81
54 changed files with 841 additions and 432 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/msg/errore.msg
View File

@ -358,7 +358,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
#
# Parser
#
# 03237 is the last used one
# 03244 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1141,6 +1141,8 @@ parser_e_implements_must_read_specifier=03240_E_Implements-property must have re
parser_e_implements_must_not_have_write_specifier=03241_E_Implements-property must not have write-specifier
parser_e_implements_must_not_have_stored_specifier=03242_E_Implements-property must not have stored-specifier
parser_e_implements_uses_non_implemented_interface=03243_E_Implements-property used on unimplemented interface: "$1"
parser_e_unsupported_real=03244_E_Floating point not supported for this target
% The compiler parsed a floating point expression, but it is not supported.
% \end{description}
#
# Type Checking

5
compiler/msgidx.inc
View File

@ -331,6 +331,7 @@ const
parser_e_implements_must_not_have_write_specifier=03241;
parser_e_implements_must_not_have_stored_specifier=03242;
parser_e_implements_uses_non_implemented_interface=03243;
parser_e_unsupported_real=03244;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -742,9 +743,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 46084;
MsgTxtSize = 46137;
MsgIdxMax : array[1..20] of longint=(
24,87,244,84,64,50,108,22,135,60,
24,87,245,84,64,50,108,22,135,60,
42,1,1,1,1,1,1,1,1,1
);

509
compiler/msgtxt.inc
View File

@ -377,452 +377,454 @@ const msgtxt : array[0..000192,1..240] of char=(
'03241_E_Implements-property must not have write-specifier'#000+
'032','42_E_Implements-property must not have stored-specifier'#000+
'03243_E_Implements-property used on unimplemented interface: "$1"'#000+
'03244_E_Floating point not supported for this target'#000+
'04000_E_Type mismatch'#000+
'04001_E_Incompatible types: got "$1" expected "$2"'#000+
'04001_E_Incompatible types: got "$1" expect','ed "$2"'#000+
'04002_E_Type mismatch between "$1" and "$2"'#000+
'0','4003_E_Type identifier expected'#000+
'04003_E_Type identifier expected'#000+
'04004_E_Variable identifier expected'#000+
'04005_E_Integer expression expected, but got "$1"'#000+
'04006_E_Boolean expression expected, but got "$1"'#000+
'04007_E_Ordinal expression expected'#000+
'04008_E_pointer type expected, but ','got "$1"'#000+
'04007_E_Ordinal ex','pression expected'#000+
'04008_E_pointer type expected, but got "$1"'#000+
'04009_E_class type expected, but got "$1"'#000+
'04011_E_Can'#039't evaluate constant expression'#000+
'04012_E_Set elements are not compatible'#000+
'04013_E_Operation not implemented for sets'#000+
'04014_W_Automatic type conversion from floating type to COMP wh','ich i'+
'04014_W_Au','tomatic type conversion from floating type to COMP which i'+
's an integer type'#000+
'04015_H_use DIV instead to get an integer result'#000+
'04016_E_string types doesn'#039't match, because of $V+ mode'#000+
'04017_E_succ or pred on enums with assignments not possible'#000+
'04017_E_succ or pred on enums with assignments not possible',#000+
'04018_E_Can'#039't read or write variables of this type'#000+
'0','4019_E_Can'#039't use readln or writeln on typed file'#000+
'04019_E_Can'#039't use readln or writeln on typed file'#000+
'04020_E_Can'#039't use read or write on untyped file.'#000+
'04021_E_Type conflict between set elements'#000+
'04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
'04023_E_Integer or real expression ex','pected'#000+
'04022_W_lo/hi(dword/qword) returns the upper/l','ower word/dword'#000+
'04023_E_Integer or real expression expected'#000+
'04024_E_Wrong type "$1" in array constructor'#000+
'04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
'04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
'04027_E_Illegal constant passed to internal math fun','ction'#000+
'04026_E_Method (variable) and Procedure (variable) are not compatible',
#000+
'04027_E_Illegal constant passed to internal math function'#000+
'04028_E_Can'#039't take the address of constant expressions'#000+
'04029_E_Argument can'#039't be assigned to'#000+
'04030_E_Can'#039't assign local procedure/function to procedure variabl'+
'e'#000+
'04031_E_Can'#039't assign values to an address'#000+
'04032_E_Can'#039't assign values to ','const variable'#000+
'04031_E_Can'#039't assign',' values to an address'#000+
'04032_E_Can'#039't assign values to const variable'#000+
'04033_E_Array type required'#000+
'04034_E_interface type expected, but got "$1"'#000+
'04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+
'04036_W_Mixing signed expressions and cardinals here may cause a range'+
' check error',#000+
'04036_W_Mixing signed express','ions and cardinals here may cause a ran'+
'ge check error'#000+
'04037_E_Typecast has different size ($1 -> $2) in assignment'#000+
'04038_E_enums with assignments can'#039't be used as array index'#000+
'04039_E_Class or Object types "$1" and "$2" are not related'#000+
'04040_W_Class types "$1" and "$2" are not related'#000+
'04041_E_','Class or interface type expected, but got "$1"'#000+
'04040','_W_Class types "$1" and "$2" are not related'#000+
'04041_E_Class or interface type expected, but got "$1"'#000+
'04042_E_Type "$1" is not completely defined'#000+
'04043_W_String literal has more characters than short string length'#000+
'04044_W_Comparison is always false due to range of values'#000+
'04045_W_Comparison is a','lways true due to range of values'#000+
'04044_W_Comparison is always',' false due to range of values'#000+
'04045_W_Comparison is always true due to range of values'#000+
'04046_W_Constructing a class "$1" with abstract methods'#000+
'04047_H_The left operand of the IN operator should be byte sized'#000+
'04048_W_Type size mismatch, possible loss of data / range check error'#000+
'04049_H_Type si','ze mismatch, possible loss of data / range check erro'+
'04048_W_Type size mismatch, poss','ible loss of data / range check erro'+
'r'#000+
'04049_H_Type size mismatch, possible loss of data / range check error'#000+
'04050_E_The address of an abstract method can'#039't be taken'#000+
'04051_E_Assignments to formal parameters and open arrays are not possi'+
'ble'#000+
'04052_E_Constant Expression expected'#000+
'04053_E_Operation',' "$1" not supported for types "$2" and "$3"'#000+
'0','4052_E_Constant Expression expected'#000+
'04053_E_Operation "$1" not supported for types "$2" and "$3"'#000+
'04054_E_Illegal type conversion: "$1" to "$2"'#000+
'04055_H_Conversion between ordinals and pointers is not portable'#000+
'04056_W_Conversion between ordinals and pointers is not portable'#000+
'04057_E_Can'#039't determ','ine which overloaded function to call'#000+
'04056_W_Conversion between ordin','als and pointers is not portable'#000+
'04057_E_Can'#039't determine which overloaded function to call'#000+
'04058_E_Illegal counter variable'#000+
'04059_W_Converting constant real value to double for C variable argume'+
'nt, add explicit typecast to prevent this.'#000+
'04060_E_Class or COM interface type expected, but got "$','1"'#000+
'040','60_E_Class or COM interface type expected, but got "$1"'#000+
'04061_E_Constant packed arrays are not yet supported'#000+
'04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+
'ed Array"'#000+
'04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not pack'+
'ed) Array"'#000+
'04064_E_Elements of pac','ked arrays cannot be of a type which need to '+
'be initialised'#000+
'04063_E_Incompatible type for arg no. $1: Got "$2" ','expected "(not pa'+
'cked) Array"'#000+
'04064_E_Elements of packed arrays cannot be of a type which need to be'+
' initialised'#000+
'04065_E_Constant packed records and objects are not yet supported'#000+
'04066_W_Arithmetic "$1" on untyped pointer is unportable to {$T+}, sug'+
'gest typecast'#000+
'04076_E_Can'#039't take address of ','a subroutine marked as local'#000+
'04066_W_Arithmetic "$1" on untyped pointer is unportable to {','$T+}, s'+
'uggest typecast'#000+
'04076_E_Can'#039't take address of a subroutine marked as local'#000+
'04077_E_Can'#039't export subroutine marked as local from a unit'#000+
'04078_E_Type is not automatable: "$1"'#000+
'04079_H_Converting the operands to "$1" before doing the add could pre'+
'vent overflow errors.'#000+
'04080_H_Converting th','e operands to "$1" before doing the subtract co'+
'uld prevent overflow errors.'#000+
'04079_H_Converting the operands to "$1" before doing the add',' could p'+
'revent overflow errors.'#000+
'04080_H_Converting the operands to "$1" before doing the subtract coul'+
'd prevent overflow errors.'#000+
'04081_H_Converting the operands to "$1" before doing the multiply coul'+
'd prevent overflow errors.'#000+
'04082_W_Converting pointers to signed integers may result in wrong ','c'+
'04082_W_Conver','ting pointers to signed integers may result in wrong c'+
'omparison results and range errors, use an unsigned type instead.'#000+
'04083_E_Interface type $1 has no valid GUID'#000+
'05000_E_Identifier not found "$1"'#000+
'05001_F_Internal Error in SymTableStack()'#000+
'05001_F_Internal Error in SymTableStack()'#000,
'05002_E_Duplicate identifier "$1"'#000+
'05003_H_Identifier ','already defined in $1 at line $2'#000+
'05003_H_Identifier already defined in $1 at line $2'#000+
'05004_E_Unknown identifier "$1"'#000+
'05005_E_Forward declaration not solved "$1"'#000+
'05007_E_Error in type definition'#000+
'05009_E_Forward type not resolved "$1"'#000+
'05010_E_Only static variables can be used in static methods',' or outsi'+
'05010_','E_Only static variables can be used in static methods or outsi'+
'de methods'#000+
'05012_F_record or class type expected'#000+
'05013_E_Instances of classes or objects with an abstract method are no'+
't allowed'#000+
'05014_W_Label not defined "$1"'#000+
'05015_E_Label used but not defined "$1"'#000+
'05016_E_Illegal label declarati','on'#000+
'05015_E_Label used',' but not defined "$1"'#000+
'05016_E_Illegal label declaration'#000+
'05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
'05018_E_Label not found'#000+
'05019_E_identifier isn'#039't a label'#000+
'05020_E_label already defined'#000+
'05021_E_illegal type declaration of set elements'#000+
'05022_E_Forward class definition not resolv','ed "$1"'#000+
'05021_E_illegal type declaration of set',' elements'#000+
'05022_E_Forward class definition not resolved "$1"'#000+
'05023_H_Unit "$1" not used in $2'#000+
'05024_H_Parameter "$1" not used'#000+
'05025_N_Local variable "$1" not used'#000+
'05026_H_Value parameter "$1" is assigned but never used'#000+
'05027_N_Local variable "$1" is assigned but never used'#000+
'05028_H_Local $1 "$','2" is not used'#000+
'05027_N_Local variabl','e "$1" is assigned but never used'#000+
'05028_H_Local $1 "$2" is not used'#000+
'05029_N_Private field "$1.$2" is never used'#000+
'05030_N_Private field "$1.$2" is assigned but never used'#000+
'05031_N_Private method "$1.$2" never used'#000+
'05032_E_Set type expected'#000+
'05033_W_Function result does not seem to be set'#000+
'05034_W_','Type "$1" is not aligned correctly in current record for C'#000+
'050','33_W_Function result does not seem to be set'#000+
'05034_W_Type "$1" is not aligned correctly in current record for C'#000+
'05035_E_Unknown record field identifier "$1"'#000+
'05036_W_Local variable "$1" does not seem to be initialized'#000+
'05037_W_Variable "$1" does not seem to be initialized'#000+
'05038_E_identifier ide','nts no member "$1"'#000+
'05037_W_Variable "$1" d','oes not seem to be initialized'#000+
'05038_E_identifier idents no member "$1"'#000+
'05039_H_Found declaration: $1'#000+
'05040_E_Data element too large'#000+
'05042_E_No matching implementation for interface method "$1" found'#000+
'05043_W_Symbol "$1" is deprecated'#000+
'05044_W_Symbol "$1" is not portable'#000+
'05055_W_Symbol "$1" is ','not implemented'#000+
'05044_','W_Symbol "$1" is not portable'#000+
'05055_W_Symbol "$1" is not implemented'#000+
'05056_E_Can'#039't create unique type from this type'#000+
'05057_H_Local variable "$1" does not seem to be initialized'#000+
'05058_H_Variable "$1" does not seem to be initialized'#000+
'05059_W_Function result variable does not seem to initialized'#000,
'05059_W_F','unction result variable does not seem to initialized'#000+
'05060_H_Function result variable does not seem to be initialized'#000+
'05061_W_Variable "$1" read but nowhere assigned'#000+
'05062_H_Found abstract method: $1'#000+
'05063_W_Symbol "$1" is experimental'#000+
'06009_E_Parameter list size exceeds 65535 bytes'#000+
'06012_E_F','ile types must be var parameters'#000+
'0600','9_E_Parameter list size exceeds 65535 bytes'#000+
'06012_E_File types must be var parameters'#000+
'06013_E_The use of a far pointer isn'#039't allowed there'#000+
'06015_E_EXPORT declared functions can'#039't be called'#000+
'06016_W_Possible illegal call of constructor or destructor'#000+
'06016_W_Possible illegal call of constructor or des','tructor'#000+
'06017_N_Inefficient code'#000+
'06018_W_unreachable ','code'#000+
'06018_W_unreachable code'#000+
'06020_E_Abstract methods can'#039't be called directly'#000+
'06027_DL_Register $1 weight $2 $3'#000+
'06029_DL_Stack frame is omitted'#000+
'06031_E_Object or class methods can'#039't be inline.'#000+
'06032_E_Procvar calls cannot be inline.'#000+
'06033_E_No code for inline pro','cedure stored'#000+
'06032_E_Procvar c','alls cannot be inline.'#000+
'06033_E_No code for inline procedure stored'#000+
'06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
'sed, use (set)length instead'#000+
'06037_E_Constructors or destructors can not be called inside a '#039'wi'+
'th'#039' clause'#000+
'06038_E_Cannot call message handler methods directly'#000+
'0','6039_E_Jump in or outside of an exception block'#000+
'0','6038_E_Cannot call message handler methods directly'#000+
'06039_E_Jump in or outside of an exception block'#000+
'06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
'06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
'06042_W_Local variable size exceed limit for certain cpu'#039's'#000+
'06043_E_Loc','al variables size exceeds supported limit'#000+
'06042_W_Local var','iable size exceed limit for certain cpu'#039's'#000+
'06043_E_Local variables size exceeds supported limit'#000+
'06044_E_BREAK not allowed'#000+
'06045_E_CONTINUE not allowed'#000+
'06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+
'me library.'#000+
'06047_F_Cannot find system type "$1". Check if you use the co','rrect r'+
'06047_F_','Cannot find system type "$1". Check if you use the correct r'+
'un time library.'#000+
'06048_H_Inherited call to abstract method ignored'#000+
'06049_E_Goto label "$1" not defined or optimized away'#000+
'07000_DL_Starting $1 styled assembler parsing'#000+
'07001_DL_Finished $1 styled assembler parsing'#000+
'07002_E_Non-label pa','ttern contains @'#000+
'07001_DL_Fini','shed $1 styled assembler parsing'#000+
'07002_E_Non-label pattern contains @'#000+
'07004_E_Error building record offset'#000+
'07005_E_OFFSET used without identifier'#000+
'07006_E_TYPE used without identifier'#000+
'07007_E_Cannot use local variable or parameters here'#000+
'07008_E_need to use OFFSET here'#000+
'07009_E_need to use $ her','e'#000+
'0700','8_E_need to use OFFSET here'#000+
'07009_E_need to use $ here'#000+
'07010_E_Cannot use multiple relocatable symbols'#000+
'07011_E_Relocatable symbol can only be added'#000+
'07012_E_Invalid constant expression'#000+
'07013_E_Relocatable symbol is not allowed'#000+
'07014_E_Invalid reference syntax'#000+
'07015_E_You can not reach $1 from ','that code'#000+
'07014_E_Invali','d reference syntax'#000+
'07015_E_You can not reach $1 from that code'#000+
'07016_E_Local symbols/labels aren'#039't allowed as references'#000+
'07017_E_Invalid base and index register usage'#000+
'07018_W_Possible error in object field handling'#000+
'07019_E_Wrong scale factor specified'#000+
'07019_E_Wrong scale facto','r specified'#000+
'07020_E_Multiple index register usage'#000+
'070','21_E_Invalid operand type'#000+
'07021_E_Invalid operand type'#000+
'07022_E_Invalid string as opcode operand: $1'#000+
'07023_W_@CODE and @DATA not supported'#000+
'07024_E_Null label references are not allowed'#000+
'07025_E_Divide by zero in asm evaluator'#000+
'07025_E_Divide by zero in asm ev','aluator'#000+
'07026_E_Illegal expression'#000+
'07027_E_escape seq','uence ignored: $1'#000+
'07027_E_escape sequence ignored: $1'#000+
'07028_E_Invalid symbol reference'#000+
'07029_W_Fwait can cause emulation problems with emu387'#000+
'07030_W_$1 without operand translated into $1P'#000+
'07031_W_ENTER instruction is not supported by Linux kernel'#000+
'07032_W_Calling an overload ','function in assembler'#000+
'07031_W_ENTER instruction is not s','upported by Linux kernel'#000+
'07032_W_Calling an overload function in assembler'#000+
'07033_E_Unsupported symbol type for operand'#000+
'07034_E_Constant value out of bounds'#000+
'07035_E_Error converting decimal $1'#000+
'07036_E_Error converting octal $1'#000+
'07037_E_Error converting binary $1'#000+
'07038_E_Error converting hexadec','imal $1'#000+
'07037_E_Error ','converting binary $1'#000+
'07038_E_Error converting hexadecimal $1'#000+
'07039_H_$1 translated to $2'#000+
'07040_W_$1 is associated to an overloaded function'#000+
'07041_E_Cannot use SELF outside a method'#000+
'07042_E_Cannot use OLDEBP outside a nested procedure'#000+
'07043_W_Procedures can'#039't return any value in asm code'#000+
'07044','_E_SEG not supported'#000+
'07043_','W_Procedures can'#039't return any value in asm code'#000+
'07044_E_SEG not supported'#000+
'07045_E_Size suffix and destination or source size do not match'#000+
'07046_W_Size suffix and destination or source size do not match'#000+
'07047_E_Assembler syntax error'#000+
'07048_E_Invalid combination of opcode and operands'#000+
'07049_E_A','ssembler syntax error in operand'#000+
'07048_E','_Invalid combination of opcode and operands'#000+
'07049_E_Assembler syntax error in operand'#000+
'07050_E_Assembler syntax error in constant'#000+
'07051_E_Invalid String expression'#000+
'07052_W_constant with symbol $1 for address which is not on a pointer'#000+
'07053_E_Unrecognized opcode $1'#000+
'07054_E_Invalid or missing op','code'#000+
'07053_E','_Unrecognized opcode $1'#000+
'07054_E_Invalid or missing opcode'#000+
'07055_E_Invalid combination of prefix and opcode: $1'#000+
'07056_E_Invalid combination of override and opcode: $1'#000+
'07057_E_Too many operands on line'#000+
'07058_W_NEAR ignored'#000+
'07059_W_FAR ignored'#000+
'07059_W_FAR ignored',#000+
'07060_E_Duplicate local symbol $1'#000+
'07061_E_Undefined ','local symbol $1'#000+
'07061_E_Undefined local symbol $1'#000+
'07062_E_Unknown label identifier $1'#000+
'07063_E_Invalid register name'#000+
'07064_E_Invalid floating point register name'#000+
'07066_W_Modulo not supported'#000+
'07067_E_Invalid floating point constant $1'#000+
'07068_E_Invalid floating point expression',#000+
'07067_E_Invalid floating point ','constant $1'#000+
'07068_E_Invalid floating point expression'#000+
'07069_E_Wrong symbol type'#000+
'07070_E_Cannot index a local var or parameter with a register'#000+
'07071_E_Invalid segment override expression'#000+
'07072_W_Identifier $1 supposed external'#000+
'07073_E_Strings not allowed as constants'#000+
'07074_No type of variable ','specified'#000+
'07073_E_String','s not allowed as constants'#000+
'07074_No type of variable specified'#000+
'07075_E_assembler code not returned to text section'#000+
'07076_E_Not a directive or local symbol $1'#000+
'07077_E_Using a defined name as a local label'#000+
'07078_E_Dollar token is used without an identifier'#000+
'07079_W_32bit constant created for add','ress'#000+
'07078_E_Dollar token is used without',' an identifier'#000+
'07079_W_32bit constant created for address'#000+
'07080_N_.align is target specific, use .balign or .p2align'#000+
'07081_E_Can'#039't access fields directly for parameters'#000+
'07082_E_Can'#039't access fields of objects/classes directly'#000+
'07083_E_No size specified and unable to determine the size of the op','e'+
'rands'#000+
'07083_E_No size',' specified and unable to determine the size of the op'+
'erands'#000+
'07084_E_Cannot use RESULT in this function'#000+
'07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
'07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
'07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
'07089_E_Char < not allowe','d here'#000+
'07088_W_"$1 %st(n)" tran','slated into "$1 %st(n),%st"'#000+
'07089_E_Char < not allowed here'#000+
'07090_E_Char > not allowed here'#000+
'07093_W_ALIGN not supported'#000+
'07094_E_Inc and Dec cannot be together'#000+
'07095_E_Invalid reglist for movem'#000+
'07096_E_Reglist invalid for opcode'#000+
'07097_E_Higher cpu mode required ($1)'#000+
'07098_W_No size specified a','nd unable to determine the size of the op'+
'erands, using DWORD as default'#000+
'07097_E_High','er cpu mode required ($1)'#000+
'07098_W_No size specified and unable to determine the size of the oper'+
'ands, using DWORD as default'#000+
'07099_E_Syntax error while trying to parse a shifter operand'#000+
'07100_E_Address of packed component is not at a byte boundary'#000+
'07101_W_No size specified and unable to deter','mine the size of the op'+
'erands, using BYTE as default'#000+
'07100_E_Address of packed component is not at a byte b','oundary'#000+
'07101_W_No size specified and unable to determine the size of the oper'+
'ands, using BYTE as default'#000+
'07102_W_Use of +offset(%ebp) for parameters invalid here'#000+
'07103_W_Use of +offset(%ebp) is not compatible with regcall convention'+
#000+
'07104_W_Use of -offset(%ebp) is not recommended for local v','ariable a'+
'07104_','W_Use of -offset(%ebp) is not recommended for local variable a'+
'ccess'#000+
'07105_W_Use of -offset(%esp), access may cause a crash or value may be'+
' lost'#000+
'07106_E_VMTOffset must be used in combination with a virtual method, a'+
'nd "$1" is not virtual'#000+
'07107_E_Generating PIC, but reference is not PIC-safe'#000+
'08','000_F_Too many assembler files'#000+
'071','07_E_Generating PIC, but reference is not PIC-safe'#000+
'08000_F_Too many assembler files'#000+
'08001_F_Selected assembler output not supported'#000+
'08002_F_Comp not supported'#000+
'08003_F_Direct not support for binary writers'#000+
'08004_E_Allocating of data is only allowed in bss section'#000+
'08005_F_No binary writer selec','ted'#000+
'08004_E_Allocating of data is only ','allowed in bss section'#000+
'08005_F_No binary writer selected'#000+
'08006_E_Asm: Opcode $1 not in table'#000+
'08007_E_Asm: $1 invalid combination of opcode and operands'#000+
'08008_E_Asm: 16 Bit references not supported'#000+
'08009_E_Asm: Invalid effective address'#000+
'08010_E_Asm: Immediate or reference expected'#000+
'08011_E_Asm:',' $1 value exceeds bounds $2'#000+
'0801','0_E_Asm: Immediate or reference expected'#000+
'08011_E_Asm: $1 value exceeds bounds $2'#000+
'08012_E_Asm: Short jump is out of range $1'#000+
'08013_E_Asm: Undefined label $1'#000+
'08014_E_Asm: Comp type not supported for this target'#000+
'08015_E_Asm: Extended type not supported for this target'#000+
'08016_E_Asm: Duplicate labe','l $1'#000+
'08015_E_Asm: Extended type not ','supported for this target'#000+
'08016_E_Asm: Duplicate label $1'#000+
'08017_E_Asm: Redefined label $1'#000+
'08018_E_Asm: First defined here'#000+
'08019_E_Asm: Invalid register $1'#000+
'08020_E_Asm: 16 or 32 Bit references not supported'#000+
'08021_E_Asm: 64 Bit operands not supported'#000+
'08021_E_Asm: 64 Bit operands not s','upported'#000+
'09000_W_Source operating system redefined'#000+
'09','001_I_Assembling (pipe) $1'#000+
'09001_I_Assembling (pipe) $1'#000+
'09002_E_Can'#039't create assembler file: $1'#000+
'09003_E_Can'#039't create object file: $1'#000+
'09004_E_Can'#039't create archive file: $1'#000+
'09005_E_Assembler $1 not found, switching to external assembling'#000+
'09005_E_Assembler $1 not found, switching to ','external assembling'#000+
'09006_T_Using assembler: $1'#000+
'09007','_E_Error while assembling exitcode $1'#000+
'09007_E_Error while assembling exitcode $1'#000+
'09008_E_Can'#039't call the assembler, error $1 switching to external a'+
'ssembling'#000+
'09009_I_Assembling $1'#000+
'09010_I_Assembling with smartlinking $1'#000+
'09011_W_Object $1 not found, Linking may fail !'#000+
'09012_W_Library ','$1 not found, Linking may fail !'#000+
'09011_W_Obj','ect $1 not found, Linking may fail !'#000+
'09012_W_Library $1 not found, Linking may fail !'#000+
'09013_E_Error while linking'#000+
'09014_E_Can'#039't call the linker, switching to external linking'#000+
'09015_I_Linking $1'#000+
'09016_E_Util $1 not found, switching to external linking'#000+
'09016_E_Util $1 not found, switching to extern','al linking'#000+
'09017_T_Using util $1'#000+
'09018_E_Creation of ','Executables not supported'#000+
'09018_E_Creation of Executables not supported'#000+
'09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
'09020_I_Closing script $1'#000+
'09021_E_resource compiler not found, switching to external mode'#000+
'09022_I_Compiling resource $1'#000+
'09023_T_unit $1 can'#039't be statically',' linked, switching to smart l'+
'inking'#000+
'09022_I_Comp','iling resource $1'#000+
'09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+
'king'#000+
'09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
#000+
'09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
'g'#000+
'09026_E_unit $1 can'#039't be smart or static linked'#000+
'09027_E_unit $1 can'#039't',' be shared or static linked'#000+
'09026_E_unit $1 ','can'#039't be smart or static linked'#000+
'09027_E_unit $1 can'#039't be shared or static linked'#000+
'09028_D_Calling resource compiler "$1" with "$2" as command line'#000+
'09128_F_Can'#039't post process executable $1'#000+
'09129_F_Can'#039't open executable $1'#000+
'09130_X_Size of Code: $1 bytes'#000+
'09131_X_Size of initialized data: $1 bytes',#000+
'09130_X_Size of Code',': $1 bytes'#000+
'09131_X_Size of initialized data: $1 bytes'#000+
'09132_X_Size of uninitialized data: $1 bytes'#000+
'09133_X_Stack space reserved: $1 bytes'#000+
'09134_X_Stack space committed: $1 bytes'#000+
'10000_T_Unitsearch: $1'#000+
'10001_T_PPU Loading $1'#000+
'10002_U_PPU Name: $1'#000+
'10002_U_PPU Name',': $1'#000+
'10003_U_PPU Flags: $1'#000+
'10004_U_PPU Crc: $1'#000+
'10005_','U_PPU Time: $1'#000+
'10005_U_PPU Time: $1'#000+
'10006_U_PPU File too short'#000+
'10007_U_PPU Invalid Header (no PPU at the begin)'#000+
'10008_U_PPU Invalid Version $1'#000+
'10009_U_PPU is compiled for another processor'#000+
'10010_U_PPU is compiled for an other target'#000+
'10010_U_PPU is comp','iled for an other target'#000+
'10011_U_PPU Source: $1'#000+
'10012','_U_Writing $1'#000+
'10012_U_Writing $1'#000+
'10013_F_Can'#039't Write PPU-File'#000+
'10014_F_Error reading PPU-File'#000+
'10015_F_unexpected end of PPU-File'#000+
'10016_F_Invalid PPU-File entry: $1'#000+
'10017_F_PPU Dbx count problem'#000+
'10018_E_Illegal unit name: $1'#000+
'10018_E_Illeg','al unit name: $1'#000+
'10019_F_Too much units'#000+
'10020_F_Circu','lar unit reference between $1 and $2'#000+
'10020_F_Circular unit reference between $1 and $2'#000+
'10021_F_Can'#039't compile unit $1, no sources available'#000+
'10022_F_Can'#039't find unit $1 used by $2'#000+
'10023_W_Unit $1 was not found but $2 exists'#000+
'10024_F_Unit $1 searched but $2 found'#000+
'10025_W_Compiling the system un','it requires the -Us switch'#000+
'10024_F_Unit $1 ','searched but $2 found'#000+
'10025_W_Compiling the system unit requires the -Us switch'#000+
'10026_F_There were $1 errors compiling module, stopping'#000+
'10027_U_Load from $1 ($2) unit $3'#000+
'10028_U_Recompiling $1, checksum changed for $2'#000+
'10029_U_Recompiling $1, source found only'#000+
'10030_U_Recompiling unit, static ','lib is older than ppufile'#000+
'10029_U_Recompiling $1',', source found only'#000+
'10030_U_Recompiling unit, static lib is older than ppufile'#000+
'10031_U_Recompiling unit, shared lib is older than ppufile'#000+
'10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
'10033_U_Recompiling unit, obj is older than asm'#000+
'10033_U_Recompiling unit, obj is older th','an asm'#000+
'10034_U_Parsing interface of $1'#000+
'10035_U_Parsin','g implementation of $1'#000+
'10035_U_Parsing implementation of $1'#000+
'10036_U_Second load for unit $1'#000+
'10037_U_PPU Check file $1 time $2'#000+
'10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
'10041_U_File $1 is newer than PPU file $2'#000+
'10042_U_Trying to use a unit which was compi','led with a different FPU'+
' mode'#000+
'10041_U_File $1 is newer than PPU',' file $2'#000+
'10042_U_Trying to use a unit which was compiled with a different FPU m'+
'ode'#000+
'10043_U_Loading interface units from $1'#000+
'10044_U_Loading implementation units from $1'#000+
'10045_U_Interface CRC changed for unit $1'#000+
'10046_U_Implementation CRC changed for unit $1'#000+
'10046_U_Implementation CRC cha','nged for unit $1'#000+
'10047_U_Finished compiling unit $1'#000+
'1','0048_U_Add dependency of $1 to $2'#000+
'10048_U_Add dependency of $1 to $2'#000+
'10049_U_No reload, is caller: $1'#000+
'10050_U_No reload, already in second compile: $1'#000+
'10051_U_Flag for reload: $1'#000+
'10052_U_Forced reloading'#000+
'10053_U_Previous state of $1: $2'#000+
'10054_U_Already compiling $1, setting ','second compile'#000+
'10053_U_Previous s','tate of $1: $2'#000+
'10054_U_Already compiling $1, setting second compile'#000+
'10055_U_Loading unit $1'#000+
'10056_U_Finished loading unit $1'#000+
'10057_U_Registering new unit $1'#000+
'10058_U_Re-resolving unit $1'#000+
'10059_U_Skipping re-resolving unit $1, still loading used units'#000+
'11000_O_$1 [options] <inputfile> [options]'#000,
'10059_U_Skipping re-resolving unit $1, still loading u','sed units'#000+
'11000_O_$1 [options] <inputfile> [options]'#000+
'11001_W_Only one source file supported'#000+
'11002_W_DEF file can be created only for OS/2'#000+
'11003_E_nested response files are not supported'#000+
'11004_F_No source file name in command line'#000+
'11005_N_No option inside $1 config file'#000+
'11006_E_Illegal paramet','er: $1'#000+
'11005_N_No',' option inside $1 config file'#000+
'11006_E_Illegal parameter: $1'#000+
'11007_H_-? writes help pages'#000+
'11008_F_Too many config files nested'#000+
'11009_F_Unable to open file $1'#000+
'11010_D_Reading further options from $1'#000+
'11011_W_Target is already set to: $1'#000+
'11012_W_Shared libs not supported on DOS platform, revertin','g to stat'+
'11012_','W_Shared libs not supported on DOS platform, reverting to stat'+
'ic'#000+
'11013_F_too many IF(N)DEFs'#000+
'11014_F_too many ENDIFs'#000+
'11015_F_open conditional at the end of the file'#000+
'11016_W_Debug information generation is not supported by this executab'+
'le'#000+
'11017_H_Try recompiling with -dGDB'#000+
'11018_W_You are using',' the obsolete switch $1'#000+
'110','17_H_Try recompiling with -dGDB'#000+
'11018_W_You are using the obsolete switch $1'#000+
'11019_W_You are using the obsolete switch $1, please use $2'#000+
'11020_N_Switching assembler to default source writing assembler'#000+
'11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
'11022_W_"$1" assembler us','e forced'#000+
'11021_W_Assembler output selected "$1" ','is not compatible with "$2"'#000+
'11022_W_"$1" assembler use forced'#000+
'11026_T_Reading options from file $1'#000+
'11027_T_Reading options from environment $1'#000+
'11028_D_Handling option "$1"'#000+
'11029__*** press enter ***'#000+
'11030_H_Start of reading config file $1'#000+
'11031_H_End of reading config file $1'#000+
'11032_D_interpre','ting option "$1"'#000+
'1','1031_H_End of reading config file $1'#000+
'11032_D_interpreting option "$1"'#000+
'11036_D_interpreting firstpass option "$1"'#000+
'11033_D_interpreting file option "$1"'#000+
'11034_D_Reading config file "$1"'#000+
'11035_D_found source file name "$1"'#000+
'11039_E_Unknown code page'#000+
'11039_E_Unknown code',' page'#000+
'11040_F_Config file $1 is a directory'#000+
'11041_W_A','ssembler output selected "$1" cannot generate debug info, d'+
'ebugging disabled'#000+
'11041_W_Assembler output selected "$1" cannot generate debug info, deb'+
'ugging disabled'#000+
'11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+
'CPU'#010+
'Copyright (c) 1993-2007 by Florian Klaempfl'#000+
'11024_Free Pascal Compiler version $FPCVERSIO','N'#010+
'Copyright (c) 1993-2007 by Florian K','laempfl'#000+
'11024_Free Pascal Compiler version $FPCVERSION'#010+
#010+
'Compiler Date : $FPCDATE'#010+
'Compiler CPU Target: $FPCCPU'#010+
@ -834,194 +836,194 @@ const msgtxt : array[0..000192,1..240] of char=(
' $INSTRUCTIONSETS'#010+
#010+
'Supported FPU instruction sets:'#010+
' $FPUINSTRUCTIONSETS'#010+
' $FPUI','NSTRUCTIONSETS'#010+
#010+
'Supported Optimizations:'#010+
' $OPTIMIZAT','IONS'#010+
' $OPTIMIZATIONS'#010+
#010+
'This program comes under the GNU General Public Licence'#010+
'For more information read COPYING.FPC'#010+
#010+
'Report bugs,suggestions etc to:'#010+
' bugs@freepascal.org'#000+
'11025_**0*_Put + after a boolean switch option to enable it, - to disa',
'ble it'#010+
'11025_**0*_Put + ','after a boolean switch option to enable it, - to di'+
'sable it'#010+
'**1a_The compiler doesn'#039't delete the generated assembler file'#010+
'**2al_List sourcecode lines in assembler file'#010+
'**2an_List node info in assembler file'#010+
'*L2ap_Use pipes instead of creating temporary assembler files'#010+
'**2ar_List register allo','cation/release info in assembler file'#010+
'*L2ap_Use pipes instead of creati','ng temporary assembler files'#010+
'**2ar_List register allocation/release info in assembler file'#010+
'**2at_List temp allocation/release info in assembler file'#010+
'**1A<x>_Output format:'#010+
'**2Adefault_Use default assembler'#010+
'3*2Aas_Assemble using GNU AS'#010+
'3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+
'3*2Anasmelf_ELF','32 (Linux) file using Nasm'#010+
'3*2An','asmcoff_COFF (Go32v2) file using Nasm'#010+
'3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+
'3*2Anasmwin32_Win32 object file using Nasm'#010+
'3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+
'3*2Awasm_Obj file using Wasm (Watcom)'#010+
'3*2Anasmobj_Obj file using Nasm'#010+
'3*2Anasmobj_Obj file using Nas','m'#010+
'3*2Amasm_Obj file using Masm (Microsoft)'#010+
'3*2Atasm_O','bj file using Tasm (Borland)'#010+
'3*2Atasm_Obj file using Tasm (Borland)'#010+
'3*2Aelf_ELF (Linux) using internal writer'#010+
'3*2Acoff_COFF (Go32v2) using internal writer'#010+
'3*2Apecoff_PE-COFF (Win32) using internal writer'#010+
'4*2Aas_Assemble using GNU AS'#010+
'4*2Aas_Assemble using ','GNU AS'#010+
'6*2Aas_Unix o-file using GNU AS'#010+
'6*2Agas_GNU Mo','torola assembler'#010+
'6*2Agas_GNU Motorola assembler'#010+
'6*2Amit_MIT Syntax (old GAS)'#010+
'6*2Amot_Standard Motorola assembler'#010+
'A*2Aas_Assemble using GNU AS'#010+
'P*2Aas_Assemble using GNU AS'#010+
'S*2Aas_Assemble using GNU AS'#010+
'**1b_Generate browser info'#010+
'**1b_Generate brow','ser info'#010+
'**2bl_Generate local symbol info'#010+
'**1B_Build ','all modules'#010+
'**1B_Build all modules'#010+
'**1C<x>_Code generation options:'#010+
'**2Cc<x>_Set default calling convention to <x>'#010+
'**2CD_Create also dynamic library (not supported)'#010+
'**2Ce_Compilation with emulated floating point opcodes'#010+
'**2Cf<x>_Select fpu instruction set to use,',' see fpc -i for possible '+
'values'#010+
'**2Ce_Compilation with emulated floating poin','t opcodes'#010+
'**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+
'lues'#010+
'**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+
'**2Cg_Generate PIC code'#010+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
'**2Ci_IO-checking'#010+
'**2Ci_IO-c','hecking'#010+
'**2Cn_Omit linking stage'#010+
'**2Co_Check overflow',' of integer operations'#010+
'**2Co_Check overflow of integer operations'#010+
'**2CO_Check for possible overflow of integer operations'#010+
'**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+
'**2CP<x>=<y>_ packing settings'#010+
'**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2',', '+
'**3CPPACKSET=','<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, '+
'4 and 8'#010+
'**2Cr_Range checking'#010+
'**2CR_Verify object method call validity'#010+
'**2Cs<n>_Set stack size to <n>'#010+
'**2Ct_Stack checking'#010+
'**2CX_Create also smartlinked library'#010+
'**1d<x>_Defines the symbol <x>'#010+
'**1d<x>_Defines the symbo','l <x>'#010+
'**1D_Generate a DEF file'#010+
'**2Dd<x>_Set descripti','on to <x>'#010+
'**2Dd<x>_Set description to <x>'#010+
'**2Dv<x>_Set DLL version to <x>'#010+
'*O2Dw_PM application'#010+
'**1e<x>_Set path to executable'#010+
'**1E_Same as -Cn'#010+
'**1fPIC_Same as -Cg'#010+
'**1F<x>_Set file names and paths:'#010+
'**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
'sed'#010+
'*','*2Fc<x>_Set input codepage to <x>'#010+
'**2Fa<x>[,y]_(for a pr','ogram) load units <x> and [y] before uses is p'+
'arsed'#010+
'**2Fc<x>_Set input codepage to <x>'#010+
'**2FC<x>_Set RC compiler binary name to <x>'#010+
'**2FD<x>_Set the directory where to search for compiler utilities'#010+
'**2Fe<x>_Redirect error output to <x>'#010+
'**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
'**2FE<x>_','Set exe/unit output path to <x>'#010+
'**2Ff','<x>_Add <x> to framework path (Darwin only)'#010+
'**2FE<x>_Set exe/unit output path to <x>'#010+
'**2Fi<x>_Add <x> to include path'#010+
'**2Fl<x>_Add <x> to library path'#010+
'**2FL<x>_Use <x> as dynamic linker'#010+
'**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
'r'#010+
'**2Fm<x>_Load unicode conversion table from <x>.txt in',' the compiler '+
'dir'#010+
'**2Fo<x>_Add <x> to object path'#010+
'**2','Fr<x>_Load error message file <x>'#010+
'**2Fr<x>_Load error message file <x>'#010+
'**2FR<x>_Set resource (.res) linker to <x>'#010+
'**2Fu<x>_Add <x> to unit path'#010+
'**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
'*g1g_Generate debug information (default format for target)'#010+
'*g2gc_Generate checks',' for pointers'#010+
'*g1g_Generate debug informat','ion (default format for target)'#010+
'*g2gc_Generate checks for pointers'#010+
'*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
'*g2gl_Use line info unit (show more info with backtraces)'#010+
'*g2go<x>_Set debug information options'#010+
'*g3godwarfsets_ Enable Dwarf set debug information (breaks gdb < ','6.5'+
'*g3godwarfse','ts_ Enable Dwarf set debug information (breaks gdb < 6.5'+
')'#010+
'*g2gp_Preserve case in stabs symbol names'#010+
'*g2gs_Generate stabs debug information'#010+
'*g2gt_Trash local variables (to detect uninitialized uses)'#010+
'*g2gv_Generates programs traceable with valgrind'#010+
'*g2gw_Generate dwarf-2 debug information (same',' as -gw2)'#010+
'*g2gv_Generates programs traceable with va','lgrind'#010+
'*g2gw_Generate dwarf-2 debug information (same as -gw2)'#010+
'*g2gw2_Generate dwarf-2 debug information'#010+
'*g2gw3_Generate dwarf-3 debug information'#010+
'**1i_Information'#010+
'**2iD_Return compiler date'#010+
'**2iV_Return short compiler version'#010+
'**2iW_Return full compiler version'#010+
'**2iW_Return ','full compiler version'#010+
'**2iSO_Return compiler OS'#010+
'**2iS','P_Return compiler host processor'#010+
'**2iSP_Return compiler host processor'#010+
'**2iTO_Return target OS'#010+
'**2iTP_Return target processor'#010+
'**1I<x>_Add <x> to include path'#010+
'**1k<x>_Pass <x> to the linker'#010+
'**1l_Write logo'#010+
'**1M<x>_Set language mode to <x>'#010+
'**1M<x>_Set language',' mode to <x>'#010+
'**2Mfpc_Free Pascal dialect (default)'#010+
'**','2Mobjfpc_FPC mode with Object Pascal support'#010+
'**2Mobjfpc_FPC mode with Object Pascal support'#010+
'**2Mdelphi_Delphi 7 compatibility mode'#010+
'**2Mtp_TP/BP 7.0 compatibility mode'#010+
'**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+
'**1n_Do not read the default config files'#010+
'**1N<x>_Node tree opti','mizations'#010+
'**1n_Do not',' read the default config files'#010+
'**1N<x>_Node tree optimizations'#010+
'**2Nu_Unroll loops'#010+
'**1o<x>_Change the name of the executable produced to <x>'#010+
'**1O<x>_Optimizations:'#010+
'**2O-_Disable optimizations'#010+
'**2O1_Level 1 optimizations (quick and debugger friendly)'#010+
'**2O2_Level 2 optimizations (-O1 + quick opt','imizations)'#010+
'**2O1_Level 1 optimizations (quick and debugger f','riendly)'#010+
'**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
'**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
'**2Oa<x>=<y>_Set alignment'#010+
'**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
'values'#010+
'**2Op<x>_Set target cpu for optimizing, see fpc -i for possible value',
's'#010+
'**2Op<x>_Set tar','get cpu for optimizing, see fpc -i for possible valu'+
'es'#010+
'**2Os_Optimize for size rather than speed'#010+
'**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
'**1R<x>_Assembler reading style:'#010+
'**2Rdefault_Use default assembler for target'#010+
'3*2Ratt_Read AT&T style assembler'#010+
'3*2Rintel_Read Intel sty','le assembler'#010+
'3*2Ra','tt_Read AT&T style assembler'#010+
'3*2Rintel_Read Intel style assembler'#010+
'6*2RMOT_Read motorola style assembler'#010+
'**1S<x>_Syntax options:'#010+
'**2S2_Same as -Mobjfpc'#010+
'**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
'**2Sa_Turn on assertions'#010+
'**2Sd_Same as -Mdelphi'#010+
'**2Se<x>_Error options. <x> is a combination ','of the following:'#010+
'**2Sd_Same as -','Mdelphi'#010+
'**2Se<x>_Error options. <x> is a combination of the following:'#010+
'**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
'**3*_w : Compiler also halts after warnings'#010+
'**3*_n : Compiler also halts after notes'#010+
'**3*_h : Compiler also halts after hints'#010+
'**2Sg_Enable LABEL and GOTO (defau','lt in -Mtp and -Mdelphi)'#010+
'**3*_h : Compiler also',' halts after hints'#010+
'**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+
'**2Sh_Use ansistrings by default instead of shortstrings'#010+
'**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
'**2Sk_Load fpcylix unit'#010+
'**2SI<x>_Set interface style to <x>'#010+
'**3SIcom_COM compatible interf','ace (default)'#010+
'**2SI<x>_Set ','interface style to <x>'#010+
'**3SIcom_COM compatible interface (default)'#010+
'**3SIcorba_CORBA compatible interface'#010+
'**2Sm_Support macros like C (global)'#010+
'**2So_Same as -Mtp'#010+
'**2Ss_Constructor name must be init (destructor must be done)'#010+
'**2St_Allow static keyword in objects'#010+
'**2Sx_Enable exception keywords ','(default in Delphi/ObjFPC modes)'#010+
'**2St_Allow stati','c keyword in objects'#010+
'**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+
'**1s_Do not call assembler and linker'#010+
'**2sh_Generate script to link on host'#010+
'**2st_Generate script to link on target'#010+
'**2sr_Skip register allocation phase (use with -alr)'#010+
'**2sr_Skip register allocation phase (','use with -alr)'#010+
'**1T<x>_Target operating system:'#010+
'3*2Te','mx_OS/2 via EMX (including EMX/RSX extender)'#010+
'3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
'3*2Tfreebsd_FreeBSD'#010+
'3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
'3*2Tlinux_Linux'#010+
'3*2Tnetbsd_NetBSD'#010+
'3*2Tnetware_Novell Netware Module (clib)'#010+
'3*2Tnetware_Novell Netware Module (clib)',#010+
'3*2Tnetwlibc_Novell Netware Module (libc)'#010+
'3*2Topenbs','d_OpenBSD'#010+
'3*2Topenbsd_OpenBSD'#010+
'3*2Tos2_OS/2 / eComStation'#010+
'3*2Tsunos_SunOS/Solaris'#010+
'3*2Tsymbian_Symbian OS'#010+
'3*2Twatcom_Watcom compatible DOS extender'#010+
'3*2Twdosx_WDOSX DOS extender'#010+
'3*2Twin32_Windows 32 Bit'#010+
'3*2Twince_Windows CE'#010+
'3*2Twin','ce_Windows CE'#010+
'4*2Tlinux_Linux'#010+
'6*2Tamiga_Commodore Ami','ga'#010+
'6*2Tamiga_Commodore Amiga'#010+
'6*2Tatari_Atari ST/STe/TT'#010+
'6*2Tlinux_Linux/m68k'#010+
'6*2Tmacos_Macintosh m68k (not supported)'#010+
@ -1029,76 +1031,75 @@ const msgtxt : array[0..000192,1..240] of char=(
'A*2Tlinux_Linux'#010+
'A*2Twince_Windows CE'#010+
'P*2Tamiga_AmigaOS on PowerPC'#010+
'P*2Tdarwin_Darwin and Mac OS X on PowerPC'#010+
'P*2Tlinux_Linux on Powe','rPC'#010+
'P*2Tdarwin_D','arwin and Mac OS X on PowerPC'#010+
'P*2Tlinux_Linux on PowerPC'#010+
'P*2Tmacos_Mac OS (classic) on PowerPC'#010+
'P*2Tmorphos_MorphOS'#010+
'S*2Tlinux_Linux'#010+
'**1u<x>_Undefines the symbol <x>'#010+
'**1U_Unit options:'#010+
'**2Un_Do not check where the unit name matches the file name'#010+
'**2Ur_Generate release unit files (never automati','cally recompiled)'#010+
'**2Un_Do not check where the unit name matches the file n','ame'#010+
'**2Ur_Generate release unit files (never automatically recompiled)'#010+
'**2Us_Compile a system unit'#010+
'**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
'**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+
'**2*_w : Show warnings u : Show unit info'#010+
'*','*2*_n : Show notes t : Show tried/used files'#010+
'**2*','_w : Show warnings u : Show unit info'#010+
'**2*_n : Show notes t : Show tried/used files'#010+
'**2*_h : Show hints c : Show conditionals'#010+
'**2*_i : Show general info d : Show debug info'#010+
'**2*_l : Show linenumbers r : Rhide/GCC compatibili','ty mod'+
'**2*_l : ','Show linenumbers r : Rhide/GCC compatibility mod'+
'e'#010+
'**2*_a : Show everything x : Executable info (Win32 only)'#010+
'**2*_b : Write file names messages with full path'#010+
'**2*_v : Write fpcdebug.txt with p : Write tree.log with parse tre'+
'e'#010+
'**2*_v : Write fpcdebug.txt with p : Write tree.log wit','h parse t'+
'ree'#010+
'**2*_ lots of debugging info'#010+
'3*1W<x>_','Target-specific options (targets)'#010+
'3*1W<x>_Target-specific options (targets)'#010+
'A*1W<x>_Target-specific options (targets)'#010+
'P*1W<x>_Target-specific options (targets)'#010+
'3*2Wb_Create a bundle instead of a library (Darwin)'#010+
'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
'p*2Wb_Create a bun','dle instead of a library (Darwin)'#010+
'P*2Wb_Create a bu','ndle instead of a library (Darwin)'#010+
'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
'3*2WB_Create a relocatable image (Windows)'#010+
'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
'3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
'3*2WC_Specify console type application (EMX, OS/2, Windows',')'#010+
'A*2WC_Specify console type application (Windows)'#010+
'P*','2WC_Specify console type application (Classic Mac OS)'#010+
'P*2WC_Specify console type application (Classic Mac OS)'#010+
'3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
'3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
'3*2WG_S','pecify graphic type application (EMX, OS/2, Windows)'#010+
'3*2WF_Spe','cify full-screen type application (EMX, OS/2)'#010+
'3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
'A*2WG_Specify graphic type application (Windows)'#010+
'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
'3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
'A*2WN_Do not',' generate relocation code, needed for debugging (Windows'+
'3*2WN_Do not generate relocat','ion code, needed for debugging (Windows'+
')'#010+
'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
'3*2WR_Generate relocation code (Windows)'#010+
'A*2WR_Generate relocation code (Windows)'#010+
'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+
'P*2WT_Specify MPW tool type application (Classi','c Mac OS)'#010+
'**1X_Executable options:'#010+
'**2Xc_Pass --share','d/-dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
'inux)'#010+
'**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
'ux)'#010+
'**2Xd_Do not use standard library search path (needed for cross compil'+
'e)'#010+
'**2Xe_Use external linker'#010+
'**2Xg_Create debuginfo in a separate file and add a debuglink section '+
'to executable'#010+
'*','*2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+
'**2Xg_Create debuginfo in a sepa','rate file and add a debuglink sectio'+
'n to executable'#010+
'**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+
'**2Xi_Use internal linker'#010+
'**2Xm_Generate link map'#010+
'**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
's '#039'main'#039')'#010+
'**2XP<x>_Prepend the binutils names with the prefix',' <x>'#010+
's '#039'main'#039,')'#010+
'**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
'**2Xr<x>_Set library search path to <x> (needed for cross compile) (Be'+
'OS, Linux)'#010+
'**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
', Linux, Mac OS, Solaris)'#010+
'**2Xs_Strip all symbols from executable'#010+
'**2XS_Try to link ','units statically (default, defines FPC_LINK_STATIC'+
')'#010+
'**2Xs','_Strip all symbols from executable'#010+
'**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
'**2Xt_Link with static libraries (-static is passed to linker)'#010+
'**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+
'**1*_'#010+
'**1*_'#010,
'**1?_Show this help'#010+
'**1h_Shows this help without wait','ing'#000
'**1h_Shows this help without waiting'#000
);

5
compiler/ncal.pas
View File

@ -206,7 +206,7 @@ implementation
symconst,defutil,defcmp,
htypechk,pass_1,
ncnv,nld,ninl,nadd,ncon,nmem,nset,
procinfo,
procinfo,cpuinfo,
cgbase
;
@ -332,7 +332,8 @@ implementation
typecheckpass(para.left);
end
{ force automatable float type }
else if is_extended(para.left.resultdef) then
else if is_extended(para.left.resultdef)
and (current_settings.fputype<>fpu_none) then
begin
para.left:=ctypeconvnode.create_internal(para.left,s64floattype);
typecheckpass(para.left);

6
compiler/ncnv.pas
View File

@ -585,9 +585,9 @@ implementation
p:=ctypeconvnode.create(p,s32inttype)
else if is_void(p.resultdef) then
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename)
else if iscvarargs and
is_currency(p.resultdef) then
p:=ctypeconvnode.create(p,s64floattype);
else if iscvarargs and is_currency(p.resultdef)
and (current_settings.fputype<>fpu_none) then
p:=ctypeconvnode.create(p,s64floattype);
end;
floatdef :
if not(iscvarargs) then

2
compiler/ncon.pas
View File

@ -472,6 +472,8 @@ implementation
{ i386 }
constructor trealconstnode.create(v : bestreal;def:tdef);
begin
if current_settings.fputype=fpu_none then
internalerror(2008022401);
inherited create(realconstn);
typedef:=def;
value_real:=v;

48
compiler/options.pas
View File

@ -2193,9 +2193,6 @@ begin
def_system_macro('CPU68K');
def_system_macro('CPUM68K');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
@ -2207,9 +2204,6 @@ begin
def_system_macro('CPUPOWERPC');
def_system_macro('CPUPOWERPC32');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
@ -2217,9 +2211,6 @@ begin
def_system_macro('CPUPOWERPC');
def_system_macro('CPUPOWERPC64');
def_system_macro('CPU64');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
@ -2233,27 +2224,17 @@ begin
def_system_macro('CPU64');
{ not supported for now, afaik (FK)
def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
{ win64 doesn't support the legacy fpu }
if target_info.system<>system_x86_64_win64 then
def_system_macro('FPC_HAS_TYPE_EXTENDED')
else
if target_info.system=system_x86_64_win64 then
begin
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
undef_system_macro('FPC_HAS_TYPE_EXTENDED');
end;
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
{$endif}
{$ifdef sparc}
def_system_macro('CPUSPARC');
def_system_macro('CPUSPARC32');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
@ -2264,18 +2245,12 @@ begin
{$ifdef arm}
def_system_macro('CPUARM');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif arm}
{$ifdef avr}
def_system_macro('CPUAVR');
def_system_macro('CPU16');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif avr}
@ -2478,6 +2453,27 @@ begin
def_system_macro('CPU'+Cputypestr[init_settings.cputype]);
def_system_macro('FPU'+fputypestr[init_settings.fputype]);
{$if defined(i386) or defined(m68k) or defined(powerpc) or defined(powerpc64)
or defined(sparc) or defined(arm) or defined(avr)}
if init_settings.fputype<>fpu_none then
begin
{$if defined(i386)}
def_system_macro('FPC_HAS_TYPE_EXTENDED');
{$endif}
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
{$if not defined(i386) and not defined(x86_64)}
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
{$endif}
{$ifdef x86_64}
{ win64 doesn't support the legacy fpu }
if target_info.system=system_x86_64_win64 then
undef_system_macro('FPC_HAS_TYPE_EXTENDED')
else
def_system_macro('FPC_HAS_TYPE_EXTENDED');
{$endif}
end;
{$endif}
{$ifdef ARM}
{ define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL }

2
compiler/pexpr.pas
View File

@ -2343,6 +2343,8 @@ implementation
end;
consume(_REALNUMBER);
{$ifdef FPC_REAL2REAL_FIXED}
if current_settings.fputype=fpu_none then
Message(parser_e_unsupported_real);
if (current_settings.minfpconstprec=s32real) and
(d = single(d)) then
p1:=crealconstnode.create(d,s32floattype)

3
compiler/powerpc/cpuinfo.pas
View File

@ -65,7 +65,8 @@ Const
'970'
);
fputypestr : array[tfputype] of string[8] = ('',
fputypestr : array[tfputype] of string[8] = (
'NONE',
'SOFT',
'STANDARD'
);

59
compiler/psystem.pas
View File

@ -40,7 +40,7 @@ interface
implementation
uses
globals,globtype,verbose,constexp,
globals,globtype,verbose,constexp,cpuinfo,
systems,
symconst,symtype,symsym,symdef,symtable,
aasmtai,aasmdata,aasmcpu,
@ -116,6 +116,20 @@ implementation
systemunit.insert(result);
end;
procedure create_fpu_types;
begin
if init_settings.fputype<>fpu_none then
begin
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
end else begin
s32floattype:=nil;
s64floattype:=nil;
s80floattype:=nil;
end;
end;
var
hrecst : trecordsymtable;
begin
@ -150,9 +164,7 @@ implementation
openchararraytype:=tarraydef.create(0,-1,s32inttype);
tarraydef(openchararraytype).elementdef:=cchartype;
{$ifdef x86}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
if target_info.system<>system_x86_64_win64 then
s64currencytype:=tfloatdef.create(s64currency)
else
@ -162,33 +174,23 @@ implementation
end;
{$endif x86}
{$ifdef powerpc}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
{$endif powerpc}
{$ifdef POWERPC64}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
{$endif POWERPC64}
{$ifdef sparc}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
{$endif sparc}
{$ifdef m68k}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
{$endif}
{$ifdef arm}
s32floattype:=tfloatdef.create(s32real);
s64floattype:=tfloatdef.create(s64real);
s80floattype:=tfloatdef.create(s80real);
create_fpu_types;
s64currencytype:=torddef.create(scurrency,low(int64),high(int64));
{$endif arm}
{$ifdef avr}
@ -240,6 +242,7 @@ implementation
else
*)
{$endif cpufpemu}
if init_settings.fputype <> fpu_none then
begin
addtype('Single',s32floattype);
addtype('Double',s64floattype);
@ -316,9 +319,12 @@ implementation
addtype('$file',cfiletype);
addtype('$variant',cvarianttype);
addtype('$olevariant',cvarianttype);
addtype('$s32real',s32floattype);
addtype('$s64real',s64floattype);
addtype('$s80real',s80floattype);
if init_settings.fputype<>fpu_none then
begin
addtype('$s32real',s32floattype);
addtype('$s64real',s64floattype);
addtype('$s80real',s80floattype);
end;
addtype('$s64currency',s64currencytype);
{ Add a type for virtual method tables }
hrecst:=trecordsymtable.create(current_settings.packrecords);
@ -396,9 +402,12 @@ implementation
loadtype('unicodestring',cunicodestringtype);
loadtype('openshortstring',openshortstringtype);
loadtype('openchararray',openchararraytype);
loadtype('s32real',s32floattype);
loadtype('s64real',s64floattype);
loadtype('s80real',s80floattype);
if init_settings.fputype <> fpu_none then
begin
loadtype('s32real',s32floattype);
loadtype('s64real',s64floattype);
loadtype('s80real',s80floattype);
end;
loadtype('s64currency',s64currencytype);
loadtype('boolean',booltype);
loadtype('boolean8',bool8type);

2
compiler/systems/i_linux.pas
View File

@ -632,7 +632,7 @@ unit i_linux;
res : res_none;
dbg : dbg_stabs;
script : script_unix;
endian : endian_little;
endian : endian_big;
alignment :
(
procalign : 4;

4
rtl/inc/astrings.inc
View File

@ -821,6 +821,7 @@ begin
end;
{$ifndef FPUNONE}
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; compilerproc;
Var
SS : String;
@ -834,6 +835,7 @@ begin
Val(SS,fpc_Val_Real_AnsiStr,code);
end;
end;
{$endif}
Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_ANSISTR']; compilerproc;
@ -917,6 +919,7 @@ end;
{$endif CPU64}
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var
ss: ShortString;
@ -924,6 +927,7 @@ begin
str_real(len,fr,d,treal_type(rt),ss);
s:=ss;
end;
{$endif}
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}

20
rtl/inc/compproc.inc
View File

@ -103,7 +103,9 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; dimcount : dword
{ Str() support }
procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); compilerproc;
{$ifndef FPUNONE}
procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
{$endif}
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);compilerproc;
procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstring); compilerproc;
@ -112,7 +114,9 @@ procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of char); c
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
{$endif}
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
@ -138,31 +142,41 @@ procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; out S : WideString); compi
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$endif CPU64}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPUNONE}
procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
{$endif}
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPUNONE}
procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of char); compilerproc;
{$endif}
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of char);compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{ Val() support }
{$ifndef FPUNONE}
Function fpc_Val_Real_ShortStr(const s : shortstring; out code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_Shortstr(Const S: ShortString; out Code: ValSInt): ValUInt; compilerproc;
function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; compilerproc;
Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
{$ifndef FPUNONE}
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPUNONE}
Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;
{$endif}
Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;out code:valsint):longint;compilerproc;
@ -317,7 +331,9 @@ Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); compilerp
procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerproc;
procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
{$endif CPU64}
{$ifndef FPUNONE}
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
{$endif}
procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); compilerproc;
@ -360,7 +376,9 @@ Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); compilerproc;
Procedure fpc_Read_Text_Char(var f : Text; out c : char); compilerproc;
Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
{$ifndef FPUNONE}
Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
{$endif}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
{$ifndef CPU64}
@ -391,6 +409,7 @@ function fpc_shl_int64(value,shift : int64) : int64; compilerproc;
function fpc_shr_int64(value,shift : int64) : int64; compilerproc;
{$endif FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
{$ifndef FPUNONE}
function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
@ -404,6 +423,7 @@ function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inl
function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
function fpc_round_real(d : ValReal) : int64;compilerproc;
function fpc_trunc_real(d : ValReal) : int64;compilerproc;
{$endif}
{$ifdef FPC_HAS_FEATURE_CLASSES}
function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;

16
rtl/inc/ctypes.pp
View File

@ -72,9 +72,16 @@ type
culong = cardinal; pculong = ^culong;
{$endif}
// Kylix compat types
u_long = culong;
u_short = cushort;
{$ifndef FPUNONE}
cfloat = single; pcfloat = ^cfloat;
cdouble = double; pcdouble = ^cdouble;
{$endif}
{$endif}
{$ifdef defined(win64) or defined(wince)}
{$define longdouble_is_double}
@ -84,6 +91,7 @@ type
{$define longdouble_is_double}
{$endif}
{$ifndef FPUNONE}
{$ifdef longdouble_is_double}
clongdouble=double;
{$else}
@ -104,11 +112,6 @@ type
{$endif}
Pclongdouble=^clongdouble;
// Kylix compat types
u_long = culong;
u_short = cushort;
{$ifdef longdouble_assignment_overload_real80}
operator := (const v:clongdouble) r:extended;inline;
operator := (const v:extended) r:clongdouble;inline;
@ -157,9 +160,11 @@ operator <=(const e:Double;const c:clongdouble) r:boolean;inline;
operator <=(const c:clongdouble;const e:Double) r:boolean;inline;
{$endif dummy}
{$endif}
{$endif FPUNONE}
implementation
{$ifndef FPUNONE}
{$ifdef longdouble_assignment_overload_real80}
operator := (const v:clongdouble) r:extended;
@ -385,5 +390,6 @@ begin
end;
{$endif}
{$endif}
{$endif FPUNONE}
end.

2
rtl/inc/generic.inc
View File

@ -1684,6 +1684,7 @@ end;
{$endif ndef FPC_SYSTEM_HAS_INT_STR_QWORD}
{$ifndef FPUNONE}
{$ifndef FPC_SYSTEM_HAS_SYSRESETFPU}
procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -1701,6 +1702,7 @@ begin
end;
{$endif FPC_SYSTEM_HAS_SYSINITFPU}
{$endif}
{$ifndef FPC_SYSTEM_HAS_SWAPENDIAN}
function SwapEndian(const AValue: SmallInt): SmallInt;

49
rtl/inc/genmath.inc
View File

@ -965,55 +965,6 @@ invalid:
{$endif FPC_SYSTEM_HAS_EXP}
{$ifdef FPC_CURRENCY_IS_INT64}
function trunc(c : currency) : int64;
type
tmyrec = record
i: int64;
end;
begin
result := int64(tmyrec(c)) div 10000
end;
function trunc(c : comp) : int64;
begin
result := c
end;
function round(c : currency) : int64;
type
tmyrec = record
i: int64;
end;
var
rem, absrem: longint;
begin
{ (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
result := int64(tmyrec(c)) div 10000;
rem := int64(tmyrec(c)) - result * 10000;
absrem := abs(rem);
if (absrem > 5000) or
((absrem = 5000) and
(rem > 0)) then
if (rem > 0) then
inc(result)
else
dec(result);
end;
function round(c : comp) : int64;
begin
result := c
end;
{$endif FPC_CURRENCY_IS_INT64}
{$ifndef FPC_SYSTEM_HAS_LN}
function fpc_ln_real(d:ValReal):ValReal;compilerproc;
{*****************************************************************}

4
rtl/inc/macpas.pp
View File

@ -25,7 +25,9 @@ interface
{$define SYSTEMINLINE}
type
{$ifndef FPUNONE}
LongDouble = ValReal;
{$endif}
FourCharArray = packed array[1..4] of char;
UnsignedByte = Byte;
@ -387,9 +389,11 @@ end;
{$ifdef cpupowerpc}
{$ifndef FPUNONE}
begin
asm
mtfsfi 6,1
end;
{$endif}
{$endif cpupowerpc}
end.

7
rtl/inc/mathh.inc
View File

@ -70,13 +70,6 @@ procedure float_raise(i: shortint);
function int(d : ValReal) : ValReal;[internproc:fpc_in_int_real];
function trunc(d : ValReal) : int64;[internproc:fpc_in_trunc_real];
{$ifdef FPC_CURRENCY_IS_INT64}
function trunc(c : currency) : int64;
function trunc(c : comp) : int64;
function round(c : currency) : int64;
function round(c : comp) : int64;
{$endif FPC_CURRENCY_IS_INT64}
{$ifdef SUPPORT_EXTENDED}
function FPower10(val: Extended; Power: Longint): Extended;
{$endif SUPPORT_EXTENDED}

4
rtl/inc/matrix.pp
View File

@ -31,6 +31,7 @@ interface
{*****************************************************************************}
{$ifndef FPUNONE}
{$MACRO on}
type Tvector2_single_data=array[0..1] of single;
@ -820,4 +821,7 @@ implementation
{$INFO Compile mmatimp.inc for Tmatrix4_extended}
{$i mmatimp.inc}
{$else}
implementation
{$endif FPUNONE}
end.

4
rtl/inc/objpash.inc
View File

@ -304,7 +304,9 @@
vtInteger = 0;
vtBoolean = 1;
vtChar = 2;
{$ifndef FPUNONE}
vtExtended = 3;
{$endif}
vtString = 4;
vtPointer = 5;
vtPChar = 6;
@ -335,7 +337,9 @@
vtChar : (VChar: Char);
vtWideChar : (VWideChar: WideChar);
{$endif ENDIAN_BIG}
{$ifndef FPUNONE}
vtExtended : (VExtended: PExtended);
{$endif}
vtString : (VString: PShortString);
vtPointer : (VPointer: Pointer);
vtPChar : (VPChar: PChar);

10
rtl/inc/sstrings.inc
View File

@ -396,12 +396,16 @@ end;
{ it's used inside real2str.inc and otherwise the searching via the }
{ compilerproc name will fail (JM) }
{$ifndef FPUNONE}
{$I real2str.inc}
{$endif}
{$ifndef FPUNONE}
procedure fpc_shortstr_float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT']; compilerproc;
begin
str_real(len,fr,d,treal_type(rt),s);
end;
{$endif}
procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);[public,alias:'FPC_SHORTSTR_ENUM'];compilerproc;
@ -723,6 +727,7 @@ end;
{$endif CPU64}
{$ifndef FPUNONE}
procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of char);compilerproc;
var
ss : shortstring;
@ -735,6 +740,7 @@ begin
maxlen:=high(a)+1;
move(ss[1],pchar(@a)^,maxlen);
end;
{$endif}
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of char);compilerproc;
@ -1014,6 +1020,7 @@ end;
{$endif CPU64}
{$ifndef FPUNONE}
const
{$ifdef FPC_HAS_TYPE_EXTENDED}
valmaxexpnorm=4932;
@ -1028,7 +1035,9 @@ const
{$endif}
{$endif}
{$endif}
{$endif}
{$ifndef FPUNONE}
Function fpc_Val_Real_ShortStr(const s : shortstring; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; compilerproc;
var
hd,
@ -1142,6 +1151,7 @@ begin
{ success ! }
code:=0;
end;
{$endif}
function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_SHORTSTR']; compilerproc;

6
rtl/inc/system.inc
View File

@ -293,6 +293,7 @@ begin
end;
{$endif SUPPORT_EXTENDED}
{$ifndef FPUNONE}
{$ifdef FPC_USE_LIBC}
{ Include libc versions }
{$i cgenmath.inc}
@ -301,6 +302,9 @@ end;
{$I math.inc}
{ Include generic version }
{$I genmath.inc}
{$endif}
{$i gencurr.inc}
function aligntoptr(p : pointer) : pointer;inline;
@ -542,10 +546,12 @@ begin
random := 0;
end;
{$ifndef FPUNONE}
function random: extended;
begin
random := cardinal(genrand_MT19937) * (1.0/(int64(1) shl 32));
end;
{$endif}
{****************************************************************************
Memory Management

52
rtl/inc/systemh.inc
View File

@ -89,9 +89,11 @@ Type
{ moved here from psystem.pas
Delphi allows chose of overloaded procedure depending
on Real <-> Double, so use type here, see also tw7425.pp (FK) }
{$ifndef FPUNONE}
{$ifndef VER2_0}
Real = type Double;
{$endif VER2_0}
{$endif}
{$ifdef CPUI386}
{$define CPU32}
@ -103,7 +105,9 @@ Type
{$define SUPPORT_EXTENDED}
{$define SUPPORT_COMP}
ValReal = Extended;
{$ifndef FPUNONE}
ValReal = Extended;
{$endif}
{$endif CPUI386}
{$ifdef CPUX86_64}
@ -112,10 +116,14 @@ Type
{$define DEFAULT_EXTENDED}
{$define SUPPORT_EXTENDED}
{$define SUPPORT_COMP}
ValReal = Extended;
{$ifndef FPUNONE}
ValReal = Extended;
{$endif}
{$else WIN64}
{$define DEFAULT_DOUBLE}
ValReal = Double;
{$ifndef FPUNONE}
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
@ -133,7 +141,9 @@ Type
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
ValReal = Real;
{$ifndef FPUNONE}
ValReal = Real;
{$endif}
{ Comp type does not exist on fpu }
Comp = int64;
@ -145,12 +155,14 @@ Type
{$ifdef CPUPOWERPC}
{$define DEFAULT_DOUBLE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$ifndef FPUNONE}
{$define SUPPORT_SINGLE}
{$define SUPPORT_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
ValReal = Double;
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
@ -167,7 +179,9 @@ Type
{$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
ValReal = Double;
{$ifndef FPUNONE}
ValReal = Double;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
@ -186,7 +200,9 @@ Type
{$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
{$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
ValReal = Real;
{$ifndef FPUNONE}
ValReal = Real;
{$endif}
{ map comp to int64, but this doesn't mean we compile the comp support in! }
Comp = Int64;
@ -262,16 +278,20 @@ Type
PUTF8String = ^UTF8String;
HRESULT = type Longint;
{$ifndef FPUNONE}
TDateTime = type Double;
{$endif}
TError = type Longint;
{$ifndef FPUNONE}
PSingle = ^Single;
PDouble = ^Double;
PExtended = ^Extended;
{$endif}
PCurrency = ^Currency;
{$ifdef SUPPORT_COMP}
PComp = ^Comp;
{$endif SUPPORT_COMP}
PExtended = ^Extended;
PSmallInt = ^Smallint;
PShortInt = ^Shortint;
@ -298,8 +318,10 @@ Type
PShortString = ^ShortString;
PAnsiString = ^AnsiString;
{$ifndef FPUNONE}
PDate = ^TDateTime;
PDateTime = ^TDateTime;
{$endif}
PError = ^TError;
PVariant = ^Variant;
POleVariant = ^OleVariant;
@ -506,7 +528,9 @@ Function Align (Addr : Pointer; Alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINL
{$ifdef FPC_HAS_FEATURE_RANDOM}
Function Random(l:longint):longint;
Function Random(l:int64):int64;
{$ifndef FPUNONE}
Function Random: extended;
{$endif}
Procedure Randomize;
{$endif FPC_HAS_FEATURE_RANDOM}
@ -560,8 +584,12 @@ function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifndef FPUNONE}
{ float math routines }
{$I mathh.inc}
{$endif}
{ currency math routines }
{$I currh.inc}
{****************************************************************************
Addr/Pointer Handling
@ -841,8 +869,10 @@ Procedure SysInitExceptions;
{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
procedure SysInitStdIO;
{$endif FPC_HAS_FEATURE_CONSOLEIO}
{$ifndef FPUNONE}
Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
{*****************************************************************************
Abstract/Assert/Error Handling

8
rtl/inc/text.inc
View File

@ -689,6 +689,7 @@ end;
{$endif CPU64}
{$ifndef FPUNONE}
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); iocheck; [Public,Alias:'FPC_WRITE_TEXT_FLOAT']; compilerproc;
var
s : String;
@ -698,6 +699,7 @@ Begin
Str_real(Len,fixkomma,r,treal_type(rt),s);
Write_Str(Len,t,s);
End;
{$endif}
procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); iocheck; [Public,Alias:'FPC_WRITE_TEXT_ENUM']; compilerproc;
@ -1163,6 +1165,7 @@ Begin
End;
{$ifndef FPUNONE}
procedure fpc_Read_Text_Float(var f : Text; out v : ValReal); iocheck; [Public,Alias:'FPC_READ_TEXT_FLOAT']; compilerproc;
var
hs : string;
@ -1184,6 +1187,7 @@ begin
If code<>0 Then
InOutRes:=106;
end;
{$endif}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); iocheck; [Public,Alias:'FPC_READ_TEXT_ENUM'];compilerproc;
@ -1211,7 +1215,11 @@ var
hs : string;
code : Word;
begin
{$ifdef FPUNONE}
v:=0;
{$else}
v:=0.0;
{$endif}
If not CheckRead(f) then
exit;
hs:='';

2
rtl/inc/thread.inc
View File

@ -23,8 +23,10 @@ Var
procedure InitThread(stklen:SizeUInt);
begin
{$ifndef FPUNONE}
SysResetFPU;
SysInitFPU;
{$endif}
{$ifndef HAS_MEMORYMANAGER}
{ initialize this thread's heap }
InitHeapThread;

4
rtl/inc/ucomplex.pp
View File

@ -24,6 +24,7 @@ Unit UComplex;
interface
{$ifndef FPUNONE}
uses math;
type complex = record
@ -633,4 +634,7 @@ Unit UComplex;
end;
{$else}
implementation
{$endif FPUNONE}
end.

20
rtl/inc/variant.inc
View File

@ -279,10 +279,12 @@ end;
{$ifndef VER2_0}
{$ifndef FPUNONE}
Operator :=(const source : real) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
VariantManager.VarFromReal(Dest,Source);
end;
{$endif}
{$endif VER2_0}
@ -293,10 +295,12 @@ operator :=(const source : currency) dest : variant;{$ifdef SYSTEMINLINE}inline;
end;
{$ifndef FPUNONE}
operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
VariantManager.VarFromTDateTime(Dest,Source);
end;
{$endif}
operator :=(const source : terror) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -460,10 +464,12 @@ end;
{$ifndef VER2_0}
{$ifndef FPUNONE}
operator :=(const source : variant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
dest:=variantmanager.vartoreal(source);
end;
{$endif}
{$endif VER2_0}
{ Misc. }
@ -473,10 +479,12 @@ operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;
end;
{$ifndef FPUNONE}
operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
dest:=variantmanager.vartotdatetime(source);
end;
{$endif}
{$ifndef FPC_HASINTERNALOLEVARIANT2VARIANTCAST}
operator :=(const source : olevariant) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -783,17 +791,23 @@ operator :=(const source : olevariant) dest : extended;{$ifdef SYSTEMINLINE}inli
{$ifdef SUPPORT_COMP}
operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$ifdef FPUNONE}
dest:=comp(variantmanager.vartoint64(variant(tvardata(source))));
{$else}
dest:=comp(variantmanager.vartoreal(variant(tvardata(source))));
{$endif}
end;
{$endif SUPPORT_COMP}
{$ifndef FPUNONE}
{$ifndef VER2_0}
operator :=(const source : olevariant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
dest:=variantmanager.vartoreal(variant(tvardata(source)));
end;
{$endif VER2_0}
{$endif}
{ Misc. }
operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -802,10 +816,12 @@ operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inli
end;
{$ifndef FPUNONE}
operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
dest:=variantmanager.vartotdatetime(variant(tvardata(source)));
end;
{$endif}
operator :=(const source : olevariant) dest : terror;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -949,10 +965,12 @@ operator :=(const source : comp) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{
{$ifndef VER2_0}
{$ifndef FPUNONE}
operator :=(const source : real) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
variantmanager.varfromreal(variant(tvardata(dest)),source);
end;
{$endif}
{$endif VER2_0}
@ -963,10 +981,12 @@ operator :=(const source : currency) dest : olevariant;{$ifdef SYSTEMINLINE}inli
end;
{$ifndef FPUNONE}
operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
variantmanager.varfromtdatetime(variant(tvardata(dest)),source);
end;
{$endif}
operator :=(const source : terror) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}

28
rtl/inc/varianth.inc
View File

@ -18,10 +18,12 @@ const
varnull = 1;
varsmallint = 2;
varinteger = 3;
{$ifndef FPUNONE}
varsingle = 4;
vardouble = 5;
varcurrency = 6;
vardate = 7;
{$endif}
varcurrency = 6;
varolestr = 8;
vardispatch = 9;
varerror = 10;
@ -85,10 +87,12 @@ type
case word of
varsmallint : (vsmallint : smallint);
varinteger : (vinteger : longint);
{$ifndef FPUNONE}
varsingle : (vsingle : single);
vardouble : (vdouble : double);
varcurrency : (vcurrency : currency);
vardate : (vdate : tdatetime);
{$endif}
varcurrency : (vcurrency : currency);
varolestr : (volestr : pwidechar);
vardispatch : (vdispatch : pointer);
varerror : (verror : hresult);
@ -138,8 +142,10 @@ type
vartoint64 : function(const v : variant) : int64;
vartoword64 : function(const v : variant) : qword;
vartobool : function(const v : variant) : boolean;
{$ifndef FPUNONE}
vartoreal : function(const v : variant) : extended;
vartotdatetime : function(const v : variant) : tdatetime;
{$endif}
vartocurr : function(const v : variant) : currency;
vartopstr : procedure(var s ;const v : variant);
vartolstr : procedure(var s : ansistring;const v : variant);
@ -153,8 +159,10 @@ type
varfromint : procedure(var dest : variant;const source,Range : longint);
varfromint64 : procedure(var dest : variant;const source : int64);
varfromword64 : procedure(var dest : variant;const source : qword);
{$ifndef FPUNONE}
varfromreal : procedure(var dest : variant;const source : extended);
varfromtdatetime : procedure(var dest : Variant;const source : TDateTime);
{$endif}
varfromcurr : procedure(var dest : Variant;const source : Currency);
varfrompstr: procedure(var dest : variant; const source : ShortString);
varfromlstr: procedure(var dest : variant; const source : ansistring);
@ -249,13 +257,17 @@ operator :=(const source : extended) dest : variant;{$ifdef SYSTEMINLINE}inline;
{$ifdef SUPPORT_COMP}
operator :=(const source : comp) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif SUPPORT_COMP}
{$ifndef FPUNONE}
{$ifndef VER2_0}
operator :=(const source : real) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif VER2_0}
{$endif}
{ Misc. }
operator :=(const source : currency) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifndef FPUNONE}
operator :=(const source : tdatetime) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
operator :=(const source : terror) dest : variant;{$ifdef SYSTEMINLINE}inline;{$endif}
{**********************************************************************
@ -299,9 +311,11 @@ operator :=(const source : variant) dest : extended;{$ifdef SYSTEMINLINE}inline;
{$ifdef SUPPORT_COMP}
operator :=(const source : variant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif SUPPORT_COMP}
{$ifndef FPUNONE}
{$ifndef VER2_0}
operator :=(const source : variant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif VER2_0}
{$endif}
{ done by the compiler now }
{$ifndef FPC_HASINTERNALOLEVARIANT2VARIANTCAST}
@ -312,7 +326,9 @@ operator :=(const source : variant) dest : olevariant;{$ifdef SYSTEMINLINE}inlin
{ Misc. }
operator :=(const source : variant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifndef FPUNONE}
operator :=(const source : variant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
operator :=(const source : variant) dest : terror;{$ifdef SYSTEMINLINE}inline;{$endif}
{**********************************************************************
@ -386,13 +402,17 @@ operator :=(const source : olevariant) dest : extended;{$ifdef SYSTEMINLINE}inli
{$ifdef SUPPORT_COMP}
operator :=(const source : olevariant) dest : comp;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif SUPPORT_COMP}
{$ifndef FPUNONE}
{$ifndef VER2_0}
operator :=(const source : olevariant) dest : real;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif VER2_0}
{$endif}
{ Misc. }
operator :=(const source : olevariant) dest : currency;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifndef FPUNONE}
operator :=(const source : olevariant) dest : tdatetime;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
operator :=(const source : olevariant) dest : terror;{$ifdef SYSTEMINLINE}inline;{$endif}
{**********************************************************************
@ -436,13 +456,17 @@ operator :=(const source : extended) dest : olevariant;{$ifdef SYSTEMINLINE}inli
{$ifdef SUPPORT_COMP}
operator :=(const source : comp) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif SUPPORT_COMP}
{$ifndef FPUNONE}
{$ifndef VER2_0}
operator :=(const source : real) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif VER2_0}
{$endif}
{ Misc. }
operator :=(const source : currency) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifndef FPUNONE}
operator :=(const source : tdatetime) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
{$endif}
operator :=(const source : terror) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
{ silly, but how else should the compiler know what to do with pos(<string type>,<variant>)? (FK) }

4
rtl/inc/wustrings.inc
View File

@ -1459,6 +1459,7 @@ begin
end;
{$ifndef FPUNONE}
Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; compilerproc;
Var
SS : String;
@ -1472,6 +1473,7 @@ begin
Val(SS,fpc_Val_Real_WideStr,code);
end;
end;
{$endif}
function fpc_val_enum_widestr(str2ordindex:pointer;const s:widestring;out code:valsint):longint;compilerproc;
@ -1568,6 +1570,7 @@ end;
{$endif CPU64}
{$ifndef FPUNONE}
procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString);compilerproc;
var
ss : shortstring;
@ -1575,6 +1578,7 @@ begin
str_real(len,fr,d,treal_type(rt),ss);
s:=ss;
end;
{$endif}
procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;

2
rtl/linux/powerpc/sighnd.inc
View File

@ -21,8 +21,10 @@ var
{ fpustate: longint; }
begin
res:=0;
{$ifndef FPUNONE}
{ exception flags are turned off by kernel }
fpc_enable_ppc_fpu_exceptions;
{$endif}
case sig of
SIGFPE :
case (SigInfo^.si_code) of

2
rtl/linux/system.pp
View File

@ -306,6 +306,7 @@ begin
InitSyscallIntf;
{$endif}
{$ifndef FPUNONE}
SysResetFPU;
if not(IsLibrary) then
SysInitFPU;
@ -313,6 +314,7 @@ begin
// some PPC kernels set the exception bits FE0/FE1 in the MSR to zero,
// disabling all FPU exceptions. Enable them again.
fpprctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE);
{$endif}
{$endif}
IsConsole := TRUE;
StackLength := CheckInitialStkLen(initialStkLen);

8
rtl/objpas/convutil.inc
View File

@ -25,14 +25,13 @@ interface
{$mode objfpc}
{$H+}
{$ifndef FPUNONE}
Type TConvType = type Integer;
TConvFamily = type Integer;
TConvFamilyArray = array of TConvFamily;
TConvTypeArray = array of TConvType;
TConversionProc = function(const AValue: Double): Double;
Type TConvUtilFloat = double;
TConvUtilFloat = double;
Function RegisterConversionFamily(Const S : String):TConvFamily;
Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
@ -278,4 +277,7 @@ end;
finalization
setlength(theunits,0);
setlength(thefamilies,0);
{$else}
implementation
{$endif}
end.

76
rtl/objpas/cvarutil.inc
View File

@ -88,10 +88,12 @@ begin
varSmallInt : Result := vSmallInt;
varShortInt : Result := vShortInt;
varInteger : Result := smallint(vInteger);
{$ifndef FPUNONE}
varSingle : Result := smallint(Round(vSingle));
varDouble : Result := smallint(Round(vDouble));
varCurrency : Result := smallint(Round(vCurrency));
varDate : Result := smallint(Round(vDate));
{$endif}
varCurrency : Result := smallint(Round(vCurrency));
varBoolean : Result := smallint(SmallInt(vBoolean));
varVariant : Result := VariantToSmallInt(PVarData(vPointer)^);
varByte : Result := vByte;
@ -108,10 +110,12 @@ begin
varSmallInt : Result := PSmallInt(vPointer)^;
varShortInt : Result := PShortInt(vPointer)^;
varInteger : Result := smallint(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := smallint(Round(PSingle(vPointer)^));
varDouble : Result := smallint(Round(PDouble(vPointer)^));
varCurrency : Result := smallint(Round(PCurrency(vPointer)^));
varDate : Result := smallint(Round(PDate(vPointer)^));
{$endif}
varCurrency : Result := smallint(Round(PCurrency(vPointer)^));
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToSmallInt(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -167,10 +171,12 @@ begin
varSmallInt : Result := shortint(vSmallInt);
varShortInt : Result := vShortInt;
varInteger : Result := shortint(vInteger);
{$ifndef FPUNONE}
varSingle : Result := shortint(Round(vSingle));
varDouble : Result := shortint(Round(vDouble));
varCurrency : Result := shortint(Round(vCurrency));
varDate : Result := shortint(Round(vDate));
{$endif}
varCurrency : Result := shortint(Round(vCurrency));
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToShortInt(PVarData(vPointer)^);
varByte : Result := shortint(vByte);
@ -187,10 +193,12 @@ begin
varSmallInt : Result := shortint(PSmallInt(vPointer)^);
varShortInt : Result := PShortInt(vPointer)^;
varInteger : Result := shortint(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := shortint(Round(PSingle(vPointer)^));
varDouble : Result := shortint(Round(PDouble(vPointer)^));
varCurrency : Result := shortint(Round(PCurrency(vPointer)^));
varDate : Result := shortint(Round(PDate(vPointer)^));
{$endif}
varCurrency : Result := shortint(Round(PCurrency(vPointer)^));
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToShortInt(PVarData(vPointer)^);
varByte : Result := shortint(PByte(vPointer)^);
@ -246,10 +254,12 @@ begin
varSmallInt : Result := vSmallInt;
varShortInt : Result := vShortInt;
varInteger : Result := vInteger;
{$ifndef FPUNONE}
varSingle : Result := longint(Round(vSingle));
varDouble : Result := longint(Round(vDouble));
varCurrency : Result := longint(Round(vCurrency));
varDate : Result := longint(Round(vDate));
{$endif}
varCurrency : Result := longint(Round(vCurrency));
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToLongInt(PVarData(vPointer)^);
varByte : Result := vByte;
@ -266,10 +276,12 @@ begin
varSmallInt : Result := PSmallInt(vPointer)^;
varShortInt : Result := PShortInt(vPointer)^;
varInteger : Result := PInteger(vPointer)^;
{$ifndef FPUNONE}
varSingle : Result := longint(Round(PSingle(vPointer)^));
varDouble : Result := longint(Round(PDouble(vPointer)^));
varCurrency : Result := longint(Round(PCurrency(vPointer)^));
varDate : Result := longint(Round(PDate(vPointer)^));
{$endif}
varCurrency : Result := longint(Round(PCurrency(vPointer)^));
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToLongInt(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -325,10 +337,12 @@ begin
varSmallInt : Result := vSmallInt;
varShortInt : Result := vShortInt;
varInteger : Result := cardinal(vInteger);
{$ifndef FPUNONE}
varSingle : Result := cardinal(Round(vSingle));
varDouble : Result := cardinal(Round(vDouble));
varCurrency : Result := cardinal(Round(vCurrency));
varDate : Result := cardinal(Round(vDate));
{$endif}
varCurrency : Result := cardinal(Round(vCurrency));
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToCardinal(PVarData(vPointer)^);
varByte : Result := vByte;
@ -345,10 +359,12 @@ begin
varSmallInt : Result := cardinal(PSmallInt(vPointer)^);
varShortInt : Result := cardinal(PShortInt(vPointer)^);
varInteger : Result := cardinal(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := cardinal(Round(PSingle(vPointer)^));
varDouble : Result := cardinal(Round(PDouble(vPointer)^));
varCurrency : Result := cardinal(Round(PCurrency(vPointer)^));
varDate : Result := cardinal(Round(PDate(vPointer)^));
{$endif}
varCurrency : Result := cardinal(Round(PCurrency(vPointer)^));
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToCardinal(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -389,6 +405,8 @@ end;
{--- Single ---}
{$ifndef FPUNONE}
Function WStrToSingle(p: Pointer) : Single;
var
s : ShortString;
@ -573,6 +591,8 @@ begin
end; {$ENDIF}
end;
{$endif FPUNONE}
{--- Currency ---}
Function WStrToCurrency(p: Pointer) : Currency;
@ -638,6 +658,7 @@ begin
varSmallInt : Result := vSmallInt;
varShortInt : Result := vShortInt;
varInteger : Result := vInteger;
{$ifndef FPUNONE}
varSingle : begin
if (vSingle > MaxCurrency) or (vSingle < MinCurrency) then
VariantTypeMismatch(vType, varCurrency);
@ -648,12 +669,13 @@ begin
VariantTypeMismatch(vType, varCurrency);
Result := vDouble;
end;
varCurrency : Result := vCurrency;
varDate : begin
if (varDate > MaxCurrency) or (varDate < MinCurrency) then
VariantTypeMismatch(vType, varCurrency);
Result := vDate;
end;
{$endif}
varCurrency : Result := vCurrency;
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToCurrency(PVarData(vPointer)^);
varByte : Result := vByte;
@ -670,6 +692,7 @@ begin
varSmallInt : Result := PSmallInt(vPointer)^;
varShortInt : Result := PShortInt(vPointer)^;
varInteger : Result := PInteger(vPointer)^;
{$ifndef FPUNONE}
varSingle : begin
if (PSingle(vPointer)^ > MaxCurrency) or (PSingle(vPointer)^ < MinCurrency) then
VariantTypeMismatch(vType, varCurrency);
@ -680,12 +703,13 @@ begin
VariantTypeMismatch(vType, varCurrency);
Result := PDouble(vPointer)^;
end;
varCurrency : Result := PCurrency(vPointer)^;
varDate : begin
if (PDate(vPointer)^ > MaxCurrency) or (PDate(vPointer)^ < MinCurrency) then
VariantTypeMismatch(vType, varCurrency);
Result := PDate(vPointer)^;
end;
{$endif}
varCurrency : Result := PCurrency(vPointer)^;
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToCurrency(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -710,6 +734,8 @@ end;
{--- Date ---}
{$ifndef FPUNONE}
Function WStrToDate(p: Pointer) : TDateTime;
var
s: string;
@ -791,6 +817,8 @@ begin
end; {$ENDIF}
end;
{$endif}
{--- Boolean ---}
Function WStrToBoolean(p: Pointer) : Boolean;
@ -818,10 +846,12 @@ begin
varSmallInt : Result := vSmallInt <> 0;
varShortInt : Result := vShortInt <> 0;
varInteger : Result := vInteger <> 0;
{$ifndef FPUNONE}
varSingle : Result := vSingle <> 0;
varDouble : Result := vDouble <> 0;
varCurrency : Result := vCurrency <> 0;
varDate : Result := vDate <> 0;
{$endif}
varBoolean : Result := vBoolean;
varVariant : Result := VariantToBoolean(PVarData(vPointer)^);
varByte : Result := vByte <> 0;
@ -838,10 +868,12 @@ begin
varSmallInt : Result := PSmallInt(vPointer)^ <> 0;
varShortInt : Result := PShortInt(vPointer)^ <> 0;
varInteger : Result := PInteger(vPointer)^ <> 0;
{$ifndef FPUNONE}
varSingle : Result := PSingle(vPointer)^ <> 0;
varDouble : Result := PDouble(vPointer)^ <> 0;
varCurrency : Result := PCurrency(vPointer)^ <> 0;
varDate : Result := PDate(vPointer)^ <> 0;
{$endif}
varBoolean : Result := SmallInt(PWordBool(vPointer)^) <> 0;
varVariant : Result := VariantToBoolean(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^ <> 0;
@ -897,10 +929,12 @@ begin
varSmallInt : Result := byte(vSmallInt);
varShortInt : Result := byte(vShortInt);
varInteger : Result := byte(vInteger);
{$ifndef FPUNONE}
varSingle : Result := byte(Round(vSingle));
varDouble : Result := byte(Round(vDouble));
varCurrency : Result := byte(Round(vCurrency));
varDate : Result := byte(Round(vDate));
{$endif}
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToByte(PVarData(vPointer)^);
varByte : Result := vByte;
@ -917,10 +951,12 @@ begin
varSmallInt : Result := byte(PSmallInt(vPointer)^);
varShortInt : Result := byte(PShortInt(vPointer)^);
varInteger : Result := byte(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := byte(Round(PSingle(vPointer)^));
varDouble : Result := byte(Round(PDouble(vPointer)^));
varCurrency : Result := byte(Round(PCurrency(vPointer)^));
varDate : Result := byte(Round(PDate(vPointer)^));
{$endif}
varBoolean : Result := byte(SmallInt(PWordBool(vPointer)^));
varVariant : Result := byte(VariantToByte(PVarData(vPointer)^));
varByte : Result := PByte(vPointer)^;
@ -976,10 +1012,12 @@ begin
varSmallInt : Result := vSmallInt;
varShortInt : Result := vShortInt;
varInteger : Result := vInteger;
{$ifndef FPUNONE}
varSingle : Result := Round(vSingle);
varDouble : Result := Round(vDouble);
varCurrency : Result := Round(vCurrency);
varDate : Result := Round(vDate);
{$endif}
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToInt64(PVarData(vPointer)^);
varByte : Result := vByte;
@ -996,10 +1034,12 @@ begin
varSmallInt : Result := PSmallInt(vPointer)^;
varShortInt : Result := PShortInt(vPointer)^;
varInteger : Result := PInteger(vPointer)^;
{$ifndef FPUNONE}
varSingle : Result := Round(PSingle(vPointer)^);
varDouble : Result := Round(PDouble(vPointer)^);
varCurrency : Result := Round(PCurrency(vPointer)^);
varDate : Result := Round(PDate(vPointer)^);
{$endif}
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToInt64(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -1055,10 +1095,12 @@ begin
varSmallInt : Result := qword(vSmallInt);
varShortInt : Result := qword(vShortInt);
varInteger : Result := qword(vInteger);
{$ifndef FPUNONE}
varSingle : Result := qword(Round(vSingle));
varDouble : Result := qword(Round(vDouble));
varCurrency : Result := qword(Round(vCurrency));
varDate : Result := qword(Round(vDate));
{$endif}
varBoolean : Result := SmallInt(vBoolean);
varVariant : Result := VariantToQWord(PVarData(vPointer)^);
varByte : Result := vByte;
@ -1075,10 +1117,12 @@ begin
varSmallInt : Result := qword(PSmallInt(vPointer)^);
varShortInt : Result := qword(PShortInt(vPointer)^);
varInteger : Result := qword(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := qword(Round(PSingle(vPointer)^));
varDouble : Result := qword(Round(PDouble(vPointer)^));
varCurrency : Result := qword(Round(PCurrency(vPointer)^));
varDate : Result := qword(Round(PDate(vPointer)^));
{$endif}
varBoolean : Result := SmallInt(PWordBool(vPointer)^);
varVariant : Result := VariantToQWord(PVarData(vPointer)^);
varByte : Result := PByte(vPointer)^;
@ -1116,10 +1160,12 @@ begin
varSmallInt : Result := IntToStr(vSmallInt);
varShortInt : Result := IntToStr(vShortInt);
varInteger : Result := IntToStr(vInteger);
{$ifndef FPUNONE}
varSingle : Result := FloatToStr(vSingle);
varDouble : Result := FloatToStr(vDouble);
varCurrency : Result := FloatToStr(vCurrency);
varDate : Result := FloatToStr(vDate);
{$endif}
varBoolean : Result := BoolToStr(vBoolean, True);
varVariant : Result := VariantToWideString(PVarData(vPointer)^);
varByte : Result := IntToStr(vByte);
@ -1136,10 +1182,12 @@ begin
varSmallInt : Result := IntToStr(PSmallInt(vPointer)^);
varShortInt : Result := IntToStr(PShortInt(vPointer)^);
varInteger : Result := IntToStr(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := FloatToStr(PSingle(vPointer)^);
varDouble : Result := FloatToStr(PDouble(vPointer)^);
varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
varDate : Result := FloatToStr(PDate(vPointer)^);
{$endif}
varBoolean : Result := BoolToStr(PWordBool(vPointer)^, True);
varVariant : Result := VariantToWideString(PVarData(vPointer)^);
varByte : Result := IntToStr(PByte(vPointer)^);
@ -1177,10 +1225,12 @@ begin
varSmallInt : Result := IntToStr(vSmallInt);
varShortInt : Result := IntToStr(vShortInt);
varInteger : Result := IntToStr(vInteger);
{$ifndef FPUNONE}
varSingle : Result := FloatToStr(vSingle);
varDouble : Result := FloatToStr(vDouble);
varCurrency : Result := FloatToStr(vCurrency);
varDate : Result := DateToStr(vDate);
{$endif}
varBoolean : Result := BoolToStr(vBoolean, True);
varVariant : Result := VariantToAnsiString(PVarData(vPointer)^);
varByte : Result := IntToStr(vByte);
@ -1197,10 +1247,12 @@ begin
varSmallInt : Result := IntToStr(PSmallInt(vPointer)^);
varShortInt : Result := IntToStr(PShortInt(vPointer)^);
varInteger : Result := IntToStr(PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle : Result := FloatToStr(PSingle(vPointer)^);
varDouble : Result := FloatToStr(PDouble(vPointer)^);
varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
varDate : Result := DateToStr(PDate(vPointer)^);
{$endif}
varBoolean : Result := BoolToStr(PWordBool(vPointer)^, True);
varVariant : Result := VariantToAnsiString(PVarData(vPointer)^);
varByte : Result := IntToStr(PByte(vPointer)^);
@ -1346,10 +1398,12 @@ begin
varNull : Write(F, 'Null');
varSmallInt : Write(F, vSmallInt);
varInteger : Write(F, vInteger);
{$ifndef FPUNONE}
varSingle : Write(F, vSingle);
varDouble : Write(F, vDouble);
varCurrency : Write(F, vCurrency);
varDate : Write(F, vDate);
{$endif}
varOleStr : Write(F, WideString(Pointer(vOleStr)));
varError : Write(F, IntToHex(Cardinal(vError), 8));
varBoolean : Write(F, vBoolean);
@ -1368,10 +1422,12 @@ begin
varNull or varByRef : Write(F, 'Null');
varSmallInt or varByRef : Write(F, PSmallInt(vPointer)^);
varInteger or varByRef : Write(F, PInteger(vPointer)^);
{$ifndef FPUNONE}
varSingle or varByRef : Write(F, PSingle(vPointer)^);
varDouble or varByRef : Write(F, PDouble(vPointer)^);
varCurrency or varByRef : Write(F, PCurrency(vPointer)^);
varDate or varByRef : Write(F, PDate(vPointer)^);
{$endif}
varOleStr or varByRef : Write(F, WideString(PPointer(vPointer)^));
varError or varByRef : Write(F, IntToHex(Cardinal(PLongWord(vPointer)^), 8));
varBoolean or varByRef : Write(F, PWordBool(vPointer)^);

4
rtl/objpas/dateutil.inc
View File

@ -19,6 +19,7 @@ unit dateutils;
interface
{$ifndef FPUNONE}
uses
SysUtils, Math, Types;
@ -2385,4 +2386,7 @@ begin
result:=scandatetime(pattern,s,defaultformatsettings);
end;
{$else}
implementation
{$endif FPUNONE}
end.

58
rtl/objpas/fmtbcd.pp
View File

@ -190,12 +190,14 @@ INTERFACE
{$define myInttype := int64}
{$endif}
{$ifndef FPUNONE}
{$ifdef real8}
{$define myRealtype := double}
{$endif}
{$ifdef real10}
{$define myRealtype := extended}
{$endif}
{$endif}
{$ifdef SUPPORT_COMP}
{$define comproutines}
@ -266,9 +268,11 @@ INTERFACE
BCDin2 : tBCD;
var BCDout : tBCD );
{$ifndef FPUNONE}
procedure BCDMultiply ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDMultiply ( const BCDIn : tBCD;
const StringIn : FmtBCDStringtype;
@ -283,9 +287,11 @@ INTERFACE
Divisor : tBCD;
var BCDout : tBCD );
{$ifndef FPUNONE}
procedure BCDDivide ( const Dividend : tBCD;
const Divisor : myRealtype;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDDivide ( const Dividend : tBCD;
const Divisor : FmtBCDStringtype;
@ -306,9 +312,11 @@ INTERFACE
Precision,
Scale : Word ) : Variant;
{$ifndef FPUNONE}
function VarFmtBCDCreate ( const aValue : myRealtype;
Precision : Word = 18;
Scale : Word = 4 ) : Variant;
{$endif}
function VarFmtBCDCreate ( const aBCD : tBCD ) : Variant;
@ -322,10 +330,12 @@ INTERFACE
function TryStrToBCD ( const aValue : FmtBCDStringtype;
var BCD : tBCD ) : Boolean;
{$ifndef FPUNONE}
function DoubleToBCD ( const aValue : myRealtype ) : tBCD; Inline;
procedure DoubleToBCD ( const aValue : myRealtype;
var BCD : tBCD );
{$endif}
function IntegerToBCD ( const aValue : myInttype ) : tBCD;
@ -340,7 +350,9 @@ INTERFACE
{ Convert BCD struct to string/Double/Integer }
function BCDToStr ( const BCD : tBCD ) : FmtBCDStringtype;
{$ifndef FPUNONE}
function BCDToDouble ( const BCD : tBCD ) : myRealtype;
{$endif}
function BCDToInteger ( const BCD : tBCD;
Truncate : Boolean = False ) : myInttype;
@ -380,6 +392,7 @@ INTERFACE
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$ifndef FPUNONE}
procedure BCDAdd ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
@ -387,6 +400,7 @@ INTERFACE
procedure BCDAdd ( const DoubleIn : myRealtype;
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDAdd ( const BCDIn : tBCD;
const Currin : currency;
@ -426,6 +440,7 @@ INTERFACE
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$ifndef FPUNONE}
procedure BCDSubtract ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
@ -433,6 +448,7 @@ INTERFACE
procedure BCDSubtract ( const DoubleIn : myRealtype;
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDSubtract ( const BCDIn : tBCD;
const Currin : currency;
@ -472,9 +488,11 @@ INTERFACE
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$ifndef FPUNONE}
procedure BCDMultiply ( const DoubleIn : myRealtype;
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDMultiply ( const BCDIn : tBCD;
const Currin : currency;
@ -506,9 +524,11 @@ INTERFACE
const Divisor : tBCD;
var BCDout : tBCD ); Inline;
{$ifndef FPUNONE}
procedure BCDDivide ( const Dividend : myRealtype;
const Divisor : tBCD;
var BCDout : tBCD ); Inline;
{$endif}
procedure BCDDivide ( const BCDIn : tBCD;
const Currin : currency;
@ -561,11 +581,13 @@ INTERFACE
operator + ( const i : myInttype;
const BCD : tBCD ) z : tBCD; Inline;
{$ifndef FPUNONE}
operator + ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
operator + ( const r : myRealtype;
const BCD : tBCD ) z : tBCD; Inline;
{$endif}
operator + ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -596,11 +618,13 @@ INTERFACE
operator - ( const i : myInttype;
const BCD : tBCD ) z : tBCD; Inline;
{$ifndef FPUNONE}
operator - ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
operator - ( const r : myRealtype;
const BCD : tBCD ) z : tBCD; Inline;
{$endif}
operator - ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -631,11 +655,13 @@ INTERFACE
operator * ( const i : myInttype;
const BCD : tBCD ) z : tBCD; Inline;
{$ifndef FPUNONE}
operator * ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
operator * ( const r : myRealtype;
const BCD : tBCD ) z : tBCD; Inline;
{$endif}
operator * ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -666,11 +692,13 @@ INTERFACE
operator / ( const i : myInttype;
const BCD : tBCD ) z : tBCD; Inline;
{$ifndef FPUNONE}
operator / ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
operator / ( const r : myRealtype;
const BCD : tBCD ) z : tBCD; Inline;
{$endif}
operator / ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -728,6 +756,7 @@ INTERFACE
operator := ( const BCD : tBCD ) z : int64; Inline;
{$endif}
{$ifndef FPUNONE}
operator := ( const r : Single ) z : tBCD; Inline;
operator := ( const BCD : tBCD ) z : Single; Inline;
@ -740,6 +769,7 @@ INTERFACE
operator := ( const r : Extended ) z : tBCD; Inline;
operator := ( const BCD : tBCD ) z : Extended; Inline;
{$endif}
{$endif}
operator := ( const c : currency ) z : tBCD; Inline;
@ -1539,6 +1569,7 @@ IMPLEMENTATION
else StrToBCD := BCD;
end;
{$ifndef FPUNONE}
procedure DoubleToBCD ( const aValue : myRealtype;
var BCD : tBCD );
@ -1559,6 +1590,7 @@ IMPLEMENTATION
begin
DoubleToBCD ( aValue, result );
end;
{$endif}
function IntegerToBCD ( const aValue : myInttype ) : tBCD;
@ -1732,6 +1764,7 @@ IMPLEMENTATION
{$endif}
end;
{$ifndef FPUNONE}
function BCDToDouble ( const BCD : tBCD ) : myRealtype;
var
@ -1762,6 +1795,7 @@ IMPLEMENTATION
else BCDToDouble := +r;
end;
end;
{$endif}
function BCDToInteger ( const BCD : tBCD;
Truncate : Boolean = False ) : myInttype;
@ -2095,6 +2129,7 @@ writeln;
end;
end;
{$ifndef FPUNONE}
procedure BCDMultiply ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
@ -2102,6 +2137,7 @@ writeln;
begin
BCDMultiply ( BCDIn, DoubleToBCD ( DoubleIn ), BCDout );
end;
{$endif}
procedure BCDMultiply ( const BCDIn : tBCD;
const StringIn : FmtBCDStringtype;
@ -2370,6 +2406,7 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
BCDDivide ( StrToBCD ( Dividend ), StrToBCD ( Divisor ), BCDout );
end;
{$ifndef FPUNONE}
procedure BCDDivide ( const Dividend : tBCD;
const Divisor : myRealtype;
var BCDout : tBCD ); Inline;
@ -2377,6 +2414,7 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
begin
BCDDivide ( Dividend, DoubleToBCD ( Divisor ), BCDout );
end;
{$endif}
procedure BCDDivide ( const Dividend : tBCD;
const Divisor : FmtBCDStringtype;
@ -2410,6 +2448,7 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
VarFmtBCDCreate ( result, StrToBCD ( aValue ) );
end;
{$ifndef FPUNONE}
function VarFmtBCDCreate ( const aValue : myRealtype;
Precision : Word = 18;
Scale : Word = 4 ) : Variant;
@ -2417,6 +2456,7 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
begin
VarFmtBCDCreate ( result, DoubleToBCD ( aValue ) );
end;
{$endif}
function VarFmtBCDCreate ( const aBCD : tBCD ) : Variant;
@ -2649,6 +2689,7 @@ write(direct);dumpbcd(bcdin);write('[',intin,']');
BCDAdd ( BCDIn, IntIn, BCDout );
end;
{$ifndef FPUNONE}
procedure BCDAdd ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
@ -2664,6 +2705,7 @@ write(direct);dumpbcd(bcdin);write('[',intin,']');
begin
BCDAdd ( DoubleToBCD ( DoubleIn ), BCDIn, BCDout );
end;
{$endif}
procedure BCDAdd ( const BCDIn : tBCD;
const Currin : currency;
@ -2732,6 +2774,7 @@ write(direct);dumpbcd(bcdin);write('[',intin,']');
BCDNegate ( BCDout );
end;
{$ifndef FPUNONE}
procedure BCDSubtract ( const BCDIn : tBCD;
const DoubleIn : myRealtype;
var BCDout : tBCD ); Inline;
@ -2747,6 +2790,7 @@ write(direct);dumpbcd(bcdin);write('[',intin,']');
begin
BCDSubtract ( DoubleToBCD ( DoubleIn ), BCDIn, BCDout );
end;
{$endif}
procedure BCDSubtract ( const BCDIn : tBCD;
const Currin : currency;
@ -2915,6 +2959,7 @@ writeln;
BCDMultiply ( BCDIn, IntIn, BCDout );
end;
{$ifndef FPUNONE}
procedure BCDMultiply ( const DoubleIn : myRealtype;
const BCDIn : tBCD;
var BCDout : tBCD ); Inline;
@ -2922,6 +2967,7 @@ writeln;
begin
BCDMultiply ( DoubleToBCD ( DoubleIn ), BCDIn, BCDout );
end;
{$endif}
procedure BCDMultiply ( const BCDIn : tBCD;
const Currin : currency;
@ -2981,6 +3027,7 @@ writeln;
BCDDivide ( IntegerToBCD ( Dividend ), Divisor, BCDout );
end;
{$ifndef FPUNONE}
procedure BCDDivide ( const Dividend : myRealtype;
const Divisor : tBCD;
var BCDout : tBCD ); Inline;
@ -2988,6 +3035,7 @@ writeln;
begin
BCDDivide ( DoubleToBCD ( Dividend ), Divisor, BCDout );
end;
{$endif}
procedure BCDDivide ( const BCDIn : tBCD;
const Currin : currency;
@ -3102,6 +3150,7 @@ writeln;
BCDAdd ( i, BCD, z );
end;
{$ifndef FPUNONE}
operator + ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
@ -3115,6 +3164,7 @@ writeln;
begin
BCDAdd ( DoubleToBCD ( r ), BCD, z );
end;
{$endif}
operator + ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -3182,6 +3232,7 @@ writeln;
BCDNegate ( z );
end;
{$ifndef FPUNONE}
operator - ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
@ -3195,6 +3246,7 @@ writeln;
begin
BCDSubtract ( DoubleToBCD ( r ), BCD, z );
end;
{$endif}
operator - ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -3261,6 +3313,7 @@ writeln;
BCDMultiply ( BCD, i, z );
end;
{$ifndef FPUNONE}
operator * ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
@ -3274,6 +3327,7 @@ writeln;
begin
BCDMultiply ( DoubleToBCD ( r ), BCD, z );
end;
{$endif}
operator * ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -3340,6 +3394,7 @@ writeln;
BCDDivide ( IntegerToBCD ( i ), BCD, z );
end;
{$ifndef FPUNONE}
operator / ( const BCD : tBCD;
const r : myRealtype ) z : tBCD; Inline;
@ -3353,6 +3408,7 @@ writeln;
begin
BCDDivide ( DoubleToBCD ( r ), BCD, z );
end;
{$endif}
operator / ( const BCD : tBCD;
const c : currency ) z : tBCD; Inline;
@ -3498,6 +3554,7 @@ writeln;
end;
{$endif}
{$ifndef FPUNONE}
operator := ( const r : Single ) z : tBCD; Inline;
begin
@ -3534,6 +3591,7 @@ writeln;
begin
z := BCDToDouble ( BCD );
end;
{$endif}
{$endif}
operator := ( const c : currency ) z : tBCD; Inline;

5
rtl/objpas/math.pp
View File

@ -26,6 +26,7 @@
unit math;
interface
{$ifndef FPUNONE}
uses
sysutils;
@ -2386,4 +2387,8 @@ begin
end;
{$endif}
{$else}
implementation
{$endif FPUNONE}
end.

4
rtl/objpas/stdconvs.pp
View File

@ -22,6 +22,7 @@ interface
{$mode objfpc}
{$H+}
{$ifndef FPUNONE}
Uses convutils;
@ -547,4 +548,7 @@ end;
initialization
registerall;
{$else}
implementation
{$endif}
end.

2
rtl/objpas/sysutils/filutilh.inc
View File

@ -80,7 +80,9 @@ Function FileSeek (Handle : THandle; FOffset, Origin: Longint) : Longint;
Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
Procedure FileClose (Handle : THandle);
Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
{$ifndef FPUNONE}
Function FileAge (Const FileName : String): Longint;
{$endif}
Function FileExists (Const FileName : String) : Boolean;
Function DirectoryExists (Const Directory : String) : Boolean;
Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;

5
rtl/objpas/sysutils/sysformt.inc
View File

@ -237,6 +237,7 @@ begin
Index:=Prec-Length(ToAdd);
ToAdd:=StringOfChar('0',Index)+ToAdd
end;
{$ifndef FPUNONE}
'E' : begin
if CheckArg(vtCurrency,false) then
ToAdd:=FloatToStrF(Args[doarg].VCurrency^,ffexponent,Prec,3,FormatSettings)
@ -267,6 +268,10 @@ begin
else if CheckArg(vtCurrency,true) then
ToAdd:=FloatToStrF(Args[doarg].VCurrency^,ffCurrency,9999,Prec,FormatSettings);
end;
{$else}
'E','F','G','N','M':
RunError(207);
{$endif}
'S' : begin
if CheckArg(vtString,false) then
hs:=Args[doarg].VString^

41
rtl/objpas/sysutils/sysstr.inc
View File

@ -983,6 +983,8 @@ begin
Result:=Buffer;
end;
{$ifndef FPUNONE}
Function StrToFloat(Const S: String): Extended;
begin
@ -1572,6 +1574,7 @@ begin
end;
{$ifndef FPC_COMP_IS_INT64}
Function FloatToStrF(Value: Int64; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
@ -1633,17 +1636,6 @@ begin
Result:=FloatToStrF(Value,ffGeneral,-1,0);
end;
function AnsiDequotedStr(const S: string; AQuote: Char): string;
var p : pchar;
begin
p:=pchar(pointer(s)); // work around CONST. Ansiextract is safe for nil
result:=AnsiExtractquotedStr(p,AQuote);
if result='' Then
result:=s;
end;
function StrToCurr(const S: string): Currency;
begin
if not TextToFloat(PChar(pointer(S)), Result, fvCurrency) then
@ -1663,6 +1655,18 @@ begin
Result:=Default;
end;
{$endif FPUNONE}
function AnsiDequotedStr(const S: string; AQuote: Char): string;
var p : pchar;
begin
p:=pchar(pointer(s)); // work around CONST. Ansiextract is safe for nil
result:=AnsiExtractquotedStr(p,AQuote);
if result='' Then
result:=s;
end;
function StrToBool(const S: string): Boolean;
begin
@ -1711,14 +1715,22 @@ end;
function TryStrToBool(const S: string; out Value: Boolean): Boolean;
Var
Temp : String;
{$ifdef FPUNONE}
D : Longint;
{$else}
D : Double;
{$endif}
Code: word;
begin
Temp:=upcase(S);
Val(temp,D,code);
Result:=true;
If Code=0 then
{$ifdef FPUNONE}
Value:=(D<>0)
{$else}
Value:=(D<>0.0)
{$endif}
else If Temp='TRUE' then
Value:=true
else if Temp='FALSE' then
@ -1727,6 +1739,8 @@ begin
Result:=false;
end;
{$ifndef FPUNONE}
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
begin
@ -2372,6 +2386,7 @@ begin
Result:=FormatCurr(Format,Value,DefaultFormatSettings);
end;
{$endif}
{==============================================================================}
{ extra functions }
@ -2779,8 +2794,10 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
case fmt[m] of
'd':
Result:=vtInteger;
{$ifndef FPUNONE}
'f':
Result:=vtExtended;
{$endif}
's':
Result:=vtString;
'c':
@ -2833,6 +2850,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
end;
{$ifndef FPUNONE}
vtExtended :
begin
if GetFloat>0 then
@ -2843,6 +2861,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
else
break;
end;
{$endif}
vtString :
begin

25
rtl/objpas/sysutils/sysstrh.inc
View File

@ -40,6 +40,7 @@ type
const
{ For floattodatetime and VariantToDate }
{$ifndef FPUNONE}
MinDateTime: TDateTime = -693593.0; { 01/01/0001 12:00:00.000 AM }
MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
@ -50,6 +51,10 @@ const
MinCurrency: Currency = -922337203685477.0000;
MaxCurrency: Currency = 922337203685477.0000;
{$endif}
{$else}
MinCurrency: Currency = -9223372036854775807;
MaxCurrency: Currency = 9223372036854775807;
{$endif}
Const
LeadBytes: set of Char = [];
@ -129,6 +134,7 @@ Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Arra
Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const; Const FormatSettings: TFormatSettings) : Pchar;
Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
Procedure FmtStr(Var Res: string; const Fmt : string; Const args: Array of const; Const FormatSettings: TFormatSettings);
{$ifndef FPUNONE}
{$ifdef FPC_HAS_TYPE_EXTENDED}
Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
@ -190,6 +196,17 @@ function StrToCurr(const S: string): Currency;
function TryStrToCurr(const S: string;Var Value : Currency): Boolean;
function StrToCurrDef(const S: string; Default : Currency): Currency;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar; FormatSettings : TFormatSettings): Integer;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function FormatFloat(Const Format : String; Value : Extended; Const FormatSettings: TFormatSettings) : String;
function FormatCurr(const Format: string; Value: Currency): string;
Function FormatCurr(const Format: string; Value: Currency; Const FormatSettings: TFormatSettings): string;
{$endif}
function StrToBool(const S: string): Boolean;
function BoolToStr(B: Boolean;UseBoolStrs:Boolean=False): string;
function StrToBoolDef(const S: string; Default: Boolean): Boolean;
@ -197,15 +214,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar; FormatSettings : TFormatSettings): Integer;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function FormatFloat(Const Format : String; Value : Extended; Const FormatSettings: TFormatSettings) : String;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
function FormatCurr(const Format: string; Value: Currency): string;
Function FormatCurr(const Format: string; Value: Currency; Const FormatSettings: TFormatSettings): string;
function SScanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;

2
rtl/objpas/sysutils/sysutilh.inc
View File

@ -21,7 +21,9 @@
{ Read date & Time function declarations }
{$i osutilsh.inc}
{$ifndef FPUNONE}
{$i datih.inc}
{$endif}
{ Read String Handling functions declaration }
{$i sysstrh.inc}

2
rtl/objpas/sysutils/sysutils.inc
View File

@ -80,7 +80,9 @@
{$i sysstr.inc}
{ Read date & Time function implementations }
{$ifndef FPUNONE}
{$i dati.inc}
{$endif}
{ Read pchar handling functions implementation }
{$i syspch.inc}

4
rtl/objpas/types.pp
View File

@ -35,7 +35,9 @@ type
PLongint = System.PLongint;
PSmallInt = System.PSmallInt;
{$ifndef FPUNONE}
PDouble = System.PDouble;
{$endif}
PByte = System.PByte;
Largeint = int64;
LARGE_INT = LargeInt;
@ -53,8 +55,10 @@ type
TInt64DynArray = array of Int64;
TQWordDynArray = array of QWord;
TLongWordDynArray = array of LongWord;
{$ifndef FPUNONE}
TSingleDynArray = array of Single;
TDoubleDynArray = array of Double;
{$endif}
TBooleanDynArray = array of Boolean;
TStringDynArray = array of AnsiString;
TWideStringDynArray = array of WideString;

12
rtl/objpas/typinfo.pp
View File

@ -34,15 +34,17 @@ unit typinfo;
{$MINENUMSIZE 1 this saves a lot of memory }
// if you change one of the following enumeration types
// you have also to change the compiler in an appropriate way !
TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,
tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
tkSet,tkMethod,tkSString,tkLString,tkAString,
tkWString,tkVariant,tkArray,tkRecord,tkInterface,
tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
tkDynArray,tkInterfaceRaw);
TOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
{$ifndef FPUNONE}
TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
{$endif}
TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
mkClassProcedure, mkClassFunction);
TParamFlag = (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
@ -99,8 +101,10 @@ unit typinfo;
tkSet:
(CompType : PTypeInfo)
);
{$ifndef FPUNONE}
tkFloat:
(FloatType : TFloatType);
{$endif}
tkSString:
(MaxLength : Byte);
tkClass:
@ -248,10 +252,12 @@ Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
Procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
{$ifndef FPUNONE}
Function GetFloatProp(Instance: TObject; PropInfo : PPropInfo) : Extended;
Function GetFloatProp(Instance: TObject; const PropName: string): Extended;
Procedure SetFloatProp(Instance: TObject; const PropName: string; Value: Extended);
Procedure SetFloatProp(Instance: TObject; PropInfo : PPropInfo; Value : Extended);
{$endif}
Function GetObjectProp(Instance: TObject; const PropName: string): TObject;
Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
@ -1363,6 +1369,7 @@ begin
end;
{$ifndef FPUNONE}
{ ---------------------------------------------------------------------
Float properties
@ -1509,6 +1516,7 @@ begin
SetFloatProp(Instance,FindPropInfo(Instance,PropName),Value);
end;
{$endif}
{ ---------------------------------------------------------------------
Method properties

4
rtl/objpas/varutilh.inc
View File

@ -59,10 +59,12 @@ function VariantToSmallInt(const VargSrc : TVarData) : SmallInt;
function VariantToLongint(const VargSrc : TVarData) : Longint;
function VariantToShortint(const VargSrc : TVarData) : ShortInt;
function VariantToCardinal(const VargSrc : TVarData) : Cardinal;
{$ifndef FPUNONE}
function VariantToSingle(const VargSrc : TVarData) : Single;
function VariantToDouble(const VargSrc : TVarData) : Double;
function VariantToCurrency(const VargSrc : TVarData) : Currency;
function VariantToDate(const VargSrc : TVarData) : TDateTime;
{$endif}
function VariantToCurrency(const VargSrc : TVarData) : Currency;
function VariantToBoolean(const VargSrc : TVarData) : Boolean;
function VariantToByte(const VargSrc : TVarData) : Byte;
function VariantToInt64(const VargSrc : TVarData ) : Int64;

25
rtl/objpas/varutils.inc
View File

@ -68,8 +68,11 @@ begin
begin
if (VType and varByRef) = 0 then
case VType of
varEmpty, varNull, varSmallint, varInteger, varSingle, varDouble, varWord,
varCurrency, varDate, varError, varBoolean, varByte,VarShortInt,
varEmpty, varNull, varSmallint, varInteger, varWord,
{$ifndef FPUNONE}
varSingle, varDouble, varCurrency, varDate,
{$endif}
varError, varBoolean, varByte,VarShortInt,
varInt64, VarLongWord,VarQWord:
;
varOleStr:
@ -102,8 +105,11 @@ begin
else
case (VType and varTypeMask) of
varEmpty, varNull:;
varSmallint, varInteger, varSingle, varDouble, varCurrency, varWord,
varDate, varError, varBoolean, varByte,VarShortInt,
varSmallint, varInteger, varWord,
{$ifndef FPUNONE}
varSingle, varDouble, varCurrency, varDate,
{$endif}
varError, varBoolean, varByte,VarShortInt,
varInt64, VarLongWord,VarQWord:
Move(VBytes, VargDest.VBytes, SizeOf(VargDest.VBytes));
varOleStr:
@ -133,10 +139,12 @@ begin
varEmpty, varNull:;
varSmallint : VargDest.VSmallInt:=PSmallInt(VPointer)^;
varInteger : VargDest.VInteger:=PLongint(VPointer)^;
{$ifndef FPUNONE}
varSingle : VargDest.VSingle:=PSingle(VPointer)^;
varDouble : VargDest.VDouble:=PDouble(VPointer)^;
varCurrency : VargDest.VCurrency:=PCurrency(VPointer)^;
varDate : VargDest.VDate:=PDate(VPointer)^;
{$endif}
varBoolean : VargDest.VBoolean:=PWordBool(VPointer)^;
varError : VargDest.VError:=PError(VPointer)^;
varByte : VargDest.VByte:=PByte(VPointer)^;
@ -176,10 +184,12 @@ begin
case Vartype of
varSmallInt : VargDest.VSmallInt:=VariantToSmallInt(Tmp);
varInteger : VargDest.VInteger:=VariantToLongint(Tmp);
{$ifndef FPUNONE}
varSingle : VargDest.VSingle:=VariantToSingle(Tmp);
varDouble : VargDest.VDouble:=VariantToDouble(Tmp);
varCurrency : VargDest.VCurrency:=VariantToCurrency(Tmp);
varDate : VargDest.VDate:=VariantToDate(tmp);
{$endif}
varOleStr : MakeWideString(VargDest.VoleStr, VariantToWideString(tmp));
varDispatch : Result:=VAR_TYPEMISMATCH;
varUnknown : Result:=VAR_TYPEMISMATCH;
@ -374,8 +384,11 @@ Type
Const
Supportedpsas : set of TVarTypes =
[varSmallint,varInteger,varSingle,varDouble,varCurrency,varDate,varOleStr,
varDispatch,varError,varBoolean,varVariant,varUnknown,varByte];
[varSmallint,varInteger,
{$ifndef FPUNONE}
varSingle,varDouble,varCurrency,varDate,
{$endif}
varOleStr,varDispatch,varError,varBoolean,varVariant,varUnknown,varByte];
psaElementSizes : Array [varEmpty..varByte] of Byte =
(0,0,2,4,4,8,8,8,4,4,4,2,16,4,0,0,0,1);
psaElementFlags : Array [varEmpty..varByte] of Longint =

17
rtl/powerpc/powerpc.inc
View File

@ -34,6 +34,8 @@ const
ppc_fpu_invalid_snan = (1 shl (32-7));
}
{$ifndef FPUNONE}
procedure fpc_enable_ppc_fpu_exceptions;
assembler; nostackframe;
asm
@ -52,7 +54,6 @@ asm
mtfsfi 6,9
end;
procedure fpc_cpuinit;
begin
fpc_enable_ppc_fpu_exceptions;
@ -206,6 +207,14 @@ _restfpr_31_l: lwz r0, 4(r11)
end;
{$endif MACOS}
{$else}
procedure fpc_cpuinit;
begin
end;
{$endif}
{****************************************************************************
Move / Fill
****************************************************************************}
@ -333,7 +342,7 @@ asm
{ r0 := count div 4, will be moved to ctr when copying dwords }
srwi r0,r5,2
{$ifndef ppc603}
{$if not defined(ppc603) and not defined(FPUNONE)}
{ adjust the update count: it will now be 8 or -8 depending on overlap }
slwi r10,r10,1
@ -451,7 +460,9 @@ var
temp : packed record
case byte of
0: (l1,l2: longint);
{$ifndef FPUNONE}
1: (d: double);
{$endif}
end;
{$endif FPC_ABI_AIX}
asm
@ -480,6 +491,7 @@ asm
add r3,r3,r10
{ decrease count with number of bytes already stored }
sub r4,r4,r10
{$IFNDEF FPUNONE}
blt cr1,.LFillCharSmall
{$IFDEF USE_DCBZ}
{ if we have to fill with 0 (which happens a lot), we can simply use }
@ -559,6 +571,7 @@ asm
addi r3,r3,8
b .LFillCharVerySmall
.LFillCharSmall:
{$ENDIF FPUNONE}
{ when we arrive here, we're already 4 byte aligned }
{ get count div 4 to store dwords }
srwi r10,r4,2

72
rtl/powerpc/setjump.inc
View File

@ -20,44 +20,80 @@ function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJM
mflr r0
stw r2,4(r3)
stw r14,12(r3)
{$ifndef FPUNONE}
stfd f14,88(r3)
{$endif}
stw r0,8(r3)
stw r15,16(r3)
{$ifndef FPUNONE}
stfd f15,96(r3)
{$endif}
mfcr r0
stw r16,20(r3)
{$ifndef FPUNONE}
stfd f16,104(r3)
{$endif}
stw r0,84(r3)
stw r17,24(r3)
{$ifndef FPUNONE}
stfd f17,112(r3)
{$endif}
stw r18,28(r3)
{$ifndef FPUNONE}
stfd f18,120(r3)
{$endif}
stw r19,32(r3)
{$ifndef FPUNONE}
stfd f19,128(r3)
{$endif}
stw r20,36(r3)
{$ifndef FPUNONE}
stfd f20,136(r3)
{$endif}
stw r21,40(r3)
{$ifndef FPUNONE}
stfd f21,144(r3)
{$endif}
stw r22,44(r3)
{$ifndef FPUNONE}
stfd f22,152(r3)
{$endif}
stw r23,48(r3)
{$ifndef FPUNONE}
stfd f23,160(r3)
{$endif}
stw r24,52(r3)
{$ifndef FPUNONE}
stfd f24,168(r3)
{$endif}
stw r25,56(r3)
{$ifndef FPUNONE}
stfd f25,176(r3)
{$endif}
stw r26,60(r3)
{$ifndef FPUNONE}
stfd f26,184(r3)
{$endif}
stw r27,64(r3)
{$ifndef FPUNONE}
stfd f27,192(r3)
{$endif}
stw r28,68(r3)
{$ifndef FPUNONE}
stfd f28,200(r3)
{$endif}
stw r29,72(r3)
{$ifndef FPUNONE}
stfd f29,208(r3)
{$endif}
stw r30,76(r3)
{$ifndef FPUNONE}
stfd f30,216(r3)
{$endif}
stw r31,80(r3)
{$ifndef FPUNONE}
stfd f31,224(r3)
{$endif}
li r3,0
end;
@ -67,44 +103,80 @@ procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'F
lwz r2,4(r3)
lwz r0,8(r3)
lwz r14,12(r3)
{$ifndef FPUNONE}
lfd f14,88(r3)
{$endif}
lwz r15,16(r3)
{$ifndef FPUNONE}
lfd f15,96(r3)
{$endif}
lwz r16,20(r3)
{$ifndef FPUNONE}
lfd f16,104(r3)
{$endif}
lwz r17,24(r3)
{$ifndef FPUNONE}
lfd f17,112(r3)
{$endif}
lwz r18,28(r3)
{$ifndef FPUNONE}
lfd f18,120(r3)
{$endif}
lwz r19,32(r3)
{$ifndef FPUNONE}
lfd f19,128(r3)
{$endif}
lwz r20,36(r3)
{$ifndef FPUNONE}
lfd f20,136(r3)
{$endif}
mtlr r0
lwz r21,40(r3)
{$ifndef FPUNONE}
lfd f21,144(r3)
{$endif}
lwz r22,44(r3)
{$ifndef FPUNONE}
lfd f22,152(r3)
{$endif}
lwz r0,84(r3)
lwz r23,48(r3)
{$ifndef FPUNONE}
lfd f23,160(r3)
{$endif}
lwz r24,52(r3)
{$ifndef FPUNONE}
lfd f24,168(r3)
{$endif}
lwz r25,56(r3)
{$ifndef FPUNONE}
lfd f25,176(r3)
{$endif}
mtcrf 0xff,r0
lwz r26,60(r3)
{$ifndef FPUNONE}
lfd f26,184(r3)
{$endif}
lwz r27,64(r3)
{$ifndef FPUNONE}
lfd f27,192(r3)
{$endif}
lwz r28,68(r3)
{$ifndef FPUNONE}
lfd f28,200(r3)
{$endif}
lwz r29,72(r3)
{$ifndef FPUNONE}
lfd f29,208(r3)
{$endif}
lwz r30,76(r3)
{$ifndef FPUNONE}
lfd f30,216(r3)
{$endif}
lwz r31,80(r3)
{$ifndef FPUNONE}
lfd f31,224(r3)
{$endif}
mr r3,r4
end;

2
rtl/powerpc/setjumph.inc
View File

@ -17,7 +17,9 @@
type
jmp_buf = packed record
r1,r2,lr,r14,r15,r16,r17,r18,r19,r20,r21,r22,r23,r24,r25,r26,r27,r28,r29,r30,r31,cr : dword;
{$ifndef FPUNONE}
f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30,f31 : double;
{$endif}
end;
pjmp_buf = ^jmp_buf;

2
rtl/unix/aliasctp.inc
View File

@ -48,7 +48,9 @@ type
cslong = UnixType.cslong; pcslong = UnixType.pcslong;
culong = UnixType.culong; pculong = UnixType.pculong;
{$ifndef FPUNONE}
cfloat = UnixType.cfloat; pcfloat = UnixType.pcfloat;
cdouble = UnixType.cdouble; pcdouble = UnixType.pcdouble;
// clongdouble = UnixType.clongdouble; pclongdouble = UnixType.pclongdouble;
{$endif}

2
rtl/unix/ctypes.inc
View File

@ -59,7 +59,9 @@ type
culong = cardinal; pculong = ^culong;
{$endif}
{$ifndef FPUNONE}
cfloat = single; pcfloat = ^cfloat;
cdouble = double; pcdouble = ^cdouble;
clongdouble = extended; pclongdouble = ^clongdouble;
{$endif}

6
rtl/unix/sysutils.pp
View File

@ -248,6 +248,7 @@ begin
FileTruncate:=fpftruncate(Handle,Size)>=0;
end;
{$ifndef FPUNONE}
Function UnixToWinAge(UnixAge : time_t): Longint;
Var
@ -269,6 +270,7 @@ begin
else
Result:=UnixToWinAge(info.st_mtime);
end;
{$endif}
Function FileExists (Const FileName : String) : Boolean;
@ -432,7 +434,9 @@ begin
f.Attr:=WinAttr;
f.Size:=st.st_Size;
f.Mode:=st.st_mode;
{$ifndef FPUNONE}
f.Time:=UnixToWinAge(st.st_mtime);
{$endif}
result:=true;
End;
end;
@ -777,6 +781,7 @@ End;
{$ifndef FPUNONE}
Procedure GetLocalTime(var SystemTime: TSystemTime);
var
@ -786,6 +791,7 @@ begin
GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
// SystemTime.MilliSecond := 0;
end ;
{$endif}
Procedure InitAnsi;

2
tests/test/tmove.pp
View File

@ -1,3 +1,5 @@
{ %TIMEOUT=20 }
const
err: boolean = false;