DMARCD - DM archive device.

This is the real source for DEVICE; OARCDV BIN, which uses the old
"ARC!!!" archive format.  The previously reconstructed ARCDEV 66 can
be removed, and it was also the wrong version.

build/basics.tcl

@@ -106,7 +106,7 @@ respond "*" ":midas device;jobdev arc_syseng;arcdev\r"
 expect ":KILL"
 respond "*" ":link device;jobdev ar,device;jobdev arc\r"
 
-respond "*" ":midas device;oarcdv bin_syseng;arcdev 66\r"
+respond "*" ":midas device;oarcdv bin_sysen2; dmarcd\r"
 expect ":KILL"
 
 # JOBDEV D (DSKDEV)

src/sysen2/dmarcd.30

@@ -1,6 +1,4 @@
-TITLE ARCDEV -- BOJ HANDLER FOR ARCHIVE DEVICE
-; Version 66 reconstructed from SYSENG; ARCDEV 23 (timestamped 1976-12-26)
-; and DEVICE; OARCDV BIN (1977-07-04) disassembly.
+ TITLE ARCDEV -- BOJ HANDLER FOR ARCHIVE DEVICE
 
 
 ; SUMMARY OF ARCDEV ROUTINES
@@ -89,8 +87,9 @@ TITLE ARCDEV -- BOJ HANDLER FOR ARCHIVE DEVICE
 ;		OF DIRECTORY (E.G. DELETION, INSERTION, GARBAGE COLLECTION)
 
 ; ONLY OTHER DIFFERENCE FROM STANDARD DISK DIRECTORY IS IN 5TH WORD
-; OF EACH NAME BLOCK.  DISK USES LEFT HALF FOR REFERENCE DATE, DOESN'T
-; USE RIGHT HALF.  ARC USES LEFT HALF FOR REFERENCE DATE, USES RIGHT HALF
+; OF EACH NAME BLOCK.  DISK USES LEFT HALF FOR REFERENCE DATE, RIGHT
+; HALF FOR AUTHOR, BYTE SIZE, AND BYTE LENGTH WHICH WE DON'T DO YET.
+; ARC USES LEFT HALF FOR REFERENCE DATE, USES RIGHT HALF
 ; FOR COUNT OF NUMBER OF OPENS FOR READING.
 
 ; SECOND BLOCK:
@@ -162,6 +161,8 @@ P=15    ;DO NOT CHANGE! ;PDL POINTER
 T=16    ;"
 U=17    ;"              ;USER INDEX
 
+.XCREF A,B,C,D,E,TT,I,Q,J,R,W,H,P,T,U
+
 BOJC==1
 MFDI==3
 
@@ -185,8 +186,8 @@ POSPTR:	0	; ACCESS POINTER
 OPMODE:	0	; MODE OF OPEN
 CRUNAM:	0	; CREATOR OF THIS ARCDEV
 CRJNAM:	0	; JNAME OF CREATOR OF THIS ARCDEV
-LENGTH:	0	; FILE LENGTH OF READ FILE
-BYTSIZ:	0	; BYTE SIZE
+LENGTH:	0	; FILE LENGTH OF READ FILE (IN WORDS)
+BYTSIZ:	0	; 7 OR 44 DEPENDING ON OPEN MODE
 BYTPWD:	0	; BYTES PER WORD
 
 LOCKSW:	0	; 0=>ARC NOT LOCKED 1.1 BIT=1 => SOFT LOCKED, 1.2 BIT=1 => HARD LOCKED
@@ -1173,7 +1174,7 @@ ARCINI:	PUSH	P,A
 	MOVE	A,[BLOCK3,,BLOCK3+1]
 	BLT	A,BLOCK3+1777
 	MOVE	A,[SIXBIT /ARC!!!/]
-	MOVEM	A,BLOCK3+ARCTYP
+	MOVEM	A,BLOCK3+ARCTYP	; IDENTIFY THIS FILE AS LEGITIMATE ARCHIVE.
 	MOVEI	A,2000		; POINTER TO NAME AREA OFF THE END
 	MOVEM	A,BLOCK3+UDNAMP
 	MOVE	A,[-2000,,BLOCK3]
