From c750a3ec3b866067ab46dbcc9083205d823047c3 Mon Sep 17 00:00:00 2001 From: Malcolm Beattie Date: Fri, 28 Mar 1997 13:32:21 +0000 Subject: [PATCH] Initial devel changes. Pseudo-hashes. Optional strong typing. RESTART {}. p4raw-id: //depot/perl@2 --- av.c | 170 ++++++++++++++++++ doop.c | 18 +- embed.h | 13 +- ext/DB_File/DB_File.xs | 2 +- global.sym | 9 + interp.sym | 1 + keywords.h | 459 +++++++++++++++++++++++++------------------------ keywords.pl | 1 + lib/ExtUtils/xsubpp | 7 +- op.c | 60 +++++++ perl.c | 4 +- perl.h | 2 + pp.c | 40 +++-- pp_hot.c | 14 +- proto.h | 8 + t/op/groups.t | 8 +- toke.c | 16 ++ 17 files changed, 571 insertions(+), 261 deletions(-) diff --git a/av.c b/av.c index b27ec76..8e8e47a 100644 --- a/av.c +++ b/av.c @@ -463,3 +463,173 @@ I32 fill; else (void)av_store(av,fill,&sv_undef); } + +SV** +avhv_fetch(av, key, klen, lval) +AV *av; +char *key; +U32 klen; +I32 lval; +{ + SV **keys, **indsvp; + I32 ind; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + if (indsvp) { + ind = SvIV(*indsvp); + if (ind < 1) + croak("Bad index while coercing array into hash"); + } else { + if (!lval) + return 0; + + ind = AvFILL(av) + 1; + hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), 0); + } + return av_fetch(av, ind, lval); +} + +SV** +avhv_store(av, key, klen, val, hash) +AV *av; +char *key; +U32 klen; +SV *val; +U32 hash; +{ + SV **keys, **indsvp; + I32 ind; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + if (indsvp) { + ind = SvIV(*indsvp); + if (ind < 1) + croak("Bad index while coercing array into hash"); + } else { + ind = AvFILL(av) + 1; + hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), hash); + } + return av_store(av, ind, val); +} + +bool +avhv_exists(av, key, klen) +AV *av; +char *key; +U32 klen; +{ + SV **keys; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + return hv_exists((HV*)SvRV(*keys), key, klen); +} + +/* avhv_delete leaks. Caller can re-index and compress if so desired. */ +SV * +avhv_delete(av, key, klen, flags) +AV *av; +char *key; +U32 klen; +I32 flags; +{ + SV **keys; + SV *sv; + SV **svp; + I32 ind; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + sv = hv_delete((HV*)SvRV(*keys), key, klen, 0); + if (!sv) + return Nullsv; + ind = SvIV(sv); + if (ind < 1) + croak("Bad index while coercing array into hash"); + svp = av_fetch(av, ind, FALSE); + if (!svp) + return Nullsv; + if (flags & G_DISCARD) { + sv = Nullsv; + SvREFCNT_dec(*svp); + } else { + sv = sv_2mortal(*svp); + } + *svp = &sv_undef; + return sv; +} + +I32 +avhv_iterinit(av) +AV *av; +{ + SV **keys; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + return hv_iterinit((HV*)SvRV(*keys)); +} + +HE * +avhv_iternext(av) +AV *av; +{ + SV **keys; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + return hv_iternext((HV*)SvRV(*keys)); +} + +SV * +avhv_iterval(av, entry) +AV *av; +register HE *entry; +{ + SV **keys; + SV *sv; + I32 ind; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + sv = hv_iterval((HV*)SvRV(*keys), entry); + ind = SvIV(sv); + if (ind < 1) + croak("Bad index while coercing array into hash"); + return *av_fetch(av, ind, TRUE); +} + +SV * +avhv_iternextsv(av, key, retlen) +AV *av; +char **key; +I32 *retlen; +{ + SV **keys; + HE *he; + SV *sv; + I32 ind; + + keys = av_fetch(av, 0, FALSE); + if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) + croak("Can't coerce array into hash"); + if ( (he = hv_iternext((HV*)SvRV(*keys))) == NULL) + return NULL; + *key = hv_iterkey(he, retlen); + sv = hv_iterval((HV*)SvRV(*keys), he); + ind = SvIV(sv); + if (ind < 1) + croak("Bad index while coercing array into hash"); + return *av_fetch(av, ind, TRUE); +} diff --git a/doop.c b/doop.c index c906db7..9512533 100644 --- a/doop.c +++ b/doop.c @@ -628,15 +628,19 @@ dARGS SV *tmpstr; I32 dokeys = (op->op_type == OP_KEYS); I32 dovalues = (op->op_type == OP_VALUES); - + I32 realhv = (SvTYPE(hv) == SVt_PVHV); + if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) dokeys = dovalues = TRUE; if (!hv) RETURN; - (void)hv_iterinit(hv); /* always reset iterator regardless */ - + if (realhv) + (void)hv_iterinit(hv); /* always reset iterator regardless */ + else + (void)avhv_iterinit((AV*)hv); + if (GIMME != G_ARRAY) { dTARGET; @@ -645,7 +649,7 @@ dARGS else { i = 0; /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) { + while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) { i++; } } @@ -657,7 +661,7 @@ dARGS EXTEND(sp, HvMAX(hv) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ - while (entry = hv_iternext(hv)) { + while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) { SPAGAIN; if (dokeys) { tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */ @@ -668,7 +672,8 @@ dARGS if (dovalues) { tmpstr = NEWSV(45,0); PUTBACK; - sv_setsv(tmpstr,hv_iterval(hv,entry)); + sv_setsv(tmpstr,realhv ? + hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry)); SPAGAIN; DEBUG_H( { sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, @@ -681,4 +686,3 @@ dARGS } return NORMAL; } - diff --git a/embed.h b/embed.h index bfd73bd..572cc2c 100644 --- a/embed.h +++ b/embed.h @@ -78,6 +78,7 @@ #define hexdigit Perl_hexdigit #define hints Perl_hints #define in_my Perl_in_my +#define in_my_stash Perl_in_my_stash #define inc_amg Perl_inc_amg #define io_close Perl_io_close #define know_next Perl_know_next @@ -172,7 +173,7 @@ #define regeol Perl_regeol #define regfold Perl_regfold #define reginput Perl_reginput -#define regkind Perl_regkind +#define regkind Perl_regkind #define reglastparen Perl_reglastparen #define regmyendp Perl_regmyendp #define regmyp_size Perl_regmyp_size @@ -289,6 +290,14 @@ #define append_list Perl_append_list #define apply Perl_apply #define assertref Perl_assertref +#define avhv_delete Perl_avhv_delete +#define avhv_exists Perl_avhv_exists +#define avhv_fetch Perl_avhv_fetch +#define avhv_iterinit Perl_avhv_iterinit +#define avhv_iternext Perl_avhv_iternext +#define avhv_iternextsv Perl_avhv_iternextsv +#define avhv_iterval Perl_avhv_iterval +#define avhv_store Perl_avhv_store #define av_clear Perl_av_clear #define av_extend Perl_av_extend #define av_fake Perl_av_fake @@ -1193,6 +1202,7 @@ #define preambled (curinterp->Ipreambled) #define preambleav (curinterp->Ipreambleav) #define preprocess (curinterp->Ipreprocess) +#define restartav (curinterp->Irestartav) #define restartop (curinterp->Irestartop) #define rightgv (curinterp->Irightgv) #define rs (curinterp->Irs) @@ -1347,6 +1357,7 @@ #define Ipreambled preambled #define Ipreambleav preambleav #define Ipreprocess preprocess +#define Irestartav restartav #define Irestartop restartop #define Irightgv rightgv #define Irs rs diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index dd9e03d..fe967e6 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -718,7 +718,7 @@ db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH) RETVAL BOOT: - newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file); + newXS("DB_File::TIEARRAY", XS_DB_File_TIEHASH, file); int db_DESTROY(db) diff --git a/global.sym b/global.sym index 70d07c0..93bedba 100644 --- a/global.sym +++ b/global.sym @@ -65,6 +65,7 @@ gt_amg hexdigit hints in_my +in_my_stash inc_amg io_close know_next @@ -279,6 +280,14 @@ append_elem append_list apply assertref +avhv_delete +avhv_exists +avhv_fetch +avhv_iterinit +avhv_iternext +avhv_iternextsv +avhv_iterval +avhv_store av_clear av_extend av_fake diff --git a/interp.sym b/interp.sym index 801eb41..30e8562 100644 --- a/interp.sym +++ b/interp.sym @@ -111,6 +111,7 @@ pidstatus preambled preambleav preprocess +restartav restartop rightgv rs diff --git a/keywords.h b/keywords.h index 8cb2748..a6dabf3 100644 --- a/keywords.h +++ b/keywords.h @@ -14,232 +14,233 @@ #define KEY_LE 13 #define KEY_LT 14 #define KEY_NE 15 -#define KEY_abs 16 -#define KEY_accept 17 -#define KEY_alarm 18 -#define KEY_and 19 -#define KEY_atan2 20 -#define KEY_bind 21 -#define KEY_binmode 22 -#define KEY_bless 23 -#define KEY_caller 24 -#define KEY_chdir 25 -#define KEY_chmod 26 -#define KEY_chomp 27 -#define KEY_chop 28 -#define KEY_chown 29 -#define KEY_chr 30 -#define KEY_chroot 31 -#define KEY_close 32 -#define KEY_closedir 33 -#define KEY_cmp 34 -#define KEY_connect 35 -#define KEY_continue 36 -#define KEY_cos 37 -#define KEY_crypt 38 -#define KEY_dbmclose 39 -#define KEY_dbmopen 40 -#define KEY_defined 41 -#define KEY_delete 42 -#define KEY_die 43 -#define KEY_do 44 -#define KEY_dump 45 -#define KEY_each 46 -#define KEY_else 47 -#define KEY_elsif 48 -#define KEY_endgrent 49 -#define KEY_endhostent 50 -#define KEY_endnetent 51 -#define KEY_endprotoent 52 -#define KEY_endpwent 53 -#define KEY_endservent 54 -#define KEY_eof 55 -#define KEY_eq 56 -#define KEY_eval 57 -#define KEY_exec 58 -#define KEY_exists 59 -#define KEY_exit 60 -#define KEY_exp 61 -#define KEY_fcntl 62 -#define KEY_fileno 63 -#define KEY_flock 64 -#define KEY_for 65 -#define KEY_foreach 66 -#define KEY_fork 67 -#define KEY_format 68 -#define KEY_formline 69 -#define KEY_ge 70 -#define KEY_getc 71 -#define KEY_getgrent 72 -#define KEY_getgrgid 73 -#define KEY_getgrnam 74 -#define KEY_gethostbyaddr 75 -#define KEY_gethostbyname 76 -#define KEY_gethostent 77 -#define KEY_getlogin 78 -#define KEY_getnetbyaddr 79 -#define KEY_getnetbyname 80 -#define KEY_getnetent 81 -#define KEY_getpeername 82 -#define KEY_getpgrp 83 -#define KEY_getppid 84 -#define KEY_getpriority 85 -#define KEY_getprotobyname 86 -#define KEY_getprotobynumber 87 -#define KEY_getprotoent 88 -#define KEY_getpwent 89 -#define KEY_getpwnam 90 -#define KEY_getpwuid 91 -#define KEY_getservbyname 92 -#define KEY_getservbyport 93 -#define KEY_getservent 94 -#define KEY_getsockname 95 -#define KEY_getsockopt 96 -#define KEY_glob 97 -#define KEY_gmtime 98 -#define KEY_goto 99 -#define KEY_grep 100 -#define KEY_gt 101 -#define KEY_hex 102 -#define KEY_if 103 -#define KEY_index 104 -#define KEY_int 105 -#define KEY_ioctl 106 -#define KEY_join 107 -#define KEY_keys 108 -#define KEY_kill 109 -#define KEY_last 110 -#define KEY_lc 111 -#define KEY_lcfirst 112 -#define KEY_le 113 -#define KEY_length 114 -#define KEY_link 115 -#define KEY_listen 116 -#define KEY_local 117 -#define KEY_localtime 118 -#define KEY_log 119 -#define KEY_lstat 120 -#define KEY_lt 121 -#define KEY_m 122 -#define KEY_map 123 -#define KEY_mkdir 124 -#define KEY_msgctl 125 -#define KEY_msgget 126 -#define KEY_msgrcv 127 -#define KEY_msgsnd 128 -#define KEY_my 129 -#define KEY_ne 130 -#define KEY_next 131 -#define KEY_no 132 -#define KEY_not 133 -#define KEY_oct 134 -#define KEY_open 135 -#define KEY_opendir 136 -#define KEY_or 137 -#define KEY_ord 138 -#define KEY_pack 139 -#define KEY_package 140 -#define KEY_pipe 141 -#define KEY_pop 142 -#define KEY_pos 143 -#define KEY_print 144 -#define KEY_printf 145 -#define KEY_prototype 146 -#define KEY_push 147 -#define KEY_q 148 -#define KEY_qq 149 -#define KEY_quotemeta 150 -#define KEY_qw 151 -#define KEY_qx 152 -#define KEY_rand 153 -#define KEY_read 154 -#define KEY_readdir 155 -#define KEY_readline 156 -#define KEY_readlink 157 -#define KEY_readpipe 158 -#define KEY_recv 159 -#define KEY_redo 160 -#define KEY_ref 161 -#define KEY_rename 162 -#define KEY_require 163 -#define KEY_reset 164 -#define KEY_return 165 -#define KEY_reverse 166 -#define KEY_rewinddir 167 -#define KEY_rindex 168 -#define KEY_rmdir 169 -#define KEY_s 170 -#define KEY_scalar 171 -#define KEY_seek 172 -#define KEY_seekdir 173 -#define KEY_select 174 -#define KEY_semctl 175 -#define KEY_semget 176 -#define KEY_semop 177 -#define KEY_send 178 -#define KEY_setgrent 179 -#define KEY_sethostent 180 -#define KEY_setnetent 181 -#define KEY_setpgrp 182 -#define KEY_setpriority 183 -#define KEY_setprotoent 184 -#define KEY_setpwent 185 -#define KEY_setservent 186 -#define KEY_setsockopt 187 -#define KEY_shift 188 -#define KEY_shmctl 189 -#define KEY_shmget 190 -#define KEY_shmread 191 -#define KEY_shmwrite 192 -#define KEY_shutdown 193 -#define KEY_sin 194 -#define KEY_sleep 195 -#define KEY_socket 196 -#define KEY_socketpair 197 -#define KEY_sort 198 -#define KEY_splice 199 -#define KEY_split 200 -#define KEY_sprintf 201 -#define KEY_sqrt 202 -#define KEY_srand 203 -#define KEY_stat 204 -#define KEY_study 205 -#define KEY_sub 206 -#define KEY_substr 207 -#define KEY_symlink 208 -#define KEY_syscall 209 -#define KEY_sysopen 210 -#define KEY_sysread 211 -#define KEY_system 212 -#define KEY_syswrite 213 -#define KEY_tell 214 -#define KEY_telldir 215 -#define KEY_tie 216 -#define KEY_tied 217 -#define KEY_time 218 -#define KEY_times 219 -#define KEY_tr 220 -#define KEY_truncate 221 -#define KEY_uc 222 -#define KEY_ucfirst 223 -#define KEY_umask 224 -#define KEY_undef 225 -#define KEY_unless 226 -#define KEY_unlink 227 -#define KEY_unpack 228 -#define KEY_unshift 229 -#define KEY_untie 230 -#define KEY_until 231 -#define KEY_use 232 -#define KEY_utime 233 -#define KEY_values 234 -#define KEY_vec 235 -#define KEY_wait 236 -#define KEY_waitpid 237 -#define KEY_wantarray 238 -#define KEY_warn 239 -#define KEY_while 240 -#define KEY_write 241 -#define KEY_x 242 -#define KEY_xor 243 -#define KEY_y 244 +#define KEY_RESTART 16 +#define KEY_abs 17 +#define KEY_accept 18 +#define KEY_alarm 19 +#define KEY_and 20 +#define KEY_atan2 21 +#define KEY_bind 22 +#define KEY_binmode 23 +#define KEY_bless 24 +#define KEY_caller 25 +#define KEY_chdir 26 +#define KEY_chmod 27 +#define KEY_chomp 28 +#define KEY_chop 29 +#define KEY_chown 30 +#define KEY_chr 31 +#define KEY_chroot 32 +#define KEY_close 33 +#define KEY_closedir 34 +#define KEY_cmp 35 +#define KEY_connect 36 +#define KEY_continue 37 +#define KEY_cos 38 +#define KEY_crypt 39 +#define KEY_dbmclose 40 +#define KEY_dbmopen 41 +#define KEY_defined 42 +#define KEY_delete 43 +#define KEY_die 44 +#define KEY_do 45 +#define KEY_dump 46 +#define KEY_each 47 +#define KEY_else 48 +#define KEY_elsif 49 +#define KEY_endgrent 50 +#define KEY_endhostent 51 +#define KEY_endnetent 52 +#define KEY_endprotoent 53 +#define KEY_endpwent 54 +#define KEY_endservent 55 +#define KEY_eof 56 +#define KEY_eq 57 +#define KEY_eval 58 +#define KEY_exec 59 +#define KEY_exists 60 +#define KEY_exit 61 +#define KEY_exp 62 +#define KEY_fcntl 63 +#define KEY_fileno 64 +#define KEY_flock 65 +#define KEY_for 66 +#define KEY_foreach 67 +#define KEY_fork 68 +#define KEY_format 69 +#define KEY_formline 70 +#define KEY_ge 71 +#define KEY_getc 72 +#define KEY_getgrent 73 +#define KEY_getgrgid 74 +#define KEY_getgrnam 75 +#define KEY_gethostbyaddr 76 +#define KEY_gethostbyname 77 +#define KEY_gethostent 78 +#define KEY_getlogin 79 +#define KEY_getnetbyaddr 80 +#define KEY_getnetbyname 81 +#define KEY_getnetent 82 +#define KEY_getpeername 83 +#define KEY_getpgrp 84 +#define KEY_getppid 85 +#define KEY_getpriority 86 +#define KEY_getprotobyname 87 +#define KEY_getprotobynumber 88 +#define KEY_getprotoent 89 +#define KEY_getpwent 90 +#define KEY_getpwnam 91 +#define KEY_getpwuid 92 +#define KEY_getservbyname 93 +#define KEY_getservbyport 94 +#define KEY_getservent 95 +#define KEY_getsockname 96 +#define KEY_getsockopt 97 +#define KEY_glob 98 +#define KEY_gmtime 99 +#define KEY_goto 100 +#define KEY_grep 101 +#define KEY_gt 102 +#define KEY_hex 103 +#define KEY_if 104 +#define KEY_index 105 +#define KEY_int 106 +#define KEY_ioctl 107 +#define KEY_join 108 +#define KEY_keys 109 +#define KEY_kill 110 +#define KEY_last 111 +#define KEY_lc 112 +#define KEY_lcfirst 113 +#define KEY_le 114 +#define KEY_length 115 +#define KEY_link 116 +#define KEY_listen 117 +#define KEY_local 118 +#define KEY_localtime 119 +#define KEY_log 120 +#define KEY_lstat 121 +#define KEY_lt 122 +#define KEY_m 123 +#define KEY_map 124 +#define KEY_mkdir 125 +#define KEY_msgctl 126 +#define KEY_msgget 127 +#define KEY_msgrcv 128 +#define KEY_msgsnd 129 +#define KEY_my 130 +#define KEY_ne 131 +#define KEY_next 132 +#define KEY_no 133 +#define KEY_not 134 +#define KEY_oct 135 +#define KEY_open 136 +#define KEY_opendir 137 +#define KEY_or 138 +#define KEY_ord 139 +#define KEY_pack 140 +#define KEY_package 141 +#define KEY_pipe 142 +#define KEY_pop 143 +#define KEY_pos 144 +#define KEY_print 145 +#define KEY_printf 146 +#define KEY_prototype 147 +#define KEY_push 148 +#define KEY_q 149 +#define KEY_qq 150 +#define KEY_quotemeta 151 +#define KEY_qw 152 +#define KEY_qx 153 +#define KEY_rand 154 +#define KEY_read 155 +#define KEY_readdir 156 +#define KEY_readline 157 +#define KEY_readlink 158 +#define KEY_readpipe 159 +#define KEY_recv 160 +#define KEY_redo 161 +#define KEY_ref 162 +#define KEY_rename 163 +#define KEY_require 164 +#define KEY_reset 165 +#define KEY_return 166 +#define KEY_reverse 167 +#define KEY_rewinddir 168 +#define KEY_rindex 169 +#define KEY_rmdir 170 +#define KEY_s 171 +#define KEY_scalar 172 +#define KEY_seek 173 +#define KEY_seekdir 174 +#define KEY_select 175 +#define KEY_semctl 176 +#define KEY_semget 177 +#define KEY_semop 178 +#define KEY_send 179 +#define KEY_setgrent 180 +#define KEY_sethostent 181 +#define KEY_setnetent 182 +#define KEY_setpgrp 183 +#define KEY_setpriority 184 +#define KEY_setprotoent 185 +#define KEY_setpwent 186 +#define KEY_setservent 187 +#define KEY_setsockopt 188 +#define KEY_shift 189 +#define KEY_shmctl 190 +#define KEY_shmget 191 +#define KEY_shmread 192 +#define KEY_shmwrite 193 +#define KEY_shutdown 194 +#define KEY_sin 195 +#define KEY_sleep 196 +#define KEY_socket 197 +#define KEY_socketpair 198 +#define KEY_sort 199 +#define KEY_splice 200 +#define KEY_split 201 +#define KEY_sprintf 202 +#define KEY_sqrt 203 +#define KEY_srand 204 +#define KEY_stat 205 +#define KEY_study 206 +#define KEY_sub 207 +#define KEY_substr 208 +#define KEY_symlink 209 +#define KEY_syscall 210 +#define KEY_sysopen 211 +#define KEY_sysread 212 +#define KEY_system 213 +#define KEY_syswrite 214 +#define KEY_tell 215 +#define KEY_telldir 216 +#define KEY_tie 217 +#define KEY_tied 218 +#define KEY_time 219 +#define KEY_times 220 +#define KEY_tr 221 +#define KEY_truncate 222 +#define KEY_uc 223 +#define KEY_ucfirst 224 +#define KEY_umask 225 +#define KEY_undef 226 +#define KEY_unless 227 +#define KEY_unlink 228 +#define KEY_unpack 229 +#define KEY_unshift 230 +#define KEY_untie 231 +#define KEY_until 232 +#define KEY_use 233 +#define KEY_utime 234 +#define KEY_values 235 +#define KEY_vec 236 +#define KEY_wait 237 +#define KEY_waitpid 238 +#define KEY_wantarray 239 +#define KEY_warn 240 +#define KEY_while 241 +#define KEY_write 242 +#define KEY_x 243 +#define KEY_xor 244 +#define KEY_y 245 diff --git a/keywords.pl b/keywords.pl index 086a109..c9479c4 100755 --- a/keywords.pl +++ b/keywords.pl @@ -39,6 +39,7 @@ GT LE LT NE +RESTART abs accept alarm diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 8554bb5..742e6d3 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -767,8 +767,9 @@ while (fetch_para()) { unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s; ($class, $func_name, $orig_args) = ($1, $2, $3) ; - ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; - $Full_func_name = "${Packid}_$func_name"; + ($fname = $func_name) =~ s/^($Prefix)?//; + $pname = $Packprefix . $fname; + $Full_func_name = "${Packid}_$fname"; # Check for duplicate function definition for $tmp (@XSStack) { @@ -816,7 +817,7 @@ while (fetch_para()) { # print function header print Q<<"EOF"; -#XS(XS_${Packid}_$func_name) +#XS(XS_$Full_func_name) #[[ # dXSARGS; EOF diff --git a/op.c b/op.c index d56ed9a..b291cef 100644 --- a/op.c +++ b/op.c @@ -128,6 +128,14 @@ char *name; sv = NEWSV(1102,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); + if (in_my_stash) { + if (*name != '$') + croak("Can't declare class for non-scalar %s in \"my\"",name); + SvOBJECT_on(sv); + (void)SvUPGRADE(sv, SVt_PVMG); + SvSTASH(sv) = (HV*)SvREFCNT_inc(in_my_stash); + sv_objcount++; + } av_store(comppad_name, off, sv); SvNVX(sv) = (double)999999999; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ @@ -1324,6 +1332,7 @@ I32 lex; } } in_my = FALSE; + in_my_stash = Nullhv; if (lex) return my(o); else @@ -2893,6 +2902,11 @@ OP *block; av_unshift(endav, 1); av_store(endav, 0, SvREFCNT_inc(cv)); } + else if (strEQ(s, "RESTART") && !error_count) { + if (!restartav) + restartav = newAV(); + av_push(restartav, SvREFCNT_inc(cv)); + } if (perldb && curstash != debstash) { SV *sv; SV *tmpstr = sv_newmortal(); @@ -2987,6 +3001,11 @@ char *filename; av_unshift(endav, 1); av_store(endav, 0, SvREFCNT_inc(gv)); } + else if (strEQ(s, "RESTART")) { + if (!restartav) + restartav = newAV(); + av_push(restartav, SvREFCNT_inc(gv)); + } if (!name) { GvCV(gv) = 0; /* Will remember elsewhere instead. */ CvANON_on(cv); @@ -4130,6 +4149,47 @@ register OP* o; } } break; + + case OP_HELEM: { + UNOP *rop; + SV *lexname; + GV **fields; + SV **svp, **indsvp; + I32 ind; + char *key; + STRLEN keylen; + + if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO) + || ((BINOP*)o)->op_last->op_type != OP_CONST) + break; + rop = (UNOP*)((BINOP*)o)->op_first; + if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV) + break; + lexname = *av_fetch(comppad_name, rop->op_first->op_targ, TRUE); + if (!SvOBJECT(lexname)) + break; + fields = hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); + if (!fields || !GvHV(*fields)) + break; + svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv; + key = SvPV(*svp, keylen); + indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + if (!indsvp) { + croak("No such field \"%s\" in variable %s of type %s", + key, SvPV(lexname, na), HvNAME(SvSTASH(lexname))); + } + ind = SvIV(*indsvp); + if (ind < 1) + croak("Bad index while coercing array into hash"); + rop->op_type = OP_RV2AV; + rop->op_ppaddr = ppaddr[OP_RV2AV]; + o->op_type = OP_AELEM; + o->op_ppaddr = ppaddr[OP_AELEM]; + SvREFCNT_dec(*svp); + *svp = newSViv(ind); + break; + } + default: o->op_seq = op_seqmax++; break; diff --git a/perl.c b/perl.c index 6c7723a..479e96c 100644 --- a/perl.c +++ b/perl.c @@ -551,7 +551,9 @@ PerlInterpreter *sv_interp; my_exit(0); } if (perldb && DBsingle) - sv_setiv(DBsingle, 1); + sv_setiv(DBsingle, 1); + if (restartav) + calllist(restartav); } /* do it */ diff --git a/perl.h b/perl.h index bfb9210..3d39fa1 100644 --- a/perl.h +++ b/perl.h @@ -1160,6 +1160,7 @@ EXT char * last_uni; /* position of last named-unary operator */ EXT char * last_lop; /* position of last list operator */ EXT OPCODE last_lop_op; /* last list operator */ EXT bool in_my; /* we're compiling a "my" declaration */ +EXT HV * in_my_stash; /* declared class of this "my" declaration */ #ifdef FCRYPT EXT I32 cryptseen; /* has fast crypt() been initialized? */ #endif @@ -1313,6 +1314,7 @@ IEXT HV * Idebstash; /* symbol table for perldb package */ IEXT SV * Icurstname; /* name of current package */ IEXT AV * Ibeginav; /* names of BEGIN subroutines */ IEXT AV * Iendav; /* names of END subroutines */ +IEXT AV * Irestartav; /* names of RESTART subroutines */ IEXT AV * Ipad; /* storage for lexically scoped temporaries */ IEXT AV * Ipadname; /* variable names for "my" variables */ diff --git a/pp.c b/pp.c index 54433af2..40c0e77 100644 --- a/pp.c +++ b/pp.c @@ -1791,20 +1791,24 @@ PP(pp_each) HE *entry; I32 i; char *tmps; + I32 realhv = (SvTYPE(hash) == SVt_PVHV); PUTBACK; - entry = hv_iternext(hash); /* might clobber stack_sp */ + /* might clobber stack_sp */ + entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash); SPAGAIN; EXTEND(SP, 2); if (entry) { - tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */ + tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */ if (!i) tmps = ""; PUSHs(sv_2mortal(newSVpv(tmps, i))); if (GIMME == G_ARRAY) { PUTBACK; - sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */ + /* might clobber stack_sp */ + sv_setsv(TARG, realhv ? + hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry)); SPAGAIN; PUSHs(TARG); } @@ -1833,12 +1837,16 @@ PP(pp_delete) HV *hv = (HV*)POPs; char *tmps; STRLEN len; - if (SvTYPE(hv) != SVt_PVHV) { + I32 flags = op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0; + + tmps = SvPV(tmpsv, len); + if (SvTYPE(hv) == SVt_PVHV) + sv = hv_delete(hv, tmps, len, flags); + else if (SvTYPE(hv) == SVt_PVAV) { + sv = avhv_delete((AV*)hv, tmps, len, flags); + } else { DIE("Not a HASH reference"); } - tmps = SvPV(tmpsv, len); - sv = hv_delete(hv, tmps, len, - op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0); if (!sv) RETPUSHUNDEF; PUSHs(sv); @@ -1852,12 +1860,16 @@ PP(pp_exists) HV *hv = (HV*)POPs; char *tmps; STRLEN len; - if (SvTYPE(hv) != SVt_PVHV) { + tmps = SvPV(tmpsv, len); + if (SvTYPE(hv) == SVt_PVHV) { + if (hv_exists(hv, tmps, len)) + RETPUSHYES; + } else if (SvTYPE(hv) == SVt_PVAV) { + if (avhv_exists((AV*)hv, tmps, len)) + RETPUSHYES; + } else { DIE("Not a HASH reference"); } - tmps = SvPV(tmpsv, len); - if (hv_exists(hv, tmps, len)) - RETPUSHYES; RETPUSHNO; } @@ -1867,13 +1879,15 @@ PP(pp_hslice) register SV **svp; register HV *hv = (HV*)POPs; register I32 lval = op->op_flags & OPf_MOD; + I32 realhv = (SvTYPE(hv) == SVt_PVHV); - if (SvTYPE(hv) == SVt_PVHV) { + if (realhv || SvTYPE(hv) == SVt_PVAV) { while (++MARK <= SP) { STRLEN keylen; char *key = SvPV(*MARK, keylen); - svp = hv_fetch(hv, key, keylen, lval); + svp = realhv ? hv_fetch(hv, key, keylen, lval) + : avhv_fetch((AV*)hv, key, keylen, lval); if (lval) { if (!svp || *svp == &sv_undef) DIE(no_helem, key); diff --git a/pp_hot.c b/pp_hot.c index 8fe39f3..430a7d9 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -469,7 +469,7 @@ PP(pp_rv2hv) if (SvROK(sv)) { wasref: hv = (HV*)SvRV(sv); - if (SvTYPE(hv) != SVt_PVHV) + if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) DIE("Not a HASH reference"); if (op->op_private & OPpLVAL_INTRO) hv = (HV*)save_svref((SV**)sv); @@ -479,7 +479,7 @@ PP(pp_rv2hv) } } else { - if (SvTYPE(sv) == SVt_PVHV) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) { hv = (HV*)sv; if (op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -526,12 +526,14 @@ PP(pp_rv2hv) } else { dTARGET; + /* This bit is OK even when hv is really an AV */ if (HvFILL(hv)) { sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1); sv_setpv(TARG, buf); } else sv_setiv(TARG, 0); + SETTARG; RETURN; } @@ -1198,9 +1200,13 @@ PP(pp_helem) HV *hv = (HV*)POPs; I32 lval = op->op_flags & OPf_MOD; - if (SvTYPE(hv) != SVt_PVHV) + if (SvTYPE(hv) == SVt_PVHV) + svp = hv_fetch(hv, key, keylen, lval); + else if (SvTYPE(hv) == SVt_PVAV) + svp = avhv_fetch((AV*)hv, key, keylen, lval); + else { RETPUSHUNDEF; - svp = hv_fetch(hv, key, keylen, lval); + } if (lval) { if (!svp || *svp == &sv_undef) DIE(no_helem, key); diff --git a/proto.h b/proto.h index 542d566..efda120 100644 --- a/proto.h +++ b/proto.h @@ -14,6 +14,14 @@ OP* append_elem _((I32 optype, OP* head, OP* tail)); OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); I32 apply _((I32 type, SV** mark, SV** sp)); void assertref _((OP* op)); +SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); +bool avhv_exists _((AV *ar, char* key, U32 klen)); +SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); +I32 avhv_iterinit _((AV *ar)); +HE* avhv_iternext _((AV *ar)); +SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); +SV* avhv_iterval _((AV *ar, HE* entry)); +SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); void av_clear _((AV* ar)); void av_extend _((AV* ar, I32 key)); AV* av_fake _((I32 size, SV** svp)); diff --git a/t/op/groups.t b/t/op/groups.t index 4445953..8676504 100755 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -1,6 +1,10 @@ #!./perl -if (! -x '/usr/ucb/groups') { +if (-x '/usr/ucb/groups') { + $groups_command = '/usr/ucb/groups'; +} elsif (-x '/usr/bin/groups') { + $groups_command = '/usr/bin/groups'; +} else { print "1..0\n"; exit 0; } @@ -26,7 +30,7 @@ for (split(' ', $()) { $gr1 = join(' ', sort @gr); -$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`/usr/ucb/groups`))); +$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`$groups_command`))); if ($gr1 eq $gr2) { print "ok 1\n"; diff --git a/toke.c b/toke.c index 5a43c09..1318208 100644 --- a/toke.c +++ b/toke.c @@ -2546,6 +2546,7 @@ yylex() case KEY_DESTROY: case KEY_BEGIN: case KEY_END: + case KEY_RESTART: if (expect == XSTATE) { s = bufptr; goto really_sub; @@ -2931,6 +2932,17 @@ yylex() case KEY_my: in_my = TRUE; yylval.ival = 1; + s = skipspace(s); + if (isIDFIRST(*s)) { + s = scan_word(s, tokenbuf, TRUE, &len); + in_my_stash = gv_stashpv(tokenbuf, FALSE); + if (!in_my_stash) { + char tmpbuf[1024]; + bufptr = s; + sprintf(tmpbuf, "No such class %.1000s", tokenbuf); + yyerror(tmpbuf); + } + } OPERATOR(LOCAL); case KEY_next: @@ -3816,6 +3828,9 @@ I32 len; } else if (strEQ(d,"quotemeta")) return -KEY_quotemeta; break; + case 'R': + if (strEQ(d,"RESTART")) return KEY_RESTART; + break; case 'r': switch (len) { case 3: @@ -4997,5 +5012,6 @@ char *s; croak("%s has too many errors.\n", SvPVX(GvSV(curcop->cop_filegv))); in_my = 0; + in_my_stash = Nullhv; return 0; } -- 1.8.3.1