-- MesaRuntime>Instructions.mesa (February 4, 1981 by Knutsen)

DIRECTORY
Environment USING [Byte],
Frame USING [GetReturnFrame, GetReturnLink],
Inline USING [
BITSHIFT, BITXOR, DIVMOD, LDIVMOD, LongNumber,
LongDiv, LongDivMod, LongMult],
Mopcodes USING [zKFCB],
PrincOps USING [GlobalFrameHandle, NullLink, StateVector],
ProcessInternal USING [],
RuntimeInternal USING [Codebase],
RuntimePrograms USING [],
SDDefs: FROM "SDDefs" USING [
sBLTE, sBLTEC, sBLTECL, sBLTEL, sBoundsFault, sBYTBLTE,
sBYTBLTEC, sBYTBLTECL, sBYTBLTEL, SD, sLongDiv, sLongDivMod,
sLongMod, sLongMul, sLongStringCheck, sPointerFault, sSignedDiv,
sStringInit, sULongDiv, sULongDivMod, sULongMod];

Instructions: PROGRAM
IMPORTS Frame, Inline, RuntimeInternal EXPORTS RuntimePrograms =
BEGIN

--RuntimePrograms.--InitializeInstructions: PUBLIC PROCEDURE [] =
BEGIN OPEN SDDefs;
pSD: POINTER TO ARRAY [0..0) OF UNSPECIFIED ← SD;
pSD[sBLTE] ← BlockEqual;
pSD[sBYTBLTE] ← ByteBlockEqual;
pSD[sBLTEC] ← BlockEqualCode;
pSD[sBYTBLTEC] ← ByteBlockEqualCode;
pSD[sBLTECL] ← BlockEqualCodeLong;
pSD[sBYTBLTECL] ← ByteBlockEqualCodeLong;
pSD[sBLTEL] ← BlockEqualLong;
pSD[sBYTBLTEL] ← ByteBlockEqualLong;
pSD[sLongDiv] ← DDiv;
pSD[sLongDivMod] ← DDivMod;
pSD[sLongMod] ← DMod;
pSD[sLongMul] ← DMultiply;
pSD[sLongStringCheck] ← LongStringCheck;
pSD[sULongDivMod] ← DUnsignedDivMod;
pSD[sULongMod] ← DUnsignedMod;
pSD[sULongDiv] ← DUnsignedDiv;
pSD[sSignedDiv] ← SignDivide;
pSD[sStringInit] ← StringInit;
END;

-- Unimplemented instructions:

BlockEqual: PROCEDURE [p1: POINTER, n: CARDINAL, p2: POINTER]
RETURNS [BOOLEAN] = -- BLTE
BEGIN
i: CARDINAL;
FOR i IN [0 .. n) DO
IF (p1+i)↑ # (p2+i)↑ THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]
END;

BlockEqualCodeLong: PROCEDURE [p1: LONG POINTER, n, offset: CARDINAL]
RETURNS [BOOLEAN] = -- BLTECL
BEGIN
p2: LONG POINTER = RuntimeInternal.Codebase[
LOOPHOLE[Frame.GetReturnFrame[].accesslink, PROGRAM]]+offset;
i: CARDINAL;
FOR i IN [0 .. n) DO
IF (p1+i)↑ # (p2+i)↑ THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]
END;

BlockEqualCode: PROCEDURE [p1: POINTER, n, offset: CARDINAL]
RETURNS [BOOLEAN] = -- BLTEC
BEGIN
p2: LONG POINTER = RuntimeInternal.Codebase[
LOOPHOLE[Frame.GetReturnFrame[].accesslink, PROGRAM]]+offset;
i: CARDINAL;
FOR i IN [0 .. n) DO
IF (p1+i)↑ # (p2+i)↑ THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]
END;

BlockEqualLong: PROCEDURE [p1: LONG POINTER, n: CARDINAL, p2: LONG POINTER]
RETURNS [BOOLEAN] = -- BLTEL
BEGIN
i: CARDINAL;
FOR i IN [0 .. n) DO
IF (p1+i)↑ # (p2+i)↑ THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE]
END;

ByteBlockEqual: PROCEDURE [p1: PPA, n: CARDINAL, p2: PPA]
RETURNS [BOOLEAN] = -- BYTBLTE
{ RETURN[BlockEqual[p1: p1, p2: p2, n: n/2] AND p1[n-1] = p2[n-1]]; };

ByteBlockEqualCode: PROCEDURE [p1: POINTER, n, offset: CARDINAL]
RETURNS [BOOLEAN] = -- BYTBLTEC
BEGIN
codebase: LONG POINTER = RuntimeInternal.Codebase[
LOOPHOLE[Frame.GetReturnFrame[].accesslink, PROGRAM]];
RETURN[ByteBlockEqualLong[p2: codebase+offset, p1: p1, n: n]]
END;

ByteBlockEqualCodeLong: PROCEDURE [p1: LONG POINTER, n, offset: CARDINAL]
RETURNS [result: BOOLEAN] = -- BYTBLTECL
BEGIN
codebase: LONG POINTER = RuntimeInternal.Codebase[
LOOPHOLE[Frame.GetReturnFrame[].accesslink, PROGRAM]];
RETURN[ByteBlockEqualLong[p2: codebase+offset, p1: p1, n: n]]
END;

PPA: TYPE = POINTER TO PACKED ARRAY [0..0) OF Environment.Byte;

ByteBlockEqualLong: PROC [p1: LONG PPA, n: CARDINAL, p2: LONG PPA]
RETURNS [BOOLEAN] = -- BYTBLTEL
{ RETURN[BlockEqualLong[p1: p1, p2: p2, n: n/2] AND p1[n-1]=p2[n-1]]; };


-- Data shuffling

StringInit: PROCEDURE [coffset, n: CARDINAL, reloc, dest: POINTER] =
BEGIN
g: PrincOps.GlobalFrameHandle = Frame.GetReturnFrame[].accesslink;
i: CARDINAL;
codebase: LONG POINTER = RuntimeInternal.Codebase[
LOOPHOLE[g, PROGRAM]] + coffset;
FOR i IN [0..n) DO (dest+i)↑ ← (codebase+i)↑ + reloc; ENDLOOP;
RETURN
END;

-- Long, signed and mixed mode arithmetic:

Number: TYPE = Inline.LongNumber;
DIVMOD: PROCEDURE [n,d: CARDINAL] RETURNS [QR] =
LOOPHOLE[Inline.DIVMOD];
LDIVMOD: PROCEDURE [nlow,nhigh,d: CARDINAL] RETURNS [QR] =
LOOPHOLE[Inline.LDIVMOD];
QR: TYPE = RECORD [q, r: INTEGER];
PQR: TYPE = POINTER TO QR;

SignDivide: PROCEDURE =
BEGIN
state: PrincOps.StateVector;
p: PQR;
t: CARDINAL;
negnum,negden: BOOLEAN;
state ← STATE;
state.stkptr ← t ← state.stkptr-1;
state.dest ← Frame.GetReturnLink[];
state.source ← PrincOps.NullLink;
p ← @state.stk[t-1];
IF negden ← (p.r < 0) THEN p.r ← -p.r;
IF negnum ← (p.q < 0) THEN p.q ← -p.q;
p↑ ← DIVMOD[n: p.q, d: p.r];
IF Inline.BITXOR[negnum,negden] # 0 THEN p.q ← -p.q;
IF negnum THEN p.r ← -p.r;
RETURN WITH state;
END;

DDivMod: PROCEDURE [
num, den: Number] RETURNS [quotient, remainder: Number] =
BEGIN
negNum, negDen: BOOLEAN ← FALSE;
IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN
BEGIN negNum ← TRUE; num.li ← -num.li; END;
IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN
BEGIN negDen ← TRUE; den.li ← -den.li; END;
[quotient: quotient, remainder: remainder] ←
DUnsignedDivMod[num: num, den: den];
IF Inline.BITXOR[negNum,negDen] # 0 THEN
quotient.li ← -quotient.li;
IF negNum THEN remainder.li ← -remainder.li;
RETURN
END;

DDiv: PROC [a,b: Number] RETURNS [Number] =
{ RETURN[DDivMod[a,b].quotient]; };

DMod: PROCEDURE [a,b: Number] RETURNS [r: Number] =
{ [remainder: r] ← DDivMod[a,b]; RETURN; };

