jkotlinski · jkotlinski · Dec 27, 2024 · Dec 15, 2024 · Dec 15, 2024 · Dec 15, 2024
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -6,8 +6,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 ### Added
+ - Exception support with CATCH and THROW.
+ - ABORT and ABORT" throw exceptions -1 and -2.
  - S" now works in interpretation mode. It returns a transient buffer.
- - STRING, stores a counted string.
+ - 0> to compat.
 ### Fixed
  - V: crash when entering ":w!"
 

diff --git a/Makefile b/Makefile
@@ -23,7 +23,7 @@ SRC_NAMES = base debug v asm gfx gfxdemo rnd sin ls turtle fractals \
     wordlist io open dos see accept
 SRCS = $(addprefix $(SRC_DIR)/,$(addsuffix .fs,$(SRC_NAMES)))
 
-TEST_SRC_NAMES = test testcore testcoreplus testcoreext tester testsee 1
+TEST_SRC_NAMES = test testcore testcoreplus testcoreext testexception tester testsee 1
 TEST2_SRC_NAMES = see gfx gfxdemo fractals mmldemo mml sid spritedemo sprite compat rnd sin turtle
 TEST_SRCS = $(addprefix test/,$(addsuffix .fs,$(TEST_SRC_NAMES)))
 
@@ -90,7 +90,7 @@ docs: docs/index.html
 
 docs/index.html: manual/index.adoc manual/words.adoc manual/links.adoc manual/sid.adoc manual/asm.adoc \
 	manual/mnemonics.adoc manual/memmap.adoc manual/anatomy.adoc LICENSE.txt manual/tutorial.adoc \
-	manual/intro.adoc
+	manual/intro.adoc manual/exceptions.adoc
 	rm -rf docs
 	asciidoctor -a revnumber=$(shell git describe --tags --dirty) -a revdate=$(shell git log -1 --format=%as) -o docs/index.html manual/index.adoc
 

diff --git a/asm/compiler.asm b/asm/compiler.asm
@@ -151,7 +151,8 @@ HEADER ; ( "name" -- )
     ; Abort if empty string.
     lda LSB - 2, x
     bne +
-    jmp .on_stack_underflow ; "err"
+    lda #-16 ; attempt to use zero-length string as a name
+    jmp throw_a
 +   sta .putlen+1
 
     ; Move back [W]LATEST.

diff --git a/asm/disk.asm b/asm/disk.asm
@@ -269,7 +269,8 @@ INCLUDED
     jsr READST
     beq +
     jsr _errorchread
-    jmp ABORT
+    lda #-37 ; file i/o exception
+    jmp throw_a
 +
     pla
     tax

diff --git a/asm/durexforth.asm b/asm/durexforth.asm
@@ -156,6 +156,7 @@ MINUS_ONE
 !src "io.asm"
 !src "lowercase.asm"
 !src "disk.asm"
+!src "exception.asm"
 !src "format.asm"
 
 BOOT_STRING

