[asperl] tweaks to make it build with the Borland compiler. Won't run
Gurusamy Sarathy [Tue, 26 May 1998 13:39:14 +0000 (13:39 +0000)]
testsuite because @INC intuition from location of perlcore.dll seems
to be broken.  Also, system() and qx// seem broken as well.

p4raw-id: //depot/asperl@1033

14 files changed:
ObjXSub.h
doio.c
embedvar.h
ext/POSIX/POSIX.xs
interp.sym
intrpvar.h
objpp.h
perl.c
perl.h
perlvars.h
proto.h
regcomp.c
regexec.c
toke.c

index 9880e8c..f525cad 100644 (file)
--- a/ObjXSub.h
+++ b/ObjXSub.h
 #define dowarn                 pPerl->Perl_dowarn
 #undef  dumplvl
 #define dumplvl                        pPerl->Perl_dumplvl
-#undef  e_fp
-#define e_fp                   pPerl->Perl_e_fp
-#undef  e_tmpname
-#define e_tmpname              pPerl->Perl_e_tmpname
+#undef  e_script
+#define e_script               pPerl->Perl_e_script
 #undef  egid
 #define egid                   pPerl->Perl_egid
 #undef  endav
 #define sv_undef               pPerl->Perl_sv_undef
 #undef  sv_yes
 #define sv_yes                 pPerl->Perl_sv_yes
+#undef  sys_intern
+#define sys_intern             pPerl->Perl_sys_intern
 #undef  tainted
 #define tainted                        pPerl->Perl_tainted
 #undef  tainting
 #define dounwind            pPerl->Perl_dounwind
 #undef  do_aexec
 #define do_aexec            pPerl->Perl_do_aexec
+#undef  do_binmode
+#define do_binmode          pPerl->Perl_do_binmode
 #undef  do_chomp
 #define do_chomp            pPerl->Perl_do_chomp
 #undef  do_chop
 #define filter_read         pPerl->Perl_filter_read
 #undef  find_threadsv
 #define find_threadsv       pPerl->Perl_find_threadsv
+#undef  find_script
+#define find_script         pPerl->Perl_find_script
 #undef  force_ident
 #define force_ident         pPerl->Perl_force_ident
 #undef  force_list
 #define magic_getpack       pPerl->Perl_magic_getpack
 #undef  magic_getglob
 #define magic_getglob       pPerl->Perl_magic_getglob
+#undef  magic_getnkeys
+#define magic_getnkeys      pPerl->Perl_magic_getnkeys
 #undef  magic_getpos
 #define magic_getpos        pPerl->Perl_magic_getpos
 #undef  magic_getsig
 #define magic_getsig        pPerl->Perl_magic_getsig
+#undef  magic_getsubstr
+#define magic_getsubstr     pPerl->Perl_magic_getsubstr
 #undef  magic_gettaint
 #define magic_gettaint      pPerl->Perl_magic_gettaint
 #undef  magic_getuvar
 #define magic_getuvar       pPerl->Perl_magic_getuvar
+#undef  magic_getvec
+#define magic_getvec        pPerl->Perl_magic_getvec
 #undef  magic_len
 #define magic_len           pPerl->Perl_magic_len
 #undef  magic_methpack
diff --git a/doio.c b/doio.c
index f6362b1..61c21b5 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -741,7 +741,7 @@ do_binmode(PerlIO *fp, int iotype, int flag)
         * document this anywhere). GSAR 97-5-24
         */
        PerlIO_seek(fp,0L,0);
-       fp->flags |= _F_BIN;
+       ((FILE*)fp)->flags |= _F_BIN;
 #endif
        return 1;
     }
@@ -1085,7 +1085,9 @@ apply(I32 type, register SV **mark, register SV **sp)
     SV **oldmark = mark;
 
 #define APPLY_TAINT_PROPER() \
-    if (!(tainting && tainted)) {} else { goto taint_proper; }
+    STMT_START {                                               \
+       if (tainting && tainted) { goto taint_proper_label; }   \
+    } STMT_END
 
     /* This is a first heuristic; it doesn't catch tainting magic. */
     if (tainting) {
@@ -1265,7 +1267,7 @@ apply(I32 type, register SV **mark, register SV **sp)
     }
     return tot;
 
-  taint_proper:
+  taint_proper_label:
     TAINT_PROPER(what);
     return 0;  /* this should never happen */
 
index 2e52562..cd4701d 100644 (file)
 #define eval_start             (curinterp->Ieval_start)
 #define exitlist               (curinterp->Iexitlist)
 #define exitlistlen            (curinterp->Iexitlistlen)
