<> <> <> <> DIRECTORY Basics USING [BITSHIFT, bitsPerByte, bitsPerWord, bytesPerWord, DivMod, LongDiv, LongDivMod, LongMult, LongNumber, RawBytes], MesaRuntimeInit USING [], PrincOps USING [BBptr, BBTableSpace, ByteBltBlock, GlobalFrameHandle, NullLink, sBLTE, sBLTEC, sBLTECL, sBLTEL, sBoundsFault, sBYTBLTE, sBYTBLTEC, sBYTBLTECL, sBYTBLTEL, SD, sLongDiv, sLongDivMod, sLongMod, sLongMul, sLongStringCheck, sPointerFault, sSignedDiv, sStringInit, StateVector, sULongDiv, sULongDivMod, sULongMod, zKFCB], PrincOpsUtils USING [AlignedBBTable, BITBLT, Codebase, GetReturnFrame, GetReturnLink, LongCopy]; InstructionsImpl: PROGRAM IMPORTS Basics, PrincOpsUtils EXPORTS MesaRuntimeInit, PrincOpsUtils = BEGIN <> BlockEqual: PROC [p1: POINTER, n: CARDINAL, p2: POINTER] RETURNS [BOOL] = { <> FOR i: CARDINAL IN [0 .. n) DO IF (p1+i)^ ~= (p2+i)^ THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE] }; BlockEqualCodeLong: PROC [p1: LONG POINTER, n, offset: CARDINAL] RETURNS [BOOL] = { <> p2: LONG POINTER = PrincOpsUtils.Codebase[PrincOpsUtils.GetReturnFrame[].accesslink]+offset; FOR i: CARDINAL IN [0 .. n) DO IF (p1+i)^ ~= (p2+i)^ THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE] }; BlockEqualCode: PROC [p1: POINTER, n, offset: CARDINAL] RETURNS [BOOL] = { <> p2: LONG POINTER = PrincOpsUtils.Codebase[PrincOpsUtils.GetReturnFrame[].accesslink]+offset; FOR i: CARDINAL IN [0 .. n) DO IF (p1+i)^ ~= (p2+i)^ THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE] }; BlockEqualLong: PROC [p1: LONG POINTER, n: CARDINAL, p2: LONG POINTER] RETURNS [BOOL] = { <> FOR i: CARDINAL IN [0 .. n) DO IF (p1+i)^ ~= (p2+i)^ THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE] }; ByteBlockEqual: PROC [p1: PPA, n: CARDINAL, p2: PPA] RETURNS [BOOL] = { <> RETURN[BlockEqual[p1: p1, p2: p2, n: n/2] AND p1[n-1] = p2[n-1]]; }; ByteBlockEqualCode: PROC [p1: POINTER, n, offset: CARDINAL] RETURNS [BOOL] = { <> codebase: LONG POINTER = PrincOpsUtils.Codebase[PrincOpsUtils.GetReturnFrame[].accesslink]; RETURN[ByteBlockEqualLong[p2: codebase+offset, p1: p1, n: n]] }; ByteBlockEqualCodeLong: PROC [p1: LONG POINTER, n, offset: CARDINAL] RETURNS [result: BOOL] = { <> codebase: LONG POINTER = PrincOpsUtils.Codebase[PrincOpsUtils.GetReturnFrame[].accesslink]; RETURN[ByteBlockEqualLong[p2: codebase+offset, p1: p1, n: n]] }; PPA: TYPE = POINTER TO Basics.RawBytes; LPPA: TYPE = LONG POINTER TO Basics.RawBytes; ByteBlockEqualLong: PROC [p1: LPPA, n: CARDINAL, p2: LPPA] RETURNS [BOOL] = { <> RETURN[BlockEqualLong[p1: p1, p2: p2, n: n/2] AND p1[n-1]=p2[n-1]]}; <> ByteBlt: PUBLIC PROC [to, from: PrincOps.ByteBltBlock] RETURNS [nBytes: CARDINAL] = { <> toBytes, fromBytes: LPPA; moved: CARDINAL _ 0; <> IF to.startIndex>to.stopIndexPlusOne OR from.startIndex>from.stopIndexPlusOne THEN ERROR; IF (nBytes _ MIN[to.stopIndexPlusOne-to.startIndex,from.stopIndexPlusOne-from.startIndex]) = 0 THEN RETURN; toBytes _ to.blockPointer; fromBytes _ from.blockPointer; <> IF to.startIndex MOD 2 ~= 0 THEN { toBytes[to.startIndex] _ fromBytes[from.startIndex]; moved _ 1; to.startIndex _ to.startIndex+1; from.startIndex _ from.startIndex+1; }; IF from.startIndex MOD 2 = 0 THEN { <> words: CARDINAL = (nBytes-moved)/2; PrincOpsUtils.LongCopy[ to: toBytes+to.startIndex/2, from: fromBytes+from.startIndex/2, nwords: words]; IF moved+2*words ~= nBytes THEN <> toBytes[to.startIndex+2*words] _ fromBytes[from.startIndex+2*words]; } <> ELSE { <> bba: PrincOps.BBTableSpace; bbt: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@bba]; lineWidth: CARDINAL = 16; -- words per scan line: controls interrupt latency bitsPerLine: CARDINAL = lineWidth*Basics.bitsPerWord; bytesPerLine: CARDINAL =lineWidth*Basics.bytesPerWord; lines: CARDINAL = (nBytes-moved)/bytesPerLine; -- bytes left to move with first BitBlt tail: CARDINAL = (nBytes-moved) MOD bytesPerLine; -- bytes left to move with second BitBlt bbt^ _ [ dst: [word: toBytes+to.startIndex/2, bit: 0], dstBpl: bitsPerLine, src: [word: fromBytes+from.startIndex/2, bit: 8], srcDesc: [srcBpl[bitsPerLine]], width: bitsPerLine, height: lines, flags: [direction: forward, disjoint: TRUE, disjointItems: TRUE, gray: FALSE, srcFunc: null, dstFunc: null]]; <> IF lines ~= 0 THEN PrincOpsUtils.BITBLT[bbt]; <> bbt.dst.word _ bbt.dst.word + lines*lineWidth; bbt.src.word _ bbt.src.word + lines*lineWidth; bbt.width _ Basics.bitsPerByte*tail; bbt.height _ 1; IF tail ~= 0 THEN PrincOpsUtils.BITBLT[bbt]; }; }; <> StringInit: PROC [coffset, n: CARDINAL, reloc, dest: POINTER] = { g: PrincOps.GlobalFrameHandle = PrincOpsUtils.GetReturnFrame[].accesslink; codebase: LONG POINTER = PrincOpsUtils.Codebase[g] + coffset; FOR i: CARDINAL IN [0..n) DO (dest+i)^ _ (codebase+i)^ + reloc; ENDLOOP; }; <> Number: TYPE = Basics.LongNumber; DivMod: PROC [n, d: CARDINAL] RETURNS [QR] = LOOPHOLE[Basics.DivMod]; QR: TYPE = RECORD [q, r: INTEGER]; PQR: TYPE = POINTER TO QR; SignDivide: PROC = { state: PrincOps.StateVector; qr: QR; p: PQR; t: CARDINAL; negnum, negden: BOOL; state _ STATE; state.stkptr _ t _ state.stkptr-1; state.dest _ PrincOpsUtils.GetReturnLink[]; state.source _ PrincOps.NullLink; p _ LOOPHOLE[@state.stk[t-1]]; qr _ p^; IF negden _ (qr.r < 0) THEN qr.r _ -qr.r; IF negnum _ (qr.q < 0) THEN qr.q _ -qr.q; qr _ DivMod[n: qr.q, d: qr.r]; IF negnum ~= negden THEN qr.q _ -qr.q; IF negnum THEN qr.r _ -qr.r; p^ _ qr; RETURN WITH state; }; DDivMod: PROC [num, den: Number] RETURNS [quotient, remainder: Number] = { negNum, negDen: BOOL _ FALSE; IF LOOPHOLE[num.highbits, INTEGER] < 0 THEN {negNum _ TRUE; num.li _ -num.li}; IF LOOPHOLE[den.highbits, INTEGER] < 0 THEN {negDen _ TRUE; den.li _ -den.li}; [quotient: quotient, remainder: remainder] _ DUnsignedDivMod[num: num, den: den]; IF negNum ~= negDen THEN quotient.li _ -quotient.li; IF negNum THEN remainder.li _ -remainder.li; }; DDiv: PROC [a, b: Number] RETURNS [Number] = { RETURN[DDivMod[a, b].quotient]}; DMod: PROC [a, b: Number] RETURNS [Number] = { RETURN[DDivMod[a, b].remainder]}; DMultiply: PROC [a, b: Number] RETURNS [product: Number] = { product.lc _ Basics.LongMult[a.lowbits, b.lowbits]; product.highbits _ product.highbits + a.lowbits*b.highbits + a.highbits*b.lowbits; }; DUnsignedDivMod: PROC [num, den: Number] RETURNS [quotient, remainder: Number] = { qq: CARDINAL; count: [0..31); lTemp: Number; IF den.highbits = 0 THEN { [quotient.highbits, qq] _ Basics.LongDivMod[ LOOPHOLE[Number[num[lowbits: num.highbits, highbits: 0]]], den.lowbits]; [quotient.lowbits, remainder.lowbits] _ Basics.LongDivMod[ LOOPHOLE[Number[num[lowbits: num.lowbits, highbits: qq]]], den.lowbits]; remainder.highbits _ 0; } ELSE { count _ 0; quotient.highbits _ 0; lTemp _ den; WHILE lTemp.highbits ~= 0 DO -- normalize lTemp.lowbits _ Basics.BITSHIFT[lTemp.lowbits, -1] + Basics.BITSHIFT[lTemp.highbits, 15]; lTemp.highbits _ Basics.BITSHIFT[lTemp.highbits, -1]; count _ count + 1; ENDLOOP; IF num.highbits >= lTemp.lowbits THEN { <> div: Number = Number[num[lowbits: 0, highbits: lTemp.lowbits]]; qq _ Basics.LongDiv[num.lc-div.lc, lTemp.lowbits]/2 + 100000B; count _ count - 1; } ELSE qq _ Basics.LongDiv[num.lc, lTemp.lowbits]; -- trial quotient qq _ Basics.BITSHIFT[qq, -count]; lTemp.lc _ Basics.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; }; }; DUnsignedDiv: PROC [a, b: Number] RETURNS [Number] = { RETURN[DUnsignedDivMod[a, b].quotient]}; DUnsignedMod: PROC [a, b: Number] RETURNS [Number] = { RETURN[DUnsignedDivMod[a, b].remainder]}; <> LongStringCheck: PROC = { state: PrincOps.StateVector; tos, index: CARDINAL; p: POINTER TO LONG STRING; BoundsFault: PROC = MACHINE CODE {PrincOps.zKFCB, PrincOps.sBoundsFault}; PointerFault: PROC = MACHINE CODE {PrincOps.zKFCB, PrincOps.sPointerFault}; state _ STATE; tos _ state.stkptr; index _ state.stk[tos]; p _ LOOPHOLE[@state.stk[tos-2]]; IF p^ = NIL THEN PointerFault[]; IF index >= p^.maxlength THEN BoundsFault[]; state.dest _ PrincOpsUtils.GetReturnLink[]; state.source _ PrincOps.NullLink; RETURN WITH state; }; <<>> <> <<>> Initialize: PROC = { pSD: POINTER TO ARRAY NAT OF PROC ANY RETURNS ANY _ LOOPHOLE[PrincOps.SD]; pSD[PrincOps.sBLTE] _ BlockEqual; pSD[PrincOps.sBYTBLTE] _ ByteBlockEqual; pSD[PrincOps.sBLTEC] _ BlockEqualCode; pSD[PrincOps.sBYTBLTEC] _ ByteBlockEqualCode; pSD[PrincOps.sBLTECL] _ BlockEqualCodeLong; pSD[PrincOps.sBYTBLTECL] _ ByteBlockEqualCodeLong; pSD[PrincOps.sBLTEL] _ BlockEqualLong; pSD[PrincOps.sBYTBLTEL] _ ByteBlockEqualLong; pSD[PrincOps.sLongDiv] _ DDiv; pSD[PrincOps.sLongDivMod] _ DDivMod; pSD[PrincOps.sLongMod] _ DMod; pSD[PrincOps.sLongMul] _ DMultiply; pSD[PrincOps.sLongStringCheck] _ LongStringCheck; pSD[PrincOps.sULongDivMod] _ DUnsignedDivMod; pSD[PrincOps.sULongMod] _ DUnsignedMod; pSD[PrincOps.sULongDiv] _ DUnsignedDiv; pSD[PrincOps.sSignedDiv] _ SignDivide; pSD[PrincOps.sStringInit] _ StringInit; }; Initialize[]; END.