DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦cbfe8e721⟧ TextFile

    Length: 31616 (0x7b80)
    Types: TextFile
    Names: »EEOFPRC.MAC«

Derivation

└─⟦77f87173f⟧ Bits:30005981/disk3.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90
    └─⟦this⟧ »EEOFPRC.MAC« 

TextFile

;*************************************************
;*                                               *
;*	MODULE : EEOFPRC.MAC       (RC-700)      *
;*	DATE   : 01.02.82                        *
;*	BY     : ASE GmbH , 6472 Altenstadt      *
;*	VERSION: 1.90                            *
;*                                               *
;*************************************************
;
; THIS MODULE HANDLES MOST OF THE PROCESSING TO BE DONE AFTER THE
; USER HAS COMPLETED THE ENTRY OF A FIELD.
;
	PUBLIC	EOFPRC
	PUBLIC	RACHK
	PUBLIC	REGPRC
	PUBLIC	TFLD
	PUBLIC	QFLD
	PUBLIC	OPFLG
	PUBLIC	CD11
	PUBLIC	DSPCD
	PUBLIC	SGNSET
	PUBLIC	SGNCHK
	PUBLIC	ZNSGN
	PUBLIC	AUTINC
	PUBLIC	DSPREG
	PUBLIC	FCORR
;
	ext	DEMODE
	ext	EOFLD
	ext	LFSTB
	ext	FNCFLG
	ext	DSPMSG
	ext	KEYER3
	ext	INTFLG
	ext	ENTFLG
	ext	SVEBFF
	ext	RSTBFF
	ext	SOFUBA
	ext	FILCTR
	ext	SVEBF1
	ext	NXTFDB
	ext	GENFSB
	ext	CFLAG
	ext	REGCHK
	ext	ENTSND
	ext	SVEBF2
	ext	SOFCBA
	ext	REGFLG
	ext	ENTCPL
	ext	R0FLG
	ext	R25FLG
	ext	SOZ
	ext	STR1
	ext	STR2
	ext	BCDAXB
	ext	BFNO
	ext	FPTTAB
	ext	SOFFBA
	ext	MUL
	ext	ADD
	ext	SUB
	ext	NEGFLG
	ext	BXBCDA
	ext	MINFLG
	ext	EFTFLG
	ext	KEYER7
	ext	ASXDEC
	ext	DGTCNT
	ext	CBWD4
	ext	NXTLPE
	ext	FTMFLG
	ext	NXTLPE
	ext	R1FLG
	ext	INBUFF
	ext	DUPFLD
	ext	CBFADD
	ext	FBFADD
	ext	MLNFLG
	ext	ANYRG3
	ext	SETMSG
	ext	INCCRS
	ext	CHRRD
	ext	RAVER
	ext	ENTRY
	ext	VCRFLG
	ext	FMFFLG
	ext	FNCFLG
	ext	KEYERR
	ext	VCRCTR
	ext	BRFLD
;
;
;this checks for zoned fields and converts the digit.
;
EOFPRC:	ld	a,(EFTFLG)	;
	cp	0ffh		;
	jp	nz,EOFPR1	;
	call	NXTFDB		;
EOFPR1:	ld	a,(MINFLG)	;
	cp	0ffh		;
	jp	nz,EOFPR4	;go on minus-flag not set
	ld	a,00h		;
	ld	(MINFLG),a	;reset minus flag
	ld	hl,(SOFUBA)	;
	dec	hl		;
	call	SGNSET		;make last digit minus
EOFPR4:	ld	a,(EFTFLG)	;
	cp	0ffh		;
	jp	z,EOFPR3	;
	jp	RAFLL		;
EOFPR3:	ld	hl,(SOFUBA)	;
	dec	hl		;
	ld	a,(hl)		;
	ld	hl,(SOFCBA)	;
	dec	hl		;
	ld	(hl),a		;
	jp	EOFLD		;
;
;this checks for right-adjust fields and returns to calling
;routine with a-reg set to 0ffh if it is, otherwise a-reg
;will be zeroed.
;
RACHK:	ld	a,(LFSTB)	;get last field start byte
	cp	'J'		;
	jp	z,BLKFLL	;
	cp	'I'		;
	jp	z,BLKFLL	;
	cp	'Y'		;
	jp	z,BLKFLL	;
	cp	'Z'		;
	jp	z,BLKFLL	;
	cp	'R'		;
	jp	z,ZROFLL	;
	cp	'X'		;
	jp	z,ZROFLL	;
	cp	'+'		;auto increment?
	jp	nz,RACHK1	;go if not
	ld	a,(DEMODE)	;update mode?
	cp	01h		;
	jp	z,RACHK1	;bypass on verify mode
	cp	02h		;
	jp	z,ZROFLL	;yes,treat it as right adjust
	ld	a,(FTMFLG)	;
	cp	0ffh		;first time flag set?
	jp	z,ZROFLL	;go if it is
RACHK1:	ld	a,00h		;not a right adjust field
	ret			;
;
;this sets the right-djust fill character to blank.
;
BLKFLL:	ld	a,20h		;
	ld	(FLLCHR),a	;fill char. is blank
	ld	a,0ffh		;set the a-reg
	ld	c,20h		;
	ret			;
;
;this sets the right adjust fill character to zero.
;
ZROFLL:	ld	a,30h		;
	ld	(FLLCHR),a	;fill char. is zero.
	ld	a,0ffh		;set a-reg
	ld	c,30h		;
	ret			;ret.
;
;the following will right-adjust the field and left-fill it
;with the given fill character. the adjusting and filling
;will be done in the user-buffer and on the screen.
;
RAFLL:	ld	a,0ffh		;
	ld	(ENTFLG),a	;
	call	SVEBFF		;save the 3 main bufferpointers
	ld	hl,(SOFUBA)	;
	ld	bc,(FILCTR)	;
	and	a		;
	sbc	hl,bc		;calc. start of field in userbuffer
	ld	(SVEBF5),hl	;and save it.
	ld	hl,(SVEBF1)	;
	ld	(SOFUBA),hl	;restore user buffer pointer.
	ld	hl,(FILCTR)	;
	ld	(RAFSV2),hl	;
	ld	bc,00h		;
	sbc	hl,bc		;
	jp	nz,RAFLL7	;jump if field length not zero
	ld	a,0ffh		;
	ld	(STFFLG),a	;set start of field flag
	jp	RAFLL1		;
