Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - main.bli
There are 13 other files named main.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 1985
!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. INFANTE /FI /HPW /DBT/SJW/EGM/SRM/PLB/TFV/CDM/TJK

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

GLOBAL BIND MAINV = #10^24 + 0^18 + #2512;	 ! Version Date: 7-Jan-85

%(

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

24	-----	-----	CHANGE THE GETSEGMENT CODE INTO A ROUTINE.
			ADD ROUTNINE NXFILG WHICH WHEN CALLED FROM
			PHAZ1, WILL GET FORTRA AND THEN CALL NXTFIL TO
			OPEN THE NEXT INPUT FILE.  IT THEN RETURNS TO
			PHAZ1.  THIS ALLOWS PHZA1 TO CONCATINATE
			INPUT FILES IF THE USER DESIRES.

25	-----	-----	SAVE STACK POINTERS BEFORE CALL TO MRP1 SO
			THAT IF A RETURN TO MRP1 IS NOT NECESSARY ONE
			CAN RETURN DIRECTLY TO COMMAN
26	-----	-----	ADD CODE TO PRINT OUT END OF PROGRAM AND END
			OF COMPILATION MESSAGES WHEN THE RETURN TO PHAZ1
			IS SKIPPED.
27	-----	-----	OUTPUT ERROR CODE FOR GETSEG FAILURES
28	-----	-----	REMOVE FT1SEQ SWITCH SETTING - NOW FROM IOFLG
29	467	VER5	REMOVE 28: REQUIRE FT1SEG.REQ

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

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

31	1117	EGM	26-Aug-81	--------
	Remove restriction that high segs start at 400010.

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

32	1460	SRM	18-Jan-82
	If character data is used, do not optimize.
	( This restriction will be removed later. )

33	1500	SRM	11-Feb-82
	Do not give the CHO warning message here. Instead wait until
	get into FORTC to issues the message. This is necessary
	because on the -10 this module is loaded with every overlay.
	If an error message is given from this module, that message
	must go into every overlay's error file or the -10 build
	will not complete successfully.

1600	PLB	21-Jun-82
	Remove unused routine SIXBOUT created in edit 1047.  Removed
	during TOPS-20 nativization since it contained an OUTCHR.

1633	TFV	1-Sep-82
	Improve /STATISTICS to get times by compiler phase.

1650	CDM	18-Oct-82
	Install copyright notice into compiler memory image.

1710	CDM	6-Jan-83
	Update compiler memory image copyright notice.

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

1725	TFV	3-Feb-83
	Add FORLINK linkage to  statistics routines PHASBEGIN,  PHASEND,
	and RNTIME.  This cures the execute only problem on the -10.

2053	CDM	2-May-84
	Update copyright notice.


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

2403	TJK	20-Jun-84
	Turn the optimizer on when character data is present.

2512	CDM	7-Jan-85
	Update copyright notice.

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

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

)%

%1650%	! Copyright notice for  this compiler.  This  will apear in  the
%1650%	! memory image and the .EXE files.
%1650%
%2512%	GLOBAL BIND COPYRIGHT = UPLIT(ASCIZ '?M?J?M?JCOPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1985?M?JALL RIGHTS RESERVED.?M?J?M?J');


%1633%	REQUIRE  FTTENX.REQ;	! needed for /STATISTICS

REQUIRE  FT1SEG.REQ;
REQUIRE  IOFLG.BLI;

LINKAGE  FORLINK = ENTXIT (FORI,FORO);

FORWARD
	NXFILG,
	GETSG,
%1633%	PHASBEGIN,	! Start timer for this phase
%1633%	PHASEND,	! Collect phase time
%1633%	RNTIME;		! Returns runtime

REGISTER
	T1=1,
	T2=2,
	C=3;

EXTERNAL
	AHEAD,
%1460%	CHARUSED,
%1633%	PBTIME,		! Runtime at the beginning of this phase
%1633%	PHTIME,		! Vector of runtimes per phase
	SAVE17,
%1633%	SEGINCORE,	! Current phase
	TTCHAR,
	ZMAKEX;


OWN SVV17,SVV16;	!LOCATIONS TO SAVE THE STACK POINTERS INORDER TO
			!SKIP THE RETURN TO MRP1 IF NOT NECESSARY

