Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / lib5.seq < prev next >

Wrap

Text File | 1991-02-12 | 25.6 KB | 813 lines

\ LIB5.SEQ 6805 Target Library Source by Andrew McKewan \ *************************************************************************** \ Target specific words used by the compiler to complete compilation of \ the the various types of library and target definitions. These words \ will need to be re-written when a new traget is being written. \ *************************************************************************** \ Target Library words \ *************************************************************************** >LIBRARY TARGET DEFINITIONS \ *************************************************************************** \ This macro puts a literal number on the data stack. The instructon \ sequence used is not optimal, but is likely to be optimized later by the \ automatic POP optimizer. MACRO (LIT) ( n1 -- ) \ Special macro to compile an inline number # LDA, \ to the stack. PUSH END-MACRO NO-INTERPRET ' (LIT) >EXECUTE IS COMP_SINGLE \ link into number compiler MACRO EXIT ( -- ) EXIT_OPT END-MACRO NO-INTERPRET MACRO ?EXIT ( f1 -- ) \ If boolean f1 is true, exit from definition POP A TST, 0= NOT IF, RTS, THEN, END-MACRO NO-INTERPRET \ *************************************************************************** \ Compiler Control Structures MACRO BEGIN ( -- ) BEGIN, OPT_OFF1 END-MACRO NO-INTERPRET MACRO AGAIN ( -- ) AGAIN, OPT_OFF1 END-MACRO NO-INTERPRET MACRO IF ( f -- ) POP A TST, 0= NOT IF, OPT_OFF1 END-MACRO NO-INTERPRET TARGET ' IF ALIAS WHILE ( f1 -- ) MACRO ELSE ( -- ) ELSE, OPT_OFF1 END-MACRO NO-INTERPRET MACRO THEN ( -- ) THEN, OPT_OFF1 END-MACRO NO-INTERPRET MACRO REPEAT ( -- ) REPEAT, OPT_OFF1 END-MACRO NO-INTERPRET MACRO UNTIL ( f1 -- ) POP A TST, 0= NOT UNTIL, OPT_OFF1 END-MACRO NO-INTERPRET \ *************************************************************************** \ CASE STATEMENT NOT IMPLEMENTED COMMENT: FORTH >FORTH 0 VALUE #CASES \ a CASE counter FORTH : %CASE ( -- ) [FORTH] OFF> #CASES ; FORTH : CASE ( -- ) [FORTH] ?LIB IF COMPILE %CASE ELSE %CASE THEN [TARGET] ; IMMEDIATE TARGET >LIBRARY MACRO OF ( n1 n2 -- n1 ) ( n1 n2 -- ) [FORTH] LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] CMP BX, # ( xxxx ) [FORTH] ELSE [5ASSEMBLER] CMP BX, ( xxxx ) [FORTH] THEN ELSE [5ASSEMBLER] LODSW XCHG AX, BX CMP BX, AX [FORTH] THEN INCR> #CASES \ bump number of cases ?LONG IF [5ASSEMBLER] JZ here 5 + A; \ branch around JMP JMP +BR# $ WORD A; [FORTH] ELSE [5ASSEMBLER] JNZ +BR# $ A; [FORTH] THEN [5ASSEMBLER] LOAD_BX END-MACRO NO-INTERPRET MACRO ENDOF ( -- ) JMP +BR# $ WORD BR#SWAP -BR# DUP $:| 01LAB OPT_OFF1 END-MACRO NO-INTERPRET MACRO ENDCASE ( -- ) \ resolve branch [FORTH] SAVE> ?LONG \ save current branch length flag LONG_BRANCH \ we default to long for ENDCASE #CASES 0 \ resolve #CASES case statments DO [5ASSEMBLER] -BR# DUP $:| 01LAB [FORTH] LOOP OFF> #CASES RESTORE> ?LONG \ restore branch length flag [5ASSEMBLER] OPT_OFF1 END-MACRO NO-INTERPRET COMMENT; \ *************************************************************************** \ Runtime Primatives for for/next loop CODE (FOR) ( n -- ) %LOOP 1+ LDA, %LOOP 2+ STA, %LOOP LDA, %LOOP 1+ STA, POP, %LOOP STA, RTS, END-CODE CODE (NEXT) ( -- ) %LOOP 1+ LDA, %LOOP STA, %LOOP 2+ LDA, %LOOP 1+ STA, RTS, END-CODE MACRO FOR ( n1 -- ) F['] (FOR) TARG_COMPILE BEGIN, OPT_OFF1 END-MACRO NO-INTERPRET MACRO NEXT ( -- ) %LOOP DEC, 0= UNTIL, F['] (NEXT) TARG_COMPILE END-MACRO NO-INTERPRET MACRO I ( -- n ) %LOOP LDA, PUSH END-MACRO NO-INTERPRET MACRO LEAVE ( -- ) \ LEAVE forces an exit at the end \ of the loop by setting the index to 1. 1 # LDA, %LOOP STA, END-MACRO NO-INTERPRET \ *************************************************************************** \ Stack Operators MACRO DROP ( n1 -- ) X INC, END-MACRO EXECUTES> DROP MACRO DUP ( n1 -- n1 n1 ) [FORTH] PUSH_OPT IF PUSH PUSH ELSE [5ASSEMBLER] 0 ,X LDA, [FORTH] PUSH THEN [TARGET] END-MACRO EXECUTES> DUP CODE SWAP ( n1 n2 -- n2 n1 ) 0 ,X LDA, TEMP STA, 1 ,X LDA, 0 ,X STA, TEMP LDA, 1 ,X STA, RTS, END-CODE EXECUTES> SWAP MACRO OVER ( n1 n2 -- n1 n2 n1 ) 1 ,X LDA, PUSH END-MACRO EXECUTES> OVER CODE ROT ( n1 n2 n3 -- n2 n3 n1 ) 0 ,X LDA, TEMP STA, 1 ,X LDA, TEMP 1+ STA, 2 ,X LDA, 0 ,X STA, TEMP LDA, 1 ,X STA, TEMP 1+ LDA, 2 ,X STA, RTS, END-CODE EXECUTES> ROT MACRO NIP ( n1 n2 -- n2 ) POP 0 ,X STA, END-MACRO EXECUTES> NIP CODE TUCK ( n1 n2 -- n2 n1 n2 ) 0 ,X LDA, TEMP STA, 1 ,X LDA, 0 ,X STA, TEMP LDA, 1 ,X STA, PUSH, RTS, END-CODE EXECUTES> TUCK CODE ?DUP ( n -- n | n n ) 0 ,X LDA, 0= NOT IF, PUSH, THEN, RTS, END-CODE EXECUTES> ?DUP CODE (PICK) ( n1 -- n2 ) TEMP STX, 0 ,X LDA, TEMP ADD, TAX, 1 ,X LDA, TEMP LDX, 0 ,X STA, RTS, END-CODE MACRO PICK ( n1 -- n2 ) [FORTH] LIT_OPT IF [5ASSEMBLER] ( xxx ) ,X LDA, [FORTH] PUSH ELSE F['] (PICK) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET \ *************************************************************************** \ Double stack operators MACRO 2DROP ( n1 n2 -- ) X INC, X INC, END-MACRO EXECUTES> 2DROP CODE 2DUP ( n1 n2 -- n1 n2 n1 n2 ) 1 ,X LDA, PUSH, 1 ,X LDA, PUSH, RTS, END-CODE EXECUTES> 2DUP \ *************************************************************************** \ Arithmetic/logical operators MACRO + ( n1 n2 -- n3 ) [FORTH] LIT_LIT_OPT IF + [5ASSEMBLER] # LDA, [FORTH] PUSH ELSE PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] # ADD, [FORTH] ELSE [5ASSEMBLER] MEM ADD, [FORTH] THEN PUSH ELSE POP [5ASSEMBLER] 0 ,X ADD, 0 ,X STA, [FORTH] THEN THEN [TARGET] END-MACRO EXECUTES> + MACRO - ( n1 n2 -- n3 ) [FORTH] LIT_LIT_OPT IF - [5ASSEMBLER] # LDA, [FORTH] PUSH ELSE PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] # SUB, [FORTH] ELSE [5ASSEMBLER] MEM SUB, [FORTH] THEN PUSH ELSE POP [5ASSEMBLER] 0 ,X SUB, A NEG, 0 ,X STA, [FORTH] THEN THEN [TARGET] END-MACRO EXECUTES> - MACRO AND ( n1 n2 -- n3 ) [FORTH] LIT_LIT_OPT IF AND [5ASSEMBLER] # LDA, [FORTH] PUSH ELSE PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] # AND, [FORTH] ELSE [5ASSEMBLER] MEM AND, [FORTH] THEN PUSH ELSE POP [5ASSEMBLER] 0 ,X AND, 0 ,X STA, [FORTH] THEN THEN [TARGET] END-MACRO EXECUTES> AND MACRO OR ( n1 n2 -- n3 ) [FORTH] LIT_LIT_OPT IF OR [5ASSEMBLER] # LDA, [FORTH] PUSH ELSE PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] # ORA, [FORTH] ELSE [5ASSEMBLER] MEM ORA, [FORTH] THEN PUSH ELSE POP [5ASSEMBLER] 0 ,X ORA, 0 ,X STA, [FORTH] THEN THEN [TARGET] END-MACRO EXECUTES> OR MACRO XOR ( n1 n2 -- n3 ) [FORTH] LIT_LIT_OPT IF XOR [5ASSEMBLER] # LDA, [FORTH] PUSH ELSE PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] # EOR, [FORTH] ELSE [5ASSEMBLER] MEM EOR, [FORTH] THEN PUSH ELSE POP [5ASSEMBLER] 0 ,X EOR, 0 ,X STA, [FORTH] THEN THEN [TARGET] END-MACRO EXECUTES> XOR LABEL (*) ( u1 u2 -- u3 ) POP TEMP STX, 0 ,X LDX, MUL, TEMP LDX, 0 ,X STA, RTS, END-CODE MACRO * ( u1 u2 -- u3 ) [FORTH] PUSH_LIT/MEM_OPT ?DUP IF 0< IF [5ASSEMBLER] TEMP STX, ( xxx ) # LDX, MUL, TEMP LDX, [FORTH] PUSH ELSE [5ASSEMBLER] TEMP STX, ( xxx ) LDX, MUL, TEMP LDX, [FORTH] PUSH THEN ELSE \ F['] (*) TARG_COMPILE POP [5ASSEMBLER] TEMP STX, 0 ,X LDX, MUL, TEMP LDX, 0 ,X STA, [FORTH] THEN [TARGET] END-MACRO EXECUTES> * CODE M* ( u1 u2 -- ud ) TEMP STX, 0 ,X LDA, 1 ,X LDX, MUL, TEMP 1+ STX, TEMP LDX, 1 ,X STA, TEMP 1+ LDA, 0 ,X STA, RTS, END-CODE ( NO DIVIDE YET !!! ) \ *************************************************************************** \ Unary arithmetic/logical operators MACRO NEGATE ( n1 -- n2 ) [FORTH] PUSH_OPT IF [5ASSEMBLER] A NEG, [FORTH] PUSH ELSE [5ASSEMBLER] 0 ,X NEG, [FORTH] THEN [TARGET] END-MACRO EXECUTES> NEGATE MACRO NOT ( n1 -- n2 ) [FORTH] PUSH_OPT IF [5ASSEMBLER] A COM, [FORTH] PUSH ELSE [5ASSEMBLER] 0 ,X COM, [FORTH] THEN [TARGET] END-MACRO EXECUTES> NOT MACRO 2* ( n1 -- n2 ) [FORTH] PUSH_OPT IF [5ASSEMBLER] A LSL, [FORTH] PUSH ELSE [5ASSEMBLER] 0 ,X LSL, [FORTH] THEN [TARGET] END-MACRO EXECUTES> 2* MACRO 2/ ( n1 -- n2 ) [FORTH] PUSH_OPT IF [5ASSEMBLER] A LSR, [FORTH] PUSH ELSE [5ASSEMBLER] 0 ,X LSR, [FORTH] THEN [TARGET] END-MACRO EXECUTES> 2/ $FF CONSTANT TRUE $00 CONSTANT FALSE \ *************************************************************************** \ Program control MACRO SP! ( ? -- ) \ reset data stack pointer SP0 # LDX, END-CODE NO-INTERPRET MACRO RP! ( -- ) \ reset return stack pointer RSP, END-MACRO NO-INTERPRET MACRO NOOP ( -- ) \ no operation NOP, END-MACRO EXECUTES> NOOP \ *************************************************************************** \ 6805 Special instructions \ MAYBE PUT THESE IN INTERRUPT LIBRARY FILE MACRO EI ( -- ) \ enable interrupts CLI, END-MACRO NO-INTERPRET MACRO DI ( -- ) \ disable interrupts SEI, END-MACRO NO-INTERPRET MACRO SWI ( -- ) \ software interrupt SWI, END-MACRO NO-INTERPRET MACRO WAIT ( -- ) \ wait for interrupt WAIT, END-MACRO NO-INTERPRET MACRO STOP ( -- ) \ stop processor STOP, END-MACRO NO-INTERPRET \ *************************************************************************** \ Memory operations CODE (@) ( addr -- n ) \ default subroutine call TEMP STX, 0 ,X LDX, 0 ,X LDA, TEMP LDX, 0 ,X STA, RTS, END-CODE MACRO @ ( -- ) \ The ! MACRO [FORTH] LIT_OPT IF [5ASSEMBLER] ( xxx ) LDA, [FORTH] PUSH ELSE F['] (@) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' @ >EXECUTE IS COMP_FETCH \ link into compiler CODE (!) ( n a -- ) \ default subroutine TEMP STX, 1 ,X LDA, 0 ,X LDX, 0 ,X STA, TEMP LDX, X INC, X INC, RTS, END-CODE MACRO ! ( n addr -- ) [FORTH] LIT_OPT IF POP [5ASSEMBLER] ( xxx ) STA, [FORTH] ELSE F['] (!) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' ! >EXECUTE IS COMP_STORE \ link to compiler CODE (+!) ( n addr -- ) \ default subroutine TEMP STX, 1 ,X LDA, 0 ,X LDX, 0 ,X ADD, 0 ,X STA, TEMP LDX, X INC, X INC, RTS, END-CODE MACRO +! ( n addr -- ) [FORTH] LIT_OPT IF [5ASSEMBLER] POP DUP ( xxx ) ADD, ( xxx ) STA, [FORTH] ELSE F['] (+!) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' +! >EXECUTE IS COMP_PSTORE \ link to compiler CODE (ON) ( addr -- ) \ default subroutine TEMP STX, 0 ,X LDX, $FF # LDA, 0 ,X STA, TEMP LDX, X INC, RTS, END-CODE MACRO ON ( addr -- ) [FORTH] LIT_OPT IF [5ASSEMBLER] $FF # LDA, ( xxx ) STA, [FORTH] ELSE F['] (ON) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' ON >EXECUTE IS COMP_ON \ link to compiler CODE (OFF) ( addr -- ) \ default subroutine TEMP STX, 0 ,X LDX, 0 ,X CLR, TEMP LDX, X INC, RTS, END-CODE MACRO OFF ( addr -- ) [FORTH] LIT_OPT IF [5ASSEMBLER] ( xxx ) CLR, [FORTH] ELSE F['] (OFF) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' OFF >EXECUTE IS COMP_OFF \ link to compiler CODE (INCR) ( addr -- ) \ default subroutine TEMP STX, 0 ,X LDX, 0 ,X INC, TEMP LDX, X INC, RTS, END-CODE MACRO INCR ( addr -- ) [FORTH] LIT_OPT IF [5ASSEMBLER] ( xxx ) INC, [FORTH] ELSE F['] (INCR) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' INCR >EXECUTE IS COMP_INCR \ link to compiler CODE (DECR) ( addr -- ) \ default subroutine TEMP STX, 0 ,X LDX, 0 ,X DEC, TEMP LDX, X INC, RTS, END-CODE MACRO DECR ( addr -- ) [FORTH] LIT_OPT IF [5ASSEMBLER] ( xxx ) DEC, [FORTH] ELSE F['] (DECR) TARG_COMPILE THEN [TARGET] END-MACRO NO-INTERPRET ' DECR >EXECUTE IS COMP_DECR \ link to compiler \ *************************************************************************** \ Double Memory Operarors CODE 2@ ( adr -- n1 n2 ) TEMP STX, 0 ,X LDX, 0 ,X LDA, TEMP 1+ STA, TEMP LDX, 0 ,X LDX, 1 ,X LDA, TEMP LDX, 0 ,X STA, TEMP 1+ LDA, PUSH, RTS, END-CODE CODE 2! ( n1 n2 adr -- ) POP, TEMP 1+ STA, TEMP STX, 0 ,X LDA, TEMP 1+ LDX, 0 ,X STA, TEMP LDX, 1 ,X LDA, TEMP 1+ LDX, 1 ,X STA, TEMP LDX, X INC, X INC, RTS, END-CODE \ *************************************************************************** \ Block Memory Operators CODE MOVE ( from to len -- ) POP, TEMP STA, ( len ) POP, TEMP 1+ STA, ( to ) POP, TEMP 2+ STA, ( from ) TEMP 3 + STX, ( save X ) TEMP TST, 0= NOT IF, BEGIN, TEMP 2+ LDX, 0 ,X LDA, TEMP 1+ LDX, 0 ,X STA, TEMP 2+ INC, TEMP 1+ INC, TEMP DEC, 0= UNTIL, THEN, TEMP 3 + LDX, RTS, END-CODE CODE FILL ( adr len n -- ) POP, TEMP STA, ( n ) POP, TEMP 1+ STA, ( len ) POP, TEMP 2+ STA, ( addr ) TEMP 3 + STX, ( save X ) TEMP 1+ TST, 0= NOT IF, TEMP LDA, TEMP 2+ LDX, BEGIN, 0 ,X STA, X INC, TEMP 1+ DEC, 0= UNTIL, THEN, TEMP 3 + LDX, RTS, END-CODE : ERASE ( addr len -- ) 0 FILL ; \ *************************************************************************** \ Comparison Operators CODE 0= ( n -- f ) 0 ,X LDA, 0= IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE 0<> ( n -- f ) 0 ,X LDA, 0= NOT IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE 0< ( n -- f ) 0 ,X LDA, 0< IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE 0> ( n -- f ) 0 ,X LDA, 0= IF, 0 ,X CLR, RTS, THEN, 0< IF, 0 ,X CLR, RTS, THEN, $FF # LDA, 0 ,X STA, RTS, END-CODE CODE = ( n n1 -- f ) POP, 0 ,X CMP, 0= IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE <> ( n n1 -- f ) POP, 0 ,X CMP, 0= NOT IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE < ( n n1 -- f ) POP, 0 ,X CMP, > IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE > ( n n1 -- f ) POP, 0 ,X CMP, < IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE <= ( n n1 -- f ) POP, 0 ,X CMP, < NOT IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE CODE >= ( n n1 -- f ) POP, 0 ,X CMP, > NOT IF, $FF # LDA, 0 ,X STA, RTS, THEN, 0 ,X CLR, RTS, END-CODE \ *************************************************************************** CODE MS ( n -- ) \ Delay for N milliseconds POP, TEMP CLR, BEGIN, BEGIN, TEMP DEC, 0= UNTIL, A DEC, 0= UNTIL, RTS, END-CODE : 500MS ( -- ) \ Delays approximately 500 msec. 250 MS 250 MS ; >FORTH