MSP430-FORTH/MSP_EXP430FR5994/DOUBLE.4TH

   1
   2 ; -----------------------------------------------------
   3 ; DOUBLE.4th for MSP_EXP430FR5994
   4 ; -----------------------------------------------------
   5
   6 ; -----------------------------------------------------------
   7 ; requires DOUBLE_INPUT kernel addon, see forthMSP430FR.asm
   8 ; -----------------------------------------------------------
   9
  10 PWR_STATE
  11
  12 [DEFINED] {DOUBLE} [IF]  {DOUBLE} [THEN]
  13
  14 MARKER {DOUBLE}
  15
  16 [UNDEFINED] >R [IF]
  17 CODE >R
  18 PUSH R14
  19 MOV @R15+,R14
  20 MOV @R13+,R0
  21 ENDCODE
  22 [THEN]
  23
  24 [UNDEFINED] R> [IF]
  25 CODE R>
  26 SUB #2,R15
  27 MOV R14,0(R15)
  28 MOV @R1+,R14
  29 MOV @R13+,R0
  30 ENDCODE
  31 [THEN]
  32
  33 [UNDEFINED] @ [IF]
  34 CODE @
  35 MOV @R14,R14
  36 MOV @R13+,R0
  37 ENDCODE
  38 [THEN]
  39
  40 [UNDEFINED] ! [IF]
  41 CODE !
  42 MOV @R15+,0(R14)
  43 MOV @R15+,R14
  44 MOV @R13+,R0
  45 ENDCODE
  46 [THEN]
  47
  48 [UNDEFINED] C@ [IF]
  49 CODE C@
  50 MOV.B @R14,R14
  51 MOV @R13+,R0
  52 ENDCODE
  53 [THEN]
  54
  55 [UNDEFINED] SWAP [IF]
  56 CODE SWAP
  57 MOV @R15,R10
  58 MOV R14,0(R15)
  59 MOV R10,R14
  60 MOV @R13+,R0
  61 ENDCODE
  62 [THEN]
  63
  64 [UNDEFINED] OVER [IF]
  65 CODE OVER
  66 MOV R14,-2(R15)
  67 MOV @R15,R14
  68 SUB #2,R15
  69 MOV @R13+,R0
  70 ENDCODE
  71 [THEN]
  72
  73 [UNDEFINED] ROT [IF]
  74 CODE ROT
  75 MOV @R15,R10
  76 MOV R14,0(R15)
  77 MOV 2(R15),R14
  78 MOV R10,2(R15)
  79 MOV @R13+,R0
  80 ENDCODE
  81 [THEN]
  82
  83 [UNDEFINED] - [IF]
  84 CODE -
  85 SUB @R15+,R14
  86 XOR #-1,R14
  87 ADD #1,R14
  88 MOV @R13+,R0
  89 ENDCODE
  90 [THEN]
  91
  92 [UNDEFINED] < [IF]
  93 CODE <
  94         SUB @R15+,R14
  95         S< ?GOTO FW1
  96         0<> IF
  97 BW1         MOV #-1,R14
  98         THEN
  99         MOV @R13+,R0
 100 ENDCODE
 101
 102 CODE >
 103         SUB @R15+,R14
 104         S< ?GOTO BW1
 105 FW1     AND #0,R14
 106         MOV @R13+,R0
 107 ENDCODE
 108 [THEN]
 109
 110 [UNDEFINED] IF [IF]
 111 CODE IF
 112 SUB #2,R15
 113 MOV R14,0(R15)
 114 MOV &$1DC6,R14
 115 ADD #4,&$1DC6
 116 MOV #$4042,0(R14)
 117 ADD #2,R14
 118 MOV @R13+,R0
 119 ENDCODE IMMEDIATE
 120
 121 CODE THEN
 122 MOV &$1DC6,0(R14)
 123 MOV @R15+,R14
 124 MOV @R13+,R0
 125 ENDCODE IMMEDIATE
 126 [THEN]
 127
 128 [UNDEFINED] ELSE [IF]
 129 CODE ELSE
 130 ADD #4,&$1DC6
 131 MOV &$1DC6,R10
 132 MOV #$403E,-4(R10)
 133 MOV R10,0(R14)
 134 SUB #2,R10
 135 MOV R10,R14
 136 MOV @R13+,R0
 137 ENDCODE IMMEDIATE
 138 [THEN]
 139
 140 [UNDEFINED] TO [IF]
 141 CODE TO
 142 BIS #$400,R2
 143 MOV @R13+,R0
 144 ENDCODE
 145 [THEN]
 146
 147 [UNDEFINED] DOES> [IF]
 148 CODE DOES>
 149 MOV &$1DBA,R10
 150 MOV #$1285,0(R10)
 151 MOV R13,2(R10)
 152 MOV @R1+,R13
 153 MOV @R13+,R0
 154 ENDCODE
 155 [THEN]
 156
 157 [UNDEFINED] SPACES [IF]
 158 CODE SPACES
 159 CMP #0,R14
 160 0<> IF
 161     PUSH R13
 162     BEGIN
 163         LO2HI
 164         $20 EMIT
 165         HI2LO
 166         SUB #2,R13
 167         SUB #1,R14
 168     0= UNTIL
 169     MOV @R1+,R13
 170 THEN
 171 MOV @R15+,R14
 172 MOV @R13+,R0
 173 ENDCODE
 174 [THEN]
 175
 176 [UNDEFINED] 2@ [IF]
 177 CODE 2@
 178 SUB #2,R15
 179 MOV 2(R14),0(R15)
 180 MOV @R14,R14
 181 MOV @R13+,R0
 182 ENDCODE
 183 [THEN]
 184
 185 [UNDEFINED] 2! [IF]
 186 CODE 2!
 187 MOV @R15+,0(R14)
 188 MOV @R15+,2(R14)
 189 MOV @R15+,R14
 190 MOV @R13+,R0
 191 ENDCODE
 192 [THEN]
 193
 194 [UNDEFINED] 2DUP [IF]
 195 CODE 2DUP
 196 SUB #4,R15
 197 MOV R14,2(R15)
 198 MOV 4(R15),0(R15)
 199 MOV @R13+,R0
 200 ENDCODE
 201 [THEN]
 202
 203 [UNDEFINED] 2DROP [IF]
 204 CODE 2DROP
 205 ADD #2,R15
 206 MOV @R15+,R14
 207 MOV @R13+,R0
 208 ENDCODE
 209 [THEN]
 210
 211 [UNDEFINED] 2SWAP [IF]
 212 CODE 2SWAP
 213 MOV @R15,R10
 214 MOV 4(R15),0(R15)
 215 MOV R10,4(R15)
 216 MOV R14,R10
 217 MOV 2(R15),R14
 218 MOV R10,2(R15)
 219 MOV @R13+,R0
 220 ENDCODE
 221 [THEN]
 222
 223 [UNDEFINED] 2OVER [IF]
 224 CODE 2OVER
 225 SUB #4,R15
 226 MOV R14,2(R15)
 227 MOV 8(R15),0(R15)
 228 MOV 6(R15),R14
 229 MOV @R13+,R0
 230 ENDCODE
 231 [THEN]
 232
 233 [UNDEFINED] 2>R [IF]
 234 CODE 2>R
 235 PUSH @R15+
 236 PUSH R14
 237 MOV @R15+,R14
 238 MOV @R13+,R0
 239 ENDCODE
 240 [THEN]
 241
 242 [UNDEFINED] 2R@ [IF]
 243 CODE 2R@
 244 SUB #4,R15
 245 MOV R14,2(R15)
 246 MOV @R1,R14
 247 MOV 2(R1),0(R15)
 248 MOV @R13+,R0
 249 ENDCODE
 250 [THEN]
 251
 252 [UNDEFINED] 2R> [IF]
 253 CODE 2R>
 254 SUB #4,R15
 255 MOV R14,2(R15)
 256 MOV @R1+,R14
 257 MOV @R1+,0(R15)
 258 MOV @R13+,R0
 259 ENDCODE
 260 [THEN]
 261
 262
 263 [UNDEFINED] D. [IF]
 264 CODE D.
 265 MOV #U.,R10
 266 ADD #10,R10
 267 MOV R10,R0
 268 ENDCODE
 269 [THEN]
 270
 271 [UNDEFINED] 2ROT [IF]
 272 CODE 2ROT
 273 MOV 8(R15),R9
 274 MOV 6(R15),R8
 275 MOV 4(R15),8(R15)
 276 MOV 2(R15),6(R15)
 277 MOV @R15,4(R15)
 278 MOV R14,2(R15)
 279 MOV R9,0(R15)
 280 MOV R8,R14
 281 MOV @R13+,R0
 282 ENDCODE
 283 [THEN]
 284
 285 [UNDEFINED] D>S [IF]
 286 CODE D>S
 287 MOV @R15+,R14
 288 MOV @R13+,R0
 289 ENDCODE
 290 [THEN]
 291
 292 [UNDEFINED] D0= [IF]
 293 CODE D0=
 294 CMP #0,R14
 295 MOV #0,R14
 296 0= IF
 297     CMP #0,0(R15)
 298     0= IF
 299         MOV #-1,R14
 300     THEN
 301 THEN
 302 ADD #2,R15
 303 MOV @R13+,R0
 304 ENDCODE
 305 [THEN]
 306
 307 [UNDEFINED] D0< [IF]
 308 CODE D0<
 309 CMP #0,R14
 310 MOV #0,R14
 311 S< IF
 312     MOV #-1,R14
 313 THEN
 314 ADD #2,R15
 315 MOV @R13+,R0
 316 ENDCODE
 317 [THEN]
 318
 319 [UNDEFINED] D= [IF]
 320 CODE D=
 321 CMP R14,2(R15)
 322 MOV #0,R14
 323 0= IF
 324     CMP @R15,4(R15)
 325     0= IF
 326     MOV #-1,R14
 327     THEN
 328 THEN
 329 ADD #6,R15
 330 MOV @R13+,R0
 331 ENDCODE
 332 [THEN]
 333
 334 [UNDEFINED] D< [IF]
 335 CODE D<
 336 CMP R14,2(R15)
 337 MOV #0,R14
 338 S< IF
 339     MOV #-1,R14
 340 THEN
 341 0= IF
 342     CMP @R15,4(R15)
 343     S< IF
 344         MOV #-1,R14
 345     THEN
 346 THEN
 347 ADD #6,R15
 348 MOV @R13+,R0
 349 ENDCODE
 350 [THEN]
 351
 352 [UNDEFINED] DU< [IF]
 353 CODE DU<
 354 CMP R14,2(R15)
 355 MOV #0,R14
 356 U< IF
 357     MOV #-1,R14
 358 THEN
 359 0= IF
 360     CMP @R15,4(R15)
 361     U< IF
 362         MOV #-1,R14
 363     THEN
 364 THEN
 365 ADD #6,R15
 366 MOV @R13+,R0
 367 ENDCODE
 368 [THEN]
 369
 370 [UNDEFINED] D+ [IF]
 371 CODE D+
 372 BW1 ADD @R15+,2(R15)
 373     ADDC @R15+,R14
 374 MOV @R13+,R0
 375 ENDCODE
 376 [THEN]
 377
 378 [UNDEFINED] M+ [IF]
 379 CODE M+
 380 SUB #2,R15
 381 CMP #0,R14
 382 MOV R14,0(R15)
 383 MOV #-1,R14
 384 0>= IF
 385     MOV #0,R14
 386 THEN
 387 GOTO BW1
 388 ENDCODE
 389 [THEN]
 390
 391 [UNDEFINED] D- [IF]
 392 CODE D-
 393 SUB @R15+,2(R15)
 394 SUBC R14,0(R15)
 395 MOV @R15+,R14
 396 MOV @R13+,R0
 397 ENDCODE
 398 [THEN]
 399
 400 [UNDEFINED] DNEGATE [IF]
 401 CODE DNEGATE
 402 XOR #-1,0(R15)
 403 XOR #-1,R14
 404 ADD #1,0(R15)
 405 ADDC #0,R14
 406 MOV @R13+,R0
 407 ENDCODE
 408 [THEN]
 409
 410 [UNDEFINED] DABS [IF]
 411 CODE DABS
 412 CMP #0,R14
 413 0>= IF
 414     MOV @R13+,R0
 415 THEN
 416 MOV #DNEGATE,R0
 417 ENDCODE
 418 [THEN]
 419
 420 [UNDEFINED] D2/ [IF]
 421 CODE D2/
 422 RRA R14
 423 RRC 0(R15)
 424 MOV @R13+,R0
 425 ENDCODE
 426 [THEN]
 427
 428 [UNDEFINED] D2* [IF]
 429 CODE D2*
 430 ADD @R15,0(R15)
 431 ADDC R14,R14
 432 MOV @R13+,R0
 433 ENDCODE
 434 [THEN]
 435
 436 [UNDEFINED] DMAX [IF]
 437 : DMAX
 438 2OVER 2OVER
 439 D< IF
 440     2>R 2DROP 2R>
 441 ELSE
 442     2DROP
 443 THEN
 444 ;
 445 [THEN]
 446
 447 [UNDEFINED] DMIN [IF]
 448 : DMIN
 449 2OVER 2OVER
 450 D< IF
 451     2DROP
 452 ELSE 2>R 2DROP 2R>
 453 THEN
 454 ;
 455
 456 $1A04 C@ $EF > [IF] ; test tag value for MSP430FR413x devices without hardware_MPY
 457
 458 [UNDEFINED] M*/ [IF]
 459 CODE M*/
 460 BIC #$200,R2
 461 CMP #0,2(R15)
 462 S< IF
 463     XOR #-1,4(R15)
 464     XOR #-1,2(R15)
 465     ADD #1,4(R15)
 466     ADDC #0,2(R15)
 467     BIS #$200,R2
 468 THEN
 469 CMP #0,0(R15)
 470 S< IF
 471     XOR #-1,0(R15)
 472     ADD #1,0(R15)
 473     BIT #$200,R2
 474     0= IF
 475         BIS #$200,R2
 476     ELSE
 477         BIC #$200,R2
 478     THEN
 479 THEN
 480             MOV 4(R15),R8
 481             MOV 2(R15),R11
 482             MOV @R15+,R12
 483             MOV #0,R5
 484             MOV #0,2(R15)
 485             MOV #0,0(R15)
 486             MOV #0,R10
 487             MOV #1,R9
 488 BEGIN       BIT R9,R12
 489     0<> IF  ADD R8,2(R15)
 490             ADDC R11,0(R15)
 491             ADDC R5,R10
 492     THEN    ADD R8,R8
 493             ADDC R11,R11
 494             ADDC R5,R5
 495             ADD R9,R9
 496 U>= UNTIL
 497 MOV R14,R11
 498 MOV @R15,R14
 499 MOV 2(R15),R12
 500
 501 MOV #32,R5
 502 CALL #$408E
 503 MOV @R15+,0(R15)
 504 BIT #$200,R2
 505 0<> IF
 506     XOR #-1,0(R15)
 507     XOR #-1,R14
 508     ADD #1,0(R15)
 509     ADDC #0,R14
 510     BIC #$200,R2
 511     CMP #0,R10
 512     0<> IF
 513         SUB #1,0(R15)
 514         SUBC #0,R14
 515     THEN
 516 THEN
 517 MOV @R13+,R0
 518 ENDCODE
 519 [THEN]
 520
 521 [ELSE]
 522
 523 [UNDEFINED] M*/ [IF]
 524 CODE M*/
 525 MOV 4(R15),&$4D4
 526 MOV 2(R15),&$4D6
 527 MOV @R15+,&$4C8
 528 MOV R14,R11
 529 MOV R0,R0
 530 MOV &$4E4,R12
 531 MOV &$4E6,R14
 532 MOV &$4E8,R10
 533 BIC #$200,R2
 534 CMP #0,R10
 535 S< IF
 536     XOR #-1,R12
 537     XOR #-1,R14
 538     XOR #-1,R10
 539     ADD #1,R12
 540     ADDC #0,R14
 541     ADDC #0,R10
 542     BIS #$200,R2
 543 THEN
 544 MOV #32,R5
 545 CALL #$408E
 546 MOV @R15+,0(R15)
 547 BIT #$200,R2
 548 0<> IF
 549     XOR #-1,0(R15)
 550     XOR #-1,R14
 551     ADD #1,0(R15)
 552     ADDC #0,R14
 553     BIC #$200,R2
 554     CMP #0,R10
 555     0<> IF
 556         SUB #1,0(R15)
 557         SUBC #0,R14
 558     THEN
 559 THEN
 560 MOV @R13+,R0
 561 ENDCODE
 562 [THEN]
 563
 564 [THEN]  ; end of software/hardware_MPY
 565
 566 [UNDEFINED] 2VARIABLE [IF]
 567 : 2VARIABLE
 568 CREATE
 569 HI2LO
 570 ADD #4,&$1DC6
 571 MOV @R1+,R13
 572 MOV @R13+,R0
 573 ENDCODE
 574 [THEN]
 575
 576 [UNDEFINED] 2CONSTANT [IF]
 577 : 2CONSTANT
 578 CREATE
 579 , ,
 580 DOES>
 581 2@
 582 ;
 583 [THEN]
 584
 585 [UNDEFINED] 2VALUE [IF]
 586 : 2VALUE
 587 CREATE , ,
 588 DOES>
 589 HI2LO
 590 MOV @R1+,R13
 591 BIT #$200,R2
 592 0= IF
 593    MOV #2@,R0
 594 THEN
 595 BIC #$200,R2
 596 MOV #2!,R0
 597 ENDCODE
 598 [THEN]
 599
 600 [UNDEFINED] 2LITERAL [IF]
 601 CODE 2LITERAL
 602 BIS #$200,R2
 603 MOV #LITERAL,R0
 604 ENDCODE IMMEDIATE
 605 [THEN]
 606
 607 [UNDEFINED] D.R [IF]
 608 : D.R
 609 >R SWAP OVER DABS <# #S ROT SIGN #>
 610 R> OVER - SPACES TYPE
 611 ;
 612 [THEN]
 613
 614 [THEN]
 615
 616 RST_HERE
 617
 618
 619 [UNDEFINED] VARIABLE [IF]
 620 : VARIABLE
 621 CREATE
 622 HI2LO
 623 MOV @R1+,R13
 624 ADD #2,&$1DC6
 625 MOV @R13+,R0
 626 ENDCODE
 627 [THEN]
 628
 629 [UNDEFINED] CONSTANT [IF]
 630 : CONSTANT
 631 CREATE
 632 HI2LO
 633 MOV R14,-2(R10)
 634 MOV @R15+,R14
 635 MOV @R1+,R13
 636 MOV @R13+,R0
 637 ENDCODE
 638 [THEN]
 639
 640 [UNDEFINED] CELLS [IF]
 641 CODE CELLS
 642 ADD R14,R14
 643 MOV @R13+,R0
 644 ENDCODE
 645 [THEN]
 646
 647 [UNDEFINED] ALLOT [IF]
 648 CODE ALLOT
 649 ADD R14,&$1DC6
 650 MOV @R15+,R14
 651 MOV @R13+,R0
 652 ENDCODE
 653 [THEN]
 654
 655 [UNDEFINED] DEPTH [IF]
 656 CODE DEPTH
 657 MOV R14,-2(R15)
 658 MOV #$1C80,R14
 659 SUB R15,R14
 660 RRA R14
 661 SUB #2,R15
 662 MOV @R13+,R0
 663 ENDCODE
 664 [THEN]
 665
 666 [UNDEFINED] DUP [IF]
 667 CODE DUP
 668 BW1 SUB #2,R15
 669     MOV R14,0(R15)
 670     MOV @R13+,R0
 671 ENDCODE
 672
 673 CODE ?DUP
 674 CMP #0,R14
 675 0<> ?GOTO BW1
 676 MOV @R13+,R0
 677 ENDCODE
 678 [THEN]
 679
 680 [UNDEFINED] DO [IF]
 681 CODE DO
 682 SUB #2,R15
 683 MOV R14,0(R15)
 684 ADD #2,&$1DC6
 685 MOV &$1DC6,R14
 686 MOV #$404C,-2(R14)
 687 ADD #2,&$1C00
 688 MOV &$1C00,R10
 689 MOV #0,0(R10)
 690 MOV @R13+,R0
 691 ENDCODE IMMEDIATE
 692
 693 CODE LOOP
 694     MOV #$406E,R9
 695 BW1 ADD #4,&$1DC6
 696     MOV &$1DC6,R10
 697     MOV R9,-4(R10)
 698     MOV R14,-2(R10)
 699 BEGIN
 700     MOV &$1C00,R14
 701     SUB #2,&$1C00
 702     MOV @R14,R14
 703     CMP #0,R14
 704 0<> WHILE
 705     MOV R10,0(R14)
 706 REPEAT
 707     MOV @R15+,R14
 708     MOV @R13+,R0
 709 ENDCODE IMMEDIATE
 710
 711 CODE +LOOP
 712 MOV #$405C,R9
 713 GOTO BW1
 714 ENDCODE IMMEDIATE
 715 [THEN]
 716
 717 [UNDEFINED] I [IF]
 718 CODE I
 719 SUB #2,R15
 720 MOV R14,0(R15)
 721 MOV @R1,R14
 722 SUB 2(R1),R14
 723 MOV @R13+,R0
 724 ENDCODE
 725 [THEN]
 726
 727 [UNDEFINED] + [IF]
 728 CODE +
 729 ADD @R15+,R14
 730 MOV @R13+,R0
 731 ENDCODE
 732 [THEN]
 733
 734 [UNDEFINED] = [IF]
 735 CODE =
 736 SUB @R15+,R14
 737 0<> IF
 738     AND #0,R14
 739     MOV @R13+,R0
 740 THEN
 741 XOR #-1,R14
 742 MOV @R13+,R0
 743 ENDCODE
 744 [THEN]
 745
 746 [UNDEFINED] 0= [IF]
 747 CODE 0=
 748 SUB #1,R14
 749 SUBC R14,R14
 750 MOV @R13+,R0
 751 ENDCODE
 752 [THEN]
 753
 754 [UNDEFINED] SOURCE [IF]
 755 CODE SOURCE
 756 SUB #4,R15
 757 MOV R14,2(R15)
 758 MOV &$1DC0,R14
 759 MOV &$1DC2,0(R15)
 760 MOV @R13+,R0
 761 ENDCODE
 762 [THEN]
 763
 764 [UNDEFINED] >IN [IF]
 765 $1DC4 CONSTANT >IN
 766 [THEN]
 767
 768 [UNDEFINED] SWAP [IF]
 769 CODE SWAP
 770 MOV @R15,R10
 771 MOV R14,0(R15)
 772 MOV R10,R14
 773 MOV @R13+,R0
 774 ENDCODE
 775 [THEN]
 776
 777 [UNDEFINED] DROP [IF]
 778 CODE DROP
 779 MOV @R15+,R14
 780 MOV @R13+,R0
 781 ENDCODE
 782 [THEN]
 783
 784 [UNDEFINED] 1+ [IF]
 785 CODE 1+
 786 ADD #1,R14
 787 MOV @R13+,R0
 788 ENDCODE
 789 [THEN]
 790
 791 [UNDEFINED] CHAR [IF]
 792 : CHAR
 793     $20 WORD 1+ C@
 794 ;
 795 [THEN]
 796
 797 [UNDEFINED] [CHAR] [IF]
 798 : [CHAR]
 799     CHAR POSTPONE LITERAL
 800 ; IMMEDIATE
 801 [THEN]
 802
 803 [UNDEFINED] 2/ [IF]
 804 CODE 2/
 805 RRA R14
 806 MOV @R13+,R0
 807 ENDCODE
 808 [THEN]
 809
 810 [UNDEFINED] INVERT [IF]
 811 CODE INVERT
 812 XOR #-1,R14
 813 MOV @R13+,R0
 814 ENDCODE
 815 [THEN]
 816
 817 [UNDEFINED] RSHIFT [IF]
 818 CODE RSHIFT
 819             MOV @R15+,R10
 820             AND #$1F,R14
 821 0<> IF
 822     BEGIN   BIC #1,R2
 823             RRC R10
 824             SUB #1,R14
 825     0= UNTIL
 826 THEN        MOV R10,R14
 827             MOV @R13+,R0
 828 ENDCODE
 829 [THEN]
 830
 831 [UNDEFINED] 0< [IF]
 832 CODE 0<
 833 ADD R14,R14
 834 SUBC R14,R14
 835 XOR #-1,R14
 836 MOV @R13+,R0
 837 ENDCODE
 838 [THEN]
 839
 840 [UNDEFINED] S>D [IF]
 841 : S>D
 842     DUP 0<
 843 ;
 844 [THEN]
 845
 846 [UNDEFINED] 1- [IF]
 847 CODE 1-
 848 SUB #1,R14
 849 MOV @R13+,R0
 850 ENDCODE
 851 [THEN]
 852
 853 [UNDEFINED] UM/MOD [IF]
 854 CODE UM/MOD
 855     PUSH #DROP
 856     MOV #$4074,R0
 857 ENDCODE
 858 [THEN]
 859
 860 [UNDEFINED] SM/REM [IF]
 861 CODE SM/REM
 862 MOV R14,R12
 863 MOV @R15,R11
 864 CMP #0,R14
 865 S< IF
 866     XOR #-1,R14
 867     ADD #1,R14
 868 THEN
 869 CMP #0,0(R15)
 870 S< IF
 871     XOR #-1,2(R15)
 872     XOR #-1,0(R15)
 873     ADD #1,2(R15)
 874     ADDC #0,0(R15)
 875 THEN
 876 PUSHM #3,R13
 877 LO2HI
 878     UM/MOD
 879 HI2LO
 880 POPM #3,R13
 881 CMP #0,R11
 882 S< IF
 883     XOR #-1,0(R15)
 884     ADD #1,0(R15)
 885 THEN
 886 XOR R12,R11
 887 CMP #0,R11
 888 S< IF
 889     XOR #-1,R14
 890     ADD #1,R14
 891 THEN
 892 MOV @R13+,R0
 893 ENDCODE
 894 [THEN]
 895
 896 [UNDEFINED] FM/MOD [IF]
 897 : FM/MOD
 898 SM/REM
 899 HI2LO
 900 CMP #0,0(R15)
 901 0<> IF
 902     CMP #1,R14
 903     S< IF
 904       ADD R12,0(R15)
 905       SUB #1,R14
 906     THEN
 907 THEN
 908 MOV @R1+,R13
 909 MOV @R13+,R0
 910 ENDCODE
 911 [THEN]
 912
 913 [UNDEFINED] NIP [IF]
 914 CODE NIP
 915 ADD #2,R15
 916 MOV @R13+,R0
 917 ENDCODE
 918 [THEN]
 919
 920 [UNDEFINED] / [IF]
 921 : /
 922 >R DUP 0< R> FM/MOD NIP
 923 ;
 924 [THEN]
 925
 926 [UNDEFINED] NEGATE [IF]
 927 CODE NEGATE
 928 XOR #-1,R14
 929 ADD #1,R14
 930 MOV @R13+,R0
 931 ENDCODE
 932 [THEN]
 933
 934 [UNDEFINED] HERE [IF]
 935 CODE HERE
 936 MOV #$402C,R0
 937 ENDCODE
 938 [THEN]
 939
 940 [UNDEFINED] CHARS [IF]
 941 CODE CHARS
 942 MOV @R13+,R0
 943 ENDCODE
 944 [THEN]
 945
 946 [UNDEFINED] MOVE [IF]
 947 CODE MOVE
 948 MOV R14,R10
 949 MOV @R15+,R8
 950 MOV @R15+,R9
 951 MOV @R15+,R14
 952 CMP #0,R10
 953 0<> IF
 954     CMP R9,R8
 955     0<> IF
 956         U< IF
 957             BEGIN
 958                 MOV.B @R9+,0(R8)
 959                 ADD #1,R8
 960                 SUB #1,R10
 961             0= UNTIL
 962             MOV @R13+,R0
 963         THEN
 964         ADD R10,R8
 965         ADD R10,R9
 966         BEGIN
 967             SUB #1,R9
 968             SUB #1,R8
 969             MOV.B @R9,0(R8)
 970             SUB #1,R10
 971         0= UNTIL
 972     THEN
 973 THEN
 974 MOV @R13+,R0
 975 ENDCODE
 976 [THEN]
 977
 978  0 CONSTANT FALSE
 979 -1 CONSTANT TRUE
 980
 981 VARIABLE VERBOSE
 982     FALSE VERBOSE !
 983
 984
 985 VARIABLE ACTUAL-DEPTH
 986 CREATE ACTUAL-RESULTS 20 CELLS ALLOT
 987
 988 : T{
 989     ;
 990
 991 : ->
 992     DEPTH DUP ACTUAL-DEPTH !
 993     ?DUP IF
 994         0 DO ACTUAL-RESULTS I CELLS + ! LOOP
 995     THEN ;
 996
 997 : }T
 998
 999     DEPTH ACTUAL-DEPTH @ = IF
