perm filename DEBY.SAI[AID,HE] blob
sn#381305 filedate 1978-09-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "DEBY"
C00007 00003 PROCEDURE FC11(REAL F10 REFERENCE INTEGER WORD1, WORD2)
C00009 00004
C00013 ENDMK
C⊗;
BEGIN "DEBY"
COMMENT This is a test routine to assist testing and debugging PNTAID;
REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "MSSNGR.REL[AID,HE]" LOAD_MODULE;
EXTERNAL PROCEDURE EVAL(INTEGER ARRAY REQ; INTEGER REQLENGTH;
REAL ARRAY ANSWER; REFERENCE INTEGER ANSLENGTH);
EXTERNAL PROCEDURE INIT;
STRING ARRAY XOPCODE[1:200];
PROCEDURE COP(INTEGER C; REFERENCE INTEGER XL; REFERENCE BOOLEAN INITIALIZED;
REFERENCE INTEGER OPVAL; STRING OPTXT);
! This procedure is used for converting an AL interpreter opcode from symbolic
to numeric form (if C = 0), or from numeric to symbolic form (if C ≠ 0);
BEGIN "cop"
INTEGER CHAN,COUNT,BRCHAR,EOF,FLAG,BRTABL0,BRTABL1,INDEX,CLASS;
STRING SYMBOL,DELIMTR;
IF NOT INITIALIZED THEN
BEGIN "initialize"
CHAN←GETCHAN;
COUNT←200;
OPEN( CHAN, "DSK", 0, 2, 0, COUNT, BRCHAR, EOF);
LOOKUP( CHAN, "INTOPS.PAL[AL,HE]",FLAG);
BRTABL0 ← GETBREAK;
BRTABL1 ← GETBREAK;
SETBREAK( BRTABL0, CRLF&" ,"&TAB&FF, NULL, "XNR");
SETBREAK( BRTABL1, CRLF&" ,"&TAB&FF, NULL, "INR");
INDEX ← 0 ;
DEFINE GETSYMBOL="BEGIN INPUT( CHAN, BRTABL0);
SYMBOL← INPUT( CHAN, BRTABL1)
END";
CLASS← 0;
GETSYMBOL;
WHILE NOT EOF DO
CASE CLASS OF
BEGIN "fill"
BEGIN "0 ≡ passing"
IF EQU(SYMBOL,"COMMENT")
THEN CLASS← 1
ELSE IF EQU(SYMBOL,"MAKEOP") THEN CLASS← 3;
GETSYMBOL;
END "0 ≡ passing";
BEGIN "1 ≡ comment"
DELIMTR←SYMBOL[1 for 1];
CLASS← 2;
GETSYMBOL
END "1 ≡ comment";
BEGIN "2 ≡ delimitted"
INTEGER L,I;
L←LENGTH(SYMBOL);
FOR I←1 TIL L DO IF SYMBOL[I FOR 1]=DELIMTR THEN CLASS← 0;
GETSYMBOL;
END "2 ≡ delimitted";
BEGIN "3 ≡ MAKEOP"
INDEX← INDEX + 1 ;
XOPCODE[INDEX] ← SYMBOL ;
CLASS← 0;
GETSYMBOL;
END "3 ≡ MAKEOP"
END "fill";
XL ← INDEX ;
INITIALIZED ← TRUE ;
END "initialize";
IF C=0
THEN
BEGIN
INTEGER I;
FOR I←1 STEP 1 UNTIL XL DO
IF EQU(XOPCODE[I],OPTXT) THEN BEGIN OPVAL← 2*I; RETURN END
;
OPVAL← 0;
RETURN
END
ELSE
IF ( 2 ≤ OPVAL ≤ XL ) AND (OPVAL = (OPVAL LSH -1) LSH 1 )
THEN BEGIN OPTXT← XOPCODE[OPVAL%2]; RETURN END
ELSE BEGIN OPTXT← NULL; RETURN END;
END "cop";
BOOLEAN COPINIT;
INTEGER COPXL;
INTEGER PROCEDURE OPNUM(STRING TXT);
BEGIN
INTEGER VAL;
COP( 0, COPXL, COPINIT, VAL, TXT);
RETURN(VAL)
END;
STRING PROCEDURE OPTXT(INTEGER VAL);
BEGIN
STRING TXT;
COP( 1, COPXL, COPINIT, VAL, TXT);
RETURN(TXT);
END;
STRING PROCEDURE ASCIFY (INTEGER ARRAY MSG; INTEGER LTH);
BEGIN "ascify"
! Converts the 11-format ASCIZ string to 10-format;
STRING ANS;
INTEGER PTR;
ANS ← NULL;
FOR PTR ← 1 STEP 1 UNTIL LTH DO
BEGIN "unpack" ! Take care of two characters;
ANS ← ANS & (MSG[PTR] LAND '377) & (MSG[PTR] LSH -8);
END "unpack";
RETURN(ANS);
END "ascify";
PROCEDURE FC11(REAL F10; REFERENCE INTEGER WORD1, WORD2);
BEGIN
! Convert a pdp-10 floating number (i.e. F10) to a two pdp-11 word (i.e. WORD1,
WORD2) floating number format to be sent to the 11 ;
INTEGER SIGN, EXPONENT, FRAC, FRAC1, FRAC2;
IF MEMLOC(F10, INTEGER)=0 THEN BEGIN WORD1←WORD2←0; RETURN END;
SIGN← MEMLOC(F10, INTEGER) LSH -35;
EXPONENT← MEMLOC(F10, INTEGER) LSH 1 LSH -28;
FRAC← MEMLOC(F10, INTEGER) LSH 9 LSH -9;
! PRINT(CRLF,"F10=",CVOS(F10)," SIGN=",SIGN," EXP=",CVOS(EXPONENT)," FRAC=",CVOS(FRAC));
IF SIGN=1 THEN BEGIN
EXPONENT← (LNOT EXPONENT) LAND '377;
FRAC← '1000000000 - FRAC
END;
FRAC1← (FRAC LSH -19) LAND '177;
FRAC2← FRAC LSH 17 LSH -20;
! PRINT(CRLF,"FRAC1=",CVOS(FRAC1)," FRAC2=",CVOS(FRAC2));
WORD1← SIGN LSH 15 LOR EXPONENT LSH 7 LOR FRAC1;
WORD2← FRAC2;
! PRINT(crlf," WORD1=",CVOS(WORD1)," WORD2=",CVOS(WORD2));
END;
INTEGER I;
INTEGER ARRAY REQUEST[1:50];
REAL ARRAY ANS[1:12];
INTEGER REQLEN, ANSLEN;
COPINIT← FALSE;
REQLEN←20;
REQUEST[1]← 3;
REQUEST[2]← 2;
REQUEST[3]← OPNUM("XMVAR");
REQUEST[4]← 1;
REQUEST[5]← 2;
REQUEST[6]← 0;
REQUEST[7]← OPNUM("XGTVAL");
REQUEST[8]← '2;
REQUEST[9]← OPNUM("XVALPRN");
REQUEST[10]← OPNUM("XNOOP");
REQUEST[11]← OPNUM("XPUSHSCI");
FC11(1.0,REQUEST[12],REQUEST[13]);
REQUEST[14]← OPNUM("XGTVAL");
REQUEST[15]← '405;
REQUEST[16]← OPNUM("XCHNGE");
REQUEST[17]← '402;
REQUEST[18]← OPNUM("XKVAR");
REQUEST[19]← 2;
REQUEST[20]← OPNUM("XTERMINATE");
EVAL(REQUEST,REQLEN,ANS,ANSLEN);
PRINT(CRLF,ANSLEN,CRLF);
FOR I←1 TIL ANSLEN DO PRINT(CRLF,ANS[I]);
END "DEBY"