perm filename EXTEND.SAI[X,AIL] blob sn#002439 filedate 1975-02-16 generic text, type T, neo UTF8
00050	DEFINE DSCR="COMMENT ";
00100	DSCR "MACHINE EXTENSION FUNCTIONS"
00200	DES THIS SET OF FUNCTIONS IS USED TO EXTEND THE DATA-ACESSING AND
00300	 CONVERSION POWER OF SAIL TO HANDLE HALF-WORD OPERANDS, AND
00400	 THE VERY COMMON RECNO-WORD OR RECNO-INDEX FORMS (10 BIT-8 BIT FIELD
00500	 PAIRS).  THE DESCRIPTION IS ARRANGED IN A WAY TO HELP FIND THEM
00600	 WHEN YOU'VE FORGOTTEN WHAT THEY ARE:
00700	
00800		integer→integer			integer→string
00900	
01000	  left half
01100	    load
01200		L←LH(W) 			"S"←CVSL(W) convert lh to string
01300						"S"←CVOSL(W)  same, but octal
01400	    store
01500		L←STLH(@Y,W) l←lh(y)←w
01600		L←STLHZ(@Y,W) same+rh(y)←0
01700	
01800	
01900	  right half
02000	    load
02100		R←RH(W)				"S"←CVSR(W) similar
02200						"S"←CVOSR(W)
02300	
02400	    store
02500		R←STRH(Y,W) similar to stlh
02600		R←STRHZ(Y,W)
02700	
02800	
02900	  both halves
03000	    load
03100	      W←CVH(L,R)  l lsh 18 + r	 	"S"←CVSH(W) both halves, sep by " "
03200						"S"←CVOSH(W)
03300	
03400	    store
03500	       W←STH(@L,@R,W) left half to l, etc.
03600	
03700	
03800	  recno-word
03900	    load
04000		RW←CVRW(R,W) packs to 18 bits
04100	    store
04200		RW←STRW(@R,@W,RW) unpacks to R,W
04300						"S"←CVSRW(RW) "$rec-wd$"
04400	
04500	  recno-index
04600	    load
04700		RI←CVRW(R,I) no different
04800	    store
04900		RI←STRW(R,I,RI)			"S"←CVSRI(RI) "%rec-index%"
05000	
05100	;
05200	COMMENT HERE, THEN, ARE THE "MACHINE-EXTENDING" FUNCTIONS;
05300	
05400	INTEGER PROCEDURE RH(INTEGER W);START_CODE HRRZ 1,W; END;
05500	INTEGER PROCEDURE LH(INTEGER W);START_CODE HLRZ 1,W; END;
05600	INTEGER PROCEDURE STRH(REFERENCE INTEGER Y;INTEGER W);
05700	 START_CODE HRRZ 1,W; HRRM 1,⊗'777776('17); END;
05800	INTEGER PROCEDURE STLH(REFERENCE INTEGER Y; INTEGER W);
05900	 START_CODE HRRZ 1,W; HRLM 1,⊗'777776('17); END;
06000	INTEGER PROCEDURE STLHZ(REFERENCE INTEGER Y; INTEGER W);
06100	 START_CODE HRRZ 1,W; HLRZM 1,@-2('17); END;
06200	INTEGER PROCEDURE STRHZ(REFERENCE INTEGER Y; INTEGER W);
06300	 START_CODE HRRZ 1,W; HRRZM 1,@-2('17); END;
06400	STRING PROCEDURE CVSL(INTEGER W);RETURN(CVS(LH(W)));
06500	STRING PROCEDURE CVOSL(INTEGER W);RETURN(CVOS(LH(W)));
06600	STRING PROCEDURE CVSR(INTEGER W);RETURN(CVS(RH(W)));
06700	STRING PROCEDURE CVOSR(INTEGER W);RETURN(CVOS(RH(W)));
06800	INTEGER PROCEDURE CVH(INTEGER L,R);RETURN(L LSH 18 + R);
06900	INTEGER PROCEDURE STH(REFERENCE INTEGER L,R; INTEGER W);
07000	START_CODE
07100	 MOVE 1,W;
07200	 HLRZM 1,⊗'777775('17);
07300	 HRRZM 1,⊗'777776('17);
07400	END "STH";
07500	STRING PROCEDURE CVSH(INTEGER W);RETURN(CVS(LH(W))&CVS(RH(W)));
07600	STRING PROCEDURE CVOSH(INTEGER W);RETURN(CVOS(LH(W))&" "&CVOS(RH(W)));
07700	INTEGER PROCEDURE RECBITS(INTEGER RW); RETURN(LDB(POINT(10,RW,27)));
07800	INTEGER PROCEDURE WDBITS(INTEGER RW); RETURN(RW LAND '377);
07900	INTEGER PROCEDURE CVRW(INTEGER R,W);RETURN((R LSH 8) LOR (W LAND '377));
08000	INTEGER PROCEDURE STRW(REFERENCE INTEGER R,W;INTEGER RW);
08100	BEGIN
08200	 R←RECBITS(RW);
08300	 W←WDBITS(RW);
08400	 RETURN(RW)
08500	END;
08600	STRING PROCEDURE CVSRW(INTEGER RW);
08700	 RETURN("$"&CVOS(RECBITS(RW))&"-"&CVOS(WDBITS(RW))&"$");
08800	STRING PROCEDURE CVSRI(INTEGER RII);
08900	 RETURN("%"&CVOS(RECBITS(RII))&"-"&CVOS(WDBITS(RII))&"%");