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 c files used by compiler :
18 c unit file description
20 c 13 output sequential (F) listing (.LST) (ML2, )
21 c 14 temporary direct (C) code after parser (WAN1, ML2)
22 c 15 output sequential (C) L-code (.LCD) (WAN1, ML2)
23 c 16 temporary sequential (C) listing (WAN1, ML2)
24 c 17 input sequential (C) source (WAN1, ML2)
25 c 18 temporary sequential (C) L-code (WAN1, AL11)
26 c 19 temporary direct (C) errors (WAN2, ML2)
27 c 21 output sequential (C) debugger (WAN1, ML2)
29 subroutine LOGLAN(parlen,parbuf)
32 IMPLICIT INTEGER (A-Z)
33 c parlen - dlugosc linii z parametrami dla kompilatora
34 c parbuf - bufor zawierajacy parametry dla kompilatora
35 C======================================================================C
42 C DANKA SZCZEPANSKA-WASERSZTRUM C
44 C ANDRZEJ I. LITWINIUK C
45 C WOJTEK A. NYKOWSKI C
47 C IIUW, WARSZAWA, 1982 C
49 C PORTED TO SIEMENS 7760 BS2000 BY: C
51 C PAWEL K. GBURZYNSKI C
53 C ANDRZEJ I. LITWINIUK C
55 C IIPMCAU, KIEL, MAY-JUNE 1984 C
57 C PORTED TO IBM PC BY C
58 C Danuta Szczepanska C
59 C Boleslaw Ciesielski C
62 C PORTED TO VAX / VMS BY C
63 C Danuta Szczepanska C
66 C PORTED TO XENIX SCO BY C
69 C PORTED TO UNIX SCO BY C
72 C PORTED TO SUN SPARC BY C
75 C======================================================================C
76 IMPLICIT INTEGER (A-Z)
77 COMMON /BLANK/ C0M(4) , S, ADRES , K
78 common /mjlmsg/ierc,msg
80 C======================================================================C
81 C THE FOLLOWING FILE UNITS ARE USED: C
83 C 1 - INTERACTIVE INPUT FROM THE TERMINAL C
84 C 2 - INTERACTIVE OUTPUT TO THE TERMINAL C
85 C 13 - LISTING OUTPUT C
86 C 14 - WORKING FILE SCRATCH C
87 C 15 - L-CODE OUTPUT C
88 C 16 - PARTIAL LISTING FROM PARSER C
89 C 17 - SOURCE INPUT TO THE COMPILER C
90 C 18 - AUXILIARY SOURCE INPUT C
91 C 19 - SCRATCH FILE INCLUDING INFO ABOUT COMPILATION ERRORS C
92 C======================================================================C
94 character jfname, param
96 common /par/ param(256),dl, pozopt
97 c param - line of program parameters
98 c dl - length of program parameters
99 c pozopt - options position in param
101 common /jf/jfname(72),jf
104 call ffputcs(0,' LOGLAN-82 UNIX Compiler, Version 2.1')
106 call ffputcs(0,' January 10, 1993')
108 call ffputcs(0,' (C)Copyright Institute of Informatics,')
109 call ffputcs(0,' University of Warsaw')
110 call ffputcs(0,' (C)Copyleft LITA Universite de Pau')
118 15 param(i)=parbuf(i)
120 if(dl.ne.0) go to 100
125 call ffputcs(0,' File name: ')
126 call ffgets (0,param,70)
129 c file name is in param
132 if(param(pozopt).ne.' ') go to 30
136 50 if(param(pozopt).eq.' '.or.param(pozopt).eq.',' .or.
137 * param(pozopt).eq.';') go to 300
138 if (jf.ge.70) go to 40
140 jfname(jf) = param(pozopt)
142 if(pozopt .le. dl) go to 50
143 300 if (jf.eq.0) go to 200
154 IMPLICIT INTEGER (A-Z)
156 C INITIATES THE BLANK COMMON
157 C FIXES DIVISION OF IPMEM INTO COMPILER TABLES
161 COMMON /BLANK/ COM(278),
162 X LMEM , LPMEM , IRECN , ISFIN , LPMSYS, LPML , LPMF ,
163 X NRINT , NRRE , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
164 X NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
165 X LOCAL , OWN , OBJECT,
167 cdsw&bc X IPMEM(50000)
169 C COM - OBSZAR KOMUNIKACYJNY STRUMIENI
170 C LMEM - (=32000) ROZMIAR CALEJ PAMIECI GLOWNEJ
171 C LPMEM - PODZIAL PAMIECI NA CZESCI IPMEM I ISMEM
172 C IRECN - INDEKS SZCZYTU STOSU STALYCH REAL
173 C ISFIN - INDEKS SZCZYTU SLOWNIKA PROTOTYPOW
175 C LPMSYS - INDEKS PIERWSZEGO SLOWA W IPMEM OBSZARU NIEPRZEZ-
176 C NACZONEGO NA PROTOTYPY SYSTEMOWE
177 C LPML - INDEKS PIERWSZEGO SLOWA OBSZARU WOLNEGO W IPMEM
178 C LPMF - INDEKS OSTATNIEGO SLOWA WOLNEGO OBSZARU W IPMEM
180 C IDENTYFIKATORY PROTOTYPOW SYSTEMOWYCH
181 C NRINT - IDENTYFIKATOR PROTOTYPU INTEGER
187 C NRTEXT - STRING (TEXT)
188 C NRUNIV - IDENTYFIKATOR PROTOTYPU UNIWERSALNEGO
189 C NATTR - IDENTYFIKATOR PSEUDO-ATRYBUTU (Z NUMEREM -1)
190 C NRNONE - IDENTYFIKATOR PROTOTYPU TYPU NONE (UNIWERSALNY
192 C NBLSYS - IDENTYFIKATOR BLOKU SYSTEMOWEGO
193 C NBLUS - BLOKU GLOWNEGO UZYTKOWNIKA
195 C INSYS - FLAGA SPOSOBU REZERWACJI (PRZEZ MGETM) PAMIECI
196 C W IPMEM - .TRUE. JESLI REZERWACJA W CZESCI SYSTE-
198 C LOCAL - FLAGA DOSTEPU DO OBIEKTOW - 2 JESLI OBIEKT
199 C BYL LOKALNY, 1 - GDY Z SL, 0 - GDY Z BLOKU GLOWNEGO
200 C OWN - FLAGA DOSTEPU DO OBIEKTOW - .TRUE. JESLI OBIEKT NIE
201 C POCHODZI Z PREFIKSOW (TYLKO Z WLASCIWEGO OBIEKTU)
202 C OBJECT - PROTOTYP OBIEKTU, Z KTOREGO POCHODZIL OSTATNIO
203 C SZUKANY IDENTYFIKATOR (OBIEKT POCHODZACY Z CIAGU SL)
206 C IN THIS PLACE THE SIZE OF IPMEM MAY BE REDECLARED; THEN THE
207 C VARIABLE LMEM (BELOW) SHOULD BE SET TO THE LENGTH OF IPMEM.
210 C IPMEM - MAIN MEMORY AREA OF THE COMPILER
211 C LPML - ADDRESS OF THE FIRST -
212 C LPMF - ADDRESS OF THE LAST FREE WORD IN IPMEM
213 C ISFIN - TOP OF THE DICTIONARY OF PROTOTYPES
214 C LPMEM - DIVISION POINT OF IPMEM
215 C LMEM - LENGTH OF IPMEM
222 IF (LPMEM.GT.4550) GO TO 1
223 C --- SIZE OF IPMEM TOO SMALL
224 call ffputcs(0,' Fatal Error: Memory overflow ')
231 C --- 2 BELOW STANDS FOR THE SIZE OF REAL NUMBER EXPRESSED IN THE
232 C --- NUMBER OF INTEGERS WHICH COVERS THIS SIZE.
233 cvax the size of real numbers on vax is 4 bytes ( = the size of integer)
235 cdsw lpml - first free place in real constants
236 cdsw in the future - (lpmem+1) = 0.0, (lpmem+2) = 1.0
237 lpml = lpmem + WORDS_IN_REAL
240 C THE FIRST REAL CONSTANT IS 0.0
248 IMPLICIT INTEGER (A-Z)
249 cdsw INTEGER DATAHEX1,DATAHEX2,DATAHEX3
250 cdsw DATA DATAHEX1,DATAHEX2,DATAHEX3 /Z802F,Z0000,ZFFFF/
253 C INITIATES THE BLANK COMMON
255 DIMENSION X(169),Y(169)
258 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
259 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
260 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
261 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
262 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
263 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
264 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
265 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
266 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
267 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
268 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
269 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
270 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
271 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
272 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
273 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
274 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
275 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
278 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
279 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
280 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
281 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
282 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
283 M WRITE, WRITELN, WBOUND, UNICAL,
285 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
286 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
287 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
288 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
289 S HASH(8000), M, NAME(10), NLAST, NL,
291 U TRANS1(13,13), TRANS2(13,13), B0, B(70),
292 V SKOK0, SKOK(70), KK, MM, STAN, STAN1,
293 W AUX, K1, SY, SY1, NU, JK1, EXP,
294 X SIGN, INTPART, FRAC, OKEY, FRACT,JK2,NB,
295 Y TL, BYTE, TEXT(20),
296 Z TOP, IN, NEXT, STACK(500)
301 EQUIVALENCE (TRANS1(1,1),X(1))
302 EQUIVALENCE (TRANS2(1,1),Y(1))
304 C DATA M,HASH,NAME,NLAST,NL /1009,3000*0,10*0,3001,10/
305 c #8027 zmienione na #002F - w zapisie uzupelnieniowym
308 c #ffff zmienione na -#0001
318 C DATA TRANS2 /1,3,5,8,3,10,10,16,18,1,10,10,20,2,1,1,8,1,14,14,16,
320 C ,1,14,1,20,1,3,1,9,11,14,14,16,18,1,14,14,20,1,3,6,8,12,14,14,16,
321 C ,18,1,14,14,20,1,4,7,8,4,15,15,16,18,1,14,14,20,1,3,1,8,13,14,14,16
322 C ,,18,1,14,14,20,1,4,7,8,4,15,15,16,18,1,14,14,20,1,3,7,8,3,14,14,16
323 C ,,18,1,14,14,20,1,3,6,10,3,14,14,16,18,1,14,14,20,1,3,1,8,3,14,14,
325 C ,18,1,14,14,20,7*1,17,14*1,19,15*1,21/
326 C DATA TRANS1 /1,1,9,5*1,16,17,1,1,1,2,4,4,2,4,2,2,2,16,17,2,4,2,1,5
327 C ,,10,1,1,5,5,5,16,17,5,5,5,1,7,11,7,1,7,7,7,16,17,7,7,7,1,5,12,7,5,
328 C ,15,1,7,16,17,7,7,7,1,6,13,7,1,6,6,6,16,17,6,6,6,1,6,12,7,6,15,1,7,
329 C ,16,17,7,7,7,1,7,12,7,7,7,7,7,16,17,7,7,7,1,8,11,1,8,8,8,8,16,17,8,
330 C ,8,8,1,6,14,6,6,6,6,6,16,17,6,6,6,7*3,1,3,3,3,3,3,8*1,17,1,1,1,1,
332 C DATA B0,B/10*2,4*1,4,21*1,0,0,3,6,5,10,10,7,12,10,11,8*10,9,3*10,
334 C DATA SKOK0,SKOK /47*6,1,2,3,4,4,5,18*6/
356 C DATA S,ADRES,STAN,K,SY,AUX,EXP,SIGN,INTPART,FRAC /10*0/
367 C DATA OKEY,NU /.FALSE.,0.0/
444 C DATA BYTE,TL,NB,TEXT /64,20,2,20*0/
482 IMPLICIT INTEGER (A-Z)
483 DIMENSION X(169),Y(169)
486 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
487 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
488 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
489 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
490 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
491 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
492 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
493 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
494 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
495 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
496 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
497 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
498 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
499 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
500 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
501 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
502 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
503 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
506 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
507 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
508 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
509 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
510 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
511 M WRITE, WRITELN, WBOUND, UNICAL,
513 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
514 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
515 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
516 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
517 S HASH(8000), M, NAME(10), NLAST, NL,
519 U TRANS1(13,13), TRANS2(13,13), B0, B(70),
520 V SKOK0, SKOK(70), KK, MM, STAN, STAN1,
521 W AUX, K1, SY, SY1, NU, JK1, EXP,
522 X SIGN, INTPART, FRAC, OKEY, FRACT,JK2,NB,
523 Y TL, BYTE, TEXT(20),
524 Z TOP, IN, NEXT, STACK(500)
529 EQUIVALENCE(TRANS1(1,1),X(1))
530 EQUIVALENCE(TRANS2(1,1),Y(1))
808 IMPLICIT INTEGER (A-Z)
809 C --- READS INPUT PARAMETERS; APPROPRIATELY MODIFIES OPTION WORD
812 O S, ADRES, K, SCOMA, SDOT, SEMICOL,
813 1 SCOLON, SLEFT, SRIGHT, SBECOME, STAR, SRELAT,
814 2 SEOF, SIDENT, SCONST, SAND, SARRAY, SARROF,
815 3 SATTACH, SBEGIN, SBLOCK, SBOOL, SCALL, SCASE,
816 4 SCLASS, SCLOSE, SCONS, SCOPY, SCOROUT, SDETACH,
817 5 SDIM, SDO, SDOWN, SELSE, SEND, SESAC,
818 6 SEXIT, SEXTERN, SFI, SFOR, SFUNCT, SIF,
819 7 SINNER, SINPUT, SINT, SKILL, SLOCK, SNEW,
820 8 SNONE, SNOT, SOD, SOR, SORIF, SOTHER,
821 9 SOUTPUT, SPREF, SPRCD, SQUA, SREAD, SRESUME,
822 O SRETURN, STEP, STOP, STAKEN, STHEN, STHIS,
823 A STO, STYPE, SUNIT, SVAR, SVIRTUAL, SWAIT,
824 B SWHEN, SWHILE, SWRIT, SWRITLN, STRUE, SALL,
825 C WAND, WARRAY, WASSIGN, WASSCON, WATTACH, WBLOCK,
826 D WCALL, WCASE, WCASEL, WCOMA, WCNSTB, WCNSTC,
827 E WCNSTI, WCNSTN, WCNSTR, WCNST, WCOPY, WDETACH,
828 F WDOT, WDOWNTO, WEOF, WESAC, WFIN, WFIRST,
829 G WFOREND, WFORVAR, WFROM, WIDENT, WIFFALS, WIFTRUE
832 H WINNER, WINSTREND,WJUMP, WKILL, WLABEL, WLEFT,
833 I WLOCK, WLOW, WLSE, WNEW, WNEWARRAY,WNOT,
834 J WOPERAT, WOPT, WOR, WOTHER, WPREF, WPRIM,
835 K WQUA, WREAD, WRELAT, WRESUME, WRETURN, WRIGHT,
836 L WSTART, WSTEP, WSTOP, WTHIS, WTO, WAIT,
837 M WRITE, WRITELN, WBOUND, UNICAL,
839 O LMEM, LPMEM, IRECN, ISFIN, LPMSYS, LPML,
840 P LPMF, NRINT, NRRE, NRBOOL, NRCHAR, NRCOR,
841 Q NRPROC, NRTEXT, NRUNIV, NATTR, NRNONE, NBLSYS,
842 R NBLUS, NEMPTY, INSYS, LOCAL, OWN, OBJECT,
843 S HASH(8000), M, NAME(10), NLAST, NL,
845 U TRANS1(13,13), TRANS2(13,13), B0, B(70),
846 V SKOK0, SKOK(70), KK, MM, STAN, STAN1,
847 W AUX, K1, SY, SY1, NU, EXP,
848 X SIGN, INTPART, FRAC, OKEY, FRACT, NB,
849 Y TL, BYTE, TEXT(20),
850 Z TOP, IN, NEXT, STACK(500)
856 common /par/ param(256),dl, pozopt
857 c param - line of program parameters
858 c dl - length of program parameters
859 c pozopt - options position in param
863 if(pozopt .gt.dl .or. dl .eq. 0) go to 1000
866 if(param(pozopt).ne.' ') go to 102
869 102 if ( ext .eq. 1) go to 105
871 if(param(pozopt).eq.';') go to 9999
872 if(param(pozopt) .ne.',') go to 105
876 do 103 k = pozopt, dl
877 if(i.ge.70) go to 107
879 103 skok(i) = ichar(param(k))
889 cps * ' Specify compilation options : (default = D-S-L-O+T+M+I+)'$)
898 10 znak = iand(X'ff', skok(k))
900 IF (ZNAK.EQ.ICHAR(' ')) GO TO 10
901 IF (ZNAK.EQ.ICHAR(',')) GO TO 10
902 IF (ZNAK.EQ.0) GOTO 9999
904 20 sign = iand(X'ff', skok(k))
906 IF (SIGN.EQ.ICHAR(' ')) GOTO 20
907 IF (SIGN.EQ.ICHAR('+')) GOTO 30
908 IF (SIGN.EQ.ICHAR('-')) GOTO 30
910 29 call ffputcs(0,' Bad option - ignored')
913 30 IF (ZNAK.GT.ICHAR('Z')) ZNAK = ZNAK-32
914 C IF (ZNAK.EQ.ICHAR('C')) GOTO 670
915 IF (ZNAK.EQ.ICHAR('D')) GOTO 680
916 C IF (ZNAK.EQ.ICHAR('F')) GOTO 700
917 cdsw IF (ZNAK.EQ.ICHAR('I')) GOTO 730
918 IF (ZNAK.EQ.ICHAR('L')) GOTO 760
919 cdsw IF (ZNAK.EQ.ICHAR('M')) GOTO 770
920 IF (ZNAK.EQ.ICHAR('O')) GOTO 790
921 C --- IF (ZNAK.EQ.ICHAR('P')) GOTO 800
923 IF (ZNAK.EQ.ICHAR('S')) GOTO 830
925 IF (ZNAK.EQ.ICHAR('T')) GOTO 840
926 if (znak.eq.ichar('H')) go to 620
928 c opcja 'H' - duza pamiec
931 #if ! ( DISABLE_H == 1 )
932 if(sign.eq.ichar('+')) go to 625
933 c0m(4) = ibclr(c0m(4),12)
935 625 c0m(3) = ibset(c0m(3),12)
939 C ****** "ROZPOZNANO" MEANS "RECOGNIZED"
940 C 670 IF (SIGN.EQ.ICHAR('+')) GO TO 675
941 C C0M(4)=IBCLR(C0M(4),5)
943 C 675 C0M(3)=IBSET(C0M(3),5)
946 680 IF (SIGN.EQ.ICHAR('+')) GO TO 685
947 C0M(4)=IBCLR(C0M(4),4)
949 685 C0M(3)=IBSET(C0M(3),4)
952 C 700 IF (SIGN.EQ.ICHAR('+')) GOTO 705
953 C C0M(4)=IBCLR(C0M(4),6)
955 C 705 C0M(3)=IBSET(C0M(3),6)
958 C 730 IF (SIGN.EQ.ICHAR('+')) GOTO 735
959 C C0M(4)=IBCLR(C0M(4),2)
961 C 735 C0M(3)=IBSET(C0M(3),2)
964 760 IF (SIGN.EQ.ICHAR('+')) GOTO 765
965 C0M(4)=IBCLR(C0M(4),15)
967 765 C0M(3)=IBSET(C0M(3),15)
970 C 770 IF (SIGN.EQ.ICHAR('+')) GOTO 775
971 C C0M(4)=IBCLR(C0M(4),0)
973 C 775 C0M(3)=IBSET(C0M(3),0)
976 790 IF (SIGN.EQ.ICHAR('+')) GOTO 795
977 C0M(4)=IBCLR(C0M(4),1)
979 795 C0M(3)=IBSET(C0M(3),1)
982 C 800 IF (SIGN.EQ.ICHAR('+')) GOTO 805
983 C C0M(4)=IBCLR(C0M(4),14)
985 C 805 C0M(3)=IBSET(C0M(3),14)
989 830 IF (SIGN.EQ.ICHAR('+')) GOTO 835
990 C0M(4)=IBCLR(C0M(4),13)
992 835 C0M(3)=IBSET(C0M(3),13)
996 840 IF (SIGN.EQ.ICHAR('+')) GOTO 845
997 C0M(4)=IBCLR(C0M(4),3)
999 845 C0M(3)=IBSET(C0M(3),3)
1001 9999 C0M(2)=IOR(C0M(3),IAND(C0M(4),C0M(2)))
1004 call ffputcs(0,' Pass One')
1012 C----------------DISPLAYS END-OF-PASS INFORMATION
1013 IMPLICIT INTEGER (A-Z)
1016 COMMON /MJLMSG/ IERC, MSG
1020 IF (IERC .EQ. 0) RETURN
1022 IF (IOP(1).LE.7) RETURN