Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50403/dirdta.mac
There are no other files named dirdta.mac in the archive.
	TITLE	DIRDTA -- Routine to write DECtape directory on DSK:FOR01.DAT

	SALL
	ENTRY	DIRDTA
	EXTERN	.JBFF
;
;	THIS SUBROUTINE WAS WRITTEN TO RETRIEVE THE DIRECTORY FROM A
;	MOUNTED DECTAPE AND RETURN IT TO PROGRAM PDO.
;		WRITTEN BY GORDON ROSS, COLGATE UNIVERSITY, 3/6/76
;
;
;	TO CALL DIRDTA:
;
;	CALL DIRDTA(DEVICE,FLAG)		;IN FORTRAN
;
;		--OR--
;
;	MOVEI	16,ARGLST			;SAME AS FORTRAN SUBR ARG LIST
;	PUSHJ	17,DIRDTA			;IN MACRO
;
;	WHERE DEVICE CONTAINS THE NAME OF THE DECTAPE AND FLAG IS AN ERROR
;	VARIABLE.  IF FLAG.NE. 0 ON RETURN, THEN AN ERROR HAS OCCURED IN
;	READING THE DIRECTORY (NO SUCH DEVICE, I/O ERROR, ETC...), AND NO
;	FILE WILL BE WRITTEN (ALTHOUGH AN ERROR MESSAGE WILL BE TYPED).
;	DEVICE MAY BE EITHER A SINGLE OR DOUBLE PRECISION VARIABLE.
;	A <COLON> OR <SPACE> OR <NO-MORE-CHARACTERS> WILL TERMINATE
;	THE DEVICE NAME.
;
;
	OPDEF	PJRST[JRST]
;
;
;	I/O CHANNEL SHOULD ALWAYS BE ZERO:
;
	IOCHN==0
;
	DV.DTA==100			;DEVCHR BIT FOR DECTAPE
;
;	ACS:
;
	T1==1				;TEMP 1
	T2==2				;TEMP 2
	T3==3				;TEMP 3
	T4==4				;TEMP 4
	R1==5				;REG 1; MAY BE USED BY UPPER LEVEL SUBRS ONLY
	M==6				;MESSAGE POINTER
	P==17				;PUSH DOWN STACK AC
;
;
	DEFINE	ERROR(A),<
	XLIST
	JSP	M,ERRMSG		;;NO RETURN FROM ERROR CALL
	JFCL	[ASCIZ\A\]		;;SET ADDRESS OF ERROR MESSAGE (IN ASCII)
	LIST
>
;
;
	DEFINE	ERROR2(A),<
	XLIST
	JSP	M,ERMSG2		;;SIMILER TO ERROR BUT STACK DECREMENTED ONE
	JFCL	[ASCIZ\A\]
	LIST
>
;
;
	DEFINE	MONGEN(A)<
	IRP	A,<
	BYTE	(21) "A" (7) "-"	;;MACRO TO GENERATE MONTH NAMES
>>
;	DATA:
;
DTABLK:	117				;OPEN DTA IN NON-STANDARD DUMP MODE
DEVICE:	BLOCK	2
BLKCNT:	BLOCK	^D23			;BLOCK COUNT OF EACH FILE 
BUFFER:					;BUFFER TO READ IN DECTAPE DIRECTORY
BLKALC:	BLOCK	^D83			;BLOCK COUNTS KEPT HERE 
FILES:	BLOCK	^D22			;FILE NAMES HERE
EXTS:	BLOCK	^D22			;EXTS AND DATES HERE (HIGH ORDER BITS IN BLKALC)
TAPEID:	BLOCK	1			;DECTAPE TAPE ID
DSKFIL:	Z				;OPEN BLOCK FOR DSK OUTPUT FILE
	SIXBIT/DSK/			;DEFAULT
	XWD	OBUF,0			;BUFFER MODE
OBUF:	BLOCK	3			;OUTPUT BUFFER RING
FOR01:	SIXBIT/FOR01/			;NAME OF OUTPUT FILE
	SIXBIT/DAT/			;AND EXTENSION
	BLOCK	2
