Trailing-Edge
-
PDP-10 Archives
-
bb-d868e-bm_tops20_v41_2020_dist_1of2
-
language-sources/h3cntr.bli
There are 18 other files named h3cntr.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: 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