1000         DEPTH ?DUP IF
1001         0 DO
1002             ACTUAL-RESULTS I CELLS + @
1003             = 0= IF TRUE ABORT" INCORRECT RESULT" THEN
1004         LOOP
1005         THEN
1006     ELSE
1007         TRUE ABORT" WRONG NUMBER OF RESULTS"
1008     THEN ;
1009
1010 : TESTING
1011     SOURCE VERBOSE @
1012     IF DUP >R TYPE CR R> >IN !
1013     ELSE >IN ! DROP [CHAR] * EMIT
1014     THEN ;
1015
1016 -1 CONSTANT 1S
1017 0 CONSTANT <FALSE>
1018 -1 CONSTANT <TRUE>
1019 0 INVERT 1 RSHIFT           CONSTANT MAX-INT    ; 011...1
1020 0 INVERT 1 RSHIFT INVERT    CONSTANT MIN-INT    ; 100...0
1021 MAX-INT 2/                  CONSTANT HI-INT     ; 001...1
1022 MIN-INT 2/                  CONSTANT LO-INT     ; 110...0
1023 -1 MAX-INT                  2CONSTANT MAX-2INT  ; 011...1
1024 0 MIN-INT                   2CONSTANT MIN-2INT  ; 100...0
1025 MAX-2INT 2/                 2CONSTANT HI-2INT   ; 001...1
1026 MIN-2INT 2/                 2CONSTANT LO-2INT   ; 110...0
1027
1028 ECHO
1029
1030 ; --------------------------------------------------------------------------------
1031 ; DOUBLE tests
1032 ; --------------------------------------------------------------------------------
1033
1034 T{ 1 2 2CONSTANT 2c1 -> }T
1035 T{ 2c1 -> 1 2 }T
1036 T{ : cd1 2c1 ; -> }T
1037 T{ cd1 -> 1 2 }T
1038
1039 T{ : cd2 2CONSTANT ; -> }T
1040 T{ -1 -2 cd2 2c2 -> }T
1041 T{ 2c2 -> -1 -2 }T
1042
1043 T{ 4 5 2CONSTANT 2c3 IMMEDIATE 2c3 -> 4 5 }T
1044 T{ : cd6 2c3 2LITERAL ; cd6 -> 4 5 }T
1045
1046 T{ 2VARIABLE 2v1 -> }T
1047 T{ 0. 2v1 2! ->    }T
1048 T{    2v1 2@ -> 0. }T
1049 T{ -1 -2 2v1 2! ->       }T
1050 T{       2v1 2@ -> -1 -2 }T
1051 T{ : cd2 2VARIABLE ; -> }T
1052 T{ cd2 2v2 -> }T
1053 T{ : cd3 2v2 2! ; -> }T
1054 T{ -2 -1 cd3 -> }T
1055 T{ 2v2 2@ -> -2 -1 }T
1056
1057 T{ 2VARIABLE 2v3 IMMEDIATE 5 6 2v3 2! -> }T
1058 T{ 2v3 2@ -> 5 6 }T
1059
1060 T{ : cd1 [ MAX-2INT ] 2LITERAL ; -> }T
1061 T{ cd1 -> MAX-2INT }T
1062 T{ 2VARIABLE 2v4 IMMEDIATE 5 6 2v4 2! -> }T
1063 T{ : cd7 2v4 [ 2@ ] 2LITERAL ; cd7 -> 5 6 }T
1064 T{ : cd8 [ 6 7 ] 2v4 [ 2! ] ; 2v4 2@ -> 6 7 }T
1065
1066 T{ 1 2 2VALUE t2val -> }T
1067 T{ t2val -> 1 2 }T
1068 T{ 3 4 TO t2val -> }T
1069 T{ t2val -> 3 4 }T
1070 : sett2val t2val 2SWAP TO t2val ;
1071 T{ 5 6 sett2val t2val -> 3 4 5 6 }T
1072
1073 T{  0.  5. D+ ->  5. }T
1074 T{ -5.  0. D+ -> -5. }T
1075 T{  1.  2. D+ ->  3. }T
1076 T{  1. -2. D+ -> -1. }T
1077 T{ -1.  2. D+ ->  1. }T
1078 T{ -1. -2. D+ -> -3. }T
1079 T{ -1.  1. D+ ->  0. }T
1080 T{  0  0  0  5 D+ ->  0  5 }T
1081 T{ -1  5  0  0 D+ -> -1  5 }T
1082 T{  0  0  0 -5 D+ ->  0 -5 }T
1083 T{  0 -5 -1  0 D+ -> -1 -5 }T
1084 T{  0  1  0  2 D+ ->  0  3 }T
1085 T{ -1  1  0 -2 D+ -> -1 -1 }T
1086 T{  0 -1  0  2 D+ ->  0  1 }T
1087 T{  0 -1 -1 -2 D+ -> -1 -3 }T
1088 T{ -1 -1  0  1 D+ -> -1  0 }T
1089
1090 T{ MIN-INT 0 2DUP D+ -> 0 1 }T
1091 T{ MIN-INT S>D MIN-INT 0 D+ -> 0 0 }T
1092
1093 T{  HI-2INT       1. D+ -> 0 HI-INT 1+ }T
1094 T{  HI-2INT     2DUP D+ -> 1S 1- MAX-INT }T
1095 T{ MAX-2INT MIN-2INT D+ -> -1. }T
1096 T{ MAX-2INT  LO-2INT D+ -> HI-2INT }T
1097 T{  LO-2INT     2DUP D+ -> MIN-2INT }T
1098 T{  HI-2INT MIN-2INT D+ 1. D+ -> LO-2INT }T
1099
1100 T{  0.  5. D- -> -5. }T
1101 T{  5.  0. D- ->  5. }T
1102 T{  0. -5. D- ->  5. }T
1103 T{  1.  2. D- -> -1. }T
1104 T{  1. -2. D- ->  3. }T
1105 T{ -1.  2. D- -> -3. }T
1106 T{ -1. -2. D- ->  1. }T
1107 T{ -1. -1. D- ->  0. }T
1108 T{  0  0  0  5 D- ->  0 -5 }T
1109 T{ -1  5  0  0 D- -> -1  5 }T
1110 T{  0  0 -1 -5 D- ->  1  4 }T
1111 T{  0 -5  0  0 D- ->  0 -5 }T
1112 T{ -1  1  0  2 D- -> -1 -1 }T
1113 T{  0  1 -1 -2 D- ->  1  2 }T
1114 T{  0 -1  0  2 D- ->  0 -3 }T
1115 T{  0 -1  0 -2 D- ->  0  1 }T
1116 T{  0  0  0  1 D- ->  0 -1 }T
1117 T{ MIN-INT 0 2DUP D- -> 0. }T
1118 T{ MIN-INT S>D MAX-INT 0 D- -> 1 1S }T
1119 T{ MAX-2INT max-2INT D- -> 0. }T
1120 T{ MIN-2INT min-2INT D- -> 0. }T
1121 T{ MAX-2INT  hi-2INT D- -> lo-2INT DNEGATE }T
1122 T{  HI-2INT  lo-2INT D- -> max-2INT }T
1123 T{  LO-2INT  hi-2INT D- -> min-2INT 1. D+ }T
1124 T{ MIN-2INT min-2INT D- -> 0. }T
1125 T{ MIN-2INT  lo-2INT D- -> lo-2INT }T
1126
1127 T{                0. D0< -> <FALSE> }T
1128 T{                1. D0< -> <FALSE> }T
1129 T{  MIN-INT        0 D0< -> <FALSE> }T
1130 T{        0  MAX-INT D0< -> <FALSE> }T
1131 T{          MAX-2INT D0< -> <FALSE> }T
1132 T{               -1. D0< -> <TRUE>  }T
1133 T{          MIN-2INT D0< -> <TRUE>  }T
1134
1135 T{               1. D0= -> <FALSE> }T
1136 T{ MIN-INT        0 D0= -> <FALSE> }T
1137 T{         MAX-2INT D0= -> <FALSE> }T
1138 T{      -1  MAX-INT D0= -> <FALSE> }T
1139 T{               0. D0= -> <TRUE>  }T
1140 T{              -1. D0= -> <FALSE> }T
1141 T{       0  MIN-INT D0= -> <FALSE> }T
1142
1143 T{              0. D2* -> 0. D2* }T
1144 T{ MIN-INT       0 D2* -> 0 1 }T
1145 T{         HI-2INT D2* -> MAX-2INT 1. D- }T
1146 T{         LO-2INT D2* -> MIN-2INT }T
1147
1148 T{       0. D2/ -> 0.        }T
1149 T{       1. D2/ -> 0.        }T
1150 T{      0 1 D2/ -> MIN-INT 0 }T
1151 T{ MAX-2INT D2/ -> HI-2INT   }T
1152 T{      -1. D2/ -> -1.       }T
1153 T{ MIN-2INT D2/ -> LO-2INT   }T
1154
1155 T{       0.       1. D< -> <TRUE>  }T
1156 T{       0.       0. D< -> <FALSE> }T
1157 T{       1.       0. D< -> <FALSE> }T
1158 T{      -1.       1. D< -> <TRUE>  }T
1159 T{      -1.       0. D< -> <TRUE>  }T
1160 T{      -2.      -1. D< -> <TRUE>  }T
1161 T{      -1.      -2. D< -> <FALSE> }T
1162 T{      -1. MAX-2INT D< -> <TRUE>  }T
1163 T{ MIN-2INT MAX-2INT D< -> <TRUE>  }T
1164 T{ MAX-2INT      -1. D< -> <FALSE> }T
1165 T{ MAX-2INT MIN-2INT D< -> <FALSE> }T
1166 T{ MAX-2INT 2DUP -1. D+ D< -> <FALSE> }T
1167 T{ MIN-2INT 2DUP  1. D+ D< -> <TRUE>  }T
1168
1169 T{      -1.      -1. D= -> <TRUE>  }T
1170 T{      -1.       0. D= -> <FALSE> }T
1171 T{      -1.       1. D= -> <FALSE> }T
1172 T{       0.      -1. D= -> <FALSE> }T
1173 T{       0.       0. D= -> <TRUE>  }T
1174 T{       0.       1. D= -> <FALSE> }T
1175 T{       1.      -1. D= -> <FALSE> }T
1176 T{       1.       0. D= -> <FALSE> }T
1177 T{       1.       1. D= -> <TRUE>  }T
1178 T{   0   -1    0  -1 D= -> <TRUE>  }T
1179 T{   0   -1    0   0 D= -> <FALSE> }T
1180 T{   0   -1    0   1 D= -> <FALSE> }T
1181 T{   0    0    0  -1 D= -> <FALSE> }T
1182 T{   0    0    0   0 D= -> <TRUE>  }T
1183 T{   0    0    0   1 D= -> <FALSE> }T
1184 T{   0    1    0  -1 D= -> <FALSE> }T
1185 T{   0    1    0   0 D= -> <FALSE> }T
1186 T{   0    1    0   1 D= -> <TRUE>  }T
1187
1188 T{ MAX-2INT MIN-2INT D= -> <FALSE> }T
1189 T{ MAX-2INT       0. D= -> <FALSE> }T
1190 T{ MAX-2INT MAX-2INT D= -> <TRUE>  }T
1191 T{ MAX-2INT HI-2INT  D= -> <FALSE> }T
1192 T{ MAX-2INT MIN-2INT D= -> <FALSE> }T
1193 T{ MIN-2INT MIN-2INT D= -> <TRUE>  }T
1194 T{ MIN-2INT LO-2INT  D= -> <FALSE> }T
1195 T{ MIN-2INT MAX-2INT D= -> <FALSE> }T
1196
1197 T{    1234  0 D>S ->  1234   }T
1198 T{   -1234 -1 D>S -> -1234   }T
1199 T{ MAX-INT  0 D>S -> MAX-INT }T
1200 T{ MIN-INT -1 D>S -> MIN-INT }T
1201
1202
1203 T{       1. DABS -> 1.       }T
1204 T{      -1. DABS -> 1.       }T
1205 T{ MAX-2INT DABS -> MAX-2INT }T
1206 T{ MIN-2INT 1. D+ DABS -> MAX-2INT }T
1207
1208 T{       1.       2. DMAX ->  2.      }T
1209 T{       1.       0. DMAX ->  1.      }T
1210 T{       1.      -1. DMAX ->  1.      }T
1211 T{       1.       1. DMAX ->  1.      }T
1212 T{       0.       1. DMAX ->  1.      }T
1213 T{       0.      -1. DMAX ->  0.      }T
1214 T{      -1.       1. DMAX ->  1.      }T
1215 T{      -1.      -2. DMAX -> -1.      }T
1216 T{ MAX-2INT  HI-2INT DMAX -> MAX-2INT }T
1217 T{ MAX-2INT MIN-2INT DMAX -> MAX-2INT }T
1218 T{ MIN-2INT MAX-2INT DMAX -> MAX-2INT }T
1219 T{ MIN-2INT  LO-2INT DMAX -> LO-2INT  }T
1220
1221 T{ MAX-2INT       1. DMAX -> MAX-2INT }T
1222 T{ MAX-2INT      -1. DMAX -> MAX-2INT }T
1223 T{ MIN-2INT       1. DMAX ->  1.      }T
1224 T{ MIN-2INT      -1. DMAX -> -1.      }T
1225
1226 T{       1.       2. DMIN ->  1.      }T
1227 T{       1.       0. DMIN ->  0.      }T
1228 T{       1.      -1. DMIN -> -1.      }T
1229 T{       1.       1. DMIN ->  1.      }T
1230 T{       0.       1. DMIN ->  0.      }T
1231 T{       0.      -1. DMIN -> -1.      }T
1232 T{      -1.       1. DMIN -> -1.      }T
1233 T{      -1.      -2. DMIN -> -2.      }T
1234 T{ MAX-2INT  HI-2INT DMIN -> HI-2INT  }T
1235 T{ MAX-2INT MIN-2INT DMIN -> MIN-2INT }T
1236 T{ MIN-2INT MAX-2INT DMIN -> MIN-2INT }T
1237 T{ MIN-2INT  LO-2INT DMIN -> MIN-2INT }T
1238
1239 T{ MAX-2INT       1. DMIN ->  1.      }T
1240 T{ MAX-2INT      -1. DMIN -> -1.      }T
1241 T{ MIN-2INT       1. DMIN -> MIN-2INT }T
1242 T{ MIN-2INT      -1. DMIN -> MIN-2INT }T
1243
1244 T{   0. DNEGATE ->  0. }T
1245 T{   1. DNEGATE -> -1. }T
1246 T{  -1. DNEGATE ->  1. }T
1247 T{ max-2int DNEGATE -> min-2int SWAP 1+ SWAP }T
1248 T{ min-2int SWAP 1+ SWAP DNEGATE -> max-2int }T
1249
1250 T{       1.       2. 3. 2ROT ->       2. 3.       1. }T
1251 T{ MAX-2INT MIN-2INT 1. 2ROT -> MIN-2INT 1. MAX-2INT }T
1252
1253 T{       1.       1. DU< -> <FALSE> }T
1254 T{       1.      -1. DU< -> <TRUE>  }T
1255 T{      -1.       1. DU< -> <FALSE> }T
1256 T{      -1.      -2. DU< -> <FALSE> }T
1257 T{ MAX-2INT  HI-2INT DU< -> <FALSE> }T
1258 T{  HI-2INT MAX-2INT DU< -> <TRUE>  }T
1259 T{ MAX-2INT MIN-2INT DU< -> <TRUE>  }T
1260 T{ MIN-2INT MAX-2INT DU< -> <FALSE> }T
1261 T{ MIN-2INT  LO-2INT DU< -> <TRUE>  }T
1262
1263 T{ HI-2INT   1 M+ -> HI-2INT   1. D+ }T
1264 T{ MAX-2INT -1 M+ -> MAX-2INT -1. D+ }T
1265 T{ MIN-2INT  1 M+ -> MIN-2INT  1. D+ }T
1266 T{ LO-2INT  -1 M+ -> LO-2INT  -1. D+ }T
1267
1268 -3 2 / . ; if floored you see -2 -->
1269 : ?floored [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ;
1270
1271 T{       5.       7             11 M*/ ->  3. }T
1272 T{       5.      -7             11 M*/ -> -3. ?floored }T
1273 T{      -5.       7             11 M*/ -> -3. ?floored }T
1274 T{      -5.      -7             11 M*/ ->  3. }T
1275
1276 T{ MAX-2INT       8             16 M*/ -> HI-2INT }T
1277 T{ MIN-2INT       8             16 M*/ -> LO-2INT }T
1278 T{ MAX-2INT      -8             16 M*/ -> HI-2INT DNEGATE ?floored }T
1279 T{ MIN-2INT      -8             16 M*/ -> LO-2INT DNEGATE }T
1280
1281 T{ MAX-2INT MAX-INT        MAX-INT M*/ -> MAX-2INT }T
1282 T{ MAX-2INT MAX-INT 2/     MAX-INT M*/ -> MAX-INT 1- HI-2INT NIP }T
1283 T{ MIN-2INT LO-2INT NIP DUP NEGATE M*/ -> MIN-2INT }T
1284 T{ MIN-2INT LO-2INT NIP 1- MAX-INT M*/ -> MIN-INT 3 + HI-2INT NIP 2 + }T
1285 T{ MAX-2INT LO-2INT NIP DUP NEGATE M*/ -> MAX-2INT DNEGATE }T
1286 T{ MIN-2INT MAX-INT            DUP M*/ -> MIN-2INT }T
1287
1288 MAX-2INT 71 73 M*/ 2CONSTANT dbl1
1289 MIN-2INT 73 79 M*/ 2CONSTANT dbl2
1290 : d>ascii
1291    DUP >R <# DABS #S R> SIGN #>
1292    HERE SWAP 2DUP 2>R CHARS DUP ALLOT MOVE 2R>
1293 ;
1294
1295 dbl1 d>ascii 2CONSTANT "dbl1"
1296 dbl2 d>ascii 2CONSTANT "dbl2"
1297
1298 : DoubleOutput
1299    CR ." You should see lines duplicated:" CR
1300    5 SPACES "dbl1" TYPE CR
1301    5 SPACES dbl1 D. CR
1302    8 SPACES "dbl1" DUP >R TYPE CR
1303    5 SPACES dbl1 R> 3 + D.R CR
1304    5 SPACES "dbl2" TYPE CR
1305    5 SPACES dbl2 D. CR
1306    10 SPACES "dbl2" DUP >R TYPE CR
1307    5 SPACES dbl2 R> 5 + D.R CR
1308 ;
1309
1310 T{ DoubleOutput -> }T