Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/crc/ind/indtlk.mac
There are no other files named indtlk.mac in the archive.
	title indtlk - Display program to step through overheads
;
;	This program is just a simple display routine to cycle through sets
;	of displays, in large letters on the screen. It is set up so that,
;	at first, the initial line of each screen is in bold charachters.
;	as the space bar is hit, each line is emboldened in turn. After a screen
;	ful is cycled through, we move onto the next one.
;
	search	vtmac
	$titl==0
	vtstor
	regdef
	.request sys:sub
	external	$vtinit,$putcrs,$vtbig,$vtatr,$curhom,$cleos,$vtend
	external	$vtgon,$vtgoff,$vtscrn,$vt132,$vt80,$cleol,$vtdwn
	external	$vtlft,$curup

	cexit.==:12345

	slen==^d50		;stack size
;
;	These are the tables of screen displays.
;	The format is:
;	Header for display, either standard format (as below) or -1
;	if -1, next word is address of special routine
;	if standard, followed by standard format words containing a single
;	screenfull. Screen is terminated by 0 word. Entire sequence is
;	terminated by 2 zero words.
;
;	LH:	Address of a word containg the cursor position for this
;		display line
;	RH:	Address of an ASCIZ string for this position
;		A zero word terminates each display.
;
	define	line(x,y,text),< [x,,y],,[asciz\text\]>

	define	cursor(x,y),< movei	t2,x
			movei	t1,y
			call	$putcrs>
dstart:

	line	4,1,<Advantages of TAKE files>
	line	1,4,< o Less typing>
	line	1,7,< o Less thinking>
	line	1,^d10,< o Less room for error>
	line	1,^d13,< o Permanent record for others>
	0
	line	2,1,<Disadvantages of TAKE files>
	line	1,4,< o Fixed set of commands>
	line	1,7,< o Only EXEC commands allowed>
	line	1,^d10,< o No interaction with user>
	line	1,^d13,< o No loops or tests>
	0
	line	8,1,<Possible solutions>
	line	1,4,< o Modify the EXEC - extra commands>
	line	1,7,< o Enhance the MIC program>
	line	1,^d10,< o Design a new utility :>
	0
	-1		;start of special function block
	bigind		;address of routine for special function block
	line	^d10,1,<Goals of IND>
	line	1,4,< o Provide all facilities of TAKE>
	line	1,7,< o Provide for 'Parameters' for files>
	line	1,^d10,< o Provide for loops, tests, error trap>
	line	1,^d13,< o Provide for user interaction>
	line	1,^d16,< o Ease of use - power + simplicity>
	0
	line	^d6,1,<What an IND file can contain>
	line	1,4,< o EXEC commands>
	line	1,6,< o Program commands>
	line	1,^d8,< o Messages for the terminal>
	line	1,^d10,< o Directives to control IND>
	line	1,^d12,< o Requests for user input>
	line	1,^d14,< o Comments>
	line	1,^d16,< o Subroutines>
	line	1,^d18,< o Variables>
	0
	line	^d8,1,<IND variables - types>
	line	1,4,< o Logical, numeric, string or file>
	line	1,7,< o May appear anywhere in command file>
	line	1,^d10,< o User input or program control>
	line	1,^d13,< o Tested, compared, or 'substituted'>
	line	1,^d16,< o Range checks and defaults for input>
	line	1,^d19,< o Special variables for username etc.>
	0
	line	^d8,1,<What an IND file contains>
	line	1,4,<EXEC commands - as in TAKE files>
	line	1,7,<IND directives - precede by .>
	line	1,^d10,<Messages - precede by ;>
	line	1,^d13,<Comments - precede by .;>
	0
	line	^d8,1,<Classes of IND directives>
	line	1,4,<Requests for input: .ASKS,.ASK>
	line	1,7,<Tests, comparisons: .IF, .IFT>
	line	1,^d10,<Control: .GOTO,.GOSUB,.CALL>
	line	1,^d13,<Variable definition: .INC,.SETS,SETT>
	line	1,^d16,<File handling: .OPEN,.DATA,.TESTFILE>
	line	1,^d19,<Time-based commands:.DELAY,.PAUSE>
	0
	line	^d8,1,<Input commands>
	line	1,4,<.ASK var Yes or no question>
	line	1,6,< Asks a yes/no question, sets var>
	line	1,8,<.ASKN var Numeric question>
	line	1,^d10,< Asks a question with numeric answer>
	line	1,^d12,<.ASKS var Question>
	line	1,^d14,< Asks a question and records text answer>
	line	1,^d16,<.ASKF var Question>
	line	1,^d18,< Asks a question with a filename answer>
	line	1,^d21,<.ASKN, .ASKS have upper/lower limits>
	0
	line	^d8,1,<Logical test directives>
	line	1,4,<.IFT var command>
	line	1,6,< Executes command if var is true>
	line	1,8,<.IFF var command>
	line	1,^d10,< Executes command if var is false>
	line	1,^d12,<.IFDEF var command>
	line	1,^d14,< Executes command if var is defined>
	line	1,^d16,<.IFNDEF var command>
	line	1,^d18,< Executes command if var is not defined>
	line	1,^d21,< Command can be anything, including .IF>
	0
	line	^d8,1,<Comparison directives>
	line	1,4,<.IF var relop expression command>
	line	1,6,< Execute command if comparison is true>
	line	1,8,<Var is numeric or string variable>
	line	1,^d10,<Expression is numeric or string>
	line	1,^d12,<Relop is one of following:>
	line	1,^d14,< =,<,=<,>,>=,~=>
	line	1,^d16,< Also permitted are:>
	line	1,^d18,< EQ,LT,LE,GT,GE,NE>
	line	1,^d20,< Strings are compared ignoring case>
	0
	line	^d8,1,<Variable definition>
	line	1,4,<.SETN var expression>
	line	1,7,<.SETS VAR expression>
	line	1,^d10,< Sets variable to value of expression>
	LINE	1,^D13,<.SETF var (or .SETT var)>
	line	1,^d16,< Sets logical variable true or false>
	line	1,^d19,<.INC var (or .DEC var)>
	line	1,^d21,< Increments or decrements numeric variable>
	0
	line	^d10,1,<Examples:>
	LINE	1,4,<.ASKS NAME What is your name ?>
	line	1,7,<.IF NAME EQ "PANAY" .GOTO HELP>
	line	1,^d10,<;	Hello, 'name'>
	line	1,^d13,<CONNECT <'NAME'>>
	0
	-1			;special function block for substitution
	subst			;address of routine
	line	^d8,1,<Program control directives>
	line	1,4,<.GOTO label - jumps to label>
	line	1,7,<.GOSUB label - subroutine call>
	line	1,^d10,<.RETURN - from .GOSUB>
	line	1,^d13,<.CALL filename - nest IND files>
	line	1,^d16,< .CALL preserves all variables>
	line	1,^d19,<.RUN program data>
	line	1,^d21,< Runs a program with input from terminal>
	0
	line	^d8,1,<File control directives>
	line	1,4,<.OPEN filename, .OPENA filename>
	line	1,6,< Opens output data file (possibly for append)>
	line	1,8,<.DATA text>
	line	1,^d10,< Sends text to current data file>
	line	1,^d12,<.CLOSE>
	line	1,^d14,< Closes current data file>
	line	1,^d16,<.TESTFILE filename>
	line	1,^d18,< Checks for existence of file. Returns:>
	line	1,^d20,< Exists, not exists, Invisible, offline, deleted>
	0
	line	^d6,1,<Control operating mode>
	line	1,4,<.ENABLE/.DISABLE keyword>
	line	1,7,<EXTENDED-EXEC>
	line	1,9,<ESCAPE>
	line	1,^d11,<CONTROL-Z-EXITS>
	line	1,^d13,<SUBSTITUTION>
	line	1,^d15,<QUIET>
	line	1,^d17,<TRACE>
	line	1,^d19,<DATA>
	line	1,^d21,< .ENABLE DATA only stopped by .DISABLE DATA>
	0
	0

