IMD 1.16: 1/06/2007 9:47:03 FOGCPM.156 ممممممممممممممم--FOGCPM156CP4PKT ASM€ CP4PKT ASM€ !"CP4PKT ASM€#$%&'()*+,-./012CP4PKT ASMt3456789:;<=>?@A-01-00 87 “-CPM156 DOC ”•CP4SYS ASM€BCDEFGHIJKLMNOPQCP4SYS ASM€RSTUVWXYZ[\]^_`aCP4SYS ASM€bcdefghijklmnopqCP4SYS ASM€rstuvwxyz{|}~€CP4SYS ASM€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘CP4SYS ASM’مممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممThis is the disk name. مممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممم; CP4PKT.ASM ; KERMIT - (Celtic for "FREE") ; ; This is the CP/M-80 implementation of the Columbia University ; KERMIT file transfer protocol. ; ; Version 4.0 ; ; Copyright June 1981,1982,1983,1984 ; Columbia University ; ; Originally written by Bill Catchings of the Columbia University Center for ; Computing Activities, 612 W. 115th St., New York, NY 10025. ; ; Contributions by Frank da Cruz, Daphne Tzoar, Bernie Eiben, ; Bruce Tanner, Nick Bush, Greg Small, Kimmo Laaksonen, Jeff Damens, and many ; others. ; ; This file contains the (system-independent) routines that implement ; the KERMIT protocol, and the commands that use them: ; RECEIVE, SEND, FINISH, and LOGOUT. ; ; revision history: ; edir 6: November 22, 1984 ; Change SEND's 'Unable to find file' error exit from calling ; error3 to calling prtstr instead. I don't know about you, but ; I greatly dislike having messages dumped into pre-existing ; junk on the screen where I have to spend lots of time hunting ; for them. [Hal Hostetler] ; ; edit 5: September 9, 1984 ; Call flsmdm in init to flush old input when starting transfers. ; Select console before returning from inpkt. ; Replace inline code with calls to makfil/clofil to set up for ; multisector buffering on output. ; Remove superfluous call to clrlin in error3. ; ; edit 4: August 21, 1984 (CJC) ; Fix comment in inpkt: packet is terminated by NUL on return, not CR. ; If debugging, display the outgoing packet before putting the EOL ; character on, so the dumped packet doesn't get overwritten. ; ; edit 3: July 27, 1984 ; add link directive for LASM. CP4PKT is linked by CP4MIT, and links ; to CP4TT. Add Toad Hall TACtrap to permit operations through a TAC. ; ; edit 2: June 8, 1984 ; formatting and documentation; remove some unused labels; move setpar ; to cp4mit.m80; add module version string; make all arithmetic on ; 'pktnum' modulo 64; apply defaults correctly for missing parameters ; in send-init packet (and corresponding ack). ; ; edit 1: May, 1984 ; extracted from CPMBASE.M80 version 3.9; modifications are described ; in the accompanying .UPD file. ; pktver: db 'CP4PKT.ASM (6) 22-Nov-84$' ; name, edit number, date ; RECEIVE command ; here from: kermit read: lxi d,data ;Where to put the text (if any.) mvi a,cmtxt call comnd ;Get either some text or a confirm. jmp kermt3 ; Didn't get anything. ora a ;Get any chars? jz read1 ;Nope, just a regular send. sta argblk+1 ;Store the number of chars. xchg ;Get pointer into HL. mvi m,'$' ;Put in a dollar sign for printing. call init ;Clear the line and initialize the buffers. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr mvi a,'1' ;Start with single character checksum sta curchk ;Save the type xra a ;Start a packet zero. sta argblk mvi a,'R' ;Receive init packet. call spack ;Send the packet. jmp kermt3 ; Die! jmp read12 read1: call init ;Clear the line and initialize the buffers. read12: xra a sta czseen ;Clear the ^X/^Z flag initially. lxi h,0 shld numpkt ;Set the number of packets to zero. shld numrtr ;Set the number of retries to zero. sta pktnum ;Set the packet number to zero. sta numtry ;Set the number of tries to zero. call scrnrt ;Position cursor lxi h,0 call nout ;Write the number of retries. mvi a,'R' sta state ;Set the state to receive initiate. ;... ; ;RECEIVE state table switcher. read2: call scrnp ;Position cursor lhld numpkt call nout ;Write the current packet number. lda state ;Get the state. cpi 'D' ;Are we in the DATA receive state? jnz read3 call rdata jmp read2 read3: cpi 'F' ;Are we in the FILE receive state? jnz read4 call rfile ;Call receive file. jmp read2 read4: cpi 'R' ;Are we in the Receive-Initiate state? jnz read5 call rinit lda state ;[jd] get new state cpi 'F' ;[jd] went into receive state? jnz read2 ;[jd] no lxi d,inms24 ;[jd] yes, get receiving... message call finmes ;[jd] go print it jmp read2 read5: cpi 'C' ;Are we in the Receive-Complete state? jnz read6 lxi d,infms3 ;Put in "Complete" message. lda czseen ;Or was it interrupted? ora a ; . . . jz read5a ;No. xra a ;Yes, clear flag. sta czseen ; ... lxi d,inms13 ;Issue "interrupted" message. read5a: call finmes ;Print completion message in right place. jmp kermit read6: cpi 'A' ;Are we in the Receive-"Abort" state? jnz read7 read7: lxi d,infms4 ;Anything else is equivalent to "abort". call finmes jmp kermit ; ; Receive routines ; Receive init ; called by: read rinit: lda numtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm rinit2 lxi d,ermes4 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rinit2: inr a ;Increment it. sta numtry ;Save the updated number of tries. mvi a,'1' ;Reset block check type to single character sta curchk ;Store as current type for initialization call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'S' ;Is it a send initiate packet? jnz rinit3 ;If not see if its an error. lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda argblk ;Returned packet number. (Synchronize them.) call countp lda argblk+1 ;Get the number of arguments received. lxi h,data ;Get a pointer to the data. call spar ;Get the data into the proper variables. lxi h,data ;Get a pointer to our data block. call rpar ;Set up the receive parameters. sta argblk+1 ;Store the returned number of arguments. mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ; Failed, abort. lda inichk ;Now switch to agreed upon check-type sta curchk ;For all future packets mvi a,'F' ;Set the state to file send. sta state ret rinit3: cpi 'E' ;Is it an error packet. jnz nak0 ;If not NAK whatever it is. call error jmp abort ; ; Receive file ; called by: read rfile: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rfile1 lxi d,ermes5 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfile1: inr a ;Increment it. sta numtry ;Save the updated number of tries. call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'S' ;Is it a send initiate packet? jnz rfile2 ; No, try next type. lda oldtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm rfil12 ;If not proceed. lxi d,ermes4 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfil12: inr a ;Increment it. sta oldtry ;Save the updated number of tries. lda pktnum ;Get the present packet number. dcr a ;Decrement ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number cmp b ;Is the packet's number one less than now? jnz nak0 ;No, NAK and try again. call updrtr ;Update the retry count. xra a sta numtry ;Reset the number of tries. lxi h,data ;Get a pointer to our data block. call rpar ;Set up the parameter information. sta argblk+1 ;Save the number of arguments. mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ; Failed, abort. ret rfile2: cpi 'Z' ;Is it an EOF packet? jnz rfile3 ; No, try next type. lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rfil21 ;If not proceed. lxi d,ermes6 call error3 ;Move cursor and print an error message. jmp abort ;Change the state to abort. rfil21: call tryagn ret rfile3: cpi 'F' ;Start of file? jnz rfile4 call compp jnz nak0 ;No, NAK it and try again. call countp call gofil ;Get a file to write to, and init output buffer. jmp abort lda numtry ;Get the number of tries. sta oldtry ;Save it. call ackp mvi a,'D' ;Set the state to data receive. sta state lda czseen ;Check if we punted a file cpi 'Z' ;and didn't want any more rz ;If that was the request, keep telling other end xra a ;Otherwise, clear flag (^X is only for one file) sta czseen ;And store the flag back ret rfile4: cpi 'B' ;End of transmission. jnz rfile5 call compp jnz nak0 ;No, NAK it and try again. xra a ;No data. (Packet number already in argblk). sta argblk+1 mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort mvi a,'C' ;Set the state to complete. sta state ret rfile5: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Receive data ; called by: read rdata: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdata1 lxi d,erms10 call error3 ;Display error message. jmp abort ;Change the state to abort. rdata1: inr a ;Increment it. sta numtry ;Save the updated number of tries. call rpack ;Get a packet. jmp nak ; Trashed packet: nak, retry. cpi 'D' ;Is it a data packet? jnz rdata2 ; No, try next type. call compp jz rdat14 lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdat12 ;If not proceed. lxi d,erms10 call error3 ;Display err msg. jmp abort ;Change the state to abort. rdat12: call tryagn ret rdat14: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. lda argblk+1 ;Get the length of the data. call ptchr jmp abort ; Unable to write out chars;abort. xra a sta numtry ;Reset the number of tries. sta argblk+1 ;No data. (Packet number still in argblk.) mov c,a ;Assume no data lda czseen ;Check if control-X typed ora a ; . . . jz rdat15 ;Zero if not typed mov c,a ;Get the type of character typed mvi a,1 ;One data character sta argblk+1 ;Save the count mov a,c ;Get the possible data character sta data ;Store in data area rdat15: mvi a,'Y' ;Acknowledge packet. call spack ;Send the packet. jmp abort ret rdata2: cpi 'F' ;Start of file? jnz rdata3 ; No, try next type. lda oldtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm rdat21 ;If not proceed. lxi d,ermes5 call error3 ;Display err msg. jmp abort ;Change the state to abort. rdat21: call tryagn ret rdata3: cpi 'Z' ;Is it a EOF packet? jnz rdata4 ;Try and see if its an error. call compp jnz nak0 ;No, NAK it and try again. call countp lda argblk+1 ;Get the data length cpi 1 ;Have one item? jnz rdat33 ;If not, ignore data lda data ;Yes, get the character cpi 'D' ;Is it a 'D' for discard? jz rdat36 ;If so, punt file rdat33: call clofil ;Finish off the file. jmp rdat37 ; Give up if the disk is full. xra a ;Since we kept the file, sta czseen ;don't say it was discarded. rdat36: lda numtry ;Get the number of tries. sta oldtry ;Save it. call ackp mvi a,'F' sta state ret rdat37: lxi d,erms11 ; "?Disk full" call error3 ; put it on the error line jmp abort ; abort transfer rdata4: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; SEND command ; here from: kermit send: mvi a,cmifi ;Parse an input file spec. lxi d,fcb ;Give the address for the FCB. call comnd jmp kermit ; Give up on bad parse. call cfmcmd call mfname ;handle (multi) files jnc send14 ;got a valid file-name lxi d,erms15 call prtstr ;Display error msg. ([hh] where it's visible) jmp kermit send14: call init ;Clear the line and initialize the buffers. xra a sta pktnum ;Set the packet number to zero. sta numtry ;Set the number of tries to zero. sta wrn8 ;[jd] we haven't sent the 8-bit-lost warning lxi h,0 shld numpkt ;Set the number of packets to zero. shld numrtr ;Set the number of retries to zero. call scrnrt ;Position cursor lxi h,0 call nout ;Write the number of retries. mvi a,'1' ;Reset to use single character checksum sta curchk ;For startup mvi a,'S' sta state ;Set the state to receive initiate. ;... ; ;SEND state table switcher send2: call scrnp ;Position cursor lhld numpkt call nout ;Write the packet number. lda state ;Get the state. cpi 'D' ;Are we in the data send state? jnz send3 call sdata jmp send2 send3: cpi 'F' ;Are we in the file send state? jnz send4 call sfile ;Call send file. jmp send2 send4: cpi 'Z' ;Are we in the EOF state? jnz send5 call seof jmp send2 send5: cpi 'S' ;Are we in the send initiate state? jnz send6 call sinit lda state ;[jd] get state back cpi 'F' ;[jd] into file send state yet? jnz send2 ;[jd] no lxi d,inms23 ;[jd] yes, print sending... call finmes ;[jd] jmp send2 send6: cpi 'B' ;Are we in the eot state? jnz send7 call seot jmp send2 send7: cpi 'C' ;Are we in the send complete state? jnz send8 ;No... lxi d,infms3 ;Yes, write "Complete" message. lda czseen ;Or was it interrupted? ora a ; . . . jz send7a ;No. lxi d,inms13 ;Yes, then say "Interrupted" instead. send7a: call finmes jmp kermit send8: cpi 'A' ;Are we in the send "abort" state? jnz send9 lxi d,infms4 ;Print message. call finmes jmp kermit send9: lxi d,infms4 ;Anything else is equivalent to "abort". call finmes jmp kermit ; ; Send routines ; Send initiate ; called by: send sinit: lda numtry ;Get the number of tries. cpi imxtry ;Have we reached the maximum number of tries? jm sinit2 lxi d,erms14 call error3 ;Display ermsg jmp abort ;Change the state to abort. sinit2: inr a ;Increment it. sta numtry ;Save the updated number of tries. mvi a,'1' ;Reset to use single character checksum sta curchk ;For startup lda chktyp ;Get our desired block check type sta inichk ;Store so we tell other end lxi h,data ;Get a pointer to our data block. call rpar ;Set up the parameter information. sta argblk+1 ;Save the number of arguments. lda numpkt ;Get the packet number. sta argblk mvi a,'S' ;Send initiate packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sinit3 ;If not try next. call compp rnz ;If not try again. call countp lda argblk+1 ;Get the number of pieces of data. lxi h,data ;Pointer to the data. call spar ;Read in the data. lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda inichk ;Get the agreed upon block check type sta curchk ;Store as type to use for packets now mvi a,'F' ;Set the state to file send. sta state call getfil ;Open the file. ret ; assume success; mfname thinks the file exists. sinit3: cpi 'N' ;NAK? jnz sinit4 ;If not see if its an error. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not assume its for this packet, go again. xra a sta numtry ;Reset number of tries. mvi a,'F' ;Set the state to file send. sta state ret sinit4: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send file header ; called by: send sfile: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm sfile1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. sfile1: inr a ;Increment it. sta numtry ;Save the updated number of tries. xra a ;Clear A sta czseen ;No control-Z or X seen lxi h,data ;Get a pointer to our data block. shld datptr ;Save it. lxi h,fcb+1 ;Pointer to the file name in the FCB. shld fcbptr ;Save position in FCB. mvi b,0 ;No chars yet. mvi c,0 sfil11: mov a,b cpi 8H ;Is this the ninth char? jnz sfil12 ;If not proceed. mvi a,'.' ;Get a dot. lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr c sfil12: inr b ;Increment the count. mov a,b cpi 0CH ;Twelve? jp sfil13 lhld fcbptr mov a,m ani 7fH ;Turn off CP/M 2 or 3's high bits. inx h shld fcbptr ;Save position in FCB. cpi '!' ;Is it a good character? jm sfil11 ;If not get the next. lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr c jmp sfil11 ;Get another. sfil13: mov a,c ;Number of char in file name. sta argblk+1 lhld datptr mvi a,'$' mov m,a ;Put in a dollar sign for printing. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr lda pktnum ;Get the packet number. sta argblk mvi a,'F' ;File header packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sfile2 ;If not try next. call compp rnz ;If not hold out for the right one. sfil14: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. call gtchr ;Fill the first data packet jmp sfil16 ;Error go see if its EOF. ; ;Got the chars, proceed. sta size ;Save the size of the data gotten. mvi a,'D' ;Set the state to data send. sta state ret sfil16: cpi 0FFH ;Is it EOF? jnz abort ;If not give up. mvi a,'Z' ;Set the state to EOF. sta state ret sfile2: cpi 'N' ;NAK? jnz sfile3 ;Try if error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp sfil14 ;Just as good as a ACK;go to the ACK code. sfile3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send data ; called by: send sdata: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm sdata1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. sdata1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lxi h, data ;Get a pointer to our data block. shld datptr ;Save it. lxi h,filbuf ;Pointer to chars to be sent. shld cbfptr ;Save position in char buffer. mvi b,1 ;First char. sdat11: lhld cbfptr mov a,m inx h shld cbfptr ;Save position in char buffer. mov c,a ;[jd] preserve character temporarily lda quot8 ;[jd] doing eighth-bit quoting? ora a ;[jd] mov a,c ;[jd] restore char jnz sdat4 ;[jd] using eighth-bit quoting, no warning lda parity ;[jd] get parity cpi parnon ;[jd] none? mov a,c ;[jd] restore character jz sdat4 ;[jd] no parity, leave char alone lda wrn8 ;[jd] look at warning flag ora a ;[jd] have we already given the warning? jnz sdat5 ;[jd] yes, skip this mov a,c ;[jd] restore character... ani 80h ;[jd] examine parity jz sdat5 ;[jd] no parity, no warning. call parwrn ;[jd] ...print warning - parity lost mvi a,0ffh ;[jd] remember that we sent the message sta wrn8 ;[jd] sdat5: mov a,c ;[jd] restore character again ani 7fh ;[jd] strip parity so not checksummed sdat4: lhld datptr mov m,a ;Put the char in the data packet. inx h shld datptr ;Save position in data packet. inr b ;Increment the count. lda size ;Get the number of chars in char buffer. cmp b ;Have we transfered that many? jp sdat11 ;If not get another. lda size ;Number of char in char buffer. sta argblk+1 lda pktnum ;Get the packet number. sta argblk mvi a,'D' ;Data packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz sdata2 ;If not try next. call compp rnz ;If not hold out for the right one. lda argblk ;Get the packet number back call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. lda argblk+1 ;Get the data length cpi 1 ;Check if only 1 character? jnz sdat15 ;If not, just continue lda data ;Got one character, get it from data cpi 'Z' ;Want to abort entire stream? jnz sdat14 ;If not, check for just this file sta czseen ;Yes, remember it sdat14: cpi 'X' ;Desire abort of current file? jnz sdat15 ;If not, just continue sta czseen ;Yes, remember that sdat15: lda czseen ;Also get control-Z flag ora a ;Check if either given jz sdat12 ;If neither given, continue mvi a,'Z' ;Change state to EOF sta state ; . . . ret ;And return sdat12: call gtchr jmp sdat13 ;Error go see if its EOF. sta size ;Save the size of the data gotten. ret sdat13: cpi 0FFH ;Is it EOF? jnz abort ;If not give up. mvi a,'Z' ;Set the state to EOF. sta state ret sdata2: cpi 'N' ;NAK? jnz sdata3 ;See if is an error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp sdat12 ;Just as good as a ACK;go to the ACK code. sdata3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send EOF ; called by: send seof: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm seof1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. seof1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lda pktnum ;Get the packet number. sta argblk xra a sta argblk+1 ;No data. lda czseen ;Check if C-Z or C-X typed ora a ; . . . jz seof14 ;If not aborted, just keep going mvi a,'D' ;Tell other end to discard packet sta data ;Store in data portion mvi a,1 ;One character sta argblk+1 ;Store the length seof14: mvi a,'Z' ;EOF packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz seof2 ;If not try next. call compp rnz ;If not hold out for the right one. seof12: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. mvi c,closf ;Close the file. lxi d,fcb call bdos ;* Check if successful lda czseen ;Desire abort of entire stream? cpi 'Z' ;Desire abort of entire stream? jz seof13 ;If so, just give up now call mfname ;Get the next file. jc seof13 ; No more. call getfil ;and open it (assume success) xra a ;Clear A sta czseen ;Since we have not aborted this file mvi a,'F' ;Set the state to file send. sta state ret seof13: mvi a,'B' ;Set the state to EOT. sta state ret seof2: cpi 'N' ;NAK? jnz seof3 ;Try and see if its an error packet. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp seof12 ;Just as good as a ACK;go to the ACK code. seof3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; Send EOT ; called by: send seot: lda numtry ;Get the number of tries. cpi maxtry ;Have we reached the maximum number of tries? jm seot1 lxi d,erms14 call error3 jmp abort ;Change the state to abort. seot1: inr a ;Increment it. sta numtry ;Save the updated number of tries. lda pktnum ;Get the packet number. sta argblk xra a sta argblk+1 ;No data. mvi a,'B' ;EOF packet. call spack ;Send the packet. jmp abort ; Failed, abort. call rpack ;Get a packet. jmp r ; Trashed packet don't change state, retry. cpi 'Y' ;ACK? jnz seot2 ;If not try next. call compp rnz ;If not hold out for the right one. seot12: call countp lda numtry ;Get the number of tries. sta oldtry ;Save it. xra a sta numtry ;Reset the number of tries. mvi a,'C' ;Set the state to file send. sta state ret seot2: cpi 'N' ;NAK? jnz seot3 ;Is it error. call updrtr ;Update the number of retries. lda pktnum ;Get the present packet number. inr a ;Increment ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number. cmp b ;Is the packet's number one more than now? rnz ;If not go try again. jmp seot12 ;Just as good as a ACK;go to the ACK code. seot3: cpi 'E' ;Is it an error packet. jnz abort call error jmp abort ; ; This routine sets up the data for init packet (either the ; Send_init or ACK packet). ; called by: rinit, rfile, sinit rpar: lda rpsiz ;Get the receive packet size. adi ' ' ;Add a space to make it printable. mov m,a ;Put it in the packet. inx h ;Point to the next char. lda rtime ;Get the receive packet time out. adi ' ' ;Add a space. mov m,a ;Put it in the packet. inx h lda rpad ;Get the number of padding chars. adi ' ' mov m,a inx h lda rpadch ;Get the padding char. adi 100O ;Uncontrol it. ani 7FH mov m,a inx h lda reol ;Get the EOL char. adi ' ' mov m,a inx h lda rquote ;Get the quote char. mov m,a inx h mvi m,'Y' ;[jd] we know how to do 8-bit quoting lda parity ;[jd] cpi parnon ;[jd] parity none? jz rpar1 ;[jd] yes, keep going lda qbchr ;[jd] no, better request 8-bit quoting mov m,a rpar1: inx h ;Advance to next lda chktyp ;Get desired block check type mov m,a ;Store it inx h ;Advance pointer mvi a,08H ;Six pieces of data. ret ; ; This routine reads in all the send_init packet information. ; called by: rinit, sinit spar: sta temp4 ;Save the number of arguments. ; Initialize some variables to their required default values, so we use ; the right values even if the remote Kermit doesn't send the full packet: ; ; we don't do anything with timeout values yet. ; ; no default pad count/pad character? mvi a,cr ; EOL character = carriage-return sta seol mvi a,'#' ; quote character = '#' sta squote mvi a,'&' ; eighth-bit quote character = '&' sta qbchr mvi a,'1' ; block-check = 1-character-checksum sta inichk ; mov a,m ;Get the max packet size. sbi ' ' ;Subtract a space. sta spsiz ;Save it. lda temp4 cpi 3 ;Fewer than three pieces? rm ;If so we are done. inx h inx h ;Increment past the time out info. mov a,m ;Get the number of padding chars. sbi ' ' sta spad lda temp4 cpi 4 ;Fewer than four pieces? rm ;If so we are done. inx h mov a,m ;Get the padding char. adi 100O ;Re-controlify it. ani 7FH sta spadch lda temp4 cpi 5 ;Fewer than five pieces? rm ;If so we are done. inx h mov a,m ;Get the EOL char. sbi ' ' sta seol lda temp4 cpi 6 ;Fewer than six pieces? rm ;If so we are done. inx h mov a,m ;Get the quote char. sta squote lda temp4 ;Get the amount of data supplied cpi 7 ;Have an 8-bit quote? rm ;If not there, all don e inx h ;Yes, get the character mvi a,0 ;[jd] sta quot8 ;[jd] assume not quoting mov a,m ;Get the supplied character cpi 'N' ;[jd] No? jz spar1 ;[jd] then don't try to do it cpi ' ' ;[jd] maybe they don't know about it... jz spar1 ;[jd] then don't try to do it. cpi 'Y' ;[jd] Yes? jnz spar2 ;[jd] if not 'Y', assume it's a quote char. lda parity ;[jd] using parity? cpi parnon ;[jd] no, don't need quoting... jz spar1 ;[jd] mvi a,0ffh ;[jd] else turn on... sta quot8 ;[jd] ...quote flag jmp spar1 spar2: sta qbchr ;[jd] use their quote char (should validate) mvi a,0ffh sta quot8 ;[jd] turn quote flag and fall thru... spar1: lda temp4 ;Determine if block check type given cpi 8 ;Is the field there? rm ;If not, all done inx h ;Point to the character mov a,m ;Get the value mov b,a ;Copy value lda chktyp ;Get our type cmp b ;Is it our desired type? rnz ; If not, use default (1-character-checksum) sta inichk ; Match, store as type to use after init ret ; and return ; ; Copy characters from packet to disk ; called by: rdata ptchr: sta temp1 ;Save the size. lxi h,data ;Beginning of received packet data. shld outpnt ;Remember where we are. lda rquote mov b,a ;Keep the quote char in b. mvi c,0 ;[jd] assume no 8-bit quote char lda quot8 ;[jd] doing 8-bit quoting? ora a jz ptchr1 ;[jd] no, keep going lda qbchr ;[jd] else get 8-bit quote char mov c,a ;[jd] keep this in c ptchr1: lxi h,temp1 dcr m ;Decrement # of chars in packet. jm rskp ;Return successfully if done. lxi h,chrcnt ;Number of chars remaining in dma. dcr m ;Decrement. jp ptchr2 ;Continue if space left. call outbuf ;Output it if full. jmp ptchr9 ; Error return if disk is full. ptchr2: lhld outpnt ;Get position in output buffer. mov a,m ;Grab a char. inx h shld outpnt ;and bump pointer. mvi e,0 ;[jd] assume nothing to OR in. cmp c ;[jd] is it the binary quote char? jnz ptch2a ;[jd] no, keep going mvi e,80h ;[jd] include parity bit lda temp1 dcr a sta temp1 ;[jd] decrement character count mov a,m ;[jd] get next character inx h shld outpnt ptch2a: cmp b ;Is it the quote char? jnz ptchr3 ;[jd] changed to ptchr3 so includes parity mov a,m ;Get the quoted character inx h shld outpnt ;and bump pointer. lxi h,temp1 dcr m ;Decrement # of chars in packet. mov d,a ;Save the char. ani 80H ;Turn off all but the parity bit. ora e ;[jd] let parity come from either (???) mov e,a ;Save the parity bit. mov a,d ;Get the char. ani 7FH ;Turn off the parity bit. cmp b ;Is it the quote char? jz ptchr3 ;If so just go write it out. cmp c ;[jd] maybe it's the 8-bit prefix character? jz ptchr3 ;[jd] then don't controllify. mov a,d ;Get the char. adi 40H ;Make the character a control char again. ani 7FH ;Modulo 128. ptchr3: ora e ;Or in the parity bit. lhld bufpnt ;Destination buffer. mov m,a ;Store it. inx h shld bufpnt ;Update the pointer jmp ptchr1 ;and loop to next char. ptchr9: lxi d,erms11 ; "?Disk full" call error3 ; put it on the error line ret ; take error return. ; ; Fill a data packet from file ; called by: sfile, sdata gtchr: lda squote ;Get the quote char. mov c,a ;Keep quote char in c. lda curchk ;Get current block check type sui '1' ;Get the extra overhead mov b,a ;Get a copy lda spsiz ;Get the maximum packet size. sui 5 ;Subtract the overhead. sub b ;Determine max packet length sta temp1 ;This is the number of chars we are to get. lxi h,filbuf ;Where to put the data. shld cbfptr ;Remember where we are. mvi b,0 ;No chars. gtchr1: lda temp1 dcr a ;Decrement the number of chars left. jp gtchr2 ;Go on if there is more than one left. mov a,b ;Return the count in A. jmp rskp gtchr2: sta temp1 lda chrcnt ;Space left in the DMA. dcr a ;* Can improve order here. jm gtchr3 sta chrcnt jmp gtchr4 gtchr3: call inbuf ;Get another buffer full. jmp gtch30 ; If no more return what we got. jmp gtchr4 ;If we got some, proceed. gtch30: mov a,b ;Return the count in A. ora a ;Get any chars? jnz rskp ;If so return them. jmp gtceof ;If not, say we found the end of the file. gtchr4: lhld bufpnt ;Position in DMA. mov a,m ;Get a char from the file. inx h shld bufpnt mov d,a ;Save the char. ani 80H ;Turn off all but parity. mov e,a ;Save the parity bit. jz gtch4a ;[jd] no parity, skip this check... lda quot8 ;[jd] doing eighth-bit quoting? ora a jz gtch4a ;[jd] no, just proceed normally lda temp1 ;[jd] get space remaining cpi 2 ;[jd] 3 chrs left (one cnted already)? jm gtchr9 ;[jd] no, skip this dcr a ;[jd] decrement space remaining sta temp1 ;[jd] put back. lhld cbfptr ;[jd] Position in character buffer. lda qbchr ;[jd] get quote character mov m,a ;]jd] Put the quote char in the buffer. inx h ;[jd] increment destination buffer pointer shld cbfptr ;[jd] store the pointer back inr b ;[jd] Increment th e char count. mvi e,0 ;[jd] no parity bit to OR in. ;[jd] fall thru... gtch4a: mov a,d ;Restore the char. ani 7FH ;Turn off the parity. mov d,a ;[jd] save here for later... cpi ' ' ;Compare to a space. jm gtchr5 ;If less then its a control char, handle it. cpi del ;Is the char a delete? jz gtchr5 ;Go quote it. lda quot8 ; Are we doing 8th-bit quoting? ora a jz gtch4c ; if not, skip this test and restore character. lda qbchr ; get 8th-bit quote character cmp d ; same as current character? jz gtch4b ; yes, have to quote it... gtch4c: mov a,d ; no. get character back again. cmp c ;Is it the quote char? jnz gtchr8 ;If not proceed. gtch4b: lxi h,temp1 ;[jd] point to char count dcr m ;[jd] decrement (know room for at least one) lhld cbfptr ;Position in character buffer. mov m,c ;Put the (quote) char in the buffer. inx h shld cbfptr inr b ;Increment the char count. mov a,d ;[jd] restore character again jmp gtchr8 gtchr5: ora e ;Turn on the parity bit. cpi ('Z'-100O) ;Is it a ^Z? jnz gtchr7 ;If not just proceed. lda cpmflg ;Was the file created by CPM... cpi 1 ;in ASCII-mode ? jz gtch52 ;Control-Z stops text cpi 2 ;in BINARY mode? jz gtchr6 ;Yes, pass the ^Z ;At this point file-mode is DEFAULT. ;If the rest of the record is filled with ^Zs, we're at EOF, otherwise ;its a regular character. lhld bufpnt ;since CHRCNT is ZERO at EOF-time lda chrcnt ;(set by INBUF5 B.G.E) mov d,a ;Get the number of chars left in the DMA. gtch51: dcr d mov a,d jp gtch53 ;Any chars left? gtch52: xra a ;If not, get a zero. sta chrcnt ;Say no more chars in buffer. mov a,b ;Return the count in A. jmp rskp ;Scan rest of buffer for non ^Z -- If we find a non ^Z, fall into gtchr6. ;If we get to the end of the buffer before finding a non ^Z, fall into gtch52. gtch53: mov a,m ;Get the next char. inx h ;Move the pointer. cpi ('Z'-100O) ;Is it a ^Z? jz gtch51 ;If so see if the rest are. gtchr6: mvi a,('Z'-100O) ;Restore the ^Z. gtchr7: sta temp2 ;Save the char. lxi h,temp1 ;Point to the char total remaining. dcr m ;Decrement it. lhld cbfptr ;Position in character buffer. mov m,c ;Put the quote in the buffer. inx h shld cbfptr inr b ;Increment the char count. lda temp2 ;Get the control char back. adi 40H ;Make the non-control. ani 7fH ;Modulo 200 octal. gtchr8: lhld cbfptr ;Position in character buffer. ora e ;Or in the parity bit. mov m,a ;Put the char in the buffer. inx h shld cbfptr inr b ;Increment the char count. jmp gtchr1 ;Go around again. gtchr9: ;[jd] not enough room left in buffer... lhld bufpnt dcx h shld bufpnt ;[jd] back up over last character lxi h,chrcnt ;[jd] point to character count inr m ;[jd] increment it mov a,b ;[jd] count of chars transferred jmp rskp ;[jd] return it gtceof: mvi a,0FFH ;Get a minus one. ret ; ; Get the file name (including host to micro translation) ; called by: rfile gofil: lxi h,data ;Get the address of the file name. shld datptr ;Store the address. lxi h,fcb+1 ;Address of the FCB. shld fcbptr ;Save it. xra a sta temp1 ;Initialize the char count. sta temp2 sta fcb ;Set the drive to default to current. mvi b,' ' gofil1: mov m,b ;Blank the FCB. inx h inr a cpi 0CH ;Twelve? jm gofil1 gofil2: lhld datptr ;Get the NAME field. mov a,m cpi 'a' ;Force upper case jm gofl2a ; ani 5FH ; gofl2a: inx h cpi '.' ;Seperator? jnz gofil3 shld datptr ;[jd] update ptr (moved from above) lxi h,fcb+9H shld fcbptr lda temp1 sta temp2 mvi a,9H sta temp1 jmp gofil6 gofil3: ora a ;Trailing null? jz gofil7 ;Then we're done. shld datptr ;[jd] no, can update ptr now. lhld fcbptr mov m,a inx h shld fcbptr lda temp1 ;Get the char count. inr a sta temp1 cpi 8H ;Are we finished with this field? jm gofil2 gofil4: sta temp2 lhld datptr mov a,m inx h shld datptr ora a jz gofil7 cpi '.' ;Is this the terminator? jnz gofil4  ;Go until we find it. gofil6: lhld datptr ;Get the TYPE field. mov a,m cpi 'a' ;Force upper case jm gofl6a ; ani 5FH ; gofl6a: ora a ;Trailing null? jz gofil7 ;Then we're done. ;[jd] move above two lines so we don't increment pointer if char is null inx h shld datptr lhld fcbptr mov m,a inx h shld fcbptr lda temp1 ;Get the char count. inr a sta temp1 cpi 0CH ;Are we finished with this field? jm gofil6 gofil7: lhld datptr mvi m,'$' ;Put in a dollar sign for printing. call scrfln ;Position cursor lxi d,data ;Print the file name call prtstr lda flwflg ;Is file warning on? ora a jz gofil9 ;If not, just proceed. mvi c,openf ;See if the file exists. lxi d,fcb call bdos cpi 0FFH ;Does it exist? jz gofil9 ;If not create it. lxi d,infms5 call error3 lda temp2 ;Get the number of chars in the file name. ora a jnz gofil8 lda temp1 sta temp2 gofil8: mvi b,0 mov d,b ;Zero d for dad index into filename inr a ;Replace next char acter after filename cpi 9H ;Is the first field full? jnz gofl80 mvi b,0FFH ;Set a flag saying so. dcr a gofl80: mov e,a ;Keep current, replace index in d,e. gofl81: lxi h,fcb ;Get the FCB. dad d ;Add in the character number. mvi m,'&' ;Replace the char with an ampersand. push b push d lxi h,fcb ;Trim off any CP/M 2.2 attribute bits mvi c,1+8+3 ;so they do not affect the new file gofl82: mov a,m ; ani 7FH ; mov m,a ; inx h ; dcr c ; jnz gofl82 ; mvi c,openf ;See if the file exists. lxi d,fcb call bdos pop d pop b cpi 0FFH ;Does it exist? jz gofl89 ;If not create it. mov a,b ;Get the field-full flag. ora a ;Incr. or decr. ? jz gofl83 ;Jump if increment dcr e ;Decrement the number of chars. mov a,e ora a jz gofl88 ;If no more, die. jmp gofl81 gofl83: inr e ;Increment the number of chars. mov a,e cpi 9H ;Are we to the end? jm gofl81 ;If not try again. lda temp2 ;Get the original size. mov e,a mvi b,0FFH ;Set flag saying field-full, decrement jmp gofl81 gofl88: lxi d,erms16 ;Tell user that we can't rename it. call prtstr ret gofl89: mvi c,8 ;[jd] # of chars in name lxi d,fnbuf ;[jd] point to destination lxi h,fcb+1 ;[jd] source of name mvi b,0 ;[jd] first-time-thru flag gof89a: mov a,m ;[jd] get a char from the name inx h ;[jd] pass it cpi ' ' ;[jd] end of this part of name? jz gof89b ;[jd] yes, skip rest... stax d ;[jd] else drop char off inx d ;[jd] increment dest ptr dcr c ;[jd] decrement count jnz gof89a ;[jd] and continue if more to go gof89b: mov a,b ;[jd] ora a ;[jd] first time thru? jnz gof89c ;[jd] no, no period mvi a,'.' ;[jd] period between parts stax d ;[jd] inx d ;[jd] mvi b,0ffh ;[jd] not first time thru anymore mvi c,3 ;[jd] length of this part lxi h,fcb+9 ;[jd] start of extension jmp gof89a ;[jd] keep copying gof89c: mvi a,'$' stax d ;[jd] end the name string lxi d,fnbuf ;[jd] Print the file name call prtstr gofil9: call makfil ; Create the file. jmp gofl91 ; Disk was full. jmp rskp ; Success. gofl91: lxi d,erms11 call error3 ret ; ; This is the FINISH command. It tells the remote KERSRV to exit. ; here from kermit finish: call cfmcmd xra a sta numtry ;Inititialize count. mvi a,'1' ;Reset block check type to single character sta curchk ; . . . finsh1: lda numtry ;How many times have we tried? cpi maxtry ;Too many times? jm finsh3 ;No, try it. finsh2: lxi d,erms18 ;Say we couldn't do it. call prtstr jmp kermit ;Go home. finsh3: inr a ;Increment the number of tries. sta numtry xra a sta argblk ;Make it packet number zero. mvi a,1 sta argblk+1 ;One piece of data. lxi h,data mvi m,'F' ;Finish running Kermit. mvi a,'G' ;Generic command packet. call spack jmp finsh2 ; Tell the user and die. call rpack ;Get an acknowledgement. jmp finsh1 ; Go try again. cpi 'Y' ;ACK? jz kermit ;Yes, we are done. cpi 'E' ;Is it an error packet? jnz finsh1 ;Try sending the packet again. call error1 ;Print the error message. jmp kermit ; ; This is the LOGOUT command. It tells the remote KERSRV to logout. ; here from: kermit logout: call cfmcmd call logo ;Send the logout packet. jmp kermit ;Go get another command jmp kermit ; whether we succeed or not. ; do logout processing. ; called by: bye, logout logo: xra a sta numtry ;Inititialize count. mvi a,'1' ;Reset block check type to single character sta curchk ; . . . logo1: lda numtry ;How many times have we tried? cpi maxtry ;Too many times? jm logo3 ;No, try it. logo2: lxi d,erms19 ;Say we couldn't do it. call prtstr ret ;Finished. logo3: inr a ;Increment the number of tries. sta numtry xra a sta argblk ;Make it packet number zero. mvi a,1 sta argblk+1 ;One piece of data. lxi h,data mvi m,'L' ;Logout the remote host. mvi a,'G' ;Generic command packet. call spack jmp logo2 ; Tell the user and die. call rpack  ;Get an acknowledgement jmp logo1 ; Go try again. cpi 'Y' ;ACK? jz rskp ;Yes, we are done. cpi 'E' ;Is it an error packet? jnz logo1 ;Try sending the packet again. call error1 ;Print the error message. ret ;All done. ; ; Packet routines ; Send_Packet ; This routine assembles a packet from the arguments given and sends it ; to the host. ; ; Expects the following: ; A - Type of packet (D,Y,N,S,R,E,F,Z,T) ; ARGBLK - Packet sequence number ; ARGBLK+1 - Number of data characters ; Returns: nonskip if failure ; skip if success ; called by: read, rinit, rfile, rdata, sinit, sfile, sdata, seof, seot, ; finish, logout, nak, ackp spack: sta argblk+2 lxi h,packet ;Get address of the send packet. mvi a,soh ;Get the start of header char. mov m,a ;Put in the packet. inx h ;Point to next char. lda curchk ;Get current checksum type sui '1' ;Determine extra length of checksum mov b,a ;Copy length lda argblk+1 ;Get the number of data chars. adi ' '+ 3 ;Real packet character count made printable. add b ;Determine overall length mov m,a ;Put in the packet. inx h ;Point to next char. lxi b,0 ;Zero the checksum AC. mov c,a ;Start the checksum. lda argblk ;Get the packet number. adi ' ' ;Add a space so the number is printable. mov m,a ;Put in the packet. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A (Cannot be XRA A, since we can't ; touch carry flag) adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk+2 ;Get the packet type. mov m,a ;Put in the packet. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B spack2: lda argblk+1 ;Get the packet size. ora a ;Are there any chars of data? jz spack3 ; No, finish up. dcr a ;Decrement the char count. sta argblk+1 ;Put it back. mov a,m ;Get the next char. inx h ;Point to next char. add c mov c,a ;Add the packet number to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B jmp spack2 ;Go try again. spack3: lda curchk ;Get the current checksum type cpi '2' ;Two character? jz spack4 ;Yes, go handle it jnc spack5 ;No, go handle CRC if '3' mov a,c ;Get the character total. ani 0C0H ;Turn off all but the two high order bits. ;Shift them into the low order position. rlc ;Two left rotates same as 6 rights rlc ; . . . add c ;Add it to the old bits. ani 3FH ;Turn off the two high order bits. (MOD 64) adi ' ' ;Add a space so the number is printable. mov m,a ;Put in the packet. inx h ;Point to next char. jmp spack7 ;Go store eol character ;Here for 3 character CRC-CCITT spack5: mvi m,0 ;Store a null for current end push h ;Save H lxi h,packet+1 ;Point to first checksumed character call crcclc ;Calculate the CRC pop h ;Restore the pointer mov c,e ;Get low order half for later mov b,d ;Copy the high order mov a,d ;Get the high order portion rlc ;Shift off low 4 bits rlc ; . . . rlc ; . . . rlc ; . . . ani 0FH ;Keep only low 4 bits adi ' ' ;Put into printing range mov m,a ;Store the character inx h ;Point to next position ;Here for two character checksum spack4: mov a,b ;Get high order portion ani 0FH ;Only keep last four bits rlc ;Shift up two bits rlc ; . . . mov b,a ;Copy back into safe place mov a,c ;Get low order half rlc ;Shift high two bits rlc ;to low two bits ani 03H ;Keep only two low bits ora b ;Get high order portion in adi ' ' ;Convert to printing character range mov m,a ;Store the character inx h ;Point to next character mov a,c ;get low order portion ani 3FH ;Keep only six bits adi ' ' ;Convert to printing range mov m,a ;Store it inx h ;Bump the pointer spack7: lda dbgflg ora a ; is debugging enabled? jz spack8 push h ; yes. save address of end of packet mvi m,0 ; null-terminate the packet for display call sppos ; position cursor lxi h,packet+1 ; print the packet call dmptxt pop h ; restore address of end of packet spack8: lda seol ;Get the EOL the other host wants. mov m,a ;Put in the packet. inx h ;Point to next char. xra a ;Get a null. mov m,a ;Put in the packet. ; Write out the packet. outpkt: call selmdm ; Set up for output to comm port if iobyt lda spad ;Get the number of padding chars. sta temp1 outpk2: lda temp1 ;Get the count. dcr a ora a jm outpk6 ;If none left proceed. sta temp1 lda spadch ;Get the padding char. call setpar ;Set parity appropriately mov e,a ;Put the char in right AC. call outmdm ;Output it. jmp outpk2 outpk6: lxi h,packet ; Point to the packet. outlup: mov a,m ; Get the next character. ora a ; Is it a null? jz outlud ; If so return success. call setpar ; Set parity for the character mov e,a ; Put it in right AC  call outmdm ; and output it. ; TAC trap: If this character is the TAC intercept character, and the TAC ; trap is enabled, we have to output it twice. If the TAC trap is enabled, ; tacflg contains the intercept character. (The current character cannot ; be NUL, so we don't have to worry about doubling nulls in the message) lda tacflg ; get current intercept character, or zero. cmp m ; compare against current data character. jnz outpk8 ; if different, do nothing. call setpar ; match. set appropriate parity, mov e,a ; put it in the right register, call outmdm ; and output it a second time. outpk8: inx h ; Increment the char pointer. jmp outlup outlud: call selcon ; select console jmp rskp ; and return success ; ; Receive_Packet ; This routine waits for a packet to arrive from the host. It reads ; characters until it finds a SOH. It then reads the packet into packet. ; ; Returns: nonskip if failure (checksum wrong or packet trashed) ; skip if success, with ;  A - message type ; ARGBLK - message number ; ARGBLK+1 - length of data ; called by: rinit, rfile, rdata, ; sinit, sfile, sdata, seof, seot, finish, logout rpack: call inpkt ;Read up to the end-of-line character jmp r ; Return bad. rpack0: call getchr ;Get a character. jmp rpack ; Hit eol;null line;just start over. cpi soh ;Is the char the start of header char? jnz rpack0 ; No, go until it is. rpack1: call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta packet+1 ;Store in packet also mov c,a ;Start the checksum. lda curchk ;Get block check type sui '1' ;Determine extra length of block check mov b,a ;Get a copy mov a,c ;Get back length character sui ' '+3 ;Get the real data count. sub b ;Get total length sta argblk+1 mvi b,0 ;Clear high order half of checksum call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta argblk sta packet+2 ;Save also in packet add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk sui ' ' ;Get the real packet number. sta argblk call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sta temp1 ;Save the message type. sta packet+3 ;Save in packet add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B lda argblk+1 ;Get the number of data characters. sta temp2 lxi h,data ;Point to the data buffer. shld datptr rpack2: lda temp2 sui 1 ;Any data characters? jm rpack3 ; If not go get the checksum. sta temp2 call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. lhld datptr mov m,a ;Put the char into the packet. inx h ;Point to the next character. shld datptr add c mov c,a ;Add the character to the checksum. mvi a,0 ;Clear A adc b ;Get high order portion of checksum mov b,a ;Copy back to B jmp rpack2 ;Go get another. rpack3: call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Turn the char back into a number. sta temp3 ;Determine type of checksum lda curchk ;Get the current checksum type cpi '2' ;1, 2 or 3 character? jz rpack4 ;If zero, 2 character jnc rpack5 ;Go handle 3 character mov a,c ;Get the character total. ani 0C0H ;Turn off all but the two high order bits. ;Shift them into the low order position. rlc ;Two left rotates same as six rights rlc ; . . . add c ;Add it to the old bits. ani 3FH ;Turn off the two high order bits. (MOD 64) mov b,a lda temp3 ;Get the real received checksum. cmp b ;Are they equal? jz rpack7 ;If so, proceed. rpack9: call updrtr ;If not, update the number of retries. ret ;Return error. ;Here for three character CRC-CCITT rpack5: lhld datptr ;Get the address of the data mvi m,0 ;Store a zero in the buffer to terminate packet lxi h,packet+1 ;Point at start of checksummed region call crcclc ;Calculate the CRC mov c,e ;Save low order half for later mov b,d ;Also copy high order mov a,d ;Get high byte rlc ;Want high four bits rlc ; . . . rlc ;And shift two more rlc ; . . . ani 0FH ;Keep only 4 bits mov d,a ;Back into D lda temp3 ;Get first value back cmp d ;Correct? jnz rpack9 ;No, punt call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Remove space offset sta temp3 ;Store for later check ;... ;Here for a two character checksum and last two characters of CRC rpack4: mov a,b ;Get high order portion ani 0FH ;Only four bits rlc ;Shift up two bits rlc ; . . . mov b,a ;Save back in B mov a,c ;Get low order rlc ;move two high bits to low bits rlc ; . . . ani 03H ;Save only low two bits ora b ;Get other 4 bits mov b,a ;Save back in B lda temp3 ;Get this portion of checksum cmp b ;Check first half jnz rpack9 ;If bad, go give up call getchr ;Get a character. jmp r ; Hit end of line, return bad. cpi soh ;Is the char the start of header char? jz rpack1 ; Yes, then go start over. sui ' ' ;Remove space offset mov b,a ;Save in safe place mov a,c ;Get low 8 bits of checksum ani 3FH ;Keep only 6 bits cmp b ;Correct value jnz rpack9 ;Bad, give up rpack7: lhld datptr mvi m,0 ;Put a null at the end of the data. lda temp1 ;Get the type. jmp rskp ; ; inpkt - receive and buffer packet ; returns: nonskip if error (timeout) ; skip if success; packet starts at recpkt (which holds the SOH) ; and is terminated by a null. ; console is selected in either case. ; called by: rpack inpkt: lxi h,recpkt ;Point to the beginning of the packet. shld pktptr inpkt1: call inchr ;Get first character jmp r ;Return failure cpi soh ;is it the beginning of a packet? jnz inpkt1 ;if not, ignore leading junk jmp inpkt3 ;else go put it in packet inpkt2: call inchr ;Get a character. jmp r ; Return failure. cpi soh ;is it a new beginning of packet? jnz inpkt3 ;if not continue lxi h,recpkt ;else throw away what we've got so far shld pktptr ; inpkt3: lhld pktptr ; mov m,a ;Put the char in the packet. inx h shld pktptr mov b,a lxi d,-recpkx ;Start over if packet buffer overflow dad d ; jc inpkt ; lda reol ;Get the EOL char. cmp b jnz inpkt2 ;If not loop for another. ;... ;Begin IBM change/fdc ;This moved from OUTPK7 -- it appears that waiting until we're ;ready to send a packet before looking for turnaround character ;is long enough for it to get lost. Better to look now. lda ibmflg ;Is this the IBM? ora a jz inpkt6 ;If not then proceed. lda state ;Check if this is the Send-Init packet. cpi 'S' jz inpkt6 ;If so don't wait for the XON. inpkt5: call inchr ;Wait for the turn around char. jmp inpkt6 cpi xon ;Is it the IBM turn around character? jnz inpkt5 ;If not, go until it is. inpkt6: lhld pktptr ;Reload packet pointer ;End IBM change/fdc. dcx h ;Back up to end of line character mvi m,0 ;Replace it with a null to stop rpack: call selcon ;We've got the packet. Return to console. lda dbgflg ; Is debugging enabled? ora a jz inpkt7 inx h ; Point to next char. call rppos ; position cursor lxi h,recpkt+1 ; print the packet call dmptxt inpkt7: lxi h,recpkt shld pktptr ;Save the packet pointer. jmp rskp ;If so we are done. ; getchr - get next character from buffered packet. ; returns nonskip at end of packet. ; called by: rpack getchr: lhld pktptr ;Get the packet pointer. mov a,m ;Get the char. inx h shld pktptr ora a ;Is it the null we put at the end of the packet? jnz rskp ;If not return retskp. ret ;If so return failure. ; ; ; inchr - character input loop for file transfer ; returns: nonskip if timeout or character typed on console ; (console selected) ; skip with character from modem in A (parity stripped ; if necessary; modem selected) ; preserves bc, de, hl in either case. ; called by: inpkt inchr: push h ; save hl and bc push b lhld timout ;Get initial value for timeout shld timval ;[jd] inchr0: call selmdm ;select modem call inpmdm ;Try to get a character from the modem ora a jz inchr2 ;if zero, nothing there. mov b,a lda parity ;Is the parity none? cpi parnon mov a,b jz inchr1 ;If so just return. ani 7FH ;Turn off the parity bit. inchr1: pop b ;restore registers pop h jmp rskp ;take skip return, character in A inchr2: call selcon ;select console call inpcon ; Try to get a character from the console ora a jz inchr6 ;If not go do timer thing cpi cr ;Is it a carriage return? jz inchr4 ;If so return cpi ('Z'-100O) ;Control-Z? jz inchr5 ;Yes, go flag it cpi ('C'-100O) ;Control-C? jz inchr7 ;re-enter, he wants to get out cpi ('X'-100O) ;Control-X? jnz inchr6 ;No, ignore it. do timer thing. inchr5: adi 100O ;Convert to printing range sta czseen ;Flag we saw a control-Z inchr4: pop b ; restore registers pop h ret ;And return inchr6: lda timflg ;[jd] pick up timer flag ora a ;[jd] are we allowed to use timer? jz inchr0 ;[jd] no, don't time out lhld timval ; decrement fuzzy time-out dcx h ; shld timval ;((timout-1) * loop time) mov a,h ;(Retry if not time-out) ora l ; jnz inchr0 ; call updrtr ;Count as retry (?) pop b ;restore registers pop h ret ;and return to do retry inchr7: call clrtop ;[hh] clear screen and home cursor jmp kermit ;[hh] then re-enter kermit ; ; CRCCLC - Routine to calculate a CRC-CCITT for a string. ; ; This routine will calculate a CRC using the CCITT polynomial for ; a string. ; ; call with: HL/ Address of null-terminated string ; 16-bit CRC value is returned in DE. ; Registers BC and HL are preserved. ; ; called by: spack, rpack crcclc: push h ;Save HL push b ;And BC lxi d,0 ;Initial CRC value is 0 crccl0: mov a,m ;Get a character ora a ;Check if zero jz crccl1 ;If so, all done push h ;Save the pointer xra e ;Add in with previous value mov e,a ;Get a copy ani 0FH ;Get last 4 bits of combined value mov c,a ;Get into C mvi b,0 ;And make high order zero lxi h,crctb2 ;Point at low order table dad b ;Point to correct entry dad b ; . . . push h ;Save the address mov a,e ;Get combined value back again rrc ;Shift over to make index rrc ; . . . rrc ; . . . ani 1EH ;Keep only 4 bits mov c,a ;Set up to offset table lxi h,crctab ;Point at high order table dad b ;Correct entry mov a,m ;Get low order portion of entry xra d ;XOR with previous high order half inx h ;Point to high order byte mov d,m ;Get into D pop h ;Get back pointer to other table entry xra m ;Include with new high order half mov e,a ;Copy new low order portion inx h ;Point to other portion mov a,m ;Get the other portion of the table entry xra d ;Include with other high order portion mov d,a ;Move back into D pop h ;And H inx h ;Point to next character jmp crccl0 ;Go get next character crccl1: pop b ;Restore B pop h ;And HL ret ;And return, DE=CRC-CCITT CRCTAB: DW 00000H DW 01081H DW 02102H DW 03183H DW 04204H DW 05285H DW 06306H DW 07387H DW 08408H DW 09489H DW 0A50AH DW 0B58BH DW 0C60CH DW 0D68DH DW 0E70EH DW 0F78FH CRCTB2: DW 00000H DW 01189H DW 02312H DW 0329BH DW 04624H DW 057ADH DW 06536H DW 074BFH DW 08C48H DW 09DC1H DW 0AF5AH DW 0BED3H DW 0CA6CH DW 0DBE5H DW 0E97EH DW 0F8F7H ; ; This is where we go if we get an error during a protocol communication. ; error prints the error packet on line 6 or so, and aborts the ; transfer. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot ; error1 print CRLF followed by the error packet. ; called by: finish, logout ; error2 just prints the error packet. ; error3 positions cursor and prints error message specified in DE. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, ; seot, parwrn, gofil, outbuf error: call screrr ;Position the cursor. mvi a,'A' ;Set the state to abort. sta state jmp error2 error1: lxi d,crlf ;Print a CRLF. call prtstr error2: lda argblk+1 ;Get the length of the data. mov c,a mvi b,0 ;Put it into BC lxi h,data ;Get the address of the data. dad b ;Get to the end of the string. mvi a,'$' ;Put a dollar sign at the end. mov m,a lxi d,data ;Print error message call prtstr ret error3: push d ;Save the pointer to the message. call screrr ;Position the cursor. pop d ;Get the pointer back. call prtstr ;Print error message ret ; ; Set up for file transfer. ; called by read, send. init: lxi d,version ; point at Kermit's version string call sysscr ; fix up screen call selmdm ; select modem call flsmdm ; purge any pending data call selcon ; select console again. ret ; Set state to ABORT ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot, ; nak, ackp abort: mvi a,'A' ;Otherwise abort. sta state ret ; nak - send NAK packet ; here from: rinit, rfile, rdata ; nak0 - update retry count and send NAK packet ; here from: rinit, rfile, rdata, tryagn nak0: call updrtr ;Update number of retries. nak: lda pktnum ;Get the packet number we're waiting for. sta argblk xra a ;No data. sta argblk+1 mvi a,'N' ;NAK that packet. call spack jmp abort ; Give up. ret ;Go around again. ; increment and display retry count ; called by: rfile, sinit, sfile, sdata, seof, seot, ; nak, rpack, inchr, tryagn updrtr: call scrnrt ;Position cursor lhld numrtr inx h ;Increment the number of retries shld numrtr call nout ;Write the number of retries. ret ; [jd] this routine prints parity warnings. All registers are ; saved except for a. ; called by: sdata parwrn: push b push d push h lxi d,inms25 call error3 pop h pop d pop b ret ;[jd] end of addition ; print message in status field. address of message is in DE. ; called by: read, send finmes: push d ;Save message. call scrst ;Position cursor pop d ;Print the termination message call prtstr call scrend ;Position cursor for prompt ret ; Compare expected packet number against received packet number. ; return with flags set (Z = packet number valid) ; called by: rfile, rdata, sinit, sfile, sdata, seof, seot compp: lda pktnum ;Get the packet Nr. mov b,a lda argblk cmp b ret ; Increment the packet number, modulo 64. ; called by: rinit, rfile, rdata, sinit, sfile, sdata, seof, seot countp: inr a ;Increment packet Nr. ani 3FH ;Turn off the two high order bits sta pktnum ;Save modulo 64 of number lhld numpkt inx h ;Increment Nr. of packets shld numpkt ret ; Send an ACK-packet ; called by: rfile, rdata, tryagn ackp: xra a sta numtry ;Reset number of retries sta argblk+1 ;No data. (The packet number is in argblk) mvi a,'Y' ;Acknowledge packet call spack ;Send packet jmp abort ret ; ? ; called with A/ current retry count ; called by: rfile, rdata tryagn: inr a ;Increment it. sta oldtry ;Save the updated number of tries. lda pktnum ;Get the present packet number. dcr a ;Decrement ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number cmp b ;Is the packet's number one less than now? jnz nak0 ;No, NAK it and try again. call updrtr ;Update the number of retries. call ackp ret ; Output a null-terminated string to the console. We assume that the ; console has been selected. Called with HL = address of string. ; called by: spack, inpkt dmptxt: mov a,m ; get character from string ora a rz ; done if null push h ; save string address mov e,a ; move character to E for outcon call outcon ; output character to console pop h ; restore string address inx h ; point past printed character jmp dmptxt ; go output rest of string ; IF lasm LINK CP4TT ENDIF;lasm  ; called with A/ current retry count ; called by: rfile, rdata tryagn: inr a ;Increment it. sta oldtry ;Save the updated number of tries. lda pktnum ;Get the present packet number. dcr a ;Decrement ani 3FH ; modulo 64 mov b,a lda argblk ;Get the packet's number cmp b ;Is the packet's number one less than now? jnz nak0 ;No, NAK it and try again. call updrtr ;Update the number of retries. call ackp ret ; Output a null-terminated string to the console. We assume that th; CP4SYS.ASM ; KERMIT - (Celtic for "FREE") ; ; This is the CP/M-80 implementation of the Columbia University ; KERMIT file transfer protocol. ; ; Version 4.0 ; ; Copyright June 1981,1982,1983,1984,1985 ; Columbia University ; ; Originally written by Bill Catchings of the Columbia University Center for ; Computing Activities, 612 W. 115th St., New York, NY 10025. ; ; Contributions by Frank da Cruz, Daphne Tzoar, Bernie Eiben, ; Bruce Tanner, Nick Bush, Greg Small, Kimmo Laaksonen, Jeff Damens, and many ; others. ; ; This file contains the system-dependent code and data for KERMIT. ; It will be probably be broken into independent files to generate ; overlays for the various systems, one or more overlay possible ; from each file. For now, we will leave it in one piece. ; ; revision history: ; edit 12: February 6, 1985 ; Add extended H89 support (by Paul Milazzo, Rice University), ; support for Northstar Horizon with Northstar CP/M and SIO-4 board ; (by Joe Smith, Colorodo School of Mines), and support for Lobo ; MAX-80 computer (from Hal Hostetler) ; ; edit 11: 13-Jan-85 by Vanya J.Cooper Pima Commun. College Tel: 602-884-6809 ; ;pcc001 27-Dec-84 vjc modules: cp4sys,cp4typ ; Add conditional for Xerox 820. I thought at first I could ; live with the kaypro conditional, but it's enough of a pain ; that I added it back in. The clear-to-end-of-screen char ; is different, breaking many programs in VT52 mode, and the ; default escape char control-\, is not at all obvious how ; to type on the 820 keyboard. If you muddle through the ; key translation table, it turns out to be control-comma. ; Rather than OR xer820 all the occurances of kpII conditionals ; I added a bbI conditional for all common code for the big ; board I based machines that is automatically turned on by ; either kpII or xer820. This will also make it easier in ; the future if another flavor of bigboard is added. ; ; edit 10: 5 December 1984 by CJC ; Add missing ENDIF (tsk, tsk) ; ; edit 9: 4 December 1984 by CJC ; Add two osborne fixes: missing crlf in outlin:, incorrect opcode in ; initialization. ; ; edit 8: 13 October 1984 by L M Jones, JCC, for New York Botanical Garden ; Add support for CPT-85xx series word processors when running CP/M-80. ; ; edit 7: 29 August 1984 by Bdale Garbee @ CMU ; Add support for Digicomp Delphi 100 and Netronics Smartvid terminal. ; ; edit 6: August 21, 1984 ; Add flsmdm, to flush comm line on startup. ; Support multiple-sector buffering (except for osborne 1). ; ; edit 5: August 19, 1984 ; Add missing RET in outlpt: (*sigh*). Also preserve DE in case ; the BIOS destroys it. Add version string (sysedt, since sysver ; was already taken). ; ; edit 4: August 8, 1984 ; Running terminal output through the BDOS didn't work so well for ; the Kaypro. Remove the special check at outcon:. ; ; edit 3: August 3, 1984 ; move "mover" to CP4SYS from CP4UTL, so we can use Z80 block move. ; define Z80 true or false when setting up the rest of the parameters. ; (I'm only defining as Z80's the ones I KNOW are Z80's, because I ; don't want to break anything by guessing wrong). Make the values ; stored by sysinit in "speed" match the 16-bit values found in the ; speed table, so we can find them later. ; ; edit 2: July 27, 1984 (CJC) ; Add break capability for Kaypro II and bbII. ; Merge Toad Hall changes: Allow assembly with LASM, add support for ; Morrow Decision I. ; ; edit 1: May, 1984 ; extracted from CPMBASE.M80 version 3.9; modifications are described ; in the accompanying .UPD file. ; ; Keep module name, edit number, and last revision date in memory. sysedt: db 'CP4SYS.ASM (12) 6-Feb-85$' ; ; Assembly time message to let me know I'm building the right version. ; LASM generates an 'S' error along with the message, which is messy, but ; better than trying to put everything inside a IF m80 OR mac80 conditional, ; because LASM doesn't like nested IF's, either. IF robin .printx * Assembling KERMIT-80 for the DEC VT180 * ENDIF IF brain .printx * Assembling KERMIT-80 for the Intertec Superbrain * ENDIF IF vector .printx * Assembling KERMIT-80 for the Vector Graphics * ENDIF IF osi .printx * Assembling KERMIT-80 for the Ohio Scientific * ENDIF IF heath .printx * Assembling KERMIT-80 for the Heath/Zenith 89 * ENDIF IF z100 .printx * Assembling KERMIT-80 for the Heath/Zenith Z100 * ENDIF IF apple .printx * Assembling KERMIT-80 for the Apple ][ * ENDIF;apple IF apmmdm .printx * with Z80 Softcard & Micromodem II * ENDIF;apmmdm IF ap6551 .printx * with Z80 Softcard & 6551 ACIA * ENDIF;ap6551 IF trs80 .printx * Assembling KERMIT-80 for the TRS-80 II * ENDIF IF osbrn1 .printx * Assembling KERMIT-80 for the Osborne 1 * ENDIF IF telcon .printx * Assembling KERMIT-80 for the Telcon Zorba * ENDIF IF dmII .printx * Assembling KERMIT-80 for the DECmate II * ENDIF IF gener .printx * Assembling Generic KERMIT-80 * ENDIF IF cpm3 .printx * Assembling Generic KERMIT-80 for CP/M 3.0 * ENDIF IF kpii .printx * Assembling Kaypro II KERMIT-80 * ENDIF IF xer820 ;[pcc001] .printx * Assembling Xerox 820 KERMIT-80 * ENDIF ;[pcc001] IF bbII .printx * Assembling BigBoard II KERMIT-80 * ENDIF IF mdI .printx * Assembling for Morrow Decision I * ENDIF ;mdI [Toad Hall] IF mmdI .printx * Assembling for Morrow Micro Decision I * ENDIF ;mmdI IF mikko .printx * Assembling MikroMikko Kermit-80 * ENDIF IF delphi ;[7] .printx * Assembling Digicomp Delphi 100 Kermit-80 * ENDIF ;[7] IF cpt85xx .printx * Assembling CPT-85xx (under CompuPak CP/M) Kermit-80 * ENDIF IF norths .printx * Assembling for NorthStar Horizon with HSIO-4 board * ENDIF;norths IF lobo ;[hh] .printx * Assembling Kermit-80 for the Lobo MAX-80 * ENDIF;lobo [hh] ; Also tell what kind of terminal, if any, is selected IF crt .printx * generic CRT selected * ENDIF IF adm3a .printx * ADM3A selected * ENDIF IF smrtvd ;[7] .printx * Netronics Smartvid-80 selected * ENDIF ;[7] IF tvi925 .printx * TVI925 selected * ENDIF IF vt52 .printx * VT52 selected * ENDIF IF vt100 .printx * VT100 selected * ENDIF ; ;========================================================================= ; I/O Byte assignments (2-bit fields for 4 devices at loc 3) ; ;bits 6+7 LIST field ; 0 LIST is Teletype device (TTY:) ; 1 LIST is CRT device (CRT:) ; 2 LIST is Lineprinter (LPT:) ; 3 LIST is user defined (UL1:) ; ;bits 4+5 PUNCH field ; 0 PUNCH is Teletype device (TTY:) ; 1 PUNCH is high speed punch (PUN:) ; 2 PUNCH is user defined #1 (UP1:) ; 3 PUNCH is user defined #2 (UP2:) ; ;bits 2+3 READER field ; 0 READER is Teletype device (TTY:) ; 1 READER is high speed reader (RDR:) ; 2 READER is user defined #1 (UR1:) ; 3 READER is user defined #2 (UR2:) ; ;bits 0+1 CONSOLE field ; 0 CONSOLE is console printer (TTY:) ; 1 CONSOLE is CRT device (CRT:) ; 2 CONSOLE is in Batch-mode (BAT:);READER = Input, ; LIST = Output ; 3 CONSOLE is user defined (UC1:) ; ;========================================================================= iobyte EQU 03H ;Location of I/O byte ; the basics... IF robin OR gener batio EQU 056H ;I/O byte CON=BAT,LIST=CRT,READER=RDR,PUNCH=PTP defio EQU 095H ;I/O byte CON=CRT,LIST=LPT,READER=RDR,PUNCH=PTP ENDIF;robin OR gener IF gener crtio equ 01010101B ; use CRT: device ptrio equ 01010110B ; use PTR: device ttyio equ 00000000B ; use TTY: device uc1io equ 01010111B ; use UC1: device ur1io equ 01101010B ; use UR1: device ur2io equ 01111110B ; use UR2: device ENDIF;gener IF robin lptio EQU 054H ;I/O byte CON=TTY,LIST=CRT,READER=PTR,PUNCH=PTP gppio EQU 057H ;I/O byte CON=UC1,LIST=CRT,READER=RDR,PUNCH=PTP ENDIF;robin IF dmII batio EQU 042H ;I/O byte CON=BAT,LIST=CRT,READER=RDR defio EQU 081H ;I/O byte CON=CRT,LIST=LPT,READER=RDR ENDIF;dmII IF mikko batio EQU 10110010B ; I/O byte console => serial line defio EQU 10000001B ; I/O byte console => CRT and Keyboard ENDIF;mikko ; ; ; Protocol parameters. Some of these can be changed with commands. ; drpsiz EQU 5EH ;Default receive packet size. (maximum is 5EH) dspsiz EQU 20H ;Default send packet size. (maximum is 5EH) dstime EQU 08H ;Default send time out interval. IF NOT (apple OR osbrn1) drtime EQU 05H ;Default receive time out interval. ENDIF;NOT (apple OR osbrn1) IF apple OR osbrn1 drtime EQU 0AH ; Use longer receive timeout on apple and osborne. ENDIF;apple OR osbrn1 dspad EQU 00H ;Default send padding. drpad EQU 00H ;Default receive padding. dspadc EQU 00H ;Default send padding char. drpadc EQU 00H ;Default receive padding char. dseol EQU CR ;Default send EOL char. dreol EQU CR ;Default receive EOL char. dsquot EQU '#' ;Default send quote char. drquot EQU '#' ;Default receive quote char. dschkt EQU '1' ;Default checksum type ; IF lobo ;[hh] mnport EQU 0F7E4H ;Modem data port A mnprts EQU 0F7E5H ;Modem status/conrtol port A baudrt EQU 0F7D0H ;Baud rate port A output EQU 04H ;Transmit buffer empty input EQU 01H ;Receive data available z80 EQU TRUE ;a good z80, here ENDIF;lobo IF brain baudst EQU 60H ; baudrt EQU 0EF00H ;Memory location where baud rates are stored. mnport EQU 58H ;Modem data port mnprts EQU 59H ;Modem status port output EQU 01H ;Transmitter empty input EQU 02H ;Input data available z80 EQU FALSE ;I don't know... ENDIF;brain IF osi mnport EQU 0CF01H ;Modem data port mnprts EQU 0CF00H ;Modem status port output EQU 02H ;Transmitter empty input EQU 01H ;Input data available z80 EQU FALSE ;I don't know... ENDIF;osi IF vector mnport EQU 04H ;Modem data port mnprts EQU 05H ;Modem status port output EQU 01H ;Transmitter empty input EQU 02H ;Input data available z80 EQU FALSE ;I don't know... ENDIF;vector IF delphi ;[7] mnport EQU 22H ;[7] Modem data port mnprts EQU 23H ;[7] Modem status port output EQU 01H ;[7] Transmitter empty input EQU 02H ;[7] Input data available baudrt equ 29h ;[7] Baud rate port for channel 2 (default) z80 EQU true ;[7] We're using the z80 side of the dual processor ENDIF;[7] delphi IF heath ; Definitions for the 8250 ACE acerbr EQU 0 ; ACE Receiver Buffer Register offset (R/O) (DLAB = 0) acethr EQU 0 ; ACE Transmitter Holding Register offset (W/O) acedll EQU 0 ; ACE Divisor Latch (Low) (DLAB = 1) acedlh EQU 1 ; ACE Divisor Latch (High) (DLAB = 1) aceier EQU 1 ; ACE Interrupt Enable Register (DLAB = 0) aceiir EQU 2 ; ACE Interrupt Identification Register acelcr EQU 3 ; ACE Line Control Register acemcr EQU 4 ; ACE Modem Control Register acelsr EQU 5 ; ACE Line Status Register offset acemsr EQU 6 ; ACE Modem Status Register ace8bw EQU 00000011b ; 8 bit words acesb EQU 01000000b ; set break acedla EQU 10000000b ; divisor latch access acedtr EQU 00000001b ; data terminal ready aceloo EQU 00010000b ; loopback mode acedr EQU 00000001b ; data ready acethe EQU 00100000b ; transmitter holding register empty mnport EQU 330O ;Modem data port mnprts EQU mnport+acelsr ;Modem status port output EQU acethe ;Transmitter empty input EQU acedr ;Input data available z80 EQU TRUE ;H89 uses the Z80 ENDIF;heath IF z100 mnport EQU 0ECH ;Modem data port mnprts EQU 0EDH ;Modem status port output EQU 01H ;Transmitter empty input EQU 02H ;Input data available z80 EQU FALSE ;[hh] this one's an 8085. ENDIF;z100 IF trs80 ;NEEDS display definition (e.g. trs80lb or trs80pt) mnport EQU 0F4H ;Modem data port (0F5H for port B) mnprts EQU 0F6H ;Modem status port (0F7H for port B) output EQU 04H ;Transmitter empty input EQU 01H ;Input data available z80 EQU TRUE ;[hh] All TRS-80's but the CoCo ENDIF;trs80 IF apmmdm ;APPLE Slot 2 contains Micromodem II. MNPORT EQU 0E0A7H ;Communications Port. mnprts EQU 0E0A6H ;Communications Port Status. mnmodm EQU 0E0A5H ;Modem Control Port. orgmod EQU 8EH ;Modem Originate Mode. OUTPUT EQU 02H ;Output Buffer Empty. INPUT EQU 01H ;Input Register Full. apinc1 EQU 03H ;First Init Character for 6850 ACIA (Reset) apinc2 EQU 11H ;Second Init Character for ACIA (8-bits) apoffh EQU 80H ;Set if OFFHOOK AP300 EQU 1 ;300 Baud z80 EQU TRUE ;Z80 Softcard ENDIF;apmmdm IF ap6551 ;jb mnport EQU 0E088H+(10H*apslot) ;jb Communications Port. mnprts EQU 0E089H+(10H*apslot) ;jb Communications Port Status. mnprtc EQU 0E08BH+(10H*apslot) ;jb Communications Control mnprtm EQU 0E08AH+(10H*apslot) ;jb Communications Master (command) output EQU 10H ;jb Output Buffer Empty. input EQU 08H ;jb Input Register Full. mncinb EQU 18H ;jb Control Port Initialization Byte ;jb (8-bit, no parity, 1-stop, 1200 baud) mnminb EQU 0BH ;jb Master Port Initialization Byte ;jb (DTR, RTS, no interrupts) z80 EQU TRUE ;Z80 Softcard ENDIF;ap6551 IF osbrn1 ;Osborne 1 uses 6850 ACIA, but memory mapped. Derived from Apple. BAUDRT EQU 0EFC1H ;Memory location where baud rates are stored. OSTOP EQU 4000H ;Where we move OSMOVE to at startup OSPORT EQU 2A01H ;Communications Port. OSPRTS EQU 2A00H ;Communications Port Status. OUTPUT EQU 02H ;Output Buffer Empty. INPUT EQU 01H ;Input Register Full. OSBIN1 EQU 57H ;First Init Character for 6850 ACIA (Reset) ;(I would have thought 03, but prom code writes 57 there) OSBI12 EQU 55H ;Second Init Character for ACIA (8-bits, 1200) OSBI03 EQU 56H ;Second init char. for ACIA (8 bits, 300) ;(don't ask.. I don't know why SETUP writes 55 and 56 either) z80 EQU TRUE ;[hh] a z80 here, also ENDIF;osbrn1 IF telcon MNPORT EQU 20H ;Modem data port MNPRTS EQU 21H ;Modem status port OUTPUT EQU 01H ;Transmitter empty INPUT EQU 02H ;Input data available z80 EQU FALSE ;I don't know... ENDIF;telcon IF robin ;Those definitions below that are commented out are just for information ;***** NOT generally found in distributed documentation **** ;pbausl EQU 90H ;The Baud-Rate register. prntst EQU 49H ;Printer ;prndat EQU 48H contst EQU 41H ;Console ;condat EQU 40H gentst EQU 51H ;General port. ;gendat EQU 50H comtst EQU 59H ;COMM-Port ;comdat EQU 58H ;output EQU 01H ;Output ready bit. ;input EQU 02H ;Input ready bit. z80 EQU TRUE ; This one's a Z80. ENDIF;robin IF bbI  mnport equ 04h ; Modem data port mnprts equ 06h ; Modem status port output equ 04h ; Transmit buffer empty input equ 01h ; Receive data available baudrt equ 00h ; Baud rate port for channel A z80 EQU TRUE ; This one's a Z80. ENDIF;bbI IF norths ;The basic Northstar Horizon BIOS does not access ports 2-5 port0d equ 02h ;Port 0 data (console) port0s equ 03h ;Port 0 status port1d equ 04h ;Port 1 data (printer) port1s equ 05h ;Port 1 status port2b equ 10h ;Port 2 baud port2i equ 11h ;Port 2 interrupt mask port2d equ 12h ;Port 2 data port2s equ 13h ;Port 2 status port3b equ 14h ;Port 3 baud port3i equ 15h ;Port 3 interrupt mask port3d equ 16h ;Port 3 data port3s equ 17h ;Port 3 status port4b equ 18h ;Port 4 baud port4i equ 19h ;Port 4 interrupt mask port4d equ 1Ah ;Port 4 data port4s equ 1Bh ;Port 4 status port5b equ 1Ch ;Port 5 baud port5i equ 1Dh ;Port 5 interrupt mask port5d equ 1Eh ;Port 5 data port5s equ 1Fh ;Port 5 status NS19K2 EQU 00H ;19.2 kilobaud NS9600 EQU 01H ;9600 baud NS4800 EQU 02H ;4800 baud NS2400 EQU 03H ;2400 baud NS1200 EQU 04H ;1200 baud NS0600 EQU 05H ; 600 baud NS0300 EQU 06H ; 300 baud NS0110 EQU 07H ; 110 baud ;; Set to use port 5 at 1200 baud ***** mnport equ port5d ;Data port mnprts equ port5s ;Status port baudrt equ port5b ;Baud rate port baudini equ ns1200 ;Initial baud rate output EQU 1 ;Bit of UART status for transmitter ready input EQU 2 ;Bit of UART status for receiver ready z80 equ FALSE ENDIF;norths IF bbII mnport equ 80h ; Modem data port (SIO channel A) mnprts equ 81h ; Modem status port output equ 04h ; Transmit buffer empty input equ 01h ; Receive data available baudrt equ 89h ; Baud rate port for channel A z80 EQU TRUE ; This one's a Z80. ENDIF;bbII IF cpt85xx baudrt EQU 4Ch ; Baud rate generater (National MM5307) mnport EQU 4Bh ; Comm port data register (Intel 8251) mnprts EQU 4Ah ; Comm port command/status register output EQU 01h ; Transmitter buffer empty flag input EQU 02h ; Reciver buffer full flag TxEmpty EQU 04h ; Transmitter empty flag z80 EQU FALSE ; It's really an 8080 [or 8085 ... same thing] ENDIF;cpt85xx IF mmdI ;Morrow MicroDecision - the single-board one mnport EQU 0FEH ;Morrow Printer UART data port mnprts EQU 0FFH ;Morrow Printer UART command/status output EQU 01H ;Output ready bit. input EQU 02H ;Input ready bit. ;Note: Needs terminal definition (vt100, vt52, tvi925, adm3a or crt above) z80 EQU FALSE ;I don't know... ENDIF;mmdI IF mdI ;Morrow Decision I - the big sucker mnport equ 48H ; Modem data port. mnprts equ 4DH ; Modem status port. output equ 20H ; Transmitter empty. input equ 1 ; Input data available. mbase equ 48H ; Base address of Multi I/O port ; selector area. grpsel equ 4FH ; Group select port. rbr equ 48H ; Read Data Buffer. group equ 1 ; Multi I/O Group byte for serial ports. congrp equ 1 ; Serial Port 1 for console mdmgrp equ 3 ; Serial Port 3 for modem. ; Following are needed for baud rate changes...[Toad Hall] dlm equ 49H ; Baud Rate Divisor (Most Sig Bit) dll equ 48H ; Baud Rate Divisor (Least Sig Bit) ier equ 49H ; Interrupt Enable Register lcr equ 4BH ; Line Control Register lsr equ 4DH ; Line Status Register msr equ 4EH ; Modem Status Register dlab equ 80H ; Divisor Latch Access Bit wls0 equ 1 ; Word Length Select Bit 0 wls1 equ 2 ; Word Length Select Bit 1 for 8 bit word stb equ 4 ; Stop bit count - 2 stop bits imask equ 0 ; Interrupt mask (all disabled) z80 EQU TRUE ; This one's a Z80. ENDIF ;mdI NOTE: needs terminal definition. [Toad Hall] IF mikko sioac EQU 0FF12H ;SIO channel A register(s) address sioo3 EQU 01000001B ;SIO Write Reg. 3 original setup (?) ;RX 7 bits,synch mode bits 0,RX enable sion3 EQU 11001111B ;SIO Write Reg. 3 KERMIT setup ;RX 8 bits,synch mode bits 0,RX enable sioo4 EQU 01001111B ;SIO Write Reg. 4 original setup (?) ;X16 clock,8 bit synch(ignored), ;2stop bits,par even(on) sion4 EQU 01000100B ;SIO Write Reg. 4 KERMIT setup ;X16 clock,8 bit synch(ignored), ;1stop bit,par off sioo5 EQU 10101010B ;SIO Write Reg. 5 original setup (?) ;DTR,TX 7 bits,TX enable,RTS sion5 EQU 11101010B ;SIO Write Reg. 5 KERMIT setup ;DTR,TX 8 bits,TX enable,RTS txclk EQU 0FF30H ;Baud rate generator (CTC) for transmitter rxclk EQU 0FF31H ;Baud rate generator (CTC) for receiver chmask EQU 0F1F2H ;Mask byte address for SIO ch. A reception z80 EQU TRUE ;It's got a SIO and a CTC, it must be a Z80 ENDIF;mikko IF robin OR dmII z80 EQU TRUE ; This one's a Z80 ENDIF;robin OR dmII IF gener OR cpm3 ; To be truly generic, we must assume 8080. z80 EQU FALSE ENDIF;gener OR cpm3 ; IF brain OR osi OR apple OR telcon OR xer820 defesc EQU ']'-100O ;The default escape character. ENDIF;brain OR osi OR apple OR telcon OR xer820 IF vector defesc EQU '~' ;Vector can't type ']'. ENDIF;vector IF robin OR dmII OR mikko OR heath OR z100 OR osbrn1 OR kpII OR lobo defesc EQU '\'-100O ;The default is Control \ -- it's easier B.E. ENDIF;robin OR dmII OR mikko OR heath OR z100 OR osbrn1 OR kpII OR lobo IF crt OR vt100 OR vt52 OR tvi925 OR adm3a OR smrtvd OR cpt85xx defesc EQU '\'-100O ;Still Control-\ (just ran out of room...) ENDIF;crt OR vt100 OR vt52 OR tvi925 OR adm3a OR smrtvd OR cpt85xx IF trs80 defesc EQU '_'-100O ;CTRL-_ (Down-arrow on TRS-80 keyboard) ENDIF;trs80 ; Select initial setting for VT-52 emulation flag. IF crt ; If dumb or unknown console, vtval EQU 0FFH ; we can't support VT52 emulation ENDIF;crt IF heath OR z100 OR telcon OR vt52 ; If console looks like (or is) VT52 vtval EQU 0 ; we don't need VT52 emulation ENDIF;heath OR z100 OR telcon OR vt52 IF robin OR dmII OR vt100 ; If console looks like VT100 vtval EQU 0 ; we probably don't want VT52 emulation ENDIF;robin OR dmII OR vt100 ; If none of the above, default to VT52-EMULATION ON. IF NOT (crt OR heath OR z100 OR telcon OR vt52 OR robin OR dmII OR vt100) vtval EQU 1 ENDIF;NOT (crt OR heath OR z100 OR telcon OR vt52 OR robin OR dmII OR vt100) ; Set the fuzzy timeout value. Range is 1 (VERY short) through 0ffffH to zero ; (maximum). The actual duration is a function of the loop length and the ; processor speed. For now, we'll make it zero for everybody, but feel free ; to change it for your system. fuzval EQU 0 ; ; ; System-dependent initialization ; Called once at program start. sysinit: mvi c,getvnm ; get the BDOS version number (e.g. 22H, 31H) call bdos mov a,l sta bdosvr ; and store it away for future reference ; lxi d,cfgmsg ; "configured for " call prtstr lxi d,sysver ; get configuration we're configured for call prtstr ; print it. ; ; If we're set up to do special terminal handling, say what kind ; of terminal we expect... (unless it's the generic 'crt') IF adm3a OR tvi925 OR vt52 OR vt100 OR smrtvd ;[7] lxi d,witmsg ; " with " call prtstr lxi d,ttytyp ; terminal type call prtstr ENDIF;adm3a OR tvi925 OR vt52 OR vt100 OR smrtvd ;[7] call prcrlf ; print CR/LF ; ; now, to work... ; IF NOT osbrn1 ; locate large buffer for multi-sector I/O ; What we want to do here is find the ccp. Space between ovlend and the ccp ; is available for buffering, except we don't want to use more than maxsec ; buffers (if we use too many, the remote end could time out while we're ; writing to disk). maxsec is system-dependent, but for now we'll just ; use 8Kbytes. If you get retransmissions and other protocol errors after ; transferring the first maxsec sectors, lower maxsec. ; I'm excluding the Osborne 1 for now because it needs code up at 4000H, ; so we'd have to start the buffer after that. maxsec EQU (8*1024)/bufsiz ; 8K / number of bytes per sector lxi h,ovlend ; get start of buffer shld bufadr ; store in linkage section mvi a,maxsec ; get size of buffer, in sectors sta bufsec ; store that, too. ENDIF;NOT osbrn1 IF iobyt ; (actually, we ought to do this for everybody) call iniadr ;Initialize the BIOS addresses mvi c,gtiob ;Get current I/O byte call bdos ;From CP/M sta coniob ;Remember where console is ENDIF;iobyt IF osbrn1 lxi d,ostop ;where we're moving it to lxi h,osmove ;what we're moving mvi b,osmct ;How many bytes we're moving call mover lda baudrt ; Find out what speed is current ani 1 mvi a,osbi03 ; assume 300 baud jz osstr1 mvi a,osbi12 ; nope, it's 1200. osstr1: sta speed ; save initial speed sta speed+1 ; as 16 bits, to match speed table entries mov d,a mov e,a ; get initial speed in DE call sysspd ;set up parity etc. ENDIF;osbrn1 IF bbI OR bbII lxi d,siotbl ; Load the address of the status able mvi c,siolen ; Length of status table siolup: ;Loop back here for each command byte ldax d ; Load the first byte into A inx d ; Index the pointer out mnprts ; Send it to the status port dcr c ; Decrement the byte counter jnz siolup ; Jump back for more commands ENDIF;bbI or bbII IF cpt85xx mvi a,80h ; Send UART reset [force idle] by setting out baudrt ; bit 7 of baud rate I/O port mvi a,0Fh ; Clear reset bit and default to 9600 baud out baudrt mvi a,4Eh ; Set UART mode to async 16x clock, 8 data out mnprts ; bits, no parity, and 1 stop bit mvi a,37h ; Set command to Tx enable, DTR on, Rx enable, out mnprts ; break off, error reset, and RTS on ENDIF;cpt85xx IF lobo ;[hh] lxi d,siotbl ;[hh] address of status table mvi c,siolen ;[hh] length of the table siolup: ;[hh] loop here for each command byte ldax d ;[hh] load first byte into A inx d ;[hh] index pointer to next bute sta mnprts ;[hh] send it to status port A sta mnprts+2 ;[hh] and to status port B dcr c ;[hh] decrement the counter jnz siolup ;[hh] loop back for more commands mvi a,05H ;[hh] value for 300 baud sta baudrt ;[hh] starting default for port A sta baudrt+4 ;[hh] and for port B sta speed ;[hh] tell program they're set mvi a,0E4H ;[hh] value for port A sta port ;[hh] tell program we've set this, too mvi a,0D0H ;[hh] port A baud rate value sta port+1 ;[hh] save this as well, for consistancy ENDIF ;lobo IF mikko lxi d,mintbl ;Address of KERMIT Reg values (what) mvi c,minlen ;Length of table (how many) lxi h,sioac ;Send data to ch. A SIO registers (to where) call movmik mvi a,0FFH ;Set ch. A mask to use all bits sta chmask ENDIF;mikko IF brain lda baudrt ; fetch current baud rate ani 0F0H ; extract left nibble rrc ; shift right 4 places rrc rrc rrc sta speed ; store as comm port speed sta speed+1 ; (16 bits, to match speed table entries) ENDIF;brain IF mdI lxi h,96 ;Default 1200 baud modem port speed shld speed ;Store as modem port speed  call sysspd ;Initialize the port ENDIF;mdI [Toad Hall] IF ap6551 lda mnprtc ; read control port ani 0fH ; extract low order nybble sta speed ; store as comm line speed sta speed+1 ; (16 bits, to match speed table entries) mvi a,mnminb ;jb initialization routine sta mnprts ;jb sta mnprtm ;jb initialize master (command) port mvi a,mncinb ;jb sta mnprtc ;jb initialize control port ENDIF;ap6551 IF norths mvi a,baudini ;Get initial speed out baudrt sta speed ;save for status display sta speed+1 ENDIF;norths IF delphi ;[7] ; ; shove the default baud rate (1200) in to the Delphi port address ; for the baud rate generator on port 2, the default port; save this ; value so we can tell what speed is selected. ; mvi a,07h ;[7] get value for 1200 baud out baudrt ;[7] set it for port 2 sta speed ;[7] save for status display sta speed+1 ENDIF;[7] delphi ; IF heath ; ; System dependent startup for H89 ; call mdmofl ; keep the line safe from garbage ; First, tell Kermit the modem port's current speed in mnport+acelcr ori acedla out mnport+acelcr ; access the ACE's divisor latch in mnport+acedll ; get the low byte sta speed in mnport+acedlh ; and the high byte sta speed+1 ; Now set up the port for Kermit mvi a,ace8bw ; 8 data bits, 1 stop bit, no parity out mnport+acelcr in mnport+acemcr ori acedtr ; raise DTR (just in case) out mnport+acemcr call mdmonl ; and put the ACE back on line ret ; Take the ACE off line before modifying its state mdmofl: in mnport+aceier ; save the ACE's interrupt state sta iersav xra a out mnport+aceier ; and disable ACE interrupts in mnport+acemcr ; now put the ACE in loopback mode ori aceloo out mnport+acemcr ret ; Put the ACE back on line mdmonl: in mnport ; flush left-over garbage in the receive buffer mvi a,7 ; wait about 2 300-baud character times call delay in mnport ; and flush more garbage in mnport+acemcr ; take the ACE out of loopback mode ani 0FFH-aceloo out mnport+acemcr lda iersav out mnport+aceier ; and restore the ACE's interrupt state ret iersav: ds 1 ENDIF;heath ret ; return from system-dependent routine bdosvr: ds 1 ; space to save the BDOS version number ; IF iobyt ; This one is hopefully the last "improvement" in view of GENERIC ;Kermit. It uses for Character-I/O the BIOS-routines ( instead of the ;"normal" BDOS routines. What does it give us (hopefully) : More speed, ;higher chance of success ( I/O byte implemented in BIOS [if at all]), ;but no "extra" device handling - that's done by BDOS. ; ; How do we "get" the call-adresses? Location 0 has a JMP Warm-Boot ;in CP/M which points into the second location of the BIOS JMP-Vector. The ;next three locations of the JMP-Vector point to the CONSTAT,CONIN,CONOUT ;BIOS-routines. CONOUT wants the character in C. ; ;- Bernie Eiben iniadr: lhld 1 ;get BIOS Warmstart-address lxi d,3 ;next adress is CONSTAT in BIOS dad d shld bconst+1 ;stuff it into the call-instruction lxi d,3 ;next adress is CONIN in BIOS dad d shld bconin+1 ; lxi d,3 ;next adress is CONOUT in BIOS dad d shld bcnout+1 lxi d,3 ;next address is LIST in BIOS dad d shld blsout+1 ret ;And return bconst: jmp $-$ ;Call BIOS directly (filled in by iniadr) bconin: jmp $-$ ;Call BIOS directly (filled in by iniadr) bcnout: jmp $-$ ;Call BIOS directly (filled in by iniadr) blsout: jmp $-$ ; .... ENDIF;iobyt IF mikko ;currently for MIKROMIKKO only ; copy command block into memory-mapped SIO. movmik: di ;disable interrupts movmk1: ldax d ;Get a register value mov m,a ;Output it inx d ;Next value dcr c ;Decrement counter jnz movmk1 ;Repeat until done ei ret ENDIF;mikko ; IF osbrn1 osmove: osflag equ 0EF08H ;Osborne 1 Bank-2 flag ; ; return modem status in A ; OSLDST EQU ostop-osmove+$ DI OUT 0 LDA osprts ;Read the status port OUT 1 EI ret ; ; set modem status from A ; OSSTST equ ostop-osmove+$ DI  OUT 0 STA osprts ;Write the control port jmp osstex ; ; read character from modem into A ; OSLDDA equ ostop-osmove+$ DI OUT 0 LDA osport OUT 1 EI ret ; ; output character in A to modem ; OSSTDA equ ostop-osmove+$ DI OUT 0 STA osport osstex equ ostop-osmove+$ OUT 1 mvi a,1 sta osflag EI ret osmct equ $-osmove ENDIF;osbrn1 IF bbI OR bbII OR lobo ; List of commands to set up SIO channel A for asynchronous operation. siotbl: DB 18H ; Channel reset DB 18H ; another, in case register 0 wasn't selected DB 04H ; Select register 4 DB 44H ; 1 stop bit, clock*16 DB 01H ; Select register 1 DB 00H ; No interrupts enabled DB 03H ; Select register 3 DB 0C1H ; Rx enable, 8 bit Rx character DB 05H ; Select register 5 DB 0EAH ; Tx enable, 8 bit Tx character, ; raise DTR and RTS siolen equ $-siotbl ; length of command list ENDIF;bbI or bbII OR lobo IF mikko ; command list to set SIO chip back to normal state miotbl: db 3 ;reg. 3 db sioo3 db 5 ;reg. 5 db sioo5 db 4 ;reg. 4 db sioo4 db 0 ;reselect reg. 0 miolen equ $-miotbl ;MikroMikko SIO table length (original values) ; command list to set up SIO chip for operation with Kermit mintbl: db 3 ;reg. 3 db sion3 db 5 ;reg. 5 db sion5 db 4 ;reg. 4 db sion4 db 0 ;reselect reg. 0 minlen equ $-mintbl ;MikroMikko SIO table length (KERMIT values) ENDIF;mikko ; ; ; system-dependent termination processing ; If we've changed anything, this is our last chance to put it back. sysexit: IF mikko lxi d,miotbl ;Load the adress of original reg values mvi c,miolen ;Length of table lxi h,sioac ;Send data to ch A SIO registers call movmik mvi a,07FH ;Set ch A mask to use just 7 bits sta chmask ENDIF;mikko IF cpt85xx mvi a,80h ; Reset (force idle) the 8251 UART via bit 7 out baudrt ; of the baud rate generater port mvi a,00h ; and turn off the baud rate generater out baudrt ENDIF;cpt85xx ret ; ; system-dependent processing for start of CONNECT command ; syscon: IF apmmdm call ckdial ;See if dialing is required. jmp kermit ;Go to command loop if aborted. ENDIF;apmmdm IF robin OR trs80 OR cpt85xx ;For Robin/TRS80/CPT-85xx, add some more info lxi d,conmsg ; about obscure key combinations call prtstr ENDIF;robin OR trs80 OR cpt85xx IF osbrn1 ;*** This is Software dependent *** lhld 1 ;Modify back-arrow code to DELETE mvi l,0 ;Get BIOS-start address lxi d,85H ;Adress for key-code = XX85H dad d mov e,m ;Get it in DE inx h mov d,m xchg ;Memory pointer to HL mvi m,del ;modify the code ENDIF;osbrn1 ret conmsg: ; Messages printed when entering transparent (CONNECT) mode: IF robin ; for Robin, control-S key is hidden db ' (Type Left Arrow to send CTRL-S)',cr,lf,'$' ENDIF;robin IF trs80 ; for TRS-80, the preferred escape key is hidden db ' (Control-_ is the Down-Arrow key on the TRS-80 keyboard)' db cr,lf,'$' ENDIF;trs80 IF cpt85xx ; for CPT-85xx, some graphics map "funny" to keyboard in CP/M db ' (Use CODE + SHIFT + 1/2 key to generate a Control-\)' db cr,lf,'$' ENDIF;cpt85xx ; IF apmmdm ;This code was mostly taken from ; APMODEM.ASM V2.1 ; Based on MODEM.ASM by Ward Christensen ; Modified for the Apple ][ by Gordon Banks 1-Jan-81 ; Micromodem ][ dialer option by Dav Holle 2-Feb-81 ; Code modified for KERMIT by Scott Robinson 14-Oct-82 ; ;Come here to see if we need to dial a number. ; ckdial: lda mnport ;access the data port lda mnprts ;check status ani 4 ;do we already have carrier? jz rskp ;Yes, just continue xra a ;Hangup Phone for starters sta mnmodm lxi b,1000 ;Delay for a second call delay mvi a,8FH ;orgmod+ap300+apoffh sta holdd ;storing mode for after dialing mvi A,8DH ;Go Offhook to start dialing sequence sta mnmodm mvi a,apinc1 ;Init ACIA sta mnport mvi a,apinc2 ;Set ACIA bits per character sta mnport lxi b,2500 ;wait 2.5 seconds for dial tone call delay lxi d,dialms ;Ask the user for the number call prtstr ; gtdial: mvi c,conin ;Get a character call bdos push psw ;save it cpi 30H ;is it big enough to dial? jc dialed ;no cpi 3AH ;is it too big to dial? jnc dialed ;yes ani 0FH ;ok, it's a digit, get its value jnz dialnz ;dial nonzero digits as-is mvi A,10 ;dial zero as ten ; dialnz: mov e,a ;count pulses in E-reg dopuls: mvi a,0DH ;put it on-hook sta mnmodm lxi b,61 ;61-millisec pulse call delay mvi a,8DH ;take it off-hook again... sta mnmodm lxi b,39 ;39-millisec delay between pulses call delay dcr e ;any more pulses to do? jnz dopuls ;yep, do 'em lxi b,600 ;delay 600 msecs between digits call delay ; dialed: pop psw ;get back the char cpi cr ;do we have a CR (done dialing)? jnz gtdial ;no, keep on dialin' lxi d,dialm2 call prtstr tictoc: mvi c,dconio ;Direct console input. mvi e,0FFH call bdos ora a ;Have a charcter? jnz nodial ;If so we abort lda mnport ;access the data port lda mnprts ;get modem status ani 4 ;carrier? jnz tictoc ;No ; lda holdd ;get the old modem control byte sta mnmodm ;turn our carrier on lxi d,dialm3 call prtstr jmp rskp nodial: xra a ;Hangup the modem. sta mnmodm ret ;Return to abort the command. ; holdd: db 0 ;Modem setup code dialms: DB 'Number to Dial: $' dialm2: DB CR,LF,'Awaiting Carrier....(any key aborts)$' dialm3: DB cr,lf,'Connected.',CR,LF,'$' ; ;DELAY wait for the number of millisecs in B,C ; delay: push b ;save B,C push d ;save D,E inr b ;bump B for later DCR ; delay1: mvi e,126 ;delay count for 1 millisec (Apple Z80 ;clock=2.041MHz) ; delay2: dcr e ;count jnz delay2 ;down ; dcr c ;more millisecs? jnz delay1 ;yes dcr b ;no - more in hi byte? jnz delay1 ;yes pop d ;no, restore D,E pop b ; restore B,C ret ENDIF;apmmdm ; ; ; syscls - system-dependent close routine ; called when exiting transparent session. ; syscls: IF osbrn1 lhld 1 ;Modify back-arrow code to BACKSPACE mvi l,0 ;Get BIOS address lxi d,85H ;Address for key-code =XX85H dad d mov e,m ;Get it in DE inx h mov d,m xchg ;Address to HL mvi m,bs ;Modify code ENDIF;osbrn1 ret ; ; ; sysinh - help for system-dependent special functions. ; called in response to ?, after listing all the ; system-independent escape sequences. ; sysinh: IF apmmdm OR robin OR dmII OR bbII OR bbI OR cpt85xx OR heath OR lobo lxi d,inhlps ; we got options... call prtstr ; print them. ENDIF;apmmdm OR robin OR dmII OR bbII OR bbI OR cpt85xx OR heath OR lobo ret ;additional, system-dependent help for transparent mode ; (two-character escape sequences) inhlps: IF robin OR dmII OR bbII OR bbI OR cpt85xx OR heath OR lobo db cr,lf,'B Transmit a BREAK' ENDIF;robin OR dmII OR bbII OR bbI OR cpt85xx OR heath OR lobo IF apmmdm OR heath OR lobo db cr,lf,'D Drop the line' ENDIF;apmmdm OR heath OR lobo db '$' ;[hh] table terminator ; ; sysint - system dependent special functions ; called when transparent escape character has been typed; ; the second character of the sequence is in A (and in B). ; returns: ; non-skip: sequence has been processed ; skip: sequence was not recognized sysint: ani 137O ; convert lower case to upper, for testing... IF apmmdm cpi 'D' ;Disconnect Modem? jnz intc00 ;No. xra a ;Yes, hangup the modem sta mnmodm ret ; command has been executed intc00: ENDIF;apmmdm IF heath cpi 'D' ; drop line? jnz intc00 ; no: try next function character mdmdrp: in mnport+acemcr ; (we also get here from sysbye) ani 0FFH-acedtr out mnport+acemcr ; yes: drop DTR mvi a,50 ; for half a second call delay in mnport+acemcr ori acedtr out mnport+acemcr ; and then restore it ret intc00: ENDIF;heath IF robin OR dmII OR bbI OR bbII OR cpt85xx OR heath OR lobo cpi 'B' ; send break? jz sendbr ; yes, go do it. return nonskip when through. ENDIF;robin OR dmII OR bbI OR bbII OR cpt85xx OR heath OR lobo IF lobo ;[hh] cpi 'D' ;[hh] disconnect? jz discon ;[hh] yes, go do it. nonskip return when done. ENDIF ;lobo jmp rskp ; take skip return - command not recognized. ; IF robin ;Definitions & code to send a BREAK (ungenerically, no other way). comctl equ 59h ;VT180 communications port crtctl equ 41h ;VT180 crt port ;VT180 serial port command bits txe equ 1 ;transmit enable dtr equ 2 ;dtr on rxe equ 4 ;rx enable sndbrk equ 8 rerr equ 10h ;reset error rts equ 20h ;RTS on reset equ 40h ;port reset ;Send a break to the communications port. ; sendbr: lxi h,38500 ;250 ms(?) lda prtadr ;Get address of selected port mov c,a ;Into C mvi a,sndbrk+dtr ; OUT C,A ;Want to send to port addressed by C db 0EDH,079H ;Op code for above instruction sndbr1: dcx h ;timing loop... mov a,l ora h jnz sndbr1 ;...until over lda prtadr ;Get the address for the port mov c,a ;Into C mvi a,txe+dtr+rxe+rerr+rts ;enable tr/rc, dtr, reset error ; out c,a ;Z-80 only instruction db 0EDH,079H ;Op code for above instruction out contst ;reset ports ret ENDIF;robin ; IF dmII ;[jd] this added to send break on DECmate ; DECmate command codes for 6120 I/O processor oboff equ 3fh ; offset of outbyt routine for 6120 prtctl equ 02h ; port control brdat equ 06h ; data to tell 6120 to send a break brdur equ 30 ; duration, 30 = 300 ms. sendbr: lxi b,(brdat * 100h) + prtctl ; c/prtctl, b/brdat call outbyt lxi b,brdur*100h ; b/duration, c/0 ; fall through into outbyt outbyt: lhld 1 ; get warm boot address lxi d,oboff ; offset of outbyt routine dad d ; compute address pchl ; branch there (a callret) ENDIF;dmII ; IF bbI OR bbII ;[cjc] send break on Kaypro and bbII ; Officially, a "break" is 300 milliseconds of "space" (idle line is ; "mark"). (or maybe 200 milliseconds; I forget.) The timing isn't ; usually that critical, but we'll make an attempt, at least. Sending ; too long a break can cause some modems to hang up. sendbr: ; First, make sure the transmitter is really empty. (The SIO sets ; "transmitter buffer empty" when it can accept another character; ; the previous character is still being shifted onto the line. ; Another status bit, "all done", is set to indicate that the ; transmitter is really idle. sndbr1: mvi a,1 ; select Read Register 1 out mnprts in mnprts ; read the contents ani 1 ; test "all done" flag jz sndbr1 ; loop until it's nonzero. ; ; Next, set the "send break" bit to start the transmitter spacing. mvi a,5 ; select Write Register 5 out mnprts mvi a,0FAH ; Tx enable, 8 bit Tx character, Send Break, out mnprts ; DTR and RTS on. ; ; Now, delay for 30 hundredths of a second mvi a,30 ; delay count call delay ; ; Time's up. Put transmitter back in normal state (data byte is the ; same as the one in siotbl: for Write Register 5) and return. mvi a,5 ; select Write Register 5 out mnprts mvi a,0EAH ; Tx enable, 8 bit Tx character, out mnprts ; DTR and RTS on. ret ; done. ENDIF;bbI OR bbII IF lobo ;[hh] This routine sends a break tone or disconnects a modem ; (those that respond to it) by setting the DTR line low ; for 300 ms. ; sendbr: mvi a,05H ;[hh] write register 5 call outctl ;[hh] send it to control port mvi a,0FAH ;[hh] value to send break tone jmp sndbr1 ;[hh] ; discon: mvi a,05H ;[hh] write register 5 call outctl ;[hh] send it to the control port mvi a,06AH ;[hh] DTR off and break tone on sndbr1: call outctl ;[hh] send to control port mvi a,30 ;[hh] delay count for 300 ms. call delay ;[hh] wait a while... mvi a,05H ;[hh] write register 5 call outctl ;[hh] get it's attention mvi a,0EAH ;[hh] normal 8 bits, DTR on, RTS on, etc. call outctl ;[hh] restore SIO ret ; outctl: sta mnprts ;[hh] ret ENDIF ;lobo ; IF cpt85xx ;[lmj] send break on cpt85xx sendbr: ; ; Ensure that the transmitter has finished sending buffered chars sndbr1: in mnprts ; get UART status ani TxEmpty ; everything sent? jz sndbr1 ; no, wait a bit more ; ; Begin sending a break by setting bit in UART command register mvi a,3Fh ; Set TxEna, DTR, RxEna, SBreak, ErrRst, RTS out mnprts ; ; Wait for 250 milliseconds (using hundredths second dealy routine) mvi a,25 call delay ; ; Resume normal operation by clearing the SendBreak command bit mvi a,37h ;Set TxEna, DTR, RxEna, ErrRst, RTS out mnprts ; ret ;done ENDIF;cpt85xx ; IF heath ; ; Send BREAK on H89 ; sendbr: in mnport+acelcr ori acesb out mnport+acelcr ; set ACE break condition mvi a,30 call delay ; wait 300 milliseconds in mnport+acelcr ani 0FFH-acesb out mnport+acelcr ; and clear ACE break condition ret ENDIF;heath IF bbI OR bbII OR cpt85xx OR heath OR lobo ; ;[cjc] Delay routine. Called with time (hundredths of seconds) in A. ; The inner loop delays 1001 T-states, assuming no wait states are ; inserted; this is repeated CPUSPD times, for a total delay of just ; over 0.01 second. (CPUSPD should be set to the system clock rate, ; in units of 100KHz: for an unmodified Kaypro II, that's 25 for ; 2.5 MHz. Some enterprising soul could determine whether or not the ; Kaypro actually inserts a wait state on instruction fetch (a common ; practice); if so, the magic number at delay2 needs to be decreased. ; (We also neglect to consider time spent at interrupt level). ; ; called by: sendbr ; destroys BC delay: mvi c,cpuspd ; Number of times to wait 1000 T-states to ; make .01 second delay delay2: mvi b,70 ; Number of times to execute inner loop to ; make 1000 T-state delay delay3: dcr b ; 4 T-states (* 70 * cpuspd) jnz delay3 ; 10 T-states (* 70 * cpuspd) dcr c ; 4 T-states (* cpuspd) jnz delay2 ; 10 T-states (* cpuspd) ; total delay: ((14 * 70) + 14) * cpuspd ; = 1001 * cpuspd dcr a ; 4 T-states jnz delay ; 10 T-states ret ; grand total: ((1001 * cpuspd) + 14) * a ENDIF;bbI OR bbII OR cpt85xx OR heath OR lobo ; ; ; sysflt - system-dependent filter ; called with character in E. ; if this character should not be printed, return with A = zero. ; preserves bc, de, hl. ; note: ,,, and are always discarded. sysflt: mov a,e ; get character for testing IF mikko cpi 'O'-100O ;Control-O's lock keyboard rnz ; if not control-O, it's ok. xra a ; don't allow control-O out. ENDIF;mikko ret ; ; ; system-dependent processing for BYE command. ; for apmmdm, heath, and lobo, hang up the phone. sysbye: IF apmmdm xra a ;Hangup our end, too. sta mnmodm ENDIF;apmmdm IF heath call mdmdrp ; Sleazy but effective ENDIF;heath IF lobo ;[hh] call discon ;[hh] force modem to hang up ENDIF;lobo ret ; ; This is the system-dependent command to change the baud rate. ; DE contains the two-byte value from the baud rate table; this ; value is also stored in 'speed'. sysspd: ; Set the speed for the Brain IF brain lda baudrt ;Get the present baud rates. ani 0fH ;turn off the left mov d,a ;Set it aside. mov a,e ;Get the new baud rate. rlc  ;Shift left 4 places. rlc rlc rlc ora d ; combine with the old baud rate sta baudrt ;Store the new baud rates. out baudst ;Set the baud rates. ret ENDIF;brain ; Set the speed for the Osborne I IF osbrn1 mvi a,osbin1 ;Reset the ACIA call osstst ;Write the control port osbs1: inr c ;Waiting loop jnz osbs1 mov a,e ; get the specified speed jmp osstst ;Write the control reg. ENDIF;osbrn1 ; Set the speed for bigboard II IF bbII di ; don't let anything between the data bytes mvi a,01000111b ; get the command byte (load time constant) out baudrt ; output it to CTC mov a,e ; Get the parsed value. out baudrt ; Tell the baud rate generator. ei ; end of critical section ret ENDIF;bbII ;[hh] set the speed for a lobo MAX-80 IF lobo mov a,e ;[hh] get the parsed value setbd: sta baudrt ;[hh] and send it to the baud rate port ret ;[hh] ENDIF;lobo ; Set the speed for bigboard I or the delphi or the CPT-85xx or Northstar IF bbI OR delphi OR cpt85xx mov a,e ; get the parsed value out baudrt ; Tell the baud rate generator. ret ENDIF;bbI OR delphi OR cpt85xx OR norths ; Set the speed for MicroMikko. DE is baud rate multiplier IF mikko di lxi h,txclk mov m,d ;LSB first (swapped in memory) mov m,e ;MSB last lxi h,rxclk mov m,d mov m,e mvi b,0 ;"modifier" for 1 stop bit mvi a,2 ;Test MSB of speed >2 (110 bps or less) cmp e jp miksp1 mvi b,00001000B ;"modifier" for 2 stop bits miksp1: mvi a,4 ;Select SIO Reg 4 lxi h,sioac mov m,a mvi a,sion4 ;Get values ora b ;Add modifier mov m,a ;Set value (stop bits) ei ret ENDIF;mikko ; Set the speed for Apple with 6551 ACIA IF ap6551 lda mnprtc ;jb read control port ani 0F0H ;jb zap low order nybble ora e ;jb put rate in low order nybble sta mnprtc ;jb send to control port ret ENDIF;ap6551 ; Set the speed for the Decision I IF mdI call selmdm ;Let's be absolutely sure, huh? mvi a,dlab+wls1+wls0+stb ;Set data latch access bit out lcr ;Out to Line Control Register lhld speed ;Load baudrate multiplier xchg mov a,d ;Get low order byte for baud rate out dlm ;Out to the MSB divisor port mov a,e ;...and the high order byte out dll ;Out to the LSB divisor port mvi a,wls1+wls0+stb ;Enable Divisor Access Latch out lcr ;Out to ACE Line Control Register xra a ;Clear A out ier ;Set no interrupts out lsr ;Clear status in msr ;Clear Modem Status Register in lsr ;Clear Line Status Register in rbr ;Clear Receiver Buffers in rbr ret ENDIF ;mdI [Toad Hall] IF heath ; ; Set speed for H89 ; call mdmofl ; keep the line safe from garbage in mnport+acelcr ori acedla out mnport+acelcr ; access the ACE's divisor latch mov a,e ; low byte of speed is in E out mnport+acedll ; set the low byte mov a,d ; high byte of speed is in D out mnport+acedlh ; set the high byte in mnport+acelcr ani 0FFH-acedla out mnport+acelcr ; de-access the ACE's divisor latch call mdmonl ; and put the ACE back on line ret ENDIF;heath ; ; Speed tables ; (Note that speed tables MUST be in alphabetical order for later ; lookup procedures, and must begin with a value showing the total ; number of entries. The speed help tables are just for us poor ; humans. ; db string length,string,divisor (2 identical bytes or 1 word) ; [Toad Hall] IF bbI OR brain OR delphi OR lobo ;[hh] spdtbl: db 10h ;16 entries db 03h,'110$', 02h,02h db 04h,'1200$', 07h,07h db 05h,'134.5$', 03h,03h db 03h,'150$', 04h,04h db 04h,'1800$', 08h,08h db 05h,'19200$', 0fh,0fh db 04h,'2000$', 09h,09h db 04h,'2400$', 0ah,0ah db 03h,'300$', 05h,05h db 04h,'3600$', 0bh,0bh db 04h,'4800$', 0ch,0ch db 02h,'50$', 00h,00h db 03h,'600$', 06h,06h db 04h,'7200$', 0dh,0dh db 02h,'75$', 01h,01h db 04h,'9600$', 0eh,0eh sphtbl: db cr,lf,' 50 75 110 134.5 150 300 600 1200' db cr,lf,' 1800 2000 2400 3600 4800 7200 9600 19200$' ENDIF;bbI OR brain OR delphi OR lobo ;[hh] IF bbII spdtbl: db 8 ; 8 entries db 04h,'1200$', 20h,20h db 05h,'19200$', 02h,02h db 04h,'2400$', 10h,10h db 03h,'300$', 80h,80h db 05h,'38400$', 01h,01h db 04h,'4800$', 08h,08h db 03h,'600$', 40h,40h db 04h,'9600$', 04h,04h sphtbl: db cr,lf,' 300 600 1200 2400 4800 9600 19200 38400$' ENDIF;bbII IF cpt85xx spdtbl: db 15 ; 15 entries db 03,'110$', 03h,03h db 04,'1200$', 09h,09h db 05,'134.5$', 04h,04h db 03,'150$', 05h,05h db 04,'1800$', 0Ah,0Ah db 04,'2400$', 0Bh,0Bh db 03,'300$', 06h,06h db 04,'3600$', 0Ch,0Ch db 04,'4800$', 0Dh,0Dh db 02,'50$', 01h,01h db 03,'600$', 07h,07h db 04,'7200$', 0Eh,0Eh db 02,'75$', 02h,02h db 03,'900$', 08h,08h db 04,'9600$', 0Fh,0Fh sphtbl: db cr,lf,' 50 75 110 134.5 150 300 600 900' db cr,lf,' 1200 1800 2400 3600 4800 7200 9600$' ENDIF;cpt85xx IF mikko spdtbl: db 9h ;9 entries db 03h,'110$' dw 0369h db 04h,'1200$' dw 0050h db 03h,'150$' dw 0280h db 04h,'2400$' dw 0028h db 03h,'300$' dw 0140h db 04h,'4800$' dw 0014h db 03h,'600$' dw 00A0H db 02h,'75$' dw 0500h db 04h,'9600$' dw 000ah sphtbl: db cr,lf,' 75 110 150 300 600 1200 2400 4800 9600$' ENDIF;mikko IF osbrn1 spdtbl: db 02h ;2 entries db 04h,'1200$', OSBI12,OSBI12 db 03h,'300$', OSBI03,OSBI03 sphtbl: db cr,lf,' 300',cr,lf,' 1200$' ENDIF;osbrn1 IF ap6551 ;jb spdtbl: db 0DH ;jb 13 entries db 03H,'110$', 03H,03H ;jb db 04H,'1200$', 08H,08H ;jb db 05H,'134.5$', 04H,04H ;jb db 03H,'150$', 05H,05H ;jb db 04H,'1800$', 09H,09H ;jb db 05H,'19200$', 0FH,0FH ;jb db 04H,'2400$', 0AH,0AH ;jb db 03H,'300$', 06H,06H ;jb db 04H,'3600$', 0BH,0BH ;jb db 04H,'4800$', 0CH,0CH ;jb db 03H,'600$', 07H,07H ;jb db 04H,'7200$', 0DH,0DH ;jb db 04H,'9600$', 0EH,0EH ;jb sphtbl: db cr,lf,' 110 134.5 150 300 600 1200 1800' db cr,lf,' 2400 3600 4800 7200 9600 19200$' ENDIF;ap6551 IF mdI spdtbl: db 0dh ; 13 entries db 03h, '110$' dw 1047 db 04h, '1200$' dw 96 db 03h, '150$' dw 768 db 05h,'19200$' dw 6 db 04h, '2400$' dw 48 db 03h, '300$' dw 384 db 05h,'38400$' dw 3 db 03h, '450$' dw 288 db 04h, '4800$' dw 24 db 05h,'56000$' dw 2 db 03h, '600$' dw 192 db 02h, '75$' dw 1536 db 04h, '9600$' dw 12 sphtbl: db cr,lf,' 75 110 150 300 450 600 1200' db cr,lf,' 2400 4800 9600 19200 38400 56000$' ;(Lord knows what you'll be communicating with at 56000 baud, but the ;Multi-I/O board literature says it'll do it, so what the heck.... ;might as well throw it in here just to show off...sure hope the ;port don't melt...) ENDIF ;mdI [Toad Hall] IF heath ; ; Speed selection table for H89 (OK, so I got a little carried away...) ; spdtbl: db 19 ; 19 entries db 3,'110$' dw 1047 db 4,'1200$' dw 96 db 5,'134.5$' dw 857 db 4,'1800$' dw 64 db 5,'19200$' dw 6 db 3,'200$' dw 576 db 4,'2400$'  dw 48 db 3,'300$' dw 384 db 4,'3600$' dw 32 db 5,'38400$' dw 3 db 3,'450$' dw 256 db 4,'4800$' dw 24 db 2,'50$' dw 2304 db 5,'56000$' dw 2 db 3,'600$' dw 192 db 4,'7200$' dw 16 db 2,'75$' dw 1536 db 3,'900$' dw 128 db 4,'9600$' dw 12 sphtbl: db cr,lf db ' 50 75 110 134.5 200 300 450 600 900 1200' db cr,lf,' 1800 2400 3600 4800 7200 9600 19200 38400 56000$' ENDIF;heath IF norths spdtbl: db 8 ; 8 entries db 3,'110$', 07H,07H db 4,'1200$', 04H,04H db 5,'19200$', 00H,00H db 4,'2400$', 03H,03H db 3,'300$', 06H,06H db 4,'4800$', 02H,02H db 3,'600$', 05H,05H db 4,'9600$', 01H,01H sphtbl: db cr,lf db ' 110 300 600 1200 2400 4800 9600 19200$' ENDIF;norths ; The following conditionals were once a huge if not statement. There ; wasn't enough room to add the lobo to the list, so it had to be broken ; into 2, which you can't do with an if not. I redid it as two ifs and ; applied them to those that wouldn't set baud. [Hal Hostetler] IF robin OR gener OR dmII OR vector OR z100 OR trs80 OR telcon spdtbl equ 0 ; SET BAUD not supported. sphtbl equ 0 ENDIF;robin OR gener OR dmII OR vector OR z100 OR trs80 OR telcon ; IF mmdI OR osi OR cpm3 OR apmmdm spdtbl EQU 0 ;[hh] SET BAUD not supported. sphtbl EQU 0 ;[hh] ran out of room above... ENDIF;mmdI OR osi OR cpm3 OR apmmdm ; ; This is the system-dependent SET PORT command. ; HL contains the argument from the command table. sysprt: IF lobo ;[hh] mov a,e ;[hh] get the data port value and store at sta outmd3+1 ;[hh] the two places we use... sta inpmd2+1 ;[hh] MNPORT in the overlay sta port ;[hh] inform program of the change in ports inr a ;[hh] status port = data port + 1 in the Lobo sta outmd1+1 ;[hh] store it at the three places... sta inpmd1+1 ;[hh] we use MNPRTS... sta outctl+1 ;[hh] in the overlay mov a,d ;[hh] now get the baud rate port value sta getbd+1 ;[hh] store it in the two places we use... sta setbd+1 ;[hh] BAUDRT in the overlay sta port+1 ;[hh] don't need to, but keeps it consistant getbd: lda baudrt ;[hh] get baud rate value from port sta speed ;[hh] tell STAT. baud rate for each port ;[hh] is independant of the other ENDIF ;lobo IF iobyt mov a,m ;Get the I/O byte sta prtiob ;Save the desired IO byte for this port inx h ;Point at next entry mov a,m ;Get the output function sta prtfun ;Save it ENDIF;iobyt IF iobyt AND robin inx h ;Point at next entry mov a,m ;Get the hardware address for the port sta prtadr ;Store it ENDIF;iobyt AND robin ret ; ; ; Port tables for Lobo MAX-80 IF lobo ;[hh] ; help text prhtbl: db cr,lf,'RS-232 port A or B$' ; ; command table prttbl: db 02H ;[hh] two entries db 01H,'A$',0E4H,0D0H db 01H,'B$',0E6H,0D4H ENDIF ;lobo ; ; ; Port tables for GENERIC CPM 2.2 IF gener ; help text prhtbl: db cr,lf,'CRT device' db cr,lf,'PTR device' db cr,lf,'TTY device' db cr,lf,'UC1 device' db cr,lf,'UR1 device' db cr,lf,'UR2 device$' ; command table prttbl: db 06H ;Six devices to choose from db 03H,'CRT$' dw crtptb db 03H,'PTR$' dw ptrptb db 03H,'TTY$' dw ttyptb db 03H,'UC1$' dw uc1ptb db 03H,'UR1$' dw ur1ptb db 03H,'UR2$' dw ur2ptb ; port entry table ; table entries are: ; db iobyte-value, BDOS output function, reserved crtptb: db crtio,conout,0 ptrptb: db ptrio,punout,0 ttyptb: db ttyio,conout,0 uc1ptb: db uc1io,conout,0 ur1ptb: db ur1io,punout,0 ur2ptb: db ur2io,punout,0 ENDIF;gener ; ; ; Port tables for DECmate II or MicroMikko ; IF dmII OR mikko ; help text prhtbl: db cr,lf,'COMMUNICATIONS port$' ; command table prttbl: db 01H ;Only one port known at this point db 0EH,'COMMUNICATIONS$' dw comptb ;address of info ; port entry table ; table entries are: ; db iobyte-value, BDOS output function, reserved comptb: db batio,punout,0 ENDIF;dmII OR mikko ; ; ; Port tables for Robin ; IF robin ; help text prhtbl: db cr,lf,'COMMUNICATIONS port' db cr,lf,'GENERAL purpose port' db cr,lf,'PRINTER port$' ; command table prttbl: db 03H ;Three entries db 0EH,'COMMUNICATIONS$' dw comptb db 07H,'GENERAL$' dw gppptb db 07H,'PRINTER$' dw prnptb ; port entry table ; table entries are: ; db iobyte-value, BDOS output function, hardware port address ; (control/status) ; ;At present, the hardware port address is only used for sending a break. comptb: db batio,punout,comtst gppptb: db gppio,conout,gentst prnptb: db lptio,conout,prntst prtadr: db comtst ;space for current hardware port address ENDIF;robin IF iobyt prtfun: db punout ;Function to use for output to comm port prtiob: db batio ;I/O byte to use for communicating coniob: db defio ;I/O byte to use for console ENDIF;iobyt IF NOT (iobyt OR lobo) ;[hh] prttbl equ 0 ; SET PORT is not supported prhtbl equ 0 ENDIF;NOT iobyt OR lobo ; ; ; Set up screen display for file transfer ; called with kermit version in DE ; sysscr: push d ; save version for a bit lxi d,outlin ; clear screen, position cursor call prtstr ; do it pop d ; get Kermit's version IF NOT (osi OR crt) ; got cursor control? call prtstr ; print it mvi e,'[' ; open bracket call outcon ; print it (close bracket is in outln2) lxi d,sysver ; get name and version of system module call prtstr lxi d,outln2 ; yes, print field names call prtstr lda dbgflg ; is debugging enabled? ora a rz ; finished if no debugging lxi d,outln3 ; set up debugging fields call prtstr ENDIF;NOT (osi OR crt) ret ; ; Calculate free space for current drive ; returns value in HL sysspc: lda bdosvr ;cpm3's alloc vect may be in another bank cpi 30H ;cpm3 or later? jm cp2spc ;no: use cp/m 2 algorithm lda fcb ;If no drive, get ora a ; logged in drive jz dir180 dcr a ;FCB drive A=1 normalize to be A=0 jmp dir18a dir180: mvi c,rddrv call bdos dir18a: mov e,a ;drive in e mvi c,getfs ;get free space BDOS funct call bdos ;returns free recs (3 bytes in buff..buff+2) mvi b,3 ;conv recs to K by 3 bit shift dir18b: xra a ;clear carry mvi c,3 ;for 3 bytes lxi h,buff+3 ;point to addr + 1 dir18c: dcx h ;point to less sig. byte mov a,m ;get byte rar ;carry -> A -> carry mov m,a ;put back byte dcr c ;for all bytes (carry not mod) jnz dir18c dcr b ;shift 1 bit 3 times jnz dir18b mov e,m ;get least sig byte inx h mov d,m ;get most sig byte xchg ;get K free in HL ret ; the rest are CP/M 2.2 systems, so use the alloc vector cp2spc: mvi c,getalv ;Address of CP/M Allocation Vector call bdos xchg ;Get its length lhld bmax inx h lxi b,0 ;Initialize Block count to zero dir19: push d ;Save allocation address ldax d mvi e,8 ;set to process 8 blocks dir20: ral ;Test bit jc dir20a inx b dir20a: mov d,a ;Save bits dcx h mov a,l ora h jz dir21 ;Quit if out of blocks mov a,d ;Restore bits dcr e ;count down 8 bits jnz dir20 ;do another bit pop d ;Bump to next count of Allocation Vector inx d jmp dir19 ;process it dir21: pop d ;Clear Allocation vector from stack mov l,c ;Copy block to 'HL' mov h,b lda bshiftf ;Get Block Shift Factor sui 3 ;Convert from records to thousands rz ;Skip shifts if 1K blocks dir22: dad h ;Multiply blocks by 'K per Block' dcr a jnz dir22 ret ; ; ; selmdm - select modem port ; selcon - select console port ; selmdm is called before using inpmdm or outmdm; ; selcon is called before using inpcon or outcon. ; For iobyt systems, diddle the I/O byte to select console or comm port; ; For Decision I, switches Multi I/O board to console or modem serial ; port. [Toad Hall] ; For the rest, does nothing. ; preserves bc, de, hl. selmdm: IF iobyt lda prtiob ;Set up for output to go to the comm port sta iobyte ;Switch byte directly ENDIF;iobyt IF mdI lda group ori mdmgrp ;Mask modem serial port out grpsel ENDIF;mdI [Toad Hall] ret selcon: IF iobyt lda coniob ;Set up for output to go to the console port sta iobyte ;Switch directly ENDIF;iobyt IF mdI lda group ori congrp ;Mask console serial port (1) out grpsel ENDIF;mdI [Toad Hall] ret ; ; Get character from console, or return zero. ; result is returned in A. destroys bc, de, hl. ; inpcon: IF NOT iobyt mvi c,dconio ;Direct console I/O BDOS call. mvi e,0FFH ;Input. call BDOS ENDIF;NOT iobyt IF iobyt call bconst ;Get the status ora a ;Anything there? rz ;No, forget it call bconin ;Yes, get the character ENDIF;iobyt ret ; ; ; Output character in E to the console. ; destroys bc, de, hl ; outcon: IF NOT iobyt mvi c,dconio ;Console output bdos call. call bdos ;Output the char to the console. ENDIF;NOT iobyt IF iobyt mov c,e ;Character call bcnout ;to Console ENDIF;iobyt ret ; ; ; outmdm - output a char from E to the modem. ; the parity bit has been set as necessary. ; returns nonskip; bc, de, hl preserved. outmdm: IF osi OR apple OR lobo ;[hh] push h outmd1: lxi h,mnprts ;address of the port status register outmd2: mov a,m ; get port status in A ani output ;Loop till ready. jz outmd2 outmd3: lxi h,mnport ;address of port data register mov m,e ; write the character pop h ret ENDIF;osi OR apple OR lobo IF osbrn1 call osldst ;Read the status port ani output ;Loop till ready. jz outmdm mov a,e jmp osstda ;Write to the data port ENDIF;osbrn1 IF inout in mnprts ;Get the output done flag. ani output ;Is it set? jz outmdm ;If not, loop until it is. mov a,e out mnport ;Output it. ret ENDIF;inout IF iobyt ;**** Note that we enter from outpkt with the I/O byte already set up for ; output to go to the comm port push h push b lda prtfun ;Get the output function mov c,a ;Into C call bdos ;And output the character pop b pop h ret ENDIF;iobyt IF cpm3 push h push b mvi c,auxout ;Output to the aux output device call bdos pop b pop h ret ENDIF;cpm3 ; ; ; get character from modem; return zero if none available. ; for IOBYT systems, the modem port has already been selected. ; destroys bc, de, hl. inpmdm: IF iobyt call bconst ;Is Char at COMM-Port? ora a ;something there? rz ; return if nothing there call bconin ; data present. read data. ENDIF;iobyt IF cpm3 mvi c,auxist call bdos ;is char at auxin? ora a ;something there? rz ;no mvi c,auxin call bdos ;read char from auxin ENDIF;cpm3 IF osi OR apple OR lobo ;[hh] inpmd1: lda mnprts ;Get the port status into A. ani input ;See if the input ready bit is on. rz ;If not then return. inpmd2: lda mnport ;If so, get the char. ENDIF;osi OR apple IF osbrn1 call osldst ;Read the status port ani input ;Something there? rz ;Nope call osldda ;Read the data port ENDIF;osbrn1 IF inout ;Note: modem port should already be selected for mdI. [Toad Hall] in mnprts ;Get the port status into A. ani input ;See if the input ready bit is on. rz ;If not then return. in mnport ;If so, get the char. ENDIF;inout ret ; return with character in A ; ; flsmdm - flush comm line. ; Modem is selected. ; Currently, just gets characters until none are available. flsmdm: call inpmdm ; Try to get a character ora a ; Got one? jnz flsmdm ; If so, try for another ret ; Receiver is drained. Return. ; ; ; outlpt - output character in E to printer ; console is selected. ; preserves de. outlpt: push d ; save DE in either case IF NOT iobyt mvi c,lstout call bdos ;Char to printer ENDIF;NOT iobyt IF iobyt mov c,e call blsout ENDIF;iobyt pop d ; restore saved register pair ret ; ; ; Screen manipulation routines ; csrpos - move to row B, column C ; ; csrpos for terminals that use a leadin sequence followed ; by (row + 31.) and (column + 31.) ; IF NOT (robin OR dmII OR vt100 OR osi OR crt OR vector) csrpos: push b ; save coordinates lxi d,curldn ; get cursor leadin sequence call prtstr ; print it pop h ; restore coordinates mov a,h ; get row adi (' '-1) ; space is row one mov e,a push h call outcon ; output row pop h mov a,l ; get column adi (' '-1) ; space is column one mov e,a jmp outcon ; output it and return ENDIF;NOT (robin OR dmII OR vt100 OR osi OR crt OR vector) ; ; csrpos for ANSI terminals ; IF robin OR dmII OR vt100 csrpos: push b ; save coordinates lxi d,curldn ; get cursor leadin sequence call prtstr ; print it pop h ; peek at coordinates push h ; then save away again mov l,h ; l = row mvi h,0 ; hl = row call nout ; output in decimal mvi e,';' ; follow with semicolon call outcon ; print it pop h ; restore column mvi h,0 ; hl = column call nout mvi e,'H' ; terminate with 'move cursor' command jmp outcon ; output it and return ENDIF;robin OR dmII OR vt100 ; ; csrpos for the Vector General. It's weird. ; IF vector csrpos: dcr b ; vector uses zero-based addressing? dcr c push b ; save coordinates mvi e,esc ; print an escape call outcon pop d ; peek at coordinates push d call outcon ; output column pop d mov e,d ; get row jmp outcon ; output and return ENDIF;vector IF osi OR crt ; systems without cursor positioning csrpos: ret ; dummy routine referenced by linkage section ENDIF;osi OR crt ; ; position to various fields: ; for the Kermits with cursor positioning, the display looks like this: ; 5 10 15 20 25 30 35 ; +----|----|----|----|----|----|----|... ; 1 | ; 2 | Kermit-80 v4.0 [system] ; 3 | ; 4 |Number of packets: ____ ; 5 |Number of retries: ____ ; 6 |File name: ____________ ; 7 |... ; 8 |... ; 9 |RPack: ___(if debugging)... ; 10 | ; 11 |SPack: ___(if debugging)... ; 12 | ; 13 |Kermit-80 A:> (when finished) ; IF NOT (osi OR crt) scrnp: lxi b,4*100H+20 jmp csrpos scrnrt: lxi b,5*100H+20 jmp csrpos scrfln: lxi b,6*100H+12 call csrpos clreol: lxi d,tk jmp prtstr screrr: lxi b,7*100H+1 call csrpos jmp clreol scrst: lxi b,8*100H+1 call csrpos jmp clreol rppos: lxi b,9*100H+8 call csrpos jmp clreol sppos: lxi b,11*100H+8 call csrpos jmp clreol scrend: lxi b,13*100H+1 call csrpos clreos: lxi d,tj jmp prtstr ENDIF;NOT (osi OR crt) IF osi OR crt ; no cursor control scrnp: mvi e,' ' jmp outcon scrnrt: mvi e,' ' call outcon mvi e,'%' jmp outcon scrfln: screrr: scrst: scrend: jmp prcrlf ;Print CR/LF [Toad Hall] rppos: lxi d,prpack jmp prtstr sppos: lxi d,pspack jmp prtstr ENDIF;osi OR crt ; ; delchr - make delete look like a backspace. Unless delete is a printing ; character, we just need to print a backspace. (we'll output clrspc ; afterwards) ; For Kaypro and Vector General, delete puts a blotch on the screen. ; For Apple and Osborne 1, delete moves but doesn't print. delchr: IF bbI OR vector OR apple OR osbrn1 OR lobo lxi d,delstr jmp prtstr ENDIF;bbI OR vector OR apple OR osbrn1 OR lobo IF NOT (bbI OR vector OR apple OR osbrn1) mvi e,bs ;get a backspace jmp outcon ENDIF;NOT (bbI OR vector OR apple OR osbrn1) ; erase the character at the current cursor position clrspc: mvi e,' ' call outcon mvi e,bs ;get a backspace jmp outcon ; erase the current line clrlin: lxi d,eralin jmp prtstr ; erase the whole screen, and go home. preserves b (but not c) clrtop: lxi d,erascr jmp prtstr ; Some frequently-used routines (duplicates of those in CP4MIT): ; prcrlf - output a CR/LF ; prtstr - output string in DE ; rskp - return, skipping over error return prcrlf: lxi d,crlf prtstr: mvi c,prstr jmp bdos rskp: pop h ; Get the return address inx h ; Increment by three inx h inx h pchl ; Copy block of data ; source in HL, destination in DE, byte count in BC ; called by: cp4sys, mfname ; mover: IF NOT z80 ; 8080's have to do it the hard way mov a,m stax d inx h inx d dcx b mov a,b ora c jnz mover ENDIF;NOT z80 IF z80 db 0EDh,0B0h ; Z80 LDIR instruction ENDIF;z80 ret ; ; ; Miscellaneous messages ; crlf: db cr,lf,'$' cfgmsg: db 'configured for $' IF adm3a OR tvi925 OR vt52 OR vt100 OR smrtvd ; [7] witmsg: db ' with $' ENDIF;adm3a OR tvi925 OR vt52 OR vt100 OR smrtvd ; [7] ;**************************Terminal tables**************************** IF NOT (osi OR crt) ; got cursor control? outln2: db ']',cr,lf,cr,lf,'Number of packets:' db cr,lf,'Number of retries:' db cr,lf,'File name:$' outln3: db cr,lf,cr,lf ; debugging messages db cr,lf,'RPack:' db cr,lf ; blank line in case of long packet db cr,lf,'SPack:$' ENDIF;NOT (osi OR crt) IF lobo ;[hh] sysver: db 'Lobo MAX-80$' outlin: db esc,'*',cr,lf,tab,tab,'$' erascr: db esc,'*$' ;[hh] clear screen and home cursor eralin: db cr,esc,'R$' ;[hh] clear line curldn: db esc,'=$' ;[hh] cursor lead-in string delstr: db bs,' ',bs,bs,'$' ;[hh] ??adjust for echoing delete ttab: ;[hh] table start location ta: db 0BH,'$',0,0 ;[hh] cursor up tb: db 0AH,'$',0,0 ;[hh] cursor down tc: db 0CH,'$',0,0  ;[hh] cursor right td: db 08H,'$',0,0 ;[hh] cursor left te: db esc,'*$',0 ;[hh] clear display (homes cursor) tf: db '$',0,0,0 ;[hh] (can't) enter graphics mode tg: db '$',0,0,0 ;[hh] (can't) exit graphics mode th: db 01EH,'$',0,0 ;[hh] home cursor ti: db esc,'E$',0 ;[hh] reverse linefeed (insert line) tj: db esc,'Y$',0 ;[hh] clear to end of screen tk: db esc,'T$',0 ;[hh] clear to end of line ENDIF ;lobo ; IF brain sysver: db 'Intertec SuperBrain$' outlin: db ('A'-100O),esc,'~k',cr,lf,tab,tab,'$' erascr: db ('A'-100O),esc,'~k$' ;Clear screen and go home. eralin: db cr,esc,'~K$' ;Clear line. curldn: db esc,'Y$' ; leadin for cursor positioning ttab: ;Table start location. ta: db ('K'-100O),'$',0,0 ;Cursor up. tb: db 12O,'$',0,0 ;Cursor down. tc: db ('F'-100O),'$',0,0 ;Cursor right. td: db '$',0,0,0 ;(can't) Cursor left te: db '$',0,0,0 ;(can't) Clear display tf: db '$',0,0,0 ;(can't) Enter graphics mode tg: db '$',0,0,0 ;(can't) Exit graphics mode th: db ('A'-100O),'$',0,0 ;Cursor home. ti: db ('K'-100O),'$',0,0 ;Reverse linefeed. tj: db esc,'~k$',0 ;Clear to end of screen. tk: db esc,'~K$',0 ;Clear to end of line. ENDIF;brain ; IF osbrn1 sysver: db 'Osborne 1$' outlin: db 1AH,cr,lf,tab,'$' ;(Clear screen, home cursor) erascr: db 1AH,'$' ;Clear screen and go home. eralin: db cr,esc,'T$' ;Clear line. delstr: db bs,bs,'$' ; Adjust for delete curldn: db esc,'=$' ;Cursor lead-in ttab: ;Table start location. ta: db ('K'-100O),'$',0,0 ;Cursor up. tb: db 12O,'$',0,0 ;Cursor down. tc: db ('L'-100O),'$',0,0 ;Cursor right. td: db bs,'$',0,0 ;Cursor left. te: db subt,'$',0,0 ;Clear screen. tf: db '$',0,0,0 ;(can't) Enter graphics mode tg: db '$',0,0,0 ;(can't) Exit graphics mode th: db ('^'-100O),'$',0,0 ;Cursor home. ti: db ('K'-100O),'$',0,0 ;Reverse linefeed. tj: db esc,'T$',0 ;(can't) Clear to end of screen. tk: db esc,'T$',0 ;Clear to end of line. ENDIF;osbrn1 ; IF apple sysver: db 'Apple II CP/M$' outlin: db ('^'-100O),esc,'Y',cr,lf,' $' erascr: db ('^'-100O),esc,'Y$' ;Clear screen and go home. eralin: db cr,esc,'T$' ;Clear line. delstr: db bs,bs,'$' ; Adjust for delete curldn: db esc,'=$' ;Cursor lead-in ttab: ;Table start location. ta: db ('K'-100O),'$',0,0 ;Cursor up. tb: db 12O,'$',0,0 ;Cursor down. tc: db ('F'-100O),'$',0,0 ;Cursor right. td: db '$',0,0,0 ;(can't) Cursor left te: db '$',0,0,0 ;(can't) Clear display tf: db '$',0,0,0 ;(can't) Enter graphics mode tg: db '$',0,0,0 ;(can't) Exit graphics mode th: db ('^'-100O),'$',0,0 ;Cursor home. ti: db ('K'-100O),'$',0,0 ;Reverse linefeed. tj: db esc,'Y$',0 ;Clear to end of screen. tk: db esc,'T$',0 ;Clear to end of line. ENDIF;apple ; IF vector sysver: db 'Vector Graphics$' outlin: db ('D'-100O),cr,lf,tab,tab,'$' erascr: db ('D'-100O),'$' ;Clear screen and go home. eralin: db cr,('Q'-100O),'$' ;Clear line. delstr: db bs,' ',bs,bs,'$' ; adjust for echoing delete character ttab: ;Table start location. ta: db ('U'-100O),'$',0,0 ;Cursor up. tb: db 12O,'$',0,0 ;Cursor down. tc: db ('Z'-100O),'$',0,0 ;Cursor right. td: db '$',0,0,0 ;(can't) Cursor left te: db '$',0,0,0 ;(can't) Clear display tf: db '$',0,0,0 ;(can't) Enter graphics mode tg: db '$',0,0,0 ;(can't) Exit graphics mode th: db ('B'-100O),'$',0,0 ;Cursor home. ti: db ('U'-100O),'$',0,0 ;Reverse linefeed. tj: db ('P'-100O),'$',0,0 ;Clear to end of screen. tk: db ('Q'-100O),'$',0,0 ;Clear to end of line. ENDIF;vector ; IF telcon sysver: db 'Telcon Zorba$' ENDIF;telcon IF heath sysver: db 'Heath/Zenith 89$' ENDIF;heath IF z100 sysver: db 'Heath/Zenith Z-100 CP/M$' ENDIF;z100 IF vt52 ; DEC VT52 ttytyp: db 'VT52$' ENDIF;vt52 IF heath OR z100 OR telcon OR vt52 outlin: db esc,'H',esc,'J',cr,lf,tab,tab,'$' erascr: db esc,'H',esc,'J$' ;Clear screen and go home. eralin: db cr,esc,'K$' ;Clear line. curldn: db esc,'Y$' ;cursor leadin ttab: ;Table start location. ta: db esc,'A$',0 ;Cursor up. tb: db esc,'B$',0 ;Cursor down. tc: db esc,'C$',0 ;Cursor right. td: db esc,'D$',0 ;Cursor left te: db esc,'E$',0 ;Clear display tf: db esc,'F$',0 ;Enter Graphics Mode tg: db esc,'G$',0 ;Exit Graphics mode th: db esc,'H$',0 ;Cursor home. ti: db esc,'I$',0 ;Reverse linefeed. tj: db esc,'J$',0 ;Clear to end of screen. tk: db esc,'K$',0 ;Clear to end of line. ENDIF;heath OR z100 OR telcon OR vt52 ; IF trs80lb sysver: db 'TRS-80 II Lifeboat CP/M$' outlin: db esc,':',cr,lf,tab,tab,'$' erascr: db esc,':$' ;Clear screen and go home. eralin: db cr,esc,'T$' ;Clear line. curldn: db esc,'=$' ;Cursor lead-in ttab: ;Table start location. ta: db 0BH,'$',0,0 ;Cursor up. tb: db 0AH,'$',0,0 ;Cursor down. tc: db 0CH,'$',0,0 ;Cursor right. td: db bs,'$',0,0 ;Cursor left te: db esc,':$',0 ;Clear display tf: db '$',0,0,0 ;(can't) Enter Graphics Mode tg: db '$',0,0,0 ;(can't) Exit Graphics mode th: db 1EH,'$',0,0 ;Cursor home. ti: db 0BH,'$',0,0 ;Reverse linefeed. tj: db esc,'Y$',0 ;Clear to end of screen. tk: db esc,'T$',0 ;Clear to end of line. ENDIF;trs80lb ; IF trs80pt sysver: db 'TRS-80 II P+T CP/M$' outlin: db 0CH,cr,lf,tab,tab,'$' erascr: db 0CH,'$' ;Clear screen and go home. eralin: db cr,01H,'$' ;Clear line. curldn: db esc,'Y$' ;Cursor lead-in ttab: ;Table start location ;Must be 4 bytes each ta: db 1EH,'$',0,0 ;Cursor up. tb: db 1FH,'$',0,0 ;Cursor down. tc: db 1DH,'$',0,0 ;Cursor right. td: db 1CH,'$',0,0 ;Cursor left te: db 0CH,'$',0,0 ;Clear display tf: db 11H,'$',0,0 ;Enter Graphics Mode tg: db 14H,'$',0,0 ;Exit Graphics mode th: db 06H,'$',0,0 ;Cursor home. ti: db 1EH,'$',0,0 ;Reverse linefeed. tj: db 02H,'$',0,0 ;Clear to end of screen. tk: db 01H,'$',0,0 ;Clear to end of line. ENDIF;trs80pt ; IF robin sysver: db 'VT180 "Robin"$' ENDIF;robin IF dmII sysver: db 'DECmate II CP/M-80$' ENDIF;dmII IF vt100 ttytyp: db 'VT100$' ENDIF;vt100 IF norths sysver: db 'Northstar Horizon$' ENDIF;norths IF robin OR dmII or vt100 ; Note that we cannot support Graphics Mode or the H19 erase-screen command ; (E), because the sequences are more than three bytes. outlin: db esc,3CH,esc,'[H',esc,'[J',cr,lf,tab,tab,'$' erascr: db esc,'[H',esc,'[J$' ;Clear screen and go home. eralin: db cr,esc,'[K$' ;Clear line. curldn: db esc,'[$' ; Cursor leadin ttab: ta: db esc,'[A$' ; Cursor up. tb: db esc,'[B$' ; Cursor down. tc: db esc,'[C$' ; Cursor right. td: db esc,'[D$' ; Cursor left te: db '$',0,0,0 ; (can't) Clear display tf: db '$',0,0,0 ; (don't) Enter Graphics Mode tg: db '$',0,0,0 ; (don't) Exit Graphics mode th: db esc,'[H$' ; Cursor home. ti: db esc,'M$',0 ; Reverse linefeed. tj: db esc,'[J$' ; Clear to end of screen. tk: db esc,'[K$' ; Clear to end of line. ENDIF;robin OR dmII or vt100 ; IF kpii sysver: db 'Kaypro II$' outlin: db subt,cr,lf,tab,tab,'$' erascr: db subt,'$' ;Clear screen and home. eralin: db cr,18H,'$' ;Clear line. curldn: db esc,'=$' ;Cursor lead-in delstr: db bs,' ',bs,bs,'$' ; adjust for echoing delete character ttab: ;Table start location. ta: db 0BH,'$',0,0 ;Cursor up. tb: db 0AH,'$',0,0 ;Cursor down. tc: db 0CH,'$',0,0 ;Cursor right. td: db bs,'$',0,0 ;Cursor left te: db subt,'$',0,0 ;Clear display tf: db esc,'G$',0 ; Enter Graphics Mode (select Greek) tg: db esc,'A$',0 ; Exit Graphics mode (select ASCII) th: db 1EH,'$',0,0 ; Cursor home. [UTK016] ti: db esc,'E','$',0 ; Reverse linefeed. (insert line) tj: db 'W'-100O,'$',0,0 ; Clear to end of screen. tk: db 'X'-100O,'$',0,0 ; Clear to end of line. ENDIF ; kpii ; IF xer820 sysver: db 'Xerox 820$' outlin: db subt,cr,lf,tab,tab,'$' erascr: db subt,'$' ;Clear screen and home. eralin: db cr,18H,'$' ;Clear line. curldn: db esc,'=$' ;Cursor lead-in delstr: db bs,' ',bs,bs,'$' ; adjust for echoing delete character ttab: ;Table start location. ta: db 0BH,'$',0,0 ;Cursor up. tb: db 0AH,'$',0,0 ;Cursor down. tc: db 0CH,'$',0,0 ;Cursor right. td: db bs,'$',0,0 ;Cursor left te: db subt,'$',0,0 ;Clear display tf: db '$',0,0,0 ; Enter Graphics Mode (can't) tg: db '$',0,0,0 ; Exit Graphics mode (can't) th: db 1EH,'$',0,0 ; Cursor home. [UTK016] ti: db 0BH,'$',0,0 ; Reverse linefeed. (cursor up) tj: db 11H,'$',0,0 ; Clear to end of screen. tk: db 18H,'$',0,0 ; Clear to end of line. ENDIF ; xer820 ; IF mikko sysver: db 'MikroMikko$' outlin: db subt,cr,lf,tab,'$' erascr: db subt,'$' ;Clear screen and go home. eralin: db cr,1CH,'$' ;Clear line. curldn: db esc,'=$' ;cursor leadin ttab: ;Table start location. ta: db 0BH,'$',0,0 ;Cursor up. tb: db 0AH,'$',0,0 ;Cursor down. tc: db 0CH,'$',0,0 ;Cursor right. td: db bs,'$',0,0 ;Cursor left te: db subt,'$',0,0 ;Clear display tf: db '$',0,0,0 ;(can't) Enter Graphics Mode tg: db '$',0,0,0 ;(can't) Exit Graphics mode th: db 1EH,'$',0,0 ;Cursor home. ti: db '$',0,0,0 ;(can't) Reverse linefeed. tj: db 1cH,'$',0,0 ;Clear to end of screen. tk: db 1cH,'$',0,0 ;Clear to end of line. ENDIF;mikko ; IF gener or cpm3 sysver: db 'Generic CP/M-80$' ENDIF;gener or cpm3 IF bbII sysver: db 'Big Board II$' ENDIF;bbII IF cpt85xx sysver: db 'CPT-85xx under CompuPak CP/M$' ENDIF;cpt85xx IF mdI sysver: db 'Morrow Decision I$' ENDIF;mdI [Toad Hall] IF mmdI sysver: db 'MicroDecision I$' ENDIF;mmdI IF osi sysver: db 'Ohio Scientific$' ENDIF;osi IF osi OR crt outlin: db cr,lf,'Starting ...$' erascr equ crlf ;"Home & clear" (best we can do). eralin: db '^U',cr,lf,'$' ;Clear line. prpack: db cr,lf,'RPack: $' pspack: db cr,lf,'SPack: $' ttab equ 0 ; no VT52 table ENDIF;osi OR crt IF tvi925 ;(incidentally, works fine for Freedom 100 also [Toad Hall]) ;adm3a entry and tvi925 entry separated to remove warning message. ttytyp: db 'TVI925$' outlin: db 'Z'-64,0,0,cr,lf,'$' erascr: db 'Z'-64,0,0,'$' ;Clear screen and home eralin: db esc,'Y$',0 ;Clear to end of sreen curldn: db cr,esc,'=$' ;Cursor lead-in ttab: ;Table start location ;(MUST be 4 bytes each) ta: db 'K'-64,'$',0,0 ;Cursor up, stop at top tb: db 'V'-64,'$',0,0 ;Cursor down, stop at bottom tc: db 'L'-64,'$',0,0 ;Cursor right, stop at right td: db 'H'-64,'$',0,0 ;Cursor left, stop at left te: db 'Z'-64,0,0,'$' ;Clear display (2 pad nulls) tf: db '$',0,0,0 ;(can't) Enter Graphics mode tg: db '$',0,0,0 ;(can't) Exit Graphics mode th: db 1EH,'$',0,0 ;Cursor home ti: db esc,'j$',0 ;Reverse linefeed, scroll tj: db esc,'Y$',0 ;Clear to end of sreen tk: db esc,'T$',0 ;Clear to end of line ENDIF;tvi925 IF adm3a ttytyp: db 'ADM3A$' outlin: db 'Z'-64,0,0,cr,lf,'$' erascr: db 'Z'-64,0,0,'$' ;Clear screen and home eralin: db esc,'Y$',0 ;Clear to end of sreen curldn: db cr,esc,'=$' ;Cursor lead-in ttab: ;Table start location ;(MUST be 4 bytes each) ta: db 'K'-64,'$',0,0 ;Cursor up, stop at top tb: db 'J'-64,'$',0,0 ;Cursor down CTRL-J tc: db 'L'-64,'$',0,0 ;Cursor right, stop at right td: db 'H'-64,'$',0,0 ;Cursor left, stop at left te: db 'Z'-64,0,0,'$' ;Clear display (2 pad nulls) tf: db '$',0,0,0 ;(can't) Enter Grap hics mode tg: db '$',0,0,0 ;(can't) Exit Graphics mode th: db 1EH,'$',0,0 ;Cursor home ti: db 'K'-64,'$',0,0 ;Reverse linefeed tj: db '$',0,0,0 ;(can't) Clear to end of screen tk: db '$',0,0,0 ;(can't) Clear to end of line ENDIF;adm3a IF delphi ; [7] new system sysver: db 'Digicomp Delphi 100$' endif;delphi IF smrtvd ; [7] new terminal ttytyp: db 'Smartvid-80$' outlin: db esc,'+',cr,lf,tab,tab,'$' eralin: db cr,esc,'T$' ;Clear to end of line. erascr: db esc,'+$' ;Clear screen and go home. curldn: db esc,'=$' ;Cursor lead-in ttab: ;Table start location. ta: db ('K'-100O),'$',0,0 ;Cursor up. tb: db 12O,'$',0,0 ;Cursor down. tc: db ('A'-100O),'$',0,0 ;Cursor right. td: db ('H'-100O),'$',0,0 ;Cursor left. te: db ('L'-100O),'$',0,0 ;Clear screen and home cursor tf: db '$',0,0,0 ;(can't) Enter Graphics mode tg: db '$',0,0,0 ;(can't) Exit Graphics mode th: db ('Z'-100O),'$',0,0 ;Cursor home. ti: db ('K'-100O),'$',0,0 ;Reverse linefeed. tj: db esc,'Y$',0 ;Clear to end of screen. tk: db esc,'T$',0 ;Clear to end of line. ENDIF;smrtvd ovlend equ $ ; End of overlay END CP4PKT ASMt3456789:;<=>?@ACP4SYS $$$€BCDEFGHIJKLMNOPQCP4SYS $$$€RSTUVWXYZ[\]^_`aCP4SYS $$$€bcdefghijklmnopqCP4SYS $$$€rstuvwxyz{|}~€CP4SYS $$$€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘CP4SYS $$$مممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممم This is the release date of the disk. مممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممم Fog Library Disk FOG-CPM.156 Copyright (1987) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. Disk 4 of 4. Kermit. Filename Description -01-00 .87 This is the release date of the disk. -CPM156 .DOC This is the description of the disk contents. CP4PKT .ASM 8165 63K ver. 4.05 [Kermit 49 of 50] CP4SYS .ASM E594 81K ver. 4.05 [Kermit 50 of 50]  ",TRIM(filedesc) ENDIF SKIP ENDDO SELE A ENDDO ? SET ALTE OFF SET ALTE TO IF EOF() .OR. BOF() .OR. mft=mlt RELE ALL USE SELE B USE RETURN ENDIF ENDDO مممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممممم!ممممم"ممممم#ممممم$ممممم%ممممم&ممممم'ممممم