1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 2004 by Marco van de Voort, member of the 4 Free Pascal development team 5 6 Implements C types for in header conversions 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 15 16 **********************************************************************} 17 18unit ctypes; 19 20{$ifdef FPC} 21 {$inline on} 22 {$define dummy} 23{$endif} 24 25interface 26 27{$ifdef unix} 28uses unixtype; 29{$i aliasctp.inc} 30{$else} 31 32type 33{$ifndef FPC} 34 qword = int64; // Keep h2pas "uses ctypes" headers working with delphi. 35 ptruint = cardinal; 36 pptruint = ^ptruint; 37{$endif} 38 39 { the following type definitions are compiler dependant } 40 { and system dependant } 41 42 cint8 = shortint; pcint8 = ^cint8; 43 cuint8 = byte; pcuint8 = ^cuint8; 44 cchar = cint8; pcchar = ^cchar; 45 cschar = cint8; pcschar = ^cschar; 46 cuchar = cuint8; pcuchar = ^cuchar; 47 48 cint16 = smallint; pcint16 = ^cint16; 49 cuint16 = word; pcuint16 = ^cuint16; 50 cshort = cint16; pcshort = ^cshort; 51 csshort = cint16; pcsshort = ^csshort; 52 cushort = cuint16; pcushort = ^cushort; 53 54 cint32 = longint; pcint32 = ^cint32; 55 cuint32 = longword; pcuint32 = ^cuint32; 56 57 cint64 = int64; pcint64 = ^cint64; 58 cuint64 = qword; pcuint64 = ^cuint64; 59 clonglong = cint64; pclonglong = ^clonglong; 60 cslonglong = cint64; pcslonglong = ^cslonglong; 61 culonglong = cuint64; pculonglong = ^culonglong; 62 63 cbool = longbool; pcbool = ^cbool; 64 65{$if defined(cpu64) and not(defined(win64) and defined(cpux86_64))} 66 cint = cint32; pcint = ^cint; { minimum range is : 32-bit } 67 csint = cint32; pcsint = ^csint; { minimum range is : 32-bit } 68 cuint = cuint32; pcuint = ^cuint; { minimum range is : 32-bit } 69 clong = int64; pclong = ^clong; 70 cslong = int64; pcslong = ^cslong; 71 culong = qword; pculong = ^culong; 72{$elseif defined(cpu16)} 73 { 16-bit int sizes checked against Borland C++ 3.1 and Open Watcom 1.9 } 74 cint = cint16; pcint = ^cint; 75 csint = cint16; pcsint = ^csint; 76 cuint = cuint16; pcuint = ^cuint; 77 clong = longint; pclong = ^clong; 78 cslong = longint; pcslong = ^cslong; 79 culong = cardinal; pculong = ^culong; 80{$else} 81 cint = cint32; pcint = ^cint; { minimum range is : 32-bit } 82 csint = cint32; pcsint = ^csint; { minimum range is : 32-bit } 83 cuint = cuint32; pcuint = ^cuint; { minimum range is : 32-bit } 84 clong = longint; pclong = ^clong; 85 cslong = longint; pcslong = ^cslong; 86 culong = cardinal; pculong = ^culong; 87{$ifend} 88 89 csigned = cint; pcsigned = ^csigned; 90 cunsigned = cuint; pcunsigned = ^cunsigned; 91 92 csize_t = ptruint; pcsize_t = pptruint; 93 94// Kylix compat types 95 u_long = culong; 96 u_short = cushort; 97 coff_t = clong; 98 99{$ifndef FPUNONE} 100 cfloat = single; pcfloat = ^cfloat; 101 cdouble = double; pcdouble = ^cdouble; 102{$endif} 103{$endif} 104 105{$if defined(win64) or defined(wince) or defined(android)} 106 {$define longdouble_is_double} 107{$endif} 108 109{$if defined(linux) and (defined(cpupowerpc) or defined(cpuarm))} 110 {$define longdouble_is_double} 111{$ifend} 112 113{$if defined(darwin) and defined(cpuaarch64)} 114 {$define longdouble_is_double} 115{$ifend} 116 117{$ifndef FPUNONE} 118{$if defined(longdouble_is_double) or not defined(FPC_HAS_CEXTENDED)} 119 clongdouble=double; 120{$else} 121 {$if defined(cpui8086) or defined(cpui386) or defined(cpux86_64) or defined(cpuavr)} 122 clongdouble = cextended; 123 {$else} 124 {$define longdouble_assignment_overload_real128} 125 clongdouble = packed array [0..15] of byte; 126 {$ifend} 127{$ifend} 128 Pclongdouble=^clongdouble; 129 130{$ifdef longdouble_assignment_overload_real128} 131{Non-x86 typically doesn't have extended. To be fixed once this changes.} 132operator := (const v:clongdouble) r:double;inline; 133operator := (const v:double) r:clongdouble;inline; 134{$ifdef dummy} 135operator +(const e:Double;const c:clongdouble) r:Double;inline; 136operator +(const c:clongdouble;const e:Double) r:Double;inline; 137operator -(const e:Double;const c:clongdouble) r:Double;inline; 138operator -(const c:clongdouble;const e:Double) r:Double;inline; 139operator *(const e:Double;const c:clongdouble) r:Double;inline; 140operator *(const c:clongdouble;const e:Double) r:Double;inline; 141operator /(const e:Double;const c:clongdouble) r:Double;inline; 142operator /(const c:clongdouble;const e:Double) r:Double;inline; 143operator =(const e:Double;const c:clongdouble) r:boolean;inline; 144operator =(const c:clongdouble;const e:Double) r:boolean;inline; 145operator <(const e:Double;const c:clongdouble) r:boolean;inline; 146operator <(const c:clongdouble;const e:Double) r:boolean;inline; 147operator >(const e:Double;const c:clongdouble) r:boolean;inline; 148operator >(const c:clongdouble;const e:Double) r:boolean;inline; 149operator >=(const e:Double;const c:clongdouble) r:boolean;inline; 150operator >=(const c:clongdouble;const e:Double) r:boolean;inline; 151operator <=(const e:Double;const c:clongdouble) r:boolean;inline; 152operator <=(const c:clongdouble;const e:Double) r:boolean;inline; 153{$endif dummy} 154{$endif} 155{$endif FPUNONE} 156 157implementation 158 159{$ifndef FPUNONE} 160 161{$ifdef longdouble_assignment_overload_real128} 162 163{$ifdef ENDIAN_LITTLE} 164const r128_mantissa_ofs=0; 165 r128_exponent_ofs=14; 166{$else} 167const r128_mantissa_ofs=2; 168 r128_exponent_ofs=0; 169{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} 170 {$define USE_UNALIGNED} 171{$endif FPC_REQUIRES_PROPER_ALIGNMENT} 172{$endif} 173 174operator := (const v:clongdouble) r:double; 175var 176 exp : word; 177 mant : qword; 178 is_neg : boolean; 179begin 180 is_neg:=(pword(@v[r128_exponent_ofs])^and $8000)<>0; 181 exp:=((Pword(@v[r128_exponent_ofs])^and $7fff)-$4000)+$400; 182 if is_neg then 183 exp:=exp+$800; 184{$ifdef USE_UNALIGNED} 185 mant:=unaligned(Pqword(@v[r128_mantissa_ofs])^); 186{$else not USE_UNALIGNED} 187 mant:=Pqword(@v[r128_mantissa_ofs])^; 188{$endif not USE_UNALIGNED} 189 qword(r):=(qword(exp) shl 52) or 190 (mant shr 12); 191end; 192 193operator := (const v:double) r:clongdouble; 194var 195 is_neg : boolean; 196 exp : word; 197begin 198 is_neg:=(qword(v) shr 63) <> 0; 199 exp:=$4000 + ((qword(v) shr 52) and $7ff) -$400; 200 if is_neg then 201 exp:=exp+$8000; 202 Pword(@r[r128_exponent_ofs])^:=exp; 203{$ifdef USE_UNALIGNED} 204 unaligned(Pqword(@r[r128_mantissa_ofs])^):=qword(v) shl 12; 205 Pword(@r[r128_mantissa_ofs+8])^:=0; 206 Pword(@r[r128_mantissa_ofs+10])^:=0; 207{$else not USE_UNALIGNED} 208 Pqword(@r[r128_mantissa_ofs])^:=qword(v) shl 12; 209 Pcardinal(@r[r128_mantissa_ofs+8])^:=0; 210{$endif not USE_UNALIGNED} 211 Pword(@r[r128_mantissa_ofs+12])^:=0; 212end; 213 214{$ifdef dummy} 215 216// There is no record with a value field in this case 217 218operator +(const e:Double;const c:clongdouble) r:Double;inline; 219begin 220 r:=e+double(c); 221end; 222 223operator +(const c:clongdouble;const e:Double) r:Double;inline; 224begin 225 r:=double(c)+e; 226end; 227 228operator -(const e:Double;const c:clongdouble) r:Double;inline; 229begin 230 r:=e-double(c); 231end; 232 233operator -(const c:clongdouble;const e:Double) r:Double;inline; 234begin 235 r:=double(c)-e; 236end; 237 238operator *(const e:Double;const c:clongdouble) r:Double;inline; 239begin 240 r:=e*double(c); 241end; 242 243operator *(const c:clongdouble;const e:Double) r:Double;inline; 244begin 245 r:=double(c)*e; 246end; 247 248operator /(const e:Double;const c:clongdouble) r:Double;inline; 249begin 250 r:=e/double(c); 251end; 252 253operator /(const c:clongdouble;const e:Double) r:Double;inline; 254begin 255 r:=double(c)/e; 256end; 257 258operator =(const e:Double;const c:clongdouble) r:boolean;inline; 259begin 260 r:=e=double(c); 261end; 262 263operator =(const c:clongdouble;const e:Double) r:boolean;inline; 264begin 265 r:=double(c)=e; 266end; 267 268operator <(const e:Double;const c:clongdouble) r:boolean;inline; 269begin 270 r:=e<double(c); 271end; 272 273operator <(const c:clongdouble;const e:Double) r:boolean;inline; 274begin 275 r:=double(c)<e; 276end; 277 278operator >(const e:Double;const c:clongdouble) r:boolean;inline; 279begin 280 r:=e>double(c); 281end; 282 283operator >(const c:clongdouble;const e:Double) r:boolean;inline; 284begin 285 r:=double(c)>e; 286end; 287 288operator >=(const e:Double;const c:clongdouble) r:boolean;inline; 289begin 290 r:=e>=double(c); 291end; 292 293operator >=(const c:clongdouble;const e:Double) r:boolean;inline; 294begin 295 r:=double(c)>=e; 296end; 297 298operator <=(const e:Double;const c:clongdouble) r:boolean;inline; 299begin 300 r:=e<=double(c); 301end; 302 303operator <=(const c:clongdouble;const e:Double) r:boolean;inline; 304begin 305 r:=double(c)<=e; 306end; 307{$endif} 308{$endif} 309{$endif FPUNONE} 310 311end. 312