;	Alphawrite screen directory.  Works on V1.2
;	This was originally adapted via FIX from FILES.LIT, distributed with
;	the Omniledger accounting package, as an M68 training exercise.
;	I've since noticed great similarities with the excellent EDIR from
;	White House Software (available from AMUS network).
;	all comments are IKLF interpretation and should not be relied on
;	Author (with the above caveats) Iain Fraser, Mortimer Technology Ltd, 1987
;
;       See AWUTIL.DOC for more info

	OBJNAM	.LIT

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

 	VMAJOR	=1
 	VMINOR	=0
 	VEDIT	=100.

L00000:	PHDR	-1,0

	LEA	A5,L00000			; A5 indexes start of prog
	MOV	A2,D2				; store index to command line
	LEA	A1,WRK0(A5)			; index work area
	MOV	A1,D0
	MOV	D0,W0AD(A5)			; store address
	LEA	A1,WRK1(A5)			; index second work area
	MOV	A1,D0
	MOV	D0,W1AD(A5)			; store address
	MOV	D2,A2				; restore index to command line
	TRM					; test for terminator
	JNE	10$				; no
	CLR	D2				; yes so indicate no command line
10$:	CALL	GETUFD
	JEQ	NOPPN				; no ppn
	CALL	CURCLR				; clear cursor position
	MOVB	#52,FNMASC(A5)			; * as default filename
	CLRB	1+FNMASC(A5)
	CALL	GETSRC				; get search parameters
FILOOP:	CALL	GETFIL				; get file from directory
	JEQ	ENDDIR				; no more files
	CALL	MATFIL				; does file match?
	JNE	FILOOP				; no - next one
	CALL	FLREAD				; read first block of file
	CALL	FIRST1				; first time code if necc
	LEA	A1,HOMCUR(A5)			; load table of cursor homes
	MOV	A1,D2				; into register
	CALL	NEXCUR				; put cursor to next posn
	JNE	PRFILE				; jump if successful
;						; else prompt for next screen
	MOV	#14001,D1			; 24,1
	TCRT	
	PUSH	D1
	MOV	#177413,D1			; -1,11 (background display)
	TCRT	
	POP	D1
	TYPESP	<Press Return to continue ->
	PUSH	D1
	MOV	#177414,D1			; -1,12 (foreground display)
	TCRT	
	POP	D1
	CALL	GETKBD
	CMPB	D1,#3				; control-C
	JEQ	ENDDIR				; causes exit
	LEA	A1,HOMCUR(A5)			; load table of cursor homes
	MOV	A1,D2
	CALL	NEXCUR				; next cursor position
	PUSH	D1
	MOV	#177412,D1			; -1,10 (erase eos)
	TCRT	
	POP	D1
PRFILE:	LEA	A6,FNMASC(A5)			; filename to print
	TTYL					; print it
 	MOV	#7,D1				; 7 cols
 	CALL	CURTAB				; reposition cursor
;	LEA	A6,EXTASC(A5)			; extension to print 
;	TTYL					; print it
	LEA	A6,16.+WRK1(A5)			; AW description
	TTYL

	JMP	FILOOP				; next file

ENDDIR:	TST	WRK2(A5)			; 1st time flag
	JNE	20$				; set, so there has been something
	TYPECR	<%No such files>		; not set so no matches
	EXIT	
20$:	MOV	#14001,D1			; 24,1
	TCRT	
	PUSH	D1
	MOV	#177411,D1			; -1,9 erase eol
	TCRT	
	POP	D1
	EXIT	

NOPPN:	TYPECR	<Account does not exist>
	EXIT	

WRK0:	BLKB	1000
WRK1:	BLKB	1000
WRK2:	LWORD	0

FIRST1:	TST	WRK2(A5)			; 1st time flag
	BEQ	FIRSTY				; 1st time
	RTN					; not first time
