title FORMIS routines to handle form and fields ; ; ; equates for assembly ; INCLUDE RSOPT.INC entry addacc,addbase entry cbldes,cblock,cbreaks,chain,ckfree,clrend,copyright,curdsk,dsptch,exit entry fcols,fields,fimage,filedk,filen,flines entry fndblk,fndfld,formid,forms,freest entry getlen,getoff,getnxo,gtform entry indptr,initms,ldbs,lenedw,lenit0 entry msclose,msgfcb,nxfree,nxtfdb,nwform entry plines,ptitem,ptitma entry resdsk,rdform entry setdsk,staacc,stachr,stackp,startm,stkptr entry upper,vrname IF RE entry abort,inform,memovf,noname,pntitm,prvfdb,wtform,mkform ENDIF ; entry fldptr,skpoff ;these entries not present anymore !!! ; FIRST ext coprit ; copyright ext idtex,pidtex ; hardware ext prottx,pdrvtx ext signon ;version text ext msgver ;version of message file to use ext xpret ;external program return ; USER ext hite,wid ext pbgmem ;end of program ext system ;system disk drive ; TIF ext endcur ;position cursor at form end ; IOPACK/USER ext getif ;get input if waiting ext inputc ;input character ext printc ;print character in C (used for echo) ext chrout ;print character in C ext mycur ;curretn cursor position ext dspmsg ;display message from current position ext dsplay ;display message from cursor position in BC ext clears ;clear screen ext msgrsp ;display message and get responce ext readbf ;read line like CP/M call ext wtline ;wait for display of all requests ext clrline ;clear lines on screen ext hite ;number of lines on screen IF KANJI ext knjtst ;test if byte in the ACC is first of a KANJI character ext knjflg ;set when KANJI character input in IOPACK ENDIF ; FORMGEN/KAM ext mult ;multiply routine ext copyhl,cmpde ext imdos ;imdos simulator ext defdma ;set default dma address ext fopen ;file open ext fmake ;extent creation ext eosdsk ;last disk used ext dskset ;set disk for chain if RE ext abtms1,abtms3 ext abtms4,abtms5 endif ; REMSG/ISMSG ext mstart ;message module length, memory resident portion ext ind1st,indlst ;message offset list start and end ext chainm,chname ext gtfrms,crlfm ext fdmsg,fdmsg1 ext fdmsg2,fdmsg3 ext msgdsk ext fnameb,fname,fncnt ;report name ext bufend ;message buffer end ext bufbeg ;message buffer start ext rdnext ;where to put in buffer ext numadj,nm2adj ;number of addresses to adjust ext endfix ;end of fixed length portion ext fixlen,varlen ;message file lengths ext copym1,copym2 ;copyright message ; DEFLD/MAIN/FEDIT ext gloopc ;get loop count ext erchar ;put character into error message page 60 ; if RE ext ourfdb ;DEFLD current ddb ext move ;FDB move fdb item ext adjoff ;FDB adjust offset in ddb ext gtfdbnum ;FDB get fdb number ext skpnms ;DEFLD skip field names, for number in ACC ext memout ;FORMGEN out of memory endif if IS ext cswtch,posmth ;used to identify which print driver to use ext drvrst ;where to put it ext nofmsg ;ISMSG ext bdfmsg,erfmsg ;ISMSG ext nofrm2,nofrm1 ;ISMSG ext memerr,fdberr ;FEDIT ext getans ;FEDIT ext stvoln ;MAIN ext dmaddr ;KAM IF KANJI drvrln equ 7F0H ;driver length ELSE drvrln equ 6F0H ;driver length ENDIF endif ; ; equates ; nx equ 1 ;message continued flag cx equ 4 ;message continued but don't add base cr equ 0DH nmdisk equ 16 ;number of disk drives allowed ctrlc equ 3 esc equ 1BH ctrlz equ 1AH nparms equ 13 ;number of report parameters maxexp equ 0EFH ;maximum expression length dsmin equ 13 ;min FDB length for DS fdbs oplstl equ 8 ;option list length flnmsk equ 3FH ;field name length mask IF HILITE remvid equ 7FH ELSE remvid equ 0FFH ENDIF ; ; ; error codes for logerr ; e$mask equ 3FH ;error type mask f$mask equ 80H ;fatal error mask e$warn equ 000H ;warning e$err equ 040H ;field error e$serr equ 080H ;semi-fatal error e$ferr equ 0C0H ;fatal error e$ior equ 1+e$warn ;invalid output record e$stb equ 2+e$warn ;string overflow destination e$alph equ 3+e$warn ;non-numeric data e$zer equ 4+e$err ;divide by zero e$ofd equ 5+e$err ;numeric overflow destination e$inf equ 6+e$err ;index record not found e$xof equ 7+e$serr ;exponent overflow e$memx equ 8+e$serr ;out of for expresson calculation e$ipl equ 9+e$ferr ;illegal page length e$ill equ 10+e$ferr ;illegal expression e$fdb equ 11+e$ferr ;bad fdb e$adkf equ 12+e$ferr ;abort for disk full e$mem equ 13+e$ferr ;out of memory page ; FILE DEFINITION BLOCK dforms equ 0 ;item number of forms count ddtype equ 2 ;offset for type byte dt.ovw equ 1 ;overwrite if output (internal use, not set in file) dt.key equ 2 ;keyed dt.ndx equ 8 ;write index if output, follow index order if input ;dt.upd equ 8 ;allow update if input (unused) ;dt.pre equ 10H ;presorted if input (unused) dt.mvf equ 20H ;multi-volume dt.app equ 40H ;append if output dt.out equ 80H ;input = 0, output = 80H ddmisc equ 3 ;offset for misc byte dm.ent equ 1 ;enter names at run time dm.def equ 2 ;use default name dm.exp equ 4 ;exclusion expression present dm.aim equ 8 ;file already in memory ;dm.soc equ 10H ;NZ if sort order was changed (unused) dddisk equ 4 ;offset for form disk ddname equ 5 ;offset for form name ddbuf equ 13 ;offset of number of buffers ddbcon equ 14 ;end of constant portion ddb equ 40H ;flag for a ddb item lpf equ 0C0H ;flag for a loop item ddsort equ ddb+1 ;item number for sort fields (2 bytes per field) ddsfld equ lpf ;item number of sort field number ddsflg equ lpf+1 ;item number of sort flag ds.dsc equ 1 ;descending ds.str equ 2 ;string ddslen equ 2 ;number of bytes ddfnms equ ddb+2 ;item number of number of names (12 bytes per file) ddfdsk equ lpf+2 ;item number for file disk df.chd equ 80H ;change disks ddfnam equ lpf+3 ;item number for file name ddftyp equ lpf+4 ;item number for file type ddflen equ 12 ;number of bytes ddexpl equ ddb+3 ;item number of exclusion expression length ;ddeexp equ ddb+4 ;item number for end file expression length (unused) ddnflds equ ddb+5 ;item number for number of fields in form ddfuse equ lpf+5 ;item number for field is used code (internal use only) df.use equ 1 ; bit for is used (internal use only) dddlen equ 1 ; number of bytes per field (internal use only) dd.int equ 80H ; intermediate field page ; FIELD DEFINITION BLOCK fdlen equ 2 ;offset of field length fdaddr equ 3 ;form/equblk address (internal use only) fdcol equ 3 ;offset of column in form image fdline equ 4 ;offset of line in form image fdtype equ 5 ;offset of field type ft.src equ 3 ;field source mask ft.fil equ 0 ;file ft.clc equ 1 ;calc ft.inp equ 2 ;input ft.coi equ 3 ;calc or input ft.str equ 4 ;string calc ft.out equ 8 ;output field ft.equ equ 40H ;field is equivalenced fdedit equ 6 ;offset of edit flags fe.rj equ 1 ;right justified fe.edm equ 2 ;edit mask ;fe.rmi equ 4 ;strip edit characters on input (unused) ;fe.rmo equ 8 ;strip edit characters on output (unused) fe.cbd equ 10H ;field is control break dependent fe.pgd equ 20H ;field is page dependent fe.da equ 80H ;decimal aligned fdpad equ 7 ;offset of pad character fdifil equ 8 ;offset of input file number fdifld equ 9 ;offset of input field number fdindx equ 10 ;offset of input index field if reference fdofil equ 11 ;offset of output file number fdofld equ 12 ;offset of output field number fdondx equ 13 ;offset of output index field if reference fdcbl equ 14 ;offset of control break level fdequ equ 15 ;offset of equivalent field fdbcon equ 16 ;length constant portion fdb equ 80H ;flag for fdb item fdedw1 equ fdb+1 ;item number of mask part I fdedw2 equ fdb+2 ;item number of mask part I fdcexp equ fdb+3 ;item number of calculation expression length fdinp equ fdb+3 ;item number of input expression length (if no calc) fdclpc equ fdb+4 ;item number of UNLESS/THEN expression count fdclex equ lpf+6 ;item number of UNLESS expression fdctex equ lpf+7 ;item number of THEN expression fdclen equ 2 ;number of bytes to add/remove in maintaining the loop fdlexp equ fdb+5 ;item number of load expression length ;fdoexp equ fdb+6 ;item number of output expression length (unused) fdkexp equ fdb+7 ;item number of clear if expression fdname equ fdb+8 ;item number of field name ; LINE DEFINITION BLOCK ldlen equ 2 ;offset of field length ldcol equ 3 ;offset of column in form image ldline equ 4 ;offset of line in form image ldpexp equ 5 ;offset of print expression ; CONDITIONS DEFINTION BLOCK cdb equ 50H ;flag for conditions block item cdbcon equ 5 ;length of constant portion cdpexp equ cdb+1 ;item number of end page expression cdrexp equ cdb+2 ;item number of end report expression ; ; datastar offsets and bits ; ds.nam equ 40H ;datastar field is named ds.int equ 1 ;intermediate field dsedit equ 6 ;edit control byte ds.edw equ 2 ;edit word ds.rng equ 4 ;range ds.lst equ 40H ;list verify dsedc equ 16 ;edit word nhelpl equ 7 ;number of help lines minfdb equ 13 ;minimum length for an fdb ; coninf equ 1 conrdy equ 11 seldsk equ 14 closef equ 16 deletf equ 19 readf equ 20 writef equ 21 renamf equ 23 getdsk equ 25 setdmf equ 26 boot equ 0 bdos equ 5 bdosp equ 6 namlen equ 8 typlen equ 3 cmdlin equ 80H deffcb equ 5CH defext equ 68H defbuf equ 80H chnfcb equ 5CH fnamel equ 11 ;form name length fnamet equ fnamel+1 ;total length exchnr equ defbuf+fnamet ;execute chain routine here esc equ 1BH ; page ;**************************************** ; ; display signon message ; ;**************************************** startm: lxi h,startl ;message list pointer start1: mov e,m ;message address inx h mov d,m inx h mov c,m ;screen address inx h mov b,m inx h mov a,e ora d jz wtline ;jif end list xchg call dsplay xchg jmp start1 ; startl: dw signon,100H dw coprit,200H dw idtex,40BH if IS dw pidtex,50BH dw prottx,60BH dw pdrvtx,70BH endif dw 0 ;end list ; ; display copyright ; copyright: call onesec ;wait a second lxi h,copyl jmp start1 ; copyl: dw coprit,0008H dw copym1,0100H dw copym2,0600H dw 0 ; onesec: lxi h,0 ones1: xthl xthl inx h mov a,h ora l jnz ones1 ret ; crlf: push psw push h lxi h,crlfm call dspmsg pop h pop psw ret ; printl: call crlf printt: xchg call dspmsg xchg ret page ;**************************************** ; ; routines for locating messages ; ;**************************************** ; ; add base of message file to address in HL ; addbas: push d lxi d,mstart ;message base dad d pop d ret ; ; clear to screen end ; clrend: lda hite sub b jmp clrline ;clear to screen end if IS ; ; init print driver by locating the right one and moving it into place ; initpd: lda cswtch IF KANJI cpi 1 ;do we want serial daisy? rnz ;rif not - tty already there lxi b,drvrln ;driver length push h ;save pointer ELSE cpi 3 rz ;nothing to do if oem, it's already there push h ;save pointer lxi b,drvrln ;driver length lda posmth cpi 1 jz initp1 ;jif to load serial daisy dad b ;point tty printer ENDIF initp1: lxi d,drvrst ;point drvier start initp2: mov a,m stax d inx d inx h dcx b mov a,b ora c jnz initp2 pop h ret ; ; form is has errors ; erform: call rdclose lxi h,erfmsg ;error in form message call ferror ;get what to do mvi a,ctrlc lxi h,nofrm2 jz chain jp exit ;exit on ^C ret ; ; form is no good ; bdform: lxi h,bdfmsg ;error in form message call ferror ;get what to do jp exit ;exit on ^C ret ; ; form not found ; noform: lxi h,nofmsg call ferror mvi a,0FFH lxi h,nofrm1 jz chain jp exit ;exit on ^C ret ;go back to re-enter the name ; ; display error in form message ; HL = message pointer ; ferror: lxi d,deffcb push h call stvoln ;put drive, report name into message pop h xra a sta defbuf lxi b,900H call getans dcr a ret endif ; ; most of the messages are not in memory ; HL points to table of 2 addresses per entry: ; address in memory ; offset in file ; if the message is not in memory, the address will be zero ; and we have to read it from the overlay file ; indptr: push d push b push psw lxi d,ind1st dcx d call cmpde jnc indpt1 ;not in list lxi d,indlst call cmpde jc indpt1 ;not in list mov e,m inx h mov d,m mov a,d ora e cz rdmsg ;read message file, return message address in DE xchg indpt1: pop psw pop b pop d ret ; ; read message file for offset @HL ; return message pointer in DE ; rdmsg: push h ;save table address for filling it in after the read inx h call locmsg ;locate message in file, reading first sector, set HL cz rdata ;read in the message @RDNEXT, return DE = message start pop h mov m,d ;put back into table dcx h mov m,e ret ; ; locate message in file, and read the first sector ; locmsg: mov e,m ;get offset in message file inx h mov d,m push d mov a,d ;extent = # bytes / 2^14 = top two bits rlc rlc ani 3 lxi h,msgext cmp m ;see if different extent cnz newext ;change extents if needed pop h ;get byte number dad h mov a,h ani 7FH sta msgrec mov a,l rrc if IS ; ; read next sector, ACC is offset in sector of message start ; rdsect: push d push b mov e,a mvi d,0 ;offset in HL lhld dmaddr ;current dma address push h bfaddr equ $+1 lxi h,msbuff shld dmaddr ;set dma address dad d ;point where to start in buffer mvi c,readf lxi d,msgfcb call imdos ;read sector xthl shld dmaddr ;restore dma address pop h ;pointer to address in buffer pop b pop d ret else ; ; read next sector, ACC is starting byte ; rdsect: push d push b mov l,a mvi h,0 ;offset in HL bfaddr equ $+1 lxi d,msbuff mvi c,setdmf call imdos ;set dma address dad d ;point where to start in buffer mvi c,readf lxi d,msgfcb call imdos ;read sector pop b pop d ret endif ; ; open next extent for message file ; HL points extent byte in FCB ; newext: push psw ;save next extent number call msclose ;close the old extent pop psw mov m,a ;set new extent call fopen ;open next rz call endcur call noovr6 ;display REMSGS.OVR ??? jmp exit ;all done ; ; read the message into memory from buffer pointer in HL to RDNEXT ; rdata: xchg lhld rdnext ;get address to read xchg rdata1: call mvbyte ;move one byte ora a jz rdata2 ;done on zero byte cpi cx jz rdata3 cpi nx ;check for address flag rdata3: cz mv2bytes ;get address jmp rdata1 ; rdata2: lhld rdnext ;where we started reading xchg shld rdnext ;reset for next time call ctable ;clear table for: DE <= address < HL ret ; ; move one or 2 bytes ; mv2byt: call mvbyte mvbyte: lda bfaddr ;low order address adi 80H ;buffer end sub l cz rdsect ;replenish if empty, ACC must be zero when call call endchk ;check for at buffer end cz wrapbf ;wrap buffer if at end rz ;buffer overflow mov a,m ;move byte stax d inx h inx d ret ; ; check for buffer end ; endchk: push h lhld bufend call cmpde pop h ret ; ; wrap buffer if at end ; wrapbf: push h ;save read buffer address call rdata2 ;clear table, set DE = where we started reading lhld bufbeg ;get buffer start shld rdnext ;reset the start call movbuf ;move the buffer xchg ;DE = store pointer pop h call endchk ;still at the end? (this should never happen) mvi a,0 ;for the buffer overflow ret ; movbuf: call endchk rz ldax d mov m,a inx h inx d jmp movbuf ; ; clear table for: DE <= address < HL ; ctable: push b lxi b,indlst ;point table end dcx b ctabl1: dcx b dcx b ;point high order byte of address call ctabl2 ;clear address if in range dcx b dcx b ldax b ora a ;zero flags table start jnz ctabl1 ;jif not done pop b ret ; ; clear address @BC if: DE <= @BC < HL ; BC points high order byte ; ctabl2: call ctabl3 ;set cy if HL is greater rnc xchg call ctabl3 ;set cy if DE is greater xchg rc xra a stax b dcx b stax b inx b ret ; ; set cy if HL is higher than @BC ; ctabl3: ldax b cmp h rnz dcx b ldax b inx b cmp l ret ; ; fcb for overlay file ; can't be in message file because it hasn't been read in yet ; if RE msgfcb: db 0,'REMSGS OVR' msgext: db 0,0,0,0 ds 16 msgrec: db 0 endif if IS msgfcb: db 0,'RSMSGS OVR' msgext: db 0,0,0,0 ds 16 msgrec: db 0 endif ; ; assign a stack pointer and init print driver if IS ; stackp: lxi h,endfix ;end of message pointers if IS call initpd ;init print driver endif lxi d,150 ;use 150 for stack dad d ;stack start shld stkptr ;allocate space for stack pop d ;our return sphl ;switch stacks push d ;restore return mvi c,getdsk call imdos ;get current disk setdsk: sta curdsk call resdsk ret ; ; overlay file not found or wrong version ; DE = msgfcb ; get disk drive to try or reboot ; noovr: lxi h,900H ;line and column shld mycur ;set cursor position xchg mov a,m ora a jnz noovr4 ;jif second time through call chksys ;set CY if system disk assigned jc noovr5 noovr4: call noovr6 ;display X:REMSGS.OVR??? call inputc ;get response mov c,a ;save for echo call upper ;convert to upper case call chkdsk ;set CY if ok jnc exit ;give it up noovr5: sta msgfcb call printc ;echo ; ; init message file overlay ; initms: lxi d,msgfcb call fopen ;open it mvi a,0 cz rdsect ;read the first sector if successful open cz ckvers ;if found and read, check version number jnz noovr ;jif not found/read or wrong version lxi d,mstart ;where to put push h lhld fixlen ;ptr to length of fixed length portion of file mov b,h mov c,l pop h call openms ;read fixed length portion of the message file push h ;save msbuff pointer lhld varlen ;get variable length mov b,h mov c,l lhld fixlen ;number bytes in fixed length portion xchg lhld freest ;where to put push h call subde ;get offset to add pop d ;destination xthl ;get msbuff ptr, save offset for later call openms ;read the rest xchg shld freest ;reset free space pointer ; ; adjust addresses by adding message base offset ; lda numadj ;number to adjust lxi h,ind1st ;first address to adjust lxi d,2 ;item length pop b ;restore offset call adjbs1 inx h ;skip end pointer lda nm2adj lxi d,4 adjbs1: push psw ;save count push d mov e,m ;get offset inx h mov d,m mov a,e ora d jz adjbs2 ;don't adjust if not in memory xchg dad b ;add base xchg adjbs2: mov m,d ;restore dcx h mov m,e pop d dad d pop psw dcr a jnz adjbs1 ret ; ; check version number ; ckvers: push h push d lhld msbuff ;get version number of overlay xchg lhld msgver ;get version number of program mov a,h cmp d jnz ckvrs1 mov a,l cmp e ckvrs1: pop d pop h ret ; ; display message, omitting spaces ; HL = ptr ; B = count ; noovr1: mov c,m mov a,c cpi ' ' cnz chrout inx h dcr b jnz noovr1 ret ; ; display disk drive in ACC ; noovr2: adi 'A'-1 mov c,a call chrout mvi c,':' call chrout ret ; ; display REMSGS.OVR??? ; noovr6: lxi h,msgfcb mov a,m ora a cnz noovr2 ;display disk drive if any inx h mvi b,namlen ;name length call noovr1 ;display name mvi c,'.' call chrout ;display '.' mvi b,typlen call noovr1 ;display file type lxi h,noovr3 call dspmsg ;display ' ??? ' ret ; noovr3: db ' ??? ',0 ; ; read number of bytes in BC to address in DE ; on entry, HL = current address in buffer ; openms: call mvbyte ;move one byte dcx b mov a,b ora c ;check for at buffer end jnz openms ret page ;**************************************** ; ; chain next program ; HL = program name pointer ; ;**************************************** ; chain: push psw ;save chain flag call msclose lxi d,chnfcb ;chain fcb push d mvi b,0CH call copyhl ;copy to fcb xra a stax d ;clear extent pop d call chopen ;open the program file call endcur ;restore terminal call getif ;get input character if one is waiting cpi ctrlc jz boot ;abort call dskset ;select disk and set 1st byte to zero lxi h,100H pop b ;chain flag sphl ;set stack pointer push b lda curdsk mov c,a push b ;save current disk lxi h,fncnt ;form name count lxi d,defbuf mvi b,fnamet ;count + form name call copyhl ;move form name lxi h,chainp ; ; routine to move stuff @HL to exchnr and execute it there ; with DE = 100H and HL = @BDOSP ; chaine: lxi d,exchnr mvi b,78H-fnamet;don't overwrite stack call copyhl ;move program lxi h,100h ;program start xchg lhld bdosp jmp exchnr ;execute chain program ; chksys: lda system chkdsk: call upper sui 'A' cpi nmdisk inr a ret ; ; open file for chaining ; chopen: call fopen ;try on current disk rz ;success call chksys jnc chopn1 ;not assigned chopn0: stax d call fopen ;try again with system disk rz ;exit to system if not found chopn1: ldax d ora a jnz chopn2 lda curdsk inr a chopn2: adi 'A'-1 sta msgdsk ;set disk drive for message push d inx d lxi h,chname call indptr xchg chopn3: mov a,m ;move name to error message stax d inx h inx d sui ' ' jnz chopn3 dcx d stax d ;mark end call clears lxi h,chainm lxi b,700H ;line 7, accept all answers call msgrsp pop d ;restore fcb pointer call chkdsk jc chopn0 exit: call endcur call resdsk jmp boot page ; ; program to chain next program ; ; assembled here, but resides at exchnr (8BH) for execution ; chainp: push d mvi c,conrdy call bdos ora a mvi c,coninf cnz bdos ;get character if ready cpi ctrlc jz boot ;abort on ctrl-c pop d push d ;some BDOS's clobber mvi c,setdmf call bdos ;set address lxi d,chnfcb mvi c,readf call bdos ;read the sector pop d ;restore address lxi h,80H dad d xchg ;point next sector ora a jz exchnr ;loop to routine start cpi 1 jnz boot ;boot if error lxi d,chnfcb mvi c,closef call bdos ;close file for MP/M pop b ;logged drive pop psw ;chain flag jmp xpret ;start up for chain page if RE ; pntitm: lhld ourfdb jmp ptitma endif ; ; point to item, item follows ; ptitem: xthl mov a,m ;get item number inx h xthl ptitma: ora a jnz ptitmb lhld forms ;if zero, point forms jmp ptitmc ptitmb: push b call getoff ;get offset into BC for item number in ACC dad b ;point item pop b ptitmc: mov a,m ora a ret ; ; get offset into BC for item number in ACC ; getoff: mvi b,0 mov c,a ;item number is offset usually cpi ddb ;set cy if done rc ;done ; ; get offset for special item into BC ; ACC has number ; gtoff1: mvi c,0 ;starting offset cpi lpf jnc gtoff4 ;jif very special (a loop item) gtoff2: push d mov e,a ;done at this item ani 0F0H ;starting item number mov d,a ;item number gtoff3: call lenitm ;get length of item in d in ACC call addacc ;add length in ACC to total in BC inr d ;next item mov a,d cmp e jnz gtoff3 pop d ret ; ; get offset inside a loop ; this depends on the number of iterations of the loop (loopc) ; total is loopc*loopln + constant ; and return ACC with item number of previous non-loop item ; gtoff4: push h lxi h,gtoff5 ;constant table push b sui lpf ;get item number mov c,a ;(BC is zero on entry) dad b dad b dad b pop b mov a,m ;ddb item before loop item inx h xthl ;restore ddb start call gtoff2 ;get offset to loop xthl ;restore table pointer mov a,m ;constant inx h mov l,m ;bytes per loop item push psw call gloopc inr a mov h,a ;number of loops pop psw inr l dcr l jnz lnlp1 ;multiply number of loops times length unless len=0 dad h ;number of loops * 2 + 2 in H add h ;add to 0/1 (this is for fdclex and fdctex only) pop h jmp lnclp0 ;add up offsets for UNLESS/THEN expressions ; ; table for loop items ; (ddb location,offset,loop length) ; gtoff5: db ddsort,1,ddslen ;ddsfld db ddsort,2,ddslen ;ddsflg db ddfnms,1,ddflen ;ddfdsk db ddfnms,2,ddflen ;ddfnam db ddfnms,10,ddflen ;ddftyp db ddnfld,1,dddlen ;ddfuse db fdclpc,0,0 ;fdclex db fdclpc,1,0 ;fdctex ; ; dispatch on ACC ; dsptch: xthl ;save HL, get table push d mov e,a mvi d,0 dad d dad d ;point table mov e,m inx h mov d,m xchg pop d xthl ret ; ; get length of item in D in ACC ; assumes (for efficiency) in many cases that BC has offset to item start ; lenitm: mov a,d lenit0: cpi fdb jnc fdbitm cpi cdb jnc cdbitm ; ddbitm: ani 0FH call dsptch dw lenddb ;length invarient part of ddb dw lensrt ;length sort data dw lenfns ;length file names dw leniex ;length include/exclude record expression dw leneex ;length endfile expression ; cdbitm: ani 0FH call dsptch dw lencdb ;length invarient part of cdb dw lenpgx ;length page expression dw lenrpx ;length end report expression ; fdbitm: ani 0FH call dsptch dw lenfdb ;length invarient part of fdb dw lenedw ;length edit word dw lenedw ;length edit word dw lencex ;length calc field expression dw lenclp ;length UNLESS/THEN expressions dw lenpex ;length print expression dw lenoex ;length output expression dw lenkex ;length clear expression dw lename ;length field name ; ; individual length routines ; lenddb: mvi a,ddbcon ;length of constant portion ret ; ; length of sort data ; ; this one actually adds most of the length into BC ; it must not be called as an individual routine ; lensrt: mvi a,ddslen ;length of sort info lnloop: push h dad b ;point item start mov l,m ;number of loops mov h,a ;loop length mov a,l lnlp1: call addacc ;add it into total mov a,l dcr h jnz lnlp1 pop h mvi a,1 ret ; ; length of UNLESS/THEN expressions ; ; so does this one ; lenclp: call lenexp ;get number of loops + 1 add a ;number of UNLESS/THENs + 2 lnclp0: dcr a ; + 1 inx b ;skip loop count byte lnclp1: dcr a rz push psw ;save expression count call lenexp ;expression length call addacc ;add to offset total pop psw jmp lnclp1 ; ; length of file names ; ; so does this one ; lenfns: mvi a,ddflen jmp lnloop ; ; length expressions ; these all use BC so it must be set before call ; lenpgx: lenrpx: leniex: leneex: lencex: leninp: lename: lenexp: push h dad b mov a,m pop h inr a ret lenoex: lenkex: lenpex: call lenexp ;get value of length byte+1 cpi maxexp+1 rc ;it's a real expression length mvi a,1 ;it's a conditon code ret ; lencdb: mvi a,cdbcon ret ; lenfdb: mvi a,fdbcon ret ; lenedw: push h call ptitem db fdedit pop h ani fe.edm rz getlen: push h call ptitem db fdlen pop h ret ; ; add ACC to offset in BC ; addacc: add c mov c,a rnc inr b ret ; ; for fdb pointer in HL, get next fdb pointer into HL ; set z-flag if at end ; nxtfdb: push b call getnxo ;get offset to next fdb in BC dad b pop b mov a,m inx h ora m dcx h ret ; ; get offset to next fdb into BC ; getnxo: mov c,m inx h mov b,m ;get second byte of length dcx h ret if RE ; ; for fdb pointer in HL, get previous fdb pointer into HL ; set z-flag if at end ; prvfdb: call gtfdbnum ;get fdb number ora a rz ;done if was at first dcr a call fndfld inr a ;clear Z ret endif ; ; find field in form ; ACC = field number ; fndfld: lhld fields ;point to field descriptor block start cmp m jnc fdberr fndblk: inx h ;skip number of fields ora a rz fdfld1: push psw call nxtfdb pop psw dcr a jnz fdfld1 ret page ; ; reset current disk for exit ; resdsk: mvi c,seldsk lda curdsk mov e,a call imdos call defdma ret ; ; store acc preserving hi bit ; stachr: mov a,c staacc: mov m,a ret page ;**************************************** ; ; get form name ; ;**************************************** gtfrm0: lxi b,100H call msgrsp cpi ctrlc jz exit cpi esc jnz gtfrm0 gtform: lxi h,firstm ;set first time for wtform mvi m,0FFH lxi h,cmdline mov a,m ora a cnz gtfrm2 ;move name if entered if IS sta oplflg ;set flag that name was found, use option list endif jnz gtfrm1 ;jif name was there lxi h,gtfrms lxi b,900H ;line 9 call clrend ;clear to end of screen call dsplay ;display lxi h,fnameb call readbf ;get input line gtfrm1: mvi b,0 mvi a,1 call clrline lxi h,fncnt ;point number bytes entered lxi d,deffcb mvi a,namlen+1 ;name plus disk drive call vrname ;verify name and move to deffcb lxi h,fdmsg cc gtfr00 ;get message pointer if illegal jz gtfrm0 ;jif empty,illegal ret ; ; get message pointer, return Z set ; gtfr00: cpi ctrlc jz exit lxi h,fdmsg3 ora a rz ;only disk drive call erchar ;put character into message mov a,c ora a rz ;too many characters lxi h,fdmsg1 cpi 9 rz ;bad disk drive lxi h,fdmsg2 xra a ret ;illegal character ; ; copy name on command line into fncnt/fname ; HL = command line pointer positioned at: # bytes, name, option list ; ; return Z set if no name ; fill option list buffer ; gtfrm2: mov c,m ;number of characters in command line xra a mov b,a ;count characters in name here mov m,a ;clear in case come through again if bad name inx h ;skip length byte push h dad b mov m,a ;clear end of option list pop h gtfrm3: mov a,m inx h cpi ' ' jz gtfrm3 ;skip leading spaces dcx h ;point first character of name lda fnameb mov c,a ;name buffer length lxi d,fname ;name buffer call gtfrm4 ;mov name to buffer, returning HL = name end, B = count xra a stax d mov a,b sta fncnt ora a ;set Z if no name rz ;no name if IS lxi d,oplstb ;option list buffer mvi b,oplstl call copyhl ori 0FFH ;return NZ endif ret ; ; move HL -> DE stopping at 0 or '/' ; number to move in C, after count runs out, still find first 0 or / ; return B = number moved ; ; B = 0 on entry ; gtfrm4: mov a,m ora a rz if IS cpi '/' rz endif inx h inr c dcr c ;set Z if out of room in name buffer jz gtfrm4 stax d inx d inr b dcr c jmp gtfrm4 ; ; verify name and move to DE ; HL = number of bytes, followed by name ; ACC= # bytes in destination: 1, 9 or 12 ; ; returns ; CY set if illegal (test first) ; Z set if empty ; CY and Z set if only entered disk drive ; vrname: mov c,a ;dest count mov a,m ;source count ora a ;clear CY rz ;empty call vrnam1 mov a,m ;get next source byte rc ;just disk drive and wanted more ora a ;set Z if success (source empty) stc rnz adi 1 ;clear Z, CY ret ; ; do the verify ; return on illegal or destination full ; vrnam1: inx h ;point name inx h ;point ':' if there mov a,m ;get it dcx h cpi ':' mvi a,0 ;assume no disk jnz vrnam2 ;jif current disk call gtbyte ;get disk sui 'A' ;get disk number cpi nmdisk rnc ;jif disk drive too high inr a inx h ;skip disk inx h ;skip ':' vrnam2: ora a ;clear CY stax d ;set disk drive inx d dcr c rz ;jif disk drive was all we wanted mov a,m ora a stc rz ;can't have just disk drive if dest length was > 1 mvi b,8 ;8 bytes in file name call vrnam3 ;convert name rz ;jif did't want extension mov a,m ora a jz vrnam5 ;this was put in to put ' ' into extension sui '.' ora a ;clear CY rnz ;jif no extension inx h ;skip vrnam5: mvi b,3 ;3 bytes in file type vrnam3: call gtbyte ;convert to upper, set Z if empty, CY if illegal call vrnam4 ;replace with space if empty/illegal stax d inx d dcr c dcr b jnz vrnam3 inr c dcr c ;set Z if don't want more characters rnc ;return if all characters legal rnz ;or not done mvi c,1 ;adjust for gtfr00, so can distinguish from too many ret ; vrnam4: mvi a,' ' rz rc mov a,m inx h ret ; ; get next byte ; convert to upper ; set Z if empty ; set CY if illegal ; gtbyte: mov a,m ora a rz ;empty IF KANJI call knjtst ;is it a KANJI? jnc gtbyt2 ;jif not sta knjflg ;set Kanji flag ora a ;ensure Z not set stc ;set the carry bit ret gtbyt2: ENDIF cpi '0' rc ;0-2FH illegal call upper ;convert to upper case IF KANA cpi 0A0H ;test if less than first KANA char jc gtbyt1 ;j if not KANA cpi 0E0H ;test if greater than last KANA char cmc ;complement cy to mean invalid rc ;0E0H - 0FFH invalid gtbyt1: ENDIF mov m,a cpi '[' cmc rc ;5BH-60H, 7B-7FH illegal sui ':' cpi 'A'-':' mov a,m ;restore rc ;3AH-40H illegal :;<=>?@ ora a ;clear Z ret ; ; covert to upper case ; upper: IF KANA cpi 7FH ;if not ASCII don't convert rnc ENDIF cpi 61H rc ani 5FH ;convert to upper ret page ;**************************************** ; ; read infostar form ; ;**************************************** rdform: call rptype call rdopen ;open the file if IS jnz noform ;not found else rnz endif sta nwform ;clear new form call crlf call defdma call rdflnm ;read file name and report parameters if IS IF HILITE lda filen ELSE lda former ;ACC= ATEBIT error in form flag ;(used first byte of Report parameters since can) ;(not use hi-bit of form name to indicate error.) ENDIF ora a jm erform ;jif form has errors endif lhld freest ;free space start shld cblock call rdblks ;read conditions block shld cbldes if RE push h call rdcbls ;read control break levels pop h ;don't keep them in REDIT else call rdcbls endif shld forms call rdblks ;read forms call rdrimg ;read report image shld ldbs call rdblks ;read LDBs shld fields call rdblks ;read fdbs shld nxfree call rdclose ;close for MP/M lda rdflag ora a jnz bdform ret ; rptype: call putype db 'RPT' ret ; bktype: call putype ;set file type db 'BAK' ret ; frmtyp: call putype db 'DEF' ret ; ; read control break levels ; rdcbls: lxi b,1 call gtdata add a mov c,a cnz gtdata ret ; ; put file type into FCB ; putype: xthl ;get file type pointer lxi d,deffcb push d push b xchg lxi b,namlen+1 dad b ;point file type in FCB xchg mvi b,typlen call copyhl ;copy file type to FCB xra a stax d ;clear extent pop b pop d xthl ret ; ; open form file for form imput ; rdopen: xra a sta rdflag lxi d,deffcb call fopen ;open the file lxi h,defbuf+80H shld bufptr lxi h,cmdline mvi m,0 ;in case file wasn't found ret ; ; close form file ; rdclos: lxi d,deffcb mvi c,closef call imdos ret ; ; close message file ; msclos: lxi d,msgfcb mvi c,closef call imdos ret ; ; read file name ; rdflnm: lxi h,filen ;file name ptr lxi b,nparms+8 call gtdata ;get data from file IF HILITE lda filen ;get error bit(hi-bit of form name) ENDIF ; ; move name to filen ; ACC = error bit ; movnam: lxi h,deffcb lxi d,filedk mvi b,9 IF HILITE ani 80H mov c,a ;save error bit ENDIF mov a,m ;store disk drive without error bit mvnam1: stax d inx h inx d mov a,m IF HILITE ora c ;OR error bit into FILEN (so form name will hilite) ENDIF dcr b jnz mvnam1 ret ; ; move name to deffcb ; putnam: lxi h,filedk putnm1: lxi d,deffcb mvi b,9 putnm2: mov a,m ani remvid ;remove error bits stax d inx h inx d dcr b jnz putnm2 ret ; ; read definition blocks ; rdblks: mvi c,3 ;number of blocks plus length of first block rdblk1: call gtdata ;do read plus length next block rnz ;unexpected end file (bad form) dcx h ;point offset start dcx h mov c,m ;egt block length inx h mov b,m inx h mov a,c ora b jnz rdblk1 ;read block plus length next ret ; ; read report image ; rdrimg: lda flines sta plines mov e,a call rdrim2 ;get 0FFH at form start shld fimage rdrim1: inx b call gtdata rnz ;unexpected end file (bad form) dcx h mov a,m inx h cpi cr jnz rdrim1 dcr e jnz rdrim1 rdrim2: inx b call gtdata ;get 0FFH at form end ret ; ; get data from file ; ; including ; make sure BC + HL < bdos ; make sure no eof is encountered ; gtdata: lda rdflag ;do nothing if end file reached ora a rnz push d push h ;save data destination ptr call ckfree pop d ;restore destination pointer lhld bufptr gtdat1: mov a,h dcr a ;test for end of buffer cz rdbuff ;read if empty dcx b mov a,b ora c mov a,m stax d ;mov from buffer inx h inx d jnz gtdat1 shld bufptr xchg pop d ret ; ; check enough free space ; ckfree: dad b ;do the test first xchg lhld bdos+1 call subde rnc ; ; out of memory ; if RE lda formin ora a jnz memout ;form is in memory, use non-fatal form of message memovf: lxi d,abtms3 jmp abort endif if IS jmp memerr endif ; subde: mov a,l sub e mov l,a mov a,h sbb d mov h,a ret ; ; read buffer from disk ; rdbuff: push d push b mvi c,readf lxi d,deffcb call imdos pop b pop d lxi h,defbuf rz ;return if no error mvi a,0FFH sta rdflag ;say end file reached ret if RE ; routines for form generation only aarrgg: ;for now bdform: fdberr: lxi d,abtms1 abort: xchg abort1: lda eosdsk adi 'A' sta msgdsk lxi b,100H+cr call msgrsp jmp exit ;abort page ;**************************************** ; ; read datastar form ; HL = name pointer (disk,name) ; ;**************************************** inform: call defdma ;set dma address call putnm1 ;put name into deffcb call frmtyp ;put type call rdopen ;open the file rnz ;not found inr a sta formin ;say form in memory lhld nxfree ;where to put call skpnam ;skip file name call rdkeys ;read key descriptor block call skpimg ;skip form image call dsblks ;read field names call rdclose ;close the file xra a ;say we found it ret ; ; skip name ; skpnam: push h lxi b,8 call gtdata pop h ret ; ; read key descriptor block ; rdkeys: lxi b,1 call gtdata ;get number of key fields rnz ;unexpected end file (bad form) mov c,a ;save number of key fields mvi a,ddsort call pntitm ;point old keydes mov a,c sub m ;change mov m,c ;set new inx h push h ;save where to read keys in case we have to call subde mov e,a mov d,b ;clear D jnc rdkey1 mvi d,0FFH call subde ;point end for move call subde rdkey1: xchg dad h ;two bytes per xchg cnz addblk ;make room pop h ;restore where to read keys mov a,c add a mov c,a cnz rdkey2 ;read sort block lhld nxfree ret ; ; read sort block ; rdkey2: push h ;save address push b ;save count call gtdata ;do the read pop b pop h rnz ;unexpected end file (bad form) rdkey3: inr m ;IS numbers start with 001, DS start with 000 inx h inx h dcr c dcr c jnz rdkey3 ret ; ; skip form image ; skpimg: push h lxi b,4 call gtdata ;get data from file pop h rnz ;unexpected end file (bad form) push h inx h inx h mov b,m ;number of lines inx h mov c,m skpim1: pop h push h push b mvi b,0 call gtdata pop b dcr b jnz skpim1 pop h ret ; ; read Datastar field names ; this is done by moving all of memory up under BDOS, reading the ; names in and moving it back down ; HL points to free space start ; dsblks: lxi b,2 ;two byte offset call ckfree ;get number of bytes remaining into HL xchg mvi a,ddnflds call pntitm call addblk ;add block of memory at start of old names push h ;save where to put names dad d ;point to where old names are mov a,m call skpnms ;skip to end of field names xthl ;save address of 1st byte to move down, get dest start ; lxi b,2 ;it's still two call gtdata ;read nunber of fdbs and zero byte dcx h ;skip zero byte dsblk1: push h ;save start call rdsblk ;read ds block pop h jz dsblk2 ;done push h ;save destination call pntnam ;set HL to name pointer, ACC to type byte pop d ;get destination into DE ani ds.int rrc ;move to 80H ora m mov m,a ;add flag to number of byte ani flnmsk ;now remove it mov b,a ;number of bytes inr b ;plus 1 for count byte call copyhl ;move name mov a,c ;field length stax d inx d xchg jmp dsblk1 ; ; read DS block ; rdsblk: lxi b,1 push h call gtdata ;read first byte of offset ora a inx b cnz gtdata ;read second byte of offset xthl call dsblen ;get ds block length into BC pop h mov a,b ora c rz ;rif done dcx b ;remove offset bytes from count dcx b call gtdata ;read rest of FDB xri 0FFH ;set Z if end file ret ; ; get DS block length into BC ; dsblen: mov c,m mov a,c ora a rz cpi minfdb rnc mov b,a inx h mov c,m ret ; ; complete by moving stuff back down ; dsblk2: pop d ;where we saved everything lda rdflag ora a cnz dsblk4 ;jif couldn't read form call subde ;number of bytes left over jnc dsblk3 ;won't fit xchg ; ; add/remove block at HL ; addblk: push h ;to have the move adjust pointer in HL call move ;make space lhld ourfdb call adjoff ;adjust offset pop h ret ; ; names didn't fit ; dsblk3: call dsblk4 call subde xchg call addblk jmp memout ; ; couldn't read form ; dsblk4: mvi a,ddnflds call pntitm ;point to number of fields again mvi m,0 ;say there's none inx h ret ; ; point to name ; pntnam: mov a,m inx h ;skip offset to next cpi dsmin jnc pntnm0 inx h ;unless it's two byte pntnm0: mov c,m mvi b,0 ;save for skipping edit mask, range inx h inx h inx h ;point DS fdctrl mov a,m ani ds.nam ;check for name inx h mov a,m ;get type byte jz pntnm2 push psw inx h ;point DS fdedit mov d,m ;get it mvi a,ds.edw call pntnm1 ;add for edit mask mvi a,ds.rng call pntnm1 ;add for range push b ;save length to return mvi c,6 ;1/2 file name length mvi a,ds.lst call pntnm1 ;add for file name mvi c,dsedc-dsedit dad b ;this should point to calc mov c,m inx h ;skip calc length dad b ;skip calc pop b pop psw ;restore type byte ret ; pntnm1: ana d rz dad b dad b ret ; pntnm2: lxi h,noname ret ; noname: db 0 ; ; make form from scratch ; mkform: mvi a,1 sta nwform ;set new form flag call crlf xra a ;clear error bit call movnam ;move file name mvi b,nparms xra a mkfrm1: stax d inx d dcr b jnz mkfrm1 lhld freest shld cblock ;do cblock call mkfrm3 shld forms ;do forms call mkfrm3 lda hite sui nhelpl ;number of help lines sta flines sta plines mvi m,0FFH inx h shld fimage ;set form image mkfrm2: mvi m,'.' inx h mvi m,cr inx h dcr a jnz mkfrm2 mvi m,0FFH ;mark form end inx h shld ldbs call mkfrm3 ;make LDBs shld fields ;set field pointer call mkfrm3 call wtform ;make sure there's enough room call dlfile ;get rid of it in case we abort later ret ; mkfrm3: xra a mov m,a inx h mov m,a inx h mov m,a inx h shld nxfree ret ; ; write new form file ; wtform: call defdma call putnam ;move name to deffcb call bktype ;set file type to BAK lxi h,firstm mov a,m mvi m,0 ora a mvi c,deletf cnz dlfile ;delete and prepare for rename only if first time call rptype ;set file type to .RPT call imdos ;do delete (of previous .RPT) or rename (.RPT -> .BAK) xra a sta defext ;clear extent call fmake lxi d,abtms4 jnz abwrite ;abort write lxi h,defbuf shld bufptr ;init buffer ptr lxi h,filen lxi b,8+nparms call wtdata ;write file name lhld cblock xchg lhld forms call wtfrm2 ;write data from cblock to forms lhld cbldes mov a,m add a inr a mov c,a call wtdata ;write control break levels lhld forms xchg lhld nxfree call wtfrm2 ;write files, form image and fields lhld bufptr wtfrm1: mvi m,ctrlz inr l jnz wtfrm1 call wtbuff lxi d,deffcb mvi c,closef call imdos ;close it xra a sta defext ;set extent zero ret ; ; delete file and prepare for rename ; dlfile: mvi c,deletf ;delete old file (.BAK) call imdos xchg lxi d,deffcb+10H mvi b,10H call copyhl ;copy for rename mvi c,renamf ;rename (.RPT -> .BAK) ret ; ; write from DE to HL ; wtfrm2: call subde xchg mov b,d mov c,e call wtdata ;write forms ret ; ; write data into buffer ; wtdata: xchg lhld bufptr wtdat1: ldax d mov m,a ;store in buffer inx d inr l cz wtbuff ;write buffer if full dcx b mov a,b ora c jnz wtdat1 shld bufptr xchg ret ; ; write buffer to disk ; wtbuff: push d push b lxi d,deffcb mvi c,writef call imdos pop b pop d lxi h,defbuf rz ;done if zero lxi d,abtms5 ;disk full ; ; abort write, DE = message pointer ; abwrit: push d call rptype ;make sure we delete the RPT file call dlfile ;delete it, returning C = renamf call bktype call imdos ;do the rename pop d jmp abort endif ;end routines for REDIT only bufptr: ds 2 ;read file buffer ptr freest: ds 2 ;free space start stkptr: ds 2 ;stack pointer top nxfree: ds 2 ;next free space firstm: ds 1 ;nz if haven't called wtform yet rdflag: ds 1 ;NZ if physical end encountered before logical end key: ds 2 ;pointer to key buffer curdsk: db 0 ;save current filedk: db 0 ;drive for file filen: ds 8 ;report name flines: ds 1 ;number of report lines cbreak: ds 1 ;number of control break fields IF ATEBIT former: ;use first byte of Report parameters to ;indicate error in form instead of hi-bit ;of form name ENDIF ds nparms-2 ;report parameters plines: ds 1 ;number of printing lines in form formid: db 0 ; fcols: ds 1 ;number of columns in form image cblock: ds 2 ;conditions block cbldes: ds 2 ;control break descriptor block forms: ds 2 ;number of forms fimage: ds 2 ;pointer to form image ldbs: ds 2 ;pointer to line definition blocks fields: ds 2 ;pointer to field descriptor blocks curfdb: ds 1 ;temporary for openem nwform: db 0 ;new form if nz formin: db 0 ;if nz form is in memory, use non-fatal I.S.M. message if IS oplflg::ds 1 ;nz if option list oplstb::ds oplstl ;option list buffer db 0 ;end it endif msbuff: ds 80H ;sector buffer for indptr to read messages from .OVL end