dsforth/main.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; dsFORTH v0.0.2
   3 ;; based on AberSoft FIG-Forth v1.1A
   4 ;; restored & partially rewritten by Ketmar
   5 ;; distribution terms: GNU GPL v3
   6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; dedicated to Enota
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;; excuse me my English, i'm not a native speaker
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11 ;; the code has to be optimized!!!
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13   DEFFMT SCLBOOT
  14
  15 ;; set this to 0 to save ~700 bytes
  16 USE_FAST_MULDIV EQU 1
  17 USE_REL_BRANCH EQU 0
  18
  19 ;; those words are of little use
  20 USE_EXT_BLOCK_WORDS EQU 0
  21
  22 ;; waste ~350 bytes for textual error messages?
  23 USE_TEXT_ERROR_MESSAGES EQU 1
  24
  25 ;; "LAST-KEY*"
  26 USE_EXT_LAST_KEY EQU 0
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;; word format:
  30 ;; db  len_flags
  31 ;;   name
  32 ;; dw  lfa
  33 ;; dw  cfa
  34 ;; ....
  35 ;; len_flags:
  36 ;;   bits 0-4: length
  37 ;;   bit 5: SMUDGE flag (=1: word definition isn't finished)
  38 ;;   bit 6: IMMEDIATE flag (=1: true)
  39 ;;   bit 7: always 1
  40 ;; the last byte of the name always has bit 7 set
  41 ;;
  42 ;; for CODE words: cfa points to the body
  43 ;; for FORTH words: cfa points to "_doforth"
  44 ;; for CONST words: cfa points to "_doconst"
  45 ;; for VAR words: cfa points to "_dovar"
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 ;; tech info
  50 ;; registers:
  51 ;;   BC: address interpreter insrtuction pointer
  52 ;;   IX: USER-var base
  53 ;;   IY: used by ROM, do not change
  54 ;;   all other regs are free
  55 ;;
  56 ;; stacks:
  57 ;;   data stack: machine stask (PUSH/POP)
  58 ;;   exec stack: address with f_curRP (last item)
  59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60
  61
  62   org  #6000
  63 ;; start address: #6000
  64 run_cold:
  65   di
  66   jp    run_0        ;; DO NOT CHANGE THIS TO JR!
  67 run_warm:
  68   di
  69   ld    bc,WARMbody
  70   jr    run_1
  71 run_0:
  72 ;; k8: test for 128k
  73   push  bc
  74   ; save byte at #C000 for 48K
  75   ld    a,(#C000)
  76   ex    af,af'
  77   ; check for 128K
  78   ld    hl,#4000
  79   xor   a
  80   ; reset #C000
  81   ld    (#C000),a
  82   ld    (hl),a
  83   ld    bc,#7FFD
  84   ld    a,#15
  85   out   (c),a        ;; now #C000 should be the screen page #5
  86   ld    (#C000),a    ;; trash it
  87   ld    a,#10
  88   out   (c),a        ;; and go back (just in case) %-)
  89   ld    a,(hl)
  90   ld    (hl),0       ;; so it won't be visible
  91   or    a            ;; now check if we really trashed the scrren
  92   jr    z,run_ok48
  93   ld    a,1
  94 run_ok48:
  95   ld    (f_is128K),a
  96   ; restore #C000
  97   ex    af,af'
  98   ld    (#C000),a
  99   ld    a,#08
 100   ld    (#5C6A),a  ; CAPS
 101   ld    a,#3F
 102   ld    i,a
 103   im    1
 104   ld    bc,COLDbody
 105 run_1:
 106   ld    hl,(f_initRP)
 107   ld    (f_curRP),hl
 108   ld    ix,(f_userBASE)
 109   ld    hl,(f_initSP)
 110   ld    sp,hl
 111   ei
 112   jr    i_next
 113
 114 ;;;;;;;;;;;;;;; VARIABLES
 115
 116 f_is128K:   defb 0
 117 f_cur7FFD:  defb #10
 118
 119 ;; current RP
 120 ;; it grows to to lower addresses (to 0), just as the data stack
 121 ;; currently it's address is hardcoded
 122 f_curRP:    defw #D7AE  ;; ???
 123
 124 ;; address of the first "user" variable (def: run_cold-64)
 125 f_userBASE: defw forth_default_user_area  ;; was:#D7B0
 126
 127 f_tib:      defs 50,0
 128
 129 f_userDEF:
 130 f_initSP:
 131   defw #FFE0           ;; S0: starting SP. SP grows to addr #0000; was #D600
 132 f_initRP:
 133   defw #F800           ;; R0: starting RP. RP grows to addr #0000; was #D7AE
 134 f_tibptr:
 135   defw f_tib           ;; TIB
 136 ;; WARNING! keep in sync with `FORTH_USER` and `COLD`!
 137   defw 31              ;; WIDTH
 138   defw 1               ;; WARNING -- if we have no messages text, 1 is the same as 0
 139   defw latest_byte     ;; FENCE
 140   defw latest_byte     ;; DP
 141   defw forth_voc_link  ;; VOC-LINK
 142 f_userDEF_size equ $-f_userDEF
 143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 144
 145 ;;; address interpreter
 146 ;; AberSoft
 147 i_pushde:
 148   push  de
 149 i_pushhl:
 150   push  hl
 151 i_next:
 152   ld    a,(bc)
 153   inc   bc
 154   ld    l,a
 155   ld    a,(bc)
 156   inc   bc
 157   ld    h,a
 158 iexecx:
 159   ld    e,(hl)
 160   inc   hl
 161   ld    d,(hl)
 162   ex    de,hl
 163 ; debug label
 164 i_next_jmp:
 165   jp    (hl)
 166 ;;; end of address interpreter
 167
 168
 169 $FORTH_CONST (.NEXT)     i_next
 170 $FORTH_CONST (.PUSHHL)   i_pushhl
 171 $FORTH_CONST (.PUSHDEHL) i_pushde
 172 $FORTH_CONST (@CUR-RP)   f_curRP
 173 $FORTH_CONST (@CUR-BASE) f_userBASE
 174 $FORTH_CONST (LAST-7FFD) f_cur7FFD
 175
 176
 177 $FORTH_CODE_WORD LIT
 178 ;; AberSoft
 179   ld    a,(bc)
 180   inc   bc
 181   ld    l,a
 182   ld    a,(bc)
 183   inc   bc
 184   ld    h,a
 185   jp    i_pushhl
 186 $FORTH_END_CODE_WORD LIT
 187
 188 $FORTH_CODE_WORD EXECUTE
 189 ;; AberSoft
 190 ;; ( cfa )
 191   pop   hl
 192   jp    iexecx
 193 $FORTH_END_CODE_WORD EXECUTE
 194
 195 $FORTH_CODE_WORD BRANCH  XBRANCH
 196 ;; AberSoft
 197 BRANCHbody:
 198   ld    hl,bc
 199   IF USE_REL_BRANCH
 200   ;; original code for relative RBRANCH
 201   ld    e,(hl)
 202   inc   hl
 203   ld    d,(hl)
 204   dec   hl
 205   add   hl,de
 206   ld    bc,hl
 207   ELSE
 208   ld    c,(hl)
 209   inc   hl
 210   ld    b,(hl)
 211   ENDIF
 212   jp    i_next
 213 $FORTH_END_CODE_WORD BRANCH
 214
 215 $FORTH_CODE_WORD 0BRANCH  XBRANCH
 216 ;; AberSoft
 217   pop   hl
 218   ld    a,l
 219   or    h
 220   jr    z,BRANCHbody
 221 branchskip:
 222   inc   bc
 223   inc   bc
 224   jp    i_next
 225 $FORTH_END_CODE_WORD 0BRANCH
 226
 227 $FORTH_CODE_WORD TBRANCH  XBRANCH
 228 ;; k8
 229   pop   hl
 230   ld    a,l
 231   or    h
 232   jr    nz,BRANCHbody
 233   jr    branchskip
 234 $FORTH_END_CODE_WORD TBRANCH
 235
 236 $FORTH_CODE_WORD (LOOP)  XBRANCH
 237 ;; AberSoft
 238   ld    de,1
 239 xloop:
 240   ld    hl,(f_curRP)
 241   ld    a,(hl)
 242   add   a,e
 243   ld    (hl),a
 244   ld    e,a
 245   inc   hl
 246   ld    a,(hl)
 247   adc   a,d
 248   ld    (hl),a
 249   inc   hl
 250   inc   d
 251   dec   d
 252   ld    d,a
 253   jp    m,xloop0
 254   ld    a,e
 255   sub   (hl)
 256   ld    a,d
 257   inc   hl
 258   sbc   a,(hl)
 259   jr    xloop1
 260 xloop0:
 261   ld    a,(hl)
 262   sub   e
 263   inc   hl
 264   ld    a,(hl)
 265   sbc   a,d
 266 xloop1:
 267   jp    m,BRANCHbody
 268   inc   hl
 269   ld    (f_curRP),hl
 270   inc   bc
 271   inc   bc
 272   jp    i_next
 273 $FORTH_END_CODE_WORD (LOOP)
 274
 275 $FORTH_CODE_WORD (+LOOP)  XBRANCH
 276 ;; AberSoft
 277   pop   de
 278   jr    xloop
 279 $FORTH_END_CODE_WORD (+LOOP)
 280
 281 $FORTH_CODE_WORD (DO)
 282 ;; AberSoft
 283 ;; ( limit start -- )
 284 ;; loops from start to limit-1
 285   ld    hl,(f_curRP)
 286   dec   hl
 287   dec   hl
 288   dec   hl
 289   dec   hl
 290   ld    (f_curRP),hl
 291   pop   de
 292   ld    (hl),e
 293   inc   hl
 294   ld    (hl),d
 295   pop   de
 296   inc   hl
 297   ld    (hl),e
 298   inc   hl
 299   ld    (hl),d
 300   jp    i_next
 301 $FORTH_END_CODE_WORD (DO)
 302
 303 $FORTH_CODE_WORD I
 304 ;; AberSoft
 305 ;; ( -- i )
 306   ld    hl,(f_curRP)
 307 fword_load_rp_i:
 308   ld    e,(hl)
 309   inc   hl
 310   ld    d,(hl)
 311   push  de
 312   jp    i_next
 313 $FORTH_END_CODE_WORD I
 314
 315 $FORTH_CODE_WORD I'
 316 ;; AberSoft, k8
 317 ;; ( -- i' )
 318   ld    hl,(f_curRP)
 319 fword_loadrp_itick:
 320   inc   hl
 321   inc   hl
 322   jr    fword_load_rp_i
 323 $FORTH_END_CODE_WORD I'
 324
 325 $FORTH_CODE_WORD J
 326 ;; AberSoft
 327 ;; ( -- j )
 328   ld    hl,(f_curRP)
 329 fword_loadrp_j:
 330   inc   hl
 331   inc   hl
 332   jr    fword_loadrp_itick
 333 $FORTH_END_CODE_WORD J
 334
 335 $FORTH_CODE_WORD J'
 336 ;; k8
 337 ;; ( -- j' )
 338   ld    hl,(f_curRP)
 339   inc   hl
 340   inc   hl
 341   jr    fword_loadrp_j
 342 $FORTH_END_CODE_WORD J'
 343
 344 ;; DO/LOOP will stop on the next iteration
 345 $FORTH_CODE_WORD LEAVE
 346 ;; AberSoft
 347 ;; ( -- )
 348   ld    hl,(f_curRP)
 349   ld    e,(hl)
 350   inc   hl
 351   ld    d,(hl)
 352   inc   hl
 353   ld    (hl),e
 354   inc   hl
 355   ld    (hl),d
 356   jp    i_next
 357 $FORTH_END_CODE_WORD LEAVE
 358
 359
 360 $FORTH_CODE_WORD DIGIT
 361 ;; AberSoft, k8
 362 ;; ( c base -- n2 true )  ok case
 363 ;; ( c base -- false )    error case
 364   pop   hl        ;; HL: base
 365   pop   de        ;; E: char
 366   ld    a,e
 367   ;; k8: allow lowercased chars
 368   cp    'a'
 369   jr    c,digitnoup
 370   sub   32
 371 digitnoup:
 372   sub   #30
 373   jp    m,digit1
 374   cp    10
 375   jp    m,digit0
 376   sub   7
 377   cp    10
 378   jp    m,digit1
 379 digit0:
 380   cp    l
 381   jp    p,digit1
 382   ld    e,a
 383   ld    hl,1
 384   jp    i_pushde
 385 digit1:
 386   ld    hl,0  ;; k8: just in case of invalid base
 387   jp    i_pushhl
 388 $FORTH_END_CODE_WORD DIGIT
 389
 390
 391 $FORTH_CODE_WORD (FIND)
 392 ;; AberSoft
 393 ;; ( addr l addr2 -- pfa b tf  ok)
 394 ;; ( addr l addr2 -- ff        bad)
 395   pop   de
 396 xfind0:
 397   pop   hl
 398   push  hl
 399   ld    a,(de)
 400   xor   (hl)
 401   and   #3F
 402   jr    nz,xfind4
 403 xfind1:
 404   inc   hl
 405   inc   de
 406   ld    a,(de)
 407   xor   (hl)
 408   add   a,a
 409   jr    nz,xfind3
 410   jr    nc,xfind1
 411   ld    hl,5
 412   add   hl,de
 413   ex    (sp),hl
 414 xfind2:
 415   dec   de
 416   ld    a,(de)
 417   or    a
 418   jp    p,xfind2
 419   ld    e,a
 420   ld    d,0
 421   ld    hl,1
 422   jp    i_pushde
 423 xfind3:
 424   jr    c,xfind5
 425 xfind4:
 426   inc   de
 427   ld    a,(de)
 428   or    a
 429   jp    p,xfind4
 430 xfind5:
 431   inc   de
 432   ex    de,hl
 433   ld    e,(hl)
 434   inc   hl
 435   ld    d,(hl)
 436   ld    a,d
 437   or    e
 438   jr    nz,xfind0
 439   pop   hl
 440   ld    hl,0
 441   jp    i_pushhl
 442 $FORTH_END_CODE_WORD (FIND)
 443
 444
 445 $FORTH_CODE_WORD ENCLOSE
 446 ;; AberSoft
 447 ;; ( addr delimeter -- addr w_start_ofs w_end_ofs next_scan_ofs )
 448   pop   de  ;; E=delimeter
 449   pop   hl  ;; HL=addr
 450   push  hl
 451
 452   ld    a,e
 453   ld    d,a
 454   ld    e,#FF
 455   dec   hl
 456
 457 ;; here: E=word len; A=delim; HL=addr
 458 enclose0:
 459 ;; skip delimiters
 460   inc   hl
 461   inc   e
 462   cp    (hl)
 463   jr    z,enclose0
 464
 465   ld    d,0
 466   push  de        ;; store # of delimiters before the word
 467
 468   ld    d,a       ;; D=delimiter
 469 ;; check for "end of buffer" (#0)
 470   ld    a,(hl)
 471   and   a
 472   jr    nz,enclose1
 473
 474 ;; oops... no more blondies on the island
 475   ld    d,0
 476   inc   e
 477   push  de        ;; store full length
 478
 479   dec   e
 480   push  de        ;; store position of the next char to scan
 481   jp    i_next
 482
 483 ;; here: E=word len; D=delim; HL=addr
 484 enclose1:
 485 ;; now collect the word itself
 486   ld    a,d
 487   inc   hl
 488   inc   e
 489   cp    (hl)
 490   jr    z,enclose2  ;; word ends?
 491 ;; no, check "end of buffer"
 492   ld    a,(hl)
 493   and   a
 494   jr    nz,enclose1
 495
 496 ;; oops... no more blondies on the island
 497   ld    d,0
 498   push  de        ;; store full length
 499   push  de        ;; store position of the next char to scan (???)
 500   jp    i_next
 501
 502 enclose2:
 503   ld    d,0
 504   push  de        ;; store full length
 505   inc   e
 506   push  de        ;; store position of the next char to scan
 507   jp    i_next
 508 $FORTH_END_CODE_WORD ENCLOSE
 509
 510   include "math_bitop.zas"
 511   include "math_compare.zas"
 512   include "math_basic.zas"
 513   include "math_misc.zas"
 514   include "math_hlev.zas"
 515
 516   include "main_stackops.zas"
 517   include "main_memops.zas"
 518
 519 $FORTH_CODE_WORD FORTH-WORD?
 520 ;; k8
 521 ;; ( pfa -- flag )
 522   pop   hl
 523   dec   hl
 524   ld    d, (hl)
 525   dec   hl
 526   ld    e, (hl)
 527   ld    hl,_doforth
 528   sbc   hl,de
 529   ld    a,h
 530   or    l
 531   ld    hl,1
 532   jr    z,isfword0
 533   dec   l
 534 isfword0:
 535   jp    i_pushhl
 536 $FORTH_END_CODE_WORD FORTH-WORD?
 537
 538 ;; check if BREAK is pressed
 539 $FORTH_CODE_WORD ?BREAK
 540 ;; AberSoft, k8
 541 ;; ( -- break_flag)
 542   call  #1F54  ;; uses only A
 543   ld    hl,0
 544   jp    c,i_pushhl
 545   inc   l
 546   jp    i_pushhl
 547 $FORTH_END_CODE_WORD ?BREAK
 548
 549   include "main_hldef.zas"
 550
 551 ;;;;;;;;;;;;;; some speedup constants
 552 $FORTH_CONST 0 0
 553 $FORTH_CONST 1 1
 554 $FORTH_CONST 2 2
 555 $FORTH_CONST 3 3
 556 $FORTH_CONST 4 4
 557 $FORTH_CONST -1 -1
 558 $FORTH_CONST -2 -2
 559 $FORTH_CONST -4 -4
 560 $FORTH_CONST BL 32
 561 $FORTH_CONST CHCR 13
 562 $FORTH_CONST CHLF 10
 563
 564 $FORTH_CONST C/L 64
 565
 566 $FORTH_WORD +ORIGIN
 567   LIT run_cold  + ;S
 568 $FORTH_END_WORD +ORIGIN
 569
 570 ;; offsets to some COLD values
 571 $FORTH_CONST (COLD-INIT-SP) f_initSP
 572 $FORTH_CONST (COLD-INIT-RP) f_initRP
 573 $FORTH_CONST (COLD-TIBPTR)  f_tibptr
 574
 575 ;; these ones will be inited by COLD with the predefined values
 576 $FORTH_USER S0        #06
 577 $FORTH_USER R0        #08
 578 $FORTH_USER TIB       #0A
 579 $FORTH_USER WIDTH     #0C
 580 $FORTH_USER WARNING   #0E
 581 $FORTH_USER FENCE     #10
 582 $FORTH_USER DP        #12
 583 $FORTH_USER VOC-LINK  #14
 584 ;; these ones will not be inited by COLD
 585 $FORTH_USER BLK       #16
 586 $FORTH_USER IN        #18
 587 fuserofs_readonly equ #1A
 588 $FORTH_USER READ-ONLY #1A
 589 $FORTH_USER SCR       #1C
 590 ;; OFFSET is the offset for BLOCK operation
 591 ;; i.e. actual block number will be n+OFFSET
 592 $FORTH_USER OFFSET    #1E
 593 $FORTH_USER CONTEXT   #20
 594 $FORTH_USER CURRENT   #22
 595 $FORTH_USER STATE     #24
 596 $FORTH_USER BASE      #26
 597 $FORTH_USER DPL       #28
 598 $FORTH_USER FLD       #2A
 599 $FORTH_USER CSP       #2C
 600 $FORTH_USER R#        #2E
 601 $FORTH_USER HLD       #30
 602 ;; new for WORDS
 603 $FORTH_USER SHOW-HIDDEN #32
 604 fuserofs_showhidden equ #32
 605 ;; new var for TLOAD: if not zero, we're loading from a disk file
 606 ;;$FORTH_USER TLOAD-Y   #34
 607
 608 forth_default_user_size equ #40
 609 forth_default_user_area defs #40,0
 610
 611
 612 ;; 6x8 printing driver
 613   include "main_emit6.zas"
 614   include "main_key6.zas"
 615
 616 $FORTH_CODE_WORD (HANG)
 617 forth_hang:
 618   di
 619   jr    $
 620 $FORTH_END_CODE_WORD (HANG)
 621
 622 $FORTH_CODE_WORD BYE
 623 ;; return to TR-DOS
 624   jp    #3D00
 625 ;;;; return to BASIC?
 626 ;;  LD   A,#17
 627 ;;  LD   (f_cur7FFD),A
 628 ;;  LD   BC,#7FFD
 629 ;;  OUT  (C),A
 630 ;;  LD   HL,0
 631 ;;  PUSH HL
 632 ;;  JP   #3D2F
 633 $FORTH_END_CODE_WORD BYE
 634
 635 $FORTH_CODE_WORD 128K?
 636   ld    a,(f_is128K)
 637 cw_is_128k_done:
 638   ld    l,a
 639   ld    h,0
 640   jp    i_pushhl
 641 $FORTH_END_CODE_WORD 128K?
 642
 643 $FORTH_CODE_WORD 48K?
 644   ld    a,(f_is128K)
 645   or    a
 646   ld    a,1
 647   jr    z,cw_is_128k_done
 648   xor   a
 649   jr    cw_is_128k_done
 650 $FORTH_END_CODE_WORD 48K?
 651
 652 $FORTH_WORD .CREDITZ
 653 ;; k8
 654   (.") ~\n48K/128K dsFORTH v0.0.2\n~
 655   (.") ~original version: \x7F Abersoft, 1983\n~
 656   (.") ~modifications by Ketmar//Invisible Vector\n~
 657   ;; (.") ~distribution terms: GNU GPL\n~
 658   ;S
 659 $FORTH_END_WORD .CREDITZ
 660
 661
 662 ;; ;eave the address of the next available dictionary location
 663 $FORTH_WORD HERE
 664 ;; AberSoft
 665 ;; ( -- addr )
 666   DP @ ;S
 667 $FORTH_END_WORD HERE
 668
 669 $FORTH_WORD ALLOT
 670 ;; AberSoft,k8
 671 ;; ( n -- )
 672 ;; k8 checks on
 673   SP@ RP@ UMIN BL - DP @ U< 0BRANCH allot0
 674   (.") ~ALLOT: out of memory!\n~  ;;"
 675   ABORT
 676 allot0:
 677 ;; k8 checks off
 678   DP +! ;S
 679 $FORTH_END_WORD ALLOT
 680
 681 $FORTH_WORD ,
 682 ;; AberSoft
 683 ;; ( n -- )
 684   HERE ! 2 ALLOT ;S
 685 $FORTH_END_WORD ,
 686
 687 $FORTH_WORD C,
 688 ;; AberSoft
 689 ;; ( n -- )
 690   HERE C! 1 ALLOT ;S
 691 $FORTH_END_WORD C,
 692
 693
 694 $FORTH_WORD TRAVERSE
 695 ;; AberSoft
 696 ;; ( addr1 n -- addr2 )
 697   SWAP
 698 traverse0:
 699   OVER + LIT 127 OVER C@ <
 700   0BRANCH traverse0
 701   SWAP DROP ;S
 702 $FORTH_END_WORD TRAVERSE
 703
 704
 705 $FORTH_WORD LATEST
 706 ;; AberSoft
 707 ;; ( -- addr )
 708   CURRENT @ @ ;S
 709 $FORTH_END_WORD LATEST
 710
 711 $FORTH_WORD LFA
 712 ;; AberSoft
 713 ;; ( pfa -- lfa )
 714   4 - ;S
 715 $FORTH_END_WORD LFA
 716
 717 $FORTH_WORD CFA
 718 ;; AberSoft
 719 ;; ( pfa -- cfa )
 720   2- ;S
 721 $FORTH_END_WORD CFA
 722
 723 $FORTH_WORD NFA
 724 ;; AberSoft
 725 ;; ( pfa -- nfa )
 726   LIT 5 -  -1  TRAVERSE ;S
 727 $FORTH_END_WORD NFA
 728
 729 $FORTH_WORD PFA
 730 ;; AberSoft
 731 ;; ( nfa -- pfa )
 732   1 TRAVERSE LIT 5 + ;S
 733 $FORTH_END_WORD PFA
 734
 735
 736 $FORTH_WORD !CSP
 737 ;; AberSoft
 738 ;; ( -- )
 739   SP@ CSP ! ;S
 740 $FORTH_END_WORD !CSP
 741
 742 $FORTH_WORD ?ERROR
 743 ;; AberSoft
 744 ;; ( flag code -- )
 745   SWAP 0BRANCH qerror0
 746   ERROR BRANCH qerror1
 747 qerror0:
 748   DROP
 749 qerror1:
 750   ;S
 751 $FORTH_END_WORD ?ERROR
 752
 753 $FORTH_WORD ?COMP
 754 ;; AberSoft
 755 ;; ( -- )
 756   STATE @ 0= LIT 17 ?ERROR ;S
 757 $FORTH_END_WORD ?COMP
 758
 759 $FORTH_WORD ?EXEC
 760 ;; AberSoft
 761 ;; ( -- )
 762   STATE @ LIT 18 ?ERROR ;S
 763 $FORTH_END_WORD ?EXEC
 764
 765 $FORTH_WORD ?PAIRS
 766 ;; AberSoft
 767 ;; ( n1 n2 -- )
 768   - LIT 19 ?ERROR ;S
 769 $FORTH_END_WORD ?PAIRS
 770
 771 $FORTH_WORD ?CSP
 772 ;; AberSoft
 773 ;; ( -- )
 774   SP@ CSP @ - LIT 20 ?ERROR ;S
 775 $FORTH_END_WORD ?CSP
 776
 777 $FORTH_WORD ?LOADING
 778 ;; AberSoft
 779 ;; ( -- )
 780   BLK @ 0= LIT 22 ?ERROR ;S
 781 $FORTH_END_WORD ?LOADING
 782
 783 $FORTH_WORD COMPILE
 784 ;; AberSoft
 785 ;; ( -- )
 786   ?COMP R> DUP 2+ >R @ , ;S
 787 $FORTH_END_WORD COMPILE
 788
 789 $FORTH_WORD [ IMM
 790 ;; AberSoft
 791 ;; ( -- )
 792   STATE 0! ;S
 793 $FORTH_END_WORD [
 794
 795 $FORTH_WORD ]
 796 ;; AberSoft
 797 ;; ( -- )
 798   LIT #C0 STATE ! ;S
 799 $FORTH_END_WORD ]
 800
 801 $FORTH_WORD SMUDGE
 802 ;; AberSoft
 803 ;; ( -- )
 804   LATEST LIT #20 TOGGLE ;S
 805 $FORTH_END_WORD SMUDGE
 806
 807 $FORTH_WORD HEX
 808 ;; AberSoft
 809 ;; ( -- )
 810   LIT 16 BASE ! ;S
 811 $FORTH_END_WORD HEX
 812
 813 $FORTH_WORD BINARY
 814 ;; AberSoft
 815 ;; ( -- )
 816   2 BASE ! ;S
 817 $FORTH_END_WORD BINARY
 818
 819 $FORTH_WORD DECIMAL
 820 ;; AberSoft
 821 ;; ( -- )
 822   LIT 10 BASE ! ;S
 823 $FORTH_END_WORD DECIMAL
 824
 825 $FORTH_WORD COUNT
 826 ;; AberSoft
 827 ;; ( a -- a+1 (a) )
 828   DUP 1+ SWAP C@ ;S
 829 $FORTH_END_WORD COUNT
 830
 831 $FORTH_WORD -TRAILING
 832 ;; AberSoft
 833 ;; ( addr n1 -- addr n2 )
 834   DUP 0 (DO)
 835 ntrailing0:
 836   OVER OVER + 1- C@ BL - 0BRANCH ntrailing1
 837   LEAVE BRANCH ntrailing2
 838 ntrailing1:
 839   1-
 840 ntrailing2:
 841   (LOOP)  ntrailing0
 842   ;S
 843 $FORTH_END_WORD -TRAILING
 844
 845
 846 $FORTH_WORD (.")  ;;"
 847 ;; AberSoft
 848 ;; ( -- )
 849   R@ COUNT dup 1+ R> + >R TYPE ;S
 850 $FORTH_END_WORD (.")  ;;"
 851
 852 $FORTH_WORD ." IMM  ;;"
 853 ;; AberSoft, k8
 854 ;; ( -- )
 855   LIT 34  STATE @ 0BRANCH dotq0
 856   COMPILE (.")  ;;"
 857   WORD C@ 1+ ALLOT BRANCH dotq1
 858 dotq0:
 859   WORD COUNT TYPE
 860 dotq1:
 861   ;S
 862 $FORTH_END_WORD ."  ;;"
 863
 864 $FORTH_CODE_WORD (")  ;;"
 865 ;; ( -- addr count )
 866   ld    a,(bc)
 867   inc   bc
 868   ld    l,a
 869   ld    h,0
 870   push  bc     ;; addr
 871   push  hl     ;; length
 872   add   hl,bc
 873   ld    b,h
 874   ld    c,l
 875   jp    i_next
 876 $FORTH_END_CODE_WORD (")  ;;"
 877
 878 $FORTH_WORD " IMM  ;;"
 879 ;; AberSoft, k8
 880 ;; ( -- addr count )
 881 ;; compile string into the current definition
 882 ;; or place it at PAD (depends of current STATE)
 883   LIT 34  STATE @ 0BRANCH dots0
 884   COMPILE (")  ;;"
 885   WORD C@ 1+ ALLOT BRANCH dots1
 886 dots0:
 887   TEXT PAD COUNT
 888 dots1:
 889   ;S
 890 $FORTH_END_WORD "  ;;"
 891
 892   include "main_editstr.zas"
 893
 894 $FORTH_WORD EXPECT
 895 ;; k8
 896 ;; ( addr len -- )
 897   1- (EDITSTR-MAXLEN) !  (EDITSTR-ADDR) !
 898   (EDITSTR-LEN) 0!  (EDITSTR-cp) 0!
 899   XEDITSTR  ;S
 900 $FORTH_END_WORD EXPECT
 901
 902 $FORTH_WORD QUERY
 903 ;; AberSoft
 904 ;; ( -- )
 905   TIB @  LIT 80 EXPECT  IN 0! ;S
 906 $FORTH_END_WORD QUERY
 907
 908 ;; ~ will be changed to char with code 0 by ZASM
 909 ;; this word will be called by INTERPRET
 910 ;; when it meets the end of line marker (0x00)
 911 ;; zwb: break INTERPRET
 912 ;; zw2: continue INTERPRETING
 913 $FORTH_WORD ~ IMM ;; #0
 914 ;; AberSoft, k8
 915 ;; ( -- )
 916   ;;TLOAD-Y @ 0BRANCH zwx
 917   FOPENED? 0BRANCH zwx
 918   FREADLN 0BRANCH zwx1  ;; no more lines
 919   DROP TIB ! IN 0! BRANCH zw2
 920 zwx1:
 921   ;;TLOAD-Y 0!
 922   FCLOSE
 923   LIT f_tibptr @  DUP 0! TIB !  IN 0!
 924   ?EXEC RDROP
 925   BRANCH zwb
 926 zwx:
 927   BLK @ 0BRANCH zw1
 928   1 BLK +!  IN 0!  BLK @ b/SCR 1- AND 0= 0BRANCH zw0
 929 zwb:
 930   ?EXEC RDROP
 931 zw0:
 932   BRANCH zw2
 933 zw1:
 934   RDROP
 935 zw2:
 936   ;S
 937 $FORTH_END_WORD ~
 938
 939
 940 $FORTH_WORD PAD
 941 ;; AberSoft
 942 ;; ( -- pad )
 943   HERE LIT 68 + ;S
 944 $FORTH_END_WORD PAD
 945
 946
 947 ;; read next word from the input stream
 948 ;; place it at HERE as the counted string
 949 $FORTH_WORD WORD
 950 ;; AberSoft, k8
 951 ;; ( delimeter -- here )
 952   BLK @ 0BRANCH word0        ;; not LOADing?
 953   BLK @ BLOCK BRANCH word1   ;; else -- load block and get its address
 954 word0:
 955   TIB @
 956 word1:
 957   IN @ + SWAP ENCLOSE
 958 ;; ENCLOSE: ( addr delimeter -- addr w_start_ofs w_end_ofs next_scan_ofs )
 959
 960   HERE LIT 34 BLANKS
 961   IN +!  ;; ( addr w_start_ofs w_end_ofs )
 962   OVER - ;; ( addr w_start_ofs w_len )
 963   DUP >R  HERE C!   ;; length stored; ( addr w_start_ofs | w_len )
 964   +  HERE 1+  R>  CMOVE
 965   HERE ;S
 966 $FORTH_END_WORD WORD
 967
 968 $FORTH_WORD (NUMBER)
 969 ;; AberSoft
 970 ;; ( d1 addrl -- d2 addr2 )
 971 ;; converts from (addrl+1)
 972 xnumber0:
 973   1+ DUP >R C@ BASE @ DIGIT 0BRANCH xnumber2
 974   SWAP BASE @ U* DROP ROT BASE @ U* D+ DPL @ 1+ 0BRANCH xnumber1
 975   1 DPL +!
 976 xnumber1:
 977   R> BRANCH xnumber0
 978 xnumber2:
 979   R> ;S
 980 $FORTH_END_WORD (NUMBER)
 981
 982 $FORTH_WORD NUMBER
 983 ;; AberSoft
 984 ;; ( addr -- d )
 985 ;; sets DPL if decimal point was found
 986   0 0 ROT DUP 1+ C@ LIT 45 = DUP >R + -1
 987 number0:
 988   DPL ! (NUMBER) DUP C@ BL - 0BRANCH number1
 989   DUP C@ LIT 46 - 0 ?ERROR 0
 990   BRANCH number0
 991 number1:
 992   DROP R> 0BRANCH number2
 993   DNEGATE
 994 number2:
 995   ;S
 996 $FORTH_END_WORD NUMBER
 997
 998
 999 ;; read next word from the input stream
1000 ;; search it in the dictionary
1001 $FORTH_WORD -FIND
1002 ;; AberSoft, k8
1003 ;; ( -- pfa b tf  ok)
1004 ;; ( -- ff        bad)
1005   BL WORD  CONTEXT @ @  (FIND)
1006   DUP 0= 0BRANCH nfind0
1007   DROP  HERE LATEST (FIND)
1008 nfind0:
1009   ;S
1010 $FORTH_END_WORD -FIND
1011
1012 $FORTH_WORD (ABORT)
1013 ;; AberSoft
1014 ;; ( -- )
1015   ABORT
1016 $FORTH_END_WORD (ABORT)
1017
1018 $FORTH_WORD (ERROR-STOP)
1019 ;; k8
1020 ;; ( -- )
1021   FCLOSE
1022   SP!
1023   LIT f_tibptr @ TIB !
1024   QUIT
1025 $FORTH_END_WORD (ERROR-STOP)
1026
1027 $FORTH_WORD ERROR
1028 ;; AberSoft
1029 ;; ( n -- )
1030   ;;TLOAD-Y 0!
1031   FCLOSE
1032   WARNING @ 0< 0BRANCH error0
1033   (ABORT)
1034 error0:
1035   HERE COUNT TYPE (.")  ~? ~  ;;"
1036   MESSAGE
1037   SP!  BLK @ -DUP 0BRANCH error1
1038   IN @ SWAP
1039 error1:
1040   LIT f_tibptr @ TIB !
1041   QUIT
1042 $FORTH_END_WORD ERROR
1043
1044 $FORTH_WORD ID.
1045 ;; AberSoft
1046 ;; ( nfa -- )
1047   PAD BL LIT 95 FILL
1048   DUP PFA LFA OVER - PAD SWAP CMOVE
1049   PAD COUNT LIT 31 AND 2DUP + 1- DUP @ LIT #FF7F AND SWAP !
1050   TYPE SPACE ;S
1051 $FORTH_END_WORD ID.
1052
1053 $FORTH_WORD [COMPILE] IMM
1054 ;; AberSoft
1055 ;; ( -- )
1056   -FIND 0= 0 ?ERROR DROP CFA , ;S
1057 $FORTH_END_WORD [COMPILE]
1058
1059 $FORTH_WORD LITERAL IMM
1060 ;; AberSoft
1061 ;; ( n -- )
1062   STATE @ 0BRANCH literal0
1063   COMPILE LIT ,
1064 literal0:
1065   ;S
1066 $FORTH_END_WORD LITERAL
1067
1068 $FORTH_WORD DLITERAL IMM
1069 ;; AberSoft
1070 ;; ( lo hi -- )
1071   STATE @ 0BRANCH dliteral0
1072   SWAP LITERAL LITERAL
1073 dliteral0:
1074   ;S
1075 $FORTH_END_WORD DLITERAL
1076
1077 $FORTH_WORD ?STACK
1078 ;; AberSoft, k8
1079 ;; ( -- )
1080   ;; check for stack underflow
1081   SP@ S0 @ SWAP U< 1 ?ERROR
1082   ;; check for stack overflow
1083   ;; SP@ HERE LIT 128 + U< LIT 7 ?ERROR
1084   SP@
1085     ;; end of words
1086     HERE LIT 128 +
1087     ;; current RP (k8)
1088     RP@ LIT 8 + UMAX
1089     ;; initial RP (k8)
1090     R0 @ LIT 8 + UMAX
1091   U< LIT 7 ?ERROR
1092   ;S
1093 $FORTH_END_WORD ?STACK
1094
1095
1096 $FORTH_WORD ([0pfx])
1097 ;; k8
1098 ;; ( base -- )
1099   BL WORD
1100   BASE @ >R  SWAP BASE !
1101   0 0  ROT (NUMBER)  ;; ( d2 addr2 )
1102   R> BASE !
1103   HERE COUNT  ;; (d2 addr2 here+1 count )
1104   NROT  ;; (d2 count addr2 here+1 )
1105   -  ;; (d2 count diff )
1106   != 0 ?ERROR
1107   ;; (d2)
1108   DROP
1109   LITERAL
1110   ;S
1111 $FORTH_END_WORD ([0pfx])
1112
1113 $FORTH_WORD [0x] IMM
1114 ;; k8
1115 ;; ( -- n )
1116   LIT 16 ([0pfx])
1117   ;S
1118 $FORTH_END_WORD [0x]
1119
1120 $FORTH_WORD [0b] IMM
1121 ;; k8
1122 ;; ( -- n )
1123   2 ([0pfx])
1124   ;S
1125 $FORTH_END_WORD [0b]
1126
1127 $FORTH_WORD [0o] IMM
1128 ;; k8
1129 ;; ( -- n )
1130   LIT 8 ([0pfx])
1131   ;S
1132 $FORTH_END_WORD [0o]
1133
1134 $FORTH_WORD [CHAR] IMM
1135 ;; k8
1136 ;; ( -- c )
1137   BL WORD COUNT 0= LIT 42 ?ERROR
1138   C@ LITERAL
1139   ;S
1140 $FORTH_END_WORD [CHAR]
1141
1142
1143 $FORTH_WORD INTERPRET
1144 ;; AberSoft
1145 interpret0:
1146   -FIND 0BRANCH interpret3
1147   STATE @ < 0BRANCH interpret1
1148   CFA , BRANCH interpret5  ;;OLD: BRANCH interpret2
1149 interpret1:
1150   CFA EXECUTE
1151 interpret2:
1152   ?STACK BRANCH interpret0  ;;OLD: BRANCH interpret6
1153 interpret3:
1154   HERE NUMBER DPL @ 1+ 0BRANCH interpret4
1155   DLITERAL BRANCH interpret5
1156 interpret4:
1157   DROP LITERAL
1158 interpret5:
1159   ?STACK
1160 interpret6:
1161   BRANCH interpret0
1162 $FORTH_END_WORD INTERPRET
1163
1164 $FORTH_WORD IMMEDIATE
1165 ;; AberSoft
1166 ;; ( -- )
1167   LATEST LIT #40 TOGGLE ;S
1168 $FORTH_END_WORD IMMEDIATE
1169
1170 $FORTH_WORD DEFINITIONS
1171 ;; AberSoft
1172 ;; ( -- )
1173   CONTEXT @ CURRENT ! ;S
1174 $FORTH_END_WORD DEFINITIONS
1175
1176 $FORTH_WORD ( IMM
1177 ;; AberSoft, k8
1178 ;; ( -- )
1179   LIT 41 WORD DROP ;S
1180 $FORTH_END_WORD (
1181
1182 ;;FIXME: NOT PROPERLY TESTED!
1183 $FORTH_WORD \ IMM
1184 ;; k8
1185 ;; ( -- )
1186   BLK @ 0BRANCH cmt_eol_tib
1187   BLK @ BLOCK BRANCH cmt_eol_main   ;; else -- load block and get its address
1188 cmt_eol_tib:
1189   TIB @
1190 cmt_eol_main:
1191   DUP
1192   IN @ +  ;; ( staddr curaddr )
1193   ;;DEBUG: CR DUP U.
1194 cmt_eol_loop:
1195   DUP C@
1196   ;;DEBUG: DUP XEMIT
1197   DUP 0BRANCH cmt_eol_done
1198   ;; non-zero
1199   DUP CHCR = TBRANCH cmt_eol_done
1200   DUP CHLF = TBRANCH cmt_eol_done
1201   DROP
1202   1+
1203   BRANCH cmt_eol_loop
1204 cmt_eol_done:
1205   DROP
1206   ;;DEBUG: SPACE DUP U. CR
1207   SWAP - IN !
1208   ;S
1209 $FORTH_END_WORD \
1210
1211
1212 $FORTH_WORD QUIT
1213 ;; AberSoft
1214 ;; ( -- )
1215   BLK 0!
1216   ;;TLOAD-Y 0!
1217   FCLOSE
1218   [
1219 quit0:
1220   RP! CR QUERY INTERPRET STATE @ 0= 0BRANCH quit1
1221   (.")  ~ok~  ;;"
1222 quit1:
1223   BRANCH quit0
1224 $FORTH_END_WORD QUIT
1225
1226
1227 $FORTH_WORD ABORT
1228 ;; AberSoft, k8
1229 ;; ( -- )
1230   SP! DECIMAL ?STACK
1231   ;;TLOAD-Y 0!
1232   FCLOSE
1233   FORTH DEFINITIONS  QUIT
1234 $FORTH_END_WORD ABORT
1235
1236 $FORTH_WORD WARM
1237 ;; AberSoft, k8
1238 ;; ( -- )
1239 WARMbody:
1240 ;;  8 1 16384 TR-SREAD
1241   RP! EMPTY-BUFFERS
1242   CLS .CREDITZ
1243   ABORT
1244 $FORTH_END_WORD WARM
1245
1246 $FORTH_WORD COLD
1247 ;; AberSoft, k8
1248 ;; ( -- )
1249 COLDbody:
1250   FIRST BUF-USE !  FIRST BUF-PREV !  DR0
1251   ;; the first USER is at f_userBASE+6
1252   LIT f_userDEF  LIT f_userBASE @ LIT 6 +  LIT f_userDEF_size CMOVE
1253   RP!
1254   LIT f_userBASE @ LIT fuserofs_readonly + 0!  ;; READ-ONLY
1255   LIT f_userBASE @ LIT fuserofs_showhidden + 0!  ;; SHOW-HIDDEN
1256   LIT latest_word  LIT forth_voc_latest  !
1257   LIT f_cur7FFD C@ LIT #7FFD OUTP
1258   WARM
1259 $FORTH_END_WORD COLD
1260
1261
1262   IF USE_TEXT_ERROR_MESSAGES
1263 forth_error_msg_table:
1264   defb 1
1265     defc "Stack empty"
1266   defb 2
1267     defc "Dictionary full"
1268   defb 3
1269     defc "Incorrect address mode"
1270   defb 4
1271     defc "Is not unique"
1272   defb 6
1273     defc "RAM disc range"
1274   defb 7
1275     defc "Stack full"
1276   defb 9
1277     defc "Load from page 0"
1278   defb 17
1279     defc "Compilation only"
1280   defb 18
1281     defc "Execution only"
1282   defb 19
1283     defc "Conditionals not paired"
1284   defb 20
1285     defc "Definition not finished"
1286   defb 21
1287     defc "In protected dictionary"
1288   defb 22
1289     defc "Use only when loading"
1290   defb 23
1291     defc "Off current editing screen"
1292   defb 24
1293     defc "Declare vocabulary"
1294   defb 42
1295     defc "Word expected"
1296   defb 0
1297
1298 ;; show warning message
1299 $FORTH_WORD MESSAGE
1300 ;; AberSoft
1301 ;; ( num -- )
1302 ;; message #0 is "word?" show no warning text
1303   -DUP 0BRANCH message_done
1304 ;; show warning text?
1305   WARNING @ 0BRANCH message_simple
1306   ;; show message line
1307   ;; k8: nope; use built-in text instead
1308   ;; 4 OFFSET @ b/SCR / - .LINE SPACE
1309   >R
1310   LIT forth_error_msg_table
1311   ;; ( tbl | num )
1312 message_loop:
1313     COUNT -DUP 0BRANCH message_loop_done
1314     ;; ( tbl msgid | num )
1315     R@ = 0BRANCH message_loop_skip
1316     COUNT TYPE RDROP ;S
1317 message_loop_skip:
1318     COUNT +
1319   BRANCH message_loop
1320 message_loop_done:
1321   ;; ( tbl | num )
1322   DROP R>
1323 message_simple:
1324   (.")  ~MSG #~  ;;"
1325   BASE @ DECIMAL SWAP . BASE !
1326 message_done:
1327   ;S
1328 $FORTH_END_WORD MESSAGE
1329
1330   ELSE
1331
1332 ;; show warning message
1333 $FORTH_WORD MESSAGE
1334 ;; AberSoft
1335 ;; ( num -- )
1336 ;; message #0 is "word?" show no warning text
1337   -DUP 0BRANCH message_done
1338   (.")  ~MSG #~  ;;"
1339   BASE @ DECIMAL SWAP . BASE !
1340 message_done:
1341   ;S
1342 $FORTH_END_WORD MESSAGE
1343
1344   ENDIF
1345
1346
1347 $FORTH_WORD ' IMM
1348 ;; AberSoft
1349 ;; ( -- )
1350   -FIND 0= 0 ?ERROR DROP LITERAL ;S
1351 $FORTH_END_WORD '
1352
1353   include "main_ctrl.zas"
1354
1355   include "main_nprint.zas"
1356
1357 ;; $FORTH_WORD ?
1358 ;; ;; AberSoft
1359 ;;   @ . ;S
1360 ;; $FORTH_END_WORD ?
1361
1362   include "main_vlist.zas"
1363
1364 ;; read next word from the input stream
1365 ;; place it at PAD as the counted string
1366 $FORTH_WORD TEXT
1367 ;; AberSoft, k8
1368 ;; ( delimeter -- )
1369   HERE  C/L 1+  BLANKS
1370   WORD  PAD  C/L 1+  CMOVE ;S
1371 $FORTH_END_WORD TEXT
1372
1373 $FORTH_WORD SIZE
1374 ;; AberSoft
1375 ;; ( -- n )
1376   HERE 0 +ORIGIN - ;S
1377 $FORTH_END_WORD SIZE
1378
1379 $FORTH_WORD FREE
1380 ;; AberSoft
1381 ;; ( -- n )
1382   SP@ RP@ UMIN BL - HERE - ;S
1383 $FORTH_END_WORD FREE
1384
1385
1386 $FORTH_WORD FORGET
1387 ;; AberSoft
1388 ;; ( -- )
1389   CURRENT @ CONTEXT @ - LIT 24 ?ERROR
1390   ' DUP FENCE @ U< LIT 21 ?ERROR
1391   DUP NFA DP ! LFA @ CURRENT @ ! ;S
1392 $FORTH_END_WORD FORGET
1393
1394
1395 ;; FORTH vocabulary
1396 $FORTH_DOES FORTH voc_does IMM
1397 ;; k8, AberSoft
1398 ;; ( -- )
1399   defw #A081          ;; name
1400 forth_voc_latest:
1401   defw latest_word    ;; voc latest
1402 forth_voc_link:
1403   defw 0              ;; prev voc-link
1404
1405 $FORTH_WORD VOCABULARY
1406 ;; AberSoft
1407 ;; ( -- )
1408   <BUILDS LIT #A081 , CURRENT @ CFA , HERE VOC-LINK @ , VOC-LINK ! DOES>
1409 voc_does:
1410   2+ CONTEXT ! ;S
1411 $FORTH_END_WORD VOCABULARY
1412
1413 ;; VOCABULARY BODY:
1414 ;; "DOES>" ptr
1415 ;; name: " "
1416 ;; lfa
1417 ;; old voc-link
1418
1419
1420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1421 ;; buffers, blocks, etc...
1422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1423   include "main_trdos.zas"
1424   include "main_blocks.zas"
1425   include "ext_textfile.zas"
1426 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1427 ;; end of buffers, blocks, etc...
1428 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1429
1430   include "ext_gfxlo.zas"
1431   include "ext_gfxhi.zas"
1432   include "ext_dump.zas"
1433
1434 ;;;;;;;;;;;;;;;;;;;; INSERT YOUR WORDS BELOW ;;;;;;;;;;;;;;;;;;;;
1435 ;;
1436 ;;
1437 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1438
1439 ;;!!!!!! THIS LABEL SHOULD BE JUST BEFORE THE LAST DEFINED WORD
1440 latest_word:
1441 ;;!!!!!! DO NOT REMOVE THIS WORD! THE SYSTEM USES IT
1442 $FORTH_WORD NOOP
1443 ;; AberSoft
1444 ;; ( -- )
1445   ;S
1446 $FORTH_END_WORD NOOP
1447
1448 latest_byte: defw 666