www.pudn.com > tp60src.zip > OBJECT.ASM
model large compiler_text,pascal include compiler.inc .data EmulNames db 'FIDRQQ' dw 5c32h db 'FIARQQ' dw 0fe32h db 'FICRQQ' dw 0e32h db 'FIERQQ' dw 1632h db 'FISRQQ' dw 632h db 'FIWRQQ' dw 0a23dh db 'FJARQQ' dw 4000h db 'FJCRQQ' dw 0c000h db 'FJSRQQ' dw 8000h KnownSegments db 4,'CODE',0 db 4,'CSEG',0 db 5,'_TEXT',0 db 5,'CONST',1 db 5,'_DATA',1 db 4,'DATA',2 db 4,'DSEG',2 db 4,'_BSS',2 .data? BufPtr dw ? CurSegIndex db ? CodeSegIndex db ? ConstSegIndex db ? DataSegIndex db ? DataUnit dw ? DataOffset dw ? DataSource dw ? DataTarget dw ? LastData dw ? RecEnd dw ? Name0 dw ? Name1 dw ? Name2 dw ? .code compiler_text public LinkObjects LinkObjects proc near mov es,SourceList.Segm xor di,di @@1: cmp di,SourceList.Offs je @@3 cmp es:[di].slFileType,fdObjectDir jne @@2 push di Invoke ReadObjectFile call ProcessObjFile Invoke CloseObjectFile Invoke FlushCodeMap Invoke FlushConstMap Invoke FlushDataMap pop di mov es,SourceList.Segm @@2: mov bl,es:[di].slName.B0 mov bh,0 lea di,[di+size TSourceList+bx] jmp @@1 @@3: ret LinkObjects endp ObjectError proc near lea dx,FileNameBuf Chain ParamError2 ObjectError endp ProcessObjFile proc near xor ax,ax mov CurSegIndex,al mov CodeSegIndex,al mov ConstSegIndex,al mov DataSegIndex,al mov LastData,ax mov BufPtr,offset SourceBuffer mov ax,Dictionary.Segm Invoke PutUseUnit mov DataUnit,ax xor si,si mov es,ObjectFileSeg @@1: cmp si,ObjectFileSize jae @@2 seges lodsb test al,1 jnz @@2 sub al,80h jc @@2 cmp al,22h ja @@2 mov bl,al xor bh,bh seges lodsw add ax,si dec ax mov RecEnd,ax call word ptr cs:@@3[bx] mov si,RecEnd inc si jmp @@1 @@2: mov ax,47 jmp ObjectError @@3 dw SkipRecord ; THEADR dw SkipRecord ; LHEADR dw SkipRecord dw SkipRecord dw SkipRecord ; COMENT dw ModEnd ; MODEND dw ExtDef ; EXTDEF dw SkipRecord ; TYPDEF dw PubDef ; PUBDEF dw SkipRecord ; LOCSYM dw SkipRecord ; LINNUM dw SkipRecord ; LNAMES dw SegDef ; SEGDEF dw SkipRecord ; GRPDEF dw FixUpp ; FIXUPP dw SkipRecord dw LeData ; LEDATA dw LiData ; LIDATA ProcessObjFile endp ModEnd proc near pop ax SkipRecord label near ret ModEnd endp SegDef proc near @@1: inc CurSegIndex inc si seges lodsw push ax seges lodsb inc si inc si call WhichSegment pop dx jnz @@5 cmp al,1 mov al,CurSegIndex jb @@3 je @@2 cmp DataSegIndex,0 jne @@5 mov DataSegIndex,al add VarsSize,dx jnc @@5 mov ax,49 jmp ObjectError @@2: cmp ConstSegIndex,0 jne @@5 mov ConstSegIndex,al lea bx,CompiledConst jmp short @@4 @@3: cmp CodeSegIndex,0 jne @@5 mov CodeSegIndex,al lea bx,CompiledCode @@4: xchg ax,dx mov cx,ax Invoke GetMemory xor ax,ax rep stosb mov es,ObjectFileSeg @@5: cmp si,RecEnd jb @@1 ret SegDef endp WhichSegment proc near push si xor ah,ah mov cx,ax xor si,si @@1: seges lodsb xchg ax,dx seges lodsw xchg ax,dx add dx,si cmp al,96h ; LNAMES jne @@3 dec dx @@2: seges lodsb dec cx jz @@4 add si,ax cmp si,dx jne @@2 inc dx @@3: mov si,dx jmp @@1 @@4: mov bx,si mov dx,ax lea si,KnownSegments @@5: lodsb cmp al,1 jb @@9 mov cx,ax mov di,bx cmp cx,dx je @@6 ja @@7 cmp byte ptr [si],'_' jne @@7 add di,dx sub di,cx @@6: repe cmpsb je @@8 @@7: add si,cx inc si jmp @@5 @@8: lodsb @@9: pop si ret WhichSegment endp PubDef proc near seges lodsb or al,al jnz @@4 seges lodsb cmp al,CodeSegIndex jne @@4 @@1: call GetName seges lodsw push es si ax call ConvertName jz @@2 Invoke LocalSearch jnz @@5 cmp al,t_Type jne @@5 mov si,es:[di].tsType.Offs mov di,es:[di].tsType.Segm mov es,es:[di] cmp es:[si].tdType,ttObject jne @@5 call ConvertName Invoke SearchField jnz @@5 jmp short @@3 @@2: Invoke LocalSearch jz @@3 call AddPublic @@3: cmp al,t_Proc jne @@5 test es:[di].psFlags,pfExternal jz @@5 mov di,es:[di].psProcMap mov es,ProcMap.Segm mov ax,CodeMap.Offs xchg ax,es:[di].pmCodeMap inc ax jnz @@5 pop ax mov es:[di].pmEntryPoint,ax pop si es inc si cmp si,RecEnd jb @@1 ret @@4: mov ax,51 jmp ObjectError @@5: mov ax,51 mov di,Name0 mov es,ObjectFileSeg Chain ParamError PubDef endp AddPublic proc near mov ax,size TProcStub+size TProcType Invoke LocalAddIdent Invoke FlushProcMap mov al,t_Proc mov es:[bx].seType,al mov es:[di].psFlags,pfExternal mov es:[di].psType.tdType,ttProc mov es:[di].psType.tdModifier,emLongint mov es:[di].psType.tdSizeOf,4 ret AddPublic endp ExtDef proc near @@1: call GetName push es si call ConvertName jz @@3 Invoke SearchSymbol jnz @@2 cmp al,t_Type jne @@2 mov si,es:[di].tsType.Offs mov di,es:[di].tsType.Segm mov es,es:[di] cmp es:[si].tdType,ttObject jne @@2 call ConvertName Invoke SearchField jnz @@2 cmp al,t_Proc je @@8 @@2: mov ax,52 mov di,Name0 mov es,ObjectFileSeg Chain ParamError @@3: call EmulFixup jnc @@9 Invoke SearchSymbol jz @@4 call AddPublic @@4: cmp al,t_Proc je @@8 cmp al,t_Var jne @@2 @@5: test es:[di].vsFlags,vfAlias jz @@6 mov bx,es:[di].vsLink.Segm mov di,es:[di].vsLink.Offs mov es,es:[bx] jmp @@5 @@6: mov al,es:[di].vsFlags and al,vfType mov cx,ffData cmp al,vfVar je @@7 mov cx,ffConst cmp al,vfConst jne @@2 @@7: push es di mov ax,es Invoke PutUseUnit pop di es or ax,cx mov bx,es:[di].vsMap mov dx,es:[di].vsOffset jmp short @@9 @@8: test es:[di].psFlags,pfInline jnz @@2 push es di mov ax,es Invoke PutUseUnit pop di es mov bx,es:[di].psProcMap xor dx,dx @@9: mov di,BufPtr cmp di,offset SourceBuffer+256*6 je @@11 mov [di],ax mov [di+2],bx mov [di+4],dx add BufPtr,6 pop si es inc si cmp si,RecEnd jae @@10 jmp @@1 @@10: ret @@11: mov ax,53 jmp ObjectError ExtDef endp EmulFixup proc near cmp IdentBuf[0],6 jne @@2 lea si,EmulNames push ds pop es @@1: lea di,IdentBuf[1] mov bx,si mov cx,6 repe cmpsb je @@3 lea si,[bx+8] cmp si,offset KnownSegments jne @@1 @@2: stc ret @@3: lodsw mov dx,ax mov ax,-1 mov bx,ax ret EmulFixup endp LeData proc near call DataHeader jnz @@1 mov LastData,bx mov cx,RecEnd sub cx,si push ds es mov es,DataTarget pop ds rep movsb push ds pop es ds @@1: ret LeData endp DataHeader proc near xor ax,ax mov LastData,ax seges lodsb mov di,CodeSectStart mov dx,CompiledCode.Segm lea bx,CodeFixups cmp al,CodeSegIndex je @@1 mov di,ConstSectStart mov dx,CompiledConst.Segm lea bx,ConstFixups cmp al,ConstSegIndex jne @@2 @@1: seges lodsw mov DataOffset,ax mov DataSource,di mov DataTarget,dx add di,ax xor ax,ax @@2: ret DataHeader endp LiData proc near call DataHeader jnz @@2 @@1: call ProcessLiData cmp si,RecEnd jb @@1 @@2: ret LiData endp ProcessLiData proc near seges lodsw @@1: push ax si seges lodsw or ax,ax jz @@3 @@2: push ax call ProcessLiData pop ax dec ax jnz @@2 jmp short @@4 @@3: seges lodsb mov cl,al xor ch,ch push ds es mov es,DataTarget pop ds rep movsb push ds pop es ds @@4: mov dx,si pop si ax dec ax jnz @@1 mov si,dx ret ProcessLiData endp FixUpp proc near cmp LastData,0 je @@6 @@1: seges lodsb mov ah,al and al,0fch xor dx,dx cmp al,84h je @@2 mov dx,ffOffs cmp al,0c4h je @@2 mov dx,ffSegm cmp al,0c8h je @@2 mov dx,ffPtr cmp al,0cch jne @@6 @@2: seges lodsb and ax,3ffh add ax,DataOffset mov di,ax seges lodsb mov cl,al test cl,88h jnz @@6 test cl,40h jnz @@3 seges lodsb or al,al jns @@3 inc si @@3: seges lodsb xor ah,ah or al,al jns @@4 and al,7fh mov ah,al seges lodsb @@4: mov bx,ax xor ax,ax test cl,4 jnz @@5 seges lodsw @@5: push di ds add di,DataSource mov ds,DataTarget add ax,[di] pop ds di xchg ax,dx call ProcessFixup cmp si,RecEnd jb @@1 ret @@6: mov ax,56 jmp ObjectError FixUpp endp ProcessFixup proc near test cl,2 jnz @@4 test cl,1 jnz @@3 cmp bl,CodeSegIndex jne @@1 or ax,ffCode mov bx,CodeMap.Offs jmp short @@5 @@1: cmp bl,ConstSegIndex jne @@2 or ax,ffConst mov bx,ConstMap.Offs jmp short @@5 @@2: cmp bl,DataSegIndex jne @@7 @@3: or ax,ffData mov bx,DataMap.Offs jmp short @@5 @@4: shl bx,1 mov cx,bx shl bx,1 add bx,cx or ax,SourceBuffer[bx-6] add dx,SourceBuffer[bx-2] mov bx,SourceBuffer[bx-4] cmp ax,-1 jne @@6 push ds add di,DataSource mov ds,DataTarget mov [di],dx pop ds ret @@5: or ax,DataUnit @@6: push di bx ax mov ax,size TSegMap mov bx,LastData Invoke GetMemory pop ax stosw pop ax stosw mov ax,dx stosw pop ax stosw mov es,ObjectFileSeg ret @@7: mov ax,56 jmp ObjectError ProcessFixup endp GetName proc near mov Name0,si seges lodsb mov Name1,si xor ah,ah add si,ax mov Name2,si ret GetName endp ConvertName proc near push di es xor bx,bx xor cx,cx mov dx,Name2 mov di,Name1 mov es,ObjectFileSeg @@1: cmp di,dx je @@3 mov al,es:[di] inc di cmp al,'@' je @@3 cmp al,'a' jb @@2 cmp al,'z' ja @@2 sub al,'a'-'A' @@2: inc bx mov IdentBuf[bx],al dec al add cl,al jmp @@1 @@3: add cl,cl mov IdentBuf[0],bl mov SymbolHash,cl mov Name1,di cmp di,dx pop es di ret ConvertName endp end