-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathenviron.fs
101 lines (79 loc) · 2.31 KB
/
environ.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
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
\ *** ENVIRONMENT? *** 03may92py
Vocabulary environment environment definitions
$FF Constant /counted-string
&66 Constant /hold
: /pad &84 ;
8 Constant address-unit-bits
' true Alias floored
$FF Constant max-char
: max-d $7FFFFFFFFFFFFFFF. ;
$7FFFFFFF Constant max-n
-1 Constant max-u
: max-ud -1. ;
: return-stack-cells r0 @ up@ udp @ + - cell/ ;
: stack-cells s0 @ s^ @ - cell/ ;
base @ decimal
s" version.h" r/o open-file throw
pad $100 2 pick read-line throw drop swap close-file throw
pad swap '" skip '" -skip
2dup 2dup '. scan nip - s>number drop -rot '. scan '. skip
2dup 2dup '. scan nip - s>number drop -rot '. scan '. skip
s>number drop
swap &100 * +
: bigFORTH ( -- minor*100+minor-minor major ) [ -rot ] Literal Literal ;
s" minos-version.h" r/o open-file throw
pad $100 2 pick read-line throw drop swap close-file throw
pad swap '" skip '" -skip
2dup 2dup '. scan nip - s>number drop -rot '. scan '. skip
2dup 2dup '. scan nip - s>number drop -rot '. scan '. skip
s>number drop
swap &100 * +
: MINOS ( -- minor*100+minor-minor major ) [ -rot ] Literal Literal ;
base !
: forthid s" bigFORTH" ;
: forthver ( -- major minor minor-minor )
bigFORTH &100 /mod swap ;
true Value core
true Value core-ext
\ other wordsets 28dec94py
true Value block
true Value block-ext
true Value double
true Value double-ext
true Value exception
true Value exception-ext
true Value facility
true Value facility-ext
true Value file
true Value file-ext
false Value floating
false Value floating-ext
8 Value floating-stack
-1 Value #locals
false Value locals
false Value locals-ext
true Value memory-alloc
true Value memory-alloc-ext
true Value tools
true Value tools-ext
true Value search-order
true Value search-order-ext
$10 Constant wordlists
true Value string
true Value string-ext
' noop alias X:deferred
' noop alias X:defined
' noop alias X:ekeys
' noop alias X:extension-query
' noop alias X:fp-stack
' noop alias X:ftrunc
' noop alias X:number-prefixes
' noop alias X:parse-name
\ ' noop alias X:required
' noop alias X:structures
' noop alias X:xchar
Forth definitions
: environment? ( addr u -- values t / f )
& environment search-wordlist
IF execute true ELSE false THEN ;
: environmental ( -- values t / f ) name count environment? ;