Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/listng.bli
There are 26 other files named listng.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) 1973,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: D. B. TOLMAN/DCE/SJW/RDH/TFV/EGM

MODULE LISTNG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LISTNG%

GLOBAL BIND LISTNV = 6^24 + 0^18 + 26;	! Version Date:	28-Sep-81

%(

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

1	-----	-----	ADD CODE TO INSTAT TO HANDLE THE
			COMPIL "+" CONSTRUCT.

			ADD CODE TO GETBUF,EOPRESTORE,EOPSAVE TO ALOW THE INCLUDE STATEMENT TO WORK

2	-----	-----	IT IS ALWAYS NICE TO TELL THE MOINTOR WHEN
			YOU ARE GRABBING UP MORE CORE - EOPRESTORE

3	-----	-----	FIX SHIFTPOOL SO IT WON'T GO BANANAS IF THE
			BEGINNING OF THE STATEMENT IS AT THE BEGINNING
			OF POOL ALREADY.

			FIX BUG IN THE HEADING - PAGEHEADER

4	-----	-----	ADD NEW DEBUG SWITCH OUTPUT TO HEADING

5	-----	-----	CHANGE INSTAT AND EOPRESTORE TO USE THE BUFFER
			CORE REQUIREMENTS (BGSTBF) THAT WERE CALCULATED
			IN COMMAN.  FOR THE INCLUDE STATEMENT - SINCE
			IT ONLY USES DSK WE CAN ASSUME THAT THE BUFFER
			SIZES WILL NOT CHANGE FROM FILE TO FILE - SO
			DON'T HAVE TO WORRY ABOUT ALLOCATING XTRA CORE

			FIX PRINT SO THAT WHEN IT INSERTS A CR ( IE. NOCR
			IS SET ) THAT IT INSERTS IT BEFORE THE LINE
			TERMINATOR.  THIS IS FOR THE OLD WORLD PRINTERS
			THAT PRINT WHEN THEY SEE A CR

6	-----	-----	CHANGE CALLS TO ERROR - SOME OF  ITS MESSAGES WERE 
			DELETED

7	-----	-----	SET ERRFLAG IN PRINT WHEN ERLSTR IS CALLED
			IT WAS SUPPOSED TO BE SET BY BACKTYPE BUT
			BACKTYPE DOES NOT GET CALLED IF THE LISTING
			IS GOING TO THE TTY: .  NOTHING BAD HAPPENED
			EXCEPT LEXICA THOUGHT THINGS WERE INCONSISTANT
			AND SAID SO...

			CHANGE ALL INUUOS TO USE SKIP MACROS

8	-----	-----	ADD FTTENEX I/O CODE

9	-----	-----	FIX FTTENEX CODE
10	342	17876	FIX NUMEROUS BUGS FOR UNCLASSIFIABLE STATEMENT
			(VERY LONG ONES), (DCE)
11	351		MAKE THE LAST PATCH WORK, (DCE)
12	422	18493	IMBEDDED NULLS (MANY) CAUSE LOOPING
			PREVENT THIS, AND CHANGE MESSAGE, (DCE)
13	467	VER5	REQUIRE FTTENX.REQ, SJW
14	506	10056	FIX FILES WITH LINE SEQUENCE NUMBERS
			WHICH OCCUR AT BUFFER BOUNDARIES, (DCE)

***** Begin Version 5A *****

15	537	21811	LEXEME SPLIT ACROSS LINES GIVES BAD ERROR MSG, (DCE)
16	541	-----	-20 ONLY: CLEAR LASTCHARACTER IN READTXT AFTER
			  ^Z SEEN SO MORE TTY: INPUT MAY BE DONE, (SJW)
17	556	-----	PUT /L IN HEADER IF LINE NUMBER/OCTAL MAP REQUESTED,
			(DCE)
18	561	10429	PAGE MARKS SHOULD BE IGNORED DURING CONTINUATION
			LINE PROCESSING, (DCE)
19	621	QAR2120	MODIFY EDIT 561 IN CASE PAGE MARK ENDS FILE., (DCE)
20	667	25664	ONE MORE TIME FOR PAGE MARKS - IF NULL WORD
			FOLLOWS IT (END OF BUFFER), (DCE)

***** Begin Version 5B *****

21	677	25573	PRINT A P IF PARAMETER OPTION SPECIFIED, (DCE)

***** Begin Version 6 *****

22	750	TFV	1-Jan-80	------
	Remove Debug:Parameters (edit 677)

23	761	TFV	1-Mar-80	------
	Print /GFL if specified

24	767	DCE	20-May-80	-----
	Add /F77 (future usage) to listing

25	1047	EGM	22-Jan-81	Q10-05325
	Add support for TOPS-10 execute only.

26	1133	TFV	28-Sep-81	------
	Add /STatistics to listing.  It is disabled in the released V6.

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

)%

REQUIRE  FTTENX.REQ;
SWITCHES NOLIST;
REQUIRE LEXAID.BLI;
SWITCHES LIST;
EXTERNAL E112;	!ERROR POINTER
EXTERNAL FATLEX,JOBREL,JOBFF;
EXTERNAL DIGITS,FNDFF;
EXTERNAL  LINEOUT,CHAROUT,ERRLINK,SAVSPACE,STRNGOUT;
EXTERNAL NAME,CORMAN,MSGNOTYPD,ERRMSG,NUMFATL,NUMWARN,WARNOPT;
EXTERNAL NOCR,PAGE;
EXTERNAL FATLERR,WARNERR,BLDMSG,HEADING,STRNG6,STRNG7,ERROR;
EXTERNAL MSNGTIC; !NEED ACCESS WHEN RETURNING BOGUS CHARACTER

REQUIRE  IOFLG.BLI;		! IO AND FLGREG DEFINITIONS

FORWARD BACKTYPE,SINPUT,READTXT,CHK4MORE;
MACRO FULL = 0,36  $;


OWN  BTPTR;	! POINTER FOR BACK TYPE WHICH CONTAINS THE BYTE
		! POSTION OF THE NEXT PORTION OF THE STATEMENT
		! IN ERROR,  TO BE TYPED
EXTERNAL ARINGLEFT; !USED FOR HANDLING BUFFERS CORRECTLY

MACRO SKIP(OP)=
BEGIN
	MACHOP SETZ=#400, SETO=#474;
	SETO(VREG,0);
	OP;
	SETZ(VREG,0);
	.VREG
END$;



	GLOBAL ROUTINE 
DECREMENT (PTR) =  ! DECREMENT BYTE POINTER PTR
BEGIN
		% PTR CONTAINS A POINTER TO A BYTE POINTER %
		STRUCTURE  IND[P,S] = (@.IND)<.P,.S>;
		MAP  IND  PTR;

		IF  (VREG _ .PTR[PFLD] + .PTR[SFLD] )   EQL  36
		THEN	( PTR[PFLD] _ 1;
			  PTR[RIGHT] _ .PTR[RIGHT] - 1  
			)
		ELSE	  PTR[PFLD] _ .VREG
		;
END;	%DECREMENT POINTER %


		FORWARD GETBUF,SHIFTPOOL,OVRESTORE,OVERFLOW;

GLOBAL ROUTINE

LINESEQNO  ( PTRPTR )  =

	% .PTRPTR CONTAINS THE ADDRESS OF A BYTE POINTER %
	% DECODE THE LINESEQUENCE NUMBER POINTED TO BY ..PTRPTR AND RETURN IT
	  NOTE THAT ..PTRPTR IS UPDATED IN THE PROCESS   %
	% THE FOLLOWING TAB IF AY IS SKIPPED %

