Directory of image this file is from
This file as a plain text file

/DYN.SB
/
/	DYN : ALLOACTE AND ACCESS DYNAMIC ARRAYS.
/
/	CALL DYRST
/
/	INITIALIZES DYNAMIC MEMORY SYSTEM. DEALLOCATES ALL
/	ARRAYS.
/
/	X = DYDIM( LEN, SIZE)
/
/	ALLOCATES AN ARRAY 'X' OF 'LEN' ELEMENTS OF SIZE 'SIZE'
/	RETURNS 0.0 IF DYNAMIC MEMORY IS FULL.
/
/	CALL DYGET(X,LOW, HIGH, BUF)
/
/	MOVES ELEMENTS LOW...HIGH OF ARRAY 'X' TO USER ARRAY 'BUF'
/
/	CALL DYPUT(X, LOW, HIGH, BUF)
/
/	MOVES ELEMENTS LOW...HIGH OF ARRAY 'BUF' TO DYNAMIC ARRAY 'X'
/
/////////////////////////////////////////////////////////////////////////

OPDEF	TADI	1400
OPDEF	DCAI	3400
ABSYM	TEMP1	176
ABSYM	TEMP2	177
ABSYM	TEMP3	7
OPDEF	CDF0	6201
OPDEF	CLA2	7600	/MODE 2 CLA
ABSYM	X0	10

	LAP
/	DATA AREA	\

FREFLD,	0
LOW,	0
MAXFLD,	0


SZ,
VERR,	0
	CLA
	TAD	ERP
	DCA	X0	/SET TABLE POINTER

NXERR,	TAD I	X0
	DCA	ER1	/GET ERROR MESSAGE
	TAD I	X0
	CIA
	TAD	VERR	/COMPARE ERROR ADDRESSES
	SZA CLA
	JMP	NXERR	/TRY NEXT ERROR

	CALL	1,ERROR
	ARG	VALERR	/VAL? ERROR
ERP,	ERP
	TEXT	'BN'
	BNERR#
	TEXT	'CS'
	CSERR#
	TEXT	'LD'
	LDERR#



/
/	DYPUT : LOAD DYNAMIC ARRAY
/
	ENTRY	DYPUT
DYPUT,	BLOCK	2
	JMS	PREARG
	JMS	SETUP

	TAD	GETFLD	/LOAD DYNAMIC MEMORY
	DCA	PUTFLD
	TAD	ARGFLD
	DCA	GETFLD
	TAD	GETADR
	DCA	PUTADR
	TAD	ARGADR
	DCA	GETADR
	JMP	MVMM	/GO MOVE MEMORY

/
/	DYGET : READ DYNAMIC MEMORY TO USER ARRAY
/
VALERR,	TEXT	'DY'
ER1,	0
	ENTRY	DYGET
DYGET,	0
W,	0
	JMS	PREARG	/PRESET ARG GETTER
	JMS	SETUP	/SETUP ARGUMENTS

TOBUF,	TAD	ARGFLD
	DCA	PUTFLD
	TAD	ARGADR
	DCA	PUTADR

MVMM,	TAD	SZ
	CIA
	DCA	TEMP2

MVLP,	JMS	GETMEM
	JMS	PUTMEM
	ISZ	TEMP2
	JMP	MVLP	/MOVE MORE OF THIS ELEMENT

	ISZ	TEMP1
	JMP	MVMM	/MORE ELEMENTS
	RETRN	DYGET	/ WHEWW!!!

ARGADR,	0
IARG,	0
ARGF,	HLT
	TADI	W
	INC	W
	DCA	ARGFLD	/FIELD OF ARGUMENT
	TADI	W
	INC	W
	DCA	ARGADR
	JMS	GETW
	JMP I	IARG