dend:

stack:	block	slen
dbuf:	block	^d30
entvec:	jrst	start
	jrst	start
	verno	1,,1,3

start:	reset%			;clear the world
	move	p,[iowd slen,stack]
	call	$vtinit		;set up the terminal, JFN word, etc.
	movei	p1,dstart	;point to start of display buffers
;
;	Now loop through all displays
;
displa:	call	header		;display the heading line
	movem	p1,p2			;save pointer to one-liners
disp1:	move	t3,(p1)			;get next one-liner
	jumpe	t3,dbold		;if zero, go through bold bit
	hlrz	t4,t3			;get cursor addresses
	hlrz	t2,(t4)			;get x
	hrrz	t1,(t4)			;get y
	push	p,t3
	call	$putcrs			;position for this line
	pop	p,t3			;get back one-liner description
	hrro	t1,t3			;construct string pointer
	call	$vtbig			;type out line
	aoja	p1,disp1		;loop for all lines
dbold:	move	p1,p2		;get back pointer to one-liners
dbold1:	move	t4,(p1)			;get next word of table
	jumpe	t4,dnext		;if zero, go for next display
	hlrz	t3,t4			;get cursor address pointer
	hlrz	t2,(t3)			;get row
	hrrz	t1,(t3)			;get column
	push	p,t3			;save all
	call	$putcrs			;position for re-write
	pop	p,t3
	movei	t1,1			;turn bold on
	call	$vtatr			;set it
	hrro	t1,t4			;point to one-liner
	push	p,t3
	push	p,t4
	call	$vtbig			;display it
	pbin%				;wait for a character
	pop	p,t4
	pop	p,t3
	hlrz	t3,t4			;now retrieve cursor position
	hlrz	t2,(t3)
	hrrz	t1,(t3)
	call	$putcrs			;back to start of line
	setz	t1,			;turn bold off
	call	$vtatr
	hrro	t1,t4			;point to text again
	call	$VTbig			;redisplay without bold
	aoja	p1,dbold1		;loop through all one-liners
