Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64b-sb - 10,7/amis/dskio.mac
There are no other files named dskio.mac in the archive.
TITLE	DSKIO - Disk I/O routines for editor AMIS	-*-Macro-*-



dsk==2				;Channel for disk I/O.

dsksize==^D640			;Size of disk block, in chars.


opdef	call[	pushj	p,]

define	bugerr(msg),<
	jrst[	movei	2,[
			asciz	"'msg'"]
		pushj	p,bug##]
>;End of bugerr macro.

define	DBP(ac,%lbl),<		;Decrement Byte Pointer
	caml	ac,[35b5]
	 jrst[	sub  ac,[340000,,1]
		jrst  %lbl]
	add	ac,[7b5]
>;End of DBP macro

TWOSEG	600000			;make a shareable highsegment

;PROCEDURE dskinit;
;(* Initialises the DSKIO-module *)

dskini::SETZM	ds.opn		; no files open yet
	SETZM	proflg		; no funny renameing done yet
	SETZM	notdir		; no device checks yet
	SETZM	tcrflg		; we haven't fiddled
	SETZM	tcrdev		;  with TMPCORE yet
	setzm	prsarg		; No parameters from TMP:EDS yet.

; Make a temporary filename based on the jobnumber.

	PJOB	t1,			; get our job number
	IDIVI	t1,^D100		; I don't really want to explain..
	IDIVI	t2,^D10			; ..this code sequence...
	ROT	t2,-6
	ROTC	t1,-6
	TLO	t2,'000'(t3)
	TRO	t2,'AMI'		; ...
	MOVEM	t2,tmpnam		; store it

;PROCEDURE blankstring (VAR txt: STRING);
;(*	Blanks the string 'txt' *)


blanks:	push	p,t1		;Save T1.
	move	t1,[BYTE (7) " "," "," "," "," "]
	movem	t1,(txt)	;Blank first word
	HRLZ	t1,txt		;get pointer to string
	HRRI	t1,1(txt)
	BLT	t1,strsiz/5-1(txt)	; blank the string
	POP	p,t1

; This routine is called upon initialization to rescan the command line.

rrspar::setzm	rsccnt		;No chars rescanned yet.
	rescan	1		;Try rescan the command line.
	 skipa			; OK, start parsing.
	  popj	p,		;  Not OK, just return.
	setz	t4,		;Clear word.
	move	t5,[point 6,t4]	;Load byte pointer.
	movei	t6,6		;Load char count.
rrs.2:	pushj	p,rrsgch	;Try get a character.
	 popj	p,		; No more, give up.
	caie	t1," "		;Loop until some non-blank char.
	 cain	t1,.chtab
	  jrst	rrs.2
rrs.3:	cail	t1,"0"		;While char is alphanumeric, collect word.
	 caile	t1,"9"
	cail	t1,"A"
	 caile	t1,"Z"
	cail	t1,"a"
	 caile	t1,"z"
	  jrst	rrs.5
	sojl	t6,rrs.4
	cail	t1,"a"
	 subi	t1,40
	subi	t1,40
	idpb	t1,t5
rrs.4:	pushj	p,rrsgch	;Get next char of word.
	 tdza	t1,t1		; No more, flag in T1 and skip.
	  jrst	rrs.3
rrs.5:	came	t4,['A     ']	;Do we know this initial command?
	 camn	t4,['AM    ']
	  jrst	rrs.8
	came	t4,['AMI   ']
	 camn	t4,['AMIS  ']
	  jrst	rrs.8
	jumpe	t1,.popj	;No, quit if this was eol.
rrs.6:	caie	t1,"!"		;Not eol, scan for comment start or "-".
	 cain	t1,";"
	  jrst	read6c
	cain	t1,"-"
	 jrst	rrs.7
	pushj	p,rrsgch
	 popj	p,
	jrst	rrs.6

read6c:	pushj	p,rrsgch	;We found a command, skip to eol.
	 popj	p,
	jrst	read6c

rrs.7:	pushj	p,rrsgch	;Found a hyphen, eat it and use rest.
	 popj	p,
rrs.8:	setom	offset##	;'AMIS' started command, flag it.
	jumpe	t1,.popj	;Allow eol after command.
	caie	t1," "		;Start of arguments -- skip leading blanks.
	 cain	t1,.chtab
	  jrst	rrs.7
	move	t5,[point 7,tcrbuf+1]
rrs.9:	idpb	t1,t5
	aos	rsccnt
	pushj	p,rrsgch
	 skipa	t1,[ascii "AMIS "]
	  jrst	rrs.9
	movem	t1,tcrbuf+0	;Store initial part of TMP:EDS
	movei	t1,^D13		;Terminate file with CRLF.
	idpb	t1,t5
	movei	t1,^D10
	idpb	t1,t5
	setzm	offset##	;No need to read the file we just wrote...
	movsi	t0,'EDS'	;Load tempcore file name.
	move	t1,rsccnt	;Get count of bytes rescanned.
	addi	t1,5+4+2	;Add one word, two chars and adjustment.
	idivi	t1,5		;Compute number of words.
	movn	t1,t1		;Negate.
	hrl	t1,t1		;Put in left half.
	hrri	t1,tcrbuf-1	;Make IOWD to buffer.
	movx	t2,<.tcrwf,,t0>
	tmpcor	t2,		;Write TMP:EDS
	 jfcl			; Oh well...
	popj	p,		;Done with all this junk.

rrsgch:	inchwl	t1		;Get a character.
	movei	t0,1B35		;Load a bit.
	lsh	t0,(t1)		;Shift according to character.
	trne	t0,^B10000000000001;Ignore CR and NULL.
	 jrst	rrsgch
	tdnn	t0,[^B1100000101000001110010001000]
	 aos	(p)
	popj	p,

;function GetParameters: boolean;
;(* Reads TMP:EDS and prepares for special things. *)

getpar::skipe	offset##	;Check runoffset.
	 jrst	getpa0		; Set, look for and read TMP:EDS
	hrlz	t1,rsccnt	;Zero, check what we rescanned.
	jumpe	t1,retf		;Nothing, tell MAIN the fact.
	hrri	t1,tcrbuf+1	;Something, make len,,addr.
	movem	t1,prsarg	;Set up for DSKOPEN
	jrst	rett		;Return true.

getpa0:	MOVSI	t3,'EDS'	; read from TMP:EDS
	HRLZI	t4,-50		; negative count of words in buffer
	HRRI	t4,tcrbuf-1	; addr-1 to buffer
	MOVE	t1,[.TCRRF,,t3]
	 jrst	retf		; No tmp:eds maybe.
	MOVE	t3,[POINT 7,tcrbuf]
	IMULI	t1,5
;come here to find first blank or <TAB>
getpa1:	jumple	t1,retf		;Abort now if no chars left.
	ILDB	t4,t3
	CAIE	t4," "
	  SOJA	t1,getpa2
	   soja	t1,getpa1
;now scan past all blanks or <TAB>s
getpa2:	jumple	t1,retf
	ILDB	t4,t3
	 CAIN	t4," "
	  SOJA	t1,getpa2
;come here to shift the string to the left
	move	t5,[POINT 7,tcrbuf]
	tdza	t6,t6
getpa3:	ildb	t4,t3
	caie	t4,.chcnv	;^V?
	 cail	t4," "		; No, other control char?
	  cail	t4,177		;  or rubout?
	   jrst	quit		;   Terminator.
	idpb	t4,t5
	addi	t6,1		;Count chars moved.
	sojg	t1,getpa3

quit:	jumpe	t6,retf		;No chars moved means no parameters.
	hrli	t6,tcrbuf	;set up swapped pointer.
	movsm	t6,prsarg	;store.
	jrst	rett

retf:	tdza	t1,t1
rett:	movei	t1,1
	movem	t1,1(p)
	popj	p,

;(*	Local function to parse a filespec.
;	Returns the following "error" codes in ac0: *)
	errnoe==101	; no error, success
	erricf==102	; illegal character in filspec.
	errtlf==103	; too long field in filespec.
	errdfn==104	; duplicate filename
	errdex==105	; duplicate extension
	errddr==106	; double directory
	errcnd==107	; colon, but no device
	errddv==110	; duplicate device
	errils==111	; illegal separator in directory
	errtms==112	; too many sfds
	errnls==113	; null sfd
	errilf==114	; illegal format for directory
	errilp==115	; illegal protection code
	errdpr==116	; duplicate protection
	errnw8==117	; cant write 8-bit files.

	X==7			;Duplicate use of these.
;filespec. flags			; device found
	f.nam==1B34			; file name found
	f.ext==1B33			; extension found
	f.dir==1B32			; directory found			; protection found

filprs: SETZ	flags,			; clear flag word
	PUSH	p,pos			; save some accumulators
	PUSH	p,separ
	PUSH	p,word
	PUSH	p,sfdpnt
	PUSH	p,pth
	PUSH	p,err
	SETZM	cvseen			; no CTRL-V seen yet
	SETZM	PG.VAL		;[JE] No /Page yet.
	SETZM	LN.VAL		;[JE] No /Line yet.
	SETZM	CH.VAL		;[JE] No /Char yet.
	SETZM	FLAG8		;[JE] No bytesize yet.
	HLRZM	n,prslen	;[JE] save string length.
	HRLI	n,(POINT 7,0)		; set up bytepointer to string
	MOVEI	pos,1			; pos points to first char in n
filpr1: CALL	nxtsix			; get next sixbit char
	 JRST	.firet			; illegal character
	JUMPL	separ,.finrt		; end of string
filpr2:	DBP	n			; decrement byte pointer
	SUBI	pos,1			; reset pos to last read char
	CALL	nxtwrd			; get a sixbit word
	 JRST	.firet			; too long field
	CAIN	separ,':'		; is it device?
	 JRST	fildev			; yes
	JUMPE	word,filpr3		; if null, not filename
	MOVEI	err,errdfn		; assume double filenam error
	TROE	flags,f.nam		; check double filename error
	 JRST	.firet			; yes, duplicate filename error
	MOVEM	word,.RBNAM(lkb)	; save filename

filpr3: CAIN	separ,'.'		; is it extension?
	 JRST	filext			; yes
	CAIN	separ,'<'		; protection or directory?
	 JRST	filpro			; see if protection
	CAIN	separ,'['		; directory?
	 JRST	fildir			; yes
	JUMPLE	separ,.finrt		; at end of string?
	MOVEI	err,erricf		; no, we don't recognise it
	 JRST	.firet
; here if "<" seen - check if it is protection
filpro:	MOVEM	n,save.n		; save position in
	MOVEM	pos,savpos		;  name string
	CALL	nxtoct			; get prortection code
	 JRST	.firet			; error
	CAIE	separ,'>'		; was it protection?
	 JRST[	MOVE	n,save.n	; no, try directory instead
		MOVE	pos,savpos
		JRST	fildir]
	MOVEI	err,errdpr		; assume duplicate protection
	TROE	flags,		; duplicate?
	 JRST	.firet			; yep
	MOVEI	err,errilp
	CAILE	word,777		; check if legal
	 JRST	.firet			; illegal
	DPB	word,[POINT ^D9,dslkbk+.RBPRV,^D8]	; store protection code
	JRST	filpr1			; back for next field

; here if colon seen - we should have a device
fildev:	MOVEI	err,errilf		; assume illegal format
	TRNE	flags,f.nam+f.ext+f.dir	; device must be first in spec.!!
	 JRST	.firet
	JUMPE	word,[
		MOVEI	err,errcnd	; no device before colon, error
		JRST	.firet]
	MOVEI	err,errddv		; assume double device error
	TROE	flags,
	 JRST	.firet			; yes, duplicate device
	MOVEM	word,dsopbk+.OPDEV	; save device
	DEVCHR	word,			; what kind of device?
	TXNE	word,DV.DIR		; directory device?
	 JRST	filpr1			; yes, go back for more
	SETOM	notdir			; it was not a directory device
	JUMPN	word,filpr1		; but it was a device
	MOVE	word,dsopbk+.OPDEV	; see if it was TMP:
	CAXN	word,SIXBIT /TMP/	; tmpcore?
	 SETOM	tcrdev			; yes, remember it
	JRST	filpr1

; here if period seen - next word should be extension
filext: MOVEI	err,errdex		; assume duplicate extension
	TROE	flags,f.ext		; check for double extension
	 JRST	.firet			; yes, double extension
	CALL	nxtwrd			; get next sixbit word
	 JRST	.firet			; too long field
	HLLM	word,.RBEXT(lkb)	; save extension
	JUMPG	separ,filpr2		; go back for more, if there is any
	JRST	.finrt			; ok, we're finished
; here if left bracket seen - directory should come next
fildir:	SKIPE	notdir			; directory device?
	 JRST	fild.1			; no, don't check default path
	MOVE	pth,.RBPPN(lkb)		; get pointer to PATH.-block
	MOVE	separ,dsopbk+1		; get device
	MOVEM	separ,.PTFCN(pth)	; put device in PATH.-block
	MOVEI	err,ERDNA%		; assume device not available
	PATH.	pth,			; find out default path for this device
	 JRST	.firet			; yep, it wasn't there
	GETPPN	word,			; get job's PPN			(*JMR*)
	 JFCL				;				(*JMR*)
	MOVEM	word,.PTPPN(pth)	; save PPN
fild.1:	MOVEI	err,errddr		; assume duplicate directory
	TROE	flags,f.dir		; check duplicate directory error
	 JRST	.firet			; yes, duplicate directory
	CALL	nxtoct			; read an octal number (project)
	 JRST	.firet			; error, too long field
	CAIE	separ,'-'		; default directory?
	 JRST	fildr1			; no, proceed
	CALL	nxtsix			; get next char
	 JRST	.firet			; error, illegal char
	JRST	fildr3			; finish directory parsing

fildr1: SKIPE	word			; null project?
	 HRLM	word,.PTPPN(pth)	; no, save project
	MOVEI	err,errils		; assume illegal separator in directory
	CAIE	separ,','		; check it
	 JRST	.firet			; yes, illegal separator
	CALL	nxtoct			; read an octal number (programmer)
	 JRST	.firet			; error, too long field
	SKIPE	word			; null programmer?
	 HRRM	word,.PTPPN(pth)	; no, save programmer
	MOVEI	sfdpnt,.PTSFD(pth)	; set pointer to first sfd
fildr2: CAIE	separ,','		; sfd next?
	 JRST	fildr3			; no, finish directory parsing
	MOVEI	err,errtms		; assume too many sfds
	CAIL	sfdpnt,.PTMAX(pth)	; how many sfds now?
	 JRST	.firet			; too many
	CALL	nxtwrd			; get next sixbit word
	 JRST	.firet			; too long field
	MOVEM	word,(sfdpnt)		; save the sfd
	ADDI	sfdpnt,1		; increment sfd-pointer
	JUMPN	word,fildr2		; if not null sfd, get next
	MOVEI	err,errnls		; null sfd, illegal
	 JRST	.firet

fildr3: SETZM	(sfdpnt)		; null word must be last in path
	MOVEI	err,errilf		; assume illegal format for directory
	JUMPLE	separ,filpr1		; hack to allow missing right bracket
	CAIE	separ,']'		; must be at end of directory
	 CAIN	separ,'>'		; check end of 2741 directory too
	  JRST	filpr1			; back for next field
	JRST .firet			; yep, it was error all right

.finrt: MOVEI	err,errnoe		; return success
	SKIPE	notdir			; is it a directory device?
	 JRST	.firet			; no
	TRNN	flags,f.dir		; directory found?
	 SETZM	.RBPPN(lkb)		; directory wasn't seen, use default
	TRNE	flags,		; protection found?
	 JRST	.firet			; yep
	MOVX	t1,<-1,,.GTDFL>
	GETTAB	t1,			; find out default protection
	 SETZ	t1,			; that should give us default later
	TXNN	t1,JD.SDP		; did user set default prot?
	 JRST[	MOVX	t1,%LDSTP	; no, get system default
		GETTAB	t1,
		 MOVX	t1,057B8	; well...
		JRST	.+1]
	LDB	t1,[POINT ^D9,t1,^D8]	; extract prot.
	DPB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]	; store it
