annotate examples_forth/cross09.4 @ 86:4967d1acd34a

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