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