C	PROGRAM FREESTORE.FT
C	--------------------
C
C
C
C
	SUBROUTINE FREESTORE(MEM,NODE,IPTR,JPTR,KPTR,IOPR)
C
C
C
C	PETER LEMKIN
C	NCI,DCBD,IPU
C	NIH
C	BETHESDA, MD 20014
C
C
C	FEB 9, 1978
C	MAY 13, 1977
C	MAY 9, 1977
C	MAY 12, 1977
C	MARCH 10, 1977
C	MARCH 8, 1977
C	MARCH 2, 1977
C	FEB 26, 1977
C	FEB 25, 1977
C	FEB 24, 1977
C	FEB 23, 1977
C
C
C	PURPOSE
C	-------
C	SETUP AND MAINTAIN A NODE FREESTORE IN A BM USING THE ENTIRE
C	16-BITS OF THE BM WORDS.
C
C	THE FREESTORE CAN MAINTAIN NODE LISTS OF DIFFERENT
C	SIZE NODES. A NODE IS OF SIZE GEQ 3 16-BIT BM WORDS
C	(6 PDP8E D.P EAE WORDS). NOTE NODE[1:6] STORES THE [BACK (REAR),
C	LEFT (FORWARD), RIGHT (OPT. DATA).]
C
C	THE NODE SIZE IS ALWAYS SPECIFIED IN TERMS OF THE NUMBER OF
C	16-BIT WORDS (OR 1/2 THE # OF PDP8E 12-BIT WORDS)
C	USED IN A NODE.
C
C
C	THE EAE DOUBLE PRECISION PDP8E FORMAT IS AS FOLLOWS:
C
C		FOR D.P. # K[1:2],
C			K[1] IS THE LEAST SIGNIFICANT WORD,
C			K[2] IS THE MOST SIGNIFICANT WORD.
C
C
C	ARGUMENTS
C	---------
C	MEM - BM NUMBER USED AS THE FREESTORE.
C
C	NODE[1:N] - POINTER TO NODE ARRAY TO BE STORED OR FETCHED
C		FROM THE FREESTORE (IF APPLICABLE).
C
C	IPTR[1:2] - POINTER IF APPLICABLE.
C
C	JPTR[1:2] - POINTER IF APPLICABLE.
C
C	KPTR[1:2] - POINTER IF APPLICABLE.
C
C	IOPR - OPERATION SPECIFICATION.
C
C
C
C
C	IOPR	FUNCTION
C	----	--------
C	1	NINIT - INITIALIZE A FREE STORE REGION AVAIL LIST
C			OF NODE SIZE KPTR IN THE SPECIFIED BM MEM USING
C			THE RANGE OF BM ADDRESS IPTR TO JPTR. NOTE IPTR
C			POINTS THE THE HEAD OF THE AVAIL LIST. THE NODES
C			INFO AND RIGHT LINKS WILL BE INITIAIZED TO ZERO.
C			THE FIRST 3 WORDS OF THE NODE ARE LINK FIELDS
C			DEFINED AS FOLLOWS:
C				NODE[1] = BACKWARDS POINTER.
C				NODE[2] = LEFT (FORWARD) PTR.
C				NODE[3] = RIGHT (OPT. DATA) PTR
C				NODE[4:KPTR] = INFO FIELDS INIT TO 0.
C			NOTE THAT THE AVAIL POINTER NODE (IPTR NODE) IS
C			NEVER ALLOCATED AND THAT ITS RIGHT POINTER FIELD
C			CONTAINS THE NODE SIZE (KPTR) WHILE THE LEFT POINTER
C			FIELD POINTS TO THE TOP OF THE AVAIL LIST (LAST NODE
C			IN THE LIST).
C
C	2	NGETNODE - GET A NODE POINTER FROM THE FREESTORE FOR
C			AVAIL LIST (MEM,IPTR) AND RETURN THE POINTER IN
C			JPTR AND THE SIZE OF THE NODE IN KPTR. IF
C			NO NODE CAN BE ALLOCATED, THEN JPTR[1:2]=-1.
C
C	3	NFREENODE - RETURN A NODE POINTED TO BY JPTR TO THE
C			AVAIL LIST POINTED TO BY (MEM,IPTR).
C			NO CHECKING IS DONE TO MAKE SURE THE SIZES ARE
C			THE SAME.

C	4	NREADINFO - COPY THE CONTENTS OF THE NODE (OF SIZE KPTR
C			INCLUDING THE 3 PTR FIELDS) INTO NODE[1:KPTR]
C			OF THE NODE POINTED TO BY (MEM,IPTR).
C
C	5	NWRITEINFO - COPY THE CONTENTS OF NODE[1:KPTR] INTO THE
C			NODE POINTED TO BY (MEM,IPTR). NOTE THAT
C			NO CHECKING IS DONE ON THE ACTUAL SIZE OF THE NODE.
C			THE SIZE IS SPECIFIED IN TERMS OF PDP8E WORDS.
C
C	6	NSETBACKPTR - SET THE BACKWARDS POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C			THE SIZE IS SPECIFIED IN TERMS OF PDP8E WORDS.
C
C	7	NGETBACKPTR - COPY THE BACKWARDS POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
C	8	NSETLEFTPTR - SET THE LEFT POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C
C	9	NGETLEFTPTR - COPY THE LEFT POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
C	10	NSETRIGHTPTR - SET THE RIGHT POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C
C	11	NGETRIGHTPTR - COPY THE RIGHT POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
C	12	NSETALLPTRS - SET [BACK,LEFT,RIGHT] PTRS <==
C				NODE[1:6] IN THE
C				THE NODE POINTED TO BY (MEM,IPTR).
C
C	13	NGETALLPTRS - COPY NODE[1:6] <== [BACK,LEFT,RIGHT]
C				FIELDS OF THE NODE POINTED TO BY (MEM,IPTR).
C
C	14	NLISTFREE- RETURN A LIST POINTED TO BY JPTR TO
C			THE AVAIL LIST POINTED TO BY (MEM,IPTR).
C			NOTE: ALL NODES MUST BE THE SAME SIZE.
C
C	15	NTREEFREE - RETURN A TREE POINTED TO BY JPTR TO THE
C			AVAIL LIST POINTED TO BY (MEM,IPTR).
C			NOTE: ALL NODES MUST BE THE SAME SIZE.
C
C	16	NGRAPHFREE - RETURN A GRAPH POINTED TO BY JPTR
C			TO THE AVAIL LIST POINTED TO BY (MEM,IPTR).
C			NOTE: ALL NODES MUST BE THE SAME SIZE.
C	OPDEFS
C	------
C
S	OPDEF	RIF	6224
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	SHL	7413
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	DCM	7575
S	OPDEF	CLAMQ	7621
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
S	OPDEF	DMAGO	6070
S	SKPDF	DMASKP	6071
S	OPDEF	DMAWC	6072
S	OPDEF	DMACA	6073
S	OPDEF	DMACLR	6074
S	OPDEF	EXDMA1	6524
S	OPDEF	EXDMA2	6525
C
	DIMENSION II(2),JJ(2),KK(2),MM(2),NN(2),KK16BITS(2)
	DIMENSION IADDR(2),IVAL(2)
	DIMENSION MSIZESPACE(2),IFRONT(2),IREAR(2),MAXNODES(2)
	DIMENSION IBUFPTR(2)
C
C
C	[0] INITIALIZATION
C
C
C	****DUMMY VARIALBE DEFINITION****
	GOTO 2000
S	DUMMY CC
S	CPAGE 2
S CC,	BLOCK 2
2000	CONTINUE
C	*******************************************
C
C	CHECK FOR ARGUMENT COUNT ERROR. THERE SHOULD BE 6 ARGS
C	EACH ARG TAKING UP 2 LOCS AND THE POINTER IS ON THE RETURN
C	P-D13=LOC(NARGS*'100+LINK SUBR#). THEREFORE CHECK NARGS
S	TAD FREES
S	DCA CC
S	TAD FREES#
S	TAD (-D13
S	DCA CC#
S	TAD I CC /GET NARG&LINK
S	BSW
S	AND (0077
S	TAD (-6 /-# ARGS
S	SNA CLA
S	JMP \2043 /OK, CONTINUE
C
C
C
C	ERROR!!!!!
	WRITE(1,2046)
2046	FORMAT('?FREEST AG')
	CALL EXIT
C
C	DISPATCHER
2043	CONTINUE
C
C	DEFINE DPCVRT CALLS
	LDTOF=-1
	LFTOD=+1
C
C	COPY MEM LOCALLY
	MMEM=MEM
C
C
C
C	[0.1] CHECK FOR VALID OPR#
	IF(IOPR-1)996,10,10
10	IF(IOPR-16)11,11,996
996	WRITE(1,995)IOPR
995	FORMAT('?FREEST IOPR',I5)
C
C
C	[0.1.1] RETURN
S \2047,	CLA
C
C*****DEBUG*****
C	MAKE SURE THAT FREESTORE POINT CONTENTS IS NOT = 1!
C	IF IT IT IS =1 THEN FAIL "FS" 2003;
S	TAD (0623 /"FS"
S	DCA \SPACE /FLAG IF FAIL
C
S	DCA \IADDR#
	IADDR=1
S	JMS RD16BITS
S	TAD \IVAL#
S	MQL
S	TAD \IVAL
S	MQA /OR TOGETHER
S	TAD (-1
S	SNA CLA
S	JMP \2003 /FAIL
C*************
S	SWBA
	RETURN
C
C
C	[0.2] DISPATCH
11	GOTO(100,200,300,400,500,600,700,800,900,1000,1100,1200,1300
     1,1400,1500,1600),IOPR
C
C	[1]	NINIT - INITIALIZE A FREE STORE REGION AVAIL LIST
C			OF NODE SIZE KPTR IN THE SPECIFIED BM MEM USING
C			THE RANGE OF BM ADDRESS IPTR TO JPTR. NOTE IPTR
C			POINTS THE THE HEAD OF THE AVAIL LIST. THE NODES
C			INFO AND RIGHT LINKS WILL BE INITIAIZED TO ZERO.
C			THE FIRST 3 WORDS OF THE NODE ARE LINK FIELDS
C			DEFINED AS FOLLOWS:
C				NODE[1] = BACKWARDS POINTER.
C				NODE[2] = LEFT (FORWARD) PTR.
C				NODE[3] = RIGHT (OPT. DATA) PTR
C				NODE[4:KPTR] = INFO FIELDS INIT TO 0.
C			NOTE THAT THE AVAIL POINTER NODE (IPTR NODE) IS
C			NEVER ALLOCATED AND THAT ITS RIGHT POINTER FIELD
C			CONTAINS THE NODE SIZE (KPTR) WHILE THE LEFT POINTER
C			FIELD POINTS TO THE TOP OF THE AVAIL LIST (LAST NODE
C			IN THE LIST).
C
C	[1.1] ZERO THE FREESTORE MEM[IPTR:JPTR]
C	GET THE IPTR AND JPTR
100	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (17 /MAGNITUDE #
S	DCA \II#
C
	JJ=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	AND (17 /MAGNITUDE #
S	DCA \JJ#
C
	KK=KPTR+KPTR
	KK16BITS=KPTR
S	DCA \KK16BITS#
	SIZE=KPTR
C
C	MAKE SURE THAT THE SIZE GEQ 3
	IF(KK16BITS-3)104,103,103
104	WRITE(1,105)KK16BITS(1)
105	FORMAT('?FREEST ND SZ',I5)
	CALL EXIT
C
C
C	[1.1.1] COMPUTE: MSIZESPACE=JJ[1:2]-II[1:2]
S \103,	SWAB
S	CPAGE 2
S	DAD
S	\II

S	DCM

S	CPAGE 2
S	DAD
S	\JJ
C
S	CPAGE 2
S	DST
S	\MSIZESPACE
S	CLAMQ
C
C
	CALL DPCVRT(MSIZESPACE,SPACE,LDTOF)
	FMAXNODES=SPACE/SIZE
C
C	PUT BACK INTO D.P.
	CALL DPCVRT(MAXNODES,FMAXNODES,LFTOD)
C
C	TRUNCATE F.P MAX # NODES
	CALL DPCVRT(MAXNODES,FMAXNODES,LDTOF)
C
C
C	[1.2] SET UP THE STARTING ADDRESS OF REGION TO ZERO.
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
C
C	[1.3] LOOP WRITING 0'S UNTIL IADDR GEQ JJ.
	IVAL=0
S	DCA \IVAL#
C
101	CONTINUE
S	JMS WT16BITS
C
C	ADD 1 TO IADDR
S	ISZ \IADDR
S	SKP
S	ISZ \IADDR#
S	CLA
C
C
C
C	[1.3.1] IF IADDR > JJ THEN STOP
S	SWAB
S	CPAGE 2
S	DAD
S	\IADDR
C
S	DCM
C
S	CPAGE 2
S	DAD
S	\JJ
C
S	SMA CLA
S	JMP \101 /CONTINUE
S	CLAMQ /DONE!
C
C
C	[1.5] GENERATE NODES. INITIAL THE PTRS.
C	COMPUTE: IFRONT=IPTR+KK16BITS
S	TAD \KK16BITS
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IFRONT
S	CLAMQ
C
C
C	COMPUTE: IREAR=IPTR+(MAXNODES-1)*KK16BITS
	T=(FMAXNODES-1.0)*SIZE
	CALL DPCVRT(MM,T,LFTOD)
C
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DAD
S	\MM
C
S	CPAGE 2
S	DST
S	\IREAR
S	CLAMQ
C
C	BACKUP THE IREAR PTR IN MM
	MM=IREAR
S	TAD \IREAR#
S	DCA \MM#
C
C
C
C	[1.5] RESET IADDR
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
C
C	[1.6] LOOP
C	INSERT PTRS TO NODE POINTED TO BY IADDR.
C	FIRST DO REAR PTR
102	IVAL=IREAR
S	TAD \IREAR#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C	COMPUTE NEW REAR
C	AS: REAR<== IADDR;
	IREAR=IADDR
S	TAD \IADDR#
S	DCA \IREAR#
C
C	INCREMENT IADDR[1:2].
S	ISZ \IADDR
S	SKP
S	ISZ \IADDR#
S	CLA
C
C
C	[1.6.1] DO FORWARD POINTER
	IVAL=IFRONT
S	TAD \IFRONT#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C
C	[1.6.2] COMPUTE: IFRONT=IFRONT+KK16BITS (D.P)
S	TAD \KK16BITS
S	SWAB
S	CPAGE 2
S	DAD
S	\IFRONT
C
S	CPAGE 2
S	DST
S	\IFRONT
S	CLAMQ
C
C
C	[1.6.3] COMPUTE NEW ADDRESS: IADDR=IADDR+(KK16BITS-1)
S	CLA CMA
S	TAD \KK16BITS
S	SWAB
S	CPAGE 2
S	DAD
S	\IADDR
C
S	CPAGE 2
S	DST
S	\IADDR
C
C	[1.6.4] IF (IADDR+KK16BITS) > JPTR 
C			THEN DONE ELSE GOTO [1.6]
S	CPAGE 2
S	DAD
S	\KK16BITS
C
S	DCM
C
S	CPAGE 2
S	DAD
S	\JJ
S	SMA CLA
S	JMP \102 /CONTINUE
C
S	CLAMQ /DONE
C
C
C	[1.7] FIXUP FORWARD PTR OF LAST NODE TO POINT TO IPTR.
S	CLA IAC /+1
S	SWAB
S	CPAGE 2
S	DAD
S	\MM /POINTER TO LAST NODE SAVED IN [1.4]
C
S	CPAGE 2
S	DST
S	\IADDR /IREAR+1
S	CLAMQ
C
C
	IVAL=II
S	TAD \II#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C	FIXUP NODE COUNT IN HEADER (IPTR) NODE FIELD 3.
C	NOTE: NODE COUNT IS 16-BIT WORDS!
	IVAL=KK16BITS
S	DCA \IVAL#
C
S	TAD (2 /NODE[3]
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS WT16BITS
C
C
C	[1.8] RETURN THE NUMBER OF NODES GENERATED IN KPTR
	KPTR=MAXNODES
S	INC \KPTR#
S	TAD \MAXNODES#
S	DCA I \KPTR
C
C
	GOTO 2047
C	[2]	NGETNODE - GET A NODE POINTER FROM THE FREESTORE FOR
C			AVAIL LIST (MEM,IPTR) AND RETURN THE POINTER IN
C			JPTR AND THE SIZE OF THE NODE IN KPTR. IF
C			NO NODE CAN BE ALLOCATED, THEN JPTR[1:2]=0.
C
C	[2.1] GET AVAIL NODE: REAR[IPTR]
200	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
C	IF IVAL=IADDR
C		THEN RETURN 0==>JPTR (EMPTY AVAIL LIST!)
S	TAD \IVAL
S	CIA
S	TAD \IADDR
S	SZA CLA
S	JMP \201 /NOT NULL CONTINUE
C
S	TAD \IVAL#
S	CIA
S	TAD \IADDR#
S	SZA CLA
S	JMP \201 /NOT NULL CONTINUE
C
C	NULL!, RETURN -1
	JPTR=-1
S	INC \JPTR#
	JPTR=-1
C
	GOTO 2047
C
C
C	[2.2] SAVE PTRS TO FREE NODE.
201	IREAR=IVAL
S	TAD \IVAL#
S	DCA \IREAR#
C
C
C	[2.3] ADJUST POINTERS TO AVAIL STACK
C	FRONT[REAR[REAR[IPTR]]]<==IPTR
C
C	REAR[IPTR]<==REAR[REAR[IPTR]].
C
C	COMPUTE: KK<==REAR[REAR[IPTR]].
	IADDR=IREAR
S	TAD \IREAR#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
C	NOTE: KK<==REAR[REAR[IPTR]];
	KK=IVAL
S	TAD \IVAL#
S	DCA \KK#
C
C
C	STORE: REAR[IPTR]<==KK
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
S	JMS WT16BITS
C
C	STORE FRONT[KK]<==IPTR
S	CLA IAC /+1
S	SWAB
S	CPAGE 2
S	DAD
S	\KK
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=II
S	TAD \II#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C
C	[2.4] RETURN THE NEW NODE TO JPTR
	JPTR=IREAR
S	INC \JPTR#
S	TAD \IREAR#
S	DCA I \JPTR
C	RESET CURRENT DATA FIELD BECAUSE DOING EAE
	II=II
C
C
C	[2.5] GET THE NODE SIZE FROM THE HEADER NODE[3]==> INTO KPTR
S	TAD (2
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS RD16BITS
C
	KPTR=IVAL
C
	GOTO 2047
C
C	[3]	NFREENODE - RETURN A NODE POINTED TO BY JPTR TO THE
C			AVAIL LIST POINTED TO BY (MEM,IPTR).
C			NO CHECKING IS DONE TO MAKE SURE THE SIZES ARE
C			THE SAME.

C	[3.1] RETURN NODE TO AVAIL BY ADJUSTING POINTERS AS FOLLOWS:
C
C	REAR[JPTR]<==REAR[IPTR];
C
C	FRONT[JPTR]<==IPTR
C
C	FRONT[REAR[IPTR]]<==JPTR
C
C	REAR[IPTR]<==JPTR
C
C
300	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	JJ=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \JJ#
C
C
C
C
C	[3.1.1] REAR[JPTR]<==REAR[IPTR];
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
	IADDR=JJ
S	TAD \JJ#
S	DCA \IADDR#
C
S	JMS WT16BITS
C
C
C	[3.1.2] FRONT[JPTR]<==IPTR
	IVAL=II
S	TAD \II#
S	DCA \IVAL#
C
S	CLA IAC /+1
S	SWAB
S	CPAGE 2
S	DAD
S	\JJ
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS WT16BITS
C
C
C	[3.1.3] FRONT[REAR[IPTR]]<==JPTR
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
S	CLA IAC /+1
S	SWAB
S	CPAGE 2
S	DAD
S	\IVAL
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=JJ
S	TAD \JJ#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C
C	[3.1.4] REAR[IPTR]<==JPTR
	IADDR=II
S	TAD \II#
S	DCA \II#
C
S	JMS WT16BITS
C
C
	GOTO 2047
C
C	[4]	NREADINFO - COPY THE CONTENTS OF THE NODE (OF SIZE KPTR
C			INCLUDING THE 3 PTR FIELDS) INTO NODE[1:KPTR]
C			OF THE NODE POINTED TO BY (MEM,IPTR).
C
C	[4.1]	COPY NODE[1:6] <== [BACK,LEFT,RIGHT]
C				FIELDS OF THE NODE POINTED TO BY (MEM,IPTR).
400	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	DO 401 I=1,KPTR
S	CLA CMA
S	TAD \I
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS RD16BITS
C
	NODE=IVAL
S	INC \NODE#
S	TAD \IVAL#
S	DCA I \NODE
S	INC \NODE#
C
401	CONTINUE
C
	GOTO 2047
C	[5]	NWRITEINFO - COPY THE CONTENTS OF NODE[1:KPTR] INTO THE
C			NODE POINTED TO BY (MEM,IPTR).
C
C
500	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	DO 501 I=1,KPTR
S	CLA CMA
S	TAD \I
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=NODE
S	INC \NODE#
S	TAD I \NODE
S	DCA \IVAL#
S	INC \NODE#
C
S	JMS WT16BITS
C
501	CONTINUE
C
	GOTO 2047
C	[6]	NSETBACKPTR - SET THE BACKWARDS POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C			THE SIZE IS SPECIFIED IN TERMS OF PDP8E WORDS.
C
600	IADDR=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \IADDR#
C
	IVAL=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	DCA \IVAL#
C
S	JMS WT16BITS
C
	GOTO 2047
C	[7]	NGETBACKPTR - COPY THE BACKWARDS POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
700	IADDR=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \IADDR#
C
S	JMS RD16BITS
C
	JPTR=IVAL
S	INC \JPTR#
S	TAD \IVAL#
S	DCA I \JPTR
C
	GOTO 2047
C	[8]	NSETLEFTPTR - SET THE LEFT POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C
800	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
S	CLA IAC
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	DCA \IVAL#
C
S	JMS WT16BITS
C
	GOTO 2047
C	[9]	NGETLEFTPTR - COPY THE LEFT POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
900	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
S	CLA IAC
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS RD16BITS
C
	JPTR=IVAL
S	INC \JPTR#
S	TAD \IVAL#
S	DCA I \JPTR
C
	GOTO 2047
C	[10]	NSETRIGHTPTR - SET THE RIGHT POINTER IN THE NODE POINTED
C			TO BY (MEM,IPTR) TO THE VALUE OF JPTR.
C
1000	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
S	TAD (2
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	DCA \IVAL#
C
S	JMS WT16BITS
C
	GOTO 2047
C	[11]	NGETRIGHTPTR - COPY THE RIGHT POINTER IN THE NODE
C			POINTED TO BY (MEM,IPTR) INTO JPTR.
C
1100	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
S	TAD (2
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS RD16BITS
C
	JPTR=IVAL
S	INC \JPTR#
S	TAD \IVAL#
S	DCA I \JPTR
C
	GOTO 2047
C	[12]	NSETALLPTRS - SET [BACK,LEFT,RIGHT] PTRS <==
C				NODE[1:6] IN THE
C				THE NODE POINTED TO BY (MEM,IPTR).
C
1200	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	DO 1201 I=1,3
S	CLA CMA
S	TAD \I
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=NODE
S	INC \NODE#
S	TAD I \NODE
S	DCA \IVAL#
C
S	JMS WT16BITS
1201	CONTINUE
C
C
	GOTO 2047
C	[13]	NGETALLPTRS - COPY NODE[1:6] <== [BACK,LEFT,RIGHT]
C				FIELDS OF THE NODE POINTED TO BY (MEM,IPTR).
1300	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	DO 1301 I=1,3
S	CLA CMA
S	TAD \I
S	SWAB
S	CPAGE 2
S	DAD
S	\II
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
S	JMS RD16BITS
C
	NODE=IVAL
S	INC \NODE#
S	TAD \IVAL#
S	DCA I \NODE
S	INC \NODE#
C
1301	CONTINUE
C
C
	GOTO 2047
C	[14]	NLISTFREE- RETURN A LIST POINTED TO BY JPTR TO
C			THE AVAIL LIST POINTED TO BY (MEM,IPTR).
C
1400	II=IPTR
S	INC \IPTR#
S	TAD I \IPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \II#
C
	JJ=JPTR
S	INC \JPTR#
S	TAD I \JPTR
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \JJ#
C
C
C	[14.1] ADJUST POINTER IN CURRENT AVAIL NODE FREE NODE Q.
C	SAVE PTR TO Q.
C	NN<==REAR[IPTR]
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
	NN=IVAL
S	TAD \IVAL#
S	DCA \NN#
C
C
C	POINT TO LIST WE ARE APPENDING
C	FRONT[NN]<==JPTR
S	CLA IAC /+1
S	SWAB
S	CPAGE 2
S	DAD
S	\NN
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=JJ
S	TAD \JJ#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C
C
C	[14.2] ADJUST HEAD OF LIST B (LIST WE ARE APPENDING)
C	SAVE PTR TO LAST NODE OF B
C	MM<==REAR[JPTR]
	IADDR=JJ
S	TAD \JJ#
S	DCA \IADDR#
C
S	JMS RD16BITS
C
	MM=IVAL
S	TAD \IVAL#
S	DCA \MM#
C
C
C	POINT TO LAST NODE Q IN HEADER LIST B NODE
C	REAR[JPTR]<==NN.
C
	IADDR=JJ
S	TAD \JJ#
S	DCA \IADDR#
C
	IVAL=NN
S	TAD \NN#
S	DCA \NN#
C
S	JMS WT16BITS
C
C
C
C	[14.3] SET AVAIL LIST HEADER NODE Q TO POINT TO LAST
C	NODE OF B LIST.
C	REAR[IPTR]<==MM;
C
	IADDR=II
S	TAD \II#
S	DCA \IADDR#
C
	IVAL=MM
S	TAD \MM#
S	DCA \MM#
C
S	JMS WT16BITS
C
C
C
C	[14.4] SET LAST NODE OF B LIST TO POINT TO AVAIL LIST 
C	HEADER NODE Q.
C	FRONT[MM]<==IPTR;
S	CLA IAC
S	SWAB
S	CPAGE 2
S	DAD
S	\MM
C
S	CPAGE 2
S	DST
S	\IADDR
S	CLAMQ
C
	IVAL=II
S	TAD \II#
S	DCA \IVAL#
C
S	JMS WT16BITS
C
C
C
	GOTO 2047
C	[15]	NTREEFREE - RETURN A TREE POINTED TO BY JPTR TO THE
C			AVAIL LIST POINTED TO BY (MEM,IPTR).
C
1500	GOTO 2047
C	[16]	NGRAPHFREE - RETURN A GRAPH POINTED TO BY JPTR
C			TO THE AVAIL LIST POINTED TO BY (MEM,IPTR).
1600	GOTO 2047
C	*********************************************************
C	SUBROUTINE:	B M D M A		*
C	*********************************************************
C	DO READ OR WRITE I/O ON THE BUFFER POINTED TO BY
C	IBUFPTR[1:2] FOR KWC 16-BIT WORDS STARTING AT
C	ADDRESS MMEM&IADDR[1:2]. IBMRDWT DETERMINES IF IT IS A
C	READ (0) OR A WRITE (11).
C
C	FETCH A 16-BIT BM WORD (TO PDP8E EAE FORMAT)
C	FROM THE SPECIFIED BM
C
C	ARGS
C	----
C	MMEM - BM NUMBER 0 TO 7
C	IADDR[1:2] - WITHIN BM 16-BIT ADDRESS (EAE MODE)
C	IBUFPTR[1:2] - FORTRAN II DUMMY VARIABLE PTR TO BUFFER
C	IBMRDWT - 0 TO READ, 1 TO WRITE.
C
S	CPAGE 3
S RBMDMABUF,	JMP I BMDMA
S BMDMA,	0
C
C
C	[1] INITIAL DMA (WC,CA) REGISTERS
S	DMACLR
S	TAD \IBUFPTR#	/POINTER TO BUFFER
S	DMACA		/LOAD ADDRESS REGISTER
C
S	TAD \KWC	/# OF 16-BIT WORDS TO TRANSFER
S	CLL RAL		/X2 SINCE USE 2 PDP8E WORDS/16-BIT WORDS
S	DMAWC		/LOAD WORD COUNT REGISTER
C
C
C	[2] SET UP I/O DEVICE ADDRESS REGISTERS
C	FIRST CHECK FOR ADDRESS OVF
S	TAD \IADDR#
S	AND (7760
S	SZA CLA
S	JMP \2002 /ADDRESS OVF!
C
S	TAD \MMEM	
S	CLL RTL; RTL /MOVE [9:11]==>[5:7]
S	TAD \IADDR# /HIGH ADDRESS PART
S	EXDMA1		/HIGH-ORDER WORD
C
S	TAD \IADDR /LOW ORDER ADDRESS
S	EXDMA2		/LOAD LO-ORDER WORD
C
C
C	[3] EXECUTE COMMAND
C
S	TAD \IBUFPTR
S	AND (0070 /GET BUFFER DATA FIELD
S	MQL
S	TAD \IBMRDWT
S	SZA CLA
S	TAD (4000
S	MQA
C
S	DMAGO		/DO IT!
S	DCA 7 /ZERO COUNTER
C
S RBM,	DMASKP		/WAIT 'TIL DONE
S	SKP
S	JMP RBMDMA /DONE WITH I/O
S	ISZ 7
S	JMP RBM /NOT YET
C
C	OVERFLOW!
S	TAD (2411 /"TI"
S	DCA \SPACE
	GOTO 2003
C
C
C
C	[4] FATAL BM DMA ADDR OVF OR TIMEOUT ERROR
C	ADDR OVF
S\2002,	TAD (0117 /"AO"
S	DCA \SPACE
C
S\2003,	DMACLR
	CALL DPCVRT(IADDR,SIZE,LDTOF)
S	TAD I \IOPR
S	MQL /	**** IOPR==>MQ ***
S	TAD FREES
S	6435 /*** RETURN ADDRESS==>DISP1,DISP2
S	TAD FREES# /*************************
S	6436
C
	WRITE(1,2001)SIZE,SPACE
2001	FORMAT('?FREEST DMA ERR, RE-BOOT! ADR',F11.0,A2)
S	HLT
	GOTO 2003
C	*********************************************************
C	*SUBROUTINE     W T 1 6 B I T S
C	*********************************************************
C	WRITE 16-BITS FROM IVAL[1:2] EAE PACKED INTO (MEM,IADDR[1:2]).
C
S	CPAGE 3
S RWT16BITS,	JMP I WT16BITS
S WT16BITS,	0
C
	KWC=1
C
S	TAD PIVAL
S	DCA \IBUFPTR#
S	RIF
S	DCA \IBUFPTR
C
	IBMRDWT=1
C
S	JMS BMDMA
C
S	JMP RWT16BITS
C
C
C	*********************************************************
C	*SUBROUTINE     R D 1 6 B I T S
C	*********************************************************
C	READ 16-BITS FROM IVAL[1:2] EAE PACKED INTO (MEM,IADDR[1:2]).
C
S	CPAGE 3
S RRD16BITS,	JMP I RD16BITS
S RD16BITS,	0
C
C
	KWC=1
C
S	TAD PIVAL
S	DCA \IBUFPTR#
S	RIF
S	DCA \IBUFPTR
C
	IBMRDWT=0
C
S	JMS BMDMA
C
C	RETURN ONLY 16-BITS
S	TAD \IVAL#
S	AND (0017 /MAGNITUDE NUMBER
S	DCA \IVAL#
S	JMP RRD16BITS
C
C
C
C	******************PARAMETERS*****************
S PIVAL,	\IVAL
	END