<> <> 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; <> 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]]; }; <> 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; <> 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 <> 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; }; <> 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[]; <> state.dest _ Frame.GetReturnLink[]; state.source _ PrincOps.NullLink; RETURN WITH state; END; END.