sw/adventure/src/BITSET.RA2

   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