dnext:	aoj	p1,			;step to  next display
	skipn	(p1)			;is there one ?
	 jrst	[call	$curhom		;no, finish up
		call	$cleos
		call	$vtend
		haltf%]
	jrst	displa			;yes, do it
;
;	Routine to type header underlined
;
header:	call	$curhom			;cursor home
	call	$cleos			;clear to end of screen
	skipg	(p1)			;is it a standard header ?
	 jrst	[aoj	p1,		;no, special function block
		call	@(p1)		;dispatch to routine
		aoj	p1,		;try next block
		jrst	header]
	movei	t1,4			;set underline mode
	call	$vtatr
	movei	t1,1			;set bold mode
	call	$vtatr
	hlrz	t3,(p1)			;get cursor addresses
	hrrz	t1,(t3)			;row
	hlrz	t2,(t3)			;and column
	call	$putcrs			;position
	hrroi	t1,[byte (7) 33,"#","3"] ; set to top half of line
	psout%
	hrro	t1,(p1)			;get string
	psout%				;type it
	hlrz	t3,(p1)			;now get cursor address again
	hrrz	t1,(t3)
	hlrz	t2,(t3)			;row and column
	aoj	t1,			;bump the row number
	call	$putcrs			;position the cursor for bottom half
	hrroi	t1,[byte (7) 33,"#","4"] ; set up bottom half
	psout%
	hrro	t1,(p1)
	psout%				;output string again
	setz	t1,			;turn off underline
	call	$vtatr
	aoj	p1,
	ret
;
;	Special function block routine - large word IND
;
;
;	special	macro to generate rows of big text
;
	$yst==6

	define big(text),<
	movei	t1,$yst
	movei	t2,8
	call	$putcrs
	hrroi	t1,[byte (7) 33,"#","3",0]
	psout%
	hrroi	t1,[asciz/text/]
	psout%
	movei	t1,$yst+1
	movei	t2,8
	call	$putcrs
	hrroi	t1,[byte (7) 33,"#","4",0]
	psout%
	tmsg	<'text'>
	$yst==$yst+2>

bigind:	setz	t1,		;light background
	call	$vtscrn		;do it
	movei	t1,7
	call	$vtatr
	movei	t1,1		;reverse
	call	$vtatr
	call	$vtgon		;graphics on
	big	<aaaaa  a   a  aaa  >
	big	<  a    aa  a  a  a >
	big	<  a    a a a  a   a>
	big	<  a    a a a  a   a>
	big	<  a    a a a  a   a>
	big	<  a    a  aa  a  a >
	big	<aaaaa  a   a  aaa  >
	pbin%
	movei	t1,1		;set screen dark again
	call	$vtscrn
	setz	t1,
	call	$vtatr		;turn off all attributes
	call	$vtgoff		;turn off graphics
	ret
;
;	routine to graphically demonstrate substitution
;
subst:	call	$vt132
	cursor	1,1
	hrroi	t1,[asciz/	      Substitution at work/]
	call	$vtbig
	cursor	1,4
	hrroi	t1,[asciz/.ASKN [1:1000:200] BFAC Number of Records per block: /]
	call	$vtbig
	cursor	1,6
	hrroi	t1,[asciz/.SETN WORDS BFAC*RECLEN/]
	call	$vtbig
	cursor	1,8
	hrroi	t1,[asciz/SET TAPE RECORD-LENGTH 'WORDS'/]
	call	$vtbig
	pbin%
	cursor 1,4
	call	$cleol
	cursor	1,5
	call	$cleol
	cursor	1,4
	hrroi	t1,[asciz/ * Records per block [R:1:1000 D:200] :/]
	call	$vtbig
	cursor	^d40,4
	movei	t1,1
	call	$vtatr
	move	t2,[point 7,dbuf]
subst2:	pbin%		;get a char
	cain	t1,15		;carriage return ?
	 jrst	subst1		;yes
	push	p,t1
	push	p,t2
	movei	t1,1
	call	$vtdwn
	movei	t1,1
	call	$vtlft
	pop	p,t2
	pop	p,t1
	pbout%
	idpb	t1,t2
	movei	t1,1
	push	p,t2
	call	$curup
	pop	p,t2
	jrst	subst2
subst1:	hrroi	t1,dbuf
	movx	t3,^d10
	nin%
	 erjmp	[jshlt]
	skipn	t2
	movei	t2,^d200
	push	p,t2
	setz	t1,
	call	$vtatr
	pbin%
	cursor	1,6
	call	$cleol
	cursor	1,7
	call	$cleol
	hrroi	t1,dbuf
	hrroi	t2,[asciz/@SET TAPE RECORD-LENGTH /]
	setzb	t3,t4
	sout%
	 erjmp	[jshlt]
	pop	p,t2
	imuli	t2,^d80
	movx	t3,^d10
	nout%
	 erjmp	[jshlt]
	cursor	^d1,8
	call	$cleol
	cursor	1,9
	call	$cleol
	cursor	1,8
	hrroi	t1,dbuf
	call	$vtbig
	pbin%
	call	$vt80
	ret
	end	<3,,entvec>