; BcplTricks.asm ; Copyright Xerox Corporation 1979 ; Last modified March 1, 1980 5:19 PM by Boggs callersFrame = 0 savedPC = 1 temp = 2 extraArguments = 3 getframe = 370 return = 366 .ent FrameSize, MyFrame .ent CallersFrame, FramesCaller .ent CallFrame, GotoFrame .ent CoCall, CoReturn .ent ReturnTo, ReturnFrom .ent GotoLabel, RetryCall .srel FrameSize: .FrameSize MyFrame: .MyFrame CallersFrame: .CallersFrame FramesCaller: .FramesCaller CallFrame: .CallFrame GotoFrame: .GotoFrame CoCall: .CoCall CoReturn: .CoReturn ReturnTo: .ReturnTo ReturnFrom: .ReturnFrom GotoLabel: .GotoLabel RetryCall: .RetryCall .nrel ; FrameSize(proc) returns the frame size required by proc. .FrameSize: sta 3 savedPC,2 mov 0 3 lda 0 2,3 jmp Done ; MyFrame() returns pointer to current fram. .MyFrame: mov 2 0 jmp 1,3 ; CallersFrame([f]) returns pointer to frame that calls f. ; Default f=current frame .CallersFrame: sta 3 savedPC,2 lda 1 0,3 ;get number of arguments snz 1 1 mov 2 0 ;use present frame mov 0 3 lda 0 callersFrame,3 jmp Done ; FramesCaller(foo) returns the address to which the caller of ; the frame foo sent control, provided that he made the call ; with a jsris or jsrii, and that there has been no monkey-business ; with the frame subsequently. ; If the call was not made with a jsris or jsrii it returns 0. ; If foo is omitted it defaults to the caller's frame. .FramesCaller: sta 3 savedPC,2 lda 1 0,3 snz 1 1 ; default the argument? mov 2 0 mov 0 3 ; 3 has frame in question lda 3 callersFrame,3 ; get frame of caller sta 3 temp,2 ; save the frame in temp ; compute the address of the jsrxx instruction, which is savedPC-1 lda 3 savedPC,3 ; find out what the opcode is lda 0 -1,3 lda 1 cLmask and 1 0 lda 1 opJsris se 0 1 jmp NotJsris ; calling instruction was jsris lda 0 -1,3 lda 3 temp,2 inc 3 3 ; bump to make look like pc. jmp FcFinishUp NotJsris: lda 1 opJsrii se 0 1 jmp NotJsrii ; calling instruction was jsrii lda 0 -1,3 FcFinishUp: lda 1 cRmask and 1 0 ; the next three instructions extend the sign of the address field, now in 0 inczr 1 1 andzl 0 1 sub 1 0 ; now add in the base (PC or frame) specified by the opcode add 0 3 ; address of word +1 lda 0, @-1,3 ; go indirect through static locn jmp Done NotJsrii: mkzero 0 0 ; return zero if can't recognize opcode jmp Done cLmask: 177400 cRmask: 377 opJsris: jsris 0 opJsrii: jsrii . ; CallFrame(destframe[, arg 1[, arg 2]]) ; Sends control to the specified frame and links it back to this one. .CallFrame: sta 3 savedPC,2 mov 0 3 sta 2 callersFrame,3 Callf1: mov 1 0 lda 1 extraArguments,2 Callf2: mov 3 2 Done: lda 3 savedPC,2 jmp 1,3 ; GotoFrame(destframe[, arg 1[, arg 2]]) ; Just like CallFrame, but doesn't plant the return link. ; This is like Mesa's transfer. .GotoFrame: sta 3 savedPC,2 mov 0 3 jmp Callf1 ; CoCall(a, b) = CallFrame(MyFrame()>>F.callersFrame, a, b) .CoCall: sta 3 savedPC,2 lda 3 callersFrame,2 sta 2 callersFrame,3 jmp Callf2 ; CoReturn(a, b) ; Just like CoCall, but doesn't plant the return link .CoReturn: sta 3 savedPC,2 lda 2 callersFrame,2 jmp Done ; ReturnTo(label) ; Does a return to the specified label .ReturnTo: lda 2 callersFrame,2 mov 0 3 jmp 0,3 ; GotoLabel(frame, label, v) ; Sends control to the specified label in the specified frame, ; and passes v in AC0 .GotoLabel: mov 0 3 lda 0 extraArguments,2 mov 3 2 mov 1 3 jsr 0,3 ;in case proc head, must find #args in @ac3 1 ; RetryCall(p1, p2) ; Repeats the call which appears to have given control to the caller ; of RetryCall with p1 and p2 as the first two arguments, and the other ; arguments unchanged .RetryCall: nop lda 2 callersFrame,2 lda 3 savedPC,2 jmp -1,3 ; ReturnFrom(fnOrFrame, v) ; Looks for a frame f which is either equal to fnOrFrame, ; or has FramesCaller(f) equal to fnOrFrame. It then cuts back ; the stack to f and simulates a return from f with v as the value. ; If it runs into trouble it returns 0 ; local variables for this routine fnOrFrame = 4 v = 5 nextFrame = 6 count = 7 .ReturnFrom: sta 3 savedPC,2 jsr @getframe count+1 nop lda 0 cRmask sta 0 count,2 mov 2 3 ; the frame we just looked at is in 3 RfLoop: lda 0 callersFrame,3 ; if we've looked at too many frames, give up dsz count 2 ; if the next frame is 0, give up snz 0 0 jmp RfFailed ; if the next frame is equal to the last one, give up sne 0 3 jmp RfFailed sta 0 nextFrame,2 ; is the next frame equal to fnOrFrame? lda 1 fnOrFrame,2 sne 0 1 jmp FoundFrame ; is its caller equal to fnOrFrame? jsr .FramesCaller 1 lda 1 fnOrFrame,2 sne 0 1 jmp FoundFrame ; it's not the one we want; charge on lda 3 nextFrame,2 jmp RfLoop FoundFrame: lda 0 v,2 lda 2 nextFrame,2 lda 2 callersFrame,2 ;get his caller (return FROM him) jmp Done RfFailed: mkzero 0 0 jsr @return .end