Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!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: F.J. INFANTE, D. B. TOLMAN/MD/SJW/DCE/EGM/CKS/CDM/PLB/TFV/TJK/AlB/MEM

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

GLOBAL BIND INOUTV = #11^24 + 0^18 + #4527;	! Version Date: 1-Jan-86

%(

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

29	-----	-----	ADD HEADCHK TO CHECK FOR HEADINGS WHEN OUTPUTING
			INFORMATION AT THE END OF PROGRAM AND FOR MACRO LISTNG

30	-----	-----	OUTPUT CRLF FOR ERROR MESSAGES AFTER PHASE 1
			BEFORE THE MESSAGE

31	-----	-----	ROUTINE ERROR - DELETE ALL MESSAGES THAT ARE
			NOT USED ( LEAVING 4 ) 

			CHANGE THEM TO ?FTN FORMAT

			CHANGE ALL CALLS TO NEW NUMBERS

32	-----	-----	SET ERRFLAG IN FATLERR WHEN THE MESSAGE
			IS NOT PUT IN THE QUEUE.  BACKTYPE DOES THIS
			BUT SOMETIMES IT DOESNT GET CALLED, MAKING
			FOR SOME APPARRENT INCONSISTANCY

			CHANGE OUTUUO TO USE SKIP MACRO

33	-----	-----	CHANGE RELOUT TO USE OUUOBIN  FOR MORE MODULARITY
	
34	-----	-----	PUT FTTENEX I/O IN

35	-----	-----	FIXUP SOUTPUT A BIT
36	335	17377	FIX FATLERR SO THAT IT PRESERVES NAME
			AS SET BY LEXICAL., (MD)
37	467	VER5	REQUIRE FTTENX.REQ, (SJW)

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

40	573	-----	REQUIRE DBUGIT.REQ, (SJW)

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

41	657	11554	FIX /OPT/DEB FOR -20 TO GET LISTING FILE, (DCE)
42	723	-----	ADD /NOWARN: SELECTIVITY IN FATLER HANDLING, (DCE)
43	741	-----	ADD E145 WARNING MSG HANDLING, (DCE)
44	752	13736	Discard .REL file if fatal errors., (EGM)
45	766	-----	ADD E147 WARNING MSG HANDLING, (DCE)

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

46	1013	-----	If end-of-line is unexpected, get error msg right.

47	1043	EGM	19-Jan-81	20-15466
	Add mnuemonic CAO (Consec. arit ops illegal) for NOWARN selectivity

50	1061	DCE	9-Apr-81	-----
	Add PSR (Pound Sign in Random access illegal) for NOWARN selectivity

51	1066	EGM	12-May-81	Q10-05202
	Handle LINE:xxxx in error messages with just one special character (?E).
	And do not print the error line number if less than 1.

52	1115	EGM	30-Jul-81	--------
	Rewrite /NOWARN selectivity test for simplification of error addition.

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

1160	EGM	14-Jun-82
	If fatal errors, turn on global fatal errors this compile command flag
	(make edit 752 work properly).

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

53	1463	CKS	22-Jan-82
	Modify FATLERR's sixbit printer to not output trailing spaces

54	1466	CDM	1-Feb-82
	Addition of ?F to BLDMSG to type out integers without leading zeroes.

1563	PLB	18-Jun-82
	Remove REQUIRE of FTTENX since LEXAID does it for us.

1646	TFV	18-Oct-82
	Fix BLDMSG to output negative decimal numbers correctly.

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

2010	TJK	10-Oct-83	10-34235
	Have BLDMSG substitute printable characters for control
	characters and DEL.


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

2247	AlB	22-Dec-83
	Add routines CFLAGB and CFLEXB to aid in compatibility flagging

2420	TFV	9-Jul-84
	Fix flagger warnings so that  each gets printed once instead  of
	twice.  Fix the line numbers  for the warnings, they were  wrong
	and could ICE the compiler.

2455	MEM	30-Aug-84
	Replace all occurrences of VAX with VMS.

2473	CDM	29-Oct-84
	Add IMPLICIT NONE for the Military Standard MIL-STD-1753.
	Make ANSIPLIT, VMSPLIT, BOTHPLIT into GLOBAL symbols.

2474	TFV	21-Sep-84
	Removed definition of FULL macro, which has been moved to LEXAID.

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.

	Added routines WARNCOMT and ERRPRINT.

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

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

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

4513	CDM	12-Sep-85
	Improvements to /STATISTICS for reporting symbol table size
	and COMMON block size.
	Add routines GETIME, TIMEON, TIMEOFF.

4516	CDM	2-Oct-85
	Phase I.I for VMS long symbols.  Pass Sixbit to all error message
	routines, do not pass addresses of Sixbit anymore.  In later edits
	this will pass [length,,pointer to symbol] instead of a pointer to
	this to the error message routines.
	Make ?C and ?D the same in BLDMSG.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].
	Eliminate ?D in BLDMSG.

ENDV11
)%

REQUIRE DBUGIT.REQ;
REQUIRE LEXAID.BLI;
REQUIRE IOFLG.BLI;

FORWARD
	DIGITS(1),
	STRNG6(1),
	STRNG7(1),
	HEADCHK,
	HEADING,
	FATLERR(4),
	WARNERR(4),
	FATLEX(3) ,
	WARNLEX(3),
%2501%	WARNCOMT(1),
	BLDMSG(1),
%2501%	ERRPRINT,
	ERROR(2),
	OUUOLST,
	OUTSTAT(2),
	LINEOUT(2),
	CHAROUT(1),
	STRNGOUT(1),
	LSTOUT,
	OUUOBIN ,
	RELOUT,
	SOUTPUT(1),
%2247%	CLOSUP,
%2247%	CFLAGB,
%2247%	CFLEXB,
%2420%	CFLINB,
%4513%	GETIME,		! Gets run and connect time
%4513%	TIMEON,		! Turns special timing on
%4513%	TIMEOFF;	! Turns special timing off

EXTERNAL
	BACKTYPE,
	BASENO,
	CCLSW,
%4527%	CGERR,		! Internal compiler error
%4513%	CONTIME,	! Connect time from GETIME.
	CORMAN,
	ENTRY,
%2501%	E222,
%2501%	E225,
%2501%	E265,
	ERRLINK,
	ERRMSG,
	FLGWRD,
	FNDFF,
	HEADPTR,
	HEADSTR,
	INDEX,
	JOBFF,
	JOBFFSAVE,
	JOBREL,
	JOBSA,
%4513%	KEEPTIME,	! Time assigned from TIMEON.
	LEXLINE,	! Line number for first line being classified
	LEXNAME,
%2420%	LINELINE,	! Line number for line with error
	MSGNOTYPD,
	NAME,
	NOCR,
	NUMFATL,
	NUMWARN,
