.z80
		;****************************************
		;* Strukta Compiler   Version 1.4       *
		;* written in Strukta                   *
		;* by Rolf-Dieter Klein   1983 8.1.83   *
		;* Copyright  1983 (C)                  *
		;* 8000 Muenchen 40                     *
		;* Strassbergerstr. 34                  *
		;* West Germany                         *
		;* Tel (089) 3519416                    *
		;****************************************



	jp start 	;start of main program
		;jump also done by linker
		;if l80 is used


		; -constant declaration----------------------------------------

	seper  equ 21h 	;character for more cmds on one line
	seper1 equ 7ch 	;same as above may not apear in the program
		;neither as comment or string if not
		;a real seperator
	maxchar equ 256 	;max characters per line not greater than 256


		; --------------------------------------------------------------


	bdos equ 5 	;Bdos Start
		;
	true equ 1
	false equ 0

		; constants 
		; for the tables key,key1,sym1
		; must be in the same sequenze
		; three tables affected on change
		; symbols,tabcase and keyfield 
		; all must be in same order
		;
		; key
		;
	ifsymbol equ 0 	;
	elseifsymbol equ 1
	elsesymbol equ 2
	endifsymbol equ 3
	repeatsymbol equ 4
	untilsymbol equ 5
	whilesymbol equ 6
	endwhilesymbol equ 7
	loopsymbol equ 8
	endloopsymbol equ 9
	exitifsymbol equ 10
	exitsymbol equ 11
	dosymbol equ 12
	enddosymbol equ 13
	assembly equ 14
		;
		; key1
	zero equ 0
	carry equ 1
	pareven equ 2
	positive equ 3
	overflow equ 4
	nooverflow equ 5
	minus equ 6
	parodd equ 7
	nocarry equ 8
	nonzero equ 9
	nocond equ 10
		;

		; order of following symbols is important
		; key2
	bcreg equ 0
	dereg equ 1
	hlreg equ 2
	spreg equ 3
	ixreg equ 4
	iyreg equ 5
	areg equ 6 	;akku important
	breg equ 7
	creg equ 8
	dreg equ 9
	ereg equ 10
	hreg equ 11
	lreg equ 12
	noeg equ 13
		;

	bcpair equ bcreg+32
	depair equ dereg+32
	hlpair equ hlreg+32
	sppair equ spreg+32
	ixpair equ ixreg+32
	iypair equ iyreg+32
		;
	null equ 64 	;value of zero
	const equ 65 	;std constant
	name equ 66 	;name
	char equ 67 	;string with one element
	string equ 68 	;more characters
	syntax equ 69 	;nothing rec
		;




		; key 3
	odersym equ 0
	undsym equ 1
	notsym equ 2
	insym equ 3
	nokey3 equ 4



		; sym2
	jpaus equ 0
	jraus equ 1
	retaus equ 2
	callaus equ 3
		;
		; sym3
	notequal equ 0
	lessequal equ 1
	greatequal equ 2
	equal equ 3
	less equ 4
	greater equ 5
	nocomp equ 6

		;
		; makros
	prtstr macro text
	local marke,marke1
	ld iy,marke1
	call prt1str
	jr marke
marke1:
	defm text
	defb 0
marke:
	endm
		;

	error macro text
	local marke3,marke4
	push hl
	ld hl,marke3
	call errein
	pop hl
	jr marke4
marke3:
	defm text
	defb 0
marke4:
	endm


		;
echo::		;
	push hl  	;get one character from the Console
	push de  	;Device
	push bc
	ld c,1
	call bdos
	pop bc
	pop de
	pop hl
	ret  	;result in Akku

		;
co::		;put one Character to Console Device
	push hl  	;value is in register c
	push de  	;
	push bc
	ld e,c
	ld c,2  	;function co
	call bdos
	pop bc
	pop de
	pop hl
	ld a,c  	;akku=character
	ret
		;
lo::
	push hl
	push de
	push bc
	ld e,c
	ld c,5
	call bdos
	pop bc
	pop de
	pop hl
	ld a,c
	ret
		;

		; disksubprogramms
		;
open::		;open a file 
		;de -> fcb
	ld c,0fh 	;openfunction
	call bdos
	ret  	;a=code

make::		;create a file
	ld c,16h
	call bdos 	;de -> fcb
	ret


erase::		;delete file
	ld c,13h
	call bdos
	ret


close::
	ld c,10h 	;close
	call bdos 	;de -> fcb
	ret  	;a=code

		;
setdma::
	ld c,1ah 	;set dma adress
	call bdos 	;de = adress
	ret
		;

readsq::
	ld c,14h 	;read sequencial
	call bdos 	;de -> fcb
	ret

writesq::
	ld c,15h 	;write sequencial
	call bdos 	;de -> fcb
	ret


txter1::
	defm 'FILE NOT FOUND'
	defb 0dh,0ah,0

txter2::
	defm 'DIRECTORY FULL'
	defb 0dh,0ah,0
		;
txter3::
	defm 'DISK FULL'
	defb 0dh,0ah,0


		;
initflop::		;define buffers
		;clear 
		;both fcbs are valid
		;carry if error detected
	ld de,fcbread
	call open
;1 	if a=255
	CP 255
	JP NZ,.L1
	ld hl,txter1
	call print
	scf 
;2 	exit
	RET
;1 	endif
.L1:
	ld a,(iodest)
;1 	if a=1
	CP 1
	JP NZ,.L2
	ld de,fcbwrite
	call erase
	ld de,fcbwrite 	;create new one
	call make
;2 	if a=255 
	CP 255 
	JP NZ,.L3
	ld hl,txter2
	call print
	scf
;3 	exit
	RET
;2 	endif
.L3:
;1 	endif
.L2:
		; ok new one there
	ld hl,4096 	;to end
	ld (rbuflen),hl 	;undefined
	ld hl,0  	;empty
	ld (wbuflen),hl 	;
	ld hl,wbuf 	;clear buffers
	ld de,wbuf+1
	ld bc,4096-1
	ld (hl),1ah 	;CTRL Z
	ldir
	scf
	ccf
	ret

rdflop::		;get one char to akku
		;carry if eof
		;save all registers
	push hl
	push de
	push bc
	ld hl,(rbuflen) 	;if equal 4096 then empty
	ld de,4096
	xor a
	sbc hl,de
	ld a,l
	or h
;1 	if nz  	;not empty
	JP Z,.L4
	ld de,(rbuflen)
	ld hl,rbuf 	;start of buffer
	add hl,de
	ld a,(hl) 	;new value
	inc de
	ld (rbuflen),de 	;new length
;1 	else  	;empty first read all
	JP .L5
.L4:
		;new sektors
	ld hl,rbuf 	;clear to CTRL Z
	ld de,rbuf+1
	ld bc,4096-1
	ld (hl),1ah 	;clear
	ldir
	ld hl,rbuf
	ld d,32 	;count of sektors if possible to read
;2 	do d
.L6:
	push hl
	push de
	ex de,hl
	call setdma 	;to hl
	ld de,fcbread
	call readsq 	;also if a<>0 doesnt matter
	pop de
	pop hl
	ld bc,128
	add hl,bc
;2 	enddo
	DEC D
	JP NZ,.L6
	ld hl,1 	;first char readin
	ld (rbuflen),hl
	ld a,(rbuf) 	;
;1 	endif
.L5:
	pop bc
	pop de
	pop hl
	scf
	ccf
	ret


wrflop::		;put char c to flop
		;carry if error
	push hl  	;c = value
	push de
	push bc
	ld hl,(wbuflen) 	;look if space
	ld de,4096
	xor a
	sbc hl,de
	ld a,l
	or h
;1 	if a<>0  	;ok space
	OR A
	JP Z,.L7
	ld hl,wbuf
	ld de,(wbuflen)
	add hl,de
	ld (hl),c 	;write it
	inc de
	ld (wbuflen),de
;1 	else  	;write first
	JP .L8
.L7:
	push bc
	ld hl,wbuf
	ld d,32 	;all sectors
;2 	do d
.L9:
	push hl
	push de
	ex de,hl
	call setdma
	ld de,fcbwrite
	call writesq 	;a<>0 is error FATAL
	pop de
	pop hl
;3 	if a<>0
	OR A
	JP Z,.L10
	ld hl,txter3
	call print
	ld a,0
	ld (iodest),a 	;switch to console
	scf  	;leave it
;3 	endif
.L10:
	ld bc,128
	add hl,bc
;2 	enddo
	DEC D
	JP NZ,.L9
	ld hl,wbuf 	;clear it
	ld de,wbuf+1
	ld bc,4096-1
	ld (hl),1ah
	ldir
	pop bc  	;get char
	ld hl,1 	;one writen
	ld (wbuflen),hl
	ld a,c
	ld (wbuf),a 	;to first position CHARACTER
;1 	endif
.L8:
	pop bc
	pop de
	pop hl
	scf
	ccf
	ret

		;


terminate::		;end of sequenz write restbuffer
		;back and close files
	ld de,(wbuflen) 	;write back until 0
		;calculate number of sektors
	ld a,d
	or e
;1 	if nz  	;then anything there
	JP Z,.L11
	ld a,e
	rlca
	rl d  	;to d
	res 7,e 	;reset the msb
	ld a,d  	;get msb
	and 3fh 	;savety
	ld d,a  	;count of sektors
	ld a,e
;2 	if a<>0
	OR A
	JP Z,.L12
	inc d  	;number count exact
;2 	endif  	;d = 1..32
.L12:
	ld hl,wbuf 	;start adresse
;2 	do d  	;count of loop
.L13:
	push hl
	push de
	ex de,hl 	;de new dma
	call setdma
	ld de,fcbwrite    
	call writesq 	;and write it
	pop de
	pop hl
;3 	if a <> 0
	OR A
	JP Z,.L14
	ld hl,txter3
	call print
	scf 
;4 	exit  	;ERROR EXIT
	RET
;3 	endif
.L14:
	ld bc,128
	add hl,bc 	;next adress
;2 	enddo
	DEC D
	JP NZ,.L13
;1 	endif
.L11:
	ld de,fcbread
	call close
	ld de,fcbwrite
	call close 	;ok both are closed
	scf
	ccf
	ret


		;


getcha::		;get one character to akku
	ld a,(eof)
;1 	if a=1
	CP 1
	JP NZ,.L15
	ld a,1ah 	;stop if eof
;2 	exit
	RET
;1 	endif
.L15:
	ld a,(iosrc)
;1 	if a=0
	OR A
	JP NZ,.L16
	call echo 	;get from console
;2 	if a=0dh 	;echo a linefeed
	CP 0dh 
	JP NZ,.L17
	ld c,0ah
	call co
	ld a,0dh
;2 	endif
.L17:
;2 	if a=1ah
	CP 1ah
	JP NZ,.L18
	ld a,1
	ld (eof),a 	;set eof as marker
	ld a,1ah
	scf  	;stop carry = CTRL Z
;2 	else
	JP .L19
.L18:
	scf  	;no carry means ok s.o.
	ccf
;2 	endif
.L19:
;1 	else
	JP .L20
.L16:
		; floppy
	call rdflop 	;carry means error,ctlr z
;2 	if a=1ah
	CP 1ah
	JP NZ,.L21
	ld a,1
	ld (eof),a
	ld a,1ah 	;CTRL Z terminates all
;2 	endif
.L21:
;1 	endif
.L20:
	ret

putcha::
	ld a,(iodest)
;1 	if a=0 or a=2
	OR A
	JP Z,.L23
	CP 2
	JP NZ,.L22
.L23:
;2 	if c=9
	LD A,c
	CP 9
	JP NZ,.L24
	ld a,(tabcnt)
	ld c,a
	ld a,8
	sub c  	;8 - n (0..7)
	ld c,a
;3 	do c
.L25:
	push bc
	ld c,' '
	ld a,(iodest)
;4 	if a=0
	OR A
	JP NZ,.L26
	call co
;4 	else
	JP .L27
.L26:
	call lo
;4 	endif
.L27:
	pop bc
