level0/urforth0_w_errors.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 ERR_UNKNOWN_WORD = 0
  19 ERR_STACK_UNDERFLOW = 1
  20 ERR_STACK_OVERFLOW = 2
  21 ERR_R_STACK_UNDERFLOW = 3
  22 ERR_R_STACK_OVERFLOW = 4
  23 ERR_OUT_OF_MEMORY = 5
  24 ERR_WORD_REDEFINED = 6
  25 ERR_FILE_NOT_FOUND = 7
  26 ERR_FILE_READ_ERROR = 8
  27 ERR_FILE_WRITE_ERROR = 9
  28 ERR_FILE_TOO_BIG = 10
  29 ERR_COMPILATION_ONLY = 11
  30 ERR_EXECUTION_ONLY = 12
  31 ERR_UNPAIRED_CONDITIONALS = 13
  32 ERR_UNFINISHED_DEFINITION = 14
  33 ERR_IN_PROTECTED_DICT = 15  ; for "forget"
  34 ERR_NOT_DEFER = 16
  35 ERR_INVALID_WORD_NAME = 17
  36 ERR_WORD_EXPECTED = 18
  37 ERR_INVALID_TEMP_POOL_RELEASE = 19
  38 ERR_OUT_OF_TEMP_POOL = 20
  39 ERR_INVALID_TEMP_POOL_ALLOCATION = 21
  40 ERR_VOCABULARY_STACK_OVERFLOW = 22
  41 ERR_CHAR_EXPECTED = 23
  42 ERR_STRING_EXPECTED = 24
  43 ERR_NUMBER_EXPECTED = 25
  44 ERR_VOCABULARY_EXPECTED = 26
  45 ERR_INVALID_BREAK_CONT = 27
  46 ERR_NONNAKED_SYSTEM = 28
  47 ERR_NOT_IMPLEMENTED = 29
  48 ERR_NEGATIVE_ALLOT = 30
  49 ERR_NO_TEMP_HERE = 31
  50 ERR_TEMP_HERE_ALREADY = 32
  51 ERR_CANNOT_OVERRIDE = 33
  52 ERR_CANNOT_REPLACE = 34
  53 ERR_INPUT_TOO_LONG = 35
  54 ERR_THROW_WITHOUT_CATCH = 36
  55 ERR_THROW_CHAIN_CORRUPTED = 37
  56 ERR_UNBALANCED_IFDEF = 38
  57 ERR_ELLIPSIS_FORTH = 39
  58 ERR_ELLIPSIS_FIRST = 40
  59 ERR_NONMACRO_ONLY  = 60
  60 ERR_STRING_TOOLONG  = 61
  61 ERR_USER_ERROR = 69
  62
  63 urword_const "ERR-UNKNOWN-WORD",errid_unknown_word,ERR_UNKNOWN_WORD
  64 urword_const "ERR-STACK-UNDERFLOW",errid_stack_underflow,ERR_STACK_UNDERFLOW
  65 urword_const "ERR-STACK-OVERFLOW",errid_stack_overflow,ERR_STACK_OVERFLOW
  66 urword_const "ERR-R-STACK-UNDERFLOW",errid_r_stack_underflow,ERR_R_STACK_UNDERFLOW
  67 urword_const "ERR-R-STACK-OVERFLOW",errid_r_stack_overflow,ERR_R_STACK_OVERFLOW
  68 urword_const "ERR-OUT-OF-MEMORY",errid_out_of_memory,ERR_OUT_OF_MEMORY
  69 urword_const "ERR-WORD-REDEFINED",errid_word_redefined,ERR_WORD_REDEFINED
  70 urword_const "ERR-FILE-NOT-FOUND",errid_file_not_found,ERR_FILE_NOT_FOUND
  71 urword_const "ERR-FILE-READ-ERROR",errid_file_read_error,ERR_FILE_READ_ERROR
  72 urword_const "ERR-FILE-WRITE-ERROR",errid_file_write_error,ERR_FILE_WRITE_ERROR
  73 urword_const "ERR-FILE-TOO-BIG",errid_file_too_big,ERR_FILE_TOO_BIG
  74 urword_const "ERR-COMPILATION-ONLY",errid_compilation_only,ERR_COMPILATION_ONLY
  75 urword_const "ERR-EXECUTION-ONLY",errid_execution_only,ERR_EXECUTION_ONLY
  76 urword_const "ERR-UNPAIRED-CONDITIONALS",errid_unpaired_conditionals,ERR_UNPAIRED_CONDITIONALS
  77 urword_const "ERR-UNFINISHED-DEFINITION",errid_unfinished_definition,ERR_UNFINISHED_DEFINITION
  78 urword_const "ERR-IN-PROTECTED-DICT",errid_in_protected_dict,ERR_IN_PROTECTED_DICT
  79 urword_const "ERR-NOT-DEFER",errid_not_defer,ERR_NOT_DEFER
  80 urword_const "ERR-INVALID-WORD-NAME",errid_invalid_word_name,ERR_INVALID_WORD_NAME
  81 urword_const "ERR-WORD-EXPECTED",errid_word_expected,ERR_WORD_EXPECTED
  82 urword_const "ERR-INVALID-TEMP-POOL-RELEASE",errid_invalid_temp_pool_release,ERR_INVALID_TEMP_POOL_RELEASE
  83 urword_const "ERR-OUT-OF-TEMP-POOL",errid_out_of_temp_pool,ERR_OUT_OF_TEMP_POOL
  84 urword_const "ERR-INVALID-TEMP-POOL-ALLOCATION",errid_invalid_temp_pool_allocation,ERR_INVALID_TEMP_POOL_ALLOCATION
  85 urword_const "ERR-VOCABULARY-STACK-OVERFLOW",errid_voc_stack_overflow,ERR_VOCABULARY_STACK_OVERFLOW
  86 urword_const "ERR-CHAR-EXPECTED",errid_char_expected,ERR_CHAR_EXPECTED
  87 urword_const "ERR-STRING-EXPECTED",errid_string_expected,ERR_STRING_EXPECTED
  88 urword_const "ERR-NUMBER-EXPECTED",errid_number_expected,ERR_NUMBER_EXPECTED
  89 urword_const "ERR-VOCABULARY-EXPECTED",errid_vocab_expected,ERR_VOCABULARY_EXPECTED
  90 urword_const "ERR-INVALID-BREAK-CONT",errid_bad_break_cont,ERR_INVALID_BREAK_CONT
  91 urword_const "ERR-NONNAKED-SYSTEM",errid_nonnaked_system,ERR_NONNAKED_SYSTEM
  92 urword_const "ERR-NOT-IMPLEMENTED",errid_not_implemented,ERR_NOT_IMPLEMENTED
  93 urword_const "ERR-NEGATIVE-ALLOT",errid_negative_allot,ERR_NEGATIVE_ALLOT
  94 urword_const "ERR-NO-TEMP-HERE",errid_no_temp_here,ERR_NO_TEMP_HERE
  95 urword_const "ERR-TEMP-HERE-ALREADY",errid_temp_here_already,ERR_TEMP_HERE_ALREADY
  96 urword_const "ERR-CANNOT-OVERRIDE",errid_cannot_override,ERR_CANNOT_OVERRIDE
  97 urword_const "ERR-CANNOT-REPLACE",errid_cannot_replace,ERR_CANNOT_REPLACE
  98 urword_const "ERR-INPUT-TOO-LONG",errid_input_too_long,ERR_INPUT_TOO_LONG
  99 urword_const "ERR-THROW-WITHOUT-CATCH",errid_throw_without_catch,ERR_THROW_WITHOUT_CATCH
 100 urword_const "ERR-THROW-CHAIN-CORRUPTED",errid_throw_chain_corrupted,ERR_THROW_CHAIN_CORRUPTED
 101 urword_const "ERR-UNBALANCED-IFDEF",errid_unbalanced_ifdef,ERR_UNBALANCED_IFDEF
 102 urword_const "ERR-USER-ERROR",errid_user_error,ERR_USER_ERROR
 103 urword_const "ERR-ELLIPSIS-FORTH",errid_ellipsis_forth,ERR_ELLIPSIS_FORTH
 104 urword_const "ERR-ELLIPSIS-FIRST",errid_ellipsis_first,ERR_ELLIPSIS_FIRST
 105 urword_const "ERR-NONMACRO-ONLY",errid_nonmacro_only,ERR_NONMACRO_ONLY
 106 urword_const "ERR-STRING-TOO-LONG",errid_string_toolong,ERR_STRING_TOOLONG
 107
 108 urword_forth "(FIND-MESSAGE)",par_find_message
 109 urword_hidden
 110 ;; ( id tbladdr -- addr count 1 )
 111 ;; ( id tbladdr -- id         0 )
 112   UF swap rpush
 113   ur_begin
 114     UF dup wpeek
 115   ur_while
 116     UF dup cpeek rpeek equal
 117     ur_if
 118       ; i found her!
 119       UF rdrop 1inc zcount 1 exit
 120     ur_endif
 121     ; skip
 122     UF 1inc zcount + 1inc
 123   ur_repeat
 124   UF drop rpop 0
 125 urword_end
 126
 127
 128 urword_var "(ERROR-MSG-TABLE)",par_err_msg_table
 129 urword_hidden
 130   db ERR_UNKNOWN_WORD,"pardon?",0
 131   db ERR_STACK_UNDERFLOW,"stack underflow",0
 132   db ERR_STACK_OVERFLOW,"stack overflow",0
 133   db ERR_R_STACK_UNDERFLOW,"return stack underflow",0
 134   db ERR_R_STACK_OVERFLOW,"return stack overflow",0
 135   db ERR_OUT_OF_MEMORY,"out of memory",0
 136   db ERR_WORD_REDEFINED,"is not unique",0
 137   db ERR_FILE_NOT_FOUND,"file not found",0
 138   db ERR_FILE_READ_ERROR,"file read error",0
 139   db ERR_FILE_WRITE_ERROR,"file write error",0
 140   db ERR_FILE_TOO_BIG,"file too big",0
 141   db ERR_COMPILATION_ONLY,"compilation only",0
 142   db ERR_EXECUTION_ONLY,"execution only",0
 143   db ERR_UNPAIRED_CONDITIONALS,"conditionals not paired",0
 144   db ERR_UNFINISHED_DEFINITION,"definition not finished",0
 145   db ERR_IN_PROTECTED_DICT,"in protected dictionary",0
 146   db ERR_NOT_DEFER,"not a DEFER word",0
 147   db ERR_INVALID_WORD_NAME,"invalid word name",0
 148   db ERR_WORD_EXPECTED,"known word expected",0
 149   db ERR_INVALID_TEMP_POOL_RELEASE,"invalid temp pool release",0
 150   db ERR_OUT_OF_TEMP_POOL,"out of memory for temp pool",0
 151   db ERR_INVALID_TEMP_POOL_ALLOCATION,"invalid temp pool request",0
 152   db ERR_VOCABULARY_STACK_OVERFLOW,"vocabulary stack overflow",0
 153   db ERR_CHAR_EXPECTED,"character expected",0
 154   db ERR_STRING_EXPECTED,"string expected",0
 155   db ERR_INVALID_BREAK_CONT,"invalid break/continue",0
 156   db ERR_NONNAKED_SYSTEM,"non-naked system",0
 157   db ERR_NOT_IMPLEMENTED,"not implemented",0
 158   db ERR_NEGATIVE_ALLOT,"negative ALLOT is not allowed",0
 159   db ERR_NO_TEMP_HERE,"not allowed in transient HERE",0
 160   db ERR_TEMP_HERE_ALREADY,"transient HERE already in use",0
 161   db ERR_CANNOT_OVERRIDE,"cannot override non-Forth word",0
 162   db ERR_CANNOT_REPLACE,"no code space to replace word",0
 163   db ERR_INPUT_TOO_LONG,"input too long",0
 164   db ERR_THROW_WITHOUT_CATCH,"THROW without CATCH",0
 165   db ERR_THROW_CHAIN_CORRUPTED,"THROW chain corrupted",0
 166   db ERR_UNBALANCED_IFDEF,"unbalanced ifdefs",0
 167   db ERR_ELLIPSIS_FORTH,"`...` must be in a Forth word",0
 168   db ERR_ELLIPSIS_FIRST,"`...` must be the first in a Forth word",0
 169   db ERR_USER_ERROR,"user-defined error",0
 170   db ERR_NONMACRO_ONLY,"definition must be non-macro",0
 171   db ERR_STRING_TOOLONG,"string too long",0
 172   db 0,0
 173 urword_end_array
 174
 175
 176 urword_forth "ERROR-MESSAGE",error_message
 177   ; error 0 is "unknown word"; usually called with the word in HERE
 178   ; the word should be already dumped, and we won't show the usual "ERROR:" prompt
 179   UF dup errid_unknown_word equal
 180   ur_if
 181     ; unknown word
 182     UF par_err_msg_table par_find_message
 183     ur_ifnot
 184       UF drop strlit "pardon?"
 185     ur_endif
 186     UF 63 emit space type
 187   ur_else
 188     ; look for error message in the table
 189     UF qendcr
 190     ur_if
 191       UF space
 192     ur_endif
 193     UF pardottype "ERROR"
 194     UF par_err_msg_table par_find_message
 195     ur_if
 196       UF pardottype ": " type
 197     ur_else
 198       UF pardottype " #"
 199       UF base @ swap decimal 0 dotr base !
 200     ur_endif
 201   ur_endif
 202 urword_end
 203
 204
 205 urword_forth "ERROR-LINE.",error_line_dot
 206   ;UF tib_calc_currline qdup
 207   UF tiblineno @ qdup
 208   ur_if
 209     UF pardottype " around line #"
 210     ;; if we just read CR, go back one line
 211     UF par_last_read_char @ dup 10 equal swap 13 equal or
 212     ur_if
 213       UF 1dec 1 max
 214     ur_endif
 215     UF base @ rpush decimal dot rpop base !
 216     UF par_tib_curr_fname count qdup
 217     ur_if
 218       UF pardottype 'of file "' type 34 emit space
 219     ur_else
 220       UF drop
 221     ur_endif
 222   ur_endif
 223 urword_end
 224
 225 urword_forth "(ERROR)",par_error
 226 urword_noreturn
 227 urword_hidden
 228 ;; ( code )
 229     ;ur_bp
 230   UF decimal  ; because why not
 231   UF error_message
 232   UF error_line_dot
 233   ; print stacks depth
 234     UF base @ rpush decimal
 235     UF pardottype " D:"
 236     UF sp0 @ spget - 2 sar dot
 237     UF pardottype "R:"
 238     UF rp0 @ rpget - 2 sar dot
 239     ;UF pardottype ")"
 240     UF cr
 241     UF rpop base !
 242   UF cr abort
 243   ;; just in case it returns
 244   UF 1 nbye
 245 urword_end
 246
 247
 248 urword_forth "?ERROR",qerror
 249 ;; ( flag code -- )
 250 ;; issue an error message number n, if the boolean flag is true
 251   UF swap
 252   ur_if
 253     UF error
 254   ur_endif
 255   UF drop
 256 urword_end
 257
 258
 259 urword_forth "(ABORT-CLEANUP)",par_abort_cleanup
 260 urword_hidden
 261   UF spset0
 262   UF rpeek rpset0
 263   UF state 0poke
 264   UF temp_pool_reset
 265   UF debug_info_reset
 266   UF tload_verbose_default
 267   urto tload_verbose
 268   UF dp_temp 0poke
 269   UF rpush
 270 urword_end
 271
 272 urword_forth "(ABORT)",par_abort
 273 urword_noreturn
 274 urword_hidden
 275   UF abort_cleanup
 276   UF main_loop
 277   ;; just in case it returns
 278   UF bye
 279 urword_end
 280
 281
 282 urword_forth ".STACK",dotstack
 283 ;; dump data stack (unlimited depth)
 284   UF depth dup 0 less
 285   ur_if
 286     UF pardottype "stack underflowed" cr drop exit
 287   ur_endif
 288   UF qdup
 289   ur_ifnot
 290     UF pardottype "stack empty" cr exit
 291   ur_endif
 292   UF dup pardottype "stack depth: " dot cr
 293   UF 0
 294   ur_do
 295     UF depth 1dec i - pick
 296     UF dup dot pardottype "| " udot cr
 297   ur_loop
 298 urword_end