int/object.c

   1 #include        "depend.h"
   2 #include        "genint.h"
   3 #include        "int.h"
   4 #include        "process.h"
   5 #include        "intproto.h"
   6
   7 /* object management routines */
   8
   9
  10 void openrc(prot, virt, addr)           /* Open new field for a record. */
  11 word prot;
  12 virtaddr *virt;
  13 word *addr;
  14 {
  15     word t1;
  16
  17     request(prototype[ prot ]->appetite, &t1, addr);
  18     M[ *addr+PROTNUM ] = prot;
  19     virt->addr = t1;
  20     virt->mark = M[ t1+1 ];
  21 } /* end openrc */
  22
  23
  24 void slopen(prot, sladr, ah, am)
  25 word prot;
  26 virtaddr *sladr;
  27 word *ah, *am;
  28 {
  29     word t1, t2, virts;
  30
  31     virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
  32     storevirt(*sladr, virts);           /* preserve for compactifier */
  33     t1 = prototype[ prot ]->appetite;
  34
  35     request(t1, ah, am);                /* open field */
  36
  37     M[ *am+PROTNUM ] = prot;
  38     t1 = *am+t1;                        /* LWA+1 of object */
  39     M[ t1+SL ] = M[ virts ];            /* prepare SL pointer */
  40     M[ t1+SL+1 ] = M[ virts+1 ];
  41     t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
  42     M[ t1+DL ] = t2;
  43     M[ t1+DL+1 ] = M[ t2+1 ];
  44
  45 } /* end slopen */
  46
  47
  48 void openobj(prot, ah, am)
  49 word prot;
  50 word *ah, *am;
  51 {
  52     virtaddr v1;
  53     word t1;
  54
  55     t1 = M[ display2+prototype[ prot ]->slprototype ];
  56     v1.addr = t1;                       /* ah of SL */
  57     v1.mark = M[ t1+1 ];
  58     slopen(prot, &v1, ah, am);
  59 } /* end openobj */
  60
  61
  62 void newarry(low, up, kind, virt, am)   /* Reserve room for array */
  63 word low, up, kind;
  64 virtaddr *virt;
  65 word *am;
  66 {
  67     word ap;
  68
  69     switch ((int) kind)
  70     {
  71         case AINT     :  ap = APINT;   break;
  72         case AREAL    :  ap = APREAL;  break;
  73         case AVIRT    :  ap = APREF;   break;
  74         case APROCESS :  ap = APINT;   break;
  75     }
  76     low *= ap;
  77     up *= ap;
  78     if (up < low) errsignal(RTEILLAB);  /* illegal array bounds */
  79     low -= 3;
  80     request(up-low+ap, &virt->addr, am);
  81     M[ *am+1 ] = kind;
  82     M[ *am+2 ] = low;
  83     virt->mark = M[ virt->addr+1 ];
  84 } /* end newarry */
  85
  86
  87 void gkill(virt)                        /* Generalized killer */
  88 virtaddr *virt;
  89 {
  90     word t1, t2, t3;
  91     virtaddr vt;
  92     protdescr *ptr;
  93     message msg;
  94
  95     if (isprocess(virt))                /* kill remote process */
  96     {
  97         msg.control.type = KILLPR;
  98         obj2mess( M, virt, &msg.control.receiver );
  99         sendmsg1( &msg);/* send remote kill request */
 100     }
 101     else
 102         if (virt->mark == M[ virt->addr+1 ])
 103         {
 104             t1 = M[ virt->addr ];       /* am */
 105             t2 = M[ t1+PROTNUM ];
 106             if (t2 == AINT || t2 == AREAL || t2 == AVIRT)
 107                 disp(virt);             /* simple kill for array */
 108             else
 109                 if (t2 == FILEOBJECT)
 110                 {   /* First close file if opened */
 111                     if (M[ t1+FSTAT ] != UNKNOWN)
 112                         if (fclose(MF(t1+FFILE))) errsignal(RTEILLIO);
 113                     /* Delete file if temporary */
 114                     if (M[ t1+FTEMP ] == LTRUE)
 115                         if (unlink(MN(t1+FNAME))) errsignal(RTEILLIO);
 116                     free(MN(t1+FNAME));
 117                     disp(virt);
 118                 }
 119                 else                    /* more than array or file */
 120                 {
 121                     ptr = prototype[ t2 ];
 122                     if (ptr->kind == RECORD)
 123                         disp(virt);
 124                     else
 125                     {
 126                         t3 = t1;
 127                         do
 128                         {
 129                             t3 += M[ t3 ];   /* LWA of object */
 130                             if (M[ t3+STATSL ] != 0) errsignal(RTEILLKL);
 131                             t3 = M[ t3+DL ]; /* next object in DL */
 132                             if (t3 == 0) errsignal(RTEILLKL);
 133                             t3 = M[ t3 ];    /* am of DL */
 134                         } while (t3 != t1);
 135                         do              /* kill DL chain */
 136                         {
 137                             t3 += M[ t3 ];
 138                             loadvirt(vt, t3+DL);
 139                             disp(virt);
 140                             virt->addr = vt.addr;
 141                             virt->mark = vt.mark;
 142                             t3 = M[ virt->addr ];
 143                         } while (M[ virt->addr+1 ] == virt->mark);
 144                     }
 145                 }
 146         }
 147 } /* end gkill */
 148
 149
 150 /* Copy object to a new object and locate it by fresh.
 151  */
 152
 153 void copy(old, fresh)
 154 virtaddr *old, *fresh;
 155 {
 156     word t1, t2, t3, virts;
 157     protdescr *ptr;
 158     bool notrecord;
 159
 160     if (M[ old->addr+1 ] != old->mark)
 161     {                                   /* fine copy for none */
 162         fresh->addr = 0;
 163         fresh->mark = 0;                /* note M[ 1 ] <> 0 */
 164     }
 165     else                                /* not none */
 166     {
 167         t1 = M[ old->addr ];            /* am of old */
 168         notrecord = FALSE;              /* assume it is a record */
 169         t2 = M[ t1+PROTNUM ];
 170         if (t2 != AINT && t2 != AREAL && t2 != AVIRT && t2 != FILEOBJECT)
 171         {                               /* if not array nor file */
 172             ptr = prototype[ t2 ];
 173             if (ptr->kind != RECORD)    /* our assumption was wrong */
 174             {
 175                 notrecord = TRUE;
 176                 t3 = t1+M[ t1 ]+DL;
 177                 if (M[ t3 ] != old->addr || M[ t3+1 ] != old->mark)
 178                     errsignal(RTEILLCP); /* non-terminated object */
 179             }
 180         }
 181         virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
 182         storevirt(*old, virts);         /* preserve for compactification */
 183         request(M[ t1 ], &t2, &t3);     /* book field */
 184         fresh->addr = t2;               /* ah */
 185         fresh->mark = M[ fresh->addr+1 ];
 186         t1 = M[ M[ virts ] ];
 187         for (t2 = 1;  t2 < M[ t1 ]; t2++ )
 188             M[ t3+t2 ] = M[ t1+t2 ];
 189         if (notrecord)
 190         {
 191             storevirt(*fresh, t3+M[ t3 ]+DL);   /* loop up DL */
 192             M[ t3+M[ t3 ]+STATSL ] = 0; /* not in any SL chain */
 193         }
 194     }
 195 } /* end copy */