sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-03-25 09:05:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #9 from peterferrie/main

Browse source 
shave some bytes (credits @peterferrie)
This commit is contained in:
agreppin 2021-11-02 14:47:02 +01:00 committed by GitHub
commit 1f066da3a1
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 42 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
sectorlisp.S
View file

@ -97,7 +97,6 @@ GetObject: # called just after GetToken
je GetList
mov $g_token,%si
.Intern:
mov %si,%bx # save s
mov $g_str,%di
xor %al,%al
0: mov $-1,%cl
@ -108,7 +107,7 @@ GetObject: # called just after GetToken
jne 1b
jmp 4f
2: pop %si # drop 1
mov %bx,%si # restore s
mov $g_token,%si
repne scasb
cmp (%di),%al
jne 0b
@ -122,6 +121,11 @@ GetObject: # called just after GetToken
adc %ax,%ax # ax = 2 * ax + carry
.ret: ret
.PutObject: # .PutObject(c:al,x:di)
call PutChar # preserves di
xchg %di,%ax
# jmp PrintObject
PrintObject: # PrintObject(x:ax)
test $1,%al
xchg %ax,%di
@ -151,10 +155,6 @@ PrintObject: # PrintObject(x:ax)
call .PutObject
4: mov $')',%al
jmp PutChar
.PutObject: # .PutObject(c:al,x:di)
call PutChar # preserves di
xchg %di,%ax
jmp PrintObject
GetChar:
xor %ax,%ax # get keystroke
@ -180,9 +180,7 @@ GetList:call GetToken
call GetObject
push %ax # save 1
call GetList
xchg %ax,%si
pop %di # restore 1
jmp Cons
jmp xCons
////////////////////////////////////////////////////////////////////////////////
@ -196,7 +194,8 @@ Evlis: cmp $NIL,%di # Evlis(m:di,a:dx):ax
pop %di # restore 1
push %ax # save 2
call Evlis
xchg %ax,%si
xCons: xchg %ax,%si
pop %di # restore 2
# jmp Cons
Cons: xchg %di,%ax
@ -228,6 +227,36 @@ Pairlis:cmp $NIL,%di # Pairlis(x:di,y:si,a:dx):ax
1: xchg %dx,%ax
ret
Evcon: push %di # save c
mov (%di),%di # di = Car(c)
mov (%di),%ax # ax = Caar(c)
push %dx # save a
call Eval
pop %dx # restore a
pop %di # restore c
cmp $NIL,%ax
jne 2f
mov 2(%di),%di # di = Cdr(c)
jmp Evcon
2: mov (%di),%di # di = Car(c)
.EvCadr:call Cadr # ax = Cadar(c)
# jmp Eval
Eval: test $1,%al # Eval(e:ax,a:dx):ax
jnz Assoc
xchg %ax,%di # di = e
mov (%di),%ax # ax = Car(e)
cmp $ATOM_QUOTE,%ax # maybe CONS
je Cadr
mov 2(%di),%di # di = Cdr(e)
cmp $ATOM_COND,%ax
je Evcon
.Ldflt2:push %ax # save 2
call Evlis # preserves dx
xchg %ax,%si
pop %ax # restore 2
# jmp Apply
Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
jnz .switch
xchg %ax,%di # di = fn
@ -270,39 +299,12 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
pop %si # restore x
jmp Apply
Eval: test $1,%al # Eval(e:ax,a:dx):ax
jnz Assoc
xchg %ax,%di # di = e
mov (%di),%ax # ax = Car(e)
cmp $ATOM_QUOTE,%ax # maybe CONS
je Cadr
mov 2(%di),%di # di = Cdr(e)
cmp $ATOM_COND,%ax
je Evcon
.Ldflt2:push %ax # save 2
call Evlis # preserves dx
xchg %ax,%si
pop %ax # restore 2
jmp Apply
Cadr: mov 2(%di),%di # contents of decrement register
mov (%di),%ax # contents of address register
ret
Evcon: push %di # save c
mov (%di),%di # di = Car(c)
mov (%di),%ax # ax = Caar(c)
push %dx # save a
call Eval
pop %dx # restore a
pop %di # restore c
cmp $NIL,%ax
jne 2f
mov 2(%di),%di # di = Cdr(c)
jmp Evcon
2: mov (%di),%di # di = Car(c)
.EvCadr:call Cadr # ax = Cadar(c)
jmp Eval
assoc1: mov 2(%si),%dx # dx = Cdr(y)
# jmp Assoc
Assoc: cmp $NIL,%dx # Assoc(x:ax,y:dx):ax
mov %dx,%si
@ -310,11 +312,9 @@ Assoc: cmp $NIL,%dx # Assoc(x:ax,y:dx):ax
mov (%si),%bx # bx = Car(y)
mov (%bx),%cx # cx = Caar(y)
cmp %cx,%ax
jne 1f
jne assoc1
mov 2(%bx),%ax # ax = Cdar(y)
ret
1: mov 2(%si),%dx # dx = Cdr(y)
jmp Assoc
.type .sig,@object;
.sig: