DIRECTORY
BasicTime,
PrincOpsUtils USING [BITAND, BITXOR];

Richards: PROGRAM 
IMPORTS
BasicTime, PrincOpsUtils = {

z: UNCOUNTED ZONE;     -- heap to use for packets and tasks
TaskIdentity: TYPE = MACHINE DEPENDENT
{idler(1), worker, handlerA, handlerB, deviceA, deviceB};

Task: TYPE = LONG POINTER TO TaskControlBlock;
TaskControlBlock: TYPE = RECORD [
link: Task,
identity: TaskIdentity,
priority: TaskPriority,
input: WorkQueue,
state: TaskState,
function: TaskOperation,
handle: LONG POINTER];

TaskPriority: TYPE = CARDINAL;

TaskState: TYPE = RECORD [packetPending, taskWaiting, taskHolding: BOOL _ FALSE];
running: TaskState = [];
waiting: TaskState = [taskWaiting: TRUE];
waitingWithPacket: TaskState = [taskWaiting: TRUE, packetPending: TRUE];

TaskOperation: TYPE = PROC [work: WorkQueue, word: LONG POINTER] RETURNS [t: Task];

noTask: Task = NIL;

WorkQueue: TYPE = LONG POINTER TO Packet; 
Packet: TYPE = RECORD [
link: WorkQueue,
identity: TaskIdentity,
kind: PacketKind,
datum: CARDINAL,
data: ARRAY [0..packetBufferSize] OF CARDINAL];    

PacketKind: TYPE = {devicePacketKind, workPacketKind};
packetBufferSize: CARDINAL = 3;

noWork: WorkQueue = NIL;

queuePacketCount: CARDINAL;
holdCount: CARDINAL;

taskTable: ARRAY TaskIdentity OF Task;
taskList: Task;
currentTask: Task;
currentTaskIdentity: TaskIdentity;

InitScheduler: PROC [] = {
queuePacketCount _ holdCount _ 0;
allocWords _ allocObjects _ 0;
taskTable _ ALL[noTask];
taskList _ noTask;
};

CreateTask: PROC 
[identity: TaskIdentity, priority: TaskPriority, initialWorkQueue: WorkQueue, initialState: TaskState, function: TaskOperation, privateData: LONG POINTER] = {
t: Task _ z.NEW[TaskControlBlock _ [
link: taskList, 
identity: identity,
priority: priority,
input: initialWorkQueue, 
state: initialState, 
function: function,
handle: privateData]];
taskList _ t;
taskTable[identity] _ t;
};

CreatePacket: PROC 
[link: WorkQueue, identity: TaskIdentity, kind: PacketKind]
RETURNS [workQueue: WorkQueue] = {
workQueue _ z.NEW[Packet _ [
link: link, 
identity: identity, 
kind: kind, 
datum: 0, 
data: ALL[0]]];
RETURN [workQueue];
};

QueuePacket: PROC [packet: WorkQueue] RETURNS [task: Task] = {
t: Task _ FindTask[packet.identity];
IF t = noTask THEN RETURN [noTask];
queuePacketCount _ queuePacketCount+1;
packet.link _ noWork;
packet.identity _ currentTaskIdentity;
IF t.input = noWork
THEN {
t.input _ packet;
t.state.packetPending _ TRUE;
IF t.priority > currentTask.priority THEN RETURN [t]
}
ELSE
Append[packet, @t.input];
RETURN [currentTask];
};

Append: PROC [packet: WorkQueue, head: LONG POINTER TO WorkQueue] = {
packet.link _ noWork;
IF head^ = noWork THEN {head^ _ packet; RETURN};
FOR mouse: WorkQueue _ head^, mouse.link UNTIL mouse.link = noWork DO
REPEAT
FINISHED => mouse.link _ packet
ENDLOOP;
};

Schedule: PROC = {
message: WorkQueue;

currentTask _ taskList;
WHILE currentTask # noTask DO
message _ noWork;
IF currentTask.state.taskHolding OR currentTask.state = waiting
THEN currentTask _ currentTask.link
ELSE {
IF currentTask.state = waitingWithPacket THEN {
message _ currentTask.input;
currentTask.input _ message.link;
IF currentTask.input = noWork 
THEN currentTask.state _ running
ELSE currentTask.state _ [packetPending: TRUE]
};
currentTaskIdentity _ currentTask.identity;
currentTask _ currentTask.function[message, currentTask.handle];
};
ENDLOOP;
};

Wait: PROC [] RETURNS [task: Task] = {
currentTask.state.taskWaiting _ TRUE;
RETURN [currentTask];
};

HoldSelf: PROC [] RETURNS [task: Task] = {
holdCount _ holdCount+1;
currentTask.state.taskHolding _ TRUE;
RETURN [currentTask.link];
};

Release: PROC [identity: TaskIdentity] RETURNS [task: Task] = {
t: Task _ FindTask[identity];
IF t = noTask THEN RETURN [noTask];
t.state.taskHolding _ FALSE;
IF t.priority > currentTask.priority 
THEN RETURN [t]
ELSE RETURN [currentTask];
};

FindTask: PROC [identity: TaskIdentity] RETURNS [task: Task] = {
t: Task _ taskTable[identity];
IF t = noTask THEN ERROR;
RETURN [t];
};


hashValue: CARDINAL =  0D008H;

IdleTaskDataRecord: TYPE = RECORD [control: WORD, count: CARDINAL];
IdleTaskData: TYPE = LONG POINTER TO IdleTaskDataRecord;
initialControl: WORD = 1;

CreateIdler: PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: IdleTaskData _ z.NEW[IdleTaskDataRecord _ [initialControl, 10000]];
CreateTask[identity, priority, work, state, IdleFunction, data];
};

