www.pudn.com > tp60src.zip > LINK.ASM
model large compiler_text,pascal include compiler.inc extrn DebugInfo:far extrn LinkMap:far uhRefCount equ (word ptr uhReserved) uhCodeRelocs equ (word ptr uhReserved+2) uhConstRelocs equ (word ptr uhReserved+4) .data OverlayHeader db 'FBOV' OverlaySize dd 0 .data? CurSegment dw ? ExeFileSize dd ? CodeBuffer dw ? RelocPtr dw ? Relocations dw ? RelocCount dw ? ConstSize dw ? OverlayLink dw ? MaxOverlaySize dw ? CurrentUnit dw ? CurrentFixup dw ? CurrentTarget dd ? CurrentSource dw ? .code compiler_text public LinkProgram LinkProgram proc near test CompilerFlags.B0,cfDisk jz @@1 jmp @@4 @@1: call ResolveUnits call ReadUnits call MemCalcSizes mov ax,CompMemPtr mov DataStart,ax call MemFormData call CalcDataSeg mov ax,FirstUnit @@2: mov es,ax call ResolveCode call ResolveConst mov ax,es:uhNext or ax,ax jnz @@2 mov ax,FirstUnit mov bx,DebuggerPSP add bx,10h @@3: mov es,ax sub es:uhCodeStart,bx mov ax,es:uhNext or ax,ax jnz @@3 sub DataStart,bx sub StackStart,bx ret MemCalcSizes proc near xor ax,ax mov CodeSize.W0,ax mov CodeSize.W2,ax mov ax,FirstUnit @@1: mov es,ax mov di,es:uhCodeMap mov dx,es:uhConstMap xor ax,ax mov es:uhOverlayLength,ax jmp short @@3 @@2: mov es:[di].smAddr,ax add ax,es:[di].smLength add di,size TSegMap @@3: cmp di,dx jne @@2 mov ax,es:uhCodeSeg mov es:uhCodeStart,ax mov ax,es:uhCodeSize mov es:uhCodeLength,ax add ax,15 and al,0f0h add CodeSize.W0,ax adc CodeSize.W2,0 mov ax,es:uhNext or ax,ax jnz @@1 ret MemCalcSizes endp MemFormData proc near mov bx,2 mov si,uhConstMap call MemFormMap mov si,uhDataMap call MemFormMap mov DataSize,bx cmp bx,0fff0h ja Err1 ret MemFormData endp MemFormMap proc near mov ax,FirstUnit @@1: mov es,ax mov di,es:[si] mov dx,es:[si+2] jmp short @@3 @@2: mov es:[di].smAddr,bx add bx,es:[di].smLength jc Err1 add di,size TSegMap @@3: cmp di,dx jnz @@2 mov ax,es:uhNext or ax,ax jnz @@1 ret MemFormMap endp Err1: mov ax,49 Chain CompileError @@4: call ResolveUnits test CompilerFlags.B1,cfDiskBuffer jnz @@5 call ReadUnits @@5: call InitSmartLinker xor ax,ax mov es,FirstUnit mov es:uhOverlayLength,ax mov es,SystemUnit mov es:uhOverlayLength,ax @@6: mov ax,FirstUnit xor cx,cx @@7: mov es,ax cmp es:uhRefCount,0 je @@8 push cx Invoke MarkMem push bx mov di,1 Invoke ReadUnit call SmartLink pop bx Invoke ReleaseMem pop cx inc cx @@8: mov ax,es:uhNext or ax,ax jnz @@7 or cx,cx jnz @@6 xor ax,ax mov CurSegment,ax mov MaxOverlaySize,ax mov RelocCount,1ch call CountSizes mov ax,CurSegment mov DataStart,ax call FormData call CalcDataSeg call CreateExe cmp MaxOverlaySize,0 je @@9 mov ax,feOvr+feForceExt+(fdOutputDir+fdNoEditor)*256 Invoke CreateFile mov ax,8 xor dx,dx xor cx,cx mov bx,FileHandle Invoke SeekHandle @@9: xor ax,ax mov OverlayLink,ax mov OverlaySize.W0,8 mov OverlaySize.W2,ax mov RelocPtr,1ch mov ax,FirstUnit @@10: mov es,ax Invoke MarkMem push bx xor di,di Invoke ReadUnit mov ax,es:uhCodeLength cmp ax,es:uhOverlayLength jae @@11 mov ax,es:uhOverlayLength @@11: Invoke GetMemOnBottom mov CodeBuffer,bx call ResolveCode call SqueezeCode cmp es:uhOverlayLength,0 jne @@12 call CodeRelocs jmp short @@13 @@12: call SaveOvrCode call OvrCodeReloc call SaveOvrRelocs call FormOvrSeg @@13: call SaveCode call ResolveConst call SqueezeConst call ConstRelocs pop bx Invoke ReleaseMem mov ax,es:uhNext or ax,ax jnz @@10 call FormExe cmp MaxOverlaySize,0 je @@14 xor ax,ax xor dx,dx xor cx,cx mov bx,FileHandle Invoke SeekHandle sub OverlaySize.W0,8 sbb OverlaySize.W2,0 lea ax,OverlayHeader mov dx,ds mov cx,8 mov bx,FileHandle Invoke WriteHandle Invoke CloseFile @@14: Invoke DiscardUnits test CompilerFlags.B1,cfExtDebugger jz @@15 mov ax,ExeFileSize.W0 mov dx,ExeFileSize.W2 xor cx,cx mov bx,ExeHandle Invoke SeekHandle Invoke MarkMem push bx call DebugInfo pop bx Invoke ReleaseMem @@15: xor bx,bx xchg bx,ExeHandle Invoke CloseHandle test CompilerFlags.B1,cfLinkMap jz @@16 Invoke MarkMem push bx call LinkMap pop bx Invoke ReleaseMem @@16: ret LinkProgram endp ResolveUnits proc near mov ax,FirstUnit @@1: mov es,ax mov bx,es:uhUnits jmp short @@5 @@2: push ds mov ax,FirstUnit @@3: mov ds,ax mov si,ds:uhName add si,seName lea di,[bx].ulName mov cl,[si] mov ch,0 inc cx repe cmpsb je @@4 mov ax,ds:uhNext or ax,ax jnz @@3 pop ds mov ax,136 Chain CompileError @@4: pop ds mov es:[bx].ulSegment,ax mov bx,di @@5: cmp bx,es:uhSources jne @@2 mov ax,es:uhNext or ax,ax jnz @@1 ret ResolveUnits endp ReadUnits proc near mov ax,FirstUnit @@1: mov es,ax xor di,di Invoke ReadUnit mov es:uhTpuName,0 mov ax,es:uhNext or ax,ax jnz @@1 ret ReadUnits endp InitSmartLinker proc near mov ax,FirstUnit @@1: mov es,ax xor ax,ax mov es:uhRefCount,ax mov es:uhCodeRelocs,ax mov es:uhConstRelocs,ax mov di,es:uhProcMap mov dx,es:uhCodeMap jmp short @@3 @@2: stosw add di,size TProcMap-2 @@3: cmp di,dx jne @@2 dec ax mov di,es:uhCodeMap mov dx,es:uhEndMaps jmp short @@5 @@4: stosw add di,size TSegMap-2 @@5: cmp di,dx jne @@4 mov ax,es:uhNext or ax,ax jnz @@1 mov es,Dictionary.segm mov di,es:uhProcMap mov di,es:[di].pmCodeMap add di,es:uhCodeMap inc es:[di].smAddr inc es:uhRefCount ret InitSmartLinker endp SmartLink proc near mov CurrentUnit,es @@1: mov ax,es:uhCodeFixupSeg mov di,es:uhCodeMap mov dx,es:uhConstMap call ProcessSegment add es:uhCodeRelocs,ax mov ax,es:uhConstFixupSeg mov di,es:uhConstMap mov dx,es:uhDataMap call ProcessSegment add es:uhConstRelocs,ax cmp es:uhRefCount,0 jne @@1 ret SmartLink endp ProcessSegment proc near mov CurrentFixup,ax xor ax,ax xor si,si jmp short @@3 @@1: cmp es:[di].smAddr,0 jne @@2 inc es:[di].smAddr dec es:uhRefCount push dx si di es call ProcessMap pop es di si dx @@2: add si,es:[di].smFixupLength add di,size TSegMap @@3: cmp di,dx jne @@1 ret ProcessSegment endp ProcessMap proc near mov dx,es:[di].smFixupLength add dx,si jmp short @@9 @@1: mov es,CurrentFixup mov cx,es:[si].fiUnit mov di,es:[si].fiMap mov es,CurrentUnit mov bx,cx and bx,0fffh add bx,es:uhUnits mov es,es:[bx].ulSegment test cx,ffSegm jz @@2 inc ax @@2: test cx,ffData jz @@4 test cx,ffOffs jz @@8 test cx,ffCode jnz @@3 add di,es:uhDataMap mov es:[di].smAddr,1 jmp short @@8 @@3: add di,es:uhConstMap jmp short @@7 @@4: test cx,ffCode jnz @@6 add di,es:uhProcMap test cx,ffOffs+ffSegm jz @@5 mov es:[di].smAddr,1 @@5: mov di,es:[di].smFixupLength @@6: add di,es:uhCodeMap @@7: cmp es:[di].smAddr,-1 jne @@8 inc es:[di].smAddr inc es:uhRefCount @@8: add si,size TSegMap @@9: cmp si,dx jne @@1 ret ProcessMap endp CountSizes proc near mov ax,FirstUnit @@1: mov es,ax mov ax,CurSegment mov es:uhCodeStart,ax xor ax,ax mov di,es:uhCodeMap mov dx,es:uhConstMap jmp short @@4 @@2: cmp es:[di].smAddr,-1 je @@3 mov es:[di].smAddr,ax add ax,es:[di].smLength @@3: add di,size TSegMap @@4: cmp di,dx jne @@2 mov bx,es:uhCodeRelocs cmp es:uhOverlayLength,0 je @@9 mov es:uhOverlayLength,ax add ax,15 mov cl,4 shr ax,cl add bx,7 mov cl,3 shr bx,cl add ax,bx cmp ax,MaxOverlaySize jbe @@5 mov MaxOverlaySize,ax @@5: mov ax,ovRecSize mov di,es:uhProcMap mov dx,es:uhCodeMap jmp short @@8 @@6: cmp es:[di].pmStub,0 je @@7 mov es:[di].pmStub,ax add ax,5 @@7: add di,size TProcMap @@8: cmp di,dx jne @@6 xor bx,bx @@9: mov es:uhCodeLength,ax add ax,15 mov cl,4 shr ax,cl add CurSegment,ax add bx,es:uhConstRelocs shl bx,1 shl bx,1 add RelocCount,bx jc @@11 cmp RelocCount,0fff0h ja @@11 mov ax,es:uhNext or ax,ax jz @@10 jmp @@1 @@10: mov ax,CurSegment mov cl,4 rol ax,cl mov dx,ax and al,0f0h and dx,0fh mov CodeSize.W0,ax mov CodeSize.W2,dx ret @@11: mov ax,107 Chain CompileError CountSizes endp FormData proc near mov bx,2 mov si,uhConstMap call FormMap mov ConstSize,bx mov si,uhDataMap call FormMap mov DataSize,bx cmp bx,0fff0h ja Err2 ret FormData endp FormMap proc near mov ax,FirstUnit @@1: mov es,ax mov di,es:[si] mov dx,es:[si+2] jmp short @@4 @@2: cmp es:[di].smAddr,-1 je @@3 mov es:[di].smAddr,bx add bx,es:[di].smLength jc Err2 @@3: add di,size TSegMap @@4: cmp di,dx jne @@2 mov ax,es:uhNext or ax,ax jnz @@1 ret FormMap endp Err2: mov ax,49 Chain CompileError CalcDataSeg proc near mov es,SystemUnit mov di,es:uhConstMap mov ax,es:[di].smAddr mov DataSegment.Offs,ax mov ax,DataSize add ax,15 mov cl,4 shr ax,cl add ax,DataStart mov StackStart,ax ret CalcDataSeg endp CreateExe proc near mov ax,RelocCount Invoke GetMemOnBottom mov Relocations,bx mov ax,ConstSize Invoke GetMemOnBottom mov DataSegment.Segm,bx mov si,UnitName lea di,ExeName Invoke CopyDSCStr mov ax,feExe+feForceExt+(fdOutputDir+fdNoEditor)*256 lea dx,ExeName Invoke ConvertName lea dx,ExeName Invoke CreateHandle mov ExeHandle,ax mov ax,RelocCount add ax,15 and ax,0fff0h xor dx,dx xor cx,cx mov bx,ExeHandle Chain SeekHandle CreateExe endp ResolveCode proc near mov ax,es:uhCodeFixupSeg mov bx,es:uhCodeSeg mov di,es:uhCodeMap mov dx,es:uhConstMap jmp short @@1 ResolveConst label near mov ax,es:uhConstFixupSeg mov bx,es:uhConstSeg mov di,es:uhConstMap mov dx,es:uhDataMap @@1: mov CurrentUnit,es mov CurrentFixup,ax mov CurrentTarget.Segm,bx xor bx,bx xor si,si jmp short @@4 @@2: mov ax,es:[di].smAddr cmp ax,-1 je @@3 mov CurrentSource,ax mov CurrentTarget.Offs,bx push bx dx si di es call ResolveFixup pop es di si dx bx @@3: add bx,es:[di].smLength add si,es:[di].smFixupLength add di,size TSegMap @@4: cmp di,dx jne @@2 ret ResolveCode endp ResolveFixup proc near push bp mov bp,es:[di].smFixupLength add bp,si jmp @@10 @@1: mov es,CurrentFixup seges lodsw xchg ax,cx seges lodsw xchg ax,bx seges lodsw xchg ax,dx seges lodsw xchg ax,dx mov es,CurrentUnit mov di,cx and di,0fffh add di,es:uhUnits mov es,es:[di].ulSegment test cx,ffData jz @@3 test cx,ffCode jnz @@2 add bx,es:uhDataMap add ax,es:[bx].smAddr mov bx,DataStart jmp short @@7 @@2: add bx,es:uhConstMap add ax,es:[bx].smAddr mov bx,DataStart jmp short @@7 @@3: test cx,ffCode jnz @@5 add bx,es:uhProcMap test cx,ffPtr jz @@4 cmp es:uhOverlayLength,0 je @@4 mov ax,es:[bx].pmStub jmp short @@6 @@4: add ax,es:[bx].pmEntryPoint mov bx,es:[bx].pmCodeMap @@5: add bx,es:uhCodeMap add ax,es:[bx].smAddr @@6: mov bx,es:uhCodeStart @@7: les di,CurrentTarget add di,dx test cx,ffOffs jnz @@8 test cx,ffSegm jnz @@9 add dx,CurrentSource sub ax,dx dec ax dec ax @@8: stosw test cx,ffSegm jz @@10 @@9: xchg ax,bx stosw @@10: cmp si,bp je @@11 jmp @@1 @@11: pop bp ret ResolveFixup endp SqueezeCode proc near mov ax,es:uhCodeSeg mov bx,CodeBuffer mov di,es:uhCodeMap mov dx,es:uhConstMap jmp short @@1 SqueezeConst label near mov ax,es:uhConstSeg mov bx,DataSegment.Segm mov di,es:uhConstMap mov dx,es:uhDataMap @@1: xor si,si jmp short @@4 @@2: cmp es:[di].smAddr,-1 je @@3 push si di ds es mov cx,es:[di].smLength mov di,es:[di].smAddr mov ds,ax mov es,bx Invoke MoveBlock pop es ds di si @@3: add si,es:[di].smLength add di,size TSegMap @@4: cmp di,dx jne @@2 ret SqueezeCode endp SaveCode proc near mov dx,CodeBuffer mov cx,es:uhCodeLength mov bx,ExeHandle Chain BigWrite SaveCode endp CodeRelocs proc near mov ax,es:uhCodeFixupSeg mov bx,es:uhCodeStart mov di,es:uhCodeMap mov dx,es:uhConstMap jmp short @@1 ConstRelocs label near mov ax,es:uhConstFixupSeg mov bx,DataStart mov di,es:uhConstMap mov dx,es:uhDataMap @@1: mov CurrentFixup,ax xor si,si jmp short @@4 @@2: cmp es:[di].smAddr,-1 jz @@3 push dx si di es call Fixup2Reloc pop es di si dx @@3: add si,es:[di].smFixupLength add di,size TSegMap @@4: cmp di,dx jne @@2 ret CodeRelocs endp Fixup2Reloc proc near mov cx,es:[di].smAddr mov dx,es:[di].smFixupLength add dx,si mov di,RelocPtr jmp short @@4 @@1: mov es,CurrentFixup test es:[si].fiUnit,ffSegm jz @@3 mov ax,es:[si].fiOffset add ax,cx test es:[si].fiUnit,ffOffs jz @@2 inc ax inc ax @@2: mov es,Relocations stosw mov ax,bx stosw @@3: add si,size TFixup @@4: cmp si,dx jne @@1 mov RelocPtr,di ret Fixup2Reloc endp OvrCodeReloc proc near mov ax,es:uhCodeFixupSeg mov CurrentFixup,ax xor bx,bx xor si,si mov di,es:uhCodeMap mov dx,es:uhConstMap jmp short @@3 @@1: cmp es:[di].smAddr,-1 je @@2 push dx si di es call Fixup2OvrReloc pop es di si dx @@2: add si,es:[di].smFixupLength add di,size TSegMap @@3: cmp di,dx jne @@1 ret OvrCodeReloc endp Fixup2OvrReloc proc near mov cx,es:[di].smAddr mov dx,es:[di].smFixupLength add dx,si mov di,bx jmp short @@4 @@1: mov es,CurrentFixup test es:[si].fiUnit,ffSegm jz @@3 mov ax,es:[si].fiOffset add ax,cx test es:[si].fiUnit,ffOffs jz @@2 inc ax inc ax @@2: mov es,CodeBuffer stosw @@3: add si,size TFixup @@4: cmp si,dx jne @@1 mov bx,di ret Fixup2OvrReloc endp FormOvrSeg proc near push ds OverlayLink OverlaySize es mov es,CodeBuffer pop ds xor di,di mov ax,3fcdh stosw xor ax,ax stosw pop ax stosw pop ax stosw mov ax,ds:uhOverlayLength stosw mov ax,ds:uhCodeRelocs shl ax,1 stosw mov ax,ds:uhCodeLength sub ax,ovRecSize cwd mov cx,5 div cx stosw pop ax stosw mov cx,8 xor ax,ax rep stosw mov si,ds:uhProcMap @@1: cmp ds:[si].pmStub,0 je @@2 mov ax,3fcdh stosw mov ax,[si].pmEntryPoint mov bx,[si].pmCodeMap add bx,ds:uhCodeMap add ax,[bx].smAddr stosw xor al,al stosb @@2: add si,size TProcMap cmp si,ds:uhCodeMap jne @@1 push ds pop es ds mov ax,es:uhOverlayLength add OverlaySize.W0,ax adc OverlaySize.W2,0 mov ax,es:uhCodeRelocs shl ax,1 add OverlaySize.W0,ax adc OverlaySize.W2,0 mov ax,es:uhCodeStart mov OverlayLink,ax ret FormOvrSeg endp SaveOvrCode proc near xor ax,ax mov dx,CodeBuffer mov cx,es:uhOverlayLength mov bx,FileHandle Chain WriteHandle SaveOvrCode endp SaveOvrRelocs proc near xor ax,ax mov dx,CodeBuffer mov cx,es:uhCodeRelocs shl cx,1 mov bx,FileHandle Chain WriteHandle SaveOvrRelocs endp FormExe proc near les di,DataSegment xor bx,bx mov es:[bx],bx mov ax,OverlayLink mov es:[di]._OvrCodeList,ax mov ax,MaxOverlaySize mov es:[di]._OvrHeapSize,ax mov dx,es mov cx,ConstSize mov bx,ExeHandle Invoke BigWrite Invoke GetFileSize mov ExeFileSize.W0,ax mov ExeFileSize.W2,dx mov es,Relocations mov word ptr es:[0],'ZM' mov ax,RelocCount add ax,15 mov cl,4 shr ax,cl mov es:[8],ax add ax,DataStart mov bx,ConstSize add bx,15 mov cl,4 shr bx,cl add ax,bx mov bx,ax and ax,1fh mov cl,4 shl ax,cl mov es:[2],ax add bx,1fh mov cl,5 shr bx,cl mov es:[4],bx mov ax,RelocCount sub ax,1ch shr ax,1 shr ax,1 mov es:[6],ax mov ax,ConstSize add ax,15 mov cl,4 shr ax,cl add ax,DataStart mov bx,StackSize add bx,15 mov cl,4 shr bx,cl add bx,StackStart add bx,MaxOverlaySize sub bx,ax mov ax,MinHeapSize add ax,bx jnc @@1 mov ax,-1 @@1: mov es:[10],ax mov ax,MaxHeapSize add ax,bx jnc @@2 mov ax,-1 @@2: mov es:[12],ax mov ax,StackStart mov es:[14],ax mov ax,StackSize mov es:[16],ax mov word ptr es:[24],1ch mov word ptr es:[18],0 mov es,Dictionary.Segm mov di,es:uhProcMap mov ax,es:[di].pmEntryPoint mov di,es:[di].pmCodeMap add di,es:uhCodeMap add ax,es:[di].smAddr mov es,Relocations mov es:[20],ax mov word ptr es:[22],0 mov word ptr es:[26],0 mov dx,es mov cx,RelocCount mov bx,ExeHandle Chain BigWrite FormExe endp end