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 / forth.f83 < prev    next >
Text File  |  1989-12-21  |  5KB  |  129 lines
  1. \
  2. \  FORTH LEVEL SYSTEM 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: 26 November 1989
  17. \
  18. \  Dependencies:
  19. \       (forth) forth, string, enumerates, bitfields, structures
  20. \
  21. \  Description:
  22. \       High level extensions to the forth kernel. Implementation
  23. \       dependent sections such as entry and vocabulary structures.
  24. \
  25. \  Copying:
  26. \       This program is free software; you can redistribute it and\or modify
  27. \       it under the terms of the GNU General Public License as published by
  28. \       the Free Software Foundation; either version 1, or (at your option)
  29. \       any later version.
  30. \
  31. \       This program is distributed in the hope that it will be useful,
  32. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  33. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34. \       GNU General Public License for more details.
  35. \
  36. \       You should have received a copy of the GNU General Public License
  37. \       along with this program; see the file COPYING.  If not, write to
  38. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. .( Loading Forth definitions...) cr
  41.  
  42. ( Memory word size and integer range)
  43.  
  44. 32 constant BITS/WORD
  45. 4 constant BYTES/WORD
  46.  
  47. 1 BITS/WORD 1- << constant MIN_INT
  48. MIN_INT 1-        constant MAX_INT
  49.  
  50. ( Entry and vocabulary structures)
  51.  
  52. #include enumerates.f83
  53. #include bitfields.f83
  54. #include structures.f83
  55.  
  56. bitfields structures enumerates string forth definitions
  57.  
  58. struct.type ENTRY ( -- )
  59.   ptr  +link                           ( Pointer to previous entry)
  60.   ptr  +name                           ( Pointer to null-ended string)
  61.   long +mode                           ( Mode bit field)
  62.   long +code                           ( Code type or pointer to code)
  63.   long +parameter                      ( Parameter field or pointer to dito)
  64. struct.end
  65.  
  66. bitfield.type MODES ( -- )
  67.   bit  IMMEDIATE                       ( Execution always)
  68.   bit  EXECUTION                       ( Execution only)
  69.   bit  COMPILITION                     ( Compilation only)
  70.   bit  PRIVATE                         ( Private only)
  71. 4 bits RESERVED                                ( Bit fields reserved for future use)
  72. bitfield.end                           ( Bit 8-31 are free for applications)
  73.  
  74. enum.type CODES ( -- )
  75.   enum CODE                            ( Primitive code)
  76.   enum COLON                           ( Colon definition)
  77.   enum VARIABLE                                ( Variable)
  78.   enum CONSTANT                                ( Constant)
  79.   enum VOCABULARY                      ( Vocabulary)
  80.   enum CREATE                          ( Created symbol)
  81.   enum USER                            ( User variable local to task)
  82.   enum LOCAL                           ( Local frame variable)
  83.   enum FORWARD                         ( Forward reference)
  84.   enum FIELD                           ( Field access variable)
  85.   enum EXCEPTION                       ( Exception variable)
  86. enum.end                               ( Otherwise forth level manager)
  87.   
  88. : .entry ( entry -- )
  89.   ." entry#" dup .                     ( Print entry address)
  90.   ." link: " dup +link @ .             ( Print link)
  91.   ." name: " dup +name @ print         ( Print name)
  92.   ." mode: " dup +mode @ .             ( Print mode)
  93.   ." code: " dup +code @ .             ( Print code)
  94.   ." parameter: " +parameter @ . ;     ( Print parameter field)
  95.  
  96. : .context ( -- )
  97.   ." context: " context                        ( Access context vocabulary set)
  98.   begin                                        ( Iterate over all vocabularies)
  99.     dup @ ?dup                         ( Access vocabulary)
  100.   while
  101.     .name space                                ( And print vocabulary name)
  102.     sizeof ptr +                       ( Index the next vocabulary in the set)
  103.   repeat
  104.   drop cr ;
  105.  
  106. : .current ( -- )
  107.   ." current: " current @ .name cr ;   ( Print name of current vocabulary)
  108.  
  109. : .vocabulary ( -- )
  110.   ." vocabulary: " context             ( Access search vocabularies)
  111.   begin
  112.     dup @ ?dup                         ( Check for last vocabulary)
  113.   while
  114.     +parameter @                       ( Access list of entries)
  115.     begin
  116.       ?dup                             ( For all entries)
  117.     while
  118.       dup +code @ VOCABULARY =         ( Check if the entry is a vocabulary)
  119.       if dup .name space then          ( Print its name and continue)
  120.       +link @                          ( to the next entry)
  121.     repeat
  122.     sizeof ptr +                       ( Move to the next vocabulary)
  123.   repeat
  124.   drop cr ;                            ( Drop search list pointer)
  125.  
  126. forth only
  127.  
  128.  
  129.