home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / tex / webtp55.arc / ASM2INL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-05  |  55KB  |  1,878 lines
  1. {$R-,S-,I-,F-,V-,B-,N-,A+}
  2. Unit Asm2Inl;
  3. {-Convert assembler instructions to inlines}
  4.  
  5.  
  6. { based on the inline assembler in Inline219 by L. David Baldwin
  7.   changed for use with TANGLE, 3.8.89 Peter Sawatzki
  8.  
  9. 28 Vers 2.20 Fix sign extension bug, 4.8.89 PS
  10. ------------ 17-27: L. David Baldwin ---------
  11. 27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
  12. 26 Vers 2.18 Implement the sign extension bit for some instructions
  13. 25 Vers 2.17 Convert to Turbo 4.
  14. 24 Vers 2.16 Change byte size check in MemReg so the likes of
  15.              MOV [DI+$FE],AX will assemble right.
  16.    Allow ',' in DB pseudo op instruction.
  17. 23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
  18. 22 Vers 2.14 Change output format to better accomodate map file line numbers.
  19. 21 Vers 2.13 Allow JMP SHORT direct using symbols.
  20. 20 Vers 2.12 Allow CALL and JMP direct using symbols.
  21. 19 Vers 2.11
  22.    Fix bug in CallJmp and ShortJmp which didn't restrict short
  23.    jump range properly.
  24.    Fix bug which didn't allow CALL or JMP register. (CALL BX).
  25. 18 Vers 2.1
  26.    Fix bug in Accum which occasionally messed up IN and OUT instr.
  27.    Fix unintialized function in getnumber for quoted chars.
  28. 17 Vers 2.03
  29.     Change GetSymbol to accept about anything after '>' or '<'
  30.     Add 'NEW' pseudoinstruction.
  31.     Fix serious bug in defaultextension.
  32.     Add Wait_Already to prevent 2 'WAIT's from occuring.
  33.     Use 'tindex<maxbyte' comparison rather than <= which won't work
  34.     with integer comparison in this case.
  35. }
  36.  
  37. Interface
  38. Const
  39.   Maxbyte        = 4000;          {MaxInt}
  40.   InBufMax       = 4000;
  41. Var
  42.   TextArray      : Array[0..Maxbyte] Of Char;
  43.  
  44. Procedure SetupAsm;
  45. Function FeedAsm(Ch : Char) : Boolean;
  46. Function DoAsm(InsertComments : Boolean) : Boolean;
  47. Function ObjSize : Word;
  48.  
  49. Implementation
  50. Const
  51.   Symbolleng     = 32;            {maximum of 32 char symbols}
  52.   CR             = 13; Lf = 10; Tab = 9;
  53.   BigStringSize  = 127;
  54. Type
  55.   SymString      = String[Symbolleng];
  56.   IndxReg        = (BX, SI, DI, BP, None);
  57.   IndxSet        = Set Of IndxReg;
  58.   PtrType        = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
  59.   String4        = String[4];
  60.   String5        = Array[1..5] Of Char;
  61.   Symtype        = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
  62.                     LfBrack, RtBrack, Plus, Comma, STsym);
  63.   BigString      = String[BigStringSize]; {125 chars on a turbo line}
  64.   Label_Info_ptr = ^Label_Info;
  65.   Label_Info     = Record
  66.                      Name           : SymString;
  67.                      ByteCnt        : Integer;
  68.                      Next           : Label_Info_ptr;
  69.                    End;
  70.   Fixup_Info_Ptr = ^Fixup_Info;
  71.   Fixup_Info     = Record
  72.                      Name           : SymString;
  73.                      Indx, Indx2, Fix_pt : Integer;
  74.                      Jmptype        : (Short, Med);
  75.                      Prev, Next     : Fixup_Info_Ptr;
  76.                    End;
  77.  
  78. Var
  79.   InBufEnd       : 0..InBufMax;
  80.   InBuf          : Array[0..InBufMax] Of Char;
  81.   StartChi       : Word;
  82.   EofInstr       : Boolean;
  83.   NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
  84.   Displace, WordSize, Wait_Already : Boolean;
  85.   Addr           : Integer;
  86.   Sym            : Symtype;
  87.   Reg1, Reg2, W1, W2: byte;
  88.   ModeByte,Sti_val : Integer;
  89.   SaveOfs, DataVal : Record
  90.                        Symb           : Boolean;
  91.                        Sname          : SymString;
  92.                        Value          : Integer;
  93.                      End;
  94.   IRset          : IndxSet;
  95.   Rmm, Md        : Integer;
  96.   ByWord         : PtrType;
  97.   Byt, SignExt   : Byte;
  98.   Tindex, Tindex0, Column, ByteCount, LastSlash : Integer;
  99.  
  100.   TokStr           : SymString;
  101.   UCh, LCh       : Char;
  102.   Chi, OldChi    : Integer;
  103.  
  104.   Start_Col      : Integer;
  105.   Firstlabel, Pl : Label_Info_ptr;
  106.   Firstfix, Pf   : Fixup_Info_Ptr;
  107.  
  108.   Function GetStr(p : Word) : String;
  109.   Var
  110.     s              : String;
  111.   Begin
  112.     s := '';
  113.     Dec(p);
  114.     While (p < InBufEnd) And (InBuf[p] <> '/') Do Begin
  115.       Inc(Byte(s[0]));
  116.       s[Length(s)] := InBuf[p];
  117.       Inc(p);
  118.     End;
  119.     GetStr := s
  120.   End;
  121.  
  122.   Procedure InsertStr(s : BigString); Forward;
  123.  
  124.   Procedure Error(s : BigString);
  125.   Begin
  126.     If Not Aerr Then Begin
  127.       WriteLn;
  128.       WriteLn(GetStr(StartChi));
  129.       Write('':(Start_Col+(Chi-StartChi)),'^Error');
  130.       If Length(s) > 0 Then
  131.         Write(': ', s);
  132.       WriteLn;
  133.       Aerr := True;
  134.       InsertStr('{!Error: '+s+'}'); {-mark error in source file}
  135.     End;
  136.   End;
  137.  
  138.   Procedure SetupAsm;
  139.   Begin
  140.     InBufEnd := 0;
  141.   End;
  142.  
  143.   Function FeedAsm(Ch : Char) : Boolean;
  144.   Begin
  145.     If InBufEnd = InBufMax Then
  146.       FeedAsm := False
  147.     Else Begin
  148.       FeedAsm := True;
  149.       InBuf[InBufEnd] := Ch;
  150.       Inc(InBufEnd)
  151.     End
  152.   End;
  153.  
  154.   {the following are definitions and variables for the parser}
  155. Var
  156.   Segm, NValue   : Integer;
  157.   Symname        : SymString;
  158.   {end of parser defs}
  159.  
  160.   Procedure GetCh;
  161.     {return next char in uch and lch with uch in upper case.}
  162.   Begin
  163.     If Chi < InBufEnd Then Begin
  164.       LCh := InBuf[Chi];
  165.       If LCh = '/' Then
  166.         LCh := Chr(CR);
  167.       UCh := Upcase(LCh);
  168.       Inc(Chi);
  169.     End Else Begin
  170.       LCh := Chr(CR);
  171.       UCh := Chr(CR);
  172.       TheEnd := True
  173.     End;
  174.   End;
  175.  
  176.   Procedure SkipSpaces;
  177.   Begin
  178.     While (UCh = ' ') Or (UCh = Chr(Tab)) Do GetCh;
  179.   End;
  180.  
  181.   Function GetDec(Var V : Integer) : Boolean;
  182.   Const
  183.     Ssize = 8;
  184.   Var
  185.     s: String[Ssize];
  186.     Getd: Boolean;
  187.     Code: Integer;
  188.   Begin
  189.     Getd := False;
  190.     s := '';
  191.     While (UCh >= '0') And (UCh <= '9') Do
  192.       Begin
  193.         Getd := True;
  194.         If Ord(s[0]) < Ssize Then s := s+UCh;
  195.         GetCh;
  196.       End;
  197.     If Getd Then
  198.       Begin
  199.         Val(s, V, Code);
  200.         If Code <> 0 Then Error('Bad number format');
  201.       End;
  202.     GetDec := Getd;
  203.   End;
  204.  
  205.   Function GetHex(Var H : Integer) : Boolean;
  206.   Var
  207.     Digit: Integer; {check for '$' before the call}
  208.   Begin
  209.     H := 0; GetHex := False;
  210.     While (UCh In ['A'..'F', '0'..'9']) Do
  211.       Begin
  212.         GetHex := True;
  213.         If (UCh >= 'A') Then Digit := Ord(UCh)-Ord('A')+10
  214.         Else Digit := Ord(UCh)-Ord('0');
  215.         If H And $F000 <> 0 Then Error('Overflow');
  216.         H := (H Shl 4)+Digit;
  217.         GetCh;
  218.       End;
  219.   End;
  220.  
  221.   Function GetNumber(Var N : Integer) : Boolean;
  222.     {get a number and return it in n}
  223.   Var Term       : Char;
  224.     Err            : Boolean;
  225.   Begin
  226.     N := 0;
  227.     If UCh = '(' Then GetCh;      {ignore ( }
  228.     If (UCh = '''') Or (UCh = '"') Then
  229.       Begin
  230.         GetNumber := True;
  231.         Term := UCh; GetCh; Err := False;
  232.         While (UCh <> Term) And Not Err Do Begin
  233.           Err := N And $FF00 <> 0;
  234.           N := (N Shl 8)+Ord(LCh);
  235.           GetCh;
  236.           If Err Then Error('Overflow')
  237.         End;
  238.         GetCh;                    {use up termination char}
  239.       End
  240.     Else If UCh = '$' Then
  241.       Begin                       {a hex number}
  242.         GetCh;
  243.         If Not GetHex(N) Then Error('Hex number exp');
  244.         GetNumber := True;
  245.       End
  246.     Else
  247.       GetNumber := GetDec(N);     {maybe a decimal number}
  248.     If UCh = ')' Then GetCh;      {ignore an ending parenthesis}
  249.   End;
  250.  
  251.   Function GetExpr(Var Rslt : Integer) : Boolean;
  252.   Var
  253.     Rs1, Rs2, SaveChi : Integer;
  254.     Pos, Neg       : Boolean;
  255.   Begin
  256.     SaveChi := Chi;
  257.     GetExpr := False;
  258.     SkipSpaces;
  259.     Neg := UCh = '-';
  260.     Pos := UCh = '+';
  261.     If Pos Or Neg Then GetCh;
  262.     If GetNumber(Rs1) Then
  263.       Begin
  264.         GetExpr := True;
  265.         If Neg Then Rs1 := -Rs1;
  266.         If (UCh = '+') Or (UCh = '-') Then
  267.           If GetExpr(Rs2) Then
  268.             Inc(Rs1, Rs2);        {getexpr will take care of sign}
  269.         Rslt := Rs1;
  270.       End
  271.     Else
  272.       Begin
  273.         Chi := SaveChi-1; GetCh;
  274.       End;
  275.   End;
  276.  
  277.   {$v+}
  278.   Function GetSymbol(Var s : SymString) : Boolean;
  279.   Const
  280.     Symchars : Set Of Char = ['@'..'Z', '0'..'9', '_', '+', '-', '$', '*'];
  281.   Begin
  282.     If UCh In Symchars Then
  283.       Begin
  284.         GetSymbol := True;
  285.         s[0] := Chr(0);
  286.         While UCh In Symchars Do
  287.           Begin
  288.             If Ord(s[0]) < Symbolleng Then s := s+UCh;
  289.             GetCh;
  290.           End
  291.       End
  292.     Else GetSymbol := False;
  293.   End;
  294.   {$v-}
  295.  
  296.   Function GetAddress : Boolean;
  297.   Var
  298.     Result         : Boolean;
  299.     SaveChi        : Integer;
  300.   Begin
  301.     Result := False; SaveChi := Chi;
  302.     If GetExpr(Segm) Then
  303.       Begin
  304.         SkipSpaces;
  305.         If UCh = ':' Then
  306.           Begin
  307.             GetCh; SkipSpaces;
  308.             Result := GetExpr(NValue);
  309.           End;
  310.       End;
  311.     GetAddress := Result;
  312.     If Not Result Then
  313.       Begin Chi := SaveChi-1; GetCh; End;
  314.   End;
  315.  
  316.   Procedure ErrNull;
  317.   Begin Error(''); End;
  318.  
  319.   Procedure ErrIncorrect;
  320.   Begin Error('Incorrect or No Operand'); End;
  321.  
  322.   Procedure SegmErr;
  323.   Begin Error('Segm Reg not Permitted'); End;
  324.  
  325.   Procedure WordReg;
  326.   Begin Error('Word Reg Exp'); End;
  327.  
  328.   Procedure DataLarge;
  329.   Begin Error('Data Too Large'); End;
  330.  
  331.   Procedure Chk_BwPtr;
  332.   Begin
  333.     If ByWord >= DwPtr Then Error('BYTE or WORD Req''d');
  334.   End;
  335.  
  336.   Function ByteSize(Val : Integer) : Boolean;
  337.     {return true if val is a byte}
  338.   Begin
  339.     ByteSize := (Hi(Val) = 0) Or (Val And $FF80 = $FF80);
  340.   End;
  341.  
  342.   Function ShortSize(Val : Integer) : Boolean;
  343.     {return true if val is ShortInt size}
  344.   Begin
  345.     ShortSize := (Val >= -128) And (Val <= 127);
  346.   End;
  347.  
  348.   Function ReadByte : Boolean;
  349.   Var Rb         : Boolean;
  350.   Begin
  351.     Rb := GetExpr(NValue);
  352.     If Rb Then
  353.       If ByteSize(NValue) Then
  354.         Byt := Lo(NValue)
  355.       Else DataLarge;
  356.     ReadByte := Rb;
  357.   End;
  358.  
  359.   Function RetIndex (keyword,inst: String; var index: Byte): boolean;
  360.   Var
  361.     p: Byte;
  362.   Begin
  363.     While KeyWord[Length(KeyWord)]=' ' Do
  364.       Dec(Byte(KeyWord[0]));
  365.     KeyWord:= KeyWord+'.';
  366.     if KeyWord='.' Then
  367.       KeyWord:= '$never$';
  368.     p:= Pos(KeyWord,inst);
  369.     RetIndex:= p>0;
  370.     Index:= 0;
  371.     While p>0 Do Begin
  372.       If inst[p]='.' Then
  373.         Inc(index);
  374.       Dec(p)
  375.     End
  376.   End;
  377.  
  378.   Procedure GetString;
  379.   {Fill in TokStr, str, id2,id3.  They are, in fact, all in the
  380.    same locations}
  381.   Var
  382.     I: Integer;
  383.   Begin
  384.     SkipSpaces;
  385.     TokStr := '          ';
  386.     I := 1;
  387.     While (UCh >= '@') And (UCh <= 'Z')
  388.        Or (UCh >= '0') And (UCh <= '9') Do Begin
  389.       If I <= Symbolleng Then Begin
  390.         TokStr[I]:= UCh;
  391.         Inc(I);
  392.       End;
  393.       GetCh;
  394.     End;
  395.     TokStr[0] := Chr(I-1);
  396.   End;
  397.  
  398.   Procedure InsertChr(C : Char);
  399.   Begin
  400.     If Tindex < Maxbyte Then
  401.       Begin
  402.         TextArray[Tindex] := C;
  403.         Inc(Tindex); Inc(Column);
  404.       End
  405.     Else
  406.       Begin
  407.         WriteLn('Object Code Overflow!');
  408.         Halt(1);
  409.       End;
  410.   End;
  411.  
  412.   Procedure InsertStr(s : BigString);
  413.   Var I          : Integer;
  414.   Begin
  415.     For I := 1 To Ord(s[0]) Do InsertChr(s[I]);
  416.   End;
  417.  
  418.   Function Hex2(B : Byte) : String4;
  419.   Const HexDigs  : Array[0..15] Of Char = '0123456789ABCDEF';
  420.   Var Bz         : Byte;
  421.   Begin
  422.     Bz := B And $F; B := B Shr 4;
  423.     Hex2 := HexDigs[B]+HexDigs[Bz];
  424.   End;
  425.  
  426.   Function Hex4(W : Integer) : String4;
  427.   Begin Hex4 := Hex2(Lo(W))+Hex2(Hi(W)); End;
  428.  
  429.   Procedure InsertByte(B : Byte);
  430.   Begin
  431.     InsertStr('$'+Hex2(B));
  432.     ByteCount := ByteCount+1;
  433.     LastSlash := Tindex;
  434.     InsertChr('/');
  435.     Wait_Already := False;        {any byte inserted cancels a WAIT}
  436.   End;
  437.  
  438.   Procedure InsertWord(W : Integer);
  439.   Begin
  440.     InsertByte(Lo(W)); InsertByte(Hi(W));
  441.   End;
  442.  
  443.   Procedure InsertHi_Low(W : Integer);
  444.     {insert a word in reverse order}
  445.   Begin
  446.     InsertByte(Hi(W)); InsertByte(Lo(W));
  447.   End;
  448.  
  449.   Procedure InsertWait;
  450.   Begin                           {Insert a 'WAIT' for Fl Pt only if none already input}
  451.     If Not Wait_Already Then InsertByte($9B);
  452.   End;
  453.  
  454.   Procedure Modify_Byte(I : Integer; Modify : Byte);
  455.     {Modify an ascii byte string in textarray by adding modify to its value}
  456.   Var
  457.     St             : String4;
  458.     J              : Integer;
  459.  
  460.     Function HexToByte(I : Integer; Var J : Integer) : Byte;
  461.     {Starting at tindex, i, convert hex to a byte. return j, the tindex where
  462.      byte started}
  463.     Var
  464.       Result, Tmp    : Byte;
  465.       K              : Integer;
  466.       C              : Char;
  467.     Const
  468.       Hex            : Set Of Char = ['0'..'9', 'A'..'F'];
  469.     Begin
  470.       Result := 0;
  471.       While Not(TextArray[I] In Hex) Do Inc(I); {skip '/' and '$'}
  472.       J := I;
  473.       For K := I To I+1 Do Begin
  474.         C := TextArray[K];
  475.         If C <= '9' Then Tmp := Ord(C)-Ord('0') Else Tmp := Ord(C)-Ord('A')+10;
  476.         Result := (Result Shl 4)+Tmp
  477.       End;
  478.       HexToByte := Result
  479.     End;
  480.  
  481.   Begin
  482.     St := Hex2(HexToByte(I, J)+Modify);
  483.     TextArray[J] := St[1];
  484.     TextArray[J+1] := St[2]
  485.   End;
  486.  
  487.   Procedure DoNext;
  488.   Var
  489.     TmpCh: Char;
  490.   Begin
  491.     OldChi := Chi;
  492.     Symbol := False;
  493.     If Sym = EOLsym Then Exit;    {do nothing}
  494.     SkipSpaces;                   {note commas are significant}
  495.     If (UCh = Chr(CR)) Or (UCh = ';') Then
  496.       Sym := EOLsym
  497.     Else
  498.       If UCh = ',' Then Begin
  499.         Sym := Comma;
  500.         GetCh
  501.       End Else
  502.         If (UCh = '>') Or (UCh = '<') Then Begin
  503.           TmpCh := UCh;
  504.           GetCh;
  505.           If Not GetSymbol(Symname) Then Error('Symbol Name Exp');
  506.           If TmpCh = '<' Then
  507.             Sym := Disp8
  508.           Else
  509.             Sym := Disp16;
  510.           Symbol := True {disp8/16 is a symbol}
  511.         End Else
  512.           If GetAddress Then
  513.             If NoAddrs Then
  514.               ErrNull
  515.             Else
  516.               Sym := Address
  517.           Else
  518.             If GetExpr(NValue) Then
  519.               If ByteSize(NValue) Then
  520.                 Sym := Disp8
  521.               Else
  522.                 Sym := Disp16
  523.             Else
  524.               If (UCh >= '@') And (UCh <= 'Z') Then Begin
  525.                 GetString;
  526.                 Symname := TokStr;
  527.                 If (TokStr = 'FAR') Or (TokStr = 'NEAR')
  528.                 Or (TokStr = 'SHORT') Then
  529.                   Sym := JmpDist
  530.                 Else
  531.                   If TokStr = 'ST' Then
  532.                     Sym := STsym
  533.                   Else
  534.                     Sym := Identifier
  535.               End Else
  536.                 If UCh = '+' Then Begin
  537.                   Sym := Plus;
  538.                   GetCh
  539.                 End Else
  540.                   If UCh = '[' Then Begin
  541.                     Sym := LfBrack;
  542.                     GetCh
  543.                   End Else
  544.                     If UCh = ']' Then Begin
  545.                       Sym := RtBrack;
  546.                       GetCh
  547.                     End Else Begin
  548.                       Sym:= Othersym;
  549.                       GetCh
  550.                     End
  551.   End;
  552.  
  553. Procedure NextA;
  554. {-Get the next item but also process any
  555.   'WORD' 'BYTE', 'DWORD', 'QWORD',etc 'PTR'}
  556. Var
  557.   Indx: Byte;
  558. Const
  559.   TheInst = 'BYTE.WORD.DWORD.QWORD.TBYTE.';
  560. Begin
  561.   DoNext;
  562.   If Sym = Identifier Then
  563.     If RetIndex(TokStr,TheInst,Indx) Then Begin
  564.       ByWord:= PtrType(Indx);
  565.       DoNext;
  566.       If TokStr = 'PTR' Then
  567.         DoNext {ignore 'PTR'}
  568.     End
  569. End;
  570.  
  571.   Procedure Displace_Bytes(W : Integer);
  572.   Var C: Char;
  573.   Begin
  574.     If Displace Then With SaveOfs Do Begin
  575.       If Symb Then Begin
  576.         {-displacement is a symbol}
  577.         If W = 1 Then
  578.           C := '>'
  579.         Else
  580.           C := '<';
  581.         InsertStr(C+Sname);
  582.         If Value <> 0 Then {Add it in too, don't reverse bytes}
  583.           InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
  584.         If W = 1 Then
  585.           Inc(ByteCount, 2)
  586.         Else
  587.           Inc(ByteCount);
  588.         LastSlash := Tindex;
  589.         InsertChr('/')
  590.       End Else
  591.         If W = 1 Then
  592.           InsertWord(Value)
  593.         Else
  594.           InsertByte(Lo(Value))
  595.     End
  596.   End;
  597.  
  598.   Procedure Data_Bytes(WordSize : Boolean);
  599.   Var
  600.     C: Char;
  601.   Begin
  602.     With DataVal Do Begin
  603.       If Symb Then Begin {data is a symbol}
  604.         If WordSize Then
  605.           C := '>'
  606.         Else
  607.           C := '<';
  608.         InsertStr(C+Sname);
  609.         If Value <> 0 Then    {add it in too}
  610.           InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
  611.         If WordSize Then
  612.           Inc(ByteCount, 2)
  613.         Else
  614.           Inc(ByteCount);
  615.         LastSlash:= Tindex;
  616.         InsertChr('/');
  617.       End Else
  618.         If WordSize Then
  619.           InsertWord(Value)
  620.         Else
  621.           InsertByte(Lo(Value))
  622.     End
  623.   End;
  624.  
  625.   Function GetIR : Boolean;
  626.   Var
  627.     Indx: Byte;
  628.   Const
  629.     TheInst = 'BX.SI.DI.BP.';
  630.   Begin
  631.     GetIR := False;
  632.     If (Sym = Identifier) Then
  633.       If RetIndex(TokStr,TheInst,Indx) Then Begin
  634.         IRset:= IRset+[IndxReg(Indx)];
  635.         GetIR := True;
  636.         NextA;
  637.       End
  638.   End;
  639.  
  640.   Function MemReg(Var W : Byte) : Boolean;
  641.   Label
  642.     Abort;
  643.  
  644.   {Does not handle the 'reg' part of the mem/reg. Returns disp true if
  645.   a displacement is found with w=0 for byte disp and w=1 for word
  646.   disp.  Any displacement is output in saveofs.}
  647.  
  648.   Var
  649.     SaveChi        : Integer;
  650.     Dsp16, OldAddrs, Result_MemReg : Boolean;
  651.   Begin
  652.     SaveChi:= OldChi;
  653.     Dsp16:= False;
  654.     Result_MemReg:= False;
  655.     OldAddrs:= NoAddrs;
  656.     NoAddrs:= True;
  657.     SaveOfs.Value := 0;
  658.     SaveOfs.Symb := False;
  659.     IRset := [];
  660.     {',' or cr terminate a MemReg}
  661.     While (Sym <> Comma) And (Sym <> EOLsym) Do Begin
  662.       If Sym = LfBrack Then Begin
  663.         Result_MemReg := True;
  664.         NextA
  665.       End;
  666.       If Sym = Plus Then NextA;
  667.       If (Sym = Disp8) Or (Sym = Disp16) Then With SaveOfs Do Begin
  668.         Dsp16 := Dsp16 Or (Sym = Disp16);
  669.         If Symbol Then Begin
  670.           Symb := True;
  671.           Sname := Symname
  672.         End Else
  673.           Inc(Value, NValue);
  674.         NextA;
  675.       End Else
  676.         If Not GetIR Then
  677.           If Sym = RtBrack Then
  678.             NextA
  679.           Else
  680.             If Result_MemReg Then Begin
  681.               Error('Comma or Line End Exp');
  682.               NextA
  683.             End
  684.           Else
  685.             GoTo Abort
  686.     End; {While}
  687.     If Result_MemReg Then Begin
  688.       {-at least one '[' found}
  689.       If (IRset = []) Or (IRset = [BP]) Then Rmm := 6
  690.       Else If IRset = [BX, SI] Then Rmm := 0
  691.       Else If IRset = [BX, DI] Then Rmm := 1
  692.       Else If IRset = [BP, SI] Then Rmm := 2
  693.       Else If IRset = [BP, DI] Then Rmm := 3
  694.       Else If IRset = [SI] Then Rmm := 4
  695.       Else If IRset = [DI] Then Rmm := 5
  696.       Else If IRset = [BX] Then Rmm := 7
  697.       Else Error('Bad Register Combination');
  698.       NextA;                    {pass over any commas}
  699.       With SaveOfs Do
  700.         Dsp16 := Dsp16 Or (Symb And (Value <> 0)) Or Not ShortSize(Value);
  701.       If IRset = [] Then Begin
  702.         Displace := True;
  703.         Md := 0;
  704.         W := 1
  705.       End {direct address} Else
  706.         If (IRset = [BP]) And Not Dsp16 Then Begin
  707.           Displace := True;
  708.           Md := 1;
  709.           W := 0
  710.         End {bp must have displ} Else
  711.           If (SaveOfs.Value = 0) And Not SaveOfs.Symb Then Begin
  712.             Displace := False;
  713.             Md := 0;
  714.             W := 3
  715.           End Else
  716.             If Not Dsp16 Then {8 bit} Begin
  717.               Displace := True;
  718.               Md := 1;
  719.               W := 0
  720.             End Else Begin
  721.               Displace := True;
  722.               Md := 2;
  723.               W := 1
  724.             End;
  725.       ModeByte := 64*Md+Rmm
  726.     End Else Begin {not a MemReg}
  727. Abort: Chi := SaveChi-1; GetCh;  {restore as in beginning}
  728.        NextA
  729.     End;
  730.     NoAddrs := OldAddrs;
  731.     MemReg := Result_MemReg
  732.   End;
  733.  
  734.   Function St_St : Boolean;       {pick up st,st(i) or st(i),st or just st(i)}
  735.   Var
  736.     Err, Rslt  : Boolean;
  737.  
  738.     Function GetSti_Val : Boolean;
  739.     Var
  740.       Grslt: Boolean;
  741.     Begin
  742.       NextA;
  743.       Grslt := Sym = Disp8;
  744.       If Grslt Then Begin
  745.         Sti_val := NValue;
  746.         Err := ((Sti_val And $F8) <> 0); {check limit of 7}
  747.         NextA
  748.       End;
  749.       GetSti_Val := Grslt
  750.     End;
  751.  
  752.   Begin
  753.     Err := False;
  754.     Rslt := Sym = STsym;
  755.     If Rslt Then Begin
  756.       If GetSti_Val Then Begin
  757.         St_first := False;    {st(i) is first}
  758.         While (Sym = Comma) Or (Sym = STsym) Do NextA;
  759.       End Else Begin
  760.         St_first := True;     {st preceeds st(i)}
  761.         If Sym = Comma Then NextA;
  762.         If Sym=STsym Then Begin
  763.           If Not GetSti_Val Then
  764.             Err := True
  765.         End Else
  766.           Err:= True;
  767.         If Err Then
  768.           ErrNull
  769.       End
  770.     End;
  771.     St_St := Rslt
  772.   End;
  773.  
  774.   Function FstiOnly : Boolean;
  775.   {-Fl Pt instructions having only one form using st(i) operand
  776.     faddp,fmulp,fsubp,fsubrp,fdivp,fdivrp,ffree,fxch -- 0..7}
  777.   Var
  778.     Indx           : Byte;
  779.     Rslt           : Boolean;
  780.   Const
  781.     Stiary         : Array[0..7] of Word =
  782.       ($DEC0, $DEC8, $DEE8, $DEE0, $DEF8, $DEF0, $DDC0, $D9C8);
  783.     TheInst = 'FADDP.FMULP.FSUBP.FSUBRP.FDIVP.FDIVRP.FFREE.FXCH.';
  784.   Begin
  785.     Rslt:= RetIndex(TokStr,TheInst,Indx);
  786.     If Rslt Then Begin
  787.       NextA;
  788.       If Not St_St Then Begin
  789.         If Sym = EOLsym Then
  790.           Sti_val := 1
  791.         Else
  792.           ErrIncorrect
  793.       End;
  794.       InsertWait;
  795.       InsertHi_Low(Stiary[Indx]+Sti_val)
  796.     End;
  797.     FstiOnly := Rslt
  798.   End;
  799.  
  800.   Function FmemOnly : Boolean;
  801.   {-Fl Pt instructions having only one form using a memory operand}
  802.   {fldenv,fldcw,fstenv,fstcw,fbstp,fbld,frstor,fsave,fstsw,
  803.   fnsave,fnstcw,fnstenv,fnstsw--0..12 }
  804.   Var Indx       : Byte;
  805.     Rslt           : Boolean;
  806.   Const
  807.     Memary: Array [0..12] of Word = (
  808.               $D920, $D928, $D930, $D938, $DF30, $DF20, $DD20, $DD30, $DD38,
  809.               $DD30, $D938, $D930, $DD38);
  810.     TheInst = 'FLDENV.FLDCW.FSTENV.FSTCW.FBSTP.FBLD.FRSTOR.FSAVE.'+
  811.               'FSTSW.FNSAVE.FNSTCW.FNSTENV.FNSTSW.';
  812.   Begin
  813.     Rslt:= RetIndex(TokStr,TheInst,Indx);
  814.     If Rslt Then Begin
  815.       NextA;
  816.       If Indx < 9 Then InsertWait; {fwait}
  817.       If MemReg(W1) Then Begin
  818.         InsertHi_Low(Memary[Indx]+ModeByte);
  819.         Displace_Bytes(W1)
  820.       End Else
  821.         ErrIncorrect
  822.     End;
  823.     FmemOnly := Rslt;
  824.   End;
  825.  
  826.   Function FldType : Boolean;
  827.   {Do fld,fst,fstp-- 0..2}
  828.   Type
  829.     Arraytype      = Array[0..2, DwPtr..UnkPtr] Of Word;
  830.   Var
  831.     Indx: Byte;
  832.     Tmp: Word;
  833.     Rslt           : Boolean;
  834.   Const
  835.     Fldarray       : Arraytype = (
  836.             ($D900, $DD00, $DB28, $D9C0),
  837.             ($D910, $DD10, 0, $DDD0),
  838.             ($D918, $DD18, $DB38, $DDD8));
  839.     TheInst = 'FLD.FST.FSTP.';
  840.   Begin
  841.     Rslt:= RetIndex(TokStr,TheInst,Indx);
  842.     If Rslt Then Begin
  843.       NextA;
  844.       InsertWait;               {fwait}
  845.       If ByWord >= DwPtr Then
  846.         Tmp:= Fldarray[Indx, ByWord];
  847.       If MemReg(W1) Then Begin
  848.         If (ByWord >= DwPtr) And (ByWord <= TbPtr) Then Begin
  849.           InsertHi_Low(Tmp+ModeByte);
  850.           Displace_Bytes(W1);
  851.           If Tmp = 0 Then Error('TBYTE not Permitted')
  852.         End Else
  853.           Error('DWORD, QWORD, or TBYTE Req''d')
  854.       End Else
  855.         If St_St Then
  856.           InsertHi_Low(Tmp+Sti_val)
  857.         Else
  858.           ErrIncorrect
  859.     End;
  860.     FldType := Rslt;
  861.   End;
  862.  
  863.   Function FildType : Boolean;
  864.   {-do fild,fist,fistp-- 0..2}
  865.   Type
  866.     Arraytype      = Array[0..2, WPtr..QwPtr] Of Word;
  867.   Var
  868.     Indx: Byte;
  869.     Tmp: Word;
  870.     Rslt           : Boolean;
  871.   Const
  872.     Fildarray      : Arraytype = (
  873.            ($DF00, $DB00, $DF28),
  874.            ($DF10, $DB10, 0),
  875.            ($DF18, $DB18, $DF38));
  876.     TheInst = 'FILD.FIST.FISTP.';
  877.   Begin
  878.     Rslt:= RetIndex(TokStr,TheInst,Indx);
  879.     If Rslt Then Begin
  880.       NextA;
  881.       If MemReg(W1) Then Begin
  882.         If (ByWord >= WPtr) And (ByWord <= QwPtr) Then Begin
  883.           InsertWait;       {fwait}
  884.           Tmp := Fildarray[Indx, ByWord];
  885.           InsertHi_Low(Tmp+ModeByte);
  886.           Displace_Bytes(W1);
  887.           If Tmp = 0 Then Error('QWORD not Permitted')
  888.         End Else
  889.           Error('WORD, DWORD, or QWORD Req''d')
  890.       End Else
  891.         ErrIncorrect
  892.     End;
  893.     FildType := Rslt;
  894.   End;
  895.  
  896.   Function FaddType : Boolean;
  897.   {-The fadd,fmul,fcom,fcomp,fsub,fsubr,fdiv,fdivr instructions}
  898.   Var
  899.     Indx: Byte;
  900.     Rslt           : Boolean;
  901.   Const
  902.     TheInst = 'FADD.FMUL.FCOM.FCOMP.FSUB.FSUBR.FDIV.FDIVR.';
  903.   Begin
  904.     Rslt := RetIndex(TokStr,TheInst,Indx);
  905.     If Rslt Then Begin
  906.       NoAddrs := True;
  907.       NextA;
  908.       InsertWait;               {fwait}
  909.       If MemReg(W1) Then Begin
  910.         If ByWord = DwPtr Then
  911.           InsertByte($D8)
  912.         Else
  913.           If ByWord = QwPtr Then
  914.             InsertByte($DC)
  915.           Else
  916.             Error('DWORD or QWORD Req''d');
  917.         InsertByte(ModeByte+8*Indx);
  918.         Displace_Bytes(W1)
  919.       End Else
  920.         If St_St Then Begin
  921.           {-Must be st,st(i) or st(i),st }
  922.           If St_first Or (Indx = 2 {fcom} ) Or (Indx = 3 {fcomp} ) Then
  923.             InsertByte($D8)
  924.           Else
  925.             InsertByte($DC);
  926.           ModeByte := $C0+8*Indx+Sti_val;
  927.           If Not St_first And (Indx >= 6 {fdiv} ) Then
  928.             ModeByte := ModeByte Xor 8; {reverse fdiv,fdivr for not st_first}
  929.           InsertByte(ModeByte)
  930.         End Else
  931.           ErrIncorrect
  932.     End;
  933.     FaddType := Rslt
  934.   End;
  935.  
  936.   Function FiaddType : Boolean;
  937.     {the fiadd,fimul,ficom,ficomp,fisub,fisubr,fidiv,fidivr instructions}
  938.   Var
  939.     Indx: Byte;
  940.     Rslt: Boolean;
  941.   Const
  942.     TheInst = 'FIADD.FIMUL.FICOM.FICOMP.FISUB.FISUBR.FIDIV.FIDIVR.';
  943.   Begin
  944.     Rslt := RetIndex(TokStr,TheInst,Indx);
  945.     If Rslt Then Begin
  946.       NoAddrs := True;
  947.       NextA;
  948.       If MemReg(W1) Then Begin
  949.         InsertWait;           {fwait}
  950.         If ByWord = DwPtr Then
  951.           InsertByte($DA)
  952.         Else
  953.           If ByWord = WPtr Then
  954.             InsertByte($DE)
  955.           Else
  956.             Error('WORD or DWORD Req''d');
  957.         InsertByte(ModeByte+8*Indx);
  958.         Displace_Bytes(W1)
  959.       End Else
  960.         ErrIncorrect
  961.     End;
  962.     FiaddType := Rslt
  963.   End;
  964.  
  965.   Function Fnoperand : Boolean;
  966.   {-do the Fl Pt no operand instructions}
  967.   Var
  968.     Indx: Byte;
  969.     Rslt: Boolean;
  970.   Const
  971.     TheInst =
  972.      'FNOP.FCHS.FABS.FTST.FXAM.FLD1.FLDL2T.FLDL2E.FLDPI.FLDLG2.FLDLN2.FLDZ.'+
  973.      'F2XM1.FYL2X.FPTAN.FPATAN.FXTRACT.FDECSTP.FINCSTP.FPREM.FYL2XP1.FSQRT.'+
  974.      'FRNDINT.FSCALE.FENI.FDISI.FCLEX.FINIT.FCOMPP.FNCLEX.FNDISI.FNENI.FNINIT.';
  975.  
  976.     Fnopcode       : Array[0..32] Of Word =
  977.     ($D9D0, $D9E0, $D9E1, $D9E4, $D9E5, $D9E8,
  978.      $D9E9, $D9EA, $D9EB, $D9EC, $D9ED, $D9EE,
  979.      $D9F0, $D9F1, $D9F2, $D9F3, $D9F4, $D9F6,
  980.      $D9F7, $D9F8, $D9F9, $D9FA, $D9FC, $D9FD,
  981.      $DBE0, $DBE1, $DBE2, $DBE3, $DED9,
  982.      $DBE2, $DBE1, $DBE0, $DBE3);
  983.  
  984.   Begin
  985.     Rslt:= RetIndex(TokStr,TheInst,Indx);
  986.     If Rslt Then Begin
  987.       NextA;
  988.       If Indx < 29 Then InsertWait; {fwait}
  989.       InsertHi_Low(Fnopcode[Indx]);
  990.     End;
  991.     Fnoperand := Rslt
  992.   End;
  993.  
  994.   Function Register(Var R, W : Byte) : Boolean;
  995.   Const
  996.     TheInst = 'AL.CL.DL.BL.AH.CH.DH.BH.'+
  997.               'AX.CX.DX.BX.SP.BP.SI.DI.';
  998.   Begin
  999.     Register:= False;
  1000.     If (Sym=Identifier) Then
  1001.     If RetIndex(TokStr,TheInst,R) Then Begin
  1002.       Register:= True;
  1003.       NextA;
  1004.       If Sym = Comma Then NextA;
  1005.       W:= R Div 8;             {w=1 for word type register}
  1006.       R:= R And 7
  1007.     End
  1008.   End;
  1009.  
  1010.   Function SegRegister(Var R : Byte) : Boolean;
  1011.   Var
  1012.     Result_Segr : Boolean;
  1013.   Const
  1014.     TheInst = 'ES.CS.SS.DS.';
  1015.   Begin
  1016.     SegRegister:= False;
  1017.     If (Sym = Identifier) Then
  1018.       If RetIndex(TokStr,TheInst,R) Then Begin
  1019.         SegRegister:= True;
  1020.         NextA;
  1021.         If Sym = Comma Then
  1022.           NextA;
  1023.       End
  1024.   End;
  1025.  
  1026.   Function Data(Var Wd : Boolean) : Boolean;
  1027.   {-See if immediate data is present.  Set wd if data found is word size}
  1028.   Var SaveChi    : Integer;
  1029.     Result         : Boolean;
  1030.   Begin
  1031.     Result := False; Wd := False;
  1032.     SaveChi := OldChi;
  1033.     With DataVal Do Begin
  1034.       Value := 0;
  1035.       Symb := False;
  1036.       While (Sym = Disp8) Or (Sym = Disp16) Do Begin
  1037.         Result := True;
  1038.         If Symbol Then Begin
  1039.           Wd := Wd Or (Sym = Disp16);
  1040.           Symb := True;
  1041.           Sname := Symname
  1042.         End Else
  1043.           Inc(Value, NValue);
  1044.         NextA;
  1045.         If Sym = Plus Then NextA
  1046.       End;
  1047.       Result := (Sym = EOLsym) And Result;
  1048.       Wd := Wd Or Not ByteSize(Value)
  1049.     End;
  1050.     Data := Result;
  1051.     If Not Result Then Begin
  1052.        Chi := SaveChi-1;
  1053.       GetCh;
  1054.       NextA
  1055.     End
  1056.   End;
  1057.  
  1058.   Function TwoOperands : Boolean;
  1059.   {-Handles codes with two operands}
  1060.   Type
  1061.     InsType        = (Mov, Adc, Addx, Andx, Cmp, Orx, Sbb, Sub, Xorx, Test, Xchg, Lds, Les, Lea);
  1062.     Codetype       = Array[Mov..Lea] Of Byte;
  1063.     Shcodetype     = Array[Mov..Test] Of Byte;
  1064.   Var
  1065.     Inst           : InsType;
  1066.     Tmp            : Byte;
  1067.   Const
  1068.     TheInst  = 'MOV.ADC.ADD.AND.CMP.OR.SBB.SUB.XOR.TEST.XCHG.LDS.LES.LEA.';
  1069.     Immedop  : Codetype = ($C6,$80,$80,$80,$80,$80,$80,$80,$80,$F6,$00,$00,$00,$00);
  1070.     Immedreg : Codetype = ($00,$10,$00,$20,$38,$08,$18,$28,$30,$00,$00,$00,$00,$00);
  1071.     Memregop : Codetype = ($88,$10,$00,$20,$38,$08,$18,$28,$30,$84,$86,$C5,$C4,$8D);
  1072.     Shimmedop: Shcodetype=($00,$14,$04,$24,$3C,$0C,$1C,$2C,$34,$A8);
  1073.  
  1074.     Function ChkSignExt(WordSize : Boolean) : Byte; {Thanx to Jim LeMay}
  1075.     Begin
  1076.       If (Immedop[Inst] = $80) And Not WordSize And ShortSize(DataVal.Value) Then
  1077.         ChkSignExt := 2           { the sign extension bit }
  1078.       Else ChkSignExt := 0;       { no  sign extension bit }
  1079.     End;
  1080.  
  1081.   Begin
  1082.     TwoOperands:= False;
  1083.     if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
  1084.       Exit;
  1085.     TwoOperands:= True;
  1086.     NoAddrs:= True;
  1087.     NextA;
  1088.     If Register(Reg1, W1) Then Begin
  1089.       If Register(Reg2, W2) Then Begin
  1090.         {-mov reg,reg}
  1091.         If Inst >= Lds Then Error('Register not Permitted');
  1092.         If W1 <> W2 Then Error('Registers Incompatible');
  1093.         If (Inst = Xchg) And ((W1 = 1) And ((Reg1 = 0) Or (Reg2 = 0))) Then
  1094.           InsertByte($90+Reg1+Reg2)
  1095.         Else Begin
  1096.           InsertByte(Memregop[Inst]+W1);
  1097.           InsertByte($C0+Reg1+8*Reg2);
  1098.         End
  1099.       End Else
  1100.         If SegRegister(Reg2) Then Begin
  1101.           {-mov reg,segreg}
  1102.           If (W1 = 0) Or (Inst <> Mov) Then SegmErr;
  1103.           InsertByte($8C); InsertByte($C0+8*Reg2+Reg1);
  1104.         End Else
  1105.           If Data(WordSize) Then Begin
  1106.             {-mov reg,data}
  1107.             If Inst >= Xchg Then Error('Immediate not Permitted');
  1108.             If (Ord(WordSize) > W1) Then DataLarge;
  1109.             SignExt := ChkSignExt(W1 = 1); {the sign extension bit}
  1110.             If (Inst = Mov) Then
  1111.               InsertByte($B0+8*W1+Reg1)
  1112.             Else
  1113.               If (Reg1 = 0) {ax or al} Then Begin
  1114.                 InsertByte(Shimmedop[Inst]+W1); {add ac,immed}
  1115.                 SignExt := 0;   {no sign extenstion for AL,AX}
  1116.               End Else Begin
  1117.                 InsertByte(Immedop[Inst]+W1+SignExt);
  1118.                 InsertByte($C0+Immedreg[Inst]+Reg1);
  1119.               End;
  1120.             {-output the immediate data}
  1121.             Data_Bytes((SignExt = 0) And (W1 > 0))
  1122.           End Else
  1123.             If MemReg(W2) Then Begin
  1124.               {-mov reg,mem/reg}
  1125.               If (Inst = Mov) And (Reg1 = 0) {ax or al} And (Rmm = 6) And (Md = 0) Then
  1126.                 {-mov ac,mem}
  1127.                 InsertByte($A0+W1)
  1128.               Else Begin
  1129.                 Tmp := Memregop[Inst];
  1130.                 If Inst <= Xchg Then Begin
  1131.                   Inc(Tmp,W1);
  1132.                   If Inst <> Test Then Tmp := Tmp Or 2 {to,from bit}
  1133.                 End;
  1134.                 InsertByte(Tmp);
  1135.                 InsertByte(ModeByte+8*Reg1)
  1136.               End;
  1137.               Displace_Bytes(W2) {add on any displacement bytes}
  1138.             End Else
  1139.               ErrNull
  1140.         End Else
  1141.           If SegRegister(Reg1) Then Begin
  1142.             If Inst <> Mov Then
  1143.               SegmErr;
  1144.             InsertByte($8E);
  1145.             If Register(Reg2, W2) Then Begin
  1146.               {-mov segreg,reg}
  1147.               If (W2 = 0) Then
  1148.                 WordReg;
  1149.               InsertByte($C0+8*Reg1+Reg2)
  1150.             End Else
  1151.               If MemReg(W2) Then Begin
  1152.                 {-mov segreg,mem/reg}
  1153.                 InsertByte(ModeByte+8*Reg1);
  1154.                 Displace_Bytes(W2) {add any displacement bytes}
  1155.               End Else
  1156.                 ErrNull
  1157.           End Else
  1158.             If MemReg(W1) And (Inst <= Xchg) Then Begin
  1159.               If Register(Reg2, W2) Then Begin
  1160.                 {-mov mem/reg,reg}
  1161.                 If (W2 > Ord(ByWord)) Then Error('Byte Reg Exp');
  1162.                 If (Inst = Mov) And (Reg2 = 0) {ax or al}
  1163.                 And (Rmm = 6) And (Md = 0) Then {mov ac, mem}
  1164.                   InsertByte($A2+W2)
  1165.                 Else Begin
  1166.                   InsertByte(Memregop[Inst]+W2);
  1167.                   InsertByte(ModeByte+8*Reg2)
  1168.                 End;
  1169.                 Displace_Bytes(W1)
  1170.               End Else
  1171.                 If SegRegister(Reg2) Then Begin
  1172.                   {-mov mem/reg,segreg}
  1173.                   If (Inst <> Mov) Then SegmErr;
  1174.                   InsertByte($8C);
  1175.                   InsertByte(ModeByte+8*Reg2);
  1176.                   Displace_Bytes(W1)
  1177.                 End Else
  1178.                   If (Data(WordSize)) And (Inst < Xchg) Then Begin
  1179.                     {-mov mem/reg, data}
  1180.                     Chk_BwPtr;
  1181.                     If (Ord(WordSize) > Ord(ByWord)) Then DataLarge;
  1182.                     SignExt:= ChkSignExt(ByWord = WPtr); {the sign extension bit}
  1183.                     InsertByte(Immedop[Inst]+Ord(ByWord)+SignExt);
  1184.                     InsertByte(ModeByte+Immedreg[Inst]);
  1185.                     Displace_Bytes(W1);   {add displacement bytes}
  1186.                     Data_Bytes((SignExt = 0) And (ByWord = WPtr)); {the immediate data}
  1187.                   End Else
  1188.                     ErrNull
  1189.             End Else
  1190.               If (Sym = Disp8) Or (Sym = Disp16) Then
  1191.                 Error('Immediate not Permitted')
  1192.               Else
  1193.                 ErrNull
  1194.   End;
  1195.  
  1196.   Function OneOperand: Boolean;
  1197.   {Handles codes with one operand}
  1198.   Type
  1199.     InsType        = (Dec, Inc, Push, Pop, Nott, Neg);
  1200.     Codetype       = Array[Dec..Neg] Of Byte;
  1201.   Var
  1202.     Inst           : InsType;
  1203.     Pushpop        : Boolean;
  1204.   Const
  1205.     TheInst = 'DEC.INC.PUSH.POP.NOT.NEG.';
  1206.     Regop          : Codetype = ($48,$40,$50,$58,$00,$00);
  1207.     Segregop       : Codetype = ($00,$00,$06,$07,$00,$00);
  1208.     Memregop       : Codetype = ($FE,$FE,$FF,$8F,$F6,$F6);
  1209.     Memregcode     : Codetype = ($08,$00,$30,$00,$10,$18);
  1210.   Begin
  1211.     OneOperand := False;
  1212.     If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
  1213.       Exit;
  1214.     OneOperand := True;
  1215.     Pushpop := (Inst = Push) Or (Inst = Pop);
  1216.     NoAddrs := True;
  1217.     NextA;
  1218.     If Register(Reg1, W1) Then
  1219.       If (W1 = 1) And (Inst < Nott) Then
  1220.         {-16 bit register instructions}
  1221.         InsertByte(Regop[Inst]+Reg1)
  1222.       Else Begin
  1223.         {-byte register or neg,not with any reg}
  1224.         InsertByte(Memregop[Inst]+W1);
  1225.         InsertByte($C0+Memregcode[Inst]+Reg1);
  1226.         If Pushpop Then
  1227.           WordReg;
  1228.       End
  1229.     Else
  1230.       If SegRegister(Reg1) Then Begin
  1231.         {-segment reg--push,pop only}
  1232.         InsertByte(Segregop[Inst]+8*Reg1);
  1233.         If Not Pushpop Then SegmErr
  1234.       End Else
  1235.         If MemReg(W1) Then Begin
  1236.           {-memreg  (not register)}
  1237.           If Not Pushpop Then Chk_BwPtr;
  1238.           InsertByte(Memregop[Inst] Or Ord(ByWord));
  1239.           InsertByte(ModeByte+Memregcode[Inst]);
  1240.           Displace_Bytes(W1);
  1241.         End Else
  1242.           ErrIncorrect;
  1243.   End;
  1244.  
  1245.   Function NoOperand : Boolean;
  1246.   {-Those instructions consisting only of opcode}
  1247.   Const
  1248.     Nmbsop = 31;
  1249.   Type
  1250.     Opfield   = Array[0..Nmbsop] Of Byte;
  1251.   Var
  1252.     Index      : Byte;
  1253.   Const
  1254.     TheInst = 'DAA.AAA.NOP.MOVSB.MOVSW.CMPSB.CMPSW.XLAT.HLT.'
  1255.              +'CMC.DAS.AAS.CBW.CWD.PUSHF.POPF.SAHF.LAHF.'
  1256.              +'STOSB.STOSW.LODSB.LODSW.SCASB.SCASW.INTO.IRET.'+
  1257.              +'CLC.STC.CLI.STI.CLD.STD.';
  1258.     Opcode: Opfield = (
  1259.               $27, $37, $90, $A4, $A5, $A6, $A7, $D7, $F4,
  1260.               $F5, $2F, $3F, $98, $99, $9C, $9D, $9E, $9F, $AA, $AB, $AC, $AD,
  1261.               $AE, $AF, $CE, $CF, $F8, $F9, $FA, $FB, $FC, $FD);
  1262.   Begin
  1263.     NoOperand := False;
  1264.     If Not RetIndex(TokStr,TheInst,Index) Then
  1265.       Exit;
  1266.     NoOperand := True;
  1267.     InsertByte(Opcode[Index]);
  1268.     NextA;
  1269.   End;
  1270.  
  1271.   Function Prefix : Boolean;
  1272.   {process the prefix instructions}
  1273.   Const
  1274.     Nmbsop   = 11;
  1275.   Type
  1276.     Opfield = Array[0..Nmbsop] Of Byte;
  1277.   Var
  1278.     Index: Byte;
  1279.     SaveWait       : Boolean;
  1280.     Opc            : Byte;
  1281.   Const
  1282.     TheInst = 'LOCK.REP.REPZ.REPNZ.REPE.REPNE.WAIT.FWAIT.ES.DS.CS.SS.';
  1283.     Opcode: Opfield = ($F0,$F2,$F3,$F2,$F3,$F2,$9B,$9B,$26,$3E,$2E,$36);
  1284.   Begin
  1285.     Prefix := False;
  1286.     if Not RetIndex(TokStr,TheInst,Index) Then
  1287.       Exit;
  1288.     Prefix:= True;
  1289.     Opc := Opcode[Index];
  1290.     SaveWait := Wait_Already; {save any WAIT already programed}
  1291.     InsertByte(Opc);
  1292.     Wait_Already := SaveWait Or (Opc = $9B); {set for WAIT or FWAIT}
  1293.     Tindex0 := Tindex;      {for future fix ups}
  1294.     If UCh = ':' Then GetCh; {es: etc permitted with a colon}
  1295.   End;
  1296.  
  1297.   Function FindLabel(Var B : Integer) : Boolean;
  1298.   {-Find a label if it exists in the label chain}
  1299.   Var
  1300.     Found      : Boolean;
  1301.   Begin
  1302.     Pl:= Firstlabel;
  1303.     Found:= False;
  1304.     While (Pl <> Nil) And Not Found Do
  1305.       With Pl^ Do
  1306.         If Symname = Name Then Begin
  1307.           Found := True;
  1308.           B := ByteCnt
  1309.         End Else
  1310.           Pl := Next;
  1311.     FindLabel:= Found
  1312.   End;
  1313.  
  1314.   Function ShortJmp : Boolean;
  1315.   {-short jump instructions}
  1316.   Const
  1317.     Numjmp = 34;
  1318.   Type
  1319.     Opfield = Array[0..Numjmp] Of Byte;
  1320.   Var
  1321.     I: Byte;
  1322.     B: Integer;
  1323.   Const
  1324.     TheInst =  'JO.JNO.JB.JNAE.JNB.JAE.JE.JZ.JNE.JNZ.JBE.JNA.'
  1325.               +'JNBE.JA.LOOPN.LOOPZ.LOOPE.LOOP.JCXZ.JS.JNS.JP.JPE.'
  1326.               +'JNP.JPO.JL.JNGE.JNL.JGE.JLE.JNG.JNLE.JG.JC.JNC.';
  1327.     Opcode         : Opfield = (
  1328.               $70, $71, $72, $72, $73, $73, $74, $74, $75, $75, $76, $76,
  1329.               $77, $77, $E0, $E1, $E1, $E2, $E3, $78, $79, $7A, $7A, $7B,
  1330.               $7B, $7C, $7C, $7D, $7D, $7E, $7E, $7F, $7F, $72, $73);
  1331.  
  1332.   Begin
  1333.     ShortJmp := False;
  1334.     If Not RetIndex(TokStr,TheInst,i) Then
  1335.       Exit;
  1336.     ShortJmp := True;
  1337.     NoAddrs := True;
  1338.     InsertByte(Opcode[I]);
  1339.     NextA;
  1340.     If Sym = Identifier Then Begin
  1341.       If FindLabel(B) Then Begin
  1342.         Addr := B-(ByteCount+1);
  1343.         If (Addr <= $7F) And (Addr >= -128) Then
  1344.           InsertByte(Lo(Addr))
  1345.         Else
  1346.           Error('Too Far')
  1347.       End Else Begin
  1348.         {-enter jump into fixups}
  1349.         New(Pf);
  1350.         With Pf^ Do Begin
  1351.           Next := Firstfix;
  1352.           If Firstfix <> Nil Then
  1353.             Firstfix^.Prev := Pf;
  1354.           Firstfix := Pf;
  1355.           Prev := Nil;
  1356.           Jmptype := Short;
  1357.           Name := Symname;
  1358.           Fix_pt := ByteCount; Indx := Tindex;
  1359.           InsertByte(0) {dummy insertion}
  1360.         End
  1361.       End;
  1362.       NextA
  1363.     End Else
  1364.       Error('Label Exp')
  1365.   End;
  1366.  
  1367.   Function ShfRot : Boolean;
  1368.   Type
  1369.     InsType        = (Rclx, Rcrx, Rolx, Rorx, Salx, Sarx, Shlx, Shrx);
  1370.     Codetype       = Array[Rclx..Shrx] Of Byte;
  1371.   Var
  1372.     Inst           : InsType;
  1373.     CL             : Byte;
  1374.   Const
  1375.     TheInst = 'RCL.RCR.ROL.ROR.SAL.SAR.SHL.SHR.';
  1376.     Regcode        : Codetype = ($10, $18, 0, 8, $20, $38, $20, $28);
  1377.   Begin
  1378.     ShfRot:= False;
  1379.     If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
  1380.       Exit;
  1381.     ShfRot:= True;
  1382.     NoAddrs := True;
  1383.     NextA;
  1384.     InsertByte($D0);      {may get modified later}
  1385.     If Register(Reg1, W1) Then
  1386.       InsertByte($C0+Regcode[Inst]+Reg1)
  1387.     Else
  1388.       If MemReg(W2) Then Begin
  1389.         Chk_BwPtr;
  1390.         W1:= Ord(ByWord);
  1391.         InsertByte(ModeByte+Regcode[Inst]);
  1392.         Displace_Bytes(W2);
  1393.       End Else
  1394.         Error('Reg or Mem Exp');
  1395.     If Sym = Comma Then NextA;
  1396.     CL := 0;
  1397.     If (Sym = Identifier) And (TokStr = 'CL') Then
  1398.       CL := 2
  1399.     Else
  1400.       If NValue <> 1 Then Error('CL or 1 Exp');
  1401.     NextA;
  1402.     Modify_Byte(Tindex0, CL+W1); {modify the opcode}
  1403.   End;
  1404.  
  1405.   Function CallJmp : Boolean;
  1406.   Type
  1407.     InsType   = (CALL, JMP);
  1408.     Codetype       = Array[CALL..JMP] Of Byte;
  1409.   Var
  1410.     Inst           : InsType;
  1411.     Dist           : (Long, Shrt, Near,NoDist);
  1412.     Tmp            : Byte;
  1413.     Dwtmp          : PtrType;
  1414.     B              : Integer;
  1415.     WordSize       : Boolean;
  1416.   Const
  1417.     TheInst = 'CALL.JMP.';
  1418.     TheDist = 'FAR.NEAR.SHORT.';
  1419.     Shortop        : Codetype = ($E8, $E9);
  1420.     Longop         : Codetype = ($9A, $EA);
  1421.     Longcode       : Codetype = ($18, $28);
  1422.     Shortcode      : Codetype = ($10, $20);
  1423.   Begin
  1424.     CallJmp := False;
  1425.     if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
  1426.       Exit;
  1427.     CallJmp := True;
  1428.     NextA;
  1429.     Dist := Nodist;
  1430.     Dwtmp := ByWord;              {could have passed a 'DWORD PTR' here}
  1431.     If Sym = JmpDist Then Begin
  1432.       If Not RetIndex(TokStr,TheDist,Byte(Dist)) Then
  1433.         Dist:= NoDist;
  1434.       NextA
  1435.     End;
  1436.     If (Sym = Address) Then Begin
  1437.       InsertByte(Longop[Inst]);
  1438.       InsertWord(NValue);
  1439.       InsertWord(Segm);
  1440.     End Else
  1441.       If Register(Reg1, W1) Then Begin
  1442.         If W1 = 0 Then WordReg;
  1443.         If Dist = Long Then Error('FAR not Permitted');
  1444.         InsertByte($FF);
  1445.         InsertByte($C0+Shortcode[Inst]+Reg1);
  1446.       End Else
  1447.         If Sym = Identifier Then Begin
  1448.           If Dist = Long Then Error('Far not Permitted with Label');
  1449.           If FindLabel(B) Then Begin
  1450.             Addr := B-(ByteCount+2);
  1451.             If Inst = CALL Then Begin
  1452.               InsertByte($E8);
  1453.               InsertWord(Addr-1)
  1454.             End Else
  1455.               If (Addr <= $7F) And (Addr >= -128) And (Dist <> Near) Then Begin
  1456.                 {-short jump}
  1457.                 InsertByte($EB);
  1458.                 InsertByte(Lo(Addr))
  1459.               End Else Begin
  1460.                 InsertByte($E9);
  1461.                 InsertWord(Addr-1)
  1462.               End
  1463.           End {findlabel} Else Begin
  1464.             {enter it into fixup chain}
  1465.             New(Pf);
  1466.             With Pf^ Do Begin
  1467.               Next := Firstfix;
  1468.               If Firstfix <> Nil Then
  1469.                 Firstfix^.Prev := Pf;
  1470.               Firstfix := Pf;
  1471.               Prev := Nil;
  1472.               Name := Symname;
  1473.               If Dist = Shrt Then Begin
  1474.                 Jmptype := Short;
  1475.                 InsertByte($EB);
  1476.                 Fix_pt := ByteCount;
  1477.                 Indx := Tindex;
  1478.                 InsertByte(0); {dummy insertion}
  1479.               End Else Begin
  1480.                 Jmptype := Med;
  1481.                 If Inst = CALL Then InsertByte($E8) Else InsertByte($E9);
  1482.                 Fix_pt := ByteCount; Indx := Tindex;
  1483.                 InsertByte(0); {dummy insertion}
  1484.                 Indx2 := Tindex;
  1485.                 InsertByte(0) {another dummy byte}
  1486.               End
  1487.             End {With Pf^}
  1488.           End
  1489.         End {identifier} Else
  1490.           If Data(WordSize) Then Begin
  1491.             {Direct CALL or JMP}
  1492.             If (Inst=JMP) And (Dist=Shrt) Then Begin
  1493.               If WordSize Then Error('Must be byte size');
  1494.               InsertByte($EB);
  1495.               Data_Bytes(False);
  1496.             End Else Begin
  1497.               If Not((Dist = Nodist) Or (Dist = Near)) Or (Dwtmp <> UnkPtr) Then
  1498.                 Error('Only NEAR permitted');
  1499.               If Not WordSize Then Error('Must be word size');
  1500.               InsertByte(Shortop[Inst]);
  1501.               Data_Bytes(True)
  1502.             End
  1503.           End Else
  1504.             If MemReg(W1) Then Begin
  1505.               If (Dist = Long) Or (Dwtmp = DwPtr) Then
  1506.                 Tmp := Longcode[Inst]
  1507.               Else
  1508.                 Tmp := Shortcode[Inst];
  1509.               InsertByte($FF);
  1510.               InsertByte(ModeByte+Tmp);
  1511.               Displace_Bytes(W1)
  1512.             End Else
  1513.               ErrNull;
  1514.     NextA
  1515.   End;
  1516.  
  1517.   Procedure Retrn(Far : Boolean);
  1518.   Const
  1519.     RetCodes1: array[boolean] of Byte = ($C2,$CA);
  1520.     RetCodes2: array[boolean] of Byte = ($C3,$CB);
  1521.   Begin
  1522.     If (Sym = Disp16) Or (Sym = Disp8) Then Begin
  1523.       InsertByte(RetCodes1[Far]);
  1524.       InsertWord(NValue);
  1525.       NextA
  1526.     End Else
  1527.       InsertByte(RetCodes2[Far])
  1528.   End;
  1529.  
  1530.   Function OtherInst : Boolean;
  1531.   Type
  1532.     Instsym = (Ret,Retf,Aam,Aad,Inn,Out,Mul,Imul,Divd,Idiv,Int);
  1533.   Var
  1534.     Index: Instsym;
  1535.     Tmp: Byte;
  1536.   Const
  1537.     TheInst = 'RET.RETF.AAM.AAD.IN.OUT.MUL.IMUL.DIV.IDIV.INT.';
  1538.  
  1539.     Procedure MulDiv(B : Byte);
  1540.     Var
  1541.       Wordbit: Integer;
  1542.     Begin
  1543.       InsertByte($F6);
  1544.       If Register(Reg2, W2) Then Begin
  1545.         InsertByte($C0+B+Reg2);
  1546.         Wordbit := W2;
  1547.       End Else
  1548.         If MemReg(W2) Then Begin
  1549.           Chk_BwPtr;
  1550.           Wordbit := Ord(ByWord);
  1551.           InsertByte(ModeByte+B);
  1552.           Displace_Bytes(W2)
  1553.         End Else
  1554.           Error('Reg or Mem Exp');
  1555.       Modify_Byte(Tindex0, Wordbit)
  1556.     End;
  1557.  
  1558.     Function DXreg : Boolean;
  1559.     Begin
  1560.       DXreg := False;
  1561.       If Sym = Identifier Then
  1562.         If TokStr = 'DX' Then Begin
  1563.           DXreg := True;
  1564.           NextA
  1565.         End
  1566.     End;
  1567.  
  1568.     Function Accum(Var W : Byte) : Boolean;
  1569.     Var
  1570.       Result_acc : Boolean;
  1571.       {See if next is AL or AX}
  1572.     Begin
  1573.       Result_acc := False;
  1574.       If (Sym = Identifier) Then Begin
  1575.           Result_acc:= (TokStr = 'AX') Or (TokStr = 'AL');
  1576.           If Result_acc Then Begin
  1577.             If TokStr[2] = 'X' Then
  1578.               W := 1
  1579.             Else
  1580.               W := 0; {word vs byte register}
  1581.             NextA
  1582.           End
  1583.         End;
  1584.       Accum:= Result_acc
  1585.     End;
  1586.  
  1587.   Begin
  1588.     OtherInst := False;
  1589.     if not RetIndex(TokStr,TheInst,Byte(Index)) Then
  1590.       Exit;
  1591.     OtherInst := True;
  1592.     NextA;
  1593.     Case Index Of
  1594.       Ret : Retrn(False);
  1595.       Retf : Retrn(True);
  1596.       Out : Begin
  1597.               If DXreg Then
  1598.                 InsertByte($EE) {out dx,ac}
  1599.               Else
  1600.                 If Sym = Disp8 Then Begin
  1601.                   {out port,ac}
  1602.                   InsertByte($E6);
  1603.                   InsertByte(Lo(NValue));
  1604.                   NextA
  1605.                 End Else
  1606.                   Error('DX or Port Exp');
  1607.               If Sym = Comma Then NextA;
  1608.               If Accum(W1) Then
  1609.                 Modify_Byte(Tindex0, W1) {al or ax}
  1610.               Else
  1611.                 Error('AX or AL Exp')
  1612.             End;
  1613.       Inn : Begin
  1614.               If Accum(W1) Then Begin
  1615.                 If Sym = Comma Then NextA;
  1616.                 If DXreg Then
  1617.                   InsertByte($EC+W1) {in ac,dx}
  1618.                 Else Begin
  1619.                   If Sym = Disp8 Then Begin     {in ac,port}
  1620.                     InsertByte($E4+W1);
  1621.                     InsertByte(Lo(NValue));
  1622.                     NextA;
  1623.                   End Else
  1624.                     Error('DX or Port Exp')
  1625.                 End
  1626.               End Else
  1627.                 Error('AX or AL Exp')
  1628.             End;
  1629.       Aam : Begin
  1630.               InsertByte($D4);
  1631.               Insertbyte($0A)
  1632.             End;
  1633.       Aad : Begin
  1634.               InsertByte($D5);
  1635.               InsertByte($0A)
  1636.             End;
  1637.       Mul : MulDiv($20);
  1638.       Imul : MulDiv($28);
  1639.       Divd : MulDiv($30);
  1640.       Idiv : MulDiv($38);
  1641.       Int : If Sym = Disp8 Then Begin
  1642.               If NValue = 3 Then
  1643.                 InsertByte($CC)
  1644.               Else Begin
  1645.                 InsertByte($CD);
  1646.                 InsertByte(Lo(NValue))
  1647.               End;
  1648.               NextA
  1649.             End Else
  1650.               ErrNull;
  1651.     End;
  1652.   End;
  1653.  
  1654.   Function GetQuoted(Var Ls : BigString) : Boolean;
  1655.   Var SaveChi, K : Integer;
  1656.     Term           : Char;
  1657.     Gq             : Boolean;
  1658.   Begin
  1659.     SkipSpaces;
  1660.     SaveChi := Chi; K := 1;
  1661.     Gq := False;
  1662.     If (UCh = '''') Or (UCh = '"') Then Begin
  1663.       Term := UCh; GetCh;
  1664.       While (UCh <> Term) And (UCh <> Chr(CR)) Do
  1665.         If (UCh <> Chr(CR)) And (K <= BigStringSize) Then Begin
  1666.           Ls[K]:= LCh;
  1667.           Inc(K);
  1668.           GetCh
  1669.         End;
  1670.       GetCh;                    {pass by term}
  1671.       Gq := Not(UCh In ['+', '-', '*', '/']) {else was meant to be expr}
  1672.     End;
  1673.     Ls[0] := Chr(K-1);
  1674.     If Not Gq Then Begin
  1675.       Chi := SaveChi-1;
  1676.       GetCh
  1677.     End;
  1678.     GetQuoted := Gq
  1679.   End;
  1680.  
  1681.   Procedure DataByte;
  1682.   Var
  1683.     I: Integer;
  1684.     Lst: BigString;
  1685.   Begin
  1686.     Repeat
  1687.       If GetQuoted(Lst) Then
  1688.         For I := 1 To Ord(Lst[0]) Do
  1689.           InsertByte(Lo(Ord(Lst[I])))
  1690.       Else
  1691.         If ReadByte Then
  1692.           InsertByte(Byt)
  1693.         Else
  1694.           ErrNull;
  1695.       While (UCh = ' ') Or (UCh = Chr(Tab)) Or (UCh = ',') Do GetCh;
  1696.     Until (UCh = Chr(CR)) Or (UCh = ';') Or Aerr;
  1697.     NextA;
  1698.   End;
  1699.  
  1700.   Procedure Chk_For_Label;
  1701.   Var
  1702.     Dum1, Dum2 : Byte;
  1703.   Begin
  1704.     If Not Prefix Then Begin
  1705.       {-could be prefix here}
  1706.       SkipSpaces;
  1707.       If (TokStr[0] > Chr(0)) And (UCh = ':') Then Begin
  1708.         {-label found}
  1709.         Sym := Identifier;
  1710.         If Register(Dum1, Dum2) Then
  1711.           Error('Register name used as label')
  1712.         Else Begin
  1713.           GetCh;
  1714.           Symname := TokStr;
  1715.           Pl:= Firstlabel; {check for duplication of label}
  1716.           While Pl <> Nil Do With Pl^ Do Begin
  1717.             If Symname = Name Then Error('Duplicate Label');
  1718.             Pl := Next
  1719.           End;
  1720.           New(Pl);          {add the label to the label chain}
  1721.           With Pl^ Do Begin
  1722.             Next:= Firstlabel;
  1723.             Firstlabel:= Pl;
  1724.             ByteCnt:= ByteCount;
  1725.             Name:= Symname
  1726.           End;
  1727.           Pf := Firstfix;   {see if any fixups are required}
  1728.           While Pf <> Nil Do With Pf^ Do Begin
  1729.             If Name = Symname Then Begin
  1730.               {-remove this fixup from chain}
  1731.               If Pf = Firstfix Then
  1732.                 Firstfix := Next
  1733.               Else
  1734.                 Prev^.Next := Next;
  1735.               If Next <> Nil Then Next^.Prev := Prev;
  1736.               Dispose(Pf);
  1737.               Addr := ByteCount-(Fix_pt+1);
  1738.               If Jmptype = Short Then
  1739.                 If Addr+$80 <= $FF Then
  1740.                   Modify_Byte(Indx, Lo(Addr))
  1741.                 Else
  1742.                   Error('Too Far')
  1743.               Else Begin
  1744.                 {-jmptype=med}
  1745.                 Dec(Addr);
  1746.                 Modify_Byte(Indx, Lo(Addr));
  1747.                 Modify_Byte(Indx2, Hi(Addr))
  1748.               End
  1749.             End;
  1750.             Pf := Next
  1751.           End
  1752.         End; {label found}
  1753.         GetString; {for next item to use}
  1754.       End
  1755.     End {neither a label or a prefix} Else
  1756.       GetString {it was a prefix}
  1757.   End;
  1758.  
  1759.   Procedure Interpret;
  1760.   Begin
  1761.     Tindex0 := Tindex;            {opcode position}
  1762.     GetString;
  1763.     Chk_For_Label;
  1764.     While Prefix Do               {process any prefix instructions}
  1765.       GetString;
  1766.     If Length(TokStr)=0 Then
  1767.       NextA                       {if not a string find out what}
  1768.     Else
  1769.       If NoOperand
  1770.       Or OneOperand
  1771.       Or TwoOperands
  1772.       Or ShortJmp
  1773.       Or CallJmp
  1774.       Or ShfRot
  1775.       Or OtherInst
  1776.       Or FaddType
  1777.       Or Fnoperand
  1778.       Or FiaddType
  1779.       Or FldType
  1780.       Or FmemOnly
  1781.       Or FildType
  1782.       Or FstiOnly Then
  1783.         {void}
  1784.       Else
  1785.         If TokStr='DB' Then
  1786.           DataByte
  1787.         Else
  1788.           If TokStr = 'NEW' Then Begin
  1789.             NewFnd := True;
  1790.             NextA
  1791.           End Else
  1792.             If TokStr = 'END' Then Begin
  1793.               TheEnd := True;
  1794.               NextA
  1795.             End Else
  1796.               Error('Unknown Instruction');
  1797.     If Sym <> EOLsym Then Error('End of Line Exp');
  1798.   End;
  1799.  
  1800.   Function DoAsm(InsertComments : Boolean) : Boolean;
  1801.   Var
  1802.     s              : String;
  1803.  
  1804.     Procedure LabelReport;        {Report any fixups not made and restore heap}
  1805.     Var
  1806.       Pftmp          : Fixup_Info_Ptr;
  1807.       Pltmp          : Label_Info_ptr;
  1808.     Begin
  1809.       Pf := Firstfix;
  1810.       While Pf <> Nil Do With Pf^ Do Begin
  1811.         WriteLn('Label not Found-- ', Name);
  1812.         DoAsm := False;
  1813.         Pftmp := Next;
  1814.         Dispose(Pf);
  1815.         Pf := Pftmp
  1816.       End;
  1817.       Pl := Firstlabel;
  1818.       While Pl <> Nil Do Begin
  1819.         Pltmp := Pl^.Next;
  1820.         Dispose(Pl);
  1821.         Pl := Pltmp
  1822.       End
  1823.     End;
  1824.  
  1825.   Begin {DoAsm}
  1826.     Wait_Already := False;
  1827.     EofInstr := False;
  1828.     NewFnd := True;
  1829.     TheEnd := False;
  1830.     Tindex := 0;
  1831.     Chi := 0;
  1832.     DoAsm := True;                {-we assume there's no error}
  1833.     While NewFnd And Not TheEnd Do Begin
  1834.       NewFnd := False;
  1835.       Start_Col := 1;
  1836.       ByteCount := 0;
  1837.       Firstlabel := Nil; Firstfix := Nil;
  1838.     (* InsertStr('inline(');
  1839.      * if InsertComments then
  1840.      * InsertStr(^m^j);
  1841.      *)
  1842.  
  1843.       While Not TheEnd And Not NewFnd Do Begin
  1844.         Aerr:= False; NoAddrs := False;
  1845.         ByWord:= UnkPtr;
  1846.         Column:= 0;
  1847.         GetCh;
  1848.         Sym := Othersym;
  1849.         SkipSpaces;
  1850.         If UCh <> Chr(CR) Then Begin {skip blank lines}
  1851.           StartChi := Chi;
  1852.           Interpret;
  1853.           If Aerr Then          {-mark error}
  1854.             DoAsm := False;
  1855.           If InsertComments And Not NewFnd Then Begin
  1856.             s := GetStr(StartChi);
  1857.             If s <> '' Then
  1858.               InsertStr(#9'{'+s+'}'^m^J)
  1859.           End;
  1860.           If Column>72 Then Begin
  1861.             InsertStr(^m^j);
  1862.             Column:= 0
  1863.           End
  1864.         End;
  1865.         If TheEnd Or NewFnd Then {-Fix up the last '/' inserted}
  1866.           TextArray[LastSlash] := ' '
  1867.       End;
  1868.       LabelReport {report any fixups not made and dispose all heap items}
  1869.     End
  1870.   End;
  1871.  
  1872.   Function ObjSize : Word;
  1873.   Begin
  1874.     ObjSize := Tindex
  1875.   End;
  1876.  
  1877. End.
  1878.