C	PROGRAM LSTODT.FT
C	-----------------
C
C	PETER LEMKIN
C	NIH
C	BETHESDA, MD 20014
C
C
C	MARCH 13, 1977
C	MARCH 8, 1977
C	MARCH 12, 1977
C	MARCH 6, 1977
C	MARCH 3, 1977
C	MARCH 1, 1977
C	FEB 28, 1977
C	FEB 26, 1977
C	FEB 25, 1977
C
C
C	PURPOSE
C	-------
C	FREESTORE.FT NODE DEBUGGER PROGRAM.
C
C	CMD	FUNCTION
C	---	--------
C	A	APPEND NODE TO LIST AND SET CURRENT PTR TO NEW NODE.
C	S	SET CURRENT NODE INFO FIELD OF NODE TO TTYDATA[3:SIZE]
C	R	READ CURRENT NODE INFO FIELD==>TTY.
C	D	DELETE LAST NODE IN LIST AND RESET CURRENT PTR.
C	P	PRINT NODES OF LIST.
C	F	FIND SIZE OF FREESTORE AND PRINT IT.
C	I	INIT THE FREESTORE GIVEN [AVAIL,ENDAVAIL,SIZE OF NODE].
C	E	EXAMINE AND OPEN: [BMLOC]. SET CURRENT PTR TO BMLOC.
C	/	EXAMINE AND OPEN: (BMLOC)
C	LF	EXAMINE AND OPEN: (BMLOC<==BMLOC+1)
C	-	EXAMINE AND OPEN: (BMLOC<==BMLOC-1).
C	"	EXAMINE AND OPEN: (BMLOC<==BACKPTR(BMLOC))
C	#	EXAMINE AND OPEN: (BMLOC<==LEFTPTR(BMLOC)) /I.E. FORWARD PTR
C	%	EXAMINE AND OPEN: (BMLOC<==RIGHTPTR(BMLOC))
C	?	PRINT HELP INFORMATION.
C	L	PRINT ON LPT:/TTY: TOGGLE
C	X	RETURN THE LIST TO THE FREE STORE.
C	Y	SET LIST POINTER FROM TTY (USED WITH: A, D,P)
C	Z	SET FREESTORE AVAIL PTR FROM TTY (USED WITH: A, D, F, X)
C
C
C
C
C
S	OPDEF	KRS	6034
S	OPDEF	KCC	6032
C
	DIMENSION IAVAIL(2),IPTR(2),JPTR(2),KSIZE(2),MSIZE(2)
	DIMENSION LIST(2),NN(2),MM(2),ISERIAL(2),IVAL(2)
	DIMENSION FNODE(300),NODE(2,300)
	DIMENSION JKND(2),JKPT(2)
	DIMENSION S(2)
C
C
C	[0] INIT
C	DEFINE DPCVRT CALLS
	LDTOF=-1
	LFTOD=+1
C
C	DEFINE FREESTORE CALLS
	NINIT=1
	NGETNODE=2
	NFREENODE=3
	NREADINFO=4
	NWRITEINFO=5
	NSETBACKPTR=6
	NGETBACKPTR=7
	NSETLEFTPTR=8
	NGETLEFTPTR=9
	NSETRIGHTPTR=10
	NGETRIGHTPTR=11
	NSETALLPTRS=12
	NGETALLPTRS=13
	NLISTFREE=14
	MEM=3
C
C
	WRITE(1,999)
999	FORMAT(' LSTODT.SV 3/13/77  - FREESTORE NODE DEBUGGER.')
C
C
C	[1] INIT THE FREE STORE 
	IOUTSPOOL=0
	LIST=-1
	LIST(2)=-1
C
	ICMD=0
	STAR='*'
	SPACE=' '
	IDEV=1
	GOTO 105
