sw/adventure/GETWRD.RA

   1         SECT    WORDS
   2 /FILE GETWRD
   3 /Version 02.06
   4
   5 /This module contains two entry points to allow FORTRAN
   6 /programs access to the contents of any of the 3 12-bit words
   7 /in any floating point variable.  The idea is to facilitate
   8 /operations on text strings which are stored as 8-bit ASCII,
   9 /such as input by the routine RDLIN (see write up for RDLIN
  10 /included with that routine.).
  11
  12 /       ROUTINE GETWRD
  13
  14 /This routine is a function subroutine (ie: the result is
  15 /returned in the FAC).  As such it's name may be used in arithmetic
  16 /statments and the returned data will be used directly.  The
  17 /following example illustrates it's use:
  18 /       .
  19 /       .
  20 /       RESULT=GETWRD(MESSAG,INDX,MASK)
  21 /       .
  22 /       .
  23
  24 /Here, the desired word (exponent,hi or lo mantissa) will
  25 /be returned and placed into the variable RESULT.  The argument
  26 /MESSAG may be a variable or an array.  The actual address in the
  27 /array will be computed by the routine, depending on the value
  28 /of the variable INDX.  INDX points to the specific 12-bit word in
  29 /the array you want.  The routine adds this number to the start
  30 /address of the array, and operates on this word with an XTA
  31 /instruction.
  32
  33 /The following table illustrates this conversion:
  34
  35 /Value of INDX      Element word           Array element
  36
  37 /       1               Exponent                1
  38 /       2               Hi mant.                1
  39 /       3               Lo mant.                1
  40 /       4               Exponent                2
  41 /       5               Hi mant.                2
  42 /      etc.               etc.                 etc.
  43
  44 /The argument MASK allows the masking of the data retrieved
  45 /so parity bits etc. can be removed easily.  The value should be
  46 /the decimal equivalent of the octal number you want the data masked
  47 /by.  If MASK is 0, no masking takes place.
  48
  49 /       ROUTINE PUTWRD
  50
  51 /This routine provides the converse function of GETWRD.
  52 /It is called from FORTRAN using a standard subroutine call:
  53
  54 /       CALL PUTWRD(MESSAG,INDX,WORD)
  55
  56 /The first 2 arguments are identical to those in the routine GETWRD,
  57 /but the third argument reflects the difference in function of
  58 /these two routines.  WORD is the value in decimal that is to
  59 /be placed into the 12-bit word referenced by the first two
  60 /arguments.  Masking is not provided for.
  61
  62         EXTERN  #RETRN
  63         EXTERN  #ARGER
  64         ENTRY   GETWRD
  65         ENTRY   PUTWRD
  66
  67
  68 /Little routine to do masking of octal data.
  69 /Although the references to XR 0 and 1 destroy the
  70 /value of the Array element in XR 0-2, this is of no
  71 /consequence because we've already finished using it.
  72
  73 /The only caveat here is that #XR+2 is not an auto index register
  74 /Calling in #PAGE0 won't help because we could ge loaded onto
  75 /page 0 of some other field.
  76
  77         SECT8   #MASK
  78         TAD     #XR             /Index 0 contains fetched data
  79         AND     #XR+1           /Index 1 contains the mask.
  80         DCA     #XR             /Apply mask to data
  81         CIF CDF                 /Reset data field
  82         JMP%    #XR+2           /XR5 contains return address
  83
  84 /FPP code starts here.  It is intended that it be contiguous
  85 /with the 8-mode code so the rest of the page is not wasted
  86
  87 SECNAM, TEXT    +GETWRD+        /Init for traceback
  88 #BASE,  ORG     .+3     /Base 0
  89 INDX,   ORG     .+3     /Base 1: Stuff addresses in here
  90 #PTWRD, TEXT +PUTWRD+   /Base 2: One of the section names
  91 #GTWRD, TEXT +GETWRD+   /Base 3: The other section name
  92
  93 /Relative address on page is 23. This puts XR+2 out of any possible
  94 /danger with respect to auto-index registers.
  95
  96 #XR,    FNOP            /Base 4: XR0-2
  97         ADDR #RETRN     /       #XR2=return to FRTS address
  98         1;2;3           /Base 5: XR3-5
  99 /TENK,  F 4096.0        /Base 6
 100 K2048,  F 2048.0
 101 XSETX,  27;47;7777      /Base 7: SETX-JA-1
 102
 103         ORG     #BASE+30
 104         FNOP;   JA      #BASE   /Pointer to section name+3
 105         FNOP;#GOBAK,    0;0     /Pointer to calling base page
 106
 107 /Routine starts here.  Details of index register usage are
 108 /as follows:
 109
 110 /       XR 0    Used to fetch/store/hold target word
 111 /       XR 1    Used as arg. fetch index, and to hold mask word
 112 /       XR 2    Contains the FRTS TRAP return address
 113 /       XR 3    =1 to fetch ARRAY arg
 114 /       XR 4    =2 to fetch INDEX arg
 115 /       XR 5    =3 to fetch WORD/MASK arg
 116
 117         BASE    #BASE           /Tell assembler wher the base page is
 118
 119 /Enter here for PUTWRD
 120
 121 PUTWRD, FLDA    #PTWRD,0        /Get putwrd name
 122         JSA     GETARG          /Get args set up
 123
 124         FLDA%   INDX            /Load the new value for target word
 125         JLT     TSTNEG          /Negative range check
 126         FSUB    K2048           /For positive, < 2048
 127         JGE     PUTERR          /Out of range
 128         JA      OK              /Else ok
 129 TSTNEG, FADD    K2048           /Neg more than 2048?
 130         JLE     PUTERR          /Yes, errror
 131 OK,     FLDA%   INDX
 132         FLDA%   INDX            /In range
      ATX     0               /Store it
 133         JA      #GOBAK          /Return
 134
 135 PUTERR, FLDA    SECNAM
 136         TRAP4   #ARGER
 137
 138 /Enter here for GETWRD
 139
 140 GETWRD, FLDA    #GTWRD,0        /Load section name
 141         JSA     GETARG          /Get things set up
 142
 143         XTA     0               /Get the target word
 144         SETX    #XR             /Reset index registers
 145         ATX     0               /Store word in XR 0
 146
 147         FLDA%   INDX            /Get the mask value
 148         JEQ     NOMASK          /If 0, skip masking
 149         ATX     1               /Put the mask value into an index
 150         TRAP3   #MASK           /Go mask the number
 151
 152 NOMASK, XTA     0               /Recover the masked number
 153 /       JGE     #GOBAK          /If result is positive, return now
 154 /       FADD    TENK            /Otherwise, un-2's complement first
 155         JA      #GOBAK          /Return the answer in FAC
 156
 157 /Both routines come here to get things set up. FAC contains
 158 /section name.
 159
 160
 161 GETARG, 0;0
 162         FSTA    SECNAM          /Name into traceback prologue
 163         SETX    #XR             /Set address of index registers
 164
 165         STARTD                  /Mode for addresses
 166         0210                    /Load pointer to callers prologue
 167         FSTA    #GOBAK,0        /Store as return address
 168         0200                    /Load address of argument list
 169         SETB    #BASE           /Now tell FPP where the base page is
 170
 171         FSTA    #BASE           /Store address of args
 172
 173         FLDA%   #BASE,4         /Load pointer to INDX
 174         FSTA    INDX            /Store this
 175
 176         STARTF                  /Mode for numbers
 177         FLDA%   INDX            /Load the pointer
 178         ALN     0               /Fix it
 179         STARTD                  /Address mode
 180
 181         FADD%   #BASE,3         /Add address of ARRAY/VARIABLE
 182         FADD    XSETX           /Create a SETX ARRAY+INDEX-1
 183         FSTA    ZSETX,0         /Store to execute in line
 184
 185         FLDA%   #BASE,5         /Load pointer to MASK/Replacement word
 186         FSTA    INDX            /Store this
 187         STARTF                  /Set numeric mode
 188
 189 ZSETX,  SETX    .               /Set index on target word
 190         JA      GETARG          /Return, everything set