www.pudn.com > tp60src.zip > TPSTART.ASM
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