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