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
|
: -+ - + ;
: / /mod nip ;
: if immediate ' 0branch ,, here 0 , ;
: then immediate ] here swap ! ;
: find-) key 41 != if find-) ; then ;
: ( immediate find-) ;
( now there's parenthetical comments :)
: find-cr key 10 != if find-cr ; then ;
: \ immediate find-cr ;
\ and now line comments
: '@ @ ; \ A tickable @
: variable here 0 , word create ' lit ,, , exit ;
: constant here swap , word create ' lit ,, , ' '@ ,, exit ;
: array word create ' lit ,, here 0 , exit here swap ! ;
\ Some stuff for printing/compiling number strings
: cr 10 emit ;
: space 32 emit ;
: tab 9 emit ;
\ strings
: read-until-" key dup 34 = if 2drop ; then
c, 1 over +! read-until-" ;
: read-str
' lit ,, here 0 , \ ptr
' lit ,, here 0 , \ cnt
' branch ,, here 0 , \ branch
rot here swap ! \ ptr set
swap
read-until-"
0 c, \ Null terminate strings for syscalls
here swap !
;
: s" immediate read-str ;
: print dup 0<= if 2drop ; then
1- swap dup c@ emit 1+ swap print ;
: ." immediate
read-str
' print ,,
;
\ Exit back to linux
: bye 0 1 syscall1 ;
: fatal 1 1 syscall1 ;
\ File IO
0 constant OREAD
1 constant OWRITE
2 constant ORW
100 constant OCREATE
1 constant PROT_READ
2 constant PROT_WRITE
1 constant MAP_SHARED
variable zero 0 zero !
: ?error -1 = if ." file syscall error" cr fatal ; then ;
: write 4 syscall3 dup ?error ;
: _open 5 syscall3 dup ?error ;
: close 6 syscall1 ?error ;
: lseek 19 syscall3 dup ?error ;
: truncate 92 syscall2 ?error 42 emit ;
: open nip 0 _open ;
: screate nip OCREATE or 420 _open ;
: rswap <r <r swap >r >r ;
: mmap ( path -- ptr )
ORW open dup dup >r fsize dup <r swap >r >r 0 swap
PROT_READ PROT_WRITE or MAP_SHARED <r 0 192 syscall6 dup ?error
swap close <r ;
: mmap-screate ( path len -- ptr ) ( fl )
>r ORW screate <r
2dup 1- 0 lseek drop over zero 1 write drop
swap dup >r >r 0 swap
PROT_READ PROT_WRITE or MAP_SHARED <r 0 192 syscall6 dup ?error
<r close ;
\ String tokeniser
variable cur
variable len
variable end
array buffer 50 allot
: ?end end @ >= ;
: ?sep 33 < ;
: cnt-word ( cnt ptr -- cnt )
dup ?end if drop ; then
dup c@ ?sep if drop ; then
swap 1+ swap 1+ cnt-word ;
: find-first-char ( ptr -- ptr )
dup ?end 0= if
dup c@ ?sep if 1+ find-first-char ; then
then ;
: tokenise ( ptr len -- ) over + end ! cur ! 0 len ! ;
: token ( -- ptr len ) cur @ len @ + find-first-char dup cur !
0 over cnt-word dup len ! ;
\ log math
: lsqrt 0.5 lpow ;
: sq dup l* ;
\ High level operators
variable map-fun
variable map-stat
: do-map dup 0<= if drop ; then
1- @+ map-fun @ execute !+ do-map ;
: map ( pnf -- ) map-fun ! swap dup >a >b do-map ;
: do-sweep dup 0<= if drop ; then
@+ map-stat @ map-fun @ execute !+ 1- do-sweep ;
: sweep ( pnsf -- ) map-fun ! map-stat ! swap dup >a >b do-sweep ;
|
