|
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: 19072 (0x4a80) Types: TextFile Names: »FFMTINT.MAC«
└─⟦77f87173f⟧ Bits:30005981/disk3.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90 └─⟦this⟧ »FFMTINT.MAC«
;************************************************* ;* * ;* MODULE : FFMTINT.MAC (RC-700) * ;* DATE : 01.02.82 * ;* BY : ASE GmbH , 6472 Altenstadt * ;* VERSION: 1.90 * ;* * ;************************************************* ; ; THIS MODULE WILL VERIFY THE ENTERED FORMAT DEFINITIONS AFTER THE ; USER HAS ENTERED THEM. ; THIS MODULE IS USED DURING 'FORMAT' AND 'FORMAT-UPDATE' MODE ONLY. ; ; PUBLIC CRFLG PUBLIC FMTINT PUBLIC INTFLG PUBLIC GENFSB PUBLIC CLDEF PUBLIC CHKBTE PUBLIC INITFL PUBLIC NXTFDB ; ext CLRCUR ext ILLFRM ext INTCRT ext FILCTR ext BCPCTR ext ENTCPL ext INBUFF ext SOFFBA ext BFNO ext SOFCBA ext DEMODE ext VFCTR ext SOFUBA ext UBFADD ext DSPMSG ext CONBTA ext CHRRD ext FRMCHN ext VFPCTR ext CBFADD ext F05FLG ext FSFLG ext DUPFLG ext FRMFLG ext FRMLNG ext KEFLG ext FORMAT ext FBFADD ext ALLINC ext CFLAG ext CTRLH ext HOME ext FLOOP ext INCCRS ext FRMCPL ext CHRCNV ext co ext ci ; SPACE equ 20h ESCCHR equ 1bh CTRLQ equ 11h BELL equ 07h CHEX equ 12h ENDCRT equ 0ff7fh VFPCRT equ 0ff80h ;variable position display in ln 25 ; ; ; ;the following checks the entered format ; FMTINT: ld a,(DEMODE) ; cp 03h ;format mode? jp z,FMTIN1 ;yes it is. cp 04h ;format update mode? call nz,INTCRT ;no,clear and build the crt. FMTIN1: call CLDEF ;clear and init all DE-Flags ld a,0ffh ; ld (INTFLG),a ; call CLRCUR ;set cursor to 1 ld a,(KEFLG) ;clear line 25 cp 0ffh ;if key error flag is set call z,BLKLN ; ; ; ld hl,(SOFFBA) ;get FDB ld a,(hl) ;to a-reg GENCHK: cp 'E' ;is it an End of format? jp z,ENDCHR ;yes. cp SPACE ; jp z,GENCH2 ; call GENFSB ;check for any FSB's cp 0ffh ; jp z,FSBCHK ;yes it is an FSB. cp 55h ; jp z,ERR1 ;error , hex'00' found cp 0h ; jp z,GENCH1 ;should be a fld-strt byte cp SPACE ; jp z,GENCH2 ; ERR1: jp KERTRY ;allow manual correction ; GENCH1: ld a,c ;restore a-reg jp VARFL1 ; ; GENCH2: call NXTFDB ; jp GENCHK ; ; ;this will xlate the crt control character (upper half of the FSB) ;and move it to the crt. ; FSBCHK: ld hl,(SOFFBA) ;get FDB ld c,(hl) ;to c-reg. ld a,0f0h ;mask out the and c ; cp 80h ;fsb. is it normal display? jp nz,FSBCH1 ;no ld hl,(SOFCBA) ;yes set ld b,128 ;the normal display ld (hl),b ;control character jp FSBCH3 ; ; FSBCH1: cp 90h ;is it blinking? jp nz,FSBCH0 ;no ld hl,(SOFCBA) ;yes , set ld b,130 ;the blinking ld (hl),b ;control character jp FSBCH3 ; ; FSBCH0: cp 0b0h ;is it blink. and inverted? jp nz,FSBCH2 ;no ld hl,(SOFCBA) ;yes set ld b,146 ;the blk/inv. display ld (hl),b ;control character. jp FSBCH3 ; ; ; FSBCH2: ld hl,(SOFCBA) ;must be inverted display! ld b,144 ; ld (hl),b ; ; FSBCH3: ld a,0fh ;mask out the and c ;crt control cp 05h ;is it 05(fixed field) jp z,FXFLD ;yes,go fixed field cp 06h ;format-duplication field? jp z,FDFLD ;yes,go format-dup field. ; ; arriving here means we have a FSB in the range ; X1-X4 , i.e. a variable field. ; VARFLD: call NXTFDB ;get next fdb VARFL1: cp '+' ;is it a jp z,VARF13 ;auto-inc. field. ; ;the following instructions are an addittion to the RRZ-KASSEL ;system only and have been 'commented out'. ; ; cp '?' ;date-field? ; jp z,VARF13 ;yes. ; cp '(' ;date field and dup ? ; jp z,VARF13 ;yes ; cp '<' ;range check 1 field? ; jp z,VARF13 ;yes. ; cp '=' ;range check 2 field? ; jp z,VARF13 ; jp VARFL4 ; VARF13: call SETDUP ;set the call INCVFP ;inc the var.pos.ctr call CHKMDE ; call BLDFPT ;build field pointer entry jp FCCNUM ;dupflag VARFL4: ld b,a ;check the ld a,40h ;field start byte range and a ; sub b ; jp p,VARERR ;<A;not a field start byte ld a,5ah ; cpl ; add a,b ; jp p,VARERR ;>Z;not a field start byte ld hl,(SOFFBA) ;get the current ld a,(hl) ;FDB again ld b,41h ;build offset sub b ;into the ld hl,FDBTAB ;get FDB/FCC Table ld c,a ; ld b,0 ; add hl,bc ;got pointer in hl ld a,(hl) ;got content of table in a-reg ld hl,VARSVE ;save it ld (hl),a ;for later ; cp 0ffh ;is it a legal field start byte? jp z,VARERR ;no its not. ; ;arriving here means having a legal Field start byte ; call INCVFP ; call CHKMDE ; ; call BLDFPT ;build field pointer table entry call CHKMDE ; ; ; VARFL3: ld hl,VARSVE ;get the saved ld a,(hl) ;FDBTAB-Content to a-reg. cp 01h ; jp z,FCCALP ;go to alpha FCC cp 02h ; jp z,FCCNUM ;go to numeric FCC cp 03h ; jp nz,VARFL5 ;its not a numeric with dup function call SETDUP ;yes,set Dup-flag jp FCCNUM ;go to numeric fcc ; ; VARFL5: cp 04h ;is it alpha dup fdb? jp nz,VARFL6 ;no. call SETDUP ;yes. jp FCCALP ;and go to alpha fcc ; ;coming here means that we should have found the ;end of format character. ; VARFL6: cp 0eeh ; jp nz,VARERR ;must be format-error call DECVFP ; ld bc,(VFCTR) ; dec bc ;dec the VFCTR ld (VFCTR),bc ; jp ENDCHR ; ; ;this is the first level of the numeric checks. ; FCCNUM: call CHKMDE ; call NXTFDB ;get next fdb call INCVFP ; FCCNM1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ;back to the front. cp ':' ; jp z,FCCNUM ;numeric must fill cp '-' ; jp z,FCCNUM ;normal numeric call ANYREG ;check for possible register code cp 0ffh ; jp z,FCCNUM ;yes,its areg.,go for next fdb ld a,c ; cp 'E' ;end of format? call z,DECVFP ; jp z,ENDCHR ;yes call GENFSB ;test for FSB's. cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes it is an FSB cp 55h ; jp z,FCNUME ;fcc num.error. ; ;numeric fcc error routine ; FCNUME: jp KERTRY ;get manual correction ; ;this checks for numeric,must-fill fields ; NUMMFL: call CHKMDE ; call NXTFDB ;get next fdb call INCVFP ; NUMFL1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ;its a space , back to the start cp ':' ; jp z,FCCNUM ;regular num.must fill,get next fcc call ANYREG ;check for registers cp 0ffh ; jp z,FCCNUM ; ld a,c ; cp 'E' ;end of format? call z,DECVFP ; jp z,ENDCHR ;yes. call GENFSB ;check for any FSB cp 55h ; jp z,NMMFLE ;num.must fillerror cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes its anm FSB NMMFLE: jp KERTRY ;error correction ; ;this checks for normal,numeric fcc's ; NUMNRM: call CHKMDE ; call NXTFDB ;get next fdb call INCVFP ; NMNRM1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ;its aspace cp '-' ; jp z,FCCNUM ;normalnum., get next fdb call ANYREG ;check for reg.code cp 0ffh ; jp z,FCCNUM ;its a reg.,get next fdb ld a,c ; cp 'E' ;end of format? call z,DECVFP ; jp z,ENDCHR ;yes. call GENFSB ;check for possible FSB cp 55h ; jp z,NMNRME ;error cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes its an FSB NMNRME: jp KERTRY ;error correction ; ;this is the first level in the alpha checks. ; FCCALP: call CHKMDE ; call NXTFDB ;get next format call INCVFP ; FCCAL1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ; cp '-' ; jp z,FCCALP ;mixed fcc's in an alpha field cp '.' ; jp z,FCCALP ;mixed fcc's in an alpha field cp ';' ; jp z,FCCALP ;alpha must fill cp ':' ; jp z,FCCALP ;num.must fill in alpha field call GENFSB ;check for any FSB's cp 55h ; jp z,FCCALE ;error cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes its an FSB FCCALE: jp KERTRY ;get correction ; ;this checks alpha must fill fields ; ALMFL: call CHKMDE ; call NXTFDB ;get next fdb call INCVFP ; ALMFL1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ;yes it is a space cp 'E' ; call z,DECVFP ; jp z,ENDCHR ;its the end of format cp ';' ; jp z,FCCALP ;regular must fill alpha cp ':' ; jp z,FCCALP ;regular must fill numeric call GENFSB ; cp 55h ; jp z,ALMFLE ;error cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes its a FSB ALMFLE: jp KERTRY ;get error correction ; ;this checks normal alpha fields with mixed fcc's ; ALPMIX: call CHKMDE ; call NXTFDB ;get next fdb call INCVFP ; ALPMX1: cp SPACE ; call z,DECVFP ; jp z,GENCHK ; cp 'E' ; call z,DECVFP ; jp z,ENDCHR ; cp '.' ; jp z,FCCALP ;normal alpha cp '-' ; jp z,FCCALP ;normal num.fcc call GENFSB ;check for FSB's cp 55h ; jp z,ALPMXE ;error cp 0ffh ; call z,DECVFP ; jp z,FSBCHK ;yes,its an fsb ALPMXE: jp KERTRY ;get manual correction ; ;this handles fixed fields (mask fields) ; FXFLD: call NXTFDB ;get next fdb FXFLD1: ld c,a ; call GENFSB ;check for FSB's cp 0ffh ; jp z,FSBCHK ;yes found one cp 55h ; jp z,FXFLDE ;error ld hl,(SOFCBA) ;move the character call CHRCNV ;to the crt jp FXFLD ;go for next FXFLDE: jp KERTRY ;get manual correction ; FXDFL2: ld a,0 ;clear the ld (FXFFLG),a ;fixed field flag call NXTFDB ; jp GENCHK ;back to front level ; FXFFLG: ds 1 ;fixed field flag ; ;the following handles the format-duplication fields, which moves ;data from the format-record to the duplication buffer from which it ;will be automatically duplicated into the data-buffer when in ;entry-mode and the field has been encountered. ;this is an addittion to the RRZ-KASSEL system which has been left ;in the standard system as an enhancement. ; ; FDFLD: call NXTFDB ;step the counters call BLDFPT ;make field entry FDFLD1: call GENFSB ; cp 0ffh ;fsb? jp z,FSBCHK ;yes. cp 55h ; jp z,KERTRY ;go on format-error ld hl,(SOFCBA) ; call CHRCNV ;move char. to crt. call INCVFP ;inc no. of var. pos. call NXTFDB ; jp FDFLD1 ; ; ;the following are all the macro's used by the format checking. ; ;; ; ;setdup will set the duplicate flag on any of the following ;fdb's : D , U , L , M , + . ; SETDUP: ld a,0ffh ; ld hl,DUPFLG ; ld (hl),a ;set the flag ret ;ret to caller ; ; VARERR: jp KERTRY ;get manual correction ; ;the following will check wether the current fdb is a ;legal FSB.After execution the fdb will be aviallable ;in the c-reg.this routine is also used to analyse normal ;keyboard input characters in non-formatting modes , in these ;cases the CHKBTE (check byte) entrance is used . a character is ; expected in the a-reg.the following codes will be returned ;in the a-reg.: ; 00 = not an FSB , normal asccii character on formatting ; modes or ascii range 21-2f on other modes ; 55 = not an FSB but anything in the range 00-1f ; (error on formatting modes and a possible ; function key on other modes) ; FF = an fsb has been found. ; 20 = a space has been found ; 01 = ascii range 30 - 39 (numeric) on non-formatting modes ; (not used on formatting modes) ; 02 = ascii range 40 - 7e (alpha) on non-formatting modes ; (not used on formatting modes) ; ; GENFSB: ld hl,(SOFFBA) ;get current ld a,(hl) ;fdb CHKBTE: ld c,a ;save it in c cp 20h ; ret z ;its aspace character,return bit 7,a ;test bit 7 jp z,NRMCHR ;check if normal asccii ; ;check for FSB from 81 to 86 ; ld c,a ; ld a,80h ; and a ; sub c ; jp p,FSBERR ;not an FSB , < then 81 ld a,86h ; cpl ; add a,c ; jp m,FSBNRM ;its an FSB , not > then 86 ; ;check for 91 to 96 ; ld a,90h ; and a ; sub c ; jp p,FSBERR ;not an FSB , < then 91 ld a,96h ; cpl ; add a,c ; jp m,FSBNRM ;not an FSB , > then 96 ; ;check for A1 to A6 ; ld a,0a0h ; and a ; sub c ; jp p,FSBERR ;< then A1 ld a,0a6h ; cpl ; add a,c ; jp m,FSBNRM ;its an FSB , not > then A6 ; ;check for B1 to B6 ; ld a,0b0h ; and a ; sub c ; jp p,FSBERR ; ld a,0b6h ; cpl ; add a,c ; jp m,FSBNRM ;its an FSB , not > then B6 ; ;the following checks the asccii range from ;21 t0 2f . ; NRMCHR: ld a,20h ; and a ; sub c ; jp p,FSBERR ; ld a,2fh ; cpl ; add a,c ; jp m,FSBCHR ;yes its normal asccii ; ;the following checks the ascii range 30-39 (numeric) ; NMPCHR: ld a,39h ; cpl ; add a,c ; jp m,FSBNMR ;its a numeric 0 - 9 ; ;the following checks the ascii range 40-7e (alpha) ; ALPCHR: ld a,7eh ; cpl ; add a,c ; jp m,FSBALP ; ; ; FSBERR: ld a,55h ; ret ; FSB-error return ; FSBNRM: ld a,0ffh ; ret ; FSB found return ; FSBCHR: ld a,00 ; ret ;normal asccii return FSBNMR: ld a,00h ; ret ; ; FSBALP: ld a,00h ; ret ; ; ; ;the following will inc the buffers and cursor and load the ;next FDB to a-reg. ; NXTFDB: ld hl,ENDCRT ; ld de,(SOFCBA) ;last position on crt ? and a ; sbc hl,de ; jp z,ENDERR ;yes,no end of format found call ALLINC ;inc the buffers and cursor ld hl,(SOFFBA) ; ld a,(hl) ;get next fdb ret ;return ; INTFLG: ds 1 ;int-flag , if set prevents cur.pos.upd. ; ENDERR: ld a,(DEMODE) ; cp 00h ;entry-mode? jp z,ILLFRM ;exit to user interface cp 01h ;verify-mode? jp z,ILLFRM ; cp 02h ;modify-mode? jp z,ILLFRM ; ld a,02h ; call DSPMSG ;msg no end of format ld a,07h ; call co ;beep the user call CHRRD ; ld a,83h ;ret to call DSPMSG ;format entry pop hl ;decrement the stack ld a,00h ;reset ld (INTFLG),a ;the int-flag jp HOME ;on any character ;; ;the following will indicate a format-error to the user and return ;to format-entry after displaying a message ; ; KERTRY: ld a,(DEMODE) ; cp 00h ;entry-mode? jp z,ILLFRM ;exit to user interface. cp 01h ; jp z,ILLFRM ; cp 02h ;modify-mode? jp z,ILLFRM ; ld a,01h ; call DSPMSG ;format error message KELOOP: ld c,BELL ; call co ;beep the user KELP1: call CHRRD ; ld a,00h ; ld (INTFLG),a ;reset int-flag call INCCRS ;set the cursor ld a,83h ;set enter call DSPMSG ;format message jp FLOOP ;return to enter format level ; ; ; ;the following handles the end of format character. ; ENDCHR: ld a,0 ; ld (ENDCTR),a ;clear the end Ctr ld a,0ffh ;set ld (ENDFLG),a ;endflag call BLDFPT ;build field pointer table entry for E ld a,00h ;reset ld (ENDFLG),a ;endflag ld hl,(SOFFBA) ; inc hl ; ld (ENDSVE),hl ;save the format buffer address ld a,00h ; ld (INTFLG),a ;reset int-flag ENDCH1: call ALLINC ; call GENFSB ; cp 00h ;regular asccii? jp nz,KERTRY ;no,error. ld a,2fh ; and a ; sub c ; jp p,KERTRY ;error < 30h ld a,39h ; cpl ; add a,c ; jp p,KERTRY ;error > 39h ld a,c ; cp 30h ; jp z,ENDCH9 ;if zero go. ld a,0ffh ; ld (ZROFLG),a ; ENDCH8: ld a,(ENDCTR) ; cp 02h ; jp z,ENDEXT ;full form chain key checked. ld a,(ENDCTR) ; inc a ;inc the ctr. ld (ENDCTR),a ; jp ENDCH1 ;go for next round ENDEXT: ld a,(ZROFLG) ; cp 00h ; jp z,KERTRY ;format-chain-key all zero! ld a,0h ; ld (ZROFLG),a ;reset the zroflg ld hl,(ENDSVE) ; ld de,FRMCHN ; ld bc,03h ; ldir ; ld a,(DEMODE) ;check cp 03h ;for jp z,FRMMDE ;format mode cp 04h ; jp z,FRMMDE ; ld a,0ffh ; ld (INITFL),a ;set the format-initialized flag ENDCH7: jp ENTCPL ;assume field 0,exit to user*********** FRMMDE: ld a,04h ;display call DSPMSG ;the format complete ld a,(CRFLG) ;is the carriage return flag set? cp 0ffh ; jp z,ENDCH3 ;yes jp FRMCPL ;format complete , ret to user interf. ; ENDCH3: ld ix,VFPCRT ; ld hl,(VFPCTR) ; call CONBTA ;display no.of var.positions ld a,0h ; ld (CRFLG),a ; jp KELP1 ; ; ENDCH9: ld a,(ZROFLG) ; cp 0ffh ; jp z,ENDCH8 ; ld a,0h ; ld (ZROFLG),a ;set the format-chain-key zero flag jp ENDCH8 ; ; ENDSVE: ds 2 ;save for SOFFBA at start of FRMCHN ENDCTR: ds 1 ;ctr for # of formchainkey bytes CRFLG: ds 1 ; ENDFLG: ds 1 ;set on field table entry on end (E) INITFL: db 0h ;format initialized-flag ZROFLG: db 0h ;format-chain-key- zero flag ; ; ;the following is used to clear the major flags and pointers. ; CLDEF: ld bc,0h ;clear the ld (VFPCTR),bc ;VFPCTR ld (VFCTR),bc ;clear the variable field ctr. ld (BCPCTR),bc ;clear backward pos.ctr. ld (FILCTR),bc ;clear field length ctr. ld bc,(FBFADD) ;reset ld (SOFFBA),bc ;buffer address ld bc,(UBFADD) ;reset ld (SOFUBA),bc ;the user buffer address ld bc,(CBFADD) ; ld (SOFCBA),bc ;crt buffer address ld a,0h ; ld (FXFFLG),a ; ld (INTFLG),a ; ld (F05FLG),a ; ld (ENDFLG),a ; ld (FSFLG),a ; ld (DUPFLG),a ; ld (FRMFLG),a ; and a ; sbc hl,hl ; ld (VFCTR),hl ; ld de,01h ;set format length ld (FRMLNG),de ;to 1 ret ;return to user ; ; ;the following will blank line 25 ; BLKLN: ld a,00h ;set msg.number call DSPMSG ;display it ret ;ret to caller ; ;the following will check all possible register codes ;and will return with 0ffh in a-reg if a reg has been found, ;otherwise the a-reg will be zero. ; ANYREG: ld hl,(SOFFBA) ;get current ld a,(hl) ;fdb to a-reg cp '*' ;is it the multiplik,reg.? jp z,ANYRG1 ;yes cp 40h ; jp z,AREGER ;error ld c,a ; ld a,30h ; and a ; sbc a,c ; jp p,AREGER ; ld a,39h ; cpl ; add a,c ; jp m,ANYRG1 ;ok , not more then 39h ld a,40h ; and a ; sbc a,c ; jp p,AREGER ;out of range;<41h ld a,4fh ; cpl ; add a,c ; jp p,AREGER ;out of range;>4fh ANYRG1: ld a,0ffh ;legal register found ret ; AREGER: ld a,0 ;out of range ret ;return INCVFP: push hl ; ld hl,(VFPCTR) ; inc hl ; ld (VFPCTR),hl ; pop hl ; ret ; ; DECVFP: push hl ; ld hl,(VFPCTR) ; dec hl ; ld (VFPCTR),hl ; pop hl ; ret ; ; ; CHKMDE: push af ; ld hl,(SOFCBA) ; ld de,(SOFFBA) ; ld a,2eh ;display a period in place CHKMD2: ld (hl),a ;of a variable field position pop af ;on all modes ret ; ; ; ;the following are definitions and tables used by the format. ; VARSVE: ds 1 ;save byte for FSB/FCC Table (FDBTAB) ; ;the FDBTAB is a 2-way table which tells the field start to ;field continuation relationship. ; FDBTAB: db 01h ;A db 02h ;B db 02h ;C db 03h ;D db 0eeh ;E db 02h ;F db 02h ;G db 02h ;H db 01h ;I db 02h ;J db 01h ;K db 03h ;L db 03h ;M db 02h ;N db 01h ;O db 02h ;P db 02h ;Q db 02h ;R db 02h ;S db 02h ;T db 04h ;U db 02h ;V db 01h ;W db 02h ;X db 02h ;Y db 01h ;Z ; ;the following routine will check the max. number of fields per ;format and maintain the var.-field-ctr. ; ; BLDFPT: ld bc,(VFCTR) ; LD HL,125 ; sbc hl,bc ;max.no of fields reached? jp m,FLDERR ;yes. ld a,(ENDFLG) ; cp 0ffh ; jp z,ENDFLD ;it must be the end of format! BLDFP1: ld bc,(VFCTR) ;inc inc bc ;the ld (VFCTR),bc ;no. of variable fields. ret ; FLDERR: ld a,05h ; call DSPMSG ;display error message pop hl ;pop the stack ld hl,0h ;clear the ld (VFCTR),hl ;var.field counter JP KELP1 ;AND GET CORRECTION ; ENDFLD: jp BLDFP1 ; ; end «eof»