!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:	H3CNTR.BLI
!DATE:		14 JANUARY 74	MGM/FLD/KR

%3.43%	GLOBAL BIND H3CNV=6;	!MODULE VERSION NUMBER


GLOBAL ROUTINE CNINIT =
  BEGIN
  MAP MNAM, ACCUM;
  MACRO SYNER(X,Y)=(WARNEM(X,Y); RETURN 1)$,
         LDEL=DEL<LEFTHALF>$;
  MACRO	STTSTE=STKSTE(.P)$,
	STTLEN=STKLEN(.P)$,
	FNS=FNSTAT[.P]$;
%%
%
    "PSWSTK" IS CALLED BY THE SWITCH DECLARATION ROUTINE WHEN
    IT HAS RECOGNIZED "STACK" IN THE ARGUMENT STRING.  NOTE
    COMMUNICATION VIA "FNS" (NORMALLY NOT USED THIS WAY).
    A STACK IS GENERATED ONLY WHEN THE LENGTH IS NON ZERO.  
%
%%
FORWARD PSWSTT;
GLOBAL ROUTINE PSWSTK=
BEGIN
	IF PSWSTT(0) THEN 1 ELSE
	    BEGIN
		LSTART_1;
		IF .ST[.STKSTE(0),0]<TYPEF> EQL UNDEDT THEN 
			SYNER(.NSYM,ERSYSTKINV) ELSE 0
	    END
END;

%%
%
	"PSWTIM" IS CALLED BYY THE SWITCH DECLARATION ROUTINE
	WHEN A TIMER ROUTINE IS DECLARED.
%
%%
GLOBAL ROUTINE PSWTIM=
BEGIN
	IF PSWSTT(1) THEN 1 ELSE
	    BEGIN
		IF .ST[.TIMSTE,0]<TYPEF> EQL GLOBALT
		    OR .ST[.TIMSTE,0]<TYPEF> EQL OWNT  THEN
			SYNER(.NSYM,ERSYSTKINV) ELSE 0
	    END
END;
  GLOBAL ROUTINE PSWSTT(P)=
%%
%
	ROUTINE "PSWSTT" IS CALLED BY "PSWSTK" OR "PSWTIM" TO
	DECLARE A STACK OR A TIMER.  DEFAULTS ARE 'STACK' FOR
	STACK NAME, 'OWN' FOR STACK TYPE; 'TIMER' FOR
	TIMER ROUTINE, 'EXTERNAL' FOR ROUTINE TYPE.

	P = 0 => STACK DECLARATION
	P = 1 => TIMER ROUTINE DECLARATION