FIRSTY:	MOV	#-1,WRK2(A5)			; no longer first time
	CALL	IMAGEM				; image mode
	PUSH	D1				; save D1
	MOV	#177400,D1			; -1,0 (clear screen)
	TCRT	
	POP	D1				; restore D1
	PUSH	D1				; save it again
	MOV	#177413,D1			; -1,11 (background display)
	TCRT	
	POP	D1				; restore D1
	TYPE	<    AlphaWRITE Screen Catalogue...................................>
	LEA	A1,DEVICE(A5)			; addr to pack device into
	MOV	A1,D2
	LEA	A1,D.DEV+DDB1(A5)		; addr with rad50 device
	MOV	A1,D1
	MOV	D1,A1
	MOV	D2,A2
	UNPACK					; unpack device
	MOV	A2,D2
	MOV	A1,D1
	LEA	A6,DEVICE(A5)			; index device name
	TTYL					; type it out
	CLR	D1				; clear drive no
	MOVW	D.DRV+DDB1(A5),D1		; load drive no from ddb
	MOV	D2,A2				; update pointer
	DCVT	0,OT$TRM			; print drive no in decimal
	TYPE	<:[>
	JOBIDX	A6				; who am I?
	MOV	A6,D0				; in register
	MOV	D0,A0
	ADD	#24,A0				; JOBUSR
	MOVW	@A0,D4				; in D4
	MOV	D0,A0				; JOBIDX
	CLRW	24(A0)				; clear JOBUSR (bad idea!)
	PRPPN	D.PPN+DDB1(A5)			; print ppn
	MOV	D0,A1				; stored JOBIDX
	ADD	#24,A1				; JOBUSR
	MOVW	D4,@A1				; restore JOBUSR
	TYPE	<]>
	PUSH	D1				; save D1
	MOV	#177414,D1			; -1,12 (foreground display)
	TCRT	
	POP	D1				; restore D1
	RTN					; return

HOMCUR:	WORD	0				; top word of cursor LW
	BYTE	1				; home col=1
	BYTE	2				; home row=2
	BYTE	70.				; cols per file=70
	BYTE	69.				; max col no=69
	BYTE	22.				; max row no=22
	BYTE	0
DEVICE:	ASCII	/DEV/
	BYTE	0
FNMASC:	LWORD	0
	LWORD	0
EXTASC:	ASCII	/WRT/
	BYTE	0
WSIZE:	WORD	0
WSIZW:	WORD	0
WACTI:	WORD	0
WACTW:	WORD	0
WLINK:	WORD	0
WLINW:	WORD	0

DDB1:	BLKB	D.DDB
DDB2:	BLKB	D.DDB

W0AD:	LWORD	0
W1AD:	LWORD	0
WW1:	LWORD	0
WW2:	LWORD	0
WDEV:	WORD	0
WDRV:	WORD	0
WPPN:	WORD	0

GETUFD:	MOV	W0AD(A5),D.BUF+DDB1(A5)		; DDB buffer addresses
	MOV	W1AD(A5),D.BUF+DDB2(A5)
	MOV	#1000,D.SIZ+DDB1(A5)		; 1 block size
	MOV	#1000,D.SIZ+DDB2(A5)
	MOVB	#100,D.FLG+DDB1(A5)		; flag as INITed
	MOVB	#100,D.FLG+DDB2(A5)
	CLR	D.DVR+DDB1(A5)			; no device driver
	CLR	D.DVR+DDB2(A5)
	JOBIDX	A6
	MOV	A6,D0
	MOV	D0,A0
	MOVW	JOBDEV(A0),D.DEV+DDB1(A5)	; default log-in device
	MOVW	JOBDRV(A0),D.DRV+DDB1(A5)	; default log-in drive
	MOVW	JOBUSR(A0),D.PPN+DDB1(A5)	; default log-in ppn
	TST	D2				; any args to command?
	JEQ	SETDD2				; no, so use defaults
	MOV	D2,WW1(A5)			; area to unpack args from
	LEA	A1,WDEV(A5)			; area to pack device into
	MOV	A1,D1
	MOV	D1,A1
	MOV	D2,A2
	PACK					; pack arg into rad50
	MOV	A2,D2				; update pointers
	MOV	A1,D1
	MOV	D2,A2
	GTDEC					; get number from args
	MOV	A2,D2				; update pointer
	MOVW	D1,WDRV(A5)			; store as drive no
	MOV	D2,A1
	ADD	#1,D2
	MOVB	#72,D7				; :
	CMPB	D7,@A1
	JEQ	INCDEV				; yup, a colon
	MOV	WW1(A5),D2
	CLR	WDEV(A5)			; no device specified
INCDEV:	MOV	D2,WW1(A5)
	CLRW	WPPN(A5)			; no ppn specified
