+++ /dev/null
- SECT WORDS\r
-/FILE GETWRD\r
-/Version 02.06\r
-\r
-/This module contains two entry points to allow FORTRAN\r
-/programs access to the contents of any of the 3 12-bit words\r
-/in any floating point variable. The idea is to facilitate\r
-/operations on text strings which are stored as 8-bit ASCII,\r
-/such as input by the routine RDLIN (see write up for RDLIN\r
-/included with that routine.).\r
-\r
-/ ROUTINE GETWRD\r
-\r
-/This routine is a function subroutine (ie: the result is\r
-/returned in the FAC). As such it's name may be used in arithmetic\r
-/statments and the returned data will be used directly. The\r
-/following example illustrates it's use:\r
-/ .\r
-/ .\r
-/ RESULT=GETWRD(MESSAG,INDX,MASK)\r
-/ .\r
-/ .\r
-\r
-/Here, the desired word (exponent,hi or lo mantissa) will\r
-/be returned and placed into the variable RESULT. The argument\r
-/MESSAG may be a variable or an array. The actual address in the\r
-/array will be computed by the routine, depending on the value\r
-/of the variable INDX. INDX points to the specific 12-bit word in\r
-/the array you want. The routine adds this number to the start\r
-/address of the array, and operates on this word with an XTA\r
-/instruction.\r
-\r
-/The following table illustrates this conversion:\r
-\r
-/Value of INDX Element word Array element\r
-\r
-/ 1 Exponent 1\r
-/ 2 Hi mant. 1\r
-/ 3 Lo mant. 1\r
-/ 4 Exponent 2\r
-/ 5 Hi mant. 2\r
-/ etc. etc. etc.\r
-\r
-/The argument MASK allows the masking of the data retrieved\r
-/so parity bits etc. can be removed easily. The value should be\r
-/the decimal equivalent of the octal number you want the data masked\r
-/by. If MASK is 0, no masking takes place.\r
-\r
-/ ROUTINE PUTWRD\r
-\r
-/This routine provides the converse function of GETWRD.\r
-/It is called from FORTRAN using a standard subroutine call:\r
-\r
-/ CALL PUTWRD(MESSAG,INDX,WORD)\r
-\r
-/The first 2 arguments are identical to those in the routine GETWRD,\r
-/but the third argument reflects the difference in function of\r
-/these two routines. WORD is the value in decimal that is to\r
-/be placed into the 12-bit word referenced by the first two\r
-/arguments. Masking is not provided for.\r
-\r
- EXTERN #RETRN\r
- EXTERN #ARGER\r
- ENTRY GETWRD\r
- ENTRY PUTWRD\r
-\r
-\r
-/Little routine to do masking of octal data.\r
-/Although the references to XR 0 and 1 destroy the\r
-/value of the Array element in XR 0-2, this is of no\r
-/consequence because we've already finished using it.\r
-\r
-/The only caveat here is that #XR+2 is not an auto index register\r
-/Calling in #PAGE0 won't help because we could ge loaded onto\r
-/page 0 of some other field.\r
-\r
- SECT8 #MASK\r
- TAD #XR /Index 0 contains fetched data\r
- AND #XR+1 /Index 1 contains the mask.\r
- DCA #XR /Apply mask to data\r
- CIF CDF /Reset data field\r
- JMP% #XR+2 /XR5 contains return address\r
-\r
-/FPP code starts here. It is intended that it be contiguous\r
-/with the 8-mode code so the rest of the page is not wasted\r
-\r
-SECNAM, TEXT +GETWRD+ /Init for traceback\r
-#BASE, ORG .+3 /Base 0\r
-INDX, ORG .+3 /Base 1: Stuff addresses in here\r
-#PTWRD, TEXT +PUTWRD+ /Base 2: One of the section names\r
-#GTWRD, TEXT +GETWRD+ /Base 3: The other section name\r
-\r
-/Relative address on page is 23. This puts XR+2 out of any possible\r
-/danger with respect to auto-index registers.\r
-\r
-#XR, FNOP /Base 4: XR0-2\r
- ADDR #RETRN / #XR2=return to FRTS address\r
- 1;2;3 /Base 5: XR3-5\r
-/TENK, F 4096.0 /Base 6\r
-K2048, F 2048.0\r
-XSETX, 27;47;7777 /Base 7: SETX-JA-1\r
-\r
- ORG #BASE+30\r
- FNOP; JA #BASE /Pointer to section name+3\r
- FNOP;#GOBAK, 0;0 /Pointer to calling base page\r
-\r
-/Routine starts here. Details of index register usage are\r
-/as follows:\r
-\r
-/ XR 0 Used to fetch/store/hold target word\r
-/ XR 1 Used as arg. fetch index, and to hold mask word\r
-/ XR 2 Contains the FRTS TRAP return address\r
-/ XR 3 =1 to fetch ARRAY arg\r
-/ XR 4 =2 to fetch INDEX arg\r
-/ XR 5 =3 to fetch WORD/MASK arg\r
-\r
- BASE #BASE /Tell assembler wher the base page is\r
-\r
-/Enter here for PUTWRD\r
-\r
-PUTWRD, FLDA #PTWRD,0 /Get putwrd name\r
- JSA GETARG /Get args set up\r
-\r
- FLDA% INDX /Load the new value for target word\r
- JLT TSTNEG /Negative range check\r
- FSUB K2048 /For positive, < 2048\r
- JGE PUTERR /Out of range\r
- JA OK /Else ok\r
-TSTNEG, FADD K2048 /Neg more than 2048?\r
- JLE PUTERR /Yes, errror\r
-OK, FLDA% INDX\r
- FLDA% INDX /In range\r ATX 0 /Store it\r
- JA #GOBAK /Return\r
-\r
-PUTERR, FLDA SECNAM\r
- TRAP4 #ARGER\r
-\r
-/Enter here for GETWRD\r
-\r
-GETWRD, FLDA #GTWRD,0 /Load section name\r
- JSA GETARG /Get things set up\r
-\r
- XTA 0 /Get the target word\r
- SETX #XR /Reset index registers\r
- ATX 0 /Store word in XR 0\r
-\r
- FLDA% INDX /Get the mask value\r
- JEQ NOMASK /If 0, skip masking\r
- ATX 1 /Put the mask value into an index\r
- TRAP3 #MASK /Go mask the number\r
-\r
-NOMASK, XTA 0 /Recover the masked number\r
-/ JGE #GOBAK /If result is positive, return now\r
-/ FADD TENK /Otherwise, un-2's complement first\r
- JA #GOBAK /Return the answer in FAC\r
-\r
-/Both routines come here to get things set up. FAC contains\r
-/section name.\r
-\r
-\r
-GETARG, 0;0\r
- FSTA SECNAM /Name into traceback prologue\r
- SETX #XR /Set address of index registers\r
-\r
- STARTD /Mode for addresses\r
- 0210 /Load pointer to callers prologue\r
- FSTA #GOBAK,0 /Store as return address\r
- 0200 /Load address of argument list\r
- SETB #BASE /Now tell FPP where the base page is\r
-\r
- FSTA #BASE /Store address of args\r
-\r
- FLDA% #BASE,4 /Load pointer to INDX\r
- FSTA INDX /Store this\r
-\r
- STARTF /Mode for numbers\r
- FLDA% INDX /Load the pointer\r
- ALN 0 /Fix it\r
- STARTD /Address mode\r
-\r
- FADD% #BASE,3 /Add address of ARRAY/VARIABLE\r
- FADD XSETX /Create a SETX ARRAY+INDEX-1\r
- FSTA ZSETX,0 /Store to execute in line\r
-\r
- FLDA% #BASE,5 /Load pointer to MASK/Replacement word\r
- FSTA INDX /Store this\r
- STARTF /Set numeric mode\r
-\r
-ZSETX, SETX . /Set index on target word\r
- JA GETARG /Return, everything set\r