+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler 	      ¦
¦	OS interface mm			      ¦
¦					      ¦
¦	Entry: ........... ZAPOS.TX	      ¦
¦	Version: ......... 1.0		      ¦
¦	Startad: ......... 95 10 01	      ¦
¦	Senast ändrad: ... 95 11 17	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Initierande equates

FALSE:		EQU	0
TRUE:		EQU	NOT FALSE
		REFS	ZAPWKEQU
WRK:		REF
ASC:		REF
PZAP:		EQU	FALSE
ICTRL$:		EQU	4		;Längden av ICTRL
		REFS	SYSEQU
RAM:		REF
		REFS	MONEQU
FFLP:		REF
		IF	WRK OR ASC
PGM:		EQU	RAM
		ELSE
PGM:		EQU	0E000H
		ENDC
		REM	SYSEQU
		REFM	SYSMAC
		FILE	ZAPDRV
		ORG	PGM
		IDNT	$,$
		WIDTH	12,96
		Z80


; Egna makron
; FCAL anropar en rutin i FCMAP

		MACRO	FCAL
		CODE	CI,LOW(FASTFC),HIGH(FASTFC)
		DATA	WORD
		ENDM


; ICTRL genererar en datastruktur bestående av:
; 1. byte, opkod eller opkodsskelett, default 0.
; 2. ord,  offset till instruktionshanteraren.
; 3. byte, info om instruktionen, default 0.

		MACRO	ICTRL 0,,0
		DATA	BYTE,WORD,BYTE
		ENDM


; Installation och uppstart
; IN:	 A	funktionskod
;	HL	reserverat
; UT:	 A	felkod, 0 = ok

ZAP:		LD	(ZAPSP),SP
		PUSH	AF
		Text	'Pons Assembler 1.0 951001'
		XOR	A
		LD	IX,KORD		;IX ska vara KORD alltid
		LD	(IX+$FOUT),A
		LD	(IX+$FOPT1),A
		LD	(IX+$FOPT2),A
		LD	(IX+$USERX),A
		POP	AF
		SCAL	ZJUMP
		DW	ZAPNOR		;0 ZAP normal
		DW	ZAPASC		;1 ASC
ZAPASC:		SET	BASC,(IX+$USERX);Extern användare
		LD	(ZAPLNK),HL	;Pekaren dit
		JR	ZAP1
ZAPNOR:		LD	HL,GTRET	;Default retur i ZAPLNK
		LD	(ZAPLNK),HL
ZAP1:		LD	HL,(MAP)	;Spara för återställning
		LD	(MAPSAV),HL
		LD	HL,(BREAK)	;Spara BREAK
		LD	(BRKSAV),HL
		LD	HL,ZAPEXI	;Ny BREAK
		LD	(BREAK),HL
		LD	HL,ZAP
		LD	DE,ZAP$
		SCAL	ZCRCA		;Stämmer CRC?
		IF	WRK
		XOR	A
		ENDC
		JP	NZ,ZAPER	;Nej, illa
		SSCV	ZFCAL		;CALL FASTFC är mycket snabbare
		LD	(ZAPFCA),HL	;än SCAL ZFCAL
		SSCV	ZFCAL		;Tack för lånet
		CALL	LFCEXT		;Ladda FCAL extension
		FCAL	@FCEXT		;Init FC
		IF	WRK
		RST	BRKPT
		ENDC
		LD	HL,SSY		;Init symboltabellen
		LD	(SYS),HL	; start
		LD	(SYE),HL	; stopp
		CALL	MAPSY		;In med SY
		XOR	A
		LD	(HL),A		;Sista symbolen
		CALL	MAPRS		;In med RS
		LD	HL,SRS
		LD	(RSE),HL
		LD	(HL),A		;Tomt där med
		CALL	MAPTX		;Källkoden i TX
		LD	HL,(CLINP)	;Pekar på kommandoraden
		LD	(ZCLINP),HL
		FCAL	@INPUT		;Ta raden
		FCAL	@MAIN		;Gör jobbet
		CALL	WRSY		;Skriv symboltabellen
		FCAL	@WRMC		;Skriv makrotabellen
		LD	HL,(FELR)
		OR	HL		;Några fel?
		JR	Z,ZAP2		;Nej
ZAPEXI:		BIT	BNABO,(IX+$FOPT2);Undertrycka abort go?
		JR	NZ,ZAP2		;Ja
		PUSH	AF
		SCAL	ZCFMA		;CFMA gör CR
		POP	AF
ZAP2:		SCAL	ZNNOM		;Ass lo lo
		LD	HL,(EP2CPI)	;Återställ printern
		FCAL	@WIDTH
		CALL	MAPXX		;Leave
		LD	HL,(BRKSAV)	;Återställ BREAK
		LD	(BREAK),HL
		LD	SP,(ZAPSP)
		RET


; Ladda in Zaps extension

LFCEXT:		LD	HL,FCESC*256+FCMAP
		LD	(UXMAP),HL	;Map & esc för ZFCAL
		LD	HL,SFC
		LD	(UXSTAB),HL	;Adr. till rutintabellen
		CALL	MAPFC		;In med FC
		LD	DE,LFCFCB
		LD	HL,WKFCB
		IF	WRK
		LD	BC,4*256+33H	;SAT först
		ELSE
		LD	BC,4*256+32H	;Tillåt assignad GO
		ENDC
		SCAL	ZLFN
		CALL	ZAPER
		DEC	HL
		LD	(HL),C		;Drive för GO
		XOR	A		;Skippa 0
		LD	HL,SFC		;Start
		LD	DE,TOP		;Stopp
		CALL	READ		;Läs filen
		RET	Z		;Z = ok
		DEC	A		;Filen för stor?
		JP	Z,MEMOV		;Ja
		LD	A,B		;Felkod från dos
		JP	ZAPER
		IF	PZAP
LFCFCB:		DB	'ZAPFCAL.GO',0
		ELSE
LFCFCB:		DB	'PZAPEXT.GO',0
		ENDC


; Anropa en rutin i FCMAP
; FCAL gör CALL FASTFC

FASTFC:		PUSH	HL
		LD	HL,(ZAPFCA)	;Adress till ZFCAL i dos
		EX	(SP),HL
		RET


; ZAP är klar, åter till anroparen

MAPXX:		PUSH	HL
		LD	HL,(MAPSAV)
		JR	MAPIN


; Mappa in SXBUF, SXMAP
; UT:	HL	förra map och escape

MAPSX:		LD	HL,(MAP)
		PUSH	HL
		LD	HL,SXESC*256+SXMAP
		JR	MAPIN


; Mappa in objektkoden, OCMAP

MAPOC:		LD	HL,(MAP)
		PUSH	HL
		LD	HL,OCESC*256+OCMAP
		JR	MAPIN


; Mappa in symboltabellen, SYMAP

MAPSY:		PUSH	HL
		LD	HL,SYESC*256+SYMAP
		JR	MAPIN


; Mappa in den "remota" symboltabellen, RSMAP

MAPRS:		PUSH	HL
		LD	HL,RSESC*256+RSMAP
		JR	MAPIN


; Mappa in FCAL-rutinerna, FCMAP

MAPFC:		PUSH	HL
		LD	HL,FCESC*256+FCMAP
		JR	MAPIN


; Mappa in källkoden, TXMAP

MAPTX:		PUSH	HL
		LD	HL,TXESC*256+TXMAP
		JR	MAPIN


; Återställ map & escape
; IN:	HL	map & escape

ANYMAP:		PUSH	HL


; Välj in en ny minnesmap
; IN:	 H	escape
;	 L	map
; UT:	Allt orört

MAPIN:		PUSH	AF
		LD	(MAP),HL
		LD	A,H
		OUT	(EMAP0),A	;Map 0 escape
		LD	A,L
		OUT	(SMAP),A	;Välj map
		POP	AF,HL
		RET


; ZAP error handler
; IN:	 A	felkod; 0 är inget fel

ZAPER:		OR	A
		RET	Z
		PUSH	AF
		SCAL	'N'
		COVR	'Emsg'
		Text	'/Zap'
		POP	AF
		JP	ZAPEXI


; Abortera om BREAK trycks ned

CKBRK:		LD	A,2
		CALL	FFLP
		IN	A,(0)
		IF	WRK
		CP	0AFH		;Escape?
		JR	Z,break		;Ja
		ENDC
		OR	80H
		CP	-1-38H		;CTRL/SHIFT/@?
		RET	NZ
		IF	NOT(WRK)
		JP	ZAPEXI		;Bryt
		ELSE
break:		LD	HL,(BREAK)
		PUSH	HL
		LD	HL,(BRKSAV)
		LD	(BREAK),HL
		RST	BRKPT
		POP	HL
		LD	(BREAK),HL
		RET
		ENDC


; Bestäm nästa fil att assemblera

GET:		LD	B,(IX+$FASS)	;Antal filer
		LD	HL,IFCB-21
		LD	DE,21
GT1:		ADD	HL,DE		;Sök filens FCB
		DJNZ	GT1
		CALL	COPFCB
		LD	A,(FASS)
		BIT	BFRCRD,(IX+$MISC1);Forcerad inläsning?
		JR	NZ,GT2		;Ja
		CP	(IX+$RASF)	;FASS=RASF=1 om FILR = 1
		RET	Z
GT2:		LD	(RASF),A


; Läs in fil att assemblera. Kolla filens CRC
; om bit BTXCRC är satt i SFLAG.
; IN:	TXMAP 1a gången från DOPASS
; UT:	TXMAP

HGET:		LD	(IX+$RETRY),RCTR ;Retry counter
HT1:		XOR	A		;Skippa 0
		LD	HL,STX		;KK start
		LD	DE,TOP		;Max för kk
		CALL	READ
		JR	Z,HT3		;Z = ok
		DEC	A		;Filen för stor?
		JP	Z,MEMOV		;Ja
		LD	A,B
HT2:		JP	ZAPER
HT3:		LD	(ETX),DE	;KK stopp
		LD	A,CR
		LD	(DE),A
		LD	A,(SFLAG)
		BIT	BTXCRC,A	;Kolla CRC?
		JR	Z,HT4		;Nej
		CALL	FILCRC		;CRC ok?
		JR	Z,HT4		;Ja
		DEC	(IX+$RETRY)	;Försöka mer?
		JR	NZ,HT1		;Ja
		JR	HT2
HT4:		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	Z		;Nej
		BIT	BASC,(IX+$USERX);Informera om ny fil?
		RET	Z		;Nej
		LD	HL,(ZAPLNK)
		CALL	JPHL		;Gå till user x
GTRET:		RET


; Kopiera FCB (HL) till WKFCB
; IN:	HL	pekar på drive i FCB

COPFCB:		LD	BC,21
		LD	DE,WKDRV
		LDIR			;Till WKFCB


; Skriv ut namn och drive i WKFCB

PWFCB:		LD	HL,WKDRV	;Drive
		LD	C,(HL)
		INC	HL		;WKFCB
		SCAL	ZFCB		;Skriv ut filnamnet
		Text	'.'
		RET


; Skriv symbolfilen till disken
; Beräkna CRC först om BSYCRC är 1.

WRSY:		BIT	BSYSAV,(IX+$FOPT1);Symbolfil?
		RET	Z		;Nej
		LD	HL,(FELR)
		OR	HL		;Några fel?
		JR	Z,WY1		;Nej
		Text	'(No symbolfile created)'
		RET
WY1:		CALL	MAPSY
		LD	HL,(SYE)
		LD	B,0
WY2:		INC	HL
		LD	(HL),-1
		DJNZ	WY2
		LD	A,(SYDRV)
		LD	C,A
		SCAL	ZRDIR
		CALL	ZAPER
		SBC	HL,HL
		LD	(SYFCB+FSFL),HL
		LD	(SYFCB+FLDA),HL
		LD	(SYFCB+FEXA),HL
		LD	HL,(NXTSEC)
		LD	(SYFCB+FSEC),HL
		PUSH	HL
		LD	HL,(SYE)
		LD	DE,(SYS)
		LD	A,(SFLAG)
		BIT	BSYCRC,A	;Generera CRC på SY?
		JR	Z,WY3		;Nej
		PUSH	HL,DE
		EX	DE,HL
		INC	DE
		SCAL	ZCRCA
		LD	(SYFCB+FEXA),HL	;Spara CRC i FEXA
		POP	DE,HL
WY3:		PUSH	DE
		OR	A
		SBC	HL,DE
		INC	H
		LD	L,H
		LD	H,0
		LD	(SYFCB+FNSC),HL
		LD	B,L
		POP	HL,DE
		SCAL	ZDWR
		CALL	ZAPER
		LD	HL,SYFCB


; Katalogisera skapad fil

ENTER:		SCAL	ZENTER		;Enter filen. Gick bra?
		RET	Z		;Ja
		CP	31H		;Finns namnet redan?
		JP	NZ,ZAPER	;Nej, annat fel
		PUSH	HL		;FCBX
		LD	HL,SXFCB+FSFL
		BIT	0,(HL)		;Låst fil?
		LD	A,33H
		JP	NZ,ZAPER	;Ja
		SET	1,(HL)		;Deleta den då
		LD	HL,SXFCB
		SCAL	ZREPL
		POP	HL
		FCAL	@DMSG		;Tala om det
		JR	ENTER		;Försök igen


; Kolla om det finns något i SB. Nollställ resten
; av sektorn i så fall och skriv

ZFILL:		LD	HL,(SBPTR)
		LD	DE,SB
		OR	A
		SBC	HL,DE		;SB tom?
		ADD	HL,DE
		RET	Z		;Ja
		PUSH	HL,DE,BC,HL
		CALL	MAPOC		;Mappa in OC
		EX	(SP),HL		;Förra map & esc
		JR	ZL2
ZL1:		LD	(HL),0
		INC	HL
ZL2:		LD	A,L
		OR	A
		JR	NZ,ZL1
		LD	DE,SB
		SBC	HL,DE
		LD	B,H		;Antal sektorer
		CALL	WROC
		JR	WREXI


; Fyll på SB med en byte till och skriv till
; disken om det blir fullt
; IN:	 A	byte att skriva
;	Allt reserverat utom A
; OBS!	SB måste starta på jämn sektor

DISK:		PUSH	HL,DE,BC
		CALL	MAPOC		;Mappa in OC
		PUSH	HL		;Förra map & esc
		LD	HL,(SBPTR)
		LD	(HL),A
		INC	HL
		LD	DE,SB$
		OR	A
		SBC	HL,DE		;SB full?
		ADD	HL,DE
		LD	B,SBNSC		;Default
		CALL	NC,WROC		;Ja
WREXI:		LD	(SBPTR),HL
		POP	HL
		CALL	ANYMAP		;Återställ
		POP	BC,DE,HL
		RET


; Skriv objektkoden i SB till disken
; IN:	 B	antal sektorer att skriva
;	OCMAP
; UT:	 B	orört
;	 C	drive
;	DE	startsektor
;	HL	SB
;	SEKTOR uppdaterad

WROC:		LD	HL,SB
		PUSH	HL
		LD	DE,(SEKTOR)
		LD	A,(OCDRV)
		LD	C,A
		SCAL	ZDWR
		CALL	ZAPER
		LD	H,A		;A = 0
		LD	L,B
		ADD	HL,DE
		LD	(SEKTOR),HL
		POP	HL
		RET


; Läs en fil från disken
; IN:	 A	skip vid bakåtstegning
;	HL	laddadress
;	DE	övre gräns
;	WKFCB initierat, lämplig map invald
; UT:	AF	status där:
;	 Z	allt ok
;	HL	laddadress
;	DE	pekar på filens sista byte
;	NZ	något är fel
;     NZ 1	filen är för stor
;     NZ 2	fel vid läsning; B = felkod från dos

READ:		PUSH	AF,HL
		LD	A,(WKFCB+FNSC)
		LD	B,A
		LD	C,0
		ADD	HL,BC		;+ storleken
		LD	A,1
		JR	C,RD2		;C = för stor
		EX	DE,HL
		SBC	HL,DE		;Får filen plats?
		JR	C,RD2		;Nej
		POP	HL		;Laddadress
		PUSH	DE		;Filens slut
		LD	A,(WKDRV)
		LD	C,A
		LD	DE,(WKFCB+FSEC)
		SCAL	ZDRD		;Ladda in den
		EX	DE,HL		;DE laddadress
		LD	B,A
		LD	A,2
		JR	NZ,RD2		;NZ = gick inte
		POP	HL,AF
RD1:		DEC	HL
		CP	(HL)
		JR	Z,RD1
		EX	DE,HL		;HL start, DE slut
		XOR	A
		RET
RD2:		OR	A
		POP	HL,HL
		RET


; Kolla CRC på en symbolfil om BSYCRC = 1.
; IN:	HL	startadress
;	DE	stoppadress
; UT:	AF	Z: CRC ok, NZ: CRC-fel
;	resten orört

SYCRC:		LD	A,(SFLAG)
		BIT	BSYCRC,A	;Kolla CRC på SY?
		RET	Z		;Nej


; Kolla CRC på en fil, som lästs med READ
; IN:	HL	startadress
;	DE	stoppadress
; UT:	AF	Z: CRC ok, NZ: CRC-fel
;	resten orört

FILCRC:		PUSH	HL,DE
		INC	DE
		SCAL	ZCRCA
		LD	DE,(WKFCB+FEXA)
		SBC	HL,DE
		POP	DE,HL
		RET


; Deaktivera printer, skriv mot CRT

SCREEN:		CALL	EJECT
		RES	BUPR,(IX+$FOUT)	;Nästa output till CRT
		RET


; Aktivera printern

ACTPRN:		SET	BUPR,(IX+$FOUT)	;Till printern


; Printer formfeed

EJECT:		BIT	BPRINT,(IX+$FOPT1);Printer begärd?
		RET	Z		;Nej
		LD	HL,PLCT
		LD	A,(PPOS)
		OR	(HL)		;Göra formfeed?
		RET	Z		;Nej
		LD	A,FF
		RST	ROUT
		RET


; Uttabell

OUTTB:		DB	ZUOUT,0


; Utmatningsrutin

OUTPUT:		FCAL	@TXOUT		;Resten i FC
		RET


; Lista raden och eventuell objektkod

LIST:		BIT	BERRM,(IX+$LFLG1);Felmeddelande?
		JR	NZ,LT1		;Ja
		BIT	BPASS,(IX+$FPASS);Pass 1?
		RET	Z		;Ja
		BIT	BLIST,(IX+$FOPT1);Printerlistning?
		RET	Z		;Nej
		BIT	BNOLO,(IX+$FOUT);Lista denna rad?
		RET	NZ		;Nej
		BIT	BCOND,(IX+$LFLG1);Gällande villkor?
		JR	Z,LT1		;Nej
		BIT	BDEL,(IX+$FOPT1);Undertrycka villkor?
		RET	NZ		;Ja
LT1:		PUSH	IY
		LD	IY,(LINE)	;Kopiera hela raden
		CALL	TXCOPY
		POP	IY
		FCAL	@LIST		;Resten i FC
		JP	MAPTX		;Bort med map 31!


; Minnet räcker inte till

MEMOV:		FCAL	@MEMOV		;Ingen retur från @MEMOV


; Felhanterare, aborterande

ERROR:		CALL	FEL
		LD	HL,(ADRESS)
		LD	(LCCT),HL
		LD	HL,(HIADRESS)
		LD	(HILCCT),HL
		CALL	MAPTX		;In med kk
		LD	SP,(RESP)
		JP	ASMLIS


; Felrapporterare
; IN:	 A	felkod

FELHLZ:		LD	HL,0
		LD	DE,0
		LD	(VALUE),HL
		LD	(HIVALUE),HL
		LD	(INDEX),HL
		LD	(HIINDEX),HL
FEL:		FCAL	@FEL
		RET


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler 	      ¦
¦	Hantera pass och uttryck	      ¦
¦					      ¦
¦	Entry: ........... ZAPDRV.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... 		      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Styrrutin för ett pass (1 eller 2)

FCPASS:		LD	HL,(MAP)	;DOPASS kräver TXMAP
		PUSH	HL
		CALL	MAPTX
		CALL	DOPASS
		EX	(SP),HL
		CALL	ANYMAP
		POP	HL
		RET
DOPASS:		CALL	CLOSE		;Stäng REFS
		CALL	ACTPRN		;Printer formfeed
DS1:		RES	BUPR,(IX+$FOUT)	;Skriv mot CRT
		Print	'Pass '
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	NZ,DS2		;Ja
		Print	'one'
		JR	DS3
DS2:		Print	'two'
DS3:		Print	': '
		BIT	BFILE,(IX+$MISC1);FILE påträffad?
		RES	BFILE,(IX+$MISC1)
		JR	Z,DS4		;Nej
		LD	HL,FLDRV
		CALL	COPFCB		;Skriv namnet
		CALL	HGET		;Läs in filen
		OR	-1		;NZ
DS4:		CALL	Z,GET		;Ta in nästa fil om fler
		CALL	ACTPRN		;Printer formfeed
		LD	IY,STX		;Källkodens början
		SET	BUPR,(IX+$FOUT)	;Skriv mot printern
DS5:		CALL	CKBRK
		LD	HL,IY		;HL radens början
		LD	DE,(ETX)
		XOR	A
		SBC	HL,DE		;Passet klart?
		JR	NC,DS6		;Ja
		CALL	ASSEMB		;Assemblera raden
		BIT	BEND,(IX+$LFLG1);END påträffad?
		JR	Z,DS5		;Nej
		RET
DS6:		BIT	BFILE,(IX+$MISC1);FILE påträffad?
		JR	NZ,DS1		;Ja
		LD	A,(FASS)
		CP	(IX+$FILR)	;Assemblerat alla?
		RET	NC		;Ja
		INC	(IX+$FASS)	;Gör nästa
		JR	DS1


; Assemblera en rad
; IN:	 A	0
;	TXMAP
; UT:	TXMAP

ASSEMB:		LD	(RESP),SP	;Retur DOPASS
		LD	HL,A
		LD	(LFLG1),HL	;Alla radflaggor = 0
		LD	(LFLG3),A
		LD	(IFLG2),A
		LD	(SEP),HL	;Inget tecken efter adr, OFOBJ=0
		LD	HL,(LCCT)	;Förra instruktionens
		LD	(ADRESS),HL	;slut är dennas start
		LD	(RACTR),HL	;För RA också
		LD	HL,(HILCCT)
		LD	(HIADRESS),HL
		LD	(HIRACTR),HL
		LD	(LINE),IY	;IY radens 1a tecken
		LD	A,(IY)
		CP	CR		;Tom rad?
		JR	Z,ASMLIS	;Ja
		CP	FF		;Formfeed?
		JR	NZ,AB1		;Nej
		CALL	EJECT		;Gör formfeed
		INC	IY		;Nästa tecken
		LD	A,(IY)
		CP	CR		;Tom rad?
		JR	Z,NÄSTA		;Ja
AB1:		CP	';'		;Kommentar?
		JR	Z,ASMLIS	;Ja
		CP	'*'		;Kommentar?
		JR	Z,ASMLIS	;Ja
		CP	EKST		;Extra kommentar?
		CALL	Z,FÖRBI		;Ja, förbi allt tom ]
		CP	CR		;CR efter ]?
		JR	Z,ASMLIS	;Ja
		OR	A		;Grafiskt tecken?
		JP	M,ASMLIS	;Ja, kommentar
		LD	HL,(VILLK)	;Sätts FF av DOPASS
		BIT	0,(HL)		;Ska raden assembleras?
		JR	NZ,AB3		;Ja
		SET	BCOND,(IX+$LFLG1);Villkor gäller
		CP	BLANK
		JR	Z,AB2
		CP	TAB
		JR	NZ,ASMLIS
AB2:		CALL	IYTKN		;Förbi blank och tab
		CALL	CKIF		;Pseudo-op på raden?
		JR	C,ASMLIS	;Nej
		JR	AB4
AB3:		CALL	LABEL		;Finns label, så ta den
		CALL	TECKEN		;Förbi blank och tab
		CP	CR		;Vid CR?
		JR	Z,AB5		;Ja
		CP	';'		;Vid ;?
		JR	Z,AB5		;Ja
		LD	A,(DDFLAG)	;Minns om förra raden var
		LD	(LASTDDFLAG),A	;ett DDIR direktiv
		LD	(IX+$DDFLAG),0
		SET	BPADDR,(IX+$LFLG1);Skriv adressen i LIST
		CALL	STMNT		;Ta opkodsfält + resten
		JP	NZ,ERR8		;NZ = ogiltig operand
		CALL	MAPTX		;In med TX
AB4:		LD	A,(IY)
		CALL	SLUT		;Raden slut resten ktar?
		JP	C,ERR5		;Nej, syntaxfel
AB5:		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	NZ,ASMLIS	;Ja
		BIT	BEXLBL,(IX+$LFLG1);Dubbel label?
		LD	A,13
		JP	NZ,ERROR	;Ja
ASMLIS:		CALL	LIST		;Skriv ut raden
		RES	BNOLO,(IX+$FOUT);Lista nästa rad


; Gå till nästa rad
; IN:	IY	någonstans i raden
; UT:	IY	pekar på nästa rad

NÄSTA:		LD	A,CR
		LD	BC,0
		LD	HL,IY
		CPIR
		LD	IY,HL
		RET


; Kolla 1a tecken på raden, sök i symboltabellen
; om det är en label & om den inte finns förut,
; så sätt in den i tabellen med sitt värde.
; IN:	TXMAP
; UT:	IY pekar på 1a tecken efter labeln och
; om kolon finns, efter det.

LABEL:		LD	A,(IY)
		CP	TAB
		RET	Z
		CP	BLANK
		RET	Z
		SET	BPADDR,(IX+$LFLG1);Skriv adressen i LIST
		CALL	SYCOPY		;Kopiera till SCRWRK
		LD	HL,(SYS)	;Kolla om labeln redan
		CALL	SÖKIYS		;finns i symboltabellen
		JR	NC,LL3		;Ja, den finns
		LD	HL,RESWTB	;Gå igenom 5 tabeller,
		LD	B,5		;börja m reserverade ord
LL1:		PUSH	BC
		CALL	SÖKIY		;Reseverat ord?
		POP	BC
		JR	NC,LL2		;Ja
		INC	HL
		DJNZ	LL1		;Nästa tabell
		CALL	INSERT		;Sätt in i SY
		JR	LL4
LL2:		LD	A,12		;Reserved word
		CALL	FEL
		JR	LL5
LL3:		SET	BEXLBL,(IX+$LFLG1);Lbl finns förut men
		EX	DE,HL		;det kan ju vara SET
LL4:		LD	(ASYVAL),HL	;Sätt in labelns värde
		LD	DE,(LCCT)
		LD	(HL),E
		INC	HL
		LD	(HL),D
		INC	HL
		LD	DE,(HILCCT)
		LD	(HL),E
		INC	HL
		LD	(HL),D
		SET	BLABEL,(IX+$LFLG1);Raden har en label
LL5:		CALL	AVANTI
		LD	A,(IY)
		CP	':'
		RET	NZ
		INC	IY
		RET


; Återställ TXMAP och IY
; Stega IY förbi blank och TAB

AVANTI:		CALL	MAPTX		;In med kk
		LD	IY,(PASTSY)
		CALL	TECKEN
XORRET:		XOR	A
		RET


; Kopiera en symbol från källkoden till SCRWRK
; IN:	IY	pekar på symbolen
;	TXMAP
; UT:	IY	pekar på symbolen i SCRWRK
;	PASTSY pekar på 1a tecken efter symbolen
;	SYMAP

SYCOPY:		LD	HL,IY
		LD	DE,SCRWRK
		PUSH	DE
SY1:		LD	A,(HL)
		LDI
		CALL	EXTEND		;Godkänt tecken?
		JR	NC,SY1		;Ja
		DEC	HL
		LD	(PASTSY),HL
		POP	IY
		JP	MAPSY


; Subrutin till LABEL och REMOTE, som sätter in
; symbolen i symboltabellen
; IN:	IY	pekar på symbolen i SCRWRK
;	SYMAP

INSERT:		PUSH	IY
		LD	A,(IY)
		CALL	TILLÅT		;Tillåtet tecken?
		LD	A,10		;Invalid label
		JP	C,ERROR		;Nej
		LD	BC,0
IT1:		INC	IY,C		;Räkna antal tecken
		LD	A,(IY)
		CALL	EXTEND		;Tillåt lbl med siffror
		JR	NC,IT1		;NC = godkänt
		LD	HL,(SYE)
		PUSH	HL
		ADD	HL,BC
		INC	HL,4
		LD	DE,(SYSTAR)
		DEC	DE
		OR	A
		SBC	HL,DE		;Får labeln plats?
		ADD	HL,DE
		JP	NC,MEMOV	;Nej
		LD	(SYE),HL
		LD	(HL),0		;Stopptecken i SY
		POP	DE,HL
		LDIR			;Kopiera labeln till SY
		EX	DE,HL
		DEC	HL
		SET	7,(HL)
		INC	HL
		RET


; Hämta ett tecken ur källkoden
; Används av FCAL-rutiner, som inte behöver
; kopiera hela raden
; IN:	Allt reserverat
; UT:	 A	=(IY)

FCCHAR:		PUSH	HL		;HL
		LD	HL,(MAP)	;Okänd map
		CALL	MAPTX		;In med TX
		LD	A,(IY)		;Tack
		CALL	ANYMAP		;Okänd map tillbaka
		POP	HL
		RET


; Gå förbi komma, blank, tab och []
; Används av FCAL-rutiner, som inte behöver
; kopiera hela raden
; IN:	Allt reserverat
; UT:	 A	=(IY)

FCKOMMA:	PUSH	HL		;HL
		LD	HL,(MAP)	;Okänd map
		CALL	MAPTX		;In med TX
		CALL	KOMMA
		CALL	ANYMAP		;Okänd map tillbaka
		POP	HL
		RET


; Gå förbi komma, blank, tab och []
; Stega INTE förbi komma om CKGM är aktiv.
; IN:	Allt reserverat
; UT:	 A	=(IY)

KOMMA:		BIT	BSTEP,(IX+$LFLG2);Stega förbi komma?
		RET	NZ		;Nej
		LD	A,(IY)
		CP	','
		RET	NZ


; Gå förbi blank och tab.
; Stanna vid nästa tecken
; UT:	 A	=(IY)

IYTKN:		INC	IY
TECKEN:		LD	A,(IY)
		CP	TAB
		JR	Z,IYTKN
		CP	BLANK
		JR	Z,IYTKN
		CP	EKST		;Extra kommentar?
		RET	NZ		;Nej
		CALL	FÖRBI
		JR	TECKEN


; Gå förbi alla tecken inom [] nestat
; Om kommentaren inleds med [* ignoreras nestning och
; istället fungerar *] som slut på kommentarsblocket.
; IN:	IY	pekar på [
;	Allt reserverat utom AF
; UT:	IY	pekar på nästa tecken efter ]
;	 A	=(IY)

FÖRBI:		PUSH	HL,DE,BC
		LD	(IX+$COMMENT),0
		LD	DE,IY
		LD	HL,(ETX)	;Textens slut
		OR	A
		SBC	HL,DE		;Antal byte kvar
		LD	BC,EKSP*256+CR	;B stopptecken för extra
		LD	A,(IY+1)
		CP	'*'		;Ignorera nestning?
		SET	BNONEST,(IX+$MISC1)
		JR	Z,förbi1	;Ja
		RES	BNONEST,(IX+$MISC1)
förbi1:		LD	A,(DE)
		INC	DE
		CP	B		;Funnit ]?
		JR	NZ,förbi3	;Nej
		BIT	BNONEST,(IX+$MISC1) ;Ignorera nestning?
		JR	Z,förbi2	;Nej
		DEC	DE,2
		LD	A,(DE)
		INC	DE,2
		CP	'*'		;Funnit *]?
		JR	Z,förbi6	;Ja, ut
		JR	förbi4
förbi2:		DEC	(IX+$COMMENT)	;Lika många vänster som höger?
		JR	Z,förbi6	;Ja, ut
		JR	förbi4
förbi3:		CP	C		;Raden slut?
		JR	Z,förbi7	;Ja
		CP	EKST		;Ny kommentar?
		JR	NZ,förbi4	;Nej
		INC	(IX+$COMMENT)
förbi4:		DEC	HL
		OR	HL		;Texten slut?
		JR	NZ,förbi1	;Nej
förbi5:		LD	A,41		;Terminator missing
		JP	ERROR
förbi6:		LD	A,(DE)		;Första tecken efter sista ]
		LD	IY,DE
		POP	BC,DE,HL
		RET
förbi7:		PUSH	HL,BC
		CALL	ASMLIS		;Lista ut raden
		LD	(LINE),IY	;Nästa rad
		LD	DE,IY
		POP	BC,HL
		JR	förbi4


; Det är en instruktion, ett pseudodirektiv eller makro.
; Första positionen i opkodsfältet ger (oftast)
; adressen till fortsättningstabellen.
; För instruktioner av typ dst,src gäller:
; UT:	 A	=H
;	 B	typ av operand (dst kombinerad med src)
;	 C	opkodsskelett
;	DE	D dst (reg1), E typ
;	HL	H src (reg2), L typ; LOW(dd) om (IR+dd)
;	IY	nästa tecken
;	 F	CY: 0, NZ: uttryck inom <>, annars Z
; Om bit IMDATA = 1 är DE och HL skiftade.
; Om bit RAMODE = 1 får man skriva uttryck inom <>.
; Om bit XMODE = 1 får man skriva (IR+dd) eller <IR+dd>.

STMNT:		PUSH	IY
		LD	HL,POS1		;Börja i position 1
		CALL	SÖKHL
		JR	NC,ST1		;NC = finns
		INC	HL		;Övriga instruktioner
ST1:		CALL	SÖKIY
		JR	NC,ST2		;NC = finns
		POP	IY
		CALL	CKIF		;Villkor?
		RET	NC		;Ja, redan klart
		CALL	CKGM		;Makro?
		RET	NC		;Ja, redan klart
		LD	A,9		;Unknown instruction
		JP	ERROR
ST2:		POP	BC		;Glöm gamla IY
		BIT	7,L		;Instruktion med cc?
		CALL	NZ,GETCC	;Ja, ta cc
		LD	(IX+$IFLG1),H	;Kan vara flaggor
		LD	C,H		;Kan också vara opkod
		LD	A,L		;Bit 7=0. L index i JOB
		LD	H,0		;HL index i JOB
		ADD	HL,HL
		LD	DE,JOB
		ADD	HL,DE		;Gå in i JOB
		LD	E,(HL)
		INC	HL
		LD	D,(HL)
		PUSH	DE		;Kan vara rutin direkt
		CP	KLASS1		;Jobb i klass 1?
		RET	C		;Ja, gå dit
		LD	(IX+$GGR),1	;Default multipel
		CP	KLASS2		;Klass 2?
		JR	NC,ST4		;Nej, högre
		CALL	EXPR		;Kanske multipel
		JR	Z,ST3		;Z = ingen multipel
		CALL	OPLBL		;Definierad symbol väl?
		CALL	TRUNKA		;Max 255?
		LD	(IX+$GGR),L	;Ja. Anropa adressen på
ST3:		JP	DO_MEX		;stacken L gånger
ST4:		LD	HL,DOEX		;Lägg ev. till EX sist
		EX	(SP),HL
		LD	(MULTIX),HL	;För multipla operander
		PUSH	HL,AF		;A = klass
		CALL	EXPR		;Utvärdera dst
		LD	A,(OPFLG)
		AND	1		;Minns om dst har någon
		LD	(SXPOS),A	;odefinierad symbol
		PUSH	HL
		LD	HL,(VALUE)
		LD	(INDEX),HL	;Första operandens index
		LD	HL,(HIVALUE)
		LD	(HIINDEX),HL
		POP	HL,AF
		CP	KLASS3		;Jobb i klass 3?
		JP	C,ST16		;Ja, gå dit
		CP	KLASS4		;Jobb i klass 4?
		JR	NC,ST5		;Nej, högre
		POP	AF		;Glöm HL
		CALL	FIXEX		;Kanske EX först
		LD	E,(IX+$LFLG2)	;Radflaggor
		LD	A,D		;A operandtyp
		OR	A
		FCAL	@MULTI		;Multipla operander
		RET
ST5:		LD	B,A		;B = klass
		LD	A,D
		PUSH	HL,AF		;Värde och typ
		CALL	EXPR		;Utvärdera src
		LD	C,A		;C = typ av src
		LD	A,(OPFLG)
		RRA			;Minns om också src har
		RL	(IX+$SXPOS)	;odefinierad symbol
		LD	A,B
		CP	KLASS5		;Jobb i klass 5?
		JR	NC,ST6		;Nej, högre
		LD	A,(IY)
		CALL	SLUT		;Raden slut, kommentar?
		JR	Z,ST8		;Ja
		PUSH	HL,BC		;Nej, DDIR
		LD	C,0C0H		;Opkodsskelett för DDIR
		CALL	IDDIR
		LD	A,(DDFLAG)
		LD	(LASTDDFLAG),A
		LD	(IX+$DDFLAG),0
		POP	BC,HL
		JR	ST8
ST6:		SET	BDOME,(IX+$LFLG3);Gör DO_ME
		PUSH	HL,DE		;Klass 6 får ha multipel
		LD	HL,(VALUE)	;Multipeln skriver över
		LD	DE,(HIVALUE)
		PUSH	HL,DE
		CALL	EXPR		;Kanske multipel
		JR	Z,ST7		;Z = ingen multipel
		CALL	OPLBL		;Definierad symbol väl?
		CALL	TRUNKA		;Max 255
		LD	(IX+$GGR),L
ST7:		POP	DE,HL
		LD	(VALUE),HL
		LD	(HIVALUE),DE
		POP	DE,HL
ST8:		BIT	BCOPY,(IX+$IFLG1);Kopiera till LINBUF?
		JR	Z,ST9		;Nej
		PUSH	BC,HL
		LD	HL,(MAP)
		PUSH	HL
		CALL	TXCOPY		;Kopiera raden
		POP	HL
		CALL	ANYMAP
		POP	HL,BC
