Merge pull request #2 from pzembrod/master

Make C64 VolksForth plus a shim pass core.fr from ANS test suite.

6502/C64/Makefile

@@ -0,0 +1,61 @@
+
+# This Makefile and the build scripts in the emulator/ subdir require
+# the file format conversion tools from the tools/ subdir of
+# https://github.com/pzembrod/cc64 to be installed.
+
+vf_blk_d64_files = $(wildcard disks/*.d64)
+vf_blk_fth_files = $(patsubst %.d64, %.fth, $(vf_blk_d64_files))
+
+test_files = $(wildcard tests/*.f*)
+test_files_petscii = $(patsubst tests/%, cbmfiles/%, $(test_files))
+
+
+# Target to convert all .d64 images into .fth files for easier reading.
+vf_blk_fth: $(vf_blk_fth_files)
+
+
+# Convenience targets
+
+run-devenv: emulator/devenv.T64
+	emulator/run-in-vice.sh devenv
+
+run-testbase: emulator/testbase.T64
+	emulator/run-in-vice.sh testbase
+
+run-tests: emulator/testbase.T64 $(test_files_petscii)
+	emulator/run-in-vice.sh testbase \
+	  "include run-vf-tests.fth\n"
+
+
+# Rules for building Forth binaries on top of the plain vanilla
+# c64-volksforth83.
+
+cbmfiles/devenv: emulator/run-in-vice.sh emulator/build-devenv.sh \
+    emulator/c64-volksforth83.T64 \
+     disks/vforth4_1.d64  disks/vforth4_3.d64  disks/file-words.d64
+	emulator/build-devenv.sh
+
+cbmfiles/testbase: emulator/run-in-vice.sh emulator/build-testbase.sh \
+    emulator/c64-volksforth83.T64 disks/file-words.d64
+	emulator/build-testbase.sh
+
+
+# Generic T64 tape image rule
+
+emulator/%.T64: cbmfiles/%
+	bin2t64 $< $@
+
+
+# Generic rule for populating cbmfiles/ with PETSCII text files
+
+cbmfiles/%.fth: tests/%.fth
+	ascii2petscii $< $@
+
+cbmfiles/%.fr: tests/%.fr
+	ascii2petscii $< $@
+
+
+# Generic rule for converting .d64 blk sources into .fth files.
+
+disks/%.fth: disks/%.d64
+	ufscr2file $< $@

6502/C64/cbmfiles/.gitignore

@@ -0,0 +1,3 @@
+*.fth
+core.fr
+notdone

6502/C64/emulator/.gitignore

@@ -0,0 +1 @@
+*.T64

6502/C64/emulator/build-devenv.sh

@@ -0,0 +1,16 @@
+#!/bin/bash
+set -e
+
+emulatordir="$(dirname "${BASH_SOURCE[0]}")"
+basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")"
+
+rm -f "${basedir}/cbmfiles/devenv"
+
+# load editor from vforth4_3.d64 block 19 in drive 10.
+# load savesystem from vforth4_1.d64 block 26 in drive 9.
+# load include and dos from file-words.d64 block 10 in drive 11.
+# savesystem and then scratch file notdone to exit emulator.
+keybuf="2 drive 19 load\n47 load\n1 drive 26 load\n3 drive 10 load\n\
+savesystem devenv\ndos s0:notdone\n"
+
+"${emulatordir}/run-in-vice.sh" "c64-volksforth83" "${keybuf}"

6502/C64/emulator/build-testbase.sh

@@ -0,0 +1,15 @@
+#!/bin/bash
+set -e
+
+emulatordir="$(dirname "${BASH_SOURCE[0]}")"
+basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")"
+
+rm -f "${basedir}/cbmfiles/testbase"
+
+# load savesystem w/o editor from file-words.d64 block 20 in drive 11.
+# load include and dos from file-words.d64 block 10 in drive 11.
+# savesystem and then scratch file notdone to exit emulator.
+keybuf="3 drive 20 load\n3 drive 10 load\n\
+savesystem testbase\ndos s0:notdone\n"
+
+"${emulatordir}/run-in-vice.sh" "c64-volksforth83" "${keybuf}"

6502/C64/emulator/notdone

@@ -0,0 +1,5 @@
+Flag file:
+Build or test processes running in VICE signal that they are done
+by scratching this file's copy from the cbmfiles/ dir.
+Corresponding build bash scripts watch for the existence of this
+file in cbmfiles/ and terminate VICE after the file disappeared.

6502/C64/emulator/run-in-vice.sh

@@ -0,0 +1,52 @@
+#!/bin/bash
+set -e
+
+emulatordir="$(realpath --relative-to="$PWD" "$(dirname "${BASH_SOURCE[0]}")")"
+basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")"
+
+autostart=""
+if [ -n "$1" ]
+then
+  autostart="-autostart ${emulatordir}/${1}.T64"
+fi
+
+keybuf=""
+warp=""
+if [ -n "$2" ]
+then
+  keybuf="${2}" # dos s0:notdone\n"
+  # The following could also just be a cp.
+  ascii2petscii "${emulatordir}/notdone" "${basedir}/cbmfiles/notdone"
+  warp="-warp"
+fi
+
+x64 \
+  -virtualdev \
+  +truedrive \
+  -drive8type 1541 \
+  -drive9type 1541 \
+  -drive10type 1541 \
+  -drive11type 1541 \
+  -fs8 "${basedir}/cbmfiles" \
+  -9 "${basedir}/disks/vforth4_1.d64" \
+  -10 "${basedir}/disks/vforth4_3.d64" \
+  -11 "${basedir}/disks/file-words.d64" \
+  -symkeymap "${emulatordir}/x11_sym_vf_de.vkm" \
+  -keymap 2 \
+  $autostart \
+  -keybuf "$keybuf" \
+  $warp \
+  &
+
+
+if [ -n "$keybuf" ]
+then
+  while [ -f "${basedir}/cbmfiles/notdone" ]
+    do sleep 1
+  done
+  sleep 0.5
+
+  kill %1
+fi
+
+wait %1 || echo "x64 returned $?"

6502/C64/emulator/x11_sym_vf_de.vkm

@@ -0,0 +1,371 @@
+# VICE keyboard mapping file
+#
+# A Keyboard map is read in as patch to the current map.
+#
+# File format:
+# - comment lines start with '#'
+# - keyword lines start with '!keyword'
+# - normal line has 'keysym/scancode row column shiftflag'
+#
+# Keywords and their lines are:
+# '!CLEAR'               clear whole table
+# '!INCLUDE filename'    read file as mapping file
+# '!LSHIFT row col'      left shift keyboard row/column
+# '!RSHIFT row col'      right shift keyboard row/column
+# '!VSHIFT shiftkey'     virtual shift key (RSHIFT or LSHIFT)
+# '!SHIFTL shiftkey'     shift lock key (RSHIFT or LSHIFT)
+# '!UNDEF keysym'        remove keysym from table
+#
+# Shiftflag can have the values:
+# 0      key is not shifted for this keysym/scancode
+# 1      key is shifted for this keysym/scancode
+# 2      left shift
+# 4      right shift
+# 8      key can be shifted or not with this keysym/scancode
+# 16     deshift key for this keysym/scancode
+# 32     another definition for this keysym/scancode follows
+# 64     shift lock
+# 256    key is used for an alternative keyboard mapping
+#
+# Negative row values:
+# 'keysym -1 n' joystick keymap A, direction n
+# 'keysym -2 n' joystick keymap B, direction n
+# 'keysym -3 0' first RESTORE key
+# 'keysym -3 1' second RESTORE key
+# 'keysym -4 0' 40/80 column key
+# 'keysym -4 1' CAPS (ASCII/DIN) key
+# 'keysym -5 n' joyport keypad, key n
+#
+# Joystick direction values:
+# 0      Fire
+# 1      South/West
+# 2      South
+# 3      South/East
+# 4      West
+# 5      East
+# 6      North/West
+# 7      North
+# 8      North/East
+#
+# Joyport keypad key layout:
+# --------------------------
+# |  0 |  1 |  2 |  3 |  4 |
+# --------------------------
+# |  5 |  6 |  7 |  8 |  9 |
+# --------------------------
+# | 10 | 11 | 12 | 13 | 14 |
+# --------------------------
+# | 15 | 16 | 17 | 18 | 19 |
+# --------------------------
+#
+# When a bigger spaced key is used,
+# it uses the upper left most key value.
+
+# Symbolic Mapping, German Layout, C64, X11
+
+#       +-----+-----+-----+-----+-----+-----+-----+-----+
+#       |Bit 0|Bit 1|Bit 2|Bit 3|Bit 4|Bit 5|Bit 6|Bit 7|
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 0| DEL |Retrn|C_L/R|  F7 |  F1 |  F3 |  F5 |C_U/D|
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 1| 3 # |  W  |  A  | 4 $ |  Z  |  S  |  E  | S_L |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 2| 5 % |  R  |  D  | 6 & |  C  |  F  |  T  |  X  |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 3| 7 ' |  Y  |  G  | 8 ( |  B  |  H  |  U  |  V  |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 4| 9 ) |  I  |  J  |  0  |  M  |  K  |  O  |  N  |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 5|  +  |  P  |  L  |  -  | . > | : [ |  @  | , < |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 6|POUND|  *  | ; ] | HOME| S_R |  =  | A_UP| / ? |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+# |Bit 7| 1 ! |A_LFT| CTRL| 2 " |SPACE|  C= |  Q  | R/S |
+# +-----+-----+-----+-----+-----+-----+-----+-----+-----+
+
+!CLEAR
+!LSHIFT 1 7
+!RSHIFT 6 4
+!VSHIFT RSHIFT
+!SHIFTL LSHIFT
+
+# keys that can't be mapped symbolically are:
+# (row0) arrow left (-> end), pound (-> ), clr/home (-> home)
+# (row1) restore (-> F12)
+# (row2) run/stop (-> escape)
+# (row3) commodore (-> control)
+
+# extra keys are:
+# clr/home (-> altgr+\)
+# ins/del (-> delete)
+# ins/del+shift (-> insert)
+# arrow left (-> underscore, ssharp, altgr+~)
+# arrow up+shift (-> altgr+m)
+# f1 (-> page up)
+# f7 (-> page down)
+# : (-> oe)
+# :+shift (-> OE, altgr+[)
+# ; (-> ae)
+# ;+shift (-> AE, altgr+])
+# @ (-> ue, altgr+Q)
+# @+shift (-> UE)
+
+#####################
+# |Bit 0| DEL |Retrn|C_L/R|  F7 |  F1 |  F3 |  F5 |C_U/D|
+
+# inst/del
+BackSpace      0 0 8
+# extra: delete -> ins/del
+Delete         0 0 8
+# extra: insert -> shift+ins/del
+Insert         0 0 1
+# return
+Return         0 1 8
+# cursor r/l
+Right          0 2 8
+Left           0 2 1
+# f7
+F7             0 3 8
+F8             0 3 1
+# extra: pagedown -> f7
+Page_Down      0 3 8
+# f1
+F1             0 4 8
+F2             0 4 1
+# extra: pagedown -> f1
+Page_Up        0 4 8
+# f3
+F3             0 5 8
+F4             0 5 1
+# f4
+F5             0 6 8
+F6             0 6 1
+# cursor u/d
+Up             0 7 1
+Down           0 7 8
+
+#####################
+# |Bit 1| 3 # |  W  |  A  | 4 $ |  Z  |  S  |  E  | S_L |
+
+# shift+3
+section        1 0 8
+numbersign     1 0 1
+# shift+4
+dollar         1 3 8
+# left shift
+Shift_L        1 7 2
+# shift lock
+Caps_Lock      1 7 64
+
+#####################
+# |Bit 2| 5 % |  R  |  D  | 6 & |  C  |  F  |  T  |  X  |
+
+# shift+5
+percent        2 0 8
+# shift+6
+ampersand      2 3 8
+
+#####################
+# |Bit 3| 7 ' |  Y  |  G  | 8 ( |  B  |  H  |  U  |  V  |
+
+# shift+7
+apostrophe     3 0 1
+# shift+8
+parenleft      3 3 8
+
+#####################
+# |Bit 4| 9 ) |  I  |  J  |  0  |  M  |  K  |  O  |  N  |
+
+# shift+9
+parenright     4 0 8
+
+#####################
+# |Bit 5|  +  |  P  |  L  |  -  | . > | : [ |  @  | , < |
+
+# plus
+plus           5 0 0
+braceleft      5 0 1
+# minus
+minus          5 3 0
+grave          5 3 8
+braceright     5 3 1
+# dot
+period         5 4 8
+greater        5 4 1
+# colon
+colon          5 5 0
+# extra: oe -> colon
+odiaeresis     5 5 0
+# extra: OE -> :+shift
+Odiaeresis     5 5 1
+# extra: altgr+[ -> :+shift
+bracketleft    5 5 1
+# @-key
+at             5 6 0
+# extra: ue -> @
+udiaeresis     5 6 8
+# extra: UE -> @+shift
+Udiaeresis     5 6 1
+# comma
+comma          5 7 8
+less           5 7 1
+
+#####################
+# |Bit 6|POUND|  *  | ; ] | HOME| S_R |  =  | A_UP| / ? |
+
+# pound
+bar            6 0 8
+brokenbar      6 0 8
+acute          6 0 8
+grave          6 0 8
+# *
+asterisk       6 1 16
+# semicolon
+semicolon      6 2 0
+# extra: ae -> ;
+adiaeresis     6 2 8
+# extra: AE -> ;+shift
+Adiaeresis     6 2 1
+# extra: altgr+] -> ;+shift
+bracketright   6 2 1
+# clr/home
+Home           6 3 8
+# extra: altgr+\ -> clr/home
+backslash      6 0 8
+# right shift
+Shift_R        6 4 4
+# =
+equal          6 5 16
+# arrow up / pi
+asciicircum    6 6 8
+degree         6 6 8
+# extra: altgr+m -> arrow up+shift (pi)
+mu             6 6 1
+# / ?
+slash          6 7 16
+question       6 7 8
+
+#####################
+# |Bit 7| 1 ! |A_LFT| CTRL| 2 " |SPACE|  C= |  Q  | R/S |
+
+# shift+1
+exclam         7 0 8
+# left arrow
+End            7 1 8
+# extra: underscore -> arrow left
+underscore     7 1 8
+# extra: altgr+~ -> arrow left
+asciitilde     7 1 8
+# extra: ssharp -> arrow left
+ssharp         7 1 8
+# ctrl
+Tab            7 2 8
+ISO_Left_Tab   7 2 8
+Control_L      7 2 8
+Control_R      7 2 8
+# shift+2
+quotedbl       7 3 8
+# space
+space          7 4 8
+# cbm
+# Control_L      7 5 8
+Alt_L      7 5 8
+# run/stop
+Escape         7 7 8
+
+#####################
+# letters and numbers
+
+0 4 3 8
+1 7 0 8
+2 7 3 8
+3 1 0 8
+4 1 3 8
+5 2 0 8
+6 2 3 8
+7 3 0 0
+8 3 3 8
+9 4 0 8
+
+A 1 2 8
+B 3 4 8
+C 2 4 8
+D 2 2 8
+E 1 6 8
+F 2 5 8
+G 3 2 8
+H 3 5 8
+I 4 1 8
+J 4 2 8
+K 4 5 8
+L 5 2 8
+M 4 4 8
+N 4 7 8
+O 4 6 8
+P 5 1 8
+Q 7 6 8
+R 2 1 8
+S 1 5 8
+T 2 6 8
+U 3 6 8
+V 3 7 8
+W 1 1 8
+X 2 7 8
+Y 3 1 8
+Z 1 4 8
+a 1 2 8
+b 3 4 8
+c 2 4 8
+d 2 2 8
+e 1 6 8
+f 2 5 8
+g 3 2 8
+h 3 5 8
+i 4 1 8
+j 4 2 8
+k 4 5 8
+l 5 2 8
+m 4 4 8
+n 4 7 8
+o 4 6 8
+p 5 1 8
+q 7 6 8
+r 2 1 8
+s 1 5 8
+t 2 6 8
+u 3 6 8
+v 3 7 8
+w 1 1 8
+x 2 7 8
+y 3 1 8
+z 1 4 8
+
+#
+# Restore key mappings
+#
+F12 -3 0
+F12 -3 1
+
+#
+# joyport attached keypad
+#
+Num_Lock    -5 0
+KP_7        -5 1
+KP_8        -5 2
+KP_9        -5 3
+KP_Divide   -5 4
+Scroll_Lock -5 5
+KP_4        -5 6
+KP_5        -5 7
+KP_6        -5 8
+KP_Multiply -5 9
+Sys_Req     -5 10
+KP_1        -5 11
+KP_2        -5 12
+KP_3        -5 13
+KP_Subtract -5 14
+Print       -5 15
+KP_0        -5 16
+KP_Delete   -5 17
+KP_Enter    -5 18
+KP_Add      -5 19

6502/C64/readme.txt

@@ -71,31 +71,40 @@ We recommend a Floppy Drive.
   vforth_1.d64 - Diskimage Disk 1 for Emulator usage
                  C64 volksForth Binary
                  C16 volksForth Binary
-                 Sourcecode 
+                 Sourcecode
   vforth_2.d64 - Diskimage Disk 2 for Emulator usage
                  complete volksForth 6502 C64/C16 Sourcecode
                  (can be compiled with Target Compiler)
   vforth_3.d64 - Diskimage Disk 3 for Emulator usage
-                 Assembler, Disassembler, Editor 
+                 Assembler, Disassembler, Editor
   vforth_4.d64 - Diskimage Disk 4 for Emulator usage
                  Grafic, Demos, Tools, Decompiler
-  tc38q.d64    - Sourcecode and Manual for Target Compiler 
+  tc38q.d64    - Sourcecode and Manual for Target Compiler
+  file-words.d64 - Some words to facilitate the pending transition
+                 from direct disk/d64 access blocks/screens to
+                 stream files as the primary sources from which
+                 C64 VolksForth is built.
 
   This version of volksForth is still using a traditional Forth-Block
-  filesystem on the Disks. The upcoming version 3.90 will have a ANSI-FORTH 
+  filesystem on the Disks. The upcoming version 3.90 will have a ANSI-FORTH
   compatible File-Interface to access normal Files on Disk. The Forth-Block
   routines will still be available as an optional package.
-  
+
 * Using volksFORTH in an Emulator
   * volksForth 3.81 6502 for C=64, C16 and Plus4 has been tested in these
     Emulators:
     * VICE  - http://www.viceteam.org/
-    * Frodo - http://frodo.cebix.net/ 
-    (with the good work of the VICE people we wouldn't be able to re-relase
-     this software) 
+    * Frodo - http://frodo.cebix.net/
+    (without the good work of the VICE people we wouldn't be able to re-relase
+     this software)
+
+* Automated build using VICE:
+  The Makefile and the build scripts in the emulator/ subdir require
+  the file format conversion tools from the tools/ subdir of
+  https://github.com/pzembrod/cc64 to be installed.
 
 * Website:
-  VolksForth is available ob SourceForge
+  VolksForth is available on SourceForge
   http://volksForth.sf.net
   and on the Website of Forth Gesellschaft (German Chapter of Forth Interst Group, FIG)
   http://www.forth-ev.de

6502/C64/tests/ans-shim.fth

@@ -0,0 +1,45 @@
+
+: \vf  [compile] \ ;
+
+: cells  2* ;
+
+: s"  [compile] " compile count ; immediate
+
+: [char]  [compile] ascii ; immediate
+: char  [compile] ascii ;
+
+: invert  not ;
+
+: lshift  0 ?DO 2* LOOP ;
+
+: rshift  0 ?DO 2/ 32767 and LOOP ;
+
+: 2over  3 pick 3 pick ;
+
+: s>d  extend ;
+
+: fm/mod  m/mod ;
+
+: sm/rem  dup >r  2dup xor >r  m/mod
+    over IF r> 0< IF 1+ swap r> - swap ELSE rdrop THEN
+    ELSE rdrop rdrop THEN ;
+
+: postpone  ' dup >name c@ $40 and
+    IF , ELSE [compile] compile compile , THEN ; immediate
+
+: align ;
+: aligned ;
+: cell+  2+ ;
+: char+  1+ ;
+: chars ;
+
+: 2@  dup 2+ @ swap @ ;
+: 2!  under ! 2+ ! ;
+
+: recurse  last @ name> , ; immediate
+
+: >number  ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+ BEGIN  dup 0= IF exit THEN
+ >r  count digit? WHILE accumulate r> 1- REPEAT 1- r> ;
+
+: accept  expect span @ ;

6502/C64/tests/run-vf-tests.fth

@@ -0,0 +1,10 @@
+
+: \vf  [compile] \ ; immediate
+
+include ans-shim.fth
+
+include tester.fth
+
+\ 1 verbose !
+
+include core.fr

6502/C64/tests/tester.fth

@@ -0,0 +1,66 @@
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST  
+
+\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
+\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
+\ VERSION 1.2
+
+\ 24/11/2015 Replaced Core Ext word <> with = 0=
+\ 31/3/2015 Variable #ERRORS added and incremented for each error reported.
+\ 22/1/09 The words { and } have been changed to T{ and }T respectively to
+\ agree with the Forth 200X file ttester.fs. This avoids clashes with
+\ locals using { ... } and the FSL use of } 
+
+HEX
+
+\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
+\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
+VARIABLE VERBOSE
+   FALSE VERBOSE !
+\   TRUE VERBOSE !
+
+: EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
+   DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
+
+VARIABLE #ERRORS 0 #ERRORS !
+
+: ERROR      \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
+      \ THE LINE THAT HAD THE ERROR.
+   CR TYPE SOURCE TYPE       \ DISPLAY LINE CORRESPONDING TO ERROR
+   EMPTY-STACK               \ THROW AWAY EVERY THING ELSE
+   #ERRORS @ 1 + #ERRORS !
+\   QUIT  \ *** Uncomment this line to QUIT on an error
+;
+
+VARIABLE ACTUAL-DEPTH         \ STACK RECORD
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
+
+: T{      \ ( -- ) SYNTACTIC SUGAR.
+   ;
+
+: ->      \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
+   DEPTH DUP ACTUAL-DEPTH !      \ RECORD DEPTH
+   ?DUP IF            \ IF THERE IS SOMETHING ON STACK
+      0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
+   THEN ;
+
+: }T      \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
+      \ (ACTUAL) CONTENTS.
+   DEPTH ACTUAL-DEPTH @ = IF      \ IF DEPTHS MATCH
+      DEPTH ?DUP IF         \ IF THERE IS SOMETHING ON THE STACK
+         0  DO            \ FOR EACH STACK ITEM
+           ACTUAL-RESULTS I CELLS + @   \ COMPARE ACTUAL WITH EXPECTED
+           = 0= IF S" INCORRECT RESULT: " ERROR LEAVE THEN
+         LOOP
+      THEN
+   ELSE               \ DEPTH MISMATCH
+      S" WRONG NUMBER OF RESULTS: " ERROR
+   THEN ;
+
+: TESTING   \ ( -- ) TALKING COMMENT.
+  SOURCE VERBOSE @
+   IF DUP >R TYPE CR R> >IN !
+   ELSE >IN ! DROP [CHAR] * EMIT
+   THEN ;
+