;3 	enddo  
	DEC C
	JP NZ,.L25
	ld a,0
	ld (tabcnt),a 	;restore
;2 	else
	JP .L28
.L24:
	push bc
	ld a,(iodest)
;3 	if a=0
	OR A
	JP NZ,.L29
	call co 	;to outputstream from reg c
;3 	else
	JP .L30
.L29:
	call lo
;3 	endif
.L30:
	pop bc
	ld a,(tabcnt)
	inc a
;3 	if a = 8 	;0..7
	CP  8 
	JP NZ,.L31
	ld a,0
;3 	endif
.L31:
	ld (tabcnt),a 	;0..7  0..7
;3 	if c = 0dh or c =0ah
	LD A,c
	CP  0dh 
	JP Z,.L33
	LD A,c
	CP 0ah
	JP NZ,.L32
.L33:
	xor a
	ld (tabcnt),a
;3 	endif
.L32:
;2 	endif
.L28:
	scf
	ccf  	;no carry means ok
;1 	else
	JP .L34
.L22:
		; floppy 
	call wrflop 	;including error exit
;1 	endif
.L34:
	ret
		;


print::		;output message to console
;1 	while (hl)<>0 	;termintor is \0
.L35:
	LD A,(hl)
	OR A
	JP Z,.L36
	ld c,(hl)
	call co
	inc hl
;1 	endwhile
	JP .L35
.L36:
	ret
		;

dezout::		;print hl in dezimal
	ld c,0  	;save flag on stack
	push bc  	;allways positive
;1 	repeat
.L37:
	ld a,0  	; hl := hl div 10
;2 	do b,16 	; a := hl mod 10
	LD b,16 
.L38:
	sla l
	rl h
	rl a
	cp 10  	; div 10
;3 	if nc
	JP C,.L39
	sub 10
	set 0,l
;3 	endif
.L39:
;2 	enddo
	DEC B
	JP NZ,.L38
	add a,'0'
	ld c,a
	push bc
;1 	until h=0 and l=0
	LD A,h
	OR A
	JP NZ,.L37
	LD A,l
	OR A
	JP NZ,.L37
	pop bc
;1 	while c<>0
.L40:
	LD A,c
	OR A
	JP Z,.L41
	call co 	;to console only
	pop bc
;1 	endwhile
	JP .L40
.L41:
	ret
		;

dezix::		;hl to (ix) in dezimal
		;terminate with 0
	ld c,0  	;save flag on stack
	push bc  	;allways positive
;1 	repeat
.L42:
	ld a,0  	; hl := hl div 10
;2 	do b,16 	; a := hl mod 10
	LD b,16 
.L43:
	sla l
	rl h
	rl a
	cp 10  	; div 10
;3 	if nc
	JP C,.L44
	sub 10
	set 0,l
;3 	endif
.L44:
;2 	enddo
	DEC B
	JP NZ,.L43
	add a,'0'
	ld c,a
	push bc
;1 	until h=0 and l=0
	LD A,h
	OR A
	JP NZ,.L42
	LD A,l
	OR A
	JP NZ,.L42
	pop bc
;1 	while c<>0
.L45:
	LD A,c
	OR A
	JP Z,.L46
	ld (ix+0),c
	inc ix
	pop bc
;1 	endwhile
	JP .L45
.L46:
	ld (ix+0),0
	ret
		;


getline::		;get one  line from the input stream
	ld hl,einzeile 	;point to start of the line
	ld b,0  	;char counter
;1 	repeat
.L47:
;2 	repeat
.L48:
	call getcha 	;carry = final
;2 	until c or a <> 0ah
	JP C,.L49
	CP  0ah
	JP Z,.L48
.L49:
;2 	if a <> 1ah 	;ctrl Z
	CP  1ah 
	JP Z,.L50
;3 	if a = 8 	;backspace
	CP  8 
	JP NZ,.L51
;4 	if b<>0
	LD A,b
	OR A
	JP Z,.L52
	dec hl 
	dec b
	push bc
	ld c,' '
	call co
	ld c,8
	call co
	pop bc
	ld a,' ' 	;dummy
;4 	endif
.L52:
;3 	else
	JP .L53
.L51:
;4 	if a = 0dh or a = seper or a=seper1 	;end of line
	CP  0dh 
	JP Z,.L55
	CP  seper 
	JP Z,.L55
	CP seper1 
	JP NZ,.L54
.L55:
	ld (hl),0 	;terminator
	ld c,0dh 	;end
;4 	else
	JP .L56
.L54:
;5 	if a < 32
	CP  32
	JP NC,.L57
	ld a,' '
;5 	endif
.L57:
	ld (hl),a
	ld c,a
	inc hl
	inc b
;4 	endif
.L56:
;3 	endif
.L53:
	scf
	ccf
;2 	else
	JP .L58
.L50:
	ld c,1ah 	;stop it
;2 	endif
.L58:
;1 	until c=1ah or c = 0dh or b=maxchar-2
	LD A,c
	CP 1ah 
	JP Z,.L59
	LD A,c
	CP  0dh 
	JP Z,.L59
	LD A,b
	CP maxchar-2
	JP NZ,.L47
.L59:
	ld (hl),0 	;savety
	ld hl,(inline)
	inc hl
	ld (inline),hl 	;
		;only if not console
	ld a,(iosrc)
;1 	if a<>0
	OR A
	JP Z,.L60
	ld a,l
	and 7fh 	;every 128 lines
;2 	if a=0
	OR A
	JP NZ,.L61
	ld c,'.'
	call co 	;show that it works every 128 lines
;2 	endif  	;lines
.L61:
;1 	endif
.L60:
	ret
		;

		;
putline::		;auszeile to output device
		;count global line-counter
		;check whether line is empty
		;if so then do not output
	push bc   	;save all
	push de 
	push hl   	;save hl is important
	ld hl,auszeile  	;start of line
	ld a,0
	ld (flagp),a  	;assume no char there
;1 	while (hl) <> 0
.L62:
	LD A,(hl)
	OR A
	JP Z,.L63
;2 	if not (hl) in [32,9]
	LD A,(hl)
	CP 32
	JP Z,.L64
	CP 9
	JP Z,.L64
	ld a,1
	ld (flagp),a
;2 	endif
.L64:
	inc hl
;1 	endwhile
	JP .L62
.L63:
	ld a,(flagp)  	;must be comment mode
	ld b,a   	;if comments or chars
	ld a,(comsw)  	;1=nocomments
;1 	if a=0 or b=1  	;ok line is valid
	OR A
	JP Z,.L66
	LD A,b
	CP 1  
	JP NZ,.L65
.L66:
	ld hl,(outline)
	inc hl
	ld (outline),hl
	ld hl,auszeile  	;output of the line
;2 	while (hl) <> 0 
.L67:
	LD A,(hl)
	OR A
	JP Z,.L68
	ld c,(hl)
	call putcha  	;print it
	inc hl
;2 	endwhile
	JP .L67
.L68:
	ld c,0dh
	call putcha
	ld c,0ah
	call putcha  	;and print crlf
;1 	endif
.L65:
	pop hl
	pop de
	pop bc
	ret
		;


toupper::		;convert to uppercase
;1 	if a in ['a'..'z']
	CP 'z'+1
	JR NC,.L71
	CP 'a'+0
	JP NC,.L70
.L71:
	JP .L69
.L70:
	sub 'a'
	add a,'A'
;1 	endif
.L69:
	ret
		;

	blank equ 0 	;state names
	z1 equ 1
	zb equ 2
	z2 equ 3
	z3 equ 4
	komm equ 5
		;


sepline::		;calculate values of labelx,instr,comment
	xor a
	ld (lenlab),a
	ld (lenins),a
	ld (lencom),a 	;all undefined
		;
	ld a,blank
	ld (state),a 	;set to first state
	ld hl,einzeile 	;pointer to einzeile
;1 	while (hl)<>0 	;as long as not empty
.L72:
	LD A,(hl)
	OR A
	JP Z,.L73
	ld c,(hl) 	;value of char hl=pointer
	ld a,(state)
;2 	if a = blank 
	CP  blank 
	JP NZ,.L74
;3 	if c = 3bh
	LD A,c
	CP  3bh
	JP NZ,.L75
	ld a,komm
	ld (state),a 	;set to comment state
	ld (comment),hl
	ld a,1
	ld (lencom),a
;3 	else
	JP .L76
.L75:
;4 	if c <> ' '
	LD A,c
	CP  ' '
	JP Z,.L77
	ld a,z1
	ld (state),a
	ld (instr),hl 	; set to first value
	ld a,1
	ld (lenins),a 	; one char valid
;4 	endif
.L77:
;3 	endif
.L76:
;2 	else
	JP .L78
.L74:
;3 	if a = z1
	CP  z1
	JP NZ,.L79
;4 	if c = 3bh
	LD A,c
	CP  3bh
	JP NZ,.L80
	ld a,komm
	ld (state),a
	ld (comment),hl
	ld a,1
	ld (lencom),a
;4 	else
	JP .L81
.L80:
	ld a,(lenins)
	inc a
	ld (lenins),a 	; next point valid
;5 	if c = ':'
	LD A,c
	CP  ':'
	JP NZ,.L82
	ld a,zb
	ld (state),a
	ld de,(instr)
	ld (labelx),de
	ld a,(lenins)
	ld (lenlab),a
	ld a,0
	ld (lenins),a 	;was label
;5 	else
	JP .L83
.L82:
;6 	if c=22h or c=27h 
	LD A,c
	CP 22h 
	JP Z,.L85
	LD A,c
	CP 27h 
	JP NZ,.L84
.L85:
	ld a,z2
	ld (state),a
;6 	else
	JP .L86
.L84:
;7 	if c=' ' 	;nach blanks keine labels
	LD A,c
	CP ' ' 
	JP NZ,.L87
	ld a,z3
	ld (state),a
;7 	endif
.L87:
;6 	endif
.L86:
;5 	endif
.L83:
;4 	endif
.L81:
;3 	else 
	JP .L88
.L79:
;4 	if a = zb
	CP  zb
	JP NZ,.L89
;5 	if c = 3bh
	LD A,c
	CP  3bh
	JP NZ,.L90
	ld a,komm
	ld (state),a
	ld (comment),hl
	ld a,1
	ld (lencom),a
;5 	else
	JP .L91
.L90:
;6 	if not c in [' ',':']
	LD A,c
	CP ' '
	JP Z,.L92
	CP ':'
	JP Z,.L92
	ld a,z3
	ld (state),a
	ld (instr),hl 	;start value
	ld a,1
	ld (lenins),a
;6 	else
	JP .L93
.L92:
;7 	if c = ':'
	LD A,c
	CP  ':'
	JP NZ,.L94
	ld a,(lenlab)
	inc a
	ld (lenlab),a
;7 	endif
.L94:
;6 	endif
.L93:
;5 	endif
.L91:
;4 	else
	JP .L95
.L89:
;5 	if a = z2
	CP  z2
	JP NZ,.L96
	ld a,(lenins)
	inc a
	ld (lenins),a
;6 	if c = 22h or c = 27h
	LD A,c
	CP  22h 
	JP Z,.L98
	LD A,c
	CP  27h
	JP NZ,.L97
.L98:
	ld a,z3
	ld (state),a
;6 	endif
.L97:
;5 	else
	JP .L99
.L96:
;6 	if a = z3
	CP  z3
	JP NZ,.L100
;7 	if c = 3bh 
	LD A,c
	CP  3bh 
	JP NZ,.L101
	ld a,komm
	ld (state),a
	ld (comment),hl
	ld a,1
	ld (lencom),a
;7 	else
	JP .L102
.L101:
	ld a,(lenins)
	inc a 
	ld (lenins),a
;8 	if c = 22h or c = 27h
	LD A,c
	CP  22h 
	JP Z,.L104
	LD A,c
	CP  27h
	JP NZ,.L103
.L104:
	ld a,z2
	ld (state),a
;8 	endif
.L103:
;7 	endif
.L102:
;6 	else
	JP .L105
.L100:
;7 	if a = komm
	CP  komm
	JP NZ,.L106
	ld a,(lencom)
	inc a
	ld (lencom),a
