9 #ANDER, TAD #XR /Simple masking
15 /FPP code here; using the rest of the SECT8 page.
17 #RET, SETX #XR /Traceback
20 SECNAM, TEXT +BITSET+ /For traceback
21 #BASE, ORG .+3 /Base 0
22 N, ORG .+3 /Base 1 - value
24 #BSET, TEXT +BITSET+ /Base 2 - section name
25 #ISH, TEXT +ISHFT + /Base 3
27 / Now at address 23, past autoindex registers.
28 #XR, FNOP /Base 5: XR 0
29 ADDR #RETRN / XR 1; XR2 return to FRTS address.
147 /BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0
150 BITSET, FLDA #BSET /Section name
151 JSA GETARG /Common setup
153 FLDA% L /Get array index
155 FLDA COND-0003,7 /COND(L)
157 LDX 1,0 /Put 1 into shift value
159 JEQ #1 /No shift if zero
162 XTA 0 /Get the "1" back
166 ATX 0 /Put result in place
167 #1, XTA 0 /Get result
169 ATX 0 /One mask value
175 JEQ #GOBAK /Return if zero
178 ITEST, ORG .+3 /Test value
180 ISHFT, FLDA #ISH /Section name
181 JSA GETARG /Common setup
182 FLDA% N /Get shift count
183 JEQ #SKIP /No need to shift
184 FNEG /Negative shift count goes left
186 FLDA% L /Get value to shift
187 ALN 0 /Align to right
193 #SKIP, FLDA% L /Get value back
196 GETARG, 0;0 /Common setup routine
197 FSTA SECNAM /AC has section name
198 SETX #XR /Set up index registers
200 0210 /Get caller's prolog
203 SETB #BASE /Set up base page
204 FSTA #BASE /Set up arg list
205 FLDA% #BASE,3 /Get first arg
207 FLDA% #BASE,4 /Second arg