-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathifunlist.ppcs
137 lines (123 loc) · 4.96 KB
/
ifunlist.ppcs
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*-
;(include-header "aihead.s")
;(include-header "aistat.s")
;(include-header "ifunhead.s")
(comment "List Operations.")
;; |DoCar| and |DoCdr| are in IFUNCOM1.PPCS
(define-instruction |DoSetToCar| :operand-from-stack ()
(with-multiple-memory-reads (t9 t10 t11 t12)
;; (isettocar arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8)
(stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t)
(ANDI-DOT t2 arg5 192 "Save the old CDR code")
#+list-inline (car-internal arg5 arg6 set-to-car arg2 t5 t6 t7 t8 t)
#-list-inline (call-subroutine |CarInternal|)
(TagType arg5 arg5)
(OR arg5 arg5 t2 "Put back the original CDR codes")
(stack-write2 arg1 arg5 arg6)
(ContinueToNextInstruction)))
(define-instruction |DoSetToCdr| :operand-from-stack ()
(with-multiple-memory-reads (t9 t10 t11 t12)
;; (isettocdr arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8)
(stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t)
(ANDI-DOT t2 arg5 192 "Save the old CDR code")
#+list-inline (cdr-internal arg5 arg6 set-to-cdr arg2 t5 t6 t7 t8 t)
#-list-inline (call-subroutine |CdrInternal|)
(TagType arg5 arg5)
(OR arg5 arg5 t2 "Put back the original CDR codes")
(stack-write2 arg1 arg5 arg6)
(ContinueToNextInstruction)))
;; |DoSetToCdrPushCar| is in IFUNCOM1.PPCS
(define-procedure |SetToCdrPushCarLocative| ()
(label settocdrpushcarlocative)
(mov arg2 t2)
(using-multiple-memory-reads (t9 t10 t11 t12)
(memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t))
(TagType t1 t1)
(stack-push2-with-cdr arg5 arg6)
(OR t1 t1 t3 "Put back the original CDR codes")
(stack-write2 arg1 arg5 arg6)
(ContinueToNextInstruction))
;; |DoRplaca| and |DoRplacd| are in IFUNCOM2.PPCS
(define-instruction |DoAssoc| :operand-from-stack (:needs-tos t)
(carcdrloop (assoc arg3 arg4 t1 t2 arg5 arg6 arg2 assoccdr assocexc
t4 t5 t6 t7 t8 t9 t10 t11 t12)
(;; Loop top: nothing
)
(;; Loop body: look for alist element
(type-dispatch t1 t7 t8
(|TypeList|
(mov arg2 t2) ;MEM-READ can clobber its VMA arg
;; save/restore arg5/arg6 (the cdr) around memory-read
(mov t3 arg5)
(mov arg1 arg6)
(memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)
(TagType arg5 t5)
(mov arg5 t3)
(CMP 0 0 arg6 arg4)
(mov arg6 arg1)
(BC 4 2 assoccdr "Jump if data different")
(CMP 0 1 t5 arg3)
(BC 4 2 assoccdr "Jump if tags different")
(comment "we found a match!")
(TagType t1 t1)
(stack-write2 iSP t1 t2)
(ContinueToNextInstruction)) ;loop exit succeed
(|TypeNIL| ;skip this element
(B assoccdr))
(:else ;+++ should do spare list exception
(SetTag arg4 arg5 t1)
(illegal-operand assoc-list-element-not-list t1))))
(;; Loop step: nothing, macro automatically cdrs
)
(;; Loop end: return nil
(stack-write-nil iSP t1 t2 "Return NIL")
(ContinueToNextInstruction))))
(define-instruction |DoMember| :operand-from-stack (:needs-tos t)
(carcdrloop (member arg3 arg4 t1 t2 arg5 arg6 arg2 membercdr memberexc
t4 t5 t6 t7 t8 t9 t10 t11 t12)
(;; Loop top: remember list in t3/arg1
(TagType t1 t3)
(mov arg1 t2))
(;; Loop body: compare car
(TagType t1 t5)
(SUBF t7 t2 arg4 "t7=0 if data same")
(branch-if-nonzero t7 membercdr "J. if different")
(SUBF t6 t5 arg3 "t6 zero if same tag")
(branch-if-nonzero t6 membercdr "J. if tags different")
(comment "we found a match!")
(stack-write2 iSP t3 arg1)
(ContinueToNextInstruction))
(;; Loop step: nothing, macro automatically cdrs
)
(;; Loop end: return nil
(stack-write-nil iSP t1 t2 "Return NIL")
(ContinueToNextInstruction))))
(define-instruction |DoRgetf| :operand-from-stack (:needs-tos t)
(carcdrloop (rgetf arg3 arg4 t1 t2 arg5 arg6 arg2 rgetfcdr rgetfexc
t4 t5 t6 t7 t8 t9 t10 t11 t12)
(;; Loop top: nothing
)
(;; Loop body: compare car
(TagType t1 t5)
(SUBF t7 t2 arg4 "t7=0 if data same")
(branch-if-nonzero t7 rgetfcdr "J. if different")
(SUBF t6 t5 arg3 "t6 zero if same tag")
(branch-if-nonzero t6 rgetfcdr "J. if tags different")
(comment "we found a match!")
(TagType arg5 t1 "Strip CDR code")
(ADDI t5 t1 #.(- |type$K-NIL|) "t5=0 if end of list")
(branch-if-zero t5 rgetfexc "after all this effort we lose!")
(mov t2 arg6)
#+list-inline (car-internal arg5 arg6 rgetf arg2 t5 t6 t7 t8 t)
#-list-inline (call-subroutine |CarInternal|) ;cadr of init
(TagType arg5 arg5 "Strip the CDR code")
(stack-write2 iSP arg5 arg6) ;return value 1
(stack-push2 t1 t2 arg2 "Push the second result") ;cdr of init
(ContinueToNextInstruction))
(;; Loop step: cdr over value
CDR
)
(;; Loop end: return (values nil nil)
(stack-write-nil-and-push-nil iSP arg2 "Return NIL") ;fail exit
(ContinueToNextInstruction))))
(comment "Fin.")