title TURBO Pascal Immediate Control Generator name ('TPCTL') maclib base80 ; Build .CTL file for DASM of TURBO Pascal COM file ; It selects version of TURBO automatically ; There are two RTL calls where immediate code follows. ; The format is: ; CALL RTL_function ; DB len ; DB b1,b2,...,blen ; Copyright (C) Werner Cirsovius ; Hohe Weide 44 ; D-20253 Hamburg ; Tel.: +49-40-4223247 ; Version 2.0 August 1989 ; Call it: TPCTL file [C] ; Option C allows log to console entry $memry ext wcard,hexout,string,open,fseek,delete,creatd ext dskget,puteof,dskput,emplin,rdbfp,wrbuf,wrfcb ext @crlf,closef,filsiz,adda,conout _JP equ 0c3h _LD.BC equ 001h _LD.DE equ 011h _LD.HL equ 021h _LD.SP equ 031h _LD.A.1 equ 03eh+001h*256 ; LD A,1 for TP v3x _CALL equ 0cdh _LDA equ 03ah ; LD A,(adr) _STA equ 032h ; LD (adr),A _LHLD equ 02ah ; LD HL,(adr) _SHLD equ 022h ; LD (adr),HL _CCF equ 03fh ; First one byte code - CCF _POP.BC equ 0c1h ; Last one byte code - POP BC _BIT equ 0cbh ; Bit prefix _DD equ 0ddh ; Special prefixes _ED equ 0edh _FD equ 0fdh _LD.IXo equ 036h ; LD (I?+offs),d8 _LD.IXi equ 021h ; LD I?,d16 _LD.a.I equ 022h ; LD (adr),I? _LD.I.a equ 02ah ; LD I?,(adr) v1r1 equ 0360h ; Initialisierung 1 v2r1 equ 038dh v1r2 equ 0485h v2r2 equ 04b2h v3r1 equ 0364h ; Initialisierung 2 v3ar1 equ 0365h v3r2 equ 04d4h v3ar2 equ 04d5h v1lib equ 1d76h ; End of RTL v2lib equ 1fc9h v3lib equ 20e2h v3Alib equ 20e3h v1ias equ 04e0h ; Immediate string assignment v2ias equ 051dh v3ias equ 054dh v3Aias equ 054eh v1ist equ 1940h ; Immediate write of string v2ist equ 1981h v3ist equ 17bah v3Aist equ 17bbh v1hdl equ 27 ; Header length v2hdl equ v1hdl v3hdl equ 26 v3ahdl equ v3hdl dseg ; $PRO: db '0103,S' db cr,lf $PRO.1: db 'xxxx,I' db cr,lf,eot $EPI: db 'xxxx,E' db cr,lf,eot $CAL.1: db 'xxxx,H' ; <- PC db cr,lf $CAL.2: db 'xxxx,B' ; <- PC+1 db cr,lf $CAL.3: db 'xxxx,I' ; <- PC+n db cr,lf,eot $CAL0.1: db 'xxxx,H' ; <- PC db cr,lf $CAL0.2: db 'xxxx,I' ; <- PC+1 db cr,lf,eot $HEAD: db cr,lf,lf,'Scanning program ' $HEAD.1: db 'xxxx - ' $HEAD.2: db 'xxxx' db cr,lf,lf,eot ; ; One byte instructions ; OneByteCodes: db 000h,002h,003h,004h,005h,007h,008h,009h db 00ah,00bh,00ch,00dh,00fh,012h,013h,014h db 015h,017h,019h,01ah,01bh,01ch,01dh,01fh db 023h,024h,025h,027h,029h,02bh,02ch,02dh db 02fh,033h,034h,035h,037h,039h,03bh,03ch db 03dh,0c5h,0c7h,0c8h,0c9h,0cfh,0d0h,0d1h db 0d5h,0d7h,0d8h,0d9h,0dfh,0e0h,0e1h,0e3h db 0e5h,0e7h,0e8h,0e9h,0ebh,0efh,0f0h,0f1h db 0f3h,0f5h,0f7h,0f8h,0f9h,0fbh,0ffh OB.Len equ $-OneByteCodes ; ; Two byte instructions ; TwoByteCodes: db 006h,00eh,016h,01eh,026h,02eh,036h,03eh db 0c6h,0ceh,0d6h,0deh,0e6h,0eeh,0f6h,0feh db 0d3h,0dbh TB.Len equ $-TwoByteCodes ; ; Relative jump instructions ; JRcodes: db 010h,018h,020h,028h,030h,038h JR.Len equ $-JRcodes ; ; Jump instructions ; JPcodes: db 0c2h,0c3h,0cah,0d2h,0dah,0e2h,0eah,0f2h db 0fah JP.Len equ $-JPcodes ; ; Call instructions ; CALLcodes: db 0c4h,0cch,0cdh,0d4h,0dch,0e4h,0ech,0f4h db 0fch CAL.Len equ $-CALLcodes ; ; Immediate load instructions ; D16codes: db 001h,011h,021h,031h D16.Len equ $-D16codes ; ; Special prefixed (ED) load instructions ; ED.code1: db 04bh,05bh,07bh ED.Len1 equ $-ED.code1 ; ED.code2: db 043h,053h,073h ED.Len2 equ $-ED.code2 ; Special prefixed (DD-FD) bit instructions FD.code: db 034h,035h,046h,04eh,056h,05eh,066h,06eh db 070h,071h,072h,073h,074h,075h,077h,07eh db 086h,08eh,096h,09eh,0a6h,0aeh,0b6h,0beh FD.Len equ $-FD.code ; ; Version dependend routines ; $TP.ADR: dw $TP.PAR1,$TP.PAR2,$TP.PAR3,$TP.PAR3A $TP.PAR1: dw v1lib,v1ias,v1ist db v1hdl db '1' $TP.PAR2: dw v2lib,v2ias,v2ist db v2hdl db '2' $TP.PAR3: dw v3lib,v3ias,v3ist db v3hdl db '3' $TP.PAR3A: dw v3Alib,v3Aias,v3Aist db v3ahdl dc '3' FndTP: ds 1 TPhdlen: ds 1 TP$VER: ds 1 $memry: ds 2 PClen: ds 2 Console: ds 1 XFER.PC: ds 2 PC: ds 2 TBstop: ds 2 StkSav: ds 2 PrgRec: ds 2 ErrExtend: ds 2 TBoffs: ds 2 TBbeg: ds 2 ; Address of end of TURBO !!!! 1.x TBlib: ds 2 ; End of TURBO lib ; specLIB: db special ; Special calls @TBsp: ds 2 ; >> Immediate string to stack ds 2 ; >> Immediate string output special equ ($-@TBsp) / 2 $COM: db 'COM' $CTL: db 'CTL' $HELP: db 'Generate base control .CTL file required for DASM' db cr,lf db 'based upon TURBO PASCAL v.1, 2 or 3 generated .COM file' db cr,lf db '(Detected automatically)' db cr,lf,lf db 'Call it:',tab,'TPCTL file [C]' db cr,lf,lf db 'Option C allows log to console' db cr,lf,eot $ILL.WILD: db 'Wildcard not allowed in file name',eot $NO.FILE: db 'Cannot open file',eot $ERR.FILE: db 'File is not TURBO COM file',eot $TPVER: db cr,lf,lf,'Seems to be compiled by TURBO PASCAL v.',eot $DONE: db 'File decoding done',eot $WRT.ERR: db 'CTL file write error',cr,lf,eot $EMP.FILE: db '(Zero length)',cr,lf,eot $NO.JP: db '(Missing JP)',cr,lf,eot $RD.ERR: db '(File read error)',cr,lf,eot $ILL.HD: db '(Invalid header)',cr,lf,eot $ILL.LEN: db '(Invalid length)',cr,lf,eot cseg ; ; Prepare CTL file ; rewrite: ld hl,($memry) ; Get start of memory ld (wrbuf),hl ; For disk buffer ld de,reclng add hl,de ld (wrfcb),hl ; Set FCB ex de,hl push de ld hl,FCB ld bc,.fdrv+.fname ldir ; Copy main file ld hl,$CTL ld bc,.fext ldir ; Set .CTL pop de call creatd ; Create file ret nc jp wrterr ; ; Position file to record and read it ; ENTRY Reg HL holds PC ; fpos: dec h ; Base is 0100h ld a,l and 01111111b ; Get record pointer ld (rdbfp),a ; Set for reading ld a,l ; Divide address by 128 ld l,h ld h,0 add a,a adc hl,hl xor a ld de,FCB call fseek ; Seek recotd ret nc jp geterr ; Error ; ; Set prolog ; SetPRO: ld hl,($HEAD.1) ld ($PRO.1),hl ; Copy ASCII address ld hl,($HEAD.1+2) ld ($PRO.1+2),hl ld de,$PRO call puts ret ; ; Set epilog ; SetEPI: ld de,$EPI ld hl,(TBstop) call hexout ; Get end of program ld de,$EPI call puts ret ; ; Get PC from CALL ; Test if address library related ; EXIT Reg HL holds address ; Carry set if lib access ; isLibPC?: ld de,(TBlib) ld hl,(XFER.PC) ; Find PC or a sbc hl,de ; Check in LIB ld hl,(XFER.PC) ; Get back PC ret ; ; ==>> I/O routing <<== ; ; Give new line ; NL: push de ld de,@crlf call puts ; Print new line pop de ret ; ; Print string at ^DE ; puts: push de push bc ld b,eot call emplin ; Put to file pop bc pop de jp c,wrterr ld a,(Console) ; Test console, too or a call z,string ; Yeap ret ; ; Get word, convert to ASCII hex ; Sequence xx LO HI ; ENTRY Reg DE holds buffer ; Reg BC holds inc/decrement ; xtoa: push bc call fgetc ; Skip byte call fgetw ; Get word pop bc add hl,bc ; Fix address call hexout ; Convert to hex ret ; ; Check valid header beginning at address in ^HL ; ; The header differs in the different TURBO versions ; ; For TURBO v1 and v2 the header looks like: ; ; LD SP,$-$ ; Load stack ; LD HL,$-$ ; Set top memory ; LD DE,$-$ ; Set ??? ; LD BC,$-$ ; Set mode ; CALL rout1 ; LD HL,$-$ ; Set 1st free address ; LD DE,$-$ ; Set last free address ; LD BC,$-$ ; Set top of memory ; CALL rout2 ; ; With rout1=0360 or 038d and rout2=0485 or 04b2 ; ; And for TURBO v3 and v3A the header looks like: ; ; LD SP,$-$ ; Load stack ; LD HL,$-$ ; Set top memory ; LD BC,$-$ ; Set mode ; CALL rout1 ; LD HL,$-$ ; Set 1st free address ; LD DE,$-$ ; Set last free address ; LD BC,$-$ ; Set top of memory ; LD A,1 ; CALL rout2 ; ; With rout1=0364 or 0365 and rout2=04d4 or 04d5 ; ChkHead: call fpos ; Position file ; ; The first two instructions are same in all versions of TURBO ; ld b,_LD.SP call tst.opc.w ; Test instructions ld b,_LD.HL call tst.opc.w ; ; Now decide whether v1 and 2 or v3 and v3A ; call fgetc ; Get opcode push af call fgetw ; Read and ignore word pop af cp _LD.DE ; Test early versions jr z,Hd1_2 ; Yeap cp _LD.BC ; Verify v3x jr nz,ill.hd ; ; We found v3.x ; call tst.CALL ; Verify call ex de,hl ld hl,v3r1 ; Try first one or a sbc hl,de ld bc,v3r2 ld a,4 jr z,Hd3 ld hl,v3ar1 ; Verify next one or a sbc hl,de ld bc,v3ar2 ld a,6 jr nz,ill.hd Hd3: push bc ; Save address expected ld (FndTP),a ; Save index ld b,_LD.HL ; Get next code call tst.opc.w ; And address ld (TBstop),hl ; For top call skipRegs ; Skip following ones call fgetw ; Get next bytes ld de,_LD.A.1 or a sbc hl,de ; Verify it jr z,chkCALL ; Check final call jr ill.hd ; ; Verify CALL follows ; tst.CALL: ld b,_CALL ; ; Verify correct opcode in reg B, skip following word ; tst.opc.w: call fgetc ; Get it cp b ; Verify it ill.hd: ld hl,$ILL.HD call nz,setErrx ; Set error if not jp nz,comer ; Tell error call fgetw ; Get word ret ; Ignore it ; ; We found v1 or v2 ; Hd1_2: ld b,_LD.BC ; Verify next instruction call tst.opc.w call tst.CALL ; Verify call ex de,hl ld hl,v1r1 ; Try first one or a sbc hl,de ld bc,v1r2 ld a,0 jr z,Hd1 ld hl,v2r1 ; Verify next one or a sbc hl,de ld bc,v2r2 ld a,2 jr nz,ill.hd Hd1: push bc ; Save address expected push af ld (FndTP),a ; Save index ld b,_LD.HL ; Get next code call tst.opc.w ; And address pop af cp 4 ; V1 needs increment jr nz,Hd2 ; For end address inc hl Hd2: ld (TBstop),hl ; Save top call skipRegs ; Skip following ones chkCALL: call tst.CALL ; Get last call pop de or a sbc hl,de ; Verify it ret z ; Well done jr ill.hd ; ; Skip two instructions ; skipRegs: ld b,_LD.DE ; Ignore following ones call tst.opc.w ld b,_LD.BC call tst.opc.w ret ; ; Set version addresses ; setTPver: ld a,(FndTP) ; Get version index ld hl,$TP.ADR call adda ; Set pointer ld e,(hl) ; Fetch pointer inc hl ld d,(hl) push de pop ix ld l,(ix+0) ; Get addresses ld h,(ix+1) ld (TBlib),hl ld l,(ix+2) ld h,(ix+3) ld (@TBsp),hl ld l,(ix+4) ld h,(ix+5) ld (@TBsp+2),hl ld a,(ix+6) ld (TPhdlen),a ; Header length ld a,(ix+7) ld (TP$VER),a ; Version number ret ; ; Set default extension ; ENTRY Reg DE points to extension of FCB ; Reg HL points to extension to be set ; setdef.ext: ld a,(de) ; Get extension cp ' ' ; Test defined ret nz ; Yeap ld bc,.fext ldir ; Set default ret ; ; Process the file ; AnalyzeTB: ld (StkSav),sp ; Save stack TBloop: call DecodeOPC ; Decode the OPCode ld (PClen),bc ; Save length of instruction inc e dec e call nz,CAL ; Got CALL ld de,(PC) ; Fetch PC ld hl,(PClen) add hl,de ; Add length of code ld (PC),hl ld de,(TBstop) or a sbc hl,de ; Test end jr nz,TBloop ; Nope, get next ld de,$DONE ret ; ; Get byte from file, check error ; EXIT Accu holds byte read ; fgetc: call dskget ; Load a byte ret nc ; Ok geterr: ld sp,(StkSav) ld hl,$RD.ERR setErrx: ld (ErrExtend),hl ; Save extended error address ld de,$ERR.FILE ret ; NOT ok ; ; Get word from file ; EXIT Reg HL holds word read ; fgetw: call fgetc ; Load LO byte ld l,a call fgetc ; And HI byte ld h,a ret ; ; Decode an OPCode - especially search for CALL ; ; Reg E returns 0 - No call instruction ; 1 - Call instruction ; ; Reg BC returns length of code ; DecodeOPC: call fgetc ; Get OPcode ld bc,2 ; Preset length ld e,0 ; And type cp _BIT ; Check bit manipulating TwoBytes: push af call z,fgetc ; Skip next on two byte code pop af ret z ; Exit on match dec bc ; Set to length of one cp _CCF ; Test one byte possible jr c,NotOneByte ; Nope cp _POP.BC+1 ; Verify ret c ; Ok, got it NotOneByte: ld hl,OneByteCodes ld bc,OB.Len cpir ; Find one byte codes ld bc,1 ret z ; Got it ld hl,TwoByteCodes ld bc,TB.Len cpir ; Find two byte code ld bc,2 jr z,TwoBytes ; Got it ld hl,JRcodes ld bc,JR.Len cpir ; Test relative jump jr nz,NotJR ; Nope ld bc,2 ; Set length call fgetc ; Get relative offset ret NotJR: ld hl,JPcodes ld bc,JP.Len cpir ; Find JP codes WordCode: ld bc,3 jr nz,NotJP ; Not jump/call XFER.adr: call fgetw ; Get address ld (XFER.PC),hl ; Save ret NotJP: ld hl,CALLcodes ld bc,CAL.Len cpir ld e,1 jr z,WordCode ; Got call dec e ld hl,D16codes ld bc,D16.Len cpir jr z,WordCode ; Got immediate load cp _LDA ; Test accu load jr z,WordCode cp _STA ; Test accu save jr z,WordCode cp _LHLD ; Test HL load jr z,WordCode cp _SHLD ; Test HL save jr z,WordCode ld bc,1 cp _DD ; Test prefix jr z,DD.FD.code cp _FD jr z,DD.FD.code cp _ED ret nz call fgetc ; Get opcode ld hl,ED.code1 ld bc,ED.Len1 cpir ; Test load ld bc,4 jr z,XFER.adr ; Get address ld hl,ED.code2 ld bc,ED.Len2 cpir ld bc,4 jr z,XFER.adr ; Dtto. ld bc,2 ret DD.FD.code: call fgetc ; Get opcode cp _BIT ; Test bit manipulation IDX.wrd.offs: ld bc,4 jr nz,More.DD.FD ; Try other code call fgetw ; Get next two values IDX.offs: ret More.DD.FD: ld hl,FD.code ld bc,FD.Len cpir ; Test bit manipulation jr nz,LD.?D? call fgetc ; Get offset ret LD.?D?: cp _LD.IXo ; Test very special jr z,IDX.wrd.offs ld bc,4 cp _LD.IXi ; Test load jp z,XFER.adr ; Yeap, get address cp _LD.a.I jp z,XFER.adr cp _LD.I.a jp z,XFER.adr ld bc,2 ret ; ; Process call instruction ; CAL: call isLibPC? ; Get PC, check LIB ret nc ; Not in lib ; ; Find lib address with immediate parameters following ; Format: ; CALL LIB ; DB N ; DB B1,B2,...,BN ; ex de,hl ld ix,specLIB+1 ; Init address array ld b,(ix-1) ; Get length of check table callop: ld l,(ix+0) ; Fetch special address ld h,(ix+1) or a sbc hl,de jr z,spcfnd ; Match inc ix inc ix djnz callop ret spcfnd: ld de,$CAL.1 ld hl,(PC) inc hl ; Skip to hex inc hl inc hl push hl call hexout ; Set current PC pop hl inc hl ld de,$CAL.2 call hexout call fgetc ; Fetch length ld c,a ld b,0 ld hl,(PClen) add hl,bc inc hl ld (PClen),hl ; Fix PC length ld de,(PC) add hl,de ld de,$CAL.3 call hexout inc c dec c ; Test zero length jr nz,put.CAL ; Nope ld hl,($CAL.1) ; Unpack for special case ld ($CAL0.1),hl ld hl,($CAL.1+2) ld ($CAL0.1+2),hl ld hl,($CAL.3) ld ($CAL0.2),hl ld hl,($CAL.3+2) ld ($CAL0.2+2),hl ld de,$CAL0.1 call puts ret put.CAL: ld de,$CAL.1 call puts ld b,c ; Get length ld a,b or a ; Test zero ret z ; Ignore if so spclop: call fgetc ; Skip string djnz spclop ret ; ; Set console option ; setOption: ld a,(FCB+DIRlen+.fdrv) sub 'C' ld (Console),a ; Set or reset Console ret ; ; Open compiled file ; resetTP: ld a,(FCBnam) cp ' ' ; Test filename given ld de,$HELP jp z,ErrEnd ; Nope, error ld de,FCB call wcard ; Verify no wildcard ld de,$ILL.WILD jp z,comer ld hl,$COM ld de,FCBext call setdef.ext ; Set default extension ld de,FCB call open ; Find file call nc,filsiz ; And it's size ld de,$NO.FILE jp c,comer ; Cannot open ld (PrgRec),hl ; Save it ld a,l or h ; Verify correct file ld hl,$EMP.FILE call z,setErrx ; Set error if not jp z,comer ; Tell error ld a,1 ld (fseek-1),a ; Enable increment after read ret ; ; Prepare compiled file ; prepTP: call fgetc ; Get first byte of file cp _JP ; Verify legal start of file ld hl,$NO.JP call nz,setErrx ; Set error if not jp nz,comer ; Should be call fgetw ; Get word follows ld (TBoffs),hl ; For offset address push hl call ChkHead ; Check valid header call setTPver ; Set version addresses pop hl ld (TBbeg),hl ; Set adress for top ;; call fpos ; Position file ld de,(FCBrnd) ; Check legal range ld hl,(PrgRec) or a sbc hl,de ; Test legal size of file ld hl,$ILL.LEN call c,setErrx jp c,comer ;; call fgetw ; Get end ;; ld (TBstop),hl ; For top call tellversion ; Print compiler version found ld de,$HEAD.1 ld hl,(TBoffs) push hl call hexout ; Get start of program ld de,$HEAD.2 ld hl,(TBstop) dec hl call hexout ; Get end of program pop hl ld a,(TPhdlen) ; Get header length call adda ; Set start address now ld (PC),hl ; Set TURBO start call fpos ; Position file ld de,$HEAD call string ; Tell range ret ; ; Tell vesion of compiler detected ; tellversion: ld de,$TPVER call string ; Tell it ld a,(TP$VER) bit 7,a ; Test high bit res 7,a push af call conout ; Print version pop af ret z ; Got "normal" version ld a,'A' call conout ; Indicate 3A ret ; ; %%%%%%%%%%%%%%%%%%%% ; %%% Main program %%% ; %%%%%%%%%%%%%%%%%%%% ; TPCTL: ld sp,(TPATOP) ; Get stack call setOption ; Set console option call resetTP ; Open compiled file call prepTP ; Prepare compiled file call rewrite ; Prepare .CTL file call SetPRO ; Set prolog call AnalyzeTB ; Process TURBO program ld de,(ErrExtend) ; Test extended error ld a,e or d call nz,string ; Yeap, do it call SetEPI ; Set epilog call closef ; Close .CTL file jp nc,OS ; Ok ; ; File write error processing ; wrterr: ld de,(wrfcb) call delete ; Delete file ld de,$WRT.ERR ; ; Give error message and go ; ErrEnd: call string jp OS ; ; Test pending error ; comer: ld de,(ErrExtend) ; Test extended error ld a,e or d call nz,string ; Yeap, do it jp OS end TPCTL