projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add README.md
[pdp8.git] / sw / adventure / src / 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
81e70d48 17#RET, SETX #XR /Traceback\r
84b5715c
PH		 18 SETB #BASE\r
19 JA .+3\r
81e70d48 20SECNAM, TEXT +BITSET+ /For traceback\r
84b5715c
PH		 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
81e70d48
PH		 28#XR, FNOP /Base 5: XR 0\r
29 ADDR #RETRN / XR 1; XR2 return to FRTS address.\r
30 1;2;3 /Base 6: XR3-5\r
31TWO, F 2.0 /Base 7\r
84b5715c
PH		 32\r
33 ORG #BASE+30\r
34 FNOP\r
35 JA #RET\r
36 FNOP\r
37#GOBAK, 0;0\r
38 #LBL=.\r
39 COMMON MISCOM\r
40LINUSE, ORG .+0003\r
41TRVS, ORG .+0003\r
42CLSSES, ORG .+0003\r
43OLDLOC, ORG .+0003\r
44LOC, ORG .+0003\r
45CVAL, ORG .+0044\r
46TK, ORG .+0074\r
47NEWLOC, ORG .+0003\r
48KEY, ORG .+0702\r
49PLAC, ORG .+0454\r
50FIXD, ORG .+0454\r
51ACTSPK, ORG .+0151\r
52COND, ORG .+0702\r
53HINTS, ORG .+0360\r
54HNTMAX, ORG .+0003\r
55PROP, ORG .+0454\r
56TALLY, ORG .+0003\r
57TALLY2, ORG .+0003\r
58HINTLC, ORG .+0074\r
59CHLOC, ORG .+0003\r
60CHLOC2, ORG .+0003\r
61DSEEN, ORG .+0022\r
62DFLAG, ORG .+0003\r
63DLOC, ORG .+0022\r
64DALTLC, ORG .+0003\r
65KEYS, ORG .+0003\r
66LAMP, ORG .+0003\r
67GRATE, ORG .+0003\r
68CAGE, ORG .+0003\r
69ROD, ORG .+0003\r
70ROD2, ORG .+0003\r
71STEPS, ORG .+0003\r
72BIRD, ORG .+0003\r
73DOOR, ORG .+0003\r
74PILLOW, ORG .+0003\r
75SNAKE, ORG .+0003\r
76FISSUR, ORG .+0003\r
77TABLET, ORG .+0003\r
78CLAM, ORG .+0003\r
79OYSTER, ORG .+0003\r
80MAGZIN, ORG .+0003\r
81DWARF, ORG .+0003\r
82KNIFE, ORG .+0003\r
83FOOD, ORG .+0003\r
84BOTTLE, ORG .+0003\r
85WATER, ORG .+0003\r
86OIL, ORG .+0003\r
87PLANT, ORG .+0003\r
88PLANT2, ORG .+0003\r
89AXE, ORG .+0003\r
90MIRROR, ORG .+0003\r
91DRAGON, ORG .+0003\r
92CHASM, ORG .+0003\r
93TROLL, ORG .+0003\r
94TROLL2, ORG .+0003\r
95BEAR, ORG .+0003\r
96MESSAG, ORG .+0003\r
97VEND, ORG .+0003\r
98BATTER, ORG .+0003\r
99NUGGET, ORG .+0003\r
100COINS, ORG .+0003\r
101CHEST, ORG .+0003\r
102EGGS, ORG .+0003\r
103TRIDNT, ORG .+0003\r
104VASE, ORG .+0003\r
105EMRALD, ORG .+0003\r
106PYRAM, ORG .+0003\r
107PEARL, ORG .+0003\r
108RUG, ORG .+0003\r
109CHAIN, ORG .+0003\r
110BACK, ORG .+0003\r
111LOOK, ORG .+0003\r
112CAVE, ORG .+0003\r
113NULL, ORG .+0003\r
114ENTRNC, ORG .+0003\r
115DPRSSN, ORG .+0003\r
116SAY, ORG .+0003\r
117LOCK, ORG .+0003\r
118THROW, ORG .+0003\r
119FIND, ORG .+0003\r
120INVENT, ORG .+0003\r
121TURNS, ORG .+0003\r
122LMWARN, ORG .+0003\r
123KNFLOC, ORG .+0003\r
124DETAIL, ORG .+0003\r
125ABBNUM, ORG .+0003\r
126NUMDIE, ORG .+0003\r
127MAXDIE, ORG .+0003\r
128DKILL, ORG .+0003\r
129FOOBAR, ORG .+0003\r
130BONUS, ORG .+0003\r
131CLOCK1, ORG .+0003\r
132CLOCK2, ORG .+0003\r
133CLOSNG, ORG .+0003\r
134PANIC, ORG .+0003\r
135CLOSED, ORG .+0003\r
136GAVEUP, ORG .+0003\r
137SCORNG, ORG .+0003\r
138ODLOC, ORG .+0022\r
139STREAM, ORG .+0003\r
140SPICES, ORG .+0003\r
141 ORG #LBL\r
142\r
143COUNT, ORG .+3\r
144ONE, F 1.0\r
145\r
146\r
147/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0\r
81e70d48 148 BASE #BASE\r
84b5715c
PH		 149\r
150BITSET, FLDA #BSET /Section name\r
151 JSA GETARG /Common setup\r
84b5715c
PH		 152\r
153 FLDA% L /Get array index\r
81e70d48
PH		 154 ATX 7\r
155 FLDA COND-0003,7 /COND(L)\r
84b5715c
PH		 156 FSTA ITEST / COND(L)\r
157 LDX 1,0 /Put 1 into shift value\r
158 FLDA% N /Get N value\r
159 JEQ #1 /No shift if zero\r
160 FNEG /Negate\r
161 ATX 1 /Into register\r
162 XTA 0 /Get the "1" back\r
84b5715c
PH		 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
84b5715c
PH		 180ISHFT, FLDA #ISH /Section name\r
181 JSA GETARG /Common setup\r
84b5715c
PH		 182 FLDA% N /Get shift count\r
183 JEQ #SKIP /No need to shift\r
184 FNEG /Negative shift count goes left\r
185 ATX 1 /Into XR 1\r
186 FLDA% L /Get value to shift\r
187 ALN 0 /Align to right\r
188 STARTD\r
189 ALN 1 /Shift\r
190 STARTF /Done\r
191 JSA #FIX\r
192 JA #GOBAK /Done\r
193#SKIP, FLDA% L /Get value back\r
194 JA #GOBAK /Done\r
195\r
196GETARG, 0;0 /Common setup routine\r
197 FSTA SECNAM /AC has section name\r
81e70d48 198 SETX #XR /Set up index registers\r
84b5715c 199 STARTD\r
81e70d48 200 0210 /Get caller's prolog\r
84b5715c
PH		 201 FSTA #GOBAK,0\r
202 0200 /Get arg list\r
84b5715c
PH		 203 SETB #BASE /Set up base page\r
204 FSTA #BASE /Set up arg list\r
81e70d48 205 FLDA% #BASE,3 /Get first arg\r
84b5715c 206 FSTA L\r
81e70d48 207 FLDA% #BASE,4 /Second arg\r
84b5715c
PH		 208 FSTA N\r
209 STARTF\r
210 JA GETARG /Return\r
211 END\r
My complete PDP-8 universe