From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Mon, 5 Mar 2001 19:47:57 +0000 (+0000)
Subject: Integrate mainline (mostly - holding of on Encode.pm for a bit.)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c130f5bf137a33b7d9b08f028572692c4035032;p=p5sagit%2Fp5-mst-13.2.git

Integrate mainline (mostly - holding of on Encode.pm for a bit.)

p4raw-id: //depot/perlio@9048
---

diff --git a/lib/ExtUtils/MM_OS2.pm b/lib/ExtUtils/MM_OS2.pm
index c0c5240..d6bbc1c 100644
--- a/lib/ExtUtils/MM_OS2.pm
+++ b/lib/ExtUtils/MM_OS2.pm
@@ -97,6 +97,22 @@ sub perl_archive
  return "\$(PERL_INC)/libperl\$(LIB_EXT)";
 }
 
+=item perl_archive_after
+
+This is an internal method that returns path to a library which
+should be put on the linker command line I<after> the external libraries
+to be linked to dynamic extensions.  This may be needed if the linker
+is one-pass, and Perl includes some overrides for C RTL functions,
+such as malloc().
+
+=cut 
+
+sub perl_archive_after
+{
+ return "\$(PERL_INC)/libperl_override\$(LIB_EXT)" unless $OS2::is_aout;
+ return "";
+}
+
 sub export_list
 {
  my ($self) = @_;
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index d7dd720..e043b3c 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -210,6 +210,7 @@ sub ExtUtils::MM_Unix::parse_version ;
 sub ExtUtils::MM_Unix::pasthru ;
 sub ExtUtils::MM_Unix::path ;
 sub ExtUtils::MM_Unix::perl_archive;
+sub ExtUtils::MM_Unix::perl_archive_after;
 sub ExtUtils::MM_Unix::perl_script ;
 sub ExtUtils::MM_Unix::perldepend ;
 sub ExtUtils::MM_Unix::pm_to_blib ;
@@ -684,6 +685,10 @@ EXPORT_LIST = $tmp
     push @m, "
 PERL_ARCHIVE = $tmp
 ";
+    $tmp = $self->perl_archive_after;
+    push @m, "
+PERL_ARCHIVE_AFTER = $tmp
+";
 
 #    push @m, q{
 #INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{
@@ -1071,7 +1076,7 @@ ARMAYBE = '.$armaybe.'
 OTHERLDFLAGS = '.$otherldflags.'
 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
 
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
 ');
     if ($armaybe ne ':'){
 	$ldfrom = 'tmp$(LIB_EXT)';
@@ -1081,7 +1086,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
     $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
 
     # The IRIX linker doesn't use LD_RUN_PATH
-    $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"}
+    my $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"}
 	if ($^O eq 'irix' && $self->{LD_RUN_PATH});
 
     # For example in AIX the shared objects/libraries from previous builds
@@ -1093,7 +1098,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
 ');
 
     push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
-		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
+		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)');
     push @m, '
 	$(CHMOD) $(PERM_RWX) $@
 ';
@@ -2514,7 +2519,7 @@ MAP_LIBPERL = $libperl
 
 push @m, "
 \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
-	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) $ldfrom \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
 	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
 	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
 	$self->{NOECHO}echo 'To remove the intermediate files say'
