Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/listng.bli
There are 26 other files named listng.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 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: D. B. TOLMAN/DCE/SJW/RDH/TFV/EGM/CDM/AHM/PLB/PY/AlB/MEM

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

GLOBAL BIND LISTNV = #11^24 + 0^18 + #4602; 	!Version Date:	13-Jan-88

%(

***** 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.

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

1162	PY	29-Jun-82	------
	Replace oblsolete RDTXT JSYS with TEXTI. Add routine WRITECRLF
        to type a CRLF when control-Z is read from a terminal. CONVERT
	the ENDOFILE returned by LEXINI to EOF.

***** Begin Version 7 *****

27	1466	CDM	1-Feb-82
	Printing /D(A) for /DEBUG:ARGUMENTS in listings.

1504	AHM	26-Feb-82
	Display "/EXT"  for /EXTEND  in  listing headers,  change  the
	EXPAND switch to display "/EXP" to lessen confusion and  print
	"/NOF77" when not doing "/F77".

1600	PLB	9-Jul-82
	Use ODTIM JSYS for header time & date.  Make -Mth- be
	mixed case so the -10 & -20 are identical. Use CORUUO routine
	to manage core.

1613	CDM	13-Aug-82
	Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS

***** End V7 Development *****

2064	PLB	22-Jun-84	10-34728
	Fix BACKTYPE of very very long lines.


***** Begin Version 10 *****

2447	PLB	10-Aug-84
	Add support for nested INCLUDE files.  Added many form feeds,
	fixed spacing, moved FORWARDS, EXTERNALS, GLOBALS, OWNS, and
	BINDS to top of MODULE.

2474	TFV	21-Sep-84,	AlB	17-Oct-84
	Fix continuation processing to handle unlimited numbers of blank
	and comment  lines between  continuation lines.   The lines  are
	recorded in  a linked  list  of four  word entries,  defined  in
	LEXAID.BLI.  If there are too many blank and comment lines,  the
	buffer will get an overflow.   When this happens, the buffer  is
	compacted using the information in the linked list.  The info is
	also used  to speed  up continuation  processing in  the  lexeme
	scan.

2500	AlB	14-Nov-84
	Change the list of entries for source lines from a linked list
	in dynamic memory to a fixed-length list in static memory.

2501	AlB	20-Nov-84
	Special handling of errors found in comment lines.  Since these
	errors can be detected while scanning unprinted comment lines, they
	cannot go through the normal error queueing process.


2505	AlB	28-Nov-84
	Adjust BACKLINE when the source pool is jiggled.

	The BACKPRINT routine was taken out of LEXSUP, rewritten and
	put into this module.

2527	AlB	28-Mar-85
	The DISCARD routine was causing all trailing comments
	to be displayed whenever a preceding source line had an error.
	However, the BACKTYPE routine gets confused if one attempts to
	type a line which does not (yet) have a line terminator.
	Solution is not to use BACKTYPE when compacting the buffer.

***** End V10 Development *****

2604	MEM	13-Feb-87
	When compacting the buffer, CLASLINE must be incremented for each
	comment line we print that is before the first code line after 
	CLASLINE. Otherwise, if we print a buffer of 99 comment lines
	and CLASLINE is not updated, then the line number of the next line
	after the 99th comment line will be the same as the first comment line
	after the last code line -- the line numbers will keep getting reset
	(ACMCLASBACK sets LINELINE to CLASLINE).

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

***** Begin Version 11 *****

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].  The lengths will be one
	(word) until a later edit, which will store and use long symbols.

4564	MEM	13-Feb-87
	When compacting the buffer, CLASLINE must be incremented for each
	comment line we print that is before the first code line after 
	CLASLINE. Otherwise, if we print a buffer of 99 comment lines
	and CLASLINE is not updated, then the line number of the next line
	after the 99th comment line will be the same as the first comment line
	after the last code line -- the line numbers will keep getting reset
	(ACMCLASBACK sets LINELINE to CLASLINE).

4602	DCE	13-Jan-88
	Remove edit 4564.  It only worked in the simplest case, and there
	were several other problems which are now corrected in LEXICA and
	LEXCLA.

ENDV11
)%

SWITCHES NOLIST;
REQUIRE LEXAID.BLI;		![1600] REQUIRES FTTENX AUTOMATICALLY
SWITCHES LIST;

EXTERNAL
	ARINGLEFT,		!Used for handling buffers correctly
%2505%	BACKLINE,
	BASENO,
	BGSTBF,			!MAX BUF SIZE -- CALCULATED BY COMMAN
	BLDMSG,
	CHAROUT,
!%4602%	CLASLINE,
%2474%	CLASLCUR,		! Entry for classification backup line
	CLOSUP,
	CORERR,
	CORMAN,
	CORUUO,
	DIGITS,
	E61,			!COMPILER ERROR IN ROUTINE <BLETCH>
	E112,			!ILLEGAL CHARACTER IN L.S.N.
	ENTRY,
	ERRLINK,
	ERRMSG,
	ERROR,
	FATLERR,
	FATLEX,
	FNDFF,
	HEADING,
	HEADPTR,
	HEADSTR,
%2447%	ICLEVEL,	!CURRENT INCLUDE LEVEL (0 BASED) VALID IF <ININCLUD>
	JOBREL,
	JOBSA,
	JOBFF,
	LASTLINE,
	LINEOUT,
	MSGNOTYPD,
	MSNGTIC,	!Need access when returning bogus character
	NAME,
	NOCR,
	NUMFATL,
	NUMWARN,