ST9:		POP	AF,DE
		RLCA	4		;Kombinera typerna för
		OR	C		;dst och src (dst i hög)
		EX	(SP),HL		;HL tabellens adress (?)
		PUSH	DE
		BIT	BFCT,(IX+$IFLG1);Ligger tabellen i FC?
		JR	Z,ST10		;Nej, HL är adress
		CALL	MAPFC		;HL är index i FCJOB &
		EX	DE,HL		;där finns eftersökt adr
		LD	HL,SFC		;FCJOBs startadress
		ADD	HL,DE,2		;Indexera FCJOB
		LD	E,(HL)		;Ta eftersökta tabellens
		INC	HL		;adress
		LD	D,(HL)
		EX	DE,HL		;Ska va i HL
ST10:		LD	B,0
		LD	C,(HL)		;Antal byte i tabellen
		ADD	HL,BC		;Sista byte i typerna
		PUSH	HL
		CPDR			;Positionen blir index
		POP	HL
		INC	HL
		ADD	HL,BC,ICTRL$	;Indexera ICTRL
		LD	B,A		;B kombinerad operandtyp
		LD	C,(HL)		;Ta opkoden ur ICTRL
		INC	HL
		LD	E,(HL)		;och offset till
		INC	HL		;instruktionens handler
		LD	D,(HL)
		INC	HL
		LD	A,(HL)
		LD	(IFLG2),A	;Instruktionens flaggor
		DEC	HL,2		;Peka på offset
		ADD	HL,DE		;HL handlerns adress
		BIT	BDOME,(IX+$LFLG3);Gå till DO_ME?
		JR	Z,ST11		;Nej, spar tid
		LD	(MULTIX),HL
		LD	HL,DO_ME
ST11:		POP	DE		;DE info för dst
		EX	(SP),HL		;HL info för src
		BIT	BID,A		;T ex (IR),R?
		JR	Z,ST12		;Nej, R,(IR)
		EX	DE,HL		;Vänd: DE=src, HL=dst
ST12:		BIT	BINDEX,(IX+$LFLG2);Finns +d eller +dd?
		JR	Z,ST13		;Nej
		BIT	BXMOD,A		;Detta tillåtet?
		JR	Z,ST14		;Nej
ST13:		BIT	BRA,(IX+$LFLG2)	;Uttryck inom <>?
		JR	Z,ST15		;Nej
		BIT	BRAMOD,A	;Får man det då? Z=NEJ
ST14:		JP	Z,ERR8		;Invalid operand
ST15:		EX	AF,AF		;NZ för RA
		CALL	FIXEX		;EX först?
		EX	AF,AF
		LD	A,H		;A registerkod
		RET			;Instruktion av typ x,x
ST16:		CALL	FIXEX		;Kanske EX först
		LD	E,(IX+$LFLG2)	;Radflaggor
		LD	A,D		;A operandtyp
		OR	A
		RET			;Instruktion med 1 oper.


; (IY) kanske är ett villkor

CKIF:		LD	HL,VILKTB
		CALL	SÖKIY		;Villkor?
		RET	C		;Nej
JPHL:		JP	(HL)		;HL har adressen


; (IY) måste peka på ett makro!

CKGM:		BIT	BMACRO,(IX+$MMAIN) ;Finns det makron?
		SCF			;Unknown instruction
		RET	Z		;Nej
		CALL	TXCOPY
		FCAL	@GMAC
		RET


; Kopiera resten av raden till LINBUF i FCMAP
; UT:	HL	pekar på CR i raden

TXCOPY:		CALL	MAPFC		;In med FC
		LD	DE,(SFC)	;Start LINBUF
		LD	A,FCMAP AND 0F0H OR TXMAP AND 0FH
		LD	(MAP),A
		OUT	(SMAP),A	;Läser TX, skriver FC
		LD	HL,IY
		LD	A,CR
TY1:		CP	(HL)
		LDI
		JP	NZ,TY1
		DEC	HL
		RET


; Kolla vilken cc det är

GETCC:		PUSH	HL
		LD	HL,CCTAB
		CALL	SÖKIY		;Finns cc?
		LD	L,-1		;-1 => ingen cc
		JR	C,GCC1		;Nej
		CALL	KOMMA		;Förbi , tab & blank
		LD	L,H		;H = cc
GCC1:		LD	(IX+$CC),L
		POP	HL
		RES	7,L
		RET


; Utvärdera uttrycket i operanden
; IN:	Alla ' reserverade
; UT:	AF	operandtyp och status
;	 D	operandtyp
;	HL	data, VALUE = HL
;	 Z	tomt (vid ; eller CR)

EXPR:		LD	(IX+$OPFLG),0	;Operandflaggor
		PUSH	BC
		CALL	OPERAND
		POP	BC
		LD	D,A
		CALL	KOMMA
		LD	A,(OPFLG)
		AND	OPMASK
		OR	(IX+$LFLG2)
		LD	(LFLG2),A
		LD	A,D
		OR	A
		RET


; Utvärdera uttrycket i operanden
; Exakt som EXPR, men återställer anroparens
; map & esc. Används av FCAL-rutiner för retur
; till okänd map.

FCEXPR:		LD	HL,(MAP)	;Okänd map
		PUSH	HL
		CALL	MAPTX		;In med TX
		CALL	EXPR
		EX	(SP),HL
		CALL	ANYMAP		;Okänd map tillbaka
		POP	HL
		RET


; Utvärdera operanden

OPERAND:	LD	A,(IY)
		CALL	SLUT		;Raden slut, kommentar?
		JR	C,OD1		;Nej
		XOR	A
		LD	HL,A
		LD	(HIVALUE),HL
		RET
OD1:		CALL	AMORE		;Fortsättning nästa rad?
		JR	NC,OPERAND	;Ja
		LD	B,0
		CP	'('		;Adress el indirekt reg?
		JR	Z,OD2		;Ja
		CP	'<'		;Relativ adress?
		JR	NZ,OD3		;Nej
		SET	BRA,(IX+$OPFLG)
OD2:		LD	B,8
		CALL	IYTKN		;Förbi (<, blank och tab
OD3:		LD	A,(IY)
		CALL	TILLÅT		;Godkänt tecken?
		JP	C,OD15		;Nej
		LD	HL,REGTAB	;Är det ett register?
		CALL	SÖKIY
		JP	C,OD16		;Nej
		LD	A,(IY)
		CP	"'"		;Register '?
		JR	NZ,OD11		;Nej
		LD	A,H
		CP	30H		;SP'?
		JR	Z,OD10		;Ja, finns inte
		LD	C,0
		LD	A,L
		CP	7		;XYH eller XYL?
		LD	A,H
		JR	NZ,OD4		;Nej
		BIT	7,A		;IXH/L?
		JR	NZ,OD7		;Nej, IYH/L
		JR	OD5
OD4:		CP	0DDH		;IX'?
		JR	NZ,OD6		;Nej, kanske IY'
OD5:		SET	BEXXX,(IX+$LFLG3)
		JR	OD9
OD6:		CP	0FDH		;IY'?
		JR	NZ,OD8		;Nej
OD7:		SET	BEXXY,(IX+$LFLG3)
		JR	OD9
OD8:		CP	7		;Register A'?
		LD	C,1 SHL BEXAF	;EX AF,AF i så fall
		JR	Z,OD9		;Ja
		CP	70H		;AF'?
		JR	Z,OD9		;Ja
		LD	C,1 SHL BEXX	;Det blir EXX
OD9:		LD	A,C
		SET	BPRIM,A		;Pseudo register prim
		OR	(IX+$LFLG2)	;Minns detta
		LD	(LFLG2),A
OD10:		CALL	IYTKN		;Förbi '
OD11:		LD	A,L		;Registrets typ
		INC	B
		DEC	B		;Register inom parentes?
		RET	Z		;Nej
		OR	B		;(< OR reg = operandtyp
		LD	B,A		;Bra att ha
		LD	A,H
		SBC	HL,HL		;Default x/sx
		LD	(VALUE),HL
		LD	(HIVALUE),HL
		LD	H,A
		LD	A,(IY)		;Nästa tecken
		CP	'+'		;RR + (RR eller symbol)?
		JR	Z,OD13		;Z = endera
		CP	'-'		;RR - (RR eller symbol)?
		JR	NZ,OD12		;Nej, ska ha ) el >
		SET	BMINUS,(IX+$LFLG2);Minus i operanden
		JR	OD13
OD12:		CALL	CKEND		;Ska ha )>
		LD	A,B		;A typ, HL värde/kod
		RET
OD13:		PUSH	HL		;H registerkod, L offset
		LD	HL,SIGN		;± för polaritet?
		CALL	SÖKHL
		JP	C,ERR5		;Nej, syntaxfel
		PUSH	HL		;Funktionskod för ±
		LD	HL,REGTAB	;Register efter ±?
		CALL	SÖKIY
		JR	C,OD14		;Nej, index
		BIT	BMINUS,(IX+$LFLG2);RR-RR?
		JP	NZ,ERR5		;Ja, syntaxfel
		LD	(IX+$RCODE),H	;Register 2
		POP	AF,HL		;Glöm ±, minns regkod
		LD	B,13		;BX
		JR	OD12
OD14:		PUSH	BC
		CALL	PXOR		;Sök symbolens värde
		POP	BC,DE		;BC typ, DE funk för ±
		DEC	D		;Ska det vara negativt?
		CALL	Z,TWOCPL	;Japp
		LD	(VALUE),HL
		LD	A,L
		POP	HL
		LD	L,A
		SET	BINDEX,(IX+$LFLG2);Det finns index
		JR	OD12
OD15:		INC	B
		DEC	B		;Inom parentes?
		JR	NZ,OD16		;Ja
		CALL	CITAT		;ASCII - citat?
		JR	NZ,OD16		;Nej
		CP	6		;Mer än ett tecken?
		RET	Z		;Ja
		LD	IY,HL
OD16:		PUSH	BC
		CALL	PXOR		;Sök symbolens värde
		POP	BC
		LD	(VALUE),HL
		INC	B
		DEC	B
		LD	A,4
		RET	Z
		CALL	CKEND		;Ska ha slut )>
		CALL	SLUTK		;Raden slut?
		LD	A,12		;Det är (nn)
		RET	NC		;Ja
		CALL	FOREVER
		LD	(VALUE),HL
		LD	A,4		;Det är nn
		RET


; Kolla att uttrycket inom () eller <> är slut
; UT:	 A	nästa tecken efter )>, blank & tab

CKEND:		LD	A,')'
		BIT	BRA,(IX+$OPFLG)	;Fått <?
		JR	Z,CKEND1	;Nej
		LD	A,'>'
CKEND1:		CP	(IY)		;Slut parentes?
		JP	NZ,ERR1		;Nej, parentesfel
		JP	IYTKN		;Förbi )>, blank och tab


; Kolla om raden har avslutats med kolon
; Lista den i så fall och fortsätt på nästa.
; Fortsättningsraden får ha en label. Om första
; parametern på den nya raden är default, så måste
; den skrivas ",,".
; UT:	Om kolon: NC
;	 A	tecken att forsätta med
;	Annars: CY
;	 A	orört

MORE:		LD	A,(IY)
AMORE:		CP	':'		;Fortsättning nästa rad?
		SCF
		RET	NZ		;Nej
		CALL	ASMLIS		;Lista ut raden
		LD	(LINE),IY	;LINE pekar på nya raden
		LD	(IX+$OFOBJ),0	;Töm OBJ
		LD	HL,(LCCT)	;Korrekt adress i lista
		LD	(ADRESS),HL
		LD	(RACTR),HL
		LD	HL,(HILCCT)
		LD	(HIADRESS),HL
		LD	(HIRACTR),HL
		LD	A,(IY)
		CALL	TILLÅT		;Tillåtet tecken?
		CALL	NC,LABEL	;Ja, ta labeln
		CALL	TECKEN		;Förbi BLANK och TAB
		OR	A
		RET


; Exakt som MORE, men återställer anroparens
; map & esc. Används av FCAL-rutiner för retur
; till okänd map. Kopierar den nya raden.

FCMORE:		LD	HL,(MAP)	;Okänd map
		PUSH	HL,DE,BC
		CALL	MAPTX		;In med TX
		CALL	MORE
		JR	C,FCM1		;C = ingen ny rad
		PUSH	AF
		CALL	TXCOPY		;Ny rad till LINBUF
		POP	AF
FCM1:		POP	BC,DE,HL
		JP	ANYMAP		;Okänd map tillbaka


; Pseudo OR (10) och XOR (11)

PXOR:		CALL	PAND
PXR1:		SUB	10		;Minst OR?
		RET	C		;Nej
		PUSH	HL
		LD	HL,(HIVALUE)
		EX	(SP),HL
		PUSH	HL,AF
		CALL	PAND
		POP	BC,DE
		LD	C,A
		DEC	B		;XOR?
		JR	Z,PXR2		;Ja
		OR	HL,DE		;OR lo
		EX	(SP),HL
		LD	DE,(HIVALUE)	;Nya HIVALUE
		OR	HL,DE		;OR hi
		JR	PXR3
PXR2:		XOR	HL,DE		;XOR lo
		EX	(SP),HL
		LD	DE,(HIVALUE)	;Nya HIVALUE
		XOR	HL,DE		;XOR hi
PXR3:		LD	(HIVALUE),HL
		POP	HL
		LD	A,C
		JR	PXR1


; Pseudo AND (20)

PAND:		CALL	CKNOT
PAD1:		CP	20		;AND?
		RET	NZ		;Nej
		PUSH	HL
		LD	HL,(HIVALUE)
		EX	(SP),HL
		PUSH	HL
		CALL	CKNOT
		POP	DE
		LD	C,A
		AND	HL,DE		;AND lo
		EX	(SP),HL
		LD	DE,(HIVALUE)	;Nya HIVALUE
		AND	HL,DE		;AND hi
		LD	(HIVALUE),HL
		POP	HL
		LD	A,C
		JR	PAD1


; Kolla NOT

CKNOT:		LD	HL,ICKE		;NOT?
		CALL	SÖKIY
		JR	C,PMAGN		;Nej
		CALL	PMAGN
		LD	C,A		;Invertera
		CPL	HL
		PUSH	HL
		LD	HL,(HIVALUE)
		CPL	HL
		LD	(HIVALUE),HL
		POP	HL
		LD	A,C
		RET


; Pseudo EQ (28H), NE (29H), GE (2CH)
;	 LE (2DH), GT (2AH), LT (2BH)

PMAGN:		CALL	PPMIN
PMN1:		CP	28H		;Minst EQ?
		RET	C		;Nej
		LD	DE,(HIVALUE)	;1a hi
		LD	B,(IX+$AFUNC)
		PUSH	HL',DE',DE,BC,HL
		CALL	PPMIN
		EX	DE,HL		;DE 2a lo
		POP	HL,BC		;HL 1a lo
		EX	AF,AF		;Ev. ny funk
		LD	A,B		;Denna funk
		EXX
		POP	HL		;1a hi
		LD	DE,(HIVALUE)	;2a hi
		OR	A
		SBC	HL,DE		;1a - 2a
		POP	DE,HL		;DE',HL' orört
		EXX
		JR	NZ,PMN2		;NZ => behöver ej testa lo
		SBC	HL,DE
PMN2:		PUSH	AF		;F -> C
		POP	BC
		LD	HL,0		;false
		BIT	7,A		;EQ, LE eller LT?
		JR	NZ,PMN3		;Ja
		AND	C		;NE, GE eller GT
		JR	NZ,PMN5
		JR	PMN4
PMN3:		RES	7,A
		AND	C
		JR	Z,PMN5
PMN4:		DEC	HL		;true
PMN5:		LD	(HIVALUE),HL
		EX	AF,AF
		JR	PMN1


; Pseudo + (32H), - (33H)

PPMIN:		CALL	PCOUNT
PPMN1:		CP	32H		;Minst +?
		RET	C		;Nej
		PUSH	HL
		LD	HL,(HIVALUE)
		EX	(SP),HL
		PUSH	HL,AF
		CALL	PCOUNT
		POP	BC,DE
		LD	C,A
		LD	A,B
		CP	32H		;Plus?
		JR	NZ,PPMN2	;Nej
		ADD	HL,DE
		EX	(SP),HL
		LD	DE,(HIVALUE)
		ADC	HL,DE
		JR	PPMN3
PPMN2:		EX	DE,HL		;gamla - nya
		OR	A
		SBC	HL,DE
		EX	(SP),HL
		LD	DE,(HIVALUE)
		SBC	HL,DE
PPMN3:		LD	(HIVALUE),HL
		POP	HL
		LD	A,C
		JR	PPMN1


; Pseudo * (3CH), / (3DH)
; MOD (3EH), SHL (3FH) och SHR (40H)

PCOUNT:		CALL	CKSIGN
PCNT1:		CP	3CH		;Minst multiplikation?
		RET	C		;Nej
		LD	DE,(HIVALUE)
		PUSH	BC',DE',HL',AF,DE,HL
		CALL	CKSIGN
		EX	DE,HL		;DE 2a lo
		POP	BC		;BC 1a lo
		EX	AF,AF		;Ev. ny funk
		EXX
		LD	DE,(HIVALUE)	;DE 2a hi
		POP	BC,AF		;BC 1a hi
		LD	HL,0
		EXX
		LD	HL,0
		SUB	3CH		;Multiplikation?
		JR	NZ,PCNT2	;Nej
		CALL	MULTIPLY
		JR	PNCT8
PCNT2:		DEC	A		;Division (3DH)?
		JR	NZ,PCNT3	;Nej
		CALL	DIVIDE
		JR	PNCT8
PCNT3:		DEC	A		;Modulo (3EH)?
		JR	NZ,PCNT4	;Nej
		CALL	DIVIDE
		LD	BC,HL		;Rest lo
		LD	BC,HL'		;Rest hi
		JR	PNCT8
PCNT4:		INC	D		;SHL eller SHR
		DEC	D		;2a lo > 256?
		JR	NZ,PCNT7	;Ja
		LD	H,A
		OR	DE'		;2a hi=0?
		JR	NZ,PCNT7	;Nej
		LD	A,E
		CP	32		;> 32 bitar?
		JR	NC,PCNT7	;Ja
		DEC	H
		INC	E
PCNT5:		DEC	E		;Skiftat allt?
		JR	Z,PNCT8		;Ja
		INC	H
		DEC	H		;Vilket håll?
		JR	NZ,PCNT6	;NZ = höger
		SLA	C
		RL	B,C',B'
		JR	PCNT5
PCNT6:		EXX
		SRL	B
		RR	C
		EXX
		RR	B,C
		JR	PCNT5
PCNT7:		LD	BC,0
		LD	BC',0
PNCT8:		LD	(HIVALUE),BC'
		LD	HL,BC
		POP	HL',DE',BC'
		EX	AF,AF
		JP	PCNT1


; Kolla + eller - framför operanden

CKSIGN:		LD	HL,SIGN
		CALL	SÖKHL		;Tecken?
		JR	C,CKHILO	;Nej
		DEC	H
		JR	NZ,CKHILO
		CALL	CKHILO
TWOCPL:		LD	DE,(HIVALUE)	;Från CNVNBR
		LD	C,A
		CPL	HL		;1 - komplementet
		CPL	DE
		INC	HL		;2 - komplementet
		OR	HL		;Blev HL+1 = 0?
		JR	NZ,twocplX	;nej
		INC	DE
twocplX:	LD	(HIVALUE),DE
		LD	A,C
		RET


; Kolla LOW eller HIGH, LOWW eller HIGHW

CKHILO:		LD	HL,HILO		;LOW eller HIGH?
		CALL	SÖKIY
		JR	C,PARENT	;Nej
		PUSH	HL
		CALL	PARENT
		POP	DE
		LD	A,D
		LD	DE,(HIVALUE)
		OR	A		;LOW?
		JR	Z,hilo2		;Ja
		DEC	A		;HIGH?
		JR	Z,hilo1		;Ja
		DEC	A		;LOWW?
		JR	Z,hilo3		;Ja
		EX	DE,HL		;Det är HIGHW
		JR	hilo3
hilo1:		LD	L,H
hilo2:		LD	H,0
hilo3:		LD	DE,0
		LD	(HIVALUE),DE
		XOR	A
		RET


; Utvärdera uttrycket inom parentes,
; om det finns någon

PARENT:		LD	A,(IY)
		CP	'('		;Vänsterparentes?
		JR	NZ,PT1		;Nej
		CALL	IYTKN		;Förbi blank och tab
		CALL	PXOR		;Räkna ut vad det blir
		LD	A,(IY)
		CP	')'		;Klart?
		JR	Z,SL1		;Ja
ERR1:		LD	A,1		;Parentesfel
ERR0:		JP	ERROR
PT1:		CALL	SIFFRA		;Siffra?
		JR	C,PT2		;Nej
		CALL	CNVNBR
		JR	NC,SL4
		LD	A,3		;Error in constant
		JR	ERR0
PT2:		CALL	CITAT		;Citat?
		JR	NZ,SYMBOL	;Nej
		LD	L,D
		LD	H,0
		CP	4
		JR	Z,SL5
		JP	ERR8		;Ogiltig operand


; Syntaxfel

ERR5:		LD	A,5		;Syntax error
		JR	ERR0


; Det är en symbol av något slag
; IN:	TXMAP
; UT:	TXMAP

SYMBOL:		CALL	TILLÅT		;Godkänt tecken?
		JR	C,ERR5		;Nej, syntaxfel
		CP	'$'		;Location Counter?
		JR	NZ,SL2		;Nej
		LD	A,(IY+1)
		CALL	TILLÅT		;Godkänt tecken efter $?
		JR	NC,SL2		;Ja, inte LCCT då
		LD	HL,(HILCCT)
		LD	(HIVALUE),HL
		LD	HL,(LCCT)
SL1:		INC	IY
		JR	SL4
SL2:		CALL	SYCOPY		;Kopiera till SCRWRK
		LD	HL,(SYS)	;Finns symbolen i SY?
		CALL	SÖKIYS
		CALL	NC,AVANTI	;Ja, TXMAP & IY tbaks
		JR	NC,SL5		;NC = fortfarande ja
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	Z,SL3		;Nej
		CALL	REMOTE		;Remote label?
		JR	NC,SL5		;Ja
		CALL	FEL4		;Undefined symbol
SL3:		SET	BNXLBL,(IX+$LFLG1);Odefinierad symbol på
		CALL	AVANTI		;denna rad
		SET	BUNDEF,(IX+$OPFLG);EXPR: odef. symbol
SL4:		CALL	TECKEN		;Förbi blank och tab
SL5:		LD	A,(IY)
		CALL	SLUTP		;Uttrycket slut?
		JP	NC,XORRET	;Ja
SL6:		PUSH	HL
		LD	HL,SHARIT	;Operator i kortform?
		CALL	SÖKHL
		JR	NC,SL7		;Ja
		LD	HL,ARITOP	;Ordinarie form?
		CALL	SÖKIY
		JR	C,ERR5		;Nej, syntaxfel
SL7:		LD	A,H
		LD	(IX+$AFUNC),L	;Funktionskod
		POP	HL
		RET


; Uttrycket är inte klart och jag är rekursiv

FOREVER:	LD	DE,PXR1		;Pseudo OR, XOR
		PUSH	DE
		LD	DE,PAD1		;Pseudo AND
		PUSH	DE
		LD	DE,PMN1		;Pseudo MAGN
		PUSH	DE
		LD	DE,PPMN1	;Pseudo +, -
		PUSH	DE
		LD	DE,PCNT1	;Pseudo *, /, MOD etc
		PUSH	DE
		JR	SL6


; Sök label i REM(ote) symboltabell
; IN:	IY	labeln i SCRWRK
;	SYMAP
; UT:	Om CY:	finns inte i symboltabellen
;	IY	orört
;	SYMAP eller RSMAP
;	Om NC:	symbolen finns
;	IY	efter symbolen i TXMAP
;	TXMAP

REMOTE:		CALL	MAPRS
		LD	HL,SRS		;Symboltabellernas start
		CALL	SÖKIYS
		RET	C		;C = finns inte
		PUSH	HL		;Symbolens värde
		CALL	MAPSY		;Mappa in SY
		LD	IY,SCRWRK
		CALL	INSERT		;Sätt in labeln
		LD	(ASYVAL),HL	;Värdets adress
		POP	DE
		PUSH	DE
		CALL	PEU3		;Värdet också
		POP	HL		;Värdet i HL
		JP	AVANTI		;TXMAP & IY tillbaka


; Omvandla från ASCII till binär (32 bitar)
; IN:	register ' reserverade
; UT:	HL	lägsta 16 bitarna i talet
;	HIVALUE	håller de högsta 16 bitarna

CNVNBR:		LD	HL,IY
		PUSH	HL
		LD	B,0
CR1:		INC	HL,B		;Räkna siffrorna
		LD	A,(HL)
		CALL	EXTEND		;Nästa siffra?
		JR	NC,CR1		;Ja
		EX	(SP),HL
		POP	IY
		LD	A,(IY-1)
		CP	'9'+1		;Decimalt?
		LD	C,10		;Bas 10
		JR	C,CR2		;Ja
		RES	5,A		;Stor bokstav
		DEC	B
		LD	C,16		;Bas 16
		CP	'H'		;Hex?
		JR	Z,CR2		;Ja
		LD	C,8		;Bas 8
		CP	'Q'		;Oktalt?
		JR	Z,CR2		;Ja
		CP	'O'		;Oktalt?
		JR	Z,CR2		;Ja
		LD	C,2		;Bas 2
		CP	'B'		;Binärt?
		JR	Z,CR2		;Ja
		LD	C,10		;Bas 10
		CP	'D'		;Decimalt?
		SCF
		RET	NZ		;Nej
CR2:		EX	DE,HL
		LD	HL,0
		EXX
		PUSH	HL,DE
		LD	HL,0
		LD	DE,0
		EXX
		CALL	CR3
		EXX
		LD	(HIVALUE),HL
		POP	DE,HL
		EXX
		RET
CR3:		LD	A,(DE)
		INC	DE
		SUB	30H
		RET	C
		CP	10
		JR	C,CR4
		SUB	7
		RES	5,A
		CP	10
		RET	C
CR4:		CP	C
		CCF
		RET	C
		PUSH	DE
		LD	DE,0
		BIT	1,C		;2 med i basen?
		JR	Z,CR5		;Nej
		BIT	3,C		;8 med i basen?
		JR	Z,CR7		;Nej
		LD	DE,HL		;Det är alltså decimalt
		LD	DE,HL'
		JR	CR6
CR5:		BIT	3,C		;8 i basen?
		JR	NZ,CR6		;Ja
		ADD	HL,HL
		ADC	HL,HL'
CR6:		ADD	HL,HL
		ADC	HL,HL'
		ADD	HL,HL
		ADC	HL,HL'
		ADD	HL,DE
		ADC	HL,DE'
CR7:		ADD	HL,HL
		ADC	HL,HL'
		LD	E,A
		LD	D,0
		ADD	HL,DE
		JR	NC,CR8
		EXX
		LD	DE,0
		ADC	HL,DE
		EXX
CR8:		POP	DE
		RET	C
		DJNZ	CR3
		RET


; ASCII - citat

CITAT:		LD	A,(IY)
		CP	"'"		;Citat?
		JR	Z,CT1		;Ja, '
		CP	'"'		;Citat?
		RET	NZ		;Nej
CT1:		PUSH	BC		;Citat ' eller "
		LD	(IX+$CTLEN),-1	;Antal i citatet
		LD	HL,IY		;Pekar på 1a ' eller "
CT2:		INC	IY
		LD	B,C		;BCDE dwd
		LD	C,D
		LD	D,E
		LD	E,A		;E byte
		LD	(CTBYTE),A
		INC	(IX+$CTLEN)	;Antal i citatet
		LD	A,(IY)
		CP	CR		;CR efter 1a '"?
		JR	Z,CITATR	;Ja
		CP	(HL)		;Slut citat?
		JR	NZ,CT2		;Nej
		INC	IY
		LD	A,(IY)
		CP	(HL)		;3 '" i rad?
		JR	Z,CT2
		INC	(IX+$CTLEN)
		DEC	(IX+$CTLEN)
		JR	Z,CITATR
		BIT	BPDB,(IX+$LFLG2);Operand till DB?
		JR	NZ,CT6		;Ja
		BIT	BPDC,(IX+$LFLG1);Operand till DC?
		JR	NZ,CT6		;Ja
		LD	A,(IX+$CTLEN)	;Antal i citatet
		CP	2		;16 bitars ASCII?
		JR	NZ,CT3		;Nej
		LD	BC,0		;Förhindra trunkeringsfel
		JR	CT5
CT3:		CP	3		;24 bitars ASCII?
		JR	NZ,CT4
		LD	B,0		;Förhindra trunkeringsfel
		JR	CT5
CT4:		CP	4		;32 bitars ASCII?
CT5:		LD	A,6		;Citat av ascii
CT6:		PUSH	HL,AF		;Pekar på 1a '", Z
		CALL	TECKEN		;Förbi blank och tab
		POP	AF
		JR	Z,CT7		;Z = 16/24/32 bitars citat
		POP	HL,BC		;HL 1a '", BC orört
		LD	DE,0
		LD	(HIVALUE),DE
		LD	D,(IX+$CTBYTE)	;D byte
		LD	E,(IX+$CTLEN)	;Antal i citatet
		LD	A,E
		DEC	A		;1 tecken?
		LD	A,4		;Typ n
		RET	Z
		XOR	A
		LD	A,6		;Det är flera
		RET
CT7:		LD	HL,DE		;HL wd
		LD	(VALUE),HL
		LD	(HIVALUE),BC
		POP	BC,BC		;Glöm '", BC orört, Z
		RET
CITATR:		LD	A,2		;Error in string
		JP	ERROR


; Sök instruktioner eller reserverade ord
; IN:	HL	tabell att söka
;	IY	kk
; UT:	Om NC:	finns
;	HL	data
;	IY	förbi sökt ord, blank och tab
;	Om CY:	finns inte
;	IY	orört

SÖKHL:		LD	D,-1		;Kolla tills HL är slut
		JR	SK1
SÖKIY:		LD	D,0		;Kolla tills IY är slut
SK1:		LD	A,(HL)
		OR	A
		SCF
		RET	Z
		PUSH	IY
SK2:		LD	E,(HL)
		RES	7,E
		LD	A,(IY)
		CP	'a'
		JR	C,SK3
		CP	'å'+1
		JR	NC,SK3
		SUB	20H		;Stor bokstav
SK3:		CP	E
		JR	NZ,SK4
		BIT	7,(HL)
		INC	HL,IY
		JR	Z,SK2
		INC	D
		DEC	D
		JR	NZ,SKEXI
		LD	A,(IY)
		CALL	EXTEND
		JR	NC,SK5
SKEXI:		POP	DE
		LD	E,(HL)
		INC	HL
		LD	D,(HL)
		EX	DE,HL
		CALL	TECKEN		;Förbi blank och tab
		XOR	A
		RET
SK4:		BIT	7,(HL)
		INC	HL
		JR	Z,SK4
SK5:		INC	HL,2
		POP	IY
		JR	SK1


; Sök en symbol
; IN:	HL	tabell att söka
;	IY	kk
; UT:	Om NC:	finns
;	HL	data(15-0), data(31-16) i HIVALUE
;	DE	pekar på data(7-0)
;	IY	förbi sökt ord, blank och tab
;	Om CY:	finns inte
;	IY	orört

SÖKHLS:		LD	D,-1		;Kolla tills HL är slut
		JR	SKS1
SÖKIYS:		LD	D,0		;Kolla tills IY är slut
SKS1:		LD	E,7FH		;Mask
SKS2:		LD	A,(HL)
		OR	A
		SCF
		RET	Z
		PUSH	IY
SKS3:		LD	A,(HL)
		AND	E
		CP	(IY)
		JR	NZ,SKS4
		BIT	7,(HL)
		INC	HL,IY
		JR	Z,SKS3
		INC	D
		DEC	D
		JR	NZ,SKS5
		LD	A,(IY)
		CALL	EXTEND
		JR	NC,SKS5
		POP	DE
		PUSH	HL		;data(7-0)
		LD	E,(HL)
		INC	HL
		LD	D,(HL)
		INC	HL
		PUSH	DE
		LD	E,(HL)
		INC	HL
		LD	D,(HL)
		LD	(HIVALUE),DE
		POP	HL,DE
		CALL	TECKEN		;Förbi blank och tab
		XOR	A
		RET
SKS4:		BIT	7,(HL)
		INC	HL
		JR	Z,SKS4
SKS5:		INC	HL,4
		POP	IY
		JR	SKS2


; Utöka de test som TILLÅT gör

EXTEND:		CALL	TILLÅT
		RET	NC
SIFFRA:		CP	'0'
		RET	C
		CP	'9'+1
		CCF
		RET


; Kolla att det är ett tillåtet tecken
; Carry = 1 => otillåtet tecken

TILLÅT:		CP	40H
		JR	C,TT1
		CP	'Å'+1
		CCF
		RET	NC
		CP	'a'
		JR	C,TT2
		CP	'å'+1
		CCF
		RET
TT1:		CP	'$'
		RET	Z
		CP	'.'
		RET	Z
		CP	'?'
		RET	Z
		SCF
		RET
TT2:		CP	'_'		;Understrykning
		RET	Z
		SCF
		RET


; Ta reda på var i raden vi är

SLUTP:		CP	')'
		RET	Z
		CP	'>'
		RET	Z
SLUTK:		CP	','
		RET	Z
SLUT:		CP	CR
		RET	Z
		CP	';'
		RET	Z
		SCF
		RET


; ZMTTT - multiplikation 32*32 -> 32 bitar
; IN:	BC,BC'	låg resp. hög multiplikand
;	DE,DE'	låg resp. hög multiplikator
;	HL,HL'	0, 0
; UT:	BC,BC'	låg resp. hög produkt
;	resten skräp
;	CY	1 vid overflow

MULTIPLY:	LD	A,33
		EXX			;HIGH måste vara fram
mttt1:		RR	H,L,H',L'	;HIPH & HIPL höger
		RR	B,C,B',C'	;MKANDH & MKANDL höger
		JR	NC,mttt2	;NC = no add
		ADD	HL,DE'		;MKATORL + HIPL
		ADC	HL,DE		;MKATORH + HIPH
mttt2:		DEC	A
		JR	NZ,mttt1
		EXX
		RET


; ZDTTT - division 32/32 -> 32 bitar
; IN:	BC,BC'	låg resp. hög dividend
;	DE,DE'	låg resp. hög divisor
;	HL,HL'	0, 0
; UT:	BC,BC'	låg resp. hög kvot
;	HL,HL'	låg resp. hög rest
;	resten skräp
;	CY	1 vid overflow

DIVIDE:		LD	A,33
dttt1:		RL	C,B,C',B'	;Låg & hög DEND vänster
		DEC	A		;Klar?
		RET	Z		;Z=JA
		ADC	HL,HL		;Låg HDEND vänster
		ADC	HL,HL'		;Hög
		OR	A
		SBC	HL,DE		;Låg HDEND-DISOR
		SBC	HL,DE'		;Hög
		CCF
		JR	C,dttt1		;C = addera ej tillbaka
		ADD	HL,DE
		ADC	HL,DE'
		OR	A		;Bort CY
		JR	dttt1
		FILE	ZAPLD


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Alla former av LD		      ¦
¦					      ¦
¦	Entry: ........... ZAPLD.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 11 17	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
¦+--------------------------------------------+
¦¦
¦¦ Denna översikt visar register och operandkodning.
¦¦ Operandtypen måste rymmas i en byte.
¦¦ Uttryck utan parentes:
¦¦ 1 = R	  A, B, C, D, E, H, L
¦¦ 2 = RR	  BC, DE, HL, SP
¦¦ 3 = XY	  IX, IY
¦¦ 4 = d,dd,n,nn  d,n = byte, dd,nn = ord
¦¦ 5 = spec.reg.  I, R, SR, DSR, XSR, YSR
¦¦ 6 = citat av ascii > 1 byte (1 byte = 4)
¦¦ 7 = RX	  IXH, IXL, IYH, IYL
¦¦ 8 = uttryck inom parentes:
¦¦ 9 = (C)	  I/O adress (8 OR R = 9)
¦¦ A = (RR)	  (BC), (DE), (HL)
¦¦ B = (XY)	  (IX+d), (IY+d)
¦¦ C = (DA)	  (nn)
++


; Instruktion LD
; Tillåtna typer/moder för LD
; OBS!	STMNT söker tabellen baklänges.

ILD:		DB	ILDT$	;Antal byte i tabellen
ILDT:		DB	0	;Slut tabell
[ 1]		DB	25H	;HL,I
[ 2]		DB	52H	;I,HL
[ 3]		DB	33H	;XY,XY
[ 4]		DB	31H	;Pseudo XY,R
[ 5]		DB	21H	;Pseudo RR,R
[ 6]		DB	0B3H	;(XY+d),XY
[ 7]		DB	3BH	;XY,(XY+d)
[ 8]		DB	0A3H	;(RR),XY & (SR),XY
[ 9]		DB	3AH	;XY,(RR) & XY,(SR)
[10]		DB	0B2H	;(XY+d),RR
[11]		DB	2BH	;RR,(XY+d)
[12]		DB	77H	;XYH,XYL och XYL,XYH
[13]		DB	74H	;XYH,n och XYL,n
[14]		DB	71H	;XYH,R och XYL,R
[15]		DB	17H	;R,XYH, R,XYL
[16]		DB	0A2H	;(RR),RR, (SR),RR
[17]		DB	2AH	;RR,(RR), RR,(SR)
[18]		DB	15H	;A,I och A,R
[19]		DB	51H	;I,A och R,A
[20]		DB	32H	;XY,RR
[21]		DB	23H	;RR,XY
[22]		DB	22H	;RR,RR och SP,HL
[23]		DB	0C3H	;(DA),XY
[24]		DB	36H	;XY,'wd'
[25]		DB	3CH	;XY,(DA)
[26]		DB	34H	;XY,dd
[27]		DB	0B4H	;(XY+d),n
[28]		DB	0B1H	;(XY+d),R
[29]		DB	1BH	;R,(XY+d)
[30]		DB	0C1H	;(DA),A
[31]		DB	1CH	;A,(DA)
[32]		DB	0C2H	;(DA),RR
[33]		DB	26H	;RR,'wd'
[34]		DB	2CH	;RR,(DA)
[35]		DB	24H	;RR,dd
[36]		DB	0A4H	;(HL),n
[37]		DB	0A1H	;(RR),R
[38]		DB	1AH	;R,(RR)
[39]		DB	14H	;R,n
[40]		DB	11H	;R,R
ILDT$:		EQU	$-ILDT


