;This program is written to allow Turbo Pascal
;to work with Z80 systems where the BIOS uses IX and IY without
;restoring them.  The patch is installed at Location 0040H - this space
;is reserved by Digital Research for Patching CBIOS.
;
;Written By John Newgas on March 7th 1986
;
;I Can be contacted by Modem at V21/V23 on TBBS London
; telephone (01)-348-9400 . This is a 24 Hour Bulletin Board
; where I am the SYSOP.
;
; This Program was writen particularly to allow Turbo Pascal V 3.0
;to operate on a Bondwell 2 Lap portable micro
;
;   This program was modified by Lew Merrick to fall into more
;   conventional format.  I also added the compilation
;   instructions shown below (which I hope will save you some
;   of the headaches I went through!).
;
;   Complile with M80 as shown:
;       M80 =TURBPT/L
;   Link with L80 as shown:
;       L80 TURBPT,TURBPT/N/E
;
;   The COM file is available elsewhere in this library.
;
;-----------------------------------------------------------------------
;
.Z80
ASEG                    ; Declare Absolute SEGment format
        ORG 100H        ; Conventional TPA start location
        DI              ; In case of accidents during program !
        LD HL,(0001H)   ; BIOS Warm Boot Vector Location
        LD DE,000AH     ; WBOOT to Conout difference
        ADD HL,DE       ; HL now has adress of vector to CONOUT
        LD A,(HL)       ; Low Byte of actual Conout
        LD (FCALL+1),A  ; Into call after reg save
        INC HL          ; Point to Low byte
        LD A,(HL)       ; Get High Byte
        LD (FCALL+2),A  ; Put it away also
        PUSH HL         ; Save HL which is hi byte of conout
        LD DE,0040H     ; Make patch location destination
        LD HL,ROUTN     ; Move from ROUTN
        LD BC,REND-ROUTN; Length of routine
        LDIR            ; Move it into position
        POP HL          ; Restore HL
        LD (HL),00H     ; Patch in High and
        DEC HL
        LD (HL),40H     ; Low byte of new routine in vector positon
        EI              ; Restore Interupts
        JP 0000H        ; Finish with a warm boot !
;
;
ROUTN:  PUSH IX         ; Save  both Index Registers
        PUSH IY
FCALL:  CALL ROUTN      ; Dummy call to be patched with the
                        ; actual CONOUT subroutine address
        POP IY          ; Returns here with RET at end of CONOUT
        POP IX          ; Index Registers restored
        RET             ; Back to original caller !
REND:
END