dsforth/main_stackops.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; stack manipulation
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 ;; end of "colon" word
   6 ;; breaks "LOAD" too
   7 $FORTH_CODE_WORD ;S
   8 ;; AberSoft
   9 ;; ( -- )
  10   ld    hl,(f_curRP)
  11   ld    c,(hl)
  12   inc   hl
  13   ld    b,(hl)
  14   inc   hl
  15   jr    rsetrpnext
  16 $FORTH_END_CODE_WORD ;S
  17
  18
  19 ;; get current SP
  20 $FORTH_CODE_WORD SP@
  21 ;; AberSoft
  22 ;; ( -- sp )
  23   ld    hl,0
  24   add   hl,sp
  25   jp    i_pushhl
  26 $FORTH_END_CODE_WORD SP@
  27
  28 $FORTH_CODE_WORD SP!
  29 ;; AberSoft
  30 ;; SP := [SP0]
  31   ld    e,(ix+6)
  32   ld    d,(ix+7)
  33   ex    de,hl
  34   ld    sp,hl
  35   jp    i_next
  36 $FORTH_END_CODE_WORD SP!
  37
  38 ;; get current RP
  39 $FORTH_CODE_WORD RP@
  40 ;; AberSoft
  41 ;; ( -- rp )
  42   ld    hl,(f_curRP)
  43   jp    i_pushhl
  44 $FORTH_END_CODE_WORD RP@
  45
  46 $FORTH_CODE_WORD RP!
  47 ;; AberSoft
  48 ;; RP := [RP0]
  49   ld    e,(ix+8)
  50   ld    d,(ix+9)
  51   ex    de,hl
  52   jr    rsetrpnext
  53 $FORTH_END_CODE_WORD RP!
  54
  55
  56 ;; move value from paremeter stack to execution stack
  57 $FORTH_CODE_WORD >R
  58 ;; AberSoft
  59 ;; ( n -- || n )
  60   pop   de
  61   ld    hl,(f_curRP)
  62   dec   hl
  63   ld    (hl),d
  64   dec   hl
  65   ld    (hl),e
  66 rsetrpnext:
  67   ld    (f_curRP),hl
  68   jp    i_next
  69 $FORTH_END_CODE_WORD >R
  70
  71 ;; move value from execution stack to paremeter stack
  72 $FORTH_CODE_WORD R>
  73 ;; AberSoft
  74 ;; ( n || -- n )
  75   ld    hl,(f_curRP)
  76   ld    e,(hl)
  77   inc   hl
  78   ld    d,(hl)
  79   inc   hl
  80   push  de
  81   jr    rsetrpnext
  82 $FORTH_END_CODE_WORD R>
  83
  84 ;; copy value from execution stack to paremeter stack
  85 $FORTH_CODE_WORD R@
  86 ;; AberSoft
  87 ;; ( n || -- n || n)
  88   ld    hl,(f_curRP)
  89   ld    e,(hl)
  90   inc   hl
  91   ld    d,(hl)
  92   push  de
  93   jp    i_next
  94 $FORTH_END_CODE_WORD R@
  95
  96 $FORTH_CODE_WORD RDROP
  97 ;; k8
  98 ;; ( || n -- || )
  99   ld    hl,(f_curRP)
 100   inc   hl
 101   inc   hl
 102   jr    rsetrpnext
 103 $FORTH_END_CODE_WORD RDROP
 104
 105
 106 $FORTH_CODE_WORD DROP
 107 ;; AberSoft
 108 ;; ( n -- )
 109 doonedrop:
 110   pop   hl
 111   jp    i_next
 112 $FORTH_END_CODE_WORD DROP
 113
 114 $FORTH_CODE_WORD 2DROP
 115 ;; k8
 116 ;; ( n0 n1 -- )
 117   pop   hl
 118   jr    doonedrop
 119 $FORTH_END_CODE_WORD 2DROP
 120
 121 $FORTH_CODE_WORD OVER
 122 ;; AberSoft
 123 ;; ( n0 n1 -- n0 n1 n0 )
 124   pop   de
 125   pop   hl
 126   push  hl
 127   jp    i_pushde
 128 $FORTH_END_CODE_WORD OVER
 129
 130 $FORTH_WORD 2OVER
 131 ;; AberSoft
 132 ;; ( d0 d1 -- d0 d1 d0 )
 133 ;; k8: rewrite on asm?
 134   2SWAP 2DUP >R >R 2SWAP R> R> ;S
 135 $FORTH_END_WORD 2OVER
 136
 137 $FORTH_CODE_WORD SWAP
 138 ;; AberSoft
 139 ;; ( n0 n1 -- n1 n0 )
 140   pop   hl
 141   ex    (sp),hl
 142   jp    i_pushhl
 143 $FORTH_END_CODE_WORD SWAP
 144
 145 $FORTH_WORD 2SWAP
 146 ;; AberSoft
 147 ;; ( d0 d1 -- d1 d0 )
 148 ;; k8: rewrite on asm?
 149   ROT >R ROT R> ;S
 150 $FORTH_END_WORD 2SWAP
 151
 152 $FORTH_CODE_WORD DUP
 153 ;; AberSoft
 154 ;; ( n -- n n )
 155   pop   hl
 156   push  hl
 157   jp    i_pushhl
 158 $FORTH_END_CODE_WORD DUP
 159
 160 $FORTH_CODE_WORD -DUP
 161 ;; k8
 162 ;; ( n -- n n ) if n is not 0
 163 ;; ( n -- n ) if n is 0
 164   pop   hl
 165   ld    a,l
 166   or    h
 167   jp    z,i_pushhl
 168   ld    de,hl
 169   jp    i_pushde
 170 $FORTH_END_CODE_WORD -DUP
 171
 172 $FORTH_CODE_WORD 2DUP
 173 ;; AberSoft
 174 ;; ( d -- d d )
 175   pop   hl
 176   pop   de
 177   push  de
 178   push  hl
 179   jp    i_pushde
 180 $FORTH_END_CODE_WORD 2DUP
 181
 182 $FORTH_CODE_WORD ROT
 183 ;; AberSoft
 184 ;; ( n0 n1 n2 -- n1 n2 n0 )
 185   pop   de  ;; n2
 186   pop   hl  ;; n1
 187   ex    (sp),hl  ;; swap n0 and n1
 188   ;; push n2, then n0
 189   jp    i_pushde
 190 $FORTH_END_CODE_WORD ROT
 191
 192 $FORTH_CODE_WORD NROT
 193 ;; AberSoft
 194 ;; ( n0 n1 n2 -- n2 n0 n1 )
 195   pop   hl  ;; n2
 196   pop   de  ;; n1
 197   ex    (sp),hl  ;; swap n0 and n2
 198   ;; push n0, then n1
 199   ex    de,hl
 200   jp    i_pushde
 201 $FORTH_END_CODE_WORD NROT