win32/GenCAPI.pl

   1
   2 # creates a C API file from proto.h
   3 # takes one argument, the path to lib/CORE directory.
   4 # creates 2 files: "PerlCAPI.cpp" and "PerlCAPI.h".
   5
   6 my $hdrfile = "$ARGV[0]\\PerlCAPI.h";
   7 my $infile = '..\\proto.h';
   8 my $embedfile = '..\\embed.h';
   9 my $separateObj = 0;
  10
  11 my %skip_list;
  12 my %embed;
  13
  14 sub readembed(\%$) {
  15     my ($syms, $file) = @_;
  16     my ($line, @words);
  17     %$syms = ();
  18     local (*FILE, $_);
  19     open(FILE, "< $file")
  20         or die "$0: Can't open $file: $!\n";
  21     while ($line = <FILE>) {
  22         chop($line);
  23         if ($line =~ /^#define\s+\w+/) {
  24             $line =~ s/^#define\s+//;
  25             @words = split ' ', $line;
  26 #           print "$words[0]\t$words[1]\n";
  27             $$syms{$words[0]} = $words[1];
  28         }
  29     }
  30     close(FILE);
  31 }
  32
  33 readembed %embed, $embedfile;
  34
  35 sub skip_these {
  36     my $list = shift;
  37     foreach my $symbol (@$list) {
  38         $skip_list{$symbol} = 1;
  39     }
  40 }
  41
  42 skip_these [qw(
  43 cando
  44 cast_ulong
  45 my_chsize
  46 condpair_magic
  47 deb
  48 deb_growlevel
  49 debprofdump
  50 debop
  51 debstack
  52 debstackptrs
  53 fprintf
  54 find_threadsv
  55 magic_mutexfree
  56 my_pclose
  57 my_popen
  58 my_swap
  59 my_htonl
  60 my_ntohl
  61 new_struct_thread
  62 same_dirent
  63 unlnk
  64 unlock_condpair
  65 safexmalloc
  66 safexcalloc
  67 safexrealloc
  68 safexfree
  69 Perl_GetVars
  70 )];
  71
  72
  73
  74 if (!open(INFILE, "<$infile")) {
  75     print "open of $infile failed: $!\n";
  76     return 1;
  77 }
  78
  79 if (!open(OUTFILE, ">PerlCAPI.cpp")) {
  80     print "open of PerlCAPI.cpp failed: $!\n";
  81     return 1;
  82 }
  83
  84 print OUTFILE <<ENDCODE;
  85 #include "EXTERN.h"
  86 #include "perl.h"
  87 #include "XSUB.h"
  88
  89 #define DESTRUCTORFUNC (void (*)(void*))
  90
  91 ENDCODE
  92
  93 print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0);
  94
  95 print OUTFILE <<ENDCODE;
  96 extern "C" void SetCPerlObj(CPerlObj* pP)
  97 {
  98     pPerl = pP;
  99 }
 100
 101 ENDCODE
 102
 103 print OUTFILE "#endif\n" unless ($separateObj == 0);
 104
 105 while () {
 106     last unless defined ($_ = <INFILE>);
 107     if (/^VIRTUAL\s/) {
 108         while (!/;$/) {
 109             chomp;
 110             $_ .= <INFILE>;
 111         }
 112         $_ =~ s/^VIRTUAL\s*//;
 113         $_ =~ s/\s*__attribute__.*$/;/;
 114         if ( /(.*)\s([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ ||
 115              /(.*)\*([A-z_]*[0-9A-z_]+\s)_\(\((.*)\)\);/ ) {
 116             $type = $1;
 117             $name = $2;
 118             $args = $3;
 119
 120             $name =~ s/\s*$//;
 121             $type =~ s/\s*$//;
 122             next if (defined $skip_list{$name});
 123
 124             if($args eq "ARGSproto") {
 125                 $args = "void";
 126             }
 127
 128             $return = ($type eq "void" or $type eq "Free_t") ? "\t" : "\treturn";
 129
 130             if(defined $embed{$name}) {
 131                 $funcName = $embed{$name};
 132             } else {
 133                 $funcName = $name;
 134             }
 135
 136             @args = split(',', $args);
 137             if ($args[$#args] =~ /\s*\.\.\.\s*/) {
 138                 if(($name eq "croak") or ($name eq "deb") or ($name eq "die")
 139                         or ($name eq "form") or ($name eq "warn")) {
 140                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 141                     $args[0] =~ /(\w+)\W*$/;
 142                     $arg = $1;
 143                     print OUTFILE <<ENDCODE;
 144
 145 #undef $name
 146 extern "C" $type $funcName ($args)
 147 {
 148     char *pstr;
 149     char *pmsg;
 150     va_list args;
 151     va_start(args, $arg);
 152     pmsg = pPerl->Perl_mess($arg, &args);
 153     New(0, pstr, strlen(pmsg)+1, char);
 154     strcpy(pstr, pmsg);
 155 $return pPerl->Perl_$name(pstr);
 156     va_end(args);
 157 }
 158 ENDCODE
 159                     print OUTFILE "#endif\n" unless ($separateObj == 0);
 160                 }
 161                 elsif($name eq "newSVpvf") {
 162                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 163                     $args[0] =~ /(\w+)\W*$/;
 164                     $arg = $1;
 165                     print OUTFILE <<ENDCODE;
 166
 167 #undef $name
 168 extern "C" $type $funcName ($args)
 169 {
 170     SV *sv;
 171     va_list args;
 172     va_start(args, $arg);
 173     sv = pPerl->Perl_newSV(0);
 174     pPerl->Perl_sv_vcatpvfn(sv, $arg, strlen($arg), &args, NULL, 0, NULL);
 175     va_end(args);
 176     return sv;
 177 }
 178 ENDCODE
 179                     print OUTFILE "#endif\n" unless ($separateObj == 0);
 180                 }
 181                 elsif($name eq "sv_catpvf") {
 182                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 183                     $args[0] =~ /(\w+)\W*$/;
 184                     $arg0 = $1;
 185                     $args[1] =~ /(\w+)\W*$/;
 186                     $arg1 = $1;
 187                     print OUTFILE <<ENDCODE;
 188
 189 #undef $name
 190 extern "C" $type $funcName ($args)
 191 {
 192     va_list args;
 193     va_start(args, $arg1);
 194     pPerl->Perl_sv_vcatpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
 195     va_end(args);
 196 }
 197 ENDCODE
 198                     print OUTFILE "#endif\n" unless ($separateObj == 0);
 199                 }
 200                 elsif($name eq "sv_setpvf") {
 201                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 202                     $args[0] =~ /(\w+)\W*$/;
 203                     $arg0 = $1;
 204                     $args[1] =~ /(\w+)\W*$/;
 205                     $arg1 = $1;
 206                     print OUTFILE <<ENDCODE;
 207
 208 #undef $name
 209 extern "C" $type $funcName ($args)
 210 {
 211     va_list args;
 212     va_start(args, $arg1);
 213     pPerl->Perl_sv_vsetpvfn($arg0, $arg1, strlen($arg1), &args, NULL, 0, NULL);
 214     va_end(args);
 215 }
 216 ENDCODE
 217                     print OUTFILE "#endif\n" unless ($separateObj == 0);
 218                 }
 219                 elsif($name eq "fprintf") {
 220                     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 221                     $args[0] =~ /(\w+)\W*$/;
 222                     $arg0 = $1;
 223                     $args[1] =~ /(\w+)\W*$/;
 224                     $arg1 = $1;
 225                     print OUTFILE <<ENDCODE;
 226
 227 #undef $name
 228 extern "C" $type $name ($args)
 229 {
 230     int nRet;
 231     va_list args;
 232     va_start(args, $arg1);
 233     nRet = PerlIO_vprintf($arg0, $arg1, args);
 234     va_end(args);
 235     return nRet;
 236 }
 237 ENDCODE
 238                     print OUTFILE "#endif\n" unless ($separateObj == 0);
 239                 } else {
 240                     print "Warning: can't handle varargs function '$name'\n";
 241                 }
 242                 next;
 243             }
 244
 245             # newXS special case
 246             if ($name eq "newXS") {
 247                 next;
 248             }
 249
 250             print OUTFILE "\n#ifdef $name" . "defined" unless ($separateObj == 0);
 251
 252             # handle specical case for save_destructor
 253             if ($name eq "save_destructor") {
 254                 next;
 255             }
 256             # handle specical case for sighandler
 257             if ($name eq "sighandler") {
 258                 next;
 259             }
 260             # handle special case for sv_grow
 261             if ($name eq "sv_grow" and $args eq "SV* sv, unsigned long newlen") {
 262                 next;
 263             }
 264             # handle special case for newSV
 265             if ($name eq "newSV" and $args eq "I32 x, STRLEN len") {
 266                 next;
 267             }
 268             # handle special case for perl_parse
 269             if ($name eq "perl_parse") {
 270                 print OUTFILE <<ENDCODE;
 271
 272 #undef $name
 273 extern "C" $type $name ($args)
 274 {
 275     return pPerl->perl_parse(xsinit, argc, argv, env);
 276 }
 277 ENDCODE
 278                 print OUTFILE "#endif\n" unless ($separateObj == 0);
 279                 next;
 280             }
 281
 282             # foo(void);
 283             if ($args eq "void") {
 284                 print OUTFILE <<ENDCODE;
 285
 286 #undef $name
 287 extern "C" $type $funcName ()
 288 {
 289 $return pPerl->$funcName();
 290 }
 291
 292 ENDCODE
 293                 print OUTFILE "#endif\n" unless ($separateObj == 0);
 294                 next;
 295             }
 296
 297             # foo(char *s, const int bar);
 298             print OUTFILE <<ENDCODE;
 299
 300 #undef $name
 301 extern "C" $type $funcName ($args)
 302 {
 303 $return pPerl->$funcName
 304 ENDCODE
 305
 306             $doneone = 0;
 307             foreach $arg (@args) {
 308                 if ($arg =~ /(\w+)\W*$/) {
 309                     if ($doneone) {
 310                         print OUTFILE ", $1";
 311                     }
 312                     else {
 313                         print OUTFILE "($1";
 314                         $doneone++;
 315                     }
 316                 }
 317             }
 318             print OUTFILE ");\n}\n";
 319             print OUTFILE "#endif\n" unless ($separateObj == 0);
 320         }
 321         else {
 322             print "failed to match $_";
 323         }
 324     }
 325 }
 326
 327 close INFILE;
 328
 329 %skip_list = ();
 330
 331 skip_these [qw(
 332 strchop
 333 filemode
 334 lastfd
 335 oldname
 336 curinterp
 337 Argv
 338 Cmd
 339 sortcop
 340 sortstash
 341 firstgv
 342 secondgv
 343 sortstack
 344 signalstack
 345 mystrk
 346 dumplvl
 347 oldlastpm
 348 gensym
 349 preambled
 350 preambleav
 351 Ilaststatval
 352 Ilaststype
 353 mess_sv
 354 ors
 355 opsave
 356 eval_mutex
 357 orslen
 358 ofmt
 359 mh
 360 modcount
 361 generation
 362 DBcv
 363 archpat_auto
 364 sortcxix
 365 lastgotoprobe
 366 regdummy
 367 regparse
 368 regxend
 369 regcode
 370 regnaughty
 371 regsawback
 372 regprecomp
 373 regnpar
 374 regsize
 375 regflags
 376 regseen
 377 seen_zerolen
 378 rx
 379 extralen
 380 colorset
 381 colors
 382 reginput
 383 regbol
 384 regeol
 385 regstartp
 386 regendp
 387 reglastparen
 388 regtill
 389 regprev
 390 reg_start_tmp
 391 reg_start_tmpl
 392 regdata
 393 bostr
 394 reg_flags
 395 reg_eval_set
 396 regnarrate
 397 regprogram
 398 regindent
 399 regcc
 400 in_clean_objs
 401 in_clean_all
 402 linestart
 403 pending_ident
 404 statusvalue_vms
 405 sublex_info
 406 thrsv
 407 threadnum
 408 piMem
 409 piENV
 410 piStdIO
 411 piLIO
 412 piDir
 413 piSock
 414 piProc
 415 cshname
 416 threadsv_names
 417 thread
 418 nthreads
 419 thr_key
 420 threads_mutex
 421 malloc_mutex
 422 svref_mutex
 423 sv_mutex
 424 nthreads_cond
 425 eval_cond
 426 cryptseen
 427 cshlen
 428 )];
 429
 430 sub readvars(\%$$) {
 431     my ($syms, $file, $pre) = @_;
 432     %$syms = ();
 433     local (*FILE, $_);
 434     open(FILE, "< $file")
 435         or die "$0: Can't open $file: $!\n";
 436     while (<FILE>) {
 437         s/[ \t]*#.*//;          # Delete comments.
 438         if (/PERLVARI?C?\($pre(\w+),\s*([^,)]+)/) {
 439             $$syms{$1} = $2;
 440         }
 441     }
 442     close(FILE);
 443 }
 444
 445 my %intrp;
 446 my %thread;
 447 my %globvar;
 448
 449 readvars %intrp,  '..\intrpvar.h','I';
 450 readvars %thread, '..\thrdvar.h','T';
 451 readvars %globvar, '..\perlvars.h','G';
 452
 453 open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n";
 454 print HDRFILE <<ENDCODE;
 455 void SetCPerlObj(void* pP);
 456 CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);
 457
 458 ENDCODE
 459
 460 sub DoVariable($$) {
 461     my $name = shift;
 462     my $type = shift;
 463
 464     return if (defined $skip_list{$name});
 465     return if ($type eq 'struct perl_thread *');
 466
 467     print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
 468     print OUTFILE <<ENDCODE;
 469 extern "C" $type * _Perl_$name ()
 470 {
 471     return (($type *)&pPerl->Perl_$name);
 472 }
 473
 474 ENDCODE
 475
 476     print OUTFILE "#endif\n" unless ($separateObj == 0);
 477
 478     print HDRFILE <<ENDCODE;
 479
 480 #undef Perl_$name
 481 $type * _Perl_$name ();
 482 #define Perl_$name (*_Perl_$name())
 483
 484 ENDCODE
 485
 486 }
 487
 488 foreach $key (keys %intrp) {
 489     DoVariable ($key, $intrp{$key});
 490 }
 491
 492 foreach $key (keys %thread) {
 493     DoVariable ($key, $thread{$key});
 494 }
 495
 496 foreach $key (keys %globvar) {
 497     DoVariable ($key, $globvar{$key});
 498 }
 499
 500 print OUTFILE <<EOCODE;
 501
 502
 503 extern "C" {
 504 void xs_handler(CV* cv, CPerlObj* p)
 505 {
 506     void(*func)(CV*);
 507     SV* sv;
 508     MAGIC* m = pPerl->Perl_mg_find((SV*)cv, '~');
 509     if(m != NULL)
 510     {
 511         sv = m->mg_obj;
 512         if(SvIOK(sv))
 513         {
 514             func = (void(*)(CV*))SvIVX(sv);
 515         }
 516         else
 517         {
 518             func = (void(*)(CV*))pPerl->Perl_sv_2iv(sv);
 519         }
 520         func(cv);
 521     }
 522 }
 523
 524 CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename)
 525 {
 526     CV* cv = pPerl->Perl_newXS(name, xs_handler, filename);
 527     pPerl->Perl_sv_magic((SV*)cv, pPerl->Perl_sv_2mortal(pPerl->Perl_newSViv((IV)subaddr)), '~', "CAPI", 4);
 528     return cv;
 529 }
 530
 531
 532 void Perl_deb(const char pat, ...)
 533 {
 534 }
 535
 536 #undef piMem
 537 #undef piENV
 538 #undef piStdIO
 539 #undef piLIO
 540 #undef piDir
 541 #undef piSock
 542 #undef piProc
 543
 544 int *        _win32_errno(void)
 545 {
 546     return &pPerl->ErrorNo();
 547 }
 548
 549 FILE*        _win32_stdin(void)
 550 {
 551     return (FILE*)pPerl->piStdIO->Stdin();
 552 }
 553
 554 FILE*        _win32_stdout(void)
 555 {
 556     return (FILE*)pPerl->piStdIO->Stdout();
 557 }
 558
 559 FILE*        _win32_stderr(void)
 560 {
 561     return (FILE*)pPerl->piStdIO->Stderr();
 562 }
 563
 564 int          _win32_ferror(FILE *fp)
 565 {
 566     return pPerl->piStdIO->Error((PerlIO*)fp, ErrorNo());
 567 }
 568
 569 int          _win32_feof(FILE *fp)
 570 {
 571     return pPerl->piStdIO->Eof((PerlIO*)fp, ErrorNo());
 572 }
 573
 574 char*        _win32_strerror(int e)
 575 {
 576     return strerror(e);
 577 }
 578
 579 void         _win32_perror(const char *str)
 580 {
 581     perror(str);
 582 }
 583
 584 int          _win32_vfprintf(FILE *pf, const char *format, va_list arg)
 585 {
 586     return pPerl->piStdIO->Vprintf((PerlIO*)pf, ErrorNo(), format, arg);
 587 }
 588
 589 int          _win32_vprintf(const char *format, va_list arg)
 590 {
 591     return pPerl->piStdIO->Vprintf(pPerl->piStdIO->Stdout(), ErrorNo(), format, arg);
 592 }
 593
 594 int          _win32_fprintf(FILE *pf, const char *format, ...)
 595 {
 596     int ret;
 597     va_list args;
 598     va_start(args, format);
 599     ret = _win32_vfprintf(pf, format, args);
 600     va_end(args);
 601     return ret;
 602 }
 603
 604 int          _win32_printf(const char *format, ...)
 605 {
 606     int ret;
 607     va_list args;
 608     va_start(args, format);
 609     ret = _win32_vprintf(format, args);
 610     va_end(args);
 611     return ret;
 612 }
 613
 614 size_t       _win32_fread(void *buf, size_t size, size_t count, FILE *pf)
 615 {
 616     return pPerl->piStdIO->Read((PerlIO*)pf, buf, (size*count), ErrorNo());
 617 }
 618
 619 size_t       _win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf)
 620 {
 621     return pPerl->piStdIO->Write((PerlIO*)pf, buf, (size*count), ErrorNo());
 622 }
 623
 624 FILE*        _win32_fopen(const char *path, const char *mode)
 625 {
 626     return (FILE*)pPerl->piStdIO->Open(path, mode, ErrorNo());
 627 }
 628
 629 FILE*        _win32_fdopen(int fh, const char *mode)
 630 {
 631     return (FILE*)pPerl->piStdIO->Fdopen(fh, mode, ErrorNo());
 632 }
 633
 634 FILE*        _win32_freopen(const char *path, const char *mode, FILE *pf)
 635 {
 636     return (FILE*)pPerl->piStdIO->Reopen(path, mode, (PerlIO*)pf, ErrorNo());
 637 }
 638
 639 int          _win32_fclose(FILE *pf)
 640 {
 641     return pPerl->piStdIO->Close((PerlIO*)pf, ErrorNo());
 642 }
 643
 644 int          _win32_fputs(const char *s,FILE *pf)
 645 {
 646     return pPerl->piStdIO->Puts((PerlIO*)pf, s, ErrorNo());
 647 }
 648
 649 int          _win32_fputc(int c,FILE *pf)
 650 {
 651     return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo());
 652 }
 653
 654 int          _win32_ungetc(int c,FILE *pf)
 655 {
 656     return pPerl->piStdIO->Ungetc((PerlIO*)pf, c, ErrorNo());
 657 }
 658
 659 int          _win32_getc(FILE *pf)
 660 {
 661     return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo());
 662 }
 663
 664 int          _win32_fileno(FILE *pf)
 665 {
 666     return pPerl->piStdIO->Fileno((PerlIO*)pf, ErrorNo());
 667 }
 668
 669 void         _win32_clearerr(FILE *pf)
 670 {
 671     pPerl->piStdIO->Clearerr((PerlIO*)pf, ErrorNo());
 672 }
 673
 674 int          _win32_fflush(FILE *pf)
 675 {
 676     return pPerl->piStdIO->Flush((PerlIO*)pf, ErrorNo());
 677 }
 678
 679 long         _win32_ftell(FILE *pf)
 680 {
 681     return pPerl->piStdIO->Tell((PerlIO*)pf, ErrorNo());
 682 }
 683
 684 int          _win32_fseek(FILE *pf,long offset,int origin)
 685 {
 686     return pPerl->piStdIO->Seek((PerlIO*)pf, offset, origin, ErrorNo());
 687 }
 688
 689 int          _win32_fgetpos(FILE *pf,fpos_t *p)
 690 {
 691     return pPerl->piStdIO->Getpos((PerlIO*)pf, p, ErrorNo());
 692 }
 693
 694 int          _win32_fsetpos(FILE *pf,const fpos_t *p)
 695 {
 696     return pPerl->piStdIO->Setpos((PerlIO*)pf, p, ErrorNo());
 697 }
 698
 699 void         _win32_rewind(FILE *pf)
 700 {
 701     pPerl->piStdIO->Rewind((PerlIO*)pf, ErrorNo());
 702 }
 703
 704 FILE*        _win32_tmpfile(void)
 705 {
 706     return (FILE*)pPerl->piStdIO->Tmpfile(ErrorNo());
 707 }
 708
 709 void         _win32_setbuf(FILE *pf, char *buf)
 710 {
 711     pPerl->piStdIO->SetBuf((PerlIO*)pf, buf, ErrorNo());
 712 }
 713
 714 int          _win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
 715 {
 716     return pPerl->piStdIO->SetVBuf((PerlIO*)pf, buf, type, size, ErrorNo());
 717 }
 718
 719 int          _win32_fgetc(FILE *pf)
 720 {
 721     return pPerl->piStdIO->Getc((PerlIO*)pf, ErrorNo());
 722 }
 723
 724 int          _win32_putc(int c, FILE *pf)
 725 {
 726     return pPerl->piStdIO->Putc((PerlIO*)pf, c, ErrorNo());
 727 }
 728
 729 int          _win32_puts(const char *s)
 730 {
 731     return pPerl->piStdIO->Puts(pPerl->piStdIO->Stdout(), s, ErrorNo());
 732 }
 733
 734 int          _win32_getchar(void)
 735 {
 736     return pPerl->piStdIO->Getc(pPerl->piStdIO->Stdin(), ErrorNo());
 737 }
 738
 739 int          _win32_putchar(int c)
 740 {
 741     return pPerl->piStdIO->Putc(pPerl->piStdIO->Stdout(), c, ErrorNo());
 742 }
 743
 744 void*        _win32_malloc(size_t size)
 745 {
 746     return pPerl->piMem->Malloc(size);
 747 }
 748
 749 void*        _win32_calloc(size_t numitems, size_t size)
 750 {
 751     return pPerl->piMem->Malloc(numitems*size);
 752 }
 753
 754 void*        _win32_realloc(void *block, size_t size)
 755 {
 756     return pPerl->piMem->Realloc(block, size);
 757 }
 758
 759 void         _win32_free(void *block)
 760 {
 761     pPerl->piMem->Free(block);
 762 }
 763
 764 void         _win32_abort(void)
 765 {
 766     pPerl->piProc->Abort();
 767 }
 768
 769 int          _win32_pipe(int *phandles, unsigned int psize, int textmode)
 770 {
 771     return pPerl->piProc->Pipe(phandles);
 772 }
 773
 774 FILE*        _win32_popen(const char *command, const char *mode)
 775 {
 776     return (FILE*)pPerl->piProc->Popen(command, mode);
 777 }
 778
 779 int          _win32_pclose(FILE *pf)
 780 {
 781     return pPerl->piProc->Pclose((PerlIO*)pf);
 782 }
 783
 784 unsigned     _win32_sleep(unsigned int t)
 785 {
 786     return pPerl->piProc->Sleep(t);
 787 }
 788
 789 int     _win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 790 {
 791     return pPerl->piProc->Spawnvp(mode, cmdname, argv);
 792 }
 793
 794 int          _win32_mkdir(const char *dir, int mode)
 795 {
 796     return pPerl->piDir->Makedir(dir, mode, ErrorNo());
 797 }
 798
 799 int          _win32_rmdir(const char *dir)
 800 {
 801     return pPerl->piDir->Rmdir(dir, ErrorNo());
 802 }
 803
 804 int          _win32_chdir(const char *dir)
 805 {
 806     return pPerl->piDir->Chdir(dir, ErrorNo());
 807 }
 808
 809 #undef stat
 810 int          _win32_fstat(int fd,struct stat *sbufptr)
 811 {
 812     return pPerl->piLIO->FileStat(fd, sbufptr, ErrorNo());
 813 }
 814
 815 int          _win32_stat(const char *name,struct stat *sbufptr)
 816 {
 817     return pPerl->piLIO->NameStat(name, sbufptr, ErrorNo());
 818 }
 819
 820 int          _win32_setmode(int fd, int mode)
 821 {
 822     return pPerl->piLIO->Setmode(fd, mode, ErrorNo());
 823 }
 824
 825 long         _win32_lseek(int fd, long offset, int origin)
 826 {
 827     return pPerl->piLIO->Lseek(fd, offset, origin, ErrorNo());
 828 }
 829
 830 long         _win32_tell(int fd)
 831 {
 832     return pPerl->piStdIO->Tell((PerlIO*)fd, ErrorNo());
 833 }
 834
 835 int          _win32_dup(int fd)
 836 {
 837     return pPerl->piLIO->Dup(fd, ErrorNo());
 838 }
 839
 840 int          _win32_dup2(int h1, int h2)
 841 {
 842     return pPerl->piLIO->Dup2(h1, h2, ErrorNo());
 843 }
 844
 845 int          _win32_open(const char *path, int oflag,...)
 846 {
 847     return pPerl->piLIO->Open(path, oflag, ErrorNo());
 848 }
 849
 850 int          _win32_close(int fd)
 851 {
 852     return pPerl->piLIO->Close(fd, ErrorNo());
 853 }
 854
 855 int          _win32_read(int fd, void *buf, unsigned int cnt)
 856 {
 857     return pPerl->piLIO->Read(fd, buf, cnt, ErrorNo());
 858 }
 859
 860 int          _win32_write(int fd, const void *buf, unsigned int cnt)
 861 {
 862     return pPerl->piLIO->Write(fd, buf, cnt, ErrorNo());
 863 }
 864
 865 int          _win32_times(struct tms *timebuf)
 866 {
 867     return pPerl->piProc->Times(timebuf);
 868 }
 869
 870 int          _win32_ioctl(int i, unsigned int u, char *data)
 871 {
 872     return pPerl->piLIO->IOCtl(i, u, data, ErrorNo());
 873 }
 874
 875 int          _win32_utime(const char *f, struct utimbuf *t)
 876 {
 877     return pPerl->piLIO->Utime((char*)f, t, ErrorNo());
 878 }
 879
 880 char*   _win32_getenv(const char *name)
 881 {
 882     return pPerl->piENV->Getenv(name, ErrorNo());
 883 }
 884
 885 int          _win32_open_osfhandle(long handle, int flags)
 886 {
 887     return pPerl->piStdIO->OpenOSfhandle(handle, flags);
 888 }
 889
 890 long         _win32_get_osfhandle(int fd)
 891 {
 892     return pPerl->piStdIO->GetOSfhandle(fd);
 893 }
 894 } /* extern "C" */
 895 EOCODE
 896
 897
 898 print HDRFILE <<EOCODE;
 899 #undef win32_errno
 900 #undef win32_stdin
 901 #undef win32_stdout
 902 #undef win32_stderr
 903 #undef win32_ferror
 904 #undef win32_feof
 905 #undef win32_fprintf
 906 #undef win32_printf
 907 #undef win32_vfprintf
 908 #undef win32_vprintf
 909 #undef win32_fread
 910 #undef win32_fwrite
 911 #undef win32_fopen
 912 #undef win32_fdopen
 913 #undef win32_freopen
 914 #undef win32_fclose
 915 #undef win32_fputs
 916 #undef win32_fputc
 917 #undef win32_ungetc
 918 #undef win32_getc
 919 #undef win32_fileno
 920 #undef win32_clearerr
 921 #undef win32_fflush
 922 #undef win32_ftell
 923 #undef win32_fseek
 924 #undef win32_fgetpos
 925 #undef win32_fsetpos
 926 #undef win32_rewind
 927 #undef win32_tmpfile
 928 #undef win32_abort
 929 #undef win32_fstat
 930 #undef win32_stat
 931 #undef win32_pipe
 932 #undef win32_popen
 933 #undef win32_pclose
 934 #undef win32_setmode
 935 #undef win32_lseek
 936 #undef win32_tell
 937 #undef win32_dup
 938 #undef win32_dup2
 939 #undef win32_open
 940 #undef win32_close
 941 #undef win32_eof
 942 #undef win32_read
 943 #undef win32_write
 944 #undef win32_mkdir
 945 #undef win32_rmdir
 946 #undef win32_chdir
 947 #undef win32_setbuf
 948 #undef win32_setvbuf
 949 #undef win32_fgetc
 950 #undef win32_putc
 951 #undef win32_puts
 952 #undef win32_getchar
 953 #undef win32_putchar
 954 #undef win32_malloc
 955 #undef win32_calloc
 956 #undef win32_realloc
 957 #undef win32_free
 958 #undef win32_sleep
 959 #undef win32_times
 960 #undef win32_stat
 961 #undef win32_ioctl
 962 #undef win32_utime
 963 #undef win32_getenv
 964
 965 #define win32_errno    _win32_errno
 966 #define win32_stdin    _win32_stdin
 967 #define win32_stdout   _win32_stdout
 968 #define win32_stderr   _win32_stderr
 969 #define win32_ferror   _win32_ferror
 970 #define win32_feof     _win32_feof
 971 #define win32_strerror _win32_strerror
 972 #define win32_perror   _win32_perror
 973 #define win32_fprintf  _win32_fprintf
 974 #define win32_printf   _win32_printf
 975 #define win32_vfprintf _win32_vfprintf
 976 #define win32_vprintf  _win32_vprintf
 977 #define win32_fread    _win32_fread
 978 #define win32_fwrite   _win32_fwrite
 979 #define win32_fopen    _win32_fopen
 980 #define win32_fdopen   _win32_fdopen
 981 #define win32_freopen  _win32_freopen
 982 #define win32_fclose   _win32_fclose
 983 #define win32_fputs    _win32_fputs
 984 #define win32_fputc    _win32_fputc
 985 #define win32_ungetc   _win32_ungetc
 986 #define win32_getc     _win32_getc
 987 #define win32_fileno   _win32_fileno
 988 #define win32_clearerr _win32_clearerr
 989 #define win32_fflush   _win32_fflush
 990 #define win32_ftell    _win32_ftell
 991 #define win32_fseek    _win32_fseek
 992 #define win32_fgetpos  _win32_fgetpos
 993 #define win32_fsetpos  _win32_fsetpos
 994 #define win32_rewind   _win32_rewind
 995 #define win32_tmpfile  _win32_tmpfile
 996 #define win32_abort    _win32_abort
 997 #define win32_fstat    _win32_fstat
 998 #define win32_stat     _win32_stat
 999 #define win32_pipe     _win32_pipe
