home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fxmsdos.ri < prev    next >
Text File  |  2000-08-17  |  7KB  |  336 lines
  1. /*
  2.  * fxmsdos.ri
  3.  */
  4.  
  5. char *zptr = NULL;
  6.  
  7. /*
  8.  * Prototype.
  9.  */
  10.  
  11. int    getlist    (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. #ifdef ListFix
  95.       bp->listprev = bp->listnext = (union block *) hp;
  96. #endif                    /* ListFix */
  97.  
  98.       /* returns [flags,ax,bx,cx,dx,si,di,es,ds] */
  99.  
  100.       MakeInt((uword)flag,&(bp->lslots[0]));
  101.       MakeInt((uword)outreg.x.ax,&(bp->lslots[1]));
  102.       MakeInt((uword)outreg.x.bx,&(bp->lslots[2]));
  103.       MakeInt((uword)outreg.x.cx,&(bp->lslots[3]));
  104.       MakeInt((uword)outreg.x.dx,&(bp->lslots[4]));
  105.       MakeInt((uword)outreg.x.si,&(bp->lslots[5]));
  106.       MakeInt((uword)outreg.x.di,&(bp->lslots[6]));
  107.       MakeInt((uword)insreg.es,&(bp->lslots[7]));
  108.       MakeInt((uword)insreg.ds,&(bp->lslots[8]));
  109.  
  110.       result.dword = D_List;
  111.       result.vword.bptr = (union block *) hp;
  112.       return result;
  113.       }
  114. end
  115. #endif                    /* MICROSOFT || TURBO || ZTC_386 ... */
  116.  
  117.  
  118. "Peek(addr,len) - read from memory"
  119.  
  120. function{1} Peek(addr,len)
  121.    declare {
  122.       C_integer _len_;
  123.       }
  124.    if !def:C_integer(len,1,_len_) then
  125.       runerr(101,len)
  126.    abstract {
  127.       return string
  128.       }
  129.    body {
  130.       unsigned int vals[2];
  131.       struct b_list *hp;
  132.       struct b_lelem *bp;
  133.       union {
  134.           char *cptr;
  135.           struct {
  136.              unsigned int o;
  137.              unsigned int s;
  138.              } Word;
  139.           } unaddr;
  140.  
  141.       type_case addr of {
  142.          integer: {
  143.  
  144. #ifdef LargeInts
  145.             if (Type(addr) == T_Lrgint)
  146.                runerr(205,addr);
  147. #endif                        /* LargeInts */
  148.  
  149.             return string(_len_,(char *) word2ptr(IntVal(addr)));
  150.             }
  151.          list: {
  152.             hp = (struct b_list *) BlkLoc(addr);
  153.             if (hp->size != 2) {
  154.                runerr(205, addr);
  155.                }
  156.             bp = (struct b_lelem *) hp->listhead;
  157.             if (getlist(bp, vals, 2) == Failed) fail;
  158.             unaddr.Word.s = vals[0];
  159.             unaddr.Word.o = vals[1];
  160.         return string(_len_,unaddr.cptr);
  161.             }
  162.          default: {
  163.             runerr(101,addr);
  164.         }
  165.          }
  166.       /* NOTREACHED */
  167.       }
  168. end
  169.  
  170.  
  171. "poke(addr,s) - write to memory"
  172.  
  173. function{1} Poke(addr,s)
  174.    if !cnv:string(s) then
  175.       runerr(103, s)
  176.    abstract {
  177.       return null
  178.       }
  179.    body {
  180.       unsigned int vals[2];
  181.       register char *s1,*s2;
  182.       register word l;
  183.       union {
  184.          char *cptr;
  185.          struct {
  186.             unsigned int o;
  187.             unsigned int s;
  188.             } Word;
  189.          } unaddr;
  190.       struct b_list *hp;
  191.       struct b_lelem *bp;
  192.  
  193.       type_case addr of {
  194.          integer: {
  195.  
  196. #ifdef LargeInts
  197.             if (Type(addr) == T_Lrgint)
  198.                runerr(205, addr);
  199. #endif                    /* LargeInts */
  200.  
  201.             unaddr.cptr = (char *)word2ptr(addr.vword.integr);
  202.         }
  203.          list: {
  204.             hp = (struct b_list *) BlkLoc(addr);
  205.             if (hp->size != 2) {
  206.                runerr(205,addr);
  207.                }
  208.             bp = (struct b_lelem *) hp->listhead;
  209.             if (getlist(bp, vals, 2) == Failed) fail;
  210.             unaddr.Word.s = vals[0];
  211.             unaddr.Word.o = vals[1];
  212.             }
  213.          default: {
  214.             runerr(101,addr);
  215.         }
  216.          }
  217.       l = StrLen(s);
  218.       s1 = StrLoc(s);
  219.       s2 = unaddr.cptr;
  220.  
  221.       memcopy(s2,s1,l);     /* Copy... */
  222.       return nulldesc;
  223.       }
  224. end
  225.  
  226.  
  227. "GetSpace(i) - allocate memory block"
  228.  
  229. function{1} GetSpace(i)
  230.    if !cnv:C_integer(i) then    /* should check for small */
  231.       runerr(101,i)
  232.    abstract {
  233.       return integer
  234.       }
  235.    body {
  236.       char *addr;
  237.       uword u;
  238.  
  239.       addr = (char *)calloc((int)i,sizeof(char));
  240.       if (addr==NULL)
  241.          fail;
  242.       u = ptr2word(addr);
  243.       return C_integer u;
  244.       }
  245. end
  246.  
  247.  
  248. "FreeSpace(a) - free allocated memory block"
  249.  
  250. function{1} FreeSpace(a)
  251.    if !cnv:C_integer(a) then
  252.       runerr(101,a)
  253.    abstract {
  254.       return null
  255.       }
  256.    body {
  257.       uword u;
  258.       char *addr;
  259.  
  260.       u = (uword)a;
  261.       addr = word2ptr(u);
  262.       free((pointer)addr);
  263.       return nulldesc;
  264.       }
  265. end
  266.  
  267. /*
  268.  * getlist - copy integers from an Icon list to a C array.
  269.  */
  270.  
  271. int getlist(bp,vals,limit)
  272. unsigned int *vals;
  273. int limit;
  274. struct b_lelem *bp;
  275. {
  276.     int i;
  277.     int count;
  278.  
  279.     i = 0;
  280.     for(count = 0 ;count <limit;count++) {
  281.     int j;
  282.     if( ++i > bp->nused) {
  283.         i = 1;
  284.         bp = (struct b_lelem *) bp->listnext;
  285.     }
  286.     j = bp->first + i - 1;    /* Get slot index */
  287.     if( j >= bp->nslots)
  288.         j -= bp->nslots;
  289.     switch(Type(bp->lslots[j])) {
  290.         case T_Integer:    /* should check for small */
  291.         vals[count] = (int)IntVal(bp->lslots[j]);
  292.         break;
  293.         default:
  294.         RunErr(101,&bp->lslots[j]);
  295.     }
  296.     }
  297.    return 0;
  298. }
  299.  
  300.  
  301. "InPort(i) - return a value from port i"
  302.  
  303. function{1} InPort(i)
  304.    if !cnv:C_integer(i) then /* should check i's valid range */
  305.       runerr(101,i)
  306.    abstract {
  307.       return integer
  308.       }
  309.    inline {
  310.       return C_integer inp(i);
  311.       }
  312. end
  313.  
  314.  
  315. "OutPort(i1,i2) - write i2 to port i1"
  316.  
  317. function{1} OutPort(i1,i2)
  318.    if !cnv:C_integer(i1) then
  319.       runerr(101,i1)
  320.    if !cnv:C_integer(i2) then
  321.       runerr(101,i2)
  322.    abstract {
  323.       return null
  324.       }
  325.    body {
  326.       /*
  327.        * make sure that i2 is not just a C integer, it must fit in one byte
  328.        */
  329.       if ((i2 < 0) || (i2 > 255)){
  330.          irunerr(205, i2);
  331.          }
  332.       outp(i1,i2);
  333.       return nulldesc;
  334.    }
  335. end
  336.