fcc/tlin.fth at main · CCurl/fcc · GitHub

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
// Test file for the Linux version

// Output a single character to stdout
// NOS: the char, TOS, addr to store the char
// EAX = 4: syscall number (write)
// EBX = 1: stdout
// ECX = address of buffer with chars to output
// EDX is the number of chars to write
: outChar ( c a-- ) code
	pop ebx
	mov [eax], bl
	mov edx, 1
	mov ecx, eax
	mov ebx, 1
	mov eax, 4
	int 0x80
	pop eax
end-code
;

var _em
: emit  ( c-- ) _em outChar ;

// Read a single character from stdin
// Needs CR to complete
// EAX = 3: syscall number (read)
// EBX = 1: stdout
// ECX = address of buffer to store the char
// EDX is the number of chars to read
: inKey ( buf--c ) code
	mov ebx, 0
	mov ecx, eax
	mov edx, 1
	mov eax, 3
	push ecx
	int 0x80
	pop ecx
	movzx eax, byte [ecx]
end-code
;

var _k
: key ( -- c ) _k inKey ;

: bye code
	mov eax, 1
	xor ebx, ebx
	int 0x80
end-code
;

: @a  a@ @ ;				: !a  a@ ! ;
: @a+ @a  a@ 4 + a! ;		: !a+ !a  a@ 4 + a! ;
: @a- @a  a@ 4 - a! ;		: !a- !a  a@ 4 - a! ;

: c@a   a@ c@ ;				: c!a   a@ c! ;
: c@a+  c@a  a+ ;			: c!a+  c!a  a+ ;
: c@a-  c@a  a- ;			: c!a-  c!a  a- ;

: +L +locs  a@ l0 ! ;
: -L l0 @  a!  -locs ;

: 0= if 0 exit then 1 ;
: ztype ( a-- ) +L  a!
	begin
		c@a+ dup 0=
		if drop -L exit then
		emit
	again ;


: Mil ( n--m ) 1000 dup * * ;
: cr 10 emit ;
: space 32 emit ;
: negate 0 swap - ;

var base
var buf 3 allot
var #n
: (.) ( n -- )
	+L #n a! 0 dup c!a- c!a-
	dup 0 < if 1 #n c! negate then
	begin
		base @ /mod swap '0' +
		dup '9' > if 7 + then
		c!a- dup
	while drop
	#n c@ if '-' c!a- then
	a@ 1+ ztype -L ;
: . (.) space ;

: strlen ( a--n )
	+locs  a@ l0 !  a!
	0  begin  1+  a@ c@  a+  while
	1-  l0 @ a!  -locs ;

var x
: x++  x @ 1+ x ! ;
: x+4  x @ 4 + x ! ;

: t0 cr 't' emit . ;
: t1   1 t0 s" hello world!" ztype ;
: t2   2 t0 1234 s" hello" strlen . . ;
: t3   ( 3 t0 key . ) ;
: t4   4 t0 0= if 'n' emit exit then 'y' emit ;
: t5   5 t0 buf a! 'h' c!a+ 'i' c!a+ 0 c!a buf ztype space ;
: t6   6 t0 666 222 ->reg2  333 ->reg3  444 ->reg4 . s" (should print 666)" ztype ;
: t7   7 t0 s" test ztype ..." ztype ;
: t8   8 t0 3344 . -3344 . $1234 . 1234 #16 base ! . #10 base ! ;
: t9   9 t0 999 123 100 /mod . . . ;
: t10 10 t0 'g' x c! x c@ dup . emit ;
: t11 11 t0 's' emit 999 Mil dup (.) begin 1- dup while drop 'e' emit ;
: t12 12 t0 +locs s" -l3-" l3 ! +locs 17 l3 ! l3 @ . -locs l3 @ ztype -locs ;
: t999 s" bye" ztype cr bye ;

: main
	10 base !
	t1 t2 t3 0 t4 1 t4 t5 t6 t7 t8 t9 t10 t11 t12
	cr t999 cr
	s" still here?" ztype ;