urflibs/urasm/ext/dup-include.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrAsm Forth Engine!
   4 ;; GPLv3 ONLY
   5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6 ;; Z80 Assembler: DUP and INCLUDE instructions
   7 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9
  10 also-defs: asm-helpers
  11
  12 false value verbose-include?
  13
  14 : .curr-file  ( -- )
  15   0 (include-file-name) xtype
  16 ;
  17
  18
  19 define-accessors dup
  20   def: prev
  21   def: count
  22   def: line
  23   def: fofs
  24   def: clabel
  25 end-accessors
  26
  27 0 value dup-curr
  28
  29
  30 define-accessors inc
  31   def: prev
  32   def: dupr
  33 end-accessors
  34
  35 0 value inc-curr
  36
  37
  38 : (end-include)  ( -- eof-flag )
  39   inc-curr if
  40     dup-curr " unfinished DUP" ?error
  41     inc-curr inc->dupr@ to dup-curr
  42     inc-curr inc->prev@ to inc-curr
  43     next-token expect-eol
  44     refill drop
  45     true to line-start next-token
  46     false
  47     verbose-include? if ." continue >: " .curr-file cr endif
  48   else true endif
  49 ;
  50
  51 : do-include  ( -- )
  52   next-token tok-type tk-str <> " quoted file name expected" ?error
  53   token string:>pad next-token expect-eol
  54   inc-size n-allot
  55   inc-curr over inc->prev! to inc-curr
  56   dup-curr inc-curr inc->dupr!
  57   0 to dup-curr
  58   string:pad-cc@ 0 0 (include-no-refill)
  59   verbose-include? if ." included <: " .curr-file cr endif
  60   next-token expect-eol
  61 ;
  62
  63
  64 : inc-dup-label  ( -- )
  65   dup-curr dup->clabel@ ?dup if
  66     dup asm-labels:label->value@
  67     1+ swap asm-labels:label->value!
  68   endif
  69 ;
  70
  71 : do-edup  ( -- )
  72   next-token expect-eol
  73   dup-curr " EDUP without DUP" ?not-error
  74   dup-curr dup->count@ 1- dup +if
  75     dup-curr dup->count!
  76     dup-curr dup->line@ 1- dup-curr dup->fofs@ (INCLUDE-LINE-SEEK)
  77     refill-nocross " wuta?" ?not-error parse-skip-line  ;; skip EDUP
  78     next-token expect-eol
  79     inc-dup-label
  80   else drop dup-curr dup->prev@ to dup-curr endif
  81 ;
  82
  83 : do-dup  ( -- )
  84   next-token asm-expr:expression-const
  85   ;; check for label
  86   token-`,`? if next-token
  87     token-id? " label name expected" ?not-error
  88     token 0 asm-labels:define-var-simple-res next-token
  89   else  0
  90   endif expect-eol
  91   swap
  92   dup 1 65536 within " invalid DUP counter" ?not-error
  93   dup-size n-allot
  94   dup-curr over dup->prev! to dup-curr
  95   dup-curr dup->count!
  96   0 (INCLUDE-FILE-LINE) dup-curr dup->line!
  97   (INCLUDE-LINE-FOFS) dup-curr dup->fofs!
  98   dup-curr dup->clabel!
  99 ;
 100
 101 prev-defs
 102
 103
 104 also-defs: asm-instr
 105
 106 : INCLUDE  ( -- )  asm-helpers:do-include ;
 107 ALIAS-FOR INCLUDE IS $INCLUDE
 108
 109 : EDUP  ( -- )  asm-helpers:do-edup ;
 110
 111 ;;WARNING! THIS MUST BE THE LAST ONE!
 112 : $DUP  ( -- )  asm-helpers:do-dup ;
 113
 114 prev-defs