added SemaphoreHeap

stix/kernel/Collection-Array.st

@@ -29,6 +29,11 @@
 	{
 		1 to: self size do: [:i | aBlock value: (self at: i)].
 	}
+
+	#method copy: anArray
+	{
+		1 to: (anArray size) do: [:i | self at: i put: (anArray at: i) ].
+	}
 }
 
 #class(#character) String(Array)

stix/kernel/Context.st

@@ -111,17 +111,17 @@
 
 		## less block context before whileTrue: is recursively sent.
 		## whileTrue: is sent in a method context.
-##		(self value) ifFalse: [^nil].
+		(self value) ifFalse: [^nil].
-##		aBlock value. 
+		aBlock value. 
-##		self whileTrue: aBlock.
+		self whileTrue: aBlock.
 
 ## ----------------------------------------------------------------------------
 
 ## ----------------------------------------------------------------------------
-		| pc sp xsp |
+"		| pc sp xsp |
 
 		sp := thisContext sp.
-		sp := sp - 1. "decrement sp by 1 becuase thisContext pushed above affects the sp method"
+		sp := sp - 1. ## decrement sp by 1 becuase thisContext pushed above affects the sp method
 		pc := thisContext pc.
 		self value ifFalse: [ ^nil "^self" ].
 		aBlock value.
@@ -131,7 +131,7 @@
 		## this +2 or - 3 above is dependent on the byte code instruction size used for 'store'  
 		## +2 to skip STORE_INTO_TEMP(pc) and POP_STACKTOP.
 		## TODO: make it independent of the byte code size 
-
+"
 ## ----------------------------------------------------------------------------
 
 ##        #<label>:

stix/kernel/Process.st

@@ -1,31 +1,4 @@
 