MACHOP TTCALL =#051, CALLI = #047, TDZA = #634,JFCL = #255;
!********************************************************************
!THESE TWO SETS OF BINDS GO TOGETHER AND ESTABLISH THE CORRESPONDENCE
!BETWEEN THE NAMES OF THE PHASES AND THE NAMES OF THE
!SEGMENTS FOR THE GETSEG UUO.

BIND PHAZNAME = PLIT(SIXBIT'FORTRA',	!P0-0 COMMAND SCANNER
		     SIXBIT'FORTB',	!P1-1 SYNTAX +LEXICAL+SEMANTICS
		     SIXBIT'FORTC',	!P2S-3 PHAZ2 SKELETON
		     SIXBIT'FORTD',	!P2-2 OPTIMIZER
		     SIXBIT'FORTE',	!P3G-4 GLOBAL OPT REGISTER ALLOCATOR
		     SIXBIT'FORTF',	!P3R-5 LOCAL REGISTER ALLOCATOR
		     SIXBIT'FORTG')	!P3-6 CODE GENERATOR
		     ;
BIND PNAMES = PLIT(PLIT ASCIZ'FORTRA',	!P0-0 COMMAND SCANNER
		     PLIT ASCIZ'FORTB',	!P1-1 SYNTAX +LEXICAL+SEMANTICS
		     PLIT ASCIZ'FORTC',	!P2S-3 PHAZ2 SKELETON
		     PLIT ASCIZ'FORTD',	!P2-2 OPTIMIZER
		     PLIT ASCIZ'FORTE',	!P3G-4 GLOBAL OPT REGISTER ALLOCATOR
		     PLIT ASCIZ'FORTF',	!P3R-5 LOCAL REGISTER ALLOCATOR
		     PLIT ASCIZ'FORTG')	!P3-6 CODE GENERATOR
		     ;
BIND	P0=0,
	P1=1,
	P2S=2,
	P2=3,
	P3G=4,
	P3R=5,
	P3=6;

