Initial devel changes.
Malcolm Beattie [Fri, 28 Mar 1997 13:32:21 +0000 (13:32 +0000)]
Pseudo-hashes. Optional strong typing. RESTART {}.

p4raw-id: //depot/perl@2

17 files changed:
av.c
doop.c
embed.h
ext/DB_File/DB_File.xs
global.sym
interp.sym
keywords.h
keywords.pl
lib/ExtUtils/xsubpp
op.c
perl.c
perl.h
pp.c
pp_hot.c
proto.h
t/op/groups.t
toke.c

diff --git a/av.c b/av.c
index b27ec76..8e8e47a 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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
 #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
 #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
 #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)
 #define Ipreambled     preambled
 #define Ipreambleav    preambleav
 #define Ipreprocess    preprocess
+#define Irestartav     restartav
 #define Irestartop     restartop
 #define Irightgv       rightgv
 #define Irs            rs
index dd9e03d..fe967e6 100644 (file)
@@ -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)
index 70d07c0..93bedba 100644 (file)
@@ -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
index 801eb41..30e8562 100644 (file)
@@ -111,6 +111,7 @@ pidstatus
 preambled
 preambleav
 preprocess
+restartav
 restartop
 rightgv
 rs
index 8cb2748..a6dabf3 100644 (file)
 #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
index 086a109..c9479c4 100755 (executable)
@@ -39,6 +39,7 @@ GT
 LE
 LT
 NE
+RESTART
 abs
 accept
 alarm
index 8554bb5..742e6d3 100755 (executable)
@@ -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 (file)
--- 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 (file)
--- 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 (file)
--- 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 54433af..40c0e77 100644 (file)
--- 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);
index 8fe39f3..430a7d9 100644 (file)
--- 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 (file)
--- 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));
index 4445953..8676504 100755 (executable)
@@ -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 (file)
--- 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;
 }