; =====> CIO.ASM ;*************************************** ;* TIPC Scheme Runtime Support * ;* I/O support * ;* * ;* (C) Copyright 1985, 1986 by Texas * ;* Instruments Incorporated. * ;* All rights reserved. * ;* * ;* Date Written: 24 March 1986 * ;* Last Modification: * ;* 14 April 1986 * ;* Change references to pagetabl * ;* to call memory manager for use * ;* with extended/expanded mem. * ;* 9 Sept 1986 - ds * ;* Add EGA support * ;* 21 Nov 1986 - rb * ;* Detect disk full error correctly* ;* 7 Jan 1987 - dbs * ;* Added support for random I/O * ;* 10 Feb 1987 - tc * ;* EOF-DISP modified to reflect * ;* other changes in Page 5 symbols * ;* 16 Mar 1987 - tc * ;* Added Binary I/O, Error handling* ;* for Disk Full * ;* 21 Jan 1988 - rb * ;* binary I/O uses line-length=0; * ;* do EGA cursor with BIOS call; * ;* use dirty bit of port flags * ;* (commented out) * ;* * ;*************************************** page 60,132 include scheme.equ include sinterp.arg P_FLAGS equ 6 W_FLAGS equ 26 HANDLE equ 8 CUR_LINE equ 10 CUR_COL equ 12 UL_LINE equ 14 UL_COL equ 16 N_LINES equ 18 N_COLS equ 20 T_ATTR equ 24 BUF_POS equ 28 BUF_END equ 30 BUFR equ 32 CHUNK equ 14 BACKSP equ 08 WRAP equ 1 TAB equ 09 RETURN equ 0Dh LF equ 0Ah CTRL_Z equ 1Ah LEFT_AR equ 4Bh RIGHT_AR equ 4Dh F3 equ 3Dh F5 equ 3Fh INSERT equ 52h DELETE equ 53h ENTER equ 0Dh NULL_CH equ 0 BELL_CH equ 07 BLANK equ 0020h buf_len equ 253 MSDOS equ 21h DGROUP group data data segment word public 'DATA' assume DS:DGROUP public port_r, port_seg, port_d public prn_hand public direct,nlines, ncols, ulline, ulcol public curcol, row, column, cur_off, char_hgt bad_set db "[VM INTERNAL ERROR] setadr: bad port",CR,LF,0 push_er db "[VM INTERNAL ERROR] pushchar: failed",CR,LF,0 rd_st_er db "[VM INTERNAL ERROR] takechar: source not a string",CR,LF,0 ch_rd db "CHAR-READY?",0 rch_er db "READ-CHAR",0 sfp_err db "SET-FILE-POSITION!",0 port_r dw 0 ; port_reg dw 0 port_seg dw 0 ; port_page segment port_d dw 0 ; port_disp prn_hand dw 0 ; printer handle win_p dw 0 ; window_p str_p dw 0 ; string_p handlee dw 0 ; handle direct dw 0 ; direction nlines dw 0 ; n_lines ncols dw 0 ; n_cols ulline dw 0 ; ul_line ulcol dw 0 ; ul_col t_attrib dw 0 ; text attribute insert_m dw 0 ; insert mode curcol dw 0 ; cur_col curline dw 0 ; cur_line index dw 0 ; index of buffer sh_ptr dw 0 ; pointer of shadow buffer sh_len dw 0 ; length of shadow buffer sh_bufer db 256 dup (0) ; shadow buffer for characters row dw 256 dup (0) ; row vector column dw 256 dup (0) ; column vector scan dw ? endscan dw ? cur_off dw 0 char_hgt dw 8 extrn vid_mode:word extrn ega_col:byte extrn ega_row:byte data ends XGROUP group progx progx segment word public 'progx' assume CS:XGROUP extrn zbell:far extrn zch_rdy:far extrn sch_err:near extrn dos_err:near ; ; For the Ega ; This routine first outputs a byte to the sequencer register to point to ; the map mask register, and then uses the map mask register to enable ; all banks for writing. ; public enable enable proc far comment ~ push DX push AX mov DX,3c4h ; port addr of sequencer mov AL,2 ; index to other map mask register out DX,AL ; set index register inc DX ; set DX to map mask register xchg AL,AH out DX,AL ; enable all banks pop AX pop DX ~ ret enable endp ;**************************************************************************** ;* * ;* EGA Cursor Emulator * ;* * ;* Purpose: to simulate a cursor for the IBM EGA modes. * ;* * ;**************************************************************************** public ega_curs ega_curs proc far cmp vid_mode,14 ; don't bother unless in EGA mode jl ega_03 mov CX,cur_off and CX,7fh ; is bit one on? jz ega_02 ; cursor not turned off and cur_off,0feh ; turn off bit one jmp ega_03 ega_02: cmp t_attrib,00h ; black attribute? je ega_03 ; forget it ; set up BIOS call mov AX,09DBh ; reverse-video block mov BX,8Fh ; attr = xor,white mov CX,1 ; repetition count = 1 int 10h comment ~ push ES mov AX,0a000h mov ES,AX mov char_hgt,8 cmp vid_mode,14 je ega_01 mov char_hgt,14 ; ; start scan line = row * height ; ega_01: mov AL,ega_row ; current line number xor AH,AH mul char_hgt mov scan,AX ; ; end scan line = row * height + height - 1 ; add AX,char_hgt dec AX mov endscan,AX show_loop: mov CX,80 mul CX mov BX,AX xor AX,AX mov AL,ega_col add BX,AX ; current column mov AH,18h call logical mov DL,0ffh call clrbyte inc scan mov AX,scan cmp AX,endscan jl show_loop mov AH,0 call logical mov AH,0 call enable pop ES ~ ega_03: ret ega_curs endp comment ~ ; signal to the graphics processor that we want to do a logical operation ; (and or xor) with the latched data. ; on entry ah = function selected logical proc near push DX push AX mov DX,3ceh ; port addr of graphics address reg mov AL,3 ; data rotate function out DX,AL inc DX xchg AL,AH out DX,AL pop AX pop DX ret logical endp ; ;on entry: DL contains bit mask for clearing ES:[BX] points to byte in ; CRT memory ; clrbyte proc near mov AH,0fh call enable ; enable all banks mov AL,ES:[BX] ; latch data xor AL,AL ; zero mov ES:[BX],AL ; clear byte mov AH,0ffh call enable mov AL,ES:[BX] ; ???? mov AL,DL ; bit mask for character mov ES:[BX],AL ; set the value ret clrbyte endp ~ progx ends PGROUP group prog prog segment byte public 'PROG' assume CS:PGROUP extrn zscroll:near extrn zputcur:near extrn zputc:near extrn getch:near extrn zcuron:near extrn zcuroff:near extrn zread:near extrn toblock:near extrn stringrd:near extrn printstr:near ;******************************************************************** ; * ; set_pos will set the file position, determing which chunk * ; of the file to read and then setting the file position to * ; the appropriate place. * ; * ;******************************************************************** set%_arg struc dw ? ; caller's CS and IP dw ? dw ? ; ES set_prt dw ? ; port # set_amt dw ? ; chunk # set_buf dw ? ; new buffer pointer set%_arg ends public set_pos set_pos proc near push ES push BP mov BP,SP mov AX,1 pushm C_call get_port,,Load_ES ; get port address mov SP,BP mov BX,tmp_page ; check return status cmp byte ptr ptype+[BX],PORTTYPE*2 ; check type je set_010 setferr: lea BX,sfp_err ; address of error message pushm <[BP].set_buf, [BP].set_amt, [BP].set_prt> mov AX,3 pushm C_call set_src_,,Load_ES ; set_src_err mov SP,BP mov AX,-1 jmp set_don ; set_010: mov BX,tmp_page LoadPage ES,BX ; get page address of port mov SI,tmp_disp mov DX,word ptr ES:[SI+P_FLAGS] and DX,04h ; port a file or a window? cmp DX,04h je setferr mov DI,[BP].set_amt mov DX,[DI] inc DX mov word ptr ES:[SI+CHUNK],DX ; update chunk # dec DX mov CL,8 xor BX,BX mov BL,DH xor DH,DH shl DX,CL ; multiply DX by 256 mov CX,BX test byte ptr ES:[SI+P_FLAGS],READWRITE+WRITE_ONLY ;test port flags pushf ;save flags for later jz set_015 ;if input port jump or byte ptr ES:[SI+P_FLAGS],DIRTY ;else set dirty bit mov BX,[BP].set_buf ; get chunk offset add DX,[BX] ; and add fo file position set_015: mov BX,word ptr ES:[SI+HANDLE] ;get file handle mov AH,42h ;move file pointer to file mov AL,0 ;start plus offset in dx int MSDOS popf ;restore flags jnz set_020 ;jump if output port mov CX,256 ;get buffer length mov BX,word ptr ES:[SI+HANDLE] ;get file handle mov DX,SI add DX,32 ;start of port buffer push DS push ES pop DS ;ds:dx => port buffer mov AH,3fh ;read from a file int MSDOS ;go do it pop DS mov word ptr ES:[SI+BUF_END],AX ;save #bytes read in port set_020: mov BX,[BP].set_buf ;address of chunk offset mov AX,[BX] ;get offset mov word ptr ES:[SI+BUF_POS],AX ;and save in port set_don: pop BP pop ES ret set_pos endp ;;;************************************************************************** ;;; Set Port Address ;;;************************************************************************** set_arg struc dw ? ; caller's BP dw ? ; caller's ES dw ? ; return address pg dw ? ; adjusted page number dis dw ? set_arg ends public ssetadr ; temporary ssetadr proc near ; assembly routine for setadr push ES push BP mov BP,SP push DI push SI push BX mov BX,[BP].pg ; adjusted page number cmp byte ptr ptype+[BX],PORTTYPE*2 ; check port type jne set_err ; get port information lea DI,port_r ; get port register address mov [DI].C_page,BX mov SI,[BP].dis mov [DI].C_disp,SI mov port_d,SI LoadPage ES,BX ; get page address ;;; mov ES,word ptr pagetabl+[BX] ; get page address mov port_seg,ES ; save the page paragraph mov AX,word ptr ES:[SI+HANDLE] ; handler mov handlee,AX mov AX,word ptr ES:[SI+P_FLAGS] ; port flag mov direct,AX mov BX,AX and AX,WINDOW mov win_p,AX and BX,STRIO mov str_p,BX xor AX,AX ; return status set_ret: pop BX pop SI pop DI pop BP pop ES ret ; Display error message set_err: lea SI,bad_set ; address of error message push SI C_call printf,,Load_ES ; print error message mov SP,BP C_call force_de ; force_debug mov SP,BP mov AX,1 ; return error status jmp set_ret ssetadr endp ;;;************************************************************************** ;;; Input a Single Character ;;;************************************************************************** take_arg struc leng dw 256 new_bpos dw 0 take_BP dw ? ; caller's BP dw ? ; caller's ES dw ? ; caller's return address take_arg ends public take_ch take_ch proc near push ES push BP sub SP,offset take_BP ; allocate local storage mov BP,SP mov [BP].new_bpos,0 ; buf position after refilling buf mov [BP].leng,256 ; set up buffer length lea SI,port_r mov BX,[SI].C_page LoadPage ES,BX mov SI,port_d ; get displacement ; Fix for random I/O - read preceeded by a write test byte ptr ES:[SI+P_FLAGS],READWRITE+WRITE_ONLY jz take_c00 ;skip if input port mov BL,byte ptr ES:[SI+P_FLAGS] ;get port flags and BL,DIRTY+STRIO+OPEN+WINDOW ;isolate appropriate flags cmp BL,DIRTY+OPEN ;buffer modified? jne take_c00 ; no, jump and byte ptr ES:[SI+P_FLAGS],NOT DIRTY ;clear flag ; this read was preceded by at least one write, so reposition file pointer ; so it rereads the buffer mov BX,word ptr ES:[SI+HANDLE] dec word ptr ES:[SI+CHUNK] mov CX,word ptr ES:[SI+CHUNK] xor DL,DL mov DH,CL mov CL,CH xor CH,CH mov AX,4200h ; reposition file pointer int MSDOS mov BX,ES:[SI+BUF_POS] ; after re-reading file, restore mov [BP].new_bpos,BX ; current buffer position jmp take_fil ; go re-read the file take_c00: mov BX,word ptr ES:[SI+BUF_POS] cmp BX,word ptr ES:[SI+BUF_END] jge take_c01 jmp take_nxt ; get the next character from buffer ; buffer empty -- fill it up take_c01: cmp win_p,0 ; window object? jne take_c02 jmp take_fil ; no, jump take_c02: cmp str_p,0 ; read from string? je take_win ; no, jump ; read character from string lea BX,[BP].leng push BX lea BX,row ; buffer for characters push BX lea SI,port_r pushm <[SI].C_disp,[SI].C_page> ; port object mov AX,DS mov ES,AX ; ES segment points to DS call stringrd mov SP,BP test AX,AX ; check return status jnz take_ser ; error, jump lea SI,port_r mov BX,[SI].C_page LoadPage ES,BX ;;; LoadPage ES,port_seg ; restore port page ;;; mov ES,port_seg ; reset ES segment mov SI,port_d ; restore SI register jmp take_10 take_ser: lea BX,rd_st_er ; address of error message push BX C_call printf ; display error message mov SP,BP jmp take_10 ; read from window take_win: call read_win mov BX,AX jmp short take_11 ; take_10: mov BX,[BP].leng take_11: mov ES:[SI+BUF_END],BX ; save buffer length test BX,BX ; length zero? jnz take_20 ; no, jump mov ES:[SI+BUF_POS],BX jmp take_30 take_20: cmp win_p,0 ; window object? je take_22 ; no, copy string cmp str_p,0 ; string? je take_25 ; no, jump ; copy characters from buffer to file object take_22: push SI ; save SI register mov DI,SI add DI,BUFR lea SI,row mov CX,BX ; length of characters to move cld ; direction forward rep movsb pop SI ; restore SI register take_25: mov BX,[BP].new_bpos ; BX = buffer position ; Return the next character from the input buffer take_nxt: xor AH,AH mov AL,byte ptr ES:[SI+BUFR+BX] inc BX mov word ptr ES:[SI+BUF_POS],BX cmp AL,CTRL_Z ; test for control-Z jne take_ret ; no, return test direct,BINARY jnz take_ret ; no, return take_30: mov AX,256 ; text file, send EOF take_ret: add SP,offset take_BP ; release local storage pop BP pop ES ret ; Read from file public take_fil take_fil: cmp word ptr ES:[SI+CHUNK],1 ; operating on first chunk? jne take_f05 ; no, jump cmp word ptr ES:[SI+BUF_POS],0 ; Have we filled the buffer yet? je take_f10 ; yes, jump take_f05: inc word ptr ES:[SI+CHUNK] ; bump the chunk number take_f10: mov BX,handlee ; file handle lea CX,[BP].leng ; address of length of bytes to read lea AX,row ; input buffer pushm call zread mov SP,BP test AX,AX ; error status jz take_50 ; no, jump ; We will not return from call to dos_err add AX,(IO_ERRORS_START - 1) ; Make Dos I/O error number mov BX,1 lea CX,port_r pushm ; 1 = non-restartable call dos_err ; invoke scheme error handler take_50: jmp take_10 ;relative jump not long enough take_ch endp ;************************************************************************** ; Read a "record" from window ; ES:SI points to the window object ; Return AX = number of characters read ;************************************************************************** read_arg struc read_SI dw ? read_BX dw ? sav_p dw ? sav_d dw ? read_BP dw ? ; caller's BP dw ? ; caller's return address read_arg ends public read_win read_win proc near push BP sub SP,offset read_BP ; allocate for local storage mov BP,SP xor BX,BX ; initialization mov index,BX mov sh_ptr,BX mov insert_m,BX mov BX,word ptr ES:[SI+CUR_LINE] ; get window information mov curline,BX mov DX,word ptr ES:[SI+CUR_COL] mov curcol,DX mov DX,word ptr ES:[SI+UL_LINE] mov ulline,DX mov DX,word ptr ES:[SI+UL_COL] mov ulcol,DX mov DX,word ptr ES:[SI+N_LINES] mov nlines,DX mov DX,word ptr ES:[SI+N_COLS] mov ncols,DX mov DX,word ptr ES:[SI+T_ATTR] mov t_attrib,DX call zcuron ; turn on the cursor read_001: mov BX,curline ; get the current line number cmp BX,nlines ; check out of lines jl read_put pushm call zscroll ; scroll up one line mov SP,BP mov BX,nlines dec BX ; cur_line = n_lines - 1 mov curline,BX mov curcol,0 ; cur_col = 0 read_put: mov DX,curcol add DX,ulcol add BX,ulline pushm call zputcur ; show the cursor mov SP,BP call getch ; character returned in AL test AL,AL ; extended character? jz read_ex jmp read_100 ;;; Process extended key sequence read_ex: call getch ; character returned in AL cmp AL,LEFT_AR ; left arrow key? jne read_ra jmp read_bs ; as backspace ; read_ra: cmp AL,RIGHT_AR ; right arrow key? jne read_f3 mov insert_m,0 ; turn off insert mode mov BX,sh_ptr cmp BX,sh_len jl read_030 ; get character from shadow buffer jmp read_001 read_030: lea DI,sh_bufer mov AL,byte ptr [DI+BX] jmp read_one ; read_f3: cmp AL,F3 ; F3 key? jne read_f5 mov insert_m,0 ; turn off insert mode read_041: mov CX,index cmp CX,buf_len ; index < len? jl read_043 jmp read_001 ; no room for more chars read_043: mov BX,sh_ptr cmp BX,sh_len ; sh_ptr < sh_length? jl read_045 jmp read_001 ; buffer empty read_045: lea DI,sh_bufer mov AL,byte ptr [DI+BX] call echo_ch ; AL = character mov SP,BP jmp read_041 ; read_f5: cmp AL,F5 ; F5 key? jne read_ins call ega_curs ; turn off the EGA cursor mov insert_m,0 ; turn off insert mode cmp index,0 jne read_051 jmp read_001 read_051: call str_str ; copy characters to shadow buffer mov BX,index mov sh_len,BX mov byte ptr [DI+BX],0 ; end of string dec BX mov [BP].read_SI,SI ; save SI register lea DI,row ; address of row vector lea SI,column ; address of column vector read_053: cmp BX,0 jl read_055 cmp byte ptr [DI+BX],0 jl read_055 mov [BP].read_BX,BX ; save BX mov CX,BLANK pushm xor CH,CH mov CL,byte ptr [SI+BX] mov curcol,CX add CX,ulcol ; ul_col + cur_col push CX mov CL,byte ptr [DI+BX] mov curline,CX add CX,ulline ; ul_line + cur_line push CX call zputc mov SP,BP mov BX,[BP].read_BX ; restore BX dec BX jmp read_053 read_055: mov SI,[BP].read_SI ; restore SI register mov index,0 mov sh_ptr,0 jmp read_001 ; read_ins: cmp AL,INSERT ; insert key? jne read_del call ega_curs ; turn off the EGA cursor mov insert_m,1 ; turn on insert mode jmp read_001 ; read_del: cmp AL,DELETE ; delete key? jne read_EN mov insert_m,0 ; turn off insert mode mov BX,sh_ptr cmp BX,sh_len ; sh_ptr < sh_len? jl read_d01 jmp read_001 read_d01: inc sh_ptr ; sh_ptr++ jmp read_001 ; read_EN: cmp AL,ENTER ; enter key? je read_RT ; as carriage return jmp read_001 ;;; Process ascii character read_100: cmp AL,BACKSP ; backspace? jne read_200 read_bs: mov insert_m,0 ; turn off insert mode call ega_curs ; turn off the EGA cursor mov BX,index cmp BX,0 jle read_150 lea DI,row dec BX cmp byte ptr [DI+BX],0 jl read_150 mov index,BX cmp sh_ptr,0 je read_120 dec sh_ptr ; decrement sh_ptr pointer read_120: lea DI,column xor CH,CH mov CL,byte ptr [DI+BX] ; update cur_line and cur_col mov curcol,CX lea DI,row xor DH,DH mov DL,byte ptr [DI+BX] mov curline,DX mov BX,BLANK add CX,ulcol ; ul_col + cur_col add DX,ulline ; ul_line + cur_line pushm call zputc mov SP,BP jmp read_001 read_150: call zbell jmp read_001 ; read_200: cmp AL,RETURN ; carriage return? je read_RT jmp read_300 ; no, jump ;;; Process return key read_RT: cmp vid_mode,14 jl read_rt1 call ega_curs ; turn off the ega cursor or cur_off,1 read_rt1: mov BX,index mov byte ptr ES:[SI+BUFR+BX],RETURN ; insert carriage return inc BX mov byte ptr ES:[SI+BUFR+BX],LF ; insert line feed inc BX mov index,BX mov DX,curline mov curcol,0 ; cur_col = 0 inc DX ; cur_line++ cmp DX,nlines ; out of lines? jl read_220 pushm call zscroll ; scroll up one line mov SP,BP mov DX,nlines ; yes, cur_line = n_lines - 1 dec DX read_220: mov curline,DX ; restore cur_line call str_str ; copy string into buffer cmp TRNS_pag,0 ; check transcript file je read_250 mov BX,direct and BX,TRANSCRI jz read_250 ; transcript file "on" lea BX,port_r mov DX,[BX].C_page mov [BP].sav_p,DX mov DX,[BX].C_disp mov [BP].sav_d,DX pushm call ssetadr ; set transcript file address mov SP,BP mov AX,index dec AX push AX lea BX,sh_bufer push BX mov [BP].read_SI,SI ; save SI register call printstr ; output to transcript file mov SP,BP mov SI,[BP].read_SI ; restore SI register pushm <[BP].sav_d, [BP].sav_p> call ssetadr ; set current port address mov SP,BP lea DI,sh_bufer read_250: mov BX,index dec BX mov byte ptr [DI+BX],0 ; end of string dec BX mov sh_len,BX jmp read_off ; read_300: cmp AL,LF ; line feed? jne read_one jmp read_001 ; ignore line feed key ; read_one: mov BX,index ; default cmp BX,buf_len ; index >= len? jl read_420 call zbell jmp read_001 read_420: call echo_ch ; AL = character jmp read_001 ; read_off: call zcuroff ; turn off the cursor mov BX,curline mov CX,curcol mov ES:[SI+CUR_LINE],BX ; save cur_line and cur_col mov ES:[SI+CUR_COL],CX mov AX,index ; return length ; read_ret: add SP,offset read_BP pop BP ret read_win endp ;***************************************************************************** ; Move the string in port object to buffer sh_bufer ;***************************************************************************** str_str proc near lea DI,sh_bufer ; address of shadow buffer ; xor BX,BX ; Clear the buffer ;str_01: cmp BX,sh_len ; jge str_10 ; mov byte ptr [DI+BX],0 ; inc BX ; jmp str_01 ; Move the characters str_10: push SI ; save SI add SI,BUFR ; address of input buffer mov CX,index mov AX,ES mov BX,DS mov ES,BX ; ES:DI points to destination string mov DS,AX ; DS:SI points to source string rep movsb mov ES,AX ; reset segment registers mov DS,BX pop SI ; restore SI lea DI,sh_bufer ret str_str endp ;***************************************************************************** ; Echo single character ;***************************************************************************** echo_ch proc near push BP mov BP,SP mov BX,word ptr ES:[SI+T_ATTR] ; get attribute mov t_attrib,BX mov BX,index mov byte ptr ES:[SI+BX+BUFR],AL ; store character inc BX ; index++ mov index,BX ; cmp insert_m,0 ; insert mode? jne echo_10 inc sh_ptr ; sh_ptr++ echo_10: mov DX,curcol mov CX,curline cmp DX,ncols ; end of line? jl echo_20 inc CX ; yes, cur_line++ xor DX,DX ; cur_col = 0 echo_20: lea DI,row cmp CX,nlines ; out of lines? jl echo_50 pushm call zscroll ; scroll up one line mov SP,BP mov CX,nlines dec CX ; cur_line = n_lines - 1 xor DX,DX ; cur_col = 0 ; Decrement the contents of row vector push AX ; save the character push BX ; save the index push CX mov AX,BX ; AX = index xor BX,BX echo_30: cmp BX,AX ; j < index? jge echo_40 ; mov CL,byte ptr [DI+BX] dec byte ptr [DI+BX] ; row[j]-- ; mov byte ptr [DI+BX],CL inc BX ; j++ jmp echo_30 echo_40: pop CX pop BX ; restore information pop AX echo_50: dec BX ; update row and column vectors mov byte ptr [DI+BX],CL lea DI,column mov byte ptr [DI+BX],DL cmp AL,TAB ; tab key? jne echo_100 ; Process the TAB key mov AX,DX mov BX,8 div BL ; AH = cur_col % 8 sub BL,AH add DX,BX cmp DX,ncols ; end of line? jle echo_60 mov DX,ncols echo_60: mov BX,DX add BX,ulcol cmp BX,80 ; out of screen? jl echo_200 mov BX,79 pushm call zputcur mov SP,BP jmp echo_200 ; Process the non-TAB key echo_100: mov curline,CX ; save the information mov curcol,DX add DX,ulcol add CX,ulline pushm call zputc mov SP,BP mov DX,curcol ; restore the information mov CX,curline inc DX echo_200: mov curline,CX mov curcol,DX pop BP ret echo_ch endp ;************************************************************************* ; Push a single character back into the input buffer ;************************************************************************* public pushchar pushchar proc near push ES push BP mov BP,SP push SI push BX ;;; LoadPage ES,port_seg ; Get port page lea SI,port_r mov BX,[SI].C_page LoadPage ES,BX ;;; mov ES,port_seg ; get address of page mov SI,port_d mov BX,word ptr ES:[SI+BUF_POS] ; input buffer starting position cmp BX,0 ; any character available? jle push_err ; no, error dec BX mov word ptr ES:[SI+BUF_POS],BX ; decrement the starting position push_ret: pop BX pop SI pop BP pop ES ret push_err: lea BX,push_er push BX C_call printf,,Load_ES ; print error message mov SP,BP C_call force_de,,Load_ES ; force_debug() mov SP,BP jmp push_ret pushchar endp rd_proc proc near ;************************************************************************* ; Support for read-char-ready? ;************************************************************************* extrn next_SP:near extrn src_err:near public rd_ch_rd public read_cha rd_ch_rd: lods byte ptr ES:[SI] save add AX,offset reg0 ; compute register address mov DI,AX save ; save DI register xor CX,CX push CX push AX C_call get_port,,Load_ES ; get port object mov SP,BP test AX,AX ; check return status jz rd_010 jmp rd_err ; rd_010: restore mov [DI].C_page,SPECCHAR*2 ; prepare to return a character mov SI,tmp_disp mov BX,tmp_page LoadPage ES,BX ; get page address ;;; mov ES,word ptr pagetabl+[BX] ; get address of page mov BX,word ptr ES:[SI+BUF_POS] ; input buffer starting position cmp BX,word ptr ES:[SI+BUF_END] ; compare with ending position jge rd_020 xor AH,AH mov AL,byte ptr ES:[SI+BUFR+BX] ; get the character rd_T: cmp AL,CTRL_Z ; control-Z? jne rd_015 mov BX,word ptr ES:[SI+P_FLAGS] and BX,BINARY ; binary file? jnz rd_015 rd_eof: mov [DI].C_page,EOF_PAGE*2 ; return eof character mov [DI].C_disp,EOF_DISP jmp next_SP ; rd_015: mov [DI].C_disp,AX ; return the character jmp next_SP ; no character in input buffer rd_020: mov AX,word ptr ES:[SI+P_FLAGS] mov BX,AX and AX,WINDOW ; window? jz rd_030 call zch_rdy ; any character? test AX,AX jz rd_no xor AH,AH ; yes jmp rd_T ; no character available -- return '() rd_no: xor AX,AX mov [DI].C_page,AX mov [DI].C_disp,AX jmp next_SP ; not a window rd_030: and BX,OPEN ; open? jz rd_no ; no, return '() pushm call ssetadr mov SP,BP call take_ch ; get one character mov SP,BP restore cmp AX,256 ; eof? je rd_eof call pushchar ; no, put it back mov SP,BP jmp rd_015 ; Wrong port object, display error message rd_err: lea BX,ch_rd jmp src_err ; link to error handler ;;;************************************************************************ ;;; Support for read-char ;;;************************************************************************ read_cha: lods byte ptr ES:[SI] save add AX,offset reg0 ; compute register address mov DI,AX save ; save DI register xor CX,CX push CX push AX C_call get_port,,Load_ES ; get port object mov SP,BP test AX,AX ; check return status jz rc_010 jmp rc_err ; rc_010: restore mov [DI].C_page,SPECCHAR*2 mov BX,tmp_page LoadPage ES,BX ; get page address ;;; mov ES,word ptr pagetabl+[BX] ; get address of page mov SI,tmp_disp mov AX,word ptr ES:[SI+P_FLAGS] ; get port flags mov BX,AX and AX,WINDOW ; window object? jz rc_050 and BX,STRIO ; string object? jnz rc_050 mov CX,word ptr ES:[SI+BUF_POS] cmp CX,word ptr ES:[SI+BUF_END] ; any character in buffer? jl rc_050 mov CX,word ptr ES:[SI+CUR_LINE] add CX,word ptr ES:[SI+UL_LINE] mov DX,word ptr ES:[SI+CUR_COL] add DX,word ptr ES:[SI+UL_COL] push AX mov AX,word ptr ES:[SI+T_ATTR] mov t_attrib,AX pop AX pushm call zputcur ; cursor position mov SP,BP call zcuron ; cursor on mov SP,BP call getch ; get character mov [DI].C_disp,AX mov byte ptr ES:[SI+BUFR],AL ; store in port object call zcuroff ; cursor off mov SP,BP mov BX,1 mov word ptr ES:[SI+BUF_POS],BX mov word ptr ES:[SI+BUF_END],BX jmp next_SP ; rc_050: pushm call ssetadr ; set port address mov SP,BP call take_ch ; take one character mov SP,BP restore cmp AX,256 ; eof? je rc_060 jmp rd_015 ; return the character rc_060: jmp rd_eof ; rc_err: lea BX,rch_er ; address of error message jmp src_err ; jump to error handler rd_proc endp ;;;**************************************************************** ;;; Output a single character ;;;**************************************************************** give_arg struc lenn dw ? ; character string length lenn2 dw ? ; second copy of length sav_pg dw ? sav_ds dw ? give_SI dw ? give_DX dw ? give_CX dw ? give_BX dw ? give_BP dw ? ; caller's BP dw ? ; caller's ES dw ? ; caller's return address char dw ? ; the character to be output give_arg ends extrn zscroll:near extrn force_de:near extrn zputc:near extrn printf:near extrn zwrite:near extrn force_re:near public givechar givechar proc near push ES push BP sub SP,offset give_BP mov BP,SP mov [BP].give_SI,SI ; save registers mov [BP].give_DX,DX mov [BP].give_CX,CX mov [BP].give_BX,BX cmp TRNS_pag,0 ; transcript file? je give_010 mov BX,direct and BX,TRANSCRI jz give_010 ; transcript file "on" lea BX,port_r mov DX,[BX].C_page mov [BP].sav_pg,DX mov DX,[BX].C_disp mov [BP].sav_ds,DX pushm call ssetadr ; set transcript file mov SP,BP push [BP].char call givechar ; output to transcript file mov SP,BP pushm <[BP].sav_ds,[BP].sav_pg> call ssetadr ; set port address mov SP,BP ; give_010: mov CX,[BP].char cmp win_p,0 ; window? jne give_015 jmp give_fil ; no, jump give_015: cmp str_p,0 ; string? je give_018 jmp give_030 ; yes, return ; Output to window give_018: cmp CL,RETURN ; carriage return? jne give_020 mov CL,LF ; yes, change to LF give_020: ;;; call putc_win ; putc_window ;;;******************************************************************** ;;; Output Character to Window ;;; ;;; Description:This routine writes a character to the current cursor ;;; position, then increments the cursor location. ;;; If the current cursor position is now within the bounds ;;; of the window, the character is output in the first ;;; column of the next line, scrolling the window, if ;;; necessary. The current text attributes are used to ;;; write the character. ;;; Note: CX = character ;;;******************************************************************** mov SI,port_d ; get displacement lea BX,port_r mov BX,[BX].C_page LoadPage ES,BX ;;; LoadPage ES,port_seg ; get port page ;;; mov ES,port_seg ; get page segment mov AX,direct ; get the port flag and AX,OPEN ; open for write? jnz putc_002 jmp give_ret putc_002: mov BX,word ptr ES:[SI+CUR_LINE] ; BX = cur_line mov AX,word ptr ES:[SI+CUR_COL] ; AX = cur_col mov DX,word ptr ES:[SI+UL_LINE] mov ulline,DX mov DX,word ptr ES:[SI+UL_COL] mov ulcol,DX mov DX,word ptr ES:[SI+N_LINES] mov nlines,DX mov DX,word ptr ES:[SI+N_COLS] mov ncols,DX mov DX,word ptr ES:[SI+T_ATTR] mov t_attrib,DX ; Check for the character cmp CL,NULL_CH ; null character? jne putc_010 jmp give_ret ; do nothing ; putc_010: cmp CL,BACKSP ; backspace? jne putc_020 dec AX cmp AX,0 jl putc_015 jmp putc_120 putc_015: xor AX,AX ; cur_col = 0 jmp putc_120 ; putc_020: cmp CL,BELL_CH ; bell character? jne putc_030 call zbell ; sound the alarm mov SP,BP jmp give_ret ; putc_030: cmp CL,TAB ; tab character? jne putc_050 mov CX,AX mov DX,8 ; DL = 8 div DL ; AH = (cur_col % 8) sub DL,AH add CX,DX mov AX,CX jmp putc_120 ; ;putc_040: cmp CL,RETURN ; carriage return? ; jne putc_050 ; xor AX,AX ; cur_col = 0 ; jmp putc_100 ; putc_050: cmp CL,LF ; line feed? jne putc_060 xor AX,AX inc BX cmp BX,nlines ; out of lines? jge putc_055 jmp putc_100 putc_055: pushm call zscroll ; scroll window up one line mov SP,BP mov BX,nlines dec BX xor AX,AX jmp putc_100 ; default putc_060: cmp AX,ncols ; check end of line jl putc_080 mov DX,word ptr ES:[SI+W_FLAGS] and DX,WRAP jz putc_070 inc BX ; wrap xor AX,AX jmp putc_080 putc_070: inc AX ; clip jmp putc_100 ; no display putc_080: cmp BX,nlines ; check out of lines? jl putc_090 pushm call zscroll ; scroll window up one line mov SP,BP mov BX,nlines dec BX ; set up current line number xor AX,AX ; and current column number putc_090: mov curcol,AX mov curline,BX push t_attrib ; text character attribute push [BP].char ; character add AX,ulcol push AX ; column number to console add BX,ulline push BX ; line number to console call zputc ; write on cursor position mov SP,BP mov AX,curcol mov BX,curline inc AX ; increment current column putc_100: mov ES:[SI+CUR_LINE],BX ; save current cursor line number putc_120: mov ES:[SI+CUR_COL],AX ; save current cursor column number give_030: jmp give_ret ; Output to file give_fil: lea BX,[BP].lenn mov word ptr [BX],1 ; lenn <- 1 mov word ptr [BX+2],1 ; lenn2 <- 1 lea SI,[BP].char mov AX,handlee test direct,BINARY ; Binary file? jnz give_50 ; Yes, jump cmp CL,LF ; Line feed? jne give_50 ; no, jump mov word ptr [SI],RETURN ; output carriage return pushm call zwrite mov SP,BP test AX,AX ; check return status jnz give_er ; error, jump mov AX,[BP].lenn ; #chars spec'd = #chars written? cmp AX,[BP].lenn2 jne give_disk mov AX,handlee jmp give_80 ; give_50: pushm call zwrite mov SP,BP test AX,AX jnz give_er mov AX,[BP].lenn ; #chars spec'd = #chars written? cmp AX,[BP].lenn2 cmp AX,[BP].lenn2 jne give_disk test direct,BINARY ; Binary file? jnz give_100 ; yes, jump cmp word ptr [SI],RETURN ; carriage return? jne give_100 ; no, jump mov AX,handlee ;;; cmp AX,prn_hand ; printer? ;;; je give_100 ; yes, jump give_80: lea SI,[BP].char mov word ptr [SI],LF ; output line feed lea BX,[BP].lenn mov word ptr [BX],1 pushm call zwrite mov SP,BP test AX,AX ; check return status jnz give_er mov AX,[BP].lenn ; #chars spec'd = #chars written? cmp AX,[BP].lenn2 cmp AX,[BP].lenn2 je give_100 give_disk: mov ax,DISK_FULL_ERROR ; Note disk full error jmp short give_er1 give_er: add ax,(IO_ERRORS_START - 1) ; make dos i/o error number give_er1: mov BX,1 lea CX,port_r pushm ; 1 = non-restartable ; We will not return from call to dos_err call dos_err ; invoke scheme error handler give_100: lea BX,port_r mov BX,[BX].C_page LoadPage ES,BX ;;; LoadPage ES,port_seg ;;; mov ES,port_seg mov BX,word ptr [SI] ; get the character mov SI,port_d mov AX,word ptr ES:[SI+CUR_COL] test direct,BINARY ; Binary file? jnz give_200 cmp BL,BACKSP ; back space? jne give_110 dec AX cmp AX,0 jge give_200 give_rt: xor AX,AX jmp give_200 give_110: cmp BL,TAB ; tab? jne give_120 mov CX,AX mov DX,8 div DL ; AH = (cur_col % 8) sub DL,AH add CX,DX mov AX,CX jmp give_200 ; give_120: cmp BL,RETURN ; carriage return? jne give_130 ; no, continue mov BL,LF ; yes, make it a linefeed jmp give_rt ; give_130: cmp BL,LF ; line feed? jne give_140 jmp give_rt ; default give_140: cmp AX,word ptr ES:[SI+N_COLS] jge give_rt inc AX ; give_200: cmp word ptr ES:[SI+N_COLS],0 ; Line length = 0 ? je give_20a ; Yes, don't maintain column mov ES:[SI+CUR_COL],AX give_20a: mov AX,word ptr ES:[SI+BUF_POS] inc AX test direct,BINARY ; Binary file? jnz give_20b ; yes, jump cmp BX,LF ; CR or LF just output? jne give_20b ; no, jump inc AX ; yes bump # bytes written give_20b: cmp AX,256 ; Exceed chunk boundary? jle give_201 ; no, jump sub AX,256 ; AX = excess above chunk inc word ptr ES:[SI+CHUNK] ; bump chunk # give_201: mov word ptr ES:[SI+BUF_POS],AX ; set the buffer position give_ret: xor AX,AX add SP,offset give_BP ; release local storage mov SI,[BP].give_SI ; restore registers mov DX,[BP].give_DX mov CX,[BP].give_CX mov BX,[BP].give_BX pop BP pop ES ret givechar endp prog ends end