File ANWEIS.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file
	SUBROUTINE ANWEISUNG
	COMMON NERR,IERRS,LC,CC,DIN,FIN
	COMMON SYM,IDENT,INUM,RNUM,SLENG,CH,STRING
	COMMON STACK,BOTTOM,TOP,KITUM,KZEIGER,NIDEK,NZEIGER
	COMMON IC0,RC0,SC0,P0,I0,T0,GPUNKT
	COMMON ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER
	COMMON ICTAB,RCTAB,SCTAB,SCZ,PTAB,PZ,ITAB,IZ,TTAB,TZ
	INTEGER PUNKT,GPUNKT,NPUNKT,INKITUM,INKI,INKI0,INKI1
	INTEGER NERR,IERRS(61,3),LC,CC
	INTEGER SYM,IDENT,INUM,SLENG,CH,STRING(80)
	INTEGER STACK(200),BOTTOM(10),TOP(10),KITUM(200,4)
	INTEGER NIDEK(100,2),NZEIGER,IC0,RC0,SC0,P0,I0,T0
	INTEGER ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER
	INTEGER ICTAB(200),SCTAB(200),SCZ(50),PTAB(100),PZ(50)
	INTEGER ITAB(100),IZ(50),TTAB(400),TZ(50)
	REAL RNUM,RCTAB(50)
	LOGICAL LEER,DD,B
	CALL EINKELLERN(-1,1)
	CALL EINKELLERN(1,1)
	WHILE (GPUNKT.NE.(-1))
C$	WRITE(1,1)GPUNKT,NPUNKT(2,1),NPUNKT(3,1)
C$1	FORMAT('G1PUNKT:',I6,' G2PUNKT:',I6,' G3PUNKT:',I6)
	  GOTO(101,102,103,104,105,106,107,108),GPUNKT
101	IF (SYM.EQ.1)	@IDENT
	  INKI=INKITUM(IDENT)
	  IF (INKI.EQ.0) CALL FATAL(104)
	  INKI1=KITUM(INKI,2)
	  IF (INKI1.EQ.7)	@FUNCTION-IDENT.
	    CALL GETSYM
	    CALL ERSETZEN(8,1)
	  ELSE
	    IF (INKI1.EQ.5)	@VAR.-IDENT.
	      CALL GETSYM
	      CALL ERSETZEN(8,1)
	      CALL EINKELLERN(15,1)	@VARIABLENANFANG
	      CALL EINKELLERN(KITUM(INKI,3),5)
	      CALL AUSDRUCK	@VARIABLE
	    ELSE
	      IF (INKI1.EQ.6)	@PROC.-IDENT.
	        CALL GETSYM
	        CALL EINKELLERN(0,6)	@ZETA
		CALL EINKELLERN(INKI,3)
	        IF(SYM.EQ.11)	@"("
		  SYM=7		@","
		  WHILE (SYM.EQ.7)	@","
		    CALL GETSYM
		    CALL EINKELLERN(1,1)
		    CALL AUSDRUCK
		    CALL AUFAD(1,6)
		    CALL EINKELLERN(PUNKT(5),7)
		    CALL AUSKELLERN(5)
		    IF(INKI.EQ.26.OR.INKI.EQ.27)	@WRITE
		      WHILE(SYM.EQ.24)
			CALL GETSYM
			CALL SCONST
			CALL AUSKELLERN(4)
			CALL AUSKELLERN(5)
		      ENDWHILE
		    ENDIF
		  ENDWHILE
		  IF (SYM.NE.10)	@")"
		    CALL FEHL(4)
		  ELSE
	  	    CALL GETSYM
		  ENDIF
		ENDIF
	        CALL PLIST
	  	CALL AUSKELLERN(1)
	      ELSE
	        CALL FATAL(103)
	      ENDIF
	    ENDIF
	  ENDIF
	  GOTO 199
	ENDIF
	IF (SYM.EQ.53)	@BEGIN
	  CALL GETSYM
	  CALL ERSETZEN(2,1)
	  CALL EINKELLERN(1,1)
	  GOTO 199
	ENDIF
	IF (SYM.EQ.63)	@IF
	  CALL GETSYM