; Opkod, offset och flaggor till rutinen som hanterar
; instruktionen. För flaggorna gäller (ettställda):
; IMDATA: skifta dst & src (normalt dst i DE; src i HL).
; RAMODE: tillåtet att använda uttryck inom <>.
; XMODE:  tillåtet att använda +d/+dd inom () eller <>.
;
; Offset-ordet i tabellen MÅSTE alltid vara positivt
; dvs handlern måste ligga EFTER adressen där offset
; definieras (för att kunna rymma flaggor).
;
; Namnsättningsregler:
; . = data eller register INOM parentes följer
; _ = data eller register UTAN parentes följer

[ 0]		ICTRL	,,ERR8-$
[ 1]		ICTRL	057H,AR_AI-$
[ 2]		ICTRL	047H,AR_AI-$,IMDATA
[ 3]		ICTRL	027H,XY_XY-$
[ 4]		ICTRL	040H,XY_R-$
[ 5]		ICTRL	040H,RR_R-$
[ 6]		ICTRL	023H,XY.XY-$,IMDATA OR XMODE
[ 7]		ICTRL	023H,XY.XY-$,XMODE
[ 8]		ICTRL	001H,XY.RR-$,IMDATA OR XMODE
[ 9]		ICTRL	003H,XY.RR-$,XMODE
[10]		ICTRL	003H,RR.XY-$,XMODE
[11]		ICTRL	003H,RR.XY-$,IMDATA OR XMODE
[12]		ICTRL	040H,R_RX-$
[13]		ICTRL	006H,RX_N-$
[14]		ICTRL	040H,R_RX-$
[15]		ICTRL	040H,R_RX-$
[16]		ICTRL	00CH,RR.RR-$,IMDATA OR XMODE
[17]		ICTRL	00CH,RR.RR-$,XMODE
[18]		ICTRL	057H,AR_AI-$
[19]		ICTRL	047H,AR_AI-$,IMDATA
[20]		ICTRL	007H,RR_XY-$,IMDATA
[21]		ICTRL	0F9H,RR_XY-$
[22]		ICTRL	0F9H,RR_RR-$
[23]		ICTRL	022H,XY.DA-$
[24]		ICTRL	021H,XY_AS-$,IMDATA
[25]		ICTRL	02AH,XY.DA-$,IMDATA
[26]		ICTRL	021H,XY.DA-$,IMDATA
[27]		ICTRL	036H,XY_N-$,IMDATA OR XMODE
[28]		ICTRL	070H,R.XY-$,IMDATA OR XMODE
[29]		ICTRL	046H,R.XY-$,XMODE
[30]		ICTRL	032H,A.DA-$
[31]		ICTRL	03AH,A.DA-$,IMDATA
[32]		ICTRL	022H,RR.DA-$
[33]		ICTRL	001H,RR_AS-$,IMDATA
[34]		ICTRL	02AH,RR.DA-$,IMDATA
[35]		ICTRL	001H,RR_NN-$,IMDATA
[36]		ICTRL	036H,HL_N-$
[37]		ICTRL	002H,R.RR-$,IMDATA OR XMODE
[38]		ICTRL	00AH,R.RR-$
[39]		ICTRL	006H,R_N-$
[40]		ICTRL	040H,R_R-$


; Instruktion LDW
; Tillåtna typer/moder för LDW

ILDW:		DB	ILDWT$	;Antal byte i tabellen
ILDWT:		DB	0	;Slut tabell
		DB	0A6H	;(RR),'wd'
		DB	0A4H	;(RR),nn
ILDWT$:		EQU	$-ILDWT
		ICTRL	,,ERR8-$
		ICTRL	006H,.RR_AS-$,IMDATA
		ICTRL	006H,.RR_NN-$,IMDATA


; Typ 11, LD R,R

R_R:		OR	C
		LD	C,A
R_R1:		JP	BILDA


; Typ 14, LD R,n

R_N:		CALL	BILDA
TRPUT:		CALL	TRUNKA
		JP	OPKODA


; Typ 1A, LD R,(RR)
;     A1, LD (RR),R
; IN:	 A	=H
;	BC	B 1A, A1, C 0A, 02 för (RR)
;	DE	reg R, E 1
;	HL	reg (RR), L d

R.RR:		CP	20H		;Register HL?
		JR	Z,R.RR2		;Ja
		BIT	5,H		;Register SP?
		RET	NZ		;Ja
R.RR1:		LD	A,D
		CP	7		;Register A?
		RET	NZ		;Nej, invalid operand
		JP	BILDA3
R.RR2:		LD	A,D
		BIT	3,C		;LD (HL),R?
		LD	C,70H
		JP	Z,BILDA4	;Ja
		LD	C,46H		;Det är R,(HL)
		JR	R_R1


; Typ A4, LD (HL),n
; IN:	 A	=H
;	BC	B A4, C 36
;	DE	D 20, E=0
;	HL	n

HL_N:		LD	A,D
		SUB	20H		;Med HL?
		RET	NZ		;Nej
		LD	D,A
		JP	R_N		;(HL),n


; Typ 24, LD RR,dd/ddd/dddd
; Typ 26, LD RR,'wd' (16/24/32 bitar)
; LD BC,'wd' ger: 'w' i B och 'd' i C

RR_AS:		CALL	CKAS
RR_NN:		CALL	BILDA2
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 2C, LD RR,(DA)
;     C2, LD (DA),RR
; IN:	 A	=H
;	BC	B 2C, C2, C 2A, 22 för (DA)
;	DE	dd
;	HL	H reg RR, L typ

RR.DA:		CP	20H		;Register HL?
		JR	Z,RR_NN		;Ja
		CALL	FIXED		;De andra har prefix ED
		LD	A,C
		XOR	61H
		LD	C,A
		JR	RR_NN


; Typ 1C, LD A,(DA)
;     C1, LD (DA),A
; IN:	 A	R
;	BC	B 1C, C1, C 3A, 32
;	DE	dd

A.DA:		SUB	7		;Register A?
		RET	NZ		;Nej, ogiltig operand
		LD	H,A
		CALL	BILDA2
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 1B, LD R,(XY+d/dd/ddd)
;     B1, LD (XY+d/dd/ddd),R
; IN:	 A	=H
;	BC	B 1B, B1, C 46, 70 för (XY)
;	DE	register R, E typ
;	HL	H DD för IX, FD för IY, L d

R.XY:		BIT	1,C		;LD (XY),R?
		LD	A,D
		JR	Z,r.xysx1	;Ja
		RLCA	3		;Det är R,(XY)
r.xysx1:	OR	C
		LD	C,A
PUTSX:		CALL	OPKODH
		CALL	OPKODC
		JP	PutIndex


; Typ B4, LD (XY+d/dd/ddd),n
; IN:	 A	=H
;	BC	B B4, C 36
;	DE	n
;	HL	H DD för IX, FD för IY, L d
;	 F	CY: 0, Z: short index, NZ: välj X/SX

XY_N:		SET	BPUTX,(IX+$LFLG3);Använd INDEX i PutIndex
		PUSH	DE
		CALL	PUTSX		;DD/FD + 36 + d
		POP	HL
		JP	TRPUT		;+ n


; Typ 36, LD XY,'wd'
; Typ 3C, LD XY,(DA)
;     C3, LD (DA),XY
;     34, LD XY,dd
; IN:	 A	=H
;	BC	34, 36, 3C, C3, C 21, 2A, 22, 21
;	DE	dd
;	HL	H DD för IX, FD för IY, L = d

XY_AS:		CALL	CKAS
XY.DA:		CALL	OPKODH		;Skriv DD, FD
		LD	H,20H
		CALL	BILDA2
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 22, LD RR,RR

RR_RR:		CALL	IsSP_HL		;SP,HL?
		RET	Z		;Ja, redan klart
		CALL	RSCode
		RET	NZ
		LD	A,(rsCode)
		OR	0CDH
		LD	L,A		;ED/DD/FD
		EX	DE,HL
		CALL	RRCodeA
		RET	NZ
		LD	A,(rrCodeA)
		OR	2
		LD	H,A
		LD	L,E
		JP	OPKODHL
IsSP_HL:	LD	A,H
		CP	20H		;Src HL?
		RET	NZ		;Nej
		LD	A,D
		CP	30H		;Dst SP?
		RET	NZ		;Nej
		JP	OPKODC


; Typ 21, pseudo LD RR,R för BC, DE och HL
; IN:	 D	dst; RR
;	 H	src; R
; LD HL,A ger: LD H,A + LD L,A

RR_R:		FCAL	@RR_R		;Ligger i FCMAP
		RET


; Typ 23, LD RR,XY
;     32, LD XY,RR
; IN:	 A	=H
;	BC	B 23,32, C F9,7
;	DE	D dst RR, E typ
;	HL	H src XY, L typ

RR_XY:		CALL	IsSP_XY		;SP,XY?
		RET	Z		;Ja, klart
		EX	DE,HL
		CALL	RRCodeA
		RET	NZ
		LD	A,(rrCodeA)
		BIT	0,B		;XY,RR?
		JR	Z,rr_xy1	;Ja
		LD	C,0BH		;RR,XY
rr_xy1:		OR	C
		LD	H,A
		LD	L,D
		JP	OPKODHL
IsSP_XY:	LD	A,D
		CP	30H		;Till SP?
		RET	NZ		;Nej
		CALL	OPKODH
		JP	OPKODC


; Typ 33, LD XY,XY
; IN:	 A	=H
;	BC	B 23,32, C F9,7
;	DE	D dst XY, E typ
;	HL	H src XY, L typ

XY_XY:		CP	D		;Samma reg?
		JP	Z,ERR8		;Ja, går inte
		CALL	OPKODD
		JP	OPKODC


; Typ 31, pseudo LD XY,R för IX och IY
; IN:	 A	=H
;	BC	B 31, C 40
;	 D	dst; DD för IX, FD för IY
;	 H	src; R
; LD IX,A ger: LD IXH,A + LD IXL,A

XY_R:		FCAL	@XY_R
		RET


; Typ 15, LD A,I och LD A,R
;     51, LD I,A och LD R,A
;     25, LD HL,I
;     52, LD I,HL
; IN:	 A	=H
;	BC	B 15,51,25,52, C 57,47,57,47
;	DE	D dst R
;	HL	H src R

AR_AI:		OR	A		;Med I?
		JR	Z,ar_ai1	;Ja
		CP	8		;Med R?
		RET	NZ		;Nej
ar_ai1:		LD	A,D
		CP	20H		;Med HL?
		JP	Z,FIXDDC
		CALL	FIXED
		JP	R.RR1


; Typ 3A, LD XY,(RR) och XY,(SP+d/dd/ddd)
;     A3, LD (RR),XY och (SP+d/dd/ddd),XY
; IN:	 A	=H
;	BC	B 3A, A3, C 3, 1
;	DE	DD för IX, FD för IY, E 3
;	HL	H registerkod för RR, L d

XY.RR:		CP	30H		;Med SP?
		JR	Z,XY.SP		;Ja
		BIT	BINDEX,(IX+$LFLG2);Finns index?
		RET	NZ		;Ja, invalid operand
		CALL	RRCodeA
		RET	NZ
		LD	A,(rrCodeA)
		OR	C
		LD	L,D
		LD	H,A
		JP	OPKODHL		;Skriv DD/FD + opkod
XY.SP:		CALL	OPKODD
		CALL	FIXCB
		CALL	PutIndex
		LD	A,21H
		BIT	7,B		;XY,(SP)?
		JP	Z,OPKODA	;Ja
		OR	8		;(SP),XY
		JP	OPKODA


; Typ 2A, LD RR,(RR) och RR,(SP+d/dd/ddd)
;     A2, LD (RR),RR och (SP+d/dd/ddd),RR
; IN:	 A	=H
;	BC	B 2A, A2, C 0C, 0C
;	DE	D reg RR, E 2
;	HL	H reg (RR), L d

RR.RR:		CP	30H		;Med SP?
		JR	Z,RR.SP		;Ja
		BIT	BINDEX,(IX+$LFLG2);Finns index?
		RET	NZ		;Ja, invalid operand
		CALL	RRCodeA		;ri
		RET	NZ
		LD	A,L
		OR	C
		LD	C,A
		EX	DE,HL
		CALL	RRCodeA		;rr
		RET	NZ
		LD	A,(rrCodeA)
		OR	C
		LD	C,A
		BIT	7,B		;RR,(RR)?
		JP	Z,FIXDDC	;Ja
		JP	FIXFDC		;(RR),RR
RR.SP:		EX	DE,HL
		CALL	RRCodeA
		RET	NZ
		CALL	FIXDD
		CALL	FIXCB
		CALL	PutIndex
		LD	A,(rrCodeA)
		INC	A
		BIT	7,B		;RR,(SP)?
		JP	Z,OPKODA	;Ja
		OR	8		;(SP),RR
		JP	OPKODA


; Typ 74, LD RX,n
; IN:	 A	=H
;	BC	74, C 6
;	DE	D 4 om XYH, 5 om XYL, E = 7
;	HL	n

RX_N:		PUSH	HL
		LD	H,D
		RES	0,H
		CALL	R_RX		;Skriv DD/FD + R_R
		POP	HL
		JP	TRPUT		;TRUNKA + OPKODA


; Typ 17, LD R,RX
;     71, LD RX,R
;     77, LD RX,RX
; IN:	BC	17, 71, 77, 74, C 40, 40, 40
;	DE	D dst (reg1), E typ
;	HL	H src (reg2), L typ
; Bit 7 är 1 i D eller H om RX är IYx

R_RX:		LD	A,B
		CP	77H		;XYx,XYx?
		JR	Z,R_RX1		;Ja, inget med H & L
		CP	74H		;RX,d?
		JR	Z,R_RX2		;Ja
		LD	A,D
		AND	7FH		;Bort bit 7
		OR	1		;Gör H=L i dst
		LD	B,A
		LD	A,H
		AND	7FH		;Bort bit 7
		OR	1		;Gör H=L i src
		CP	B		;H el L i dst el src?
		JR	NZ,R_RX2	;Nej, ok
		OR	A		;NZ
		RET			;Invalid
R_RX1:		LD	A,H
		XOR	D		;LD IXx,IYx?
		RET	M		;Ja, går inte
R_RX2:		LD	A,H
		LD	B,H
		OR	D
		LD	H,A
		CALL	RX		;DD/FD
		LD	A,B
		AND	7FH
		RES	7,D
		JP	R_R


; Sök och generera escape för IXx/IYx
; IN:	 H	bit 7 i H = 1 om IY
; UT:	 H	bit 7 = 0

RX:		LD	A,0DDH		;Antag IXx
		BIT	7,H		;IXx?
		RES	7,H
		JR	Z,rx1		;Ja
		LD	A,0FDH		;Det är IYx
rx1:		JP	OPKODA


; Typ 3B, LD XY,(XY+d/dd/ddd)
;     B3, LD (XY+d/dd/ddd),XY
; IN:	 A	=H
;	BC	B 3B, B3, C 23,23
;	DE	D registerkod för XY, E typ
;	HL	H registerkod för (XY), L d

XY.XY:		CP	D		;IX,(IX) eller IY,(IY)?
		JP	Z,ERR8		;Ja, går inte
		CALL	OPKODH
		CALL	FIXCB
		CALL	PutIndex
		LD	A,C
		BIT	7,B		;IX,(IY)?
		JP	Z,OPKODA	;Ja
		OR	8		;(IY),IX
		JP	OPKODA


; Typ 2B, LD RR,(XY+d/dd/ddd)
;     B2, LD (XY+d/dd/ddd),RR
; IN:	 A	=H
;	BC	B 2B, B2, C 3, 3
;	DE	D registerkod för (XY), E = d
;	HL	H registerkod för RR, L typ
;	 F	CY: 0; Z & NZ ignoreras

RR.XY:		CALL	RRCodeA
		RET	NZ
		CALL	OPKODD
		CALL	FIXCB
		CALL	PutIndex
		LD	A,(rrCodeA)
		OR	C
		BIT	7,B		;RR,(XY)?
		JP	Z,OPKODA	;Ja
		OR	8
		JP	OPKODA


; Typ A6, LDW (RR),'wd'
; Typ A4, LDW (RR),nn
; IN:	 A	=H
;	BC	B A4,A6, C 06 06
;	DE	nn
;	HL	H RR, L=0

.RR_AS:		CALL	CKAS
.RR_NN:		CALL	RRCodeA		;Med BC,DE,HL?
		RET	NZ		;Nej
		CALL	FIXED		;ED först
		LD	A,(rrCodeA)
		CALL	BILDA4		;+ opkod
		JP	PutAddress	;+ nn, 16/24/32 bitar


; Instruktion LDCTL
; Tillåtna typer/moder för LDCTL

ILDC:		DB	ILDCT$	;Antal byte i tabellen
ILDCT:		DB	0	;Slut tabell
		DB	52H	;SR,HL
		DB	25H	;HL,SR
		DB	15H	;A,DSR, A,XSR, A,YSR
		DB	54H	;SR,n, DSR,n, XSR,n, YSR,n
		DB	51H	;SR,A, DSR,A, XSR,A, YSR,A
ILDCT$:		EQU	$-ILDCT
		ICTRL	,,ERR8-$
		ICTRL	0C8H,HL_SR-$,IMDATA
		ICTRL	0C0H,HL_SR-$
		ICTRL	0D0H,A_xSR-$
		ICTRL	0CAH,SR_N-$
		ICTRL	0C8H,SR_A-$


; Typ 51, LDCTL SR,A, DSR,A, XSR,A och YSR,A
; IN:	 A	=H
;	BC	B 51, C C8
;	DE	D dst 4,1,2,3, E 5
;	HL	H src 7, L 1

SR_A:		CP	7		;Med A?
		RET	NZ		;Nej
		LD	A,D
		OR	A		;Med I?
		JP	Z,ERR8		;Ja
		CP	8		;Med R?
		JP	Z,ERR8		;Ja
		CP	4		;Till SR?
		JP	Z,FIXDDC	;Ja
		RLCA	4
		OR	0CDH
		LD	L,A
		LD	H,0D8H
		JP	OPKODHL


; Typ 54, LDCTL SR,n, DSR,n, XSR,n och YSR,n
; IN:	 A	=H
;	BC	B 54, C CA
;	DE	D dst 4,1,2,3, E 5
;	HL	n

SR_N:		LD	A,D
		OR	A		;Med I?
		JP	Z,ERR8		;Ja
		CP	8		;Med R?
		JP	Z,ERR8		;Ja
		CP	4		;Till SR?
		JR	NZ,sr_n		;Nej
		CALL	FIXDDC
		JP	TRPUT
sr_n:		PUSH	HL
		RLCA	4
		OR	0CDH
		LD	L,A
		LD	H,0DAH
		CALL	OPKODHL
		POP	HL
		JP	TRPUT


; Typ 15, LDCTL A,DSR, A,XSR och A,YSR
; IN:	 A	=H
;	BC	B 15, C D0
;	DE	D dst R, E 1
;	HL	H src 1,2,3, L 5

A_xSR:		OR	A		;Med I?
		JP	Z,ERR8		;Ja
		CP	8		;Med R?
		JP	Z,ERR8		;Ja
		CP	4		;Med SR?
		JP	Z,ERR8		;Ja
		LD	A,D
		CP	7		;Med A?
		RET	NZ		;Nej
		LD	A,H
		RLCA	4
		OR	0CDH
		LD	L,A
		LD	H,C
		JP	OPKODHL


; Typ 25, LDCTL HL,SR
;     52, LDCTL SR,HL
; IN:	 A	=H
;	BC	B 51, C C8
;	DE	D dst RR, E 2
;	HL	H src SR, L 5

HL_SR:		CP	4		;Med SR?
		RET	NZ		;Nej
		LD	A,L
		CP	5		;Säkert?
		RET	NZ		;Nej
		LD	A,D
		CP	20H		;Med HL?
		RET	NZ		;Nej
		JP	FIXEDC
		FILE	ZAPARI


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Aritmetiska instruktioner	      ¦
¦					      ¦
¦	Entry: ........... ZAPARI.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Rutinerna som följer hanterar 8 bitars aritmetiska
; och logiska instruktioner. De är: AND, OR, XOR, CP,
; SUB och SBC. Här hanteras dessutom ADD och ADC.
; INC och DEC hanteras separat.
; IN:	 A	=D
;	BC	B skräp, C A6,B6,AE,BE,96 & 9E resp.
;	DE	D typ, E LFLG2 (ej för ADC, ADD)
;	HL	om registeroperation: H R/RR, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 04, ADC etc n

IARITB:		FCAL	@IARITB		;Hit från IARITB i ZAPTAB
		RET


; Instruktion MLT
; IN:	 A	=D
;	BC	B skräp, C
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 02, MLT RR

IMLT:		FCAL	@IMLT
		RET


; Instruktionerna DIVUW, MULTW och MULTUW
; IN:	 A	=D
;	BC	B skräp, C B8, 90, 98
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H R, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 02, DIVUW etc RR

DIVMULW:	FCAL	@DIVMULW	;RR?
		RET


; Instruktionerna INC och DEC
; IN:	 A	=D
;	BC	B skräp, C 23 (INC), 2B (DEC)
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H R/RR, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 02, INC/DEC RR

INCDEC:		CP	2		;RR?
		JR	NZ,ID_XY	;Nej
		LD	A,H
		CP	70H		;Är det AF?
		JP	Z,ERR8		;Ja, invalid
IDRRX:		LD	A,C
		AND	0CFH
		LD	C,A
		JP	BILDA3


; Typ 03, INC/DEC XY

ID_XY:		CP	3		;IX, IY?
		JR	NZ,ID.HL	;Nej
IDXY:		LD	L,H
		LD	H,C
		JP	OPKODHL


; Typ 0A, INC/DEC (HL)

ID.HL:		BIT	3,C		;INC?
		LD	C,34H
		JR	Z,id.hl1	;Ja
		INC	C		;Det är DEC
id.hl1:		CP	0AH		;(RR)?
		JR	NZ,ID_R		;Nej
		LD	A,H
		CP	20H		;HL?
		RET	NZ		;Nej
		BIT	BINDEX,E	;Finns index?
		RET	NZ
		JP	OPKODC


; Typ 01, INC/DEC R

ID_R:		CP	1		;R?
		JR	NZ,ID_RX	;Nej
IDRX:		LD	A,C
		AND	0C7H
		LD	C,A
		LD	A,H
		JP	BILDA1


; Typ 07, INC/DEC RX

ID_RX:		CP	7		;RX?
		JR	NZ,ID.XY	;Nej
		CALL	RX		;DD/FD
		JR	IDRX


; Typ 0B, INC/DEC (XY)

ID.XY:		CP	0BH		;(XY)?
		RET	NZ		;Nej
		CALL	OPKODH
		CALL	OPKODC		;+ 34/35
		JP	PutIndex


; Rutinerna som följer hanterar 16 bitars instruktioner. De är:
; ADCW, ADDW, ANDW, CPW, ORW, SBCW, SUBW, XORW
; IN:	 A	=D
;	BC	B skräp, C 8C,84,A4,BC,B4,9C,94,AC
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H RR, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 02, ADCW etc RR

IARITW:		FCAL	@IARITW
		RET
		FILE	ZAPMIS


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Diverse instruktioner		      ¦
¦					      ¦
¦	Entry: ........... ZAPMIS.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Instruktion eller pseudo SET

ISET:		LD	B,A
		LD	A,(IY)
		CALL	SLUT		;Pseudo SET?
		LD	A,B
		JP	Z,PDEFL		;Ja, define label


; Instruktion BIT, SET och RES

IBIT:		CALL	TRUNK		;Biten < 256
		AND	0F8H		;Biten < 8?
		RET	NZ		;Nej
		LD	A,L
		RLCA	3
		OR	C
		LD	C,A
		CALL	EXPR		;Hämta register & offset
		LD	E,(IX+$LFLG2)	;EXPR ger ny LFLG2
		CALL	FIXEX
		LD	A,D


; Aritmetiska och logiska skiftinstruktioner:
; RL, RR, RLC, RRC, SLA, SRA, SRL
; IN:	 A	=D
;	BC	B skräp, C opkod
;	DE	D typ, E LFLG2
;	HL	H R, L typ eller d
;
; Typ 0B, RR etc (XY)

ISHIFT:		FCAL	@ISHIFT
		RET


; Aritmetiska och logiska skiftinstruktioner:
; RLW, RRW, RLCW, RRCW, SLAW, SRAW, SRLW
; IN:	 A	=D
;	BC	B skräp, C opkod
;	DE	D typ, E LFLG2
;	HL	H RR, L typ eller d
;
; Typ 0B, RLW etc (XY)

ISHIFTW:	FCAL	@ISHIFTW
		RET


; Instruktionerna PUSH och POP
; IN:	 A	=D
;	BC	B skräp, C opkod
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H RR, L typ/d
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 03, PUSH/POP XY

PUSHPOP:	SET	BMULTI,(IX+$LFLG3);N kanske instruktion
		CP	3		;XY?
		JP	Z,IDXY		;Ja


; Typ 02, PUSH/POP RR

PP_RR:		CP	2		;RR?
		JR	NZ,PP_NN	;Nej
		LD	A,H
		CP	30H		;SP?
ERR8Z:		JP	Z,ERR8		;Ja, invalid
		RES	6,H
		JP	IDRRX


; Typ 04, PUSH NN

PP_NN:		CP	4		;NN?
		JR	NZ,PP_AS	;Nej
PP_NNA:		BIT	2,C		;POP?
		JR	Z,ERR8Z		;Ja, går inte
		LD	D,C
		SET	4,D
		LD	E,0FDH
		EX	DE,HL
		CALL	OPKODHL		;FD F5
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 06, PUSH 'wd'

PP_AS:		CP	6		;AS?
		JR	NZ,PP_SR	;Nej
		CALL	CKAS
		JR	PP_NNA


; Typ 05, PUSH/POP SR

PP_SR:		CP	5		;Spec. reg?
		RET	NZ		;Nej
		LD	A,H
		CP	4		;SR?
		RET	NZ		;Nej
		RES	5,C
		JP	FIXEDC


; Instruktion RST

IRST:		CALL	TRUNK
		LD	H,A
		AND	C
		CALL	NZ,FEL7
		JP	BILDA3


; Instruktion IM

IIM:		FCAL	@IIM
		RET


; Instruktion JR

IJR:		LD	B,(IX+$CC)
		INC	B		;Finns cc?
		JR	Z,IDJNZ		;Nej
		DEC	B
		BIT	5,B
		RET	NZ
		LD	C,B
		SET	5,C


; Instruktion DJNZ nn[,IB | IW]

IDJNZ:		CP	4
		RET	NZ
		LD	A,(IY)
		CALL	SLUT		;Raden slut?
		JR	NZ,idjnz1	;nej
		CALL	OPKODC		;10
		LD	(LASTDDFLAG),A	;A=0
		LD	E,2		;Instruktionens längd
		FCAL	@RA
		JP	PutIndex	;+ RA (SX)
idjnz1:		LD	HL,DDTABLE
		CALL	SÖKIY
		JR	C,idjnz2
		LD	A,H
		LD	E,4		;Instruktionens längd
		CP	3		;IB?
		JR	Z,idjnz3	;ja
		INC	E		;E 5
		CP	0FH		;IW?
		JR	Z,idjnz3	;ja
idjnz2:		LD	A,45		;Range specifier missing
		JP	ERROR
idjnz3:		LD	(LASTDDFLAG),A
		CALL	OPKODL		;DD/FD
		CALL	OPKODC		;10
		FCAL	@RA
		JP	PutIndex	;X eller LX


; Instruktion RET

IRET:		LD	B,(IX+$CC)
		INC	B		;Finns cc?
		JP	Z,OPKODC	;Nej, reg C
		DEC	B,C
		RES	3,C
		LD	A,B
		JP	BILDA4		;cc OR C


; Instruktion JP

IJP:		CP	0AH		;JP (RR)?
		JR	NZ,JP.XY	;Nej
		LD	B,(IX+$CC)
		INC	B		;Finns cc?
		RET	NZ		;Ja, fel
		LD	A,H		;JP (HL)
		CP	20H		;Med HL?
		RET	NZ		;Nej
		BIT	BINDEX,E	;Finns index?
		RET	NZ		;Ja, fel
		JP	OPKODC
JP.XY:		CP	0BH		;JP (XY)?
		JR	NZ,JP_DA	;Nej
		BIT	BINDEX,E	;Finns index?
		CALL	NZ,FEL7		;Ja, offset error
		JP	IDXY
JP_DA:		LD	C,0C3H		;Antag JP DA


; Instruktion CALL

ICALL:		CP	4		;DA?
		RET	NZ		;Nej
		CALL	IRET		;CD eller cc
		JP	PutAddress	;+ DA, 16/24/32 bitar


; Instruktion CALR NN[,IB | IW]

ICALR:		CP	4		;DA?
		RET	NZ		;Nej
		LD	A,(IY)
		CALL	SLUT		;Raden slut?
		JR	NZ,icalr1	;nej
		CALL	FIXED
		CALL	IRET		;CD eller cc
		LD	(LASTDDFLAG),A	;A=0
		LD	E,3
		FCAL	@RA
		JP	PutIndex	;+ RA (SX)
icalr1:		LD	HL,DDTABLE
		CALL	SÖKIY
		JR	C,icalr2
		LD	A,H
		LD	E,4
		CP	3		;IB?
		JR	Z,icalr3	;ja
		INC	E
		CP	0FH		;IW?
		JR	Z,icalr3	;ja
icalr2:		LD	A,45		;Range specifier missing
		JP	ERROR
icalr3:		LD	(LASTDDFLAG),A
		CALL	OPKODL
		CALL	IRET		;CD eller cc
		FCAL	@RA
		JP	PutIndex	;X eller LX


; Instruktionerna DI och EI

IDIEI:		CALL	EXPR		;Raden slut?
		JP	Z,OPKODC	;Ja
		CALL	TRUNK		;Biten < 256
		AND	0F0H		;Biten < 0F?
		RET	NZ		;Nej
		CALL	FIXDDC
		JP	OPKODL


; Pseudoinstruktion SCAL
; SCAL är RST 18 + byte (0-FF)

ISCAL:		CALL	TRUNK
		LD	L,C
		LD	H,A
		JP	OPKODHL


; Instruktion DDIR

IDDIR:		LD	HL,DDTABLE
		CALL	SÖKIY
		LD	A,44		;Unknown decoder directive
		JP	C,ERROR
		LD	A,(IY)
		CALL	SLUT		;Raden slut, kommentar?
		JR	Z,ddir2		;ja
		PUSH	BC		;C opkodsskelett
		LD	C,H		;dd kod
		CALL	KOMMA
		LD	HL,DDTABLE
		CALL	SÖKIY
		LD	A,44		;Unknown decoder directive
		JP	C,ERROR
		RES	BIW,C
		RES	BIW,H
		LD	A,C
		RLCA	4
		OR	H
		LD	HL,DDXLAT
		LD	BC,DDXLAT$
		CPDR
		LD	BC,DDXLAT$+1
		ADD	HL,BC
		POP	BC
		LD	H,(HL)
ddir2:		LD	A,H		;wim
		OR	1 SHL BDDUSED	;Bit BDDUSED är "used" flag
		LD	(DDFLAG),A	; ifall koden skulle råka vara 0
		LD	L,0DDH		;Utgå från DD
		BIT	2,H		;LW mode?
		RES	2,H
		RES	BIW,H
		JR	Z,ddir3		;nej
		LD	L,0FDH
ddir3:		LD	A,H
		OR	C
		LD	H,A
		LD	(DDCODE),HL	;Minns åt pseudoinstruktioner
		JP	OPKODHL


; Instruktion RESC och SETC

IRESC:		LD	HL,CBTABLE
		CALL	SÖKIY
		LD	A,46		;Unknown control bit
		JP	C,ERROR
		LD	A,H
		CP	3		;Är det XM?
		JR	NZ,iresc1	;Nej
		BIT	3,C		;SETC?
		RET	NZ		;Nej, går inte
iresc1:		RLCA	4
		OR	L
		LD	L,A
		LD	H,C
		JP	OPKODHL


; Instruktion SWAP
; IN:	 A	=D
;	BC	B skräp, C 0E
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 02, SWAP RR

ISWAP:		FCAL	@ISWAP
		RET


; Instruktion TST och TSTIO
; IN:	 A	=D
;	BC	B skräp, C 4, 74 för TSTIO
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 01, TST R

ITST:		FCAL	@ITST
		RET
		FILE	ZAPCHK


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Objektkodsbildning och felkontroll.   ¦
¦	Diverse.			      ¦
¦					      ¦
¦	Entry: ........... ZAPCHK.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 12 06	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Z380 har 4 instruktionsformat:
; Format 1 har ingen escape kod, bara opkod
; Format 2 har opkod escape ED + opkod
; Format 3 har opkod escape CB + opkod / CB + d + opkod
; Format 4 har opkod escape ED
; Escape för adresseringsmod är DD eller FD

FIXCB:		LD	A,0CBH
		JP	OPKODA
FIXDD:		LD	A,0DDH
		JR	OPKODA
FIXEB:		LD	A,0EBH		;Åt pseudoinstruktioner
		JR	OPKODA
FIXED:		LD	A,0EDH
		JR	OPKODA
FIXFD:		LD	A,0FDH
		JR	OPKODA


; Skicka ut genererad kod

OPKODHL:	CALL	OPKODL		;Ord i HL
		JR	OPKODH
OPKODL:		LD	A,L		;8 bitar i L
		JR	OPKODA
OPKODH:		LD	A,H		;8 bitar i H
		JR	OPKODA
OPKODD:		LD	A,D		;8 bitar i D
		JR	OPKODA


; Bilda en byte operationskod

BILDA:		LD	A,D
BILDA1:		RLCA	3
		JR	BILDA4
BILDA2:		BIT	6,H		;AF?
		JP	NZ,ERR8		;Ja, ogiltig operand
BILDA3:		LD	A,H
BILDA4:		OR	C
		JR	OPKODA


; Denna rutin ligger ibland överst på stacken, så
; returen från instruktionshanterarna går hit.
; Vissa pseudoinstruktioner föregås och avslutas
; med EXX eller EX AF,AF eller båda.

DOEX:		RET	NZ		;Annat fel
FIXEX:		BIT	BPRIM,(IX+$LFLG2);Behövs EX?
		RET	Z		;Nej
		BIT	BIGNEX,(IX+$IFLG2);Ignorera auto EX?
		JR	NZ,fixex1	;Ja
		LD	A,(LASTDDFLAG)
		OR	A		;Finns DDIR?
		LD	A,47		;Decoder directive misses target
		JP	NZ,ERROR	;Ja
		SET	BSTEPRA,(IX+$MISC1);Stega fram RACTR också
		LD	A,8
		BIT	BEXAF,(IX+$LFLG2);Göra EX AF,AF?
		CALL	NZ,OPKODA	;Ja
		LD	A,0D9H
		BIT	BEXX,(IX+$LFLG2);Göra EXX?
		CALL	NZ,OPKODA	;Ja
		PUSH	HL
		LD	HL,0D9DDH
		BIT	BEXXX,(IX+$LFLG3);Göra EXXX?
		CALL	NZ,OPKODHL	;Ja
		LD	L,0FDH
		BIT	BEXXY,(IX+$LFLG3);Göra EXXY?
		CALL	NZ,OPKODHL	;Ja
		POP	HL
		RES	BSTEPRA,(IX+$MISC1)
fixex1:		XOR	A
		RET


; Instruktioner utan operander
; IN:	 C	opkod

FIXDDC:		CALL	FIXDD		;CPLW, EXXX
		JR	OPKODC
FIXFDC:		CALL	FIXFD		;EXXY
		JR	OPKODC
FIXEDC:		CALL	FIXED		;ED först för LDI m fl
OPKODC:		LD	A,C		;DAA, CPL, SCF, CCF m fl


; Skriv objektkoden till listbuffer och disk
; IN:	 A	genererad opkod/data
; UT:	 A	0, Z & NC
;	Resten orört

OPKODA:		PUSH	HL
		SET	BPUTC,(IX+$FPASS);Börjat generera kod
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	Z,OPKOD5	;Nej
		PUSH	DE,BC
		LD	C,A
		LD	HL,(FORORG)
		LD	DE,(HIFORORG)
		OR	HL		;Framåt ORG, DS etc?
		OR	D
		OR	E
		JR	Z,OPKOD3	;Nej
		BIT	BOBJCT,(IX+$FOPT1);Objektkod?
		JR	NZ,OPKOD1	;Ja
		SBC	HL,HL
		JR	OPKOD2
OPKOD1:		XOR	A		;Fyll luckan med 0
		CALL	DISK		;Skriv till disk
		DEC	HL
		OR	HL
		JR	NZ,OPKOD1
		OR	DE
		JR	Z,OPKOD2
		DEC	DE
		JR	OPKOD1
OPKOD2:		LD	(FORORG),HL
		LD	(HIFORORG),HL
OPKOD3:		BIT	BOBJCT,(IX+$FOPT1);Objektkod?
		JR	Z,OPKOD4	;Nej
		LD	A,C
		CALL	DISK		;Skriv till disk
OPKOD4:		CALL	PUTOBJ		;Och listbuffer
		POP	BC,DE
OPKOD5:		LD	HL,(LCCT)	;Stega fram $ ett snäpp
		INC	HL
		LD	(LCCT),HL
		OR	HL
		JR	NZ,OPKOD7
		LD	HL,(HILCCT)
		INC	HL
		LD	(HILCCT),HL
OPKOD7:		BIT	BSTEPRA,(IX+$MISC1);Stega fram RACTR också?
		JR	Z,OPKOD6	;Nej
		LD	HL,(RACTR)
		INC	HL
		LD	(RACTR),HL
		OR	HL
		JR	NZ,OPKOD6
		LD	HL,(HIRACTR)
		INC	HL
		LD	(HIRACTR),HL
OPKOD6:		POP	HL
		XOR	A
		RET


; Sätt in en byte i objektkodens listbuffer
; IN:	 C	objektkod

