Google
 

Trailing-Edge - PDP-10 Archives - AP-5471B-BM - sources/algstm.mac
There are 8 other files named algstm.mac in the archive. Click here to see a list.
;
;
;
;
;
;
;	COPYRIGHT (C) 1975,1976,1977,1978
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
;	SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
;	OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER
;	COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
;	TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
;	AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
;	SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
;	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
;	NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;
;SUBTTL STATEMENT MODULE

; COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
MODULE MSTM;
$PLEVEL=2;
BEGIN
EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC BLK1,BLK2,RUND,RUND2,RUND3,RUND5,FAIL,ERREAD,ERR,DSEL,SDOT,SBRACK,BENTRY,BEXIT,PSEUDO;
EXPROC MOB,PCALL,MABS,MREL,SEMERR,RAFIX,EVAL,MJRST0,UNSTACK,REOPEN,CLOSE,PLUNK,IPLUNK,LABREF,GBOOL,GSTAT;
EXPROC MPS,XTNDLB,STADD,SCINS; [E030]
EXPROC DUBDEC,PMBPLT,PMBLNT;
EXPROC	MRK.1,MRK.2,MRK.3,MRK.4,MRK.5,MRK.6,MRK.7,MRK.8,MRK.9;

;..SIMULATE THE ENVIRONMENT OF PROCEDURE DECLARATION ROUTINE(SPRODEC).;
FAKE FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1;
SUBTTL ROUTINE FOR <WHILE STATEMENT>.
;
;PARSE:		<WHILE STATEMENT>::= WHILE <BOOLEAN EXPRESSION> DO <STATEMENT>
;
;SYNTAX ERRORS:
;		WHILE NOT IMMEDIATELY PRECEDED BY A DELIMITER
;			BEGIN X WHILE B DO S END
;			      ^
;
;		PENDING STOPPER ENCOUNTERED BEFORE DO
;			BEGIN WHILE A = END DO S END
;					  ^
;
;		WHILE STATEMENT OCCURS WHERE ONLY <UNCONDITIONAL STATEMENT> IS ALLOWED
;			IF B THEN WHILE B DO S ELSE S;
;						  ^
;
;SEMANTIC ERRORS:
;		NOT <BOOLEAN EXPRESSION>
;			WHILE A + B DO S
;				  ^
;
;		NOT <STATEMENT>
;			WHILE B DO A[I];
;				      ^
;
;CODE 	GENERATED:
;		L: <BOOLEAN EXPRESSION>
;		   [TRANSFER TO L2 IF <BOOLEAN EXPRESSION> IS FALSE]
;		   <STATEMENT>
;		   JRST L
;		L2:
;
PROCEDURE SWHILE;
BEGIN
 LOCAL ST6,WHINIT,WHJUMP;
 FORMAL OLDEL;
 MRK.1; PLACE 'FOR' MARKER;
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
   THEN
     FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
   FI;
 CODE GWHL1;
;----
 ;WHINIT_RA;
				MOVE	T,RA;$
				MOVEM	T,WHINIT;$
 KILLAX;
;-------
 ENDCODE;
 ;ST6_STOPS;
 ;STOPS_STOPS OR 'DO';
				SETSTOPS(ST6,.DO);$
 RUND;
 ESEL;
 ;STOPS_ST6;
				RESTOP(ST6);$
 IF DEL = 'DO'
				DELEL(.DO);$
   THEN
    BEGIN
	CODE GWHL2;
;	----
	GBOOL;
	MOB;
	;WHJUMP<RHS>_(RA-1);
	;WHJUMP<LHS>_CAX;
				MOVE	T,RA;$
				SUBI	T,1;$
				HRL	T,CAX;$
				MOVEM	T,WHJUMP;$
;	-------
	ENDCODE;
	SFALSE(ERRL);
	RUND2;
	MRK.2;	PLACE 'DO' MARKER;
	SSEL;
	CODE GWHL3;
;	----
	GSTAT;
	;T_'JRST'.WHINIT;
				HRLZI	T,<JRST 0>_-22;$
				HRR	T,WHINIT;$
	MREL;
	JOIN(WHJUMP);
	MRK.3;	PLACE 'OD' MARKER;