;7 	endif
.L106:
;6 	endif
.L105:
;5 	endif
.L99:
;4 	endif 
.L95:
;3 	endif
.L88:
;2 	endif
.L78:
	inc hl  	;next char
;1 	endwhile
	JP .L72
.L73:
		; transport to sourcelin
	ld hl,(instr)
	ld de,sourcelin
	ld a,(lenins)
	ld b,a
;1 	if b<>0
	LD A,b
	OR A
	JP Z,.L107
;2 	do b
.L108:
	ld a,(hl)
	ld (de),a
	inc hl
	inc de
;2 	enddo
	DEC B
	JP NZ,.L108
;1 	endif
.L107:
	xor a
	ld (de),a 	;mark end
	ret

trf::		;small transport
;1 	while b <> 0
.L109:
	LD A,b
	OR A
	JP Z,.L110
	ld a,(hl) 	;get source
	ld (ix+0),a
	inc hl
	inc ix
	dec b
;1 	endwhile
	JP .L109
.L110:
	ret
		;


toaus::		;fuer std ausgabe aufbereiten
		;output of labelx,instr,comment
		;to the string auszeile
	ld ix,auszeile 	;pointer to destination
	ld hl,(labelx)
	ld a,(lenlab) 	;if label
	ld b,a
	call trf
		;
toaus1::
	ld hl,(instr)
	ld a,(lenins)
	ld b,a
	ld a,(lencom)
;1 	if a<>0 or b<>0
	OR A
	JP NZ,.L112
	LD A,b
	OR A
	JP Z,.L111
.L112:
	ld (ix+0),9
	inc ix
;1 	endif
.L111:
	call trf
	ld hl,(comment)
	ld a,(comsw)
;1 	if a=0
	OR A
	JP NZ,.L113
	ld a,(lencom)
	ld b,a
;2 	if a<>0
	OR A
	JP Z,.L114
	ld (ix+0),9
	inc ix
;2 	endif
.L114:
	call trf 	;if nonzero
;1 	endif
.L113:
	ld (ix+0),0 	;terminator
	call putline
	ret

		;


getkey::		;ix -> key table
		;de -> start of text to be compared
		;c=counter of valid chars
		;scans until no alpha or digit
		;----
		;carry if no key found a=nmax+1
		;else a=n (0..n) of keynumber
		;de points to nextsymbol
		;if found else to start
	ld (de1sto),de
	ld (bc1sto),bc 	;save it
	call igbn 	;ignore and count
	push ix
	ld (desto),de 	;temp sto
	ld (bcsto),bc
	exx
	ld b,0  	;index counter
	exx
;1 	loop
	PUSH HL
	LD HL,.L115
	EX (SP),HL
.L116:
;2 	if (ix+0)=0 	;terminator search useless
	LD A,(ix+0)
	OR A
	JP NZ,.L117
	ld de,(de1sto) 	;get old one
	ld bc,(bc1sto) 	;get counter old one
	scf
;3 	exit
	RET
;2 	endif
.L117:
	ld a,(de)
	call toupper
;2 	if (ix+0)=a 	;if both equal then  suspect
	CP (ix+0)
	JP NZ,.L118
	ld a,(de)
	call toupper
	ld b,a
;3 	while (ix+0)=b and (ix+0)<>0 and b<>0
.L119:
	LD A,(ix+0)
	CP b
	JP NZ,.L120
	LD A,(ix+0)
	OR A
	JP Z,.L120
	LD A,b
	OR A
	JP Z,.L120
	inc ix
	inc de
	inc c 	;char counter
	ld a,(de)
	call toupper
	ld b,a
;3 	endwhile
	JP .L119
.L120:
;3 	if not b in ['a'..'z','A'..'Z','0'..'9']
	LD A,b
	CP 'z'+1
	JR NC,.L122
	CP 'a'+0
	JP NC,.L121
.L122:
	CP 'Z'+1
	JR NC,.L123
	CP 'A'+0
	JP NC,.L121
.L123:
	CP '9'+1
	JR NC,.L124
	CP '0'+0
	JP NC,.L121
.L124:
;4 	if (ix+0)=0
	LD A,(ix+0)
	OR A
	JP NZ,.L125
	scf
	ccf  	;ok key found de-> next
;5 	exit
	RET
;4 	endif
.L125:
;3 	endif
.L121:
	ld de,(desto) 	;get old pointer back
	ld bc,(bcsto) 	;old char counter
;2 	endif
.L118:
		; search next keyword
;2 	while (ix+0) <> 0
.L126:
	LD A,(ix+0)
	OR A
	JP Z,.L127
	inc ix
;2 	endwhile
	JP .L126
.L127:
	inc ix  	;to next keyword 
	exx
	inc b  	;next number
	exx
;1 	endloop
	JP .L116
.L115:
	pop ix
	exx
	ld a,b  	;number , de->nextsymbol
	exx
	ret

getsym::		;ix -> key table
		;de -> start of text to be compared
		;scans until found or 0 for spez symbols
		;order of keytab is important because
		;the first symbols are taken
		;----
		;carry if no key found a=nmax+1
		;else a=n (0..n) of keynumber
		;de points to nextsymbol
	ld (de1sto),de
	ld (bc1sto),bc 	;save it
	call igbn 	;ignore and count
	push ix
	ld (desto),de 	;temp sto
	ld (bcsto),bc
	exx
	ld b,0  	;index counter
	exx
;1 	loop
	PUSH HL
	LD HL,.L128
	EX (SP),HL
.L129:
;2 	if (ix+0)=0 	;terminator search useless
	LD A,(ix+0)
	OR A
	JP NZ,.L130
	ld de,(de1sto) 	;get old one
	ld bc,(bc1sto) 	;get counter old one
	scf
;3 	exit
	RET
;2 	endif
.L130:
	ld a,(de)
	call toupper
;2 	if (ix+0)=a 	;if both equal then  suspect
	CP (ix+0)
	JP NZ,.L131
	ld a,(de)
	call toupper
	ld b,a
;3 	while (ix+0)=b and (ix+0)<>0 and b<>0
.L132:
	LD A,(ix+0)
	CP b
	JP NZ,.L133
	LD A,(ix+0)
	OR A
	JP Z,.L133
	LD A,b
	OR A
	JP Z,.L133
	inc ix
	inc de
	inc c 	;char counter
	ld a,(de)
	call toupper
	ld b,a
;3 	endwhile
	JP .L132
.L133:
;3 	if (ix+0)=0
	LD A,(ix+0)
	OR A
	JP NZ,.L134
	scf
	ccf  	;ok key found de-> next
;4 	exit
	RET
;3 	endif
.L134:
	ld de,(desto) 	;get old pointer back
	ld bc,(bcsto) 	;old char counter
;2 	endif
.L131:
		; search next keyword
;2 	while (ix+0) <> 0
.L135:
	LD A,(ix+0)
	OR A
	JP Z,.L136
	inc ix
;2 	endwhile
	JP .L135
.L136:
	inc ix  	;to next keyword 
	exx
	inc b  	;next number
	exx
;1 	endloop
	JP .L129
.L128:
	pop ix
	exx
	ld a,b  	;number , de->nextsymbol
	exx
	ret


		; all string functions terminate the string with 0
		; but they do not inr ix so that the can be concatenated
		; easyly

		;
putlabel::		;ix -> destination hl = labelnr
	push bc
	push de
	push hl
	ld (ix+0),'.'
	inc ix
	ld (ix+0),'L'
	inc ix
	call dezix 	;dezimalnumber to ix ok term
	pop hl
	pop de
	pop bc
	ret  	;ix points to next free place

lblsgn::		;label marker '.Lnnnn:'
	ld (ix+0),':'
	inc ix
	ld (ix+0),0
	ret


		; used by makro
prt1str::		;iy -> string fixed
		;ix -> destination
;1 	while (iy+0) <> 0
.L137:
	LD A,(iy+0)
	OR A
	JP Z,.L138
	ld a,(iy+0)
	ld (ix+0),a
	inc ix
	inc iy
;1 	endwhile
	JP .L137
.L138:
	ld (ix+0),0
	ret

		;

prtind::		;ix -> ziel a=index iy -> keytabelle
	push bc
	ld b,a  	;range 0..n
;1 	loop
	PUSH HL
	LD HL,.L139
	EX (SP),HL
.L140:
;2 	exitif b=0 	;index found
	LD A,b
	OR A
	RET Z
;2 	while (iy+0)<>0
.L141:
	LD A,(iy+0)
	OR A
	JP Z,.L142
	inc iy
;2 	endwhile
	JP .L141
.L142:
	inc iy  	;next pos
;2 	exitif (iy+0)=0
	LD A,(iy+0)
	OR A
	RET Z
	dec b  	;count backwards
;1 	endloop
	JP .L140
.L139:
;1 	while (iy+0) <> 0
.L143:
	LD A,(iy+0)
	OR A
	JP Z,.L144
	ld a,(iy+0)
	ld (ix+0),a
	inc ix
	inc iy
;1 	endwhile
	JP .L143
.L144:
	pop bc
	ld (ix+0),0
	ret


prttab::		;set tab
	ld (ix+0),9
	inc ix
	ld (ix+0),0
	ret

prtchl::		;print c chars from (hl)
		;save all registers
		;without ix
		;print them to (ix)
		;if c umlimited then print 
		;till 0 in inputstream
	push hl
	push bc
;1 	while c <> 0 and (hl) <> 0
.L145:
	LD A,c
	OR A
	JP Z,.L146
	LD A,(hl)
	OR A
	JP Z,.L146
	ld a,(hl)
	ld (ix+0),a
	inc ix
	inc hl
	dec c
;1 	endwhile
	JP .L145
.L146:
	pop bc
	pop hl
	ld (ix+0),0 	;terminate string
	ret
		;

		;


		;

gencomment::		;set commentline hl=levelnumber
		;destination is auszeile
	ld hl,(level) 	;get level
	push hl
	ld ix,auszeile 	;pointer to destination
	ld hl,(labelx)
	ld a,(lenlab) 	;if label
	ld b,a
	call trf
	pop hl
	ld a,(comsw)
;1 	if a=0
	OR A
	JP NZ,.L147
	ld (ix+0),';' 	;new comment
	inc ix
	call dezix 	;output number
	ld (ix+0),' '
	inc ix
	call toaus1 	;rest std
;1 	else
	JP .L148
.L147:
	ld (ix+0),0 	;no comment
	call putline 	;
;1 	endif
.L148:
	ret
		;


		; scanner fuer assemblerausdruecke
		; scanner for assemby expressions
		;
		;
		; de -> points to start of text to be analysed
		; afterwards
		; de -> points to nextsymbol not in syntax
		; b = recogniced typ
		; c = count of read characters including blanks
		;


igbn::		;ignore blanks subprogram
	ld a,(de)
;1 	while a=' '
.L149:
	CP ' '
	JP NZ,.L150
	inc de
	inc c  	;also increment counter
	ld a,(de)
;1 	endwhile
	JP .L149
.L150:
	ret


scanass::		;scan assembly syntax restricted
	push ix
	ld c,0  	;0 characters read in
	call igbn 	;ignore leading blanks
	call scan1 	;processor for symbols
	pop ix  	;de points to next symbol b,c valid
	ret  	;b=code c=count of read in chars

scan1::		;sub utility
	ld b,syntax 	;assume syntax error
	ld a,(de) 	;get first symbol
;1 	if a=27h 	;was it a quote
	CP 27h 
	JP NZ,.L151
	inc de  	;ok start symbol
	inc c  	;one char
	ld a,(de)
;2 	if a=27h or a=2 	;error if again quot
	CP 27h 
	JP Z,.L153
	CP 2 
	JP NZ,.L152
.L153:
	ld b,syntax
;3 	exit
	RET
;2 	endif
.L152:
	inc de
	inc c
	ld b,char 	;seams to be char
	ld a,(de)
;2 	while a<>27h and a<>0 	;end char
.L154:
	CP 27h 
	JP Z,.L155
	OR A
	JP Z,.L155
	inc de
	inc c
	ld b,string 	;must be string
	ld a,(de)