RAFLL7:	ld	a,00h		;
	ld	(STFFLG),a	;reset start of field flag
RAFLL1:	call	NXTFDB		;step to next fdb
	call	GENFSB		;test it.
	ld	hl,(FILCTR)	;
	inc	hl		;
	ld	(FILCTR),hl	;
	cp	20h		;end of field?
	jp	z,RAFLL2	;yes.
	cp	0ffh		;end of field?
	jp	z,RAFLL2	;yes.
	ld	a,0ffh		;
	ld	(CFLAG),a	;set call flag
	call	REGCHK		;check possible register codes.
	ld	a,00h		;
	ld	(CFLAG),a	;reset call flag
	jp	RAFLL1		;keep looping.
;
RAFLL2:	ld	hl,(SOFCBA)	;
	dec	hl		;
	ld	(SOFCBA),hl	;
	ld	a,(STFFLG)	;
	cp	0ffh		;
	jp	z,RAFLL8	;
	ld	hl,(SVEBF2)	;
	dec	hl		;
	ld	(SVEBF2),hl	;
RAFLL8:	ld	de,(SOFUBA)	;
	dec	de		;
	ld	(SVEBF4),de	;save sofuba
	ld	hl,(SVEBF1)	;
	ld	a,(STFFLG)	;
	cp	0ffh		;
	jp	z,RAFLL9	;
	dec	hl		;
RAFLL9:	ld	(RAFSV1),hl	;
	ld	hl,(RAFSV2)	;
	ld	BC,00H		;
	and	a		;
	sbc	hl,bc		;
	jp	z,RAFLL0	;
	ld	bc,(SVEBF5)	;
	ld	hl,(RAFSV1)	;
RAFLL3:	ld	a,(hl)		;get character
	ld	(de),a		;and move it.
	ld	a,(FLLCHR)	;
	ld	(hl),a		;write fill character
	ld	a,(de)		;restore character
	push	hl		;save hl
	push 	de		;save de
	ld	hl,(SVEBF2)	;
	ld	de,(SOFCBA)	;
	ld	(de),a		;move character to screen
	ld	a,(FLLCHR)	;
	ld	(hl),a		;fill character in its place
	dec	de		;
	dec	hl		;
	ld	(SVEBF2),hl	;
	ld	(SOFCBA),de	;
	pop	hl		;
	pop	de		;
	ex	de,hl		;
	ld	(RAFSV1),HL	;
	and	a		;
	sbc	hl,bc		;
	jp	z,RAFLL4	;
	ld	hl,(RAFSV1)	;
	dec	hl		;
	dec	de		;
	jp	RAFLL3		;
;
;the following fills the rest of the field in the userbuffer
;after the actual content has been right adjusted.
;
RAFLL4:	dec	de		;
RAFLL0:	ld	bc,(SVEBF5)	;
	ld	a,(FLLCHR)	;
	ld	(RAFSV3),de	;
	ex	de,hl		;
	and	a		;
	sbc	hl,bc		;
	jp	m,RAFLL5	;
	ld	de,(RAFSV3)	;
	ld	(de),a		;
	jp	RAFLL4		;
;
;the following fills the rest of the field with the fillcharacter
;on the crt after the actual field content has been right adjusted.
;
RAFLL5:	ld	bc,(SVEBF2)	;
	ld	hl,(RAFSV2)	;
	ld	de,00h		;
	and	a		;
	sbc	hl,de		;
	jp	z,RAFL10	;
	inc	bc		;
RAFL10:	ld	hl,(SOFCBA)	;
	ld	de,(SVEBF4)	;
	inc	de		;
	ld	(SOFUBA),de	;restore sofuba for exit.
RAFLL6:	and	a		;
	ld	(RAFSV1),hl	;
	sbc	hl,bc		;
	jp	m,EOFLD		;all done.
	ld	hl,(RAFSV1)	;
	ld	(hl),a		;
	dec	hl		;
	jp	RAFLL6		;
;
;
;
SVEBF5:	dw	0000h		;start of field save
FLLCHR:	db	00h		;fill character is passed here.
RAFSV1:	dw	0000h		;used to save hl
STFFLG:	db	00h		;start of field flag
SVEBF4:	dw	0000h		;
RAFSV2:	dw	0000H		;save filctr
RAFSV3:	dw	0000h		;
;
;
;the following handles the arithmetic operations between registers
;and fields.
;
REGPRC:	ld	a,(AICFLG)	;
	cp	0ffh		;auto inc flag set?
	jp	z,AUTIN4	;yes
	ld	a,(CDFLG)	;
	cp	00h		;
	jp	z,CDCHK		;check for possible check-digit code
	ld	a,00h		;
	ld	(CDFLG),a	;
REGP99:	ld	a,(REGFLG)	;
	cp	0ffh		;any register used?
	jp	nz,REGP97	;no,bypass the reg.-processing
	ld	a,(TQFLG)	;is this a T/Q-field?
	cp	0ffh		;
	jp	nz,REGP22	;bypass if not.
	ld	a,00h		;
	ld	(TQFLG),a	;clear the flag
	jp	REGP97		;
REGP22:	ld	c,00h		;clear the c-reg
	ld	hl,R0FLG	;
;
;find the first used register
;in the field-description.
;
REGPR1:	ld	a,(hl)		;
	cp	0ffh		;
	jp	z,REGPR7	;found it.
	ld	(RPRSV3),hl	;
	ld	de,R25FLG	;
	and	a		;
	sbc	hl,de		;
	jp	z,REGP97	;go if all 25 reg are checked
	ld	hl,(RPRSV3)	;
REGP21:	inc	hl		;
	inc	c		;inc the reg.number
	jp	REGPR1		;
;
;this checks the kind of register and sets the operation-flag.
;OPRFLG = 00 multiplication register
;       = 01 addittion register
;       = 02 subtraction register
;
REGPR7:	ld	(RPRSV4),hl	;save register-flag pointer
	ld	hl,RNOSV	;
	ld	(hl),c		;save register flag pointer
	ld	a,c		;
	cp	00h		;
	jp	nz,REGPR5	;
	ld	(OPRFLG),a	;must be a mul-reg.
	jp	REGPR2		;
