level0/urforth0_w_termio_high.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_defer "EMIT",emit,paremit
  19 ;; ( ch -- )
  20
  21 urword_defer "CR",cr,parcr
  22 ;; ( -- )
  23
  24 urword_defer "BELL",bell,parbell
  25 ;; ( -- )
  26
  27 urword_defer "ENDCR",endcr,parendcr
  28 ;; ( -- )
  29
  30 ;; should "ENDCR" do "CR"?
  31 urword_defer "?ENDCR",qendcr,parqendcr
  32 ;; ( -- flag )
  33
  34 urword_defer "RESET-EMITCOL",reset_emitcol,par_reset_emitcol
  35 ;; ( -- )
  36
  37 urword_defer "KEY",key,pargetch
  38 ;; ( -- ch )
  39
  40
  41 urword_forth "SAFE-EMIT",safeemit
  42 ;; ( ch -- )
  43   UF 0xff and
  44   UF dup 32 less
  45   ur_if
  46     ;; < 32: allow tab, cr, lf
  47     UF dup 9 equal
  48     UF over 10 equal or
  49     UF over 13 equal or
  50     ur_ifnot
  51       UF drop 63
  52     ur_endif
  53   ur_else
  54     UF dup 127 equal
  55     ur_if
  56       UF drop 63
  57     ur_endif
  58   ur_endif
  59   UF emit
  60 urword_end
  61
  62
  63 urword_forth "TYPE-WITH",par_type_with
  64 ;; ( addr length emitcfa -- )
  65   UF rpush
  66   ur_begin
  67     UF dup 0great
  68   ur_while
  69     UF swap dup cpeek rpeek execute 1inc swap 1dec
  70   ur_repeat
  71   UF 2drop rdrop
  72 urword_end
  73
  74 urword_forth "TYPE",type
  75 ;; ( addr length -- )
  76   UF cfalit emit par_type_with
  77 urword_end
  78
  79 urword_forth "SAFE-TYPE",safetype
  80 ;; ( addr length -- )
  81   UF cfalit safeemit par_type_with
  82 urword_end
  83
  84 urword_forth "SPACE",space
  85 ;; ( -- )
  86   UF 32 emit
  87 urword_end
  88
  89 urword_forth "SPACES",spaces
  90 ;; ( n -- )
  91   UF dup 0great
  92   ur_if
  93     UF 0
  94     ur_do
  95       UF space
  96     ur_loop
  97   ur_else
  98     UF drop
  99   ur_endif
 100 urword_end
 101
 102 urword_forth "TYPE-ASCIIZ",type_asciiz
 103 ;; ( addr -- )
 104 ;; type asciiz string
 105   UF zcount type
 106 urword_end
 107
 108 urword_forth "SAFE-TYPE-ASCIIZ",safetype_asciiz
 109 ;; ( addr -- )
 110 ;; type asciiz string
 111   UF zcount safetype
 112 urword_end