xref: /csrg-svn/usr.bin/pascal/src/subr.c (revision 1836)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static	char sccsid[] = "@(#)subr.c 1.3 11/24/80";
4 
5 #include "whoami.h"
6 #include "0.h"
7 
8 #ifndef PI1
9 /*
10  * Does the string fp end in '.' and the character c ?
11  */
12 dotted(fp, c)
13 	register char *fp;
14 	char c;
15 {
16 	register int i;
17 
18 	i = strlen(fp);
19 	return (i > 1 && fp[i - 2] == '.' && fp[i - 1] == c);
20 }
21 
22 /*
23  * Toggle the option c.
24  */
25 togopt(c)
26 	char c;
27 {
28 	register char *tp;
29 
30 	tp = &opt( c );
31 	*tp = 1 - *tp;
32 }
33 
34 /*
35  * Set the time vector "tvec" to the
36  * modification time stamp of a file.
37  */
38 gettime( filename )
39     char *filename;
40 {
41 #include <stat.h>
42 	struct stat stb;
43 
44 	stat(filename, &stb);
45 	tvec = stb.st_mtime;
46 }
47 
48 /*
49  * Convert a "ctime" into a Pascal styple time line
50  */
51 char *
52 myctime(tv)
53 	int *tv;
54 {
55 	register char *cp, *dp;
56 	char *cpp;
57 	register i;
58 	static char mycbuf[26];
59 
60 	cpp = ctime(tv);
61 	dp = mycbuf;
62 	cp = cpp;
63 	cpp[16] = 0;
64 	while (*dp++ = *cp++);
65 	dp--;
66 	cp = cpp+19;
67 	cpp[24] = 0;
68 	while (*dp++ = *cp++);
69 	return (mycbuf);
70 }
71 
72 /*
73  * Is "fp" in the command line list of names ?
74  */
75 inpflist(fp)
76 	char *fp;
77 {
78 	register i, *pfp;
79 
80 	pfp = pflist;
81 	for (i = pflstc; i > 0; i--)
82 		if (strcmp(fp, *pfp++) == 0)
83 			return (1);
84 	return (0);
85 }
86 #endif
87 
88 extern	int errno;
89 extern	char *sys_errlist[];
90 
91 /*
92  * Boom!
93  */
94 Perror(file, error)
95 	char *file, *error;
96 {
97 
98 	write(2, file, strlen(file));
99 	write(2, ": ", 2);
100 	write(2, error, strlen(error));
101 	write(2, "\n", 1);
102 /*
103 	errno = 0;
104 	sys_errlist[0] = error;
105 	perror(file);
106 */
107 }
108 
109 int *
110 calloc(num, size)
111 	int num, size;
112 {
113 	register int p1, *p2, nbyte;
114 
115 	nbyte = (num*size+( ( sizeof ( int ) ) - 1 ) ) & ~( ( sizeof ( int ) ) - 1 );
116 	if ((p1 = malloc(nbyte)) == 0)
117 		return (0);
118 	p2 = p1;
119 	nbyte /= sizeof ( int );
120 	do {
121 		*p2++ = 0;
122 	} while (--nbyte);
123 	return (p1);
124 }
125 
126 /*
127  * Compare strings:  s1>s2: >0  s1==s2: 0  s1<s2: <0
128  */
129 strcmp(s1, s2)
130 	register char *s1, *s2;
131 {
132 
133 	while (*s1 == *s2++)
134 		if (*s1++=='\0')
135 			return (0);
136 	return (*s1 - *--s2);
137 }
138 
139 /*
140  * Copy string s2 to s1.
141  * S1 must be large enough.
142  * Return s1.
143  */
144 strcpy(s1, s2)
145 	register char *s1, *s2;
146 {
147 	register os1;
148 
149 	os1 = s1;
150 	while (*s1++ = *s2++)
151 		continue;
152 	return (os1);
153 }
154 
155 /*
156  * Strlen is currently a freebie of perror
157  * Take the length of a string.
158  * Note that this does not include the trailing null!
159 strlen(cp)
160 	register char *cp;
161 {
162 	register int i;
163 
164 	for (i = 0; *cp != 0; cp++)
165 		i++;
166 	return (i);
167 }
168  */
169 copy(to, from, bytes)
170 	register char *to, *from;
171 	register int bytes;
172 {
173 
174 	if (bytes != 0)
175 		do
176 			*to++ = *from++;
177 		while (--bytes);
178 }
179 
180 /*
181  * Is ch one of the characters in the string cp ?
182  */
183 any(cp, ch)
184 	register char *cp;
185 	char ch;
186 {
187 
188 	while (*cp)
189 		if (*cp++ == ch)
190 			return (1);
191 	return (0);
192 }
193 
194 opush(c)
195 	register CHAR c;
196 {
197 
198 	c -= 'A';
199 	optstk[c] <<= 1;
200 	optstk[c] |= opts[c];
201 	opts[c] = 1;
202 #ifdef PI0
203 	send(ROPUSH, c);
204 #endif
205 }
206 
207 opop(c)
208 	register CHAR c;
209 {
210 
211 	c -= 'A';
212 	opts[c] = optstk[c] & 1;
213 	optstk[c] >>= 1;
214 #ifdef PI0
215 	send(ROPOP, c);
216 #endif
217 }
218