NAME ccscom ; File CCSCOM.ASM ;CHINESE ifdef MSDOS include msscom.dat else include ccscom.dat endif code segment public 'code' extrn prtchr:near, clrbuf:near, outchr:near, isdev:near extrn sppos:near, stpos:near, biterr:near, intmsg:near extrn clearl:near, rppos:near, errpack:near, prtscr:near extrn pktcpt:near, strlen:near, pcwait:near assume cs:code, ds:datas ; Packet routines ; Send_Packet ; This routine assembles a packet from the arguments given and sends it ; to the host. ; ; Expects the following: ; AH - Type of packet (D,Y,N,S,I,R,E,F,Z,other) ; PACK.SEQNUM - Packet sequence number ; PACK.DATLEN - Number of data characters ; Returns: +1 always ; Packet construction areas: ; Prolog (8 bytes) Data null Data ;+----------------------------------------+---------------+---------------+ ;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS | ;+----------------------------------------+---------------+---------------+ ; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow. ; SPKT PROC NEAR spack: push ax ; save packet type (in ah) call clrbuf ; clear serial port input buffer call prtchr ; exercise receiver nop nop nop call clrbuf ; clear serial port input buffer mov spkcnt,0 ; number of bytes sent in this packet add fsta.pspkt,1 ; statistics, count a packet being sent adc fsta.pspkt+2,0 ; ripple carry mov al,spause ; Wait spause milliseconds before xor ah,ah ; sending a packet or al,al ; zero? jz spk1 ; z = yes call pcwait ; to let other side get ready spk1: mov dh,trans.spad ; Get the number of padding chars. spk2: dec dh cmp dh,0 jl spk5 ; If none left proceed. mov ah,trans.spadch ; Get the padding char. push dx ; save loop counter call outchr ; Output it. jmp spk3 ; failed nop ; must be three bytes pop dx ; get loop counter jmp spk2 ; do remaining padding chars spk3: pop dx pop ax ret ; failed spk5: pop ax ; recover ah mov prvtyp,ah ; Remember packet type mov bx,portval ; Get current port structure [umd] mov parmsk,0ffh ; Set parity mask for 8 bits [umd] cmp [bx].parflg,parnon ; Using parity? [umd] je spacka ; e = no. use mask as is. [umd] mov parmsk,7fh ; else set mask for 7 data bits. [umd] spacka: call snddeb ; do debug display (while it's still our turn) mov pktptr,offset prolog mov word ptr prolog,0 mov word ptr prolog+2,0 mov word ptr prolog+4,0 mov word ptr prolog+6,0 mov al,trans.ssoh ; Get the start of header char. mov prolog,al ; Put SOH in the packet. mov ax,pack.seqnum ; SEQ add al,20h ; ascii bias mov prolog+2,al ; store SEQ in packet mov ah,0 mov chksum,ax ; start checksum mov al,prvtyp ; TYPE mov prolog+3,al ; store TYPE add chksum,ax ; add to checksum ; ; packet length type is directly governed here by length of header plus data ; field, pack.datlen, plus chksum: regular <= 94, long <= 9024, else X long. ; mov ax,pack.datlen ; DATA length add ax,2 ; add SEQ, TYPE lengths add al,trans.chklen ; add checksum length at the end adc ah,0 ; propagate carry, yields overall new length cmp ax,maxpack ; too big? jle spdlp0 ; le = ok ret ; return bad spdlp0: mov pack.lentyp,3 ; assume regular packet cmp ax,94 ; longer than a regular? ja spdlp1 ; a = use long add al,20h ; convert length to ascii mov prolog+1,al ; store LEN mov ah,0 add chksum,ax ; add LEN to checksum jmp spklp5 ; do regular spdlp1: push ax ; Use Long packets (type 3) push bx push cx push dx sub ax,2 ; deduct SEQ and TYPE from above = data+chksum mov pack.lentyp,0 ; assume type 0 packet cmp ax,(95*95-1) ; longest type 0 packet (9024) jbe spdlp3 ; be = type 0 mov pack.lentyp,1 ; type 1 packet spdlp3: mov bl,pack.lentyp ; add new LEN field to checksum add bl,20h ; ascii bias, tochar() mov bh,0 add chksum,bx ; add to running checksum mov prolog+1,bl ; put LEN into packet mov bx,offset prolog+4 ; address of extended length field mov cx,1 ; a counter xor dx,dx ; high order numerator of length spdlp7: div ninefive ; divide ax by 95. quo = ax, rem = dx push dx ; push remainder inc cx ; count push depth cmp ax,95 ; quotient >= 95? jae spdlp7 ; ae = yes, recurse push ax ; push for pop below spdlp8: pop ax ; get a digit add al,20h ; apply tochar() mov [bx],al ; store in data field add chksum,ax ; accumulate checksum for header inc bx ; point to next data field byte mov byte ptr[bx],0 ; insert terminator loop spdlp8 ; get the rest ; mov ax,chksum ; current checksum shl ax,1 ; put two highest bits of al into ah shl ax,1 and ah,3 ; want just those two bits shr al,1 ; put al back in place shr al,1 add al,ah ; add two high bits to earlier checksum and al,03fh ; chop to lower 6 bits (mod 64) add al,20h ; apply tochar() mov [bx],al ; store that in length's header checksum mov ah,0 add chksum,ax ; add that byte to running checksum pop dx pop cx pop bx pop ax spklp5: push si ; assume soh, len, seq, type, extra len are in prolog push di push cx push ds pop es ; set es to data segment for implied es:di mov si,offset prolog ; source mov di,offset data-1 ; end point of destination mov pktptr,offset data ; start of packet ptr for debug cmp pack.lentyp,0 ; long packets? jne spklp6 ; ne = no add si,6 ; long packets mov cx,7 ; seven bytes soh,len,seq,type, xl1,xl2,xlchk jmp spklp8 spklp6: cmp pack.lentyp,1 ; extra long packets? jne spklp7 ; ne = no mov cx,8 ; extra long packets add si,7 jmp spklp8 spklp7: add si,3 ; regular packets, slide up by four bytes mov cx,4 ; number of bytes to move spklp8: jcxz spklp9 ; no movement needed sub pktptr,cx ; pktprt=new offset of prolog section std rep movsb ; move the protocol header, cx times cld spklp9: pop cx pop di pop si mov bx,pktptr ; place where protocol section starts spklp10:mov ah,[bx] ; protocol part inc bx call spkout ; send byte to serial port jnc spklp11 ; nc = good send jmp spackq ; bad send spklp11:cmp bx,offset data ; done all protocol parts yet? jb spklp10 ; b = not yet mov bx,offset data ; select from given data buffer mov dx,pack.datlen ; Get the number of data bytes in packet. spack2: dec dx ; Decrement the char count. js spack3 ; sign = no, finish up. mov al,byte ptr[bx] ; get a data char inc bx ; point to next char [umd] test al,80h ; eighth bit set? jz spackb ; z = no and al,parmsk ; apply parity mask, may clear 8th bit [umd] cmp hierr,0 ; printed high bit error yet? [umd] jne spackb ; ne = yes [umd] push ax push bx push cx push dx call biterr pop dx pop cx pop bx pop ax mov hierr,0FFH ; set err flag. spackb: mov ah,0 add chksum,ax ; add the char to the checksum [umd] and chksum,0fffh ; keep only low order 12 bits mov ah,al ; put char in ah where spkout wants it call spkout ; send it jnc spack2 ; Go get more data chars jmp spackq ; bad send spack3: mov cx,chksum cmp trans.chklen,2 ; What kind of checksum are we using? je spackx ; e = 2 characters. jg spacky ; g = 3 characters. mov ah,cl ; 1 char: get the character total. mov ch,cl ; Save here too (need 'cl' for shift). and ah,0C0H ; Turn off all but the two high order bits. mov cl,6 shr ah,cl ; Shift them into the low order position. mov cl,ch add ah,cl ; Add it to the old bits. and ah,3FH ; Turn off the two high order bits. (MOD 64) add ah,' ' ; Add a space so the number is printable. mov [bx],ah ; Put in the packet. inc bx ; Point to next char. call spkout ; send it jnc spackz ; Add EOL char. jmp spackq ; bad send spacky: mov byte ptr[bx],0 ; null, to determine end of buffer. push bx ; Don't lose our place. mov bx,pktptr ; First checksummed character. inc bx ; skip SOH call crcclc ; Calculate the CRC. pop bx push cx ; save the crc mov ax,cx ; Manipulate it here. and ax,0F000H ; Get 4 highest bits. mov cl,4 shr ah,cl ; Shift them over 4 bits. add ah,' ' ; Make printable. mov [bx],ah ; Add to buffer. inc bx pop cx ; Get back checksum value. call spkout ; send it jnc spackx jmp spackq ; bad send spackx: push cx ; Save it for now. and cx,0FC0H ; Get bits 6-11. mov ax,cx mov cl,6 shr ax,cl ; Shift them bits over. add al,' ' ; Make printable. mov [bx],al ; Add to buffer. inc bx mov ah,al call spkout ; send it pop cx ; Get back the original. jc spackq ; c = bad send and cx,003FH ; Get bits 0-5. add cl,' ' ; Make printable. mov [bx],cl ; Add to buffer. inc bx mov ah,cl call spkout ; send it jnc spackz spackq: RET ; bad send, do ret to caller of spack spackz: mov ah,trans.seol ; Get the EOL the other host wants. mov [bx],ah ; Put eol inc bx call deblin ; do debug display (while it's still our turn) cmp flags.debug,0 ; In debug mode? jne spackz0 ; ne = yes test flags.capflg,logpkt ; log packets? jz spackz1 ; z = no spackz0:cmp linecnt,0 ; anything on current line? je spackz1 ; e = no mov dx,offset crlf ; finish line with cr/lf call captdol ; to log file spackz1:mov ah,trans.seol ; recover EOL call spkout ; send it jnc spackz2 jmp spackq ; bad send spackz2: mov ax,spkcnt ; number of bytes sent in this packet add fsta.psbyte,ax ; total bytes sent adc fsta.psbyte+2,0 ; propagate carry to high word call chkcon ; check console for user interrupts nop ; no action on plain rets nop nop jmp rskp ; return successfully SPKT ENDP spkout: push ax ; send char in ah out the serial port push bx ; return carry clear if success push cx push dx mov tmp,1 ; retry counter spkour: call outchr ; serial port transmitter procedure jmp short spkoux ; bad send, retry nop inc spkcnt ; count number of bytes sent in this packet pop dx pop cx pop bx pop ax clc ; carry clear for good send ret spkoux: cmp tmp,5 ; done 5 attempts on this char? jge spkoux1 ; ge = yes, fail the sending inc tmp push ax mov ax,10 ; wait 10 milliseconds call pcwait pop ax jmp short spkour ; retry spkoux1:pop dx ; failed to send char pop cx pop bx pop ax stc ; set carry for bad send ret ; Calculate the CRC of the null-terminated string whose address is in BX. ; Returns the CRC in CX. Destroys BX and AX. ; The CRC is based on the SDLC polynomial: x**16 + x**12 + x**5 + 1. ; By Edgar Butt 28 Oct 1987 [ebb]. crcclc: push dx mov dx,0 ; Initial CRC value is 0 mov cl,4 ; Load shift count crc0: mov ah,[bx] ; Get the next char of the string cmp ah,0 ; If null, then we're done je crc1 inc bx xor dl,ah ; XOR input with lo order byte of CRC mov ah,dl ; Copy it shl ah,cl ; Shift copy xor ah,dl ; XOR to get quotient byte in ah mov dl,dh ; High byte of CRC becomes low byte mov dh,ah ; Initialize high byte with quotient mov al,0 shr ax,cl ; Shift quotient byte xor dl,ah ; XOR (part of) it with CRC shr ax,1 ; Shift it again xor dx,ax ; XOR it again to finish up jmp short crc0 crc1: mov cx,dx ; Return it in CX pop dx ret ; Receive_Packet ; This routine waits for a packet arrive from the host. It reads ; chars until it finds a SOH. ; Returns ; PACK.SEQNUM - Packet sequence number ; PACK.DATLEN - Number of data characters ; DATA array - data in packet ; AH - packet type (letter code) ; Packet construction areas: ; Prolog (8 bytes+2 nulls) null Data null Data null ;+----------------------------------------+---------------+---------------+ ;| SOH,LEN,SEQ,TYPE,Xlen(2-3),Xlen chksum | packet's data | chksum,EOL,HS | ;+----------------------------------------+---------------+---------------+ ; where Xlen is 2 byte (Long) or 3 byte (Extra Long) count of bytes to follow. RPACK PROC NEAR call rcvdeb ; setup debug banner, if needed. mov fairflg,0 ; set fairness flag mov pktptr,offset prolog ; where to place packet prolog material mov bx,pktptr ; bx = debug buffer pointer for new data mov rpkcnt,0 ; number of bytes received in this packet mov ax,0 ; most recently read char, initialize it push bx mov bl,flags.cxzflg ; Remember original value mov tmpflg,bl ; Store it here mov parmsk,0ffh ; parity mask, assume 8 bit data mov bx,portval cmp [bx].parflg,parnon ; parity is none? pop bx je rpack0 ; e = none mov parmsk,07fh ; else strip parity (8th) bit rpack0: call deblin ; debug, show chars received thus far mov word ptr prolog,0 ; clear prolog and data fields mov word ptr prolog+2,0 mov word ptr prolog+4,0 mov word ptr prolog+6,0 mov word ptr data,0 mov pktptr,offset prolog ; where to place packet prolog material mov bx,pktptr ; bx = debug buffer pointer for new data mov status,stat_suc ; assume success call inchr ; Get a character. SOH jmp rpack0a ; failure (eol, timeout, user intervention) nop rpack0b:mov byte ptr[bx],al ; store char in buffer inc bx cmp al,trans.rsoh ; Is the char the start of header char? jne rpack0 ; ne = no, go until it is. jmp rpack1 ; got the SOH char from the port rpack0a:jc rpack0b ; c = hit eol from prev packet, restart jmp rpack6 ; timeout or user intervention rpack1: mov pktptr,offset prolog ; if we got here from below mov bx,pktptr ; debug pointer mov byte ptr[bx],al ; store SOH in buffer inc bx mov status,stat_suc ; say success, in case rescanning for pkt. call inchr ; Get a character. LEN jmp rpack4 ; failure nop mov byte ptr[bx],al ; store LEN in buffer inc bx mov ah,0 cmp al,trans.rsoh ; Is the char the start of header char? jne rpack1e ; ne = no jmp rpack7 ; yes, start over rpack1e:mov chksum,ax ; start the checksum sub al,20h ; unchar() to binary mov pack.datlen,ax ; Save the data count (byte) call inchr ; Get a character. SEQ jmp rpack4 ; failure nop mov byte ptr[bx],al ; store SEQ in buffer inc bx cmp al,trans.rsoh ; Is the char the start of header char? jz rpack1 ; nz = yes, then go start over. mov ah,0 add chksum,ax sub al,' ' ; Get the real packet number. mov ah,0 mov pack.seqnum,ax ; Save the packet number. SEQ call inchr ; Get a character. TYPE jmp rpack4 ; failure mov byte ptr[bx],al ; store TYPE in buffer inc bx cmp al,trans.rsoh ; Is the char the start of header char? jz rpack1 ; nz = yes, then go start over. mov pktype,al ; Save the message type mov ah,0 add chksum,ax ; Add it to the checksum. push bx mov bx,portval ; Point to current port structure cmp [bx].ecoflg,0 ; Is the host echoing? pop bx jne rpak11 ; No, packets not echoed cmp al,prvtyp ; Packet type same as last sent? jne rpak11 ; ne = no mov prvtyp,0 ; clear to respond to next packet jmp rpack0 ; Yes, chuck echoed packet rpak11: call getlen ; get complicated data length (reg, lp, elp) ; into pack.datlen and kind into pack.lentyp ; carry set if error jnc rpack1d ; nc = long packet checksum is ok or status,stat_chk ; say bad checksum jmp rpack4 ; checksum failure rpack1d: ; Start of change. ; Now determine block check type for this packet. Here we violate the layered ; nature of the protocol by inspecting the packet type in order to detect when ; the two sides get out of sync. Two heuristics allow us to resync here: ; a. I and S packets always has a type 1 checksum. ; b. A NAK never contains data, so its block check type is seqnum1. cmp prolog+3,'S' ; Is this an "S" packet? jne rpk0 ; ne = no. mov trans.chklen,1 ; S packets use one byte checksums jmp rpk3 rpk0: cmp prolog+3,'I' ; I packets are like S packets jne rpk1 mov trans.chklen,1 ; I packets use one byte checksums jmp rpk3 rpk1: cmp prolog+3,'N' ; Is this a NAK? jne rpk3 ; ne = no. cmp pack.datlen,1 ; NAK, get length of data + chklen jb rpk1a ; b = impossible length cmp pack.datlen,3 ; longest NAK (3 char checksum) jbe rpk2 ; be = possible rpk1a: or status,stat_ptl ; status = bad length jmp rpack4 ; ret on impossible length rpk2: mov ax,pack.datlen mov trans.chklen,al ; remainder must be checksum type for NAK. rpk3: mov ax,pack.datlen ; get length of data + chksum sub al,trans.chklen ; minus checksum length, for all packets sbb ah,0 ; propagate borrow mov pack.datlen,ax ; store apparent length of data field ; End of change. ; now, for long packets we start the real data (after the extended byte ; count 3 or 4 bytes) at offset data and thus the checksumming starts ; such packets a few bytes earlier. [jrd] push si push di push cx mov di,offset data-1 mov si,offset prolog mov pktptr,offset data cmp pack.lentyp,0 ; long packets? jne rpk5 ; ne = no mov cx,7 ; seven bytes mark...type, xl,xl,xlchk add si,6 jmp rpk7 rpk5: cmp pack.lentyp,1 ; extra long packets? jne rpk6 ; ne = no mov cx,8 ; extra long packets, no movement add si,7 jmp rpk7 rpk6: add si,3 ; regular packets, slide by four bytes mov cx,4 ; number of bytes to move rpk7: jcxz rpk8 ; no movement needed sub pktptr,cx ; pktptr=new offset of prolog section push es ; save es push ds pop es ; set es to datas segment std ; move backward rep movsb ; move the protocol header, cx times pop es cld ; reset direction flag to normal rpk8: pop cx pop di pop si mov dx,pack.datlen ; length of data field, excl LP header mov chrcnt,dx mov dx,trans.rlongp ; longest packet we can receive sub dl,trans.chklen ; minus checksum length sbb dh,0 ; propagate borrow cmp pack.lentyp,3 ; Regular Packet? jne rpk8a ; ne = no sub dx,2 ; minus SEQ, TYPE for regular packets rpk8a: cmp dx,pack.datlen ; is data field too long? jae rpk8b ; ae = not too big or status,stat_ptl ; failure status, packet too long jmp rpack4 ; too big, quit now rpk8b: mov bx,offset data ; Point to the data buffer. ; Get DATA field characters rpack2: dec chrcnt ; # data chars js rpack3 ; s = exhausted data, go get the checksum. call inchr ; Get a character into al. DATA jmp rpack4 ; control-c, timeout (out of data), eol nop mov byte ptr[bx],al ; Put the char into the packet. inc bx ; Point to the next character. cmp al,trans.rsoh ; Is the char the start of header char? jnz rpak2b ; nz = no jmp rpack7 ; yes, then go start over. rpak2b: mov ah,0 add chksum,ax and chksum,0fffh ; keep only lower 12 bits jmp rpack2 ; Go get another. rpack3: call inchr ; Get a character. Start Checksum bytes jmp rpack4 ; failed nop mov byte ptr[bx],al ; place to store checksum, EOL, HS for debug inc bx ; point at next slot cmp al,trans.rsoh ; Is the char the start of header char? jne rpk3x ; ne = no jmp rpack7 ; yes, then go start over. rpk3x: sub al,' ' ; Turn the char back into a number. mov cx,chksum ; current checksum cmp trans.chklen,2 ; What checksum length is in use. je rpackx ; e = Two character checksum. jg rpacky ; g = Three character CRC. shl cx,1 ; put two highest digits of al into ah shl cx,1 and ch,3 ; want just those two bits shr cl,1 ; put al back in place shr cl,1 add cl,ch ; add two high bits to earlier checksum and cl,03fh ; chop to lower 6 bits (mod 64) cmp cl,al ; computed vs received checksum byte (binary) je rpk3xa ; e = equal, so finish up. or status,stat_chk ; say checksum failure rpk3xa: jmp rpack4 rpack7: call deblin ; dump debugging information so far jmp rpack1 ; For the jump out of range. rpacky: mov tmp,al ; Save value from packet here. push bx ; Three character CRC. mov cx,[bx-1] ; save checksum char and next mov temp,cx mov word ptr[bx-1],0 ; put null at end of Data field for crc mov bx,pktptr ; Where data for CRC is. inc bx ; skip SOH call crcclc ; Calculate the CRC and put into CX. pop bx mov ax,temp mov [bx-1],ax ; restore char pair from above mov ah,ch ; cx = 16 bit binary CRC of rcv'd data and ah,0f0h ; Manipulate it here. shr ah,1 shr ah,1 ; Get 4 highest bits. shr ah,1 shr ah,1 ; Shift them over 4 bits. cmp ah,tmp ; Is what we got == what we calculated? je rpky1 ; e = yes or status,stat_chk ; checksum failure rpky1: call inchr ; Get next character of checksum. jmp rpack4 ; Failed. nop mov byte ptr[bx],al ; put into buffer for debug inc bx cmp al,trans.rsoh ; Restarting? je rpack7 ; e = yes sub al,' ' ; Get back real value. rpackx: mov tmp,al ; Save here for now. push cx ; Two character checksum. and cx,0FC0H ; Get bits 6-11. mov ax,cx mov cl,6 shr ax,cl ; Shift them bits over. pop cx ; Get back the original. cmp al,tmp ; Are they equal? je rpkx1 ; yes or status,stat_chk ; checksum failure rpkx1: call inchr ; Get last character of checksum. jmp rpack4 ; Failed. nop mov byte ptr[bx],al ; put into buffer for debug inc bx cmp al,trans.rsoh ; Restarting? je rpack7 ; e = yes sub al,' ' ; Get back real value. and cx,003FH ; Get bits 0-5. cmp al,cl ; Do the last chars match? je rpack4 ; e = yes or status,stat_chk ; say checksum failure rpack4: test status,stat_tmo ; timeout? jnz rpack6 ; nz = yes test status,stat_eol ; premature eol? jnz rpack4c ; nz = yes, try handshake call inchr ; get eol char (ok = ret with carry set) jnc rpack6 ; nc = timeout or user intervention nop cmp bx,offset data+maxpack+7 ; filled debug buffer yet? ja rpack4e ; a = yes mov byte ptr[bx],al ; put into buffer for debug inc bx rpack4e:cmp al,trans.rsoh ; soh already? jne rpack4a ; ne = no jmp rpack7 ; yes rpack4a:and status,not stat_eol ; desired eol is not an error rpack4c:push bx ; test for line turn char, if handshaking mov bx,portval mov ah,[bx].hands ; get desired handshake char cmp [bx].hndflg,0 ; doing half duplex handshaking? pop bx je rpack6 ; e = no mov tmp,ah ; keep it here call inchr ; get handshake char jnc rpack5 ; nc = timeout or user intervention nop and status,not stat_eol ; ignore unexpected eol status here. cmp bx,offset data+maxpack+7 ; filled debug buffer yet? ja rpack4f ; a = yes mov byte ptr[bx],al ; put into buffer for debug inc bx rpack4f:cmp al,trans.rsoh ; soh already? jne rpack4d ; ne = no jmp rpack7 ; yes, do debug display and start over rpack4d:cmp al,tmp ; compare received char with handshake jne rpack4c ; ne = not handshake, try again til timeout rpack5: and status,not stat_tmo ; ignore timeouts on handshake char rpack6: call deblin ; do debug display cmp flags.debug,0 ; In debug mode? jne rpack6a ; ne = yes test flags.capflg,logpkt ; log packets? jz rpack6b ; z = no rpack6a:cmp linecnt,0 ; anything on current line? je rpack6b ; e = no mov dx,offset crlf ; finish line with cr/lf call captdol ; to log file rpack6b:call chkcon ; check console for user interrupt nop nop nop test status,stat_tmo ; did a timeout get us here? jz rpack6c ; z = no mov pktype,'T' ; yes, say 'T' type packet (timeout) rpack6c:mov bl,tmpflg ; flags before rpack began cmp bl,flags.cxzflg ; did flags change? je rpack6e ; e = no cmp flags.cxzflg,'C'; did user type contol-C? je rpack6d ; e = yes cmp flags.cxzflg,'E'; protocol exit request? jne rpack6e ; ne = no ; mov bx,offset cemsg ; user intervention message for error packet mcmsgb cemsg, ccemsg call errpack ; send error message rpack6d:mov pack.state,'A' ; and move to abort state call intmsg ; show interrupt msg for control-C-E rpack6e:mov ax,rpkcnt ; number of bytes received in this packet add fsta.prbyte,ax ; total received bytes adc fsta.prbyte+2,0 ; propagate carry to high word add fsta.prpkt,1 ; count received packet adc fsta.prpkt+2,0 ; ripple carry mov ah,pktype ; return packet type in ah cmp status,stat_suc ; successful so far? jne rpack6x ; ne = no jmp rskp ; success exit rpack6x:ret ; failure exit RPACK ENDP ; Check Console (keyboard). Ret if "action" chars: cr for forced timeout, ; Control-E for force out Error packet, Control-C for quit work now. ; Return rskp on Control-X and Control-Z as these are acted upon by higher ; layers. Consume and ignore anything else. chkcon: call isdev ; is stdin a device and not a disk file? jnc chkco5 ; nc = no, a disk file so do not read here mov dl,0ffh mov ah,dconio ; read console int dos jz chkco5 ; z = nothing there cmp al,cr ; carriage return? je chkco3 ; e = yes, simulate timeout cmp al,'C'-40h ; Control-C? je chkco1 ; e = yes cmp al,'E'-40h ; Control-E? je chkco1 ; e = yes cmp al,'X'-40h ; Control-X? je chkco4 ; e = yes cmp al,'Z'-40h ; Control-Z? je chkco4 ; record it, take no immmediate action here cmp al,0 ; scan code being returned? jne chkcon ; ne = no mov ah,dconio ; read and discard second byte mov dl,0ffh int dos jmp chkcon ; else unknown, read any more chkco1: add al,40h ; Make Control-C-E printable. mov flags.cxzflg,al ; Remember what we saw. chkco2: or status,stat_int ; interrupted ret ; act now chkco3: or status,stat_tmo ; cr simulates timeout ret ; act now chkco4: add al,40h ; make control-X-Z printable mov flags.cxzflg,al ; put into flags jmp rskp ; do not act on them here chkco5: cmp flags.cxzflg,'C'; control-C intercepted elsewhere? je chkco2 ; e = yes jmp rskp ; else say no immediate action needed getlen proc near ; compute packet length for short & long types ; returns length in pack.datlen and length ; type (0, 1, 3) in pack.lentyp ; returns length of data + checksum mov ax,pack.datlen ; LEN from packet's second byte xor ah,ah ; clear unused high byte cmp al,3 ; regular packet has 3 or larger here jb getln0 ; b = long packet sub pack.datlen,2 ; minus SEQ and TYPE = DATA + CHKSUM mov pack.lentyp,3 ; store assumed length type (3 = regular) clc ; clear carry for success ret getln0: push cx ; counter for number of length bytes mov pack.lentyp,0 ; store assumed length type 0 (long) mov cx,2 ; two base-95 digits cmp al,0 ; is this a type 0 (long packet)? je getln5 ; e = yes, go find & check length data getln1: mov pack.lentyp,1 ; store length type (1 = extra long) mov cx,3 ; three base 95 digits cmp al,1 ; is this a type 1 (extra long packet)? je getln5 ; e = yes, go find & check length data pop cx stc ; set carry bit to say error (unkn len code) ret getln5: ; chk header chksum and recover binary length push dx ; save working reg xor ax,ax ; clear length accumulator, low part mov pack.datlen,ax ; clear final length too getln7: xor dx,dx ; ditto, high part mov ax,pack.datlen ; length to date mul ninefive ; multiply accumulation (in ax) by 95 mov pack.datlen,ax ; save results push cx call inchr ; read another serial port char into al nop ; should do something here about failures nop nop pop cx mov ah,0 mov byte ptr[bx],al ; store in buffer inc bx add chksum,ax sub al,20h ; subtract space, apply unchar() add pack.datlen,ax ; add to overall length count loop getln7 ; cx preset earlier for type 0 or type 1 mov dx,chksum ; get running checksum shl dx,1 ; get two high order bits into dh shl dx,1 and dh,3 ; want just these two bits shr dl,1 ; put low order part back shr dl,1 add dl,dh ; add low order byte to two high order bits and dl,03fh ; chop to lower 6 bits (mod 64) add dl,20h ; apply tochar() push dx call inchr ; read another serial port char nop nop nop pop dx mov ah,0 mov byte ptr[bx],al ; store in buf for debug inc bx add chksum,ax cmp dl,al ; our vs their checksum, same? pop dx ; unsave regs (preserves flags) pop cx je getln9 ; e = checksums match, success or status,stat_chk ; checksum failure stc ; else return carry set for error ret getln9: clc ; clear carry (say success) ret getlen endp ; Get char from serial port into al, with timeout and console check. ; Ret carry clear if timeout or console char, Ret carry set if EOL seen, ; Rskp on other port chars. Fairflg allows occassional reads from console ; before looking at serial port, to avoid latchups. inchr: mov timeit,0 ; reset timeout flag (do each char separately) push bx ; save a reg cmp fairflg,maxpack ; look at console first every now and then jbe inchr1 ; be = not console's turn yet call chkcon ; check console jmp inchr5 ; got cr or control-c/e input nop mov fairflg,0 ; reset fairness flag for next time inchr1: call prtchr ; Is there a serial port character to read? jmp inchr6 ; Got one (in al); else does rskp. nop call chkcon ; check console jmp inchr5 ; got cr or control-c/e input nop inchr2: cmp flags.timflg,0 ; Are timeouts turned off? je inchr1 ; e = yes, just check for more input. cmp trans.stime,0 ; Doing time outs? je inchr1 ; e = no, just go check for more input. push cx ; save regs push dx ; Stolen from Script code. cmp timeit,0 ; have we gotten time of day for first fail? jne inchr4 ; ne = yes, just compare times mov ah,gettim ; get DOS time of day int dos ; ch = hh, cl = mm, dh = ss, dl = 0.01 sec xchg ch,cl ; get ordering of low byte = hours, etc mov word ptr rptim,cx ; hours and minutes xchg dh,dl mov word ptr rptim+2,dx ; seconds and fraction mov bl,trans.stime ; our desired timeout interval (seconds) mov bh,0 ; one byte's worth mov temp,bx ; work area mov bx,2 ; start with seconds field inchr3: mov ax,temp ; desired timeout interval, working copy add al,rptim[bx] ; add current tod digit interval adc ah,0 xor dx,dx ; clear high order part thereof div sixzero ; compute number of minutes or hours mov temp,ax ; quotient, for next time around mov rptim[bx],dl ; put normalized remainder in timeout tod dec bx ; look at next higher order time field cmp bx,0 ; done all time fields? jge inchr3 ; ge = no cmp rptim[0],24 ; normalize hours jl inchr3a ; l = not 24 hours or greater sub rptim[0],24 ; discard part over 24 hours inchr3a:mov timeit,1 ; say have tod of timeout inchr4: mov ah,gettim ; compare present tod versus timeout tod int dos ; get the time of day sub ch,rptim ; hours difference, ch = (now - timeout) je inchr4b ; e = same, check mmss.s jl inchr4d ; l = we are early cmp ch,12 ; hours difference, large or small? jge inchr4d ; ge = we are early jl inchr4c ; l = we are late, say timeout inchr4b:cmp cl,rptim+1 ; minutes, hours match jb inchr4d ; b = we are early ja inchr4c ; a = we are late cmp dh,rptim+2 ; seconds, hours and minutes match jb inchr4d ; b = we are early ja inchr4c ; a = we are late cmp dl,rptim+3 ; hundredths of seconds, hhmmss match jb inchr4d ; b = we are early inchr4c:or status,stat_tmo ; say timeout pop dx pop cx jmp inchr5 ; timeout exit inchr4d:pop dx pop cx jmp inchr1 ; not timed out yet inchr5: pop bx ; here with console char or timeout clc ; clear carry bit ret ; failure inchr6: pop bx ; here with char in al from port and al,parmsk ; apply 7/8 bit parity mask or al,al ; null char? jnz inchr6b ; nz = no inchr6a:jmp inchr ; ignore the null, read another char inchr6b:cmp al,del ; ascii del byte? je inchr6a ; e = yes, ignore it too inc rpkcnt ; count received byte cmp al,trans.reol ; eol char we want? je inchr7 ; e = yes, ret with carry set jmp rskp ; char is in al inchr7: or status,stat_eol ; set status appropriately stc ; set carry to say eol seen ret ; and return qualified failure ; sleep for the # of seconds in al ; Preserve all regs. Added console input forced timeout 21 March 1987 [jrd] sleep proc near push ax push cx push dx push ax ; save argument mov ah,gettim ; DOS tod (ch=hh, cl=mm, dh=ss, dl=.s) int dos ; get current time pop ax ; restore desired # of seconds add dh,al ; add # of seconds sleep1: cmp dh,60 ; too big for seconds? jb sleep2 ; no, keep going sub dh,60 ; yes, subtract a minute's overflow inc cl ; and add one to minutes field cmp cl,60 ; did minutes overflow? jb sleep1 ; no, check seconds again sub cl,60 ; else take away an hour's overflow inc ch ; add it back in hours field jmp sleep1 ; and keep checking sleep2: mov time,cx ; store desired ending time, hh,mm mov time+2,dx ; ss, .s sleep3: call chkcon ; check console for user timeout override jmp short sleep5 ; have override nop ; three bytes for rskp mov ah,gettim ; get time int dos ; from dos sub ch,byte ptr time+1 ; hours difference, ch = (now - timeout) je sleep4 ; e = hours match, check mmss.s jl sleep3 ; l = we are early cmp ch,12 ; hours difference, large or small? jge sleep3 ; ge = we are early jl sleep5 ; l = we are late, exit now sleep4: cmp cl,byte ptr time ; check minutes, hours match jb sleep3 ; b = we are early ja sleep5 ; a = over limit, time to exit cmp dx,time+2 ; check seconds and fraction, hhmm match jb sleep3 ; b = we are early sleep5: pop dx pop cx pop ax ret sleep endp ; Packet Debug display routines rcvdeb: cmp flags.debug,0 ; In debug mode? jne rcvde1 ; ne = yes test flags.capflg,logpkt ; log packets? jnz rcvde1 ; e = yes ret ; no rcvde1: mov debflg,'R' ; say receiving jmp deb1 snddeb: cmp flags.debug,0 ; In debug mode? jne sndde1 ; ne = yes test flags.capflg,logpkt ; log packets? jnz sndde1 ; yes ret ; no sndde1: mov debflg,'S' ; say sending deb1: push ax ; Debug. Packet display. push bx push cx ; save some regs. push dx push di test flags.debug,logpkt ; is debug active (vs just logging)? jz deb1d ; z = no, just logging cmp fmtdsp,0 ; non-formatted display? je deb1d ; e = yes, skip extra line clearing cmp debflg,'R' ; receiving? je deb1a ; e = yes call sppos ; spack: cursor position jmp deb1b deb1a: call rppos ; rpack: cursor position deb1b: call clearl ; clear the line mov dx,offset crlf mov ah,prstr ; display int dos call clearl ; clear debug line and line beneath deb1e: cmp debflg,'R' ; receiving? je deb1c ; e = yes call sppos ; reposition cursor for spack: jmp deb1d deb1c: call rppos ; reposition cursor for rpack: deb1d: mov dx,offset spmes ; spack: message cmp debflg,'R' jne deb2 ; ne = sending mov dx,offset rpmes ; rpack: message deb2: call captdol ; record dollar terminated string in Log file mov linecnt,7 ; number of columns used so far pop di pop dx pop cx pop bx pop ax ret ; done ; Display/log packet chars processed so far. ; Displays chars from pktptr to bx, both are pointers. ; Enter with bx = offset of next new char. All registers preserved deblin: cmp flags.debug,0 ; In debug mode? jne debln0 ; ne = yes test flags.capflg,logpkt ; log packets? jnz debln0 ; nz = yes ret ; else nothing to do debln0: push cx push dx push di mov di,pktptr ; starting place for debug analysis mov cx,bx ; place for next new char sub cx,di ; minus where we start = number chars to do cmp cx,0 jle debln5 ; le = nothing to do debln2: cmp di,offset data+maxpack+10 ; end of buffer data? ja debln5 ; a = all done push cx ; save loop counter cmp linecnt,70 jb debln3 ; b = not yet, get next data char mov dx,offset crlf ; break line with cr/lf call captdol ; and in log file mov linecnt,0 ; setup for next line debln3: mov dl,byte ptr [di]; get char test dl,80h ; high bit set? jz debln3b ; z = no push dx ; save char in dl mov dl,7eh ; show tilde char for high bit set call captchr ; record in Log file inc linecnt ; count displayed column cmp linecnt,70 ; exhausted line count yet? jb debln3a ; b = not yet mov dx,offset crlf ; break line with cr/lf call captdol ; and in log file mov linecnt,0 ; setup for next line debln3a:pop dx and dl,7fh ; get lower seven bits here debln3b:cmp dl,' ' ; control char? jae debln4 ; ae = no add dl,40h ; uncontrollify the char push dx ; save char in dl mov dl,5eh ; show caret before control code call captchr ; record in Log file inc linecnt ; count displayed column cmp linecnt,70 ; exhausted line count yet? jb debln3c ; b = not yet mov dx,offset crlf ; break line with cr/lf call captdol ; and in log file mov linecnt,0 ; setup for next line debln3c:pop dx ; recover char in dl debln4: call captchr ; record char in dl in the log file inc di ; done with this char, point to next inc linecnt ; one more column used on screen pop cx ; recover loop counter loop debln2 ; get next data char debln5: pop di pop dx pop cx ret captdol proc near ; write dollar sign terminated string in dx ; to the capture file (Log file). [jrd] push ax ; save regs push si mov si,dx ; point to start of string captdo1:lodsb ; get a byte into al cmp al,'$' ; at the end yet? je captdo2 ; e = yes mov dl,al call captchr ; Log the char jmp short captdo1 ; repeat until dollar sign is encountered captdo2:pop si pop ax ret captdol endp captcx proc near ; record counted string, starts in di, count ; is in cx. [jrd] jcxz captc2 ; if count = zero, exit now push ax ; save regs push cx push si mov si,di ; get start address captc1: lodsb ; get a char into al call pktcpt ; record it, cptchr is in msster.asm loop captc1 ; do this cx times pop si pop cx pop ax captc2: ret captcx endp captchr proc near ; record char in dl into the Log file push ax cmp flags.debug,0 ; debug display active? jz captch1 ; z = no. mov ah,conout int dos ; display char in dl captch1:test flags.capflg,logpkt ; logging active? jz captch2 ; z = no mov al,dl ; where pktcpt wants it call pktcpt ; record the char, pktcpt is in msster.asm captch2:pop ax ret captchr endp ; Jumping to this location is like retskp. It assumes the instruction ; after the call is a jmp addr. RSKP PROC NEAR pop bp add bp,3 push bp ret RSKP ENDP ; Jumping here is the same as a ret. R PROC NEAR ret R ENDP code ends end