Google
 

Trailing-Edge - PDP-10 Archives - BB-L014E-BM - autopatch/act1.c05
There are no other files named act1.c05 in the archive.
 REP 5/1	;05C1
	!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
	!AUTHOR: T.E. OSTEN/FJI/MD/SJW/JNG/DCE/TFV/AHM
 WIT
	!COPYRIGHT (C) 1972,1981,1982 BY DIGITAL EQUIPMENT CORPORATION
	!AUTHOR: T.E. OSTEN/FJI/MD/SJW/JNG/DCE/TFV/AHM/EGM
 REP 22/1	;05C2
	GLOBAL BIND ACT1V = 6^24 + 0^18 + 128;		! Version Date:	19-Oct-81
 WIT
	GLOBAL BIND ACT1V = 6^24 + 0^18 + #1155;		! Version Date:	9-Jun-82
 INS 176/1	;05C3
	***** End V6 Development *****

	1153	EGM	3-Jun-82
		Add appropriate calls to SAVSPACE to free up systax list items that
		are no longer needed. Also eliminate one overzealous call, and the
		routine BLDUNIT which is no longer used.

	1155	EGM	9-Jun-82
		Allow BLDARRAY to continue processing ONEARRAY list after semantic
		errors are seen. This allows detection of multiple errors per
		statement, and frequently eliminates annoying 'not dimensioned'
		errors.

 REP 190/1	;05C4
			BLDUNIT,	!
 WIT
	%[1153]%
 INS 1157/1	;05C5
	%[1155]% LOCAL BLDSTATUS;	!Deferred return status, 0=All OK,
	%[1155]%			! -1=Error in 1 or more items

 INS 1194/1	;05C6
	%[1155]% BLDSTATUS_0;		!Assume all items are OK
 REP 1309/1	;05C7
					IF NAMDEF(IDDEFT, .T1) LSS 0 THEN RETURN .VREG;
					T1[IDATTRIBUT(INTYPE)] _ 1;
					T1[VALTYPE]_.IDTYPE;
 WIT
	%[1155]%			IF NAMDEF(IDDEFT, .T1) LSS 0 THEN BLDSTATUS_.VREG
	%[1155]%			ELSE
	%[1155]%			BEGIN
	%[1155]%				T1[IDATTRIBUT(INTYPE)] _ 1;
	%[1155]%				T1[VALTYPE]_.IDTYPE
	%[1155]%			END;
 REP 1315/1	;05C8
					IF NAMDEF( VARARY, .T1) LSS 0 THEN RETURN .VREG;
					CHKCOMMON(.T1);	!ROUTINE TO CHECK COMMON DECLARATION
 WIT
	%[1155]%			IF NAMDEF( VARARY, .T1) LSS 0 THEN BLDSTATUS_.VREG;
	%[1155]%			IF CHKCOMMON(.T1) LSS 0 THEN BLDSTATUS_.VREG	!CHECK COMMON DECLARATION
 REP 1329/1	;05C9
						IF NAMDEF(ARRYDEF,.T1) LSS 0 THEN RETURN .VREG
 WIT
	%[1155]%				IF NAMDEF(ARRYDEF,.T1) LSS 0 THEN BLDSTATUS_.VREG
 REP 1341/1	;05C10
						IF NAMDEF(ARRYDEFT,.T1) LSS 0 THEN RETURN .VREG;
						T1[IDATTRIBUT(INTYPE)] _ 1;
						T1[VALTYPE]_.IDTYPE;
 WIT
	%[1155]%				IF NAMDEF(ARRYDEFT,.T1) LSS 0 THEN BLDSTATUS_.VREG
	%[1155]%				ELSE
	%[1155]%				BEGIN
	%[1155]%					T1[IDATTRIBUT(INTYPE)] _ 1;
	%[1155]%					T1[VALTYPE]_.IDTYPE
	%[1155]%				END;
 REP 1347/1	;05C11
						IF NAMDEF (ARRYDEF,.T1) LSS 0 THEN RETURN .VREG;
						IF CHKCOMMON(.T1) LSS 0 THEN RETURN .VREG;	!CHECK COMMON DECLARATIONS
 WIT
	%[1155]%				IF NAMDEF (ARRYDEF,.T1) LSS 0 THEN BLDSTATUS_.VREG;
	%[1155]%				IF CHKCOMMON(.T1) LSS 0 THEN BLDSTATUS_.VREG	!CHECK COMMON DECLARATIONS
 REP 1358/1	;05C12
				IF (T2_BLDDIM(.R2[ELMNT])) LSS 0 THEN RETURN .VREG
 WIT
	%[1155]%		IF (T2_BLDDIM(.R2[ELMNT])) LSS 0 THEN BLDSTATUS_.VREG
 INS 1374/1	;05C13
	%[1155]% RETURN .BLDSTATUS		!Deferred status
 REP 1805/1	;05C14
	GLOBAL ROUTINE BLDUNIT (UPNT)=
	BEGIN
		MAP BASE UPNT; LOCAL BASE T2;REGISTER BASE R1:T1:R2;
		EXTERNAL SAVSPACE %(SIZE,LOC)%,STK,BLDFORMAT %(FPNT)%,BLDVAR %(UPNT)%;
		EXTERNAL SETUSE,NAMLSTOK;
		EXTERNAL CNVNODE;
		MACRO
		ERR15(X)=RETURN FATLEX( INTGPLIT<0,0>, X, E15<0,0> )  $;
		!----------------------------------------------------------------------------------------------------------
		!THIS ROUTINE IS CALLED WITH THE PARAMETER UPNT POINTING
		!TO A UNITSPEC OPTIONALLY FOLLOWED BY A FORMATID.  SEE
		!EXPANSIONS OF THE METASYMBOLS IOSPEC, UNITSPEC AND FORMATID FOR
		!DETAILS.  A UNIT NUMBER MAY BE AN INTEGER CONSTANT OR AN INTEGER
		!VARIABLE.  IF A FORMAT IS PRESENT THE ROUTINE BLDFORMAT IS CALLED
		!TO SCAN THE FORMAT.  UPON EXIT FROM THIS ROUTINE THE FOLLOWING
		!LOCATIONS WILL BE DEFINED:
		!
		!	STK[2]=UNIT
		!	STK[3]=RECORD
		!	STK[4]=FORMAT
		!	STK[5]=ERR
		!	STK[6]=END
		!----------------------------------------------------------------------------------------------------------
		R1_.UPNT[ELMNT];R2_.R1[ELMNT1];  !R2_LOC(CONSTANT OR VARIABLE)
		IF .R1[ELMNT] EQL 1 THEN !INTEGER CONSTNAT
		BEGIN
			IF .R2[VALTYPE] NEQ INTEGER THEN ERR15 (PLIT SIXBIT 'UNIT');
			STK[2]_.R2
		END
		ELSE !VARIABLE
		BEGIN
			T2 _ .R2[ELMNT];	!PTR TO IDENTIFIER OR CONSTANT NODE
			IF .T2[VALTYPE] NEQ INTEGER THEN ERR15 (T2[IDSYMBOL]);
			SETUSE _ USE;
			IF (STK[2]_BLDVAR(.R2)) LSS 0 THEN RETURN .VREG;
			%DON'T LET UNSUBSCRIPTED ARRAYS THROUGH%
			IF .VREG<LEFT>  EQL  IDENTIFIER
			THEN	( MAP BASE VREG;
				  IF .VREG[OPRSP1]  EQL  ARRAYNM1
				  THEN	RETURN FATLEX( VREG[IDSYMBOL],ARPLIT<0,0>,E4<0,0>);
				);
		END;
		IF .R1[ELMNT2] NEQ 0 THEN !RECORD NUMBER
		BEGIN
			STK[3] _ .R1[ELMNT3];
			T1 _ @@STK[3];
			IF .T1[VALTP1] NEQ INTEG1
			  THEN  (.STK[3])<FULL> _ CNVNODE(.T1,INTEGER,0);
		END ELSE ( NAMLSTOK _ 1; STK[3]_0 ) ;
		SAVSPACE(.R1<LEFT>,@R1);
		STK[4]_STK[5]_STK[6]_0;
		IF .UPNT[ELMNT1] NEQ 0 THEN !FORMAT, END/ERR
		BEGIN
			R2_.UPNT[ELMNT2];
			T1 _ .R2[ELMNT];
			INCR FMT FROM .T1 TO .T1+.T1<LEFT> DO
			BEGIN
				MAP BASE FMT;
				FLAG _ 0; !SIGNAL BLDFORMAT FOR POSSIBLE END= OR ERR=
				IF BLDFORMAT(.FMT[ELMNT]) LSS 0 THEN ( NAMLSTOK _ 0;  RETURN .VREG);
				SAVSPACE(.FMT[ELMNT]<LEFT>,.FMT[ELMNT]);
			END;
			T1 _ .R2[ELMNT]; SAVSPACE(.T1<LEFT>,.T1);
		END;
		NAMLSTOK _ 0;
		SAVSPACE(.UPNT<LEFT>,@UPNT);
	END;
 WIT
	%[1153]%
 REP 1884/1	;05C15
	%[760]%		SAVSPACE(.KLPNT<LEFT>,@KLPNT);
 WIT
	%[1153]%
 INS 2030/1	;05C16
	%[1153]%				SAVSPACE(.R1<LEFT>,@R1)
 INS 2108/1	;05C17
	%[1153]%			SAVSPACE(.R1[ELMNT]<LEFT>,.R1[ELMNT])
 REP 2115/1	;05C18
	%[760]%				END;
 WIT
	%[1153]%				SAVSPACE(.R2<LEFT>,@R2)
	%[760]%				END;
	%[1153]%		SAVSPACE(.R1<LEFT>,@R1)
 SUM 176593