www.pudn.com > tp60src.zip > COMPILE.ASM
model large compiler_text,pascal include compiler.inc .data DefProgramName db 7,'PROGRAM' SystemName db 6,'SYSTEM' SystemTps db 'SYSTEM.TPS',0 Extensions db 'PAS',0 db 'EXE',0 db 'TPU',0 db 'OBJ',0 db 'MAP',0 db 'OVR',0 ErrorNumbers dw 123,123,123,123,123,123,123,123,123,123,48,49,48,49,124 Signature db '$*$*$*',0,4,8,5,'COMPILER',0 .code compiler_text public CompilerEntry public SearchUnitName public CreateFile public CloseFile public ReadObjectFile public CloseObjectFile public BigWrite public GetFileSize public ConvertName public FileCreate public FileClose public FileWrite public WriteBig public GetFlatMem public GetProcStackSize public FlatMemAvail CompilerEntry proc near cld lea ax,@@3 Invoke SetErrHandler lea di,ProgramLocation push ds pop es lea cx,CompilerFlags sub cx,di xor ax,ax rep stosb mov SavedDepth,ax dec ax mov SavedDepth2,ax lea ax,CompMemPtr mov FileStackPtr,ax mov SaveFileStack,ax mov TempBufPtr,offset TempBuffer mov DefinesPtr,offset DefinesBuf call PutHeader call CompileFile cmp ProgramSection,0 jge @@2 inc ProgramLocation test CompilerFlags.B0,cfDisk jnz @@1 inc ProgramLocation @@1: ret @@2: mov StackSize,ax mov MinHeapSize,ax mov MaxHeapSize,ax ret @@3: mov di,FileStackPtr cmp di,offset CompMemPtr je @@4 mov ErrorPos,di mov ax,TextPos mov [di].fsTextPos,ax @@4: cmp FileHandle,0 je @@5 lea dx,FileNameBuf Invoke DeleteFile @@5: cmp ExeHandle,0 jz @@6 lea dx,ExeName Invoke DeleteFile @@6: ret CompilerEntry endp PutHeader proc near lea di,UnitNameLen push ds pop es lea cx,ConstSectStart2+2 sub cx,di xor al,al rep stosb mov ax,InitOptions mov GlobalOptions,ax lea si,ErrorNumbers lea di,Dictionary lea dx,StmtPart+8 Invoke InitHeap mov ax,size TUnitHeader Invoke GetDictMem mov ax,'PT' stosw mov ax,'9U' stosw mov ax,FirstUnit stosw mov FirstUnit,es ZeroHeader label near mov es,Dictionary.Segm mov di,uhLink mov cx,(size TUnitHeader-uhLink) shr 1 xor ax,ax rep stosw mov Dictionary.Offs,di ret PutHeader endp CompileFile proc near mov SlashToken,tSlash mov EqualToken,tEqual mov al,fdUnitDir mov dx,UnitName add dx,UnitNameLen Invoke AddToSourceList mov dx,UnitName Invoke AddToFileStack Invoke MarkFileTime push SaveFileStack SaveDefinesPtr mov ax,FileStackPtr mov SaveFileStack,ax mov ax,DefinesPtr mov SaveDefinesPtr,ax Invoke StandardDefines Invoke GetToken test CompilerFlags.B0,cfForceUnit jnz @@1 cmp CurrentToken,tUnit je @@1 call CompileProgram jmp short @@2 @@1: call CompileUnit @@2: mov ax,SaveDefinesPtr mov DefinesPtr,ax pop SaveDefinesPtr SaveFileStack Chain PopFileStack CompileFile endp CompileProgram proc near mov ProgramSection,psMainProgram mov al,tProgram Invoke CheckToken jnz @@3 Invoke NeedIdent call PutProgramName Invoke GetToken mov al,tOParen Invoke CheckToken jnz @@2 @@1: mov al,t_Ident Invoke NeedToken mov al,tComma Invoke CheckToken jz @@1 mov al,tCParen Invoke NeedToken @@2: mov al,tSemicolon Invoke NeedToken jmp short @@4 @@3: lea di,DefProgramName push ds pop es Invoke CalcHash call PutProgramName @@4: call UsesClause Invoke DeclarationPart call MainProgram call EndOfFile Invoke LinkObjects Invoke CheckUndefs call FlushUnit call FlushSegments Chain LinkProgram CompileProgram endp CompileUnit proc near mov ProgramSection,psInterface mov al,tUnit Invoke NeedToken Invoke NeedIdent call PutUnitName Invoke GetToken mov al,tSemicolon Invoke NeedToken mov al,tInterface Invoke NeedToken call UsesClause Invoke DeclarationPart call CalcChecksum mov ax,Dictionary.Offs mov InterfaceEnd,ax mov ProgramSection,psImplementation mov al,tImplementation Invoke NeedToken call UsesClause call CreateDebugHash Invoke DeclarationPart cmp CurrentToken,tBegin jne @@1 call MainProgram jmp short @@2 @@1: mov al,tEnd Invoke NeedToken @@2: call EndOfFile Invoke LinkObjects Invoke CheckUndefs call FlushSymbols call FlushUnit call SaveUnit jmp FlushSegments CompileUnit endp HValue SYSTEM,128 PutUnitName proc near mov al,@HS lea di,SystemName Invoke CompareSymbol jnz @@1 mov CompilingSystem,1 lea si,SystemTps lea di,FileNameBuf Invoke CopyDSCStr mov ax,fdUnitDir*256 lea dx,FileNameBuf call ConvertName lea dx,FileNameBuf call ReadUnit jmp short @@2 PutProgramName label near @@1: les di,Dictionary mov es:uhInterface,di mov es:uhDebugHash,di mov ax,64 Invoke CreateHashTable @@2: les di,Dictionary mov es:uhName,di mov ax,size TUnitStub Invoke AddNewIdent mov es:[bx].seType,t_Unit mov NextUnit,di mov ax,es stosw xor ax,ax stosw stosw stosw mov ax,size TProcMap lea bx,ProcMap Invoke GetMemory xor ax,ax stosw stosw dec ax stosw stosw ret PutUnitName endp UsesClause proc near mov es,Dictionary.Segm or GlobalOptions,coGlobal test GlobalOptions,coOverlayCode jz @@1 or es:uhFlags,ufOverlay @@1: mov di,es:uhName mov bl,es:[di].seName.B0 mov bh,0 mov ax,es:[di+size TSymbol+bx].usPrev mov PrevUnit,ax cmp CompilingSystem,0 jne @@2 cmp ProgramSection,psImplementation je @@2 lea di,SystemName push ds pop es Invoke CalcHash call Insert2UsesList @@2: mov al,tUses Invoke CheckToken pushf jnz @@4 @@3: Invoke NeedIdent call Insert2UsesList Invoke GetToken mov al,tComma Invoke CheckToken jz @@3 @@4: call UseUnit popf jnz @@5 mov al,tSemicolon Invoke NeedToken @@5: mov es,Dictionary.Segm mov di,es:uhName mov bl,es:[di].seName.B0 mov bh,0 mov ax,PrevUnit mov es:[di+size TSymbol+bx].usPrev,ax cmp CompilingSystem,0 jne @@6 mov di,es:[di+size TSymbol+bx].usNext mov bl,es:[di].seName.B0 mov bh,0 @@6: mov ax,es:[di+size TSymbol+bx].usAddress mov SystemUnit,ax ret UsesClause endp Insert2UsesList proc near mov ax,size TUnitStub Invoke AddNewIdent mov es:[bx].seType,t_Unit mov si,NextUnit mov es:[si].usNext,bx mov NextUnit,di mov si,PrevUnit mov es:[di].usPrev,si mov PrevUnit,bx ret Insert2UsesList endp CalcChecksum proc near call PushLinks push ds lds cx,Dictionary mov si,es:uhInterface sub cx,si shr cx,1 xor dx,dx @@1: lodsw rol dx,1 add dx,ax loop @@1 or dx,dx jnz @@2 dec dx @@2: mov di,ds:uhName mov bl,[di].seName.B0 mov bh,0 mov [di+size TSymbol+bx].usChecksum,dx pop ds call PopLinks ret CalcChecksum endp PushLinks proc near pop dx xor cx,cx mov es,Dictionary.segm mov di,es:uhName @@1: mov bl,es:[di].seName.B0 mov bh,0 lea di,[di+size TSymbol+bx] push es:[di].usAddress push di mov es:[di].usAddress,0 inc cx mov di,es:[di].usNext or di,di jnz @@1 push cx jmp dx PushLinks endp PopLinks proc near pop dx cx @@1: pop di pop es:[di].usAddress loop @@1 jmp dx PopLinks endp CreateDebugHash proc near mov es,Dictionary.Segm mov di,es:uhInterface mov ax,es:[di] add ax,4 Invoke GetDictMem mov es:uhDebugHash,di ret CreateDebugHash endp MainProgram proc near xor ax,ax mov LocalsSize,ax mov LocalsBottom,ax Invoke StatementPart mov es,ProcMap.Segm mov es:pmEntryPoint,ax mov ax,CodeMap.Offs mov es:pmCodeMap,ax Invoke FlushCodeMap Chain FlushConstMap MainProgram endp EndOfFile proc near cmp CurrentToken,tPoint jne @@1 mov di,FileStackPtr cmp di,SaveFileStack jne @@2 Chain StartFileInfo @@1: mov ax,94 Chain CompileError @@2: mov ax,10 Chain CompileError EndOfFile endp FlushSymbols proc near mov ax,GlobalOptions and ax,coDebugInfo+coLocalSymbols cmp ax,coDebugInfo+coLocalSymbols jne @@1 push ds mov ds,Dictionary.Segm mov si,ds:uhInterface mov di,ds:uhDebugHash mov cx,[si] add cx,4 push ds pop es rep movsb pop ds jmp short @@2 @@1: mov es,Dictionary.Segm mov ax,es:uhDebugHash mov Dictionary.Offs,ax mov ax,es:uhInterface mov es:uhDebugHash,ax @@2: mov es,Dictionary.Segm mov di,es:uhInterface mov cx,es:[di] shr cx,1 inc cx mov ax,InterfaceEnd @@3: inc di inc di mov bx,di @@4: mov bx,es:[bx] cmp bx,ax jae @@4 mov es:[di],bx loop @@3 ret FlushSymbols endp FlushUnit proc near mov es,UnitList.Segm xor ax,ax xor bx,bx xor di,di jmp short @@2 @@1: mov es:[di].ulSegment,ax mov bl,es:[di].ulName.B0 lea di,[di+size TUnitList+bx] @@2: cmp di,UnitList.Offs jne @@1 mov es,Dictionary.Segm mov ax,DefUnitFlags or es:uhFlags,ax Chain FormUnit FlushUnit endp SaveUnit proc near test CompilerFlags.B0,cfDisk jz @@1 call PushLinks mov es,Dictionary.Segm push es:uhNext xor ax,ax mov es:uhNext,ax mov ax,feTpu+feForceExt+(fdOutputDir+fdNoEditor)*256 call CreateFile Invoke WriteUnit call CloseFile mov es,Dictionary.Segm pop es:uhNext call PopLinks @@1: mov ax,CompiledCode.Offs mov CodeSize.W0,ax xor ax,ax mov CodeSize.W2,ax mov ax,CompiledConst.Offs add ax,VarsSize mov DataSize,ax ret SaveUnit endp FlushSegments proc near mov es,Dictionary.Segm mov di,uhCodeSeg mov ax,CompiledCode.Segm stosw mov ax,CompiledConst.Segm stosw mov ax,CodeFixups.Segm stosw mov ax,ConstFixups.Segm stosw ret FlushSegments endp UseUnit proc near inc CurDepth mov es,FirstUnit mov ax,UsedUnit xchg ax,es:uhNext mov FirstUnit,ax mov UsedUnit,es mov di,es:uhName mov bl,es:[di].seName mov bh,0 mov dx,es @@1: mov es:[di+size TSymbol+bx].usAddress,dx mov di,es:[di+size TSymbol+bx].usNext or di,di jz @@3 push di add di,seName call LoadUnit mov di,es:uhName mov bl,es:[di].seName.B0 mov bh,0 mov ax,es:[di+size TSymbol+bx].usChecksum mov dx,es pop di mov es,UsedUnit mov bl,es:[di].seName.B0 mov bh,0 mov cx,es:[di+size TSymbol+bx].usChecksum or cx,cx jnz @@2 mov es:[di+size TSymbol+bx].usChecksum,ax jmp @@1 @@2: cmp ax,cx je @@1 add di,seName @@3: mov es,UsedUnit mov ax,FirstUnit xchg ax,es:uhNext mov UsedUnit,ax mov FirstUnit,es dec CurDepth mov ax,SavedDepth2 cmp ax,CurDepth jne @@4 push di Invoke RestoreState pop di @@4: mov es,FirstUnit or di,di ret UseUnit endp LoadUnit proc near Loc SourceTime,dword,1 Loc UnitTime,dword,1 Loc NameLen,word,1 Loc UName,byte,64 Loc SourceName,byte,80 Loc TpuName,byte,80 Entry lea si,UName Invoke CopyPasStr mov ax,FirstUnit mov bx,uhNext lea si,UName call SearchUnitName jz @@1 mov ax,UsedUnit mov bx,uhNext lea si,UName call SearchUnitName jnz @@2 mov di,es:uhName mov bl,es:[di].seName.B0 mov bh,0 cmp es:[di+size TSymbol+bx].usChecksum,0 je @@3 @@1: jmp @@15 @@2: mov ax,LibraryUnits mov bx,uhLink lea si,UName call SearchUnitName jnz @@6 mov ax,FirstUnit mov es:uhNext,ax mov FirstUnit,es call UseUnit jnz @@4 jmp @@14 @@3: mov ax,68 jmp short @@5 @@4: mov ax,70 @@5: lea di,UName push ds pop es Chain ParamError @@6: mov ax,SavedDepth cmp ax,CurDepth je @@7 Invoke SaveState or CompilerFlags.B0,cfUseUnits+cfDisk+cfForceUnit mov ax,CurDepth xchg ax,SavedDepth mov SavedDepth2,ax @@7: call PutHeader lea si,UName lea di,SourceName Invoke DSPas2C xor ax,ax mov dx,ax test CompilerFlags.B0,cfBuild jz @@8 mov ax,fePas+fdUnitDir*256 lea dx,SourceName call ConvertName mov NameLen,ax lea dx,SourceName Invoke FileTime add ax,1 adc dx,0 @@8: mov SourceTime.W0,ax mov SourceTime.W2,dx or ax,dx jnz @@10 lea si,SourceName lea di,TpuName Invoke CopyDSCStr mov ax,feTpu+feForceExt+(fdOutputDir+fdNoEditor)*256 lea dx,TpuName call ConvertName lea dx,TpuName Invoke FileTime and ax,dx inc ax jnz @@9 lea si,SourceName lea di,TpuName Invoke CopyDSCStr mov ax,feTpu+feForceExt+fdUnitDir*256 lea dx,TpuName call ConvertName @@9: lea dx,TpuName call ReadUnit lea si,UName call MatchName call UseUnit mov al,0 jz @@13 jmp @@4 @@10: lea si,SourceName lea di,TpuName Invoke CopyDSCStr mov ax,feTpu+feForceExt+(fdOutputDir+fdNoEditor)*256 lea dx,TpuName call ConvertName test CompilerFlags.B0,cfMake jz @@12 lea dx,TpuName Invoke FileTime add ax,1 adc dx,0 mov UnitTime.W0,ax mov UnitTime.W2,dx sub ax,SourceTime.W0 sbb dx,SourceTime.W2 jc @@12 lea dx,TpuName call ReadUnit lea si,UName call MatchName mov ax,UnitTime.W0 mov dx,UnitTime.W2 call CheckSources jc @@11 call UseUnit mov al,0 jz @@13 @@11: call ZeroHeader @@12: lea ax,SourceName mov UnitName,ax mov ax,NameLen mov UnitNameLen,ax call CompileFile lea si,UName call MatchName mov al,-1 @@13: lea si,TpuName Invoke Add2TpuList @@14: mov es,FirstUnit xor ax,ax mov es:uhOverlayLength,ax @@15: Invoke UpdateCompInfo Exit LoadUnit endp ReadUnit proc near push dx Invoke OpenHandle mov bx,ax mov es,Dictionary.Segm xor ax,ax mov dx,es mov cx,size TUnitHeader push bx push es:uhNext Invoke ReadHandle pop es:uhNext pop bx dx cmp ax,size TUnitHeader jne @@1 cmp es:uhSignature.W0,'PT' jne @@1 cmp es:uhSignature.W2,'9U' jne @@1 mov ax,es:uhEndTrace sub ax,size TUnitHeader mov cx,ax push bx inc ExactAlloc Invoke GetDictMem dec ExactAlloc pop bx mov ax,di mov dx,es push bx Invoke ReadHandle pop bx Chain CloseHandle @@1: mov ax,72 Chain ParamError2 ReadUnit endp SearchUnitName proc near @@1: or ax,ax jz @@2 mov es,ax mov di,es:uhName add di,seName mov cl,[si] xor ch,ch inc cx mov dx,si repe cmpsb mov si,dx je @@3 mov ax,es:[bx] jmp @@1 @@2: dec ax @@3: ret SearchUnitName endp MatchName proc near mov es,FirstUnit mov di,es:uhName add di,seName mov cl,[si] xor ch,ch inc cx push si repe cmpsb pop si jne @@1 ret @@1: mov ax,69 mov di,si push ds pop es Chain ParamError MatchName endp CheckSources proc near Loc Time,dword,1 Loc UName,byte,80 Entry mov Time.W0,ax mov Time.W2,dx mov es,FirstUnit mov di,es:uhSources @@1: mov bl,es:[di].slName.B0 mov bh,0 lea di,[di+size TSourceList+bx] cmp di,es:uhTrace je @@3 push es di add di,slName lea si,UName Invoke Pas2C pop di es mov ah,es:[di] mov al,0 lea dx,UName call ConvertName lea dx,UName Invoke FileTime add ax,1 adc dx,0 cmp dx,Time.W2 jb @@1 ja @@2 cmp ax,Time.W0 jbe @@1 @@2: stc @@3: Exit CheckSources endp CreateFile proc near mov si,UnitName lea di,FileNameBuf push ax Invoke CopyDSCStr pop ax lea dx,FileNameBuf call ConvertName lea dx,FileNameBuf Invoke CreateHandle mov FileHandle,ax ret CreateFile endp CloseFile proc near xor bx,bx xchg bx,FileHandle Chain CloseHandle CloseFile endp ReadObjectFile proc near mov al,0 mov ah,es:[di] push ax add di,7 lea si,FileNameBuf Invoke Pas2C pop ax lea dx,FileNameBuf call ConvertName lea dx,FileNameBuf Invoke OpenHandle mov bx,ax push bx call GetFileSize or dx,dx jnz @@1 cmp ax,0fff0h ja @@1 mov ObjectFileSize,ax Invoke GetMemOnTop mov ObjectFileSeg,bx xor ax,ax mov dx,bx mov cx,ObjectFileSize pop bx push bx Invoke ReadHandle pop bx Chain CloseHandle @@1: mov ax,45 lea dx,FileNameBuf Chain ParamError2 ReadObjectFile endp CloseObjectFile proc near mov ax,ObjectFileSize mov bx,ObjectFileSeg Chain FreeMemOnTop CloseObjectFile endp BigWrite proc near push cx di es mov es,dx mov di,cx neg cx and cx,0fh xor ax,ax rep stosb pop es di cx add cx,0fh and cx,0fff0h Chain WriteHandle BigWrite endp GetFileSize proc near xor ax,ax xor dx,dx mov cx,2 push bx Invoke SeekHandle pop bx push dx ax xor ax,ax xor dx,dx xor cx,cx Invoke SeekHandle pop ax dx ret GetFileSize endp ConvertName proc near Loc UName,word,1 Loc Temp,byte,224 Entry push si di es mov UName,dx mov dx,ax push ds pop es or dl,dl jz @@8 mov si,UName @@1: xor bx,bx @@2: lodsb or al,al jz @@3 cmp al,'\' je @@1 cmp al,'.' jne @@2 mov bx,si jmp @@2 @@3: or bx,bx jz @@4 test dl,feForceExt jz @@8 mov si,bx @@4: mov di,si dec di mov al,'.' stosb lea si,Extensions and dl,0fh @@5: dec dl jz @@7 @@6: lodsb or al,al jnz @@6 jmp @@5 @@7: lodsb stosb or al,al jnz @@7 @@8: mov bl,dh and bl,0fh jnz @@10 @@9: xor dx,dx jmp @@26 @@10: mov bh,0 shl bx,1 mov si,Directories[bx-2] cmp byte ptr [si],0 je @@9 test dh,fdNoEditor jnz @@17 mov dx,UName Invoke FileTime and ax,dx inc ax jnz @@9 @@11: cmp byte ptr [si],0 je @@9 lea di,Temp xor dx,dx xor ah,ah @@12: mov ah,al lodsb or al,al jz @@13 cmp al,';' je @@14 stosb inc dx jmp @@12 @@13: dec si @@14: cmp ah,':' je @@15 cmp ah,'\' je @@15 mov al,'\' stosb inc dx @@15: push si mov si,UName @@16: lodsb stosb or al,al jnz @@16 pop si push dx lea dx,Temp Invoke FileTime and ax,dx inc ax pop dx jz @@11 jmp short @@23 @@17: lea di,Temp xor dx,dx xor ah,ah @@18: mov ah,al lodsb or al,al jz @@19 stosb inc dx jmp @@18 @@19: cmp ah,':' je @@20 cmp ah,'\' je @@20 mov al,'\' stosb inc dx @@20: mov bx,di mov si,UName @@21: lodsb stosb or al,al jz @@23 cmp al,':' je @@22 cmp al,'\' jne @@21 @@22: mov di,bx jmp @@21 @@23: lea si,Temp mov di,UName mov cx,79 @@24: lodsb or al,al jz @@25 stosb loop @@24 @@25: xor al,al stosb @@26: mov ax,dx pop es di si Exit ConvertName endp FileCreate proc far Entry far call CreateFile Exit FileCreate endp FileClose proc far Entry far call CloseFile Exit FileClose endp FileWrite proc far Entry far Invoke WriteHandle Exit FileWrite endp WriteBig proc far Entry far call BigWrite Exit WriteBig endp GetFlatMem proc far Entry far Invoke GetMemOnBottom Exit GetFlatMem endp GetProcStackSize proc far Entry far Invoke StackRequired Exit GetProcStackSize endp FlatMemAvail proc far Entry far Invoke GetMemAvail Exit FlatMemAvail endp end