From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- .../common/lib/forth2012/tester/tester-amforth.frt | 66 ---------------------- 1 file changed, 66 deletions(-) delete mode 100644 amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt (limited to 'amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt') diff --git a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt b/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt deleted file mode 100644 index 01d3ca5..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt +++ /dev/null @@ -1,66 +0,0 @@ -\ 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 - -\ modified for amforth by Matthias Trute 2007 - -\ 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 - 0 VERBOSE ! - -variable ACTUAL-DEPTH \ STACK RECORD -variable START-DEPTH - -: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. - depth START-DEPTH @ < if - depth START-DEPTH @ swap do 0 loop - then - depth START-DEPTH @ > if - depth START-DEPTH @ do drop loop - then -; - -: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY - \ THE LINE THAT HAD THE ERROR. - itype source type cr \ DISPLAY LINE CORRESPONDING TO ERROR - EMPTY-STACK \ THROW AWAY EVERY THING ELSE -; - -variable ACTUAL-DEPTH \ STACK RECORD -variable ACTUAL-RESULTS 20 cells allot \ reserve space in RAM - -: t{ \ ( -- ) SYNTACTIC SUGAR. - depth START-DEPTH ! -; - -: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - depth dup ACTUAL-DEPTH ! \ RECORD DEPTH - START-DEPTH @ > if \ IF THERE IS SOMETHING ON STACK - depth START-DEPTH @ - 0 do ACTUAL-RESULTS i cells + ! loop \ SAVE THEM - then -; - -: }t \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED - depth ACTUAL-DEPTH @ = if \ IF DEPTHS MATCH - depth START-DEPTH @ > if \ IF THERE IS SOMETHING ON THE STACK - depth START-DEPTH @ - 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 ; - -- cgit v1.2.3