home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fxmsdos.ri < prev    next >
Text File  |  1996-03-22  |  7KB  |  333 lines
  1. /*
  2.  * fxmsdos.ri
  3.  */
  4.  
  5. char *zptr = NULL;
  6.  
  7. /*
  8.  * Prototype.
  9.  */
  10.  
  11. int    getlist    Params((struct b_lelem *bp,unsigned int *vals, int limit));
  12.  
  13. "Int86(a) - perform an interrupt"
  14.  
  15. #if MICROSOFT || TURBO || ZTC_386 || BORLAND_286 || BORLAND_386 || SCCX_MX
  16. function{1} Int86(a)
  17.    /*
  18.     * Make sure that a is a list
  19.     */
  20.    if !is:list(a) then
  21.       runerr(118,a)
  22.    abstract {
  23.       return list
  24.       }
  25.    body {
  26.        union  REGS inreg,outreg;
  27.        struct SREGS insreg,outsreg;
  28.  
  29. #if BORLAND_386
  30. #define ax eax
  31. #define bx ebx
  32. #define cx ecx
  33. #define dx edx
  34. #define si esi
  35. #define di edi
  36. #define int86x int386x
  37. #endif                    /* BORLAND_386 */
  38.  
  39.        unsigned int vals[9];
  40.        unsigned int flag;
  41.        word nslots;
  42.  
  43.        struct b_list *hp;
  44.        struct b_lelem *bp;
  45.  
  46.       /*
  47.        * Make sure that a only has 9 values, and all are ints.
  48.        */
  49.        hp = (struct b_list *) BlkLoc(a);
  50.        if (hp->size != 9) {
  51.           runerr(205, a);
  52.           }
  53.  
  54.        bp = (struct b_lelem *) hp->listhead;
  55.        if (getlist(bp, vals, 9) == Failed)
  56.           fail;
  57.        flag = vals[0];
  58.  
  59.        inreg.x.ax = vals[1];
  60.        inreg.x.bx = vals[2];
  61.        inreg.x.cx = vals[3];
  62.        inreg.x.dx = vals[4];
  63.        inreg.x.si = vals[5];
  64.        inreg.x.di = vals[6];
  65.        segread(&insreg);
  66. #if BORLAND_286 || BORLAND_386
  67.        /*
  68.         * Only set segment registers if caller provided a non-zero value.
  69.         * This probably should be done for all protected-mode versions, and
  70.         * instruct user to specify 0 for ds/es to use default ds/es.
  71.         * Unlike PharLap, Borland does not publish known selector values
  72.         * to use in ds or es.  Loading a garbage value will result in a
  73.         * trap.
  74.         */
  75.        if (vals[7])
  76.           insreg.es = vals[7];
  77.        if (vals[8])
  78.           insreg.ds = vals[8];
  79. #endif                    /* BORLAND_286 || BORLAND_386 */
  80.  
  81.    /*  flag = int86x(flag,&inreg,&outreg,&insreg); */
  82.  
  83.        int86x(flag,&inreg,&outreg,&insreg);    /* ... this should work for */
  84.        flag = outreg.x.cflag;            /* ... both MSC and Turbo C */
  85.  
  86.       /*
  87.        * Return the values.
  88.        */
  89.       nslots = 9;
  90.  
  91.       Protect(hp = alclist((word)9), runerr(0));
  92.       Protect(bp = alclstb(nslots,(word)0,(word)9), runerr(0));
  93.       hp->listhead = hp->listtail = (union block *) bp;
  94.  
  95.       /* returns [flags,ax,bx,cx,dx,si,di,es,ds] */
  96.  
  97.       MakeInt((uword)flag,&(bp->lslots[0]));
  98.       MakeInt((uword)outreg.x.ax,&(bp->lslots[1]));
  99.       MakeInt((uword)outreg.x.bx,&(bp->lslots[2]));
  100.       MakeInt((uword)outreg.x.cx,&(bp->lslots[3]));
  101.       MakeInt((uword)outreg.x.dx,&(bp->lslots[4]));
  102.       MakeInt((uword)outreg.x.si,&(bp->lslots[5]));
  103.       MakeInt((uword)outreg.x.di,&(bp->lslots[6]));
  104.       MakeInt((uword)insreg.es,&(bp->lslots[7]));
  105.       MakeInt((uword)insreg.ds,&(bp->lslots[8]));
  106.  
  107.       result.dword = D_List;
  108.       result.vword.bptr = (union block *) hp;
  109.       return result;
  110.       }
  111. end
  112. #endif                    /* MICROSOFT || TURBO || ZTC_386 ... */
  113.  
  114.  
  115. "Peek(addr,len) - read from memory"
  116.  
  117. function{1} Peek(addr,len)
  118.    declare {
  119.       C_integer _len_;
  120.       }
  121.    if !def:C_integer(len,1,_len_) then
  122.       runerr(101,len)
  123.    abstract {
  124.       return string
  125.       }
  126.    body {
  127.       unsigned int vals[2];
  128.       struct b_list *hp;
  129.       struct b_lelem *bp;
  130.       union {
  131.           char *cptr;
  132.           struct {
  133.              unsigned int o;
  134.              unsigned int s;
  135.              } Word;
  136.           } unaddr;
  137.  
  138.       type_case addr of {
  139.          integer: {
  140.  
  141. #ifdef LargeInts
  142.             if (Type(addr) == T_Lrgint)
  143.                runerr(205,addr);
  144. #endif                        /* LargeInts */
  145.  
  146.             return string(_len_,(char *) word2ptr(IntVal(addr)));
  147.             }
  148.          list: {
  149.             hp = (struct b_list *) BlkLoc(addr);
  150.             if (hp->size != 2) {
  151.                runerr(205, addr);
  152.                }
  153.             bp = (struct b_lelem *) hp->listhead;
  154.             if (getlist(bp, vals, 2) == Failed) fail;
  155.             unaddr.Word.s = vals[0];
  156.             unaddr.Word.o = vals[1];
  157.         return string(_len_,unaddr.cptr);
  158.             }
  159.          default: {
  160.             runerr(101,addr);
  161.         }
  162.          }
  163.       /* NOTREACHED */
  164.       }
  165. end
  166.  
  167.  
  168. "poke(addr,s) - write to memory"
  169.  
  170. function{1} Poke(addr,s)
  171.    if !cnv:string(s) then
  172.       runerr(103, s)
  173.    abstract {
  174.       return null
  175.       }
  176.    body {
  177.       unsigned int vals[2];
  178.       register char *s1,*s2;
  179.       register word l;
  180.       union {
  181.          char *cptr;
  182.          struct {
  183.             unsigned int o;
  184.             unsigned int s;
  185.             } Word;
  186.          } unaddr;
  187.       struct b_list *hp;
  188.       struct b_lelem *bp;
  189.  
  190.       type_case addr of {
  191.          integer: {
  192.  
  193. #ifdef LargeInts
  194.             if (Type(addr) == T_Lrgint)
  195.                runerr(205, addr);
  196. #endif                    /* LargeInts */
  197.  
  198.             unaddr.cptr = (char *)word2ptr(addr.vword.integr);
  199.         }
  200.          list: {
  201.             hp = (struct b_list *) BlkLoc(addr);
  202.             if (hp->size != 2) {
  203.                runerr(205,addr);
  204.                }
  205.             bp = (struct b_lelem *) hp->listhead;
  206.             if (getlist(bp, vals, 2) == Failed) fail;
  207.             unaddr.Word.s = vals[0];
  208.             unaddr.Word.o = vals[1];
  209.             }
  210.          default: {
  211.             runerr(101,addr);
  212.         }
  213.          }
  214.       l = StrLen(s);
  215.       s1 = StrLoc(s);
  216.       s2 = unaddr.cptr;
  217.  
  218.       memcopy(s2,s1,l);     /* Copy... */
  219.       return nulldesc;
  220.       }
  221. end
  222.  
  223.  
  224. "GetSpace(i) - allocate memory block"
  225.  
  226. function{1} GetSpace(i)
  227.    if !cnv:C_integer(i) then    /* should check for small */
  228.       runerr(101,i)
  229.    abstract {
  230.       return integer
  231.       }
  232.    body {
  233.       char *addr;
  234.       uword u;
  235.  
  236.       addr = (char *)calloc((int)i,sizeof(char));
  237.       if (addr==NULL)
  238.          fail;
  239.       u = ptr2word(addr);
  240.       return C_integer u;
  241.       }
  242. end
  243.  
  244.  
  245. "FreeSpace(a) - free allocated memory block"
  246.  
  247. function{1} FreeSpace(a)
  248.    if !cnv:C_integer(a) then
  249.       runerr(101,a)
  250.    abstract {
  251.       return null
  252.       }
  253.    body {
  254.       uword u;
  255.       char *addr;
  256.  
  257.       u = (uword)a;
  258.       addr = word2ptr(u);
  259.       free((pointer)addr);
  260.       return nulldesc;
  261.       }
  262. end
  263.  
  264. /*
  265.  * getlist - copy integers from an Icon list to a C array.
  266.  */
  267.  
  268. int getlist(bp,vals,limit)
  269. unsigned int *vals;
  270. int limit;
  271. struct b_lelem *bp;
  272. {
  273.     int i;
  274.     int count;
  275.  
  276.     i = 0;
  277.     for(count = 0 ;count <limit;count++) {
  278.     int j;
  279.     if( ++i > bp->nused) {
  280.         i = 1;
  281.         bp = (struct b_lelem *) bp->listnext;
  282.     }
  283.     j = bp->first + i - 1;    /* Get slot index */
  284.     if( j >= bp->nslots)
  285.         j -= bp->nslots;
  286.     switch(Type(bp->lslots[j])) {
  287.         case T_Integer:    /* should check for small */
  288.         vals[count] = (int)IntVal(bp->lslots[j]);
  289.         break;
  290.         default:
  291.         RunErr(101,&bp->lslots[j]);
  292.     }
  293.     }
  294.    return 0;
  295. }
  296.  
  297.  
  298. "InPort(i) - return a value from port i"
  299.  
  300. function{1} InPort(i)
  301.    if !cnv:C_integer(i) then /* should check i's valid range */
  302.       runerr(101,i)
  303.    abstract {
  304.       return integer
  305.       }
  306.    inline {
  307.       return C_integer inp(i);
  308.       }
  309. end
  310.  
  311.  
  312. "OutPort(i1,i2) - write i2 to port i1"
  313.  
  314. function{1} OutPort(i1,i2)
  315.    if !cnv:C_integer(i1) then
  316.       runerr(101,i1)
  317.    if !cnv:C_integer(i2) then
  318.       runerr(101,i2)
  319.    abstract {
  320.       return null
  321.       }
  322.    body {
  323.       /*
  324.        * make sure that i2 is not just a C integer, it must fit in one byte
  325.        */
  326.       if ((i2 < 0) || (i2 > 255)){
  327.          irunerr(205, i2);
  328.          }
  329.       outp(i1,i2);
  330.       return nulldesc;
  331.    }
  332. end
  333.