Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0002/makgog.sai
There is 1 other file named makgog.sai in the archive. Click here to see a list.
begin "libhed"

Comment This program was extracted from SCISS.  It makes GOGTAB.DEF
	from HEAD, after compilation with a special switch.  SCISS
	does this as a sideeffect.  But since SCISS is otherwise
	meaningless for the Tops-20 implementation, it seemed
	cleaner to supply this as a separate routine.;

 define  = "begin",  = "end";
      INTEGER I,COUNT,TYPEWD,BLKSIZ,BRK,EOF,SRC,symo;
      INTEGER PERLINE;
      INTEGER ARRAY BLOCK[0:17];
      define crlf = "'15&'12";

      PROCEDURE GETBLK;
       "GETBLK"
	 IF COUNT=0 THEN 
	    TYPEWD _ WORDIN(SRC);
	    COUNT _ TYPEWD LAND '777777;
	    TYPEWD _ TYPEWD LSH -18
	 ;
	 WORDIN(SRC);
	 ARRYIN(SRC,BLOCK[0],BLKSIZ _ COUNT MIN 18);
	 COUNT _ COUNT - BLKSIZ
       "GETBLK";

      RECURSIVE STRING PROCEDURE R50TO7(INTEGER SYM);  "R50TO7"
	COMMENT CONVERT RADIX50 TO ASCII;
	IF SYM=0 THEN RETURN(NULL) ELSE 
	INTEGER CHAR; CHAR_SYM MOD '50;
	CHAR_IF CHAR LEQ 10 THEN CHAR-1+"0"
	 ELSE IF CHAR LEQ 10+"Z"-'101 THEN CHAR-11+"A"
	 ELSE IF CHAR=37 THEN "."
	 ELSE IF CHAR=38 THEN "$"
	 ELSE IF CHAR=39 THEN "%"
	 ELSE 0;
	RETURN(R50TO7(SYM % '50)&CHAR)   "R50TO7";

      open(src_getchan,"DSK",0,3,0,i,i,eof);
      LOOKUP(SRC,"SAIHED.REL",COUNT);

      PERLINE_COUNT_0;
      DO GETBLK UNTIL TYPEWD=2;
      OPEN(SYMO_getchan,"DSK",0,0,3,I,I,I); IF I THEN USERERR(0,0,"NO DSK TODAY");
      ENTER(SYMO,"GOGTAB.DEF",I); IF I THEN USERERR(0,0,"CANT ENTER GOGTAB.DEF");
      OUT(SYMO,"REQUIRE ""[][]"" DELIMITERS;"&CRLF&
	"COMMENT SYMBOLIC USER TABLE INDICES");
      DO 
	 INTEGER B,C;
	 C_BLOCK[0];
	 B_C LAND '37777777777;
	 IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN 
	    IF (PERLINE LAND '37) THEN OUT(SYMO,";"&CRLF&CRLF&"DEFINE ")
	    ELSE OUT(SYMO,IF (PERLINE LAND 3) THEN ","&CRLF ELSE ",");
	    OUT(SYMO,R50TO7(B)&"=['"&CVOS(BLOCK[1])&"]");
	    PERLINE_PERLINE+1;
	 ;
	 GETBLK
       UNTIL TYPEWD=5;
      OUT(SYMO,";"&CRLF&CRLF&"REQUIRE UNSTACK!DELIMITERS;"); RELEASE(SYMO);

      CLOSE(SRC);
end "libhed";