Category : Assembly Language Source Code
Archive   : EMAC15ES.ZIP
Filename : EMACS.ASM

;History:107,1
;Wed May 03 22:12:32 1989 Use a variable for the default bell pitch.
;Wed May 03 21:10:16 1989 don't 'and' the background color with 7.
;Tue Mar 07 23:58:36 1989 add parameters to #(bl)
;Tue Mar 07 23:33:36 1989 background colors are only three bits -- and them with 7.
;Mon Jan 30 22:49:56 1989 Add support for multiple colors.
;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

color_list label byte
fore_color db 7
back_color db 0
control_color db 2
whitespc_color db 7

bell_pitch dw 2000

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 'bs' ;Bot Scroll
db 'cc' ;Control Color
db 'cd' ;Current Directory
db 'cl' ;Line Number
db 'cn' ;Computer Name
db 'cs' ;Column on Screen
db 'cw' ;Current Window
db 'bp' ;Bell Pitch
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 'wc' ;Whitespace Color
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_bs
dw lv_prim_cc
dw lv_prim_cd
dw lv_prim_cl
dw lv_prim_cn
dw lv_prim_cs
dw lv_prim_cw
dw lv_prim_bp
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_wc
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_bs
dw sv_prim_cc
dw sv_prim_cd
dw sv_prim_cl
dw sv_prim_cn
dw sv_prim_cs
dw sv_prim_cw
dw sv_prim_bp
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_wc
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_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_bp:
mov ax,bell_pitch
jmp return_number

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_cc:
mov ah,0
mov al,control_color
jmp return_number

lv_prim_wc:
mov ah,0
mov al,whitespc_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_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_bp:
mov bell_pitch,ax
ret


sv_prim_fc:
mov fore_color,al
mov si,offset color_list
call set_screen_color
ret

sv_prim_bc:
mov back_color,al
mov si,offset color_list
call set_screen_color
ret

sv_prim_cc:
mov control_color,al
mov si,offset color_list
call set_screen_color
ret


sv_prim_wc:
mov whitespc_color,al
mov si,offset color_list
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_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 get_decimal_arg1
push ax
mov cx,2
call get_decimal_arg
mov cx,ax
pop bx
or bx,bx ;Do they want the default?
jne bl_prim_1 ;no.
mov bx,bell_pitch ;yes.
bl_prim_1:
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

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 '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 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