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"