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