PUTOBJ:		LD	A,LOW(OBJSIZ)
		CP	(IX+$OFOBJ)	;Plats för en till?
		RET	Z		;Nej
		LD	E,(IX+$OFOBJ)	;Offset i OBJ
		LD	D,0
		LD	HL,OBJ
		ADD	HL,DE
		LD	(HL),C
		INC	(IX+$OFOBJ)
		RET


; För vissa funktioner med symboliska uttryck
; måste de i uttrycket ingående symbolerna vara
; definierade. Se efter att operandens symboler
; har ett värde som går att använda.

OPLBL:		SUB	4		;dd/nn?
		JP	NZ,ERR8		;Nej, Invalid operand
		BIT	BNXLBL,(IX+$LFLG1);Allt definierat?
		RET	Z		;Ja
		LD	HL,A		;A = 0
		LD	(HIVALUE),HL
		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	NZ		;Ja
FEL4:		LD	A,4		;Undefined symbol
		JP	FELHLZ		;Säg bara till i pass 1


; Trunkera byte
; IN:	HL	tal att kolla
; UT:	 A	=L om HL är godkänt

TRUNK:		CP	4
		JP	NZ,ERR8		;Ogiltig operand
TRUNKA:		XOR	A
		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	Z		;Nej
		PUSH	DE
		LD	DE,(HIVALUE)
		OR	DE
		OR	H
		JR	Z,trunk1
		INC	DE,H
		OR	DE
		OR	H
trunk1:		POP	DE
		JR	NZ,FEL6
		LD	A,L
		RET
FEL6:		LD	A,6		;Truncation error
		JP	FELHLZ


; Generera offset för IX/IY beroende på DDIR
; IN:	Allt reserverat utom A

PutIndex:	LD	A,(LASTDDFLAG)
		OR	A		;Finns DDIR?
		JR	NZ,pi2		;Ja
pi1:		CALL	CKSX		;short index (8 bitar)
		JP	OPKODA		;d
pi2:		PUSH	BC
		LD	B,A
		AND	3		;DDIR med IB eller IW?
		LD	A,B
		POP	BC
		JR	Z,pi1		;Nej, bara W eller LW
		BIT	3,A		;IW?
		JR	NZ,pi3		;Ja
		CALL	CKX		;IB => index (16 bitar)
		JP	OPKODHL
pi3:		CALL	CKLX		;IW => long index (24 bitar)
		CALL	OPKODHL
		LD	A,E
		JP	OPKODA


; Generera absolutadress beroende på DDIR
; IN:	Allt reserverat utom A

PutAddressErr:	CALL	FEL6		;FELHLZ
PutAddress:	LD	HL,(VALUE)
		LD	DE,(HIVALUE)
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	NZ,pa1		;Ja
		LD	HL,0
		LD	DE,0
pa1:		LD	A,(LASTDDFLAG)
		OR	A		;Finns DDIR?
		JR	NZ,pa3		;Ja
pa2:		OR	DE		;HI=0?
		JP	Z,OPKODHL	;Ja
		INC	DE
		OR	DE		;-1?
		JR	NZ,PutAddressErr;Nej
		JP	OPKODHL		;Jo, 16 bitar
pa3:		PUSH	BC
		LD	B,A
		AND	3		;DDIR med IB eller IW?
		LD	A,B
		POP	BC
		JR	Z,pa2		;Nej, bara W eller LW
		BIT	3,A		;IW?
		JR	NZ,pa5		;Ja
		LD	A,D
		OR	A		;MSB=0?
		JR	Z,pa4		;Ja
		INC	A		;eller FF?
		JR	NZ,PutAddressErr;Nej
pa4:		CALL	OPKODHL
		EX	DE,HL
		JP	OPKODL		;IB => 24 bitar
pa5:		CALL	OPKODHL		;IW => 32 bitar
		EX	DE,HL
		JP	OPKODHL


; Kolla att offset ryms i 8 bitar

CKSX:		PUSH	HL,DE
		CALL	GetNum
		CALL	CKOFF8		;8 bitars signed offset
		POP	DE,HL
		RET


; Hämta index att testa

GetNum:		LD	HL,(VALUE)
		LD	DE,(HIVALUE)
		BIT	BPUTX,(IX+$LFLG3) ;INDEX?
		RET	Z		;Nej
		LD	HL,(INDEX)
		LD	DE,(HIINDEX)
		RES	BPUTX,(IX+$LFLG3) ;Engångs
		RET


; Kolla fel i offset
; IN:	DEHL	tal att kolla
; UT:	 A	=L om DEHL är godkänt

CKOFF8:		XOR	A
		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	Z		;Nej
		OR	DE		;HI = 0?
		OR	H
		JR	Z,cf1		;Ja
		PUSH	DE
		INC	DE
		INC	H
		OR	DE		;HI = FFFF FFxx?
		OR	H
		POP	DE
		JR	NZ,FEL7		;Nej
		LD	A,D
cf1:		XOR	L
		LD	A,L
		RET	P
FEL7:		LD	A,7		;Offset error
		JP	FELHLZ


; Kolla att offset ryms i 16 bitar
; IN:	DEHL	tal att kolla
; UT:	HL	HL om DEHL är godkänt

CKX:		CALL	GetNum
CKOFF16:	XOR	A
		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	Z		;Nej
		OR	DE		;HI = 0?
		JR	Z,cf161		;Ja
		PUSH	DE
		INC	DE
		OR	DE		;HI = FFFF xxxx?
		POP	DE
		JR	NZ,FEL7		;Nej
		LD	A,D
cf161:		XOR	H
		RET	P
		JR	FEL7		;Offset error


; Kolla att offset ryms i 24 bitar
; IN:	DEHL	tal att kolla
; UT:	DEHL	orört om DEHL är godkänt

CKLX:		CALL	GetNum
CKOFF24:	XOR	A
		BIT	BPASS,(IX+$FPASS);Pass 2?
		RET	Z		;Nej
		LD	A,D
		INC	A
		LD	A,D
		JR	Z,cf241
		OR	A
		JR	NZ,FEL7
cf241:		XOR	E
		RET	P
		JR	FEL7


; Kolla att ascii motsvarar DDIR

CKAS:		PUSH	BC
		LD	C,2		;Antag 16 bitar
		LD	A,(LASTDDFLAG)
		OR	A		;Finns DDIR?
		JR	Z,ckas1		;Nej, 16 bitar
		LD	B,A
		AND	3		;DDIR med IB eller IW?
		LD	A,B
		JR	Z,ckas1		;Nej, bara W eller LW, 16 bitar
		LD	C,4
		BIT	3,A		;IW?
		JR	NZ,ckas1	;Ja, 32 bitar
		DEC	C		;IB => 24 bitar
ckas1:		LD	A,(CTLEN)
		CP	C		;Rätt antal tecken i citatet?
		POP	BC
		RET	Z		;Ja
		JP	CITATR


; Beräkna en kod för rr
; IN:	 H	registerkod
; UT:	 A	=H
;	 L	rr: 00 för BC, 01 för DE, 11 för HL
;	NZ	det är inte BC, DE eller HL och då gäller inte L.

RRCodeA:	LD	A,H
		LD	L,0
		LD	(rrCodeA),A
		OR	A		;00 BC?
		RET	Z		;ja
		INC	L
		CP	10H		;10 DE?
		RET	Z		;ja
		LD	L,3
		LD	(IX+$rrCodeA),30H
		CP	20H		;20 HL?
		RET


; Beräkna en kod för rr
; IN:	 D	registerkod
; UT:	 A	=D
;	 L	rr: 000 för BC, 010 för DE, 111 för HL
;	NZ	det är inte BC, DE eller HL och då gäller inte L.

RRCodeB:	LD	A,D
		LD	L,0
		OR	A		;00 BC?
		RET	Z		;ja
		LD	L,2
		CP	10H		;10 DE?
		RET	Z		;ja
		LD	L,7
		CP	20H		;20 HL?
		RET


; Beräkna en kod för rr
; IN:	 H	registerkod
; UT:	 A	=H
;	 L	rr: 00 för BC, 01 för DE, 10 för HL, 11 för SP
;	NZ	det är inte BC, DE, HL eller SP och då gäller inte L.

RRCodeC:	LD	A,H
		LD	L,0
		LD	(rrCodeC),A
		OR	A		;00 BC?
		RET	Z		;ja
		INC	L
		CP	10H		;10 DE?
		RET	Z		;ja
		INC	L
		CP	20H		;20 HL?
		RET	Z		;Ja
		INC	L
		CP	30H		;30 HL?
		RET


; Beräkna en kod för rs
; IN:	 H	registerkod
; UT:	 A	=H
;	 L	rs: 10 för BC, 01 för DE, 11 för HL
;	NZ	det är inte BC, DE eller HL och
;		då gäller inte L.

RSCode:		LD	A,H
		LD	L,2
		LD	(IX+$rsCode),20H
		OR	A		;00 BC?
		RET	Z		;ja
		DEC	L
		LD	(rsCode),A
		CP	10H		;10 DE?
		RET	Z		;ja
		LD	L,3
		LD	(IX+$rsCode),30H
		CP	20H		;20 HL?
		RET


; Anropa instruktionshandlern
; IN:	Allt reserverat
;	Antal gånger att repetera i GGR

DO_MEX:		EX	(SP),HL		;Handlern på stacken
		LD	(MULTIX),HL	;Hanterarens adress
		POP	HL
		EX	AF,AF
DO_MEM:		EX	AF,AF
DO_ME:		PUSH	HL,DE,BC,AF
		CALL	DO_ONE
		POP	AF',BC,DE,HL
		RET	NZ		;NZ = nåt fel
		DEC	(IX+$GGR)	;En gång till?
		JR	NZ,DO_MEM	;Ja
		RET
DO_ONE:		PUSH	HL,AF
		LD	A,(LASTDDFLAG)
		OR	A		;Finns DDIR?
		JR	Z,do_one1	;Nej
		BIT	BREPEATDD,(IX+$LFLG3);Repetera DDCODE?
		SET	BREPEATDD,(IX+$LFLG3)
		LD	HL,(DDCODE)	;DDCODE att upprepa
		CALL	NZ,OPKODHL	;Ja
do_one1:	POP	AF
		LD	HL,(MULTIX)	;Hanterarens adress
		EX	(SP),HL
		RET			;Gå dit
		FILE	ZAPPSD


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Pseudodirektiv			      ¦
¦					      ¦
¦	Entry: ........... ZAPPSD.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 11 19	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; IDNT, pseudo

PIDNT:		DB	PIDNT$	;Antal byte
PIDNTT:		DB	0,44H
PIDNT$:		EQU	$-PIDNTT
		ICTRL	,,ERR8-$
		ICTRL	,,PIDN-$


; Typ 44, IDNT nn,nn

PIDN:		BIT	BIDNT,(IX+$FPASS);Förekommit förut?
		LD	A,18		;Can only be used once
		JP	NZ,ERROR	;Ja
		SET	BIDNT,(IX+$FPASS);Fått IDNT
		LD	(OCFCB+FLDA),DE	;File load address
		LD	(OCFCB+FEXA),HL	;File execute address
		RET


; Ogiltig operand

ERR8:		LD	A,8		;Invalid operand
		JP	ERROR


; Pseudo DB, DEFB, DUP, DUPW och DUPD

PDB:		LD	A,C
		SCAL	ZJUMP
		DW	PDBDFB		;0 = DB
		DW	PDBDFB		;1 = DEFB
		DW	PDUP		;2 = DUP
		DW	PDUPW		;3 = DUPW
		DW	PDUPD		;4 = DUPD


; Pseudo DB och DEFB

PDBDFB:		FCAL	@DB
		RET


; Pseudo DUP (byte)
; Syntax: DUP 0,10
; Medför att 0 genereras 10 gånger

PDUP:		FCAL	@DUP
		RET


; Pseudo DUPW (word)
; Syntax: DUPW 0,10
; Medför att 0 genereras 10 gånger

PDUPW:		FCAL	@DUPW
		RET


; Pseudo DUPD (longword)
; Syntax: DUPD 0,10
; Medför att 0 genereras 10 gånger

PDUPD:		FCAL	@DUPD
		RET


; Pseudo DC

PDC:		SET	BPDC,(IX+$LFLG1);Flagga DC
		CALL	CITAT
		RET	NZ
		JR	HDB


; Pseudo DW och DEFW

PDW:		FCAL	@DW
		RET


; Pseudo DD

PDD:		FCAL	@DD
		RET


; Pseudo DS

PDS:		FCAL	@DS
		RET


; Pseudo DEFM

PDEFM:		SET	BPDB,(IX+$LFLG2);Flagga DB åt CITAT
		CALL	CITAT
		RET	NZ
		JR	HDB


; Hjälprutin åt DB, DC och DEFM
; Generera objektkod av ASCII

HDB:		LD	D,(HL)
HB1:		INC	HL
		LD	A,(HL)
		CP	D
		JR	NZ,HB2
		INC	HL
HB2:		DEC	E
		JR	NZ,HB3
		BIT	BPDC,(IX+$LFLG1);DC?
		JR	Z,HB3		;Nej
		SET	7,A		;Sätt bit 7 då
HB3:		INC	E
		CALL	OPKODA
		DEC	E
		JR	NZ,HB1
		RET


; Exakt som HDB, men återställer anroparens
; map & esc. Används av FCAL-rutiner för retur
; till okänd map.
; IN:	HL	pekar på ASCII
; UT:	HL	skräp

FCHDB:		PUSH	HL
		LD	HL,(MAP)	;Okänd map
		EX	(SP),HL
		CALL	MAPTX		;In med TX
		CALL	HDB
		POP	HL
		JP	ANYMAP		;Okänd map tillbaka


; Pseudo EQU, SET och DEFL
; TXMAP från STMNT
; UT:	SYMAP

PDEFL:		RES	BEXLBL,(IX+$LFLG1);Ingen label förut
PEQU:		CALL	OPLBL
		BIT	BERRM,(IX+$LFLG1);Definierad symbol?
		JR	NZ,PEU4		;Nej, (pass 1)
		BIT	BLABEL,(IX+$LFLG1);Finns label på raden?
		LD	A,11		;Label missing
		JP	Z,ERROR		;Nej, (pass 2)
PEU1:		LD	(ADRESS),HL	;EQU-värdet
		LD	DE,(HIVALUE)
		LD	(HIADRESS),DE
PEU2:		CALL	MAPSY		;In med SY
		EX	DE,HL
		LD	HL,(ASYVAL)	;Sätt in värdet
PEU3:		LD	(HL),E
		INC	HL
		LD	(HL),D
		INC	HL
		LD	DE,(HIVALUE)
		LD	(HL),E
		INC	HL
		LD	(HL),D
PEU4:		XOR	A
		RET


; Pseudo ORG

PORG:		CALL	OPLBL
		LD	HL',(HIVALUE)
		BIT	BPUTC,(IX+$FPASS);Blivit någon kod än?
		JR	Z,POG1		;Nej
		EX	DE,HL		;Värdet till DE
		LD	HL,(LCCT)	;LCCT-FORORG
		LD	BC,(FORORG)
		OR	A
		SBC	HL,BC
		EX	DE,HL		;HL värdet, DE LCCT före ev. DS
		EXX
		LD	HL,(HILCCT)
		LD	BC,(HIFORORG)
		SBC	HL,BC
		EX	DE,HL
		LD	HL,(HIVALUE)
		EXX
		OR	A
		SBC	HL,DE		;LCCT (före DS) - värdet
		SBC	HL,DE'
		LD	A,14		;Illegal bacwards ORG
		JP	C,ERROR
		LD	(FORORG),HL
		ADD	HL,DE
		EXX
		LD	(HIFORORG),HL
		ADC	HL,DE
		EXX
POG1:		LD	(LCCT),HL
		LD	(ADRESS),HL
		EXX
		LD	(HILCCT),HL
		LD	(HIADRESS),HL
		EXX
		BIT	BLABEL,(IX+$LFLG1);Finns label?
		JR	NZ,PEU2		;Ja
		XOR	A
		RET


; Pseudo END, m fl

PEND:		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		LD	A,C
		SCAL	ZJUMP
		DW	POEND		;0 = END
		DW	0		;1 = LEDIG
		DW	PMSG		;2 = MSG
		DW	PALIGN		;3 = ALIGN
		DW	PTTL		;4 = TTL
		DW	PTTLN		;5 = TTLN
		DW	PSTL		;6 = STL
		DW	PSTLN		;7 = STLN
		DW	PMACRO		;8 = MACRO
		DW	PENDM		;9 = ENDM
		DW	PCODE		;10 = CODE
		DW	PDATA		;11 = DATA
		DW	PSTRIP		;12 = STRIP


; Pseudo END

POEND:		FCAL	@END
		RET


; Pseudo ALIGN, default 2

PALIGN:		FCAL	@ALIGN
		RET


; Pseudo TTL, TTLN, STL och STLN
; TTL och STL ger en överskriftsrad till, som skrivs
; ut under den ordinarie. Båda ger formfeed.
; TTLN och STLN "stänger av" extra överskriften.
; TTL och TTLN deaktiverar automatiskt STL.
; Om TTL eller STL innehåller semikolon, sätts
; datum och tid in av OUTPUT.
; Om STL är aktiv skrivs raden ut under TTL.
;
; Pseudo TTL

PTTL:		LD	A,10H		;Bit 4 = 1
		LD	E,0		;0 = TTL
		RES	BSTL,(IX+$FPASS);Bort med STL
AXTL:		PUSH	DE,AF
		CALL	TXCOPY
		POP	AF,DE
		PUSH	HL
		FCAL	@AXTL
		POP	IY
		RET


; Pseudo TTLN

PTTLN:		LD	A,NOT(30H)	;Bort med TTL och STL
DXTL:		FCAL	@DXTL
		RET


; Pseudo STL

PSTL:		LD	A,20H
		LD	E,1		;1 = STL
		JR	AXTL


; Pseudo STLN

PSTLN:		LD	A,NOT(20H)
		JR	DXTL


; Pseudo MACRO, definiera makrots namn

PMACRO:		CALL	TXCOPY
		FCAL	@MACRO
		RET


; Pseudo ENDM

PENDM:		FCAL	@ENDM
		RET


; Pseudo CODE, definiera opkoden

PCODE:		LD	A,(IY)
		FCAL	@CODE
		RET


; Pseudo DATA, definiera makrots operander

PDATA:		CALL	TXCOPY
		FCAL	@DATA
		RET


; Pseudo STRIP
; Syntax: STRIP LABEL1 (,LABEL2)
; STRIP tar bort alla symboler som följer EFTER label1
; till och med label2 ur symboltabellen. Om label2
; saknas underförstås "till slutet av symboltabellen".
; IN:	IY	pekar på LABEL1
; UT:	IY	pekar på ; eller CR i raden
;	Resten skräp

PSTRIP:		BIT	BPASS,(IX+$FPASS);Pass 2?
		JR	NZ,PP1		;Ja
SKIP:		CALL	NÄSTA		;Stega IY till nästa rad
		DEC	IY		;Peka på CR i denna
		XOR	A
		RET
PP1:		CALL	SYCOPY
		LD	HL,(SYS)
		CALL	SÖKIYS		;Finns första symbolen?
		PUSH	AF
		CALL	AVANTI
		POP	AF
		LD	A,4		;Undefined symbol
		JP	C,ERROR		;Nej
		INC	DE,4		;Förbi värdet
		PUSH	DE		;Bort härifrån
		LD	A,(IY)
		CALL	SLUT		;Raden slut resten ktar?
		LD	DE,(SYE)
		JR	NC,PP2		;Ja, till slut av SY
		CALL	KOMMA		;Förbi komma etc
		CALL	SYCOPY
		POP	HL		;Fortsätt söka härifrån
		PUSH	HL
		CALL	SÖKIYS		;Finns andra symbolen?
		PUSH	AF
		CALL	AVANTI
		POP	AF
		LD	A,4		;Undefined symbol
		JP	C,ERROR		;Nej
		INC	DE,4		;Till hit
PP2:		LD	HL,(SYE)
		SBC	HL,DE
		LD	BC,HL		;Antal byte att flytta
		INC	BC		;+ 1 för stopp
		EX	DE,HL
		POP	DE		;Härifrån är destination
		CALL	MAPSY
		LDIR
		DEC	DE		;Pekar på stopp
		LD	(SYE),DE
		XOR	A
		RET


; Pseudo MSG

PMSG:		CALL	TXCOPY
		PUSH	HL
		FCAL	@MSG
		POP	IY
		RET


; Pseudo REFS, REM, REFM och FILE
; UT:	IY	CR i raden
;	 Z	inget fel

PREFS:		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		LD	A,C
		SCAL	ZJUMP
		DW	PREFSC		;0 = REFS
		DW	REMC		;1 = REM
		DW	PFILE		;2 = FILE
		DW	PREFM		;3 = REFM


; Pseudo REM
; Ladda en "remote" symboltabell till RSMAP

REMC:		CALL	CLOSE		;Stäng senaste REFS
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JP	NZ,SKIP		;Ja, ladda inte då
		LD	HL,WKFCB
		CALL	HPREFS
		CALL	MAPRS		;In med RS
		LD	(IX+$RETRY),RCTR
REMC1:		LD	HL,(RSE)	;Pekar på 0
		LD	DE,TOP		;Max
		LD	A,-1		;Skippa FF
		CALL	READ
		JR	NZ,SYER		;NZ = nåt fel
		CALL	SYCRC		;Ska kanske kolla CRC
		JR	Z,REMC2		;Z = CRC ok
		DEC	(IX+$RETRY)	;Försöka mer?
		JR	NZ,REMC1	;Ja
		JR	ERR32		;CRC error
REMC2:		LD	(RSE),DE	;Filens slut
		RET


; Något är fel vid läsning av symboltabell
; IN:	 A	felkod från READ

SYER:		LD	B,A
		LD	A,22		;Symbolfile too big
		DEC	B		;För stor?
		JR	Z,SYER1		;Ja
		LD	A,21		;Symbolfile unreadable
SYER1:		JP	ERROR		;2, läsfel
ERR32:		LD	A,32
		JR	SYER1


; Pseudo REFS

PREFSC:		CALL	CLOSE		;Stäng senaste REFS
		LD	A,(FPASS)
		AND	3		;Pass 2 och börjat
		SUB	3		;generera kod?
		JP	Z,SKIP		;Ja, ladda inte då
		LD	HL,WKFCB
		CALL	HPREFS
		LD	(IX+$RETRY),RCTR
PC1:		LD	A,(WKFCB+FNSC)
		LD	B,A
		LD	C,0
		LD	HL,SYSDEF
		PUSH	HL
		OR	A
		SBC	HL,BC
		LD	DE,(SYE)
		INC	DE
		OR	A
		SBC	HL,DE		;Får symbolfilen plats?
		ADD	HL,DE
		LD	A,22		;Symbolfile too big
		JR	C,ERRJMP	;Nej
		CALL	MAPSY		;In med SY
		POP	DE		;SYSDEF är max
		LD	A,-1		;Skippa FF
		CALL	READ
		JR	NZ,SYER		;NZ = nåt fel
		CALL	SYCRC		;Ska kanske kolla CRC
		JR	Z,PC2		;Z = CRC ok
		DEC	(IX+$RETRY)	;Försöka mer?
		JR	NZ,PC1		;Ja
		JR	ERR32		;CRC error
PC2:		LD	(SYSTAR),HL	;Symbolfilens start
		RET
ERRJMP:		JP	ERROR


; Hjälprutin, som söker upp den refererade
; symbolfilen åt REFS och REM.
; MDRV söks alltid först för SY om inte drive
; anges. Om filen inte finns kollas om SY är
; assignat och filen läses då därifrån.
; Drivarna söks i den ordning de har assignats.
; IN:	HL	FCB
;	IY	pekar på filnamnet i källkoden
; UT:	 C	drive
;	DE	skräp
;	HL	oförändrat
;	IY	efter filnamnet

HPREFS:		PUSH	HL		;FCB-adress
		LD	DE,FEXT		;SY default
		ADD	HL,DE
		LD	(HL),'S'
		INC	HL
		LD	(HL),'Y'
		POP	HL
		LD	DE,IY
		LD	BC,6*256+3EH
		SCAL	ZLFN		;Ta filnamnet
		DEC	HL
		LD	(HL),C
		INC	HL
		PUSH	AF
		LD	IY,DE
		CALL	TECKEN		;Förbi tab & blank
		POP	AF
		RET	Z		;Z = inget fel
		LD	A,(ERRCOD)	;Den som hittade felet
		LD	B,A
		CP	ZCFS		;CFS?
		LD	A,19		;Bad symbolfile name
		JR	Z,ERRJMP	;Ja
		LD	A,B
		CP	ZRDIR		;RDIR?
		LD	A,21		;Symbolfile unreadable
		JR	Z,ERRJMP	;Ja
		LD	A,20		;No such symbolfile
		JR	ERRJMP


; FILE, pseudo - ny källkodsfil

PFILE:		CALL	TXCOPY
		FCAL	@FILE
		RET


; Pseudo REFM
; Ladda en makrofil till FCMAP

PREFM:		CALL	TXCOPY
		PUSH	HL
		FCAL	@REFM
		POP	IY
		XOR	A
		RET


; Pseudo REF
; Om raden har en label ligger den i SCRWRK

PREF:		BIT	BLABEL,(IX+$LFLG1);Finns label?
		JR	Z,PRF2		;Nej
		RES	BEXLBL,(IX+$LFLG1);Finns inte förut
		PUSH	IY
		LD	IY,SCRWRK
		LD	HL,(SYSTAR)	;Symbolfilens start
		LD	A,(FPASS)
		AND	3		;Pass 2 och börjat
		SUB	3		;generera kod?
		JR	NZ,PRF1		;Nej
		LD	HL,(SYS)	;Sök i tabellen istället
PRF1:		CALL	MAPSY		;Mappa SY
		CALL	SÖKIYS
		POP	IY
		LD	A,17H		;Symbol not in symb file
		CALL	C,FELHLZ
		JP	PEU1
PRF2:		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		BIT	BPASS,(IX+$FPASS);Pass 2?
		JP	NZ,XORRET	;Ja, retur
		LD	HL,SYSDEF
		LD	DE,(SYSTAR)
		OR	A		;REF går bara 1 gång
		SBC	HL,DE		;Finns det nåt?
		RET	Z		;Nej
		CALL	MAPSY
		LD	BC,HL
		LD	HL,(SYE)
		EX	DE,HL
		LDIR			;Lägg till sist
		EX	DE,HL
PRF3:		DEC	HL
		LD	A,(HL)
		INC	A
		JR	Z,PRF3
		LD	(SYE),HL


; Denna rutin stänger senast inlästa symbolfil
; genom att sätta "symbol table start", SYSTAR
; till deault, SYSDEF.

CLOSE:		LD	HL,SYSDEF	;Sätt SYSTAR till SYSDEF
		LD	(SYSTAR),HL
		CALL	MAPSY		;Mappa SY
		XOR	A
		LD	(HL),A		;Sista symbolen
		JP	MAPTX		;Kk tillbaka


; Pseudo IF/COND

PIF:		FCAL	@IF
		RET


; Pseudo ELSE

PELSE:		FCAL	@ELSE
		RET


; Pseudo ENDIF/ENDC

PENDC:		FCAL	@ENDC
		RET
		FILE	ZAPTAB


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Tabeller			      ¦
¦					      ¦
¦	Entry: ........... ZAPTAB.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 11 23	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Reseverade ord

RESWTB:		DC	'$'
		DB	0,0


; Registertabell
; Registernas kodning (vänster byte):
; 1 = 8 bitars register: A, B, C, D, E, H, L
; 2 = 16 bitars register: BC, DE, HL, SP
; 3 = IX, IY
; 5 = I, R, SR, DSR, XSR, YSR
; 7 = IXH, IXL, IYH, IYL

REGTAB:		DC	'A'	;A = 7
		DB	1,7
		DC	'B'	;B = 0
		DB	1,0
		DC	'C'	;C = 1
		DB	1,1
		DC	'D'	;D = 2
		DB	1,2
		DC	'E'	;E = 3
		DB	1,3
		DC	'H'	;H = 4
		DB	1,4
		DC	'L'	;L = 5
		DB	1,5
		DC	'I'	;I = 0
		DB	5,0
		DC	'R'	;R = 8
		DB	5,8
		DC	'AF'	;AF = 70
		DB	2,70H
		DC	'HL'	;HL = 20
		DB	2,20H
		DC	'DE'	;DE = 10
		DB	2,10H
		DC	'BC'	;BC = 0
		DB	2,0
		DC	'SP'	;SP = 30
		DB	2,30H
		DC	'IX'	;IX = DD
		DB	3,0DDH
		DC	'IY'	;IY = FD
		DB	3,0FDH
		DC	'IXH'	;IXH som H
		DB	7,4
		DC	'IXL'	;IXL som L
		DB	7,5
		DC	'IYH'
		DB	7,84H	;Bit 7 ger FD
		DC	'IYL'
		DB	7,85H
		DC	'SR'	;SR
		DB	5,4
		DC	'DSR'	;DSR
		DB	5,2
		DC	'XSR'	;XSR
		DB	5,1
		DC	'YSR'	;YSR
		DB	5,3
		DB	0	;Slut tabell


; Condition Codes

CCTAB:		DC	'NZ'		;Not zero
		DB	0,0 SHL 3
		DC	'Z'		;Zero
		DB	0,1 SHL 3
		DC	'NC'		;No carry
		DB	0,2 SHL 3
		DC	'C'		;Carry
		DB	0,3 SHL 3
		DC	'P'		;Plus
		DB	0,6 SHL 3
		DC	'M'		;Minus
		DB	0,7 SHL 3
		DC	'PO'		;Parity odd
		DB	0,4 SHL 3
		DC	'PE'		;Parity even
		DB	0,5 SHL 3
		DC	'NV'		;No overflow (PO)
		DB	0,4 SHL 3
		DC	'V'		;Overflow (PE)
		DB	0,5 SHL 3
		DC	'NS'		;No sign (P)
		DB	0,6 SHL 3
		DC	'S'		;Sign (M)
		DB	0,7 SHL 3
		DB	0


; I nedanstående tabeller är höger byte koden
; som väljer funktionen och vänster byte är
; flaggor till den processande rutinen
;
; LOW och HIGH (byte), LOWW och HIGHW (word)

HILO:		DC	'LOW'
		DB	0,0
		DC	'HIGH'
		DB	0,1
		DC	'LOWW'
		DB	0,2
		DC	'HIGHW'
		DB	0,3
		DB	0


; Invertering

ICKE:		DC	'NOT'
		DB	0,1EH
		DB	0


; Aritmetiska operatorer

ARITOP:		DC	'MOD'	;Modulo
		DB	0,3EH
		DC	'SHL'	;Logical shift left
		DB	0,3FH
		DC	'SHR'	;Logical shift right
		DB	0,40H
		DC	'AND'	;AND
		DB	0,14H
		DC	'OR'	;OR
		DB	0,10
		DC	'XOR'	;XOR
		DB	0,11
		DC	'EQ'	;Equal
		DB	0C0H,28H
		DC	'NE'	;Not equal
		DB	40H,29H
		DC	'GE'	;Greater than or equal
		DB	1,2CH
		DC	'LE'	;Less than or equal
		DB	0C1H,2DH
		DC	'GT'	;Greater than
		DB	41H,2AH
		DC	'LT'	;Less than
		DB	81H,2BH
		DB	0


; Tecken - minus eller plus

SIGN:		DC	'-'
		DB	0,1
		DC	'+'
		DB	0,0
		DB	0


; Aritmetiska operatorer i kortform

SHARIT:		DC	'+'	;Positivt tal
		DB	0,32H
		DC	'-'	;Negativt tal, 2 - komplementet
		DB	0,33H
		DC	'*'	;Multiplikation
		DB	0,3CH
		DC	'/'	;Division
		DB	0,3DH
		DC	'Ö'	;Modulo
		DB	0,3EH
		DC	'&'	;AND
		DB	0,14H
		DC	'^'	;OR
		DB	0,10
		DC	'%'	;XOR
		DB	0,11
		DC	'='	;Equal
		DB	0C0H,28H
		DC	'<>'	;Not equal
		DB	40H,29H
		DC	'>='	;Greater than or equal
		DB	1,2CH
		DC	'<='	;Less than or equal
		DB	0C1H,2DH
		DC	'>'	;Greater than
		DB	41H,2AH
		DC	'<'	;Less than
		DB	81H,2BH
		DB	0


; Operander till DDIR
; Bit BIW flaggar IW

DDTABLE:	DC	'IB'
		DB	0DDH,3
		DC	'IW'
		DB	0FDH,7 OR 1 SHL BIW
		DC	'W'
		DB	0,0
		DC	'LW'
		DB	0,4
		DB	0


; Tillåtna kombinationer av DDIR mode,mode
; Bit BIW flaggar IW

DDXLATS:	DB	30H	;IB,W
		DB	3	;W,IB
		DB	70H	;IW,W
		DB	7	;W,IW
		DB	34H	;IB,LW
		DB	43H	;LW,IB
		DB	74H	;IW,LW
		DB	47H	;LW,IW
DDXLAT:		EQU	$-1
DDXLAT$:	EQU	$-DDXLATS
		DB	1,1,2 OR 1 SHL BIW,2 OR 1 SHL BIW,5,5
		DB	6 OR 1 SHL BIW,6 OR 1 SHL BIW


; Operander till SETC och RESC

CBTABLE:	DC	'LW'
		DB	0CDH,1
		DC	'LCK'
		DB	0CDH,2
		DC	'XM'
		DB	0CDH,3
		DB	0


; Klassindelad funktionstabell, max 256 jobb totalt
; Adressen till adressen som hämtas här bildas i STMNT
; av det index (vänster byte), som kommer efter ordet i
; fortsättningstabellen (POSX) för aktuell instruktion.
; OBS!	Lägg nya jobb SIST i sin klasstabell.
;
; KLASS 1
; Instruktioner utan operand och pseudodirektiv
; med eller utan operand.

JOB:		DW	OPKODC	;DAA, SCF, CCF, CPL etc
[ 1]		DW	FIXEDC	;LDIR, LDDR, CPI etc
[ 2]		DW	IRET	;RET
[ 3]		DW	PDB	;DB, DEFB, DUP, DUPW, DUPD
[ 4]		DW	PDW	;DW, DEFW
[ 5]		DW	PDEFM	;DEFM
[ 6]		DW	PDC	;DC
[ 7]		DW	PEND	;END, ALIGN, PTTL m fl
[ 8]		DW	PREFS	;REFS, REM, FILE, REFM
[ 9]		DW	PREF	;REF
[10]		DW	IDIEI	;DI, EI
[11]		DW	FIXFDC	;EXXY
[12]		DW	FIXDDC	;CPLW, EXXX, MTEST
[13]		DW	PDD	;DD
[14]		DW	IDDIR	;DDIR
[15]		DW	IRESC	;RESC och SETC
KLASS1:		EQU	($-JOB)/2
K1:		EQU	0	;Startindex i klass 1
K2:		EQU	KLASS1	;Startindex i klass 2


; KLASS 2
; Instruktioner utan operand med frivillig multipel.
; STMNT tar multipeln, om det finns någon.

[ 0]		DW	OPKODC	;RLA, RLCA etc
[ 1]		DW	FIXEDC	;LDI, LDD etc
KLASS2:		EQU	($-JOB)/2
K3:		EQU	KLASS2	;Startindex i klass 3


; KLASS 3
; Instruktioner och pseudodirektiv med en (1)
; operand. STMNT utvärderar operanden.

[ 0]		DW	IJP	;JP
[ 1]		DW	ICALL	;CALL
[ 2]		DW	IJR	;JR
[ 3]		DW	IDJNZ	;DJNZ
[ 4]		DW	IARITB	;CP, AND, OR, XOR
[ 5]		DW	IBIT	;BIT, RES
[ 6]		DW	ISET	;SET
[ 7]		DW	IRST	;RST
[ 8]		DW	IIM	;IM
[ 9]		DW	ISCAL	;SCAL
[10]		DW	PDS	;DS, DEFS
[11]		DW	PEQU	;EQU
[12]		DW	PDEFL	;DEFL
[13]		DW	PORG	;ORG
[14]		DW	DIVMULW	;DIVUW, MULTW & MULTUW
[15]		DW	ICALR	;CALR
[16]		DW	IMLT	;MLT
[17]		DW	ITST	;TST och TSTIO
KLASS3:		EQU	($-JOB)/2
K4:		EQU	KLASS3	;Startindex i klass 4


; KLASS 4
; Instruktioner med en (1) operand följd av
; frivillig multipel, ny operand med multipel osv.
; STMNT utvärderar den första operanden.

[ 0]		DW	INCDEC	;INC, DEC
[ 1]		DW	ISHIFT	;RL, RR, RLC, RRC, SLA etc
[ 2]		DW	PUSHPOP	;PUSH, POP
[ 3]		DW	IARITW	;ADCW, ADDW, ANDW, SUBW, CPW m fl
[ 4]		DW	ISHIFTW	;RLW, RLCW, RRW, RRCW m fl
[ 5]		DW	ISWAP	;SWAP
KLASS4:		EQU	($-JOB)/2
K5:		EQU	KLASS4	;Startindex i klass 5


; KLASS 5
; Instruktioner och pseudodirektiv med sammansatt
; operand typ dst,src.
; STMNT utvärderar både dst och src.

[ 0]		DW	ILD	;LD
[ 1]		DW	@IIN	;IN
[ 2]		DW	@IOUT	;OUT
[ 3]		DW	@IEX	;EX
[ 4]		DW	PIDNT	;IDNT
[ 5]		DW	ILDW	;LDW
[ 6]		DW	@IINW	;INW
[ 7]		DW	ILDC	;LDCTL
[ 8]		DW	@IIN0	;IN0
[ 9]		DW	@IINA	;INA
[10]		DW	@IINAW	;INAW
[11]		DW	@PWIDTH	;WIDTH pseudo
[12]		DW	@IOUTW	;OUTW
[13]		DW	@IOUT0	;OUT0
[14]		DW	@IOUTA	;OUTA
[15]		DW	@IOUTAW	;OUTAW
KLASS5:		EQU	($-JOB)/2
K6:		EQU	KLASS5	;Startindex i klass 6


