Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
pha3.bli
There are 12 other files named pha3.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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: S MURPHY/SJW/EGM/CDM/AHM
MODULE PHA3(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),START) =
BEGIN
! REQUIRES FIRST, TABLES
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
GLOBAL BIND PHA3V = 7^24 + 0^18 + #1624; ! Version Date: 28-Aug-82
%(
***** Begin Revision History *****
46 ----- ----- CHANGE REFERENCES TO PROGNAME
47 ----- ----- OUTPUT THE MACRO LISTING HEADING IN PHA3 SO
THAT THE SIXBIT FUNCTION NAME WILL FOLLOW IT
48 ----- ----- IF THE "DBGTRAC" FLAG IS SET, CALL
INIFDDT TO OUTPUT
"XCT FDDT."
49 ----- ----- FIX ARGUMENT BLOCKS HEADING TO ONLY BE OUTPUT
IF MACROCODE IS REQUESTED
50 464 QA754 HANDLE HEADINGS FOR LINE-NUMBER/OCTAL-LOCATION
MAP IF NO MACRO LISTING REQUESTED, (SJW)
51 476 QA754 MAKE LINE/OCTAL MAP HEADING OPTIONAL UNDER
/MAP=MAPFLG, (SJW)
***** Begin Version 5A *****
52 607 22685 GENERATE ZERO-ARG-BLOCK ONLY IF NEEDED (IE, IF
NEDZER SET)
****** Begin version 6 ******
53 1047 EGM 22-Jan-81 Q10-05325
Add support for TOPS-10 execute only.
****** Begin version 7 ******
1511 CDM 17-Mar-82
Add hooks for SAVE statement processing. Call to ZSAVEOUT must
be un-commented.
1521 CDM 26-Mar-82
Add hooks for argument checking processing. ARGCHK=TRUE sets
arg checking on.
1531 CDM 4-May-82
SAVE statement code review.
1566 CDM 24-Jun-82
Enable writable overlay block (1045 for SAVE) output.
1572 AHM 29-Jun-82
Move check for ?Program too large from ZENDALL to MRP3 so that
the check is performed even if object code isn't generated.
1576 AHM 7-Jul-82
Make the compiler emit a JRST to the start address of programs
under /EXTENDED and have ZENDALL make that the entry vector.
1614 CDM 16-Aug-82
Moved call to ZARGCHECK from here to ZENDALL so that rel blocks
would be output after the symbol table was dumped.
1624 AHM 28-82
Don't call ZSAVEOUT in MRP3 if /EXTEND was specified, since we
don't support overlays for extended addressing and variables
are always preserved when not using overlays.
Module:
PHA3
***** End Revision History *****
)%
%[1047]% PORTAL ROUTINE MRP3 =
BEGIN
%(***OVERLAY TO DO CODE GENERATION****)%
EXTERNAL OBUFFA,
HILOC,
CGASMNT,
CGSTMNT,
CGARGS,
CGIOARGS, !ROUTINES TO GENERATE ARG BLOCKS FOR
CGSTPAUARGS, ! IO STMNTS AND STOP/PAUSE STMNTS
CGOPGEN,
COMTSIZ, ! Size of all the COMMON blocks
CSTMNT, ! Current statement
DEFLAB,
DOSP,
DOSTAK,
DUMPDIM, !ROUTINE TO OUTPUT ALL DIMENSION INFORMATION
! FOR ALL PROTECTED ARRAYS (FOR ALL ARRAYS
! WHEN THE USER SPECIFIES THE "DEBUG" SWITCH)
%1572% E142, ! Error message - ? Program too large
%1572% FATLER, ! Prints error messages
GENLAB,
INIFDDT, !TO GENERATE "XCT FDDT."
INIISNRLBLK, !TO INIT BUFFER USED FOR
! THE LABELS INSERTED WHEN THE "DEBUG" SWITCH
! IS SPECIFIED BY THE USER
ISN, !INTERNAL SEQ NUMBER OF STMNT
%1572% LARGELOC, ! Next free location in .LARG.
LSTFORMATS, !TO LIST FORMAT STMNTS IN THE MACRO-EXPANDED
! LISTING
%1572% LOWLOC, ! Next free location in .DATA.
NAMGEN, !TO GENERATE NAMELIST ENTRIES
NEDZER, ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
OBUFF,
OPGRES,
OPDSPIX,
OUTMDA,
OUTMOD,
PBFPTR,
PBOPWD,
PBUFF,
PHAZCONTROL,
PSYMPTR,
%1511% SAVNED, ! SAVE statement is needed
SEGINCORE,
ZENDALL,
ZERBLK,
ZOUTMSG,
%1521% ZCOERCION, ! Puts out coercion blocks
%1511% ZSAVEOUT, ! Processing for SAVE statement
%1521% ZSFARGCHECK; ! Arg checking blocks for defn of subprograms
MAP PPEEPFRAME PBFPTR;
MAP BASE CSTMNT;
MAP PEEPFRAME PBUFF;
LOCAL
STADDR, !PROGRAM STARTING ADDRESS
%1576% ENTADDR, ! Address of entry vector
%1576% STARTLAB; ! Start address label for JRST in entry vector
%1521% BIND ARGDUM=PLIT(ARGCHK GLOBALLY NAMES
%1521% TRUE); ! Set to 0 to discontinue arg checking
! If user specified the "DEBUG" switch init buffer used for
! labels inserted on each line.
IF .FLGREG<DBGLABL> THEN INIISNRLBLK();
! If the user specified the "TRACE" option of the DEBUG switch,
! init for generation of "XCT FDDT."
IF .FLGREG<DBGTRAC> THEN INIFDDT();
%(***INIT PTR TO DO-INFORMATION AREA***)%
DOSP_DOSTAK;
%(***DEFINE A LABEL TO CORRESPOND TO A ZERO-ARG-BLOCK FOR FOROTS - THIS
ARGBLOCK WILL BE USED FOR A NUMBER OF STMNTS***)%
NEDZER _ 0; ! INITIALIZE TO "ZERO-ARG-BLOCK NOT NEEDED"
ZERBLK_GENLAB();
IF .FLGREG<LISTING>
THEN
BEGIN
EXTERNAL HEADING, PAGELINE, STRNGOUT;
IF .FLGREG<MACROCODE>
THEN
BEGIN
IF (PAGELINE _ .PAGELINE - 4) LEQ 0
THEN
BEGIN
HEADING ();
PAGELINE _ .PAGELINE - 4;
END;
STRNGOUT(PLIT ASCIZ '?M?J?M?JLINE LOC LABEL GENERATED CODE?M?J');
END
ELSE
IF .FLGREG<MAPFLG>
THEN
BEGIN
IF (PAGELINE _ .PAGELINE - 7) LEQ 0
THEN
BEGIN
HEADING ();
PAGELINE _ .PAGELINE - 7;
END;
STRNGOUT (PLIT ASCIZ '?M?J?M?JLINE NUMBER/OCTAL LOCATION MAP');
STRNGOUT (PLIT ASCIZ '?M?J?M?J : 0?I1?I2?I3?I4?I5?I6?I7?I8?I9?M?J');
STRNGOUT (PLIT ASCIZ '------:-------------------------------------------------------------------------------');
STRNGOUT (PLIT ASCIZ '?M?J :?M?J00000 : ');
END;
END;
CSTMNT_.SORCPTR<LEFT>;
%(***SKIP 1ST STMNT OF PROGRAM - WHICH IS A DUMMY CONTINUE***)%
IF .CSTMNT NEQ 0
THEN
CSTMNT_.CSTMNT[SRCLINK];
PBFPTR_PBUFF; !INIT PTR TO NEXT AVAILABLE PEEPHOLER ENTRY
PBFPTR[PBFISN]_NOISN; !INIT INTERNAL SEQ NO FIELD FOR 1ST INSTR
%(****STARTING ADDRESS OF PROGRAM***)%
STADDR _ .HILOC;
%1576% IF EXTENDED
%1576% THEN IF .FLGREG<PROGTYP> EQL MAPROG
%1576% THEN DEFLAB(STARTLAB=GENLAB()); ! Tack down a label for the entry point
%1521% ! Output coercion block for argument type checking blocks.
%1521% IF .ARGCHK EQL TRUE THEN
%1521% IF .FLGREG<OBJECT> THEN
%1521% IF .FLGREG<PROGTYP> NEQ BKPROG ! Not block data program
%1521% THEN ZCOERCION();
%(***GENERATE A CALL TO RESET. AT THE BEGINNING OF THE PROGRAM***)%
%(***FOR THE MAIN PROGRAM ONLY***)%
IF .FLGREG<PROGTYP> EQL MAPROG THEN
BEGIN
OPDSPIX_OPGRES;
CGOPGEN();
END;
%(***GENERATE CODE FOR ALL STMNTS OF THE PROGRAM****)%
WHILE .CSTMNT NEQ 0
DO
BEGIN
ISN_.CSTMNT[SRCISN];
CGSTMNT();
CSTMNT_.CSTMNT[SRCLINK];
END;
%(***OUTPUT ANY INSTRUCTIONS STILL REMAINING IN THE PEEPHOLE BUFFER AND SET THE
PTR TO NEXT AVAILABLE WD OF PEEPHOLE BUFFER BACK TO THE START OF BUFFER***)%
IF .PBFPTR NEQ PBUFF
THEN
BEGIN
OUTMOD(PBUFF, (.PBFPTR-PBUFF)/PBFENTSIZE );
PBUFF[PBFLABEL]_NOLABEL; !INIT LABEL FIELD OF 1ST INSTR
PBFPTR_PBUFF;
END;
! Put out a JRST to the start address for extended main
! programs that will be called the entry vector by ZENDALL
! later on.
%1576% IF EXTENDED
%1576% THEN IF .FLGREG<PROGTYP> EQL MAPROG
%1576% THEN
%1576% BEGIN
%1576% ENTADDR = .HILOC;
%1576% JRSTGEN(.STARTLAB)
%1576% END;
%1521% ! If a subroutine or function, output the arg check blocks for the
%1521% ! definition of the subprogram
%1521% IF .ARGCHK EQL TRUE THEN
%1521% IF .FLGREG<OBJECT> THEN
%1521% IF .FLGREG<PROGTYP> EQL SUPROG OR .FLGREG<PROGTYP> EQL FNPROG
%1521% THEN ZSFARGCHECK();
%(***OUTPUT HEADINGS FOR ARG-BLOCKS***)%
IF .FLGREG<LISTING> THEN
IF .FLGREG<MACROCODE>
THEN
BEGIN
EXTERNAL HEADING,PAGELINE,STRNGOUT;
IF ( PAGELINE_.PAGELINE-4) LEQ 0
THEN ( HEADING(); PAGELINE_.PAGELINE-4);
%1521% STRNGOUT(PLIT ASCIZ '?M?J?M?JARGUMENT BLOCKS:?M?J?M?J')
END;
%(***OUTPUT A "ZERO-ARG-BLOCK" TO BE USED FOR EVERY FN AND SUBR CALL THAT
HAS NO ARGS (ALSO USED BY STOP PAUSE AND END WHEN THERE IS NO ARG).
BLOCK WILL BE 2 WDS OF 0. THE LABEL "ZERBLK" ON THE 2ND WD.
******)%
IF .NEDZER NEQ 0 ! IS ZERO-ARG-BLOCK NEEDED ?
THEN
BEGIN
PSYMPTR_PBF2NOSYM;
PBOPWD_0;
OBUFFA();
DEFLAB(.ZERBLK);
PSYMPTR_PBF2NOSYM;
PBOPWD_0;
OBUFFA();
END; ! OF IF .NEDZER NEQ 0 THEN BEGIN
%(*** Output the argument blocks for any call statements
or function references ***)%
CGARGS();
%(***WALK THRU ALL IO STMNTS OUTPUTTING ALL ARGLISTS FOR THEM***)%
CSTMNT_.IOFIRST; !PTR TO 1ST IO STMNT
WHILE .CSTMNT NEQ 0
DO
BEGIN
ISN_.CSTMNT[SRCISN];
IF .CSTMNT[SRCID] EQL STOPID OR .CSTMNT[SRCID] EQL PAUSID
THEN CGSTPAUARGS() !TO GENERATE ARG-BLOCK
! FOR STOP OR PAUSE
ELSE CGIOARGS(); !TO GENERATE ARG-BLOCK
! FOR AN IO STMNT
CSTMNT_.CSTMNT[IOLINK];
END;
%(****GENERATE NAMELISTS IF ANY EXIST****)%
NAMGEN();
%(***OUTPUT DIMENSION INFORMATION FOR ALL PROTECTED ARRAYS***)%
DUMPDIM();
%(***OUTPUT ANY INSTRUCTIONS STILL REMAINING IN THE PEEPHOLE BUFFER***)%
IF .PBFPTR NEQ PBUFF
THEN OUTMDA(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
%1511% ! Output anything required for the SAVE statement
%1531% IF .SAVNED ! Any SAVE-ing needed?
%1531% AND .FLGREG<OBJECT> ! Yes, producing a .REL file?
%1624% AND NOT EXTENDED ! Yes, hacking extended addressing?
%1511% THEN ZSAVEOUT(); ! No, program could get overlayed
%(**If user requested a macro-expanded listing, list the format
statements***)%
IF .FLGREG<LISTING> AND .FLGREG<MACROCODE> THEN LSTFORMATS();
%(**TO TERMINATE THE REL FILE****)%
IF .FLGREG<OBJECT>
%1576% THEN ZENDALL(.STADDR,.ENTADDR); ! Pass object addresses of entry vector
! and start address
! Check for section overflows if program too large
%1571% IF .HILOC+.LOWLOC+.COMTSIZ GEQ 1^18
%1571% OR .LARGELOC GEQ 1^30
THEN FATLER(.ISN,E142<0,0>)
END; !END OF MRP3
MACHOP POPJ=#263;
MRP3();
POPJ(#17,0)