
<<MimeImpl.mesa>>
    <<Carl Hauser, November 24, 1986 2:50:24 pm PST>>
<<>>
    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
        };

    <<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];
        i _ SELECT t.type FROM
            tokenDECIMAL, tokenOCTAL, tokenHEX => LOOPHOLE[Convert.CardFromWholeNumberLiteral[t.rope]],
            tokenSINGLE => IF Rope.Equal[t.rope, "-"] THEN -(Expression[s]) ELSE ERROR SyntaxError[Rope.Cat["Numeric token required instead of 
            ", t.rope]],
            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]]];
        };

    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 Basics.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.


        <<>>