Google
 

Trailing-Edge - PDP-10 Archives - tops20_version7_0_tools_tape_clock_tape - tools/typvfu/typvfu.mac
There are 4 other files named typvfu.mac in the archive. Click here to see a list.
	TITLE	TYPVFU - Program to format DAVFU files

	SEARCH	GLXMAC,ORNMAC
	PROLOG	(TYPVFU)

	TYPWHO==0
	TYPVER==1
	TYPMIN==0
	TYPEDT==1

	LOC	137
	EXP	<VRSN.(TYP)>
	RELOC

COMMENT \

001	Leterrip !!!

\ ;End edit history
	SUBTTL	Symbols, macro's and impure storage

	EXTERN	PARSER
	PARSET

	DEFINE	$FATAL(TXT),<
	JRST	[$TEXT(,<?TXT>)
		 JRST GETCMD ]  >

	VFULEN==^D144			;Max DAVFU size
	LPI%%6==354			;6 Lines Per Inch
	LPI%%8==355			;8 Lines Per Inch
	LPI%%0==356			;Do not change LPI
	VFUEOF==357			;DAVFU end EOF byte
	PAR%SZ==^D4			;Parser block length
	CMD%SZ==^D512			;Command state block length

DATBLK:
PDL:	BLOCK	^D100
VFU:	BLOCK	VFULEN+1		;The VFU channel mask buffer
BUFFER:	BLOCK	VFULEN/2		;The VFU I/O buffer
LPITYP:	0,,0				;LPI type address
BYTPTR:	0,,0				;$TEXT byte pointer
PARBLK:	BLOCK	PAR%SZ			;Parser argument block
CMDBLK:	BLOCK	CMD%SZ			;Command state block
IFN:	0,,0				;File IFN
ENDBLK:

IB:	$BUILD	(IB.SZ)			;Build initialization block
	  $SET	(IB.PRG,,'TYPVFU')	;Program name
	  $SET	(IB.FLG,IT.OCT,1)	;Require command terminal
	$EOB

FOB:	0,,0				;FD Address
	^D36				;Byte size
	SUBTTL	Main program

TYPVFU:	RESET				;Always do this
	MOVE	P,[IOWD ^D100,PDL]	;Setup the stack
	SETZM	DATBLK			;Clear first word of storage
	MOVE	S1,[DATBLK,,DATBLK+1]	;Get source,,destination
	BLT	S1,ENDBLK-1		;Zero the data area (allocate pages)
	MOVEI	S1,IB.SZ
	MOVEI	S2,IB
	$CALL	I%INIT			;Get the library
	SETZB	S1,S2			;Don't want timer interrupts for parser
	$CALL	P$INIT			;Initialize parser routines
	MOVEI	S1,INI010		;Setup parser arg block
	MOVEM	S1,PAR.TB+PARBLK	;Store Table address
	MOVEI	S1,[ASCIZ/TYPVFU>/]	;Get prompt address
	MOVEM	S1,PAR.PM+PARBLK	;Store the prompt
	MOVEI	S1,CMDBLK		;Get the command state block address
	MOVEM	S1,PAR.CM+PARBLK	;Store address to return args

GETCMD:	MOVE	P,[IOWD	^D100,PDL]	;Reset stack
	MOVEI	S1,CMD%SZ		;Clear initial arguments
	MOVEI	S2,CMDBLK		;Get length in S1, address in S2
	$CALL	.ZCHNK			;Zap the block
	MOVEI	S1,COM.SZ-1
	STORE	S1,.MSTYP+CMDBLK,MS.CNT	;Set initial size
	MOVEI	S1,PAR%SZ		;Get size of parser block
	MOVEI	S2,PARBLK		;Point to it
	$CALL	PARSER			;Parse the command
	JUMPT	GETCM1			;Onward if command parsed ok

CMDERR:	MOVE	S1,PRT.FL(S2)		;Get the flags
	MOVE	S2,PRT.EM(S2)		;Get the address of error text
	TXNE	S1,P.CEOF		;End of file on RESCAN?
	 MOVEI	S2,[ASCIZ/Invalid command terminator/]
	JRST	ERROR			;Tell the user and try again

GETCM1:	MOVEI	S1,COM.SZ+CMDBLK	;Point to first argument
	$CALL	P$SETU			;Setup for second pass
	$CALL	P$KEYW			;Get keyword value
	JUMPF	[MOVEI  S2,[ASCIZ/Internal command keyword table error/]
		 PJRST  ERROR ]		;Tell the user and retry
	$CALL	0(S1)			;Else call the processor
	JRST	GETCMD			;Get another command
	SUBTTL	ERROR - Routine to output an error message

ERROR:	PUSH	P,S2
ERRO1:	$CALL	K%TPOS			;Get terminal position
	SKIPE	S1			;At column 0?
	$TEXT				;No..make it so
	POP	P,S2
	$TEXT	(,?^T/0(S2)/)		;Display the error
	JRST	GETCMD			;Get another command
	SUBTTL	Initialization and Keyword dispatch tables

INI010:	$INIT(KEY010)			;Parse initialization

KEY010:	$KEYDSP(KEY020)

