Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/sta1.bli
There are 12 other files named sta1.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,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE, D. B. TOLMAN/SJW/DCE
MODULE STA1(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
! LEXNAM, FIRST, TABLES, META72, ASHELP
SWITCHES NOLIST;
REQUIRE LEXNAM.BLI;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE META72.BLI;
REQUIRE ASHELP.BLI;
SWITCHES LIST;
GLOBAL BIND STA1V = 5^24 + 1^18 + 66; !VERSION DATE: 13-JAN-77
%(
REVISION HISTORY
57 ----- ----- FIX COMPLEX CONSTANTS IN DATA STATEMENTS SO THAT
THE ENTIRE CONSTANT CAN BE SIGNED
58 ----- ----- OPENCLOSE - FIX BUG THAT UNIT = WOULD DESTROY
THE CODE OF THE LAST PARAMETER .
AND WHILE WE ARE THERE FIX UP A FEW PARAMETER
VALUE LEGALITY CHECKS
59 ----- ----- CHECK FOR ILLEGAL LIST DIRECTED REREAD
60 ----- ----- IN DATAGEN - MUST CHECK THE SIGN OF THE
REPEAT COUNT ITSELF NOT JUST SIGNFLG
BECAUSE OF POSSIBLE NEGATIVE PARMETERS
61 ----- ----- FIX ERROR MESSAGE CALL FOR NON-ARRAY OPEN
STATEMENT PARAMETER VALUES
62 313 16666 FIX DIALOG WITH NO =
63 VER5 ----- HANDLE ERR= IN OPENCLOSE
64 424 QA690 ERROR IF DIRECTORY= NOT LITERAL OR ARRAY
NAME IN OPENCLOSE
BEGIN VERSION 5A, 7-NOV-76
65 521 QA900 FIX E15 PARAMS TO FATLEX IN OPENCLOSE
66 531 20323 GIVE WARNING FOR PARAMETER USED AS ASSOC VAR
)%
!THE NUMBER IN COMMENT'S IS THE STATEMENTS LOCATION
!IN THE HASH TABLE .
FORWARD
% 3% DATASTA, !DATA
% 8% PRINSTA, !PRINT
% 18% OPENSTA, !OPEN
% 34% FINDSTA, !FIND
% 39% REWISTA, !REWIND
% 45% RERESTA, !REREAD
% 63% BKSPST, !BACKSPACE OR BACKFILE
% 67% DECOSTA, !DECODE
% 83% CLOSSTA, !CLOSE
% 84% ENDFSTA, !ENDFILE
% 95% ENCOSTA, !ENCODE
%113% TYPESTA; !TYPE
GLOBAL ROUTINE BLDUTILITY(NODEDATA)=
BEGIN
%
ROUTINE BUILDS A STATEMENT NODE FOR REWIND AND UNLOAD STATEMENTS
STK[0] CONTAINS A PTR TO A PTR TO A BLOCK OF 2WORDS
1. CHOICE 1(CONSTANT) OR 2(VARIABLE)
2. PTR TO CONSTANT NODE OR SYNTAX OUTPUT FROM PARSE OF VARIABLESPEC
BLDVAR IS CALLED IF CHOICE 2 TO BUILD A VARIABLE REFERENCE NODE
%
EXTERNAL NAME,NEWENTRY,STK,SAVSPACE,BLDVAR,SETUSE;
REGISTER BASE T1;
REGISTER BASE R2;
MACRO ERR55=(FATLEX(E55<0,0>))$;
T1_@(.STK[0]+1);
SETUSE _ USE; ! FLAG FOR BLDVAR
IF .T1[ELMNT] NEQ 1
THEN
BEGIN
R2_ BLDVAR(.T1[ELMNT1]);
% 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> );
END
ELSE R2 _ .T1[ELMNT1];
IF .R2[VALTYPE] NEQ INTEGER THEN ERR55; !NON-INTEGER UNIT
NAME _ IDOFSTATEMENT _ .NODEDATA; NAME<RIGHT> _ SORTAB;
T1 _ NEWENTRY(); !MAKING SORCE NODE
T1[IOUNIT] _ .R2;
SAVSPACE(.STK[0]<LEFT>,.STK[0]);
END; !OF BLDUTILITY
GLOBAL ROUTINE BLDIO1(NODEDATA)= !BUILDS AN IO NODE FOR TYPE,PRINT,PUNCH,ACCEPT,BACKSPACE,BACKFILE,ENDFILE,SKIPFILE,SKIPRECORD
BEGIN
REGISTER BASE T1;REGISTER BASE R1:R2;
EXTERNAL STK,SAVSPACE %(SIZE, LOC)%,BLDFORMAT %(FPNT)%,DATALIST %(LPNT)%,
NEWENTRY %()%,TYPE,IODOXPN;
LOCAL F;
!----------------------------------------------------------------------------------------------------------
!THIS ROUTINE EXPECTS SYNTAX TO RETURN A POINTER IN STK[0] TO A
!FORMAT SPECIFICATION AND AN OPTIONAL IO LIST. SEE EXPANSIONS OF
!METASYMBOLS PRINT, FORMATID, AND DATAITEM FOR DETAILS.
!----------------------------------------------------------------------------------------------------------
R1_.STK[0];
TYPE_IF .NODEDATA EQL WRITDATA THEN WRITEE ELSE READD %READ AND REREAD % ;
!ABOVE FOR SETTING FLAG (STORD) IN LIST ITEMS SYMBOL TABLE ENTRIES
FLAG _ -1; !FLAG SAYS DON'T LOOK FOR END= IN BLDFORMAT
STK[4] _ 0; ! CLEAR THE FORMAT RETURN SPOT
IF BLDFORMAT(.R1) LSS 0 THEN RETURN .VREG;
F_.STK[4];
IF .R1[ELMNT2] NEQ 0 THEN !I/O LIST
BEGIN
R2_.R1[ELMNT3]; !GET PTR TO I/O LIST PTRS
!
!GENERATE LINKED LIST OF I/O NODES
!
IF (R2 _ DATALIST(.R2[ELMNT])) LSS 0 THEN RETURN .VREG;
END
ELSE
BEGIN % NO IOLIST%
IF .F EQL -1 THEN RETURN FATLEX(E96<0,0>);
%NO IO LIST FOR LIST DIRECTED IO%
R2_0;
END;
SAVSPACE(.R1<LEFT>,.R1);
NAME_IDOFSTATEMENT_.NODEDATA;NAME<RIGHT>_SORTAB;T1_NEWENTRY();
T1[IOFORM]_.F;
T1[IORECORD]_0;T1[IOLIST]_.R2<LEFT>;
IODOXPN(.T1); !DO XPN FOR IOLISTS
RETURN .T1
END;
GLOBAL ROUTINE PRINSTA=
BEGIN
REGISTER BASE T1;
!SEMANTIC ANALYSIS BEGINS
T1 _ BLDIO1(WRITDATA); !BUILDS THE PRINT STAEMENT IO NODE
T1[IOUNIT]_MAKECNST(INTEGER,0,-3); !PRINTID
.VREG
END;
GLOBAL ROUTINE TYPESTA=
BEGIN
REGISTER BASE T1;
!SEMANTIC ANALYSIS BEGINS
T1 _ BLDIO1(WRITDATA);
T1[IOUNIT] _ MAKECNST(INTEGER,0,-1); !TYPE ID
.VREG
END;
GLOBAL ROUTINE BLDEDCODE(NODEDATA)=
BEGIN
REGISTER BASE T1;REGISTER BASE R1:R2;
EXTERNAL STK,SAVSPACE %(SIZE,LOC)%, BLDFORMAT %(FPNT)%,BLDVAR %(VPNT)%,
IODOXPN,DATALIST %(LPNT)%,TYPE,CORMAN %()%,NEWENTRY %()%;
EXTERNAL SETUSE,STMNDESC;
MACRO ERR15(X)=RETURN FATLEX( INTGPLIT<0,0>, X, E15<0,0> )$;
LOCAL CH,F,B;
!----------------------------------------------------------------------------------------------------------
!THIS ROUTINE EXPECTS SYNTAX TO RETURN A POINTER IN STK[0] TO AN
!ENCODE/DECODE SPECIFICATION (CHARACTERS,FORMAT,BUFFER) FOLLOWED BY
!AN I/O LIST. SEE EXPANSIONS OF METASYMBOLS ENCODE, ENCODECODESPEC,
!EXPRESSION, FORMATID, VARIABLESPEC AND DATAITEM FOR DETAILS.
!----------------------------------------------------------------------------------------------------------
R1_.STK[0];
R2_.R1[ELMNT];
IF .R2[VALTYPE] NEQ INTEGER THEN ERR15 (PLIT SIXBIT 'COUNT');
CH_@R2;
!
!BLDFORMAT RETURNS RESULTS IN STK[4]
!
STK[4]_ 0;
FLAG _ 1; ! NO END= OR ERR= FLAG TO BLDFORMAT
IF BLDFORMAT(R1[ELMNT1]) LSS 0 THEN RETURN .VREG; !NOTE NON-DOTTED PARAMETER
IF (F_.STK[4]) EQL -1 THEN RETURN FATLEX(KEYWRD(@STMNDESC),E101<0,0>);
%NO LIST DIRECTED ENCODE/DECODE%
SETUSE _ IF .TYPE EQL WRITEE THEN SETT ELSE USE; !FLAG FOR BLDVAR
IF (B_BLDVAR(.R1[ELMNT3])) LSS 0 THEN RETURN .VREG;
IF .R1[ELMNT4] NEQ 0
THEN
BEGIN
IF (R2 _ DATALIST(.R1[ELMNT5])) LSS 0 THEN RETURN .VREG
END
ELSE R2 _ 0; ! NO IOLIST
NAME_IDOFSTATEMENT_.NODEDATA;NAME<RIGHT>_SORTAB;T1_NEWENTRY();
T1[IOUNIT]_.B;T1[IOFORM]_.F;T1[IORECORD]_.CH;T1[IOLIST]_.R2<LEFT>;
IODOXPN(.T1); !DO DOXPN FOR IOLIST
SAVSPACE(.R1<LEFT>,@R1);
.VREG
END;
GLOBAL ROUTINE ENCOSTA=
BEGIN
!SEMANTIC ANALYSIS BEGINS
TYPE _ WRITEE; !FLAG FOR DATALIST
BLDEDCODE(ENCODATA); !BUILD AN ENCODE STATEMENT NODE
.VREG
END;
GLOBAL ROUTINE DECOSTA=
BEGIN
!SEMANTIC ANALYSIS BEGINS
TYPE _ READD; ! FLAG FOR DATALIST
BLDEDCODE(DECODATA); !BUILD A DECODE STATEMENT NODE
.VREG
END;
GLOBAL ROUTINE RERESTA=
BEGIN
REGISTER BASE T1;
EXTERNAL STMNDESC,FATLEX,E101;
!SEMANTIC ANALYSIS BEGINS
!
T1 _ BLDIO1(REREDATA);
IF .T1[IOFORM] EQL #777777
THEN FATLEX(KEYWRD(@STMNDESC),E101<0,0>);
%NO LIST DIRECTED REREADS%
T1[IOUNIT] _ MAKECNST(INTEGER,0,-6); !RE READ ID
.VREG
END;
GLOBAL ROUTINE BKSPST=
BEGIN
EXTERNAL BLDREPT;
REGISTER R;
BIND DUM = PLIT( SP NAMES 'SPACE?0', FIL NAMES 'FILE?0' );
R _ BACKDATA;
LOOK4CHAR _ SP<36,7>;
DECR I FROM 1 TO 0
DO
BEGIN
IF LEXICAL(.GSTSSCAN) NEQ 0
THEN
BEGIN % GOT ONE %
IF SYNTAX(UTILSPEC) LSS 0 THEN RETURN .VREG;
RETURN BLDUTILITY(.R)
END;
R _ BKFILDATA; ! TRY FILE
LOOK4CHAR _ FIL<36,7>
END;
RETURN FATLEX(E12<0,0>); !MISSPELLED
END;
GLOBAL ROUTINE REWISTA=
BEGIN
!SEMANTIC ANALYSIS BEGINS
BLDUTILITY(REWIDATA); !BUILD A REWIND STATEMENT NODE
.VREG
END;
GLOBAL ROUTINE ENDFSTA=
BEGIN
!SEMANTIC ANALYSIS BEGINS
BLDUTILITY(ENDFDATA); !BUILD AN ENDFILE STATEMENT NODE
.VREG
END;
GLOBAL ROUTINE FINDSTA=
BEGIN
REGISTER BASE T1; REGISTER BASE R1:R2;
EXTERNAL STK,SAVSPACE %(SIZE,LOC)%,BLDVAR %(VPNT)%,NEWENTRY %()%;
EXTERNAL SETUSE;
MACRO ERR15(X) = RETURN FATLEX( INTGPLIT<0,0>, X, E15<0,0> ) $;
!SEMANTIC ANALYSIS BEGINS
!----------------------------------------------------------------------------------------------------------
!THIS ROUTINE EXPECTS SYNTAX TO RETURN A POINTER IN STK[0]
!TO A UNIT NUMBER (INTEGER CONSTANT OR VARIABLE) FOLLOWED
!BY A RECORD NUMBER. SEE EXPANSIONS OF METASYMBOLS FIND,
!VARIABLESPEC AND EXPRESSION FOR DETAILS.
!----------------------------------------------------------------------------------------------------------
R1_.STK[0];R2_.R1[ELMNT1]; !R2_LOC (CONSTANT OR VARIABLE)
IF .R1[ELMNT]EQL 1 THEN !CONSTANT
BEGIN
IF .R2[VALTYPE] NEQ INTEGER THEN ERR15(PLIT SIXBIT'UNIT');
END
ELSE !VARIABLE
BEGIN
T1_.R2[ELMNT]; !T1_LOC (IDENTIFIER)
IF .T1[VALTYPE] NEQ INTEGER THEN ERR15(T1[IDSYMBOL]);
SETUSE _ USE; !BLDVAR FLAG
IF (R2_BLDVAR(@R2)) LSS 0 THEN RETURN .VREG;
END;
NAME_IDOFSTATEMENT_FINDDATA;NAME<RIGHT>_SORTAB;T1_NEWENTRY();
T1[IOUNIT]_@R2;T1[IOFORM]_0;
T1[IORECORD]_.R1[ELMNT2];T1[IOLIST]_0;
T1[IOERR]_T1[IOEND]_0;
SAVSPACE(.R1<LEFT>,@R1);
.VREG
END;
ROUTINE CMPLXCONGEN(PTR , SIGNN )= !BUILDS A COMPLEX ONSTANT NODE FROM DATA LIST
!SEMANTIC OUTPUT
BEGIN
REGISTER SIGNFLG;
LOCAL BASE REALPT :IMAGPT;
EXTERNAL CNSTCM,C1H,C1L,C2H,C2L,COPRIX,KDPRL,KDNEGB,KTYPCB;
REGISTER BASE T1:T2;
ROUTINE SIGNEDREAL(CONST)=
%(****************************
GIVEN A PTR TO A CONSTANT TABLE ENTRY FOR THE REAL OR
IMAGINARY PART OF A COMPLEX CONST, (WHERE THAT PART MAY
ITSELF BE ANY TYPE) RETURN THE SINGLE-WD REAL
VALUE TO BE USED FOR THAT PART OF THE CONSTANT.
THE REGISTER-VARIABLE "SIGNFLG" IS ASSUMED TO BE "TRUE"
IF THE CONSTANT INDICATED BY "CONST" SHOULD BE NEGATED.
SIGNN - IS THE SIGN OF THE TOTAL CONSTANT
*******************************)%
BEGIN
MAP PEXPRNODE CONST;
C1H_.CONST[CONST1]; !HI ORDER PART
C1L_.CONST[CONST2]; !LOW ORDER PART
%(***IF CONST IS NOT REAL, CONVERT IT TO REAL. THE CONSTANT FOLDING
ROUTINE TAKES ITS ARG IN THE GLOBALS C1H,C1L***)%
IF .CONST[VALTYPE] NEQ REAL
THEN
BEGIN
COPRIX_KKTPCNVIX(REAL2,.CONST[VALTP2]); !INDEX INTO CONSTNT FOLDER
! FOR THE TYPE-CONV DESIRED
CNSTCM(); !CONVERT THE CONST IN C1H,C1L
! LEAVING RESULT IN C2H,C2L;
C1H_.C2H;
C1L_.C2L
END;
%(***ROUND THE 2 WD REAL TO A SINGLE-WD REAL***)%
IF .CONST[VALTYPE] NEQ DOUBLOCT
THEN
BEGIN !DONT ROUND DOUBLE-OCTAL
COPRIX_KDPRL; !INDEX INTO THE CONST FOLDER FOR ROUNDING
! DOUBLE-WD REAL TO SINGLE-WD REAL
CNSTCM(); !ROUND THE DOUBLE-WD REAL IN C1H-C1L, LEAVING
! RESULT IN C2H
C1H_ .C2H
END;
%(***IF THE VALUE SHOULD BE NEGATED, DO SO***)%
IF .SIGNFLG
THEN RETURN -.C1H
ELSE RETURN .C1H
END;
%(***PROCESS REAL PART**)%
T1 _ .PTR;
SIGNFLG _ .SIGNN;
IF .T1[ELMNT] NEQ 0 !IS IT SIGNED?
THEN
(IF .T1[ELMNT] EQL 2 THEN SIGNFLG _ -1 -.SIGNN;
T1_.T1+1;
);
REALPT_SIGNEDREAL(.T1[ELMNT1]);
%(***PROCESS IMAGINARY PART**)%
SIGNFLG _ .SIGNN;
T1_.T1+2; !SKIP TO IMAG PART
IF .T1[ELMNT] NEQ 0
THEN (IF .T1[ELMNT] EQL 2 THEN SIGNFLG_ -1 -.SIGNN;
T1_.T1+1;
);
IMAGPT _ SIGNEDREAL(.T1[ELMNT1]);
!NOW MAKE ACOMPLEX CONSTANT NODE
RETURN MAKECNST(COMPLEX,.REALPT,.IMAGPT);
END; !OF ROUTINE CPLXCONGEN
GLOBAL ROUTINE DATAGEN(CONLIST)=
BEGIN
EXTERNAL CORMAN,NAME,SAVSPACE;
LOCAL REPEAT,COUNT,DATCSIZ,SIGNFLG;
LOCAL BASE CONNODE :CONPTR;
LABEL DAT1;
MACRO ERR54 = ( FATLEX(E54<0,0>))$;
EXTERNAL CNSTCM,C1H,C1L,C2H,C2L,COPRIX,KDPRL,KDNEGB;
MACRO DNEG(X,Y)=
BEGIN
C1H _ X[CONST1]; !HIGH ORDER
C1L _ X[CONST2]; !LOW ORDER
COPRIX _ KDNEGB + .CKA10FLG;
CNSTCM(); !CONVERT TO NEG
MAKECNST(Y,.C2H,.C2L)
END$;
MACRO DDATCONNODE =
BEGIN
NAME<LEFT> _ 2; CONNODE _ CORMAN();
IF .CONPTR EQL 0
THEN (CONPTR<LEFT> _ CONPTR<RIGHT> _ .CONNODE)
ELSE (CONPTR[CLINK] _ .CONNODE;
CONPTR<RIGHT> _.CONNODE;
);
END$;
REGISTER BASE T1:T2; MAP BASE CONLIST;
%
ROUTINE BUILDS A LIST OF DATA CONSTANTS AND KEEPS COUNT FOR LATER USE
BY THE DATA LIST PROCESSING ROUTINES
%
CONPTR _ 0; COUNT _ 0;
INCR CONITEM FROM .CONLIST TO .CONLIST+.CONLIST<LEFT> BY 2 DO
BEGIN
MAP BASE CONITEM;
REPEAT _ 1; !INITIALIZE
SIGNFLG _ 0;
!SEE IF CONSTANT IS LITERAL OR NUMBER
DAT1: IF .CONITEM[ELMNT] EQL 1
THEN !NUMBER
BEGIN
T1 _ .CONITEM[ELMNT1]; !PTR TO 2 OR 3 WORD SET CONST [* CONST]
IF .T1[ELMNT] NEQ 0
THEN( !SIGHNED CONSTANT
IF .T1[ELMNT] EQL 2 !MINUS
THEN SIGNFLG_-1 ELSE SIGNFLG_0;
T1 _ .T1+1;! TO GET PAST THE SIGN
)
ELSE SIGNFLG _ 0;
%NOW DECIDE WHETHER WE HAVE A CONSTANT OR COMPLEX CONSTANT%
IF .T1[ELMNT1] EQL 2
THEN
BEGIN %COMPLEX CONSTANT%
T2 _ CMPLXCONGEN( .T1[ELMNT2] , .SIGNFLG );
COUNT _ .COUNT + 2;
SIGNFLG _ 0; !COMPLEX SIGNS ARE DONE
END
ELSE
BEGIN %ITS AN INTEGER OR REAL%
T1 _ .T1[ELMNT2]; !POINTER TO CONSTANT-OPTION
T2 _ .T1[ELMNT]; !PTR TO FIRST CONSTANT OR REPEAT COUNT
IF .T1[ELMNT1] NEQ 0
THEN (!REPEAT FACTOR T2 POINTS TO REPEAT CONST
IF .T2[VALTYPE] NEQ INTEGER
THEN (ERR54; REPEAT _ 0; LEAVE DAT1);
%DO THIS IN CASE OF NEGATIVE PARAMETER VALUES%
IF .SIGNFLG NEQ 0
THEN T2 _ MAKECNST(INTEGER,0,-.T2[CONST2]);
IF .T2[CONST2] LSS 0 THEN (ERR54; REPEAT _ 0; LEAVE DAT1);
REPEAT _ .T2[CONST2]; !REPEAT VALUE
T1 _ .T1[ELMNT2]; !PTR TO REPEATED CONST OR LITERAL
T2 _ .T1[ELMNT2]; !PTR TO ACTUAL CONSTANT OR LITSTRING NODE
IF .T1[ELMNT1] EQL 1
THEN !NUMBER
(
IF .T2[ELMNT] NEQ 0
THEN (!SIGNED NUMBER
IF .T2[ELMNT] EQL 2
THEN SIGNFLG_-1 ELSE SIGNFLG_0;
T2 _ .T2+1
)
ELSE SIGNFLG _ 0;
%NOW WHAT KIND OF CONSTANT DO WE HAVE%
IF .T2[ELMNT1] EQL 2
THEN
BEGIN %COMPLEX%
T2_ CMPLXCONGEN( .T2[ELMNT2] , .SIGNFLG );
COUNT _ .COUNT+2;
SIGNFLG _ 0
END
ELSE
BEGIN %REAL OR INTEGER OR DOUBLE%
T2 _ .T2[ELMNT2]; !CONSTANT LEXEME
DATCSIZ _ IF .T2[DBLFLG] THEN 2 ELSE 1
END
)
ELSE !LITERAL
DATCSIZ _ .T2[LITSIZ]
)
ELSE ( %NO REPEAT%
DATCSIZ _ IF .T2[DBLFLG] THEN 2 ELSE 1;
);
COUNT _ .COUNT + .DATCSIZ * .REPEAT;
IF .SIGNFLG NEQ 0
THEN IF .T2[VALTP1] EQL INTEG1
THEN T2 _ MAKECNST(INTEGER,0,-.T2[CONST2])
ELSE T2 _ DNEG(.T2,.T2[VALTYPE]); !NEGATE THE NUMBER
END % CONSTANT OR COMPLEX %
END
ELSE !LITERAL
BEGIN
T2 _ .CONITEM[ELMNT1]; !PTR TO LITERAL STRING NODE
COUNT _ .COUNT + .T2[LITSIZ];
END;
DDATCONNODE; !BUILD AND LINK A DATA CONSTANT NODE
CONPTR[DATARPT] _ .REPEAT;
CONPTR[DCONST] _ .T2;
END; !OF INCR LOOP
RETURN .COUNT^18+ .CONPTR<LEFT>;
END;
GLOBAL ROUTINE DATASTA=
BEGIN
REGISTER BASE T1;
REGISTER BASE R1:R2;
LOCAL ITEMLIST,CONLIST;
EXTERNAL DATAGEN %(LOC,SIZE)%,SAVSPACE %(SIZE,LOC)%,STK,SP,DATALIST,TYPE,NEWENTRY;
EXTERNAL DATASUBCHK;
!SEMANTIC ANALYSIS BEGINS
T1_@.STK[0]; !T1_LOC(DATASPEC OR LIST A,LINEND)
INCR DAT FROM .T1 TO .T1+.T1<LEFT> DO
BEGIN !PROCESS LIST OF DATA SPECIFICATIONS
MAP BASE DAT;
R1 _ .DAT[ELMNT]; !PTR TO 2 ITEM LIST - 1.DATALIST PTR
! 2.CONLIST PTR
T1 _ .R1[ELMNT1]; !PROCESS CONLIST PTR FIRST FO COUNT NUMBER OF CONSTANTS
!T1 POINTS TO 3 WORD LIST (SLASH,CONLISTPTR,SLASH)
R2 _ .T1[ELMNT1]; !GET PTR TO LIST OF CONSTANT SPECS
SAVSPACE (.T1<LEFT>,.T1); !GET BACK SPACE
CONLIST _ DATAGEN(.R2);
SAVSPACE(.R2<LEFT>,.R2);
!
!NOW PROCESS LIST OF DATA ITEM SPECIFICATIONS
!USE THE SAME ROUTINE AS USED BY IO LISTS AND RETURN PTR
!TO SAME KIND OF LIST STRUCTURE AS IO LISTS
!
TYPE _ DATALST; !SIGNAL DATA STATEMENT TO DATALIST ROUTINE
SP _ 0; !RESET FOR USE IN DATALIST
ITEMLIST _ DATALIST(.R1[ELMNT]); !USEING FIRST ITEM POINTED TO BY R1
DATASUBCHK(.ITEMLIST<LEFT>,0,0); !CHECK SUBSCRIPTS ON LIST ITEMS FOR VALIDITY
SAVSPACE(.R1<LEFT>,.R1); !RETRIEVE SOME SPACE
!
!NOW BUILD A DATA STATEMENT NODE AND LINK TO ANY PREVIOUS ONES
!
NAME _ DATATAB; !ID OF DATA TABLE FOR NEWENTRY
R2 _ NEWENTRY();
!FILL IN PTRS TO LISTS IN DATA NODE
!
R2[DATITEMS] _ .ITEMLIST<LEFT>; R2[DATCONS] _ .CONLIST;
R2[DATCOUNT] _ .CONLIST<LEFT>; !NUMBER OF CONSTANTS SPECIFIED
R2[DATISN]_.ISN; !STMNT NUMBER (NEEDED FOR ERROR MESSAGES
! IN ALLOCATION ROUTINE)
END; !OF INCR LOOP
T1 _ @.STK[0]; SAVSPACE(.T1<LEFT>,.T1); SAVSPACE(0,.STK[0]);
.VREG
END; !OF DATASTA
GLOBAL ROUTINE STRNGSCAN= !STRING SCAN
!PUTS A STRING OF UP TO 6 SIXBIT CHARACTERS
!IN SIX LEFT JUSTIFIED AND RETURNS IT
BEGIN
EXTERNAL LEXICAL,GSTCSCAN,LOOK4CHAR;
REGISTER SIX,C;
LOOK4CHAR _ "?L"; ! ANY LETTER
DECR SHIFT FROM 30 TO 0 BY 6 DO !PACK THE FIRST 6 CHARACTERS
BEGIN
MACHOP ADDI=#271;
SIX_.SIX^6;
IF ( C _ LEXICAL(.GSTCSCAN ) ) EQL 0
THEN RETURN ( SIX _ .SIX^.SHIFT ) ! NO MORE LETTERS
ELSE ADDI ( SIX, -" ", C ) ! CONVERT TO SIXBIT AND PUT IN SIX
END;
DO
IF LEXICAL(.GSTCSCAN) EQL 0 THEN RETURN .SIX ! SKIP ALL CHARS PAST 6
WHILE 1;
END; !OF STRNGSCAN
GLOBAL ROUTINE OPENCLOSE(OPENCLOSDATA)=
BEGIN
OWN BASE PT;
REGISTER BASE R1:T1:T2;
EXTERNAL FATLEX;
!**;[531], OPENCLOSE @3958, DCE, 13-JAN-77
%[531]% EXTERNAL E143;
EXTERNAL LEXEMEGEN %()%, LSAVE, LEXL, STK,SP,SYNTAX %(META)%,
BLDVAR %(VPNT)%, CORMAN %()%, NEWENTRY %()%,STRNGSCAN;
%[V5]% EXTERNAL NONIOINIO; ! FLAG FOR LABREF THRU LEXICAL
%[V5]% EXTERNAL