MONTHS:	MONGEN	<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>
;
DIRDTA:	CAIA				;HERE ON PUSHJ P,DIRDTA
	PUSH	P,CEXIT.##		;GO TO C(CEXIT.) ON RETURN FROM JSA
	MOVEI	T1,@(16)		;GET ADDRESS OF ASCII/DEVICE/
	HRLI	T1,440700		;FORM ILDB POINTER
	MOVEI	T2,5			;ASSUME FIVE CHARACTER MAX
	LDB	T3,[POINT 4,(16),12]	;GET THE TYPE OF THE FIRST ARGUMENT
	CAIN	T3,6			;IF THE DEVICE IS DOUBLE PRECISION
	MOVEI	T2,6			;ASSUME UP TO SIX CHARACTERS PRESENT
	MOVE	T3,[POINT 6,DEVICE]	;POINTER TO STORE DEVICE IN SIXBIT
	SETZM	DEVICE			;ASSUME NO DEVICE
GETDEV:	ILDB	T4,T1			;GET AN ASCII CHARACTER
	JUMPE	T4,GOTDEV		;DONE IF ASCII 0
	CAIN	T4,":"			;OR IF IT IS
	JRST	GOTDEV			;A COLON TYPED BY THE USER
	ADDI	T4,40			;CONVERT TO SIXBIT
	IDPB	T4,T3			;AND STORE IN DEVICE NAME
	SOJG	T2,GETDEV		;GO GET MORE IF NEEDED
GOTDEV:	MOVSI	T1,'DTA'		;IF THERE IS NO DEVICE
	SKIPN	DEVICE			;NAME PRESENT
	MOVEM	T1,DEVICE		;ASSUME DTA
	MOVE	T1,DEVICE		;GET THE DEVICE NAME
	DEVCHR	T1,			;FIND OUT WHAT KIND OF DEVICE IT IS
	TLNN	T1,DV.DTA		;IS IT A DECTAPE?
	ERROR	<?Device not a DECtape>	;NO! BOMB OUT THE USER
	OPEN	IOCHN,DTABLK		;GET THE DECTAPE
	ERROR	<?DECtape not available to read directory>	;!!
	USETI	IOCHN,144		;GO TO THE DIRECTORY
	IN	[IOWD 200,BUFFER
		 Z]			;AND READ IT IN
	CAIA				;GOOD RETURN
	ERROR	<?Input error reading DECtape directory>	;!!
	RELEAS	IOCHN,			;DONE WITH THE DECTAPE
	MOVEI	T1,^D22			;NOW TO ZERO ALL BLOCK COUNTS...
ZERCNT:	SETZM	BLKCNT(T1)		;CLEAR THIS ONE
	SOJGE	T1,ZERCNT		;AND GO FOR MORE
	MOVEI	T1,^D577		;NOW TO COUNT ALL FREE AND ALLOCATED
	MOVE	T2,[POINT 5,BUFFER]	;BLOCKS.  BLKCNT+0 WILL CONTAIN