%4527%	ONEWPTR,	!Returns [1,,pointer] for Sixbit symbol
	PAGE,
	PAGEPTR,
	SAVSPACE,
	STRNG6,
	STRNG7,
	STRNGOUT,
%2501%	WARNCOMT,
	WARNERR,
	WARNOPT;

REQUIRE  IOFLG.BLI;		! IO AND FLGREG DEFINITIONS

FORWARD
%2505%	BACKPRINT,
	BACKTYPE,
	CHK4MORE,
	GETBUF,
	OVERFLOW,
%2474%	COMPACT,	! Compact buffer after overflow
%2500%	DISCARD,	! Compact buffer
%2474%	BLTLINL,	! Routine to BLT codelines to top of POOL
	OVRESTORE,
	READTXT,
	SHIFTPOOL,
	SINPUT,
	PRINT;

OWN
	BTPTR,		! POINTER FOR BACK TYPE WHICH CONTAINS THE BYTE
			! POSTION OF THE NEXT PORTION OF THE STATEMENT
			! IN ERROR,  TO BE TYPED
%2474%	CBUFPTR,	! Pointer to current available word in pool
%2474%	CPREVPTR,	! Pointer to end of latest line that was moved
%2527%	DISCARDING,	! TRUE if we are in the DISCARD routine
	LASTCHARACTER,
%2500%	LINLNEXT,	! Place where next source list cell will go
	SVFROM;

GLOBAL	FFBUFSAV;		! TOUCHED BY MRP1 IN DRIVER
				! (BUT SPELLED WRONG! (FFBUFSV))

MACHOP	CALLI=#047,
	HLLZ=#510,
	HLRZ=#554,
	HRLZ=#514,
	MOVEI=#201,
	ROT=#241,
	ROTC=#245;

BIND	JOBVER=#137;

%2447%	BIND	&FOINP = #17,	!FILOP. INPUT FUNCTION
%2447%		&FOGET = #22;	!FILOP. GETSTS FUNCTION

MACRO	ADJUST = SVFROM$;

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

MACRO	IOIMPM=17,1$,
	IODERR=16,1$,
	IODTER=15,1$,
	IOBKTL=14,1$,
	IODEND=13,1$;

%2447%	MACRO WHICHCHAN = (IF .FLGREG<ININCLUD>
%2447%		THEN ICL + .ICLEVEL
%2447%		ELSE SRC) $;
%2447%	MACRO  RINGHDR = (.BUFPNT(WHICHCHAN)<RIGHT>) $;
	MACRO  RINGLENGTH = (IF NOT FTTENEX 
		THEN  .(RINGHDR)<RIGHT>
%2447%		ELSE  @XWORDCNT(WHICHCHAN)) $;
	MACRO  RINGSTART = (IF NOT FTTENEX
		THEN  (RINGHDR+1)
%2447%		ELSE  @BUFFERS(WHICHCHAN)) $;