@@ -3122,6 +3127,7 @@ sub processPL {
         my $list = ref($self->{PL_FILES}->{$plfile})
 		? $self->{PL_FILES}->{$plfile}
 		: [$self->{PL_FILES}->{$plfile}];
+	my $target;
 	foreach $target (@$list) {
 	push @m, "
 all :: $target
@@ -3828,6 +3834,21 @@ sub perl_archive
  return "";
 }
 
+=item perl_archive_after
+
+This is an internal method that returns path to a library which
+should be put on the linker command line I<after> the external libraries
+to be linked to dynamic extensions.  This may be needed if the linker
+is one-pass, and Perl includes some overrides for C RTL functions,
+such as malloc().
+
+=cut 
+
+sub perl_archive_after
+{
+ return "";
+}
+
 =item export_list
 
 This is internal method that returns name of a file that is
diff --git a/makedef.pl b/makedef.pl
index 02305c2..da0b36c 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -277,6 +277,8 @@ elsif ($PLATFORM eq 'os2') {
 		    my_tmpfile
 		    my_tmpnam
 		    my_flock
+		    my_rmdir
+		    my_mkdir
 		    malloc_mutex
 		    threads_mutex
 		    nthreads
@@ -389,6 +391,8 @@ if ($define{'MYMALLOC'}) {
 		    Perl_mfree
 		    Perl_realloc
 		    Perl_calloc
+		    Perl_strdup
+		    Perl_putenv
 		    )];
     if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
 	emit_symbols [qw(
diff --git a/op.c b/op.c
index 4c5dd13..13fe21b 100644
--- a/op.c
+++ b/op.c
@@ -843,6 +843,29 @@ S_op_clear(pTHX_ OP *o)
     case OP_MATCH:
     case OP_QR:
 clear_pmop:
+	{
+	    HV *pmstash = PmopSTASH(cPMOPo);
+	    if (pmstash) {
+		PMOP *pmop = HvPMROOT(pmstash);
+		PMOP *lastpmop = NULL;
+		while (pmop) {
+		    if (cPMOPo == pmop) {
+			if (lastpmop)
+			    lastpmop->op_pmnext = pmop->op_pmnext;
+			else
+			    HvPMROOT(pmstash) = pmop->op_pmnext;
+			break;
+		    }
+		    lastpmop = pmop;
+		    pmop = pmop->op_pmnext;
+		}
+#ifdef USE_ITHREADS
+		Safefree(PmopSTASHPV(cPMOPo));
+#else
+		/* NOTE: PMOP.op_pmstash is not refcounted */
+#endif
+	    }
+	}
 	cPMOPo->op_pmreplroot = Nullop;
 	ReREFCNT_dec(cPMOPo->op_pmregexp);
 	cPMOPo->op_pmregexp = (REGEXP*)NULL;
@@ -2934,6 +2957,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     if (type != OP_TRANS && PL_curstash) {
 	pmop->op_pmnext = HvPMROOT(PL_curstash);
 	HvPMROOT(PL_curstash) = pmop;
+	PmopSTASH_set(pmop,PL_curstash);
     }
 
     return (OP*)pmop;
diff --git a/op.h b/op.h
index b1b11a5..f3bc515 100644
--- a/op.h
+++ b/op.h
@@ -242,6 +242,11 @@ struct pmop {
     U16		op_pmflags;
     U16		op_pmpermflags;
     U8		op_pmdynflags;
+#ifdef USE_ITHREADS
+    char *	op_pmstashpv;
+#else
+    HV *	op_pmstash;
+#endif
 };
 
 #define PMdf_USED	0x01		/* pm has been used once already */
@@ -271,6 +276,20 @@ struct pmop {
 /* mask of bits stored in regexp->reganch */
 #define PMf_COMPILETIME	(PMf_MULTILINE|PMf_SINGLELINE|PMf_LOCALE|PMf_FOLD|PMf_EXTENDED)
 
+#ifdef USE_ITHREADS
+#  define PmopSTASHPV(o)	((o)->op_pmstashpv)
+#  define PmopSTASHPV_set(o,pv)	((o)->op_pmstashpv = ((pv) ? savepv(pv) : Nullch))
+#  define PmopSTASH(o)		(PmopSTASHPV(o) \
+				 ? gv_stashpv(PmopSTASHPV(o),GV_ADD) : Nullhv)
+#  define PmopSTASH_set(o,hv)	PmopSTASHPV_set(o, (hv) ? HvNAME(hv) : Nullch)
+#else
+#  define PmopSTASH(o)		((o)->op_pmstash)
+#  define PmopSTASH_set(o,hv)	((o)->op_pmstash = (hv))
+#  define PmopSTASHPV(o)	(PmopSTASH(o) ? HvNAME(PmopSTASH(o)) : Nullch)
+   /* op_pmstash is not refcounted */
+#  define PmopSTASHPV_set(o,pv)	PmopSTASH_set((o), gv_stashpv(pv,GV_ADD))
+#endif
+
 struct svop {
     BASEOP
     SV *	op_sv;
diff --git a/os2/Changes b/os2/Changes
index e56b708..e72e0bd 100644
--- a/os2/Changes
+++ b/os2/Changes
@@ -322,3 +322,68 @@ after 5.005_62:
 	  (alas, uppercased - but with /);
 	t/io/fs.t was failing on HPFS386;
 	Remove extra ';' from defines for MQ operations.
+
+pre 5.6.1:
+	Resolved: "Bad free()" messages (e.g., from DB_File) with -Zomf build.
+	   The reason was: when an extension DLL was linked, the order of
+	   libraries was similar to this:
+		f1.obj f2.obj libperl.lib -llibr1 -llibr2
+	   (with C RTL implicitly after this).  When libperl.lib overrides
+	   some C RTL functions, they are correctly resolved when mentioned
+	   in f1.obj and f2.obj.  However, the resolution for libr1.lib and
+	   libr2.lib is implementation-dependent.
+
+	   With -Zomf linking the symbols are resolved for libr1.lib and
+	   libr2.lib *only if* they reside in .obj-file-sections of libperl.lib
+	   which were already "picked up" for symbols in f1.obj f2.obj.
+	   However, libperl.lib is an import library for a .DLL, so *each
+	   symbol in libperl.lib sits in its own pseudo-section*!
+
+	   Corollary: only those symbol from libperl.lib which were already
+	   mentioned in f1.obj f2.obj would be used for libr1.lib and
+	   libr2.lib.  Example: if f1.obj f2.obj do not mention calloc() but
+	   libr1.lib and libr2.lib do, then .lib's will get calloc() of C RTL,
+	   not one of libperl.lib.
+
+	   Solution: create a small duplicate of libperl.lib with overriding
+	   symbols only.  Put it *after* -llibr1 -llibr2 on the link line.
+	   Map strdup() and putenv() to Perl_strdup() and Perl_putenv()
+	   inside this library.
+
+	Resolved: rmdir() and mkdir() do not accept trailing slashes.
+	   Wrappers are implemented.
+	Resolved: when loading modules, FP mask may be erroneously changed by
+	   _DLLInitTerm() (e.g., TCP32IP).
+		Solutions: a) dlopen() saves/restores the FP mask.
+			   b) When starting, reset FP mask to a sane value
+				(if the DLL was compile-time linked).
+	New functions in package OS2:
+		unsigned _control87(unsigned new,unsigned mask)	# as in EMX
+		unsigned get_control87()
+		# with default values good for handling exception mask:
+		unsigned set_control87_em(new=MCW_EM,mask=MCW_EM)
+	    Needed to guard against other situations when the FP mask is
+	    stompted upon.  Apparently, IBM used a compiler (for some period
+	    of time around '95?) which changes FP mask right and left...
+	Resolved: $^X was always uppercased (cosmetic).  Solution:
+	    use argv[0] if it differs from what the OS returns only in case.
+	Resolved: when creating PM message queues, WinCancelShutdown() was
+	    not called even if the application said that it would not serve
+	    messages in this queue.  Could result in PM refusing to shutdown.
+
+	    Solution: resolve WinCancelShutdown at run time, keep the refcount
+	    of who is going to serve the queue.
+	Resolved: Perl_Deregister_MQ() segfaulted (pid/tid not initialized).
+	Resolved: FillWinError() would not fetch the error.
+	    Solution: resolve WinGetLastError at run time, call it.
+	Resolved: OS2::REXX would ignore arguments given to a Perl function
+	    imported into the REXX compartment via REXX_eval_with().
+	Resolved: OS2::REXX would treat arguments given to a Perl function
+	    imported into the REXX compartment via _register() as ASCIIZ
+	    strings inside of binary strings.
+	Resolved: OS2::REXX did not document _register().
+	Resolved: OS2::REXX would not report the error to REXX if an error
+	    condition appeared during a call to Perl function from REXX
+	    compartment.  As a result, the return string was not initialized.
+	A complete example of a mini-application added to OS2::REXX.
+
diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs
index 21c99a5..c167226 100644
--- a/os2/Makefile.SHs
+++ b/os2/Makefile.SHs
@@ -41,9 +41,18 @@ CONFIG_ARGS	= $config_args
 !GROK!THIS!
 
 $spitshell >>Makefile <<'!NO!SUBS!'
-$(LIBPERL): perl.imp $(PERL_DLL) perl5.def
+$(LIBPERL): perl.imp $(PERL_DLL) perl5.def libperl_override.lib
 	emximp -o $(LIBPERL) perl.imp
 
+libperl_override.imp: os2/os2add.sym
+	./miniperl -wnle 'print "$$_\t$(PERL_DLL_BASE)\t$$_\t?"' os2/os2add.sym > tmp.imp
+	echo	'strdup	$(PERL_DLL_BASE)	Perl_strdup	?' >> tmp.imp
+	echo	'putenv	$(PERL_DLL_BASE)	Perl_putenv	?' >> tmp.imp
+	sh mv-if-diff tmp.imp $@
+
+libperl_override.lib: libperl_override.imp
+	emximp -o $@ libperl_override.imp
+
 $(AOUT_LIBPERL_DLL): perl.imp $(PERL_DLL) perl5.def
 	emximp -o $(AOUT_LIBPERL_DLL) perl.imp
 
diff --git a/os2/OS2/REXX/Makefile.PL b/os2/OS2/REXX/Makefile.PL
index 178ef7b..9b4c0ba 100644
--- a/os2/OS2/REXX/Makefile.PL
+++ b/os2/OS2/REXX/Makefile.PL
@@ -2,7 +2,7 @@ use ExtUtils::MakeMaker;
 
 WriteMakefile(
 	      NAME => 'OS2::REXX',
-	      VERSION => '0.22',
+	      VERSION_FROM => 'REXX.pm',
 	      MAN3PODS 	=> {}, 	# Pods will be built by installman.
 	      XSPROTOARG => '-noprototypes',
 	      PERL_MALLOC_OK => 1,
diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm
index 144dd37..1a7cb4d 100644
--- a/os2/OS2/REXX/REXX.pm
+++ b/os2/OS2/REXX/REXX.pm
@@ -10,7 +10,9 @@ require OS2::DLL;
 # (move infrequently used names to @EXPORT_OK below)
 @EXPORT = qw(REXX_call REXX_eval REXX_eval_with);
 # Other items we are prepared to export if requested
-@EXPORT_OK = qw(drop);
+@EXPORT_OK = qw(drop register);
+
+$VERSION = '1.00';
 
 # We cannot just put OS2::DLL in @ISA, since some scripts would use
 # function interface, not method interface...
@@ -24,6 +26,8 @@ bootstrap OS2::REXX;
 # Preloaded methods go here.  Autoload methods go after __END__, and are
 # processed by the autosplit program.
 
+sub register {_register($_) for @_}
+
 sub prefix
 {
 	my $self = shift;
@@ -259,12 +263,37 @@ One enables REXX runtime by bracketing your code by
 
 	REXX_call \&subroutine_name;
 
-Inside such a call one has access to REXX variables (see below), and to
+Inside such a call one has access to REXX variables (see below).
+
+An alternative way to execute code inside a REXX compartment is
 
 	REXX_eval EXPR;
 	REXX_eval_with EXPR, 
 		subroutine_name_in_REXX => \&Perl_subroutine
 
+Here C<EXPR> is a REXX code to run; to execute Perl code one needs to put
+it inside Perl_subroutine(), and call this subroutine from REXX, as in
+
+	REXX_eval_with <<EOE, foo => sub { 123 * shift };
+	  say foo(2)
+	EOE
+
+If one needs more Perl subroutines available, one can "import" them into
+REXX from inside Perl_subroutine(); since REXX is not case-sensitive,
+the names should be uppercased.
+
+	use OS2::REXX 'register';
+
+	sub BAR { 123 + shift}
+	sub BAZ { 789 }
+	sub importer { register qw(BAR BAZ) }
+
+	REXX_eval_with <<'EOE', importer => \&importer;
+	  call importer
+	  say bar(34)
+	  say baz()
+	EOE
+
 =head2 Bind scalar variable to REXX variable:
 
 	tie $var, OS2::REXX, "NAME";
@@ -298,6 +327,12 @@ part of the key and it is subject to character set restrictions.
 
 	OS2::REXX::dropall("STEM" [, "STEM" [, ...]]);
 
+=head2 Make Perl functions available in REXX:
+
+	OS2::REXX::register("NAME" [, "NAME" [, ...]]);
+
+Since REXX is not case-sensitive, the names should be uppercase.
+
 =head1 NOTES
 
 Note that while function and variable names are case insensitive in the
@@ -333,7 +368,43 @@ overridden. So unless you know better than I do, do not access REXX
 variables (probably tied to Perl variables) or call REXX functions
 which access REXX queues or REXX variables in signal handlers.
 
-See C<t/rx*.t> for examples.
+See C<t/rx*.t> and the next section for examples.
+
+=head1 EXAMPLE
+
+  use OS2::REXX;
+
+  sub Ender::DESTROY { $vrexx->VExit; print "Exiting...\n" }
+
+  $vrexx = OS2::REXX->load('VREXX');
+  REXX_call {			# VOpenWindow takes a stem
+    local $SIG{TERM} = sub {die}; # enable Ender::DESTROY
+    local $SIG{INT} = sub {die};	# enable Ender::DESTROY
+
+    $code = $vrexx->VInit;
+    print "Init code = `$code'\n";
+    die "error initializing VREXX" if $code eq 'ERROR';
+
+    my $ender = bless [], 'Ender'; # Call Ender::DESTROY on exit
+
+    print "VREXX Version ", $vrexx->VGetVersion, "\n";
+
+    tie %pos, 'OS2::REXX', 'POS.' or die;
+    %pos = ( LEFT   => 0, RIGHT  => 7, TOP    => 5, BOTTOM => 0 );
+
+    $id = $vrexx->VOpenWindow('To disconnect:', 'WHITE', 'POS');
+    $vrexx->VForeColor($id, 'BLACK');
+    $vrexx->VSetFont($id, 'TIME', '30');
+    $tlim = time + 60;
+    while ( ($r = $tlim - time) >= 0 ) {
+      $vrexx->VClearWindow($id);
+      $vrexx->VSay($id, 100, 50, (sprintf "%02i:%02i", int($r/60), $r % 60));
+      sleep 1;
+    }
+    print "Close code = `$res'\n" if $res = $vrexx->VCloseWindow($id);
+  };
+
+
 
 =head1 ENVIRONMENT
 
diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs
index b196ea1..f88d0af 100644
--- a/os2/OS2/REXX/REXX.xs
+++ b/os2/OS2/REXX/REXX.xs
@@ -97,7 +97,7 @@ exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
     if (rc || SvTRUE(GvSV(PL_errgv))) {
 	if (SvTRUE(GvSV(PL_errgv))) {
 	    STRLEN n_a;
-	    Perl_die(aTHX_ "Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
+	    Perl_die(aTHX_ "Error inside perl function called from REXX compartment:\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
 	}
 	Perl_die(aTHX_ "REXX compartment returned non-zero status %li", rc);
     }
@@ -129,6 +129,7 @@ PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret)
     unsigned long len;
     char *str;
     char **arr;
+    SV *res;
     dSP;
 
     DosSetExceptionHandler(&xreg);
@@ -144,47 +145,41 @@ PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret)
     }
 #endif 
 
+    for (i = 0; i < argc; ++i)
+	XPUSHs(sv_2mortal(newSVpvn(argv[i].strptr, argv[i].strlength)));
+    PUTBACK;
     if (name) {
-	int ac = 0;
-	char **arr = alloca((argc + 1) * sizeof(char *));
-
-	for (i = 0; i < argc; ++i)
-	    arr[ac++] = argv[i].strptr;
-	arr[ac] = NULL;
-
-	rc = perl_call_argv(name, G_SCALAR | G_EVAL, arr);
+	rc = perl_call_pv(name, G_SCALAR | G_EVAL);
     } else if (exec_cv) {
 	SV *cv = exec_cv;
 
 	exec_cv = NULL;
 	rc = perl_call_sv(cv, G_SCALAR | G_EVAL);
-    } else rc = -1;
+    } else
+	rc = -1;
 
     SPAGAIN;
 
-    if (rc == 1 && SvOK(TOPs)) { 
-	str = SvPVx(POPs, len);
-	if (len > 256)
-	    if (DosAllocMem((PPVOID)&ret->strptr, len, PAG_READ|PAG_WRITE|PAG_COMMIT)) {
-		DosUnsetExceptionHandler(&xreg);
-		return 1;
-	    }
-	memcpy(ret->strptr, str, len);
-	ret->strlength = len;
-    }
+    if (rc == 1)			/* must be! */
+	res = POPs;
+    if (rc == 1 && SvOK(res)) { 
+	str = SvPVx(res, len);
+	if (len <= 256			/* Default buffer is 256-char long */
+	    || !CheckOSError(DosAllocMem((PPVOID)&ret->strptr, len,
+					PAG_READ|PAG_WRITE|PAG_COMMIT))) {
+	    memcpy(ret->strptr, str, len);
+	    ret->strlength = len;
+	} else
+	    rc = 0;
+    } else
+	rc = 0;
 
     PUTBACK ;
     FREETMPS ;
     LEAVE ;
 
-    if (rc != 1) {
-	DosUnsetExceptionHandler(&xreg);
-	return 1;
-    }
-
-
     DosUnsetExceptionHandler(&xreg);
-    return 0;
+    return rc == 1 ? 0 : 1;			/* 0 means SUCCESS */
 }
 
 static void
diff --git a/os2/OS2/REXX/t/rx_cmprt.t b/os2/OS2/REXX/t/rx_cmprt.t
index f2113e3..6baec76 100644
--- a/os2/OS2/REXX/t/rx_cmprt.t
+++ b/os2/OS2/REXX/t/rx_cmprt.t
@@ -8,11 +8,11 @@ BEGIN {
     }
 }
 
-use OS2::REXX;
+use OS2::REXX qw(:DEFAULT register);
 
 $| = 1;				# Otherwise data from REXX may come first
 
-print "1..13\n";
+print "1..16\n";
 
 $n = 1;
 sub do_me {
@@ -38,3 +38,11 @@ REXX_eval 'say "ok 10"';
 REXX_eval 'say "ok 11"';
 print "ok 12\n" if REXX_eval("return 2 + 3") eq 5;
 REXX_eval_with 'say myfunc()', myfunc => sub {"ok 13"};
+REXX_eval_with "call myout 'ok'  14", myout => sub {print shift, "\n"};
+REXX_eval_with "say 'ok 'myfunc(3,5)", myfunc => sub {shift() * shift()};
+
+sub MYFUNC1 {shift}
+sub MYFUNC2 {3 * shift}
+REXX_eval_with "call myfunc
+		say 'ok 'myfunc1(1)myfunc2(2)",
+  myfunc => sub { register qw(myfunc1 myfunc2) };
diff --git a/os2/os2.c b/os2/os2.c
index 50f0e1d..4ce933d 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -8,6 +8,7 @@
 #define SPU_DISABLESUPPRESSION          0
 #define SPU_ENABLESUPPRESSION           1
 #include <os2.h>
+#include "dlfcn.h"
 
 #include <sys/uflags.h>
 
@@ -189,6 +190,16 @@ static USHORT loadOrd[2] = { 874, 873 }; /* Query=874, Set=873. */
 #define ORD_SET_ELP	1
 struct PMWIN_entries_t PMWIN_entries;
 
+HMODULE
+loadModule(char *modname)
+{
+    HMODULE h = (HMODULE)dlopen(modname, 0);
+    if (!h)
+	Perl_croak_nocontext("Error loading module '%s': %s", 
+			     modname, dlerror());
+    return h;
+}
+
 APIRET
 loadByOrd(char *modname, ULONG ord)
 {
@@ -198,11 +209,14 @@ loadByOrd(char *modname, ULONG ord)
 	PFN fcn;
 	APIRET rc;
 
-	if ((!hdosc && CheckOSError(DosLoadModule(buf, sizeof buf, 
-						  modname, &hdosc)))
-	    || CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
-	    Perl_croak_nocontext("This version of OS/2 does not support %s.%i", 
-		  modname, loadOrd[ord]);
+	
+	if (!hdosc) {
+	    hdosc = loadModule(modname);
+	    if (CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
+		Perl_croak_nocontext(
+			"This version of OS/2 does not support %s.%i", 
+			modname, loadOrd[ord]);	    
+	}
 	ExtFCN[ord] = fcn;
     } 
     if ((long)ExtFCN[ord] == -1) 
@@ -220,6 +234,8 @@ init_PMWIN_entries(void)
 	918,				/* PeekMsg */
 	915,				/* GetMsg */
 	912,				/* DispatchMsg */
+	753,				/* GetLastError */
+	705,				/* CancelShutdown */
     };
     BYTE buf[20];
     int i = 0;
@@ -228,9 +244,8 @@ init_PMWIN_entries(void)
     if (hpmwin)
 	return;
 
-    if (CheckOSError(DosLoadModule(buf, sizeof buf, "pmwin", &hpmwin)))
-	Perl_croak_nocontext("This version of OS/2 does not support pmwin: error in %s", buf);
-    while (i <= 5) {
+    hpmwin = loadModule("pmwin");
+    while (i < sizeof(ords)/sizeof(int)) {
 	if (CheckOSError(DosQueryProcAddr(hpmwin, ords[i], NULL, 
 					  ((PFN*)&PMWIN_entries)+i)))
 	    Perl_croak_nocontext("This version of OS/2 does not support pmwin.%d", ords[i]);
@@ -1138,12 +1153,11 @@ static HMODULE htcp = 0;
 static void *
 tcp0(char *name)
 {
-    static BYTE buf[20];
     PFN fcn;
 
     if (!(_emx_env & 0x200)) Perl_croak_nocontext("%s requires OS/2", name); /* Die if not OS/2. */
     if (!htcp)
-	DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
+	htcp = loadModule("tcp32dll");
     if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
 	return (void *) ((void * (*)(void)) fcn) ();
     return 0;
@@ -1367,15 +1381,30 @@ os2error(int rc)
 char *
 os2_execname(pTHX)
 {
-  char buf[300], *p;
+  char buf[300], *p, *o = PL_origargv[0], ok = 1;
 
   if (_execname(buf, sizeof buf) != 0)
-	return PL_origargv[0];
+	return o;
   p = buf;
   while (*p) {
     if (*p == '\\')
 	*p = '/';
+    if (*p == '/') {
+	if (ok && *o != '/' && *o != '\\')
+	    ok = 0;
+    } else if (ok && tolower(*o) != tolower(*p))
+	ok = 0;	
     p++;
+    o++;
+  }
+  if (ok) { /* PL_origargv[0] matches the real name.  Use PL_origargv[0]: */
+     strcpy(buf, PL_origargv[0]);	/* _execname() is always uppercased */
+     p = buf;
+     while (*p) {
+       if (*p == '\\')
+           *p = '/';
+       p++;
+     }     
   }
   p = savepv(buf);
   SAVEFREEPV(p);
@@ -1447,7 +1476,6 @@ Perl_Register_MQ(int serve)
 	return Perl_hmq;
     DosGetInfoBlocks(&tib, &pib);
     Perl_os2_initial_mode = pib->pib_ultype;
-    Perl_hmq_refcnt = 1;
     /* Try morphing into a PM application. */
     if (pib->pib_ultype != 3)		/* 2 is VIO */
 	pib->pib_ultype = 3;		/* 3 is PM */
@@ -1456,10 +1484,20 @@ Perl_Register_MQ(int serve)
     Perl_hmq = (*PMWIN_entries.CreateMsgQueue)(perl_hab_GET(), 64); 
     if (!Perl_hmq) {
 	static int cnt;
+
+	SAVEINT(cnt);			/* Allow catch()ing. */
 	if (cnt++)
 	    _exit(188);			/* Panic can try to create a window. */
 	Perl_croak_nocontext("Cannot create a message queue, or morph to a PM application");
     }
+    if (serve) {
+	if ( Perl_hmq_servers <= 0	/* Safe to inform us on shutdown, */
+	     && Perl_hmq_refcnt > 0 )	/* this was switched off before... */
+	    (*PMWIN_entries.CancelShutdown)(Perl_hmq, 0);
+	Perl_hmq_servers++;
+    } else if (!Perl_hmq_servers)	/* Do not inform us on shutdown */
+	(*PMWIN_entries.CancelShutdown)(Perl_hmq, 1);
+    Perl_hmq_refcnt++;
     return Perl_hmq;
 }
 
@@ -1469,9 +1507,9 @@ Perl_Serve_Messages(int force)
     int cnt = 0;
     QMSG msg;
 
-    if (Perl_hmq_servers && !force)
+    if (Perl_hmq_servers > 0 && !force)
 	return 0;
-    if (!Perl_hmq_refcnt)
+    if (Perl_hmq_refcnt <= 0)
 	Perl_croak_nocontext("No message queue");
     while ((*PMWIN_entries.PeekMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0, PM_REMOVE)) {
 	cnt++;
@@ -1487,9 +1525,9 @@ Perl_Process_Messages(int force, I32 *cntp)
 {
     QMSG msg;
 
-    if (Perl_hmq_servers && !force)
+    if (Perl_hmq_servers > 0 && !force)
 	return 0;
-    if (!Perl_hmq_refcnt)
+    if (Perl_hmq_refcnt <= 0)
 	Perl_croak_nocontext("No message queue");
     while ((*PMWIN_entries.GetMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0)) {
 	if (cntp)
@@ -1509,21 +1547,23 @@ Perl_Deregister_MQ(int serve)
     PPIB pib;
     PTIB tib;
 
-    if (--Perl_hmq_refcnt == 0) {
+    if (serve)
+	Perl_hmq_servers--;
+    if (--Perl_hmq_refcnt <= 0) {
+	init_PMWIN_entries();			/* To be extra safe */
 	(*PMWIN_entries.DestroyMsgQueue)(Perl_hmq);
 	Perl_hmq = 0;
 	/* Try morphing back from a PM application. */
+	DosGetInfoBlocks(&tib, &pib);
 	if (pib->pib_ultype == 3)		/* 3 is PM */
 	    pib->pib_ultype = Perl_os2_initial_mode;
 	else
 	    Perl_warn_nocontext("Unexpected program mode %d when morphing back from PM",
 		 pib->pib_ultype);
-    }
+    } else if (serve && Perl_hmq_servers <= 0)	/* Last server exited */
+	(*PMWIN_entries.CancelShutdown)(Perl_hmq, 1);
 }
 
-extern void dlopen();
-void *fakedl = &dlopen;		/* Pull in dynaloading part. */
-
 #define sys_is_absolute(path) ( isALPHA((path)[0]) && (path)[1] == ':' \
 				&& ((path)[2] == '/' || (path)[2] == '\\'))
 #define sys_is_rooted _fnisabs
@@ -2026,6 +2066,71 @@ XS(XS_Cwd_extLibpath_set)
     XSRETURN(1);
 }
 
+#define get_control87()		_control87(0,0)
+#define set_control87		_control87
+
+XS(XS_OS2__control87)
+{
+    dXSARGS;
+    if (items != 2)
+	croak("Usage: OS2::_control87(new,mask)");
+    {
+	unsigned	new = (unsigned)SvIV(ST(0));
+	unsigned	mask = (unsigned)SvIV(ST(1));
+	unsigned	RETVAL;
+
+	RETVAL = _control87(new, mask);
+	ST(0) = sv_newmortal();
+	sv_setiv(ST(0), (IV)RETVAL);
+    }
+    XSRETURN(1);
+}
+
+XS(XS_OS2_get_control87)
+{
+    dXSARGS;
+    if (items != 0)
+	croak("Usage: OS2::get_control87()");
+    {
+	unsigned	RETVAL;
+
+	RETVAL = get_control87();
+	ST(0) = sv_newmortal();
+	sv_setiv(ST(0), (IV)RETVAL);
+    }
+    XSRETURN(1);
+}
+
+
+XS(XS_OS2_set_control87)
+{
+    dXSARGS;
+    if (items < 0 || items > 2)
+	croak("Usage: OS2::set_control87(new=MCW_EM, mask=MCW_EM)");
+    {
+	unsigned	new;
+	unsigned	mask;
+	unsigned	RETVAL;
+
+	if (items < 1)
+	    new = MCW_EM;
+	else {
+	    new = (unsigned)SvIV(ST(0));
+	}
+
+	if (items < 2)
+	    mask = MCW_EM;
+	else {
+	    mask = (unsigned)SvIV(ST(1));
+	}
+
+	RETVAL = set_control87(new, mask);
+	ST(0) = sv_newmortal();
+	sv_setiv(ST(0), (IV)RETVAL);
+    }
+    XSRETURN(1);
+}
+
 int
 Xs_OS2_init(pTHX)
 {
@@ -2055,6 +2160,9 @@ Xs_OS2_init(pTHX)
         newXS("Cwd::sys_is_relative", XS_Cwd_sys_is_relative, file);
         newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
         newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
+        newXSproto("OS2::_control87", XS_OS2__control87, file, "$$");
+        newXSproto("OS2::get_control87", XS_OS2_get_control87, file, "");
+        newXSproto("OS2::set_control87", XS_OS2_set_control87, file, ";$$");
 	gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV);
 	GvMULTI_on(gv);
 #ifdef PERL_IS_AOUT
@@ -2106,6 +2214,8 @@ Perl_OS2_init(char **env)
     }
     MUTEX_INIT(&start_thread_mutex);
     os2_mytype = my_type();		/* Do it before morphing.  Needed? */
+    /* Some DLLs reset FP flags on load.  We may have been linked with them */
+    _control87(MCW_EM, MCW_EM);
 }
 
 #undef tmpnam
@@ -2139,6 +2249,38 @@ my_tmpfile ()
 					     grants TMP. */
 }
 
+#undef rmdir
+
+int
+my_rmdir (__const__ char *s)
+{
+    char buf[MAXPATHLEN];
+    STRLEN l = strlen(s);
+
+    if (s[l-1] == '/' || s[l-1] == '\\') {	/* EMX rmdir fails... */
+	strcpy(buf,s);
+	buf[l - 1] = 0;
+	s = buf;
+    }
+    return rmdir(s);
+}
+
+#undef mkdir
+
+int
+my_mkdir (__const__ char *s, long perm)
+{
+    char buf[MAXPATHLEN];
+    STRLEN l = strlen(s);
+
+    if (s[l-1] == '/' || s[l-1] == '\\') {	/* EMX mkdir fails... */
+	strcpy(buf,s);
+	buf[l - 1] = 0;
+	s = buf;
+    }
+    return mkdir(s, perm);
+}
+
 #undef flock
 
 /* This code was contributed by Rocco Caputo. */
diff --git a/os2/os2.sym b/os2/os2.sym
index 6855686..3f535e4 100644
--- a/os2/os2.sym
+++ b/os2/os2.sym
@@ -9,6 +9,8 @@ dlclose
 my_tmpfile
 my_tmpnam
 my_flock
+my_rmdir
+my_mkdir
 malloc_mutex
 threads_mutex
 nthreads
diff --git a/os2/os2add.sym b/os2/os2add.sym
new file mode 100644
index 0000000..36aab85
--- /dev/null
+++ b/os2/os2add.sym
@@ -0,0 +1,9 @@
+dlopen
+dlsym
+dlerror
+dlclose
+malloc
+realloc
+free
+calloc
+ctermid
diff --git a/os2/os2ish.h b/os2/os2ish.h
index dccd932..30e67ca 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -261,6 +261,8 @@ PerlIO *my_syspopen(pTHX_ char *cmd, char *mode);
 int my_syspclose(PerlIO *f);
 FILE *my_tmpfile (void);
 char *my_tmpnam (char *);
+int my_mkdir (__const__ char *, long);
+int my_rmdir (__const__ char *);
 
 #undef L_tmpnam
 #define L_tmpnam MAXPATHLEN
@@ -283,6 +285,8 @@ char *my_tmpnam (char *);
 
 #define my_getenv(var) getenv(var)
 #define flock	my_flock
+#define rmdir	my_rmdir
+#define mkdir	my_mkdir
 
 void *emx_calloc (size_t, size_t);
 void emx_free (void *);
@@ -394,6 +398,8 @@ struct PMWIN_entries_t {
 		  unsigned long hwndFilter, unsigned long msgFilterFirst,
 		  unsigned long msgFilterLast);
     void * (*DispatchMsg)(unsigned long hab, struct _QMSG *pqmsg);
+    unsigned long (*GetLastError)(unsigned long hab);
+    unsigned long (*CancelShutdown)(unsigned long hmq, unsigned long fCancelAlways);
 };
 extern struct PMWIN_entries_t PMWIN_entries;
 void init_PMWIN_entries(void);
@@ -418,9 +424,14 @@ void init_PMWIN_entries(void);
 #define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1))
 #define FillOSError(rc) (os2_setsyserrno(rc),				\
 			Perl_severity = SEVERITY_ERROR) 
-#define FillWinError (Perl_severity = ERRORIDSEV(Perl_rc),		\
-			Perl_rc = ERRORIDERROR(Perl_rc)),		\
-			os2_setsyserrno(Perl_rc)
+
+/* At this moment init_PMWIN_entries() should be a nop (WinInitialize should
+   be called already, right?), so we do not risk stepping over our own error */
+#define FillWinError (	init_PMWIN_entries(),				\
+			Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()),\
+			Perl_severity = ERRORIDSEV(Perl_rc),		\
+			Perl_rc = ERRORIDERROR(Perl_rc),		\
+			os2_setsyserrno(Perl_rc))
 
 #define STATIC_FILE_LENGTH 127
 
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index db42d44..27d5bd7 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -318,7 +318,7 @@ L<perlsub/"Constant Functions">.
 	SV*	cv_const_sv(CV* cv)
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item dMARK
 