;
REGPR5:	ld	c,a		;save a
	ld	a,0fh		;
	cpl			;
	add	a,c		;
	jp	p,REGPR6	; > the 9, must be subtraction reg.
	ld	a,1h		;
	ld	(OPRFLG),a	;its an add-reg.
	ld	a,c		;restore a
	jp	REGPR2		;
;
REGPR6:	ld	a,2h		;
	ld	(OPRFLG),a	;its a subtr. reg.
	ld	a,c		;restore a
	jp	REGPR2		;
;
;register number is in a-reg,now get start to register-area in Z.
;
REGPR2:	ld	c,a		;save a-reg
	ld	a,(FCOFLG)	;
	cp	00h		;
	jp	z,REGP94	;
;
;the following will reverse the operation on field corrections.
;add for sub,sub for add , multiplication will not be touched
;
	ld	a,(OPRFLG)	;
	cp	00h		;
	jp	z,REGP94	;bypass on multiplication
	cp	01h		;
	jp	nz,REGP95	;go if not add-operation
	ld	a,02h		;
	ld	(OPRFLG),a	;set to subtraction
	jp	REGP94		;
REGP95:	cp	02h		;subtraction operation?
	jp	nz,REGP94	;go if not
	ld	a,01h		;
	ld	(OPRFLG),a	;set to add
;
REGP94:	ld	a,c		;
REGP96:	ld	hl,(SOZ)	;
	ld	bc,75		;offset to first register
	add	hl,bc		;
;
;start to reg. 0 is now in hl , now calc. the start to the right reg.
;
REGPR3:	cp	00h		;
	jp	z,REGPR4	;found it , its reg 0 (mul-reg)
	ld	bc,15		;
	add	hl,bc		;step to next reg.
	dec	a		;
	jp	REGPR3		;keep looping
;
;address of reg now in hl , get end address of it.
;
REGPR4:	ld	bc,14		;
	add	hl,bc		;
	ld	(RPRSV1),hl	;save end-address of register
	ld	a,(CFLAG)	;
	cp	0ffh		;
	ret	z		;return if call flag set.
	call	SGNCHK		;check the reg-cont. present sign
;
REGP16:	ld	a,(ZNSGN)	;
	ld	(RGSGN),a	;set register sign flag
	ld	ix,(RPRSV1)	;reg end adress
	ld	hl,STR2		;start of bcd-string
	ld	b,15		;number of digits
	call	BCDAXB		;convert register ascii to bcd
;
;now start on field contents by calc. the field start adress
;
REGP98:	ld	hl,(BFNO)	;
	dec	hl		;
REGPR8:	dec	hl		;
	add	hl,hl		;
	add	hl,hl		;
	ld	de,FPTTAB	;
	add	hl,de		;
	ld	e,(hl)		;
	inc	hl		;
	ld	d,(hl)		;
	ld	(SOFFBA),de	;get start of field in format buffer
	inc	hl		;
	ld	e,(hl)		;
	inc	hl		;
	ld	d,(hl)		;
	ld	(SOFUBA),de	;got start of field in user buffer
	ld	hl,(FILCTR)	;
	dec	hl		;
	add	hl,de		;get end of field
	ld	(RPRSV2),hl	;save end of field
	ld	de,(FBFADD)	;
	ld	hl,(SOFFBA)	;
	and	a		;
	sbc	hl,de		;
	ld	de,(CBFADD)	;
	add	hl,de		;
	ld	(TQSV2),hl	;save calculated start of field on crt.
	ld	a,(CFLAG)	;
	cp	0ffh		;
	ret	z		;return here if call flag set
	ld	hl,(RPRSV2)	;
	call	SGNCHK		;
	ld	a,(ZNSGN)	;
	ld	(FLDSGN),a	;
	ld	hl,15		;
	ld	bc,(FILCTR)	;
	and	a		;
	sbc	hl,bc		;check the field length
	jp	p,REGP17	;fld-length must be less then 16
	ld	b,15		;fld-length > 15 , so cut down to 15.
	jp	REGP18		;
REGP17:	ld	b,c		;move actual fld-lngth to b
REGP18:	ld	ix,(RPRSV2)	;get end of field
	ld	hl,STR1		;get bcd-string start
	call	BCDAXB		;xlate from ascii to bcd
	ld	a,(FLDSGN)	;get fieldsgn
	cp	0ffh		;
	jp	nz,REGP34	;bypass on positive field
	ld	hl,(RPRSV2)	;get end of field
	call	SGNSET		;restore sign of field
REGP34:	call	OPTST		;set combined sign fld/reg
	ld	a,(OPFLG)	;test combined sign
	cp	03h		;(+) (+)
	jp	z,REGP23	;
	cp	01h		;(-) (+)
	jp	z,REGP31	;
	cp	02h		;(+) (-)
	jp	z,REGP35	;
	cp	00h		;
	jp	z,REGP25	;(-) (-)
REGP23:	ld	a,(OPRFLG)	;
	cp	00h		;multiplication?
	jp	nz,REGP26	;no
	call	MUL		;
	jp	REGP28		;
REGP26:	cp	01h		;addittion
	jp	nz,REGP27	;no.
	call	ADD		;
	jp	REGP28		;
REGP27:	call	SUB		;must be sub.
REGP28:	ld	a,(NEGFLG)	;
	ld	(FINSGN),a	;
	jp	REGP19		;
;
REGP24:	call	SUB		;
REGP30:	ld	a,(NEGFLG)	;
	cpl			;
	ld	(FINSGN),a	;
	jp	REGP19		;
;
REGP35:	ld	a,(OPRFLG)	;
	cp	00h		;mul.?
	jp	nz,REGP36	;go if not.
	call	MUL		;
	jp	REGP28		;
;
REGP36:	cp	01h		;add ?
	jp	nz,REGP37	;go if not.
	call	SUB		;
	jp	REGP30		;
;
REGP37:	call	ADD		;assume subtr.-reg.
	jp	REGP30		;
