![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pret.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 pret.s CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / lib |
1.1 ! root 1: #include "../h/config.h" ! 2: /* ! 3: * pret - returns a value from an Icon procedure. pret takes ! 4: * a single argument which is the value to return. The real ! 5: * work is in figuring out whether the return value needs to ! 6: * be dereferenced. ! 7: */ ! 8: ! 9: Global(_deref) /* Dereference a variable */ ! 10: Global(_rtrace) /* Return trace routine */ ! 11: Global(_boundary) /* Icon/C boundary address */ ! 12: Global(_current) /* Current expression stack */ ! 13: Global(_file) /* Current file name */ ! 14: Global(_k_level) /* Value of &level */ ! 15: Global(_k_trace) /* Value of &trace */ ! 16: Global(_line) /* Current line number */ ! 17: ! 18: Global(_pret) ! 19: #ifdef VAX ! 20: _pret: ! 21: Mask 0 # Don't need to save any registers because ! 22: # the current frame will be discarded. ! 23: movl fp,_boundary # The boundary is set because deref may ! 24: # cause garbage collection. ! 25: decl _k_level # A procedure is being exited, so &level ! 26: # must be decremented. ! 27: /* ! 28: * Calculate target address for return value in r11. ! 29: */ ! 30: # The frame of the caller is the procedure ! 31: # frame for the Icon procedure returning ! 32: movl 8(fp),r2 # a value. Put it's ap in r2. ! 33: # The return value will overwrite arg0, ! 34: # the address of arg0 is calculated via: ! 35: ashl $3,4(r2),r11 # r11 = 8 * nargs ! 36: addl2 $8,r11 # + 8 ! 37: addl2 r2,r11 # + ap ! 38: # Note that nargs and ap belong to the ! 39: # returning Icon procedure. ! 40: /* ! 41: * Dereference the return value if it is a local variable or an ! 42: * argument. ! 43: */ ! 44: # The return value is on the stack as ! 45: # an argument, put type field of return ! 46: movl 8(ap),r1 # value in r1 for testing. ! 47: bitl $F_NQUAL,r1 # If return value is a string, ! 48: beql chktrace # it doesn't need dereferencing. ! 49: bitl $F_VAR,r1 # If return value isn't a variable, ! 50: beql chktrace # it doesn't need dereferencing. ! 51: bitl $F_TVAR,r1 # If return value is a trapped variable, ! 52: bneq chktv # it requires some work. ! 53: movl 12(ap),r1 # Otherwise, get the address of the ! 54: jmp chkloc # data block for more testing. ! 55: ! 56: chktv: # A trapped variable is being returned, ! 57: # only substring trapped variables need ! 58: # dereferencing. ! 59: bicl2 $~TYPEMASK,r1 # "and" off all but bits in type field ! 60: cmpl $T_TVSUBS,r1 # If the variable isn't a substring t.v., ! 61: bneq chktrace # it doesn't need dereferencing. ! 62: movl 12(ap),r1 # Point r1 at data block for s.s.t.v. ! 63: movl 16(r1),r1 # Then at actual address of variable ! 64: chkloc: # ! 65: # See if the variable is on the stack. ! 66: # If it is, it will lie between the ! 67: # sp and the base of the current ! 68: # expression stack. r1 holds address ! 69: # of variable. ! 70: cmpl r1,sp # If address is below the sp, ! 71: blssu chktrace # it's not a local or an argument ! 72: movl _current+4,r0 # Point r0 at data block for current ! 73: # expression. ! 74: cmpl r1,12(r0) # Fourth word is the base of the stack ! 75: # for the current expression. If the ! 76: # variable address is above the stack ! 77: bgtru chktrace # base, it's not a local or an argument. ! 78: # Otherwise, it is a local or an argument ! 79: # and must be dereferenced. ! 80: pushal 8(ap) # Push address of return value ! 81: calls $1,_deref # and dereference it. ! 82: ! 83: /* ! 84: * Print trace message if &trace is set. ! 85: */ ! 86: chktrace: ! 87: tstl _k_trace # If &trace is zero, ! 88: beql tracedone # no tracing. ! 89: # Otherwise, set up to call rtrace ! 90: # with address of proc block and ! 91: # return value. ! 92: pushal 8(ap) # Push address of return value ! 93: pushl 4(r11) # Push address of procedure block ! 94: calls $2,_rtrace # rtrace(proc. block address,&return value) ! 95: ! 96: tracedone: # The descriptor for the procedure block ! 97: # (arg0) must be replaced by the descriptor ! 98: # of the return value. r11 points at the ! 99: movq 8(ap),(r11) # procedure block, so a movq does the trick. ! 100: /* ! 101: * Return from the Icon procedure. What this really does is to return ! 102: * via the frame built by invoke. Thus, the return below returns from ! 103: * the call to invoke. ! 104: */ ! 105: ! 106: movl 12(fp),fp # Get frame built by invoke on top of stack ! 107: movl -4(fp),_line # Restore _line, ! 108: movl -8(fp),_file # and _file from procedure block. ! 109: clrl _boundary # Reentering an Icon environment, so ! 110: # the boundary is cleared. ! 111: ret # Return. This is manifested as a ! 112: # return from invoke. ! 113: #endif VAX ! 114: ! 115: #ifdef PORT ! 116: DummyFcn(_pret) ! 117: #endif PORT ! 118: #ifdef PDP11 ! 119: / pret - return from an Icon procedure. ! 120: / Return value is argument to pret at 6(r5). ! 121: ! 122: / Register usage: ! 123: / r1: type or pointer field of returned value ! 124: / r2: returning procedure frame pointer ! 125: / r3: address of argument #0 (place-holder for returned value) ! 126: / r5: current procedure frame pointer ! 127: _pret: ! 128: mov r5,-(sp) / create new procedure frame ! 129: mov sp,r5 ! 130: mov r4,-(sp) ! 131: mov r3,-(sp) ! 132: mov r2,-(sp) ! 133: mov r5,_boundary / set Icon/C boundary ! 134: ! 135: / Decrement &level and calculate address of eventual return value. ! 136: ! 137: dec _k_level ! 138: mov (r5),r2 / compute address for ! 139: mov 4(r2),r3 / return value: ! 140: asl r3 / r3 = r2 + 6 + 4*nargs ! 141: asl r3 ! 142: add r2,r3 ! 143: add $6,r3 ! 144: ! 145: / Dereference return value if necessary. ! 146: ! 147: mov 6(r5),r1 / get type field of return value into r1 ! 148: bit $F_NQUAL,r1 / if return value is the ! 149: beq 1f / name of a local variable ! 150: bit $F_VAR,r1 / or argument, then it ! 151: beq 1f / needs dereferencing ! 152: bit $F_TVAR,r1 ! 153: bne 2f ! 154: mov 8.(r5),r1 / get pointer field into r1 ! 155: br 3f ! 156: 2: ! 157: bic $!TYPEMASK,r1 / check type code for substring t.v. ! 158: cmp $T_TVSUBS,r1 / if not, it doesn't need ! 159: bne 1f / dereferencing ! 160: mov 8.(r5),r1 / get pointer field from b_tvsubs ! 161: mov 8.(r1),r1 / block into r1 ! 162: 3: ! 163: cmp r1,sp / if pointer is between ! 164: blo 1f / sp and sbase, it is a local ! 165: mov _current+2,r0 / or an argument ! 166: cmp r1,6(r0) ! 167: bhi 1f ! 168: mov r5,-(sp) / dereference it ! 169: add $6,(sp) ! 170: jsr pc,_deref ! 171: tst (sp)+ ! 172: ! 173: / Print trace message if &trace is set. ! 174: ! 175: 1: ! 176: tst _k_trace ! 177: beq 1f ! 178: mov r5,-(sp) / push address of return value ! 179: add $6,(sp) ! 180: mov 2(r3),-(sp) / push pointer to procedure block ! 181: jsr pc,_rtrace / call rtrace; other arguments are in frame ! 182: cmp (sp)+,(sp)+ ! 183: ! 184: / Copy return value to the outer expression frame. ! 185: ! 186: 1: ! 187: mov r3,r1 / save r3 to pop stack to this point later ! 188: mov 6(r5),(r3)+ / move return value down from top of stack ! 189: mov 8.(r5),(r3) ! 190: ! 191: / Return. ! 192: ! 193: mov r2,r5 / restore old values of registers ! 194: mov r2,r0 ! 195: mov -(r0),r4 ! 196: mov -(r0),r3 ! 197: mov -(r0),r2 ! 198: mov -(r0),_line ! 199: mov -(r0),_file ! 200: mov r5,sp ! 201: mov (sp)+,r5 ! 202: mov (sp)+,r0 / pop return pc ! 203: mov r1,sp / pop stack to return value ! 204: clr _boundary / clear Icon/C boundary ! 205: jmp (r0) / return ! 206: #endif PDP11
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.