DSEG    SEGMENT BYTE PUBLIC

        ;Pascal variables
        EXTRN   InitSP:WORD
        EXTRN   ErrorAddr:DWORD
        EXTRN   PrefixSeg:WORD

DSEG    ENDS

CSEG    SEGMENT BYTE PUBLIC

        ASSUME  CS:CSEG, DS:DSEG

        ;Entry point from Pascal
        PUBLIC  Trace

;Table of encoded instruction lengths and types
InstrTable LABEL BYTE
;           0   1   2   3   4   5   6   7   8   9   A   B   C   D   E   F
        DB 09, 09, 09, 09, 02, 03, 01, 01, 09, 09, 09, 09, 02, 03, 01, 01   ;0
        DB 09, 09, 09, 09, 02, 03, 01, 01, 09, 09, 09, 09, 02, 03, 01, 01   ;1
        DB 09, 09, 09, 09, 02, 03, 01, 01, 09, 09, 09, 09, 02, 03, 01, 01   ;2
        DB 09, 09, 09, 09, 02, 03, 01, 01, 09, 09, 09, 09, 02, 03, 01, 01   ;3
        DB 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01   ;4
        DB 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 01   ;5
        DB 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32   ;6
        DB 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02, 02   ;7
        DB 10, 11, 10, 10, 09, 09, 09, 09, 09, 09, 09, 09, 09, 09, 09, 09   ;8
        DB 01, 01, 01, 01, 01, 01, 01, 01, 01, 01, 05, 01, 01, 01, 01, 01   ;9
        DB 03, 03, 03, 03, 01, 01, 01, 01, 02, 03, 01, 01, 01, 01, 01, 01   ;A
        DB 02, 02, 02, 02, 02, 02, 02, 02, 03, 03, 03, 03, 03, 03, 03, 03   ;B
        DB 32, 32, 03, 01, 09, 09, 10, 11, 32, 32, 03, 01, 01, 02, 01, 01   ;C
        DB 09, 09, 09, 09, 01, 01, 32, 01, 09, 09, 09, 09, 09, 09, 09, 09   ;D
        DB 02, 02, 02, 02, 02, 02, 02, 02, 03, 03, 05, 02, 01, 01, 01, 01   ;E
        DB 01, 32, 01, 01, 01, 01, 18, 19, 01, 01, 01, 01, 01, 01, 09, 09   ;F

;********************************************************************** Rm
; Add length of secondary fields to instruction length
; On entry:
;     AH = mod reg r/m byte to decode
;     BX = instruction length so far
; On exit
;     BX = total instruction length including address
;     AX destroyed
Rm      PROC    NEAR
        MOV     AL,AH                           ;AL = NextB
        AND     AL,0C0h                         ;AL = mod field
        OR      AL,AL                           ;Direct addressing mode?
        JNZ     Rm4                             ;No, check again
        AND     AH,7                            ;AH = r/m field
        CMP     AH,6                            ;No base register mode?
        JNE     Rm1                             ;No, just one byte of instruction
        JMP SHORT Rm3                           ;Else three bytes of instruction
Rm4:    CMP     AL,40h                          ;One byte displacement mode?
        JE      Rm2                             ;Yes, two bytes of instruction
        CMP     AL,80h                          ;Two byte displacement mode?
        JNE     Rm1                             ;No, just one byte of instruction
Rm3:    INC     BX
Rm2:    INC     BX
Rm1:    INC     BX
        RET
Rm      ENDP

;********************************************************************** Next
; on entry:
;     ES:DI points to current instruction
; on exit:
;     ES:DI points to next instruction
;     AX,BX destroyed
;     CF set if disassembly error
Next    PROC    NEAR
        MOV     AX,ES:[DI]                      ;Get next word of code
        MOV     BX,offset InstrTable            ;Point to instruction table
        DB      2Eh                             ;CS override
        XLAT                                    ;AL = instruction code delta
        MOV     BL,AL                           ;Save delta
        XOR     BH,BH                           ;BH = 0
        AND     BL,7                            ;BX = instruction length
        AND     AL,0F8h                         ;Separate instruction type
        OR      AL,AL                           ;Itype = 0?
        JZ      SetNext                         ;Yes, we're done
        CMP     AL,08                           ;Itype = 8?
        JNZ     Check10                         ;No, check further
GetRm:  CALL    Rm                              ;Get addressing length
        JMP SHORT SetNext