@@ -1223,7 +1223,7 @@ eligible for inlining at compile-time.
 	CV*	newCONSTSUB(HV* stash, char* name, SV* sv)
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item newHV
 
@@ -1369,7 +1369,7 @@ Found in file sv.c
 Used by C<xsubpp> to hook up XSUBs as Perl subs.
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item newXSproto
 
@@ -1568,13 +1568,34 @@ Found in file pp.h
 
 =item POPp
 
-Pops a string off the stack.
+Pops a string off the stack. Deprecated. New code should provide
+a STRLEN n_a and use POPpx.
 
 	char*	POPp
 
 =for hackers
 Found in file pp.h
 
+=item POPpbytex
+
+Pops a string off the stack which must consist of bytes i.e. characters < 256.
+Requires a variable STRLEN n_a in scope.
+
+	char*	POPpbytex
+
+=for hackers
+Found in file pp.h
+
+=item POPpx
+
+Pops a string off the stack.
+Requires a variable STRLEN n_a in scope.
+
+	char*	POPpx
+
+=for hackers
+Found in file pp.h
+
 =item POPs
 
 Pops an SV off the stack.
@@ -2368,19 +2389,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+	svtype	SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-	svtype	SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h
diff --git a/t/op/pat.t b/t/op/pat.t
index 3a4623d..20acee4 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..243\n";
+print "1..245\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1183,30 +1183,47 @@ if (/(\C)/g) {
   }
 }
 
