home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / LIB / TILE / blocks.f83 < prev    next >
Text File  |  1989-12-22  |  2KB  |  69 lines
  1. \
  2. \  CODE BLOCK DEFINITIONS
  3. \
  4. \  Copyright (c) 1989 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 29 November 1989
  17. \
  18. \  Dependencies:
  19. \       (forth) compiler
  20. \
  21. \  Description:
  22. \       Code blocks as an alternative to passing functions as parameters.
  23. \
  24. \  Copying:
  25. \       This program is free software; you can redistribute it and\or modify
  26. \       it under the terms of the GNU General Public License as published by
  27. \       the Free Software Foundation; either version 1, or (at your option)
  28. \       any later version.
  29. \
  30. \       This program is distributed in the hope that it will be useful,
  31. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. \       GNU General Public License for more details.
  34. \
  35. \       You should have received a copy of the GNU General Public License
  36. \       along with this program; see the file COPYING.  If not, write to
  37. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  38.  
  39. .( Loading Block definitions...) cr
  40.  
  41. vocabulary blocks
  42.  
  43. compiler blocks definitions
  44.  
  45. 16 field +block ( addr1 -- addr2 )
  46.  
  47. : block[ ( -- )
  48.   compiling                            ( Check interpreter state)
  49.   if here +block [compile] literal     ( If compiling then create literal)
  50.     compile (branch) >mark             ( to code section and branch over)
  51.     true                               ( Mark code compilation state)
  52.   else
  53.     here                               ( Return pointer to code section)
  54.     false                              ( Mark non-code compilation state)
  55.     ]                                  ( Start compiling code for block)
  56.   then ; immediate
  57.  
  58. : ]; ( -- block)
  59.   [compile] ;                          ( Compile what semicolon does)
  60.   if >resolve                          ( If within code resolve branch)
  61.     ]                                  ( And Continue compiling)
  62.   then ; immediate
  63.  
  64. : call ( block -- )
  65.   >r ;                                 ( Perform the block definition)
  66.  
  67. forth only
  68.  
  69.