CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / jsage / znode3 / uploads / onpack.lbr / ONADD.AZM / ONADD.ASM

Wrap

Assembly Source File | 1993-06-07 | 40.5 KB | 1,994 lines

title 'ONADD on-screen adding-machine program' ; ; Last revised: 07/19/87 (rgf) ; ; ********************************************* ; * * ; * ONADD on-screen adding machine program * ; * * ; ********************************************* ; ; Copyright (c) 1987 ON!;Systems, Inc. ; ; Written for ON!Systems, Inc. by Ronald G. Fowler ; Fort Atkinson, WI ; name ('ONADD') ; extrn fpinp,fpout ;FLOAT routines extrn fpadd,fpsub,fpmul,fpdiv extrn facc ;float accumulator ; extrn ffree public base,formot ; ; ONADD constants ; digitl equ 10 ;digits to left of dp digitr equ 2 ;digits to right of dp cmtlen equ 31 ;length of comment scline equ 6 ;line from which scrolls occur iline equ 22 ;line for input numsiz equ digitr+digitl+1 ;number input field size: rt + lft + dp spc1 equ 2 ;spacing between num field and flags spc2 equ 10 ;spacing between flags and comment flgcol equ numsiz+spc1 ;flag column fls equ 3 ;size of flag column cmtcol equ flgcol+spc2+fls ;comment column ; ; PUTSW bits ; scrbit equ 00000001b ;1=write to screen filbit equ 00000010b ;1=write to file ; ; ; Float size definition ... must match definition in FLOATx.REL. ; digits equ 16 ;# significant digits (internal): must be EVEN fpsize equ (digits/2)+1 ;float size (fixed, don't change this!) ; dirio equ 6 ;direct I/O system call system equ 5 ;system entrypoint tpa equ 0100H ;transient program area ; ; cr equ 13 ;carriage return lf equ 10 ;linefeed bs equ 8 ;backspace tab equ 9 ;horizontal tab bell equ 7 ; escape equ 01BH ; ; definition of keys ; togkey equ escape ;keycode that toggles between num & comment cekey equ 'X'-64 ;control-X=clear entry subkey equ '\' ;subtotal key tabkey equ tab mskey equ 'M' ;memory-store key mrkey equ 'R' ;memory-recall key ; multi macro what,cnt rept cnt db what endm endm ; ; ; **************************** ; * Video interface routines * ; **************************** ; org tpa ; base: jmp start ;skip over video stuff ; ; ZCPR3 stuff ; envlit: db 'Z3ENV' ;Z3-compatible utility db 1 ;external environment z3eadr: dw 0 ;env address ; ;------------------------------------------------------------ ; ; ******************************* ; * Terminal Interface Routines * ; ******************************* ; ; Jump table ; curadr: jmp acur cls: jmp acls dellin: jmp adelln inslin: jmp ainsln ; ; The routines ... ; ; Address cursor, D=row, E=column ; acur: xchg shld cursor xchg mvi a,escape call outchr mvi a,'=' call outchr mov a,d ;send row adi ' ' call outchr mov a,e ;column adi ' ' jmp outchr ; ; delete line at cursor position ; adelln: mvi a,escape call outchr mvi a,'R' jmp outchr ; ; insert line at cursor position ; ainsln: mvi a,escape call outchr mvi a,'E' jmp outchr ; acls: mvi a,01AH jmp outchr ; ; Character output for terminal routines ; outchr: push h push d push b push psw ;save everybody mov e,a ;output from E mvi c,dirio ;direct console I/O cpi 0FEH ;validate character, so strange char- cc bdos ; acters don't become input requests pop psw pop b ;unstack and return pop d pop h ret ; ; end of terminal interface ; ;------------------------------------------------------------ ; org tpa+200h ;locate beyond terminal interface ; ; ; ************* ; * Data Area * ; ************* ; inkbuf: ds numsiz+2 ;field size + slop membuf: ds numsiz+2 ;MEM cmtbuf: ds cmtlen+2 ;comment buffer opfld: db ' ',0 ;operator flag field ; mdiv: ds 1 ;M diversion flag mptr: ds 2 ;pointer for M diversion msflag: ds 1 ;M store flag ; obp: ds 2 ;output buffer pointer outcnt: ds 2 ;output char count memtop: ds 2 ;top of memory ; padcnt: ds 1 ;# padding blanks required padchr: ds 1 ;character to pad with rollct: ds 1 ;scroll-count opcode: ds 1 ;operator code op1: ds 1 ;opcode for num1 temp: ds 2 ;temp for context switch tempx: ds 1 ;temp for CMNT ; spsave: ds 2 ;system stackpointer save ds 80 ;local stack stack: db 0 ;take up space (for debugger) num1: ds fpsize ;input buffer 1 num2: ds fpsize ;input buffer 2 termch: db 0 ;RDFLD terminator character cursor: ds 2 ;current cursor address z3flag: db 0 ceflag: db 0 ;double clear-entry flag hold: ds fpsize contxt: ds 7 ;cmt context-save: flg, curad, ctrs, ptr putsw: ds 1 ;bit 1=1 if write-file, 0=1 if write scrn outflg: ds 1 ;gets reset if file buffer fills recalc: ds 1 ;recalc flag pfield: db 0,0 ;prompt column,row ; ; context switch stuff ; consp: ds 2 ;consumer stacklevel prosp: ds 2 ;producer stacklevel ; ; producer stack ; ds 40 ;growth space prost: dw 0,0,0 ;initial registers protop: ds 2 ;top of the stack ; ;------------------------------------------------------------ ; ; ; We begin ... ; start: lxi h,0 ;save stackpointer dad sp shld spsave xra a ;no recalc yet sta recalc lxi sp,stack ;load local stack mvi a,scrbit ;reset PUT switch sta putsw call putscr ;put up screen call nitfil ;init file stuff ; ; loop here for each expression ; main: call linput ;get a number jc main ;double-CE here has nothing to clear lxi d,num1 lxi h,inkbuf call fpinp ;input float lda opcode ;get opcode sta op1 call scroll ;roll up the screen ; ; loop here for each successive term ; main2: call linput ;get another number jnc main3 ;jump if not double CE call scroll ;give it up jmp main main3: lxi d,num2 lxi h,inkbuf call fpinp call scroll ;roll the screen up lxi h,num1 lxi d,num2 lda opcode ;first, check for '-', (reverse Polish) cpi '-' ; which Richard J. says is how *real* jnz notpol ; calculators work their minus key mvi a,'+' ;it's a minus, set up an add for next sta opcode ;yes, really ... jmp subit ;but this time, subtract notpol: lda op1 ;not minus, apparently not reverse Polish cpi '+' ;so be algebraic jz addit cpi '-' jz subit cpi '*' jz multit cpi '/' jz divit addit: call fpadd jmp opjoin subit: call fpsub jmp opjoin multit: call fpmul jmp opjoin divit: call fpdiv opjoin: call movfac lda opcode ;get most recent op cpi tabkey ;total? jz total ;jump if so cpi subkey ; jnz nsub mvi a,'=' call subtot ;show subtotal mvi a,'+' ;plus ADD call opshow call scroll mvi a,'+' ;really an add nsub: sta op1 ;not yet lxi h,hold ;move HOLD to NUM1 lxi d,num1 call fpmove jmp main2 ; ; here at the end of a series ; total: mvi a,scrbit+filbit sta putsw ;put this in file too lxi h,dash call prathl mvi a,scrbit ;back to screen only sta putsw call scroll mvi a,'T' call subtot call scroll call scroll jmp main ; subtot: push psw mvi a,scrbit+filbit sta putsw ;screen + file lxi h,hold call fpout ;write to screen and file mvi a,' ' call wrfbyt ;space over in file pop psw ;show opcode 'T' call opshow mvi a,scrbit ;screen only sta putsw ret ; linput: xra a ;no comment context yet sta contxt sta mdiv ;no M diversion yet sta msflag ;no memory-store yet mvi e,0 ;E holds total buffer char count lxi h,inkbuf ;HL addresses the buffer lxi b,(digitl*256) ;B has positions-left, C is DP flag keylp: mvi m,0 ;keep terminator call shobuf ;display the buffer rekey: call linchr ;get a char call cvtuc ;upshift cpi mrkey ;memory recall? jnz notmr ;jump if not mov a,e ;buffer must be empty ora a jnz rekey push h ;yes mvi a,'M' ;flag it call opshow mvi a,'R' call opshow lxi h,membuf ;set pointer shld mptr mvi a,1 ;set M divert flag sta mdiv pop h jmp rekey ;onward notmr: cpi mskey ;memory store? jnz notms ;jump if not lda msflag ;already done memory store? ora a jnz rekey ;jump if so mvi a,1 ;well, we have now sta msflag mvi a,'M' ;flag it call opshow mvi a,'S' call opshow push h ;copy buffer to MEM push d push b lxi h,inkbuf lxi d,membuf mvmem: mov a,m stax d inx h inx d ora a jnz mvmem call shomem ;display it pop b pop d pop h jmp rekey notms: cpi cekey ;clear-entry? jnz notce lxi h,ceflag ;check flag mov a,m ;2 CE's in a row? mvi m,1 ;(set the flag) ora a stc rnz ;exit CY=1 if so lxi d,(iline*256)+cmtcol+1 call curadr ;address comment lxi h,cblank call prathl ;print blanks jmp linput ;re-enter ; notce: push psw xra a ;reset clear-entry flag sta ceflag pop psw call alpha ;A-Z or a-z? jnc yestog ;toggle to note field if so cpi togkey ;escape key? jnz notesc ;jump if not yestog: push h ;yes, stack 'em all push d push b call cmnt ;input the comment pop b pop d pop h jc keylp ;jump if toggle jmp ndp ;must be <cr> notesc: call digchk ;is this a digit? jc notdig ;jump if not inr b ;yes. Is there space for another? dcr b jz rekey ;ignore it if not mov m,a ;there is, stuff it inx h dcr b ;one less position inr e ;one more char jmp keylp ;onward notdig: cpi bs ;check for bs or rub jz isrub cpi 07fh jnz notrub isrub: mov a,e ;anything in buffer? ora a jz rekey ;ignore if nothing dcr e ;one less character inr b ;one more position dcx h ;point one backward mov a,m ;get what's there cpi '.' ;deleting the DP? jnz keylp ;jump if not mvi c,0 ;yes, reset the DP flag lda padcnt ;get positions free on left mov b,a jmp keylp ;onward ; notrub: cpi '.' ;decimal point? jnz ndp ;\jump if not mov a,c ;yes, test flag ora a jnz rekey ;if already have dp, ignore it inr c ;set dp flag mov a,b ;set pad count for SHOBUF sta padcnt mvi m,'.' ;put dp in buffer inx h inr e ;add to length mvi b,digitr ;get right-of-dp max jmp keylp ndp: push b call opchek ;operator? jnz notop ;jump if not mov a,b ;save the code sta opcode pop b lxi h,inkbuf ;normalize call normal mvi a,filbit+scrbit ;write to screen and file sta putsw mvi c,1 ;decimal point there now call shobuf ;re-display mvi a,' ' ;space over in file call wrfbyt lda opcode call opshow lxi h,cmtbuf ;got a comment? mov a,m ora a jz endcmt ;jump if not mvi a,' ' ;yes, space over call wrfbyt cmtwr: mov a,m inx h ora a jz endcmt call wrfbyt ;write to file jmp cmtwr endcmt: mvi a,scrbit ;back to screen only sta putsw ora a ret notop: pop b cpi 'C'-64 ;abort? jnz notcc ;jump if not push d push h lxi d,xitmsg call ynprmt ;get Y/N prompt pop h pop d cpi 'Y' jnz keylp ;if not Y, continue exit: call wrtfil ;maybe write an output file lxi d,iline*256 call curadr lhld spsave sphl ret ; ; print msg .DE in prompt field, get Y/N response ; ynprmt: lhld cursor push h ;save cursor pos call prpmt ;print prompt call getyn pop d push psw call clearp ;clear prompt file call curadr ;restore cursor pop psw ret ; getyn: call charin call cvtuc cpi 'Y' rz cpi 'N' jnz getyn ;wait for Y/N ret ; ; print msg .DE in prompt field ; prpmt: lhld pfield ;prompt loc xchg call curadr call prathl ;print the message ret ; ; LINPUT get char routine ; linchr: lda mdiv ;M key diversion active? ora a jz charin ;get from keyboard if not push h ;yes, get from MEM lhld mptr mov a,m inx h ;advance shld mptr pop h ora a ;got something? rnz ;exit if so sta mdiv ;nope, reset M diversion jmp charin ;and get from keyboard ; ; normalize input buffer .HL (to 2 decimal places) ; normal: mov a,m ;fetch ora a ;end? jz nodot ;jump, no DP found inx h ;else advance cpi '.' ;DP? jnz normal ;loop if not mov a,m ;first place present? ora a jz norm2 ;if not, go normalize 2 inx h mov a,m ;second? ora a jz norm1 ;if not, normalize 1 ret ;both present, exit nodot: mov a,b ;set pad count sta padcnt mvi m,'.' ;add DP inx h inr e norm2: mvi m,'0' inx h inr e norm1: mvi m,'0' inx h inr e mvi m,0 ;terminator lxi b,1 ;B=0 (no free dig right), C=1 (DP flag) ret ; notcc: jmp rekey ;unknown key ; ; check for operator key ; opchek: mvi b,tabkey cmp b rz mvi b,subkey cmp b rz mvi b,'+' cpi cr rz cpi '+' rz mvi b,'-' cmp b rz mvi b,'/' cmp b rz mvi b,'*' cpi 'x' rz cpi 'X' rz cmp b ret ; ; Input the comment field. Now, we have to remember ; what character we came in with, because an alpha ; character must shift into comment mode. Which is ; the way it originally worked, but they didn't like ; it that way. (A programmer's work is never done ...). ; cmnt: sta tempx ;save the damned character lxi h,contxt ;have we already started cmt field? mov a,m ora a jz newcmt ;go start new if not inx h ;yes, address saved context mov e,m ;fetch cursor adrs inx h mov d,m inx h call curadr ;go there mov c,m ;load counters and pointer inx h mov b,m inx h mov a,m inx h mov h,m mov l,a jmp cktemp ;go examine key newcmt: lxi d,(iline*256)+cmtcol+1 push d call curadr mvi a,' ' mvi b,cmtlen ;blank field call rchar pop d call curadr mvi b,cmtlen-1 ;max mvi c,0 ;length of comment lxi h,cmtbuf ;comment buffer cktemp: lda tempx ;get the char we entered with call alpha ;is it printable? (might be ESC) jnc okalph ;jump if so await: mvi m,0 ;maintain terminator call charin cpi togkey ;got an escape? jnz noteky ;jump if not shld contxt+5 ;yes, save the context lhld cursor ;get cursor adrs xchg ;to DE lxi h,contxt mvi m,1 ;flag a context is saved inx h mov m,e ;save cursor adrs inx h mov m,d inx h mov m,c ;save counters inx h mov m,d inx h stc ;return toggle, not done ret ;all done, back to number field ; noteky: cpi 'x' ;these three codes ... jz okalph ; ... have to be pre-checked cpi 'X' ; ... because OPCHEK will re- jz okalph ; ... return a TRUE, and they cpi subkey ; ... really aren't operators jz okalph ; ... in the comment field. ; push b ;opcode? call opchek pop b rz ;exit if so cpi 07FH jz crub cpi bs jnz nrub crub: mov a,c ;are we all the way back? ora a jz await ;ignore this if so dcx h ;back up mvi a,bs ;remove char on screen call type mvi a,' ' call type mvi a,bs call type inr b ;add a position dcr c ;deduct count jmp await ;onward nrub: cpi ' ' ;control characters prohibited jc await okalph: inr b ;have space? dcr b jnz gotsp ;jump if so mvi a,bell ;ring the bell call type jmp await ;ignore it otherwise gotsp: dcr b ;yes, deduct one inr c ;lenght increment mov m,a ;store it inx h call type ;display it jmp await ;onward ; ; Display the input buffer ; shobuf: push h ;save 'em push d push b mvi a,cr ;back to start of line call wrsbyt ;screen only lxi h,inkbuf call displa ;display the buffer pop b pop d pop h ret ; ; formatted output ; formot: lxi b,digitl*256 ;B=digit-left count, C=dp flag mvi e,0 ;total bufr size dcx h ;pre-decrement sblank: inx h mov a,m ;skip blanks cpi ' ' jz sblank push h ;save pointer scanlp: mov a,m ;got end? inx h ora a jz formnd ;jump if so cpi '.' ;dp? jnz fndp ;jump if not mov a,b ;yes, set DISPLA pad count sta padcnt mvi b,digitr inr e inr c ;set DP flag jmp scanlp fndp: inr b ;room remaining? dcr b jz fov ;overflow if not dcr b ;got room inr e jmp scanlp fov: inr c ;is this the decimal portion? dcr c jnz fdec ;jump if so ; ; integer portion overflow ; pop h ;discard the number mvi b,digitl ;print an overflowed number mvi a,'E' call rchar mvi a,'.' call type mvi b,digitr mvi a,'E' call rchar ret ; fdec: dcx h mvi m,0 ;truncate formnd: pop h ;get buffer pointer bak push h call normal ;normalize pop h ;fall into DISPLA ; ; Display buffer .HL formatted, with DP cursor backspacing. ; On entry, E=total field size, B=remaining space in buffer, ; C=DP flag, and PADCNT holds the amount of padding necessary ; on the left. ; displa: push b mvi e,numsiz ;field pad count initially mov a,c ;got a dp yet? ora a jz show1 ;\jump if no dp (b=pos left = pad cnt) lda padcnt ;get positions before DP mov b,a show1: call rblank ;pad sholp: mov a,m ;fetch inx h ora a ;terminator? jz show2 ;jump if so call type ;no, display it dcr e ;one less jmp sholp show2: mov b,e ;remaining size of field call rblank pop b ;get DP flag back (in c) push b mov a,c ;check dp flag ora a jnz show3 ;if dp, use remaining in B as bs-count mvi b,digitr+1 ;if no dp, back up to left of dp show3: mvi a,bs call rchar pop b ret ; ; print # blanks in A ; rblank: mvi a,' ' rchar: sta padchr mov a,b ;get count ora a ;exit if none to print rz lda padchr bllp: call type dcr e dcr b jnz bllp ret ; ; display MEM variable ; shomem: lhld cursor ;don't lose position push h lxi d,50 ;line 0, col 50 call curadr lxi h,mname call prathl lxi h,membuf call prathl pop d ;restore cursor jmp curadr ; ; shop opcode in A in opcode column in D ; opshow: cpi tab ;convert tab to blank jnz opsh1 mvi a,' ' opsh1: push h push b push psw lxi h,opfld ;where they go mvi b,3 ;max opscan: mov a,m ;find empty position cpi ' ' jz opfnd inx h dcr b jnz opscan lxi h,opfld ;none found, overwrite oldest opfnd: pop psw push psw mov m,a lxi d,(iline*256)+flgcol call curadr ;display on screen lxi h,opfld call prathl pop psw pop b pop h ret ; opcler: lxi h,' ' shld opfld shld opfld+1 ret ; putscr: mvi a,(iline-scline)-1 sta rollct ;count before switch call cls lxi d,(1*256)+31 call curadr lxi h,header call prathl lxi d,(scline-1)*256 call curadr mvi b,78 mvi a,'-' call rchar ;put up line lxi d,(iline-1)*256 call curadr lxi h,leader call prathl lxi d,iline*256 jmp curadr ; ; scroll up ; scroll: lxi d,(scline+1)*256 lxi h,rollct ;switched yet? mov a,m ora a jz scrol1 ;\jump if so dcr m ;no,downcount dcr d ;and use previous line scrol1: call curadr call dellin lxi d,iline*256 call curadr scnl: mvi a,cr ;write newline to file call wrfbyt mvi a,lf call wrfbyt ; ; clear fields ; call opcler ;clear OP field xra a sta inkbuf sta cmtbuf ret ; ; ;------------------------------------------------------------ ; ; ***************************** ; * Miscellaneous Subroutines * ; ***************************** ; ; inline print, string .TOS ; ilprt: xthl call prathl xthl ret ; ; print string .HL ; prathl: mov a,m ;fetch inx h ora a ;null terminates rz call type ;display jmp prathl ; ; output char in A to console, modify nothing ; type: push h ;stack everybody push d push b push psw lda putsw ;put to output file? ani filbit jz putnfl ;jump if not pop psw ;yes push psw call wrfbyt putnfl: lda putsw ;write to screen? ani scrbit jz typxit ;exit if not pop psw ;yes push psw call wrsbyt ;write to screen typxit: pop psw pop b pop d pop h ret ; ; write char in A to screen ; wrsbyt: push psw mov e,a ;align mvi c,dirio call bdos pop psw ;recall character lxi h,cursor ;update cursor column cpi lf ;linefeed? jnz type0 ;jump if not inx h ;yes, advance line only inr m ret type0: cpi cr ;end of line? jnz type1 ;jump if not mvi m,0 ;yes, reset column ret type1: cpi bs ;backspace? jnz type2 ;jump if not dcr m ;one less dcr m ;extra for next instruction type2: inr m ;advance column ret ; ; input character to A, modify only A ; charin: lda recalc ;get recalc flag ora a jz char1 ;jump if not reading file call swpro ;switch to producer context ora a ;did we get a character? rnz ;done if so sta recalc ;no, reset flag, fall into CHAR1 char1: push h push d push b inlp: mvi e,0ffh ;indicate input, not output mvi c,dirio call bdos ;read character ora a ;BDOS returns 0 ... jz inlp ; ... if no character waiting charx: pop b pop d pop h ret ; ; convert char in A to upper case ; cvtuc: cpi 'a' rc cpi 'z'+1 rnc ani 5fh ret ; digchk: cpi '0' rc cpi '9'+1 cmc ret ; alphck: cpi 'A' rc cpi 'Z'+1 cmc rnc cpi 'a' rc cpi 'z'+1 cmc ret ; ; copy the FACC to HOLD ; movfac: lxi d,hold ;copy the FACC to local lxi h,facc fpmove: lxi b,fpsize ;fall into block move ldir: mov a,m stax d inx h inx d dcx b mov a,b ora c jnz ldir ret ; ; clear prompt field ; clearp: push h push d lhld pfield xchg call curadr lxi h,mblank call prathl pop d pop h ret ; ; FENV - find Z3 environment ... if found, sets named ; directory address; if not found, leaves named dir- ; ectory address 0. ; ; FENV routine Copyright 1986 by Zivio, Inc. ; All Rights Reserved ; fenv: xra a ;no Z3 yet sta z3flag lhld z3eadr ;already have Z3 env from Z3ins? mov a,h ora l jnz sdir ;if so, get set ndir adrs lxi h,0ffffh ;Beginning of search, top of memory srch: lxi d,envlit+4 ;Search target end. evscan: lda 2 ;Bios page cmp h ;Page being searched rz ;give up, can't find it ldax d ;Get the 'v' cmp m ;Is hl pointing to it yet? jz vm1 ;Yes. dcx h ;Next byte jmp evscan ;Again vm1: mvi b,4 ;Check four more bytes vm2: dcx d ;Next byte in target dcx h ;Next byte in memory ldax d ;Get target byte cmp m ;Compare it with memory jnz srch ;Start over dcr b jnz vm2 ;Continue checking ; ; may have found it ... ; dcx h dcx h dcx h ;Back up to potential environment address push h ;Save it lxi d,1bh ;Offset to envptr in z3env dad d ;Point hl to it mov e,m ;Low byte to e inx h mov d,m ;Move envptr to de pop h ;Retrieve potential environment address mov a,h cmp d ;Compare high order jnz evnext mov a,l cmp e ;Compare low order jz sdir ;jump if found evnext: inx h ;else continue search inx h inx h jmp srch ; ; have ENV ; sdir: mvi a,0ffh ;set Z3 flag sta z3flag ret ; ; ;------------------------------------------------------------ ; ; ******************* ; * FILE MANAGEMENT * ; ******************* ; ; ; File-I/O system calls and equates ; fcb equ 05ch ;file control block tbuff equ 80h ;command tail buffer ; seldsk equ 14 ;select disk open equ 15 ;open file close equ 16 ;close file erase equ 19 ;erase file read equ 20 ;read sequential record write equ 21 ;write sequential record make equ 22 ;create file ; curdsk equ 25 ;return current drive setdma equ 26 ;set disk transfer adrs user equ 32 ;get/set user code ; ; Set up input file ; nitfil: mvi a,1 ;output-file write enable sta outflg dcr a ;A=0 sta recalc ;recalc=false lxi h,ffree ;init buffer shld obp lhld system+1 ;init memory dcr h dcr h ;2 pages (leaving room for EOF's) mvi l,0ffh shld memtop ; ; query for input file ; lhld cursor ;save cursor position push h lxi d,rdfmsg ;query for recalc call prpmt call charin call cvtuc cpi 'Y' jnz nitxit ;jump if refused reask: call clearp lxi d,ifnmsg ;prompt for filename call askfn jc nitxit ;exit if blank name lxi d,outfcb ;see if file exists mvi c,open call bdos inr a ;? jz inf ;jump if not found mvi a,1 ;set recalc flag sta recalc lxi h,pstart ;entry point of producer stack shld protop lxi h,prost ;initial stackpointer shld prosp ;for producer jmp nitxit inf: lxi d,nfmsg ;print not found call prpmt call charin jmp reask nitxit: call clearp pop d ;restore cursor call curadr ret ; ; switch to producer context ; swpro: push h ;stack everybody push d push b lxi h,0 dad sp shld consp ;stack the consumer lhld prosp ;get producer stack level sphl pop b ;become a different process pop d pop h ret ; ; switch to consumer context, passing A reg ; swcon: push h ;stack everybody push d push b lxi h,0 dad sp shld prosp ;stack the producer lhld consp ;get consumer stack level sphl pop b pop d pop h ret ; ; start of producer process ; linmax equ 50 ;maximum line size ; pstart: mvi a,80h ;set input buf ptr to force a read sta ibp xra a sta eoflg ;reset file-ended flag pmain: call rdline ;read a line jc pend ;jump if no more lda linbuf ;address buffer cpi '-' ;dashes? jz pmain ;ignore line if so lda linflg ;get FLAG field cpi 'T' ;t-lines are not user-generated jz pmain cpi '=' ;subtotal lines too jz pmain cpi 'M' ;memory op? jnz notmrk ;jump if not lda linflg+1 ;memory recall? cpi 'R' jnz notmrk ;jump if not ; ; memory recall operation ; mvi a,mrkey ;send MR key call swcon call sndcmt ;send comment lda linflg+2 cpi ' ' ;convert blank to tab jnz pmain1 mvi a,tabkey pmain1: call swcon jmp pmain ;onward ; notmrk: lxi h,linbuf-1 ;send number mvi b,digitl+digitr+2 ;count+1 skipbk: dcr b inx h mov a,m ;skip blanks cpi ' ' jz skipbk numlp: mov a,m ;send number to consumer inx h call swcon dcr b jnz numlp call sndcmt ;send comment lxi h,linflg ;address flags mov a,m inx h cpi 'M' ;memory store? jnz notmsk ;jump if not mov a,m ;get S inx h cpi 'S' jnz notmsk ;jump mvi a,mskey ;send store key call swcon mov a,m ;get operator notmsk: cpi ' ' ;convert space to tab jnz pmain2 mvi a,tabkey pmain2: call swcon ;send it jmp pmain ;onward ; pend: xra a ;A=0 to SWCON terminates us call swcon ; ; send comment ; sndcmt: lxi h,lincmt ;address comment field mov a,m ;got one? ora a rz cpi ' ' ;exit if not rz call sndtog ;send toggle key scmlp: mov a,m ora a jz sndtog ;exit if end inx h call swcon jmp scmlp sndtog: mvi a,togkey ;switch back jmp swcon ; ; Read line from file ; rdline: xra a ;no comment yet sta lincmt lxi h,linbuf ;where it goes lxi b,linmax ;B=upcounter, C=max rdllp: mvi m,0 ;insure terminator call rdbyte ;read a byte cpi 01AH jz rdleof ;jump if EOF cpi lf jz rdlend cpi ' ' ;ignore all other control chars jc rdllp inr c ;good char ... do we have room? dcr c jz rdllp ;jump if not mov m,a ;store it inx h ;advance inr b ;up count dcr c ;downcount jmp rdllp rdlend: mov a,b ;got anything? ora a jz rdline ;if not, go get another ret rdleof: mvi a,1 ;set EOF flag sta eoflg mov a,b ;file ended ... got any chars? ora a rnz ;exit w/line if so stc ;nope ret ; ; Read byte from file ; rdbyte: lda eoflg ;got end of file? ora a mvi a,01AH rnz ;exit EOF if so push h push d push b lda ibp ;get pointer ora a jp rdb1 ;jump if not past end lxi d,filbuf ;set DMA mvi c,setdma call bdos lxi d,outfcb ;read mvi c,read call bdos ora a ;good read? jz rdb1 ;jump if so sta eoflg ;no, set end-of-file flag mvi a,01AH ;return EOF jmp rdbxit rdb1: mov e,a ;pointer to DE mvi d,0 inr a ;update pointer sta ibp lxi h,filbuf ;offset into buffer dad d mov a,m ;fetch ora a rdbxit: pop b pop d pop h ret ; linbuf: ds digitl ;integer portion of # ds 1 ;DP ds digitr ;decimal portion ds 1 ;blank linflg: ds 3 ;flag field ds 1 ;blank lincmt: ds cmtlen ;comment ; ds 20 ;cr etc. ; filbuf: ds 128 ;input file buffer ibp: ds 1 ;input buffer pointer eoflg: ds 1 ;end-of-file flag ; ;------------------------------------------------------------ ; ; write byte to output buffer ; wrfbyt: push h ;save everyone push d push b push psw mov c,a ;output character to C lda outflg ;filewrite enabled? ora a jz wrexit ;just exit if not mov a,c cpi 01AH ;only EOF, CR and LF control chars in file jz wrf1 cpi cr ; jz wrf1 cpi lf jz wrf1 cpi ' ' ;suppress all others jc wrexit wrf1: call putbuf ;put char in buffer jnc wrexit ;jump if it went ; ; out of memory ; lhld cursor ;get current cursor adrs push h ;save it lhld pfield ;address prompt field xchg call curadr lxi h,memmsg ;print msg call prathl call charin call clearp ;clear prompt field pop d ;restore old cursor adrs call curadr xra a ;reset write sta outflg wrexit: pop psw ;restore everyone pop b pop d pop h ret ; ; put char in C in buffer, return CY=1 if buf filled ; putbuf: lhld memtop xchg ;DE=top lhld obp ;get output buffer pointer mov m,c ;store char mov a,e ;are we there? cmp l jnz wrfok ;jump if not mov a,d cmp h jnz wrfok stc ret wrfok: inx h shld obp lhld outcnt ;increment output count inx h shld outcnt ora a ret ; mname: db 'MEM: ',0 rdfmsg: db 'Recalculate existing tape (Y/N)? ',0 nfmsg: db 'File not found! <any key> ',0 ifnmsg: db 'Read tape from filename: ',0 xitmsg: db 'Exit ON!ADD (y/n)?',0 wrtmsg: db 'X,E: exit, F: write output tape: ',0 fulems: db 'Disk full! Partial tape saved <any key> :',0 ofnmsg: db 'Save tape to filename: ',0 eramsg: db 'File exists ... erase (Y/N) ?',0 makems: db 'Error creating file <any key> :',0 header: db 'O N ! A D D',cr,lf,cr,lf db '^X = Clear entry | TAB = total | \ = ' db 'subtotal |^C = exit | M = Memory Store' db cr,lf db 'ESC = note/number | +-*/ (add,subtract' db ',multiply,divide) | R = Memory recall' db 0 dash: db '---------------------',0 cblank: multi ' ',cmtlen ;blanks db 0 leader: multi 'x',digitl multi '.',1 multi 'x',digitr multi ' ',spc1 multi 'O',fls multi ' ',spc2 db ' ----------- Note -------------',0 memmsg: db 'Memory full! Output tape disabled <any key> :',0 mblank: db ' ',0 ; filnbf: db 15,0 ds 15+3 ; ; write an output file ; wrtfil: lhld outcnt ;got anything to write? mov a,h ora l rz ;skip this if not lhld cursor ;save cursor position push h lxi d,wrtmsg ;query for output file call prpmt call charin call cvtuc cpi 'X' ;exit jz wrtxit cpi 'E' jz wrtxit call clearp ;clear prompt field lxi d,ofnmsg ;prompt for filename call askfn ;get it jc wrtxit ;if blank name, exit lhld memtop ;take back that extra page inr h ; ... we stole when we set up MEMTOP shld memtop ; ... so there's room for EOF stuff lxi d,outfcb ;see if file already exists mvi c,open call bdos inr a ;? jz makeit ;if not, go make new mvi c,close lxi d,outfcb ;close it call bdos call clearp lxi d,eramsg call prpmt ;ask if we should erase call getyn ;get Y/N answer cpi 'Y' jnz wrtxit ;exit if NO call type ;echo mvi a,cr call type lxi d,outfcb ;erase mvi c,erase call bdos makeit: lxi d,outfcb ;create new mvi c,make call bdos cpi 0ffh ;good make? lxi d,makems ;prep error msg jz wtexit ;if not, go error out ; ; pad output buffer with EOF markers ; padit: mvi a,01AH ;pad last sector with EOF call wrfbyt lhld outcnt ;last sector emptied? mov a,l ani 07FH jnz padit ;loop until it is mvi b,7 ;get log 128 for divide rotrlp: ora a mov a,h rar mov h,a mov a,l rar mov l,a dcr b jnz rotrlp mov b,h ;BC=record count mov c,l lxi d,ffree ;DE=start of buffer wrlp: lxi h,128 ;calc next DMA dad d push h ;save it push b ;save count mvi c,setdma ;set this one call bdos lxi d,outfcb ;write mvi c,write call bdos pop b ;recall count pop d ;recall next DMA ora a ;good write? jz wrtok ;jump if so lxi d,outfcb ;no, close what we have mvi c,close call bdos jmp dskful wrtok: dcx b ;write all mov a,b ora c jnz wrlp lxi d,outfcb ;now close the file mvi c,close call bdos inr a ;did it go? jnz wrtxit ;exit if so dskful: lxi d,fulems ;print msg wtexit: call prpmt call charin wrtxit: call clearp pop d call curadr ret ; ; Print prompt .HL, query filename. Returns CY=1 if blank name ; askfn: call prpmt lxi d,filnbf mvi c,10 call bdos lxi h,filnbf+1 mov a,m ;anything entered? ora a stc rz ;quit if not push h mov e,m ;length to DE mvi d,0 dad d inx h ;HL pointing past last mvi m,0 ;null terminate pop h scanb: inx h mov a,m ;skip any leading blanks cpi ' ' jz scanb ora a ;termination here ends it stc rz lxi d,outfcb ;parse the name call fparse ora a ret ; ; output FCB ; db 0 ;---> outfcb's user area outfcb: db 0,'OUTPUTXXFCB',0,0,0,0 ;local FCB dw 0,0,0,0,0,0,0,0 db 0,0,0 ; ; input FCB ; db 0 ;---> outfcb's user area infcb: db 0,'CALC ANS',0,0,0,0 ;local FCB dw 0,0,0,0,0,0,0,0 db 0,0,0 ; ; ; ********************************* ; * file name parsing subroutines * ; ********************************* ; ; ; getfn gets a file name from text pointed to by reg hl into ; an fcb pointed to by reg de. leading delimeters are ; ignored. allows drive spec of the form <du:> (drive/user). ; this routine formats all 33 bytes of the fcb (but not ran rec). ; ; entry de first byte of fcb ; exit b=# of '?' in name ; fcb-1= user # parsed (if specified) or 255 ; ; fparse: call nitfcb ;init 1st half of fcb call gstart ;scan to first character of name call getdrv ;get drive/user spec. if present mov a,b ;get user # or 255 cpi 0ffh ;255? jz fpars1 ;jump if so dcx d ;back up to byte preceeding fcb dcx d stax d ;stuff user # inx d ;onward inx d fpars1: call getps ;get primary and secondary name ret ; ; nitfcb fills the fcb with dflt info - 0 in drive field ; all-blank in name field, and 0 in ex,s1,s2,rc, disk ; allocation map, and random record # fields ; nitfcb: push h push d call getusr ;init user field pop d pop h push d ;save fcb loc dcx d stax d ;init user # to currnt user # inx d xchg ;move it to hl mvi m,0 ;drive=default inx h ;bump to name field mvi b,11 ;zap all of name fld nitlp: mvi m,' ' inx h dcr b jnz nitlp mvi b,33-11 ;zero others, up to nr field zlp: mvi m,0 inx h dcr b jnz zlp xchg ;restore hl pop d ;restore fcb pointer ret ; ; gstart advances the text pointer (reg hl) to the first ; non delimiter character (i.e. ignores blanks). returns a ; flag if end of line (00h or ';') is found while scaning. ; exit hl pointing to first non delimiter ; a clobbered ; zero set if end of line was found ; gstart: call getch ;see if pointing to delim? rnz ;nope - return ora a ;physical end? rz ;yes - return w/flag inx h ;nope - move over it jmp gstart ;and try next char ; ; getdrv checks for the presence of a du: spec at the text ; pointer, and if present formats drive into fcb and returns ; user # in b. ; ; entry hl text pointer ; de pointer to first byte of fcb ; exit hl possibly updated text pointer ; de pointer to second (primary name) byte of fcb ; b user # if specified or 0ffh ; getdrv: mvi b,0ffh ;default no user # push h ;save text pointer dscan: call getch ;get next char inx h ;skip pointer over it jnz dscan ;scan until delimiter cpi ':' ;delimiter a colon? inx d ;skip dr field in fcb in case not pop h ;and restore text pointer rnz ;return if no du: spec mov a,m ;got one, get first char call cvtuc ;may be drive name, cvt to upper case cpi 'A' ;alpha? jc isnum ;jump to get user # if not sui 'A'-1 ;yes, convert from ascii to # dcx d ;back up fcb pointer to dr field stax d ;store drive # into fcb inx d ;pass pointer over drv inx h ;skip drive spec in text isnum: mov a,m ;fetch next inx h cpi ':' ;du delimiter? rz ;done then dcx h ;nope, back up text pointer mvi b,0 ;got a digit, init user value uloop: mov a,b ;get accumulated user # add a ;* 10 for new digit add a add b add a mov b,a ;back to b mov a,m ;get text char sui '0' ;make binary add b ;add to user # mov b,a ;updated user # inx h ;skip over it mov a,m ;get next cpi ':' ;end of spec? jnz uloop ;jump if not inx h ;yep, return txt pointer past du: ret ; ; getps gets the primary and secondary names into the fcb. ; entry hl text pointer ; exit hl character following secondary name (if present) ; getps: mvi c,8 ;max length of primary name mvi b,0 ;init count of '?' call getnam ;pack primary name into fcb mov a,m ;see if terminated by a period cpi '.' rnz ;nope - secondary name not given ;return default (blanks) inx h ;yup - move text pointer over period ftpoint:mov a,c ;yup - update fcb pointer to secondary ora a jz getft inx d dcr c jmp ftpoint getft: mvi c,3 ;max length of secondary name call getnam ;pack secondary name into fcb ret ; ; getnam copies a name from the text pointer into the fcb for ; a given maximum length or until a delimiter is found, which ; ever occurs first. if more than the maximum number of ; characters is present, character are ignored until a ; a delimiter is found. ; entry hl first character of name to be scanned ; de pointer into fcb name field ; c maximum length ; exit hl pointing to terminating delimiter ; de next empty byte in fcb name field ; c max length - number of characters transfered ; getnam: call getch ;are we pointing to a delimiter yet? rz ;if so, name is transfered inx h ;if not, move over character cpi '*' ;ambigious file reference? jz ambig ;if so, fill the rest of field with '?' cpi '?' ;afn reference? jnz notqm ;skip if not inr b ;else bump afn count notqm: call cvtuc ;if not, convert to upper case stax d ;and copy into name field inx d ;increment name field pointer dcr c ;if name field full? jnz getnam ;nope - keep filling jmp getdel ;yup - ignore until delimiter ambig: mvi a,'?' ;fill character for wild card match fillq: stax d ;fill until field is full inx d inr b ;increment count of '?' dcr c jnz fillq ;fall thru to ingore rest of name getdel: call getch ;pointing to a delimiter? rz ;yup - all done inx h ;nope - ignore antoher one jmp getdel ; ; getch gets the character pointed to by the text pointer ; and sets the zero flag if it is a delimiter. ; entry hl text pointer ; exit hl preserved ; a character at text pointer ; z set if a delimiter ; getch: mov a,m ;get the character, test for delim ; ; global entry: test char in a for filename delimiter ; fndelm: cpi '/' rz cpi '.' rz cpi ',' rz cpi ' ' rz cpi ':' rz cpi '=' rz ora a ;set zero flag on end of text r0: ret ; ; bdos entry: preserves bc, de. if system call is a file ; function, this routine logs into the drive/ ; user area specified, then logs back after ; the call. ; bdos: call filfck ;check for a file function jnz bdos1 ;jump if not a file function call getdu ;get drive/user shld savedu ldax d ;get fcb's drive sta fcbdrv ;save it dcr a ;make 0-relative jm bdos0 ;if not default drive, jump mov h,a ;copy to h bdos0: xra a ;set fcb to default stax d dcx d ;get fcb's user # ldax d mov l,a inx d ;restore de call setdu ;set fcb's user ; ; note that unspecified user # (value=0ffh) becomes ; a getusr call, preventing ambiguity. ; call bdos1 ;do user's system call push psw ;save result push h lda fcbdrv ;restore fcb's drive stax d lhld savedu ;restore prior drive/user call setdu pop h ;restore bdos result registers pop psw ret ; ; local variables for bdos replacement routine ; savedu: dw 0 ;saved drive,user fcbdrv: db 0 ;fcb's drive dmadr: dw 80h ;current dma adrs ; bdos1: push d push b mov a,c ;doing setdma? cpi setdma jnz bdos1a ;jump if not xchg ;yep, keep a record of dma addresses shld dmadr xchg bdos1a: call system pop b pop d ret ; ; get drive, user: h=drv, l=user ; getdu: push b ;don't modify bc push d mvi c,user ;get user # mvi e,0ffh call bdos1 push psw ;save it mvi c,curdsk ;get drive call bdos1 mov h,a ;drive returned in h pop psw mov l,a ;user in l pop d pop b ;restore caller's bc ret ; ; set drive, user: h=drv, l=user ; setdu: push b ;don't modify bc push d push h ;save info mov e,h ;drive to e mvi c,seldsk ;set it call bdos1 pop h ;recall info push h mov e,l ;user # to e mvi c,user call bdos1 ;set it pop h pop d pop b ret ; ; check for file-function: open, close, read random, write ; random, read sequential, write sequential. ; filfck: mov a,c ;get function # cpi open rz rc ;ignore lower function #'s cpi close rz cpi read rz cpi write rz cpi erase rz cpi make ret ; ; routine to return user # without disturbing registers ; getusr: push h push d push b mvi c,user mvi e,0ffh call bdos pop b pop d pop h ret ; ; Check A for alpha char ... return CY=1 if not ; alpha: cpi 'A' rc ;exit, way too lo cpi 'Z'+1 cmc rnc ;return if A-Z cpi 'a' rc ;exit, >Z, <a cpi 'Z'+1 cmc ret ; end ; a delimiter is found. ; entry hl first character of name to be scanned ; de po