+++ /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