Check-in [740b68635e]
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login Impressum Datenschutzerklärung

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Use synonym instead of alias
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 740b68635ed1cdcbd92fc9e85d8a474db670b6a8
User & Date: bernd 2019-05-04 12:06:11
Context
2019-05-04
23:39
night mode less colorfull check-in: 5faad66ffb user: bernd tags: trunk
12:06
Use synonym instead of alias check-in: 740b68635e user: bernd tags: trunk
10:11
Use dummy-dict to create dummy local check-in: b9cb7d1176 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to 64bit.fs. 

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
220
221
222
223
224
225
226
227
228
229
230

: umin! ( n addr -- )   >r r@ @ umin r> ! ;
: umax! ( n addr -- )   >r r@ @ umax r> ! ;

1 pad ! pad c@ negate constant le?

cell 8 = [IF]
    : 64bit ;
    ' @ Alias 64@
    ' ! Alias 64!
    ' le-ux@ Alias le-64@
    ' le-x! Alias le-64!
    ' be-ux@ Alias be-64@
    ' be-x! Alias be-64!
    ' noop Alias 64><
    ' swap alias n64-swap
    ' swap alias 64n-swap
    ' dup Alias 64dup
    ' over Alias 64over
    ' drop Alias 64drop
    ' nip Alias 64nip
    ' swap Alias 64swap
    ' tuck Alias 64tuck
    ' + Alias 64+
    ' - Alias 64-
    ' or Alias 64or
    ' and Alias 64and
    ' xor Alias 64xor
    ' Variable Alias 64Variable
    ' User Alias 64User
    ' Constant Alias 64Constant
    ' Value Alias 64Value
    ' 2/ Alias 64-2/
    ' 2* Alias 64-2*
    ' negate Alias 64negate
    ' invert Alias 64invert
    0 Constant 64#0
    1 Constant 64#1
    -1 Constant 64#-1
    synonym 64literal literal
    ' rshift Alias 64rshift
    ' lshift Alias 64lshift
    ' rol Alias 64rol
    ' ror Alias 64ror
    ' s>f Alias 64>f
    ' f>s Alias f>64
    ' = Alias 64=
    ' <> Alias 64<>
    -1 1 64rshift Constant max-int64
    ' u. alias u64.
    ' . alias s64.
    ' noop Alias 64>n immediate
    ' noop Alias n>64 immediate
    ' noop Alias u>64 immediate
    ' s>d Alias 64>d
    ' drop Alias d>64
    ' >r Alias 64>r
    ' r> Alias 64r>
    ' 0= Alias 64-0=
    ' 0<> Alias 64-0<>
    ' 0>= Alias 64-0>=
    ' 0<= Alias 64-0<=
    ' 0< Alias 64-0<
    ' < Alias 64<
    ' > Alias 64>
    ' u< Alias 64u<
    ' u> Alias 64u>
    ' u<= Alias 64u<=
    ' u>= Alias 64u>=
    ' on Alias 64on
    ' +! Alias 64+!
    ' min Alias 64min
    ' max Alias 64max
    ' umin Alias 64umin
    ' umax Alias 64umax
    ' abs Alias 64abs
    ' off Alias 64off
    ' */ Alias 64*/
    ' * Alias 64*
    : 128@ ( addr -- d ) 2@ swap ;
    : 128! ( d addr -- ) >r swap r> 2! ;
    ' d+ Alias 128+ \ 128 bit addition
    ' d- Alias 128- \ 128 bit addition
    ' stop-ns alias stop-64ns
    also locals-types definitions
    ' w: alias 64:
    ' w^ alias 64^
    previous definitions
    ' min! Alias 64min!
    ' max! Alias 64max!
    ' umin! Alias 64umin!
    ' umax! Alias 64umax!
    ' !@ Alias 64!@
    ' be-ux@ Alias be@
    ' be-x! Alias be!
