--- /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
projects / pdp8.git / blobdiff