%
%%
    BEGIN
	BIND DEFNAME=.(PLIT('STACK','TIMER')[.P]);
	BIND DEFL=IF .P THEN DEFAULTTIML ELSE DEFAULTSTKL;
      LOCAL DECLTYPE;
      IF .LDEL EQL HCOMMA OR .LDEL EQL HPAROPEN OR .LDEL EQL HROCLO
        THEN %WE NEED AN STE OF TYPE OWN FOR STACK OR EXTERNAL FOR TIMER%

          BEGIN
            ACCUM[0]_DEFNAME; ACCUM[1]_-2;
            STTSTE_STINSERT(UNDEDT^TYPEFP+LSM,0);
            IF .LDEL EQL HPAROPEN
              THEN
                (HRUND(); EXPRESSION(1);
                 IF NOT LITP(.FUTSYM)
                   THEN (WARNEM(.NSYM,ERSMINSTKL);
                         STTLEN_DEFL)
                   ELSE
                     IF .LDEL NEQ HROCLO
                       THEN SYNER(.NDEL,ERSYSTKINV)
                       ELSE (STTLEN_LITV(.SYM); HRUND()))
            ELSE STTLEN_DEFL;
            DECLTYPE_IF NOT .P THEN (2^18+OWNT) ELSE (EXTRNT);


          END

        ELSE

          BEGIN
            IF .LDEL NEQ HEQL THEN SYNER(.NDEL,ERSYSTKINV);
            HRUND();
            IF .SYM NEQ HEMPTY THEN SYNER(.NSYM,ERSYSTKINV);
            IF (DECLTYPE_
              IF .DEL<ADDRESSF> EQL NSEXTERNAL<0,0> THEN EXTRNT
              ELSE IF
                .DEL<ADDRESSF> EQL NSGLOBAL<0,0> THEN (1^18+GLOBALT)
              ELSE IF
                .DEL<ADDRESSF> EQL NSOWN<0,0> THEN (2^18+OWNT)
	      ELSE IF
		.DEL<ADDRESSF> EQL NSFORWARD<0,0> THEN (3^18+UNDEDT)
              ELSE 0) EQL 0
              THEN SYNER(.NDEL,ERSYSTKINV);
            HRUND();
            IF .SYM NEQ HEMPTY THEN SYNER(.NSYM,ERSYSTKINV);
            IF .LDEL NEQ HROPEN THEN SYNER(.NDEL,ERSYSTKINV);
            HRUND();
            IF NOT .SYM<LSF> THEN SYNER(.NSYM,ERSYSTKINV);
            STTSTE_.SYM<STEF>;

            IF .LDEL EQL HCOMMA
              THEN
                (HRUND(); EXPRESSION(1);
                 IF LITP(.SYM)
                   THEN STTLEN_LITV(.SYM)
                   ELSE (WARNEM(.NSYM,ERSMINSTKL);
                         STTLEN_DEFL)
                )
              ELSE STTLEN_DEFL;

            IF .LDEL NEQ HROCLO THEN SYNER(.NDEL,ERSYSTKINV);
            IF .FUTSYM NEQ HEMPTY THEN SYNER(.NFUTSYM,ERSYSTKINV);
            HRUND(); %POTENTIAL COMMA IS IN THE RIGHT POSITION (DEL)%
          END; % END OF LARGE IF%

     % AT THIS POINT: STTLEN HAS LENGTH OF STACK/TIMER;
                      STTSTE HAS STE FOR STACK/TIMER ENTRY;
                      DECLTYPE<LEFTHALF> HAS 0,1,2 OR 3 FOR EXTERNAL,
                        GLOBAL, OWN, OR FORWARD;
                      DECLTYPE<ADDRESSF> HAS THE ACTUAL TYPE. %

    ST[.STTSTE,0]<TYPEF>_.DECLTYPE<ADDRESSF>;
    FNS_.DECLTYPE<LEFTHALF>; % FNS USED AS A TEMPORARY %
    0
  END;  % END PSWSTT%
  LOCAL VALREG;
!	GENERATE CODE TO SET THE VREG FOR CCL ENTRY


IF .CCLFLAG THEN BEGIN
	CODE(TDZA,.VREG,.VREG,0);
	CODE(MOVEI,.VREG,1,0);
    END;
%%
%
	DECLARE THE STACK AND/OR TIMER ROUTINE
%
%%

IF .TTFLAG	!THEN WE HAVE /T
  THEN IF .TIMSTE EQL 0 THEN	!WE DON'T HAVE A TIMER DECLARATION
      BEGIN			!MAKE UP DEFAULTS
	ACCUM_'TIMER';
	ACCUM+1_-2;
	TIMSTE_STINSERT(EXTRNT^TYPEFP+LSM,0);
	TIMLEN_DEFAULTTIML;
	FNSTAT[1]_0	!FNS WHEN .P =1
      END;
INCR P FROM 0 TO 1 DO
BEGIN
  IF .STTLEN NEQ 0 THEN
    BEGIN
    CASE .FNS OF 
      SET
        PEXTERNAL(0,0,.STTSTE);
        PGLO(NEXTGLOBAL,.STTLEN,.STTSTE);
        PGLO(NEXTOWN,.STTLEN,.STTSTE);
	(BLOCKLEVEL_.BLOCKLEVEL+3; 
		GENFCN(STTSTE_DECSYQ(.STTSTE,FORWT,0));
		BLOCKLEVEL_.BLOCKLEVEL-3)
      TES;
