Frostbyte's 1980s DOS Shareware Collection

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

/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / VORX / EM15DM11.ARC / EMACS.ASM < prev next >

Wrap

Assembly Source File | 1989-08-18 | 41KB | 2,050 lines

;emacs.asm - last modified Fri Aug 18 23:01:26 1989 PDT - mbf ;History:722,45 ;Sat Jul 29 14:53:07 1989 Added cc primitive for setting cursor type (lines ; 1852, 1932, 2006; see also ibm.asm) [mbf] ;Fri May 26 09:30:20 1989 Added bp variable (0..1) for toggling beep timeout ; (lines 117, 147, 176, 238-39, 630-33, 725-27; see also ibm.asm) [mbf] ;10-02-88 20:50:38 add a buffer for mouse clicks. ;10-01-88 14:50:07 make #(lv,ms) return four numbers. ;09-23-88 20:37:28 clean up auto_save ;09-18-88 23:13:35 Add "string index", si_prim ;09-18-88 12:32:52 use lowercase pathnames in #(lv,cd). ;09-12-88 23:40:00 if the buffer-modified flag is 2, then the buffer is read-only. ;09-10-88 05:44:35 Use bl instead of num_screen_cols in announce(). ;09-10-88 05:40:21 try returning / when they try to find it. ;08-16-88 00:23:20 change auto save so it only count changes to a file. ;07-24-88 23:25:20 Put the third argument to #(an) *after* the cursor. ;07-19-88 00:17:27 Create 'li' primitive. ;05-15-88 19:58:02 Remove reference to non-existent init_memory [kdb] ;05-07-88 22:07:45 if stdout and stderr are redirected, don't bother swapping screens. ;04-17-88 22:47:53 add the ex redirect code. ;04-03-88 23:28:39 move the version number into another file. ;04-01-88 22:47:59 add tc variable. ;03-30-88 21:22:49 move xlat_to_mark to memory.asm ;03-30-88 20:48:45 add tr_prim ;03-27-88 19:47:54 add store_firstline and store_lastline ;03-26-88 15:53:35 put the variables in alphabetic order. ;03-26-88 14:24:12 expand the ?v_prim symbols to the two letter symbols. ;03-26-88 10:02:03 get rid of old single-letter variables. ;03-26-88 10:01:52 add auto-save counter ;03-23-88 23:56:09 Add variables 'fo' and 'bo' for original colors. ;03-13-88 12:27:10 remove #(ef) ;03-10-88 22:41:26 add #(l?) ;12-13-87 21:17:22 ;11-26-87 11:45:11 fix goofyness in it_prim. ;09-09-87 00:49:51 after fixing redisp for the column redisplay bug, bump the version. ;07-15-87 22:10:51 up the version letter because I gave a copy to Pat. ;07-13-87 23:11:23 remove xyputch. ;07-13-87 23:00:03 move things around between files. ;07-10-87 23:09:06 add #(lv,vn) - version number. ;07-10-87 22:54:07 fix the problem with #(lv,xx) where xx is not a variable. ;07-10-87 00:23:10 remove trailing blank from #(sv,cd,...) ;07-10-87 00:17:28 add #(sv,cd,...) ;07-08-87 21:37:15 put a trailing \ on 'cd' variable. ;07-08-87 21:01:05 create the 'cd' variable. ;07-05-87 14:16:38 make complete paths in ff_prim an assembly-time option. ;07-05-87 14:02:28 compute the prefix length in ff_prim properly. ;07-05-87 11:55:54 Return full pathname and lowercase in ff_prim. test_prims equ 0 page ,132 .xlist include memory.def include mint.def include findfile.def data segment byte public extrn version_number: byte, version_number_len: abs ;the following externs are defined in 'mintprim' extrn read_errors: word extrn write_errors: word extrn data_bottop: word extrn data_topbot: word ;the following externs are defined in 'mintscan' extrn fbgn: word, fend: word extrn next_ids: word ;the following externs are defined in the computer-dependent file. extrn max_screen_line: byte extrn num_screen_cols: word extrn computer_name: byte extrn computer_name_len: abs public filename, filename2 filename db 64 dup(?) filename2 db 64 dup(?) rename_error db 'Rename error' rename_error_len equ $-rename_error speller_txt db 'Speller' speller_txt_len equ $-speller_txt extrn next_redisp_line: word public standard_ids standard_ids db '#(d,#(g))',0 nokbd_ids db '#(k)#(d,#(g))',0 auto_ids db '#(Fauto-save)',0 auto_save_limit dw 0 auto_save_cntr dw 0 byte_ptr label byte foreback_color label word fore_color db 7 back_color db 0 ex_stdin dw ? ;-1 if we're not redirecting. ex_stdout dw ? ;-1 if we're not redirecting. ex_stderr dw ? ;-1 if we're not redirecting. extrn swap_screen_flag: word ;=1 if we should swap screens. extrn tab_size: word extrn fore_original: byte extrn back_original: byte variable_table label byte db 'as' ;Auto Save db 'bc' ;Background Color db 'bl' ;Bot Line db 'bo' ;Background Original db 'bp' ;Beep Toggle [mbf] db 'bs' ;Bot Scroll db 'cd' ;Current Directory db 'cl' ;Line Number db 'cn' ;Computer Name db 'cs' ;Column on Screen db 'cw' ;Current Window db 'fc' ;Foreground Color db 'fo' ;Foreground Original db 'im' ;Inverse Mark db 'is' ;Inhibit Snow db 'lc' ;Lefthand Column db 'mb' ;Modified Buffer db 'ms' ;Mint Space db 'nl' ;Number of Lines db 'ow' ;Other Window db 'pb' ;Percent of Buffer db 'rs' ;Row on Screen db 'tc' ;Tab Columns db 'tl' ;Top Line db 'ts' ;Top Scroll db 'vn' ;Version Number db 'ws' ;Whitespace Showing variable_count equ ($-variable_table)/2 lv_prim_table label word dw lv_prim_as dw lv_prim_bc dw lv_prim_bl dw lv_prim_bo dw lv_prim_bp ;mbf dw lv_prim_bs dw lv_prim_cd dw lv_prim_cl dw lv_prim_cn dw lv_prim_cs dw lv_prim_cw dw lv_prim_fc dw lv_prim_fo dw lv_prim_im dw lv_prim_is dw lv_prim_lc dw lv_prim_mb dw lv_prim_ms dw lv_prim_nl dw lv_prim_ow dw lv_prim_pb dw lv_prim_rs dw lv_prim_tc dw lv_prim_tl dw lv_prim_ts dw lv_prim_vn dw lv_prim_ws sv_prim_table label word dw sv_prim_as dw sv_prim_bc dw sv_prim_bl dw sv_prim_bo dw sv_prim_bp ;mbf dw sv_prim_bs dw sv_prim_cd dw sv_prim_cl dw sv_prim_cn dw sv_prim_cs dw sv_prim_cw dw sv_prim_fc dw sv_prim_fo dw sv_prim_im dw sv_prim_is dw sv_prim_lc dw sv_prim_mb dw sv_prim_ms dw sv_prim_nl dw sv_prim_ow dw sv_prim_pb dw sv_prim_rs dw sv_prim_tc dw sv_prim_tl dw sv_prim_ts dw sv_prim_vn dw sv_prim_ws extrn stackp: byte public trace_handle trace_handle dw -1 sa_jump dw ? sa_n_jump dw ? mouse_buffer dw 0 ;mouse button buffer. data ends code segment byte public assume cs:code, ds:data, es:data extrn set_screen_color: near extrn redisplay: near ;ax=line to leave the cursor on. extrn buffer_free: near extrn read_firstline: near extrn read_lastline: near extrn store_firstline: near extrn store_lastline: near extrn read_newrow: near extrn read_linesbefore: near extrn read_linecount: near extrn read_buffer_modified: near extrn store_buffer_modified: near extrn read_ibm_cga: near extrn store_ibm_cga: near extrn read_inverse_mark: near extrn store_inverse_mark: near extrn read_showblanks: near extrn store_showblanks: near extrn read_beep: near ;mbf extrn store_beep: near extrn read_top_percent: near extrn read_bot_percent: near extrn store_top_percent: near extrn store_bot_percent: near extrn read_other_window: near extrn read_current_window: near extrn store_other_window: near extrn store_current_window: near extrn chrout: near ;al=char to overwrite to screen. extrn paint_screen: near ;sets entire screen to be repainted. extrn paint_window: near ;causes the current buffer to be shown in the current window. extrn insert_string: near ;si,cx describe the string. extrn buffer_allocate: near ;entry: cx=buffer number to select, ; cx=0 to create new buffer. ; ax=0 for read/write buffer. ;exit: ax=new buffer number if enough ; memory, ax=0 otherwise. extrn read_mark: near ;entry: al=mark to read to. ;exit: es:si, cx describing string. extrn del_to_mark: near ;entry: al=mark to delete to. extrn set_mark: near ;entry: al=dest mark, ah=source mark. extrn goto_mark: near ;entry: al=mark to go to. extrn xlat_to_mark: near ;entry: al=mark to translate to. ; es:bx = translate table, ; dx = length of translate table. extrn stack_marks: near ;entry: ax>0 to create temp marks, ; ax=0 to delete temp marks, ; ax<0 to create perm marks and delete ; all temp marks. extrn compute_cursor: near ;exit with dx=column (0..65535) extrn set_column: near ;entry: ax=desired column extrn set_line: near ;entry: ax=desired line. extrn read_firstcolumn: near ;get the left hand column. extrn store_firstcolumn: near ;set the left hand column. extrn ring_the_bell: near ;the following extrns are in the computer-dependent file extrn xychrout: near extrn clear_count: near extrn position_cursor: near extrn check_for_key: near ;the following extrns are in 'files' extrn read_file: near extrn write_file: near ;the following extrns are in 'search' extrn regexp_pat: near extrn set_pattern: near extrn search: near ;the following extrns are in 'mintscan' extrn nomem: near ;the following externs are in 'pick' extrn pick_on: near extrn pick_off: near extrn check_pick: near extrn get_pick_values: near public init_ids init_ids: mov sp,offset stackp call check_for_key ;use the standard ids only if kbd ready. jnz init_ids_1 mov ax,offset nokbd_ids init_ids_2: cmp next_ids,offset standard_ids ;only use a different one if jne init_ids_1 ;we're at the standard ids. mov next_ids,ax init_ids_1: jmp init_ids_continue extrn init_ids_continue: near write_protect: call read_buffer_modified ;see if this buffer is read-only. cmp al,2 je write_protect_1 ;yes - leave immediately. ret write_protect_1: pop ax ;discard our return address. jmp return_null auto_save: mov ax,auto_save_cntr ;is the counter already at zero? or ax,ax ;is the counter already at zero? je auto_save_1 ;yes - don't decrement it. dec ax ;time to auto-save? jne auto_save_1 ;no. mov ax,auto_save_limit ;yes - reset the counter. mov next_ids,offset auto_ids auto_save_1: mov auto_save_cntr,ax ret if test_prims ;test primitive. fills memory to the max. strictly for testing only. ts_prim: di_points_fbgn mov cx,data_topbot sub cx,di dec cx push cx mov al,' ' rep stosb pop cx jmp return_sicx formSeg segment public ;the following externs are defined in 'mintform' extrn formhash: word formSeg ends ;dump formhash. strictly for testing only. tt_prim: mov cx,256 di_points_fbgn chk_room_cnt mov si,offset formhash tt_prim_1: test cx,3fh jne tt_prim_4 mov ax,LINENEW stosw tt_prim_4: mov dx,0 lodsw mov bx,ax tt_prim_2: cmp bx,NIL ;at end of list yet? je tt_prim_3 mov bx,[bx].hash_link inc dx jmp tt_prim_2 tt_prim_3: mov ax,dx ;get the count add al,'0' ;convert to ascii (cheaply) stosb loop tt_prim_1 jmp return_tos endif ;redisplay. rd_prim: call getarg1 jcxz rd_prim_1 call paint_screen ;paint, call paint_window jmp short rd_prim_3 ; always redisplay rd_prim_1: call check_for_key ;redisplay only if no key waiting. jnz rd_prim_2 rd_prim_3: call redisplay rd_prim_2: jmp return_null ;overwrite the screen. ow_prim: call getarg1 jcxz ow_prim_2 ow_prim_1: lodsb xor ah,ah call chrout push si push cx pop cx pop si loop ow_prim_1 ow_prim_2: jmp return_null extrn get_math: near extrn gotoxy: near ;gotoxy xy_prim: call get_math mov dh,al mov dl,bl call gotoxy jmp return_null ;announce a string an_prim: mov bx,num_screen_cols ;end of the line. mov cx,2 ;if the second arg is non-null, mov dh,0 ;start in this column call getarg jcxz an_prim_1 call read_lastline ; put the announcement after the current window. inc al mov dl,al call announce1 call clear_count ;clear to the end of the annunciator. jmp return_null an_prim_1: mov dl,max_screen_line ;get the row. inc dl inc dl ;put our announcement after it. call announce1 ;announce the left part. call position_cursor ; put the cursor at the end of the string mov cx,3 ;now announce the right part. call announce call clear_count ;clear to the end of the annunciator. jmp return_null announce1: mov cx,1 announce: ;given an argument in cx, print it at row=dl, column=dh. call getarg jcxz announce_2 ;if null, we';re done. announce_1: cmp dh,bl ;end of the line. jae announce_2 ;if we hit end of line, we're done. lodsb ;get a character. mov ah,0 call xychrout inc dh loop announce_1 announce_2: ret ;insert a string. is_prim: call write_protect call getarg1 call insert_string jc is_prim_1 ;go if we can't insert it. jmp return_null is_prim_1: mov cx,2 jmp return_arg extrn get_mint_space: near lv_prim: ;load variable mov bx,offset lv_prim_table call parse_variable di_points_fbgn jmp word ptr [bx] lv_prim_cd: mov cx,64+3 ;we need at most 64 plus 'a:\'. chk_room_cnt mov ah,19h ;get the current drive. int 21h mov dl,al inc dl add al,'a' stosb mov ax,':' + '\'*256 stosw mov si,di ;get the directory here. mov ah,47h ;get current directory. int 21h lv_prim_cd_1: ;find the terminating null. lodsb call to_lower ;lowercase the filename. mov [si-1],al or al,al jne lv_prim_cd_1 dec si xchg di,si ;di should point to the null. cmp si,di ;are we in a subdirectory? je lv_prim_cd_2 mov al,'\' ;yes - store a trailing backslash. stosb lv_prim_cd_2: jmp return_tos lv_prim_vn: mov si,offset version_number mov cx,version_number_len chk_room_cnt rep movsb jmp return_tos lv_prim_cn: mov si,offset computer_name mov cx,computer_name_len chk_room_cnt rep movsb jmp return_tos lv_prim_im: call read_inverse_mark stosb jmp return_tos lv_prim_pb: call read_linecount inc ax push ax call read_linesbefore inc ax mov dx,100 mul dx pop cx div cx jmp return_number lv_prim_ms: mov cx,6*4 chk_room_cnt call get_mint_space jmp return_tos lv_prim_fc: mov ah,0 mov al,fore_color jmp return_number lv_prim_bc: mov ah,0 mov al,back_color jmp return_number lv_prim_fo: mov ah,0 mov al,fore_original jmp return_number lv_prim_bo: mov ah,0 mov al,back_original jmp return_number lv_prim_ow: call read_other_window jmp return_number lv_prim_cw: call read_current_window jmp return_number lv_prim_ts: call read_top_percent mov ah,0 jmp return_number lv_prim_bs: call read_bot_percent mov ah,0 jmp return_number lv_prim_ws: call read_showblanks inc ax jmp return_number lv_prim_bp: ;mbf call read_beep inc ax jmp return_number lv_prim_nl: call read_linecount inc ax jmp return_number lv_prim_rs: call read_newrow inc ax jmp return_number lv_prim_cs: call compute_cursor mov ax,dx inc ax jmp return_number lv_prim_lc: call read_firstcolumn inc ax jmp return_number lv_prim_tc: mov ax,tab_size inc ax jmp return_number lv_prim_tl: call read_firstline mov ah,0 inc ax jmp return_number lv_prim_bl: call read_lastline mov ah,0 inc ax jmp return_number lv_prim_mb: call read_buffer_modified mov ah,0 jmp return_number lv_prim_is: call read_ibm_cga mov ah,0 jmp return_number lv_prim_as: mov ax,auto_save_limit jmp return_number lv_prim_cl: call read_linesbefore inc ax jmp return_number sv_prim: ;store variable mov bx,offset sv_prim_table call parse_variable push bx mov cx,2 call get_decimal_arg pop bx call word ptr [bx] jmp return_null sv_prim_fc: mov fore_color,al mov ax,foreback_color call set_screen_color ret sv_prim_bc: mov back_color,al mov ax,foreback_color call set_screen_color ret sv_prim_ow: call store_other_window ret sv_prim_cw: call store_current_window ret sv_prim_ts: call store_top_percent ret sv_prim_bs: call store_bot_percent ret sv_prim_ws: call store_showblanks ;whitespace. ret sv_prim_bp: ;mbf call store_beep ret sv_prim_im: mov cx,2 call getarg_mark call store_inverse_mark ret sv_prim_cd: mov cx,2 ;get the "filename" into filename. call getarg_filename mov ax,[si] ;get the first two chars. or al,al ;do we have anything at all? je sv_prim_cd_1 ;no. cmp ah,':' ;is the second char ':'? jne sv_prim_cd_2 ;no. add si,2 ;parse past these characters. call to_lower ;convert the drive character to lowercase. sub al,'a' mov ah,0eh ;select drive mov dl,al int 21h sv_prim_cd_2: mov dx,si ;save a copy and find the first null. sv_prim_cd_3: lodsb or al,al jne sv_prim_cd_3 sub si,2 ;make si -> last char of path. cmp si,dx ;is this a one character subdir? je sv_prim_cd_4 ;yes - don't strip trailing slashes. xor al,al xchg al,[si] ;store a null there. cmp al,'\' ;was it a backslash? je sv_prim_cd_4 ;yes. cmp al,'/' ;was it a slash? je sv_prim_cd_4 ;yes. mov [si],al ;no - store the original char. sv_prim_cd_4: mov ah,3bh ;change to this directory. int 21h sv_prim_cd_1: ret sv_prim_tc: cmp ax,2 je sv_prim_tc_1 cmp ax,4 je sv_prim_tc_1 cmp ax,8 je sv_prim_tc_1 cmp ax,16 jne sv_prim_tc_2 sv_prim_tc_1: dec ax mov tab_size,ax call paint_screen sv_prim_tc_2: ret sv_prim_tl: dec ax call store_firstline ret sv_prim_bl: dec ax call store_lastline ret sv_prim_fo: sv_prim_bo: sv_prim_vn: sv_prim_cn: sv_prim_pb: sv_prim_ms: sv_prim_nl: ret sv_prim_rs: mov next_redisp_line,ax ret sv_prim_cs: call set_column ret sv_prim_lc: dec ax call store_firstcolumn ret sv_prim_mb: call store_buffer_modified ret sv_prim_is: call store_ibm_cga ret sv_prim_as: mov auto_save_limit,ax mov auto_save_cntr,ax ret sv_prim_cl: call set_line ret parse_variable: ;parse a variable letter. ;return bx -> proper entry in the table pointed to by bx on entry. ;the default is at the end of the table. call getarg1 mov ax,'l' ;defaults to line jcxz parse_variable_1 lodsb dec cx je parse_variable_1 mov ah,[si] parse_variable_1: mov di,offset variable_table mov cx,variable_count repne scasw sub cx,variable_count-1 neg cx shl cx,1 add bx,cx ret pp_prim: di_points_fbgn mov cx,11 ;make sure there's enough room. chk_room_cnt call get_pick_values push dx ;save vertical mov ax,cx mov cx,0 mov bx,10 call put_number mov al,',' stosb pop ax ;pushed as dx jmp return_number sa_prim: mov di,fend ;make di point to some free memory. add di,2 mov si,fbgn ;point si at "sa". mov si,[si] ;point si at the first arg. mov dx,0 ;count the arguments here. sa_prim_1: cmp si,[si] ;are we pointing at fend? je sa_prim_2 mov [di],si ;save a pointer to the argument. add di,2 chk_room mov si,[si] ;make it point to next arg. inc dx jmp sa_prim_1 sa_prim_2: ;dx=number of arguments. ;fend+2->argument pointers. mov bx,fend ;make bx point to some free memory. add bx,2 mov sa_jump,dx dec dx loop1: cmp sa_jump,1 ;is JUMP > 1? jbe sa_prim_4 ;no - sort complete shr sa_jump,1 ;JUMP = JUMP DIV 2 loop2: mov bp,1 ;set DONE = TRUE mov ax,dx ;get N sub ax,sa_jump ;compute N - JUMP mov sa_n_jump,ax ;store N - JUMP mov cx,0 ;for J = 1 to N - JUMP DO loop3: mov si,bx add si,cx ;make si -> a[J] add si,cx mov di,si add di,sa_jump ;offset I by JUMP add di,sa_jump push cx push si push di mov si,[si] ;get the two arguments under consideration. mov di,[di] mov ax,[si] ;compute length of this arg. sub ax,si sub ax,mark_overhead add si,mark_overhead-1 ;make si=> text of argument. mov cx,[di] ;compute length of this arg. sub cx,di sub cx,mark_overhead add di,mark_overhead-1 ;make si=> text of argument. cmp ax,cx ;if the first string is shorter, jb sa_prim_8 ; return if if they're equal. ;second string is smaller. push cx repe cmpsb ;compare the two strings pop cx pop di pop si jb sa_prim_5 ;go if they're in order already. ja sa_prim_6 ;if they're not in order, swap them. cmp ax,cx ;were the strings equal? je sa_prim_5 ;yes - don't swap them. jmp short sa_prim_6 sa_prim_8: xchg cx,ax ;first string is smaller. repe cmpsb ;compare the two strings pop di pop si jbe sa_prim_5 ;go if they're in order already. sa_prim_6: mov ax,[si] ;swap them. xchg ax,[di] mov [si],ax mov bp,0 ;set DONE = FALSE sa_prim_5: pop cx ;get the counter back. inc cx ;bump the counter cmp cx,sa_n_jump ;is cx = N - JUMP? jbe loop3 ;if cycle not complete, go again cmp bp,0 ;is DONE = FALSE je loop2 ;no, another cycle jmp loop1 ;keep going until sort is complete sa_prim_4: inc dx ;because we 'dec'ed it before. mov bx,fend ;make bx point to some free memory. add bx,2 mov di,bx ;compute the end of the table. add di,dx add di,dx push di sa_prim_7: mov si,[bx] add bx,2 mov cx,[si] ;compute length of this arg. sub cx,si sub cx,mark_overhead add si,mark_overhead-1 ;make si=> text of argument. inc cx ;include space for the comma. chk_room_cnt dec cx rep movsb mov al,',' ;comma terminate the strings. stosb dec dx ;done with all of them? jne sa_prim_7 ;no - do another. jmp return_tos bl_prim: call ring_the_bell jmp return_null ;push/pop marks pm_prim: call get_decimal_arg1 call stack_marks jc pm_prim_1 jmp return_null pm_prim_1: mov cx,2 jmp return_arg_active ;set mark (to point) sm_prim: mov cx,2 call getarg_mark mov al,'.' ;if 2nd is missing, use '.' jcxz sm_prim_1 lodsb sm_prim_1: mov ah,al ;get source mark push ax ;save source mark call getarg_mark1 pop bx ;pushed as ax mov ah,bl ;get dest mark call set_mark jmp return_null ;set point (to marks) sp_prim: mov cx,1 call getarg jcxz sp_prim_1 sp_prim_2: lodsb push si push cx call goto_mark pop cx pop si loop sp_prim_2 sp_prim_1: jmp return_null ;delete to mark dm_prim: call write_protect call getarg1 jcxz dm_prim_1 dm_prim_2: lodsb push si push cx call del_to_mark pop cx pop si loop dm_prim_2 dm_prim_1: jmp return_null ;read to mark rm_prim: call getarg_mark1 ;get mark number to read from. call read_mark ;returns es:si, cx describing string. assume ds:nothing di_points_fbgn ; chk_room_cnt mov ax,es call buffer_free ;make sure that there's that much room. jc rm_prim_1 ;if cy, there must be no room. rep movsb ;move the string. push es ;restore our ds. pop ds jmp return_tos rm_prim_1: add sp,2 ;conserve the stack. push es ;restore our ds. pop ds assume ds:data mov cx,2 jmp return_arg_active ;translate characters. tr_prim: call write_protect mov cx,2 ;translate according to arg 2. call getarg push si push cx call getarg_mark1 ;get mark number to read from. pop dx pop bx call xlat_to_mark jmp return_null ;count to mark rc_prim: call getarg_mark1 ;get mark number to read from. call read_mark ;returns ds:si, cx describing string. push es ;restore our ds. pop ds mov ax,cx di_points_fbgn jmp return_number ;spell check sc_prim: push ds xor ax,ax mov ds,ax lds si,ds:[4*82h] ;get the speller's interrupt. sub si,speller_txt_len+2 ;backup past the string and version. mov di,offset speller_txt mov cx,speller_txt_len ;see if the speller is installed. repe cmpsb pop ds mov ax,-1 ;if no speller, return -1. jne sc_prim_1 ;no speller. call getarg1_filename push si mov cx,2 call get_decimal_arg mov ah,al pop si ;get the pointer to the word. int 82h sc_prim_1: di_points_fbgn jmp return_number ;mark before point #(mb,mark,before,after) mb_prim: call getarg_mark1 call read_mark push es ;restore our ds. pop ds jc mb_prim_1 ;go if point is before mark mov cx,2 jmp return_arg mb_prim_1: mov cx,3 jmp return_arg ;look pattern. return arg 2 if bad pattern. lp_prim: mov cx,3 ;see if we should be regular or not. call getarg mov dx,cx ;remember it. mov cx,4 ;see if we should fold case or not. call getarg mov di,cx ;remember it. call getarg1 call set_pattern jc lp_prim_1 jmp return_null lp_prim_1: mov cx,2 jmp return_arg_active ;look regular. return arg 2 if bad pattern. lr_prim: call getarg1 call regexp_pat jc lr_prim_1 jmp return_null lr_prim_1: mov cx,2 jmp return_arg_active ;look for a string. return arg 5 if not found. lk_prim: call getarg_mark1 push ax mov cx,2 call getarg_mark push ax mov cx,3 call getarg_mark push ax mov cx,4 call getarg_mark mov dl,al ;set arg 4 (last) pop ax ;restore arg 3 (first) mov dh,al pop cx ;restore arg 2 (end) pushed as ax. pop ax ;restore arg 1 (start) mov ch,al call search jc lk_prim_1 jmp return_null lk_prim_1: mov cx,5 jmp return_arg_active ;look for a string. return arg 5 if found, arg 6 if not. lt_prim: call getarg_mark1 push ax mov cx,2 call getarg_mark push ax mov cx,3 call getarg_mark push ax mov cx,4 call getarg_mark mov dl,al ;set arg 4 (last) pop ax ;restore arg 3 (first) mov dh,al pop cx ;restore arg 2 (end) pushed as ax. pop ax ;restore arg 1 (start) mov ch,al call search mov cx,5 ;if we found it, return arg 5. jnc lt_prim_1 mov cx,6 ;else return arg 6. lt_prim_1: jmp return_arg ;find the first and next occurrences of a file. ff_prim: mov dx,offset filename2 mov ah,1ah int 21h call getarg1_filename mov dx,si ;remember the filename for find_first. di_points_fend mov ax,[si] cmp ah,':' ;does this filename have a drive? jne ff_prim_9 ;no. mov ax,[si+2] ;yes - skip it. ff_prim_9: cmp ax,'/' ;are they referring to root? je ff_prim_a cmp ax,'\' jne ff_prim_b ff_prim_a: mov cx,5 chk_room_cnt ff_prim_8: lodsb cmp al,'/' jne ff_prim_c mov al,'\' ff_prim_c: stosb or al,al jne ff_prim_8 dec di mov cx,2 ;copy the separator argument. call getarg chk_room_cnt rep movsb jmp return_tos ff_prim_b: mov ah,4eh ;find first matching file mov cx,10h ;find subdirs, too. ff_prim_1: int 21h ;find first or find next. jnc ff_prim_2 ;more files... jmp return_tos ff_prim_2: mov si,offset filename2.find_buf_name mov ah,0 ff_prim_3: lodsb or al,al je ff_prim_4 cmp al,'.' ;remember if we got a '.'. jne ff_prim_6 inc ah ff_prim_6: call to_lower chk_room stosb jmp ff_prim_3 ff_prim_4: test filename2.find_buf_attr,10h ;is this a subdir? je ff_prim_5 ;no. mov al,'\' ;yes- store a trailing backslash. chk_room stosb jmp short ff_prim_7 ;don't consider storing '.'. ff_prim_5: or ah,ah ;did we find a '.'? jne ff_prim_7 mov al,'.' ;no - store a trailing '.'. stosb ff_prim_7: mov cx,2 ;copy the separator argument. call getarg chk_room_cnt rep movsb mov ah,4fh ;find next. jmp ff_prim_1 to_lower: cmp al,'A' ;uppercase? jb to_lower_1 cmp al,'Z' ja to_lower_1 add al,'a'-'A' ;use uppercase. to_lower_1: ret ;rename a file. rn_prim: call getarg1_filename mov cx,2 call getarg mov di,offset filename2 rep movsb xor al,al stosb mov dx,offset filename mov di,offset filename2 mov ah,56h ;rename file int 21h jnc rn_prim_1 mov si,offset rename_error mov cx,rename_error_len jmp return_sicx rn_prim_1: jmp return_null ;delete a file. de_prim: call getarg1_filename mov dx,si mov ah,41h ;delete file int 21h jnc de_prim_1 mov al,2 mov bx,offset read_errors jmp return_string de_prim_1: jmp return_null ;read a file rf_prim: call write_protect call getarg1_filename call read_file mov bx,offset read_errors jmp return_string ;write a file. wf_prim: call getarg1_filename push si ;preserve the pointer to the filename. mov cx,2 call getarg_mark pop si call write_file mov bx,offset write_errors jmp return_string ;allocate a buffer ba_prim: call get_decimal_arg1 push ax mov cx,2 call getarg mov ax,cx pop cx ;pushed as ax. call buffer_allocate di_points_fbgn jmp return_number ;insert from a buffer ;#(bi,buffer number,mark,yes,no) bi_prim: call write_protect call get_decimal_arg1 ;get the buffer number. push ax mov cx,2 ;get the mark. call getarg_mark pop cx call buffer_insert jc bi_prim_1 ;go if we can't insert it. mov cx,3 jmp return_arg bi_prim_1: mov cx,4 jmp return_arg ao_prim: call getarg1 ;get the first argument mov dx,cx ;save size of first argument mov di,si ;save pointer to first argument mov cx,2 ;get second argument call getarg cmp cx,dx ;second shorter than first? jb ao_prim_2 ;yes - use second's length. mov cx,dx ;no - use first's length. repe cmpsb ;strings alphabetically ordered? jb ao_prim_4 ;no, return 4th. jmp short ao_prim_3 ao_prim_2: repe cmpsb ;strings alphabetically ordered? jbe ao_prim_4 ;no, return 4th. ao_prim_3: mov cx,3 jmp return_arg ao_prim_4: mov cx,4 jmp return_arg it_prim: ;check for key, timed. call check_for_key ;character waiting? jne it_prim_1 ;yes - don't turn the pick on. call auto_save call pick_on call input_timed push ax ;preserve the key value. call pick_off pop ax jmp short it_prim_2 it_prim_1: call input_timed it_prim_2: call decode_key ;no - change the key into a string. di_points_fbgn it_prim_3: lodsb or al,al je it_prim_4 chk_room stosb jmp it_prim_3 it_prim_4: jmp return_tos input_timed: call get_decimal_arg1 mov bp,ax ;save the wait time. xor ax,ax ;check the mouse buffer first. xchg ax,mouse_buffer or ax,ax jne input_timed_5 ;got one - see if we should restuff it. xor si,si ;si is the elapsed time. mov ah,2ch ;get the current hundreths. int 21h mov bl,dl input_timed_1: call check_for_key ;character waiting? jne input_timed_2 ;yes - return it. call check_pick ;pick waiting? jne input_timed_5 ;yes - return it. mov ah,2ch ;gtime int 21h mov al,dl ;subtract the new time from the old. sub al,bl mov bl,dl ;update the time in bl. cbw jns input_timed_4 ;go if it's positive. add ax,100 ;make it positive. input_timed_4: add si,ax ;add in to the current time. cmp si,bp ;time to timeout yet? jb input_timed_1 ;no. mov ax,255 ;yes - timeout. jmp short input_timed_3 input_timed_5: or bp,bp ;original wait time. jnz input_timed_3 ;if non zero wait, we're inputting it. mov mouse_buffer,ax ;store the mouse button in a buffer. jmp short input_timed_3 input_timed_2: or bp,bp ;original wait time. jz input_timed_3 ;if zero wait, we're just checking. call get_key_value input_timed_3: ret bc_prim: mov cx,2 ;get 'from' argument. call getarg mov dl,'a' ;default to ASCII jcxz bc_prim_1 mov dl,[si] ;get from type. bc_prim_1: mov cx,3 ;get 'to' argument. call getarg mov dh,'d' ;default to decimal jcxz bc_prim_2 mov dh,[si] bc_prim_2: call getarg1 call bc_prim_base ;get the source base. or bx,bx ;ASCII? jnz bc_prim_4 ;no. jcxz bc_prim_6 lodsb mov ah,0 jmp bc_prim_3 bc_prim_6: mov ax,-1 ;if ASCII, and null argument, use -1. jmp bc_prim_3 bc_prim_4: push dx ;preserve dx. call get_number pop dx bc_prim_3: ;we now have the number in ax. mov dl,dh call bc_prim_base di_points_fbgn or bx,bx jnz bc_prim_5 stosb jmp return_tos bc_prim_5: mov cx,0 ;use only as many digits as are needed. call put_number jmp return_tos ;private subroutine, used only bc_prim. bc_prim_base: ;enter with dl=base character. ;exit with bx=base if number; bx=0 if ASCII. or dl,20h ;convert UPPER case to lower case. cmp dl,'d' jne bc_prim_base_1 mov bx,10 ret bc_prim_base_1: cmp dl,'o' jne bc_prim_base_2 mov bx,8 ret bc_prim_base_2: cmp dl,'h' jne bc_prim_base_3 mov bx,16 ret bc_prim_base_3: cmp dl,'c' jne bc_prim_base_4 mov bx,0 ret bc_prim_base_4: cmp dl,'a' ;a alias character. jne bc_prim_base_5 mov bx,0 ret bc_prim_base_5: cmp dl,'b' jne bc_prim_base_6 mov bx,2 ret bc_prim_base_6: ret getarg_mark1: mov cx,1 getarg_mark: ;enter with cx=arg number. ;exit with al=mark, cx=arg size, si->arg. call getarg mov al,0 ;use null if no string specified. jcxz getarg_mark_1 mov al,[si] ;get the first character getarg_mark_1: ret public trace_result trace_result: ;enter with si->, cx=count of returning result of a primitive call. ;doesn't modify si or cx. push bx push cx push si mov bx,trace_handle or bx,bx js trace_result_3 mov al,'{' call printchar jcxz trace_result_1 trace_result_2: lodsb call printchar loop trace_result_2 trace_result_1: mov al,'}' call printchar mov al,CR call printchar mov al,LF call printchar mov ah,7 int 21h trace_result_3: pop si pop cx pop bx ret neutral_marker equ 3 public trace_invoke trace_invoke: ;enter with bx->fbgn, al=function type (active or neutral) push bx push dx push di mov di,bx mov bx,trace_handle or bx,bx js trace_result_3 cmp al,neutral_marker jne trace_invoke_1 mov al,"#" call printchar trace_invoke_1: mov al,"#" call printchar mov al,"(" call printchar trace_invoke_3: mov si,di mov di,[di] cmp si,di ;at end? je trace_invoke_2 ;yes. mov cx,di sub cx,si sub cx,mark_overhead ;remove overhead. add si,mark_overhead-1 ;skip past overhead. jcxz trace_invoke_5 trace_invoke_4: lodsb call printchar loop trace_invoke_4 trace_invoke_5: cmp di,[di] ;last argument? je trace_invoke_3 ;yes - don't print comma. mov al,"," call printchar jmp trace_invoke_3 trace_invoke_2: mov al,")" call printchar pop di pop dx pop bx trace_invoke_6: ret printchar: mov dl,al mov ah,6 int 21h ret redirect: ;enter with bx = device to redirect (0..2). ;exit with ax = new flag for this device. mov cx,bx ;get the filename. add cx,3 call getarg_filename je redirect_1 ;no filename - don't redirect. mov ah,45h ;make a copy of handle in bx int 21h ; into ax. push ax ;remember the old handle. mov ah,3eh ;close the original handle. int 21h mov ax,3d00h ;open for reading. cmp bx,0 ;redirecting from stdin? je redirect_2 mov ah,3ch ;no - we have to create it. xor cx,cx redirect_2: mov dx,si ;point to the filename. int 21h ;either open or create. jc redirect_3 ;go if we failed to open it. pop ax ;get the old handle back. ret redirect_3: mov cx,bx ;get the original handle (now closed). pop bx ;get the copy of the original handle. mov ah,46h ;copy the bx handle to cx. int 21h mov ah,3eh ;now close the copy. int 21h redirect_1: mov ax,-1 ;say that there is no file open. ret unredirect: ;enter with bx = stdxxx file number, cx = handle to restore. cmp cx,-1 je unredirect_1 mov ah,3eh ;close stdxxx file. int 21h xchg bx,cx ;force the original handle back. mov ah,46h int 21h mov ah,3eh ;close the copy. int 21h unredirect_1: ret ex_prim: mov bx,0 call redirect mov ex_stdin,ax mov bx,1 call redirect mov ex_stdout,ax mov bx,2 call redirect mov ex_stderr,ax push swap_screen_flag mov ax,ex_stdout or ax,ex_stderr cmp ax,-1 ;are we redirecting both of them? je ex_prim_1 ;no. mov swap_screen_flag,0 ;yes - don't swap screens. ex_prim_1: call getarg1_filename push si mov cx,2 call getarg pop di call execute_program pop swap_screen_flag di_points_fbgn push ax mov bx,0 mov cx,ex_stdin call unredirect mov bx,1 mov cx,ex_stdout call unredirect mov bx,2 mov cx,ex_stderr call unredirect pop ax jmp return_number extrn execute_program: near extrn get_key_value: near extrn decode_key: near extrn buffer_insert: near extrn return_arg: near extrn return_number: near extrn return_null: near extrn return_sicx: near extrn return_tos: near extrn return_arg_active: near extrn return_string: near extrn getarg1_filename: near extrn getarg_filename: near extrn getarg1: near extrn getarg: near extrn get_decimal_arg1: near extrn get_decimal_arg: near extrn get_decimal: near extrn get_number: near extrn put_number: near ;the following externs are defined in mintprim.asm extrn dflt: near extrn hl_prim: near extrn eq_prim: near extrn nc_prim: near extrn db_prim: near extrn ct_prim: near extrn st_prim: near ;forms extrn ds_prim: near extrn mp_prim: near extrn gs_prim: near extrn go_prim: near extrn gn_prim: near extrn rs_prim: near extrn fm_prim: near extrn ev_prim: near extrn ls_prim: near extrn es_prim: near extrn sl_prim: near extrn ll_prim: near extrn nb_prim: near extrn si_prim: near ;math extrn ad_prim: near extrn su_prim: near extrn ml_prim: near extrn dv_prim: near extrn md_prim: near extrn gr_prim: near extrn cc_prim: near ;mbf public ex_prim public sc_prim public rd_prim public it_prim public sa_prim public is_prim public bc_prim public sv_prim public lv_prim public pp_prim public bl_prim public sm_prim public sp_prim public dm_prim public rm_prim public rc_prim public mb_prim public lp_prim public lr_prim public lk_prim public rf_prim public wf_prim public an_prim public ow_prim public xy_prim public pm_prim public ba_prim public bi_prim public ff_prim public rn_prim public de_prim if test_prims public ts_prim public tt_prim endif code ends data segment byte public public function_name_table public function_name_length public function_address function_name_table label word db 'rd' db 'it' db '==' ;equals db 'nc' ;number of characters db 'ct' ;convert time db 'a?' ;alphabetic ordered? db 'sa' ;sort ascending ;forms db 'ds' ;define string db 'mp' ;make parameter db 'gs' ;get string db 'go' ;get one db 'gn' ;get n db 'rs' ;reset string db 'fm' ;first match db 'ev' ;read enviornment db 'ls' ;list strings db 'es' ;erase string db 'sl' ;save library db 'll' ;load library db 'n?' ;name exists? db 'si' ;string index ;math db '++' ;add db '--' ;subtract db '**' ;multiply db '//' ;divide db '%%' ;modulus db 'g?' ;numeric greater db 'cc' ;cursor: mbf db 'is' ;insert string db 'bc' ;base conversion db 'sv' ;set variable db 'lv' ;load variable db 'pp' ;pick position db 'bl' ;bell db 'sm' ;set mark db 'sp' ;set point db 'dm' ;del to mark db 'rm' ;read to mark db 'rc' ;read count db 'mb' ;mark before db 'lp' ;look pattern db 'lr' ;look regexp db 'lk' ;look db 'l?' ;look&test db 'rf' ;read file db 'wf' ;write file db 'an' ;announce db 'ow' ;overwrite db 'xy' ;gotoxy db 'pm' ;push/pop mark db 'ba' ;buffer allocate db 'bi' ;buffer insert db 'ff' ;find files db 'rn' ;rename file db 'de' ;delete file db 'st' ;syntax table db 'hl' ;halt db 'db' ;debug db 'tr' ;translate db 'ex' ;execute db 'sc' ;spell check if test_prims db 'ts' db 'tt' endif function_name_length equ ($-function_name_table)/2 dw dflt function_address label word dw rd_prim ;redisplay dw it_prim ;input timed. dw eq_prim dw nc_prim dw ct_prim dw ao_prim dw sa_prim ;forms dw ds_prim dw mp_prim dw gs_prim dw go_prim dw gn_prim dw rs_prim dw fm_prim dw ev_prim dw ls_prim dw es_prim dw sl_prim dw ll_prim dw nb_prim dw si_prim ;math dw ad_prim dw su_prim dw ml_prim dw dv_prim dw md_prim dw gr_prim dw cc_prim ;mbf dw is_prim ;insert string dw bc_prim ;base convert dw sv_prim ;set variable dw lv_prim ;load variable dw pp_prim ;pick position dw bl_prim ;bell dw sm_prim ;set mark dw sp_prim ;set point dw dm_prim ;delete to mark dw rm_prim ;read to mark dw rc_prim ;count to mark dw mb_prim ;mark before dw lp_prim ;look pattern dw lr_prim ;look regexp dw lk_prim ;look dw lt_prim ;look&test dw rf_prim ;read file dw wf_prim ;write file dw an_prim ;announce dw ow_prim ;overwrite dw xy_prim ;gotoxy dw pm_prim ;push/pop mark dw ba_prim ;buffer allocate dw bi_prim ;buffer insert dw ff_prim ;find first/next dw rn_prim ;rename file dw de_prim ;delete file dw st_prim ;set the syntax table. dw hl_prim dw db_prim dw tr_prim dw ex_prim dw sc_prim if test_prims dw ts_prim ;test dw tt_prim ;test two endif data ends end