;2 	endwhile
	JP .L154
.L155:
	inc de
	inc c  	;to next symbol
	call igbn 	;next symbol + or -
	ld a,(de)
;2 	if a in ['+','-']
	CP '+'
	JP Z,.L157
	CP '-'
	JP Z,.L157
	JP .L156
.L157:
	inc de
	inc c
	call scan1 	;RECURSIVE
;3 	if b in [null,const,name,char,string]
	LD A,b
	CP null
	JP Z,.L159
	CP const
	JP Z,.L159
	CP name
	JP Z,.L159
	CP char
	JP Z,.L159
	CP string
	JP Z,.L159
	JP .L158
.L159:
	ld b,const 	;always constant
;3 	else
	JP .L160
.L158:
	ld b,syntax 	;else is error
;3 	endif
.L160:
;2 	endif
.L156:
;1 	else
	JP .L161
.L151:
;2 	if a=22h 	;quote
	CP 22h 
	JP NZ,.L162
	inc de  	;ok start symbol
	inc c  	;one char
	ld a,(de)
;3 	if a=22h or a=2 	;error if again quot
	CP 22h 
	JP Z,.L164
	CP 2 
	JP NZ,.L163
.L164:
	ld b,syntax
;4 	exit
	RET
;3 	endif
.L163:
	inc de
	inc c
	ld b,char 	;seams to be char
	ld a,(de)
;3 	while a<>22h and a<>0 	;end char 
.L165:
	CP 22h 
	JP Z,.L166
	OR A
	JP Z,.L166
	inc de
	inc c
	ld b,string 	;must be string
	ld a,(de)
;3 	endwhile
	JP .L165
.L166:
	inc de
	inc c  	;to next symbol
	call igbn 	;next symbol + or -
	ld a,(de)
;3 	if a in ['+','-']
	CP '+'
	JP Z,.L168
	CP '-'
	JP Z,.L168
	JP .L167
.L168:
	inc de
	inc c
	call scan1 	;RECURSIVE
;4 	if b in [null,const,name,char,string]
	LD A,b
	CP null
	JP Z,.L170
	CP const
	JP Z,.L170
	CP name
	JP Z,.L170
	CP char
	JP Z,.L170
	CP string
	JP Z,.L170
	JP .L169
.L170:
	ld b,const 	;always constant
;4 	else
	JP .L171
.L169:
	ld b,syntax 	;else is error
;4 	endif
.L171:
;3 	endif
.L167:
;2 	else  	; check for simple register 
	JP .L172
.L162:
;3 	if a = '('
	CP  '('
	JP NZ,.L173
	inc de
	inc c
	ld ix,key2
	call getkey 	;check for register
;4 	if a in [ixreg,iyreg]
	CP ixreg
	JP Z,.L175
	CP iyreg
	JP Z,.L175
	JP .L174
.L175:
	add a,32
	ld b,a 	;save it
	call igbn
	ld a,(de)
;5 	if a = '+' 	; ok when + constant
	CP  '+' 
	JP NZ,.L176
	inc de
	inc c
	call igbn
	ld a,(de)
;6 	while a in ['0'..'9','a'..'z','A'..'Z','+','-']
.L177:
	CP '9'+1
	JR NC,.L180
	CP '0'+0
	JP NC,.L179
.L180:
	CP 'z'+1
	JR NC,.L181
	CP 'a'+0
	JP NC,.L179
.L181:
	CP 'Z'+1
	JR NC,.L182
	CP 'A'+0
	JP NC,.L179
.L182:
	CP '+'
	JP Z,.L179
	CP '-'
	JP Z,.L179
	JP .L178
.L179:
	inc de
	inc c
	ld a,(de)
;6 	endwhile
	JP .L177
.L178:
;5 	else
	JP .L183
.L176:
	ld b,syntax
;6 	exit 	;error cond
	RET
;5 	endif
.L183:
;4 	else
	JP .L184
.L174:
;5 	if a in [areg..lreg]
	CP lreg+1
	JR NC,.L187
	CP areg+0
	JP NC,.L186
.L187:
	JP .L185
.L186:
	ld b,syntax 	;not possible
;5 	else
	JP .L188
.L185:
	add a,32 	;must conform regspec
	ld b,a
;5 	endif
.L188:
;4 	endif
.L184:
	call igbn
	ld a,(de) 	;must be )
;4 	if a = ')'
	CP  ')'
	JP NZ,.L189
	inc de
	inc c
;4 	else
	JP .L190
.L189:
	ld b,syntax
;4 	endif
.L190:
;3 	else  	;simple register
	JP .L191
.L173:
	ld ix,key2 	;keywords register
	call getkey 	;de stays valid c count up 
;4 	if a = noeg
	CP  noeg
	JP NZ,.L192
		; must be constant de-> start without blanks
	ld a,(de)
;5 	if a in ['0'..'9']
	CP '9'+1
	JR NC,.L195
	CP '0'+0
	JP NC,.L194
.L195:
	JP .L193
.L194:
		; is number check whether zero
	ld a,0
	ld (flag),a 	;assume zero
	ld a,(de)
;6 	while a in ['0'..'9','A'..'F','a'..'f','h','H','O','o','B','b']
.L196:
	CP '9'+1
	JR NC,.L199
	CP '0'+0
	JP NC,.L198
.L199:
	CP 'F'+1
	JR NC,.L200
	CP 'A'+0
	JP NC,.L198
.L200:
	CP 'f'+1
	JR NC,.L201
	CP 'a'+0
	JP NC,.L198
.L201:
	CP 'h'
	JP Z,.L198
	CP 'H'
	JP Z,.L198
	CP 'O'
	JP Z,.L198
	CP 'o'
	JP Z,.L198
	CP 'B'
	JP Z,.L198
	CP 'b'
	JP Z,.L198
	JP .L197
.L198:
;7 	if not a in ['H','h','O','o','0']
	CP 'H'
	JP Z,.L202
	CP 'h'
	JP Z,.L202
	CP 'O'
	JP Z,.L202
	CP 'o'
	JP Z,.L202
	CP '0'
	JP Z,.L202
	ld a,1 	;binary bB 0b is not zero
	ld (flag),a
;7 	endif
.L202:
	inc de
	inc c
	ld a,(de)
;6 	endwhile
	JP .L196
.L197:
	ld a,(flag)
;6 	if a=0
	OR A
	JP NZ,.L203
	ld b,null
;6 	else
	JP .L204
.L203:
	ld b,const 
;6 	endif
.L204:
	call igbn 	;next symbol + or -
	ld a,(de)
;6 	if a in ['+','-']
	CP '+'
	JP Z,.L206
	CP '-'
	JP Z,.L206
	JP .L205
.L206:
	inc de
	inc c
	call scan1 	;RECURSIVE
;7 	if b in [null,const,name,char,string]
	LD A,b
	CP null
	JP Z,.L208
	CP const
	JP Z,.L208
	CP name
	JP Z,.L208
	CP char
	JP Z,.L208
	CP string
	JP Z,.L208
	JP .L207
.L208:
	ld b,const 	;always constant
;7 	else
	JP .L209
.L207:
	ld b,syntax 	;else is error
;7 	endif
.L209:
;6 	endif
.L205:
;5 	else 	; is name    
	JP .L210
.L193:
	ld a,(de)
;6 	if a in ['0'..'9','a'..'z','A'..'Z']
	CP '9'+1
	JR NC,.L213
	CP '0'+0
	JP NC,.L212
.L213:
	CP 'z'+1
	JR NC,.L214
	CP 'a'+0
	JP NC,.L212
.L214:
	CP 'Z'+1
	JR NC,.L215
	CP 'A'+0
	JP NC,.L212
.L215:
	JP .L211
.L212:
;7 	while a in ['0'..'9','a'..'z','A'..'Z']
.L216:
	CP '9'+1
	JR NC,.L219
	CP '0'+0
	JP NC,.L218
.L219:
	CP 'z'+1
	JR NC,.L220
	CP 'a'+0
	JP NC,.L218
.L220:
	CP 'Z'+1
	JR NC,.L221
	CP 'A'+0
	JP NC,.L218
.L221:
	JP .L217
.L218:
	inc de
	inc c
	ld a,(de)
;7 	endwhile
	JP .L216
.L217:
	ld b,name 	;is a name
	call igbn
	ld a,(de)
;7 	if a in ['+','-']
	CP '+'
	JP Z,.L223
	CP '-'
	JP Z,.L223
	JP .L222
.L223:
	inc de
	inc c
	call scan1 	;recursive
;8 	if b in [null,const,name,char,string]
	LD A,b
	CP null
	JP Z,.L225
	CP const
	JP Z,.L225
	CP name
	JP Z,.L225
	CP char
	JP Z,.L225
	CP string
	JP Z,.L225
	JP .L224
.L225:
	ld b,const
;8 	else  	;register etc
	JP .L226
.L224:
	ld b,syntax
;8 	endif
.L226:
;7 	endif
.L222:
;6 	endif 	;no name because blanks only
.L211:
;5 	endif
.L210:
;4 	else  	;must be single register
	JP .L227
.L192:
	ld b,a 	;save code all valid, register
;4 	endif
.L227:
;3 	endif
.L191:
;2 	endif
.L172:
;1 	endif
.L161:
		; ok final b is valid
	ret



reverse::		;a=code of condition
		;result is complementary condition
	push bc  	;preserve all registers
	push hl
	ld c,a  	;save for compare
	ld hl,tabrev
;1 	loop
	PUSH HL
	LD HL,.L228
	EX (SP),HL
.L229:
;2 	exitif (hl)=0ffh 	;end of table
	LD A,(hl)
	CP 0ffh 
	RET Z
;2 	if (hl)=c
	LD A,(hl)
	CP c
	JP NZ,.L230
	inc hl
	ld a,(hl)
;3 	exit
	RET
;2 	endif
.L230:
	inc hl  	;by two
	inc hl
;1 	endloop
	JP .L229
.L228:
	pop hl
	pop bc
	ret


tabrev::
	defb zero,nonzero
	defb carry,nocarry
	defb pareven,parodd
	defb positive,minus
	defb overflow,nooverflow
	defb nooverflow,overflow
	defb minus,positive
	defb parodd,pareven
	defb nocarry,carry
	defb nonzero,zero
	defb nocond,nocond
	defb 0ffh,0ffh 	;terminator

		;
		; LABEL GENERATOR
		;

newlabel::		;get next label to hl
	ld hl,(labelnr)
	inc hl
	ld (labelnr),hl
	ret



gencode::		;main sub codegenerator
		;for small conditions  
		;a = tf true = 1 false = 0
		;b = type of jump sym2
		;c = type of condition key1
		;hl = labelnumber
;1 	if a=false 	;if false jump then reverse
	CP false 
	JP NZ,.L231
	ld a,c
	call reverse
	ld c,a  	;restore value
;1 	endif
.L231:
;1 	if c in [overflow,nooverflow]
	LD A,c
	CP overflow
	JP Z,.L233
	CP nooverflow
	JP Z,.L233
	JP .L232
.L233:
;2 	if b = retaus
	LD A,b
	CP  retaus
	JP NZ,.L234
;3 	if c = overflow
	LD A,c
	CP  overflow
	JP NZ,.L235
	ld ix,auszeile
	call prttab
	prtstr 'JR Z,'
	call newlabel 	;loose old label
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'RET NC'
	call putline
	ld ix,auszeile
	call putlabel 	;jump there
	call lblsgn
	call putline
;3 	else
	JP .L236
.L235:
	ld ix,auszeile
	call prttab
	prtstr 'RET Z'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'RET C'
	call putline
;3 	endif
.L236:
;2 	else { normal jumps }
	JP .L237
.L234:
;3 	if c = overflow
	LD A,c
	CP  overflow
	JP NZ,.L238
	ld ix,auszeile
	call prttab
	prtstr 'JR Z,'
	push hl  	;save jump to label
	call newlabel 	;gen new one
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'JP NC,'
	ex (sp),hl  	;get old one
	call putlabel
	call putline
	pop hl  	;get new label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline  	;jump there
