tpstart.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	extrn	VOpen:far
	extrn	VClose:far
	extrn	VRead:far
	extrn	VSeek:far
	extrn	VTime:far
	extrn	VFTime:far
	extrn	SetCompInfo:far

TInitParams	struc
	icLibraryName	dd	?
	icMemPtr	dw	?
	ends

TInitResult	struc
	irErrorNum	dw	?
	irMemPtr	dw	?
	ends

TCompParams	struc
	cpFlags		dw	?
	cpMainFile	dd	?
	cpMemPtr	dw	?
	cpOptions	dw	?
	cpStackSize	dw	?
	cpLowHeapLimit	dw	?
	cpHighHeapLimit	dw	?
	cpDefines	dd	?
	cpExeTpuDir	dd	?
	cpIncludeDir	dd	?
	cpUnitDir	dd	?
	cpObjectDir	dd	?
	ends

TCompResult	struc
	crErrorNum	dw	?
	crProgramLoc	dw	?
	crErrorFile	dd	?
	crErrorPar	dd	?
	crErrorLine	dw	?
	crErrorCol	dw	?
	crCodeSize	dd	?
	crDataSize	dw	?
	crStackSize	dw	?
	crMinHeapSize	dw	?
	crMaxHeapSize	dw	?
	crTotalLines	dd	?
	crFreeMemory	dd	?
	crExeName	dd	?
	ends

	.data

SystemName	db	6,'SYSTEM'
OpenFiles	dw	16 dup(0)

	extrn	ProgramStatus:word
	extrn	PrefixSeg:word

	.data?

LastCallTime	dw	?

	.code	compiler_text

	public	InitCompiler
	public	Compile
	public	ResetCompiler
	public	CreateHandle
	public	OpenHandle
	public	CloseHandle
	public	ReadHandle
	public	WriteHandle
	public	SeekHandle
	public	HandleTime
	public	FileTime
	public	DeleteFile
	public	CloseAll
	public	UpdateCompInfo
	public	StartFileInfo
	public	EndFileInfo
	public	C2Pas

InitCompiler	proc	far
	Argm	Params,dword,1
	Argm	Result,dword,1
	Entry	far
	cld
	les	di,Params
	mov	ax,es:[di].icMemPtr
	call	InitCompMem
	mov	TpuListPtr,offset TpuList
	mov	ax,100h
	Invoke	GetMemOnBottom
	mov	DebuggerPSP,bx
	mov	Use8087,0
	mov	ax,[di].icLibraryName.Offs
	or	ax,[di].icLibraryName.Segm
	jz	@@1
	lea	bx,[di].icLibraryName
	call	TempPas2C
@@1:	mov	UnitName,ax
	Invoke	ReadLibrary
	les	di,Result
	mov	ax,ErrorNum
	stosw
	mov	ax,CompMemPtr
	stosw
	push	cs
	call	near ptr ResetCompiler
	Exit
InitCompiler	endp

Compile	proc	far
	Argm	Params,dword,1
	Argm	Result,dword,1
	Entry	far
	cld
	les	di,Params
	mov	ax,es:[di].cpMemPtr
	call	InitCompMem
	mov	TpuListPtr,offset TpuList
	mov	ax,es:[di].cpFlags
	mov	CompilerFlags,ax
	lea	bx,[di].cpMainFile
	call	TempPas2C
	mov	UnitName,ax
	mov	ax,es:[di].cpOptions
	mov	InitOptions,ax
	mov	ax,es:[di].cpStackSize
	mov	StackSize,ax
	mov	ax,es:[di].cpLowHeapLimit
	mov	MinHeapSize,ax
	mov	ax,es:[di].cpHighHeapLimit
	mov	MaxHeapSize,ax
	lea	bx,[di].cpDefines
	call	TempPas2C
	mov	InitDefines,ax
	lea	bx,[di].cpExeTpuDir
	mov	si,2
@@1:	call	TempPas2C
	mov	Directories[si],ax
	add	bx,4
	inc	si
	inc	si
	cmp	si,10
	jne	@@1
	push	CompMemPtr TpuListPtr
	Invoke	CompilerEntry
	pop	TpuListPtr ax
	cmp	ProgramLocation,plDisk
	jb	@@2
	mov	ProgramStatus,psCompiled
	ja	@@3
	test	CompilerFlags.B1,cfIntDebugger
	jnz	@@3