[ELSE]
    ' rot alias n64-swap
    ' -rot alias 64n-swap
    ' 2drop alias 64drop
    ' 2nip alias 64nip
    ' 2dup Alias 64dup
    ' 2over Alias 64over
    ' 2swap Alias 64swap
    ' 2tuck Alias 64tuck
    ' swap Alias 64><
    : 64@  2@ 64>< ; [IFDEF] macro macro [THEN]
    : 64!  >r 64>< r> 2! ; [IFDEF] macro macro [THEN]
    ' le-uxd@ Alias le-64@
    ' le-xd! Alias le-64!
    ' be-uxd@ Alias be-64@
    ' be-xd! Alias be-64!
    ' d+ Alias 64+
    ' d- Alias 64-
    : 64or rot or >r or r> ;
    : 64and rot and >r and r> ;
    : 64xor rot xor >r xor r> ;
    ' 2Variable Alias 64Variable
    : 64User  User cell uallot drop ;
    ' 2Constant Alias 64Constant
    ' 2Value Alias 64Value
    ' d2/ Alias 64-2/
    ' d2* Alias 64-2*
    ' dnegate Alias 64negate
    : 64invert invert swap invert swap ;
    #0. 2Constant 64#0
    #1. 2Constant 64#1
    #-1. 2Constant 64#-1
    synonym 64literal 2literal
    ' dlshift Alias 64lshift
    ' drshift Alias 64rshift
    ' drol Alias 64rol
    ' dror Alias 64ror
    ' d>f Alias 64>f
    ' f>d Alias f>64
    ' d= Alias 64=
    ' d<> Alias 64<>
    #-1. 1 64rshift 64Constant max-int64
    ' ud. alias u64.
    ' d. alias s64.
    ' drop Alias 64>n
    ' noop Alias 64>d immediate
    ' noop Alias d>64 immediate
    ' s>d Alias n>64
    ' false Alias u>64
    ' 2>r Alias 64>r
    ' 2r> Alias 64r>
    ' d0= Alias 64-0=
    ' d0<> Alias 64-0<>
    ' d0>= Alias 64-0>=
    ' d0<= Alias 64-0<=
    ' d0< Alias 64-0<
    ' d< Alias 64<
    ' d> Alias 64>
    ' du< Alias 64u<
    ' du> Alias 64u>
    ' du<= Alias 64u<=
    ' du>= Alias 64u>=
    : 64on ( addr -- )  >r 64#-1 r> 64! ;
    : 64+!  ( 64n addr -- )  dup >r 64@ 64+ r> 64! ;
    ' dmin Alias 64min
    ' dmax Alias 64max
    : 64umin  2over 2over du> IF  2swap  THEN  2drop ;
    : 64umax  2over 2over du< IF  2swap  THEN  2drop ;
    ' dabs Alias 64abs
    : 64off #0. rot 64! ;
    ' m*/ Alias 64*/
    : 64* ( d1 d2 -- d3 ) { l1 h1 l2 h2 }
	l1 l2 um* l1 h2 um* l2 h1 um* d+ drop + ;
    : 128@ ( addr -- x1..x4 )
	>r
	r@ @
	r@ cell+ @
	r@ 2 cells + @
