PageRenderTime 26ms CodeModel.GetById 1ms RepoModel.GetById 0ms app.codeStats 0ms

/support/z88/errors.fth

https://bitbucket.org/garryl/camelforth
Forth | 67 lines | 56 code | 11 blank | 0 comment | 2 complexity | 8505193e6f9750968ded1969029c55d3 MD5 | raw file
Possible License(s): GPL-3.0 
    

  1. \ ****************************************************************************
    2. 

  2. \ CamelForth for the Zilog Z80
    3. 

  3. \ Copyright (c) 1994,1995 Bradford J. Rodriguez
    4. 

  4. \ With contributions by Douglas Beattie Jr., 1998
    5. 

  5. \ Widely extended and reorganised by Garry Lancaster, 1999-2014
    6. 

  6. \ Z88, Sprinter, ZX Spectrum +3/+3e ports by Garry Lancaster, 1999-2014
    7. 

  7. \
    8. 

  8. \ This program is free software; you can redistribute it and/or modify
    9. 

  9. \ it under the terms of the GNU General Public License as published by
    10. 

  10. \ the Free Software Foundation; either version 3 of the License, or
    11. 

  11. \ (at your option) any later version.
    12. 

  12. \
    13. 

  13. \ This program is distributed in the hope that it will be useful,
    14. 

  14. \ but WITHOUT ANY WARRANTY; without even the implied warranty of
    15. 

  15. \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16. 

  16. \ GNU General Public License for more details.
    17. 

  17. \
    18. 

  18. \ You should have received a copy of the GNU General Public License
    19. 

  19. \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
    20. 

  20. \ ****************************************************************************
    21. 

  21. 

  22. CR .( Loading error reporting...)
    23. 

  23. 

  24. HEX
    25. 

  25. 

  26. CODE GN_ESP ( rc -- addr x )
    27. 

  27.   79 C,              \ ld a,c
    28. 

  28.   E7 C, 4C09 ,       \ call_oz(gn_esp)
    29. 

  29.   E5 C,              \ push hl
    30. 

  30. NEXT
    31. 

  31. 

  32. CODE GN_RBE ( addr x -- addr' x c )
    33. 

  33.   E1 C,              \ pop hl  (BHL=extended address)
    34. 

  34.   E7 C, 3E09 ,       \ call_oz(gn_rbe)
    35. 

  35.   23 C,              \ inc hl
    36. 

  36.   E5 C,              \ push hl
    37. 

  37.   C5 C,              \ push bc
    38. 

  38.   4F C,              \ ld c,a
    39. 

  39.   06 C, 00 C,        \ ld b,0  (TOS=char)
    40. 

  40. NEXT
    41. 

  41. 

  42. DECIMAL
    43. 

  43. 

  44. : .OZERR ( rc -- )
    45. 

  45.    GN_ESP BEGIN  GN_RBE ?DUP  WHILE  EMIT  REPEAT  2DROP ;
    46. 

  46. 

  47. : .ANYERROR ( rc -- )
    48. 

  48.      CASE -35 OF  ." Invalid block"  ENDOF
    49. 

  49.           -49 OF  ." Search-order overflow"  ENDOF
    50. 

  50.           -4095 OF  ." Non-fastable word: " ABORT"S 2@ TYPE  ENDOF
    51. 

  51.           -4094 OF  ." Input nesting error"  ENDOF
    52. 

  52.           -4093 OF  ." Region error"  ENDOF
    53. 

  53.           -4092 OF  ." Blocks already allocated"  ENDOF
    54. 

  54. 

  55.           DUP NEGATE 256 /MOD  ( rc -rclo -rchi )
    56. 

  56.           CASE  1 OF  .OZERR  ENDOF
    57. 

  57.                 2 OF  ." Package "
    58. 

  58.                       BASE @ HEX SWAP . BASE !
    59. 

  59.                       ." not found"
    60. 

  60.                   ENDOF
    61. 

  61.                 
    62. 

  62.                 NIP OVER (.ERR)
    63. 

  63.           ENDCASE
    64. 

  64.      ENDCASE ;
    65. 

  65. 

  66. ' .ANYERROR IS .ERROR
    67. 

    68. 

  68.