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))&"%");