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