PPNSRC:	MOV	D2,A2
	TRM					; terminator?
	JEQ	SETDD1				; yup so we're done with args
	MOV	D2,A0
	ADD	#1,D2
	MOVB	@A0,D7
	CMPB	D7,#133				; [
	JNE	PPNSRC				; nope so try next char
	MOV	D2,A2
	GTPPN					; unpack ppn
	MOV	A2,D2
	MOVW	D1,WPPN(A5)			; and store
	ADD	#1,D2
	MOV	WW1(A5),D0
	MOV	D0,A0
	MOVB	@A0,D7
	CMPB	D7,#133				; [
	JNE	SETDD1				; nope
	MOV	D2,WW1(A5)
SETDD1:	TST	WDEV(A5)			; device specified?
	JEQ	TESPPN				; nope
	MOVW	WDEV(A5),D.DEV+DDB1(A5)		; yup, so store dev in ddb
	MOVW	WDRV(A5),D.DRV+DDB1(A5)		; and drv
TESPPN:	TSTW	WPPN(A5)			; ppn specified?
	JEQ	SETDD2				; nope
	MOVW	WPPN(A5),D.PPN+DDB1(A5)		; yup so store it
SETDD2:	MOVW	D.DEV+DDB1(A5),D.DEV+DDB2(A5)	; copy account into ddb2
	MOVW	D.DRV+DDB1(A5),D.DRV+DDB2(A5)
	MOVW	D.PPN+DDB1(A5),D.PPN+DDB2(A5)
	MOV	#1,D.REC+DDB1(A5)		; want record one
GETMFD:	LEA	A6,DDB1(A5)			; in ddb1
	READ					; so read it
	CLR	WW2(A5)				; zeroise index
NEXMFR:	MOV	W0AD(A5),D0			; address of record buffer
	ADD	WW2(A5),D0			; add record index
	MOV	D0,A0
	TSTW	@A0				; is this zero
	JEQ	NEXMFD				; yup so end of mfd record
	MOV	D0,A0
	MOVW	@A0,D7
	CMPW	D7,D.PPN+DDB1(A5)		; ppn we want
	JEQ	GOTPPN				; yup
	ADD	#10,WW2(A5)			; no so look at next one
	JMP	NEXMFR				; loop back
GOTPPN:	MOV	D0,A0
	ADD	#2,A0
	MOVW	@A0,2+D.REC+DDB1(A5)		; put ufd address in ddb1
	LEA	A6,DDB1(A5)
	READ					; read it
	MOV	WW1(A5),D2			; leave D2 pointing to next bit of command line
	MOV	#2,WW2(A5)			; leave WW2 pointing to 1st ufd entry
	LCC	#0				; indicate OK
RETUFD:	RTN					; back to main bit
NEXMFD:	MOV	D0,A0
	TSTW	2(A0)				; link to next mfd block
	BEQ	RETUFD				; none so return with error
	MOV	D0,A0
	ADD	#2,A0
	MOVW	@A0,D0
	AND	#177777,D0
	MOV	D0,D.REC+DDB1(A5)		; next mfd rec in ddb
	JMP	GETMFD				; search this one


GETFIL:	MOV	W0AD(A5),D0			; ufd buffer ptr
	ADD	WW2(A5),D0			; position in buffer
	MOV	D0,A1				; indexed by A1
	MOVW	#-1,D7
	CMPW	D7,@A1				; erased file?
	JNE	10$				; no
	ADD	#14,D0				; yes so point to next one
	ADD	#14,WW2(A5)
10$:	MOV	WW2(A5),D7			; position in buffer
	CMP	D7,#770				; past last valid entry
	JLO	20$				; no
	MOV	W0AD(A5),D0			; yes so index buffer
	MOV	D0,A0
	TSTW	@A0				; link entry present
	BEQ	RETUFD				; no so end of search
	MOV	D0,A0				; yes
	MOVW	@A0,2+D.REC+DDB1(A5)		; so point to next block
	LEA	A6,DDB1(A5)			; and
	READ					; read it in
	MOV	#2,WW2(A5)			; point to first entry
20$:	MOV	W0AD(A5),D0			; ufd buffer pointer
	ADD	WW2(A5),D0			; position in buffer
	MOV	D0,A1				; index it
	MOVW	#-1,D7
	CMPW	D7,@A1				; erased file?
	JEQ	GETFIL				; yes so point to next one
	MOV	D0,A0				; no so index it again
	TSTW	@A0				; end of directory?
	BNE	30$				; no
	RTN					; yes so return
