1 /* { dg-do compile } */
2 /* { dg-additional-options "-fpic -std=c99" } */
3
4 typedef unsigned int size_t;
5 typedef struct
6 {
7 unsigned long __val[(1024 / (8 * sizeof (unsigned long)))];
8 } __sigset_t;
9 struct __jmp_buf_tag
10 {
11 __sigset_t __saved_mask;
12 };
13 typedef struct __jmp_buf_tag sigjmp_buf[1];
14 struct stat
15 {
16 long long st_dev;
17 unsigned short int __pad1;
18 int tm_isdst;
19 long int tm_gmtoff;
20 char *tm_zone;
21 };
22
23 typedef size_t STRLEN;
24 typedef struct op OP;
25 typedef struct cop COP;
26 typedef struct interpreter PerlInterpreter;
27 typedef struct sv SV;
28 typedef struct av AV;
29 typedef struct cv CV;
30 typedef struct gp GP;
31 typedef struct gv GV;
32 typedef struct xpv XPV;
33 typedef struct xpvio XPVIO;
34 typedef union any ANY;
35 typedef unsigned char U8;
36 typedef long I32;
37 typedef unsigned long U32;
38 typedef U32 line_t;
39 typedef struct _PerlIO PerlIOl;
40 typedef PerlIOl *PerlIO;
41 struct sv
42 {
43 void *sv_any;
44 U32 sv_flags;
45 union
46 {
47 char *svu_pv;
48 } sv_u;
49 };
50 struct gv
51 {
52 U32 sv_flags;
53 union
54 {
55 GP *svu_gp;
56 } sv_u;
57 };
58 struct io
59 {
60 XPVIO *sv_any;
61 };
62 struct xpv
63 {
64 STRLEN xpv_cur;
65 };
66 struct xpvio
67 {
68 PerlIO *xio_ofp;
69 };
70 struct gp
71 {
72 SV *gp_sv;
73 struct io *gp_io;
74 };
75 struct jmpenv
76 {
77 struct jmpenv *je_prev;
78 sigjmp_buf je_buf;
79 int je_ret;
80 };
81 typedef struct jmpenv JMPENV;
82 struct cop
83 {
84 line_t cop_line;
85 struct refcounted_he *cop_hints_hash;
86 };
87 struct interpreter
88 {
89 SV **Istack_sp;
90 OP *Iop;
91 SV **Icurpad;
92 SV **Istack_base;
93 SV **Istack_max;
94 I32 *Iscopestack;
95 I32 Iscopestack_ix;
96 I32 Iscopestack_max;
97 ANY *Isavestack;
98 I32 Isavestack_ix;
99 I32 Isavestack_max;
100 SV **Itmps_stack;
101 I32 Itmps_ix;
102 I32 Itmps_floor;
103 I32 Itmps_max;
104 I32 Imodcount;
105 I32 *Imarkstack;
106 I32 *Imarkstack_ptr;
107 I32 *Imarkstack_max;
108 SV *ISv;
109 XPV *IXpv;
110 STRLEN Ina;
111 struct stat Istatbuf;
112 struct stat Istatcache;
113 OP *Irestartop;
114 COP *volatile Icurcop;
115 JMPENV *Itop_env;
116 U8 Iexit_flags;
117 I32 Istatusvalue;
118 I32 Istatusvalue_posix;
119 GV *Istderrgv;
120 GV *Ierrgv;
121 AV *Ibeginav;
122 AV *Iunitcheckav;
123 COP Icompiling;
124 char Isavebegin;
125 volatile U32 Idebug;
126 AV *Ibeginav_save;
127 AV *Icheckav_save;
128 AV *Iunitcheckav_save;
129 };
130
131 void S_my_exit_jump (PerlInterpreter *my_perl __attribute__((unused)))
132 __attribute__((noreturn));
133
134 int Perl_av_len (PerlInterpreter*, AV*);
135 void Perl_av_create_and_push (PerlInterpreter*, AV**, SV*);
136 int __sigsetjmp (sigjmp_buf env, int savemask);
137 void Perl_sv_2pv_flags (PerlInterpreter*, SV*, STRLEN*, int);
138 void Perl_deb (PerlInterpreter*,
139 const char*, const char*, int, const char*, int);
140 void Perl_croak (PerlInterpreter*, const char*, void*);
141 void foo (void);
142
143 void
Perl_call_list(PerlInterpreter * my_perl,I32 oldscope,AV * paramList)144 Perl_call_list (PerlInterpreter *my_perl __attribute__((unused)),
145 I32 oldscope, AV *paramList)
146 {
147 SV *atsv;
148 CV *cv;
149 STRLEN len;
150 int ret;
151 JMPENV cur_env;
152 GV *shplep;
153 volatile line_t oldline;
154
155 oldline = (my_perl->Icurcop) ? my_perl->Icurcop->cop_line : 0;
156
157 while (Perl_av_len (my_perl, paramList) >= 0)
158 {
159 if (my_perl->Isavebegin)
160 {
161 if (paramList == my_perl->Ibeginav)
162 {
163 Perl_av_create_and_push (my_perl, &my_perl->Ibeginav_save,
164 (SV*) cv);
165 Perl_av_create_and_push(my_perl, &my_perl->Icheckav_save,
166 (SV*) cv);
167 }
168 else if (paramList == my_perl->Iunitcheckav)
169 Perl_av_create_and_push(my_perl, &my_perl->Iunitcheckav_save,
170 (SV*) cv);
171 }
172
173 cur_env.je_ret = __sigsetjmp (cur_env.je_buf, 0);
174
175 switch (ret)
176 {
177 case 0:
178 shplep = (GV *) my_perl->Ierrgv;
179 *my_perl->Imarkstack_ptr = my_perl->Istack_sp - my_perl->Istack_base;
180 atsv = shplep->sv_u.svu_gp->gp_sv;
181 if (atsv->sv_flags & 0x00000400 == 0x00000400)
182 len = ((XPV*) ((SV *) atsv)->sv_any)->xpv_cur;
183 else
184 Perl_sv_2pv_flags (my_perl, atsv, &len, 2|32);
185
186 if (len)
187 {
188 my_perl->Icurcop = &my_perl->Icompiling;
189 while (my_perl->Iscopestack_ix > oldscope)
190 {
191 if (my_perl->Idebug & 0x00000004)
192 Perl_deb (my_perl, "scope", "LEAVE",
193 my_perl->Iscopestack_ix, "perl.c", 5166);
194 (my_perl->Itop_env) = cur_env.je_prev;
195 }
196
197 Perl_croak (my_perl, "%""-p""", (void*) atsv);
198 }
199
200 case 1:
201 my_perl->Istatusvalue = 1;
202 my_perl->Istatusvalue_posix = 1;
203 case 2:
204 while (my_perl->Iscopestack_ix > oldscope)
205 if (my_perl->Idebug & 0x00000004)
206 foo ();
207 my_perl->Icurcop = &my_perl->Icompiling;
208 my_perl->Icurcop->cop_line = oldline;
209 if (my_perl->Idebug & 0x00000004)
210 foo ();
211 S_my_exit_jump (my_perl);
212 case 3:
213 if (my_perl->Irestartop)
214 foo ();
215 }
216 }
217 }
218