-\ From: John Hayes S1I\r
-\ Subject: tester.fr\r
-\ Date: Mon, 27 Nov 95 13:10:09 PST \r
-\r
-\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY\r
-\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.\r
-\ VERSION 1.1\r
-HEX\r
-\r
-\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY\r
-\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.\r
-VARIABLE VERBOSE\r
- FALSE VERBOSE !\r
-\r
-: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.\r
- DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;\r
-\r
-: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY\r
- \ THE LINE THAT HAD THE ERROR.\r
- TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR\r
- EMPTY-STACK \ THROW AWAY EVERY THING ELSE\r
-;\r
-\r
-VARIABLE ACTUAL-DEPTH \ STACK RECORD\r
-CREATE ACTUAL-RESULTS 20 CELLS ALLOT\r
-\r
-: { \ ( -- ) SYNTACTIC SUGAR.\r
- ;\r
-\r
-: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.\r
- DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH\r
- ?DUP IF \ IF THERE IS SOMETHING ON STACK\r
- 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM\r
- THEN ;\r
-\r
-: } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED\r
- \ (ACTUAL) CONTENTS.\r
- DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH\r
- DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK\r
- 0 DO \ FOR EACH STACK ITEM\r
- ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED\r
- <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN\r
- LOOP\r
- THEN\r
- ELSE \ DEPTH MISMATCH\r
- S" WRONG NUMBER OF RESULTS: " ERROR\r
- THEN ;\r
-\r
-: TESTING \ ( -- ) TALKING COMMENT.\r
- SOURCE VERBOSE @\r
- IF DUP >R TYPE CR R> >IN !\r
- ELSE >IN ! DROP\r
- THEN ;\r
-\r
+\ 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.1
+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 !
+
+: 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 ;
+
+: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
+ \ THE LINE THAT HAD THE ERROR.
+ TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR
+ EMPTY-STACK \ THROW AWAY EVERY THING ELSE
+;
+
+VARIABLE ACTUAL-DEPTH \ STACK RECORD
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
+
+: { \ ( -- ) 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 ;
+
+: } \ ( ... -- ) 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
+ <> 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
+ THEN ;
+