rttip.inc 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt
  5. member of the Free Pascal development team
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. { Run-Time type information routines - processor dependent part }
  13. { I think we should use the pascal version, this code isn't }
  14. { much faster }
  15. { $define FPC_SYSTEM_HAS_FPC_INITIALIZE}
  16. {
  17. Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
  18. assembler;
  19. asm
  20. // Save registers
  21. push %eax
  22. push %ebx
  23. push %ecx
  24. push %edx
  25. // decide what type it is
  26. movl TypeInfo,%ebx
  27. movb (%ebx),%al
  28. subb $9,%al
  29. jz .LDoAnsiStringInit
  30. decb %al
  31. jz .LDoAnsiStringInit
  32. decb %al
  33. jz .LDoVariantInit
  34. decb %al
  35. jz .LDoArrayInit
  36. decb %al
  37. jz .LDoRecordInit
  38. decb %al
  39. jz .LDoInterfaceInit
  40. decb %al
  41. jz .LDoClassInit
  42. decb %al
  43. jz .LDoObjectInit
  44. decb %al
  45. // what is called here ??? FK
  46. jz .LDoClassInit
  47. subb $4,%al
  48. jz .LDoDynArrayInit
  49. jmp .LExitInitialize
  50. // Interfaces
  51. .LDoInterfaceInit:
  52. movl Data, %eax
  53. movl $0,(%eax)
  54. jmp .LExitInitialize
  55. // Variants
  56. .LDoVariantInit:
  57. movl Data,%eax
  58. pushl %eax
  59. call FPC_VARIANT_INIT
  60. jmp .LExitInitialize
  61. // dynamic Array
  62. .LDoDynArrayInit:
  63. movl Data, %eax
  64. movl $0,(%eax)
  65. jmp .LExitInitialize
  66. .LDoObjectInit:
  67. .LDoClassInit:
  68. .LDoRecordInit:
  69. incl %ebx
  70. movzbl (%ebx),%eax
  71. // Skip also recordsize.
  72. addl $5,%eax
  73. addl %eax,%ebx
  74. // %ebx points to element count. Set in %edx
  75. movl (%ebx),%edx
  76. addl $4,%ebx
  77. // %ebx points to First element in record
  78. .LMyRecordInitLoop:
  79. decl %edx
  80. jl .LExitInitialize
  81. // %ebx points to typeinfo pointer
  82. // Push type
  83. pushl (%ebx)
  84. addl $4,%ebx
  85. // %ebx points to offset in record.
  86. // Us it to calculate data
  87. movl Data,%eax
  88. addl (%ebx),%eax
  89. addl $4,%ebx
  90. // push data
  91. pushl %eax
  92. call INT_INITIALIZE
  93. jmp .LMyRecordInitLoop
  94. // Array handling
  95. .LDoArrayInit:
  96. // Skip array name !!
  97. incl %ebx
  98. movzbl (%ebx),%eax
  99. incl %eax
  100. addl %eax,%ebx
  101. // %ebx points to size. Put size in ecx
  102. movl (%ebx),%ecx
  103. addl $4, %ebx
  104. // %ebx points to count. Put count in %edx
  105. movl (%ebx),%edx
  106. addl $4, %ebx
  107. // %ebx points to type. Put into ebx.
  108. // Start treating elements.
  109. .LMyArrayInitLoop:
  110. decl %edx
  111. jl .LExitInitialize
  112. // push type
  113. pushl (%ebx)
  114. // calculate data
  115. movl %ecx,%eax
  116. imull %edx,%eax
  117. addl Data,%eax
  118. // push data
  119. pushl %eax
  120. call INT_INITIALIZE
  121. jmp .LMyArrayInitLoop
  122. // AnsiString handling :
  123. .LDoAnsiStringInit:
  124. movl Data, %eax
  125. movl $0,(%eax)
  126. .LExitInitialize:
  127. pop %edx
  128. pop %ecx
  129. pop %ebx
  130. pop %eax
  131. end;
  132. }
  133. {$ define FPC_SYSTEM_HAS_FPC_FINALIZE}
  134. {
  135. Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
  136. assembler;
  137. asm
  138. push %eax
  139. push %ebx
  140. push %ecx
  141. push %edx
  142. // decide what type it is
  143. movl TypeInfo,%ebx
  144. movb (%ebx),%al
  145. subb $9,%al
  146. jz .LDoAnsiStringFinal
  147. decb %al
  148. jz .LDoAnsiStringFinal
  149. decb %al
  150. jz .LDoVariantFinal
  151. decb %al
  152. jz .LDoArrayFinal
  153. decb %al
  154. jz .LDoRecordFinal
  155. decb %al
  156. jz .LDoInterfaceFinal
  157. decb %al
  158. jz .LDoClassFinal
  159. decb %al
  160. jz .LDoObjectFinal
  161. decb %al
  162. // what is called here ??? FK
  163. jz .LDoClassFinal
  164. subb $4,%al
  165. jz .LDoDynArrayFinal
  166. jmp .LExitFinalize
  167. // Interfaces
  168. .LDoInterfaceFinal:
  169. pushl Data
  170. call Intf_Decr_Ref
  171. jmp .LExitFinalize
  172. // Variants
  173. .LDoVariantFinal:
  174. jmp .LExitFinalize
  175. // dynamic Array
  176. .LDoDynArrayFinal:
  177. pushl TypeInfo
  178. pushl Data
  179. call FPC_DYNARRAY_DECR_REF
  180. jmp .LExitFinalize
  181. .LDoClassFinal:
  182. .LDoObjectFinal:
  183. .LDoRecordFinal:
  184. incl %ebx
  185. movzbl (%ebx),%eax
  186. // Skip also recordsize.
  187. addl $5,%eax
  188. addl %eax,%ebx
  189. // %ebx points to element count. Set in %edx
  190. movl (%ebx),%edx
  191. addl $4,%ebx
  192. // %ebx points to First element in record
  193. .LMyRecordFinalLoop:
  194. decl %edx
  195. jl .LExitFinalize
  196. // %ebx points to typeinfo pointer
  197. // Push type
  198. pushl (%ebx)
  199. addl $4,%ebx
  200. // %ebx points to offset.
  201. // Use to calculate data
  202. movl Data,%eax
  203. addl (%ebx),%eax
  204. addl $4,%ebx
  205. // push data
  206. pushl %eax
  207. call INT_FINALIZE
  208. jmp .LMyRecordFinalLoop
  209. // Array handling
  210. .LDoArrayFinal:
  211. // Skip array name !!
  212. incl %ebx
  213. movzbl (%ebx),%eax
  214. incl %eax
  215. addl %eax,%ebx
  216. // %ebx points to size. Put size in ecx
  217. movl (%ebx),%ecx
  218. addl $4, %ebx
  219. // %ebx points to count. Put count in %edx
  220. movl (%ebx),%edx
  221. addl $4, %ebx
  222. // %ebx points to type. Put into ebx.
  223. // Start treating elements.
  224. .LMyArrayFinalLoop:
  225. decl %edx
  226. jl .LExitFinalize
  227. // push type
  228. pushl (%ebx)
  229. // calculate data
  230. movl %ecx,%eax
  231. imull %edx,%eax
  232. addl Data,%eax
  233. // push data
  234. pushl %eax
  235. call INT_FINALIZE
  236. jmp .LMyArrayFinalLoop
  237. // AnsiString handling :
  238. .LDoAnsiStringFinal:
  239. pushl Data
  240. call FPC_ANSISTR_DECR_REF
  241. .LExitFinalize:
  242. pop %edx
  243. pop %ecx
  244. pop %ebx
  245. pop %eax
  246. end;
  247. }
  248. {$define FPC_SYSTEM_HAS_FPC_ADDREF}
  249. Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
  250. Assembler;
  251. asm
  252. // Save registers
  253. push %eax
  254. push %ebx
  255. push %ecx
  256. push %edx
  257. // decide what type it is
  258. movl TypeInfo,%ebx
  259. movb (%ebx),%al
  260. subb $9,%al
  261. jz .LDoAnsiStringAddRef
  262. decb %al
  263. jz .LDoAnsiStringAddRef
  264. decb %al
  265. jz .LDoVariantAddRef
  266. decb %al
  267. jz .LDoArrayAddRef
  268. decb %al
  269. jz .LDoRecordAddRef
  270. decb %al
  271. jz .LDoInterfaceAddRef
  272. decb %al
  273. jz .LDoClassAddRef
  274. decb %al
  275. jz .LDoObjectAddRef
  276. decb %al
  277. // what is called here ??? FK
  278. jz .LDoClassAddRef
  279. subb $4,%al
  280. jz .LDoDynArrayAddRef
  281. jmp .LExitAddRef
  282. // Interfaces
  283. .LDoInterfaceAddRef:
  284. pushl Data
  285. call INTF_INCR_REF
  286. jmp .LExitAddRef
  287. // Variants
  288. .LDoVariantAddRef:
  289. jmp .LExitAddRef
  290. // Dynamic Arrays
  291. .LDoDynArrayAddRef:
  292. pushl Data
  293. call FPC_DYNARRAY_INCR_REF
  294. jmp .LExitAddRef
  295. .LDoClassAddRef:
  296. .LDoObjectAddRef:
  297. .LDoRecordAddRef:
  298. incl %ebx
  299. movzbl (%ebx),%eax
  300. // Skip also recordsize.
  301. addl $5,%eax
  302. addl %eax,%ebx
  303. // %ebx points to element count. Set in %edx
  304. movl (%ebx),%edx
  305. addl $4,%ebx
  306. // %ebx points to First element in record
  307. .LMyRecordAddRefLoop:
  308. decl %edx
  309. jl .LExitAddRef
  310. // Push type
  311. pushl (%ebx)
  312. addl $4,%ebx
  313. // Calculate data
  314. movl Data,%eax
  315. addl (%ebx),%eax
  316. addl $4,%ebx
  317. // push data
  318. pushl %eax
  319. call INT_ADDREF
  320. jmp .LMyRecordAddRefLoop
  321. // Array handling
  322. .LDoArrayAddRef:
  323. // Skip array name !!
  324. incl %ebx
  325. movzbl (%ebx),%eax
  326. incl %eax
  327. addl %eax,%ebx
  328. // %ebx points to size. Put size in ecx
  329. movl (%ebx),%ecx
  330. addl $4, %ebx
  331. // %ebx points to count. Put count in %edx
  332. movl (%ebx),%edx
  333. addl $4, %ebx
  334. // %ebx points to type. Put into ebx.
  335. // Start treating elements.
  336. .LMyArrayAddRefLoop:
  337. decl %edx
  338. jl .LExitAddRef
  339. // push type
  340. pushl (%ebx)
  341. // calculate data
  342. movl %ecx,%eax
  343. imull %edx,%eax
  344. addl Data,%eax
  345. // push data
  346. pushl %eax
  347. call INT_ADDREF
  348. jmp .LMyArrayAddRefLoop
  349. // AnsiString handling :
  350. .LDoAnsiStringAddRef:
  351. pushl Data
  352. call FPC_ANSISTR_INCR_REF
  353. .LExitAddRef:
  354. pop %edx
  355. pop %ecx
  356. pop %ebx
  357. pop %eax
  358. end;
  359. {$define FPC_SYSTEM_HAS_FPC_DECREF}
  360. Procedure fpc_DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
  361. Assembler;
  362. asm
  363. // Save registers
  364. push %eax
  365. push %ebx
  366. push %ecx
  367. push %edx
  368. // decide what type it is
  369. movl TypeInfo,%ebx
  370. movb (%ebx),%al
  371. subb $9,%al
  372. jz .LDoAnsiStringDecRef
  373. decb %al
  374. jz .LDoAnsiStringDecRef
  375. decb %al
  376. jz .LDoVariantDecRef
  377. decb %al
  378. jz .LDoArrayDecRef
  379. decb %al
  380. jz .LDoRecordDecRef
  381. decb %al
  382. jz .LDoInterfaceDecRef
  383. decb %al
  384. jz .LDoClassDecRef
  385. decb %al
  386. jz .LDoObjectDecRef
  387. decb %al
  388. // what is called here ??? FK
  389. jz .LDoClassDecRef
  390. subb $4,%al
  391. jz .LDoDynArrayDecRef
  392. jmp .LExitDecRef
  393. // Interfaces
  394. .LDoInterfaceDecRef:
  395. pushl Data
  396. call INTF_DECR_REF
  397. jmp .LExitDecRef
  398. // Variants
  399. .LDoVariantDecRef:
  400. jmp .LExitDecRef
  401. // Dynamic Arrays
  402. .LDoDynArrayDecRef:
  403. pushl TypeInfo
  404. pushl Data
  405. call FPC_DYNARRAY_DECR_REF
  406. jmp .LExitDecRef
  407. .LDoClassDecRef:
  408. .LDoObjectDecRef:
  409. .LDoRecordDecRef:
  410. incl %ebx
  411. movzbl (%ebx),%eax
  412. // Skip also recordsize.
  413. addl $5,%eax
  414. addl %eax,%ebx
  415. // %ebx points to element count. Set in %edx
  416. movl (%ebx),%edx
  417. addl $4,%ebx
  418. // %ebx points to First element in record
  419. .LMyRecordDecRefLoop:
  420. decl %edx
  421. jl .LExitDecRef
  422. // Push type
  423. pushl (%ebx)
  424. addl $4,%ebx
  425. // Calculate data
  426. movl Data,%eax
  427. addl (%ebx),%eax
  428. addl $4,%ebx
  429. // push data
  430. pushl %eax
  431. call INT_DECREF
  432. jmp .LMyRecordDecRefLoop
  433. // Array handling
  434. .LDoArrayDecRef:
  435. // Skip array name !!
  436. incl %ebx
  437. movzbl (%ebx),%eax
  438. incl %eax
  439. addl %eax,%ebx
  440. // %ebx points to size. Put size in ecx
  441. movl (%ebx),%ecx
  442. addl $4, %ebx
  443. // %ebx points to count. Put count in %edx
  444. movl (%ebx),%edx
  445. addl $4, %ebx
  446. // %ebx points to type. Put into ebx.
  447. // Start treating elements.
  448. .LMyArrayDecRefLoop:
  449. decl %edx
  450. jl .LExitDecRef
  451. // push type
  452. pushl (%ebx)
  453. // calculate data
  454. movl %ecx,%eax
  455. imull %edx,%eax
  456. addl Data,%eax
  457. // push data
  458. pushl %eax
  459. call INT_DECREF
  460. jmp .LMyArrayDecRefLoop
  461. // AnsiString handling :
  462. .LDoAnsiStringDecRef:
  463. movl Data,%eax
  464. pushl %eax
  465. call FPC_ANSISTR_DECR_REF
  466. .LExitDecRef:
  467. pop %edx
  468. pop %ecx
  469. pop %ebx
  470. pop %eax
  471. end;
  472. {
  473. $Log$
  474. Revision 1.12 2001-11-17 16:56:08 florian
  475. * init and final code in genrtti.inc updated
  476. Revision 1.11 2001/11/14 22:59:11 michael
  477. + Initial variant support
  478. Revision 1.10 2001/08/01 15:00:10 jonas
  479. + "compproc" helpers
  480. * renamed several helpers so that their name is the same as their
  481. "public alias", which should facilitate the conversion of processor
  482. specific code in the code generator to processor independent code
  483. * some small fixes to the val_ansistring and val_widestring helpers
  484. (always immediately exit if the source string is longer than 255
  485. chars)
  486. * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is
  487. still nil (used to crash, now return resp -1 and 0)
  488. Revision 1.9 2001/05/31 22:42:56 florian
  489. * some fixes for widestrings and variants
  490. Revision 1.8 2001/04/23 18:25:44 peter
  491. * m68k updates
  492. Revision 1.7 2000/11/09 17:49:34 florian
  493. + FPC_FINALIZEARRAY
  494. * Finalize to int_finalize renamed
  495. Revision 1.6 2000/11/06 21:52:21 florian
  496. * another fix for interfaces
  497. Revision 1.5 2000/11/06 21:35:59 peter
  498. * removed some warnings
  499. Revision 1.4 2000/11/04 16:30:35 florian
  500. + interfaces support
  501. Revision 1.3 2000/10/21 18:20:17 florian
  502. * a lot of small changes:
  503. - setlength is internal
  504. - win32 graph unit extended
  505. ....
  506. Revision 1.2 2000/07/13 11:33:41 michael
  507. + removed logs
  508. }