www.pudn.com > tp60src.zip > LEX.ASM
model large compiler_text,pascal
include compiler.inc
.data
Defines db 5,'VER60'
db 5,'MSDOS'
db 5,'CPU86'
DefL1 equ $-Defines
db 5,'CPU87'
DefL2 equ $-Defines
.data?
StartToken db ?
SymbolToken db ?
SymbolTextPos dw ?
.code compiler_text
public CreateHashTable
public AddIdent2Dict
public AddNewIdent
public LocalAddIdent
public AddIdent
public GetHash
public NeedIdent
public CompareSymbol
public CalcHash
public GetSymbol
public SearchSymbol
public SearchField
public LocalSearch
public SearchHash
public ChooseToken
public GetPlusMinus
public GetDirective
public CheckDirective
public CheckToken
public NeedToken
public GetToken
public ProcessCaret
public StandardDefines
public GetRawToken
public AddToFileStack
public MarkFileTime
public PopFileStack
public UpperCase
public CopyPasStr
public CopyDSCStr
public Pas2C
public DSPas2C
public CompareStrings
public MoveBlock
public MoveBlockRev
public AllocTempBuf
public AddToSourceList
CreateHashTable proc near
mov cx,ax
shl ax,1
add ax,2
Invoke GetDictMem
mov ax,cx
dec ax
shl ax,1
stosw
xor ax,ax
rep stosw
ret
CreateHashTable endp
AddIdent2Dict proc near
call NeedIdent
call AddNewIdent
jmp GetToken
AddIdent2Dict endp
AddNewIdent proc near
push ax
call LocalSearch
pop ax
jnz LocalAddIdent
mov ax,4
Chain IdentError
AddNewIdent endp
LocalAddIdent proc near
call GetHash
AddIdent label near
push ax
mov cl,IdentBuf[0]
mov ch,0
inc cx
add ax,size TSymbol-1
add ax,cx
Invoke GetDictMem
mov bl,SymbolHash
and bx,es:[si]
lea bx,[bx+si+2]
mov ax,es:[bx]
mov es:[bx],di
mov bx,di
stosw
xor ax,ax
stosb
lea si,IdentBuf
rep movsb
pop cx
push di
rep stosb
pop di
ret
LocalAddIdent endp
GetHash proc near
mov es,Dictionary.Segm
mov si,CurOwner
or si,si
jnz @@1
mov si,CurProc
or si,si
jnz @@2
mov si,es:uhInterface
ret
@@1: mov si,es:[si].rtHash
ret
@@2: mov si,es:[si].psHash
ret
GetHash endp
NeedIdent proc near
cmp CurrentToken,t_Ident
jne @@1
ret
@@1: mov ax,2
Chain CompileError
NeedIdent endp
CompareSymbol proc near
cmp CurrentToken,t_Ident
jne @@1
cmp al,SymbolHash
jne @@1
push cx
lea si,IdentBuf
push ds
pop es
mov cl,[si]
xor ch,ch
inc cx
repe cmpsb
pop cx
@@1: ret
CompareSymbol endp
CalcHash proc near
lea si,IdentBuf
mov ah,es:[di]
mov [si],ah
inc di
inc si
xor bl,bl
@@1: mov al,es:[di]
cmp al,'a'
jb @@2
cmp al,'z'
ja @@2
sub al,'a'-'A'
@@2: mov [si],al
inc di
inc si
dec al
add bl,al
dec ah
jnz @@1
add bl,bl
mov SymbolHash,bl
ret
CalcHash endp
GetSymbol proc near
cmp CurrentToken,t_Ident
jne @@2
test CompilerFlags.B0,cfDebugging
jnz @@4
push si di
call SearchSymbol
jnz @@3
cmp al,t_Unit
jne @@1
call GetToken
mov al,tPoint
call NeedToken
call NeedIdent
mov es,es:[di]
mov di,es:uhInterface
call SearchHash
jnz @@3
@@1: mov CurrentToken,al
mov CurrentHash,bx
mov CurrentSymbol.Offs,di
mov CurrentSymbol.Segm,es
pop di si
@@2: ret
@@3: mov ax,3
Chain CompileError
@@4: push si di
call FindUnitName
jz @@7
call SearchSymbol
jz @@7
mov ax,FirstUnit
@@5: mov es,ax
call DebuggingSearch
jz @@7
mov ax,es:uhNext
or ax,ax
jnz @@5
@@6: mov ax,3
Chain CompileError
@@7: call GiveSymbol
cmp al,t_Unit
jne @@8
call NeedField
jnz @@11
call DebuggingSearch
jnz @@6
call GiveSymbol
@@8: cmp al,t_Type
jne @@9
mov si,es:[di].tsType.Offs
mov di,es:[di].tsType.Segm
mov es,es:[di]
cmp es:[si].tdType,ttObject
jne @@11
call NeedField
jnz @@11
call SearchField
jnz @@6
call GetToken
cmp al,t_Proc
jne @@11
jmp short @@10
@@9: cmp al,t_Proc
jne @@11
test es:[di].psFlags,pfInline+pfMethod
jnz @@11
@@10: call NeedField
jnz @@11
mov di,es:[di].psHash
call SearchHash
jnz @@6
call GiveSymbol
jmp @@9
@@11: mov ax,SymbolTextPos
mov bx,FileStackPtr
mov [bx],ax
call GetToken
mov al,SymbolToken
mov CurrentToken,al
pop di si
ret
GetSymbol endp
DebuggingSearch proc near
mov di,es:uhDebugHash
call SearchHash
jz @@1
mov ax,es
cmp ax,SystemUnit
jne @@1
lea di,RegVars
push cs
pop es
call SearchHash
jz @@1
mov es,SystemUnit
@@1: ret
DebuggingSearch endp
GiveSymbol proc near
mov SymbolToken,al
mov CurrentHash,bx
mov CurrentSymbol.offs,di
mov CurrentSymbol.segm,es
mov bx,TextPos
mov SymbolTextPos,bx
jmp GetToken
GiveSymbol endp
NeedField proc near
cmp CurrentToken,tPoint
jne @@1
call GetToken
jmp NeedIdent
@@1: ret
NeedField endp
SearchSymbol proc near
mov si,WithChain
jmp short @@2
@@1: les si,[si].wcOwner
call SearchField
jz @@8
mov si,CurrentWith
mov si,[si].wcNext
@@2: mov CurrentWith,si
or si,si
jnz @@1
mov es,Dictionary.Segm
mov si,CurScope
jmp short @@4
@@3: mov bl,es:[si].seName.B0
mov bh,0
lea si,[si+size TSymbol+bx]
push si
call SearchLocal
pop si
jz @@7
mov es,Dictionary.Segm
test es:[si].psFlags,pfMethod
jnz @@5
mov si,es:[si].psScope
@@4: or si,si
jnz @@3
@@5: mov si,es:uhName
@@6: mov bl,es:[si].seName.B0
mov bh,0
lea si,[si+size TSymbol+bx]
mov es,es:[si]
mov di,es:uhInterface
push si
call SearchHash
pop si
jz @@7
mov es,Dictionary.Segm
mov si,es:[si].usPrev
or si,si
jnz @@6
dec si
ret
@@7: xor si,si
@@8: ret
SearchSymbol endp
SearchLocal proc near
mov di,es:[si].psHash
push si
call SearchHash
pop si
jz @@1
test es:[si].psFlags,pfMethod
jnz @@2
or si,si
@@1: ret
@@2: mov si,es:[si].psScope
SearchField label near
mov CurrentOwner.Offs,si
mov CurrentOwner.Segm,es
@@3: mov di,es:[si].rtHash
push si
call SearchHash
pop si
jz @@5
cmp es:[si].tdType,ttObject
jne @@5
mov bx,es:[si].otParent.Segm
or bx,bx
jz @@4
mov si,es:[si].otParent.Offs
mov es,es:[bx]
jmp @@3
@@4: dec bx
@@5: ret
SearchLocal endp
LocalSearch proc near
mov es,Dictionary.Segm
mov si,CurOwner
or si,si
jnz SearchField
mov si,CurProc
or si,si
jnz SearchLocal
mov di,es:uhInterface
SearchHash label near
mov bl,SymbolHash
and bx,es:[di]
mov bx,es:[bx+di+2]
or bx,bx
jz @@3
lea ax,IdentBuf
mov dl,IdentBuf[0]
mov dh,0
inc dx
@@1: lea di,[bx].seName
mov si,ax
mov cx,dx
repe cmpsb
je @@4
@@2: mov bx,es:[bx]
or bx,bx
jnz @@1
@@3: dec bx
ret
@@4: mov al,es:[bx].seType
test al,t_Private
jnz @@5
ret
@@5: and al,not t_Private
mov cx,es
cmp cx,Dictionary.Segm
jne @@2
ret
LocalSearch endp
FindUnitName proc near
lea bx,IdentBuf
_FindUnitName label near
mov ax,FirstUnit
mov dl,[bx]
mov dh,0
inc dx
@@1: mov es,ax
mov di,es:uhName
add di,seName
mov cx,dx
mov si,bx
repe cmpsb
je @@2
mov ax,es:uhNext
or ax,ax
jnz @@1
dec ax
ret
@@2: mov al,t_Unit
mov bx,es:uhName
ret
FindUnitName endp
ChooseToken proc near
mov cl,cs:[bx]
xor ch,ch
inc bx
mov dl,cs:[bx]
xor dh,dh
inc bx
mov al,CurrentToken
@@1: cmp al,cs:[bx]
je @@2
add bx,dx
loop @@1
dec cx
@@2: ret
ChooseToken endp
GetPlusMinus proc near
mov al,CurrentToken
cmp al,tMinus
je @@1
cmp al,tPlus
je @@1
xor al,al
ret
@@1: jmp GetToken
GetPlusMinus endp
GetDirective proc near
cmp CurrentToken,t_Ident
jne @@2
push es di si dx cx bx ax
lea di,ProcDirs
push cs
pop es
call SearchHash
jnz @@1
mov CurrentToken,al
@@1: pop ax bx cx dx si di es
@@2: ret
GetDirective endp
CheckDirective proc near
call GetDirective
CheckToken label near
cmp al,CurrentToken
je @@1
ret
@@1: jmp GetToken
CheckDirective endp
Codes db t_Ident,2
db t_Label,35
db tBegin,36
db tEnd,37
db tDo,50
db tOf,54
db tInterface,55
db tThen,57
db tImplementation,73
db tUnit,84
db tSemicolon,85
db tColon,86
db tComma,87
db tOParen,88
db tCParen,89
db tEqual,90
db tConstEqual,90
db tAssign,91
db tOBracket,92
db tCBracket,93
db tPoint,94
db tRange,95
db tNil,120
CodesS equ ($-Codes) shr 1
NeedToken proc near
cmp al,CurrentToken
jne @@1
jmp GetToken
@@1: lea bx,Codes
mov cx,CodesS
@@2: mov dx,cs:[bx]
cmp al,dl
je @@3
inc bx
inc bx
loop @@2
mov dh,5
@@3: mov al,dh
xor ah,ah
Chain CompileError
NeedToken endp
GetToken proc near
push ax bx cx dx si di es
test CompilerFlags.B0,cfDebugging
jnz @@1
Invoke UpdateCompInfo
@@1: call GetRawToken
mov TextPos,si
mov ax,[si]
or al,al
jz @@4
cmp al,'0'
jb @@7
cmp al,'9'
jbe @@3
cmp al,'A'
jb @@6
cmp al,'Z'
jbe @@2
cmp al,'a'
jb @@5
cmp al,'z'
ja @@10
@@2: call Ident
jmp short @@8
@@3: call Number
jmp short @@8
@@4: mov al,0
jmp short @@8
@@5: sub al,'Z'-'A'+1
@@6: sub al,'9'-'0'+1
@@7: sub al,' '+1
mov bl,al
xor bh,bh
add bx,bx
call cs:@@11[bx]
@@8: mov CurrentToken,al
mov di,FileStackPtr
mov [di],si
xor ax,ax
pop es di si dx cx bx
@@9: pop ax
ret
@@10: mov ax,5
Chain CompileError
@@11 dw @@10 ; !
dw @@10 ; "
dw String ; #
dw IntNumber ; $
dw @@10 ; %
dw @@10 ; &
dw String ; '
dw OParen ; (
dw CParen ; )
dw Times ; *
dw Plus ; +
dw Comma ; ,
dw Minus ; -
dw Point ; .
dw Slash ; /
dw Colon ; :
dw Semicolon ; ;
dw Less ; <
dw Equal ; =
dw Greater ; >
dw @@10 ; ?
dw At ; @
dw OBracket ; [
dw @@10 ; \
dw CBracket ; ]
dw Caret ; ^
dw Ident ; _
dw @@10 ; `
GetToken endp
Ident proc near
lea di,IdentBuf
xor cx,cx
@@1: mov al,[si]
cmp al,'0'
jb @@3
cmp al,'9'
jbe @@2
cmp al,'_'
je @@2
and al,0dfh
cmp al,'A'
jb @@3
cmp al,'Z'
ja @@3
@@2: inc si
cmp cl,63
je @@1
inc di
inc cl
mov [di],al
dec al
add ch,al
jmp @@1
@@3: mov IdentBuf[0],cl
add ch,ch
mov SymbolHash,ch
lea di,KeyWords
push cs
pop es
push si
call SearchHash
pop si
jz @@4
mov al,t_Ident
@@4: ret
Ident endp
Number proc near
mov bx,si
@@1: inc bx
mov ax,[bx]
cmp al,'0'
jb @@2
cmp al,'9'
jbe @@1
@@2: call UpperCase
cmp al,'E'
je @@3
cmp al,'.'
jne IntNumber
cmp ah,'.'
je IntNumber
cmp ah,')'
je IntNumber
@@3: lea bx,SymbolValue
Invoke Str2Extended
jc @@4
mov ax,_Extended
jmp GiveConst
@@4: mov TextPos,si
mov ax,6
Chain CompileError
Number endp
IntNumber proc near
Invoke Str2Long
jc @@1
mov SymbolValue.W0,ax
mov SymbolValue.W2,dx
mov ax,_Longint
jmp GiveConst
@@1: mov TextPos,si
mov ax,7
Chain CompileError
IntNumber endp
String proc near
mov ax,128
call AllocTempBuf
mov SymbolValue.W0,bx
inc bx
xor cx,cx
@@1: mov al,[si]
cmp al,''''
jne @@5
@@2: inc si
mov al,[si]
or al,al
jz @@4
cmp al,''''
jne @@3
inc si
mov al,[si]
cmp al,''''
jne @@1
@@3: mov [bx],al
inc bx
inc cx
jmp @@2
@@4: mov TextPos,si
mov ax,8
Chain CompileError
@@5: cmp al,'^'
jne @@7
inc si
mov al,[si]
call UpperCase
or al,al
jz @@4
inc si
xor al,40h
@@6: mov [bx],al
inc bx
inc cx
jmp @@1
@@7: cmp al,'#'
jne @@8
inc si
push bx cx
Invoke Str2Long
pop cx bx
jnc @@6
mov TextPos,si
mov ax,7
Chain CompileError
@@8: mov byte ptr [bx],0
inc bx
mov TempBufPtr,bx
mov bx,SymbolValue.W0
mov [bx],cl
mov ax,_String
dec cx
jnz GiveConst
mov al,[bx+1]
xor ah,ah
cwd
mov SymbolValue.W0,ax
mov SymbolValue.W2,dx
mov ax,_Char
GiveConst label near
mov SymbolType.offs,ax
mov ax,SystemUnit
mov SymbolType.segm,ax
mov al,t_Constant
ret
String endp
OParen proc near
mov al,tOParen
cmp ah,'.'
jne @@1
mov al,tOBracket
inc si
@@1: inc si
ret
OParen endp
CParen proc near
mov al,tCParen
inc si
ret
CParen endp
Times proc near
mov al,tTimes
inc si
ret
Times endp
Plus proc near
mov al,tPlus
inc si
ret
Plus endp
Comma proc near
mov al,tComma
inc si
ret
Comma endp
Minus proc near
mov al,tMinus
inc si
ret
Minus endp
Point proc near
mov al,tRange
cmp ah,'.'
je @@1
mov al,tPoint
cmp ah,')'
jne @@2
mov al,tCBracket
@@1: inc si
@@2: inc si
ret
Point endp
Slash proc near
mov al,SlashToken
inc si
ret
Slash endp
Colon proc near
mov al,tColon
cmp ah,'='
jne @@1
mov al,tAssign
inc si
@@1: inc si
ret
Colon endp
Semicolon proc near
mov al,tSemicolon
inc si
ret
Semicolon endp
Less proc near
mov al,tNotEqual
cmp ah,'>'
je @@1
mov al,tLess
cmp ah,'='
jne @@2
mov al,tLEq
@@1: inc si
@@2: inc si
ret
Less endp
Equal proc near
mov al,EqualToken
inc si
ret
Equal endp
Greater proc near
mov al,tGreater
cmp ah,'='
jne @@1
mov al,tGEq
inc si
@@1: inc si
ret
Greater endp
At proc near
mov al,tAt
inc si
ret
At endp
OBracket proc near
mov al,tOBracket
inc si
ret
OBracket endp
CBracket proc near
mov al,tCBracket
inc si
ret
CBracket endp
Caret proc near
mov al,tCaret
inc si
ret
Caret endp
ProcessCaret proc near
cmp CurrentToken,tCaret
jne @@1
push si di
mov di,FileStackPtr
mov si,[di].fsTextPos
dec si
call String
mov CurrentToken,al
mov di,FileStackPtr
mov [di],si
pop di si
@@1: ret
ProcessCaret endp
StandardDefines proc near
mov cx,DefL1
Invoke CheckFpu
jnz @@1
mov cx,DefL2
@@1: lea si,Defines
mov ax,DefinesPtr
mov di,ax
add ax,cx
cmp ax,offset DefinesBuf+1024
ja @@4
mov DefinesPtr,ax
push ds
pop es
rep movsb
mov si,InitDefines
@@2: call ParseString
cmp byte ptr [si],0
je @@3
call GetWord
cmp FileNameBuf[0],0
je @@5
call AddDefine
jmp @@2
@@3: ret
@@4: mov ax,127
Chain CompileError
@@5: mov ax,130
Chain CompileError
StandardDefines endp
GetRawToken proc near
@@1: mov di,FileStackPtr
mov si,[di].fsTextPos
@@2: lodsb
or al,al
jz @@4
cmp al,' '
jbe @@2
dec si
test CompilerFlags.B0,cfDebugging
jnz @@6
mov ax,[si]
cmp al,'{'
je @@3
cmp ax,'*('
jne @@6
inc si
@@3: inc si
call ProcessComment
jmp @@2
@@4: test CompilerFlags.B0,cfDebugging
jnz @@5
call GetChar
jnz @@2
mov di,FileStackPtr
mov [di].fsTextPos,si
call PopFileStack
jmp @@1
@@5: dec si
@@6: ret
GetRawToken endp
ProcessComment proc near
mov StartToken,al
cmp byte ptr [si],'$'
je @@1
jmp SkipComment
@@1: inc si
call SearchDirective
jc DirError
mov ax,cs:DirValues[bx]
or ax,ax
jz @@4
mov dx,ax
and ax,not coGlobal
cmp byte ptr [si],'+'
jne @@2
or GlobalOptions,ax
jmp short @@3
@@2: cmp byte ptr [si],'-'
jne @@4
not ax
and GlobalOptions,ax
@@3: and dx,coGlobal
and dx,GlobalOptions
jnz DirError
inc si
cmp byte ptr [si],','
je @@1
jmp SkipComment
@@4: jmp cs:DirProcs[bx]
ProcessComment endp
DirError proc near
mov ax,17
Chain CompileError
DirError endp
DefineDir proc near
call GetOneWord
call AddDefine
jmp SkipComment
DefineDir endp
ElseDir proc near
mov di,FileStackPtr
cmp [di].fsNestLevel,0
je @@2
push di
call SkipComment
call SkipIfDef
pop di
jz @@1
dec [di].fsNestLevel
@@1: ret
@@2: mov ax,128
Chain CompileError
ElseDir endp
EndIfDir proc near
mov di,FileStackPtr
cmp [di].fsNestLevel,0
je @@1
dec [di].fsNestLevel
jmp SkipComment
@@1: mov ax,128
Chain CompileError
EndIfDir endp
IDir proc near
call GetFileName
call SkipComment
mov di,FileStackPtr
mov [di].fsTextPos,si
mov TextPos,si
mov ax,fePas
lea dx,FileNameBuf
Invoke ConvertName
mov al,fdIncludeDir
lea dx,FileNameBuf
call AddToSourceList
push ax
mov ax,fdIncludeDir*256
lea dx,FileNameBuf
Invoke ConvertName
pop ax
lea dx,FileNameBuf
call AddToFileStack
call MarkFileTime
mov di,FileStackPtr
mov si,[di].fsTextPos
ret
IDir endp
IfDefDir proc near
call GetOneWord
call SearchDefine
_IfDef label near
push ax
call SkipComment
pop ax
mov di,FileStackPtr
inc [di].fsNestLevel
or ax,ax
jnz @@1
push di
call SkipIfDef
pop di
jz @@1
dec [di].fsNestLevel
@@1: ret
IfDefDir endp
IfNDefDir proc near
call GetOneWord
call SearchDefine
not ax
jmp _IfDef
IfNDefDir endp
IfOptDir proc near
call ParseString
call SearchDirective
jc @@2
mov ax,cs:DirValues[bx]
or ax,ax
jz @@2
and ax,not coGlobal
mov dx,GlobalOptions
cmp byte ptr [si],'+'
je @@1
cmp byte ptr [si],'-'
jne @@2
not dx
@@1: and ax,dx
jmp _IfDef
@@2: jmp DirError
IfOptDir endp
LDir proc near
call GetFileName
mov ax,feObj
lea dx,FileNameBuf
Invoke ConvertName
mov al,fdObjectDir
lea dx,FileNameBuf
push si
call AddToSourceList
pop si
jmp SkipComment
LDir endp
MDir proc near
call GetInt
jc @@1
or dx,dx
jnz @@1
cmp ax,1024
jb @@1
cmp ax,65520
ja @@1
mov StackSize,ax
call GetPara
jc @@1
cmp ax,40960
ja @@1
mov MinHeapSize,ax
call GetPara
jc @@1
cmp ax,MinHeapSize
jb @@1
cmp ax,40960
ja @@1
mov MaxHeapSize,ax
jmp SkipComment
@@1: jmp DirError
MDir endp
ODir proc near
cmp ProgramSection,0
jge @@1
test CompilerFlags.B0,cfDisk
jz @@2
call GetOneWord
push si
lea bx,FileNameBuf
call _FindUnitName
jnz @@3
test es:uhFlags,ufOverlay
jz @@4
mov es:uhOverlayLength,-1
pop si
jmp SkipComment
@@1: mov ax,17
Chain CompileError
@@2: mov ax,141
Chain CompileError
@@3: mov ax,3
Chain CompileError
@@4: mov ax,144
Chain CompileError
ODir endp
UndefDir proc near
call GetOneWord
call DeleteDefine
jmp SkipComment
UndefDir endp
AddDefine proc near
call SearchDefine
or ax,ax
jnz @@1
push si
lea si,FileNameBuf
mov cl,[si]
xor ch,ch
inc cx
mov ax,DefinesPtr
mov di,ax
add ax,cx
cmp ax,offset DefinesBuf+1024
ja @@2
mov DefinesPtr,ax
rep movsb
pop si
@@1: ret
@@2: mov ax,127
Chain CompileError
AddDefine endp
DeleteDefine proc near
call SearchDefine
or ax,ax
jz @@1
push si
mov si,di
lodsb
xor ah,ah
add si,ax
mov cx,DefinesPtr
sub cx,si
rep movsb
mov DefinesPtr,di
pop si
@@1: ret
DeleteDefine endp
SearchDefine proc near
push si
mov di,SaveDefinesPtr
push ds
pop es
xor ax,ax
@@1: cmp di,DefinesPtr
je @@3
mov cl,[di]
xor ch,ch
inc cx
push cx di
lea si,FileNameBuf
repe cmpsb
pop di cx
jz @@2
add di,cx
jmp @@1
@@2: dec ax
@@3: pop si
ret
SearchDefine endp
SkipComment proc near
cmp StartToken,'{'
jne @@3
@@1: lodsb
or al,al
jz @@2
cmp al,'}'
jne @@1
ret
@@2: call GetChar
jnz @@1
jmp short @@6
@@3: xor ah,ah
@@4: mov ah,al
lodsb
or al,al
jz @@5
cmp ax,'*)'
jne @@4
ret
@@5: call GetChar
jnz @@3
@@6: mov ax,10
Chain CompileError
SkipComment endp
SkipIfDef proc near
xor dl,dl
@@1: xor dh,dh
@@2: mov ax,[si]
or al,al
jz @@4
cmp al,''''
je @@5
or dh,dh
jnz @@3
cmp al,'{'
je @@7
cmp ax,'*('
je @@6
@@3: inc si
jmp @@2
@@4: push dx
call GetChar
pop dx
jnz @@1
mov ax,129
Chain CompileError
@@5: not dh
jmp @@3
@@6: inc si
@@7: inc si
mov StartToken,al
cmp byte ptr [si],'$'
jne @@8
inc si
push dx
call SearchDirective
pop dx
jc @@8
mov al,bl
mov cx,100h
cmp al,6*2 ; $ELSE
nop
nop
je @@9
mov cx,1ffh
cmp al,7*2 ; $ENDIF
nop
nop
je @@9
mov cx,1
cmp al,11*2 ; $IFDEF
nop
nop
je @@9
cmp al,12*2 ; $IFNDEF
nop
nop
je @@9
cmp al,13*2 ; $IFOPT
nop
nop
je @@9
@@8: xor cx,cx
@@9: push cx dx
call SkipComment
pop dx cx
or ch,ch
jz @@10
or dl,dl
jz @@11
@@10: add dl,cl
jmp @@1
@@11: or cl,cl
ret
SkipIfDef endp
SearchDirective proc near
lea di,Directives
mov TextPos,si
call GetWord
push cs
pop es
xor bx,bx
@@1: mov cl,es:[di]
xor ch,ch
jcxz @@2
inc cx
push si
lea si,FileNameBuf
repe cmpsb
pop si
je @@3
add di,cx
inc bx
inc bx
jmp @@1
@@2: stc
@@3: ret
SearchDirective endp
GetOneWord proc near
call ParseString
mov TextPos,si
call GetWord
cmp FileNameBuf[0],0
je @@1
ret
@@1: mov ax,2
Chain CompileError
GetOneWord endp
GetWord proc near
xor bx,bx
mov al,[si]
@@1: cmp al,'_'
je @@2
and al,0dfh
cmp al,'A'
jb @@3
cmp al,'Z'
ja @@3
@@2: inc si
inc bx
mov FileNameBuf[bx],al
cmp bx,63
jz @@3
mov al,[si]
cmp al,'0'
jb @@3
cmp al,'9'
jbe @@2
jmp @@1
@@3: mov FileNameBuf[0],bl
ret
GetWord endp
GetFileName proc near
call ParseString
mov TextPos,si
xor bx,bx
@@1: mov al,[si]
cmp al,' '
jbe @@3
cmp al,'*'
je @@3
cmp al,'}'
je @@3
cmp al,'a'
jb @@2
cmp al,'z'
ja @@2
sub al,'a'-'A'
@@2: mov FileNameBuf[bx],al
inc si
inc bx
cmp bx,79
jne @@1
@@3: mov FileNameBuf[bx],0
ret
GetFileName endp
GetPara proc near
call GetInt
jc @@2
add ax,15
adc dx,0
jc @@2
mov cx,4
@@1: shr dx,1
rcr ax,1
loop @@1
or dx,dx
jz @@2
stc
@@2: ret
GetPara endp
GetInt proc near
call ParseString
mov TextPos,si
Chain Str2Long
GetInt endp
ParseString proc near
@@1: mov al,[si]
or al,al
jz @@3
cmp al,' '
jbe @@2
cmp al,','
je @@2
cmp al,';'
jne @@3
@@2: inc si
jmp @@1
@@3: ret
ParseString endp
Directives db 1,'A'
db 1,'B'
db 4,'CODE'
db 1,'D'
db 6,'DEFINE'
db 1,'E'
db 4,'ELSE'
db 5,'ENDIF'
db 1,'F'
db 1,'G'
db 1,'I'
db 5,'IFDEF'
db 6,'IFNDEF'
db 5,'IFOPT'
db 1,'L'
db 1,'M'
db 1,'N'
db 1,'O'
db 1,'R'
db 1,'S'
db 5,'UNDEF'
db 1,'V'
db 1,'W'
db 1,'X'
db 0
DirValues dw coWordAlign+coGlobal ; $A
dw coBooleanEval ; $B
dw 0
dw coDebugInfo+coGlobal ; $D
dw 0
dw coEmulation+coGlobal ; $E
dw 0
dw 0
dw coForceFarCalls ; $F
dw co286Code ; $G
dw coIOChk ; $I
dw 0
dw 0
dw 0
dw coLocalSymbols+coGlobal ; $L
dw 0
dw co8087+coGlobal ; $N
dw coOverlayCode+coGlobal ; $O
dw coRangeChk ; $R
dw coStackChk ; $S
dw 0
dw coVarStringChk ; $V
dw coWinFrame ; $W
dw coExtSyntax+coGlobal ; $X
DirProcs dw DirError
dw DirError
dw SkipComment ; $CODE
dw DirError
dw DefineDir ; $DEFINE
dw DirError
dw ElseDir ; $ELSE
dw EndIfDir ; $ENDIF
dw DirError
dw DirError
dw IDir ; $I
dw IfDefDir ; $IFDEF
dw IfNDefDir ; $IFNDEF
dw IfOptDir ; $IFOPT
dw LDir ; $L
dw MDir ; $M
dw DirError
dw ODir ; $O
dw SkipComment ; $R
dw DirError
dw UndefDir ; $UNDEF
dw DirError
dw DirError
dw DirError
GetChar proc near
mov bx,FileStackPtr
mov ax,[bx].fsLineLength
cwd
add [bx].fsFilePos.W0,ax
adc [bx].fsFilePos.W2,dx
mov cx,128
xor dx,dx
mov si,SourceBufPtr
lea di,[bx].fsCurrentLine
push ds
pop es
mov bx,SourceBufEnd
@@1: cmp si,bx
je @@5
@@2: lodsb
inc dx
cmp al,' '
jb @@4
@@3: stosb
loop @@1
dec di
call @@6
dec di
mov TextPos,di
mov ax,11
Chain CompileError
@@4: cmp al,0dh
je @@1
cmp al,0ah
je @@6
or al,al
jz @@1
cmp al,1ah
jne @@3
dec si
dec dx
jmp short @@6
@@5: push cx dx
lea ax,SourceBuffer
mov dx,ds
lea cx,SourceBuffer[1024]
sub cx,ax
mov bx,FileStackPtr
mov bx,[bx].fsFileHandle
Invoke ReadHandle
pop dx cx
lea si,SourceBuffer
mov bx,si
add bx,ax
mov SourceBufEnd,bx
or ax,ax
jnz @@2
@@6: xor al,al
stosb
mov bx,FileStackPtr
mov [bx].fsLineLength,dx
or dx,dx
jz @@7
inc [bx].fsLineNumber
add TotalLines.W0,1
adc TotalLines.W2,0
@@7: mov SourceBufPtr,si
lea si,[bx].fsCurrentLine
mov TextPos,si
or dx,dx
ret
GetChar endp
AddToFileStack proc near
cmp InStmtPart,0
jne @@1
mov di,FileStackPtr
cmp di,offset FileStack
je @@2
sub di,size TFileStack
mov [di].fsNameEntry,ax
push di
mov si,dx
lea di,[di].fsName
call CopyDSCStr
pop di
Invoke OpenHandle
mov [di].fsFileHandle,ax
lea ax,[di].fsName
mov [di].fsFileName,ax
lea ax,[di].fsCurrentLine
mov [di].fsTextPos,ax
mov TextPos,ax
xor ax,ax
mov [di].fsLineNumber,ax
mov [di].fsFilePos.W0,ax
mov [di].fsFilePos.W2,ax
mov [di].fsLineLength,ax
mov [di].fsCurrentLine[0],al
mov [di].fsNestLevel,ax
mov SourceBufPtr,ax
mov SourceBufEnd,ax
mov FileStackPtr,di
Chain StartFileInfo
@@1: mov ax,118
Chain CompileError
@@2: mov ax,9
Chain CompileError
AddToFileStack endp
MarkFileTime proc near
mov di,FileStackPtr
mov bx,[di].fsFileHandle
Invoke HandleTime
mov bx,[di].fsNameEntry
mov es,SourceList.Segm
mov es:[bx].slTimeStamp.W0,ax
mov es:[bx].slTimeStamp.W2,dx
ret
MarkFileTime endp
PopFileStack proc near
cmp InStmtPart,0
jne @@2
mov di,FileStackPtr
cmp di,SaveFileStack
je @@2
cmp [di].fsNestLevel,0
jne @@3
Invoke EndFileInfo
mov bx,[di].fsFileHandle
Invoke CloseHandle
add di,size TFileStack
mov FileStackPtr,di
cmp di,offset FileStack[15*size TFileStack]
je @@1
mov ax,[di].fsTextPos
mov TextPos,ax
mov ax,[di].fsFilePos.W0
mov dx,[di].fsFilePos.W2
add ax,[di].fsLineLength
adc dx,0
xor cx,cx
mov bx,[di].fsFileHandle
Invoke SeekHandle
xor ax,ax
mov SourceBufPtr,ax
mov SourceBufEnd,ax
Chain StartFileInfo
@@1: ret
@@2: mov ax,10
Chain CompileError
@@3: mov ax,129
Chain CompileError
PopFileStack endp
UpperCase proc near
cmp al,'a'
jb @@1
cmp al,'z'
ja @@1
sub al,'a'-'A'
@@1: ret
UpperCase endp
CopyPasStr proc near
call Swap
call _CopyPasStr
Swap label near
xchg si,di
push ds es
pop ds es
ret
CopyPasStr endp
CopyDSPasStr proc near
push ds
pop es
_CopyPasStr label near
lodsb
stosb
mov cl,al
xor ch,ch
rep movsb
ret
CopyDSPasStr endp
CopyCStr proc near
call Swap
call _CopyCStr
jmp Swap
CopyCStr endp
CopyDSCStr proc near
push ds
pop es
_CopyCStr label near
@@1: lodsb
stosb
or al,al
jnz @@1
ret
CopyDSCStr endp
Pas2C proc near
call Swap
call _Pas2C
jmp Swap
Pas2C endp
DSPas2C proc near
push ds
pop es
_Pas2C label near
lodsb
mov cl,al
xor ch,ch
rep movsb
xor al,al
stosb
ret
DSPas2C endp
CompareStrings proc near
lodsb
mov ah,es:[di]
inc di
mov cl,al
cmp cl,ah
jbe @@1
mov cl,ah
@@1: xor ch,ch
jcxz @@2
repe cmpsb
jne @@3
@@2: cmp al,ah
@@3: ret
CompareStrings endp
MoveBlock proc near
shr cx,1
rep movsw
jnc @@1
movsb
@@1: ret
MoveBlock endp
MoveBlockRev proc near
std
add si,cx
add di,cx
dec si
dec di
shr cx,1
jnc @@1
movsb
@@1: dec si
dec di
rep movsw
cld
ret
MoveBlockRev endp
AllocTempBuf proc near
mov bx,TempBufPtr
add ax,bx
cmp ax,offset TempBuffer[1024]
jbe @@1
sub ax,bx
lea bx,TempBuffer
add ax,bx
@@1: mov TempBufPtr,ax
ret
AllocTempBuf endp
AddToSourceList proc near
push ax
mov si,dx
@@1: lodsb
or al,al
jnz @@1
mov cx,si
sub cx,dx
mov ax,cx
add ax,size TSourceList-1
lea bx,SourceList
Invoke GetMemory
pop ax
push di
stosb
xor ax,ax
stosw
stosw
stosw
dec cx
mov al,cl
stosb
mov si,dx
rep movsb
pop ax
ret
AddToSourceList endp
KeyWords label word
hash 16
hent PACKED,tPacked
hent PROGRAM,tProgram
hent IMPLEMENTATION,tImplementation
hent INTERFACE,tInterface
hent UNIT,tUnit
hent USES,tUses
hent LABEL,tLabel
hent GOTO,tGoto
hent ASM,tAsm
hent INLINE,tInline
hent DESTRUCTOR,tDestructor
hent CONSTRUCTOR,tConstructor
hent OBJECT,tObject
hent SET,tSet
hent FILE,tFile
hent IN,tIn
hent XOR,tXor
hent SHR,tShr
hent SHL,tShl
hent MOD,tMod
hent DIV,tDiv
hent NIL,tNil
hent NOT,tNot
hent OR,tOr
hent AND,tAnd
hent WITH,tWith
hent CASE,tCase
hent STRING,tString
hent RECORD,tRecord
hent OF,tOf
hent ARRAY,tArray
hent CONST,tConst
hent TYPE,tType
hent VAR,tVar
hent DOWNTO,tDownto
hent ELSE,tElse
hent UNTIL,tUntil
hent REPEAT,tRepeat
hent DO,tDo
hent WHILE,tWhile
hent TO,tTo
hent FOR,tFor
hent THEN,tThen
hent IF,tIf
hent FUNCTION,tFunction
hent PROCEDURE,tProcedure
hent END,tEnd
hent BEGIN,tBegin
hend
ProcDirs label word
hash 4
hent ABSOLUTE,tAbsolute
hent ASSEMBLER,tAssembler
hent EXTERNAL,tExternal
hent FAR,tFar
hent FORWARD,tForward
hent INTERRUPT,tInterrupt
hent NEAR,tNear
hent VIRTUAL,tVirtual
hend
RegVars label word
hash 4
hent AL,t_Reg
db rAX+rByte
hent AH,t_Reg
db rAX+1+rByte
hent BL,t_Reg
db rBX+rByte
hent BH,t_Reg
db rBX+1+rByte
hent CL,t_Reg
db rCX+rByte
hent CH,t_Reg
db rCX+1+rByte
hent DL,t_Reg
db rDX+rByte
hent DH,t_Reg
db rDX+1+rByte
hent AX,t_Reg
db rAX
hent BX,t_Reg
db rBX
hent CX,t_Reg
db rCX
hent DX,t_Reg
db rDX
hent BP,t_Reg
db rBP
hent SI,t_Reg
db rSI
hent DI,t_Reg
db rDI
hent DS,t_Reg
db rDS
hent ES,t_Reg
db rES
hent IP,t_Reg
db rIP
hent CS,t_Reg
db rCS
hent FL,t_Reg
db rFL
hent SP,t_Reg
db rSP
hent SS,t_Reg
db rSS
hend
end