-# 241..242
-#
-# The tr is admittedly NOT a regular expression operator,
-# but this test is more of an EBCDIC test, the background is
-# that \x89 is 'i' and \x90 is 'j', and \x8e is not a letter,
-# not even a printable character.  Now for the trick:
-# if the range is specified using letters, the \x8e should most
-# probably not match, but if the range is specified using explicit
-# numeric endpoints, it probably should match.  The first case,
-# not matching if using letters, is already tested elsewhere,
-# here we test for the matching cases.
-
-$_ = qq/\x8E/;
-
-print "not " unless /[\x89-\x91]/;
-print "ok 241\n";
-
-print "not " unless tr/\x89-\x91//d == 1;
-print "ok 242\n";
-
 {
   # japhy -- added 03/03/2001
   () = (my $str = "abc") =~ /(...)/;
   $str = "def";
   print "not " if $1 ne "abc";
+  print "ok 241\n";
+}
+
+# The 242 and 243 go with the 244 and 245.
+# The trick is that in EBCDIC the explicit numeric range should match
+# (as also in non-EBCDIC) but the explicit alphabetic range should not match.
+
+if ("\x8e" =~ /[\x89-\x91]/) {
+  print "ok 242\n";
+} else {
+  print "not ok 242\n";
+}
+
+if ("\xce" =~ /[\xc9-\xd1]/) {
   print "ok 243\n";
+} else {
+  print "not ok 243\n";
+}
+
+# In most places these tests would succeed since \x8e does not
+# in most character sets match 'i' or 'j' nor would \xce match
+# 'I' or 'J', but strictly speaking these tests are here for
+# the good of EBCDIC, so let's test these only there.
+if (ord('i') == 0x89 && ord('J') == 0xd1) { # EBCDIC
+  if ("\x8e" !~ /[i-j]/) {
+    print "ok 244\n";
+  } else {
+    print "not ok 244\n";
+  }
+  if ("\xce" !~ /[I-J]/) {
+    print "ok 245\n";
+  } else {
+    print "not ok 245\n";
+  }
+} else {
+  for (244..245) {
+    print "ok $_ # Skip: not EBCDIC\n";
+  }
 }