C
100	WRITE(1,101)STAR,
101	FORMAT(A1)
C
C	IF IOUTSPOOL=0 THEN TTY ELSE LPT
S	TAD \IOUTSPOOL
S	SZA CLA
S	TAD (2 /DEV 3=LPT
S	TAD (1
S	DCA \IDEV
C
C	GET COMMAND
SINCHAR,	KSF
S	JMP INCHAR /NO
C
S	KRB
S	TLS
S	AND (177
S	TAD (200
S	DCA \ICMD
C
C	DO CRLF
	WRITE(IDEV,102)
102	FORMAT()
C
C
C	IF CMD="?" THEN PRINT HELP MSG
S	TAD \ICMD
S	TAD (-"?
S	SZA CLA
S	JMP \103 /NO
C	YES
C	PRINT HELP INFO
105	WRITE(IDEV,104)
104	FORMAT(' APPEND ND, SET ND, READ ND, DELETE ND, PRINT LIST,'
     1,/,' F(SIZE), INIT, EXAMINE, /(.), LF(.+1), - (.-1), "(BKPTR),'
     2,/,' #(FWD PTR), %(RHT PTR), ?(HELP), ^C(OS8), L(TTY/LPT),')
	WRITE(IDEV,106)
106	FORMAT(' X(RETURN LIST TO FREESTORE), Y(SET LST PTR),'
     1' Z(SET FREESTORE PTR).')
	GOTO 100
C
C
C	INCREMENT THE SERIAL #
103	SERIAL=SERIAL+1.0
	CALL DPCVRT(ISERIAL,SERIAL,LFTOD)
C
C
C	[2.1] IF A THEN APPEND
S	TAD \ICMD
S	TAD (-"A /"A "
S	SZA CLA
S	JMP \220 /NO
C
C	YES
C	GET NODE
	CALL FREESTORE(MEM,JKND,IAVAIL,JPTR,JKPT,NGETNODE)
C
C	IF LIST[1:2]=-1 
C		THEN LIST<==JPTR, R[LIST]_LIST, F[LIST]_LIST;
C
S	CLA IAC
S	TAD \LIST
S	SZA CLA
S	JMP \210 /NO
C
S	CLA IAC
S	TAD \LIST#
S	SZA CLA
S	JMP \210 /NO
C
C	YES,
	LIST=JPTR
S	TAD \JPTR#
S	DCA \LIST#
C
	CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NSETBACKPTR)
	CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NSETLEFTPTR)
	GOTO 211
C
C
C	[2.1.1] LINK JPTR NODE TO LIST.
C	FRONT[JPTR]_LIST;
210	CALL FREESTORE(MEM,JKND,JPTR,LIST,JKPT,NSETLEFTPTR)
C
C	REAR[JPTR]_REAR[LIST];
	CALL FREESTORE(MEM,JKND,LIST,NN,JKPT,NGETBACKPTR)
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NSETBACKPTR)
C
C	FRONT[REAR[LIST]]_JPTR;
	CALL FREESTORE(MEM,JKND,NN,JPTR,JKPT,NSETLEFTPTR)
C
C	REAR[LIST]_JPTR
	CALL FREESTORE(MEM,JKND,LIST,JPTR,JKPT,NSETBACKPTR)
C
C
C	[2.1.2] INSERT SERIAL # INTO RIGHT FIELD
211	CALL FREESTORE(MEM,JKND,JPTR,ISERIAL,JKPT,NSETRIGHTPTR)
C
C	[2.1.3] UPDATE CURRENT PTR
	CALL DPCVRT(JPTR,ADDRESS,LDTOF)
	GOTO 100
C	[2.2] IF D THEN DELETE
S \220,	TAD \ICMD
S	TAD (-"D /"D "
S	SZA CLA
S	JMP \230 /NO
C
C	YES
C
C	IF LIST[1:2]=-1 THEN NOP
C
S	CLA IAC
S	TAD \LIST
S	SZA CLA
S	JMP \221 /NO
C
S	CLA IAC
S	TAD \LIST#
S	SZA CLA
S	JMP \221 /NO
C
C	YES,
	WRITE(IDEV,222)
222	FORMAT(' NULL LIST - NO DELETE!')
	GOTO 100
C
C	GET LAST NODE PTR
221	CALL FREESTORE(MEM,JKND,LIST,JPTR,JKPT,NGETBACKPTR)
C
C	IF LIST=JPTR
C		THEN THIS IS THE LAST NODE, SO ZERO THE LIST PTR;
	L1=LIST
S	TAD \L2
S	DCA \LIST#
C
S	TAD \JPTR
S	CIA
S	TAD \LIST
S	SZA CLA
S	JMP \223 /NO
S	TAD \JPTR#
S	CIA
S	TAD \LIST#
S	SZA CLA
S	JMP \223 /NO
C
C	ZERO LIST BACKUP
	L1=-1
	L2=-1
C
C	RETURN NODE TO AVAIL - SHORTEN THE LIST--
C	NN_REAR[JPTR]
223	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR)
C
C	FRONT[NN]_LIST;
	CALL FREESTORE(MEM,JKND,NN,LIST,JKPT,NSETLEFTPTR)
C
C	REAR[LIST]_NN
	CALL FREESTORE(MEM,JKND,LIST,NN,JKPT,NSETBACKPTR)
C	UPDATE CURRENT PTR
	CALL DPCVRT(NN,ADDRESS,LDTOF)
C
C	RETURN NODE TO AVAIL LIST
	CALL FREESTORE(MEM,JKND,IAVAIL,JPTR,KSIZE,NFREENODE)
C
C	RESTORE LIST PTR
	LIST=L1
	LIST(2)=L2
	GOTO 100
C
C	[2.3] IF P THEN PRINT NODE LIST BY SEARCH AND PRINT
S \230,	TAD \ICMD
S	TAD (-"P /"P "
S	SZA CLA
S	JMP \240 /NO
C
C
C	YES, TRAVERSE THROUGH THE LST. INIT PTR
	JPTR=LIST
S	TAD \LIST#
S	DCA \JPTR#
C
C
C	IF NULL LIST THEN DO NOT PRINT.
S	CLA IAC
S	TAD \LIST#
S	SNA CLA
S	JMP \100 /NULL RETURN
	GOTO 232
C
C	IF JPTR[1:2]=LIST[1:2] THEN DONE ELSE CONTINUE
231	CONTINUE
S	TAD \JPTR
S	CIA
S	TAD \LIST
S	SZA CLA
S	JMP \232 /NO
C
S	TAD \JPTR#
S	CIA
S	TAD \LIST#
S	SNA CLA
S	JMP \100 /NO
C
C	GET AND PRINT THE NODE
232	CONTINUE
	CALL FREESTORE(MEM,NODE,JPTR,JKPT,MSIZE,NREADINFO)
C
C	ADJUST PTR TO NEXT NODE.
	JPTR=NODE(1,2)
	JPTR(2)=NODE(2,2)
C
C	PRINT IT AFTER CVT TO D.P.
	DO 233 I=1,MSIZE
C	CVT TO FP
	CALL DPCVRT(NODE(1,I),FNODE(I),LDTOF)
233	CONTINUE
C
	WRITE(IDEV,234)(FNODE(I),I=1,MSIZE)
234	FORMAT(/,' ***NODE***',/,' ',300(F8.0,/,' '))
	GOTO 231
C	[2.4] IF F THEN PRINT AVAIL LIST SIZE BY SEARCH AND PRINT
S \240,	TAD \ICMD
S	TAD (-"F /"F "
S	SZA CLA
S	JMP \250 /NO
C
C
C	YES, TRAVERSE THROUGH THE LST. INIT PTR
	COUNT=0.0
	JPTR=IAVAIL
S	TAD \IAVAIL#
S	DCA \JPTR#
C
241	CONTINUE
C
C	IF FRONT[JPTR]=IAVAIL
C		THEN DONE;
	CALL FREESTORE(MEM,JKND,JPTR,NN,KSIZE,NGETLEFTPTR)
	IF(NN-IAVAIL)242,247,242
C
S \247,	TAD \NN#
S	CIA
S	TAD \IAVAIL#
S	SZA CLA
S	JMP \242 /NO
C
C
C	DONE
249	WRITE(IDEV,248)COUNT
248	FORMAT(' COUNT=',F10.0,' NODES.')
	GOTO 100
C
C
C	ADJUST PTR TO NEXT NODE.
242	JPTR=NN
S	TAD \NN#
S	DCA \JPTR#
C
C	INCREMENT THE COUNT
	COUNT=COUNT+1.0
	GOTO 241
C	[2.5] IF I THEN INIT THE FREESTORE
250	CONTINUE
S	TAD \ICMD
S	TAD (-"I /"I "
S	SZA CLA
S	JMP \260 /NO
C
C	YES,
	KSIZE(2)=0
	READ(1,251)AVAIL,ENDAVAIL,KSIZE(1)
251	FORMAT(' START OF AVAIL=',F10.0,/,' END OF AVAIL?=',F10.0
     1,/,' NODE SIZE (> 2)=',I5)
C
C
C	CVT TO INTEGER
	CALL DPCVRT(IAVAIL,AVAIL,LFTOD)
	CALL DPCVRT(JPTR,ENDAVAIL,LFTOD)
C
	KSIZE=MAX(3,MIN(KSIZE,300))
	MSIZE=KSIZE
S	DCA \MSIZE#
	CALL FREESTORE(MEM,NODE,IAVAIL,JPTR,KSIZE,NINIT)
C
C
	CALL DPCVRT(KSIZE,SIZE,LDTOF)
	WRITE(IDEV,252)SIZE
252	FORMAT(' FREESTORE INITIALIZED WITH ',F12.0,' NODES.')
	GOTO 100
C
C	[2.6] IF E THEN REQUEST ADDRESS
S\260,	TAD \ICMD
S	TAD (-"E
S	SZA CLA
S	JMP \270
C
C	YES,
C
	READ(1,261)ADDRESS
261	FORMAT(' EXAMINING BM ADDRESS?=',F10.0)
C
C
C	[2.6.1] OPEN THE LOCATION
262	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
C
C	GET IT
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR)
	CALL DPCVRT(NN,VALUE,LDTOF)
	WRITE(IDEV,263)ADDRESS,VALUE,
263	FORMAT(' ',F8.0,'/ ',F8.0)
C
C
C	[2.6.2] IF "0 < ICMD < "9 THEN CLOSE THE LOC ELSE GET #
S WTTYIN,	KSF
S	JMP WTTYIN
S	KRS
S	AND (177
S	TAD (200
S	DCA \ICMD
S	TAD \ICMD
S	TAD (-"0
S	SPA CLA
S	JMP \100 /NO, < "0
C
S	TAD \ICMD
S	TAD (-"9
S	TAD (-1
S	SMA CLA
S	JMP \100 /NO, > "9
C
C
C	[2.6.3] GET REPLACEMENT DATA
	READ(1,265)VALUE
265	FORMAT(F7.0)
	CALL DPCVRT(NN,VALUE,LFTOD)
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NSETBACKPTR)
	GOTO 100
C
C	[2.7] IF LINEFEED THEN PRINT C(ADDRESS_ADDRESS+1);
S\270,	TAD \ICMD
S	TAD (-212 /LF
S	SZA CLA
S	JMP \280 /NO
C
C	YES
	ADDRESS=ADDRESS+1.0
	GOTO 262
C
C	[2.8] IF - THEN PRINT C(ADDRESS_ADDRESS-1);
S\280,	TAD \ICMD
S	TAD (-"-
S	SZA CLA
S	JMP \290 /NO
C
C	YES
	ADDRESS=ADDRESS-1.0
	GOTO 262
C	[2.9] IF " THEN "BACKPOINTER" PRINT C(ADDRESS_C(ADDRESS));
S\290,	TAD \ICMD
S	TAD (-""
S	SZA CLA
S	JMP \300 /NO
C
C	YES
	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR)
	CALL DPCVRT(NN,ADDRESS,LDTOF)
	GOTO 262
C	[2.10] IF # 
C		THEN "LEFT (FORWARD) PTR" PRINT C(ADDRESS_C(ADDRESS+1));
S\300,	TAD \ICMD
S	TAD (-"#
S	SZA CLA
S	JMP \310 /NO
C
C	YES
	ADDRESS=ADDRESS+1.0
	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR)
	CALL DPCVRT(NN,ADDRESS,LDTOF)
	GOTO 262
C	[2.11] IF % 
C		THEN "RIGHT PTR" PRINT C(ADDRESS_C(ADDRESS+2));
S\310,	TAD \ICMD
S	TAD (-"%
S	SZA CLA
S	JMP \320 /NO
C
C	YES
	ADDRESS=ADDRESS+2.0
	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
	CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR)
	CALL DPCVRT(NN,ADDRESS,LDTOF)
	GOTO 262
C	[2.12] IF S 
C		THEN  GET INFO FOR NODE<==TTY;
S\320,	TAD \ICMD
S	TAD (-"S
S	SZA CLA
S	JMP \330 /NO
C
C	YES READ INTO==>NODE ARRAY
	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
	CALL FREESTORE(MEM,NODE,JPTR,JKPT,MSIZE,NREADINFO)
C
C	GET THE INFO FROM THE TTY:
	DO 321 I=4,MSIZE
	WRITE(IDEV,322)I,SPACE,
322	FORMAT(' NODE[',I3,']=',A1)
	READ(1,323)VALUE
323	FORMAT(F7.0)
	CALL DPCVRT(NODE(1,I),VALUE,LFTOD)
321	CONTINUE
C
C	PUT IT BACK INTO NODE
	CALL FREESTORE(MEM,NODE,JPTR,JKPT,MSIZE,NWRITEINFO)
	GOTO 100
C	[2.13] IF R 
C		THEN  GET INFO FOR NODE==>TTY;
S\330,	TAD \ICMD
S	TAD (-"R
S	SZA CLA
S	JMP \340 /NO
C
C	YES READ INTO==>NODE ARRAY
	CALL DPCVRT(JPTR,ADDRESS,LFTOD)
	CALL FREESTORE(MEM,NODE,JPTR,JKPT,MSIZE,NREADINFO)
C
C	CVT TO FP
	DO 331 I=1,MSIZE
	CALL DPCVRT(NODE(1,I),FNODE(I),LDTOF)
331	CONTINUE
C
	DO 332 I=1,MSIZE
	WRITE(IDEV,333)I,FNODE(I)
333	FORMAT(' NODE[',I3,']=',F7.0)
332	CONTINUE
	GOTO 100
C	[2.14] IF / THEN OPEN CURRENT ADDRESS.
S\340,	TAD \ICMD
S	TAD (-"/
S	SZA CLA
S	JMP \350 /NO
C
C	YES
	GOTO 262
C	[2.15] IF ^C THEN RETURN TO OS8
S\350,	TAD \ICMD
S	TAD (-203 /^C
S	SZA CLA
S	JMP \360 /NO
C
C	YES
	CALL EXIT
C	[2.16] IF L THEN TOGGLE PRINT SWITCH
S\360,	TAD \ICMD
S	TAD (-"L
S	SZA CLA
S	JMP \370 /NO
C
C	YES
	IOUTSPOOLV=1-IOUTSPOOLV
	S(1)='TTY'
	S(2)='LPT'
	DEVICE=S(1+IOUTSPOOLV)
	WRITE(1,361)DEVICE
361	FORMAT(' PRINTING ON ',A3)
	GOTO 370
C	[2.17] IF X THEN  RETURN LIST TO FREESTORE.
S\370,	TAD \ICMD
S	TAD (-"X
S	SZA CLA
S	JMP \380 /NO
C
C	YES
S	CLA IAC
S	TAD \LIST#
S	SNA CLA
S	JMP \100 /NULL
C
	CALL FREESTORE(MEM,JKND,IAVAIL,LIST,JKPT,NLISTFREE)
C
C	ZERO THE LIST PTR
	LIST=-1
	LIST(2)=-1
	GOTO 100
C	[2.18] IF Y THEN SET LIST[1:2]<==TTY:
S\380,	TAD \ICMD
S	TAD (-"Y
S	SZA CLA
S	JMP \390 /NO
C
C	YES
	READ(1,381)ALIST
381	FORMAT(' NEW LIST PTR=',F7.0)
	CALL DPCVRT(LIST,ALIST,LFTOD)
	GOTO 100
C	[2.19] IF Z THEN SET IAVAIL[1:2]<==TTY:
S\390,	TAD \ICMD
S	TAD (-"Z
S	SZA CLA
S	JMP \100 /NO
C
C	YES
	READ(1,391)AVAIL
391	FORMAT(' NEW FREESTORE PTR=',F7.0)
	CALL DPCVRT(AVAIL,AVAIL,LFTOD)
	GOTO 100
	END