diff --git a/asm/exception.asm b/asm/exception.asm
@@ -0,0 +1,171 @@
+; CATCH THROW (ABORT")
+
+EXCEPTION_HANDLER
+    +VALUE _EXCEPTION_HANDLER
+_EXCEPTION_HANDLER
+    !word 0
+
++BACKLINK "catch", 5
+CATCH
+    ; save data stack pointer
+    txa
+    jsr pushya
+    jsr TO_R
+    ; save previous handler
+    jsr EXCEPTION_HANDLER
+    jsr FETCH
+    jsr TO_R
+    ; set current handler
+    stx W
+    tsx
+    txa
+    ldx W
+    jsr pushya
+    jsr EXCEPTION_HANDLER
+    jsr STORE
+    ; execute returns if no THROW
+    jsr EXECUTE
+    ; restore previous handler
+    jsr R_TO
+    jsr EXCEPTION_HANDLER
+    jsr STORE
+    ; discard saved stack pointer
+    jsr R_TO
+    inx ; drop
+    ; normal completion
+    jmp ZERO
+
++BACKLINK "throw", 5
+THROW
+    lda LSB,x
+    ora MSB,x
+    bne +
+    ; 0 throw is no-op
+    inx
+    rts
++   lda _EXCEPTION_HANDLER + 1
+    beq .print_error_and_abort
+
+    ; restore previous return stack
+    jsr EXCEPTION_HANDLER
+    jsr FETCH
+    stx W
+    lda LSB,x
+    tax
+    txs
+    ldx W
+    inx
+
+    ; restore previous handler
+    jsr R_TO
+    jsr EXCEPTION_HANDLER
+    jsr STORE
+
+    ; exc# on return stack
+    jsr R_TO
+    jsr SWAP
+    jsr TO_R
+
+    ; restore stack
+    lda LSB,x
+    tax
+    inx
+    jsr R_TO
+    rts
+
+.print_error_and_abort
+    lda MSB,x
+    cmp #-1
+    bne .unknown_exception
+    lda LSB,x
+    cmp #-13 ; Undefined word is printed before THROW.
+    beq .cr_and_abort
+    cmp #-37 ; File I/O errors are printed before THROW.
+    beq .cr_and_abort
+    cmp #-2 ; abort"
+    bne +
+    jsr .get_abort_string
+    jmp .type_and_abort
++   jsr .get_system_exception_string
+    jsr COUNT
+.type_and_abort
+    jsr RVS
+    jsr TYPE
+.cr_and_abort
+    jsr CR
+    ldx #X_INIT
+    jmp QUIT
+
+; It is a bit cheesy to use a hardcoded list, but it works.
+; A linked list would be more flexible.
+.get_system_exception_string
+    cmp #-1
+    bne +
+    +VALUE .abort_string
++   cmp #-4
+    bne +
+    +VALUE .stack_underflow
++   cmp #-8
+    bne +
+    +VALUE .mem_full
++   cmp #-10
+    bne +
+    +VALUE .div_error
++   cmp #-16
+    bne +
+    +VALUE .no_word
++   cmp #-28
+    bne .unknown_exception
+    +VALUE .user_interrupt
+
+.unknown_exception
+    jsr RVS
+    jsr DOT
+    lda #'e'
+    jsr PUTCHR
+    lda #'r'
+    jsr PUTCHR
+    jsr PUTCHR
+    jmp .cr_and_abort
+
+.get_abort_string
+.msg_lsb = * + 1
+    lda #0
+.msg_msb = * + 1
+    ldy #0
+    jsr pushya
+.msg_len = * + 1
+    lda #0
+    ldy #0
+    jmp pushya
+
+.abort_string
+    !byte 5
+    !text "abort"
+.stack_underflow
+    !byte 5
+    !text "stack"
+.mem_full
+    !byte 4
+    !text "full"
+.no_word
+    !byte 7
+    !text "no name"
+.div_error
+    !byte 2
+    !text "/0" ; division by zero
+.user_interrupt
+    !byte 3
+    !text "brk"
+
++BACKLINK "(abort\")", 8 ; ( addr u -- )
+    lda LSB,x
+    sta .msg_len
+    inx
+    lda LSB,x
+    sta .msg_lsb
+    lda MSB,x
+    sta .msg_msb
+    inx
+    lda #-2
+    jmp throw_a
diff --git a/asm/header.py b/asm/header.py
@@ -19,7 +19,12 @@ def verify(path):
     for line in lines:
         if "+BACKLINK" not in line:
             continue
-        words += [line.split('"')[1].rsplit('"')[0].upper()]
+        start = line.find('"') + 1
+        end = line.rfind('"')
+        word = line[start:end]
+        word = word.replace('\\"', '"')
+        word = word.upper()
+        words += [word]
 
     if not words:
         return