-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathboot.fs
53 lines (40 loc) · 1.46 KB
/
boot.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
: CHAR PARSE-NAME DROP C@ ;
: [CHAR] CHAR POSTPONE LITERAL ; IMMEDIATE
: ( [CHAR] ) PARSE 2DROP ; IMMEDIATE
( At compile-time, compile the string specified by addr1 u to the
current definition. At run-time, addr2 u specifies the compiled
string. )
: SLITERAL ( ct: addr1 u -- rt: -- addr2 u )
POSTPONE (SLITERAL)
DUP C,
>R HERE R@ CMOVE
R> CP +!
; IMMEDIATE
( Parse and compile ccc delimited by ". At run-time, addr u specifies
the compiled string. )
: S" ( "ccc<quote>" -- addr u )
[CHAR] " PARSE POSTPONE SLITERAL
; IMMEDIATE
: ." POSTPONE S" POSTPONE VDP-TYPE ; IMMEDIATE
: IF POSTPONE 0BRANCH HERE 0 , ; IMMEDIATE
: THEN HERE SWAP ! ; IMMEDIATE
: ELSE POSTPONE BRANCH HERE 0 , SWAP POSTPONE THEN ; IMMEDIATE
: DO HERE POSTPONE 2>R ; IMMEDIATE
: LOOP POSTPONE 2R> POSTPONE 1+ POSTPONE (LOOP) POSTPONE 0BRANCH ,
POSTPONE 2DROP ; IMMEDIATE
: I POSTPONE R@ ; IMMEDIATE
( write ASCII table to screen )
: WRITEASCII 256 0 DO I VDPDATA C! LOOP ;
CLEAR-VRAM LOAD-FONT VDP-INIT 0 VDP-POS
: CLEAR 0 VDP-POS 960 0 DO BL EMIT LOOP 0 VDP-POS ;
( printing out sectors )
: SECTOR 8 + 12 LSHIFT ;
: PAGE 9 LSHIFT + ;
: PRINT-LINE 32 0 DO DUP C@ EMIT 1+ LOOP ;
: LIST SECTOR SWAP PAGE 16 0 DO CR PRINT-LINE LOOP DROP ;
( writing to blocks )
: >BLOCK" 2DUP BLOCK SWAP PAGE [CHAR] " PARSE >R SWAP R@ CMOVE FLUSH
SECTOR SWAP PAGE R> ;
( evaluation )
: EVALUATE (SOURCE) 2! 0 >IN ! INTERPRET ;
CLEAR .( FORTH booted successfully ) CR QUIT