📄 declare.asm
字号:
mov al,tOParen
Invoke CheckToken
jnz @@1
push es di
call GetParamList
pop di es
mov es:[di].ptParamCount,cx
mov al,tCParen
Invoke NeedToken
@@1: pop ax
cmp al,tFunction
jne @@2
mov al,tColon
Invoke NeedToken
push es di
call GetTypeName
cmp es:[di].tdType,ttPointer
jb @@3
call _SearchUnit
pop di es
mov es:[di].ptResult.Offs,ax
mov es:[di].ptResult.Segm,dx
@@2: ret
@@3: mov ax,34
Chain CompileError
GetProcHeader endp
GetParamList proc near
Loc Flags,byte,2
Loc CurCount,word,1
Loc TotalCount,word,1
Entry
mov TotalCount,0
@@1: mov CurCount,0
mov al,tVar
Invoke CheckToken
mov al,vfLocal+vfAddress
jz @@2
mov al,vfLocal
@@2: mov Flags,al
@@3: call GetIdent
inc CurCount
mov al,tComma
Invoke CheckToken
jz @@3
test Flags,vfAddress
jz @@4
mov es,SystemUnit
mov di,_Void
cmp CurrentToken,tColon
jne @@5
@@4: mov al,tColon
Invoke NeedToken
call _GetTypeName
test Flags,vfAddress
jnz @@5
cmp es:[di].tdType,ttFile
je @@8
cmp es:[di].tdType,ttText
je @@8
@@5: call _SearchUnit
push dx ax
mov ax,size TProcParam
mul CurCount
Invoke GetDictMem
pop ax dx
mov bl,Flags
mov cx,CurCount
@@6: mov es:[di].ppType.Offs,ax
mov es:[di].ppType.Segm,dx
mov es:[di].ppFlags,bl
add di,size TProcParam
loop @@6
mov ax,CurCount
add TotalCount,ax
mov al,tSemicolon
Invoke CheckToken
jnz @@7
jmp @@1
@@7: mov cx,TotalCount
Exit
@@8: mov ax,126
Chain CompileError
GetParamList endp
GetIdent proc near
Invoke NeedIdent
lea si,IdentBuf
mov al,[si]
mov ah,0
inc ax
mov cx,ax
lea bx,TempDict
Invoke GetMemory
rep movsb
Chain GetToken
GetIdent endp
SetType proc near
Invoke GetToken
mov al,tOf
Invoke NeedToken
call GetBound
mov ax,es:[di].itLowerBound.W0
mov bx,es:[di].itUpperBound.W0
or ah,bh
jnz @@1
mov cl,3
shr ax,cl
shr bx,cl
sub bx,ax
inc bx
call _SearchUnit
push dx ax
mov ax,size TSetType
mov cx,ttSet
call PutTypePrefix
pop es:[di].stBase
ret
@@1: mov ax,23
Chain CompileError
SetType endp
PointerType proc near
Invoke GetToken
mov al,CurrentToken
mov di,_String
cmp al,tString
je @@1
mov di,_File
cmp al,tFile
je @@1
push TempDict.Offs
call GetIdent
mov ax,size TPointerType
mov bx,4
mov cx,ttPointer+emLongint*256
call PutTypePrefix
mov ax,ForwardTypes
mov es:[di].ptBase.Offs,ax
pop es:[di].ptBase.Segm
mov ForwardTypes,di
ret
@@1: mov es,SystemUnit
call _SearchUnit
push dx ax
mov ax,size TPointerType
mov bx,4
mov cx,ttPointer+emLongint*256
call PutTypePrefix
pop es:[di].ptBase
Chain GetToken
PointerType endp
FileType proc near
Invoke GetToken
mov al,tOf
Invoke CheckToken
jnz @@1
call GetTypeNoObj
mov al,es:[di].tdType
cmp al,ttObject
je @@2
cmp al,ttFile
je @@2
cmp al,ttText
je @@2
call _SearchUnit
push dx ax
mov ax,size TFileType
mov bx,128
mov cx,4
call PutTypePrefix
pop es:[di].ftBase
ret
@@1: mov es,SystemUnit
mov di,_File
ret
@@2: mov ax,24
Chain CompileError
FileType endp
StringType proc near
Invoke GetToken
mov al,tOBracket
Invoke CheckToken
jz @@2
mov es,SystemUnit
mov di,_String
ret
@@1: mov ax,25
Chain CompileError
@@2: call GetIntConstExpr
or dx,dx
jnz @@1
or ah,ah
jnz @@1
or al,al
jz @@1
push ax
mov di,_Longint
mov es,SystemUnit
call _SearchUnit
push dx ax
mov ax,size TOrdinalType
mov bx,1
mov cx,ttInteger+emByte*256
call PutTypePrefix
pop es:[di].itBase
pop bx
xor ax,ax
mov es:[di].itLowerBound.W0,ax
mov es:[di].itLowerBound.W2,ax
mov es:[di].itUpperBound.W0,bx
mov es:[di].itUpperBound.W2,ax
inc bx
call _SearchUnit
push dx ax
mov di,_Char
mov es,SystemUnit
call _SearchUnit
push dx ax
mov ax,size TArrayType
mov cx,ttString
call PutTypePrefix
pop es:[di].atBase
pop es:[di].atBounds
mov al,tCBracket
Chain NeedToken
StringType endp
EnumType proc near
Invoke GetToken
mov ax,size TOrdinalType
xor bx,bx
mov cx,ttEnum
call PutTypePrefix
push es di
call _SearchUnit
mov es:[di].itBase.Offs,ax
mov es:[di].itBase.Segm,dx
push dx ax
mov ax,size TSetType+2
mov bx,32
mov cx,ttSet
call PutTypePrefix
pop bx dx
mov es:[di].stBase.Offs,bx
mov es:[di].stBase.Segm,dx
mov cx,-1
@@1: inc cx
push bx cx dx
mov ax,size TConstStub+4
Invoke AddIdent2Dict
mov es:[bx].seType,t_Const
pop dx cx bx
mov ax,bx
stosw
mov ax,dx
stosw
mov ax,cx
stosw
xor ax,ax
stosw
mov al,tComma
Invoke CheckToken
jz @@1
mov al,tCParen
Invoke NeedToken
mov ax,cx
xor dx,dx
call FitConstType
mov bx,1
test al,emX
jz @@2
inc bx
@@2: pop di es
mov es:[di].tdModifier,al
mov es:[di].tdSizeOf,bx
xor ax,ax
mov es:[di].itLowerBound.W0,ax
mov es:[di].itLowerBound.W2,ax
mov es:[di].itUpperBound.W0,cx
mov es:[di].itUpperBound.W2,ax
mov es:[di].etReserved,ax
ret
EnumType endp
RangeType proc near
Loc LowerBound,byte,<size TExpr>
Loc UpperBound,byte,<size TExpr>
Entry
lea di,LowerBound
call GetConstExpr
cmp es:[bx].tdType,ttInteger
jae @@1
mov ax,27
Chain CompileError
@@1: mov al,tRange
Invoke NeedToken
lea di,UpperBound
call GetConstExpr
cmp bx,LowerBound.exType.Offs
jne @@2
mov ax,es
cmp ax,LowerBound.exType.Segm
je @@3
@@2: mov ax,26
Chain CompileError
@@3: mov ax,UpperBound.exValue.W0
mov dx,UpperBound.exValue.W2
sub ax,LowerBound.exValue.W0
sbb dx,LowerBound.exValue.W2
jge @@4
mov ax,28
Chain CompileError
@@4: mov ax,LowerBound.exValue.W0
mov dx,LowerBound.exValue.W2
call FitConstType
mov cl,al
mov ax,UpperBound.exValue.W0
mov dx,UpperBound.exValue.W2
call FitConstType
mov ah,cl
call IntExtension
mov bx,1
test al,emX
jz @@5
inc bx
test al,emXX
jz @@5
inc bx
inc bx
@@5: les di,LowerBound.exType
mov cl,es:[di].tdType
mov ch,al
call _SearchUnit
push dx ax
mov ax,size TOrdinalType
call PutTypePrefix
mov ax,LowerBound.exValue.W0
mov es:[di].itLowerBound.W0,ax
mov ax,LowerBound.exValue.W2
mov es:[di].itLowerBound.W2,ax
mov ax,UpperBound.exValue.W0
mov es:[di].itUpperBound.W0,ax
mov ax,UpperBound.exValue.W2
mov es:[di].itUpperBound.W2,ax
pop es:[di].itBase
Exit
RangeType endp
GetBound proc near
Invoke ProcessCaret
call GetTypeNoObj
cmp es:[di].tdType,ttInteger
jb @@1
cmp es:[di].tdSizeOf,2
ja @@1
ret
@@1: mov ax,29
Chain CompileError
GetBound endp
PutTypePrefix proc near
push bx
Invoke GetDictMem
pop bx
mov word ptr es:[di].tdType,cx
mov es:[di].tdSizeOf,bx
mov es:[di].tdNext,0
ret
PutTypePrefix endp
_SearchUnit proc near
mov ax,di
mov dx,es
SearchUnit label near
push bx di ds
mov ds,Dictionary.Segm
mov di,ds:uhName
xor bx,bx
jmp short @@2
@@1: mov di,[di+size TSymbol+bx].usNext
or di,di
jz @@3
@@2: mov bl,[di].seName.B0
cmp dx,[di+size TSymbol+bx].usAddress
jne @@1
lea dx,[di+size TSymbol+bx]
pop ds di bx
ret
@@3: pop ds
mov ax,136
Chain CompileError
_SearchUnit endp
GetInitializer proc near
push es di
mov ax,es:[di].tdSizeOf
lea bx,CompiledConst
mov cx,ax
Invoke GetMemory
mov ConstPtr,di
xor al,al
rep stosb
mov ConstSectStart2,di
pop di es
call _GetInit
mov ax,ConstSectStart
mov ConstSectStart2,ax
ret
GetInitializer endp
_GetInit proc near
mov bl,es:[di]
xor bh,bh
shl bx,1
jmp cs:@@1[bx]
@@1 dw InitError
dw InitArray
dw InitRecord
dw InitRecord
dw InitError
dw InitError
dw InitNumber
dw InitSet
dw InitNumber
dw InitString
dw InitNumber
dw InitNumber
dw InitNumber
dw InitNumber
dw InitNumber
dw InitNumber
_GetInit endp
InitError proc near
mov ax,99
Chain CompileError
InitError endp
InitArray proc near
Loc _Type,dword,1
Entry
mov _Type.Offs,di
mov _Type.Segm,es
lea di,_Type
Invoke CheckPackedChar
jnz @@2
cmp CurrentToken,tOParen
je @@2
call GetStrConstExpr
mov cl,[bx]
xor ch,ch
inc bx
les di,_Type
mov ax,es:[di].tdSizeOf
cmp cx,ax
jne @@1
call PutConst
jmp short @@5
@@1: mov ax,100
Chain CompileError
@@2: mov al,tOParen
Invoke NeedToken
les di,_Type
mov bx,es:[di].atBounds.Segm
mov di,es:[di].atBounds.Offs
mov es,es:[bx]
mov cx,es:[di].itUpperBound.W0
sub cx,es:[di].itLowerBound.W0
les di,_Type
mov bx,es:[di].atBase.Segm
mov di,es:[di].atBase.Offs
mov es,es:[bx]
@@3: push cx es di
call _GetInit
pop di es cx
dec cx
js @@4
mov al,tComma
Invoke NeedToken
jmp @@3
@@4: mov al,tCParen
Invoke NeedToken
@@5: Exit
InitArray endp
InitRecord proc near
Loc _Type,dword,1
Loc SaveConstPtr,word,1
Loc VMTOffset,word,1
Entry
mov _Type.Offs,di
mov _Type.Segm,es
mov ax,ConstPtr
mov SaveConstPtr,ax
mov ax,-1
cmp es:[di].tdType,ttObject
jne @@1
cmp es:[di].otVMTSize,0
je @@1
mov ax,es
mov bx,es:[di].otVMTAddr
mov cx,ffConst+ffOffs
xor dx,dx
mov si,ConstPtr
add si,es:[di].otVMTOffset
Invoke PutConstFixup
mov ax,es:[di].otVMTOffset
@@1: mov VMTOffset,ax
mov al,tOParen
Invoke NeedToken
cmp CurrentToken,tCParen
je @@4
@@2: mov ax,ConstPtr
sub ax,SaveConstPtr
cmp ax,VMTOffset
jne @@3
add ConstPtr,2
@@3: les si,_Type
Invoke SearchField
jnz @@5
cmp al,t_Var
jne @@5
Invoke GetToken
mov ax,ConstPtr
sub ax,SaveConstPtr
cmp ax,es:[di].vsOffset
jne @@6
mov al,tColon
Invoke NeedToken
mov bx,es:[di].vsType.Segm
mov di,es:[di].vsType.Offs
mov es,es:[bx]
call _GetInit
mov al,tSemicolon
Invoke CheckToken
jz @@2
@@4: mov al,tCParen
Invoke NeedToken
les di,_Type
mov ax,SaveConstPtr
add ax,es:[di].tdSizeOf
mov ConstPtr,ax
Exit
@@5: mov ax,44
Chain CompileError
@@6: mov ax,101
Chain CompileError
InitRecord endp
InitSet proc near
Loc Temp,byte,<size TExpr>
Entry
push es di
lea di,Temp
call GetConstExpr
mov si,sp
Invoke TypeCompat
pop bx es
Invoke SetBaseAndSize
mov bl,ah
xor bh,bh
add bx,Temp.exOffset
xor ah,ah
mov cx,ax
call PutConst
Exit
InitSet endp
InitString proc near
push es:[di].tdSizeOf
call GetStrConstExpr
pop ax
dec ax
mov cl,[bx]
xor ch,ch
cmp cx,ax
jbe @@1
mov cx,ax
mov [bx],cl
@@1: inc ax
inc cx
jmp PutConst
InitString endp
InitNumber proc near
Loc Temp,byte,<size TExpr>
Entry
push StmtPart.Offs es di
lea di,Temp
mov si,sp
Invoke GetExpression
mov si,sp
Invoke AssignmentCast
Invoke TypeCompat
Invoke CastOrdinal
pop di es ax
cmp ax,StmtPart.Offs
jne @@8
cmp es:[di].tdType,tt8087
jne @@1
mov al,es:[di].tdModifier
lea bx,Temp.exValue
Invoke Extended2Float
@@1: mov ax,es:[di].tdSizeOf
cmp Temp.exLocation,elAddress
je @@2
lea bx,Temp.exValue
mov cx,ax
call PutConst
jmp short @@7
@@2: test Temp.exMisc,efSS+efES+efBP+efDI
jnz @@8
push ax
mov ax,Temp.exSegment
mov bx,Temp.exMap
mov dx,Temp.exOffset
test Temp.exMisc,efDS
jnz @@3
xor cx,cx
test Temp.exMisc,efCS
jz @@4
mov cx,ffCode
jmp short @@4
@@3: mov cx,ffData
test Temp.exMisc,efConst
jz @@4
mov cx,ffConst
@@4: test Temp.exMisc,efSeg
jnz @@5
or cx,ffOffs
test Temp.exModifier,emXX
jz @@6
@@5: or cx,ffSegm
@@6: mov si,ConstPtr
Invoke PutConstFixup
pop ax
add ConstPtr,ax
@@7: Exit
@@8: mov ax,133
Chain CompileError
InitNumber endp
PutConst proc near
mov si,bx
mov di,ConstPtr
mov es,CompiledConst.Segm
rep movsb
add ConstPtr,ax
ret
PutConst endp
GetConstExpr proc near
push StmtPart.Offs
Invoke GetExpr
pop ax
cmp ax,StmtPart.Offs
jne @@2
cmp [di].exLocation,elImmediate
jne @@2
les bx,[di].exType
cmp es:[bx].tdType,ttInteger
jb @@1
mov si,es:[bx].itBase.Segm
mov bx,es:[bx].itBase.Offs
mov es,es:[si]
mov [di].exType.Offs,bx
mov [di].exType.Segm,es
@@1: ret
@@2: mov ax,133
Chain CompileError
GetConstExpr endp
GetIntConstExpr proc near
Loc Temp,byte,<size TExpr>
Entry
lea di,Temp
call GetConstExpr
cmp es:[bx].tdType,ttInteger
jne @@1
mov ax,[di].exValue.W0
mov dx,[di].exValue.W2
Exit
@@1: mov ax,30
Chain CompileError
GetIntConstExpr endp
GetStrConstExpr proc near
Loc Temp,byte,<size TExpr>
Entry
lea di,Temp
call GetConstExpr
Invoke ConvChar2String
les bx,[di].exType
cmp es:[bx].tdType,ttString
jne @@1
mov bx,[di].exOffset
Exit
@@1: mov ax,102
Chain CompileError
GetStrConstExpr endp
FitConstType proc near
or dx,dx
js @@5
jnz @@4
or ah,ah
js @@3
jnz @@2
or al,al
js @@1
xor al,al
ret
@@1: mov al,emByte
ret
@@2: mov al,emX
ret
@@3: mov al,emWord
ret
@@4: mov al,emX+emXX
ret
@@5: cmp dx,-1
jne @@7
cmp ah,-1
jne @@6
or al,al
jns @@6
mov al,emShortint
ret
@@6: or ah,ah
jns @@7
mov al,emInteger
ret
@@7: mov al,emLongint
ret
FitConstType endp
IntExtension proc near
cmp al,ah
jae @@1
xchg al,ah
@@1: test ah,emSigned
jz @@3
test al,emUnsigned
jz @@2
shl al,1
@@2: or al,emSigned
@@3: ret
IntExtension endp
end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -