File: GETWRD.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1
SECT WORDS
/FILE GETWRD
/Version 02.06
/This module contains two entry points to allow FORTRAN
/programs access to the contents of any of the 3 12-bit words
/in any floating point variable. The idea is to facilitate
/operations on text strings which are stored as 8-bit ASCII,
/such as input by the routine RDLIN (see write up for RDLIN
/included with that routine.).
/ ROUTINE GETWRD
/This routine is a function subroutine (ie: the result is
/returned in the FAC). As such it's name may be used in arithmetic
/statments and the returned data will be used directly. The
/following example illustrates it's use:
/ .
/ .
/ RESULT=GETWRD(MESSAG,INDX,MASK)
/ .
/ .
/Here, the desired word (exponent,hi or lo mantissa) will
/be returned and placed into the variable RESULT. The argument
/MESSAG may be a variable or an array. The actual address in the
/array will be computed by the routine, depending on the value
/of the variable INDX. INDX points to the specific 12-bit word in
/the array you want. The routine adds this number to the start
/address of the array, and operates on this word with an XTA
/instruction.
/The following table illustrates this conversion:
/Value of INDX Element word Array element
/ 1 Exponent 1
/ 2 Hi mant. 1
/ 3 Lo mant. 1
/ 4 Exponent 2
/ 5 Hi mant. 2
/ etc. etc. etc.
/The argument MASK allows the masking of the data retrieved
/so parity bits etc. can be removed easily. The value should be
/the decimal equivalent of the octal number you want the data masked
/by. If MASK is 0, no masking takes place.
/ ROUTINE PUTWRD
/This routine provides the converse function of GETWRD.
/It is called from FORTRAN using a standard subroutine call:
/ CALL PUTWRD(MESSAG,INDX,WORD)
/The first 2 arguments are identical to those in the routine GETWRD,
RALF V50A 24-JUL-20 PAGE 1-1
/but the third argument reflects the difference in function of
/these two routines. WORD is the value in decimal that is to
/be placed into the 12-bit word referenced by the first two
/arguments. Masking is not provided for.
EXTERN #RETRN
EXTERN #ARGER
ENTRY GETWRD
ENTRY PUTWRD
/Little routine to do masking of octal data.
/Although the references to XR 0 and 1 destroy the
/value of the Array element in XR 0-2, this is of no
/consequence because we've already finished using it.
/The only caveat here is that #XR+2 is not an auto index register
/Calling in #PAGE0 won't help because we could ge loaded onto
/page 0 of some other field.
SECT8 #MASK
00000 1224 TAD #XR /Index 0 contains fetched data
00001 0225 AND #XR+1 /Index 1 contains the mask.
00002 3224 DCA #XR /Apply mask to data
00003 6203 CIF CDF /Reset data field
00004 5626 JMP% #XR+2 /XR5 contains return address
/FPP code starts here. It is intended that it be contiguous
/with the 8-mode code so the rest of the page is not wasted
00005 0705 SECNAM, TEXT +GETWRD+ /Init for traceback
00006 2427
00007 2204
#BASE, ORG .+3 /Base 0
INDX, ORG .+3 /Base 1: Stuff addresses in here
00016 2025 #PTWRD, TEXT +PUTWRD+ /Base 2: One of the section names
00017 2427
00020 2204
00021 0705 #GTWRD, TEXT +GETWRD+ /Base 3: The other section name
00022 2427
00023 2204
/Relative address on page is 23. This puts XR+2 out of any possible
/danger with respect to auto-index registers.
00024 0040 #XR, FNOP /Base 4: XR0-2
00025 0000 ADDR #RETRN / #XR2=return to FRTS address
00026 0000
00027 0001 1;2;3 /Base 5: XR3-5
00030 0002
00031 0003
/TENK, F 4096.0 /Base 6
00032 0014 K2048, F 2048.0
00033 2000
00034 0000
00035 0027 XSETX, 27;47;7777 /Base 7: SETX-JA-1
RALF V50A 24-JUL-20 PAGE 1-2
00036 0047
00037 7777
ORG #BASE+30
00040 0040 FNOP; JA #BASE /Pointer to section name+3
00041 1030
00042 0010
00043 0040 FNOP;#GOBAK, 0;0 /Pointer to calling base page
00044 0000
00045 0000
/Routine starts here. Details of index register usage are
/as follows:
/ XR 0 Used to fetch/store/hold target word
/ XR 1 Used as arg. fetch index, and to hold mask word
/ XR 2 Contains the FRTS TRAP return address
/ XR 3 =1 to fetch ARRAY arg
/ XR 4 =2 to fetch INDEX arg
/ XR 5 =3 to fetch WORD/MASK arg
BASE #BASE /Tell assembler wher the base page is
/Enter here for PUTWRD
00046 0400 PUTWRD, FLDA #PTWRD,0 /Get putwrd name
00047 0016
00050 1120 JSA GETARG /Get args set up
00051 0117
00052 0601 FLDA% INDX /Load the new value for target word
00053 1050 JLT TSTNEG /Negative range check
00054 0062
00055 2206 FSUB K2048 /For positive, < 2048
00056 1010 JGE PUTERR /Out of range
00057 0072
00060 1030 JA OK /Else ok
00061 0065
00062 1206 TSTNEG, FADD K2048 /Neg more than 2048?
00063 1020 JLE PUTERR /Yes, errror
00064 0072
00065 0601 OK, FLDA% INDX
00066 0601 FLDA% INDX /In range
00067 0020 ATX 0 /Store it
00070 1030 JA #GOBAK /Return
00071 0044
00072 0400 PUTERR, FLDA SECNAM
00073 0005
00074 4000 TRAP4 #ARGER
00075 0000
/Enter here for GETWRD
00076 0400 GETWRD, FLDA #GTWRD,0 /Load section name
00077 0021
RALF V50A 24-JUL-20 PAGE 1-3
00100 1120 JSA GETARG /Get things set up
00101 0117
00102 0030 XTA 0 /Get the target word
00103 1100 SETX #XR /Reset index registers
00104 0024
00105 0020 ATX 0 /Store word in XR 0
00106 0601 FLDA% INDX /Get the mask value
00107 1000 JEQ NOMASK /If 0, skip masking
00110 0114
00111 0021 ATX 1 /Put the mask value into an index
00112 3000 TRAP3 #MASK /Go mask the number
00113 0000
00114 0030 NOMASK, XTA 0 /Recover the masked number
/ JGE #GOBAK /If result is positive, return now
/ FADD TENK /Otherwise, un-2's complement first
00115 1030 JA #GOBAK /Return the answer in FAC
00116 0044
/Both routines come here to get things set up. FAC contains
/section name.
00117 0000 GETARG, 0;0
00120 0000
00121 6400 FSTA SECNAM /Name into traceback prologue
00122 0005
00123 1100 SETX #XR /Set address of index registers
00124 0024
00125 0006 STARTD /Mode for addresses
00126 0210 0210 /Load pointer to callers prologue
00127 6400 FSTA #GOBAK,0 /Store as return address
00130 0044
00131 0200 0200 /Load address of argument list
00132 1110 SETB #BASE /Now tell FPP where the base page is
00133 0010
00134 6200 FSTA #BASE /Store address of args
00135 0640 FLDA% #BASE,4 /Load pointer to INDX
00136 6201 FSTA INDX /Store this
00137 0005 STARTF /Mode for numbers
00140 0601 FLDA% INDX /Load the pointer
00141 0010 ALN 0 /Fix it
00142 0006 STARTD /Address mode
00143 1630 FADD% #BASE,3 /Add address of ARRAY/VARIABLE
00144 1207 FADD XSETX /Create a SETX ARRAY+INDEX-1
00145 6400 FSTA ZSETX,0 /Store to execute in line
00146 0152
00147 0650 FLDA% #BASE,5 /Load pointer to MASK/Replacement word
RALF V50A 24-JUL-20 PAGE 1-4
00150 6201 FSTA INDX /Store this
00151 0005 STARTF /Set numeric mode
00152 1100 ZSETX, SETX . /Set index on target word
00153 0152
00154 1030 JA GETARG /Return, everything set
00155 0117
RALF V50A 24-JUL-20 PAGE 1-5
NO ERRORS
21 SYMBOLS, NO ABS REFS
# C 00000 #ARGER X 00000 #BASE 00010 #GOBAK 00044
#GTWRD 00021 #MAIN S 00000 #MASK 8 00156 #PTWRD 00016
#RETRN X 00000 #XR 00024 GETARG 00117 GETWRD 00076
INDX 00013 K2048 00032 NOMASK 00114 OK 00065
PUTERR 00072 PUTWRD 00046 SECNAM 00005 TSTNEG 00062
WORDS S 00000 XSETX 00035 ZSETX 00152