home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / opt5.seq < prev    next >
Encoding:
Text File  |  1991-02-12  |  17.6 KB  |  459 lines
  1. \ OPT5.SEQ      Library Optimizers for 6805 Target Compiler     A. McKewan
  2.  
  3. ONLY FORTH ALSO COMPILER ALSO TARGET ALSO
  4.  
  5. >FORTH
  6.  
  7. COMPILER DEFINITIONS
  8.  
  9. : TVER  ."  6805 Version "
  10. \        ." 1.00 " ;
  11.         version 0 <# # # ascii . hold #s #> type space ;
  12. ' TVER IS TVERSION              \ install startup message
  13.  
  14. WARNING OFF                     \ NO REDEFINITION WARNING IN LIBRARY
  15. FORTH                           \ we want a Forth NOT a target variable
  16. 2VARIABLE IMM-HERE              \ Most recent place where immediate move
  17.                                 \ to BX was compiled
  18. VARIABLE CALL-HERE              \ Most recent place where call subroutine
  19.                                 \ was compiled
  20.  
  21. \ ***************************************************************************
  22. \ Adjust compiler for 6805 target
  23.  
  24. ' NOOP IS DATA-SEG-FIX          \ No need to fixup data segment
  25.  
  26. \ Fix target access for Motorola byte order
  27. : mot@  ( seg ofs -- n )  @L flip ;
  28. ' mot@  ' @-t >body @ xseg @ + 4 !L     \ patch @-t to do byte swap
  29.  
  30. : %%!-t  ( n tadr -- )  swap flip swap %!-t ;
  31. ' %%!-t is !-t
  32.  
  33. : %%set_cold_entry  ( -- )
  34.                 here-t cold_start !-t ;
  35. ' %%set_cold_entry is set_cold_entry
  36.  
  37. : %%resolve_1   ( a1 -- )               \ resolve one reverence to HERE-T
  38.                 here-t swap !-T ;       \ use absolute addresses
  39. ' %%resolve_1 is resolve_1              \ link in default resolver
  40.  
  41.  
  42. $050 dup dp-d ! =: data-start
  43. $100 dup dp-t ! =: code-start
  44.  
  45. \ ***************************************************************************
  46. \ Optimizer for exit.  If the exit is preceeded by a call instruction,
  47. \ replace the call with a jump.  Otherwise compile a return instruction.
  48. \ THIS PREVENTS US FROM USING INLINE WORDS WHICH ASSUME A TERMINATING RTS !!
  49.  
  50. : EXIT_OPT      ( -- )
  51.                 [FORTH]
  52.                 ?OPT
  53.         IF
  54.                 HERE-T 3 -                      \ address of call instruction
  55.                 DUP C@-T $CD =                  \ JSR opcode
  56.                 OVER CALL-HERE @ = AND
  57.                 OVER OPT_LIMIT U> AND
  58.                 IF
  59.                         $CC OVER C!-T           \ patch JMP opcode
  60.                         =: LINESTRT             \ reset listing pointer
  61.                         .INST                   \ show instruction
  62.                 ELSE
  63.                         DROP                    \ discard address
  64.                         [5ASSEMBLER]
  65.                         RTS,                    \ just compile rts
  66.                         [FORTH]
  67.                 THEN
  68.         ELSE
  69.                 ?REOPT
  70.                 [5ASSEMBLER]
  71.                 RTS,                            \ just compile rts
  72.                 [FORTH]
  73.         THEN    ;
  74.  
  75. \ ***************************************************************************
  76. \ New function for END-CODE, needs to not use REVEAL
  77.  
  78. 5ASSEMBLER also forth also
  79.  
  80. : CEND-CODE     ( -- )
  81.                 ll-global? 0=
  82.                 if      ll-errs?        \ check for local label errors
  83.                 then
  84.                 ARUNSAVE IS RUN
  85.                 PREVIOUS A; ;
  86.  
  87. previous previous target
  88.  
  89. : %END-MACRO    ( -- )          \ complete assembly of a MACRO
  90.                 ?reopt
  91.                 [5ASSEMBLER]
  92.                 compile a;                      \ make sure 5ASSEMBLER is done
  93.                 compile cend-code               \ pop 5ASSEMBLER vocabulary
  94.                 [compile] FOR; ;                \ complete colon def
  95.  
  96. ' %END-MACRO IS END-MACRO       \ install in END-MACRO
  97.  
  98. : %END-LCODE    ( -- )          \ complete assembly of a LCODE
  99.                 ?reopt
  100.                 [5ASSEMBLER]
  101.                 compile a;                      \ make sure 5ASSEMBLER is done
  102.                 compile cend-code               \ pop 5ASSEMBLER vocabulary
  103.                 [compile] FOR; ;                \ complete colon def
  104.  
  105. ' %END-LCODE IS END-LCODE       \ install in END-LCODE
  106.  
  107. : %END-L:       ( -- )          \ complete a library CALL definition
  108.                 [5ASSEMBLER]
  109.                 compile setassem
  110. \                compile rts,
  111. \                compile a;                      \ make sure 5ASSEMBLER is done
  112.                 COMPILE EXIT_OPT
  113.                 compile cend-code               \ pop 5ASSEMBLER vocabulary
  114.                 compile unnest ;                \ complete colon def
  115.  
  116. ' %END-L: IS END-L:
  117.  
  118. : %END-LM:      ( -- )          \ complete a library MACRO : definition
  119.                 [5ASSEMBLER]
  120.                 compile setassem
  121.                 compile cend-code
  122.                 compile unnest ;                \ complete colon def
  123.  
  124. ' %END-LM: IS END-LM:
  125.  
  126. : %END-T:       ( -- )          \ complete a target CALL definition
  127.                 [5ASSEMBLER]
  128.                 setassem                \ do 5ASSEMBLER setup
  129. \                rts, a;                  \ terminate with a RET instruction
  130.                 EXIT_OPT
  131.                 fend-code ;             \ do 5ASSEMBLER finishup
  132.  
  133. ' %END-T: IS END-T:
  134.  
  135. ' NOOP IS START-T:              \ no start needed in CALL threaded system
  136.  
  137. : %COMP_CALL    ( a1 -- )                       \ a1 = CFA of symbol
  138.                 ?REOPT
  139.                 HERE-T CALL-HERE !
  140.                 $CD C,-T                        \ compile JSR
  141.                 dup     >resaddr @ dup -1 <>    \ if resolved already
  142.                 if      ( here-t 2+ - ) ,-T         \ resolve this call
  143.                         >count incr             \ bump use count
  144.                                         \ ELSE, add it to the chain of
  145.                 else    drop                    \ discard the "-1"
  146.                                                 \ references to be resolved.
  147.                         dup >chain @ ,-T        \ link chain @ to here
  148.                         here-t 2- over >chain ! \ link here into chain
  149.                         >res                    \ add to resolution stack
  150.                 then    ;
  151.  
  152. ' %COMP_CALL IS COMP_CALL
  153.  
  154. : %COMP_JMP_IMM ( a1 -- )                      \ a1 = actual address
  155.                 $CC C,-T ( HERE-T 2+ - ) ,-T ;
  156.  
  157. ' %COMP_JMP_IMM IS COMP_JMP_IMM
  158.  
  159. : %SUB_RET      ( -- )
  160.                 -1 ALLOT-T ;            \ remove a one byte RET instruction
  161.                                         \ preceeding us in memory
  162.  
  163. ' %SUB_RET IS SUB_RET
  164.  
  165. : %TCODE-START  ( -- )
  166.                 setassem
  167.                 [assembler]
  168.                 llab-init ;
  169.  
  170. ' %TCODE-START IS TCODE-START
  171.  
  172. : %LCODE-START  ( -- )
  173.                 compile tcode-start     \ initialize the 5ASSEMBLER
  174.                 5ASSEMBLER ;             \ and select 5ASSEMBLER vocabulary now!
  175.  
  176. ' %LCODE-START IS LCODE-START
  177.  
  178. : %MACRO-START  ( -- )
  179.                 compile setassem        \ initialize the 5ASSEMBLER
  180.                 5ASSEMBLER ;             \ and select 5ASSEMBLER vocabulary now!
  181.  
  182. ' %MACRO-START IS MACRO-START
  183.  
  184.  
  185. \ ***************************************************************************
  186. \ Modified defining words
  187.  
  188. : VARIABLE  1 ARRAY ;
  189.  
  190.  
  191. \ ***************************************************************************
  192. \ Start of the set of functions supported in the target compiler.
  193. \ These are mostely macros which will compile in-line assembly code.
  194. \ Colon definitions are compiled as routines when defined, and are
  195. \ accessed by a CALL when referenced.
  196.  
  197. ONLY FORTH ALSO COMPILER ALSO TARGET ALSO
  198.  
  199. TARGET DEFINITIONS
  200.  
  201. >LIBRARY                        \ Select the Library versions of
  202.                                 \ defining words.
  203.  
  204. \ ***************************************************************************
  205. \ Variables used by Forth Kernel:
  206.  
  207. 8 ARRAY STACK           \ Data stack
  208. 4 ARRAY TEMP            \ Temps for code words
  209. 3 ARRAY %LOOP           \ FOR/NEXT loop stack
  210.  
  211. >FORTH
  212. : SP0  STACK 8 + ;      \ Top of data stack
  213. >LIBRARY
  214.  
  215. MACRO IMAGE-INIT ( -- )         \ Target compiler runtime initialization
  216.         BEGIN,  SEI,
  217.                 RSP,
  218.                 $50 # LDX,
  219.                 BEGIN,  0 ,X CLR,  X INC,  0= UNTIL,    \ clear ram
  220.                 SP0 # LDX,              \ RESET STACK
  221.                 $1000 JSR,              \ CALL real program (gets patched)
  222.                 here-t 2- =: cold_start \ set patch pointer
  223.         AGAIN,
  224.                 END-MACRO
  225.  
  226. FORTH DEFINITIONS >FORTH
  227.  
  228. \ DEFER DEF-INIT                  \ default target initialization
  229. \ DEFER NO-INIT                   \ default NO initialization
  230.  
  231. : TARGET-INIT   ( -- )          \ initialize the terget compiler
  232.                 ?LIB ABORT" Can't use TARGET-INIT in a library routine"
  233.                 ONLY FORTH ALSO COMPILER ALSO
  234.                 TARGET ALSO DEFINITIONS 5ASSEMBLER ALSO
  235.                 POSTFIX         \ use postfix assembler
  236.                 tseg_init       \ Initialize the target compile buffer
  237.                 >target         \ select target defining words
  238.                 target          \ Select the target vocabulary
  239.                 lihere =: linestrt
  240.                 F['] IMAGE-INIT                 \ address of init routine
  241.                 DUP >COUNT INCR                 \ mark it used and
  242.                         >EXECUTE EXECUTE        \ compile it
  243. \                ?DEFINIT
  244. \                IF      DEF-INIT
  245. \                ELSE    NO-INIT
  246. \                THEN
  247.                 ; IMMEDIATE
  248.  
  249. ' TARGET-INIT IS TARGET-INITIALIZE
  250.  
  251.  
  252. \ ***************************************************************************
  253. \                           OPTIMIZERS !!
  254. \ ***************************************************************************
  255. \ PUSH and POP macros
  256.  
  257. 5ASSEMBLER DEFINITIONS
  258. : PUSH,         X DEC,  0 ,X STA,  ;
  259. : POP,          0 ,X LDA,  X INC,  ;
  260.  
  261. COMPILER DEFINITIONS
  262. : PUSH          ( -- )
  263.                 [5ASSEMBLER] PUSH, [COMPILER]
  264.                 ?REOPT ;
  265.  
  266. : PUSH_OPT      ( -- f )
  267.                 ?OPT
  268.         IF      HERE-T 2- @-T $5AF7 =           \ X DEC,  0 ,X STA,
  269.                 OPT_LIMIT HERE-T 2- U< AND
  270.                 IF      -2 ALLOT-T              \ if it matches, discard
  271.                                                 \ previously compiled 2 bytes
  272.                         LIHERE =: LINESTRT
  273.                         TRUE                    \ return true flag
  274.                 ELSE    FALSE
  275.                 THEN
  276.         ELSE    ?REOPT
  277.                 FALSE
  278.         THEN    ;
  279.  
  280.  
  281. : POP           ( -- )
  282.                 PUSH_OPT NOT
  283.         IF      [5ASSEMBLER]
  284.                 POP,
  285.                 [COMPILER]
  286.         THEN    ;
  287.  
  288.  
  289. \ ***************************************************************************
  290. \ Literal/Memory optimize.  If previous instrucion was a literal, remove
  291. \ compiled code and return value and a flag of -1.  If previous instruction
  292. \ was a memory fetch, remove compiled code and return address and a flag
  293. \ of 1.  Otherwise return a zero flag.
  294. \
  295. \ LIT_OPT     looks for:        xxx # LDA,  X DEC,  0 ,X STA,
  296. \
  297. \ LIT/MEM_OPT looks for:        xxx # LDA,  X DEC,  0 ,X STA,
  298. \                    or:        xxx ) LDA,  X DEC,  0 ,X STA,
  299. \
  300.  
  301. COMPILER DEFINITIONS
  302.  
  303. : LIT_OPT       ( -- <xxxx> f1 )                \ literal optimize
  304.                 ?OPT                            \ Are we optimizing?
  305.         IF                                      \ instructions before ?
  306.                 HERE-T 4 - C@-T $A6   =         \ xx # LDA,
  307.                 HERE-T 2 -  @-T $5AF7 = AND     \ X DEC,  0 ,X STA,
  308.                 OPT_LIMIT HERE-T 4 - U< AND
  309.                 IF      HERE-T 3 - C@-T         \ get the value xx
  310.                         -4 ALLOT-T              \ if it matches, discard
  311.                                                 \ previously compiled 4 bytes
  312.                         LIHERE =: LINESTRT      \ and return value
  313.  
  314.                         TRUE                    \ return -1 for literal
  315.                 ELSE    FALSE
  316.                 THEN
  317.         ELSE    ?REOPT
  318.                 FALSE
  319.         THEN    ;
  320.  
  321. : LIT/MEM?      ( byte -- f )   \ true if lda immediate or direct
  322.                 $EF AND $A6 = ;
  323.  
  324. : LIT/MEM-FLAG  ( byte -- f )   \  -1 = literal, 1 = memory
  325.                 $A6 = 2* 1+ ;
  326.  
  327. : LIT/MEM_OPT   ( -- <xxxx> f1 )                \ literal/memory optimize
  328.                 ?OPT                            \ Are we optimizing?
  329.         IF                                      \ instructions before ?
  330.                 HERE-T 4 - C@-T LIT/MEM?        \ xx # LDA, or xx LDA,
  331.                 HERE-T 2 -  @-T $5AF7 = AND     \ X DEC,  0 ,X STA,
  332.                 OPT_LIMIT HERE-T 4 - U< AND
  333.                 IF      HERE-T 3 - C@-T         \ get the value xx
  334.                         HERE-T 4 - C@-T LIT/MEM-FLAG    \ and flag
  335.                         -4 ALLOT-T              \ if it matches, discard
  336.                                                 \ previously compiled 4 bytes
  337.                         LIHERE =: LINESTRT      \ and return value
  338.                 ELSE
  339.                         0
  340.                 THEN
  341.         ELSE    ?REOPT
  342.                 0
  343.         THEN    ;
  344.  
  345. : PUSH_LIT/MEM_OPT   ( -- <xxxx> f1 )   \ push then literal/memory optimize
  346.                 ?OPT                            \ Are we optimizing?
  347.         IF                                      \ instructions before ?
  348.                 HERE-T 6 -  @-T $5AF7 =         \ X DEC,  0 ,X STA,
  349.                 HERE-T 4 - C@-T LIT/MEM? AND    \ xx # LDA, -or- xx LDA,
  350.                 HERE-T 2 -  @-T $5AF7 = AND     \ X DEC,  0 ,X STA,
  351.                 OPT_LIMIT HERE-T 6 - U< AND
  352.                 IF      HERE-T 3 - C@-T         \ get the value xx
  353.                         HERE-T 4 - C@-T LIT/MEM-FLAG    \ and flag
  354.                         -6 ALLOT-T              \ if it matches, discard
  355.                                                 \ previously compiled 6 bytes
  356.                         LIHERE =: LINESTRT      \ and return value
  357.                 ELSE
  358.                         0
  359.                 THEN
  360.         ELSE    ?REOPT
  361.                 0
  362.         THEN    ;
  363.  
  364. : LIT_LIT_OPT   ( -- <xx yy> f1 )               \ double literal optimize
  365.                 ?OPT                            \ Are we optimizing?
  366.         IF                                      \ instructions before ?
  367.                 HERE-T 8 - C@-T $A6 =           \ xx # LDA,
  368.                 HERE-T 6 -  @-T $5AF7 = AND     \ X DEC,  0 ,X STA,
  369.                 HERE-T 4 - C@-T $A6   = AND     \ yy # LDA,
  370.                 HERE-T 2 -  @-T $5AF7 = AND     \ X DEC,  0 ,X STA,
  371.                 OPT_LIMIT HERE-T 8 - U< AND
  372.                 IF      HERE-T 7 - C@-T         \ get the value xx
  373.                         HERE-T 3 - C@-T         \ get the value yy
  374.                         -8 ALLOT-T              \ if it matches, discard
  375.                                                 \ previously compiled 4 bytes
  376.                         LIHERE =: LINESTRT      \ and return value
  377.                         TRUE
  378.                 ELSE
  379.                         FALSE
  380.                 THEN
  381.         ELSE    ?REOPT
  382.                 FALSE
  383.         THEN    ;
  384.  
  385.  
  386. \ ***************************************************************************
  387. \ Optimizer for binary operators ( + - AND OR XOR )
  388.  
  389. FORTH VARIABLE %CFA
  390.  
  391. : BINARY        ( cfa opcode -- )
  392.                 [FORTH]
  393.                 >R  %CFA !
  394.                 LIT/MEM_OPT ?DUP
  395.         IF      0<
  396.                 IF      LIT/MEM_OPT ?DUP
  397.                         IF      0<
  398.                                 IF      R> DROP
  399.                                         SWAP %CFA @ EXECUTE
  400.                                         [5ASSEMBLER]
  401.                                         ( xxx_op_yyy ) # LDA,
  402.                                         [FORTH]
  403.                                         PUSH
  404.                                 ELSE
  405.                                         [5ASSEMBLER]
  406.                                         ( xxx ) LDA,
  407.                                         ( yyy ) R> $A0 + C, C, .INST ( # OP )
  408.                                         [FORTH]
  409.                                         PUSH
  410.                                 THEN
  411.                         ELSE
  412.                                 [5ASSEMBLER]
  413.                                 0 ,X LDA,
  414.                                 ( xxx ) R> $A0 + C, C, .INST ( # OP )
  415.                                 0 ,X STA,
  416.                                 [FORTH]
  417.                         THEN
  418.                 ELSE    LIT/MEM_OPT ?DUP
  419.                         IF      0<
  420.                                 IF
  421.                                         [5ASSEMBLER]
  422.                                         ( xxx ) # LDA,
  423.                                         ( yyy ) R> $B0 + C, C, .INST ( MEM OP )
  424.                                         [FORTH]
  425.                                         PUSH
  426.                                 ELSE
  427.                                         [5ASSEMBLER]
  428.                                         ( xxx ) LDA,
  429.                                         ( yyy ) R> $B0 + C, C, .INST ( MEM OP )
  430.                                         [FORTH]
  431.                                         PUSH
  432.                                 THEN
  433.                         ELSE
  434.                                 [5ASSEMBLER]
  435.                                 0 ,X LDA,
  436.                                 ( xxx ) R> $B0 + C, C, .INST ( MEM OP )
  437.                                 0 ,X STA,
  438.                                 [FORTH]
  439.                         THEN
  440.                 THEN
  441.         ELSE
  442.                 POP
  443.                 [5ASSEMBLER]
  444.                 R@ $F0 + C, .INST ( 0 ,X OP )
  445.                 [FORTH]
  446.           R> 0= IF      ( subtract )
  447.                         [5ASSEMBLER]
  448.                         A NEG,
  449.                         [FORTH]
  450.                 THEN
  451.                 [5ASSEMBLER]
  452.                 0 ,X STA,
  453.                 [FORTH]
  454.         THEN    ;
  455.  
  456.  
  457. TARGET DEFINITIONS
  458.  
  459.