File: CARRY.RA of Disk: V50/Source/Source-Listing-FORTRAN-2

(Source file text) 

---

	SECT	CARRY
/	 SUBROUTINE CARRY(OBJECT,WHERE)
/	 C
/	 C  START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
/	 C  LOCATION.  INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED.  IF OBJECT>100
/	 C  (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.
/	 C
/	 IMPLICIT INTEGER (A-Z)
/	 COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
/	 DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)
/	 C

	JA	#ST
#XR,	ORG	.+10
	TEXT	+CARRY+
#RET,	SETX	#XR
	SETB	#BASE
	JA	.+3
#BASE,	ORG	.+6
OBJECT,	ORG	.+3
WHERE,	ORG	.+3
HUND,	F 100.0
ONE,	F 1.0
M1,	F -1.0
	ORG	#BASE+30
	FNOP
	JA	#RET
	FNOP
#GOBAK,	0;0
	#LBL=.
	COMMON	PLACOM
ATLOC,	ORG	.+0702
LINK,	ORG	.+1130
PLACE,	ORG	.+0454
FIXED,	ORG	.+0454
HOLDNG,	ORG	.+3
	ORG	#LBL
#RTN,	BASE	#BASE
	JA	#GOBAK
#ST,	STARTD
	0210
	FSTA	#GOBAK,0
	0200
	SETX	#XR
	SETB	#BASE
	LDX	0,1
	FSTA	#BASE
	FLDA%	#BASE,1+
	FSTA	OBJECT
	FLDA%	#BASE,1+
	FSTA	WHERE
	STARTF
	FLDA%	WHERE		/Pre-load indexes
	ATX	6
	FLDA%	OBJECT
	ATX	7		/Fall thru with OBJECT in AC
/	 IF(OBJECT.GT.100)GOTO 5
	FSUB	HUND
	JGT	#5
/	 IF(PLACE(OBJECT).EQ.-1)RETURN
	FLDA	ONE
	FADD	PLACE-3,7
	JEQ	#RTN
/	 PLACE(OBJECT)=-1
	FLDA	M1
	FSTA	PLACE-3,7
/	 HOLDNG=HOLDNG+1
	FLDA	ONE
	FADDM	HOLDNG

/	 5       IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
#5,	FLDA	ATLOC-3,6
	FSUB%	OBJECT
	JNE	#6
/	 ATLOC(WHERE)=LINK(OBJECT)
	FLDA	LINK-3,7
	FSTA	ATLOC-3,6
/	 RETURN
	JA	#RTN

/	 6       TEMP=ATLOC(WHERE)
#6,	FLDA	ATLOC-3,6
/	 7       IF(LINK(TEMP).EQ.OBJECT)GOTO 8
#7,	ATX	5
	FLDA	LINK-3,5
	FSUB%	OBJECT
	JEQ	#8
/	 TEMP=LINK(TEMP)
	FLDA	LINK-3,5
/	 GOTO 7
	JA	#7

/	 8       LINK(TEMP)=LINK(OBJECT)
#8,	FLDA	LINK-3,7
	FSTA	LINK-3,5
/	 RETURN
/	 END
	JA	#RTN
	END

---