-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathff.ff
219 lines (190 loc) · 8.83 KB
/
ff.ff
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
variable features 100 allot
: append ( @ # c@ -- ) 2dup c@ + over 2>r c@+ + place drop 2r>
2dup c! + 1+ 0 swap c! ;
: appendc ( c c@ -- ) tuck c@+ + tuck c! 0 over 1+ c! over- swap c! ;
: -v` ."\\ features: " features c@+ type cr ;
"help" features append
"help`" find 2drop '_' 8 which@ tuck ct|! h.nm+ c! \ to be deleted by hidepvt
: help` \ <name> -- ; display help for <name>, or for "help" by default
wsparse 0= IF 2drop "help" THEN
[` 2>r "ff.help" needed 2r> _] 0; \ dup this line for your own help file(s)
!"no_help_found_for_this_word"
: within over- -rot - u> 2drop nzTRUE ? zFALSE ; \ n [ ) -- ; nz?
: max` >` IF` swap` THEN` nip` ; \ n2 n1 -- max(n2,n1)
: min` <` IF` swap` THEN` nip` ; \ n2 n1 -- min(n2,n1)
: pick` \ xn..x0 n -- xn..x0 xn
\ must be preceded by "52(push edx)6Axx(push byte)5A(pop edx)"
here 4- @ $FE00FFFE& $5A006A52- 0<> IF !"is_not_preceded_by_a_constant" ;THEN
drop -3 allot here 1+ c@ 1- 0= IF drop ;THEN \ "52(push edx)"=over` C=1
0< IF drop swap` nipdup` ;THEN \ i.e. dup`
$5C8B, s08 10 << $24+ w, ; \ 8B5C24xx(mov ebx,[esp+4n])
: 2over` 3 lit` pick` 3 lit` pick` ;
\ $89%11&sd(mov d,s) 0:eax 1:ecx 2:edx 3:ebx 4:esp 5:ebp 6:esi 7:edi
: rp@` over` $C389, s01 ; \ 89C3(mov ebx,eax) -> 89D8(mov eax,ebx)
: sp@` over` $E389, s01 ; \ 89E3(mov ebx,esp) -> 89DC(mov esp,ebx)
\ : rsp!` >C1 $D089DC89, s08 s08 2drop` ; \ rp sp -- ; for multitasking
constant` ' alias equ` \ shorter, and more usual for assembly programmers
\ --------------------------------------------------------------------
\ pictured numeric output: <# # #s hold sign #>
46 constant pnmaxlen
create pnbuf pvt pnmaxlen 2+ allot
: <# pnmaxlen pnbuf c! 0 pnbuf pnmaxlen+ 1+ c! ; <#
: #> 2drop pnbuf c@+ swap over+ swap pnmaxlen swap - ;
:. _len1- pnbuf dupc@ 1- swap c! ;
: hold pnbuf dupc@ + c! _len1- ;
:. _dh 9 u> drop IF over+ THEN nip '0'+ 'z' u> drop IF '?'_ THEN hold ;
:. _# >r um/mod r> rot _dh 0 ;
: # base@ 7 _# ;
: x# $10 39 _# ;
: X# $10 7 _# ;
:. _s >r BEGIN r execute over 0- drop 0= UNTIL rdrop ;
: #s # ' _s ;
: x#s x# ' _s ;
: X#s X# ' _s ;
: sign 0- drop 0< IF '-' hold THEN ;
\ --------------------------------------------------------------------
\ ?ior malloc/free lseek ioctl/select
\ fixup replaces a 5 byte call with a mov ebx,funh and
\ modifies the call stack to return to just before the mov;
\ used for once-only symbol resolution at runtime (turnkey safe)
: fixup libc@ #fun rdrop r> 5- dup>r $bb overc! 1+ ! ;
:. _strerror "strerror" fixup
: strerror negate 1 dup _strerror #call zlen type cr ;
variable ior \ I/O result, error when negative:
: ?ior dup ior! \ n -- ; displays system error message
: ?ior. dup $FF | -1 <> 2drop IF drop ;THEN strerror !"system_call_failed" ;
:. _malloc "malloc" fixup
: malloc 1 dup _malloc #call ; \ # -- @ ; see "man malloc"
:. _free "free" fixup
: free 1 dup _free #call drop ; \ @ --
\ syscall values see /usr/include/asm-i386/unistd.h
: lseek 3 19 syscall ; \ wh off fd -- off ; wh=0:SET 1:CUR 2:END
: ioctl 3 54 syscall ; \ int ioctl(int fd, int request, void* arg);
: select 5 142 syscall ; \ timeval* exceptfds* writefds* readfds* n -- ?
\ st_dev 0 st_ino 12 st_mode 16 st_nlink 20 st_uid 24 st_gid 28 st_rdev 32
\ st_size 44 st_blksize 48 st_blocks 52 st_atim 56 st_mtim 64 st_ctim 72
: mkst` create` 98 allot` ;
: stat nip tuck 98 erase 2 195 syscall ; \ stat64
44 constant st.size
\ --------------------------------------------------------------------
\ call back
: 'callback:` '` :` \ xt <name> -- ; .. arg1 arg0 ret -C- .. arg1 arg0 ; 28/
\ 5A(pop edx)8D8424.00FFFFFF(lea eax,[esp-256])94(xchg eax,esp)
\ 52(push edx)60(pusha) \ -- ret eax ecx edx ebx esp ebp esi edi
\ 94(xchg eax,esp)5B(pop ebx)5A(pop edx)94(xchg eax,esp)E8.long(call xt)
$24848D5A, ,4 $FFFF'FF00, ,4 $94605294, ,4 $E8945A5B, ,4 here 4+ - ,
\ 895C24.1C(mov[esp+28],ebx)61(popa)C2.0001(ret 256)
$1C245C89, ,4 $0100C261, ,4 anon:`
;
variable fdset pvt 0 , 0 , \ for select, the 2 zeros are a null timeval
: key? stdin
: fdin? \ fd -- ; returns zFALSE if file-descriptor fd would wait for input
1 swap << fdset! \ fd_set READ; select will return 0 or 1 (or 0<)
fdset 4+ 0 0 fdset $20 select dup ?ior 0- drop
;
:. _TCGETS $5401 SKIP \ see termios
:. _TCSETSW $5403 THEN eob swap stdin ioctl ?ior ;
: ekey \ -- c ; raw access to keyboard input
\ not yet perfect: line-discipline-control-chars still interpreted,
\ more to patch in termios structure...
_TCGETS eob 12+ dup@ swap &100 over! \ -- n eob+12 ; raw
_TCSETSW key -rot ! _TCSETSW
;
: stopdump? key 10- drop ;
: ;dump` ;` BEGIN 16 bounds under 2dump stopdump? 0<> UNTIL drop ; \ @ --
\ --------------------------------------------------------------------
\ OS shell/command interface
\ Note: literal strings are already zero-terminated.
\ Note: as wsparse considers the NUL character as whitespace, NUL may replace
\ any other whitespace (HT,LF,VT,FF,CR,space) without breaking source code.
: zt \ @ # -- @ ; append zero-terminator
over+ 0 swap c! ;
:. _getenv "getenv" fixup
: getenv 1_ dup _getenv #call 0- 0= IF 0 ELSE zlen THEN ;
:. _getpid "getpid" fixup
: getpid 0 0 _getpid #call ;
:. _getppid "getppid" fixup
: getppid 0 0 _getppid #call ;
:. _system "system" fixup
: system zt 1 dup _system #call ;
: man` >in@ 4- lnparse + over- \ <mantopic> -- ; 4-:"man_" fallthru
: shell \ @ # -- ; send command to shell, command result into ior
system 0; ior! !"shell_call_failed"
: cd` \ <newdir> -- ; change directory
wsparse zt 1 12 syscall ?ior
;
: !!` \ <line> -- ; send command line to shell
lnparse shell ;
\ --------------------------------------------------------------------
[1] [IF] " locals" features append \ Local variables
\ 8B5804(mov ebx,[eax+0x4])
\ 8918(mov [eax],ebx) \ 895804(mov [eax+0x4],ebx)
: r0!` >C1 $1889, s08 drop` ;
: r1` over` $04588B, s08 ,1 ;
: r1!` >C1 $045889, s08 ,1 drop` ;
: r2` over` $08588B, s08 ,1 ;
: r2!` >C1 $085889, s08 ,1 drop` ;
: r3` over` $0C588B, s08 ,1 ;
: r3!` >C1 $0C5889, s08 ,1 drop` ;
: r4` over` $10588B, s08 ,1 ;
: r4!` >C1 $105889, s08 ,1 drop` ;
: r5` over` $14588B, s08 ,1 ;
: r5!` >C1 $145889, s08 ,1 drop` ;
\ 83E804(sub eax,4)8F00(pop dword[eax])4B(dec ebx)75F8(jnz -8)
: >>r` under` 0-` 0>` IF` $4E883, ,3 $1008F, ,2 $4B, s1 $F875, ,2 THEN` 2drop` ;
\ C1E302(shl ebx,2)01D8(add eax,ebx)
: +r` >C1 $02E3C1, s01 ,1 $D801, s08 drop` ;
\ 29D8(sub eax,ebx)
: -r` >C1 $02E3C1, s01 ,1 $D829, s08 drop` ;
\ C1E202(shl edx,2)29D0(sub eax,edx)
\ 8F00(pop dword[eax])83C004(add eax,4)4B(dec ebx)75F8(jnz -8)
: >>rr` dup` 0-` 0>` IF` $02E2C1, ,3 $D029, ,2
$1008F, ,2 $4C083, ,3 $4B, ,1 $F875, ,2
$D029, ,2 THEN` 2drop` ;
r` ' alias r0`
r0!` ' alias r!`
+r` ' alias xxr`
[THEN]
\ --------------------------------------------------------------------
\ console display control (topleft=0,0)
: cls` ( -- ) ."^[[2J"
: home ( -- ) 0 dup
: atxy ( xCol yRow -- ) ."^[[" 1+ .dec\ .";" 1+ .dec\ ."H" ;
: atx ( xCol -- ) ."^[[" 1+ .dec\ ."G" ;
[1] [IF] " normal" features append \ symbolic attributes and color names
:^ color ( n -- ) ."^[[" .dec\ ."m" ;
:. _nocolor drop ;
: nocolor _nocolor ' color !^ ;
: normal 0 color ; : bold 1 color ; : dim 2 color ;
: underline 4 color ; : blink 5 color ; : inverse 7 color ;
: concealed 8 color ; : foreground 30+ color ; : background 40+ color ;
0 constant black 1 constant red 2 constant green 3 constant yellow
4 constant blue 5 constant magenta 6 constant cyan 7 constant white
:. _ss 1- 0; swap >r _ss r .x r> ;
: ss depth cyan foreground ."( " dup .dec\ ."; " 1+ 3 max _ss .")^J" normal ;
: dd depth TIMES drop REPEAT ;
[THEN]
\ --------------------------------------------------------------------
[1] [IF] " .now" features append \ Calendar date and time display
:. _leap .dec\ ."-2-29" drop ;
: .d ( n -- ; display days since 0-0-0 as gregorian date )
146097 /% 400* swap 146096 = drop IF swap 400+ _leap ;THEN
36524 /% 100* rot + swap
1461 /% 4* rot + swap 1460 = drop IF swap 4+ _leap ;THEN
365 /% rot + swap \ -- y rem
dup 31+ 5* 153/ 2+ tuck 1+ 153* 5/ 123- - -rot \ -- d y m
12 > drop IF 12- swap 1+ swap THEN swap \ -- d m y
.dec\ ."-" .dec\ ."-" .dec\ ;
: .wd ( n -- ) 7% 3* "wedthufrisatsunmontue" drop + 3 type ;
: now \ -- n ; returns number of seconds since 2000-3-1_0:0:0
0 1 13 syscall [ 1970-1-1 2000-3-1- 24:0:0* 1:0:0+ ] lit + ;
: .now` ( -- ) now dup 24:0:0/ .wd space \ display current date&time
: .dt ( n -- ) 24:0:0 /% 2000-3-1+ .d ."\_" \ display seconds as date&time
: .t ( n -- ) 60 /% 60 /% .dec\ .":" .dec\ .":" .dec ; \ display seconds as time
[THEN]
: ms@ \ -- n ; get current milliseconds count
eob 0 over 2 78 syscall drop 2@ 1000* swap 1000/ + ;
: ms \ n -- ; wait n milliseconds
1000 /% swap 1'000'000* swap eob 2! 0 eob 2 162 syscall drop ;
"FFHIDE" getenv 0- 0<> IF swap c@ $30- 0= IF hide off THEN THEN 2drop ;
hidepvt " hidepvt" features append ;