9 #ANDER, TAD #XR /Simple masking
15 /FPP code here; using the rest of the SECT8 page.
17 SECNAM, TEXT +BITSET+ /For traceback
18 #RET, SETX #XR /Return addr
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.
29 ADDR #RETRN /XR 1; XR2 return to FRTS address.
30 ORG #XR+10 / Space for our index regs
146 /BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0
148 BITSET, FLDA #BSET /Section name
149 JSA GETARG /Common setup
152 FLDA% L /Get array index
154 FLDA COND-0003,1 /COND(L)
156 LDX 1,0 /Put 1 into shift value
158 JEQ #1 /No shift if zero
161 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
184 ISHFT, FLDA #ISH /Section name
185 JSA GETARG /Common setup
188 FLDA% N /Get shift count
189 JEQ #SKIP /No need to shift
190 FNEG /Negative shift count goes left
192 FLDA% L /Get value to shift
193 ALN 0 /Align to right
199 #SKIP, FLDA% L /Get value back
202 GETARG, 0;0 /Common setup routine
203 FSTA SECNAM /AC has section name
205 0210 /Get caller's return
208 SETX #XR /Set up index registers
209 SETB #BASE /Set up base page
210 FSTA #BASE /Set up arg list
211 LDX 0,1 /Zero to XR #1
212 FLDA% #BASE,1+ /Get first arg
214 FLDA% #BASE,1+ /Second arg