|
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: 31616 (0x7b80) Types: TextFile Names: »EEOFPRC.MAC«
└─⟦77f87173f⟧ Bits:30005981/disk3.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90 └─⟦this⟧ »EEOFPRC.MAC«
;************************************************* ;* * ;* 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»