bitset

bitset.tal

@@ -0,0 +1,41 @@
+( bitset.tal )
+( )
+( this hasn't actually been used yet. buyer beware! )
+
+( x* -> addr* )
+%FIND { #03 SFT2 ;bits ADD2 }
+
+( x* -> mask^ i.e. 1<<(x&7) )
+%MASK { SWP POP #07 AND #40 SFT #01 SWP SFT }
+
+( x* -> unmask^ i.e. (1<(x&7))^ff )
+%UNMASK { SWP POP #07 AND #40 SFT #01 #ff EOR SWP SFT }
+
+%SIZE { #2000 }
+
+|0100
+
+@bits $2000 ( 8,192 bytes; 65,536 bits )
+
+@add ( x* -> )
+    STH2k FIND ( byte^ [x*] )
+    STH2kr MASK ( byte^ mask^ [x*] )
+    ORA STH2r ( byte|mask^ x* )
+    FIND STA JMP2r
+
+@get ( x* -> bool^ )
+    STH2k FIND LDA ( byte^ [x*] )
+    STH2r MASK AND ( byte&mask )
+    JMP2r 
+
+@del ( x* -> )
+    STH2k FIND ( byte^ [x*] )
+    STH2kr UNMASK ( byte^ unmask^ [x*] )
+    AND STH2r ( byte&mask^ x* )
+    FIND STA JMP2r
+
+@clear ( -> )
+    ;bits DUP2 SIZE ADD2 STH2 ( addr* [limit] )
+    &loop #0000 OVR2 STA2 ( write 0 to addr )
+    INC2 STH2kr LTH2 ,&loop JCN ( if addr+1 < limit loop )
+    POP2 POP2r JMP2r ( clean up stacks )