File: GETWRD.RA of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
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, /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 TAD #XR /Index 0 contains fetched data AND #XR+1 /Index 1 contains the mask. DCA #XR /Apply mask to data CIF CDF /Reset data field 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 SECNAM, TEXT +GETWRD+ /Init for traceback #BASE, ORG .+3 /Base 0 INDX, ORG .+3 /Base 1: Stuff addresses in here #PTWRD, TEXT +PUTWRD+ /Base 2: One of the section names #GTWRD, TEXT +GETWRD+ /Base 3: The other section name /Relative address on page is 23. This puts XR+2 out of any possible /danger with respect to auto-index registers. #XR, FNOP /Base 4: XR0-2 ADDR #RETRN / #XR2=return to FRTS address 1;2;3 /Base 5: XR3-5 /TENK, F 4096.0 /Base 6 K2048, F 2048.0 XSETX, 27;47;7777 /Base 7: SETX-JA-1 ORG #BASE+30 FNOP; JA #BASE /Pointer to section name+3 FNOP;#GOBAK, 0;0 /Pointer to calling base page /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 PUTWRD, FLDA #PTWRD,0 /Get putwrd name JSA GETARG /Get args set up FLDA% INDX /Load the new value for target word JLT TSTNEG /Negative range check FSUB K2048 /For positive, < 2048 JGE PUTERR /Out of range JA OK /Else ok TSTNEG, FADD K2048 /Neg more than 2048? JLE PUTERR /Yes, errror OK, FLDA% INDX FLDA% INDX /In range ATX 0 /Store it JA #GOBAK /Return PUTERR, FLDA SECNAM TRAP4 #ARGER /Enter here for GETWRD GETWRD, FLDA #GTWRD,0 /Load section name JSA GETARG /Get things set up XTA 0 /Get the target word SETX #XR /Reset index registers ATX 0 /Store word in XR 0 FLDA% INDX /Get the mask value JEQ NOMASK /If 0, skip masking ATX 1 /Put the mask value into an index TRAP3 #MASK /Go mask the number NOMASK, XTA 0 /Recover the masked number / JGE #GOBAK /If result is positive, return now / FADD TENK /Otherwise, un-2's complement first JA #GOBAK /Return the answer in FAC /Both routines come here to get things set up. FAC contains /section name. GETARG, 0;0 FSTA SECNAM /Name into traceback prologue SETX #XR /Set address of index registers STARTD /Mode for addresses 0210 /Load pointer to callers prologue FSTA #GOBAK,0 /Store as return address 0200 /Load address of argument list SETB #BASE /Now tell FPP where the base page is FSTA #BASE /Store address of args FLDA% #BASE,4 /Load pointer to INDX FSTA INDX /Store this STARTF /Mode for numbers FLDA% INDX /Load the pointer ALN 0 /Fix it STARTD /Address mode FADD% #BASE,3 /Add address of ARRAY/VARIABLE FADD XSETX /Create a SETX ARRAY+INDEX-1 FSTA ZSETX,0 /Store to execute in line FLDA% #BASE,5 /Load pointer to MASK/Replacement word FSTA INDX /Store this STARTF /Set numeric mode ZSETX, SETX . /Set index on target word JA GETARG /Return, everything set