30$:	MOV	D0,D1
	LEA	A1,FNMASC(A5)
	MOV	A1,D2
	MOV	D1,A1				; rad50 filename from ufd
	MOV	D2,A2				; area to unpack into
	UNPACK					; unpack 1st byte
	MOV	A2,D2				; update pointers
	MOV	A1,D1
	MOV	D1,A1
	MOV	D2,A2
	UNPACK					; unpack second byte
	MOV	A2,D2				; update pointers
	MOV	A1,D1
	MOV	D2,A0
	CLRB	@A0				; terminate with null
STRFIL:	SUB	#1,D2				; last char of upacked name
	MOV	D2,A0
	MOVB	@A0,D7
	CMPB	D7,#40				; space ?
	JNE	40$				; no
	MOV	D2,A0				; yes
	CLRB	@A0				; replace with null
	JMP	STRFIL				; and look at previous char
40$:	LEA	A1,EXTASC(A5)			; area for unpacked extension
	MOV	A1,D2
	MOV	D1,A1				; packed extension from ufd
	MOV	D2,A2
	UNPACK					; and unpack it
	MOV	A2,D2				; update pointers
	MOV	A1,D1
	MOV	D2,A0
	CLRB	@A0				; terminate with null
STREXT:	SUB	#1,D2				; look at last char
	MOV	D2,A0
	MOVB	@A0,D7
	CMPB	D7,#40				; space?
	JNE	50$				; no
	MOV	D2,A0				; yes
	CLRB	@A0				; replace with null
	JMP	STREXT				; and look at previous char
50$:	MOV	D0,A0				; pointer to buffer
	ADD	#6,A0				; plus six chars - size
	MOVW	@A0,WSIZW(A5)			; store it
	MOV	D0,A0				; pointer to buffer
	ADD	#10,A0				; plus 8 - active
	MOVW	@A0,WACTW(A5)			; store it
	MOV	D0,A0				; pointer to buffer
	ADD	#12,A0				; plus 10 - link
	MOVW	@A0,WLINW(A5)			; store it
	ADD	#14,WW2(A5)			; point to next entry
 	RTN					; and return

; this bit of code doesn't seem to get used
; does now

FLREAD:	MOV	WLINK(A5),D.REC+DDB2(A5)	; set up record no of file
	LEA	A6,DDB2(A5)			; file #2
	READ					; read record
	MOV	WACTI(A5),D.WRK+DDB2(A5)	; active bytes
	MOV	WSIZE(A5),D7			; size
	CMP	D7,#1				; is it 1?
	MOV	#1000,D.SIZ+DDB2(A5)		; size = 1 block
	JNE	60$				; always jump??
	MOV	WACTI(A5),D.SIZ+DDB2(A5)	; size = active bytes
60$:	MOV	#2,D.IDX+DDB2(A5)		; point to byte 2 of file
	MOVB	#1,D.OPN+DDB2(A5)		; indicate file open
	RTN					; return

FNMSRC:	LWORD	0
	LWORD	0
EXTSRC:	LWORD	0

VALCHR:	WORD	^H7A61				; za
	WORD	^H5A41				; ZA
	WORD	^H3930				; 90
	WORD	^H3F3F				; ??
	WORD	^H2A2A				; **
	WORD	0


VALCHA:	MOV	D0,A0
	TSTB	@A0				; end of validation table?
	JEQ	VALBAD				; yes , failed validation
	MOV	D0,A1
	CMPB	D1,@A1				; compare char with low range
	JLO	VALNXT				; fail - next test
	MOV	D0,A1
	ADD	#1,A1
	CMPB	D1,@A1				; compare char with high range
	JHI	VALNXT				; fail - next test
	LCC	#4				; char in valid range
	RTN
VALNXT:	ADD	#2,D0				; point to next range
	JMP	VALCHA
VALBAD:	LCC	#0				; indicate failure
	RTN	

UPCASE:	CMPB	D1,#141				; a
	JLO	UPCASR				; less than a
	CMPB	D1,#172				; z
	JHI	UPCASR				; more than z
	SUB	#40,D1				; a-z so convert to upper case
UPCASR:	RTN	

GETSRC:	CLR	D3				; clear counter
NXTFNC:	CLR	D1				; clear arg char
	MOV	D2,A0				; index arg line
	MOVB	@A0,D1
	LEA	A1,VALCHR(A5)			; table of valid chars
	MOV	A1,D0
	CALL	VALCHA
	JNE	GETEXT				; char is invalid - done here
	CMP	D3,#7				; counter over 6?
	JNE	STOFNM				; no
