Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/main.bli
There are 13 other files named main.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1973,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F. INFANTE /FI /HPW /DBT/SJW/EGM
MODULE MAIN(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,LOWSEG,GLOROUTINES)=
BEGIN
GLOBAL BIND MAINV = 6^24 + 0^18 + 31; ! Version Date: 26-Aug-81
%(
***** 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.
***** End Revision History *****
)%
REQUIRE FT1SEG.REQ;
REQUIRE IOFLG.BLI;
LINKAGE FORLINK = ENTXIT (FORI,FORO);
FORWARD SIXBOUT, !OUTPUT A SIXBIT WORD VIA TTCALL
NXFILG,
GETSG;
REGISTER C=3,T1=1,T2=2;
EXTERNAL SAVE17;
EXTERNAL TTCHAR,ZMAKEX,AHEAD;
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;
MACRO TPHAZ = T1$;
WHILE 1 DO
BEGIN
CASE .SEGINCORE OF SET
%IN PHASE 0% !GET PHASE 1 SYNTAX
IF FT1SEG EQL 0 THEN (JOBSYM<0,36> _ 0; JOBUSY<0,36> _ 0;TPHAZ _ P1)
ELSE TPHAZ _ P1;
%IN PHASE 1% BEGIN
IF FT1SEG EQL 0 THEN !MULTI-SEGMENT COMPILER
(JOBSYM<0,36> _ 0; JOBUSY<0,36> _ 0); !CLEARING BAD DDT INFORMATION
TPHAZ _ IF .SOPTIMIZ THEN P2 ELSE P2S;
END;
%IN PHASE 2S%
TPHAZ _ P3R;
%IN PHASE 2%
TPHAZ _ P3G;
%IN PHASE 3G%
TPHAZ _ P3;
%IN PHASE 3R%
TPHAZ _ P3;
%IN PHASE 3%
TPHAZ _ P1;
%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
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;
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 (SEGINCORE _ 0; RETURN);
SEGINCORE _ .TPHAZ;
IF .TPHAZ EQL P1
THEN %SAVE STACK% ( SVV17 _ .SREG; SVV16 _ .FREG);
!
! 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;
!
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 SIXBOUT( WORD ) =
!OUTPUT THE SIXBIT CHARS IN WORD UNTIL WE HIT A NULL
!OR UNTIL WE HAVE OUTPUT SIX CHARS. OUTPUT
!VIA TTCALL(1).
BEGIN
REGISTER BP, !BYTE POINTER
CHAR; !CONTAINS CHARACTER IN PROGRESS
BP_(WORD-1)<0,6>;
DECR I FROM 5 TO 0 DO
BEGIN
IF (CHAR_SCANI(BP)) EQL 0
THEN RETURN
ELSE (CHAR_.CHAR+#40); !SIXBIT TO ASCII
TTCALL(1,CHAR)
END
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;
END
ELUDOM