home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 09 / bob / bobfcn.c < prev    next >
Text File  |  1991-07-11  |  5KB  |  218 lines
  1. /* bobfcn.c - built-in classes and functions */
  2. /*
  3.     Copyright (c) 1991, by David Michael Betz
  4.     All rights reserved
  5. */
  6.  
  7. #include "bob.h"
  8.  
  9. /* argument check macros */
  10. #define argmin(n,min)    ((n) < (min) ? toofew() : TRUE)
  11. #define argmax(n,max)    ((n) > (max) ? toomany() : TRUE)
  12. #define argcount(n,cnt)    (argmin(n,cnt) ? argmax(n,cnt) : FALSE)
  13.  
  14. /* external variables */
  15. extern DICTIONARY *symbols;
  16.  
  17. /* forward declarations */
  18. int xnewvector(),xnewstring(),xprint();
  19. int xfopen(),xfclose(),xgetc(),xputc();
  20.  
  21. /* init_functions - initialize the internal functions */
  22. void init_functions()
  23. {
  24.     add_file("stdin",stdin);
  25.     add_file("stdout",stdout);
  26.     add_file("stderr",stderr);
  27.     add_function("newvector",xnewvector);
  28.     add_function("newstring",xnewstring);
  29.     add_function("fopen",xfopen);
  30.     add_function("fclose",xfclose);
  31.     add_function("getc",xgetc);
  32.     add_function("putc",xputc);
  33.     add_function("print",xprint);
  34. }
  35.  
  36. /* add_function - add a built-in function */
  37. static add_function(name,fcn)
  38.   char *name; int (*fcn)();
  39. {
  40.     DICT_ENTRY *sym;
  41.     sym = addentry(symbols,name,ST_SFUNCTION);
  42.     set_code(&sym->de_value,fcn);
  43. }
  44.  
  45. /* add_file - add a built-in file */
  46. static add_file(name,fp)
  47.   char *name; FILE *fp;
  48. {
  49.     DICT_ENTRY *sym;
  50.     sym = addentry(symbols,name,ST_SDATA);
  51.     set_file(&sym->de_value,fp);
  52. }
  53.  
  54. /* xnewvector - allocate a new vector */
  55. static int xnewvector(argc)
  56.   int argc;
  57. {
  58.     int size;
  59.     argcount(argc,1);
  60.     chktype(0,DT_INTEGER);
  61.     size = sp->v.v_integer;
  62.     ++sp;
  63.     set_vector(&sp[0],newvector(size));
  64. }
  65.  
  66. /* xnewstring - allocate a new string */
  67. static int xnewstring(argc)
  68.   int argc;
  69. {
  70.     int size;
  71.     argcount(argc,1);
  72.     chktype(0,DT_INTEGER);
  73.     size = sp->v.v_integer;
  74.     ++sp;
  75.     set_string(&sp[0],newstring(size));
  76. }
  77.  
  78. /* xfopen - open a file */
  79. static int xfopen(argc)
  80.   int argc;
  81. {
  82.     char name[50],mode[10];
  83.     FILE *fp;
  84.     argcount(argc,2);
  85.     chktype(0,DT_STRING);
  86.     chktype(1,DT_STRING);
  87.     getcstring(name,sizeof(name),sp[1].v.v_string);
  88.     getcstring(mode,sizeof(mode),sp[0].v.v_string);
  89.     fp = fopen(name,mode);
  90.     sp += 2;
  91.     if (fp)
  92.     set_file(&sp[0],fp);
  93.     else
  94.     set_nil(&sp[0]);
  95. }
  96.  
  97. /* xfclose - close a file */
  98. static int xfclose(argc)
  99.   int argc;
  100. {
  101.     int sts;
  102.     argcount(argc,1);
  103.     chktype(0,DT_FILE);
  104.     sts = fclose(sp[0].v.v_fp);
  105.     ++sp;
  106.     set_integer(&sp[0],sts);
  107. }
  108.  
  109. /* xgetc - get a character from a file */
  110. static int xgetc(argc)
  111.   int argc;
  112. {
  113.     int ch;
  114.     argcount(argc,1);
  115.     chktype(0,DT_FILE);
  116.     ch = getc(sp[0].v.v_fp);
  117.     ++sp;
  118.     set_integer(&sp[0],ch);
  119. }
  120.  
  121. /* xputc - output a character to a file */
  122. static int xputc(argc)
  123.   int argc;
  124. {
  125.     int ch;
  126.     argcount(argc,2);
  127.     chktype(0,DT_FILE);
  128.     chktype(1,DT_INTEGER);
  129.     ch = putc(sp[1].v.v_integer,sp[0].v.v_fp);
  130.     sp += 2;
  131.     set_integer(&sp[0],ch);
  132. }
  133.  
  134. /* xprint - generic print function */
  135. static int xprint(argc)
  136.   int argc;
  137. {
  138.     int n;
  139.     for (n = argc; --n >= 0; )
  140.     print1(FALSE,&sp[n]);
  141.     sp += argc;
  142.     set_nil(sp);
  143. }
  144.  
  145. /* print1 - print one value */
  146. print1(qflag,val)
  147.   int qflag; VALUE *val;
  148. {
  149.     char buf[200],*p;
  150.     CLASS *class;
  151.     int len;
  152.     switch (val->v_type) {
  153.     case DT_NIL:
  154.     osputs("nil");
  155.     break;
  156.     case DT_CLASS:
  157.     sprintf(buf,"#<Class-%s>",val->v.v_class->cl_name);
  158.     osputs(buf);
  159.     break;
  160.     case DT_OBJECT:
  161.     sprintf(buf,"#<Object-%lx>",val->v.v_object);
  162.     osputs(buf);
  163.     break;
  164.     case DT_VECTOR:
  165.     sprintf(buf,"#<Vector-%lx>",val->v.v_vector);
  166.     osputs(buf);
  167.     break;
  168.     case DT_INTEGER:
  169.     sprintf(buf,"%ld",val->v.v_integer);
  170.     osputs(buf);
  171.     break;
  172.     case DT_STRING:
  173.     if (qflag) osputs("\"");
  174.     p = val->v.v_string->s_data;
  175.     len = val->v.v_string->s_length;
  176.     while (--len >= 0)
  177.         osputc(*p++);
  178.     if (qflag) osputs("\"");
  179.     break;
  180.     case DT_BYTECODE:
  181.     sprintf(buf,"#<Bytecode-%lx>",val->v.v_bytecode);
  182.     osputs(buf);
  183.     break;
  184.     case DT_CODE:
  185.     sprintf(buf,"#<Code-%lx>",val->v.v_code);
  186.     osputs(buf);
  187.     break;
  188.     case DT_VAR:
  189.     if ((class = val->v.v_var->de_dictionary->di_class) == NULL)
  190.         osputs(val->v.v_var->de_key);
  191.     else {
  192.         sprintf(buf,"%s::%s",class->cl_name,val->v.v_var->de_key);
  193.         osputs(buf);
  194.     }
  195.     break;
  196.     case DT_FILE:
  197.     sprintf(buf,"#<File-%lx>",val->v.v_fp);
  198.     osputs(buf);
  199.     break;
  200.     default:
  201.     error("Undefined type: %d",val->v_type);
  202.     }
  203. }
  204.  
  205. /* toofew - too few arguments */
  206. static int toofew()
  207. {
  208.     error("Too few arguments");
  209.     return (FALSE);
  210. }
  211.  
  212. /* toomany - too many arguments */
  213. static int toomany()
  214. {
  215.     error("Too many arguments");
  216.     return (FALSE);
  217. }
  218.