!*********************************************************************
MACRO	SERRORS = FLGREG<1,1>$,
	SSYNTAX = FLGREG<20,1>$,
	SOPTIMIZ= FLGREG<0,1>$,
	SAVREGS = BEGIN
			REGSAV[15] _ .(#17)<0,36>;
			#17<0,36> _ REGSAV<0,0>;
			BLT(#17,REGSAV[14])
		  END$,
	RESREGS = BEGIN
			#17<0,36> _ (REGSAV<0,0>)^18;
			BLT(#17,#17)
		   END$;

EXTERNAL  NUMFATL,NUMWARN;	!FATAL AND WARNING ERROR COUNTS
EXTERNAL REGSAV[16],	!FOR SAVING REGISTERS FOR GETSEG
	 ENTRY,
	 ERROUT,
	 SEGINCORE,	!HOLDS CURRENT IN CORE SEGMENT NUMBER
	 GETSBLOK[6];	!THE GETSEG DATA BLOCK
!
EXTERNAL JOBSA;
!
%[1117]% EXTERNAL HISEG; ! Common high seg entry point
!
EXTERNAL MRP0,		!PHAZE 0 MAIN ROUTINE
	 MRP1,		!PHAZE 1 MAIN ROUTINE
	 MRP2S,		!PHAZE 2S MAIN ROUTINE
	 MRP2,		!PHAZE 2 MAIN ROUTINE
	 MRP3R,		!PHAZE 3R MAIN ROUTINE
	 MRP3G,		!PHAZE 3G MAIN ROUTINE
	 MRP3;		!PHAZE 3 MAIN ROUTINE
!
MACRO REED =(TTCALL(4,VREG); .VREG)$;
!
!THE FOLLOWING ROUTINE CONTROLS THE COMPILATION PROCESS FROM ONE PHASE TO THE NEXT
!EACH PHASE, WHEN IT FINISHED ALL IT CAN DO TO THE PROGRAM,CALLS THE
!NEXT PHASE OF THE COMPILER BY RETURNING TO THE ROUTINE PHAZCONTROL
!WITH THE PHASE NUMBER OF ITSELF IN THE GLOBAL
!VARIABLE SEGINCORE. FOR EXAMPLE IF WE ARE IN PHASE 1 SYNTAX THEN TO
!CALL THE NEXT PHASE:   SEGINCORE _ 1;  PHAZCONTROL();
!IF THE GETSEG FOR THE NEXT PHASE IS COMPLETED THEN
!THE NEXT PHASE WILL BEGIN EXECUTING. THE CALLING ROUTINE SHOULD
!NOT CALL THE NEXT PHASE IF IT HAS ENCOUNTERED ERRORS IN THE PROGRAM
!WHILE PERFORMING ITS TASK. THUS, PHASE 1 SHOULD NOT
!CALL THE NEXT PHASE IF THERE ARE SYNTAX ERRORS OR IF ONLY SYNTAX
!CHECKING WAS REQUESTED BY THE USER.
%[1047]% ROUTINE FORLINK PHAZCONTROL=	!CONTROLS THE CALLING OF THE COMPILER SEGMENTS
BEGIN
	EXTERNAL CTCSTART,CCLSW;
	BIND JOBSYM = #116, JOBUSY = #117;
%1460%	EXTERNAL TURNOFFOPT;	!Flag for /OPT turned off for 1 subroutine
				! because it had character data
	MACRO TPHAZ = T1$;

%1633%	PHASEND();	! Collect time for this phase

WHILE 1 DO
   BEGIN
	CASE .SEGINCORE OF SET

	%(IN PHASE 0)%		!GET PHASE 1 SYNTAX
	BEGIN	! In phase 0
		IF FT1SEG EQL 0
		THEN
		BEGIN	! Multi-segment compiler
			JOBSYM<0,36> _ 0;
			JOBUSY<0,36> _ 0;
		END;	! Multi-segment compiler
		TPHAZ _ P1;
	END;	! In phase 0

	%(IN PHASE 1)%
	BEGIN	! In phase 1
		IF FT1SEG EQL 0
		THEN
		BEGIN	!Multi-segment Compiler
			JOBSYM<0,36> _ 0;
			JOBUSY<0,36> _ 0;	!CLEARING BAD DDT INFORMATION
		END;	!Multi-segment compiler

%1460%		IF .SOPTIMIZ
%1460%		THEN
%1460%		BEGIN	!/OPT was specified
![2403] Turn optimizer on when character data is present
!%1460%			! Ignore /OPT for subprograms that use character data 
!%1460%			IF .CHARUSED
!%1460%			THEN
!%1460%			BEGIN	! Turn-off-OPT	
!%1500%
!%1460%				! Turn off the /OPT flag but remember that
!%1460%				!  have done so
!%1500%				!  (Note that warning message that this
!%1500%				!  has occurred will be given from MRP2S)
!
!%1460%				TURNOFFOPT = -1;
!%1460%				SOPTIMIZ = 0;
!%1460%
!%1460%				TPHAZ _ P2S;
!%1460%			END	!Turn-off-OPT
!%1460%			ELSE
%1460%			TPHAZ _ P2;
%1460%		END	!/OPT was specified
%1460%		ELSE	!/OPT was not specified
%1460%		TPHAZ_P2S;
	END;	! In phase 1

	%(IN PHASE 2S)%
	TPHAZ _ P3R;

	%(IN PHASE 2)%
	TPHAZ _ P3G;

	%(IN PHASE 3G)%
	TPHAZ _ P3;

	%(IN PHASE 3R)%
	TPHAZ _ P3;

	%(IN PHASE 3)%
%1460%	BEGIN	!In P3
%1460%
![2403] Turn optimizer on when character data is present
!%1460%		!If turned off /OPT, turn it on again
!%1460%		IF .TURNOFFOPT
!%1460%		THEN
!%1460%		BEGIN
!%1460%			TURNOFFOPT = 0;
!%1460%			SOPTIMIZ = 1;
!%1460%		END;
%1460%
%1460%		TPHAZ _ P1;
%1460%	END;	!In P3

	%(IN PHASE 1 AND RETURNING TO PHASE 0)%
	TPHAZ _ P0;

	%(CALL FROM CTCSTART)%
	TPHAZ _ P0

	TES;

	%CHECK FOR RETURN TO MRP1 - RETURN TO COMMAN IF ITS NOT
	  NECESSARY  %
	IF .SEGINCORE EQL P3
	THEN
	BEGIN	% WE SHOULD RETURN TO MRP1%
		IF    .FLGREG<ENDFILE>
		THEN
		BEGIN	%SKIP THE RETURN%
			EXTERNAL  ENDUNIT;

			SREG _ .SVV17;
			FREG _ .SVV16;
%[1047]%		IF FT1SEG EQL 0
%[1047]%		THEN GETSG(P0)	! Get the segment
%[1047]%		ELSE GETSBLOK[1] _ .PHAZNAME[P0]; ! Remember the name
			SEGINCORE _ P0;

			ENDUNIT();	!OUTPUT END OF PROG UNIT MESAGE

%1633%			PHASBEGIN();	! Start clock for this phase

			RETURN
		END
		ELSE
		BEGIN	%RETURN TO MRP1%
%[1047]%		IF FT1SEG EQL 0
%[1047]%		THEN GETSG(P1)	! Get the segment
%[1047]%		ELSE GETSBLOK[1] _ .PHAZNAME[P1]; ! Remember the name
			SEGINCORE _ P1;
%1633%			PHASBEGIN();	! Start clock for this phase
			RETURN
		END
	END;
!
! DO GETSEG IF MULTI-SEGMENT COMPILER
!
![1047] Get the segment (if multi-seg) and always remember the segment name
%[1047]% IF FT1SEG EQL 0 THEN GETSG(.TPHAZ) ELSE GETSBLOK[1]_.PHAZNAME[.TPHAZ];

!
	JOBSA<0,18> _ CTCSTART<0,0>;
		!FOR ^C .START EVENTUALITY
	%CHECK FOR RETURN TO COMMAN%
	IF .SEGINCORE EQL (P3+1)
	THEN
	BEGIN
		SEGINCORE _ 0;
%1633%		PHASBEGIN();	! Start clock for this phase
		RETURN
	END;

	SEGINCORE _ .TPHAZ;
	IF .TPHAZ EQL  P1
	THEN	%SAVE STACK% ( SVV17 _ .SREG; SVV16 _ .FREG);

%1633%	PHASBEGIN();	! Start clock for this phase

!
! START THE NEXT SEGMENT
!
IF FT1SEG EQL 0 THEN			!MULTI SEGMENT START
%[1117]%	HISEG()			!Start the next phase
		ELSE			!SINGLE SEGMENT START
	CASE .TPHAZ OF SET		!CALL MAIN ROUTINE
	MRP0();				!PHAZE 0
	MRP1();				!PHAZE 1
	MRP2S();			!PHAZE 2S
	(SAVE17_.SREG<0,36>+#1000001;MRP2());	!PHAZE 2
	MRP3G();			!PHAZE 3G
	MRP3R();			!PHAZE 3R
	MRP3()				!PHAZE 3
	TES;
!

%1633%	PHASEND();	! Collect time for this phase

   IF .SEGINCORE EQL P1 THEN SEGINCORE _ (P3+1) !DO THIS ONLY IF A RETURN TO THE COMMAND SCANNER IS NEEDED
   ELSE
   %QUIT IF ERRORS WERE DETECTED%
	IF .NUMFATL  NEQ  0  THEN  SEGINCORE _ P3;
!
!PHASES 2,2S AND 3 ALL RETURN HERE AFTER COMPLETING THEIR COMPUTATIONS
!THEY DO NOT CALL PHAZCONTRO DIRECTLY BUT MERELY FALL BACK (POPJ 17,0)
!SINCE THEY WERE CALLED BY PHAZCONTROL ITSELF
!ONLY PHASE0 AND PHASE1 CALL THE NEXT PHASES BY DIRECT CALL TO PHAZCONTROL
!
   END	!0F WHILE 1 DO
END;

%[1047]% ROUTINE FORLINK GETSG( TPHAZ ) =

BEGIN

IF FT1SEG EQL 0 THEN
BEGIN
	!THE REST OF THE GETSEG ARGS ARE SET IN MODULE COMND
	GETSBLOK[1] _ .PHAZNAME[.TPHAZ];
	!FIRST LET'S GET RID OF THE UNWANTED HISEG
	!
	VREG _ 1^18;
	CALLI(VREG,#11);	!CORE UUO TO DELETE THE HISEG
	JFCL(0,0);
	!NOW LET'S DO THE GETSEG
	!FIRST WE MUST SAVE ALL REGISTERS
	SAVREGS;

	!NOW LET'S TRY THE GETSEG
	VREG_GETSBLOK<0,0>;	!START ADDRESS OF GETSEG BLOCK
	CALLI(VREG,#40);	!GET THE SEGMENT
	TDZA(T2,T2);		!T2 FALSE IF GETSEG FAILS
	T2_1;			!T2 TRUE IF GETSEG SUCCEEDS

	!IN EITHER CASE, WE MUST! RESTORE ACS BEFORE TRYING ANYTHING FANCE
	IF .T2 THEN RESREGS
		ELSE		!TYPE OUT AN ERROR MESSAGE AND EXIT
		  !NOTE THAT WE TYPE OUT THE MESSAGE OURSELVES RIGHT
		  !HERE RATHER THAN CALLING ROUTINE ERROUT.  WE DO THIS
		  !BECAUSE IT IS POSSIBLE FOR A GETSEG TO FAIL IN SUCH
		  !A MANNER THAT NO VALID HIGH SEGMENT WILL BE AVAILABLE.
		  !SINCE ERROUT LIVES IN THE HIGH SEGS, WE MIGHT NOT
		  !BE ABLE TO ACCESS IT; SO WE OUTPUT THE ERROR MESSAGE
		  !FROM HERE VIA TTCALL.
		  BEGIN
			%SAVE ERROR CODE%
			GETSBLOK[5] _ 0;
			GETSBLOK[5]<29,7> _ .VREG<3,3> + "0";
			GETSBLOK[5]<22,7> _ .VREG<0,3> + "0";
		    RESREGS;
		    TTCALL(3,PLIT ASCIZ '??FTNNGS - CANNOT GET SEGMENT ');
			TTCALL(3,.PNAMES[.TPHAZ]);
			TTCALL(3,PLIT' - ERROR CODE:?0');
			TTCALL(3,GETSBLOK[5]);
		    TTCALL(3,PLIT ASCIZ '?M?J');
		    CALLI (1,#12)		!DON'T DESTROY OLD FILES

		  END;
END;					!END OF FT1SEG CONDITIONAL
END;	!GETSG

%[1047]% GLOBAL ROUTINE FORLINK NXFILG =
BEGIN
	% THIS ROUTINE WILL GET FORTRA BACK AND REQUEST THE NEXT INPUT
	  FILE FROM IT AND THEN RETURN< TO FORTB  %
	EXTERNAL NXTFIL;
	GETSG(P0);	!GET FORTRA
	NXTFIL();	!GET NEXT INPUT FILE
	FLGREG<ENDFILE> _ 1;	!NXTFIL DOES A SKIP RETURN IF IT FINDS A 
				!FILE SO THIS WILL NOT BE SET UNLESS NO FILE
				!IS FOUND
	GETSG(P1);	!GET FORTB BACK
END;


%[1047]% ROUTINE FORLINK CTCSTART =	!ENTER HERE AFTER ^C START
BEGIN
	SEGINCORE _ P3+2;	!SIMULATE IN PHASE 6
	PHAZCONTROL()
END;

ROUTINE FORLINK PHASBEGIN=		![1725] Use FORLINK linkage
BEGIN

%1633%	! Written by TFV on 1-Sep-82

	! Setup runtime for this phase

	PBTIME = RNTIME();

END;	! of PHASBEGIN

ROUTINE FORLINK PHASEND=		![1725] Use FORLINK linkage
BEGIN

%1633%	! Written by TFV on 1-Sep-82

	! Collect runtime for this phase

	REGISTER ETIME;

	ETIME = RNTIME();	! Get current runtime

	! Add it to this phase

	PHTIME[.SEGINCORE] = .PHTIME[.SEGINCORE] + .ETIME - .PBTIME;

END;	! of PHASEND

ROUTINE FORLINK RNTIME=		![1725] Use FORLINK linkage
BEGIN

%1633%	! Written by TFV on 1-Sep-82

	! Returns runtime

	MACHOP	CALLI=#047,JSYS=#104;		! For MSTIME, RUNTIM, RUNTM

REGISTER
	NUM,
	AC1=1,AC2=2,AC3=3;

LOCAL
	RSV[3];

	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
		NUM _ .AC1;	! Run time is in AC1
		AC1 _ .RSV[0];	! Restore AC1
		AC2 _ .RSV[1];	! Restore AC2
		AC3 _ .RSV[2];	! Restore AC3
	END
	ELSE	NUM _ CALLI(NUM,#27);	! RUNTIM UUO for TOPS-10

	RETURN .NUM

END;	! of RNTIME

END
ELUDOM