C$	CALL STEST
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
C$	CALL STEST
	  B=PUNKT(5).NE.1
	  IF (B) CALL FATAL(130)
	  CALL AUSKELLERN(5)
	  IF (SYM.NE.74)	@THEN
	    CALL FEHL(52)
	  ELSE
	    CALL GETSYM
	  ENDIF
C$	CALL STEST
	  CALL ERSETZEN(3,1)
	  CALL EINKELLLERN(1,1)
C$	CALL STEST
	  GOTO 199
	ENDIF
	IF (SYM.EQ.54)	@CASE
	  CALL GETSYM
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
	  B=PUNKT(5).EQ.2.OR.PUNKT(5).EQ.4
	  IF (.NOT.B) CALL FATAL(110)
	  IF (SYM.NE.67)	@OF
	    CALL FEHL(8)
	  ELSE
	    CALL GETSYM
	  ENDIF
	  CALL ERSETZEN(4,1)
	  GOTO 199
	ENDIF
	IF(SYM.EQ.79)	@WHILE
	  CALL GETSYM
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
	  B=PUNKT(5).NE.1
	  IF (B) CALL FATAL(130)	@TYP BOOLEAN ERWARTET
	  CALL AUSKELLERN(5)
	  IF (SYM.NE.58)	@DO
	    CALL FEHL(54)
	  ELSE
	    CALL GETSYM
	  ENDIF
	  GOTO 199
	ENDIF
	IF (SYM.EQ.73)	@REPEAT
	  CALL GETSYM
	  CALL ERSETZEN(7,1)
	  CALL EINKELLERN(1,1)
	  GOTO 199
	ENDIF
	IF (SYM.EQ.61)	@FOR
	  CALL GETSYM
	  IF (SYM.NE.1) CALL FATAL(2)
	  INKI=INKITUM(IDENT)
	  IF (INKI.EQ.0) CALL FATAL(104)
	  INKI1=KITUM(INKI,2)
	  IF(INKI1.NE.5) CALL FATAL(103)
	  INKI1=KITUM(INKI,3)
	  B=INKI1.EQ.4.OR.INKI1.EQ.2
	  IF (.NOT.B) CALL FATAL(143)
	  CALL EINKELLERN(INKI1,5)
	  CALL GETSYM
	  B=SYM.EQ.24.OR.SYM.EQ.16.OR.SYM.EQ.20
	  IF (.NOT.B) CALL FATAL(51)
	  IF (SYM.NE.20)	@:=
	    CALL FEHL(51)
	  ELSE
	    CALL GETSYM
	  ENDIF
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
	  B=PUNKT(5).NE.NPUNKT(2,5)
	  IF (B) CALL FATAL(145)
	  CALL AUSKELLERN(5)
	  IF (SYM.NE.75)	@TO
	    IF (SYM.NE.57) CALL FATAL(55)	@DOWNTO
	  ENDIF
	  CALL GETSYM
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
	  B=PUNKT(5).NE.NPUNKT(2,5)
	  IF (B) CALL FATAL(145)
	  CALL AUSKELLERN(5)
	  IF (SYM.NE.58)	@DO
	    CALL FEHL(54)
	  ELSE
	    CALL GETSYM
	  ENDIF
	  GOTO 199
	ENDIF
	CALL FATAL(99)
102	IF(SYM.EQ.23)	@";"  VERBUND
	  CALL GETSYM
	  CALL EINKELLERN(1,1)
	  GOTO 199
	ENDIF
	IF (SYM.EQ.60)	@END
	  CALL GETSYM
	  CALL AUSKELLERN(1)
	ELSE
	  CALL FEHL(14)
	  B=SYM.NE.1.AND.SYM.NE.53.AND.SYM.NE.63.AND.SYM.NE.54
	1.AND.SYM.NE.79.AND.SYM.NE.73.AND.SYM.NE.61
	  IF(B)CALL FATAL(13)
	ENDIF
	GOTO 199
