picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

ht.c (6597B)

      1 /* 18may12abu
      2  * (c) Software Lab. Alexander Burger
      3  */
      4 
      5 #include "pico.h"
      6 
      7 // (ht:Prin 'sym ..) -> sym
      8 any Prin(any x) {
      9    any y = Nil;
     10 
     11    while (isCell(x = cdr(x))) {
     12       if (isNum(y = EVAL(car(x))) || isCell(y) || isExt(y))
     13          prin(y);
     14       else {
     15          int c;
     16          char *p, nm[bufSize(y)];
     17 
     18          bufString(y, nm);
     19          for (p = nm; *p;) {
     20             switch (*(byte*)p) {
     21             case '<':
     22                outString("&lt;");
     23                break;
     24             case '>':
     25                outString("&gt;");
     26                break;
     27             case '&':
     28                outString("&amp;");
     29                break;
     30             case '"':
     31                outString("&quot;");
     32                break;
     33             case 0xFF:
     34                Env.put(0xEF);
     35                Env.put(0xBF);
     36                Env.put(0xBF);
     37                break;
     38             default:
     39                Env.put(c = *p);
     40                if ((c & 0x80) != 0) {
     41                   Env.put(*++p);
     42                   if ((c & 0x20) != 0)
     43                      Env.put(*++p);
     44                }
     45             }
     46             ++p;
     47          }
     48       }
     49    }
     50    return y;
     51 }
     52 
     53 static void putHex(int c) {
     54    int n;
     55 
     56    Env.put('%');
     57    if ((n = c >> 4 & 0xF) > 9)
     58       n += 7;
     59    Env.put(n + '0');
     60    if ((n = c & 0xF) > 9)
     61       n += 7;
     62    Env.put(n + '0');
     63 }
     64 
     65 static void htEncode(char *p) {
     66 	int c;
     67 
     68    while (c = *p++) {
     69       if (strchr(" \"#%&:;<=>?_", c))
     70          putHex(c);
     71       else {
     72          Env.put(c);
     73          if ((c & 0x80) != 0) {
     74             Env.put(*p++);
     75             if ((c & 0x20) != 0)
     76                Env.put(*p++);
     77          }
     78       }
     79    }
     80 }
     81 
     82 static void htFmt(any x) {
     83    any y;
     84 
     85    if (isNum(x))
     86       Env.put('+'),  prin(x);
     87    else if (isCell(x))
     88       do
     89          Env.put('_'),  htFmt(car(x));
     90       while (isCell(x = cdr(x)));
     91    else if (isNum(y = name(x))) {
     92       char nm[bufSize(x)];
     93 
     94       bufString(x, nm);
     95       if (isExt(x))
     96          Env.put('-'),  htEncode(nm);
     97       else if (hashed(x, Intern[ihash(y)]))
     98          Env.put('$'),  htEncode(nm);
     99       else if (strchr("$+-", *nm)) {
    100          putHex(*nm);
    101          htEncode(nm+1);
    102       }
    103       else
    104          htEncode(nm);
    105    }
    106 }
    107 
    108 // (ht:Fmt 'any ..) -> sym
    109 any Fmt(any x) {
    110    int n, i;
    111    cell c[length(x = cdr(x))];
    112 
    113    for (n = 0;  isCell(x);  ++n, x = cdr(x))
    114       Push(c[n], EVAL(car(x)));
    115    begString();
    116    for (i = 0; i < n;) {
    117       htFmt(data(c[i]));
    118       if (++i != n)
    119          Env.put('&');
    120    }
    121    x = endString();
    122    if (n)
    123       drop(c[0]);
    124    return x;
    125 }
    126 
    127 static int getHex(any *p) {
    128    int n, m;
    129 
    130    n = firstByte(car(*p)),  *p = cdr(*p);
    131    if ((n -= '0') > 9)
    132       n = (n & 0xDF) - 7;
    133    m = firstByte(car(*p)),  *p = cdr(*p);
    134    if ((m -= '0') > 9)
    135       m = (m & 0xDF) - 7;
    136    return n << 4 | m;
    137 }
    138 
    139 static bool head(char *s, any x) {
    140    while (*s) {
    141       if (*s++ != firstByte(car(x)))
    142          return NO;
    143       x = cdr(x);
    144    }
    145    return YES;
    146 }
    147 
    148 static int getUnicode(any *p) {
    149    int c, n = 0;
    150    any x = cdr(*p);
    151 
    152    while ((c = firstByte(car(x))) >= '0' && c <= '9') {
    153       n = n * 10 + c - '0';
    154       x = cdr(x);
    155    }
    156    if (n  &&  c == ';') {
    157       *p = cdr(x);
    158       return n;
    159    }
    160    return 0;
    161 }
    162 
    163 // (ht:Pack 'lst) -> sym
    164 any Pack(any x) {
    165    int c;
    166    cell c1;
    167 
    168    x = EVAL(cadr(x));
    169    begString();
    170    Push(c1,x);
    171    while (isCell(x)) {
    172       if ((c = firstByte(car(x))) == '%')
    173          x = cdr(x),  Env.put(getHex(&x));
    174       else if (c != '&')
    175          outName(car(x)), x = cdr(x);
    176       else if (head("lt;", x = cdr(x)))
    177          Env.put('<'), x = cdddr(x);
    178       else if (head("gt;", x))
    179          Env.put('>'), x = cdddr(x);
    180       else if (head("amp;", x))
    181          Env.put('&'), x = cddddr(x);
    182       else if (head("quot;", x))
    183          Env.put('"'), x = cddr(cdddr(x));
    184       else if (head("nbsp;", x))
    185          Env.put(' '), x = cddr(cdddr(x));
    186       else if (firstByte(car(x)) == '#' && (c = getUnicode(&x)))
    187          outName(mkChar(c));
    188       else
    189          Env.put('&');
    190    }
    191    return endString();
    192 }
    193 
    194 /*** Read content length bytes */
    195 // (ht:Read 'cnt) -> lst
    196 any Read(any ex) {
    197    any x;
    198    int n, c;
    199    cell c1;
    200 
    201    if ((n = evCnt(ex, cdr(ex))) <= 0)
    202       return Nil;
    203    if (!Chr)
    204       Env.get();
    205    if (Chr < 0)
    206       return Nil;
    207    if ((c = getChar()) >= 128) {
    208       --n;
    209       if (c >= 2048)
    210          --n;
    211    }
    212    if (--n < 0)
    213       return Nil;
    214    Push(c1, x = cons(mkChar(c), Nil));
    215    while (n) {
    216       Env.get();
    217       if (Chr < 0) {
    218          data(c1) = Nil;
    219          break;
    220       }
    221       if ((c = getChar()) >= 128) {
    222          --n;
    223          if (c >= 2048)
    224             --n;
    225       }
    226       if (--n < 0) {
    227          data(c1) = Nil;
    228          break;
    229       }
    230       x = cdr(x) = cons(mkChar(c), Nil);
    231    }
    232    Chr = 0;
    233    return Pop(c1);
    234 }
    235 
    236 
    237 /*** Chunked Encoding ***/
    238 #define CHUNK 4000
    239 static int Cnt;
    240 static void (*Get)(void);
    241 static void (*Put)(int);
    242 static char Chunk[CHUNK];
    243 
    244 static int chrHex(void) {
    245    if (Chr >= '0' && Chr <= '9')
    246       return Chr - 48;
    247    else if (Chr >= 'A' && Chr <= 'F')
    248       return Chr - 55;
    249    else if (Chr >= 'a' && Chr <= 'f')
    250       return Chr - 87;
    251    else
    252       return -1;
    253 }
    254 
    255 static void chunkSize(void) {
    256    int n;
    257 
    258    if (!Chr)
    259       Get();
    260    if ((Cnt = chrHex()) >= 0) {
    261       while (Get(), (n = chrHex()) >= 0)
    262          Cnt = Cnt << 4 | n;
    263       while (Chr != '\n') {
    264          if (Chr < 0)
    265             return;
    266          Get();
    267       }
    268       Get();
    269       if (Cnt == 0) {
    270          Get();  // Skip '\r' of empty line
    271          Chr = 0;  // Discard '\n'
    272       }
    273    }
    274 }
    275 
    276 static void getChunked(void) {
    277    if (Cnt <= 0)
    278       Chr = -1;
    279    else {
    280       Get();
    281       if (--Cnt == 0) {
    282          Get(), Get();  // Skip '\n', '\r'
    283          chunkSize();
    284       }
    285    }
    286 }
    287 
    288 // (ht:In 'flg . prg) -> any
    289 any In(any x) {
    290    x = cdr(x);
    291    if (isNil(EVAL(car(x))))
    292       return prog(cdr(x));
    293    Get = Env.get,  Env.get = getChunked;
    294    chunkSize();
    295    x = prog(cdr(x));
    296    Env.get = Get;
    297    Chr = 0;
    298    return x;
    299 }
    300 
    301 static void wrChunk(void) {
    302    int i;
    303    char buf[BITS/2];
    304 
    305    sprintf(buf, "%x\r\n", Cnt);
    306    i = 0;
    307    do
    308       Put(buf[i]);
    309    while (buf[++i]);
    310    for (i = 0; i < Cnt; ++i)
    311       Put(Chunk[i]);
    312    Put('\r'), Put('\n');
    313 }
    314 
    315 static void putChunked(int c) {
    316    Chunk[Cnt++] = c;
    317    if (Cnt == CHUNK)
    318       wrChunk(),  Cnt = 0;
    319 }
    320 
    321 // (ht:Out 'flg . prg) -> any
    322 any Out(any x) {
    323    x = cdr(x);
    324    if (isNil(EVAL(car(x))))
    325       x = prog(cdr(x));
    326    else {
    327       Cnt = 0;
    328       Put = Env.put,  Env.put = putChunked;
    329       x = prog(cdr(x));
    330       if (Cnt)
    331          wrChunk();
    332       Env.put = Put;
    333       outString("0\r\n\r\n");
    334    }
    335    flush(OutFile);
    336    return x;
    337 }