1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
; copy s-exp into big (permanent) heap
; R0 = arg1
; big heap at 11000
; touches R0, R1, R2
copy:
005400 032710 BIT #1, (R0) ; test if cons or atom
005402 000001
005404 001016 BNE is_atom ; branch if atom
; otherwise it's cons:
005406 011046 MOV @R0, -(SP) ; save car to stack
005410 016000 MOV 2(R0), R0 ; arg1 <- cdr
005412 000002
005414 004737 JSR PC, @copy ; result <- copy(cdr)
005416 005400
005420 010001 MOV R0, R1 ; arg2 <- result
005422 012600 MOV (SP)+, R0 ; arg1 <- car from stack
005424 010146 MOV R1, -(SP) ; save arg2
005426 004737 JSR PC, @copy ; arg1 <- copy(car)
005430 005400
005432 012601 MOV (SP)+, R1 ; restore arg2
005434 004737 JSR PC, @big_cons ; allocate cons cell
005436 005600
005440 000207 RTS PC
is_atom:
005442 013702 MOV @#11000, R2 ; get free pointer
005444 011000
005446 010246 MOV R2, -(SP) ; save new atom start address
005450 010201 MOV R2, R1
005452 062701 ADD #3, R1
005454 000003
005456 010122 MOV R1, (R2)+ ; allocate atom tag and increment free pointer
005460 011000 MOV @R0, R0
005462 005300 DEC R0 ; get string address
005464 112022 MOVB (R0)+, (R2)+ ; copy one byte
005466 001376 BNE -4 ; if not null continue copying chars
005470 005202 INC R2 ; align free pointer
005472 042702 BIC #1, R2
005574 000001
005576 010237 MOV R2, @#11000 ; store new free pointer
005500 011000
005502 012600 MOV (SP)+, R0 ; result <- address of new atom
005504 000207 RTS PC
big_cons:
005600 013702 MOV @#11000, R2 ; get free pointer
005602 011000
005604 010012 MOV R0, @R2 ; move arg1 to car of new cons cell
005606 010162 MOV R1, 2(R2) ; move arg2 to cdr of new cons cell
005610 000002
005612 010200 MOV R2, R0 ; result <- new cons cell
005614 062702 ADD 4, R2 ; advance free pointer
005616 000004
005620 010237 MOV R2, @#11000 ; store new free pointer
005622 011000
005624 000207 RTS PC
|
