summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisplib.c1
-rw-r--r--stdlib/defset.tl8
-rw-r--r--stdlib/doc-syms.tl2
-rw-r--r--stdlib/optimize.tl9
-rw-r--r--stdlib/socket.tl24
-rw-r--r--stdlib/termios.tl16
-rw-r--r--txr.140
7 files changed, 76 insertions, 24 deletions
diff --git a/lisplib.c b/lisplib.c
index 582788f2..3a5beb78 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -809,6 +809,7 @@ static val defset_set_entries(val dlt, val fun)
val name[] = {
lit("defset"), lit("sub-list"), lit("sub-vec"), lit("sub-str"),
lit("left"), lit("right"), lit("key"),
+ lit("set-mask"), lit("clear-mask"),
nil
};
set_dlt_entries(dlt, name, fun);
diff --git a/stdlib/defset.tl b/stdlib/defset.tl
index 8cbb9c73..a595b515 100644
--- a/stdlib/defset.tl
+++ b/stdlib/defset.tl
@@ -128,3 +128,11 @@
(defset key (node) nkey
^(progn (set-key ,node ,nkey) ,nkey))
+
+(defmacro set-mask (:env env place . integers)
+ (with-update-expander (getter setter) place env
+ ^(,setter (logior (,getter) ,*integers))))
+
+(defmacro clear-mask (:env env place . integers)
+ (with-update-expander (getter setter) place env
+ ^(,setter (logand (,getter) (lognot (logior ,*integers))))))
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 3de245da..94b2cf89 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -338,6 +338,7 @@
("clear-error" "D-000C")
("clear-iflags" "N-02061924")
("clear-lflags" "N-02061924")
+ ("clear-mask" "N-0269D998")
("clear-oflags" "N-02061924")
("clear-struct" "N-03A968CA")
("clearhash" "N-00836D97")
@@ -1676,6 +1677,7 @@
("set-key" "N-033F7D05")
("set-left" "N-033F7D05")
("set-lflags" "N-02061924")
+ ("set-mask" "N-0269D998")
("set-max-depth" "N-027D3FB4")
("set-max-length" "N-031FA9E5")
("set-oflags" "N-02061924")
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index 8a7bce71..8d2c1f5c 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -24,6 +24,7 @@
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.
+
(compile-only
(defstruct live-info nil
(defined 0)
@@ -252,8 +253,8 @@
((fi . re)
(let* ((live (upd-used bl re live))
(lif [bb.li-hash fi]))
- (set live (logand live (lognot lif.defined)))
- (set lif.used (logior live lif.used))
+ (clear-mask live lif.defined)
+ (set-mask lif.used live)
live))
(else live)))
(visit (bl)
@@ -265,12 +266,12 @@
(old-live (or bl.live 0)))
(each ((nx bl.links))
(visit nx)
- (set used (logior used nx.used)))
+ (set-mask used nx.used))
(when (neql (set bl.live (logior used old-live))
old-live)
(let ((live-in (logand (upd-used bl bl.insns bl.live)
(lognot bl.defined))))
- (set bl.used (logior live-in bl.used)))
+ (set-mask bl.used live-in))
(set changed t))))))
(set changed nil)
(visit bb.root))))))
diff --git a/stdlib/socket.tl b/stdlib/socket.tl
index eac123be..aeb33dbe 100644
--- a/stdlib/socket.tl
+++ b/stdlib/socket.tl
@@ -102,11 +102,11 @@
(defun sys:str-inaddr-net-impl (addr wextra : weff)
(let ((mask addr))
- (set mask (logior mask (ash mask 1)))
- (set mask (logior mask (ash mask 2)))
- (set mask (logior mask (ash mask 4)))
- (set mask (logior mask (ash mask 8)))
- (set mask (logior mask (ash mask 16)))
+ (set-mask mask (ash mask 1))
+ (set-mask mask (ash mask 2))
+ (set-mask mask (ash mask 4))
+ (set-mask mask (ash mask 8))
+ (set-mask mask (ash mask 16))
(let* ((w (- 32 (width (lognot mask 32))))
(d (logand addr #xFF))
(c (logand (ash addr -8) #xFF))
@@ -130,13 +130,13 @@
(= (ash addr -32) #xFFFF))
`::ffff:@(sys:str-inaddr-net-impl (logtrunc addr 32) 96 width)`
(let ((mask addr))
- (set mask (logior mask (ash mask 1)))
- (set mask (logior mask (ash mask 2)))
- (set mask (logior mask (ash mask 4)))
- (set mask (logior mask (ash mask 8)))
- (set mask (logior mask (ash mask 16)))
- (set mask (logior mask (ash mask 32)))
- (set mask (logior mask (ash mask 64)))
+ (set-mask mask (ash mask 1))
+ (set-mask mask (ash mask 2))
+ (set-mask mask (ash mask 4))
+ (set-mask mask (ash mask 8))
+ (set-mask mask (ash mask 16))
+ (set-mask mask (ash mask 32))
+ (set-mask mask (ash mask 64))
(let* ((w (- 128 (width (lognot mask 128))))
(pieces (let ((count 8))
(nexpand-left (lambda (val)
diff --git a/stdlib/termios.tl b/stdlib/termios.tl
index 1689ecaa..6059149e 100644
--- a/stdlib/termios.tl
+++ b/stdlib/termios.tl
@@ -25,28 +25,28 @@
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.
(defmeth termios set-iflags (tio . values)
- (set tio.iflag (logior tio.iflag . values)))
+ (set-mask tio.iflag . values))
(defmeth termios set-oflags (tio . values)
- (set tio.oflag (logior tio.oflag . values)))
+ (set-mask tio.oflag . values))
(defmeth termios set-cflags (tio . values)
- (set tio.cflag (logior tio.cflag . values)))
+ (set-mask tio.cflag . values))
(defmeth termios set-lflags (tio . values)
- (set tio.lflag (logior tio.lflag . values)))
+ (set-mask tio.lflag . values))
(defmeth termios clear-iflags (tio . values)
- (set tio.iflag (logand tio.iflag (lognot (logior . values)))))
+ (clear-mask tio.iflag . values))
(defmeth termios clear-oflags (tio . values)
- (set tio.oflag (logand tio.oflag (lognot (logior . values)))))
+ (clear-mask tio.oflag . values))
(defmeth termios clear-cflags (tio . values)
- (set tio.cflag (logand tio.cflag (lognot (logior . values)))))
+ (clear-mask tio.cflag . values))
(defmeth termios clear-lflags (tio . values)
- (set tio.lflag (logand tio.lflag (lognot (logior . values)))))
+ (clear-mask tio.lflag . values))
(defmeth termios go-raw (tio)
tio.(clear-iflags ignbrk brkint parmrk istrip inlcr igncr icrnl ixon)
diff --git a/txr.1 b/txr.1
index 9e0d95eb..a70914ab 100644
--- a/txr.1
+++ b/txr.1
@@ -14035,6 +14035,20 @@ operational pipeline to the value of
and stores the result back into
.metn place .
+.meIP (set-mask < place << integer *)
+Sets to 1 the bits in
+.meta place
+corresponding to bits that are equal to 1 in the mask made up of the
+.meta integer
+arguments (by combining them together with the inclusive or operation).
+
+.meIP (clear-mask < place << integer *)
+Clears (sets to 0) the bits in
+.meta place
+corresponding to bits that are equal to 1 in the mask made up of the
+.meta integer
+arguments (by combining them together with the inclusive or operation).
+
.PP
.SS* Namespaces and Environments
@@ -47094,6 +47108,32 @@ is zero, the value returned is zero.
The argument may be a character.
+.coNP Macros @ set-mask and @ clear-mask
+.synb
+.mets (set-mask < place << integer *)
+.mets (clear-mask < place << integer *)
+.syne
+.desc
+The
+.code set-mask
+and
+.code clear-mask
+macros set to 1 and 0, respectively, the bits in
+.meta place
+corresponding to bits that are equal to 1 in the mask resulting from
+applying the inclusive or operation to the
+.meta integer
+arguments.
+The following equivalences hold:
+
+.verb
+ (set-mask place integer ...)
+ <--> (set place (logior place integer ...)
+
+ (clear-mask place integer ...)
+ <--> (set place (logand place (lognot (logior integer ...))))
+.brev
+
.SS* User-Defined Arithmetic Types
\*(TL makes it possible for the user application program to define structure
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-01 11:37:15 +0000