**Dorado Smalltalk Microcode -- Model 1, XM version
** last edited July 9, 1979 10:08 AM by Deutsch


** Code for handling ordinary messages


Title[DsmallMsgs.MC];

Top Level;

KnowRBase[State];


* Handle non-trapped cases of trapped msgs

I.Apply10:
T ← (Id) + (24c), Branch[.ApplyId];* 10 + addr of "+" atom
I.Apply26:
T ← (Id) + (42c), Branch[.ApplyId];* 26 + addr of "+" atom
.ApplyId:
Fetch ← StackP;
Top ← Md, MemBase ← AemMemBase, Branch[FetchMsg];

Apply:
RBase ← RBase[SavSp];
T ← SavSp, RBase ← RBase[State];
StackP ← T, MemBase ← TFrameBr;
Fetch ← StackP;*Recover top of stack
Top ← Md, RBase ← RBase[AemRegs];
T ← Ireg, RBase ← RBase[State];*recover trapped opcode #
T ← T - (244c);* -244 = addr of "+" atom - first trapped opcode (260)
MemBase ← AemMemBase;
Fetch ← T;
Name ← Md, Branch[SndMsg];*don’t go through FetchMsg -- leave Ireg unchanged

*Litmsgs----Non-Trapped messages

IFU2[214,LocFrameBr,I.XLitMsg,17];* want Id=alpha, so no N
MIFU[320,17,IFU1[==,LocFrameBr,I.FetchMsg,=]];
MIFU[337,17,IFU1[==,LocFrameBr,I.FetchMsg17,=]];
MIFU[356,17,IFU1[==,LocFrameBr,I.FetchMsg36,=]];
MIFU[375,3,IFU1[==,LocFrameBr,I.FetchMsg55,=]];

I.FetchMsg17:
T ← (Id) + (17c), Branch[FetchMsg];
I.FetchMsg36:
T ← (Id) + (36c), Branch[FetchMsg];
I.FetchMsg55:
T ← (Id) + (55c), Branch[FetchMsg];

I.XLitMsg:
I.FetchMsg:
Fetch ← Id, Branch[.FetchMsg1];

FetchMsg:*enter here with T+MemBase = addr of message, and correct BR
Fetch ← T;
.FetchMsg1:
Name ← Md;
Ireg ← T - T - 1;*flag as literal msg for Dispatch

SndMsg:
Call[GTopCls];*T ← class of top of stack
SupMod ← T, Call[HashL];*Hash class of target--no dirty
MyTemp ← T + (MDictF.c);
MemBase ← AemMemBase;*Relative to zero
Fetch ← MyTemp;
PD ← Md + 1;
BOop ← Md, DblBranch[.Nid1, .DictOk, Alu=0];*Null MDict fails

.DictOk:
T ← Md;*placement
Call[HashL];*Hash MDict of target, no dirty (arg. in T)
MemBase ← AemMemBase;
Fetch ← T;
MemBase ← BCoreBr;
BrLo ← T;
BCoreBase ← T, T ← Md;*Referencing BCore
Call[Ilong];
Temp2 ← T - 1, Call[Hash];*Temp2=Length-1//Hash left side of dictionary
MemBase ← NamesBr;
BrLo ← T, T ← Temp2;
Temp1 ← (Name) and T, Branch[.Nid2, Alu=0];*Zero MDict size fails//initial hash=name and len-1
Cnt ← 1s;*Count wraparounds

.DLoop:
Temp1 ← T ← (Fetch ← Temp1) + 1;
PD ← (Md) + 1;
PD ← (Md) - (Name), Branch[.Nid3, Alu=0];*empty entry?
PD ← (Temp2) - T, Branch[.GotIt, Alu=0];*match?
Branch[.DLoop, Alu>=0];*no wraparound?
Temp1 ← T - T, Branch[.Nid4, Cnt=0&-1];*second wrap?
Branch[.DLoop];

