TITLE SET-DISPLAY-RESET COMM. PORT ON RAINBOW 100 subttl STACK SEGMENT STACK SEGMENT PARA STACK 'STACK' ; dw 100 dup(?) ; TSTACK LABEL WORD STACK ENDS ; ;DEFINE PROGRAM SEGMENT PREFIX ; PREFIX SEGMENT AT 0 ORG 80H CMDCNT DB ? ;COMMAND LINE COUNT CMDSTR DB 80 DUP (?) ;COMMAND LINE BUFFER PREFIX ENDS ; subttl DATA SEGMENT ; DSEG SEGMENT PARA PUBLIC 'DATA' ; APREFIX DW 0 CLS DB 1BH,'[2J','$' ;ESCAPE SEQ. TO CLEAR SCREEN INTRO DB ' ' DB 1BH,'[7m' DB 'SETAUX.EXE V2.0 by David N. Mitchell Copyright (C)' DB ' 8/86',13,10 DB 1BH,'[0m' DB 13,10 DB ' The "SETAUX" program now supports two new functions : ' DB '"SETAUX D" will',13,10 DB 'display the current settings of the port and "SETAUX R" will ' DB 'reset the',13,10 DB 'port to the NVM settings and clear the port. The display ' DB 'and set functions',13,10 DB 'only support the options listed below. Once changed by the ' DB 'program, these',13,10 DB 'settings will NOT be reflected in the modem set-up screen ' DB 'accessed through',13,10 DB 'the Rainbow SET-UP key. The following is a list of ' DB 'supported settings to be',13,10 DB 'passed in the order listed along with the actual parameters ' DB 'in parentheses.',13,10 DB 'NO intervening spaces are allowed between parameters !',13,10 DB 13,10 DB 'STOP BITS : 1 (1) 1.5 (2) 2 (3)',13,10 DB 'DATA BITS : 5 (1) 6 (2) 7 (3) 8 (4) 7S (5)' DB ' 7M (6)',13,10 DB 'PARITY : EVEN (1) ODD (2) NONE (3)',13,10 DB 'RCV BAUD : 300 (1) 1200 (2) 2400 (3) 4800 (4) 9600 (5)' DB 13,10 DB 'XMT BAUD : 300 (1) 1200 (2) 2400 (3) 4800 (4) 9600 (5)' DB 13,10 DB 13,10 DB 'Example call for 1 stop bit, 8 data bits, no parity, RCV = ' DB '1200, XMT = 1200 :',13,10 DB 13,10 DB 'SETAUX 14322',13,10,'$' ; ; IO CONTROL PACKET ; IOCTL LABEL BYTE FNUM DB ? FRETC DB ? CHAR DB ? CSTAT DB ? DEVNUM DB 0 MDMCNTL DB 0 STOPBIT DB 0 DATABIT DB 0 PARITY DB 0 RXBAUD DB 0 TXBAUD DB 0 XONCHR DB 0 XOFFCHR DB 0 RXONOFF DB 0 TXONOFF DB 0 ALTBUF DB 6 DUP(0) ; BLANK16 DB ' $' HEADER0 DB ' *** Rainbow Current Comm. Port Set-Up ***',13,10,'$' HEADER1 DB ' (Copyright (C) 8/86 David Mitchell)',13,10,'$' HEADER2 DB 'DATA BITS/PARITY RCV-BAUD TX-BAUD STOP-BITS',13,10,'$' HEADER3 DB '---------------- -------- ------- ---------',13,10,'$' CRLF DB 13,10,'$' BLANK DB 20H FIVE DB '5' SIX DB '6' SEVEN DB '7' EIGHT DB '8' S DB 'S' M DB 'M' SLASH DB '/' ODD DB 'O' EVEN0 DB 'E' NONE DB 'N' ONE DB '1',13,10,'$' ONE5 DB '1.5',13,10,'$' TWO DB '2',13,10,'$' B300 DB ' 300$' B1200 DB ' 1200$' B2400 DB ' 2400$' B4800 DB ' 4800$' B9600 DB ' 9600$' OTHER DB 'OTHER$' PARERR DB 'ERROR : 7S and 7M data bit specifications require parity = ' DB 'NONE$' ERROR DB 'ERROR : Invalid Parameter Specification$' PARAM DB 'ERROR : Too Many Parameters$' NOSET DB 'Function Unsuccessful',13,10,'$' ; DSEG ENDS ; subttl MACROS INCLUDE CALLS.MAC ; ; subttl CODE SEGMENT ; CSEG SEGMENT PARA PUBLIC 'CODE' START PROC FAR ASSUME CS:CSEG,SS:STACK,ES:PREFIX mov ax,dseg mov ds,ax ASSUME DS:DSEG mov aprefix,es mov ax,stack mov ss,ax mov sp,offset tstack ENTRY: MOV DI,OFFSET CMDSTR ;LOCATION OF PARAMETER STRING MOV CH,0 MOV CL,CMDCNT ;LENGTH OF PARAMETER STRING CMP CX,0 ;ANY PARAMETERS JNZ SCAN0 ;YES - PROCESS THEM JMP SCANX SCAN0: MOV AL,ES:[DI] ;GET FIRST PARAMETER CHAR. CMP AL,20H JZ NOSAV ;DITCH THE LEADING SPACE SCAN1: MOV AL,ES:[DI] CMP AL,96 JLE NEXT ;IF CHAR. < "A" DON'T CONVERT CMP AL,123 JGE NEXT ;IF CHAR. > "Z" DON'T CONVERT SUB AL,20H ;CONVERT TO UPPER CASE NEXT: MOV ES:[DI],AL ;PUT CHAR. BACK IN BUFFER NOSAV: INC DI ;POINT TO NEXT CHARACTER LOOP SCAN1 ;GET NEXT CHARACTER MOV AL,'$' MOV ES:[DI],AL SCANX: NOP ;ALL PARAMETERS HANDLED ;------------------------------------------------------------------------------- ;START OF MAIN PROGRAM ;------------------------------------------------------------------------------- cmp cmdcnt,0 jnz chk ;if no paramters, display intro ;display help message jmp done CHK: mov di,offset cmdstr ;check param. for "D" or "R" inc di mov cl,es:[di] cmp cl,44H ;D = display current settings, jnz chk4r call showset jmp done CHK4R: cmp cl,52H ;R = reset to NVM & clear jnz chkparm call reset jmp done CHKPARM:call check call setparm jmp done ;------------------------------------------------------------------------------- ;RETURN TO DOS ;------------------------------------------------------------------------------- DONE: display crlf exit RET START ENDP ;------------------------------------------------------------------------------- ;SUBROUTINES ;------------------------------------------------------------------------------- RESET PROC mov cl,1 mov di,offset fnum ;function code mov [di],cl mov di,offset devnum ;device number mov al,1 mov [di],al ;device = comm. mov ah,44H ;IOCTL devices function code mov al,2 ;func. code - 2 works (not 3) mov bx,3 ;handle - 3=AUX 4=PRN mov dx,offset ioctl ;packet address int 21H ;reset to NVM & clear port ret RESET ENDP SHOWSET PROC mov al,3 mov di,offset fnum ;function code mov [di],al mov di,offset devnum ;device number mov al,1 mov [di],al ;device = comm. mov ah,44H ;IOCTL devices function code mov al,2 ;func. code mov bx,3 ;handle - 3=AUX 4=PRN mov dx,offset fnum ;packet address int 21H mov di,offset fretc mov al,[di] ;ret. code cmp al,0FFH ;FFH = success , 0 = fail jz dispset ;display settings nomsg: display noset jmp done dispset:display crlf display blank16 display header0 display blank16 display header1 display crlf display blank16 display header2 display blank16 display header3 display blank16 mov cx,8 loop1: dsp_chr blank loop loop1 mov di,offset databit mov al,[di] cmp al,1 jnz chk2 dsp_chr five jmp party chk2: cmp al,2 jnz chk3 dsp_chr six jmp party chk3: cmp al,3 jnz chk4 dsp_chr seven jmp party chk4: cmp al,4 jnz chk5 dsp_chr eight jmp party chk5: cmp al,5 jnz chk6 dsp_chr seven dsp_chr slash dsp_chr s jmp nopar chk6: dsp_chr seven dsp_chr slash dsp_chr m jmp nopar party: dsp_chr slash mov di,offset parity mov al,[di] cmp al,1 jnz chkp2 dsp_chr even0 jmp nopar chkp2: cmp al,2 jnz chkp3 dsp_chr odd jmp nopar chkp3: dsp_chr none nopar: mov cx,9 loop2: dsp_chr blank loop loop2 mov di,offset rxbaud mov al,[di] cmp al,7 jnz chkr2 display b300 jmp trsmt chkr2: cmp al,9 jnz chkr3 display b1200 jmp trsmt chkr3: cmp al,0CH jnz chkr4 display b2400 jmp trsmt chkr4: cmp al,0EH jnz chkr5 display b4800 jmp trsmt chkr5: cmp al,10H jnz chkr6 display b9600 jmp trsmt chkr6: display other trsmt: mov cx,5 loop3: dsp_chr blank loop loop3 mov di,offset txbaud mov al,[di] cmp al,7 jnz chkt2 display b300 jmp stbit chkt2: cmp al,9 jnz chkt3 display b1200 jmp stbit chkt3: cmp al,0CH jnz chkt4 display b2400 jmp stbit chkt4: cmp al,0EH jnz chkt5 display b4800 jmp stbit chkt5: cmp al,10H jnz chkt6 display b9600 jmp stbit chkt6: display other stbit: mov cx,7 loop4: dsp_chr blank loop loop4 mov di,offset stopbit mov al,[di] cmp al,1 jnz chks2 dsp_chr one jmp done chks2: cmp al,2 jnz chks3 display one5 jmp done chks3: display two SHOWSET ENDP CHECK PROC mov dl,0 ;parity flag, see below mov ch,0 ;zero high byte mov cl,5 ;must have 5 parameters mov bx,1 ;parm counter mov di,offset cmdstr ;location of cmd. line (parms) CONT: inc di ;skip blank - mov to next parm. mov al,es:[di] ;get 1st parm into al cmp al,20H ;check for blanks jz err ;go print error msg cmp bx,1 ;1st parm ? jnz too ;no, goto two cmp al,34H ;1st parm >= 4 ? jge err ;yes, goto err jmp zero ;go chk. if parm <= 0 TOO: cmp bl,2 ;2nd parm ? jnz three ;no, goto three cmp al,37H ;2nd parm >= 7 ? jge err ;yes, goto err cmp al,34H ;2nd parm <= 4 ? jle ok ;yes, don't worry about parity mov dl,1 ;no, set flag - parity must = N OK: jmp zero ;go chk. if parm <= 0 THREE: cmp bl,3 ;3rd parm ? jnz four ;no, goto four cmp al,34H ;3rd parm >= 4 ? jge err ;yes, goto err cmp dl,1 ;flag set ? jnz zero ;no, goto zero cmp al,33H ;yes, parity must = N jnz perr ;parity <> N, print parity err. jmp zero ;parity = N, goto zero FOUR: cmp al,36H ;this is used for 4th and 5th jge err ;since both must be < 6 ZERO: cmp al,30H ;used to check all parms > 0 jle err ;no, goto err inc bx ;add 1 to count loop cont ;sub. 1 from cx, goto cont inc di ;add 1 to pointer mov al,es:[di] ;get what should be '$' cmp al,24H ;char = '$' ? jnz toomany ;no, print toomany msg ret ; ERR: mov dx,offset error ;prints standard error msg WRITE: mov ah,09H ; int 21H ; jmp quit ; PERR: mov dx,offset parerr ;print parity error msg jmp write ; TOOMANY:mov dx,offset param ;print too many parms error msg jmp write ; QUIT: exit ret CHECK ENDP SETPARM PROC mov cl,0 mov si,offset fnum ;function code mov [si],cl mov si,offset devnum ;device number mov al,1 mov [si],al ;device = comm. mov di,offset cmdstr ;parm. string address inc di ;skip blank mov al,es:[di] ;get 1st parm. - stop bits sub al,30H ;convert from ascii to numeric inc di mov si,offset stopbit mov [si],al ;set stop bits mov al,es:[di] ;get 2nd parm. - data bits sub al,30H ;convert from ascii to numeric inc di mov si,offset databit mov [si],al ;set data bits mov al,es:[di] ;get 3rd parm. - parity sub al,30H ;convert from ascii to numeric inc di mov si,offset parity mov [si],al ;set parity mov al,es:[di] ;get 4th parm. - rcv baud sub al,30H ;convert from ascii to numeric cmp al,1 ;check for 300 baud jnz rchk1 ;no, goto rchk1 mov al,7 ;yes, code for 300 baud jmp setrcv ;goto set rcv baud RCHK1: cmp al,2 ;check for 1200 baud jnz rchk2 ;no, goto rchk2 mov al,9 ;yes, code for 1200 baud jmp setrcv RCHK2: cmp al,3 ;check for 2400 baud jnz rchk3 mov al,0CH ;yes, code for 2400 jmp setrcv RCHK3: cmp al,4 jnz rchk4 mov al,0EH ;yes, code for 4800 jmp setrcv RCHK4: mov al,10H ;9600 baud is only one left SETRCV: inc di mov si,offset rxbaud mov [si],al ;set RCV baud mov al,es:[di] ;get 5th parm. - xmt baud sub al,30H ;convert from ascii to numeric cmp al,1 ;check for 300 baud jnz chek1 ;no, goto chek1 mov al,7 ;yes, code for 300 baud jmp setx ;goto set tx baud CHEK1: cmp al,2 ;check for 1200 baud jnz chek2 ;no, goto chek2 mov al,9 ;yes, code for 1200 baud jmp setx CHEK2: cmp al,3 ;check for 2400 baud jnz chek3 mov al,0CH ;yes, code for 2400 jmp setx CHEK3: cmp al,4 jnz chek4 mov al,0EH ;yes, code for 4800 jmp setx CHEK4: mov al,10H ;9600 baud is only one left SETX: inc di mov si,offset txbaud mov [si],al ;set XMT baud mov ah,44H ;IOCTL devices function code mov al,2 ;func. code - 2 works (not 3) mov bx,3 ;handle - 3=AUX 4=PRN mov dx,offset ioctl ;packet address int 21H mov si,offset fretc mov al,[si] cmp al,0FFH jz retu display noset RETU: ret SETPARM ENDP CSEG ENDS END START