projects:sample7.blk
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
projects/sample7.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1