1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; and now
for something completely different
...
5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 : C@A
( -- byte
) 0 C@A
+ ;
12 : W@A
( -- word
) 0 W@A
+ ;
13 : @A
( -- value
) 0 @A
+ ;
15 : C
!A
( byte
-- ) 0 C
!A
+ ;
16 : W
!A
( word
-- ) 0 W
!A
+ ;
17 : !A
( value
-- ) 0 !A
+ ;
19 : 1+ ( a
-- a
+1 ) 1 + ;
20 : 2+ ( a
-- a
+2 ) 2 + ;
21 : 4+ ( a
-- a
+2 ) 4 + ;
22 : 1- ( a
-- a
-1 ) 1 - ;
23 : 2- ( a
-- a
-2 ) 2 - ;
24 : 4- ( a
-- a
-2 ) 4 - ;
26 : 0= ( n
-- n
==0 ) 0 = ;
27 : 0<> ( n
-- n
<>0 ) 0 <> ;
28 : 0< ( n
-- n
==0 ) 0 < ;
29 : 0<= ( n
-- n
==0 ) 0 <= ;
30 : 0> ( n
-- n
<>0 ) 0 > ;
31 : 0>= ( n
-- n
<>0 ) 0 >= ;
33 : NOTNOT
( a
-- !!a
) NOT NOT
;
35 ;; yay
, ABS without branches
! because i can
, lol
36 \ a
+ (a
>>31) ^
(a
>>31)
37 : ABS
( a
-- |a|
) DUP
-31 ASH DUP ROT
+ XOR
;
38 : SIGN?
( n
-- -1|
0|
1 ) DUP
-31 ASH SWAP
0> 1 AND
+ ;
39 : NEGATE
( n
-- -n
) BITNOT
1+ ;
41 : LSHIFT
( n count
-- n
) DUP
0< " invalid shift amount" ?ERROR LSH
;
42 : RSHIFT
( n count
-- n
) DUP
0< " invalid shift amount" ?ERROR NEGATE LSH
;
43 : ARSHIFT
( n count
-- n
) DUP
0< " invalid shift amount" ?ERROR NEGATE ASH
;
50 : LO
-WORD
( a
-- a
&0xffff ) 0xffff AND
;
51 : HI
-WORD
( a
-- [a
>>16]&0xffff ) -16 LSH LO
-WORD
;
53 : LO
-BYTE
( a
-- a
&0xff ) 0xff AND
;
54 : HI
-BYTE
( a
-- [a
>>8]&0xff ) -8 LSH LO
-BYTE
;
56 \
: ~AND
( a b
-- a
&~b
) BITNOT AND
;
58 \
: SWAP
! ( addr value
-- ) SWAP
! ;
59 \
: ~AND
! ( value addr
-- ) DUP @ ROT ~AND SWAP
! ;
60 \
: OR
! ( value addr
-- ) DUP @ ROT OR SWAP
! ;
61 \
: XOR
! ( value addr
-- ) DUP @ ROT XOR SWAP
! ;
62 : 0! ( addr
-- ) 0 SWAP
! ;
63 : 1! ( addr
-- ) 1 SWAP
! ;
64 : +! ( n addr
-- ) DUP @ ROT
+ SWAP
! ;
65 : -! ( n addr
-- ) DUP @ ROT
- SWAP
! ;
66 : 1+! ( addr
-- ) 1 SWAP
+! ;
67 : 1-! ( addr
-- ) 1 SWAP
-! ;
69 : BCOUNT
( addr
-- addr
+1 count
) DUP
1+ SWAP C@
;
70 : COUNT
( addr
-- addr
+4 count
) DUP
4+ SWAP @
;
72 : HEX
( -- ) 16 BASE
! ;
73 : DECIMAL
( -- ) 10 BASE
! ;
74 : OCTAL
( -- ) 8 BASE
! ;
75 : BINARY
( -- ) 2 BASE
! ;
77 : WITHIN
( value a b
-- value
>=a
&&value
<b
)
81 : UWITHIN
( value a b
-- value
>=a
&&value
<b
)
82 ROT DUP
>R SWAP U
< R
> ROT U
>= AND
86 : BOUNDS?
( value a b
-- value
>=a
&&value
<=b
)
87 ROT DUP
>R SWAP U
<= R
> ROT U
>= AND
91 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92 ;; additional stack ops
94 : NIP
( a b
-- b
) SWAP DROP
;
95 : TUCK
( a b
-- b a b
) SWAP OVER
;