JNKFNC:	CLR	D1				; clear arg char
	MOV	D2,A0				; index arg line
	ADD	#1,D2				; point to next char
	MOVB	@A0,D1				; load arg char
	LEA	A1,VALCHR(A5)			; validate it
	MOV	A1,D0
	CALL	VALCHA
	JEQ	JNKFNC				; if valid get next one
	JMP	GETEXT				; if invalid we're done
STOFNM:	CLR	D1				; clear arg char
	MOV	D2,A0				; index arg char
	ADD	#1,D2				; point to next one
	MOVB	@A0,D1				; load char
	CALL	UPCASE				; upper case it
	LEA	A1,FNMSRC(A5)			; index filename to search
	MOV	A1,D0				
	ADD	D3,D0				; add char count
	MOV	D0,A1
	MOVB	D1,@A1				; store char
	ADD	#1,D3				; increment count
	JMP	NXTFNC				; go back for next one
GETEXT:	LEA	A1,FNMSRC(A5)			; index filename to search
	MOV	A1,D0
	ADD	D3,D0				; add char count
	MOV	D0,A0
	CLRB	@A0				; null at end
	CLR	D3				; clear counter
	CLRB	EXTSRC(A5)			; clear extension to search
	MOV	D2,A0
	MOVB	@A0,D7				; next char
	CMPB	D7,#56				; .
	JNE	TSTSRC				; not a . so no extension
	ADD	#1,D2				; increment pointer
NXTEXT:	CLR	D1				; clear arg char
	MOV	D2,A0
	MOVB	@A0,D1
	LEA	A1,VALCHR(A5)			; validate it
	MOV	A1,D0
	CALL	VALCHA
	JNE	TEREXT				; if invalid
	CMP	D3,#4				; over 3 chars?
	JNE	STOEXT				; not yet
JNKEXT:	CLR	D1				; clear arg char
	MOV	D2,A0				; index arg
	ADD	#1,D2				; point to next one
	MOVB	@A0,D1				; load char
	LEA	A1,VALCHR(A5)
	MOV	A1,D0
	CALL	VALCHA				; validate it
	JEQ	JNKEXT				; next one if valid
	JMP	TEREXT				; else we're done
STOEXT:	CLR	D1				; clear arg char
	MOV	D2,A0				; index arg line
	ADD	#1,D2				; point to next one
	MOVB	@A0,D1				; load char
	CALL	UPCASE				; upper case it
	LEA	A1,EXTSRC(A5)			; where to load it to
	MOV	A1,D0
	ADD	D3,D0				; add in counter
	MOV	D0,A1
	MOVB	D1,@A1				; store char
	ADD	#1,D3				; increment counter
	JMP	NXTEXT				; go back for next one
TEREXT:	LEA	A1,EXTSRC(A5)			; extension to search for
	MOV	A1,D0
	ADD	D3,D0				; add in char count
	MOV	D0,A0
	CLRB	@A0				; terminate with null
TSTSRC:	TSTB	FNMSRC(A5)			; any filename offered?
	JNE	TSTEXT				; no
	LEA	A1,FNMASC(A5)			; index what we will test against
	MOV	A1,D2
	LEA	A1,FNMSRC(A5)			; index what we've just stored
	MOV	A1,D0
NXTSCH:	MOV	D2,A0
	ADD	#1,D2				; increment index
	MOV	D0,A1
	ADD	#1,D0				; increment index
	MOVB	@A0,@A1				; move char across
	JNE	NXTSCH				; next one if last wasn't null
TSTEXT:	TSTB	EXTSRC(A5)			; do as above for extension
	JNE	SRCRET				; if there is one
	LEA	A1,EXTASC(A5)
	MOV	A1,D2
	LEA	A1,EXTSRC(A5)
	MOV	A1,D0
NXTECH:	MOV	D2,A0
	ADD	#1,D2
	MOV	D0,A1
	ADD	#1,D0
	MOVB	@A0,@A1
	JNE	NXTECH
SRCRET:	RTN	

MATTES:	MOV	D2,A0				; D2 points to dir entry
	TSTB	@A0				; if char null string matches
	JEQ	MATYES
	MOV	D0,A0				; D0 points to search entry
	MOVB	@A0,D7
	CMPB	D7,#52				; if * string matches
	JEQ	MATYES
	MOV	D0,A0				; search entry
	MOVB	@A0,D7
	CMPB	D7,#77				; if ? char matches
	JNE	MATCHA				; no
