home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / ldm / trash.pas < prev   
Pascal/Delphi Source File  |  1989-11-10  |  40KB  |  969 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      TRASH.PAS                         *)
  3. (*         (c) 1990  Georg Willmann & TOOLBOX             *)
  4. (* ------------------------------------------------------ *)
  5. {$R-,S-,I-,V-,B-,D-,E-,F-,N-,L-}
  6. {$M 4096,0,0}
  7.  
  8. USES Dos, MemWrite;           { für SetIntVec/GetIntVec   }
  9.  
  10. CONST
  11.   Version        = 'TRASH v2.01';
  12.   HotKey         = $5500;
  13.   HotKeyName     = 'Shift-F2';
  14.  
  15. VAR
  16.   WhereY         : BYTE ABSOLUTE $0000:$0451;
  17.   KbdStart       : WORD ABSOLUTE $0040:$001A;
  18.   KbdTail        : WORD ABSOLUTE $0040:$001C;
  19.   SaveLine       : ARRAY[0..159] OF BYTE;
  20.   CharBuffer     : ARRAY[0..84]  OF WORD;
  21.   SaveInt16,
  22.   CurrInt        : POINTER;
  23.   SaveSS, SaveSP,
  24.   ProgSS, ProgSP : WORD;
  25.   KeyPtr, Nr, i  : BYTE;
  26.  
  27.   PROCEDURE SwitchStack;       { wie immer bei Residenten  }
  28.   INLINE($8C/$16/SaveSS/$89/$26/SaveSp/$FA/
  29.          $8E/$16/ProgSS/$8B/$26/ProgSP/$FB);
  30.  
  31.   PROCEDURE SwitchBack;
  32.   INLINE($FA/$8E/$16/SaveSS/$8B/$26/SaveSP/$FB);
  33.  
  34.   PROCEDURE Assemble;          { urspl. Hauptprogramm      }
  35.  
  36. TYPE
  37.   SetType      = 0..24;      { Adressierungsart siehe Text }
  38.   ByteWordType = (NoLen, BLen, WLen);
  39.   BefehlType   = (MOV, PUSH, POP, XCHG, IN_, OUT, XLAT, LEA,
  40.                   LDS, LES, LAHF, SAHF, PUSHF, POPF, ADD,
  41.                   ADC, INC_, AAA, DAA, SUB, SBB, DEC_, NEG,
  42.                   CMP, AAS, DAS, MUL, IMUL, AAM, DIV_, IDIV,
  43.                   AAD, CBW, CWD, NOT_, SHL_, SAL, SHR_, SAR,
  44.                   ROL, ROR, RCL, RCR, AND_, TEST, OR_, XOR_,
  45.                   REP, REPZ, REPE, REPNE, REPNZ, MOVSB,
  46.                   CMPSB, SCASB, LODSB, STOSB, CALL, JMP,
  47.                   RET, JE, JZ, JL, JNGE, JLE, JNG, JB, JNAE,
  48.                   JP, JPE, JO, JS, JNE, JNZ, JNL, JGE, JNLE,
  49.                   JG, JNB, JAE, JNBE, JA, JNP, JPO, JNO,
  50.                   JNS, JNA, JBE, LOOP, LOOPZ, LOOPE, LOOPNZ,
  51.                   LOOPNE, JCXZ, INT, INTO, IRET, CLC, STC,
  52.                   CMC, CLD, CLI, HLT, LOCK, NOP, STD, STI,
  53.                   WAIT, MOVSW, CMPSW, SCASW, LODSW, STOSW,
  54.                   CALLF, RETF, JMPF, CS, SS, DS, ES, NOBEF);
  55. CONST
  56.   BefBez : ARRAY [BefehlType] OF STRING [6] =
  57.                  ('MOV', 'PUSH', 'POP', 'XCHG', 'IN', 'OUT',
  58.                   'XLAT', 'LEA', 'LDS', 'LES', 'LAHF',
  59.                   'SAHF', 'PUSHF', 'POPF', 'ADD', 'ADC',
  60.                   'INC', 'AAA', 'DAA', 'SUB', 'SBB', 'DEC',
  61.                   'NEG', 'CMP', 'AAS', 'DAS', 'MUL', 'IMUL',
  62.                   'AAM', 'DIV', 'IDIV', 'AAD', 'CBW', 'CWD',
  63.                   'NOT', 'SHL', 'SAL', 'SHR', 'SAR', 'ROL',
  64.                   'ROR', 'RCL', 'RCR', 'AND', 'TEST', 'OR',
  65.                   'XOR', 'REP', 'REPZ', 'REPE', 'REPNE',
  66.                   'REPNZ', 'MOVSB', 'CMPSB', 'SCASB',
  67.                   'LODSB', 'STOSB', 'CALL', 'JMP', 'RET',
  68.                   'JE', 'JZ',' JL', 'JNGE', 'JLE', 'JNG',
  69.                   'JB', 'JNAE', 'JP', 'JPE', 'JO', 'JS',
  70.                   'JNE', 'JNZ', 'JNL', 'JGE', 'JNLE', 'JG',
  71.                   'JNB', 'JAE', 'JNBE', 'JA', 'JNP', 'JPO',
  72.                   'JNO', 'JNS', 'JNA', 'JBE', 'LOOP',
  73.                   'LOOPZ', 'LOOPE', 'LOOPNZ', 'LOOPNE',
  74.                   'JCXZ', 'INT', 'INTO', 'IRET', 'CLC',
  75.                   'STC', 'CMC', 'CLD', 'CLI', 'HLT', 'LOCK',
  76.                   'NOP', 'STD', 'STI', 'WAIT', 'MOVSW',
  77.                   'CMPSW', 'SCASW', 'LODSW', 'STOSW',
  78.                   'CALLF', 'RETF', 'JMPF', 'CS:', 'SS:',
  79.                   'DS:', 'ES:', 'NOBEF');
  80.  
  81.   BefAnz   = 178;            { Anzahl der Befehle          }
  82.   BefBytes : ARRAY [0..BefAnz] OF RECORD
  83.                                    Befehl      : BefehlType;
  84.                                    AddType     : SetType;
  85.                                    first, next : BYTE;
  86.                                   END =
  87.  ((Befehl  : MOV;    AddType : 15; first : $A0; next : $00),
  88.   (Befehl  : MOV;    AddType : 16; first : $A2; next : $00),
  89.   (Befehl  : MOV;    AddType : 13; first : $B0; next : $00),
  90.   (Befehl  : MOV;    AddType :  9; first : $88; next : $00),
  91.   (Befehl  : MOV;    AddType : 10; first : $8A; next : $00),
  92.   (Befehl  : MOV;    AddType : 11; first : $8C; next : $00),
  93.   (Befehl  : MOV;    AddType : 12; first : $8E; next : $00),
  94.   (Befehl  : MOV;    AddType : 14; first : $C6; next : $00),
  95.   (Befehl  : PUSH;   AddType : 03; first : $50; next : $00),
  96.   (Befehl  : PUSH;   AddType : 04; first : $06; next : $00),
  97.   (Befehl  : PUSH;   AddType : 05; first : $FF; next : $30),
  98.   (Befehl  : POP;    AddType : 03; first : $58; next : $00),
  99.   (Befehl  : POP;    AddType : 04; first : $07; next : $00),
  100.   (Befehl  : POP;    AddType : 05; first : $8F; next : $00),
  101.   (Befehl  : XCHG;   AddType : 17; first : $90; next : $00),
  102.   (Befehl  : XCHG;   AddType : 09; first : $86; next : $00),
  103.   (Befehl  : XCHG;   AddType : 10; first : $86; next : $00),
  104.   (Befehl  : IN_;    AddType : 18; first : $E4; next : $00),
  105.   (Befehl  : IN_;    AddType : 19; first : $EC; next : $00),
  106.   (Befehl  : OUT;    AddType : 18; first : $E6; next : $00),
  107.   (Befehl  : OUT;    AddType : 19; first : $EE; next : $00),
  108.   (Befehl  : XLAT;   AddType : 00; first : $D7; next : $00),
  109.   (Befehl  : LEA;    AddType : 10; first : $8D; next : $00),
  110.   (Befehl  : LDS;    AddType : 10; first : $C5; next : $00),
  111.   (Befehl  : LES;    AddType : 10; first : $C4; next : $00),
  112.   (Befehl  : LAHF;   AddType : 00; first : $9F; next : $00),
  113.   (Befehl  : SAHF;   AddType : 00; first : $9E; next : $00),
  114.   (Befehl  : PUSHF;  AddType : 00; first : $9C; next : $00),
  115.   (Befehl  : POPF;   AddType : 00; first : $9D; next : $00),
  116.   (Befehl  : ADD;    AddType : 21; first : $04; next : $00),
  117.   (Befehl  : ADD;    AddType : 09; first : $00; next : $00),
  118.   (Befehl  : ADD;    AddType : 10; first : $02; next : $00),
  119.   (Befehl  : ADD;    AddType : 20; first : $80; next : $00),
  120.   (Befehl  : ADC;    AddType : 21; first : $14; next : $00),
  121.   (Befehl  : ADC;    AddType : 09; first : $10; next : $00),
  122.   (Befehl  : ADC;    AddType : 10; first : $12; next : $00),
  123.   (Befehl  : ADC;    AddType : 20; first : $80; next : $10),
  124.   (Befehl  : INC_;   AddType : 03; first : $40; next : $00),
  125.   (Befehl  : INC_;   AddType : 06; first : $FE; next : $00),
  126.   (Befehl  : AAA;    AddType : 00; first : $37; next : $00),
  127.   (Befehl  : DAA;    AddType : 00; first : $27; next : $00),
  128.   (Befehl  : SUB;    AddType : 21; first : $4C; next : $00),
  129.   (Befehl  : SUB;    AddType : 09; first : $28; next : $00),
  130.   (Befehl  : SUB;    AddType : 10; first : $2A; next : $00),
  131.   (Befehl  : SUB;    AddType : 20; first : $80; next : $28),
  132.   (Befehl  : SBB;    AddType : 21; first : $1C; next : $00),
  133.   (Befehl  : SBB;    AddType : 09; first : $18; next : $00),
  134.   (Befehl  : SBB;    AddType : 10; first : $1A; next : $00),
  135.   (Befehl  : SBB;    AddType : 20; first : $80; next : $18),
  136.   (Befehl  : DEC_;   AddType : 03; first : $48; next : $00),
  137.   (Befehl  : DEC_;   AddType : 06; first : $FE; next : $00),
  138.   (Befehl  : NEG;    AddType : 06; first : $F6; next : $18),
  139.   (Befehl  : CMP;    AddType : 21; first : $3C; next : $00),
  140.   (Befehl  : CMP;    AddType : 20; first : $80; next : $38),
  141.   (Befehl  : CMP;    AddType : 09; first : $38; next : $00),
  142.   (Befehl  : CMP;    AddType : 10; first : $3A; next : $00),
  143.   (Befehl  : AAS;    AddType : 00; first : $3F; next : $00),
  144.   (Befehl  : DAS;    AddType : 00; first : $2F; next : $00),
  145.   (Befehl  : MUL;    AddType : 06; first : $F6; next : $20),
  146.   (Befehl  : IMUL;   AddType : 06; first : $F6; next : $28),
  147.   (Befehl  : AAM;    AddType : 00; first : $D4; next : $0A),
  148.   (Befehl  : DIV_;   AddType : 06; first : $F6; next : $30),
  149.   (Befehl  : IDIV;   AddType : 06; first : $F6; next : $38),
  150.   (Befehl  : AAD;    AddType : 00; first : $D5; next : $0A),
  151.   (Befehl  : CBW;    AddType : 00; first : $98; next : $00),
  152.   (Befehl  : CWD;    AddType : 00; first : $99; next : $00),
  153.   (Befehl  : NOT_;   AddType : 06; first : $F6; next : $10),
  154.   (Befehl  : SHL_;   AddType : 06; first : $D0; next : $20),
  155.   (Befehl  : SHL_;   AddType : 07; first : $D2; next : $20),
  156.   (Befehl  : SAL;    AddType : 06; first : $D0; next : $20),
  157.   (Befehl  : SAL;    AddType : 07; first : $D2; next : $20),
  158.   (Befehl  : SHR_;   AddType : 06; first : $D0; next : $28),
  159.   (Befehl  : SHR_;   AddType : 07; first : $D2; next : $28),
  160.   (Befehl  : SAR;    AddType : 06; first : $D0; next : $38),
  161.   (Befehl  : SAR;    AddType : 07; first : $D2; next : $38),
  162.   (Befehl  : ROL;    AddType : 06; first : $D0; next : $00),
  163.   (Befehl  : ROL;    AddType : 07; first : $D2; next : $00),
  164.   (Befehl  : ROR;    AddType : 06; first : $D0; next : $08),
  165.   (Befehl  : ROR;    AddType : 07; first : $D2; next : $08),
  166.   (Befehl  : RCL;    AddType : 06; first : $D0; next : $10),
  167.   (Befehl  : RCL;    AddType : 07; first : $D2; next : $10),
  168.   (Befehl  : RCR;    AddType : 06; first : $D0; next : $18),
  169.   (Befehl  : RCR;    AddType : 07; first : $D2; next : $18),
  170.   (Befehl  : AND_;   AddType : 21; first : $24; next : $00),
  171.   (Befehl  : AND_;   AddType : 14; first : $80; next : $20),
  172.   (Befehl  : AND_;   AddType : 09; first : $20; next : $00),
  173.   (Befehl  : AND_;   AddType : 10; first : $22; next : $00),
  174.   (Befehl  : TEST;   AddType : 21; first : $A8; next : $00),
  175.   (Befehl  : TEST;   AddType : 14; first : $F6; next : $00),
  176.   (Befehl  : TEST;   AddType : 09; first : $84; next : $00),
  177.   (Befehl  : TEST;   AddType : 10; first : $84; next : $00),
  178.   (Befehl  : OR_;    AddType : 21; first : $0C; next : $00),
  179.   (Befehl  : OR_;    AddType : 14; first : $80; next : $08),
  180.   (Befehl  : OR_;    AddType : 09; first : $08; next : $00),
  181.   (Befehl  : OR_;    AddType : 10; first : $0A; next : $00),
  182.   (Befehl  : XOR_;   AddType : 21; first : $34; next : $00),
  183.   (Befehl  : XOR_;   AddType : 14; first : $80; next : $30),
  184.   (Befehl  : XOR_;   AddType : 09; first : $30; next : $00),
  185.   (Befehl  : XOR_;   AddType : 10; first : $32; next : $00),
  186.   (Befehl  : REP;    AddType : 00; first : $F2; next : $00),
  187.   (Befehl  : REPZ;   AddType : 00; first : $F3; next : $00),
  188.   (Befehl  : REPNZ;  AddType : 00; first : $F2; next : $00),
  189.   (Befehl  : REPE;   AddType : 00; first : $F3; next : $00),
  190.   (Befehl  : REPNE;  AddType : 00; first : $F2; next : $00),
  191.   (Befehl  : MOVSB;  AddType : 00; first : $A4; next : $00),
  192.   (Befehl  : CMPSB;  AddType : 00; first : $A6; next : $00),
  193.   (Befehl  : SCASB;  AddType : 00; first : $AE; next : $00),
  194.   (Befehl  : LODSB;  AddType : 00; first : $AC; next : $00),
  195.   (Befehl  : STOSB;  AddType : 00; first : $AA; next : $00),
  196.   (Befehl  : CALL;   AddType : 22; first : $E8; next : $00),
  197.   (Befehl  : CALL;   AddType : 05; first : $FF; next : $10),
  198.   (Befehl  : JMP;    AddType : 05; first : $FF; next : $20),
  199.   (Befehl  : JMP;    AddType : 24; first : $E9; next : $00),
  200.   (Befehl  : RET;    AddType : 00; first : $C3; next : $00),
  201.   (Befehl  : RET;    AddType : 01; first : $C2; next : $00),
  202.   (Befehl  : JE;     AddType : 02; first : $74; next : $00),
  203.   (Befehl  : JZ;     AddType : 02; first : $74; next : $00),
  204.   (Befehl  : JL;     AddType : 02; first : $7C; next : $00),
  205.   (Befehl  : JNGE;   AddType : 02; first : $7C; next : $00),
  206.   (Befehl  : JLE;    AddType : 02; first : $7E; next : $00),
  207.   (Befehl  : JNG;    AddType : 02; first : $7E; next : $00),
  208.   (Befehl  : JB;     AddType : 02; first : $72; next : $00),
  209.   (Befehl  : JNAE;   AddType : 02; first : $72; next : $00),
  210.   (Befehl  : JP;     AddType : 02; first : $7A; next : $00),
  211.   (Befehl  : JPE;    AddType : 02; first : $7A; next : $00),
  212.   (Befehl  : JO;     AddType : 02; first : $70; next : $00),
  213.   (Befehl  : JS;     AddType : 02; first : $78; next : $00),
  214.   (Befehl  : JNE;    AddType : 02; first : $75; next : $00),
  215.   (Befehl  : JNZ;    AddType : 02; first : $75; next : $00),
  216.   (Befehl  : JNL;    AddType : 02; first : $7D; next : $00),
  217.   (Befehl  : JGE;    AddType : 02; first : $7D; next : $00),
  218.   (Befehl  : JNLE;   AddType : 02; first : $7F; next : $00),
  219.   (Befehl  : JG;     AddType : 02; first : $7F; next : $00),
  220.   (Befehl  : JNB;    AddType : 02; first : $73; next : $00),
  221.   (Befehl  : JAE;    AddType : 02; first : $73; next : $00),
  222.   (Befehl  : JNBE;   AddType : 02; first : $77; next : $00),
  223.   (Befehl  : JA;     AddType : 02; first : $77; next : $00),
  224.   (Befehl  : JNP;    AddType : 02; first : $7B; next : $00),
  225.   (Befehl  : JPO;    AddType : 02; first : $7B; next : $00),
  226.   (Befehl  : JNO;    AddType : 02; first : $71; next : $00),
  227.   (Befehl  : JNS;    AddType : 02; first : $79; next : $00),
  228.   (Befehl  : JNA;    AddType : 02; first : $76; next : $00),
  229.   (Befehl  : JBE;    AddType : 02; first : $76; next : $00),
  230.   (Befehl  : LOOP;   AddType : 02; first : $E2; next : $00),
  231.   (Befehl  : LOOPZ;  AddType : 02; first : $E1; next : $00),
  232.   (Befehl  : LOOPE;  AddType : 02; first : $E1; next : $00),
  233.   (Befehl  : LOOPNZ; AddType : 02; first : $E0; next : $00),
  234.   (Befehl  : LOOPNE; AddType : 02; first : $E0; next : $00),
  235.   (Befehl  : JCXZ;   AddType : 02; first : $E3; next : $00),
  236.   (Befehl  : INT;    AddType : 08; first : $CD; next : $00),
  237.   (Befehl  : INTO;   AddType : 00; first : $CE; next : $00),
  238.   (Befehl  : IRET;   AddType : 00; first : $CF; next : $00),
  239.   (Befehl  : CLC;    AddType : 00; first : $F8; next : $00),
  240.   (Befehl  : STC;    AddType : 00; first : $F9; next : $00),
  241.   (Befehl  : CMC;    AddType : 00; first : $F5; next : $00),
  242.   (Befehl  : CLD;    AddType : 00; first : $FC; next : $00),
  243.   (Befehl  : CLI;    AddType : 00; first : $FA; next : $00),
  244.   (Befehl  : HLT;    AddType : 00; first : $F4; next : $00),
  245.   (Befehl  : LOCK;   AddType : 00; first : $F0; next : $00),
  246.   (Befehl  : NOP;    AddType : 00; first : $90; next : $00),
  247.   (Befehl  : STD;    AddType : 00; first : $FD; next : $00),
  248.   (Befehl  : STI;    AddType : 00; first : $FB; next : $00),
  249.   (Befehl  : WAIT;   AddType : 00; first : $9B; next : $00),
  250.   (Befehl  : MOVSW;  AddType : 00; first : $A5; next : $00),
  251.   (Befehl  : CMPSW;  AddType : 00; first : $A7; next : $00),
  252.   (Befehl  : SCASW;  AddType : 00; first : $AF; next : $00),
  253.   (Befehl  : LODSW;  AddType : 00; first : $AD; next : $00),
  254.   (Befehl  : STOSW;  AddType : 00; first : $AB; next : $00),
  255.   (Befehl  : CALLF;  AddType : 05; first : $FF; next : $18),
  256.   (Befehl  : CALLF;  AddType : 23; first : $9A; next : $00),
  257.   (Befehl  : JMPF;   AddType : 05; first : $FF; next : $28),
  258.   (Befehl  : JMPF;   AddType : 23; first : $EA; next : $00),
  259.   (Befehl  : RETF;   AddType : 00; first : $CB; next : $00),
  260.   (Befehl  : RETF;   AddType : 01; first : $CA; next : $00),
  261.   (Befehl  : LAHF;   AddType : 00; first : $9F; next : $00),
  262.   (Befehl  : CS;     AddType : 00; first : $2E; next : $00),
  263.   (Befehl  : SS;     AddType : 00; first : $36; next : $00),
  264.   (Befehl  : DS;     AddType : 00; first : $3E; next : $00),
  265.   (Befehl  : ES;     AddType : 00; first : $26; next:$00));
  266.  
  267.                              { Alle Register               }
  268.  
  269.   WRegs : ARRAY [0..7] OF STRING [2] =
  270.            ('AX', 'CX', 'DX', 'BX', 'SP', 'BP', 'SI', 'DI');
  271.   BRegs : ARRAY [0..7] OF STRING [2] =
  272.            ('AL', 'CL', 'DL', 'BL', 'AH', 'CH', 'DH', 'BH');
  273.   SRegs : ARRAY [0..3] OF STRING [2] =
  274.            ('ES', 'CS', 'SS', 'DS');
  275.   MRegs : ARRAY [0..7] OF STRING [6] =
  276.            ('[BX+SI', '[BX+DI', '[BP+SI', '[BP+DI',
  277.                                 '[SI', '[DI', '[BP', '[BX');
  278.   BWOR  : ARRAY [ByteWordType] OF BYTE = (0, 0, 1);
  279.  
  280.   Home   = $4700;
  281.   Ctrl_Q = $1011;
  282.   Ctrl_Y = $2C19;
  283.   Down   = $5000;
  284.  
  285. TYPE
  286.   Operands      = (nichts, Imm, Regs, EA, SegRegs,
  287.                    Abs, RegCl, RegDX, RegAW);
  288.   OperandsType  = SET OF Operands;
  289.   DOperandsType = SET OF SetType;
  290.  
  291. VAR
  292.   DOperand      : DOperandsType;   { Adressierungsart      }
  293.   ByteWord      : ByteWordType;    { Datenbreite           }
  294.   PutString,                       { Ergebnis-String       }
  295.   AssemblerCode,
  296.   Mnemo,
  297.   Source,
  298.   Dest          : STRING [80];
  299.   OpAnz,                          { Anzahl der Operanden   }
  300.   i, Col        : INTEGER;
  301.  
  302.   FUNCTION Space(Len : BYTE) : STRING;
  303.   VAR
  304.     Dummy : STRING;
  305.   BEGIN
  306.     FillChar(Dummy[1], Len, ' ');
  307.     Dummy[0] := Chr(Len);
  308.     Space    := Dummy;
  309.   END;
  310.  
  311.   PROCEDURE Error(Nr : BYTE);      { erledigt den Ausstieg }
  312.   BEGIN
  313.     Move(Ptr(VideoBuffer, 3840)^, SaveLine, 160);
  314.     WriteMem(1, 25, '                                    ' +
  315.                    '                                ', 112);
  316.     WriteMem(1, 25, 'Error : ', 112);
  317.     CASE Nr OF
  318.       1 : WriteMem(9,25,'}  wird erwartet',112);
  319.       2 : WriteMem(9,25,'Syntaxfehler',112);
  320.       3 : WriteMem(9,25,'Unerlaubtes Zeichen in Zahl',112);
  321.       4 : WriteMem(9,25,'Länge von Ziel- und Quelloperand'+
  322.                          ' verschieden',112);
  323.       5 : WriteMem(9,25,'Unbekannter Befehl',112);
  324.       6 : WriteMem(9,25,']  wird erwartet',112);
  325.       7 : WriteMem(9,25,'Word Register wird erwartet',112);
  326.       8 : WriteMem(9,25,'{  wird erwartet',112);
  327.       9 : WriteMem(9,25,'Falsches Format der Adresse',112);
  328.     END;
  329.     WriteMem(65,25,'Weiter mit Taste',240);
  330.     REPEAT UNTIL KbdStart <> KbdTail;
  331.     KbdStart := KbdTail;      { Tastasturpuffer löschen    }
  332.     Move(SaveLine, Ptr(VideoBuffer, 3840)^, 160);
  333.     SetIntVec($16, CurrInt);  { Vektor zurücksetzen        }
  334.     SwitchBack;               { Stapel umschalten          }
  335.     INLINE($5D/$07/$1F/$5F/
  336.            $5E/$5A/$59/$5B/   { Register wiederherstellen  }
  337.            $58/$CF);          { und IRET ausführen         }
  338.   END;
  339.  
  340.   FUNCTION FirstIn(Str1, Str2 : STRING) : BOOLEAN;
  341.                              { prüft ob Str1 in Str2 ab    }
  342.                              { Anfang enthalten ist        }
  343.   VAR
  344.     ip : INTEGER;
  345.   BEGIN
  346.     FirstIn := TRUE;
  347.     IF Length(Str1) > Length(Str2) THEN
  348.       FirstIn := FALSE
  349.     ELSE
  350.       FOR ip := 1 TO Length(Str1) DO
  351.         IF Str1[ip] <> Str2[ip] THEN FirstIn := FALSE;
  352.   END;
  353.  
  354.   PROCEDURE ReadAssemblerCode;
  355.                              { liest String vom Bildschirm }
  356.                              { Ergebnis steht in           }
  357.                              { 'AssemblerCode'             }
  358.   VAR
  359.     i, Offset : WORD;
  360.   BEGIN
  361.     Offset := WhereY * 160;
  362.     i := 0;
  363.     AssemblerCode := '';
  364.     WHILE (Chr(Mem[VideoBuffer:Offset+i]) <> '{') AND
  365.           (i < 156) DO Inc(i, 2);
  366.     Inc(i, 2);
  367.     IF i = 158 THEN Error(8);    { Klammer auf fehlt       }
  368.     WHILE (Chr(Mem[VideoBuffer:Offset+i]) <> '}') AND
  369.           (i < 158) DO BEGIN
  370.       Insert(UpCase(Chr(Mem[VideoBuffer:Offset+i])),
  371.              AssemblerCode, 255);
  372.       Inc(i, 2);
  373.     END;
  374.     IF i = 158 THEN Error(1);    { Klammer zu fehlt        }
  375.     i := 1;                      { Leerzeichen entfernen   }
  376.     WHILE (i < Length(AssemblerCode)) AND
  377.           (AssemblerCode[i] = ' ') DO Inc(i);
  378.     Delete(AssemblerCode, 1, Pred(i));
  379.     i := Length(AssemblerCode);
  380.     WHILE (i > 0) AND (AssemblerCode[i] = ' ') DO Dec(i);
  381.     AssemblerCode[0] := Chr(i);
  382.   END;
  383.  
  384.   PROCEDURE SplitLine;       { Trennt AssemblerCode in     }
  385.                              { Mnemo,Dest und Source auf   }
  386.                              { und ermittelt OpAnz         }
  387.   VAR
  388.     i   : INTEGER;
  389.     Len : BYTE ABSOLUTE AssemblerCode;
  390.   BEGIN
  391.     i     := 1;
  392.     OpAnz := 0;
  393.     Mnemo := '';  Source := '';  Dest := '';
  394.     WHILE (AssemblerCode[i] <> ' ') AND (i <= Len) DO BEGIN
  395.       Insert(AssemblerCode[i], Mnemo, 255);
  396.       Inc(i);
  397.     END;
  398.     WHILE (AssemblerCode[i] = ' ') AND (i <= Len) DO Inc(i);
  399.     IF i > Len THEN BEGIN
  400.       OpAnz := 0;  Exit;
  401.     END;
  402.     WHILE (AssemblerCode[i] <> ' ') AND
  403.           (AssemblerCode[i] <> ',') AND
  404.           (i <= Len) DO BEGIN
  405.       Insert(AssemblerCode[i], Dest, 255);
  406.       Inc(i);
  407.     END;
  408.     IF (AssemblerCode[i] = ',') AND (i <= Len) THEN
  409.       IF (i < Len) THEN BEGIN
  410.         OpAnz := 2;
  411.         Inc(i);
  412.       END ELSE Error(2)
  413.     ELSE BEGIN
  414.       OpAnz := 1; Exit;
  415.     END;
  416.     WHILE (AssemblerCode[i] <> ' ') AND (i <= Len) DO BEGIN
  417.       Insert(AssemblerCode[i], Source, 255);
  418.       Inc(i);
  419.     END;
  420.   END;
  421.  
  422.   PROCEDURE Store(Code : WORD);  { schreibt Code in Puffer }
  423.   BEGIN
  424.     CharBuffer[Nr] := Code;
  425.     Inc(Nr);
  426.   END;
  427.  
  428.   PROCEDURE Init;                { Initialisierung         }
  429.   BEGIN
  430.     KeyPtr := 0;
  431.     Nr     := 0;
  432.   END;
  433.  
  434.   FUNCTION TestImm(VAR Operand : STRING) : BOOLEAN;
  435.                              { prüft ob Direktdatum        }
  436.                              { einen gültigen Wert hat     }
  437.   CONST
  438.     HexChars : SET OF CHAR = ['0'..'9', 'A'..'F'];
  439.     DezChars : SET OF CHAR = ['-', '0'..'9'];
  440.   VAR
  441.     i        : INTEGER;
  442.     Hex      : BOOLEAN;
  443.   BEGIN
  444.     TestImm := TRUE;
  445.     Hex     := Operand[1] = '$';
  446.     IF Operand[1] IN ['$','#','+'] THEN Delete(Operand,1,1);
  447.     FOR i := 1 TO Length(Operand) DO
  448.       IF ((    Hex) AND Not (Operand[i] in HexChars)) OR
  449.          ((Not Hex) AND Not (Operand[i] in DezChars)) THEN
  450.         Error(3);
  451.     IF Hex THEN Insert('$', Operand, 1);
  452.   END;
  453.  
  454.   FUNCTION SegOfs(VAR Adresse : STRING) : STRING;
  455.                     { wandelt die Adresse in Hex-Codes um  }
  456.                     { $FFFF0000  ══>  $00/$00/$FF/$FF      }
  457.   VAR
  458.     i       : INTEGER;
  459.     OneByte : STRING [4];
  460.     Dummy   : STRING [16];
  461.   BEGIN
  462.     IF (Adresse[0] <> #9) THEN Error(9);  { falsche Länge  }
  463.     FOR i := 4 DOWNTO 1 DO BEGIN
  464.       Insert('/$' + Copy(Adresse, i SHL 1, 2), OneByte, 1);
  465.       Move(OneByte[1], Dummy[(4-i) SHL 2], 4);
  466.     END;
  467.     Dummy[0] := #15;
  468.     SegOfs   := Dummy;
  469.   END;
  470.  
  471.   PROCEDURE GetOperandsType(VAR Operand : STRING;
  472.                             VAR OpSet   : OperandsType;
  473.                             VAR BW      : ByteWordType);
  474.                              { Ermittelt den Typ des       }
  475.                              { Operanden "Operand"         }
  476.   VAR
  477.     i, j : INTEGER;
  478.   BEGIN
  479.     OpSet :=[];              { OpSet löschen               }
  480.     BW    := NoLen;          { keine Datenwortbreite       }
  481.     IF Length(Operand) = 2 THEN BEGIN
  482.       i := 7;                { auf Wort-Register prüfen    }
  483.       WHILE (i >= 0) AND (WRegs[i] <> Operand) DO Dec(i);
  484.       IF i >= 0 THEN BEGIN   { wenn ja dann                }
  485.         BW := WLen;          { Datenbreite gleich WORT     }
  486.         OpSet := [Regs,EA];  { Register/Effektive Addresse }
  487.         IF i = 0 THEN        { bei i = 0 auch AX           }
  488.           OpSet := [Regs, EA, RegAW];
  489.       END ELSE BEGIN
  490.         i := 7;              { auf Byte-Register prüfen    }
  491.         WHILE (i >= 0) AND (BRegs[i] <> Operand) DO Dec(i);
  492.         IF i >= 0 THEN BEGIN
  493.           BW := BLen;        { Datenbreite gleich BYTE     }
  494.           OpSet := [Regs, EA];
  495.           IF i = 0 THEN      { bei i = 0 auch AH/AL        }
  496.             OpSet := [Regs, EA, RegAW];
  497.           IF i = 1 THEN      { bei i = 1 CL für SHIFTS u.a.}
  498.             OpSet := [Regs, EA, RegCL];
  499.         END ELSE BEGIN
  500.           i := 3;            { auf Segment-Register prüfen }
  501.           WHILE (i >= 0) AND (SRegs[i] <> Operand) DO
  502.             Dec(i);
  503.           IF i >= 0 THEN     { ja, dann Segment-Register   }
  504.             OpSet := [SegRegs]
  505.           ELSE
  506.             IF TestImm(Operand) THEN   { gültig ?          }
  507.               OpSet := [Imm];          { also Direktdatum  }
  508.         END;
  509.       END;
  510.     END ELSE { Länge Operand > 2 }
  511.       IF Operand = '[DX]' THEN
  512.         OpSet := [RegDX]     { RegDX für IN/OUT            }
  513.       ELSE BEGIN
  514.         IF Operand[1] = '[' THEN BEGIN
  515.           i := 7;            { indirekte Adresse  ?        }
  516.           WHILE (i >= 0) AND NOT FirstIn(MRegs[i], Operand)
  517.           DO Dec(i);
  518.           IF (i >= 0) AND
  519.              (Operand[Length(MRegs[i])+1] IN ['+','-',']'])
  520.           THEN OpSet := [EA]      { ja   : dann indirekt   }
  521.           ELSE OpSet := [Abs,EA]; { nein : evtl. direkt    }
  522.         END ELSE BEGIN
  523.           IF FirstIn('WORD PTR', Operand) THEN BEGIN
  524.             OpSet := [Abs,EA];    { absolute Adresse mit   }
  525.             BW := WLen;           { Datenbreite WORT       }
  526.           END ELSE
  527.             IF FirstIn('BYTE PTR', Operand) THEN BEGIN
  528.               OpSet := [Abs,EA];  { absolute Adresse mit   }
  529.               BW    := BLen;      { Datenbreite BYTE       }
  530.             END ELSE
  531.               IF TestImm(Operand) THEN  { gültig ?         }
  532.                 OpSet := [Imm];         { also Direktdatum }
  533.         END;
  534.       END;
  535.   END; { of GetOperandsType }
  536.  
  537.   PROCEDURE GetDOperandsType;     { Erklärung siehe Text   }
  538.   VAR
  539.     i           : INTEGER;
  540.     SourceType,                   { Typ des Quelloperanden }
  541.     DestType    : OperandsType;   { Typ des Zieloperanden  }
  542.     BW          : ByteWordType;
  543.   BEGIN
  544.     DOperand := [];
  545.     CASE OpAnz OF            { in Abhängigkeit von OpAnz   }
  546.       0 : DOperand := [0];   { Adressierungsart ermitteln  }
  547.       1 : BEGIN              { siehe Tabelle BegleitText   }
  548.             GetOperandsType(Dest, DestType, ByteWord);
  549.             IF Imm IN DestType THEN
  550.               DOperand := [1, 2, 8, 22, 23, 24];
  551.             IF EA IN DestType THEN
  552.               IF ByteWord = BLen THEN DOperand := [6]
  553.                                  ELSE DOperand := [5, 6];
  554.             IF (Regs IN DestType) AND (ByteWord = WLen) THEN
  555.               DOperand := DOperand + [3];
  556.             IF SegRegs IN DestType THEN DOperand := [4];
  557.           END;
  558.       2 : BEGIN
  559.             GetOperandsType(Dest, DestType, ByteWord);
  560.             GetOperandsType(Source, SourceType, BW);
  561.             IF EA IN DestType THEN BEGIN
  562.               IF RegCL IN SourceType THEN DOperand := [7];
  563.               IF Regs IN SourceType THEN
  564.                 DOperand := DOperand + [9];
  565.               IF SegRegs IN SourceType THEN
  566.                 DOperand := DOperand + [11];
  567.               IF Imm IN SourceType THEN
  568.                 DOperand := DOperand + [14, 20];
  569.             END;
  570.             IF Regs IN DestType THEN BEGIN
  571.               IF EA IN SourceType THEN
  572.                 DOperand := DOperand + [10];
  573.               IF Imm IN SourceType THEN
  574.                 DOperand := DOperand + [13];
  575.             END;
  576.             IF (SegRegs IN DestType) AND
  577.                (EA IN SourceType) THEN
  578.               DOperand := [12];
  579.             IF RegAW IN DestType THEN BEGIN
  580.               IF Abs IN SourceType THEN
  581.                 DOperand := DOperand + [15];
  582.               IF Imm IN SourceType THEN
  583.                 DOperand := DOperand + [18, 21];
  584.               IF (Regs IN SourceType) AND
  585.                  (ByteWord = WLen) THEN
  586.                 DOperand := DOperand + [17];
  587.               IF RegDX IN SourceType THEN
  588.                 DOperand := DOperand + [19];
  589.             END;
  590.             IF (Abs IN DestType) AND
  591.                (RegAW IN SourceType) THEN
  592.               DOperand := DOperand + [16];
  593.             IF ByteWord = NoLen THEN
  594.               ByteWord := BW
  595.             ELSE
  596.               IF (BW <> NoLen) AND (BW <> ByteWord) AND
  597.                     (NOT (7 IN DOperand)) THEN Error(4);
  598.           END;
  599.     END;
  600.   END; { of GetDOperandsType }
  601.  
  602.   FUNCTION CheckMnemo : BefehlType;
  603.                              { prüft ob der Befehl in der  }
  604.                              { Liste existiert             }
  605.   VAR
  606.     Bef : BefehlType;
  607.   BEGIN
  608.     BefBez[NOBEF] := Mnemo;
  609.     Bef := MOV;
  610.     WHILE Mnemo <> BefBez[Bef] DO Inc(Bef);
  611.     IF Bef = NOBEF THEN Error(5);
  612.     CheckMnemo := Bef;
  613.   END;
  614.  
  615.   FUNCTION GetBefehl : INTEGER;
  616.                              { Holt den richtigen Befehl   }
  617.                              { in Abhängigkeit der         }
  618.                              { Befehlsbezeichnung und      }
  619.                              { Adressierungsart            }
  620.   VAR
  621.     BefBez : BefehlType;
  622.     i      : INTEGER;
  623.   BEGIN
  624.     BefBez := CheckMnemo;
  625.     GetDOperandsType;
  626.     FOR i := 0 TO BefAnz DO
  627.       IF (BefBez = BefBytes[i].Befehl) AND
  628.          (BefBytes[i].AddType in DOperand) THEN BEGIN
  629.         GetBefehl := i;
  630.         Exit;                   { wenn gefunden dann EXIT  }
  631.       END;
  632.     Error(2);                   { sonst Fehler             }
  633.   END;
  634.  
  635.   FUNCTION RegNr(S : STRING) : BYTE;
  636.                              { WORD- oder BYTE-Register-   }
  637.                              { nummer ermitteln            }
  638.   VAR
  639.     i : BYTE;
  640.   BEGIN
  641.     i := 7;
  642.     WHILE (i<8) AND (S <> WRegs[i]) AND (S <> BRegs[i]) DO
  643.       Dec(i);
  644.     RegNr := i;
  645.   END;
  646.  
  647.   FUNCTION SegNr(S : STRING) : BYTE;
  648.                              { Segment-Registernummer      }
  649.                              { ermitteln                   }
  650.   VAR
  651.     i : BYTE;
  652.   BEGIN
  653.     i := 3;
  654.     WHILE (i > 0) AND (S <> SRegs[i]) DO Dec(i);
  655.     SegNr := i;
  656.   END;
  657.  
  658.   PROCEDURE InitPut;         { String Initialisieren       }
  659.   BEGIN
  660.     PutString := '  INLINE(';
  661.   END;
  662.  
  663.   PROCEDURE PutB(B : BYTE);  { HexByte in String schreiben }
  664.   CONST
  665.     Digit : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  666.   BEGIN
  667.     PutString := PutString + '$' + Digit[b SHR 4] +
  668.                  Digit[b AND $0F] + '/';
  669.   END;
  670.  
  671.   PROCEDURE PutS(S : STRING);{ String in String schreiben  }
  672.   BEGIN
  673.     PutString := PutString + S + '/';
  674.   END;
  675.  
  676.   PROCEDURE EndPut;          { String beenden              }
  677.   BEGIN
  678.     PutString[Length(PutString)] := ')';
  679.     PutString := PutString + ';' +
  680.                  Space(40-Length(PutString)) + '{ ' + Mnemo;
  681.     CASE OpAnz OF
  682.       1 : PutString := PutString +
  683.                        Space(50-Length(PutString)) + Dest;
  684.       2 : PutString := PutString +
  685.                        Space(50-Length(PutString)) + Dest +
  686.                        ',' + Source;
  687.     END;
  688.     PutString := PutString +
  689.                  Space(78-Length(PutString)) + '}';
  690.   END;
  691.  
  692.   PROCEDURE PutEA(Mask : BYTE; OP : STRING);
  693.                              { R/M Operand Compilieren     }
  694.                              { Byte 7/6   = Modus          }
  695.                              { Byte 5/4/3 = Maske          }
  696.                              { Byte 2/1/0 = Reg oder R/M   }
  697.   VAR
  698.     RM, Modus  : BYTE;
  699.     Disp       : STRING;
  700.   BEGIN
  701.     RM := RegNr(OP);             { Register ?              }
  702.     IF RM < 8 THEN Modus := 3    { wenn ja dann Modus = 3  }
  703.     ELSE BEGIN
  704.       IF OP[1] <> '[' THEN BEGIN { wenn BYTE/WORD PTR      }
  705.         i := Pos('[', OP);
  706.         IF i = 0 THEN Error(2);
  707.         Delete(OP, 1, Pred(i));  { dieses entfernen        }
  708.       END;
  709.       i := 0;                    { auf ind. Adr. prüfen    }
  710.       WHILE (i < 8) AND NOT FirstIn(MRegs[i],OP) DO Inc(i);
  711.       IF i = 8 THEN BEGIN        { nein, dann Abs. Adresse }
  712.         Modus := 0;
  713.         RM    := 6;
  714.         IF OP[Length(OP)] <> ']' THEN Error(6);
  715.         Disp  := Copy(OP, 2, Length(OP)-2);
  716.                                  { '[' und ']' entfernen   }
  717.         IF Disp[1] <> '>' THEN   { hier nur 16 Bit möglich }
  718.           Insert('>', Disp, 1);
  719.       END ELSE BEGIN
  720.         RM := i;                 { sonst indirekte Adr.    }
  721.         Disp := Copy(OP, 1+Length(MRegs[i]), 255);
  722.                                  { Displacement ermitteln  }
  723.         IF Disp[1] IN ['+', ']'] THEN
  724.           Delete(Disp, 1, 1);    { '+'/']' entfernen       }
  725.         IF Disp = '' THEN        { wenn kein Displacement  }
  726.           IF RM = 6 THEN BEGIN   { dann, wenn RM = 6       }
  727.             Modus  := 1;         { besondere Beachtung von }
  728.             Disp   := '$00';     { [BP] ═> [BP+0]          }
  729.           END ELSE Modus := 0    { also Mod.=0 kein Disp   }
  730.         ELSE BEGIN               { wenn doch Displacement  }
  731.           IF Disp[Length(Disp)] <> ']' THEN Error(1);
  732.                                  { dann mit ']' beendet    }
  733.           Dec(Disp[0]);          { ']' hinten entfernen    }
  734.           CASE Disp[1] OF        { 1. Zeichen auswerten    }
  735.             '<'   : Modus := 1;  {  8 Bit Displacement     }
  736.             '>'   : Modus := 2;            { 16 Bit Disp.  }
  737.             '$'   : IF TestImm(Disp) THEN  { gültig ?      }
  738.                       IF Length(Disp) < 4  { wenn ja dann  }
  739.                       THEN Modus := 1      { je nach Länge }
  740.                       ELSE Modus := 2;     { 1 oder 2      }
  741.             '0'..'9',
  742.             '-'   : BEGIN
  743.                       Val(Disp, i, Col);
  744.                       IF Col <> 0 THEN Error(3);
  745.                       IF (i >= -128) AND (i <= 127) THEN
  746.                         Modus := 1
  747.                       ELSE Modus := 2;
  748.                     END;
  749.             ELSE BEGIN
  750.               Insert('>', Disp, 1); { Default 16 Bit       }
  751.               Modus := 2;
  752.             END;
  753.           END; { of case }
  754.         END;
  755.       END;
  756.     END;
  757.     PutB(Mask OR RM OR Modus SHL 6); { Ergebnis eintragen  }
  758.     IF ((Modus = 0) AND (((Mask OR RM) AND 7) = 6)) OR
  759.        (Modus = 1)  OR (Modus = 2) THEN PutS(Disp);
  760.   END; { of PutEA }
  761.  
  762.   FUNCTION ImmLen(VAR S : STRING; Flag : BOOLEAN) : BYTE;
  763.                              { Datenbreite des Direkt-     }
  764.                              { datums S ermitteln          }
  765.                              { 1 = Byte/0 = Word           }
  766.   VAR
  767.     i : INTEGER;
  768.   BEGIN
  769.     CASE S[1] OF
  770.       '<'  : ImmLen := 1;
  771.       '>'  : ImmLen := 0;
  772.       '$'  : IF TestImm(S) THEN
  773.                IF Length(S) < 4 THEN ImmLen := 1
  774.                                 ELSE ImmLen := 0;
  775.       '0'..'9',
  776.       '-'  : BEGIN
  777.                Val(S, i, Col);
  778.                IF Col <> 0 THEN Error(3);
  779.                IF (i >= -128) AND (i <= 127) THEN ImmLen:=1
  780.                                              ELSE ImmLen:=0;
  781.              END;
  782.       ELSE BEGIN
  783.         ImmLen := 0;
  784.         IF Flag THEN Insert('>', S, 1);
  785.       END;
  786.     END; { of case }
  787.   END; { of ImmLen }
  788.  
  789.   PROCEDURE PutBWS(S : STRING);
  790.   VAR
  791.     Len : BYTE;
  792.   BEGIN
  793.     Len := ImmLen(S, TRUE);
  794.     IF Len <> BWOR[ByteWord] THEN PutS(S)
  795.     ELSE
  796.       IF Len = 0 THEN Error(2)
  797.       ELSE
  798.         IF S[1] = '<' THEN Error(2)
  799.                       ELSE PutS(S);
  800.   END;
  801.  
  802.   PROCEDURE PutLS(S : STRING);
  803.   VAR
  804.     Len : BYTE;
  805.   BEGIN
  806.     Len := ImmLen(S, TRUE);
  807.     IF Len <> BWOR[ByteWord] THEN PutS(S)
  808.     ELSE
  809.       IF Len = 0 THEN Error(2)
  810.       ELSE
  811.         IF S[1] = '<' THEN Error(2)
  812.                       ELSE PutS('>' + S);
  813.   END;
  814.  
  815.   PROCEDURE MakeCommand;
  816.                              { Befehl gemäß Vorschrift     }
  817.                              { zusammenbauen               }
  818.   VAR
  819.     Bef : INTEGER;
  820.   BEGIN
  821.     InitPut;
  822.     Bef := GetBefehl;
  823.     WITH BefBytes[Bef] DO
  824.       CASE AddType OF
  825.         0      : BEGIN
  826.                    PutB(First);
  827.                    IF Next > 0 THEN PutB(Next);
  828.                  END;
  829.         1, 22  : BEGIN  PutB(First);  PutS('>' + Dest)  END;
  830.         2, 8   : BEGIN  PutB(First);  PutS('<' + Dest)  END;
  831.         3      : PutB(First OR RegNr(Dest));
  832.         4      : PutB(First OR SegNr(Dest) SHL 3);
  833.         5      : BEGIN  PutB(First);  PutEA(Next,Dest)  END;
  834.         6, 7   : BEGIN
  835.                    PutB(First OR BWOR[ByteWord]);
  836.                    PutEA(Next, Dest)
  837.                  END;
  838.         9      : BEGIN
  839.                    PutB(First OR BWOR[ByteWord]);
  840.                    PutEA(RegNr(Source) SHL 3, Dest);
  841.                  END;
  842.         10     : BEGIN
  843.                    IF (Befehl IN [LDS,LEA,LES]) THEN BEGIN
  844.                                    { nur 16Bit Register    }
  845.                       IF (ByteWord <> WLen) THEN Error(7)
  846.                       ELSE ByteWord := NoLen;
  847.                    END;
  848.                    PutB(First OR BWOR[ByteWord]);
  849.                    PutEA(RegNr(Dest) SHL 3, Source);
  850.                  END;
  851.         11     : BEGIN
  852.                    PutB(First);
  853.                    PutEA(Next OR SegNr(Source) SHL 3, Dest);
  854.                  END;
  855.         12     : BEGIN
  856.                    PutB(First);
  857.                    PutEA(Next OR SegNr(Dest) SHL 3, Source);
  858.                  END;
  859.         13     : BEGIN
  860.                    PutB(First OR RegNr(Dest) OR
  861.                         BWOR[ByteWord] SHL 3);
  862.                    PutS(Source);
  863.                  END;
  864.         14     : BEGIN
  865.                    PutB(First OR BWOR[ByteWord]);
  866.                    PutEA(Next, Dest);
  867.                    PutLS(Source);
  868.                  END;
  869.         15     : BEGIN
  870.                    PutB(First OR BWOR[ByteWord]);
  871.                    PutS(Copy(Source, 2, Length(Source)-2));
  872.                  END;
  873.         16     : BEGIN
  874.                    PutB(First OR BWOR[ByteWord]);
  875.                    PutS(Copy(Dest, 2, Length(Dest)-2));
  876.                  END;
  877.         17     : PutB(First OR RegNr(Source));
  878.         18     : BEGIN
  879.                    PutB(First OR BWOR[ByteWord]);
  880.                    PutS(Source);
  881.                  END;
  882.         19     : PutB(First OR BWOR[ByteWord]);
  883.         20     : BEGIN
  884.                    PutB(First OR
  885.                         ImmLen(Source, FALSE) SHL 1 OR
  886.                         BWOR[ByteWord]);
  887.                    PutEA(Next,Dest);
  888.                    PutBWS(Source);
  889.                  END;
  890.         21     : BEGIN
  891.                    PutB(First OR BWOR[ByteWord]);
  892.                    PutLS(Source);
  893.                  END;
  894.         23     : BEGIN
  895.                    PutB(First);
  896.                    PutS(SegOfs(Dest));
  897.                  END;
  898.         24     : BEGIN
  899.                    PutB(First OR ImmLen(Dest, FALSE) SHL 1);
  900.                    PutS(Dest);
  901.                  END;
  902.       END; { of case }
  903.       EndPut;
  904.   END; { of MakeCommand }
  905.  
  906. BEGIN { of Assemble }
  907.   Init;                   { Initialisieren                 }
  908.   ReadAssemblerCode;      { Code vom Bildschirm einlesen   }
  909.   SplitLine;              { Mnemo,Dest,Source ermitteln    }
  910.   MakeCommand;            { Befehl zusammenbauen           }
  911.   Store(Home);            { an Zeilenanfang                }
  912.   Store(Ctrl_Q);          { bis Zeilenende löschen         }
  913.   Store(Ctrl_Y);
  914.   FOR i := 1 TO Length(PutString) DO
  915.     Store(Word(PutString[i]));   { Inline-Code ═> Puffer   }
  916.   Store(Home);            { und wieder an Zeilenanfang     }
  917.   Store(Down);            { und eine Zeile runter          }
  918.   KbdStart := $1E;        { Tastaturpuffer auf Anfang      }
  919.   KbdTail  := $1E;        { und löschen                    }
  920.   Inc(KbdTail, 2);        { und Tastendruck vortäuschen    }
  921. END;
  922.  
  923. {$F+}
  924. PROCEDURE Int16(Flags, CS, IP, AX, BX, CX, DX, SI, DI,
  925.                 DS, ES, BP : WORD); INTERRUPT;
  926.  
  927.   PROCEDURE ChainInt(Adress : POINTER);
  928.   INLINE($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
  929.          $EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);
  930.  
  931.   FUNCTION KeyFromOldInt16 : WORD;
  932.   INLINE($31/$C0/$9C/$FF/$1E/SaveInt16);
  933.  
  934. BEGIN
  935.   IF (Hi(AX) = 0) THEN BEGIN
  936.     IF KeyPtr < Nr THEN BEGIN   { wenn Zeichen vorliegen   }
  937.       AX := CharBuffer[KeyPtr]; { dann in AX übergeben     }
  938.       Inc(KeyPtr);              { und KeyPtr erhöhen       }
  939.       IF KeyPtr = Nr THEN
  940.         Inc(KbdStart, 2);       { und nun wieder zurück    }
  941.     END ELSE BEGIN
  942.       AX := KeyFromOldInt16;    { alten Int16 aufrufen     }
  943.       IF AX = HotKey THEN BEGIN { wenn AX = HotKey         }
  944.         SwitchStack;            { dann ...                 }
  945.         GetIntVec($16, CurrInt);
  946.         SetIntVec($16, SaveInt16);
  947.         Assemble;               { jetzt gehts los...       }
  948.         SetIntVec($16, CurrInt);
  949.         SwitchBack;
  950.       END;
  951.     END;
  952.   END ELSE ChainInt(SaveInt16);
  953. END;
  954. {$F-}
  955.  
  956. BEGIN                    { Installation des Programms      }
  957.   ProgSS := SSeg;
  958.   ProgSP := SPtr;
  959.   WriteLn(^M^J, Version, ' installiert,',
  960.           ^M^J, 'aktivieren mit ', HotkeyName,  '.');
  961.   SwapVectors;
  962.   GetIntVec($16, SaveInt16);
  963.   SetIntVec($16, @Int16);
  964.   KeyPtr := 0;
  965.   Nr     := 0;
  966.   Keep(0);
  967. END.
  968. (* ------------------------------------------------------ *)
  969. (*                 Ende von TRASH.PAS                     *)