BEGIN
	LOCAL LINESAVE;
%[667]%	EXTERNAL INCLAS;
	REGISTER T1;
	VREG _ 0;
	(@PTRPTR)<LEFT> _ #440700;	! SET BYTEPOINTER TO BEGINNING OF THE WORD
	DECR  N FROM  4 TO 0  DO
	BEGIN
		IF ( T1 _ SCANI ( @PTRPTR ) - "0" ) LSS  0  OR  .T1  GTR  9
		THEN
		BEGIN
			IF .T1 NEQ  ( " " - "0" )
			THEN	WARNERR(.LINELINE,E112<0,0>);
			T1 _ 0
		END;
		VREG _ .VREG * 10  +.T1
	END;
	
	!BE SURE THAT THE TAB FOLLOWING THE LINE SEQUENCE NUMBER DOES NOT
	! OCCUR IN THE NEXT BUFFER IN WHICH CASE WE HAVE TO
	! GO THROUGH ALL KINDS OF CONTORTIONS HERE
	! TO GET THE BUFFERS SET UP RIGHT AND THE TAB SKIPPED.
	LINESAVE_.VREG;
	T1_SCANI(@PTRPTR);
	IF .T1 EQL #177	!END OF BUFFER CHARACTER?
		THEN IF CURWORD EQL .CURPOOLEND	!REALLY BUFFER END?
			THEN IF (T1_GETBUF()) EQL OVRFLO
			  THEN(SHIFTPOOL();
				IF (T1_OVRESTORE()) EQL OVRFLO
					THEN T1_OVERFLOW(0,0)
				);
	! NOW WE HAVE THE REAL NEXT CHAR IN T1
