home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1987 / 12 / tracy / trcy.exp < prev   
Text File  |  1987-11-13  |  2KB  |  109 lines
  1.  
  2.  
  3. ( Moves NEXT address to and from stack.)
  4. : I> ( - a) COMPILE R> ; IMMEDIATE
  5. : >I ( a )  COMPILE >R ; IMMEDIATE
  6.  
  7. ( Even address alignment, if required.)
  8. : ALIGN HERE 1 AND ALLOT ;
  9. : REALIGN ( a - a') DUP 1 AND + ;
  10.  
  11. ( Hides number of bytes per word.)
  12. 2 CONSTANT CELL
  13. : CELL+ ( n - n') 2+ ;
  14. : CELLS ( n - n') 2* ;
  15.  
  16. ( Compiles self-reference.)
  17. : RECURSE ( ...) ; IMMEDIATE
  18.  
  19. ( Forces interpretation of the input stream.)
  20. : INTERPRET ( ...) ;  
  21.  
  22. ( Discards return stack overhead of DO--LOOP.)
  23. : UNDO  I> R> R> 2DROP >I ;
  24.  
  25. example 1
  26.  
  27.  
  28.  
  29.  
  30. NEED D2* \IF : D2* ( d - d') 2DUP D+ ;
  31. NEED HEX \IF : HEX ( DECIMAL ) 10 BASE ! ;
  32.  
  33. NEED C, \IF : C, ( n ) HERE 1 ALLOT C! ;
  34. NEED BL \IF 32 CONSTANT BL ( a blank) 
  35.  
  36. NEED ERASE \IF : ERASE ( a n) 00 FILL ;
  37. NEED BLANK \IF : BLANK ( a n) BL FILL ;
  38.  
  39. NEED .R \IF : .R ( n w) >R DUP 0< R> D.R ;
  40.  
  41. EXAMPLE 2
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50. : 2>R ( n n2)
  51. \ pushes a pair on the return stack.
  52.   COMPILE SWAP COMPILE >R COMPILE >R ; 
  53.  IMMEDIATE
  54.  
  55. : 2R> ( - n n2)
  56. \ pops a pair from the return stack.
  57.   COMPILE R> COMPILE R> COMPILE SWAP ;
  58.  IMMEDIATE
  59.  
  60. : @EXECUTE ( ? ) @ EXECUTE ;
  61.  
  62. : AGAIN 
  63. \ used in a BEGIN-- AGAIN structure.
  64.   0 [COMPILE] LITERAL [COMPILE] UNTIL ;
  65.  IMMEDIATE
  66.  
  67. : DLITERAL  SWAP
  68.   [COMPILE] LITERAL [COMPILE] LITERAL ;
  69.  IMMEDIATE
  70.  
  71. : S>D ( n - d) DUP 0< ;
  72. \ single to double number.
  73.  
  74. : WITHIN ( n min max - f)
  75. \ true if min <= n < max.
  76.    OVER - >R - R> U< ;
  77.  
  78. -1 CONSTANT TRUE
  79.  
  80. example 3
  81.  
  82.  
  83.  
  84.  
  85.  
  86. -TEXT ( a n a2 - -1 , 0 , 1)
  87. \ -1 if string a n < a2 n , 0 if equal,
  88. \ and 1 if >.
  89.  
  90. COMPARE ( a n a2 n2 - -1 , 0 , 1)
  91. \ -1 if string a n < a2 n2 , 0 if equal,
  92. \ and 1 if >.
  93.  
  94. -MATCH ( a n a2 n2 - offset 0 , ? -1)
  95. \ position of string a2 n2 in a n.
  96. \ Offset is 0 if a n is found in 1st
  97. \ position. True with invalid offset
  98. \ if a2 n2 isn't in a n.
  99.  
  100. : ANIMAL " ANIMAL" ;
  101.  
  102. " ANIMATE" ANIMAL COMPARE . 1 ok
  103.  
  104. " ANT" ANIMAL COMPARE . -1 ok
  105. ANIMAL " IMA" -MATCH . . 0 2 ok
  106. ANIMAL " XYZ" -MATCH . . -1 ????? ok
  107.  
  108. example 4
  109.