Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/scnr.bli
There are 12 other files named scnr.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1976,1981 BY DIGITAL EQUIPMENT CORPORATION
! Author: *

MODULE SCNR=
BEGIN

GLOBAL BIND SCNRV = 6^24 + 0^18 + 0;	! Version Date: 21-Nov-80

%(

***** Begin Revision History *****

***** End Revision History *****

)%

	MACRO BUFSIZ=100$;
	FORWARD GETTTY,SETUP;
	EXTERNAL RESET,CRLF,RETABLE;
	EXTERNAL QPARSE,SECDEFS;
	EXTERNAL SIXBIT,PUTMSG,IOERR;

GLOBAL ROUTINE INIT=
    BEGIN
	LOCAL VECTOR ZBUFFER[BUFSIZ+3];
	RESET();
	CRLF(0);
	DO
	    BEGIN
		RETABLE();
		ZBUFFER[0]_BUFSIZ;
		ZBUFFER[1]_0;
		ZBUFFER[2]_0;
		PUTMSG('*');
		GETTTY(ZBUFFER);
	    END
	    UNTIL
		SETUP(ZBUFFER);
    END;
ROUTINE GETTTY(BUFF)=
    BEGIN
	MACRO	INCHWL(X)=TTCALL(4,X)$,
		SIZEFLD=24,6$,
		CLRBFI=TTCALL(#11)$,
		BSIZE=BUFFER[-3]$,
		BCNT=BUFFER[-2]$,
		BPTR=BUFFER[-1]$;
	MACHOP TTCALL=#051;
	BIND VECTOR BUFFER=.BUFF+3;
	LOCAL T1,T2;

	DECR PTR FROM .BSIZE TO 0 DO BUFFER[.PTR]_0;
	IF .BPTR EQL 0 THEN 
		% USE DEFAULT VALUE %
		T2_BPTR_BUFFER[0]<36,7> ELSE T2_.BPTR;

	DO
	    BEGIN
		INCHWL(T1);
		REPLACEI(BPTR, IF .BPTR<SIZEFLD> EQL 6 THEN SIXBIT(.T1) ELSE .T1);
		BSIZE_.BSIZE+1;
	    END

	UNTIL
		.T1 EQL #015 OR .BCNT GEQ .BSIZE;

	IF .T1 EQL #015 THEN INCHWL(T1) ELSE
		BEGIN
		IOERR(1);
		CLRBFI;
		CRLF(0);
		PUTMSG('*');
		GETTTY(.BUFF);
		END;
	BPTR_.T2; % RESTORE POINTER %
END;
GLOBAL ROUTINE SETSTRING(BUFFER,CODE)=
    BEGIN
	EXTERNAL ZPOS;
	LOCAL VECTOR QPROD[3];
	MACRO XBUFF=QPROD[0]$,	% BUFFER ADDRESS %
		XTRSW=QPROD[2]<0,2>$,	% TRACE SWITCH %
		XFIX=QPROD[2]<2,1>$,	% FIX SWITCH %
		XMSGX=QPROD[2]<3,1>$,	% MESSAGE SWITCH %
		XHALTS=QPROD[2]<4,1>$,	% HALT SWITCH %
		XEXPL=QPROD[2]<18,18>$,	% EXPLAIN TABLE %
		XTRAC=QPROD[1]<18,18>$,	% TRACE NAME TABLE %
		XPROD=QPROD[1]<0,18>$;	% PRODUCTIONS %
	EXTERNAL QTRSW,QFIX,QMSG,QMACH,QTRACET;
	
	XBUFF_.BUFFER;
	XTRSW_.QTRSW;
	XFIX_.QFIX;
	XEXPL_QMSG;
	XPROD_QMACH;
	XTRAC_QTRACET;
	( QPARSE(.CODE,QPROD)  OR .ZPOS^18 )
    END;

ROUTINE SETUP(BUFFER)=
    BEGIN
	IF SETSTRING(.BUFFER,1) THEN
 	    BEGIN
		RETURN SECDEFS();
		 END;
    END;
END ELUDOM