%1115%	NWKTB,		!NOWARN KEYWORD TABLE (SIXBIT)
%1115%	NWKTBC,		!NOWARN KEYWORD COUNT
%1115%	NWBITS,		!NOWARN OPTIONS SELECTED
	PAGE,
	PAGELINE,
	PAGEPTR,
	PROGNAME,
%4513%	RUNTIME,	! Runtime from GETIME.
	SAVSPACE,
	SEGINCORE,
%4513%	STATIME,	! Accumulated special time.
	WARMSG,
	WARNOPT,
	WOPTMSG;

OWN
%2501%	ERRNODE [ENODSIZ];	! Temporary error node

BIND
%2501%	PLITFLG=UPLIT(
%2473%	    ANSIPLIT GLOBALLY NAMES ' Extension to Fortran-77: ?0',
%2473%	    VMSPLIT GLOBALLY NAMES ' VMS incompatibility: ?0',
%2473%	    BOTHPLIT GLOBALLY NAMES ' Fortran-77 and VMS: ?0'
	    );

BIND
	BMODE=	#14,
	AMODE=	0,
	BINARYOUTP=	1^18+1^BMODE,
	ASCIIOUTP=	1^18+1^AMODE,
	ASCIIINP=	1^19+1^AMODE;

MACRO	ADVANCEN=	30,6$,
	BACKSPACEN=	24,6$,
	! FULL=		0,36$,	Removed in edit 2474
	NXT(C) =  REPLACEI ( HEADPTR, C ) $;

MACRO SKIP(OP)=
BEGIN
	VREG_1;
	OP;
	VREG_0;
	.VREG
END$,
	NOSKIP(OP)=
BEGIN
	VREG_0;
	OP;
	VREG_1;
	.VREG
END$;

MACHOP  IDIVI = #231, MOVEI = #201, ROTC = #245;

!------------------------------------------------------------------------------
!
!	ERROR(N,CHNL)=	TYPE ERROR NUMBER N USING CHNL TO SPECIFY WHICH FIELD,
!			DEVICE, FILE, OR PROJECT PROGRAMMER NUMBER TO TYPE.
!			RETURNS TO JOB STARTING ADDRESS (.JOBSA) SO THAT
!			ANOTHER COMMAND STRING MAY BE TYPED. CALLED BY I/O
!			ROUTINES TO TYPE FATAL I/O ERRORS ONLY.
!
!	GETBUF=		RETURNS NEXT CHARACTER FROM SOURCE IN VREG AND AS ITS
!			VALUE.  IF AND END OF FILE OCCURS THEN IT RETURNS EOF
!			AS ITS VALUE. IF ANY OTHER ERROR CONDITION OCCURS THE
!			ERROR ROUTINE IS CALLED TO TYPE OUT THE APPROPRIATE
!			ERROR MESSAGE.
!
!	LSTOUT=		OUTPUTS THE CONTENTS OF REGISTER C AS THE NEXT LISTING
!			CHARACTER. THE ERROR ROUTINE IS CALLED IF AN ERROR
!			OCCURS.
!
!	RELOUT=		OUTPUTS THE CONTENTS OF REGISTER C AS THE NEXT WORD OF
!			THE OBJECT FILE. THE ERROR ROUTINE IS CALLED IF AN
!			ERROR OCCURS.
!
!------------------------------------------------------------------------------

GLOBAL ROUTINE DIGITS(NUM)=
BEGIN
	LOCAL N;
	GLOBAL NUMODIG;	!USED TO COUNT UP THE DIGITS IF THE CALLER ZEROS IT
	N_.NUM MOD @BASENO;
	IF (NUM_.NUM/@BASENO) NEQ 0 THEN DIGITS(@NUM);
	NUMODIG _ .NUMODIG + 1;	!COUNT UP THE NUMBER OF DIGITS
	NXT ( .N + "0" );
	.VREG

END;	! of DIGITS

GLOBAL ROUTINE STRNG6(ST)=
!++
! Output ST, a Sixbit symbol [length,,pointer] and return the length 
! in characters
!--
BEGIN
	REGISTER T[2];


	VREG = 0;	!Count the letters in the symbol

%4527%	INCR CNT FROM 0 TO .ST<SYMLENGTH> - 1
%4527%	DO
%4527%	BEGIN	! Each word in the symbol

%4527%		T[0] = @(.ST<SYMPOINTER> + .CNT);	! CNT-th word of Sixbit

%4527%		UNTIL .T[0] EQL 0			! Stop when done
		DO
		BEGIN	! Each character

			MOVEI(T[1],0);
			ROTC(T[0],6);
			MOVEI(T[1]," ",T[1]);
			NXT( .T[1] );
			VREG=.VREG+1;			! One more letter

		END;	! Each character

%4527%	END;	! Each word in the symbol

	RETURN .VREG;	! Count of the number of letters

END;	! of STRNG6

GLOBAL ROUTINE STRNG7(ST)=
BEGIN
	REGISTER T[2];
	T[0] _ .ST;
	DO (MOVEI(T[1],0);ROTC(T[0],7);NXT( .T[1] )) UNTIL .T[0] EQL 0;
	.VREG

END;	! of STRNG7

GLOBAL ROUTINE HEADCHK=
!++
! WHEN CALLED WILL CHECK TO SEE IF THE END OF PAGE HAS BEEN REACHED AND IF
! SO PUT OUT A HEADING
!--
BEGIN	
	IF NOT .FLGREG<LISTING>  THEN  RETURN;
	IF .PAGELINE  LEQ  0
	THEN	HEADING();
	PAGELINE _ .PAGELINE -1;

END;	! of HEADCHK

GLOBAL ROUTINE HEADING=
!++
! PUT THE ROUTINE NAME AND PAGE NUMBER IN THE HEADING AND PRINT IT %
!--

BEGIN
	% PUT BLANKS IN WHERE THE NAME WILL GO %
	HEADSTR[0] _ '     ';
	HEADSTR[1]<29,7> _ " ";
	HEADPTR _ HEADSTR<36,7>;
	STRNG6( .PROGNAME );
	HEADPTR _ .PAGEPTR;
	IF .FNDFF  EQL  0
	THEN 	CHAROUT ( FF )	! OUTPUT FF IF USER DIDN'T PUT ONE IN
	ELSE	( FNDFF _ 0; PAGE<LEFT> _ .PAGE<LEFT> + 1;  PAGE<RIGHT> _ 0);	! RESET PAGE

	BASENO _ 10;
	DIGITS ( .PAGE<LEFT> );
	IF .PAGE<RIGHT>  NEQ  0
	THEN	( NXT("-");  DIGITS( .PAGE<RIGHT> ) );
	NXT("?0");

	PAGE _ .PAGE + 1;
	PAGELINE _ LINESPERPAGE - 3;

	STRNGOUT ( HEADSTR<ADRS> );	STRNGOUT( PLIT'?M?J?M?J?M?J?0');