IdleFunction: TaskOperation = {
data: IdleTaskData _ word;
data.count _ data.count-1;
IF data.count = 0 THEN RETURN [HoldSelf[]];
IF PrincOpsUtils.BITAND[data.control, 1] = 0
THEN {
data.control _ data.control/2;
RETURN [Release[deviceA]];
}
ELSE {
data.control _ PrincOpsUtils.BITXOR[data.control/2, hashValue];
RETURN [Release[deviceB]];
};
};


DeviceTaskDataRecord: TYPE = RECORD [pending: WorkQueue];
DeviceTaskData: TYPE = LONG POINTER TO DeviceTaskDataRecord;

CreateDevice: PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: DeviceTaskData _ z.NEW[DeviceTaskDataRecord _ [noWork]];
CreateTask[identity, priority, work, state, DeviceFunction, data];
};

DeviceFunction: TaskOperation = {
data: DeviceTaskData _ word;
IF work = noWork 
THEN {
IF data.pending = noWork THEN RETURN [Wait[]];
work _ data.pending;
data.pending _ noWork;
RETURN [QueuePacket[work]]
}
ELSE {
data.pending _ work;
RETURN [HoldSelf[]]
};
};


HandlerTaskDataRecord: TYPE = RECORD [workIn, deviceIn: WorkQueue];
HandlerTaskData: TYPE = LONG POINTER TO HandlerTaskDataRecord;

CreateHandler: PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: HandlerTaskData _ z.NEW[HandlerTaskDataRecord _ [noWork, noWork]];
CreateTask[identity, priority, work, state, HandlerFunction, data];
};

HandlerFunction: TaskOperation = {
data: HandlerTaskData _ word;
workPacket, devicePacket: WorkQueue;
count: INTEGER;
IF work # noWork THEN
IF work.kind = workPacketKind 
THEN Append[work, @data.workIn]
ELSE Append[work, @data.deviceIn];
IF data.workIn # noWork THEN {
workPacket _ data.workIn;
count _ workPacket.datum;
IF count > packetBufferSize THEN {
data.workIn _ data.workIn.link;
RETURN [QueuePacket[workPacket]];
};
IF data.deviceIn # noWork THEN {
devicePacket _ data.deviceIn;
data.deviceIn _ data.deviceIn.link;
devicePacket.datum _ workPacket.data[count];
workPacket.datum _ count+1;
RETURN [QueuePacket[devicePacket]]
};
};
RETURN [Wait[]];
};


WorkerTaskDataRecord: TYPE = RECORD [destination: TaskIdentity, count: CARDINAL];
WorkerTaskData: TYPE = LONG POINTER TO WorkerTaskDataRecord;

CreateWorker: PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: WorkerTaskData _ z.NEW[WorkerTaskDataRecord _ [handlerA, 0]];
CreateTask[identity, priority, work, state, WorkFunction, data];
};

