Google
 

Trailing-Edge - PDP-10 Archives - BB-H138C-BM - language-sources/dr0n.bli
There are 18 other files named dr0n.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) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME:	LODRIV.BLI
!DATE:		18 OCTOBER 73	MGM/FLD

%3.2%	GLOBAL BIND LODRV=12;	!MODULE VERSION NUMBER
!		UTILITY ROUTINES FOR BLISS
!	------------------------------------------

!
! REVISION HISTORY:
!
!    7-14-77   ROUTINE READALINE IS MODIFIED TO FIX A BUG IN
!              MULTIPLE MODULES.ANY ANYTHING FOLLOWED BY
!              ELUDOM IS DISCARDED.IF MODULE FOLLOWS ELUDOM
!              USER WILL GET AN ERROR FOR NEXT MODULE .
!  7-15-77     ROUITNE READALINE IS MODIFIED SO THAT NO EXTRA BLANK
!              IS INSERTED IN QUOTED STRING EVER MORE THAN ONE
!               SOURCE LINE.
!   6-2-77    ROUTINE EOCHAR IS MODIFIED SO THAT BLISS10 STATISTICS
!             GETS LISTED ON TTY IF LISTING DEVICE IS NOT A TTY.
!
! 1/26/77	ADDED NECESSARY CODE TO FORCELINE TO HANDLE
!		THE BLISS-36 LISTING DEMANDS.  THIS INCLUDES A NEW
!		ROUTINE LINOUT.
!
! 5-9-77       ROUTINE READALINE IS MODIFIED TO HAVE MORE THAN ONE
!              MODULE IN A FILE.THIS DOES NOT ADVANCE THE INPUT 
!              BUFFER AND POINT TO CURRENT LINE IN INPUT BUFFER.
!


! IO ROUTINES
!-------------



%3.1%	GLOBAL ROUTINE OUTPUT(DEV,CHUNK)=
    ! OUTPUT A CHUNK (ALLWORD OR CHAR) ON 'DEV', WHERE
    !    DEV= 1    BINARY DEVICE(HIGH SEGMENT)
    !         2    LISTING DEVICE
  


    BEGIN MACHOP IDPB=#136;
    IF (DEVBUF[.DEV,2]_.DEVBUF[.DEV,2]-1) LEQ 0 THEN FORCE(.DEV);
    3<0,36>_.CHUNK; IDPB(3,DEVBUF[.DEV,1])
    END;



%3.1%	GLOBAL ROUTINE OCHAR(CHAR)=
    ! OUTPUT ONE CHARACTER ON THE LISTING DEVICE
    (IF NOT .LSTFLG THEN OUTPUT(2,.CHAR);1);



%3.1%	GLOBAL ROUTINE OUTREL(ALLWORD)=
    ! OUTPUT ONE ALLWORD ON THE HIGH-SEG BINARY FILE
    ( IF NOT .BINFLG THEN OUTPUT(1,.ALLWORD);1);



%2.25%GLOBAL ROUTINE OUTPSTRING(PTR)=
%2.25%	!OUTPUT THE ASCIZ STRING STARTING AT ADDRESS .PTR
%2.25%	!TO THE LISTING DEVICE
%2.25%
%2.25%	IF NOT .LSTFLG THEN
%2.25%	BEGIN
%2.25%	  REGISTER BP,	!BYTE POINTER TO OUTPUT STRING
%2.25%		   CHAR;	!HOLDS CHAR TO BE OUTPUT
%2.25%
%2.25%	  BP_((.PTR)-1)<0,7>;	!INIT BYTE POINTER
%2.25%
%2.25%	  !OUTPUT ASCIZ STRING UNTIL NULL CHAR
%2.25%
%2.25%	  UNTIL (CHAR_SCANI(BP)) EQL 0
%2.25%	    DO OUTPUT(2,.CHAR);
%2.25%
%2.25%	END;
%3.1%	GLOBAL ROUTINE OUTSTR(STR,N)=
    IF NOT .LSTFLG THEN
    BEGIN LOCAL P; MACHOP ILDB=#134;
    ! OUTPUT A (SHORT) STRING, N CHARS L.J., ON LISTING DEVICE
    P_STR<7*.N,7>;
    INCR I FROM 1 TO .N DO OUTPUT(2,ILDB(3,P));
    .N
    END;



