/packages/libogcfpc/src/ogc/cast.inc

https://github.com/slibre/freepascal · Pascal · 275 lines · 219 code · 41 blank · 15 comment · 0 complexity · 848de6935529807be91af39685f15f25 MD5 · raw file

  1. {$IFDEF OGC_INTERFACE}
  2. const
  3. // GQR2 = 914;
  4. // GQR3 = 915;
  5. // GQR4 = 916;
  6. // GQR5 = 917;
  7. // GQR6 = 918;
  8. // GQR7 = 919;
  9. GQR_TYPE_F32 = 0;
  10. GQR_TYPE_U8 = 4;
  11. GQR_TYPE_U16 = 5;
  12. GQR_TYPE_S8 = 6;
  13. GQR_TYPE_S16 = 7;
  14. GQR_CAST_U8 = 2;
  15. GQR_CAST_U16 = 3;
  16. GQR_CAST_S8 = 4;
  17. GQR_CAST_S16 = 5;
  18. {$ifdef GEKKO}
  19. procedure __set_gqr(_reg,_val: cint); inline;
  20. procedure CAST_Init(); inline;
  21. procedure CAST_SetGQR2(_type, scale: cuint32); inline;
  22. procedure CAST_SetGQR3(_type, scale: cuint32); inline;
  23. procedure CAST_SetGQR4(_type, scale: cuint32); inline;
  24. procedure CAST_SetGQR5(_type, scale: cuint32); inline;
  25. procedure CAST_SetGQR6(_type, scale: cuint32); inline;
  26. procedure CAST_SetGQR7(_type, scale: cuint32); inline;
  27. function __castu8f32(_in: pcuint8): f32; inline;
  28. function __castu16f32(_in: pcuint16): f32; inline;
  29. function __casts8f32(_in: pcint8): f32; inline
  30. function __casts16f32(register s16 *in): f32; inline;
  31. procedure castu8f32(_in: pcuint8; out _out: pf32); inline;
  32. procedure castu16f32(_in: pcuint16; out _out: pf32); inline;
  33. procedure casts8f32(_in: pcint8; out _out: pf32); inline;
  34. procedure casts16f32(_in: pcint16; out _out: pf32); inline;
  35. function __castf32u8(_in: f32): cuint8; inline;
  36. function __castf32u16(_in: f32): cuint16; inline;
  37. function __castf32s8(_in: f32): cint8; inline;
  38. function __castf32s16(_in: f32): cint16; inline;
  39. procedure castf32u8(_in: pf32; out _out: pcuint8); inline;
  40. procedure castf32u16(_in: pf32; out _out: pcuint16); inline;
  41. procedure castf32s8(_in: pf32; out _out: pcint8); inline;
  42. procedure castf32s16(_in: pf32; out _out: pcint16); inline;
  43. {$endif GEKKO}
  44. {$ENDIF OGC_INTERFACE}
  45. {$IFDEF OGC_IMPLEMENTATION}
  46. {$ifdef GEKKO}
  47. procedure __set_gqr(_reg,_val: cint); inline;
  48. begin
  49. asm
  50. mtspr r3,r4
  51. end;
  52. end;
  53. // does a default init
  54. procedure CAST_Init(); inline;
  55. begin
  56. asm
  57. li 3,0x0004
  58. oris 3,3,0x0004
  59. mtspr 914,3
  60. li 3,0x0005
  61. oris 3,3,0x0005
  62. mtspr 915,3
  63. li 3,0x0006
  64. oris 3,3,0x0006
  65. mtspr 916,3
  66. li 3,0x0007
  67. oris 3,3,0x0007
  68. mtspr 917,3
  69. end;
  70. end;
  71. procedure CAST_SetGQR2(_type, scale: cuint32); inline;
  72. var
  73. val: cuint32;
  74. begin
  75. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  76. __set_gqr(GQR2,val);
  77. end;
  78. procedure CAST_SetGQR3(_type, scale: cuint32); inline;
  79. var
  80. val: cuint32;
  81. begin
  82. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  83. __set_gqr(GQR3,val);
  84. end;
  85. procedure CAST_SetGQR4(_type, scale: cuint32); inline;
  86. var
  87. val: cuint32;
  88. begin
  89. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  90. __set_gqr(GQR4,val);
  91. end;
  92. procedure CAST_SetGQR5(_type, scale: cuint32); inline;
  93. var
  94. val: cuint32;
  95. begin
  96. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  97. __set_gqr(GQR5,val);
  98. end;
  99. procedure CAST_SetGQR6(_type, scale: cuint32); inline;
  100. var
  101. val: cuint32;
  102. begin
  103. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  104. __set_gqr(GQR6,val);
  105. end;
  106. procedure CAST_SetGQR7(_type, scale: cuint32); inline;
  107. var
  108. val: cuint32;
  109. begin
  110. val := (((((scale) shl 8) or (_type)) shl 16) or (((scale) shl 8) or (_type)));
  111. __set_gqr(GQR7,val);
  112. end;
  113. function __castu8f32(_in: pcuint8): f32; inline;
  114. var
  115. rval: f32;
  116. begin
  117. asm
  118. psq_l %[rval],0(%[_in]),1,2
  119. end;
  120. result := rval;
  121. end;
  122. function __castu16f32(_in: pcuint16): f32; inline;
  123. var
  124. rval: f32;
  125. begin
  126. asm
  127. psq_l %[rval],0(%[in]),1,3
  128. end;
  129. result := rval;
  130. end;
  131. function __casts8f32(_in: pcint8): f32; inline
  132. var
  133. rval: f32;
  134. begin
  135. asm
  136. psq_l %[rval],0(%[in]),1,4
  137. end;
  138. result := rval;
  139. end;
  140. function __casts16f32(register s16 *in): f32; inline;
  141. var
  142. rval: f32;
  143. begin
  144. asm
  145. psq_l %[rval],0(%[in]),1,5
  146. end;
  147. result := rval;
  148. end;
  149. procedure castu8f32(_in: pcuint8; out _out: pf32); inline;
  150. begin
  151. _out^ := __castu8f32(_in);
  152. end;
  153. procedure castu16f32(_in: pcuint16; out _out: pf32); inline;
  154. begin
  155. _out^ := __castu16f32(_in);
  156. end;
  157. procedure casts8f32(_in: pcint8; out _out: pf32); inline;
  158. begin
  159. _out^ := __casts8f32(_in);
  160. end;
  161. procedure casts16f32(_in: pcint16; out _out: pf32); inline;
  162. begin
  163. _out^ := __casts16f32(_in);
  164. end;
  165. function __castf32u8(_in: f32): cuint8; inline;
  166. var
  167. a: f32;
  168. rval: cuint8;
  169. ptr: pf32;
  170. begin
  171. ptr := @a;
  172. asm
  173. psq_st %[in],0(%[ptr]),1,2
  174. lbz %[out],0(%[ptr])
  175. end;
  176. result := rval;
  177. end;
  178. function __castf32u16(_in: f32): cuint16; inline;
  179. var
  180. a: f32;
  181. rval: cuint16;
  182. ptr: pf32;
  183. begin
  184. ptr := @a;
  185. asm
  186. psq_st %[in],0(%[ptr]),1,3
  187. lhz %[out],0(%[ptr])
  188. end;
  189. result := rval;
  190. end;
  191. function __castf32s8(_in: f32): cint8; inline;
  192. var
  193. a: f32;
  194. rval: cint8;
  195. ptr: pf32;
  196. begin
  197. ptr := @a;
  198. asm
  199. psq_st %[in],0(%[ptr]),1,4
  200. lbz %[out],0(%[ptr])
  201. end;
  202. result := rval;
  203. end;
  204. function __castf32s16(_in: f32): cint16; inline;
  205. var
  206. a: f32;
  207. rval: cint16;
  208. ptr: pf32;
  209. begin
  210. ptr := @a;
  211. asm
  212. psq_st %[in],0(%[ptr]),1,5
  213. lha %[out],0(%[ptr])
  214. end;
  215. result := rval;
  216. end;
  217. procedure castf32u8(_in: pf32; out _out: pcuint8); inline;
  218. begin
  219. _out^ := __castf32u8(_in^);
  220. end;
  221. procedure castf32u16(_in: pf32; out _out: pcuint16); inline;
  222. begin
  223. _out^ := __castf32u16(_in^);
  224. end;
  225. procedure castf32s8(_in: pf32; out _out: pcint8); inline;
  226. begin
  227. _out^ := __castf32s8(_in^);
  228. end;
  229. procedure castf32s16(_in: pf32; out _out: pcint16); inline;
  230. begin
  231. _out^ := __castf32s16(_in^);
  232. end;
  233. {$endif GEKKO}
  234. {$endif OGC_IMPLEMENTATION}