@@2:	mov	CompMemPtr,ax
	call	CleanMemory
@@3:	les	di,Result
	mov	ax,ErrorNum
	stosw
	mov	ax,ProgramLocation
	stosw
	mov	bx,ErrorPos
	xor	si,si
	or	bx,bx
	jz	@@4
	lea	si,[bx].fsName
@@4:	call	TempC2Pas
	mov	si,ErrorPar
	call	TempC2Pas
	xor	ax,ax
	cwd
	or	bx,bx
	jz	@@5
	mov	ax,[bx].fsLineNumber
	mov	dx,[bx].fsTextPos
	sub	dx,bx
	sub	dx,fsCurrentLine-1
@@5:	stosw
	xchg	ax,dx
	stosw
	mov	ax,CodeSize.W0
	stosw
	mov	ax,CodeSize.W2
	stosw
	mov	ax,DataSize
	stosw
	mov	ax,StackSize
	stosw
	mov	ax,MinHeapSize
	stosw
	mov	ax,MaxHeapSize
	stosw
	mov	ax,TotalLines.W0
	stosw
	mov	ax,TotalLines.W2
	stosw
	mov	ax,CompMemTop
	sub	ax,CompMemPtr
	mov	dx,16
	mul	dx
	stosw
	xchg	ax,dx
	stosw
	xor	si,si
	cmp	ProgramLocation,plDisk
	jne	@@6
	lea	si,ExeName
@@6:	call	TempC2Pas
	Exit
Compile	endp

ResetCompiler	proc	far
	Entry	far
	xor	ax,ax
	mov	ProgramStatus,ax
	mov	ProgramSegment,ax
	mov	SourceCount,ax
	call	CleanMemory
	Exit
ResetCompiler	endp

InitCompMem	proc	near
	mov	CompMemPtr,ax
	push	ds
	mov	ds,PrefixSeg
	mov	ax,ds:[2]
	pop	ds
	mov	CompMemTop,ax
	ret
InitCompMem	endp

TempPas2C	proc	near
	push	es di si
	les	di,es:[bx]
	mov	si,TpuListPtr
	push	si
	Invoke	Pas2C
	pop	ax
	mov	TpuListPtr,si
	pop	si di es
	ret
TempPas2C	endp

TempC2Pas	proc	near
	xor	ax,ax
	cwd
	or	si,si
	jz	@@1
	push	es di
	mov	di,TpuListPtr
	push	di
	call	C2Pas
	pop	ax
	mov	TpuListPtr,di
	mov	dx,ds
	pop	di es
@@1:	stosw
	xchg	ax,dx
	stosw
	ret
TempC2Pas	endp

CleanMemory	proc	near
	mov	ax,LibraryUnits
	mov	bx,6
	lea	si,SystemName
	Invoke	SearchUnitName
	mov	ax,0
	jnz	@@1
	mov	es:uhNext,ax
	mov	di,es:uhName
	mov	bl,es:[di].seName.B0
	mov	bh,0
	mov	es:[di+size TSymbol+bx].usAddress,es
	mov	ax,es
@@1:	mov	FirstUnit,ax
	mov	SystemUnit,ax
	ret
CleanMemory	endp

CreateHandle	proc	near
	mov	ax,3
	jmp	short @@1
OpenHandle	label	near
	xor	ax,ax
@@1:	Loc	S,byte,80
	Entry
	push	es di si dx
	mov	si,dx
	lea	di,S
	push	ds di ax
	call	C2Pas
	call	VOpen
	cld
	pop	dx
	or	ax,ax
	jl	@@2
	xor	bx,bx
	call	TrackOpenFile
	pop	si di es
	Exit
@@2:	mov	cx,15
	cmp	al,-2
	je	@@3
	mov	cl,13
	cmp	al,-4
	je	@@3
	mov	cl,146
	cmp	al,-5
	je	@@3
	mov	cl,14
@@3:	xchg	ax,cx
	Chain	ParamError2
CreateHandle	endp

