57
|
1 \ 6809 meta compiler to be run from an ANSI standard FORTH system
|
|
2 \ that contains the FILE wordset.
|
|
3
|
|
4 \ We need the word VOCABULARY. It's not in the standard though it will
|
|
5 \ be in most actual implementations.
|
|
6 : VOCABULARY WORDLIST CREATE , \ Make a new wordlist and store it in def.
|
|
7 DOES> >R \ Replace last item in the search order.
|
|
8 GET-ORDER SWAP DROP R> @ SWAP SET-ORDER ;
|
|
9
|
|
10 .( Loading the assembler "asm09.4") CR
|
|
11 S" asm09.4" INCLUDED
|
|
12
|
|
13 .( Loading the meta compiler "meta09.4") CR
|
|
14 S" meta09.4" INCLUDED
|
|
15
|
|
16 .( Compiling the kernel from "kernel09.4") CR
|
|
17 S" kernel09.4" INCLUDED
|
|
18
|
|
19 \ Save the binary image of the Forth system as Motorola S records.
|
|
20
|
|
21 DECIMAL
|
|
22 VARIABLE CHKSUM
|
|
23 CREATE SBUF 42 CHARS ALLOT
|
|
24 CHAR S SBUF C!
|
|
25 CHAR 1 SBUF CHAR+ C!
|
|
26 VARIABLE BYTECOUNT
|
|
27 VARIABLE ADDR
|
|
28 VARIABLE FILEHAND
|
|
29 : TOHEX ( byte addr ---) \ Conert byte to two-digit hex at addr
|
|
30 BASE @ >R HEX SWAP 0 <# # # #> DROP SWAP 2 CHARS CMOVE R> BASE ! ;
|
|
31 : FLUSHHEX \ Store the S-record buffer in a file
|
|
32 BYTECOUNT @ IF
|
|
33 BYTECOUNT @ 3 + DUP CHKSUM +! SBUF 2 CHARS + TOHEX
|
|
34 ADDR @ 8 RSHIFT 255 AND DUP CHKSUM +! SBUF 4 CHARS + TOHEX
|
|
35 ADDR @ 255 AND DUP CHKSUM +! SBUF 6 CHARS + TOHEX
|
|
36 255 CHKSUM @ 255 AND - SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX
|
|
37 SBUF 10 BYTECOUNT @ 2* + FILEHAND @ WRITE-LINE THROW
|
|
38 THEN BYTECOUNT @ ADDR +! 0 BYTECOUNT ! 0 CHKSUM ! ;
|
|
39 : PUTHEX ( byte ---) \ Store the byte in the S-record buffer
|
|
40 BYTECOUNT @ 16 = IF FLUSHHEX THEN
|
|
41 DUP CHKSUM +! SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX
|
|
42 1 BYTECOUNT +!
|
|
43 ;
|
|
44 : SAVE-IMAGE ( --- )
|
|
45 S" kernel09" W/O CREATE-FILE THROW FILEHAND !
|
|
46 0 CHKSUM ! 0 BYTECOUNT ! ORIGIN ADDR !
|
|
47 THERE ORIGIN - 0 DO IMAGE I + C@ PUTHEX LOOP FLUSHHEX
|
|
48 S" S9030000FC" FILEHAND @ WRITE-LINE THROW
|
|
49 FILEHAND @ CLOSE-FILE THROW
|
|
50 ;
|
|
51 SAVE-IMAGE
|
|
52 .( Image saved as "kernel09") CR
|
|
53
|
|
54 BYE
|