+#define extralen               (curinterp->Iextralen)
 #define fdpid                  (curinterp->Ifdpid)
 #define filemode               (curinterp->Ifilemode)
 #define firstgv                        (curinterp->Ifirstgv)
 #define Ieval_start            eval_start
 #define Iexitlist              exitlist
 #define Iexitlistlen           exitlistlen
+#define Iextralen              extralen
 #define Ifdpid                 fdpid
 #define Ifilemode              filemode
 #define Ifirstgv               firstgv
 #define eval_start             Perl_eval_start
 #define exitlist               Perl_exitlist
 #define exitlistlen            Perl_exitlistlen
+#define extralen               Perl_extralen
 #define fdpid                  Perl_fdpid
 #define filemode               Perl_filemode
 #define firstgv                        Perl_firstgv
index 1dba9a6..b49fa42 100644 (file)
@@ -5,6 +5,12 @@
 #define PERLIO_NOT_STDIO 1
 #include "perl.h"
 #include "XSUB.h"
+#ifdef PERL_OBJECT
+#  undef signal
+#  undef open
+#  undef TAINT_PROPER
+#  define TAINT_PROPER(a)      /* XXX hack */
+#endif
 #include <ctype.h>
 #ifdef I_DIRENT    /* XXX maybe better to just rely on perl.h? */
 #include <dirent.h>
 #if defined (WIN32)
 #  undef mkfifo  /* #defined in perl.h */
 #  define mkfifo(a,b) not_here("mkfifo")
-#  define ttyname(a) not_here("ttyname")
+#  define ttyname(a) (char*)not_here("ttyname")
 #  define sigset_t long
 #  define pid_t long
 #  ifdef __BORLANDC__
index de164d5..7a53ab3 100644 (file)
@@ -50,6 +50,7 @@ eval_root
 eval_start
 exitlist
 exitlistlen
+extralen
 fdpid
 filemode
 firstgv
@@ -94,6 +95,7 @@ minus_l
 minus_n
 minus_p
 modglobal
+modcount
 multiline
 mystrk
 nrs
index 03435ac..de2578a 100644 (file)
@@ -162,7 +162,6 @@ PERLVAR(Isys_intern,        struct interp_intern)           /* platform internals */
 
 /* more statics moved here */
 PERLVAR(Imh,           HE)             /* from hv.c */
-PERLVAR(Imodcount,     I32)            /* from op.c */
 PERLVARI(Igeneration,  int,    100)    /* from op.c */
 PERLVAR(IDBcv,         CV *)           /* from perl.c */
 PERLVAR(Iarchpat_auto, char*)          /* from perl.c */
diff --git a/objpp.h b/objpp.h
index 77b6c0d..4bc40cd 100644 (file)
--- a/objpp.h
+++ b/objpp.h
 #define do_aexec          CPerlObj::Perl_do_aexec
 #undef  do_aspawn
 #define do_aspawn         CPerlObj::do_aspawn
+#undef  do_binmode
+#define do_binmode        CPerlObj::Perl_do_binmode
 #undef  do_chop
 #define do_chop           CPerlObj::Perl_do_chop
 #undef  do_close
 #define filter_read       CPerlObj::Perl_filter_read
 #undef  find_beginning
 #define find_beginning    CPerlObj::find_beginning
+#undef  find_script
+#define find_script       CPerlObj::Perl_find_script
 #undef  forbid_setid
 #define forbid_setid      CPerlObj::forbid_setid
 #undef  force_ident
 #define magic_getpack     CPerlObj::Perl_magic_getpack
 #undef  magic_getglob
 #define magic_getglob     CPerlObj::Perl_magic_getglob
+#undef  magic_getnkeys
+#define magic_getnkeys    CPerlObj::Perl_magic_getnkeys
 #undef  magic_getpos
 #define magic_getpos      CPerlObj::Perl_magic_getpos
 #undef  magic_getsig
 #define magic_getsig      CPerlObj::Perl_magic_getsig
+#undef  magic_getsubstr
+#define magic_getsubstr   CPerlObj::Perl_magic_getsubstr
 #undef  magic_gettaint
 #define magic_gettaint    CPerlObj::Perl_magic_gettaint
 #undef  magic_getuvar
 #define magic_getuvar     CPerlObj::Perl_magic_getuvar
+#undef  magic_getvec
+#define magic_getvec     CPerlObj::Perl_magic_getvec
 #undef  magic_len
 #define magic_len         CPerlObj::Perl_magic_len
 #undef  magic_methcall
 #define regtail           CPerlObj::regtail
 #undef  regtry
 #define regtry            CPerlObj::regtry
