Mercurial > hg > Members > kono > os9 > sbc09
comparison examples_forth/cross09.4 @ 57:2088fd998865
sbc09 directry clean up
| author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Mon, 23 Jul 2018 16:07:12 +0900 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 56:4fa2bdb0c457 | 57:2088fd998865 |
|---|---|
| 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 |