103	IF (SYM.EQ.59)	@ELSE  IN IF-ANWEISUNG
	  CALL GETSYM
	  CALL ERSETZEN(1,1)
	ELSE
	  CALL AUSKELLERN(1)
	ENDIF
	GOTO 199
104	CALL CONSTANT 	@FALLANWEISUNG
	B=PUNKT(5).NE.NPUNKT(2,5)
	IF (B) CALL FATAL(147)
	CALL AUSKELLERN(5)	@TAU
	CALL AUSKELLERN(4)
	WHILE(SYM.EQ.7)	@","
	  CALL GETSYM
	  CALL CONSTANT
	  B=PUNKT(5).NE.NPUNKT(2,5)
	  IF (B) CALL FATAL(147)
	  CALL AUSKELLERN(5)
	  CALL AUSKELLERN(4)
	ENDWHILE
	IF(SYM.NE.24)	@":"
	  CALL FEHL(5)
	ELSE
	  CALL GETSYM
	ENDIF
	CALL ERSETZEN(5,1)
	CALL EINKELLERN(1,1)
	GOTO 199
105	IF (SYM.EQ.23)	@";"  CASE-FORTSETZUNG
	  CALL GETSYM
	  CALL ERSETZEN(4,1)
	ELSE
	  IF(SYM.EQ.69)	@OTHERS
	    CALL GETSYM
	    IF (SYM.NE.24)	@":"
	      CALL FEHL(5)
	    ELSE
	      CALL GETSYM
	    ENDIF
	    CALL ERSETZEN(6,1)
	    CALL EINKELLERN(1,1)
	  ELSE
	    IF(SYM.NE.60)
	      CALL FEHL(14)	@";" ODER END
	    ELSE
	      CALL GETSYM
	      CALL AUSKELLERN(1)
	    ENDIF
	  ENDIF
	ENDIF
C$	CALL STEST
	GOTO 199
106	IF (SYM.NE.60)	@END BEI CASE
	  CALL FEHL(13)
	ELSE
	  CALL GETSYM
	  CALL AUSKELLERN(1)
	ENDIF
	GOTO 199
107	IF (SYM.EQ.77)	@UNTIL  BEI REPEAT-SCHLEIFE
	  CALL GETSYM
	  CALL EINKELLERN(1,1)
	  CALL AUSDRUCK
	  B=PUNKT(5).NE.1
	  IF(B) CALL FATAL(130)
	  CALL AUSKELLERN(5)
	  CALL AUSKELLERN(1)	@GAMMA
	  GOTO 199
	ENDIF
	IF (SYM.NE.23)	@";"
	  CALL FEHL(14)
	  B=SYM.NE.1.AND.SYM.NE.53.AND.SYM.NE.63.AND.SYM.NE.54
	  B=B.AND.SYM.NE.79.AND.SYM.NE.73.AND.SYM.NE.61
	  IF (B) CALL FATAL(13)
	ELSE
	  CALL GETSYM
	ENDIF
	CALL EINKELLERN(1,1)
	GOTO 199
108	B=SYM.EQ.20.OR.SYM.EQ.24.OR.SYM.EQ.16	@":=" IN ERGIBTANW.
	IF (.NOT.B) CALL FATAL(51)
	IF (SYM.NE.20)	@":="
	  CALL FEHL(51)
	ELSE
	  CALL GETSYM
	ENDIF
	CALL EINKELLERN(1,1)	@INITIALISIERUNG FUER AUSDRUCK
	CALL AUSDRUCK
	CALL VERGLEICH
	CALL AUSKELLERN(1)
199	CONTINUE
	ENDWHILE
	CALL AUSKELLERN(1)
	RETURN
	END
Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with. I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation.

PDP-8 Home Page PDP-8 Site Map PDP-8 Site Search