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

Comment * SIMULA specification;
OPTIONS(/E:QUICK,ZYLISG);
CHARACTER PROCEDURE insinglechar(ifile); REF(Infile)ifile;

!*;! MACRO-10 code !*;!

	TITLE	insinglechar
	ENTRY	ZYLISG
	SUBTTL	SIMULA utility, Lars Enderin Mar 1976

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


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	ifile==XWAC1
	fcode==XWAC10
	iondx==XWAC11
	OPDEF	IONDX.	[CALLI	127]

	bup==OFFSET(ZBHBUP)
	cnt==OFFSET(ZBHCNT)

	.TOIIC==11	;! TRMOP code for image mode input of one char

ZYLISG:	PROC
	EXCH	XWAC1,(XTAC)
	IF	;! Controlling terminal
		CAIN	XWAC1,NONE
		GOTO	TRUE
		IFOFF	ZFITA(XWAC1)
		GOTO	FALSE
	THEN	; ! Use INCHRW
		INCHRW	(XTAC)
		GOTO	L9
	FI
	SAVE	<XBH,iondx,fcode>
	IF	; ! Another terminal
		IFOFF	ZFITU(ifile)
		GOTO	FALSE
	THEN	; ! Use TRMOP
		LF	iondx,ZFIDVN(XWAC1)	; ! Get i/o index corresponding to device
		IONDX.	iondx,
		SETZ	iondx,	; ! Error
		JUMPE	iondx,L2	; ! Handle like dsk on error
		LI	fcode,.TOIIC
		L	XWAC1,[2,,fcode]
		TRMOP.	XWAC1,
		JSP	error
		GOTO	L8
	FI
L2():!	;! Ordinary file handling
	IF	;! [143] No more data last time
		IFOFF	ZFIEND(ifile)
		GOTO	FALSE
	THEN	;! Set ENDFILE, return ^Z
		SETON	ZIFEND(ifile)
		L	XWAC1,"Z"-"A"+1
		GOTO	L8
	FI
	LF	XBH,ZFIIBH(XWAC1)
	SUBI	XBH,1
	IF	;! Character available in buffer
		SOSGE	CNT(XBH)
		GOTO	FALSE
	THEN	;! Get it
		ILDB	XWAC1,bup(XBH)
	ELSE	;! Must get new buffer first
		SETON	ZFINB(ifile)
		EXEC	IORB
		SETOFF	ZFINB(ifile)
		IF	;! EOF
			IFOFF	ZFIEND(ifile)
			GOTO	FALSE
		THEN	;! Return ^Z
			LI	XWAC1,"Z"-"A"+1
		ELSE	;! Return next char
			GOTO	L2	;! [143] and count it
	FI	FI
L8():!	RESTORE
L9():!	EXCH	XWAC1,(XTAC)
	POPJ	XPDP,
error:	OUTSTR	[ASCIZ/
?ZYLISG TRMOP error in INSINGLECHAR
/]
	RTSERR	QDSCON,214
	SETZ	XWAC1,	;! Return null on proceeding
	GOTO	L8
	EPROC
	LIT
	END;