ARM.ARMRuntime.Mod 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674
  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. (* stub in order to make the runtime itself compile, cf next procedure. This module needs to be compiled with FPU support on *)
  375. PROCEDURE ConvF64U32*(x: UNSIGNED32): FLOAT64;
  376. BEGIN
  377. HALT(100);
  378. END ConvF64U32;
  379. (* if an FPU64 is available, the result must be made available via FPU register *)
  380. PROCEDURE ConvF64S64F*(x: DoubleWord): LONGREAL;
  381. VAR l,h:LONGREAL;
  382. BEGIN
  383. l := x.low;
  384. h := x.high;
  385. RETURN h * 100000000H + l;
  386. END ConvF64S64F;
  387. (* only called when no FPU64 is available *)
  388. PROCEDURE ConvF64S32*(x: LONGINT): FLOAT64;
  389. VAR flt: FLOAT64;
  390. BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
  391. END ConvF64S32;
  392. (* only called when no FPU64 is available *)
  393. PROCEDURE ConvF64S16*(x: INTEGER): FLOAT64;
  394. VAR flt: FLOAT64;
  395. BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
  396. END ConvF64S16;
  397. (* only called when no FPU32 is available *)
  398. PROCEDURE ConvF32S16*(x: INTEGER): FLOAT32;
  399. BEGIN
  400. RETURN ConvF32S32(LONGINT(x))
  401. END ConvF32S16;
  402. (* only called when no FPU32 is available *)
  403. PROCEDURE ConvF32S8*(x: SHORTINT): FLOAT32;
  404. BEGIN
  405. RETURN ConvF32S16(INTEGER(x))
  406. END ConvF32S8;
  407. (* only called when no FPU64 is available *)
  408. PROCEDURE ConvF64S8*(x: SHORTINT): FLOAT64;
  409. BEGIN
  410. RETURN ConvF64S16(INTEGER(x))
  411. END ConvF64S8;
  412. (* only called when no FPU32 is available *)
  413. PROCEDURE SubF32*(left, right: FLOAT32): FLOAT32;
  414. BEGIN RETURN AddF32(left, NegF32(right))
  415. END SubF32;
  416. (* only called when no FPU32 is available *)
  417. PROCEDURE MulF32*(x, y: FLOAT32): FLOAT32;
  418. VAR xe, zh, ye, s: LONGINT; (*zh, ye in this order; ye used as zh in MULD*)
  419. BEGIN
  420. IF SYSTEM.NULL(y) = TRUE THEN x := 0
  421. ELSIF SYSTEM.NULL(y) = FALSE THEN
  422. s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
  423. xe := x DIV C MOD E; (* exponent with bias *)
  424. ye := y DIV C MOD E; (* exponent with bias *)
  425. x := (x MOD C + C) * 20H;
  426. y := (y MOD C + C) * 20H;
  427. xe := xe + ye - B; (* exponent with bias *)
  428. SYSTEM.MULD(ye, x, y); (* note that this implicitly changes zh *)
  429. IF zh >= 4*C THEN
  430. x := (zh+2) DIV 4;
  431. INC(xe);
  432. ELSE
  433. x := (zh+1) DIV 2;
  434. END;
  435. IF xe < 0 THEN (* underflow *)
  436. x := 0;
  437. ELSIF xe > 0FEH THEN (* overflow *)
  438. x := MAXFLOAT32 + s;
  439. ELSE
  440. x := xe*C + (x-C) + s;
  441. END;
  442. END ;
  443. RETURN x
  444. END MulF32;
  445. (* only called when no FPU32 is available *)
  446. PROCEDURE DivF32*(x, y: FLOAT32): FLOAT32;
  447. VAR xe, ye, q, s: LONGINT;
  448. BEGIN
  449. s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
  450. IF SYSTEM.NULL(y) = TRUE THEN
  451. x := MAXFLOAT32 + s;
  452. ELSIF SYSTEM.NULL(x) = FALSE THEN
  453. xe := x DIV C MOD E; (* exponent with bias *)
  454. ye := y DIV C MOD E; (* exponent with bias *)
  455. x := x MOD C + C;
  456. y := y MOD C + C;
  457. xe := xe - ye + B; (* exponent with bias *)
  458. IF x < y THEN
  459. x := x*2; DEC(xe);
  460. END ;
  461. IF xe < 0 THEN (* underflow *)
  462. x := 0;
  463. ELSIF xe > 0FEH THEN (* overflow *)
  464. x := MAXFLOAT32 + s;
  465. ELSE (* divide *)
  466. q := 0;
  467. WHILE q < LONGINT(1000000H) DO (* 2*C *)
  468. q := 2*q;
  469. IF x >= y THEN
  470. x := x - y;
  471. INC(q);
  472. END;
  473. x := 2*x;
  474. END;
  475. q := (q+1) DIV 2; (*round*)
  476. x := xe*C + (q-C) + s;
  477. END;
  478. END;
  479. RETURN x
  480. END DivF32;
  481. (** converts a float into an integer, ignores the fractional part
  482. - corresponds to ENTIER(x) **)
  483. PROCEDURE ConvS32F32*(x: FLOAT32): LONGINT;
  484. VAR xe, s: LONGINT;
  485. BEGIN
  486. IF SYSTEM.NULL(x) = TRUE THEN
  487. x := 0
  488. ELSE
  489. s := x; xe := x DIV C MOD E - B; x := x MOD C + C;
  490. IF s < 0 THEN x := -x END ;
  491. IF xe < 24 THEN x := ASH(x, xe - 23)
  492. ELSIF xe < 31 THEN x := LSH(x, xe - 23)
  493. ELSIF s < 0 THEN x := LONGINT(80000000H);
  494. ELSE x := LONGINT(7FFFFFFFH);
  495. END;
  496. END ;
  497. RETURN x
  498. END ConvS32F32;
  499. (** converts an integer into a float, ignores the non-integer part
  500. - corresponds to REAL(int)
  501. - note that no rounding occurs
  502. only called when no FPU32 is available
  503. **)
  504. PROCEDURE ConvF32S32*(x: LONGINT): FLOAT32;
  505. VAR xe, s: LONGINT;
  506. BEGIN
  507. IF x = LONGINT(80000000H) THEN (* ABS cannot handle the most negative LONGINT number! *)
  508. x := LONGINT(0CF000000H);
  509. ELSIF x # 0 THEN
  510. s := x;
  511. x := ABS(x); xe := 23;
  512. WHILE x >= 2*C DO
  513. x := x DIV 2; INC(xe);
  514. END;
  515. WHILE x < C DO
  516. x := 2*x; DEC(xe);
  517. END;
  518. x := (xe + B)*C - C + x;
  519. IF s < 0 THEN x := x+S END
  520. END ;
  521. RETURN x
  522. END ConvF32S32;
  523. (* only called when no FPU32 is available *)
  524. PROCEDURE ConvF32S64*(x: HUGEINT): FLOAT32;
  525. BEGIN
  526. RETURN ConvF32F64(ConvF64S64(x))
  527. END ConvF32S64;
  528. (* stub in order to make the runtime itself compile, cf next procedure. This module needs to be compiled with FPU support on *)
  529. PROCEDURE ConvF32U32*(x: UNSIGNED32): FLOAT32;
  530. BEGIN
  531. HALT(100);
  532. END ConvF32U32;
  533. (* if an FPU32 is available, the result must be made available via FPU register *)
  534. PROCEDURE ConvF32S64F*(x: DoubleWord): REAL;
  535. VAR l,h:REAL;
  536. BEGIN
  537. l := x.low;
  538. h := x.high;
  539. RETURN h * 100000000H + l;
  540. END ConvF32S64F;
  541. (* ---- STRING OPERATIONS ---- *)
  542. (** compare two strings
  543. - returns 0 if both strings are lexicographically equal
  544. - returns +1 if 'left' is lexicographically greater than 'right'
  545. - returns -1 if 'left' is lexicographically less than 'right'
  546. **)
  547. PROCEDURE CompareString*(CONST left, right: ARRAY OF CHAR): SHORTINT;
  548. VAR
  549. result: SHORTINT;
  550. i: LONGINT;
  551. leftChar, rightChar: CHAR;
  552. BEGIN
  553. result := 0;
  554. i := 0;
  555. REPEAT
  556. leftChar := left[i]; rightChar := right[i];
  557. IF leftChar < rightChar THEN result := -1
  558. ELSIF leftChar > rightChar THEN result := +1
  559. END;
  560. INC(i)
  561. UNTIL (result # 0) OR (leftChar = 0X) OR (rightChar = 0X);
  562. RETURN result
  563. END CompareString;
  564. (** copy a string from 'source' to 'destination'
  565. - note that PACO semantics are used **)
  566. PROCEDURE CopyString*(VAR destination: ARRAY OF CHAR; CONST source: ARRAY OF CHAR);
  567. VAR
  568. sourceLength, destinationLength: LONGINT;
  569. BEGIN
  570. destinationLength := LEN(destination);
  571. sourceLength := LEN(source);
  572. IF destinationLength < sourceLength THEN sourceLength := destinationLength END;
  573. SYSTEM.MOVE(ADDRESSOF(source[0]), ADDRESSOF(destination[0]), sourceLength)
  574. END CopyString;
  575. END ARMRuntime.