@@ -1463,11 +1464,12 @@ DIRMAP:	PUSH	P,A
 	HRLZI	B,-2
 	.CALL	BLKMAP
 	JRST	DTAERR
-	MOVE	A,ARCDIR+ARCTYP
-	CAME	A,[-1]
-	 CAMN	A,[SIXBIT /ARC!!!/]
+	MOVE	A,ARCDIR+ARCTYP	;IS THIS FILE REALLY AN ARCHIVE?
+	CAME	A,[-1]		;FOR NOW, ACCEPT-1 (OLD CONVENTION) OR 'ARC!!!.
+	 CAMN	A,[SIXBIT /ARC!!!/]	;SOMEDAY -1 WILL BECOME ILLEGAL.
 	  CAIA
-	   JRST [MOVSI H,46 ? JRST OPFAIL]
+	   JRST	[ MOVSI H,%EBDFL	;NOT AN ARCHIVE FILE => "UNRECOGNIZABLE FILE"
+		  JRST OPFAIL ]
 	MOVE	A,[SIXBIT /ARC!!!/]
 	MOVEM	A,ARCDIR+ARCTYP
 	MOVE	A,ARCDIR+GCTAG	; GET GC TAG
@@ -1493,10 +1495,10 @@ OPNAR2:	POP	P,A
 
 ARCNOP:	.STATUS	ARC,A		; FIND OUT WHY
 	LDB	A,[220600,,A]	; GET OPEN FAILURE BITS
-	CAIN	A,4
-	JRST	OPNAR2
+	CAIN	A,%ENSFL	; FILE NOT FOUND => NON-SKIP RETURN, SO WILL CREATE.
+	 JRST	OPNAR2
 	CAIE	A,23		; FILE LOCKED?
-	JRST	ARCNP4		; NO - FILE NOT FOUND
+	JRST	ARCNP4
 ARCNP3:	MOVEI	A,15		; WAIT A HALF SECOND AND TRY AGAIN
 	.SLEEP	A,
 	MOVE	A,(P)
@@ -2017,8 +2019,8 @@ NOSDEV:	HRLZI	H,1
 ; OPEN FAILURE
 
 OPFAIL:	SETZM	I		; COME HERE TO REPORT OPEN FAILURE
-	SKIPL CLSINP	; ERROR WHILE CLOSE IN PROGRESS?
-	JRST CLSDIE	;THEN JUST GO AWAY
+	SKIPL	CLSINP		; ERROR WHILE CLOSE IN PROGRESS?
+	JRST	CLSDIE		; THEN JUST GO AWAY
 	.CALL	JRET
 	JFCL
 	SKIPN	IFOPEN		; IS THIS .CALL FAILURE?
@@ -2161,8 +2163,8 @@ OPEN:	MOVE	A,WD3		; COPY SUB-FILE NAMES
 	MOVEM	A,DEVICE
 	MOVE	A,WD7		; SAVE OPEN MODE
 	MOVEM	A,OPMODE
-	TRNE	A,6
-	 SKIPA	A,[44]
+	TRNE	A,6		; SKIP IF CHARACTER MODE
+	 SKIPA	A,[44]		; BLOCK OR IMAGE
 	  MOVEI	A,7
 	MOVEM	A,BYTSIZ
 	MOVEI	B,44
@@ -2326,7 +2328,7 @@ FILOP3:	MOVE	A,UNFN1(Q)	; STORE REAL INFO ABOUT THE FILE
 	HLLM	A,RFDATE	; AND CORE COPY
 FILOP5:	MOVE	A,Q		; GET BYTE POINTER TO DESCRIPTOR AREA
 	PUSHJ	P,DSCBPT