+#undef  regwhite
+#define regwhite          CPerlObj::regwhite
 #undef  repeatcpy
 #define repeatcpy         CPerlObj::Perl_repeatcpy
 #undef  restore_expect
diff --git a/perl.c b/perl.c
index bc55ba1..e6d8e65 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -69,7 +69,9 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
     mess_sv     = Nullsv;      \
   } STMT_END
 
-#ifndef PERL_OBJECT
+#ifdef PERL_OBJECT
+static I32 read_e_script _((CPerlObj* pPerl, int idx, SV *buf_sv, int maxlen));
+#else
 static void find_beginning _((void));
 static void forbid_setid _((char *));
 static void incpush _((char *, int));
@@ -384,7 +386,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
 
     /* call exit list functions */
     while (exitlistlen-- > 0)
-       exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+       exitlist[exitlistlen].fn(THIS_ exitlist[exitlistlen].ptr);
 
     Safefree(exitlist);
 
@@ -595,7 +597,11 @@ perl_free(PerlInterpreter *sv_interp)
 }
 
 void
+#ifdef PERL_OBJECT
+CPerlObj::perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr)
+#else
 perl_atexit(void (*fn) (void *), void *ptr)
+#endif
 {
     Renew(exitlist, exitlistlen+1, PerlExitListEntry);
     exitlist[exitlistlen].fn = fn;
@@ -2219,22 +2225,6 @@ find_beginning(void)
 }
 
 
-STATIC I32
-read_e_script(int idx, SV *buf_sv, int maxlen)
-{
-    char *p, *nl;
-    FILTER_READ(idx+1, buf_sv, maxlen);
-    p  = SvPVX(e_script);
-    nl = strchr(p, '\n');
-    nl = (nl) ? nl+1 : SvEND(e_script);
-    if (nl-p == 0)
-       return 0;
-    sv_catpvn(buf_sv, p, nl-p);
-    sv_chop(e_script, nl);
-    return 1;
-}
-
-
 STATIC void
 init_ids(void)
 {
@@ -2876,3 +2866,27 @@ my_exit_jump(void)
 
     JMPENV_JUMP(2);
 }
