Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/driver.bli
There are 13 other files named driver.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: D. B. TOLMAN/MD/JNG/SJW
MODULE DRIVER (START,RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
GLOBAL BIND DRIVV = 5^24 + 1^18 + 20; ! VERSION DATE: 16-May-76
%(
REVISION HISTORY
2 ----- ----- ADD CODE TO EXECUTE "SYNTAX" FOR SELECTED STATEMENTS
BEFORE CALLING THEIR SEMANTICS ROUTINES
3 ----- ----- ADD THE CODE TO RECOGNIZE END OF FILE IN AN INCLUDED
FILE AND THEN RESTORE THE ORIGIONAL SOURCE FILE
AND CONTINUE PROCESSING IT
4 ----- ----- MOVE ZZOUTMSG TO UNEND SO THAT IT CAN BE CALLED BY MAIN
WHILE IN ANY PHASE
5 ---- ----- MOVE THE END OF PROGRAM UNIT AND END OF
COMPILATION CODE TO ROUTINES ENDUNIT AND
FINALCHAR RESPECTIVELY IN MODULE UNEND.
THIS WILL ALLOW THEM TO BE ACCESSED BY MAIN
6 ----- ----- ADD ERROR DETECTION OF PROGRAM UNIT TERMINATION IN
INCLUDE
7 ----- ----- REDUCE THE END OF THE STACK BY POOLSIZ FOR
PHAZE1 AND THEN RESTORE FOR LATER PASSES
8 ----- ----- FINAL CHAR HAS GONE AWAY
9 ----- ----- ADD PROCESSING TO GLOBINIT TO INITIALIZE
THE FLGREG FOR THE NEW DEBUG SWITCH MODIFIERS
10 ----- ----- FIX DOCHECK TO HANDLE THE NEW ACTIVVE DO STACK
WHICH NOW CONTAINS THE ACTIVE INDEX FOR EACH LOOP
ADD ROUTINE CKDOINDEX() WHICH WILL SEARCH THE
ACTIVE LIST FOR SOME GIVEN VARIABLE
11 ----- ----- ADD ROUTINE CKAJDIM TO CHECK THE LIST OF
VARIABLE DIMENSIONS WHICH WERE NOT LEGAL
AT THE TIME TO SEE IF THEY HAVE BECOME LEGAL
12 ----- ----- MOVE DOCHECK CALL TO UNLINK LOOP LIST DOWN
AFTER SEMANTICS SO THE LAST STAATEMENT WILL
BE PART OF THE LOOP FOR INDEX MODIFICATION
CHECKING PURPOSES
13 ----- ----- FIX DOCHECK SO IT POPS INDEX PROPERLY
14 230 ----- LEGAL VARIABLE DIMENSIONS MUST BE ALLOCATED
15 303 16369 CLEAR FLGREG OF ARGUMENT LIST FLAG BETWEEN STATEMENTS
16 307 16611 CLEAR BUFFERS AFTER FINISHING ERROR MESSAGES
17 343 17636 FIX END OF STA. SO THAT THE LINE NUMBER IS CORRECT.
18 462 19960 FIX MRP1 TO ALWAYS LEAVE SREG<LEFT> THE WAY
IT FOUND IT (FIX PDL OV'S IN LATER PHAZES)
********** BEGIN VERSION 5A **********
19 571 22378 DEFINE AND CALL CLERIDUSECNTS AT END OF MRP1
TO CLEAR IDUSECNTS OF .I TEMPS SHARED IN
DIM TABLE
20 573 ----- REQUIRE DBUGIT.REQ
)% !END REVISION HISTORY
REQUIRE DBUGIT.REQ; ![573] SJW 16-MAY-77
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
EXTERNAL ZZOUTMSG,DIGITS;
EXTERNAL E67,E69,E29,E107,E108,E61,E110,E123; !ERROR MESSGE POINTERS
EXTERNAL FATLERR,WARNERR,NUMFATL,NUMWARN,STMNDESC;
GLOBAL ROUTINE
ENDSTA =
BEGIN
EXTERNAL ERLSTR;
EXTERNAL PSTATE,LEXICAL,GSTLEXEME,GSTNOEND,GSTEOP,ISN,WARNERR,PSTEND,ENDCODE,NEWENTRY,LABLOFSTATEMENT,CONTSTA;
EXTERNAL PSTBKIMP,PSTEXEC;
%CHECK FOR UNIT TERMINATION IN INCLUDE%
IF .FLGREG<ININCLUD>
THEN
BEGIN %ITS A NO O %
PSTATE _ IF .FLGREG<PROGTYP> EQL BKPROG
THEN PSTBKIMP<0,0>
ELSE PSTEXEC<0,0>;
RETURN FATLERR(.ISN, E123<0,0>)
END;
IF .PSTATE NEQ PSTEND<0,0>
THEN
BEGIN
% MISSING END STATEMENT %
WARNERR ( .ISN, E69<0,0> );
PSTATE _ PSTEND<0,0>;
%**;[343], ENDSTA , MD , 23-JAN-76 %
%**;[343], ADD @ LINE 3239 %
NAME _ IDOFSTATEMENT _ ENDDATA;![343] CREATE ENTRY BEFORE CALL TO LEXICAL
NAME<RIGHT> _ SORTAB;![343]
NEWENTRY();![343]
LEXICAL ( .GSTNOEND ); ! RESTORE LEXICAL TO BEGINNING OF LAST
! STATEMENT AND PERFORM END OF PROGRAM
! UNIT PROCESSING
END
ELSE
BEGIN % WE HAVE AN "END" STATEMENT %
% MAKE DUMMY CONTINUE LABEL HERE IF LABELELD %
IF .LABLOFSTATEMENT NEQ 0
THEN
BEGIN % LABELED END %
CONTSTA();
LABLOFSTATEMENT _ 0
END
ELSE LEXICAL ( .GSTLEXEME ) ; ! PICK UP EOS
%**;[343], ENDSTA , MD , 23-JAN-76 %
%**;[343], ADD @ LINE 3255 %
NAME _ IDOFSTATEMENT _ ENDDATA;![343] CREATE ENTRY BEFORE CALL TO LEXICAL
NAME<RIGHT> _ SORTAB;![343]
NEWENTRY();![343]
LEXICAL ( .GSTEOP ) ! END OF PROGRAM UNIT PROCESSING
END;
%**;[343] , ENDSTA , MD ,23-JAN-76 %
%**;[343] , DELETE 3 LINES @ LINE 3260 %
%CLEAR OUT THE ERROR MESSAGE QUEUE %
ERLSTR( NOT .FLGREG<TTYDEV> AND NOT .FLGREG<NOERRORS> );
END; % ROUTINE ENDSTA %
GLOBAL ROUTINE
CKAJDIM =
BEGIN
%SCAN THE STACK OF VARIABLES IN DIMSTK TO SEE IF
THEY HAVE BEEN DEFINED AS DUMMIES BY NOW %
EXTERNAL DIMSTK,SAVSPAC,E126,FATLERR,E15;
REGISTER BASE LINK:PTR;
LINK_.DIMSTK<RIGHT>;
WHILE ( .LINK ) NEQ 0
DO
BEGIN
PTR _ .(.LINK+1)<RIGHT>; !VARIABLE OR ARRAY POINTER
IF .PTR[OPRSP1] EQL ARRAYNM1
THEN
BEGIN
%ITS AN ARRAY%
IF NOT .PTR[IDATTRIBUT(DUMMY)]
THEN FATLERR( PLIT'A DUMMY ARRAY?0', PTR[IDSYMBOL], .(.LINK+1)<LEFT>,E15<0,0>);
END
ELSE
BEGIN
%ITS A VARIABLE %
IF .PTR[OPERSP] NEQ FORMLVAR
AND NOT .PTR[IDATTRIBUT(INCOM)]
THEN FATLERR ( .PTR[IDSYMBOL],.(.LINK+1)<LEFT>,E126<0,0>);
%**;[230],ROUTINE CKAJDIM,INSERT @ 3289,MD,11/17/74%
%[230]% PTR[IDATTRIBUT(NOALLOC)]_0; !MUST ALLOCATE
END;
LINK _ @( VREG _ .LINK );
SAVSPAC ( 1,.VREG )
END
END;
GLOBAL ROUTINE
LABLCHECK=
BEGIN
%
ROUTINE SCANS THE LABEL TABLE AND OUTPUTS A LIST OF UNDEFINED
LABELS IT ENCOUNTERS.
%
EXTERNAL LABTBL,LSTOUT,DECODELINE,LINENO,ZZOUTMSG,HEADCHK;
LOCAL BASE PTR, UNDEFLABEL,COUNT;
COUNT _ 0;
UNDEFLABEL _ 0;
DECR I FROM LASIZ-1 TO 0 DO
BEGIN
IF (PTR _ .LABTBL[.I]) NEQ 0
THEN
BEGIN
DO BEGIN
IF .PTR[SNHDR] EQL 0
THEN IF .PTR[SNUMBER] LEQ 99999
THEN (!ERROR UNDEFINED LABEL
IF .UNDEFLABEL EQL 0 THEN( HEADCHK(); ZZOUTMSG(PLIT '?M?J?M?JUNDEFINED LABELS?M?J?M?J?0'));
UNDEFLABEL _ .PTR[SNUMBER];
DECODELINE( .UNDEFLABEL );
ZZOUTMSG( LINENO<0,0> );
IF (COUNT _.COUNT+1) GTR 3
THEN (COUNT _ 0; ZZOUTMSG( PLIT'?M?J?0' ); HEADCHK());
NUMFATL _ .NUMFATL+1; !INCREMENT # OF ERRORS
);
END WHILE (PTR _ .PTR[CLINK]) NEQ 0;
END
END;
IF .UNDEFLABEL NEQ 0
THEN
BEGIN
ZZOUTMSG( PLIT'?M?J?0');
FLGREG<ERRSW> _ 1; !SET FLAG FOR FATAL ERRORS
END
END; !OF LABLCHECK
GLOBAL ROUTINE
UNDOLABEL= !UNTERMINATED DO LABELS
BEGIN
%
ROUTINE IS CALLED BY CLASSIFIER MODULE AFTER END OF PROGRAM
FLAG IS SEEN AND SOME UNTERMINATED DO LOOPS ARE KNOWN TO EXIST.
ROUTINE THEN FOLLOWS CHAIN OF UNTERMINATD DO'S AND OUTPUTS THE LOOP TERMINAL LABEL
MISSING AND THE LINE NUMBER OF THE DO STATEMENT IN WHICH IT WAS FOUND
%
EXTERNAL LASDOLABEL,DECODELINE,LINENO,ZZOUTMSG,HEADCHK;
MAP BASE LASDOLABEL;
LOCAL BASE PTR;
FLGREG<ERRSW> _ 1;
HEADCHK();
ZZOUTMSG(PLIT'?M?J?M?JUNTERMINATED DO LOOPS?M?J?M?J?0');
DO
BEGIN
HEADCHK();
PTR _ .LASDOLABEL<RIGHT>; PTR _ .PTR[SNDOLNK];
ZZOUTMSG(PLIT'LINE: ');
PTR_.(.PTR)<LEFT>; !PTR TO DO NODE
DECODELINE( .PTR[SRCISN] );
ZZOUTMSG ( LINENO<0,0> );
ZZOUTMSG ( PLIT'?M?J?0' );
NUMFATL _ .NUMFATL+1; !INCREMENT ERROR COUNT
END UNTIL (LASDOLABEL _ @(.LASDOLABEL<LEFT>)) EQL 0;
END; !OF UNDOLABEL
GLOBAL ROUTINE
DOCHECK ( LABNODE ) =
BEGIN
%LABNODE CONTAINS APOINTER TO A STATEMENT LABEL NODE
ADJUST THE DO NEST LEVEL COUNT AND CHECK FOR ILLEGAL NESTING
WE GET HERE ONLY IF THE LABEL WAS IN A DO STATEMENT SEEN ALREADY
%
EXTERNAL LASDOLABEL,DONESTLEVEL,DOINDEX,FATLEX;
MAP BASE LABNODE: LASDOLABEL;
!
DONESTLEVEL _ .DONESTLEVEL - .LABNODE[SNDOLVL]; !SUBTRACT THE NEST LEVEL OF THE LABEL
IF .LABNODE NEQ .LASDOLABEL<RIGHT>
THEN !INCORRECT DO LOOP NESTING
(LOCAL BASE SRCPT;
SRCPT _ .LASDOLABEL[SNDOLNK]; !THE LINK PTR TO THE LAST DO NODE SEEN
SRCPT _ .(.SRCPT)<LEFT>; !GET PTR TO SOURCE NODE
FATLERR ( .SRCPT[SRCISN] % THE ISN OF THE LAST DO SEEN %
, .ISN, E29<0,0>) !ILLEGALLY NESTED DO
)
!
!ELSE UNSTACK NESTED LABELS OF DO'S THAT HAVE THE SAME TERMINAL LABEL
!
ELSE
DO
BEGIN
EXTERNAL CURDOINDEX;
CURDOINDEX _ @(.LASDOLABEL<LEFT>+1); !INDEX POINTER
LASDOLABEL _ @(.LASDOLABEL<LEFT>); !LABEL POINTER
END
UNTIL .LABNODE NEQ .LASDOLABEL<RIGHT>;
END;
GLOBAL ROUTINE
CKDOINDEX ( ID ) =
BEGIN
%SEARCH BACK UP THE CURRENTLY ACTIVE DO LOOP LIST AND SEE
IF ID ( A POINTER TO A VARIABLE ) IS AN ACTIVE INDEX %
MAP BASE ID;
REGISTER LAB,IDX;
EXTERNAL LASDOLABEL,CURDOINDEX;
IF .LASDOLABEL EQL 0 THEN RETURN 0;
LAB _ .LASDOLABEL<LEFT>;
IDX _ .CURDOINDEX<RIGHT>;
DO
BEGIN
IF .ID<RIGHT> EQL .IDX
THEN RETURN -1; !ITS A MATCH
IDX _ .(@LAB+1)<RIGHT>;
LAB _ .(@LAB)<LEFT>;
END
UNTIL .LAB EQL 0;
RETURN 0 !NO MATCH
END;
MACHOP POPJ=#263;
MACRO CORE(X) = BEGIN
CALLI(X,#11);
END$;
EXTERNAL LOWLOC,SEGINCORE,ILABIX,PHAZCONTROL %()%,ERRLINK,SP,TMPCNT[4],FREELIST,LSAVE,LEXL,LEXEMEGEN %()%;
GLOBAL ROUTINE
GLOBINIT= !INITIALIZE ALL GLOBALS
BEGIN
!FILE GLOBL.BLI HAS ALL THE GLOBALS DEFINED
EXTERNAL GLOBEND;
% FIRST ZERO EVERYTHING UP TO GLOBEND - THERE ARE A FEW AFTER
GLOBEND WHICH SHOULD NOT BE ZEROED FOR EVERY COMPILATION UNIT %
SYMTBL[0]_ 0; !THE FIRST GLOBAL IN GLOBL.BLI
VREG<LEFT>_ SYMTBL<0,0>; VREG<RIGHT> _ SYMTBL[1]<0,0>; !SET BLT POINTER
BLT(VREG,GLOBEND); !ZERO THE GLOBAL AREA
IF .JOBREL GEQ .JOBFF THEN
BEGIN
(.JOBFF)<FULL> _ 0;
IF .JOBREL GTR .JOBFF THEN
BEGIN
VREG<LEFT> _ .JOBFF; VREG<RIGHT> _ .JOBFF+1;
BLT(VREG,.JOBREL)
END
END;
!INITIALIZE GLOBAL AREA
BEGIN
EXTERNAL ENTRY,SYMTYPE,TBLSEARCH,NAME,ONEPLIT,PROGNAME;
EXTERNAL GINTEGER,GREAL,PAGE,PAGELINE,NONIOINIO;
REGISTER T1,T2;
ILABIX _ 100000; !INITIAL TEMPORTRY LABEL VALUE
TYPTAB["A"-"A"]_GREAL<0,0>;
T1<LEFT>_TYPTAB["A"-"A"];T1<RIGHT>_.T1<LEFT>+1;
BLT(T1,TYPTAB["Z"-"A"]);
T1<LEFT>_TYPTAB["I"-"A"];T1<RIGHT>_.T1<LEFT>+1;
TYPTAB["I"-"A"]_GINTEGER<0,0>;
BLT(T1,TYPTAB["N"-"A"]);
PROGNAME _ SIXBIT'MAIN.';
PAGE _ 1^18;
PAGELINE _ -1;
NONIOINIO _ 0;
FLGREG<ERRSW> _ 0;
SPACEFREE_@JOBREL-@JOBFF;
SEGINCORE_1;
FLGREG<BLKDATA> _ 0; ! CLEAR THE BLKDATA BIT
FLGREG<LABLDUM> _ 0; ! LABEL FORMALS PARAMETERS
FLGREG<PROGTYP> _ MAPROG; ! MAIN PROGRAM
FLGREG<MULTENT> _ 0; ! MULTIPLE ENTRIES FLAG
FLGREG<ENDFILE> _ 0; !CLEAR END OF FILE FLAG
FLGREG<BTTMSTFL> _ 1; !BOTTOMMOST SUBROUTINE FLAG
LOWLOC _ 1;
END !OF GLOBI1
!
END; !OF ROUTINE GLOBINIT
!**[571] DRIVER @3534 SJW 11-MAY-77
![571] DEFINE ROUTINE CLERIDUSECNTS BEFORE ROUTINE MRP1
ROUTINE CLERIDUSECNTS =
BEGIN
EXTERNAL DTABPTR; ! HEAD OF DIM ENTRY LIST
LOCAL PTR; ! TO MARCH DOWN LIST
LOCAL DIMENTRY E; ! ONE ELEMENT ON LIST
LOCAL BASE ITEMP; ! SYM TAB ENTRY FOR .I TEMPORARY
LABEL CHECKTHIS;
PTR _ .DTABPTR<RIGHT>; ! START AT HEAD OF LIST
WHILE .PTR NEQ 0
DO BEGIN
E _ .PTR; ! THIS DIM TABLE ENTRY
CHECKTHIS: BEGIN
IF .E [DIMNUM] LSS 2 ! OFFSET SHARED IS FOR 2ND DIM
THEN LEAVE CHECKTHIS;
IF NOT .E [ADJDIMFLG] ! SHARED ONLY IF ADJUSTABLE DIMS
THEN LEAVE CHECKTHIS;
ITEMP _ .E [DFACTOR (1)]; ! SYM TAB ENTRY OF .I TEMP
ITEMP [IDUSECNT] _ 0; ! CLEAR USE COUNT
END; ! OF CHECKTHIS
PTR _ .E [ARALINK]; ! NEXT ELEMENT
END; ! OF WHILE .PTR NEQ 0
END; ! OF CLERIDUSECNTS
GLOBAL ROUTINE
MRP1=
BEGIN
REGISTER T1,T2;
EXTERNAL ENDUNIT;
EXTERNAL GSTSTMNT,GSTLEXEME,BUGOUT,GSTNOEND,GSTEOP,ERLSTR;
EXTERNAL FATLERR,LEXLINE,STALABL;
EXTERNAL LEXICAL,STMNDESC,STRNGOUT;
EXTERNAL ENDOFILE;
EXTERNAL ISN,PSTEND,DECODELINE,WARNERR;
BIND EOSLEX = 5;
EXTERNAL EOPRESTORE,EOPSVPOOL;
EXTERNAL CURPOOLEND,POOL;
EXTERNAL ENTRY,TBLSEARCH,SYMTYPE;
EXTERNAL JOBERR,JOBFFSAV,ENDSTA,WARNOUT,ERRMSG,CCLSW,ONEPLIT;
EXTERNAL LASDOLABEL,ADJCALL;
EXTERNAL LINENO,PAGEHEADING;
LABEL COMPILATION;
BIND EOF =#200;
%REDUCE THE STACK BY POOLSIZ BECAUSE POOL CANNOT
BE DESTROYED LIKE THE OLD DAYS%
SREG _ .SREG + POOLSIZ^18;
% FIRST PROGRAM UNIT INITIALIZATION %
CURPOOLEND _ POOL[0]<0,0>;
LINENO[1] _ ' '; ! TAB FOLLOWING LINE NUMBERS
BEGIN %CHECK AND SET APPROPRIATE FLAGS FOR DEBUG SWITCH%
MACRO
%DEFINE BIT POSITIONS AS SET BY SCAN FOR
THE VARIOUS DEBUG MODIFIERS. THESE ARE SET
IN DEBGSW.
THE LEFT HALF INDICATES WHICH MODIFIERS HAVE
BEEN SPEICFICALLY EXCLUDED AND THE RIGHT HALF
INDICATES THOSE WHICH HAVE BEEN INCLUDED
%
DBSDIMN = 0,1$,
DBSLABL = 1,1$,
DBSINDX = 2,1$,
DBSTRAC = 3,1$,
DBSBOUN = 4,1$;
BIND NUMSWITCHES = 5;
BIND DEBUGFLGS =
% FLGREG BIT POSITIONS FOR THE VARIOUS MODIFIERS%
1^DBGDIMNBR +
1^DBGINDXBR +
1^DBGLABLBR +
1^DBGTRACBR +
1^DBGBOUNBR ;
EXTERNAL DEBGSW; !SWITCH VALUE VARIABLE - SET BY SCAN
REGISTER R;
% FIRST CHECK FOR SPECIFIC EXCLUSIONS. IF ONLY EXCLUSIONS ARE
SPECIFIED IT IMPLIES A REQUEST FOR THE REST %
IF .DEBGSW<LEFT> LSS 1^NUMSWITCHES
AND .DEBGSW<LEFT> NEQ 0
AND .DEBGSW<RIGHT> EQL 0
THEN
%ONLY EXCLUSIONS - INCLUDE THE REST %
R _ NOT .DEBGSW<LEFT>
ELSE
% RIGHT SIDE IS GOOD %
R _ .DEBGSW<RIGHT>;
%CLEAR SWITCHES IN FLGREG %
FLGREG<FULL> _ .FLGREG<FULL> AND ( NOT DEBUGFLGS );
% NOW SET THE SPECIFIC SWITCHES %
IF .R NEQ 0
THEN
BEGIN
EXTERNAL FATLERR,E133;
IF .R<DBSDIMN> THEN FLGREG<DBGDIMN> _ -1;
IF .R<DBSINDX> THEN FLGREG<DBGINDX> _ -1;
IF .R<DBSLABL> THEN FLGREG<DBGLABL> _ -1;
IF .R<DBSTRAC> THEN ( FLGREG<DBGTRAC> _ -1; FLGREG<DBGLABL> _ -1 );
IF .R<DBSBOUN> THEN FLGREG<BOUNDS> _ -1;
%NO GLOBAL OPTIMIZATION IF /DEBUG%
IF .FLGREG<OPTIMIZE>
THEN ( EXTERNAL LINELINE;
LINELINE _ -1; %TO GET THE MESSAGE PRINTED%
FLGREG<OPTIMIZE>_0; FATLERR(0,E133<0,0>));
END
END; %DEBUG MODIFER PROCESSING%
PAGEHEADING(); ! BUILD THE PAGE HEADING SKELITION
FLGREG<FATALERR> _ FLGREG<WARNGERR> _ 0;
!**;[462] Change @ line 3614 in MRP1 JNG 24-Sep-76
%[462]% IF EOPRESTORE() EQL EOF
%[462]% THEN
%[462]% BEGIN
%[462]% SREG _ .SREG - POOLSIZ^18; !RESTORE THE STACK
%[462]% RETURN 0
%[462]% END;
COMPILATION:
WHILE 1
DO
BEGIN % COMPILATION LOOP %
LABEL STATEMENT;
EXTERNAL PSTATE,GINTEGER;
GLOBINIT(); ! INITIALIZE THE GLOBAL AREA
JOBFFSAV _ .JOBFF; !SAVING THE STATE OF THE LOW SEG
% CREATE A CONSTANT NODE FOR 1 %
NAME _ CONTAB; SYMTYPE _ GINTEGER<0,0>; ENTRY[1] _ 1;
ONEPLIT _ TBLSEARCH();
DO
STATEMENT:BEGIN % PROGRAM UNIT LOOP %
LABLOFSTATEMENT _ 0;
%**;[303],DRIVER,JNT,18-JUN-75%
%**;[303],IN MRP1 @ 3625 (AFTER STATEMENT:)%
FLGREG<FELFLG>_0; ![303] CLEAR ARG LIST FLAG
% CLASSIFY THE NEXT STATEMENT %
WHILE 1 DO
BEGIN
IF LEXICAL ( .GSTSTMNT ) NEQ ENDOFILE<0,0>
THEN EXITLOOP
ELSE
BEGIN % MISSING END STATEMENT %
EXTERNAL POSTINCL;
IF .FLGREG<ININCLUD> THEN POSTINCL()
ELSE
IF .PSTATE EQL 0
THEN ( LEXICAL(.GSTEOP);LEAVE COMPILATION)
ELSE ( ENDSTA();
LEAVE STATEMENT !SKIP REST OF STATEMENT PROCESSING
)
END
END;
BEGIN % CLASSIFIED STATEMENT %
EXTERNAL CREFIT;
BIND LINNE = 2;
IF .FLGREG<CROSSREF> THEN CREFIT(.ISN,LINNE); !LINE NUMBER OF STATEMENT
IF DBUGIT THEN
BEGIN
EXTERNAL STRNGOUT,LINENO;
REGISTER T;
IF ( T_.BUGOUT AND 4) NEQ 0
THEN
BEGIN
STRNGOUT(KEYWRD(.STMNDESC));
DECODELINE(.ISN);
STRNGOUT(PLIT(' CLASSIFICATION - STATEMENT '));
STRNGOUT (LINENO);
STRNGOUT(PLIT'?M?J');
END
END;
% CHECK STATEMENT ORDERING %
% STRUCTURE FOR THE STATMENT ORDER CHECKING STATE TABLE %
BEGIN
STRUCTURE ORDERTAB[ST,CD] =
.ORDERTAB+(.CD*(PSTEND<0,0>+1))+.ST;
EXTERNAL STMNSTATE,STMNDESC,PSTATE;
MAP ORDERTAB STMNSTATE;
REGISTER CODE;
IF ( CODE _ .STMNSTATE[ .PSTATE, .ORDERCODE( @STMNDESC) ] ) LEQ PSTEND<0,0>
THEN
BEGIN % VALID ORDERING %
PSTATE _ .CODE
END
ELSE
BEGIN % ILLEGAL ORDERING %
EXTERNAL ISN,FATLERR,WARNERR;
CASE (.CODE-PSTEND<0,0>-1) OF SET
%OW - ORDER WARNING %
BEGIN
WARNERR ( KEYWRD(@STMNDESC)<0,0>, .ISN, E107<0,0> )
END;
% ED - MISSING END %
BEGIN
ENDSTA();
LEAVE STATEMENT ! END OF PROGRAM UNIT
END;
% BD - ILLEGAL STATEMENT IN BLOCK DATA %
BEGIN
FATLERR ( .ISN, E108<0,0> );
LEAVE STATEMENT ! SKIP THE STATEMENT
END;
% IE - INTERNAL COMPILER ERROR %
BEGIN
EXTERNAL FATLERR;
FATLERR ( PLIT'STORDER',.ISN,E61<0,0>)
END
TES
END
END
END;
% PRO