www.pudn.com > tp60src.zip > ASM.ASM
model large compiler_text,pascal include compiler.inc extrn Assemble:far .data db 44,62,159,155,7,8,76,158,157,12,31,156,155,1,5 ErrorCodes label byte .data? SaveDictionary dw ? .code compiler_text public AsmClause public GetAsmSymbol public GetAsmLabel public EmitByte public EmitFixup public EmitJump public EmitFloat AsmClause proc near cmp CurrentToken,tAsm je @@1 mov ax,162 Chain CompileError @@1: mov ax,Dictionary.Offs mov SaveDictionary,ax mov ax,4 Invoke CreateHashTable push Dictionary.Offs @@2: Invoke UpdateCompInfo Invoke GetRawToken mov TextPos,si lodsb cmp al,';' je @@6 and al,0dfh cmp al,'E' jne @@3 lodsw and ax,0dfdfh cmp ax,'DN' jne @@3 mov al,[si] cmp al,'0' jb @@9 cmp al,'9'+1 jb @@3 and al,0dfh cmp al,'A' jb @@9 cmp al,'Z'+1 jb @@3 cmp al,'_' jne @@9 @@3: Invoke GetLineNumber Invoke PutLineNumber push ds TextPos mov ax,sp push ss ax mov ax,128 push ax xor ax,ax test GlobalOptions,co286Code jz @@4 inc ax @@4: mov di,CurProc or di,di jz @@5 mov es,Dictionary.Segm test es:[di].psFlags,pfFar jz @@5 or ax,100h @@5: push ax call Assemble pop si di or ax,ax jnz @@7 @@6: mov di,FileStackPtr mov [di],si jmp @@2 @@7: jg @@8 xchg ax,bx mov al,ErrorCodes[bx] xor ah,ah @@8: mov TextPos,si Chain CompileError @@9: mov di,FileStackPtr mov [di].fsTextPos,si Invoke GetToken pop ax cmp ax,Dictionary.Offs jne @@10 mov ax,SaveDictionary mov Dictionary.Offs,ax @@10: Chain DoneGoal AsmClause endp GetAsmSymbol proc far _Name:dword,Symbol:dword cld les di,_Name Invoke CalcHash les di,Symbol les di,es:[di] call AsmIdent jnz @@2 mov CurrentHash,bx xor ah,ah shl ax,1 xchg ax,si xor ax,ax mov dx,ax mov cx,-1 mov bx,cx call cs:@@3[si-t_Label*2] jc @@1 push ax es di les di,Symbol pop ax stosw pop ax stosw xchg ax,cx stosw xchg ax,bx stosw pop ax stosw xchg ax,dx stosw xchg ax,si stosw cmp ax,-3 sbb ax,ax inc ax stosw xor ax,ax @@1: ret @@2: mov ax,3 jmp @@1 @@3 dw AsmLabel dw AsmConst dw AsmType dw AsmVar dw AsmProc dw AsmError dw AsmError dw AsmError dw AsmError dw AsmError dw AsmUnit dw AsmSeg dw AsmLoc GetAsmSymbol endp AsmLabel proc near Invoke GetHash mov cx,CurrentHash cmp cx,si jb @@1 mov bx,ffCode call AsmUseUnit mov si,-3 xor di,di mov es,di ret @@1: mov ax,80 stc ret AsmLabel endp AsmType proc near mov si,es:[di].tsType.Segm mov di,es:[di].tsType.Offs mov es,es:[si] _AsmType label near mov si,es:[di].tdSizeOf cmp es:[di].tdType,ttRecord je @@1 cmp es:[di].tdType,ttObject je @@1 xor di,di mov es,di @@1: ret AsmType endp AsmVar proc near @@1: mov al,es:[di].vsFlags test al,vfAlias jz @@2 mov si,es:[di].vsLink.Segm mov di,es:[di].vsLink.Offs mov es,es:[si] jmp @@1 @@2: test al,vfField jnz @@4 dec cx and al,vfType cmp al,vfAbsolute je @@5 dec cx cmp al,vfLocal je @@4 mov cx,es:[di].vsMap mov bx,ffData cmp al,vfVar je @@3 mov bx,ffConst @@3: call AsmUseUnit @@4: mov ax,es:[di].vsOffset cwd jmp short @@6 @@5: mov ax,es:[di].vsAddress.Offs mov dx,es:[di].vsAddress.Segm @@6: test es:[di].vsFlags,vfAddress jnz @@7 mov si,es:[di].vsType.Segm mov di,es:[di].vsType.Offs mov es,es:[si] jmp _AsmType @@7: mov si,4 xor di,di mov es,di ret AsmVar endp AsmUnit proc near xor si,si mov es,es:[di].usAddress xor di,di ret AsmUnit endp AsmSeg proc near xor cx,cx mov bx,es:[di] mov es,Dictionary.Segm call AsmUseUnit mov si,0fff0h xor di,di mov es,di ret AsmSeg endp AsmConst proc near push es di mov si,es:[di].csType.Segm mov di,es:[di].csType.Offs mov es,es:[si] mov al,es:[di].tdType pop di es cmp al,ttInteger jae @@1 cmp al,ttPointer jne AsmError @@1: mov ax,es:[di].csValue.W0 mov dx,es:[di].csValue.W2 xor si,si xor di,di mov es,di ret AsmConst endp AsmProc proc near test es:[di].psFlags,pfInline jnz AsmError mov cx,es:[di].psProcMap xor bx,bx call AsmUseUnit mov si,-1 test es:[di].psFlags,pfFar jz @@1 dec si @@1: xor di,di mov es,di ret AsmProc endp AsmError proc near mov ax,160 stc ret AsmError endp AsmLoc proc near mov al,es:[di] mov es,Dictionary.Segm mov di,CurProc or di,di jz AsmError cmp al,1 jb @@2 je @@3 mov bx,es:[di].psType.ptResult.Offs or bx,bx jz AsmError mov cl,es:[di].psFlags mov di,es:[di].psType.ptResult.Segm mov es,es:[di] mov ax,ParamsBottom mov si,4 cmp es:[bx].tdType,ttString je @@1 test cl,pfAssembler jnz AsmError mov ax,ProcResult mov si,es:[bx].tdSizeOf @@1: mov cx,-3 mov bx,-1 jmp short @@5 @@2: mov ax,LocalsSize and ax,0fffeh neg ax jmp short @@4 @@3: mov ax,ParamsSize @@4: xor si,si @@5: cwd xor di,di mov es,di ret AsmLoc endp AsmIdent proc near cmp IdentBuf[1],'@' je @@3 mov ax,es or ax,di jz @@2 or di,di jz @@1 mov si,di Invoke SearchField jnz @@2 ret @@1: mov di,es:uhInterface Invoke SearchHash jz @@4 @@2: Chain SearchSymbol @@3: lea di,@@5 push cs pop es Invoke SearchHash jz @@4 mov es,Dictionary.Segm mov di,SaveDictionary Invoke SearchHash jz @@4 mov ax,2 mov si,SaveDictionary Invoke AddIdent mov al,t_Label mov es:[bx].seType,al cmp al,al @@4: ret @@5 label word hash 1 hent @CODE,t_@Seg dw ffCode hent @DATA,t_@Seg dw ffData hent @LOCALS,t_@Loc db 0 hent @PARAMS,t_@Loc db 1 hent @RESULT,t_@Loc db 2 hend AsmIdent endp AsmUseUnit proc near push ax mov ax,es push es di bx Invoke PutUseUnit pop bx di es or bx,ax pop ax ret AsmUseUnit endp GetAsmLabel proc far cld mov bx,sp les di,ss:[bx+4] Invoke CalcHash xor di,di mov es,di call AsmIdent jnz @@2 cmp al,t_Label jne @@2 Invoke GetHash cmp di,si jb @@3 cmp es:[di].lsLink,0 jne @@4 push es di mov ax,3 Invoke GetStmtMem mov al,12 stosb pop bx es mov es:[bx],di xor ax,ax @@1: ret 4 @@2: mov ax,3 jmp @@1 @@3: mov ax,80 jmp @@1 @@4: mov ax,81 jmp @@1 GetAsmLabel endp EmitByte proc far cld mov ax,2 Invoke GetStmtMem mov bx,sp mov al,4 mov ah,ss:[bx+4] stosw xor ax,ax ret 2 EmitByte endp EmitFixup proc far cld mov ax,7 Invoke GetStmtMem mov bx,sp mov dx,ss:[bx+10] mov ch,ss:[bx+12] mov cl,4 shl ch,cl or dh,ch mov cx,ss:[bx+8] mov ax,dx and ax,ffCode or ffData or ffConst cmp ax,ffCode mov al,14 jne @@1 jcxz @@1 mov al,16 @@1: stosb xchg ax,dx stosw xchg ax,cx stosw mov ax,ss:[bx+4] stosw xor ax,ax ret 10 EmitFixup endp EmitJump proc far cld mov ax,8 Invoke GetStmtMem mov bx,sp mov ax,ss:[bx+6] and ax,ffCode or ffData or ffConst cmp ax,ffCode jne @@2 push di mov al,8 mov ah,ss:[bx+8] stosw mov ax,ss:[bx+4] stosw pop ax xchg ax,LabelChain stosw xor ax,ax @@1: ret 6 @@2: mov ax,160 jmp @@1 EmitJump endp EmitFloat proc far cld mov bx,sp mov al,ss:[bx+8] mov ah,ss:[bx+6] cmp byte ptr ss:[bx+4],0 jne @@2 cmp al,9bh je @@1 or ah,ah jz @@5 xchg al,ah jmp short @@3 @@1: Invoke PutFwait jmp short @@6 @@2: push ax Invoke PutEmulInt pop ax or ah,ah jz @@4 sub ah,26h mov cl,3 shl ah,cl xor ah,al mov al,3ch @@3: Invoke PutWord jmp short @@6 @@4: sub al,0a4h @@5: Invoke PutByte @@6: xor ax,ax ret 6 EmitFloat endp end