	subroutine parser
#
#	Syntaktische Analyse der Muster gemaess der Nervenfaser-Grammatik
#
# Die LL(1)-Grammatik wird von Datei GRAMMAR.TBL eingelesen. Die Datei 
# enthaelt die Symbole und Produktionen der Grammatik sowie die Analyse-Tafel 
# fuer den Parser.
#
# Externe Routinen:
# Name		File,Bibliothek
# zpunkt	ZPUNKT		liefert den naechsten Zentralpunkt
# primex	PRIMEX		liefert das naechste Primitivmuster
# fillin	FILLIN		fuellt die erkannte Faser im Flag-Feld
#
# Version 0.1	16.05.85
#
define START	990 		# Labels
define ABORT	997
define NEXTZP	998
define EXIT	999
#
define DRIVE 0			# Default drive
define LUN 6			# Disk unit
#
define NTEMAX 25		# max.Anzahl Nonterminals
define TERMAX 10		# max.Anzahl Terminals
define PROMAX 40		# max.Anzahl Produktionen
define PROLNG 30		# max.Anzahl von Zeichen in Prod.
define INPMAX 50		# max.Anzahl Zeichen im Inputstring
define SSTMAX 30		# max.Anzahl Eintraege im Symbolstack
#
define BLANKS x'2020'		# Blanks
#
logical	found,error,show,ready	# Flags
#
byte	char			# Einzelzeichen
byte	y,yy
#
integer	vaun(NTEMAX),		# Nonterminals
	vaut(TERMAX),		# Terminals
	prod(PROMAX,10)		# rechte Seite der Produktionen
integer	nteanz,			# Anzahl der Nonterminals,
	teranz,			#	     Terminals,
	proanz			#	     Produktionen
integer	probuf(10)		# Produktion (String)
integer	rhsanz(PROMAX)		# Anz.der Symbole auf der rechten Seite
#
real	pnr,prodnr(PROMAX)	# Prod'nummern (String)
real	table(NTEMAX,TERMAX)	# Analyse-Tafel mit Prod'nummern
#
integer	inpstr(INPMAX),		# Input String
	sstack(SSTMAX)		# Symbol-Stack