; KLASS 6
; Instruktioner och pseudodirektiv med sammansatt
; operand typ dst,src följd av frivillig multipel.
; STMNT utvärderar dst och src och multipeln,
; om det finns någon.

[ 0]		DW	@IADC	;ADC
[ 1]		DW	@ISBC	;SBC
[ 2]		DW	@IADD	;ADD
[ 3]		DW	@ISUB	;SUB
KLASS6:		EQU	($-JOB)/2


; Adresser till fortsättningstabeller beroende
; på första bokstaven i opkodsfältet

POS1:		DC	'L'	;Första bokstaven är L
		DW	POSL	;Resten av ordet finns i POSL
		DC	'C'
		DW	POSC
		DC	'D'
		DW	POSD
		DC	'I'
		DW	POSI
		DC	'A'
		DW	POSA
		DC	'S'
		DW	POSS
		DC	'O'
		DW	POSO
		DC	'E'
		DW	POSE
		DC	'R'
		DW	POSR
		DC	'M'
		DW	POSM
		DC	'T'
		DW	POST
		DC	'F'
		DW	POSF
		DB	0


; Övriga instruktioner
; Vänster byte är index i JOB. Om bit 7 är satt
; är det en villkorsinstruktion.

		DC	'JP'		;JP, Klass 3 Jobb 0
		DB	K3+0 OR 80H,0E9H
		DC	'JR'		;JR
		DB	K3+2 OR 80H,18H
		DC	'PUSH'		;PUSH
		DB	K4+2,0E5H
		DC	'POP'		;POP
		DB	K4+2,0E1H
		DC	'BIT'		;BIT
		DB	K3+5,46H
		DC	'XOR'		;XOR
		DB	K3+4,0AEH
		DC	'XORW'		;XORW
		DB	K4+3,0ACH
		DC	'NEG'		;NEG
		DB	K1+1,44H
		DC	'NEGW'		;NEGW
		DB	K1+1,54H
 		DC	'BTEST'		;BTEST
		DB	K1+1,0CFH
		DC	'NOP'		;NOP
		DB	K2+0,0
		DC	'HALT'		;HALT
		DB	K1+0,76H
		DC	'WIDTH'		;WIDTH
		DB	K5+11,1 SHL BFCT OR 1 SHL BCOPY
		DB	0		;Slut tabell


; 1:a bokstaven är A

POSA:		DC	'DD'		;ADD
		DB	K6+2,1 SHL BFCT
		DC	'DDW'		;ADDW
		DB	K4+3,84H
		DC	'ND'		;AND
		DB	K3+4,0A6H
		DC	'NDW'		;ANDW
		DB	K4+3,0A4H
		DC	'DC'		;ADC
		DB	K6+0,1 SHL BFCT
		DC	'DCW'		;ADCW
		DB	K4+3,8CH
		DC	'LIGN'		;ALIGN
		DB	K1+7,3
		DB	0


; 1:a bokstaven är C

POSC:		DC	'ALL'		;CALL
		DB	K3+1 OR 80H,0CDH
		DC	'ALR'		;CALR
		DB	K3+15 OR 80H,0CDH
		DC	'P'		;CP
		DB	K3+4,0BEH
		DC	'PW'		;CPW
		DB	K4+3,0BCH
		DC	'CF'		;CCF
		DB	K1+0,3FH
		DC	'PL'		;CPL
		DB	K1+0,2FH
		DC	'PLW'		;CPLW
		DB	K1+12,2FH
		DC	'PIR'		;CPIR
		DB	K1+1,0B1H
		DC	'PDR'		;CPDR
		DB	K1+1,0B9H
		DC	'PI'		;CPI
		DB	K1+1,0A1H
		DC	'PD'		;CPD
		DB	K1+1,0A9H
		DC	'ODE'		;CODE
		DB	K1+7,10
		DB	0


; 1:a bokstaven är D

POSD:		DC	'EC'		;DEC
		DB	K4+0,2BH
		DC	'JNZ'		;DJNZ
		DB	K3+3,10H
		DC	'DIR'		;DDIR
		DB	K1+14,0C0H
		DC	'B'		;DB
		DB	K1+3,0
		DC	'W'		;DW
		DB	K1+4,0
		DC	'S'		;DS
		DB	K3+10,0
		DC	'C'		;DC
		DB	K1+6,0
		DC	'D'		;DD
		DB	K1+13,0
		DC	'AA'		;DAA
		DB	K1+0,27H
		DC	'I'		;DI
		DB	K1+10,0F3H
		DC	'IVUW'		;DIVUW
		DB	K3+14,0B8H
		DC	'UP'		;DUP
		DB	K1+3,2
		DC	'UPW'		;DUPW
		DB	K1+3,3
		DC	'UPD'		;DUPD
		DB	K1+3,4
		DC	'ATA'		;DATA
		DB	K1+7,11
		DC	'EFB'		;DEFB
		DB	K1+3,1
		DC	'EFW'		;DEFW
		DB	K1+4,0
		DC	'EFM'		;DEFM
		DB	K1+5,0
		DC	'EFS'		;DEFS
		DB	K3+10,0
		DC	'EFL'		;DEFL
		DB	K3+12,0
		DB	0


; 1:a bokstaven är E

POSE:		DC	'X'		;EX
		DB	K5+3,1 SHL BFCT
		DC	'QU'		;EQU
		DB	K3+11,0
		DC	'XX'		;EXX
		DB	K1+0,0D9H
		DC	'I'		;EI
		DB	K1+10,0FBH
		DC	'XTS'		;EXTS
		DB	K1+1,65H
		DC	'XTSW'		;EXTSW
		DB	K1+1,75H
		DC	'XALL'		;EXALL
		DB	K1+1,0D9H
		DC	'XXX'		;EXXX
		DB	K1+12,0D9H
		DC	'XXY'		;EXXY
		DB	K1+11,0D9H
		DC	'ND'		;END
		DB	K1+7,0
		DC	'NDM'		;ENDM
		DB	K1+7,9
		DB	0


; 1:a bokstaven är F

POSF:		DC	'ILE'		;FILE
		DB	K1+8,2
		DB	0


; 1:a bokstaven är I

POSI:		DC	'NC'		;INC
		DB	K4+0,23H
		DC	'N'		;IN
		DB	K5+1,1 SHL BFCT
		DC	'NW'		;INW
		DB	K5+6,1 SHL BFCT
		DC	'N0'		;IN0
		DB	K5+8,1 SHL BFCT
		DC	'NA'		;INA
		DB	K5+9,1 SHL BFCT
		DC	'NAW'		;INAW
		DB	K5+10,1 SHL BFCT
		DC	'M'		;IM
		DB	K3+8,0
		DC	'NIR'		;INIR
		DB	K1+1,0B2H
		DC	'NIRW'		;INIRW
		DB	K1+1,0F2H
		DC	'NDR'		;INDR
		DB	K1+1,0BAH
		DC	'NDRW'		;INDRW
		DB	K1+1,0FAH
		DC	'NI'		;INI
		DB	K2+1,0A2H
		DC	'NIW'		;INIW
		DB	K2+1,0E2H
		DC	'ND'		;IND
		DB	K2+1,0AAH
		DC	'NDW'		;INDW
		DB	K2+1,0EAH
		DC	'DNT'		;IDNT
		DB	K5+4,0
		DB	0


; 1:a bokstaven är L

POSL:		DC	'D'		;LD
		DB	K5+0,0
		DC	'DW'		;LDW
		DB	K5+5,0
		DC	'DCTL'		;LDCTL
		DB	K5+7,0
		DC	'DIR'		;LDIR
		DB	K1+1,0B0H
		DC	'DIRW'		;LDIRW
		DB	K1+1,0F0H
		DC	'DDR'		;LDDR
		DB	K1+1,0B8H
		DC	'DDRW'		;LDDRW
		DB	K1+1,0F8H
		DC	'DI'		;LDI
		DB	K2+1,0A0H
		DC	'DIW'		;LDIW
		DB	K2+1,0E0H
		DC	'DD'		;LDD
		DB	K2+1,0A8H
		DC	'DDW'		;LDDW
		DB	K2+1,0E8H
		DB	0


; 1:a bokstaven är M

POSM:		DC	'LT'		;MLT
		DB	K3+16,4CH
		DC	'TEST'		;MTEST
		DB	K1+12,0CFH
		DC	'ULTW'		;MULTW
		DB	K3+14,90H
		DC	'ULTUW'		;MULTUW
		DB	K3+14,98H
		DC	'ACRO'		;MACRO
		DB	K1+7,8
		DC	'SG'		;MSG
		DB	K1+7,2
		DB	0


; 1:a bokstaven är O

POSO:		DC	'R'		;OR
		DB	K3+4,0B6H
		DC	'RW'		;ORW
		DB	K4+3,0B4H
		DC	'UT'		;OUT
		DB	K5+2,1 SHL BFCT
		DC	'UTW'		;OUTW
		DB	K5+12,1 SHL BFCT
		DC	'UT0'		;OUT0
		DB	K5+13,1 SHL BFCT
		DC	'UTA'		;OUTA
		DB	K5+14,1 SHL BFCT
		DC	'UTAW'		;OUTAW
		DB	K5+15,1 SHL BFCT
		DC	'TIM'		;OTIM
		DB	K1+1,83H
		DC	'TIMR'		;OTIMR
		DB	K1+1,93H
		DC	'TIR'		;OTIR
		DB	K1+1,0B3H
		DC	'TIRW'		;OTIRW
		DB	K1+1,0F3H
		DC	'TDR'		;OTDR
		DB	K1+1,0BBH
		DC	'TDRW'		;OTDRW
		DB	K1+1,0FBH
		DC	'UTI'		;OUTI
		DB	K2+1,0A3H
		DC	'UTIW'		;OUTIW
		DB	K2+1,0E3H
		DC	'UTD'		;OUTD
		DB	K2+1,0ABH
		DC	'UTDW'		;OUTDW
		DB	K2+1,0EBH
		DC	'TDM'		;OTDM
		DB	K2+1,8BH
		DC	'TDMR'		;OTDMR
		DB	K2+1,9BH
		DC	'RG'		;ORG
		DB	K3+13,0
		DB	0


; 1:a bokstaven är R

POSR:		DC	'ET'		;RET
		DB	K1+2 OR 80H,0C9H
		DC	'ST'		;RST
		DB	K3+7,0C7H
		DC	'ES'		;RES
		DB	K3+5,86H
		DC	'LA'		;RLA
		DB	K2+0,17H
		DC	'RA'		;RRA
		DB	K2+0,1FH
		DC	'LCA'		;RLCA
		DB	K2+0,7
		DC	'RCA'		;RRCA
		DB	K2+0,15
		DC	'L'		;RL
		DB	K4+1,16H
		DC	'LW'		;RLW
		DB	K4+4,10H
		DC	'R'		;RR
		DB	K4+1,1EH
		DC	'RW'		;RRW
		DB	K4+4,18H
		DC	'ESC'		;RESC
		DB	K1+15,0FFH
		DC	'LC'		;RLC
		DB	K4+1,6
		DC	'LCW'		;RLCW
		DB	K4+4,0
		DC	'RC'		;RRC
		DB	K4+1,14
		DC	'RCW'		;RRCW
		DB	K4+4,8
		DC	'LD'		;RLD
		DB	K1+1,6FH
		DC	'RD'		;RRD
		DB	K1+1,67H
		DC	'ETI'		;RETI
		DB	K1+1,4DH
		DC	'ETB'		;RETB
		DB	K1+1,55H
		DC	'ETN'		;RETN
		DB	K1+1,45H
		DC	'EFS'		;REFS
		DB	K1+8,0
		DC	'EF'		;REF
		DB	K1+9,0
		DC	'EM'		;REM
		DB	K1+8,1
		DC	'EFM'		;REFM
		DB	K1+8,3
		DB	0


; 1:a bokstaven är S

POSS:		DC	'BC'		;SBC
		DB	K6+1,1 SHL BFCT
		DC	'BCW'		;SBCW
		DB	K4+3,9CH
		DC	'UB'		;SUB
		DB	K6+3,1 SHL BFCT
		DC	'UBW'		;SUBW
		DB	K4+3,94H
		DC	'ET'		;SET
		DB	K3+6,0C6H
		DC	'ETC'		;SETC
		DB	K1+15,0F7H
		DC	'WAP'		;SWAP
		DB	K4+5,0EH
		DC	'CAL'		;SCAL
		DB	K3+9,0DFH
		DC	'CF'		;SCF
		DB	K1+0,37H
		DC	'LA'		;SLA
		DB	K4+1,26H
		DC	'LAW'		;SLAW
		DB	K4+4,20H
		DC	'RA'		;SRA
		DB	K4+1,2EH
		DC	'RAW'		;SRAW
		DB	K4+4,28H
		DC	'RL'		;SRL
		DB	K4+1,3EH
		DC	'RLW'		;SRLW
		DB	K4+4,38H
		DC	'LP'		;SLP
		DB	K1+1,76H
		DC	'TL'		;STL
		DB	K1+7,6
		DC	'TLN'		;STLN
		DB	K1+7,7
		DC	'TRIP'		;STRIP
		DB	K1+7,12
		DB	0


; 1:a bokstaven är T

POST:		DC	'ST'		;TST
		DB	K3+17,4
		DC	'STIO'		;TSTIO
		DB	K3+17,74H
		DC	'TL'		;TTL
		DB	K1+7,4
		DC	'TLN'		;TTLN
		DB	K1+7,5
		DB	0


; Tabell med villkorsord

VILKTB:		DC	'IF'
		DW	PIF
		DC	'COND'
		DW	PIF
		DC	'ENDIF'
		DW	PENDC
		DC	'ENDC'
		DW	PENDC
		DC	'ELSE'
		DW	PELSE
		DB	0
		CRC			;CRC
ZAP$:		EQU	$
		IF	ZAP$ GT PGM+1FFFH
		ORG	PGM
		ENDC
		REFS	ZAPWKEQU
		REF
		END


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Equates och Workspace		      ¦
¦					      ¦
¦	Entry: ........... ZAPWRK.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Initierande equates

FALSE:		EQU	0
TRUE:		EQU	NOT FALSE
WRK:		EQU	FALSE
ASC:		EQU	FALSE
		REFS	SYSEQU
RAM:		REF
		WIDTH	12,96


; Diverse equates

OP1:		EQU	2	;Operandposition 1
OP2:		EQU	1	;Operandposition 2
EKST:		EQU	8AH	;Start extra kommentar
EKSP:		EQU	8BH	;Stopp extra kommentar
NFCL:		EQU	1	;Antal filer på kommandoraden
LBSIZE:		EQU	256	;Storleken av LINBUF i ZAPFC
ÖSIZE:		EQU	46	;Antal tecken överskrift & TTL
RCTR:		EQU	3	;Retry counter
SB:		EQU	0B000H	;Sektorbufferns adress i OCMAP
SB$:		EQU	SB+1000H
SBNSC:		EQU	(SB$-SB)/256
SXBUF$:		EQU	1000H	;4096 st räcker väl?
SXBUF:		EQU	SB-SXBUF$;Start flaggor för x/sx
SYSDEF:		EQU	0BF00H	;Defaultadr för SYSTAR i map 0
SYMAP:		EQU	0	;Symboltabellen i map 0
TXMAP:		EQU	11H	;Källkoden i map 1
RSMAP:		EQU	22H	;Remote SY i map 2
OCMAP:		EQU	22H	;Objektkoden (SB) i map 2
SXMAP:		EQU	22H	;Flaggor för x/sx i map 2
FCMAP:		EQU	33H	;FCAL-rutiner i map 3
		IF	WRK OR ASC
SYESC:		EQU	2
TXESC:		EQU	2
RSESC:		EQU	2
OCESC:		EQU	2
SXESC:		EQU	2
FCESC:		EQU	2
SSY:		EQU	3000H
STX:		EQU	3000H
SRS:		EQU	3000H
SFC:		EQU	7000H
		ELSE
SYESC:		EQU	3
TXESC:		EQU	3
RSESC:		EQU	3
OCESC:		EQU	3
SXESC:		EQU	3
FCESC:		EQU	3
SSY:		EQU	RAM	;Start för symbolerna
STX:		EQU	RAM	;Start för källkoden
SRS:		EQU	RAM	;Start för remote SY
SFC:		EQU	RAM	;Start för FCAL
		ENDC


; Workspace

		ORG	0C440H
		IF	WRK
SOWIDZ:		EQU	0	;Identitet workspace
		ENDC
ZAPSP:		DS	2	;SP vid start
ZAPFCA:		DS	2	;Adressen till ZFCAL i dos
MULTIX:		DS	2	;Adr till instruktionshanterare
BRKSAV:		DS	2	;Sparad BREAK
MAPSAV:		DS	2	;Map & escape vid start
ETX:		DS	2	;Källkodens slutadress
SYSTAR:		DS	2	;Pekare till ny symbolfil (REFS)
SYS:		DS	2	;Symboltab startadress
SYE:		DS	2	;Symboltab slutadress
RSE:		DS	2	;Slut remote SY
ZCLINP:		DS	2	;ZAPs CLINP
MSVAL:		DS	2	;Tal att skriva ut i MSAGE
FELR:		DS	2	;Felräknare
FORORG:		DS	2	;Forward ORG
HIFORORG:	DS	2	; hi
RESP:		DS	2	;SP för retur till DOPASS
LCCT:		DS	2	;Location Counter ($)
HILCCT:		DS	2	; hi
RACTR:		DS	2	;Location Counter för RA
HIRACTR:	DS	2	; hi
ADRESS:		DS	2	;Instruktionens startadress
HIADRESS:	DS	2	; hi
VALUE:		DS	2	;Operandens värde
HIVALUE:	DS	2	; hi
HIMVALUE:	DS	2	;Temp åt MULTI
INDEX:		DS	2	;dd för operand 1
HIINDEX:	DS	2	; hi
ASYVAL:		DS	2	;Adress i SY där LC ska in
LINE:		DS	2	;Adress till nästa rad
PASTSY:		DS	2	;Pekar efter SY i TXMAP
SEKTOR:		DS	2	;Sektoradress på disken
SBPTR:		DS	2	;Sektorbufferns adress
SIDR:		DS	2	;Sidräknare
DDCODE:		DS	2	;Opkod senaste DDIR genererade
SCRWRK:		DS	32	;Scratch
VILLK:		DS	2	;Villkorspekare
		DS	16	;16 villkorsnivåer
KORD:		EQU	$	;Kontrollordens basadress
FOPT1:		DS	1	;Optioner på kommandoraden
FOPT2:		DS	1	; 2
FPASS:		DS	1	;Flaggor för varje pass
LFLG1:		DS	1	;Flaggor för varje rad
LFLG2:		DS	1	; 2
LFLG3:		DS	1	; 3
OLDLFLG3:	DS	1	;För MULTI
NEWLFLG3:	DS	1	;
CC:		DS	1	;Condition Code
RCODE:		DS	1	;Registerkod för BX
IFLG1:		DS	1	;Flaggor från instruktionstabell
IFLG2:		DS	1	;Flaggor från offsettabell
SEP:		DS	1	;+ framför antal byte DS
OFOBJ:		DS	1	;Offset nästa byte i listbuffer
AFUNC:		DS	1	;Aritmetisk funktionskod
RADR:		DS	1	;Antal rader på skärmen
LINES:		DS	1	;Radräknare utmatning
FOUT:		DS	1	;Flaggor för utmatning
FILR:		DS	1	;Filräknare i GPAR
RASF:		DS	1	;Räknare för assemblerade filer
FASS:		DS	1	;Filnr att assemblera
MISC1:		DS	1	;Diverse flaggor
USERX:		DS	1	;Flaggor för extern användare
CMAC:		DS	1	;Current makro
SPAGE:		DS	1	;2 vid sidan 100
RETRY:		DS	1	;Retry counter
CTLEN:		DS	1	;Länden av ASCII-citat
CTBYTE:		DS	1	;ASCII byte i CITAT
MMAIN:		DS	1	;Huvudflaggor för makron
OPFLG:		DS	1	;Flaggor för varje operand
SXPOS:		DS	1	;1 för varje oper. med odef. sy.
MXCTR:		DS	1	;Multipel i MULTI
GGR:		DS	1	;De med bara en multipel
COMMENT:	DS	1	;Nivå för nästade kommentarer i FÖRBI
DDFLAG:		DS	1	;DD kod om denna rad är DDIR
LASTDDFLAG:	DS	1	;Minns om förra raden var DDIR
rrCodeA:	DS	1	;Kod från RRCodeA * 16 (SHL 4)
rrCodeC:	DS	1	;Kod från RRCodeC * 16 (SHL 4)
rsCode:		DS	1	;Kod från RSCode * 16 (SHL 4)
P2CPI:		DS	1	;CPI under pass 2
P2CPL:		DS	1	; CPL
EP2CPI:		DS	1	;CPI efter pass 2
EP2CPL:		DS	1	; CPL
WKDRV:		DS	1	;WKFCB drive
WKFCB:		DS	20	;FCB för inläsning
FLDRV:		DS	1	;FLFCB drive
FLFCB:		DS	20	;FCB för inläsning
OCDRV:		DS	1	;OCFCB drive
OCFCB:		DS	20	;FCB för objektkod
SYDRV:		DS	1	;SYFCB drive
SYFCB:		DS	20	;FCB för symbolfil
IFCB:		DS	21*NFCL	;FCBer för filer på kommandorad
OBJ:		DS	256	;Assemblerad instruktion
OBJSIZ:		EQU	$-OBJ-1
		IF	WRK
EOWIDZ:		EQU	0	;Slut på workspace id
		ENDC


; Offset till IX relativt KORD

		IF	WRK
OFFIXZ:		EQU	0	;Offset id
		ENDC
$FOPT1:		EQU	FOPT1-KORD
$FPASS:		EQU	FPASS-KORD
$LFLG1:		EQU	LFLG1-KORD
$LFLG2:		EQU	LFLG2-KORD
$LFLG3:		EQU	LFLG3-KORD
$OLDLFLG3:	EQU	OLDLFLG3-KORD
$NEWLFLG3:	EQU	NEWLFLG3-KORD
$CC:		EQU	CC-KORD
$RCODE:		EQU	RCODE-KORD
$IFLG1:		EQU	IFLG1-KORD
$IFLG2:		EQU	IFLG2-KORD
$OFOBJ:		EQU	OFOBJ-KORD
$SEP:		EQU	SEP-KORD
$AFUNC:		EQU	AFUNC-KORD
$RADR:		EQU	RADR-KORD
$LINES:		EQU	LINES-KORD
$FOUT:		EQU	FOUT-KORD
$FILR:		EQU	FILR-KORD
$RASF:		EQU	RASF-KORD
$FASS:		EQU	FASS-KORD
$MISC1:		EQU	MISC1-KORD
$USERX:		EQU	USERX-KORD
$FOPT2:		EQU	FOPT2-KORD
$CMAC:		EQU	CMAC-KORD
$SPAGE:		EQU	SPAGE-KORD
$RETRY:		EQU	RETRY-KORD
$CTLEN:		EQU	CTLEN-KORD
$CTBYTE:	EQU	CTBYTE-KORD
$MMAIN:		EQU	MMAIN-KORD
$OPFLG:		EQU	OPFLG-KORD
$SXPOS:		EQU	SXPOS-KORD
$MXCTR:		EQU	MXCTR-KORD
$GGR:		EQU	GGR-KORD
$COMMENT:	EQU	COMMENT-KORD
$DDFLAG:	EQU	DDFLAG-KORD
$LASTDDFLAG:	EQU	LASTDDFLAG-KORD
$rrCodeA:	EQU	rrCodeA-KORD
$rrCodeC:	EQU	rrCodeC-KORD
$rsCode:	EQU	rsCode-KORD
		IF	WRK
OFFIXE:		EQU	0	;Slut offset
		ENDC


; Rutinnummer för FCAL

FC:		EQU	1	;Reserverade nummer
@MACRO:		EQU	FC+0	;MACRO
@ENDM:		EQU	FC+1	;ENDM
@CODE:		EQU	FC+2	;CODE
@DATA:		EQU	FC+3	;DATA
@GMAC:		EQU	FC+4	;Generera makro
@FCEXT:		EQU	FC+5	;Init ZAP ext
@FEL:		EQU	FC+6	;Rapportera ett fel
@LIST:		EQU	FC+7	;Lista en rad
@TXOUT:		EQU	FC+8	;Utmatning
@INPUT:		EQU	FC+9	;Ta kommandoraden
@ALIGN:		EQU	FC+10	;ALIGN
@AXTL:		EQU	FC+11	;TTL eller STL
@DXTL:		EQU	FC+12	;TTLN eller STLN
@WRMC:		EQU	FC+13	;Makroarean till disken
@REFM:		EQU	FC+14	;REFM
@MAIN:		EQU	FC+15	;ZAPs huvudrutin
@DMSG:		EQU	FC+16	;Filnamn som tas bort
@MEMOV:		EQU	FC+17	;Minnet fullt
@DB:		EQU	FC+18	;DB
@DUP:		EQU	FC+19	;DUP
@DUPW:		EQU	FC+20	;DUPW
@DW:		EQU	FC+21	;DW
@DS:		EQU	FC+22	;DS
@END:		EQU	FC+23	;END
@IINW:		EQU	FC+24	;INW
@IIN0:		EQU	FC+25	;IN0
@IF:		EQU	FC+26	;IF
@ELSE:		EQU	FC+27	;ELSE
@ENDC:		EQU	FC+28	;ENDC
@MSAGE:		EQU	FC+29	;Skriv ett meddelande
@MULTI:		EQU	FC+30	;Multipla operander
@IINA:		EQU	FC+31	;INA
@RR_R:		EQU	FC+32	;LD RR,R
@DD		EQU	FC+33	;DD
@XY_R:		EQU	FC+34	;LD XY,R
@IARITB:	EQU	FC+35	;IARITB
@IEX:		EQU	FC+36	;EX
@FILE:		EQU	FC+37	;Ny källkodsfil
@IIN:		EQU	FC+38	;IN
@IOUT:		EQU	FC+39	;OUT
@IADC:		EQU	FC+40	;ADC
@ISBC:		EQU	FC+41	;SBC
@IADD:		EQU	FC+42	;ADD
@DIVMULW:	EQU	FC+43	;DIVMULW
@IARITW:	EQU	FC+44	;IARITW
@PWIDTH:	EQU	FC+45	;WIDTH, pseudo
@WIDTH:		EQU	FC+46	;Sätt WIDTH
@MSG:		EQU	FC+47	;MSG
@IINAW:		EQU	FC+48	;INAW
@IOUTW:		EQU	FC+49	;OUTW
@IOUT0:		EQU	FC+50	;OUT0
@IOUTA:		EQU	FC+51	;OUTA
@IOUTAW:	EQU	FC+52	;OUTAW
@ISUB:		EQU	FC+53	;SUB
@RA:		EQU	FC+54	;Beräkna RA
@DUPD:		EQU	FC+55	;DUPD
@ISHIFTW:	EQU	FC+56	;ISHIFTW
@IIM:		EQU	FC+57	;IM
@ISHIFT:	EQU	FC+58	;ISHIFT
@IMLT:		EQU	FC+59	;IMLT
@ISWAP:		EQU	FC+60	;ISWAP
@ITST:		EQU	FC+61	;ITST


; Bitar i FOPT1, optioner

BLIST:		EQU	0	;L - Lista
BPRINT:		EQU	1	;P - Printerutmatning
BSYSAV:		EQU	2	;C - Symboltabellen till disken
BSTOP:		EQU	3	;S - Stopp var 15:e rad i OUTPUT
BGENE:		EQU	4	;G - Skriv alla byte
BDEL:		EQU	5	;D - Undertryck villkorsrader
BFORCE:		EQU	6	;F - Tvinga pass 2
BOBJCT:		EQU	7	;Objektkod begärd


; Bitar i FOPT2, extra optioner

BNABO:		EQU	0	;N - Undertryck abort go
BMCSAV:		EQU	1	;M - Makron till disken
BNOCRC:		EQU	2	;I - Ingen CRC på objektkod
BENTLIN:	EQU	3	;T - Ingen trunkering av långa rader
				;4 LEDIG
				;5 LEDIG
				;6 LEDIG
				;7 LEDIG


; Bitar i FPASS, kontrollord för varje pass

BPASS:		EQU	0	;0 = pass 1, 1 = pass 2
BPUTC:		EQU	1	;Börjat generera kod
BIDNT:		EQU	2	;IDNT finns
BSXOVF:		EQU	3	;Overflow i SXBUF
BTTL:		EQU	4	;TTL aktiv (title)
BSTL:		EQU	5	;STL aktiv (sub title)
				;6 LEDIG
				;7 LEDIG


; Bitar i LFLG1, kontrollord för varje rad

BLABEL:		EQU	0	;Det finns en label på raden
BNXLBL:		EQU	1	;Odefinierad symbol i operanden
BPADDR:		EQU	2	;Skriv ut adressen i LIST
BCOND:		EQU	3	;Gällande villkor
BEXLBL:		EQU	4	;Symbolen finns redan i SY
BPDC:		EQU	5	;Pseudo DC, så sätt bit 7 sist
BERRM:		EQU	6	;Skriver felmeddelande i LIST
BEND:		EQU	7	;END påträffad


; Bitar i LFLG2, kontrollord för varje rad

BPDB:		EQU	0	;CITAT: denna rad är DB
BSTEP:		EQU	1	;Makro. Ej förbi komma i KOMMA
BPRIM:		EQU	2	;Pseudo LD dst',src
BMINUS:		EQU	3	;Minus i operanden
BINDEX:		EQU	4	;Finns 8 eller 16 bitars index
BRA:		EQU	5	;Relativ adress; uttryck inom <>
BEXX:		EQU	6	;Gör EXX
BEXAF:		EQU	7	;Gör EX AF,AF
MPMASK:		EQU	3FH	;Deaktiverar BEXX & BEXAF


; Bitar i LFLG3, kontrollord för varje rad

BMSYNC:		EQU	0	;MULTI förväntar sig register
BMULTI:		EQU	1	;MULTI tillåter t ex PUSH 3,3,3
BPUTX:		EQU	2	;Använd INDEX i PutIndex
BDOME:		EQU	3	;Gör DO_ME (klass 6)
BFMI:		EQU	4	;Tvinga instruktion i MULTI
BEXXX:		EQU	5	;IX', så gör EXXX i FIXEX
BEXXY:		EQU	6	;IY', så gör EXXY i FIXEX
BREPEATDD:	EQU	7	;Repetera DDCODE i DO_ONE


; Bitar i OPFLG, kontrollord för varje operand

BUNDEF:		EQU	0	;Odefinierad symbol i operanden
				;1 LEDIG
				;2 LEDIG
				;3 LEDIG
				;4 LEDIG
; BRA:		EQU	5	;Relativ adress; uttryck inom <>
				;6 LEDIG
				;7 LEDIG
OPMASK:		EQU	1 SHL BRA ;Isolera bit BRA


; Bitar i FOUT, kontrollord för utmatning

BHEAD:		EQU	0	;Skriver överskrift i OUTPUT
BUPR:		EQU	1	;Till printern om assignad
				;2 LEDIG
BOSTL:		EQU	3	;Skriver STL i OUTPUT
BNOLO:		EQU	4	;Lista inte denna rad
				;(TTL, STL, TTLN, STLN, WIDTH)
BOTTL:		EQU	5	;Skriver TTL i OUTPUT
BSNCR:		EQU	6	;Stopp vid nästa CR i OUTPUT
				;7 LEDIG


; Bitar i MISC1, diverse flaggor

BSTEPRA:	EQU	0	;Stega fram RACTR i OPKODA
BFILE:		EQU	1	;FILE påträffad
BFRCRD:		EQU	2	;Forcerad inläsning av fil 1
BIYMAP:		EQU	3	;Var är IY? 0 = TXMAP, 1 = FCMAP
BMSVAL:		EQU	4	;MSAGE skriver MSVAL
BNONEST:	EQU	5	;Ingen nestning i FÖRBI [* ... *]
				;6 LEDIG
				;7 LEDIG


; Bitar i MMAIN, kontrollord för makron

BOWNM:		EQU	0	;Eget makro definierat
BMDISK:		EQU	1	;Makron har laddats med REFM
BMDEF:		EQU	2	;Definition av makro pågår
BCOMMA:		EQU	3	;Default på definitionsrad (,CR)
BMACRO:		EQU	4	;Det finns makron
				;5 LEDIG
				;6 LEDIG
				;7 LEDIG


; MMASK används av PMACRO till att sätta bit
; BOWNM, BMDEF och BMACRO

MMASK:		EQU	00010101B


; Bitar i USERX, extra användare

BASC:		EQU	0	;Gå till ZAPLNK vid filbyte
				;1 LEDIG
				;2 LEDIG
				;3 LEDIG
				;4 LEDIG
				;5 LEDIG
				;6 LEDIG
				;7 LEDIG


; Bitar i IFLG1 (höger byte i instruktionstabellen).
; Endast för jobb i klass 5 och 6.

BFCT:		EQU	0	;Tabell och handler ligger i FC
BCOPY:		EQU	1	;Kopiera raden till LINBUF
				;2 LEDIG
				;3 LEDIG
				;4 LEDIG
				;5 LEDIG
				;6 LEDIG
				;7 LEDIG


; Bitar i IFLG2 (byte 1 i offsettabellen).
; Endast för jobb i klass 5 och 6.

BID:		EQU	0	;Byt plats på dst och src
BRAMOD:		EQU	1	;Tillåtet att använda <>
BXMOD:		EQU	2	;Tillåtet att använda +d/+dd
BIGNEX:		EQU	3	;Ignorera auto EXX & EX AF,AF i DOEX
				;4 LEDIG
				;5 LEDIG
				;6 LEDIG
				;7 LEDIG


; Ovanstående bitdefinitioner på ett annat sätt
; (för att spara plats i källkoden)

IMDATA:		EQU	1	;BID
RAMODE:		EQU	2	;BRAMOD
XMODE:		EQU	4	;BXMOD
IGNEX:		EQU	8	;BIGNEX


; Bitar i DDFLAG
; Bit 2..0 är wim, som används i instruktionen

BIW:		EQU	3	;Flaggar IW
BDDUSED:	EQU	7	;Flaggar used i fall allt annat är 0


; Beräknade FCB Equates; WKFCB

		REFS	SYSEQU
FNAM:		REF
FEXT:		REF
FSFL:		REF
FUFL:		REF
FSEC:		REF
FNSC:		REF
FLDA:		REF
FEXA:		REF
WKFNAM:		EQU	WKFCB+FNAM
WKFEXT:		EQU	WKFCB+FEXT
WKFSFL:		EQU	WKFCB+FSFL
WKFUFL:		EQU	WKFCB+FUFL
WKFSEC:		EQU	WKFCB+FSEC
WKFNSC:		EQU	WKFCB+FNSC
WKFLDA:		EQU	WKFCB+FLDA
WKFEXA:		EQU	WKFCB+FEXA


; Beräknade FCB Equates; FLFCB

FLFNAM:		EQU	FLFCB+FNAM
FLFEXT:		EQU	FLFCB+FEXT
FLFSFL:		EQU	FLFCB+FSFL
FLFUFL:		EQU	FLFCB+FUFL
FLFSEC:		EQU	FLFCB+FSEC
FLFNSC:		EQU	FLFCB+FNSC
FLFLDA:		EQU	FLFCB+FLDA
FLFEXA:		EQU	FLFCB+FEXA


; Beräknade FCB Equates; OCFCB

OCFNAM:		EQU	OCFCB+FNAM
OCFEXT:		EQU	OCFCB+FEXT
OCFSFL:		EQU	OCFCB+FSFL
OCFUFL:		EQU	OCFCB+FUFL
OCFSEC:		EQU	OCFCB+FSEC
OCFNSC:		EQU	OCFCB+FNSC
OCFLDA:		EQU	OCFCB+FLDA
OCFEXA:		EQU	OCFCB+FEXA


; Beräknade FCB Equates; SYFCB

SYFNAM:		EQU	SYFCB+FNAM
SYFEXT:		EQU	SYFCB+FEXT
SYFSFL:		EQU	SYFCB+FSFL
SYFUFL:		EQU	SYFCB+FUFL
SYFSEC:		EQU	SYFCB+FSEC
SYFNSC:		EQU	SYFCB+FNSC
SYFLDA:		EQU	SYFCB+FLDA
SYFEXA:		EQU	SYFCB+FEXA
$END:		END


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Diverse rutiner för FCAL 	      ¦
¦					      ¦
¦	Entry: ........... ZAPFCINI.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... 95 10 01	      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Initierande equates

		REFS	ZAPEQU
WRK:		REF
ASC:		REF
SFC:		REF
ÖSIZE:		REF
LBSIZE:		REF
		REM	ZAPEQU
		REM	SYSEQU
		REFM	SYSMAC
		FILE	ZAPFCMIS
		ORG	SFC
		IDNT	$,$
		WIDTH	12,96
		Z80


; Egna makron
; ICTRL genererar en datastruktur bestående av:
; 1. byte, opkod eller opkodsskelett, default 0.
; 2. ord,  offset till instruktionshanteraren.
; 3. byte, info om instruktionen, default 0.

		MACRO	ICTRL 0,,0
		DATA	BYTE,WORD,BYTE
		ENDM


; Diverse info

FCST:		DW	LINBUF	; 0, behöver TXCOPY veta


; Adresser till alla rutiner i FCMAP