1000 #define win32_popen    _win32_popen
1001 #define win32_pclose   _win32_pclose
1002 #define win32_setmode  _win32_setmode
1003 #define win32_lseek    _win32_lseek
1004 #define win32_tell     _win32_tell
1005 #define win32_dup      _win32_dup
1006 #define win32_dup2     _win32_dup2
1007 #define win32_open     _win32_open
1008 #define win32_close    _win32_close
1009 #define win32_eof      _win32_eof
1010 #define win32_read     _win32_read
1011 #define win32_write    _win32_write
1012 #define win32_mkdir    _win32_mkdir
1013 #define win32_rmdir    _win32_rmdir
1014 #define win32_chdir    _win32_chdir
1015 #define win32_setbuf   _win32_setbuf
1016 #define win32_setvbuf  _win32_setvbuf
1017 #define win32_fgetc    _win32_fgetc
1018 #define win32_putc     _win32_putc
1019 #define win32_puts     _win32_puts
1020 #define win32_getchar  _win32_getchar
1021 #define win32_putchar  _win32_putchar
1022 #define win32_malloc   _win32_malloc
1023 #define win32_calloc   _win32_calloc
1024 #define win32_realloc  _win32_realloc
1025 #define win32_free     _win32_free
1026 #define win32_sleep    _win32_sleep
1027 #define win32_spawnvp  _win32_spawnvp
1028 #define win32_times    _win32_times
1029 #define win32_stat     _win32_stat
1030 #define win32_ioctl    _win32_ioctl
1031 #define win32_utime    _win32_utime
1032 #define win32_getenv   _win32_getenv
1033 #define win32_open_osfhandle _win32_open_osfhandle
1034 #define win32_get_osfhandle  _win32_get_osfhandle
1035
1036 int *   _win32_errno(void);
1037 FILE*   _win32_stdin(void);
1038 FILE*   _win32_stdout(void);
1039 FILE*   _win32_stderr(void);
1040 int     _win32_ferror(FILE *fp);
1041 int     _win32_feof(FILE *fp);
1042 char*   _win32_strerror(int e);
1043 void    _win32_perror(const char *str);
1044 int     _win32_fprintf(FILE *pf, const char *format, ...);
1045 int     _win32_printf(const char *format, ...);
1046 int     _win32_vfprintf(FILE *pf, const char *format, va_list arg);
1047 int     _win32_vprintf(const char *format, va_list arg);
1048 size_t  _win32_fread(void *buf, size_t size, size_t count, FILE *pf);
1049 size_t  _win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf);
1050 FILE*   _win32_fopen(const char *path, const char *mode);
1051 FILE*   _win32_fdopen(int fh, const char *mode);
1052 FILE*   _win32_freopen(const char *path, const char *mode, FILE *pf);
1053 int     _win32_fclose(FILE *pf);
1054 int     _win32_fputs(const char *s,FILE *pf);
1055 int     _win32_fputc(int c,FILE *pf);
1056 int     _win32_ungetc(int c,FILE *pf);
1057 int     _win32_getc(FILE *pf);
1058 int     _win32_fileno(FILE *pf);
1059 void    _win32_clearerr(FILE *pf);
1060 int     _win32_fflush(FILE *pf);
1061 long    _win32_ftell(FILE *pf);
1062 int     _win32_fseek(FILE *pf,long offset,int origin);
1063 int     _win32_fgetpos(FILE *pf,fpos_t *p);
1064 int     _win32_fsetpos(FILE *pf,const fpos_t *p);
1065 void    _win32_rewind(FILE *pf);
1066 FILE*   _win32_tmpfile(void);
1067 void    _win32_abort(void);
1068 int     _win32_fstat(int fd,struct stat *sbufptr);
1069 int     _win32_stat(const char *name,struct stat *sbufptr);
1070 int     _win32_pipe( int *phandles, unsigned int psize, int textmode );
1071 FILE*   _win32_popen( const char *command, const char *mode );
1072 int     _win32_pclose( FILE *pf);
1073 int     _win32_setmode( int fd, int mode);
1074 long    _win32_lseek( int fd, long offset, int origin);
1075 long    _win32_tell( int fd);
1076 int     _win32_dup( int fd);
1077 int     _win32_dup2(int h1, int h2);
1078 int     _win32_open(const char *path, int oflag,...);
1079 int     _win32_close(int fd);
1080 int     _win32_eof(int fd);
1081 int     _win32_read(int fd, void *buf, unsigned int cnt);
1082 int     _win32_write(int fd, const void *buf, unsigned int cnt);
1083 int     _win32_mkdir(const char *dir, int mode);
1084 int     _win32_rmdir(const char *dir);
1085 int     _win32_chdir(const char *dir);
1086 void    _win32_setbuf(FILE *pf, char *buf);
1087 int     _win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
1088 char*   _win32_fgets(char *s, int n, FILE *pf);
1089 char*   _win32_gets(char *s);
1090 int     _win32_fgetc(FILE *pf);
1091 int     _win32_putc(int c, FILE *pf);
1092 int     _win32_puts(const char *s);
1093 int     _win32_getchar(void);
1094 int     _win32_putchar(int c);
1095 void*   _win32_malloc(size_t size);
1096 void*   _win32_calloc(size_t numitems, size_t size);
1097 void*   _win32_realloc(void *block, size_t size);
1098 void    _win32_free(void *block);
1099 unsigned _win32_sleep(unsigned int);
1100 int     _win32_spawnvp(int mode, const char *cmdname, const char *const *argv);
1101 int     _win32_times(struct tms *timebuf);
1102 int     _win32_stat(const char *path, struct stat *buf);
1103 int     _win32_ioctl(int i, unsigned int u, char *data);
1104 int     _win32_utime(const char *f, struct utimbuf *t);
1105 char*   _win32_getenv(const char *name);
1106 int     _win32_open_osfhandle(long handle, int flags);
1107 long    _win32_get_osfhandle(int fd);
1108
1109 #pragma warning(once : 4113)
1110 EOCODE
1111
1112
1113 close HDRFILE;
1114 close OUTFILE;