%3.1%	GLOBAL ROUTINE OUTSTN(I)=
    IF NOT .LSTFLG THEN
    BEGIN LOCAL P,N,C; MACHOP ILDB=#134;
    ! OUTPUT A NAME FROM THE ST, INDEX OF ENTRY IS 'I'.
    P_ST[.I,1]<1,7>; N_0;
    WHILE (C_ILDB(3,P)) NEQ #177 AND .N LSS 10 DO (OUTPUT(2,.C);N_.N+1);
    .N
    END;



%3.1%	GLOBAL ROUTINE OUTBLANK(N)=
    IF NOT .LSTFLG THEN
    BEGIN		    ! OUTPUT 'N' BLANKS ON THE LISTING DEVICE
	INCR I FROM 1 TO .N DO OUTPUT(2," ")
    END;
%3.1%   GLOBAL ROUTINE OUTMOC(ALLWORD)=
    IF NOT .LSTFLG THEN
    BEGIN LOCAL T; T_0;
    ! OUTPUT MINIMAL LENGTH OCTAL CONSTANT
    DECR I FROM 11 TO 1 DO
        IF .ALLWORD<3*.I,3> NEQ 0 THEN BREAK(T_.I);
    DECR I FROM .T TO 0 DO OUTPUT(2,"0"+.ALLWORD<3*.I,3>);
    .T+1
    END;



%3.1%	GLOBAL ROUTINE OUTCONOC(A)=

	!OUTPUT-CONCISE-OCTAL.  CALLED FOR 18BIT CONSTANTS.  PUTS THEM IN
%3.19%	!NEGATIVE FORMAT IF .A<15,3>=7.

%3.19%	IF (.A<15,3> EQL 7) THEN (OCHAR("-"); OUTMOC(-(.A OR LEFTM)) + 1)
	ELSE OUTMOC(.A);




%3.1%	GLOBAL ROUTINE NEWLINE=
    IF NOT .LSTFLG THEN
    BEGIN
    ! WRITE NEW LINE SYMBOL, HANDLE REQ'D PAGINATION.
    OCHAR(#15); OCHAR(#12);    ! IF .TTYLST THEN (OCHAR(#15); OCHAR(#15));
    IF (NLINES_.NLINES+1) GTR 56 THEN (PAGE(); NLINES_0);
    IF .TTYLST THEN FORCE(2);
    END;
! ERROR IO ROUTINES
!-------------------


%3.1%	GLOBAL ROUTINE EOCHAR(CHAR)=
    BEGIN
    ! ERROR OUTPUT (ONE CHARACTER). OUTPUT GOES TO THE LISTING
    ! DEVICE, IF THERE IS ONE, AND TO THE TTY -- IF: 1) TTY IS
    ! NOT THE LISTING DEVICE ALREADY, 2) ERROR MESSAGES TO TTY
    ! HAVE NOT BEEN SPECIFICALLY SUPRESSED.

    IF NOT .LSTFLG THEN OUTPUT(2,.CHAR);
! OUTPUT BLISS-10 STATISTICS FOR BLISS-36C ALSO   6-1-77
    IF NOT (.ERRBIT OR .TTYLST OR (.CCLCTL<2,1> AND NOT .B20FLG)) THEN TTYLIST(.CHAR);
    1
    END;


%2.25%GLOBAL ROUTINE EOUTPSTRING(PTR)=
%2.25%	!OUTPUT THE ASCIZ STRING STARTING AT ADDRESS .PTR
%2.25%
%2.25%	BEGIN
%2.25%	  REGISTER BP,	!BYTE POINTER TO OUTPUT STRING
%2.25%		   CHAR;	!HOLDS CHAR TO BE OUTPUT
%2.25%
%2.25%	  BP_((.PTR)-1)<0,7>;	!INIT BYTE POINTER
%2.25%
%2.25%	  !OUTPUT ASCIZ STRING UNTIL NULL CHAR
%2.25%
%2.25%	  UNTIL (CHAR_SCANI(BP)) EQL 0
%2.25%	    DO EOCHAR(.CHAR);
%2.25%
%2.25%	END;

%3.1%	GLOBAL ROUTINE EOUTSTR(STR,N)=
    BEGIN LOCAL P; MACHOP ILDB=#134;
    ! OUTPUT (SHORT) STRING ON ERROR DEVICE(S)
    P_STR<7*.N,7>;
    INCR I FROM 1 TO .N DO EOCHAR(ILDB(3,P));
    END;



