=== Examples for lecture number eight. === Screen 0 not modified 0 \ Examples for lecture number eight. 11:18JWB02/28/86 1 \ Last change: Screen 001 17:03jwb03/24/87 2 3 4 Dictionary Structure. 5 6 Vocabularies. 7 8 Recursion. 9 10 11 12 13 14 15 Screen 1 not modified 0 \ Load screen. 17:03jwb03/24/87 1 \ Typing OK always loads screen 1! 2 FROM SAMPLE1.BLK 9 LOAD \ MQUIT 3 6 VIEWS B:LEDIT.BLK \ Identify LEDIT.BLK as file # 6 4 6 VIEW# ! \ Set current view number. 5 FROM B:LEDIT.BLK OK \ load the line editor 6 NEW-EXP \ activate the new line editor. 7 8 7 VIEWS B:SAMPLE8.BLK \ Identify sample8.blk as file # 7 9 7 VIEW# ! \ Set current view number to 7 10 11 7 9 THRU \ Load Number Format examples and Verify. 12 16 18 THRU \ Load SPY 13 14 ONLY FORTH ALSO EDITOR ALSO FORTH DEFINITIONS 15 Screen 2 not modified 0 \ Review-1 Strings 21:41JWB11/14/85 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 4 ," {text}" ( -- -- ) ONLY USE OUTSIDE A WORD DEFINITION 5 Compile a counted {text} string into dictionary. Do not use in 6 a word definition!! System will crash (if you're lucky). 7 8 " {text}" ( -- adr count ) ONLY USE WITHIN A WORD DEFINITION 9 Compile a counted string into a word definition. When word 10 is later executed the address and count are returned. 11 12 Examples: 13 CREATE NAME$ ," George Smith" 14 : JOB$ " FORTH Programmer" ; 15 Screen 3 not modified 0 \ Review-2 COUNT TYPE EXPECT 21:58JWB11/14/85 1 2 COUNT ( adr adr+1 n) 3 If adr points to a counted string, COUNT will fetch the 4 character count an increment adr to point to first character. 5 Count is often used to fetch successive characters of a string 6 7 TYPE ( adr n -- ) Type n characters of string at adr. 8 9 FILL ( adr n c ) Fill string at adr with n copies of c . 10 ERASE ( adr n ) Fill string at adr with n null's or 0's. 11 12 EXPECT ( adr n -- ) 13 Input a string of length n to buffer at adr . Actual number 14 of characters entered is stored in a variable called SPAN. 15 Note: EXPECT does not return a counted string. Screen 4 not modified 0 \ Review-3 Moving Strings. 22:05JWB11/14/85 1 2 CMOVE ( adrf adrt n -- ) Use when adrf > adrt 3 Move n bytes from adrf to adrt. Left-most or low memory bytes 4 are moved first. ( ie Move starts at beginning of string.) 5 Use CMOVE to move strings down to lower memory. 6 7 CMOVE> ( adrf adrt n -- ) Use when adrf < adrt 8 Move n bytes from adrf to adrt. Right-most or high memory 9 bytes are moved first. ( ie Move starts at end of string.) 10 Use CMOVE> to move strings up to higher memory. 11 12 MOVE ( adrf adrt n -- ) 13 Move n bytes from adrf to adrt. If adrf < adrt use CMOVE> 14 otherwise use CMOVE. This will prevent overlap. 15 Use MOVE when you can't remember whether to use CMOVE or CMOVE> Screen 5 not modified 0 \ Review-4 Strings 22:10JWB11/14/85 1 \ Move a string at adrf and pack it at adrt with count n. 2 : CPACK ( adrf adrt n -- ) 3 SWAP 2DUP C! \ Store string count. 4 1+ SWAP CMOVE ; 5 \ Chopping n characters from the left of a string 6 : CHOP ( adr count n adr' count' ) 7 ROT OVER + -ROT - ; EXIT 8 9 -TRAILING ( adr count1 adr count2 ) Remove trailing blanks 10 11 \ CONVERT ( d1 adr1 d2 adr2 ) 12 \ Convert a string at adr1+1 accumulating number into d1. 13 \ Stops at first non digit character at addr2. adr1 is usually 14 \ the address of a counted or packed digit string. The first 15 \ digit of the string will be at adr1+1 . Screen 6 not modified 0 \ Review-5 Number formating 19:01JWB11/18/85 1 2 PAD ( -- adr ) Return address for string output buffer. 3 HLD ( -- adr ) Pointer to current location in output buf 4 HOLD ( n -- ) Add character n to string being formed. 5 SIGN ( n -- ) If n is negative insert a -ve sign in the 6 output string. DIFFERENT FROM BRODIE 7 8 <# ( dn dn ) Start number formating ( PAD HLD ! ) . 9 dn, the number to be formated, is not 10 used by <# but is usually present. 11 # ( dn dn' ) Convert one digit of dn using current 12 number BASE and remaining digits as dn' . 13 #S ( dn dn') Convert a number until finished. When 14 conversion is finished dn' will be zero. 15 #> ( dn adr len ) Terminate numeric conversion. Screen 7 not modified 0 \ Number formating examples. 22:44JWB11/14/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 \ Save sign as third item. 12 <# ROT SIGN 13 ( 0< IF ASCII - HOLD ELSE ASCII + HOLD THEN ) 14 # # ASCII . HOLD #S ASCII $ HOLD 15 #> TYPE SPACE ; Screen 8 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 9 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 2- VERIFY ; 14 \ Problem 1: Use HEAD and 1LINE to write a better memory 15 \ DUMP utility. Screen 10 not modified 0 \ CASE ... OF ... ENDOF ... ENDCASE 11:24JWB02/28/86 1 \ First look at sample7.blk screen number 28. 2 \ CASE causes an index value to be compared to a series 3 \ OF values. Any number of OF .. ENDOF pairs may be used. 4 \ OF is equivalent to OVER = IF DROP 5 \ ENDOF is equivalent to ELSE 6 \ ENDCASE is equivalent of DROP and number of THENs 7 \ When the index value equals one of the OF values, the sequence 8 \ between that OF and the corresponding ENDOF is executed. 9 \ Control then branches to the word following ENDCASE. 10 \ If no match is found, ENDCASE drops the index from the stack. 11 12 \ The "otherwise" case may be handled by a sequence placed 13 \ between the last ENDOF and ENDCASE. The index value must 14 \ however be preserved across this otherwise sequence so that 15 \ ENDCASE may DROP it. Screen 11 not modified 0 \ Multi-way branching CASE Statement 22:52JWB11/14/85 1 : TIS ( -- -- ) CR ." THIS IS DIGIT NUMBER " ; 2 : TEST2 ( -- -- ) 3 BEGIN KEY DUP 13 <> WHILE 4 CASE 5 ASCII 1 OF TIS ." ONE " ENDOF 6 ASCII 2 OF TIS ." TWO " ENDOF 7 ASCII 3 OF TIS ." THREE " ENDOF 8 ASCII 4 OF TIS ." FOUR " ENDOF 9 ASCII 5 OF TIS ." FIVE " ENDOF 10 ASCII 6 OF TIS ." SIX " ENDOF 11 ASCII 7 OF TIS ." SEVEN " ENDOF 12 ASCII 8 OF TIS ." EIGHT " ENDOF 13 ASCII 9 OF TIS ." NINE " ENDOF 14 ASCII 0 OF TIS ." ZERO " ENDOF 15 BEEP ENDCASE REPEAT DROP ; Screen 12 not modified 0 \ Structure of a FORTH word definition. 19:24JWB11/18/85 1 2 4-bits 12-bits 3 vfa -> | File # | Block # | View Field 4 lfa -> | Link address | Link Field 5 nfa -> |1PScount | Name Field count=5bits 6 |0 char | 7 |0 char | char=7bits 8 |0 char | 9 |1 char | 10 cfa -> | Addr Inner Interpr.| Code field 11 pfa -> | Parameter List | Parameter Field 12 | . . . . | Also called the 13 | . . . . | BODY of the word 14 | . . . . | definition. 15 Screen 13 not modified 0 \ View, Link, Name: Details 19:26JWB11/18/85 1 View Field: Contains the File # as set by VIEWS and the 2 Block # or screen # that the word definition is on. 3 File # The File # set by the VIEWS comand is in the top 4 or most significant 4 bits of the view field. 5 Block # Or screen # is in the low 12 bits of view field. 6 Link Field: Contains the address of the Name Field of the 7 of the previous word in the dictionary. 8 9 Name Field: Byte 1: 1 Delimeter bit 10 P Precedence bit, 1 for IMMEDIATE words 11 S Smudge bit, HIDE sets REVEAL clears. 12 0 4 Character count max is 31 13 Byte 2: 0char 14 15 Last Byte : 1char 1 is delimiter. Screen 14 not modified 0 \ Code and Parameter fields 10:20JWB11/17/85 1 Code Field : Contains pointer to ( ie address of ) the 2 machine code of the routine that implements this 3 particular class of words. This will be 4 different for constants, variables, colon, 5 and machine code definitions. It is called 6 the code field because it always points to 7 machine code for the host CPU!! 8 9 Parameter Field The contents of this field depends on the type 10 of word. For single (16-bit) variables and 11 and constants it contains their 16-bit value. 12 For a colon definition it contains a list of 13 the cfa's of the words that make up the colon 14 definition. For a code definion it contains 15 the actual machine code for the word. Screen 15 not modified 0 \ Accessing a words fields. 10:40JWB11/17/85 1 2 ' {word} ( -- cfa ) Leave code field address of {word}. 3 4 >VIEW ( cfa vfa ) Go to view field from code field. 5 >LINK ( cfa lfa ) Go to link field from code field. 6 >NAME ( cfa nfa ) Go to name field from code field. 7 >BODY ( cfa pfa ) Go to parameter field from code field. 8 VIEW> ( vfa cfa ) Go from view field to code field. 9 LINK> ( lfa cfa ) Go from link field to code field. 10 NAME> ( nfa cfa ) Go from name field to code field. 11 BODY> ( pfa cfa ) Go from body to code field. 12 N>LINK ( nfa lfa ) Go from name field to link field. 13 L>NAME ( lfa nfa ) Go from link field to name field. 14 Hints: Read >VIEW as "to view field" 15 VIEW> as "from view field" Screen 16 not modified 0 \ SPY-VFA 20:04JWB11/18/85 1 \ Display contents of field in both binary and hex. 2 : .RAW ( adr -- ) 3 DUP H. ." Contains: " @ DUP H. ." hex or " B. ." bin" ; 4 : SPY-VFA ( cfa -- ) 5 CR ." VFA: " 6 >VIEW DUP .RAW CR 11 SPACES \ Display raw contents of vfa. 7 @ DUP 4095 AND DUP \ Mask top 4 bits to get scr# 8 IF SWAP 4096 / 15 AND ?DUP \ Extract view file number. 9 IF 2* VIEW-FILES + @ \ Find cfa of the view file. 10 ." Located in file: " \ Display file name. 11 >BODY .FILE 12 ELSE ." May be in current file: " 13 FILE? 14 THEN ." Screen # " . \ Display screen number. 15 ELSE 2DROP ." Entered at the terminal." THEN ; Screen 17 not modified 0 \ SPY-LFA SPY-NFA 13:52JWB11/17/85 1 2 : SPY-LFA ( cfa -- ) 3 CR ." LFA: " 4 >LINK DUP .RAW 5 CR 11 SPACES ." This word is linked to: " 6 @ L>NAME .ID ; 7 8 : SPY-NFA ( cfa -- ) 9 CR ." NFA: " 10 >NAME DUP .RAW CR DUP HEX 1LINE DECIMAL 11 DUP C@ 64 AND CR 11 SPACES ." Precedence bit is " 12 IF " on." ELSE ." off." THEN 13 DUP C@ 32 AND ." Smudge bit is " 14 IF " on." ELSE ." off." THEN 15 C@ 31 AND ." The word length is " . ; Screen 18 not modified 0 \ SYP-CFA SPY-PFA SPY 12:23JWB11/17/85 1 2 : SPY-CFA ( cfa -- ) 3 CR ." CFA: " .RAW ; 4 5 : SPY-PFA ( cfa -- ) 6 >BODY CR ." PFA: " .RAW ; 7 8 : SPY ( -- -- ) 9 ' CR DUP SPY-VFA 10 CR DUP SPY-LFA 11 CR DUP SPY-NFA 12 CR DUP SPY-CFA 13 CR DUP SPY-PFA 14 CR KEY 13 = IF DROP ELSE (SEE) THEN ; 15 Screen 19 not modified 0 \ The Smudge bit and the Precedence bit 20:00JWB11/18/85 1 HIDE ( -- -- ) Removes last word defined by unlinking it 2 from its vocabulary thread. Previously smudge bit was set. 3 REVEAL ( -- -- ) Link the most recently defined word into 4 the current vocabulary. Previously smudge bit was cleared. 5 IMMEDIATE ( -- -- ) Turn on the precedence bit of the most 6 recently defined word in the dictionary. 7 IMMEDIATE flags a definition so that it is executed during 8 compilation instead of being compiled. 9 IMMEDIATE marks the most recently compiled definition so that 10 when it is encountered at compile time, it is executed rather 11 than compiled. Many compiler words are immediate. 12 ['] {word} This is an IMMEDIATE word used within a definition. 13 It used to compile the cfa of the following word as a 14 LITERAL or number. It is equivalent to the sequence 15 [ ' {word} ] LITERAL Screen 20 not modified 0 \ DP HERE CURRENT #VOC CONTEXT 14:26JWB11/17/85 1 DP ( -- adr ) Variable containing the current top 2 of the dicitionary. 3 HERE ( -- adr ) Returns top of dictionary as stored in 4 DP 5 CURRENT ( -- adr ) Variable containing the pfa of the 6 vocabulary in to which new definitions 7 are compiled. 8 #VOCS ( -- n ) Constant whose value is the maximum 9 number of dictionaries that can be in 10 the search order. 11 CONTEXT ( -- adr ) Variable containing the address of the 12 array space that holds the 8=#VOCs 13 transient vocabulary pointers ( pfas) 14 The CONTEXT array specifies the search 15 order for the text interpreter. Screen 21 not modified 0 \ ORDER VOC-LINK VOCS DEFINITIONS 14:37JWB11/17/85 1 ORDER ( -- -- ) Display the vocabulary names forming the 2 search order in their present search 3 order sequence. Then show vocabulary 4 into which new definitions will be put. 5 VOC-LINK ( -- adr ) Variable that contains pointer to the 6 most recently defined vocabulary. 7 The pointer is actually pfa+8 !!! 8 Vocabularies are thus linked in the 9 order of their creation. 10 VOCS ( -- -- ) List all vocabularies that exist in this 11 FORTH system. 12 DEFINITIONS ( -- -- ) Select the transient vocabulary ( first 13 in the context array) as the compilation 14 vocabulary into which all subsequent 15 new word definitions will be added. Screen 22 not modified 0 \ VOCABULARY ALSO PREVIOUS 17:05JWB11/17/85 1 2 VOCABULARY {name} ( -- -- ) 3 A dictionary entry for {name} is created which specifies a 4 new list of word definitions. Subsequent execution of {name} 5 replaces the first vocabulary in the current search order 6 with {name}. When name becomes the compilation vocabulary 7 new definitions will be appended to {name}'s word list. 8 9 ALSO ( -- -- ) 10 Push transient vocabulary making it the first resident 11 vocabulary in the search order. 12 13 PREVIOUS ( -- -- ) 14 The inverse of ALSO, removes the most recently referenced 15 vocabulary from the search order. Screen 23 not modified 0 \ ROOT ONLY SEAL 17:04JWB11/17/85 1 2 ROOT ( -- -- ) 3 A small vocabulary for controlling search order. 4 5 ONLY ( -- -- ) 6 Erases the search order and forces the ROOT vocabulary to be 7 the first and last. 8 9 SEAL ( -- -- ) 10 Usage: SEAL FORTH will change the search order such that 11 only FORTH will be searched. Used for turn-key applications. 12 13 14 15 Screen 24 not modified 0 \ 17:16JWB11/17/85 1 ONLY FORTH ALSO DEFINITIONS CR ORDER 2 VOCABULARY SOUND CR .( VOCS ) VOCS CR 3 ROOT DEFINITIONS : SOUND SOUND ; CR ORDER 4 SOUND DEFINITIONS CR ORDER HEX 5 6 \ PC! ( byte n -- ) Output byte to port number n. 7 \ PC@ ( n byte ) Input byte from port number n. 8 9 : S.ON ( -- -- ) \ Turn speaker on. 10 61 PC@ 11 3 OR 61 PC! ; 12 13 : S.OFF ( -- -- ) \ Turn speaker off. 14 61 PC@ 15 FFFC AND 61 PC! ; DECIMAL Screen 25 not modified 0 \ TONE 17:09JWB11/17/85 1 2 3 : TONE ( freq -- ) \ Make tone of specified frequency. 4 21 MAX \ Lowest frequency. 5 1.190000 ROT \ Get divisor for timer. 6 MU/MOD \ 16bit.rem 32bit.quot 7 DROP NIP [ HEX ] \ Keep 16-bit quotient only. 8 0B6 043 PC! \ Write to timer mode register. 9 100 /MOD SWAP \ Split into hi and low byte. 10 42 PC! 42 PC! \ Store low and high byte in timer. 11 S.ON ; DECIMAL \ turn speaker on. 12 13 14 15 Screen 26 not modified 0 \ SCALE 17:30JWB11/17/85 1 2 : C 131 TONE ; 3 : D 147 TONE ; 4 : E 165 TONE ; 5 : F 175 TONE ; 6 : G 196 TONE ; 7 : A 220 TONE ; 8 : B 247 TONE ; 9 : CC 262 TONE ; 10 11 : BEAT 20000 0 DO LOOP ; 12 13 : SCALE C BEAT D BEAT E BEAT F BEAT G BEAT 14 A BEAT B BEAT CC BEAT BEAT BEAT S.OFF ; 15 Screen 27 not modified 0 \ Recursive Factorial Function. 21:34JWB11/18/85 1 2 : FACTORIAL ( n n! ) 3 CR ." entering factorial" .S 4 DUP 0> IF DUP 1- [ REVEAL ] FACTORIAL [ HIDE ] * 5 ELSE DROP 1 6 THEN CR ." leaving factorial" .S ; EXIT 7 8 \ RECURSIVE Allow current definition to be self referencing. 9 10 : FACTORIAL ( n n! ) RECURSIVE 11 CR ." entering factorial" .S 12 DUP 0> IF DUP 1- FACTORIAL * 13 ELSE DROP 1 14 THEN CR ." leaving factorial" .S ; 15 Screen 28 not modified 0 \ 22:53JWB11/14/85 1 : 2** ( n 2**n ) RECURSIVE 2 CR ." entering" .S 3 DUP 0> IF 1- 2** 2* 4 ELSE DROP 1 5 THEN CR ." leaving " .S ; 6 7 : FIBONACCI ( n fib ) RECURSIVE 8 CR ." entering" .S DUP 0< ABORT" invalid argument" 9 DUP 1 > 10 IF DUP 1- FIBONACCI 11 SWAP 2- FIBONACCI + 12 THEN CR ." leaving " .S ; 13 14 \ : MYSELF LAST @ NAME> , ; IMMEDIATE 15 \ : RECURSE LAST @ NAME> , ; IMMEDIATE Screen 29 not modified 0 \ Stack Bubble Sort 12:42JWB02/28/86 1 2 \ Recursive bubble sort 3 : BUBBLE ( n n n ... m m m ... one pass ) RECURSIVE 4 CR ." ENTERING " .S 5 DEPTH 1 > 6 IF 2DUP < IF SWAP THEN 7 >R BUBBLE R> 8 THEN 9 CR ." LEAVING " .S ; 10 11 : SORT ( n n n n ... m m m m ... sorted ) 12 DEPTH 1 > IF 13 DEPTH 1- 0 DO BUBBLE LOOP THEN ; 14 15 Screen 30 not modified 0 \ Stack Bubble Sort 12:42JWB02/28/86 1 VARIABLE DIRECTION 2 : ASCENDING DIRECTION ON ; : DESCENDING DIRECTION OFF ; 3 : COMPARE DIRECTION @ IF < ELSE > THEN ; 4 5 : BUBBLE ( n n n ... m m m ... one pass ) RECURSIVE 6 CR ." ENTERING " .S 7 DEPTH 1 > 8 IF 2DUP COMPARE IF SWAP THEN 9 >R BUBBLE R> 10 THEN 11 CR ." LEAVING " .S ; 12 13 : SORT ( n n n n ... m m m m ... sorted ) 14 DEPTH 1 > IF 15 DEPTH 1- 0 DO BUBBLE LOOP THEN ; Screen 31 not modified 0 \ Multi-way branching IF .. ELSE .. THEN 14:58JWB03/04/86 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 ;