ADDON/CORE_COMP.asm

   1 ; -*- coding: utf-8 -*-
   2 ; http://patorjk.com/software/taag/#p=display&f=Banner&t=Fast Forth
   3
   4 ; Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
   5 ; Copyright (C) <2015>  <J.M. THOORENS>
   6 ;
   7 ; This program is free software: you can redistribute it and/or modify
   8 ; it under the terms of the GNU General Public License as published by
   9 ; the Free Software Foundation, either version 3 of the License, or
  10 ; (at your option) any later version.
  11 ;
  12 ; This program is distributed in the hope that it will be useful,
  13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ; GNU General Public License for more details.
  16 ;
  17 ; You should have received a copy of the GNU General Public License
  18 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20
  21     FORTHWORD "{CORE_COMP}"
  22     MOV @IP+,PC
  23
  24 ;https://forth-standard.org/standard/core/SPACE
  25 ;C SPACE   --               output a space
  26             FORTHWORD "SPACE"
  27 SPACE       SUB #2,PSP              ;1
  28             MOV TOS,0(PSP)          ;3
  29             MOV #20h,TOS            ;2
  30             JMP EMIT                ;17~  23~
  31
  32 ;https://forth-standard.org/standard/core/SPACES
  33 ;C SPACES   n --            output n spaces
  34             FORTHWORD "SPACES"
  35 SPACES      CMP #0,TOS
  36             JZ SPACESNEXT2
  37             PUSH IP
  38             MOV #SPACESNEXT,IP
  39             JMP SPACE               ;25~
  40 SPACESNEXT  .word   $+2
  41             SUB #2,IP               ;1
  42             SUB #1,TOS              ;1
  43             JNZ SPACE               ;25~ ==> 27~ by space ==> 2.963 MBds @ 8 MHz
  44             MOV @RSP+,IP            ;
  45 SPACESNEXT2 MOV @PSP+,TOS           ; --         drop n
  46             MOV @IP+,PC                   ;
  47
  48     .IFDEF MPY
  49
  50 ;https://forth-standard.org/standard/core/UMTimes
  51 ;C UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
  52             FORTHWORD "UM*"
  53 UMSTAR      MOV @PSP,&MPY       ; Load 1st operand
  54             MOV TOS,&OP2        ; Load 2nd operand
  55             MOV &RES0,0(PSP)    ; low result on stack
  56             MOV &RES1,TOS       ; high result in TOS
  57             MOV @IP+,PC
  58
  59 ;https://forth-standard.org/standard/core/MTimes
  60 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  61             FORTHWORD "M*"
  62 MSTAR       MOV @PSP,&MPYS
  63             MOV TOS,&OP2
  64             MOV &RES0,0(PSP)
  65             MOV &RES1,TOS
  66             MOV @IP+,PC
  67
  68     .ELSE
  69
  70 ;https://forth-standard.org/standard/core/MTimes
  71 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  72             FORTHWORD "M*"
  73 MSTAR       MOV TOS,S           ; TOS= n2
  74             XOR @PSP,S          ; S contains sign of result
  75             CMP #0,0(PSP)       ; n1 > -1 ?
  76             JGE u1n2MSTAR       ; yes
  77             XOR #-1,0(PSP)      ; no : n1 --> u1
  78             ADD #1,0(PSP)       ;
  79 u1n2MSTAR   CMP #0,TOS          ; n2 <= -1 ?
  80             JGE u1u2MSTAR       ; no
  81             XOR #-1,TOS         ; y: n2 --> u2
  82             ADD #1,TOS          ;
  83 u1u2MSTAR   PUSHM #2,IP         ;           PUSHM IP,S
  84             ASMtoFORTH
  85             .word UMSTAR        ; UMSTAR use S,T,W,X,Y
  86             .word   $+2
  87             POPM #2,IP          ;           POPM S,IP
  88             CMP #0,S            ; result > -1 ?
  89             JGE MSTARend        ; yes
  90             XOR #-1,0(PSP)      ; no : ud --> d
  91             XOR #-1,TOS
  92             ADD #1,0(PSP)
  93             ADDC #0,TOS
  94 MSTARend    MOV @IP+,PC
  95
  96     .ENDIF ;MPY
  97
  98 ;https://forth-standard.org/standard/core/UMDivMOD
  99 ; UM/MOD   udlo|udhi u1 -- r q   unsigned 32/16->r16 q16
 100             FORTHWORD "UM/MOD"
 101 UMSLASHMOD  PUSH #DROP          ;3 as return address for MU/MOD
 102             MOV #MUSMOD,PC
 103
 104 ;https://forth-standard.org/standard/core/SMDivREM
 105 ;C SM/REM   d1lo d1hi n2 -- n3 n4  symmetric signed div
 106             FORTHWORD "SM/REM"
 107 SMSLASHREM  MOV TOS,S           ;1            S=divisor
 108             MOV @PSP,T          ;2            T=rem_sign
 109             CMP #0,TOS          ;1            n2 >= 0 ?
 110             JGE d1u2SMSLASHREM  ;2            yes
 111             XOR #-1,TOS         ;1
 112             ADD #1,TOS          ;1
 113 d1u2SMSLASHREM                  ;   -- d1 u2
 114             CMP #0,0(PSP)       ;3           d1hi >= 0 ?
 115             JGE ud1u2SMSLASHREM ;2           yes
 116             XOR #-1,2(PSP)      ;4           d1lo
 117             XOR #-1,0(PSP)      ;4           d1hi
 118             ADD #1,2(PSP)       ;4           d1lo+1
 119             ADDC #0,0(PSP)      ;4           d1hi+C
 120 ud1u2SMSLASHREM                 ;   -- ud1 u2
 121             PUSHM  #2,S          ;4         PUSHM S,T
 122             CALL #MUSMOD
 123             MOV @PSP+,TOS
 124             POPM  #2,S          ;4          POPM T,S
 125             CMP #0,T            ;1  -- ur uq  T=rem_sign>=0?
 126             JGE SMSLASHREMnruq  ;2           yes
 127             XOR #-1,0(PSP)      ;3
 128             ADD #1,0(PSP)       ;3
 129 SMSLASHREMnruq
 130             XOR S,T             ;1           S=divisor T=quot_sign
 131             CMP #0,T            ;1  -- nr uq  T=quot_sign>=0?
 132             JGE SMSLASHREMnrnq  ;2           yes
 133 NEGAT       XOR #-1,TOS         ;1
 134             ADD #1,TOS          ;1
 135 SMSLASHREMnrnq                  ;   -- nr nq  S=divisor
 136             MOV @IP+,PC         ;4 34 words
 137
 138 ;https://forth-standard.org/standard/core/FMDivMOD
 139 ;C FM/MOD   d1 n1 -- r q   floored signed div'n
 140             FORTHWORD "FM/MOD"
 141 FMSLASHMOD  PUSH IP
 142             MOV #FMSLASHMOD1,IP
 143             JMP SMSLASHREM
 144 FMSLASHMOD1 .word   $+2         ; -- remainder quotient       S=divisor
 145             CMP #0,0(PSP)       ;
 146             JZ FMSLASHMODEND
 147             CMP #1,TOS          ; quotient < 1 ?
 148             JGE FMSLASHMODEND   ;
 149 QUOTLESSONE ADD S,0(PSP)        ; add divisor to remainder
 150             SUB #1,TOS          ; decrement quotient
 151 FMSLASHMODEND
 152             MOV @RSP+,IP
 153             MOV @IP+,PC                   ;
 154
 155 ;https://forth-standard.org/standard/core/NEGATE
 156 ;C NEGATE   x1 -- x2            two's complement
 157             FORTHWORD "NEGATE"
 158             JMP NEGAT
 159
 160 ;https://forth-standard.org/standard/core/ABS
 161 ;C ABS     n1 -- +n2     absolute value
 162             FORTHWORD "ABS"
 163 ABBS        CMP #0,TOS           ; 1
 164             JN NEGAT
 165             MOV @IP+,PC
 166
 167 ;https://forth-standard.org/standard/core/Times
 168 ;C *      n1 n2 -- n3       signed multiply
 169             FORTHWORD "*"
 170 STAR        mDOCOL
 171             .word   MSTAR,DROP,EXIT
 172
 173 ;https://forth-standard.org/standard/core/DivMOD
 174 ;C /MOD   n1 n2 -- n3 n4    signed divide/rem'dr
 175             FORTHWORD "/MOD"
 176 SLASHMOD    mDOCOL
 177             .word   TOR,STOD,RFROM,FMSLASHMOD,EXIT
 178
 179 ;https://forth-standard.org/standard/core/Div
 180 ;C /      n1 n2 -- n3       signed divide
 181             FORTHWORD "/"
 182 SLASH       mDOCOL
 183             .word   TOR,STOD,RFROM,FMSLASHMOD,NIP,EXIT
 184
 185 ;https://forth-standard.org/standard/core/MOD
 186 ;C MOD    n1 n2 -- n3       signed remainder
 187             FORTHWORD "MOD"
 188 MODD        mDOCOL
 189             .word   TOR,STOD,RFROM,FMSLASHMOD,DROP,EXIT
 190
 191 ;https://forth-standard.org/standard/core/TimesDivMOD
 192 ;C */MOD  n1 n2 n3 -- n4 n5    n1*n2/n3, rem&quot
 193             FORTHWORD "*/MOD"
 194 SSMOD       mDOCOL
 195             .word   TOR,MSTAR,RFROM,FMSLASHMOD,EXIT
 196
 197 ;https://forth-standard.org/standard/core/TimesDiv
 198 ;C */     n1 n2 n3 -- n4        n1*n2/n3
 199             FORTHWORD "*/"
 200 STARSLASH   mDOCOL
 201             .word   TOR,MSTAR,RFROM,FMSLASHMOD,NIP,EXIT
 202
 203
 204
 205 ;https://forth-standard.org/standard/core/ALIGNED
 206 ;C ALIGNED  addr -- a-addr       align given addr
 207             FORTHWORD "ALIGNED"
 208 ALIGNED     BIT #1,TOS
 209             ADDC #0,TOS
 210             MOV @IP+,PC
 211
 212 ;https://forth-standard.org/standard/core/ALIGN
 213 ;C ALIGN    --                         align HERE
 214             FORTHWORD "ALIGN"
 215 ALIGNN      BIT #1,&DDP    ; 3
 216             ADDC #0,&DDP   ; 4
 217             MOV @IP+,PC
 218
 219 ;https://forth-standard.org/standard/core/CHARS
 220 ;C CHARS    n1 -- n2            chars->adrs units
 221             FORTHWORD "CHARS"
 222             MOV @IP+,PC
 223
 224 ;https://forth-standard.org/standard/core/CHARPlus
 225 ;C CHAR+    c-addr1 -- c-addr2   add char size
 226             FORTHWORD "CHAR+"
 227             ADD #1,TOS
 228             MOV @IP+,PC
 229
 230 ;https://forth-standard.org/standard/core/CELLS
 231 ;C CELLS    n1 -- n2            cells->adrs units
 232             FORTHWORD "CELLS"
 233             ADD TOS,TOS
 234             MOV @IP+,PC
 235
 236 ;https://forth-standard.org/standard/core/CELLPlus
 237 ;C CELL+    a-addr1 -- a-addr2      add cell size
 238             FORTHWORD "CELL+"
 239             ADD #2,TOS
 240             MOV @IP+,PC
 241
 242 ;----------------------------------------------------------------------
 243 ; DOUBLE OPERATORS
 244 ;----------------------------------------------------------------------
 245
 246 ; https://forth-standard.org/standard/core/StoD
 247 ; S>D    n -- d          single -> double prec.
 248             FORTHWORD "S>D"
 249 STOD        SUB #2,PSP
 250             MOV TOS,0(PSP)
 251             JMP ZEROLESS
 252
 253 ; https://forth-standard.org/standard/core/TwoFetch
 254 ; 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
 255             FORTHWORD "2@"
 256 TWOFETCH    SUB #2, PSP
 257             MOV 2(TOS),0(PSP)
 258             MOV @TOS,TOS
 259             MOV @IP+,PC
 260
 261 ; https://forth-standard.org/standard/core/TwoStore
 262 ; 2!    x1 x2 a-addr --    store 2 cells ; the top of stack is stored at the lower adr
 263             FORTHWORD "2!"
 264 TWOSTORE    MOV @PSP+,0(TOS)
 265             MOV @PSP+,2(TOS)
 266             MOV @PSP+,TOS
 267             MOV @IP+,PC
 268
 269 ;; https://forth-standard.org/standard/double/TwoVALUE
 270 ;            FORTHWORD "2VALUE"
 271 ;            mDOCOL
 272 ;            .word CREATE
 273 ;            .word COMMA,COMMA  ; compile hi then lo
 274 ;            .word DOES
 275 ;            .word   $+2
 276 ;            MOV @RSP+,IP
 277 ;            BIT #UF10,SR
 278 ;            JZ TWOFETCH
 279 ;            BIC #UF10,SR
 280 ;            JMP TWOSTORE
 281
 282 ; https://forth-standard.org/standard/core/TwoDROP
 283 ; 2DROP  x1 x2 --          drop 2 cells
 284             FORTHWORD "2DROP"
 285             ADD #2,PSP
 286             MOV @PSP+,TOS
 287             MOV @IP+,PC
 288
 289 ; https://forth-standard.org/standard/core/TwoSWAP
 290 ; 2SWAP  x1 x2 x3 x4 -- x3 x4 x1 x2
 291             FORTHWORD "2SWAP"
 292             MOV @PSP,W          ; -- x1 x2 x3 x4    W=x3
 293             MOV 4(PSP),0(PSP)   ; -- x1 x2 x1 x4
 294             MOV W,4(PSP)        ; -- x3 x2 x1 x4
 295             MOV TOS,W           ; -- x3 x2 x1 x4    W=x4
 296             MOV 2(PSP),TOS      ; -- x3 x2 x1 x2    W=x4
 297             MOV W,2(PSP)        ; -- x3 x4 x1 x2
 298             MOV @IP+,PC
 299
 300 ; https://forth-standard.org/standard/core/TwoOVER
 301 ; 2OVER  x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
 302             FORTHWORD "2OVER"
 303             SUB #4,PSP          ; -- x1 x2 x3 x x x4
 304             MOV TOS,2(PSP)      ; -- x1 x2 x3 x4 x x4
 305             MOV 8(PSP),0(PSP)   ; -- x1 x2 x3 x4 x1 x4
 306             MOV 6(PSP),TOS      ; -- x1 x2 x3 x4 x1 x2
 307             MOV @IP+,PC
 308
 309 ;https://forth-standard.org/standard/core/CFetch
 310 ; C@     c-addr -- char   fetch char from memory
 311             FORTHWORD "C@"
 312 CFETCH      MOV.B @TOS,TOS      ;2
 313             MOV @IP+,PC         ;4
 314
 315 ;https://forth-standard.org/standard/core/CStore
 316 ; C!      char c-addr --    store char in memory
 317             FORTHWORD "C!"
 318 CSTORE      MOV.B @PSP+,0(TOS)  ;4
 319             ADD #1,PSP          ;1
 320             MOV @PSP+,TOS       ;2
 321             MOV @IP+,PC
 322
 323 ;https://forth-standard.org/standard/core/CComma
 324 ; C,   char --        append char
 325             FORTHWORD "C,"
 326 CCOMMA      MOV &DDP,W
 327             MOV.B TOS,0(W)
 328             ADD #1,&DDP
 329             MOV @PSP+,TOS
 330             MOV @IP+,PC
 331
 332 ;https://forth-standard.org/standard/core/AND
 333 ;C AND    x1 x2 -- x3           logical AND
 334             FORTHWORD "AND"
 335 ANDD        AND @PSP+,TOS
 336             MOV @IP+,PC
 337
 338 ;https://forth-standard.org/standard/core/OR
 339 ;C OR     x1 x2 -- x3           logical OR
 340             FORTHWORD "OR"
 341 ORR         BIS @PSP+,TOS
 342             MOV @IP+,PC
 343
 344 ;https://forth-standard.org/standard/core/XOR
 345 ;C XOR    x1 x2 -- x3           logical XOR
 346             FORTHWORD "XOR"
 347 XORR        XOR @PSP+,TOS
 348             MOV @IP+,PC
 349
 350 ;https://forth-standard.org/standard/core/INVERT
 351 ;C INVERT   x1 -- x2            bitwise inversion
 352             FORTHWORD "INVERT"
 353             XOR #-1,TOS
 354             MOV @IP+,PC
 355
 356 ;https://forth-standard.org/standard/core/LSHIFT
 357 ;C LSHIFT  x1 u -- x2    logical L shift u places
 358             FORTHWORD "LSHIFT"
 359 LSHIFT      MOV @PSP+,W
 360             AND #1Fh,TOS        ; no need to shift more than 16
 361             JZ LSH_X
 362 LSH_1       ADD W,W
 363             SUB #1,TOS
 364             JNZ LSH_1
 365 LSH_X       MOV W,TOS
 366             MOV @IP+,PC
 367
 368 ;https://forth-standard.org/standard/core/RSHIFT
 369 ;C RSHIFT  x1 u -- x2    logical R shift u places
 370             FORTHWORD "RSHIFT"
 371 RSHIFT      MOV @PSP+,W
 372             AND #1Fh,TOS        ; no need to shift more than 16
 373             JZ RSH_X
 374 RSH_1       BIC #1,SR           ; CLRC
 375             RRC W
 376             SUB #1,TOS
 377             JNZ RSH_1
 378 RSH_X       MOV W,TOS
 379             MOV @IP+,PC
 380
 381 ;https://forth-standard.org/standard/core/TwoTimes
 382 ;C 2*      x1 -- x2         arithmetic left shift
 383             FORTHWORD "2*"
 384 TWOTIMES    ADD TOS,TOS
 385             MOV @IP+,PC
 386
 387 ;https://forth-standard.org/standard/core/TwoDiv
 388 ;C 2/      x1 -- x2        arithmetic right shift
 389             FORTHWORD "2/"
 390 TWODIV      RRA TOS
 391             MOV @IP+,PC
 392
 393 ;https://forth-standard.org/standard/core/MAX
 394 ;C MAX    n1 n2 -- n3       signed maximum
 395             FORTHWORD "MAX"
 396 MAX         CMP @PSP,TOS    ; n2-n1
 397             JL SELn1        ; n2<n1
 398 SELn2       ADD #2,PSP
 399             MOV @IP+,PC
 400
 401 ;https://forth-standard.org/standard/core/MIN
 402 ;C MIN    n1 n2 -- n3       signed minimum
 403             FORTHWORD "MIN"
 404 MIN         CMP @PSP,TOS    ; n2-n1
 405             JL SELn2        ; n2<n1
 406 SELn1       MOV @PSP+,TOS
 407             MOV @IP+,PC
 408
 409 ;https://forth-standard.org/standard/core/PlusStore
 410 ;C +!     n/u a-addr --       add to memory
 411             FORTHWORD "+!"
 412 PLUSSTORE   ADD @PSP+,0(TOS)
 413             MOV @PSP+,TOS
 414             MOV @IP+,PC
 415
 416 ;https://forth-standard.org/standard/core/CHAR
 417 ;C CHAR   -- char           parse ASCII character
 418             FORTHWORD "CHAR"
 419 CHARR       mDOCOL
 420             .word   FBLANK,WORDD,ONEPLUS,CFETCH,EXIT
 421
 422 ;https://forth-standard.org/standard/core/BracketCHAR
 423 ;C [CHAR]   --          compile character literal
 424             FORTHWORDIMM "[CHAR]"        ; immediate
 425 BRACCHAR    mDOCOL
 426             .word   CHARR
 427             .word   lit,lit,COMMA
 428             .word   COMMA,EXIT
 429
 430 ;https://forth-standard.org/standard/core/FILL
 431 ;C FILL   c-addr u char --  fill memory with char
 432             FORTHWORD "FILL"
 433 FILL        MOV @PSP+,X     ; count
 434             MOV @PSP+,W     ; address
 435             CMP #0,X
 436             JZ FILL_X
 437 FILL_1      MOV.B TOS,0(W)    ; store char in memory
 438             ADD #1,W
 439             SUB #1,X
 440             JNZ FILL_1
 441 FILL_X      MOV @PSP+,TOS   ; pop new TOS
 442             MOV @IP+,PC
 443
 444 ;https://forth-standard.org/standard/core/HEX
 445             FORTHWORD "HEX"
 446 HEX         MOV #16,&BASE
 447             MOV @IP+,PC
 448
 449 ;https://forth-standard.org/standard/core/DECIMAL
 450             FORTHWORD "DECIMAL"
 451 DECIMAL     MOV #10,&BASE
 452             MOV @IP+,PC
 453
 454 ; https://forth-standard.org/standard/core/HERE
 455 ; HERE    -- addr      returns memory ptr
 456             FORTHWORD "HERE"
 457             MOV #BEGIN,PC
 458
 459 ;https://forth-standard.org/standard/core/p
 460 ;C (                \  --     paren ; skip input until )
 461             FORTHWORDIMM "\40"      ; immediate
 462 PARENT       mDOCOL
 463             .word   lit,')',WORDD,DROP,EXIT
 464
 465 ;https://forth-standard.org/standard/core/Dotp
 466 ; .(                \  --     dotparen ; type comment immediatly.
 467             FORTHWORDIMM ".\40"        ; immediate
 468 DOTPAREN    MOV #0,&CAPS
 469             mDOCOL
 470             .word   lit,')',WORDD
 471             .word   COUNT,TYPE
 472             .word   FBLANK,LIT,CAPS,STORE
 473             .word   EXIT
 474
 475 ;https://forth-standard.org/standard/core/J
 476 ;C J        -- n   R: 4*sys -- 4*sys
 477 ;C                  get the second loop index
 478             FORTHWORD "J"
 479 JJ          SUB #2,PSP      ; make room in TOS
 480             MOV TOS,0(PSP)
 481             MOV 4(RSP),TOS  ; index = loopctr - fudge
 482             SUB 6(RSP),TOS
 483             MOV @IP+,PC
 484
 485 ;https://forth-standard.org/standard/core/UNLOOP
 486 ;UNLOOP   --   R: sys1 sys2 --  drop loop parms
 487             FORTHWORD "UNLOOP"
 488 UNLOOP      ADD #4,RSP
 489             MOV @IP+,PC
 490
 491 ;https://forth-standard.org/standard/core/LEAVE
 492 ;C LEAVE    --    L: -- adrs
 493             FORTHWORDIMM "LEAVE"    ; immediate
 494 LEAV        MOV &DDP,W              ; compile three words
 495             MOV #UNLOOP,0(W)        ; [HERE] = UNLOOP
 496             MOV #BRAN,2(W)          ; [HERE+2] = BRAN
 497             ADD #6,&DDP             ; [HERE+4] = After LOOP adr
 498             ADD #2,&LEAVEPTR
 499             ADD #4,W
 500             MOV &LEAVEPTR,X
 501             MOV W,0(X)              ; leave HERE+4 on LEAVEPTR stack
 502             MOV @IP+,PC
 503
 504 ;https://forth-standard.org/standard/core/RECURSE
 505 ;C RECURSE  --      recurse to current definition (compile current definition)
 506             FORTHWORDIMM "RECURSE"  ; immediate
 507 RECURSE     MOV &DDP,X              ;
 508             MOV &LAST_CFA,0(X)      ;
 509             ADD #2,&DDP             ;
 510             MOV @IP+,PC
 511
 512 ; https://forth-standard.org/standard/core/toBODY
 513 ; >BODY     -- addr      leave BODY of a CREATEd word; also leave default ACTION-OF primary DEFERred word
 514             FORTHWORD ">BODY"
 515 TOBODY      ADD #4,TOS
 516             MOV @IP+,PC
 517
 518 ;https://forth-standard.org/standard/core/SOURCE
 519 ;C SOURCE   -- adr u   of  current input buffer
 520             FORTHWORD "SOURCE"
 521             SUB #4,PSP
 522             MOV TOS,2(PSP)
 523             MOV &SOURCE_LEN,TOS
 524             MOV &SOURCE_ORG,0(PSP)
 525             MOV @IP+,PC
 526
 527 ;https://forth-standard.org/standard/core/BASE
 528 ;C BASE    -- a-addr       holds conversion radix
 529             FORTHWORD "BASE"
 530             CALL rDOCON
 531             .word   BASE    ; VARIABLE address in RAM space
 532
 533 ;https://forth-standard.org/standard/core/toIN
 534 ;C >IN     -- a-addr       holds offset in input stream
 535             FORTHWORD ">IN"
 536 FTOIN       CALL rDOCON
 537             .word   TOIN    ; VARIABLE address in RAM space
 538
 539 ;https://forth-standard.org/standard/core/PAD
 540 ; PAD           --  pad address
 541             FORTHWORD "PAD"
 542 PAD         CALL rDOCON
 543             .WORD    PAD_ORG
 544
 545 ; https://forth-standard.org/standard/core/MARKER
 546 ; MARKER
 547 ;( "<spaces>name" -- )
 548 ;Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
 549 ;with the execution semantics defined below.
 550
 551 ;name Execution: ( -- )
 552 ;Restore all dictionary allocation and search order pointers to the state they had just prior to the
 553 ;definition of name. Remove the definition of name and all subsequent definitions. Restoration
 554 ;of any structures still existing that could refer to deleted definitions or deallocated data space is
 555 ;not necessarily provided. No other contextual information such as numeric base is affected
 556
 557 MARKER_DOES .word   $+2                 ; execution part
 558             MOV     @RSP+,IP            ; -- PFA
 559             MOV     @TOS+,&INIVOC       ;       set VOC_LINK value for RST_STATE
 560             MOV     @TOS,&INIDP         ;       set DP value for RST_STATE
 561             MOV     @PSP+,TOS           ; --
 562             MOV     #RST_STATE,PC       ;       execute RST_STATE, PWR_STATE then STATE_DOES
 563
 564             FORTHWORD "MARKER"          ; definition part
 565             CALL    #HEADER             ;4 W = DP+4
 566             MOV     #DODOES,-4(W)       ;4 CFA = DODOES
 567             MOV     #MARKER_DOES,-2(W)  ;4 PFA = MARKER_DOES
 568             MOV     &LASTVOC,0(W)       ;5 [BODY] = VOCLINK to be restored
 569             SUB     #2,Y                ;1 Y = LFA
 570             MOV     Y,2(W)              ;3 [BODY+2] = LFA = DP to be restored
 571             ADD     #4,&DDP             ;3
 572             MOV     #GOOD_CSP,PC
 573