mirror of
https://github.com/samsonjs/sectorlisp.git
synced 2026-04-27 14:57:41 +00:00
Reduce size (498 bytes)
This commit is contained in:
parent
fea29b58a0
commit
6b5fbf22f0
1 changed files with 57 additions and 58 deletions
115
sectorlisp.S
115
sectorlisp.S
|
|
@ -23,7 +23,6 @@
|
||||||
// Compatible with the original hardware
|
// Compatible with the original hardware
|
||||||
|
|
||||||
.code16
|
.code16
|
||||||
.set a,-2-2
|
|
||||||
.globl _start
|
.globl _start
|
||||||
_start: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
|
_start: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
|
||||||
kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
|
kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
|
||||||
|
|
@ -38,43 +37,6 @@ kCdr: .asciz "CDR" # ordering matters
|
||||||
kCons: .asciz "CONS" # ordering matters
|
kCons: .asciz "CONS" # ordering matters
|
||||||
kEq: .asciz "EQ" # needs to be last
|
kEq: .asciz "EQ" # needs to be last
|
||||||
|
|
||||||
Read: call GetToken
|
|
||||||
call GetObject
|
|
||||||
ret
|
|
||||||
|
|
||||||
Define: call Read
|
|
||||||
push %ax
|
|
||||||
call Read
|
|
||||||
pop %di
|
|
||||||
call Cons
|
|
||||||
xchg %ax,%di
|
|
||||||
xchg %bp,%ax
|
|
||||||
call Cons
|
|
||||||
xchg %ax,%bp
|
|
||||||
jmp main
|
|
||||||
|
|
||||||
begin: mov $0x8000,%sp
|
|
||||||
push %cs
|
|
||||||
pop %ds
|
|
||||||
push %cs
|
|
||||||
pop %es
|
|
||||||
push %cs
|
|
||||||
pop %ss
|
|
||||||
mov $2,%bx
|
|
||||||
mov %sp,%cx
|
|
||||||
xor %bp,%bp
|
|
||||||
main: xor %dx,%dx
|
|
||||||
call Read
|
|
||||||
cmp $kDefine,%ax
|
|
||||||
je Define
|
|
||||||
mov %bp,%dx
|
|
||||||
call Eval
|
|
||||||
Catch: xchg %ax,%si
|
|
||||||
call PrintObject
|
|
||||||
mov $'\r',%al
|
|
||||||
call PutChar
|
|
||||||
jmp main
|
|
||||||
|
|
||||||
GetToken: # GetToken():al
|
GetToken: # GetToken():al
|
||||||
mov %cx,%di
|
mov %cx,%di
|
||||||
1: mov %dl,%al
|
1: mov %dl,%al
|
||||||
|
|
@ -153,12 +115,6 @@ Intern: push %cx # Intern(cx,di): ax
|
||||||
pop %cx
|
pop %cx
|
||||||
ret
|
ret
|
||||||
|
|
||||||
Undef: push %ax
|
|
||||||
mov $'?',%al
|
|
||||||
call PutChar
|
|
||||||
pop %ax
|
|
||||||
jmp Catch
|
|
||||||
|
|
||||||
GetChar:xor %ax,%ax # GetChar→al:dl
|
GetChar:xor %ax,%ax # GetChar→al:dl
|
||||||
int $0x16 # get keystroke
|
int $0x16 # get keystroke
|
||||||
PutChar:mov $0x0e,%ah # prints CP-437
|
PutChar:mov $0x0e,%ah # prints CP-437
|
||||||
|
|
@ -206,20 +162,6 @@ Gc: cmp %dx,%di # Gc(x:di,A:dx,B:si):ax
|
||||||
add %dx,%ax
|
add %dx,%ax
|
||||||
ret
|
ret
|
||||||
|
|
||||||
Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
|
|
||||||
1: test %si,%si
|
|
||||||
jns Undef
|
|
||||||
mov (%si),%di
|
|
||||||
mov (%bx,%si),%si
|
|
||||||
scasw
|
|
||||||
jne 1b
|
|
||||||
.byte 0xf6
|
|
||||||
Cadr: mov (%bx,%di),%di # contents of decrement register
|
|
||||||
.byte 0x3C # cmp §scasw,%al (nop next byte)
|
|
||||||
Cdr: scasw # increments our data index by 2
|
|
||||||
Car: mov (%di),%ax # contents of address register!!
|
|
||||||
2: ret
|
|
||||||
|
|
||||||
GetList:call GetToken
|
GetList:call GetToken
|
||||||
cmp $')',%al
|
cmp $')',%al
|
||||||
je .retF
|
je .retF
|
||||||
|
|
@ -274,6 +216,20 @@ Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):dx
|
||||||
.retT: mov $kT,%al
|
.retT: mov $kT,%al
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
|
||||||
|
1: test %si,%si
|
||||||
|
jns Undef
|
||||||
|
mov (%si),%di
|
||||||
|
mov (%bx,%si),%si
|
||||||
|
scasw
|
||||||
|
jne 1b
|
||||||
|
.byte 0xf6
|
||||||
|
Cadr: mov (%bx,%di),%di # contents of decrement register
|
||||||
|
.byte 0x3C # cmp §scasw,%al (nop next byte)
|
||||||
|
Cdr: scasw # increments our data index by 2
|
||||||
|
Car: mov (%di),%ax # contents of address register!!
|
||||||
|
2: ret
|
||||||
|
|
||||||
1: mov (%bx,%di),%di # di = Cdr(c)
|
1: mov (%bx,%di),%di # di = Cdr(c)
|
||||||
Evcon: push %di # save c
|
Evcon: push %di # save c
|
||||||
mov (%di),%si # di = Car(c)
|
mov (%di),%si # di = Car(c)
|
||||||
|
|
@ -315,6 +271,49 @@ Eval: test %ax,%ax # Eval(e:ax,a:dx):ax
|
||||||
pop %dx # restore a
|
pop %dx # restore a
|
||||||
1: ret
|
1: ret
|
||||||
|
|
||||||
|
Undef: push %ax
|
||||||
|
mov $'?',%al
|
||||||
|
call PutChar
|
||||||
|
pop %ax
|
||||||
|
jmp Catch
|
||||||
|
|
||||||
|
Read: call GetToken
|
||||||
|
call GetObject
|
||||||
|
ret
|
||||||
|
|
||||||
|
Define: call Read
|
||||||
|
push %ax
|
||||||
|
call Read
|
||||||
|
pop %di
|
||||||
|
call Cons
|
||||||
|
xchg %ax,%di
|
||||||
|
xchg %bp,%ax
|
||||||
|
call Cons
|
||||||
|
xchg %ax,%bp
|
||||||
|
jmp main
|
||||||
|
|
||||||
|
begin: mov $0x8000,%sp
|
||||||
|
push %cs
|
||||||
|
pop %ds
|
||||||
|
push %cs
|
||||||
|
pop %es
|
||||||
|
push %cs
|
||||||
|
pop %ss
|
||||||
|
mov $2,%bx
|
||||||
|
mov %sp,%cx
|
||||||
|
xor %bp,%bp
|
||||||
|
main: xor %dx,%dx
|
||||||
|
call Read
|
||||||
|
cmp $kDefine,%ax
|
||||||
|
je Define
|
||||||
|
mov %bp,%dx
|
||||||
|
call Eval
|
||||||
|
Catch: xchg %ax,%si
|
||||||
|
call PrintObject
|
||||||
|
mov $'\r',%al
|
||||||
|
call PutChar
|
||||||
|
jmp main
|
||||||
|
|
||||||
.sig: .fill 510 - (. - _start), 1, 0xce
|
.sig: .fill 510 - (. - _start), 1, 0xce
|
||||||
.word 0xAA55
|
.word 0xAA55
|
||||||
.type .sig,@object
|
.type .sig,@object
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue