Google
 

Trailing-Edge - PDP-10 Archives - AP-D480B-SB_1978 - 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  LABELS  %()%;		! SET LOOK4LABELS
%[V5]%	EXTERNAL  E34;			! DUPLICATE ERR= PARAMETER

	LABEL OPEN1,OPEN2;
	MACRO CHKCTYPE(X)=
	BEGIN
	PT _ .X;
	IF .PT[VALTYPE] NEQ INTEGER
		AND .PT[VALTYPE]  NEQ  OCTAL
	 THEN RETURN FATLEX ( PLIT SIXBIT'VALUE',E94<0,0>);
	END$;
	MACRO CHKTYPE(X)=
	BEGIN
	PT _ .X;
	IF .PT[VALTYPE] NEQ INTEGER
	 THEN RETURN FATLEX ( PT[IDSYMBOL],E94<0,0>);
	END$;
	MACRO CHKVTYP(X)=
	BEGIN
	PT_.X;
	IF .PT[VALTYPE] EQL LOGICAL
	 THEN RETURN FATLEX ( PT[IDSYMBOL],E94<0,0>);
	END$;
	MACRO
		UNITP = #25$,
%[V5]%		ERREQ = #26$,		! ARGID FOR ERR=
		ACCESS(I) = (PARAM[I]+1)<LEFT> $,
		ARGID(I) = (PARAM[I]+1)<RIGHT>  $,
		DIALOG = 1$,
		OPENACCESS = 0,0,0,18$,	!ACESSS MODE
		OPENARGID = 18,18$,	!TYPE OF ARGUMENT
		ERR15(X)=(PT_.LEXL;RETURN FATLEX(X,PT,E15<0,0>))$;

%[V5]%	MACRO	ERR34  =  RETURN FATLEX (PLIT 'PARAMETER',
%[V5]%					 PLIT (SIXBIT 'ERR'),
%[V5]%					 E34<0,0>)$;

	MACHOP BLT=#251;LOCAL RQD;
%[V5]%	BIND NUMPARAM = 18;
	BIND PARAM=PLIT(	!	  CONST	VAR	LIT	NAME	ARRAY	NULL
%1%	 SIXBIT'UNIT  ',0  ^18+	#25 ,	!    X		 X
%2%	 SIXBIT'FILE',1  ^18+	#6 ,	!		 X	 X
%3%	 SIXBIT'RECORD',0  ^18+	#14 ,	!    X		 X
%4%	 SIXBIT'ASSOCI',3  ^18+	#22 ,	!		 X
!%5%	 SIXBIT'ERROR ',3  ^18+	#21 ,	!		 X
%6%	 SIXBIT'DIALOG',2  ^18+	#1 ,	!			 X		   X	  X
%7%	 SIXBIT'DEVICE',1  ^18+	#3 ,	!		 X	 X
%8%	 SIXBIT'ACCESS',1  ^18+	#2 ,	!	  X	  X
%9%	 SIXBIT'MODE  ',1  ^18+	#12 ,	!		 X	 X
%10%	 SIXBIT'PROTEC',0  ^18+	#7 ,	!    X		 X
%11%	 SIXBIT'DIRECT',2  ^18+	#10 ,	!			 X		   X
%12%	 SIXBIT'DISPOS',1  ^18+	#15 ,	!		 X	 X
%13%	 SIXBIT'FILESI',0  ^18+	#13 ,	!    X		 X
%14%	 SIXBIT'BLOCKS',0  ^18+	#5 ,	!    X		 X
%15%	 SIXBIT'BUFFER',0  ^18+	#4 ,	!    X		 X
%16%	 SIXBIT'VERSIO',0  ^18+	#16 ,	!    X		 X
!%17%	 SIXBIT 'LIMIT',0  ^18+	#11 ,	!    X		 X
!%18%	 SIXBIT'REELS ',2  ^18+	#17 ,	!			 X		   X
!%19%	 SIXBIT'MOUNT ',2  ^18+	#20 ,	!			 X		   X
%20%	 SIXBIT'PARITY',1  ^18+	#23,
%21%	 SIXBIT'DENSIT',1  ^18+	#24,
%22%	 SIXBIT'ERR   ',5  ^18+ #26	! HANDLED SEPARATELY	%[V5]%
	);
	BIND OPENPLIT= PLIT'OPEN';
	EXTERNAL  SETUSE,NAMREF;
	LOCAL OARGID;	!OPENARG ID
