=== Examples for lecture number seven. === Screen 0 not modified 0 \ Examples for lecture number seven. 14:27JWB11/03/85 1 \ Last change: Screen 013 13:20JWB02/21/86 2 3 4 Strings. 5 6 Number Formating. 7 8 Case Statement 9 10 11 12 13 14 15 Screen 1 not modified 0 \ Load Screen for sample 7.blk 12:54JWB02/21/86 1 \ Typing OK always loads screen 1! 2 3 FROM LEDIT.BLK OK \ load the line editor 4 NEW-EXP \ activate the new line editor. 5 6 7 10 11 THRU \ load the new dump utility. 8 9 10 11 12 13 14 15 Screen 2 not modified 0 \ Suggested Projects - choose one. 13:06JWB02/21/86 1 1 HELP SYSTEM - organize, rewrite and/or add to existing help 2 screens(sample1.blk). Comment source screens and prepare word 3 glossary. Fix help system so it works even when sample1.blk 4 in not the current screen file. 5 2 LINE EDITOR - finish detailed comments screens 51 -62. Modify 6 function key assignments to match DOSEDIT. Prepare word 7 glossary. Add the recall line from screen feature. 8 3 FORTH BBS & TERMINAL PROGRAM - Sample term pgm is in FORTH DIM 9 V6 N5, Don V. and Jack B have some BBS source. Get it working 10 Detailed comments and word glossary. Then enhance it. 11 4 FLOATING POINT MATH - add the transcendental functions, square 12 root, etc to our simple floating point package. Detailed 13 comments, glossary etc. 14 5 FAST FOURIER TRANSFORM and COMPLEX NUMBERS - Reference 15 DDJ V9 N9 Sept 1984 page34, I have some of the source on disk. Screen 3 not modified 0 \ Review-1 Star-slash the scaler. 20:54JWB10/31/85 1 \ */ ( a b c ab/c ) 2 \ Perform multiplication and then division. 3 \ Star-slash multiplies 16bit a and 16bit b to form a 32bit 4 \ intermediate result which is then divided by 16bit c to give a 5 \ 16bit result. The 32bit intermediate product ensures accurate 6 \ results when multiplying by fractions. 7 8 \ We use */ to multiply a by the fraction b/c 9 \ Examples: 10 \ 32-bit intermediate product results in correct answer. 11 \ 15000 3 4 */ gives 11250 correct answer 12 13 \ 16-bit intermediate product results in overflow and the 14 \ 15000 3 * 4 / gives -5134 wrong answer 15 Screen 4 not modified 0 \ Review-2 Star slash mod, Rounding Fracti 21:04JWB10/31/85 1 \ */MOD ( a b c r q ) 2 \ Compute ab/c with 32bit intermediate product ab and leave 3 \ quotient q and remainder r . Note: Forth-83 */MOD uses 4 \ signed values a b c and uses floored symmetric division. 5 6 \ Rounding calculations that involve division. 7 : %R1 10 */ 5 + 10 / . ; 8 : %R2 50 */ 1+ 2/ . ; 9 : %R3 100 */MOD SWAP 50 + 100 / + . ; 10 : %R4 100 */MOD SWAP 49 > NEGATE + . ; 11 12 \ Fractions: see Brodie page 125 for more. 13 : *PI 355 113 */ ; 14 : *SQRT(2) 19601 13860 */ ; 15 : *E 28667 10546 */ ; Screen 5 not modified 0 \ Review-3 Timer module. 22:19JWB10/31/85 1 \ Return current time in ticks (18.2/sec) as a double integer. 2 CODE @TICKS ( -- dn ) 3 AH AH SUB \ Set AH to zero for timer read. 4 IP PUSH \ Save FORTHs interpretive pointer. 5 RP PUSH \ Save FORTHs return stack pointer. 6 26 INT \ Call function 26 for timer read. 7 RP POP \ Restore return stack pointer. 8 IP POP \ Restore interpretive pointer. 9 DX PUSH \ Push low 16 bits of double number. 10 CX PUSH \ Push high 16 bits of double number. 11 NEXT \ Return to inner interpreter. 12 END-CODE \ Indicate end of code definition. 13 2VARIABLE TICKS 14 \ Save current time in ticks. 15 : !TIMER ( -- -- ) @TICKS TICKS 2! ; : TIME ; Screen 6 not modified 0 \ Review-2 Timing Template. 21:51JWB10/31/85 1 FORGET TIME : TIME ; 2 \ Fetch elapsed time in ticks. 3 : @TIMER ( -- dn ) 4 @TICKS TICKS 2@ D- ; 5 6 \ @TIMER gives time in ticks, 18.2 ticks/sec so if we perform 7 \ 1000 passes we can get count in micro-secs for one pass. 8 9 : TIME.IT 10 !TIMER 1000 0 11 DO TUCK NIP LOOP 12 @TIMER DROP CR 13 5000 91 */ . 230 EMIT ." -seconds for one pass." ; 14 15 : TEST CR 5 0 DO TIME.IT LOOP ; Screen 7 not modified 0 \ Review-5 Infinite & indefinite Loops 22:34JWB10/31/85 1 The infinite loop with no exit. 2 3 ... (step 1) BEGIN (step2) AGAIN (step3) ... 4 5 The infinite loop with EXIT escape hatch. 6 7 ... (s1) BEGIN (s2) 8 (condition) IF EXIT THEN 9 (s3) 10 AGAIN (s4) ... 11 Indefinite Loops 12 13 ... (s1) BEGIN (s2) 14 (condition) 15 UNTIL (s3) ... Screen 8 not modified 0 \ Review-6 Indefinite Loops 15:40jwb11/01/85 1 2 \ ... (s1) BEGIN (s2) 3 \ (condition) 4 \ WHILE (s3) 5 \ REPEAT (s4) ... 6 7 8 9 10 11 12 13 14 15 Screen 9 not modified 0 \ Review-7 Loops 15:40jwb11/01/85 1 \ ... (s1) l i DO (s2) LOOP (s3) ... 2 \ ... (s1) l i DO (s2) n +LOOP (s3) ... 3 \ ... (s1) l i ?DO (s2) LOOP (s3) ... 4 \ ... (s1) l i ?DO (s2) n +LOOP (s3) ... 5 \ Leaving Loops early. 6 \ (s1) l i DO (s2) 7 \ (condition) IF (s3) LEAVE THEN 8 \ (s4) 9 \ LOOP (s5) ... 10 \ This is an alternative form if step 3 is not required. 11 \ (s1) l i DO (s2) 12 \ (condition) ?LEAVE 13 \ (s4) 14 \ LOOP (s5) ... 15 \ Screen 10 not modified 0 \ [IN] .ASCII ?SPACE .RBYTE HEAD 14:33JWB11/02/85 1 \ Leave true flag if a <= x <= b . 2 : [IN] ( x a b f ) 1+ -ROT 1- OVER < -ROT > AND ; 3 4 : .ASCII ( n -- ) \ EMIT n as printable ascii or a space. 5 127 AND DUP BL 126 [IN] NOT IF DROP BL THEN EMIT ; 6 \ Double space if i is equal to 8 . 7 : ?SPACE ( i -- ) 8 = IF SPACE SPACE THEN ; 8 \ Print byte right justified in field w wide. 9 : .RBYTE ( n w -- ) 10 >R 0 <# # # #> R> OVER - SPACES TYPE ; 11 \ Based on address adr , display heading for VERIFY 12 : HEAD ( adr -- ) 13 CR 5 SPACES 16 0 DO I OVER + 255 AND 14 I ?SPACE 3 .RBYTE LOOP 15 2 SPACES 16 0 DO I OVER + 15 AND 1 .R LOOP DROP ; Screen 11 not modified 0 \ 1LINE VERIFY PEEK Problem 1. 14:39JWB11/02/85 1 : 1LINE ( adr -- ) \ Verify 16 bytes from address. 2 DUP CR 0 4 D.R SPACE DUP \ Display address. 3 16 0 DO I ?SPACE COUNT 3 .RBYTE \ Display bytes in hex. 4 LOOP DROP 2 SPACES 5 16 0 DO COUNT .ASCII \ Display bytes as ASCII. 6 LOOP DROP SPACE ; 7 8 : VERIFY ( adr -- ) \ Only 32 bytes from adr with header. 9 BASE @ SWAP HEX DUP HEAD 10 DUP 1LINE DUP 16 + 1LINE HEAD CR BASE ! ; 11 12 \ Dump out first 32 bytes of a word in the dictionary. 13 : PEEK ' >NAME 1- VERIFY ; 14 \ Problem 1: Use HEAD and 1LINE to write a better memory 15 \ DUMP utility. Screen 12 not modified 0 \ String operators-1 13:15JWB02/21/86 1 \ A counted string in memory is |05|48|45|4C|4C|4F| <-hex 2 \ preceded by character count. |05| H| E| L| L| O| 3 \ Compile a counted {text} string into dictionary. 4 \ ," {text}" ( -- -- ) USE OUTSIDE DEFINITION ONLY!!! 5 CREATE NAME$ ," George Smith" 6 \ If adr points to a counted string, COUNT will fetch the 7 \ character count an increment adr to point to first character. 8 \ Count is often used to fetch successive characters of a string 9 \ as in the definition of TYPE below and VER of screen 11. 10 \ COUNT ( adr adr+1 n) 11 : COUNT DUP 1+ OVER C@ ; \ Actually COUNT is a CODE def. 12 \ Given address adr and character count n type the string. 13 \ TYPE ( adr n -- ) Type n characters of string at adr. 14 : TYPE 15 0 ?DO COUNT EMIT LOOP DROP ; Screen 13 not modified 0 \ String operators-2 13:20JWB02/21/86 1 \ " {text}" ( -- adr count ) ONLY USE WITHIN A WORD DEFINITION 2 \ Compile a counted string into a word definition. When word 3 \ is later executed the address and count are returned. 4 : JOB$ " FORTH Programmer" ; 5 6 : DASHED1 CR ." ----------" ; 7 CREATE DASH ," ----------" ; 8 9 : DASHED2 CR DASH COUNT TYPE ; 10 : DASHED3 CR " ----------" TYPE ; 11 : DASHED4 CR 10 0 DO ASCII - EMIT LOOP ; 12 13 \ FILL ( adr n c ) Fill string at adr with n copies of c . 14 \ ERASE ( adr n ) Fill string at adr with n null's or 0's. 15 Screen 14 not modified 0 \ String Examples. 13:11JWB02/21/86 1 \ Input a string of length n to buffer at adr . Actual number 2 \ of characters entered is stored in a variable called SPAN. 3 \ EXPECT ( adr n -- ) 4 \ Note: EXPECT does not return a counted string. 5 CREATE BUFFER1 80 ALLOT VARIABLE LEN 6 \ Accept a string up to 80 characters long from the console. 7 : READLINE ( -- -- ) 8 BUFFER1 80 BL FILL \ Clear BUFFER1 to blanks. 9 CR BUFFER1 80 EXPECT SPAN @ LEN ! ; 10 \ Note: Actual character count is returned in variable SPAN 11 12 \ Display string stored in BUFFER1 13 : SHOWLINE ( -- -- ) 14 CR BUFFER1 LEN @ TYPE ; 15 Screen 15 not modified 0 \ Moving Strings. 22:20JWB10/31/85 1 \ Move n bytes from adrf to adrt. Left-most or low memory bytes 2 \ are moved first. ( ie Move starts at beginning of string.) 3 \ CMOVE ( adrf adrt n -- ) Use when adrf > adrt 4 \ Use CMOVE to move strings down to lower memory. 5 6 \ Move n bytes from adrf to adrt. Right-most or high memory 7 \ bytes are moved first. ( ie Move starts at end of string.) 8 \ CMOVE> ( adrf adrt n -- ) Use when adrf < adrt 9 \ Use CMOVE> to move strings up to higher memory. 10 11 \ Move n bytes from adrf to adrt. If adrf < adrt use CMOVE> 12 \ otherwise use CMOVE. This will prevent overlap. 13 \ MOVE ( adrf adrt n -- ) 14 : MOVE -ROT 2DUP U< 15 IF ROT CMOVE> ELSE ROT CMOVE THEN ; Screen 16 not modified 0 \ Packing and chopping strings. 14:47JWB11/02/85 1 CREATE BUFFER2 80 ALLOT 2 3 \ Move a string at adrf and pack it at adrt with count n. 4 : CPACK ( adrf adrt n -- ) 5 SWAP 2DUP C! \ Store string count. 6 1+ SWAP CMOVE ; 7 8 \ Try: READLINE BUFFER1 BUFFER2 LEN @ CPACK 9 \ BUFFER2 VERIFY 10 \ BUFFER2 COUNT TYPE 11 12 \ Chopping n characters from the left of a string 13 : CHOP ( adr count n adr' count' ) 14 ROT OVER + -ROT - ; 15 Screen 17 not modified 0 \ -TRAILING CONVERT 14:54JWB11/02/85 1 \ Remove trailing blanks from a string. 2 : -TRAILING ( adr count1 adr count2 ) 3 DUP 0 4 ?DO \ Examine each character if any. 5 2DUP + 1- \ Address of last character. 6 C@ BL <> \ Is this character a blank? 7 IF LEAVE THEN \ If its not we are done. 8 1- \ Decrease count by 1 to shorten. 9 LOOP ; 10 \ Convert a string at adr1+1 accumulating number into d1. 11 \ Stops at first non digit character at addr2. adr1 is usually 12 \ the address of a counted or packed digit string. The first 13 \ digit of the string will be at adr1+1 . 14 \ CONVERT ( d1 adr1 d2 adr2 ) 15 Screen 18 not modified 0 \ Converting a string to a number. 22:20JWB10/31/85 1 \ Convert a ASCII digit string to a double number. 2 : VAL ( adr count dn flag ) 3 PAD SWAP CPACK \ Copy and pack string at PAD buffer. 4 BL PAD COUNT + C! \ Add a blank at the end of string. 5 0 0 \ Double number accumlator. 6 PAD \ Start address-1 7 CONVERT \ Convert the number. 8 DUP C@ ASCII - = \ Stopped by -ve sign? 9 IF CONVERT \ If so continue conversion. 10 >R DNEGATE R> \ Apply the -ve sign to result. 11 THEN C@ BL = ; \ Successful conversion if we end 12 \ with a blank. 13 : D#IN BEGIN READLINE BUFFER1 LEN @ VAL NOT 14 WHILE CR ." REDO FROM START" 2DROP 15 REPEAT ; Screen 19 not modified 0 \ EMIT CTYPE 15:19JWB11/02/85 1 \ Echo character n to the printer if its on and the console. 2 \ : EMIT ( n -- ) 3 \ PRINTING @ 4 \ IF DUP (PRINT) -1 #OUT +! 5 \ THEN (CONSOLE) ; 6 7 \ PRINTING ( -- adr ) Printer flag. True for printer output. 8 \ (PRINT) ( n -- ) Send character n to the printer. 9 \ (CONSOLE) ( n -- ) Send character n to the console only. 10 \ #OUT ( -- adr ) Variable, # of characters output since 11 the last carriage return. 12 \ Output n bytes of string at adr to console only. 13 : CTYPE ( adr n -- ) 14 0 ?DO COUNT (CONSOLE) LOOP DROP ; 15 Screen 20 not modified 0 \ Double Number Conversion Primitives-1. 15:35JWB11/02/85 1 CREATE PBUF 40 ALLOT \ Buffer to hold output string. 2 : PAD ( -- adr ) \ Return address for output string. 3 PBUF 16 + ; 4 VARIABLE HLD \ Current output address in PBUF . 5 : ??? CR .S PBUF 1LINE CR ; 6 : HOLD ( n -- ) \ Add character n to string being formed. 7 -1 HLD +! HLD @ C! ; 8 \ Start numeric conversion. 9 : <# ( -- -- ) PBUF 32 ERASE 10 PAD HLD ! ; \ Initialize HLD for new output. 11 \ Terminate numeric conversion. 12 : #> ( dn adr len ) 13 2DROP \ Drop double number. 14 HLD @ \ Address of string. 15 PAD OVER - ; \ Compute length of string. Screen 21 not modified 0 \ Double Number Conversion Primitives-2. 15:53JWB11/02/85 1 \ If n is negative insert a -ve sign in the output string. 2 : SIGN ( n -- ) 3 0< IF ASCII - HOLD THEN ; 4 \ Convert a single digit using the current number BASE. 5 : # ( dn dn' ) 6 BASE @ MU/MOD \ Divide dn by current base. 7 ROT 9 OVER < \ Digit greater than 9 ? 8 IF 7 + THEN \ Add offset of letter A for hex etc 9 ASCII 0 + HOLD ( ???) ; \ Add offset to digit zero and save. 10 \ MU/MOD is a mixed mode division operator. It divides a 11 \ double number dn by a single divisor n leaving a single 12 \ remainder r and a double quotiend dq. 13 \ MU/MOD ( dn n r dq ) \ dn = dq*n + r 14 : #S ( dn dn') \ Convert a number until finished. 15 BEGIN # 2DUP OR 0= UNTIL ; Screen 22 not modified 0 \ Numeric Output-1 16:04JWB11/02/85 1 2 \ (U.) Convert an unsigned 16 bit number to a string. 3 : (U.) (S u -- a l ) 0 <# #S #> ; 4 \ U. Output as an unsigned single number with trailing space. 5 : U. (S u -- ) (U.) TYPE SPACE ; 6 \ U.R Output as an unsigned single number right justified. 7 : U.R (S u l -- ) >R (U.) R> OVER - SPACES TYPE ; 8 9 \ (.) Convert a signed 16 bit number to a string. 10 : (.) (S n -- a l ) DUP ABS 0 <# #S ROT SIGN #> ; 11 \ . Output as a signed single number with a trailing space. 12 : . (S n -- ) (.) TYPE SPACE ; 13 \ .R Output as a signed single number right justified. 14 : .R (S n l -- ) >R (.) R> OVER - SPACES TYPE ; 15 Screen 23 not modified 0 \ Numeric Output-2 16:03JWB11/02/85 1 2 \ (UD.) Convert an unsigned double number to a string. 3 : (UD.) (S ud -- a l ) <# #S #> ; 4 \ UD. Output as unsigned double number with a trailing space 5 : UD. (S ud -- ) (UD.) TYPE SPACE ; 6 \ UD.R Output as an unsigned double number right justified. 7 : UD.R (S ud l -- ) >R (UD.) R> OVER - SPACES TYPE ; 8 9 \ (D.) Convert a signed double number to a string. 10 : (D.) (S d -- a l ) TUCK DABS <# #S ROT SIGN #> ; 11 \ D. Output as a signed double number with a trailing space. 12 : D. (S d -- ) (D.) TYPE SPACE ; 13 \ D.R Output as a signed double number right justified. 14 : D.R (S d l -- ) >R (D.) R> OVER - SPACES TYPE ; 15 Screen 24 not modified 0 \ Number formating examples. 15:35JWB11/02/85 1 \ Print single number as four digit hex and preserve system base 2 : H. BASE @ >R 16 BASE ! 3 0 <# # # # # #> 4 R> BASE ! TYPE SPACE ; 5 \ Print 16-bit number as binary saving preserving current BASE. 6 : B. BASE @ >R 2 BASE ! 7 0 <# # # # # # # # # # # # # # # # # #> 8 R> BASE ! TYPE SPACE ; 9 \ Print double number as signed dollars and cents. 10 : $. ( dn -- ) 11 TUCK DABS <# 12 ROT 0< IF ASCII - HOLD ELSE ASCII + HOLD THEN 13 # # ASCII . HOLD #S ASCII $ HOLD 14 #> TYPE SPACE ; 15 Screen 25 not modified 0 \ Formating the time. 15:35JWB11/02/85 1 2 : SECONDS ( -- dn ) 3 @TICKS 18 MU/MOD ROT DROP ; ( should be 18.2 ) 4 5 : SEX 6 BASE ! ; 6 7 : :## # ( base 10 ) SEX # ( base 6 ) 8 DECIMAL ASCII : HOLD ; 9 10 : .TIME 11 SECONDS <# :## :## #S #> TYPE SPACE ; 12 \ Problem: 13 \ We need M*/ to get the SECONDS correct. See Brodie page 174 14 \ and screen 24 of SAMPLE2.BLK and fix SECONDS so we get the 15 \ correct time. Screen 26 not modified 0 \ Home Work 15:35JWB11/02/85 1 \ Do problems 1 through 8 page 182 of BRODIE 2 3 \ Redefine D. so that 4 \ 1234567. D. gives 1,234,567 5 6 \ Now do it again so that 7 \ 1234567. D. gives 1 234 567. <<< Note dec. point 8 9 \ Write the word O. that displays a number as Octal while 10 \ preserving the current system base. 11 12 \ Write B.R H.R and O.R that take a number n and a field 13 \ width w and then display Binary, Hex, or Octal right 14 \ justified in a field w wide while preserving the current 15 \ system base. Screen 27 not modified 0 \ Editor words used in LEDIT 15:35JWB11/02/85 1 2 \ LITTLE-CURSOR Makes a little cursor. 3 \ BIG-CURSOR Makes a big cursor. 4 5 \ Clear window with ul corner at (x,y) and lr at (x',y'). 6 \ a is the attribute byte. 7 or 0111 binary clears window. 7 \ 112 or 01110000 binary clears window to all white!! 8 \ INIT-WINDOW ( x y x' y' a -- ) 9 : DELAY 0 0 DO LOOP ; 10 : WOW 32 0 DO 0 0 79 24 I INIT-WINDOW 11 CR ." THIS IS NUMBER " I . DELAY LOOP ; 12 13 \ Wait for key press ( without ^C abort ) and return as n. 14 \ {KEY} ( -- n ) 15 Screen 28 not modified 0 \ Multi-way branching IF .. ELSE .. THEN 14:09JWB11/03/85 1 : TIS ( -- -- ) CR ." THIS IS DIGIT NUMBER " ; 2 : TEST1 ( -- -- ) 3 BEGIN KEY DUP 13 <> WHILE 4 ASCII 1 OVER = IF DROP TIS ." ONE " ELSE 5 ASCII 2 OVER = IF DROP TIS ." TWO " ELSE 6 ASCII 3 OVER = IF DROP TIS ." THREE " ELSE 7 ASCII 4 OVER = IF DROP TIS ." FOUR " ELSE 8 ASCII 5 OVER = IF DROP TIS ." FIVE " ELSE 9 ASCII 6 OVER = IF DROP TIS ." SIX " ELSE 10 ASCII 7 OVER = IF DROP TIS ." SEVEN " ELSE 11 ASCII 8 OVER = IF DROP TIS ." EIGHT " ELSE 12 ASCII 9 OVER = IF DROP TIS ." NINE " ELSE 13 ASCII 0 OVER = IF DROP TIS ." ZERO " ELSE 14 BEEP DROP THEN THEN THEN THEN THEN 15 THEN THEN THEN THEN THEN REPEAT DROP ; Screen 29 not modified 0 \ CASE ... OF ... ENDOF ... ENDCASE 14:19JWB11/03/85 1 \ CASE causes an index value to be compared to a series 2 \ OF values. Any number of OF .. ENDOF pairs may be used. 3 \ OF is equivalent to OVER = IF DROP 4 \ ENDOF is equivalent to ELSE 5 \ ENDCASE is equivalent of DROP and number of THENs 6 \ When the index value equals one of the OF values, the sequence 7 \ between that OF and the corresponding ENDOF is executed. 8 \ Control then branches to the word following ENDCASE. 9 \ If no match is found, ENDCASE drops the index from the stack. 10 11 \ The "otherwise" case may be handled by a sequence placed 12 \ between the last ENDOF and ENDCASE. The index value must 13 \ however be preserved across this otherwise sequence so that 14 \ ENDCASE may DROP it. 15 Screen 30 not modified 0 \ (OF) 14:12JWB06/16/85 1 \ EQUIVALENT TO OVER = IF DROP 2 CODE (OF) 3 AX POP BX POP 4 BX AX CMP 5 0<> IF BX PUSH 6 0 [IP] IP MOV 7 NEXT 8 THEN IP INC 9 IP INC 10 NEXT END-CODE 11 12 13 14 15 Screen 31 not modified 0 \ CASE OF ENDOF ENDCASE 14:12JWB06/16/85 1 ( see FORTH DIMENSIONS, II/3 page 37 ) 2 3 : CASE CSP @ !CSP TRUE ; IMMEDIATE 4 5 : OF ?CONDITION COMPILE (OF) ?>MARK ; IMMEDIATE 6 7 : ENDOF COMPILE BRANCH ?>MARK 8 2SWAP ?>RESOLVE TRUE ; IMMEDIATE 9 10 : ENDCASE ?CONDITION COMPILE DROP BEGIN SP@ 11 CSP @ = 0= WHILE ?>RESOLVE 12 REPEAT CSP ! ; IMMEDIATE 13 14 15 Screen 32 not modified 0 \ Multi-way branching CASE Statement 14:06JWB11/03/85 1 : TEST2 ( -- -- ) 2 BEGIN KEY DUP 13 <> WHILE 3 CASE 4 ASCII 1 OF TIS ." ONE " ENDOF 5 ASCII 2 OF TIS ." TWO " ENDOF 6 ASCII 3 OF TIS ." THREE " ENDOF 7 ASCII 4 OF TIS ." FOUR " ENDOF 8 ASCII 5 OF TIS ." FIVE " ENDOF 9 ASCII 6 OF TIS ." SIX " ENDOF 10 ASCII 7 OF TIS ." SEVEN " ENDOF 11 ASCII 8 OF TIS ." EIGHT " ENDOF 12 ASCII 9 OF TIS ." NINE " ENDOF 13 ASCII 0 OF TIS ." ZERO " ENDOF 14 BEEP 15 ENDCASE REPEAT DROP ; Screen 34 not modified 0 \ Sample code definitions for the curious. 12:51JWB02/21/86 1 CODE SPLIT ( hilo lo hi ) 2 BX POP 3 AH AH SUB 4 BL AL MOV 5 AX PUSH 6 BH AL MOV 7 AX PUSH 8 NEXT END-CODE 9 CODE MELD ( lo hi hilo ) 10 AX POP 11 BX POP 12 AL AH MOV 13 BL AL MOV 14 AX PUSH 15 NEXT END-CODE