FCJOB:		DW	PMACRO	;MAKRO
[ 1]		DW	PENDM	;ENDM
[ 2]		DW	PCODE	;CODE
[ 3]		DW	PDATA	;DATA
[ 4]		DW	GENMAC	;Generera makro
[ 5]		DW	FCEXT	;Init ZAPFC
[ 6]		DW	FEL	;Rapportera ett fel
[ 7]		DW	LIST	;Lista en rad
[ 8]		DW	TXOUT	;Utmatning
[ 9]		DW	INPUT	;Ta kommandoraden
[10]		DW	PALIGN	;ALIGN
[11]		DW	ACTXTL	;TTL, STL
[12]		DW	DEAXTL	;TTLN, STLN
[13]		DW	WRMC	;Makroarean till disken
[14]		DW	PREFM	;REFM
[15]		DW	MASTER	;ZAPs huvudrutin
[16]		DW	DMSG	;Meddela att fil tas bort
[17]		DW	MEMOV	;Minnet fullt
[18]		DW	PDB	;DB
[19]		DW	PDUP	;DUP
[20]		DW	PDUPW	;DUPW
[21]		DW	PDW	;DW
[22]		DW	PDS	;DS
[23]		DW	PEND	;END
[24]		DW	IINW	;INW
[25]		DW	IIN0	;IN0
[26]		DW	PIF	;IF
[27]		DW	PELSE	;ELSE
[28]		DW	PENDC	;ENDC
[29]		DW	MSAGE	;Meddelande
[30]		DW	MULTI	;Multipla operander
[31]		DW	IINA	;INA
[32]		DW	RR_R	;LD RR,R, pseudo
[33]		DW	PDD	;DD
[34]		DW	XY_R	;LD XY,R, pseudo
[35]		DW	IARITB	;IARITB
[36]		DW	IEX	;EX
[37]		DW	PFILE	;FILE
[38]		DW	IIN	;IN
[39]		DW	IOUT	;OUT
[40]		DW	IADC	;ADC
[41]		DW	ISBC	;SBC
[42]		DW	IADD	;ADD
[43]		DW	DIVMULW	;DIVMULW
[44]		DW	IARITW	;IARITW
[45]		DW	PWIDTH	;WIDTH n1,n2,n3,n4
[46]		DW	Width	;Sätt WIDTH
[47]		DW	PMSG	;MSG
[48]		DW	IINAW	;INAW
[49]		DW	IOUTW	;OUTW
[50]		DW	IOUT0	;OUT0
[51]		DW	IOUTA	;OUTA
[52]		DW	IOUTAW	;OUTAW
[53]		DW	ISUB	;SUB
[54]		DW	RA	;Beräkna RA
[55]		DW	PDUPD	;DUPD
[56]		DW	ISHIFTW	;SHIFTW
[57]		DW	IIM	;IM
[58]		DW	ISHIFT	;SHIFT
[59]		DW	IMLT	;MLT
[60]		DW	ISWAP	;SWAP
[61]		DW	ITST	;TST


; @FCEXT - installera Zap Extension

FCEXT:		LD	HL,FCST		;Kolla CRC
		LD	DE,FCEND
		SCAL	ZCRCA		;Stämmer CRC?
		JP	NZ,ZAPER	;Nej
		RET			;Inget mer att göra


; @MAIN - gör båda passen
; Katalogisera eventuell objektkod.

MASTER:		LD	(IX+$RADR),15	;Antal rader på skärmen
		LD	(IX+$LINES),15	;Init åt TXOUT
		LD	HL,OUTPUT	;Egen utmatning
		LD	(UOUTA),HL
		LD	HL,OUTTB	;Ny uttabell
		SCAL	ZNOM
		SCAL	ZCRLF
		LD	HL,MNAMES	;Start egna makron
		LD	(OWNMAC),HL
		LD	HL,MNAMES+MAXMAC*MLEN$
		LD	(MLIMIT),HL	;Stopp makron
		XOR	A
		SBC	HL,HL
		LD	(MMAIN),A	;Flaggor för makrofunk.
		LD	(MISC1),A	;Diverse flaggor = 0
		LD	(SIDR),HL	;Sidräknaren = 0
		LD	(P2CPI),HL	;0 är invalid printerkod
		LD	(EP2CPI),HL
		CALL	PASS		;Pass 1 alla filer ok?
		JR	Z,MR1		;Ja
		BIT	BFORCE,(IX+$FOPT1);Tvinga pass 2?
		JR	NZ,MR1		;Ja
		Text	'Pass two aborted.'
		RET
MR1:		SCAL	ZCRLF
		BIT	BOBJCT,(IX+$FOPT1);Objektkod?
		JR	Z,MR2		;Nej
		LD	A,(OCDRV)	;Drive för objektkod
		LD	C,A
		SCAL	ZRDIR
		CALL	ZAPER
		LD	HL,(NXTSEC)	;Init startsektorn
		LD	(SEKTOR),HL
		LD	HL,SB		;Init sektorbuffern
		LD	(SBPTR),HL
MR2:		LD	HL,(P2CPI)
		CALL	Width		;Sätt printern
		LD	A,1		;Gör pass 2 alla filer
		CALL	PASS
		BIT	BOBJCT,(IX+$FOPT1);Objektkod?
		RET	Z		;Nej
		OR	A		;Några fel?
		JR	Z,MR4		;Nej
MR3:		Text	'(No object file created)'
		RET
MR4:		CALL	ZFILL		;Nollställ sektorn ut
		LD	A,(OCDRV)
		LD	C,A
		SCAL	ZRDIR
		CALL	ZAPER
		LD	HL,(SEKTOR)
		LD	DE,(NXTSEC)
		OR	A
		SBC	HL,DE		;Uppdaterades SEKTOR?
		JR	Z,MR3		;Nej
		CALL	SAVEOC		;Spara objektkoden
		LD	HL,OCFCB	;Peka på FCB
		JP	ENTER		;Katalogisera filen


; Spara objektkoden
; Beräkna CRC om det är *.GO, *.ED eller *.OV.
; IN:	HL	objektkodens storlek i sektorer
;	DE	startsektor på disken
;	NC
; OBS!	Man MÅSTE reservera plats för CRC med
;	DW 0 i källkoden om det är GO eller ED.

SAVEOC:		LD	(OCFCB+FNSC),HL	;Gör klart OCFCB
		LD	(OCFCB+FSEC),DE
		SBC	HL,HL
		LD	(OCFCB+FSFL),HL
		BIT	BNOCRC,(IX+$FOPT2);Strunta i CRC?
		RET	NZ		;Ja
		LD	DE,(OCFCB+FEXT)
		LD	HL,'OG'
		OR	A
		SBC	HL,DE		;Är det GO?
		JR	Z,SC1		;Ja
		LD	HL,'DE'
		OR	A
		SBC	HL,DE		;Är det ED?
		JR	Z,SC1		;Ja
		LD	HL,'VO'
		OR	A
		SBC	HL,DE		;Är det OV?
		RET	NZ		;Nej
		LD	A,(SFLAG)
		BIT	BOVCRC,A	;Generera CRC för OV?
		RET	Z		;Nej
		LD	A,1		;Typ OV
		JR	SC2
SC1:		XOR	A		;Typ GO/ED
SC2:		EX	AF,AF
		LD	BC,21
		LD	DE,WKDRV
		LD	HL,OCDRV	;Kopiera OCFCB
		LDIR
		LD	HL,(MACPTR)	;Sista makrot
		INC	HL,2		;Förbi FF
		LD	DE,255
		ADD	HL,DE
		LD	L,0		;HL nästa jämna sektor
		XOR	A		;Skippa 0
		LD	DE,TOP		;Stopp
		CALL	READ		;Läs objektkoden
		JR	Z,SC3		;Z = ok
		DEC	A		;Filen för stor?
		JP	Z,MEMOV		;Ja
		LD	A,B		;Fel från dos
		JP	ZAPER
SC3:		INC	DE		;Förbi sista byte
		EX	DE,HL
		SBC	HL,DE
		LD	BC,HL		;BC kodens storlek
		EX	DE,HL		;i DE också
		SCAL	ZCRCB		;Beräkna CRC
		EX	AF,AF
		OR	A		;GO eller ED?
		JR	Z,SC4		;Ja
		LD	(OCFCB+FLDA),BC	;Antal byte i FLDA
		LD	(OCFCB+FEXA),HL	;CRC i FEXA
		RET			;Katalogisera
SC4:		EX	DE,HL		;Skriv in CRC sist
		LD	A,H
		LD	(HL),D
		INC	HL
		LD	(HL),E
		LD	L,0		;Sektor att skriva
		LD	DE,(SEKTOR)	;Nästa sektor
		DEC	DE		;Skriv om sista sektorn
		LD	B,1		;1 sektor
		CP	H		;Skriva 1 sektor?
		JR	Z,SC5		;Ja
		INC	B		;CRC tar 1 sektor till
		DEC	H,DE
SC5:		LD	A,(OCDRV)
		LD	C,A		;Drive
		SCAL	ZDWR		;Skriv 1, 2 sektorer
		JP	ZAPER		;Ut via ZAPER


; Styrrutin för ett pass (1 eller 2)

PASS:		LD	(FPASS),A	;Bit 0 = pass
		XOR	A
		LD	(DDFLAG),A	;DDIR inaktiv
		LD	(LASTDDFLAG),A
		LD	(SPAGE),A	;Ingen offset för PAGE
		LD	HL,(OWNMAC)	;Start egna makron
		LD	(MACPTR),HL	;Nästa makro
		LD	(HL),A		;Inga namn
		SBC	HL,HL
		LD	(FELR),HL	;Inga fel
		LD	(LCCT),HL	;Org 0
		LD	(HILCCT),HL
		LD	(FORORG),HL	;Inget att addera LCCT
		LD	(HIFORORG),HL
		LD	HL,VILLK+2
		LD	(VILLK),HL
		LD	(HL),-1		;Alla villkor avslutade
		LD	(IX+$FASS),1	;Assemblerar 1a filen
		CALL	FCPASS		;Resten i map 0
		LD	HL,(VILLK)
		LD	DE,VILLK+2
		SBC	HL,DE		;Alla villkor avslutade?
		LD	A,17		;ENDIF/ENDC missing
		CALL	NZ,FEL		;Nej
		BIT	BMDEF,(IX+$MMAIN);Oavslutat makro?
		LD	A,28		;ENDM missing
		CALL	NZ,FEL		;Ja
		BIT	BOBJCT,(IX+$FOPT1);Objektkod?
		JR	Z,PS1		;Nej
		BIT	BIDNT,(IX+$FPASS);Finns IDNT?
		LD	A,24		;IDNT missing
		CALL	Z,FEL		;Nej
PS1:		CALL	SCREEN
		Print	'Errors = '
		LD	HL,(FELR)
		PUSH	HL
		CALL	HexDec		;Antal fel
		Print	', End = '
		LD	HL,(HILCCT)
		CALL	PBCD		;Slutadress hög
		LD	HL,(LCCT)
		CALL	PBCD		;Slutadress
		Text	'.'
		POP	HL
		OR	HL		;Några fel?
		RET


; @INPUT - ta in parametrarna på raden; INPTX hanterar
; källkodsfilerna. Om GO, OV eller SY är assignade,
; skrivs objektkoden/symbolfilen dit, för de har
; prioritet över MDRV. För GO, OV och SY används
; den först assignade driven, om det finns någon.
; *.MC hanteras likadant som *.SY.
; UT:	Skräp

INPUT:		LD	HL,0
		LD	(FILR),HL	;FILR & RASF = 0
		LD	HL,IFCB+1
IP1:		CALL	INPTX		;Källkodsfilerna
		LD	BC,21		;TXMAP inne
		ADD	HL,BC		;Peka på nästa FCB
		LD	DE,(ZCLINP)
		INC	(IX+$FILR)
		LD	A,(FILR)
		CP	NFCL		;Tagit NFCL filer?
		JR	Z,IP2		;Ja
		LD	A,(DE)
		CP	','		;Fler infiler?
		JR	NZ,IP2		;Nej
		INC	DE
		LD	(ZCLINP),DE
		JR	IP1
IP2:		XOR	A		;Inga optioner
		LD	(IX+$FOPT1),A
		LD	(IX+$FOPT2),A
		LD	A,(DE)
		OR	A		;Raden slut?
		RET	Z		;Ja
		CP	';'		;Optioner?
		JR	Z,IP5		;Ja
		LD	HL,'OG'		;GO default
		LD	(OCFCB+FEXT),HL
		LD	HL,OCFCB
		LD	B,6
		SCAL	ZCFS
		CALL	ZAPER
		LD	(ZCLINP),DE
		BIT	2,B		;Drive angiven?
		JR	Z,IP4		;Ja
		LD	(CGOTOF),A	;Tabelloffset för GO = 0
		LD	(COVTOF),A	;liksom offset för OV
		LD	HL,'OG'
		LD	DE,(OCFCB+FEXT)
		SBC	HL,DE		;Extension GO?
		LD	HL,NGODRV	;GO tabellen
		JR	Z,IP3		;Ja
		OR	A
		LD	HL,'VO'
		SBC	HL,DE		;Extension OV?
		JR	NZ,IP4		;Nej
		LD	HL,NOVDRV	;OV tabellen
IP3:		SCAL	ZSAT		;Search assign table
IP4:		LD	A,C
		LD	(OCDRV),A	;Drive för objektkod
		SET	BOBJCT,(IX+$FOPT1);Flagga objektkod
		LD	DE,(ZCLINP)
		LD	A,(DE)
		CP	';'		;Optioner?
		RET	NZ		;Nej
IP5:		INC	DE		;Förbi ;
		LD	A,(DE)
		CP	BLANK		;Fler optioner?
		JR	Z,IP7		;Nej
		OR	A		;Slut på raden?
		JR	Z,IP7		;Ja
		LD	BC,OPT$		;Antal i standard
		LD	HL,OPT
		CPDR			;Standard option?
		JR	NZ,IP6		;Nej, kolla extra
		LD	BC,OPT$+1
		ADD	HL,BC
		LD	A,(HL)
		OR	(IX+$FOPT1)
		LD	(IX+$FOPT1),A
		JR	IP5
IP6:		LD	BC,XTOPT$	;Antal i extra
		LD	HL,XTOPT
		CPDR			;Extra option?
		JR	NZ,IP5		;Nej
		LD	BC,XTOPT$+1
		ADD	HL,BC
		LD	A,(HL)
		OR	(IX+$FOPT2)
		LD	(IX+$FOPT2),A
		JR	IP5
IP7:		LD	(ZCLINP),DE
		BIT	BPRINT,(IX+$FOPT1);Överskrift?
		JR	Z,IP8		;Nej
		Text	'Heading? '
		SCAL	ZINLIN
		EX	DE,HL
		LD	DE,ÖSK
		LD	BC,ÖSIZE
		LDIR
IP8:		BIT	BSYSAV,(IX+$FOPT1);Symboltabell?
		JR	Z,IP10		;Nej
IPMS2:		Print	'Symbolfile name? '
IPMS2$:		EQU	$-IPMS2-2
		SCAL	ZINLIN
		LD	HL,IPMS2$
		ADD	HL,DE
		EX	DE,HL
		LD	HL,'YS'		;SY default
		LD	(SYFCB+FEXT),HL
		LD	HL,SYFCB
		LD	B,6
		SCAL	ZCFS
		CALL	ZAPER
		BIT	2,B		;Drive angiven?
		JR	Z,IP9		;Ja
		LD	(CSYTOF),A	;Tabelloffset för SY = 0
		LD	HL,NSYDRV	;SY tabellen
		SCAL	ZSAT
IP9:		LD	A,C
		LD	(SYDRV),A	;Drive för symbolfil
IP10:		BIT	BMCSAV,(IX+$FOPT2);Makron till disken?
		RET	Z		;Nej
IPMS3:		Print	'Macrofile name? '
IPMS3$:		EQU	$-IPMS3-2
		SCAL	ZINLIN
		LD	HL,IPMS3$
		ADD	HL,DE
		EX	DE,HL
		LD	HL,'CM'		;MC default
		LD	(MCFCB+FEXT),HL
		LD	HL,MCFCB
		LD	B,6
		SCAL	ZCFS
		CALL	ZAPER
		BIT	2,B		;Drive angiven?
		JR	Z,IP11		;Ja
		LD	(CSYTOF),A	;Tabelloffset för SY = 0
		LD	HL,NSYDRV	;SY tabellen
		SCAL	ZSAT
IP11:		LD	A,C
		LD	(MCDRV),A	;Drive för makrofil
		RET


; Optioner på kommandoraden
; Dessa bitar går in i FOPT1, bit 0 först

OPTS:		DB	'L'	;Lista
		DB	'P'	;Lista till printern
		DB	'C'	;Symboltabell till disken
		DB	'S'	;Stopp efter 15 rader
		DB	'G'	;Skriv alla byte
		DB	'D'	;Undertryck villkorsrader
		DB	'F'	;Tvinga pass 2
OPT$:		EQU	$-OPTS	;Antal
OPT:		EQU	$-1	;Söks baklänges
		DB	1,2,4,8,10H,20H,40H


; Optioner på kommandoraden
; Dessa bitar går in i FOPT2, bit 0 först

XTOPTS:		DB	'N'	;Undertryck abort go
		DB	'M'	;Makron till disken
		DB	'I'	;Ingen CRC på objektkod
		DB	'T'	;Ingen trunkering av långa rader
XTOPT$:		EQU	$-XTOPTS
XTOPT:		EQU	$-1
		DB	1,2,4,8


; Ta ett filnamn för källkod
; Assignade drivar söks alltid först för TX om
; inte drive anges. Om TX inte är assignat,
; söks filnamnet på MDRV och läses därifrån, om
; den finns, annars fel och abort.
; Drivarna söks i den ordning de har assignats.
; Anges drive används inte assigntabellen.
; IN:	HL	pekar på FCB
; UT:	HL	oförändrat
;	ZCLINP uppdaterad

INPTX:		PUSH	HL		;FCB-adress
		LD	DE,FEXT		;TX default
		ADD	HL,DE
		LD	(HL),'T'
		INC	HL
		LD	(HL),'X'
		POP	HL
		LD	DE,(ZCLINP)
		LD	BC,6*256+3FH	;Drive & ext frivilligt
		SCAL	ZLFN
		CALL	ZAPER
		LD	(ZCLINP),DE
		DEC	HL
		LD	(HL),C		;Drive till FCB
		INC	HL
		RET


; @LIST - lista en rad
; IN:	Raden kopierad till LINBUF

LIST:		LD	HL,LINBUF	;Init LBPTR
		LD	(LBPTR),HL
		LD	HL,(ADRESS)
		LD	HL',(HIADRESS)
		LD	C,(IX+$OFOBJ)
		LD	DE,OBJ
LT1:		LD	B,9
		BIT	BPADDR,(IX+$LFLG1);Skriva ut adressen?
		JR	Z,LT2		;Nej
		EXX
		CALL	PBCD		;HIADRESS
		EXX
		CALL	PBCD		;ADRESS
		LD	B,1
LT2:		SCAL	ZSPACE
		DJNZ	LT2
		LD	A,(SEP)
		OR	A		;Ytterligare tecken?
		JR	Z,LT3		;Nej
		RST	ROUT
		SCAL	ZSPACE
		PUSH	HL
		LD	HL,(OBJ)
		CALL	PBCD
		LD	HL,(OBJ+2)
		CALL	PBCD
		POP	HL
		LD	B,3		;Kvar till labelfältet
		LD	C,0
		JR	LT6
LT3:		LD	B,6		;Antal byte i objektkod
LT4:		INC	C
		DEC	C		;Tomt i OBJ?
		JR	Z,LT5		;Ja
		LD	A,(DE)
		SCAL	ZB2HEX
		INC	HL,DE		;HL ADRESS
		OR	HL
		JR	NZ,LT41
		INC	HL'		;HIADRESS
LT41:		DEC	C
		DJNZ	LT4
LT5:		SLA	B
		INC	B
LT6:		SCAL	ZSPACE		;Fyll ut till labelfält
		DJNZ	LT6
		PUSH	HL
		LD	HL,(LBPTR)
LT7:		LD	A,(HL)		;Skicka ut källkoden
		INC	HL
		CP	FF		;Formfeed?
		JR	Z,LT7		;Ja, förbi
		RST	ROUT
		CP	CR
		JR	NZ,LT7
		DEC	HL
		LD	(LBPTR),HL
		POP	HL
		BIT	BGENE,(IX+$FOPT1);Skriva alla byte?
		RET	Z		;Nej
		INC	C
		DEC	C		;Något kvar i OBJ?
		JR	NZ,LT1		;Ja
		RET


; @TXOUT - utmatningsrutin

TXOUT:		BIT	BUPR,(IX+$FOUT)	;Mot printern?
		JR	Z,TXT1		;Nej
		BIT	BPRINT,(IX+$FOPT1);Printerutskrift?
		JR	NZ,TXT8		;Ja
TXT1:		PUSH	AF
		LD	B,A
		SCAL	ZIN		;Känn av tangentbordet
		LD	A,B
		BIT	BSNCR,(IX+$FOUT);Stanna vid CR?
		JR	NZ,TXT2		;Ja
		JR	NC,TXT3		;Nej
		SET	BSNCR,(IX+$FOUT);Bryt vid nästa CR
TXT2:		CP	CR		;Är det CR?
		JR	NZ,TXT4		;Nej
		CALL	WAIT
		CP	BLANK		;Space?
		JR	Z,TXT3		;Ja
		CP	CR		;CR?
		JR	NZ,TXT3		;Nej
		RES	BSNCR,(IX+$FOUT);Bryt inte mer
TXT3:		LD	A,B
		CP	CR
		JR	NZ,TXT4
		DEC	(IX+$LINES)
		JR	NZ,TXT6
		LD	A,(IX+$RADR)
		LD	(IX+$LINES),A	;Ny skärmsida
		BIT	BSTOP,(IX+$FOPT1);Stopp i ZBLINK?
		JR	Z,TXT6		;Nej
		CALL	WAIT		;Vänta
		JR	TXT6
TXT4:		LD	C,39H
		CP	TAB
		JR	NZ,TXT5
		LD	C,32H
TXT5:		LD	A,(CURSOR)
		AND	3FH
		CP	C
		JR	NC,TXT7
TXT6:		LD	A,B
		SCAL	ZCRT
TXT7:		POP	AF
		RET
TXT8:		PUSH	AF		;A har tecknet
		BIT	BHEAD,(IX+$FOUT);Skriver jag överskrift?
		JP	NZ,TXT17	;Ja
		LD	HL,PLCT		;Printer line counter
		LD	A,(PPOS)	;Print head position
		OR	(HL)		;Ny sida?
		JP	NZ,TXT17	;Nej
		SET	BHEAD,(IX+$FOUT);Skriver överskrift
		Print	'Zap V1.0 ',TAB,TAB,0
TXT9:		LD	A,(PCPL)	;Characters per line
		SUB	24+6+ÖSIZE	;3 TAB + PAGE 1 + ÖSK
		SUB	(IX+$SPAGE)	;Utrymme för sidnumret
		LD	B,A		;Antal blanka till PAGE
		LD	A,ÖSIZE		;Antal i ÖSK
TXT10:		PUSH	BC
		LD	B,A
		PUSH	BC
		LD	BC,ÖSIZE
		LD	DE,XTLWRK	;ÖSK till wrk
		LD	HL,TTLÖSK
		BIT	BOTTL,(IX+$FOUT);TTL?
		JR	NZ,TXT11	;Ja
		LD	HL,STLÖSK
		BIT	BOSTL,(IX+$FOUT);STL?
		JR	NZ,TXT11	;Ja
		LD	HL,ÖSK		;Det är heading
TXT11:		PUSH	DE
		LDIR
		POP	HL
		PUSH	HL
		LD	A,';'
		LD	C,ÖSIZE
		CPIR			;Datum & tid i XTLWRK?
		INC	BC
		LD	DE,HL
		DEC	HL
		CALL	Z,TIME		;Ja
		POP	HL,BC
		INC	B
TXT12:		DEC	B
		JR	Z,TXT13
		LD	A,(HL)		;Mata ut överskriften
		INC	HL
		RST	ROUT
		JR	TXT12
TXT13:		POP	BC
		LD	HL,KORD+$FOUT
		BIT	5,(HL)		;TTL?
		JR	NZ,TXT15	;Ja
		BIT	3,(HL)		;STL?
		JR	NZ,TXT16	;Ja
		PUSH	HL
TXT14:		SCAL	ZSPACE		;Space fram till PAGE
		DJNZ	TXT14
		Print	'PAGE '
		LD	HL,(SIDR)	;Öka sidan
		CALL	ABCD
		LD	(SIDR),HL
		CALL	SIDNUM		;Skriv sidnumret
		POP	HL
		BIT	BTTL,(IX+$FPASS);TTL aktiv?
		JR	Z,TXT16		;Nej
		Print	CR,TAB,TAB,TAB,0
		SET	5,(HL)		;Skriver TTL
		JP	TXT9
TXT15:		BIT	BSTL,(IX+$FPASS);STL aktiv?
		JR	Z,TXT16		;Nej
		Print	CR,TAB,TAB,TAB,0
		RES	5,(HL)		;Bort TTL
		SET	3,(HL)		;Skriver STL
		JP	TXT9
TXT16:		SCAL	ZCRLF		;CR efter sista raden
		SCAL	ZCRLF		;En tom rad
		LD	A,(HL)		;KORD8 bit 0, 3 & 5 = 0
		AND	NOT(29H)
		LD	(HL),A
TXT17:		LD	A,(PPOS)
		OR	A		;Ny rad?
		JR	NZ,TXT19	;Nej
		LD	HL,PLMG
		LD	A,(HL)
		SUB	6		;Går det att justera?
		JR	C,TXT20		;Nej
		LD	(HL),A		;Ny vänstermarginal
		POP	AF		;Tecken att skriva
		PUSH	HL
		SCAL	ZPOUT
		POP	HL
		PUSH	AF
		LD	A,6		;Återställ marginalen
		ADD	A,(HL)
		LD	(HL),A
TXT18:		POP	AF
		RET
TXT19:		LD	HL,PCPL
		CP	(HL)		;Får tecknet plats på raden?
		JR	C,TXT20		;Ja
		POP	AF
		PUSH	AF
		CP	CR		;Är det CR?
		JR	Z,TXT20		;Ja
		BIT	BENTLIN,(IX+$FOPT2);Ska allt skrivas ändå?
		JR	Z,TXT18		;Nej
TXT20:		POP	AF
		SCAL	ZPOUT
		RET


; Datum och tid har begärts
; Ta tiden och sätt in den i (HL)
; IN:	BC	antal byte i buffer
;	DE	pekare till skiljetecken
;	HL	adress i buffer
; UT:	BC	byte kvar i buffer
;	DE	utpekade skiljetecken
;	HL	BC byte från slutet

TIME:		PUSH	HL,BC		;Här ska datum & tid in
		LD	A,3		;Tfun DTASC
		BIT	BASC,(IX+$FOUT)	;Extern användare?
		JR	NZ,TE1		;Ja
		SCAL	ZCOV		;ZCOV går fortare
		DB	'Tfun'
		JR	TE2
TE1:		SCAL	ZCOVR
		DB	'Tfun'
TE2:		POP	BC,DE
		PUSH	HL		;Spara SIGN
		LD	A,-1
		LD	HL,S2FCB
TE3:		CP	(HL)		;Sätt in datum
		LDI
		JP	PO,TE6
		JR	NZ,TE3
		EX	DE,HL
		DEC	HL
		LD	(HL),BLANK	;Blanka ut -1
		INC	HL
		EX	DE,HL
		LD	HL,S1FCB
TE4:		CP	(HL)		;Sätt in tiden
		LDI
		JP	PO,TE6
		JR	NZ,TE4
		POP	HL
		EX	DE,HL
		DEC	HL
		INC	BC
TE5:		LD	(HL),BLANK	;Blanka ut -1
		RET
TE6:		EX	DE,HL		;Kanske slutar med -1,
		DEC	HL		;eller 5X eller X, så ta
		INC	BC		;bort det då.
		POP	DE
		CALL	TE8		;Skiljetecken eller -1?
		JR	Z,TE5		;Ja
		DEC	HL
		INC	BC
		CALL	TE8		;Skiljetecken eller -1?
		JR	Z,TE7		;Ja
		INC	HL,2
		DEC	BC,2
		RET
TE7:		LD	(HL),BLANK
		INC	HL
		DEC	BC
		JR	TE5
TE8:		LD	A,(HL)
		CP	D
		RET	Z
		CP	E
		RET	Z
		INC	A
		RET


; Skriv sidnumret med nollundertryckning och
; justera SPAGE om nästa sidnummer kräver mer plats
; IN:	HL	sidnummer i BCD
; UT:	BC	skräp
;	HL	orört

SIDNUM:		LD	A,(SPAGE)	;# siffror utöver 1 i
		PUSH	AF,HL		;i denna sidas sidnummer
		CALL	ABCD		;Nästa sidnummer
		LD	A,3		;3 nibbles att testa
SM1:		LD	B,4		;4 bitar i en nibble
SM2:		ADD	HL,HL		;Används denna nibble?
		JR	C,SM3		;Ja
		DJNZ	SM2
		DEC	A
		JR	NZ,SM1
SM3:		LD	(SPAGE),A	;# siffror-1 nästa sidnr
		POP	HL,AF		;Skriv denna sidas sidnr
		SCAL	ZJUMP
		DW	SM4		;0, 1 siffra
		DW	PRINTL		;1, 2 siffror
		DW	SM5		;2, 3 siffror
		DW	PBCD		;3, 4 siffror
SM4:		LD	A,L
		SCAL	ZB1HEX
		RET
SM5:		LD	A,H
		SCAL	ZB1HEX
		JR	PRINTL		;L med B2HEX


; Skriv ut HL

PBCD:		LD	A,H
		SCAL	ZB2HEX
PRINTL:		LD	A,L
		SCAL	ZB2HEX
		RET


; Addera 1 till HL i BCD

ABCD:		LD	A,L
		ADD	A,1
		DAA
		LD	L,A
		RET	NC
		LD	A,H
		ADD	A,1
		DAA
		LD	H,A
		RET


; Vänta på användaren med blinkande kursor
; UT:	 A	rörd tangent

WAIT:		PUSH	BC
		LD	A,(CFFLG)	;Kan vara jobbström
		PUSH	AF
		XOR	A
		LD	(CFFLG),A
		SCAL	ZBLINK		;Bara vänta
		LD	C,A
		POP	AF
		LD	(CFFLG),A
		LD	A,C
		POP	BC
		RET


; Omvandla hex till decimal och skriv
; ut resultatet med nollundertryckning

HexDec:		LD	BC,500H
		LD	DE,dectab
		PUSH	DE
hexdec1:	EX	(SP),HL
		LD	E,(HL)
		INC	HL
		LD	D,(HL)
		INC	HL
		EX	(SP),HL
		XOR	A
hexdec2:	INC	A
		SBC	HL,DE
		JR	NC,hexdec2
		ADD	HL,DE
		DEC	A
		JR	NZ,hexdec3
		INC	C
		DEC	C
		JR	NZ,hexdec3
		LD	A,B
		DEC	A
		JR	NZ,hexdec4
hexdec3:	DEC	C
		ADD	A,30H
		RST	ROUT
hexdec4:	DJNZ	hexdec1
		POP	DE
		RET


; Tabell för omvanling hex till decimal

dectab:		DW	10000
		DW	1000
		DW	100
		DW	10
		DW	1


; @DMSG - skriv att den gamla filen tas bort
; IN:	HL	pekar på FCB

DMSG:		Print	'(Old '
		LD	A,(DDRV)
		LD	C,A
		SCAL	ZFCB
		Text	' deleted)'
		RET


; @MEMOV - minnet räcker inte till

MEMOV:		CALL	SCREEN
		Text	'Memory overflow.'
		JP	ZAPEXI


; Fel inom FC med osäker IY

FCER5:		LD	A,5	;Syntax error
		JR	FCERR
FCER8:		LD	A,8	;Invalid operand
		JR	FCERR
FCER29:		LD	A,29	;Too many operands
		JR	FCERR
FCER31:		LD	A,31	;Operand missing
		JR	FCERR
FCER33:		LD	A,33	;Too many parameters
		JR	FCERR
FCER35:		LD	A,35	;Too many default codes
		JR	FCERR
FCER36:		LD	A,36	;Parameter descriptor missing


; Fel inom FC med osäker IY
; Återställ IY till sin position i TX före retur
; IN:	 A	felkod

FCERR:		CALL	TXPOS?		;IY i TX
		JP	ERROR


; @MSAGE - skriv ett meddelande
; IN:	 A	kod
;	BC,DE,HL reserverade
; MSVAL tal att skriva om BMSVAL = 1

MSAGE:		PUSH	HL,BC
		LD	B,A
		LD	HL,MSGTAB
		RES	BUPR,(IX+$FOUT)	;Skriv mot CRT
		CALL	PRINT
		BIT	BMSVAL,(IX+$MISC1);Skriva MSVAL?
		JR	Z,MSAGE1	;Nej
		RES	BMSVAL,(IX+$MISC1)
		LD	HL,(MSVAL)
		SCAL	ZTBCD3
MSAGE1:		Print	CUL,'.',CR,0
		SET	BUPR,(IX+$FOUT)	;Till printern igen
		POP	BC,HL
		XOR	A
		RET


; @FEL - rapportera ett fel
; IN:	 A	felkod
;	BC,DE,HL reserverade

FEL:		SET	BERRM,(IX+$LFLG1);Skriver felmeddelande
		PUSH	HL,BC
		LD	B,A
		Print	'>>>> ERROR',TAB,0
		LD	HL,FELTAB
		CALL	PRINT
		SCAL	ZCRLF
		LD	HL,(FELR)	;Räkna felen
		INC	HL
		LD	(FELR),HL
		POP	BC,HL
		XOR	A
		RET


; Skriv ett meddelande
; IN:	 B	felkod
;	HL	pekar på första texten

PRINT:		DEC	B		;Denna text?
		JR	Z,PT2		;Ja
PT1:		BIT	7,(HL)
		INC	HL
		JR	Z,PT1
		JR	PRINT
PT2:		LD	A,(HL)
		AND	7FH
		RST	ROUT
		BIT	7,(HL)
		INC	HL
		JR	Z,PT2
		RET


; Meddelanden

MSGTAB:		DC	'Auto X/SX detection terminated. $ = '


; Felmeddelanden

FELTAB:		DC	'Parantheses error'
[ 2]		DC	'Error in string'
[ 3]		DC	'Error in constant'
[ 4]		DC	'Undefined symbol'
[ 5]		DC	'Syntax error'
[ 6]		DC	'Truncation error'
[ 7]		DC	'Offset error'
[ 8]		DC	'Invalid operand'
[ 9]		DC	'Unknown instruction'
[10]		DC	'Invalid label'
[11]		DC	'Label missing'
[12]		DC	'Reserved word'
[13]		DC	'Doubly defined label'
[14]		DC	'Illegal backwards ORG'
[15]		DC	'Too many IF/COND''s'
[16]		DC	'No prior IF/COND'
[17]		DC	'ENDIF/ENDC missing'
[18]		DC	'IDNT can only be used once'
[19]		DC	'Bad symbolfile name'
[20]		DC	'No such symbolfile'
[21]		DC	'Symbolfile unreadable'
[22]		DC	'Symbolfile too big'
[23]		DC	'Symbol not in symbolfile'
[24]		DC	'IDNT missing'
[25]		DC	'Too many REM files'
[26]		DC	'Too many MACROs'
[27]		DC	'No prior MACRO'
[28]		DC	'ENDM missing'
[29]		DC	'Too many operands'
[30]		DC	'Doubly defined macro'
[31]		DC	'Operand missing'
[32]		DC	'CRC error'
[33]		DC	'Too many parameters'
[34]		DC	'Macro area overflow'
[35]		DC	'Too many default codes'
[36]		DC	'Parameter descriptor missing'
[37]		DC	'Can''t do both BYTES and WORDS'
[38]		DC	'Macrofile unreadable'
[39]		DC	'Register operand expected'
[40]		DC	'Template missing'
[41]		DC	'Comment terminator missing'
[42]		DC	'Bad macrofile name'
[43]		DC	'No such macrofile'
[44]		DC	'Unknown decoder directive'
[45]		DC	'Range specifier missing'
[46]		DC	'Unknown control bit'
[47]		DC	'Decoder directive misses target instruction'


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Diverse instruktioner		      ¦
¦					      ¦
¦	Entry: ........... ZAPFCMIS.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 12 14	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Instruktion ADC
; Dummyn fångar upp t ex A,BC, som inte finns, och därför hamnar i ALP
; i ZAPARI och där genererar oönskad och felaktig kod.

IADC:		DB	IADCT$	;Antal
IADCT:		DB	0	;A,You_Name_It
		DB	22H	;HL,RR
		DB	12H	;R,RR
		DB	13H	;R,XY
IADCT$:		EQU	$-IADCT
		ICTRL	08EH,FCACBIF-$,XMODE
		ICTRL	04AH,ACHL_RR-$
		ICTRL	,,ERR8-$	;Dummy
		ICTRL	,,ERR8-$	;Dummy


; Instruktion SBC

ISBC:		DB	ISBCT$	;Antal
ISBCT:		DB	0	;A,s
		DB	22H	;HL,RR
		DB	12H	;R,RR
		DB	13H	;R,XY
ISBCT$:		EQU	$-ISBCT
		ICTRL	09EH,FCACBIF-$,XMODE
		ICTRL	042H,ACHL_RR-$
		ICTRL	,,ERR8-$	;Dummy
		ICTRL	,,ERR8-$	;Dummy


; Instruktion ADD

IADD:		DB	IADDT$	;Antal
IADDT:		DB	0	;A,s
		DB	33H	;XY,XY
		DB	32H	;XY,RR
		DB	24H	;SP,nn
		DB	2CH	;HL,(DA)
		DB	22H	;HL,RR
		DB	12H	;R,RR
		DB	13H	;R,XY
IADDT$:		EQU	$-IADDT
		ICTRL	086H,FCACBIF-$,XMODE
		ICTRL	029H,ADXY_XY-$
		ICTRL	009H,ADXY_RR-$
		ICTRL	082H,ADSP_NN-$,IMDATA
		ICTRL	0C6H,ADHL.DA-$,IMDATA
		ICTRL	009H,ADHL_RR-$
		ICTRL	,,ERR8-$	;Dummy
		ICTRL	,,ERR8-$	;Dummy


; Instruktion SUB

ISUB:		DB	ISUBT$	;Antal
ISUBT:		DB	0	;A,s
		DB	24H	;SP,nn
		DB	2CH	;HL,(DA)
		DB	12H	;R,RR
		DB	13H	;R,XY
ISUBT$:		EQU	$-ISUBT
		ICTRL	096H,FCACBIF-$,XMODE
		ICTRL	092H,ADSP_NN-$,IMDATA
		ICTRL	0D6H,ADHL.DA-$,IMDATA
		ICTRL	,,ERR8-$	;Dummy
		ICTRL	,,ERR8-$	;Dummy


