home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0400 / CCE_0442.ZIP / CCE_0442.PD / XSCHEM28 / STSTUFF.C < prev    next >
C/C++ Source or Header  |  1991-11-23  |  7KB  |  363 lines
  1. /* ststuff.c - atari-st specific routines */
  2.  
  3. #include <osbind.h>
  4. #include "xscheme.h"
  5.  
  6. #define STRMAX         100             /* maximum length of a string constant */
  7. /* char buf[STRMAX+1] = { 0 }; */
  8. static char buf[200];
  9.  
  10. #define LBSIZE 200
  11.  
  12. /* set MWC memory parameters */
  13. long _stksize = 16384;    /* stack must be 16K */
  14.  
  15. /* external variables */
  16. extern LVAL s_unbound,true;
  17. extern FILE *tfp;
  18. extern int errno;
  19.  
  20. /* local variables */
  21. static char lbuf[LBSIZE];
  22. static int lpos[LBSIZE];
  23. static int lindex;
  24. static int lcount;
  25. static int lposition;
  26. static long rseed = 1L;
  27.  
  28. #ifdef __STDC__
  29. static void xinfo(void);
  30. static void xflush(void);
  31. static int xgetc(void);
  32. static void xputc(int ch);
  33. static int xcheck(void);
  34. #endif
  35.  
  36. /* main - the main routine */
  37. void main(argc,argv)
  38.   int argc; char *argv[];
  39. {
  40.     xlmain(argc,argv);
  41. }
  42.  
  43. /* osinit - initialize */
  44. void osinit(banner)
  45.   char *banner;
  46. {
  47.     ostputs(banner);
  48.     ostputc('\n');
  49.     lposition = 0;
  50.     lindex = 0;
  51.     lcount = 0;
  52. }
  53.  
  54. /* osfinish - clean up before returning to the operating system */
  55. void osfinish()
  56. {
  57. }
  58.  
  59. /* oserror - print an error message */
  60. void oserror(msg)
  61.   char *msg;
  62. {
  63.     ostputs("error: ");
  64.     ostputs(msg);
  65.     ostputc('\n');
  66. }
  67.  
  68. /* osrand - return a random number between 0 and n-1 */
  69. int osrand(n)
  70.   int n;
  71. {
  72.     long k1;
  73.  
  74.     /* make sure we don't get stuck at zero */
  75.     if (rseed == 0L) rseed = 1L;
  76.  
  77.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  78.     k1 = rseed / 127773L;
  79.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  80.     rseed += 2147483647L;
  81.  
  82.     /* return a random number between 0 and n-1 */
  83.     return ((int)(rseed % (long)n));
  84. }
  85.  
  86. /* osaopen - open an ascii file */
  87. FILE *osaopen(name,mode)
  88.   char *name,*mode;
  89. {
  90.     return (fopen(name,mode));
  91. }
  92.  
  93. /* osbopen - open a binary file */
  94. FILE *osbopen(name,mode)
  95.   char *name,*mode;
  96. {
  97.     char bmode[10];
  98.     strcpy(bmode,mode); strcat(bmode,"b");
  99.     return (fopen(name,bmode));
  100. }
  101.  
  102. /* osclose - close a file */
  103. int osclose(fp)
  104.   FILE *fp;
  105. {
  106.     return (fclose(fp));
  107. }
  108.  
  109. /* ostell - get the current file position */
  110. long ostell(fp)
  111.   FILE *fp;
  112. {
  113.     return (ftell(fp));
  114. }
  115.  
  116. /* osseek - set the current file position */
  117. int osseek(fp,offset,whence)
  118.   FILE *fp; long offset; int whence;
  119. {
  120.     return (fseek(fp,offset,whence));
  121. }
  122.  
  123. /* osagetc - get a character from an ascii file */
  124. int osagetc(fp)
  125.   FILE *fp;
  126. {
  127.     return (getc(fp));
  128. }
  129.  
  130. /* osaputc - put a character to an ascii file */
  131. int osaputc(ch,fp)
  132.   int ch; FILE *fp;
  133. {
  134.     return (putc(ch,fp));
  135. }
  136.  
  137. /* osbgetc - get a character from a binary file */
  138. int osbgetc(fp)
  139.   FILE *fp;
  140. {
  141.     return (getc(fp));
  142. }
  143.  
  144. /* osbputc - put a character to a binary file */
  145. int osbputc(ch,fp)
  146.   int ch; FILE *fp;
  147. {
  148.     return (putc(ch,fp));
  149. }
  150.  
  151. /* ostgetc - get a character from the terminal */
  152. int ostgetc()
  153. {
  154.     int ch;
  155.  
  156.     /* check for a buffered character */
  157.     if (lcount--)
  158.     return (lbuf[lindex++]);
  159.  
  160.     /* get an input line */
  161.     for (lcount = 0; ; )
  162.     switch (ch = xgetc()) {
  163.     case '\r':
  164.         lbuf[lcount++] = '\n';
  165.         xputc('\r'); xputc('\n'); lposition = 0;
  166.         if (tfp)
  167.             for (lindex = 0; lindex < lcount; ++lindex)
  168.             osaputc(lbuf[lindex],tfp);
  169.         lindex = 0; lcount--;
  170.         return (lbuf[lindex++]);
  171.     case '\010':
  172.     case '\177':
  173.         if (lcount) {
  174.             lcount--;
  175.             while (lposition > lpos[lcount]) {
  176.             xputc('\010'); xputc(' '); xputc('\010');
  177.             lposition--;
  178.             }
  179.         }
  180.         break;
  181.     case '\032':
  182.         xflush();
  183.         return (EOF);
  184.     default:
  185.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  186.             lbuf[lcount] = ch;
  187.             lpos[lcount] = lposition;
  188.             if (ch == '\t')
  189.             do {
  190.                 xputc(' ');
  191.             } while (++lposition & 7);
  192.             else {
  193.             xputc(ch); lposition++;
  194.             }
  195.             lcount++;
  196.         }
  197.         else {
  198.             xflush();
  199.             switch (ch) {
  200.             case '\003':    xltoplevel();    /* control-c */
  201.             case '\007':    xlcleanup();    /* control-g */
  202.             case '\020':    xlcontinue();    /* control-p */
  203.             case '\032':    return (EOF);    /* control-z */
  204.             case '\034':    xlwrapup();    /* control-\ */
  205.             default:        return (ch);
  206.             }
  207.         }
  208.     }
  209. }
  210.  
  211. /* ostputc - put a character to the terminal */
  212. void ostputc(ch)
  213.   int ch;
  214. {
  215.     /* check for control characters */
  216.     oscheck();
  217.  
  218.     /* output the character */
  219.     if (ch == '\n') {
  220.     xputc('\r'); xputc('\n');
  221.     lposition = 0;
  222.     }
  223.     else {
  224.     xputc(ch);
  225.     lposition++;
  226.    }
  227.  
  228.    /* output the character to the transcript file */
  229.    if (tfp)
  230.     osaputc(ch,tfp);
  231. }
  232.  
  233. /* ostputs - output a string to the terminal */
  234. void ostputs(str)
  235.   char *str;
  236. {
  237.     while (*str != '\0')
  238.     ostputc(*str++);
  239. }
  240.  
  241. /* osflush - flush the terminal input buffer */
  242. void osflush()
  243. {
  244.     lindex = lcount = lposition = 0;
  245. }
  246.  
  247. /* oscheck - check for control characters during execution */
  248. void oscheck()
  249. {
  250.     switch (xcheck()) {
  251.     case '\002':    /* control-b */
  252.     xflush();
  253.     xlbreak();
  254.     break;
  255.     case '\003':    /* control-c */
  256.     xflush();
  257.     xltoplevel();
  258.     break;
  259.     case '\024':    /* control-t */
  260.     xinfo();
  261.     break;
  262.     case '\023':    /* control-s */
  263.     while (xcheck() != '\021')
  264.         ;
  265.     break;
  266.     case '\034':    /* control-\ */
  267.     xlwrapup();
  268.     break;
  269.     }
  270. }
  271.  
  272. /* xinfo - show information on control-t */
  273. static void xinfo()
  274. {
  275. /*
  276.     extern int nfree,gccalls;
  277.     extern long total;
  278.     char buf[80];
  279.     sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %ld ]",
  280.         nfree,gccalls,total);
  281.     errputstr(buf);
  282. */
  283. }
  284.  
  285. /* xflush - flush the input line buffer and start a new line */
  286. static void xflush()
  287. {
  288.     osflush();
  289.     ostputc('\n');
  290. }
  291.  
  292. /* xgetc - get a character from the terminal without echo */
  293. static int xgetc()
  294. {
  295.     int ch;
  296.     while ((ch = Crawio(0xFF)) == 0)
  297.     ;
  298.     return (ch & 0xFF);
  299. }
  300.  
  301. /* xputc - put a character to the terminal */
  302. static void xputc(ch)
  303.   int ch;
  304. {
  305.     Crawio(ch);
  306. }
  307.  
  308. /* xcheck - check for a character */
  309. static int xcheck()
  310. {
  311.     return (Crawio(0xFF));
  312. }
  313.  
  314. /* file name extension table */
  315. char *ext[] = { ".prg",".tos",".ttp",NULL };
  316.  
  317. /* xsystem - the built-in function 'system' */
  318. LVAL xsystem()
  319. {
  320.     char *str,*p,cmd[100];
  321.     int cmdlen,sts,i;
  322.  
  323.     /* get the command string */
  324.     str = getstring(xlgastring());
  325.     xllastarg();
  326.  
  327.     /* get the command name */
  328.     for (p = cmd, cmdlen = 0; *str && !isspace(*str); ++cmdlen)
  329.     *p++ = *str++;
  330.     *p = '\0';
  331.  
  332.     /* skip spaces between the command name and the arguments */
  333.     while (*str && isspace(*str))
  334.     ++str;
  335.  
  336.     /* make a counted ascii argument list */
  337.     for (p = &buf[1], buf[0] = '\0'; *str; ++buf[0])
  338.     *p++ = *str++;
  339.     *p = '\0';
  340.  
  341.     /* try each extension */
  342.     for (i = 0; ext[i]; ++i) {
  343.     strcpy(&cmd[cmdlen],ext[i]);
  344.     if ((sts = Pexec(0,cmd,buf,"")) != -33)
  345.         break;
  346.     }
  347.  
  348.     /* return the completion status */
  349.     return (cvfixnum((FIXTYPE)sts));
  350. }
  351.  
  352. /* xgetkey - get a key from the keyboard */
  353. LVAL xgetkey()
  354. {
  355.     xllastarg();
  356.     return (cvfixnum((FIXTYPE)xgetc()));
  357. }
  358.  
  359. /* ossymbols - lookup important symbols */
  360. void ossymbols()
  361. {
  362. }
  363.