|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 33024 (0x8100)
Types: TextFile
Names: »EEOFPRC.MAC«
└─⟦4f77bd9c1⟧ Bits:30005982/disk2.imd RC Computer - Turn Key Data Entry System - Vers. 1.91
└─⟦this⟧ »EEOFPRC.MAC«
└─⟦8417fc433⟧ Bits:30005982/disk1.imd RC Computer - Turn Key Data Entry System - Vers. 1.91
└─⟦this⟧ »EEOFPRC.MAC«
;*************************************************
;* *
;* MODULE : EEOFPRC.MAC (RC-850) *
;* DATE : 05.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
ext ATTSVE
ext ATTBYT
ext BLMVE
ext CHRCNV
ext BLINIT
;
;
CDDSP equ 0feb3h ;check digit display area
RGDSP equ 0ff1bh ;register display area
RSTCHR equ 01h ;reset key
;
;
;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 c,a ;
call CHRCNV ;
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 a,(ATTBYT) ;
ld (ATTSVE),a ;
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 ;
dec hl ;
ld (SOFCBA),hl ;
ld a,(ATTSVE) ;
ld (ATTBYT),a ;
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
inc de ;
ld a,(ATTSVE) ;
ld (de),a ;
ld a,(FLLCHR) ;
ld (hl),a ;fill character in its place
ld a,(ATTSVE) ;
inc hl ;
ld (hl),a ;
dec de ;
dec de ;
dec de ;
dec hl ;
dec hl ;
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 ;
ld (RAFSV5),a ;
ld a,(ATTSVE) ;
inc hl ;
ld (hl),a ;
dec hl ;
dec hl ;
dec hl ;
ld a,(RAFSV5) ;
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 ;
RAFSV5: db 00h ;
;
;
;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 ;
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,(ATTBYT) ;
ld (ATTSVE),a ;
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) ;
ld a,(ATTSVE) ;
ld (ATTBYT),a ;
call BLMVE ;
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) ;
dec hl ;
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 ;
ld hl,(SOFCBA) ;
dec hl ;
dec hl ;
dec hl ;
dec hl ;
ld (SOFCBA),hl ;
ld hl,(SOFFBA) ;
dec hl ;
dec hl ;
ld (SOFFBA),hl ;
ld hl,(SOFUBA) ;
dec hl ;
dec hl ;
ld (SOFUBA),hl ;
call NXTFDB ;
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,CDDSP ;
ld (hl),a ;display the CD on line 25
ld a,00h ;
inc hl ;
ld (hl),a ;
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
ld a,(ATTBYT) ;
ld (ATTSVE),a ;
DSPRE1: ld hl,RGDSP ;
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 RSTCHR ;reset key?
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,00h ;
ld (hl),a ;
inc hl ;
ld a,20h ;
ld (hl),a ;followed by a space
inc hl ;
ld a,00h ;
ld (hl),a ;
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 ;
call BLMVE ;mov reg.content to display area
ld a,20h ;
ld (de),a ;
inc de ;
ld a,00h ;
ld (de),a ;
jp DSPRE1 ;and go for next character
;comes here after escape-character
DSPRE9: ld bc,RGDSP ;get start of display area
ld hl,17 ;
ld a,(ATTBYT) ;
ld (ATTSVE),a ;
ld a,00h ;
ld (ATTBYT),a ;
ld a,20h ;
call BLINIT ;space display area
ld a,(ATTSVE) ;
ld (ATTBYT),a ;
ld hl,(DSPRS1) ;
ld (SOFCBA),hl ;restore crt-pointer
ld a,00h ;
ld (MLNFLG),a ;reset msg lne flag
call INCCRS ;
ld a,(ATTSVE) ;
ld (ATTBYT),a ;
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: ld a,(ATTBYT) ;
ld (ATTSVE),a ;
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
ld a,(ATTSVE) ;
inc hl ;
ld (hl),a ;
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»