home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.7z / ftp.whtech.com / emulators / v9t9 / linux / sources / V9t9 / tools / Forth / 99equs.fs < prev    next >
Encoding:
FORTH Source  |  2006-10-19  |  2.3 KB  |  119 lines
  1. \    Equates global to V9t9 FORTH
  2. \
  3.  
  4. >cross also assembler \ also T assembler H also cross
  5. order cr ." woowo"
  6. \ only forth also assembler definitions
  7. \ cr order cr cr
  8.  
  9. >assembler
  10. $0E    constant    rRP        \ return stack pointer
  11. $0F    constant    rSP        \ stack pointer
  12. $0D    constant    rIP        \ instruction pointer
  13. \ $0C not assigned: CRU stuff
  14. \ $0B not assigned: BL return val
  15. \ env-has? standard-threading [if]
  16. T has? standard-threading H [if]
  17. $08    constant    rWA        \ work address
  18. [else]
  19. $08    constant    rDOCOL    \ ptr to DOCOL
  20. $07 constant    rDODOES    \ ptr to DODOES
  21. [then]
  22. $06    constant    rNEXT    \ ptr to NEXT
  23. $05    constant    rT4        \ temp #4
  24. $04    constant    rT3        \ temp #3
  25. $03    constant    rT2        \ temp #2
  26. $02    constant    rT1        \ temp #1
  27. $01    constant    rTOS    \ top of stack
  28.  
  29. also assembler
  30. rTOS R:    TOS        rTOS *R: *TOS    rTOS *R+: *TOS+        rTOS @>(R):    @>(TOS)
  31. rT1 R:    T1        rT1 *R: *T1        rT1 *R+: *T1+        rT1 @>(R):    @>(T1)
  32. rT2 R:    T2        rT2 *R: *T2        rT2 *R+: *T2+        rT2 @>(R):    @>(T2)
  33. rT3 R:    T3        rT3 *R: *T3        rT3 *R+: *T3+        rT3 @>(R):    @>(T3)
  34. rT4 R:    T4        rT4 *R: *T4        rT4 *R+: *T4+        rT4 @>(R):    @>(T4)
  35. rRP    R:    RP        rRP    *R:    *RP        rRP *R+: *RP+        rRP    @>(R):    @>(RP)
  36. rIP    R:    IP        rIP    *R:    *IP        rIP *R+: *IP+        rIP    @>(R):    @>(IP)
  37. rSP    R:    SP        rSP    *R:    *SP        rSP *R+: *SP+        rSP    @>(R):    @>(SP)
  38. \ rNEXT R: NEXT    rNEXT *R: *NEXT    \ rNEXT *R+: *NEXT+    rNEXT @>(R):    @>(NEXT)
  39.  
  40. \ env-has? standard-threading [if]
  41. T has? standard-threading  <A> [if]
  42.  
  43. rWA    R:    WA        rWA *R+: *WA+
  44. [else]
  45. rDODOES R: DODOES
  46. rDOCOL R: DOCOL
  47. [endif]
  48.  
  49. 1    constant    USING-TOS    \ caching TOS or using pure stack?
  50. 1    constant    THREADED    \ standard threading?
  51.  
  52. \    push TOS to stack 
  53. : PUSH
  54.     dect SP
  55.     mov TOS , *SP
  56. ; immediate
  57.  
  58. \    pop TOS from stack
  59. : POP
  60.     mov *SP+ , TOS
  61. ; immediate
  62.  
  63. \    drop and pop TOS from stack
  64. : POP2
  65.     inct SP
  66.     mov *SP+ , TOS
  67. ; immediate
  68.  
  69. \    drop 2 and pop TOS from stack
  70. : POP3
  71.     ai SP , 4 #
  72.     mov *SP+ , TOS
  73. ; immediate
  74.  
  75. \    drop, not changing TOS
  76. : 0POP
  77.     inct SP
  78. ; immediate
  79.  
  80. \    drop 2, not changing TOS
  81. : 0POP2
  82.     ai SP , 4 #
  83. ; immediate
  84.  
  85. \ env-has? inlining-next [if]
  86. \     env-has? standard-threading [if]
  87. T has? inlining-next <A> [if]
  88.      T has? standard-threading <A> [if]
  89.         : NEXT
  90.             mov *IP+ , WA
  91.             mov *WA+ , R0
  92.             b    *R0
  93.         ;    immediate
  94.     [else]
  95.         : NEXT
  96.             mov *IP+ , R0
  97.             b    *R0
  98.         ;    immediate
  99.     [endif]
  100. [else]
  101.     : NEXT
  102.         b     rNEXT *R
  103.     ;     immediate
  104. [endif]
  105.  
  106. previous
  107.  
  108. >cross
  109.  
  110. : VECTOR ( ip wp -- )
  111.     T ,  , H
  112. ;
  113.  
  114. : vector! ( ip wp addr -- )
  115.     dup >r T ! H r> T ! H
  116. ;
  117.  
  118.  
  119.