Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/05/vdccin.mac
There are 2 other files named vdccin.mac in the archive. Click here to see a list.
00100	COMMENT * VDCCIN, SIMULA specification;
00200	OPTIONS(/E:QUICK,VDCCIN);
00300	PROCEDURE VDCCIN;
00400	COMMENT
00500	Save settings of FORM, PAGE, BLANKS and TABS. Set up for ^C interrupt
00600	to reset to initial settings,  but  revert  to  current  settings  if
00700	continued.
00800	Also contains, at VDCC.O, code  for  VDCCOUT,  which  restores  TRMOP
00900	settings   and   disables  ^C  interrupt.  VDCC.O  is  referred  from
01000	VDCCOU.MAC, q.v.
01100	;
01200	
01300	!*;! MACRO-10 code !*;!
01400	
01500		TITLE	VDCCIN
01600		ENTRY	VDCCIN, VDCC.O
01700		SUBTTL	SIMULA utility, Lars Enderin Feb 1979
01800	
01900	;!*** Copyright 1979 by the Swedish Defence Research Institute. ***
02000	;!*** Copying is allowed.					***
02100	
02200	
02300		sall
02400		search	simmac,simmcr,simrpa
02500		macinit
02600		EXTERN .VDCCI	;! Data area
02700	
02800		;! Local definitions ;!
02900	
03000		DEFINE TRMOP(CODE) ;! Read value (CODE = 1xxx)<
03100	<	LI CODE
03200		ST FCD(X2)
03300		LI FCD(X2)
03400		HRLI 3
03500		TRMOP.
03600		 GOTO [OUTSTR [ASCIZ/
03700	?VDCCIN TRMOP error
03800	/]
03900		RET]
04000	>
04100	
04200		DEFINE TRMOPW(CODE) ;! Change value from X0. (CODE = 1xxx)
04300	<	ST VAL(X2)
04400		LI 1000+CODE
04500		ST FCD(X2)
04600		LI FCD(X2)
04700		HRLI 3
04800		TRMOP.
04900	
05000		 GOTO [OUTSTR [ASCIZ/
05100	?VDCCIN TRMOP error
05200	/]
05300		RET]
05400	>
05500	
05600	;! Structure of data area
05700	
05800	SV==0		;! Saved flags
05900	CIN==SV+1	;! ^C interrupt block
06000	PCI==CIN+.EROPC	;! PC of interrupt stored at this offset
06100	DF reason,CIN+.ERCCL,18,17 ;! Interrupt error flag
06200	FCD==CIN+4	;! Function code for TRMOP.
06300	UDX==FCD+1	;! Universal device index for terminal
06400	VAL==FCD+2	;! Value for TRMOP.
06500	
06600	;! Fields for TRMOP values
06700	
06800	 DF FORM,0,2,2
06900	 DF PAGE,0,2,4
07000	 DF TABS,0,2,6
07100	 DF BLANKS,0,2,8
07200	
07300	XRET==X6
     
07400	VDCCIN: PROC
07500	
07600		LD [4,,VDCINT	;! Set up interrupt block for ^C
07700		    0,,ER.ICC]	;! No message control, handle ^C
07800		LI X2,.VDCCI	;! Address of data area
07900		STD CIN(X2)
08000		SETZM CIN+2(X2)
08100		SETZM CIN+3(X2)
08200	
08300		SETO		;! Find UDX of terminal
08400		TRMNO.
08500		 HALT .
08600		ST UDX(X2)
08700	
08800		JSP XRET,VDCCSV	;! Save certain TRMOP settings
08900		LI CIN+.VDCCI;! Enable ^C interrupt, handled at VDCINT
09000		ST .JBINT
09100		RET
09200	
09300	VDCC.O:	;! Reset as at initial call
09400		LI X2,.VDCCI	;! Data area address
09500		JSP XRET,VDCCRS	;! Restore certain TRMOP. settings
09600		SETZM .JBINT	;! Disable ^C interrupt
09700		RET
09800	
09900		EPROC
     
10000	VDCINT:! PROC
10100		SAVE <X0,X1,X2,XRET,X5,X7>
10200		LI X2,.VDCCI	;! Address of data area
10300		LF X1,reason(X2)
10400		CAIE X1,ER.ICC
10500		 HALT .
10600		L X5,(X2)	;! Save initial status in X5
10700		JSP XRET,VDCCSV
10800		EXCH X5,(X2)
10900		JSP XRET,VDCCRS
11000		EXCH X5,(X2)
11100		LI X7,VDCIRE	;! REENTER address
11200		SKIPE .JBREN	;! No change if zero
11300		 EXCH X7,.JBREN
11400		MONRT.		;! To monitor with .
11500	VDCINR:! JSP XRET,VDCCRS ;! Back here if continued, revert to settings
11600				;!  before ^C interrupt
11700		ST X5,(X2)	;! Saved initial status
11800		RESTORE		;! saved ac's
11900		STACK PCI+.VDCCI ;! Interrupt PC as return addrees
12000		SETZM PCI+.VDCCI ;! Enable for new interrupts
12100		RET
12200		EPROC
12300	
12400	VDCIRE:! L PCI+.VDCCI	;! Continue there after PROCEED
12500		ST .JBOPC
12600		HRRM X7,PCI+.VDCCI ;! Will go to specified REENTER address
12700		EXCH X7,.JBREN
12800		GOTO VDCINR
     
12900	VDCCRS:! ;! Restore from (X2)
13000		LF ,FORM(X2)
13100		TRMOPW(.TOFRM)
13200		LF ,PAGE(X2)
13300		TRMOPW(.TOPAG)
13400		LF ,TABS(X2)
13500		TRMOPW(.TOTAB)
13600		LF ,BLANKS(X2)
13700		TRMOPW(.TOBLK)
13800		BRANCH (XRET)
     
13900	VDCCSV:! ;! Save at (X2)
14000		TRMOP(.TOFRM)
14100		SF ,FORM(X2)
14200		TRMOP(.TOPAG)
14300		SF ,PAGE(X2)
14400		TRMOP(.TOTAB)
14500		SF ,TABS(X2)
14600		TRMOP(.TOBLK)
14700		SF ,BLANKS(X2)
14800		BRANCH (XRET)
14900		LIT
15000		END;