.firet:	MOVE	t0,err			; return error code
	POP	p,err			; restore some accumulators
	POP	p,pth
	POP	p,sfdpnt
	POP	p,word
	POP	p,separ
	POP	p,pos
;get next sixbit char

;skip return if succesful, with char in ac 'separ',
; negative "char" if end of string.
;nonskip return if failure, with error code in 'err'

nxtsix: CAMLE	pos,prslen	; past last char?
	 JRST[	SETO	separ,	; yes, return negative "char"
		JRST	.nsret]
	ILDB	separ,n 	; get next ascii char
	CAIL	separ,"a"
	 CAILE	separ,"z"
	   SUBI separ," "	; convert to capitals
	CAIL	separ," "	; is char in sixbit range?
	 CAILE	separ,"_"
	  JRST[ MOVEI	err,erricf	; assume it's illegal
		CAIE	separ,"V"-"@"	; is it CTRL-V?
		 POPJ	P,	; no it isn't, sorry
		SKIPE	cvseen	; CTRL-V already typed?
		 JRST[	SETZM	cvseen	; yes, sorry
			POPJ	P,]
		SETOM	cvseen	; set the CTRL-V flag
		ADDI	pos,1	; we have read on more char
		JRST	nxtsix	; ignore this char and get next
	SUBI	separ," "	; convert to sixbit
	ADDI	pos,1		; increment pos
	CAIE	separ,'/'	;[JE] Attempt to read switches.
	 JRST	.nsret		;[JE]  Normal char, return.
	PUSHJ	P,SWTCHK	;[JE] Check for switches.
	SETO	separ,		;[JE] Call this end of string.
.nsret: AOS	(p)		; bump return address
; Here to check for switches.  Don't look too close...

swtchk:	push	p,word		;Save current word.
	push	p,t7		;Save this one too.
swtlup:	pushj	p,atom		;Read an atom.
	camn	word,['8     ']	;Want eight bit bytes?
	 jrst	sw.8bt		; Yes, go handle.
	camn	word,['I     ']	;Want I*M eight bits?
	 jrst		; Yes, go handle.
	caie	separ,':'	;Terminated by colon?
	 jrst	swtret		; No, then we don't know about it.
	came	word,['P     ']	;/P?
	 camn	word,['PA    ']	; /Pa?
	  jrst		;  Yes, go handle.
	came	word,['PAG   ']	;/Pag?
	 camn	word,['PAGE  ']	; /Page?
	  jrst		;  Yes, go handle.
	came	word,['L     ']	;/L?
	 camn	word,['LI    ']	; /Li?
	  jrst	sw.line		;  Yes, go handle.
	came	word,['LIN   ']	;/Lin?
	 camn	word,['LINE  ']	; /Line?
	  jrst	sw.line		;  Yes, go handle.
	came	word,['C     ']	;/C?
	 camn	word,['CH    ']	; /Ch?
	  jrst	sw.char		;  Yes, go handle.
	came	word,['CHA   ']	;/Cha?
	 camn	word,['CHAR  ']	; /Char?
	  jrst	sw.char		;  Yes, go handle.
	came	word,['R     ']	;/R?
	 camn	word,['RU    ']	; /Ru?
	  jrst		;  Yes, go handle.
	camn	word,['RUN   ']	;/Run?
	 jrst		; Yes, go handle.

swtret:	pop	p,t7
	pop	p,word
	popj	p,

; Here to handle /8 and /I	skipa	numb,["I"]
sw.8bt:	movei	numb,"8"
	movem	numb,flag8
	jrst	swtlup

; Here to decode /Page

sw.pag:	pushj	p,decnum	;Get decimal argument.
	movem	numb,pg.val	;Store argument.
	jrst	swtlup		;Loop for more.

; Here to decode /Line

sw.lin:	pushj	p,decnum	;Get decimal argument.
	movem	numb,ln.val	;Store argument.
	jrst	swtlup		;Loop for more.

; Here to decode /Char.

sw.cha:	pushj	p,decnum	;Get decimal argument.
	movem	numb,ch.val	;Store argument.
	jrst	swtlup		;Loop for more.

; Here to decode /Run.	MOVEI	X,6		;Load a loop counter.
	SETZM	RUNBLK-1(X)	;Clear a word.
	SOJG	X,.-1		;Loop over them all.
RUNLUP:	PUSHJ	P,ATOM		;The rest should be obvious.
	JUMPLE	SEPAR,swtret	;Restore and return after all is done.
	CAIE	SEPAR,'<';'>'
	 CAIN	SEPAR,'[';']'
	  MOVEI	X,2


	    JRST ATOM.4


decnum:	movei	numb,0		;Start with zero.
decn.2:	pushj	p,getchr	;Get next char.
	cail	separ,'0'	;In range?
	 caile	separ,'9'
	  popj	p,		;  No, return now.
	imuli	numb,^D10	;Shift...
	addi	numb,-'0'(separ);Add...
	jrst	decn.2		;Loop...

	 JRST[	SETO	SEPAR,	; No, return -1.
		POPJ	P,]
	ILDB	SEPAR,N		;Yes, get next char.
;get next sixbit word

;skip return if succesful,
; with sixbit value in ac 'word' and break char in ac 'separ' 
;nonskip return if failure, with error code in 'err'

nxtwrd: PUSH	p,t7		; save an ac
	SETZ	word,		; clear result
	MOVEI	t7,6		; max 6 chars in a sixbit word
nxtwr1: CALL	nxtsix		; get next char
	 JRST[	POP	p,t7	; unsave an ac
		POPJ	P,]		; error, illegal char
	JUMPL	separ,.nwret	; end of string
	SKIPN	separ		; null char?
	 JRST	nwillc		; yes, just return
	CAIGE	separ,'0'	; legal char?
	 JRST	nwillc		; no
	CAIG	separ,'9'	; try again
	 JRST	nxtwr2		; yes, definitely legal
	CAIL	separ,'A'	; last chance
	 CAILE	separ,'Z'
nwillc:	  JRST[	SKIPN	cvseen	; have we seen a CTRL-V?
		 JRST	.nwret	; sorry, illegal char
		SETZM	cvseen	; yes, clear the CTRL-V flag
		JRST	nxtwr2	; and pretend it's a legal char
nxtwr2: JUMPE	t7,nxtwr1	; t7 = 0 means word is full -- don't store...
	LSH	word,6		; shift left SIX BITs
	IOR	word,separ	; append next char
	SOJA	t7,nxtwr1	; get next char, if room for more
.nwret: IMULI	t7,6
	LSH	word,(t7)	; left justify
	POP	p,t7		; restore an ac
	AOS	(p)		; bump return pc
;read an octal number

;skip return if succesful,
; with octal value in ac 'word' and break char in ac 'separ' 
;nonskip return if failure, with error code in 'err'

nxtoct: PUSH	p,t7		; save an ac
	SETZ	word,		; clear result
	MOVEI	t7,6		; max six digits in an octal halfword
nxtoc1: CALL	nxtsix		; get next char
	 JRST[	POP	p,t7	; error, illegal char (error code -2)
		POPJ	P,]
	SKIPN	separ		; null char?
	 JRST	.noret		; yes, just return
	CAIL	separ,'0'	; legal digit?
	 CAILE	separ,'7'
	  JRST	.noret		; no
	JUMPE	t7,[		; yes, but halfword is full
		MOVEI	err,errtlf
		POP	p,t7
		POPJ	P,]
	LSH	word,3		; shift left one octal digit
	SUBI	separ,'0'	; convert to octal
	IOR	word,separ	; append next digit
	SOJA	t7,nxtoc1
.noret: POP	p,t7		; restore an ac
	AOS	(p)		; bump return pc
; Routines to handle "List Files".  Currently just dummies.
; function LsFOpen(s: string; l: integer): boolean;
; function LsFMore: boolean;
; function LsFChar: char;
; function LsFClose: boolean;

LSFOPE::movei	1,[[ASCIZ "LSF? List Files not yet implemented"]]
	movem	1,errtab
	setzm	lsterr
	movni	1,2
	movem	1,1(p)
	popj	p,

	movei	2,[ASCIZ "DSKIO: LSFxxx routine called."]
	pushj	p,bug##
;(*	Opens the file "n" in access "a". Returns 0 if success,
;	otherwise -1 if file wasn't found, and -2 on all other errors *)
dskope::HRLI	n,strsize	;Load default string length.
	skipe	prsarg		;Special case?
	 move	n,prsarg	; Yes, use another argument.
	setzm	prsarg		;... but only once.
	SKIPE	ds.opn			; check if we already have an open file
	 bugerr <DSKOPEN: File is already open>
	cain	a,"R"		;Map new access codes to old.
	 movei	a,1
	cain	a,"W"
	 movei	a,2
	cail	a,1		;Range check the new access code.
	 caile	a,2
	  bugerr <DSKOPEN: Illegal access code>
	DMOVE	t0,[
		EXP	.IOASC		; use ascii mode
		SIXBIT	'DSK']		; default device
	DMOVEM	t0,dsopbk+.OPMOD
	MOVEI	t1,dslkln		; length of LOOKUP-block
	MOVEM	t1,dslkbk+.RBCNT	; it might be clobberd
	MOVEI	t0,dslkpt		;Pointer to path.
	SETZ	t1,			;Empty file name.
	DMOVEM	t0,dslkbk+.RBPPN
	MOVE	t1,[
		dslkbk+.RBEXT,,dslkbk+.RBPRV]; set up to clear lookup block
	SETZM	dslkbk+.RBEXT		; clear first word
	BLT	t1,dslkbk+.RBDEV	; clear the block
	PUSH	p,3			; save ac3
	MOVEI	3,dslkbk		; prepare to parse for lookup-block
	CALL	filprs			; parse the filename
	POP	p,3			; unsave ac3
	CAIE	t0,errnoe		; check if no error
	 JRST	fatal
	SKIPE	tcrdev			; tmpcore?
	 JRST	@[
		tcropn			; yes, go read in from TMP:
		opnret			; yes, but nothing special when writing
	MOVEI	t0,ERDNA%		; assume device not available
	OPEN	dsk,dsopbk		; open device
 	 JRST	fatal
	MOVE	t1,dsopbk+.OPDEV
	DEVTYP	t1,			; ask monitor what kind of device
	 bugerr	<DSKOPEN: DEVTYP failed>
	JRST	@[
		opread			; open for read
		opwrit			; open for write

tcropn:	HLLZ	t4,dslkbk+.RBNAM	; no, read from TMP:
	MOVE	t5,[IOWD dsksiz/5,dsbuf1+3]
	MOVE	t3,[.TCRRF,,t4]
	 JRST[	MOVEI	t0,ERFNF%	; wasn't there
		JRST	warn]
	MOVEM	t3,tcrsiz		; save number of read words
	JRST	opnret

; come here if open for read
	TXNN	t1,DV.IN		; can device can do input?
	 JRST	fatal
	MOVX	t0,.INFIN		; infinitely large
	MOVEM	t0,blknum		;  file assumed
	SKIPE	notdir			; is it a directory device?
	 JRST	opre10			; no, don't do LOOKUP
	LOOKUP	dsk,dslkbk
	 JRST[	HRRZ	t0,dslkbk+.RBEXT; failed, return with error code
		SKIPE	t0		; fatal error?
		 JRST	fatal		; yes
		JRST	warn]		; no, just warning
	MOVE	t0,dslkbk+.RBSIZ	; get size in words
	IDIVI	t0,dsksiz/5		; how many blocks?
	SKIPE	t1			; exact?
	 ADDI	t0,1			; no, but we still want the last block
	MOVEM	t0,blknum		; save it
	MOVEI	t1,dsk			; disk channel
	MOVEM	t1,dslkpt+.PTFCN	; to path-block
	MOVE	t1,[.PTMAX,,dslkpt]
	PATH.	t1,			; get real path to the file
	 bugerr	<Can't get real path to file> ; should never happen
opre10:	MOVEI	t1,dsbfih		; use buffers for input
	CALL	bufbld			; build buffers
	JRST	opnret

; Routine to get file name and extension from Tops-10.  (7.02)

		XWD	2,[
			XWD	^D11,EXPFIL]]
	FILOP.	T1,		;Try get Name and Ext. from Topsy.
	 POPJ	P,		; Nope, just ignore this.
	MOVE	T1,EXPFIL+.FOFFN;Get file name, and store in LOOKUP block.
	MOVE	T1,EXPFIL+.FOFEX;Get extension, and store in LOOKUP block.
	POPJ	P,		;Return, with LOOKUP/ENTER block updated.

; come here if open for write
	TXNN	t1,DV.OUT		;  can device do output?
	 JRST	fatal
	movei	t0,errnw8	;Assume /8 set.
	skipe	flag8		;Is it?
	 jrst	fatal		; Yes, then we cannot write.
	MOVEM	t1,dslkpt+.PTSWT	; don't use fishy switches
	LDB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]	; save original prot.
	MOVEM	t1,orgpro
	SKIPN	notdir			; is it a directory device?
	LOOKUP  dsk,dslkbk		; see if it is an existing file
	 JRST	nfound			; no open a new one
	MOVEI	t1,dslkpt
	MOVEM	t1,dslkbk+.RBPPN	; set pointer to path block
	MOVEI	t1,dsk
	MOVEM	t1,dslkpt+.PTFCN	; channel
	MOVE	t1,[11,,dslkpt]		; length,,arg
	PATH.	t1,			; find out path to this file
	 bugerr	<Can't get path to file>
	SETOM	xxbak			; yes, indicate that we're using backup
	SKIPE	orgpro			; do we have an original prot already?
	 JRST	opwr05			; yes
	LDB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]	; save original prot.
	MOVEM	t1,orgpro
opwr05:	HLLZ	t1,dslkbk+.RBEXT	; save original extension
	MOVEM	t1,orgext
	MOVE	t1,dslkbk+.RBNAM	; save original filename
	MOVEM	t1,orgnam
	MOVE	t1,tmppro		; use temporary protection
	DPB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
	MOVE	t1,tmpnam		; use the temporary name
	MOVEM	t1,dslkbk+.RBNAM
	MOVE	t1,tmpext		; use temporary fileextension
	HLLM	t1,dslkbk+.RBEXT
	MOVEI	t0,ERDNA%		; assume device not available
	OPEN	dsk,dsopbk		; open device again
 	 JRST	fatal
nfound: HLLZS	dslkbk+.RBEXT		; clear creation-date (high order bits)
	SETZ	t1,
	DPB	t1,[POINT ^D23,dslkbk+.RBPRV,^D35]	; and low bits
	MOVE	t1,[dslkbk+.RBSIZ,,dslkbk+.RBVER]
	push	p,dslkbk+.rbspl	;*****
	push	p,dslkbk+.rbver	;***
	SETZM	dslkbk+.RBSIZ
	BLT	t1,dslkbk+.RBDEV	; clear rest of LOOKUP block
	pop	p,dslkbk+.rbver	;***
	pop	p,dslkbk+.rbspl	;*****
	ENTER	dsk,dslkbk		; create a file
	 JRST[	HRRZ	t0,dslkbk+.RBEXT ; error
		JRST	fatal]
	SKIPE	notdir			; is it a directory device?
	 JRST	opwr10			; no, don't try to get path
	MOVEI	t1,dsk			; disk channel
	MOVEM	t1,dslkpt+.PTFCN	; to path-block
	MOVE	t1,[.PTMAX,,dslkpt]
	PATH.	t1,			; get real path to the file
	 bugerr	<Can't get real path to the file>
opwr10:	MOVEI	t1,dsbfoh		; use buffers for output
	CALL	bufbld			; build buffers
	OUT	dsk,			; try a dummy OUT
	bugerr	<DSKOPEN: Dummy OUT failed>
opnret: MOVE	t1,a
	MOVEM	t1,ds.opn		; the file is now open
	POPJ	P,			; all's well, return with 0

;build buffers, arg is pointer to buffer header control block in t1
	PUSH	p,t0
	MOVX	t0,<BF.VBR+dsbuf1+.BFHDR>; pointer to current buffer
	MOVEM	t0,.BFADR(t1)		; put it in buffer-header
	MOVE	t0,[POINT 7,0,35]
	MOVEM	t0,.BFPTR(t1)		; set up byte-pointer
	SETZM	.BFCTR(t1)		; clear byte-counter
	HRLZI	t0,dsksiz/5+1		; buffer size + 1
	HRRI	t0,dsbuf2+.BFHDR
	MOVEM	t0,dsbuf1+.BFHDR	; set up first buffer
	HRRI	t0,dsbuf3+.BFHDR
	MOVEM	t0,dsbuf2+.BFHDR	; set up second buffer
	HRRI	t0,dsbuf4+.BFHDR
	MOVEM	t0,dsbuf3+.BFHDR	; set up third buffer
	HRRI	t0,dsbuf5+.BFHDR
	MOVEM	t0,dsbuf4+.BFHDR	; set up fourth buffer
	HRRI	t0,dsbuf6+.BFHDR
	MOVEM	t0,dsbuf5+.BFHDR	; set up fifth buffer
	HRRI	t0,dsbuf1+.BFHDR
	MOVEM	t0,dsbuf6+.BFHDR	; set up sixth buffer
	POP	p,t0
;PROCEDURE truename (VAR namstr: string; fields: char);
;(*	Gives the name of the opened file. *)




;flags to decide what fields to return
devp==1B35			; 1
namep==1B34			; 2
typep==1B33			; 4
dirp==1B32			; 8
attrp==1B31			; 16
nodep==1B30			; 32

truena::cain	fields,"B"	;Map from new calling standard...
	 movei	fields,<namep>
	cain	fields,"D"
	 movei	fields,<nodep+devp+namep+typep+dirp>
	cain	fields,"F"
	 movei	fields,<devp+namep+typep+dirp+attrp>
	push	p,namstr	;Save argument, for retry.
	pushj	p,.truen	;First try...
	jumpge	t1,tnret	;All OK, return.
	trz	fields,<nodep+attrp>
	move	namstr,(p)
	pushj	p,.truen	;second try...
	jumpge	t1,tnret	;Did it without protection, good.
	trz	fields,dirp
	move	namstr,(p)
	pushj	p,.truen	;Last try...
tnret:	pop	p,(p)		;restore stack.
	popj	p,		;return.

.truen:	CALL	blanks			; blank the string
	HRLI	namstr,(POINT 7,0)	; make a bytepointer
	MOVEI	t1,strsiz		; length of string
	txnn	fields,nodep	;Node name wanted?
	 jrst	no.nod		; Nope, skip a bit.
	movei	x1,2		;Set up argument list length.
	movei	x2,.gtloc
	gettab	x2,		;Get number of local node.
	 jrst	no.nod		; Oops...
	movx	sixwrd,<.ndrnn,,x1>
	node.	sixwrd,		;Convert to node name.
	 jrst	no.nod		; Oops...
	call	trusix		;Store in string.
	movei	char,":"	;Store double colon.
	call	putnam
	call	putnam
no.nod:	SKIPN	sixwrd,dslkbk+.RBDEV	; if nothing there
	 SKIPA	sixwrd,dsopbk+1		;  then try here
	  TRZ	sixwrd,007777		;   only first 4 chars, thank you
	MOVEM	sixwrd,dsopbk+1 	; save device name
	TXNN	fields,devp
	CALL	trusix			; output to the namestring
	MOVEI	char,":"		; colon finishes
	CALL	putnam	MOVE	t7,dsopbk+1		; get device name again
	HLRZ	t6,t7			; we need it once more
	DEVTYP	t7,			; get charcteristics
	 bugerr	<TRUNAME: DEVTYP failed>
	TXNE	t7,TY.MAN+TY.SPL	; directory device or spooled device?
	 JRST	trufil			; yes, print at least filename
	CAIE	t6,'TMP'		; no, is it TMP: ?
	 POPJ	P,			; no, don't do anything more
	SETO	t7,			; make sure we don't go past filename
trufil:	TXNN	fields,namep
	 JRST	no.nam
	MOVE	sixwrd,dslkbk+.RBNAM	; filename
	CALL	trusix
no.nam:	TXNE	t7,TY.SPL		; spooled device?
	 POPJ	P,			; yes, don't print any more junk
	TXNN	fields,typep
	 JRST	no.typ
	MOVEI	char,"."		; separates from extension
	CALL	putnam
	HLLZ	sixwrd,dslkbk+.RBEXT	; get extension
	CALL	trusix			; print the extension
no.typ:	TXNN	fields,dirp
	 JRST	no.dir
trudir:	MOVEI	char,"["		; here comes directory
	CALL	putnam
	SKIPE	dslkbk+.RBPPN		; null pointer
	 JRST	trudi1			; no, proceed
	MOVE	t8,dsopbk+1
	MOVEM	t8,dslkpt+.PTFCN	; device
	MOVE	t7,[.PTMAX,,dslkpt]
	PATH.	t7,			; get default path
	 bugerr	<TRUENAME: Can't get path of device>
trudi1:	HLRZ	number,dslkpt+.PTPPN	; get project
	CALL	truoct
	MOVEI	char,","		; separate with comma
	CALL	putnam
	HRRZ	number,dslkpt+.PTPPN	; get programmer
	CALL	truoct
	MOVEI	t7,dslkpt+.PTSFD	; get first sfd
trudi2:	SKIPN	(t7)			; null sfd?
	 JRST	trudi3			; yes, end of directory
	MOVEI	char,","		; separator
	CALL	putnam
	MOVE	sixwrd,(t7)		; get sfd-name
	CALL	trusix
	AOJA	t7,trudi2		; get next sfd
trudi3:	MOVEI	char,"]"		; finishes the directory
	CALL	putnam
no.dir:	TXNN	fields,attrp
	JRST	no.att
trupro:	MOVEI	char,"<"		; start of protection field
	CALL	putnam
	MOVEI	t8,3			; three digits in protection code
	MOVE	t7,[POINT 3,dslkbk+.RBPRV]	; pointer to protection code
trupr1:	ILDB	char,t7			; get a digit
	ADDI	char,"0"		; convert to ascii
	CALL	putnam			; put it in string
	SOJG	t8,trupr1		; get next digit
	MOVEI	char,">"		; end of protection field
	CALL	putnam
	skipn	flag8		;[JE] Eight bit?
	 jrst	no.att		;[JE]  Nope, skip this.
	movei	char,"/"	;[JE] Yes, add "/" to string.
	pushj	p,putnam
	move	char,flag8	;[JE] Add kind of eight-bit.
	pushj	p,putnam
no.att:	popj	p,

; put a sixbit word in the string.
; sixbit word in ac 'sixwrd'.

trusix:	JUMPE	sixwrd,[POPJ P,]	; null word
trusi1:	SETZ	char,
	LSHC	char,6			; get a sixbit byte
	ADDI	char," "		; convert to ascii
	CAIGE	char,"0"		; legal char?
	 JRST	trusi2			; no
	CAIG	char,"9"		; try again
	 JRST	trusi3			; yes, definitely legal
	CAIL	char,"A"		; last chance
	 CAILE	char,"Z"
trusi2:	  JRST[	HRLZ	char,char	; save char in left half of ac
		CALL	putnam		; put the ^V
		HLRZ	char,char	; get back the char
		JRST	trusi3]		; go put the char too
trusi3:	CALL	putnam			; put it in namestring
	JUMPN	sixwrd,trusi1		; get next byte

; put an octal number in the string.
; number in ac 'number'. number+1 is destroyed.

truoct:	IDIVI	number,^D8		; get quotient and remainder
	PUSH	p,number+1		; push remainder
	SKIPE	number			; IF quotient /= 0 THEN
	 CALL	truoct			;   trueoct (quotient)
	POP	p,char			; ELSE fall thru to put-routine
	ADDI	char,"0"		; but first convert to ascii

; put a character in the string..
; character in ac 'char'.

putnam:	SUBI	t1,1		;[JE]Decrement char counter
	SKIPL	t1		;[JE]Room left in string?
	 IDPB	char,namstr	;[JE] No, deposit the byte
;FUNCTION TrueMode: majors;
;(* Return our opinion of what major mode this buffer shall have, *)
;(* based on what extension we have. *)

TRUEMO::HLRZ	T1,DSLKBK+.RBEXT ;Get extension from lookup/enter block
	MOVEI	T2,MODLEN	;Get length of mode table
TMOD.2:	HRRZ	T3,MODTAB(T2)	;Get next extension from table
	CAIN	T3,(T1)		;Is this it?
	 JRST	TMOD.4		; Yes, go return corresponding mode
	SOJGE	T2,TMOD.2	;No, decrement counter, and maybe loop back
	MOVEI	T1,MD%FUN	;No table left, assume fundamental mode
	MOVEM	T1,1(P)		;Return value for pascal

TMOD.4:	HLRZ	T1,MODTAB(T2)	;We found a match, get the mode from table
	MOVEM	T1,1(P)		;Return it for pascal
	POPJ	P,		;All done!

;*** NOTE *** These must agree with the type 'majors' in MAIN.PAS

MD%C==  7

MODTAB:	XWD	MD%TXT,'DOC'	;Documentation files
	XWD	MD%TXT,'HLP'	;Help files
	XWD	MD%TXT,'MAN'	;Manuals
	XWD	MD%TXT,'MEM'	;Memos
	XWD	MD%TXT,'MSS'	;Scribe something
	XWD	MD%TXT,'PL '	;Prolog (NIL says text mode is best...)
	XWD	MD%TXT,'RFC'	;Request For Comments...
	XWD	MD%TXT,'TXT'	;General text files
	XWD	MD%ALG,'ALG'	;Algol-60
	XWD	MD%ALG,'SIM'	;Simula
	XWD	MD%MAC,'MAC'	;Macro-10
	XWD	MD%MAC,'MID'	;Midas
	XWD	MD%MAC,'P11'	;Macro-11
	XWD	MD%PAS,'PAS'	;Pascal
	XWD	MD%C,  'C  '	;C
	XWD	MD%C,  'H  '	;C 'include' files
	XWD	MD%TEX,'TEX'	;TeX sources
	XWD	MD%ADA,'ADA'	;Frog code.
	XWD	MD%BLI,'BLI'	;Bliss (yeach) code.
	XWD	MD%BLI,'B36'	; -""-
	XWD	MD%BLI,'R36'	; -""-
	XWD	MD%BLI,'REQ'	; -""-
;PROCEDURE TruePos(var pagenumber, linenumber, charnumber: bufpos);
;(* Give back information about where in the file to start. *)

TRUEPO::move	1,pg.val
	movem	1,(2)		;Give page #.
	move	1,ln.val
	movem	1,(3)		;Give line #.
	move	1,ch.val
	movem	1,(4)		;Give char #.
	popj	p,		;Return.
;FUNCTION dskcd(d: string): integer;
;(* This implements the function "Connect to Directory". *)

dskcd::	SETZM	dslkpt		;Clear first word of PATH. block.
	MOVE	1,[dslkpt,,dslkpt+1]
	BLT	1,dslkpt+.PTMAX	;Clear rest of block.
	HRLI	2,strsize	;Load string size.
	MOVEI	3,dslkbk	;Load stupid argument pointer.
	CALL	filprs		;Call parser to fill in data.
	CAIE	t0,errnoe	;Any error?
	 JRST	fatal		; Yes, conplain.
	MOVEM	1,dslkpt+.PTFCN	;Set up function code.
	MOVE	1,[.PTMAX,,dslkpt]
	MOVEI	t0,errccd	;Assume error.
	PATH.	1,		;Try change default path.
	 JRST	fatal		; Bad, propagate error.
	SETZM	1,1(p)		;Give good return.
	POPJ	p,
;FUNCTION dskrecognition(VAR f: string; VAR len: integer; ch: char): boolean;
;(* This is the file name recognition routine.  It just returns FALSE *)
;(* in this implementation. *)

DSKREC::SETZM	1(P)		;Clear return value.  (Means FALSE)
	POPJ	P,		;Return and show that this did not work.
;(*	Reads data from the file into x. 
;	Returns number of read characters if success, -1 if EOF and
;	-2 if other error. *)
dskrea::SKIPN	ds.opn			; check if file is open
	 bugerr <DSKREAD: File is not open>
	SKIPE	tcrdev			; tmpcore?
	 JRST	tcrrea			; yes
	IN	dsk,
	 JRST	dskr10
	STATZ	dsk,IO.EOF		; check for end-of-file
	 JRST[	SETOM	1(P)		; return -1 in case of EOF 
		POPJ	P,]
	STATZ	dsk,IO.ERR		; hard error?
	 bugerr <DSKREAD: Hard error. Please reboot>
	 bugerr <DSKREAD: Strange error>

dskr10:	HRRZ	t1,dsbfih+.BFADR	; address to current buffer
	ADDI	t1,2			; get pointer to start of buffer
	SETAM	t1,(x)			; to where it should end up
	MOVE	t3,dsbfih+.BFCTR	; get number of read bytes
	skipe	flag8		;[JE] Eight-bit bytes?
	 jrst	dskr.8		;[JE]  Yes, have to convert block.
	SOSLE	blknum			; last block?
	 JRST	.inret			; no, just return count
	pushj	p,getlwd	;[JE] Get last word in buffer.
	TXNN	t5,000000000377		; [BD] Ends with <NUL> ?
	 SUBI	t3,1			; [BD] yes, decrement count
	TXNN	t5,000000077777		; [BD] Ends with <NUL> <NUL> ?
	 SUBI	t3,1			; [BD] yes, decrement count
	TXNN	t5,000017777777		; [BD] Ends with <NUL> <NUL> <NUL> ?
	 SUBI	t3,1			; [BD] yes, decrement count
	TXNN	t5,003777777777		; [BD] Ends <NUL> <NUL> <NUL> <NUL> ?
	 SUBI	t3,1			; [BD] yes, decrement count
.inret:	MOVEM	t3,1(p)			; return count

; Get last data word in buffer.

getlwd:	move	t2,dsbfih+.bfptr;Get byte pointer.
	movei	t4,-1(t3)	;Get number of 7-bit bytes, minus one.
	idivi	t4,5		;Get number of words minus one.
	add	t2,t4		;Increment byte pointer.
	ibp	t2		;... to last word somewhere.
	move	t5,(t2)		;Fetch last word.
	popj	p,		;return.

dskr.8:	move	t1,t3		;Get number of bytes.
	imuli	t1,4		;Convert to 8-bit bytes.
	idivi	t1,5
	sosle	blknum		;Last block?
	 jrst	dskr8b		; Nope, just convert buffer.
	pushj	p,getlwd	;Get last word in buffer.
	txnn	t5,000000007777	;Check for one null.
	 subi	t1,1
	txnn	t5,000003777777	;Check for two nulls.
	 subi	t1,1
	txnn	t5,001777777777	;Check for three nulls.
	 subi	t1,1
dskr8b:	movem	t1,1(p)		;Set return value.
	jumple	t1,.popj	;Save some work for empty buffers.
	movei	t6,[jrst (t3)]	;Default to no conversion.
	move	t2,flag8	;What kind of eight-bit?
	cain	t2,"I"		;I*M specials?
	 movei	t6,cvtibm	; Yes, load conversion routine.
	cain	t2,"A"		;ANSI eight bit?
	 movei	t6,cvtansi	; Yes, load conversion routine.
	move	t7,dsbfih+.bfptr;Get seven-bit byte pointer.
	move	t8,t7		;Copy it.
	tlc	t8,001700	;Convert to eight-bit pointer.
dskr8c:	ildb	t2,t8		;Get eight-bit byte.
	jsp	t3,(t6)		;Possibly convert it.
	idpb	t2,t7		;Store seven-bit byte.
	sojg	t1,dskr8c	;Decrement and loop.
	popj	p,

; Routine to convert eight-bit char in T2 to suitable seven-bit character.

define	convert(c8,c7),<
	cain	t2,100+c8
	 movei	t2,c7
>;convert macro

cvtibm:	caig	t2,200		;High bit set?
	 jrst	(t3)		; No, save compares.
	convert "A","~"
	convert "B","`"
	convert "D","{"
	convert "F","}"
	convert "N","["
	convert "O","]"
	convert "P","@"
	convert "T","|"
	convert "Y","\"
	convert "Z","^"
	jrst	(t3)		;Return from JSP call.

cvtansi:jrst	(t3)		;Just return for now.

tcrrea:	skipe	tcrflg		; have we read a block already?
	 jrst[	setom	1(p)	; yes, return EOF
		popj	p,]
	move	t3,tcrsiz	; get number of words read
	subi	t3,1		; minus one
	move	t4,t3		; compute number..
	imuli	t3,5		; ..of bytes
	movei	t0,dsbuf1+3	; get pointer to buffer
	movem	t0,(x)		; give to caller
	hrli	t0,(POINT 7,0)	; make a bytepointer to the buffer
	add	t4,t0		; adjust to last word - 1
tcrr10:	ildb	t5,t4		; get that byte
	skipe	t5		; <NUL>?
	 aoja	t3,tcrr10	; no, get next
	movem	t3,1(p)		; give number of read bytes to caller
	setom	tcrflg		; indicate we've read from TMP:
	popj	p,
;(*	Returns the address of the next available diskbuffer. *)

dsknex::HRRZ	t1,dsbfoh+.BFADR	; address of buffer header
	SKIPE	tcrdev			; tmpcore?
	 MOVEI	t1,dsbuf1+.BFHDR	; yes, use predefined buffer
	ADDI	t1,2			; offset to get beginning of text
	MOVEM	t1,1(p)
	POPJ	p,

;(*	Writes count bytes of data on the file from x.
;	Returns 0 if success, -2 otherwise. *)
dskwri::SKIPN	ds.opn			; check if file is open
	 bugerr <DSKWRITE: File is not open>
	CAILE	count,dsksiz
	 bugerr	<DSKWRITE: Too large diskblock>
	MOVE	t3,count		; get number of bytes to write
	IDIVI	t3,5
;[je] n'th try to get the correct byte pointer...
	movei	t5,dsbuf1+3
	hrli	t5,(point 7)
	skipn	tcrdev
	 move	t5,dsbfoh+.bfptr
	add	t3,t5

dskw10:	JUMPE	t4,dskw20
	IBP	t3
	SOJA	t4,dskw10

dskw20:	SETAM	t3,dsbfoh+.BFPTR
	CAIE	count,dsksize		; check if disk block full	(*JMR*)
	 CALL	filnul
	MOVNI	t3,9(count)		; calculate number of full words(*JMR*)
	IDIVI	t3,5			;  in the buffer		(*JMR*)
	HRLZ	t3,t3			; make an AOBJN pointer out of	(*JMR*)
	HRR	t3,dsbfoh+.BFADR	;  it				(*JMR*)
	ADDI	t3,1			;				(*JMR*)
	MOVEI	t4,1			; bit to clear			(*JMR*)
dskw30:	AOBJP	t3,dskw40		; more words to clear bit in?	(*JMR*)
	ANDCAM	t4,(t3)			; yes, clear least significant	(*JMR*)
	JRST	dskw30			;  bit and loop			(*JMR*)

dskw40:	SKIPE	tcrdev			; tmpcore?
	 JRST	tcrwri			; yes
	OUT	dsk,
	 JRST[	SETZM	1(p)	; all's well
		POPJ	p,]
	STATZ	dsk,IO.ERR		; hard error?
	 bugerr <DSKWRITE: Hard error.Error code later>
	 bugerr <DSKWRITE: Strange error>

tcrwri:	HLLZ	t4,dslkbk+.RBNAM	; get filename
	MOVN	t5,count		; negative number of bytes to write
	IDIVI	t5,5			; convert
	JUMPE	t6,tcrw10		;  into
	SUBI	t5,1			;  words
tcrw10:	HRLZ	t5,t5			; make an
	HRRI	t5,dsbuf1+2		;  IOWD
	MOVE	t3,[.TCRWF,,t4]
	TMPCOR	t3,			; write the TMP: file
	 JRST[	MOVEI	t0,ERNRM%	; too large possibly
		JRST	fatal]
	SETZM	1(p)			; all's well
	POPJ	p,

filnul:	SETZ	t0,			; if not, nullpad last word	(*JMR*)
	TLNN	t3,37B22		; check if thru last word	(*JMR*)
	 POPJ	p,			; done, exit from small loop	(*JMR*)
	IDPB	t0,t3			; store a null in buffer ring	(*JMR*)
	JRST	filnul			; and loop back for next byte	(*JMR*)
;(*	Closes the open file. Returns 0 if succesful,
;	-1 if file not found, -2 otherwise. *)
dskclo::SKIPN	ds.opn			; check if file is open
	 bugerr <DSKCLOSE: File is not open>
	SKIPE	tcrdev			; tmpcore?
	 JRST	dskcl1			; yes
	RELEAS	dsk,			; release the channel
	SKIPN	xxbak			; do we have backup?
	 JRST	dskcl1			; no we're finished
	MOVE	t1,orgnam		; get original name
	SETAM	t1,dslkbk+.RBNAM
	MOVE	t1,bakext		; get backupextension
	HLLM	t1,dslkbk+.RBEXT
	MOVEI	t0,ERDNA%		; assume device not available
	OPEN	dsk,dsopbk		; open the device
	 JRST	fatal			; sorry...
	LOOKUP	dsk,dslkbk		; do we have an old backup file?
	 JRST	newbak			; no
	SETZ	t0,			; yes
	RENAME	dsk,t0			; delete old backup file
	 JRST[	MOVEI	t0,errbkd	; can't delete old backup
		JRST	fatal]
newbak:	MOVE	t1,orgnam		; get original name back
	SETAM	t1,dslkbk+.RBNAM
	MOVE	t1,orgext		; get original extension back
	HLLM	t1,dslkbk+.RBEXT
	MOVEI	t0,ERDNA%		; assume device not available
	OPEN	dsk,dsopbk		; try open a device
	 JRST	fatal
	LOOKUP  dsk,dslkbk		; lookup the original file
	 JRST	rentmp			; never mind, perhaps we don't have one
	SETOM	proflg
	HRRZ	t2,dslkbk+.RBEXT	; get creation date 
	HLL	t2,bakext		; get backup extension
tobakr:	MOVEM	t2,dslkbk+.RBEXT
	RENAME  dsk,dslkbk		; rename original file
	 JRST[	MOVEI	t0,errbkr
		SKIPN	proflg		; have we tried before?
		 JRST	fatal		; yes, tell'm we're sorry
		LDB	t1,[POINT 3,dslkbk+.RBPRV,2]
		MOVEI	t0,errbkr
		CAIE	t1,2		; is it protection code 2 ?
		 JRST	fatal		; no we can't rename
		MOVE	t1,orgext
		HLLM	t1,dslkbk+.RBEXT
		MOVEI	t1,1
		DPB	t1,[POINT 3,dslkbk+.RBPRV,2]
		MOVEI	t0,errbkr
		RENAME	dsk,dslkbk	; try to change the protection
		 JRST	fatal		; can't lower prot, sorry
		MOVEI	t1,2
		MOVE	t1,orgpro
		ANDI	t1,477		; safety measure in case of FILE DAEMON
		DPB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
		SETZM	proflg		; don't try this again
		JRST	tobakr		; go try rename to backup name again
rentmp:	MOVE	t1,tmpnam		; get name of tmp-file
	SETAM	t1,dslkbk+.RBNAM
	MOVE	t1,tmpext		; get extension of tmp-file
	HLLM	t1,dslkbk+.RBEXT
	MOVEI	t0,ERDNA%		; assume device not available
	OPEN	dsk,dsopbk		; try open a device
	 JRST	fatal
	LOOKUP  dsk,dslkbk		; lookup the tmp-file
	 JRST[  HRRZ	t0,dslkbk+.RBEXT ; error
		SKIPN	t0
		JRST	warn
		JRST	fatal]
	MOVE	t1,orgnam		; get name of original file
	SETAM	t1,dslkbk+.RBNAM
	MOVE	t1,orgext		; get extension of original file
	HLLM	t1,dslkbk+.RBEXT
	MOVE	t1,orgpro		; get original protection
	DPB	t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
	RENAME  dsk,dslkbk		; rename tmp-file to original file
	 JRST[	HRRZ	t0,dslkbk+.RBEXT; failed, return with error code
		SKIPN	t0
		JRST	warn
		JRST	fatal]
	RELEAS  dsk,			; don't need device any more
	SETZM	xxbak			; reset backup flag
dskcl1: SETZM	ds.opn			; file isn't open any more
	SETZM	tcrflg
	SETZM	tcrdev
	SETZM	notdir
	setzm	1(p)
	popj	p,
;PROCEDURE dskmessage (VAR errstr: STRING);
;(*	Returns latest disk-error. *)


dskmes::CALL	blanks			; blank the string
	MOVE	t1,errtab		; get what table
	ADD	t1,lsterr		; add offset into table
	MOVE	t1,(t1)			; get address of errorstring
	HRLI	t1,(POINT 7,0)		; make a bytepointer
	MOVEI	t4,strsiz		; max length of a string
	MOVE	t6,[POINT 7,(errstr)]	; make byte pointer to dest.
dskme1:	ILDB	t5,t1			; get next char
	JUMPE	t5,dskme2		; break on <NUL>
	IDPB	t5,t6			; put byte in dest.
	SOJG	t4,dskme1		; get next char, if room for more
dskme2:	MOVEI	t1,otherr
	CAME	t1,errtab		; misc. error?
	 popj	p,			; no, just return
	MOVEI	t1,errbkr-errmis
	CAME	t1,lsterr		; errbkr error-code?
	 popj	p,			; no, return
	MOVE	t6,[POINT 7,jobpos/5(errstr),<jobpos-jobpos/5*5>*7-1]
	MOVE	t1,[pOiNT 6,tmpnam]	; pointer to jobnumber in SIXBIT
	MOVEI	t4,3			; mAx 3 digits in jobnumber
dskm10:	ILDB	t5,t1			; get next digit
	ADDI	t5," "			; convert to ascii
	IDPB	t5,t6			; store it
	SOJG	t4,dskm10		; get next digit
	popj	p,

; routine to set latest error, argument in ac0, which is preserved on exit
	PUSH	p,t0
	PUSH	p,t1
	PUSH	p,t2
	CAILE	t0,1000			; misc. error?
	 JRST[	SUBI	t0,errmis	; subtract to get offset
		MOVEI	t1,otherr	; use misc. error table
		MOVEI	t2,othmax	; check
		JRST	setchk		;  boundaries
	CAILE	t0,100			; parsing error codes are > 100
	 JRST[	SUBI	t0,errnoe	; subtract first error to get offset
		MOVEI	t1,prserr	; use parsing error table
		MOVEI	t2,prsmax	; check
		JRST	setchk		;  boundaries
	MOVEI	t1,monerr		; use monitor error table
	MOVEI	t2,monmax
setchk:	JUMPL	t0,setch1		; IF offset < 0 OR
	CAMG	t0,t2			;   offset > max allowed
	 JRST	seter1			; THEN
setch1:	MOVEI	t1,errset		;   use special error-error
	SETZ	t0,			; FI
seter1:	SETAM	t1,errtab		; set what table to use
	SETAM	t0,lsterr		; set latest error
	CLOSE	dsk,			; close the file
	SETZM	tcrflg
	SETZM	tcrdev
	SETZM	notdir
	SETZM	ds.opn			; and remember it
	SETZM	xxbak			; clear backup-flag too
	POP	p,t2
	POP	p,t1
	POP	p,t0
	popj	p,

fatal:	CALL	seterr			; set latest error
	movx	t1,-2
	movem	t1,1(p)
	popj	p,

warn:	CALL	seterr			; set latest error
	setom	1(p)
	popj	p,

;High segment data and literals

tmppro:	EXP	100			; temporary protection
tmpext:	SIXBIT	'TMP'			; temporary extension
bakext:	SIXBIT	'BAK'			; backup extension

;special error-error
errset:	[ASCIZ	"UNK? Unknown error in DSKIO"]

;error table, misc. errors
	[ASCIZ	"IOF? This is no error"]
	[ASCIZ	"IOF? Can't delete old backup file"]
	[ASCIZ	"IOF? Backup failed, saving as nnnAMI.TMP"]
;		 123456789012345678901234567890^
	[ASCIZ	"CCD? Can't change directory"]

;error table, parsing errors.
;40 chars:	"                                        "
	[ASCIZ	"FSE? No error, success"]			;errnoe==101
	[ASCIZ	"FSE? Illegal character in filespec."]		;erricf==102
	[ASCIZ	"FSE? Too long field in filespecification"]	;errtlf==103
	[ASCIZ	"FSE? Duplicate filespec"]			;errdfn==104
	[ASCIZ	"FSE? Duplicate extension"]			;errdex==105
	[ASCIZ	"FSE? Double directory"]			;errddr==106
	[ASCIZ	"FSE? Colon, but no device"]			;errcnd==107
	[ASCIZ	"FSE? Duplicate device"]			;errddv==110
	[ASCIZ	"FSE? Illegal separator in directory"]		;errils==111
	[ASCIZ	"FSE? Too many sfds"]				;errtms==112
	[ASCIZ	"FSE? Null sfd"]				;errnls==113
	[ASCIZ	"FSE? Illegal format for directory"]		;errilf==114
	[ASCIZ	"FSE? Illegal protection code"]			;errilp==115
	[ASCIZ	"FSE? Duplicate protection"]			;errdpr==116
	[ASCIZ	"FOO? Cannot write 8-bit files"]		;errnw8==117

	[ASCIZ	"IOE? File not found"]				;ERFNF%==0
	[ASCIZ	"IOE? Incorrect ppn"]				;ERIPP%==1
	[ASCIZ	"IOE? Protection failure"]			;ERPRT%==2
	[ASCIZ	"IOE? File being modified"]			;ERFBM%==3
	[ASCIZ	"IOE? Already existing file name"]		;ERAEF%==4
	[ASCIZ	"IOE? Illegal sequence of uuos"]		;ERISU%==5
	[ASCIZ	"IOE? Transmission error"]			;ERTRN%==6
	[ASCIZ	"IOE? Not a save file"]				;ERNSF%==7
	[ASCIZ	"IOE? Not enough core"]				;ERNEC%==10
	[ASCIZ	"IOE? Device not available"]			;ERDNA%==11
	[ASCIZ	"IOE? No such device"]				;ERNSD%==12
	[ASCIZ	"IOE? Ill. mon. call for getseg and filop"]	;ERILU%==13
	[ASCIZ	"IOE? No room"]					;ERNRM%==14
	[ASCIZ	"IOE? Write-locked"]				;ERWLK%==15
	[ASCIZ	"IOE? Not enough table space"]			;ERNET%==16
	[ASCIZ	"IOE? Partial allocation"]			;ERPOA%==17
	[ASCIZ	"IOE? Block not free"]				;ERBNF%==20
	[ASCIZ	"IOE? Can't supersede a directory"]		;ERCSD%==21
	[ASCIZ	"IOE? Can't delete non-empty directory"]	;ERDNE%==22
	[ASCIZ	"IOE? Sfd not found"]				;ERSNF%==23
	[ASCIZ	"IOE? Search list empty"]			;ERSLE%==24
	[ASCIZ	"IOE? Sfd nest level too deep"]			;ERLVL%==25
	[ASCIZ	"IOE? No-create for all s/l"]			;ERNCE%==26
	[ASCIZ	"IOE? Segment not on swap space"]		;ERSNS%==27
	[ASCIZ	"IOE? Can't update file"]			;ERFCU%==30
	[ASCIZ	"IOE? Low seg overlaps hi seg (getseg)"]	;ERLOH%==31
	[ASCIZ	"IOE? Not logged in (run)"]			;ERNLI%==32
	[ASCIZ	"IOE? File has outstanding locks set"]		;ERENQ%==33
	[ASCIZ	"IOE? Bad .EXE file directory (getseg,run"]	;ERBED%==34
	[ASCIZ	"IOE? Bad ext. for .EXE file(getseg,run)"]	;ERBEE%==35
	[ASCIZ	"IOE? .EXE directory too big(getseg,run)"]	;ERDTB%==36
	[ASCIZ	"IOE? TSK - exceeded network capacity"]		;ERENC%==37
	[ASCIZ	"IOE? TSK - task not available"]		;ERTNA%==40
	[ASCIZ	"IOE? TSK - undefined network node"]		;ERUNN%==41
	[ASCIZ	"IOE? Rename - sfd is in use"]			;ERSIU%==42
	[ASCIZ	"IOE? Delete - file has an ndr lock"]		;ERNDR%==43
	[ASCIZ	"IOE? Job count high (A.T. read cnt ovrfl"]	;ERJCH%==44
	[ASCIZ	"IOE? Cannot rename sfd to a lower level"]	;ERSSL%==45

;Lowsegment storage

					; OPEN block
dsopbk: EXP	0			; I/O status and flags
	EXP	0			; Sixbit device name or UDX
	dsbfoh,,dsbfih			; Buffer ring header pointers

dslkbk: EXP	dslkln			; .RBCNT, Number of args following
	XWD	0,dslkpt		; .RBPPN, Pointer to path

; Job's PPN								(*JMR*)
jobppn:	BLOCK	1			; Logged in PPN			(*JMR*)

; PATH.-block
dslkpt: BLOCK	.PTMAX+1
prslen:	BLOCK	1		;String length when parsing file names.
prsarg:	block	1		;Special input pointer for parser.

tcrsiz:	BLOCK	1			; place to save number of read words

tcrdev:	BLOCK	1			; flag for TMP:
tcrflg:	BLOCK	1			; flag for reading TMP:
notdir:	BLOCK	1			; flag for non-directory devices
ds.opn: EXP	0			; file-is-open flag
; buffer ring headers
dsbfoh: BLOCK	3			; output header
dsbfih: BLOCK	3			; input header
; buffers
dsbuf1: BLOCK	3			; first buffer
	BLOCK	dsksiz/5
dsbuf2: BLOCK	3			; second buffer
	BLOCK	dsksiz/5
dsbuf3: BLOCK	3			; third buffer
	BLOCK	dsksiz/5
dsbuf4: BLOCK	3			; fourth buffer
	BLOCK	dsksiz/5
dsbuf5: BLOCK	3			; fifth buffer
	BLOCK	dsksiz/5
dsbuf6: BLOCK	3			; sixth buffer
	BLOCK	dsksiz/5
; data for backup
tmpnam:	BLOCK	1			; temporary filename
orgpro:	BLOCK	1			; original protection
orgnam:	BLOCK	1			; original file name
orgext:	BLOCK	1			; original extension
xxbak:	BLOCK	1			; backup flag

; storage for the error-handler
errtab:	BLOCK	1			; pointer to last error tabel
lsterr:	BLOCK	1			; offset into last error table

proflg:	BLOCK	1			; protection-code flag

cvseen:	EXP	0			; CTRL-V flag

save.n:	BLOCK	1			; place to save pointer to filename
savpos:	BLOCk	1			; place to save position in filename

blknum:	BLOCK	1			; number of blocks in file

TCRBUF:	BLOCK	50		;Buffer for TMP:EDS reading/writing.
RSCCNT:	block	1		;Count of argument chars rescanned.

RUNBLK::			;[JE] Argument for /RUN:file
RUNDEV::!EXP	0		;Device.
RUNFIL::!EXP	0		;File name.
RUNEXT::!EXP	0		;Extension.
	 EXP	0		;Some zero word.
	 EXP	0		;Another zero word.

EXPFIL:	BLOCK	^D11		;Expand file name here.

PG.VAL:	BLOCK	1		;Value of /Page:nn
LN.VAL:	BLOCK	1		;Value of /Line:nn
CH.VAL:	BLOCK	1		;Value of /Char:nn

FLAG8:	BLOCK	1		;Byte size of input file.