; Typ 22, ADC/SBC HL,RR
; IN:	 A	=H
;	BC	B 22, C 4A
;	DE	D 20 för HL
;	HL	H RR, L 2

ACHL_RR:	LD	A,D
		CP	20H		;HL dest?
		RET	NZ		;Nej
ACHLRRX:	CALL	FIXED		;ED först
		JP	BILDA2


; Typ 22, ADD HL,RR[,X]
; IN:	 A	=H
;	BC	B 22, C 9
;	DE	dst; D RR, E 2
;	HL	src; H RR, L 2
; X ADD HL,RR kan skrivas ADD HL,RR,X

ADHL_RR:	LD	A,D
		CP	20H		;HL dest?
		RET	NZ		;Nej
		JP	BILDA2


; Typ 2C, ADD/SUB HL,(DA)[,X]
; IN:	 A	=H
;	BC	B 2C, C C6
;	HL	dst; H RR, L 2
;	DE	src; nn
; X ADD HL,(DA) kan skrivas ADD HL,(DA),X

ADHL.DA:	CP	20H		;HL dest?
		RET	NZ		;Nej
		CALL	FIXEDC		;ED + C6
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 24, ADD/SUB SP,nn[,X]
; IN:	 A	=H
;	BC	B 24, C 82
;	HL	dst; H RR, L 2
;	DE	src; nn
; X ADD SP,nn kan skrivas ADD SP,nn,X

ADSP_NN:	CP	30H		;SP dest?
		RET	NZ		;Nej
		CALL	FIXEDC		;ED + 82
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 32, ADD XY,RR[,X]
; IN:	 A	=H
;	BC	B 32, C 9
;	DE	dst; D DD för IX, FD för IY, E 3
;	HL	src; H RR, L 2
; X ADD XY,RR kan skrivas ADD XY,RR,X

ADXY_RR:	CP	20H		;HL som src?
		JP	Z,ERR8		;Ja, går inte
ADXYRRX:	CALL	OPKODD		;DD/FD i D
		JP	BILDA2


; Typ 33, ADD IX,IX[,X] och IY,IY[,X]
; IN:	 A	=H
;	BC	B 33, C 29
;	DE	dst; D DD för IX, FD för IY, E 3
;	HL	dst; H DD för IX, FD för IY, L 3
; X ADD XY,XY kan skrivas ADD XY,XY,X

ADXY_XY:	SUB	D		;IX,IX eller IY,IY?
		RET	NZ		;Nej
		LD	H,A
		JR	ADXYRRX


; Interface till aritmetiska byteinstruktioner
; IN:	 A	=H
;	BC	B typ, C opkod
;	DE	D dst, E typ
;	HL	se IARITB

FCACBIF:	LD	A,B
		AND	0F0H
		CP	10H		;Typ R,nåt?
		RET	NZ		;Nej
		LD	A,D
		CP	7		;R = Ackumulatorn?
		RET	NZ		;Nej
		LD	A,B
		AND	0FH
		JP	IARITB


; Instruktion EX

IEX:		DB	IEXT$	;Antal
IEXT:		DB	0
		DB	0A3H	;(SP),XY
		DB	0A2H	;(SP),HL
		DB	33H	;XY,XY
		DB	23H	;RR,XY
		DB	22H	;RR,RR
		DB	1AH	;A,(HL)
		DB	11H	;A,R
IEXT$:		EQU	$-IEXT
		ICTRL	,,IERR8-$
		ICTRL	0E3H,XSP_XY-$
		ICTRL	0E3H,XSP_HL-$
		ICTRL	02BH,XXY_XY-$,IGNEX
		ICTRL	003H,XRR_XY-$,IMDATA
		ICTRL	0EBH,XRR_RR-$,IGNEX
		ICTRL	037H,XA.HL-$
		ICTRL	007H,XR_R-$,IMDATA OR IGNEX


; Typ 1A, EX A,(HL)
; IN:	 A	=H
;	BC	B 1A, C 37
;	DE	D dst R, E typ
;	HL	H src RR, L d

XA.HL:		CP	20H		;(HL)?
		RET	NZ		;Nej
		LD	A,D
		CP	7		;Med A?
		RET	NZ		;Nej
		JP	FIXEDC


; Typ 11, EX A,R och EX A,R' + pseudo
; IN:	 A	=H
;	BC	B 11, C 7
;	DE	D src R, E typ
;	HL	H dst R, L typ
; EX B,C ger: LD A,B + LD B,C + LD C,A

XR_R:		CP	D		;Andra reg samma?
		JR	NZ,XA_R		;Nej
		LD	A,30H		;Det är någon av:
		OR	D		;EX A,A'
		LD	H,A		;EX B,B' etc
		LD	L,0CBH
		JP	OPKODHL
XA_R:		CP	7		;EX A,?
		JR	NZ,XR_RP	;Nej, pseudo
		CALL	FIXED
		JP	BILDA
XR_RP:		LD	A,40H OR 7 SHL 3;LD A,
		OR	H
		CALL	OPKODA		;LD A,R (dst)
		EX	DE,HL
		LD	C,40H		;LD
		LD	A,H
		CALL	R_R		;LD R,R
		LD	C,47H		;LD R,A
		EX	DE,HL
		JP	BILDA


; Typ 22, EX RR,RR och EX RR,RR'
; IN:	 A	=H
;	BC	B 22, C EB
;	DE	D dst RR, E typ
;	HL	H src RR, L typ

XRR_RR:		CP	D		;Andra registret samma?
		JR	NZ,XRRHL	;Nej
		LD	C,8
		CP	70H		;AF?
		JP	Z,OPKODC	;Ja, EX AF,AF'
		CALL	RRCodeA
		RET	NZ		;Ej BC, DE eller HL
		CALL	FIXED
		LD	A,30H		;Det är någon av:
		OR	L		;EX BC,BC'
		LD	H,A		;EX DE,DE'
		LD	L,0CBH		;EX HL,HL'
		JP	OPKODHL
XRRHL:		CP	20H		;Är src reg HL?
		JR	NZ,XRRDE	;Nej
		LD	A,D
		CP	10H		;Register DE?
		JP	Z,OPKODC	;Ja, EX DE,HL
		OR	A		;Reg BC?
		RET	NZ		;Nej
		LD	C,0DH		;EX BC,HL
		JP	FIXEDC
XRRDE:		CP	10H		;Är src reg DE?
		RET	NZ		;Nej
		LD	A,D
		OR	A		;Är dst reg BC?
		RET	NZ		;Nej
		LD	C,5		;EX BC,DE
		JP	FIXEDC


; Typ 23, EX RR,XY
; IN:	 A	=H
;	BC	B 32, C 03
;	DE	D src RR, E typ
;	HL	H dst RR, L typ

XRR_XY:		CALL	RRCodeA
		RET	NZ
		BIT	5,D		;IX?
		JR	Z,xrr_xy1	;Ja
		SET	3,C
xrr_xy1:	LD	A,(rrCodeA)
		OR	C
		LD	C,A
		JP	FIXEDC


; Typ 33, EX IX,IY och EX XY,XY'
; IN:	 A	=H
;	BC	B 33, C 2B
;	DE	D dst RR, E typ
;	HL	H src RR, L typ

XXY_XY:		CP	D		;Andra reg samma?
		JR	NZ,XIX_IY	;Nej
		CALL	FIXED
		LD	HL,34CBH
		BIT	5,D		;IX,IX?
		JP	Z,OPKODHL	;Ja
		INC	H		;Det är IY,IY
		JP	OPKODHL
XIX_IY:		BIT	5,D		;IY som dst?
		RET	NZ		;Ja
		JP	FIXEDC


; Typ A2, EX (SP),HL

XSP_HL:		JP	IsSP_HL


; Typ A3, EX (SP),XY

XSP_XY:		JP	IsSP_XY


; Instruktion IN

IIN:		DB	IINT$	;Antal
IINT:		DB	0
		DB	19H	;R,(C)
		DB	1CH	;A,(n)
IINT$:		EQU	$-IINT
		ICTRL	,,IERR8-$
		ICTRL	040H,R.C-$
		ICTRL	0DBH,A.N-$


; Instruktion OUT

IOUT:		DB	IOUT$	;Antal
IOUTT:		DB	0
		DB	94H	;(C),n
		DB	91H	;(C),R
		DB	0C1H	;(n),A
IOUT$:		EQU	$-IOUTT
		ICTRL	,,IERR8-$
		ICTRL	071H,.C_N-$
		ICTRL	041H,R.C-$,IMDATA
		ICTRL	0D3H,A.N-$,IMDATA


; Typ 1C, IN A,(n)
;     C1, OUT (n),A

A.N:		LD	A,D
		SUB	7		;7 - 7 = 0
		RET	NZ		;Nej
		LD	D,A
		JP	R_N


; Typ 19, IN R,(C)
;     91, OUT (C),R

R.C:		CP	1		;Register C?
		RET	NZ		;Nej
		CALL	FIXED		;Alla (C) har prefix ED
		JP	BILDA


; Typ C4, OUT (C),n

.C_N:		LD	A,D
		CP	1		;Register C?
		RET	NZ		;Nej
		CALL	FIXEDC		;Alla (C) har prefix ED
		JP	TRPUT


; Instruktion INW

IINW:		DB	IINWT$	;Antal
IINWT:		DB	0
		DB	29H	;RR,(C)
IINWT$:		EQU	$-IINWT
		ICTRL	,,IERR8-$
		ICTRL	040H,RR.C-$


; Instruktion OUTW

IOUTW:		DB	IOUTWT$	;Antal
IOUTWT:		DB	0
		DB	94H	;(C),nn
		DB	92H	;(C),RR
IOUTWT$:	EQU	$-IOUTWT
		ICTRL	,,IERR8-$
		ICTRL	079H,.C_NN-$
		ICTRL	041H,RR.C-$,IMDATA


; Typ 29, IN RR,(C)
; IN:	 A	=H
;	BC	B 29, C 40
;	DE	D dst RR, E typ
;	HL	H src R, L typ

RR.C:		CP	1		;Register C?
		RET	NZ		;Nej
		CALL	RRCodeB
		RET	NZ
		CALL	FIXDD		;DD
		LD	A,L
		JP	BILDA1


; Typ C4, OUTW (C),nn

.C_NN:		LD	A,D
		CP	1		;Register C?
		RET	NZ		;Nej
		CALL	FIXFDC
		LD	(IX+$LASTDDFLAG),0
		JP	PutAddress	;+ nn 16 bitar


; Instruktion IN0

IIN0:		DB	IIN0T$	;Antal
IIN0T:		DB	0
		DB	0C0H	;IN0 (n) motsvarar TSTI
		DB	1CH	;IN0 R,(n)
IIN0T$:		EQU	$-IIN0T
		ICTRL	,,IERR8-$
		ICTRL	030H,IN0R.N-$,IMDATA
		ICTRL	000H,IN0R.N-$


; Instruktion OUT0

IOUT0:		DB	IOUT0T$	;Antal
IOUT0T:		DB	0
		DB	0C1H	;OUT0 (n),R
IOUT0T$:	EQU	$-IOUT0T
		ICTRL	,,IERR8-$
		ICTRL	001H,IN0R.N-$,IMDATA


; Typ 1C, IN0 R,(n)
;     C0, IN0 (n)
;     C1, OUT0 (n),R
; IN:	 A	=H
;	BC	B 1C,C0,C1, C 0,30,1
;	DE	D dst R, E typ
;	HL	n

IN0R.N:		CALL	FIXED
		CALL	BILDA
		JP	TRPUT


; Instruktion INA

IINA:		DB	IINAT$	;Antal
IINAT:		DB	0
		DB	1CH	;INA A,(nn)
IINAT$:		EQU	$-IINAT
		ICTRL	,,IERR8-$
		ICTRL	0EDH,INAR.NN-$


; Instruktion INAW

IINAW:		DB	IINAWT$	;Antal
IINAWT:		DB	0
		DB	2CH	;INAW HL,(nn)
IINAWT$:	EQU	$-IINAWT
		ICTRL	,,IERR8-$
		ICTRL	0FDH,INAWHL.NN-$


; Typ 1C, INA A,(nn)
; IN:	 A	=H
;	BC	B 1C, C ED
;	DE	D dst R, E typ
;	HL	nn

INAR.NN:	LD	A,D
		CP	7		;Med A?
INAX:		RET	NZ		;Nej
		EX	DE,HL
		LD	L,C
		LD	H,0DBH
		CALL	OPKODHL		;ED DB
		JP	PutAddress	;+ 16/24/32 bitar


; Typ 2C, INAW HL,(nn)
; IN:	 A	=H
;	BC	B 2C, C FD
;	DE	D dst R, E typ
;	HL	nn

INAWHL.NN:	LD	A,D
		CP	20H		;Med HL?
		JR	INAX


; Instruktion OUTA

IOUTA:		DB	IOUTAT$	;Antal
IOUTAT:		DB	0
		DB	0C1H	;OUTA (nn),A
IOUTAT$:	EQU	$-IOUTAT
		ICTRL	,,IERR8-$
		ICTRL	0EDH,OUTA.NN_A-$,IMDATA


; Instruktion OUTAW

IOUTAW:		DB	IOUTAWT$	;Antal
IOUTAWT:	DB	0
		DB	0C2H	;OUTAW (nn),HL
IOUTAWT$:	EQU	$-IOUTAWT
		ICTRL	,,IERR8-$
		ICTRL	0FDH,OUTAW.NN_HL-$,IMDATA


; Typ C1, OUTA (nn),A
; IN:	 A	=H
;	BC	B C1, C ED
;	DE	D src R, E typ
;	HL	nn

OUTA.NN_A:	LD	A,D
		CP	7		;Med A?
OUTAX:		RET	NZ		;Nej
		EX	DE,HL
		LD	L,C
		LD	H,0D3H
		CALL	OPKODHL		;ED D3
		JP	PutAddress	;+ 16/24/32 bitar


; Typ C2, OUTAW (nn),HL
; IN:	 A	=H
;	BC	B C2, C FD
;	DE	D src R, E typ
;	HL	nn

OUTAW.NN_HL:	LD	A,D
		CP	20H		;Med HL?
		JR	OUTAX


; Ogiltig operand för någon instruktion

IERR8:		JP	ERR8


; @IARITB
; Rutinerna som följer hanterar 8 bitars aritmetiska
; och logiska instruktioner. De är: AND, OR, XOR, CP,
; SUB och SBC. Här hanteras dessutom ADD och ADC.
; INC och DEC hanteras separat.
; IN:	 A	=D
;	BC	B skräp, C A6,B6,AE,BE,96 & 9E resp.
;	DE	D typ, E LFLG2 (ej för ADC, ADD)
;	HL	om registeroperation: H R/RR, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 04, ADC etc n

IARITB:		EQU	$		;Hit från FCACBIF i ZAPFCMIS
		CP	4		;Immediate n?
		JR	NZ,ACB.XY	;Nej
		SET	6,C
		CALL	TRUNKA
		LD	H,L
		LD	L,C
		JP	OPKODHL


; Typ 0B, ADC etc (XY+d/dd/ddd)

ACB.XY:		CP	0BH		;(XY)?
		JR	NZ,ACB_R	;Nej
		CALL	OPKODH		;DD/FD först
		CALL	OPKODC		;+ 8E
		JP	PutIndex


; Typ 01, ADC etc R

ACB_R:		CP	1		;R?
		JR	NZ,ACB.HL	;Nej
ACBRX:		LD	A,C
		AND	0F8H
		OR	H
		JP	OPKODA


; Typ 0A, ADC etc (HL)

ACB.HL:		CP	0AH		;(HL)?
		JR	NZ,ACB_RX	;Nej
		LD	A,H
		CP	20H		;Är det HL?
		RET	NZ		;Nej
		BIT	BINDEX,(IX+$LFLG2) ;Finns index?
		RET	NZ		;Ja, (HL+1234) ej tillåtet
		JP	OPKODC


; Typ 07, ADC etc RX

ACB_RX:		CP	7		;RX?
		JR	NZ,ALP		;Nej
		CALL	RX		;DD/FD
		JR	ACBRX


; Logiska pseudoinstruktioner
; Typ 02, AND etc [A,]RR
;     03, AND etc [A,]XY
; OR HL ger: LD A,H + OR L
; XOR IX ger: LD A,IXH + XOR IXL osv.

ALP:		CP	2		;BC,DE,HL?
		JR	Z,alp1		;Ja
		CP	3		;XY?
		RET	NZ		;Nej
alp1:		CP	3		;XY?
		LD	B,C
		LD	A,H
		PUSH	AF
		CALL	Z,OPKODA	;Ja, DD/FD
		JR	NZ,alp2		;NZ = inte XY
		LD	H,20H		;XYH eller XYL
alp2:		LD	A,H
		RRCA	3		;Gör BC, DE eller HL
		LD	H,A		;till B, D eller H
		INC	H		;Nästa register (C,E,L)
		LD	C,40H		;LD
		LD	D,7		;LD A,
		CALL	R_R		;LD A,B, D, H eller XYH
		POP	AF
		CALL	Z,OPKODA	;DD/FD
		LD	C,B		;Opkoden tillbaka
		JR	ACBRX		;Sen som C, E eller L


; @DIVMULW
; Instruktionerna DIVUW, MULTW och MULTUW
; IN:	 A	=D
;	BC	B skräp, C B8, 90, 98
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H R, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 02, DIVUW etc RR

DIVMULW:	CP	2		;RR?
		JR	NZ,DM_XY	;Nej
		CALL	RRCodeA
		RET	NZ		;ej BC, DE, HL
		CALL	FIXED		;ED först
		CALL	FIXCB		;+ CB
		JP	AXWRR		;+ opkod


; Typ 03, DIVUW etc XY

DM_XY:		CP	3		;XY?
		JR	NZ,DM_NN	;Nej
		CALL	FIXED		;ED först
		CALL	FIXCB		;+ CB
		LD	A,C
		OR	4
		BIT	5,H		;IX?
		JP	Z,OPKODA	;Ja
		INC	A
		JP	OPKODA


; Typ 04, DIVUW etc nn

DM_NN:		CP	4		;NN?
		JR	NZ,DM_AS	;Nej
DMNN:		CALL	FIXED		;ED först
		CALL	FIXCB		;+ CB
		LD	L,7
		CALL	AXWRR		;+ opkod
		LD	(IX+$LASTDDFLAG),0
		JP	PutAddress	;+ nn 16 bitar


; Typ 06, DIVUW etc 'wd'

DM_AS:		CP	6		;NN?
		JR	NZ,DM.XY	;Nej
		LD	(IX+$LASTDDFLAG),0
		CALL	CKAS
		JR	DMNN


; Typ 0B, DIVUW etc (XY)

DM.XY:		CP	0BH		;(XY)?
		RET	NZ		;Nej
		CALL	OPKODH		;DD/FD
		CALL	FIXCB		;+ CB
		CALL	PutIndex	;+ index
		LD	L,2
		JP	AXWRR		;+ BA


; @IARITW
; Rutinerna som följer hanterar 16 bitars instruktioner. De är:
; ADCW, ADDW, ANDW, CPW, ORW, SBCW, SUBW, XORW
; IN:	 A	=D
;	BC	B skräp, C 8C,84,A4,BC,B4,9C,94,AC
;	DE	D typ, E LFLG2
;	HL	om registeroperation: H RR, L typ
;	HL	om nn, (DA) eller <RA>: dd
;
; Typ 02, ADCW etc RR

IARITW:		EQU	$
		CP	2		;RR?
		JR	NZ,AXW_XY	;Nej
		CALL	RRCodeA
		RET	NZ		;ej BC, DE, HL
AXWRRED:	CALL	FIXED		;ED
AXWRR:		LD	A,L
		OR	C		;8C
		JP	OPKODA


; Typ 03, ADCW etc XY

AXW_XY:		CP	3		;XY?
		JR	NZ,AXW_NN	;Nej
		CALL	OPKODH		;DD/FD
		JR	AXWRR		;+ 8F, för XY har typ=3 i L


; Typ 04, ADCW etc nn

AXW_NN:		CP	4		;nn?
		JR	NZ,AXW_AS	;Nej
AXWNNA:		EX	DE,HL		;DE nn
		LD	L,2
		CALL	AXWRRED		;FIXED + OPKODC
		LD	(IX+$LASTDDFLAG),0
		JP	PutAddress	;+ nn 16 bitar


; Typ 06, ADCW etc 'wd'

AXW_AS:		CP	6		;AS?
		JR	NZ,AXW.XY	;Nej
		LD	(IX+$LASTDDFLAG),0
		CALL	CKAS
		JR	AXWNNA


; Typ 0B, ADCW etc (XY+d/dd/ddd)

AXW.XY:		CP	0BH		;(XY)?
		RET	NZ		;Nej
		CALL	OPKODH		;DD/FD först
		LD	A,C		;8C
		OR	42H		;=> CE
		CALL	OPKODA
		JP	PutIndex


; @RA
; Beräkna offset för RA
; IN:	 E	instruktionens längd
; UT:	HL	VALUE
;	HIVALUE & VALUE uppdaterade

RA:		LD	HL,(RACTR)	;$ för instruktionens 1a byte
		LD	D,0
		ADD	HL,DE		;PC+X
		EX	DE,HL
		LD	HL,(VALUE)
		EXX			;Bort
		PUSH	HL,DE
		LD	HL,(HIRACTR)
		LD	DE,0
		ADC	HL,DE
		EX	DE,HL
		LD	HL,(HIVALUE)
		EXX			;Fram
		BIT	BNXLBL,(IX+$LFLG1);Finns symbolen?
		JR	Z,ra1		;Ja
		LD	DE,HL
ra1:		OR	A
		SBC	HL,DE		;Low dd - PC+X
		LD	(VALUE),HL
		EXX			;Bort
		BIT	BNXLBL,(IX+$LFLG1);Finns symbolen?
		JR	Z,ra2		;Ja
		LD	DE,HL
ra2:		SBC	HL,DE		;Hi dd - PC+X
		LD	(HIVALUE),HL
		POP	DE,HL
		EXX			;Fram
		RET


; @ISHIFT
; Aritmetiska och logiska skiftinstruktioner:
; RL, RR, RLC, RRC, SLA, SRA, SRL
; IN:	 A	=D
;	BC	B skräp, C opkod
;	DE	D typ, E LFLG2
;	HL	H R, L typ eller d
;
; Typ 0B, RR etc (XY)

ISHIFT:		CP	0BH		;(XY)?
		JR	NZ,RS.XY1	;Nej
		CALL	OPKODH		;DD/FD
		CALL	FIXCB		;+ CB
		CALL	PutIndex	;+ index
		JP	OPKODC
RS.XY1:		LD	B,A		;Typ
		CALL	FIXCB		;De andra har escape CB
		LD	A,B


; Typ 01, RR etc R

RS_R:		CP	1		;R?
		JR	NZ,RS.HL	;Nej
		LD	A,C
		AND	0F8H
		OR	H
		JP	OPKODA


; Typ 0A, RR etc (HL)

RS.HL:		CP	0AH		;(HL)?
		RET	NZ		;Nej
RS.HLJ:		LD	A,H
		CP	20H		;Med HL?
		RET	NZ		;Nej
		BIT	BINDEX,E	;Finns index?
		RET	NZ		;Ja, fel
		JP	OPKODC


; @ISHIFTW
; Aritmetiska och logiska skiftinstruktioner:
; RLW, RRW, RLCW, RRCW, SLAW, SRAW, SRLW
; IN:	 A	=D
;	BC	B skräp, C opkod
;	DE	D typ, E LFLG2
;	HL	H RR, L typ eller d
;
; Typ 0B, RLW etc (XY)

ISHIFTW:	CP	0BH		;(XY)?
		JR	NZ,RSW.XY1	;Nej
		SET	1,C		;12
		JP	ISHIFT
RSW.XY1:	LD	B,A		;Typ
		CALL	FIXED		;De andra har escape ED CB
		CALL	FIXCB
		LD	A,B


; Typ 02, RLW etc RR

RSW_RR:		CP	2		;RR?
		JR	NZ,RSW.HL	;Nej
		CALL	RRCodeA
		RET	NZ
		LD	A,C
		OR	L
		JP	OPKODA


; Typ 0A, RLW etc (HL)

RSW.HL:		CP	0AH		;(HL)?
		JR	NZ,RSW_XY	;Nej
		SET	1,C
		JP	RS.HLJ


; Typ 03, RLW etc XY

RSW_XY:		CP	3		;XY?
		RET	NZ		;Nej
		SET	2,C		;14
		BIT	5,H		;IX?
		JP	Z,OPKODC
		INC	C		;15
		JP	OPKODC


; @IIM
; Instruktion IM

IMTAB:		DB	46H,56H,5EH,4EH	;IM 0, 1, 2 och 3
IIM:		CALL	TRUNK
		CP	4		;IM = 4?
		CALL	NC,FEL7		;Ja, Offset error
		LD	DE,IMTAB	;HL=0 => IM 0
		ADD	HL,DE
		LD	C,(HL)
		JP	FIXEDC


; @IMLT
; Instruktion MLT
; IN:	 A	=D
;	BC	B skräp, C
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 02, MLT RR

IMLT:		CP	2
		RET	NZ
		CALL	RRCodeC
		RET	NZ
		LD	A,(rrCodeC)
		OR	C
		LD	C,A
		JP	FIXEDC


; @ISWAP
; Instruktion SWAP
; IN:	 A	=D
;	BC	B skräp, C 0E
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 02, SWAP RR

ISWAP:		CP	2
		JR	NZ,SWAP_XY
		CALL	RRCodeA
		RET	NZ
		LD	A,(rrCodeA)
		OR	C
		LD	C,A
		JP	FIXEDC


; Typ 03, SWAP XY

SWAP_XY:	CP	3
		RET	NZ
		LD	A,C
		OR	30H
		LD	L,H
		LD	H,A
		JP	OPKODHL


; @ITST
; Instruktion TST och TSTIO
; IN:	 A	=D
;	BC	B skräp, C 4, 74 för TSTIO
;	DE	D typ, E LFLG2
;	HL	H RR, L typ
;
; Typ 01, TST R

ITST:		CP	1
		JR	NZ,TST_N
		CALL	FIXED
		LD	A,H
		JP	BILDA1


; Typ 04, TST/TSTIO n

TST_N:		CP	4
		JR	NZ,TST.HL
		CALL	FIXED
		LD	A,C
		OR	60H
		CALL	OPKODA
		CALL	TRUNKA
		JP	OPKODA


; Typ 04, TST (HL)

TST.HL:		CP	0AH
		RET	NZ
		CALL	FIXED
		LD	A,6
		JP	BILDA1
		FILE	ZAPFCPSI


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Pseudoinstruktioner	 	      ¦
¦					      ¦
¦	Entry: ........... ZAPFCPSI.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 11 22	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; @MULTI - multipla operander
; Vissa instruktioner får ha operand följd av
; multipel, ny operand med multipel etc.
; Tillåter även pseudoinstruktioner med underförstådd
; EXX, EXXX, EXXY eller EX AF,AF; INC A',2,B',HL',IX',IY' ger:
;
; 08	EX	AF,AF		;1
; 3C	INC	A
; 3C	INC	A
; 08	EX	AF,AF
; D9	EXX			;2
; 04	INC	B
; 23	INC	HL		;3
; D9	EXX
; DDD9	EXXX			;4
; DD23	INC	IX
; DDD9	EXXX
; FDD9	EXXY			;5
; FD23	INC	IY
; FDD9	EXXY
;
; IN:	MULTIX	instruktionshanterarens adress
;	Resten: se anroparen
; UT:	Retur med bortvända register när raden
;	är slut om allt gått bra.
;	AF	status: NZ nåt fel, annars 0, Z & NC
; OBS!	Max för multipeln är 255.

MULTI:		LD	B,A		;Operandtyp
		CALL	SINGLE		;Gör instruktionen 1 gg
		RET	NZ		;NZ = nåt fel
MULTIB:		EXX			;Bort
		LD	A,(LFLG2)	;Radflaggor
		LD	B,A
		AND	MPMASK		;Nollställ BEXX & BEXAF
		LD	(LFLG2),A	;inför nästa operand
		LD	A,B		;Minns EXX etc för denna
		AND	NOT(MPMASK)
		LD	C,A
		LD	A,(LFLG3)	;Minns gamla LFLG3
		LD	(OLDLFLG3),A
		AND	NOT(1 SHL BEXXX OR 1 SHL BEXXY) ;Nollställ
		LD	(LFLG3),A	;BEXXX och BEXXY
		CALL	FCCHAR
		CP	','		;,,?
		JR	NZ,MULTIO	;Nej
		CALL	FCKOMMA		;Förbi , etc
		SET	BFMI,(IX+$LFLG3);Tvinga instruktion
MULTIO:		BIT	BFMI,(IX+$LFLG3);Tvinga instruktion?
		JR	NZ,MULTIO_REG	;Ja
		BIT	BMSYNC,(IX+$LFLG3);Tvinga instruktion?
		JR	NZ,MULTIO_REG	;Ja
		LD	HL,(HIVALUE)	;Spara VALUE så att det inte
		PUSH	HL		;blir överskrivet av multipeln
		LD	HL,(VALUE)
		PUSH	HL
		CALL	FCEXPR		;Ta multipel
		PUSH	HL		;Spara HIVALUE i HIMVALUE
		LD	HL,(HIVALUE)
		LD	(HIMVALUE),HL
		POP	HL
		EX	(SP),HL
		LD	(VALUE),HL
		POP	HL
		EX	(SP),HL
		LD	(HIVALUE),HL
		POP	HL
		JR	MULTIO_X
MULTIO_REG:	CALL	FCEXPR		;Ta register
MULTIO_X:	LD	E,(IX+$LFLG2)	;Ev. ny EXX etc
		LD	(IX+$LFLG2),B	;Gamla tillbaka
		PUSH	AF		;Samma med LFLG3
		LD	A,(LFLG3)
		LD	(NEWLFLG3),A
		LD	A,(OLDLFLG3)
		LD	(LFLG3),A
		POP	AF
		RET	Z		;Z = raden slut
		PUSH	HL		;Register/multipel
		LD	HL,LFLG3	;Ska pyssla med flaggor
		BIT	BFMI,(HL)	;Tvinga instruktion?
		JR	NZ,MULTII	;Ja
		CP	4		;Typ N?
		JR	Z,MULTIC	;Ja, upprepa
MULTII:		RES	BMSYNC,(HL)	;Instruktion detta
		RES	BFMI,(HL)	;Kan tvingas en gång
		LD	A,(OLDLFLG3)
		AND	1 SHL BEXXX OR 1 SHL BEXXY
		XOR	(IX+$NEWLFLG3)
		LD	(HL),A		;LFLG3
		LD	A,E
		XOR	C
		DEC	HL		;LFLG2
		LD	(HL),A		;Ny LFLG2
		CALL	FIXEX		;EXX etc för nya
		LD	(HL),E
		INC	HL		;LFLG3
		LD	A,(NEWLFLG3)
		AND	NOT(1 SHL BMSYNC OR 1 SHL BFMI)
		LD	(HL),A
		LD	A,D
		EXX			;Fram
		POP	HL
		JP	MULTI		;Ny instruktion
MULTIC:		BIT	BMSYNC,(HL)	;Multipel förra gången?
		JR	Z,MULTIV	;Nej
		BIT	BMULTI,(HL)	;Är det tillåtet?
		JR	NZ,MULTII	;Ja
		LD	A,39		;Register expected
		JP	ERROR
MULTIV:		SET	BMSYNC,(HL)	;Instruktion nästa gång
		LD	HL,(HIVALUE)
		LD	DE,(HIMVALUE)
		LD	(HIVALUE),DE
		EX	(SP),HL
		CALL	OPLBL		;Definierad symbol väl?
		CALL	TRUNKA		;Ja. Max 255?
		EX	(SP),HL
		LD	(HIVALUE),HL
		POP	HL
		LD	A,L		;Ja, ok vi kör
		EXX			;Fram
		OR	A		;= 0?
		JP	Z,MULTIB	;Ja, (0 är 1 gång)
		DEC	A		;= 1?
		JP	Z,MULTIB	;Ja, (1 är 1 gång)
		LD	(MXCTR),A	;Kvar; 1 redan gjord
MULTIP:		LD	DE,(LCCT)	;Ny $ åt multipel RA
		LD	(RACTR),DE
		LD	DE,(HILCCT)
		LD	(HIRACTR),DE
		CALL	SINGLE		;En till
		DEC	(IX+$MXCTR)	;Fler?
		JR	NZ,MULTIP	;Ja
		JP	MULTIB
SINGLE:		PUSH	HL,BC		;Gör X en gång
		LD	A,B		;Kompatibel med STMNT
		LD	D,B
		LD	E,(IX+$LFLG2)
		CALL	DO_ONE
		POP	BC,HL
		RET


; @RR_R - pseudoinstruktion för LD
; Typ 21, LD RR,R
; IN:	 D	dst; RR
;	 H	src; R
; LD HL,A ger: LD H,A + LD L,A

RR_R:		LD	A,D
		CP	30H		;SP,R?
		JP	Z,ERR8		;Ja, kan inte
		CALL	RR_RRT		;BC, DE, HL
		LD	D,C		;Hög dest. B, D eller H
		LD	A,H		;Src reg
		CALL	RR_RRC
		INC	D		;Låg dest. C, E eller L
		LD	A,H
		JR	RR_RRC
RR_RRC:		LD	C,40H
		JP	R_R
RR_RRT:		CP	70H		;AF?
		JP	Z,ERR8		;Ja, kan inte
		LD	C,A
		OR	A		;BC?
		RET	Z		;Ja
		LD	C,2
		CP	10H		;DE?
		RET	Z		;Ja
		LD	C,4
		CP	20H		;HL?
		RET			;Ja


; @XY_R - pseudoinstruktion för LD
; Typ 31, LD XY,R
; IN:	 A	=H
;	 C	40
;	 D	dst; DD för IX, FD för IY
;	 H	src; R
; LD IX,A ger: LD IXH,A + LD IXL,A

XY_R:		OR	1
		CP	5		;XY,H eller L?
		PUSH	AF
		JR	NZ,XY_R1	;Nej
		CALL	Z,FIXEB		;EX DE,HL först
		DEC	H,2		;Gör D/E av H/L
XY_R1:		BIT	5,D		;IX eller IY?
		LD	D,4		;Antag IX
		JR	Z,XY_R2		;Z = IX
		SET	7,D		;IY
XY_R2:		LD	B,71H		;RX,R
		DEC	H
		PUSH	HL,DE,BC
		INC	H
		CALL	R_RX		;RR(h),XYH eller tvärtom
		POP	BC,DE,HL
		INC	H,D
		CALL	R_RX		;RR(l),XYL eller tvärtom
		POP	AF		;Avsluta med EX DE,HL?
		CALL	Z,FIXEB		;Ja
		XOR	A
		RET
		FILE	ZAPFCPSD


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Pseudodirektiv			      ¦
¦					      ¦
¦	Entry: ........... ZAPFCPSD.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 95 11 19	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; @Macro, pseudo
; Definiera namn och parametersättning.
; Syntax: MACRO NAMN [:][par,par,,,] (max 16)
; IN:	IY	pekar på makrot i TextMap
; Resten av raden kopierad till LinBuf i FcMap

PMACRO:		CALL	MFLAGS		;Pågår makrodefinition?
		LD	A,28
		JP	NZ,ERROR	;Ja, ENDM missing
		CALL	MAPIY
		LD	HL,MNAMES	;Peka på start
		CALL	SÖKMAC		;Finns makrot förut?
		LD	A,30		;Doubly defined macro
		JP	NC,FCERR	;Ja
		LD	A,(IY)
		CALL	TILLÅT		;Tillåtet tecken?
		JP	C,FCER8		;Nej, Invalid operand
		PUSH	HL		;HL namnets startadress
		LD	HL,(MACPTR)
		LD	DE,MLEN$	;+ max storlek
		ADD	HL,DE		;Plats för ett till?
		LD	A,34		;Macro area overflow
		JP	C,FCERR		;CY = över 64k
		LD	DE,(MLIMIT)
		SBC	HL,DE		;Inom rimliga gränser?
		JP	NC,FCERR	;Nej
		LD	HL,IY
		POP	DE
PO1:		LD	A,(HL)		;Sätt in i tabellen
		CALL	EXTEND		;Tillåt siffror i namnet
		JR	C,PO2		;C = namnet slut
		LDI
		JR	PO1
PO2:		LD	IY,HL
		EX	DE,HL
		DEC	HL		;Sista tecknet
		SET	7,(HL)		;Sätt bit 7 åt SÖK
		INC	HL
		LD	(CURMAC),HL	;Adress makrots data
		LD	HL,MSTART
		LD	DE,MSTART+1
		LD	BC,MLEN$	;Nollställ wrk
		LD	(HL),0
		LDIR			;MPCTR i C = 0
		CALL	TECKEN		;Förbi blank och tab
		SET	BSTEP,(IX+$LFLG2);KOMMA rör ej komma
		LD	A,(IY)
		CP	','		;Finns parametrar?
		JR	Z,PO3		;Ja
		CALL	EXTEND		;Tillåtet tecken?
		JR	NC,PO3		;Ja
		CALL	TXPOS		;Flytta IY till TX
		CALL	FCMORE		;Fortsätta på nästa rad?
		PUSH	AF
		CALL	MAPIY
		POP	AF
		JR	NC,PO3		;Ja
		CALL	TXPOS
POEXI:		LD	HL,MMAIN	;MacroDef pågår,
		LD	A,(HL)		;det finns makron,
		OR	MMASK		;eget makro definierat
		LD	(HL),A
		LD	A,C		;Så här många parametrar
		LD	(MPCTR),A
		XOR	A		;IY vid ; eller CR
		RET
PO3:		RES	BCOMMA,(IX+$MMAIN);Tvinga ,,
PO4:		CALL	FCPOS?		;IY är väl i FC?
		LD	A,(IY)		;LINBUF i FC
		CP	','		;En parameter till?
		JR	Z,PO9		;Ja
PO5:		CALL	TXPOS
		CALL	FCMORE		;Fortsätta på nästa rad?
		JR	C,PO6		;Nej
		CALL	MAPIY
		JR	PO3		;Om från början
