home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / love / rpn_asm.txt < prev    next >
Text File  |  1993-04-11  |  17KB  |  452 lines
  1. (( L.O.V.E. FORTH - RPN Assembler
  2.    - completed with all op-codes by Homer Seywerd
  3.       changes/additions also placed in the public domain
  4.    - support for   CODE   and   ;CODE
  5.    - virtual vocabulary
  6.  
  7. *** 
  8. An example provided to illustrate the programming of a traditional 
  9. RPN assembler in Forth. Serious assembly language programmers should use
  10. the LOVE Forth standard assembler interface instead. The standard assembler
  11. interface allows the use of Borland's , Microsoft's or Isaacson's assemblers
  12. to produce object code for LOVE Forth.
  13. ***
  14.  
  15. ))
  16.  
  17. ( ASSEMBLER SOURCE )
  18.  
  19. : 8*   8 *   ;  ( N -- N)
  20. : 6+ 6 + ;  ( N -- N)
  21. : OFF  ( addr-- )   0 SWAP !  ;
  22. : ON ( addr-- )   1 SWAP !  ;
  23. : 3C, C, C, C, ;
  24.  
  25.  
  26.   VARIABLE <#>   
  27.   VARIABLE <TD>
  28.   VARIABLE <TS>
  29.   VARIABLE <RD>
  30.   VARIABLE <RS>
  31.   VARIABLE <W>
  32.   VARIABLE <WD>
  33.   VARIABLE <OD>
  34.   VARIABLE <OS>
  35.   VARIABLE <D>
  36.   VARIABLE INTER
  37.   VARIABLE <SP>
  38.  
  39. : A, CS:C, ;
  40. : !<SP>         SP@ <SP> ! ;
  41. : ?<SP>         <SP> @ SP@ - 2- 2/ ;
  42. : ?ERR1 ABORT" ADDRESS OUT OF RANGE" ;
  43. : ?ERR2 ABORT" IMMEDIATE DATA VALUE NOT ALLOWED" ;
  44. : ?ERR3 ABORT" ILLEGAL OPERAND" ;
  45. : ?ERR4 ABORT" DESTINATION ADDRESS MISSING" ;
  46. : ERR5 1 ABORT" REGISTER MISMATCH" ;
  47. : ERR3 1 ?ERR3 ;
  48.  
  49. 0 CONSTANT      DIRECT
  50. 1 CONSTANT      IMMED
  51. 2 CONSTANT      REG8
  52. 3 CONSTANT      REG16
  53. 4 CONSTANT      INDEXED
  54. 5 CONSTANT      SEGREG
  55.  
  56. HEX
  57.  
  58. : DREG  CREATE 3C,
  59.         DOES> DUP C@ DUP FF =
  60.         IF DROP ELSE DUP <W> ! <WD> !
  61.         THEN 1+ DUP C@ <TD> ! 1+ C@ <RD> !
  62.         <#> @ ?ERR2 <TD> @ 4 =
  63.         IF ?<SP> 0> IF <OD> ! THEN THEN ;
  64.  
  65. : SREG  CREATE 3C,
  66.         DOES> DUP C@ DUP FF =
  67.         IF DROP ELSE <W> !
  68.         THEN 1+ DUP C@ <TS> ! 1+ C@ <RS> !
  69.         <TS> @ 4 =
  70.         IF ?<SP> 0> IF <OS> ! THEN THEN ;
  71.  
  72. 0 2 0 SREG AL   0 2 0 DREG AL,  0 3 1 SREG AX   0 3 1 DREG AX,
  73. 1 2 0 SREG CL   1 2 0 DREG CL,  1 3 1 SREG CX   1 3 1 DREG CX,
  74. 2 2 0 SREG DL   2 2 0 DREG DL,  2 3 1 SREG DX   2 3 1 DREG DX,
  75. 3 2 0 SREG BL   3 2 0 DREG BL,  3 3 1 SREG BX   3 3 1 DREG BX,
  76. 4 2 0 SREG AH   4 2 0 DREG AH,  4 3 1 SREG SP   4 3 1 DREG SP,
  77. 5 2 0 SREG CH   5 2 0 DREG CH,  5 3 1 SREG BP   5 3 1 DREG BP,
  78. 6 2 0 SREG DH   6 2 0 DREG DH,  6 3 1 SREG SI   6 3 1 DREG SI,
  79. 7 2 0 SREG BH   7 2 0 DREG BH,  7 3 1 SREG DI   7 3 1 DREG DI,
  80.  
  81. 0 5 -1 SREG ES   0 5 -1 DREG ES,
  82. 1 5 -1 SREG CS   1 5 -1 DREG CS,
  83. 2 5 -1 SREG SS   2 5 -1 DREG SS,
  84. 3 5 -1 SREG DS   3 5 -1 DREG DS,
  85.  
  86. 0 4 -1 SREG [BX+SI]             0 4 -1 DREG [BX+SI],
  87. 0 4 -1 SREG [SI+BX]             0 4 -1 DREG [SI+BX],
  88. 1 4 -1 SREG [BX+DI]             1 4 -1 DREG [BX+DI],
  89. 1 4 -1 SREG [DI+BX]             1 4 -1 DREG [DI+BX],
  90. 2 4 -1 SREG [BP+SI]             2 4 -1 DREG [BP+SI],
  91. 2 4 -1 SREG [SI+BP]             2 4 -1 DREG [SI+BP],
  92. 3 4 -1 SREG [BP+DI]             3 4 -1 DREG [BP+DI],
  93. 3 4 -1 SREG [DI+BP]             3 4 -1 DREG [DI+BP],
  94. 4 4 -1 SREG [SI]                4 4 -1 DREG [SI],
  95. 5 4 -1 SREG [DI]                5 4 -1 DREG [DI],
  96. 6 4 -1 SREG [BP]                6 4 -1 DREG [BP],
  97. 7 4 -1 SREG [BX]                7 4 -1 DREG [BX],
  98.  
  99. : ?W      <W> @ ;               : ?TD     <TD> @ ;
  100. : ?TS     <TS> @ ;              : ?RD     <RD> @ ;
  101. : ?RS     <RS> @ ;              : ?OD     <OD> @ ;
  102. : ?OS     <OS> @ ;              : +D      <D> @ 2* + ;
  103. : +W      ?W + ;                : +RD     ?RD + ;
  104. : +RS     ?RS + ;               : MOD1    3F AND 040 OR ;
  105. : MOD2    3F AND 080 OR ;       : MOD3    3F AND 0C0 OR ;
  106. : RESET   <#>  OFF  <W> OFF <OS> OFF <RD> OFF <TD> OFF
  107.           <TS> OFF <OD> OFF <D>  OFF <WD> OFF <RS> OFF !<SP>
  108.           INTER OFF ;
  109. : DSET    ?TS INDEXED = IF <D> ON THEN ;
  110. : Dt      <D> ON ;             : BIG? ABS -80 AND 0= NOT ;
  111. : +S ( instr,word--instr)
  112.   FF80 AND ?DUP IF FF80 = ELSE -1 THEN ?W 0= NOT AND
  113.   IF 2+ <W> OFF THEN ;
  114.  
  115. : ASMHERE       DPCODE @ ; ( for revectoring)
  116. : OFFSET8,      ASMHERE 1+ - DUP ABS 07F > ?ERR1 A, ;
  117. : OFFSET16,     ASMHERE 2+ - CS:, ;
  118. : DISP,         <D> @ IF ?OS ELSE ?OD THEN DUP
  119.                 IF DUP ABS 07F >
  120.                   IF SWAP MOD2 A, CS:,
  121.                   ELSE SWAP MOD1 A, A, THEN
  122.                 ELSE DROP DUP 7 AND 6 =
  123.                   IF MOD1 A, 0 A, ELSE A, THEN
  124.                 THEN ;
  125. : 1MI           CREATE C,      DOES> C@ A, RESET ;
  126. : 2MI           CREATE C,      DOES> C@ A, OFFSET8, RESET ;
  127. : 3MI           CREATE C,      DOES> C@ +W A, RESET ;
  128.  
  129. : 4MI    CREATE 3C, C,   ( PUSH POP)
  130.          DOES> ?TS CASE
  131.            DIRECT OF  2+ DUP C@ A, 1+ C@ 6 + A, CS:, ENDOF
  132.            REG16  OF  1+ C@ +RS A, ENDOF
  133.            INDEXED OF 2+ DUP C@ A, DSET 1+ C@ +RS DISP, ENDOF
  134.            SEGREG OF  C@ ?RS 8* + A, ENDOF
  135.          ERR3 ENDCASE RESET ;
  136.  
  137. : 6MI   CREATE C, C,
  138.         DOES> DUP C@ 2 AND IF ?TD ?TS ELSE ?TS ?TD THEN
  139.         REG16 = IF <W> ON ELSE <W> OFF THEN
  140.         REG16 =
  141.         IF ( dx) 1+ C@ +W A,
  142.         ELSE ( dir) C@ +W A, A,
  143.         THEN RESET ;
  144.  
  145. : 5MI CREATE 3C,       ( JMP CALL)
  146.   DOES>  ?TS CASE
  147.    DIRECT OF INTER @
  148.            IF 2+ C@ A, CS:, CS:,  ( intersegment)
  149.            ELSE C@                              ( intraseg)
  150.              SWAP ASMHERE - 2- SWAP ( disp,op--)
  151.              DDUP 1 AND SWAP BIG? NOT AND
  152.              IF 2+ A, A, ( short jmp) ELSE A, 1- CS:, ( jm/cl)
  153.              THEN  THEN ENDOF
  154.    REG16   OF INTER @ ?ERR3  FF A, 1+ C@ +RS MOD3 A,  ENDOF
  155.    INDEXED OF DSET FF A, 1+ C@ +RS INTER @
  156.               IF 8 + THEN  DISP,  ENDOF
  157.     ERR3 ENDCASE RESET ;
  158.  
  159.  
  160. : 7MI   CREATE 3C, C, C, DOES> ?TS IMMED =
  161.         IF 1+ DUP 2+ C@ 0= ?ERR2
  162.          ?TD REG8 = ?TD REG16 = OR
  163.          IF ?RD  IF DUP 1+ C@ +W OVER 3 + C@
  164.                    IF 2 PICK +S THEN A,
  165.                    C@ MOD3 +RD A,
  166.                  ELSE   2+ C@ +W A, ( AL/AX) THEN
  167.          ELSE DUP 1+ C@ +W OVER 3 + C@
  168.             IF 2 PICK +S THEN A,   ?TD CASE
  169.           DIRECT  OF      C@ 6+ A, SWAP CS:, ENDOF
  170.           INDEXED OF DSET C@ +RD DISP,     ENDOF ERR3 ENDCASE
  171.          THEN ?W IF CS:, ELSE A, THEN
  172.         ELSE DSET
  173.           ?TS DIRECT = IF Dt THEN
  174.           C@ +D +W A, ?TD CASE
  175.      REG8 OF ?TS CASE            ( REG8 is dest)
  176.       DIRECT  OF  ?RD 8* 6+ A, CS:, ENDOF
  177.       REG8    OF  ?RS 8* +RD MOD3 A, ENDOF
  178.       INDEXED OF  ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF
  179.      REG16 OF ?TS CASE
  180.       DIRECT  OF  ?RD 8* 6+ A, CS:, ENDOF
  181.       REG16   OF  ?RS 8* +RD MOD3 A, ENDOF
  182.       INDEXED OF  ?RD 8* +RS DISP, ENDOF ERR3 ENDCASE ENDOF
  183.      INDEXED OF ?TS CASE
  184.       REG8    OF  ?RS 8* +RD DISP, ENDOF
  185.       REG16   OF  ?RS 8* +RD DISP, ENDOF ERR3 ENDCASE ENDOF
  186.      DIRECT  OF ?TS CASE
  187.       REG8    OF  ?RS 8* 6+ A, CS:, ENDOF
  188.       REG16   OF  ?RS 8* 6+ A, CS:, ENDOF  ERR3 ENDCASE
  189.      ENDOF   ERR3 ENDCASE THEN RESET ;
  190.  
  191.  
  192.  
  193. : 8MI   CREATE C, C,
  194.         DOES> DUP 1+ C@ +W A, ?TS CASE
  195.           DIRECT  OF  C@ 6+ A, CS:,    ENDOF
  196.           REG8    OF  C@ +RS MOD3 A, ENDOF
  197.           REG16   OF  C@ +RS MOD3 A, ENDOF
  198.           INDEXED OF  DSET C@ +RS DISP, ENDOF
  199.           ERR3 ENDCASE RESET ;
  200. : 9MI   CREATE C, C,
  201.         DOES> DUP 1+ C@ <WD> @ + ?TS 1 >
  202.         IF 2+ ( CL reg) ELSE ROT DROP ( 1) THEN A, ?TD CASE
  203.         DIRECT    OF  C@ 6+      A, CS:, ENDOF
  204.         REG8      OF  C@ MOD3 +RD A, ENDOF
  205.         REG16     OF  C@ MOD3 +RD A, ENDOF
  206.         INDEXED   OF  DSET C@ +RD DISP, ENDOF
  207.         ERR3 ENDCASE RESET ;
  208.  
  209.  
  210. : 10MI  CREATE C, C,                                ( AAD AAM )
  211.         DOES> DUP C@ SWAP 1+ C@ A, A, RESET ;
  212. : 11MI  CREATE C, C,                                ( INC DEC )
  213.         DOES> ?TS CASE
  214.           DIRECT  OF  FE  +W A, 1+ C@ 6+ A, CS:, ENDOF
  215.           REG8    OF  0FE A, 1+ C@ MOD3 +RS A, ENDOF
  216.           REG16   OF  C@ +RS A, ENDOF
  217.           INDEXED OF  DSET 0FE +W A, 1+ C@ +RS DISP, ENDOF
  218.           ERR3 ENDCASE RESET ;
  219. : MOV DSET ?TD CASE
  220.         DIRECT OF ?TS CASE
  221.           REG8   OF ?RS IF 088 A, ?RS 8* 6+ A, CS:,
  222.                         ELSE 0A2 +W A, CS:, THEN ENDOF
  223.           REG16  OF ?RS IF 089 A, ?RS 8* 6+ A, CS:,
  224.        ELSE 0A2 +W A, CS:, THEN ENDOF
  225.           SEGREG  OF  08C A, ?RS 8* 6+ A, CS:, ENDOF
  226.           IMMED   OF  C6 +W A, 6 A, SWAP CS:, ?W
  227.                      IF CS:, ELSE A, THEN ENDOF
  228.           ERR3 ENDCASE ENDOF
  229.         REG8 OF ?TS CASE
  230.           DIRECT  OF  ?RD IF 08A A, ?RD 8* 6+ A, CS:,
  231.                         ELSE 0A0 +W A, CS:, THEN ENDOF
  232.           IMMED   OF  0B0 +RD A, A, ENDOF
  233.           REG8    OF  Dt 88 +D A, ?RD 8* +RS MOD3 A, ENDOF
  234.           REG16   OF  ERR5 ENDOF
  235.           INDEXED OF  88 +D +W A, ?RD 8* +RS DISP, ENDOF
  236.           ERR3 ENDCASE ENDOF
  237.         REG16 OF ?TS CASE
  238.           DIRECT  OF  ?RD IF 08B A, ?RD 8* 6+ A, CS:,
  239.                           ELSE 0A0 +W A, CS:, THEN ENDOF
  240.           IMMED   OF  0B8 +RD A, CS:, ENDOF
  241.           REG16   OF  Dt 88 +W +D A, ?RD 8* +RS MOD3 A, ENDOF
  242.           INDEXED OF  088 +D +W A, ?RD 8* +RS DISP, ENDOF
  243.           SEGREG  OF  08C A, ?RS 8* +RD MOD3 A, ENDOF
  244.           ERR3 ENDCASE ENDOF
  245.         INDEXED   OF  ?TS CASE
  246.           IMMED   OF  0C6 +W A, ?RD DISP, ?W IF CS:,
  247.                           ELSE A, THEN ENDOF
  248.           REG8    OF  088 +D +W A, ?RS 8* +RD DISP, ENDOF
  249.           REG16   OF  088 +D +W A, ?RS 8* +RD DISP, ENDOF
  250.           SEGREG  OF  08C A, ?RS 8* +RD DISP, ENDOF
  251.           ERR3 ENDCASE ENDOF
  252.         SEGREG OF ?TS CASE
  253.           DIRECT   OF  08E A, ?RD 8* 6+ A, CS:, ENDOF
  254.           REG16    OF  08E A, ?RD 8* +RS MOD3 A, ENDOF
  255.           INDEXED  OF  08E A, ?RD 8* +RS DISP, ENDOF
  256.           ERR3 ENDCASE ENDOF
  257.           ERR3 ENDCASE RESET ;
  258.  
  259.  
  260. : XCHG  DSET ?TD CASE
  261.         DIRECT OF ?TS REG16 =
  262.                   IF 90 +RS A, ELSE ERR3 THEN ENDOF
  263.         REG8 OF 86 +W A, ?TS CASE
  264.           DIRECT  OF  ?RD 8* 6+ A, CS:,    ENDOF
  265.           REG8    OF  ?RD 8* +RS MOD3 A, ENDOF
  266.           INDEXED OF  ?RD 8* +RS DISP, ENDOF
  267.           ERR3 ENDCASE ENDOF
  268.         REG16 OF 86 +W A, ?TS CASE
  269.           DIRECT  OF  ?RD 8* 6+ A, CS:,    ENDOF
  270.           REG16   OF  ?RD 8* +RS MOD3 A, ENDOF
  271.           INDEXED OF  ?RD 8* +RS DISP, ENDOF
  272.           ERR3 ENDCASE ENDOF
  273.           ERR3 ENDCASE RESET ;
  274.  
  275.  
  276.  
  277. : TEST  ?TS IMMED =
  278.    IF ?TD DUP REG8 = SWAP REG16 = OR
  279.     IF ?RD
  280.      IF F6 +W A, ?RD MOD3 A, ELSE A8 +W A, THEN
  281.     ELSE F6 +W A, ?TD CASE
  282.           DIRECT  OF  6 A, SWAP CS:, ENDOF
  283.           INDEXED OF  ?RD DISP,   ENDOF ERR3 ENDCASE
  284.     THEN ?W IF CS:, ELSE A, THEN
  285.    ELSE   ?TD REG8 < ?TD REG16 > OR ?ERR3 84 +W A,
  286.           DSET  ?TS CASE
  287.           DIRECT  OF ?RD 8* 6+ A, CS:,    ENDOF
  288.           REG8    OF ?RD 8* +RS MOD3 A, ENDOF
  289.           REG16   OF ?RD 8* +RS MOD3 A, ENDOF
  290.           INDEXED OF ?RD 8* +RS DISP,   ENDOF  ERR3 ENDCASE
  291.    THEN RESET ;
  292.  
  293.  
  294. : INT  CD A, A, RESET ;
  295. : 16MI CREATE C,                                        ( RET )
  296. DOES> C@ DUP INTER @
  297.   IF 8 + THEN A, 1 AND 0=
  298.   IF CS:, THEN RESET ;
  299.  
  300.  
  301. 37       1MI   AAA     1 3C 80 38 38 7MI CMP        (    INT )
  302. D5 0A    10MI  AAD     A6       3MI  CMPS     CE    1MI  INTO
  303. D4 0A    10MI  AAM     99       1MI  CWD      CF    1MI  IRET
  304. 3F       1MI   AAS     27       1MI  DAA      77    2MI  JA
  305. 1 14 80 10 10 7MI ADC  2F       1MI  DAS      73    2MI  JAE
  306. 1 04 80 00 00 7MI ADD  08 48    11MI DEC      72    2MI  JB
  307. 0 24 80 20 20 7MI AND  F6 30    8MI  DIV      76    2MI  JBE
  308. 9A 10 E8 5MI   CALL                ( ESC )    E3    2MI  JCXZ
  309. 98       1MI   CBW     F4       1MI  HLT      74    2MI  JE
  310. F8       1MI   CLC     F6 38    8MI  IDIV     7F    2MI  JG
  311. FC       1MI   CLD     F6 28    8MI  IMUL     7D    2MI  JGE
  312. FA       1MI   CLI     EC E4    6MI  IN       7C    2MI  JL
  313. F5       1MI   CMC     00 40    11MI INC      7E    2MI  JLE
  314. EA 20 E9 5MI JMP    75       2MI  JNZ    ( E2       2MI  LOOP )
  315. 76    2MI  JNA      70       2MI  JO       E1       2MI  LOOPE
  316. 72    2MI  JNAE     7A       2MI  JP       E0       2MI  LOOPNE
  317. 73    2MI  JNB      7A       2MI  JPE      E0       2MI  LOOPNZ
  318. 77    2MI  JNBE     7B       2MI  JPO      E1       2MI  LOOPZ
  319. 75    2MI  JNE      78       2MI  JS                   ( MOV )
  320. 7E    2MI  JNG      74       2MI  JZ       A4       3MI  MOVS
  321. 7C    2MI  JNGE     9F       1MI  LAHF     F6 20    8MI  MUL
  322. 7D    2MI  JNL      0 0 0 0 C2 7MI LDS     F6 18    8MI  NEG
  323. 7F    2MI  JNLE     0 0 0 0 8A 7MI LEA     90       1MI  NOP
  324. 71    2MI  JNO      0 0 0 0 C1 7MI LES     F6 10    8MI  NOT
  325. 7B    2MI  JNP      F0       1MI  LOCK     0 0C 80 08 08 7MI OR
  326. 79    2MI  JNS      AC       3MI  LODS     EE E6    6MI  OUT
  327. 0 8F 58 07 4MI POP D0 08    9MI  ROR     1 2C 80 28 28 7MI SUB
  328. 9D    1MI  POPF     9E       1MI  SAHF             (    TEST )
  329. 30 FF 50 06 4MI PUSH D0 38    9MI  SAR     9B       1MI  WAIT
  330. 9C    1MI  PUSHF    1 1C 80 18 18 7MI SBB          (    XCHG )
  331. D0 10 9MI  RCL      AE       3MI  SCAS    D7       1MI  XLAT
  332. D0 18 9MI  RCR                 (  SEG )   0 34 80 30 30 7MI XOR
  333. F3    1MI  REP      D0 20    9MI  SAL     C2      16MI  +RET
  334. F3    1MI  REPE     D0 20    9MI  SHL
  335. F2    1MI  REPNE    D0 28    9MI  SHR
  336. F2    1MI  REPNZ    F9       1MI  STC
  337. F3    1MI  REPZ     FD       1MI  STD
  338. C3   16MI  RET      FB       1MI  STI
  339. D0 00 9MI  ROL      AA       3MI  STOS
  340.  
  341. : BYTE          <W> OFF <WD> OFF ;
  342. : WORD          <W> ON <WD> ON ;
  343. : #             <#> ON <TS> ON ;
  344. : ,             DEPTH 1 < ?ERR4 <TD> OFF ;
  345. : ES: 26 A, ;
  346. : CS: 2E A, ;
  347. : SS: 36 A, ;
  348. : DS: 3E A, ;
  349. : FAR INTER ON ;
  350.  
  351. ( AGAIN and REPEAT are two byte relative jumps           )
  352. ( All of the other logical tests are one byte relative jumps )
  353. ( e.g., max decimal one byte jump is +/- 127 bytes           )
  354. : ERR1?  - DUP ABS 7F > ?ERR1 ;
  355. ( VERY IMPORTANT NOTE:  MUST have count in CX REG !!!        )
  356. ( CX max can be 1 THRU 65535 <$FFFF>                         )
  357.  
  358. : DO DPCODE @ RESET ;
  359.  
  360. ( Will set CX=1  to exit upon reaching LOOP                  )
  361. ( E.G.,  A, B CMP IF= LEAVE THEN                             )
  362. : LEAVE B9 A, 1 CS:, RESET ;
  363.  
  364. ( Will first decrement CX and then JMP to DO if CX is not 0  )
  365. : LOOP E2 A, DPCODE @  1+ ERR1?  A, RESET ;
  366.  
  367. ( The following are used after:  A, B CMP <or CMPS>          )
  368. ( A or B  can be any MEM, REG, or # NO.;  byte or word       )
  369. : IF=  75 A, DPCODE @ 0 A, RESET ; ( IF A = B )
  370.  
  371. : IF< 7D A, DPCODE @ 0 A, RESET ; ( IF A < B )
  372.  
  373. : IFU< 73 A, DPCODE @ 0 A, RESET ; ( IF A U< B )
  374. : IF0< 79 A, DPCODE @ 0 A, RESET ; ( IF SF = 1 )
  375. : IF-OVERFLOW  71 A, DPCODE @ 0 A, RESET ; ( If overflow flag 1)
  376.  
  377. : ELSE EB A, DUP DPCODE @ SWAP ERR1? SWAP CS:C! DPCODE @ 0 A,
  378.     RESET ;
  379. : THEN DUP 1+ DPCODE @ SWAP ERR1? SWAP CS:C! RESET ;
  380.  
  381. : BEGIN DPCODE @ RESET ;
  382.  
  383. : AGAIN E9 A, DPCODE @ 2+ - CS:, RESET ;
  384.  
  385. ( Use after: A, B CMP <or CMPS>  e.g., repeat UNTIL A=B      )
  386. : UNTIL=  75 A, DPCODE @ 1+ ERR1? A, RESET ;
  387. : UNTIL0<  79 A, DPCODE @ 1+ ERR1? A, RESET ;
  388. : UNTIL<  7D A, DPCODE @ 1+ ERR1? A, RESET ;
  389.  
  390. : UNTILU< 73 A, DPCODE @ 1+ ERR1? A, RESET ;
  391.  
  392. ( next word can be followed by "not"                          )
  393. : UNTIL-OVERFLOW  71 A, DPCODE @ 1+ ERR1? A, RESET ;
  394. ( ovrflo = 1 )
  395.  
  396. : WHILE=  IF= ; ( example: BEGIN...A, B CMP WHILE=...REPEAT   )
  397.  
  398. : WHILE<  IF< ;
  399. : WHILE0< IF0< ;
  400. : WHILEU< IFU< ;
  401.  
  402. : WHILE-OVERFLOW  IF-OVERFLOW ; ( can be followed by "not"    )
  403.  
  404. ( Use "non" to invert logical operators, e.g., IF= non        )
  405. ( or UNTIL< non  means repeat until  A is not less than B     )
  406. ( Lower case is used to avoid conflict with opcode word NOT   )
  407.  
  408. : non  DPCODE @ 2- DUP CS:C@ 1- SWAP CS:C! ;
  409.  
  410. : REPEAT  SWAP AGAIN THEN  ;
  411.  
  412. ( Assembler TEST Logical Operators  )
  413. ( Use after A, B TEST since logic is reversed <TEST = AND>   )
  414. : IFTEST  IF= non ;
  415.  
  416. : UNTILTEST  UNTIL= non ;
  417.  
  418. : WHILETEST  WHILE= non ;
  419.  
  420. : IFNOTEST  IF= ;
  421.  
  422. : UNTILNOTEST  UNTIL= ;
  423.  
  424. : WHILENOTEST  WHILE= ;
  425.  
  426. ( Do not compile two not's together. Do not compile IFTEST non)
  427. ( as two separate words.)
  428.  
  429. ( WORD LODS BX, AX MOV WORD [BX] JMP )
  430. : NEXT-JMP  AD A, 8B A, D8 A, FF A, 27 A, RESET ;
  431.  
  432. : APUSH-JMP  50 A, NEXT-JMP ;
  433.  
  434. DECIMAL
  435.  
  436. : C;  RESET ?CSP SMUDGE  VDROP    ;
  437. : END-CODE C; ;
  438.  
  439. : LABEL  ( define assembler label  ( -- )
  440.   ( this takes advantage of L.O.V.E Forth characteristic that:
  441.     CONSTANT does not add anything to the code segment  )
  442.   SMUDGE ( previous code word )
  443.   CS:HERE CONSTANT
  444.   SMUDGE ( for C; to unsmudge) ;
  445.  
  446. : ;CODE   ?CSP
  447.    COMPILE <;CODE> DPCODE @ TS:, [COMPILE] [
  448.    ALSO ASSEMBLER  RESET  ; IMMEDIATE
  449.  
  450. : CODE
  451.   !CSP CREATE: DPCODE @ TS:HERE TS:BODY> TS:!
  452.   ALSO ASSEMBLER RESET  SMUDGE ;