![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to coact.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib|
Return to coact.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 root 1: /*
2: * coact(coexpr,value) - suspend current co-expression and activate
3: * coexpr with value.
4: *
5: * Outline:
6: * create procedure frame
7: * save sp and boundary in current co-expression stack header
8: * dereference result if it is local to co-expression
9: * change current stack to coexpr
10: * set activator in new co-expression stack header
11: * get sp and boundary from new co-expression stack header
12: * return value in new stack
13: */
14: Global(_boundary) /* Icon/C boundary */
15: Global(_current) /* current co-expression */
16: Global(_file) /* current file name */
17: Global(_line) /* current line number */
18: Global(_deref) /* dereference */
19: Global(_runerr) /* runtime error */
20: Global(_coact)
21:
22: #ifdef VAX
23: _coact:
24: Mask STDSV
25: calls $0,_setbound
26: subl2 $8,sp # Make room on stack for line and file
27: movl _line,-4(fp) # and put them in the frame
28: movl _file,-8(fp)
29: movl _current+4,r2 # r2 <- pointer to current stack header
30: movl sp,16(r2) # save the stack pointer,
31: movl ap,20(r2) # address pointer,
32: movl _boundary,24(r2)# and boundary for the current co-expression
33: # in its stack header
34: moval 8(ap),r4 # point r4 at coexp argument on stack
35: pushl r4 # and
36: calls $1,_deref # dereference the co-expression
37: cmpl $D_ESTACK,(r4)+ # see if we indeed have a co-expression
38: # and if we don't, it's runnerr 118,
39: # "co-expression expected"
40: jeql f1
41: tstl -(r4) # back up to point at bogus co-expression
42: pushl r4 # and call runerr with the bogon as
43: pushl $118 # its argument
44: calls $2,_runerr
45:
46: f1:
47: movl (r4)+,r3 # point r3 at the co-expression stack header
48: movl $D_ESTACK,4(r3) # create the descriptor for the activator
49: movl r2,8(r3) # (r2 has pointer to previously current
50: # co-expression, which is the activator)
51: movl r3,_current+4 # make the new co-expression current
52: movl 16(r3),sp # get stack pointer,
53: movl 20(r3),ap # address pointer,
54: movl 24(r3),fp # and frame pointer/boundary from header
55: movl fp,_boundary
56: movl 4(ap),r1 # get nargs in r1
57: movaq 8(ap)[r1],r0 # point r0 at target for result on stack,
58: movl r0,r1 # and save the pointer
59: movq (r4),(r1) # copy value from old stack to new
60: movl r1,r4 # point r4 at address of result on new stack
61: movl (r4),r1 # get type field of new result
62: bitl $F_NQUAL,r1 # if return value points into the old
63: jeql f11 # co-expression, then it needs
64: bitl $F_VAR,r1 # dereferencing
65: jeql f11
66: bitl $F_TVAR,r1
67: jneq f2
68: movl 4(r4),r1 # get pointer field of result into r1
69: jbr f3
70: f2:
71: bicl2 $~TYPEMASK,r1 # isolate type bits by turning off others
72: cmpl $T_TVSUBS,r1 # if we have a substring t.v., we have
73: jneq f11 # to dereference it.
74: movl 4(r4),r1 # point r1 at the string of the
75: movl 16(r1),r1 # trapped variable (cmt??)
76: f3:
77: cmpl r1,16(r2) # if pointer is between old sp and sbase,
78: jlss f11 # it needs dereferencing
79: cmpl r1,12(r2)
80: jgtr f11
81: pushl r4
82: calls $1,_deref # so, dereference it
83: f11:
84: movl -4(fp),_line # restore line number
85: movl -8(fp),_file # and file name
86: calls $0,_clrbound
87: ret # return. This return will use the dummy
88: # frame built above and we should land in
89: # first frame built above
90: #endif VAX
91: #ifdef PORT
92: DummyFcn(_coact)
93: #endif PORT
94: #ifdef PDP11
95: / coact(coexpr,value) - suspend current co-expression and activate
96: / coexpr with value.
97:
98: / NOTE: this code is highly dependent on stack frame layout.
99:
100: / Outline:
101: / create procedure frame
102: / save sp and boundary in current co-expression stack header
103: / dereference result if it is local to co-expression
104: / change current stack to coexpr
105: / set activator in new co-expression stack header
106: / get sp and boundary from new co-expression stack header
107: / return value in new stack
108:
109: / Register usage:
110: / r2: pointer to current co-expression stack header
111: / r3: pointer to new co-expression stack header
112: / r4: pointer to arguments to activate
113: / r5: procedure frame pointer
114: Global(csv) / save registers
115: Global(cret) / return as from C
116: _coact:
117: jsr r5,csv / create procedure frame
118: mov _line,(sp) / save current line number
119: mov _file,-(sp) / and file name
120: mov _current+2,r2 / r2 <- pointer to current stack header
121: mov sp,8.(r2) / save sp
122: mov _boundary,12.(r2) / save boundary
123: mov r5,r4 / r4 <- pointer to coexpr
124: add $6,r4
125: mov r4,-(sp) / dereference coexpr
126: jsr pc,_deref
127: tst (sp)+
128: cmp $D_ESTACK,(r4)+ / check type field of coexpr
129: beq 1f
130: tst -(r4)
131: mov r4,-(sp)
132: mov $118.,-(sp) / runerr 118 - co-expression expected
133: jsr pc,_runerr
134: 1:
135: mov (r4)+,r3 / r3 <- pointer to new stack header
136: mov $D_ESTACK,2(r3) / set activator field of new stack header
137: mov r2,4(r3)
138: mov r3,_current+2 / make new stack header current
139: mov 8.(r3),sp / get new sp
140: mov 12.(r3),r5 / get new r5 and
141: mov r5,_boundary / new boundary
142: mov 4(r5),r0 / r0 <- location of result on new stack
143: asl r0 / (r0 <- 6 + 4*nargs)
144: asl r0
145: add r5,r0
146: add $6,r0
147: mov r0,r1 / remember address of result on new stack
148: mov (r4)+,(r0)+ / copy value from old stack
149: mov (r4)+,(r0)
150: mov r1,r4 / r4 <- address of result on new stack
151: mov (r4), r1 / get type field of return value into r1
152: bit $F_NQUAL,r1 / if return value points into the old
153: beq 1f / co-expression, then it needs
154: bit $F_VAR,r1 / dereferencing
155: beq 1f
156: bit $F_TVAR,r1
157: bne 2f
158: mov 2(r4),r1 / get pointer field into r1
159: br 3f
160: 2:
161: bic $!TYPEMASK,r1 / check type code for substring t.v.
162: cmp $T_TVSUBS,r1 / if not, it doesn't need
163: bne 1f / dereferencing
164: mov 2(r4),r1 / get pointer field from b_tvsubs
165: mov 8.(r1),r1 / block into r1
166: 3:
167: cmp r1,8.(r2) / if pointer is between old
168: blo 1f / sp and sbase it needs
169: cmp r1,6.(r2) / dereferencing
170: bhi 1f
171: mov r4,(sp) / dereference it
172: jsr pc,_deref
173: tst (sp)+
174: 1:
175: mov -8.(r5),_line / restore line number
176: mov -10.(r5),_file / and file name
177: jmp cret / return in new stack
178: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.