;3 	else
	JP .L239
.L238:
	ld ix,auszeile
	call prttab
	prtstr 'JP Z,'
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'JP C,'
	call putlabel
	call putline
;3 	endif
.L239:
;2 	endif
.L237:
;1 	else
	JP .L240
.L232:
;2 	if b = retaus
	LD A,b
	CP  retaus
	JP NZ,.L241
;3 	if c = nocond
	LD A,c
	CP  nocond
	JP NZ,.L242
	ld ix,auszeile
	call prttab
	ld iy,sym2
	ld a,retaus
	call prtind
	call putline
;3 	else
	JP .L243
.L242:
	ld ix,auszeile
	call prttab
	ld iy,sym2
	ld a,retaus
	call prtind
	ld a,c 	;key1 as index
	ld iy,key1 	;
	call prtind
	call putline
;3 	endif
.L243:
;2 	else
	JP .L244
.L241:
;3 	if c = nocond
	LD A,c
	CP  nocond
	JP NZ,.L245
	ld ix,auszeile
	call prttab
	ld iy,sym2
	ld a,b 	;type of jump
	call prtind
	call putlabel 	;hl is nr
	call putline
;3 	else
	JP .L246
.L245:
	ld ix,auszeile
	call prttab
	ld iy,sym2
	ld a,b
	call prtind
	ld iy,key1 	;cond
	ld a,c
	call prtind
	ld (ix+0),','
	inc ix
	call putlabel
	call putline
;3 	endif
.L246:
;2 	endif
.L244:
;1 	endif
.L240:
	ret

		; code generator
gencond::		;a=true,false
		;b=jump type main
		;hl = label
		;de = pointer to source


	call genexpr
	ret


		; parser for syntax check and preview
		; only de is valid, pointer to next symbol
		; afterwards points to next symbol not in syntax
		; REST DESTROYED
parseexpr::
	call parseterm
	ld ix,key3 	;and or in check
	push de 	;save adress if not odersymbol
	call getkey
;1 	while a = odersym
.L247:
	CP  odersym
	JP NZ,.L248
	call parseterm
	pop bc 	;remove old de
	push de 	;save new de
	ld ix,key3
	call getkey
;1 	endwhile  
	JP .L247
.L248:
	pop de  	;not odersym
	ret

parseterm::
	call parsefaktor
	ld ix,key3
	push de 	;save old one
	call getkey
;1 	while a = undsym
.L249:
	CP  undsym
	JP NZ,.L250
	call parsefaktor
	pop bc 	;can be removed
	push de 	;new one
	ld ix,key3
	call getkey
;1 	endwhile
	JP .L249
.L250:
	pop de  	;get valid one
	ret

parsefaktor::
	push de
	ld ix,key3
	call getkey
;1 	if a = notsym
	CP  notsym
	JP NZ,.L251
	pop bc 	;throw away
	call parsefaktor
;2 	exit  	;with new de
	RET
;1 	endif
.L251:
	pop de
	call igbn
	ld a,(de)
;1 	if a = '['
	CP  '['
	JP NZ,.L252
	inc de
	call parseexpr
	call igbn
	ld a,(de)
;2 	if a = ']'
	CP  ']'
	JP NZ,.L253
	inc de
;3 	exit  	;ok s.o.
	RET
;2 	endif
.L253:
;2 	exit  	;SYNTAX ERROR
	RET
;1 	endif
.L252:
		; de valid points to first symbol
	call scanass 	;must be assembly
		;
	push de 	;can be in or comparison
	ld ix,sym3
	call getsym 	;scan for symbol
;1 	if a = nocomp 	;must be in
	CP  nocomp 
	JP NZ,.L254
	pop de 	;get old pointer
	push de
	ld ix,key3 	;scan for in
	call getkey
;2 	if a = insym
	CP  insym
	JP NZ,.L255
	pop bc 	;de is valid
	call igbn 	;check [ .. ]
	ld a,(de)
;3 	if a = '['
	CP  '['
	JP NZ,.L256
	inc de 	;to next
;4 	loop
	PUSH HL
	LD HL,.L257
	EX (SP),HL
.L258:
	call scanass 	;first is assembly
;5 	exitif b = syntax 	;syntaxfehler ist terminator
	LD A,b
	CP  syntax 
	RET Z
	call igbn
	ld a,(de)
;5 	if a = ','
	CP  ','
	JP NZ,.L259
	inc de
;5 	else
	JP .L260
.L259:
;6 	if a = '.'
	CP  '.'
	JP NZ,.L261
	inc de
	ld a,(de)
;7 	if a = '.'
	CP  '.'
	JP NZ,.L262
	inc de
;7 	endif
.L262:
;6 	endif
.L261:
;5 	endif
.L260:
	call igbn
	ld a,(de)  	;next symbol
;5 	exitif a=']' or a = 0
	CP ']' 
	RET Z
	OR A
	RET Z
;4 	endloop
	JP .L258
.L257:
;4 	if a = ']'
	CP  ']'
	JP NZ,.L263
	inc de  	;ok to next symbol
;4 	endif
.L263:
;3 	else
	JP .L264
.L256:
	nop  	;SYNTAX ERROR
;3 	endif
.L264:
;2 	else
	JP .L265
.L255:
	pop de 	;old pointer SYNTAX ERROR
;2 	endif  
.L265:
;1 	else  	;is condition
	JP .L266
.L254:
	pop bc 	;de is ok
	call scanass 	;to end
;1 	endif
.L266:
	ret



genexpr::
		;b = jmptype
		;de = pointer
		;hl = label
	push af
	push bc
	push de  	;start pointer
	push hl
	call parseterm 	;get de to nextsymbol
	ld ix,key3
	call getkey
;1 	if a = odersym
	CP  odersym
	JP NZ,.L267
	pop hl   	;label
	pop de 
	pop bc   	;b=jmptyp
	pop af   	;generate code for first op
;2 	if a = true  	;true at or
	CP  true  
	JP NZ,.L268
;3 	repeat
.L269:
	push hl
	push bc  	;main parameter   
	ld a,true
	call genterm  	;de must be valid afterwards
	push de  	;save
	ld ix,key3
	call getkey
;4 	if a = odersym  	;a remains
	CP  odersym  
	JP NZ,.L270
	pop bc  	;discard
;4 	else
	JP .L271
.L270:
	pop de  	;else get old one
;4 	endif
.L271:
	pop bc
	pop hl  	;main parameter
;3 	until a <> odersym
	CP  odersym
	JP Z,.L269
;2 	else   	;false at or
	JP .L272
.L268:
	push hl  	;save old label
	call newlabel  	;get a new one
;3 	loop
	PUSH HL
	LD HL,.L273
	EX (SP),HL
.L274:
	push hl
	push de
	push bc
	call parseterm 	;search next symbol
	ld ix,key3
	call getkey  	;test if and symbol
	pop bc
	pop de
	pop hl
;4 	exitif a <> odersym
	CP  odersym
	RET NZ
	push hl
	push bc
	ld a,true
	ld b,jpaus  	;must be jump
	call genterm  	;generate term
	ld ix,key3
	call getkey  	;must be ok
;4 	if a <> odersym
	CP  odersym
	JP Z,.L275
	error 'SYSTEM ERROR IN EXPR'
;4 	endif
.L275:
	pop bc
	pop hl
;3 	endloop
	JP .L274
.L273:
	ex (sp),hl  	;exchange labels
	ld a,false  	;hl,de,b valid
	call genterm
	pop hl  	;get old label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
;2 	endif
.L272:
;1 	else
	JP .L276
.L267:
	pop hl
	pop de
	pop bc
	pop af
	call genterm
;1 	endif
.L276:
	ret

genterm::		;a = flag
		;b = jmptype
		;de = pointer
		;hl = label
	push af
	push bc
	push de  	;start pointer
	push hl
	call parsefaktor 	;get de to nextsymbol
	ld ix,key3
	call getkey
;1 	if a = undsym
	CP  undsym
	JP NZ,.L277
	pop hl   	;label
	pop de 
	pop bc   	;b=jmptyp
	pop af   	;generate code for first op
;2 	if a = false  	;false at and
	CP  false  
	JP NZ,.L278
;3 	repeat
.L279:
	push hl
	push bc  	;main parameter   
	ld a,false
	call genfaktor 	;de must be valid afterwards
	push de  	;save
	ld ix,key3
	call getkey
;4 	if a = undsym 	;a remains
	CP  undsym 
	JP NZ,.L280
	pop bc  	;discard
;4 	else
	JP .L281
.L280:
	pop de  	;else get old one
;4 	endif
.L281:
	pop bc
	pop hl  	;main parameter
;3 	until a <> undsym
	CP  undsym
	JP Z,.L279
;2 	else   	;true at and
	JP .L282
.L278:
	push hl  	;save old label
	call newlabel  	;get a new one
;3 	loop
	PUSH HL
	LD HL,.L283
	EX (SP),HL
.L284:
	push hl
	push de
	push bc
	call parsefaktor 	;search next symbol
	ld ix,key3
	call getkey  	;test if or symbol
	pop bc
	pop de
	pop hl
;4 	exitif a <> undsym
	CP  undsym
	RET NZ
	push hl
	push bc
	ld a,false
	ld b,jpaus  	;must be jump
	call genfaktor 	;generate faktor
	ld ix,key3
	call getkey  	;must be ok
;4 	if a <> undsym
	CP  undsym
	JP Z,.L285
	error 'SYSTEM ERROR IN TERM'
;4 	endif
.L285:
	pop bc
	pop hl
;3 	endloop
	JP .L284
.L283:
	ex (sp),hl  	;exchange labels
	ld a,true  	;hl,de,b valid
	call genfaktor
	pop hl  	;get old label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
;2 	endif
.L282:
;1 	else
	JP .L286
.L277:
	pop hl
	pop de
	pop bc
	pop af
	call genfaktor
;1 	endif
.L286:
	ret

genfaktor::		;a=tf true,false
		;b=jump type 
		;de=start of text
		;hl=labelnr

	push af
	push bc
	call igbn  	;ignore blanks
	pop bc   	;new de
	pop af   	;de,hl still valid
		;
	push af
	push bc   	;now test for not symbol
	push de   	;save start
	ld ix,key3  	;scan for not
	call getkey
;1 	if a=notsym
	CP notsym
	JP NZ,.L287
	pop bc   	;remove old de
	pop bc
	pop af   	;true flag
;2 	if a=true
	CP true
	JP NZ,.L288
	ld a,false
;2 	else
	JP .L289
.L288:
	ld a,true
;2 	endif
.L289:
	call genfaktor  	;RECURSIVE CALL NOT NOT NOT ...
;2 	exit   	;leave procedure genfaktor
	RET
;1 	else
	JP .L290
.L287:
	pop de   	;get old pointer
	pop bc
	pop af
;1 	endif
.L290:
		;
		;
	push af
	push bc
	push de   	;save for [ test
	call igbn
	ld a,(de)
;1 	if a = '['
	CP  '['
	JP NZ,.L291
	inc de   	;point to next symbol
	pop bc   	;throw away
	pop bc
	pop af   	;all must be valid
	call genexpr  	;RECURSIVE CALL
	call igbn  	;test ]
	ld a,(de)
;2 	if a = ']'
	CP  ']'
	JP NZ,.L292
	inc de
;3 	exit   	;FINAL OK s.o POINT TO NEXT
	RET
;2 	else
	JP .L293
.L292:
	error 'ERROR  ] MISSING'
;3 	exit
	RET
;2 	endif
.L293:
;1 	else
	JP .L294
.L291:
	pop de
	pop bc
	pop af
;1 	endif
.L294:

		;
		; test whether in, condition or single 
		; kontextsensive part
	push af   	;save flag
	push bc   	;save jumptype
	push de   	;start pointer
	call scanass  	;now try to get symbol afterwards
		;de points there
	push de   	;save second
	ld ix,sym3
	call getsym  	;scan symbol no terminator
		;now akku valid
