![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to coret.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 coret.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 root 1: /*
2: * coret(coexpr,value) - suspend current co-expression and activate
3: * activator with value, without changing activator's activator.
4: *
5: * Outline:
6: * create procedure frame
7: * save sp and boundary in current co-expression stack header
8: * change current stack to coexpr
9: * get sp and boundary from new co-expression stack header
10: * return value in new stack
11: */
12: Global(_boundary) /* Icon/C boundary */
13: Global(_current) /* current co-expression */
14: Global(_file) /* current file name */
15: Global(_line) /* current line number */
16: Global(_deref) /* dereference */
17:
18: Global(_coret)
19: #ifdef VAX
20: _coret:
21: Mask STDSV
22: calls $0,_setbound
23: subl2 $8,sp # Make room on stack for line and file
24: movl _line,-4(fp) # and put them in the frame
25: movl _file,-8(fp)
26: movl _current+4,r2 # r2 <- pointer to current stack header
27: movl sp,16(r2) # save the stack pointer,
28: movl ap,20(r2) # address pointer,
29: movl _boundary,24(r2) # and boundary for the current co-expression
30: # in its stack header
31: movl ap,r4 # save ap for later use (to get the
32: # result that we were passed
33: movl 8(r2),r3 # r3 points to activator
34: movl r3,_current+4 # make new stack header current
35: movl 16(r3),sp # get new sp,
36: movl 20(r3),ap # ap,
37: movl 24(r3),fp # fp,
38: movl fp,_boundary # and boundary
39: movq 8(r4),16(ap) # copy arg0 of caller to our arg0, apparently
40: # because we have two fake arguments (?)
41: moval 16(ap),r4 # point r4 at our new result
42:
43: movl (r4),r1 # get type field of new result
44: bitl $F_NQUAL,r1 # if return value points into the old
45: jeql f1 # co-expression, then it needs
46: bitl $F_VAR,r1 # dereferencing
47: jeql f1
48: bitl $F_TVAR,r1
49: jneq f2
50: movl 4(r4),r1 # get pointer field of result into r1
51: jbr f3
52: f2:
53: bicl2 $~TYPEMASK,r1 # isolate type bits by turning off others
54: cmpl $T_TVSUBS,r1 # if we have a substring t.v., we have
55: jneq f1 # to dereference it.
56: movl 4(r4),r1 # point r1 at the string of the
57: movl 16(r1),r1 # trapped variable
58: f3:
59: cmpl r1,16(r2) # if pointer is between old sp and sbase,
60: jlss f1 # it needs dereferencing
61: cmpl r1,12(r2)
62: jgtr f1
63: pushl r4
64: calls $1,_deref # so, dereference it
65: f1:
66: movl -4(fp),_line # restore line number
67: movl -8(fp),_file # and file name
68: calls $0,_clrbound
69: ret # return. This return will use the dummy
70: # frame built above and we should land in
71: #endif VAX
72: #ifdef PORT
73: DummyFcn(_coret)
74: #endif PORT
75: #ifdef PDP11
76: / coret(coexpr,value) - suspend current co-expression and activate
77: / activator with value, without changing activator's activator.
78:
79: / NOTE: this code is highly dependent on stack frame layout.
80:
81: / Outline:
82: / create procedure frame
83: / save sp and boundary in current co-expression stack header
84: / change current stack to coexpr
85: / get sp and boundary from new co-expression stack header
86: / return value in new stack
87:
88: / Register usage:
89: / r2: pointer to current co-expression stack header
90: / r3: pointer to new co-expression stack header
91: / r4: pointer to arguments to activate
92: / r5: procedure frame pointer
93: Global(csv) / save registers
94: Global(cret) / return as from C
95:
96: _coret:
97: jsr r5,csv / create procedure frame
98: mov _line,(sp) / save current line number
99: mov _file,-(sp) / and file name
100: mov _current+2,r2 / r2 <- pointer to current stack header
101: mov sp,8.(r2) / save sp
102: mov _boundary,12.(r2) / save boundary
103: mov r5,r4 / r4 <- pointer to top of stack
104: mov 4(r2),r3 / r3 <- pointer to activator
105: mov r3,_current+2 / make new stack header current
106: mov 8.(r3),sp / get new sp
107: mov 12.(r3),r5 / get new r5 and
108: mov r5,_boundary / new boundary
109: mov 6(r4),10.(r5) / copy value from old stack
110: mov 8.(r4),12.(r5)
111: mov r5,r4 / r4 <- address of result on new stack
112: add $10.,r4
113: mov (r4), r1 / get type field of return value into r1
114: bit $F_NQUAL,r1 / if return value points into the old
115: beq 1f / co-expression, then it needs
116: bit $F_VAR,r1 / dereferencing
117: beq 1f
118: bit $F_TVAR,r1
119: bne 2f
120: mov 2(r4),r1 / get pointer field into r1
121: br 3f
122: 2:
123: bic $!TYPEMASK,r1 / check type code for substring t.v.
124: cmp $T_TVSUBS,r1 / if not, it doesn't need
125: bne 1f / dereferencing
126: mov 2(r4),r1 / get pointer field from b_tvsubs
127: mov 8.(r1),r1 / block into r1
128: 3:
129: cmp r1,8.(r2) / if pointer is between old
130: blo 1f / sp and sbase it needs
131: cmp r1,6.(r2) / dereferencing
132: bhi 1f
133: mov r4,-(sp) / dereference result
134: jsr pc,_deref
135: tst (sp)+
136: 1:
137: mov -8.(r5),_line / restore line number
138: mov -10.(r5),_file / and file name
139: jmp cret / return in new stack
140: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.