SUBROUTINE DOIT5
C
C	PURPOSE: EXECUTES UNCONDITIONAL TRANSFER OF CONTROL FUNCTIONS 
C	 "GTOa" TO "GSB(n)".
C
C	NOTE ON INDIRECT REGISTER REFERENCES:  FOR GSB(n) AND GTO(n) COMMANDS
C	 ABSOLUTE VALUE OF INTEGER PART OF CONTENTS IN REGISTER n ARE USED.
C	 IF # IN REGISTER n = 0, PROGRAM DOES NOT BRANCH.  IF # IN n .NE. 0,
C	 SEARCH BEGINS AT CURRENT PROGRAM STEP FOR THE CORRESPONDING
C	 "LBL" ENTRY.  THIS IS IN SHARP CONTRAST TO THE HP67 EXECUTION
C	 OF INDIRECT GTO AND GSB INSTRUCTIONS !!!  IN THE HP67, A NEGATIVE
C	 VALUE IN n IS INTERPRETTED  AS "RAPID REVERSE BRANCHING", WHICH
C	 IS NOT SUPPORTED IN THIS HP CALCULATOR EMULATOR.  TO IMPLEMENT
C	 RAPID REVERSE BRANCHING WOULD PROBABLY BE MUCH SLOWER THEN LABEL
C	 SEARCHING IN CURRENT DESIGN PHILOSPHY OF THIS PROGRAM.
C
C	SPECIAL NOTE ON SUBROUTINE LINKING:  SUBROUTINE RETURN POINTS ARE
C	 STORED AS A FIRST-IN LAST-OUT  STACK USING GENERAL STORAGE REGISTERS
C	 "R" IN TOP-DOWN FASHION.  EACH RETURN POINT IS STORED AS THE
C	 RESULT OF A "GSB" COMMAND WITH THE RETURN POINT BEING LOADED
C	 INTO FIRST FREE SPACE STARTING WITH R(256) (REGISTER 255) AND WORKING
C	 DOWN.  EACH RETURN POINT IS AN INTEGER PROGRAM COUNTER, THUS, 4 RETURN
C	 POINTS CAN BE STORED IN ONE DOUBLE PRECISION REGISTER R, AND IS
C	 REFERENCED BY INTEGER ARRAY "IRTN" EQUIVALENCED TO ARRAY "R".  "NEST"
C	 IN /FLAGS/ COMMON KEEPS TRACK OF THE SUBROUTINE NESTING LEVEL.  IF NEST
C	 IS NEGATIVE, NO RETURN POINTS ARE PENDING AND CONTROL REVERTS TO
C	 KEYBOARD. IF NEST IS >/= 0, NEST + 1 RETURN POINTS ARE PENDING.  SINCE
C	 NEST IS A BYTE VARIABLE, THIS MEANS THAT UP TO 128 RETURN POINTS MAY BE
C	 PENDING.  ONCE THIS IS EXCEEDED, HOWEVER, NEST GOES NEGATIVE AND
C	 CONTROL WILL RETURN TO KEYBOARD AT NEXT "RTN" INSTRUCTION.
C	 SINCE THE GENERAL STORAGE REGISTERS ARE USED, USER'S SHOULD
C	 AT LEAST AVOID USING R(256) (REGISTER 255)  WHICH WILL ALWAYS ALLOW
C	 4 RETURN POINTS TO BE CORRECTLY STORED (MAXIMUM NESTING LEVEL SUPPORTED
C	 BY HP CALCULATORS).  TO ALLOW MAXIMUM # RETURN POINTS PENDING AND
C	 AVOID ALL POSSIBLE PROBLEMS OF ADULTERATING DATA/PROGRAM COUNTERS, DO
C	 NOT USE REGISTER'S 224 TO 255 (EQUIVALENT TO R(225)-R(256)).
C
C	 THIS ROUTINE HANDLES GO TO SUBROUTINE INSTRUCTIONS BY INCREMENTING
C	 NEST AND PLACING CURRENT PROGRAM COUNTER INTO IRTN(1024-NEST).
C
C	SUBROUTINES REQUIRED:
C	 JUMPTO(TYPE,LABEL)
C		GIVEN TYPE OF LABEL TO SCAN FOR (TYPE=1 FOR ALPHA, TYPE=2 FOR
C		NUMERIC) AND BYTE VALUE CORRESPONDING TO THE LABEL WANTED, 
C		SEARCH STARTS FROM CURRENT PC.  IF FOUND, PC=NEXT STEP AFTER
C	 	"LBL" INSTRUCTION.  IF NOT FOUND, TYPE RETURNED =0 AND PC
C		REMAINS UNCHANGED.  NOTE ON NUMERIC LABELS: THE ACTUAL
C	 	LABEL # STORED WITH THE "LBL" COMMAND IS IN OFFSET BINARY FORM
C		SUCH THAT LABEL 0 ACTUALLY STORED INTERNALLY AS LABEL -128.
C		WHEN CALLING JUMPTO, MAKE SURE NUMERIC LABEL REQUESTED IS
C		IN THIS FORM.
C
C	SORENSON 2/81
C
	COMMON/FLAGS/STATE,ERROR,STKLFT,NEST,ANGLES,DIGITS,RADIX,FLAG(4)
	BYTE FLAG,STATE,ERROR,STKLFT,ANGLES,DIGITS,RADIX,NEST
	COMMON/COMAND/LENGTH,CMND(40)
	BYTE CMND
	COMMON/MEMORY/PC,P(1000)
	INTEGER PC
	BYTE P
	COMMON/STACK/X,Y,Z,T,XLST
	DOUBLE PRECISION X,Y,Z,T,XLST
	COMMON/REGS/R(256)
	DOUBLE PRECISION R
	EQUIVALENCE (IRTN,R)
	DIMENSION IRTN(1024)
	BYTE LABEL,TYPE
