home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP11.ARK / XLPRIN.C < prev    next >
Text File  |  1986-10-12  |  3KB  |  174 lines
  1. /* xlprint - xlisp print routine */
  2.  
  3. #ifdef AZTEC
  4. #include "a:stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13.  
  14. /* local variables */
  15. static struct node *printsym;
  16.  
  17. /* print - builtin function print */
  18. static struct node *print(args)
  19.   struct node *args;
  20. {
  21.     xprint(args,TRUE);
  22. }
  23.  
  24. /* princ - builtin function princ */
  25. static struct node *princ(args)
  26.   struct node *args;
  27. {
  28.     xprint(args,FALSE);
  29. }
  30.  
  31. /* xprint - common print function */
  32. xprint(args,flag)
  33.   struct node *args; int flag;
  34. {
  35.     struct node *oldstk,arg,val;
  36.  
  37.     /* create a new stack frame */
  38.     oldstk = xlsave(&arg,&val,NULL);
  39.  
  40.     /* initialize */
  41.     arg.n_ptr = args;
  42.  
  43.     /* evaluate and print each argument */
  44.     while (arg.n_ptr != NULL)
  45.     xlprint(xlevarg(&arg.n_ptr),flag);
  46.  
  47.     /* restore previous stack frame */
  48.     xlstack = oldstk;
  49.  
  50.     /* return null */
  51.     return (NULL);
  52. }
  53.  
  54. /* xlprint - print an xlisp value */
  55. xlprint(vptr,flag)
  56.   struct node *vptr; int flag;
  57. {
  58.     struct node *nptr,*next,*msg;
  59. #ifdef FGETNAME 
  60.     char buffer[128];
  61. #endif
  62.  
  63.     /* print null as the empty list */
  64.     if (vptr == NULL) {
  65.     printf("()");
  66.     return;
  67.     }
  68.  
  69.     /* check value type */
  70.     switch (vptr->n_type) {
  71.     case SUBR:
  72.         printf("<Subr: #%o>",vptr);
  73.         break;
  74.     case LIST:
  75.         putchar('(');
  76.         for (nptr = vptr; nptr != NULL; nptr = next) {
  77.             xlprint(nptr->n_listvalue,flag);
  78.         if ((next = nptr->n_listnext) != NULL)
  79.             if (next->n_type == LIST)
  80.             putchar(' ');
  81.             else {
  82.             putchar('.');
  83.             xlprint(next,flag);
  84.             break;
  85.             }
  86.         }
  87.         putchar(')');
  88.         break;
  89.     case SYM:
  90.         printf("%s",vptr->n_symname);
  91.         break;
  92.     case INT:
  93.         printf("%d",vptr->n_int);
  94.         break;
  95.     case STR:
  96.         if (flag)
  97.         putstring(vptr->n_str);
  98.         else
  99.         printf("%s",vptr->n_str);
  100.         break;
  101.     case FPTR:
  102. #ifdef FGETNAME
  103.         printf("<File: %s>",fgetname(vptr->n_fp, buffer));
  104. #else
  105.         printf("<File: #%o>",vptr);
  106. #endif
  107.         break;
  108.     case OBJ:
  109.         if ((msg = xlmfind(vptr,printsym)) == NULL)
  110.         xlfail("no print message");
  111.         xlxsend(vptr,msg,NULL);
  112.         break;
  113.     case KMAP:
  114.         printf("<Kmap: #%o>",vptr);
  115.         break;
  116.     }
  117. }
  118.  
  119. /* putstring - output a string */
  120. static putstring(str)
  121.   char *str;
  122. {
  123.     int ch;
  124.  
  125.     /* output the initial quote */
  126.     putchar('"');
  127.  
  128.     /* output each character in the string */
  129.     while (ch = *str++)
  130.  
  131.     /* check for a control character */
  132.     if (ch < 040 || ch == '\\') {
  133.         putchar('\\');
  134.         switch (ch) {
  135.         case '\033':
  136.             putchar('e');
  137.             break;
  138.         case '\n':
  139.             putchar('n');
  140.             break;
  141.         case '\r':
  142.             putchar('r');
  143.             break;
  144.         case '\t':
  145.             putchar('t');
  146.             break;
  147.         case '\\':
  148.             putchar('\\');
  149.             break;
  150.         default:
  151.             printf("%03o",ch);
  152.             break;
  153.         }
  154.     }
  155.  
  156.     /* output a normal character */
  157.     else
  158.         putchar(ch);
  159.  
  160.     /* output the terminating quote */
  161.     putchar('"');
  162. }
  163.  
  164. /* xlpinit - initialize the print routines */
  165. xlpinit()
  166. {
  167.     /* find the 'print' symbol */
  168.     printsym = xlenter("print");
  169.  
  170.     /* enter builtin functions */
  171.     xlsubr("print",print);
  172.     xlsubr("princ",princ);
  173. }
  174.