Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/insngl.mac
There is 1 other file named insngl.mac in the archive. Click here to see a list.
00100	Comment * SIMULA specification;
00200	OPTIONS(/E:QUICK,insngl);
00300	CHARACTER PROCEDURE insngl(ifile); REF(Infile)ifile;
00400	
00500	!*;! MACRO-10 code !*;!
00600	
00700		TITLE	insngl
00800		ENTRY	insngl
00900		SUBTTL	SIMULA utility, Lars Enderin Mar 1976
01000	
01100	;!*** Copyright 1976 by the Swedish Defence Research Institute. ***
01200	;!*** Copying is allowed.					***
01300	
01400	
01500		sall
01600		search	simmac,simmcr,simrpa
01700		macinit
01800	
01900		;! Local definitions ;!
02000	
02100		ifile==XWAC1
02200		fcode==XWAC10
02300		iondx==XWAC11
02400		OPDEF	IONDX.	[CALLI	127]
02500	
02600		bup==OFFSET(ZBHBUP)
02700		cnt==OFFSET(ZBHCNT)
02800	
02900		.TOINC==10	;! TRMOP code for line mode input of one char
03000	
03100	insngl:	PROC
03200		EXCH	XWAC1,(XTAC)
03300		IF	;! Controlling terminal
03400			CAIN	XWAC1,NONE
03500			GOTO	TRUE
03600			IFOFF	ZFITA(XWAC1)
03700			GOTO	FALSE
03800		THEN	; ! Use INCHWL
03900			INCHWL	(XTAC)
04000			GOTO	L9
04100		FI
04200		SAVE	<XBH,iondx,fcode>
04300		IF	; ! Another terminal
04400			IFOFF	ZFITU(ifile)
04500			GOTO	FALSE
04600		THEN	; ! Use TRMOP
04700			LF	iondx,ZFICHN(XWAC1)	; ! Get i/o index corresponding to channel
04800			IONDX.	iondx,
04900			 SETZ	iondx,	; ! Error
05000			JUMPE	iondx,L2	; ! Handle like dsk on error
05100			LI	fcode,.TOINC
05200			L	XWAC1,[2,,fcode]
05300			TRMOP.	XWAC1,
05400			 JSP	error
05500			GOTO	L8
05600		FI
05700	L2():!	;! Ordinary file handling
05800		IF	;! [143] No more data last time
05900			IFOFF	ZFIEND(ifile)
06000			GOTO	FALSE
06100		THEN	;! Set ENDFILE, return ^Z
06200			SETON	ZIFEND(ifile)
06300			L	XWAC1,"Z"-"A"+1
06400			GOTO	L8
06500		FI
06600		LF	XBH,ZFIIBH(XWAC1)
06700		SUBI	XBH,1
06800		IF	;! Character available in buffer
06900			SOSGE	CNT(XBH)
07000			GOTO	FALSE
07100		THEN	;! Get it
07200			ILDB	XWAC1,bup(XBH)
07300		ELSE	;! Must get new buffer first
07400			SETON	ZFINB(ifile)
07500			EXEC	IORB
07600			SETOFF	ZFINB(ifile)
07700			IF	;! EOF
07800				IFOFF	ZFIEND(ifile)
07900				GOTO	FALSE
08000			THEN	;! Return ^Z
08100				LI	XWAC1,"Z"-"A"+1
08200			ELSE	;! Return next char
08300				GOTO	L2	;! [143] and count it
08400		FI	FI
08500	L8():!	RESTORE
08600	L9():!	EXCH	XWAC1,(XTAC)
08700		POPJ	XPDP,
08800	error:	OUTSTR	[ASCIZ/
08900	?INSNGL TRMOP error
09000	/]
09100		RTSERR	QDSCON,214
09200		SETZ	XWAC1,	;! Return null on proceeding
09300		GOTO	L8
09400		EPROC
09500		LIT
09600		END;