END;	! of HEADING

GLOBAL ROUTINE FATLERR(ENT2,ENT1,LINE,ERRNUM)=
BEGIN

	% THIS ROUTINE WILL QUEUE OR PRINT THE ERROR MESSAGE DEPENDING ON THE
	  CURRENT LINE NUMBER AND THE ONE ASSOCIATED WITH THE MESSAGE.  IF THE TWO
	  NUMBERS ARE NOT EQUAL THEN THE MESSAGE IS PRINTED BECAUSE IT RELATES
	  TO SOME PREVIOUSLY UNPRINTED LINE.  IF THEY ARE EQUAL THEN IT  RELATES
	  TO THE CURRENT AND UNPRINTED LINE AND SO WILL BE QUEUED UNTIL THE LINE
	  IS PRINTED.  %
	
	% PARAMETERS:
		ENT1 - FIRST MESSAGE PARAMETER( 7BIT,6BIT , OR NUMBER)
		ENT2 - SECOND MESSAGE PARAMETER
			THE PARAMETER INDICATOR IN THE MESSAGE SKELETON
			SPECIFIES THE TYPE OF PARAMETER.
		LINE - LINE NUMBER ASSOCIATED WITH THE MESSAGE
		ERRNUM - ERROR NUMBER
		WARNFATL - IF 1 INDICATES A FATAL ERROR, 0 A WARNING
	
		NOTE THAT ONLY THE LAST THREE PARAMETERS ARE REQUIRED
	%


	REGISTER T1,
%[1115]%		T2,		!ANOTHER SCRATCH REGISTER
		 ENODE;



%[1115]%	LOCAL	ERRABREV;	!SIXBIT ERROR MNUEMONIC


	%DETERMINE IF WARNING OR FATAL ERROR %
	IF .ERRNUM<RIGHT>  LSS  WARMSG<0,0>
	THEN
	BEGIN	%WARNING%
		NUMWARN _ .NUMWARN + 1;
		IF .ERRNUM<RIGHT>  GEQ  WOPTMSG<0,0>
		THEN	WARNOPT _ -1;	!WARNING MAY AFFECT OPTIMIZED CODE
%[1115]%		!If user specified /NOWARN, may need to
%[1115]%		! suppress printing this message.
%[1115]%		IF .FLGREG<NOWARNING> THEN
%[1115]%		BEGIN
%[1115]%			!Grab first 3 characters of the
%[1115]%			! error message (mnuemonic) and
%[1115]%			! convert them to sixbit.
%[1115]%			T1 _ (ERRMSG[.ERRNUM<RIGHT>]-1)<1,7>;
%[1115]%			T2 _ (ERRABREV-1)<0,6>;
%[1115]%			ERRABREV _ 0;
%[1115]%			REPLACEI(T2,SCANI(T1)-" ");
%[1115]%			REPLACEI(T2,SCANI(T1)-" ");
%[1115]%			REPLACEI(T2,SCANI(T1)-" ");
%[1115]%
%[1115]%			!Step through the /NOWARN keyword table
%[1115]%			! starting with keyword 3 (offset 2).
%[1115]%			!If the mnuemonic for this warning matchs
%[1115]%			! a keyword, and that keyword was selected
%[1115]%			! via a /NOWARN switch, suppress the warning.
%[1115]%			!Also decrement the warn count, since
%[1115]%			! the user does not care about this situation.
%[1115]%			INCR T1 FROM 2 TO (NWKTBC-1)<0,0> DO
%[1115]%				IF .NWKTB[.T1] EQL .ERRABREV THEN
%[1115]%				IF .(NWBITS + .T1/36)<(.T1 MOD 36),1> NEQ 0
%[1115]%				THEN
%[1115]%				BEGIN
%[1115]%					NUMWARN _ .NUMWARN-1;
%[1115]%					RETURN -1
%[1115]%				END
%[1115]%		END
	END
	ELSE
	BEGIN	%FATAL%
		NUMFATL _ .NUMFATL + 1;
		FLGREG<ERRSW> _ -1
	END;

	IF .LINE EQL .LINELINE  AND .SEGINCORE EQL  1 % ALWAYS PRINT MESSAGES FOR LATER PASSES  %
	THEN	% ASSOCIATED WITH CURRENT LINE SO QUEUE IT %
	BEGIN
		LOCAL SAVNAME;	!TO SAVE NAME AS SET BY LEXICAL
		SAVNAME_.NAME;
		MSGNOTYPD _ 1;	! SET MESSAGE TO BE TYPED FLAG
		NAME<LEFT> _ ENODSIZ;
		ENODE _ CORMAN();	! GET A BLOCK OF FREE STORAGE FOR THE NODE
		NAME_.SAVNAME;	!RESTORE NAME
		% ERRLINK<RIGHT> CONTAINS A POINTER TO THE BEGINNING 
		  OF THE LIST AND .ERRLINK<LEFT> A POINTER TO THE END OF THE LIST %
		IF .ERRLINK<RIGHT>  EQL  0
		THEN	( ERRLINK<LEFT> _ .ENODE;
			  ERRLINK<RIGHT> _ .ENODE
			)
		ELSE	( ENODLINK(ERRLINK<LEFT>)  _ .ENODE;
			  ERRLINK<LEFT> _ .ENODE
			)
	END
	ELSE	% THE MESSAGE WILL BE PRINTED NOW SO JUST BUILD THE BLOCK IN TEMPORARY STORAGE%
		ENODE _ ERRNODE  ;

	%BUILD THE NODE  %
	
	EMSGNUM(ENODE) _ .ERRNUM;
	ERRTYPD(ENODE) _ 0;
	ERRLINE (ENODE) _ .LINE;
	ERRENT1(ENODE)  _ .ENT1;
	ERRENT2(ENODE)  _ .ENT2;


	IF .LINE NEQ .LINELINE  OR .SEGINCORE  NEQ  1
	THEN	% PRINT MESSAGE NOW , IT RELATES TO PREVIOUS LINE %
%2501%		ERRPRINT(.LINE);
	RETURN -1

END;	! of FATLERR

GLOBAL ROUTINE WARNERR(ENT2,ENT1,LINE,ERRNUM)=
BEGIN
	% PROCESS WARNING ERROR MESSAGE REQUESTS %

	FATLERR (.ENT2,.ENT1,.LINE,.ERRNUM )

END;	! of WARNERR

GLOBAL ROUTINE FATLEX(ENT2,ENT1,ERRNUM) =
BEGIN
	% FOR ERRORS ASSOCIATED WITH LEXEMES  %
	RETURN  FATLERR( .ENT2,.ENT1,.LEXLINE,.ERRNUM )
END;

