Artifact bd25c7b7dac6331f7dc938e15300b47d9b50bd4c:
- File 64bit.fs — part of check-in [740b68635e] at 2019-05-04 12:06:11 on branch trunk — Use synonym instead of alias (user: bernd size: 6342)
\ portable functions for 64 bit numbers : min! ( n addr -- ) >r r@ @ min r> ! ; : max! ( n addr -- ) >r r@ @ max r> ! ; : 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 )