File: RESOV2.MA of Tape: Various/Tests/Blank-Tape-Unit1

(Source file text) 

---

/OS/8 RESOURCES OVLY. 2 FOR KBM V40
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1978 BY DIGITAL EQUIPMENT CORPORATION
/		 AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	.EXTERNAL PRINT,FREEDV,READI,CRLF,OPRINT,DPRINT
	.EXTERNAL SLOTAB
	.ENTRY DIRT,ZEROSL,CNTSLT

	FAST=20
	EXTEN=22

	X0=10

	GERMAN=1

	.MACRO .PRINT ARG
	JMS I (PRINT
	TEXT	"ARG"
	.ENDM
	.RSECT OV2
	FIELD 1

	.NOLIST ME,MEB

DIRT,	0
	JMS I (READI
	1400		/READ 6 BLOCKS
	4000		/INTO 04000
	1		/FROM BLOCK 1
	JMS I (DVALID	/CHECK IF VALID DIRECTORY
	TAD FAST
	SNA CLA
	JMP I DIRT	/NO DIRECT IN FAST MODE
	JMS I (CRLF
	DCA USED
	DCA UNUSED
	DCA NFILES
	DCA NMTS
	DCA NSEGS
	STL CLA RAR	/4000
LUP$:	DCA DIRPTR
	ISZ NSEGS
	JMS GETDIR
	DCA NENTRY	/- NO. OF ENTRIES IN SEGMENT
	JMS GETDIR
	DCA STBLK	/STARTING BLOCK # OF FIRST FILE IN SEGMENT
	JMS GETDIR
	DCA LINK	/LINK TO NEXT SEGMENT
	JMS GETDIR
	CLA		/IGNORE FLAG WORD TO TENTATIVE FILE
	JMS GETDIR
	DCA AIW		/# OF ADDITIONAL INFO WORDS
	TAD NENTRY
	DCA DKNT
L$:	JMS GETDIR
	SNA CLA
	JMP MT$		/AN EMPTY ENTRY
	TAD AIW
	CIA
	TAD (3
	TAD DIRPTR
	DCA DIRPTR	/POINT TO FILE LENGTH
	JMS GETDIR	/GET NEG OF NUMBER OF BLOCKS IN FILE
	SNA
	JMP 2$	/A TENTATIVE FILE, IGNORE
	CIA
	TAD USED
	DCA USED
	ISZ NFILES
	JMP 2$
MT$:	JMS GETDIR
	CIA
	TAD UNUSED
	DCA UNUSED
	ISZ NMTS
2$:	ISZ DKNT	/ANY MORE ENTRIES IN THIS SEGMENT?
	JMP L$		/YES
	TAD LINK
	SNA CLA
	JMP 3$
	TAD NSEGS
	CMA
	TAD LINK	/ASSUME LINKS ARE IN ORDER
	SZA CLA
	JMP I (BADDIR
	STA		/GO TO NEXT SEGMENT
	TAD DIRPTR
	AND (7400
	TAD (400
	JMP LUP$

3$:	JMS I (PRINFO
LVDIR,	JMS I (CRLF
	JMS I (CRLF
	JMP I DIRT
DKNT,	0
USED,	0		/NO. OF BLOCKS USED
UNUSED,	0		/# OF UNUSED BLOCKS ON DEVICE
NFILES,	0		/# OF FILES
NMTS,	0		/# OF EMPTIES
NSEGS,	0		/# OF DIRECTORY SEGMENTS USED

NENTRY,	0		/- # OF ENTRIES IN SEGMENT
STBLK,	0		/STARTING BLOCK # OF FIRST FILE IN SEGMENT
LINK,	0		/LINK TO NEXT SEGMENT
AIW,	0		/# OF ADDITIOANAL INFORMATION WORDS

GETDIR,	0
	CDF 0
	TAD I DIRPTR
	CDF 10
	ISZ DIRPTR
	JMP I GETDIR

DIRPTR,	0
	PAGE
PRINFO,	0
	TAD EXTEN
	SNA CLA
	JMP 2$		/JUST # OF FREE BLOCKS UNLESS /E
	TAD I (NFILES
	SNA
	JMP 2$
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " FILES IN ">
.IF DF  GERMAN < .PRINT " DATEIEN IN ">
	TAD I (USED
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " BLOCKS">
.IF DF  GERMAN < .PRINT " BLOECKEN">
	STA
	TAD I (NSEGS
	SNA CLA
	JMP 1$
.IF NDF GERMAN < .PRINT " USING ">
.IF DF  GERMAN < .PRINT " AUF ">
	TAD I (NSEGS
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " SEGMENTS">
.IF DF  GERMAN < .PRINT " SEGMENTE VERTEILT">
1$:	JMS I (CRLF
2$:	TAD I (UNUSED
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " FREE BLOCKS">
.IF DF  GERMAN < .PRINT " FREIE BLOECKE">
	TAD EXTEN
	SNA CLA
	JMP I PRINFO
	TAD I (NMTS
	CLL RAR
	SNA CLA
	JMP 3$
	.PRINT " ("
	TAD I (NMTS
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " EMPTIES)">
.IF DF  GERMAN < .PRINT " LOECHER)">
3$:	CLA IAC
	TAD I (AIW
	SZA CLA
	JMS PRAIW
	JMP I PRINFO
PRAIW,	0
	JMS I (CRLF
	TAD I (AIW
	CIA
	STL
	JMS I (DPRINT
.IF NDF GERMAN < .PRINT " EXTRA INFO WDS">
.IF DF  GERMAN < .PRINT " EXTRA INF. WTR">
	JMP I PRAIW
	PAGE
DVALID,	0
	STL CLA RAR	/4000
	DCA I (DIRPTR
	JMS I (GETDIR
	CLL
	TAD (200
	SNL CLA
	JMP BADDIR
	JMS I (GETDIR
	SNA
	JMP BADDIR
	TAD (-400	/REMEMBER COS
	SMA CLA
	JMP BADDIR
	JMS I (GETDIR
	CLA		/LINKS THOROUGHLY CHECKED ELSEWHERE
	JMS I (GETDIR
	SNA
	JMP OKDIR
	TAD (-1400
	CLL
	TAD (-1000
	SZL CLA
	JMP BADDIR
OKDIR,	JMS I (GETDIR
	SPA SNA CLA
	JMP I DVALID
BADDIR,
.IF NDF GERMAN < .PRINT "?BAD DIRECTORY">
.IF DF  GERMAN < .PRINT "?VERZEICHNIS-FEHLER">
	JMP I (LVDIR
SLTM,	0

SLKNT,
ZEROSL,	0
	TAD (-10
	DCA SLTM
	TAD (SLOTAB-1
	DCA X0
	DCA I X0
	ISZ SLTM
	JMP .-2
	JMP I ZEROSL

CNTSLT,	0
	TAD (-10
	DCA SLTM
	DCA SLKNT
	TAD (SLOTAB-1
	DCA X0
L$:	TAD I X0
	SNA CLA
	ISZ SLKNT
	ISZ SLTM
	JMP L$
.IF NDF GERMAN < .PRINT "FREE DEVICE SLOTS: ">
.IF DF  GERMAN < .PRINT "OFFENE KANAELE: ">
	TAD I (FREEDV
	JMS XPRINT
.IF NDF GERMAN < .PRINT ",  FREE BLOCK SLOTS: ">
.IF DF  GERMAN < .PRINT ", FREIE GERAETE-BLOECKE: ">
	TAD SLKNT
	JMS XPRINT
	JMS I (CRLF
	JMP I CNTSLT
XPRINT,	0
	SNA
	JMP 1$
	JMS I (OPRINT
	JMP I XPRINT

1$:
.IF NDF GERMAN < .PRINT "NONE">
.IF DF  GERMAN < .PRINT "KEINE">
	JMP I XPRINT
	PAGE

---