;1 	if a=nocomp
	CP nocomp
	JP NZ,.L295
		;no comparision
		;check whether IN symbol is there
	pop de   	;get prev one
	ld ix,key3
	call getkey  	;normal keyword
;2 	if a=insym
	CP insym
	JP NZ,.L296
	pop de
	pop bc
	pop af  	;old one values
	call genin  	;generate code for in
;2 	else
	JP .L297
.L296:
		; must be single consition
	pop de  	;pointer to start
	ld ix,key1  	;condition key
	call getkey  	;akku is keyword
;3 	if a=nocond
	CP nocond
	JP NZ,.L298
	error 'ERROR WRONG EXPRESSION'
	pop bc
	pop af  	;clean stack
;3 	else
	JP .L299
.L298:
	pop bc
	ld c,a  	;b=type c=cond
	pop af  	;a=true,false
	call gencode  	;de,hl valid
;3 	endif
.L299:
;2 	endif
.L297:
;1 	else
	JP .L300
.L295:
		;must be comparision
	pop de  	;throw away
	pop de
	pop bc 
	pop af 	;start analyse
	call genvergleich
;1 	endif
.L300:
	ret


genin::		; nn in [   ]
		; de -> start
	ld (gentrue),a  	; flag old
	ld a,b
	ld (genjmp),a
	ld (gen1labl),hl 	;save all parameters
		; de points to start
	ld (genw),de  	;save start of de
	call scanass  	;c=count b=code
		;
;1 	if b <> areg  	;must load register
	LD A,b
	CP  areg  
	JP Z,.L301
	push de  	;c=count
	push bc
	ld ix,auszeile
	call prttab
	prtstr 'LD A,'
	pop bc
	ld hl,(genw)  	;start of text
	call prtchl
	call putline
	pop de
;1 	endif
.L301:
		; de points to IN
	ld ix,key3
	call getkey
;1 	if a <> insym
	CP  insym
	JP Z,.L302
	error 'ERROR   SYNTAX'
;2 	exit
	RET
