File:  [gforth] / gforth / arch / misc / asm.fs
Revision 1.5: download - view: text, annotated - select for diffs
Wed Oct 2 15:54:57 2002 UTC (19 years, 3 months ago) by jwilke
Branches: MAIN
CVS tags: v0-6-2, v0-6-1, v0-6-0, HEAD
warn if end-label / end-code is missing

    1: \ PIE MISC assembler
    2: 
    3: Vocabulary assembler
    4: also assembler also definitions forth
    5: \ [IFUNDEF] cross
    6: \ : X ;
    7: \ [THEN]
    8: 
    9: \ sources
   10: 
   11: $0 Constant PC		$1 Constant PC+2
   12: $2 Constant PC+4	$3 Constant PC+6
   13: 
   14: $8 Constant ACCU	$9 Constant SF
   15: $A Constant ZF		$C Constant CF
   16: 
   17: \ destinations
   18: 
   19: $0 Constant JMP		$1 Constant JS
   20: $2 Constant JZ		$4 Constant JC
   21: 
   22: $7 Constant *ACCU
   23: ( $8 Constant ACCU )	$9 Constant SUB
   24: ( $A Constant SUBR )	$B Constant ADD
   25: $C Constant XOR		$D Constant OR
   26: $E Constant AND		$F Constant SHR
   27: 
   28: $FFFC Constant txd
   29: $FFFF Constant rx?
   30: $FFFE Constant rxd
   31: \ $FFF0 Constant tx
   32: 
   33: : end-label previous ;
   34: 
   35: Create marks $10 cells allot
   36: 
   37: : ahere X here 2/ ;
   38: 
   39: : m ( n -- ) cells marks + ahere 2* swap ! 0 ;
   40: : r ( n -- ) cells marks + @ ahere swap s" !" evaluate 0 ;
   41: 
   42: \ intel hex dump
   43: 
   44: : 0.r ( n1 n2 -- ) 0 swap <# 0 ?DO # LOOP #> type ;
   45: 
   46: : tohex ( dest addr u -- )  base @ >r hex
   47:   ." :" swap >r >r
   48:   r@ dup 2 0.r  over 4 0.r  ." 00"
   49:   over 8 rshift + +
   50:   r> r> swap bounds ?DO  I ( 1 xor ) c@ dup 2 0.r +  LOOP
   51:   negate $FF and 2 0.r  r> base ! ;
   52: 
   53: : 2hex ( dest addr u -- )
   54:   BEGIN  dup WHILE
   55:          >r 2dup r@ $10 min tohex cr
   56:          r> $10 /string 0 max rot $10 + -rot
   57:   REPEAT  drop 2drop ;
   58: 
   59: \ : sym 
   60: \    base @ >r hex
   61: \    cr ." sym:s/PC=" ahere 4 0.r ." /" bl word count type ." /g" cr
   62: \    r> base ! ;
   63: : sym bl word drop ;
   64: 
   65: : label 
   66:   >in @ bl word count X here symentry >in !
   67:   ahere Constant ;
   68: 
   69: : code
   70:   -1 ABORT" Need end-code or end-label before a new code definition" ;
   71: 
   72: also forth definitions
   73: 
   74: : label also assembler label ;
   75: 
   76: : (code) also assembler ;
   77: : (end-code) previous ;
   78: 
   79: previous previous previous
   80: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>