ARM.ARMRuntime.Mod 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662
  1. MODULE ARMRuntime;
  2. IMPORT SYSTEM, FPE64;
  3. CONST
  4. B = 127;
  5. C = 800000H;
  6. E = 100H;
  7. S = LONGINT(80000000H); (* used by VFP unit emulation *)
  8. MAXFLOAT32 = LONGINT(7F7FFFFFH);
  9. TYPE
  10. ULONGINT = LONGINT; (* alias to make distinction between signed and unsigned more clear *)
  11. UHUGEINT = HUGEINT;
  12. FLOAT32 = LONGINT; (* alias to make clear that the integer actually contains a IEEE 32 bit float *)
  13. FLOAT64= HUGEINT;
  14. DoubleWord = RECORD
  15. low*: UNSIGNED32; high*: SIGNED32;
  16. END;
  17. PROCEDURE DivS8*(left, right: SHORTINT): SHORTINT;
  18. VAR result, dummy: LONGINT;
  19. BEGIN DivModS32(left, right, result, dummy); RETURN SHORTINT(result)
  20. END DivS8;
  21. PROCEDURE DivS16*(left, right: INTEGER): INTEGER;
  22. VAR result, dummy: LONGINT;
  23. BEGIN DivModS32(left, right, result, dummy); RETURN INTEGER(result)
  24. END DivS16;
  25. PROCEDURE DivS32*(left, right: LONGINT): LONGINT;
  26. VAR result, dummy: LONGINT;
  27. BEGIN DivModS32(left, right, result, dummy); RETURN result
  28. END DivS32;
  29. PROCEDURE DivU32*(left, right: ULONGINT): ULONGINT;
  30. VAR result, dummy: LONGINT;
  31. BEGIN DivModU32(left, right, result, dummy); RETURN result
  32. END DivU32;
  33. PROCEDURE DivS64*(left, right: HUGEINT): HUGEINT;
  34. VAR result, dummy: HUGEINT;
  35. BEGIN
  36. DivModS64(left, right, result, dummy); RETURN result
  37. END DivS64;
  38. PROCEDURE ModS8*(left, right: SHORTINT): SHORTINT;
  39. VAR result, dummy: LONGINT;
  40. BEGIN DivModS32(left, right, dummy, result); RETURN SHORTINT(result)
  41. END ModS8;
  42. PROCEDURE ModS16*(left, right: INTEGER): INTEGER;
  43. VAR result, dummy: LONGINT;
  44. BEGIN DivModS32(left, right, dummy, result); RETURN INTEGER(result)
  45. END ModS16;
  46. PROCEDURE ModS32*(left, right: LONGINT): LONGINT;
  47. VAR result, dummy: LONGINT;
  48. BEGIN DivModS32(left, right, dummy, result); RETURN result
  49. END ModS32;
  50. PROCEDURE ModU32*(left, right: ULONGINT): ULONGINT;
  51. VAR result, dummy: LONGINT;
  52. BEGIN DivModU32(left, right, dummy, result); RETURN result
  53. END ModU32;
  54. PROCEDURE ModS64*(left, right: HUGEINT): HUGEINT;
  55. VAR result, dummy: HUGEINT;
  56. BEGIN
  57. DivModS64(left, right, dummy, result); RETURN result
  58. END ModS64;
  59. PROCEDURE RolS64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
  60. CODE
  61. LDR R2, [FP, #+8] ; R2 := amount
  62. LDR R3, [FP, #+12] ; R3 := source[Low]
  63. LDR R4, [FP, #+16] ; R4 := source[High]
  64. ; source = R4:R3
  65. AND R2, R2, #3FH ; R2 := R2 MOD 64
  66. CMP R2, #32
  67. ; IF R2 < 32:
  68. MOVLT R0, R3, LSL R2
  69. MOVLT R1, R4, LSL R2
  70. RSBLT R2, R2, #32 ; R2 := 32 - R2
  71. ORRLT R0, R0, R4, LSR R2
  72. ORRLT R1, R1, R3, LSR R2
  73. ; IF R2 >= 32:
  74. SUBGE R2, R2, #32 ; R2 := R2 - 32
  75. MOVGE R0, R4, LSL R2
  76. MOVGE R1, R3, LSL R2
  77. RSBGE R2, R2, #32 ; R2 := 32 - R2
  78. ORRGE R0, R0, R3, LSR R2
  79. ORRGE R1, R1, R4, LSR R2
  80. ; result = R1:R0
  81. END RolS64;
  82. PROCEDURE RolU64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
  83. BEGIN RETURN RolS64(source, amount)
  84. END RolU64;
  85. PROCEDURE RorS64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
  86. BEGIN RETURN RolS64(source, 64 - (amount MOD 64))
  87. END RorS64;
  88. PROCEDURE RorU64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
  89. BEGIN RETURN RolS64(source, 64 - (amount MOD 64))
  90. END RorU64;
  91. (* signed division and modulus
  92. - note: this implements the mathematical definition of DIV and MOD in contrast to the symmetric one
  93. *)
  94. PROCEDURE DivModS32(dividend, divisor: LONGINT; VAR quotient, remainder: LONGINT);
  95. BEGIN
  96. ASSERT(divisor > 0);
  97. IF dividend >= 0 THEN
  98. DivModU32(dividend, divisor, quotient, remainder)
  99. ELSE
  100. dividend := -dividend;
  101. DivModU32(dividend, divisor, quotient, remainder);
  102. quotient := -quotient;
  103. IF remainder # 0 THEN
  104. DEC(quotient);
  105. remainder := divisor - remainder
  106. END
  107. END
  108. END DivModS32;
  109. (*
  110. Fast 32-bit unsigned integer division/modulo (author Alexey Morozov)
  111. *)
  112. PROCEDURE DivModU32*(dividend, divisor: ULONGINT; VAR quotient, remainder: ULONGINT);
  113. CODE
  114. MOV R2, #0 ; quotient will be stored in R2
  115. LDR R0, [FP,#dividend] ; R0 := dividend
  116. LDR R1, [FP,#divisor] ; R1 := divisor
  117. ; check for the case dividend < divisor
  118. CMP R0, R1
  119. BEQ Equal
  120. BLS Exit ; nothing to do than setting quotient to 0 and remainder to dividend (R0)
  121. CLZ R3, R0 ; R3 := clz(dividend)
  122. CLZ R4, R1 ; R4 := clz(divisor)
  123. SUB R3, R4, R3 ; R2 := clz(divisor) - clz(dividend) , R2 >= 0
  124. LSL R1, R1, R3 ; scale divisor: divisor := LSH(divisor,clz(divisor)-clz(dividend))
  125. Loop:
  126. CMP R0, R1
  127. ADC R2, R2, R2
  128. SUBCS R0, R0, R1
  129. LSR R1, R1, #1
  130. SUBS R3, R3, #1
  131. BPL Loop
  132. ; R0 holds the remainder
  133. B Exit
  134. Equal:
  135. MOV R2, #1
  136. MOV R0, #0
  137. Exit:
  138. LDR R1, [FP,#quotient] ; R1 := address of quotient
  139. LDR R3, [FP,#remainder] ; R3 := address of remainder
  140. STR R2, [R1,#0] ; quotient := R2
  141. STR R0, [R3,#0] ; remainder := R0
  142. END DivModU32;
  143. (**
  144. Signed 64-bit multiplication. Adapted version based on the original code
  145. from "Runtime ABI for the ARM Cortex-M0" (https://github.com/bobbl/libaeabi-cortexm0/blob/master/lmul.S)
  146. /* Runtime ABI for the ARM Cortex-M0
  147. * lmul.S: 64 bit multiplication
  148. *
  149. * Copyright (c) 2013 Jörg Mische <bobbl@gmx.de>
  150. *
  151. * Permission to use, copy, modify, and/or distribute this software for any
  152. * purpose with or without fee is hereby granted, provided that the above
  153. * copyright notice and this permission notice appear in all copies.
  154. *
  155. * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  156. * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  157. * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  158. * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  159. * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  160. * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
  161. * OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  162. */
  163. Multiply r1:r0 and r3:r2 and return the product in r1:r0
  164. Can also be used for unsigned long product
  165. *)
  166. PROCEDURE MulS64*(x, y: HUGEINT): HUGEINT;
  167. CODE
  168. ldr r0, [FP,#x]
  169. ldr r1, [FP,#x+4]
  170. ldr r2, [FP,#y]
  171. ldr r3, [FP,#y+4]
  172. muls r1, r1, r2
  173. muls r3, r3, r0
  174. adds r1, r1, r3
  175. lsrs r3, r0, #16
  176. lsrs r4, r2, #16
  177. muls r3, r3, r4
  178. adds r1, r1, r3
  179. lsrs r3, r0, #16
  180. uxth r0, r0
  181. uxth r2, r2
  182. muls r3, r3, r2
  183. muls r4, r4, r0
  184. muls r0, r0, r2
  185. movs r2, #0
  186. adds r3, r3, r4
  187. adcs r2, r2, r2
  188. lsls r2, r2, #16
  189. adds r1, r1, r2
  190. lsls r2, r3, #16
  191. lsrs r3, r3, #16
  192. adds r0, r0, r2
  193. adcs r1, r1, r3
  194. END MulS64;
  195. (* signed division and modulus
  196. - note: this implements the mathematical definition of DIV and MOD in contrast to the symmetric one
  197. *)
  198. PROCEDURE DivModS64*(dividend, divisor: HUGEINT; VAR quotient, remainder: HUGEINT);
  199. BEGIN
  200. ASSERT(divisor > 0);
  201. IF dividend >= 0 THEN
  202. DivModU64(dividend, divisor, quotient, remainder)
  203. ELSE
  204. dividend := -dividend;
  205. DivModU64(dividend, divisor, quotient, remainder);
  206. quotient := -quotient;
  207. IF remainder # 0 THEN
  208. DEC(quotient);
  209. remainder := divisor - remainder
  210. END
  211. END
  212. END DivModS64;
  213. (* Count leading zeros in a binary representation of a given 64-bit integer number *)
  214. PROCEDURE Clz64*(x: UHUGEINT): LONGINT;
  215. CODE
  216. ; high-half
  217. LDR R1, [FP,#x+4]
  218. CMP R1, #0 ; if high-half is zero count leading zeros of the low-half
  219. BEQ LowHalf
  220. CLZ R0, R1
  221. B Exit
  222. ; low-half
  223. LowHalf:
  224. LDR R1, [FP,#x]
  225. CLZ R0, R1
  226. ADD R0, R0, #32 ; add 32 zeros from the high-half
  227. Exit:
  228. END Clz64;
  229. (*
  230. Fast 64-bit unsigned integer division/modulo (Alexey Morozov)
  231. *)
  232. PROCEDURE DivModU64*(dividend, divisor: UHUGEINT; VAR quotient, remainder: UHUGEINT);
  233. VAR m: LONGINT;
  234. BEGIN
  235. quotient := 0;
  236. IF dividend = 0 THEN remainder := 0; RETURN; END;
  237. IF dividend < divisor THEN remainder := dividend; RETURN; END;
  238. m := Clz64(divisor) - Clz64(dividend);
  239. ASSERT(m >= 0);
  240. divisor := LSH(divisor,m);
  241. WHILE m >= 0 DO
  242. quotient := LSH(quotient,1);
  243. IF dividend >= divisor THEN
  244. INC(quotient);
  245. DEC(dividend,divisor);
  246. END;
  247. divisor := LSH(divisor,-1);
  248. DEC(m);
  249. END;
  250. remainder := dividend;
  251. (*
  252. CODE
  253. ldr r0, [FP,#dividend]
  254. ldr r1, [FP,#dividend+4]
  255. ldr r2, [FP,#divisor]
  256. ldr r3, [FP,#divisor+4]
  257. ldr r5, [FP,#quotient]
  258. ldr r6, [FP,#remainder]
  259. str r0, [r5,#0]
  260. str r1, [r5,#4]
  261. str r2, [r6,#0]
  262. str r3, [r6,#4]
  263. *)
  264. END DivModU64;
  265. (* only called when no FPU64 is available *)
  266. PROCEDURE NegF32*(float: FLOAT32): FLOAT32;
  267. CODE
  268. LDR R0, [FP, #+float] ; R0 := float
  269. EOR R0, R0, #S ; invert only the sign bit
  270. END NegF32;
  271. (* only called when no FPU64 is available *)
  272. PROCEDURE AbsF32*(float: FLOAT32): FLOAT32;
  273. CODE
  274. LDR R0, [FP, #+float] ; R0 := float
  275. BIC R0, R0, #S ; clear the sign bit
  276. END AbsF32;
  277. (* only called when no FPU32 is available *)
  278. PROCEDURE AddF32*(x, y: FLOAT32): FLOAT32;
  279. VAR xe, ye, s: LONGINT;
  280. BEGIN
  281. IF SYSTEM.NULL(x) = TRUE THEN x := y
  282. ELSIF SYSTEM.NULL(y) = FALSE THEN
  283. xe := x DIV C MOD E; (* exponent with bias *)
  284. IF x >= 0 THEN x := (x MOD C + C)*2 ELSE x := -(x MOD C + C)*2 END ;
  285. ye := y DIV C MOD E; (* exponent with bias *)
  286. IF y >= 0 THEN y := (y MOD C + C)*2 ELSE y := -(y MOD C + C)*2 END ;
  287. IF xe < ye THEN
  288. ye := ye - xe; xe := xe + ye; (*denorm x*)
  289. IF ye <= 25 THEN x := ASH(x, -ye) ELSE x := 0 END
  290. ELSIF ye < xe THEN
  291. ye := xe - ye; (*denorm y*)
  292. IF ye <= 25 THEN y := ASH(y, -ye) ELSE y := 0 END
  293. END ;
  294. s := x + y; x := ABS(s);
  295. s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, s)*{31});
  296. IF x # 0 THEN
  297. IF x >= 4*C THEN x := (x+2) DIV 4; INC(xe)
  298. ELSIF x >= 2*C THEN x := (x+1) DIV 2
  299. ELSE DEC(xe);
  300. WHILE x < C DO x := 2*x; DEC(xe) END
  301. END ;
  302. IF xe < 0 THEN x := 0 (*underflow*)
  303. ELSIF xe > 0FEH THEN x := MAXFLOAT32 + s; (* overflow *)
  304. ELSE x := xe*C + (x - C) + s;
  305. END;
  306. END
  307. END ;
  308. RETURN x
  309. END AddF32;
  310. (* only called when no FPU64 is available *)
  311. PROCEDURE AddF64*(x,y: FLOAT64): FLOAT64;
  312. VAR z: FLOAT64;
  313. BEGIN FPE64.Add(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  314. END AddF64;
  315. (* only called when no FPU64 is available *)
  316. PROCEDURE MulF64*(x,y: FLOAT64): FLOAT64;
  317. VAR z: FLOAT64;
  318. BEGIN FPE64.Mul(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  319. END MulF64;
  320. (* only called when no FPU64 is available *)
  321. PROCEDURE DivF64*(x,y: FLOAT64): FLOAT64;
  322. VAR z: FLOAT64;
  323. BEGIN FPE64.Div(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  324. END DivF64;
  325. (* only called when no FPU64 is available *)
  326. PROCEDURE SubF64*(x,y: FLOAT64): FLOAT64;
  327. VAR z: FLOAT64;
  328. BEGIN FPE64.Sub(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  329. END SubF64;
  330. (* only called when no FPU64 is available *)
  331. PROCEDURE AbsF64*(x: FLOAT64): FLOAT64;
  332. VAR z: FLOAT64;
  333. BEGIN FPE64.Abs(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  334. END AbsF64;
  335. (* only called when no FPU64 is available *)
  336. PROCEDURE NegF64*(x: FLOAT64): FLOAT64;
  337. VAR z: FLOAT64;
  338. BEGIN FPE64.Neg(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  339. END NegF64;
  340. PROCEDURE ConvS32F64*(x: FLOAT64): LONGINT;
  341. BEGIN RETURN FPE64.Fix(SYSTEM.VAL(FPE64.Float64,x))
  342. END ConvS32F64;
  343. PROCEDURE ConvS64F64*(x: FLOAT64): HUGEINT;
  344. BEGIN RETURN FPE64.FixInt64(SYSTEM.VAL(FPE64.Float64,x))
  345. END ConvS64F64;
  346. PROCEDURE ConvS64F32*(x: FLOAT32): HUGEINT;
  347. VAR d: FPE64.Float64;
  348. BEGIN
  349. FPE64.Double(x, d);
  350. RETURN FPE64.FixInt64(d)
  351. END ConvS64F32;
  352. (* only called when no FPU32 is available *)
  353. PROCEDURE ConvF32F64*(x: FLOAT64): FLOAT32;
  354. BEGIN RETURN FPE64.Single(SYSTEM.VAL(FPE64.Float64,x))
  355. END ConvF32F64;
  356. (* if an FPU32 is available, the result must be made available via FPU register *)
  357. PROCEDURE ConvF32F64F*(x: FLOAT64): REAL;
  358. VAR r: FLOAT32;
  359. BEGIN
  360. r := FPE64.Single(SYSTEM.VAL(FPE64.Float64,x));
  361. RETURN SYSTEM.VAL(REAL, r);
  362. END ConvF32F64F;
  363. (* only called when no FPU64 is available *)
  364. PROCEDURE ConvF64F32*(x: FLOAT32): FLOAT64;
  365. VAR z: FLOAT64;
  366. BEGIN FPE64.Double(x,SYSTEM.VAL(FPE64.Float64,z)); RETURN z
  367. END ConvF64F32;
  368. (* only called when no FPU64 is available *)
  369. PROCEDURE ConvF64S64*(x: HUGEINT): FLOAT64;
  370. VAR flt: FLOAT64;
  371. BEGIN
  372. FPE64.FloatInt64(x, SYSTEM.VAL(FPE64.Float64, flt)); RETURN flt
  373. END ConvF64S64;
  374. (* if an FPU64 is available, the result must be made available via FPU register *)
  375. PROCEDURE ConvF64S64F*(x: DoubleWord): LONGREAL;
  376. VAR l,h:LONGREAL;
  377. BEGIN
  378. l := x.low;
  379. h := x.high;
  380. RETURN h * 100000000H + l;
  381. END ConvF64S64F;
  382. (* only called when no FPU64 is available *)
  383. PROCEDURE ConvF64S32*(x: LONGINT): FLOAT64;
  384. VAR flt: FLOAT64;
  385. BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
  386. END ConvF64S32;
  387. (* only called when no FPU64 is available *)
  388. PROCEDURE ConvF64S16*(x: INTEGER): FLOAT64;
  389. VAR flt: FLOAT64;
  390. BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
  391. END ConvF64S16;
  392. (* only called when no FPU32 is available *)
  393. PROCEDURE ConvF32S16*(x: INTEGER): FLOAT32;
  394. BEGIN
  395. RETURN ConvF32S32(LONGINT(x))
  396. END ConvF32S16;
  397. (* only called when no FPU32 is available *)
  398. PROCEDURE ConvF32S8*(x: SHORTINT): FLOAT32;
  399. BEGIN
  400. RETURN ConvF32S16(INTEGER(x))
  401. END ConvF32S8;
  402. (* only called when no FPU64 is available *)
  403. PROCEDURE ConvF64S8*(x: SHORTINT): FLOAT64;
  404. BEGIN
  405. RETURN ConvF64S16(INTEGER(x))
  406. END ConvF64S8;
  407. (* only called when no FPU32 is available *)
  408. PROCEDURE SubF32*(left, right: FLOAT32): FLOAT32;
  409. BEGIN RETURN AddF32(left, NegF32(right))
  410. END SubF32;
  411. (* only called when no FPU32 is available *)
  412. PROCEDURE MulF32*(x, y: FLOAT32): FLOAT32;
  413. VAR xe, zh, ye, s: LONGINT; (*zh, ye in this order; ye used as zh in MULD*)
  414. BEGIN
  415. IF SYSTEM.NULL(y) = TRUE THEN x := 0
  416. ELSIF SYSTEM.NULL(y) = FALSE THEN
  417. s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
  418. xe := x DIV C MOD E; (* exponent with bias *)
  419. ye := y DIV C MOD E; (* exponent with bias *)
  420. x := (x MOD C + C) * 20H;
  421. y := (y MOD C + C) * 20H;
  422. xe := xe + ye - B; (* exponent with bias *)
  423. SYSTEM.MULD(ye, x, y); (* note that this implicitly changes zh *)
  424. IF zh >= 4*C THEN
  425. x := (zh+2) DIV 4;
  426. INC(xe);
  427. ELSE
  428. x := (zh+1) DIV 2;
  429. END;
  430. IF xe < 0 THEN (* underflow *)
  431. x := 0;
  432. ELSIF xe > 0FEH THEN (* overflow *)
  433. x := MAXFLOAT32 + s;
  434. ELSE
  435. x := xe*C + (x-C) + s;
  436. END;
  437. END ;
  438. RETURN x
  439. END MulF32;
  440. (* only called when no FPU32 is available *)
  441. PROCEDURE DivF32*(x, y: FLOAT32): FLOAT32;
  442. VAR xe, ye, q, s: LONGINT;
  443. BEGIN
  444. s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
  445. IF SYSTEM.NULL(y) = TRUE THEN
  446. x := MAXFLOAT32 + s;
  447. ELSIF SYSTEM.NULL(x) = FALSE THEN
  448. xe := x DIV C MOD E; (* exponent with bias *)
  449. ye := y DIV C MOD E; (* exponent with bias *)
  450. x := x MOD C + C;
  451. y := y MOD C + C;
  452. xe := xe - ye + B; (* exponent with bias *)
  453. IF x < y THEN
  454. x := x*2; DEC(xe);
  455. END ;
  456. IF xe < 0 THEN (* underflow *)
  457. x := 0;
  458. ELSIF xe > 0FEH THEN (* overflow *)
  459. x := MAXFLOAT32 + s;
  460. ELSE (* divide *)
  461. q := 0;
  462. WHILE q < LONGINT(1000000H) DO (* 2*C *)
  463. q := 2*q;
  464. IF x >= y THEN
  465. x := x - y;
  466. INC(q);
  467. END;
  468. x := 2*x;
  469. END;
  470. q := (q+1) DIV 2; (*round*)
  471. x := xe*C + (q-C) + s;
  472. END;
  473. END;
  474. RETURN x
  475. END DivF32;
  476. (** converts a float into an integer, ignores the fractional part
  477. - corresponds to ENTIER(x) **)
  478. PROCEDURE ConvS32F32*(x: FLOAT32): LONGINT;
  479. VAR xe, s: LONGINT;
  480. BEGIN
  481. IF SYSTEM.NULL(x) = TRUE THEN
  482. x := 0
  483. ELSE
  484. s := x; xe := x DIV C MOD E - B; x := x MOD C + C;
  485. IF s < 0 THEN x := -x END ;
  486. IF xe < 24 THEN x := ASH(x, xe - 23)
  487. ELSIF xe < 31 THEN x := LSH(x, xe - 23)
  488. ELSIF s < 0 THEN x := LONGINT(80000000H);
  489. ELSE x := LONGINT(7FFFFFFFH);
  490. END;
  491. END ;
  492. RETURN x
  493. END ConvS32F32;
  494. (** converts an integer into a float, ignores the non-integer part
  495. - corresponds to REAL(int)
  496. - note that no rounding occurs
  497. only called when no FPU32 is available
  498. **)
  499. PROCEDURE ConvF32S32*(x: LONGINT): FLOAT32;
  500. VAR xe, s: LONGINT;
  501. BEGIN
  502. IF x = LONGINT(80000000H) THEN (* ABS cannot handle the most negative LONGINT number! *)
  503. x := LONGINT(0CF000000H);
  504. ELSIF x # 0 THEN
  505. s := x;
  506. x := ABS(x); xe := 23;
  507. WHILE x >= 2*C DO
  508. x := x DIV 2; INC(xe);
  509. END;
  510. WHILE x < C DO
  511. x := 2*x; DEC(xe);
  512. END;
  513. x := (xe + B)*C - C + x;
  514. IF s < 0 THEN x := x+S END
  515. END ;
  516. RETURN x
  517. END ConvF32S32;
  518. (* only called when no FPU32 is available *)
  519. PROCEDURE ConvF32S64*(x: HUGEINT): FLOAT32;
  520. BEGIN
  521. RETURN ConvF32F64(ConvF64S64(x))
  522. END ConvF32S64;
  523. (* if an FPU32 is available, the result must be made available via FPU register *)
  524. PROCEDURE ConvF32S64F*(x: DoubleWord): REAL;
  525. VAR l,h:REAL;
  526. BEGIN
  527. l := x.low;
  528. h := x.high;
  529. RETURN h * 100000000H + l;
  530. END ConvF32S64F;
  531. (* ---- STRING OPERATIONS ---- *)
  532. (** compare two strings
  533. - returns 0 if both strings are lexicographically equal
  534. - returns +1 if 'left' is lexicographically greater than 'right'
  535. - returns -1 if 'left' is lexicographically less than 'right'
  536. **)
  537. PROCEDURE CompareString*(CONST left, right: ARRAY OF CHAR): SHORTINT;
  538. VAR
  539. result: SHORTINT;
  540. i: LONGINT;
  541. leftChar, rightChar: CHAR;
  542. BEGIN
  543. result := 0;
  544. i := 0;
  545. REPEAT
  546. leftChar := left[i]; rightChar := right[i];
  547. IF leftChar < rightChar THEN result := -1
  548. ELSIF leftChar > rightChar THEN result := +1
  549. END;
  550. INC(i)
  551. UNTIL (result # 0) OR (leftChar = 0X) OR (rightChar = 0X);
  552. RETURN result
  553. END CompareString;
  554. (** copy a string from 'source' to 'destination'
  555. - note that PACO semantics are used **)
  556. PROCEDURE CopyString*(VAR destination: ARRAY OF CHAR; CONST source: ARRAY OF CHAR);
  557. VAR
  558. sourceLength, destinationLength: LONGINT;
  559. BEGIN
  560. destinationLength := LEN(destination);
  561. sourceLength := LEN(source);
  562. IF destinationLength < sourceLength THEN sourceLength := destinationLength END;
  563. SYSTEM.MOVE(ADDRESSOF(source[0]), ADDRESSOF(destination[0]), sourceLength)
  564. END CopyString;
  565. END ARMRuntime.