GLOBAL ROUTINE WARNLEX(ENT2,ENT1,ERRNUM)=
BEGIN
	% FOR WARNING ERRORS ASSOCIATIED WITH LEXEMES %
	RETURN  FATLERR  ( .ENT2, .ENT1, .LEXLINE, .ERRNUM )
END;

GLOBAL ROUTINE WARNCOMT(SRCENT)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Produce a warning message for a comment line.
!	The message to be listed is encoded in the source line entry
!	for the line.
!
! FORMAL PARAMETERS:
!
!	SRCENT	- The address of the source list entry for the line
!		  containing the error.
!
! IMPLICIT INPUTS:
!
!	The source list entry.
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	An error message may be printed and/or typed.
!
!--


%2501%	!Written by AlB on 20-Nov-84

BEGIN
	REGISTER ENODE;			! Points to error node

	NUMWARN = .NUMWARN+1;		! Count it
	ENODE = ERRNODE;
	EMSGNUM(ENODE) = E265<0,0>;	! Assume this for now
	ERRTYPD(ENODE) = 0;
	ERRLINE(ENODE) = .LINENUM(SRCENT);

	CASE .ERRCOMNT(SRCENT)-1 OF	! Code for error message
	SET
		! 1 - ANSI Improper character in column 1
		ERRENT1(ENODE) = ANSIPLIT;

		! 2 - VMS Improper character in column 1
		ERRENT1(ENODE) = VMSPLIT;

		! 3 - BOTH Improper character in column 1
		ERRENT1(ENODE) = BOTHPLIT;

		! 4 - ANSI Comment on statement
		EMSGNUM(ENODE) = E222<0,0>;

		! 5 - ANSI Debug line
		EMSGNUM(ENODE) = E225<0,0>;

	TES;

	ERRPRINT(.LINENUM(SRCENT));	! Print the message

END;	! of WARNCOMT

GLOBAL ROUTINE BLDMSG(ENODE)=
BEGIN
	!BUILDS MSG POINTED TO BY EPTR AND RETURNS A POINTER TO IT

	REGISTER T[3];
	MACRO  T1=T[0]$,  T2=T[1]$,  T3=T[2]$,   C=T[2]$;
	LABEL PARAM;
	LOCAL N,EPTR;
	OWN TTYMSG[20];
	BIND TTYPTR= TTYMSG;

%1466%	ROUTINE DECOUT(NUM)=	![1466] New
%1466%	BEGIN
%1466%		REGISTER DIGIT;
%1646%		IF .NUM LSS 0
%1646%		THEN
%1646%		BEGIN	! Handle negative numbers correctly

%1646%			REPLACEI(TTYPTR,"-");
%1646%			NUM = -.NUM;
%1646%		END;