;
;
REGP25:	ld	a,(OPRFLG)	;
	cp	00h		;
	jp	nz,REGP29	;
	call	MUL		;
	jp	REGP28		;
;
REGP29:	cp	01h		;
	jp	nz,REGP24	;
	call	ADD		;
	ld	a,0ffh		;
	ld	(FINSGN),a	;
	jp	REGP19		;
REGP31:	ld	a,(OPRFLG)	;
	cp	00h		;
	jp	nz,REGP32	;
	call	MUL		;
	jp	REGP19		;
REGP32:	cp	01h		;
	jp	nz,REGP33	;
	call	SUB		;
	jp	REGP28		;
REGP33:	call	ADD		;
	jp	REGP28		;
;
;
;add or subtr. is completed , now xlate and restore the operands.
;
REGP19:	ld	ix,(RPRSV1)	;get end of reg.
	ld	hl,STR2		;start of bcd-string
	ld	b,15		;number of digits
	call	BXBCDA		;bcd to ascii
	ld	a,(FINSGN)	;
	cp	0ffh		;negativ?
	jp	nz,REGP20	;go if not
	ld	hl,(RPRSV1)	;
	call	SGNSET		;zone the register
REGP20:	ld	hl,RNOSV	;
	ld	c,(hl)		;restore register number
	ld	hl,(RPRSV4)	;restore register flag pointer
	ld	a,(AICFLG)	;
	cp	0ffh		;auto inc flag set?
	jp	z,AUTIN1	;yes go.
	jp	REGP21		;and process other registers
;
REGP97:	ld	a,(FCOFLG)	;get field correction flag
	cp	0ffh		;
	jp	z,FCORR2	;go if set.
	jp	ENTCPL		;
;
;the following subroutine checks the sign of the operand for positive
;or negativ zoned. If zoned the routine will xlate the zoned character
;to normal ascii decimal and set the ZNFLG. otherwise the ZNFLG will
;be reset.
;negativ zoning: J=1,K=2,L=3,M=4,N=5,O=6,P=7,Q=8,R=9,Hex'7D'=0.
;the routine expects the address of the signed position in the hl-reg.
;
SGNCHK:	ld	a,(hl)		;
	cp	'J'		;-1?
	jp	nz,SGNCH1	;
	ld	a,31h		;
	call	SETNR		;
	ret			;
SGNCH1:	cp	'K'		;-2?
	jp	nz,SGNCH2	;
	ld	a,32h		;
	call	SETNR		;
	ret			;
SGNCH2:	cp	'L'		;-3?
	jp	nz,SGNCH3	;
	ld	a,33h		;
	call	SETNR		;
	ret			;
SGNCH3:	cp	'M'		;
	jp	nz,SGNCH4	;
	ld	a,34h		;
	call	SETNR		;
	ret			;
SGNCH4:	cp	'N'		;
	jp	nz,SGNCH5	;
	ld	a,35h		;
	call	SETNR		;
	ret			;
SGNCH5:	cp	'O'		;-5?
	jp	nz,SGNCH6	;
	ld	a,36h		;
	call	SETNR		;
	ret			;
SGNCH6:	cp	'P'		;-7?
	jp	nz,SGNCH7	;
	ld	a,37h		;
	call	SETNR		;
	ret			;
SGNCH7:	cp	'Q'		;-8?
	jp	nz,SGNCH8	;
	ld	a,38h		;
	call	SETNR		;
	ret			;
SGNCH8:	cp	'R'		;
	jp	nz,SGNCH9	;
	ld	a,39h		;
	call	SETNR		;
	ret			;
SGNCH9:	cp	7dh		;-0?
	jp	nz,SGNC10	;
	ld	a,30h		;
	call	SETNR		;
	ret			;
SGNC10:	ld	a,00h		;
	ld	(ZNSGN),a	;set positive sign
	ret			;
SETNR:	ld	(hl),a		;
	ld	a,0ffh		;
	ld	(ZNSGN),a	;set negative sign
	ret			;
;
;the following subroutine sets the operand-flag (OPFLG) based on the
;the signs of both operands.the following applies:
;  sign of field   sign of register    setting of OPFLG
;       -                 -                   00
;       -                 +                   01
;       +                 -                   02
;       +                 +                   03
;
OPTST:	ld	a,(FLDSGN)	;
	cp	0ffh		;
	jp	z,OPTST1	;
	ld	a,(RGSGN)	;at this point field must be positive
	cp	0ffh		;
	jp	z,OPTST3	;
	ld	a,03h		;at this point reg. must be positive
	ld	(OPFLG),a	;
	ret			;
OPTST1:	ld	a,(RGSGN)	;at this point field must be negative
	cp	0ffh		;
	jp	z,OPTST2	;
	ld	a,01h		;at this point reg. must be positive
	ld	(OPFLG),a	;
	ret			;
OPTST2:	ld	a,00h		;at this point reg. must be negativ
	ld	(OPFLG),a	;
	ret			;
OPTST3:	ld	a,02h		;at this point reg. must be negativ
	ld	(OPFLG),a	;
	ret			;
;
;the following subroutine sets the zoned sign in the register after
;the final sign (after the actual operation) is known.It expects the
;hl-register to point to the least significant popsition of the
;register.
;
SGNSET:	ld	a,(hl)		;
	cp	30h		;
	jp	nz,SGNS1	;
	ld	a,7dh		;
	ld	(hl),a		;
	ret			;
SGNS1:	cp	31h		;
	jp	nz,SGNS2	;
	ld	a,'J'		;
	ld	(hl),a		;
	ret			;
SGNS2:	cp	32h		;
	jp	nz,SGNS3	;
	ld	a,'K'		;
	ld	(hl),a		;
	ret			;
SGNS3:	cp	33h		;
	jp	nz,SGNS4	;
	ld	a,'L'		;
	ld	(hl),a		;
	ret			;
SGNS4:	cp	34h		;
	jp	nz,SGNS5	;
	ld	a,'M'		;
	ld	(hl),a		;
	ret			;
SGNS5:	cp	35h		;
	jp	nz,SGNS6	;
	ld	a,'N'		;
	ld	(hl),a		;
	ret			;