%[V5]%	LOCAL BASE  ERRLAB;	! ERR= LABEL


	ROUTINE  GETVARB  =
	BEGIN
		IF SYNTAX(VARIABLESPEC) LSS 0 THEN RETURN .VREG;
		R1_.STK[.SP];
		IF (R1 _ STK[.SP]_BLDVAR(@R1)) LSS 0 THEN RETURN .VREG;
		% BLDVAR ALLOWS ARRAYS WITHOUT SUBSCRIPTS SO DON'T LET THEM THROUGH HERE %
		IF .R1<LEFT>  EQL  IDENTIFIER
		THEN	IF  .R1[OPRSP1]  EQL   ARRAYNM1
			THEN	RETURN FATLEX  ( R1[IDSYMBOL], ARPLIT<0,0>, E4<0,0> );
	END;	%GETVARB%

!SEMANTIC ANALYSIS BEGINS
	!----------------------------------------------------------------------------------------------------------
	!THIS ROUTINE SCANS THE PARAMETERS OF THE OPEN STATEMENT
	!FOR THE UNIQUE PARAMETER NAMES SPECIFIED ABOVE IN THE PARAM
	!PLIT.  FOR EACH UNIQUE PARAMETER NAME THERE IS ONLY ONE OF
	!SIX POSSIBLE PARAMETER TYPES WHICH IS LEGAL.  THESE ARE SPECIFIED
	!BY THE SECOND ENTRY OF EACH SUBPLIT AS: CONSTANT OR VARIABLE (0),
	!VARIABLE OR LITERAL (1), LITERAL OR ARRAY NAME (2), VARIABLE (3),
	!OR A UNIQUE NAME (4).  THESE PARAMETERS, AFTER BEING SCANNED
	!ARE PLACED IN A PSEUDO-OPEN NODE ON THE STACK FORM
	!PARAMETER NUMBER^18+LOC.
	!----------------------------------------------------------------------------------------------------------
	SETUSE _ USE;	! BLDVAR FLAG - ALL VARIABLES HERE ARE REFERENCE
	RQD _ 0;	!RESET RQUIRED ARG (UNIT)
%[V5]%	ERRLAB _ 0;	! RESET ERR= LABEL
	LEXL_LEXEMEGEN(); STK[0]_0; SP_-1;
	IF .LEXL NEQ LPAREN^18 THEN ERR0L(LPARPLIT);
	DO
	BEGIN
	LABEL UNITSKIP;
	UNITSKIP:BEGIN

		LEXL_STRNGSCAN();
		IF .LEXL EQL 0 THEN ( LEXL_LEXEMEGEN();EXITLOOP );	! NO NAME TO BE FOUND
		R1_.LEXL;
		OPEN1:BEGIN
			INCR I FROM 0 TO ( NUMPARAM-1 ) * 2  BY 2  DO
			BEGIN
			IF .R1 EQL @PARAM[.I] THEN (OARGID_.ARGID(.I);R1 _ .ACCESS(.I);LEAVE OPEN1 );
			END;
			ERR15(PLIT'OPEN/CLOSE PARAMETER')
		END ; %OPEN1%
		IF .OARGID EQL UNITP  THEN RQD_-1;	!SET REQUIRED FLAG
		LEXL_LEXEMEGEN();
		IF .LEXL NEQ EQUAL^18 THEN
%**;[313],STA1,JNT,02-JUL-75%
%**;[313],IN OPENCLOSE @ 4058%
			(IF .OARGID EQL DIALOG THEN	![313] DIALOG IS ONLY POSSIBILITY
				(STK[SP_.SP+1]<WHOLE>_DIALOG^18;	![313] SET TO DIALOG WITH 0 PTR
				LSAVE_-1;	![313] DON'T GET ANOTHER LEXEME
				LEAVE UNITSKIP)	![313] ON TO NEXT PARAMETER
				ELSE ERR0L(PLIT'"="');
			);

