home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / asm5.seq < prev    next >
Text File  |  1991-02-12  |  6KB  |  179 lines
  1. \ ASM5.SEQ              6805 Assembler                  by Andrew McKewan
  2.  
  3. \ Adapted to TCOM following TCOM96
  4.  
  5. warning off
  6.  
  7. ONLY FORTH DEFINITIONS
  8. VOCABULARY 5ASSEMBLER
  9. ' 5ASSEMBLER ALIAS [5ASSEMBLER] IMMEDIATE
  10. ONLY FORTH ALSO assembler also 5ASSEMBLER DEFINITIONS ALSO
  11.  
  12. \ some alias headers so we dont have to redefine these words in
  13. \ the new target assembler.
  14.  
  15. ' a;            alias a;
  16. ' a;!           alias a;!
  17. ' $             alias $
  18. ' $:            alias $:
  19.  
  20. ' $:            alias $:|
  21. ' $:F           alias $$:F
  22. \ ' $:|           alias $:|             add back when long labels defined
  23. \ ' $$:F          alias $$:F
  24.  
  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. ' c,            alias c,
  32. ' ,             alias ,
  33. ' here          alias here
  34. ' tc@           alias tc@
  35. ' tc!           alias tc!
  36. ' t!            alias t!
  37.  
  38. FORTH DEFINITIONS
  39.  
  40. : DOASSEM05     ( --- )
  41.                   ['] RUN-A; IS RUN
  42.                 0 ['] DROP A;!
  43.                 APRIOR 4 + 2@ APRIOR 2!
  44.                 ll-global? 0=
  45.                 if      llab-init               \ in case labels used
  46.                 then
  47.                 ALSO 5ASSEMBLER ;
  48.  
  49. : SETASM05      ['] DOASSEM05 IS SETASSEM  ;
  50. : SETASM86      ['] DOASSEM   IS SETASSEM  ;
  51.  
  52. SETASM05
  53.  
  54. ONLY FORTH ALSO 5ASSEMBLER DEFINITIONS ALSO
  55.  
  56. HEX
  57.  
  58. \ Addressing Modes
  59.  
  60. VARIABLE (MM)   ( holds opcode mode )
  61. : MM   CREATE , DOES> @ (MM) ! ;   ( byte offsets in table )
  62. 0 MM MEM   18 MM #   30 MM A   48 MM X   60 MM ,X  MEM
  63.  
  64. : ADJUST    ( table address, operand --- table address+offset )
  65.    DUP E000 AND  IF DROP 9 + EXIT THEN
  66.    DUP FF00 AND  IF DROP 6 + EXIT THEN
  67.                  IF      3 + EXIT THEN ;
  68.  
  69. : ERR   MEM  1 ABORT" Assembly Error"  ;
  70.  
  71. : OP     C, ;                                ( compile opcode )
  72. : OP+B   C, C, ;            ( compile opcode and byte operand )
  73. : OP+W   C, SPLIT C, C, ;           ( opcode and word operand )
  74. : OP+0   C, DROP ;                      ( opcode for 0,X mode )
  75.  
  76. \ The follinng definition is for use with library labels in TCOM.
  77. \ If PARITY is a library label,
  78. \ use           PARITY $D6 OP,
  79. \ instead of    PARITY LDA,
  80. \ because PARITY will not return its correct address until after
  81. \ it is compiled and the wrong addressing mode may be used.
  82.  
  83. : OP,  ( operand opcode -- )  OP+W ;
  84. : CALL,  ( adr -- )    $CD OP, ;        \ FOR JSR, TO LABEL ROUTINES
  85.  
  86.  
  87. \ Relative branch resolution:
  88. : SIZE? ( to, from --- offset, flag )  1+ - DUP 80 + -100 AND ;
  89. : ?S    ( to, from -- offset )  SIZE? ABORT" Range Error in Branch" ;
  90.  
  91.  
  92. : Modes  ( n -- )               \ build opcode jump table
  93.   0 DO  BL WORD NUMBER DROP C,  ' ,  LOOP ;
  94.  
  95. CREATE M-Table  ( holds address modes )
  96.  
  97.          ( zero    byte    word   >1fff    zero    byte    word   >1fff )
  98. 8 Modes   30 OP+B 30 OP+B 00 ERR  00 ERR  B0 OP+B B0 OP+B C0 OP+W 00 ERR
  99. 8 Modes   00 ERR  00 ERR  00 ERR  00 ERR  A0 OP+B A0 OP+B 00 ERR  00 ERR
  100. 8 Modes   40 OP   40 OP   40 OP   40 OP   00 ERR  00 ERR  00 ERR  00 ERR
  101. 8 Modes   50 OP   50 OP   50 OP   50 OP   00 ERR  00 ERR  00 ERR  00 ERR
  102. 8 Modes   70 OP+0 60 OP+B 00 ERR  00 ERR  F0 OP+0 E0 OP+B D0 OP+W 00 ERR
  103.  
  104. : (OPC)         ( operand proto-byte -- assemble to memory )
  105.         C@ M-Table (MM) @ +  2 PICK ADJUST  OVER 80 AND IF 0C + THEN
  106.         COUNT  ROT OR SWAP @ EXECUTE  MEM ;
  107.  
  108.  
  109. : 1MI   ( -- )                  \ single-byte instructions
  110.         CREATE C,  DOES> C@ C, .INST ;
  111.  
  112. : 2MI   ( mem bit -- )          \ bit set and clear
  113.         CREATE C,  DOES> C@ SWAP 2* + C,  SPLIT IF ERR THEN C, .INST ;
  114.  
  115. : 3MI   ( operand -- )          \ multimode instructions
  116.         CREATE C,  DOES> (OPC) .INST ;
  117.  
  118. : 4MI   ( operand -- )          \ jump and call optimized
  119.         CREATE C,
  120.         DOES>  OVER HERE 1+ SIZE? ( big )  (MM) @ 60 = ( ,x )  OR
  121.                 IF  DROP (OPC)
  122.                 ELSE SWAP C@ 08C = ( jmp )
  123.                   IF 020 ELSE 0AD THEN C, C, DROP THEN .INST ;
  124.  
  125. : 5MI   ( dest -- )             \ branch instructions
  126.         CREATE C,  DOES> C@ C,  HERE ?S C, .INST ;
  127.  
  128. : 6MI   ( dest mem bit -- )     \ bit test and branch
  129.         CREATE C,
  130.         DOES>  C@ SWAP 2* + C,  SPLIT IF ERR THEN C,  HERE ?S C, .INST ;
  131.  
  132.  
  133. 89 3MI ADC,     8B 3MI ADD,     84 3MI AND,     08 3MI ASL,
  134. 07 3MI ASR,     24 5MI BCC,     11 2MI BCLR,    25 5MI BCS,
  135. 27 5MI BEQ,     28 5MI BHCC,    29 5MI BHCS,    22 5MI BHI,
  136. 24 5MI BHS,     2F 5MI BIH,     2E 5MI BIL,     85 3MI BIT,
  137. 25 5MI BLO,     23 5MI BLS,     2C 5MI BMC,     2B 5MI BMI,
  138. 2D 5MI BMS,     26 5MI BNE,     2A 5MI BPL,     20 5MI BRA,
  139. 01 6MI BRCLR,   21 5MI BRN,     00 6MI BRSET,   10 2MI BSET,
  140. AD 5MI BSR,     98 1MI CLC,     9A 1MI CLI,     0F 3MI CLR,
  141. 81 3MI CMP,     03 3MI COM,     83 3MI CPX,     0A 3MI DEC,
  142. 88 3MI EOR,     0C 3MI INC,     8C 3MI JMP,     8D 3MI JSR,
  143. 86 3MI LDA,     8E 3MI LDX,     08 3MI LSL,     04 3MI LSR,
  144. 42 1MI MUL,     00 3MI NEG,     9D 1MI NOP,     8A 3MI ORA,
  145. 09 3MI ROL,     06 3MI ROR,     9C 1MI RSP,     80 1MI RTI,
  146. 81 1MI RTS,     82 3MI SBC,     99 1MI SEC,     9B 1MI SEI,
  147. 87 3MI STA,     8E 1MI STOP,    8F 3MI STX,     80 3MI SUB,
  148. 83 1MI SWI,     97 1MI TAX,     0D 3MI TST,     9F 1MI TXA,
  149. 8F 1MI WAIT,
  150.  
  151.  
  152. \ Stuctured Conditionals
  153.  
  154. : ?<MARK        ( -- adr f )    HERE  TRUE ;
  155. : ?<RESOLVE     ( adr f -- )    ?CONDITION  HERE ?S C, ;
  156. : ?>MARK        ( -- adr f )    HERE 0 C,  TRUE ;
  157. : ?>RESOLVE     ( adr f -- )    ?CONDITION  HERE OVER ?S SWAP TC! ;
  158.  
  159. 24 CONSTANT CS       26 CONSTANT 0=       2A CONSTANT 0<
  160. 2E CONSTANT IRQHI    23 CONSTANT  >       24 CONSTANT  <
  161.  
  162. : NOT       1 XOR ;
  163. : SET       2* FF01 + ;
  164. : CLEAR     SET NOT ;
  165.  
  166. : IF,       SPLIT SWAP C, IF C, THEN  ?>MARK .INST ;
  167. : THEN,     ?>RESOLVE  ;
  168. : ELSE,     20 IF,  2SWAP THEN, ;
  169. : BEGIN,    ?<MARK ;
  170. : UNTIL,    SPLIT SWAP C, IF C, THEN  ?<RESOLVE .INST ;
  171. : AGAIN,    20 UNTIL, ;
  172. : WHILE,    IF, 2SWAP ;
  173. : REPEAT,   AGAIN, THEN, ;
  174.  
  175. DECIMAL
  176.  
  177. ONLY FORTH ALSO DEFINITIONS
  178.  
  179.