Check10:
        CMP     AL,10h                          ;Itype = 10h?
        JNE     NextError                       ;No, junk in code stream
        MOV     AL,AH                           ;AL = Next byte
        AND     AL,38h                          ;NextB and 38h
        OR      AL,AL                           ;Is it zero?
        JZ      GetRm                           ;Yes, add Rm and we're done
        MOV     BX,1                            ;No, base length is one
        JMP SHORT GetRm                         ;Add Rm and we're done
NextError:
        STC                                     ;Set carry flag to indicate error
SetNext:
        ADD     DI,BX                           ;Point DI to next
        RET
Next    ENDP

;********************************************************************** FarProc
; on entry:
;     ES:DI points to current instruction
; on exit:
;     ZF set if current procedure is NEAR
;     CF set if disassembly error
;     AX,BX destroyed
FarProc PROC    NEAR
        PUSH    DI                              ;Save current IP value
        CLC                                     ;Clear error flag
FPNext: MOV     AL,ES:[DI]                      ;Get next instruction
        CMP     AL,0C2h                         ;See if any RET instruction
        JZ      FPDone
        CMP     AL,0C3h
        JZ      FPDone
        CMP     AL,0CAh
        JZ      FPDone
        CMP     AL,0CBh
        JZ      FPDone
        CALL    Next                            ;Advance to next instruction
        JNC     FPNext                          ;Loop if no disassembly error
FPDone:
        TEST    AL,08h                          ;Is FAR bit set?
        POP     DI                              ;Restore current instruction
        RET
FarProc ENDP

;***************************************************************** WriteAxHex
;Write AX in hex format to stdout
;Also called at WriteAlAscii
;  AX,CX,DX destroyed
WriteAxHex PROC NEAR
        PUSH   AX                               ;Save AX a moment
        MOV    AL,AH                            ;Do top byte first
        CALL   DoNibble
        POP    AX                               ;Now do bottom byte
DoNibble:
        PUSH   AX                               ;Save AL
        MOV    CL,04                            ;Get top nibble
        SHR    AL,CL
        CALL   ConvHex                          ;Convert to hex format
        POP    AX
        AND    AL,0Fh                           ;Get bottom nibble
ConvHex:
        ADD    AL,'0'                           ;Convert to ASCII numeral
        CMP    AL,'9'                           ;Is it decimal?
        JBE    WriteAlAscii                     ;Yes, write it now
        ADD    AL,07                            ;Convert to 'A'..'F'
WriteAlAscii:
        MOV    DL,AL                            ;Write character in AL
        MOV    AH,06                            ;DOS writechar
        INT    21h
        RET
WriteAxHex ENDP

;********************************************************************** Trace
; Trace stack of return points
; Writes results to stdout, which should be reset first
Trace   PROC    NEAR
        MOV     CX,PrefixSeg
        ADD     CX,10h                          ;CX = base code segment
        LES     DI,ErrorAddr                    ;ES:DI => relative error address
        MOV     AX,ES
        ADD     AX,CX                           ;Convert to absolute address
        MOV     ES,AX                           ;ES:DI => absolute error address
        MOV     SI,[BP]                         ;SI = saved BP
TraceNext:
        PUSH    CX                              ;Save CX
        MOV     AX,ES                           ;Get current code segment
        SUB     AX,CX                           ;Convert to relative code seg
        CALL    WriteAxHex                      ;Write code seg in hex
        MOV     AL,':'
        CALL    WriteAlAscii                    ;Write ':'
        MOV     AX,DI
        CALL    WriteAxHex                      ;Write instr pointer in hex
        MOV     AL,13
        CALL    WriteAlAscii                    ;Write <CR>
        MOV     AL,10
        CALL    WriteAlAscii                    ;Write <LF>
        POP     CX                              ;Restore CX

        CMP     SI,InitSP                       ;Stack trace done?
        JAE     TraceDone                       ;Yes, exit
        CALL    FarProc                         ;Is current ES:DI a far proc?
        JC      TraceDone                       ;Get out if disassembly error
        JZ      SetNewIp                        ;Jump if near proc
        MOV     ES,SS:[SI+4]                    ;ES = new code segment
SetNewIp:
        MOV     DI,SS:[SI+2]                    ;DI = new instr pointer
        MOV     SI,SS:[SI]                      ;SI = new BP
        JMP SHORT TraceNext                     ;Do it again
TraceDone:
        RET
Trace   ENDP

CSEG    ENDS

        END