.GotIt:
Temp1 ← (Temp1) - 1, MemBase ← BCoreBr;*back up index by 1
Fetch ← 1s, Call[HashMd];*found name---get value
T ← (Temp1) + (T), MemBase ← AemMemBase;*real core address (more or less)
Fetch ← T;

RProg:
Nop;
BOop ← Md, Call[HashMd];*BOop ← MDict[Literal Operator]
MemBase ← AemMemBase;
Fetch ← T;
MemBase ← BCoreBr;
BrLo ← T;
BCoreBase ← T;
Temp3 ← Md;
PD ← Temp3;
PD ← (Temp3) - 1, Branch[.Bytes, Alu=0];*No primitive
PD ← (Temp3) - (50c), Branch[.SelfPrim, Alu=0];*Primitive 1=NoOp=Branch[Byterp]
Branch[.InstFieldPrim, Alu=0];*Primitive 40=read inst field

* Do a primitive. Start by transferring the args into the fixed communication area

.DoPrim:
Fetch ← 1s;
Temp2 ← (StackP) - 1, T ← Md;
Temp1 ← T and (7c);
MyTemp ← Top;
T ← T - T - 1, MemBase ← AemMemBase;*Nil T for store of Self

.NcLoop:
T ← T + (SelfLoc.c) + 1;
Store ← T, DBuf ← MyTemp;*First time, store Self--then args
Temp1 ← T ← (Temp1) - 1, MemBase ← TFrameBr;
Temp2 ← (Fetch ← Temp2) - 1, Branch[.NcDone, Alu<0];
MyTemp ← Md, MemBase ← AemMemBase, Branch[.NcLoop];

.NcDone:
MemBase ← AemMemBase, T ← Md;*sink Md
MyTemp ← (PrimTabLoc.c);
Fetch ← MyTemp;
T ← (Temp3) + (Md);*Add primitive number to primitive table addr
Fetch ← T;
T ← Md, Branch[FetchTPc];

PrimRet:
T ← Arg1, MemBase ← BCoreBr;
Top ← B ← T, Fetch ← 1s;
T ← (7c);
T ← T and (Md);
T ← (StackP) - T, Branch[Stor];

PrimFail:
T ← BOop, Call[RefCkLInc];
Branch[.DoBytes];

.SelfPrim:
Branch[Byterp];

.InstFieldPrim:
Fetch ← 2s;
T ← Md, Arg1 ← Top;
Temp1 ← Rsh[T, 10], Call[Hash];*get field #
MemBase ← AemMemBase, T ← T + (Temp1);
Fetch ← T;
Arg1 ← Md, Call[RefCkInc];
Branch[PrimRet];

*Do a Smalltalk-coded method

.Bytes:
Call[RefLastInc];*Bump refct of method

