Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/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) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S MURPHY/SJW/EGM
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 = 6^24 + 0^18 + 53; ! Version Date: 20-Jul-81
%(
***** 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.
***** End Revision History *****
)%
%[1047]% PORTAL ROUTINE MRP3 =
BEGIN
%(***OVERLAY TO DO CODE GENERATION****)%
EXTERNAL INIFDDT; !TO GENERATE "XCT FDDT."
EXTERNAL INIISNRLBLK; !TO INIT BUFFER USED FOR
! THE LABELS INSERTED WHEN THE "DEBUG" SWITCH
! IS SPECIFIED BY THE USER
EXTERNAL NAMGEN; !TO GENERATE NAMELIST ENTRIES
EXTERNAL CSTMNT,PBFPTR,PBUFF;
EXTERNAL ISN; !INTERNAL SEQ NUMBER OF STMNT
EXTERNAL DUMPDIM; !ROUTINE TO OUTPUT ALL DIMENSION INFORMATION
! FOR ALL PROTECTED ARRAYS (FOR ALL ARRAYS
! WHEN THE USER SPECIFIES THE "DEBUG" SWITCH)
MAP PPEEPFRAME PBFPTR;
MAP BASE CSTMNT;
MAP PEEPFRAME PBUFF;
EXTERNAL OBUFFA;
EXTERNAL HILOC;
EXTERNAL CGASMNT,CGSTMNT;
EXTERNAL CGIOARGS,CGSTPAUARGS; !ROUTINES TO GENERATE ARG BLOCKS FOR
! IO STMNTS AND STOP/PAUSE STMNTS
EXTERNAL ZOUTMSG;
EXTERNAL CGARGS;
EXTERNAL SEGINCORE,PHAZCONTROL;
EXTERNAL OUTMOD,OUTMDA;
EXTERNAL DOSP,DOSTAK;
EXTERNAL ZENDALL;
EXTERNAL LSTFORMATS; !TO LIST FORMAT STMNTS IN THE MACRO-EXPANDED LISTING
EXTERNAL NEDZER; ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
EXTERNAL ZERBLK;
EXTERNAL CGOPGEN,OPGRES,OPDSPIX;
EXTERNAL GENLAB,DEFLAB;
EXTERNAL PSYMPTR,PBOPWD,OBUFF;
OWN STADDR; !PROGRAM STARTING ADDRESS
IF .FLGREG<DBGLABL> THEN INIISNRLBLK(); !IF USER SPECIFIED THE "DEBUG" SWITCH
! INIT BUFFER USED FOR LABELS INSERTED ON EACH LINE
IF .FLGREG<DBGTRAC> THEN INIFDDT(); !IF THE USER SPECIFIED THE "TRACE"
! OPTION OF THE DEBUG SWITCH, INIT FOR GENERATION
! OF "XCT FDDT."
%(***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;
%(***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;
%(***OUTPUT HEADINGS FOR ARG-BLOCKS***)%
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>
THEN ( EXTERNAL HEADING,PAGELINE,STRNGOUT;
IF ( PAGELINE_.PAGELINE-4) LEQ 0
THEN ( HEADING(); PAGELINE_.PAGELINE-4);
STRNGOUT(PLIT ASCIZ '?M?J?M?J ARGUMENT BLOCKS:?M?J?M?J')
);
%(***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);
%(**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> THEN
ZENDALL(.STADDR);
END; !END OF MRP3
MACHOP POPJ=#263;
MRP3();
POPJ(#17,0)