/* * This file was generated automatically by ExtUtils::ParseXS version 2.18 from the * contents of Map8.xs. Do not edit this file, edit Map8.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "Map8.xs" /* $Id: Map8.xs,v 1.12 2001/12/31 17:51:25 gisle Exp $ * * Copyright 1998, Gisle Aas. * * This library is free software; you can redistribute it and/or * modify it under the same terms as Perl itself. */ #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include "patchlevel.h" #if PATCHLEVEL <= 4 && !defined(PL_dowarn) #define PL_dowarn dowarn #endif #include "map8.h" /* Some renaming that helps avoiding name class with the Perl versions * of the constructors */ #define map8__new map8_new #define map8__new_txtfile map8_new_txtfile #define map8__new_binfile map8_new_binfile /* Callbacks are always on and will invoke methods on the * Unicode::Map8 object. */ static U16* to16_cb(U8 u, Map8* m, STRLEN *len) { dSP; int n; SV* sv; U16* buf; STRLEN buflen; PUSHMARK(sp); XPUSHs(sv_2mortal(newRV_inc(m->obj))); XPUSHs(sv_2mortal(newSViv(u))); PUTBACK; n = perl_call_method("unmapped_to16", G_SCALAR); assert(n == 1); SPAGAIN; sv = POPs; PUTBACK; buf = (U16*)SvPV(sv, buflen); *len = buflen / sizeof(U16); return buf; } static U8* to8_cb(U16 u, Map8* m, STRLEN *len) { dSP; int n; SV* sv; PUSHMARK(sp); XPUSHs(sv_2mortal(newRV_inc(m->obj))); XPUSHs(sv_2mortal(newSViv(u))); PUTBACK; n = perl_call_method("unmapped_to8", G_SCALAR); assert(n == 1); SPAGAIN; sv = POPs; PUTBACK; return SvPV(sv, *len); } /* We use '~' magic to attach the Map8* objects to Unicode::Map8 * objects. The pointer to the attached Map8* object is stored in * the mg_obj fields of struct magic. The attached Map8* object * is also automatically freed when the magic is freed. */ static int map8_magic_free(pTHX_ SV* sv, MAGIC* mg) { map8_free((Map8*)mg->mg_obj); return 1; } static MGVTBL magic_cleanup = { 0, 0, 0, 0, map8_magic_free }; static Map8* find_map8(SV* obj) { MAGIC *m; if (!sv_derived_from(obj, "Unicode::Map8")) croak("Not an Unicode::Map8 object"); m = mg_find(SvRV(obj), '~'); if (!m) croak("No magic attached"); if (m->mg_len != 666) croak("Bad magic in ~-magic"); return (Map8*) m->mg_obj; } static void attach_map8(SV* obj, Map8* map8) { SV* hv = SvRV(obj); MAGIC *m; sv_magic(hv, NULL, '~', 0, 666); m = mg_find(hv, '~'); if (!m) croak("Can't find back ~ magic"); m->mg_virtual = &magic_cleanup; m->mg_obj = (SV*)map8; /* register callbacks */ map8->cb_to8 = to8_cb; map8->cb_to16 = to16_cb; map8->obj = (void*)hv; /* so callbacks can find the object again */ } #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #line 148 "Map8.c" XS(XS_Unicode__Map8__new); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8__new) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 0) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::_new", ""); PERL_UNUSED_VAR(cv); /* -W */ { Map8 * RETVAL; RETVAL = map8__new(); ST(0) = sv_newmortal(); /* Make a HASH object, and attach the map to it */ if (RETVAL) { HV* stash = gv_stashpv("Unicode::Map8", TRUE); sv_upgrade(ST(0), SVt_RV); SvRV(ST(0)) = (SV*)newHV(); SvROK_on(ST(0)); (void)sv_bless(ST(0), stash); attach_map8(ST(0), RETVAL); } else { SvOK_off(ST(0)); } } XSRETURN(1); } XS(XS_Unicode__Map8__new_txtfile); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8__new_txtfile) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 1) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::_new_txtfile", "filename"); PERL_UNUSED_VAR(cv); /* -W */ { char* filename = (char *)SvPV_nolen(ST(0)); Map8 * RETVAL; RETVAL = map8__new_txtfile(filename); ST(0) = sv_newmortal(); /* Make a HASH object, and attach the map to it */ if (RETVAL) { HV* stash = gv_stashpv("Unicode::Map8", TRUE); sv_upgrade(ST(0), SVt_RV); SvRV(ST(0)) = (SV*)newHV(); SvROK_on(ST(0)); (void)sv_bless(ST(0), stash); attach_map8(ST(0), RETVAL); } else { SvOK_off(ST(0)); } } XSRETURN(1); } XS(XS_Unicode__Map8__new_binfile); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8__new_binfile) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 1) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::_new_binfile", "filename"); PERL_UNUSED_VAR(cv); /* -W */ { char* filename = (char *)SvPV_nolen(ST(0)); Map8 * RETVAL; RETVAL = map8__new_binfile(filename); ST(0) = sv_newmortal(); /* Make a HASH object, and attach the map to it */ if (RETVAL) { HV* stash = gv_stashpv("Unicode::Map8", TRUE); sv_upgrade(ST(0), SVt_RV); SvRV(ST(0)) = (SV*)newHV(); SvROK_on(ST(0)); (void)sv_bless(ST(0), stash); attach_map8(ST(0), RETVAL); } else { SvOK_off(ST(0)); } } XSRETURN(1); } XS(XS_Unicode__Map8_addpair); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_addpair) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 3) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::addpair", "map, u8, u16"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); U8 u8 = (U8)SvUV(ST(1)); U16 u16 = (unsigned short)SvUV(ST(2)); map8_addpair(map, u8, u16); } XSRETURN_EMPTY; } XS(XS_Unicode__Map8_default_to8); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_default_to8) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif dXSI32; if (items < 1) Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "map, ..."); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); U16 RETVAL; dXSTARG; #line 161 "Map8.xs" RETVAL = ix ? map8_get_def_to16(map) : map8_get_def_to8(map); if (items > 1) { if (ix) map8_set_def_to16(map, SvIV(ST(1))); else map8_set_def_to8(map, SvIV(ST(1))); } #line 294 "Map8.c" XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8_nostrict); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_nostrict) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 1) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::nostrict", "map"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); map8_nostrict(map); } XSRETURN_EMPTY; } XS(XS_Unicode__Map8_MAP8_BINFILE_MAGIC_HI); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_MAP8_BINFILE_MAGIC_HI) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 0) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::MAP8_BINFILE_MAGIC_HI", ""); PERL_UNUSED_VAR(cv); /* -W */ { U16 RETVAL; dXSTARG; #line 178 "Map8.xs" RETVAL = MAP8_BINFILE_MAGIC_HI; #line 337 "Map8.c" XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8_MAP8_BINFILE_MAGIC_LO); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_MAP8_BINFILE_MAGIC_LO) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 0) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::MAP8_BINFILE_MAGIC_LO", ""); PERL_UNUSED_VAR(cv); /* -W */ { U16 RETVAL; dXSTARG; #line 185 "Map8.xs" RETVAL = MAP8_BINFILE_MAGIC_LO; #line 360 "Map8.c" XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8_NOCHAR); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_NOCHAR) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 0) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::NOCHAR", ""); PERL_UNUSED_VAR(cv); /* -W */ { U16 RETVAL; dXSTARG; #line 192 "Map8.xs" RETVAL = NOCHAR; #line 383 "Map8.c" XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8__empty_block); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8__empty_block) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::_empty_block", "map, block"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); U8 block = (U8)SvUV(ST(1)); SV * RETVAL; #line 201 "Map8.xs" if (block > 0xFF) croak("Only 256 blocks exists"); RETVAL = boolSV(map8_empty_block(map, block)); #line 409 "Map8.c" ST(0) = RETVAL; sv_2mortal(ST(0)); } XSRETURN(1); } XS(XS_Unicode__Map8_to_char16); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_to_char16) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::to_char16", "map, c"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); U8 c = (U8)SvUV(ST(1)); U16 RETVAL; dXSTARG; #line 212 "Map8.xs" RETVAL = ntohs(map8_to_char16(map, c)); #line 435 "Map8.c" XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8_to_char8); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_to_char8) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::to_char8", "map, uc"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); U16 uc = (unsigned short)SvUV(ST(1)); U16 RETVAL; dXSTARG; RETVAL = map8_to_char8(map, uc); XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } XS(XS_Unicode__Map8_to8); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_to8) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::to8", "map, str16"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); #line 225 "Map8.xs" STRLEN len; STRLEN origlen; char* str; char* cur; #line 484 "Map8.c" U16* str16 = (U16*)SvPV(ST(1), len); SV * RETVAL; #line 232 "Map8.xs" if (PL_dowarn && (len % 2) != 0) warn("Uneven length of wide string"); len /= 2; origlen = len; RETVAL = newSV(len + 1); SvPOK_on(RETVAL); str = SvPVX(RETVAL); for (cur = str; len--; str16++) { U16 c16 = ntohs(*str16); U16 c = map8_to_char8(map, c16); if (c != NOCHAR) { *cur++ = (U8)c; } else if (map->def_to8 != NOCHAR) { *cur++ = (U8)map->def_to8; } else if (map->cb_to8) { U8* buf; STRLEN blen; buf = map->cb_to8(c16, map, &blen); if (buf && blen > 0) { if (blen == 1) { *cur++ = *buf; } else { /* we might need to grow the string buffer. * Find out the minimum requirement and a * guess that avoids growing each time if * several char map longer strings */ STRLEN curlen = cur - str; STRLEN guess = origlen * (curlen + blen) / (origlen - len); STRLEN min = curlen + blen + len + 1; if (guess < min) guess = min; else if (curlen <= 1 && guess > min*4) guess = min*4; str = SvGROW(RETVAL, guess); cur = str + curlen; while (blen--) *cur++ = *buf++; } } } } SvCUR_set(RETVAL, cur - str); *cur = '\0'; #line 538 "Map8.c" ST(0) = RETVAL; sv_2mortal(ST(0)); } XSRETURN(1); } XS(XS_Unicode__Map8_to16); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_to16) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 2) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::to16", "map, str8"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* map = find_map8(ST(0)); #line 289 "Map8.xs" STRLEN len; STRLEN origlen; U16* str; U16* cur; #line 564 "Map8.c" U8* str8 = SvPV(ST(1), len); SV * RETVAL; #line 296 "Map8.xs" origlen = len; RETVAL = newSV(sizeof(U16)*len + 1); SvPOK_on(RETVAL); str = (U16*)SvPVX(RETVAL); for (cur = str; len--; str8++) { U16 c = map8_to_char16(map, *str8); if (c != NOCHAR) { *cur++ = c; } else if (map->def_to16 != NOCHAR) { *cur++ = map->def_to16; } else if (map->cb_to16) { U16* buf; STRLEN blen; buf = map->cb_to16(*str8, map, &blen); if (buf && blen > 0) { if (blen == 1) { *cur++ = *buf; } else { /* we might need to grow the string buffer. * Find out the minimum requirement and a * guess that avoids growing each time if * several char map longer strings */ STRLEN curlen = cur - str; STRLEN guess = origlen * (curlen + blen) / (origlen - len); STRLEN min = curlen + blen + len + 1; if (guess < min) guess = min; else if (curlen <= 1 && guess > min*4) guess = min*4; str = (U16*)SvGROW(RETVAL, sizeof(U16)*guess); cur = str + curlen; while (blen--) *cur++ = *buf++; } } } } SvCUR_set(RETVAL, (cur - str)*sizeof(U16)); *cur = '\0'; #line 614 "Map8.c" ST(0) = RETVAL; sv_2mortal(ST(0)); } XSRETURN(1); } XS(XS_Unicode__Map8_recode8); /* prototype to pass -Wmissing-prototypes */ XS(XS_Unicode__Map8_recode8) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif if (items != 3) Perl_croak(aTHX_ "Usage: %s(%s)", "Unicode::Map8::recode8", "m1, m2, str"); PERL_UNUSED_VAR(cv); /* -W */ { Map8* m1 = find_map8(ST(0)); Map8* m2 = find_map8(ST(1)); #line 350 "Map8.xs" STRLEN len; STRLEN rlen; char* res; #line 640 "Map8.c" char* str = SvPV(ST(2), len); SV * RETVAL; #line 356 "Map8.xs" RETVAL = newSV(len + 1); SvPOK_on(RETVAL); res = SvPVX(RETVAL); map8_recode8(m1, m2, str, res, len, &rlen); res[rlen] = '\0'; SvCUR_set(RETVAL, rlen); #line 650 "Map8.c" ST(0) = RETVAL; sv_2mortal(ST(0)); } XSRETURN(1); } #ifdef __cplusplus extern "C" #endif XS(boot_Unicode__Map8); /* prototype to pass -Wmissing-prototypes */ XS(boot_Unicode__Map8) { #ifdef dVAR dVAR; dXSARGS; #else dXSARGS; #endif char* file = __FILE__; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ XS_VERSION_BOOTCHECK ; { CV * cv ; newXS("Unicode::Map8::_new", XS_Unicode__Map8__new, file); newXS("Unicode::Map8::_new_txtfile", XS_Unicode__Map8__new_txtfile, file); newXS("Unicode::Map8::_new_binfile", XS_Unicode__Map8__new_binfile, file); newXS("Unicode::Map8::addpair", XS_Unicode__Map8_addpair, file); cv = newXS("Unicode::Map8::default_to16", XS_Unicode__Map8_default_to8, file); XSANY.any_i32 = 1 ; cv = newXS("Unicode::Map8::default_to8", XS_Unicode__Map8_default_to8, file); XSANY.any_i32 = 0 ; newXS("Unicode::Map8::nostrict", XS_Unicode__Map8_nostrict, file); newXS("Unicode::Map8::MAP8_BINFILE_MAGIC_HI", XS_Unicode__Map8_MAP8_BINFILE_MAGIC_HI, file); newXS("Unicode::Map8::MAP8_BINFILE_MAGIC_LO", XS_Unicode__Map8_MAP8_BINFILE_MAGIC_LO, file); newXS("Unicode::Map8::NOCHAR", XS_Unicode__Map8_NOCHAR, file); newXS("Unicode::Map8::_empty_block", XS_Unicode__Map8__empty_block, file); newXS("Unicode::Map8::to_char16", XS_Unicode__Map8_to_char16, file); newXS("Unicode::Map8::to_char8", XS_Unicode__Map8_to_char8, file); newXS("Unicode::Map8::to8", XS_Unicode__Map8_to8, file); newXS("Unicode::Map8::to16", XS_Unicode__Map8_to16, file); newXS("Unicode::Map8::recode8", XS_Unicode__Map8_recode8, file); } XSRETURN_YES; }