X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;ds=sidebyside;f=sw%2Fadventure%2FGETWRD.RA;fp=sw%2Fadventure%2FGETWRD.RA;h=0000000000000000000000000000000000000000;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=3556b06a0a6f70e70c1b49d41dedb647fd8497dc;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/adventure/GETWRD.RA b/sw/adventure/GETWRD.RA deleted file mode 100644 index 3556b06..0000000 --- a/sw/adventure/GETWRD.RA +++ /dev/null @@ -1,190 +0,0 @@ - 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