-
-#class Delay(Object)
-{
-## TODO: support milliseconds or nanoseconds
-	#dcl delay.
-
-	#method(#class) forSeconds: anInteger
-	{
-		^super basicNew initWith: anInteger.
-	}
-
-	#method initWith: anInteger
-	{
-		self.delay := anInteger.
-	}
-
-	#method wait
-	{
-		Processor sleep: self.delay.
-	}
-
-	#method resume
-	{
-		" TODO: .............. "
-	}
-}
-
 #class(#pointer) Process(Object)
 {
 	#dcl initial_context current_context state sp prev next sem.
@@ -84,11 +57,13 @@
 
 #class Semaphore(Object)
 {
-	#dcl count waiting_head waiting_tail.
+	#dcl count waiting_head waiting_tail heapIndex fireTime.
 
 	#method initialize
 	{
-		count := 0.
+		self.count := 0.
+		self.heapIndex := 0.
+		self.fireTime := 0.
 	}
 
 	#method signal 
@@ -102,11 +77,195 @@
 		<primitive: #_semaphore_wait>
 		self primitiveFailed.
 	}
+
+	#method heapIndex
+	{
+		^heapIndex
+	}
+
+	#method heapIndex: anIndex
+	{
+		heapIndex := anIndex
+	}
+
+	#method fireTime
+	{
+		^fireTime
+	}
+
+	#method fireTime: anInteger
+	{
+		self.fireTime := anInteger.
+	}
+
+	#method youngerThan: aSemaphore
+	{
+		^self.fireTime < (aSemaphore fireTime)
+	}
+}
+
+#class SemaphoreHeap(Object)
+{
+	#dcl arr size.
+
+	#method initialize
+	{
+		self.size := 0.
+		self.arr := Array new: 100.
+	}
+
+	#method size
+	{
+		^self.size
+	}
+
+	#method insert: aSemaphore
+	{
+		self.size >= (self.arr size) ifTrue: [
+			| newarr newsize |
+			newsize := (self.arr size) * 2.
+			newarr := Array new: newsize.
+			newarr copy: self.arr.
+			self.arr := newarr.
+		].
+
+		self.size := self.size + 1.
+		self.arr at: self.size put: aSemaphore.
+		aSemaphore heapIndex: self.size.
+
+		^self siftUp: self.size.
+	}
+
+	#method popTop
+	{
+		| top |
+
+		top := self.arr at: 1.
+		self deleteAt: 1.
+		^top
+	}
+
+	#method updateAt: anIndex
+	{
+	}
+
+	#method deleteAt: anIndex
+	{
+		| item |
+
+		item := self.arr at: anIndex.
+		item heapIndex: -1.
+
+		(anIndex == self.size) 
+			ifTrue: [
+				"the last item"
+				self.arr at: self.size put: nil.
+				self.size := self.size - 1
+			]
+			ifFalse: [
+				| xitem |
+
+				xitem := self.arr at: self.size.
+				self.arr at: anIndex put: xitem.
+				xitem heapIndex: anIndex.
+				self.arr at: self.size put: nil.
+				self.size := self.size - 1.
+
+				(xitem youngerThan: item) 
+					ifTrue: [self siftUp: anIndex ]
+					ifFalse: [self siftDown: anIndex ]
+			]
+	}
+
+	#method parentIndex: anIndex
+	{
+		## ^(anIndex - 1) quo: 2
+		^anIndex quo: 2
+	}
+
+	#method leftChildIndex: anIndex
+	{
+		## ^(anIndex * 2) + 1.
+		^(anIndex * 2).
+	}
+
+	#method rightChildIndex: anIndex
+	{
+		## ^(anIndex * 2) + 2.
+		^(anIndex * 2) + 1.
+	}
+
+	#method siftUp: anIndex
+	{
+		| pindex cindex par cur |
+
+		anIndex <= 1 ifTrue: [ ^anIndex ].
+
+		cindex := anIndex.
+		pindex := self parentIndex: anIndex.
+
+		par := self.arr at: pindex.
+		cur := self.arr at: cindex.
+
+		[ cur youngerThan: par ] whileTrue: [
+
+			cindex := pindex.
+			pindex := self parentIndex: pindex.
+
+			par := self.arr at: pindex.
+			cur := self.arr at: cindex.
+		].
+
+		self.arr at: cindex put: cur.
+		cur heapIndex: cindex.
+
+		^cindex
+	}
+
+	#method siftDown: anIndex
+	{
+		| base capa cindex item |
+
+
+		base := self.size quo: 2.
+		(anIndex > base) ifTrue: [^anIndex].
+
+		cindex := anIndex.
+		item := self.arr at: cindex.
+
+		[ cindex < base ] whileTrue: [
+			| left right younger xitem |
+
+			left := self leftChildIndex: cindex.
+			right := self rightChildIndex: cindex.
+
+			((right <= self.size) and: [(self.arr at: right) youngerThan: (self.arr at: left)])
+				ifTrue: [ younger := right ]
+				ifFalse: [ younger := left ].
+
+			xitem := self.arr at: younger.
+			(item youngerThan: xitem) 
+				ifTrue: [
+					"break the loop"
+					base := anIndex 
+				]
+				ifFalse: [
+					self.arr at: cindex put: xitem.
+					xitem heapIndex: cindex.
+					cindex := younger.
+				]
+		].
+
+		self.arr at: cindex put: item.
+		item heapIndex: cindex.
+
+		^cindex
+	}
 }
 
 #class ProcessScheduler(Object)
 {
-	#dcl tally active runnable_head runnable_tail.
+	#dcl tally active runnable_head runnable_tail sem_heap.
 
 	#method new
 	{
@@ -159,4 +318,9 @@
 		self primitiveFailed
 	}
 	"
+
+	#method signal: aSemaphore after: anInteger
+	{
+		self.sem_heap add: aSemaphore withTimeout: anInteger.
+	}
 }

stix/lib/exec.c

@@ -210,7 +210,7 @@ static STIX_INLINE stix_oop_process_t find_next_runnable_process (stix_t* stix)
 {
 	stix_oop_process_t npr;
 	STIX_ASSERT (stix->processor->active->state == STIX_SMOOI_TO_OOP(PROCESS_STATE_RUNNING));
-	npr = stix->processor->active->p_next;
+	npr = stix->processor->active->next;
 	if ((stix_oop_t)npr == stix->_nil) npr = stix->processor->runnable_head;
 	return npr;
 }
