home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / perl5a1.lha / perl5alpha1 / do / pack < prev    next >
Encoding:
Text File  |  1992-08-15  |  8.0 KB  |  400 lines
  1. void
  2. do_pack(TARG,arglast)
  3. register STR *TARG;
  4. int *arglast;
  5. {
  6.     register STR **st = stack->ary_array;
  7.     register int sp = arglast[1];
  8.     register int items;
  9.     register char *pat = str_get(st[sp]);
  10.     register char *patend = pat + st[sp]->str_cur;
  11.     register int len;
  12.     int datumtype;
  13.     STR *fromstr;
  14.     /*SUPPRESS 442*/
  15.     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
  16.     static char *space10 = "          ";
  17.  
  18.     /* These must not be in registers: */
  19.     char achar;
  20.     short ashort;
  21.     int aint;
  22.     unsigned int auint;
  23.     long along;
  24.     unsigned long aulong;
  25. #ifdef QUAD
  26.     quad aquad;
  27.     unsigned quad auquad;
  28. #endif
  29.     char *aptr;
  30.     float afloat;
  31.     double adouble;
  32.  
  33.     items = arglast[2] - sp;
  34.     st += ++sp;
  35.     str_nset(TARG,"",0);
  36.     while (pat < patend) {
  37. #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
  38.     datumtype = *pat++;
  39.     if (*pat == '*') {
  40.         len = index("@Xxu",datumtype) ? 0 : items;
  41.         pat++;
  42.     }
  43.     else if (isDIGIT(*pat)) {
  44.         len = *pat++ - '0';
  45.         while (isDIGIT(*pat))
  46.         len = (len * 10) + (*pat++ - '0');
  47.     }
  48.     else
  49.         len = 1;
  50.     switch(datumtype) {
  51.     default:
  52.         break;
  53.     case '%':
  54.         fatal("% may only be used in unpack");
  55.     case '@':
  56.         len -= TARG->str_cur;
  57.         if (len > 0)
  58.         goto grow;
  59.         len = -len;
  60.         if (len > 0)
  61.         goto shrink;
  62.         break;
  63.     case 'X':
  64.       shrink:
  65.         if (TARG->str_cur < len)
  66.         fatal("X outside of string");
  67.         TARG->str_cur -= len;
  68.         TARG->str_ptr[TARG->str_cur] = '\0';
  69.         break;
  70.     case 'x':
  71.       grow:
  72.         while (len >= 10) {
  73.         str_ncat(TARG,null10,10);
  74.         len -= 10;
  75.         }
  76.         str_ncat(TARG,null10,len);
  77.         break;
  78.     case 'A':
  79.     case 'a':
  80.         fromstr = NEXTFROM;
  81.         aptr = str_get(fromstr);
  82.         if (pat[-1] == '*')
  83.         len = fromstr->str_cur;
  84.         if (fromstr->str_cur > len)
  85.         str_ncat(TARG,aptr,len);
  86.         else {
  87.         str_ncat(TARG,aptr,fromstr->str_cur);
  88.         len -= fromstr->str_cur;
  89.         if (datumtype == 'A') {
  90.             while (len >= 10) {
  91.             str_ncat(TARG,space10,10);
  92.             len -= 10;
  93.             }
  94.             str_ncat(TARG,space10,len);
  95.         }
  96.         else {
  97.             while (len >= 10) {
  98.             str_ncat(TARG,null10,10);
  99.             len -= 10;
  100.             }
  101.             str_ncat(TARG,null10,len);
  102.         }
  103.         }
  104.         break;
  105.     case 'B':
  106.     case 'b':
  107.         {
  108.         char *savepat = pat;
  109.         int saveitems;
  110.  
  111.         fromstr = NEXTFROM;
  112.         saveitems = items;
  113.         aptr = str_get(fromstr);
  114.         if (pat[-1] == '*')
  115.             len = fromstr->str_cur;
  116.         pat = aptr;
  117.         aint = TARG->str_cur;
  118.         TARG->str_cur += (len+7)/8;
  119.         STR_GROW(TARG, TARG->str_cur + 1);
  120.         aptr = TARG->str_ptr + aint;
  121.         if (len > fromstr->str_cur)
  122.             len = fromstr->str_cur;
  123.         aint = len;
  124.         items = 0;
  125.         if (datumtype == 'B') {
  126.             for (len = 0; len++ < aint;) {
  127.             items |= *pat++ & 1;
  128.             if (len & 7)
  129.                 items <<= 1;
  130.             else {
  131.                 *aptr++ = items & 0xff;
  132.                 items = 0;
  133.             }
  134.             }
  135.         }
  136.         else {
  137.             for (len = 0; len++ < aint;) {
  138.             if (*pat++ & 1)
  139.                 items |= 128;
  140.             if (len & 7)
  141.                 items >>= 1;
  142.             else {
  143.                 *aptr++ = items & 0xff;
  144.                 items = 0;
  145.             }
  146.             }
  147.         }
  148.         if (aint & 7) {
  149.             if (datumtype == 'B')
  150.             items <<= 7 - (aint & 7);
  151.             else
  152.             items >>= 7 - (aint & 7);
  153.             *aptr++ = items & 0xff;
  154.         }
  155.         pat = TARG->str_ptr + TARG->str_cur;
  156.         while (aptr <= pat)
  157.             *aptr++ = '\0';
  158.  
  159.         pat = savepat;
  160.         items = saveitems;
  161.         }
  162.         break;
  163.     case 'H':
  164.     case 'h':
  165.         {
  166.         char *savepat = pat;
  167.         int saveitems;
  168.  
  169.         fromstr = NEXTFROM;
  170.         saveitems = items;
  171.         aptr = str_get(fromstr);
  172.         if (pat[-1] == '*')
  173.             len = fromstr->str_cur;
  174.         pat = aptr;
  175.         aint = TARG->str_cur;
  176.         TARG->str_cur += (len+1)/2;
  177.         STR_GROW(TARG, TARG->str_cur + 1);
  178.         aptr = TARG->str_ptr + aint;
  179.         if (len > fromstr->str_cur)
  180.             len = fromstr->str_cur;
  181.         aint = len;
  182.         items = 0;
  183.         if (datumtype == 'H') {
  184.             for (len = 0; len++ < aint;) {
  185.             if (isALPHA(*pat))
  186.                 items |= ((*pat++ & 15) + 9) & 15;
  187.             else
  188.                 items |= *pat++ & 15;
  189.             if (len & 1)
  190.                 items <<= 4;
  191.             else {
  192.                 *aptr++ = items & 0xff;
  193.                 items = 0;
  194.             }
  195.             }
  196.         }
  197.         else {
  198.             for (len = 0; len++ < aint;) {
  199.             if (isALPHA(*pat))
  200.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  201.             else
  202.                 items |= (*pat++ & 15) << 4;
  203.             if (len & 1)
  204.                 items >>= 4;
  205.             else {
  206.                 *aptr++ = items & 0xff;
  207.                 items = 0;
  208.             }
  209.             }
  210.         }
  211.         if (aint & 1)
  212.             *aptr++ = items & 0xff;
  213.         pat = TARG->str_ptr + TARG->str_cur;
  214.         while (aptr <= pat)
  215.             *aptr++ = '\0';
  216.  
  217.         pat = savepat;
  218.         items = saveitems;
  219.         }
  220.         break;
  221.     case 'C':
  222.     case 'c':
  223.         while (len-- > 0) {
  224.         fromstr = NEXTFROM;
  225.         aint = (int)str_gnum(fromstr);
  226.         achar = aint;
  227.         str_ncat(TARG,&achar,sizeof(char));
  228.         }
  229.         break;
  230.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  231.     case 'f':
  232.     case 'F':
  233.         while (len-- > 0) {
  234.         fromstr = NEXTFROM;
  235.         afloat = (float)str_gnum(fromstr);
  236.         str_ncat(TARG, (char *)&afloat, sizeof (float));
  237.         }
  238.         break;
  239.     case 'd':
  240.     case 'D':
  241.         while (len-- > 0) {
  242.         fromstr = NEXTFROM;
  243.         adouble = (double)str_gnum(fromstr);
  244.         str_ncat(TARG, (char *)&adouble, sizeof (double));
  245.         }
  246.         break;
  247.     case 'n':
  248.         while (len-- > 0) {
  249.         fromstr = NEXTFROM;
  250.         ashort = (short)str_gnum(fromstr);
  251. #ifdef HAS_HTONS
  252.         ashort = htons(ashort);
  253. #endif
  254.         str_ncat(TARG,(char*)&ashort,sizeof(short));
  255.         }
  256.         break;
  257.     case 'v':
  258.         while (len-- > 0) {
  259.         fromstr = NEXTFROM;
  260.         ashort = (short)str_gnum(fromstr);
  261. #ifdef HAS_HTOVS
  262.         ashort = htovs(ashort);
  263. #endif
  264.         str_ncat(TARG,(char*)&ashort,sizeof(short));
  265.         }
  266.         break;
  267.     case 'S':
  268.     case 's':
  269.         while (len-- > 0) {
  270.         fromstr = NEXTFROM;
  271.         ashort = (short)str_gnum(fromstr);
  272.         str_ncat(TARG,(char*)&ashort,sizeof(short));
  273.         }
  274.         break;
  275.     case 'I':
  276.         while (len-- > 0) {
  277.         fromstr = NEXTFROM;
  278.         auint = U_I(str_gnum(fromstr));
  279.         str_ncat(TARG,(char*)&auint,sizeof(unsigned int));
  280.         }
  281.         break;
  282.     case 'i':
  283.         while (len-- > 0) {
  284.         fromstr = NEXTFROM;
  285.         aint = (int)str_gnum(fromstr);
  286.         str_ncat(TARG,(char*)&aint,sizeof(int));
  287.         }
  288.         break;
  289.     case 'N':
  290.         while (len-- > 0) {
  291.         fromstr = NEXTFROM;
  292.         aulong = U_L(str_gnum(fromstr));
  293. #ifdef HAS_HTONL
  294.         aulong = htonl(aulong);
  295. #endif
  296.         str_ncat(TARG,(char*)&aulong,sizeof(unsigned long));
  297.         }
  298.         break;
  299.     case 'V':
  300.         while (len-- > 0) {
  301.         fromstr = NEXTFROM;
  302.         aulong = U_L(str_gnum(fromstr));
  303. #ifdef HAS_HTOVL
  304.         aulong = htovl(aulong);
  305. #endif
  306.         str_ncat(TARG,(char*)&aulong,sizeof(unsigned long));
  307.         }
  308.         break;
  309.     case 'L':
  310.         while (len-- > 0) {
  311.         fromstr = NEXTFROM;
  312.         aulong = U_L(str_gnum(fromstr));
  313.         str_ncat(TARG,(char*)&aulong,sizeof(unsigned long));
  314.         }
  315.         break;
  316.     case 'l':
  317.         while (len-- > 0) {
  318.         fromstr = NEXTFROM;
  319.         along = (long)str_gnum(fromstr);
  320.         str_ncat(TARG,(char*)&along,sizeof(long));
  321.         }
  322.         break;
  323. #ifdef QUAD
  324.     case 'Q':
  325.         while (len-- > 0) {
  326.         fromstr = NEXTFROM;
  327.         auquad = (unsigned quad)str_gnum(fromstr);
  328.         str_ncat(TARG,(char*)&auquad,sizeof(unsigned quad));
  329.         }
  330.         break;
  331.     case 'q':
  332.         while (len-- > 0) {
  333.         fromstr = NEXTFROM;
  334.         aquad = (quad)str_gnum(fromstr);
  335.         str_ncat(TARG,(char*)&aquad,sizeof(quad));
  336.         }
  337.         break;
  338. #endif /* QUAD */
  339.     case 'p':
  340.         while (len-- > 0) {
  341.         fromstr = NEXTFROM;
  342.         aptr = str_get(fromstr);
  343.         str_ncat(TARG,(char*)&aptr,sizeof(char*));
  344.         }
  345.         break;
  346.     case 'u':
  347.         fromstr = NEXTFROM;
  348.         aptr = str_get(fromstr);
  349.         aint = fromstr->str_cur;
  350.         STR_GROW(TARG,aint * 4 / 3);
  351.         if (len <= 1)
  352.         len = 45;
  353.         else
  354.         len = len / 3 * 3;
  355.         while (aint > 0) {
  356.         int todo;
  357.  
  358.         if (aint > len)
  359.             todo = len;
  360.         else
  361.             todo = aint;
  362.         doencodes(TARG, aptr, todo);
  363.         aint -= todo;
  364.         aptr += todo;
  365.         }
  366.         break;
  367.     }
  368.     }
  369.     STABSET(TARG);
  370. }
  371. #undef NEXTFROM
  372.  
  373. static void
  374. doencodes(TARG, s, len)
  375. register STR *TARG;
  376. register char *s;
  377. register int len;
  378. {
  379.     char hunk[5];
  380.  
  381.     *hunk = len + ' ';
  382.     str_ncat(TARG, hunk, 1);
  383.     hunk[4] = '\0';
  384.     while (len > 0) {
  385.     hunk[0] = ' ' + (077 & (*s >> 2));
  386.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  387.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  388.     hunk[3] = ' ' + (077 & (s[2] & 077));
  389.     str_ncat(TARG, hunk, 4);
  390.     s += 3;
  391.     len -= 3;
  392.     }
  393.     for (s = TARG->str_ptr; *s; s++) {
  394.     if (*s == ' ')
  395.         *s = '`';
  396.     }
  397.     str_ncat(TARG, "\n", 1);
  398. }
  399.  
  400.