%[V5]%		IF .OARGID EQL ERREQ
%[V5]%		  THEN BEGIN		! PROCESS ERR= LABEL
%[V5]%		    IF .ERRLAB NEQ 0
%[V5]%		      THEN ERR34;	! DUPLICATE ERR= PARAMETER
%[V5]%		    LABELS ();		! SET "LABEL REQUIRED" SWITCH
%[V5]%		    NONIOINIO _ 1;	! EXECUTABLE LABEL IN IO STATEMENT OK
%[V5]%		    ERRLAB _ LEXEMEGEN ();
%[V5]%!				LOOK4LABELS & NONIOINIO ALREADY RESET
%[V5]%		    LSAVE _ 0;		! GET NEXT LEXEME
%[V5]%		    LEAVE UNITSKIP;	! DON'T PUT ANYTHING IN STK
%[V5]%		  END;

		LEXL_LEXEMEGEN(); LSAVE _ -1;
		  CASE .R1 OF SET
		    BEGIN !CONSTANT OR VARIABLE
			IF .LEXL<LEFT> EQL CONSTLEX
				THEN (CHKCTYPE(LEXL<RIGHT>);
					STK[SP_.SP+1]_.LEXL<RIGHT>;
					 LSAVE _ 0)
				ELSE IF .LEXL<LEFT> EQL IDENTIFIER THEN
					BEGIN
						CHKTYPE(LEXL<RIGHT>); !MAKE SURE ARG IS INTEGER
						IF GETVARB() LSS 0 THEN RETURN .VREG
					END ELSE ERR0L(PLIT'CONSTANT OR VARIABLE');
			IF .RQD EQL -1 THEN(RQD _ .STK[.SP]<RIGHT>; SP_.SP-1;LEAVE UNITSKIP %DON'T SET OPENARGID%);
		    END;
		    BEGIN !VARIABLE OR LITERAL
			IF .LEXL<LEFT> EQL LITSTRING THEN (STK[SP_.SP+1]_.LEXL<RIGHT>; LSAVE _ 0)
				ELSE IF .LEXL<LEFT> EQL IDENTIFIER THEN
					BEGIN
						CHKVTYP(LEXL<RIGHT>); !MAKE SURE ARG TYPE IS VALID
						IF GETVARB() LSS 0 THEN RETURN .VREG
					END ELSE ERR0L (PLIT'VARIABLE OR LITERAL');
		    END;
		    BEGIN !LITERAL OR ARRAY NAME
			IF .LEXL<LEFT> EQL LITSTRING THEN STK[SP_.SP+1]_.LEXL<RIGHT>
				ELSE IF .LEXL<LEFT> EQL IDENTIFIER THEN
					BEGIN
						R1_@LEXL;
						IF .R1[OPRSP1] NEQ ARRAYNM1
								THEN  RETURN FATLEX(PLIT'ARRAY',R1[IDSYMBOL],E15<0,0>)
								ELSE STK[SP_.SP+1]_@R1;
						NAMREF ( ARRAYNM1, .R1 )
!**[424} OPENCLOSE @4138 SJW 17-AUG-76
%[424]%					END ELSE ERR0L (PLIT 'LITERAL OR ARRAY NAME');
			LSAVE _ 0;
		    END;
		    BEGIN !VARIABLE
			IF .LEXL<LEFT> EQL IDENTIFIER THEN
			BEGIN
				CHKTYPE(LEXL<RIGHT>); !MAKE SURE ARG IS INTEGER
!**;[531], OPENCLOSE @4110, DCE, 13-JAN-77
!**;[531], GIVE WARNING FOR SUBROUTINE PARAMETER USED AS ASSOCIATE VAR
%[531]%				T1_.LEXL;
%[531]%				IF .T1[OPR1] EQL FMLVARFL
%[531]%					THEN WARNERR(.ISN,E143<0,0>);
				IF GETVARB()  LSS 0 THEN RETURN .VREG
			END ELSE ERR0L(PLIT'VARIABLE');
		    END
		   TES;
	  STK[.SP]<OPENARGID>_.OARGID;
	END; % OF UNIT SKIP %
	 IF .LSAVE NEQ 0 THEN LSAVE _ 0 ELSE LEXL _ LEXEMEGEN();
	END WHILE .LEXL<LEFT> EQL COMMA;
	IF .LEXL NEQ RPAREN^18 THEN ERR0L(RPARPLIT);
	IF LEXEMEGEN() NEQ LINEND^18 THEN ERR0L(PLIT'LINEND');
	IF .RQD EQL 0 THEN
!**[521] OPENCLOSE @4162 SJW 24-NOV-76
![521] FIX PARAMS TO E15 IN FATLEX: E15 =?B IS NOT ?C
![521]				    1ST PARAM IS ?C IN 7BIT
![521]				    2ND PARAM IS ?B IN 6BIT
		RETURN FATLEX(PLIT 'DEFINED',PLIT SIXBIT'UNIT',E15<0,0>);
	IF .SP GEQ 0
	THEN(
		NAME<LEFT>_.SP+1;R1_CORMAN();
		T1<LEFT>_STK[0];T1<RIGHT>_.R1;T2_.R1+.SP;BLT(T1,0,T2);
	    )
	ELSE R1 _ 0;
	NAME_IDOFSTATEMENT_.OPENCLOSDATA;NAME<RIGHT>_SORTAB;T1_NEWENTRY();
	T1[OPSIZ]_.SP+1;T1[OPLST]_.R1; T1[IOUNIT] _ .RQD;
%[V5]%	T1 [IOERR] _ .ERRLAB<RIGHT>;
	SP _ -1;
	.VREG
END;
GLOBAL ROUTINE OPENSTA=
BEGIN
EXTERNAL OPENCLOSE;
	OPENCLOSE(OPENDATA);
	.VREG
END;
GLOBAL ROUTINE CLOSSTA=
BEGIN
EXTERNAL OPENCLOSE;
	OPENCLOSE(CLOSDATA);
	.VREG
END;
END
ELUDOM