................................................................................
	r> 3 cells + @ ;
    : 128! ( x1..x4 addr -- )
	>r
	r@ 3 cells + !
	r@ 2 cells + !
	r@ cell+ !
	r> ! ;
    ' stop-dns alias stop-64ns
    : compile-pushlocal-64 ( a-addr -- ) ( run-time: w1 w2 -- )
	locals-size @ alignlp-w cell+ cell+ dup locals-size !
	swap !
	postpone >l postpone >l ;
    also locals-types definitions
    ' d: alias 64:
    : 64^ ( "name" -- a-addr xt ) \ net2o 64-caret
	create-local
	['] compile-pushlocal-64
      does> ( Compilation: -- ) ( Run-time: -- w )
	postpone laddr# @ lp-offset, ;
    previous definitions
    ' dummy-dict ' dict-execute ' locals-types:64^ wrap-xt dummy-64^ 2drop
................................................................................
    : dumin ( ud1 ud2 -- ud3 )  2over 2over du> IF  2swap  THEN  2drop ;
    : dumax ( ud1 ud2 -- ud3 )  2over 2over du< IF  2swap  THEN  2drop ;
    : 64!@ ( value addr -- old-value )   >r r@ 64@ 64swap r> 64! ;
    : 64min! ( d addr -- )  >r r@ 64@ dmin r> 64! ;
    : 64max! ( d addr -- )  >r r@ 64@ dmax r> 64! ;
    : 64umin! ( n addr -- )   >r r@ 64@ dumin r> 64! ;
    : 64umax! ( n addr -- )   >r r@ 64@ dumin r> 64! ;
    ' be-ul@ alias be@
    ' be-l! alias be!
    : 128+ ( 128a 128b -- 128c ) \ 128 bit addition
	{ d: a1 d: a2 d: b1 d: b2 }
	a1 b1 d+ a2 b2 d+ 2over a1 du< s>d d- ;
    : 128- ( 128a 128b -- 128c ) \ 128 bit addition
	{ d: a1 d: a2 d: b1 d: b2 }
	a1 b1 d- a2 b2 d- 2over a1 du> s>d d+ ;
[THEN]
\ independent of cell size, using dfloats:
' dfloats Alias 64s
' dfloat+ Alias 64'+
' dfaligned Alias 64aligned
' dffield: Alias 64field:
: x64. ( 64n -- ) ['] u64. $10 base-execute ;
: le-128@ ( addr -- d )
    dup >r le-64@ r> 64'+ le-64@ ;
: le-128! ( d addr -- )
    dup >r 64'+ le-64! r> le-64! ;
: be-128@ ( addr -- d )
    dup >r 64'+ be-64@ r> be-64@ ;
: be-128! ( d addr -- )
    dup >r be-64! r> 64'+ be-64! ;
: 64>128 ( 64 -- 128 ) 64dup 64-0< n>64 ;
Create 64!-table ' 64! , ' 64+! ,
1 64s ' 64aligned ' 64@ 64!-table wrap+value: 64value: ( u1 "name" -- u2 )








|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|




|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|


|
|
|

|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|


|
|
|
|
|
|



|

|
|
|
|
|





|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|


|
|


|

|







 







|





|







 







|
|








|
|
|
|













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
220
221
222
223
224
225
226
227
228
229
230

: umin! ( n addr -- )   >r r@ @ umin r> ! ;
: umax! ( n addr -- )   >r r@ @ umax r> ! ;

1 pad ! pad c@ negate constant le?

cell 8 = [IF]
    : 64bit ;
    synonym 64@ @
    synonym 64! !
    synonym le-64@ le-ux@
    synonym le-64! le-x!
    synonym be-64@ be-ux@
    synonym be-64! be-x!
    synonym 64>< noop
    synonym n64-swap swap
    synonym 64n-swap swap
    synonym 64dup dup
    synonym 64over over
    synonym 64drop drop
    synonym 64nip nip
    synonym 64swap swap
    synonym 64tuck tuck
    synonym 64+ +
    synonym 64- -
    synonym 64or or
    synonym 64and and
    synonym 64xor xor
    synonym 64Variable Variable
    synonym 64User User
    synonym 64Constant Constant
    synonym 64Value Value
    synonym 64-2/ 2/
    synonym 64-2* 2*
    synonym 64negate negate
    synonym 64invert invert
    0 Constant 64#0
    1 Constant 64#1
    -1 Constant 64#-1
    synonym 64literal literal
    synonym 64rshift rshift
    synonym 64lshift lshift
    synonym 64rol rol
    synonym 64ror ror
    synonym 64>f s>f
    synonym f>64 f>s
    synonym 64= =
    synonym 64<> <>
    -1 1 64rshift Constant max-int64
    synonym u64. u.
    synonym s64. .
    synonym 64>n noop immediate
    synonym n>64 noop immediate
    synonym u>64 noop immediate
    synonym 64>d s>d
    synonym d>64 drop
    synonym 64>r >r
    synonym 64r> r>
    synonym 64-0= 0=
    synonym 64-0<> 0<>
    synonym 64-0>= 0>=
    synonym 64-0<= 0<=
    synonym 64-0< 0<
    synonym 64< <
    synonym 64> >
    synonym 64u< u<
    synonym 64u> u>
    synonym 64u<= u<=
    synonym 64u>= u>=
    synonym 64on on
    synonym 64+! +!
    synonym 64min min
    synonym 64max max
    synonym 64umin umin
    synonym 64umax umax
    synonym 64abs abs
    synonym 64off off
    synonym 64*/ */
    synonym 64* *
    : 128@ ( addr -- d ) 2@ swap ;
    : 128! ( d addr -- ) >r swap r> 2! ;
    synonym 128+ d+ \ 128 bit addition
    synonym 128- d- \ 128 bit addition
    synonym stop-64ns stop-ns
    also locals-types definitions
    synonym 64: w:
    synonym 64^ w^
    previous definitions
    synonym 64min! min!
    synonym 64max! max!
    synonym 64umin! umin!
    synonym 64umax! umax!
    synonym 64!@ !@
    synonym be@ be-ux@
    synonym be! be-x!
[ELSE]
    synonym n64-swap rot
    synonym 64n-swap -rot
    synonym 64drop 2drop
    synonym 64nip 2nip
    synonym 64dup 2dup
    synonym 64over 2over
    synonym 64swap 2swap
    synonym 64tuck 2tuck
    synonym 64>< swap
    : 64@  2@ 64>< ; [IFDEF] macro macro [THEN]
    : 64!  >r 64>< r> 2! ; [IFDEF] macro macro [THEN]
    synonym le-64@ le-uxd@
    synonym le-64! le-xd!
    synonym be-64@ be-uxd@
    synonym be-64! be-xd!
    synonym 64+ d+
    synonym 64- d-
    : 64or rot or >r or r> ;
    : 64and rot and >r and r> ;
    : 64xor rot xor >r xor r> ;
    synonym 64Variable 2Variable
    : 64User  User cell uallot drop ;
    synonym 64Constant 2Constant
    synonym 64Value 2Value
    synonym 64-2/ d2/
    synonym 64-2* d2*
    synonym 64negate dnegate
    : 64invert invert swap invert swap ;
    #0. 2Constant 64#0
    #1. 2Constant 64#1
    #-1. 2Constant 64#-1
    synonym 64literal 2literal
    synonym 64lshift dlshift
    synonym 64rshift drshift
    synonym 64rol drol
    synonym 64ror dror
    synonym 64>f d>f
    synonym f>64 f>d
    synonym 64= d=
    synonym 64<> d<>
    #-1. 1 64rshift 64Constant max-int64
    synonym u64. ud.
    synonym s64. d.
    synonym 64>n drop
    synonym 64>d noop immediate
    synonym d>64 noop immediate
    synonym n>64 s>d
    synonym u>64 false
    synonym 64>r 2>r
    synonym 64r> 2r>
    synonym 64-0= d0=
    synonym 64-0<> d0<>
    synonym 64-0>= d0>=
    synonym 64-0<= d0<=
    synonym 64-0< d0<
    synonym 64< d<
    synonym 64> d>
    synonym 64u< du<
    synonym 64u> du>
    synonym 64u<= du<=
    synonym 64u>= du>=
    : 64on ( addr -- )  >r 64#-1 r> 64! ;
    : 64+!  ( 64n addr -- )  dup >r 64@ 64+ r> 64! ;
    synonym 64min dmin
    synonym 64max dmax
    : 64umin  2over 2over du> IF  2swap  THEN  2drop ;
    : 64umax  2over 2over du< IF  2swap  THEN  2drop ;
    synonym 64abs dabs
    : 64off #0. rot 64! ;
    synonym 64*/ m*/
    : 64* ( d1 d2 -- d3 ) { l1 h1 l2 h2 }
	l1 l2 um* l1 h2 um* l2 h1 um* d+ drop + ;
    : 128@ ( addr -- x1..x4 )
	>r
	r@ @
	r@ cell+ @
	r@ 2 cells + @
................................................................................
	r> 3 cells + @ ;
    : 128! ( x1..x4 addr -- )
	>r
	r@ 3 cells + !
	r@ 2 cells + !
	r@ cell+ !
	r> ! ;
    synonym stop-64ns stop-dns
    : compile-pushlocal-64 ( a-addr -- ) ( run-time: w1 w2 -- )
	locals-size @ alignlp-w cell+ cell+ dup locals-size !
	swap !
	postpone >l postpone >l ;
    also locals-types definitions
    synonym 64: d:
    : 64^ ( "name" -- a-addr xt ) \ net2o 64-caret
	create-local
	['] compile-pushlocal-64
      does> ( Compilation: -- ) ( Run-time: -- w )
	postpone laddr# @ lp-offset, ;
    previous definitions
    ' dummy-dict ' dict-execute ' locals-types:64^ wrap-xt dummy-64^ 2drop
................................................................................
    : dumin ( ud1 ud2 -- ud3 )  2over 2over du> IF  2swap  THEN  2drop ;
    : dumax ( ud1 ud2 -- ud3 )  2over 2over du< IF  2swap  THEN  2drop ;
    : 64!@ ( value addr -- old-value )   >r r@ 64@ 64swap r> 64! ;
    : 64min! ( d addr -- )  >r r@ 64@ dmin r> 64! ;
    : 64max! ( d addr -- )  >r r@ 64@ dmax r> 64! ;
    : 64umin! ( n addr -- )   >r r@ 64@ dumin r> 64! ;
    : 64umax! ( n addr -- )   >r r@ 64@ dumin r> 64! ;
    synonym be@ be-ul@
    synonym be! be-l!
    : 128+ ( 128a 128b -- 128c ) \ 128 bit addition
	{ d: a1 d: a2 d: b1 d: b2 }
	a1 b1 d+ a2 b2 d+ 2over a1 du< s>d d- ;
    : 128- ( 128a 128b -- 128c ) \ 128 bit addition
	{ d: a1 d: a2 d: b1 d: b2 }
	a1 b1 d- a2 b2 d- 2over a1 du> s>d d+ ;
[THEN]
\ independent of cell size, using dfloats:
synonym 64s dfloats
synonym 64'+ dfloat+
synonym 64aligned dfaligned
synonym 64field: dffield:
: x64. ( 64n -- ) ['] u64. $10 base-execute ;
: le-128@ ( addr -- d )
    dup >r le-64@ r> 64'+ le-64@ ;
: le-128! ( d addr -- )
    dup >r 64'+ le-64! r> le-64! ;
: be-128@ ( addr -- d )
    dup >r 64'+ be-64@ r> be-64@ ;
: be-128! ( d addr -- )
    dup >r be-64! r> 64'+ be-64! ;
: 64>128 ( 64 -- 128 ) 64dup 64-0< n>64 ;
Create 64!-table ' 64! , ' 64+! ,
1 64s ' 64aligned ' 64@ 64!-table wrap+value: 64value: ( u1 "name" -- u2 )

Fossil 2.10 [a56cb60278] 2019-10-07 17:20:47