WorkFunction: TaskOperation = {
data: WorkerTaskData _ word;
IF work = noWork
THEN RETURN [Wait[]]
ELSE {
data.destination _ 
(IF data.destination = handlerA THEN handlerB ELSE handlerA);
work.identity _ data.destination;
work.datum _ 0;
FOR i: CARDINAL IN [0..packetBufferSize] DO
data.count _ data.count+1;
IF data.count > 26 THEN data.count _ 1;
work.data[i] _ ('A-0C)+data.count-1;
ENDLOOP;
RETURN [QueuePacket[work]];
};
};

Main: PUBLIC PROC RETURNS [time: REAL] = {
workQ: WorkQueue;

pulses: BasicTime.Pulses = BasicTime.GetClockPulses[];

InitScheduler[];

CreateIdler[idler, 0, noWork, running];

workQ _ CreatePacket[noWork, worker, workPacketKind];
workQ _ CreatePacket[workQ, worker, workPacketKind];
CreateWorker[worker, 1000, workQ, waitingWithPacket];

workQ _ CreatePacket[noWork, deviceA, devicePacketKind];
workQ _ CreatePacket[workQ, deviceA, devicePacketKind];
workQ _ CreatePacket[workQ, deviceA, devicePacketKind];
CreateHandler[handlerA, 2000, workQ, waitingWithPacket];

workQ _ CreatePacket[noWork, deviceB, devicePacketKind];
workQ _ CreatePacket[workQ, deviceB, devicePacketKind];
workQ _ CreatePacket[workQ, deviceB, devicePacketKind];
CreateHandler[handlerB, 2000, workQ, waitingWithPacket];

CreateDevice[deviceA, 4000, noWork, waiting];
CreateDevice[deviceB, 5000, noWork, waiting];

Schedule[];
IF queuePacketCount # 23246 THEN ERROR Bogus;
IF holdCount # 9297 THEN ERROR Bogus;
IF allocObjects # 20 THEN ERROR Bogus;
IF allocWords # 140 THEN ERROR Bogus;
time _ BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - pulses];
};

Bogus: ERROR = CODE;


Alloc: PROC [z: UNCOUNTED ZONE, words: CARDINAL] RETURNS [LONG POINTER] = {
index: CARDINAL _ allocWords;
allocObjects _ allocObjects + 1;
allocWords _ allocWords + words;
RETURN [@allocBase[index]];
};

allocObjects: CARDINAL _ 0;
allocWords: CARDINAL _ 0;
AllocRef: TYPE = REF AllocBlock;
AllocBlock: TYPE = RECORD [rest: SEQUENCE words: NAT OF CARDINAL];
allocBase: AllocRef _ NEW[AllocBlock[256]];

allocPtr: PROC ANY RETURNS ANY _ Alloc;

allocPtrPtr: LONG POINTER _ LOOPHOLE[LONG[@allocPtr]];

z _ LOOPHOLE[LONG[@allocPtrPtr]];

}...  

,Richards.mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
Martin Richards' benchmark program transcribed from BCPL
via Modula version by Peter Robinson of Fri May 20 14:55:00 1983
modified for Dragon comparison by Russ Atkinson, July 19, 1984 11:29:27 pm PDT 
Pradeep Sindhu October 22, 1985 3:18:22 pm PDT

TaskNames
Scheduler    
Idle
Devices
Handle
Working



The following procedure is used to implement the uncounted zone.  We are quite sneaky here, but it does not really matter.
Yucchhhh!!!  This is necessary but disgusting!
Κ=˜š
œ
™
Jšœ
Οm
œ1™<Jš
œ8™8Jš
œ@™@J™OIcode™.—J˜š
Οk	˜	J˜
Jšœžœžœžœ˜%J˜—šœ	žœ
˜š
ž˜Jš
œ˜—J˜Jšœž	œ
žœΟc$˜;J™š
œ	™	šœžœžœ
ž	˜&J˜9J˜——š
œ
™
Jš	œžœžœ
žœ
žœ˜.šœžœžœ˜!Jš
œ˜J˜J˜J˜J˜J˜Jšœž
œ˜J˜—Jšœžœžœ
˜J˜š	œžœžœ+žœžœ˜QJ˜Jšœ#žœ˜)Jšœ-žœžœ˜H—J˜š
Οn
œžœžœžœžœ˜SJ˜—Jšœžœ
˜J˜Jš	œžœžœ
žœ
žœ	˜*šœžœžœ˜J˜J˜J˜Jšœž	œ
˜šœžœžœ
žœ˜3J˜——Jšœžœ&˜6Jšœžœ˜J˜Jšœžœ
˜J˜Jšœžœ
˜Jšœžœ
˜J˜Jšœžœžœ˜&J˜J˜J˜"J˜š 
œžœ˜J˜!Jš
œ˜Jšœžœ	˜J˜Jš
œ˜J˜—š 
œžœ
˜Jšœ
žœ˜ž
šœžœ˜$J˜J˜J˜J˜J˜J˜J˜—J˜
J˜Jš
œ˜J˜—š œžœ
˜J˜;Jšžœ˜"šœžœ˜Jš
œ˜J˜J˜J˜
Jšœžœ˜—Jšžœ
˜Jš
œ˜J˜—š œžœžœ˜>J˜$Jšžœžœ
žœ
˜#J˜&J˜J˜&šžœ˜šžœ˜J˜Jšœžœ
˜Jšžœ#žœ
žœ˜4Jš
œ
˜
—š
ž˜J˜——Jšžœ˜Jš
œ˜J˜—š
 œžœžœ