;	-------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
   ELSE
     FAIL(12,HARD,DEL,ILLEGAL DELIMITER FOUND BEFORE 'DO');
 FI
 IF DEL = 'ELSE' AND OLDEL = 'STHEN'
				DELEL(.ELSE);$
				MOVE	T,OLDEL;$
				TEL(OTHEN);$
   THEN
     FAIL(13,SOFT,DEL,WHILE STATEMENT IS NOT UNCONDITIONAL STATEMENT);
 FI
 CODE GWHL4;
;----
 STATEMENT;
;-------
 ENDCODE;
ENDD;
SUBTTL ROUTINE FOR <UNLABELLED CONDITIONAL STATEMENT>.
;
;PARSE:		<UNLABELLED CONDITIONAL STATEMENT>::=
;			<IF STATEMENT>/
;			<IF STATEMENT> ELSE <STATEMENT>/
;			<IF CLAUSE> <FOR STATEMENT>/
;			<IF CLAUSE> <WHILE STATEMENT>
;		WHERE <IF CLAUSE>::=IF <BOOLEAN EXPRESSION> THEN
;		AND   <IF STATEMENT>::= <IF CLAUSE><UNCONDITIONAL STATEMENT>
;
;SYNTAX ERRORS:
;		IF NOT PRECEDED BY A DELIMITER
;			BEGIN X IF B THEN S;S END
;			      ^
;
;		THIS STATEMENT OCCURS WHERE ONLY <UNCONDITIONAL STATEMENT> IS ALLOWED
;			IF B THEN IF B THEN S;
;				   ^
;
;		PENDING STOPPER ENCOUNTERED BEFORE THEN
;			IF B = END THEN S ELSE S
;				 ^
;
;		SPURIOUS SEMICOLON BEFORE ELSE
;			IF B THEN S; ELSE S
;				   ^
;
;
PROCEDURE SSIF;
BEGIN
 REGISTER REGIF;
 LOCAL ST7,IFJUMP;
 FORMAL OLDEL;
 MRK.4;	PLACE 'IF' MARKER
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
    THEN
      FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
    FI;
 IF OLDEL ='STHEN'
				MOVE	T,OLDEL;$
				TEL(OTHEN);$
  THEN
    FAIL(14,HARD,DEL,'THEN IF' ILLEGAL);
 FI;
 ;ST7_STOPS;
 ;STOPS_STOPS OR 'THEN';
				SETSTOPS(ST7,.THEN);$
 RUND;
 ESEL;
 IF DEL = 'THEN'
				DELEL(.THEN);$
   THEN
     BEGIN
;	----
	CODE GSIF1;
	 GBOOL;
	 MOB;
	 ;IFJUMP<RHS>_(RA-1);
				HRRZ	T,RA;$
				SUBI	T,1;$
	 ;IFJUMP<LHS>_CAX;
				HRL	T,CAX;$
				MOVEM	T,IFJUMP;$
;	-------
	ENDCODE;
	SFALSE(ERRL);
	;STOPS_ST7 OR 'SELSE';
				MOVE	STOPS,ST7;$
				ADDSTOPS(.ELSE);$
	RUND2;
	MRK.5;	PLACE 'THEN' MARKER;
	SSEL(OTHEN);
	;STOPS_ST7;
				RESTOPS(ST7);$
	CODE GSIF2;
;       ----
        GSTAT;
;       -------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
   ELSE
     BEGIN
	;STOPS_ST7;
				RESTOPS(ST7);$
	FAIL(15,HARD,DEL,THEN STATEMENT NOT FOUND);
	IF DEL NE 'ELSE'
				DELNEL(.ELSE)
	  THEN
	    ;..SORRY TO HAVE TO DO THIS;
	    GOTO RETURN;
	FI;
     ENDD
 FI;
 IF DEL = SC AND NDEL = 'ELSE' AND NSYM = PHI
				DELEL(.SC);$
				NDELEL(.ELSE);$
				SKIPE	NSYM;$
				GOTO	FALSE;$
   THEN
      BEGIN
	FAIL(10,SOFT,DEL,SPURIOUS SEMICOLON);
	;REGIF_SYM;
				MOVE	R