Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/scnr.bli
There are 12 other files named scnr.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

! Author: *

MODULE SCNR=
BEGIN

GLOBAL BIND SCNRV = #11^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