diff --git a/t/op/tr.t b/t/op/tr.t
index eb5c4ca..e114464 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..57\n";
+print "1..61\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -325,3 +325,28 @@ print "ok 56\n";
 print "not " unless $a eq "X";
 print "ok 57\n";
 
+# Tricky on EBCDIC: while [a-z] [A-Z] must not match the gap characters,
+# (i-j, r-s, I-J, R-S), [\x89-\x91] [\xc9-\xd1] has to match them,
+# from Karsten Sperling.
+
+$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x89-\x91/X/;
+print "not " unless $c == 8 and $a eq "XXXXXXXX";
+print "ok 58\n";
+   
+$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\xc9-\xd1/X/;
+print "not " unless $c == 8 and $a eq "XXXXXXXX";
+print "ok 59\n";
+   
+if (ord('i') == 0x89 & ord('J') == 0xd1) {
+
+$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
+print "not " unless $c == 2 and $a eq "X\x8a\x8b\x8c\x8d\x8f\x90X";
+print "ok 60\n";
+   
+$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
+print "not " unless $c == 2 and $a eq "X\xca\xcb\xcc\xcd\xcf\xd0X";
+print "ok 61\n";
+
+} else {
+  for (60..61) { print "ok $_ # Skip: not EBCDIC\n" }
+}