@@ -229,8 +229,8 @@ static STIX_INLINE int chain_into_processor (stix_t* stix, stix_oop_process_t pr
 	 * link it to the processor's process list. */
 	stix_ooi_t tally;
 
-	STIX_ASSERT ((stix_oop_t)proc->p_prev == stix->_nil);
+	STIX_ASSERT ((stix_oop_t)proc->prev == stix->_nil);
-	STIX_ASSERT ((stix_oop_t)proc->p_next == stix->_nil);
+	STIX_ASSERT ((stix_oop_t)proc->next == stix->_nil);
 
 	STIX_ASSERT (proc->state == STIX_SMOOI_TO_OOP(PROCESS_STATE_SUSPENDED));
 
@@ -249,8 +249,8 @@ printf ("TOO MANY PROCESS\n");
 	/* append to the runnable list */
 	if (tally > 0)
 	{
-		proc->p_prev = stix->processor->runnable_tail;
+		proc->prev = stix->processor->runnable_tail;
-		stix->processor->runnable_tail->p_next = proc;
+		stix->processor->runnable_tail->next = proc;
 	}
 	else
 	{
@@ -277,13 +277,13 @@ static STIX_INLINE void unchain_from_processor (stix_t* stix, stix_oop_process_t
 	tally = STIX_OOP_TO_SMOOI(stix->processor->tally);
 	STIX_ASSERT (tally > 0);
 
-	if ((stix_oop_t)proc->p_prev != stix->_nil) proc->p_prev->p_next = proc->p_next;
+	if ((stix_oop_t)proc->prev != stix->_nil) proc->prev->next = proc->next;
-	else stix->processor->runnable_head = proc->p_next;
+	else stix->processor->runnable_head = proc->next;
-	if ((stix_oop_t)proc->p_next != stix->_nil) proc->p_next->p_prev = proc->p_prev;
+	if ((stix_oop_t)proc->next != stix->_nil) proc->next->prev = proc->prev;
-	else stix->processor->runnable_tail = proc->p_prev;
+	else stix->processor->runnable_tail = proc->prev;
 
-	proc->p_prev = (stix_oop_process_t)stix->_nil;
+	proc->prev = (stix_oop_process_t)stix->_nil;
-	proc->p_next = (stix_oop_process_t)stix->_nil;
+	proc->next = (stix_oop_process_t)stix->_nil;
 
 	tally--;
 	if (tally == 0) stix->processor->active = stix->nil_process;
@@ -295,8 +295,8 @@ static STIX_INLINE void chain_into_semaphore (stix_t* stix, stix_oop_process_t p
 	/* append a process to the process list of a semaphore*/
 
 	STIX_ASSERT ((stix_oop_t)proc->sem == stix->_nil);
-	STIX_ASSERT ((stix_oop_t)proc->p_prev == stix->_nil);
+	STIX_ASSERT ((stix_oop_t)proc->prev == stix->_nil);
-	STIX_ASSERT ((stix_oop_t)proc->p_next == stix->_nil);
+	STIX_ASSERT ((stix_oop_t)proc->next == stix->_nil);
 
 	if ((stix_oop_t)sem->waiting_head == stix->_nil)
 	{
@@ -305,8 +305,8 @@ static STIX_INLINE void chain_into_semaphore (stix_t* stix, stix_oop_process_t p
 	}
 	else
 	{
-		proc->p_prev = sem->waiting_tail;
+		proc->prev = sem->waiting_tail;
-		sem->waiting_tail->p_next = proc;
+		sem->waiting_tail->next = proc;
 	}
 	sem->waiting_tail = proc;
 
@@ -320,13 +320,13 @@ static STIX_INLINE void unchain_from_semaphore (stix_t* stix, stix_oop_process_t
 	STIX_ASSERT ((stix_oop_t)proc->sem != stix->_nil);
 
 	sem = proc->sem;
-	if ((stix_oop_t)proc->p_prev != stix->_nil) proc->p_prev->p_next = proc->p_next;
+	if ((stix_oop_t)proc->prev != stix->_nil) proc->prev->next = proc->next;
-	else sem->waiting_head = proc->p_next;
+	else sem->waiting_head = proc->next;
-	if ((stix_oop_t)proc->p_next != stix->_nil) proc->p_next->p_prev = proc->p_prev;
+	if ((stix_oop_t)proc->next != stix->_nil) proc->next->prev = proc->prev;
-	else sem->waiting_tail = proc->p_prev;
+	else sem->waiting_tail = proc->prev;
 
-	proc->p_prev = (stix_oop_process_t)stix->_nil;
+	proc->prev = (stix_oop_process_t)stix->_nil;
-	proc->p_next = (stix_oop_process_t)stix->_nil;
+	proc->next = (stix_oop_process_t)stix->_nil;
 }
 
 static void terminate_process (stix_t* stix, stix_oop_process_t proc)
@@ -392,8 +392,8 @@ printf ("TO RESUME PROCESS = %p %d\n", proc, (int)STIX_OOP_TO_SMOOI(proc->state)
 	{
 		/* SUSPENED ---> RUNNING */
 
-		STIX_ASSERT ((stix_oop_t)proc->p_prev == stix->_nil);
+		STIX_ASSERT ((stix_oop_t)proc->prev == stix->_nil);
-		STIX_ASSERT ((stix_oop_t)proc->p_next == stix->_nil);
+		STIX_ASSERT ((stix_oop_t)proc->next == stix->_nil);
 
 		chain_into_processor (stix, proc); /* TODO: error check */
 
@@ -472,16 +472,21 @@ static void yield_process (stix_t* stix, stix_oop_process_t proc)
 
 static int async_signal_semaphore (stix_t* stix, stix_oop_semaphore_t sem)
 {
-	if (stix->sem_count > STIX_COUNTOF(stix->sem_list))
+	if (stix->sem_list_count >= stix->sem_list_capa)
 	{
-		/* TOO MANY ASYNC SEMAPHORES.. */
+		stix_oow_t new_capa;
-	/* TODO: PROPER ERROR HANDLING */
+		stix_oop_semaphore_t* tmp;
-		stix->errnum = STIX_ESYSMEM;
+
-		return -1;
+		new_capa = stix->sem_list_capa * 2; /* TODO: overflow check.. */
+		tmp = stix_reallocmem (stix, stix->sem_list, STIX_SIZEOF(stix_oop_semaphore_t) * new_capa);
+		if (!tmp) return -1;
+
+		stix->sem_list = tmp;
+		stix->sem_list_capa = new_capa;
 	}
 
-	stix->sem_list[stix->sem_count] = sem;
+	stix->sem_list[stix->sem_list_count] = sem;
-	stix->sem_count++;
+	stix->sem_list_count++;
 	return 0;
 }
 
@@ -502,13 +507,6 @@ printf ("signal semaphore...1111\n");
 	{
 printf ("signal semaphore...2222\n");
 		proc = sem->waiting_head;
-/*
-		sem->waiting_head = proc->semp_next;
-		if ((stix_oop_t)sem->waiting_head == stix->_nil)
-			sem->waiting_tail = (stix_oop_process_t)stix->_nil;
-
-		proc->semp_next = (stix_oop_process_t)stix->_nil;
-*/
 		unchain_from_semaphore (stix, proc);
 		resume_process (stix, proc); /* TODO: error check */
 	}
@@ -2585,10 +2583,10 @@ IDLEING WAITING FOR PROCESS WAKE-UP...
 		}
 */
 
-		while (stix->sem_count > 0)
+		while (stix->sem_list_count > 0)
 		{
-			--stix->sem_count;
+			--stix->sem_list_count;
-			signal_semaphore (stix, stix->sem_list[stix->sem_count]);
+			signal_semaphore (stix, stix->sem_list[stix->sem_list_count]);
 		}
 
 		/* TODO: implement different process switching scheme - time-slice or clock based??? */

stix/lib/gc.c

@@ -339,7 +339,7 @@ printf ("STARTING GC curheap base %p ptr %p newheap base %p ptr %p\n",
 	stix->processor = (stix_oop_process_scheduler_t) stix_moveoop (stix, (stix_oop_t)stix->processor);
 	stix->nil_process = (stix_oop_process_t) stix_moveoop (stix, (stix_oop_t)stix->nil_process);
 
-	for (i = 0; i < stix->sem_count; i++)
+	for (i = 0; i < stix->sem_list_count; i++)
 	{
 		stix->sem_list[i] = stix_moveoop (stix, stix->sem_list[i]);
 	}

stix/lib/stix-prv.h

@@ -54,7 +54,7 @@
 
 /* this is for gc debugging */
 /*#define STIX_DEBUG_PROCESSOR*/
-#define STIX_DEBUG_GC_001
+//#define STIX_DEBUG_GC_001
 /*#define STIX_DEBUG_GC_002*/
 #define STIX_DEBUG_COMP_001
 /*#define STIX_DEBUG_COMP_002*/

stix/lib/stix.c

@@ -129,6 +129,20 @@ void stix_fini (stix_t* stix)
 {
 	stix_cb_t* cb;
 
+	if (stix->sem_list)
+	{
+		stix_freemem (stix, stix->sem_list);
+		stix->sem_list_capa = 0;
+		stix->sem_list_count = 0;
+	}
+
+	if (stix->sem_heap)
+	{
+		stix_freemem (stix, stix->sem_heap);
+		stix->sem_heap_capa = 0;
+		stix->sem_heap_count = 0;
+	}
+
 	for (cb = stix->cblist; cb; cb = cb->next)
 	{
 		if (cb->fini) cb->fini (stix);

stix/lib/stix.h

@@ -544,7 +544,7 @@ struct stix_context_t
 typedef struct stix_process_t stix_process_t;
 typedef struct stix_process_t* stix_oop_process_t;
 
-#define STIX_SEMAPHORE_NAMED_INSTVARS 3
+#define STIX_SEMAPHORE_NAMED_INSTVARS 5
 typedef struct stix_semaphore_t stix_semaphore_t;
 typedef struct stix_semaphore_t* stix_oop_semaphore_t;
 
@@ -557,8 +557,8 @@ struct stix_process_t
 	stix_oop_t         state; /* SmallInteger */
 	stix_oop_t         sp;    /* stack pointer. SmallInteger */
 
-	stix_oop_process_t p_prev;
+	stix_oop_process_t prev;
-	stix_oop_process_t p_next;
+	stix_oop_process_t next;
 
 	stix_oop_semaphore_t sem;
 
@@ -572,9 +572,11 @@ struct stix_semaphore_t
 	stix_oop_t count; /* SmallInteger */
 	stix_oop_process_t waiting_head;
 	stix_oop_process_t waiting_tail;
+	stix_oop_t sempq_index;
+	stix_oop_t sempq_firing_time;
 };
 
-#define STIX_PROCESS_SCHEDULER_NAMED_INSTVARS 4
+#define STIX_PROCESS_SCHEDULER_NAMED_INSTVARS 5
 typedef struct stix_process_scheduler_t stix_process_scheduler_t;
 typedef struct stix_process_scheduler_t* stix_oop_process_scheduler_t;
 struct stix_process_scheduler_t
@@ -584,6 +586,7 @@ struct stix_process_scheduler_t
 	stix_oop_process_t active; /*  pointer to an active process in the runnable process list */
 	stix_oop_process_t runnable_head; /* runnable process list */
 	stix_oop_process_t runnable_tail; /* runnable process list */
+	stix_oop_t sempq; /* SemaphoreHeap */
 };
 
 /**
@@ -772,8 +775,14 @@ struct stix_t
 	stix_oop_process_scheduler_t processor; /* instance of ProcessScheduler */
 	stix_oop_process_t nil_process; /* instance of Process */
 
-	stix_oop_semaphore_t sem_list[256]; /* TODO: make it dynamic */
+	stix_oop_semaphore_t* sem_list;
-	stix_oow_t sem_count;
+	stix_oow_t sem_list_count;
+	stix_oow_t sem_list_capa;
+
+	/* semaphores sorted according to expiry */
+	stix_oop_semaphore_t* sem_heap;
+	stix_oow_t sem_heap_count;
+	stix_oow_t sem_heap_capa;
 
 	stix_oop_t* tmp_stack[256]; /* stack for temporaries */
 	stix_oow_t tmp_count;