%1466%		DIGIT = .NUM MOD 10;
%1466%		IF .NUM/10 NEQ 0 THEN DECOUT(.NUM/10);
%1466%		REPLACEI(TTYPTR,.DIGIT+"0");
%1466%	END;


	EPTR _ ERRMSG[C_.EMSGNUM(ENODE)]<36,7>;	! FORM THE BYTE POINTER
	TTYPTR _ (TTYMSG+1)<8,7>;
	N _ 0;
	IF .C  LSS  WARMSG<0,0>
	THEN	TTYMSG[1] _ '%FTN'
	ELSE	TTYMSG[1] _ '??FTN';	!FATAL

	WHILE 1 DO
	PARAM:	IF (C_SCANI(EPTR)) LSS " " 
		THEN CASE .C OF SET

	%0:%	EXITLOOP;	!UNDEFINED CHARACTERS IN LAST WORD OF PLIT ARE NULLS
	%"?A":%	BEGIN	!INSERT THE RIGHTMOST FIVE DECIMAL DIGITS SUPPLIED BY 
			!THE NEXT PARAMETER WITH LEADING ZEROES

			T1_.(.ENODE<RIGHT>)[N_.N+1];T2_T3_0;
			DECR J FROM 4 TO 0 DO
			BEGIN
				MACHOP IDIVI=#231,ADDI=#271,LSHC=#246;
				IDIVI(T1,10);	!REMAINDER IN T2
				ADDI(T2,"0");	!ASCII-DIGIT_REMAINDER+"0"
				LSHC(T2,-7);	!T3<29,7>_ASCII-DIGIT
			END;
			T1_T3<36,7>;
			DECR J FROM 4 TO 0 DO COPYII (T1,TTYPTR ) ;
		END;

	%"?B":%	BEGIN	!INSERT THE ASCII STRING POINTED TO BY THE NEXT PARAMETER
			% CHECK TO SEE IF ITS A CHARACTER OR BYTE POINTER%
			IF (T2 _ ( T1 _ .(.ENODE<RIGHT>)[N_.N+1]) AND NOT #377) EQL  0
			THEN
			BEGIN	% ITS A CHARACTER %
%[1013]%			BIND  EOSLEX = 5;
				IF  .T1  LSS #200	! Is it a character?
				THEN
				BEGIN			! It is
%2010%					IF .T1 EQL #177		! Is it DEL?
%2010%					THEN
%2010%					BEGIN		! Yes, use ^?
%2010%						REPLACEI(TTYPTR,"^");
%2010%						REPLACEI(TTYPTR,"??")
%2010%					END
%2010%					ELSE IF .T1 LSS #40	! Is it a CTRL?
%2010%					THEN
%2010%					BEGIN	! Yes, use ^ representation
%2010%						REPLACEI(TTYPTR,"^");
%2010%						REPLACEI(TTYPTR,.T1 OR #100)
%2010%					END
%2010%					ELSE REPLACEI(TTYPTR,.T1); ! normal chr
%2010%
					LEAVE PARAM
				END
				ELSE	T1 _ .LEXNAME[EOSLEX];
			END;
			 T1 _ (.T1)<36,7>;
			  UNTIL(C_SCANI(T1)) EQL 0 DO  REPLACEI(TTYPTR,.C)
			END;

	%"?C":%	BEGIN	! Insert the SIXBIT name in the next parameter

%4527%			T2 = @(.ENODE<RIGHT>)[N_.N+1];	! [length,,pointer]
%4527%			T1 = .T2<SYMPOINTER>;		! Pointer to symbol
%4527%			T1 = (.T1)<SYMPRV1STCHAR>;	! BP to first char

%4527%			DECR X FROM (SIXBCHARSPERWORD * .T2<SYMLENGTH>) TO 1
			DO 
			BEGIN	! Each character in symbol

%1463%				C _ SCANI(T1)+" ";
%1463%				IF .C NEQ " " THEN REPLACEI(TTYPTR,.C);

			END	! Each character in symbol

		END;	! Insert the SIXBIT name in the next parameter

%4527%	%"?D"%	CGERR();	! Use ?C, not ?D

%[1066]% %"?E"%	BEGIN	! INSERT "Line:nnnnn" if required
%[1066]%		IF (T2_.(.ENODE<RIGHT>)[N_.N+1]) GTR 0 THEN
%[1066]%		BEGIN
%[1066]%			T1 _ (PLIT' Line:')<36,7>;
%[1066]%			UNTIL (C_SCANI(T1)) EQL 0 DO
%[1066]%				REPLACEI(TTYPTR,.C);
%[1066]%			T1_.T2;T2_T3_0;
%[1066]%			DECR J FROM 4 TO 0 DO
%[1066]%			BEGIN
%[1066]%				MACHOP IDIVI=#231,ADDI=#271,LSHC=#246;
%[1066]%				IDIVI(T1,10);	!REMAINDER IN T2
%[1066]%				ADDI(T2,"0");	!MAKE IT ASCII
%[1066]%				LSHC(T2,-7)	!T3<29,7>_ASCII-DIGIT
%[1066]%			END;
%[1066]%			T1_T3<36,7>;
%[1066]%			DECR J FROM 4 TO 0 DO COPYII (T1,TTYPTR )
%[1066]%		END;
		END;

%1466%	%"?F":%	BEGIN
%1466%			! Insert the rightmost  decimal digits supplied  by
%1466%			! the next parameter with no leading zeroes.
%1466%			DECOUT( .(.ENODE<RIGHT>)[N_.N+1] );
%1466%		END

		TES ELSE  REPLACEI(TTYPTR,.C);
	   REPLACEI(TTYPTR,CR);
	 REPLACEI(TTYPTR,LF);
	REPLACEI(TTYPTR,0);

	RETURN  (TTYMSG+1)<ADRS>;

END;	! of BLDMSG

ROUTINE ERRPRINT(LINE)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Print and/or type an error message
!
! FORMAL PARAMETERS:
!
!	LINE	- The line number for the line in error
!
! IMPLICIT INPUTS:
!
!	ERRNODE	- An error node containing info about the message to be emitted
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	An error message may be printed and/or typed.
!
!--


%2501%	! Taken from FATLERR by AlB on 20-Nov-84

BEGIN
	REGISTER ENODE;			! Points to error node

	ENODE = BLDMSG(ERRNODE);	! Build the message

	IF .FLGREG<LISTING>
	THEN
	BEGIN	! Print message on listing
		IF .SEGINCORE  NEQ  1
		THEN	! Put out CRLF after Phase 1
		BEGIN
			STRNGOUT(PLIT'?M?J');
			PAGELINE _ .PAGELINE - 1
		END;

		! NO HEADING IF WE ARE HERE TO PRINT OPTIMIZE SWITCH IGNORED
		IF .PAGELINE LEQ 0 AND .LINE NEQ -2
		THEN HEADING();

		PAGELINE _ .PAGELINE -1;
		STRNGOUT(.ENODE)
	END;	! Print message on listing

	IF NOT .FLGREG<TTYDEV> AND NOT .FLGREG<NOERRORS>
	THEN
	BEGIN	! Message to TTY
		! BE CAREFUL IF NO LINES HAVE BEEN SCANNED YET!
		IF  NOT   .ERRFLAG  AND  .SEGINCORE EQL  1
			AND .LINE NEQ -2
		THEN	! THIS IS THE FIRST ERROR IN THIS
			!  STATEMENT SO TYPE ALL LINES TO THIS POINT
			 BACKTYPE(LINESONLY);

		OUTTYX (ENODE)	! Message sent to TTY
	END;	! Message to TTY

	! NOTE THAT A MESSAGE IS GOING OUT THAT WILL NOT SHOW UP IN THE QUEUE
	ERRFLAG _ -1;

END;	! of ERRPRINT

GLOBAL ROUTINE ERROR(N,CHNL)=
BEGIN
IF NOT FTTENEX THEN
BEGIN
	REGISTER T1=1,T2=2,C=3;
	BIND	DEVMODE=PLIT(PLIT('BINARY OUTPUT'),PLIT('ASCII OUTPUT'),PLIT('ASCII INPUT'))-1;
	BIND	FIELD=PLIT(PLIT('OBJECT'),PLIT('LISTING'),PLIT('SOURCE'))-1;
%ERROR% BIND	ERRORS=PLIT(
!%0%		PLIT('I/O#0 1 FILE 2 COULD NOT BE FOUND'),
!%1%		PLIT('I/O#1 3 UFD DOES NOT EXITS'),
!%2%		PLIT('I/O#2 PROTECTION FAILUTE OR DIRECTORY FULL ON 1 DEVICE 4'),
!%3%		PLIT('I/O#3 1 FILE 2 IS BEING MODIFIED'),
!%4%		PLIT('I/O#4 ENTER FOLLOWS LOOKUP OF 1 FILE 2'),
!%5%		PLIT('I/O#5 LOOKUP FOLLOWS ENTER OF 1 FILE 2'),
!%6%		PLIT('I/O#6 DEVICE ERROR, DATA ERROR, OR DATA INCONSISTENCY IN 1 UFD'),
!%7%		PLIT('I/O#7 DSK ERROR NUMBER SEVEN'),
!%8%		PLIT('I/O#8 DSK ERROR NUMBER TEN'),	%OCTAL DISK ERRORS %
!%9%		PLIT('I/O#9 DSK ERROR NUMBER ELEVEN'),
!%10%		PLIT('I/O#10 DSK ERROR NUMBER TWELVE'),
!%11%		PLIT('I/O#11 DSK ERROR NUMBER THIRTEEN'),
!%12%		PLIT('I/O#12 1 FILE STRUCTURE 4 HAS NO ROOM OR HAS EXCEEDED ITS QUOTA'),
!%13%		PLIT('I/O#13 1 DEVICE 4 IS WRITE LOCKED'),
!%14%		PLIT('I/O#14 NOT ENOUGH TABLE SPACE IN MONITOR FREE CORE FOR 1 DEVICE 4'),
!%15%		PLIT('I/O#15 1 FILE 2 ONLY PARTIALLY ALLOCATED'),
!%16%		PLIT('I/O#16 1 FILE 2 BLOCK NOT FREE ON ALLOCATED POSITION'),
!%17%		PLIT('I/O#17 1 DEVICE 4 NOT AVAILABLE'),
%0%		PLIT('?FTNDWL 1 DEVICE 4 WRITE LOCKED'),
%1%		PLIT('?FTNHDE HARDWARE DEVICE ERROR ON 1 DEVICE 4'),
%2%		PLIT('?FTNCPE CHECKSUM OR PARITY ERROR IN 1 FILE 2'),
%3%		PLIT('?FTNQEX BLOCK TOO LARGE OR QUOTA EXCEEDED FOR 1 FILE 2'),
!%22%		PLIT('I/O#22 NOT ENOUGH ROOM IN CORE FOR COMMAND STRING'),
!%23%		PLIT('I/O#23 WILD CHARACTERS IN OUTPUT SPECIFICATION ARE NOT SUPPORTED'),
!%24%		PLIT('I/O#24 SUBFILE OUTPUT IS NOT SUPPORTED'),
!%25%		PLIT('I/O#25 1 DEVICE 4 CANNOT DO 5'),
!%26%		PLIT('I/O#26 NON-EXISTANT INPUT FILE'),
!%27%		PLIT('I/O#27 WILD CARD FEATURE FOR DECTAPE NOT SUPPORTED'),
!%28%		PLIT('I/O#28 ONLY TWO OUTPUT FILES ARE SUPPORTED'),
!%29%		PLIT('I/O#29 1 DEVICE 4 ALREADY IN USE OR DOESN''T EXIST'),
!%30%		PLIT('I/O#30 WILD EXTENSIONS IN OUTPUT SPECIFICATION ARE NOT SUPPORTED'),
!%31%		PLIT('COR#31 NOT ENOUGH CORE FOR EXPANSION, COMPILATION TERMINATED')
		);
MACHOP	CLOSE=#070,JRST=#254;
%(-----------------------------------------------------------------------------------------------------------------
	COPY THE "N"TH PLIT OF THE ERRORS PLIT INTO LINE BUFFER T, TRANSLATING
	THE DIGITS 1-5 INTO THE APPROPRIATE INFORMATION.  USE THE CHANNEL
	NUMBER TO INDICATE IN WHICH FIELD oF THE COMMAND STRING THE
	ERROR OCCURRED AND TO PICK UP THE APPROPRIATE DEVICE, FILENAME,
	ETC. FOR THIS CHANNEL.
-----------------------------------------------------------------------------------------------------------------)%
LOCAL	P1,P2,T[20]% 100 CHARACTER LINE %;
P1_(@(ERRORS+.N)-1)<1,7>;P2_T[0]<36,7>;
INCR I FROM 1 TO @P1*5 DO	!P1 POINTS INITIALLY TO THE PLIT WORD COUNT
		SELECT C_SCANI(P1) OF NSET
0:		EXITLOOP;	!UNDEFINED CHARACTERS IN LAST WORD OF PLIT ARE SET TO ZERO
"#":		(DO REPLACEI(P2,.C) UNTIL ( C_SCANI(P1)) EQL " ";REPLACEI(P2," "));
"1":		BEGIN
%SOURCE,%
%LISTING OR%		T1_(@(FIELD+.CHNL))<36,7>;
%OBJECT%		UNTIL (C_SCANI (T1)) EQL 0 DO REPLACEI(P2,.C)
		END;
"2":		BEGIN
			T1_(FILENAME(.CHNL))<36,6>;T2_6;
%FILENAME.EXTENSION%	UNTIL (T2_.T2-1) LSS 0 DO IF (C_SCANI(T1)) NEQ 0 THEN REPLACEI(P2,.C+" ");
			REPLACEI(P2,".");T2_3;
			UNTIL (T2_.T2-1) LSS 0 DO IF (C_SCANI(T1)) NEQ 0 THEN REPLACEI(P2,.C+" ")
		END;
"3":		BEGIN
			T1_(DIRECTORY(.CHNL))<36,3>;
			REPLACEI(P2,"[");T2_6;
			UNTIL (T2_.T2-1) LSS 0
%[PROJECT,PROGRAMMER]%	DO (REPLACEI(P2,SCANI(T1)+"0"));
			REPLACEI(P2,",");T2_6;
			UNTIL (T2_.T2-1) LSS 0
			DO (REPLACEI(P2,SCANI(T1)+"0"));
			REPLACEI(P2,"]")
		END;
"4":		BEGIN
			T1_(DEVICE(.CHNL))<36,6>;T2_6;
			UNTIL (T2_.T2-1) LSS 0
%DEVICE%		DO (IF (C_SCANI(T1)) EQL 0 THEN EXITLOOP ELSE REPLACEI(P2,.C+" "));
			REPLACEI(P2,":")
		END;
"5":		BEGIN
%BINARY OUTPUT,%
%ASCII OUTPUT,OR%	T1_(@(DEVMODE+.CHNL))<36,7>;
%ASCII INPUT%		UNTIL (C_SCANI(T1)) EQL 0 DO REPLACEI(P2,.C)
		END;
OTHERWISE:	REPLACEI(P2,.C)
		TESN;
		REPLACEI(P2,0);
		T1_T[0];
		OUTTYX(T1);
%[752]%		CLOSE(BIN,40);	! DISCARD .REL FILE
%[752]%		CLOSE(LST,0);CLOSE(SRC,0);
		JRST(0,.JOBSA<0,18>);
		.VREG
END
END;	! of ERROR


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

GLOBAL ROUTINE OUUOLST=
BEGIN
	% THE INDIRECT PARAMETER PASSING SIMPLIFIES THE CALL IN ITS LOOP %
	IF NOT FTTENEX
	THEN
	BEGIN
		REGISTER T1;
		MACHOP OUTUUO = #057,GETSTS = #062;

		IF SKIP(OUTUUO ( LST,0))
		THEN
		BEGIN
			GETSTS ( LST,T1 );
			OUTSTAT(LST,.T1)
		END
	END
	ELSE
	BEGIN	
		SOUTPUT( LST )
	END

END;	! of OUUOLST

GLOBAL ROUTINE OUTSTAT(DEV,STAT)=
BEGIN
	IF NOT FTTENEX THEN
	BEGIN
		! THIS ROUTINE WILL CHECK THE STATUS.  IF EVERYTHING IS ALRIGHT
		! IT WILL RETURN. THERE ARE ERRORS SO CHECK THE STATUS.

		IF .STAT<IOBKTL>
		THEN ERROR(3,.DEV)
		ELSE IF .STAT<IODTER>
		THEN ERROR(2,.DEV)
		ELSE IF .STAT<IODERR>
		THEN ERROR(1,.DEV)
		ELSE IF .STAT<IOIMPM>
		THEN ERROR(0,.DEV);

	END

END;	! of OUTSTAT

GLOBAL ROUTINE LINEOUT(BEGPTR,ENDPTR)=
BEGIN
	% THIS ROUTINE WILL TRANSFER THE ASCII STRING FROM
	  BEGPTR + 1  TO ENDPTR TO THE LST OUTPUT DEVICE   %

	MACRO  P = 30,6  $;

	DECR I FROM (.ENDPTR<RIGHT> - .BEGPTR<RIGHT> ) * 5
		+ ((.BEGPTR<P> - .ENDPTR<P>) / 7 ) -1
		TO 0  BY  1
	DO  BEGIN
		% CHECK TO SEE IF THE BUFFER IS FULL %
		IF (BUFCNT(LST) _ .BUFCNT(LST) -1 ) LEQ  0  THEN  OUUOLST()  ;
		% COPY THE NEXT CHARACTER %
		COPYII ( BEGPTR, BUFPNT(LST) );
	END;

	% DEBUGGING CODE %
	IF DBUGIT
	THEN
	BEGIN	% OUTPUT THE BUFFER IMMEDIATELY SO
		  YOU CAN SEE EXACTLY WHAT IS HAPPENTING
		  ON THE TTY  %
		REGISTER T1;
		IF ( T1 _ .BUGOUT AND 1 ) NEQ 0
		THEN
		BEGIN
			OUUOLST();
			BUFCNT(LST)_.BUFCNT(LST)+1
		END;
		% NOTE IF A LINE IS TERMINATED BY FF THIS WILL CAUSE
		  AN EXTRA FF IN LISTING %
	END;

END;	! of LINEOUT

GLOBAL ROUTINE CHAROUT(CHAR)=
BEGIN
	% OUTPUT ONE CHARACTER TO DEVICE LST  %
	IF (BUFCNT(LST) _ .BUFCNT(LST) -1 )  LEQ  0  THEN  OUUOLST();
	REPLACEI ( BUFPNT(LST),.CHAR);

	% DEBUGGING CODE %
	IF DBUGIT
	THEN
	BEGIN	% OUTPUT THE BUFFER IMMEDIATELY SO
			  YOU CAN SEE EXACTLY WHAT IS HAPPENTING
			  ON THE TTY  %
		REGISTER T1;
		IF ( T1 _ .BUGOUT AND 1 ) NEQ 0
		THEN
		BEGIN
			OUUOLST();
			BUFCNT(LST)_.BUFCNT(LST)+1
		END;
		% NOTE IF A LINE IS TERMINATED BY FF THIS WILL CAUSE
		  AN EXTRA FF IN LISTING %
	END;

END;	! of CHAROUT

GLOBAL ROUTINE STRNGOUT(PTR)=
BEGIN
	% THIS ROUTINE WILL OUTPUT A STRING OF CHARACTERS OF THE BYTE
	  SIZE SPECIFIED IN PTR<P> UNTIL A 0 CHARACTER IS ENCOUNTERED   %

	MACRO  S = 24,6  $;
	REGISTER T1;

	IF .PTR<S>  NEQ  7
	THEN	PTR<LEFT> _ #440700;	! FORM BYTE POINTER

	UNTIL ( T1 _ SCANI(PTR) )  EQL  0
	DO
	BEGIN
		IF (BUFCNT(LST) _ .BUFCNT(LST)-1)  LEQ 0
		THEN  OUUOLST ();
		REPLACEI (BUFPNT(LST),.T1)
	END;

	% DEBUGGING CODE %
	IF DBUGIT
	THEN
	BEGIN	% OUTPUT THE BUFFER IMMEDIATELY SO
			  YOU CAN SEE EXACTLY WHAT IS HAPPENTING
			  ON THE TTY  %
		REGISTER T1;
		IF ( T1 _ .BUGOUT AND 1 ) NEQ 0
		THEN
		BEGIN
			OUUOLST();
			BUFCNT(LST)_.BUFCNT(LST)+1
		END;
		% NOTE IF A LINE IS TERMINATED BY FF THIS WILL CAUSE
		  AN EXTRA FF IN LISTING %
	END;

END;	! of STRNGOUT

GLOBAL ROUTINE LSTOUT=
BEGIN
	REGISTER C=3;
	RETURN  CHAROUT(.C)
END;

GLOBAL ROUTINE OUUOBIN =
BEGIN
	% THE INDIRECT PARAMETER PASSING SIMPLIFIES THE CALL IN ITS LOOP %
	IF NOT FTTENEX
	THEN
	BEGIN
		REGISTER T1;
		MACHOP OUTUUO = #057,GETSTS = #062;
		
		IF SKIP(OUTUUO ( BIN,0))
		THEN
		BEGIN
			GETSTS ( BIN,T1 );
			OUTSTAT(BIN,.T1)
		END
	END
	ELSE
	BEGIN
		SOUTPUT( BIN )
	END

END;	! of OUUOBIN

GLOBAL ROUTINE RELOUT=
BEGIN
	REGISTER C=3;
	MACHOP	OUTUUO=#057;
	IF (BUFCNT(BIN)_.BUFCNT(BIN)-1) LEQ 0 THEN OUUOBIN();
	 REPLACEI(BUFPNT(BIN),.C);
	.VREG

END;	! of RELOUT

GLOBAL ROUTINE SOUTPUT(DEV)=
BEGIN

	IF  FTTENEX  
	THEN
	BEGIN

		LOCAL RSV[3];
		REGISTER R1=1,R2=2,R3=3;
		MACHOP  JSYS = #104;
		MACRO	SOUT = JSYS(0,#53) $;

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

		R1 _ .XDEVJFN( .DEV );	!JFN

		IF .DEV EQL BIN
		THEN
		BEGIN	%SET UP FOR BINARY%
			R3 _ - ( .BUFPNT(BIN)<RIGHT>  - .BUFFERS(BIN)<RIGHT> + 1 );	!SIZE
			BUFPNT(BIN) _ R2 _ (.BUFFERS(BIN)<RIGHT>)<36,36>;	!INITIAL POINTER
			BUFCNT(BIN) _ XSOUTSIZ;	!RESTORE COUNT
		END
		ELSE
		BEGIN	%SET UP FOR LISTING%
			%NULL FILL%
			(.BUFPNT(LST)<RIGHT>)<0,.BUFPNT(LST)<30,6>> _ 0;
			R3 _ - ( .BUFPNT(LST)<RIGHT>  - .BUFFERS(LST)<RIGHT> + 1 ) * 5 ;	!SIZE
			BUFPNT(LST) _ R2 _ (.BUFFERS(LST)<RIGHT>)<36,7>;	!INITIAL POINTER
			BUFCNT(LST) _ XSOUTSIZ * 5 ;	!RESTORE COUNT
		END;
		SOUT;
		R1_.RSV[0];R2_.RSV[1];R3_.RSV[2];
	END

END;	! of SOUTPUT

GLOBAL ROUTINE CLOSUP =
BEGIN

	IF FTTENEX 
	THEN
	BEGIN

		REGISTER R1 =1;
		MACHOP  JSYS = #104, JFCL =#255 ;
		MACRO  CLOSF = JSYS(0,#22)  $;
		LOCAL RSAV;

		RSAV _ .R1;

		IF .FLGREG<LISTING>
		THEN
		BEGIN
			SOUTPUT( LST );
			R1 _ .XDEVJFN(LST);
			CLOSF;
			JFCL (0,0);
		END;

		IF .FLGREG<OBJECT>
		THEN
		BEGIN
%[752]%			BIND CLOSEABORT = #4000000000;	! CZ%ABT CLOSE ABORT
%[1160]%		IF .FLAGS2<FTLCOM> EQL 0	! Fatal compile errors?
%[752]%			THEN
%[752]%			BEGIN				! NONE
%[752]%				SOUTPUT (BIN);
%[752]%				R1 _ 0			! NO CLOSF BITS
%[752]%			END
%[752]%			ELSE				! ERRORS
%[752]%				R1 _ CLOSEABORT;	! SET ABORT BIT
%[752]%			R1<RIGHT> _ .XDEVJFN(BIN);	! SET JFN
			CLOSF;
			JFCL(0,0);
		END;

		IF .FLGREG<ININCLUD>
		THEN
		BEGIN
			R1 _ .XDEVJFN(ICL);
			CLOSF;
			JFCL(0,0);
		END;

		R1 _ .XDEVJFN(SRC);
		CLOSF;
		JFCL(0,0);

		R1 _ .RSAV;
	END

END;	! of CLOSUP

!******************************************************************************
! Routines for putting out flagger warning messages	[2247]
!

! CFLAGB, CFLEXB and CFLINB put out Flagger warning for either or both of
!	/FLAG:VMS and /FLAG:STANDARD
! It is expected that either FLAGANSI or FLAGVMS is on.
!
! If both flags are on, the prefix will be BOTHPLIT
! If only VMS is on, the prefix will be VMSPLIT
! If VMS is off (i.e. STANDARD is on), the prefix will be ANSIPLIT

! The parameters are:
!	X -- An optional argument to be inserted into error message
!	ERRNUM -- The address of the error message

!Used outside of syntax phase
GLOBAL ROUTINE CFLAGB (X, ERRNUM) =
BEGIN
	EXTERNAL ISN;	!The line number to which we attach the message

%2455%	IF FLAGVMS
	THEN
		IF FLAGANSI
		THEN FATLERR(.X,BOTHPLIT<0,0>,.ISN,.ERRNUM)
		ELSE FATLERR(.X,VMSPLIT<0,0>,.ISN,.ERRNUM)
	ELSE
		FATLERR(.X,ANSIPLIT<0,0>,.ISN,.ERRNUM)
END; ! of CFLAGB

! Either or both for syntax
GLOBAL ROUTINE CFLEXB (X, ERRNUM) =
BEGIN
	EXTERNAL LEXLINE;	!The line number to which we attach the message

%2455%	IF FLAGVMS
	THEN
		IF FLAGANSI
		THEN FATLERR(.X,BOTHPLIT<0,0>,.LEXLINE,.ERRNUM)
%2455%		ELSE FATLERR(.X,VMSPLIT<0,0>,.LEXLINE,.ERRNUM)
	ELSE
		FATLERR(.X,ANSIPLIT<0,0>,.LEXLINE,.ERRNUM)
END; ! of CFLEXB

! Either or both for syntax

GLOBAL ROUTINE CFLINB(X, ERRNUM)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Puts out Flagger warning for either or both of:
!		/FLAG:VMS and /FLAG:STANDARD
! 	It is expected that either FLAGANSI or FLAGVMS is on.
!
!	If both flags are on, the prefix will be BOTHPLIT
!	If only VMS is on, the prefix will be VMSPLIT
!	If only STANDARD is on, the prefix will be ANSIPLIT
!
! FORMAL PARAMETERS:
!
!	X	optional argument to be inserted into error message
!	ERRNUM	address of the error message
!
! IMPLICIT INPUTS:
!
!	LINELINE	line number for the line containing the error
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Outputs a warning message to the terminal and listing.
!
!--


![2420] New

BEGIN

	EXTERNAL LINELINE;	!The line number to which we attach the message

%2455%	IF FLAGVMS
	THEN
		IF FLAGANSI
		THEN FATLERR(.X,BOTHPLIT<0,0>,.LINELINE,.ERRNUM)
		ELSE FATLERR(.X,VMSPLIT<0,0>,.LINELINE,.ERRNUM)
	ELSE
		FATLERR(.X,ANSIPLIT<0,0>,.LINELINE,.ERRNUM)

END; ! of CFLINB

GLOBAL ROUTINE GETIME=	![4513] New
!++
! FUNCTIONAL DESCRIPTION:
!
!	Gets runtime and connect time since beginning of compilation.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	RUNTIME		The run time of Fortran for the program unit.
!
!	CONTIME		The connect time of Fortran for the program unit.
!
! ROUTINE VALUE:
!
!	None, Returned in globals.
!
! SIDE EFFECTS:
!
!	None
!
!--


BEGIN

REGISTER
	AC1=1,		! Registers needed for JSYS calls
	AC2=2,		! Registers needed for JSYS calls
	AC3=3,		! Registers needed for JSYS calls
	NUM;		! Registers needed for JSYS/CALLI calls

LOCAL
	RSV[3];		! Place to save AC's 1 through 3.

MACHOP	CALLI=#047,		! TOPS-10 CALLI
	JSYS=#104;		! TOPS-20 JSYS


	NUM _ 0;
	IF FTTENEX
	THEN
	BEGIN	! TOPS-20

		RSV[0] = .AC1;	! Save AC1
		RSV[1] = .AC2;	! Save AC2
		RSV[2] = .AC3;	! Save AC3

		AC1 = #400000;	! Fork is .FHSLF
		JSYS(0,#15);	! RUNTM JSYS

		RUNTIME = .AC1;	! Run time is in AC1
		CONTIME = .AC3;	! Connect time is in AC3

		AC1 = .RSV[0];	! Restore AC1
		AC2 = .RSV[1];	! Restore AC2
		AC3 = .RSV[2];	! Restore AC3

	END	! TOPS-20
	ELSE
	BEGIN	! TOPS-10

		RUNTIME = CALLI(NUM,#27);	! RUNTIM UUO for TOPS-10
		CONTIME = CALLI(NUM,#23);	! MSTIME UUO for TOPS-10

	END;	! TOPS-10

END;	! of GETIME

GLOBAL ROUTINE TIMEON=	![4513] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	Turns on special timing.  This time is reported /STATISTICS.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	KEEPTIME	The runtime kept for the beginning of the
!			special timing.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--


BEGIN
	GETIME();		! Get the run time.
	KEEPTIME = .RUNTIME;	! Keep the run time.

END;	! of TIMEON

GLOBAL ROUTINE TIMEOFF=	![4513] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	Turns off the special timing.  Reported /STATISTICS.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	KEEPTIME	The runtime kept for the beginning of the
!			special timing.
!
! IMPLICIT OUTPUTS:
!
!	KEEPTIME	The runtime kept for the beginning of the
!			special timing.
!
!	STATIME		The accumilated special run time.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--


BEGIN

	GETIME();					! Get run time
	STATIME = .STATIME + (.RUNTIME - .KEEPTIME);	! Accumilated
							! special timing

END;	! of TIMEOFF

END
ELUDOM