-	SETZB	D,LENGTH		; INITIALIZE LENGTH
+	SETZB	D,LENGTH	; INITIALIZE LENGTH
 	ILDB	B,A		; GET FIRST BYTE
 	JUMPE	B,FILOP2	; IF FIRST BYTE IS ZERO - FILE EMPTY
 	CAIE	B,40		; BETTER BE A FORTY
@@ -2565,20 +2567,21 @@ DAUI:	PUSHJ	P,LFCHR		; GET NEXT CHARACTER
 	.IOT	BOJC,A		; SEND IT
 DAUI1:	SOSG	WD2
 	 JRST	LOOP
-	LDB	B,[000300,,OPMODE]
-	JRST	@DIRIOT(B)
+	LDB	B,[000300,,OPMODE]	; GET BASIC OPEN MODE
+	JRST	@DIRIOT(B)	; LOOP BACK TO TRANSFER MORE
+
 
 ; DIUI - DIRECTORY IMAGE UNIT INPUT - SEND NEXT WORD OF IMAGE
 ; DIRECTORY.
 
 DIUI:	MOVE	A,BLKPOS	; GET POSITION IN DIRECTORY BLOCK
 	CAIL	A,2000		; IN BOUNDS?
-	JRST	SEOF		; NO - GO SEND EOF
+	 JRST	SEOF		; NO - GO SEND EOF
 	AOS	BLKPOS		; BUMP POSITION
 	CAIN	A,2		; IS HE ASKING FOR DIRECTORY NAME?
-	JRST	DIUI0		; YES - GO GIVE IT TO HIM
+	 JRST	DIUI0		; YES - GO GIVE IT TO HIM
 	CAIG	A,1		; IS HE ASKING FOR WORD 0 OR 1
-	AOS	A		; ADJUST TO DISK FORMAT
+	 AOS	A		; ADJUST TO DISK FORMAT
 	.IOT	BOJC,ARCDIR(A)	; SEND NEXT WORD
 	JRST	DAUI1
 
@@ -2976,23 +2979,25 @@ FAUO3:	SOS	CHLFIB		; ONE LESS SLOT AVAILABLE
 	AOS	POSPTR
 	MOVE	A,LENGTH
 	PUSHJ	P,LENADJ
-FAUO4:	SOSLE	WD2
-	JRST	FAUO5
+FAUO4:	SOSLE	WD2		; SKIP IF TRANSFERRED ALL
+	 JRST	FAUO5
 	PUSHJ	P,INTON
 	JRST	LOOP
-FAUO5:	LDB	B,[000300,,OPMODE]
-	JRST	@FILIOT(B)
+
+FAUO5:	LDB	B,[000300,,OPMODE]	; GET BASIC OPEN MODE
+	JRST	@FILIOT(B)	; LOOP BACK TO TRANSFER MORE
+
 
 ; FAUI - FILE ASCII UNIT INPUT
 
 FAUI:	PUSHJ	P,INTOFF
-	SKIPGE	A,BLKPOS		; MAKE SURE THERE IS A BLOCK MAPPED IN
+	SKIPGE	A,BLKPOS	; MAKE SURE THERE IS A BLOCK MAPPED IN
 	JRST	FAUI3		; NO - FILE MUST BE EMPTY
 	SKIPE	CHLFIB		; ANY MORE CHARACTERS?
 	JRST	FAUI2		; YES - GO GET NEXT ONE
 	PUSHJ	P,NEWBLK	; GO TO NEXT BLOCK
 	JRST	FAUI3		; NO NEXT BLOCK - GIVE EOF
-FAUI2:	MOVE C,BLBPTR
+FAUI2:	MOVE	C,BLBPTR
 	ILDB	B,C	; GET NEXT CHARACTER
 	CAIN	B,^C		; EOF?
 	JRST	FAUI3		; YES - GO SEND EOF
@@ -3003,10 +3008,10 @@ FAUI2:	MOVE C,BLBPTR
 	JRST	FAUO3		; GO UPDATE COUNTS
 
 FAUI3:	PUSHJ	P,INTON
