MimeImpl.mesa
Carl Hauser, May 7, 1987 3:14:42 pm PDT
DIRECTORY
Basics,
Convert USING [CardFromWholeNumberLiteral, RopeFromInt],
DragOpsCross,
DragOpsCrossUtils,
HandCoding,
HandCodingComforts,
HandCodingSupport,
IO,
Mime,
Rope USING [Cat, Equal, ROPE],
SymTab USING [Create, Fetch, Insert, Ref];
A very simple assembler for Dragon instructions. So far, I have just a single-instruction assembler-- see AssembleOneInstruction below. This may be enough for quite a while.
MimeImpl: CEDAR PROGRAM
IMPORTS Basics, Convert, DragOpsCrossUtils, HandCoding, HandCodingComforts, HandCodingSupport, IO, Rope, SymTab
EXPORTS Mime
~ BEGIN
STREAM: TYPE = IO.STREAM;
ROPE: TYPE = Rope.ROPE;
InstructionType: TYPE = {I, LC, LR, LB, LH, LW, LBD, RRR, QR, RD, XO, XRO};
InstructionName: TYPE = {
-- I -- ADD, SUB, IAND, IOR, EXDIS, DUP, DIS, BC, SFC, SFCI, KFC, RETN, LADD, LSUB, RX, JSD, JSR, J1, J2, J3, J5,
-- LC -- LC, -- LC is a macro, choosing the right instruction for the value to be loaded
-- LR -- LRn, SRn,
-- LB -- ADDB, SUBB, LIB, RB, RSB, LIP, WB, WSB, PSB, SIP, CST, AL, ALS, AS, ASL, JB, RET, RETK,
-- LH -- ADDDB, SUBDB, LIDB, LGF, IOD, ION, IODA, SHL, SHR, SHDL, SHDR, JDB, LFC, FSDB,
-- LW -- LIQB, ADDQB, SUBQB, JQB, DFC,
-- LBD -- JEBBj, JEBB, JNEBBj, JNEBB,
-- RRR -- RADD, RUADD, RVADD, RSUB, RUSUB, RVSUB, RAND, ROR, RXOR, RRX, RFU, RBC, RLADD, RLSUB,
-- QR -- QADD, QSUB, QAND, QOR, QRX, QBC, QLADD, QLSUB,
-- RD -- RJEBj, RJEB, RJNEBj, RJNEB, RJGBj, RJGB, RJGEBj, RJGEB, RJLBj, RJLB, RJLEB, RJLEBj,
-- XO -- LRIn, SRIn,
-- XRO -- RRI, RAI, WRI, WAI
};
OperandName: TYPE = {
AUX, LOCAL, CONSTANT,
Top, Under, PopUnder, Push, TopATop, PushATop, PushA0, PushA1,
Constant0, Constant1, PopTop,
YoungestStatus, YoungestPC, EldestStatus, EldestPC, SLimit
};
The assembler has a symbol table with one entry for each instruction mnemonic. The value associated with the symbol is a record describing the instruction.
Instruction: TYPE = RECORD[
instructionProc: InstructionProc, -- the procedure for parsing the instruction
instructionName: InstructionName, -- the name of the instruction from the enumerated type
rest: SELECT type: InstructionType FROM -- the procedure that will actually assemble the instruction after parsing
I => [IProc: HandCoding.OIformInst ← NIL],
LC => [LCProc: PROC [value: INT ← 0] ← NIL],
LR => [LRProc: HandCoding.LRformInst ← NIL],
LB => [LBProc: HandCoding.OBformInst ← NIL],
LH => [LHProc: HandCoding.ODBformInst ← NIL],
LW => [LWProc: HandCoding.OQBformInst ← NIL],
LBD => [LBDProc: HandCoding.JBBformInst ← NIL],
RRR => [RRRProc: HandCoding.RRformInst ← NIL],
QR => [QRProc: HandCoding.QRformInst ← NIL],
RD => [RDProc: HandCoding.RJBformInst ← NIL],
XO => [XOProc: HandCoding.LRBformInst ← NIL],
XRO => [XROProc: HandCoding.LRRBformInst ← NIL],
ENDCASE
];
IInstruction: TYPE = Instruction[I] ← [instructionProc: I, instructionName: ADD, rest: I[NIL]];
LRInstruction: TYPE = Instruction[LR] ← [instructionProc: LR, instructionName: LRn, rest: LR[NIL]];
LCInstruction: TYPE = Instruction[LC] ← [instructionProc: LC, instructionName: LC, rest: LC[NIL]];
LBInstruction: TYPE = Instruction[LB] ← [instructionProc: LB, instructionName: ADDB, rest: LB[NIL]];
LHInstruction: TYPE = Instruction[LH] ← [instructionProc: LH, instructionName: ADDDB, rest: LH[NIL]];
LWInstruction: TYPE = Instruction[LW] ← [instructionProc: LW, instructionName: LIQB, rest: LW[NIL]];
LBDInstruction: TYPE = Instruction[LBD] ← [instructionProc: LBD, instructionName: JEBBj, rest: LBD[NIL]];
RRRInstruction: TYPE = Instruction[RRR] ← [instructionProc: RRR, instructionName: RADD, rest: RRR[NIL]];
QRInstruction: TYPE = Instruction[QR] ← [instructionProc: QR, instructionName: QADD, rest: QR[NIL]];
RDInstruction: TYPE = Instruction[RD] ← [instructionProc: RD, instructionName: RJEBj, rest: RD[NIL]];
XOInstruction: TYPE = Instruction[XO] ← [instructionProc: XO, instructionName: LRIn, rest: XO[NIL]];
XROInstruction: TYPE = Instruction[XRO] ← [instructionProc: XRO, instructionName: RRI, rest: XRO[NIL]];
InstructionProc: TYPE = PROC[instruction: REF Instruction, s: STREAM]; -- InstructionProcs correspond to the different classes of dragon instructions. Each one parses one class of instructions and calls on the appropriate per instruction procedures to do the actual assembly
OperandInfoRep: TYPE = RECORD[ -- a record because I thought I needed more information
operandName: OperandName
];
OperandInfo: TYPE = REF OperandInfoRep;
ConstantRegisterIndex: PROC [s: STREAM] RETURNS [cri: INT] ~ {
Parses an expression and verifies that it corresponds to some constant register. There's a bit of cheating here: the only constant registers are [0..12), but we also accept -2, -1, and FIRST[INT] and choose the appropriate register.
e: INT ← Expression[s];
e ← SELECT e FROM
-2 => 5,
-1 => 6,
FIRST[INT] => 7,
ENDCASE => e;
IF e IN [0..12) THEN cri ← e ELSE ERROR RangeError[e, Constant];
};
AuxOrLocalRegisterIndex: PROC [s: STREAM] RETURNS [ali: INT] ~ {
Parses an expression and verifies that it corresponds to some local or auxiliary register number [0..16).
e: INT ← Expression[s];
IF e IN [0..16) THEN ali ← e ELSE ERROR RangeError[e, AuxOrLocal];
};
Byte: PROC [s: STREAM] RETURNS [byte: INT] ~ {
Parses an expression and extracts the low order byte, provided the entire expression's value lies in [-128..256). This allows convenient notation for negative byte values in contexts where the value is sign extended rather than zero extended.
e: INT ← Expression[s];
IF e IN [-128..256) THEN byte ← Basics.LowByte[Basics.LowHalf[LOOPHOLE[e]]]
ELSE ERROR RangeError[e, Byte];
};
Halfword: PROC [s: STREAM] RETURNS [halfword: INT] ~ {
Similar to Byte but for halfwords.
e: INT ← Expression[s];
IF (-LONG[32768] <= e) AND (e <= 65535) THEN halfword ← Basics.LowHalf[LOOPHOLE[e]]
ELSE ERROR RangeError[e, Halfword];
};
SourceOrDest: TYPE = {source, destination};
GeneralReg: PROC [s: STREAM, sourceOrDest: SourceOrDest] RETURNS [
reg: REF HandCoding.RegSpec] ~ {
Parses a register specification for fully general register operands. Even for general register operands, whether it's a source or destination makes a difference as to what's allowed.
t: Token ← GetToken[s];
operandInfo: OperandInfo ← NARROW[SymTab.Fetch[OperandSyms, t.rope].val, OperandInfo];
operand: OperandName ← IF operandInfo = NIL THEN ERROR ImproperRegister[t.rope] ELSE operandInfo.operandName;
SELECT operand FROM
AUX => { e: INT ← AuxOrLocalRegisterIndex[s]; RETURN[NEW[HandCoding.RegSpec ← [reg[e]]]] };
LOCAL => { e: INT ← AuxOrLocalRegisterIndex[s]; RETURN[NEW[HandCoding.RegSpec ← [aux[e]]]] };
CONSTANT => { e: INT ← ConstantRegisterIndex[s]; RETURN[NEW[HandCoding.RegSpec ← [const[e]]]] };
Top => RETURN [NEW[HandCoding.RegSpec ← IF sourceOrDest = source THEN HandCoding.topSrc ELSE HandCoding.topDst]];
Under => RETURN [NEW[HandCoding.RegSpec ← IF sourceOrDest = source THEN HandCoding.belowSrc ELSE HandCoding.belowDst]];
PopTop => IF sourceOrDest = source
THEN RETURN [NEW[HandCoding.RegSpec ← HandCoding.popSrc]]
ELSE ERROR ImproperRegister[t.rope];
PopUnder => IF sourceOrDest = source
THEN RETURN [NEW[HandCoding.RegSpec ← HandCoding.belowSrcPop]]
ELSE ERROR ImproperRegister[t.rope];
Push => IF sourceOrDest = destination
THEN RETURN [NEW[HandCoding.RegSpec ← HandCoding.pushDst]]
ELSE ERROR ImproperRegister[t.rope];
ENDCASE => ERROR ImproperRegister[t.rope];
};
ShortSourceReg: PROC [s: STREAM] RETURNS [HandCoding.ShortRegSpec] ~ {
t: Token ← GetToken[s];
Parses a short register specification.
operandInfo: OperandInfo ← NARROW[SymTab.Fetch[OperandSyms, t.rope].val, OperandInfo];
operand: OperandName ← IF operandInfo = NIL THEN ERROR ImproperRegister[t.rope] ELSE operandInfo.operandName;
SELECT operand FROM
Constant0 => RETURN[const0];
Constant1 => RETURN[const1];
Top => RETURN[topSrc];
PopTop => RETURN[popSrc];
ENDCASE => ERROR ImproperRegister[t.rope];
};
CASpec: PROC [s: STREAM] RETURNS [DragOpsCross.ShortRegQR] ~ {
Parses a combined destination and first source operand register specification for Quick-register format instructions.
t: Token ← GetToken[s];
operandInfo: OperandInfo ← NARROW[SymTab.Fetch[OperandSyms, t.rope].val, OperandInfo];
operand: OperandName ← IF operandInfo = NIL THEN ERROR ImproperRegister[t.rope] ELSE operandInfo.operandName;
SELECT operand FROM
TopATop => RETURN[topAtop];
PushATop => RETURN[pushAtop];
PushA0 => RETURN[pushA0];
PushA1 => RETURN[pushA1];
ENDCASE => ERROR ImproperRegister[t.rope];
};
Expression: PROC [s: STREAM] RETURNS [i: INT] ~ {
Parses an arithmetic expression. For now limited to a single, possibly negated, numeric literal in decimal, octal or hex notation.
t: Token ← GetToken[s];
SELECT t.type FROM
tokenDECIMAL, tokenOCTAL, tokenHEX => i ← LOOPHOLE[Convert.CardFromWholeNumberLiteral[t.rope]];
tokenSINGLE => i ← IF Rope.Equal[t.rope, "-"] THEN -(Expression[s]) ELSE ERROR SyntaxError[Rope.Cat["Numeric token required instead of ", t.rope]];
tokenID => {
operandInfo: OperandInfo ← NARROW[SymTab.Fetch[OperandSyms, t.rope].val, OperandInfo];
operand: OperandName;
register: DragOpsCross.ProcessorRegister;
IF operandInfo = NIL THEN ERROR SyntaxError[Rope.Cat["Numeric token required instead of ", t.rope]];
operand ← operandInfo.operandName;
register ← SELECT operand FROM
YoungestStatus => ifuYoungestL,
YoungestPC => ifuYoungestPC,
EldestStatus => ifuEldestL,
EldestPC => ifuEldestPC,
SLimit => ifuSLimit,
ENDCASE => ERROR SyntaxError[Rope.Cat["Numeric token required instead of ", t.rope]];
i ← ORD[register];
};
ENDCASE => ERROR SyntaxError[Rope.Cat["Numeric token required instead of ", t.rope]];
};
Token: TYPE = RECORD [
type: IO.TokenKind,
rope: ROPE
];
GetToken: PROC [s: STREAM] RETURNS [t: Token ← [tokenERROR, NIL]] ~ {
IO.GetCedarTokenRope with some very simple error handling and return-value rearrangement.
[t.type, t.rope, ] ← IO.GetCedarTokenRope[s, TRUE !
IO.Error => CONTINUE;
IO.EndOfStream => CONTINUE];
};
RangeError: ERROR[ val: INT, type: RangeErrorType ] = CODE;
RangeErrorType: TYPE = {Constant, AuxOrLocal, Byte, Halfword};
ImproperRegister: ERROR [reason: ROPE] = CODE;
SyntaxError: ERROR [reason: ROPE] = CODE;
InstructionsSyms: SymTab.Ref ← SymTab.Create[101, TRUE];
OperandSyms: SymTab.Ref ← SymTab.Create[17, TRUE];
SingleInstruction: PROC[s: STREAM] ~ {
t: Token ← GetToken[s]; -- this reads the token that should be an instruction mnemonic
info: REF Instruction ← NARROW[SymTab.Fetch[InstructionsSyms, t.rope].val]; -- find the info for the instruction
IF info = NIL THEN ERROR SyntaxError["Instruction Required"];
info.instructionProc[info, s]; -- call the appropriate instructionProc to parse and assemble the instruction
};
I: InstructionProc ~ {
ii: IInstruction ← NARROW[instruction^, IInstruction];
ii.IProc[];
};
LC: InstructionProc ~ {
ii: LCInstruction ← NARROW[instruction^, LCInstruction];
e: INT ← Expression[s];
ii.LCProc[e];
};
LR: InstructionProc ~ {
regnum: INT ← AuxOrLocalRegisterIndex[s];
ii: LRInstruction ← NARROW[instruction^, LRInstruction];
ii.LRProc[[reg[regnum]]];
};
LB: InstructionProc ~ {
b: INT ← Byte[s];
ii: LBInstruction ← NARROW[instruction^, LBInstruction];
ii.LBProc[b];
};
LH: InstructionProc ~ {
h: INT ← Halfword[s];
ii: LHInstruction ← NARROW[instruction^, LHInstruction];
ii.LHProc[h];
};
LW: InstructionProc ~ {
w: DragOpsCross.Word ← DragOpsCrossUtils.IntToWord[Expression[s]];
ii: LWInstruction ← NARROW[instruction^, LWInstruction];
ii.LWProc[w];
};
LBD: InstructionProc ~ {
ii: LBDInstruction ← NARROW[instruction^, LBDInstruction];
comparand: INT ← Byte[s];
displacement: INT;
comma: Token ← GetToken[s];
IF NOT Rope.Equal[comma.rope, ","] THEN ERROR SyntaxError["Comma Required"];
displacement ← Byte[s];
ii.LBDProc[comparand, displacement];
};
RRR: InstructionProc ~ {
ii: RRRInstruction ← NARROW[instruction^, RRRInstruction];
cReg: REF HandCoding.RegSpec ← GeneralReg[s, destination];
aReg, bReg: REF HandCoding.RegSpec;
EatComma[s];
aReg ← GeneralReg[s, source];
EatComma[s];
bReg ← GeneralReg[s, source];
ii.RRRProc[cReg^, aReg^, bReg^];
};
QR: InstructionProc ~ {
ii: QRInstruction ← NARROW[instruction^, QRInstruction];
ca: DragOpsCross.ShortRegQR ← CASpec[s];
b: REF HandCoding.RegSpec;
EatComma[s];
b ← GeneralReg[s, source];
ii.QRProc[ca, b^];
};
RD: InstructionProc ~ {
ii: RDInstruction ← NARROW[instruction^, RDInstruction];
sreg: HandCoding.ShortRegSpec ← ShortSourceReg[s];
b: REF HandCoding.RegSpec;
displacement: INT;
EatComma[s];
b ← GeneralReg[s, source];
EatComma[s];
displacement ← Byte[s];
ii.RDProc[sreg, b^, displacement];
};
XO: InstructionProc ~ {
ii: XOInstruction ← NARROW[instruction^, XOInstruction];
regnum: INT ← AuxOrLocalRegisterIndex[s];
offset: INT;
EatComma[s];
offset ← Byte[s];
ii.XOProc[[reg[regnum]], offset];
};
XRO: InstructionProc ~ {
ii: XROInstruction ← NARROW[instruction^, XROInstruction];
a: REF HandCoding.RegSpec ← GeneralReg[s, source];
b: REF HandCoding.RegSpec;
offset: INT;
EatComma[s];
b ← GeneralReg[s, source];
EatComma[s];
offset ← Byte[s];
ii.XROProc[a^, b^, offset];
};
EatComma: PROC [s: STREAM] RETURNS [] ~ {
t: Token ← GetToken[s];
IF NOT Rope.Equal[t.rope, ","] THEN ERROR SyntaxError["Comma Required"];
};
Initialize: PROC [] RETURNS [] ~ { OPEN HandCoding;
[] ← SymTab.Insert[InstructionsSyms, "ADD", NEW[IInstruction ← [I, ADD, I[drADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "SUB", NEW[IInstruction ← [I, SUB, I[drSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "AND", NEW[IInstruction ← [I, IAND, I[drAND]]]];
[] ← SymTab.Insert[InstructionsSyms, "OR", NEW[IInstruction ← [I, IOR, I[drOR]]]];
[] ← SymTab.Insert[InstructionsSyms, "EXDIS", NEW[IInstruction ← [I, EXDIS, I[drEXDIS]]]];
[] ← SymTab.Insert[InstructionsSyms, "DUP", NEW[IInstruction ← [I, DUP, I[drDUP]]]];
[] ← SymTab.Insert[InstructionsSyms, "DIS", NEW[IInstruction ← [I, DIS, I[drDIS]]]];
[] ← SymTab.Insert[InstructionsSyms, "JSD", NEW[IInstruction ← [I, JSD, I[drJSD]]]];
[] ← SymTab.Insert[InstructionsSyms, "JSR", NEW[IInstruction ← [I, JSR, I[drJSR]]]];
[] ← SymTab.Insert[InstructionsSyms, "BC", NEW[IInstruction ← [I, BC, I[drBC]]]];
[] ← SymTab.Insert[InstructionsSyms, "SFC", NEW[IInstruction ← [I, SFC, I[drSFC]]]];
[] ← SymTab.Insert[InstructionsSyms, "SFCI", NEW[IInstruction ← [I, SFCI, I[drSFCI]]]];
[] ← SymTab.Insert[InstructionsSyms, "KFC", NEW[IInstruction ← [I, KFC, I[drKFC]]]];
[] ← SymTab.Insert[InstructionsSyms, "RETN", NEW[IInstruction ← [I, RETN, I[drRETN]]]];
[] ← SymTab.Insert[InstructionsSyms, "LADD", NEW[IInstruction ← [I, LADD, I[drLADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "LSUB", NEW[IInstruction ← [I, LSUB, I[drLSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RX", NEW[IInstruction ← [I, RX, I[drRX]]]];
[] ← SymTab.Insert[InstructionsSyms, "J1", NEW[IInstruction ← [I, J1, I[drJ1]]]];
[] ← SymTab.Insert[InstructionsSyms, "J2", NEW[IInstruction ← [I, J2, I[drJ2]]]];
[] ← SymTab.Insert[InstructionsSyms, "J3", NEW[IInstruction ← [I, J3, I[drJ3]]]];
[] ← SymTab.Insert[InstructionsSyms, "J5", NEW[IInstruction ← [I, J5, I[drJ5]]]];
[] ← SymTab.Insert[InstructionsSyms, "LC", NEW[LCInstruction ← [LC, LC, LC[HandCodingComforts.LoadConstant]]]];
[] ← SymTab.Insert[InstructionsSyms, "LRn", NEW[LRInstruction ← [LR, LRn, LR[drLRn]]]];
[] ← SymTab.Insert[InstructionsSyms, "SRn", NEW[LRInstruction ← [LR, SRn, LR[drSRn]]]];
[] ← SymTab.Insert[InstructionsSyms, "ADDB", NEW[LBInstruction ← [LB, ADDB, LB[drADDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "SUBB", NEW[LBInstruction ← [LB, SUBB, LB[drSUBB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LIB", NEW[LBInstruction ← [LB, LIB, LB[drLIB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RB", NEW[LBInstruction ← [LB, RB, LB[drRB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RSB", NEW[LBInstruction ← [LB, RSB, LB[drRSB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LIP", NEW[LBInstruction ← [LB, LIP, LB[ drLIP]]]];
[] ← SymTab.Insert[InstructionsSyms, "WB", NEW[LBInstruction ← [LB, WB, LB[drWB]]]];
[] ← SymTab.Insert[InstructionsSyms, "WSB", NEW[LBInstruction ← [LB, WSB, LB[drWSB]]]];
[] ← SymTab.Insert[InstructionsSyms, "PSB", NEW[LBInstruction ← [LB, PSB, LB[drPSB]]]];
[] ← SymTab.Insert[InstructionsSyms, "SIP", NEW[LBInstruction ← [LB, SIP, LB[drSIP]]]];
[] ← SymTab.Insert[InstructionsSyms, "CST", NEW[LBInstruction ← [LB, CST, LB[drCST]]]];
[] ← SymTab.Insert[InstructionsSyms, "AL", NEW[LBInstruction ← [LB, AL, LB[drAL]]]];
[] ← SymTab.Insert[InstructionsSyms, "ALS", NEW[LBInstruction ← [LB, ALS, LB[drALS]]]];
[] ← SymTab.Insert[InstructionsSyms, "AS", NEW[LBInstruction ← [LB, AS, LB[drAS]]]];
[] ← SymTab.Insert[InstructionsSyms, "ASL", NEW[LBInstruction ← [LB, ASL, LB[drASL]]]];
[] ← SymTab.Insert[InstructionsSyms, "JB", NEW[LBInstruction ← [LB, JB, LB[drJB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RET", NEW[LBInstruction ← [LB, RET, LB[drRET]]]];
[] ← SymTab.Insert[InstructionsSyms, "ADDDB", NEW[LHInstruction ← [LH, ADDDB, LH[drADDDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "SUBDB", NEW[LHInstruction ← [LH, SUBDB, LH[drSUBDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LIDB", NEW[LHInstruction ← [LH, LIDB, LH[drLIDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LGF", NEW[LHInstruction ← [LH, LGF, LH[drLGF]]]];
[] ← SymTab.Insert[InstructionsSyms, "IOD", NEW[LHInstruction ← [LH, IOD, LH[drIOD]]]];
[] ← SymTab.Insert[InstructionsSyms, "ION", NEW[LHInstruction ← [LH, ION, LH[drION]]]];
[] ← SymTab.Insert[InstructionsSyms, "IODA", NEW[LHInstruction ← [LH, IODA, LH[drIODA]]]];
[] ← SymTab.Insert[InstructionsSyms, "SHL", NEW[LHInstruction ← [LH, SHL, LH[drSHL]]]];
[] ← SymTab.Insert[InstructionsSyms, "SHR", NEW[LHInstruction ← [LH, SHR, LH[drSHR]]]];
[] ← SymTab.Insert[InstructionsSyms, "SHDL", NEW[LHInstruction ← [LH, SHDL, LH[drSHDL]]]];
[] ← SymTab.Insert[InstructionsSyms, "SHDR", NEW[LHInstruction ← [LH, SHDR, LH[drSHDR]]]];
[] ← SymTab.Insert[InstructionsSyms, "JDB", NEW[LHInstruction ← [LH, JDB, LH[drJDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LFC", NEW[LHInstruction ← [LH, LFC, LH[drLFC]]]];
[] ← SymTab.Insert[InstructionsSyms, "FSDB", NEW[LHInstruction ← [LH, FSDB, LH[drFSDB]]]];
[] ← SymTab.Insert[InstructionsSyms, "LIQB", NEW[LWInstruction ← [LW, LIQB, LW[drLIQB]]]];
[] ← SymTab.Insert[InstructionsSyms, "ADDQB", NEW[LWInstruction ← [LW, ADDQB, LW[drADDQB]]]];
[] ← SymTab.Insert[InstructionsSyms, "SUBQB", NEW[LWInstruction ← [LW, SUBQB, LW[drSUBQB]]]];
[] ← SymTab.Insert[InstructionsSyms, "JQB", NEW[LWInstruction ← [LW, JQB, LW[drJQB]]]];
[] ← SymTab.Insert[InstructionsSyms, "DFC", NEW[LWInstruction ← [LW, DFC, LW[drDFC]]]];
[] ← SymTab.Insert[InstructionsSyms, "JEBBj", NEW[LBDInstruction ← [LBD, JEBBj, LBD[drJEBBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "JEBB", NEW[LBDInstruction ← [LBD, JEBB, LBD[drJEBB]]]];
[] ← SymTab.Insert[InstructionsSyms, "JNEBBj", NEW[LBDInstruction ← [LBD, JNEBBj, LBD[drJNEBBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "JNEBB", NEW[LBDInstruction ← [LBD, JNEBB, LBD[drJNEBB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RADD", NEW[RRRInstruction ← [RRR, RADD, RRR[drRADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "RUADD", NEW[RRRInstruction ← [RRR, RUADD, RRR[drRUADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "RVADD", NEW[RRRInstruction ← [RRR, RVADD, RRR[drRVADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "RSUB", NEW[RRRInstruction ← [RRR, RSUB, RRR[drRSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RUSUB", NEW[RRRInstruction ← [RRR, RUSUB, RRR[drRUSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RVSUB", NEW[RRRInstruction ← [RRR, RVSUB, RRR[drRVSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RAND", NEW[RRRInstruction ← [RRR, RAND, RRR[drRAND]]]];
[] ← SymTab.Insert[InstructionsSyms, "ROR", NEW[RRRInstruction ← [RRR, ROR, RRR[drROR]]]];
[] ← SymTab.Insert[InstructionsSyms, "RXOR", NEW[RRRInstruction ← [RRR, RXOR, RRR[drRXOR]]]];
[] ← SymTab.Insert[InstructionsSyms, "RRX", NEW[RRRInstruction ← [RRR, RRX, RRR[drRRX]]]];
[] ← SymTab.Insert[InstructionsSyms, "RFU", NEW[RRRInstruction ← [RRR, RFU, RRR[drRFU]]]];
[] ← SymTab.Insert[InstructionsSyms, "RBC", NEW[RRRInstruction ← [RRR, RBC, RRR[drRBC]]]];
[] ← SymTab.Insert[InstructionsSyms, "RLADD", NEW[RRRInstruction ← [RRR, RLADD, RRR[drRLADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "RLSUB", NEW[RRRInstruction ← [RRR, RLSUB, RRR[ drRLSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "QADD", NEW[QRInstruction ← [QR, QADD, QR[drQADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "QSUB", NEW[QRInstruction ← [QR, QSUB, QR[drQSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "QAND", NEW[QRInstruction ← [QR, QAND, QR[drQAND]]]];
[] ← SymTab.Insert[InstructionsSyms, "QOR", NEW[QRInstruction ← [QR, QOR, QR[drQOR]]]];
[] ← SymTab.Insert[InstructionsSyms, "QRX", NEW[QRInstruction ← [QR, QRX, QR[drQRX]]]];
[] ← SymTab.Insert[InstructionsSyms, "QBC", NEW[QRInstruction ← [QR, QBC, QR[drQBC]]]];
[] ← SymTab.Insert[InstructionsSyms, "QLADD", NEW[QRInstruction ← [QR, QLADD, QR[drQLADD]]]];
[] ← SymTab.Insert[InstructionsSyms, "QLSUB", NEW[QRInstruction ← [QR, QLSUB, QR[drQLSUB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJEBj", NEW[RDInstruction ← [RD, RJEBj, RD[drRJEBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJEB", NEW[RDInstruction ← [RD, RJEB, RD[drRJEB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJNEBj", NEW[RDInstruction ← [RD, RJNEBj, RD[drRJNEBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJNEB", NEW[RDInstruction ← [RD, RJNEB, RD[drRJNEB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJGBj", NEW[RDInstruction ← [RD, RJGBj, RD[drRJGBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJGB", NEW[RDInstruction ← [RD, RJGB, RD[drRJGB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJGEBj", NEW[RDInstruction ← [RD, RJGEBj, RD[drRJGEBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJGEB", NEW[RDInstruction ← [RD, RJGEB, RD[drRJGEB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJLBj", NEW[RDInstruction ← [RD, RJLBj, RD[drRJLBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJLB", NEW[RDInstruction ← [RD, RJLB, RD[drRJLB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJLEB", NEW[RDInstruction ← [RD, RJLEB, RD[drRJLEB]]]];
[] ← SymTab.Insert[InstructionsSyms, "RJLEBj", NEW[RDInstruction ← [RD, RJLEBj, RD[drRJLEBJ]]]];
[] ← SymTab.Insert[InstructionsSyms, "LRIn", NEW[XOInstruction ← [XO, LRIn, XO[drLRIn]]]];
[] ← SymTab.Insert[InstructionsSyms, "SRIn", NEW[XOInstruction ← [XO, SRIn, XO[drSRIn]]]];
[] ← SymTab.Insert[InstructionsSyms, "RRI", NEW[XROInstruction ← [XRO, RRI, XRO[drRRI]]]];
[] ← SymTab.Insert[InstructionsSyms, "RAI", NEW[XROInstruction ← [XRO, RAI, XRO[drRAI]]]];
[] ← SymTab.Insert[InstructionsSyms, "WRI", NEW[XROInstruction ← [XRO, WRI, XRO[drWRI]]]];
[] ← SymTab.Insert[InstructionsSyms, "WAI", NEW[XROInstruction ← [XRO, WAI, XRO[drWAI]]]];
[] ← SymTab.Insert[OperandSyms, "AUX", NEW[OperandInfoRep ← [AUX]]];
[] ← SymTab.Insert[OperandSyms, "LOCAL", NEW[OperandInfoRep ← [LOCAL]]];
[] ← SymTab.Insert[OperandSyms, "CONSTANT", NEW[OperandInfoRep ← [CONSTANT]]];
[] ← SymTab.Insert[OperandSyms, "Top", NEW[OperandInfoRep ← [Top]]];
[] ← SymTab.Insert[OperandSyms, "Under", NEW[OperandInfoRep ← [Under]]];
[] ← SymTab.Insert[OperandSyms, "TopATop", NEW[OperandInfoRep ← [TopATop]]];
[] ← SymTab.Insert[OperandSyms, "PushATop", NEW[OperandInfoRep ← [PushATop]]];
[] ← SymTab.Insert[OperandSyms, "PushA0", NEW[OperandInfoRep ← [PushA0]]];
[] ← SymTab.Insert[OperandSyms, "PushA1", NEW[OperandInfoRep ← [PushA1]]];
[] ← SymTab.Insert[OperandSyms, "Constant0", NEW[OperandInfoRep ← [Constant0]]];
[] ← SymTab.Insert[OperandSyms, "Constant1", NEW[OperandInfoRep ← [Constant1]]];
[] ← SymTab.Insert[OperandSyms, "PopTop", NEW[OperandInfoRep ← [PopTop]]];
[] ← SymTab.Insert[OperandSyms, "YoungestStatus", NEW[OperandInfoRep ← [YoungestStatus]]];
[] ← SymTab.Insert[OperandSyms, "YoungestPC", NEW[OperandInfoRep ← [YoungestPC]]];
[] ← SymTab.Insert[OperandSyms, "EldestStatus", NEW[OperandInfoRep ← [EldestStatus]]];
[] ← SymTab.Insert[OperandSyms, "EldestPC", NEW[OperandInfoRep ← [EldestPC]]];
[] ← SymTab.Insert[OperandSyms, "SLimit", NEW[OperandInfoRep ← [SLimit]]];
};
GetWord: HandCodingSupport.GetProc = {
[data: REF, pc: INT] RETURNS [Word]
mem: REF Memory = NARROW[data];
RETURN [mem[pc]];
};
PutWord: HandCodingSupport.PutProc = {
[data: REF, pc: INT, word: Word]
mem: REF Memory = NARROW[data];
mem[pc] ← word;
};
Memory: TYPE = RECORD[
mem: SEQUENCE size: NAT OF DragOpsCross.Word
];
Bytes: TYPE = PACKED ARRAY [0..4) OF BYTE;
AssembleOneInstruction: PUBLIC PROC [r: ROPE] RETURNS [bytes: ROPE] ~ {
mem: REF Memory ← NEW[Memory[100]];
area: HandCodingSupport.Area ← NIL;
output: STREAM ← IO.ROS[];
inner: PROC [] RETURNS [] ~ {
SingleInstruction[IO.RIS[r]];
};
area ← HandCodingSupport.NewArea[$Quad, GetWord, PutWord, mem];
area.currentPC ← 0;
{
ENABLE {
RangeError => {bytes ← Rope.Cat["Range Error: ", Convert.RopeFromInt[val]]; CONTINUE};
ImproperRegister => {bytes ← Rope.Cat["Improper Register: ", reason]; CONTINUE};
SyntaxError => {bytes ← Rope.Cat["Syntax Error: ", reason]; CONTINUE};
};
HandCodingSupport.Gen1WithArea[area, inner];
{
currentWordPC: CARD ← 0;
currentBytePC: CARD ← 0;
WHILE 4*currentWordPC + currentBytePC < area.currentPC DO
currentWord: Bytes ← LOOPHOLE[mem[currentWordPC], Bytes];
IO.PutF[output, "%03xH", IO.card[currentWord[currentBytePC]]];
[currentWordPC, currentBytePC] ← Basics.DivMod[4*currentWordPC+currentBytePC+1, 4];
IF 4*currentWordPC + currentBytePC < area.currentPC THEN IO.PutF[output, ", "];
ENDLOOP;
};
bytes ← Rope.Cat[IO.RopeFromROS[output, TRUE], " -- ", r];
};
};
Initialize[];
END.