Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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) DIGITAL EQUIPMENT CORPORATION 1976, 1983
! 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