; XLT80 - Translate ZILOG Z80 mnemonics to INTEL 8080 mnemonics ; ; VERSION EQU 8 ; ; ; Based on XLATE2 which translates 8080 to Z80 mnemonics. ; ; This version will not split up unrecognized names longer than 5 char- ; acters. It operates faster because it uses larger buffers. It also ; handles long labels properly. This program will not translate Z80 ; intrinsic opcodes (Z80 opcodes with no 8080 counterpart) but flags ; them and writes the line numbers in which they are found, to the out- ; put file. It only translates to authentic Intel 8080 mnemonics; no ; "TDL" type mnemonics are used. This was was intentional, since the ; program is envisioned as a tool to convert Z80 programs to run on an ; 8080 or 8085 system. ; ; ;----------------------------------------------------------------------- ; update history ; ; 12/18/85 Simplied command structure, defaults to standard 8080 source ; v8 functions, more compatible with XLATE5 now. Other organiza- ; tional changes. This is a much better program than the ZTOI ; translator program currently being sold commercially. Among ; other undesired features, ZTOI puts out errors if any source ; code is in lower-case. It makes no attempt to translate any ; relative jumps to abolute addresses, but what is worse, does ; not even flag or mark such items as remaining intrinsic Z80. ; XLT80 handles these correctly. This program is outstanding. ; Numerous additional changes which include automatic suppres- ; sion of the intrinsic Z80 opcode message if/when none exist. ; - Irv Hoff ; ; 10/28/84 Original version, based on XLATE2. ; - Frank J. Zerilli ; ;----------------------------------------------------------------------- ; N00 EQU 0 N01 EQU 1 N07 EQU 7 N09 EQU 9 ; Tab every 8th column NF8 EQU 0F8H ; Mod 8 NFF EQU 0FFH ; Disk error return ; MEMSIZ EQU 16 ; Memory available in k IBFLEN EQU MEMSIZ*1024 ; Length of input buffer LBUFLN EQU 80 ; Line buffer length OBFLEN EQU MEMSIZ*1024 ; Length of output buffer OPBFLN EQU 5 ; Opcode buffer length ; ; ; ASCII equates ; BELL EQU 07H CR EQU 0DH CTLC EQU 03H EOF EQU 1AH EOS EQU 04H EOT EQU 04H ESC EQU 1BH FNLEN EQU 08H HT EQU 09H LF EQU 0AH QUOTE EQU 27H ; ; ; BDOS functions ; ABORT EQU 0000 BDOS EQU 0005 FCB1 EQU 005CH FCB2 EQU 006CH ; CONIN EQU 1 CONOUT EQU 2 CONST EQU 11 OPEN EQU 15 CLOSE EQU 16 DELETE EQU 19 READ EQU 20 WRITE EQU 21 MAKE EQU 22 CURDSK EQU 25 SETDMA EQU 26 ; ; ORG 100H ; ; ; Program starts here. ; START: LXI H,0 DAD SP SHLD SPBDOS LXI SP,STACK LXI D,SIGNON CALL PRTLIN LDA FCB1+1 ; Check for a file name CPI ' ' ; Print help if no name JZ START1 ; No help requested CPI '?' JNZ BEGIN LDA FCB1+2 CPI ' ' JNZ BEGIN ; START1: LXI D,HELP ; Print help message CALL PRTLIN MVI C,CONIN ; Wait for any character CALL BDOS LXI D,HELP1 ; Print rest of help CALL PRTLIN LHLD SPBDOS ; Retrieve system stack SPHL ; Pointer and pop RET ; To PC ;..... ; ; BEGIN: CALL HELLO ; Signon, open in & out files ; NXTLIN: CALL GETLIN ; Get line from input file to buf CALL PROCLIN ; Process line JMP NXTLIN ;..... ; ; ;----------------------------------------------------------------------- ; ; Print signon, open input and output files. ; HELLO: MVI C,CURDSK CALL BDOS XRA A STA UNKTBL INR A STA XCDISK CALL MAKFNS CALL OPENIN CALL CREATO RET ;..... ; ; ;----------------------------------------------------------------------- ; ; Gets line from input file to line buffer until CR. Filters out con- ; trol characters except for HT. Truncates lines after all LBUFLN ; characters. Terminates line with CR, LF, 0. ; GETLIN: CALL PDOT ; Print activity dot CALL CHKIN ; Check for abort CPI CTLC JZ JABORT XRA A STA QUOTFL STA CMNTFL LXI H,LBUFF ; Line buffer MVI B,LBUFLN ; Max number of characters ; GETLN1: XCHG LHLD XIBUFF XCHG MOV A,D CPI (IBUFF+IBFLEN)/256 JNZ GETLN4 MOV A,E CPI (IBUFF+IBFLEN) MOD 256 JNZ GETLN4 PUSH H PUSH B LXI D,IBUFF ; GETLN2: MVI C,SETDMA PUSH D CALL BDOS POP D XCHG LXI D,INFCB MVI C,READ PUSH H CALL BDOS POP H DCR A JNZ GETLN3 MVI A,EOF MOV M,A ; GETLN3: LXI D,128 DAD D XCHG MOV A,D CPI (IBUFF+IBFLEN)/256 JNZ GETLN2 MOV A,E CPI (IBUFF+IBFLEN) MOD 256 JNZ GETLN2 POP B POP H LXI D,IBUFF ; GETLN4: LDAX D INX D XCHG SHLD XIBUFF XCHG MOV M,A CPI QUOTE ; Set or reset JNZ GTLN41 ; QUOTFL LDA QUOTFL CMA STA QUOTFL ; GTLN41: LDA QUOTFL ; If in quote, ORA A ; Do nothing JNZ GTLN43 MOV A,M ; Otherwise, ';' sets CPI ';' ; CMNTFL JZ GTLN42 CPI EOS ; And EOS resets it JNZ GTLN43 XRA A ; GTLN42: STA CMNTFL ; GTLN43: LDA QUOTFL ; If in quote, ORA A ; Do nothing JNZ GTLN44 LDA CMNTFL ; If in comment, ORA A ; Do nothing JNZ GTLN44 MOV A,M CPI 97 JC GTLN44 CPI 123 JNC GTLN44 ANI 95 ; Change to upper-case MOV M,A ; GTLN44: MOV A,M ; Get the character back CPI CR ; Is it a carriage return? JZ GETLN6 CPI HT ; Is it a tab character? JZ GETLN5 CPI EOF ; It is an end of file marker? JZ GETLN7 CPI ' ' JC GETLN1 ; Filter out other control characters ; GETLN5: DCR B INX H JNZ GETLN1 INR B DCX H JMP GETLN1 ; GETLN6: INX H MVI M,LF INX H MVI M,N00 XCHG SHLD XIBUFF LHLD LINENO INX H SHLD LINENO RET ;..... ; ; ; Exit ; GETLN7: LHLD XUNKTB CALL CHKBDOS ; Ret NC if HL=41? JNC PTND54 DCR A ; No, insert ANI NF8 ; Tabs to ADI N09 ; Start output CMP B ; At col. 33 JZ PTND54 JC PTND52 MVI A,' ' JMP PTND53 ; PTND52: MVI A,HT ; PTND53: CALL PUTCHR JMP PTND51 PTND54: LDA TEMP ; Insure CPI ' ' ; Space JZ PUTND6 ; Before CPI HT ; Semi-colon JZ PUTND6 MVI A,' ' CALL PUTCHR ; PUTND6: MOV A,M INX H CPI EOS JZ PTND22 ORA A RZ CALL PUTCHR JMP PUTND6 ; ; ; Put line at HL to output file until 0 and reset colnum to 1. ; PUTLNB: XTHL ; Filter trailing POP H ; Blanks or tabs ; PUTLNC: JMP PUTLIN ;..... ; ; ;----------------------------------------------------------------------- ; ;Opcode tables ; OPTONE: DB 'CPL CMA ' DB 'CCF CMC ' DB 'SCF STC ' DB 'HALT HLT ' DB 'RLA RAL ' DB 'RRA RAR ' DB 'RLCA RLC ' DB 'RRCA RRC ' DB 'DAA DAA ' DB 'NOP NOP ' DB 'DI DI ' DB 'EI EI ' DB 0 ; OPT1Z80:DB 'EXX EXX ' DB 'LDIR LDIR ' DB 'LDI LDI ' DB 'LDDR LDDR ' DB 'LDD LDD ' DB 'CPI CPI ' DB 'CPIR CPIR ' DB 'CPD CPD ' DB 'CPDR CPDR ' DB 'INI INI ' DB 'INIR INIR ' DB 'IND IND ' DB 'INDR INDR ' DB 'OUTI OUTI ' DB 'OTIR OTIR ' DB 'OUTD OUTD ' DB 'OTDR OTDR ' DB 'NEG NEG ' DB 'RLD RLD ' DB 'RRD RRD ' DB 'RETI RETI ' DB 'RETN RETN ' DB 'IM0 IM0 ' DB 'IM1 IM1 ' DB 'IM2 IM2 ' DB 0 ; OPT2Z80:DB 'DJNZ DJNZ ' DB 'BIT BIT ' DB 'SET SET ' DB 'RES RES ' DB 'RLC RCL ' DB 'RL RL ' DB 'RRC RRC ' DB 'RR RR ' DB 'SLA SLA ' DB 'SRA SRA ' DB 'SRL SRL ' DB 'IM IM ' DB 0 ; OPTPSD: DB 'DB DB ' DB 'DW DW ' DB 'DS DS ' DB 'DEFB DB ' DB 'DEFW DW ' DB 'DEFS DS ' DB 'EQU EQU ' DB 'DL SET ' DB 'DEFL SET ' DB 'ORG ORG ' DB 0 OPTLOG: DB 'OR ORI ORA ' DB 'AND ANI ANA ' DB 'XOR XRI XRA ' DB 'CP CPI CMP ' DB 'SUB SUI SUB ' DB 0 ; OPTADD: DB 'ADD ADI ADD ' DB 0 ; OPTADC: DB 'ADC ACI ADC ' DB 'SBC SBI SBB ' DB 0 ; OPTEX: DB 'EX XCHG ' DB 0 ; OPTPP: DB 'PUSH PUSH ' DB 'POP POP ' DB 0 ; OPTINC: DB 'INC INX INR ' DB 'DEC DCX DCR ' DB 0 ; OPTLD: DB 'LD MVI MOV ' DB 0 ; OPTIO: DB 'IN IN ' DW DOIN DB 'OUT OUT ' DW DOUT DB 'RST RST ' DW DORST DB 'JP JMP ' DW DOJP DB 'JR JMP ' DW DOJP DB 'CALL CALL ' DW DOCAL DB 'RET RET ' DW DORET DB 'MEND ENDM ' DW DO180 DB 'MACROMACRO' DW DOMACR DB 'ELSE ELSE ' DW DOELSE DB 0 ;..... ; ; ;----------------------------------------------------------------------- ; ; Process labels, find potential opcode. ; FNDOPC: MOV A,M CPI ' ' JZ FNDOP3 CPI HT JZ FNDOP3 CPI CR ; Pass blank RZ ; Lines and CPI ';' ; Comment lines RZ CPI '*' ; Asterisk in first column JNZ FNDOP1 ; Is a comment line MVI M,';' RET ;..... ; ; ; Come here to process label ; FNDOP1: MVI C,N00 ; C will have length of label ; FNDOP2: MOV A,M CPI ':' JZ FNDOP4 CPI HT JZ FNDOP6 CPI ' ' JZ FNDOP6 CPI CR RZ CPI EOS RZ CPI ';' JZ FNDP72 CALL PUTCHR INX H INR C JMP FNDOP2 ; ; ; Comes here only if space or tab at beginning of line. FNDOP3: PUSH H CALL SKSPHT ; Find first non-sp or tab CPI CR ; Filter out tabs or JZ FNDOP9 ; Spaces at end of line. CPI EOS JZ FNDOP9 CPI ';' JZ FNDP71 POP H CALL PUTSPT ; Print until non-sp or ht PUSH H CALL FINDLM ; Find ,:+-/*); CR HT or SP at HL CPI ':' POP H JZ FNDOP1 ; Found a label, process it JMP FNDOP7 ; ; ; Colon terminating label comes here ; FNDOP4: INX H MOV A,M CPI ':' ; Is it a double colon ? JNZ FNDOP5 CALL PUTCHR INX H FNDOP5: MVI A,':' CALL PUTCHR ; ; ; HT or SP comes here - see if there is an opcode field FNDOP6: FNDOP7: PUSH H CALL SKSPHT MOV A,M CPI CR JZ FNDOP9 ; Filter trailing SP or TAB CPI EOS JZ FNDOP9 ; Exclamation point separator CPI ';' JNZ FNDOP8 ; Found opcode field ; FNDP71: XTHL ; Found comment field POP H ; FNDP72: POP B ; Clear return JMP PUTND5 ; Tab to proper column ;..... ; ; ; Have located opcode field ; FNDOP8: POP H CALL PUTSPT ; ; ; Move potential opcode to OPCBUF ; MOVOPC: SHLD XOPCOD MVI B,OPBFLN LXI D,OPCBUF CALL MOVBDH ; Move up to B char from HL to CALL SKSPHT ; DE until ,:+-/*); CR HT SP SHLD XOPRND SUB A INR A RET ;..... ; ; ; Come here on CR to filter trailing SP or TAB ; FNDOP9: XTHL POP H RET ;..... ; ; ;----------------------------------------------------------------------- ; ; Gets routine address from HL+2*OPBFLN and jumps to routine. ; EXEC: PUSH H LXI B,2*OPBFLN DAD B MOV C,M INX H MOV B,M POP H PUSH B ; Address on stack RET ; Go to it ;..... ; ; ; Scan table at HL for match to OPBFLN character string at OPCBUF. ; Ret Z and HL-> entry if match. ; SCANOP: MOV A,M ANA A JZ SCNOP1 PUSH B MVI B,OPBFLN LXI D,OPCBUF CALL CBDEHL ; Comp B bytes (DE)-(HL) POP B RZ DAD B JMP SCANOP ; SCNOP1: INR A RET ;..... ; ; ; Scan table at HL for match to string pointed to by DE. Enter with ; A = string length and BC = offset to next entry. Return Z and HL ; pointing to table entry if match. ; SCAN: PUSH B MOV B,A MOV A,M ORA A JZ NOTFND CALL COMP ; Comp B bytes (DE)-(HL) MOV A,B POP B RZ DAD B JMP SCAN ; NOTFND: INR A POP B RET ;..... ; ; ; Compares B chars at DE with chars at HL. Ret Z if match. Preserve ; HL, DE, BC ; CBDEHL: PUSH H PUSH D PUSH B ; CBDH1: LDAX D CPI 'a' JC CBDH2 ANI 05FH ; CBDH2: CMP M JNZ CBDH3 INX H INX D DCR B JNZ CBDH1 ; CBDH3: POP B POP D POP H RET ;..... ; ; ; Compare B bytes at DE with B bytes at HL. ; COMP: PUSH H PUSH D PUSH B ; COMP1: LDAX D CPI 'a' JC COMP2 ANI 5FH ; COMP2: CMP M JNZ COMP3 INX H INX D DCR B JNZ COMP1 ; COMP3: POP B POP D POP H RET ;..... ; ; ; Put up to OPBFLN character at HL+OPBFLN to output file. Stop at space ; and put tab to output file. ; PUTOPHT:CALL PUTOPC ; PUTHT: MVI A,HT JMP PUTCHR ;..... ; ; PUTOPC: LXI B,OPBFLN DAD B ; HL->new opcode MOV B,C ; PUTOP1: MOV A,M CPI ' ' RZ CPI HT RZ MOV A,M CALL PUTCHR INX H DCR B JNZ PUTOP1 RET ;..... ; ; ; Put string at HL to output file until 0. ; PUTOPS: MOV A,M ORA A RZ MOV A,M CALL PUTCHR INX H JMP PUTOPS ;..... ; ; ; Put string at HL to output file until 0. ; PUTRND: MOV A,M ORA A RZ MOV A,M CALL PUTCHR INX H JMP PUTRND ;..... ; ; ; Put BC character string at HL to output file. ; PUTSTR: MOV A,B ORA C RZ MOV A,M CALL PUTCHR INX H DCX B JMP PUTSTR ;..... ; ; ; Put string at HL until End of Expression (EOE). EOE is the first of ; the tabs or spaces before a semicolon or CR. Returns HL pointing to ; EOE. ; PUTEOE: PUSH B PUSH D PUSH H ; HL -> start CALL FNDEOE ; Returns HL -> EOE MOV B,M MVI M,0 POP H ; HL -> start CALL PUTLIN MOV M,B ; Restore original char POP D POP B RET ;..... ; ; ; Put spaces or tabs at HL to output file until non-(space or tab) ; PUTSPT: MOV A,M CPI ' ' JZ PUTSP1 CPI HT RNZ ; PUTSP1: CALL PUTCHR INX H JMP PUTSPT ;..... ; ; ; Find '),' and return HL -> ')'. Return NZ if not found. ; FINDPR: MOV A,M CPI CR JZ FNDNPR CPI ',' JZ FNDPR1 INX H JMP FINDPR ; FNDPR1: DCX H MOV A,M CPI ')' RET ;... ; ; FNDNPR: ORA A RET ;..... ; ; ; Find End of Expression (EOE). EOE is the first of the spaces or tabs ; before a semicolon or CR. Returns HL -> EOE. ; FNDEOE: MOV A,M CPI ';' JZ FNDEO1 CPI CR JZ FNDEO1 INX H JMP FNDEOE ; FNDEO1: DCX H MOV A,M CPI ' ' JZ FNDEO1 CPI HT JZ FNDEO1 INX H RET ;..... ; ; ; Find first ,:+-/*); CR HT SP or exclamation point at HL, return ; A = (HL). ; FINDLM: PUSH B CALL CHKDLM POP B RZ INX H JMP FINDLM ;..... ; ; ; Ret Z, A=(HL) if HL is ,:+-/*); CR HT SP or exclamation point ; CHKDLM: MOV A,M CPI ':' RZ CPI '+' RZ CPI '-' RZ CPI '/' RZ CPI '*' RZ CPI ')' RZ CPI '!' RZ ; ; ; Ret Z, A=(HL) if (HL) is CR, SP, HT, comma, or semicolon. ; CHKSEP: MOV A,M CPI ',' RZ CPI ' ' RZ CPI HT RZ CPI ';' RZ CPI CR RET ;..... ; ; ; Fill B locations at DE with spaces. Move up to B char from HL to DE ; until :+-/*); CR HT or SP encountered. Return Z and HL->special char- ; acter if found. (Search B+1 loc for special char.) ; MOVBDH: MOV C,B MVI B,N00 PUSH B PUSH D PUSH H ; Fill BC locations CALL FILLBD ; At DE with spaces POP H ; POP D POP B ; MOVBD1: PUSH B ; Ret Z, A=(HL) CALL CHKDLM ; If (HL) is POP B ; ,:+-/*); CR HT or SP RZ MOV A,M STAX D INX D INX H DCX B MOV A,B ORA C JZ CHKDLM JMP MOVBD1 ;.... ; ; ; Skip spaces and tabs. Return HL->non-space or non-tab. ; SKSPHT: MOV A,M CPI ' ' JZ SKSPT1 CPI HT RNZ ; SKSPT1: INX H JMP SKSPHT ;..... ; ; ; Subtract DE from HL, result in HL. ; SBCHLDE:MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A RET ;..... ; ; ; Fill BC locations starting at DE with spaces. Returns A = space, ; DE -> next free location, HL = DE - 1, BC = 0. ; FILLBD: MVI A,' ' STAX D MOV H,D MOV L,E INX D DCX B ; ; ; (DE)=(HL), INC HL, INC DE, DEC BC Repeat until BC = 0. ; MOVIR: MOV A,M STAX D INX H INX D DCX B MOV A,B ORA C JNZ MOVIR RET ;..... ; ; ;----------------------------------------------------------------------- ; ; TRANLATION ROUTINES ; ;----------------------------------------------------------------------- ; ; All untranslatable opcodes come here. (Well, almost all -- completely ; unrecognized opcodes are passed through unprocessed.) ; DOUNK: POP H ; ; ; Untranslatable register addressing Z80 opcodes ; DO1Z80: DO2Z80: CALL ADDLIN ; Add line # to unk. table LXI H,FLGSTR CALL PUTLIN ; Mark opcode LHLD XOPCOD JMP PUTEND ;..... ; ; ; Add current line number to UNKTBL ; ADDLIN: LHLD LINENO XCHG LHLD XUNKTB CALL CHKBDOS ; Ret NC if ok RC MOV M,E INX H MOV M,D INX H SHLD XUNKTB RET ;..... ; ; ; ELSE comes here. ; DOELSE: MVI A,HT STA ELSEFL DOPSD1: MVI A,CR STA UPSMSG ; ; ; Translatable 8080 implied addressing opcodes ; DO180: CALL PUTOPC JMP PUTOPR ;..... ; ; ; Untranslatable pseudo-ops come here. ; DOMACR: MVI A,HT STA MACRFL DOPSD0: MVI A,CR STA UPSMSG ; ; Pseudo-opcodes come here ; DOPSD: CALL PUTOPHT JMP PUTOPR ;..... ; ; ; Logical opcodes SUB, AND, OR, XOR, CP ; DOLOG: PUSH H ; HL -> first translated opcode LHLD XOPRND CALL CHKAC SHLD XOPRND CALL CHKR ; A, B, C, D, E, H, L, (HL) ? JZ DOLOGR CALL CHKIXD ; (IX+d) or (IY+d) ? JZ DOUNK ; DOLOGL: POP H ; It's a label ; DOLOG0: CALL PUTOPHT JMP PUTOPR ;..... ; ; ; Register addressed ; DOLOGR: POP D ; DE -> first translated opcode LXI H,OPBFLN DAD D ; HL -> second translation JMP DOLOG0 ;..... ; ; ;Arithmetic ADD ; DOADD: PUSH H LHLD XOPRND CALL CHKAC ; Skip 'A,' in A,s form SHLD XOPRND CALL CHKR ; Register ? JZ DOLOGR CALL CHKIXD ; (IX+d) or (IY+d) ? JZ DOUNK CALL CHKHL ; ADD HL,xx ? JZ DOADDH CALL CHKIXY ; ADD IX,xx ? JNZ DOLOGL CPI ',' JNZ DOLOGL JMP DOUNK ;..... ; ; ; ADD HL,ss ; DOADDH: CPI ',' JNZ DOUNK INX H CALL CHKRP ; Ret DE->reg.pair trans.,HL->nxt JNZ DOUNK LDAX D CPI 'P' JZ DOUNK PUSH H LXI H,OPDAD CALL PUTOPS CALL PUTHT POP H XCHG CALL PUTRND XCHG POP D JMP PUTEND ;..... ; ; ; Arithmetic opcodes ADC, SBC ; DOADC: PUSH H LHLD XOPRND CALL CHKAC ; Skip A, in A,s form SHLD XOPRND CALL CHKR ; Register ? JZ DOLOGR CALL CHKIXD ; (IX+d) or (IY+d) ? JZ DOUNK CALL CHKHL ; ADD HL,xx ? JZ DOUNK CALL CHKIXY ; ADD IX,xx ? JNZ DOLOGL CPI ',' JNZ DOLOGL JMP DOUNK ;..... ; ; ; Return Z set, HL pointing to delimiter if HL on entry points to 'A', ; 'B', 'C', 'D', 'E', 'H', 'L', or '(HL)'. If '(HL)' convert to 'M' and ; modify (xOPRND) to point to 'M'. ; CHKR: MOV A,M ANI 5FH ; CHKR0: CPI 'A' JZ CHKR2 CPI 'B' JZ CHKR2 CPI 'C' JZ CHKR2 CPI 'D' JZ CHKR2 CPI 'E' JZ CHKR2 CPI 'H' JZ CHKR2 CPI 'L' JZ CHKR2 MOV A,M CPI '(' JZ CHKR3 RET ;..... ; ; CHKR2: INX H CALL CHKDLM ; Ret A=(HL) and Z if ,:+-/*); RZ ; SP, CR, or HT DCX H RET ;..... ; ; CHKR3: XCHG ; DE -> '(' LXI H,MREG MVI B,4 CALL COMP ; Comp. B bytes (DE)-(HL) XCHG ; HL -> '(' RNZ PUSH H INX H INX H INX H INX H ; HL -> d CALL CHKDLM POP H ; HL -> '(' RNZ INX H INX H INX H MVI A,'M' MOV M,A SHLD XOPRND XRA A ; Return Z INX H ; HL -> ',' MOV A,M RET ;..... ; ; ; If HL is pointing to 'A,' then increment HL by 2 and return Z. ; CHKAC: MOV A,M ANI 5FH CPI 'A' RNZ INX H MOV A,M CPI ',' INX H RZ DCX H DCX H RET ;..... ; ; ; If HL -> 'Ad' where d is a delimiter, then return Z and HL -> d. ; Otherwise, return NZ and HL unchanged. ; CHKA: MOV A,M ANI 5FH CPI 'A' RNZ INX H CALL CHKDLM RZ DCX H RET .....: ; ; ; If HL -> 'Id' or 'Rd' where d is a delimiter then return Z and HL -> ; d. Otherwise, return NZ and HL unchanged. ; CHKIR: MOV A,M ANI 5FH CPI 'I' JZ CHKR2 CPI 'R' RNZ JMP CHKR2 ;..... ; ; ; If HL is pointing to '(IX+d)' or '(IY+d)' then return Z and HL point- ; ing to '+' or ')'. Else, return NZ and HL unchanged. ; CHKIXD: MOV A,M CPI '(' RNZ INX H CALL CHKIXY JZ CHKI1 DCX H RET ;... ; ; CHKI1: CPI '+' RZ CPI ')' RZ DCX H DCX H DCX H RET ;..... ; ; ; If HL is pointing to IXd or IYd where d is a delimiter, then return Z ; and HL pointing to d. Else, return NZ and HL unchanged. ; CHKIXY: MOV A,M ANI 5FH CPI 'I' RNZ INX H MOV A,M ANI 5FH CPI 'X' JZ CHKD CPI 'Y' JZ CHKD DCX H RET ;... ; ; CHKD: INX H CALL CHKDLM RZ DCX H DCX H RET ;..... ; ; ; If HL is pointing to 'HLd' where d is a delimiter, then return Z and ; HL pointing to d. Otherwise, return NZ and HL unchanged. ; CHKHL: MOV A,M ANI 5FH CPI 'H' RNZ INX H MOV A,M ANI 5FH CPI 'L' JZ CHKD DCX H RET ;..... ; ; ; If HL -> '(HL)d' where d is a delimiter, then return Z and HL -> d. ; Otherwise, return NZ and HL unchanged. ; CHKM: MOV A,M CPI '(' RNZ INX H CALL CHKHL JNZ CHKM2 CPI ')' JNZ CHKM1 INX H CALL CHKDLM RZ DCX H ; CHKM1: DCX H DCX H ; CHKM2: DCX H RET ;..... ; ; ; If HL is pointing to one of the following register pairs, return Z, HL ; pointing to d where d is a delimiter, and DE pointing to translation: ; ; rp translation ; ; AFd PSW ; BCd B ; DEd D ; HLd H ; SPd SP ; ; Otherwise, return NZ and HL unchanged. ; CHKRP: XCHG LXI H,RPTBL MVI A,2 ; String length LXI B,6 ; Increment to next table entry CALL SCAN XCHG RNZ INX D INX D ; DE points to translation INX H INX H ; HL points to d CALL CHKDLM RZ DCX H DCX H RET ;..... ; ; ; If HL is pointing to '(BC)d' or '(DE)d', then return Z, HL pointing to ; D, and DE pointing to translation. ; CHKBCDE:XCHG LXI H,BCDETBL MVI A,4 ; String length LXI B,6 ; Offset to next entry CALL SCAN ; Ret Z and HL->entry XCHG ; If DE in table RNZ INX D INX D INX D INX D ; DE->translation INX H INX H INX H INX H ; HL->d CALL CHKDLM RZ DCX H DCX H DCX H DCX H RET ;..... ; ; ; EX ; DOEX: PUSH H ; HL -> first translated opcode LHLD XOPRND XCHG LXI H,EXTBL1 ; EX DE,HL ? MVI A,5 ; String length LXI B,10 ; Offset to nxt entry CALL SCAN LXI B,EXTBL1+5 LXI H,5 JZ DOXCHG LXI H,EXTBL2 ; EX (SP),HL ? MVI A,7 LXI B,12 CALL SCAN ; Return HL -> entry LXI B,EXTBL2+7 JNZ DOUNK ; DOXTHL: LXI H,7 ; DOXCHG: DAD D PUSH B CALL CHKDLM ; Preserves HL, DE POP D ; DE->trans. JNZ DOUNK XCHG ; HL->translated opcode CALL PUTOPS ; Put string at HL XCHG POP D ; Clear stack JMP PUTEND ;..... ; ; ; PUSH or POP ; DOPP: PUSH H ; HL -> translated opcode LHLD XOPRND CALL CHKRP ; Ret DE->transl., HL->nxt JNZ DOUNK LDAX D CPI 'S' JZ DOUNK ; DOOPR: SHLD XOPRND POP H CALL PUTOPHT XCHG CALL PUTRND JMP PUTOPR ;..... ; ; ; INC or DEC ; DOINC: PUSH H ; HL-> first translated opcode LHLD XOPRND CALL CHKR JZ DOLOGR CALL CHKRP ; Ret DE->transl., HL->nxt JNZ DOUNK LDAX D CPI 'P' JZ DOUNK JMP DOOPR ;..... ; ; ; LD ; DOLD: PUSH H ; HL->first translated opcode LHLD XOPRND CALL CHKR JZ DOLDR CALL CHKRP ; Ret HL->dlm, DE->tranl. RP JZ DOLDRP MOV A,M CPI '(' JNZ DOUNK CALL CHKIXD JZ DOUNK CALL CHKIXY JZ DOUNK CALL CHKIR JZ DOUNK CALL CHKBCDE JZ DOSTAX ; ; ; Do LD (nn),HL or LD (nn),a ; INX H PUSH H CALL FINDPR ; Find '),' POP D ; DE -> nn JNZ DOUNK PUSH H CALL SBCHLDE XTHL ; (SP) = length INX H ; HL -> ',' INX H ; HL -> 'A' or 'HL' CALL CHKHL JZ DOSHLD CALL CHKA POP B ; BC = length JNZ DOUNK ; ; ; LD (nn),A -> STA nn ; DOSTA: PUSH H ; DE->nn, HL->rest LXI H,OPSTA ; DOST1: CALL PUTOPS CALL PUTHT ; Put HT XCHG ; HL->nn CALL PUTSTR ; Put BC chars at HL POP H ; HL->rest of line POP D ; Clean stack JMP PUTEND ;..... ; ; ; LD (nn),HL -> SHLD nn ; DOSHLD: POP B PUSH H LXI H,OPSHLD JMP DOST1 ;..... ; ; ; LD (DE),A or LD (BC),A -> STAX D or B ; DOSTAX: CPI ',' JNZ DOUNK INX H CALL CHKA JNZ DOUNK SHLD XOPRND LXI H,OPSTAX CALL PUTOPS CALL PUTHT XCHG ; HL-> translation CALL PUTRND POP D ; Clean stack JMP PUTOPR ;..... ; ; ; LD BC,nn -> LXI B,nn ; LD DE,nn -> LXI D,nn ; LD HL,nn -> LXI H,nn ; LD HL,(nn) -> LHLD nn ; LD SP,nn -> LXI SP,nn ; LD SP,HL -> SPHL ; LD SP,IX -> unk ; LD SP,IY -> unk ; LD dd,(nn) -> unk ; ; HL -> delim, DE -> translated RP. ; DOLDRP: CPI ',' INX H JNZ DOUNK LDAX D CPI 'P' JZ DOUNK CPI 'S' JZ DOLDRS MOV A,M CPI '(' JZ DOLDPL ; ; ; LD dd,nn ; DOLDLX: PUSH H ; HL -> nn LXI H,OPLXI CALL PUTOPS CALL PUTHT XCHG ; HL -> translated RP CALL PUTRND MVI A,',' CALL PUTCHR POP H ; HL -> nn CALL PUTEOE ; Put nn to output file POP D ; Clean stack JMP PUTEND ;..... ; ; ;LD SP,xx HL -> next, DE -> translated RP. ; DOLDRS: CALL CHKIXY JZ DOUNK CALL CHKHL JNZ DOLDLX SHLD XOPRND LXI H,OPSPHL CALL PUTOPS POP D ; Clean stack JMP PUTOPR ;..... ; ; ; LD dd,(nn) ; DOLDPL: LDAX D ; DE -> translated RP CPI 'H' JNZ DOUNK INX H ; HL -> nn PUSH H CALL FNDEOE ; Find end of expression nn CPI ')' POP D ; DE -> nn, HL -> EOE JNZ DOUNK DCX H ; HL -> ')' PUSH H LXI H,OPLHLD ; DOLDPL1: CALL PUTOPS CALL PUTHT POP H ; HL -> ')', DE -> nn MVI M,0 XCHG ; HL -> nn INX D ; DE -> EOE CALL PUTLIN XCHG ; HL -> EOE POP D ; Clean stack JMP PUTEND ;..... ; ; ; LD r,x ; DOLDR: CPI ',' JNZ DOUNK INX H MOV A,M CPI '(' JZ DOLDR1 CALL CHKR JZ DOLOGR CALL CHKIR ; LD I,x or LD R,x JZ DOUNK JMP DOLOGL ; DOLDR1: CALL CHKIXD JZ DOUNK CALL CHKBCDE JZ DOLDAX INX H ; HL-> nn) CALL CHKHL JNZ DOLDA CPI ')' JNZ DOUNK DCX H DCX H DCX H DCX H MOV B,M DCX H MOV A,M INX H INX H INX H MOV M,A SHLD XOPRND INX H MOV M,B INX H MVI A,'M' MOV M,A JMP DOLOGR ;..... ; ; ; LD r,(nn) HL -> '(' ; DOLDA: PUSH H LHLD XOPRND MOV A,M POP H ANI 5FH CPI 'A' JNZ DOUNK PUSH H ; HL -> nn) CALL FNDEOE CPI ')' POP D ; DE -> nn, HL -> EOE JNZ DOUNK DCX H ; HL -> ')' PUSH H LXI H,OPLDA JMP DOLDPL1 ;..... ; ; ; LD r,(BC) or LD r,(DE) DE -> tranlated RP, HL -> d ; DOLDAX: PUSH H LHLD XOPRND MOV A,M POP H ANI 5FH CPI 'A' JNZ DOUNK PUSH H LXI H,OPLDAX CALL PUTOPS CALL PUTHT POP H ; HL -> d XCHG ; HL -> translated RP CALL PUTRND XCHG ; HL -> d POP D ; Clean stack JMP PUTEND ;..... ; ; ; RST nn -> RST nn/8 ; DORST: CALL PUTOPHT LHLD XOPRND CALL PUTEOE MVI A,'/' CALL PUTCHR MVI A,'8' CALL PUTCHR JMP PUTEND ;..... ; ; ; IN r,(C) -> unk IN A,(nn) or IN A,nn -> IN nn ; DOIN: PUSH H LHLD XOPRND CALL CHKAC JNZ DOUNK MOV A,M CPI '(' JNZ DOIN1 INX H ; DOIN1: XCHG ; DE -> nn POP H ; HL -> translated opcode CALL PUTOPHT XCHG ; HL -> nn PUSH H CALL FNDEOE CPI ')' JNZ DOIN2 DCX H MVI M,' ' ; DOIN2: POP H ; HL -> nn CALL PUTEOE JMP PUTEND ;..... ; ; ; If HL -> '(C)d' where d is a delimiter, then return Z and HL -> d. ; Otherwise, return NZ and HL unchanged. ; CHKC: MOV A,M CPI '(' RNZ INX H MOV A,M ANI 5FH CPI 'C' JNZ CHKC2 INX H MOV A,M CPI ')' JNZ CHKC1 INX H CALL CHKDLM RZ DCX H ; CHKC1: DCX H ; CHKC2: DCX H RET ;..... ; ; ; OUT (C),A -> unk OUT (nn),A or OUT nn,A -> OUT nn ; DOUT: PUSH H ; HL -> translated opcode LHLD XOPRND CALL CHKC JZ DOUNK MOV A,M CPI '(' JNZ DOUT1 INX H ; DOUT1: PUSH H ; HL -> nn ; DOUT10: MOV A,M CPI ',' JZ DOUT11 CPI ';' JZ DOUT4 CPI CR JZ DOUT4 INX H JMP DOUT10 ; DOUT11: DCX H MOV A,M CPI ')' JZ DOUT2 INX H SHLD XEND JMP DOUT3 ; DOUT2: SHLD XEND INX H ; DOUT3: INX H ; HL -> 'A' CALL CHKA JNZ DOUT4 SHLD XOPRND POP D ; DE -> nn POP H ; HL -> opcode CALL PUTOPHT LHLD XEND MVI M,0 XCHG ; HL -> nn CALL PUTLIN JMP PUTOPR ; DOUT4: POP H JMP DOUNK ;..... ; ; ; Translate JR to absolute JMP. ; ; JP (HL) -> PCHL JP (IX) -> unk ; JP nn -> JMP nn JP (IY) -> unk ; ; JP NZ,nn -> JNZ nn JP Z,nn -> JZ nn ; JP NC,nn -> JNC nn JP C,nn -> JC nn ; JP PO,nn -> JPO nn JP P,nn -> JP nn ; JP PE,nn -> JPE nn JP M,nn -> JM nn ; DOJP: PUSH H ; HL -> translated opcode (JMP) LHLD XOPRND CALL CHKM ; '(HL)' ? JZ DOPCHL CALL CHKIXD ; '(IX)' or '(IY)' JZ DOUNK ; DOJP1: CALL CHKCC ; 'Z', 'C', 'P', or 'M' ? JZ DOCC CALL CHKNC ; 'NZ', 'NC' ? JZ DONC CALL CHKPOE ; 'PO', 'PE' ? JZ DOPOE POP H ; HL -> translated opcode CALL PUTOPC CALL PUTHT JMP PUTOPR ;..... ; ; ; CALL ; DOCAL: PUSH H LHLD XOPRND JMP DOJP1 ; RET ;..... ; ; DORET: PUSH H LHLD XOPRND ; DORET1: CALL CHKCC ; 'Z', 'C', 'P', or 'M' ? JZ DORCC CALL CHKNC ; 'NZ', 'NC' ? JZ DORCC CALL CHKPOE ; 'PO', 'PE' ? JZ DORPOE POP H ; HL -> translated opcode CALL PUTOPC JMP PUTOPR ;..... ; ; ; JP (HL) ; DOPCHL: PUSH H LXI H,OPPCHL CALL PUTOPS POP H POP D ; Clear stack JMP PUTEND ;..... ; ; ; Condition codes 'PO' or 'PE' ; DOPOE: INX H ; DORPOE: MVI A,CR STA POEFLG PUSH H PUSH D CALL ADDLIN POP D POP H JMP DORCC ;... ; ; ; Condition Codes 'Z', 'C', 'P', or 'M' ; DOCC: DONC: INX H ; DORCC: PUSH H ; HL -> nn LHLD XOPCOD MOV A,M CALL PUTCHR XCHG ; HL -> cc CALL PUTLIN LDAX D ; DE -> opcode ANI 5FH CPI 'R' CNZ PUTHT POP H ; HL -> nn POP D ; Clean stack JMP PUTEND ;..... ; ; ; If HL -> 'Zs', 'Cs', 'Ps', or 'Ms', where s is SP, HT, CR, comma, or ; semicolon then return Z and HL -> s. Otherwise, return NZ and HL un- ; changed. ; CHKCC: MOV A,M ANI 5FH CPI 'Z' JZ CHKCC1 CPI 'C' JZ CHKCC1 CPI 'P' JZ CHKCC1 CPI 'M' JZ CHKCC1 RET ; CHKCC1: MOV A,M LXI D,OPCC STAX D INX H CALL CHKSEP ; SP HT CR , ; JNZ CHKCC2 RET ;..... ; ; ; If HL -> 'NCs' or 'NZs' where s is SP, HT, CR, comma or semicolon then ; return Z, HL -> s, DE -> cc string. Otherwise, return NZ and HL, DE ; unchanged. ; CHKNC: MOV A,M ANI 5FH CPI 'N' RNZ MOV A,M LXI D,OPNC STAX D INX H MOV A,M ANI 5FH CPI 'Z' JZ CHKNC1 CPI 'C' JZ CHKNC1 DCX H RET ; CHKNC1: MOV A,M STA OPCC INX H CALL CHKSEP RZ ; CHKNC2: DCX H ; CHKCC2: DCX H RET ;..... ; ; ; If HL -> 'POs' or 'PEs' then return Z, HL -> s, and DE -> cc. Other- ; wise, return NZ and HL unchanged. ; CHKPOE: MOV A,M ANI 5FH CPI 'P' RNZ MOV A,M LXI D,OPNC STAX D INX H MOV A,M ANI 5FH CPI 'E' JZ CHKNC1 CPI 'O' JZ CHKNC1 DCX H RET ;..... ; ; ;----------------------------------------------------------------------- ; ; Set up input and output FCB's from FCB ; MAKFNS: LXI H,FCB1 LXI D,INFCB LXI B,FNLEN+1 CALL MOVIR MOV A,M ; Type specified ? CPI ' ' JZ MKFNS1 CPI '?' JZ MKFNS1 LXI B,3 CALL MOVIR ; MKFNS1: LXI H,FCB1 LXI D,OUTFCB LXI B,FNLEN+1 CALL MOVIR LDA FCB2 ORA A ; Allows output to JZ MKFNS2 ; Different drive STA OUTFCB ; Than input ; MKFNS2: LDA FCB2+1 CPI ' ' JZ MKFNS3 ; Allows output LXI B,8 ; File to have LXI D,OUTFCB+1 ; Different name LXI H,FCB2+1 ; From input file CALL MOVIR ; MKFNS3: LDA FCB2+9 CPI ' ' JZ MKFNS4 LXI B,3 LXI D,OUTFCB+9 LXI H,FCB2+9 CALL MOVIR ; MKFNS4: LXI D,PRFNM1 CALL PRTLIN LXI H,INFCB CALL PRFNAM LXI D,PRFNM2 CALL PRTLIN LXI H,OUTFCB CALL PRFNAM LXI D,CRLFMG CALL PRTLIN RET ;..... ; ; ; Print Filenames ; PRFNAM: MOV A,M ; Disk number ORA A JNZ PRFN1 LDA XCDISK ; PRFN1: ADI '@' CALL TYPE MVI A,':' CALL TYPE INX H MVI B,8 CALL PRFN MVI A,'.' CALL TYPE MVI B,3 ; PRFN: MOV A,M INX H CPI ' ' CNZ TYPE DCR B JNZ PRFN RET ;..... ; ; ; Open source file with ext Z80 ; OPENIN: LXI D,INFCB MVI C,OPEN CALL BDOS CPI NFF JZ NSFERR LXI H,IBUFF+IBFLEN SHLD XIBUFF RET ;..... ; ; NSFERR: LXI D,NSFMSG ; 'No Source File' JMP EREXIT ;..... ; ; ; Create output file with ext ASM ; CREATO: LXI D,OUTFCB MVI C,OPEN CALL BDOS CPI NFF JNZ OFEERR ; CREAT4: LXI D,OUTFCB MVI C,MAKE CALL BDOS CPI NFF JZ NDSERR LXI D,OUTFCB MVI C,OPEN CALL BDOS MVI A,128 STA OBUFCT LXI H,OBUFF SHLD XOBUFF RET ;..... ; ; NDSERR: LXI D,NDSMSG ; 'No directory space' JMP EREXIT ; OFEERR: LXI D,OFEMSG ; 'Output file exists' CALL PRTLIN CALL CHKYES JNZ ABORT LXI D,OUTFCB MVI C,DELETE CALL BDOS JMP CREAT4 ;..... ; ; ; Put character in A to output file, update column number. ; PUTCHR: PUSH H PUSH D PUSH B PUSH PSW STA TEMP LHLD XOBUFF MOV M,A CPI CR JZ PUTCH0 CPI LF JZ PUTCH0 CPI HT JNZ PUTCH1 LDA COLNUM DCR A ANI NF8 ADI N09 JMP PUTCH2 ;..... ; ; PUTCH0: MVI A,1 JMP PUTCH2 ; PUTCH1: LDA COLNUM INR A ; PUTCH2: STA COLNUM INX H ; Inc obuff ptr LDA OBUFCT DCR A ; Dec obuff count JNZ PTCH21 MVI A,128 ; PTCH21: STA OBUFCT MOV A,H CPI (OBUFF+OBFLEN)/256 JNZ PUTCH4 MOV A,L CPI (OBUFF+OBFLEN) MOD 256 JNZ PUTCH4 LXI D,OBUFF ; PUTCH3: MVI C,SETDMA PUSH D CALL BDOS POP D XCHG LXI D,OUTFCB CALL WRTREC ; Write record LXI D,128 DAD D XCHG MOV A,D CPI (OBUFF+OBFLEN)/256 JNZ PUTCH3 MOV A,E CPI (OBUFF+OBFLEN) MOD 256 JNZ PUTCH3 LXI H,OBUFF ; PUTCH4: SHLD XOBUFF POP PSW POP B POP D POP H RET ;..... ; ; ; Put line at HL to output file until 0. ; PUTLIN: MOV A,M ORA A RZ CALL PUTCHR INX H JMP PUTLIN ;..... ; ; ; Write record. ; WRTREC: MVI C,WRITE PUSH H CALL BDOS POP H ANA A RZ LXI D,OFWMSG ; 'output file write error' JMP EREXIT ;..... ; ; ; Fill rest of obuff with EOF, write record, and close file. ; CLOSEO: MVI A,EOF CALL PUTCHR LDA OBUFCT CPI 128 JNZ CLOSEO ; CLOSE1: LXI D,OBUFF LHLD XOBUFF MOV A,H CMP D JNZ CLOSE3 MOV A,L CMP E JNZ CLOSE3 ; CLOSE2: LXI D,OUTFCB MVI C,CLOSE JMP BDOS ; CLOSE3: MVI C,SETDMA PUSH D CALL BDOS POP D XCHG LXI D,OUTFCB CALL WRTREC LXI D,128 DAD D XCHG LDA XOBUFF+1 CMP D JNZ CLOSE3 LDA XOBUFF CMP E JNZ CLOSE3 JMP CLOSE2 ;..... ; ; ;----------------------------------------------------------------------- ; ; Print line at DE until 0 on console. ; PRTLIN: LDAX D ANA A RZ CALL TYPE INX D JMP PRTLIN ;..... ; ; ; Display the character in the A-register. ; TYPE: PUSH PSW PUSH B PUSH D PUSH H MOV E,A MVI D,N00 MVI C,CONOUT CALL BDOS POP H POP D POP B POP PSW RET ;..... ; ; ; Get character in A from CRT and return Z set if char.AND.5FH = 'Y'. ; CHKYES: MVI C,CONIN CALL BDOS PUSH PSW CALL CRLF POP PSW ANI 0DFH CPI 'Y' RET ;..... ; ; ; Return Z if no character available, otherwise, get character in A. ; CHKIN: MVI C,CONST CALL BDOS ORA A RZ MVI C,CONIN CALL BDOS RET ;..... ; ; CRLF: LXI D,CRLFMG JMP PRTLIN ;..... ; ; ; If HL < base of BDOS - 255 then return NC. Otherwise, return C. ; CHKBDOS:PUSH D XCHG LHLD BDOS+1 DCR H ORA A CALL SBCHLDE ; HL = ^BDOS-^table XCHG POP D RET ;..... ; ; ; Prints the number in HL as a decimal number. ; PDNHL: LXI D,10000 CALL PDDHL LXI D,1000 CALL PDDHL LXI D,100 CALL PDDHL LXI D,10 CALL PDDHL MOV A,L ADI '0' JMP TYPE ;..... ; ; ; Prints on console decimal digits of the number in HL. Call repetit- ; ively with DE equal to 10000, 1000, 100, 10, and 1. Each call prints ; one digit. Do not disturb HL between calls. Enter with C = 0 to sup- ; press leading zeros or C = '0' to print leading zeros. ; PDDHL: MVI B,'0'-1 ; PDD0: INR B ORA A CALL SBCHLDE JNC PDD0 DAD D MOV A,B CPI '0' JNZ PDD1 CMP C RNZ ; PDD1: MVI C,'0' JMP TYPE ;..... ; ; ; Puts to output file the number in HL as a decimal number. ; FDNHL: LXI D,10000 CALL FDDHL LXI D,1000 CALL FDDHL LXI D,100 CALL FDDHL LXI D,10 CALL FDDHL MOV A,L ADI '0' JMP PUTCHR ;..... ; ; ; Puts to output file decimal digits of the number in HL. Call repetit- ; ively with DE equal to 10000, 1000, 100, 10, and 1. Each call prints ; one digit. Do not disturb HL between calls. Enter with C = 0 to sup- ; press leading zeros or C = '0' to print leading zeros. ; FDDHL: MVI B,'0'-1 ; FDD0: INR B ORA A CALL SBCHLDE JNC FDD0 DAD D MOV A,B CPI '0' JNZ FDD1 CMP C RNZ ; FDD1: MVI C,'0' JMP PUTCHR ;..... ; ; ; Print activity dot every 100 lines ; PDOT: LDA LNCNT DCR A STA LNCNT RNZ MVI A,'.' CALL TYPE MVI A,100 ; Dot every 100 lines STA LNCNT LDA DOTCNT DCR A STA DOTCNT JNZ PDOT1 MVI A,' ' CALL TYPE MVI A,10 ; Space every 10 dots STA DOTCNT ; PDOT1: LDA NLCNT DCR A STA NLCNT RNZ CALL CRLF MVI A,50 ; 50 dots per line STA NLCNT RET ;..... ; ; ; Help message ; HELP: DB CR,LF,CR,LF DB 'XLT80 translates Zilog Z80 assembly language source' DB CR,LF DB 'code into Intel 8080 assembly language source code.' DB CR,LF DB 'It is invoked by a command of the form:',CR,LF,CR,LF DB ' XLT80 D:SRCFILE.TYP D:DESTFILE.TYP',CR,LF,CR,LF DB 'All parameters are optional - if omitted, the ',CR,LF DB 'following values are assumed:',CR,LF,CR,LF DB ' Source filetype - MAC',CR,LF DB ' Destination filetype - ASM',CR,LF DB ' Destination filename - same as source filename' DB CR,LF DB ' Drive - current drive',CR,LF,CR,LF DB '[more] ',0 ; HELP1: DB CR,' ',CR,LF,'Examples:',CR,LF,CR,LF DB 'XLT80 PRGM1 (translates PRGM1.MAC ' DB 'to PRGM1.ASM)',CR,LF DB 'XLT80 PRGM1 PRGM2 (translates PRGM1.MAC ' DB 'to PRGM2.ASM)',CR,LF DB 'XLT80 PRGM1.Z80 PRGM2.TXT (translates PRGM1.Z80 ' DB 'to PRGM2.TXT)',CR,LF,CR,LF DB 'XLT80 also has the following features:',CR,LF,CR,LF DB ' Asterisks at the beginning of lines will be ' DB 'replaced with',CR,LF,' semicolons.',CR,LF,CR,LF DB ' A dot is printed on the console for every 100 ' DB 'lines of input',CR,LF,' processed.',CR,LF,CR,LF DB CR,LF,CR,LF,0 ;..... ; ; ; Data area ; BCDETBL:DB '(BC)B',0 DB '(DE)D',0 DB 0 CMNTFL: DB 0 COLNUM: DB N01 CRLFMG: DB CR,LF,0 ELSEFL: DB 0,'ELSE',CR,LF,0 EOJMSG: DB '*** Finished ***',CR,LF,0 EXTBL1: DB 'DE,HL' DB 'XCHG',0 DB 0 EXTBL2: DB '(SP),HL' DB 'XTHL',0 DB 0 FLGSTR: DB '# ',0 INFCB: DB 0,0,0,0,0,0,0,0 DB 0,'MAC',0,0,0,0 DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0 JABTMG: DB CR,LF,'*** Job Cancelled ***',CR,LF,0 LINMSG: DB ' lines in input file processed.',CR,LF,0 MACRFL: DB 0,'MACRO',CR,LF,0 MEMMSG: DB CR,LF,'Ran out of memory for table of line numbers ' DB 'of intrinsic Z80 opcodes.',CR,LF,BELL,0 MREG: DB '(HL)' NDSMSG: DB 'No directory space',CR,LF,BELL,0 NSFMSG: DB 'No source file found',CR,LF,BELL,0 OFEMSG: DB BELL,'Output file exists, delete? (Y/N) ',0 OFWMSG: DB 'Output File Write Error',CR,LF,BELL,0 OPCC: DB 0,0 OPDAD: DB 'DAD',0 OPLDA: DB 'LDA',0 OPLDAX: DB 'LDAX',0 OPLHLD: DB 'LHLD',0 OPLXI: DB 'LXI',0 OPNC: DB 0 OPPCHL: DB 'PCHL',0 OPSTA: DB 'STA',0 OPSHLD: DB 'SHLD',0 OPSPHL: DB 'SPHL',0 OUTFCB: DB 0,0,0,0,0,0,0,0 DB 0,'ASM',0,0,0,0 DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0 POEFLG: DB 0,LF,'Condition code PO or PE found, check ' DB '8080-Z80 difference.',CR,LF,0 PRFNM1: DB 'Source File: ',0 PRFNM2: DB ', Destination File: ',0 OPSTAX: DB 'STAX',0 QUOTFL: DB 0 RPTBL: DB 'BCB',0,0,0 DB 'DED',0,0,0 DB 'HLH',0,0,0 DB 'SPSP',0,0 DB 'AFPSW',0 DB 0 SIGNON: DB CR,LF,'Z80-to-8080 translator v',(VERSION MOD 10)+'0' DB CR,LF,0 TEMP: DB 0 UNKMGF: DB ';',CR,LF,';',CR,LF,';',CR,LF,';',CR,LF,'; Line ' DB 'numbers containing untranslated opcodes:' DB CR,LF,';',CR,LF,';',0 UNKMSG: DB CR,LF,'Line numbers containing untranslated opcodes:' DB CR,LF,CR,LF,0 UPSMSG: DB 0,LF,BELL,'The following operands have been used in ' DB 'your source and have not',CR,LF,'been fully trans' DB 'lated. You must complete the translation using an ' DB 'editor.',CR,LF,CR,LF,0 XCDISK: DB 0 ; LINENO: DW 0 XEND: DW 0 XUNKTB: DW UNKTBL ; LNCNT: DB 100 ; Dot every 100 lines DOTCNT: DB 10 ; Space every 10 dots NLCNT: DB 50 ; 50 dots per line ; ; ; Uninitialized data area ; DS 100 ; Stack depth = 50 levels ; STACK EQU $ IBUFF: DS IBFLEN LBUFF: DS LBUFLN+3 OBUFCT: DS 1 OBUFF: DS OBFLEN OPCBUF: DS OPBFLN SPBDOS: DS 2 XIBUFF: DS 2 XOBUFF: DS 2 XOPCOD: DS 2 XOPRND: DS 2 UNKTBL: DS 1 ;..... ; ; END