SGNS6:	cp	36h		;
	jp	nz,SGNS7	;
	ld	a,'O'		;
	ld	(hl),a		;
	ret			;
SGNS7:	cp	37h		;
	jp	nz,SGNS8	;
	ld	a,'P'		;
	ld	(hl),a		;
	ret			;
SGNS8:	cp	38h		;
	jp	nz,SGNS9	;
	ld	a,'Q'		;
	ld	(hl),a		;
	ret			;
SGNS9:	cp	39h		;
	ret	nz		;
	ld	a,'R'		;
	ld	(hl),a		;
	ret			;
;
;
RPRSV1:	dw	0000h		;save end of reg. address
RPRSV2:	dw	0000h		;save end of field address
RPRSV3:	dw	0000h		;general save location.
RPRSV4:	dw	0000h		;save register flag pointer
RPRSV5:	db	00h		;general save location
FINSGN:	db	00h		;final sign
OPFLG:	db	00h		;calc. sign of both operands
OPRFLG:	db	00h		;operation flag
ZNSGN:	db	00h		;zoneflag used by SGNCHK
FLDSGN:	db	00h		;sign of field before operation
RGSGN:	db	00h		;sign of register before operation
RNOSV:	db	00h		;save register number
EXCFLG:	db	00h		;exceptionflag indicates reversed oper.
;                                on filtered situations(add becomes sub
;                                and vice versa:(+)-(-),(-)-(+) etc.
;
;
;
;
;the following handles the register readout fields with and without
;register clear (fsb T = readout with clear,fsb Q = readout only)
;
TFLD:	ld	a,0ffh		;
	ld	(TQFLG),a	;set the tqflag
	jp	TQFLD		;
;
QFLD:	ld	a,00h		;
	ld	(TQFLG),a	;
	jp	TQFLD		;
;
;the following calculates the field length
;
TQFLD:	ld	hl,(SOFCBA)	;
	ld	(TQSV1),hl	;save crt buffer pointer
	ld	a,0ffh		;
	ld	(INTFLG),a	;
TQFLD9:	ld	hl,(FILCTR)	;
	inc	hl		;
	ld	(FILCTR),hl	;inc the field length counter
	call	NXTFDB		;
	call	GENFSB		;
	cp	0ffh		;end of field?
	jp	z,TQFLD1	;yes.
	cp	20h		;end of field?
	jp	z,TQFLD1	;yes.
	ld	a,0ffh		;
	ld	(CFLAG),a	;set call flag
	call	REGCHK		;check for registers.
	ld	a,00h		;
	ld	(CFLAG),a	;
	jp	TQFLD9		;keep looping
;
;the following calculates the registernumber for the wanted register
;
TQFLD1:	ld	c,00h		;clear register number counter
	ld	de,R0FLG	;clear register flag pointer
TQFLD4:	ld	hl,R25FLG	;
	ld	a,(de)		;read register flag.
	cp	0ffh		;
	jp	z,TQFLD2	;found the registernumber
	and 	a		;
	sbc	hl,de		;
	jp	z,TQFLD2	;didnt see a regfister,assume reg.0
	inc	c		;inc the register number
	inc	de		;inc register flag pointer
	jp	TQFLD4		;keep looking
;
;now calculate the register end-address
;
TQFLD2:	ld	a,0ffh		;
	ld	(CFLAG),a	;set call flag
	ld	a,c		;
	call	REGP96		;
;register end address now in (RPRSV1)
;now calculate the field end address
;
	ld	hl,(BFNO)	;
	call	REGPR8		;
	ld	a,00h		;
	ld	(CFLAG),a	;reset call flag
;
;field end address now in (RPRSV2)
;now move register to field in user buffer
;
;
	ld	a,(AICFLG)	;
	cp	0ffh		;
	jp	nz,TQFL12	;bypass if not an autoinc field
	ld	hl,(TQSV2)	;
	ld	(TQSV1),hl	;load start of field on crt
TQFL12:	ld	hl,(FILCTR)	;
	ld	(RPRSV3),hl	;save the field length counter
	ld	a,15		;
	ld	(RPRSV5),a	;set register length counter
TQFLD3:	ld	hl,(RPRSV1)	;get end of register address
	ld	de,(RPRSV2)	;get end of field address
	ld	bc,(RPRSV3)	;get field length
	ld	a,(hl)		;read register character
	ld	(de),a		;and move it to the field
	ld	a,(TQFLG)	;
	cp	0ffh		;
	jp	nz,TQFLD7	;go on Q-field
	ld	a,30h		;
	ld	(hl),a		;zero register on T-field
TQFLD7:	dec	bc		;
	ld	(RPRSV3),bc	;dec field length
	dec	de		;
	ld	(RPRSV2),de	;dec field address pointer
	dec	hl		;
	ld	(RPRSV1),hl	;dec register address pointer
	ld	hl,00h		;
	and	a		;
	sbc	hl,bc		;
	jp	z,TQFL10	;field length = 0 , all done!
	ld	a,(RPRSV5)	;
	dec	a		;dec register length counter
	jp	z,TQFLD5	;register fully moved.
	ld	(RPRSV5),a	;
	jp	TQFLD3		;keep moving
;
;the remainder of the field will now be left-zero filled
;
TQFLD5:	ld	a,30h		;
	ld	(de),a		;store 0 into field
	dec	bc		;
	ld	(RPRSV3),bc	;dec field length
	dec	de		;
	ld	(RPRSV2),de	;dec field address pointer
	ld	hl,00h		;
	and	a		;
	sbc	hl,bc		;
	jp	nz,TQFLD5	;keep looping,field length not zero.
;
;now the field will be moved to the crt
;
TQFLD6:	ld	hl,(SOFUBA)	;
	ld	de,(TQSV1)	;
	ld	bc,(FILCTR)	;
	ldir			;
	ld	a,0ffh		;
	ld	(TQFLG),a	;
	ld	a,(AICFLG)	;
	cp	0ffh		;auto inc flag set?
	jp	z,AUTIN2	;yes go.
	jp	EOFLD		;all done.
;
;the following will finish clearing the register on T-fields
;when the field was shorter then the register.
;
TQFL10:	ld	a,(TQFLG)	;
	cp	0ffh		;
	jp	nz,TQFLD6	;bypass on Q-fields
TQFL11:	ld	a,(RPRSV5)	;
	dec	a		;
	jp	z,TQFLD6	;go when all clear
	ld	(RPRSV5),a	;
	ld	a,30h		;
	ld	hl,(RPRSV1)	;
	ld	(hl),a		;store zero to register
	dec	hl		;
	ld	(RPRSV1),hl	;dec reg.address pointer
	jp	TQFL11		;keep looping
;
TQSV1:	dw	0000h		;used to save the crt buffer pointer
TQFLG:	db	00h		;if set = T-field,is reset = Q-field
TQSV2:	dw	0000h		;used to save crt field start on autinc
;
;the following tests for any of the 6 possible CD10/11 field codes
;
CDCHK:	ld	a,0ffh		;
	ld	(CDFLG),a	;set check digit flag
	ld	a,(LFSTB)	;
	cp	'H'		;
	jp	z,CD10		;
	cp	'C'		;
	jp	z,CD11		;
	ld	a,(FTMFLG)	;
	cp	00h		;auto-dup/skip on?
	jp	z,REGPRC	;
	ld	a,(LFSTB)	;
	cp	'L'		;
	jp	z,CD10		;
	cp	'F'		;
	jp	z,CD10		;
	cp	'G'		;
	jp	z,CD11		;
	cp	'M'		;
	jp	z,CD11		;
	jp	REGPRC		;
;
;the following handles the CD11-field
;and also part of the CD10-field.
;
CD11:	ld	a,2h		;
	ld	(WFACT),a	;set weight factor to 2
	ld	a,00h		;
	ld	(OEFLG),a	;clear the CD10-odd/even flag
	call	SVEBFF		;
	ld	hl,(SOFUBA)	;
	ld	a,(hl)		;get entered check digit
	ld	(CDSV),a	;and save it.
	ld	(CDFPTR),hl	;
	ld	a,0ffh		;
	ld	(CFLAG),a	;
	call	REGP98		;
	ld	a,00h		;
	ld	(CFLAG),a	;
	ld	(ADDLC),a	;clear add-location
	ld	hl,(FILCTR)	;
	dec	hl		;
	ld	(CDCTR),hl	;save field length decrem. by one
CD11D:	ld	de,(CDCTR)	;
	ld	hl,00h		;
	and	a		;
	sbc	hl,de		;
	jp	z,CD11B		;go on end 0f field minus one.
	dec	de		;
	ld	(CDCTR),de	;save decremented field length.
	ld	hl,(CDFPTR)	;
	dec	hl		;dec the check digit field pointer
	ld	(CDFPTR),hl	;
	ld	ix,(CDFPTR)	;
	ld	a,01h		;
	ld	(DGTCNT),a	;
	call	ASXDEC		;xlate character from user buff. to bin
	ld	a,(CD10FL)	;
	cp	0ffh		;is this a CD10-field?
	jp	z,CD10A		;yes.
	ld	a,l		;get it to a-reg
	cp	00h		;
	jp	z,CD11A		;bypass on zero.
	ex	de,hl		;multiplikant to de-reg.
	ld	a,(WFACT)	;multiplier to a-reg
	call	MULBYT		;
CD11E:	ld	a,11 		;
	cpl			;
	add	a,l		;
	jp	p,CD11C		;result   greater then 11
	ld	a,(ADDLC)	;
	add	a,l		;add result to add-loc
	ld	(ADDLC),a	;and save it.
CD11A:	ld	a,(WFACT)	;
	inc	a		;
	ld	(WFACT),a	;sace increm.weight factor.
	cp	08h		;wf = 08?
	jp	nz,CD11D	;go if not.
	ld	a,02h		;
	ld	(WFACT),a	;reset weight factor
	jp	CD11D		;and loop.
CD11C:	ld	a,l		;
	ld	b,11 		;
	sub	b		;
	ld	l,a		;
	jp	CD11E		;
;
;comes here after end of field - 1.
;
CD11B:	ld	a,(ADDLC)	;
	ld	c,a		;
	ld	a,(CD10FL)	;
	cp	0ffh		;
	jp	z,CD10E		;go on CD10-fields.
	ld	a,11 		;
	cpl			;
	add	a,c		;
	jp	m,CD11F		;go if addloc not > then 11
	ld	a,(ADDLC)	;
	ld	c,11 		;
	sub	c		;sub 11 from add-loc.
	ld	(ADDLC),a	;save result
	jp	CD11B		;
;
CD11F:	ld	a,11 		;
	sub	c		;check-digit now in a-reg.
	cp	11		;
	jp	z,CD11J		;check-digit is 11
	cp	10		;
	jp	z,CD11J		;check-digit is 10
CD11K:	add	a,30h		;make it ascii-decimal
CD11H:	ld	c,a		;
	ld	(GENCD),a	;save generated check digit
	ld	a,00h		;
	ld	(CD10FL),a	;clear the CD10-flag.
	ld	a,(CDSV)	;
	cp	c		;
	jp	nz,CD11G	;check digit not equal.
	jp	REGPRC		;
;
CD11G:	cp	'&'		;check-digit bypass?
	jp	z,REGPRC	;yes,all done.
;
;coming here means dealing with a check digit error
;
	ld	a,0ffh		;
	ld	(CFLAG),a	;
	call	RSTBFF		;
	ld	a,00h		;
	ld	(CDFLG),a	;
	ld	(EFTFLG),a	;
	ld	a,07h		;set check digit error message
	call	KEYER7		;
	ld	hl,(FILCTR)	;
	dec	hl		;
	ld	(FILCTR),hl	;
	ld	hl,(BFNO)	;
	dec	hl		;
	ld	(BFNO),hl	;
	jp	NXTLPE		;
;
CD11J:	ld	a,30h		;make check-digit azero
	jp	CD11H		;
;
ADDLC:	db	00h		;check digit add location
WFACT:	db	00h		;weight factor
CDFLG:	db	00h		;check digit flag
CDCTR:	dw	0000h		;field length - 1 ctr.
CDSV:	db	00h		;
CDFPTR:	dw	0000h		;check-digit field pointer
CD10FL:	db	00h		;set on CD10 fields
OEFLG:	db	00h		;used during CD10-fields (odd/even add)
GENCD:	db	20h		;saved generated check digit
;
;
;the following multiplies a byte
;de = multiplicand
;a  = multiplier
;hl = result
;
MULBYT:	ld	hl,00h		;
	ld	b,8h		;
MULT:	add	hl,hl		;
	rla			;
	jp	nc,CHCNT	;
	add	hl,de		;
CHCNT:	dec	b		;
	jp	nz,MULT		;
	ret			;
;
;
;the following sets the CD10-flag for CD10 fields.
;
CD10:	ld	a,0ffh		;
	ld	(CD10FL),a	;
	jp	CD11		;
;
;the following handles the actual Check-digit 10 processing
;
CD10A:	ld	a,(OEFLG)	;
	cp	0ffh		;
	jp	z,CD10B		;go to bypass adding when flag set.
	ld	a,l		;get character to a-reg
	add	a,a     	;double a-reg
	daa			;decimal-adjustment
	ld	c,a		;save result in c-reg
	ld	a,0fh		;
	and	c		;mask out upper halfbyte
	ld	b,a		;and save in b-reg
	ld	a,0f0h		;
	and	c		;mask out lower halfbyte
	rrca			;
	rrca			;
	rrca			;
	rrca			;and shift to low byte
	add	a,b		;add the two halfbytes
	daa			;decimal adjust the result
	ld	c,a		;save result in c-reg
	ld	a,0ffh		;
	ld	(OEFLG),a	;set the odd/even flag
	jp	CD10C		;
;
CD10B:	ld	c,l		;
	ld	a,00h		;
	ld	(OEFLG),a	;clear the odd/even flag
;
CD10C:	ld	a,(ADDLC)	;
	add	a,c		;add add-location and character
	daa			;decimal adjust the result
	ld	(ADDLC),a	;save result
;
;subtract 10 from add-location if greater 10.
;
CD10D:	ld	c,a		;
	ld	a,10h		;
	cpl			;
	add	a,c		;
	jp	m,CD11D		;go for next character if < 10
	ld	a,c		;
	ld	c,10h		;
	sub	c		;
	daa			;
	ld	(ADDLC),a	;
	jp	CD10D		;
;
;now subtract c-reg from 10 to get check-digit
;
CD10E:	ld	a,10h		;
	sub	c		;
	daa			;
	cp	10h		;
	jp	z,CD11J		;make check digit zero
	jp	CD11K		;all done
;
;
;the following will display the last generated check-digit
;
DSPCD:	ld	a,(GENCD)	;get last generated check digit
	ld	hl,0ff86h	;
	ld	(hl),a		;display the CD on line 25
	jp	NXTLPE		;and return
;
;the following will handle the autoincrement field
;
;THE FOLLOWING HANDLES THE AUTOINCREMENT FIELD. IT USES THE ADD-REG.1 
;TO INCREMENT THE FIELD BY ONE AND SIMULATES A DISPLAY-REGISTER FIELD
;(TYPE Q) TO DISPLAY THE REGISTER.
;
AUTINC:	ld	a,(DEMODE)	;
	cp	01h		;verify mode?
	jp	z,BRFLD		;uncond. branch on verify mode.
AUTIN:	ld	a,(DEMODE)	;
	cp	02h		;update mode?
	jp	z,SETMSG	;yes treat as a normal numeric r/a fld.
	ld	a,0ffh		;
	ld	(AICFLG),a	;set autoinc flag
	jp	DUPFLD		;
;
;program comes back here after duplicating the field
;
AUTIN4:	LD	HL,(SOZ)	;
	LD	BC,90		;
	ADD	HL,BC		;
	LD	(AICSV2),HL	;SAVE CALCULATED START ADRESS OF REG 1
	LD	DE,AICSV1	;GET START OF REGISTER SAVE AREA
	ld	bc,15		;
	ldir 			;save current content of reg. 1
	ld	bc,(AICSV2)	;
	ld	hl,15		;
	ld	a,30h		;
	call	INBUFF		;now zero the register
	ld	hl,(AICSV2)	;
	ld	bc,14		;
	add	hl,bc		;get register end-ADDRESS
	ld	a,31h		;
	ld	(hl),a		;and make reg.-content = 1.
	ld	c,01h		;set c to reg.1 cnt
	ld	hl,R1FLG	;
	jp	REGPR7		;go and add reg.+field=reg
;
;program comes back here after the adding
;
AUTIN1:	ld	c,01h		;set reg.cnt to 1 again
	ld	a,00h		;
	ld	(TQFLG),a	;reset tq-field
	ld	hl,(BFNO)	;
	dec	hl		;
	ld	(BFNO),hl	;decrement binary field number
	jp	TQFLD2		;now go and display the field
;
;program comes back here after displaying the field
;
AUTIN2:	ld	hl,AICSV1	;
	ld	de,(AICSV2)	;
	ld	bc,15		;
	ldir			;restore register 1
	ld	a,00h		;
	ld	(TQFLG),a	;reset tq-flag
	ld	(AICFLG),a	;
	ld	a,(R0FLG)	;
	cp	0ffh		;test reg.0 flag
	jp	z,AUTIN3	;go if set
	ld	a,(R1FLG)	;
	cp	0ffh		;test reg.1 flag
	jp	nz,EOFLD	;go if not set
AUTIN3:	ld	a,0ffh		;
	ld	(REGFLG),a	;set register flag
	jp	EOFLD		;
;
AICSV1:	ds	15		;register 1 save area
AICSV2:	dw	0000h		;reg-adress save
AICFLG:	db	00h		;auto increment flag
;
;the following will display a register whose code will be entered
;by the user in the message line 25. legal codes are *,1-9,A-O.
;all othe codes will be ignored.escape will return to the entry-
;loop.
;
DSPREG:	ld	a,0ch		;
	call	DSPMSG		;set 'display register message'
	ld	hl,(SOFCBA)	;
	ld	(DSPRS1),hl	;save current crt pointer
DSPRE1:	ld	hl,0ffbbh	;
	ld	(SOFCBA),hl	;set crt pointer to display area
	ld	a,0ffh		;
	ld	(MLNFLG),a	;set message line flag
	call	INCCRS		;set cursor to message area
	call	CHRRD		;get character
	ld	(DSPRS2),a	;save character
	cp	1bh		;escape?
	jp	z,DSPRE9	;yes,prepare exit
	call	ANYRG3		;test character
	cp	00h		;illegal register code?
	jp	z,DSPRE1	;yes
	ld	a,(DSPRS2)	;get character again
	ld	hl,(SOFCBA)	;
	ld	(hl),a		;display character
	inc	hl		;
	ld	a,20h		;
	ld	(hl),a		;followed by a space
	ld	(SOFCBA),hl	;update crt-pointer
	ld	hl,(SOZ)	;get Z-base
	ld	de,75		;
	add	hl,de		;hl now points to start of reg.0
	ld	a,c		;
	cp	00h		;test reg.group 
	jp	z,DSPRE8	;go and display reg.0
	ld	a,(DSPRS2)	;
	ld	d,0fh		;
	and	d		;mask out upper 4 bits of character
	ld	d,a		;
	ld	a,c		;
	cp	01h		;reg.group 1 to 9?
	jp	nz,DSPRE6	;go if not.
	ld	a,d		;
	jp	DSPRE8		;go and display register
DSPRE6:	ld	a,09h		;
	add	a,d		;add offset for reg.group A to O
DSPRE8:	cp	00h		;right register?
	jp	z,DSPRE7	;yes,go and display it.
	ld	de,15		;
	add	hl,de		;step pointer to next register
	dec	a		;dec reg.ctr
	jp	DSPRE8		;
DSPRE7:	ld	de,(SOFCBA)	;
	inc	de		;set pointer
	ld	bc,15		;
	ldir			;mov reg.content to display area
	ld	a,20h		;
	ld	(de),a		;
	jp	DSPRE1		;and go for next character
;comes here after escape-character
DSPRE9:	ld	bc,0ffbbh	;get start of display area
	ld	hl,17		;
	ld	a,20h		;
	call	INBUFF		;space display area
	ld	hl,(DSPRS1)	;
	ld	(SOFCBA),hl	;restore crt-pointer
	ld	a,00h		;
	ld	(MLNFLG),a	;reset msg lne flag
	call	INCCRS		;
	jp	SETMSG		;all done , ret to entry loop
;
DSPRS1:	dw	0000h		;
DSPRS2:	db	00h		;
;
;
;the following will handle the field correction function . It will
;first subtract or add the current field content from/to the
;register ,if the field has assigned registers.Then it will 
;clear the field in the userbuffer and on the crt and allow 
;reeentry of the field in entry mode.the field correction function
;is allowed in verify - and update mode. In verify mode the 
;verify correction counter will be incremented and a field correction
;status will be set in the user interface.
;
FCORR:	jp	FCORR5		;bypass the mode check
;FCORR:	ld	a,(DEMODE)	;
	cp	01h		;verify mode?
	jp	z,FCORR5	;yes.
	cp	02h		;update mode?
	jp	z,FCORR5	;yes.
	ld	a,0ffh		;
	ld	(FNCFLG),a	;
	jp	KEYERR		;dont allow field correction
;
FCORR5:	ld	a,0ffh		;
	ld	(INTFLG),a	;
	call	NXTFDB		;
	call	GENFSB		;
	cp	0ffh		;
	jp	z,FCORR1	;end of field.
	cp	20h		;
	jp	z,FCORR1	;end of field.
	ld	hl,(FILCTR)	;
	inc	hl		;
	ld	(FILCTR),hl	;inc the field length
	ld	a,0ffh		;
	ld	(CFLAG),a	;set call flag
	call	REGCHK		;check for registers
	ld	a,00h		;
	ld	(CFLAG),a	;reset call flag
	jp	FCORR5		;keep looping
;
;the following will handle the correction of the registers (if any).
;
FCORR1:	ld	a,0ffh		;
	ld	(FCOFLG),a	;set field correction flag
	ld	hl,(BFNO)	;
	inc	hl		;
	ld	(BFNO),hl	;adjust binary field number ******
	ld	hl,(FILCTR)	;
	inc	hl		;
	ld	(FILCTR),hl	;adjust the field length
	jp	REGP99		;go and correct register
;
;program comes back here after register correction
;
FCORR2:	ld	hl,(FILCTR)	;
	dec	hl		;
	ld	(FILCTR),hl	;
	ld	hl,(BFNO)	;
	dec	hl		;
	ld	(BFNO),hl	; adjust field number  ********
	ld	a,0ffh		;
	ld	(CFLAG),a	;
	call	REGPR8		;get strt of bufferpointers
	ld	a,00h		;
	ld	(CFLAG),a	;
	ld	hl,(TQSV2)	;
	ld	(SOFCBA),hl	;get also crt-pointer
FCORR3:	call	GENFSB		;
	cp	0ffh		;end of field?
	jp	z,FCORR4	;yes.
	cp	20h		;
	jp	z,FCORR4	;yes.
	ld	hl,(SOFUBA)	;
	ld	a,20h		;
	ld	(hl),a		;space to userbuffer
	ld	hl,(SOFCBA)	;
	ld	a,2eh		;
	ld	(hl),a		;period to crt
	call	NXTFDB		;
	jp	FCORR3		;keep looping
;
;now prepare for reentrance of the field in entry-mode
;
FCORR4:	ld	a,(DEMODE)	;
	cp	01h		;verify mode?
	jp	nz,FCORR6	;no.
	ld	a,0ffh		;
	ld	(VCRFLG),a	;set verify correction status
FCORR6:	ld	a,00h		;
	ld	(DEMODE),a	;set entry-mode
	ld	(FCOFLG),a	;
	ld	(INTFLG),a	;reset int flag
	ld	a,0ffh		;
	ld	(FMFFLG),a	;set field corr flag
	ld	hl,(VCRCTR)	;
	inc	hl		;
	ld	(VCRCTR),hl	;inc the verify corr. ctr
	jp	ENTRY		;go to entry-loop
;
FCOFLG:	db	00h		;
;
	end
«eof»