%2447%	MACRO	FILOP&(AC) = CALLI(AC,#155) $; !GENERAL FILE OPERATOR

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;	! of DECREMENT
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 AnY 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;	! of LINESEQNO
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
%4527%		STRNG6( ONEWPTR(.T[1]) );
		IF HLLZ(T[1],EXTENSION(SRC)) NEQ 0
		THEN
		BEGIN
			NXT(".");
%4527%			STRNG6( ONEWPTR(.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
%767%	IF F77
%767%	THEN STRNG7('/F77')
%1504%	ELSE
%1504%	BEGIN
%1504%		STRNG7('/NO');
%1504%		STRNG7('F77')
%1504%	END;
	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');
%1504%	IF .FLGREG<EXPAND> THEN STRNG7('/EXP');
	IF .FLGREG<NOERRORS> THEN STRNG7('/NOER');
	!ADD /L TO PAGE HEADERS IF LINE NUMBER/OCTAL MAP REQUESTED
	IF .FLGREG<MAPFLG> THEN STRNG7('/L');
%1504%	IF EXTENDED THEN STRNG7('/EXT');
	BEGIN
		% Check debug flags %

		BIND	DEBUGFLGS =
					% FLGREG bit positions for the various
					  modifiers %
					1^DBGDIMNBR +
					1^DBGINDXBR +
					1^DBGLABLBR +
					1^DBGTRACBR +
					1^DBGBOUNBR +
%1613%				  	1^DBGARGMBR     ;
		IF ( DEBUGFLGS  AND  .FLGREG<FULL> )  NEQ  0
		THEN
		BEGIN
			! Print "/D:(" then each initial as needed,
			! then ")".

			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");
%1613%			IF .FLGREG<DBGARGMNTS>	THEN  NXT("A");
			NXT(")")
		END
	END;
!------------------------------------------------------------------------------
!	DATE - DOESN'T CHANGE
!	TIME - DOESN'T CHANGE
!------------------------------------------------------------------------------
	NXT("	");
%1600%	IF FTTENEX
%1600%	THEN
%1600%	BEGIN	!TOPS-20
%1600%		LOCAL RSV[3];
%1600%		REGISTER R1=1,R2=2,R3=3;
%1600%		MACHOP	JSYS = #104;
%1600%		MACRO	ODTIM = JSYS(0,#220) $;
%1600%
%1600%		RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3; !SAVE REGS
%1600%
%1600%		R1 _ .HEADPTR;	!DESTINATION DESIGNATOR
%1600%		R2 _ -1;	!CURRENT TIME
%1600%		R3 _ #400^18;	!OT%NTM - NO TIME
%1600%		ODTIM;		!NO ERRORS POSSIBLE EXCEPT NO TIME SET..
%1600%
%1600%		REPLACEI(R1, "	"); !TAB
%1600%
%1600%		R2 _ -1;
%1600%		R3 _ #400200^18; !OT%NDA+OT%NSC - NO DATE, NO SECONDS
%1600%		ODTIM;
%1600%
%1600%		HEADPTR _ .R1;	!RESTORE UPDATED BP
%1600%
%1600%		R1 _ .RSV[0];  R2 _ .RSV[1];  R3 _ .RSV[2] !RESTORE REGS
%1600%	END	!TOPS-20
%1600%	ELSE
%1600%	BEGIN	!TOPS-10
		BASENO _ 10;
		T[1]_(CALLI(T[0],#14) MOD 31)+1;DIGITS(.T[1]);
%1600%		T[1]_@(UPLIT('-Jan-','-Feb-','-Mar-','-Apr-','-May-','-Jun-',
%1600%			  '-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("	");
		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])
%1600%	END;	!TOPS-10
!------------------------------------------------------------------------------
!	PAGE
!------------------------------------------------------------------------------
%1600%	STRNG7('	Page'); NXT(" ");
	PAGEPTR _ .HEADPTR;	! SAVE PAGE NUMBER POINTER
	.VREG
END;	! Of PAGEHEADER
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	!TOPS-10
%2447%		LOCAL ARG;		!ARG BLOCK FOR FILOP.
		REGISTER T1;		!AC FOR FILOP.

%2447%		ARG = WHICHCHAN^18 + &FOGET; !CHAN,,FUNCTION
%2447%		T1 = 1^18 + ARG<0,0>;	!LEN,,ADR
%2447%		IFSKIP FILOP&(T1)	!PERFORM GETSTS
%2447%		THEN .VREG;		!IGNORE ERROR

		IF .T1<IODEND> THEN
		BEGIN	!.T1<IODEND> NEQ 0
			% CHECK HERE FOR MULTIPLE FILES AND END OF INCLUDE%
			IF NOT .FLGREG<EOCS>	!END OF COMMAND STRING
			THEN
			BEGIN
				%GET THE NEXT FILE%
				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
					IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
%2447%					THEN 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	!.T1<IODEND>
		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;	!TOPS-10
END;	! of INSTAT
ROUTINE TRANSFRING  =
!++
! TRANSFER THE CURRENT RING BUFFER AND RETURN NEXT CHARACTER IS THERE
! ENOUGH ROOM LEFT IN POOL FOR NEXT BUFFER CONSISTANCY CHECK
!--
BEGIN
	REGISTER T1,T2;
	MACHOP  BLT = #251;

	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;	! 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;	! of 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%
		MACRO EOFBIT = 27,1 $;

%2447%		R1 _ @XDEVJFN(.DEV);
%2447%		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	( 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;	! of SINPUT
GLOBAL ROUTINE READTXT  =
BEGIN
IF FTTENEX THEN
BEGIN

	%READ TTY INPUT - SRC ONLY %

	REGISTER R1=1,R2=2,R3=3;
	MACHOP  JSYS = #104;
%1162%	 MACRO	TEXTI = JSYS (0,#524) $;
%1162%	 OWN	TEXTIARGBLOCK[5];
%1162%	 BIND	RDCWB = 0,	!COUNT OF WORDS FOLLOWING IN ARG BLOCK
%1162%	 	RDFLG = 1,	!FLAG WORD
%1162%	 	RDIOJ = 2,	!INPUT,,OUTPUT JFN
%1162%	 	RDDBP = 3,	!DESTINATION BYTE POINTER
%1162%	 	RDDBC = 4;	!DESTINATION NUMBER OF BYTES AVAILABLE
	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;

%1162%	 TEXTIARGBLOCK[RDCWB] _ 4;	!BLOCK SIZE
%1162%	 TEXTIARGBLOCK[RDFLG] _ 1^RDTOP + 1^RDJFN;	!FLAGS
%1162%	 TEXTIARGBLOCK[RDIOJ]<LEFT> _ .XDEVJFN(SRC);	!INPUT JFN
%1162%	 TEXTIARGBLOCK[RDIOJ]<RIGHT> _ .XDEVJFN(SRC);	!OUTPUT JFN
%1162%	 TEXTIARGBLOCK[RDDBP] _ (.BUFFERS(SRC)<RIGHT>)<36,7>; !DEST PTR
%1162%	 TEXTIARGBLOCK[RDDBC] _ XSINSIZ*5; !BYTE COUNT
%1162%	 R1 _ TEXTIARGBLOCK[0]<0,0>;

%1162%	 IF SKIP(TEXTI) EQL 0
	THEN
	BEGIN
		MACHOP JRST = #254;
%1162%	 	FATLERR( PLIT'TEXTI',.LINELINE-1,E61<0,0>);
		CLOSUP();
		JRST(0,.JOBSA<0,18>)	!HALT
	END;

%1162%	 LASTCHARACTER _ ..TEXTIARGBLOCK[RDDBP];	!SAVE LAST CHARACTER
%1162%	 						!FOR EOF CHECK
	%ZERO FILL%
%1162%	 (.TEXTIARGBLOCK[RDDBP]<RIGHT>)<0,.TEXTIARGBLOCK[RDDBP]<30,6>> _ 0;

%1162%	 XWORDCNT(SRC) _ .TEXTIARGBLOCK[RDDBP]<RIGHT> - .BUFFERS(SRC) + 1;
	RETURN 1;
END
END;	! of READTXT
GLOBAL ROUTINE GETBUF =

!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
!	READS IN THE NEXT RECORD OF THE INPUT FILE AND TRANSFERS IT TO
!	POOL.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	FLGREG, WHICHCHAN
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	If end of file, return EOF.
!	If not enough room in POOL, return OVRFLO.
!
! SIDE EFFECTS:
!
!	Read next input buffer.
!
!--

BEGIN
	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	!TOPS-10
		LOCAL ARG;	!BLOCK FOR FILOP.
		REGISTER T1;	!AC FOR FILOP.

		ARG = WHICHCHAN^18 + &FOINP;	!CHAN,,FUNCTION
		T1 = 1^18 + ARG<0,0>;		!LENGTH,,ADR
		IFSKIP FILOP&(T1)
		THEN .VREG
		ELSE IF INSTAT() EQL EOF
		THEN RETURN .VREG
	END	!TOPS-10
	ELSE
	BEGIN	!TOPS-20
		IF SINPUT( WHICHCHAN ) EQL EOF
		THEN RETURN .VREG
	END;	!TOPS-20

	!NO ERRORS OR EOF CONDITION DETECTED
	!TRANSFER THE RING BUFFER AND RETURN NEXT CHARACTER

	RETURN TRANSFRING()

END;	! of GETBUF
GLOBAL ROUTINE OVRESTORE    =
!++
! 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.
!--

BEGIN

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

END;	! of OVRESTORE
GLOBAL ROUTINE EOPSVPOOL =

!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
!	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.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	Unknown
!
! SIDE EFFECTS:
!
!	Shoves POOL around, allocates core.
!
!--

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

	!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	!SEQNO
		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 "?I" AND
			  .(.STLWORD)<P,36-P-7> EQL 0
			THEN	T1 _ .T1 - 1	!FOLLOWING TAB
			ELSE	IF P NEQ 1 
				THEN LEAVE SEQNO; !NO LINE SEQUENCE NO

LOOP:		BEGIN	!WE HAVE A POSSIBLE LINE SEQ NO [LOOP]
			WHILE @T1 GEQ POOLBEGIN
			DO
			BEGIN	!WHILE
				IF @@T1 NEQ 0
				THEN
				BEGIN	!@@T1 NEQ 0
					IF .(@T1)<BIT35> EQL 1
					THEN
					BEGIN	!WE HAVE A LINE SEQ#
						!SAVE LINESEQ NUMBER
						!JUST FOR CONSISTENCY
						SVFROM _ .T1;
						SEQLAST _ 1; !FLAG LINESEQ NO
						LEAVE SEQNO
					END;	!WE HAVE A LINE SEQ#
					SEQLAST _ 0;
					LEAVE LOOP
				END	!@@T1 NEQ 0
				ELSE T1 _ .T1 - 1
			END	!WHILE
		END	!WE HAVE A POSSIBLE LINE SEQ NO [LOOP]
	END;	!SEQNO

	!SVFROM IS NOW THE START OF WHAT MUST BE SAVED.  NOW WHAT HAS
	!TO BE SAVED?

	T1 _ .CURPOOLEND<RIGHT> - RINGLENGTH;
	IF .T1 LEQ .SVFROM
	THEN EOPSAVE _ 0	!WHAT IS NEEDED IS STILL IN THE RING BUFFER
	ELSE
	BEGIN	!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)
	END;	!IN THIS CASE THE AREA FROM .SVFROM THROUGH .T1-1 MUST BE SAVED


	!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;	! of EOPSVPOOL
GLOBAL ROUTINE EOPRESTORE =

!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
!	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.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	IF END OF FILE, EOF WILL BE RETURNED,
!	OTHERWISE 1.
!
! SIDE EFFECTS:
!
!	Messes with POOL, performs file input operations
!
!--

BEGIN	!EOPRESTORE
	REGISTER T1,T2;		!REGISTERS FOR BLT
	OWN FFICLSV;		!INCLUDE FILE SAVED JOBFF
	EXTERNAL SAVSPACE %()%,
		 LEXINIT  %()%;

	ROUTINE GETCORE =	![1600] Re-written /PLB
	IF FTTENEX
	THEN	CORUUO(.JOBFF)	!TOPS-20 simulated version
	ELSE
	BEGIN
		REGISTER R1;
		MACRO CORE(AC) = CALLI(AC,#011) $;

		R1 = .JOBFF;
		CORE(R1); !CORE UUO
		 CORERR() !** DANGER ** ERROR RETURN **

	END; %GETCORE%

	ROUTINE BUFUP  =
	BEGIN
		IF FTTENEX THEN
		BEGIN	!TOPS-20

			!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;

			!SET UP OBJECT BUFFERS
			IF .FLGREG<OBJECT>
			THEN
			BEGIN
				BUFFERS(BIN) _ .JOBFF<RIGHT>;
				BUFPNT(BIN)  _ (.JOBFF<RIGHT>)<36,36>;
				BUFCNT(BIN)  _ XSOUTSIZ;
				JOBFF _ .JOBFF + XSOUTSIZ;
				GETCORE();
			END
		END	!TOPS-20
	END;	!BUFUP


	IF .CURPOOLEND<RIGHT> EQL POOLBEGIN
	THEN
	BEGIN	!COMPILATION INITIALIZATION

		!SAVE .JBFF SO THAT WHEN NEW INPUT FILES ARE OPENED
		!THEY CAN USE THE SAME LOW CORE SPACE

		IF FTTENEX
		THEN
		BEGIN	!TOPS-20

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

%2447%				IF SINPUT(ICL + .ICLEVEL) EQL EOF
%2447%				THEN RETURN .VREG;

			END	!IN INCLUDE
			ELSE
			BEGIN	!NOT ININCLUDE

				!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;
%2447%			END	!NOT ININCLUDE
		END	!TOPS-20
		ELSE
		BEGIN	!TOPS-10
			IF .FLGREG<ININCLUD>
			THEN
			BEGIN	!IN INCLUDE
				LOCAL	SAVFF,		!SAVED END OF CORE
%2447%					ARG;		!BLOCK FOR FILOP.
%2447%				REGISTER T1;		!AC FOR FILOP

				SAVFF _ .JOBFF;		!SAVE END OF CORE
				IF .FFICLSV NEQ 0	!IF SAVED INCL BUFFERS
				THEN JOBFF _ .FFICLSV;	!USE THEM

%2447%				ARG = (ICL + .ICLEVEL)^18 + &FOINP;
%2447%				T1 = 1^18 + ARG<0,0>;	!LENGTH,,ADDR
%2447%				IFSKIP FILOP&(T1) 	!FIRST INPUT BUFFER
%2447%				THEN .VREG		!SUCCESS!
%2447%				ELSE IF INSTAT() EQL EOF !FIRST INPUT FAILED
				THEN RETURN .VREG;	!RETURN EOF IF EOF
							!TERMINATE IF ERROR
							!OTHERWISE CONTINUE

				IF .FFICLSV EQL 0	!IF NO SAVED BUFFERS
				THEN FFICLSV _ .SAVFF	!WAS FIRST INCLUDE
				ELSE JOBFF _ .SAVFF;	!ELSE RESET JOBFF
			END	!IN INCLUDE
			ELSE
			BEGIN	!NOT IN INCLUDE
				MACHOP INUUO = #056;

				FFBUFSAV _ .JOBFF;
				IFSKIP INUUO(SRC,0)	!INPUT FIRST BUFFER
				THEN IF INSTAT() EQL EOF !FIRST INPUT FAILED
				THEN RETURN .VREG;	!RETURN EOF IF EOF
							!TERMINATE IF ERROR
							!OTHERWISE CONTINUE

				IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
%2447%				THEN FATLERR(.LASTLINE,PLIT'EOPRES',E61<0,0>);

				!LEAVE ENOUGH SPACE SO THE LARGEST
				!DEVICE BUFFERS WILL FIT LATER
				JOBFF _ .FFBUFSAV + .BGSTBF;

				!CHECK TO SEE THAT WE HAVE ENOUGH CORE
				GETCORE();
				FFICLSV _ 0;		!INITIALIZE FOR INCLUDE
			END;	!NOT IN INCLUDE
		END;	!TOPS-10


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

	END	!COMPILATION INITIALIZATION
	ELSE 
	BEGIN	!RESTORE POOL AFTER PREVIOUS END OF PROGRAM

%2447%		IF NOT FTTENEX
%2447%		THEN FFICLSV = 0	  !TOPS-10: INITIALIZE FOR INCLUDE
%2447%		ELSE IF .FLGREG<ININCLUD> !TOPS-20: IF NOT CURRENTLY IN INCLUDE
%2447%		THEN BUFFERS(ICL+.ICLEVEL+1) = 0; !TOPS-20: CLEAR BUFFER PTR

		IF .EOPSAVE NEQ 0
		THEN
		BEGIN	!RESTORE SAVED PORTION
			T1 _ .SAVESTART^18 + POOLBEGIN;
			T2 _ POOLBEGIN + .SAVESIZE;
			BLT(T1,-1,T2);
			SAVSPACE(.SAVESIZE-1,.SAVESTART);
			ADJUST _ 0;		!TRANSFER ENTIRE RING BUFFER
		END	!RESTORE SAVED PORTION
		ELSE
		BEGIN	!ONLY THE RING BUFFER NEED BE RESTORED
			T2 _ POOLBEGIN;

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

	END;	!RESTORE POOL AFTER PREVIOUS END OF PROGRAM

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

	T1 _ .T2;
	T1<LEFT> _ RINGSTART + .ADJUST;
	T2 _ .T2<RIGHT> + RINGLENGTH - .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 END OF FILE MAY
	!BE RETURNED. SOMEWHAT UNLIKELY THOUGH.

%1162%	IF LEXINIT() EQL ENDOFILE<0,0>
%1162%	THEN RETURN EOF
%1162%	ELSE RETURN 1

END;	! of EOPRESTORE
GLOBAL ROUTINE OVERFLOW ( INCLASS, CLASSERR )    =
!++
! THIS ROUTINE IS CALLED WHEN A STATEMENT COMPLETELY FILLS THE STATEMENT
! BUFFER POOL
!--

BEGIN
	EXTERNAL  E51,SHIFTPOOL,FATLEX;

	IF .INCLASS  NEQ  0
	THEN
%2474%	BEGIN
%2474%		IF COMPACT() EQL OVRFLO
%2474%		THEN
%2474%		BEGIN	! Line too long

			% 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);
%2474%		END	! Line too long
%2474%		ELSE	RETURN .VREG	! Buffer was compacted
%2474%	END;

	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%
ROUTINE COMPACT=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Compact buffer of source lines after overflow.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	If the pool is still overflown, return the OVRFLO character.
!	Otherwise return the next source character.
!
! SIDE EFFECTS:
!
!	None
!
!--


%2500%	! Restructured by AlB on 14-Nov-84

BEGIN
	REGISTER TEMP;	! Convenient temporary

	DISCARD();	! Compact the buffer
	IF (TEMP = GETBUF()) EQL OVRFLO
	THEN
	BEGIN	! Try to shift down POOL

		SHIFTPOOL();

		TEMP = OVRESTORE();

	END;	! Try to shift down POOL

	RETURN .TEMP;

END;	! of COMPACT
GLOBAL ROUTINE DISCARD=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Compact buffer of source lines and the source line list.
!	Print the lines in the  buffer and BLT the code lines together.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	CURPTR		- Points to current source byte
!
!	CURPOOLEND	- Address of end of pool of source
!
!	Entries in the linked list of source lines are updated
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Lines may be printed.
!
!--


%2500%	! Written by AlB on 14-Nov-84
%2500%	! This is most of what was COMPACT

BEGIN
	REGISTER
		CELL,		! Pointer to entry in linked list of lines
		TEMP;		! Convenient temp

	LOCAL SAVPTR;		! To save CURPTR
!%4602%	LOCAL NOCODEYET;

	SAVPTR = .CURPTR;
	CBUFPTR = POOLBEGIN;	! Start filling at top of pool
	CPREVPTR = (POOLBEGIN -1)<1,7>;	! Where previous line would have ended

%2527%	DISCARDING = 1;		! So we don't type discarded lines

%2500%	CELL = LINLNEXT = LINLLIST<0,0>;	! Start at head of source list

	! Skip over lines already printed and compacted
	! Blank out beginning of multiple statements on initial line

	IF NOT .PRINTED(CELL)
	THEN
	BEGIN	! Blank fill partial line 

		TEMP = .FIRSTBP(CELL);		! First char of line

		DECR I from 71 to .FCHARPOS DO REPLACEI(TEMP," ");

	END;	! Blank fill partial line 

!%4602%	NOCODEYET = 1;

%2500%	WHILE .CELL LSS .LINLLAST
	DO
	BEGIN	! More entries on linked list

%2500%		PRINT(.CELL);			! Print the line

%4602%		IF .HASCODE(CELL) THEN BLTLINL(.CELL); ! Copy the code line

%2500%		CELL = .CELL + LINLSENT;	! Next entry
	END;	! More entries on linked list

%2500%	LINLLAST = .LINLNEXT;		! Where we end up
%2500%	BLTLINL(.CELL);			! Copy last line even if comment
%2527%	DISCARDING = 0;			! Reset so error typouts happen

	! Reached end of linked list
	TEMP = .CPREVPTR;
%2500%	UNTIL .TEMP<30,1> EQL 1
	DO REPLACEI(TEMP,0);		! Null fill after end of final line

	TEMP = .CPREVPTR<RIGHT>;	! Last used word in pool

	WHILE @@TEMP EQL 0 and .TEMP GEQ POOLBEGIN
	DO (TEMP = .TEMP - 1);		! Back over null words

	TEMP = .TEMP + 1;		! First null word
	ADJUST = .CURPOOLEND - .TEMP;	! Amount to adjust

	CURPTR = .SAVPTR - .ADJUST;	! Reset CURPTR
	CURPOOLEND = .TEMP;		! Back to null word
	(.CURPOOLEND)<FULL> = ENDBUFLAG; ! Set word to all 1's

	! Fix the pointers
	LINEPTR = .FIRSTBP(LINLCURR);
	LINELINE = .LINENUM(LINLCURR);
	CONTPTR = .FIRSTBP(CONTLCUR);
	TEMP = .CLASLPT<RIGHT>;
	CLASLPT = .FIRSTBP(CLASLCUR);
	CLASPTR = .CLASPTR + .CLASLPT<RIGHT> - .TEMP;
END;	! of DISCARD
ROUTINE BLTLINL(CELL)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Copy one source line to a place lower in the pool.
!
! FORMAL PARAMETERS:
!
!	CELL		- Index to an entry in the linked list of pooled source
!
! IMPLICIT INPUTS:
!
!	CBUFPTR		- Address of word to which the line is to be moved
!	CPREVPTR	- Pointer to last moved byte
!	LINLNEXT	- Address for next entry in source list
!
! IMPLICIT OUTPUTS:
!
!	CBUFPTR, CPREVPTR and LINLNEXT will be updated
!	The source list and its pointers will be modified
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--


%2474%	! Rewritten by AlB on 17-Oct-84

BEGIN
	MACHOP  BLT = #251;

	REGISTER
		T1,
		T2,
		TEMP;

	LOCAL ENDPTR;	! Pointer to end of this line

	IF (T2 = .LASTBP(CELL)) EQL 0
	THEN	! Unfinished line, so use end of buffer
		T2 = (.CURPOOLEND - 1)<1,7>;
	ENDPTR = .T2;

	T1 = .FIRSTBP(CELL);		! Pointer to first byte on line
	IF .T1<RIGHT> EQL .CPREVPTR<RIGHT>
	THEN	! No need to move
	BEGIN
		CBUFPTR = .T2<RIGHT> + 1;
		ADJUST = 0
	END
	ELSE
	BEGIN	! Move the line
		IF (.T1 AND #76^30) EQL 0	! If on last byte of a word,
		THEN T1<LEFT> = .T1<RIGHT>+1	!   start at next word
		ELSE T1<LEFT> = .T1<RIGHT>;	!   otherwise this is the word
		T1<RIGHT> = .CBUFPTR;		! Address of destination

		ADJUST = .T1<RIGHT> - .T1<LEFT>; ! Number of words to adjust
		T2 = .T2<RIGHT> + .ADJUST;	! Last address
		CBUFPTR = .T2 + 1;		! Next free word

		BLT(T1,0,T2);			! Move it
	END;	! Move the line

	T2 = .CPREVPTR;			! Where previous line ended
	T1 = FIRSTBP(CELL) = .FIRSTBP(CELL) + .ADJUST;	! New start pointer

	WHILE .T2 NEQ .T1		! Stash nulls from end of previous
	DO REPLACEI(T2,0);		!   line to beginning of this one

	CPREVPTR = .ENDPTR + .ADJUST;	! New end pointer
	IF .LASTBP(CELL) NEQ 0		! Reset any valid pointer to last byte
	THEN LASTBP(CELL) = .CPREVPTR;

%2500%	! Move the source list entry
%2500%	T1 = .LINLNEXT;
%2500%	IF .CELL EQL .LASTCODELINE THEN LASTCODELINE = .T1;
%2500%	IF .CELL EQL .LINLCURR THEN LINLCURR = .T1;
%2500%	IF .CELL EQL .CONTLCUR THEN CONTLCUR = .T1;
%2500%	IF .CELL EQL .CLASLCUR THEN CLASLCUR = .T1;
%2505%	IF .CELL EQL .BACKLINE THEN BACKLINE = .T1;

%2500%	T2 = LINLNEXT = .T1 + LINLSENT;
%2500%	T1<LEFT> = .CELL;
%2500%	BLT(T1,-1,T2);

END;	! of BLTLINL
GLOBAL ROUTINE SHIFTPOOL =
!++
! 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

%2500%	REGISTER  T1,T2,T3;

OWN
%2500%	LADJUST,	! Source list index adjustment value
%2500%	ADJUST;		! Pointer adjustment value
%2474%	LOCAL SAVECUR;	! Save CURPTR while printing
%2474%	LOCAL SAVELINE;	! Save LINELINE while printing	
	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;

	ADJUST _ .T1 - POOLBEGIN ;
	
%2474%	! Print any unprinted lines that will be removed
%2474%	SAVECUR = .CURPTR;
%2474%	SAVELINE = .LINELINE;
%2500%	T2 = LINLLIST<0,0>;
%2474%	WHILE .FIRSTBP(T2)<RIGHT> LSS .T1
%2474%	DO
%2474%	BEGIN
%2500%		PRINT(.T2);		! Print the lines
%2500%		T2 = .T2 + LINLSENT;	! Step to next entry
%2474%	END;

%2474%	! Fix up remainder of the linked list
%2500%	T3 = LINLLIST<0,0>;		! Where list will be moved
%2500%	LADJUST = .T2 - .T3;		! Amount to shift
%2500%	T3<LEFT> = .T2;			! Where list is now

%2500%	WHILE .T2 LEQ .LINLLAST
%2474%	DO
%2474%	BEGIN
%2474%		FIRSTBP(T2) = .FIRSTBP(T2) - .ADJUST;
%2474%		IF .LASTBP(T2) NEQ 0
%2474%		THEN LASTBP(T2) = .LASTBP(T2) - .ADJUST;
%2500%		T2 = .T2 + LINLSENT;
%2474%	END;

%2474%	! Shift source to top of pool

	T2 _ .CURPOOLEND - .T1 + POOLBEGIN ;
	T1 _ .T1^18  +  POOLBEGIN;
	BLT ( T1,-1,T2);

%2500%	! Shift source list to top of LINLLIST
%2500%	T2 = .T2 - .LADJUST;		! Where list will end, plus 1
%2500%	BLT (T3,-1,T2);			! Move it

%2500%	! Adjust indices into the source list
%2500%	IF .LASTCODELINE NEQ 0
%2500%	THEN LASTCODELINE = .LASTCODELINE - .LADJUST;
%2500%	IF .LINLCURR NEQ 0
%2500%	THEN LINLCURR = .LINLCURR - .LADJUST;
%2505%	IF .BACKLINE NEQ 0
%2505%	THEN BACKLINE = .BACKLINE - .LADJUST;
%2500%	LINLLAST = .LINLLAST - .LADJUST;
%2500%	CONTLCUR = .CONTLCUR - .LADJUST;
%2500%	CLASLCUR = .CLASLCUR - .LADJUST;

	%NOW ADJUST ALL THE LITTLE POINTERS  %
%2474%		LINELINE = .SAVELINE;
		STLPTR _ .STLPTR - .ADJUST;
%2474%		CURPTR = .SAVECUR - .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;	! of SHIFTPOOL
GLOBAL ROUTINE DECODELINE  (LINENUMB) =
!++
! TRANSLATE LINE NUMBER TO ASCII AND PLACE IN LINENO[0]
! LINENO[1] CONTAINS <TAB>0000.
!--
BEGIN
	REGISTER T1=1,T2=2,T3=3;
	LOCAL SV[3];
	% SAVE REGS %
	SV[0] _ .T1;  SV[1] _ .T2;  SV[2] _ .T3;

		T1 _ .LINENUMB;
		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 )  =
!++
! CLEAR AND PRINT THE ERROR MESSAGE QUEUE - DON'T TYPE  IF NOT .MSGTOTTY
!--

BEGIN
	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;	! of ERLSTR
GLOBAL ROUTINE PRINT(CELL) =
!++
! Formats a source line for /LISTING
!--
BEGIN

%2474%	! If the parameter CELL is non-zero, it contains a pointer to the
%2474%	! entry in the linked list of source lines.  If CELL is zero, then
%2474%	! the following globals have already been set:
	!
	! CURPTR	End of line to type
	! LINEPTR	Beginning of line to type
	! LINELINE	Line number of line to type
	! NOCR		Flag of whether a <cr> is in the line to type

	LOCAL  MSGTOTTY; 	! If 1 indicates that any error messages
				! should be typed as well as printed
	LABEL	LINEPR;


%2474%	! Don't print if the source line is in the linked list, and has
%2474%	! already been printed

%2474%	IF .CELL NEQ 0
%2474%	THEN	! Line is in linked list
%2474%	BEGIN
%2474%		IF .PRINTED(CELL)
%2474%		THEN RETURN;			! Already printed

%2474%		PRINTED(CELL) = 1;		! So we won't print it again
%2474%		LINELINE = .LINENUM(CELL);	! Line number
%2474%		LINEPTR = .FIRSTBP(CELL);	! First byte position
%2474%		CURPTR = .LASTBP(CELL);		! Last byte position
%2474%	END;

%2527%	MSGTOTTY = 0;		! Assume this
%2527%	IF (.MSGNOTYPD  OR .ERRFLAG )
%2527%	THEN IF NOT .FLGREG<TTYDEV>
%2527%	THEN IF NOT .FLGREG<NOERRORS>
	THEN	
	BEGIN	! There are error messages or lines to be output to  the
		! TTY.  Type any eariler untyped lines and current line,
		! with line numbers.
%2527%		IF NOT .DISCARDING THEN BACKTYPE ( ALLCHAR );

%2527%		MSGTOTTY = 1;
	END;

	% 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 );

%2501%	! If this is a comment line with an error, put out the error message
%2501%	IF .CELL NEQ 0
%2501%	THEN IF .ERRCOMNT(CELL) NEQ 0
%2501%	THEN WARNCOMT(.CELL);

	NOCR _ 0

END;	! of PRINT
GLOBAL ROUTINE BACKTYPE ( LINESORALL )  =
!++
! 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
!--

BEGIN

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


	IF  NOT .ERRFLAG
	THEN	
	BEGIN	% START AT THE BEGINNING OF THE LINE %
		LINE _ .ISN;	! BEGINNING LINE NUMBER
%2527%		BTPTR = LINLLIST<0,0>;	! Start at the first line
%2527%		BTPTR = .FIRSTBP(BTPTR);!  for this statement
		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>;

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

	TYPELINES:BEGIN
		% ISOLATE THE NEXT LINE %
		WHILE 1 DO
		BUFLOOP:BEGIN
%2064%			DECR I FROM .CHARLIM 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 %
GLOBAL ROUTINE BACKPRINT=

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called if a line terminator was encountered
!	during some lookahead, and no backup was required.  Since
!	the lines were not printed during the lookahead, they must be
!	printed now.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	The source line list, and the source pool.
!
! IMPLICIT OUTPUTS:
!
!	BACKLINE is reset to zero.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Source lines get printed
!
!--


%2505%	! Taken from LEXSUP.BLI and rewritten

BEGIN
	REGISTER CELL;	! Index into source list

	LOCAL  TLINE,TCUR,TPTR;

	! Save current line attributes
	TLINE = .LINELINE;
	TCUR =  .CURPTR;
	TPTR =  .LINEPTR;

	! Print the lines
	CELL = .BACKLINE;
	WHILE .CELL LSS .LINLCURR
	DO
	BEGIN
		IF NOT .PRINTED(CELL) THEN PRINT(.CELL);
		CELL = .CELL + LINLSENT;
	END;

	BACKLINE = 0;	! Nothing saved now

	! Restore line attributes
	LINELINE = .TLINE;
	CURPTR =   .TCUR;
	LINEPTR =  .TPTR;

END;	! of BACKPRINT
GLOBAL ROUTINE WRITECRLF  =
!++
! Routine to write CRLF after ^Z on the -20
!--
%1162%	 BEGIN
%1162%	 IF FTTENEX THEN
%1162%	 BEGIN
%1162%	 REGISTER R1=1,R2=2,R3=3;
%1162%	 LOCAL RSV[3];
%1162%	 MACHOP  JSYS = #104;
%1162%	 MACRO	SOUT = JSYS (0,#53) $;
%1162%	 RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3;
%1162%	 R1 _ .XDEVJFN(SRC); !SOURCE JFN
%1162%	 R2 _ UPLIT (ASCIZ '?M?J')<36,7>;      !POINT TO CR,LF
%1162%	 R3 _ 0; 	     !TERMINATE ON NULL
%1162%	 SOUT;
%1162%	 R1 _ .RSV[0]; R2 _ .RSV[1]; R3 _ .RSV[2];
%1162%	 END
%1162%	 END;	! of WRITECRLF

END  %LISTNG%
ELUDOM