Home » Archimedes archive » Zipped Apps » FORTH » !FORTH/TestProgs/prog1
!FORTH/TestProgs/prog1
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/prog1 |
| Read OK: | ✔ |
| File size: | 03CE bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
File contents
CORE
: tokens INLINE BEGIN ASPACE TOKEN DUP NOT
IF TOKEN_BUFFER @ TYPE CRET ENDIF
END 0 LINE_BUFFER @ ! ;
10 ARRAY A1
10 ARRAY A2
10 ARRAY A3
: LOOK PRINT_MODE @ DUP 1 OR PRINT_MODE ! SWAP ." ( " 9 0 DO DUP [I]@ . LOOP DROP ." ) " PRINT_MODE ! ;
: OUTCHAR PRINT_MODE @ DUP 1 OR PRINT_MODE ! SWAP ECHO PRINT_MODE ! ;
: A1LOOK A1 LOOK ;
: A2LOOK A2 LOOK ;
: A3LOOK A3 LOOK ;
: A1SET 9 0 DO I> A1 [I]! LOOP ;
: A2SET 9 0 DO I> I> + A2 [I]! LOOP ;
: A3SET 9 0 DO I> 3 + A3 [I]! LOOP ;
: VectorAdd 0 DO 2OVER [I]@ 2OVER [I]@ + OVER [I]! LOOP ;
: VectorSub 0 DO 2OVER [I]@ 2OVER [I]@ - OVER [I]! LOOP ;
: VectorMul 0 DO 2OVER [I]@ 2OVER [I]@ * OVER [I]! LOOP ;
: VectorDiv 0 DO 2OVER [I]@ 2OVER [I]@ / OVER [I]! LOOP ;
A1SET
A2SET
A3SET
A3 A2 A1 9 VectorAdd A3LOOK 43 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
A3 A2 A1 9 VectorSub A3LOOK 45 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
A3 A2 A1 9 VectorMul A3LOOK 42 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
00000000 43 4f 52 45 0a 3a 20 74 6f 6b 65 6e 73 20 49 4e |CORE.: tokens IN| 00000010 4c 49 4e 45 20 42 45 47 49 4e 20 41 53 50 41 43 |LINE BEGIN ASPAC| 00000020 45 20 54 4f 4b 45 4e 20 44 55 50 20 4e 4f 54 0a |E TOKEN DUP NOT.| 00000030 20 20 20 20 20 20 20 20 49 46 20 54 4f 4b 45 4e | IF TOKEN| 00000040 5f 42 55 46 46 45 52 20 40 20 54 59 50 45 20 43 |_BUFFER @ TYPE C| 00000050 52 45 54 20 45 4e 44 49 46 0a 20 20 20 20 20 45 |RET ENDIF. E| 00000060 4e 44 20 30 20 4c 49 4e 45 5f 42 55 46 46 45 52 |ND 0 LINE_BUFFER| 00000070 20 40 20 21 20 3b 0a 31 30 20 41 52 52 41 59 20 | @ ! ;.10 ARRAY | 00000080 41 31 0a 31 30 20 41 52 52 41 59 20 41 32 0a 31 |A1.10 ARRAY A2.1| 00000090 30 20 41 52 52 41 59 20 41 33 0a 3a 20 4c 4f 4f |0 ARRAY A3.: LOO| 000000a0 4b 20 50 52 49 4e 54 5f 4d 4f 44 45 20 40 20 44 |K PRINT_MODE @ D| 000000b0 55 50 20 31 20 4f 52 20 50 52 49 4e 54 5f 4d 4f |UP 1 OR PRINT_MO| 000000c0 44 45 20 21 20 53 57 41 50 20 2e 22 20 20 28 20 |DE ! SWAP ." ( | 000000d0 22 20 39 20 30 20 44 4f 20 44 55 50 20 5b 49 5d |" 9 0 DO DUP [I]| 000000e0 40 20 2e 20 4c 4f 4f 50 20 44 52 4f 50 20 2e 22 |@ . LOOP DROP ."| 000000f0 20 20 29 20 22 20 50 52 49 4e 54 5f 4d 4f 44 45 | ) " PRINT_MODE| 00000100 20 21 20 3b 0a 3a 20 4f 55 54 43 48 41 52 20 50 | ! ;.: OUTCHAR P| 00000110 52 49 4e 54 5f 4d 4f 44 45 20 40 20 44 55 50 20 |RINT_MODE @ DUP | 00000120 31 20 4f 52 20 50 52 49 4e 54 5f 4d 4f 44 45 20 |1 OR PRINT_MODE | 00000130 21 20 53 57 41 50 20 45 43 48 4f 20 50 52 49 4e |! SWAP ECHO PRIN| 00000140 54 5f 4d 4f 44 45 20 21 20 3b 0a 3a 20 41 31 4c |T_MODE ! ;.: A1L| 00000150 4f 4f 4b 20 41 31 20 4c 4f 4f 4b 20 3b 0a 3a 20 |OOK A1 LOOK ;.: | 00000160 41 32 4c 4f 4f 4b 20 41 32 20 4c 4f 4f 4b 20 3b |A2LOOK A2 LOOK ;| 00000170 0a 3a 20 41 33 4c 4f 4f 4b 20 41 33 20 4c 4f 4f |.: A3LOOK A3 LOO| 00000180 4b 20 3b 0a 3a 20 41 31 53 45 54 20 39 20 30 20 |K ;.: A1SET 9 0 | 00000190 44 4f 20 49 3e 20 41 31 20 5b 49 5d 21 20 4c 4f |DO I> A1 [I]! LO| 000001a0 4f 50 20 3b 0a 3a 20 41 32 53 45 54 20 39 20 30 |OP ;.: A2SET 9 0| 000001b0 20 44 4f 20 49 3e 20 49 3e 20 2b 20 41 32 20 5b | DO I> I> + A2 [| 000001c0 49 5d 21 20 4c 4f 4f 50 20 3b 0a 3a 20 41 33 53 |I]! LOOP ;.: A3S| 000001d0 45 54 20 39 20 30 20 44 4f 20 49 3e 20 33 20 2b |ET 9 0 DO I> 3 +| 000001e0 20 41 33 20 5b 49 5d 21 20 4c 4f 4f 50 20 3b 0a | A3 [I]! LOOP ;.| 000001f0 3a 20 56 65 63 74 6f 72 41 64 64 20 30 20 44 4f |: VectorAdd 0 DO| 00000200 20 32 4f 56 45 52 20 5b 49 5d 40 20 32 4f 56 45 | 2OVER [I]@ 2OVE| 00000210 52 20 5b 49 5d 40 20 2b 20 4f 56 45 52 20 5b 49 |R [I]@ + OVER [I| 00000220 5d 21 20 4c 4f 4f 50 20 3b 0a 3a 20 56 65 63 74 |]! LOOP ;.: Vect| 00000230 6f 72 53 75 62 20 30 20 44 4f 20 32 4f 56 45 52 |orSub 0 DO 2OVER| 00000240 20 5b 49 5d 40 20 32 4f 56 45 52 20 5b 49 5d 40 | [I]@ 2OVER [I]@| 00000250 20 2d 20 4f 56 45 52 20 5b 49 5d 21 20 4c 4f 4f | - OVER [I]! LOO| 00000260 50 20 3b 0a 3a 20 56 65 63 74 6f 72 4d 75 6c 20 |P ;.: VectorMul | 00000270 30 20 44 4f 20 32 4f 56 45 52 20 5b 49 5d 40 20 |0 DO 2OVER [I]@ | 00000280 32 4f 56 45 52 20 5b 49 5d 40 20 2a 20 4f 56 45 |2OVER [I]@ * OVE| 00000290 52 20 5b 49 5d 21 20 4c 4f 4f 50 20 3b 0a 3a 20 |R [I]! LOOP ;.: | 000002a0 56 65 63 74 6f 72 44 69 76 20 30 20 44 4f 20 32 |VectorDiv 0 DO 2| 000002b0 4f 56 45 52 20 5b 49 5d 40 20 32 4f 56 45 52 20 |OVER [I]@ 2OVER | 000002c0 5b 49 5d 40 20 2f 20 4f 56 45 52 20 5b 49 5d 21 |[I]@ / OVER [I]!| 000002d0 20 4c 4f 4f 50 20 3b 0a 41 31 53 45 54 20 0a 41 | LOOP ;.A1SET .A| 000002e0 32 53 45 54 0a 41 33 53 45 54 0a 41 33 20 41 32 |2SET.A3SET.A3 A2| 000002f0 20 41 31 20 39 20 56 65 63 74 6f 72 41 64 64 20 | A1 9 VectorAdd | 00000300 41 33 4c 4f 4f 4b 20 34 33 20 4f 55 54 43 48 41 |A3LOOK 43 OUTCHA| 00000310 52 20 41 32 4c 4f 4f 4b 20 36 31 20 4f 55 54 43 |R A2LOOK 61 OUTC| 00000320 48 41 52 20 41 31 4c 4f 4f 4b 20 31 33 20 4f 55 |HAR A1LOOK 13 OU| 00000330 54 43 48 41 52 0a 41 33 20 41 32 20 41 31 20 39 |TCHAR.A3 A2 A1 9| 00000340 20 56 65 63 74 6f 72 53 75 62 20 41 33 4c 4f 4f | VectorSub A3LOO| 00000350 4b 20 34 35 20 4f 55 54 43 48 41 52 20 41 32 4c |K 45 OUTCHAR A2L| 00000360 4f 4f 4b 20 36 31 20 4f 55 54 43 48 41 52 20 41 |OOK 61 OUTCHAR A| 00000370 31 4c 4f 4f 4b 20 31 33 20 4f 55 54 43 48 41 52 |1LOOK 13 OUTCHAR| 00000380 0a 41 33 20 41 32 20 41 31 20 39 20 56 65 63 74 |.A3 A2 A1 9 Vect| 00000390 6f 72 4d 75 6c 20 41 33 4c 4f 4f 4b 20 34 32 20 |orMul A3LOOK 42 | 000003a0 4f 55 54 43 48 41 52 20 41 32 4c 4f 4f 4b 20 36 |OUTCHAR A2LOOK 6| 000003b0 31 20 4f 55 54 43 48 41 52 20 41 31 4c 4f 4f 4b |1 OUTCHAR A1LOOK| 000003c0 20 31 33 20 4f 55 54 43 48 41 52 0a 0a 0a | 13 OUTCHAR...| 000003ce
.