!	GENERATE THE CODE TO INITIALIZE THE STACK REGISTERS


   IF .P EQL 0 THEN
    BEGIN
%3.36% EXTERNAL RBREG;
       VALREG_(IF .SVERGFLG THEN .NOSVR ELSE 0)+COROUPREFL;
%3.36% CODE(HRRZI, .FREG, GMA(LSM OR DOTM OR .STTSTE),0);
%3.36% CODE(MOVEM,.FREG,GMA(.RBREG),0);
       CODE(HRLI, .SREG, (-(.STKLEN(0)-.VALREG)) AND RIGHTM,0);
%3.36% CODE(HRRZI,.FREG, (.FREG^18) OR .VALREG, 0);
       CODE(HRR, .SREG, .FREG, 0);
%3.37%	IF .TTFLAG OR .DEBFLG THEN 	% MAIN-PROGRAM TIMINT LINKAGE %
	BEGIN
	IF .CCLFLAG THEN CODE(PUSH,.SREG,.VREG,0);
	MPTIMIN();   !MAIN PROGRAM TIMEIN ROUTINE
	IF .CCLFLAG THEN CODE(POP,.SREG,.VREG,0);
	END;
    END;
    END;
END % OF LOOP %;
  END; %OF ROUTINE CNINIT%
!  VERSION NUMBER PROCESSOR.  THIS PAGE AND THE NEXT WERE GENERATED FOR CCO 3.21.


ROUTINE CONVERTOOCT(NUM)=
BEGIN	OWN	N, OCTNUM;

	ROUTINE CONXVT=
	   BEGIN LOCAL R;

		IF .N EQL 0 THEN RETURN 0;
		R_ .N MOD 10;  N_ .N / 10;
		CONXVT();  OCTNUM_ (.OCTNUM * 8) + .R;
		IF .R GTR 7 THEN ERROR(.NDEL, ERSYNVER)
	   END;

	N_ .NUM;  OCTNUM_ 0;  CONXVT();

	.OCTNUM
END;
GLOBAL ROUTINE PSWVER=
BEGIN	LOCAL	XCHAR, PACCM;		REGISTER VNUM;
	LABEL	MINLAB;

MACRO	VMAJOR=24,9$,	VMINOR=18,6$,	VEDIT=0,18$,	VWHO=33,3$,
	ERRORSYNTAX=ERROR(.NDEL, ERSYNVER)$;

	VNUM_ 0;  VNUM<VMAJOR>_ CONVERTOOCT(.FUTSYM);	! PUT MAJOR

	MINLAB: IF .FUTDEL EQL ERRLEX THEN	!WE HAVE MINOR
		(PACCM_ ACCUM<36,7>;

		 IF .TYPETAB[XCHAR_ SCANI(PACCM)] NEQ 2
			THEN (ERRORSYNTAX; LEAVE MINLAB);

		 VNUM<VMINOR>_ (.XCHAR - #100);

		 IF SCANI(PACCM) NEQ #177 THEN ERRORSYNTAX;

		 SRUND(#10));

	IF .FUTDEL<LEFTHALF> NEQ HPAROPEN THEN ERRORSYNTAX;

	SRUND(#40);  VNUM<VEDIT>_ .VAL;		! GET AND SAVE <EDIT>

	IF .FUTDEL<LEFTHALF> NEQ HROCLO THEN ERRORSYNTAX;

	SRUND(#10);				! TEST FOR <WHO> OR DONE

	IF .FUTDEL<LEFTHALF> EQL HMIN THEN	! WE'VE GOT <WHO>

		(SRUND(#40);  IF .VAL GEQ 8 THEN ERRORSYNTAX;
		 VNUM<VWHO>_  .VAL);

	IF (.FUTDEL<LEFTHALF> NEQ HROCLO) AND (.FUTDEL<LEFTHALF> NEQ HCOMMA)
		THEN ERRORSYNTAX;

	WRITE9(#137, .VNUM);			! WRITE IT OUT

	HRUND();				! UPDATE WINDOW

END;


!END OF H3CNTR.BLI
 