home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / SOURCE / ASSEMB.WRD next >
Encoding:
Text File  |  1992-12-18  |  5.8 KB  |  203 lines  |  [04] ASCII Text (0x0000)
  1. \ ==============================================================
  2. \ FORTH ASSEMBLER FOR 6502
  3. \   ADAPTED FROM DR. DOBBS TOOLBOOK ARTICLE
  4. \   BY WILLIAM F. RAGSDALE, JULY 1, 1980
  5. \ ==============================================================
  6.  
  7. HEX
  8. VOCABULARY ASSEMBLER IMMEDIATE
  9. ASSEMBLER DEFINITIONS
  10.  
  11. \ REGISTER ASSIGNMENT FOR MAD APPLE FORTH
  12.  
  13. EB CONSTANT XSAVE     \ USED FOR SAVING X-REG 
  14. FA CONSTANT W         \ FORTH WORD CURRENTLY BEING EXECUTED 
  15. FC CONSTANT IP        \ NEXT ADDRESS IN THE COLON DEFINITION
  16. 01 CONSTANT N         \ USER WORKSPACE FROM N-1 TO N+7
  17. \ NOT SURE WHAT TO DO ABOUT REGISTER "UP" 
  18.  
  19. \ NUCLEUS LOCATIONS SPECIFIC TO MAD APPLE FORTH
  20.  
  21. ' (DO) 12 +     CONSTANT POP     \ POP 16BIT VALUE & EXIT
  22. ' (DO) 10 +     CONSTANT POPTWO  \ POP 2 16BIT VALUES & EXIT
  23. ' LIT  13 +     CONSTANT PUT     \ REPLACE 16BIT WITH A & STK
  24. ' LIT  11 +     CONSTANT PUSH    \ ADD A & STK TO DATA STACK
  25. ' LIT  1A +     CONSTANT NEXT    \ EXIT TO INTERPRETER
  26. ' EXECUTE NFA 13 - CONSTANT SETUP \ ?????NOT SURE WHAT USED FOR
  27.  
  28. VARIABLE INDEX  0 INDEX !   -2 ALLOT \ OVERWRITE THE VARIABLE
  29. 0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 ,
  30. 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 ,
  31.  
  32. VARIABLE MODE   2 MODE !
  33. : .A  0 MODE ! ;  \ ACCUMULATOR ADDRESSING MODE
  34. : #   1 MODE ! ;  \ IMMEDIATE
  35. : MEM 2 MODE ! ;  \ ABSOLUTE 
  36. : ,X  3 MODE ! ;  \ INDEXED BY X
  37. : ,Y  4 MODE ! ;  \ INDEXED BY Y
  38. : X)  5 MODE ! ;  \ INDEXED INDIRECT BY X
  39. : )Y  6 MODE ! ;  \ INDIRECT INDEXED BY Y
  40. : )   F MODE ! ;  \ INDIRECT JMP
  41.  
  42. \ *** STACK IS LOCATED AT $300 IN MAD APPLE FORTH
  43. : BOT  ,X  300 ;  \ ADDRESS BOTTOM OF STACK
  44. : SEC  ,X  302 ;  \ ADDRESS SECOND ITEM ON STACK
  45. : RP)  ,X  101 ;  \ ADDRESS BOTTOM OF RETURN STACK
  46.  
  47. : -DUP  DUP IF DUP ENDIF ;
  48.  
  49. : UPMODE  ( ADDR F -- ADDR F ) 
  50. \ ADJUSTS MODE AND SETS FLAG IF ERROR
  51.     IF 
  52.        MODE @ 8 AND 0= IF
  53.           8 MODE +!
  54.        THEN
  55.     THEN
  56.     1 MODE @  0F AND -DUP IF
  57.        0 DO  DUP + LOOP
  58.     THEN
  59.     OVER 1+ @ AND 0=
  60. ;
  61.  
  62. : CPU ( N --- )  \ SIMPLE ONE BYTE ML COMMANDS
  63.    CREATE C,
  64.    DOES> C@ C, MEM
  65. ;
  66.      00 CPU BRK,   18 CPU CLC,   D8 CPU CLD,   58 CPU CLI,
  67.      B8 CPU CLV,   CA CPU DEX,   88 CPU DEY,   E8 CPU INX,
  68.      C8 CPU INY,   EA CPU NOP,   48 CPU PHA,   08 CPU PHP,
  69.      68 CPU PLA,   28 CPU PLP,   40 CPU RTI,   60 CPU RTS,
  70.      38 CPU SEC,   F8 CPU SED,   78 CPU SEI,   AA CPU TAX,
  71.      A8 CPU TAY,   BA CPU TSX,   8A CPU TXA,   9A CPU TXS,
  72.      98 CPU TYA,   
  73.  
  74. : M/CPU
  75.   CREATE C, ,
  76.   DOES>  DUP 1+ @ 80 AND IF
  77.      10 MODE +!
  78.   THEN
  79.   OVER FF00 AND UPMODE UPMODE IF
  80.      MEM CR LATEST ID. 3 ERROR
  81.   THEN
  82.   C@ MODE C@ INDEX + C@ + C,    \ FIRST BYTE = ML COMMAND
  83.   MODE C@ 7 AND IF
  84.      MODE C@ 0F AND 7 < IF
  85.         C,                      \ EITHER ONE BYTE
  86.      ELSE
  87.         ,                       \ OR 2 BYTE OPERAND
  88.      THEN
  89.   THEN
  90.   MEM
  91. ;
  92.  
  93. 1C6E 60 M/CPU ADC,   1C6E 20 M/CPU AND,   1C6E C0 M/CPU CMP,
  94. 1C6E 40 M/CPU EOR,   1C6E A0 M/CPU LDA,   1C6E 00 M/CPU ORA,
  95. 1C6E E0 M/CPU SBC,   1C6C 80 M/CPU STA,   0D0D 01 M/CPU ASL,
  96. 0C0C C1 M/CPU DEC,   0C0C E1 M/CPU INC,   0D0D 41 M/CPU LSR,
  97. 0D0D 21 M/CPU ROL,   0D0D 61 M/CPU ROR,   0414 81 M/CPU STX,
  98. 0486 E0 M/CPU CPX,   0486 C0 M/CPU CPY,   1496 A2 M/CPU LDX,
  99. 0C8E A0 M/CPU LDY,   048C 80 M/CPU STY,   0480 14 M/CPU JSR,
  100. 8480 40 M/CPU JMP,   0484 20 M/CPU BIT,
  101.  
  102. \
  103. \ IMPROVED IF-THEN-ELSE STRUCTURE
  104. \ CORRECTS BUG FOR OVERFLOWS
  105.  
  106. HEX
  107.  
  108. \ BRANCHING TESTS
  109.  
  110.  
  111. : NOT  20 -  ;
  112. B0 CONSTANT CS     \ BCS    CS NOT = BCC=B0-20=90
  113. F0 CONSTANT 0=     \ BEQ    0= NOT = BNE=F0-20=D0
  114. 30 CONSTANT 0<     \ BMI    0< NOT = BPL=30-20=10
  115. 70 CONSTANT VS     \ BVS    VS NOT = BVC=70-20=50
  116.  
  117.  
  118. : IF,
  119.          C,        \ STORE THE BRANCH
  120.          3 C,      \ TO INSTR FOLLOWING THE JMP
  121.          4C C,     \ JMP 
  122.          HERE      \ LEAVE THIS ADRS FOR LATER MODIFICATION
  123.          0 ,       \ STORE A ZERO ADRS FOR NOW
  124.          2         \ LEAVE ERROR CHECK CODE
  125. ; IMMEDIATE
  126.  
  127. : THEN,
  128.          ?EXEC 2 ?PAIRS      \ MAKE SURE CALLED OK
  129.          HERE                \ STK=PREV-ADRS NEW-ADRS
  130.          SWAP !              \ RESOLVE THE OLD JMP
  131. ; IMMEDIATE
  132.  
  133. : ELSE,
  134.          ?EXEC 2 ?PAIRS      \ MAKE SURE CALLED OK
  135.          4C C,               \ SET UP NEW JMP
  136.          HERE 0 ,            \ STK = ADR1 ADR2 
  137.          SWAP HERE           \ STK = ADR2 ADR1 ADR3
  138.          SWAP !              \ RESOLVE OLD JMP
  139.          2                   \ LEAVE ADR2 AND ERRCHK FOR THEN,
  140. ; IMMEDIATE
  141.  
  142. : BEGIN,
  143.          HERE 1              \ SAVE ADRS AND ERRCHK
  144. ; IMMEDIATE
  145.  
  146. : UNTIL,
  147.          ?EXEC >R            \ HOLD CONDITION ON RET STK 
  148.          1 ?PAIRS R>         \ TEST ERRCHK, IF OK RESTORE COND
  149.          C, 3 C,             \ COMPILE BRANCH OVER THE JMP
  150.          4C C, ,             \ COMPILE JMP USING BEGIN ADRS
  151. ; IMMEDIATE
  152.  
  153. : WHILE,
  154.          ?EXEC >R            \ HOLD CONDITION ON RET STACK
  155.          1 ?PAIRS R>         \ TEST ERRCHK, IF OK RESTORE COND
  156.          C, 3 C,             \ COMPILE BRANCH OVER THE JMP
  157.          4C C,               \ JMP
  158.          HERE SWAP           \ STK = NEW-ADRS OLD-ADRS
  159.          0 ,                 \ THE JMP IS UNRESOLVED 
  160.          3                   \ ERRCHK FOR REPEAT
  161. ; IMMEDIATE
  162.  
  163.         
  164. : REPEAT,
  165.          ?EXEC 3 ?PAIRS      \ TEST ERRCHK
  166.          4C C, ,              \ JMP BACK TO OLD-ADRS
  167.          HERE SWAP           \ RESOLVE JMP FROM WHILE
  168.          !                   \ WITH THIS ADRS
  169. ;
  170.  
  171.  
  172.  
  173. : END-CODE
  174.      CURRENT @ CONTEXT !
  175.      ?EXEC ?CSP SMUDGE
  176. ; IMMEDIATE
  177.  
  178. FORTH DEFINITIONS
  179.  
  180. HEX
  181. : L   ( ADDR --- )     \ MONITOR DISASSEMBLER: EX: 300 L
  182.     3A !  FE61 CALL  CR
  183. ;
  184.  
  185. : LL ( -- ) \ CONTINUES DISASSEMBLY STARTED BY L
  186.     3A @ L
  187. ;
  188.  
  189. DECIMAL
  190.  
  191.  
  192. : CODE
  193.    ?EXEC
  194.    ASSEMBLER                 \ NEEDED FOR "MEM" BELOW
  195.    [COMPILE] ASSEMBLER       \ CHANGES TO ASSEMBLER VOCAB
  196.    CREATE                    \ HEADER FOR CODE WORD
  197.    MEM
  198.    HERE DUP CFA !           \ CHANGE PFA TO POINT TO ML CODE
  199.    SP@ CSP !                \ SAVE STACK PTR FOR LATER TEST
  200. ; IMMEDIATE
  201.  
  202. FORTH
  203.