MATNEX:	ADD	#1,D0				; next search char
	ADD	#1,D2				; next dir char
	JMP	MATTES				; test 
MATCHA:	MOV	D0,A0				; search char
	MOV	D2,A1				; dir char
	MOVB	@A0,D7
	CMPB	D7,@A1				; test for equality
	JEQ	MATNEX				; yup so try next
	LCC	#0				; nope so indicate not equal
	RTN					; and return

MATYES:	LCC	#4				; indicate equal

MATRET:	RTN					; common return point

MATFIL:	LEA	A1,FNMASC(A5)			; filename from dir
	MOV	A1,D2
	LEA	A1,FNMSRC(A5)			; filename to search
	MOV	A1,D0
	CALL	MATTES				; test for match
	BNE	MATRET				; branch if no match
	LEA	A1,EXTASC(A5)			; extension from dir
	MOV	A1,D2
	LEA	A1,EXTSRC(A5)			; extension to search
	MOV	A1,D0
	JMP	MATTES				; test for match

CURPOS:	WORD	0
CURCOL:	BYTE	0
CURROW:	BYTE	0

NEXCUR:	TST	CURPOS(A5)			; cursor set up?
	JNE	INCROW				; yes
	MOV	D2,A0				; D2 is pointing to start cursor pos
	ADD	#0,A0				; don't know why
	MOV	@A0,CURPOS(A5)			; store as cursor position
POSCUR:	MOV	CURPOS(A5),D1			; position cursor
	TCRT	
	LCC	#0				; indicate NE
	RTN					; and return
INCROW:	MOV	D2,A1				; start cursor storage
	ADD	#6,A1				; +6 = highest line no
	MOVB	CURROW(A5),D7			; current cursor row
	CMPB	D7,@A1				; compare with highest
	JHI	INCCOL				; jump if too big
	CLR	D1				; clear register
	MOVB	CURROW(A5),D1			; load row
	ADD	#1,D1				; increment row
	MOVB	D1,CURROW(A5)			; store it
	JMP	POSCUR				; position cursor & return
INCCOL:	MOV	D2,A0				; start cursor position
	ADD	#3,A0				; +3 = start row
	MOVB	@A0,CURROW(A5)			; store as row for position
	CLR	D1				; clear register
	MOV	D2,A0				; start cursor pos
	ADD	#4,A0				; +4 = cols per file
	MOVB	@A0,D1				; load it
	ADDB	CURCOL(A5),D1			; add current col pos
	MOVB	D1,CURCOL(A5)			; store result
	MOV	D2,A1				; start cursor position
	ADD	#5,A1				; +5 = max column no
	MOVB	CURCOL(A5),D7			; current cursor pos
	CMPB	D7,@A1				; compare
	JLO	POSCUR				; position cursor if OK
	CLR	CURPOS(A5)			; indicate no position
	RTN					; return indicating EQ

CURTAB:	ADD	CURPOS(A5),D1			; new cursor position
	TCRT					; print it
	RTN	

CURCLR:	CLR	CURPOS(A5)			; no cursor position yet
	RTN	

IMAGEM:	JOBIDX	A6				; who am I
	MOV	JOBTRM(A6),A0
	ORW	#23,@A0				; lower case, no echo, image modes
	RTN	

; this code doesn't seem to be used. Would cancel  above settings

	JOBIDX	A6
	MOV	JOBTRM(A6),A0
	ANDW	#-24,@A0
	RTN	


GETKBD:	KBD					; get char input
	JOBIDX	A6				; who am I?
	MOVW	(A6),D7				; status word
	ANDW	#200,D7				; isolate ^C pending
	BEQ	NOTCC				; branch if not
	ANDW	#-201,(A6)			; say no ^C pending
	MOV	#3,D1				; indicate user pressed ^C
NOTCC:	RTN	

; this code doesn't seem to be used

	CLR	D1
	JOBIDX	A6
	MOVW	(A6),D7
	ANDW	#200,D7
	BEQ	10$
	MOV	#3,D1
	BR	20$
10$:	MOV	JOBTRM(A6),A6
	TST	22(A6)
	BEQ	20$
	MOV	36(A6),A6
	MOVB	@A6,D1
	AND	#177,D1
20$:	RTN	

	END

.