CloseHandle	proc	near
	push	es di si
	xor	ax,ax
	call	TrackOpenFile
	push	bx
	call	VClose
	cld
	pop	si di es
	ret
CloseHandle	endp

TrackOpenFile	proc	near
	lea	di,OpenFiles
	push	ds
	pop	es
	mov	cx,16
	xchg	ax,bx
	repne	scasw
	xchg	ax,bx
	jne	@@1
	mov	[di-2],ax
@@1:	ret
TrackOpenFile	endp

ReadHandle	proc	near
	jcxz	@@1
	push	es di si bx dx ax cx
	call	VRead
	cld
	pop	si di es
	cmp	ax,-1
	je	@@1
	ret
@@1:	xor	ax,ax
	ret
ReadHandle	endp

WriteHandle	proc	near
	jcxz	@@1
	push	ds
	mov	ds,dx
	mov	dx,ax
	mov	ah,40h
	int	21h
	cld
	pop	ds
	jc	@@2
	cmp	ax,cx
	jne	@@2
@@1:	ret
@@2:	mov	ax,16
	Chain	CompileError
WriteHandle	endp

SeekHandle	proc	near
	push	es di si bx dx ax cx
	call	VSeek
	cld
	pop	si di es
	ret
SeekHandle	endp

HandleTime	proc	near
	push	es di si bx
	call	VTime
	cld
	pop	si di es
	ret
HandleTime	endp

FileTime	proc	near
	Loc	S,byte,80
	Entry
	push	es di si
	mov	si,dx
	lea	di,S
	push	ds di
	call	C2Pas
	call	VFTime
	cld
	pop	si di es
	Exit
FileTime	endp

DeleteFile	proc	near
	mov	ah,41h
	int	21h
	cld
	ret
DeleteFile	endp

CloseAll	proc	near
	push	es di si
	lea	bx,OpenFiles
@@1:	xor	ax,ax
	xchg	ax,[bx]
	or	ax,ax
	jz	@@2
	push	bx ax
	call	VClose
	cld
	pop	bx
@@2:	inc	bx
	inc	bx
	cmp	bx,offset OpenFiles+32
	jne	@@1
	pop	si di es
	ret
CloseAll	endp

UpdateCompInfo	proc	near
	call	GetCurrentTime
	sub	ax,LastCallTime
	cmp	ax,5
	jae	InsideFileInfo
	ret
UpdateCompInfo	endp

StartFileInfo	proc	near
	xor	bx,bx
	jmp	short @@1
EndFileInfo	label	near
	mov	bx,1
	jmp	short @@1
InsideFileInfo	label	near
	mov	bx,2
@@1:	Loc	S,byte,80
	Entry
	push	es di si
	mov	ax,CompMemTop
	sub	ax,CompMemPtr
	mov	dx,10h
	mul	dx
	push	dx ax TotalLines
	xor	ax,ax
	xor	dx,dx
	xor	cx,cx
	mov	di,FileStackPtr
	cmp	di,offset CompMemPtr
	je	@@2
	push	di
	lea	si,[di].fsName
	lea	di,S
	call	C2Pas
	pop	di
	lea	ax,S
	mov	dx,ds
	mov	cx,[di].fsLineNumber
@@2:	push	cx bx dx ax
	mov	ax,sp
	push	ss ax
	call	SetCompInfo
	cld
	add	sp,16
	or	ax,ax
	jnz	@@3
	call	GetCurrentTime
	mov	LastCallTime,ax
	pop	si di es
	Exit
@@3:	Chain	CompileError
StartFileInfo	endp

GetCurrentTime	proc	near
	mov	dx,ds
	mov	ax,40h
	mov	ds,ax
	mov	ax,ds:[6ch]
	mov	ds,dx
	ret
GetCurrentTime	endp

C2Pas	proc	near
	push	ds
	pop	es
	push	di
	mov	di,si
	mov	cx,80
	xor	al,al
	repnz	scasb
	pop	di
	mov	ax,79
	sub	ax,cx
	mov	cx,ax
	add	si,cx
	add	di,cx
	dec	si
	std
	rep	movsb
	cld
	stosb
	add	di,ax
	ret
C2Pas	endp

	end