Google
 

Trailing-Edge - PDP-10 Archives - BB-H138B-BM - language-sources/cn2n.bli
There are 18 other files named cn2n.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,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME:	H2CNTR.BLI
!DATE:		29 MAY 73	MGM/FLD
!EDITED:	21 OCT 75	PAB: 5.200.3

%3.2%	GLOBAL BIND H2CNV=1;	!MODULE VERSION NUMBER

FORWARD RLINKAGE;
GLOBAL ROUTINE GPROLOG(RFSTE,DISPLAYP,NOFORMALS,NOLOCALS)=
  ! GENERATE CODE FOR THE PROLOG OF FCN OR RTN. PUTS OUT THE "LUNDEWORD"
  ! FOR CO-ROUTINE STACK INFORMATION.
  !	FORMALS:	DISPLAYP	1 --> FCN, 0 --> RTN
  !			NOFORMALS	# OF FORMALS
  !			NOLOCALS	# OF LOCALS (BODY OF ROUTINE NOT
  !					NECESSARILY A BLOCK)
!  REVISION HISTORY :
!
! 6-2-77   ROUTINES GPROLOG AND GEPILOG ARE MODIFIED SO THAT LOCALS
!          ARE ADDED AT ROUTINE ENTRY AND REMOVED AT ROUTINE
!          EXIT.MAXLOCAL IS USED TO CONTROL THE TOTAL LOCALS NEEDED.
!          NO LOCALS ARE ADDED OR DELETED AT BLOCK LEVEL.
!          IF NO ROUTINES ARE IN A MODULE ,THEN
!          IT WORKS AS A BLOCK AND ALLOCATES LOCALS(OLD METHOD).
!          THIS IS THE ONLY CASE.COROUTINES,FUNCTIONS,ROUTINES
!          ARE TREADED THE SAME IN LOCAL ALLOCATION.
!
   
  ! COMPUTES THE VALUE OF NOSAVREG (# OF REGS SAVED IN PROLOG) WHICH
  ! IS USED BY GEPILOG TO POP THE REGS.  IN THE ROUTINE CASE IT OUTPUTS
  ! THE JSP TO ENTRY CODE ONLY IF THERE ARE LOCALS, FORMALS, OR REGS SAVED

  BEGIN REGISTER I,T,S;

%5.200.29 ....%	   IF  .ST[.RFSTE,1]<PORTALSWF> THEN
	BEGIN
	!   THE USAGE "PORTAL ROUTINE ....." IS INTERPRETTED
	!   TO MEAN A GLOBAL ROUTINE WHOSE FIRST INSTRUCTION
	!   IS THE "PORTAL" INSTRUCTION, "JRST 01,.+1"

	TEMPLATE(1,PORTALC,2);
	ACPDT();
	PUSHCODE();
	CODE(JRST,1,  CTRELOC^30+LOCATE(PORTALC,2)   ,0);
			! CTRELOC IS THE RIGHT RELOCATION FOR A LABEL
	ACPR2();
	CLASSLAB();
	UNTEMPLATE()
% .... 5.200.29%	END;

    IF .TTFLAG THEN TIMEIN();
    IF .LUNDEFLG THEN
	(I_CT[NEWBOT(.CODEPTR,1),1]; (.I-1)<RELOCF>_LUNDERELOC);
     IF .DEBFLG THEN DEBIN(.RFSTE);
     IF .DISPLAYP THEN
	BEGIN
        CODE(PUSH,.SREG,.FREG,0);
        INCR I FROM 1 TO .FUNCTIONLEVEL DO
    	CODE(PUSH,.SREG,.FREG^18 OR .I,0);
        CODE(HRRZ,.FREG,.SREG,0);
        IF .FUNCTIONLEVEL NEQ 0 THEN
            CODE(SUBI,.FREG,.FUNCTIONLEVEL,0);
        CODE(PUSH,.SREG,.FREG,0);
        NOSAVREG_0;
        NOLOCALS_.NOLOCALS+.NOSVR;
	INCR I FROM 0 TO 15 DO
	  IF .REGUSE^(-.I) THEN
	    BEGIN
	      CODE(MOVEM,.I,
		   (.FUNCTIONLEVEL+.DISPLAYP+.NOSAVREG+1) OR .FREG^18,0);
	      NOSAVREG_.NOSAVREG+1
	    END;
	MAXLOCAL_.MAXLOCAL-1;	%1-JUN-77%
	CODE(ADD,.SREG,LITA(LITLEXEME((.NOLOCALS + .MAXLOCAL)*(1^18 OR 1))),0);
	%1-JUN-77%
        NOPSAV_.NOPSAV+.NOSAVREG;  !TEMP STAT PATCH
	END
     ELSE
	BEGIN
          LOCAL LASTONE;
          NOSAVREG_0;
          LASTONE_(INCR I FROM -15 TO 0 DO
            IF NOT .MODREGM^.I THEN
              IF .REGUSE^.I THEN NOSAVREG_.NOSAVREG+1
                            ELSE EXITLOOP .I);
          REGUSE_.REGUSE<0,-.LASTONE>;
	MAXLOCAL_.MAXLOCAL - (.NOSVR-.NOSAVREG+2);
	IF ((.MAXLOCAL+.NOFORMALS+.NOSAVREG+.REGUSE) NEQ 0) OR .LUNDEFLG OR .FFFLAG
%5.200.28% THEN
%5.200.28% ( IF ( IF .ST[.RFSTE,1]<LINKAGESTF> NEQ 0
%5.200.28%	THEN RLINKAGE(.RFSTE,.NOSAVREG,0)
%5.200.28%	ELSE 1)
	    THEN CODE(JSP,.JSPREG,GMA(.RENTLEX[.NOSAVREG]),0))
%5.200.28% ELSE
%5.200.28% 	(IF .ST[.RFSTE,1]<LINKAGESTF> NEQ 0
%5.200.28%	THEN RLINKAGE(.RFSTE,0,0));
        IF .REGUSE NEQ 0 THEN INCR I FROM .LASTONE TO 0 DO
          IF .REGUSE^.I THEN
            (MAXLOCAL_.MAXLOCAL+1; NOSAVREG_.NOSAVREG+1;
             CODE(PUSH,.SREG,-.I,0));
	IF (.NOLOCALS + .MAXLOCAL - .NOSAVREG) NEQ 0 
	    THEN CODE(ADD,.SREG,LITA(LITLEXEME((.NOLOCALS + .MAXLOCAL - .NOSAVREG)*(1^18+1))),0)
	%1-JUN-77%
	END;
    IF .LUNDEFLG THEN
      BEGIN
	S_2+(IF .DISPLAYP THEN .FUNCTIONLEVL+1+.NOSVR ELSE .NOSAVREG);
	T_IF .MAXLOCAL NEQ 0 THEN .S+1 ELSE 0;
	.I_(.T AND 1^9-1)^27 OR ((.NOFORMALS) AND 1^9-1)^18 OR
	    ((IF (S_.S+(.MAXLOCAL+.NOFORMALS)) EQL 2 THEN 1 ELSE .S) AND 1^18-1)
      END
  END;
GLOBAL ROUTINE GEPILOG(RFSTE,DISPLAYP,NOFORMALS,NOLOCALS)=
  ! GENERATE CODE FOR EPILOG OF FCN (DISPLAYP=1) OR ROUTINE.

  BEGIN LOCAL SAVOFFSET,SUBAMOUNT;
    IF .TTFLAG THEN TIMEOUT();
    IF .DEBFLG THEN DEBOUT(.RFSTE);
    SUBAMOUNT_
      IF .DISPLAYP THEN .NOLOCALS+.NOSVR+.FUNCTIONLEVEL+1 ELSE 0;
    SAVOFFSET_0;
    IF .SUBAMOUNT NEQ 0 THEN
      BEGIN
	INCR I FROM 0 TO 15 DO
	  IF .REGUSE^(-.I) THEN
	    BEGIN
	      CODE(MOVE,.I,
		   (.FUNCTIONLEVEL+.DISPLAYP+.SAVOFFSET+1) OR .FREG^18,0);
	      SAVOFFSET_.SAVOFFSET+1
	    END;
	IF NOT .DISPLAYP THEN SUBAMOUNT_.SUBAMOUNT+.SAVOFFSET;
	CODE(SUB,.SREG,LITA(LITLEXEME((.SUBAMOUNT + .MAXLOCAL)*(1^18 OR 1))),0);
	%1-JUN-77%
	CODE(POP,.SREG,.FREG,0);
	CODE(POPJ,.SREG,0,0);
      END
    ELSE
      BEGIN
	%1-JUN-77%
	IF .NOLOCALS + .MAXLOCAL - .NOSAVREG NEQ 0
	THEN CODE(SUB,.SREG,LITA(LITLEXEME((.NOLOCALS + .MAXLOCAL - .NOSAVREG)*(1^18+1))),0)
	!   5.200.3     TO INSERT THE SUB 0 INSTRUCTION WHEN DEBUGGING
	ELSE IF .DEBFLG THEN CODE(SUB,.SREG,LITA(LITLEXEME(0)),0);
      IF ((.MAXLOCAL+.NOFORMALS+.NOSAVREG) EQL 0) AND NOT .LUNDEFLG AND NOT .FFFLAG
%5.200.28% THEN
%5.200.28%	(IF ( IF .ST[.RFSTE,1]<LINKAGESTF> NEQ 0
%5.200.28%		THEN RLINKAGE(.RFSTE,0,1)
%5.200.28%		ELSE 1)
		THEN CODE(POPJ,.SREG,0,0))
        ELSE BEGIN LOCAL CONTIGIND;
               CONTIGIND_.NOSAVREG;
               IF .REGUSE NEQ 0 THEN INCR I FROM 0 TO 15 DO
                 (IF .REGUSE THEN (CODE(POP,.SREG,.I,0);
                                   CONTIGIND_.CONTIGIND-1);
                  REGUSE_.REGUSE^(-1));
%5.200.28%	IF ( IF .ST[.RFSTE,1]<LINKAGESTF> NEQ 0
%5.200.28%		THEN RLINKAGE(.RFSTE,.CONTIGIND,1)
%5.200.28%		ELSE 1)
%5.200.28%	THEN
               CODE(JRST,0,GMA(.RXITLEX[.CONTIGIND]),0)
             END
      END;
  END;
GLOBAL ROUTINE GFRC2(P,F,M)=
  %P IS LAST(IF ANY) PARAMETER, F IS ROUTINE(FUNCTION) NAME, AND
   M IS THE NUMBER OF PARAMETERS. RETURNS LEXEME FOR VALUE REGISTER.%
  BEGIN
    REGSEARCH(P,0);
    IF .M NEQ 0 THEN
      BEGIN
        PCIVR(.P,0);
        CODE(PUSH,.SREG,MEMORYA(.P),0);
	SAVREG(.F);
        CODE(PUSHJ,.SREG,GMA(GAT(.F)),0);
        CODE(SUB,.SREG,LITA(LITLEXEME(.M*#1000001)),0)
      END
    ELSE
      BEGIN
	SAVREG(.F);
	CODE(PUSHJ,.SREG,GMA(GAT(.F)),0);
	%5.200.3%  IF .DEBFLG THEN CODE(SUB,.SREG,LITA(LITLEXEME(0)),0)
      END;
    CLEARSOME();
    SESTOG_.SESTOG OR 4;
    GETVREG()
  END;


%5.200.28%	ROUTINE RLINKAGE(RLSTE,RLNSVR,N)=
	BEGIN
	! N=0 FOR PROLOG, =1 FOR EPILOG
	! RETURN 0 FOR SUCCESS, 1 FOR FAILURE (AND NORMAL ENTXIT)
	! RLSTE IS INDEX OF ROUTINE'S STE
	! RLNSVR IS NUMBER OF REGISTERS TO BE SAVED HERE

	LOCAL J,K,L;

	J_.ST[.RLSTE,1]<LINKAGESTF>;
	J_.ST[.J,1]<STEF>+(2*.N);	% ADDRESS OF FIRST OR SECOND STRING %
	ACCUM_.ST[.J,0];
	(ACCUM+1)_-2;

	! TRUNCATE AT 4 CHARACTERS IF NECESSARY AND APPEND ".N"

	K_".0"+.RLNSVR;
	IF .ACCUM<8,7> EQL #177
	THEN (	IF .ACCUM<15,7> EQL #177
		THEN (	IF .ACCUM<22,7> EQL #177
			THEN (	IF .ACCUM<29,7> EQL #177
				THEN RETURN 1
				ELSE ACCUM<0,29>_(.K)^15+#77776)
			ELSE ACCUM<0,22>_(.K)^8+#376)
		ELSE ACCUM<0,15>_(.K)^1+1)
	ELSE (ACCUM<1,7>_".";(ACCUM+1)<29,7>_.K);

	! MUST BE EXTERNAL

	J_SEARCH();
	IF .ST[.J,0]<TYPEF> NEQ EXTRNT
	THEN (	IF .ST[.J,0]<BLF> EQL .BLOCKLEVEL
		THEN (	IF .ST[.J,0]<TYPEF> EQL UNDEDT
			THEN (ST[.J,0]<TYPEF>_EXTRNT;
			      ST[.J,1]_#777777)
			ELSE RETURN 1)
		ELSE J_DECSYQ(.J,EXTRNT,#777777));

	! MAKE LEXEME, FOLLOWING LIINIT  (LD3/1316)

	L_DOTM+ZERO36+LSM+.J;

	!EMIT THE APPROPRIATE CODE

	IF .N	THEN CODE(JRST,0,GMA(.L),0)
		ELSE CODE(JSP,.JSPREG,GMA(.L),0);
	0	!SUCCESS
	END;




!END OF H2CNTR.BLI