;1 	endif
.L302:
		; de points to rest of string
	call igbn
		; symbol must be [
	ld a,(gentrue)
;1 	if a = false
	CP  false
	JP NZ,.L303
	call newlabel 	;get new label
	push hl
	ld hl,(gen1labl)
	ld (gen2labl),hl
	pop hl
	ld (gen1labl),hl 	;is temp label
;1 	endif
.L303:
	ld a,(de)
;1 	if a='['
	CP '['
	JP NZ,.L304
	inc de   	;next symbol
	ld a,false
	ld (final),a  	;flag for final exec
;2 	repeat   	;de must be valid
.L305:
	ld (op1w),de
	call scanass  	;scan inputline
	ld a,c
	ld (op1len),a  	;save length of first op
;3 	if b <> syntax
	LD A,b
	CP  syntax
	JP Z,.L306
	call igbn
	ld a,(de)  	;terminator
;4 	if a in [2ch,5dh] 	; ',' ']'
	CP 2ch
	JP Z,.L308
	CP 5dh
	JP Z,.L308
	JP .L307
.L308:
;5 	if a=5dh
	CP 5dh
	JP NZ,.L309
	ld a,true  	;last expression
	ld (final),a
;5 	endif
.L309:
	inc de  	;point to next 
	push de  	;save pointer
	ld a,(gentrue) 	;check if true
;5 	if a=true
	CP true
	JP NZ,.L310
		; must use genjmp  
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline 	;now generate jump
	ld hl,(gen1labl)
	ld a,(genjmp)
	ld b,a
	ld a,zero
	ld c,a
	ld a,true  	;true jump 
	call gencode
;5 	else
	JP .L311
.L310:
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'JP Z,'
	ld hl,(gen1labl)
	call putlabel
	call putline
;5 	endif
.L311:
	pop de  	;get old pointer
;4 	else
	JP .L312
.L307:
;5 	if a=2eh  	; '.'
	CP 2eh  
	JP NZ,.L313
	inc de  	;next must be dot
	ld a,(de)
;6 	if a=2eh  	;then ok
	CP 2eh  
	JP NZ,.L314
	inc de  	;to next char
	call igbn
	ld (op2w),de 	;save pointer second operand
	call scanass 	;get next de
	ld a,c
	ld (op2len),a
;7 	if b <> syntax
	LD A,b
	CP  syntax
	JP Z,.L315
	call igbn
	ld a,(de)
;8 	if a in [2ch,5dh]
	CP 2ch
	JP Z,.L317
	CP 5dh
	JP Z,.L317
	JP .L316
.L317:
;9 	if a = 5dh
	CP  5dh
	JP NZ,.L318
	ld a,true
	ld (final),a
;9 	endif       
.L318:
	inc de  	;point to next symbol
	push de  	;save pointer
	ld a,(gentrue)
;9 	if a = true
	CP  true
	JP NZ,.L319
		; generate direct code
		; use temp label for skip
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	prtstr '+1'
	call putline
	call newlabel 	;save label         
	push hl
	ld ix,auszeile
	call prttab
	prtstr 'JR NC,'
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	prtstr '+0' 	;savety
	call putline
	ld hl,(gen1labl)
	ld a,(genjmp)
	ld b,a
	ld c,nocarry
	ld a,true
	call gencode
	pop hl  	;get old label VALID
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
;9 	else
	JP .L320
.L319:
		; false generate
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	prtstr '+1'
	call putline
	call newlabel 	;skip label
	push hl
	ld ix,auszeile
	call prttab
	prtstr 'JR NC,'
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	prtstr '+0'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'JP NC,'
	ld hl,(gen1labl)
	call putlabel
	call putline
	pop hl  	;get old label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
;9 	endif
.L320:
	pop de  	;restore old pointer
;8 	else  	;error in terminator
	JP .L321
.L316:
	error 'ERROR IN TERMINATOR'
	ld a,true
	ld (final),a
;8 	endif
.L321:
;7 	else
	JP .L322
.L315:
	ld a,true
	ld (final),a
	error 'ERROR IN PARAMETER'
;7 	endif
.L322:
;6 	else
	JP .L323
.L314:
	ld a,true
	ld (final),a
	error 'ERROR IN PARAMETER'
;6 	endif
.L323:
;5 	else
	JP .L324
.L313:
	ld a,true
	ld (final),a
	error 'ERROR IN PARAMETER'
;5 	endif
.L324:
;4 	endif
.L312:
;3 	else
	JP .L325
.L306:
	error 'ERROR  IN PARAMETER'
	ld a,true
	ld (final),a
;3 	endif
.L325:
	ld a,(final)
;2 	until a=true  	;until end encountered
	CP true  
	JP NZ,.L305
	ld a,(gentrue)
;2 	if a = false
	CP  false
	JP NZ,.L326
	ld hl,(gen2labl) 	;skip to this label
	ld a,(genjmp)
	ld b,a
	ld c,nocond  	;unconditional
	ld a,true
	call gencode  	;ret,or jumps
	ld ix,auszeile
	ld hl,(gen1labl)
	call putlabel
	call lblsgn
	call putline
;2 	endif
.L326:
;1 	else
	JP .L327
.L304:
	error 'ERROR MISSING ['
;1 	endif
.L327:
	ret


genvergleich::
	ld (optrue),a 	;save it  nonrecursive
	ld a,b
	ld (opjmp),a 	;save jump type
	ld (oplabl),hl 	;jump to label
		;de points to start of text
		; seperate operands
	ld (op1w),de 	;first operand
	call scanass 	;get length
	ld a,c  	;length
	ld (op1len),a 	;
	ld a,b
	ld (op1reg),a 	;register type first operand
		; get keyword middle
	ld ix,sym3
	call getsym 	;scan symbol condition
		;de points to next start
	ld (opvgl),a 	;save comparison
	ld (op2w),de
	call scanass 	;get length and type
	ld a,c
	ld (op2len),a
	ld a,b
	ld (op2reg),a 	;type of operand
		;
		; de is valid NOW
		; now test cases for comparison
	ld a,(opvgl)
;1 	if a in [notequal,equal]
	CP notequal
	JP Z,.L329
	CP equal
	JP Z,.L329
	JP .L328
.L329:
;2 	if a = equal
	CP  equal
	JP NZ,.L330
	ld a,zero
;2 	else
	JP .L331
.L330:
	ld a,nonzero
;2 	endif
.L331:
	ld (opid1),a 	;jump type
	ld a,(op1reg) 	;test first operand
;2 	if a = areg
	CP  areg
	JP NZ,.L332
	ld a,(op2reg)
;3 	if a = null
	CP  null
	JP NZ,.L333
	ld ix,auszeile   
	call prttab
	prtstr 'OR A'
	call putline
;3 	else 
	JP .L334
.L333:
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	call putline
;3 	endif
.L334:
;2 	else
	JP .L335
.L332:
	ld a,(op2reg)
;3 	if a = areg 	;second operand is akku
	CP  areg 
	JP NZ,.L336
	ld a,(op1reg)
;4 	if a = null
	CP  null
	JP NZ,.L337
	ld ix,auszeile
	call prttab
	prtstr 'OR A'
	call putline
;4 	else
	JP .L338
.L337:
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline
;4 	endif
.L338:
;3 	else  	;both are not akku
	JP .L339
.L336:
	ld a,(op1reg)
;4 	if a = null
	CP  null
	JP NZ,.L340
	ld ix,auszeile
	call prttab
	prtstr 'XOR A'
	call putline
;4 	else
	JP .L341
.L340:
	ld ix,auszeile
	call prttab
	prtstr 'LD A,'
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline
;4 	endif
.L341:
	ld a,(op2reg)
;4 	if a = null
	CP  null
	JP NZ,.L342
	ld ix,auszeile
	call prttab
	prtstr 'OR A'
	call putline
;4 	else
	JP .L343
.L342:
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	call putline
;4 	endif
.L343:
;3 	endif
.L339:
;2 	endif
.L335:
;1 	else
	JP .L344
.L328:
		; spezial < > >= <=
	ld a,(opvgl)
;2 	if a = greater
	CP  greater
	JP NZ,.L345
	push de  	;save de 
	ld a,(op1len)
	ld c,a
	ld a,(op2len)
	ld (op1len),a
	ld a,c
	ld (op2len),a 	;exchange operands
	ld a,(op1reg)
	ld c,a
	ld a,(op2reg)
	ld (op1reg),a
	ld a,c
	ld (op2reg),a
	ld hl,(op1w)
	ld de,(op2w)
	ld (op1w),de
	ld (op2w),hl
	ld a,less
	ld (opvgl),a
	pop de
;2 	endif
.L345:
	ld a,(opvgl)
;2 	if a = lessequal
	CP  lessequal
	JP NZ,.L346
	push de 	;save de
	ld a,(op1len)
	ld c,a
	ld a,(op2len)
	ld (op1len),a
	ld a,c
	ld (op2len),a 	;exchange operands
	ld a,(op1reg)
	ld c,a
	ld a,(op2reg)
	ld (op1reg),a
	ld a,c
	ld (op2reg),a
	ld hl,(op1w)
	ld de,(op2w)
	ld (op1w),de
	ld (op2w),hl
	ld a,greatequal
	ld (opvgl),a
	pop de
;2 	endif
.L346:
	ld a,carry 
	ld (opid1),a 	;carry is condition default
	ld a,(opvgl)
;2 	if a = greatequal
	CP  greatequal
	JP NZ,.L347
	ld a,nocarry
	ld (opid1),a
;2 	endif
.L347:
	ld a,(op1reg)
;2 	if a = areg
	CP  areg
	JP NZ,.L348
		; a operand reg
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	call putline
;2 	else
	JP .L349
.L348:
	ld a,(op2reg)
;3 	if a = areg
	CP  areg
	JP NZ,.L350
		; reg operand a
		; spezial case   nnn < A or nnn >= A
	ld a,overflow
	ld (opid1),a
	ld a,(opvgl)
;4 	if a = greatequal
	CP  greatequal
	JP NZ,.L351
	ld a,nooverflow
	ld (opid1),a
;4 	endif
.L351:
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline
;3 	else
	JP .L352
.L350:
		; nnn oper  mmm
	ld ix,auszeile
	call prttab
	prtstr 'LD A,'
	ld hl,(op1w)
	ld a,(op1len)
	ld c,a
	call prtchl
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'CP '
	ld hl,(op2w)
	ld a,(op2len)
	ld c,a
	call prtchl
	call putline
;3 	endif
.L352:
;2 	endif
.L349:
;1 	endif
.L344:
		;
	ld a,(opjmp)
	ld b,a
	ld a,(opid1)
	ld c,a
	ld hl,(oplabl)
	ld a,(optrue)
	call gencode 	;generate jump
	ret
		;

		;
getscan::		;fetch an input line
		;de points to terminalsymbol
		;a is the symbol from table KEY
	call getline  	;fetch line
	call sepline  	;divide it
	ld de,sourcelin 	;analyse it
	ld ix,key  	;key table
	call getkey  	;result akku,de
	ret
		;

txterra::
	defm 'AT LINE '
	defb 0

crlf:	defb 0dh,0ah,0

errein::
	push bc
	push de
	push ix
	push iy
	push hl
	call print 	;output error name
	ld hl,crlf
	call print 	;to console
	ld hl,txterra
	call print
	ld hl,(inline)
	call dezout
	ld hl,crlf
	call print
	pop iy
	ld ix,auszeile 	;also to disk
	call prt1str
	call putline
	ld hl,(err)
	inc hl
	ld (err),hl
	pop iy
	pop ix
	pop de
	pop bc
	ret

		;


statement::		;recursive analyser
		;de - > line 
		;akku is key symbol

	ld hl,(level)
	inc hl
	ld (level),hl  	;level of recursion
	push af
	push de
;1 	if a <> assembly
	CP  assembly
	JP Z,.L353
	call gencomment 	;build comment and labels
;1 	endif
.L353:
	pop de
	pop af

	ld hl,tabcase  	;simulate a case
	ld c,a
	ld b,0
	add hl,bc
	add hl,bc  	;index * 2 + base
	ld c,(hl)  	;lsb
	inc hl
	ld b,(hl)  	;msb
	ld hl,backstate
	push hl   	;return adresse
	push bc
	pop hl
	jp (hl)   	;and execute it
		;
backstate::		;jump there back
	ld hl,(level)
	dec hl
	ld (level),hl  	;level of recursion
	ret


tabcase::		;must be same order as in keyfield
	defw genif  	;if
	defw errifelse  	;elseif
	defw errelse  	;else
	defw errendif  	;endif
	defw genrepeat  	;repeat
	defw erruntil  	;until
	defw genwhile  	;while
	defw errendwhile 	;endwhile
	defw genloop  	;loop
	defw errendloop  	;endloop
	defw genexitif  	;exitif
	defw exexit  	;exit
	defw gendo  	;do
	defw errenddo  	;enddo
	defw assem  	;assembly DEFAULT


genif::		;generate if instr de->pointer
	call igbn  	;ignore leading blanks
	call newlabel  	;hl = label
	ld a,false  	;tf = false
	ld b,jpaus  	;with jump absolute
	push hl   	;save it for future use
	call gencond  	;GENERATE CODE de->startsymbol
		;
	call getscan
	ld b,a
	ld a,(eof)
;1 	while a<>1 and b<>endifsymbol and b<>elsesymbol and b<>elseifsymbol
.L354:
	CP 1 
	JP Z,.L355
	LD A,b
	CP endifsymbol 
	JP Z,.L355
	LD A,b
	CP elsesymbol 
	JP Z,.L355
	LD A,b
	CP elseifsymbol
	JP Z,.L355
	ld a,b
	call statement
	call getscan
	ld b,a
	ld a,(eof)
;1 	endwhile
	JP .L354
.L355:

	push bc
	call gencomment
	pop bc

;1 	if b=elseifsymbol 	;case of elseif
	LD A,b
	CP elseifsymbol 
	JP NZ,.L356
	call newlabel 	;global destination
	push hl 	;save on stack <> 0
;2 	repeat
.L357:
	pop hl 	;get global
	push hl
	ld ix,auszeile
	call prttab
	prtstr 'JP '
	call putlabel
	call putline
	pop hl
	ex (sp),hl 	;get lokal temp exchange
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline 	;mark as label
	call newlabel 	;and new jump replaces old
	push hl
	ld a,false 	;hl valid
	ld b,jpaus
	call gencond 	;gen code
	pop hl 	;new
	ex (sp),hl 	;to stack
	push hl 	;global label
	call getscan
	ld b,a
	ld a,(eof)
;3 	while a<>1 and b<>endifsymbol and b<>elseifsymbol and b<>elsesymbol
.L358:
	CP 1 
	JP Z,.L359
	LD A,b
	CP endifsymbol 
	JP Z,.L359
	LD A,b
	CP elseifsymbol 
	JP Z,.L359
	LD A,b
	CP elsesymbol
	JP Z,.L359
	ld a,b
	call statement
	call getscan
	ld b,a
	ld a,(eof)
;3 	endwhile
	JP .L358
.L359:
	push bc
	call gencomment
	pop bc
;2 	until b<>elseifsymbol
	LD A,b
	CP elseifsymbol
	JP Z,.L357
		; two stack frames reserved
		; to global dest
		; so exchange global stack
	pop hl
	ex (sp),hl
	push hl 	;first lokal then global
;1 	else
	JP .L360
.L356:
	ld hl,0 	;mark no label
	ex (sp),hl
	push hl 	;save old one
;1 	endif
.L360:


;1 	if b=elsesymbol
	LD A,b
	CP elsesymbol
	JP NZ,.L361
	call newlabel 	;new label to hl
	ld ix,auszeile
	call prttab
	prtstr 'JP '
	call putlabel
	call putline
	ex (sp),hl 	;get old label and exchange
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline 	;mark as label
	call getscan
	ld b,a
	ld a,(eof)
;2 	while a<>1 and b<>endifsymbol
.L362:
	CP 1 
	JP Z,.L363
	LD A,b
	CP endifsymbol
	JP Z,.L363
	ld a,b
	call statement
	call getscan
	ld b,a
	ld a,(eof)
;2 	endwhile
	JP .L362
.L363:
	call gencomment
;1 	endif
.L361:
	pop hl  	;get old label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	pop hl
	ld a,h
	or l
;1 	exitif z 	;no more labels
	RET Z
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline 	;else elseif was there
	ret

genrepeat::		;
	call newlabel
	push hl  	;save it for until
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	call getscan
	ld b,a
	ld a,(eof)
;1 	while a<>1 and b<>untilsymbol
.L364:
	CP 1 
	JP Z,.L365
	LD A,b
	CP untilsymbol
	JP Z,.L365
	ld a,b
	call statement
	call getscan
	ld b,a  	;de is valid
	ld a,(eof)
;1 	endwhile
	JP .L364
.L365:
		; de is valid points to next symbol
	push de
	call gencomment
	pop de
	ld a,false
	ld b,jpaus 	;
	pop hl  	;to label
	call gencond
	ret
		;

genwhile::		;de points to next symbol
	call newlabel 	;hl is new label
	push hl  	;save this label
	push de  	;save pointer
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	pop de
	call newlabel 	;2cond label
	push hl  	;save also this one
	ld a,false
	ld b,jpaus 	;hl,de valid
	call gencond
	call getscan
	ld b,a
	ld a,(eof)
;1 	while a<>1 and b <> endwhilesymbol
.L366:
	CP 1 
	JP Z,.L367
	LD A,b
	CP  endwhilesymbol
	JP Z,.L367
	ld b,a
	call statement
	call getscan
	ld b,a
	ld a,(eof)
;1 	endwhile
	JP .L366
.L367:
	call gencomment 	;ok
	pop hl  	;last one
	ex (sp),hl 	;but need other one
	ld ix,auszeile
	call prttab
	prtstr 'JP '
	call putlabel
	call putline
	pop hl  	;final label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	ret



genexitif::		;de points to symbol
	ld a,true 	;gen true jump
	ld b,retaus 	;with return
	ld hl,0 	;hl undefined no label
	call gencond
	ret



genloop::		; loop executive
	call newlabel  	;hl is new label
	ld ix,auszeile
	call prttab
	prtstr 'PUSH HL'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'LD HL,'
	call putlabel
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'EX (SP),HL'
	call putline
	push hl  	;save jump over label
	call newlabel  	;next label 
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	push hl  	;save label because recursive
	call getscan  	;akku new defined
	ld b,a   	;save it temp
	ld a,(eof)  	;control it
;1 	while a<>1 and b<>endloopsymbol
.L368:
	CP 1 
	JP Z,.L369
	LD A,b
	CP endloopsymbol
	JP Z,.L369
	ld a,b  	;de points to line
	call statement 	;recursive call
	call getscan
	ld b,a
	ld a,(eof)  	;test end also
;1 	endwhile
	JP .L368
.L369:
	call gencomment 	;label comment output
	pop hl   	;back jumps label
	ld ix,auszeile
	call prttab
	prtstr 'JP '
	call putlabel
	call putline
	pop hl   	;skip label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline
	ret

gendo::		;generate do operator
		;de points to nextsymbol
	call igbn  	;to first valid symbol
	push de   	;save start  
	call scanass  	;de to nextsymbol
		;c=count b=symbol
;1 	if not b in [bcreg..lreg]
	LD A,b
	CP lreg+1
	JR NC,.L371
	CP bcreg+0
	JP NC,.L370
.L371:
	error 'ERROR WRONG DO PARAMETER'
	pop de   	;clean stack
;2 	exit
	RET
;1 	endif
.L370:
	push bc   	;save count and symbol
	call igbn
	ld a,(de)
;1 	if a = ','  	;load first parameter
	CP  ','  
	JP NZ,.L372
	ld ix,auszeile
	call prttab
	prtstr 'LD '
	pop bc
	pop hl
	push hl
	push bc  	;hl -> start
	ld c,255  	;print till end
	call prtchl
	call putline
;1 	endif
.L372:
	pop bc
	pop de   	;pointer to start of string
		;
	push bc   	;save only symbolname
		;
	call newlabel  	;hl is new label
	ld ix,auszeile
	call putlabel
	call lblsgn
	call putline  	;hl strill valid
		;
	push hl   	;save labelnumber
		;
	call getscan
	ld b,a
	ld a,(eof)
;1 	while a <> 1 and b <> enddosymbol
.L373:
	CP  1 
	JP Z,.L374
	LD A,b
	CP  enddosymbol
	JP Z,.L374
	ld a,b
	call statement
	call getscan
	ld b,a
	ld a,(eof)
;1 	endwhile
	JP .L373
.L374:
		;
	call gencomment
		;
	pop hl  	;label
	pop bc  	;b=symbolname of register
		;
	push hl  	;save label
	push bc
	ld ix,auszeile
	call prttab
	prtstr 'DEC '
	pop bc
	push bc
;1 	if b in [bcreg..lreg]
	LD A,b
	CP lreg+1
	JR NC,.L377
	CP bcreg+0
	JP NC,.L376
.L377:
	JP .L375
.L376:
	ld iy,key2
	ld a,b  	;index
	call prtind
;1 	endif
.L375:
	call putline
	pop bc
;1 	if b in [bcreg..hlreg]
	LD A,b
	CP hlreg+1
	JR NC,.L380
	CP bcreg+0
	JP NC,.L379
.L380:
	JP .L378
.L379:
;2 	if b = bcreg
	LD A,b
	CP  bcreg
	JP NZ,.L381
	ld ix,auszeile
	call prttab
	prtstr 'LD A,B'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'OR C'
	call putline
;2 	else
	JP .L382
.L381:
;3 	if b = dereg
	LD A,b
	CP  dereg
	JP NZ,.L383
	ld ix,auszeile
	call prttab
	prtstr 'LD A,D'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'OR E'
	call putline
;3 	else
	JP .L384
.L383:
;4 	if b = hlreg
	LD A,b
	CP  hlreg
	JP NZ,.L385
	ld ix,auszeile
	call prttab
	prtstr 'LD A,H' 
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'OR L'
	call putline
;4 	endif
.L385:
;3 	endif
.L384:
;2 	endif
.L382:
;1 	else
	JP .L386
.L378:
;2 	if b = ixreg
	LD A,b
	CP  ixreg
	JP NZ,.L387
	ld ix,auszeile
	call prttab
	prtstr 'DEFB 0DDH'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'LD A,H'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'DEFB 0DDH'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'OR L'
	call putline
;2 	else
	JP .L388
.L387:
;3 	if b = iyreg
	LD A,b
	CP  iyreg
	JP NZ,.L389
	ld ix,auszeile
	call prttab 
	prtstr 'DEFB 0FDH'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'LD A,H'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'DEFB 0FDH'
	call putline
	ld ix,auszeile
	call prttab
	prtstr 'OR L'
	call putline
;3 	else
	JP .L390
.L389:
;4 	if b = spreg
	LD A,b
	CP  spreg
	JP NZ,.L391
	error 'ERROR SP is dangerous'
;4 	endif
.L391:
;3 	endif
.L390:
;2 	endif
.L388:
;1 	endif
.L386:
	pop hl
	ld ix,auszeile
	call prttab
	prtstr 'JP NZ,'
	call putlabel
	call putline
	ret






exexit::
	ld ix,auszeile
	call prttab
	prtstr 'RET'
	call putline
	ret


		; error subroutines

errifelse::
	error 'ERROR ELSEIF WITHOUT IF'
	ret

errelse::
	error 'ERROR ELSE WITHOUT IF'
	ret


errendif::
	error 'ERROR ENDIF WITHOUT IF'
	ret

erruntil::
	error 'ERROR UNTIL WITHOUT REPEAT'
	ret

errendwhile::
	error 'ERROR ENDWHILE WITHOUT WHILE'
	ret


errendloop::
	error 'ENDLOOP WITHOUT LOOP'
	ret



errenddo::
	error 'ENDDO WITHOUT DO'
	ret


		; default subroutine

assem::		;std output assembly statement
	call toaus  	;includes putline
	ret


		; MAIN PROGRAMM
		;
start::		;Hauptprogramm start
	ld hl,(bdos+1) 	;get stack frame
	ld sp,hl 	;set to max
	ld a,0  	;default is console
	ld (iodest),a
	ld (iosrc),a
	ld (eof),a 	;no eof
	ld (tabcnt),a 	;tab counter
	ld hl,0
	ld (labelnr),hl 	;start with label 0
	ld (level),hl

	ld hl,txt1
	call print
		;
		; init default tables
		; 
	ld hl,fcb1
	ld de,fcbread
	ld bc,36
	ldir
	ld hl,fcb2
	ld de,fcbwrite
	ld bc,36
	ldir
		;
	ld a,0
	ld (comsw),a 	;comments
		; determine if console or disk
	ld a,(80h) 	;get buffer
;1 	if a<>0
	OR A
	JP Z,.L392
	ld b,a  	;counter 1..n CHARS
	ld hl,80h+1 	;first char
;2 	while b<>0 and (hl)=' '
.L393:
	LD A,b
	OR A
	JP Z,.L394
	LD A,(hl)
	CP ' '
	JP NZ,.L394
	inc hl
	dec b 
;2 	endwhile 	;ignore leading blanks  
	JP .L393
.L394:
;2 	if (hl) <> '/'
	LD A,(hl)
	CP  '/'
	JP Z,.L395
	push hl
	push bc
	ld hl,5ch+1
	ld de,fcbread+1
	ld bc,8
	ldir
	ld hl,5ch+1
	ld de,fcbwrite+1
	ld bc,8
	ldir
	ld a,1
	ld (iosrc),a
	ld (iodest),a 	;destination and source
	pop bc
	pop hl  
;2 	endif
.L395:
;2 	while b<>0 and (hl)<>'/'
.L396:
	LD A,b
	OR A
	JP Z,.L397
	LD A,(hl)
	CP '/'
	JP Z,.L397
	inc hl
	dec b
;2 	endwhile
	JP .L396
.L397:
;2 	if (hl) = '/'
	LD A,(hl)
	CP  '/'
	JP NZ,.L398
	inc hl
	dec b
;3 	while b <> 0
.L399:
	LD A,b
	OR A
	JP Z,.L400
;4 	if (hl) = 'C'
	LD A,(hl)
	CP  'C'
	JP NZ,.L401
	ld a,1
	ld (comsw),a 	;no comments
;4 	else
	JP .L402
.L401:
;5 	if (hl) = 'L'
	LD A,(hl)
	CP  'L'
	JP NZ,.L403
	ld a,0
	ld (iodest),a
;5 	else
	JP .L404
.L403:
;6 	if (hl) = 'P'
	LD A,(hl)
	CP  'P'
	JP NZ,.L405
	ld a,2
	ld (iodest),a 	;to printer
;6 	endif
.L405:
;5 	endif       
.L404:
;4 	endif
.L402:
	inc hl
	dec b
;3 	endwhile
	JP .L399
.L400:
;2 	endif 
.L398:
;1 	endif  	;no switches all from console
.L392:
		;
	ld a,(iosrc)
;1 	if a<>0
	OR A
	JP Z,.L406
	call initflop
;1 	else
	JP .L407
.L406:
	ld hl,txtaa
	call print
;1 	endif
.L407:
		;
		;
mainlp::		;mark for test
		;
;1 	repeat
.L408:
	call getscan 	;de->terminalsymb 
	call statement 	;
	ld a,(eof)
;1 	until a=1
	CP 1
	JP NZ,.L408

	ld hl,txt2
	call print

	ld hl,(inline)
	call dezout
	ld hl,txt3
	call print
	ld hl,(outline)
	call dezout
	ld hl,txt4
	call print
	ld hl,(err)
	call dezout
	ld hl,txt5
	call print
		;
	ld a,(iodest)
;1 	if a<>0
	OR A
	JP Z,.L409
	call terminate 	;close files
;1 	endif
.L409:
		;
	call 0  	;warm boot end of compilation




		; tables and constant data


fcb1::		;default table
	defb 0
	defb 20h,20h,20h,20h,20h,20h,20h,20h
	defm 'STR'
	defb 0,0,0,0
	defb 0,0,0,0,0,0,0,0
	defb 0,0,0,0,0,0,0,0
	defb 0,0,0,0

fcb2::		;default table
	defb 0
	defb 20h,20h,20h,20h,20h,20h,20h,20h
	defm 'MAC'
	defb 0,0,0,0
	defb 0,0,0,0,0,0,0,0
	defb 0,0,0,0,0,0,0,0
	defb 0,0,0,0







txt1::
	defb 0dh,0ah
	defm '------------------------------'
	defb 0dh,0ah
	defm 'Strukta   Compiler Version 1.4'
	defb 0dh,0ah
	defm 'by Rolf-Dieter Klein  (C) 1983 '
	defb 0dh,0ah
	defm 'Munic             West Germany'
	defb 0dh,0ah
	defm 'Last change           8.1.1983'
	defb 0dh,0ah
	defm '------------------------------'
	defb 0dh,0ah,0


txt2::
	defb 0dh,0ah,0
		;
txt3:
	defm ' line(s) were read'
	defb 0dh,0ah,0
txt4:
	defm ' line(s) were generated'
	defb 0dh,0ah,0
txt5:
	defm ' error(s) were detected'
	defb 0dh,0ah
	defm ' End of Complilation '
	defb 0dh,0ah,0
		;

txtaa::
	defb 0dh,0ah
	defm 'Please enter Struktalines End = CTRL Z '
	defb 0dh,0ah,0

key::		;keyword field a
	defm 'IF'
	defb 0
	defm 'ELSEIF' 	;must be before else
	defb 0
	defm 'ELSE'
	defb 0
	defm 'ENDIF'
	defb 0
	defm 'REPEAT'
	defb 0
	defm 'UNTIL'
	defb 0
	defm 'WHILE'
	defb 0
	defm 'ENDWHILE'
	defb 0
	defm 'LOOP'
	defb 0
	defm 'ENDLOOP'
	defb 0
	defm 'EXITIF'
	defb 0
	defm 'EXIT'
	defb 0
	defm 'DO'
	defb 0
	defm 'ENDDO'
	defb 0
	defb 0,0 	;end of table

		;
key1::		;table of conditions
	defm 'Z'
	defb 0
	defm 'C'
	defb 0
	defm 'PE'
	defb 0
	defm 'P'
	defb 0
	defm 'OV'
	defb 0
	defm 'NV'
	defb 0
	defm 'M'
	defb 0
	defm 'PO'
	defb 0
	defm 'NC'
	defb 0
	defm 'NZ'
	defb 0
	defb 0,0
		;
		;
key2:
	defm 'BC'
	defb 0
	defm 'DE'
	defb 0
	defm 'HL'
	defb 0
	defm 'SP'
	defb 0
	defm 'IX'
	defb 0
	defm 'IY'
	defb 0
	defm 'A'
	defb 0
	defm 'B'
	defb 0
	defm 'C'
	defb 0
	defm 'D'
	defb 0
	defm 'E'
	defb 0
	defm 'H'
	defb 0
	defm 'L'
	defb 0
	defb 0,0

		;
key3::
	defm 'OR'
	defb 0
	defm 'AND'
	defb 0
	defm 'NOT'
	defb 0
	defm 'IN'
	defb 0
	defb 0,0


		;
sym2::		;for output only
	defm 'JP '
	defb 0
	defm 'JR '
	defb 0
	defm 'RET '
	defb 0
	defm 'CALL '
	defb 0
	defb 0,0

sym3:
	defm '<>'
	defb 0
	defm '<='
	defb 0
	defm '>='
	defb 0
	defm '='
	defb 0
	defm '<'
	defb 0
	defm '>'
	defb 0
	defb 0,0





		; Ram Teil
iodest::	defb 0 	;destination 0=console 1=disk
iosrc::	defb 0 	;source 0=console 1=disk
		;
eof::	defb 0 	;end of file
		;
inline::	defw 0 	;count of input lines
outline::	defw 0 	;count of output lines
err::	defw 0 	;count of errors
		;
		; temp sto
desto::	defw 0 	;for getkey
de1sto::	defw 0 	;getkey
bcsto::	defw 0
bc1sto::	defw 0
		;
flagp::	defb 0 	;in putline
flag::	defb 0 	;in scanass
		;
state::	defb 0 	;state in sepline

tabcnt::	defb 0 	; tab counter
		;
labelnr::	defw 0 	; fuer labelgenerator GLOBAL
level::	defw 0 	;level of recursion
		;

		; lokale variable fuer genvergleich
		; also used by genin because
		; they are exclusive called and
		; not recursive
op1w::	defw 0 	;pointer to first operand
op1len::	defb 0 	;length of first operand
op1reg::	defb 0
op2w::	defw 0
op2len::	defb 0
op2reg::	defb 0
opvgl::	defb 0 	;value of conditioncode
opjmp::	defb 0 	;stores value of jmptype
optrue::	defb 0 	;stores true,false
oplabl::	defw 0 	;stores label of jump
opid1::	defb 0 	;type of condition
		;
		;
		; lokale variable for genin
genjmp::	defb 0
gentrue::	defb 0
gen1labl::	defw 0
gen2labl::	defw 0
genid1::	defb 0
genw::	defw 0
final::	defb 0
		;

labelx::	defw 0 	;pointer to einzeile
lenlab::	defb 0 	;length
instr::	defw 0 	;pointer to einzeile
lenins::	defb 0
comment::	defw 0 	;pointer to einzeile
lencom::	defb 0 	;comment length
		;
comsw::	defb 0 	;0=comments 1=nocomments
		;
		;
einzeile::	defs 256 	;input line buffer 0=terminator
auszeile::	defs 256 	;output line buffer 0=terminator
		;
sourcelin::	defs 256 	; line for instr part to be analysed


		;
fcbread::	defs 36
fcbwrite::	defs 36

rbuflen::	defw 0
wbuflen::	defw 0


freram::


	rbuf equ $
	wbuf equ rbuf + 4096
	next equ wbuf + 4096
		;
	global wbuf,rbuf 	;for test only

	end start