Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/sta0.bli
There are 26 other files named sta0.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) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE/HPW/ D. B. TOLMAN/DCE
MODULE STA0(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
SWITCHES NOLIST;
REQUIRE LEXNAM.BLI;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE META72.BLI;
REQUIRE ASHELP.BLI;
SWITCHES LIST;
GLOBAL BIND STA0V = 4^24+2^18+46; !VERSION DATE: 09-DEC-75
%(
REVISION HISTORY
44 ----- ----- CATCH ILLEGAL LIST DIRECTED RANDOM ACCESS
45 ----- ----- MOVE DO INDEX MODIFICATION CHECK TO NAMSET SO THAT
IT WILL GET ALL CASES OF MODIFICATION
46 336 17259 CHECK FOR ILLEGAL I/O LIST WITH NAMELIST
)%
!THE NUMBER IN COMMENT'S IS THE STATEMENTS LOCATION
!IN THE HASH TABLE .
FORWARD
MULTIASGN,
ASSIGNMENT, ! ASSIGNMENT
% 1% PUNCSTA, !PUNCH
% 38% CALLSTA, !CALL
% 49% GOTOSTA, !GOTO
% 53% PAUSSTA, !PAUSE
% 57% RETUSTA, !RETURN
% 73% ACCESTA, !ACCEPT
% 78% READSTA, !READ
% 90% WRITSTA, !WRITE
% 98% CONTSTA, !CONTINUE
%109% ASSISTA, !ASSIGN
%114% STOPSTA; !STOP
GLOBAL ROUTINE
MULTIASGN ( LEFTSIDE ) =
BEGIN
REGISTER BASE R1:R2;
EXTERNAL NEWENTRY %()%,SAVSPACE %(SIZE,LOC)%,STK,ASGNTYPER,LABLOFSTATEMENT;
EXTERNAL WARNLEX;
MACRO
EXPRBASE=1,0,FULL$;
NAME_IDOFSTATEMENT_ASGNDATA;NAME<RIGHT>_SORTAB;
R1_NEWENTRY();
R2_.STK[0];
R1[RHEXP]_.R2[ELMNT1] % EXPRESSION POINTER %;
R1[LHEXP]_R2_.LEFTSIDE;
ASGNTYPER(.R1); !CHECKING FOR ASSIGNMENT CONVERSION
R2 _ .R1[LHEXP]; !RESTORING EXP PTR INCASE OF TYPE CONVERSION NODE INSERTED
IF .R2[OPRCLS] EQL DATAOPR THEN R1[A1VALFLG]_1 ELSE R2[PARENT] _ .R1;
R2 _ .R1[RHEXP]; !RESTORE RH EXP PTR
IF .R2[OPRCLS] EQL DATAOPR THEN R1[A2VALFLG]_1
ELSE ( R2[PARENT] _ .R1; IF .R2[FNCALLSFLG] THEN R1[FNCALLSFLG] _1);
SAVSPACE(.STK[0]<LEFT>,@STK[0])
END;
GLOBAL ROUTINE
ASSIGNMENT =
BEGIN
EXTERNAL NAMSET,NAMDEF;
REGISTER BASE T1:T2;
EXTERNAL STK,SP,NEWENTRY %()%,SAVSPACE %(SIZE,LOC)%,MULTIASGN %()%,PROGNAME;
!------------------------------------------------------------------------------------------------------------------
! SYNTAX RETURNS A LIST POINTER (COUNT^18+LOC) IN STK[0]. THIS LIST CONTAINS:
!
! IDENTIFIER(20^18+LOC) - TO BE ASSIGNED
! POINTER TO LOGICAL EXPRESSION - (COUNT^18+LOC)
!
!------------------------------------------------------------------------------------------------------------------
T1_.STK[0]; !T1_LIST POINTER (COUNT^18+LOC)
T2_.T1[ELMNT]; !T2_LOC(IDENTIFIER)
% CHECK TO SEE IF ITS REALLY A VARIABLE %
IF NAMSET( VARIABL1, .T2 ) LSS 0 THEN RETURN .VREG;
% GENERATE THE ASSIGNMENT NODE %
MULTIASGN(.T2) ! GIVE IT THE LEFT HAND SIDE
END;
GLOBAL ROUTINE ASSISTA=
BEGIN
EXTERNAL SAVSPACE %(SIZE,LOC)%,BLDVAR %(VPNT)%,NEWENTRY %()%, ASIPTR,TBLSEARCH %()%,STK,TYPE,SETUSE,NAMSET;
MAP BASE ASIPTR;REGISTER BASE R1:R2;
!SEMANTIC ANALYSIS BEGINS
!--------------------------------------------------------------------------------
!THE CALL TO SYNTAX LEAVES A LIST POINTER ON THE STACK (STK[0]).
!THE POINTER POINTS TO THE LIST:
!
!LABEL (LABELEX^18+LOC) - THE LABEL TO BE ASSIGNED
!VARIABLESPEC - POINTER TO SCALAR OR ARRAY ELEMENT
!--------------------------------------------------------------------------------
R1_.STK[0]; !R1_LIST POINTER
% SET SETUSE FLAG FOR BLDVAR %
SETUSE _ SETT;
IF(STK[2]_R2_BLDVAR(.R1[ELMNT1])) LSS 0 THEN RETURN .VREG;
% BLDVAR ALLOWS ARRAYS WITHOUT SUBSCRIPTS SO DON'T LET THEM THROUGH HERE %
IF .R2<LEFT> EQL IDENTIFIER
THEN IF .R2[OPRSP1] EQL ARRAYNM1
THEN RETURN FATLEX ( R2[IDSYMBOL], ARPLIT<0,0>, E4<0,0> );
R2[IDATTRIBUT(INASSI)]_1;
NAME_IDOFSTATEMENT_ASSIDATA;NAME<RIGHT>_SORTAB;R2_NEWENTRY();
R2[ASILBL]_.R1[ELMNT];R2[ASISYM]_@STK[2];SAVSPACE(.R1<LEFT>,@R1);
IF .ASIPTR<LEFT> EQL 0 THEN ASIPTR<LEFT>_ASIPTR<RIGHT>_@R2
ELSE
BEGIN
ASIPTR[ASILINK]_@R2;ASIPTR<RIGHT>_@R2
END;
.VREG
END;
GLOBAL ROUTINE GOTOSTA=
BEGIN
EXTERNAL SAVSPACE %(SIZE,LOC)%,TBLSEARCH %()%,NEWENTRY %()%,STK,BLDVAR %(VPNT)%,SETUSE;
EXTERNAL EXPRTYPER,CNVNODE; !DOES TYPE CONVERSION IF NECESSARY
MACRO GETLAB =
INCR LLST FROM @STK[2] TO @STK[2]+.STK[2]<LEFT> DO
BEGIN
MAP BASE LLST;
LLST[ELMNT] _ .(@LLST[ELMNT])<RIGHT>
END
$;
LOCAL BASE T1; REGISTER BASE R1:T2:R2;
!SEMANTIC ANALYSIS BEGINS
!---------------------------------------------------------------------------------
!THE SYNTAX ROUTINE RETURNS A POINTER IN STK[0] TO THE LIST:
!
!CHOICE 1 - SIMPLE GOTO
! LABEL (LABELEX^18+LOC)
!CHOICE 2 - ASSIGNED OR COMPUTED GOTO
! CHOICE 1 - ASSIGNED GOTO
! COUNT^18+LOC - POINTER TO ASSIGNED VARIABLE AND LABEL LIST
! CHOICE 2 - COMPUTED GOTO
! COUNT^18+LOC - POINTER TO LABEL LIST AND CONTROL EXPRESSION
!
!SEE EXPANSION OF METASYMBOL GOTO FOR COMPLETE EXPANSION
!---------------------------------------------------------------------------------
R1_.STK[0]; !R1_LIST POINTER
IF .R1[ELMNT] EQL 1 THEN !CHOICE 1 - SIMPLE GOTO
BEGIN
NAME_IDOFSTATEMENT_GOTODATA;NAME<RIGHT>_SORTAB;T1_NEWENTRY();
T1[GOTOLBL]_.R1[ELMNT1];T1[GOTONUM]_T1[GOTOLIST]_0;
RETURN
END;
!------------------------------------------------------------------------------
!AT THIS POINT WE HAVE EITHER A COMPUTED OR ASSIGNED GOTO.
!R1[ELMNT1] TELLS US WHICH. CHOICE 1 = ASSIGNED GOTO,
!CHOICE 2 = COMPUTED GOTO.
!------------------------------------------------------------------------------
R2_.R1[ELMNT2]; !R2_LOC (ASSIGNED OR COMPUTED GOTO COMPONENTS)
IF .R1[ELMNT1] EQL 1 THEN !ASSIGNED GOTO
BEGIN
SETUSE _ SETT; ! BLDVAR FLAG
IF (STK[1]_T1_BLDVAR(.R2[ELMNT])) LSS 0 THEN RETURN .VREG;
% CHECK BLDVAR RETURN FOR UNSUBSCRIPTED ARRAY REFERENCE %
IF .T1<LEFT> EQL IDENTIFIER
THEN IF T1[OPRSP1] EQL ARRAYNM1
THEN RETURN FATLEX ( T1[IDSYMBOL], ARPLIT, E4<0,0> ) ;
IF .R2[ELMNT1] NEQ 0 THEN !ASSIGNED GOTO WITH LABEL LIST
BEGIN
T1_.R2[ELMNT2];STK[2]_.T1[ELMNT1]; !SKIP OPTIONAL COMMA
GETLAB;
SAVSPACE(.R2[ELMNT2]<LEFT>,.R2[ELMNT2]);
STK[2]<LEFT> _ .STK[2]<LEFT>+1; !INCREMENT COUNT OF LABELS
END
ELSE STK[2]_0;NAME_IDOFSTATEMENT_AGODATA;
END
ELSE
BEGIN !COMPUTED GOTO
STK[2]_.R2[ELMNT];
GETLAB;
T2 _ STK[1] _.R2[ELMNT2]; !SKIP OPTIONAL COMMA
STK[2]<LEFT> _ .STK[2]<LEFT>+1; !INCREMENT COUNT OF LABELS
IF .T2[VALTYPE] NEQ INTEGER THEN STK[1] _ CNVNODE(.T2,INTEGER,0);
NAME_IDOFSTATEMENT_CGODATA;
END;
SAVSPACE(.R1<LEFT>,@R1);
NAME<RIGHT>_SORTAB;T1_NEWENTRY();
!PTR TO LABEL NUM OF LABELS INLIST PTR TO LIST
T1[GOTOLBL]_.STK[1];T1[GOTONUM]_.STK[2]<LEFT>;T1[GOTOLIST]_.STK[2]<RIGHT>;
T2_.T1[GOTOLBL]; IF .T2[OPRCLS] NEQ DATAOPR THEN T2[PARENT] _ .T1;
.VREG
END;
GLOBAL ROUTINE CALLSTA=
BEGIN
REGISTER T2=2;
REGISTER BASE T1; MAP BASE T2;REGISTER BASE R1:R2;
EXTERNAL E121;
EXTERNAL STK,SAVSPACE %(SIZE,LOC)%,CORMAN %()%,NEWENTRY %()%,TBLSEARCH %()%,NAMSET,NAMREF,NAMDEF;
MACRO
CARGPTR=0,0,RIGHT$,CAFLGFLD=0,0,LEFT$,
ERR15(X) = RETURN FATLEX(X,R2[IDSYMBOL],E15<0,0>) $;
MACHOP BLT=#251;
LOCAL BASE CALLNODE;
!SEMANTIC ANALYSIS BEGINS
!----------------------------------------------------------------------------------