GETCNT:	ILDB	T3,T2			;THE NUMBER OF FREE BLOCKS, BLKCNT+N
	CAIG	T3,^D22			;(WHERE N IS THE FILE NUMBER) WILL
	AOS	BLKCNT(T3)		;CONTAIN THE SIZE OF FILE N
	SOJG	T1,GETCNT
	OPEN	IOCHN,DSKFIL		;NOW OPEN UP A DSK CHANNEL TO
	ERROR	<?Device DSK not available>	;!!!
	SETZM	FOR01+2			;WRITE ON THE OUTPUT FILE
	SETZM	FOR01+3			;CLEAR LAST TWO LOCS SO ENTER WILL FILL IN DEFAULTS
	ENTER	IOCHN,FOR01		;MONITOR: GIVE US THE FILE!
	ERROR	<?Cannot write the file DSK:FOR01.DAT>	;WELL...., WE TRIED!
	PUSH	P,.JBFF			;SAVE TOP-OF-CORE FOR LATER
	OUT	IOCHN,			;SET UP OUTPUT BUFFERS
	CAIA				;NORMAL RETURN
	ERROR2	<?Output error while writing DSK:FOR01.DAT>	;THE DSK IS HURTING
	MOVEI	M,[ASCIZ/



Tape id: /]				;DUMP OUT THE ID
	PUSHJ	P,PUTSTR
	MOVEI	M,TAPEID
	PUSHJ	P,PUTSIX
	MOVEI	M,[ASCIZ/
Free: /]				;THE NUMBER OF BLOCKS FREE
	PUSHJ	P,PUTSTR
	MOVE	T1,BLKCNT
	PUSHJ	P,PUTDC3
	MOVEI	M,[ASCIZ/ Blks, /]
	PUSHJ	P,PUTSTR
	MOVEI	T2,^D21			;AND THE NUMBER OF FILES FREE
	SETZ	T1,			;WE MUST CALC THIS BY THE NUMBER
FILCNT:	SKIPN	FILES(T2)		;IS THIS ENTRY A FILE
	ADDI	T1,1			;NO, INCREMENT THE COUNT
	SOJGE	T2,FILCNT		;GO FOR MORE
	PUSHJ	P,PUTDC2		;PRINT IT
	MOVEI	M,[ASCIZ/ Files
/]
	PUSHJ	P,PUTSTR
	SETZ	R1,			;REG CONTAINING COUNTER FOR PRINTING FILES OUT
TYPFIL:	SKIPN	FILES(R1)		;IS THIS A TRUE FILE?
	JRST	NXTFIL			;NO, INCREMENT COUNT AND CONTINUE
	MOVEI	M,FILES(R1)		;DUMP OUT THE FILE NAME
	PUSHJ	P,PUTSX6
	MOVEI	T1,"."			;AND THEN A PERIOD AND THE EXTENSION
	PUSHJ	P,PUTCHR
	MOVEI	M,EXTS(R1)
	PUSHJ	P,PUTSX3
	MOVEI	T1," "			;DUMP OUT ONE SPACE FOR SEPARATION
	PUSHJ	P,PUTCHR
	MOVE	T1,BLKCNT+1(R1)		;DUMP OUT THE SIZE OF THE FILE
	PUSHJ	P,PUTDC3
	MOVEI	M,[ASCIZ/  /]		;AND THE TWO SPACES
	PUSHJ	P,PUTSTR
	LDB	T1,[POINT 12,EXTS(R1),35]	;GET THE LOW ORDER BITS OF DATE
	MOVEI	T2,1			;SET UP MASK INTO HIGH ORDER BITS
	TDNE	T2,BUFFER(R1)		;IS THIS HIGH ORDER BIT ON?
	TRO	T1,10000		;YES, SET IN DATE
	TDNE	T2,BUFFER+^D22(R1)	;IS THE NEXT HIGHEST ORDER BIT ON?
	TRO	T1,20000		;YES, MAKE DATE EVEN LARGER!
	TDNE	T2,BUFFER+^D44(R1)	;IS THE HIGHEST ORDER BIT ON?
	TRO	T1,40000		;YES, MAKE A BIG-BIG DATE
	PUSHJ	P,PUTDAT		;PRINT THE DATE
	MOVEI	M,[BYTE (7) 15,12]	;GIVE A <CR>
	PUSHJ	P,PUTSTR
NXTFIL:	ADDI	R1,1			;INCREMENT TO NEXT FILE
	CAIGE	R1,^D22			;ARE WE DONE?
	JRST	TYPFIL			;NO, GO TYPE SOME MORE FILES OUT
	RELEAS	IOCHN,			;WRITE THAT FILE ON DSK!
	POP	P,.JBFF			;RESTORE OLD CORE 
	SETZM	@1(16)			;NO ERRORS, TELL CALLER THAT
	POPJ	P,			;AND RETURN