C
C	ALL FUNCTIONS PERFORMED HERE ENABLE STACK LIFT
C
	STKLFT=1
	LASTPC=PC
	LABEL=CMND(2)
	I=CMND(1)-12
	IF(I.LE.0.OR.I.GT.6)GO TO 8
	GOTO(10,30,20,10,30,20),I
C
C	CALLER MAD MISTAKE, COMMAND NOT HANDLED BY THIS ROUTINE.  RETURN
C	 ERROR -2 UNRECOGNIZED COMMAND
C
8	ERROR=-2
9	RETURN
C
C	GTO OR GSB TO ALPHA LABEL.
C
10	TYPE=1
	CALL JUMPTO(TYPE,LABEL)
C
C	CHECK IF LABEL FOUND; IF NO, RETURN ERROR -7
C
	IF(TYPE.EQ.0)GO TO 50
C
C	FOUND LABEL, IF DOING GSB FROM PROGRAM MEMORY SAVE RETURN POINT
C
	IF(STATE.LT.0.AND.I.EQ.4)GO TO 40
	RETURN
C
C	INDIRECT GTO OR GSB - FIRST FETCH LABEL AS ABSOLUTE VALUE OF INTEGER
C	IN REGISTER N (REGISTER # IN OFFSET BINARY FORM). NOTE: TO REFERENCE ANY
C	REGISTER, ARRAY SUBSCRIPT MUST BE REGISTER # +1, I.E. IF WANT REGISTER
C	0 (INTERNALLY CODED AS -128), SET J=1.
C
20	J=LABEL+129
	J=IABS(INT(SNGL(R(J))))
	IF(J.GE.0.AND.J.LT.256)GO TO 29
C
C	RETURN INDIRECT REGISTER REFERENCE ERROR
C
	ERROR=-5
	RETURN
C
C	REDEFINE LABEL LOOKING FOR
C
29	LABEL=J-128
C
C	GTO OR GSB TO NUMERIC LABEL -- OR SECOND HALF OF INDIRECT GTO/GSB
C
30	TYPE=2
	CALL JUMPTO(TYPE,LABEL)
C
C	IF NOT FOUND, RETURN ERROR -7
C
	IF(TYPE.EQ.0)GO TO 50
C
C	FOUND LABEL; IF DOING GO TO SUBROUTINE FROM PROGRAM MEMORY, SAVE 
C	RETURN POINT.
C
	IF(STATE.LT.0.AND.I.GT.4)GO TO 40
	RETURN
C
C	SAVE RETURN POINT.  IF NEST GOES NEGATIVE, SET IT TO -1 -- WILL
C	LOSE ALL PENDING RETURN POINTS
C
40	I=NEST+1
	IF(I.LE.127)GO TO 45
	NEST=-1
	RETURN
45	IRTN(1024-I)=LASTPC
	NEST=I
	RETURN
C
C	ERROR CATCHER, COULDN'T FIND LABEL
C
50	ERROR=-7
	RETURN
	END