-SEOF:	MOVEI	H,1
-	MOVSI	A,1000
+SEOF:	MOVEI	H,1		; IF SIOT, UNHANG
+	MOVSI	A,%JGSIO
 	TDNE	A,WD1
-	JRST	FISI1
+	 JRST	FISI1
 	.IOT	BOJC,[-1,,3]	; SEND EOF
 	SETOM	IOCERR		; IOC ERROR NEXT TIME
 	JRST	LOOP
@@ -3031,12 +3036,12 @@ FIUO2:	MOVE	A,BLKPOS	; GET CURRENT POINTER INTO DATA BLOCK
 	MOVE	A,LENGTH	; UPDATE LENGTH
 	PUSHJ	P,LENADJ
 	SOSLE	WD2
-	 JRST	FAUO5
+	 JRST	FAUO5		; TRANSFER MORE
 	PUSHJ	P,INTON
 	JRST	LOOP
 
 FIUO3:	PUSHJ	P,INTON
-	JRST	SEOF
+	JRST	SEOF		; SEND EOF
 
 ; FIUI - FILE IMAGE UNIT INPUT
 
@@ -3056,8 +3061,8 @@ RCHST:	MOVEI	I,1(P)		; GET POINTER TO ROOM ON STACK
 	PUSH	P,FNAME1	; REAL FILE NAMES
 	PUSH	P,FNAME2
 	PUSH	P,DIRECT	; DIRECTORY NAME
-	MOVE	A,POSPTR
-	IMUL	A,BYTPWD
+	MOVE	A,POSPTR	; CURRENT ACCESS POINTER
+	IMUL	A,BYTPWD	; RETURN IT IN BYTES
 	PUSH	P,A
 	PUSH	P,[0]		; UNKNOWN
 	PUSH	P,[0]		; UNKNOWN
@@ -3204,14 +3209,18 @@ CALWN1:	MOVEI	H,1		; MAKE LOSER SKIP
 	JRST	LOOP
 
 ; FILLEN - SEND FILE'S LENGTH
+; THIS CODE IS A BIT OF A FRAUD.  IT RETURNS STUFF COMPATIBLE
+; WITH DISK, BUT WE DON'T REALLY SUPPORT ARBITRARY BYTE SIZE
+; SINCE THIS CODE IS MUCH TO BLETCHEROUS TO FIGURE OUT HOW
+; TO PUT IT IN.
 
-FILLEN:	MOVE	A,LENGTH
-	IMUL	A,BYTPWD
-	PUSH	P,A
-	PUSH	P,BYTSIZ
-	PUSH	P,LENGTH
-	PUSH	P,[44]
-	MOVEI	A,4
+FILLEN:	MOVE	A,LENGTH	; FILE'S LENGTH IN WORDS
+	IMUL	A,BYTPWD	; CONVERT TO USER'S BYTE SIZE
+	PUSH	P,A		; VAL 1 - BYTE LENGTH
+	PUSH	P,BYTSIZ	; VAL 2 - USER'S BYTE SIZE
+	PUSH	P,LENGTH	; VAL 3 - REAL LENGTH
+	PUSH	P,[44]		; VAL 4 - SIZE BYTE'S WRITTEN IN (ALWAYS WORDS)
+	MOVEI	A,4		; RETURN 4 VALUES
 	JRST	CALWIN
 
 ; RDMPBT - READ THE DUMP BIT
@@ -3330,8 +3339,8 @@ ACCESS:	SKIPN NEWFIL
 	PUSHJ P,INTOFF
 	SETZM	IOCERR		; CLEAR I/O ERROR FLAG
 	MOVE	A,WD2		; GET POSITION HE WANTS
-	IDIV	A,BYTPWD
-	JUMPN	B,ACCES4
+	IDIV	A,BYTPWD	; CONVERT TO WORDS
+	JUMPN	B,ACCES4	; NOT ON WORD BOUNDARY => WE CAN'T DO IT.
 	MOVEM	A,WD2
 	CAMN	A,POSPTR	; DOES HE WANT WHERE WE ARE?
 	JRST	NOOP1A		; YES - DO NOTHING