integer	inppos,inpend,sstop	# Input-Position und -Ende, Top of Symbol-Stack
integer	inpsym,sstsym		# Input-Symbol, Stack-Symbol
integer	errnr			# Error-Nummer
#
integer	zx,zy			# Zentralpunkt
#
integer	mn			# Anzahl der Primitivmuster
integer	ap,dp,ep,fp,mp,np	# Attribute der Primitivmuster
real	bp,cpx,cpy,lp
real	bn,cnx,cny,fn,ln	# Attribute der Nervenfaser
#
integer	i,j,k,l			# Laufindizes
real	r,rx,ry			# Hilfsgroessen
#
real	filnam(3)		# String
byte	rep(2)			# encode-Buffer
byte	fmt3(6),fmt4(11)	# Format-Strings
#
common	/zpunkt/zx,zy
common	/pmattr/ap,bp,cpx,cpy,dp,ep,fp,lp,mp,np
common	/flags/show
#
data	y,yy/'y','Y'/
data	filnam/'GRAM','MAR ','TBL '/
data	fmt3/'(',' ',' ','A','3',')'/
data	fmt4/'(','A','5',',',' ',' ','A','4',')'/
#
#
write(1,10)
10 format(' *** PARSER ***')
#
#	Grammatik und Analyse-Tafel einlesen
#
write(1,11) filnam
11 format(' Grammatik von Datei ',3a4,' mit:')
#
call open(LUN,filnam,DRIVE)			# Grammatik-Datei oeffnen
read(LUN,20) nteanz ; encode(rep,20) nteanz
20 format(i2)
fmt3(2)=rep(1) ; fmt3(3)=rep(2)
read(LUN,fmt3) (vaun(i),i=1,nteanz)
write(1,22) nteanz
22 format(i4,' Nonterminals')
#write(1,fmt3) (vaun(i),i=1,nteanz)
#
read(LUN,20) teranz ; encode(rep,20) teranz
fmt3(2)=rep(1) ; fmt3(3)=rep(2)
read(LUN,fmt3) (vaut(i),i=1,teranz)
write(1,24) teranz
24 format(i4,' Terminals')
#write(1,fmt3) (vaut(i),i=1,teranz)
#
read(LUN,20) proanz
write(1,25) proanz
25 format(i4,' Produktionen')
do i=1,proanz
[	read(LUN,26) prodnr(i),probuf
	26 format(a5,10 a3)
	#write(1,26) prodnr(i),probuf
	l=0
	do j=3,10
	[	if (probuf(j)==BLANKS) break
		l=l+1
		prod(i,l)=probuf(j)
	]
	rhsanz(i)=l		# Anz.der Symbole auf der rechten Seite
]
i=teranz-1 ; encode(rep,20) i
fmt4(5)=rep(1) ; fmt4(6)=rep(2)
do i=1,nteanz
[	read(LUN,fmt4) (table(i,j),j=1,teranz) ]
write(1,27)
27 format(' und Analyse-Tafel eingelesen.'/)
#do i=1,nteanz
#[	write(1,fmt4)  (table(i,j),j=1,teranz) ]
endfile LUN					# Grammatik-Datei schliessen
#
write(1,28)
28 format(' Bildschirm-Protokoll? (Y/N) ')
read(1,29) char
29 format(a1)
if (char==y !! char==yy) show=.true.
else show=.false.
#
#	Alle Muster des Bildes analysieren
#
repeat
[	call zpunkt(ready)			# naechster Zentralpunkt 
	if (.not.ready)
	[	#
		#	Initialisierung der Datenstrukturen
		#
		inpend=0 ; inppos=1 				# Input
		sstop=1 ; sstack(sstop)=vaut(teranz)		# Stack
		sstop=2 ; sstack(sstop)=vaun(1)
		bn=0. ; cnx=0. ; cny=0. ; fn=0. ; ln=0. ; mn=0	# Attribute
		error=.false.
		#
		#	Parsing
		#
repeat
[	if (inppos>>inpend)
	[	call primex(inpsym,error)	# naechstes Primitivmuster 
		if (error) goto ABORT
		inpend=inpend+1 ; inpstr(inpend)=inpsym
		if (show) write(1,31) inpend,inpsym
		31 format(/' PARSER ',i2,'.Input-Symbol: ',a2)
	]
	sstsym=sstack(sstop)
	if (show) write(1,32) sstsym
	32 format(' PARSER Stack-Symbol: ',a2)
	i=1 ; found=.false.			# Stack-Symbol terminal?
	while (.not.found && i<=teranz)
		if (sstsym==vaut(i)) found=.true.
		else i=i+1
	if (found)
	[	if (inpsym==sstsym)	# Ja. Input-Symbol = Stack-Symbol?
		[	sstop=sstop-1 ; inppos=inppos+1
			mn=mn+1 ; bn=bn+bp	# Attributwerte aktualisieren
			cnx=cnx+cpx ; cny=cny+cpy
			fn=fn+float(fp) ; ln=ln+lp
			if (show)
			[	write(1,40) mn
				40 format(' m =',i3,' N-Attr. B,C,F,L:') 
				r=bn/mn ; write(1,42) r
				rx=cnx/mn ; ry=cny/mn ; write(1,42) rx,ry 
				r=fn/2. ; write(1,42) r,ln
				42 format(1x,2f6.2)
		]	]
		else	[ errnr=1 ; goto ABORT]	# Error1: Symbole passen nicht 
	]
	else
	[	i=1 ; found=.false.		# Stack-Symbol nichtterminal
		while (.not.found && i<=nteanz)
			if (sstsym==vaun(i)) found=.true.
			else i=i+1
		if (.not.found) 
			[ errnr=2 ; goto ABORT]	# Error2: falsches Stack-Symbol
		j=1 ; found=.false.		# Input-Symbol terminal
		while (.not.found && j<=teranz)
			if (inpsym==vaut(j)) found=.true.
			else j=j+1
		if (.not.found) 
			[ errnr=3 ; goto ABORT]	# Error3: falsches Input-Symbol
		pnr=table(i,j)			# Table Eintrag lesen
		if (show) write(1,50) i,j,pnr
		50 format(' Eintrag ',2i4,' = ',a4)
		#
		# ggf. Stack-Symbol durch rechte Seite der Produktion ersetzen
		#
		k=1 ; found=.false.
		while (.not.found && k<=proanz)
			if (pnr==prodnr(k)) found=.true.
			else	k=k+1
		if (found) 
		[	sstop=sstop-1
			for (l=rhsanz(k); l>=1; l=l-1)
			[	sstop=sstop+1 ; sstack(sstop)=prod(k,l)
	]	]	]
] until (sstop==0 !! .not.found)
		#
		#	Analyse eines Musters beendet
		#
		if (sstop==0) 
		[	bn=bn/mn ; cnx=cnx/mn ; cny=cny/mn ; fn=fn/2.
			if (show)
			[	write(1,40) mn
				write(1,42) bn
				write(1,42) cnx,cny
				write(1,42) fn,ln
			]
			write(1,60)
			60 format(' ***  accepted  ***')
			#call fillin(zx,zy)
		]
		else write(1,62)
		62 format(' ***  not accepted  ***')
		goto NEXTZP
		#
		#	Abbruch
		#
		ABORT	
		write(1,80) errnr
		80 format(' PARSER-Error',i2)
		write(1,81)
		81 format(' Weiter? (Y/N) ')
		read(1,82) char
		82 format(a1)
		if (char<>y && char<>yy) ready=.true.
	NEXTZP
	]
] until (ready)			# ggf. weiter mit naechstem Zentralpunkt
#
#	Ende der Subroutine
#
EXIT
write(1,90)
90 format(' *** PARSER - Ende ***')
end
