1 C Loglan82 Compiler&Interpreter
2 C Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
3 C Copyright (C) 1993, 1994 LITA, Pau
5 C This program is free software; you can redistribute it and/or modify
6 C it under the terms of the GNU General Public License as published by
7 C the Free Software Foundation; either version 2 of the License, or
8 C (at your option) any later version.
10 C This program is distributed in the hope that it will be useful,
11 C but WITHOUT ANY WARRANTY; without even the implied warranty of
12 C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 C GNU General Public License for more details. File: LICENSE.GNU
14 C ===============================================================
17 C E3 - RECOGNIZES OBJECTEXPRESSION
19 IMPLICIT INTEGER (A-Z)
22 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
23 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
24 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
25 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
26 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
27 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
28 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
29 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
30 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
31 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
32 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
33 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
34 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
35 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
36 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
37 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
38 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
39 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
42 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
43 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
44 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
45 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
46 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
47 M WRITE, WRITELN, WBOUND, UNICAL,
49 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
50 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
51 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
52 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
56 Z TOP, IN, NEXT, STACK(500),
60 10 IF (S.NE.SIDENT) GOTO 200
63 C PARAMETER VALUE IS ASSIGNED: THERE IS NO "NEW"
67 C RETURN TO LABEL 20, RESULTING FROM JUMP OPTIMIZATION.
68 200 IF (S.NE.STHIS) GOTO 250
70 IF (S.EQ.SIDENT) GOTO 210
73 210 CALL OUTPUT(WTHIS,ADRES)
76 250 IF (S.EQ.SNEW) GOTO 270
77 IF (S.NE.SNONE) GOTO 255
78 CALL OUTPUT(WCNSTN,-1)
84 270 STACK(TOP+7)=ADRES
86 IF (S.NE.SIDENT) GOTO 280
96 300 IF (S.EQ.SDOT) GOTO 350
97 IF (S.NE.SQUA) GOTO 1000
100 IF (S.NE.SIDENT) GOTO 260
101 CALL OUTPUT(WQUA,ADRES)
103 IF (S.EQ.SDOT) GOTO 350
111 IF (S.NE.SNEW) GOTO 380
114 380 IF (S.EQ.SIDENT) GOTO 390
117 390 CALL OUTPUT(WDOT,-1)
119 C RETURN INTO SOME OTHER PLACE
128 C E4 - RECOGNIZES EXPRESSION
129 C STACK(TOP+3) - NUMBER OF ARRAYOF'S ENCOUNTERED
130 IMPLICIT INTEGER (A-Z)
133 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
134 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
135 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
136 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
137 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
138 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
139 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
140 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
141 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
142 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
143 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
144 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
145 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
146 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
147 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
148 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
149 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
150 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
153 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
154 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
155 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
156 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
157 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
158 M WRITE, WRITELN, WBOUND, UNICAL,
160 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
161 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
162 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
163 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
167 Z TOP, IN, NEXT, STACK(500),
172 IF (S.NE.SARROF) GOTO 13
173 11 STACK(TOP+3)=STACK(TOP+3)+1
175 IF (S.EQ.SARROF) GOTO 11
176 13 IF (S.EQ.SCOROUT) GOTO 15
177 IF (S.EQ.SINT) GOTO 16
179 IF (STACK(TOP+3).GT.0) NEXT=3
182 C CALL E1 - BOOLEXPRESSION
183 C OR E3 - OBJECTEXPRESSION
184 15 CALL OUTPUT(WIDENT,K)
185 C COROUTINE OR PROCESS ENCOUNTERED
187 16 CALL OUTPUT(WPRIM,ADRES)
189 20 IF (STACK(TOP+3).NE.0) CALL OUTPUT(WARRAY,STACK(TOP+3))
196 C STACK(TOP+3) - COUNTS NUMBER OF EXTERNAL PARANTHESES PAIRS
197 C STACK(TOP+4) - PARAMETR - 0 THERE WAS NO NEW/START
200 IMPLICIT INTEGER (A-Z)
203 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
204 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
205 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
206 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
207 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
208 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
209 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
210 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
211 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
212 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
213 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
214 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
215 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
216 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
217 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
218 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
219 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
220 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
223 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
224 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
225 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
226 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
227 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
228 M WRITE, WRITELN, WBOUND, UNICAL,
230 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
231 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
232 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
233 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
237 Z TOP, IN, NEXT, STACK(500),
242 CALL OUTPUT(WIDENT,ADRES)
244 IF (STACK(TOP+4)-1) 15,13,12
245 12 CALL OUTPUT(WSTART,-1)
247 13 CALL OUTPUT(WNEW,-1)
248 15 IF (S.NE.SLEFT) GOTO 1000
249 IF (STACK(TOP+3).GE.2) GOTO 1000
250 C ANALYSIS OF THE ACTUAL PARAMETER
251 CALL OUTPUT(WLEFT,-1)
256 C CALL E4 - EXPRESSION
257 20 IF (S.NE.SCOMA) GOTO 28
259 CALL OUTPUT(WCOMA,-1)
264 30 IF (S.EQ.SCOMA) GOTO 22
265 28 IF (S.NE.SRIGHT) CALL ERROR(107)
266 IF (S.EQ.SRIGHT) CALL SCAN
267 CALL OUTPUT(WRIGHT,-1)
268 STACK(TOP+3)=STACK(TOP+3)+1
275 C RECOGNIZES THE SEQUENCE V1,V2,V3,. . . ,VN:= EXPR
276 C OR V1,V2, . . . ,VN := COPY ( OBJECT EXPR. )
277 C GENERATES WLSE V1 WLSE . . . WLSE EXPR /WCOPY/ WASSIGN
278 IMPLICIT INTEGER (A-Z)
281 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
282 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
283 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
284 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
285 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
286 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
287 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
288 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
289 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
290 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
291 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
292 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
293 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
294 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
295 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
296 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
297 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
298 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
301 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
302 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
303 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
304 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
305 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
306 M WRITE, WRITELN, WBOUND, UNICAL,
308 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
309 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
310 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
311 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
315 Z TOP, IN, NEXT, STACK(500),
318 GOTO (10,20,30,40),IN
319 10 CALL OUTPUT(WLSE,-1)
320 IF (S.NE.SCOMA) GOTO 120
324 C CALL OBJECTEXPRESSION
326 20 CALL OUTPUT(WLSE,-1)
327 IF (S.EQ.SCOMA) GOTO 100
328 120 IF (S.NE.SBECOME) CALL ERROR(109)
330 IF (S.NE.SCOPY) GOTO 130
332 IF (S.NE.SLEFT) GOTO 110
339 C CALL OBJECTEXPRESSION /E3/
340 30 IF (S.NE.SRIGHT) GOTO 112
344 113 CALL OUTPUT(WCOPY,WASSIGN)
349 C CALL BOOLEXPRESSION
352 CALL OUTPUT(WASSIGN,-1)
358 IMPLICIT INTEGER (A-Z)
360 C RECOGNIZES AN ARITHMETIC EXPRESSION COMPOSED OF CONSTANTS
363 C STACK(TOP+3) - MULTIPLICATIVE OPERATOR,
364 C STACK(TOP+4) - ADDITIVE OPERATOR,
365 C STACK(TOP+5) - 1 = UNARY MINUS FLAG.
369 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
370 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
371 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
372 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
373 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
374 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
375 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
376 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
377 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
378 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
379 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
380 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
381 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
382 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
383 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
384 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
385 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
386 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
389 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
390 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
391 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
392 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
393 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
394 M WRITE, WRITELN, WBOUND, UNICAL,
396 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
397 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
398 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
399 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
403 Z TOP, IN, NEXT, STACK(500),
410 IF (S.NE.STAR) GOTO 100
411 IF (ADRES.EQ.4) GOTO 82
412 IF (ADRES.EQ.3) GOTO 85
415 C MINUS (-) OCCURRS BEFORE EXPRESSION
417 C PLUS (+) BEFORE EXPRESSION - IGNORE IT
420 100 IF (S.EQ.SLEFT) GOTO 120
421 IF (S.EQ.SIDENT) GOTO 110
422 IF (S.NE.SCONST) GOTO 1000
423 C CONSTANT - TYPE STILL UNKNOWN
424 GOTO (1000,1000,101,102,103,102),K
426 101 CALL OUTPUT(WCNSTI,ADRES)
428 C TEXT (K=4) OR CHAR (K=6)
430 CALL OUTPUT(WCNSTI,0)
433 103 CALL OUTPUT(WCNSTR,ADRES)
435 C IDENTIFIER ENCOUNTERED
436 110 CALL OUTPUT(WIDENT,ADRES)
438 C LEFT PARANTHESIS ENCOUNTERED (RECURRENCE)
443 C RECURSIVE CALL OF E12 TO ANALYSE THE
445 20 IF (S.EQ.SRIGHT) GOTO 179
448 C------------- END OF THE MAIN LOOP
450 180 IF (STACK(TOP+5).EQ.0) GOTO 185
451 C MINUS BEFORE EXCPRESSION
452 CALL OUTPUT(WOPERAT,2)
454 185 IF (STACK(TOP+3).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+3))
456 IF (S.NE.STAR) GOTO 190
457 IF (ADRES.LT.5) GOTO 190
458 C MOD, DIV, * OR / - NEXT FACTOR EXPECTED
461 190 IF (STACK(TOP+4).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+4))
463 IF (S.NE.STAR) GOTO 1000
464 IF (ADRES.LT.2) GOTO 1000
465 C + OR - (MINUS) - NEXT COMPONENT EXPECTED
474 C RECOGNIZES THE SEQUENCE OF INSTRUCTIONS UNTIL A TERMINAL SYMBOL
475 C THE PARAMETER IS PASSED BY STACK(TOP+7)
478 C STACK(TOP+4) - NUMBERS OF THE GENERATED LABELS
480 C STACK(TOP+7) - A INPUT PARAMETER WHICH DETERMINES THE SET OF THE
483 C 1 - INSTRUCTIONS UNTIL WHEN/OTHERS/END
484 C 2 - .................. ELSE/FI
485 C 3 - .................. FI
486 C 4 - .................. OD
487 C 5 - .................. END
488 C 6 - .................. WHEN/OTHERWISE/ESAC
489 C 7 - .................. ESAC
491 IMPLICIT INTEGER (A-Z)
493 COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
495 COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
498 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
499 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
500 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
501 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
502 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
503 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
504 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
505 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
506 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
507 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
508 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
509 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
510 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
511 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
512 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
513 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
514 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
515 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
518 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
519 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
520 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
521 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
522 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
523 M WRITE, WRITELN, WBOUND, UNICAL,
525 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
526 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
527 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
528 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
532 Z TOP, IN, NEXT, STACK(500),
535 cdsw EQUIVALENCE (AUX,SCANER(3698))
536 EQUIVALENCE (AUX,SCANER(8698))
537 EQUIVALENCE (WSTART,WUNLOCK)
538 C*******************************************************************
539 C*** NOTE **********************************************************
540 C*** SMAIN HAS TO BE INSERTED INTO THE BLANK COMMON ON OCCASION ***
541 C*** OF SOME OTHER CHANGES *********************** 10/11/1981 ******
542 C*** WSTART SHOULD BE CHANGED TO WUNLOCK ***************************
543 C*******************************************************************
560 cbc added concurrent statements
568 GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,
569 X170,180,190,200,210,220,230,240,250,260,270,280,290,300,310,
570 x320,330,340,350,360,370,380),in
571 cdsw x320,330,340,350),in
572 cfileX320,330,340),IN
573 C CHECK WHETHER SYMBOL S MAY START AN INSTRUCTION
576 cbc 10 if(s.gt.34) go to 1111
577 10 if (s .gt. 36) goto 1111
581 15 IF (AUX.NE.0) CALL SELOPT
582 CALL OUTPUT(WINSTREND,LN)
583 GOTO (101,201,301,401,501,601,701,801,901,1001,1101,1201,1301
584 1,1401,1501,1601,1701,1801,1901,2001,2101,2201,2301,101,2501
585 2,2601,2701,2801,2901,3001,3101,3201,3301,3401,3501,3601),s
586 cbc 2,2601,2701,2801,2901,3001,3101,3201,3301,3401),s
587 C----- S = SIDENT - ASSIGNMENT STATEMENT OR OBJECT GENERATOR
591 C CALL OBJECT EXPRESSION /E3/ TO ANALYSE THE VARIABLE
594 IF (S.EQ.SEMICOL) GOTO 125
595 IF (S.EQ.SBECOME) GOTO 111
596 IF (S.EQ.SCOMA) GOTO 111
598 C INITIAL FRAGMENT OF AN ASSIGNMENT STATEMENT HAS BEEN RECOGNIZED
602 C CALL ASSIGNMENT /E6/
603 C RETURN TO LABEL 20 BELOW
604 C /JUMP OPTIMIZATION/
606 C < VARIABLE > ; IS RECOGNIZED
607 C CHECK FOR A PENDING NEW OR START
608 125 IF (STACK(TOP+15).EQ.0) CALL ERROR(123)
610 C----- S = IF INSTRUCTION: IF EXPR. THEN INSTR. ( ELSE INSTR. ) FI
611 C STACK(TOP+5)=0 THERT WAS NO ORIF/ANDIF
614 C STACK(TOP+4) - LABEL BEHIND THEN OR ELSE
615 C DEPENDING ON THE CONTENTS OF STACK(TOP+5)
616 C STACK(TOP+3) - USED TO COUN EXITS FOR THE SEQUENCES:I IF EXPR. THEN EXIT..
624 C CAL BOOLEXPRESSION /E1/
625 30 IF (S.EQ.SORIF) GOTO 203
626 IF (S.EQ.STHEN) GOTO 204
628 CALL OUTPUT(WLABEL,STACK(TOP+4))
631 203 IF (STACK(TOP+5).EQ.0) STACK(TOP+5)=ADRES
632 IF (STACK(TOP+5).NE.ADRES) CALL ERROR(140)
633 CALL OUTPUT(WIDENT+ADRES,STACK(TOP+4))
634 C IF ANDIF THEN ADRES=1 & WIDENT+ADRES=WIFFALS
635 C IF ORIF THEN ADRES=2 & WIDENT+ADRES=WIFTRUE
638 C THEN ENCOUNTERED, CHECK IF THERE WAS ORIF OR ANDIF
639 IF (STACK(TOP+5).EQ.2) GOTO 215
640 IF (STACK(TOP+5).EQ.1) GOTO 214
642 205 IF (S.NE.SEXIT) GOTO 207
643 C EXIT/REPEAT ENCOUNTERED
644 STACK(TOP+3)=STACK(TOP+3)+1
645 IF (ADRES.EQ.2) GOTO 206
648 C (EXIT)+ REPEAT ENCOUNTERED
649 206 CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),0))
653 207 IF (STACK(TOP+3).EQ.0) GOTO 214
654 CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),1))
655 C IF EXPR. THEN (EXIT)+ REPEAT
656 208 IF (S.EQ.SFI) GOTO 999
657 IF (S.EQ.SELSE) GOTO 211
658 IF (S.NE.SEMICOL) GOTO 209
661 C THERE ARE INSTRUCTIONS BEHIND EXIT
667 C CALL E8 TO ANALYSE A SEQUENCE OF STATEMENTS ENDED BY ELSE OR FI
668 290 IF (S.NE.SELSE) GOTO 999
674 C CALL E8 TO ANALYSE INMSTRUCTIONS AFTER ELSE
675 300 IF (S.EQ.SFI) GOTO 999
676 C A MISSING "FI" IS DIAGNOSED IN SOME OTHER PLACE. HERE WE JUMP TO 1000
677 C TO AVOID READING OF THE NEXT INPUT SYMBOL
680 C ANALYSIS FOR IF EXPR. THEN ......
681 214 STACK(TOP+3)=STACK(TOP+4)
682 CALL OUTPUT(WIFFALS,STACK(TOP+3))
684 C ORIF OCCURRED, A LABEL (FOR ELSE OR FI) HAS TO BE RESERVED
685 215 STACK(TOP+3)=UNICAL
687 CALL OUTPUT(WIFFALS,STACK(TOP+3))
688 CALL OUTPUT(WLABEL,STACK(TOP+4))
692 C A VALUE IS ASSIGNED TO THE PARAMETER OF E8
694 C ANALYSIS AFTER THEN
695 40 IF (S.EQ.SELSE) GOTO 241
696 IF (S.NE.SFI) GOTO 271
697 C A "FI" UNPRECEDED BY "ELSE"
698 221 CALL OUTPUT(WLABEL,STACK(TOP+3))
700 C ELSE ENCOUNTERED, WE SHOULD RESERVE A LABEL TO JUMP BEHIND FI
701 241 STACK(TOP+4)=UNICAL
704 CALL OUTPUT(WJUMP,STACK(TOP+4))
705 CALL OUTPUT(WLABEL,STACK(TOP+3))
711 C ANALYSIS OF INSTRUCTIONS AFTER ELSE
712 50 IF (S.NE.SFI) GOTO 271
713 CALL OUTPUT(WLABEL,STACK(TOP+4))
718 301 STACK(TOP+3)=UNICAL
719 STACK(TOP+4)=UNICAL+1
720 C RESERVATION OF LABELS:
721 C STACK(TOP+3) - BEGINNING OF THE LOOP (THE BOOLEAN CONDITION)
722 C STACK(TOP+4) - END OF THE LOOP
725 CALL OUTPUT(WLABEL,STACK(TOP+3))
726 CALL OUTPUT(WINSTREND,LN)
730 C CALL BOOLEXPRESSION /E1/
731 60 CALL OUTPUT(WIFFALS,STACK(TOP+4))
732 C CONDITIONAL JUMP BEHIND DO
733 IF (S.EQ.SDO) GOTO 307
743 C ANALYSIS OF THE INTERIOR OF THE DO LOOP /E8/
744 70 CALL OUTPUT(WJUMP,STACK(TOP+3))
745 C JUMP TO THE BEGINNING OF THE LOOP
746 CALL OUTPUT(WLABEL,STACK(TOP+4))
747 IF (S.EQ.SOD) GOTO 999
751 401 CALL OUTPUT(WRETURN,-1)
752 cbc added enable/disable option
754 405 if (s .ne. senab) goto 415
755 call output(wenab+adres-1, -1)
757 if (s .ne. sident) goto 420
758 call output(wident, adres)
760 if (s .eq. scoma) goto 410
762 415 call output(wprend, -1)
768 501 CALL OUTPUT(WDETACH,-1)
771 601 CALL OUTPUT(WINNER,-1)
775 C FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
780 C STACK(TOP+3)= 0 - READ
782 IF (S.EQ.SLEFT) GOTO 803
789 C CALL OBJECTEXPRESSION FOR READ( VARIABLE, . . . ,VARIABLE )
790 90 CALL OUTPUT(WWREAD,-1)
791 C CHECK IF END OF THE READ LIST
792 IF (S.EQ.SCOMA) GOTO 803
793 808 IF (S.EQ.SRIGHT) GOTO 810
797 812 IF (STACK(TOP+3).GT.0) CALL OUTPUT(WREADL,-1)
798 CALL OUTPUT(WIOEND,-1)
804 C STACK(TOP+3) - 0 - CALL
807 C --- ADDED CHECK FOR STHIS AND SNEW
808 IF (S.EQ.SIDENT.OR.S.EQ.STHIS.OR.S.EQ.SNEW) GOTO 905
812 905 CALL SLAD(5,8,10)
815 C CALL OBJECTEXPRESSION TO ANALYSE THE EXPRESSION
816 C WRITE WCALL OR WRAISE DEPENDING ON THE CONTENTS OF STACK(TOP+3)
817 100 CALL OUTPUT(WCALL+STACK(TOP+3)*64,-1)
830 C THE MEANING OF STACK(TOP+3):
839 IF (S.EQ.SLEFT) GOTO 1303
840 C STOP WITHOUT PARAMETER
841 CALL OUTPUT(WSTOP,-1)
844 IF (S.EQ.SLEFT) GOTO 1303
848 1304 IF (S.EQ.SMAIN) GOTO 1320
852 C CALL OBJECTEXPRESSION. /E3/ TO ANALYSE THE EXPRESSION AFTER
853 C KILL, ATTACH, RESUME, STOP, WAIT, LOCK
854 110 IF (S.EQ.SRIGHT) GOTO 1305
858 C JUMP ACCORDING TO THE PREVIOUSLY RECOGNIZED STATEMENT TYPE
860 GOTO (1307,1308,1309,1310,1311,1312,1313),K
861 1307 CALL OUTPUT(WKILL,-1)
863 1308 CALL OUTPUT(WATTACH,-1)
865 1309 CALL OUTPUT(WRESUME,-1)
867 1310 CALL OUTPUT(WSTOP,-1)
869 1311 CALL OUTPUT(WAIT,-1)
871 1312 CALL OUTPUT(WWLOCK,-1)
873 1313 CALL OUTPUT(WWUNLOCK,-1)
875 C MAIN ENCOUNTERED, CHECK IF THE CONTEXT IS RESUME/ATTACH
876 1320 IF (STACK(TOP+3).EQ.2) GOTO 1330
877 IF (STACK(TOP+3).EQ.3) GOTO 1340
880 C RECOGNIZED ATTACH(MAIN)
881 1330 CALL OUTPUT(WIDENT,K)
882 CALL OUTPUT(WATTACH,-1)
884 1340 CALL OUTPUT(WIDENT,K)
885 CALL OUTPUT(WRESUME,-1)
887 IF (S.EQ.SRIGHT) GOTO 999
891 C STACK(TOP+3) - LABEL OF THE BEGINNING OF THE LOOP BODY
892 C STACK(TOP+4) - LABEL OF THE FIRST STATEMENT BEHIND THE LOOP BODY
893 1401 STACK(TOP+3)=UNICAL
894 STACK(TOP+4)=UNICAL+1
897 CALL OUTPUT(WLABEL,STACK(TOP+3))
902 C CALL E8 (INSTRUCTION) WITH PARAMETER 4
903 130 CALL OUTPUT(WINSTREND,LN)
904 CALL OUTPUT(WJUMP,STACK(TOP+3))
905 CALL OUTPUT(WLABEL,STACK(TOP+4))
906 IF (S.EQ.SOD) GOTO 999
911 1505 STACK(TOP+3)=STACK(TOP+3)+1
912 IF (ADRES.EQ.2) GOTO 1550
914 IF (S.EQ.SEXIT) GOTO 1505
915 CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),1))
917 1550 CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),0))
920 1601 STACK(TOP+3)=UNICAL+1
921 STACK(TOP+4)=UNICAL+162
926 C STACK(TOP+3) - BASIC CASE LABEL, NOT USED
927 C STACK(TOP+4) - END LABEL OF THE CASE STATEMENT
928 C STACK(TOP+5) - COUNTER OF WHEN'S (NUMBER OF WHEN'S LIMITED BY 160)
929 C STACK(TOP+6) - 0 = OVERFLOW FLAG (TOO MANY WHEN'S)
930 C NOTE: THE BASIC LABEL IS RESERVED ESPECIALLY FOR AIL, NOT USED IN HERE.
931 C LABELS FOR WHEN'S ARE OF THE FORM: BASIS + I , WHERE I = 1 .. 160
932 C TOTAL NUMBER OF RESERVED LABELS IS 163.
938 C CALL E2 - ARITHEXPRESSION TO ANALYSE THE EXPRESSION AFTER CASE
939 260 CALL OUTPUT(WCASE,STACK(TOP+3))
940 IF (S.EQ.SWHEN) GOTO 1605
944 C RECOGNITION OF THE SELECTION LABEL
945 1607 IF (STACK(TOP+6).EQ.0) GOTO 1621
946 IF (S.EQ.SIDENT) GOTO 1610
947 IF (S.EQ.SCONST) GOTO 1615
949 CALL OUTPUT(WIDENT,0)
951 C IDENTIFIER RECOGNIZED
952 1610 CALL OUTPUT(WIDENT,ADRES)
954 C CONSTANT RECOGNIZED
955 1615 IF (K.EQ.6) GOTO 1618
956 IF (K.NE.3) GOTO 1608
958 CALL OUTPUT(WCNSTI,ADRES)
961 1618 CALL OUTPUT(WCNSTC,ADRES)
962 1620 CALL OUTPUT(WCASEL,STACK(TOP+3)+STACK(TOP+5))
964 IF (S.EQ.SCOLON) GOTO 1625
965 IF (S.NE.SCOMA) GOTO 1623
966 C COMA ENCOUNTERED - FURTHER LABEL LIST EXPECTED
969 C NEITHER SEMICOLON NOR COMMA (ERROR AND WE CONTINUE AS FOR
970 C SEMICOLON - INSTRUCTIONS)
973 C SEMICOLON ENCOUNTERED - INSTRUCTIONS ARE TO BE ANALYSED
975 1626 IF (STACK(TOP+5).NE.161) GOTO 1627
980 1627 CALL OUTPUT(WLABEL,STACK(TOP+3)+STACK(TOP+5))
981 STACK(TOP+5)=STACK(TOP+5)+1
982 1628 CALL SLAD(5,8,27)
986 C CALL E8 TO ANALYSE THE INSTRUCTION LIST ENDED BY WHEN, OTHERWISE
987 C OR ESAC (PARAMETER = 6)
988 270 CALL OUTPUT(WJUMP,STACK(TOP+4))
989 IF (S.EQ.SWHEN) GOTO 1605
990 IF (S.NE.SOTHER) GOTO 1655
991 C OTHERWISE ENCOUNTERED
992 CALL OUTPUT(WOTHER,-1)
998 C CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE ENDED BY ESAC (PARAMETER=7)
999 C AFTER RETURN JUMP BEHIND CASE IS NOT TO BE GENERATED
1001 C ESAC ENCOUNTERED (A MISSING ESAC IS DIAGNOSED ON SOME OTHER LEVEL).
1002 C HERE, TO PROVIDE CODE CONSISTENCY, WE ASSUME THAT AN ESAC HAS OCCURRED
1004 1655 CALL OUTPUT(WESAC,-1)
1005 CALL OUTPUT(WLABEL,STACK(TOP+4))
1006 IF (S.EQ.SESAC) GOTO 999
1014 C CALL E3 T OANALYSE THE VARIABLE
1015 210 CALL OUTPUT(WFORVAR,-1)
1016 IF (S.EQ.SBECOME) GOTO 1703
1023 C CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS
1024 220 CALL OUTPUT(WFROM,-1)
1025 IF (S.NE.STEP) GOTO 1705
1030 C CALL E2 TO ANALYZE THE STEP
1031 230 CALL OUTPUT(WSTEP,-1)
1032 1705 IF (S.EQ.STO) GOTO 1707
1033 IF (S.EQ.SDOWN) GOTO 1709
1036 C STACK(TOP+3)=0 IFF "TO" ENCOUNTERED, OTHERWISE -1 STANDS FOR "DOWNTO"
1044 C CALL E2 TO ANALYSE BOUNDS OF THE FOR LOOP
1045 240 IF (STACK(TOP+3).EQ.1) GOTO 1713
1048 1713 CALL OUTPUT(WDOWNTO,-1)
1049 C STACK(TOP+3) LABEL OF THE END OF THE LOOP (BEFORE OD!)
1050 C STACK(TOP+4) LABEL OF THE FIRST INSTRUCTION BEHIND THE LOOP
1051 C STACK(TOP+5) LABEL OF THE BEGINNING OF THE LOOP
1052 1715 STACK(TOP+3)=UNICAL
1053 STACK(TOP+4)=UNICAL+1
1054 STACK(TOP+5)=UNICAL+2
1056 CALL OUTPUT(STACK(TOP+5),STACK(TOP+4))
1057 IF (S.EQ.SDO) GOTO 1717
1065 C CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE
1066 C WITH PARAMETER = 4, I.E. "OD" IS THE TERMINAL SYMBOL
1067 250 CALL OUTPUT(WLABEL,STACK(TOP+3))
1068 CALL OUTPUT(WFOREND,-1)
1069 CALL OUTPUT(WJUMP,STACK(TOP+5))
1070 CALL OUTPUT(WLABEL,STACK(TOP+4))
1071 IF (S.EQ.SOD) GOTO 999
1079 C CALL E3 TO ANALYSE THE VARIABLE
1080 180 IF (S.EQ.SDIM) GOTO 1810
1084 IF (S.EQ.SLEFT) GOTO 1820
1087 1820 CALL OUTPUT(WLSE,-1)
1092 C CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS OF THE "FOR"
1093 190 CALL OUTPUT(WLOW,-1)
1094 IF (S.EQ.SCOLON) GOTO 1830
1101 C CALL E2 - ARITHEXPRESSION
1102 200 CALL OUTPUT(WNEWARRAY,-1)
1103 IF (S.EQ.SRIGHT) GOTO 999
1109 IF (S.EQ.SLEFT) GOTO 2003
1114 C STACK(TOP+6) - 0 - THERE WAS WRITE, 1 - THERE WAS WRITELN
1116 C CHECK IF THERE ARE PARAMETERS OF WRITELN
1117 IF (S.EQ.SLEFT) GOTO 2003
1118 CALL OUTPUT(WRITELN,WIOEND)
1124 C CALL E4 - EXPRESSION TO ANALYSE PARAMETERS OF WRITE(LN)N
1125 C STACK(TOP+5) - INCLUDES NUMBER OF THE EXPRESSIONS USED TO DESCRIBE
1128 170 IF (S.NE.SCOLON) GOTO 2010
1129 STACK(TOP+5)=STACK(TOP+5)+1
1130 IF (STACK(TOP+5).GT.2) GOTO 2015
1135 C CALL ARITHEXPRESSION TO ANALYSE FORMATS
1136 C RETURN TO LABEL 170 (OPTIMIZATION)
1137 2010 CALL OUTPUT(WRITE,STACK(TOP+5))
1138 C CHECK FOR END OF WRITE / WRITELN
1139 IF (S.EQ.SCOMA) GOTO 2003
1140 IF (S.EQ.SRIGHT) GOTO 2020
1141 2015 CALL ERROR(107)
1143 C WRITE INFORMATION ABOUT THE OCCURRENCE OF WRITELN
1144 2020 IF (STACK(TOP+6).EQ.1) CALL OUTPUT(WRITELN,-1)
1145 CALL OUTPUT(WIOEND,-1)
1149 C ANALYSIS OF WAIT AS FOR KIL, RESUME, AND SO ON.
1153 CALL OUTPUT(WBLOCK,ISFIN)
1154 C STACK(TOP+5) INCLUDES PREFIX ADDRESS, HERE 0 FOR REGULAR BLOCK,
1155 C JUMP OUT - FURTHER ANALYSIS AS FOR A PREFIXED BLOCK
1159 IF (S.EQ.SIDENT) GOTO 2302
1162 C PREFIX ENCOUNTERED - STORE ITS ADDRESS INTO STACK(TOP+5)
1163 2302 STACK(TOP+5)=ADRES
1164 CALL OUTPUT(WPREF,ISFIN)
1166 IF (S.EQ.SBLOCK) GOTO 2310
1167 IF (S.EQ.SLEFT) GOTO 2303
1170 C ANALYSIS OF THE PARAMETERS OF THE PREFIX
1171 2303 CALL OUTPUT(WLEFT,-1)
1176 C CALL E4 - EXPRESSION TO ANALYSE THE ACTUAL PARAMETERS
1178 140 IF (S.EQ.SCOMA) GOTO 2305
1179 IF (S.EQ.SRIGHT)GOTO 2306
1182 2305 CALL OUTPUT(WCOMA,-1)
1185 CALL OUTPUT(WRIGHT,-1)
1186 C COMMON ANALYSIS FOR ALL BLOCKS
1187 C POSITIONS ARE STORED INTO THE INTERMEDIATE CODE
1188 2310 CALL MARK(STACK(TOP+3),STACK(TOP+4))
1193 C ASSIGNMENT OF THE PARAMETER'S VALUE - BLOCK PREFIX
1196 C CALL E11 TO ANALYSE THE ENTIRE BLOCK
1197 C AFTER RETURN WE RECLAIM THE PLACE FROM WHICH THE INTERMEDIATE CODE FOR
1198 C THE GIVEN BLOCK IS TO BE CONTINUED
1199 150 CALL FIND(STACK(TOP+3),STACK(TOP+4))
1205 C FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
1210 IF (S.EQ.SIDENT) GOTO 905
1211 C FURTHER ANALYSIS AS FOR CALL (BUT STACK(TOP+3)=1)
1214 C----- S = WIND, TERMINATE
1215 2701 CALL OUTPUT(WIND+ADRES-1,-1)
1218 2801 IF (STACK(TOP+7).EQ.5) GOTO 1114
1221 C----- S = ASSEMBLER
1222 C --- ASSEMBLER INSERTIONS NOT IMPLEMENTED
1223 2901 CALL ERROR(106)
1224 2904 IF (S.EQ.SEND) GOTO 999
1231 IF (S.EQ.SLEFT) GOTO 3010
1238 C CALL E3 - OBJECTEXPRESSION TO ANALYSE THE VARIABLE
1239 310 STACK(TOP+3)=WOPEN1
1240 cfile ----------- added ---------------------------
1241 if(s.ne.scoma) go to 3013
1246 c call expression to analyse the second parameter
1247 cfile --------------------------------------------
1248 350 IF (S.EQ.SRIGHT) GOTO 3025
1249 IF (S.EQ.SCOMA) GOTO 3015
1250 3013 CALL ERROR(107)
1251 3014 IF (S.EQ.SEND) GOTO 1000
1258 C CALL EXPRESSION TO ANALYSE THE THIRD PARAMETER
1259 340 STACK(TOP+3)=WOPEN2
1260 3025 CALL OUTPUT(STACK(TOP+3),-1)
1261 IF (S.NE.SRIGHT) GOTO 3013
1264 3101 STACK(TOP+3)=WPUT+ADRES-1
1265 C STACK(TOP+3) - WPUT ALBO WGET
1267 IF (S.EQ.SLEFT) GOTO 3110
1271 cdsw CALL SLAD(2,8,32)
1275 C CALL E3 (OBJECTEXPRESSION) TO ANALYSE THE PARAMETER OF PUT/GET
1276 320 CALL OUTPUT(STACK(TOP+3),-1)
1277 IF (S.EQ.SRIGHT) GOTO 3140
1278 IF (S.EQ.SCOMA) GOTO 3120
1285 C CALL EXPRESSION TO ANALYSE THE PARAMETER OF PUT/GET
1286 C NOTE: RETURN INTO NON-STANDARD PLACE
1288 3180 CALL OUTPUT(WIOEND,-1)
1293 IF (S.EQ.SLEFT) GOTO 803
1295 cdeb ----------- added --------------
1299 cdeb ----------------------------------
1301 c ----- s = putrec/getrec
1303 stack(top+3) = wput+addr-1
1305 if (s .eq. sleft) goto 3410
1312 360 if (s .ne. scoma) goto 3420
1313 call output(stack(top+3), -1)
1314 stack(top+3) = wputrec+addr-1
1319 370 if (s .ne. scoma) goto 3420
1324 380 if (s .ne. sright) goto 3013
1325 call output(stack(top+3), -1)
1326 call output(wioend, -1)
1328 3420 call error(147)
1331 cbc added concurrent statements
1332 c ----- s = enable/disable
1333 3501 call output(wenab+adres-1, -1)
1335 if (s .ne. sident) goto 3520
1336 call output(wident, adres)
1338 if (s .eq. scoma) goto 3510
1339 call output(wprend, -1)
1341 3520 call error(109)
1344 3601 call output(waccep, -1)
1346 if (s .ne. sident) goto 3620
1347 call output(wident, adres)
1349 if (s .eq. scoma) goto 3510
1350 3620 call output(wprend, -1)
1353 C ----- END OF INSTRUCTIONS ----------------------------------
1356 C RETURN FROM ASSIGNMENT /JUMP OPTIMIZATION/
1358 C LABEL 80 (A GARBAGE FROM THE OLD VERSION OF THE PARSER)
1359 C RETAINED TO PRESERVE THE CONTINUITY OF THE REMAINING LABEL NUMBERS
1360 C (USED TO MARK RETURN POINTS FROM RECURSIVE CALLS)
1362 C INSTRUCTIONS RECOGNIZED
1363 C CHECK FOR A TERMINAL SYMBOL
1364 1111 IF (S.EQ.SEMICOL) GOTO 8
1365 IF (S.EQ.SELSE) GOTO 1116
1366 IF (S.EQ.SFI) GOTO 1115
1367 IF (S.EQ.SOD) GOTO 1117
1368 IF (S.EQ.SEND) GOTO 1114
1369 IF (S.EQ.SOTHER) GOTO 1119
1370 IF (S.EQ.SOTHRS) GOTO 1120
1371 IF (S.EQ.SWHEN) GOTO 1119
1372 IF (S.EQ.SESAC) GOTO 1118
1373 IF (S.EQ.SVAR) GOTO 1113
1374 IF (S.EQ.SUNIT) GOTO 1113
1375 IF (S.EQ.SCONS) GOTO 1113
1376 IF (S.NE.SEOF) GOTO 6
1377 1113 CALL ERROR(113)
1380 1115 IF (STACK(TOP+7).EQ.3) GOTO 1114
1381 1116 IF (STACK(TOP+7).EQ.2) GOTO 1114
1384 1117 IF (STACK(TOP+7).EQ.4) GOTO 1114
1387 1118 IF (STACK(TOP+7).EQ.7) GOTO 1114
1388 IF (STACK(TOP+7).EQ.6) GOTO 1114
1391 1119 IF (STACK(TOP+7).EQ.6) GOTO 1114
1392 IF (STACK(TOP+7).EQ.1) GOTO 1114
1395 1120 IF (STACK(TOP+7).EQ.1) GOTO 1114
1404 C AUGMENTS THE PROTOTYPE BY THE STARTING PLACE OF THE INTERMEDIATE
1405 C CODE FOR THE PARSED SYNTACTICAL UNIT
1407 C STACK(TOP+3) - ENTRY: PROTOTYPE ADDRESS
1408 C CONT.: ENDUNIT LABEL
1409 C STACK(TOP+4) - COPY OF THE PROTOTYPE ADRESS
1411 IMPLICIT INTEGER(A-Z)
1412 COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
1414 COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
1417 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
1418 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
1419 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
1420 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
1421 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
1422 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
1423 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
1424 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
1425 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
1426 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
1427 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
1428 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
1429 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
1430 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
1431 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
1432 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
1433 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
1434 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
1436 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
1437 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
1438 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
1439 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
1440 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
1441 M WRITE, WRITELN, WBOUND, UNICAL,
1443 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
1444 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
1445 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
1446 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
1448 cdsw $ SCANER(3735),
1450 Z TOP, IN, NEXT, STACK(500),
1452 DIMENSION IPMEM(7890)
1453 EQUIVALENCE (SCANER(1),IPMEM(1))
1458 10 STACK(TOP+4)=STACK(TOP+3)
1461 C PROTOTYPE ADDRESS IS MOVED TO VARIABLE NRRE TO SPARE SOME CODE
1462 C CHECK IF ANYTHING HAS BEEN SENT TO THE INTERMEDIATE CODE
1463 IF (IPMEM(NRRE-3).NE.0) GOTO 15
1466 15 STACK(TOP+3)=UNICAL
1468 CALL OUTPUT(WFIRST,LN)
1469 IF (S.EQ.SBEGIN) CALL SCAN
1471 IF (S.EQ.SEND) GOTO 22
1476 C CALL E8 - INSTRUCTIONS
1477 C PARAMETER = 5 /AN INSTRUCTION SEQUENCE
1478 C TERMINATED BY END /
1479 20 IF (S.NE.SLASTW) GOTO 22
1480 C LASTWILL OCCURRED - END OF CODE SHOULD BE ASSUMED AND THE PARSING SHOULD
1481 C CONTINUE. END-LABEL IS TO BE CHANGED!
1482 CALL OUTPUT(WLASTW,STACK(TOP+3))
1487 IF (S.EQ.SCOLON) CALL SCAN
1492 C CALL E8 TO ANALYSE INSTRUCTIONS AFTER LASTWILL
1493 30 IF (S.EQ.SLASTW) GOTO 32
1494 22 CALL OUTPUT(WFIN,STACK(TOP+3))
1503 IMPLICIT INTEGER (A-Z)
1505 C RECOGNIZES SEQUENCE OF DECLARATIONS
1506 C UPDATES THE PROTOTYPE WHOSE ADDRESS IS PASSED BY
1508 C CREATES LISTS OF CONSTANTS; FOR ENUMERATION CONSTANTS CREATES DESCRIPTIONS
1509 C INCLUDING NAMES OF THE CONSTANTS AND THE NUMBERS OF THEIR DECLARATION LINES.
1510 C STACK(TOP+4) - STACK(TOP+5) - DESCRIBE THE PLACE IN THE INTERMEDIATE
1511 C CODE IN THE CASE WHEN THE SUBMODULE INSTRUCTIONS HAVE TO BE WRITTEN
1512 C AFTER AN OCCURRENCE OF ENUMERATION CONSTANTS.
1513 C N O T E: THE MEANING OF THE PROTOTYPE WORD #-1 IS CHANGED. IT INCLUDES:
1514 C 0 - THERE ARE NO ENUMERATION CONSTANTS
1515 C -1 - CONSTANTS ARE WRITTEN INTO, WORKING FILE LEFT OK
1516 C 1 - THE CONSTANTS ARE FOLLOWED BY THE CODE FOR SUBMODULES
1519 C-------------------------------------------------------------------
1520 C CONSTANT LIST ITEM:
1523 C ---+------------------------
1524 C +1 ! DECL. LINE NUMBERA
1525 C ---+------------------------
1527 C ---+------------------------
1529 C ---+------------------------
1530 C +4 ! ADDRESS IN DICTIONARY OR VALUE
1531 C ---+------------------------
1532 C +5 ! THE NEXT ITEM
1533 C ---+------------------------
1535 C------------------------------------------------------------------------
1536 C SIGNAL LIST ITEM::
1538 C ----+-------------------
1540 C ----+-------------------
1541 C +1 ! LINE NUMBER IN THE SOURCE TEXT
1542 C ----+-------------------
1544 C ----+-------------------
1545 C +3 ! THE NEXT ITEM IN THE LIST
1546 C ----+-------------------
1547 C +4 ! FORMAL PARAMETER LIST
1548 C ----+-------------------
1551 C 9 - SIGNAL CONSTRUCTED PROPERLY
1552 C 10 - SIGNAL WITH A FAULTY PARAMETER LIST
1556 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
1557 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
1558 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
1559 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
1560 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
1561 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
1562 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
1563 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
1564 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
1565 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
1566 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
1567 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
1568 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
1569 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
1570 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
1571 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
1572 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
1573 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
1575 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
1576 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
1577 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
1578 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
1579 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
1580 M WRITE, WRITELN, WBOUND, UNICAL,
1582 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
1583 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
1584 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
1585 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
1587 cdsw $ SCANER(3735),
1589 Z TOP, IN, NEXT, STACK(500),
1592 cdsw INTEGER IPMEM(1000)
1593 dimension ipmem(7890)
1594 COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
1596 COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
1597 EQUIVALENCE (SCANER(1),IPMEM(1))
1601 C RECOGNITION OF DECLARATIONS
1604 10 IF (S.EQ.SCONS) GOTO 200
1605 IF (S.EQ.SVAR) GOTO 110
1606 IF (S.EQ.SUNIT) GOTO 125
1607 IF (S.EQ.SIGNAL) GOTO 500
1608 IF (S.EQ.SHANDL) GOTO 1000
1609 IF (S.EQ.SBEGIN) GOTO 1000
1610 IF (S.EQ.SEND) GOTO 1000
1611 IF (S.EQ.70) GOTO 1000
1612 IF ((S.GT.1).AND.(S.LT.25)) GOTO 1000
1613 IF (S.NE.SEMICOL) CALL ERROR(127)
1614 IF (S.EQ.SBECOME) GOTO 1000
1617 C CHECK FOR FURTHER CONSTANT DECLARATIONS (COMMA)
1618 C---------- VARIABLES
1622 IF (S.EQ.SIDENT) GOTO 112
1627 IF (K.GT.132) CALL ERROR(197)
1628 C THE IDENTIFIER IS APPENDED TO THE LIST OF VARIABLES IN ARRAY COM.
1629 C THE LIMIT FOR THE LENGTH OF THAT LIST IS 132. EXCEEDING THIS LIMIT
1630 C CAUSES PARSER ERROR 137.
1632 C NOTE: K IS USED ABOVE
1634 IF (S.EQ.SCOMA) GOTO 111
1635 IF (S.EQ.SCOLON) GOTO 113
1639 CALL ADDVAR(COM(2),J)
1641 C CHECK FOR MORE DECLARATIONS OF VARIABLES (COMMA)
1642 IF (S.EQ.SCOMA) GOTO 110
1643 IF (S.EQ.SBEGIN) GOTO 1000
1644 IF (S.EQ.SEND) GOTO 1000
1645 IF (S.EQ.SEMICOL) GOTO 15
1648 C---------- SUBMODULE
1649 125 NRRE=STACK(TOP+3)-1
1650 IF (IPMEM(NRRE).GE.0) GOTO 128
1651 C ENUMERATION CONSTANTS ARE ALREADY WRTITTEN INTO THE INTERMEDIATE CODE
1653 CALL MARK(STACK(TOP+4),STACK(TOP+5))
1654 128 CALL SLAD(3,10,3)
1658 C CALL E11 - SYNTACTIC UNIT - MODULE
1659 C RETURN TO THE BEGINNING (JUMP OPTIMIZATION)
1660 C---------- CONSTANT
1662 IF (S.EQ.SIDENT) GOTO 202
1665 202 STACK(TOP+6)=ADRES
1667 IF ((S.EQ.SRELAT).AND.(ADRES.EQ.3)) GOTO 205
1670 C "CONST IDENT =" ENCOUNTERED
1672 C RESERVATION OF IPMEM SPACE FOR THE CONSTANT DESCRIPTION
1674 IF (LPMF.LT.LPML) CALL ERROR(199)
1675 IPMEM(LPMF+1)=STACK(TOP+6)
1678 IPMEM(LPMF+6)=IPMEM(NRRE)
1680 C RECOGNITION OF THE TYPE
1681 IF (S.EQ.STRUE) GOTO 300
1682 IF (S.NE.SCONST) GOTO 300
1683 IF (K.EQ.4) GOTO 250
1684 IF (K.NE.6) GOTO 300
1685 C CHARACTER CONSTANT (K=6)
1688 C TEXT CONSTANT (K=4)
1689 250 IPMEM(LPMF+3)=48
1690 260 IPMEM(LPMF+5)=ADRES
1694 300 NRRE=STACK(TOP+3)-1
1695 IF (IPMEM(NRRE).EQ.0) GOTO 310
1696 C ANYTHING WRITTEN INTO INTERMEDIATE CODE ?
1697 IF (IPMEM(NRRE).EQ.-1) GOTO 325
1698 C YES BUT A SUBMODULE HAS BEEN WRITTEN
1699 CALL FIND(STACK(TOP+4),STACK(TOP+5))
1700 C THE PLACE IN THE INTERTMEDIATE CODE HAS BEEN FOUND
1703 C THE INITIAL INSTRUCTIONS OF THE INTERMEDIATE CODE
1707 325 CALL OUTPUT(WINSTREND,LN)
1708 CALL OUTPUT(WIDENT,STACK(TOP+6))
1709 CALL OUTPUT(WLSE,-1)
1713 C CALL E12 TO ANALYSE THE EXPRESSION
1714 20 CALL OUTPUT(WASSCON,-1)
1715 350 IF (S.EQ.SCOMA) GOTO 200
1716 IF (S.EQ.SBEGIN) GOTO 1000
1717 IF (S.EQ.SEND) GOTO 1000
1718 IF (S.EQ.SEMICOL) GOTO 15
1721 1000 NRRE=STACK(TOP+3)-1
1723 IF (IPMEM(NRRE).LE.0) GOTO 1010
1724 C SUBMODULES WERE PRECEDED BY ENUMERATION CONSTANTS - THE BEGINNING
1725 C OF CODE HAS TO BE FOUND
1726 CALL FIND(STACK(TOP+4),STACK(TOP+5))
1729 C---------- SIGNAL DECLARATION
1731 IF (S.EQ.SIDENT) GOTO 505
1734 C CREATION OF THE SIGNAL DESCRIPTION
1736 IF (LPMF.LT.LPML) CALL ERROR(199)
1740 C THE SYNTACTIC FATHER IS APPENDED TO THE LIST OF SIGNALS (PROTOTYPE WORD #4)
1741 NRCOR=STACK(TOP+3)-4
1744 IPMEM(LPMF+4)=NRCHAR
1745 C THE SIGNAL DESCRIPTION IS CREATED AND APPENDED
1747 IF (S.EQ.SCOMA) GOTO 500
1748 IF (S.EQ.SEMICOL) GOTO 15
1749 IF (S.EQ.SLEFT) GOTO 508
1753 cdsw&bc 508 STACK(TOP+5)=LPMF+1
1754 c CALL ADDPAR(STACK(TOP+5)+4,STACK(TOP+5))
1756 call addpar(lpmf+5, lpmf+1)
1758 IF (S.EQ.SRIGHT) GOTO 510
1762 IF (S.EQ.SCOMA) GOTO 500
1763 IF (S.EQ.SEMICOL) GOTO 15