Directory of image this file is from
This file as a plain text file

	SUBROUTINE GETSYM
C  PASCAL-S PARSER  VERSION VOM 20.12.80
	COMMON NERR,IERRS,LC,ICC,DIN,FIN,ICH,LL,LINE
	COMMON ISYM,LEN,IWORD,IPOINT,ID,IAL
	COMMON NAME,IRZEIG,LZEIG,MAX,IL,ISTAB
	COMMON MAXE,MINE,KMAX,NMAX,ISX,LLENG,ISLENG,ISMAX
	DIMENSION LINE(80),LZEIG(200),IRZEIG(200),NAME(200,10)
	DIMENSION IWORD(29,10),IPOINT(26,2),ID(10),LEN(29)
	DIMENSION IERRS(61,3),ISTAB(600),IZEIL(40)
	IB=0
5	IF(ICH+2016)15,10,15	@ BLANK?
10	CONTINUE
S	JMS GETCH	@  CH = " "
	GOTO 5
15	IF(ICH+1504)40,20,40
20	CONTINUE	@  "("
S	JMS GETCH
	IF(ICH+1376)25,30,25	@ CH="*"?
25	IB=1
	ICC=ICC-1
	GOTO 5
30	ICHVOR=ICH	@KOMMENTARBEGINN
S	JMS GETCH
	IF(ICHVOR+1376)30,35,30
35	IF(ICH+1440)30,37,30
37	CONTINUE	@ KOMMENTARENDE
S	JMS GETCH
	GOTO 5
40	WRITE(4,650)ICC
650	FORMAT(A2)
	IF(IB-1)43,42,43
42	ICH=-1504	@ "("
43	IF(ICH-96)100,45,45
45	IF(ICH-1696)50,50,100
50	IL=0	@ BUCHSTABE,  BEGINN IDENTIFIER
52	IF(IAL-IL)54,54,53
53	IL=IL+1
	ID(IL)=ICH
54	CONTINUE
S	JMS GETCH
	IF(96-ICH)55,55,58
55	IF(ICH-1696)52,52,58
58	IF(ICH+992)47,59,59
59	IF(ICH+416)52,52,47
47	I1=IL+1
	DO 31 I=I1,10
31	ID(I)=-2016	@ID(1) BIS ID(10) ENTHAELT IDENTIFIER
	J=(ID(1)-32)/64	@ UEBERPRUEFUNG, OB IDENTIFIER= KEYWORD
	M=IPOINT(J,1)
	N=IPOINT(J,2)
	DO 60 I=M,N
	IF(IL-LEN(I))60,98,60
98	DO 70 I1=2,10
	IF(ID(I1)-IWORD(I,I1))60,70,60
70	CONTINUE
	ISYM=50+I	@ IDENTIFIER IST KEYWORD
	RETURN
60	CONTINUE
	ISYM=1	@ IDENTIFIER IST KEIN KEYWORD
	RETURN
100	IF(ICH+992)180,105,105	@ KEIN BUCHSTABE
105	IF(ICH+416)106,106,180
106	KA=ICC	@ ZEICHEN IST EINE ZIFFER
	K=0
	ISYM=2	@ INTEGERKONSTANTE
108	K=K+1
S	JMS GETCH
	IF(ICH+992)115,110,110
110	IF(ICH+416)108,108,115
115	IF(K-KMAX)116,116,120
120	CALL FEHL(21)	@ ZU VIELE ZIFFERN IN INTEGERKONSTANTE
116	IF(ICH+1120)140,121,140
121	CONTINUE	@ "."
S	JMS GETCH
	IF(ICH+1120)124,123,124
123	ICC=ICC-1	@ ENDE DER ZIFFERNKETTE, INTEGERKONST.
	GOTO 170
124	ISYM=3	@ REALKONSTANTE
127	IF(ICH+992)140,128,128	@ NACHKOMMATEIL
128	IF(ICH+416)130,130,140
130	CONTINUE
S	JMS GETCH
	GOTO 127
140	IF(ICH-352)170,141,170	@ NACHKOMMATEIL BEENDET, "E"?
141	ISYM=3
S	JMS GETCH
	IF(ICH+1312)150,142,150
142	CONTINUE	@ "+"
S	JMS GETCH
	GOTO 155