/
/	SETUP : GET ARGUMENTS, FORM GET, PUT ADDRESSES.
/
SETUP,	0
	JMS	IARG	/GET ARRAY FIELD
	DCA	GETFLD
	TAD	GETFLD	/IS IT A FIELD ( AND NOT A F.P. #!)
	AND	(7707
	TAD	(-6201
	SZA CLA
BNERR,	JMS	VERR	/NOT A CDF!!
	INC	ARGADR
	JMS	GETW	/GET BASE ADDRESS
	DCA	GETADR	/HAVE TO TRUST IT..
	INC	ARGADR
	JMS	GETW
	DCA	SZ	/TRUST GRANULE SIZE

	JMS	IARG
	DCA	LOWSGN	/GET LOW SUBSCRIPT
	TAD	LOWSGN
	SPA
	CIA	/ABS VALUE
	DCA	LOW
	STA
	TAD	LOW
	CALL	1,MPY	/COMPUTE OFFSET
	ARG	SZ
	CLL
	TAD	GETADR	/ADD BASE, WATCH FOR OVERFLOW
	DCA	GETADR
	RTL
	RTL		/SAVE OVERFLOW
	TAD	GETFLD
	DCA	GETFLD	/POSSIBLY BUMP FIELD
	JMS	IARG	/GET HIGH SUBSCRIPT
	CMA
	TAD	LOW	/COMPUTE # OF ELEMENTS
	DCA	TEMP1
	JMS	IARG	/GET USER ARRAY PLACE
K7600,
KM200,	CLA2
	JMP I	SETUP	/RETURN
LOWSGN,	0

GETW,	0
ARGFLD,	HLT
	TADI	ARGADR	/GET ARG
	JMP I	GETW


	PAGE

SIZE,	0
TYPE,	0
FREADR,	0
GETADR,	0
PUTADR,	0

/
/	DYDIM : ALLOCATE DYNAMIC ARRAY
/
	ENTRY	DYDIM
DYDIM,	BLOCK	2
	JMS	PREARG
	JMS	IARG
	DCA	SIZE
	JMS	IARG
	DCA	TYPE
	TAD	TYPE
	CALL	1,MPY
	ARG	SIZE
	DCA	LENGTH
	TAD	FREFLD
	DCA	ACH
	TAD	FREADR
	DCA	ACM
	TAD	TYPE
	DCA	ACL
	CLL
	TAD	FREADR
	TAD	LENGTH
	DCA	FREADR
	RTL
	RTL		/CHECK FOR OVERFLOW
	TAD	FREFLD
	DCA	FREFLD
	TAD	FREFLD
	CIA
	TAD	MAXFLD
	SPA CLA
	JMP	ZERO	/OUT OF MEMORY!!
VALRTN,	RETRN	DYGET	/ALLOCATED

ZERO,	DCA	ACH
	DCA	ACM
	DCA	ACL
	JMP	VALRTN

PREARG,	0
	TAD	PREARG
	TAD	(-4
	DCA	X0
	TAD I	X0	/GET CALLING FIELD
	DCA	ARGF	/PUT INTO ARG GETTER
	TAD	ARGF
	DCA	DYGET	/FOR RETURN, O'COURSE!
	TAD I	X0
	DCA	W	/PLACE INTO ARG GETTER ADDR.
	JMP I	PREARG


/
/	DYRST : INITIALIZE DYNAMIC MEMORY
/
	ENTRY	DYRST
DYRST,	BLOCK	2
CDFI,
SETSIZ,	CDF0
	TADI	(7777
	AND	(70
	SNA
CSERR,	JMS	VERR	/NO CORE SIZE SET!
	TAD	CDFI
	DCA	MAXFLD
	CDF0
	TADI	(377	/GET TOP FIELD FROM LOADER (WE HOPE)
	SNA
LDERR,	JMS	VERR		/NO FIELD!!
	TAD	(-6221		/BELOW FIELD 2?
	SPA
	CLA			/ASSUME 2
	TAD	(6221		/RESTORE FIELD
CDFZZ,	DCA	FREFLD		/SAVE FIELD
	CDF0
	TADI	(507
	TAD	(377
	DCA	LENGTH
	TADI	LENGTH
	
CDFGG,	DCA	FREADR
	RETRN	DYRST

LENGTH,
GETMEM,	0
GETFLD,	HLT
	TADI	GETADR	/GET MEM WORD
	ISZ	GETADR
	JMP	GETRTN
	DCA	TEMP3
	TAD	GETFLD
	TAD	(10
	DCA	GETFLD
	TAD	TEMP3
GETRTN,	JMP I	GETMEM

PUTMEM,	0
PUTFLD,	HLT
	DCAI	PUTADR
	ISZ	PUTADR
	JMP	PUTRTN
	TAD	PUTFLD
	TAD	(10
	DCA	PUTFLD
PUTRTN,	JMP I	PUTMEM


	END