KEY020:	$STAB				
TOPS10<	DSPTAB(EXIFDB,\"32,<CTZ>,CM%INV)  >
	DSPTAB(DMPFDB,DUMP,<DUMP>)
	DSPTAB(EXIFDB,EXIT,<EXIT>)
	$ETAB

EXIFDB:	$NOISE	(EXI010,<to monitor>)
EXI010:	$CRLF

DMPFDB:	$NOISE(DMP010,<VFU>)
DMP010:	$IFILE(DMP020,<VFU filespec>)
DMP020:	$CRLF

EXIT:	PUSHJ	P,I%EXIT

DUMP:	PUSHJ	P,P$IFIL		;Get a filespec
	JUMPF	EXIT			;Not there,,hmmmm
	MOVEM	S1,FOB			;Save the FD address
	MOVEI	S1,2			;Get FOB length
	MOVEI	S2,FOB			;  and its address
	PUSHJ	P,F%IOPN		;Open for input
	JUMPF	[$FATAL(<Open error: ^F/@FOB/ - ^E/[-1]/>) ]
	MOVEM	S1,IFN			;Save the file ID
	PUSHJ	P,F%IBUF		;Get the DAVFU from disk
	PUSH	P,S2			;Save the buffer address
	MOVE	S1,IFN			;Get the file ID back
	PUSHJ	P,F%REL			;Close the file
	MOVE	S1,[POINT 8,BUFFER]	;Get the output buffer pointer
	POP	P,S2			;Restore the buffer address
	HRLI	S2,(POINT 8,0)		;Get the input  buffer pointer
	MOVEI	P1,VFULEN		;Get max lines DAVFU supports

LOOP:	ILDB	T1,S2			;Get an input byte
	ILDB	T2,S2			;And another
	IDPB	T2,S1			;Swap the 2 bytes
	IDPB	T1,S1			;to convert from -11 format
	CAXE	T1,VFUEOF		;At EOF yet ???
	CAXN	T2,VFUEOF		;Here too ???
	JRST	DECODE			;Yes,,continue
	SOJGE	P1,LOOP			;No,,count down total bufr length
	$FATAL	(<DAVFU larger then internal buffer size>)

DECODE:	MOVE	S1,[POINT 8,BUFFER]	;Get the input buffer pointer
	ILDB	T1,S1			;Get the start byte (LPI)
	SUBI	T1,LPI%%6		;Recode the LPI value
	SKIPL	T1			;First byte must be 354, 355, or 356
	CAILE	T1,2			;Is this really a DAVFU ???
	$FATAL	(<Invalid start byte found in DAVFU>)
	MOVEI	T1,[ASCIZ/6/
		    ASCIZ/8/
		    ASCIZ/Hardware Switched/](T1) ;Get ASCII LPI value
	MOVEM	T1,LPITYP		;Save the LPI type text address
	SETZM	P1			;Clear line counter

DECO.1:	ILDB	T1,S1			;Get a line byte
	ILDB	T2,S1			;Get the next byte
	CAXN	T1,VFUEOF		;End of data ???
	JRST	DECO.2			;Yes,,leave
	LSH	T2,6			;Shift it over 6 bits
	ADD	T2,T1			;Get 12 bits total
	MOVEM	T2,VFU(P1)		;Save the channel mask for this line
	AOS	P1			;Account for this line
	JRST	DECO.1			;Loop for all bytes

DECO.2:	$TEXT	(,<DAVFU Format Program^M^J^JLines per/inch = ^T/@LPITYP/^M^JPhysical page size = ^D/P1/ lines^M^J>)

	MOVSI	T2,400000		;Init channel mask to right place
	SETZM	T3			;Clear channel loop counter

DECO.3:	AOS	T3			;Bump channel counter
	CAILE	T3,^D12			;Only want 12 channels
	JRST	GETCMD			;Done,,go get another command
	SETOB	P3,P4			;Reset low:high line counters
	SETOM	T1			;Reset line loop counter
	ROT	T2,1			;Shift channel mask to correct place
	MOVE	S1,[POINT 7,BUFFER]	;Get $TEXT byte pointer
	MOVEM	S1,BYTPTR		;Save it for later
	SETZM	BUFFER			;Clear the first word

DECO.4:	AOS	T1			;Bump line counter
	CAILE	T1,0(P1)		;Line number in range ???
	JRST	DECO.6			;No,,dump channel data
	TDNN	T2,VFU(T1)		;Stopping on this line for this chanel ?
	JRST	DECO.4			;No,,check next line
	SKIPGE	P3			;Any start line value yet ???
	JRST	DECO.5			;No,,initialize line counters
	CAIN	T1,1(P4)		;Line + 1 ???
	JRST	[MOVEM T1,P4		;Yes,,then this is the new end line
		 JRST  DECO.4	]	;Check next line
	PUSHJ	P,DUMPIT		;Dump the start:end lines

DECO.5:	MOVEM	T1,P3			;Current line is now first line
	MOVEM	T1,P4			;   and last line
	JRST	DECO.4			;Check next line

DECO.6:	JUMPL	P3,DECO.3		;No lines,,check next channel
	PUSHJ	P,DUMPIT		;Dump the start end lines
	SETZM	S1			;Get a null
	PUSHJ	P,OUTBYT		;Make it ASCIZ
	$TEXT	(,<Channel # ^D2/T3/ stops on lines^T/BUFFER/^M^J>)
	JRST	DECO.3			;Process next channel

DUMPIT:	AOS	P3			;Convert from offset to line number
	AOS	P4			;Convert from offset to line number
	CAMN	P3,P4			;Start and end lines the same ???
	$TEXT	(OUTBYT,< ^D/P3/^A>)	;Yes,,dump just one line
	CAME	P3,P4			;Start and end lines different ???
	$TEXT	(OUTBYT,< ^D/P3/:^D/P4/^A>) ;Yes,,dump the lines
	$RETT				;Return

OUTBYT:	IDPB	S1,BYTPTR		;Save the byte
	$RETT				;Return
	
	END	TYPVFU