žœ
žœ˜EJ˜Jšžœžœžœ˜0šžœ&žœž˜EJš
ž˜Jšžœ˜Jšžœ
˜—Jš
œ˜J˜—š œžœ˜J˜J˜J˜šžœž˜J˜šžœžœ˜?Jšžœ˜#šžœ˜šžœ&žœ˜/J˜J˜!šžœ˜Jšžœ˜ Jšžœ%žœ
˜.—Jš
œ˜—J˜+J˜@Jš
œ˜——Jšžœ
˜—Jš
œ˜J˜—š œžœžœ˜&Jšœ žœ
˜%Jšžœ˜Jš
œ˜J˜—š œžœžœ˜*J˜Jšœ žœ
˜%Jšžœ˜Jš
œ˜J˜—š œžœžœ˜?J˜Jšžœžœ
žœ
˜#Jšœžœ
˜šžœ#˜%Jšžœ
žœ˜Jšžœ
žœ˜—Jš
œ˜J˜—š œžœžœ˜@J˜Jšžœžœ
žœ
˜Jšžœ˜Jš
œ˜J˜——š
œ™J˜Jšœžœ˜J˜Jš	œžœžœžœ	žœ˜CJš	œžœžœ
žœ
žœ˜8Jšœžœ˜J˜š œž˜Jš
œW˜WJšœžœ/˜IJ˜@Jš
œ˜J˜—š
œ˜J˜J˜Jšžœžœ
žœ˜+šžœžœ˜,šžœ˜Jš
œ˜Jšžœ˜Jš
œ
˜
—šžœ˜Jšœžœ˜?Jšžœ˜Jš
œ˜——Jš
œ˜J˜——š
œ™J˜Jšœžœžœ˜9Jš	œžœžœ
žœ
žœ˜<J˜š œž˜Jš
œW˜WJšœžœ"˜>J˜BJš
œ˜J˜—š
œ!˜!J˜šžœ˜šžœ˜Jšžœžœ
žœ
˜.J˜J˜Jšžœ˜Jš
œ
˜
—šžœ˜J˜Jšžœ
˜Jš
œ˜——Jš
œ˜—J˜—š
œ™J˜Jšœžœžœ˜CJš	œžœžœ
žœ
žœ˜>J˜š 
œž˜Jš
œW˜WJšœžœ+˜HJ˜CJš
œ˜J˜—š
œ"˜"J˜J˜$Jšœžœ
˜šžœž˜šžœ˜Jšžœ˜Jšžœ˜"——šžœžœ˜J˜J˜šžœžœ˜"Jš
œ˜Jšžœ˜!Jš
œ˜—šžœžœ˜ J˜J˜#J˜,J˜Jšžœ˜"Jš
œ˜—Jš
œ˜—Jšžœ
˜Jš
œ˜J˜——š
œ™J˜Jšœžœžœ$žœ˜QJš	œžœžœ
žœ
žœ˜<J˜š œž˜Jš
œW˜WJšœžœ'˜CJ˜@Jš
œ˜J˜—š
œ˜J˜šžœ˜Jšžœ
žœ	˜šžœ˜˜Jšœ
žœžœ
žœ˜=—J˜!J˜šžœžœ
žœž˜+J˜Jšžœžœ˜'J˜$Jšžœ
˜—Jšžœ˜Jš
œ˜——Jš
œ˜J˜——š œžœ
žœžœ˜*J˜J˜J˜6J˜J˜J˜J˜'J˜J˜5J˜4J˜5J˜J˜8J˜7J˜7J˜8J˜J˜8J˜7J˜7J˜8J˜J˜-J˜-J˜J˜J™Jšžœžœ
žœ˜-Jšžœžœ
žœ˜%Jšžœžœ
žœ˜&Jšžœžœ
žœ˜%J™Jš
œF˜FJ™Jš
œ˜J˜—šœžœžœ
˜J˜—š
œz™zJ˜—š œžœž	œ
žœ	žœžœžœ
žœ˜KJšœžœ˜Jš
œ ˜ Jš
œ ˜ Jšžœ˜J˜J˜—Jšœžœ˜Jšœžœ˜Jšœ
žœžœ˜ Jš
œžœžœžœžœ
žœ
žœ˜BJšœžœ˜+J˜Jš	œ
žœ
žœ
žœ
žœ	˜'J˜Jš	œ
žœ
žœžœ
žœ
˜6J˜šœžœ
žœ˜!Jš
œ.™.J˜—Jš
œ˜J˜——…—#0q