Skip to content
Snippets Groups Projects
Commit ba62abef authored by ram's avatar ram
Browse files

Initial revision

parent 2e6fb6d8
No related branches found
No related tags found
No related merge requests found
Newsgroups: comp.lang.smalltalk
Distribution: comp
Subject: Smalltalk vs. C(++) performance
Executive summary: a non-trivial benchmark written in C++ and
Smalltalk is available from otis.stanford.edu; please send me your
results.
-------------------------------------------------------------------
As some have pointed out, it is difficult to compare the runtime
performance of Smalltalk programs with the performance of equivalent C
programs. One reason for this is that for most non-trivial programs
there is no equivalent program written in the other language (because
it would be a non-trivial effort to write it).
The "best" benchmark I know of is the Richards benchmark, an operating
system simulation. It is written in an object-oriented style, uses
polymorphism, and is reasonably non-trivial (700 lines). It's
probably not the world's greatest benchmark, but better than
micro-benchamrks, and it is available in Smalltalk, Self, T (an
object-oriented version of Scheme) and C++.
[Historical note: the Richards benchmark was originally written in
BCPL by Mark Richards. Many thanks to L. Peter Deutsch for the
Smalltalk version.]
The sources for Richards are available from otis.stanford.edu
(36.22.0.201) in /pub/benchmarks. I would be interested in
comparisons of the performance of the C++ and Smalltalk versions on
various systems. We measured it a while ago for the Sun-3/4 versions
of PP 2.4, and the difference was about a factor of 10.
Disclaimer: Richards is *not* a typical application: it is relatively
small and contains no graphics or other user interaction. Thus it may
not reflect the relative performance of Your Own Real-World (TM)
Application, but I think it tests the efficiency of the basic language
mechanisms fairly well. If you think you have a better benchmark
which is available both in ST-80 and C (or Fortran or...), please let
me know.
******* ADVERTISEMENT ********
The goal of the Self project at Stanford is to improve the performance
of dynamically-typed object-oriented languages such as Smalltalk and
Self. Though similar to Smalltalk, Self is simpler and more flexible.
Our current system runs significantly faster than any Smalltalk
implementation we know of. For example, here are the numbers for
Richards on a Sun-4/260:
C++ (-O2) 730ms
Self 2160ms (Nov'90; 1940ms for an experimental system)
PP ST-80 2.4 7740ms
T 9800ms (8100ms with some not-so-kosher "tuning")
[On some other benchmarks, the Stanford Integer Benchmarks, Self
actually looks even better, running at around 60-70% of the speed of
optimized C.]
More information (papers, documentation, how to get the current system)
is available via anonymous ftp from otis.stanford.edu.
******* END OF ADVERTISEMENT ********
/* cbase.h */
#ifndef CBASE
#define CBASE
#define BOOLEAN int
#define TRUE 1
#define FALSE 0
#include <stdio.h>
#include <ctype.h>
#include <assert.h>
#endif
/* rbase.h */
#ifndef RBASE
#define RBASE
typedef enum {DevicePacket, WorkPacket}
PacketKind;
typedef enum {Idler, Worker, HandlerA, HandlerB, DeviceA, DeviceB}
Identity;
#define NTASKS 6 /* # elements of Identity */
/* = # of tasks */
#define NoWork NULL
#define NoTask NULL
#endif
/* richards.c - Richards Benchmark in C++ */
/* uh 2/2/89 */
#include <time.h>
#define clock_t long /* because Sun library isn't ANSI */
#define CLK_TCK 1000000
#include "richards.h"
/*
// creation
*/
void RBench::CreateDevice (Identity id, int prio, Packet *work,
TaskState *state)
{ DeviceTaskRec *data;
TaskControlBlock *t;
data = new DeviceTaskRec;
t = new DeviceTCB(taskList, id, prio, work, state, data);
EnterTask(id, t);
}
void RBench::CreateHandler(Identity id, int prio, Packet *work,
TaskState *state)
{ HandlerTaskRec *data;
TaskControlBlock *t;
data = new HandlerTaskRec;
t = new HandlerTCB(taskList, id, prio, work, state, data);
EnterTask(id, t);
}
void RBench::CreateIdler (Identity id, int prio, Packet *work,
TaskState *state)
{ IdleTaskRec *data;
TaskControlBlock *t;
data = new IdleTaskRec;
t = new IdlerTCB(taskList, id, prio, work, state, data);
EnterTask(id, t);
}
void RBench::CreateWorker (Identity id, int prio, Packet *work,
TaskState *state)
{ WorkerTaskRec *data;
TaskControlBlock *t;
data = new WorkerTaskRec;
t = new WorkerTCB(taskList, id, prio, work, state, data);
EnterTask(id, t);
}
void RBench::EnterTask(Identity id, TaskControlBlock *t)
{
taskList = t;
taskTable[id] = t;
}
/*
//private
*/
TaskControlBlock *RBench::FindTask(Identity id)
{ TaskControlBlock *t;
t = taskTable[id];
if (t == NULL) printf("***error: FindTask failed! ");
return t;
}
TaskControlBlock *RBench::HoldSelf()
{
holdCount++;
currentTask->SetTaskHolding(TRUE);
return currentTask->Link();
}
TaskControlBlock *RBench::QueuePacket(Packet *p)
{ TaskControlBlock *t;
t = FindTask(p->Ident());
queuePacketCount++;
p->SetLink(NoWork);
p->SetIdent(currentTaskIdent);
return t->AddPacket(p, currentTask);
}
TaskControlBlock *RBench::Release(Identity id)
{ TaskControlBlock *t;
t = FindTask(id);
t->SetTaskHolding(FALSE);
return (t->Priority() > currentTask->Priority()) ? t : currentTask;
}
void RBench::Trace(Identity id)
{
if(! --layout) {printf("\n"); layout = 50;}
printf("%d", id + 1);
}
TaskControlBlock *RBench::Wait()
{
currentTask->SetTaskWaiting(TRUE);
return currentTask;
}
/*
//scheduling
*/
void RBench::Schedule()
{
currentTask = taskList;
while (currentTask != NoTask) {
if (currentTask->IsTaskHoldingOrWaiting())
currentTask = currentTask->Link();
else {
currentTaskIdent = currentTask->Ident();
if (tracing) Trace(currentTaskIdent);
currentTask = currentTask->RunTask();
}
}
}
/*
//initializing
*/
void RBench::InitScheduler()
{
queuePacketCount = 0;
holdCount = 0;
for (int i = 0; i < NTASKS; i++) {taskTable[i] = NoTask;}
taskList = NoTask;
}
void RBench::InitTrace()
{ char c;
printf("Trace (y/n)? ");
c = getchar();
tracing = (_toupper(c) == 'Y');
}
void RBench::Start(BOOLEAN trace) {
// clock_t t1, t2, t3, t4;
TaskState *t;
Packet *workQ;
if (trace) InitTrace(); else tracing = FALSE;
InitScheduler();
// t1 = clock();
// printf("\nRichards benchmark: initializing...\n");
t = new TaskState; t->Running(); // Idler
CreateIdler(Idler, 0, NoWork, t);
workQ = new Packet(NoWork, Worker, WorkPacket); // Worker
workQ = new Packet(workQ , Worker, WorkPacket);
t = new TaskState; t->WaitingWithPacket();
CreateWorker(Worker, 1000, workQ, t);
workQ = new Packet(NoWork, DeviceA, DevicePacket); // HandlerA
workQ = new Packet(workQ , DeviceA, DevicePacket);
workQ = new Packet(workQ , DeviceA, DevicePacket);
t = new TaskState; t->WaitingWithPacket();
CreateHandler(HandlerA, 2000, workQ, t);
workQ = new Packet(NoWork, DeviceB, DevicePacket); // HandlerB
workQ = new Packet(workQ , DeviceB, DevicePacket);
workQ = new Packet(workQ , DeviceB, DevicePacket);
t = new TaskState; t->WaitingWithPacket();
CreateHandler(HandlerB, 3000, workQ, t);
t = new TaskState; t->Waiting(); // DeviceA
CreateDevice(DeviceA, 4000, NoWork, t);
t = new TaskState; t->Waiting(); // DeviceB
CreateDevice(DeviceB, 5000, NoWork, t);
// printf("starting...\n");
// t2 = clock();
Schedule();
// t3 = clock();
// printf("done.\n");
// printf("QueuePacketCount = %d, HoldCount = %d.\nThese results are %s",
// queuePacketCount, holdCount,
// (queuePacketCount == 23246 && holdCount == 9297) ?
// "correct." : "wrong!"
// );
if (! (queuePacketCount == 23246 && holdCount == 9297)) {
printf("error: richards results are incorrect\n");
}
// t4 = clock();
// printf("\nScheduler time = %g seconds, total time = %g\n",
// (double)(t3 - t2) / CLK_TCK,
// (double)(t4 - t1) / CLK_TCK);
}
#define ITER 10 /* # of iterations in main loop */
int main()
{ clock_t t_start, t_stop;
t_start = clock();
for (int i = 0; i < ITER; i++)
bm.Start(ITER == 1);
t_stop = clock();
clock_t diff = (t_stop - t_start)/ITER;
printf("richards: %d ms\n", diff/(CLK_TCK/1000));
// if (ITER > 1)
// printf("\n*** %d iterations, average of %g secs / iteration.\n",
// ITER,
// (double)(t_stop - t_start) / (ITER * CLK_TCK));
}
/* richards.h */
/* Richards benchmark in C++, translated from Smalltalk */
/* uh 2/2/89 */
#include "rbase.h"
#include "tasks.h"
/*
// RBench class definition
*/
class RBench {
private:
TaskControlBlock *taskList, *currentTask;
Identity currentTaskIdent;
TaskControlBlock *taskTable[NTASKS];
int layout;
int holdCount, queuePacketCount;
/* creation */
void CreateDevice (Identity id, int prio, Packet *work,
TaskState *state);
void CreateHandler(Identity id, int prio, Packet *work,
TaskState *state);
void CreateIdler (Identity id, int prio, Packet *work,
TaskState *state);
void CreateWorker (Identity id, int prio, Packet *work,
TaskState *state);
void EnterTask(Identity id, TaskControlBlock *t);
/* scheduling */
void Schedule();
/* initializing */
void InitScheduler();
void InitTrace();
public:
/* task management */
TaskControlBlock *FindTask(Identity id);
TaskControlBlock *HoldSelf();
TaskControlBlock *QueuePacket(Packet *p);
TaskControlBlock *Release(Identity id);
TaskControlBlock *Wait();
/* tracing */
BOOLEAN tracing;
void Trace(Identity id);
void Start(BOOLEAN askTrace);
};
RBench bm; // benchmark currently executing
(in-package "USER")
#+declare-unsafe
(proclaim '(optimize speed (space 0) (safety 0) (compilation-speed 0)))
(defconstant deviceA 5)
(defconstant deviceB 6)
(defconstant devicePacketKind 1)
(defconstant handlerA 3)
(defconstant handlerB 4)
(defconstant idler 1)
(defconstant noWork nil)
(defconstant noTask nil)
(defconstant worker 2)
(defconstant workPacketKind 2)
(defvar taskList noTask)
(defvar currentTask nil)
(defvar currentTaskIdentity nil)
(defvar taskTable (make-array 6 :initial-element noTask))
(proclaim '(simple-vector taskTable))
(defvar tracing nil)
(defvar layout 0)
(defvar queuePacketCount 0)
(defvar holdCount 0)
(proclaim '(fixnum layout queuePacketCount holdCount))
(declaim (inline make-taskControlBlock make-packet make-deviceTaskDataRecord
make-handlerTaskDataRecord make-idleTaskDataRecord
make-workerTaskDataRecord wait))
(defstruct (taskControlBlock (:constructor make-taskControlBLock ()))
packetPending taskWaiting taskHolding link identity
(priority 0 :type fixnum)
input state handle)
(defstruct (packet (:constructor make-packet ()))
link identity
(kind 0 :type fixnum)
(datum 0 :type fixnum)
(data '#() :type simple-vector))
(defstruct (deviceTaskDataRecord (:constructor make-deviceTaskDataRecord ()))
pending)
(defstruct (handlerTaskDataRecord (:constructor make-handlerTaskDataRecord ()))
workIn deviceIn)
(defstruct (idleTaskDataRecord (:constructor make-idleTaskDataRecord ()))
(control 0 :type fixnum)
(count 0 :type fixnum))
(defstruct (workerTaskDataRecord (:constructor make-workerTaskDataRecord ()))
(destination 0 :type fixnum)
(count 0 :type fixnum))
(defun wait ()
(setf (taskControlBlock-taskWaiting currentTask) t)
currentTask)
#+cmu
(declaim (ext:freeze-type taskControlBlock packet deviceTaskDataRecord
handlerTaskDataRecord idleTaskDataRecord
workerTaskDataRecord))
#+cmu
(declaim (ext:start-block richards))
(defun deviceTaskDataRecord-run (self work)
(let ((functionWork work))
(if (eq noWork functionWork)
(progn
(setq functionWork (deviceTaskDataRecord-pending self))
(if (eq noWork functionWork)
(wait)
(progn
(setf (deviceTaskDataRecord-pending self) noWork)
(queuePacket functionWork))))
(progn
(setf (deviceTaskDataRecord-pending self) functionWork)
(if tracing (trace-it (packet-datum functionWork)))
(holdSelf)))))
(defun handlerTaskDataRecord-run (self work)
(if (eq noWork work)
nil
(if (= workPacketKind (packet-kind work))
(workInAdd self work)
(deviceInAdd self work)))
(let ((workPacket (handlerTaskDataRecord-workIn self)))
(if (eq noWork workPacket)
(wait)
(let ((count (packet-datum workPacket)))
(if (> count 4)
(progn
(setf (handlerTaskDataRecord-workIn self)
(packet-link workPacket))
(queuePacket workPacket))
(let ((devicePacket (handlerTaskDataRecord-deviceIn self)))
(if (eq noWork devicePacket)
(wait)
(progn
(setf (handlerTaskDataRecord-deviceIn self)
(packet-link devicePacket))
(setf (packet-datum devicePacket)
(svref (packet-data workPacket) (- count 1)))
(setf (packet-datum workPacket) (+ count 1))
(queuePacket devicePacket)))))))))
(defun idleTaskDataRecord-run (self work)
(declare (ignore work))
(setf (idleTaskDataRecord-count self)
(- (idleTaskDataRecord-count self) 1))
(if (= 0 (idleTaskDataRecord-count self))
(holdSelf)
(if (= 0 (logand (idleTaskDataRecord-control self) 1))
(progn
(setf (idleTaskDataRecord-control self)
(floor (idleTaskDataRecord-control self) 2))
(release deviceA))
(progn
(setf (idleTaskDataRecord-control self)
(logxor (floor (idleTaskDataRecord-control self) 2)
53256))
(release deviceB)))))
(defun workerTaskDataRecord-run (self work)
(if (eq noWork work)
(wait)
(progn
(setf (workerTaskDataRecord-destination self)
(if (= handlerA (workerTaskDataRecord-destination self))
handlerB
handlerA))
(setf (packet-identity work) (workerTaskDataRecord-destination self))
(setf (packet-datum work) 1)
(do ((i 0 (+ i 1)))
((> i 3) nil)
(declare (fixnum i))
(setf (workerTaskDataRecord-count self)
(+ (workerTaskDataRecord-count self) 1))
(if (> (workerTaskDataRecord-count self) 256)
(setf (workerTaskDataRecord-count self) 1))
(setf (svref (packet-data work) i)
(the fixnum
(+ (char-code #\A)
(- (workerTaskDataRecord-count self) 1)))))
(queuePacket work))))
(defun appendHead (packet queueHead)
(setf (packet-link packet) noWork)
(if (eq noWork queueHead)
packet
(let ((mouse queueHead))
(let ((link (packet-link mouse)))
(do ()
((eq noWork link) nil)
(setq mouse link)
(setq link (packet-link mouse)))
(setf (packet-link mouse) packet)
queueHead))))
(defun initialize-globals ()
(setq taskList noTask)
(setq currentTask nil)
(setq currentTaskIdentity nil)
(setq taskTable (make-array 6 :initial-element noTask))
(setq tracing nil)
(setq layout 0)
(setq queuePacketCount 0)
(setq holdCount 0))
(defun richards ()
(initialize-globals)
(createIdler idler 0 noWork (running (make-taskControlBlock)))
(let ((workQ))
(setq workQ (createPacket noWork worker workPacketKind))
(setq workQ (createPacket workQ worker workPacketKind))
(createWorker worker 1000 workQ (waitingWithPacket))
(setq workQ (createPacket noWork deviceA devicePacketKind))
(setq workQ (createPacket workQ deviceA devicePacketKind))
(setq workQ (createPacket workQ deviceA devicePacketKind))
(createHandler handlerA 2000 workQ (waitingWithPacket))
(setq workQ (createPacket noWork deviceB devicePacketKind))
(setq workQ (createPacket workQ deviceB devicePacketKind))
(setq workQ (createPacket workQ deviceB devicePacketKind))
(createHandler handlerB 3000 workQ (waitingWithPacket))
(createDevice deviceA 4000 noWork (waiting))
(createDevice deviceB 5000 noWork (waiting))
)
(schedule)
(if (not (and (= queuePacketCount 23246) (= holdCount 9297)))
(error "richards results incorrect"))
nil)
(defun schedule ()
(setq currentTask taskList)
(do ()
((eq noTask currentTask) nil)
(if (isTaskHoldingOrWaiting currentTask)
(setq currentTask (taskControlBlock-link currentTask))
(progn
(setq currentTaskIdentity (taskControlBlock-identity currentTask))
(if tracing (trace-it currentTaskIdentity))
(setq currentTask (runTask currentTask))))))
(defun findTask (identity)
(declare (fixnum identity))
(let ((tk (svref taskTable (- identity 1))))
(if (eq noTask tk) (error "findTask failed"))
tk))
(defun holdSelf ()
(setq holdCount (+ holdCount 1))
(setf (taskControlBlock-taskHolding currentTask) t)
(taskControlBlock-link currentTask))
(defun queuePacket (packet)
(let ((tk (findTask (packet-identity packet))))
(if (eq noTask tk)
noTask
(progn
(setq queuePacketCount (+ queuePacketCount 1))
(setf (packet-link packet) noWork)
(setf (packet-identity packet) currentTaskIdentity)
(addInput tk packet currentTask)))))
(defun release (identity)
(let ((tk (findTask identity)))
(if (eq noTask tk)
noTask
(progn
(setf (taskControlBlock-taskHolding tk) nil)
(if (> (taskControlBlock-priority tk)
(taskControlBlock-priority currentTask))
tk
currentTask)))))
(defun trace-it (id)
(setq layout (- layout 1))
(if (>= 0 layout)
(progn
(format t "~%")
(setq layout 30)))
(format t "~a " id))
(defun createDevice (identity priority work state)
(let ((data (create-deviceTaskDataRecord)))
(createTask identity priority work state data)))
(defun createHandler (identity priority work state)
(let ((data (create-handlerTaskDataRecord)))
(createTask identity priority work state data)))
(defun createIdler (identity priority work state)
(let ((data (create-idleTaskDataRecord)))
(createTask identity priority work state data)))
(defun createWorker (identity priority work state)
(let ((data (create-workerTaskDataRecord)))
(createTask identity priority work state data)))
(defun createTask (identity priority work state data)
(let ((tk (create-taskControlBlock
taskList identity priority work state data)))
(setq taskList tk)
(setf (svref taskTable (- identity 1)) tk)))
(defun createPacket (link identity kind)
(create-packet link identity kind))
(defun running (tcb)
(setf (taskControlBlock-packetPending tcb) nil)
(setf (taskControlBlock-taskWaiting tcb) nil)
(setf (taskControlBlock-taskHolding tcb) nil)
tcb)
(defun waiting ()
(let ((tcb (make-taskControlBlock)))
(setf (taskControlBlock-packetPending tcb) nil)
(setf (taskControlBlock-taskWaiting tcb) t)
(setf (taskControlBlock-taskHolding tcb) nil)
tcb))
(defun waitingWithPacket ()
(let ((tcb (make-taskControlBlock)))
(setf (taskControlBlock-packetPending tcb) t)
(setf (taskControlBlock-taskWaiting tcb) t)
(setf (taskControlBlock-taskHolding tcb) nil)
tcb))
(defun isTaskHoldingOrWaiting (tcb)
(or (taskControlBlock-taskHolding tcb)
(and (not (taskControlBlock-packetPending tcb))
(taskControlBlock-taskWaiting tcb))))
(defun isWaitingWithPacket (tcb)
(and (taskControlBlock-packetPending tcb)
(and (taskControlBlock-taskWaiting tcb)
(not (taskControlBlock-taskHolding tcb)))))
(defun packetNowPending (tcb)
(setf (taskControlBlock-packetPending tcb) t)
(setf (taskControlBlock-taskWaiting tcb) nil)
(setf (taskControlBlock-taskHolding tcb) nil)
tcb)
(defun create-taskControlBlock
(link identity priority initialWorkQueue initialState privateData)
(let ((r (make-taskControlBlock)))
(setf (taskControlBlock-link r) link)
(setf (taskControlBlock-identity r) identity)
(setf (taskControlBlock-priority r) priority)
(setf (taskControlBlock-input r) initialWorkQueue)
(setf (taskControlBlock-packetPending r)
(taskControlBlock-packetPending initialState))
(setf (taskControlBlock-taskWaiting r)
(taskControlBlock-taskWaiting initialState))
(setf (taskControlBlock-taskHolding r)
(taskControlBlock-taskHolding initialState))
(setf (taskControlBlock-handle r) privateData)
(setf (taskControlBlock-state r) nil)
r))
(defun addInput (tcb packet oldTask)
(if (eq noWork (taskControlBlock-input tcb))
(progn
(setf (taskControlBlock-input tcb) packet)
(setf (taskControlBlock-packetPending tcb) t)
(if (> (taskControlBlock-priority tcb)
(taskControlBlock-priority oldTask))
tcb
oldTask))
(progn
(setf (taskControlBlock-input tcb)
(appendHead packet (taskControlBlock-input tcb)))
oldTask)))
(defun runTask (tcb)
(let ((message nil))
(if (isWaitingWithPacket tcb)
(progn
(setq message (taskControlBlock-input tcb))
(setf (taskControlBlock-input tcb) (packet-link message))
(if (eq noWork (taskControlBlock-input tcb))
(running tcb)
(packetNowPending tcb)))
(setq message noWork))
(run (taskControlBlock-handle tcb) message)))
(defun run (self work)
(typecase self
(deviceTaskDataRecord (deviceTaskDataRecord-run self work))
(handlerTaskDataRecord (handlerTaskDataRecord-run self work))
(idleTaskDataRecord (idleTaskDataRecord-run self work))
(workerTaskDataRecord (workerTaskDataRecord-run self work))))
(defun create-packet (link identity kind)
(let ((p (make-packet)))
(setf (packet-link p) link)
(setf (packet-identity p) identity)
(setf (packet-kind p) kind)
(setf (packet-datum p) 1)
(let ((v (make-array 4 :initial-element 0)))
(setf (packet-data p) v))
p))
(defun create-deviceTaskDataRecord ()
(let ((tk (make-deviceTaskDataRecord)))
(setf (deviceTaskDataRecord-pending tk) noWork)
tk))
(defun create-handlerTaskDataRecord ()
(let ((tk (make-handlerTaskDataRecord)))
(setf (handlerTaskDataRecord-workIn tk) noWork)
(setf (handlerTaskDataRecord-deviceIn tk) noWork)
tk))
(defun deviceInAdd (tk packet)
(setf (handlerTaskDataRecord-deviceIn tk)
(appendHead packet (handlerTaskDataRecord-deviceIn tk)))
tk)
(defun workInAdd (tk packet)
(setf (handlerTaskDataRecord-workIn tk)
(appendHead packet (handlerTaskDataRecord-workIn tk)))
tk)
(defun create-idleTaskDataRecord ()
(let ((tk (make-idleTaskDataRecord)))
(setf (idleTaskDataRecord-control tk) 1)
(setf (idleTaskDataRecord-count tk) 10000)
tk))
(defun create-workerTaskDataRecord ()
(let ((tk (make-workerTaskDataRecord)))
(setf (workerTaskDataRecord-destination tk) handlerA)
(setf (workerTaskDataRecord-count tk) 0)
tk))
(herald richards)
(define deviceA 5)
(define deviceB 6)
(define devicePacketKind 1)
(define handlerA 3)
(define handlerB 4)
(define idler 1)
(define noWork nil)
(define noTask nil)
(define worker 2)
(define workPacketKind 2)
(lset taskList noTask)
(lset currentTask nil)
(lset currentTaskIdentity nil)
(lset taskTable (make-vector 6))
(lset tracing nil)
(lset layout 0)
(lset queuePacketCount 0)
(lset holdCount 0)
(define-operation (run self work))
(vector-fill taskTable noTask)
(define (hash-obj l)
(if l (object-hash l) nil))
(define-structure-type taskControlBlock
packetPending taskWaiting taskHolding link identity priority input state
handle)
(define-structure-type packet
link identity kind datum data)
(define-structure-type deviceTaskDataRecord
pending
(((run self work)
(lset functionWork work)
(if (equal? noWork functionWork)
(block
(set functionWork (deviceTaskDataRecord-pending self))
(if (equal? noWork functionWork)
(wait)
(block
(set (deviceTaskDataRecord-pending self) noWork)
(queuePacket functionWork))))
(block
(set (deviceTaskDataRecord-pending self) functionWork)
(if tracing (trace (packet-datum functionWork)))
(holdSelf))))))
(define-structure-type handlerTaskDataRecord
workIn deviceIn
(((run self work)
(if (equal? noWork work)
nil
(if (equal? workPacketKind (packet-kind work))
(workInAdd self work)
(deviceInAdd self work)))
(let ((workPacket (handlerTaskDataRecord-workIn self)))
(if (equal? noWork workPacket)
(wait)
(let ((count (packet-datum workPacket)))
(if (> count 4)
(block
(set (handlerTaskDataRecord-workIn self)
(packet-link workPacket))
(queuePacket workPacket))
(let ((devicePacket (handlerTaskDataRecord-deviceIn self)))
(if (equal? noWork devicePacket)
(wait)
(block
(set (handlerTaskDataRecord-deviceIn self)
(packet-link devicePacket))
(set (packet-datum devicePacket)
(vref (packet-data workPacket) (- count 1)))
(set (packet-datum workPacket) (+ count 1))
(queuePacket devicePacket)))))))))))
(define-structure-type idleTaskDataRecord
control count
(((run self work)
(ignorable work)
(set (idleTaskDataRecord-count self)
(- (idleTaskDataRecord-count self) 1))
(if (equal? 0 (idleTaskDataRecord-count self))
(holdSelf)
(if (equal? 0 (logand (idleTaskDataRecord-control self) 1))
(block
(set (idleTaskDataRecord-control self)
(quotient (idleTaskDataRecord-control self) 2))
(release deviceA))
(block
(set (idleTaskDataRecord-control self)
(logxor (quotient (idleTaskDataRecord-control self) 2)
53256))
(release deviceB)))))))
(define-structure-type workerTaskDataRecord
destination count
(((run self work)
(if (equal? noWork work)
(wait)
(block
(set (workerTaskDataRecord-destination self)
(if (equal? handlerA (workerTaskDataRecord-destination self))
handlerB
handlerA))
(set (packet-identity work) (workerTaskDataRecord-destination self))
(set (packet-datum work) 1)
(do ((i 0 (+ i 1)))
((> i 3) nil)
(set (workerTaskDataRecord-count self)
(+ (workerTaskDataRecord-count self) 1))
(if (> (workerTaskDataRecord-count self) 256)
(set (workerTaskDataRecord-count self) 1))
(vset (packet-data work) i
(+ (char->ascii #\A)
(- (workerTaskDataRecord-count self) 1))))
(queuePacket work))))))
(define (appendHead packet queueHead)
(set (packet-link packet) noWork)
(if (equal? noWork queueHead)
packet
(block
(lset mouse queueHead)
(lset link (packet-link mouse))
(do ()
((equal? noWork link) nil)
(set mouse link)
(set link (packet-link mouse)))
(set (packet-link mouse) packet)
queueHead)))
(define (initialize-globals)
(set taskList noTask)
(set currentTask nil)
(set currentTaskIdentity nil)
(set taskTable (make-vector 6))
(set tracing nil)
(set layout 0)
(set queuePacketCount 0)
(set holdCount 0)
(vector-fill taskTable noTask))
(define (richards)
(initialize-globals)
(createIdler idler 0 noWork (running (make-taskControlBlock)))
(lset workQ (createPacket noWork worker workPacketKind))
(set workQ (createPacket workQ worker workPacketKind))
(createWorker worker 1000 workQ (waitingWithPacket))
(set workQ (createPacket noWork deviceA devicePacketKind))
(set workQ (createPacket workQ deviceA devicePacketKind))
(set workQ (createPacket workQ deviceA devicePacketKind))
(createHandler handlerA 2000 workQ (waitingWithPacket))
(set workQ (createPacket noWork deviceB devicePacketKind))
(set workQ (createPacket workQ deviceB devicePacketKind))
(set workQ (createPacket workQ deviceB devicePacketKind))
(createHandler handlerB 3000 workQ (waitingWithPacket))
(createDevice deviceA 4000 noWork (waiting))
(createDevice deviceB 5000 noWork (waiting))
(schedule)
(if (not (and (equal? queuePacketCount 23246) (equal? holdCount 9297)))
(error "richards results incorrect"))
nil)
(define (schedule)
(set currentTask taskList)
(do ()
((equal? noTask currentTask) nil)
(if (isTaskHoldingOrWaiting currentTask)
(set currentTask (taskControlBlock-link currentTask))
(block
(set currentTaskIdentity (taskControlBlock-identity currentTask))
(if tracing (trace currentTaskIdentity))
(set currentTask (runTask currentTask))))))
(define (findTask identity)
(let ((tk (vref taskTable (- identity 1))))
(if (equal? noTask tk) (error "findTask failed"))
tk))
(define (holdSelf)
(set holdCount (+ holdCount 1))
(set (taskControlBlock-taskHolding currentTask) t)
(taskControlBlock-link currentTask))
(define (queuePacket packet)
(let ((tk (findTask (packet-identity packet))))
(if (equal? noTask tk)
noTask
(block
(set queuePacketCount (+ queuePacketCount 1))
(set (packet-link packet) noWork)
(set (packet-identity packet) currentTaskIdentity)
(addInput tk packet currentTask)))))
(define (release identity)
(let ((tk (findTask identity)))
(if (equal? noTask tk)
noTask
(block
(set (taskControlBlock-taskHolding tk) nil)
(if (> (taskControlBlock-priority tk)
(taskControlBlock-priority currentTask))
tk
currentTask)))))
(define (trace id)
(set layout (- layout 1))
(if (>= 0 layout)
(block
(format (debug-output) "~%")
(set layout 30)))
(format (debug-output) "~a " id))
(define (wait)
(set (taskControlBlock-taskWaiting currentTask) t)
currentTask)
(define (createDevice identity priority work state)
(let ((data (create-deviceTaskDataRecord)))
(createTask identity priority work state data)))
(define (createHandler identity priority work state)
(let ((data (create-handlerTaskDataRecord)))
(createTask identity priority work state data)))
(define (createIdler identity priority work state)
(let ((data (create-idleTaskDataRecord)))
(createTask identity priority work state data)))
(define (createWorker identity priority work state)
(let ((data (create-workerTaskDataRecord)))
(createTask identity priority work state data)))
(define (createTask identity priority work state data)
(let ((tk (create-taskControlBlock
taskList identity priority work state data)))
(set taskList tk)
(vset taskTable (- identity 1) tk)))
(define (createPacket link identity kind)
(create-packet link identity kind))
(define (running tcb)
(set (taskControlBlock-packetPending tcb) nil)
(set (taskControlBlock-taskWaiting tcb) nil)
(set (taskControlBlock-taskHolding tcb) nil)
tcb)
(define (waiting)
(let ((tcb (make-taskControlBlock)))
(set (taskControlBlock-packetPending tcb) nil)
(set (taskControlBlock-taskWaiting tcb) t)
(set (taskControlBlock-taskHolding tcb) nil)
tcb))
(define (waitingWithPacket)
(let ((tcb (make-taskControlBlock)))
(set (taskControlBlock-packetPending tcb) t)
(set (taskControlBlock-taskWaiting tcb) t)
(set (taskControlBlock-taskHolding tcb) nil)
tcb))
(define (isTaskHoldingOrWaiting tcb)
(or (taskControlBlock-taskHolding tcb)
(and (not (taskControlBlock-packetPending tcb))
(taskControlBlock-taskWaiting tcb))))
(define (isWaitingWithPacket tcb)
(and (taskControlBlock-packetPending tcb)
(and (taskControlBlock-taskWaiting tcb)
(not (taskControlBlock-taskHolding tcb)))))
(define (packetNowPending tcb)
(set (taskControlBlock-packetPending tcb) t)
(set (taskControlBlock-taskWaiting tcb) nil)
(set (taskControlBlock-taskHolding tcb) nil)
tcb)
(define (create-taskControlBlock
link identity priority initialWorkQueue initialState privateData)
(let ((r (make-taskControlBlock)))
(set (taskControlBlock-link r) link)
(set (taskControlBlock-identity r) identity)
(set (taskControlBlock-priority r) priority)
(set (taskControlBlock-input r) initialWorkQueue)
(set (taskControlBlock-packetPending r)
(taskControlBlock-packetPending initialState))
(set (taskControlBlock-taskWaiting r)
(taskControlBlock-taskWaiting initialState))
(set (taskControlBlock-taskHolding r)
(taskControlBlock-taskHolding initialState))
(set (taskControlBlock-handle r) privateData)
(set (taskControlBlock-state r) nil)
r))
(define (addInput tcb packet oldTask)
(if (equal? noWork (taskControlBlock-input tcb))
(block
(set (taskControlBlock-input tcb) packet)
(set (taskControlBlock-packetPending tcb) t)
(if (> (taskControlBlock-priority tcb)
(taskControlBlock-priority oldTask))
tcb
oldTask))
(block
(set (taskControlBlock-input tcb)
(appendHead packet (taskControlBlock-input tcb)))
oldTask)))
(define (runTask tcb)
(lset message nil)
(if (isWaitingWithPacket tcb)
(block
(set message (taskControlBlock-input tcb))
(set (taskControlBlock-input tcb) (packet-link message))
(if (equal? noWork (taskControlBlock-input tcb))
(running tcb)
(packetNowPending tcb)))
(set message noWork))
(run (taskControlBlock-handle tcb) message))
(define (create-packet link identity kind)
(let ((p (make-packet)))
(set (packet-link p) link)
(set (packet-identity p) identity)
(set (packet-kind p) kind)
(set (packet-datum p) 1)
(let ((v (make-vector 4)))
(vector-fill v 0)
(set (packet-data p) v))
p))
(define (create-deviceTaskDataRecord)
(let ((tk (make-deviceTaskDataRecord)))
(set (deviceTaskDataRecord-pending tk) noWork)
tk))
(define (create-handlerTaskDataRecord)
(let ((tk (make-handlerTaskDataRecord)))
(set (handlerTaskDataRecord-workIn tk) noWork)
(set (handlerTaskDataRecord-deviceIn tk) noWork)
tk))
(define (deviceInAdd tk packet)
(set (handlerTaskDataRecord-deviceIn tk)
(appendHead packet (handlerTaskDataRecord-deviceIn tk)))
tk)
(define (workInAdd tk packet)
(set (handlerTaskDataRecord-workIn tk)
(appendHead packet (handlerTaskDataRecord-workIn tk)))
tk)
(define (create-idleTaskDataRecord)
(let ((tk (make-idleTaskDataRecord)))
(set (idleTaskDataRecord-control tk) 1)
(set (idleTaskDataRecord-count tk) 10000)
tk))
(define (create-workerTaskDataRecord)
(let ((tk (make-workerTaskDataRecord)))
(set (workerTaskDataRecord-destination tk) handlerA)
(set (workerTaskDataRecord-count tk) 0)
tk))
/* tasks.c */
#include "tasks.h"
#include "richards.h"
/*
// TaskControlBlock
*/
TaskControlBlock::TaskControlBlock(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData)
{
link = l; ident = id; priority = prio; input = initialWork;
packetPending = initialState->IsPacketPending();
taskWaiting = initialState->IsTaskWaiting();
taskHolding = initialState->IsTaskHolding();
handle = privateData;
}
TaskControlBlock *TaskControlBlock::AddPacket(Packet *p,
TaskControlBlock *oldTask)
{
if (input == NoWork) {
input = p;
packetPending = TRUE;
if (priority > oldTask->priority) return this;
}
else AddToList(input, p);
return oldTask;
}
TaskControlBlock *TaskControlBlock::RunTask()
{ Packet *msg;
if (IsWaitingWithPacket()) {
msg = input;
input = input->Link();
if (input == NoWork)
Running();
else PacketPending();
}
else msg = NoWork;
return this->ActionFunc(msg, handle);
}
/*
// action functions
*/
TaskControlBlock *TaskControlBlock::ActionFunc(Packet *p, void *handle)
{
p, handle, 0;
printf("***error: virtual TaskControlBlock.ActionFunc called!\n");
return NoTask;
}
TaskControlBlock *DeviceTCB::ActionFunc(Packet *p, void *handle)
{ DeviceTaskRec *data = (DeviceTaskRec *)handle;
if (p == NoWork) {
if ((p = data->Pending()) == NoWork)
return bm.Wait();
else {
data->SetPending(NoWork);
return bm.QueuePacket(p);
}
}
else {
data->SetPending(p);
if (bm.tracing) bm.Trace(p->Datum());
return bm.HoldSelf();
}
}
TaskControlBlock *HandlerTCB::ActionFunc(Packet *p, void *handle)
{ HandlerTaskRec *data = (HandlerTaskRec *)handle;
Packet *work, *devicePacket;
int count;
if (p != NoWork) {
if (p->Kind() == WorkPacket)
data->WorkInAdd(p);
else data->DeviceInAdd(p);
}
if ((work = data->WorkIn()) == NoWork)
return bm.Wait();
else {
count = work->Datum();
if (count > 4) {
data->SetWorkIn(work->Link());
return bm.QueuePacket(work);
}
else {
if ((devicePacket = data->DeviceIn()) == NoWork)
return bm.Wait();
else {
data->SetDeviceIn(devicePacket->Link());
devicePacket->SetDatum(work->Data()[count-1]);
work->SetDatum(count + 1);
return bm.QueuePacket(devicePacket);
}
}
}
}
TaskControlBlock *IdlerTCB::ActionFunc(Packet *p, void *handle)
/* p is not used here */
{ IdleTaskRec *data = (IdleTaskRec *)handle;
p, 0;
data->SetCount(data->Count() - 1);
if (data->Count() == 0)
return bm.HoldSelf();
else if ((data->Control() & 1) == 0) {
data->SetControl(data->Control() / 2);
return bm.Release(DeviceA);
}
else {
data->SetControl((data->Control() / 2) ^ 53256);
return bm.Release(DeviceB);
}
}
TaskControlBlock *WorkerTCB::ActionFunc(Packet *p, void *handle)
{ WorkerTaskRec *data = (WorkerTaskRec *)handle;
Identity dest;
if (p == NoWork)
return bm.Wait();
else {
dest = (data->Destination() == HandlerA) ? HandlerB : HandlerA;
data->SetDestination(dest);
p->SetIdent(dest);
p->SetDatum(1);
for(int i = 0; i < 4; i++) {
data->SetCount(data->Count() + 1);
if (data->Count() > 26) data->SetCount(1);
p->Data()[i] = 'A' + data->Count();
}
return bm.QueuePacket(p);
}
}
/* tasks.h - definitions of TaskState, TaskControlBlock and xxxTCB
* The subclasses of TaskControlBlock differ only in their
* implementation of the action function */
#ifndef TASKS
#define TASKS
#include "types.h"
/*
// TaskState
*/
class TaskState {
protected:
BOOLEAN packetPending, taskWaiting, taskHolding;
public:
/* initializing */
TaskState() {packetPending = TRUE; taskWaiting = taskHolding = FALSE;}
void PacketPending() {packetPending = TRUE; taskHolding = taskWaiting = FALSE;}
void Waiting() {packetPending = taskHolding = FALSE; taskWaiting = TRUE;}
void Running() {packetPending = taskWaiting = taskHolding = FALSE;}
void WaitingWithPacket() {packetPending = taskWaiting = TRUE; taskHolding = FALSE;}
/* accessing */
BOOLEAN IsPacketPending() {return packetPending;}
BOOLEAN IsTaskWaiting() {return taskWaiting;}
BOOLEAN IsTaskHolding() {return taskHolding;}
void SetTaskHolding(BOOLEAN state) {taskHolding = state;}
void SetTaskWaiting(BOOLEAN state) {taskWaiting = state;}
/* testing */
BOOLEAN IsRunning() {return !packetPending && !taskWaiting && !taskHolding;}
BOOLEAN IsTaskHoldingOrWaiting() {return taskHolding || !packetPending && taskWaiting;}
BOOLEAN IsWaiting() {return !packetPending && taskWaiting && !taskHolding;}
BOOLEAN IsWaitingWithPacket() {return packetPending && taskWaiting && !taskHolding;}
};
/*
// TaskControlBlock
*/
class TaskControlBlock : public TaskState {
protected:
TaskControlBlock *link;
Identity ident;
int priority;
Packet *input;
void *handle;
public:
/* initializing */
TaskControlBlock(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData);
/* accessing */
Identity Ident() {return ident;}
int Priority() {return priority;}
TaskControlBlock *Link() {return link;}
/* scheduling */
TaskControlBlock *AddPacket(Packet *p, TaskControlBlock *old);
virtual TaskControlBlock *ActionFunc(Packet *p, void *handle);
TaskControlBlock *RunTask();
};
/*
// DeviceTCB
*/
class DeviceTCB : public TaskControlBlock {
public:
DeviceTCB(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData) :
(l, id, prio, initialWork, initialState, privateData){}
TaskControlBlock *ActionFunc(Packet *p, void *handle);
};
/*
// HandlerTCB
*/
class HandlerTCB : public TaskControlBlock {
public:
HandlerTCB(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData) :
(l, id, prio, initialWork, initialState, privateData){}
TaskControlBlock *ActionFunc(Packet *p, void *handle);
};
/*
// IdlerTCB
*/
class IdlerTCB : public TaskControlBlock {
public:
IdlerTCB(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData) :
(l, id, prio, initialWork, initialState, privateData){}
TaskControlBlock *ActionFunc(Packet *p, void *handle);
};
/*
// WorkerTCB
*/
class WorkerTCB : public TaskControlBlock {
public:
WorkerTCB(TaskControlBlock *l, Identity id, int prio,
Packet *initialWork, TaskState *initialState,
void *privateData) :
(l, id, prio, initialWork, initialState, privateData){}
TaskControlBlock *ActionFunc(Packet *p, void *handle);
};
#endif
/* types.c */
#include "types.h"
/*
// AddToList - list utility (append elem at end of list, return head)
*/
Packet *AddToList(Packet *list, Packet *elem)
{ Packet *p, *next;
elem->SetLink(NoWork);
if (list != NoWork) {
p = list;
while((next = p->Link()) != NoWork) p = next;
p->SetLink(elem);
}
else list = elem;
return list;
}
Packet::Packet(Packet *l, Identity id, PacketKind k)
{
link = l;
ident = id;
kind = k;
datum = 1;
for(int i = 0; i < 4; i++) data[i] = 0;
}
/* types.h -- basic classes (Packet, {Device,Idle,...}TaskRec) */
#include "cbase.h"
#include "rbase.h"
/*
// Packet
*/
class Packet {
private:
Packet *link; // next packet in queue
Identity ident; // Idle, Worker, DeviceA, ...
PacketKind kind; // DevicePacket or WorkPacket
int datum;
char data[4];
public:
Packet(Packet *l, Identity id, PacketKind k);
char *Data() {return data;}
void SetData(char d[4]) {for(int i=0; i < 4; i++) data[i] = d[i];}
int Datum() {return datum;}
void SetDatum(int n) {datum = n;}
Identity Ident() {return ident;}
void SetIdent(Identity i) {ident = i;}
PacketKind Kind() {return kind;}
void SetKind(PacketKind k) {kind = k;}
Packet *Link() {return link;}
void SetLink(Packet *l) {link = l;}
};
/*
// AddToList - list utility (append elem at end of list, return head)
*/
Packet *AddToList(Packet *list, Packet *elem);
/*
// DeviceTaskRec
*/
class DeviceTaskRec {
private:
Packet *pending;
public:
DeviceTaskRec() {pending = NoWork;}
Packet *Pending() {return pending;}
void SetPending(Packet *p) {pending = p;}
};
/*
// IdleTaskRec
*/
class IdleTaskRec {
private:
int control, count;
public:
IdleTaskRec() {control = 1; count = 10000;}
int Control() {return control;}
void SetControl(int n) {control = n;}
int Count() {return count;}
void SetCount(int n) {count = n;}
};
/*
// HandlerTaskRec
*/
class HandlerTaskRec {
private:
Packet *workIn, *deviceIn;
public:
HandlerTaskRec() {workIn = deviceIn = NoWork;}
Packet *WorkIn() {return workIn;}
void SetWorkIn(Packet *p) {workIn = p;}
Packet *WorkInAdd(Packet *p) {return workIn = AddToList(workIn, p);}
Packet *DeviceIn() {return deviceIn;}
void SetDeviceIn(Packet *p) {deviceIn = p;}
Packet *DeviceInAdd(Packet *p) {return deviceIn = AddToList(deviceIn, p);}
};
/*
// WorkerTaskRec
*/
class WorkerTaskRec {
private:
Identity destination;
int count;
public:
WorkerTaskRec() {destination = HandlerA; count = 0;}
int Count() {return count;}
void SetCount(int n) {count = n;}
Identity Destination() {return destination;}
void SetDestination(Identity d) {destination = d;}
};
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment