!*************************** AMUS Program Label ******************************
! Filename: UFDSAV.RUN (d/basic)                            Date: 06/12/89
! Category: DISK         Hash Code: 146-144-030-164      Version: 1.0(105)
! Initials: AMI          Name: AMI BAR-YADIN
! Company: UNITED FASHIONS OF TEXAS                Telephone #: 5126312277
! Related Files: SBR'S: DISKIO,DEVCHR,WRTREC,HASH,DATES
! Min. Op. Sys.: na                            Expertise Level: NOV
! Special: requires d/basic (but could be converted :-)
! Description: Writes the system structure (label,mfd,ufd) of a disk to a file
!
!
!*****************************************************************************
!* Updated on 12-Jun-89 at 8:08 PM by Ami Bar-Yadin; edit time: 3:55:07 *!
PROGRAM UFDSAV,1.0(105) ! save disk system structure (label,mfd,ufd)
!
! (c) 1989 by Ami Bar-Yadin
!
! usage:
!	.run ufdsav file=disk {/O} {/S}
!ie	.run ufdsav dsk0.ufd=dsk0
!
!	The 2nd backup fields in the disk label block are updated
!	(after the label is saved) with today's date and the output
!	file name.
!
! UFD save file format:
!	The save file is mostly in binary format, however it may have
!	an ASCII header, so long as each line has a ";" in column 1.
!
!	There are four sections:  ID, Label, MFD and UFD.
!
!	The ID is a binary image as follows:
		MAP1	ID
		MAP2	  ID'DEVNAM,S,8	! null padded ASCII device name
		MAP2	  ID'BLKSIZ,B,4	! size of each disk block
		MAP2	  ID'MFDBLKS,B,4	! number of MFD blocks
		MAP2	  ID'UFDBLKS,B,4	! number of UFD blocks
		MAP2	  ID'SAVDATE,B,4	! system internal format
!	The ID is followed by a 32-bit hash code for the ID data.
!
!	Following the ID is a stream of disk blocks each preceeded by
!	a block ID header and followed by a 32-bit hash code which
!	includes the block ID data.
	MAP1	BLOCK'ID	!	(all zeros for disk label block)
	MAP2		BID'BLKNUM,B,4	! original disk block number
	MAP2		BID'PPN,B,2	! =0,0 for MFD blocks
	MAP2		BID'RELBLK,B,2	! relative to MFD/UFD (1st=1)
	MAP2		BID'BUF,X,512	! (buffer for IO and hash code)
!
!	The Label is always one block long.
!	The MFD blocks are saved one after the other and then
!	the UFD blocks are saved, one PPN at a time, block after block.
!
! disk block formats
	MAP1	LABEL,X,512
	MAP1	LABELX,@LABEL
	MAP2		LBL'OKFLAG,B,4
	MAP2		LBL'VOLNAM,S,40
	MAP2		LBL'VOLID,S,10
	MAP2		LBL'CREATOR,S,30
	MAP2		LBL'INSTALATION,S,30
	MAP2		LBL'SYSNAM,S,30
	MAP2		LBL'CREATED,B,4	! D,M,W,Y separated,word swapped
	MAP2		LBL'ACCESSED,B,4
	MAP2		LBL'BACKUP1,B,4
	MAP2		LBL'BACKVOL1,S,10
	MAP2		LBL'BACKUP2,B,4
	MAP2		LBL'BACKVOL2,S,10

	MAP1	MB,F
	MAP1	MFD,X,512
	MAP1	MFDX,@MFD
DEF  MFD'ENTRIES=63
	MAP2		MFD'ENTRY(MFD'ENTRIES)
	MAP3			MFD'PPN,B,2
	MAP3			MFD'UFDLINK,B,2
	MAP3			MFD'PASSWORD,B,4
	MAP2		MFD'ZERO,B,2
	MAP2		MFD'NEXT,B,2
	MAP2		MFD'PREV,B,2
	MAP2		MFD'FLAG,B,2

	MAP1	UB,F
	MAP1	UFD,X,512
	MAP1	UFDX,@UFD
	MAP2		UFD'NEXT,B,2
	MAP2		UFD'ENTRY(42)
	MAP3			UFD'FILNAM,B,4
	MAP3			UFD'FILEXT,B,2
	MAP3			UFD'FILBLKS,B,2
	MAP3			UFD'FILBYTS,B,2
	MAP3			UFD'FILLINK,B,2

! bit swapping maps
	MAP1	PPN,B,2
	MAP1	PPNX,@PPN	!  byte swapped
	MAP2		PPN'PROG,B,1
	MAP2		PPN'PROJ,B,1

	MAP1	LBLDATE,B,4
	MAP1	LBLDATEX,X,4,@LBLDATE

! work variables

++INCLUDE DEVCHR

	MAP1	STAMP,S,60
function STAMP$()
	STAMP="--"
	STAMP[ 3; 6]=.jobname
	STAMP[10; 6]=.terminal
	STAMP[17; 6]=.pgmname
	STAMP[24;10]=.pgmversion
	STAMP[35; 3]=.day
	STAMP[39; 8]=merge("##/##/##",.date using "#ZZZZZ")
	STAMP[48; 8]=merge("##:##:##",.time using "#ZZZZZ")
	RETURN STAMP+" "+.username
endfunc

	MAP1	DDB,X,104	! ddb for disk io
	MAP1	DDBX,@DDB
	MAP2		DERR,B,1
	MAP2		DFLG,B,1
DEF DFERC=1
DEF DFBYP=2
	MAP2		DDEV,B,2
	MAP2		DDRV,B,2
	MAP2		DFIL,B,4
	MAP2		DEXT,B,2
	MAP2		DPPN,B,2
	MAP2		DREC,B,4
	MAP2		DBUF,B,4
	MAP2		DSIZ,B,4
	MAP2		DIDX,B,4
	MAP2		DOPN,B,1

! save file ID debug info format
	MAP1	FH$,S,80, &
"Save file ID: \2345\ block=###  MFDs=\-\ UFDs=\---\  \234567\  hash=\234567\"

! block ID debug info format
	MAP1	BH$,S,80, &
"Block ID:  block=######  PPN=\23456\  relative=####            hash=\234567\"

	MAP1	SILENT'FLAG,F
	MAP1	OUTFIL,S,30
	MAP1	HASHCODE,B,4
	MAP1	I,F
	MAP1	J,F
	MAP1	A$,S,15
!
!=======
!
UFDSAV:
++INCLUDE USMAC:MTMCSN
	GOSUB SETUP
	GOSUB SHOW'LABEL	! read label and display some fields
	GOSUB WRITE'ID
	GOSUB SAVE'LABEL
	GOSUB SAVE'MFD
	GOSUB SAVE'UFD
	GOSUB UPDATE'LABEL
EXIT:
	IF OUTFIL<>SPACE  CLOSE #1
	END


SETUP:
	PRINT .pgmname;" v";.pgmversion

	IF INSTR(1,.options,"/S")  SILENT'FLAG=-1

	I=INSTR(1,.options,"=")
	WHEN I=0
!		PRINT "?Command line error" : END
		PRINT "%No file output; DEBUG ONLY run."
		OUTFIL=SPACE
	ELSE
		OUTFIL=.options[1,I-1]
	WEND

	ID'DEVNAM=parse(.options[I+1,-1])
	XCALL DEVCHR,ID'DEVNAM,DEVCHR'MAP,ID'DEVNAM
	IF (DEVCHR'FLAGS AND DCF'NODEVICE) &
		PRINT "?No such device" : END
	IF (DEVCHR'FLAGS AND DCF'FILSTRUC)=0  &
		PRINT "?Device not file structured" : END
	IF (DEVCHR'FLAGS AND DCF'MOUNTED)=0  &
		PRINT "?Device not mounted." : END

	XCALL DISKIO,0,DDB,BID'BUF,ID'DEVNAM
	DFLG=DFLG AND (NOT (DFERC OR DFBYP)) ! enable systm error trapping

	WHEN OUTFIL<>SPACE
		LOOKUP OUTFIL,I
		WHEN I<>0
			IF INSTR(1,.options,"/O")=0  &
				PRINT "?Output file exists." : END
			KILL OUTFIL
		WEND
		OPEN #1,OUTFIL,OUTPUT
		PRINT #1 ";";STAMP$()
	WEND
	RETURN


WRITE'ID:
	ID'BLKSIZ=DEVCHR'BLKSIZE	! set block size
	XCALL DATES,1,0,0,ID'SAVDATE	! set save date
	GOSUB COUNT'MFD'BLOCKS
	GOSUB COUNT'UFD'BLOCKS
	XCALL HASH,ID,HASHCODE,0,1	! one pass, all of id
	WHEN OUTFIL<>SPACE
		XCALL WRTREC,1,ID		! write ID
		XCALL WRTREC,1,HASHCODE		! write ID hash code
	ELSE
		XCALL DATES,1,0,ID'SAVDATE,A$
		PRINT USING FH$;ID'DEVNAM,ID'BLKSIZ,STR(ID'MFDBLKS), &
			STR(ID'UFDBLKS),A$,HEX(HASHCODE)
	WEND
	RETURN


SAVE'LABEL:
	BID'BLKNUM=0
	BID'PPN=0
	BID'RELBLK=0
	BID'BUF=LABEL
	GOSUB SAVE'BLOCK
	RETURN


SAVE'MFD:
	MFD'NEXT=1			! start with MFD root block
	IF OUTFIL<>SPACE AND SILENT'FLAG=0  PRINT "Saving MFD block ";
	BID'RELBLK=0
	WHILE MFD'NEXT
		IF OUTFIL<>SPACE AND SILENT'FLAG=0  PRINT HEX(MFD'NEXT);" ";
		MB=MFD'NEXT
		XCALL DISKIO,1,DDB,MB,MFD
		BID'BLKNUM=MB
		BID'PPN=0
		BID'RELBLK+=1
		BID'BUF=MFD
		GOSUB SAVE'BLOCK
	WEND
	IF SILENT'FLAG=0  PRINT
	RETURN


SAVE'UFD:
	IF OUTFIL<>SPACE AND SILENT'FLAG=0  PRINT "Saving UFD blocks: "
	MFD'NEXT=1			! start with MFD root block
	WHILE MFD'NEXT
		IF OUTFIL<>SPACE AND SILENT'FLAG=0 &
			PRINT "  MFD block ";HEX(MFD'NEXT)
		MB=MFD'NEXT
		XCALL DISKIO,1,DDB,MB,MFD	! read MFD block
		FOR I=1 TO MFD'ENTRIES
			WHEN MFD'PPN(I)
				PPN=MFD'PPN(I)
				A$=OCT(PPN'PROJ)+","+OCT(PPN'PROG)
				UFD'NEXT=MFD'UFDLINK(I)
				IF UFD'NEXT  GOSUB SAVE'UFDS
			WEND			
		NEXT
	WEND
	RETURN

SAVE'UFDS:
	IF OUTFIL<>SPACE AND SILENT'FLAG=0  PRINT "    ";A$;": ";
	BID'RELBLK=0
	WHILE UFD'NEXT
		IF OUTFIL<>SPACE AND SILENT'FLAG=0  PRINT HEX(UFD'NEXT);" ";
		UB=UFD'NEXT
		XCALL DISKIO,1,DDB,UB,UFD
		BID'BLKNUM=UB
		BID'PPN=PPN
		BID'RELBLK+=1
		BID'BUF=UFD
		GOSUB SAVE'BLOCK
	WEND
	IF SILENT'FLAG=0  PRINT
	RETURN



SHOW'LABEL:
	XCALL DISKIO,1,DDB,0,LABEL	! read label block

	PRINT LBL'VOLID;" ";LBL'VOLNAM;" of ";LBL'SYSNAM;" at ";LBL'INSTALATION

	LBLDATE=LBL'CREATED
	XCALL DATES,1,0,LBLDATEX,A$
	PRINT "Created ";A$;" by ";LBL'CREATOR;", ";

	LBLDATE=LBL'ACCESSED
	XCALL DATES,1,0,LBLDATEX,A$
	PRINT "last accessed ";A$

	LBLDATE=LBL'BACKUP1
	XCALL DATES,1,0,LBLDATEX,A$
	PRINT "Last backed up ";A$;" on ";LBL'BACKVOL1

	LBLDATE=LBL'BACKUP2
	XCALL DATES,1,0,LBLDATEX,A$
	PRINT "Last UFD save ";A$;" on ";LBL'BACKVOL2

	RETURN


UPDATE'LABEL:
	WHEN OUTFIL=SPACE
		PRINT "%Disk label not updated."
	ELSE
		XCALL DATES,1,0,ID'SAVDATE,LBLDATEX
		LBL'BACKUP2=LBLDATE
		LBL'BACKVOL2=OUTFIL
		XCALL DATES,1,0,LBLDATEX,A$
		PRINT "UFD saved ";A$;" on ";LBL'BACKVOL2
		DOPN=0 !enable write
		XCALL DISKIO,2,DDB,0,LABEL	! update disk label
		DOPN=1 !disable write
	WEND
	RETURN



COUNT'MFD'BLOCKS:
	IF SILENT'FLAG=0  PRINT "Counting MFD blocks: ";
	ID'MFDBLKS=0
	MFD'NEXT=1			! start with MFD root block
	WHILE MFD'NEXT
		IF SILENT'FLAG=0  PRINT HEX(MFD'NEXT);" ";
		ID'MFDBLKS+=1		! count MFD block
		MB=MFD'NEXT
		XCALL DISKIO,1,DDB,MB,MFD ! read MFD block
		WHEN MFD'NEXT>DEVCHR'BLOCKS	! check link to next block
			PRINT &
			   "?Invalid next block link in MFD block ";HEX(MB)
			BREAK
		WEND
	WEND
	IF SILENT'FLAG=0  PRINT
	RETURN


COUNT'UFD'BLOCKS:
	ID'UFDBLKS=0
	IF SILENT'FLAG=0  PRINT "Counting UFD blocks: "
	MFD'NEXT=1			! start with MFD root block
	WHILE MFD'NEXT
		IF SILENT'FLAG=0  PRINT "  MFD block ";HEX(MFD'NEXT)
		MB=MFD'NEXT
		XCALL DISKIO,1,DDB,MB,MFD	! read MFD block
		FOR I=1 TO MFD'ENTRIES
			WHEN MFD'PPN(I)
				PPN=MFD'PPN(I)
				A$=OCT(PPN'PROJ)+","+OCT(PPN'PROG)
				UFD'NEXT=MFD'UFDLINK(I)
				WHEN UFD'NEXT
					WHEN UFD'NEXT>DEVCHR'BLOCKS 
						PRINT &
"%Invalid UFD block link in entry";I;"of MFD block ";HEX(MB);" for ";A$
					ELSE
						GOSUB COUNT'UFDS
					WEND
				WEND
			ELSE
				IF MFD'UFDLINK(I)  PRINT &
"%Non-zero block link for zero PPN in entry";I;"of MFD block ";HEX(MB)
			WEND			
		NEXT
	WEND
	RETURN

COUNT'UFDS:
	IF SILENT'FLAG=0  PRINT "    ";A$;": ";
	J=0
	WHILE UFD'NEXT
		IF SILENT'FLAG=0  PRINT HEX(UFD'NEXT);" ";
		ID'UFDBLKS+=1
		J+=1
		UB=UFD'NEXT
		XCALL DISKIO,1,DDB,UB,UFD	! read MFD block
		WHEN UFD'NEXT>DEVCHR'BLOCKS
			PRINT &
"?Invalid next block link in UFD block ";HEX(UB);", block";J;" of ";A$
			BREAK
		WEND
	WEND
	IF SILENT'FLAG=0  PRINT
	RETURN


SAVE'BLOCK:
	XCALL HASH,BLOCK'ID,HASHCODE,0,1
	WHEN OUTFIL<>SPACE
		XCALL WRTREC,1,BLOCK'ID
		XCALL WRTREC,1,HASHCODE
	ELSE
		PPN=BID'PPN
		A$=OCT(PPN'PROJ)+","+OCT(PPN'PROG)
		PRINT USING BH$;BID'BLKNUM,A$,BID'RELBLK,HEX(HASHCODE)
	WEND
	RETURN