.DoBytes:
Call[ACtxt];
AOop ← T;*T has oop of new arec
MemBase ← ACoreBr;*Temp1 has core address
T ← BrLo ← Temp1;
ACoreBase ← T;
Store ← SenderF.s, DBuf ← Ctxt;*New AR[Sender] ← retiring activation
Store ← InstF.s, DBuf ← Top;*New AR[Inst] ← top of old stack
MyTemp ← T - T - 1;*-1
Store ← ClassF.s, DBuf ← MyTemp;*New AR[Class] ← Nil
Store ← CodeF.s, DBuf ← BOop;*New AR[Code]← MDict[Literal Op]
MemBase ← BCoreBr;
Fetch ← 1s;*Address second word of code
T ← Md;
Temp4 ← Rsh[T, 10];*Temp4 ← TSize (Byte #2 of code)
Name ← T ← T and (377c);*Name ← NArgs (Byte #3 of code)
StackP ← (StackP) - (T) - 1;*Pop the object and its args
T ← Temp4, Call[AVec];*Allocate vector, Temp4 ← TSize (Uses FF)
MemBase ← ACoreBr;
Store ← TFrameF.s, DBuf ← Arg1;*New AR[Tempframe] ← that vector

*Loop to store args and nil stack and temp part of tframe
*RetN2 is the offset in Tframe which points at the last slot filled,
*starts out as size of tframe

T ← Name;
T ← (Temp4) - T;*T ← # of temps to nil
Cnt ← T;
MyTemp ← AllOnes.c;*prepare nil
T ← (Temp1) - 1, MemBase ← AemMemBase;*Since relative to zero
T ← (Temp4) + T, Branch[.NoTemps, Cnt=0&-1];*prepare pointer to slot in new tempframe

.PutLp:
T ← (Store ← T) - 1, DBuf ← MyTemp, Branch[.PutLp, Cnt#0&-1];*Address current element

.NoTemps:
T ← (StackP) + 1, RBase ← RBase[TFrameBase];*T ← Old StackP
T ← TFrameBase ← (TFrameBase) + T, RBase ← RBase[State];*addr of lowest arg on stack
MemBase ← TFrameBr;
BrLo ← T;
T ← Name;*T has offset Nargs
Temp1 ← (Temp1) + T;*Temp1 has absolute addr. of new stack
Store ← T, DBuf ← MyTemp, Branch[.NilTop];*Add. of sender in old stack

.StorIt:
Fetch ← T;*fetch next arg from old stack
Store ← T, DBuf ← MyTemp;*Nil arg on old stack (for refct)//doesn’t clobber Md!!
MemBase ← AemMemBase;
Store ← Temp1, DBuf ← Md;*store arg on new stack, absolute addressing

.NilTop:
MemBase ← TFrameBr, T ← (T) - 1;*Decrement
Temp1 ← (Temp1) - 1, DblBranch[.DoneIt, .StorIt, Alu<0];*Decrement absolute addr.

.DoneIt:
Nop;*In the next instruction, Temp1 is restored
Temp1 ← (Temp1) + 1, Call[StopIfu];
Call[Stash];*Puts pc and stackp in new arec
MemBase ← BCoreBr;
Fetch ← 2s;*Addressing third word
Q ← Md;
Ctxt ← AOop;
RBase ← RBase[ACoreBase];
T ← ACoreBase, RBase ← RBase[State];
MemBase ← ArecBr;
BrLo ← T;
ArecBase ← T;
MemBase ← TFrameBr;
T ← BrLo ← Temp1;*Storing into TFrame
TFrameBase ← T;
T ← Q;*T ← old Md
StackP ← Rsh[T, 10];*offset of 1st stack loc (byte #4)
StackP ← (StackP) - 1;
T ← T and (377c);*initial pcb (byte #5)
Pcb ← T;
RBase ← RBase[BCoreBase];
T ← BCoreBase, RBase ← RBase[State], Call[MapCode];*T ← Core address of code, from BCore
T ← MinAt;
PD ← (Top) - (T);
T ← Top, DblBranch[.NilSelf, .HashSelf, Carry];

.NilSelf:
T ← AllOnes.c, Branch[.LoadMe];*Get ready to nil self

.HashSelf:
Arg1 ← T, Call[Hash];*T ← core address of new self
Call[Dirty];

.LoadMe:
MemBase ← SelfBr;
BrLo ← T;
SelfBase ← T;
Branch[StartByterp];*Heigh Ho Silver, Away!
*"Who was that masked man?"


.Nid4:
Branch[.Nid1];
.Nid3:
Branch[.Nid1];
.Nid2:
Branch[.Nid1];
.Nid1:*Comes here from failure: Zero, Null MDict, NotInd
T ← SupMod, Call[HashL];*Hash current MClass, no dirty
MemBase ← AemMemBase;
MyTemp ← T + (SprClsF.c);
Fetch ← MyTemp;
T ← (Md) + 1;
SupMod ← Md, Branch[NoMsg, Alu=0];
* Dispatch on info saved in Ireg (260-277 or 300-304 for trapped msgs, -1 for litmsg)
RBase ← RBase[AemRegs];
T ← Ireg, RBase ← RBase[State], DblBranch[SndMsg, RedoTrappedMsg, R<0];


NoMsg:
T ← ErrPrg.c;*Remember, Emulator BR in control
Fetch ← T, Branch[RProg];