Home » Archimedes archive » Zipped Apps » FORTH » !FORTH/TestProgs/outer
!FORTH/TestProgs/outer
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
| Tape/disk: | Home » Archimedes archive » Zipped Apps » FORTH |
| Filename: | !FORTH/TestProgs/outer |
| Read OK: | ✔ |
| File size: | 034A bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
File contents
CORE
: NormalSearch CONTEXT @ @ SEARCH DUP NOT
IF MODE @
IF DROP COMPILER @ SEARCH DUP STATE ! ENDIF
ENDIF ;
: ?NUMBER NUMBER DUP
IF MODE @
IF SWAP SETUP_STACK COMPILECONST ENDIF
ENDIF ;
: ?EXECUTE STATE @ STATE 0SET MODE @ =
IF DUP TRUE = IF DROP TOP_REG 4* + ENDIF @ EXECUTE *STACK
ELSE @ SETUP_STACK CREATE_BL , ENDIF ;
: ?SEARCH MODE @
IF SPECIAL @ SEARCH DUP
IF DUP DUP STATE ! ELSE DROP NormalSearch ENDIF
ELSE NormalSearch
ENDIF ;
FALSE VARIABLE exit
: OUTER ." Mike's FORTH interpreter / compiler" CRET
." What next >"
INLINE
BEGIN ASPACE TOKEN
IF TYPE INLINE
ELSE ?SEARCH
IF ?EXECUTE
ELSE ?NUMBER NOT
IF QUESTION TYPE INLINE ENDIF
ENDIF
ENDIF
exit @ END ;
00000000 43 4f 52 45 0a 3a 20 4e 6f 72 6d 61 6c 53 65 61 |CORE.: NormalSea| 00000010 72 63 68 20 43 4f 4e 54 45 58 54 20 40 20 40 20 |rch CONTEXT @ @ | 00000020 53 45 41 52 43 48 20 44 55 50 20 4e 4f 54 0a 20 |SEARCH DUP NOT. | 00000030 20 20 20 20 49 46 20 4d 4f 44 45 20 40 0a 20 20 | IF MODE @. | 00000040 20 20 20 20 20 20 49 46 20 44 52 4f 50 20 43 4f | IF DROP CO| 00000050 4d 50 49 4c 45 52 20 40 20 53 45 41 52 43 48 20 |MPILER @ SEARCH | 00000060 44 55 50 20 53 54 41 54 45 20 21 20 45 4e 44 49 |DUP STATE ! ENDI| 00000070 46 0a 20 20 20 20 20 45 4e 44 49 46 20 3b 0a 3a |F. ENDIF ;.:| 00000080 20 3f 4e 55 4d 42 45 52 20 4e 55 4d 42 45 52 20 | ?NUMBER NUMBER | 00000090 44 55 50 0a 20 20 20 20 20 49 46 20 4d 4f 44 45 |DUP. IF MODE| 000000a0 20 40 0a 20 20 20 20 20 20 20 20 49 46 20 53 57 | @. IF SW| 000000b0 41 50 20 53 45 54 55 50 5f 53 54 41 43 4b 20 43 |AP SETUP_STACK C| 000000c0 4f 4d 50 49 4c 45 43 4f 4e 53 54 20 45 4e 44 49 |OMPILECONST ENDI| 000000d0 46 0a 20 20 20 20 20 45 4e 44 49 46 20 3b 0a 3a |F. ENDIF ;.:| 000000e0 20 3f 45 58 45 43 55 54 45 20 53 54 41 54 45 20 | ?EXECUTE STATE | 000000f0 40 20 53 54 41 54 45 20 30 53 45 54 20 4d 4f 44 |@ STATE 0SET MOD| 00000100 45 20 40 20 3d 0a 20 20 20 20 20 49 46 20 44 55 |E @ =. IF DU| 00000110 50 20 54 52 55 45 20 3d 20 49 46 20 44 52 4f 50 |P TRUE = IF DROP| 00000120 20 54 4f 50 5f 52 45 47 20 34 2a 20 2b 20 45 4e | TOP_REG 4* + EN| 00000130 44 49 46 20 40 20 45 58 45 43 55 54 45 20 2a 53 |DIF @ EXECUTE *S| 00000140 54 41 43 4b 0a 20 20 20 20 20 45 4c 53 45 20 40 |TACK. ELSE @| 00000150 20 53 45 54 55 50 5f 53 54 41 43 4b 20 43 52 45 | SETUP_STACK CRE| 00000160 41 54 45 5f 42 4c 20 2c 20 45 4e 44 49 46 20 3b |ATE_BL , ENDIF ;| 00000170 0a 3a 20 3f 53 45 41 52 43 48 20 4d 4f 44 45 20 |.: ?SEARCH MODE | 00000180 40 0a 20 20 20 20 20 49 46 20 53 50 45 43 49 41 |@. IF SPECIA| 00000190 4c 20 40 20 53 45 41 52 43 48 20 44 55 50 20 0a |L @ SEARCH DUP .| 000001a0 20 20 20 20 20 20 20 20 49 46 20 44 55 50 20 44 | IF DUP D| 000001b0 55 50 20 53 54 41 54 45 20 21 20 45 4c 53 45 20 |UP STATE ! ELSE | 000001c0 44 52 4f 50 20 4e 6f 72 6d 61 6c 53 65 61 72 63 |DROP NormalSearc| 000001d0 68 20 45 4e 44 49 46 0a 20 20 20 20 20 45 4c 53 |h ENDIF. ELS| 000001e0 45 20 4e 6f 72 6d 61 6c 53 65 61 72 63 68 0a 20 |E NormalSearch. | 000001f0 20 20 20 20 45 4e 44 49 46 20 3b 0a 46 41 4c 53 | ENDIF ;.FALS| 00000200 45 20 56 41 52 49 41 42 4c 45 20 65 78 69 74 0a |E VARIABLE exit.| 00000210 3a 20 4f 55 54 45 52 20 2e 22 20 20 20 20 20 20 |: OUTER ." | 00000220 20 20 20 20 20 4d 69 6b 65 27 73 20 46 4f 52 54 | Mike's FORT| 00000230 48 20 69 6e 74 65 72 70 72 65 74 65 72 20 2f 20 |H interpreter / | 00000240 63 6f 6d 70 69 6c 65 72 22 20 43 52 45 54 0a 20 |compiler" CRET. | 00000250 20 20 20 20 20 20 20 2e 22 20 57 68 61 74 20 6e | ." What n| 00000260 65 78 74 20 3e 22 0a 20 20 20 20 20 49 4e 4c 49 |ext >". INLI| 00000270 4e 45 0a 20 20 20 20 20 42 45 47 49 4e 20 41 53 |NE. BEGIN AS| 00000280 50 41 43 45 20 54 4f 4b 45 4e 0a 20 20 20 20 20 |PACE TOKEN. | 00000290 20 20 20 49 46 20 54 59 50 45 20 49 4e 4c 49 4e | IF TYPE INLIN| 000002a0 45 0a 20 20 20 20 20 20 20 20 45 4c 53 45 20 3f |E. ELSE ?| 000002b0 53 45 41 52 43 48 0a 20 20 20 20 20 20 20 20 20 |SEARCH. | 000002c0 20 20 49 46 20 3f 45 58 45 43 55 54 45 20 20 20 | IF ?EXECUTE | 000002d0 0a 20 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 |. ELSE| 000002e0 20 3f 4e 55 4d 42 45 52 20 4e 4f 54 0a 20 20 20 | ?NUMBER NOT. | 000002f0 20 20 20 20 20 20 20 20 20 20 20 49 46 20 51 55 | IF QU| 00000300 45 53 54 49 4f 4e 20 54 59 50 45 20 49 4e 4c 49 |ESTION TYPE INLI| 00000310 4e 45 20 45 4e 44 49 46 0a 20 20 20 20 20 20 20 |NE ENDIF. | 00000320 20 20 20 20 45 4e 44 49 46 0a 20 20 20 20 20 20 | ENDIF. | 00000330 20 20 45 4e 44 49 46 0a 20 20 20 20 20 65 78 69 | ENDIF. exi| 00000340 74 20 40 20 45 4e 44 20 3b 0a |t @ END ;.| 0000034a
.