home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / ldm / keytrash.pas next >
Encoding:
Pascal/Delphi Source File  |  1989-09-27  |  33.6 KB  |  660 lines
  1. Program Trash_mit_Tastatureingabe;
  2.  
  3. {$M 4096,0,0}
  4. {$V-}
  5.  
  6. USES DOS,CRT;
  7.  
  8. {-----------------------------------------------------------------------------}
  9. Procedure Assemble;
  10.  
  11. Type  SetType      = 0..24;
  12.       ByteWordType = (NoLen,BLen,WLen);
  13.       BefehlType   = (MOV,PUSH,POP,XCHG,IN_,OUT,XLAT,LEA,LDS,LES,LAHF,SAHF,PUSHF,
  14.                       POPF,ADD,ADC,INC_,AAA,DAA,SUB,SBB,DEC_,NEG,CMP,AAS,DAS,MUL,
  15.                       IMUL,AAM,DIV_,IDIV,AAD,CBW,CWD,NOT_,SHL_,SAL,SHR_,SAR,ROL,ROR,
  16.                       RCL,RCR,AND_,TEST,OR_,XOR_,REP,REPZ,REPE,REPNE,REPNZ,MOVSB,CMPSB,
  17.                       SCASB,LODSB,STOSB,CALL,JMP,RET,JE,JZ,JL,JNGE,JLE,JNG,JB,JNAE,JP,JPE,JO,
  18.                       JS,JNE,JNZ,JNL,JGE,JNLE,JG,JNB,JAE,JNBE,JA,JNP,JPO,JNO,JNS,JNA,JBE,
  19.                       LOOP,LOOPZ,LOOPE,LOOPNZ,LOOPNE,JCXZ,INT,INTO,IRET,CLC,STC,
  20.                       CMC,CLD,CLI,HLT,LOCK,NOP,STD,STI,WAIT,MOVSW,CMPSW,SCASW,
  21.                       LODSW,STOSW,CALLF,RETF,JMPF,CS,SS,DS,ES,NOBEF);
  22.  
  23. const BefBez : Array[BefehlType] of String[6] =
  24.                     ('MOV','PUSH','POP','XCHG','IN','OUT','XLAT','LEA','LDS','LES','LAHF','SAHF','PUSHF',
  25.                      'POPF','ADD','ADC','INC','AAA','DAA','SUB','SBB','DEC','NEG','CMP','AAS','DAS','MUL',
  26.                      'IMUL','AAM','DIV','IDIV','AAD','CBW','CWD','NOT','SHL','SAL','SHR','SAR','ROL','ROR',
  27.                      'RCL','RCR','AND','TEST','OR','XOR','REP','REPZ','REPE','REPNE','REPNZ','MOVSB','CMPSB','SCASB',
  28.                      'LODSB','STOSB','CALL','JMP','RET','JE','JZ','JL','JNGE','JLE','JNG','JB','JNAE','JP','JPE','JO',
  29.                      'JS','JNE','JNZ','JNL','JGE','JNLE','JG','JNB','JAE','JNBE','JA','JNP','JPO','JNO','JNS','JNA',
  30.                      'JBE','LOOP','LOOPZ','LOOPE','LOOPNZ','LOOPNE','JCXZ','INT','INTO','IRET','CLC','STC',
  31.                      'CMC','CLD','CLI','HLT','LOCK','NOP','STD','STI','WAIT','MOVSW','CMPSW','SCASW',
  32.                      'LODSW','STOSW','CALLF','RETF','JMPF','CS:','SS:','DS:','ES:','NOBEF');
  33.  
  34.       BefAnz   = 178;
  35.       BefBytes : Array[0..BefAnz] of record
  36.                                     Befehl     : BefehlType;
  37.                                     AddType    : SetType;
  38.                                     first,next : Byte;
  39.                                   end  =
  40.                      ((Befehl  : MOV;    AddType : 15; first : $A0; next : $00),
  41.                       (Befehl  : MOV;    AddType : 16; first : $A2; next : $00),
  42.                       (Befehl  : MOV;    AddType : 13; first : $B0; next : $00),
  43.                       (Befehl  : MOV;    AddType :  9; first : $88; next : $00),
  44.                       (Befehl  : MOV;    AddType : 10; first : $8A; next : $00),
  45.                       (Befehl  : MOV;    AddType : 11; first : $8C; next : $00),
  46.                       (Befehl  : MOV;    AddType : 12; first : $8E; next : $00),
  47.                       (Befehl  : MOV;    AddType : 14; first : $C6; next : $00),
  48.                       (Befehl  : PUSH;   AddType : 03; first : $50; next : $00),
  49.                       (Befehl  : PUSH;   AddType : 04; first : $06; next : $00),
  50.                       (Befehl  : PUSH;   AddType : 05; first : $FF; next : $30),
  51.                       (Befehl  : POP;    AddType : 03; first : $58; next : $00),
  52.                       (Befehl  : POP;    AddType : 04; first : $07; next : $00),
  53.                       (Befehl  : POP;    AddType : 05; first : $8F; next : $00),
  54.                       (Befehl  : XCHG;   AddType : 17; first : $90; next : $00),
  55.                       (Befehl  : XCHG;   AddType : 09; first : $86; next : $00),
  56.                       (Befehl  : XCHG;   AddType : 10; first : $86; next : $00),
  57.                       (Befehl  : IN_;    AddType : 18; first : $E4; next : $00),
  58.                       (Befehl  : IN_;    AddType : 19; first : $EC; next : $00),
  59.                       (Befehl  : OUT;    AddType : 18; first : $E6; next : $00),
  60.                       (Befehl  : OUT;    AddType : 19; first : $EE; next : $00),
  61.                       (Befehl  : XLAT;   AddType : 00; first : $D7; next : $00),
  62.                       (Befehl  : LEA;    AddType : 10; first : $8D; next : $00),
  63.                       (Befehl  : LDS;    AddType : 10; first : $C5; next : $00),
  64.                       (Befehl  : LES;    AddType : 10; first : $C4; next : $00),
  65.                       (Befehl  : LAHF;   AddType : 00; first : $9F; next : $00),
  66.                       (Befehl  : SAHF;   AddType : 00; first : $9E; next : $00),
  67.                       (Befehl  : PUSHF;  AddType : 00; first : $9C; next : $00),
  68.                       (Befehl  : POPF;   AddType : 00; first : $9D; next : $00),
  69.                       (Befehl  : ADD;    AddType : 21; first : $04; next : $00),
  70.                       (Befehl  : ADD;    AddType : 09; first : $00; next : $00),
  71.                       (Befehl  : ADD;    AddType : 10; first : $02; next : $00),
  72.                       (Befehl  : ADD;    AddType : 20; first : $80; next : $00),
  73.                       (Befehl  : ADC;    AddType : 21; first : $14; next : $00),
  74.                       (Befehl  : ADC;    AddType : 09; first : $10; next : $00),
  75.                       (Befehl  : ADC;    AddType : 10; first : $12; next : $00),
  76.                       (Befehl  : ADC;    AddType : 20; first : $80; next : $10),
  77.                       (Befehl  : INC_;   AddType : 03; first : $40; next : $00),
  78.                       (Befehl  : INC_;   AddType : 06; first : $FE; next : $00),
  79.                       (Befehl  : AAA;    AddType : 00; first : $37; next : $00),
  80.                       (Befehl  : DAA;    AddType : 00; first : $27; next : $00),
  81.                       (Befehl  : SUB;    AddType : 21; first : $4C; next : $00),
  82.                       (Befehl  : SUB;    AddType : 09; first : $28; next : $00),
  83.                       (Befehl  : SUB;    AddType : 10; first : $2A; next : $00),
  84.                       (Befehl  : SUB;    AddType : 20; first : $80; next : $28),
  85.                       (Befehl  : SBB;    AddType : 21; first : $1C; next : $00),
  86.                       (Befehl  : SBB;    AddType : 09; first : $18; next : $00),
  87.                       (Befehl  : SBB;    AddType : 10; first : $1A; next : $00),
  88.                       (Befehl  : SBB;    AddType : 20; first : $80; next : $18),
  89.                       (Befehl  : DEC_;   AddType : 03; first : $48; next : $00),
  90.                       (Befehl  : DEC_;   AddType : 06; first : $FE; next : $00),
  91.                       (Befehl  : NEG;    AddType : 06; first : $F6; next : $18),
  92.                       (Befehl  : CMP;    AddType : 21; first : $3C; next : $00),
  93.                       (Befehl  : CMP;    AddType : 20; first : $80; next : $38),
  94.                       (Befehl  : CMP;    AddType : 09; first : $38; next : $00),
  95.                       (Befehl  : CMP;    AddType : 10; first : $3A; next : $00),
  96.                       (Befehl  : AAS;    AddType : 00; first : $3F; next : $00),
  97.                       (Befehl  : DAS;    AddType : 00; first : $2F; next : $00),
  98.                       (Befehl  : MUL;    AddType : 06; first : $F6; next : $20),
  99.                       (Befehl  : IMUL;   AddType : 06; first : $F6; next : $28),
  100.                       (Befehl  : AAM;    AddType : 00; first : $D4; next : $0A),
  101.                       (Befehl  : DIV_;   AddType : 06; first : $F6; next : $30),
  102.                       (Befehl  : IDIV;   AddType : 06; first : $F6; next : $38),
  103.                       (Befehl  : AAD;    AddType : 00; first : $D5; next : $0A),
  104.                       (Befehl  : CBW;    AddType : 00; first : $98; next : $00),
  105.                       (Befehl  : CWD;    AddType : 00; first : $99; next : $00),
  106.                       (Befehl  : NOT_;   AddType : 06; first : $F6; next : $10),
  107.                       (Befehl  : SHL_;   AddType : 06; first : $D0; next : $20),
  108.                       (Befehl  : SHL_;   AddType : 07; first : $D2; next : $20),
  109.                       (Befehl  : SAL;    AddType : 06; first : $D0; next : $20),
  110.                       (Befehl  : SAL;    AddType : 07; first : $D2; next : $20),
  111.                       (Befehl  : SHR_;   AddType : 06; first : $D0; next : $28),
  112.                       (Befehl  : SHR_;   AddType : 07; first : $D2; next : $28),
  113.                       (Befehl  : SAR;    AddType : 06; first : $D0; next : $38),
  114.                       (Befehl  : SAR;    AddType : 07; first : $D2; next : $38),
  115.                       (Befehl  : ROL;    AddType : 06; first : $D0; next : $00),
  116.                       (Befehl  : ROL;    AddType : 07; first : $D2; next : $00),
  117.                       (Befehl  : ROR;    AddType : 06; first : $D0; next : $08),
  118.                       (Befehl  : ROR;    AddType : 07; first : $D2; next : $08),
  119.                       (Befehl  : RCL;    AddType : 06; first : $D0; next : $10),
  120.                       (Befehl  : RCL;    AddType : 07; first : $D2; next : $10),
  121.                       (Befehl  : RCR;    AddType : 06; first : $D0; next : $18),
  122.                       (Befehl  : RCR;    AddType : 07; first : $D2; next : $18),
  123.                       (Befehl  : AND_;   AddType : 21; first : $24; next : $00),
  124.                       (Befehl  : AND_;   AddType : 14; first : $80; next : $20),
  125.                       (Befehl  : AND_;   AddType : 09; first : $20; next : $00),
  126.                       (Befehl  : AND_;   AddType : 10; first : $22; next : $00),
  127.                       (Befehl  : TEST;   AddType : 21; first : $A8; next : $00),
  128.                       (Befehl  : TEST;   AddType : 14; first : $F6; next : $00),
  129.                       (Befehl  : TEST;   AddType : 09; first : $84; next : $00),
  130.                       (Befehl  : TEST;   AddType : 10; first : $84; next : $00),
  131.                       (Befehl  : OR_;    AddType : 21; first : $0C; next : $00),
  132.                       (Befehl  : OR_;    AddType : 14; first : $80; next : $08),
  133.                       (Befehl  : OR_;    AddType : 09; first : $08; next : $00),
  134.                       (Befehl  : OR_;    AddType : 10; first : $0A; next : $00),
  135.                       (Befehl  : XOR_;   AddType : 21; first : $34; next : $00),
  136.                       (Befehl  : XOR_;   AddType : 14; first : $80; next : $30),
  137.                       (Befehl  : XOR_;   AddType : 09; first : $30; next : $00),
  138.                       (Befehl  : XOR_;   AddType : 10; first : $32; next : $00),
  139.                       (Befehl  : REP;    AddType : 00; first : $F2; next : $00),
  140.                       (Befehl  : REPZ;   AddType : 00; first : $F3; next : $00),
  141.                       (Befehl  : REPNZ;  AddType : 00; first : $F2; next : $00),
  142.                       (Befehl  : REPE;   AddType : 00; first : $F3; next : $00),
  143.                       (Befehl  : REPNE;  AddType : 00; first : $F2; next : $00),
  144.                       (Befehl  : MOVSB;  AddType : 00; first : $A4; next : $00),
  145.                       (Befehl  : CMPSB;  AddType : 00; first : $A6; next : $00),
  146.                       (Befehl  : SCASB;  AddType : 00; first : $AE; next : $00),
  147.                       (Befehl  : LODSB;  AddType : 00; first : $AC; next : $00),
  148.                       (Befehl  : STOSB;  AddType : 00; first : $AA; next : $00),
  149.                       (Befehl  : CALL;   AddType : 22; first : $E8; next : $00),
  150.                       (Befehl  : CALL;   AddType : 05; first : $FF; next : $10),
  151.                       (Befehl  : JMP;    AddType : 05; first : $FF; next : $20),
  152.                       (Befehl  : JMP;    AddType : 24; first : $E9; next : $00),
  153.                       (Befehl  : RET;    AddType : 00; first : $C3; next : $00),
  154.                       (Befehl  : RET;    AddType : 01; first : $C2; next : $00),
  155.                       (Befehl  : JE;     AddType : 02; first : $74; next : $00),
  156.                       (Befehl  : JZ;     AddType : 02; first : $74; next : $00),
  157.                       (Befehl  : JL;     AddType : 02; first : $7C; next : $00),
  158.                       (Befehl  : JNGE;   AddType : 02; first : $7C; next : $00),
  159.                       (Befehl  : JLE;    AddType : 02; first : $7E; next : $00),
  160.                       (Befehl  : JNG;    AddType : 02; first : $7E; next : $00),
  161.                       (Befehl  : JB;     AddType : 02; first : $72; next : $00),
  162.                       (Befehl  : JNAE;   AddType : 02; first : $72; next : $00),
  163.                       (Befehl  : JP;     AddType : 02; first : $7A; next : $00),
  164.                       (Befehl  : JPE;    AddType : 02; first : $7A; next : $00),
  165.                       (Befehl  : JO;     AddType : 02; first : $70; next : $00),
  166.                       (Befehl  : JS;     AddType : 02; first : $78; next : $00),
  167.                       (Befehl  : JNE;    AddType : 02; first : $75; next : $00),
  168.                       (Befehl  : JNZ;    AddType : 02; first : $75; next : $00),
  169.                       (Befehl  : JNL;    AddType : 02; first : $7D; next : $00),
  170.                       (Befehl  : JGE;    AddType : 02; first : $7D; next : $00),
  171.                       (Befehl  : JNLE;   AddType : 02; first : $7F; next : $00),
  172.                       (Befehl  : JG;     AddType : 02; first : $7F; next : $00),
  173.                       (Befehl  : JNB;    AddType : 02; first : $73; next : $00),
  174.                       (Befehl  : JAE;    AddType : 02; first : $73; next : $00),
  175.                       (Befehl  : JNBE;   AddType : 02; first : $77; next : $00),
  176.                       (Befehl  : JA;     AddType : 02; first : $77; next : $00),
  177.                       (Befehl  : JNP;    AddType : 02; first : $7B; next : $00),
  178.                       (Befehl  : JPO;    AddType : 02; first : $7B; next : $00),
  179.                       (Befehl  : JNO;    AddType : 02; first : $71; next : $00),
  180.                       (Befehl  : JNS;    AddType : 02; first : $79; next : $00),
  181.                       (Befehl  : JNA;    AddType : 02; first : $76; next : $00),
  182.                       (Befehl  : JBE;    AddType : 02; first : $76; next : $00),
  183.                       (Befehl  : LOOP;   AddType : 02; first : $E2; next : $00),
  184.                       (Befehl  : LOOPZ;  AddType : 02; first : $E1; next : $00),
  185.                       (Befehl  : LOOPE;  AddType : 02; first : $E1; next : $00),
  186.                       (Befehl  : LOOPNZ; AddType : 02; first : $E0; next : $00),
  187.                       (Befehl  : LOOPNE; AddType : 02; first : $E0; next : $00),
  188.                       (Befehl  : JCXZ;   AddType : 02; first : $E3; next : $00),
  189.                       (Befehl  : INT;    AddType : 08; first : $CD; next : $00),
  190.                       (Befehl  : INTO;   AddType : 00; first : $CE; next : $00),
  191.                       (Befehl  : IRET;   AddType : 00; first : $CF; next : $00),
  192.                       (Befehl  : CLC;    AddType : 00; first : $F8; next : $00),
  193.                       (Befehl  : STC;    AddType : 00; first : $F9; next : $00),
  194.                       (Befehl  : CMC;    AddType : 00; first : $F5; next : $00),
  195.                       (Befehl  : CLD;    AddType : 00; first : $FC; next : $00),
  196.                       (Befehl  : CLI;    AddType : 00; first : $FA; next : $00),
  197.                       (Befehl  : HLT;    AddType : 00; first : $F4; next : $00),
  198.                       (Befehl  : LOCK;   AddType : 00; first : $F0; next : $00),
  199.                       (Befehl  : NOP;    AddType : 00; first : $90; next : $00),
  200.                       (Befehl  : STD;    AddType : 00; first : $FD; next : $00),
  201.                       (Befehl  : STI;    AddType : 00; first : $FB; next : $00),
  202.                       (Befehl  : WAIT;   AddType : 00; first : $9B; next : $00),
  203.                       (Befehl  : MOVSW;  AddType : 00; first : $A5; next : $00),
  204.                       (Befehl  : CMPSW;  AddType : 00; first : $A7; next : $00),
  205.                       (Befehl  : SCASW;  AddType : 00; first : $AF; next : $00),
  206.                       (Befehl  : LODSW;  AddType : 00; first : $AD; next : $00),
  207.                       (Befehl  : STOSW;  AddType : 00; first : $AB; next : $00),
  208.                       (Befehl  : CALLF;  AddType : 05; first : $FF; next : $18),
  209.                       (Befehl  : CALLF;  AddType : 23; first : $9A; next : $00),
  210.                       (Befehl  : JMPF;   AddType : 05; first : $FF; next : $28),
  211.                       (Befehl  : JMPF;   AddType : 23; first : $EA; next : $00),
  212.                       (Befehl  : RETF;   AddType : 00; first : $CB; next : $00),
  213.                       (Befehl  : RETF;   AddType : 01; first : $CA; next : $00),
  214.                       (Befehl  : LAHF;   AddType : 00; first : $9F; next : $00),
  215.                       (Befehl  : CS;     AddType : 00; first : $2E; next : $00),
  216.                       (Befehl  : SS;     AddType : 00; first : $36; next : $00),
  217.                       (Befehl  : DS;     AddType : 00; first : $3E; next : $00),
  218.                       (Befehl  : ES;     AddType : 00; first : $26; next : $00));
  219.  
  220.       WRegs : Array[0..7] of String[2] = ('AX','CX','DX','BX','SP','BP','SI','DI');
  221.       BRegs : Array[0..7] of String[2] = ('AL','CL','DL','BL','AH','CH','DH','BH');
  222.       SRegs : Array[0..3] of String[2] = ('ES','CS','SS','DS');
  223.       MRegs : Array[0..7] of String[6] = ('[BX+SI','[BX+DI','[BP+SI','[BP+DI','[SI','[DI','[BP','[BX');
  224.       BWOR  : Array[ByteWordType] of Byte = (0,0,1);
  225.       Syntax = 1;
  226.  
  227. type  Operands      = (nichts,Imm,Regs,EA,SegRegs,Abs,RegCl,RegDX,RegAW);
  228.       OperandsType  = Set of Operands;
  229.       DOperandsType = Set of SetType;
  230.  
  231. var   DOperand               : DOperandsType;
  232.       ByteWord               : ByteWordType;
  233.       PutString,
  234.       AssemblerCode,Mnemo,
  235.       Source,Dest            : String[80];
  236.       OpAnz,i,Col            : Integer;
  237.  
  238.   {---------------------------------------------------------------------------}
  239.   procedure Error(Nr : Byte);
  240.   begin
  241.     WriteLn(^G,'Fehler');
  242.     Halt;
  243.   end;
  244.   {---------------------------------------------------------------------------}
  245.   procedure UpString(var Str1 : String);
  246.   var i : Integer;
  247.   begin
  248.     for i := 1 to length(Str1) do Str1[i] := UpCase(Str1[i]);
  249.   end;
  250.   {---------------------------------------------------------------------------}
  251.   function FirstIn(Str1,Str2 : String) : Boolean;
  252.   var ip : Integer;
  253.   begin
  254.     FirstIn := TRUE;
  255.     if length(Str1) > length(Str2) then FirstIn := FALSE
  256.     else  for ip := 1 to length(Str1) do
  257.       if Str1[ip] <> Str2[ip] then FirstIn := FALSE
  258.   end;
  259.   {---------------------------------------------------------------------------}
  260.   procedure SplitLine;
  261.   var i   : Integer;
  262.       Len : Byte ABSOLUTE AssemblerCode;
  263.   begin
  264.     OpAnz := 0;
  265.     i     := 1;
  266.     Mnemo := ''; Source := ''; Dest := '';
  267.     while (AssemblerCode[i] <> ' ') AND (i <= Len) do begin
  268.       Insert(AssemblerCode[i],Mnemo,255);
  269.       Inc(i);
  270.     end;
  271.     while (AssemblerCode[i] = ' ')  AND (i <= Len) do Inc(i);
  272.     if i > Len then begin OpAnz := 0; Exit; end;
  273.     while (AssemblerCode[i] <> ' ') AND
  274.           (AssemblerCode[i] <> ',') AND
  275.           (i <= Len) do begin
  276.       Insert(AssemblerCode[i],Dest,255);
  277.       Inc(i);
  278.     end;
  279.     if (AssemblerCode[i] = ',') AND (i <= Len) then
  280.       if (i < Len) then begin
  281.         OpAnz := 2;
  282.         Inc(i);
  283.       end else Error(Syntax)
  284.     else begin OpAnz := 1; Exit; end;
  285.     while (AssemblerCode[i] <> ' ') AND (i <= Len) do begin
  286.       Insert(AssemblerCode[i],Source,255);
  287.       Inc(i);
  288.     end
  289.   end;
  290.   {---------------------------------------------------------------------------}
  291.   function TestImm(var Operand : String) : Boolean;
  292.   const HexChars : Set of Char = ['0'..'9','A'..'F'];
  293.         DezChars : Set of Char = ['-','0'..'9'];
  294.   var   i        : Integer;
  295.         Hex      : Boolean;
  296.   begin
  297.     TestImm := TRUE;
  298.     Hex     := Operand[1] = '$';
  299.     if Operand[length(Operand)] = 'H' then delete(Operand,length(Operand),1);
  300.     if Operand[1] in ['$','#'] then delete(Operand,1,1);
  301.     for i := 1 to length(Operand) do
  302.       if ((    Hex) AND Not (Operand[i] in HexChars)) OR
  303.          ((Not Hex) AND Not (Operand[i] in DezChars))
  304.       then Error(Syntax);
  305.     if Hex then Insert('$',Operand,1);
  306.   end;
  307.   {---------------------------------------------------------------------------}
  308.   function SegOfs(var Adresse : String) : String;
  309.   var i       : Integer;
  310.       OneByte : String[4];
  311.       Dummy   : String[16];
  312.   begin
  313.     if (Adresse[0] <>  #9) then Error(Syntax);        { falsche Länge         }
  314.     for i := 4 downto 1 do begin
  315.       Insert('/$'+copy(Adresse,i SHL 1,2),OneByte,1);
  316.       move(OneByte[1],Dummy[(4-i) SHL 2],4);
  317.     end;
  318.     Dummy[0] := #15;
  319.     SegOfs := Dummy;
  320.   end;
  321.   {---------------------------------------------------------------------------}
  322.   procedure GetOperandsType(var Operand : String;
  323.                             var OpSet   : OperandsType;
  324.                             var BW      : ByteWordType);
  325.   var   i,j   : Integer;
  326.   begin
  327.     OpSet :=[];
  328.     BW    := NoLen;
  329.     if length(Operand) = 2 then begin
  330.       i := 7;
  331.       while (i >= 0) AND (WRegs[i] <> Operand) do Dec(i);
  332.       if i >= 0 then begin
  333.         BW := WLen;
  334.         OpSet := [Regs,EA];
  335.         if i = 0 then OpSet := [Regs,EA,RegAW];
  336.       end else begin
  337.         i := 7;
  338.         while (i >= 0) AND (BRegs[i] <> Operand) do Dec(i);
  339.         if i >= 0 then begin
  340.           BW := BLen;
  341.           OpSet := [Regs,EA];
  342.           if i = 0 then OpSet := [Regs,EA,RegAW];
  343.           if i = 1 then OpSet := [Regs,EA,RegCL];
  344.         end else begin
  345.           i := 3;
  346.           while (i >= 0) AND (SRegs[i] <> Operand) do Dec(i);
  347.           if i >= 0 then OpSet := [SegRegs]
  348.                     else if TestImm(Operand) then OpSet := [Imm];
  349.         end;
  350.       end;
  351.     end else if Operand = '[DX]' then OpSet := [RegDX] else begin
  352.       if Operand[1] = '[' then begin
  353.         i := 7;
  354.         while (i >= 0) AND NOT FirstIn(MRegs[i],Operand) do Dec(i);
  355.         if (i >= 0) AND (Operand[succ(length(MRegs[i]))] in ['+',']','-'])
  356.         then OpSet := [EA]
  357.         else OpSet := [Abs,EA];
  358.       end else begin
  359.         if FirstIn('WORD PTR',Operand) then begin
  360.           OpSet := [Abs,EA];
  361.           BW := WLen;
  362.         end else if FirstIn('BYTE PTR',Operand) then begin
  363.                    OpSet := [Abs,EA];
  364.                    BW    := BLen;
  365.                  end else if TestImm(Operand) then OpSet := [Imm];
  366.       end;
  367.     end;
  368.   end;
  369.   {---------------------------------------------------------------------------}
  370.   procedure GetDOperandsType;
  371.   var i           : integer;
  372.       SourceType,
  373.       DestType    : OperandsType;
  374.       BW          : ByteWordType;
  375.   begin
  376.     DOperand := [];
  377.     case OpAnz of
  378.       0 : DOperand := [0];
  379.       1 : begin
  380.             GetOperandsType(Dest,DestType,ByteWord);
  381.             if Imm in DestType then DOperand := [1,2,8,22,23,24];
  382.             if EA in DestType then if ByteWord = BLen then DOperand := [6]
  383.                                                       else DOperand := [5,6];
  384.             if (Regs in DestType) AND (ByteWord = WLen) then
  385.               DOperand := DOperand + [3];
  386.             if SegRegs in DestType then DOperand := [4];
  387.           end;
  388.       2 : begin
  389.             GetOperandsType(Dest,DestType,ByteWord);
  390.             GetOperandsType(Source,SourceType,BW);
  391.             if EA in DestType then begin
  392.               if RegCL in SourceType then DOperand := [7];
  393.               if Regs in SourceType then DOperand := DOperand + [9];
  394.               if SegRegs in SourceType then DOperand := DOperand + [11];
  395.               if Imm in SourceType then DOperand := DOperand + [14,20];
  396.             end;
  397.             if Regs in DestType then begin
  398.               if EA in SourceType then DOperand := DOperand + [10];
  399.               if Imm in SourceType then DOperand := DOperand + [13];
  400.             end;
  401.             if (SegRegs in DestType) AND (EA in SourceType) then
  402.               DOperand := [12];
  403.             if RegAW in DestType then begin
  404.               if Abs in SourceType then DOperand := DOperand + [15];
  405.               if Imm in SourceType then DOperand := DOperand + [18,21];
  406.               if (Regs in SourceType) AND (ByteWord = WLen) then
  407.                 DOperand := DOperand + [17];
  408.               if RegDX in SourceType then DOperand := DOperand + [19];
  409.             end;
  410.             if (Abs in DestType) AND (RegAW in SourceType) then
  411.               DOperand := DOperand + [16];
  412.             if ByteWord = NoLen then ByteWord := BW
  413.             else if (BW <> NoLen) AND (BW <> ByteWord) AND (Not (7 in DOperand))
  414.                                        then Error(Syntax);
  415.           end;
  416.     end;
  417.   end; { of GetDOperandsType }
  418.   {---------------------------------------------------------------------------}
  419.   function CheckMnemo : BefehlType;
  420.   var Bef : BefehlType;
  421.   begin
  422.     if length(Mnemo) > 6 then Error(Syntax);
  423.     BefBez[NOBEF] := Mnemo;
  424.     Bef := MOV;
  425.     while Mnemo <> BefBez[Bef] do Inc(Bef);
  426.     if Bef = NOBEF then Error(Syntax);
  427.     CheckMnemo := Bef;
  428.   end;
  429.   {---------------------------------------------------------------------------}
  430.   function GetBefehl : Integer;
  431.   var BefBez : BefehlType;
  432.       i      : Integer;
  433.   begin
  434.     BefBez := CheckMnemo;
  435.     GetDOperandsType;
  436.     for i := 0 to BefAnz do
  437.       if (BefBez = BefBytes[i].Befehl) AND
  438.          (BefBytes[i].AddType in DOperand) then begin
  439.         GetBefehl := i;
  440.         exit;
  441.       end;
  442.     Error(Syntax);
  443.   end;
  444.   {---------------------------------------------------------------------------}
  445.   function Space(len : Byte) : String;
  446.   var Dummy : String[80];
  447.   begin
  448.     FillChar(Dummy[1],Len,32);
  449.     Dummy[0] := chr(len);
  450.     Space := Dummy;
  451.   end;
  452.   {---------------------------------------------------------------------------}
  453.   procedure InitPut;
  454.   begin
  455.     PutString := 'INLINE(';
  456.   end;
  457.   {---------------------------------------------------------------------------}
  458.   function HexB(b : Byte) : String;
  459.   const Digit : Array[0..15] of Char = '0123456789ABCDEF';
  460.   begin
  461.     HexB := Digit[b shr 4] + Digit[b AND $0F];
  462.   end;
  463.   {---------------------------------------------------------------------------}
  464.   procedure PutB(B : Byte);
  465.   begin
  466.     PutString := PutString + '$' + HexB(b) + '/';
  467.   end;
  468.   {---------------------------------------------------------------------------}
  469.   procedure PutS(S : String);
  470.   begin
  471.     PutString := PutString + S + '/';
  472.   end;
  473.   {---------------------------------------------------------------------------}
  474.   procedure EndPut;
  475.   begin
  476.     PutString[length(PutString)] := ')';
  477.     PutString := PutString + ';' + Space(30-length(PutString)) + '{ '+Mnemo;
  478.     case OpAnz of
  479.       1 : PutString := PutString + Space(40-length(PutString)) + Dest;
  480.       2 : PutString := PutString + Space(40-length(PutString)) + Dest+','+Source;
  481.     end;
  482.     PutString := PutString + Space(68-length(PutString)) + '}';
  483.   end;
  484.   {---------------------------------------------------------------------------}
  485.   function RegNr(S : String) : Byte;
  486.   var i : Byte;
  487.   begin
  488.     i := 7;
  489.     while (i<8) AND (S <> WRegs[i]) AND (S <> BRegs[i]) do Dec(i);
  490.     RegNr := i;
  491.   end;
  492.   {---------------------------------------------------------------------------}
  493.   function SegNr(S : String) : Byte;
  494.   var i : Byte;
  495.   begin
  496.     i := 3;
  497.     while (i>0) AND (S <> SRegs[i])  do Dec(i);
  498.     SegNr := i;
  499.   end;
  500.   {---------------------------------------------------------------------------}
  501.   procedure PutEA(Mask : Byte;OP : String);
  502.   var RM,
  503.       Modus  : Byte;
  504.       Disp   : String;
  505.   begin
  506.     RM := RegNr(OP);
  507.     if RM < 8 then Modus := 3
  508.     else begin
  509.       if OP[1] <> '[' then begin
  510.         i := pos('[',OP);
  511.         if i = 0 then Error(Syntax);
  512.         delete(OP,1,pred(i));
  513.       end;
  514.       i := 0;
  515.       while (i < 8) AND NOT FirstIn(MRegs[i],OP) do Inc(i);
  516.       if i = 8 then begin
  517.         Modus := 0;
  518.         RM    := 6;
  519.         if OP[length(OP)] <> ']' then Error(Syntax);
  520.         Disp  := copy(OP,2,length(OP)-2);
  521.         if Disp[1] <> '>' then insert('>',Disp,1);
  522.       end else begin
  523.         RM := i;
  524.         Disp := copy(OP,succ(length(MRegs[i])),255);
  525.         if Disp[1] in ['+',']'] then Delete(Disp,1,1);
  526.         if Disp = '' then if RM = 6 then begin
  527.                             Modus  := 1;
  528.                             Disp := '$00';
  529.                           end else Modus := 0
  530.                      else begin
  531.                        if Disp[length(Disp)] <> ']' then Error(Syntax);
  532.                        Dec(Disp[0]);
  533.                        case Disp[1] of
  534.                          '<'     : Modus := 1;
  535.                          '>'     : Modus := 2;
  536.                          '$'     : if TestImm(Disp) then
  537.                                      if length(Disp) < 4 then Modus := 1
  538.                                                          else Modus := 2;
  539.                          '0'..'9',
  540.                          '-'     : begin
  541.                                      val(Disp,i,Col);
  542.                                      if Col <> 0 then Error(Syntax);
  543.                                      if (i >= -128) AND (i <= 127) then Modus := 1
  544.                                                                    else Modus := 2;
  545.                                    end;
  546.                          else begin
  547.                            insert('>',Disp,1);
  548.                            Modus := 2;
  549.                          end;
  550.                        end; { of case }
  551.                      end;
  552.       end;
  553.     end;
  554.     PutB(Mask OR RM OR Modus SHL 6);
  555.     if ((Modus = 0) AND (((Mask OR RM) AND 7) = 6))  OR (Modus = 1) OR (Modus = 2) then PutS(Disp);
  556.   end; { of PutEA }
  557.   {---------------------------------------------------------------------------}
  558.   function ImmLen(var S : String;Flag : Boolean) : Byte;
  559.   var i : Integer;
  560.   begin
  561.     case S[1] of
  562.       '<'  : ImmLen := 1;
  563.       '>'  : ImmLen := 0;
  564.       '$'  : if TestImm(S) then
  565.                if length(s) < 4 then ImmLen := 1
  566.                                 else ImmLen := 0;
  567.       '0'..'9',
  568.       '-'  : begin
  569.                val(S,i,Col);
  570.                if Col <> 0 then Error(Syntax);
  571.                if (i >= -128) AND (i <= 127) then ImmLen := 1
  572.                                              else ImmLen := 0;
  573.              end;
  574.       else begin
  575.         ImmLen := 0;
  576.         if Flag then insert('>',S,1);
  577.       end;
  578.     end; { of case }
  579.   end; { of ImmLen }
  580.   {---------------------------------------------------------------------------}
  581.   procedure PutBWS(S : String);
  582.   var Len : Byte;
  583.   begin
  584.     Len := ImmLen(S,TRUE);
  585.     if Len <> BWOR[ByteWord] then PutS(S)
  586.                              else if Len = 0 then Error(Syntax)
  587.                              else if S[1] = '<' then Error(Syntax)
  588.                              else PutS(S);
  589.   end;
  590.   {---------------------------------------------------------------------------}
  591.   procedure PutLS(S : String);
  592.   var Len : Byte;
  593.   begin
  594.     Len := ImmLen(S,TRUE);
  595.     if Len <> BWOR[ByteWord] then PutS(S)
  596.                              else if Len = 0 then Error(Syntax)
  597.                              else if S[1] = '<' then Error(Syntax)
  598.                              else PutS('>'+S);
  599.   end;
  600.   {---------------------------------------------------------------------------}
  601.   procedure MakeCommand;
  602.   var Bef : Integer;
  603.   begin
  604.     InitPut;
  605.     Bef := GetBefehl;
  606.     with BefBytes[Bef] do
  607.       case AddType of
  608.         0      : begin PutB(First); if Next > 0 then PutB(Next) end;
  609.         1,22   : begin PutB(First); PutS('>'+Dest)              end;
  610.         2,8    : begin PutB(First); PutS('<'+Dest)              end;
  611.         3      : PutB(First OR RegNr(Dest));
  612.         4      : PutB(First OR SegNr(Dest) SHL 3);
  613.         5      : begin PutB(First); PutEA(Next,Dest)            end;
  614.         6,7    : begin PutB(First OR BWOR[ByteWord]); PutEA(Next,Dest) end;
  615.         9      : begin PutB(First OR BWOR[ByteWord]); PutEA(RegNr(Source) SHL 3,Dest) end;
  616.         10     : begin
  617.                    if (Befehl in [LDS,LEA,LES]) then begin
  618.                       if (ByteWord <> WLen) then Error(Syntax)      { nur 16Bit Register }
  619.                                             else ByteWord := NoLen; { und Tschüß         }
  620.                    end;
  621.                    PutB(First OR BWOR[ByteWord]); PutEA(RegNr(Dest) SHL 3,Source)
  622.                  end;
  623.         11     : begin PutB(First); PutEA(Next OR SegNr(Source) SHL 3,Dest) end;
  624.         12     : begin PutB(First); PutEA(Next OR SegNr(Dest) SHL 3,Source) end;
  625.         13     : begin PutB(First OR RegNr(Dest) OR BWOR[ByteWord] SHL 3); PutS(Source) end;
  626.         14     : begin PutB(First OR BWOR[ByteWord]); PutEA(Next,Dest); PutLS(Source) end;
  627.         15     : begin
  628.                    PutB(First OR BWOR[ByteWord]);
  629.                    PutS(copy(Source,2,length(Source)-2))
  630.                  end;
  631.         16     : begin
  632.                    PutB(First OR BWOR[ByteWord]);
  633.                    PutS(copy(Dest,2,length(Dest)-2))
  634.                  end;
  635.         17     : PutB(First OR RegNr(Source));
  636.         18     : begin PutB(First OR BWOR[ByteWord]); PutS(Source);   end;
  637.         19     : PutB(First OR BWOR[ByteWord]);
  638.         20     : begin PutB(First OR ImmLen(Source,FALSE) SHL 1 OR BWOR[ByteWord]); PutEA(Next,Dest); PutBWS(Source) end;
  639.         21     : begin PutB(First OR BWOR[ByteWord]); PutLS(Source); end;
  640.         23     : begin PutB(First); PutS(SegOfs(Dest)); end;
  641.         24     : begin PutB(First OR ImmLen(Dest,FALSE) SHL 1); PutS(Dest); end;
  642.       end; { of case }
  643.       EndPut;
  644.   end; { of MakeCommand }
  645.   {---------------------------------------------------------------------------}
  646. begin { of Assemble }
  647.   repeat
  648.     Write('Enter mnemonic : ');ReadLn(AssemblerCode);
  649.     if length(AssemblerCode) = 0 then Exit;
  650.     UpString(AssemblerCode);
  651.     SplitLine;
  652.     MakeCommand;
  653.     WriteLn('Result : ',PutString);
  654.   until FALSE;
  655. end;
  656. {-----------------------------------------------------------------------------}
  657. begin
  658.   ClrScr;
  659.   Assemble;
  660. end.