home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
opt5.seq
< prev
next >
Wrap
Text File
|
1991-02-12
|
18KB
|
459 lines
\ OPT5.SEQ Library Optimizers for 6805 Target Compiler A. McKewan
ONLY FORTH ALSO COMPILER ALSO TARGET ALSO
>FORTH
COMPILER DEFINITIONS
: TVER ." 6805 Version "
\ ." 1.00 " ;
version 0 <# # # ascii . hold #s #> type space ;
' TVER IS TVERSION \ install startup message
WARNING OFF \ NO REDEFINITION WARNING IN LIBRARY
FORTH \ we want a Forth NOT a target variable
2VARIABLE IMM-HERE \ Most recent place where immediate move
\ to BX was compiled
VARIABLE CALL-HERE \ Most recent place where call subroutine
\ was compiled
\ ***************************************************************************
\ Adjust compiler for 6805 target
' NOOP IS DATA-SEG-FIX \ No need to fixup data segment
\ Fix target access for Motorola byte order
: mot@ ( seg ofs -- n ) @L flip ;
' mot@ ' @-t >body @ xseg @ + 4 !L \ patch @-t to do byte swap
: %%!-t ( n tadr -- ) swap flip swap %!-t ;
' %%!-t is !-t
: %%set_cold_entry ( -- )
here-t cold_start !-t ;
' %%set_cold_entry is set_cold_entry
: %%resolve_1 ( a1 -- ) \ resolve one reverence to HERE-T
here-t swap !-T ; \ use absolute addresses
' %%resolve_1 is resolve_1 \ link in default resolver
$050 dup dp-d ! =: data-start
$100 dup dp-t ! =: code-start
\ ***************************************************************************
\ Optimizer for exit. If the exit is preceeded by a call instruction,
\ replace the call with a jump. Otherwise compile a return instruction.
\ THIS PREVENTS US FROM USING INLINE WORDS WHICH ASSUME A TERMINATING RTS !!
: EXIT_OPT ( -- )
[FORTH]
?OPT
IF
HERE-T 3 - \ address of call instruction
DUP C@-T $CD = \ JSR opcode
OVER CALL-HERE @ = AND
OVER OPT_LIMIT U> AND
IF
$CC OVER C!-T \ patch JMP opcode
=: LINESTRT \ reset listing pointer
.INST \ show instruction
ELSE
DROP \ discard address
[5ASSEMBLER]
RTS, \ just compile rts
[FORTH]
THEN
ELSE
?REOPT
[5ASSEMBLER]
RTS, \ just compile rts
[FORTH]
THEN ;
\ ***************************************************************************
\ New function for END-CODE, needs to not use REVEAL
5ASSEMBLER also forth also
: CEND-CODE ( -- )
ll-global? 0=
if ll-errs? \ check for local label errors
then
ARUNSAVE IS RUN
PREVIOUS A; ;
previous previous target
: %END-MACRO ( -- ) \ complete assembly of a MACRO
?reopt
[5ASSEMBLER]
compile a; \ make sure 5ASSEMBLER is done
compile cend-code \ pop 5ASSEMBLER vocabulary
[compile] FOR; ; \ complete colon def
' %END-MACRO IS END-MACRO \ install in END-MACRO
: %END-LCODE ( -- ) \ complete assembly of a LCODE
?reopt
[5ASSEMBLER]
compile a; \ make sure 5ASSEMBLER is done
compile cend-code \ pop 5ASSEMBLER vocabulary
[compile] FOR; ; \ complete colon def
' %END-LCODE IS END-LCODE \ install in END-LCODE
: %END-L: ( -- ) \ complete a library CALL definition
[5ASSEMBLER]
compile setassem
\ compile rts,
\ compile a; \ make sure 5ASSEMBLER is done
COMPILE EXIT_OPT
compile cend-code \ pop 5ASSEMBLER vocabulary
compile unnest ; \ complete colon def
' %END-L: IS END-L:
: %END-LM: ( -- ) \ complete a library MACRO : definition
[5ASSEMBLER]
compile setassem
compile cend-code
compile unnest ; \ complete colon def
' %END-LM: IS END-LM:
: %END-T: ( -- ) \ complete a target CALL definition
[5ASSEMBLER]
setassem \ do 5ASSEMBLER setup
\ rts, a; \ terminate with a RET instruction
EXIT_OPT
fend-code ; \ do 5ASSEMBLER finishup
' %END-T: IS END-T:
' NOOP IS START-T: \ no start needed in CALL threaded system
: %COMP_CALL ( a1 -- ) \ a1 = CFA of symbol
?REOPT
HERE-T CALL-HERE !
$CD C,-T \ compile JSR
dup >resaddr @ dup -1 <> \ if resolved already
if ( here-t 2+ - ) ,-T \ resolve this call
>count incr \ bump use count
\ ELSE, add it to the chain of
else drop \ discard the "-1"
\ references to be resolved.
dup >chain @ ,-T \ link chain @ to here
here-t 2- over >chain ! \ link here into chain
>res \ add to resolution stack
then ;
' %COMP_CALL IS COMP_CALL
: %COMP_JMP_IMM ( a1 -- ) \ a1 = actual address
$CC C,-T ( HERE-T 2+ - ) ,-T ;
' %COMP_JMP_IMM IS COMP_JMP_IMM
: %SUB_RET ( -- )
-1 ALLOT-T ; \ remove a one byte RET instruction
\ preceeding us in memory
' %SUB_RET IS SUB_RET
: %TCODE-START ( -- )
setassem
[assembler]
llab-init ;
' %TCODE-START IS TCODE-START
: %LCODE-START ( -- )
compile tcode-start \ initialize the 5ASSEMBLER
5ASSEMBLER ; \ and select 5ASSEMBLER vocabulary now!
' %LCODE-START IS LCODE-START
: %MACRO-START ( -- )
compile setassem \ initialize the 5ASSEMBLER
5ASSEMBLER ; \ and select 5ASSEMBLER vocabulary now!
' %MACRO-START IS MACRO-START
\ ***************************************************************************
\ Modified defining words
: VARIABLE 1 ARRAY ;
\ ***************************************************************************
\ Start of the set of functions supported in the target compiler.
\ These are mostely macros which will compile in-line assembly code.
\ Colon definitions are compiled as routines when defined, and are
\ accessed by a CALL when referenced.
ONLY FORTH ALSO COMPILER ALSO TARGET ALSO
TARGET DEFINITIONS
>LIBRARY \ Select the Library versions of
\ defining words.
\ ***************************************************************************
\ Variables used by Forth Kernel:
8 ARRAY STACK \ Data stack
4 ARRAY TEMP \ Temps for code words
3 ARRAY %LOOP \ FOR/NEXT loop stack
>FORTH
: SP0 STACK 8 + ; \ Top of data stack
>LIBRARY
MACRO IMAGE-INIT ( -- ) \ Target compiler runtime initialization
BEGIN, SEI,
RSP,
$50 # LDX,
BEGIN, 0 ,X CLR, X INC, 0= UNTIL, \ clear ram
SP0 # LDX, \ RESET STACK
$1000 JSR, \ CALL real program (gets patched)
here-t 2- =: cold_start \ set patch pointer
AGAIN,
END-MACRO
FORTH DEFINITIONS >FORTH
\ DEFER DEF-INIT \ default target initialization
\ DEFER NO-INIT \ default NO initialization
: TARGET-INIT ( -- ) \ initialize the terget compiler
?LIB ABORT" Can't use TARGET-INIT in a library routine"
ONLY FORTH ALSO COMPILER ALSO
TARGET ALSO DEFINITIONS 5ASSEMBLER ALSO
POSTFIX \ use postfix assembler
tseg_init \ Initialize the target compile buffer
>target \ select target defining words
target \ Select the target vocabulary
lihere =: linestrt
F['] IMAGE-INIT \ address of init routine
DUP >COUNT INCR \ mark it used and
>EXECUTE EXECUTE \ compile it
\ ?DEFINIT
\ IF DEF-INIT
\ ELSE NO-INIT
\ THEN
; IMMEDIATE
' TARGET-INIT IS TARGET-INITIALIZE
\ ***************************************************************************
\ OPTIMIZERS !!
\ ***************************************************************************
\ PUSH and POP macros
5ASSEMBLER DEFINITIONS
: PUSH, X DEC, 0 ,X STA, ;
: POP, 0 ,X LDA, X INC, ;
COMPILER DEFINITIONS
: PUSH ( -- )
[5ASSEMBLER] PUSH, [COMPILER]
?REOPT ;
: PUSH_OPT ( -- f )
?OPT
IF HERE-T 2- @-T $5AF7 = \ X DEC, 0 ,X STA,
OPT_LIMIT HERE-T 2- U< AND
IF -2 ALLOT-T \ if it matches, discard
\ previously compiled 2 bytes
LIHERE =: LINESTRT
TRUE \ return true flag
ELSE FALSE
THEN
ELSE ?REOPT
FALSE
THEN ;
: POP ( -- )
PUSH_OPT NOT
IF [5ASSEMBLER]
POP,
[COMPILER]
THEN ;
\ ***************************************************************************
\ Literal/Memory optimize. If previous instrucion was a literal, remove
\ compiled code and return value and a flag of -1. If previous instruction
\ was a memory fetch, remove compiled code and return address and a flag
\ of 1. Otherwise return a zero flag.
\
\ LIT_OPT looks for: xxx # LDA, X DEC, 0 ,X STA,
\
\ LIT/MEM_OPT looks for: xxx # LDA, X DEC, 0 ,X STA,
\ or: xxx ) LDA, X DEC, 0 ,X STA,
\
COMPILER DEFINITIONS
: LIT_OPT ( -- <xxxx> f1 ) \ literal optimize
?OPT \ Are we optimizing?
IF \ instructions before ?
HERE-T 4 - C@-T $A6 = \ xx # LDA,
HERE-T 2 - @-T $5AF7 = AND \ X DEC, 0 ,X STA,
OPT_LIMIT HERE-T 4 - U< AND
IF HERE-T 3 - C@-T \ get the value xx
-4 ALLOT-T \ if it matches, discard
\ previously compiled 4 bytes
LIHERE =: LINESTRT \ and return value
TRUE \ return -1 for literal
ELSE FALSE
THEN
ELSE ?REOPT
FALSE
THEN ;
: LIT/MEM? ( byte -- f ) \ true if lda immediate or direct
$EF AND $A6 = ;
: LIT/MEM-FLAG ( byte -- f ) \ -1 = literal, 1 = memory
$A6 = 2* 1+ ;
: LIT/MEM_OPT ( -- <xxxx> f1 ) \ literal/memory optimize
?OPT \ Are we optimizing?
IF \ instructions before ?
HERE-T 4 - C@-T LIT/MEM? \ xx # LDA, or xx LDA,
HERE-T 2 - @-T $5AF7 = AND \ X DEC, 0 ,X STA,
OPT_LIMIT HERE-T 4 - U< AND
IF HERE-T 3 - C@-T \ get the value xx
HERE-T 4 - C@-T LIT/MEM-FLAG \ and flag
-4 ALLOT-T \ if it matches, discard
\ previously compiled 4 bytes
LIHERE =: LINESTRT \ and return value
ELSE
0
THEN
ELSE ?REOPT
0
THEN ;
: PUSH_LIT/MEM_OPT ( -- <xxxx> f1 ) \ push then literal/memory optimize
?OPT \ Are we optimizing?
IF \ instructions before ?
HERE-T 6 - @-T $5AF7 = \ X DEC, 0 ,X STA,
HERE-T 4 - C@-T LIT/MEM? AND \ xx # LDA, -or- xx LDA,
HERE-T 2 - @-T $5AF7 = AND \ X DEC, 0 ,X STA,
OPT_LIMIT HERE-T 6 - U< AND
IF HERE-T 3 - C@-T \ get the value xx
HERE-T 4 - C@-T LIT/MEM-FLAG \ and flag
-6 ALLOT-T \ if it matches, discard
\ previously compiled 6 bytes
LIHERE =: LINESTRT \ and return value
ELSE
0
THEN
ELSE ?REOPT
0
THEN ;
: LIT_LIT_OPT ( -- <xx yy> f1 ) \ double literal optimize
?OPT \ Are we optimizing?
IF \ instructions before ?
HERE-T 8 - C@-T $A6 = \ xx # LDA,
HERE-T 6 - @-T $5AF7 = AND \ X DEC, 0 ,X STA,
HERE-T 4 - C@-T $A6 = AND \ yy # LDA,
HERE-T 2 - @-T $5AF7 = AND \ X DEC, 0 ,X STA,
OPT_LIMIT HERE-T 8 - U< AND
IF HERE-T 7 - C@-T \ get the value xx
HERE-T 3 - C@-T \ get the value yy
-8 ALLOT-T \ if it matches, discard
\ previously compiled 4 bytes
LIHERE =: LINESTRT \ and return value
TRUE
ELSE
FALSE
THEN
ELSE ?REOPT
FALSE
THEN ;
\ ***************************************************************************
\ Optimizer for binary operators ( + - AND OR XOR )
FORTH VARIABLE %CFA
: BINARY ( cfa opcode -- )
[FORTH]
>R %CFA !
LIT/MEM_OPT ?DUP
IF 0<
IF LIT/MEM_OPT ?DUP
IF 0<
IF R> DROP
SWAP %CFA @ EXECUTE
[5ASSEMBLER]
( xxx_op_yyy ) # LDA,
[FORTH]
PUSH
ELSE
[5ASSEMBLER]
( xxx ) LDA,
( yyy ) R> $A0 + C, C, .INST ( # OP )
[FORTH]
PUSH
THEN
ELSE
[5ASSEMBLER]
0 ,X LDA,
( xxx ) R> $A0 + C, C, .INST ( # OP )
0 ,X STA,
[FORTH]
THEN
ELSE LIT/MEM_OPT ?DUP
IF 0<
IF
[5ASSEMBLER]
( xxx ) # LDA,
( yyy ) R> $B0 + C, C, .INST ( MEM OP )
[FORTH]
PUSH
ELSE
[5ASSEMBLER]
( xxx ) LDA,
( yyy ) R> $B0 + C, C, .INST ( MEM OP )
[FORTH]
PUSH
THEN
ELSE
[5ASSEMBLER]
0 ,X LDA,
( xxx ) R> $B0 + C, C, .INST ( MEM OP )
0 ,X STA,
[FORTH]
THEN
THEN
ELSE
POP
[5ASSEMBLER]
R@ $F0 + C, .INST ( 0 ,X OP )
[FORTH]
R> 0= IF ( subtract )
[5ASSEMBLER]
A NEG,
[FORTH]
THEN
[5ASSEMBLER]
0 ,X STA,
[FORTH]
THEN ;
TARGET DEFINITIONS