home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_5.ZIP / TCOM96.ZIP / TCOM96 / COMPILER / ASM96.SE1 < prev    next >
Encoding:
Text File  |  1991-04-11  |  16.6 KB  |  626 lines
  1. \\ ASM96.SEQ  assembler for 8096 and 80196
  2.  
  3. Adapted by Mike Mayo from PASM.SEQ,
  4. a PREFIX & POSTFIX assembler by Robert L. Smith & Tom Zimmer
  5.  
  6. {
  7. \ anew assem96
  8.  
  9. warning off     \ lots of redefinitions, I DON'T want to know about!
  10.  
  11. only FORTH definitions
  12.  
  13. vocabulary ASM96
  14. ' ASM96 alias [ASM96] immediate
  15.  
  16. only FORTH also ASSEMBLER also ASM96 definitions also
  17.  
  18. \ some alias headers so we dont have to redefine these words in
  19. \ the new target assembler.
  20.  
  21. ' $             alias $
  22. ' $:            alias $:
  23. ' $:|           alias $:|
  24. ' $$:F          alias $$:F
  25. ' L$            alias L$
  26. ' L$:           alias L$:
  27. ' ll-global?    alias ll-global?
  28. ' ll-errs?      alias ll-errs?
  29. ' end-code      alias end-code  immediate
  30. ' end-code      alias c;        immediate
  31. ' here          alias here
  32. ' tc@           alias tc@
  33. ' tc!           alias tc!
  34. ' t!            alias t!
  35. ' ,             alias ,
  36. ' c,            alias c,
  37.  
  38.  
  39. ' a;            alias a;                \ normal a;
  40.  
  41. variable a(>in1)        \ delay register for column information
  42.  
  43. : a;!                                   \ modified a;!
  44.         a(>in1) @  a(>in) !
  45.         (>in) @  a(>in1) !       \ save the source column position
  46.         a;!     \ normal a;!
  47.         ;
  48.  
  49. : I, ( n -- )   \ a special c, that tells the indexer that this is
  50.                 \ first byte of an instruction
  51.         on>  firstcodebyte
  52.         c,      \ This is c, from the ASSEMBLER vocabulary
  53.         off> firstcodebyte
  54.         ;
  55. : Oc, ( n -- )  \ a special c, that tells the indexer that this is code
  56.         on>  othercodebyte
  57.         c,      \ This is c, from the ASSEMBLER vocabulary
  58.         off> othercodebyte
  59.         ;
  60. : O, ( n -- )   \ a special ,  that tells the indexer that this is code
  61.         on>  othercodebyte
  62.         ,       \ This is , from the ASSEMBLER vocabulary
  63.         off> othercodebyte
  64.         ;
  65.  
  66. FORTH DEFINITIONS
  67.  
  68. : DOASSEM96     ( --- )
  69.                   ['] RUN-A; IS RUN
  70.                 0 ['] DROP A;!
  71.                 APRIOR 4 + 2@ APRIOR 2!
  72.                 ll-global? 0=
  73.                 if      llab-init               \ in case labels used
  74.                 then
  75.                 ALSO ASM96 ;
  76.  
  77. : setasm96      ['] DOASSEM96 IS SETASSEM  ;
  78. : setasm86      ['] doassem   is setassem  ;
  79.  
  80. setasm96
  81.  
  82. ONLY FORTH ALSO ASM96 DEFINITIONS ALSO
  83.  
  84.  
  85. \ Equates to Addressing Modes
  86.  
  87. 0 CONSTANT RDIRECT       1 CONSTANT IMMED     2 CONSTANT INDIRECT
  88. 3 CONSTANT INDEXED
  89.  
  90. VARIABLE AMODE \ 0 = register direct    1 = immediate
  91.                \ 2 = indirect           3 = indexed
  92. VARIABLE AUTOINC \ 0 = don't auto-increment   1 = do auto-increment
  93.  
  94. \ Assembler words for setting addressing mode
  95.  
  96. : []    INDIRECT AMODE ! ;
  97. : []+   INDIRECT AMODE !   1 AUTOINC !  ;
  98. : #     IMMED    AMODE ! ;
  99. : [I]   INDEXED  AMODE ! ;
  100.  
  101. VARIABLE SDMODE  \ for 3-operand instructions
  102. : <--   SDMODE ON  ;
  103.  
  104. \ Initialize all variables and flags
  105.  
  106. headers
  107.  
  108. : RESETF   0 AMODE !  0 AUTOINC !  0 SDMODE !  ;
  109.  
  110. headerless
  111.  
  112.  
  113. : breg ( breg -- ) \ assemble a byte register reference
  114.         DUP   256 <  IF    Oc,
  115.                      ELSE  " reg over 255" doerror
  116.                      THEN    ;
  117.  
  118. : wreg ( wreg -- ) \ assemble a word register reference
  119.         DUP 1 AND 0= IF    breg
  120.                      ELSE  DROP  " wreg not even" doerror
  121.                      THEN    ;
  122.  
  123. : Lreg ( Lreg -- ) \ assemble a long register reference
  124.         DUP 3 AND 0= IF    breg
  125.                      ELSE  DROP  " Lreg not /4" doerror
  126.                      THEN    ;
  127.  
  128.  
  129. \ Words to build the instructions:
  130.  
  131. : 1MIF          ( A1 --- )
  132.                 C@ I, RESETF ;           \ Single Byte Inst.
  133.  
  134. : 1MI     CREATE C, DOES> ['] 1MIF A;! A; ;
  135.  
  136.  
  137. : 2MIF          ( A1 -- )
  138.                 C@ I, breg  RESETF ;     \ e.g. CLRB breg
  139.  
  140. : 2MI     CREATE C, DOES> ['] 2MIF A;! A; ;
  141.  
  142.  
  143. : 3MIF          ( A1 -- )
  144.                 C@ I, wreg  RESETF ;     \ e.g. CLR wreg
  145.  
  146. : 3MI     CREATE C, DOES> ['] 3MIF A;! A; ;
  147.  
  148.  
  149. : 4MIF          ( A1 -- )
  150.                 C@ I, breg Lreg  RESETF ;     \ e.g. SHLL Lreg cnt/breg
  151.  
  152. : 4MI     CREATE C, DOES> ['] 4MIF A;! A; ;
  153.  
  154.  
  155. : 5MIF          ( A1 -- )
  156.                 C@ I, breg breg  RESETF ;     \ e.g. SHLL breg cnt/breg
  157.  
  158. : 5MI     CREATE C, DOES> ['] 5MIF A;! A; ;
  159.  
  160.  
  161. : 6MIF          ( A1 -- )
  162.                 C@ I, breg wreg  RESETF ;     \ e.g. SHLL wreg cnt/breg
  163.  
  164. : 6MI     CREATE C, DOES> ['] 6MIF A;! A; ;
  165.  
  166.  
  167. VARIABLE MIOP
  168. : 7MIF  ( waop A1 -- )   \ e.g. PUSH  POP
  169.         ( offset wreg A1 -- )  \ indexed
  170.     C@ MIOP !
  171.     AMODE @ CASE
  172.         0 OF    DUP 256 < IF    MIOP @ I,  wreg   \ register direct
  173.                           ELSE  MIOP @ 3 OR I,    \ long indexed pseudo-direct
  174.                                 1 Oc,  O,
  175.                           THEN
  176.           ENDOF
  177.         1 OF    MIOP @ 1 OR I,  O,  ENDOF        \ immediate
  178.         2 OF    MIOP @ 2 OR I,                  \ indirect
  179.                 $0FE AND  AUTOINC @ OR  Oc,  ENDOF
  180.         3 OF    MIOP @ 3 OR I,                  \ indexed
  181.                 OVER 256 < IF    $0FE AND Oc,  Oc, \  -short
  182.                            ELSE  1 OR Oc, O,       \  -long
  183.                            THEN
  184.           ENDOF
  185.     ENDCASE
  186.     RESETF ;
  187.  
  188. : 7MI     CREATE C, DOES> ['] 7MIF A;! A; ;
  189.  
  190.  
  191. : SD?I, ( opcode -- )      \  switch for 3-operand instructions
  192.         SDMODE @ IF  MIOP C@ $1C or
  193.                      $7C <> if ." Not a 3-operand instruction "  then
  194.                      $20 xor
  195.                THEN
  196.         I,  ;
  197.  
  198. : 8MIF  ( breg baop A1 -- )  \ e.g. ADDB breg baop
  199.         ( breg offset wreg A1 -- ) \ indexed
  200.         ( Dbreg Sbreg baop A1 -- ) \ e.g. ADDB Dbreg <-- Sbreg baop
  201.     C@ MIOP !
  202.     AMODE @ CASE
  203.         0 OF    DUP 256 < IF    MIOP @ SD?I,  breg   \ register direct
  204.                           ELSE  MIOP @ 3 OR SD?I,    \ long indexed pseudo-direct
  205.                                 1 Oc,  O,
  206.                           THEN
  207.           ENDOF
  208.         1 OF    MIOP @ 1 OR SD?I,  Oc,  ENDOF        \ immediate
  209.         2 OF    MIOP @ 2 OR SD?I,                  \ indirect
  210.                 $0FE AND  AUTOINC @ OR  Oc,  ENDOF
  211.         3 OF    MIOP @ 3 OR SD?I,                  \ indexed
  212.                 OVER 256 < IF    $0FE AND Oc,  Oc, \  -short
  213.                            ELSE  1 OR Oc, O,       \  -long
  214.                            THEN
  215.           ENDOF
  216.     ENDCASE
  217.     breg  SDMODE @ IF breg THEN   RESETF ;
  218.  
  219. : 8MI     CREATE C, DOES> ['] 8MIF A;! A; ;
  220.  
  221.  
  222. : 9MIF  ( wreg waop A1 -- )   \ e.g. ADD wreg waop
  223.         ( wreg offset wreg A1 -- ) \ indexed
  224.     C@ MIOP !
  225.     AMODE @ CASE
  226.         0 OF  DUP 256 < IF    MIOP @ SD?I,  wreg  \ register direct
  227.                         ELSE  MIOP @ 3 OR SD?I,   \ long indexed pseudo-direct
  228.                               1 Oc,  O,
  229.                         THEN
  230.           ENDOF
  231.         1 OF    MIOP @ 1 OR SD?I,  O,  ENDOF        \ immediate
  232.         2 OF    MIOP @ 2 OR SD?I,                  \ indirect
  233.                 $0FE AND  AUTOINC @ OR  Oc,  ENDOF
  234.         3 OF    MIOP @ 3 OR SD?I,                  \ indexed
  235.                 OVER 256 < IF    $0FE AND Oc,  Oc, \  -short
  236.                            ELSE  1 OR Oc, O,       \  -long
  237.                            THEN
  238.           ENDOF
  239.     ENDCASE
  240.     wreg  SDMODE @ IF wreg THEN   RESETF ;
  241.  
  242. : 9MI     CREATE C, DOES> ['] 9MIF A;! A; ;
  243.  
  244.  
  245. : 10MIF  ( Lreg waop A1 -- )      \ e.g. DIVU Lreg waop
  246.          ( Lreg offset wreg A1 -- ) \ indexed
  247.          ( Lreg wreg waop A1 -- ) \ e.g. MUL Lreg <-- wreg waop
  248.     C@ MIOP !
  249.     AMODE @ CASE
  250.         0 OF  DUP 256 < IF    MIOP @ SD?I,  wreg  \ register direct
  251.                         ELSE  MIOP @ 3 OR SD?I,   \ long indexed pseudo-direct
  252.                               1 Oc,   O,
  253.                         THEN
  254.           ENDOF
  255.         1 OF    MIOP @ 1 OR SD?I,  O,  ENDOF        \ immediate
  256.         2 OF    MIOP @ 2 OR SD?I,                  \ indirect
  257.                 $0FE AND  AUTOINC @ OR  Oc,  ENDOF
  258.         3 OF    MIOP @ 3 OR SD?I,                  \ indexed
  259.                 OVER 256 < IF    $0FE AND Oc,  Oc, \  -short
  260.                            ELSE  1 OR Oc, O,       \  -long
  261.                            THEN
  262.           ENDOF
  263.     ENDCASE
  264.     SDMODE @ IF  wreg  THEN    Lreg   RESETF ;
  265.  
  266. : 10MI     CREATE C, DOES> ['] 10MIF A;! A; ;
  267.  
  268.  
  269. : 11MIF  ( wreg baop A1 -- )      \ e.g. DIVUB wreg baop
  270.          ( wreg offset wreg A1 -- ) \ indexed
  271.          ( wreg breg baop A1 -- ) \ e.g. MULB wreg <-- breg baop
  272.     C@ MIOP !
  273.     AMODE @ CASE
  274.         0 OF  DUP 256 < IF    MIOP @ SD?I,  breg  \ register direct
  275.                         ELSE  MIOP @ 3 OR SD?I,   \ long indexed pseudo-direct
  276.                               1 Oc,   O,
  277.                         THEN
  278.           ENDOF
  279.         1 OF    MIOP @ 1 OR SD?I,  Oc,  ENDOF       \ immediate
  280.         2 OF    MIOP @ 2 OR SD?I,                  \ indirect
  281.                 $0FE AND  AUTOINC @ OR  Oc,  ENDOF
  282.         3 OF    MIOP @ 3 OR SD?I,               \ indexed
  283.                 OVER 256 < IF    $0FE AND Oc,  Oc, \  -short
  284.                            ELSE  1 OR Oc, O,       \  -long
  285.                            THEN
  286.           ENDOF
  287.     ENDCASE
  288.     SDMODE @ IF  breg  THEN    wreg   RESETF ;
  289.  
  290. : 11MI     CREATE C, DOES> ['] 11MIF A;! A; ;
  291.  
  292.  
  293. : LCALLf  ( destination 0 -- )             \ LCALL
  294.         drop
  295.         $0EF I,  HERE 2+ - O,
  296.         RESETF    ;
  297. : LCALL   0  ['] LCALLf A;! A; ;
  298.  
  299. : SCALLf  ( destination 0 -- )             \ SCALL
  300.         drop
  301.         HERE 2+ -  DUP 256 / 7 AND $28 OR I,  $0FF AND Oc,
  302.         RESETF    ;
  303. : SCALL   0  ['] SCALLf A;! A; ;
  304.  
  305. : CALLf  ( destination 0 -- )             \ SCALL and LCALL
  306.         drop  DUP   HERE 2+ -
  307.         -1024 1023  between IF  0 SCALLf  ELSE  0 LCALLf  THEN   ;
  308. : CALL   0  ['] CALLf A;! A; ;
  309.  
  310.  
  311. : LJMPf  ( destination 0 -- )             \ LJMP
  312.         drop
  313.         $0E7 I,  HERE 2+ - O,
  314.         RESETF    ;
  315. : LJMP   0  ['] LJMPf A;! A; ;
  316.  
  317. $E7 =: JMP_OPCODE       \ Make long label test use the right OPCODE
  318.  
  319. : SJMPf  ( destination 0 -- )             \ SJMP
  320.         drop
  321.         HERE 2+ -  DUP 256 / 7 AND $20 OR I,  $0FF AND Oc,
  322.         RESETF    ;
  323. : SJMP    0  ['] SJMPf A;! A; ;
  324.  
  325. : JMPf  ( destination 0 -- )             \ SJMP and LJMP
  326.         drop  DUP   HERE 2+ -
  327.         -1024 1023  between IF  SJMPf  ELSE  LJMPf  THEN   ;
  328. : JMP   0  ['] JMPf A;! A; ;
  329.  
  330.  
  331. : JBCf ( breg n destination 0 -- )                  \ JBC
  332.         drop  swap 7 and $30 or  I,
  333.         swap breg
  334.         HERE 1+ -  Oc,
  335.         RESETF ;
  336. : JBC  0  ['] JBCf A;! A; ;
  337.  
  338. : JBSf ( breg n destination 0 -- )                  \ JBS
  339.         drop  swap 7 and $38 or  I,
  340.         swap breg
  341.         HERE 1+ -  Oc,
  342.         RESETF ;
  343. : JBS  0  ['] JBSf A;! A; ;
  344.  
  345. : DJNZf  ( breg destination 0 -- )      \ DJNZ for labels
  346.         drop   $E0 I,  swap breg
  347.         HERE 1+ -  Oc,
  348.         RESETF    ;
  349. : DJNZ    0  ['] DJNZf A;! A; ;
  350.  
  351. : DJNZWf ( breg destination 0 -- )      \ DJNZW for labels
  352.         drop   $E1 I,  swap wreg
  353.         HERE 1+ -  Oc,
  354.         RESETF ;
  355. : DJNZW  0  ['] DJNZWf A;! A; ;
  356.  
  357.  
  358.  
  359. \ jump instructions for IF ELSE THEN etc.
  360.  
  361. : BITSETf ( breg n 0 -- )               \ BITSET breg n IF
  362.         drop  7 and $30 or  I,  breg
  363.         RESETF ;
  364. : BITSET  0  ['] BITSETf A;! A; ;
  365.  
  366. : BITCLEARf ( breg n 0 -- )             \ BITCLEAR breg n IF
  367.         drop  7 and $38 or  I,  breg
  368.         RESETF ;
  369. : BITCLEAR  0  ['] BITCLEARf A;! A; ;
  370.  
  371. : DEC0=f ( breg 0 -- )                  \ DEC0= breg UNTIL
  372.         drop  $E0 I,  breg
  373.         RESETF ;
  374. : DEC0=  0  ['] DEC0=f A;! A; ;
  375.  
  376. : WDEC0=f ( breg 0 -- )                 \ WDEC0= wreg UNTIL
  377.         drop  $E1 I,  wreg
  378.         RESETF ;
  379. : WDEC0=  0  ['] WDEC0=f A;! A; ;
  380.  
  381.  
  382. headers
  383.  
  384. \ Now let's create the actual instructions.
  385.  
  386. $F8     1MI     CLRC
  387. $FC     1MI     CLRVT
  388. $FA     1MI     DI
  389. $FB     1MI     EI
  390. $FD     1MI     NOP
  391. $F5     1MI     POPA
  392. $F3     1MI     POPF
  393. $F4     1MI     PUSHA
  394. $F2     1MI     PUSHF
  395. $F0     1MI     RET
  396. $FF     1MI     RST
  397. $F9     1MI     SETC
  398. $F7     1MI     TRAP
  399. \ $F1  $F6  $FE
  400.  
  401. $11     2MI     CLRB
  402. $15     2MI     DECB
  403. $17     2MI     INCB
  404. $13     2MI     NEGB
  405. $12     2MI     NOTB
  406. $00     2MI     SKIP
  407.  
  408. $E3     3MI     BR[]
  409. $01     3MI     CLR
  410. $05     3MI     DEC
  411. $16     3MI     EXTB
  412. $07     3MI     INC
  413. $03     3MI     NEG
  414. $02     3MI     NOT
  415.  
  416. $0F     4MI     NORML
  417. $0D     4MI     SHLL
  418. $0E     4MI     SHRAL
  419. $0C     4MI     SHRL
  420.  
  421. $19     5MI     SHLB
  422. $1A     5MI     SHRAB
  423. $18     5MI     SHRB
  424.  
  425. $09     6MI     SHL
  426. $08     6MI     SHR
  427. $0A     6MI     SHRA
  428.  
  429. $CC     7MI     POP
  430. $C8     7MI     PUSH
  431.  
  432. $74     8MI     ADDB
  433. $B4     8MI     ADDCB
  434. $70     8MI     ANDB
  435. $98     8MI     CMPB
  436. $B0     8MI     LDB
  437. $90     8MI     ORB
  438. $C4     8MI     STB
  439. $78     8MI     SUBB
  440. $B8     8MI     SUBCB
  441. $94     8MI     XORB
  442.  
  443. $64     9MI     ADD
  444. $A4     9MI     ADDC
  445. $60     9MI     AND
  446. $88     9MI     CMP
  447. $A0     9MI     LD
  448. $80     9MI     OR
  449. $C0     9MI     ST
  450. $68     9MI     SUB
  451. $A8     9MI     SUBC
  452. $84     9MI     XOR
  453.  
  454. $8C    10MI     DIVU
  455. $6C    10MI     MULU
  456.  
  457. : DIV   A; $0FE I, DIVU ;
  458. : MUL   A; $0FE I, MULU ;
  459.  
  460. $9C    11MI     DIVUB
  461. $7C    11MI     MULUB
  462. $AC    11MI     LDBZE
  463. $BC    11MI     LDBSE
  464.  
  465. : DIVB   A; $0FE I, DIVUB ;
  466. : MULB   A; $0FE I, MULUB ;
  467.  
  468.  
  469. \ other individual types
  470.  
  471. : EXTf  ( Lreg -- )
  472.         drop  $06 I,  Lreg   RESETF ;         \ EXT
  473. : EXT   0  ['] EXTf A;! A; ;
  474.  
  475. 1 value IDLE    2 value POWERDOWN    3 value RESETCPU \ keys for IDLPD
  476. : IDLPDf  ( key -- )
  477.         drop  $06 I,  Oc,   RESETF ;           \ IDLPD key
  478. : IDLPD   0  ['] IDLPDf A;! A; ;
  479.  
  480. : NORMLf ( Lreg breg -- )
  481.         drop  $0F I,  breg Lreg  RESETF ;     \ NORML Lreg breg
  482. : NORML   0  ['] NORMLf A;! A; ;
  483.  
  484. : CMPLf ( Lreg Lreg -- )
  485.         drop  $C5 I,  Lreg Lreg  RESETF ;     \ CMPL dLreg sLreg
  486. : CMPL   0  ['] CMPLf A;! A; ;
  487.  
  488. : BMOVf ( Lreg wreg -- )
  489.         drop  $C1 I,  wreg Lreg  RESETF ;     \ BMOV Lreg wreg
  490. : BMOV   0  ['] BMOVf A;! A; ;
  491.  
  492.  
  493. headerless
  494.  
  495. : 12MIf ( A1 A2 -- )
  496.         C@ I,  HERE 1+ - Oc,  RESETF ;         \ Conditional jumps
  497. : 12MI  CREATE C, DOES> ['] 12MIF A;! A; ;
  498.  
  499. headers
  500.  
  501. $D0 12MI JNST
  502. $D8 12MI JST
  503.  
  504. $D1 12MI JNH
  505. $D9 12MI JH
  506.  
  507. $D2 12MI JGT
  508. $DA 12MI JLE
  509.  
  510. $D3 12MI JNC
  511. $DB 12MI JC
  512.  
  513. $D4 12MI JNVT
  514. $DC 12MI JVT
  515.  
  516. $D5 12MI JNV
  517. $DD 12MI JV
  518.  
  519. $D6 12MI JGE
  520. $DE 12MI JLT
  521.  
  522. $D7 12MI JNE
  523. $DF 12MI JE
  524.  
  525.  
  526. \ The same conditional jumps, but for assembler IF, BEGIN, etc..
  527. headerless
  528.  
  529. : 13MIf ( A1 A2 -- )
  530.         C@ I,  RESETF ;                 \ compile only the first byte
  531. : 13MI  CREATE C, DOES> ['] 13MIF A;! A; ;
  532.  
  533. headers
  534.  
  535. $D0 13MI ST0<>      \ JNST
  536. $D8 13MI ST0=       \ JST
  537.  
  538. $D1 13MI U0>        \ JNH
  539. $D9 13MI U0<=       \ JH
  540.  
  541. $D2 13MI 0<=        \ JGT
  542. $DA 13MI 0>         \ JLE
  543.  
  544. $D3 13MI C0<>       \ JNC
  545. $DB 13MI C0=        \ JC
  546.  
  547. $D4 13MI VT0<>      \ JNVT
  548. $DC 13MI VT0=       \ JVT
  549.  
  550. $D5 13MI OV0<>      \ JNV
  551. $DD 13MI OV0=       \ JV
  552.  
  553. $D6 13MI 0<         \ JGE
  554. $DE 13MI 0>=        \ JLT
  555.  
  556. $D7 13MI 0=         \ JNE
  557. $DF 13MI 0<>        \ JE
  558.  
  559. $20 13MI UJMP>      \ SJMP forwards up to 127
  560. $27 13MI <UJMP      \ SJMP backwards up to 128
  561.  
  562. : x?>MARK    ( -- f addr ) TRUE   HERE   0 Oc,   ;
  563. : x?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP TC! ?CONDITION ;
  564. : x?<MARK    ( -- f addr ) TRUE   HERE   ;
  565. : x?<RESOLVE ( f addr -- ) HERE 1+ -  Oc,   ?CONDITION   ;
  566.  
  567. : BEGIN ( - a f ) A; x?<MARK ;
  568. : UNTIL ( a f - ) A; x?<RESOLVE ;
  569. : AGAIN ( a f - ) A; <UJMP UNTIL ;              \ SJMP backwards up to 127
  570. : IF    ( - A f ) A; x?>MARK ;
  571. : THEN ( A f - )  A; x?>RESOLVE ;
  572. : ELSE ( A f - A f ) A; UJMP> IF                \ SJMP forwards up to 127
  573.                      2SWAP THEN ;
  574. : REPEAT ( A f a f - )  AGAIN THEN ;
  575. : WHILE ( a f - A f a f ) IF 2SWAP ;
  576.  
  577.  
  578.  
  579.  
  580.  
  581. \  behead
  582.  
  583. }
  584.     Symbolic names for the i/o registers of the 8096 and the 80c196
  585. {
  586. hex
  587.  
  588. 0       constant    R0
  589. 2       constant    AD_RESULT
  590. 2       constant    AD_COMMAND
  591. 3       constant    HSI_MODE
  592. 4       constant    HSO_TIME
  593. 4       constant    HSI_TIME
  594. 6       constant    HSO_COMMAND
  595. 6       constant    HSI_STATUS
  596. 7       constant    SBUF
  597. 8       constant    INT_MASK
  598. 9       constant    INT_PEND
  599. 0A      constant    TIMER1
  600. 0A      constant    WATCHDOG
  601. 0B      constant    IOC2
  602. 0C      constant    TIMER2
  603. 0E      constant    BAUD_RATE
  604. 0E      constant    IOPORT0
  605. 0F      constant    IOPORT1
  606. 10      constant    IOPORT2
  607. 11      constant    SP_CON
  608. 11      constant    SP_STAT
  609. 12      constant    INT_PEND1
  610. 13      constant    INT_MASK1
  611. 14      constant    WSR
  612. 15      constant    IOC0
  613. 15      constant    IOS0
  614. 16      constant    IOC1
  615. 16      constant    IOS1
  616. 17      constant    PWM_CONTROL
  617. 17      constant    IOS2
  618. 18      constant    SP
  619.  
  620. decimal
  621.  
  622.  
  623. ONLY FORTH DEFINITIONS ALSO
  624.  
  625.  
  626.