5080 lines
84 KiB
ArmAsm
5080 lines
84 KiB
ArmAsm
[bits 16]
|
|
[org 0]
|
|
[cpu 386]
|
|
|
|
; Memory map:
|
|
; 0x500-0x8000: all list (SS)
|
|
; 0x8000-0x10000: stack (SS)
|
|
; 0x10000-0x18000: system code (CS/DS)
|
|
; 0x18000-0x20000: system data (DS)
|
|
; 0x20000-0x30000: objects (FS)
|
|
; 0x30000-0x40000: strings (GS)
|
|
; 0x40000-0x50000: environment relinking
|
|
|
|
%define ADDITIONAL_DATA (0x8000)
|
|
%define INPUT_BUFFER_SIZE (0x200)
|
|
%define INPUT_BUFFER (ADDITIONAL_DATA)
|
|
%define MAX_OPEN_FILES (8)
|
|
%define SECTOR_SIZE (0x200)
|
|
%define OPEN_FILE_BUFFER (INPUT_BUFFER + INPUT_BUFFER_SIZE)
|
|
%define SECTOR_TABLE_BUFFER (OPEN_FILE_BUFFER + SECTOR_SIZE * MAX_OPEN_FILES)
|
|
%define FS_HEADER_BUFFER (SECTOR_TABLE_BUFFER + SECTOR_SIZE)
|
|
%define TYPE_BUFFER_SIZE (0x100)
|
|
%define TYPE_BUFFER (FS_HEADER_BUFFER + SECTOR_SIZE)
|
|
%define PRIOR_INPUT_BUFFER (TYPE_BUFFER + TYPE_BUFFER_SIZE)
|
|
|
|
; Standard file open modes:
|
|
%define FILE_READ (1)
|
|
%define FILE_WRITE (2)
|
|
%define FILE_APPEND (3)
|
|
|
|
; Special file open modes:
|
|
%define FILE_RENAME (4)
|
|
%define FILE_DELETE (5)
|
|
|
|
; File flags.
|
|
%define FILE_ERROR (0x80)
|
|
|
|
; 0 position in root directory
|
|
; 2 (remaining) file size low
|
|
; 4 (remaining) file size high
|
|
; 6 offset into sector
|
|
; 8 current sector
|
|
; 10 access mode (0 if handle unused)
|
|
; 11 checksum
|
|
%define DATA_PER_OPEN_FILE (12)
|
|
%define ROOT_HANDLE ((MAX_OPEN_FILES - 1) * DATA_PER_OPEN_FILE + open_file_table)
|
|
|
|
%define SCREEN_COLOR (0x0700)
|
|
%define HIGHLIGHT_COLOR (0x1700)
|
|
%define ALT_COLOR (0x2F00)
|
|
%define ALT2_COLOR (0x3F00)
|
|
%define ALT3_COLOR (0x1F00)
|
|
%define ERROR_COLOR (0x4F00)
|
|
|
|
; If the stack pointer goes below this value then we assume it's about to overflow.
|
|
; We need a reasonable margin before the all list begins,
|
|
; since the stack is also used by the BIOS's interrupt handlers.
|
|
%macro CHECK_STACK_OVERFLOW 0
|
|
cmp sp,0x8200
|
|
jb error_stack_overflow
|
|
%endmacro
|
|
|
|
; Call the garbage collector before every object/string allocation.
|
|
; This is used to ensure that the all list is correct,
|
|
; so that only truly inaccessible objects are freed.
|
|
; %define ALWAYS_GC
|
|
|
|
; The all list is a stack of objects that shouldn't be freed.
|
|
; It grows down and uses SS, much like the actual stack.
|
|
; Its position is kept in BP, throughout all functions that need it.
|
|
; The symbol table is not kept in the all list.
|
|
%define ALL_LIST_TOP (0x8000)
|
|
%define ALL_POP(x) add bp,2*x
|
|
|
|
%macro ALL_PUSH 1
|
|
sub bp,2
|
|
cmp bp,0x500
|
|
je error_stack_overflow
|
|
mov [ss:bp],%1
|
|
%endmacro
|
|
|
|
; Each object is 4 bytes. Object 0 is nil.
|
|
; Bit 0 of the first word is used by the garbage collector.
|
|
; Bit 1 of the first word is set if the object is not a pair.
|
|
; The first word is used by pairs to store car, otherwise to store the object type.
|
|
; The second word stores object data. For pairs, this is cdr.
|
|
%define OBJ_SIZE (4)
|
|
%define TYPE_FREE (0x06)
|
|
%define TYPE_INT (0x0A)
|
|
%define TYPE_STRING (0x0E)
|
|
%define TYPE_LAMBDA (0x12)
|
|
%define TYPE_SYMBOL (0x16)
|
|
%define TYPE_BUILTIN (0x1A)
|
|
%define TYPE_NIL (0x1E)
|
|
%define TYPE_MACRO (0x22)
|
|
%define CAR(d,s) mov d,[fs:s + 0]
|
|
%define CDR(d,s) mov d,[fs:s + 2]
|
|
%define SETCAR(d,s) mov [fs:d + 0],s
|
|
%define SETCDR(d,s) mov [fs:d + 2],s
|
|
|
|
; Each string section is 8 bytes. Section 0 is used to terminate a string.
|
|
; Bit 0 of the first word is used by the garbage collector.
|
|
; Bit 1 of the first word is set if the section is unused.
|
|
; The first word indicates the identifier of the next section.
|
|
; The other words in the section store 6 ASCII characters of the string.
|
|
; If the string length is not a multiple of 6, then the last section is padded with 0s.
|
|
%define STRING_SIZE (8)
|
|
%define STRING_DATA (6)
|
|
%define STRING_NEXT(d, s) mov d,[gs:s + 0]
|
|
%define MAX_SYMBOL_LENGTH (24)
|
|
|
|
%define BUILTIN_NIL (0)
|
|
|
|
; Flags for next_argument:
|
|
%define NEXT_ARG_ANY (1 << 8) ; Match any type.
|
|
%define NEXT_ARG_QUOTE (1 << 9) ; Don't evaluate the argument.
|
|
%define NEXT_ARG_FINAL (1 << 10) ; Check this is the last argument.
|
|
%define NEXT_ARG_TAIL (1 << 11) ; Tail call evaluate. Implies _ANY and _BX; incompatible with _QUOTE and _KEEP.
|
|
%define NEXT_ARG_KEEP (1 << 12) ; Add the result to the all list.
|
|
%define NEXT_ARG_BX (1 << 13) ; Return the result in _BX. Use with _FINAL.
|
|
%define NEXT_ARG_NIL (1 << 14) ; Allow nil as well as any matched types.
|
|
|
|
start:
|
|
; Setup segment registers and the stack.
|
|
cli
|
|
xor ax,ax
|
|
mov ss,ax
|
|
mov ax,0x1000
|
|
mov ds,ax
|
|
mov ax,0x2000
|
|
mov fs,ax
|
|
mov ax,0x3000
|
|
mov gs,ax
|
|
mov sp,0
|
|
cld
|
|
sti
|
|
|
|
; Save the BIOS drive number.
|
|
mov [drive_number],dl
|
|
|
|
; Clear the screen.
|
|
call clear_screen
|
|
|
|
; Install exception handlers.
|
|
call install_exception_handlers
|
|
|
|
; Initialize IO.
|
|
call initialize_io
|
|
|
|
; Initialize the interpreter.
|
|
call initialize_interpreter
|
|
|
|
; Run the REPL.
|
|
mov word [recover],repl
|
|
call repl
|
|
|
|
cli
|
|
hlt
|
|
|
|
repl:
|
|
; Reset stack.
|
|
mov sp,0
|
|
|
|
; Allow the garbage collector to run.
|
|
mov byte [gc_ready],1
|
|
|
|
; Close any open files.
|
|
mov cx,MAX_OPEN_FILES - 1
|
|
mov si,open_file_table
|
|
.close_file_loop:
|
|
cmp byte [si + 10],0
|
|
jz .handle_unused
|
|
push si
|
|
push cx
|
|
call close_file
|
|
pop cx
|
|
pop si
|
|
.handle_unused:
|
|
add si,DATA_PER_OPEN_FILE
|
|
loop .close_file_loop
|
|
|
|
; Get user input.
|
|
mov word [print_callback],terminal_print_string
|
|
cmp byte [run_startup_command],0
|
|
je .do_startup
|
|
mov si,prompt_message
|
|
call print_string
|
|
call get_user_input
|
|
jmp .got_input
|
|
.do_startup:
|
|
mov byte [run_startup_command],1
|
|
mov cx,[startup_command_length]
|
|
mov si,startup_command
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,INPUT_BUFFER
|
|
rep movsb
|
|
mov word [print_callback],output_null
|
|
.got_input:
|
|
|
|
; Reset read information.
|
|
mov byte [next_character],0
|
|
mov word [input_line],1
|
|
mov word [input_offset],0
|
|
mov word [input_handle],0
|
|
|
|
; Set the environment.
|
|
cmp word [.environment],0
|
|
jne .environment_set
|
|
mov bx,[obj_builtins]
|
|
mov [.environment],bx
|
|
.environment_set:
|
|
|
|
; Tidy the environment.
|
|
mov bx,[.environment]
|
|
call tidy_environment
|
|
|
|
; Read and evaluate all the objects in the input buffer.
|
|
.evaluate_loop:
|
|
mov bp,ALL_LIST_TOP
|
|
mov bx,[.environment]
|
|
ALL_PUSH(bx)
|
|
call print_newline
|
|
call read_object
|
|
cmp bx,0xFFFF
|
|
je .last_object
|
|
ALL_PUSH(bx)
|
|
mov si,[.environment]
|
|
push si
|
|
mov di,sp
|
|
call evaluate_object
|
|
pop si
|
|
mov [.environment],si
|
|
or bx,bx
|
|
jz .evaluate_loop
|
|
mov cx,-100
|
|
xor dx,dx
|
|
call print_object
|
|
jmp .evaluate_loop
|
|
.last_object:
|
|
or al,al
|
|
jne error_unexpected_character
|
|
jmp repl
|
|
|
|
.environment: dw 0
|
|
|
|
get_user_input:
|
|
; Save the position where user input began.
|
|
call get_caret_position
|
|
mov [user_input_start],bx
|
|
|
|
; Reset last scancode.
|
|
mov byte [last_scancode],0
|
|
|
|
; Add entropy to RNG.
|
|
xor ah,ah
|
|
int 0x1A
|
|
add [do_builtin_random.seed],dx
|
|
add [do_builtin_random.seed],cx
|
|
|
|
xor bx,bx
|
|
|
|
.loop:
|
|
|
|
; Highlight the first unmatched brace.
|
|
push bx
|
|
call highlight_first_unmatched_brace
|
|
pop bx
|
|
|
|
; Read a character from the keyboard.
|
|
xor ax,ax
|
|
push bx
|
|
int 0x16
|
|
pop bx
|
|
cmp ah,0x48
|
|
je .up
|
|
cmp al,8
|
|
je .backspace
|
|
cmp al,13
|
|
je .done
|
|
cmp al,32
|
|
jb .loop
|
|
cmp al,127
|
|
jae .loop
|
|
|
|
; Append the character to the end of the buffer.
|
|
cmp bx,INPUT_BUFFER_SIZE - 1
|
|
je .loop
|
|
mov [INPUT_BUFFER + bx],al
|
|
inc bx
|
|
|
|
; Echo the character to the screen.
|
|
push ax
|
|
push bx
|
|
call print_character
|
|
pop bx
|
|
pop ax
|
|
|
|
jmp .loop
|
|
|
|
; Move the caret back.
|
|
.backspace:
|
|
or bx,bx
|
|
jz .loop
|
|
push bx
|
|
call print_backspace
|
|
|
|
; Clear the cell.
|
|
mov al,' '
|
|
call print_character
|
|
call print_backspace
|
|
pop bx
|
|
dec bx
|
|
jmp .loop
|
|
|
|
; Copy the prior input buffer to the current input buffer.
|
|
.up:
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,INPUT_BUFFER
|
|
mov si,PRIOR_INPUT_BUFFER
|
|
mov cx,INPUT_BUFFER_SIZE
|
|
rep movsb
|
|
|
|
; Clear the already typed text.
|
|
mov cx,bx
|
|
or cx,cx
|
|
jz .no_text_to_clear
|
|
.clear_loop:
|
|
push cx
|
|
call print_backspace
|
|
mov al,' '
|
|
call print_character
|
|
call print_backspace
|
|
pop cx
|
|
loop .clear_loop
|
|
.no_text_to_clear:
|
|
|
|
; Print the new text.
|
|
mov si,INPUT_BUFFER
|
|
call print_string
|
|
|
|
; Update bx to the length of the new input.
|
|
xor bx,bx
|
|
mov si,INPUT_BUFFER
|
|
.count_loop:
|
|
lodsb
|
|
or al,al
|
|
jz .loop
|
|
inc bx
|
|
jmp .count_loop
|
|
|
|
.done:
|
|
|
|
; Zero terminate the result.
|
|
mov byte [INPUT_BUFFER + bx],0
|
|
|
|
; Copy to the prior input buffer.
|
|
mov cx,bx
|
|
inc cx
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,PRIOR_INPUT_BUFFER
|
|
mov si,INPUT_BUFFER
|
|
rep movsb
|
|
|
|
; Remove any highlighting on an unmatched brace.
|
|
mov bx,[previously_unmatched_brace]
|
|
or bx,bx
|
|
jz .cleared_old_formatting
|
|
mov ax,0xB800
|
|
mov es,ax
|
|
mov byte [es:bx],SCREEN_COLOR >> 8
|
|
.cleared_old_formatting:
|
|
|
|
ret
|
|
|
|
; returns position in bx
|
|
; preserves cx, si, di, bp
|
|
get_caret_position:
|
|
mov ax,[caret_row]
|
|
mov dx,160
|
|
mul dx
|
|
mov bx,[caret_column]
|
|
shl bx,1
|
|
add bx,ax
|
|
ret
|
|
|
|
; bx - input buffer position
|
|
highlight_first_unmatched_brace:
|
|
mov ax,0xB800
|
|
mov es,ax
|
|
mov cx,bx
|
|
|
|
; Clear the formatting on the previously unmatched brace.
|
|
mov bx,[previously_unmatched_brace]
|
|
or bx,bx
|
|
jz .cleared_old_formatting
|
|
mov byte [es:bx],SCREEN_COLOR >> 8
|
|
.cleared_old_formatting:
|
|
|
|
; Find the first unmatched brace.
|
|
call get_caret_position
|
|
xor cx,cx
|
|
.search_loop:
|
|
sub bx,2
|
|
cmp bx,[user_input_start]
|
|
jb .at_start
|
|
mov al,[es:bx]
|
|
cmp al,')'
|
|
je .right_brace
|
|
cmp al,'('
|
|
je .left_brace
|
|
jmp .search_loop
|
|
.right_brace:
|
|
inc cx
|
|
jmp .search_loop
|
|
.left_brace:
|
|
or cx,cx
|
|
jz .found
|
|
dec cx
|
|
jmp .search_loop
|
|
|
|
; Set the formatting for the matching brace.
|
|
.found:
|
|
inc bx
|
|
mov [previously_unmatched_brace],bx
|
|
mov byte [es:bx],HIGHLIGHT_COLOR >> 8
|
|
ret
|
|
|
|
; Check if there were more closing braces than opening braces.
|
|
.at_start:
|
|
or cx,cx
|
|
jz .done
|
|
|
|
; Highlight the last unmatched closing brace.
|
|
call get_caret_position
|
|
.search_loop2:
|
|
sub bx,2
|
|
cmp bx,[user_input_start]
|
|
jb .done
|
|
mov al,[es:bx]
|
|
cmp al,')'
|
|
jne .search_loop2
|
|
inc bx
|
|
mov [previously_unmatched_brace],bx
|
|
mov byte [es:bx],ERROR_COLOR >> 8
|
|
ret
|
|
|
|
; All braces were matched.
|
|
.done:
|
|
xor bx,bx
|
|
mov [previously_unmatched_brace],bx
|
|
ret
|
|
|
|
initialize_interpreter:
|
|
; The first object and string are reserved to indicate nil.
|
|
mov ax,1
|
|
mov word [first_free_string],STRING_SIZE
|
|
mov word [first_free_object],OBJ_SIZE
|
|
|
|
; Create a list of free strings.
|
|
mov cx,(65536 / STRING_SIZE - 1)
|
|
mov bx,STRING_SIZE
|
|
mov ax,(STRING_SIZE * 2 + 2)
|
|
.free_string_loop:
|
|
mov [gs:bx],ax
|
|
add bx,STRING_SIZE
|
|
add ax,STRING_SIZE
|
|
loop .free_string_loop
|
|
|
|
; Create a list of free objects.
|
|
mov cx,(65536 / OBJ_SIZE - 1)
|
|
mov bx,OBJ_SIZE
|
|
mov ax,(OBJ_SIZE * 2)
|
|
mov dx,TYPE_FREE
|
|
.free_obj_loop:
|
|
SETCAR(bx, dx)
|
|
SETCDR(bx, ax)
|
|
add bx,OBJ_SIZE
|
|
add ax,OBJ_SIZE
|
|
loop .free_obj_loop
|
|
|
|
; Initial the nil object and string.
|
|
mov word [gs:0],0
|
|
mov word [gs:2],0
|
|
mov word [gs:4],0
|
|
mov word [gs:6],0
|
|
mov word [fs:0],TYPE_NIL
|
|
mov word [fs:2],0
|
|
|
|
; Start the symbol table and builtins as the nil object.
|
|
mov word [obj_symbol_table],0
|
|
mov word [obj_builtins],0
|
|
|
|
; Add builtins.
|
|
call add_builtins
|
|
|
|
ret
|
|
|
|
add_builtins:
|
|
mov si,builtin_strings
|
|
mov dx,0
|
|
.builtin_loop:
|
|
|
|
; Check if we're done.
|
|
mov al,[si]
|
|
or al,al
|
|
jz .done
|
|
|
|
push si
|
|
push dx
|
|
|
|
xor bx,bx
|
|
cmp dx,BUILTIN_NIL
|
|
je .made_object
|
|
|
|
; Make the builtin object itself.
|
|
mov ax,TYPE_BUILTIN
|
|
call new_object
|
|
.made_object:
|
|
|
|
; Get the symbol object.
|
|
push bx
|
|
mov bp,ALL_LIST_TOP
|
|
call find_symbol
|
|
|
|
; Create the pair of symbol-builtin.
|
|
mov ax,bx
|
|
pop dx
|
|
call new_object
|
|
|
|
; Create the list object.
|
|
mov ax,bx
|
|
mov dx,[obj_builtins]
|
|
call new_object
|
|
mov [obj_builtins],bx
|
|
|
|
; Advance to the next builtin.
|
|
pop dx
|
|
pop si
|
|
inc dx
|
|
.string_end_loop:
|
|
lodsb
|
|
or al,al
|
|
jne .string_end_loop
|
|
jmp .builtin_loop
|
|
|
|
.done:
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; returns object in bx (bx != 0xFFFF), or character in al (bx = 0xFFFF)
|
|
read_object:
|
|
CHECK_STACK_OVERFLOW
|
|
|
|
; Read a non-whitespace character.
|
|
.try_again:
|
|
call read_next_character
|
|
cmp al,10
|
|
je .try_again
|
|
cmp al,13
|
|
je .try_again
|
|
cmp al,9
|
|
je .try_again
|
|
cmp al,' '
|
|
je .try_again
|
|
|
|
; End of input?
|
|
mov bx,0xFFFF
|
|
or al,al
|
|
je .done
|
|
|
|
; Check for a comment.
|
|
cmp al,';'
|
|
jne .not_comment
|
|
.comment_loop:
|
|
call read_next_character
|
|
or al,al
|
|
jz read_object
|
|
cmp al,10
|
|
je read_object
|
|
jmp .comment_loop
|
|
.not_comment:
|
|
|
|
; Check for single-character tokens, ']' and '.'.
|
|
mov bx,0xFFFF
|
|
cmp al,')'
|
|
je .done
|
|
cmp al,'.'
|
|
je .done
|
|
|
|
; Check for string.
|
|
cmp al,'"'
|
|
je read_string_object
|
|
|
|
; Check for list.
|
|
cmp al,'('
|
|
je read_list_object
|
|
|
|
; It must be either a symbol or integer.
|
|
jmp read_symbol_object
|
|
|
|
.done:
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
read_string_object:
|
|
; Create the object.
|
|
mov ax,TYPE_STRING
|
|
xor dx,dx ; new_string could gc, so this should be valid
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
|
|
; Create the first string section.
|
|
push bx
|
|
call new_string
|
|
pop di
|
|
SETCDR(di,bx)
|
|
push di
|
|
|
|
; Read characters until the string is closed.
|
|
.add_loop:
|
|
call read_next_character
|
|
or al,al
|
|
jz error_unexpected_eoi
|
|
cmp al,'"'
|
|
je .done
|
|
|
|
; Handle escape codes.
|
|
cmp al,'\'
|
|
jne .append
|
|
call read_next_character
|
|
cmp al,'n'
|
|
jne .e1
|
|
mov al,10
|
|
.e1:
|
|
|
|
; Append the character.
|
|
.append:
|
|
call string_append_character
|
|
jmp .add_loop
|
|
|
|
.done:
|
|
pop bx
|
|
ALL_POP(1)
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; al - first character of symbol
|
|
read_symbol_object:
|
|
xor bx,bx
|
|
|
|
; Read characters into the buffer.
|
|
.loop:
|
|
cmp al,'('
|
|
je .end_symbol
|
|
cmp al,')'
|
|
je .end_symbol
|
|
cmp al,';'
|
|
je .end_symbol
|
|
cmp al,'.'
|
|
je .end_symbol
|
|
cmp al,'"'
|
|
je .end_symbol
|
|
cmp al,' '
|
|
je .end_symbol
|
|
cmp al,9
|
|
je .end_symbol
|
|
cmp al,10
|
|
je .end_symbol
|
|
or al,al
|
|
jz .end_symbol
|
|
|
|
; Store the characer, and read the next one.
|
|
cmp bx,MAX_SYMBOL_LENGTH
|
|
je error_symbol_too_long
|
|
mov [.buffer + bx],al
|
|
inc bx
|
|
call read_next_character
|
|
jmp .loop
|
|
.end_symbol:
|
|
mov byte [.buffer + bx],0
|
|
mov [next_character],al
|
|
|
|
; Try to parse the symbol as an integer.
|
|
mov si,.buffer
|
|
call read_integer_object
|
|
jc .done
|
|
|
|
; Find the symbol.
|
|
mov si,.buffer
|
|
call find_symbol
|
|
|
|
; Create the object.
|
|
mov ax,TYPE_SYMBOL
|
|
mov dx,bx
|
|
call new_object
|
|
|
|
.done: ret
|
|
.buffer: times (MAX_SYMBOL_LENGTH + 1) db 0
|
|
|
|
; bp - all list (preserved)
|
|
; si - buffer containing string
|
|
; returns object in bx, carry clear if not an integer
|
|
read_integer_object:
|
|
; Is it negative?
|
|
mov dx,32767
|
|
mov al,[si]
|
|
cmp al,'-'
|
|
jne .positive
|
|
mov dx,32768
|
|
inc si
|
|
mov al,[si]
|
|
.positive:
|
|
|
|
; Is it an empty string?
|
|
or al,al
|
|
jz .not_integer
|
|
|
|
; Iterate through each digit
|
|
xor cx,cx
|
|
.digit_loop:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
cmp al,'0'
|
|
jb .not_integer
|
|
cmp al,'9'
|
|
ja .not_integer
|
|
|
|
; Check for overflow.
|
|
cmp cx,3276
|
|
ja error_integer_too_large
|
|
|
|
; Multiply by 10.
|
|
push ax
|
|
push dx
|
|
mov ax,cx
|
|
mov bx,10
|
|
mul bx
|
|
mov cx,ax
|
|
pop dx
|
|
pop ax
|
|
|
|
; Check for overflow.
|
|
mov bx,dx
|
|
xor ah,ah
|
|
sub bx,ax
|
|
add bx,'0'
|
|
cmp cx,bx
|
|
ja error_integer_too_large
|
|
|
|
; Add the digit.
|
|
add cx,ax
|
|
sub cx,'0'
|
|
jmp .digit_loop
|
|
|
|
; Negate the final result.
|
|
.done:
|
|
cmp dx,32768
|
|
jne .negated
|
|
neg cx
|
|
.negated:
|
|
|
|
; Create the object.
|
|
mov dx,cx
|
|
mov ax,TYPE_INT
|
|
call new_object
|
|
stc
|
|
ret
|
|
|
|
.not_integer:
|
|
clc
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
read_list_object:
|
|
sub sp,8
|
|
mov di,sp
|
|
mov [ss:di+0],bp ; all
|
|
mov byte [ss:di+2],1 ; first
|
|
mov word [ss:di+4],0 ; result
|
|
mov word [ss:di+6],0 ; tail
|
|
|
|
; Loop until the list is closed.
|
|
.loop:
|
|
mov bp,[ss:di+0]
|
|
mov bx,[ss:di+4]
|
|
ALL_PUSH(bx)
|
|
call read_object
|
|
mov di,sp
|
|
|
|
; Check for end of list and dotted lists.
|
|
cmp bx,0xFFFF
|
|
jne .next_item
|
|
or al,al
|
|
jz error_unexpected_eoi
|
|
cmp al,')'
|
|
je .done
|
|
cmp al,'.'
|
|
je .dotted
|
|
jmp error_unknown
|
|
|
|
; Save the item.
|
|
.next_item:
|
|
ALL_PUSH(bx)
|
|
|
|
; Is this the first item in the list?
|
|
cmp byte [ss:di+2],1
|
|
jne .not_first
|
|
|
|
; Create the pair and set it as the tail.
|
|
mov byte [ss:di+2],0
|
|
mov ax,bx
|
|
xor dx,dx
|
|
call new_object
|
|
mov di,sp
|
|
mov [ss:di+4],bx
|
|
mov [ss:di+6],bx
|
|
jmp .loop
|
|
|
|
; Create the pair and add it to the tail.
|
|
.not_first:
|
|
mov ax,bx
|
|
xor dx,dx
|
|
call new_object
|
|
mov di,sp
|
|
mov si,[ss:di+6]
|
|
SETCDR(si, bx)
|
|
mov [ss:di+6],bx
|
|
jmp .loop
|
|
|
|
; Restore context and return.
|
|
.done:
|
|
mov bp,[ss:di+0]
|
|
mov bx,[ss:di+4]
|
|
add sp,8
|
|
ret
|
|
|
|
; Dotted list.
|
|
.dotted:
|
|
cmp byte [ss:di+2],1
|
|
je error_invalid_dot
|
|
|
|
; Read the final item.
|
|
call read_object
|
|
mov di,sp
|
|
cmp bx,0xFFFF
|
|
je error_invalid_dot
|
|
mov si,[ss:di+6]
|
|
SETCDR(si, bx)
|
|
|
|
; Read the closing brace.
|
|
call read_object
|
|
cmp bx,0xFFFF
|
|
jne error_invalid_dot
|
|
cmp al,')'
|
|
jne error_invalid_dot
|
|
jmp .done
|
|
|
|
; returns next character in al
|
|
; overwrites si only
|
|
read_next_character:
|
|
mov al,[next_character]
|
|
mov byte [next_character],0
|
|
or al,al
|
|
jnz .return
|
|
|
|
cmp word [input_handle],0
|
|
je .from_input_buffer
|
|
jmp .from_file
|
|
|
|
.process:
|
|
cmp al,10
|
|
jne .return
|
|
inc word [input_line]
|
|
.return: ret
|
|
|
|
.from_input_buffer:
|
|
mov si,[input_offset]
|
|
mov al,[si + INPUT_BUFFER]
|
|
or al,al
|
|
jz .process
|
|
inc si
|
|
mov [input_offset],si
|
|
jmp .process
|
|
|
|
.from_file:
|
|
pusha
|
|
mov si,[input_handle]
|
|
mov cx,1
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,.destination
|
|
call read_file
|
|
call has_error_file
|
|
jc error_read_file
|
|
or cx,cx
|
|
jnz .e1
|
|
mov byte [.destination],0
|
|
.e1:
|
|
popa
|
|
mov al,[.destination]
|
|
jmp .process
|
|
.destination: db 1
|
|
|
|
; bp - all list
|
|
; si - environment
|
|
; bx - object
|
|
; di - stack address to write updated enviornment, else 0
|
|
; evaluated object returned in bx
|
|
; no registers preserved
|
|
evaluate_object:
|
|
CHECK_STACK_OVERFLOW
|
|
|
|
; Keep our environment.
|
|
ALL_PUSH(si)
|
|
|
|
; Check for Ctrl+C.
|
|
inc byte [check_break]
|
|
jnz .no_break
|
|
mov ah,1
|
|
int 0x16
|
|
jz .no_break
|
|
cmp ah,0x2E
|
|
jne .remove_key
|
|
mov ah,2
|
|
int 0x16
|
|
test al,(1 << 2)
|
|
jnz error_break
|
|
.remove_key:
|
|
mov [last_scancode],ah
|
|
xor ah,ah
|
|
int 0x16
|
|
.no_break:
|
|
|
|
; Is the object a list?
|
|
CAR(ax, bx)
|
|
test ax,2
|
|
jz .list
|
|
|
|
; Is the object a symbol?
|
|
cmp ax,TYPE_SYMBOL
|
|
je .symbol
|
|
|
|
; Otherwise, the object evalutes to itself.
|
|
cmp ax,TYPE_FREE
|
|
je error_free_accessible
|
|
ret
|
|
|
|
; Lookup the value of the symbol in the environment.
|
|
.symbol:
|
|
CDR(bx, bx)
|
|
call lookup_symbol
|
|
CDR(bx, bx)
|
|
ret
|
|
|
|
; Evaluate the function.
|
|
.list:
|
|
push bx
|
|
push bp
|
|
push si
|
|
push di
|
|
xor di,di
|
|
CAR(bx, bx)
|
|
call evaluate_object
|
|
pop di
|
|
pop si
|
|
pop bp
|
|
ALL_PUSH(bx)
|
|
|
|
; Is the function a builtin?
|
|
CAR(ax, bx)
|
|
cmp ax,TYPE_BUILTIN
|
|
je .builtin
|
|
|
|
; Is the function a lambda or macro?
|
|
cmp ax,TYPE_LAMBDA
|
|
je evaluate_lambda
|
|
cmp ax,TYPE_MACRO
|
|
je evaluate_macro
|
|
|
|
; Otherwise, the function object is not callable.
|
|
jmp error_not_callable
|
|
|
|
; Get the builtin ID and the start of the arguments list.
|
|
.builtin:
|
|
CDR(ax, bx)
|
|
pop bx
|
|
CDR(bx, bx)
|
|
|
|
; Call the builtin.
|
|
push di
|
|
mov di,ax
|
|
shl di,1
|
|
mov ax,[di + builtin_functions]
|
|
or ax,ax
|
|
jz error_unimplemented_builtin
|
|
pop di
|
|
jmp ax
|
|
|
|
%macro EVALUATE_LAMBDA_COMMON 1
|
|
; Extract information about the lambda.
|
|
CDR(bx, bx)
|
|
CDR(di, bx) ; di = new environment
|
|
CAR(bx, bx)
|
|
CDR(ax, bx)
|
|
CAR(dx, bx) ; dx = symbols
|
|
pop bx
|
|
push ax ; function body
|
|
CDR(bx, bx) ; bx = arguments
|
|
|
|
; For each argument...
|
|
.argument_loop:
|
|
or dx,dx
|
|
jz .environment_ready
|
|
ALL_PUSH(di)
|
|
mov cx,%1
|
|
call next_argument
|
|
|
|
; Add it to the new environment.
|
|
push bx
|
|
push di
|
|
push dx
|
|
mov di,dx
|
|
CAR(di, di)
|
|
CDR(ax, di)
|
|
mov dx,cx
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
pop dx
|
|
mov di,dx
|
|
CDR(dx, di)
|
|
pop di
|
|
push dx
|
|
mov ax,bx
|
|
mov dx,di
|
|
call new_object
|
|
mov di,bx
|
|
pop dx
|
|
pop bx
|
|
|
|
ALL_POP(3)
|
|
jmp .argument_loop
|
|
|
|
; Check we used all the arguments.
|
|
.environment_ready:
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
%endmacro
|
|
|
|
evaluate_lambda:
|
|
EVALUATE_LAMBDA_COMMON NEXT_ARG_ANY | NEXT_ARG_KEEP
|
|
|
|
; Call the function body.
|
|
mov si,di
|
|
pop bx
|
|
jmp do_builtin_do
|
|
|
|
evaluate_macro:
|
|
pop ax
|
|
push di ; old environment pointer
|
|
push si ; old environment
|
|
push bp ; all list
|
|
|
|
; Construct the new environment.
|
|
push ax
|
|
EVALUATE_LAMBDA_COMMON NEXT_ARG_ANY | NEXT_ARG_KEEP | NEXT_ARG_QUOTE
|
|
|
|
; Evaluate the arguments passed to the macro using the new environment.
|
|
mov si,di
|
|
ALL_PUSH(si)
|
|
pop bx
|
|
call do_builtin_list
|
|
|
|
; Evaluate the result using the old environment.
|
|
pop bp
|
|
pop si
|
|
pop di
|
|
ALL_PUSH(bx)
|
|
.loop:
|
|
or bx,bx
|
|
jz .done
|
|
mov cx,NEXT_ARG_QUOTE | NEXT_ARG_ANY
|
|
call next_argument
|
|
push bx
|
|
push di
|
|
push bp
|
|
push si
|
|
or di,di
|
|
jz .no_di
|
|
mov si,[ss:di]
|
|
.no_di:
|
|
mov bx,cx
|
|
call evaluate_object
|
|
pop si
|
|
pop bp
|
|
pop di
|
|
pop bx
|
|
jmp .loop
|
|
.done:
|
|
ret
|
|
|
|
do_builtin_add:
|
|
xor dx,dx
|
|
.loop:
|
|
or bx,bx
|
|
jz .done
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(cx, di)
|
|
add dx,cx
|
|
jmp .loop
|
|
.done:
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
do_builtin_subtract:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(dx, di)
|
|
or bx,bx
|
|
jz .negate
|
|
.loop:
|
|
or bx,bx
|
|
jz .done
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(cx, di)
|
|
sub dx,cx
|
|
jmp .loop
|
|
.negate:
|
|
neg dx
|
|
.done:
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
%macro MULDIV_START 0
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
.loop:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(cx, di)
|
|
%endmacro
|
|
|
|
%macro MULDIV_END 0
|
|
or bx,bx
|
|
jnz .loop
|
|
.done:
|
|
mov dx,ax
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
%endmacro
|
|
|
|
do_builtin_multiply:
|
|
MULDIV_START
|
|
imul cx
|
|
MULDIV_END
|
|
|
|
do_builtin_divide:
|
|
MULDIV_START
|
|
cwd
|
|
idiv cx
|
|
MULDIV_END
|
|
|
|
do_builtin_modulo:
|
|
MULDIV_START
|
|
xor dx,dx
|
|
div cx
|
|
mov ax,dx
|
|
MULDIV_END
|
|
|
|
do_builtin_muldiv:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(cx, di)
|
|
imul cx
|
|
mov cx,TYPE_INT | NEXT_ARG_FINAL
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(cx, di)
|
|
idiv cx
|
|
mov dx,ax
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
do_builtin_quote:
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_QUOTE | NEXT_ARG_ANY | NEXT_ARG_BX
|
|
jmp next_argument
|
|
|
|
do_builtin_car:
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CAR(bx, bx)
|
|
ret
|
|
|
|
do_builtin_cdr:
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(bx, bx)
|
|
ret
|
|
|
|
do_builtin_setcar:
|
|
mov cx,NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov di,cx
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
SETCAR(di, cx)
|
|
mov bx,di
|
|
ret
|
|
|
|
do_builtin_setcdr:
|
|
mov cx,NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov di,cx
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
SETCDR(di, cx)
|
|
mov bx,di
|
|
ret
|
|
|
|
do_builtin_cons:
|
|
mov cx,NEXT_ARG_KEEP | NEXT_ARG_ANY
|
|
call next_argument
|
|
mov ax,cx
|
|
mov cx,NEXT_ARG_KEEP | NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
mov dx,cx
|
|
jmp new_object
|
|
|
|
new_true:
|
|
mov ax,TYPE_INT
|
|
mov dx,1
|
|
jmp new_object
|
|
|
|
%macro COMPARE_COMMON 1
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
mov cx,TYPE_INT | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(bx, bx)
|
|
cmp ax,bx
|
|
%1 new_true
|
|
xor bx,bx
|
|
ret
|
|
%endmacro
|
|
|
|
do_builtin_lt: COMPARE_COMMON jl
|
|
do_builtin_lte: COMPARE_COMMON jle
|
|
do_builtin_gt: COMPARE_COMMON jg
|
|
do_builtin_gte: COMPARE_COMMON jge
|
|
|
|
do_builtin_not:
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
or bx,bx
|
|
jz new_true
|
|
xor bx,bx
|
|
ret
|
|
|
|
%macro PRINT_COMMON 0
|
|
.loop:
|
|
or bx,bx
|
|
jz .done
|
|
mov cx,NEXT_ARG_ANY
|
|
call next_argument
|
|
pusha
|
|
mov bx,cx
|
|
mov cx,-100
|
|
mov dx,1
|
|
ALL_PUSH(bx)
|
|
call print_object
|
|
popa
|
|
jmp .loop
|
|
.done:
|
|
%endmacro
|
|
|
|
do_builtin_print:
|
|
PRINT_COMMON
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_print_colored:
|
|
push word [output_color]
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
and ax,15
|
|
mov [output_color],ax
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
and ax,15
|
|
shl ax,4
|
|
or [output_color],ax
|
|
PRINT_COMMON
|
|
xor bx,bx
|
|
pop word [output_color]
|
|
ret
|
|
|
|
do_builtin_print_substr:
|
|
; Get the starting index, the length to print, and the string itself.
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
push ax
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
or ax,ax
|
|
jz .out_of_bounds_seek
|
|
push ax
|
|
mov cx,TYPE_STRING | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
ALL_PUSH(bx)
|
|
CDR(bx, bx)
|
|
pop ax
|
|
pop cx
|
|
push ax
|
|
|
|
; Seek to the start of the substring.
|
|
.seek:
|
|
or bx,bx
|
|
jz .out_of_bounds_seek
|
|
cmp cx,6
|
|
jb .in_section
|
|
STRING_NEXT(bx, bx)
|
|
sub cx,6
|
|
jmp .seek
|
|
.in_section:
|
|
add bx,2
|
|
.loop2:
|
|
or cx,cx
|
|
jz .seek_done
|
|
mov al,[gs:bx]
|
|
or al,al
|
|
jz .out_of_bounds_seek
|
|
inc bx
|
|
dec cx
|
|
jmp .loop2
|
|
.seek_done:
|
|
|
|
; Print this section.
|
|
pop cx
|
|
.first_section:
|
|
test bx,7
|
|
jz .first_done
|
|
mov al,[gs:bx]
|
|
or al,al
|
|
jz .done
|
|
call print_character
|
|
inc bx
|
|
loop .first_section
|
|
jmp .done
|
|
.first_done:
|
|
|
|
; Go to the first middle section.
|
|
sub bx,8
|
|
STRING_NEXT(bx, bx)
|
|
|
|
; Print out full sections.
|
|
.middle_section:
|
|
or bx,bx
|
|
jz .done
|
|
cmp cx,6
|
|
jl .last_section
|
|
mov si,print_string_list.buffer
|
|
mov al,[gs:bx+2]
|
|
mov [si+0],al
|
|
mov al,[gs:bx+3]
|
|
mov [si+1],al
|
|
mov al,[gs:bx+4]
|
|
mov [si+2],al
|
|
mov al,[gs:bx+5]
|
|
mov [si+3],al
|
|
mov al,[gs:bx+6]
|
|
mov [si+4],al
|
|
mov al,[gs:bx+7]
|
|
mov [si+5],al
|
|
call print_string
|
|
STRING_NEXT(bx, bx)
|
|
sub cx,6
|
|
jmp .middle_section
|
|
or cx,cx
|
|
jz .done
|
|
|
|
; Print out the last section.
|
|
.last_section:
|
|
add bx,2
|
|
.last_loop:
|
|
mov al,[gs:bx]
|
|
or al,al
|
|
jz .done
|
|
call print_character
|
|
inc bx
|
|
loop .last_loop
|
|
|
|
.done:
|
|
xor bx,bx
|
|
ret
|
|
|
|
.out_of_bounds_seek:
|
|
pop ax
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_poke:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(di, di)
|
|
mov cx,TYPE_INT | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(cx, bx)
|
|
shl ax,12
|
|
mov es,ax
|
|
mov [es:di],cl
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_peek:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(di, di)
|
|
shl ax,12
|
|
mov es,ax
|
|
xor dh,dh
|
|
mov dl,[es:di]
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
do_builtin_atom:
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CAR(ax, bx)
|
|
test ax,2
|
|
jnz new_true
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_is:
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov di,cx
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
cmp di,bx
|
|
je new_true ; same IDs
|
|
CAR(ax, di)
|
|
CAR(cx, bx)
|
|
cmp ax,cx
|
|
jne .false ; different types
|
|
CDR(di, di)
|
|
CDR(bx, bx)
|
|
cmp ax,TYPE_INT
|
|
je .compare_cdr
|
|
cmp ax,TYPE_SYMBOL
|
|
je .compare_cdr
|
|
cmp ax,TYPE_STRING
|
|
je .compare_strings
|
|
.false:
|
|
xor bx,bx
|
|
ret
|
|
.compare_cdr:
|
|
cmp bx,di
|
|
je new_true ; same int/symbol
|
|
xor bx,bx
|
|
ret
|
|
.compare_strings:
|
|
call string_compare
|
|
jc new_true
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_and:
|
|
or bx,bx
|
|
jz new_true
|
|
mov cx,NEXT_ARG_ANY
|
|
call next_argument
|
|
or cx,cx
|
|
jnz do_builtin_and
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_or:
|
|
or bx,bx
|
|
jnz .test
|
|
xor bx,bx
|
|
ret
|
|
.test:
|
|
mov cx,NEXT_ARG_ANY
|
|
call next_argument
|
|
or cx,cx
|
|
jz do_builtin_or
|
|
jmp new_true
|
|
|
|
do_builtin_if:
|
|
CDR(cx, bx)
|
|
or cx,cx
|
|
jz error_insufficient_arguments
|
|
.loop:
|
|
CDR(cx, bx)
|
|
or cx,cx
|
|
jz .true ; final else
|
|
mov cx,NEXT_ARG_ANY
|
|
call next_argument
|
|
or cx,cx
|
|
jnz .true
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_QUOTE
|
|
call next_argument
|
|
jmp .loop ; false case
|
|
.true:
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_BX | NEXT_ARG_TAIL
|
|
jmp next_argument ; true case
|
|
|
|
%macro LAMBDA_COMMON 1
|
|
mov ax,bx
|
|
mov cx,NEXT_ARG_NIL | NEXT_ARG_QUOTE
|
|
call next_argument
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_QUOTE
|
|
call next_argument
|
|
mov dx,si
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
mov ax,%1
|
|
mov dx,bx
|
|
jmp new_object
|
|
%endmacro
|
|
|
|
do_builtin_lambda:
|
|
LAMBDA_COMMON TYPE_LAMBDA
|
|
do_builtin_macro:
|
|
LAMBDA_COMMON TYPE_MACRO
|
|
|
|
do_builtin_list:
|
|
; Check for an empty list.
|
|
or bx,bx
|
|
jnz .non_empty
|
|
ret
|
|
|
|
; Create the head of the list.
|
|
.non_empty:
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov ax,cx
|
|
xor dx,dx
|
|
push bx
|
|
call new_object
|
|
mov di,bx ; di = tail
|
|
pop bx
|
|
push di ; result on stack
|
|
ALL_POP(1)
|
|
ALL_PUSH(di)
|
|
|
|
; Loop through the rest of the items in the list.
|
|
.loop:
|
|
or bx,bx
|
|
jz .end
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_KEEP
|
|
call next_argument
|
|
|
|
; Add it to the tail.
|
|
mov ax,cx
|
|
xor dx,dx
|
|
push bx
|
|
push di
|
|
call new_object
|
|
pop di
|
|
SETCDR(di, bx)
|
|
mov di,bx
|
|
pop bx
|
|
ALL_POP(1)
|
|
jmp .loop
|
|
|
|
; Return the head of the list.
|
|
.end:
|
|
pop bx
|
|
ret
|
|
|
|
do_builtin_do:
|
|
mov cx,NEXT_ARG_QUOTE | NEXT_ARG_ANY
|
|
call next_argument
|
|
or bx,bx
|
|
jz .last_argument
|
|
push bx
|
|
push si
|
|
mov di,sp
|
|
push bp
|
|
mov bx,cx
|
|
ALL_PUSH(si)
|
|
call evaluate_object
|
|
pop bp
|
|
pop si
|
|
pop bx
|
|
jmp do_builtin_do
|
|
.last_argument:
|
|
xor di,di
|
|
mov bx,cx
|
|
ALL_POP(2) ; function and environment
|
|
jmp evaluate_object
|
|
|
|
do_builtin_let:
|
|
or di,di
|
|
jz error_cannot_let
|
|
push di
|
|
mov cx,TYPE_SYMBOL | NEXT_ARG_QUOTE | NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(ax, di)
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL | NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov dx,cx
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
mov ax,bx
|
|
mov dx,si
|
|
call new_object
|
|
pop di
|
|
mov [ss:di],bx
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_set:
|
|
mov cx,TYPE_SYMBOL | NEXT_ARG_QUOTE | NEXT_ARG_KEEP
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(di, di)
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL
|
|
call next_argument
|
|
mov bx,di
|
|
call lookup_symbol
|
|
SETCDR(bx, cx)
|
|
mov bx,cx
|
|
ret
|
|
|
|
do_builtin_while:
|
|
mov di,bx
|
|
.loop:
|
|
mov cx,NEXT_ARG_ANY
|
|
call next_argument
|
|
or cx,cx
|
|
jz .done
|
|
mov cx,NEXT_ARG_ANY | NEXT_ARG_FINAL
|
|
call next_argument
|
|
mov bx,di
|
|
jmp .loop
|
|
.done:
|
|
xor bx,bx
|
|
ret
|
|
|
|
; cx - additional flags to pass to next_argument
|
|
; preserves bp, si
|
|
next_filename_argument:
|
|
or cx,TYPE_STRING
|
|
call next_argument
|
|
push bx
|
|
push si
|
|
mov bx,cx
|
|
CDR(bx, bx)
|
|
mov di,.name
|
|
mov cx,16
|
|
call string_flatten
|
|
jc error_file_name_too_long
|
|
pop si
|
|
pop bx
|
|
ret
|
|
.name: times 16 db 0
|
|
|
|
do_builtin_src:
|
|
; We need to be in a environment-updating context to use src.
|
|
or di,di
|
|
jz error_cannot_src
|
|
|
|
push di
|
|
push si
|
|
push bp
|
|
|
|
; Get the name of the file to source.
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
|
|
; Open a handle to the file.
|
|
mov dx,FILE_READ
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
mov dx,si
|
|
|
|
pop bp
|
|
pop si
|
|
|
|
; Save the previous input context.
|
|
mov al,[next_character]
|
|
push ax
|
|
mov ax,[input_line]
|
|
push ax
|
|
mov ax,[input_offset]
|
|
push ax
|
|
mov ax,[input_handle]
|
|
push ax
|
|
|
|
; Set the new input context.
|
|
mov byte [next_character],0
|
|
mov word [input_line],1
|
|
mov word [input_offset],0
|
|
mov [input_handle],dx
|
|
|
|
push bp
|
|
|
|
.evaluate_loop:
|
|
|
|
; Reset the all list and push the environment.
|
|
pop bp
|
|
push bp
|
|
ALL_PUSH(si)
|
|
push si
|
|
|
|
; Read the object and put it on the all list.
|
|
call read_object
|
|
cmp bx,0xFFFF
|
|
je .last_object
|
|
ALL_PUSH(bx)
|
|
|
|
; Evaluate the object.
|
|
pop si
|
|
push si
|
|
mov di,sp
|
|
call evaluate_object
|
|
pop si
|
|
|
|
jmp .evaluate_loop
|
|
|
|
; Check for stray tokens.
|
|
.last_object:
|
|
or al,al
|
|
jne error_unexpected_character
|
|
|
|
; Close file handle.
|
|
push si
|
|
mov si,[input_handle]
|
|
call close_file
|
|
pop si
|
|
|
|
add sp,4
|
|
|
|
; Restore the previous input context.
|
|
pop ax
|
|
mov [input_handle],ax
|
|
pop ax
|
|
mov [input_offset],ax
|
|
pop ax
|
|
mov [input_line],ax
|
|
pop ax
|
|
mov [next_character],al
|
|
|
|
; Save the environment.
|
|
pop di
|
|
mov [ss:di],si
|
|
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_read:
|
|
; Get the name of the file to type.
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
|
|
; Open a handle to the file.
|
|
mov dx,FILE_READ
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
|
|
; Read the file and print until done.
|
|
.loop:
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,TYPE_BUFFER_SIZE - 1
|
|
mov di,TYPE_BUFFER
|
|
call read_file
|
|
call has_error_file
|
|
jc error_read_file
|
|
mov bx,cx
|
|
mov byte [TYPE_BUFFER + bx],0
|
|
push si
|
|
mov si,TYPE_BUFFER
|
|
call print_string
|
|
pop si
|
|
or bx,bx
|
|
jnz .loop
|
|
call close_file
|
|
xor bx,bx
|
|
ret
|
|
|
|
; ds:si - string
|
|
; result in cx
|
|
; null byte not counted
|
|
; preserves di, bx, dx
|
|
calculate_string_length:
|
|
xor cx,cx
|
|
.loop:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
inc cx
|
|
jmp .loop
|
|
.done:
|
|
ret
|
|
|
|
write_string_to_file:
|
|
mov di,si
|
|
call calculate_string_length
|
|
mov si,[print_data]
|
|
mov ax,ds
|
|
mov es,ax
|
|
jmp write_file
|
|
|
|
write_append_common:
|
|
push word [print_callback]
|
|
push word [print_data]
|
|
push si
|
|
push bx
|
|
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
mov [print_data],si
|
|
mov word [print_callback],write_string_to_file
|
|
|
|
pop bx
|
|
pop si
|
|
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
|
|
mov si,[print_data]
|
|
call close_file
|
|
|
|
pop word [print_data]
|
|
pop word [print_callback]
|
|
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_write:
|
|
xor cx,cx
|
|
call next_filename_argument
|
|
mov dx,FILE_WRITE
|
|
jmp write_append_common
|
|
|
|
do_builtin_append:
|
|
xor cx,cx
|
|
call next_filename_argument
|
|
mov dx,FILE_APPEND
|
|
jmp write_append_common
|
|
|
|
do_builtin_rename:
|
|
xor cx,cx
|
|
call next_filename_argument
|
|
|
|
push si
|
|
push bx
|
|
mov si,next_filename_argument.name
|
|
mov dx,FILE_RENAME
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
mov di,si
|
|
pop bx
|
|
pop si
|
|
push di
|
|
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
|
|
mov si,next_filename_argument.name
|
|
mov dx,FILE_READ
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
jne error_file_already_exists
|
|
|
|
pop si
|
|
call close_file
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_delete:
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
mov dx,FILE_DELETE
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
call close_file
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_terminal:
|
|
push word [print_callback]
|
|
push word [print_data]
|
|
mov word [print_callback],terminal_print_string
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
pop word [print_data]
|
|
pop word [print_callback]
|
|
xor bx,bx
|
|
ret
|
|
|
|
%macro LS_COMMON_START 0
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
|
|
; Start reading the root directory from the beginning.
|
|
call start_reading_root_directory
|
|
|
|
.loop:
|
|
|
|
; Read the next entry.
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov si,ROOT_HANDLE
|
|
mov di,open_file.directory_entry
|
|
mov cx,0x20
|
|
call read_file
|
|
|
|
call has_error_file
|
|
jc error_read_file
|
|
or cx,cx
|
|
jz .done
|
|
cmp byte [open_file.directory_entry],0
|
|
jz .loop
|
|
%endmacro
|
|
|
|
%macro LS_COMMON_END 0
|
|
jmp .loop
|
|
|
|
.done:
|
|
%endmacro
|
|
|
|
do_builtin_ls:
|
|
LS_COMMON_START
|
|
mov si,open_file.directory_entry
|
|
call print_string
|
|
call print_newline
|
|
LS_COMMON_END
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_dir:
|
|
xor ax,ax
|
|
mov [.total_size + 0],ax
|
|
mov [.total_size + 2],ax
|
|
LS_COMMON_START
|
|
mov dx,[open_file.directory_entry + 18]
|
|
or dx,dx
|
|
jnz .not_small
|
|
mov ax,[open_file.directory_entry + 16]
|
|
cmp ax,1000
|
|
ja .not_small
|
|
call print_s16
|
|
mov si,bytes_message
|
|
call print_string
|
|
jmp .common
|
|
.not_small:
|
|
mov cx,1000
|
|
div cx
|
|
call print_s16
|
|
mov si,kilobytes_message
|
|
call print_string
|
|
.common:
|
|
mov word [caret_column],8
|
|
mov si,open_file.directory_entry
|
|
call print_string
|
|
call print_newline
|
|
mov ax,[open_file.directory_entry + 16]
|
|
mov cx,[open_file.directory_entry + 18]
|
|
add [.total_size + 0],ax
|
|
adc [.total_size + 2],cx
|
|
LS_COMMON_END
|
|
mov ax,[.total_size + 0]
|
|
shr ax,10
|
|
mov bx,[.total_size + 2]
|
|
shl bx,6
|
|
or ax,bx
|
|
mov si,total_usage_message
|
|
call print_string
|
|
call print_s16
|
|
mov si,kilobytes_message
|
|
call print_string
|
|
mov si,out_of_message
|
|
call print_string
|
|
mov ax,[FS_HEADER_BUFFER + 4]
|
|
shr ax,1
|
|
call print_s16
|
|
mov si,kilobytes_message
|
|
call print_string
|
|
xor bx,bx
|
|
ret
|
|
.total_size: dd 0
|
|
|
|
do_builtin_strlen:
|
|
mov cx,TYPE_STRING | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(bx, bx)
|
|
xor dx,dx
|
|
.loop1:
|
|
or bx,bx
|
|
jz .done
|
|
mov cx,6
|
|
STRING_NEXT(di, bx)
|
|
add bx,2
|
|
.loop2:
|
|
mov al,[gs:bx]
|
|
or al,al
|
|
jz .done
|
|
inc bx
|
|
inc dx
|
|
loop .loop2
|
|
mov bx,di
|
|
jmp .loop1
|
|
.done:
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
do_builtin_nth_char:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(dx, di)
|
|
mov cx,TYPE_STRING | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(bx, bx)
|
|
mov cx,dx
|
|
.loop1:
|
|
or bx,bx
|
|
jz .out_of_bounds
|
|
cmp cx,6
|
|
jb .in_section
|
|
STRING_NEXT(bx, bx)
|
|
sub cx,6
|
|
jmp .loop1
|
|
.in_section:
|
|
inc cx
|
|
add bx,2
|
|
.loop2:
|
|
mov al,[gs:bx]
|
|
or al,al
|
|
jz .out_of_bounds
|
|
inc bx
|
|
loop .loop2
|
|
.done:
|
|
xor ah,ah
|
|
mov dx,ax
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
.out_of_bounds:
|
|
xor dx,dx
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
|
|
capture_common:
|
|
push si
|
|
push bx
|
|
mov ax,TYPE_STRING
|
|
xor dx,dx ; must be valid since new_string might gc
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
push bx
|
|
call new_string
|
|
mov dx,bx
|
|
pop bx
|
|
SETCDR(bx, dx)
|
|
mov [print_data],dx
|
|
mov dx,bx
|
|
pop bx
|
|
pop si
|
|
push dx
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
pop bx
|
|
pop word [print_data]
|
|
pop word [print_callback]
|
|
ret
|
|
|
|
%macro CAPTURE_START 1
|
|
push word [print_callback]
|
|
push word [print_data]
|
|
mov word [print_callback],%1
|
|
jmp capture_common
|
|
%endmacro
|
|
|
|
capture_string:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
mov bx,[print_data]
|
|
push si
|
|
call string_append_character
|
|
pop si
|
|
mov [print_data],bx
|
|
jmp capture_string
|
|
.done: ret
|
|
|
|
do_builtin_capture:
|
|
CAPTURE_START capture_string
|
|
|
|
capture_string_lower:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
mov bx,[print_data]
|
|
cmp al,'A'
|
|
jb .no_convert
|
|
cmp al,'Z'
|
|
ja .no_convert
|
|
add al,'a'-'A'
|
|
.no_convert:
|
|
push si
|
|
call string_append_character
|
|
pop si
|
|
mov [print_data],bx
|
|
jmp capture_string_lower
|
|
.done: ret
|
|
|
|
do_builtin_capture_lower:
|
|
CAPTURE_START capture_string_lower
|
|
|
|
capture_string_upper:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
mov bx,[print_data]
|
|
cmp al,'a'
|
|
jb .no_convert
|
|
cmp al,'z'
|
|
ja .no_convert
|
|
sub al,'a'-'A'
|
|
.no_convert:
|
|
push si
|
|
call string_append_character
|
|
pop si
|
|
mov [print_data],bx
|
|
jmp capture_string_upper
|
|
.done: ret
|
|
|
|
do_builtin_capture_upper:
|
|
CAPTURE_START capture_string_upper
|
|
|
|
set_graphics_mode:
|
|
mov al,[graphics_mode]
|
|
or al,al
|
|
jnz .done
|
|
mov byte [graphics_mode],1
|
|
mov ax,0xA000
|
|
mov es,ax
|
|
xor di,di
|
|
xor al,al
|
|
mov cx,320 * 200
|
|
rep stosb
|
|
mov ax,0x13
|
|
int 0x10
|
|
.done: ret
|
|
|
|
set_text_mode:
|
|
mov al,[graphics_mode]
|
|
or al,al
|
|
jz .done
|
|
mov byte [graphics_mode],0
|
|
call clear_screen
|
|
mov ax,0x03
|
|
int 0x10
|
|
mov word [caret_column],1
|
|
mov word [caret_row],0
|
|
.done: ret
|
|
|
|
do_builtin_set_graphics:
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY
|
|
call next_argument
|
|
or cx,cx
|
|
jz .text
|
|
call set_graphics_mode
|
|
xor bx,bx
|
|
ret
|
|
.text:
|
|
call set_text_mode
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_wait_key:
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
xor ax,ax
|
|
int 0x16
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_env_reset:
|
|
or di,di
|
|
jz error_cannot_env
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
mov ax,[obj_builtins]
|
|
mov [ss:di],ax
|
|
mov byte [run_startup_command],0
|
|
xor bx,bx
|
|
ret
|
|
|
|
do_builtin_env_list:
|
|
push word [output_color]
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
.loop:
|
|
or si,si
|
|
jz .done
|
|
CAR(bx, si)
|
|
CDR(di, bx)
|
|
CAR(ax, di)
|
|
CAR(bx, bx)
|
|
CDR(bx, bx)
|
|
cmp ax,TYPE_MACRO
|
|
je .alt
|
|
cmp ax,TYPE_BUILTIN
|
|
je .alt2
|
|
cmp ax,TYPE_LAMBDA
|
|
je .alt3
|
|
mov byte [output_color],(SCREEN_COLOR >> 8)
|
|
.print:
|
|
push si
|
|
call print_string_list
|
|
mov byte [output_color],(SCREEN_COLOR >> 8)
|
|
mov si,space_message
|
|
call print_string
|
|
pop si
|
|
CDR(si, si)
|
|
jmp .loop
|
|
.done:
|
|
call print_newline
|
|
mov si,memory_usage_message
|
|
call print_string
|
|
call get_memory_usage
|
|
shr ax,8
|
|
inc ax
|
|
call print_s16
|
|
mov si,kilobytes_message
|
|
call print_string
|
|
mov si,out_of_message
|
|
call print_string
|
|
mov ax,128
|
|
call print_s16
|
|
mov si,kilobytes_message
|
|
call print_string
|
|
xor bx,bx
|
|
pop word [output_color]
|
|
ret
|
|
.highlight:
|
|
mov byte [output_color],(HIGHLIGHT_COLOR >> 8)
|
|
jmp .print
|
|
.alt:
|
|
mov byte [output_color],(ALT_COLOR >> 8)
|
|
jmp .print
|
|
.alt2:
|
|
mov byte [output_color],(ALT2_COLOR >> 8)
|
|
jmp .print
|
|
.alt3:
|
|
mov byte [output_color],(ALT3_COLOR >> 8)
|
|
jmp .print
|
|
|
|
do_builtin_env_export:
|
|
; Open the file to export to.
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
mov dx,FILE_WRITE
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
|
|
; Garbage collect now to reduce export size.
|
|
push si
|
|
call garbage_collect
|
|
pop si
|
|
|
|
; Write out a signature.
|
|
mov word [.buffer + 0],'en'
|
|
mov word [.buffer + 2],('v' + 0x1000)
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,4
|
|
call write_file
|
|
|
|
; For each object...
|
|
xor bx,bx
|
|
.object_loop:
|
|
add bx,OBJ_SIZE
|
|
or bx,bx
|
|
jz .object_done
|
|
CAR(ax, bx)
|
|
cmp ax,TYPE_FREE
|
|
je .object_loop
|
|
|
|
; Write out the ID and contents.
|
|
mov [.buffer + 0],bx
|
|
mov [.buffer + 2],ax
|
|
CDR(ax, bx)
|
|
mov [.buffer + 4],ax
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,6
|
|
push bx
|
|
call write_file
|
|
pop bx
|
|
jmp .object_loop
|
|
.object_done:
|
|
|
|
; Write separator.
|
|
mov word [.buffer],0
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,6
|
|
call write_file
|
|
|
|
; For each string...
|
|
xor bx,bx
|
|
.string_loop:
|
|
add bx,STRING_SIZE
|
|
or bx,bx
|
|
jz .string_done
|
|
STRING_NEXT(ax, bx)
|
|
test ax,2
|
|
jnz .string_loop
|
|
|
|
; Write out the ID and contents.
|
|
mov [.buffer + 0],bx
|
|
mov [.buffer + 2],ax
|
|
mov ax,[gs:bx + 2]
|
|
mov [.buffer + 4],ax
|
|
mov ax,[gs:bx + 4]
|
|
mov [.buffer + 6],ax
|
|
mov ax,[gs:bx + 6]
|
|
mov [.buffer + 8],ax
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,10
|
|
push bx
|
|
call write_file
|
|
pop bx
|
|
jmp .string_loop
|
|
.string_done:
|
|
|
|
; Write separator.
|
|
mov word [.buffer],0
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,10
|
|
call write_file
|
|
|
|
; Save the environment ID and symbol table.
|
|
mov ax,[repl.environment]
|
|
mov [.buffer + 0],ax
|
|
mov ax,[obj_symbol_table]
|
|
mov [.buffer + 2],ax
|
|
mov di,.buffer
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,4
|
|
call write_file
|
|
|
|
call close_file
|
|
xor bx,bx
|
|
ret
|
|
|
|
.buffer: times 10 db 0
|
|
|
|
do_builtin_env_import:
|
|
or di,di
|
|
jz error_cannot_env
|
|
mov [.environment_dest],di
|
|
|
|
; Open the file to import from.
|
|
mov cx,NEXT_ARG_FINAL
|
|
call next_filename_argument
|
|
mov dx,FILE_READ
|
|
mov si,next_filename_argument.name
|
|
call open_file
|
|
cmp si,0xFFFF
|
|
je error_cannot_open_file
|
|
|
|
; Garbage collect now, since we can't during the import.
|
|
push si
|
|
call garbage_collect
|
|
mov byte [gc_ready],0
|
|
pop si
|
|
|
|
; Clear the re-link segment.
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
mov cx,32768
|
|
xor ax,ax
|
|
xor di,di
|
|
rep stosw
|
|
|
|
; Check the file signature.
|
|
mov cx,4
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,.buffer
|
|
call read_file
|
|
cmp cx,4
|
|
jne error_read_file
|
|
cmp word [.buffer + 0],'en'
|
|
jne error_bad_signature
|
|
cmp word [.buffer + 2],('v' + 0x1000)
|
|
jne error_bad_signature
|
|
|
|
; Load the objects.
|
|
.load_object_loop:
|
|
mov cx,6
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,.buffer
|
|
call read_file
|
|
cmp cx,6
|
|
jne error_read_file
|
|
cmp word [.buffer],0
|
|
jz .load_object_done
|
|
mov ax,[.buffer + 2]
|
|
mov dx,[.buffer + 4]
|
|
call new_object
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
mov di,[.buffer + 0]
|
|
shr di,1
|
|
mov [es:di],bx
|
|
jmp .load_object_loop
|
|
.load_object_done:
|
|
|
|
; Load the strings.
|
|
.load_string_loop:
|
|
mov cx,10
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,.buffer
|
|
call read_file
|
|
cmp cx,10
|
|
jne error_read_file
|
|
cmp word [.buffer],0
|
|
jz .load_string_done
|
|
call new_string
|
|
mov ax,[.buffer + 2]
|
|
mov [gs:bx + 0],ax
|
|
mov ax,[.buffer + 4]
|
|
mov [gs:bx + 2],ax
|
|
mov ax,[.buffer + 6]
|
|
mov [gs:bx + 4],ax
|
|
mov ax,[.buffer + 8]
|
|
mov [gs:bx + 6],ax
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
mov di,[.buffer + 0]
|
|
shr di,2
|
|
mov [es:di + 0x8000],bx
|
|
jmp .load_string_loop
|
|
.load_string_done:
|
|
|
|
; Load the environment ID and symbol table.
|
|
mov cx,4
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,.buffer
|
|
call read_file
|
|
cmp cx,4
|
|
jne error_read_file
|
|
mov ax,[.buffer + 0]
|
|
mov [.environment],ax
|
|
mov ax,[.buffer + 2]
|
|
mov [.symbol_table],ax
|
|
|
|
; Close the file.
|
|
call close_file
|
|
|
|
; Use the re-link table segment.
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
|
|
; Re-link objects.
|
|
call .relink_objects
|
|
|
|
; Re-link strings.
|
|
mov bx,0x8000
|
|
.link_string_loop:
|
|
cmp bx,0xC000
|
|
je .link_string_done
|
|
mov di,[es:bx]
|
|
or di,di
|
|
jz .link_string_next
|
|
STRING_NEXT(si, di)
|
|
or si,si
|
|
jz .link_string_next
|
|
shr si,2
|
|
mov ax,[es:si + 0x8000]
|
|
mov [gs:di],ax
|
|
.link_string_next:
|
|
add bx,2
|
|
jmp .link_string_loop
|
|
.link_string_done:
|
|
|
|
; Save the new environment ID and symbol table before we identity map the link table.
|
|
mov si,[.symbol_table]
|
|
shr si,1
|
|
mov si,[es:si]
|
|
mov [.symbol_table],si
|
|
mov si,[.environment]
|
|
shr si,1
|
|
mov si,[es:si]
|
|
mov [.environment],si
|
|
|
|
; Identity map all objects.
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
mov cx,65536 / OBJ_SIZE
|
|
xor ax,ax
|
|
xor di,di
|
|
.identity_loop:
|
|
mov [es:di],ax
|
|
add di,2
|
|
add ax,4
|
|
loop .identity_loop
|
|
|
|
; Identity map all strings.
|
|
mov cx,65536 / STRING_SIZE
|
|
xor ax,ax
|
|
mov di,0x8000
|
|
.identity_loop2:
|
|
mov [es:di],ax
|
|
add di,2
|
|
add ax,8
|
|
loop .identity_loop2
|
|
|
|
; Intern symbols.
|
|
mov si,[.symbol_table]
|
|
.symbol_loop:
|
|
or si,si
|
|
jz .symbol_done
|
|
CAR(bx, si)
|
|
push si
|
|
mov di,.symbol
|
|
mov cx,(MAX_SYMBOL_LENGTH + 1)
|
|
CDR(bx, bx)
|
|
call string_flatten
|
|
mov si,.symbol
|
|
call find_symbol
|
|
pop si
|
|
CAR(di, si)
|
|
shr di,1
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
mov [es:di],bx
|
|
CDR(si, si)
|
|
jmp .symbol_loop
|
|
.symbol_done:
|
|
|
|
; Re-link objects again to use interned symbols.
|
|
call .relink_objects
|
|
|
|
; Append the environment.
|
|
mov si,[.environment]
|
|
.environment_loop:
|
|
CDR(ax, si)
|
|
or ax,ax
|
|
jz .environment_found
|
|
mov si,ax
|
|
jmp .environment_loop
|
|
.environment_found:
|
|
mov bx,[.environment_dest]
|
|
mov ax,[ss:bx]
|
|
SETCDR(si, ax)
|
|
mov si,[.environment]
|
|
mov [ss:bx],si
|
|
|
|
; We're done!
|
|
mov byte [gc_ready],1
|
|
xor bx,bx
|
|
ret
|
|
|
|
.buffer: times 10 db 0
|
|
.environment: dw 0
|
|
.environment_dest: dw 0
|
|
.symbol: times (MAX_SYMBOL_LENGTH + 1) db 0
|
|
.symbol_table: dw 0
|
|
|
|
.relink_objects:
|
|
xor bx,bx
|
|
mov ax,0x4000
|
|
mov es,ax
|
|
.link_object_loop:
|
|
cmp bx,0x8000
|
|
je .link_object_done
|
|
mov di,[es:bx]
|
|
or di,di
|
|
jz .link_object_next
|
|
CAR(si, di)
|
|
cmp si,TYPE_LAMBDA
|
|
je .link_cdr
|
|
cmp si,TYPE_MACRO
|
|
je .link_cdr
|
|
cmp si,TYPE_SYMBOL
|
|
je .link_cdr
|
|
test si,2
|
|
jz .link_both
|
|
cmp si,TYPE_STRING
|
|
jne .link_object_next
|
|
CDR(si, di)
|
|
shr si,2
|
|
mov ax,[es:si + 0x8000]
|
|
SETCDR(di, ax)
|
|
.link_object_next:
|
|
add bx,2
|
|
jmp .link_object_loop
|
|
.link_both:
|
|
shr si,1
|
|
mov ax,[es:si]
|
|
SETCAR(di, ax)
|
|
.link_cdr:
|
|
CDR(si, di)
|
|
shr si,1
|
|
mov ax,[es:si]
|
|
SETCDR(di, ax)
|
|
add bx,2
|
|
jmp .link_object_loop
|
|
.link_object_done:
|
|
ret
|
|
|
|
do_builtin_inspect:
|
|
mov cx,NEXT_ARG_FINAL | NEXT_ARG_ANY | NEXT_ARG_BX
|
|
call next_argument
|
|
CAR(ax, bx)
|
|
cmp ax,TYPE_LAMBDA
|
|
je .inspect
|
|
cmp ax,TYPE_MACRO
|
|
je .inspect
|
|
.print:
|
|
mov cx,-100
|
|
xor dx,dx
|
|
ALL_PUSH(bx)
|
|
call print_object
|
|
xor bx,bx
|
|
ret
|
|
.inspect:
|
|
CDR(bx, bx)
|
|
CAR(bx, bx)
|
|
jmp .print
|
|
|
|
do_builtin_pause:
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
.loop:
|
|
xor ah,ah
|
|
int 0x1A
|
|
cmp dx,[.previous_time]
|
|
je .loop
|
|
mov [.previous_time],dx
|
|
add [do_builtin_random.seed],dx
|
|
add [do_builtin_random.seed],cx
|
|
xor bx,bx
|
|
ret
|
|
.previous_time: dw 0
|
|
|
|
do_builtin_last_scancode:
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
|
|
mov ah,1
|
|
int 0x16
|
|
jz .none
|
|
mov [last_scancode],ah
|
|
xor ah,ah
|
|
int 0x16
|
|
|
|
.none:
|
|
mov ax,TYPE_INT
|
|
mov dx,[last_scancode]
|
|
jmp new_object
|
|
|
|
do_builtin_random:
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
mov ax,[.seed]
|
|
add ax,12345
|
|
mov cx,9781
|
|
mul cx
|
|
mov dx,ax
|
|
mov ax,TYPE_INT
|
|
jmp new_object
|
|
.seed: dw 0
|
|
|
|
do_builtin_outb:
|
|
mov cx,TYPE_INT
|
|
call next_argument
|
|
mov di,cx
|
|
CDR(di, di)
|
|
mov cx,TYPE_INT | NEXT_ARG_FINAL | NEXT_ARG_BX
|
|
call next_argument
|
|
CDR(ax, bx)
|
|
mov dx,di
|
|
out dx,al
|
|
xor bx,bx
|
|
ret
|
|
|
|
; bp - all list (preserved, unless _KEEP set)
|
|
; si - environment (preserved)
|
|
; bx - argument list pointer (updated)
|
|
; cx - desired argument type and flags
|
|
; argument stored in cx
|
|
; additionally preserves ax, dx and di
|
|
next_argument:
|
|
; Check there is another argument.
|
|
or bx,bx
|
|
jz error_insufficient_arguments
|
|
|
|
push dx
|
|
push di
|
|
mov dx,cx
|
|
|
|
; Get the next argument and go to the next element in the list.
|
|
CAR(cx, bx)
|
|
CDR(bx, bx)
|
|
|
|
; Check this is the last argument, if requested.
|
|
test dx,NEXT_ARG_FINAL
|
|
jz .done_final_check
|
|
or bx,bx
|
|
jnz error_too_many_arguments
|
|
.done_final_check:
|
|
|
|
; Evaluate the argument with tail call recursion, if requested.
|
|
test dx,NEXT_ARG_TAIL
|
|
jz .done_tail
|
|
add sp,4 ; pop dx, di
|
|
mov bx,cx
|
|
xor di,di
|
|
ALL_POP(2) ; function and environment
|
|
jmp evaluate_object
|
|
.done_tail:
|
|
|
|
; Evaluate the argument, if requested.
|
|
test dx,NEXT_ARG_QUOTE
|
|
jnz .done_evaluate
|
|
push ax
|
|
push bx
|
|
push dx
|
|
push si
|
|
push bp
|
|
mov bx,cx
|
|
xor di,di
|
|
call evaluate_object
|
|
mov cx,bx
|
|
pop bp
|
|
pop si
|
|
pop dx
|
|
pop bx
|
|
pop ax
|
|
.done_evaluate:
|
|
|
|
; Add the result to the all list, if requested.
|
|
test dx,NEXT_ARG_KEEP
|
|
jz .done_keep
|
|
ALL_PUSH(cx)
|
|
.done_keep:
|
|
|
|
; Check the type is correct, if requested.
|
|
test dx,NEXT_ARG_NIL
|
|
jz .no_nil_flag
|
|
or cx,cx
|
|
jz .done_type_check
|
|
.no_nil_flag:
|
|
test dx,NEXT_ARG_ANY
|
|
jnz .done_type_check
|
|
mov di,cx
|
|
CAR(di, di)
|
|
or dl,dl
|
|
jnz .type_non_pair
|
|
and di,2
|
|
.type_non_pair:
|
|
push dx
|
|
xor dh,dh
|
|
cmp dx,di
|
|
jne error_wrong_type
|
|
pop dx
|
|
.done_type_check:
|
|
|
|
; Move the result to bx, if requested.
|
|
test dx,NEXT_ARG_BX
|
|
jz .done_bx
|
|
mov bx,cx
|
|
.done_bx:
|
|
|
|
pop di
|
|
pop dx
|
|
|
|
ret
|
|
|
|
; bx - environment
|
|
tidy_environment:
|
|
; Mark all string objects in use, and mark all duplicates.
|
|
push bx
|
|
.mark_loop:
|
|
or bx,bx
|
|
jz .mark_done
|
|
CAR(di, bx)
|
|
CAR(di, di)
|
|
CAR(si, di)
|
|
test si,1
|
|
jnz .already_marked
|
|
or si,1
|
|
SETCAR(di, si)
|
|
jmp .mark_next
|
|
.already_marked:
|
|
xor ax,ax
|
|
SETCAR(bx, ax)
|
|
.mark_next:
|
|
CDR(bx, bx)
|
|
jmp .mark_loop
|
|
.mark_done:
|
|
pop bx
|
|
|
|
; Unlink duplicates.
|
|
push bx
|
|
.unlink_loop:
|
|
or bx,bx
|
|
jz .unlink_done
|
|
CAR(ax, bx)
|
|
or ax,ax
|
|
jnz .unlink_next
|
|
CDR(si, bx)
|
|
SETCDR(di, si)
|
|
mov bx,di
|
|
.unlink_next:
|
|
mov di,bx
|
|
CDR(bx, bx)
|
|
jmp .unlink_loop
|
|
.unlink_done:
|
|
pop bx
|
|
|
|
; Finally, remove the mark from the string objects.
|
|
.unmark_loop:
|
|
or bx,bx
|
|
jz .unmark_done
|
|
CAR(di, bx)
|
|
CAR(di, di)
|
|
CAR(si, di)
|
|
and si,~1
|
|
SETCAR(di, si)
|
|
CDR(bx, bx)
|
|
jmp .unmark_loop
|
|
.unmark_done:
|
|
|
|
ret
|
|
|
|
; si - environment
|
|
; bx - canonical string object for symbol
|
|
; returns object in bx
|
|
; preserves ax, cx, dx
|
|
lookup_symbol:
|
|
; Are we at the end of the environment list?
|
|
or si,si
|
|
jz error_symbol_not_found
|
|
|
|
; Does the string object match?
|
|
CAR(di, si)
|
|
CAR(di, di)
|
|
cmp di,bx
|
|
je .match
|
|
|
|
; Go to the next value in the environment.
|
|
CDR(si, si)
|
|
jmp lookup_symbol
|
|
|
|
; Return the value pair.
|
|
.match:
|
|
CAR(bx, si)
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; si - string to search for
|
|
; returns object in bx
|
|
find_symbol:
|
|
; Look through the symbol table for a match.
|
|
mov di,[obj_symbol_table]
|
|
.table_loop:
|
|
or di,di
|
|
jz .not_found
|
|
CAR(bx, di)
|
|
CDR(bx, bx)
|
|
push si
|
|
call string_compare_with_literal
|
|
pop si
|
|
jc .match
|
|
CDR(di, di)
|
|
jmp .table_loop
|
|
.match:
|
|
CAR(bx, di)
|
|
ret
|
|
|
|
; Create a new string object.
|
|
.not_found:
|
|
push si
|
|
mov ax,TYPE_STRING
|
|
xor dx,dx ; new_string could gc, so this should be valid
|
|
call new_object
|
|
ALL_PUSH(bx)
|
|
push bx
|
|
call new_string
|
|
pop di
|
|
SETCDR(di,bx)
|
|
push di
|
|
|
|
; Add the string object to the symbol table.
|
|
push bx
|
|
mov ax,di
|
|
mov dx,[obj_symbol_table]
|
|
call new_object
|
|
mov [obj_symbol_table],bx
|
|
ALL_POP(1)
|
|
|
|
; Append the characters to the string.
|
|
pop bx
|
|
pop di
|
|
pop si
|
|
push di
|
|
.append_loop:
|
|
lodsb
|
|
or al,al
|
|
jz .string_complete
|
|
push si
|
|
call string_append_character
|
|
pop si
|
|
jmp .append_loop
|
|
.string_complete:
|
|
|
|
pop bx
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; bx - string (modified if tail section changes)
|
|
; al - character
|
|
string_append_character:
|
|
push bx
|
|
|
|
; Look for a free place in the current section.
|
|
mov cx,STRING_DATA
|
|
add bx,2
|
|
.loop:
|
|
cmp byte [gs:bx],0
|
|
je .store
|
|
inc bx
|
|
loop .loop
|
|
sub bx,8
|
|
|
|
; Allocate a new section.
|
|
push ax
|
|
call new_string
|
|
pop ax
|
|
pop si
|
|
mov [gs:si],bx
|
|
push bx
|
|
add bx,2
|
|
|
|
; Store the character.
|
|
.store:
|
|
mov [gs:bx],al
|
|
pop bx
|
|
ret
|
|
|
|
; bx - string 1
|
|
; di - string 2
|
|
; carry set if equal
|
|
string_compare:
|
|
mov cx,STRING_DATA
|
|
STRING_NEXT(dx, bx)
|
|
STRING_NEXT(si, di)
|
|
add bx,2
|
|
add di,2
|
|
.loop:
|
|
mov al,[gs:di]
|
|
cmp al,[gs:bx]
|
|
jne .not_equal
|
|
or al,al
|
|
je .equal
|
|
inc bx
|
|
inc di
|
|
loop .loop
|
|
mov bx,dx
|
|
mov di,si
|
|
jmp string_compare
|
|
.not_equal:
|
|
clc
|
|
ret
|
|
.equal:
|
|
stc
|
|
ret
|
|
|
|
; bx - string
|
|
; si - literal
|
|
; carry set if equal
|
|
; preserves di
|
|
string_compare_with_literal:
|
|
mov cx,STRING_DATA
|
|
STRING_NEXT(dx, bx)
|
|
add bx,2
|
|
.loop:
|
|
lodsb
|
|
cmp al,[gs:bx]
|
|
jne string_compare.not_equal
|
|
or al,al
|
|
je string_compare.equal
|
|
inc bx
|
|
loop .loop
|
|
mov bx,dx
|
|
jmp string_compare_with_literal
|
|
|
|
; bx - string
|
|
; di - destination buffer
|
|
; cx - size of the destination buffer (including space to put null byte)
|
|
; carry set if destination buffer was too small
|
|
; preserves bp
|
|
string_flatten:
|
|
mov si,cx
|
|
.next_section:
|
|
mov cx,STRING_DATA
|
|
STRING_NEXT(dx, bx)
|
|
add bx,2
|
|
.loop:
|
|
mov al,[gs:bx]
|
|
inc bx
|
|
or si,si
|
|
jz .full
|
|
mov [di],al
|
|
inc di
|
|
dec si
|
|
or al,al
|
|
jz .done
|
|
loop .loop
|
|
mov bx,dx
|
|
jmp .next_section
|
|
.done:
|
|
clc
|
|
ret
|
|
.full:
|
|
stc
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; returns string in bx
|
|
new_string:
|
|
%ifdef ALWAYS_GC
|
|
call garbage_collect
|
|
%endif
|
|
|
|
; If there are no more free string, call the garbage collector.
|
|
cmp word [first_free_string],0
|
|
jne .got_memory
|
|
call garbage_collect
|
|
cmp word [first_free_string],0
|
|
je error_out_of_memory
|
|
.got_memory:
|
|
|
|
; Remove the first free string from the list.
|
|
mov bx,[first_free_string]
|
|
STRING_NEXT(ax, bx)
|
|
and ax,0xFFFC
|
|
mov [first_free_string],ax
|
|
|
|
; Clear the contents of the string.
|
|
xor ax,ax
|
|
mov word [gs:bx+0],ax
|
|
mov word [gs:bx+2],ax
|
|
mov word [gs:bx+4],ax
|
|
mov word [gs:bx+6],ax
|
|
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
; ax - low word (preserved)
|
|
; dx - high word (preserved)
|
|
; returns object in bx
|
|
; additionally preserves si
|
|
new_object:
|
|
push ax
|
|
push dx
|
|
push si
|
|
|
|
%ifdef ALWAYS_GC
|
|
call garbage_collect
|
|
%endif
|
|
|
|
; If there are no more free objects, call the garbage collector.
|
|
cmp word [first_free_object],0
|
|
jne .got_memory
|
|
call garbage_collect
|
|
cmp word [first_free_object],0
|
|
je error_out_of_memory
|
|
.got_memory:
|
|
|
|
; Remove the first free object from the list.
|
|
mov bx,[first_free_object]
|
|
CDR(ax, bx)
|
|
mov [first_free_object],ax
|
|
|
|
; Set the contents of the object.
|
|
pop si
|
|
pop dx
|
|
pop ax
|
|
SETCAR(bx, ax)
|
|
SETCDR(bx, dx)
|
|
|
|
ret
|
|
|
|
; bp - all list (preserved)
|
|
garbage_collect:
|
|
; If we system has not yet been initialized, then we can't garbage collect.
|
|
cmp byte [gc_ready],0
|
|
je .done
|
|
|
|
; Mark the all list and the symbol table.
|
|
mov bx,[obj_symbol_table]
|
|
call mark_object
|
|
mov di,bp
|
|
.mark_loop:
|
|
cmp di,ALL_LIST_TOP
|
|
je .mark_complete
|
|
mov bx,[ss:di]
|
|
call mark_object
|
|
add di,2
|
|
jmp .mark_loop
|
|
.mark_complete:
|
|
|
|
; Iterate over all strings.
|
|
mov cx,(65536 / STRING_SIZE - 1)
|
|
mov bx,STRING_SIZE
|
|
.string_loop:
|
|
|
|
; Store and clear the mark.
|
|
STRING_NEXT(ax, bx)
|
|
and byte [gs:bx],0xFE
|
|
|
|
; If the mark is set, or the string was already free, don't free the string.
|
|
test ax,3
|
|
jnz .next_string
|
|
|
|
; Free the string.
|
|
mov ax,[first_free_string]
|
|
or ax,2
|
|
mov word [gs:bx],ax
|
|
mov [first_free_string],bx
|
|
|
|
; Go to the next string.
|
|
.next_string:
|
|
add bx,STRING_SIZE
|
|
loop .string_loop
|
|
|
|
; Iterate over all objects.
|
|
mov cx,(65536 / OBJ_SIZE - 1)
|
|
mov bx,OBJ_SIZE
|
|
.object_loop:
|
|
|
|
; Store and clear the mark.
|
|
CAR(ax, bx)
|
|
and byte [fs:bx],0xFE
|
|
|
|
; If the mark is set, or the object was already free, don't free the object.
|
|
test ax,1
|
|
jnz .next_object
|
|
cmp ax,TYPE_FREE
|
|
je .next_object
|
|
|
|
; Free the object.
|
|
mov ax,[first_free_object]
|
|
SETCDR(bx, ax)
|
|
mov ax,TYPE_FREE
|
|
SETCAR(bx, ax)
|
|
mov [first_free_object],bx
|
|
|
|
; Go to the next object.
|
|
.next_object:
|
|
add bx,OBJ_SIZE
|
|
loop .object_loop
|
|
|
|
.done:
|
|
ret
|
|
|
|
get_memory_usage:
|
|
call garbage_collect
|
|
xor ax,ax
|
|
|
|
; Count used objects.
|
|
xor bx,bx
|
|
mov cx,(65536 / OBJ_SIZE)
|
|
.object_loop:
|
|
CAR(dx, bx)
|
|
cmp dx,TYPE_FREE
|
|
je .object_free
|
|
inc ax
|
|
.object_free:
|
|
add bx,OBJ_SIZE
|
|
loop .object_loop
|
|
|
|
; Count used strings.
|
|
xor bx,bx
|
|
mov cx,(65536 / STRING_SIZE)
|
|
.string_loop:
|
|
STRING_NEXT(dx, bx)
|
|
test dx,2
|
|
jnz .string_free
|
|
add ax,2
|
|
.string_free:
|
|
add bx,STRING_SIZE
|
|
loop .string_loop
|
|
|
|
ret
|
|
|
|
; bx - object to recursively GC mark
|
|
; preserves bp
|
|
mark_object:
|
|
CHECK_STACK_OVERFLOW
|
|
|
|
; Don't mark the nil object.
|
|
or bx,bx
|
|
jz .done
|
|
|
|
; Has the object already been marked?
|
|
CAR(ax, bx)
|
|
test ax,1
|
|
jnz .done
|
|
|
|
; Mark the object.
|
|
or byte [fs:bx],1
|
|
|
|
; Is the object a pair?
|
|
test ax,2
|
|
jz .mark_both
|
|
|
|
; Is the object a lambda or macro?
|
|
cmp ax,TYPE_LAMBDA
|
|
je .mark_cdr
|
|
cmp ax,TYPE_MACRO
|
|
je .mark_cdr
|
|
|
|
; Is the object a string?
|
|
cmp ax,TYPE_STRING
|
|
je .string
|
|
|
|
cmp ax,TYPE_FREE
|
|
je error_free_accessible
|
|
|
|
.done:
|
|
ret
|
|
|
|
.mark_both:
|
|
push bx
|
|
mov bx,ax
|
|
call mark_object
|
|
pop bx
|
|
.mark_cdr:
|
|
CDR(bx, bx)
|
|
jmp mark_object
|
|
|
|
.string:
|
|
CDR(bx, bx)
|
|
jmp mark_string
|
|
|
|
; bx - string to GC mark
|
|
; preserves bp
|
|
mark_string:
|
|
; Don't mark the nil string.
|
|
or bx,bx
|
|
jz .done
|
|
|
|
; Has the section already been marked?
|
|
STRING_NEXT(ax, bx)
|
|
test ax,2
|
|
jnz .done
|
|
|
|
; Mark the section.
|
|
or byte [gs:bx],1
|
|
|
|
; Go to the next section.
|
|
mov bx,ax
|
|
jmp mark_string
|
|
|
|
.done:
|
|
ret
|
|
|
|
; preserves all registers
|
|
reset_output:
|
|
pusha
|
|
mov byte [output_color],(SCREEN_COLOR >> 8)
|
|
mov word [print_callback],terminal_print_string
|
|
call set_text_mode
|
|
popa
|
|
ret
|
|
|
|
; ax - message
|
|
error_runtime:
|
|
call reset_output
|
|
mov si,.message
|
|
call print_string
|
|
mov si,ax
|
|
call print_string
|
|
jmp [recover]
|
|
.message: db 'Runtime error: ',0
|
|
|
|
error_out_of_memory:
|
|
mov ax,.message
|
|
jmp error_runtime
|
|
.message: db 'out of memory',10,0
|
|
|
|
error_stack_overflow:
|
|
mov ax,.message
|
|
jmp error_runtime
|
|
.message: db 'stack overflow',10,0
|
|
|
|
; ax - message
|
|
error_read:
|
|
call reset_output
|
|
mov si,.message
|
|
call print_string
|
|
mov si,ax
|
|
call print_string
|
|
mov si,.line
|
|
call print_string
|
|
mov ax,[input_line]
|
|
call print_s16
|
|
call print_newline
|
|
jmp [recover]
|
|
.message: db 'Read error: ',0
|
|
.line: db 'at line ',0
|
|
|
|
error_unexpected_eoi:
|
|
mov ax,.message
|
|
jmp error_read
|
|
.message: db 'unexpected end of input',10,0
|
|
|
|
error_symbol_too_long:
|
|
mov ax,.message
|
|
jmp error_read
|
|
.message: db 'symbol too long (max is 24 characters)',10,0
|
|
|
|
error_integer_too_large:
|
|
mov ax,.message
|
|
jmp error_read
|
|
.message: db 'integer too large (must be between -32768 and 32767)',10,0
|
|
|
|
error_invalid_dot:
|
|
mov ax,.message
|
|
jmp error_read
|
|
.message: db 'invalid dotted list (dot must be after penultimate item)',10,0
|
|
|
|
error_unexpected_character:
|
|
mov ax,.message
|
|
jmp error_read
|
|
.message: db 'unexpected character',10,0
|
|
|
|
; ax - message
|
|
; bx - object
|
|
error_evaluate:
|
|
call reset_output
|
|
mov si,.message
|
|
call print_string
|
|
mov si,ax
|
|
call print_string
|
|
mov cx,-5
|
|
or bx,bx
|
|
jz .no_object
|
|
call print_object
|
|
.no_object:
|
|
call print_newline
|
|
jmp [recover]
|
|
.message: db 'Evaluate error: ',0
|
|
|
|
error_symbol_not_found:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'symbol not found - ',0
|
|
|
|
error_not_callable:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'object not callable',10,0
|
|
|
|
error_insufficient_arguments:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'insufficient arguments',10,0
|
|
|
|
error_too_many_arguments:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'too many arguments',10,0
|
|
|
|
error_wrong_type:
|
|
mov bx,cx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'incorrect argument type',10,0
|
|
|
|
error_cannot_let:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'cannot use let in this context',10,0
|
|
|
|
error_cannot_src:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'cannot use src in this context',10,0
|
|
|
|
error_cannot_env:
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'cannot modify environment in this context',10,0
|
|
|
|
error_file_name_too_long:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'the file name is too long (max 15 characters)',10,0
|
|
|
|
error_cannot_open_file:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'the file could not be found, or is already in use',10,0
|
|
|
|
error_file_already_exists:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'the file already exists',10,0
|
|
|
|
error_read_file:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'the file could not be read',10,0
|
|
|
|
error_divide_error:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'divide error (division by zero, or muldiv result too large)',10,0
|
|
|
|
error_break:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'Ctrl+C pressed',10,0
|
|
|
|
error_bad_signature:
|
|
xor bx,bx
|
|
mov ax,.message
|
|
jmp error_evaluate
|
|
.message: db 'file does not contain environment',10,0
|
|
|
|
; ax - message
|
|
error_internal:
|
|
call reset_output
|
|
mov si,.message
|
|
call print_string
|
|
mov si,ax
|
|
call print_string
|
|
hlt
|
|
jmp $
|
|
.message: db 'Internal error: ',0
|
|
|
|
error_free_accessible:
|
|
mov ax,.message
|
|
jmp error_internal
|
|
.message: db 'an accessible object was freed',10,0
|
|
|
|
error_unknown:
|
|
mov ax,.message
|
|
jmp error_internal
|
|
.message: db 'general failure',10,0
|
|
|
|
error_unimplemented_builtin:
|
|
mov ax,.message
|
|
jmp error_internal
|
|
.message: db 'unimplemented builtin',10,0
|
|
|
|
error_io_fatal:
|
|
mov ax,.message
|
|
jmp error_internal
|
|
.message: db 'could not access boot disk',10,0
|
|
|
|
install_exception_handlers:
|
|
xor ax,ax
|
|
mov es,ax
|
|
mov word [es: 0],error_divide_error
|
|
mov word [es: 2],0x1000
|
|
mov word [es: 4],error_unknown
|
|
mov word [es: 6],0x1000
|
|
mov word [es: 8],error_unknown
|
|
mov word [es:10],0x1000
|
|
mov word [es:12],error_unknown
|
|
mov word [es:14],0x1000
|
|
mov word [es:16],error_unknown
|
|
mov word [es:18],0x1000
|
|
mov word [es:20],error_unknown
|
|
mov word [es:22],0x1000
|
|
mov word [es:24],error_unknown
|
|
mov word [es:26],0x1000
|
|
mov word [es:28],error_unknown
|
|
mov word [es:30],0x1000
|
|
ret
|
|
|
|
; bx - object
|
|
; cx - depth limit
|
|
; dx - 0 to quote strings
|
|
; bp - all list (preserved)
|
|
print_object:
|
|
CHECK_STACK_OVERFLOW
|
|
|
|
CAR(ax, bx)
|
|
|
|
cmp ax,TYPE_BUILTIN
|
|
je .builtin
|
|
cmp ax,TYPE_SYMBOL
|
|
je .symbol
|
|
cmp ax,TYPE_STRING
|
|
je .string
|
|
cmp ax,TYPE_NIL
|
|
je .nil
|
|
cmp ax,TYPE_INT
|
|
je .integer
|
|
cmp ax,TYPE_LAMBDA
|
|
je .lambda
|
|
cmp ax,TYPE_MACRO
|
|
je .macro
|
|
|
|
and ax,2
|
|
cmp ax,0
|
|
je .pair
|
|
|
|
mov si,unknown_type_message
|
|
jmp print_string
|
|
|
|
.builtin:
|
|
mov si,builtin_message
|
|
call print_string
|
|
CDR(ax, bx)
|
|
call print_s16
|
|
mov si,close_sign_message
|
|
call print_string
|
|
ret
|
|
|
|
.symbol:
|
|
CDR(bx, bx)
|
|
CDR(bx, bx)
|
|
jmp print_string_list
|
|
|
|
.string:
|
|
or dl,dl
|
|
jnz .unquoted_string
|
|
mov si,string_quote_message
|
|
call print_string
|
|
CDR(bx, bx)
|
|
call print_string_list
|
|
mov si,string_quote_message
|
|
jmp print_string
|
|
.unquoted_string:
|
|
CDR(bx, bx)
|
|
jmp print_string_list
|
|
|
|
.nil:
|
|
mov si,nil_message
|
|
jmp print_string
|
|
|
|
.lambda:
|
|
mov si,lambda_message
|
|
call print_string
|
|
CDR(ax, bx)
|
|
call print_word
|
|
mov si,close_sign_message
|
|
call print_string
|
|
ret
|
|
|
|
.macro:
|
|
mov si,macro_message
|
|
call print_string
|
|
CDR(ax, bx)
|
|
call print_word
|
|
mov si,close_sign_message
|
|
call print_string
|
|
ret
|
|
|
|
.integer:
|
|
CDR(ax, bx)
|
|
jmp print_s16
|
|
|
|
.pair:
|
|
mov si,list_start_message
|
|
call print_string
|
|
cmp cx,-1
|
|
je .depth_limit_reached
|
|
inc cx
|
|
push cx
|
|
push bx
|
|
CAR(bx, bx)
|
|
xor dx,dx
|
|
call print_object
|
|
pop bx
|
|
pop cx
|
|
CDR(bx, bx)
|
|
|
|
.list_loop:
|
|
CAR(ax, bx);
|
|
test ax,2
|
|
jnz .list_end
|
|
mov si,space_message
|
|
call print_string
|
|
push cx
|
|
push bx
|
|
CAR(bx, bx)
|
|
xor dx,dx
|
|
call print_object
|
|
pop bx
|
|
pop cx
|
|
CDR(bx, bx)
|
|
jmp .list_loop
|
|
|
|
.list_end:
|
|
or bx,bx
|
|
jz .list_close
|
|
mov si,dot_message
|
|
call print_string
|
|
xor dx,dx
|
|
call print_object
|
|
|
|
.list_close:
|
|
mov si,list_end_message
|
|
call print_string
|
|
ret
|
|
|
|
.depth_limit_reached:
|
|
mov si,depth_limit_reached_message
|
|
jmp print_string
|
|
|
|
; bx - string list
|
|
print_string_list:
|
|
or bx,bx
|
|
jz .done
|
|
mov si,.buffer
|
|
mov al,[gs:bx+2]
|
|
mov [si+0],al
|
|
mov al,[gs:bx+3]
|
|
mov [si+1],al
|
|
mov al,[gs:bx+4]
|
|
mov [si+2],al
|
|
mov al,[gs:bx+5]
|
|
mov [si+3],al
|
|
mov al,[gs:bx+6]
|
|
mov [si+4],al
|
|
mov al,[gs:bx+7]
|
|
mov [si+5],al
|
|
call print_string
|
|
STRING_NEXT(bx, bx)
|
|
jmp print_string_list
|
|
.done:
|
|
ret
|
|
.buffer: db 0,0,0,0,0,0,0
|
|
|
|
clear_screen:
|
|
mov ax,0xB800
|
|
mov es,ax
|
|
mov ax,SCREEN_COLOR
|
|
mov cx,80 * 25
|
|
xor di,di
|
|
rep stosw
|
|
ret
|
|
|
|
output_null:
|
|
ret
|
|
|
|
terminal_print_string:
|
|
.loop:
|
|
lodsb
|
|
or al,al
|
|
jz .done
|
|
push si
|
|
call terminal_print_character
|
|
pop si
|
|
jmp .loop
|
|
.done:
|
|
call update_caret
|
|
ret
|
|
|
|
; al - character
|
|
print_character:
|
|
pusha
|
|
mov [.buffer],al
|
|
mov si,.buffer
|
|
call [print_callback]
|
|
popa
|
|
ret
|
|
.buffer: dw 0
|
|
|
|
; si - zero-terminated string
|
|
; bp - all list (if print callback is not to the terminal)
|
|
; preserves all registers
|
|
print_string:
|
|
pusha
|
|
call [print_callback]
|
|
popa
|
|
ret
|
|
|
|
update_caret:
|
|
mov ax,[caret_row]
|
|
mov dx,80
|
|
mul dx
|
|
add ax,[caret_column]
|
|
mov bx,ax
|
|
mov dx,0x03D4
|
|
mov al,0x0F
|
|
out dx,al
|
|
mov dx,0x03D5
|
|
mov al,bl
|
|
out dx,al
|
|
mov dx,0x03D4
|
|
mov al,0x0E
|
|
out dx,al
|
|
mov dx,0x03D5
|
|
mov al,bh
|
|
out dx,al
|
|
ret
|
|
|
|
; al - character
|
|
terminal_print_character:
|
|
mov cx,0xB800
|
|
mov es,cx
|
|
cmp al,10
|
|
je .newline
|
|
mov cx,ax
|
|
call get_caret_position
|
|
mov ax,cx
|
|
mov [es:bx],al
|
|
mov al,[output_color]
|
|
mov [es:bx + 1],al
|
|
mov bx,[caret_column]
|
|
inc bx
|
|
cmp bx,79
|
|
je .newline
|
|
mov [caret_column],bx
|
|
ret
|
|
|
|
.newline:
|
|
mov bx,1
|
|
mov [caret_column],bx
|
|
mov bx,[caret_row]
|
|
inc bx
|
|
cmp bx,25
|
|
je .scroll
|
|
mov [caret_row],bx
|
|
ret
|
|
|
|
.scroll:
|
|
mov bx,[user_input_start]
|
|
sub bx,160
|
|
mov [user_input_start],bx
|
|
mov bx,[previously_unmatched_brace]
|
|
or bx,bx
|
|
jz .e1
|
|
sub bx,160
|
|
mov [previously_unmatched_brace],bx
|
|
.e1:
|
|
mov cx,80 * 24
|
|
mov si,160
|
|
mov di,0
|
|
.scroll_loop:
|
|
mov ax,[es:si]
|
|
mov [es:di],ax
|
|
add si,2
|
|
add di,2
|
|
loop .scroll_loop
|
|
mov ax,SCREEN_COLOR
|
|
mov cx,80
|
|
rep stosw
|
|
ret
|
|
|
|
print_backspace:
|
|
mov ax,[caret_column]
|
|
cmp ax,1
|
|
je .up
|
|
dec ax
|
|
mov [caret_column],ax
|
|
jmp update_caret
|
|
.up:
|
|
mov word [caret_column],78
|
|
dec word [caret_row]
|
|
jmp update_caret
|
|
|
|
; ax - int to print
|
|
; preserves registers
|
|
print_s16:
|
|
pusha
|
|
cmp ax,0
|
|
jg .positive
|
|
je .zero
|
|
push ax
|
|
mov al,'-'
|
|
call print_character
|
|
pop ax
|
|
neg ax
|
|
.positive:
|
|
mov si,.buffer + 4
|
|
.divide_loop:
|
|
or ax,ax
|
|
jz .done
|
|
xor dx,dx
|
|
mov cx,10
|
|
div cx
|
|
add dl,'0'
|
|
mov [si],dl
|
|
dec si
|
|
jmp .divide_loop
|
|
.done:
|
|
inc si
|
|
call print_string
|
|
popa
|
|
ret
|
|
.zero:
|
|
mov al,'0'
|
|
call print_character
|
|
popa
|
|
ret
|
|
.buffer: db 0, 0, 0, 0, 0, 0
|
|
|
|
; ax - word to print in hex
|
|
; preserves registers
|
|
print_word:
|
|
pusha
|
|
mov cx,ax
|
|
mov bx,cx
|
|
shr bx,12
|
|
and bx,15
|
|
mov al,[hex_characters + bx]
|
|
push cx
|
|
call print_character
|
|
pop cx
|
|
mov bx,cx
|
|
shr bx,8
|
|
and bx,15
|
|
mov al,[hex_characters + bx]
|
|
push cx
|
|
call print_character
|
|
pop cx
|
|
mov bx,cx
|
|
shr bx,4
|
|
and bx,15
|
|
mov al,[hex_characters + bx]
|
|
push cx
|
|
call print_character
|
|
pop cx
|
|
mov bx,cx
|
|
and bx,15
|
|
mov al,[hex_characters + bx]
|
|
call print_character
|
|
popa
|
|
ret
|
|
|
|
; preserves registers
|
|
print_newline:
|
|
pusha
|
|
mov al,10
|
|
call print_character
|
|
popa
|
|
ret
|
|
|
|
initialize_io:
|
|
; Get drive parameters.
|
|
mov ah,0x08
|
|
mov dl,[drive_number]
|
|
xor di,di
|
|
int 0x13
|
|
jc error_io_fatal
|
|
and cx,31
|
|
mov [max_sectors],cx
|
|
inc dh
|
|
shr dx,8
|
|
mov [max_heads],dx
|
|
|
|
; Load the filesystem header.
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov di,1
|
|
mov bx,FS_HEADER_BUFFER
|
|
call read_sector
|
|
jc error_io_fatal
|
|
|
|
; Check for correct signature and version.
|
|
mov ax,[FS_HEADER_BUFFER]
|
|
cmp ax,0x706C
|
|
jne error_io_fatal
|
|
mov ax,[FS_HEADER_BUFFER + 2]
|
|
cmp ax,1
|
|
jne error_io_fatal
|
|
|
|
ret
|
|
|
|
; di - LBA.
|
|
; es:bx - buffer
|
|
; returns carry set on error
|
|
read_sector:
|
|
xor si,si
|
|
jmp access_sector
|
|
|
|
; di - LBA.
|
|
; es:bx - buffer
|
|
; returns carry set on error
|
|
write_sector:
|
|
mov si,1
|
|
jmp access_sector
|
|
|
|
; di - LBA.
|
|
; es:bx - buffer
|
|
; si - 1 to write, 0 to read
|
|
; returns carry set on error
|
|
access_sector:
|
|
mov byte [read_attempts],5
|
|
|
|
.try_again:
|
|
|
|
mov al,[read_attempts]
|
|
or al,al
|
|
jz .error
|
|
dec byte [read_attempts]
|
|
|
|
; Calculate cylinder and head.
|
|
mov ax,di
|
|
xor dx,dx
|
|
div word [max_sectors]
|
|
xor dx,dx
|
|
div word [max_heads]
|
|
push dx ; remainder - head
|
|
mov ch,al ; quotient - cylinder
|
|
shl ah,6
|
|
mov cl,ah
|
|
|
|
; Calculate sector.
|
|
mov ax,di
|
|
xor dx,dx
|
|
div word [max_sectors]
|
|
inc dx
|
|
or cl,dl
|
|
|
|
; Access the sector.
|
|
pop dx
|
|
mov dh,dl
|
|
mov dl,[drive_number]
|
|
push si
|
|
or si,si
|
|
jz .read
|
|
mov ax,0x0301
|
|
int 0x13
|
|
jmp .done_int
|
|
.read:
|
|
mov ax,0x0201
|
|
int 0x13
|
|
.done_int:
|
|
pop si
|
|
jc .try_again
|
|
|
|
clc
|
|
ret
|
|
.error:
|
|
stc
|
|
ret
|
|
|
|
; preserves bx, cx, dx, di, bp
|
|
start_reading_root_directory:
|
|
mov word [ROOT_HANDLE + 0],0xFFFF ; position in root directory (invalid)
|
|
mov ax,[FS_HEADER_BUFFER + 12 + 16]
|
|
mov [ROOT_HANDLE + 2],ax ; file size (low)
|
|
mov ax,[FS_HEADER_BUFFER + 12 + 18]
|
|
mov [ROOT_HANDLE + 4],ax ; file size (high)
|
|
mov word [ROOT_HANDLE + 6],0 ; offset into sector
|
|
mov ax,[FS_HEADER_BUFFER + 12 + 20]
|
|
mov [ROOT_HANDLE + 8],ax ; current sector
|
|
mov ax,1
|
|
mov [ROOT_HANDLE + 10],ax ; access mode
|
|
mov si,ROOT_HANDLE
|
|
pusha
|
|
call read_first_file_sector
|
|
popa
|
|
ret
|
|
|
|
; si - zero-terminated filename
|
|
; dx - 1 for read mode, 2 for write mode, 3 for append mode
|
|
; read/append fails if file doesn't exist, write creates or truncates
|
|
; returns file handle in si, or 0xFFFF if not found/on error
|
|
open_file:
|
|
; Check the filename is between 1 and 15 bytes.
|
|
mov di,si
|
|
.check_length:
|
|
lodsb
|
|
or al,al
|
|
jz .got_length
|
|
jmp .check_length
|
|
.got_length:
|
|
mov cx,si
|
|
sub cx,di
|
|
cmp cx,16
|
|
ja .error
|
|
or cx,cx
|
|
jz .error
|
|
mov [.name_length],cx
|
|
mov [.name],di
|
|
mov [.access_mode],dx
|
|
|
|
; Setup the last file handle for reading the root directory.
|
|
call start_reading_root_directory
|
|
jc .error
|
|
|
|
mov word [.first_unused],0xFFFF
|
|
|
|
; Loop through each entry of the root directory.
|
|
.directory_loop:
|
|
mov ax,[ROOT_HANDLE + 8]
|
|
mov [.previous_sector],ax
|
|
mov si,ROOT_HANDLE
|
|
mov cx,0x20
|
|
mov bx,ds
|
|
mov es,bx
|
|
mov di,.directory_entry
|
|
call read_file
|
|
cmp cx,0x20
|
|
jb .not_found
|
|
call has_error_file
|
|
jc .error
|
|
|
|
; Is the entry in use?
|
|
cmp byte [.directory_entry],0
|
|
jne .in_use
|
|
mov ax,[FS_HEADER_BUFFER + 12 + 16]
|
|
sub ax,[ROOT_HANDLE + 2]
|
|
sub ax,0x20 ; ...since the file pointer is now one past this entry
|
|
and ax,0x1FF
|
|
mov [.first_unused],ax
|
|
mov ax,[.previous_sector]
|
|
mov [.first_unused_sector],ax
|
|
jmp .directory_loop
|
|
|
|
; Compare the filenames.
|
|
.in_use:
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov cx,[.name_length]
|
|
mov si,[.name]
|
|
mov di,.directory_entry
|
|
rep cmpsb
|
|
jne .directory_loop
|
|
|
|
; Calculate the position of the file in the root directory.
|
|
; The root directory cannot exceed 64KB, so we ignore the high file size.
|
|
mov ax,[FS_HEADER_BUFFER + 12 + 16]
|
|
sub ax,[ROOT_HANDLE + 2]
|
|
sub ax,0x20 ; ...since the file pointer is now one past this entry
|
|
|
|
; Check the file isn't already open, and note the first available handle.
|
|
mov cx,MAX_OPEN_FILES
|
|
mov si,open_file_table
|
|
mov di,0xFFFF
|
|
.check_not_open_loop:
|
|
cmp word [si + 10],0
|
|
je .not_in_use
|
|
cmp [si + 0],ax
|
|
je .error ; already open
|
|
jmp .next_open_check
|
|
.not_in_use:
|
|
mov di,si
|
|
.next_open_check:
|
|
add si,DATA_PER_OPEN_FILE
|
|
loop .check_not_open_loop
|
|
|
|
; Were there any available handles?
|
|
cmp di,0xFFFF
|
|
je .error
|
|
|
|
; Save the file information to the handle table.
|
|
mov [di + 0],ax ; position in root directory
|
|
mov ax,[.directory_entry + 16]
|
|
mov [di + 2],ax ; file size low
|
|
mov ax,[.directory_entry + 18]
|
|
mov [di + 4],ax ; file size high
|
|
mov word [di + 6],0 ; offset into sector
|
|
mov ax,[.directory_entry + 20]
|
|
mov [di + 8],ax ; current sector
|
|
|
|
mov si,di
|
|
|
|
; If opening the file in write or delete mode, truncate the file.
|
|
cmp word [.access_mode],FILE_READ
|
|
je .not_truncate
|
|
cmp word [.access_mode],FILE_RENAME
|
|
je .not_truncate
|
|
cmp word [.access_mode],FILE_APPEND
|
|
je .not_truncate
|
|
mov ax,[si + 2]
|
|
or ax,[si + 4]
|
|
or ax,ax
|
|
jz .not_truncate ; the file size is zero, no need to truncate
|
|
xor ax,ax
|
|
mov [si + 2],ax ; file size = 0
|
|
mov [si + 4],ax
|
|
mov ax,[si + 8]
|
|
push si
|
|
xor dx,dx
|
|
cmp word [.access_mode],FILE_DELETE
|
|
je .truncate_all
|
|
inc dx
|
|
.truncate_all:
|
|
call free_file_sectors
|
|
pop si
|
|
jc .error
|
|
.not_truncate:
|
|
|
|
; If opening the file in append mode, seek to the end of the file.
|
|
cmp word [.access_mode],FILE_APPEND
|
|
jne .not_append
|
|
mov cx,[si + 2]
|
|
shr cx,9
|
|
mov dx,[si + 4]
|
|
shl dx,7
|
|
or cx,dx
|
|
.seek_loop:
|
|
or cx,cx
|
|
jz .seek_done
|
|
push cx
|
|
push si
|
|
xor cx,cx ; we read the sector in read_first_file_sector below
|
|
call read_next_file_sector
|
|
pop si
|
|
pop cx
|
|
jc .error
|
|
dec cx
|
|
jmp .seek_loop
|
|
.seek_done:
|
|
mov cx,[si + 2]
|
|
and cx,511
|
|
mov [si + 6],cx
|
|
.not_append:
|
|
|
|
; If reading or appending, load the current sector.
|
|
cmp word [.access_mode],FILE_WRITE
|
|
je .skip_load_current_sector
|
|
cmp word [.access_mode],FILE_RENAME
|
|
je .skip_load_current_sector
|
|
cmp word [.access_mode],FILE_DELETE
|
|
je .skip_load_current_sector
|
|
push si
|
|
call read_first_file_sector
|
|
pop si
|
|
jc .error
|
|
.skip_load_current_sector:
|
|
|
|
; Return the file handle.
|
|
mov ax,[.access_mode]
|
|
mov [si + 10],al ; access mode
|
|
mov al,[.directory_entry + 23]
|
|
mov [si + 11],al ; checksum
|
|
ret
|
|
|
|
; The file was not found.
|
|
.not_found:
|
|
cmp word [.access_mode],FILE_READ
|
|
je .error
|
|
cmp word [.access_mode],FILE_RENAME
|
|
je .error
|
|
cmp word [.access_mode],FILE_DELETE
|
|
je .error
|
|
|
|
; Have we seen an unused entry to put the file in?
|
|
mov ax,[.first_unused]
|
|
cmp ax,0xFFFF
|
|
je .append_entry
|
|
mov ax,[.first_unused_sector]
|
|
mov [ROOT_HANDLE + 8],ax
|
|
call read_first_file_sector
|
|
mov bx,[.first_unused]
|
|
jmp .create_entry
|
|
|
|
.append_entry:
|
|
|
|
; Is there room in the last sector of the directory?
|
|
mov bx,[ROOT_HANDLE + 6]
|
|
cmp bx,0x200
|
|
jne .grown
|
|
mov si,ROOT_HANDLE
|
|
call grow_file
|
|
mov bx,[ROOT_HANDLE + 6]
|
|
or bx,bx
|
|
jnz error_unknown
|
|
.grown:
|
|
|
|
; Update the root directory's size in the header sector.
|
|
push bx
|
|
add word [FS_HEADER_BUFFER + 12 + 16],0x20
|
|
mov di,1
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov bx,FS_HEADER_BUFFER
|
|
call write_sector
|
|
pop bx
|
|
jc .error
|
|
|
|
; Create the new entry.
|
|
.create_entry:
|
|
add bx,OPEN_FILE_BUFFER + SECTOR_SIZE * 7
|
|
call create_directory_entry
|
|
jc .error
|
|
|
|
; Save the directory.
|
|
mov di,[ROOT_HANDLE + 8]
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov bx,OPEN_FILE_BUFFER + SECTOR_SIZE * 7
|
|
call write_sector
|
|
jc .error
|
|
|
|
jmp .retry
|
|
|
|
; Try to open the file again.
|
|
.retry:
|
|
mov si,[.name]
|
|
mov dx,[.access_mode]
|
|
jmp open_file
|
|
|
|
.error:
|
|
mov si,0xFFFF
|
|
ret
|
|
|
|
.directory_entry: times 0x20 db 0
|
|
.name_length: dw 0
|
|
.name: dw 0
|
|
.access_mode: dw 0
|
|
.first_unused: dw 0
|
|
.first_unused_sector: dw 0
|
|
.previous_sector: dw 0
|
|
|
|
; ax - first sector
|
|
; dx - the new table value for the first sector (i.e. 0 frees the whole file, 1 frees all but the first sector)
|
|
; carry set on error
|
|
free_file_sectors:
|
|
; Switch the sector table.
|
|
mov bx,ax
|
|
shr ax,8
|
|
push bx
|
|
push dx
|
|
call switch_sector_table
|
|
pop dx
|
|
pop bx
|
|
jc .done
|
|
|
|
; Write the updated entry.
|
|
and bx,255
|
|
shl bx,1
|
|
mov ax,[SECTOR_TABLE_BUFFER + bx]
|
|
mov [SECTOR_TABLE_BUFFER + bx],dx
|
|
mov byte [sector_table_modified],1
|
|
|
|
; Free the next sector.
|
|
xor dx,dx
|
|
cmp ax,1
|
|
jne free_file_sectors
|
|
clc
|
|
.done: ret
|
|
|
|
; bx - destination
|
|
; carry set on error
|
|
create_directory_entry:
|
|
mov ax,ds
|
|
mov es,ax
|
|
|
|
; Clear the entry.
|
|
mov cx,0x20
|
|
xor al,al
|
|
mov di,bx
|
|
rep stosb
|
|
|
|
; Save the file name.
|
|
mov si,[open_file.name]
|
|
mov cx,[open_file.name_length]
|
|
mov di,bx
|
|
rep movsb
|
|
|
|
; Allocate the first sector.
|
|
push bx
|
|
call allocate_sector ; sets carry on error (returned)
|
|
pop bx
|
|
mov [bx + 20],ax
|
|
ret
|
|
|
|
; returns allocated sector in ax
|
|
; carry set if disk full or error
|
|
allocate_sector:
|
|
; Search the currently loaded table sector.
|
|
cmp byte [current_sector_table],0xFF
|
|
je .skip_initial_search
|
|
call .search_table_sector
|
|
jnc .done
|
|
|
|
; Try other table sectors.
|
|
.skip_initial_search:
|
|
mov byte [.current_search_table],0
|
|
.table_loop:
|
|
mov al,[.current_search_table]
|
|
call switch_sector_table
|
|
jc .error
|
|
call .search_table_sector
|
|
jnc .done
|
|
.next_table:
|
|
mov ax,[FS_HEADER_BUFFER + 8]
|
|
dec ax
|
|
mov bl,[.current_search_table]
|
|
cmp al,bl
|
|
je .error
|
|
inc bl
|
|
mov [.current_search_table],bl
|
|
jmp .table_loop
|
|
|
|
.error:
|
|
stc
|
|
ret
|
|
|
|
.current_search_table: db 0
|
|
|
|
; Search the loaded sector table sector for a free sector.
|
|
.search_table_sector:
|
|
mov cx,256 ; 512 byte sector, 2 bytes per entry
|
|
mov bx,SECTOR_TABLE_BUFFER
|
|
.search_loop:
|
|
cmp word [bx],0
|
|
jz .search_found
|
|
add bx,2
|
|
loop .search_loop
|
|
stc
|
|
ret
|
|
|
|
; Update the table.
|
|
.search_found:
|
|
mov ax,bx
|
|
shr ax,1
|
|
mov ah,[current_sector_table]
|
|
mov word [bx],1 ; end of file
|
|
mov byte [sector_table_modified],1
|
|
ret
|
|
|
|
.done:
|
|
ret
|
|
|
|
; sets carry on error
|
|
save_sector_table:
|
|
cmp byte [sector_table_modified],0
|
|
je .done
|
|
mov byte [sector_table_modified],0
|
|
xor ah,ah
|
|
mov al,[current_sector_table]
|
|
mov di,ax
|
|
add di,2
|
|
mov ax,ds
|
|
mov es,ax
|
|
mov bx,SECTOR_TABLE_BUFFER
|
|
jmp write_sector
|
|
.done: ret
|
|
|
|
; si - file handle
|
|
; carry set on error
|
|
flush_current_sector:
|
|
call get_file_buffer_offset
|
|
mov di,[si + 8] ; current sector
|
|
mov ax,ds
|
|
mov es,ax
|
|
jmp write_sector
|
|
|
|
; si - file handle
|
|
close_file:
|
|
; Were we writing to this file?
|
|
cmp byte [si + 10],FILE_READ
|
|
je .done
|
|
|
|
; Don't flush the file if we only opened it to rename or delete it.
|
|
cmp byte [si + 10],FILE_RENAME
|
|
je .skip_flush
|
|
cmp byte [si + 10],FILE_DELETE
|
|
je .skip_flush
|
|
|
|
; We need to flush the file.
|
|
push si
|
|
call flush_current_sector
|
|
pop si
|
|
.skip_flush:
|
|
|
|
; Seek to the correct sector in the root directory.
|
|
mov cx,[si + 0] ; position in root directory
|
|
shr cx,9 ; get sector in root directory
|
|
push si
|
|
call start_reading_root_directory
|
|
jc .done
|
|
or cx,cx
|
|
jz .no_seek
|
|
.find_directory_entry_loop:
|
|
push cx
|
|
mov si,ROOT_HANDLE
|
|
call read_next_file_sector ; cx = 1 on last iteration, which loads sector
|
|
pop cx
|
|
jc .pop
|
|
loop .find_directory_entry_loop
|
|
.no_seek:
|
|
pop si
|
|
|
|
; Update the directory entry.
|
|
mov bx,[si + 0]
|
|
and bx,511 ; get position within root directory sector
|
|
mov cx,[si + 2] ; file size low
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 16],cx
|
|
mov cx,[si + 4] ; file size high
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 18],cx
|
|
mov cl,[si + 11] ; checksum
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 23],cl
|
|
|
|
; Rename the file, if necessary.
|
|
cmp byte [si + 10],FILE_RENAME
|
|
jne .skip_rename
|
|
mov ax,[next_filename_argument.name + 0]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 0],ax
|
|
mov ax,[next_filename_argument.name + 2]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 2],ax
|
|
mov ax,[next_filename_argument.name + 4]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 4],ax
|
|
mov ax,[next_filename_argument.name + 6]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 6],ax
|
|
mov ax,[next_filename_argument.name + 8]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 8],ax
|
|
mov ax,[next_filename_argument.name + 10]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 10],ax
|
|
mov ax,[next_filename_argument.name + 12]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 12],ax
|
|
mov ax,[next_filename_argument.name + 14]
|
|
mov [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 14],ax
|
|
.skip_rename:
|
|
|
|
; Delete the entry, if necessary.
|
|
cmp byte [si + 10],FILE_DELETE
|
|
jne .skip_delete
|
|
mov byte [bx + OPEN_FILE_BUFFER + SECTOR_SIZE * 7 + 0],0
|
|
.skip_delete:
|
|
|
|
; Write out the directory entry.
|
|
push si
|
|
mov si,ROOT_HANDLE
|
|
call flush_current_sector
|
|
|
|
; Finally, save the sector table (if it was modified).
|
|
call save_sector_table
|
|
|
|
.pop:
|
|
pop si
|
|
.done:
|
|
mov word [si + 10],0 ; clear access mode
|
|
ret
|
|
|
|
; si - file handle
|
|
; carry set if file handle has error flag set
|
|
; everything preserved
|
|
has_error_file:
|
|
test word [si + 10],FILE_ERROR
|
|
jz .no_error
|
|
stc
|
|
ret
|
|
.no_error:
|
|
clc
|
|
ret
|
|
|
|
; si - file handle (preserved)
|
|
; offset returned in bx
|
|
; additionally preserves di and es
|
|
get_file_buffer_offset:
|
|
mov ax,si
|
|
sub ax,open_file_table
|
|
mov cx,DATA_PER_OPEN_FILE
|
|
xor dx,dx
|
|
div cx
|
|
mov cx,0x200
|
|
mul cx
|
|
mov bx,OPEN_FILE_BUFFER
|
|
add bx,ax
|
|
ret
|
|
|
|
; si - file handle (preserved)
|
|
; cx - bytes to write
|
|
; es:di - source
|
|
; may set error flag on handle
|
|
write_file:
|
|
or cx,cx
|
|
jz .done
|
|
|
|
; Check error flag has not been set.
|
|
mov al,[si + 10]
|
|
test al,FILE_ERROR
|
|
jnz .done
|
|
|
|
; Get the file buffer to use.
|
|
push cx
|
|
call get_file_buffer_offset
|
|
mov dx,bx
|
|
pop cx
|
|
|
|
.loop:
|
|
|
|
; Work out how many bytes we can write this iteration.
|
|
; We are limited by the buffer size (a sector),
|
|
; and the amount of requested bytes to write.
|
|
mov ax,cx
|
|
mov bx,0x200
|
|
sub bx,[si + 6] ; offset into sector
|
|
cmp bx,ax ; is remaining data in buffer limiting?
|
|
ja .e1
|
|
mov ax,bx
|
|
.e1:
|
|
or ax,ax
|
|
jz .nothing_to_write
|
|
|
|
; Write data to the buffer.
|
|
mov bl,[si + 11] ; checksum
|
|
push cx
|
|
push si
|
|
push ax
|
|
mov cx,ax
|
|
mov si,[si + 6]
|
|
add si,dx
|
|
.write_loop:
|
|
mov al,[es:di]
|
|
mov [si],al
|
|
inc si
|
|
inc di
|
|
xor bl,al
|
|
loop .write_loop
|
|
pop ax
|
|
pop si
|
|
pop cx
|
|
mov [si + 11],bl
|
|
|
|
; Update position in buffer, file size and remaining bytes to read.
|
|
add [si + 6],ax
|
|
add [si + 2],ax
|
|
adc word [si + 4],0
|
|
sub cx,ax
|
|
|
|
.nothing_to_write:
|
|
; If we are at the end of the buffer, then write the sector and allocate the next.
|
|
cmp word [si + 6],0x200
|
|
jne .sector_unfinished
|
|
mov ax,es
|
|
push ax
|
|
push cx
|
|
push dx
|
|
push di
|
|
push si
|
|
call flush_current_sector
|
|
pop si
|
|
jc .flush_failed
|
|
call grow_file
|
|
.flush_failed:
|
|
pop di
|
|
pop dx
|
|
pop cx
|
|
pop es
|
|
jc .error
|
|
.sector_unfinished:
|
|
|
|
; Have we written all the requested data yet?
|
|
or cx,cx
|
|
jnz .loop
|
|
|
|
.done:
|
|
ret
|
|
.error:
|
|
or byte [si + 10],FILE_ERROR
|
|
jmp .done
|
|
|
|
; si - file handle (preserved)
|
|
; sets carry on error
|
|
grow_file:
|
|
; Allocate a new sector.
|
|
push si
|
|
call allocate_sector
|
|
pop si
|
|
jc .done
|
|
|
|
; Store the new sector.
|
|
mov bx,[si + 8] ; previous sector
|
|
mov [si + 8],ax ; current sector
|
|
|
|
; Link sector into file.
|
|
mov ax,bx
|
|
shr ax,8 ; sector table index
|
|
push si
|
|
push bx
|
|
call switch_sector_table
|
|
pop bx
|
|
pop si
|
|
jc .done
|
|
and bx,0xFF
|
|
mov ax,[si + 8]
|
|
shl bx,1
|
|
mov [bx + SECTOR_TABLE_BUFFER],ax
|
|
mov byte [sector_table_modified],1
|
|
jc .done
|
|
mov word [si + 6],0
|
|
|
|
clc
|
|
.done:
|
|
ret
|
|
|
|
; al - new sector table index
|
|
; sets carry on error
|
|
switch_sector_table:
|
|
cmp al,[current_sector_table]
|
|
je .skip_switch
|
|
|
|
; Save the previous sector table (if it was modified).
|
|
push ax
|
|
call save_sector_table
|
|
pop ax
|
|
mov [current_sector_table],al
|
|
|
|
; Load the new sector table buffer.
|
|
xor ah,ah
|
|
add ax,2
|
|
mov di,ax
|
|
mov bx,ds
|
|
mov es,bx
|
|
mov bx,SECTOR_TABLE_BUFFER
|
|
call read_sector
|
|
jc .error
|
|
|
|
.skip_switch:
|
|
clc
|
|
ret
|
|
|
|
.error:
|
|
mov byte [current_sector_table],0xFF
|
|
stc
|
|
ret
|
|
|
|
; si - file handle (preserved)
|
|
; cx - bytes to read
|
|
; es:di - destination
|
|
; returns bytes read in cx, may set error flag on handle
|
|
read_file:
|
|
mov word [.bytes_read],0
|
|
|
|
or cx,cx
|
|
jz .done
|
|
|
|
; Check error flag has not been set.
|
|
mov al,[si + 10]
|
|
cmp al,FILE_READ
|
|
jne .done
|
|
|
|
; Get the file buffer to use.
|
|
push cx
|
|
call get_file_buffer_offset
|
|
mov dx,bx
|
|
pop cx
|
|
|
|
.loop:
|
|
|
|
; Work out how many bytes we can read this iteration.
|
|
; We are limited by the buffer size (a sector),
|
|
; the amount of data left in the file,
|
|
; and the amount of requested bytes to read.
|
|
mov ax,cx
|
|
cmp word [si + 4],0 ; is high file remaining non-zero?
|
|
jne .e1
|
|
cmp word [si + 2],ax ; is low file remaining limiting?
|
|
ja .e1
|
|
mov ax,[si + 2]
|
|
.e1:
|
|
mov bx,0x200
|
|
sub bx,[si + 6] ; offset into sector
|
|
cmp bx,ax ; is remaining data in buffer limiting?
|
|
ja .e2
|
|
mov ax,bx
|
|
.e2:
|
|
|
|
; Read data from the buffer.
|
|
push cx
|
|
push si
|
|
mov cx,ax
|
|
mov si,[si + 6]
|
|
add si,dx
|
|
rep movsb
|
|
pop si
|
|
pop cx
|
|
|
|
; Update bytes read, position in buffer, remaining bytes in file and remaining bytes to read.
|
|
add [.bytes_read],ax
|
|
add [si + 6],ax
|
|
sub [si + 2],ax
|
|
sbb word [si + 4],0
|
|
sub cx,ax
|
|
|
|
; If we are at the end of the file, then exit.
|
|
cmp word [si + 2],0
|
|
jne .not_at_end
|
|
cmp word [si + 4],0
|
|
je .done
|
|
.not_at_end:
|
|
|
|
; If we are at the end of the buffer, then read the next sector.
|
|
cmp word [si + 6],0x200
|
|
jne .sector_unfinished
|
|
mov ax,es
|
|
push ax
|
|
push cx
|
|
push dx
|
|
push si
|
|
push di
|
|
mov cx,1
|
|
call read_next_file_sector
|
|
pop di
|
|
pop si
|
|
pop dx
|
|
pop cx
|
|
pop es
|
|
jc .error
|
|
mov word [si + 6],0
|
|
.sector_unfinished:
|
|
|
|
; Have we read all the requested data yet?
|
|
or cx,cx
|
|
jnz .loop
|
|
|
|
.done:
|
|
mov cx,[.bytes_read]
|
|
ret
|
|
.error:
|
|
or byte [si + 10],FILE_ERROR
|
|
jmp .done
|
|
.bytes_read: dw 0
|
|
|
|
; si - file handle
|
|
; carry set on error
|
|
read_first_file_sector:
|
|
call get_file_buffer_offset
|
|
mov di,[si + 8]
|
|
mov ax,ds
|
|
mov es,ax
|
|
jmp read_sector
|
|
|
|
; si - file handle
|
|
; cx - **1** if you want to read the sector
|
|
; carry set on error
|
|
read_next_file_sector:
|
|
push si
|
|
push cx
|
|
|
|
; Do we need to switch the sector table buffer?
|
|
mov ax,[si + 8] ; current sector
|
|
shr ax,8 ; 256 sector table entries per sector
|
|
call switch_sector_table
|
|
jc .error_table
|
|
|
|
pop cx
|
|
pop si
|
|
|
|
; Get the next sector.
|
|
mov bx,[si + 8] ; current sector
|
|
and bx,0xFF
|
|
shl bx,1
|
|
mov di,[SECTOR_TABLE_BUFFER + bx]
|
|
mov [si + 8],di
|
|
|
|
; If we're just seeking through the file, we don't need to read the sector.
|
|
cmp cx,1
|
|
jne .skip_load
|
|
|
|
; Load the next sector.
|
|
mov bx,ds
|
|
mov es,bx
|
|
call get_file_buffer_offset
|
|
jmp read_sector
|
|
|
|
.skip_load:
|
|
clc
|
|
ret
|
|
|
|
.error_table:
|
|
pop si
|
|
stc
|
|
ret
|
|
|
|
; --------------- Global state.
|
|
|
|
recover:
|
|
dw 0
|
|
|
|
first_free_string:
|
|
dw 0
|
|
first_free_object:
|
|
dw 0
|
|
obj_symbol_table:
|
|
dw 0
|
|
obj_builtins:
|
|
dw 0
|
|
gc_ready:
|
|
db 0
|
|
|
|
next_character:
|
|
dw 0
|
|
input_handle:
|
|
dw 0
|
|
input_line:
|
|
dw 0
|
|
input_offset:
|
|
dw 0
|
|
|
|
print_callback:
|
|
dw terminal_print_string
|
|
print_data:
|
|
dw 0
|
|
|
|
drive_number:
|
|
db 0
|
|
read_attempts:
|
|
db 0
|
|
max_sectors:
|
|
dw 0
|
|
max_heads:
|
|
dw 0
|
|
|
|
current_sector_table:
|
|
db 0xFF
|
|
sector_table_modified:
|
|
db 0
|
|
|
|
caret_column:
|
|
dw 1
|
|
caret_row:
|
|
dw 0
|
|
output_color:
|
|
dw (SCREEN_COLOR >> 8)
|
|
graphics_mode:
|
|
dw 0
|
|
|
|
user_input_start:
|
|
dw 0
|
|
previously_unmatched_brace:
|
|
dw 0
|
|
|
|
check_break:
|
|
db 0
|
|
last_scancode:
|
|
db 0
|
|
|
|
open_file_table:
|
|
times (MAX_OPEN_FILES * DATA_PER_OPEN_FILE) db 0
|
|
|
|
; --------------- Constants.
|
|
|
|
loading_message:
|
|
db 'initializing... ',0
|
|
hex_characters:
|
|
db '0123456789ABCDEF'
|
|
prompt_message:
|
|
db 10,'glip> ',0
|
|
unknown_type_message:
|
|
db '<??>',0
|
|
nil_message:
|
|
db 'nil',0
|
|
builtin_message:
|
|
db '<builtin:',0
|
|
lambda_message:
|
|
db '<lambda:',0
|
|
macro_message:
|
|
db '<macro:',0
|
|
close_sign_message:
|
|
db '>',0
|
|
string_quote_message:
|
|
db '"',0
|
|
list_start_message:
|
|
db '(',0
|
|
depth_limit_reached_message:
|
|
db '...)',0
|
|
list_end_message:
|
|
db ')',0
|
|
dot_message:
|
|
db ' . ',0
|
|
space_message:
|
|
db ' ',0
|
|
kilobytes_message:
|
|
db 'K',0
|
|
bytes_message:
|
|
db 'B',0
|
|
total_usage_message:
|
|
db 'Disk space usage: ',0
|
|
out_of_message:
|
|
db ' of ',0
|
|
memory_usage_message:
|
|
db 'Memory usage: ',0
|
|
|
|
startup_command:
|
|
db '(src "startup.lisp")',0
|
|
startup_command_length:
|
|
db 21
|
|
run_startup_command:
|
|
db 0
|
|
|
|
builtin_strings:
|
|
db 'nil',0
|
|
db '+',0
|
|
db '-',0
|
|
db '*',0
|
|
db '/',0
|
|
db 'mod',0
|
|
db '<',0
|
|
db '<=',0
|
|
db '>',0
|
|
db '>=',0
|
|
db 'is',0
|
|
db 'atom',0
|
|
db 'not',0
|
|
db 'and',0
|
|
db 'or',0
|
|
db 'car',0
|
|
db 'cdr',0
|
|
db 'cons',0
|
|
db 'setcar',0
|
|
db 'setcdr',0
|
|
db 'list',0
|
|
db 'do',0
|
|
db 'if',0
|
|
db 'while',0
|
|
db 'let',0
|
|
db '=',0
|
|
db 'q',0
|
|
db 'fun',0
|
|
db 'mac',0
|
|
db 'print',0
|
|
db 'print-col',0
|
|
db 'print-substr',0
|
|
db 'poke',0
|
|
db 'peek',0
|
|
db 'src',0
|
|
db 'read',0
|
|
db 'write',0
|
|
db 'append',0
|
|
db 'rename',0
|
|
db 'annul',0
|
|
db 'dir',0
|
|
db 'ls',0
|
|
db 'terminal',0
|
|
db 'strlen',0
|
|
db 'nth-char',0
|
|
db 'capture',0
|
|
db 'capture-upper',0
|
|
db 'capture-lower',0
|
|
db 'set-graphics',0
|
|
db 'wait-key',0
|
|
db 'muldiv',0
|
|
db 'env-reset',0
|
|
db 'env-list',0
|
|
db 'env-export',0
|
|
db 'env-import',0
|
|
db 'inspect',0
|
|
db 'pause',0
|
|
db 'last-scancode',0
|
|
db 'random',0
|
|
db 'outb',0
|
|
db 0
|
|
builtin_functions:
|
|
dw 0 ; nil
|
|
dw do_builtin_add
|
|
dw do_builtin_subtract
|
|
dw do_builtin_multiply
|
|
dw do_builtin_divide
|
|
dw do_builtin_modulo
|
|
dw do_builtin_lt
|
|
dw do_builtin_lte
|
|
dw do_builtin_gt
|
|
dw do_builtin_gte
|
|
dw do_builtin_is
|
|
dw do_builtin_atom
|
|
dw do_builtin_not
|
|
dw do_builtin_and
|
|
dw do_builtin_or
|
|
dw do_builtin_car
|
|
dw do_builtin_cdr
|
|
dw do_builtin_cons
|
|
dw do_builtin_setcar
|
|
dw do_builtin_setcdr
|
|
dw do_builtin_list
|
|
dw do_builtin_do
|
|
dw do_builtin_if
|
|
dw do_builtin_while
|
|
dw do_builtin_let
|
|
dw do_builtin_set
|
|
dw do_builtin_quote
|
|
dw do_builtin_lambda
|
|
dw do_builtin_macro
|
|
dw do_builtin_print
|
|
dw do_builtin_print_colored
|
|
dw do_builtin_print_substr
|
|
dw do_builtin_poke
|
|
dw do_builtin_peek
|
|
dw do_builtin_src
|
|
dw do_builtin_read
|
|
dw do_builtin_write
|
|
dw do_builtin_append
|
|
dw do_builtin_rename
|
|
dw do_builtin_delete
|
|
dw do_builtin_dir
|
|
dw do_builtin_ls
|
|
dw do_builtin_terminal
|
|
dw do_builtin_strlen
|
|
dw do_builtin_nth_char
|
|
dw do_builtin_capture
|
|
dw do_builtin_capture_upper
|
|
dw do_builtin_capture_lower
|
|
dw do_builtin_set_graphics
|
|
dw do_builtin_wait_key
|
|
dw do_builtin_muldiv
|
|
dw do_builtin_env_reset
|
|
dw do_builtin_env_list
|
|
dw do_builtin_env_export
|
|
dw do_builtin_env_import
|
|
dw do_builtin_inspect
|
|
dw do_builtin_pause
|
|
dw do_builtin_last_scancode
|
|
dw do_builtin_random
|
|
dw do_builtin_outb
|