+
+
+#include "XSUB.h"
+
+static I32
+#ifdef PERL_OBJECT
+read_e_script(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
+#else
+read_e_script(int idx, SV *buf_sv, int maxlen)
+#endif
+{
+    char *p, *nl;
+    FILTER_READ(idx+1, buf_sv, maxlen);
+    p  = SvPVX(e_script);
+    nl = strchr(p, '\n');
+    nl = (nl) ? nl+1 : SvEND(e_script);
+    if (nl-p == 0)
+       return 0;
+    sv_catpvn(buf_sv, p, nl-p);
+    sv_chop(e_script, nl);
+    return 1;
+}
+
+
diff --git a/perl.h b/perl.h
index 4513a07..34f68b2 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -110,6 +110,7 @@ class CPerlObj;
 #define _CPERLarg ,CPERLarg
 #define THIS this
 #define _THIS ,this
+#define THIS_ this,
 #define CALLRUNOPS (this->*runops)
 
 #else /* !PERL_OBJECT */
@@ -1076,7 +1077,12 @@ typedef union any ANY;
 
 #include "handy.h"
 
+#ifdef PERL_OBJECT
+typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
+#else
 typedef I32 (*filter_t) _((int, SV *, int));
+#endif
+
 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
 #define FILTER_DATA(idx)          (AvARRAY(rsfp_filters)[idx])
 #define FILTER_ISREADER(idx)      (idx >= AvFILLp(rsfp_filters))
@@ -1838,7 +1844,11 @@ public:
 
 /* Interpreter exitlist entry */
 typedef struct exitlistentry {
+#ifdef PERL_OBJECT
+    void (*fn) _((CPerlObj*, void*));
+#else
     void (*fn) _((void*));
+#endif
     void *ptr;
 } PerlExitListEntry;
 
index a141c35..9f801fb 100644 (file)
@@ -60,7 +60,7 @@ PERLVAR(Gnice_chunk,  char *)         /* a nice chunk of memory to reuse */
 PERLVAR(Gnice_chunk_size,      U32)            /* how nice the chunk of memory is */
 
 #ifdef PERL_OBJECT
-PERLVARI(Grunops,      runops_proc_t,  RUNOPS_DEFAULT) 
+PERLVARI(Grunops,      runops_proc_t,  FUNC_NAME_TO_PTR(RUNOPS_DEFAULT))       
 #else
 PERLVARI(Grunops,      runops_proc_t *,        RUNOPS_DEFAULT) 
 #endif
diff --git a/proto.h b/proto.h
index f984290..75a2aaa 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -80,7 +80,12 @@ VIRTUAL CV*  cv_clone _((CV* proto));
 VIRTUAL SV*    cv_const_sv _((CV* cv));
 VIRTUAL void   cv_undef _((CV* cv));
 #ifdef DEBUGGING
-void   cx_dump _((PERL_CONTEXT* cs));
+VIRTUAL void   cx_dump _((PERL_CONTEXT* cs));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void   cx_dump_place_holder _((PERL_CONTEXT* cs));
+#endif
 #endif
 VIRTUAL SV*    filter_add _((filter_t funcp, SV* datasv));
 VIRTUAL void   filter_del _((filter_t funcp));
@@ -151,20 +156,25 @@ VIRTUAL void      do_vop _((I32 optype, SV* sv, SV* left, SV* right));
 VIRTUAL I32    dowantarray _((void));
 VIRTUAL void   dump_all _((void));
 #ifdef DEBUGGING
-void   dump_eval _((void));
+VIRTUAL void   dump_eval _((void));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void   dump_eval_place_holder _((void));
+#endif
 #endif
 #ifdef DUMP_FDS  /* See util.c */
-int    dump_fds _((char* s));
+VIRTUAL int    dump_fds _((char* s));
 #endif
-void   dump_form _((GV* gv));
-void   dump_gv _((GV* gv));
+VIRTUAL void   dump_form _((GV* gv));
+VIRTUAL void   dump_gv _((GV* gv));
 #ifdef MYMALLOC
-void   dump_mstats _((char* s));
+VIRTUAL void   dump_mstats _((char* s));
 #endif
-void   dump_op _((OP* arg));
-void   dump_pm _((PMOP* pm));
-void   dump_packsubs _((HV* stash));
-void   dump_sub _((GV* gv));
+VIRTUAL void   dump_op _((OP* arg));
+VIRTUAL void   dump_pm _((PMOP* pm));
+VIRTUAL void   dump_packsubs _((HV* stash));
+VIRTUAL void   dump_sub _((GV* gv));
 VIRTUAL void   fbm_compile _((SV* sv, U32 flags));
 VIRTUAL char*  fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
 VIRTUAL char*  find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags));
@@ -314,10 +324,10 @@ VIRTUAL void      my_exit _((U32 status)) __attribute__((noreturn));
 VIRTUAL void   my_failure_exit _((void)) __attribute__((noreturn));
 VIRTUAL I32    my_lstat _((ARGSproto));
 #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
-I32    my_memcmp _((char* s1, char* s2, I32 len));
+VIRTUAL I32    my_memcmp _((char* s1, char* s2, I32 len));
 #endif
 #if !defined(HAS_MEMSET)
-void*  my_memset _((char* loc, I32 ch, I32 len));
+VIRTUAL void*  my_memset _((char* loc, I32 ch, I32 len));
 #endif
 #ifndef PERL_OBJECT
 VIRTUAL I32    my_pclose _((PerlIO* ptr));
@@ -402,7 +412,11 @@ VIRTUAL void       peep _((OP* o));
 #ifndef PERL_OBJECT
 PerlInterpreter*       perl_alloc _((void));
 #endif
-VIRTUAL void    perl_atexit _((void(*fn)(void *), void*));
+#ifdef PERL_OBJECT
+VIRTUAL void    perl_atexit _((void(*fn)(CPerlObj *, void *), void*));
+#else
+void    perl_atexit _((void(*fn)(void *), void*));
+#endif
 VIRTUAL I32    perl_call_argv _((char* sub_name, I32 flags, char** argv));
 VIRTUAL I32    perl_call_method _((char* methname, I32 flags));
 VIRTUAL I32    perl_call_pv _((char* sub_name, I32 flags));
@@ -457,14 +471,24 @@ VIRTUAL regexp*   pregcomp _((char* exp, char* xend, PMOP* pm));
 VIRTUAL OP*    ref _((OP* o, I32 type));
 VIRTUAL OP*    refkids _((OP* o, I32 type));
 #ifdef DEBUGGING
-void   regdump _((regexp* r));
+VIRTUAL void   regdump _((regexp* r));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void   regdump_place_holder _((regexp* r));
+#endif
 #endif
 VIRTUAL I32    pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave));
 VIRTUAL I32    regexec_flags _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags));
 VIRTUAL void   pregfree _((struct regexp* r));
 VIRTUAL regnode* regnext _((regnode* p));
 #ifdef DEBUGGING
