home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
INLINER.ZIP
/
INLINER.PAS
Wrap
Pascal/Delphi Source File
|
1990-05-17
|
52KB
|
1,595 lines
{ Inliner
Version 1.00 File: INLINER.PAS
Last revised: 12 Apr 1985 Author: Anthony M. Marcy
DESCRIPTION
Inliner is an assembler which translates 8088 assembly language directly
into Turbo Pascal INLINE code. It is written in, and generates code for,
Turbo Pascal 2.00 for the IBM PC. This program is in the public domain.
Inliner accepts a source language similar, but not identical, to that
of the IBM Macro Assembler (MASM). It produces a single Turbo INLINE statement
ready to be merged into a Pascal program or used as an Include file.
All 8088 instructions are supported. MASM pseudo-ops are not, and there
are a few differences in syntax between Inliner and MASM, as detailed below.
System requirements are those for running Turbo. If you can compile
Inliner, you can run it. (If you can't compile it, you don't need it.)
Maximum assembly program size is set by the size of memory. Inliner can use
all available contiguous memory.
The new version 3.00 of Turbo has changes to the INLINE statement which
make it not always compatible with code written for Turbo 2.00. Inliner 1.00
is designed to work with Turbo 2.00. In particular, assembly programs which
contain both labels and constant identifiers, and assembled by Inliner, may
not compile correctly under Turbo 3.00.
GETTING STARTED
You will be prompted for a source file and a target file. If no source
filename extension is given, .ASM is assumed. The default target file is
your source filename with extension .PAS; a carriage return accepts the
default, or you may enter any legal filename.
Quick trick: entering TRM: as the source file will allow you to type your
input directly into Inliner. It will not be saved, however, and no editing
is available. End your input with ctrl-z. Entering NUL as the target file
will cause no output file to be generated, but you can still see the output
on the screen. Handy if you just need a line or two, or for testing what
will "work".
Inliner may also be started from the DOS command line, thus:
A> inliner infile.asm outfile.pas
The second parameter may be omitted, in which case the default is assumed.
INSTRUCTION FORMAT
An Inliner source line takes the general form:
label: opcode operand, operand ;comment
Each of these components is optional.
A LABEL can be anything that would be legal as a Turbo identifier, limited
in length to a maximum of twenty characters. The colon is mandatory after
a label.
OPCODEs are the standard Intel mnemonics. LOCK and the various REP
prefixes are supported. The segment override prefix can only be placed before
an operand, not before the opcode.
OPERANDs can be of three general kinds: register, address, and immediate.
Register operands are the usual mnemonics - AX,BX, etc.
Address operands have the following form:
prefix: (type) [base] [index] offset
Each component is optional. The ordering is strict.
prefix is a segment override -- DS, CS, SS, or ES
type is a single letter -- N Near
F Far
S Short
W Word
B Byte
base is a base register -- BX or BP
index is an index register -- SI or DI
offset is either a literal constant or a Turbo identifier
Turbo identifiers are copied into the INLINE code. Any identifier which does
not occur as a label is assumed to be a Turbo identifier. The compiler replaces
variable names with their offsets within their segments; it replaces constant
identifiers with their values. The location counter, *, is also legal. See
the Turbo manual for details.
ADD AL,var1 ;var1 is a global variable in the data segment
ADD AL,[BP]var2 ;var2 is a local variable in the stack segment
ADD AL,CS:var3 ;var3 is a typed constant in the code segment
Immediate operands are distinguished by being prefixed with an equal sign.
They may be constants or Turbo variables. Thus,
MOV AX,=2 ;loads the value 2 into AX
MOV AX,2 ;loads AX with the word at offset 2 in the data segment
MOV AX,var1 ;loads AX with the contents of variable var1
MOV AX,=var1 ;loads the offset of variable var1 into AX
The equal sign is optional in the INT, RET, IN, and OUT instructions, and
before character literals.
CONSTANTs can be decimal integers (positive or negative), hex constants
in Turbo format (preceded by $), constant identifers, or character literals
enclosed in single quotes. Examples: 2 -128 $FF cons 'x'
The type must be specified when it cannot otherwise be deduced:
ADD AX,[BP]2 ;AX - must be a word operand
INC (W)[BP]2 ;requires (W) or (B)
Immediate numeric constants default to (B)yte if in the range -128..255,
otherwise (W)ord.
JMP requires special treatment. A (F)ar jump to an absolute address may be
coded with two operands, both immediate constants, representing the segment
and the offset:
JMP =$0060,=$0100 ;absolute address 0060:0100
A (N)ear jump to an offset in the CS requires a single immediate operand:
JMP =$0100 ;address CS:0100
JMP =*-1 ;this instruction jumps to itself
An indirect jump takes either a register or an address operand. In the latter
case, the type must be specified:
JMP AX ;must be (N)ear
JMP (F)[BP][SI]
JMP (N)var1
Lastly, the jump target may be an Inliner label. For forward references,
more efficient code can be generated if (S)hort is specified when possible:
JMP lab1
JMP (S)lab2
CALL is similar to JMP, except that (S)hort cannot be used.
The conditional jump instructions -- JE, JNE, etc. -- take a single
operand which may be either an immediate constant in the range -128..127
or an Inliner label.
The string instructions vary slightly from MASM syntax. REP, REPZ, etc.,
are considered prefixes which must be placed before a string opcode on the
same line. The special no-operand forms of the string opcodes -- MOVSB,
MOVSW, etc. -- are not implemented. Instead, use the basic opcode with
a type specifier. The full two-operand forms may also be written.
REP CMPS (B)
REP MOVS (W)[SI],[DI]
Other instructions resemble their counterparts in MASM. Refer to the
Macro Assembler manual for their formats. Inliner does not support any
pseudo-ops, such as PROC, END, DW, or ASSUME. Nor does it support the
8087 mnemonics.
Pascal declarations should be used to define data, in place of DB, DW,
EQU, etc. But remember that your variables are Turbo variables -- Inliner
cannot see your declarations to check type or addressibility. You must
provide segment overrides where needed.
EXAMPLES
Here are some more examples of Inliner code:
PUSH BP
h2: CMP var1,=-1 ;byte variable assumed
CMP var1,(W)=-1 ;unless overridden
MOV var2,=var4 ;address is always two bytes
JE (S)h5
REPE SCAS(B) ;instead of SCASB
shl ax,cl ;lower case is OK
ESC = 23 , [ DI ] var2 ;spaces are OK, too
MOV ES:4,'&'
h5: SUB (W)var3,=$40
NOP
CALL (N)xyz ;indirect through variable xyz
;unless xyz is a label
MOV [BX][DI],CS
RET (N) 4 ;(N) or (F) required
-----------------------------------------------------------------
Inliner is supported on the RBBS-PC operated by
James Miles
"The Programmer's Toolbox"
(301) 540-7230 (data)
24 Hrs.
Comments, bug reports, and suggested improvements are encouraged. Address
them to ANTHONY MARCY or to SYSOP. If you make extensions or revisions
to this program, please upload so that all may share.
Enjoy!
-----------------------------------------------------------------}
program inliner;
const
tsize = 200; { size of symbol table }
type
filename = string[20];
opcode = (nul,
mov,push,pop,xchg,in_,out,xlat,lea,lds,les,lahf,sahf,pushf,
popf,add,adc,inc,sub,sbb,dec,neg,cmp,aas,das,mul,imul,aam,div_,
idiv,aad,cbw,cwd,not_,shl_,sal,shr_,sar,rol,ror,rcl,rcr,and_,
test_,or_,xor_,aaa,daa,rep,repe,repz,repne,repnz,movs,cmps,scas,
lods,stos,call,jmp,ret,je,jz,jl,jnge,jle,jng,jb,jnae,jbe,jna,jp,
jpe,jo,js,jne,jnz,jnl,jge,jnle,jg,jnb,jae,jnbe,ja,jnp,jpo,jno,jns,
loop,loopz,loope,loopnz,loopne,jcxz,int,into,iret,
clc,cmc,stc,cld,std,cli,sti,hlt,wait,esc,lock,nop,
valid,
assume,comment,db,dd,dq,dt,dw,end_,equ,even,extrn,group,include,
label_,name,org,proc,public,record_,segment,struc,macro,endm,
page,subttl,title,
fld,fst,fstp,fxch,fcom,fcomp,fcompp,ftst,fxam,fadd,fsub,fmul,fdiv,
fsqrt,fscale,fprem,frndint,fxtract,fabs,fchs,fptan,fpatan,f2xm1,
fyl2x,fyl2xp1,fldz,fld1,fldpi,fldl2t,fldl2e,fldlg2,fldln2,finit,
feni,fdisi,fldcw,fstcw,fstsw,fclex,fstenv,fldenv,fsave,frstor,
fincstp,fdecstp,ffree,fnop,fwait,
last);
regs = (firstreg,ax,bx,cx,dx,sp,bp,si,di,al,bl,cl,dl,ah,bh,ch,dh,
ds,ss,cs,es,lastreg);
line = string[80];
idtype = string[20];
attr = record { attributes of an operand }
isop: boolean;
isaddr: boolean;
isid: boolean;
isconst: boolean;
value: integer;
isreg: boolean;
issreg: boolean;
rg: regs;
isimmed: boolean;
isidx,isbase: boolean;
idx,base: regs;
isbyte,isword: boolean;
isshort,isnear,isfar: boolean;
ident: idtype;
end;
cptr = ^codrec;
codrec = record { intermediate form of a line of code }
next: cptr;
labeln: integer;
op: opcode;
op1,op2: attr;
repx: opcode;
lockx: boolean;
override: regs;
source: line;
errn: byte;
end;
charset = set of char;
var
reg: array[regs] of string[2]; { register mnemonics }
rn: array[regs] of 0..7; { register numbers }
mn: array[opcode] of string[6]; { opcode mnemonics }
tab: array[0..tsize] of record { symbol table }
id: idtype;
val: integer;
end;
src,targ: text; { source and target files }
errn,pass: byte; { error #, pass # }
atstart,ok: boolean;
t: string[132]; { target line }
loc: integer; { location counter }
tcnt: integer; { number of entries in symbol table }
n: integer; { index into symbol table }
oldlen: integer;
firstentry: cptr; { points to first line of intermediate code }
codpnt: cptr; { points to current line of intermediate code }
op: opcode;
op1,op2: attr;
repx: opcode;
lockx: boolean;
override: regs;
procedure error(j: integer); { only the first error in a line is recorded }
begin
if errn = 0 then errn := j;
end;
procedure message; { print error messages }
begin
if errn <> 0
then begin
ok := false;
t := t + '***';
case errn of
1: t := t + 'NOT ENOUGH OPERANDS';
2: t := t + 'INVALID OPERAND';
3: t := t + 'TYPE CONFLICT';
4: t := t + 'INVALID OPCODE';
5: t := t + 'INVALID REGISTER';
6: t := t + 'SYNTAX ERROR';
7: t := t + 'TYPE NOT SPECIFIED';
8: t := t + 'ILLEGAL REGISTER';
9: t := t + 'ERROR IN CONSTANT';
10: t := t + 'ILLEGAL OPERAND';
11: t := t + 'TOO MANY OPERANDS';
12: t := t + 'CONSTANT TOO BIG';
13: t := t + 'DUPLICATE PREFIX';
14: t := t + 'IDENTIFIER TOO LONG';
15: t := t + 'DUPLICATE LABEL';
16: t := t + 'UNDEFINED LABEL';
17: t := t + 'LABEL TOO FAR';
18: t := t + 'NOT IMPLEMENTED';
{ 29: system error }
else t := t + 'SYSTEM ERROR';
end;
t := t + '***'
end
end;
function stupcase(st: idtype): idtype;
var i: integer;
begin
for i := 1 to length(st) do
st[i] := upcase(st[i]);
stupcase := st
end; { stupcase }
procedure startup; { input names of source and target files }
var
exists: boolean;
inf,outf,tempstr: filename;
commandline: string[127] absolute cseg:$80;
params: string[127];
default: byte;
procedure chkinf; { does source file exist? }
begin
inf := stupcase(inf);
if pos('.',inf) = 0
then inf := inf + '.ASM';
assign(src,inf);
{$I-} reset(src) {$I+} ; { if so, open it }
exists := (ioresult = 0);
if pos(':',inf) = 0
then inf := chr(default+65) + ':' + inf;
if not exists
then writeln('File ', inf, ' not found');
end;
procedure chkoutf; { is target filename valid? }
begin
outf := stupcase(outf);
assign(targ,outf);
{$I-} rewrite(targ) {$I+} ; { if so, open it }
exists := (ioresult = 0);
if pos(':',outf) = 0
then outf := chr(default+65) + ':' + outf;
if not exists
then writeln('can''t open file ',outf);
end;
begin
inf := ''; outf := ''; params := commandline;
Inline(
$B4/$19 { MOV AH,=$19 }
/$CD/$21 { INT =$21 }
/$88/$86/default ); { MOV [BP]default,AL }
while (params <> '') and (params[1] = ' ') do
delete(params,1,1);
if params <> ''
then begin { command line parameters }
while (params <> '') and (params[1] <> ' ') do begin
inf := inf + params[1];
delete(params,1,1); end;
chkinf;
if not exists then begin
commandline := '';
startup; end
else begin
writeln('Source file: ',inf);
while (params <> '') and (params[1] = ' ') do
delete(params,1,1);
if params <> ''
then while (params <> '') and (params[1] <> ' ') do begin
outf := outf + params[1];
delete(params,1,1); end
else outf := copy(inf,1,pos('.',inf)) + 'PAS';
chkoutf;
if not exists then begin
commandline := '';
startup; end
else writeln('Target file: ',outf);
end;
end
else begin { prompt for filenames }
repeat
write(' Source file [.ASM] ? '); readln(inf);
chkinf;
until exists;
tempstr := copy(inf,1,pos('.',inf)) + 'PAS';
repeat
repeat
write(' Target file [',tempstr,'] ? ');
readln(outf); outf := stupcase(outf);
until inf <> outf;
if outf = '' then outf := tempstr;
chkoutf;
until exists;
end;
writeln;
end; { startup }
procedure init; { initialize tables }
begin
mn[mov ] := 'MOV' ; mn[push] := 'PUSH'; mn[pop ] := 'POP' ;
mn[xchg] := 'XCHG'; mn[in_ ] := 'IN' ; mn[out ] := 'OUT' ;
mn[xlat] := 'XLAT'; mn[lea ] := 'LEA' ; mn[lds ] := 'LDS' ;
mn[les ] := 'LES' ; mn[lahf] := 'LAHF'; mn[pushf] := 'PUSHF';
mn[sahf] := 'SAHF'; mn[popf] := 'POPF'; mn[add ] := 'ADD' ;
mn[adc ] := 'ADC' ; mn[inc ] := 'INC' ; mn[sub ] := 'SUB' ;
mn[sbb ] := 'SBB' ; mn[dec ] := 'DEC' ; mn[cmp ] := 'CMP' ;
mn[aas ] := 'AAS' ; mn[das ] := 'DAS' ; mn[mul ] := 'MUL' ;
mn[imul] := 'IMUL'; mn[aam ] := 'AAM' ; mn[div_] := 'DIV' ;
mn[idiv] := 'IDIV'; mn[aad ] := 'AAD' ; mn[cbw ] := 'CBW' ;
mn[cwd ] := 'CWD' ; mn[aaa ] := 'AAA' ; mn[daa ] := 'DAA' ;
mn[not_] := 'NOT' ; mn[shl_] := 'SHL' ; mn[sal ] := 'SAL' ;
mn[shr_] := 'SHR' ; mn[sar ] := 'SAR' ; mn[rol ] := 'ROL' ;
mn[ror ] := 'ROR' ; mn[rcl ] := 'RCL' ; mn[rcr ] := 'RCR' ;
mn[and_] := 'AND' ; mn[or_ ] := 'OR' ; mn[test_] := 'TEST';
mn[xor_] := 'XOR' ; mn[rep ] := 'REP' ; mn[repne] := 'REPNE';
mn[repe] := 'REPE'; mn[repz] := 'REPZ'; mn[repnz] := 'REPNZ';
mn[movs] := 'MOVS'; mn[neg ] := 'NEG' ; mn[nop ] := 'NOP' ;
mn[cmps] := 'CMPS'; mn[scas] := 'SCAS'; mn[lods] := 'LODS';
mn[stos] := 'STOS'; mn[call] := 'CALL'; mn[jmp ] := 'JMP' ;
mn[ret ] := 'RET' ; mn[je ] := 'JE' ; mn[jz ] := 'JZ' ;
mn[jl ] := 'JL' ; mn[jnge] := 'JNGE'; mn[jle ] := 'JLE' ;
mn[jng ] := 'JNG' ; mn[jb ] := 'JB' ; mn[jnae] := 'JNAE';
mn[jbe ] := 'JBE' ; mn[jna ] := 'JNA' ; mn[jp ] := 'JP' ;
mn[jpe ] := 'JPE' ; mn[jo ] := 'JO' ; mn[js ] := 'JS' ;
mn[jne ] := 'JNE' ; mn[jnz ] := 'JNZ' ; mn[jnl ] := 'JNL' ;
mn[jge ] := 'JGE' ; mn[jnle] := 'JNLE'; mn[jg ] := 'JG' ;
mn[jnb ] := 'JNB' ; mn[jae ] := 'JAE' ; mn[jnbe] := 'JNBE';
mn[ja ] := 'JA' ; mn[jnp ] := 'JNP' ; mn[jpo ] := 'JPO' ;
mn[jno ] := 'JNO' ; mn[jns ] := 'JNS' ; mn[loopz ] := 'LOOPZ' ;
mn[loop] := 'LOOP'; mn[jcxz] := 'JCXZ'; mn[loopnz] := 'LOOPNZ';
mn[int ] := 'INT' ; mn[into] := 'INTO'; mn[loope ] := 'LOOPE' ;
mn[iret] := 'IRET'; mn[clc ] := 'CLC' ; mn[loopne] := 'LOOPNE';
mn[cmc ] := 'CMC' ; mn[stc ] := 'STC' ; mn[cld ] := 'CLD' ;
mn[std ] := 'STD' ; mn[cli ] := 'CLI' ; mn[sti ] := 'STI' ;
mn[hlt ] := 'HLT' ; mn[wait] := 'WAIT'; mn[esc ] := 'ESC' ;
mn[lock] := 'LOCK';
mn[valid] := '';
mn[db ] := 'DB' ; mn[assume ] := 'ASSUME' ;
mn[dd ] := 'DD' ; mn[comment] := 'COMMENT';
mn[dq ] := 'DQ' ; mn[extrn ] := 'EXTRN' ;
mn[dt ] := 'DT' ; mn[group ] := 'GROUP' ;
mn[dw ] := 'DW' ; mn[include] := 'INCLUDE';
mn[end_] := 'END' ; mn[label_ ] := 'LABEL' ;
mn[equ ] := 'EQU' ; mn[public ] := 'PUBLIC' ;
mn[even] := 'EVEN'; mn[record_] := 'RECORD' ;
mn[name] := 'NAME'; mn[segment] := 'SEGMENT';
mn[org ] := 'ORG' ; mn[struc ] := 'STRUC' ;
mn[proc] := 'PROC'; mn[macro ] := 'MACRO' ;
mn[endm] := 'ENDM'; mn[subttl ] := 'SUBTTL' ;
mn[page] := 'PAGE'; mn[title ] := 'TITLE' ;
mn[fld ] := 'FLD' ; mn[fst ] := 'FST' ; mn[fstp ] := 'FSTP' ;
mn[fxch ] := 'FXCH' ; mn[fcom ] := 'FCOM' ; mn[fcomp ] := 'FCOMP' ;
mn[fcompp] := 'FCOMPP'; mn[ftst ] := 'FTST' ; mn[fxam ] := 'FXAM' ;
mn[fadd ] := 'FADD' ; mn[fsub ] := 'FSUB' ; mn[fmul ] := 'FMUL' ;
mn[fdiv ] := 'FDIV' ; mn[fsqrt ] := 'FSQRT' ; mn[fscale] := 'FSCALE';
mn[fprem ] := 'FPREM' ; mn[fabs ] := 'FABS' ; mn[frndint] := 'FRNDINT';
mn[fchs ] := 'FCHS' ; mn[fptan ] := 'FPTAN' ; mn[fxtract] := 'FXTRACT';
mn[fpatan] := 'FPATAN'; mn[f2xm1 ] := 'F2XM1' ; mn[fyl2x ] := 'FYL2X' ;
mn[fldz ] := 'FLDZ' ; mn[fld1 ] := 'FLD1' ; mn[fyl2xp1] := 'FYL2XP1';
mn[fldpi ] := 'FLDPI' ; mn[fldl2t] := 'FLDL2T'; mn[fldl2e] := 'FLDL2E';
mn[fldlg2] := 'FLDLG2'; mn[fldln2] := 'FLDLN2'; mn[finit ] := 'FINIT' ;
mn[feni ] := 'FENI' ; mn[fdisi ] := 'FDISI' ; mn[fldcw ] := 'FLDCW' ;
mn[fstcw ] := 'FSTCW' ; mn[fstsw ] := 'FSTSW' ; mn[fclex ] := 'FCLEX' ;
mn[fstenv] := 'FSTENV'; mn[fldenv] := 'FLDENV'; mn[fsave ] := 'FSAVE' ;
mn[frstor] := 'FRSTOR'; mn[ffree ] := 'FFREE' ; mn[fincstp] := 'FINCSTP';
mn[fnop ] := 'FNOP' ; mn[fwait ] := 'FWAIT' ; mn[fdecstp] := 'FDECSTP';
reg[ax] := 'AX'; reg[bx] := 'BX'; reg[cx] := 'CX'; reg[dx] := 'DX';
reg[sp] := 'SP'; reg[bp] := 'BP'; reg[si] := 'SI'; reg[di] := 'DI';
reg[al] := 'AL'; reg[bl] := 'BL'; reg[cl] := 'CL'; reg[dl] := 'DL';
reg[ah] := 'AH'; reg[bh] := 'BH'; reg[ch] := 'CH'; reg[dh] := 'DH';
reg[ds] := 'DS'; reg[ss] := 'SS'; reg[cs] := 'CS'; reg[es] := 'ES';
rn[ax] := 0; rn[bx] := 3; rn[cx] := 1; rn[dx] := 2;
rn[sp] := 4; rn[bp] := 5; rn[si] := 6; rn[di] := 7;
rn[al] := 0; rn[bl] := 3; rn[cl] := 1; rn[dl] := 2;
rn[ah] := 4; rn[bh] := 7; rn[ch] := 5; rn[dh] := 6;
rn[ds] := 3; rn[ss] := 2; rn[cs] := 1; rn[es] := 0;
end; { init }
function search(symbol: idtype): boolean; { search symbol table }
begin { return index in global n }
n := 0;
symbol := stupcase(symbol);
while (tab[n].id <> symbol) and (n <= tcnt) do n := n+1;
if n = tcnt+1
then search := false
else search := true;
end;
procedure generate; { pass 2 -- maintain location counter }
{ pass 3 -- generate object code }
var
q0,w,md,rm: byte;
q1: integer;
procedure oneop; { test for exactly one operand }
begin
if op2.isop then error(11);
if not op1.isop then error(1);
end;
procedure emit(q:byte); { emit one byte }
function hex(d:byte): char;
begin
if d <= 9
then hex := chr(48+d)
else hex := chr(55+d);
end;
begin
loc := loc+1;
if (pass=3) and (errn = 0) then begin
if atstart then t := t+' ' else t := t+'/';
atstart := false;
t := t+'$'+hex(q shr 4)+hex(q and 15);
end;
end;
procedure emit2(q:integer); { emit two bytes }
begin
begin
emit(q and $ff);
emit(q shr 8);
end
end;
procedure emitid(ident: idtype); { emit identifier }
begin
loc := loc+2;
if (pass=3) and (errn = 0) then t := t+'/'+ident;
end;
procedure emitimm(op:attr); { emit immediate value }
begin
with op do
if isid then emitid(ident)
else if isconst then if (w=1) then emit2(value) else emit(value)
else error(10);
end;
procedure checktype(op1,op2:attr); { check compatibility of operands }
begin
if (op1.isword and not op2.isbyte) or (op2.isword and not op1.isbyte)
then w := 1
else if (op1.isbyte and not op2.isword) or (op2.isbyte and not op1.isword)
then w := 0
else if not (op1.isbyte or op1.isword or op2.isbyte or op2.isword)
then error(7)
else error(3);
if op1.issreg or op2.issreg then w := 0;
end;
procedure modrm(q:byte; op:attr); { construct the modregr/m byte }
begin
with op do begin
if isid then md := 2
else if isconst
then if (value <= 127) and (value >= -128) then md := 1 else md := 2
else md := 0;
if isidx and isbase
then begin
if base = bx then rm := 0 else rm := 2;
if idx = di then rm := rm+1;
end
else if not isidx and not isbase
then begin
md := 0; rm := 6; end
else begin
rm := 4;
if isidx and (idx = di) then rm := rm+1;
if isbase
then if base = bp then rm := rm+2 else rm := rm+3;
end;
emit((md shl 6)+(q shl 3)+rm);
if isid then emitid(ident);
if isconst then begin
if (value <= 127) and (value >= -128) then begin
emit(value);
if (md=0) and (rm=6) then if value<0 then emit($ff) else emit(0);
end
else emit2(value);
end;
end; end;
procedure regtoreg(q:byte; op1,op2:attr);
begin
checktype(op1,op2);
emit(q+w);
emit(192 + (rn[op1.rg] shl 3) + rn[op2.rg]);
end;
procedure imtoacc(q:byte; op1,op2:attr);
begin
checktype(op1,op2);
emit(q+w);
emitimm(op2);
end;
procedure imtoreg(q:byte; op1,op2:attr);
begin
if op1.isword and op2.isbyte then w := 1 else checktype(op1,op2);
emit(q+(w shl 3)+rn[op1.rg]);
emitimm(op2);
end;
procedure onerm(q:byte; op:attr);
begin
with op do begin
if isreg
then emit(192+(q shl 3)+rn[rg])
else if isaddr then modrm(q,op)
else error(10);
end;
end;
procedure imtorm(q,r:byte; op1,op2:attr; ext:boolean);
begin
if op1.isbyte and op2.isword then error(3)
else if op1.isbyte and op2.isbyte then w := 0
else if op1.isword and op2.isword then w := 1
else if op1.isword and op2.isbyte then if ext then w := 3 else w := 1
else if op1.isaddr and op2.isbyte then w := 0
else if op1.isaddr and op2.isword then w := 1
else error(29);
emit(q+w);
onerm(r,op1);
emitimm(op2);
end;
procedure regmem(q: byte; op1,op2: attr);
begin
checktype(op1,op2);
emit(q+w);
modrm(rn[op1.rg],op2);
end;
procedure inout(q:byte; op1,op2:attr);
begin
if not (op1.isreg and (op1.rg in [ax,al])) then error(10);
if op1.rg=ax then w := 1 else w := 0;
if op2.isconst then begin
if op2.isidx or op2.isbase then error(10);
if (op2.value < 0) or (op2.value > 255) then error(12);
emit(q+w);
emit(op2.value);
end
else if op2.isreg and (op2.rg=dx) then emit(q+8+w)
else error(10);
end;
begin { generate }
t := ''; errn := codpnt^.errn;
op1 := codpnt^.op1; op2 := codpnt^.op2;
with codpnt^ do begin
if errn=0 then begin
if repx in [rep,repne,repnz] then emit($f2);
if repx in [repe,repz] then emit($f3);
if lockx then emit($f0);
if override in [ds,cs,ss,es] then emit($26+(rn[override] shl 3));
case op of
nul: ;
mov: begin
w := 1;
if not (op1.isop and op2.isop)
then error(1)
else if op1.issreg then begin
if op1.rg=cs then error(10);
q0 := $8e;
if op2.isreg then regtoreg(q0,op1,op2)
else if op2.isaddr then regmem(q0,op1,op2)
else error(10);
end
else if op2.issreg then begin
q0 := $8c;
if op1.isreg then regtoreg(q0,op2,op1)
else if op1.isaddr then regmem(q0,op2,op1)
else error(10);
end
else if op2.isimmed then begin
if op1.isreg
then imtoreg($b0,op1,op2)
else imtorm($c6,0,op1,op2,false);
end
else if op1.isreg and (op1.rg in [ax,al]) and op2.isaddr
and not op2.isbase and not op2.isidx then begin
if op1.rg = ax then emit($a1) else emit($a0);
emitimm(op2);
end
else if op2.isreg and (op2.rg in [ax,al]) and op1.isaddr
and not op1.isbase and not op1.isidx then begin
if op2.rg = ax then emit($a3) else emit($a2);
emitimm(op1);
end
else if op1.isreg and op2.isreg then begin
q0 := $8a;
regtoreg(q0,op1,op2); end
else if (op1.isreg and op2.isaddr) or (op1.isaddr and op2.isreg)
then begin
q0 := $88;
if op1.isaddr
then regmem(q0,op2,op1)
else begin
q0 := q0+2;
regmem(q0,op1,op2)
end
end
else error(10);
end;
add,adc,sub,sbb,cmp,and_,or_,xor_,test_:
begin
if not (op1.isop and op2.isop)
then error(1)
else
if op2.isimmed
then if op1.isreg and ((op1.rg=ax) or (op1.rg=al))
then begin
if op1.isword then op2.isbyte := false;
case op of
add: q0 := $04;
adc: q0 := $14;
sub: q0 := $2c;
sbb: q0 := $1c;
cmp: q0 := $3c;
and_: q0 := $24;
or_ : q0 := $0c;
xor_: q0 := $34;
test_: q0 := $a8;
end;
imtoacc(q0,op1,op2);
end
else begin
q0 := $80;
case op of
add: q1 := 0;
adc: q1 := 2;
sub: q1 := 5;
sbb: q1 := 3;
cmp: q1 := 7;
and_: q1 := 4;
or_ : q1 := 1;
xor_: q1 := 6;
test_: begin q0 := $f6; q1 := 0; end;
end;
if op in [add,adc,sub,sbb,cmp]
then imtorm(q0,q1,op1,op2,true)
else imtorm(q0,q1,op1,op2,false);
end
else if op1.isreg and op2.isreg
then begin
case op of
add: q0 := $02;
adc: q0 := $12;
sub: q0 := $2a;
sbb: q0 := $1a;
cmp: q0 := $3a;
and_: q0 := $22;
or_ : q0 := $0a;
xor_: q0 := $32;
test_: q0 := $84;
end;
regtoreg(q0,op1,op2);
end
else if (op1.isaddr and op2.isreg) or (op1.isreg and op2.isaddr)
then begin
case op of
add: q0 := $00;
adc: q0 := $10;
sub: q0 := $28;
sbb: q0 := $18;
cmp: q0 := $38;
and_: q0 := $20;
or_ : q0 := $08;
xor_: q0 := $30;
test_: q0 := $84;
end;
if op1.isaddr
then regmem(q0,op2,op1)
else begin
if op<>test_ then q0 := q0+2;
regmem(q0,op1,op2)
end
end
else error(10);
end;
push,pop:
begin
with op1 do begin
oneop;
if issreg then begin
if (op=pop) and (rg=cs) then error(10);
case op of
push: q0 := $06;
pop: q0 := $07;
end;
emit(q0+(rn[rg] shl 3));
end
else if isreg then begin
if not isword then error(3);
case op of
push: q0 := $50;
pop: q0 := $58;
end;
emit(q0+rn[rg]);
end
else if isaddr then begin
if isbyte then error(3);
case op of
push: begin q0 := $ff; q1 := 6; end;
pop: begin q0 := $8f; q1 := 0; end;
end;
emit(q0);
onerm(q1,op1);
end
else error(10);
end;
end;
inc,dec:
begin
with op1 do begin
oneop;
if isreg and isword then begin
case op of
inc: q0 := $40;
dec: q0 := $48;
end;
emit(q0+rn[rg]);
end
else if isaddr or isreg then begin
if isbyte then w := 0
else if isword then w := 1
else error(7);
case op of
inc: q1 := 0;
dec: q1 := 1;
end;
emit($fe+w);
onerm(q1,op1);
end
else error(10);
end;
end;
xchg:
begin
if not op2.isop then error(1);
if op1.isreg and op2.isreg and ((op1.rg=ax) or (op2.rg=ax))
then begin
if op1.rg<>ax
then emit($90+rn[op1.rg])
else emit($90+rn[op2.rg]);
end
else if op1.isreg and op2.isreg
then regtoreg($86,op1,op2)
else if op1.isreg and op2.isaddr
then regmem($86,op1,op2)
else if op1.isaddr and op2.isreg
then regmem($86,op2,op1)
else error(10);
end;
mul,imul,div_,idiv,neg,not_:
begin
oneop;
if op1.isbyte then q0 := $f6
else if op1.isword then q0 := $f7
else error(7);
case op of
mul: q1 := 4;
imul: q1 := 5;
div_: q1 := 6;
idiv: q1 := 7;
neg: q1 := 3;
not_: q1 := 2;
end;
emit(q0);
onerm(q1,op1);
end;
in_: inout($e4,op1,op2);
out: inout($e6,op2,op1);
lea,lds,les:
begin
if not op2.isop then error(1);
if not(op1.isreg and op1.isword and op2.isaddr) then error(10);
case op of
lea: q0 := $8d;
lds: q0 := $c5;
les: q0 := $c4;
end;
emit(q0);
onerm(rn[op1.rg],op2);
end;
shl_,sal,shr_,sar,rol,ror,rcl,rcr:
begin
with op2 do begin
if not isop then error(1);
if isidx or isbase then error(10);
if isconst and (value=1) then q0 := $d0
else if isreg and (rg=cl) then q0 := $d2
else error(10);
case op of
shl_,sal: q1 := 4;
shr_: q1 := 5;
sar: q1 := 7;
rol: q1 := 0;
ror: q1 := 1;
rcl: q1 := 2;
rcr: q1 := 3;
end;
if op1.isword
then q0 := q0+1
else if not op1.isbyte then error(7);
if not(op1.isreg or op1.isaddr) then error(10);
emit(q0);
onerm(q1,op1);
end;
end;
lods,stos,scas:
begin
with op1 do begin
if op2.isop then error(11);
if not op1.isop then error(7);
case op of
lods: q0 := $ac;
stos: q0 := $aa;
scas: q0 := $ae;
end;
if isword then q0 := q0+1 else if not isbyte then error(7);
if isbase or isimmed or isreg then error(10);
if isidx and (((idx=si) and (op in [stos,scas]))
or ((idx=di) and (op=lods))) then error(10);
emit(q0);
end; end;
movs,cmps:
begin
if op2.isop then begin
checktype(op1,op2);
if op2.isidx and (((op2.idx=di) and (op=movs))
or ((op2.idx=si) and (op=cmps))) then error(10);
if op2.isbase or op2.isimmed or op2.isreg then error(10);
end
else if op1.isop then begin
if op1.isword then w := 1
else if op1.isbyte then w := 0
else error(7);
if op1.isimmed or op1.isreg or op1.isaddr then error(10);
end
else error(7);
if op1.isop then begin
if op1.isbase or op1.isimmed or op1.isreg then error(10);
if op1.isidx and (((op1.idx=si) and (op=movs))
or ((op1.idx=di) and (op=cmps))) then error(10);
end;
case op of
movs: emit($a4+w);
cmps: emit($a6+w);
end;
end;
ret:
begin
if op2.isop then error(11);
if not op1.isop then error(1);
with op1 do begin
if isidx or isbase or isreg or isid then error(10);
if isconst then q0 := $c2 else q0 := $c3;
if isfar then q0 := q0+8
else if not isnear
then if isshort then error(10) else error(7);
emit(q0);
if isconst then emit2(value);
end
end;
jmp,call:
begin
with op1 do begin
w := 1;
if op2.isop then begin
if not (isimmed and op2.isimmed) then error(10);
if isnear or op2.isnear then error(3);
case op of
jmp: emit($ea);
call: emit($9a);
end;
emitimm(op1);
emitimm(op2);
end
else if not op1.isop then error(1)
else if isfar then begin
if (not isaddr) or (isid and search(ident)) then error(10);
emit($ff);
case op of
jmp: onerm(5,op1);
call: onerm(3,op1);
end;
end
else if isimmed and isconst then begin
if (value<=127) and (value>=-128) and (op=jmp)
then begin emit($eb); emit(value); end
else begin
case op of
jmp: emit($e9);
call: emit($e8);
end;
emitimm(op1); end;
end
else if isid and search(ident) then begin
if isidx or isbase then error(2);
q1 := tab[n].val-loc-2;
if pass=3 then begin
if (op=jmp) and (q1 >= -128) and (q1 <= 127)
then begin
emit($eb);
if isshort then emit(q1)
else begin emit(q1); emit($90); end;
end
else begin
case op of
jmp: begin
if isshort then error(17);
emit($e9); end;
call: begin
if isshort then error(10);
emit($e8); end;
end;
emit2(q1-1);
end;
end
else begin {pass2}
if (op=jmp) and (isshort or ((tab[n].val > -1) and (q1 > -128)))
then begin emit2(0); isshort := true; end
else begin emit2(0); emit(0); end;
end;
end
else if (isreg or isaddr) and not (isbyte or isshort) then begin
if not (isnear or isreg) then error(7);
emit($ff);
case op of
jmp: onerm(4,op1);
call: onerm(2,op1);
end;
end
else error(10);
end;
end;
je,jz,jl,jnge,jle,jng,jb,jnae,jbe,jna,jp,jpe,jo,js,jne,jnz,jnl,jge,jnle,
jg,jnb,jae,jnbe,ja,jnp,jpo,jno,jns,loop,loopz,loope,loopnz,loopne,jcxz:
begin
oneop;
with op1 do begin
if (isimmed and isconst)
then if not ((value>=-128) and (value<=127)) then error(12) else
else if not (isid and not (isidx or isbase)) then error(10);
case op of
je,jz: q0 := $74;
jl,jnge: q0 := $7c;
jle,jng: q0 := $7e;
jb,jnae: q0 := $72;
jbe,jna: q0 := $76;
jp,jpe: q0 := $7a;
jo: q0 := $70;
js: q0 := $78;
jne,jnz: q0 := $75;
jnl,jge: q0 := $7d;
jnle,jg: q0 := $7f;
jnb,jae: q0 := $73;
jnbe,ja: q0 := $77;
jnp,jpo: q0 := $7b;
jno: q0 := $71;
jns: q0 := $79;
loop: q0 := $e2;
loopz,loope: q0 := $e1;
loopnz,loopne: q0 := $e0;
jcxz: q0 := $e3;
end;
if isconst
then begin emit(q0); emit(value); end
else begin
if (pass=3) and not search(ident) then error(16);
q1 := tab[n].val-loc-2;
if (pass=3) and ((q1 < -128) or (q1 > 127)) then error(17);
emit(q0);
emit(q1);
end;
end;
end;
int:
begin
with op1 do begin
oneop;
if isidx or isbase or not isconst then error(10);
if (value < 0) or (value > 255) then error(12);
if value=3 then emit($cc)
else begin emit($cd); emit(value); end;
end;
end;
esc:
begin
if not op2.isop then error(1);
if not op1.isimmed then error(10);
if (op1.value < 0) or (op1.value > 63) then error(10);
emit($d8+(op1.value shr 3));
onerm((op1.value and 7),op2);
end;
xlat,lahf,sahf,pushf,popf,aaa,daa,aas,das,cbw,cwd,into,iret,clc,cmc,
stc,cld,std,cli,sti,hlt,wait,aam,aad,nop:
begin
if op1.isop then error(11);
case op of
xlat: emit($d7);
lahf: emit($9f);
sahf: emit($9e);
pushf:emit($9c);
popf: emit($9d);
aaa: emit($37);
daa: emit($27);
aas: emit($3f);
das: emit($2f);
cbw: emit($98);
cwd: emit($99);
into: emit($ce);
iret: emit($cf);
clc: emit($f8);
cmc: emit($f5);
stc: emit($f9);
cld: emit($fc);
std: emit($fd);
cli: emit($fa);
sti: emit($fb);
hlt: emit($f4);
wait: emit($9b);
aam: begin emit($d4); emit($0a); end;
aad: begin emit($d5); emit($0a); end;
nop: emit($90);
end;
end;
else error(29);
end; { case op }
end; { if errn }
if pass=3 then begin { finish constructing the target line }
if codpnt = firstentry
then begin
writeln(targ,'Inline(');
writeln; writeln('Inline('); end;
message;
if next = nil then t := t + ' );';
while length(t) < 25 do t := t+' ';
t := t + ' { ' + source;
if length(t) < oldlen-4 { make it look pretty }
then begin
if length(t) > oldlen-8 then oldlen := oldlen+2;
while length(t) < oldlen-4 do t := t+' ';
end;
t := t+' }';
oldlen := length(t);
writeln(targ,t); writeln(t); { and write it to the file }
codpnt := next;
end;
end; {with}
end; { generate }
procedure address; { compute address of each label }
begin
if codpnt^.labeln <> 0
then tab[codpnt^.labeln].val := loc;
generate; { advance location counter }
codpnt^.errn := errn;
codpnt := codpnt^.next;
end;
procedure parse_line; { scan source and build intermediate code }
var
s: line; { source line }
p: integer; { index into s }
m: idtype; { mnemonic opcode }
labeln: integer;
temp: line;
id: idtype; { identifier }
preventry: cptr; { points to previous line of intermediate code }
label nocode;
function more: boolean; { any more characters on this line? }
begin
more := p <= length(s);
end;
procedure skipblank;
begin
while more and (s[p] = ' ') do
p := p+1;
end;
function alpha: boolean;
begin
alpha := more and (s[p] in ['a'..'z','A'..'Z']);
end;
function digit: boolean;
begin
digit := more and (s[p] in ['0'..'9']);
end;
function peek(aset: charset): boolean; { is next character in aset? }
begin
if more and (s[p] in aset) then peek := true else peek := false;
end;
function test(c: char): boolean; { is the next character c? }
begin { if so, scan over it }
if more and (upcase(s[p]) = c)
then begin
p := p+1; skipblank;
test := true
end
else test := false
end;
procedure getid; { found an alpha }
begin { get rest of identifier }
id := '';
while alpha or digit or peek(['_']) do begin
if length(id) < 20
then id := id + s[p] { return it in id }
else error(14);
p := p+1;
end;
skipblank;
end;
procedure enter(symbol: idtype; var m: integer);
{ make entry in symbol table }
begin
if search(symbol)
then error(15)
else if tcnt = tsize then begin
writeln; writeln('Assembly Aborted -- Symbol Table Full');
close(src); close(targ);
halt; end
else begin
tcnt := tcnt+1;
tab[tcnt].id := stupcase(symbol);
tab[tcnt].val := -1;
m := tcnt;
end;
end;
function code: boolean; { found an id }
{ is it an opcode? }
begin
op := nul;
m := stupcase(id);
repeat { if so, return it in op }
op := succ(op)
until (mn[op] = m) or (op = last);
if op in [rep,repe,repz,repne,repnz] then begin
if repx <> nul then error(13);
repx := op; { REP prefix }
if alpha then begin { look for another opcode }
getid;
code := code; end
else error(4);
end
else if op=lock then begin
if lockx then error(13);
lockx := true; { LOCK prefix }
if alpha then begin { look for another opcode }
getid;
code := code; end
else error(4);
end
else if (op > valid) and (op <> last) then error(18)
else if op <> last then begin
code := true;
if (repx<>nul) and not (op in [movs,cmps,scas,lods,stos]) then error(4);
end
else begin code := false; op := nul; end;
end; { code }
procedure getoperand(var opr: attr); { scan an operand }
{ determine its attributes }
var r: regs;
label gotid;
procedure makebyte; { it's a byte }
begin
if opr.isword then error(3) else opr.isbyte := true;
end;
procedure makeword; { it's a word }
begin
if opr.isbyte then error(3) else opr.isword := true;
end;
procedure getnum; { scan a numeric literal }
var code: integer;
minus: boolean;
procedure gethex; { scan a hexadecimal literal }
begin
if id = '-' then minus := true;
id := '$'; p := p+1;
while more and (digit or (upcase(s[p]) in ['A','B','C','D','E','F']))
do begin
id := id + s[p]; { return it in id }
p := p+1;
end;
if id = '$' then error(2);
end;
begin
id := ''; minus := false;
if test('+') then;
if test('-') then id := '-';
if peek(['$'])
then gethex { hex }
else while digit do begin { decimal }
id := id + s[p];
p := p+1;
end;
if id = '' then error(2);
with opr do begin
val(id,value,code); { return value }
if code<>0
then if id='-32768'
then value := $8000
else error(9);
if minus then value := -value
end;
if id[1] = '-' then delete(id,1,1);
skipblank;
end; { getnum }
procedure getchar; { scan a character literal }
begin
with opr do begin
p := p+1;
value := ord(s[p]); p := p+1;
if not test('''') then error(2)
else begin
isconst := true;
isimmed := true;
if not isword then isbyte := true;
end;
end; end;
function testreg: boolean; { is id a register name? }
begin
r := firstreg;
temp := stupcase(id);
repeat
r := succ(r) { if so, return register number in r }
until (reg[r] = temp) or (r = lastreg);
if r <> lastreg then testreg := true else testreg := false;
end;
begin {getoperand}
with opr do begin
isop := true;
if not (alpha or digit or peek(['=','$','*','[','+','-','(','''']))
then error(2)
else begin
if alpha then begin
getid;
if testreg and (r in [ds,cs,ss,es]) and peek([':'])
then begin { segment override prefix }
if test(':') then;
if override<>lastreg then error(13);
override := r; end
else goto gotid;
end;
if test('(') then begin { type modifier }
if test('B') then makebyte
else if test('W') then makeword
else if test('S') then isshort := true
else if test('N') then isnear := true
else if test('F') then isfar := true
else error(6);
if not test(')') then error(6);
end;
if test('=') then isimmed := true;
if test('[')
then begin { base or index register }
if isimmed then error(2);
isaddr := true;
getid;
if testreg
then begin
if not test(']') then error(6);
if r in [bx,bp]
then begin { base register }
isbase := true; isop := true;
base := r;
if test('[')
then begin
getid;
if testreg
then begin
if not test(']') then error(6);
if r in [si,di]
then begin { and index register }
isidx := true;
idx := r;
end
else error(8)
end
else error(5)
end
end
else if r in [si,di]
then begin { index register }
isidx := true;
idx := r;
end
else error(8);
end
else error(5)
end;
if alpha
then begin { identifier }
getid;
gotid: if testreg
then begin { it's a register }
if r in [ds,ss,cs,es]
then issreg := true
else isreg := true;
if r in [ax,bx,cx,dx,sp,bp,si,di,ds,ss,cs,es]
then makeword;
if r in [ah,bh,ch,dh,al,bl,cl,dl]
then makebyte;
if isimmed then error(2);
rg := r;
end
else begin { it's a variable or label id }
isaddr := not isimmed;
isid := true;
ident := id;
if isimmed then makeword;
end;
end {alpha}
else if digit or peek(['$','+','-'])
then begin { numeric literal }
getnum;
isaddr := not isimmed;
isconst := true;
if isimmed
then if (value <= 255) and (value >= -128) and not isword
then makebyte
else makeword;
end
else if test('*')
then begin { location counter reference }
ident := '*';
isaddr := not isimmed;
isid := true;
if isimmed then makeword;
if test('+') then ident := '*+';
if test('-') then ident := '*-';
if ident<>'*' then begin
if not peek(['$','0'..'9']) then error(9);
getnum;
ident := ident + id;
end;
end
else if peek(['''']) then getchar; { character literal }
if isbase and (base=bp) and not isidx and not (isid or isconst)
then begin
isconst := true; value := 0;
ident := '$00';
end;
end;
if isimmed and not (isid or isconst) then error(6);
end; {with}
skipblank;
end; {getoperand}
begin { parse_line }
errn := 0; labeln := 0;
op := nul; repx := nul; lockx := false; override := lastreg;
with op1 do begin
isop := false; isaddr := false;
isid := false; isreg := false; issreg := false;
isidx := false; isbase := false;
isbyte := false; isword := false;
isshort := false; isnear := false; isfar := false;
isimmed := false; isconst := false;
end;
op2 := op1;
readln(src,s); { read in a source line }
for p := 1 to length(s) do
if ord(s[p]) < 32 then s[p] := ' ';
p := 1;
if more
then begin
skipblank;
if alpha then begin
getid;
if test(':') then begin { label }
enter(id,labeln);
if alpha
then getid
else goto nocode;
end;
if code { opcode }
then begin
if more and not peek([';'])
then begin
getoperand(op1); { first operand }
if test(',')
then begin
if more
then getoperand(op2) { second operand }
else error(6);
if more and not peek([';']) then error(6);
end
else if more and not peek([';']) then error(6);
end
end
else error(4)
end
else
nocode: if more and not peek([';']) then error(6);
preventry := codpnt;
if maxavail > sizeof(codrec) shr 4 +1
then new(codpnt) { create new line of intermediate code }
else begin
writeln; writeln('Assembly Aborted -- Out of Memory');
close(src); close(targ); halt; end;
if firstentry = nil then firstentry := codpnt;
preventry^.next := codpnt; { and link it }
codpnt^.next := nil;
codpnt^.labeln := labeln;
codpnt^.op := op; { enter the data }
codpnt^.op1 := op1;
codpnt^.op2 := op2;
codpnt^.repx := repx;
codpnt^.lockx := lockx;
codpnt^.override := override;
codpnt^.errn := errn;
codpnt^.source := s;
end;
end; { parse_line }
begin { main }
writeln(' InLiner'); writeln;
startup;
init;
atstart := true; ok := true;
oldlen := 0; loc := 0; tcnt := 0;
pass := 1; firstentry := nil;
while not eof(src) do parse_line;
pass := 2; codpnt := firstentry; loc := 0;
while codpnt <> nil do address;
pass := 3; codpnt := firstentry; loc := 0;
while codpnt <> nil do generate;
writeln;
if ok then writeln('Assembly Successful')
else writeln('Assembled with Errors');
close(src); close(targ);
end.