Commit | Line | Data |
---|---|---|
84b5715c PH |
1 | SECT WORDS\r |
2 | /FILE GETWRD\r | |
3 | /Version 02.06\r | |
4 | \r | |
5 | /This module contains two entry points to allow FORTRAN\r | |
6 | /programs access to the contents of any of the 3 12-bit words\r | |
7 | /in any floating point variable. The idea is to facilitate\r | |
8 | /operations on text strings which are stored as 8-bit ASCII,\r | |
9 | /such as input by the routine RDLIN (see write up for RDLIN\r | |
10 | /included with that routine.).\r | |
11 | \r | |
12 | / ROUTINE GETWRD\r | |
13 | \r | |
14 | /This routine is a function subroutine (ie: the result is\r | |
15 | /returned in the FAC). As such it's name may be used in arithmetic\r | |
16 | /statments and the returned data will be used directly. The\r | |
17 | /following example illustrates it's use:\r | |
18 | / .\r | |
19 | / .\r | |
20 | / RESULT=GETWRD(MESSAG,INDX,MASK)\r | |
21 | / .\r | |
22 | / .\r | |
23 | \r | |
24 | /Here, the desired word (exponent,hi or lo mantissa) will\r | |
25 | /be returned and placed into the variable RESULT. The argument\r | |
26 | /MESSAG may be a variable or an array. The actual address in the\r | |
27 | /array will be computed by the routine, depending on the value\r | |
28 | /of the variable INDX. INDX points to the specific 12-bit word in\r | |
29 | /the array you want. The routine adds this number to the start\r | |
30 | /address of the array, and operates on this word with an XTA\r | |
31 | /instruction.\r | |
32 | \r | |
33 | /The following table illustrates this conversion:\r | |
34 | \r | |
35 | /Value of INDX Element word Array element\r | |
36 | \r | |
37 | / 1 Exponent 1\r | |
38 | / 2 Hi mant. 1\r | |
39 | / 3 Lo mant. 1\r | |
40 | / 4 Exponent 2\r | |
41 | / 5 Hi mant. 2\r | |
42 | / etc. etc. etc.\r | |
43 | \r | |
44 | /The argument MASK allows the masking of the data retrieved\r | |
45 | /so parity bits etc. can be removed easily. The value should be\r | |
46 | /the decimal equivalent of the octal number you want the data masked\r | |
47 | /by. If MASK is 0, no masking takes place.\r | |
48 | \r | |
49 | / ROUTINE PUTWRD\r | |
50 | \r | |
51 | /This routine provides the converse function of GETWRD.\r | |
52 | /It is called from FORTRAN using a standard subroutine call:\r | |
53 | \r | |
54 | / CALL PUTWRD(MESSAG,INDX,WORD)\r | |
55 | \r | |
56 | /The first 2 arguments are identical to those in the routine GETWRD,\r | |
57 | /but the third argument reflects the difference in function of\r | |
58 | /these two routines. WORD is the value in decimal that is to\r | |
59 | /be placed into the 12-bit word referenced by the first two\r | |
60 | /arguments. Masking is not provided for.\r | |
61 | \r | |
62 | EXTERN #RETRN\r | |
63 | EXTERN #ARGER\r | |
64 | ENTRY GETWRD\r | |
65 | ENTRY PUTWRD\r | |
66 | \r | |
67 | \r | |
68 | /Little routine to do masking of octal data.\r | |
69 | /Although the references to XR 0 and 1 destroy the\r | |
70 | /value of the Array element in XR 0-2, this is of no\r | |
71 | /consequence because we've already finished using it.\r | |
72 | \r | |
73 | /The only caveat here is that #XR+2 is not an auto index register\r | |
74 | /Calling in #PAGE0 won't help because we could ge loaded onto\r | |
75 | /page 0 of some other field.\r | |
76 | \r | |
77 | SECT8 #MASK\r | |
78 | TAD #XR /Index 0 contains fetched data\r | |
79 | AND #XR+1 /Index 1 contains the mask.\r | |
80 | DCA #XR /Apply mask to data\r | |
81 | CIF CDF /Reset data field\r | |
82 | JMP% #XR+2 /XR5 contains return address\r | |
83 | \r | |
84 | /FPP code starts here. It is intended that it be contiguous\r | |
85 | /with the 8-mode code so the rest of the page is not wasted\r | |
86 | \r | |
87 | SECNAM, TEXT +GETWRD+ /Init for traceback\r | |
88 | #BASE, ORG .+3 /Base 0\r | |
89 | INDX, ORG .+3 /Base 1: Stuff addresses in here\r | |
90 | #PTWRD, TEXT +PUTWRD+ /Base 2: One of the section names\r | |
91 | #GTWRD, TEXT +GETWRD+ /Base 3: The other section name\r | |
92 | \r | |
93 | /Relative address on page is 23. This puts XR+2 out of any possible\r | |
94 | /danger with respect to auto-index registers.\r | |
95 | \r | |
96 | #XR, FNOP /Base 4: XR0-2\r | |
97 | ADDR #RETRN / #XR2=return to FRTS address\r | |
98 | 1;2;3 /Base 5: XR3-5\r | |
99 | /TENK, F 4096.0 /Base 6\r | |
100 | K2048, F 2048.0\r | |
101 | XSETX, 27;47;7777 /Base 7: SETX-JA-1\r | |
102 | \r | |
103 | ORG #BASE+30\r | |
104 | FNOP; JA #BASE /Pointer to section name+3\r | |
105 | FNOP;#GOBAK, 0;0 /Pointer to calling base page\r | |
106 | \r | |
107 | /Routine starts here. Details of index register usage are\r | |
108 | /as follows:\r | |
109 | \r | |
110 | / XR 0 Used to fetch/store/hold target word\r | |
111 | / XR 1 Used as arg. fetch index, and to hold mask word\r | |
112 | / XR 2 Contains the FRTS TRAP return address\r | |
113 | / XR 3 =1 to fetch ARRAY arg\r | |
114 | / XR 4 =2 to fetch INDEX arg\r | |
115 | / XR 5 =3 to fetch WORD/MASK arg\r | |
116 | \r | |
117 | BASE #BASE /Tell assembler wher the base page is\r | |
118 | \r | |
119 | /Enter here for PUTWRD\r | |
120 | \r | |
121 | PUTWRD, FLDA #PTWRD,0 /Get putwrd name\r | |
122 | JSA GETARG /Get args set up\r | |
123 | \r | |
124 | FLDA% INDX /Load the new value for target word\r | |
125 | JLT TSTNEG /Negative range check\r | |
126 | FSUB K2048 /For positive, < 2048\r | |
127 | JGE PUTERR /Out of range\r | |
128 | JA OK /Else ok\r | |
129 | TSTNEG, FADD K2048 /Neg more than 2048?\r | |
130 | JLE PUTERR /Yes, errror\r | |
131 | OK, FLDA% INDX\r | |
132 | FLDA% INDX /In range\r ATX 0 /Store it\r | |
133 | JA #GOBAK /Return\r | |
134 | \r | |
135 | PUTERR, FLDA SECNAM\r | |
136 | TRAP4 #ARGER\r | |
137 | \r | |
138 | /Enter here for GETWRD\r | |
139 | \r | |
140 | GETWRD, FLDA #GTWRD,0 /Load section name\r | |
141 | JSA GETARG /Get things set up\r | |
142 | \r | |
143 | XTA 0 /Get the target word\r | |
144 | SETX #XR /Reset index registers\r | |
145 | ATX 0 /Store word in XR 0\r | |
146 | \r | |
147 | FLDA% INDX /Get the mask value\r | |
148 | JEQ NOMASK /If 0, skip masking\r | |
149 | ATX 1 /Put the mask value into an index\r | |
150 | TRAP3 #MASK /Go mask the number\r | |
151 | \r | |
152 | NOMASK, XTA 0 /Recover the masked number\r | |
153 | / JGE #GOBAK /If result is positive, return now\r | |
154 | / FADD TENK /Otherwise, un-2's complement first\r | |
155 | JA #GOBAK /Return the answer in FAC\r | |
156 | \r | |
157 | /Both routines come here to get things set up. FAC contains\r | |
158 | /section name.\r | |
159 | \r | |
160 | \r | |
161 | GETARG, 0;0\r | |
162 | FSTA SECNAM /Name into traceback prologue\r | |
163 | SETX #XR /Set address of index registers\r | |
164 | \r | |
165 | STARTD /Mode for addresses\r | |
166 | 0210 /Load pointer to callers prologue\r | |
167 | FSTA #GOBAK,0 /Store as return address\r | |
168 | 0200 /Load address of argument list\r | |
169 | SETB #BASE /Now tell FPP where the base page is\r | |
170 | \r | |
171 | FSTA #BASE /Store address of args\r | |
172 | \r | |
173 | FLDA% #BASE,4 /Load pointer to INDX\r | |
174 | FSTA INDX /Store this\r | |
175 | \r | |
176 | STARTF /Mode for numbers\r | |
177 | FLDA% INDX /Load the pointer\r | |
178 | ALN 0 /Fix it\r | |
179 | STARTD /Address mode\r | |
180 | \r | |
181 | FADD% #BASE,3 /Add address of ARRAY/VARIABLE\r | |
182 | FADD XSETX /Create a SETX ARRAY+INDEX-1\r | |
183 | FSTA ZSETX,0 /Store to execute in line\r | |
184 | \r | |
185 | FLDA% #BASE,5 /Load pointer to MASK/Replacement word\r | |
186 | FSTA INDX /Store this\r | |
187 | STARTF /Set numeric mode\r | |
188 | \r | |
189 | ZSETX, SETX . /Set index on target word\r | |
190 | JA GETARG /Return, everything set\r |