--- /dev/null
+ SECT BTSET\r
+ ENTRY ISHFT\r
+ ENTRY BITSET\r
+ ENTRY #ANDER\r
+ EXTERN #RETRN\r
+ EXTERN #FIX\r
+ SECT8 BITTER\r
+\r
+#ANDER, TAD #XR /Simple masking\r
+ AND #XR+1\r
+ DCA #XR\r
+ CIF CDF\r
+ JMP% #XR+2 / Return\r
+\r
+/FPP code here; using the rest of the SECT8 page.\r
+\r
+SECNAM, TEXT +BITSET+ /For traceback\r
+#RET, SETX #XR /Return addr\r
+ SETB #BASE\r
+ JA .+3\r
+#BASE, ORG .+3 /Base 0\r
+N, ORG .+3 /Base 1 - value\r
+L, ORG .+3\r
+#BSET, TEXT +BITSET+ /Base 2 - section name\r
+#ISH, TEXT +ISHFT + /Base 3\r
+\r
+/ Now at address 23, past autoindex registers.\r
+#XR, FNOP /XR 0\r
+ ADDR #RETRN /XR 1; XR2 return to FRTS address.\r
+ ORG #XR+10 / Space for our index regs\r
+\r
+ ORG #BASE+30\r
+ FNOP\r
+ JA #RET\r
+ FNOP\r
+#GOBAK, 0;0\r
+ #LBL=.\r
+ COMMON MISCOM\r
+LINUSE, ORG .+0003\r
+TRVS, ORG .+0003\r
+CLSSES, ORG .+0003\r
+OLDLOC, ORG .+0003\r
+LOC, ORG .+0003\r
+CVAL, ORG .+0044\r
+TK, ORG .+0074\r
+NEWLOC, ORG .+0003\r
+KEY, ORG .+0702\r
+PLAC, ORG .+0454\r
+FIXD, ORG .+0454\r
+ACTSPK, ORG .+0151\r
+COND, ORG .+0702\r
+HINTS, ORG .+0360\r
+HNTMAX, ORG .+0003\r
+PROP, ORG .+0454\r
+TALLY, ORG .+0003\r
+TALLY2, ORG .+0003\r
+HINTLC, ORG .+0074\r
+CHLOC, ORG .+0003\r
+CHLOC2, ORG .+0003\r
+DSEEN, ORG .+0022\r
+DFLAG, ORG .+0003\r
+DLOC, ORG .+0022\r
+DALTLC, ORG .+0003\r
+KEYS, ORG .+0003\r
+LAMP, ORG .+0003\r
+GRATE, ORG .+0003\r
+CAGE, ORG .+0003\r
+ROD, ORG .+0003\r
+ROD2, ORG .+0003\r
+STEPS, ORG .+0003\r
+BIRD, ORG .+0003\r
+DOOR, ORG .+0003\r
+PILLOW, ORG .+0003\r
+SNAKE, ORG .+0003\r
+FISSUR, ORG .+0003\r
+TABLET, ORG .+0003\r
+CLAM, ORG .+0003\r
+OYSTER, ORG .+0003\r
+MAGZIN, ORG .+0003\r
+DWARF, ORG .+0003\r
+KNIFE, ORG .+0003\r
+FOOD, ORG .+0003\r
+BOTTLE, ORG .+0003\r
+WATER, ORG .+0003\r
+OIL, ORG .+0003\r
+PLANT, ORG .+0003\r
+PLANT2, ORG .+0003\r
+AXE, ORG .+0003\r
+MIRROR, ORG .+0003\r
+DRAGON, ORG .+0003\r
+CHASM, ORG .+0003\r
+TROLL, ORG .+0003\r
+TROLL2, ORG .+0003\r
+BEAR, ORG .+0003\r
+MESSAG, ORG .+0003\r
+VEND, ORG .+0003\r
+BATTER, ORG .+0003\r
+NUGGET, ORG .+0003\r
+COINS, ORG .+0003\r
+CHEST, ORG .+0003\r
+EGGS, ORG .+0003\r
+TRIDNT, ORG .+0003\r
+VASE, ORG .+0003\r
+EMRALD, ORG .+0003\r
+PYRAM, ORG .+0003\r
+PEARL, ORG .+0003\r
+RUG, ORG .+0003\r
+CHAIN, ORG .+0003\r
+BACK, ORG .+0003\r
+LOOK, ORG .+0003\r
+CAVE, ORG .+0003\r
+NULL, ORG .+0003\r
+ENTRNC, ORG .+0003\r
+DPRSSN, ORG .+0003\r
+SAY, ORG .+0003\r
+LOCK, ORG .+0003\r
+THROW, ORG .+0003\r
+FIND, ORG .+0003\r
+INVENT, ORG .+0003\r
+TURNS, ORG .+0003\r
+LMWARN, ORG .+0003\r
+KNFLOC, ORG .+0003\r
+DETAIL, ORG .+0003\r
+ABBNUM, ORG .+0003\r
+NUMDIE, ORG .+0003\r
+MAXDIE, ORG .+0003\r
+DKILL, ORG .+0003\r
+FOOBAR, ORG .+0003\r
+BONUS, ORG .+0003\r
+CLOCK1, ORG .+0003\r
+CLOCK2, ORG .+0003\r
+CLOSNG, ORG .+0003\r
+PANIC, ORG .+0003\r
+CLOSED, ORG .+0003\r
+GAVEUP, ORG .+0003\r
+SCORNG, ORG .+0003\r
+ODLOC, ORG .+0022\r
+STREAM, ORG .+0003\r
+SPICES, ORG .+0003\r
+ ORG #LBL\r
+\r
+COUNT, ORG .+3\r
+ONE, F 1.0\r
+\r
+\r
+/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0\r
+\r
+BITSET, FLDA #BSET /Section name\r
+ JSA GETARG /Common setup\r
+ BASE #BASE\r
+\r
+ FLDA% L /Get array index\r
+ ATX 1\r
+ FLDA COND-0003,1 /COND(L)\r
+ FSTA ITEST / COND(L)\r
+ LDX 1,0 /Put 1 into shift value\r
+ FLDA% N /Get N value\r
+ JEQ #1 /No shift if zero\r
+ FNEG /Negate\r
+ ATX 1 /Into register\r
+ XTA 0 /Get the "1" back\r
+ ALN 0\r
+ STARTD\r
+ ALN 1 /Do the shift\r
+ STARTF\r
+ ATX 0 /Put result in place\r
+#1, XTA 0 /Get result\r
+ JSA #FIX\r
+ ATX 0 /One mask value\r
+ FLDA ITEST\r
+ JSA #FIX\r
+ ATX 1 /The other\r
+ TRAP3 #ANDER /AND it\r
+ XTA 0 /Restore value\r
+ JEQ #GOBAK /Return if zero\r
+ FLDA ONE /Else one\r
+ JA #GOBAK /Done.\r
+ITEST, ORG .+3 /Test value\r
+\r
+/\r
+/ ISHFT entry point\r
+/\r
+ BASE 0\r
+ISHFT, FLDA #ISH /Section name\r
+ JSA GETARG /Common setup\r
+\r
+ BASE #BASE\r
+ FLDA% N /Get shift count\r
+ JEQ #SKIP /No need to shift\r
+ FNEG /Negative shift count goes left\r
+ ATX 1 /Into XR 1\r
+ FLDA% L /Get value to shift\r
+ ALN 0 /Align to right\r
+ STARTD\r
+ ALN 1 /Shift\r
+ STARTF /Done\r
+ JSA #FIX\r
+ JA #GOBAK /Done\r
+#SKIP, FLDA% L /Get value back\r
+ JA #GOBAK /Done\r
+\r
+GETARG, 0;0 /Common setup routine\r
+ FSTA SECNAM /AC has section name\r
+ STARTD\r
+ 0210 /Get caller's return\r
+ FSTA #GOBAK,0\r
+ 0200 /Get arg list\r
+ SETX #XR /Set up index registers\r
+ SETB #BASE /Set up base page\r
+ FSTA #BASE /Set up arg list\r
+ LDX 0,1 /Zero to XR #1\r
+ FLDA% #BASE,1+ /Get first arg\r
+ FSTA L\r
+ FLDA% #BASE,1+ /Second arg\r
+ FSTA N\r
+ STARTF\r
+ JA GETARG /Return\r
+ END\r
projects / pdp8.git / blobdiff