150	IF(ICH+1184)155,151,155
151	CONTINUE	@ "-"
S	JMS GETCH
155	IF(ICH+992)170,156,156	@ EXPONENT
156	IF(ICH+416)157,157,170
157	CONTINUE
S	JMS GETCH
	GOTO 155
170	KE=ICC-1
	WRITE(4,655)ISYM	@ AUSGABE INTEGER- BZW. REALKONSTANTE
655	FORMAT(A2)
	ISX=0
	WRITE(4,1031)(LINE(I),I=KA,KE)
	RETURN
180	INDEX=-(ICH+32)/64	@ SONSTIGES SYMBOL AUSSER IDENT, INT.-
	IF(INDEX+28)182,184,186	@ ODER REALKONST.,  UMCODIERUNG 
182	IF(INDEX+30)190,188,190
188	ISYM=19	@ "]"
	GOTO 500
184	ISYM=18	@ "["
	GOTO 500
190	CALL FATAL(0)	@ UNZULAESSIGES ZEICHEN
	GOTO 500
186	IF(INDEX-16)195,280,300
195	IF(INDEX)190,190,220
220	GOTO (230,240,250,260,270),INDEX
230	CONTINUE
S	JMS GETCH
	IF(ICH+160)232,231,232
231	ISYM=15	@ ">="
	GOTO 500
232	ISYM=14	@ ">"
	RETURN
240	ISYM=16	@ "="
	GOTO 500
250	CONTINUE
S	JMS GETCH
	IF(ICH+160)252,251,252
251	ISYM=13	@ "<="
	GOTO 500
252	IF(ICH+96)255,253,255
253	ISYM=17	@ "<>"  D.H. NOT EQUAL
	GOTO 500
255	ISYM=12	@ "<"
	RETURN
260	ISYM=23	@ ";"
	GOTO 500
270	CONTINUE
S	JMS GETCH
	IF(ICH+160)273,271,273
271	ISYM=20	@ ":="
	GOTO 500
273	ISYM=24	@ ":"
	RETURN
280	ISYM=22	@ "/"
	GOTO 500
300	IF(INDEX-29)305,400,190
305	IF(INDEX-17)190,310,320
310	CONTINUE
S	JMS GETCH
	IF(ICH+1120)312,311,312
311	ISYM=25	@ ".."  UPTO
	GOTO 500
312	ISYM=21	@ "."
	RETURN
320	ISYM=INDEX-12
	GOTO 500
400	K=0
	IB=1
	ISYM=5	@ STRING- ODER CHARACTER-KONSTANTE
S	JMS GETCH
405	K=K+1
	IF(K-LLENG)407,407,406
406	CALL FATAL (8)	@ ZEICHENKETTE ZU LANG
407	IF(K-ISMAX)415,415,410
410	CALL FATAL (7)
415	IF(ICH+1888)418,416,418
416	CONTINUE	@ " " "
S	JMS GETCH
	IF(ICH+1888)419,418,419
418	ISTAB(K)=ICH
S	JMS GETCH
	GOTO 420
419	IB=0
420	IF(IB)405,425,405
425	ISLENG=K-1
	IF(ISLENG)440,430,440
430	CALL FEHL (365)
	ISYM=65
	RETURN
440	IF(ISLENG-1)450,441,450
441	ISYM=4	@ CHARACTER- KONSTANTE
450	WRITE(4,655)ISYM
	ISX=0
	IF(ISYM-5)445,442,445
442	WRITE(4,655)ISLENG
445	WRITE(4,1031)(ISTAB(I),I=1,ISLENG)
	RETURN
500	CONTINUE
S	JMS GETCH
	RETURN
SGETCH,	0
	IF(ICC-LL)1100,1020,1020
1020	IF(LINE(LL)+1120)1030,1025,1030
1025	ISYM=21
	RETURN
1030	ICC=0
	LL=80	@ LINE LENGTH
	LC=LC+1	@ LINE COUNTER
	WRITE(4,1150)MIN1,LC
1150	FORMAT(A2)
	READ(4,1031)(LINE(I),I=1,80)
1031	FORMAT(80A1)
1049	IF(LINE(LL)+2016)1200,1050,1200
1050	LL=LL-1
	IF (LL.EQ.0) GOTO 1200
	GOTO 1049
1200	LL=LL+1
	LINE(LL)=-2016
1100	ICC=ICC+1
	ICH=LINE(ICC)
S	JMP I GETCH
	END