PO6:		RES	BCOMMA,(IX+$MMAIN);Tvinga ,,
		CALL	FCEXPR		;Få värdet av en symbol
		JR	NZ,PO8		;NZ = finns värde
		LD	A,MAXPAR
		SUB	C		;Fått max?
		JR	Z,POEXI		;Ja, inget att justera
		LD	B,A		;Antal pos. att flytta
		LD	HL,(MDPOS)
PO7:		ADD	HL,HL		;Bit 15 = 1a parameter
		DJNZ	PO7
		LD	(MDPOS),HL
		JR	POEXI
PO8:		PUSH	HL		;Default (ord)
		LD	A,C		;MPCTR som index
		CP	MBYTES		;Blivit max?
		JP	NC,FCER35	;Ja
		LD	D,0
		LD	E,A
		LD	HL,MDCODE	;Bas för defaultkoder
		ADD	HL,DE,2		;Sätt på sin position
		POP	DE		;en default parameter
		LD	(HL),E
		INC	HL
		LD	(HL),D
		JR	PO11		;Öka MPCTR
PO9:		BIT	BCOMMA,(IX+$MMAIN);Fått ,,?
		JR	NZ,PO10		;Ja
		INC	IY
		LD	A,(IY)
		CP	','		;,,?
		JR	NZ,PO5		;Nej, symbol
		SET	BCOMMA,(IX+$MMAIN);Parameter default
PO10:		INC	IY		;Förbi ,,
PO11:		LD	A,C		;Antal parametrar totalt
		CP	MAXPAR		;För många?
		JP	NC,FCER33	;Ja, Too many params.
		INC	C		;Försök med en till
		LD	HL,(MDPOS)	;Flaggor för default pos
		OR	A		;Antag tom position
		BIT	BCOMMA,(IX+$MMAIN);Tom position?
		JR	NZ,PO12		;Ja
		SCF			;1 för CR i TEXT,,CR,0
PO12:		PUSH	AF
		ADC	HL,HL		;Default parameter
		LD	(MDPOS),HL
		POP	AF
		JP	C,PO3
		JP	PO4


; Sök upp ett makro
; IN:	HL	pekar på makroarean
;	IY	pekar på makro att söka efter
; UT:	BC,DE	orört
;	HL	pekar på 1a byte efter namnet
;	CY	makrot finns inte

SÖKMAC:		LD	A,(HL)
		OR	A		;Inga makron?
		SCF
		RET	Z		;Nej
		PUSH	IY
SMC1:		LD	A,(HL)		;Ett tecken i tabellen
		AND	7FH		;Bort med EOS
		CP	(IY)		;Samma som i kk?
		JR	NZ,SMC2		;Nej
		BIT	7,(HL)		;Sista tecknet?
		INC	HL,IY
		JR	Z,SMC1		;Nej
		LD	A,(IY)
		CALL	EXTEND		;Textens sista tecken?
		JR	NC,SMC3		;Nej
		POP	AF		;Glöm IY
		CALL	TECKEN		;Förbi tab & blank
		XOR	A
		RET
SMC2:		BIT	7,(HL)		;Gå till namnets slut
		INC	HL		;i tabellen
		JR	Z,SMC2
SMC3:		PUSH	DE
		LD	E,(HL)		;Ta offset till nästa
		LD	D,0
		ADD	HL,DE		;HL pekar på nästa makro
		POP	DE,IY
		JR	SÖKMAC


; Initiera IY för arbete i FCMAP

MAPIY:		LD	(IYINI),IY	;IY i TX
		LD	IY,LINBUF
		CALL	TXPOS		;Init för relokering
		JR	FCPOS		;av IY


; Flytta IY från FC till TX bara om IY pekar i FC
; IN:	BC,DE,HL reserverade
; UT:	IYFC och IYTX uppdaterade, kanske.

TXPOS?:		BIT	BIYMAP,(IX+$MISC1);IY redan i TX?
		RET	Z		;Ja


; Flytta IY från LINBUF i FC till motsvarande
; position på raden i TX.
; IN:	BC,DE,HL reserverade
; UT:	IYFC och IYTX uppdaterade

TXPOS:		PUSH	HL,DE
		LD	HL,IY
		LD	(IYFC),HL	;Senaste IY i FC
		LD	DE,LINBUF
		OR	A
		SBC	HL,DE
		EX	DE,HL
		LD	IY,(IYINI)
		ADD	IY,DE
		LD	(IYTX),IY	;Motsvarande IY i TX
		RES	BIYMAP,(IX+$MISC1);IY i TX
		POP	DE,HL
		RET


; Flytta IY från TX till FC bara om IY pekar i TX
; IN:	BC,DE,HL reserverade
; UT:	IYFC och IYTX uppdaterade, kanske.

FCPOS?:		BIT	BIYMAP,(IX+$MISC1);IY redan i FC?
		RET	NZ		;Ja


; Flytta IY från TX till FC
; IN:	BC,DE,HL reserverade
; UT:	IYFC och IYTX uppdaterade

FCPOS:		PUSH	HL,DE		;IY i TX
		LD	HL,IY
		LD	DE,(IYTX)	;Senaste IY i TX
		LD	(IYTX),HL	;Ny IY i TX
		OR	A
		SBC	HL,DE		;Antal som stegats i TX
		LD	DE,(IYFC)
		ADD	HL,DE		;Motsvarande HL i FC
		LD	(IYFC),HL
		SET	BIYMAP,(IX+$MISC1);IY i FC
		LD	IY,HL
		POP	DE,HL
		RET


; Kolla om makrodefinition pågår
; UT:	 Z	pågår inte

MFLAGS:		BIT	BMDEF,(IX+$MMAIN);Redan aktiv?
		LD	A,27		;No prior MACRO
		RET			;Nej


; @CODE, pseudo. Definiera opkoden.
; Syntax: CODE	[:]opkod,opkod,,, (max 16)
; Alla opkoder än så länge med DB.
; IN:	IY	pekar på operand till CODE i TX
;	 A	operandens första tecken

PCODE:		PUSH	AF
		CALL	MFLAGS		;Flaggorna ok?
		JP	Z,ERROR		;Nej, No prior MACRO
		LD	BC,0		;MCODE i C, B reserverat
		POP	AF
		CALL	EXTEND		;Tillåtet tecken?
		JR	NC,PE1		;Ja
		CALL	FCMORE		;Fortsätta på nästa rad?
		JR	C,ERR31		;Nej, Operand missing
PE1:		CALL	FCEXPR
		RET	Z
		EX	DE,HL		;Byte i E
		LD	A,C		;Antal opkoder
		CP	MBYTES		;Fått max?
		JR	NC,ERR29	;Ja
		INC	A		;En opkod till
		LD	(MCODE),A
		LD	HL,MCODES
		ADD	HL,BC
		INC	C		;Upp med index
		LD	(HL),E		;En byte till i MCODES
		PUSH	BC
		LD	C,E
		CALL	PUTOBJ		;Sätt in i OBJ
		POP	BC
		JR	PE1
ERR29:		LD	A,29		;Too many operands
PEERR:		JP	ERROR
ERR31:		LD	A,31
		JR	PEERR


; @DATA, pseudo. Definiera typ av operand.
; Syntax: DATA	[:]typ,typ,,, (max 16)
; IN:	Resten av raden kopierad till LINBUF
; UT:	IY	; eller CR i LINBUF

PDATA:		CALL	MFLAGS		;Flaggorna ok?
		JP	Z,ERROR		;Nej, No prior MACRO
		CALL	FCMORE		;Tillåt ny rad
		LD	C,0		;MOPS i C
PA1:		LD	(IYINI),IY
		LD	IY,LINBUF
PA2:		LD	HL,DTYPE
		CALL	SÖKIY
		JP	C,FCER8		;Invalid operand
		EX	DE,HL		;DE adress
		LD	A,C		;Operander hittills
		CP	MAXPAR		;Fått max?
		JP	NC,FCER29	;Ja
		INC	C		;En operand till
		LD	HL,(MOFLG)
		EX	DE,HL		;HL adress, DE flaggor
		XOR	A		;Bort CY
		CALL	JPHL		;Gå till BYTE eller WORD
		LD	(MOFLG),HL
		LD	A,(IY)
		CALL	SLUT		;Vid ; eller CR?
		JR	NC,PA3		;Ja
		CALL	KOMMA		;Förbi komma etc
		CALL	TXPOS
		CALL	FCMORE		;Fortsätta på nästa rad?
		JR	NC,PA1		;Ja
		CALL	FCPOS
		JR	PA2
PA3:		CALL	TXPOS
		LD	A,(MPCTR)
		LD	B,A
		LD	A,C		;Antal operander
		CP	B		;Specat alla defaulta?
		JP	C,FCER36	;Nej
		LD	(MOPS),A
		LD	A,(MCTRL)	;Bytes OCH Words?
		AND	1 SHL BBYTES OR 1 SHL BWORDS
		CP	1 SHL BBYTES OR 1 SHL BWORDS
		LD	A,37		;Can't do BYTES & WORDS
		JP	Z,FCERR		;Ja
		LD	A,MAXPAR
		SUB	C		;Fått max?
		RET	Z		;Ja, inget att justera
		LD	B,A		;Antal pos. att flytta
		LD	HL,(MOFLG)	;HL operandflaggorna
PA4:		ADD	HL,HL		;Bit 15 = 1a operand
		DJNZ	PA4
		LD	(MOFLG),HL
		XOR	A
		RET


; Datatyper för pseudo DATA i ett makro

DTYPE:		DC	'BYTE'		;BYTE
		DW	PBYTE
		DC	'BYTES'		;BYTES
		DW	PBYTES
		DC	'WORD'		;WORD
		DW	PWORD
		DC	'WORDS'		;WORDS
		DW	PWORDS
		DB	0


; Handler för BYTE och WORD
; ASCII hanteras av BYTE(S)
; IN:	DE	MOFLG
; UT:	HL	MOFLG

PWORD:		SCF			;WORD = 1
PBYTE:		EX	DE,HL		;BYTE = 0
		ADC	HL,HL
		RET


; Handler för BYTES och WORDS

PBYTES:		LD	HL,MCTRL
		SET	BBYTES,(HL)	;Bytes i detta makro
		JR	PBYTE
PWORDS:		LD	HL,MCTRL
		SET	BWORDS,(HL)	;Words i detta makro
		JR	PWORD


; @ENDM, pseudo. Avsluta makrodefinition.

PENDM:		CALL	MFLAGS		;Flaggorna ok?
		JP	Z,ERROR		;Nej, No prior MACRO
		LD	BC,MLEN$
		LD	DE,(CURMAC)
		LD	HL,MSTART
		LD	(HL),C		;Offset till nästa makro
		LDIR
		EX	DE,HL
		LD	(HL),C		;Sista makrot
		LD	(MACPTR),HL	;MacroPointer
		RES	BMDEF,(IX+$MMAIN);MACRO-definition klar
		XOR	A
		RET


; @GMAC - generera makro
; Syntax: NAMN	[:], operand enligt MACRO och DATA
; IN:	IY	pekar på makrot i TX
; Resten av raden kopierad till LINBUF

GENMAC:		CALL	MAPIY
		LD	HL,MNAMES
		CALL	SÖKMAC		;Är makrot definierat?
		JR	NC,GC1		;Ja
		LD	IY,(IYINI)
		RET
GC1:		LD	(CURMAC),HL	;Makrots data till wrk
		LD	DE,MSTART
		LD	BC,MLEN$
		LDIR			;Index i C
		LD	HL,(MDPOS)	;Defaultpositioner
		LD	DE,(MOFLG)	;Operandflaggor
		PUSH	DE,HL
		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		SET	BSTEP,(IX+$LFLG2);STEGA rör ej komma
		LD	HL,MCODE	;Antal opkoder
		LD	A,(HL)
		OR	A		;Finns det opkoder?
		JR	Z,GC3		;Nej
		SET	BPADDR,(IX+$LFLG1);Adress i LIST
		LD	B,A
GC2:		INC	HL
		LD	A,(HL)
		CALL	OPKODA		;Skicka ut dem
		DJNZ	GC2
GC3:		LD	A,(MOPS)	;Antal operander
		LD	B,A
		LD	HL,MPCTR	;Antal på def.raden
		CP	(HL)		;Vilken är störst?
		JR	NC,GC4		;Z&NC = MOPS
		LD	B,(HL)
GC4:		LD	A,B
		OR	A		;Finns operander?
		JR	NZ,GC5		;Ja
		LD	A,(IY)
		CALL	SLUT		;Vid ; eller CR?
		JP	NZ,FCER5	;Nej, Syntax error
		CALL	TXPOS		;IY från FC till TX
GCEXI:		POP	AF,AF
		XOR	A
		RET
GC5:		SET	BPDB,(IX+$LFLG2);Ta inte 'xx' som ord
		RES	BCOMMA,(IX+$MMAIN);Tvinga ,,
GC6:		CALL	FCPOS?		;IY är väl i FC?
		LD	A,(IY)		;Detta är FC
		CP	','		;En parameter till?
		JR	NZ,GC8		;Nej
		BIT	BCOMMA,(IX+$MMAIN);Fått ,,?
		JR	NZ,GC7		;Ja
		INC	IY
		CALL	TECKEN		;Förbi blank och tab
		LD	A,(IY)
		CP	','		;,,?
		JR	NZ,GC8		;Nej, symbol
		SET	BCOMMA,(IX+$MMAIN);Parameter default
GC7:		INC	IY		;Förbi ,,
		XOR	A		;Inget från EXPR
		JR	GC10
GC8:		CALL	TXPOS		;IY från FC till TX
		CALL	FCMORE		;Fortsätta på nästa rad?
		JR	C,GC9		;Nej
		CALL	MAPIY
		JR	GC5		;Om från början
GC9:		RES	BCOMMA,(IX+$MMAIN);Tvinga ,,
		CALL	FCEXPR		;Få värdet av en symbol
GC10:		EX	AF,AF		;Z = finns ingen
		INC	B
		DEC	B		;Fler operander?
		JR	NZ,GC13		;Ja
		BIT	BCOMMA,(IX+$MMAIN);Odefinierad ,,?
		JR	NZ,GC11		;Ja, gå raden ut
		EX	AF,AF		;Retur om Z. Fel om inte
		JR	Z,GCEXI		;bytes eller words finns
		EX	AF,AF
GC11:		LD	A,(MCTRL)	;Bytes eller words?
		AND	1 SHL BBYTES OR 1 SHL BWORDS
		JP	Z,FCER5		;Nej, syntax error
		EXX
		POP	HL,DE
		SBC	HL,HL		;Inget default
		LD	DE,HL		;Antag bytes
		CP	1 SHL BBYTES	;Bytes?
		JR	Z,GC12		;Ja
		DEC	DE		;Det är words
GC12:		PUSH	DE,HL
		EXX
		INC	B		;Håll B på 0 (1 nu)
		DEC	C		;Håll C orört
GC13:		SET	BPADDR,(IX+$LFLG1);Adress i LIST
		EXX			;A och D är operandtyp
		EX	AF,AF
		POP	HL,DE
		ADD	HL,HL		;CY om default finns
		EX	DE,HL		;HL' MOFLG
		JR	NZ,GC17		;NZ = skriv över default
		JR	C,GC15		;C = default finns
		ADD	HL,HL		;MDPOS & MOFLG lika.
		PUSH	HL,DE		;,, mot ,, och det kan
		EXX			;finnas mer längre fram
GC14:		DEC	B		;En parameter färre
		INC	C		;Index hänger med
		JR	GC6
GC15:		ADD	HL,HL		;Byte eller word?
		PUSH	HL,DE
		EXX
		PUSH	AF		;CY, typ
		LD	D,0
		LD	E,C		;Index
		LD	HL,MDCODE	;Defaultkoder
		ADD	HL,DE,2
		LD	E,(HL)		;Ta ett ord
		INC	HL
		LD	D,(HL)
		EX	DE,HL
		POP	AF
		JR	C,GC16		;C = word
		LD	A,L
		CALL	OPKODA		;Generera en byte
		JR	GC14
GC16:		CALL	OPKODHL		;Generera ett ord
		JR	GC14
GC17:		ADD	HL,HL		;Byte eller word?
		PUSH	HL,DE
		EXX
		JR	C,GC19		;C = word
		CP	6		;ASCII-sträng?
		JR	Z,GC20		;Ja
		CALL	TRUNK		;Typen måste vara 4
		CALL	OPKODA
GC18:		DEC	B		;En parameter färre
		INC	C		;Index hänger med
		JP	GC5
GC19:		CP	4
		JP	NZ,FCER5	;Syntax error
		CALL	OPKODHL
		JR	GC18
GC20:		CALL	FCHDB		;Ta strängen
		JR	GC18


; @WRMC - skriv makroarean till disken
; *.MC hanteras likadant som *.SY. Se WRSY.
; Generera CRC om BSYCRC är 1.

WRMC:		BIT	BMCSAV,(IX+$FOPT2);Spara makron?
		RET	Z		;Nej
		LD	HL,(FELR)
		OR	HL		;Några fel?
		JR	Z,WC2		;Nej
WC1:		Text	'(No macrofile created)'
		RET
WC2:		LD	HL,(MACPTR)	;Från sista endm
		LD	DE,MNAMES	;Start makron
		SBC	HL,DE		;Tom area?
		JR	Z,WC1		;Ja
		ADD	HL,DE
		LD	(HL),0		;Sista makrot
		INC	HL
		LD	(HL),-1		;Filslut
		INC	HL
		OR	A
		SBC	HL,DE
		EX	DE,HL		;HL MNAMES, DE #byte
		SCAL	ZCRCB		;CRC på det
		LD	(MCFCB+FEXA),HL	;Spara CRC i FEXA
		EX	DE,HL		;HL efter FF
		LD	A,L
		OR	A		;Extra nollställning?
		JR	Z,WC6		;Nej
WC5:		LD	(HL),0
		INC	HL
		LD	A,L
		OR	A
		JR	NZ,WC5
WC6:		LD	DE,MNAMES
		SBC	HL,DE
		LD	L,H		;Antal sektorer
		LD	B,H
		LD	H,A		;A = 0
		LD	(MCFCB+FNSC),HL	;Antal sektorer
		LD	L,A		;HL = 0
		LD	A,(MCDRV)
		LD	C,A
		SCAL	ZRDIR		;Läs dir
		CALL	ZAPER
		LD	(MCFCB+FSFL),HL
		LD	(MCFCB+FLDA),HL
		LD	DE,(NXTSEC)
		LD	(MCFCB+FSEC),DE
		LD	A,(SFLAG)	;SY gäller för MC också
		BIT	BSYCRC,A	;Generera CRC på SY?
		JR	NZ,WC3		;Ja, redan gjort
		LD	(MCFCB+FEXA),HL	;Ingen CRC i FEXA
WC3:		LD	HL,MNAMES
		SCAL	ZDWR		;Skriv filen till disken
		CALL	ZAPER
		LD	HL,MCFCB
		JP	ENTER		;Katalogisera


; @REFM - ladda in en makrofil från disken
; IN:	resten av raden kopierad till LINBUF
; *.MC hanteras likadant som *.SY. Se HPREFS.
; Kolla CRC om BSYCRC är 1.

PREFM:		LD	HL,'YS'		;SY NÖDLÖSNING!
		LD	(WKFCB+FEXT),HL
		LD	HL,WKFCB
		LD	DE,LINBUF
		LD	BC,6*256+36H	;C:B3 = DON'T MATCH FEXT!
		SCAL	ZLFN		;Ta filnamnet
		JR	Z,PM1		;Z = inget fel
		LD	A,(ERRCOD)	;Den som hittade felet
		LD	B,A
		CP	ZCFS		;CFS?
		LD	A,42		;Bad macrofile name
		JR	Z,PMERRJ	;Ja
		LD	A,B
		CP	ZRDIR		;RDIR?
		LD	A,38		;Macrofile unreadable
		JR	Z,PMERRJ	;Ja
		LD	A,43		;No such macrofile
PMERRJ:		JP	ERROR
PM1:		DEC	HL
		LD	(HL),C		;WKDRV
		LD	(IX+$RETRY),RCTR
PM2:		LD	A,(WKFCB+FNSC)
		LD	B,A
		LD	A,(WKDRV)
		LD	C,A
		LD	HL,(MACPTR)
		LD	DE,(WKFCB+FSEC)
		SCAL	ZDRD		;Läs filen
		CALL	ZAPER
		LD	C,A		;A = 0
		ADD	HL,BC		;HL filens slut
		DEC	HL,A		;Sök upp FF
		CPDR
		JP	PO,ERR38	;PO = FF fanns inte
		PUSH	HL		;Nya MACPTR
		INC	HL,2		;Efter FF
		EX	DE,HL
		LD	HL,(MACPTR)
		SCAL	ZCRCA		;CRC på filen
		LD	DE,(WKFCB+FEXA)
		SBC	HL,DE		;Stämmer CRC?
		POP	HL
		JR	Z,PM3		;Ja
		LD	A,(SFLAG)
		BIT	BSYCRC,A	;Kolla CRC på SY?
		JR	Z,PM3		;Nej
		DEC	(IX+$RETRY)	;Försöka igen?
		JR	NZ,PM2		;Ja
		JR	ERR38
PM3:		LD	(MACPTR),HL
		SET	BMACRO,(IX+$MMAIN);Det finns makron
		SET	BMDISK,(IX+$MMAIN);Kommer från disken
		RET
ERR38:		LD	A,38		;Macrofile unreadable
		JR	PMERRJ


; @DB - pseudo DB och DEFB

PDB:		SET	BPDB,(IX+$LFLG2);Flagga DB åt CITAT
		CALL	FCEXPR
		RET	Z
		CP	6		;Mer än en byte?
		JR	NZ,PDB1		;Nej
		INC	C
		DEC	C		;DEFB?
		JP	NZ,ERR8		;Ja, ogiltig operand
		CALL	FCHDB
		JR	PDB
PDB1:		CALL	TRUNK
		CALL	OPKODA
		JR	PDB


; @DUP - pseudo DUP (byte)
; Syntax: DUP 0,10
; Medför att 0 kopieras 10 gånger

PDUP:		CALL	FCEXPR		;Byte att kopiera
		CALL	TRUNK		;Fel om > 255
		PUSH	HL		;L = byte
		CALL	FCEXPR		;Antal gånger
		CP	4		;Typ nn?
		JP	NZ,ERR8		;Nej
		POP	BC
PDUP1:		CALL	OPKODC		;Byte C
		DEC	HL		;HL gånger
		OR	HL
		JR	NZ,PDUP1
		RET


; @DUPW - pseudo DUPW (word)
; Syntax: DUPW 0,10
; Medför att 0 kopieras 10 gånger

PDUPW:		CALL	FCEXPR
		CP	4
PDUPW1:		JP	NZ,ERR8
		LD	DE,(HIVALUE)
		PUSH	DE,HL
		CALL	FCEXPR		;Antal gånger
		LD	BC,HL		;BC = antal
		POP	HL,DE
		CP	4
		JR	NZ,PDUPW1
		LD	(VALUE),HL
		LD	(HIVALUE),DE
		LD	(IX+$LASTDDFLAG),0
PDUPW2:		CALL	PutAddress
		DEC	BC
		OR	BC
		JR	NZ,PDUPW2
		RET


; @DUPD - pseudo DUPD (double word)
; Syntax: DUPD 0,10
; Medför att 0 kopieras 10 gånger

PDUPD:		CALL	FCEXPR
		CP	4
PDUPD1:		JP	NZ,ERR8
		LD	DE,(HIVALUE)
		PUSH	DE,HL
		CALL	FCEXPR		;Antal gånger
		LD	BC,HL		;BC = antal
		POP	HL,DE
		CP	4
		JR	NZ,PDUPD1
PDUPD2:		CALL	OPKODHL
		EX	DE,HL
		CALL	OPKODHL
		EX	DE,HL
		DEC	BC
		OR	BC
		JR	NZ,PDUPD2
		RET


; @DW - pseudo DW och DEFW, J4K1

PDW:		CALL	FCEXPR
		RET	Z
		CP	4
		RET	NZ
		LD	(IX+$LASTDDFLAG),0
		CALL	PutAddress
		JR	PDW


; @DD - pseudo DD, J16K1

PDD:		CALL	FCEXPR
		RET	Z
		CP	4
		RET	NZ
		CALL	OPKODHL
		LD	HL,(HIVALUE)
		CALL	OPKODHL
		JR	PDD


; @DS - pseudo DS, J13K2

PDS:		CALL	OPLBL
PDS1:		LD	(IX+$SEP),'+'	;Plus som skiljetecken
		LD	(OBJ+2),HL	;Visa värde att addera till LCCT
		LD	BC,(HIVALUE)
		LD	(OBJ),BC
		EX	DE,HL
		LD	HL,(LCCT)
		ADD	HL,DE
		LD	(LCCT),HL
		LD	HL,(HILCCT)
		ADC	HL,BC
		LD	(HILCCT),HL
		XOR	A
		BIT	BPUTC,(IX+$FPASS);Blivit någon kod än?
		RET	Z		;Nej
		LD	HL,(FORORG)
		ADD	HL,DE
		LD	(FORORG),HL
		LD	HL,(HIFORORG)
		ADC	HL,BC
		LD	(HIFORORG),HL
		XOR	A
		RET


; @FILE, pseudo - ny källkodsfil

PFILE:		CALL	MAPIY
		LD	(ZCLINP),IY
		LD	HL,FLFCB
		CALL	INPTX
		LD	IY,(ZCLINP)
		CALL	TECKEN		;Gå till ktar eller slut
		CALL	TXPOS
		SET	BFILE,(IX+$MISC1);FILE påträffad
		SET	BFRCRD,(IX+$MISC1);Tvinga inläsning
		XOR	A
		RET


; @ALIGN - aligna LCCT, default 2
; Genererar DS så att Location Counter (LCCT)
; på nästa adress blir jämnt delbar med multipeln
; Formel: (LCCT + X-1) AND NOT (X-1)
; OBS!	Fungerar bara på binära multiplar

PALIGN:		SET	BPADDR,(IX+$LFLG1);Adress i LIST
		CALL	FCEXPR		;Finns multipel?
		LD	DE,2		;Even default
		LD	BC,1		;1
		EXX
		LD	DE,0
		LD	BC,0
		EXX
		JR	Z,PN1		;Nej
		CALL	OPLBL		;Måste ha definierad lbl
		BIT	0,L		;Måste vara jämnt
		JP	NZ,ERR5		;Syntax error
		EX	DE,HL
		LD	DE',(HIVALUE)
PN1:		EX	DE,HL		;X-1 1st
		OR	A
		SBC	HL,BC
		EX	DE,HL		;X-1 lo
		EXX
		EX	DE,HL
		SBC	HL,BC
		EX	DE,HL		;X-1 hi
		EXX
		LD	HL,(LCCT)
		LD	BC,HL
		ADD	HL,DE		;LCCT + X-1 lo
		CPL	DE		;NOT (X-1) lo
		EXX
		LD	HL,(HILCCT)
		LD	BC,HL
		ADC	HL,DE		;LCCT + X-1 hi
		CPL	DE		;NOT (X-1) hi
		EXX
		AND	HL,DE		;AND mellan leden
		EXX
		AND	HL,DE		;AND mellan leden
		LD	(HIVALUE),HL
		OR	HL
		EXX
		OR	H
		OR	L		;Inget att lägga till?
		JP	Z,PDS1		;Nej
		SBC	HL,BC		;Antal att lägga till
		EXX
		SBC	HL,BC
		LD	(HIVALUE),HL
		EXX
		JP	PDS1


; @END - pseudo END

PEND:		SET	BPADDR,(IX+$LFLG1);Adress i LIST
		SET	BEND,(IX+$LFLG1);Flagga END
		XOR	A
		RET


; @IF - pseudo IF/COND

PIF:		CALL	FCEXPR
		CALL	OPLBL
		PUSH	HL
		LD	HL,(VILLK)
		LD	DE,VILLK+17
		SBC	HL,DE		;Ta fler nivåer?
		ADD	HL,DE
		LD	A,15		;Too many IF/CONDs
		JR	NC,HD1		;Nej
		POP	DE
		OR	DE
		AND	(HL)
		JR	Z,PIF1
		LD	A,-1
PIF1:		INC	HL
		LD	(HL),A
PIF2:		LD	(VILLK),HL
PIF3:		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		SET	BCOND,(IX+$LFLG1);Gällande villkor
PIF4:		XOR	A
		RET


; @ELSE - pseudo ELSE

PELSE:		CALL	HCOND
		LD	A,(HL)
		CPL			;Reversera
		DEC	HL
		AND	(HL)		;FALSE om högre nivån
		INC	HL		;är det
		LD	(HL),A
		JR	PIF3


; @ENDC - pseudo ENDIF/ENDC

PENDC:		CALL	HCOND
		DEC	HL
		JR	PIF2


; Hjälprutin åt ELSE och ENDC

HCOND:		LD	HL,(VILLK)
		LD	DE,VILLK+3
		OR	A
		SBC	HL,DE
		ADD	HL,DE
		RET	NC
		LD	A,16		;No prior IF/COND
HD1:		JP	ERROR


; @DXTL - deaktivera TTL eller STL
; IN:	 A	mask för deaktivering

DEAXTL:		AND	(IX+$FPASS)	;Deaktivera
		LD	(FPASS),A
		JR	XTLEXI


; @AXTL - aktivera TTL eller STL
; IN:	 A	mask för aktivering
;	 E	0 = TTL, 1 = STL
; Resten av raden kopierad till LINBUF

ACTXTL:		OR	(IX+$FPASS)	;Aktivera
		LD	(FPASS),A
		LD	HL,LINBUF
		LD	BC,ÖSIZE
		DEC	E		;STL?
		LD	DE,STLÖSK
		JR	Z,AL1		;Ja
		LD	DE,TTLÖSK
AL1:		LD	A,CR		;CR är stopptecken
AL2:		CP	(HL)		;Raden slut?
		JR	Z,AL4		;Ja
		LDI
		JP	PE,AL2
AL3:		CP	(HL)		;Gå till slutet av raden
		INC	HL
		JR	NZ,AL3		;NZ = raden ej slut
		DEC	HL
		JR	AL7
AL4:		LD	B,C		;Blanka ut resten
		LD	A,BLANK
		EX	DE,HL
		INC	B
		DEC	B		;Fullt i TTLÖSK?
		JR	Z,AL6		;Ja
AL5:		LD	(HL),A
		INC	HL
		DJNZ	AL5
AL6:		EX	DE,HL
		LD	A,CR
		JR	AL3
AL7:		CALL	EJECT		;FF med nya överskriften
XTLEXI:		SET	BNOLO,(IX+$FOUT);Lista inte denna rad
		XOR	A
		RET


; WIDTH, pseudo

PWIDTH:		DB	WIDTHT$	;Antal
WIDTHT:		DB	0
		DB	44H	;WIDTH n,n
WIDTHT$:	EQU	$-WIDTHT
		ICTRL	,,PWERR8-$
		ICTRL	,,WIDTH-$,IMDATA


; Typ 44, WIDTH n1,n2[,n3,n4]
; IN:	 A	=H
;	BC	B 44, C 0
;	DE	n2
;	HL	n1
; Resten av raden kopierad till LINBUF
; WIDTH n1,n2,n3,n4 ger: n1 CPI med n2 CPL under pass 2.
; Efter pass 2 sätts printern till n3 CPI med n4 CPL.

WIDTH:		CALL	MAPIY		;IY till FC
		BIT	BPASS,(IX+$FPASS);Pass 1?
		JR	Z,width1	;Ja
		RES	BPADDR,(IX+$LFLG1);Ingen adress i LIST
		CALL	SKIP		;ZAP & MASTER gör resten
		CALL	TXPOS		;Tillbaka till TX
		XOR	A
		RET
width1:		CALL	TXPOS		;Tillbaka till TX
		LD	BC,0
		LD	(P2CPI),BC	;0 är invalid
		LD	(EP2CPI),BC
		CALL	CkWidth
		LD	A,(HL)
		LD	(P2CPI),A	;Tecken/tum
		LD	A,E
		LD	(P2CPL),A	;Tecken/rad
		CALL	FCEXPR		;Finns n3?
		RET	Z		;Nej
		PUSH	HL
		CALL	FCEXPR		;Finns n4?
		JP	Z,FCER31	;Nej, Operand missing
		EX	DE,HL
		POP	HL		;HL n1, DE n2
		CALL	CkWidth
		LD	A,(HL)
		LD	(EP2CPI),A	;Tecken/tum
		LD	A,E
		LD	(EP2CPL),A	;Tecken/rad
		XOR	A
		RET


; Kolla att n1 eller n3 duger
; IN:	 L	n1, n3
; UT:	 A	=L
;	HL	pekar på kod för vald CPI

CkWidth:	LD	A,L
		LD	HL,wtab
		CP	10		;10 CPI?
		RET	Z		;Ja
		INC	HL
		CP	12		;12 CPI?
		RET	Z		;Ja
		INC	HL
		CP	16		;16 CPI?
		RET	Z		;Ja
		JP	ERR8
wtab:		DB	'PM',15		;SI = 0F


; @WIDTH - sätt printer width
; IN:	HL	H CPL, L CPI

Width:		OR	HL		;Valid?
		RET	Z		;Nej
		BIT	BPRINT,(IX+$FOPT1);Printerlistning?
		RET	Z		;Nej
		EX	DE,HL
		LD	HL,SXFCB	;Behöver nåt i map 0
		LD	(HL),ESC
		INC	HL
		LD	(HL),E		;P, M eller SI
		INC	HL
		LD	(HL),0
		DEC	HL,2
		LD	A,D
		LD	(PCPL),A	;Tecken/rad
		SCAL	ZSPOOL		;Printer via spooler
		RET


; Ogiltig operand

PWERR8:		JP	ERR8


; @MSG - skriv ett meddelande
; IN:	Resten av raden kopierad till LINBUF

PMSG:		RES	BUPR,(IX+$FOUT)	;Skriv mot CRT
		Print	'Message: '
		LD	HL,LINBUF
pmsg1:		LD	A,(HL)		;Skicka ut meddelandet
		INC	HL
		CP	FF		;Formfeed?
		JR	Z,pmsg1		;Ja, förbi
		RST	ROUT
		CP	CR
		JR	NZ,pmsg1
		SET	BUPR,(IX+$FOUT)	;Till printern igen
		XOR	A
		RET
		CRC			;CRC
FCEND:		EQU	$
		FILE	ZAPFCWRK


+---------------------------------------------+
¦					      ¦
¦	-=­ ZAP ­=-			      ¦
¦					      ¦
¦	ZAP Z380 Macro Assembler	      ¦
¦	Equates och Workspace		      ¦
¦					      ¦
¦	Entry: ........... ZAPFCWRK.TX	      ¦
¦	Version: ......... -		      ¦
¦	Startad: ......... -		      ¦
¦	Senast ändrad: ... 89 11 04	      ¦
¦					      ¦
¦	Mikael Pontén			      ¦
¦	Pons Data			      ¦
¦					      ¦
+---------------------------------------------+


; Diverse equates

MAXMAC:		EQU	255	;Max antal makron
MAXPAR:		EQU	16	;Max antal parametrar
MBYTES:		EQU	MAXPAR	;Max i default och code


; Workspace

		ALIGN
		IF	WRK
SOWIDZ:		EQU	0	;Identitet workspace
		ENDC
LBPTR:		DS	2	;Pekar i rad att mata ut
IYINI:		DS	2	;IY i TX = 1a byte i LINBUF
IYFC:		DS	2	;Senaste IY i FCMAP
IYTX:		DS	2	;Senaste IY i TXMAP
OWNMAC:		DS	2	;Start egna makron
MACPTR:		DS	2	;Insättningspekare nästa makro
CURMAC:		DS	2	;Pekar på makrots datastruktur
MLIMIT:		DS	2	;Ledigt minne efter makroarean
PINDEX:		DS	1	;Wrk åt GENMAC
ÖSK:		DS	ÖSIZE	;Heading
TTLÖSK:		DS	ÖSIZE	;TTL överskrift
STLÖSK:		DS	ÖSIZE	;STL överskrift
XTLWRK:		DS	ÖSIZE	;Wrk åt OUTPUT
MCDRV:		DS	1	;Drive för MC
MCFCB:		DS	20	;FCB för MC
LINBUF:		DS	LBSIZE	;Radbuffer


; Byggarea för makrots datastruktur
; Dessa data kopieras till CURMAC av ENDM

MSTART:		DS	1	;Offset nästa macro, 0 om sista
MCTRL:		DS	1	;Flaggor för detta makro
MPCTR:		DS	1	;Antal parametrar på def.raden
MDPOS:		DS	2	;Vilka positioner är med där?
MDCODE:		DS	MBYTES*2;Defaultkoder (ord)
MOPS:		DS	1	;Antal operander i Data
MOFLG:		DS	2	;Operandflaggor; byte=0, word=1
MCODE:		DS	1	;Antal byte i Code
MCODES:		DS	MBYTES	;Operationskoder
		IF	WRK
MDUMMY:		EQU	$
		ENDC
MLEN$:		EQU	$-MSTART;Nästa makro (MEND = -1 på disk)
		ALIGN	256	;Jämn sektor
MNAMES:		EQU	$	;Makroarea
		IF	WRK
EOWIDZ:		EQU	0
		ENDC


; Bitar i MCTRL

BBYTES:		EQU	0	;Bytes i detta makro
BWORDS:		EQU	1	; words


; Beräknade FCB Equates; MCFCB

		REFS	SYSEQU
FNAM:		REF
FEXT:		REF
FSFL:		REF
FUFL:		REF
FSEC:		REF
FNSC:		REF
FLDA:		REF
FEXA:		REF
MCFNAM:		EQU	MCFCB+FNAM
MCFEXT:		EQU	MCFCB+FEXT
MCFSFL:		EQU	MCFCB+FSFL
MCFUFL:		EQU	MCFCB+FUFL
MCFSEC:		EQU	MCFCB+FSEC
MCFNSC:		EQU	MCFCB+FNSC
MCFLDA:		EQU	MCFCB+FLDA
MCFEXA:		EQU	MCFCB+FEXA
		END