PUTSTR:	HRLI	M,440700		;ROUTINE TO DUMP AN ASCII STRING WHOSE
PUTAS2:	ILDB	T1,M			;ADR IS IN AC M
	JUMPE	T1,CPOPJ
	PUSHJ	P,PUTCHR
	JRST	PUTAS2
PUTSIX:	HRLI	M,440600		;ROUTINE TO DUMP A SIXBIT WORD WHOSE
	MOVEI	T2,6			;ADR IS IN AC M
PUTSXG:	ILDB	T1,M
	ADDI	T1,40
	PUSHJ	P,PUTCHR
	SOJG	T2,PUTSXG
	POPJ	P,
PUTDC3:	CAIG	T1,^D99			;ROUTINE TO PRINT DECIMAL (I3) FORMAT
	PUSHJ	P,PUTBLN
PUTDC2:	CAIG	T1,^D9			;ROUTINE TO PRINT DECIMAL (I2) FORMAT
	PUSHJ	P,PUTBLN
;	PJRST	PUTDEC
PUTDEC:	IDIVI	T1,^D10
	HRLM	T2,(P)
	JUMPE	T1,.+2
	PUSHJ	P,PUTDEC
	HLR	T1,(P)
	ADDI	T1,60
	PJRST	PUTCHR
PUTSX6:	SKIPA	T2,[6]			;ROUTINE TO PRINT SIXBIT WORD
PUTSX3:	MOVEI	T2,3			;ROUTINE TO PRINT HALF WORD IN SIXBIT
PUTSXB:	HRLI	M,440600
PUTSB2:	ILDB	T1,M
	ADDI	T1,40
	PUSHJ	P,PUTCHR
	SOJG	T2,PUTSB2
	POPJ	P,
PUTBLN:	HRLM	T1,(P)			;ROUTINE TO DUMP ON BLANK -- ALL ACS SAVED
	MOVEI	T1,40
	PUSHJ	P,PUTCHR
	HLRZ	T1,(P)
	POPJ	P,
PUTCHR:	SOSGE	OBUF+2			;ROUTINE TO DUMP ONE CHAR
	JRST	OUTIT
	IDPB	T1,OBUF+1
CPOPJ:	POPJ	P,
OUTIT:	OUT	IOCHN,
	JRST	PUTCHR
	RELEAS	IOCHN,
	POP	P,T1			;GET RID OF RETURN ADR
	POP	P,.JBFF			;AND THE OLD .JBFF
	ERROR	<?Output error while writing DSK:FOR01.DAT>
PUTDAT:	IDIVI	T1,^D31			;GET THE DAY OF THE MONTH
	HRLM	T1,(P)
	MOVEI	T1,1(T2)		;GET THE CORRECTED DAY OF THE MONTH
	PUSHJ	P,PUTDC2		;PRINT THE DAY OF THE MONTH
	MOVEI	T1,"-"			;PRINT A DASH
	PUSHJ	P,PUTCHR		;TO MAKE IT LOOK GOOD
	HLRZ	T1,(P)			;RETRIEVE THE REST OF THE DATE
	IDIVI	T1,^D12			;GET THE NUMBER OF MONTHS
	MOVEI	M,MONTHS(T2)		;AND THEN GET THE ADR OF THE ASCII/MONTH/
	HRLM	T1,(P)			;SAVE THE REMAINDER OF THE DATE
	PUSHJ	P,PUTSTR		;DUMP OUT THE MONTH (DASH PRINTED ALSO)
	HLRZ	T1,(P)			;RETRIEVE THE REST OF THE DATE(THE YEAR)
	MOVEI	T1,^D64(T1)		;ADD THE BASE OF 1964 TO IT
	PJRST	PUTDC2			;AND PRINT THE YEAR
ERMSG2:	SUB	P,[XWD 1,1]		;HERE ON ERROR2 MACRO
ERRMSG:	OUTSTR	[BYTE (7) 15,12]	;HERE ON ERROR MACRO
	OUTSTR	@(M)
	OUTSTR	[BYTE (7) 15,12]
	SETOM	@1(16)
	POPJ	P,
	END
`*U*811