home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1987 / 10 / trcy2exp.lst < prev   
File List  |  1987-09-14  |  5KB  |  198 lines
  1. 
  2. : I>  COMPILE R> ; IMMEDIATE ( no offset)
  3. : >I  COMPILE >R ; IMMEDIATE ( no offset)
  4. 
  5. : I>  R> R> 1+ SWAP >R ; IMMEDIATE ( one-byte offset)
  6. : >I  R> SWAP 1- >R >R ; IMMEDIATE ( one-byte offset)
  7. 
  8. : I>  R> R> 2+ SWAP >R ; IMMEDIATE ( two-byte offset)
  9. : >I  R> SWAP 2- >R >R ; IMMEDIATE ( two-byte offset)
  10. 
  11. : lit ( - n)  I> DUP @ SWAP 2+ >I ;
  12. 
  13. : LITERAL  COMPILE lit , ; IMMEDIATE
  14. 
  15. Example 1: A way to hide the adjustment of >
  16. 
  17. 
  18. : ALIGN  ; IMMEDIATE ( no alignment)
  19. : REALIGN ;       ( no alignment)
  20. 
  21. : ALIGN  HERE 1 AND ALLOT ; IMMEDIATE ( cell-alignment)
  22. : REALIGN ( a - a')  DUP 1 AND + ;   ( cell-alignment)
  23. 
  24. : (") ( - addr n)  I> @ COUNT 2DUP + REALIGN >I ;
  25. 
  26. : "  COMPILE (") 34 WORD DUP C@ ( n ) 1+ >R
  27.    COUNT HERE SWAP CMOVE R> ALLOT ALIGN ; IMMEDIATE
  28. 
  29. Example 2: A definition of "when the dictionary is aligned
  30. 
  31. 
  32. 2 CONSTANT CELL  ( byte-addressed 16-bit cells)
  33. : CELLS  2* ;  ( size of cell area in bytes)
  34. : CELL+  2+ ;  ( skip to the next cell address)
  35. 
  36. 4 CONSTANT CELL  ( byte-addressed 32-bit cells)
  37. : CELLS 4 * ;  ( size of cell area in bytes)
  38. : CELL+ 4 + ;  ( skip to the next cell address)   
  39. 
  40. 1 CONSTANT CELL  ( cell-addressed one-byte-per-cell)
  41. : CELLS   ;  ( size of cell area in bytes)
  42. : CELL+  1+ ;  ( skip to the next cell address)
  43. 
  44. 
  45. CELL ALLOT    ( allocate a cell)
  46. 10 CELLS ALLOT  ( allocate 10 cells)
  47. 
  48. ( addr ) DO ... CELL+ ( skip to next cell) LOOP
  49. 
  50. Example 3: A way to hide the number of bytes per cell
  51.  
  52.  
  53.  
  54. Listing 1
  55.  
  56. SCR# 0
  57. ( A Forth Standard Prelude )
  58.  
  59. This file defines additional functions and extensions which
  60. cannot be provided in the Forth-83 Standard.
  61.  
  62. Select the appropriate prelude for the particular Forth you are
  63. using and load it before loading a Standard program using these
  64. functions.
  65.  
  66.  
  67. Copyright 1986 1987 by Martin J. Tracy.
  68.  
  69. SCR# 1
  70. ( Select a FORTH-83 implementation)
  71. FORTH DECIMAL
  72.  
  73. (    2 LOAD  ( *** model ****)
  74. (  3 4 THRU  ( Lab Microsystems, Inc.  PC/FORTH  Ver. 3.0)
  75. (    5 LOAD  ( Laxen-Perry                  F83  Ver. 2.1)
  76. (    6 LOAD  ( MicroMotion MasterForth           Ver. 1.2)
  77. (    7 LOAD  ( ZEN                               Ver. 0.0)
  78. (    8 LOAD  ( FORTH, Inc. PolyFORTH II     ISD-4  MS-DOS)
  79.  
  80. SCR# 2
  81. ( FORTH-83 functions-- typical definitions)
  82. ( Note: functions already provided need not be redefined.)
  83. : RECURSE   [COMPILE] RECURSE ;  IMMEDIATE
  84. : INTERPRET   INTERPRET ;
  85.  
  86. : I> ( - 'data )   COMPILE R> ;  IMMEDIATE
  87. : >I ( - 'data )   COMPILE >R ;  IMMEDIATE
  88.  
  89. ( Used for alignment: )
  90. : ALIGN    HERE 1 AND ALLOT ;
  91. : REALIGN  ( a - a' )   DUP  1 AND + ;
  92.  
  93. ( Note: defined here for a dumb terminal.)
  94. : TAB ( x y )   CR  2DROP ;
  95. : PAGE   25 0 DO  CR  LOOP  0 0 TAB ;
  96. : MARK ( a n)   TYPE ;
  97.  
  98. SCR# 3
  99. ( Lab Microsystems, Inc.  PC/FORTH  Ver. 3.0)
  100.  
  101. ( RECURSE and INTERPRET are provided.)
  102.  
  103. ( Used by hi-level run-time words to find in-line data: )
  104. : I> ( - 'data )   COMPILE R> ;  IMMEDIATE
  105. : >I ( - 'data )   COMPILE >R ;  IMMEDIATE
  106.  
  107. ( PC/FORTH already has a word ALIGN which works differently.)
  108. ( The following two definitions must be in the order shown: )
  109.  
  110. : REALIGN  ( addr --- addr' )   ALIGN ;
  111. ( 8086/80286  run-time I realignment.)
  112. : ALIGN  ( --)  EVEN ;
  113. ( 8086/80286  compilation address alignment.)
  114.  
  115.  
  116. SCR# 4
  117. ( Lab Microsystems, Inc.  PC/FORTH  Ver. 3.0)
  118.  
  119. ( x y --- )
  120. : TAB   GOTOXY ;
  121.  
  122. ( --- ; clear screen and home cursor )
  123. : PAGE  CLS ;
  124.  
  125. ( a n --- ; display string in inverse video )
  126. : MARK   REVERSE TYPE  REVERSE ;
  127.  
  128.  
  129.  
  130. SCR# 5
  131. ( Laxen-Perry No Visible Support  F83  Ver. 2.1)
  132. ( RECURSE and INTERPRET are provided.)
  133.  
  134. ( Used by hi-level run-time words to find in-line data: )
  135. : I> ( - 'data )   COMPILE R> ;  IMMEDIATE
  136. : >I ( - 'data )   COMPILE >R ;  IMMEDIATE
  137.  
  138. ( Used for alignment: )
  139. : ALIGN     ;    : REALIGN   ;
  140.  
  141. : PAGE  ( -- )       DARK ;
  142. \ clear screen and home cursor.
  143. : TAB   ( x y -- )   AT ;
  144. \ move cursor to given coordinate.
  145. : MARK  ( a n -- )   TYPE ;
  146. \ the MARK function is not provided in F83.
  147.  
  148. SCR# 6
  149. ( MicroMotion MasterForth  Ver. 1.2.4)
  150. ( RECURSE is provided.)
  151.  
  152. : INTERPRET   TIB #TIB @ EVAL ;
  153.  
  154. : >I   COMPILE >R ;  IMMEDIATE
  155. : I>   COMPILE R> ;  IMMEDIATE
  156.  
  157. NEED   ALIGN \IF  :   ALIGN ;
  158. NEED REALIGN \IF  : REALIGN ;
  159.  
  160. ( PAGE is provided.)
  161.  
  162. : TAB  ( x y)   AT ;
  163. : MARK ( a n)  +INVERSE TYPE  -INVERSE ;
  164.  
  165.  
  166. SCR# 7
  167. ( ZEN 0.0)
  168.  
  169. ( RECURSE and INTERPRET are provided.)
  170. ( >I and I> are provided.)
  171.  
  172. NEED   ALIGN \IF  :   ALIGN ;
  173. NEED REALIGN \IF  : REALIGN ;
  174.  
  175. ( PAGE TAB and MARK are provided.)
  176.  
  177.   
  178. SCR# 8
  179. ( FORTH, Inc. polyFORTH MS-DOS ISD)   HEX  1F1F WIDTH !
  180. ( Forth-83 Compatibility layer must be loaded first.)
  181.  
  182. : RECURSE   LAST @ @  2+  COUNT +  , ;  IMMEDIATE
  183. ( INTERPRET is provided.)
  184.  
  185. ( Used by hi-level run-time words to find in-line data: )
  186. : I> ( - 'data )   COMPILE R> ;  IMMEDIATE
  187. : >I ( - 'data )   COMPILE >R ;  IMMEDIATE
  188.  
  189. ( Used for alignment: )
  190. : ALIGN     ;    : REALIGN   ;
  191.  
  192. ( PAGE and MARK are provided.)
  193. : TAB ( x y )   SWAP TAB ;
  194. ( move cursor to given coordinate.)
  195.  
  196.  
  197.  
  198.