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 ===============================================================
16 CBC B.Ciesielski added concurrent statements
17 CBC 1987.04.15 1. RESUME same as ATTACH, opcode 220
18 CBC 1987.04.24 2. added missing STORAGE:2 metacommand
19 CBC 1987.11.18 3. added procedure SCONC
22 C------------------------------------------------------
24 C NA CZUBKU JEST ARGUMENT RESUME. BADA TYP,GENERUJE KOD,
27 C ##### OUTPUT CODE : 220 .
29 C ##### DETECTED ERROR(S) : 477
31 C............. /STOS/ .....
32 IMPLICIT INTEGER (A-Z)
33 COMMON /STOS/ BOTTOM,VALTOP,VLPREV,STCKAG,STCKA0,STCKAP(14),
34 X APETYT(4),LSTLSE,LSTFOR,KIND,PHADR,LASTPR,FSTOUT,
35 X CONSNR(8),LSTSAF,LSTEMP,TEMPNR,LSTWRD,QRECNR,WB,
36 X RESULT,FRSTTS,UNIT,INNER,LSTWILL,TEST,ARG,ATLINE,
37 X FILE,FLARGS,FLMODF,FLREADY,ICOUNT,OCOUNT
38 LOGICAL LSTWILL,FLREADY,TEST
40 COMMON/OPTION/OPTMEM,OPTOPT,OPTIND,OPTTYP,OPTTRC,OPTCSC,OPTCSF
41 LOGICAL OPTOPT,OPTTYP,OPTTRC
44 COMMON /BLANK/ IOP(4),
46 X TLDIM, TLBAS, IDL, OBJL,
47 X TRDIM, TRBAS, IDR, OBJR,
52 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
53 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
54 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
59 EQUIVALENCE(STALER(1),IPMEM(1) )
60 EQUIVALENCE(STACK(1),IPMEM(1))
66 IF(STACK(VALTOP).EQ.0)RETURN
67 IF(STACK(VALTOP-3).GT.0)GO TO 500
69 ELEM=IAND(IPMEM(ELEM),15)
70 IF(ELEM.GT.7 .AND. ELEM.LT.13 .OR. ELEM.EQ.2)GO TO 500
73 IF(STACK(VALTOP).EQ.1)ELEM=LMEM-3
77 C NIEPOPRAWNY TYP ARGUMENTU RESUME
82 subroutine sconc(action)
83 IMPLICIT INTEGER (A-Z)
84 COMMON /STOS/ BOTTOM,VALTOP,VLPREV,STCKAG,STCKA0,STCKAP(14),
85 X APETYT(4),LSTLSE,LSTFOR,KIND,PHADR,LASTPR,FSTOUT,
86 X CONSNR(8),LSTSAF,LSTEMP,TEMPNR,LSTWRD,QRECNR,WB,
87 X RESULT,FRSTTS,UNIT,INNER,LSTWILL,TEST,ARG,ATLINE,
88 X FILE,FLARGS,FLMODF,FLREADY,ICOUNT,OCOUNT
89 LOGICAL LSTWILL,FLREADY,TEST
92 COMMON /BLANK/ IOP(4),
94 X TLDIM, TLBAS, IDL, OBJL,
95 X TRDIM, TRBAS, IDR, OBJR,
100 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
101 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
102 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
103 X LOCAL, OWN, OBJECT,
107 EQUIVALENCE(STALER(1),IPMEM(1) )
108 EQUIVALENCE(STACK(1),IPMEM(1))
110 c generate proper opcode
112 c process next identifier
114 if (wb .ne. 28) goto 200
116 c check if procedure or function
119 if (elem .ne. 11 .and. elem .ne. 12) goto 110
120 c output prototype address
125 c end of identifier list
127 c generate ACCEPT2 if necessary
128 if (action .eq. 225) call quadr1(226)