Commit | Line | Data |
---|---|---|
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 | ||
17 | SECNAM, TEXT +BITSET+ /For traceback | |
18 | #RET, SETX #XR /Traceback | |
19 | SETB #BASE | |
20 | JA .+3 | |
21 | #BASE, ORG .+3 /Base 0 | |
22 | N, ORG .+3 /Base 1 - value | |
23 | L, 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 | |
40 | LINUSE, ORG .+0003 | |
41 | TRVS, ORG .+0003 | |
42 | CLSSES, ORG .+0003 | |
43 | OLDLOC, ORG .+0003 | |
44 | LOC, ORG .+0003 | |
45 | CVAL, ORG .+0044 | |
46 | TK, ORG .+0074 | |
47 | NEWLOC, ORG .+0003 | |
48 | KEY, ORG .+0702 | |
49 | PLAC, ORG .+0454 | |
50 | FIXD, ORG .+0454 | |
51 | ACTSPK, ORG .+0151 | |
52 | COND, ORG .+0702 | |
53 | HINTS, ORG .+0360 | |
54 | HNTMAX, ORG .+0003 | |
55 | PROP, ORG .+0454 | |
56 | TALLY, ORG .+0003 | |
57 | TALLY2, ORG .+0003 | |
58 | HINTLC, ORG .+0074 | |
59 | CHLOC, ORG .+0003 | |
60 | CHLOC2, ORG .+0003 | |
61 | DSEEN, ORG .+0022 | |
62 | DFLAG, ORG .+0003 | |
63 | DLOC, ORG .+0022 | |
64 | DALTLC, ORG .+0003 | |
65 | KEYS, ORG .+0003 | |
66 | LAMP, ORG .+0003 | |
67 | GRATE, ORG .+0003 | |
68 | CAGE, ORG .+0003 | |
69 | ROD, ORG .+0003 | |
70 | ROD2, ORG .+0003 | |
71 | STEPS, ORG .+0003 | |
72 | BIRD, ORG .+0003 | |
73 | DOOR, ORG .+0003 | |
74 | PILLOW, ORG .+0003 | |
75 | SNAKE, ORG .+0003 | |
76 | FISSUR, ORG .+0003 | |
77 | TABLET, ORG .+0003 | |
78 | CLAM, ORG .+0003 | |
79 | OYSTER, ORG .+0003 | |
80 | MAGZIN, ORG .+0003 | |
81 | DWARF, ORG .+0003 | |
82 | KNIFE, ORG .+0003 | |
83 | FOOD, ORG .+0003 | |
84 | BOTTLE, ORG .+0003 | |
85 | WATER, ORG .+0003 | |
86 | OIL, ORG .+0003 | |
87 | PLANT, ORG .+0003 | |
88 | PLANT2, ORG .+0003 | |
89 | AXE, ORG .+0003 | |
90 | MIRROR, ORG .+0003 | |
91 | DRAGON, ORG .+0003 | |
92 | CHASM, ORG .+0003 | |
93 | TROLL, ORG .+0003 | |
94 | TROLL2, ORG .+0003 | |
95 | BEAR, ORG .+0003 | |
96 | MESSAG, ORG .+0003 | |
97 | VEND, ORG .+0003 | |
98 | BATTER, ORG .+0003 | |
99 | NUGGET, ORG .+0003 | |
100 | COINS, ORG .+0003 | |
101 | CHEST, ORG .+0003 | |
102 | EGGS, ORG .+0003 | |
103 | TRIDNT, ORG .+0003 | |
104 | VASE, ORG .+0003 | |
105 | EMRALD, ORG .+0003 | |
106 | PYRAM, ORG .+0003 | |
107 | PEARL, ORG .+0003 | |
108 | RUG, ORG .+0003 | |
109 | CHAIN, ORG .+0003 | |
110 | BACK, ORG .+0003 | |
111 | LOOK, ORG .+0003 | |
112 | CAVE, ORG .+0003 | |
113 | NULL, ORG .+0003 | |
114 | ENTRNC, ORG .+0003 | |
115 | DPRSSN, ORG .+0003 | |
116 | SAY, ORG .+0003 | |
117 | LOCK, ORG .+0003 | |
118 | THROW, ORG .+0003 | |
119 | FIND, ORG .+0003 | |
120 | INVENT, ORG .+0003 | |
121 | TURNS, ORG .+0003 | |
122 | LMWARN, ORG .+0003 | |
123 | KNFLOC, ORG .+0003 | |
124 | DETAIL, ORG .+0003 | |
125 | ABBNUM, ORG .+0003 | |
126 | NUMDIE, ORG .+0003 | |
127 | MAXDIE, ORG .+0003 | |
128 | DKILL, ORG .+0003 | |
129 | FOOBAR, ORG .+0003 | |
130 | BONUS, ORG .+0003 | |
131 | CLOCK1, ORG .+0003 | |
132 | CLOCK2, ORG .+0003 | |
133 | CLOSNG, ORG .+0003 | |
134 | PANIC, ORG .+0003 | |
135 | CLOSED, ORG .+0003 | |
136 | GAVEUP, ORG .+0003 | |
137 | SCORNG, ORG .+0003 | |
138 | ODLOC, ORG .+0022 | |
139 | STREAM, ORG .+0003 | |
140 | SPICES, ORG .+0003 | |
141 | ORG #LBL | |
142 | ||
143 | COUNT, ORG .+3 | |
144 | ONE, F 1.0 | |
145 | ||
146 | ||
147 | /BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0 | |
148 | ||
149 | BITSET, 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. | |
179 | ITEST, ORG .+3 /Test value | |
180 | ||
181 | / | |
182 | / ISHFT entry point | |
183 | / | |
184 | BASE 0 | |
185 | ||
186 | ISHFT, 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 | ||
204 | GETARG, 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 |