Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT ! SIMULA specification;
OPTIONS(/EXTERNAL:CODE,NOCHECK,read);
PROCEDURE read;

!;! MACRO-10 code !

	TITLE	read
	SUBTTL	SIMULA utility, Lars Enderin Nov 1975

;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***

	SEARCH	simrpa,simmcr,simmac
	sall
	macinit
	ENTRY	read

Comment/
Reads items into successive parameters from the current Infile or Directfile.
The current file is initially Sysin, but may be changed by giving another
Infile or Directfile reference as parameter. The other parameters may be of type
INTEGER, REAL, LONG REAL or CHARACTER. Inint, Inreal or Inchar is used depending
on the parameter type. Since the procedure is specified NOCHECK, all parameters
are passed by name. Arrays of suitable types are allowed as parameters.
/
	DEFINE	NOTHUNK(X)<JUMPGE X,FALSE>
	Xtyp==XWAC10
	Xkind==XWAC11
	XN==Xkind+1

	OPDEF	readitem	[PUSHJ XPDP,readitem]


read:
	PROC
	LOWADR
	L	XWAC2,YSYSIN(XLOW)	;! Default input file
	HRLI	XWAC1,2			;! Dynamic addr of ZFL
	HRRI	XWAC1,(XCB)

	WHILE	;! More parameters
		CAML	XWAC1,[^D32+1,,0]
		GOTO	FALSE
		HLRZ	X1,XWAC1
		ADDI	X1,(XWAC1)	;! abs addr of ZFL
		SKIPN	(X1)		;! No more if ZFL=0
		GOTO	FALSE
	DO
		WLF	,ZFLAKD(X1)	;! 1st ZFL word to X0
		LF	Xkind,ZFLAKD	;! Kind
		LF	Xtyp,ZFLATP	;! Type
		IF	;! type is REF
			CAIE	Xtyp,QREF
			GOTO	FALSE
		THEN	;! It has to be NONE, Infile or Directfile
			L	XWAC2,XWAC1
			EXEC	PHFV		;! Get file ref
			XWD	1,[1B0]		;! preserves ZFL address
			IF	;! NONE
				CAIE	XWAC2,NONE
				GOTO	FALSE	;![145]
			THEN	;! Assume Sysin
				LOWADR
				L	XWAC2,YSYSIN(XLOW)
			ELSE	;! Check qualification
				HLRZ	X1,XWAC1
				ADDI	X1,(XWAC1)
				LF	,ZFLZQU(X1)
				IF	;! Not Infile or Directfile
					CAIE	IOIN
					CAIN	IODF
					GOTO	FALSE
				THEN	;! Error!
					RTSERR	111	;! Wrong qualification
			FI	FI
		ELSE	;! Expressions are not allowed
			IFONA	ZFLVTD
			RTSERR	100	;! Illegal assignment implied
			IF
				NOTHUNK
			THEN	;! Compute parameter address directly
				LF	XWAC3,ZFLOFS(X1)
				ADD	XWAC3,OFFSET(ZFLZBI)(X1)
				CAIN	Xkind,QARRAY
				L	XWAC3,(XWAC3)	;! Array address
			ELSE	;! Evaluate thunk for the address
				L	XWAC3,XWAC1
				LI	X1,PHFA		;! For simple items
				CAIN	Xkind,QARRAY
				LI	X1,PHFM		;! For arrays
				EXEC	0(X1)
				XWD	2,[1B0+1B1]
				HLRZ	XWAC4,XWAC3	;! Abs address from
				ADDI	XWAC3,(XWAC4)	;!  dynamic address
				HLRZ	X1,XWAC1	;! Reload X1, Xtyp
				ADDI	X1,(XWAC1)
				LF	Xtyp,ZFLATP(X1)
			FI
			L	XWAC4,XWAC2	;! Load top ac
			LI	XTAC,XWAC4	;! Specify top ac
			IF	;! Kind is simple
				CAIE	Xkind,QSIMPLE
				GOTO	FALSE
			THEN	;! input one item
				readitem
			ELSE	;! Must be array
				CAIE	Xkind,QARRAY
				RTSERR	113
				LF	XN,ZARSUB(XWAC3)
				IMULI	XN,3
				LF	,ZARLEN(XWAC3)
				SUBI	3(XN)
				MOVN		;! Neg count
				ADDI	XWAC3,3(XN)
				HRLM	XWAC3	;! AOBJN word
				IF	;! TEXT or LONG REAL
					CAIE	Xtyp,QTEXT
					CAIN	Xtyp,QLREAL
					GOTO	TRUE
					GOTO	FALSE
				THEN	;! 2 words at a time
					LOOP
						readitem
					AS
						AOBJP	XWAC3,.+1
						AOBJN	XWAC3,TRUE
					SA
				ELSE	;! One word
					LOOP
						readitem
					AS
						AOBJN	XWAC3,TRUE
					SA
			FI	FI
		FI
		ADD	XWAC1,[2,,0]
	OD
	BRANCH	CSES
	EPROC

readitem:PROC
	L	XWAC4,XWAC2	;! Load top ac
	LI	XTAC,XWAC4	;! Specify top ac
	IF	;! INTEGER
		CAIE	Xtyp,QINTEGER
		GOTO	FALSE
	THEN	;! use Inint
		EXEC	IOII
	ELSE
	IF	;! REAL or LONG REAL
		CAILE	Xtyp,QLREAL
		GOTO	FALSE
	THEN	;! use Inreal
		EXEC	IOIR
		CAIN	Xtyp,QLREAL
		ST	1+XWAC4,1(XWAC3)	;! Store second word
	ELSE
	IF	;! CHARACTER
		CAIE	Xtyp,QCHARACTER
		GOTO	FALSE
	THEN	;! use Inchar
		EXEC	IOIC
	ELSE	;! Wrong type
		RTSERR	107
	FI	FI	FI
	ST	XWAC4,(XWAC3)	;! Store (first word of) value
	RETURN
	EPROC
	END;