level0/urforth0_w_compiler_helpers.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18 urword_var "(CSP)",csp,0
  19 urword_hidden
  20
  21 urword_forth "!CSP",savecsp
  22   UF spget csp !
  23 urword_end
  24
  25 urword_forth "?CSP",qcsp
  26 ;; ( -- )
  27   UF spget csp @ - errid_unfinished_definition qerror
  28 urword_end
  29
  30 urword_forth "?COMP",qcomp
  31   UF state @ 0 equal errid_compilation_only qerror
  32 urword_end
  33
  34 urword_forth "?EXEC",qexec
  35   UF state @ errid_execution_only qerror
  36 urword_end
  37
  38
  39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40 urword_forth "LITERAL",literal
  41 urword_immediate
  42   UF state @
  43   ur_if
  44     urcompile lit
  45     UF ,
  46   ur_endif
  47 urword_end
  48
  49 urword_forth "COMPILE,",compile_comma
  50 urword_arg_cfa
  51 ;; ( cfa -- )
  52   UF ,
  53 urword_end
  54
  55
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ; write 4-byte displacement for CALL/JMP jmpdest instruction to addr
  58 ; addr should point after the instruction, at the first displacement byte
  59 urword_forth "(DISP32!)",par_disp32set
  60 urword_hidden
  61 ;; ( jmpdest addr -- )
  62   UF dup cellinc rot swap - swap !
  63 urword_end
  64
  65 urword_forth "(DISP32@)",par_disp32get
  66 urword_hidden
  67 ;; ( addr -- jumpdest )
  68   UF dup @ swap cellinc +
  69 urword_end
  70
  71 ; write 5-byte CALL calldest machine instruction to addr
  72 urword_forth "(CALL!)",par_callset
  73 urword_hidden
  74 ;; ( calldest addr -- )
  75   UF 0xe8 over cpoke 1inc  ; write CALL, advance address
  76   UF par_disp32set
  77 urword_end
  78
  79 ; write 5-byte JMP jmpdest machine instruction to addr
  80 urword_forth "(JMP!)",par_jmpset
  81 urword_hidden
  82 ;; ( jmpdest addr -- )
  83   UF 0xe9 over cpoke 1inc  ; write JMP, advance address
  84   UF par_disp32set
  85 urword_end
  86
  87 ; compile 5-byte CALL calldest machine instruction to HERE
  88 urword_forth "(CALL,)",par_callcomma
  89 urword_hidden
  90 ;; ( calldest -- )
  91   UF 5 n_allot par_callset
  92 urword_end
  93
  94 ; compile 5-byte JMP jmpdest machine instruction to HERE
  95 urword_forth "(JMP,)",par_jmpcomma
  96 urword_hidden
  97 ;; ( jmpdest -- )
  98   UF 5 n_allot par_jmpset
  99 urword_end