!WE HAVE JUST SCANNED PAST A LINE SEQUENCE NUMBER, AND NOW ARE
! LOOKING FOR A POTENTIAL TAB.  IT IS POSSIBLE THAT THE LINE
! SEQUENCE NUMBER WAS REALLY PART OF A PAGE MARK IN WHICH CASE
! THE NEXT WORD IS A CARRIAGE RETURN, FORM FEED, NUL, NUL, NUL.
! IF THIS IS THE CASE, SCAN PAST THIS ENTIRE WORD, PUTTING OUT
! A NEW PAGE HEADER AS WE GO, AND LOOK FOR THE NEXT LINE SEQUENCE
! NUMBER INSTEAD OF THE ZERO ONE WHICH WE HAVE JUST SEEN.
	IF .T1 NEQ "	"
	THEN
		IF (@@@PTRPTR EQL #643^#30 AND .LINESAVE EQL 0) THEN
			BEGIN ! A PAGE MARK HAS BEEN SEEN
				(@PTRPTR)<RIGHT>_@@PTRPTR+1;
				(@PTRPTR)<LEFT>_#440700;
				FNDFF_1;
![667] CATCH ALL THE FUNNY CASES WHERE PAGE MARKS PRESENT:
![667] 	1. NULL WORD FOLLOWS (END OF BUFFER FROM SOS)
![667]	2. END OF BUFFER ITSELF (NEED TO GET NEXT BUFFER)
![667]	3. END OF FILE 
![667]	4. FINALLY MAY GET THE "REAL" LINE SEQUENCE NUMBER!
%[667]%				IF .FLGREG<LISTING> AND NOT .INCLAS THEN (CHAROUT(FF); HEADING());
%[667]%				WHILE @@@PTRPTR EQL 0 DO
%[667]%					(@PTRPTR)<RIGHT>_@@PTRPTR+1;
%[667]%				IF SCANI(@PTRPTR) EQL #177
%[667]%				THEN IF CURWORD EQL .CURPOOLEND	!REALLY BUFFER END?
%[667]%				THEN IF (T1_GETBUF()) EQL OVRFLO
%[667]%				  THEN(SHIFTPOOL();
%[667]%					IF (T1_OVRESTORE()) EQL OVRFLO
%[667]%						THEN T1_OVERFLOW(0,0)
%[667]%					);
%[667]%				(@PTRPTR)<LEFT>_#440700;
				!BEFORE RECURSION, CHECK LINE SEQUENCE BIT
				! (MAY BE AT END OF FILE).
				IF @@@PTRPTR THEN RETURN LINESEQNO(@PTRPTR); ! GET REAL LSN
			END
			ELSE DECREMENT(@PTRPTR);

	RETURN .LINESAVE ;
END; % LINESEQNO  %


	MACHOP CALLI=#047,ROTC=#245,MOVEI=#201,HLLZ=#510;
	MACHOP ROT=#241,HLRZ=#554,HRLZ=#514;
	BIND JOBVER=#137;
	EXTERNAL  HEADSTR,BASENO,HEADPTR,PAGEPTR;

	MACRO  NXT(C) =  REPLACEI ( HEADPTR, C ) $;



	GLOBAL ROUTINE 
PAGEHEADER =
BEGIN
	REGISTER T[2];
!------------------------------------------------------------------------------------------------------------------
!	PROGRAM NAME - LEAVE 6 CHARACTERS
!------------------------------------------------------------------------------------------------------------------
	HEADPTR _ HEADSTR[1]<29,7>;
!------------------------------------------------------------------------------------------------------------------
!	FILENAME - NOT NECESSARY
!------------------------------------------------------------------------------------------------------------------
	NXT("	");
	IF (T[1]_@FILENAME(SRC)) NEQ 0 THEN
	BEGIN
		STRNG6( .T[1] );
		IF HLLZ(T[1],EXTENSION(SRC)) NEQ 0 THEN
		BEGIN
			NXT(".");
			STRNG6( .T[1] );
		END
	END;
	NXT("	");
	STRNG7('FORTR');STRNG7('AN V.');
!------------------------------------------------------------------------------------------------------------------
!	VERSION - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
	T[0]_@JOBVER;T[1]_0;
	BASENO _ 8;
	ROT(T[0],3);ROTC(T[0],9);DIGITS(.T[1]);T[1]_0;
	ROTC(T[0],6);
	IF .T[1] NEQ 0 THEN NXT( .T[1] + "@" );
	IF HLRZ(T[1],T[0]) NEQ 0 THEN (NXT("(");DIGITS(.T[1]);NXT(")"); T[1]_0);
	HRLZ(T[0],T[0]);ROTC(T[0],3);
	IF .T[1] NEQ 0 THEN (NXT("-");DIGITS(.T[1]));

	!
	!SET IN KA OR KI VERSION AND /OPT IF OPTIMIZED
	!
	![767] PRINT /G OR /F77 IF APPROPRIATE

	IF .F2<GFL> THEN STRNG7('/G');		![767]
%1133%	IF .F2<STA> THEN STRNG7('/ST');		! Statistics
	IF F77 THEN STRNG7('/F77');![767]
	IF .FLGREG<OPTIMIZE> THEN STRNG7( '/OPT');
	IF .FLGREG<NOWARNING> THEN STRNG7('/NOWA');
	IF .FLGREG<CROSSREF> THEN STRNG7('/C');
%1133%	IF .FLGREG<SYNONLY> THEN STRNG7('/SY');
	IF .FLGREG<INCLUDE> THEN STRNG7('/I');
	IF .FLGREG<MACROCODE> THEN STRNG7('/M');
	IF .FLGREG<EXPAND> THEN STRNG7('/E');
	IF .FLGREG<NOERRORS> THEN STRNG7('/NOER');
	!ADD /L TO PAGE HEADERS IF LINE NUMBER/OCTAL MAP REQUESTED
	IF .FLGREG<MAPFLG> THEN STRNG7('/L');
	BEGIN	%CHECK DEBUG FLAGS%
		BIND	DEBUGFLGS =
					% FLGREG BIT POSITIONS FOR THE VARIOUS MODIFIERS%
					1^DBGDIMNBR +
					1^DBGINDXBR +
					1^DBGLABLBR +
					1^DBGTRACBR +
					1^DBGBOUNBR     ;
		IF ( DEBUGFLGS  AND  .FLGREG<FULL> )  NEQ  0
		THEN
		BEGIN
			STRNG7('/D:(');
			IF .FLGREG<BOUNDS>  THEN  NXT("B");
			IF .FLGREG<DBGTRAC>	THEN  NXT("T");
			IF .FLGREG<DBGLABL>  THEN  NXT("L");
			IF .FLGREG<DBGDIMN>   THEN   NXT("D");
			IF .FLGREG<DBGINDX>   THEN   NXT("I");
			NXT(")")
		END
	END;
!------------------------------------------------------------------------------------------------------------------
!	DATE - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
	NXT("	");
	BASENO _ 10;
	T[1]_(CALLI(T[0],#14) MOD 31)+1;DIGITS(.T[1]);
	T[1]_@(PLIT('-JAN-','-FEB-','-MAR-','-APR-','-MAY-','-JUN-',
		  '-JUL-','-AUG-','-SEP-','-OCT-','-NOV-','-DEC-')
		+(T[0]_.T[0]/31) MOD 12);
	STRNG7(.T[1]);
	T[1]_.T[0]/12 +64;DIGITS(.T[1]); NXT("	");
!------------------------------------------------------------------------------------------------------------------
!	TIME - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
	T[1]_CALLI(T[0],#23)/3600000;DIGITS(.T[1]); NXT(":");
	T[1]_(T[0]_.T[0] MOD 3600000)/60000;IF.T[1] LSS 10 THEN NXT("0");DIGITS(.T[1]);
!------------------------------------------------------------------------------------------------------------------
!	PAGE
!------------------------------------------------------------------------------------------------------------------
	STRNG7('	PAGE'); NXT(" ");
	PAGEPTR _ .HEADPTR;	! SAVE PAGE NUMBER POINTER
	.VREG
END;






	MACRO IOIMPM=17,1$,IODERR=16,1$,IODTER=15,1$,IOBKTL=14,1$,IODEND=13,1$;
	MACRO  RINGHDR = (.BUFPNT(SRC + .FLGREG<ININCLUD>)<RIGHT>)   $;
	MACRO  RINGLENGTH = IF NOT FTTENEX 
		THEN  .(RINGHDR )<RIGHT>   
		ELSE  .XWORDCNT(SRC+.FLGREG<ININCLUD>) $;
	MACRO  RINGSTART = IF NOT FTTENEX
		THEN  (RINGHDR +1)   
		ELSE  (.BUFFERS(SRC+.FLGREG<ININCLUD>)) $;
	OWN	LASTCHARACTER;


GLOBAL ROUTINE INSTAT   =
% CHECK THE STATUS OF THE SOURECE INPUT DEVICE AND TERMINATE IF
  ERROR  OR RETURN  EOF IF EOF  %
BEGIN
IF NOT FTTENEX THEN
	BEGIN
		MACHOP GETSTS=#062;
		REGISTER T1;
		IF .FLGREG<ININCLUD>  
		THEN   GETSTS(ICL,T1)
		ELSE	GETSTS(SRC,T1);
		IF .T1<IODEND> THEN
		BEGIN
			% CHECK HERE FOR MULTIPLE FILES AND END OF INCLUDE%
			IF NOT .FLGREG<EOCS>	!END OF COMMAND STRING
			THEN
			BEGIN
				%GET THE NEXT FILE%
				EXTERNAL JOBFF,FFBUFSAV;
				REGISTER SV;
%[1047]%			EXTERNAL XNXFILG;
				LABEL  CHK;
				MACHOP  INUUO = #056;

%[1047]% 			XNXFILG();
				%SEE IF WE GOT ANYTHING%
				IF .FLGREG<ENDFILE> THEN RETURN EOF;
							%NO MORE FILES%

				% SET .JBFF BACK SO THE BUFFERS WILL BE
				 ALLOCATED IN THE SAME PLACE AS THE LAST ONES
				 AND NOT GET DESTROYED BY LATER PASSES %
				SV _ .JOBFF;
				JOBFF _ .FFBUFSAV;

				IF SKIP( INUUO(SRC,0)) NEQ 0
				THEN BEGIN
					IF INSTAT()  EQL  EOF
					THEN
					BEGIN
						%NOTHING%
						FLGREG<ENDFILE> _ 1;
						JOBFF _ .SV;
						RETURN EOF;
					END;
				END;

				%JUST CHECK TO MAKE SURE THAT EVERYTHING 
				 IS OK  %
				BEGIN
					EXTERNAL  BGSTBF;	!MAX BUF SIZE
					IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
					THEN	( EXTERNAL E61,LASTLINE,FATLERR;
						   FATLERR(.LASTLINE,PLIT'INSTAT',E61<0,0>)
						)
				END;

				JOBFF _ .SV;
				PAGEHEADER();	!CHANGE THE FILE NAME IN THE HEADING
				RETURN 1;	!GOT SOMETHING
			END
			ELSE
			BEGIN
				FLGREG<ENDFILE>_1;
				RETURN EOF
			END
		END

		ELSE
		IF .T1<IOIMPM> THEN ERROR(0,SRC)
		ELSE
			IF .T1<IODERR> THEN ERROR(1,SRC)
			ELSE
				IF .T1<IODTER> THEN ERROR(2,SRC)
				ELSE
					IF .T1<IOBKTL> THEN ERROR(3,SRC);
	RETURN  1
	END   ;
END;

ROUTINE  TRANSFRING  =
BEGIN
REGISTER T1,T2;
MACHOP  BLT = #251;
	% TRANSFER THE CURRENT RING BUFFER AND RETURN NEXT CHARACTER %
	% IS THERE ENOUGH ROOM LEFT IN POOL FOR NEXT BUFFER %
	% CONSISTANCY CHECK %
	IF CURWORD NEQ .CURPOOLEND<RIGHT>
	THEN INTERR('TRANSFRING');

	VREG _  RINGLENGTH;
	T2 _ .CURPOOLEND<RIGHT>  +  .VREG ;
	!SET ARINGLEFT TO INDICATE PARTIAL BUFFER IS LEFT
	IF  .T2  GTR  POOLEND-1   THEN (ARINGLEFT_1;  RETURN  OVRFLO)  ;
	% THERE IS ENOUGH SPACE LEFT SO TRANSFER THE NEXT BUFFER %
	VREG _ RINGSTART;
	T1 _  .VREG^18  +  .CURPOOLEND<RIGHT>  ;
	BLT(T1,-1,T2)  ;
	(@T2)<FULL>	_  ENDBUFLAG  ;  % BUFFER TERMINATION FLAG  %
	CURPOOLEND _ .T2  ;
	!RESET ARINGLEFT TO ALLOW NORMAL BUFFERING
	ARINGLEFT_0;
	RETURN  ..CURPTR  ;  % NEXT CHARACTER  %
END  ;   % END OF TRANSFRING  %
	GLOBAL ROUTINE
CHK4MORE   =
BEGIN
IF FTTENEX THEN
BEGIN
	%SEE IF THERE ARE MORE INPUT FILES TO CONCATENATE %
	IF NOT .FLGREG<EOCS>
	THEN
	BEGIN
		%MIGHT BE%
%[1047]%	EXTERNAL XNXFILG;

%[1047]%	XNXFILG();
		IF .FLGREG<ENDFILE> THEN RETURN EOF;

		IF SINPUT(SRC)  EQL  EOF  THEN RETURN .VREG;
		PAGEHEADER();
		RETURN 1	!GOT SOMETHING
	END
	ELSE
	BEGIN
		FLGREG<ENDFILE> _ -1;
		RETURN  EOF	!NO MORE INPUT
	END
END
END;	%CHK4MORE%



	GLOBAL ROUTINE
SINPUT ( DEV )  =
BEGIN
IF FTTENEX THEN
BEGIN

	LOCAL VAL;
	REGISTER  R1=1,R2=2,R3=3;
	MACHOP	JSYS = #104 , JRST = #254 ;
	MACRO	SIN = JSYS(0,#52) $,
		GTSTS = JSYS(0,#24) $;
	LOCAL RSV[3];

	%GET  A BUFFER FULL OF INPUT %

	RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3;

	%TTY IS DONE A LITTLE DIFFERENTLY%
	IF .FLAGS2<TTYINPUT>
	THEN	VAL _ 	READTXT()
	ELSE
	BEGIN
		%SOME OTHER DEVICE%
		EXTERNAL CLOSUP;
		MACRO EOFBIT = 27,1 $;

		R1 _ .XDEVJFN(.DEV);
		R2 _ ( .BUFFERS(.DEV))<36,36> ;
		R3 _ -XSINSIZ ;

		SIN;	!GET SOME

		IF ( XWORDCNT(.DEV) _ .R3  + XSINSIZ ) EQL  0
		THEN
		BEGIN
			%DIDN'T GET ANYTHING  ???%
			R1 _ .XDEVJFN(.DEV);
			GTSTS;
			IF .R2<EOFBIT>
			THEN	VAL _  CHK4MORE()
			ELSE	( EXTERNAL JOBSA;
				   INTERR ('SINPUT');
				  CLOSUP();
				  JRST (0,.JOBSA<0,18>)
				)
		END
		ELSE	VAL _ 1;
	END;

	R1 _ .RSV[0]; R2 _ .RSV[1]; R3 _ .RSV[2];
	RETURN .VAL

END
END;	%SINPUT%


	GLOBAL ROUTINE
READTXT  =
BEGIN
IF FTTENEX THEN
BEGIN

	%READ TTY INPUT - SRC ONLY %

	REGISTER R1=1,R2=2,R3=3;
	MACHOP  JSYS = #104;
	MACRO  RDTXT = JSYS (0,#505) $;
	BIND  RDTOP = 34,	!TOPS-10 BREAK CHARACTERS
		RDJFN = 29;	!USE JFN

	%FIRST CHECK FOR END OF FILE%
	IF .LASTCHARACTER  EQL  "?Z"
	! -20 ONLY: CLEAR LASTCHARACTER AFTER ^Z SO MORE TTY: INPUT MAY BE DONE
	  THEN BEGIN
	    LASTCHARACTER _ 0;
	    RETURN CHK4MORE ();
	  END;

	R1 _  .XDEVJFN(SRC);
	R1<LEFT> _ .XDEVJFN(SRC);
	R2 _ (.BUFFERS(SRC)<RIGHT>)<36,7>;
	R3 _ 1^RDTOP + 1^RDJFN;	!TOPS 10 BREAK
	R3<RIGHT> _ XSINSIZ*5;	!BYTE COUNT

	IF SKIP(RDTXT) EQL 0
	THEN
	BEGIN
		EXTERNAL FATLERR,E61,CLOSUP,JOBSA;
		MACHOP JRST = #254;

		FATLERR( PLIT'RDTXT',.LINELINE-1,E61<0,0>);
		CLOSUP();
		JRST(0,.JOBSA<0,18>)	!HALT
	END;

	LASTCHARACTER _ ..R2;	!SAVE LAST CHARACTER FOR EOF CHECK
	%ZERO FILL%
	(.R2<RIGHT>)<0,.R2<30,6>> _ 0;

	XWORDCNT(SRC) _ .R2<RIGHT> - .BUFFERS(SRC) + 1;
	RETURN 1;
END
END;	%READTXT%
	GLOBAL ROUTINE
GETBUF   =
BEGIN
% READS IN THE NEXT RECORD OF THE INPUT FILE AND TRANSFERS IT
  TO POOL.  IF END OF FILE IT WILL RETURN EOF.  IF NOT ENOUGH ROOM
  IN POOL IT WILL RETURN OVRFLO.   %

EXTERNAL  ENTRY;
	MACHOP INUUO=#056,BLT=#251;
	LABEL  CHK,CHK1;
	IF  .FLGREG<ENDFILE>  THEN  RETURN  EOF;	!CHECK FOR EOF
	!CHECK FOR PARTIAL BUFFER STILL LEFT AND GO GET IT
	IF .ARINGLEFT NEQ 0 THEN RETURN TRANSFRING();

	IF NOT FTTENEX
	THEN
	BEGIN

	IF .FLGREG<ININCLUD>
	THEN
	BEGIN
		IF SKIP( INUUO(ICL,0)) NEQ 0
		THEN BEGIN
	
			VREG_0;
			IF INSTAT()  EQL  EOF  THEN  RETURN  .VREG
	
		END;  %CHK%
	END
	ELSE
	BEGIN
		IF SKIP( INUUO(SRC,0)) NEQ 0
		THEN BEGIN
	
			IF INSTAT()  EQL  EOF  THEN  RETURN  .VREG
	
		END;  %CHK%
	END;
	
	END
	ELSE
	BEGIN

		IF SINPUT(  IF .FLGREG<ININCLUD>
			    THEN	ICL
			    ELSE	SRC	)
		   EQL  EOF	THEN	RETURN .VREG
	END;

	% NO ERRORS OR EOF CONDITION DETECTED  %

	RETURN TRANSFRING()   % TRANSFER THE RING BUFFER AND RETRUN NEXT CHARACTER %

END;


GLOBAL ROUTINE OVRESTORE    =
BEGIN

% OVRESTORE WILL TRANSFER THE CURRENT RING BUFFER AREA TO THE INTERNAL 
STATEMENT BUFFER (POOL) WITHOUT DOING AN INUUO.  IT IS USED TO
CONTINUE PROCESSING AFTER AN INTERNAL STATEMENT BUFFER OVERFLOW,
WHICH WOULD HAVE PERFORMED AND INUUO BUT NOT TRANSFERED THE RING
BUFFER.
%
EXTERNAL  ENTRY;

	RETURN TRANSFRING()   % TRANSFER THE RING BUFFER AND RETURN NEXT CHARACTER  %

END ;  % OVRESTORE %

GLOBAL ROUTINE EOPSVPOOL  =
BEGIN

REGISTER T1,T2;
EXTERNAL  CORMAN %()% ;
EXTERNAL ENTRY,NAME;
LABEL  LOOP ,SEQNO;
MACRO	P = .STLPTR<30,6>  $,
	BIT35 = 0,1  $,
	STLWORD = STLPTR<RIGHT>  $;

OWN	SVFROM;
MACRO  ADJUST = SVFROM  $;

% SINCE EVERYONE ELSE WANTS TO USE POOL, EVERYTHING FROM THE BEGINNING
OF THE CURRENT STATEMENT AND ITS PRECEEDING LINE SEQUENCE NUMBER IF
ANY, MUST BE SAVED AWAY.  THE LAST RING BUFFER ADDED IS STILL IN THE 
RING BUFFER SO ONLY THAT WHICH COMES BEFORE IT NEED BE SAVED AND
IF WE ARE LUCKY THIS AMOUNT WILL BE NEGATIVE   
%

% SEE IF THERE IS A LINE SEQUENCE NUMBER PRECEEDING, BY BACKING
UP IGNORING NULLS %

%CHECK PORTION OF THE CURRENT WORD TO THE LEFT OF THE CURRENT BYTE %
SVFROM _ .STLWORD;
SEQLAST _ 0;	!CLEAR THE INTER PROGRAM UNIT SEQUENCE NUMBER SAVE FLAG
SEQNO:BEGIN

T1 _ .STLWORD;
IF  .(.STLWORD) < P, 36-P >  EQL  0
THEN	  T1 _ .T1 -1   	! NO FOLLOWING TAB
ELSE	IF P LEQ 29  AND .(.STLWORD)<29,7> EQL "	" %TAB% AND .(.STLWORD)<P,36-P-7>  EQL 0
	THEN	% FOLLOWING TAB %
		T1 _ .T1 -1
	ELSE	IF  P  NEQ   1 
		THEN	LEAVE SEQNO  ;	! NO LINE SEQUENCE NO

% WE HAVE A POSSIBLE LINE SEQ NO  %
	  LOOP:BEGIN
		WHILE @T1  GEQ  POOLBEGIN
		DO	( IF @@T1  NEQ  0
			  THEN	( IF .(@T1)<BIT35>  EQL  1
				  THEN	( % WE HAVE A LINE SEQ# %
					  % SAVE LINESEQ NO JUST FOR 
					    CONSISTENCY   %
					  SVFROM _ .T1;
					  SEQLAST _ 1;  ! FLAG LINESEQ NO
					  LEAVE  SEQNO
					);
				  SEQLAST _ 0;
				  LEAVE LOOP
				)
			  ELSE  T1 _ .T1-1
			)
	  END %LOOP%
END %SEQNO%  ;
% SVFROM IS NOW THE START OF WHAT MUST BE SAVED.  %

% NOW WHAT HAS TO BE SAVED ?  %
VREG _  RINGLENGTH;
IF ( T1_ .CURPOOLEND<RIGHT> - .VREG )  LEQ  .SVFROM
THEN	( % WHAT IS NEEDED IS STILL IN THE RING BUFFER  %
	  EOPSAVE _ 0   ;
	)

ELSE	( % IN THIS CASE THE AREA FROM .SVFROM THROUGH .T1-1 MUST
		BE SAVED  %
	  SAVESIZE _ .T1 - .SVFROM  ;
	  NAME <LEFT> _ .SAVESIZE  ;
	  SAVESTART _ CORMAN();
	  T2<RIGHT> _ . SAVESTART ;
	  T2<LEFT> _ .SVFROM ;
	  T1 _ .SAVESTART + .SAVESIZE  ;
	  BLT ( T2, -1 , T1 )  ;
	);

% NOW FIX UP ALL THE LITTLE POINTERS  %
ADJUST _ .SVFROM - POOLBEGIN;
CURPOOLEND _ .CURPOOLEND<RIGHT> - .ADJUST;
CURPTR _ .CURPTR - .ADJUST;
STLPTR _ .STLPTR - .ADJUST;
STPTR _ .STPTR - .ADJUST;
LINEPTR _ .LINEPTR - .ADJUST

END;  % EOPSAVE %


GLOBAL ROUTINE EOPRESTORE  =
BEGIN

REGISTER T1,T2;
EXTERNAL ENTRY;
OWN  ADJUST;  ! ADJUSTMENT OF RING BUFFER LENGTH AT TRANSFER TIME
EXTERNAL  SAVSPACE  %()% ,
	  LEXINIT  %()% ;

%EOPRESTORE IS CALLED AT THE BEGINNING OF EACH PROGRAM UNIT.  IT
WILL INITIALIZE POOL IN ORDER TO START PROCESSING THE PROGRAM UNIT.


IF .CURPOOLEND IS EQUAL TO POOLBEGIN THEN IT IMPLIES THAT THIS IS
THE FIRST PROGRAM UNIT IN THE COMPILATION.  IN THIS CASE THE FIRST
RING BUFFER MUST BE READ IN AND TRANSFERED TO POOL BEFORE INITIALIZING
"LEXICAL()".

IF THIS IS NOT THE CASE THEN POOL HAS BEEN SAVED AWAY AFTER THE
LAST PROGRAM UNIT SO THE SPACE WOULD BE AVAILABLE TO THE LATER PASSES.
POOL MUST BE RESTORED.  IF MORE THAN THE REMAINING CURRENT INPUT RING
BUFFER HAD TO BE SAVED IT WILL BE POINTED TO BY .EOPSAVE. THIS AREA
IS MOVED BACK TO THE BEGINNING OF POOL,  FOLLOWED BY THE CONTENTS OF 
THE CURRENT RING BUFFER.

THE SAVED AREA IS RESTORED STARTING AT POOLBEGIN.  THE RING BUFFER
MUST END AT .CURPOOLEND-1.  IF END OF FILE, EOF WILL BE RETURNED,
OTHERWISE 1.
%

MACHOP  INUUO  = #056  ;
LABEL  CHK1,CHK;
OWN FFICLSV;



ROUTINE  GETCORE =
BEGIN
			EXTERNAL JOBFF,JOBREL;
			  UNTIL  .JOBFF  LSS  .JOBREL
			  DO
			  BEGIN
				EXTERNAL CORERR;
				MACHOP CALLI = #047;

				IF ( VREG _ .JOBREL + 1 )  GTR #400000  THEN CORERR();
				%ALLOCATE%
				CALLI(VREG,#11);
				CORERR()
			  END
END; %GETCORE%

	 ROUTINE  
BUFUP  =
BEGIN
IF FTTENEX THEN
BEGIN

	%SET UP OUTPUT BUFFERS%
	IF .FLGREG<LISTING>
	THEN
	BEGIN
		BUFFERS(LST) _ .JOBFF<RIGHT>;
		BUFPNT(LST)	_ (.JOBFF<RIGHT>)<36,7>;
		BUFCNT(LST) _ XSOUTSIZ * 5;
		JOBFF _ .JOBFF+ XSOUTSIZ;
		GETCORE();
	END;

	IF .FLGREG<OBJECT>
	THEN
	BEGIN
		BUFFERS(BIN) _ .JOBFF<RIGHT>;
		BUFPNT(BIN) _ (.JOBFF<RIGHT>)<36,36>;
		BUFCNT(BIN) _ XSOUTSIZ;
		JOBFF _ .JOBFF+ XSOUTSIZ;
		GETCORE();
	END
END
END;	%BUFUP%


IF  .CURPOOLEND<RIGHT>  EQL  POOLBEGIN
THEN
BEGIN % COMPILATION INITIALIZATION %
	GLOBAL  FFBUFSAV;
	EXTERNAL JOBFF;
	%SAVE .JBFF SO THAT WHEN NEW INPUT FILES ARE OPENED
	 THEY CAN USE THE SAME LOW CORE SPACE %

	IF FTTENEX
	THEN
	BEGIN

	IF .FLGREG<ININCLUD>
	THEN
	BEGIN
		IF .BUFFERS(ICL) EQL  0
		THEN
		BEGIN
			%SET UP THE BUFFERS%
			BUFFERS(ICL) _ .JOBFF<RIGHT>;
			JOBFF_ .JOBFF + XSINSIZ;
			GETCORE();
		END;

		IF SINPUT(ICL)  EQL  EOF  THEN RETURN .VREG;

	END
	ELSE
	BEGIN
		%SOURCE INPUT INITIALIZATION%
		BUFUP();	!SET UP OUTPUT BUFFERS NOW
		BUFFERS(SRC) _ .JOBFF<RIGHT>;
		BUFFERS(ICL) _ 0;	!INITIALIZATION
		JOBFF _ .JOBFF + XSINSIZ;
		GETCORE();
		IF SINPUT ( SRC )  EQL  EOF THEN RETURN .VREG;
	END

	END
	ELSE
	BEGIN

	IF .FLGREG<ININCLUD>
	THEN
	BEGIN
		LOCAL  SAVFF;
		SAVFF _ .JOBFF;
		IF .FFICLSV  NEQ  0
		THEN	JOBFF _ .FFICLSV;	!USE THE SAME BUFFER SPACE

		IF SKIP( INUUO ( ICL,0 ) ) NEQ 0 ! FIRST INPUT BUFFER

		THEN BEGIN
			! OTHERWISE CHECK THE STATUS
	%		CHECKSTATUS  	 RETURN EOF IF EOF
					  TERMINATE IF ERROR
					  OTHERWISE CONTINUE  %
			IF INSTAT()  EQL  EOF  THEN  RETURN  .VREG
		END ;  %CHK1%
		IF .FFICLSV  EQL  0
		THEN	 FFICLSV _ .SAVFF	!FIRST INCLUDE
		ELSE	JOBFF _ .SAVFF;

	END
	ELSE
	BEGIN
		EXTERNAL  BGSTBF;	!MAXIMUM BUFFER SIZE - CALCULATED
					! BY COMMAN
		FFBUFSAV _ .JOBFF;
	
		IF SKIP( INUUO ( SRC,0 ) ) NEQ 0 ! FIRST INPUT BUFFER
	
		THEN BEGIN
			! OTHERWISE CHECK THE STATUS
	%		CHECKSTATUS  	 RETURN EOF IF EOF
					  TERMINATE IF ERROR
					  OTHERWISE CONTINUE  %
			IF INSTAT()  EQL  EOF  THEN  RETURN  .VREG
		END ;  %CHK%
		  IF (.FFBUFSAV+.BGSTBF)  LSS .JOBFF
		  THEN	(EXTERNAL E61,FATLERR,LASTLINE;
			 FATLERR(.LASTLINE,PLIT'EOPRES',E61<0,0>));
		JOBFF _ .FFBUFSAV + .BGSTBF;	!LEAVE ENOUGH SPACE SO THE LARGEST
						!DEVICE BUFFERS WILL FIT LATER
		%CHECK TO SEE THAT WE HAVE ENOUGH CORE %
		GETCORE();

		FFICLSV _ 0;	!INITIALIZE FOR INCLUDE
	END;

	END;	%NOT FTTENEX%


	% INITIALIZE POINTERS %
	CURPTR _ 0;
	T2 _ POOLBEGIN ; ! RING BUFFER TRANSFER POINT
	VREG _  RINGLENGTH;
	CURPOOLEND _ POOLBEGIN + .VREG ;
	ADJUST _ 0 ;  ! TRANSFER ENTIRE RING BUFFER

END  % COMPILATION INITIALIZATION %

ELSE 
BEGIN  % RESTORE POOL AFTER PREVIOUS END OF PROGRAM %


	IF FTTENEX
	THEN	BUFFERS(ICL) _ 0
	ELSE	FFICLSV _ 0;	!INITIALIZE FOR INCLUDE

	IF .EOPSAVE NEQ  0
	THEN	( % RESTORE SAVED PORTION %
		  T1 _ .SAVESTART ^18  +  POOLBEGIN;
		  T2 _ POOLBEGIN  +  .SAVESIZE   ;
		  BLT ( T1, -1 , T2 )  ;
		  SAVSPACE ( .SAVESIZE-1, .SAVESTART );
		  ADJUST _ 0;  ! TRANSFER ENTIRE RING BUFFER
		)

	ELSE	( % ONLY THE RING BUFFER NEED BE RESTORED %
		  T2 _ POOLBEGIN ;
		  % HOW MUCH OF THE RING BUFFER SHOULD BE TRANSFERED%
	  	  VREG _  RINGLENGTH;
		  IF (ADJUST _ POOLBEGIN - ( .CURPOOLEND<RIGHT> - .VREG ) ) LSS  0
		  THEN  ADJUST _ 0  ;
		)

END ;  % RESTORE POOL %

% NOW RESTORE THE RING BUFFER STARTING AT .T2,  BUT ONLY RESTORE 
THE LAST (RINGLENGTH - .ADJUST) WORDS.    %

T1 _ .T2;
VREG _ RINGSTART;
T1<LEFT> _  .VREG + .ADJUST ;
VREG _  RINGLENGTH;
T2 _ .T2<RIGHT>  +  .VREG - .ADJUST<RIGHT>  ;
BLT  ( T1, -1, T2 ) ;
(@T2)<FULL> _ ENDBUFLAG  ; ! STORE END OF BUFFER FLAG

%CONSISTENCY CHECK %
IF  .T2  NEQ .CURPOOLEND<RIGHT>  
THEN INTERR ( 'EOPRESTORE');

% INITIALIZE "LEXICAL".  IT IS POSSIBLE THAT AN EOF MAY BE RETURNED.
   SOMEWHAT UNLIKELY THOUGH  %

RETURN LEXINIT()  

END;  % EOPRESTORE %


	GLOBAL ROUTINE 
OVERFLOW ( INCLASS, CLASSERR )    =
BEGIN
	EXTERNAL  E51,E61,SHIFTPOOL,FATLEX;

	% THIS ROUTINE IS CALLED WHEN A STATEMENT COMPLETELY 
	  FILLS THE STATEMENT BUFFER POOL  %

	IF .INCLASS  NEQ  0
	THEN
		% IN CLASSIFICATION  - -  THE STATEMENT IS TOO LARGE
		  TO CLASSIFY
		  RETURN SOME ILLEGAL CHARACTER AND KILL
		  THE CLASSIFICATION.  THEN WHEN WE GET BACK HERE AGAIN
		  AFTER DURING THE SKIPPING OF THE STATEMENT
		  PUT OUT THE FATAL ERROR MESSAGE %

	!WE WISH TO RETURN ILLEGAL CHARACTER TO TRIGGER
	! THE TERMINATION OF THIS STATEMENT - MAKE SURE THAT
	! WE ARE NOT IN A QUOTED STRING AND RETURN APPROPRIATE
	! ILLEGAL CHARACTER FOR THE CURRENT CONTEXT.
	IF .MSNGTIC EQL 0 THEN RETURN "_" ELSE (MSNGTIC_0; RETURN EOS);

	IF  @.CLASSERR  NEQ  0
	THEN	FATLERR (.LASTLINE,E51<0,0>);
		% THIS WILL TYPE OUT ALL LINES UP TO THE CURRENT
	   	  ONE AND THEN THE MESSAGE %

		% IF THE STATEMENT WAS CLASSIFIED JUST DRIVE ON.
		  THE ONLY NOTICEABLE EFFECT WILL BE IF IT GETS AND
		  ERROR LATER THE WHOLE STATEMENT WILL NOT BE TYPED TO 
		  THE TTY:   %

	!WE HAVE PRINTED ERROR MESSAGE - CLEAR FLAG TO PREVENT
	! EXTRANEOUS ERROR MESSAGES
	(.CLASSERR)<0,36>_0;
	%DUMP THE FIRST PART OF THE STATEMENT %
	STPOS _ 72;
	STPTR _ .LINEPTR;
	STLPTR _ .LINEPTR;

	SHIFTPOOL();
	!RESET BTPTR TO PREVENT LOSS OF PARTIAL LINE IN
	! PRINTING ERROR LINE
	BTPTR_.LINEPTR;

	IF OVRESTORE()  EQL  OVRFLO
	THEN	(FATLEX(PLIT'OVERFLOW, LINE TOO LONG',
		 E61<0,0>); ARINGLEFT_0); !POSSIBLE INTERNAL ERROR

	RETURN .VREG
END;	%OVERFLOW%


GLOBAL ROUTINE

SHIFTPOOL =
BEGIN
	% THIS ROUTINE IS USED BY ACMEOB TO SHIFT THE CURRENT STATEMENT TO THE
	  TOP OF THE POOL BUFFER.
	%
	% STLPTR POINTS TO FIRST CHARACTER-1 OF THE LINE IN WHICH THE CURRENT STATEMENT BEGINS %
	
	% BACK UP TO THE FIRST NON-ZERO WORD PRECEEDING THE CURRENT ONE JUST
	  IN CASE WE NEED THE LINE SEQUENCE NUMBER IN ORDER TO SAVE AND
	  RESTORE POOL BETWEEN PROGRAM UNITS   %
	BEGIN  %SHIFT POOL %
	REGISTER  T1,T2;
	OWN  ADJUST;	! POINTER ADJUSTMENT VALUE
	
	T1 _ .STLPTR<RIGHT>;
	IF .STLPTR<PFLD>  NEQ  1
	THEN  T1 _ .T1 -1  ;
	% BACK UP TO THE NEXT NON-ZERO WORD.  IT WILL BE THE LINESEQNO IF THERE IS ONE  %
	WHILE @@T1 EQL  0  AND  .T1  GTR  POOLBEGIN
	DO ( T1 _ .T1 -1 );
	IF .T1 LEQ POOLBEGIN  THEN RETURN  OVRFLO;
	% SHIFT TO THE TOP OF POOL %
	ADJUST _ .T1 - POOLBEGIN ;
	T2 _ .CURPOOLEND - .T1 + POOLBEGIN ;
	T1 _ .T1^18  +  POOLBEGIN;
	BLT ( T1,-1,T2);
	
	%NOW ADJUST ALL THE LITTLE POINTERS  %
		STLPTR _ .STLPTR - .ADJUST;
		CURPTR _ .CURPTR - .ADJUST;
		LINEPTR _ .LINEPTR - .ADJUST;
		STPTR _ .STPTR - .ADJUST;
		CLASPTR _ .CLASPTR - .ADJUST;
		CLASLPT _ .CLASLPT - .ADJUST;
		CONTPTR _ .CONTPTR - .ADJUST;
		BTPTR _ .BTPTR - .ADJUST;
		CURPOOLEND _ .CURPOOLEND - .ADJUST;
		!REMEMBER TO SET FLAG
		(.CURPOOLEND)<FULL>_ENDBUFLAG;
	END  % SHIFTPOOL %
	
END;   %SHIFTPOOL %




	GLOBAL ROUTINE  
DECODELINE  (LINENUM) =
	BEGIN
	% TRANSLATE LINE NUMBER TO ASCII AND PLACE IN LINENO[0]
	  LINENO[1] CONTAINS <TAB>0000.   %

	REGISTER T1=1,T2=2,T3=3;
	LOCAL SV[3];
	% SAVE REGS %
	SV[0] _ .T1;  SV[1] _ .T2;  SV[2] _ .T3;

		T1 _ .LINENUM;
		DECR I FROM 4 TO 0 DO
		BEGIN
			MACHOP  IDIVI = #231, MOVEI = #201, ROTC = #245;
			IDIVI ( T1,10 );
			MOVEI ( T2,"0",T2 );
			ROTC ( T2,-7 )
		END;
		% THE LINE NUMBER IN ASCII, IS NOW IN T3 %
		LINENO[0] _ .T3;
	
		% RESTORE %
		T1 _ .SV[0];  T2 _ .SV[1];  T3 _ .SV[2];

	END;
	
	GLOBAL ROUTINE
ERLSTR ( MSGTOTTY )  =

BEGIN
	% CLEAR AND PRINT THE ERROR MESSAGE QUEUE -
		DON'T TYPE IF   NOT .MSGTOTTY  %

	UNTIL .ERRLINK<RIGHT> EQL 0
	DO
	BEGIN
		REGISTER MSG;
		MSG _ BLDMSG (.ERRMSG[.EMSGNUM(ERRLINK)],.ERRLINK<RIGHT>);

		%LISTING%
		IF .FLGREG<LISTING>
		THEN
		BEGIN
			IF .PAGELINE  LEQ  0
			THEN  HEADING();
			PAGELINE _ .PAGELINE - 1;
			STRNGOUT (.MSG)
		END;

		%TTY%
		IF NOT .ERRTYPD(ERRLINK)  AND .MSGTOTTY
		THEN	OUTTYX ( MSG ) ;

		MSG _ .ERRLINK<RIGHT>;
		ERRLINK _ @@ERRLINK;
		SAVSPACE (ENODSIZ-1,.MSG)
	END
END;	% ROUTINE ERLSTR %



	GLOBAL ROUTINE 
PRINT	=
BEGIN 	%PRINT%
	LOCAL  MSGTOTTY; ! IF 1 INDICATES THAT ANY ERROR MESSAGES SHOULD BE TYPED AS WELL AS PRINTED
	LABEL	LINEPR;


	IF (.MSGNOTYPD  OR .ERRFLAG ) AND NOT .FLGREG<TTYDEV> AND NOT .FLGREG <NOERRORS>
	THEN	% THERE ARE ERROR MESSAGES OR LINES TO BE OUTPUT TO THE TTY %
	BEGIN
		% TYPE ANY EARILER UNTYPED LINES  AND CURRENT LINE,  WITH LINE NUMBERS%
		BACKTYPE ( ALLCHAR );

		MSGTOTTY _ 1
	END
	ELSE	MSGTOTTY _ 0;

	% NOW CHECK THE LISTING %
	IF .FLGREG<LISTING>
	THEN
	LINEPR:BEGIN
		IF .PAGELINE  LEQ  0
		THEN	HEADING();	! PRINT THE HEADING

		%OUTPUT THE LINE NUMBER %
		DECODELINE(.LINELINE);
		STRNGOUT ( LINENO );	! PRINT LINE NUMBER


		% NOW INCREMENT THE LINE COUNTER %
		IF ..CURPTR  EQL  LF
		THEN	PAGELINE _ .PAGELINE -1
		ELSE
		   IF  ..CURPTR  EQL  FF
		   THEN ( PAGELINE _ -1; FNDFF _ 1 )
		   ELSE
			IF ..CURPTR  EQL  VT
			THEN
			BEGIN
				REGISTER T[2];
				MACHOP  IDIVI = #231;
				T[0] _ .PAGELINE;
				IDIVI ( T[0],20 );
				PAGELINE _ .PAGELINE -.T[1] - 1;
			END
			ELSE
				%OTHER%
				( PAGELINE _ .PAGELINE -1;
		  		  LINEOUT ( .LINEPTR, .CURPTR );	! PRINT THE LINE
				  CHAROUT (CR);CHAROUT(LF);
				  LEAVE LINEPR	!BECAUSE WE ALREADY PRINTED THE LINE
				)
		;
		% NOW PRINT THE LINE%
		IF .NOCR
		THEN
		BEGIN	%PUT CR BEFORE LINE TERMINATOR TO KEEP THE
			  OLD TIME PRINTERS HAPPY %
			DECREMENT ( CURPTR );
			IF .LINEPTR  NEQ  .CURPTR
			THEN	LINEOUT ( .LINEPTR, .CURPTR );	! PRINT THE LINE
			INCP ( CURPTR );	!INCREMENT THE POINTER AGAIN
			CHAROUT(CR);
			CHAROUT(  ..CURPTR );	!LINE TERMINATOR
		END
		ELSE
			LINEOUT ( .LINEPTR, .CURPTR );	! PRINT THE LINE

	END;

	MSGNOTYPD _ 0;	! ALL MESSAGES WILL BE TYPED HERE 

	% NOW OUTPUT THE ERROR MESSAGES AND CLEAR THE QUEUE %
	IF .ERRLINK<RIGHT>  NEQ  0
	THEN	( ERLSTR ( .MSGTOTTY ); ERRFLAG _ -1 );


	NOCR _ 0

END  ;  %PRINT %

	GLOBAL ROUTINE  
BACKTYPE ( LINESORALL )  =
BEGIN
	% THIS ROUTINE WILL OUTPUT ALL LINES OR ALL CHARACTERS STARTING
	  AT THE BEGINNING OF THE STATEMENT UP TO THE CURRENT POSITION.
	  WHAT IS OUTPUT IS DEPENDENT ON THE VALUE OF LINESORALL
	%

	OWN  LINE,LINEND,POS,TTYBUF[21],TTYPTR,LINEWASOUT;
	REGISTER C;
	LABEL TYPELINES,BUFLOOP;


	IF  NOT .ERRFLAG
	THEN	
	BEGIN	% START AT THE BEGINNING OF THE LINE %
		LINE _ .ISN;	! BEGINNING LINE NUMBER
		BTPTR _ .STPTR;		! 
		POS _ .STPOS;		! LINE CHARACTER POSTION
		ERRFLAG _ 1	! SET ERRORS ENCOUNTERED AND PRINTED FLAG
	END;

	% ELSE THIS IS THE SECOND CALL TO BACK TYPE FOR A SINGLE STATEMENT
	  SO USE THE PREVIOUS VALUES   %

	IF .BTPTR  EQL  .CURPTR  THEN  RETURN  .VREG;

	TTYPTR _ TTYBUF<36,7>;

	IF .POS  NEQ  72
	THEN
	BEGIN	% BLANK FILL FOR PARTIAL LINES %
		DECR I FROM 72-.POS-1 TO 0
		DO REPLACEI ( TTYPTR, " " );
		POS _ 72
	END;

	TYPELINES:BEGIN
		% ISOLATE THE NEXT LINE %
		WHILE 1 DO
		BUFLOOP:BEGIN
			DECR I FROM 99 TO 0
			DO 
			BEGIN %LOOP  UNTIL BUFFER IS FILLED%
				LOCAL SBTPTR;
				IF (C_SCANI(BTPTR))   GEQ  LF  AND  .C  LEQ  FF
				THEN	 % END OF A LINE %
				BEGIN
					%CHECK FOR NO CR %
					IF ..TTYPTR  NEQ  CR
					THEN	REPLACEI (TTYPTR,CR);

					%INSERT LINETERMINATOR AND BUFFER TERMINATOR %
					REPLACEI (TTYPTR, LF);	!ALWAYS LF
					REPLACEI (TTYPTR,0);

					IF NOT .LINEWASOUT
					THEN
					BEGIN	%OUTPUT THE LINE NUMBER %
						DECODELINE(.LINE);
						OUTTY ( LINENO)
					END;
					LINEWASOUT _ 0;

					  % OUTPUT THE LINE%
					OUTTY ( TTYBUF );
					TTYPTR _ TTYBUF<36,7>;

					  % IGNORE CR'S AND NULLS %
					  LINEND _ .BTPTR;
					  DO	C _ SCANI(BTPTR)
					  UNTIL  .C NEQ  CR  AND .C NEQ  0;
	
					% DETERMINE THE NEXT LINE NUMBER IN CASE WE COME BACK THROUGH HERE %
					  % CHECK FOR LINE SEQUENCE NO %
					  IF @@BTPTR
					  THEN  LINE _ LINESEQNO(BTPTR)
					  ELSE ( LINE _ .LINE+1; DECREMENT (BTPTR) );
					SBTPTR_.BTPTR;

					% CHECK FOR END OF PRINTING %
					IF .LINEND EQL .CURPTR  OR  .BTPTR  EQL  .CURPTR
					%BOTH MUST BE CHECKED SINCE WE DON'T KNOW 
					  IF CURPTR IS BEFORE OR AFTER THE
					  THE LINESEQUENCE NUMBER.  LINE SEQUENCE
					NUMBERS ARE A PAIN IN THE ASS %
					THEN LEAVE TYPELINES
					ELSE LEAVE BUFLOOP;	!NEW BUFFER



				END
				ELSE
				BEGIN	% PLACE NON-NULL CHARACTERS IN TTY BUFFER %
					IF .C NEQ 0
					THEN  REPLACEI(TTYPTR,.C);
					IF .CURPTR EQL .BTPTR
					THEN (IF .LINESORALL NEQ ALLCHAR THEN BTPTR_.SBTPTR;
					 LEAVE TYPELINES)	! END OF TYPING

				END;
			END %BUFFER LOOP %  ;

			% ONE CAN ASSUME THAT THE END OF LINE WILL BE REACHED
			  BEFORE .BTPTR EQL  .CURPTR SINCE THE LINE IS ALREADY
			  100 CHARACTERS LONG SO OUTPUT THE LINE # FOLLOWED
			  BY THIS PORTION OF THE LINE AND THEN NOTE THAT FACT %


			IF NOT .LINEWASOUT
			THEN
			BEGIN	%OUTPUT THE LINE NUMBER %
				DECODELINE(.LINE);
				OUTTY ( LINENO );
				LINEWASOUT _ 1
			END;

			% CLOSE OUT THE BUFFER %
			REPLACEI(TTYPTR,0);
			OUTTY ( TTYBUF );
			TTYPTR _ TTYBUF<36,7>

		END	% WHILE 1 LOOP - BUFLOOP:  - LOOP BACK FOR NEW TTY BUFFER %

	END;  % TYPELINES %

	% CHECK FOR PARTIAL LINE OUTPUT %
	IF .LINESORALL EQL ALLCHAR  AND .TTYPTR  NEQ  TTYBUF<36,7>
	THEN
	BEGIN	% OUTPUT PARTIAL LINE %
		IF NOT .LINEWASOUT
		THEN
		BEGIN	%OUTPUT LINE NUMBER %
			DECODELINE(.LINE);
			OUTTY ( LINENO )
		END;
		
		% OUTPUT LINE %
		% FINAL CRLF %
		REPLACEI(TTYPTR,CR);
		REPLACEI(TTYPTR,LF);
		REPLACEI(TTYPTR,0);
		OUTTY ( TTYBUF)

	END
	ELSE	IF .LINEWASOUT  THEN  INTERR ('BACKTYPE');
			% THERE MUST BE A LOT OF NULLS IN THE LINE BECAUSE
			  ITS OVER 100 CHARACTERS LONG AND WE ARE STILL
			  IN THE STATEMENT FIELD  %

END;	% BACKTYPE %


END  %LISTNG%
ELUDOM