-void   regprop _((SV* sv, regnode* o));
+VIRTUAL void   regprop _((SV* sv, regnode* o));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void   regprop_place_holder _((SV* sv, regnode* o));
+#endif
 #endif
 VIRTUAL void   repeatcpy _((char* to, char* from, I32 len, I32 count));
 VIRTUAL char*  rninstr _((char* big, char* bigend, char* little, char* lend));
@@ -587,7 +611,12 @@ VIRTUAL SV*        sv_mortalcopy _((SV* oldsv));
 VIRTUAL SV*    sv_newmortal _((void));
 VIRTUAL SV*    sv_newref _((SV* sv));
 #ifdef DEBUGGING
-char*  sv_peek _((SV* sv));
+VIRTUAL char*  sv_peek _((SV* sv));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL char*  sv_peek_place_holder _((SV* sv));
+#endif
 #endif
 VIRTUAL char*  sv_pvn_force _((SV* sv, STRLEN* lp));
 VIRTUAL char*  sv_reftype _((SV* sv, int ob));
@@ -635,7 +664,12 @@ VIRTUAL void       vivify_ref _((SV* sv, U32 to_what));
 VIRTUAL I32    wait4pid _((int pid, int* statusp, int flags));
 VIRTUAL void   warn _((const char* pat,...));
 #ifdef DEBUGGING
-void   watch _((char** addr));
+VIRTUAL void   watch _((char** addr));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+VIRTUAL void   watch_place_holder _((char** addr));
+#endif
 #endif
 VIRTUAL I32    whichsig _((char* sig));
 VIRTUAL int    yyerror _((char* s));
@@ -743,6 +777,11 @@ int div128 _((SV *pnum, bool *done));
 int runops_standard _((void));
 #ifdef DEBUGGING
 int runops_debug _((void));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+int runops_debug_place_holder _((void));
+#endif
 #endif
 void check_uni _((void));
 void  force_next _((I32 type));
@@ -829,6 +868,7 @@ void reginsert _((U8, regnode *));
 void regoptail _((regnode *, regnode *));
 void regset _((char *, I32));
 void regtail _((regnode *, regnode *));
+char* regwhite _((char *, char *));
 char* nextchar _((void));
 regnode *dumpuntil _((regnode *start, regnode *node, regnode *last, SV* sv, I32 l));
 void scan_commit _((scan_data_t *data));
@@ -850,6 +890,12 @@ int do_aspawn _((void *vreally, void **vmark, void **vsp));
 #ifdef DEBUGGING
 void del_sv _((SV *p));
 void debprof _((OP *o));
+#else
+#ifdef PERL_OBJECT
+/* create a matching set of virtual entries for the non debugging version */
+void del_sv_place_holder _((SV *p));
+void debprof_place_holder _((OP *o));
+#endif
 #endif
 
 void *bset_obj_store _((void *obj, I32 ix));
index 4230b9c..4afa40f 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
  * Forward declarations for pregcomp()'s friends.
  */
 
-static char* regwhite _((char *, char *));
 #ifndef PERL_OBJECT
 static regnode *reg _((I32, I32 *));
 static regnode *reganode _((U8, U32));
@@ -116,8 +115,8 @@ static regnode *regpiece _((I32 *));
 static void reginsert _((U8, regnode *));
 static void regoptail _((regnode *, regnode *));
 static void regtail _((regnode *, regnode *));
+static char* regwhite _((char *, char *));
 static char* nextchar _((void));
-
 static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
 #endif
 
@@ -1798,7 +1797,7 @@ tryagain:
     return(ret);
 }
 
-static char *
+STATIC char *
 regwhite(char *p, char *e)
 {
     while (p < e) {
index 17a561b..a38e97d 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -852,7 +852,7 @@ regmatch(regnode *prog)
            s = (char *) OPERAND(scan);
            if (nextchr < 0)
                nextchr = UCHARAT(locinput);
-           if (!REGINCLASS(s, nextchar))
+           if (!REGINCLASS(s, nextchr))
                sayNO;
            if (!nextchr && locinput >= regeol)
                sayNO;
diff --git a/toke.c b/toke.c
index c59a5bc..d39f2da 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1347,7 +1347,7 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
-    return (*funcp)(idx, buf_sv, maxlen);
+    return (*funcp)(THIS_ idx, buf_sv, maxlen);
 }
 
 STATIC char *