%3.1%	GLOBAL ROUTINE EOSTN(I)=
    BEGIN LOCAL P,N,C; MACHOP ILDB=#134;
    !OUTPUT A NAME FROM THE ST. INDEX OF ENTRY 'I' ON ERROR DEVICES
    P_ST[.I,1]<1,7>; N_0;
    WHILE (C_ILDB(3,P)) NEQ #177 AND .N LSS 10 DO (EOCHAR(2,.C);N_.N+1);
    .N
    END;
ROUTINE EOUTBLANK(N)=
    BEGIN
    ! OUTPUT SPECIFIED NO. BLANKS ON ERROR DEVICE(S)
    DECR I FROM (.N - 1) TO 0 DO EOCHAR(" ");
    END;



%3.20%	GLOBAL ROUTINE OUTNUM(NUM, BASE, REQD, TOG)=
%3.20%	BEGIN	OWN	N, B, RQ, T, OUTCHAR, ANUM;
%3.20%
%3.20%		ROUTINE	OUTXNUM=
%3.20%		   BEGIN  LOCAL R;
%3.20%	
%3.20%			IF .N EQL 0 THEN
%3.20%			   (IF .RQ NEQ 0 THEN
%3.20%				(DECR I FROM (.RQ - .T - .ANUM) TO 0 DO
%3.20%				   (.OUTCHAR)(IF .B EQL 10 THEN " " ELSE "0"));
%3.20%			   RETURN 0);
%3.20%
%3.20%			R_ .N MOD .B;  N_ .N / .B;  T_ .T + 1;
%3.20%			OUTXNUM();  (.OUTCHAR)("0" + .R);
%3.20%		   END;
%3.20%
%3.20%
%3.20%	OUTCHAR_  IF .TOG THEN EOCHAR<0,0> ELSE OCHAR<0,0>;
%3.20%
%3.20%	IF .NUM LSS 0 THEN (.OUTCHAR)("-");
%3.20%
%3.20%	ANUM_  1 + ((.NUM EQL 0) AND (.BASE EQL 10));
%3.20%
%3.20%	B_ .BASE;  RQ_ .REQD;  T_ 0;  N_ ABS(.NUM);  OUTXNUM();
%3.20%
%3.20%	IF (.NUM OR ((.REQD NEQ 0) AND (.BASE NEQ 10))) EQL 0 THEN (.OUTCHAR)("0");
%3.20%
%3.20%	END;
%3.1%	GLOBAL ROUTINE ENEWLINE=
    BEGIN
    ! OUTPUT NEWLINE ON THE ERROR DEVICE(S). CHECK PAGINATION
    EOCHAR(#15); EOCHAR(#12);
    IF NOT .LSTFLG THEN
        IF (NLINES_.NLINES+1) GTR 56 THEN (PAGE(); NLINES_0);
    END;


%3.1%	GLOBAL ROUTINE EMESSAGE(N)=
    BEGIN
    ! WRITE OUT A LIST OF N ONE-FULLWORD STRINGS ON THE ERROR
    ! DEVICE(S). THE STRINGS ARE ASSUMED BELOW N ON THE
    ! STACK, AND HENCE THE CALL LOOKS LIKE:
    !
    !       EMESSAGE( -STR-,-STR-, ... ,-STR-, N )
    !                <------ N OF 'EM ------>
    !
    !
    DECR I FROM .N TO 1 DO EOUTSTR(@(N-.I),5);
    END;
%3.1%	GLOBAL ROUTINE FORCELINE(TOG)=
    BEGIN REGISTER P,C; MACHOP ILDB=#134;  EXTERNAL BXA;
%5.200.37%	EXTERNAL BGNLINETAG;
    EXTERNAL DLCNT;		! NUMBER OF DEL CHARS IN INPUT LINE.
    ! THIS ROUTINE FORCES OUT THE CURRENT INPUT BUFFER LINE
    ! IF IT IS VALID (IE, IT HASN'T BEEN PRINTED ALREADY.
    ! THE VALUE OF TOG SPECIFIES WHETHER THE LINE IS WRITTEN
    ! TO BOTH THE LISTING AND ERROR DEVICES. TOG=1 => ALSO
    ! TO THE ERROR DEVICE.

     ROUTINE LINOUT(BUFPNT,TOG)=
     ! OUTPUT A STRING OF CHARACTERS STARTING WITH THE FIRST CHARACTER
    ! IN THE WORD POINTED TO BY BUFPNT AND ENDING WITH CHARACTER
    ! #177.  IF TOG IS TRUE THIS IS AN ERROR OUTPUT.
	BEGIN
	LOCAL C,P;
	P_(.BUFPNT-1)<1,7>;
	WHILE (C _ SCANI(P)) NEQ #177 DO
	    IF .C GEQ " " OR .C EQL #11
	    THEN
		IF .TOG
		THEN
		    EOCHAR(.C)
		ELSE
		    OCHAR(.C);
	.VREG
	END;


    LOCAL PFXP,PFXCNT,PFXBUF[2];

    IF .VALIDBUF THEN
	BEGIN
	VALIDBUF _ 0;
	IF .B20FLG<0,1> AND .B20FLG<2,1> THEN
	    BEGIN
	    P _ BUFF<22,7>;	! 2ND CHAR. 1ST IS ALWAYS SPACE
	    C _ SCANN(P);
	    IF .C NEQ "!" THEN RETURN .VREG;
	    REPLACEN(P,1);
	    C _ SCANI(P);
	    IF .DLCNT GEQ 2 THEN RETURN .VREG;
	    PFXP=PFXBUF<29,7>;
	    REPLACEN(PFXP,#177);
	    PFXCNT=0;
	    IF .DLCNT EQL 0 THEN
		IF .C EQL #11
		THEN
		    WHILE .C NEQ #177 DO
			BEGIN
			REPLACEN(P,1);
			IF (C _ SCANI(P)) EQL #11
			THEN
			    EXITLOOP;
			END
		ELSE
		    BEGIN
		    WHILE .C NEQ #177 DO
			BEGIN
			REPLACEN(P,1);
			IF "A" LEQ .C AND .C LEQ "Z" THEN
			    IF .PFXCNT LSS 7 THEN
				BEGIN
				REPLACEN(PFXP,.C);
				REPLACEI(PFXP,#177);
				PFXCNT _ .PFXCNT+1;
				END;
			IF (C_SCANI(P)) EQL #11
			THEN
			    EXITLOOP;
			END;
		    END;
		END;
	IF .RPAGE THEN (PAGER(); NLINES_ 0);
	P_@@(BXA+#16)^(-1);
%2.25%		OCHAR(";");	!MAKE IT A COMMENT FOR MACRO-10
	IF .B20FLG<0,1> AND .B20FLG<2,1>
	THEN
	    LINOUT(PFXBUF,.TOG)
	ELSE
	    IF .TOG
	    THEN
		(EOUTSTR(.P,5); EOCHAR(.BGNLINETAG); EOCHAR(#11); OUTNUM(.LINCNT^(-4),10,4,1); EOUTBLANK(3))	!5.200.37 3.20
	    ELSE
		(OUTSTR(.P,5); OCHAR(.BGNLINETAG); OCHAR(#11); OUTNUM(.LINCNT^(-4),10,4,0); OUTBLANK(3));	!5.200.37 3.20
	LINOUT(BUFF,.TOG);
        IF .TOG THEN ENEWLINE() ELSE NEWLINE();
        END;
    END;


%3.12% GLOBAL ROUTINE SAVEMACSRC=IF NOT (.LSTFLG OR .TTYLST) THEN OUTPUT(2,";");
!  THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18, UNLESS SPECIFICALLY
!  OTHERWISE STATED, THAT IS THE CCO LEVEL FOR EACH LINE.


FORWARD	GIVEDIAG;


GLOBAL ROUTINE IDERROR(NUM,STE)=
BEGIN

	FORCELINE(1);  ENEWLINE();		!PRINT LINE AND BLANK
	GIVEDIAG(.NUM, 0);			!GIVE DIAGNOSTIC WITH NO <CRLF>
	EMESSAGE(";  ID",":  ",2);		!TELL WHAT WE'RE GIVING
	EOSTN(.STE);  ENEWLINE();  ENEWLINE();	!GIVE BAD ID
	WARNINGFOUND_  .WARNINGFOUND + 1;

END;



GLOBAL ROUTINE ERROUT(NUM, POSN)=
BEGIN
! 5.200.36 ...		PROVIDE LIST OF ERROR LINES
	GLOBAL HDERRLINE,ERRLINLNG;
	MACRO	EFIRSTB=HDERRLINE<18,18>$,
		ELASTB=HDERRLINE<0,18>$,
		EBLKN=CT[.ELASTB,0]<18,18>$,
		EBLK1=CT[.ELASTB,0]<0,18>$,
		EBLK2=CT[.ELASTB,1]<18,18>$,
		EBLK3=CT[.ELASTB,1]<0,18>$;


	GLOBAL ROUTINE PRNTERLNS=
		BEGIN

		ROUTINE PRNTERLNV(L16)=
			BEGIN
			BIND LNSIZE=130;
			IF .ERRLINLNG EQL 0 THEN
				(EOUTBLANK(10);ERRLINLNG_10);
			IF .ERRLINLNG GTR LNSIZE-6 THEN
				(ENEWLINE();ERRLINLNG_0;PRNTERLNV(.L16);RETURN);
			EOUTBLANK(2);OUTNUM(.L16<4,14>,10,4,1);
			ERRLINLNG_.ERRLINLNG+6;
			RETURN
			END;

		LOCAL L1;
		IF .EFIRSTB EQL 0 THEN RETURN;
		L1_.EFIRSTB;
		EFIRSTB_.ELASTB;
		ELASTB_.L1;

		ENEWLINE();ENEWLINE(); ERRLINLNG_0;
		EMESSAGE("ERROR","S AND","/OR W","ARNIN","GS ON",
		" LINE","S:   ",7);
		ENEWLINE();

		
		WHILE (.EFIRSTB NEQ .ELASTB) DO
			(PRNTERLNV(.EBLK1);
			 PRNTERLNV(.EBLK2);
			 PRNTERLNV(.EBLK3);
			 ELASTB_.EBLKN);

		PRNTERLNV(.EBLK1); IF .EBLKN EQL 1 THEN RETURN (HDERRLINE_0);
		PRNTERLNV(.EBLK2); IF .EBLKN EQL 2 THEN RETURN (HDERRLINE_0);
		PRNTERLNV(.EBLK3); RETURN (HDERRLINE_0)
		END;
	IF .ELASTB EQL 0 THEN
		(ELASTB_EFIRSTB_GETSPACE(1);
		EBLKN_1;
		EBLK1_.POSN<LEFTHALF>)
	ELSE IF .EBLKN EQL 3 THEN
		(EBLKN_GETSPACE(1);
		ELASTB_.EBLKN;	!WE NOW POINT TO THE NEW BLOCK
		EBLKN_1;
		EBLK1_.POSN<LEFTHALF>)
	ELSE 
		(EBLKN_.EBLKN+1;
		(IF .EBLKN EQL 2 THEN EBLK2 ELSE EBLK3)_.POSN<LEFTHALF>);

! ... 5.200.36

	FORCELINE(1);  SAVEMACSRC();		!PRINT BAD LINE

	IF .POSN<LEFTHALF> EQL .LINCNT
		THEN EOUTBLANK(9)
		ELSE (EOUTSTR("LINE:",5);
%3.20%		      OUTNUM(.POSN<22,14>,10,4,1));	!INFORM THE USER OF WHICH LINE WE MEAN

	EOUTBLANK(6);				!POSITION

%5.200.23%	DECR I FROM (.POSN<0,7>-2) TO 0 DO EOCHAR(".");
	EOCHAR("^");  ENEWLINE();		!POINT TO ERROR

	GIVEDIAG(.NUM, 1);  ENEWLINE();		!GIVE DIAGNOSTIC

END;



GLOBAL ROUTINE ERROR(POS, NUM)=
BEGIN

	IF NOT .ERRLEVEL THEN
		(ERROUT(.NUM, .POS);
		 CODETOG_ LABIND_ 0;
		 ERRORFOUND_ .ERRORFOUND + 1);

	0
END;



GLOBAL ROUTINE WARNEM(POS, NUM)= (ERROUT(.NUM, .POS); WARNINGFOUND_ .WARNINGFOUND + 1; 0);
!  THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18.  UNLESS SPECIFICALLY
!  OTHERWISE STATED, THAT IS THE CCO LEVEL FOR EVERY LINE.


MACRO	SKIP(OP)=(REGISTER Q; Q_ 1; (OP); Q_ 0; .Q)$;
FORWARD	ERRRELEASE;


ROUTINE GETERRFILE(DEVICE,PPN)=
BEGIN	LOCAL	OPENBLOCK[3], SJBFF;
	REGISTER	REG;
	EXTERNAL	?.JBFF;
	MACHOP	OPEN=#050,	INBUF=#064,	LOOKUP=#076;

	IF .ERROPEN THEN RETURN 1;		!RETURN IF ALREADY OPEN

	ERRDAT_ GETSPACE(#205);
	OPENBLOCK_ 0;
	OPENBLOCK[1]_ .DEVICE;
	ERRDAT<LEFTHALF>_ OPENBLOCK[2]_ ST[.ERRDAT<RIGHTHALF>,0]<0,0>;

	IF NOT SKIP(OPEN(4,OPENBLOCK<0,0>)) THEN
		RETURN (ERRRELEASE(); 0);

	SJBFF_ .?.JBFF;  ?.JBFF_ .ERRDAT<LEFTHALF>+3;
	INBUF(4,1);  ?.JBFF_ .SJBFF;

	ERRFILE[3]_ .PPN;

	IF NOT SKIP(LOOKUP(4,ERRFILE<0,0>)) THEN
		RETURN (ERRRELEASE(); 0);

	ERROPEN_ 1
END;


ROUTINE ERRRELEASE=(RELEASESPACE(.ERRDAT<RIGHTHALF>,#205); ERROPEN_ 0);


ROUTINE INERRCHAR=
BEGIN	MACHOP	IN=#056,	STATZ=#063;

	IF ((.ERRDAT<LEFTHALF>)[2]_ .(.ERRDAT<LEFTHALF>)[2] - 1) LEQ 0 THEN

		IF SKIP(IN(4)) THEN
			IF SKIP(STATZ(4,#740000)) THEN RETURN 0;

	SCANI((.ERRDAT<LEFTHALF>)[1])
END;
!  THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18. SEE COMMENTS ON
!  THE PRECEEDING PAGES.


GLOBAL ROUTINE GIVERRDIAG(DISP, HEAD)=
BEGIN	LOCAL	TEMP, VALUE, NOTDONE;
	REGISTER	PTR;
	MACHOP	USETI=#074;
	LABEL	DIAGLOP;

	USETI(4, .ERRTABLE[.DISP]<0,12>);

	NOTDONE_ 1;

	WHILE .NOTDONE DO

	(PTR_ HEAD<36,7>;

		(VALUE_ DIAGLOP: DECR I FROM 3 TO 0 DO

			(IF (IF (TEMP_ INERRCHAR()) EQL 0
				 THEN RETURN 0
			 	 ELSE .TEMP) NEQ SCANI(PTR)
			     THEN LEAVE DIAGLOP WITH 0);

		NOTDONE_ .VALUE + 1));

	DECR I FROM 7 TO 0 DO INERRCHAR();	!SCAN PAST PARAMETERS

	UNTIL (TEMP_ INERRCHAR()) EQL #15 DO EOCHAR(.TEMP);	!GIVE DIAGNOSTIC


	1
END;
!  THE COMMENTS ON THE PRECEEDING PAGES CONCERNING CCO 3.18 REFER TO
!  THIS PAGE TOO.



GLOBAL ROUTINE GIVEDIAG(NUM, CRLFFLAG)=
BEGIN	LOCAL	TYPE;

	SAVEMACSRC();				! MAKE A COMMENT OF THE MESSAGE

	EOCHAR(IF (TYPE_ IF (TYPE_ .ERRTABLE[.NUM]<12,2>) EQL 0
		THEN "%"
		ELSE IF .TYPE EQL 1 THEN "??" ELSE "@") EQL "@" THEN "??" ELSE .TYPE);	!MESSAGE TYPE

	EOUTSTR("BLS",3);			! COMPILER ID

	EOUTSTR(.ERRTABLE[.NUM]<15,21>, 3);	! MNEMONIC

	IF .NOENGLISH THEN
		RETURN (IF .CRLFFLAG THEN ENEWLINE());	! DONE IF ONLY MNEMONIC

	EOCHAR(#11);				! TAB

%3.31%	IF .COREGONE THEN
%3.24%		RETURN (EMESSAGE("The c","ompil","er is"," unab","le to",
%3.24%				 " acqu","ire a","dditi","onal ","core",10);
%3.24%			ENEWLINE());

	IF NOT GETERRFILE(.ERRDEV,.ERRPPN) THEN		! CAN'T LOCATE CORRECT .ERR FILE
	    IF NOT GETERRFILE(SIXBIT'SYS',0) THEN		! CHECK SYS
		RETURN (ENEWLINE();  SAVEMACSRC();
			EMESSAGE("%BLSN","ER Ca","nnot ","acces","s .ER",
				 "R fil","e", 7); ENEWLINE());	! HACK MESSAGE

	IF NOT GIVERRDIAG(.NUM, .TYPE^29 + (.ERRTABLE[.NUM]<15,21>^8))
		THEN (ENEWLINE();  SAVEMACSRC();
		      EMESSAGE("%BLSN","MS Ca","nnot ","find ","appro",
			       "priat","e mes","sage",8); ENEWLINE());

	IF .CRLFFLAG THEN ENEWLINE();

END;
! LOGICAL (?) IO ROUTINES
!-------------------------

%3.1%	GLOBAL ROUTINE READALINE=
    BEGIN LOCAL L1;
%5.200.37%	GLOBAL EOLCONTEXT,BGNLINETAG;
%  THE FOLLOWING LINE HAS THIS PURPOSE.IF TRUE, IT
   JUST FINISHED PROCESSING ONE MODULE FROM A FILE.IT IS READY
   TO PROCESS NEXT MODULE.IF FALSE IGNORE IT.DRIVER ROUTINE
   SETS IT AND REINIT ROUTINE USES IT.  
   THERE MAY BE MORE THAN ONE MODULE IN A FILE.
   THERE IS ALREADY AN INPUT LINE IN THE BUFFER AND DONOT READ NEXT LINE.
%
%3-24-77%       EXTERNAL NOMOREINPUT; !TRUE MEANS JUST FINISHED ONE MODULE
!5.200.37	EOLCONTEXT IS TOP_OF_STACK OF CHAR DESCRIBING LEXICAL (OR OTHER ) STATE:
!5.200.37		"%" FOR INSIDE %-COMMENT
!5.200.37		"M" FOR INSIDE MACRO DEFINITION
!5.200.37		"S" FOR INSIDE STRING ("..", '...')
!5.200.37		"*" FOR INSIDE CODE NOT COMPILED DUE TO LITERAL TEST IN IF*THEN*ELSE
!5.200.37	(THESE ARE NOT ALL IMPLEMENTED: MARCH 1, 1976)

    ! READ THE NEXT INPUT LINE INTO 'BUFF', PRINTING THE PREVIOUS
    ! LINE IF THIS HAS NOT ALREADY BEEN DONE (EG., BY AN ERROR
    ! MESSAGE. A LINE NUMBER IS ASSIGNED TO THE INPUT LINE AND
    ! A RECORD OF THIS IS PLACED IN THE CODE STRING.
    FORCELINE(0); VALIDBUF_1; LINCNT_.LINCNT+16;
%5.200.37%	BGNLINETAG_.EOLCONTEXT;	!EOLCONTEXT WILL BE RESET, IF NECESSARY, ELSEWHERE.
%5.200.37%	IF .BGNLINETAG EQL 0 THEN IF NOT .CODETOG THEN
%5.200.37%	BGNLINETAG_"*";	!INSIDE NON-COMPILING CODE
    IF .CT[.CT[.CODEPTR,1]<PREVF>,1]<LEFTHALF> NEQ 0
	THEN BEGIN
	     CT[L1_GETSPACE(1),1]_.LINCNT;
	     PUSHBOT(.CODEPTR,.L1);
             END;
      IF .NOMOREINPUT  THEN NOMOREINPUT_0 %RESET IT AND GO % 
            ELSE
           IF READTEXT() THEN RECOVER (.LINCNT^18,ERILTL);	!IF 1 INPUT LINE IS LONGER THAN 135 CHARS
    IF .FINFLG THEN ( BUFF_'END);'; BUFF+1_'$;%"'''; BUFF+2_#067777777777 );
    IF .BUFF 
	THEN (PBUFF_IF .EOLCONTEXT EQL "S" THEN (BUFF+1)<29,7> ELSE BUFF<1,7>; NCBUFF_5+.LINCNT^18)
	ELSE (PBUFF_IF .EOLCONTEXT EQL "S" THEN BUFF<29,7> ELSE (BUFF-1)<1,7>; NCBUFF_0+.LINCNT^18);
    END;







!END OF LODRIV.BLI