A large commit.
[pdp8.git] / sw / adventure / personal / BITSET.RA
CommitLineData
81e70d48
PH
1 SECT BTSET
2 ENTRY ISHFT
3 ENTRY BITSET
4 ENTRY #ANDER
5 EXTERN #RETRN
6 EXTERN #FIX
7 SECT8 BITTER
8
9#ANDER, TAD #XR /Simple masking
10 AND #XR+1
11 DCA #XR
12 CIF CDF
13 JMP% #XR+2 / Return
14
15/FPP code here; using the rest of the SECT8 page.
16
17SECNAM, TEXT +BITSET+ /For traceback
18#RET, SETX #XR /Traceback
19 SETB #BASE
20 JA .+3
21#BASE, ORG .+3 /Base 0
22N, ORG .+3 /Base 1 - value
23L, ORG .+3
24#BSET, TEXT +BITSET+ /Base 2 - section name
25#ISH, TEXT +ISHFT + /Base 3
26
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.
30
31 ORG #XR+10 /Past index regs, same as -
32
33 ORG #BASE+30 /30 (base page)
34 FNOP
35 JA #RET
36 FNOP
37#GOBAK, 0;0
38 #LBL=.
39 COMMON MISCOM
40LINUSE, ORG .+0003
41TRVS, ORG .+0003
42CLSSES, ORG .+0003
43OLDLOC, ORG .+0003
44LOC, ORG .+0003
45CVAL, ORG .+0044
46TK, ORG .+0074
47NEWLOC, ORG .+0003
48KEY, ORG .+0702
49PLAC, ORG .+0454
50FIXD, ORG .+0454
51ACTSPK, ORG .+0151
52COND, ORG .+0702
53HINTS, ORG .+0360
54HNTMAX, ORG .+0003
55PROP, ORG .+0454
56TALLY, ORG .+0003
57TALLY2, ORG .+0003
58HINTLC, ORG .+0074
59CHLOC, ORG .+0003
60CHLOC2, ORG .+0003
61DSEEN, ORG .+0022
62DFLAG, ORG .+0003
63DLOC, ORG .+0022
64DALTLC, ORG .+0003
65KEYS, ORG .+0003
66LAMP, ORG .+0003
67GRATE, ORG .+0003
68CAGE, ORG .+0003
69ROD, ORG .+0003
70ROD2, ORG .+0003
71STEPS, ORG .+0003
72BIRD, ORG .+0003
73DOOR, ORG .+0003
74PILLOW, ORG .+0003
75SNAKE, ORG .+0003
76FISSUR, ORG .+0003
77TABLET, ORG .+0003
78CLAM, ORG .+0003
79OYSTER, ORG .+0003
80MAGZIN, ORG .+0003
81DWARF, ORG .+0003
82KNIFE, ORG .+0003
83FOOD, ORG .+0003
84BOTTLE, ORG .+0003
85WATER, ORG .+0003
86OIL, ORG .+0003
87PLANT, ORG .+0003
88PLANT2, ORG .+0003
89AXE, ORG .+0003
90MIRROR, ORG .+0003
91DRAGON, ORG .+0003
92CHASM, ORG .+0003
93TROLL, ORG .+0003
94TROLL2, ORG .+0003
95BEAR, ORG .+0003
96MESSAG, ORG .+0003
97VEND, ORG .+0003
98BATTER, ORG .+0003
99NUGGET, ORG .+0003
100COINS, ORG .+0003
101CHEST, ORG .+0003
102EGGS, ORG .+0003
103TRIDNT, ORG .+0003
104VASE, ORG .+0003
105EMRALD, ORG .+0003
106PYRAM, ORG .+0003
107PEARL, ORG .+0003
108RUG, ORG .+0003
109CHAIN, ORG .+0003
110BACK, ORG .+0003
111LOOK, ORG .+0003
112CAVE, ORG .+0003
113NULL, ORG .+0003
114ENTRNC, ORG .+0003
115DPRSSN, ORG .+0003
116SAY, ORG .+0003
117LOCK, ORG .+0003
118THROW, ORG .+0003
119FIND, ORG .+0003
120INVENT, ORG .+0003
121TURNS, ORG .+0003
122LMWARN, ORG .+0003
123KNFLOC, ORG .+0003
124DETAIL, ORG .+0003
125ABBNUM, ORG .+0003
126NUMDIE, ORG .+0003
127MAXDIE, ORG .+0003
128DKILL, ORG .+0003
129FOOBAR, ORG .+0003
130BONUS, ORG .+0003
131CLOCK1, ORG .+0003
132CLOCK2, ORG .+0003
133CLOSNG, ORG .+0003
134PANIC, ORG .+0003
135CLOSED, ORG .+0003
136GAVEUP, ORG .+0003
137SCORNG, ORG .+0003
138ODLOC, ORG .+0022
139STREAM, ORG .+0003
140SPICES, ORG .+0003
141 ORG #LBL
142
143COUNT, ORG .+3
144ONE, F 1.0
145
146
147/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0
148
149BITSET, FLDA #BSET /Section name
150 JSA GETARG /Common setup
151
152 BASE #BASE
153 FLDA% L /Get array index
154 ATX 1
155 FLDA COND-3,1 /COND(L)
156 FSTA ITEST / COND(L)
157 LDX 1,0 /Put 1 into shift value
158 FLDA% N /Get N value
159 JEQ #1 /No shift if zero
160 FNEG /Negate
161 ATX 1 /Into register
162 XTA 0 /Get the "1" back
163 ALN 0 /Align to right
164 STARTD
165 ALN 1 /Do the shift
166 STARTF
167 ATX 0 /Put result in place
168#1, XTA 0 /Get result
169 JSA #FIX
170 ATX 0 /One mask value
171 FLDA ITEST
172 JSA #FIX
173 ATX 1 /The other
174 TRAP3 #ANDER /AND it
175 XTA 0 /Restore value
176 JEQ #GOBAK /Return if zero
177 FLDA ONE /Else one
178 JA #GOBAK /Done.
179ITEST, ORG .+3 /Test value
180
181/
182/ ISHFT entry point
183/
184 BASE 0
185
186ISHFT, FLDA #ISH /Section name
187 JSA GETARG /Common setup
188
189 BASE #BASE
190 FLDA% N /Get shift count
191 JEQ #SKIP /No need to shift
192 FNEG /Negative shift count goes left
193 ATX 1 /Into XR 1
194 FLDA% L /Get value to shift
195 ALN 0 /Align to right
196 STARTD
197 ALN 1 /Shift
198 STARTF /Done
199 JSA #FIX
200 JA #GOBAK /Done
201#SKIP, FLDA% L /Get value back
202 JA #GOBAK /Done
203
204GETARG, 0;0 /Common setup routine
205 FSTA SECNAM /AC has section name
206 STARTD
207 0210 /Get caller's return
208 FSTA #GOBAK,0
209 0200 /Get arg list
210 SETX #XR /Set up index registers
211 SETB #BASE /Set up base page
212 FSTA #BASE /Set up arg list
213 LDX 0,1
214 FLDA% #BASE,1+ /Get first arg
215 FSTA L
216 FLDA% #BASE,1+ /Second arg
217 FSTA N
218 STARTF
219 JA GETARG /Return
220 END