forked from dan4thewin/FreeForth2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathff.ff
123 lines (106 loc) · 4.81 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
variable features 80 allot
: append ( @ # c@ -- ) 2dup c@ + over 2>r c@+ + place drop 2r> c! ;
: -v` ."\\_features:_" features c@+ type cr ;
"help" features append
"help`" find 2drop '`' which@ 6+ c! \ to be deleted by hid'm
: 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- 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])
\ $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
\ --------------------------------------------------------------------
\ ?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
$FF | -1 = 2drop IF ior@ strerror !"system_call_failed" THEN
;
: `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 -- ?
variable `fdset 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
;
\ --------------------------------------------------------------------
\ 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 zt 1 dup `getenv #call 0- 0= IF 0 ELSE zlen THEN ;
: `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-` 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-` 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]