home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / BEETLE / BEETLE.ZIP / Beetle / lib.c < prev    next >
C/C++ Source or Header  |  1997-04-22  |  4KB  |  185 lines
  1. /* LIB.C
  2.  
  3.     Vrsn  Date   Comment
  4.     ----|-------|---------------------------------------------------------------
  5.     0.00 24mar95 Code removed from step.c v0.21. See that file for earlier
  6.                  history. Code made into a #included fragment rather than a
  7.                  function.
  8.     0.01 02apr95 Added GETCH.
  9.     0.02 03apr95 Added PUTCH and NEWL.
  10.     0.03 18apr95 Added file-handling code.
  11.     0.04 19apr95 Made OPEN-FILE call (4) work on big-endian Beetles.
  12.     0.05 18jun96 Made into a function for ease of interworking with hand-coded
  13.                  run and step implementations. Address checks disabled.
  14.     0.06 01aug96 Moved code to read zero-terminated string from Beetle's memory
  15.              to getstr. Added more file-handling code.
  16.     0.07 30mar97 Changed lib's parameter to a UCELL.áAdded #include of lib.h.
  17.  
  18.     Reuben Thomas
  19.  
  20.  
  21.     Beetle's standard library.
  22.  
  23. */
  24.  
  25.  
  26. #include <stdio.h>
  27. #include "beetle.h"     /* main header */
  28. #include "opcodes.h"    /* opcode enumeration */
  29. #include "lib.h"        /* the header we're implementing */
  30.  
  31.  
  32. #define CHECKA(x)
  33. #define PTRS 16
  34.  
  35. void getstr(unsigned char *s, UCELL adr)
  36. {
  37.     int i;
  38.  
  39.     for (i = 0; *(M0 + FLIP(adr)) != 0; adr++)
  40.         s[i++] = *(M0 + FLIP(adr));
  41.     s[i] = '\0';
  42. }
  43.  
  44. void lib(UCELL routine)
  45. {
  46.     static FILE *ptr[PTRS];
  47.     static lastptr = 0;
  48.  
  49.     switch (routine) {
  50.  
  51.         /* BL */
  52.         case 0: CHECKA(SP - 1); *--SP = 32; break;
  53.  
  54.         /* CR */
  55.         case 1: NEWL; break;
  56.  
  57.         /* EMIT */
  58.         case 2: CHECKA(SP); PUTCH((BYTE)*SP); SP++; break;
  59.  
  60.         /* KEY */
  61.         case 3: CHECKA(SP - 1); *--SP = (CELL)(GETCH); break;
  62.  
  63.         /* OPEN-FILE */
  64.         case 4:
  65.             {
  66.                 int p = (lastptr == PTRS ? -1 : lastptr++);
  67.                 unsigned char file[256], perm[4];
  68.  
  69.                 if (p == -1) *SP = -1;
  70.                 else {
  71.                     getstr(file, *((UCELL *)SP + 1));
  72.                     getstr(perm, *(UCELL *)SP);
  73.                     ptr[p] = fopen((char *)file, (char *)perm);
  74.                     *SP = 0;
  75.                     *(SP + 1) = p;
  76.                 }
  77.             }
  78.             break;
  79.  
  80.         /* CLOSE-FILE */
  81.         case 5:
  82.             {
  83.                 int p = *SP, i;
  84.  
  85.                 *SP = fclose(ptr[p]);
  86.                 for (i = p; i < lastptr; i++) ptr[i] = ptr[i + 1];
  87.                 lastptr--;
  88.             }
  89.             break;
  90.  
  91.         /* READ-FILE */
  92.         case 6:
  93.             {
  94.                 unsigned long i;
  95.                 int c = 0;
  96.  
  97.                 for (i = 0; i < *((UCELL *)SP + 1) && c != EOF; i++) {
  98.                     c = fgetc(ptr[*SP]);
  99.                     if (c != EOF)
  100.                         *(M0 + FLIP(*((UCELL *)SP + 2) + i)) = (BYTE)c;
  101.                 }
  102.                 SP++;
  103.                 if (c != EOF) *SP = 0;
  104.                 else *SP = -1;
  105.                 *((UCELL *)SP + 1) = (UCELL)i;
  106.             }
  107.             break;
  108.  
  109.     /* WRITE-FILE */
  110.         case 7:
  111.             {
  112.                 unsigned long i;
  113.                 int c = 0;
  114.  
  115.                     for (i = 0; i < *((UCELL *)SP + 1) && c != EOF; i++)
  116.                         c = fputc(*(M0 + FLIP(*((UCELL *)SP + 2) + i)),
  117.                             ptr[*SP]);
  118.                 SP += 2;
  119.                 if (c != EOF) *SP = 0;
  120.                 else *SP = -1;
  121.             }
  122.             break;
  123.  
  124.         /* FILE-POSITION */
  125.         case 8:
  126.             {
  127.                 long res = ftell(ptr[*SP]);
  128.  
  129.                 *((UCELL *)SP--) = (UCELL)res;
  130.                 if (res != -1) *SP = 0;
  131.                 else *SP = -1;
  132.                 }
  133.                 break;
  134.  
  135.         /* REPOSITION-FILE */
  136.         case 9:
  137.             {
  138.                 int res = fseek(ptr[*SP], *((UCELL *)SP + 1), SEEK_SET);
  139.  
  140.                 *++SP = (UCELL)res;
  141.             }
  142.             break;
  143.  
  144.         /* FLUSH-FILE */
  145.         case 10:
  146.             {
  147.                 int res = fflush(ptr[*SP]);
  148.  
  149.                 if (res != EOF) *SP = 0;
  150.                 else *SP = -1;
  151.             }
  152.             break;
  153.  
  154.         /* RENAME-FILE */
  155.         case 11:
  156.             {
  157.                 int res;
  158.                 unsigned char from[256], to[256];
  159.  
  160.                 getstr(from, *((UCELL *)SP + 1));
  161.                 getstr(to, *(UCELL *)SP++);
  162.                 res = rename((char *)from, (char *)to);
  163.  
  164.                 if (res != 0) *SP = -1;
  165.                 else *SP = 0;
  166.             }
  167.             break;
  168.  
  169.         /* DELETE-FILE */
  170.         case 12:
  171.             {
  172.                 int res;
  173.                 unsigned char file[256];
  174.  
  175.                 getstr(file, *(UCELL *)SP);
  176.                 res = remove((char *)file);
  177.  
  178.                 if (res != 0) *SP = -1;
  179.                 else *SP = 0;
  180.             }
  181.             break;
  182.  
  183.     }
  184. }
  185.