DMultiply: PROCEDURE [a,b: Number] RETURNS [product: Number] =
BEGIN
product.lc ← Inline.LongMult[a.lowbits, b.lowbits];
product.highbits ←
product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits;
RETURN
END;

DUnsignedDivMod: PROCEDURE [
num, den: Number] RETURNS [quotient, remainder: Number] =
BEGIN OPEN Inline;
qq: CARDINAL;
count: [0..31);
lTemp: Number;
IF den.highbits = 0 THEN
BEGIN
[quotient.highbits, qq] ← LongDivMod[
LOOPHOLE[Number[num[lowbits:num.highbits, highbits:0]]],
den.lowbits];
[quotient.lowbits, remainder.lowbits] ← LongDivMod[
LOOPHOLE[Number[num[lowbits:num.lowbits, highbits:qq]]],
den.lowbits];
remainder.highbits ← 0;
END
ELSE
BEGIN
count ← 0;
quotient.highbits ← 0;
lTemp ← den;
WHILE lTemp.highbits # 0 DO -- normalize
lTemp.lowbits ←
BITSHIFT[lTemp.lowbits,-1] + BITSHIFT[lTemp.highbits,15];
lTemp.highbits ← BITSHIFT[lTemp.highbits,-1];
count ← count + 1;
ENDLOOP;
IF num.highbits >= lTemp.lowbits THEN
BEGIN -- subtract off 2↑16*divisor and fix up count
div: Number ← Number[num[lowbits: 0, highbits: lTemp.lowbits]];
qq ← LongDiv[num.lc-div.lc,lTemp.lowbits]/2 + 100000B;
count ← count - 1;
END
ELSE qq ← LongDiv[num.lc, lTemp.lowbits]; -- trial quotient
qq ← BITSHIFT[qq, -count];
lTemp.lc ← LongMult[den.lowbits, qq]; -- multiply by trial quotient
lTemp.highbits ← lTemp.highbits + den.highbits*qq;
UNTIL lTemp.lc <= num.lc DO
-- decrease quotient until product is small enough
lTemp.lc ← lTemp.lc - den.lc;
qq ← qq - 1;
ENDLOOP;
quotient.lowbits ← qq;
remainder.lc ← num.lc - lTemp.lc;
END;
RETURN
END;

DUnsignedDiv: PROCEDURE [a,b: Number] RETURNS [Number] =
{ RETURN[DUnsignedDivMod[a,b].quotient]; };

DUnsignedMod: PROCEDURE [a,b: Number] RETURNS [r: Number] =
{ [remainder: r] ← DUnsignedDivMod[a,b]; RETURN; };

-- Other

LongStringCheck: PROCEDURE =
BEGIN
state: PrincOps.StateVector;
tos, index: CARDINAL;
p: POINTER TO LONG STRING;
BoundsFault: PROCEDURE =
MACHINE CODE BEGIN Mopcodes.zKFCB, SDDefs.sBoundsFault END;
PointerFault: PROCEDURE =
MACHINE CODE BEGIN Mopcodes.zKFCB, SDDefs.sPointerFault END;
state ← STATE;
tos ← state.stkptr;
index ← state.stk[tos];
p ← @state.stk[tos-2];
IF p↑ = NIL THEN PointerFault[];
IF index >= p↑.maxlength THEN BoundsFault[];
-- This statement is new for the dandelion. It should be compatible with the Dolphin’s pre-princops stuff (he says, crossing fingers)
state.dest ← Frame.GetReturnLink[];
state.source ← PrincOps.NullLink;
RETURN WITH state;
END;

END.

LOG

July 20, 1978 9:04 AM Sandman Bug in StringInit.

August 7, 1978 8:51 AM Sandman Got Codebase from RuntimeInternal instead of CodebaseDefs.

March 14, 1979 11:27 AM McJones Mesa 5.

July 11, 1979 1:33 PM Jose ???

October 3, 1979 3:43 PM McJones Bug in DUnsignedDivMod.

December 5, 1979 8:20 AM Sandman AR 3056 BlockEqual speedup.

May 3, 1980 12:28 PM Forrest Mesa 6.

January 15, 1981 4:03 PM Knutsen InitializeInstructions[].

February 4, 1981 11:49 AM Knutsen PrincOps fields changed names.