1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
|
/* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* You may distribute under the terms of the GNU General Public License
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
* Revision 3.0.1.6 90/03/12 16:40:43 lwall
* patch13: did some ndir straightening up for Xenix
*
* Revision 3.0.1.5 90/02/28 17:52:28 lwall
* patch9: Configure now determines whether volatile is supported
* patch9: volatilized some more variables for super-optimizing compilers
* patch9: unused VREG symbol deleted
* patch9: perl can now start up other interpreters scripts
* patch9: you may now undef $/ to have no input record separator
* patch9: nested evals clobbered their longjmp environment
*
* Revision 3.0.1.4 89/12/21 20:07:35 lwall
* patch7: arranged for certain registers to be restored after longjmp()
* patch7: Configure now compiles a test program to figure out time.h fiasco
* patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
* patch7: memcpy() and memset() return void in __STDC__
* patch7: errno may now be a macro with an lvalue
* patch7: ANSI strerror() is now supported
* patch7: Xenix support for sys/ndir.h, cross compilation
*
* Revision 3.0.1.3 89/11/17 15:28:57 lwall
* patch5: byteorder now is a hex value
* patch5: Configure now looks for <time.h> including <sys/time.h>
*
* Revision 3.0.1.2 89/11/11 04:39:38 lwall
* patch2: Configure may now set -DDEBUGGING
* patch2: netinet/in.h needed sys/types.h some places
* patch2: more <sys/time.h> and <time.h> wrangling
* patch2: yydebug moved to where type doesn't matter
*
* Revision 3.0.1.1 89/10/26 23:17:08 lwall
* patch1: vfork now conditionally defined based on VFORK
* patch1: DEC risc machines have a buggy memcmp
* patch1: perl.h now includes <netinet/in.h> if it exists
*
* Revision 3.0 89/10/18 15:21:21 lwall
* 3.0 baseline
*
*/
#define VOIDUSED 1
#include "config.h"
#if defined(HASVOLATILE) || defined(__STDC__)
#define VOLATILE volatile
#else
#define VOLATILE
#endif
#ifdef IAMSUID
# ifndef TAINT
# define TAINT
# endif
#endif
#ifndef VFORK
# define vfork fork
#endif
#ifdef GETPGRP2
# ifndef GETPGRP
# define GETPGRP
# endif
# define getpgrp getpgrp2
#endif
#ifdef SETPGRP2
# ifndef SETPGRP
# define SETPGRP
# endif
# define setpgrp setpgrp2
#endif
#if defined(MEMCMP) && defined(mips) && BYTEORDER == 0x1234
#undef MEMCMP
#endif
#ifdef MEMCPY
#ifndef memcpy
#ifdef __STDC__
extern void *memcpy(), *memset();
#else
extern char *memcpy(), *memset();
#endif
#endif
#define bcopy(s1,s2,l) memcpy(s2,s1,l)
#define bzero(s,l) memset(s,0,l)
#endif
#ifndef BCMP /* prefer bcmp slightly 'cuz it doesn't order */
#define bcmp(s1,s2,l) memcmp(s1,s2,l)
#endif
#include <stdio.h>
#include <ctype.h>
#include <setjmp.h>
#include <sys/param.h> /* if this needs types.h we're still wrong */
#ifndef _TYPES_ /* If types.h defines this it's easy. */
#ifndef major /* Does everyone's types.h define this? */
#include <sys/types.h>
#endif
#endif
#ifdef I_NETINET_IN
#include <netinet/in.h>
#endif
#include <sys/stat.h>
#ifdef I_TIME
# include <time.h>
#endif
#ifdef I_SYSTIME
# ifdef SYSTIMEKERNEL
# define KERNEL
# endif
# include <sys/time.h>
# ifdef SYSTIMEKERNEL
# undef KERNEL
# endif
#endif
#include <sys/times.h>
#if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR))
#undef STRERROR
#endif
#include <errno.h>
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
#ifdef STRERROR
char *strerror();
#else
extern int sys_nerr;
extern char *sys_errlist[];
#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
#endif
#ifdef I_SYSIOCTL
#ifndef _IOCTL_
#include <sys/ioctl.h>
#endif
#endif
#if defined(mc300) || defined(mc500) || defined(mc700) /* MASSCOMP */
#ifdef SOCKETPAIR
#undef SOCKETPAIR
#endif
#ifdef NDBM
#undef NDBM
#endif
#endif
#ifdef NDBM
#include <ndbm.h>
#define SOME_DBM
#ifdef ODBM
#undef ODBM
#endif
#else
#ifdef ODBM
#ifdef NULL
#undef NULL /* suppress redefinition message */
#endif
#include <dbm.h>
#ifdef NULL
#undef NULL
#endif
#define NULL 0 /* silly thing is, we don't even use this */
#define SOME_DBM
#define dbm_fetch(db,dkey) fetch(dkey)
#define dbm_delete(db,dkey) delete(dkey)
#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
#define dbm_close(db) dbmclose()
#define dbm_firstkey(db) firstkey()
#endif /* ODBM */
#endif /* NDBM */
#ifdef SOME_DBM
EXT char *dbmkey;
EXT int dbmlen;
#endif
#if INTSIZE == 2
#define htoni htons
#define ntohi ntohs
#else
#define htoni htonl
#define ntohi ntohl
#endif
#if defined(I_DIRENT) && !defined(M_XENIX)
# include <dirent.h>
# define DIRENT dirent
#else
# ifdef I_SYSNDIR
# include <sys/ndir.h>
# define DIRENT direct
# else
# ifdef I_SYSDIR
# ifdef hp9000s500
# include <ndir.h> /* may be wrong in the future */
# else
# include <sys/dir.h>
# endif
# define DIRENT direct
# endif
# endif
#endif
typedef struct arg ARG;
typedef struct cmd CMD;
typedef struct formcmd FCMD;
typedef struct scanpat SPAT;
typedef struct stio STIO;
typedef struct sub SUBR;
typedef struct string STR;
typedef struct atbl ARRAY;
typedef struct htbl HASH;
typedef struct regexp REGEXP;
typedef struct stabptrs STBP;
typedef struct stab STAB;
#include "handy.h"
#include "regexp.h"
#include "str.h"
#include "util.h"
#include "form.h"
#include "stab.h"
#include "spat.h"
#include "arg.h"
#include "cmd.h"
#include "array.h"
#include "hash.h"
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
#ifndef __STDC__
#ifdef CHARSPRINTF
char *sprintf();
#else
int sprintf();
#endif
#endif
EXT char *Yes INIT("1");
EXT char *No INIT("");
/* "gimme" values */
/* Note: cmd.c assumes that it can use && to produce one of these values! */
#define G_SCALAR 0
#define G_ARRAY 1
#ifdef CRIPPLED_CC
int str_true();
#else /* !CRIPPLED_CC */
#define str_true(str) (Str = (str), \
(Str->str_pok ? \
((*Str->str_ptr > '0' || \
Str->str_cur > 1 || \
(Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
: \
(Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
#endif /* CRIPPLED_CC */
#ifdef DEBUGGING
#define str_peek(str) (Str = (str), \
(Str->str_pok ? \
Str->str_ptr : \
(Str->str_nok ? \
(sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
(char*)tokenbuf) : \
"" )))
#endif
#ifdef CRIPPLED_CC
char *str_get();
#else
#ifdef TAINT
#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
(Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
#else
#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
#endif /* TAINT */
#endif /* CRIPPLED_CC */
#ifdef CRIPPLED_CC
double str_gnum();
#else /* !CRIPPLED_CC */
#ifdef TAINT
#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
(Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
#else /* !TAINT */
#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
#endif /* TAINT*/
#endif /* CRIPPLED_CC */
EXT STR *Str;
#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
#ifndef BYTEORDER
#define BYTEORDER 0x1234
#endif
#if defined(htonl) && !defined(HTONL)
#define HTONL
#endif
#if defined(htons) && !defined(HTONS)
#define HTONS
#endif
#if defined(ntohl) && !defined(NTOHL)
#define NTOHL
#endif
#if defined(ntohs) && !defined(NTOHS)
#define NTOHS
#endif
#ifndef HTONL
#if (BYTEORDER != 0x4321) && (BYTEORDER != 0x87654321)
#define HTONS
#define HTONL
#define NTOHS
#define NTOHL
#define MYSWAP
#define htons my_swap
#define htonl my_htonl
#define ntohs my_swap
#define ntohl my_ntohl
#endif
#else
#if (BYTEORDER == 0x4321) || (BYTEORDER == 0x87654321)
#undef HTONS
#undef HTONL
#undef NTOHS
#undef NTOHL
#endif
#endif
CMD *add_label();
CMD *block_head();
CMD *append_line();
CMD *make_acmd();
CMD *make_ccmd();
CMD *make_icmd();
CMD *invert();
CMD *addcond();
CMD *addloop();
CMD *wopt();
CMD *over();
STAB *stabent();
STAB *genstab();
ARG *stab2arg();
ARG *op_new();
ARG *make_op();
ARG *make_match();
ARG *make_split();
ARG *rcatmaybe();
ARG *listish();
ARG *maybelistish();
ARG *localize();
ARG *fixeval();
ARG *jmaybe();
ARG *l();
ARG *fixl();
ARG *mod_match();
ARG *make_list();
ARG *cmd_to_arg();
ARG *addflags();
ARG *hide_ary();
ARG *cval_to_arg();
STR *str_new();
STR *stab_str();
int do_each();
int do_subr();
int do_match();
int do_unpack();
int eval(); /* this evaluates expressions */
int do_eval(); /* this evaluates eval operator */
int do_assign();
SUBR *make_sub();
FCMD *load_format();
char *scanpat();
char *scansubst();
char *scantrans();
char *scanstr();
char *scanreg();
char *str_append_till();
char *str_gets();
char *str_grow();
bool do_open();
bool do_close();
bool do_print();
bool do_aprint();
bool do_exec();
bool do_aexec();
int do_subst();
int cando();
int ingroup();
void str_replace();
void str_inc();
void str_dec();
void str_free();
void stab_clear();
void do_join();
void do_sprintf();
void do_accept();
void do_pipe();
void do_vecset();
void savelist();
void saveitem();
void saveint();
void savelong();
void savesptr();
void savehptr();
void restorelist();
void repeatcpy();
HASH *savehash();
ARRAY *saveary();
EXT char **origargv;
EXT int origargc;
EXT line_t line INIT(0);
EXT line_t subline INIT(0);
EXT STR *subname INIT(Nullstr);
EXT int arybase INIT(0);
struct outrec {
line_t o_lines;
char *o_str;
int o_len;
};
EXT struct outrec outrec;
EXT struct outrec toprec;
EXT STAB *stdinstab INIT(Nullstab);
EXT STAB *last_in_stab INIT(Nullstab);
EXT STAB *defstab INIT(Nullstab);
EXT STAB *argvstab INIT(Nullstab);
EXT STAB *envstab INIT(Nullstab);
EXT STAB *sigstab INIT(Nullstab);
EXT STAB *defoutstab INIT(Nullstab);
EXT STAB *curoutstab INIT(Nullstab);
EXT STAB *argvoutstab INIT(Nullstab);
EXT STAB *incstab INIT(Nullstab);
EXT STAB *leftstab INIT(Nullstab);
EXT STAB *amperstab INIT(Nullstab);
EXT STAB *rightstab INIT(Nullstab);
EXT STAB *DBstab INIT(Nullstab);
EXT STAB *DBsub INIT(Nullstab);
EXT HASH *defstash; /* main symbol table */
EXT HASH *curstash; /* symbol table for current package */
EXT HASH *debstash; /* symbol table for perldb package */
EXT STR *curstname; /* name of current package */
EXT STR *freestrroot INIT(Nullstr);
EXT STR *lastretstr INIT(Nullstr);
EXT STR *DBsingle INIT(Nullstr);
EXT int lastspbase;
EXT int lastsize;
EXT char *filename;
EXT char *origfilename;
EXT FILE * VOLATILE rsfp;
EXT char buf[1024];
EXT char *bufptr;
EXT char *oldbufptr;
EXT char *oldoldbufptr;
EXT char *bufend;
EXT STR *linestr INIT(Nullstr);
EXT int record_separator INIT('\n');
EXT int rslen INIT(1);
EXT char *ofs INIT(Nullch);
EXT int ofslen INIT(0);
EXT char *ors INIT(Nullch);
EXT int orslen INIT(0);
EXT char *ofmt INIT(Nullch);
EXT char *inplace INIT(Nullch);
EXT char *nointrp INIT("");
EXT bool preprocess INIT(FALSE);
EXT bool minus_n INIT(FALSE);
EXT bool minus_p INIT(FALSE);
EXT bool minus_a INIT(FALSE);
EXT bool doswitches INIT(FALSE);
EXT bool dowarn INIT(FALSE);
EXT bool allstabs INIT(FALSE); /* init all customary symbols in symbol table?*/
EXT bool sawampersand INIT(FALSE); /* must save all match strings */
EXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
EXT bool sawvec INIT(FALSE);
EXT bool localizing INIT(FALSE); /* are we processing a local() list? */
#ifdef CSH
char *cshname INIT(CSH);
int cshlen INIT(0);
#endif /* CSH */
#ifdef TAINT
EXT bool tainted INIT(FALSE); /* using variables controlled by $< */
#endif
#define TMPPATH "/tmp/perl-eXXXXXX"
EXT char *e_tmpname;
EXT FILE *e_fp INIT(Nullfp);
EXT char tokenbuf[256];
EXT int expectterm INIT(TRUE); /* how to interpret ambiguous tokens */
EXT VOLATILE int in_eval INIT(FALSE); /* trap fatal errors? */
EXT int multiline INIT(0); /* $*--do strings hold >1 line? */
EXT int forkprocess; /* so do_open |- can return proc# */
EXT int do_undump INIT(0); /* -u or dump seen? */
EXT int error_count INIT(0); /* how many errors so far, max 10 */
EXT int multi_start INIT(0); /* 1st line of multi-line string */
EXT int multi_end INIT(0); /* last line of multi-line string */
EXT int multi_open INIT(0); /* delimiter of said string */
EXT int multi_close INIT(0); /* delimiter of said string */
FILE *popen();
/* char *str_get(); */
STR *interp();
void free_arg();
STIO *stio_new();
EXT struct stat statbuf;
EXT struct stat statcache;
STAB *statstab INIT(Nullstab);
STR *statname;
EXT struct tms timesbuf;
EXT int uid;
EXT int euid;
EXT int gid;
EXT int egid;
UIDTYPE getuid();
UIDTYPE geteuid();
GIDTYPE getgid();
GIDTYPE getegid();
EXT int unsafe;
#ifdef DEBUGGING
EXT VOLATILE int debug INIT(0);
EXT int dlevel INIT(0);
EXT int dlmax INIT(128);
EXT char *debname;
EXT char *debdelim;
#define YYDEBUG 1
#endif
EXT int perldb INIT(0);
EXT line_t cmdline INIT(NOLINE);
EXT STR str_undef;
EXT STR str_no;
EXT STR str_yes;
/* runtime control stuff */
EXT struct loop {
char *loop_label; /* what the loop was called, if anything */
int loop_sp; /* stack pointer to copy stuff down to */
jmp_buf loop_env;
} *loop_stack;
EXT int loop_ptr INIT(-1);
EXT int loop_max INIT(128);
EXT jmp_buf top_env;
EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
EXT ARRAY *stack; /* THE STACK */
EXT ARRAY * VOLATILE savestack; /* to save non-local values on */
EXT ARRAY *tosave; /* strings to save on recursive subroutine */
EXT ARRAY *lineary; /* lines of script for debugger */
EXT ARRAY *pidstatary; /* keep pids and statuses by fd for mypopen */
EXT int *di; /* for tmp use in debuggers */
EXT char *dc;
EXT short *ds;
double atof();
long time();
struct tm *gmtime(), *localtime();
char *mktemp();
char *index(), *rindex();
char *strcpy(), *strcat();
#ifdef EUNICE
#define UNLINK unlnk
int unlnk();
#else
#define UNLINK unlink
#endif
#ifndef SETREUID
#ifdef SETRESUID
#define setreuid(r,e) setresuid(r,e,-1)
#define SETREUID
#endif
#endif
#ifndef SETREGID
#ifdef SETRESGID
#define setregid(r,e) setresgid(r,e,-1)
#define SETREGID
#endif
#endif
|