/hmsl/fth/ob_ivars.fth

https://github.com/philburk/hmsl · Forth · 162 lines · 134 code · 28 blank · 0 comment · 4 complexity · 313089c8d29e95179e36c72643ec6808 MD5 · raw file

  1. \ @(#) ob_ivars.fth 96/06/11 1.1
  2. \ Optimized Instance Variables
  3. \ These are intended to make it easier to use instance variables.
  4. \ These IVARS will automatically fetch their data. This can be optimized
  5. \ like crazy. If you want to store into them, you use IV=> .
  6. \
  7. \ Author: Phil Burk
  8. \ Copyright 1986 Delta Research
  9. \
  10. \ MOD: PLB 5/13/87 Make iv&> immediate, use os+
  11. \ MOD: PLB 9/13/88 Convert to new addressing mode, add IV.BYTES
  12. \ Add signed ivars.
  13. \ MOD: PLB 2/7/90 Add IV.STRUCT
  14. \ 00001 PLB 4/8/92 Added IV.ARRAY
  15. \ 960710 PLB Add IV.RPTR
  16. ANEW TASK-OB_IVARS
  17. decimal
  18. \ Support for fetching and storing into instance variables .
  19. \ These should not be called directly.
  20. \ Make JFORTH compile @ ! etc. inline for speed.
  21. #host_amiga_jforth [IF]
  22. max-inline @ 20 max-inline !
  23. [THEN]
  24. false [IF]
  25. : IV@ ( offset -- value , fetch from LONG instance variable )
  26. os+ @
  27. ;
  28. : IVW@ ( offset -- value , fetch from SHORT instance variable )
  29. os+ w@
  30. ;
  31. : IVC@ ( offset -- value , fetch from SHORT instance variable )
  32. os+ c@
  33. ;
  34. : IV! ( value offset -- , store into LONG instance variable )
  35. os+ !
  36. ;
  37. : IVW! ( value offset -- , store into SHORT instance variable )
  38. os+ w!
  39. ;
  40. : IVC! ( value offset -- , store into BYTE instance variable )
  41. os+ c!
  42. ;
  43. [THEN]
  44. : IV+! ( value offset -- , store into LONG instance variable )
  45. os+ +!
  46. ;
  47. #host_amiga_jforth [IF]
  48. max-inline !
  49. [THEN]
  50. : CREATE.IVAR ( size <name> -- )
  51. CREATE ob.make.member immediate
  52. DOES> ( -- address-ivar )
  53. ?comp compile os.copy
  54. ob.stats compile+@bytes
  55. ;
  56. \ These words are for declaring instance variables.
  57. \ Some of this code appears redundant but is needed because they
  58. \ are CREATE-DOES> words.
  59. : IV.LONG ( <name> --IN-- , declare a cell wide instance variable )
  60. cell create.ivar
  61. ;
  62. : IV.RPTR ( <name> --IN-- , declare a relocatable pointer instance variable )
  63. -cell create.ivar
  64. ;
  65. : IV.SHORT ( <name> --IN-- , declare a 16 bit wide instance variable )
  66. -2 create.ivar
  67. ;
  68. : IV.USHORT ( <name> --IN-- , declare a 16 bit wide instance variable )
  69. 2 create.ivar
  70. ;
  71. : IV.BYTE ( <name> --IN-- , declare a byte wide instance variable )
  72. -1 create.ivar
  73. ;
  74. : IV.UBYTE ( <name> --IN-- , declare a byte wide instance variable )
  75. 1 create.ivar
  76. ;
  77. : IV=> ( value <ivar> -- , store into ivar )
  78. ?COMP
  79. compile os.copy
  80. ob.stats? compile+!bytes
  81. ; immediate
  82. : IV+> ( value <ivar> -- , add value to ivar )
  83. ?COMP
  84. ob.stats? cell =
  85. IF [compile] literal compile iv+!
  86. ELSE " IV+>" " only works on IV.LONG !!"
  87. er_fatal er.report
  88. THEN
  89. ; immediate
  90. : IV& ( offset -- address_ivar )
  91. os+
  92. ;
  93. : IV&> ( <ivar> --IN-- address_ivar , calculate address of ivar )
  94. ?COMP
  95. ob.findit ob.offset@ [compile] literal compile os+
  96. ; immediate
  97. \ This is for declaring a field of bytes in an object.
  98. : IV.BYTES ( n <name> -- , declare a field of bytes )
  99. CREATE ob.make.member immediate
  100. DOES> ?comp @ [compile] literal compile os+
  101. ;
  102. : IV.STRUCT ( <structure> <name> -- ) ( -- addr )
  103. [compile] sizeof() iv.bytes
  104. ;
  105. \ Fast internal arrays 00001
  106. : (IV.ARRAY) ( index offset -- addr )
  107. os+
  108. swap cell* +
  109. ;
  110. : IV.ARRAY ( size <name> -- )
  111. CREATE cells ob.make.member immediate
  112. DOES> ( index addr-ivar )
  113. ?comp ob.offset@ [compile] literal
  114. compile (iv.array)
  115. ;
  116. : (IV.WARRAY) ( index offset -- addr )
  117. os+
  118. swap 2* +
  119. ;
  120. : IV.WARRAY ( size <name> -- )
  121. CREATE 2* ob.make.member immediate
  122. DOES> ( index addr-ivar )
  123. ?comp ob.offset@ [compile] literal
  124. compile (iv.warray)
  125. ;
  126. : (IV.BARRAY) ( index offset -- addr )
  127. os.copy + +
  128. ;
  129. : IV.BARRAY ( size <name> -- )
  130. CREATE ob.make.member immediate
  131. DOES> ( index addr-ivar )
  132. ?comp ob.offset@ [compile] literal
  133. compile (iv.barray)
  134. ;