home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 018.lha / sources / block.c < prev    next >
C/C++ Source or Header  |  1986-10-19  |  4KB  |  170 lines
  1. /*
  2.     Little Smalltalk
  3.  
  4.         block creation and block return
  5.         timothy a. budd, 10/84
  6.  
  7. */
  8. /*
  9.     The source code for the Little Smalltalk System may be freely
  10.     copied provided that the source of all files is acknowledged
  11.     and that this condition is copied with each file.
  12.  
  13.     The Little Smalltalk System is distributed without responsibility
  14.     for the performance of the program and without any guarantee of
  15.     maintenance.
  16.  
  17.     All questions concerning Little Smalltalk should be addressed to:
  18.  
  19.         Professor Tim Budd
  20.         Department of Computer Science
  21.         The University of Arizona
  22.         Tucson, Arizona
  23.         85721
  24.         USA
  25. */
  26. # include <stdio.h>
  27. # include "object.h"
  28. # include "drive.h"
  29. # include "interp.h"
  30. # include "block.h"
  31. # include "string.h"
  32. # include "primitive.h"
  33. # include "process.h"
  34.  
  35. extern object *o_object;    /* value of generic object */
  36.  
  37. static mstruct *fr_block = 0;    /* free list of unused blocks */
  38.  
  39. int ca_block = 0;        /* count block allocations */
  40.  
  41. /* cpyInterpreter - make a new copy of an existing interpreter */
  42. static interpreter *cpyInterpreter(anInterpreter)
  43. interpreter *anInterpreter;
  44. {    interpreter *new;
  45.  
  46.     new = cr_interpreter((interpreter *) 0,
  47.         anInterpreter->receiver,
  48.         anInterpreter->literals,
  49.         anInterpreter->bytecodes,
  50.         anInterpreter->context);
  51.  
  52.     if (anInterpreter->creator)
  53.         new->creator = anInterpreter->creator;
  54.     else
  55.         new->creator = anInterpreter;
  56.  
  57.     new->currentbyte = anInterpreter->currentbyte;
  58.     return(new);
  59. }
  60.  
  61. /* new_block - create a new instance of class Block */
  62. object *new_block(anInterpreter, argcount, arglocation)
  63. interpreter *anInterpreter;
  64. int argcount, arglocation;
  65. {    block *new;
  66.  
  67.     if (fr_block) {
  68.         new = (block *) fr_block;
  69.         fr_block = fr_block->mlink;
  70.         }
  71.     else {
  72.         new = structalloc(block);
  73.         ca_block++;
  74.         }
  75.  
  76.     new->b_ref_count = 0;
  77.     new->b_size = BLOCKSIZE;
  78.  
  79.     sassign(new->b_interpreter, cpyInterpreter(anInterpreter));
  80.     new->b_numargs = argcount;
  81.     new->b_arglocation = arglocation;
  82.     return((object *) new);
  83. }
  84.  
  85. /* free_block - return an unused block to the block free list */
  86. free_block(b)
  87. block *b;
  88. {
  89.     if (! is_block(b)) 
  90.         cant_happen(8);
  91.  
  92.     obj_dec((object *)(b->b_interpreter));
  93.  
  94.     ((mstruct *) b)->mlink = fr_block;
  95.     fr_block = (mstruct *) b;
  96. }
  97.  
  98. /* block_execute - queue a block interpreter for execution */
  99. interpreter *block_execute(sender, aBlock, numargs, args)
  100. interpreter *sender;
  101. block *aBlock;
  102. int numargs;
  103. object **args;
  104. {    interpreter *newInt;
  105.     object *tempobj;
  106.  
  107.     if (! is_block(aBlock)) cant_happen(11);
  108.     if (numargs != aBlock->b_numargs) {
  109.         sassign(tempobj, 
  110.             new_str("wrong number of arguments for block"));
  111.         primitive(ERRPRINT, 1, &tempobj);
  112.         obj_dec(tempobj);
  113.         if (sender) {
  114.             push_object(sender, o_nil);
  115.             }
  116.         return(sender); /* not sure about this ..... */
  117.         }
  118.  
  119.     /* we copy the interpreter so as to not destroy the original and to
  120.        avoid memory pointer cycles */
  121.  
  122.     newInt = cpyInterpreter(aBlock->b_interpreter);
  123.     if (sender)
  124.         assign(newInt->sender, sender);
  125.     if (numargs)
  126.         copy_arguments(newInt, aBlock->b_arglocation, 
  127.             numargs, args);
  128.     return(newInt);
  129. }
  130.  
  131. /* block_return - return an object from the context in which a block was
  132. created */
  133. block_return(blockInterpreter, anObject)
  134. interpreter *blockInterpreter;
  135. object *anObject;
  136. {    interpreter *backchain, *parent;
  137.     interpreter *creatorblock;
  138.  
  139.     creatorblock = blockInterpreter->creator;
  140.     for (backchain = blockInterpreter->sender; backchain; 
  141.             backchain = backchain->sender) {
  142.         if (! is_interpreter(backchain)) break;
  143.         if (backchain == creatorblock) {
  144.             /* found creating context, back up one more */
  145.             parent = backchain->sender;
  146.             if (parent) {
  147.                 if (! is_driver(parent))
  148.                     push_object(parent, anObject);
  149.                 link_to_process(parent);
  150.                 }
  151.             else {
  152.                 terminate_process(runningProcess);
  153.                 }
  154.             return;
  155.             }
  156.         }
  157.  
  158.     /* no block found, issue error message */
  159.     primitive(BLKRETERROR, 1, (object **) &blockInterpreter);
  160.     parent = blockInterpreter->sender;
  161.     if (parent) {
  162.         if (! is_driver(parent))
  163.             push_object(parent, anObject);
  164.         link_to_process(parent);
  165.         }
  166.     else {
  167.         terminate_process(runningProcess);
  168.         }
  169. }
  170.