software: Added more and more

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape6 / DIRECT.PA

/DIRECT V3D FOR OS/78 V1A AND OS/8 V3D
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/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.
/
/
/
/
/
/
/
/
/
/
\f/JANUARY 17, 1974			H.J.
/
/5-AUGUST-1975	MAINT. RELEASE CHANGES		S.R.
/1.	UPDATED COPYRIGHT DATE
/2.	CHANGED VERSION NUMBER TO V4
/3.	INCORPORATED PATCH (SEQ #2) OF FEB 1975 DSN
/	(FIXES BUG RE: DEFAULTING TO TTY: AND DSK:)
/
/ 5-APR-77	MH	OS/78 FIXES	(V5A)
/ 18-MAY-77	MH	SPR 2286	(V6A)
/
/DIRECTORY LISTING PROGRAM
/
/ START ADDRESS 14600;  JSW 6403
/

	PTR=20
	CNT=21
	INFPTR=22
	OUHAND=23
	INHAND=24
	EPTR=26
	INSCNT=27
	TEMP=30
	OKFLAG=31
	IFCNT=32
	OSWTCH=33
	INFWDS=34
	BDPTR=35
	GPTR1=36


	XR=10
	XR1=11
	XR2=12


	AC2=CLA CLL CML RTL
	AC4000=CLA CLL CML RAR
	ACM2=CLA CLL CMA RAL
	ACM3=CLA CLL CMA RTL


	ALTOPT=7642
	OPT1=7643
	OPT2=7644
	EQLS=7646	/EQUALS OPTION
	DATE=7666
	BIPCCL=7777	/CONTAINS DATE EXTENSION IN BITS 3 AND 4 (MH)
	BUF=5200	/THE FILE OUTPUT BUFFER
			/5 BLOCKS LONG, TO 7577

\f
	FIELD 1
	*2000
	SKP CLA		/NORMAL ENTRY
	JMP MSTRT	/CHAIN ENTRY
CDCALL,	JMS I (200	/SEE WHAT THE PERSON WANTS
	5
STAR,	5200		/IN SPECIAL MODE

MSTRT,	TAD I (OPT2	/GET OPTION /W
	RTR
	SNL CLA		/SKIP FOR VESION NUMBER
	JMP EQUALT
	JMS I (ERROR	/PRINT VERSION NUMBER
	VERNO+40
	TAD (215
	JMS I (TYPE

/SET UP FOR MULTIPLE ENTRIES ON A LINE

EQUALT,	TAD I (EQLS	/EQUALS OPTION WORD
	SPA		/MUST BE POSITIVE
	CLA CLL CML RTR	/SET AC LARGE POSITIVE
	TAD (-10	/CHECK LEGALITY OF OPTION
	SMA SZA CLA	/SKIP IF GOOD
	JMP BADEQ

/SUBSTITUTE .DI IF NULL EXTENSION

	TAD I (7604	/GET EXTENSION
	SNA		/SKIP IF GIVEN
	TAD (0411	/.DI
	DCA I (7604	/PUT EXTENSION BACK
 
/ GET THE DATE INCREMENT BITS
 
	CDF	0	/GET GET WORD FORM FIELD 0(MH)
	TAD I	(BIPCCL	/THE BITS WITH DATE EXT. ARE 3 AND 4 (MH)
	CDF	10	/BACK TO FIELD 1 (MH)
	RTR		/SHIFT THOSE BITS SO THEY CREATE A 0,10,20, OR 30(MH)
	RTR		/AFTER MASKING (MH)
	AND	(0030	/MASK (MH)
	DCA	DATINC	/SAVE THE DATE EXTENSION (MH)

/ CHECK FOR ? IN OUTPUT SPECIFICATION
	TAD (-10
	DCA CNT		/CNT HAVING -10 PUTS US AT FIRST CHAR
S1C,	TAD (7605
	JMS I (GTSXBT	/GET A CHAR
	TAD (-"?!7700	/CHECK FOR ?
	SNA
	JMP QINO
	TAD ("?-"*
	SNA CLA
	JMP AINO
	ISZ CNT
	JMP S1C


/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
	TAD (7605
S4L,	DCA PTR
	TAD (-10
	DCA CNT
ACK,	TAD PTR
	JMS I (GTSXBT
	TAD (-"*!7700
	SZA CLA
	JMP CNTUP
	AC2
	TAD CNT
	SZA
	TAD (6
	SNA CLA
	ISZ CNT
	TAD PTR
	JMS I (GTSXBT
	SZA CLA
	JMP AINO
CNTUP,	ISZ CNT
	JMP ACK
	TAD I PTR
	SNA CLA
	JMP I (NULLCK
	TAD (5
	TAD PTR
	JMP S4L

/THIS IS THE END OF OPERATION CODE
/IT CLOSES THE FILE AND HANDLES RETURNS

ENDCHK,	ISZ I (ECHO
	TAD (232
OLOOP,	JMS I (OUTCHR
	TAD I (OUWDCT	/GET -WORDS LEFT IN BUFFER
	AND (177	/CHECK AGAINST NEW BUFFER #
	SNA		/SPR 2286, CHECK CAREFULLY (MH)
	TAD	RPOS	/TO SEE IF ANY TRAILING (MH)
	CIA		/OR DANGLING CHARS (MH)
	TAD	(RPOS-1	/ARE LEFT OVER (MH)
	SZA!CLA		/(MH)
	JMP OLOOP	/KEEP GOING TO DUMP ONE
	TAD I (OUWDCT
	TAD (1200	/DONT DUMP IF AT END
	SZA CLA
	JMS DUMP	/DUMP BUFFER
	TAD I (7600
	JMS I (200
	4
	7601
CLEN,	0
	JMP CLOERR
	JMP	ABORT	/CODE MOVED TO ANOTHER PAGE (MH)

	PAGE
\f
NULLCK,	TAD (7201
	DCA AO2
	TAD (7201
	DCA AO1
	TAD I (7600
	SNA
	JMP TTYHND
	JMS I (200
	1
AO1,	7201
	HLT
	TAD AO1
	JMP CMN
TTYHND,	TAD (2424
	DCA TTY1
	TAD (3100
	DCA TTY2
	JMS I (200
	1
TTY1,	0
TTY2,	0
AO2,	7201
	JMP I (IDBLVT
	TAD TTY2
	DCA I (7600
	TAD AO2
CMN,	DCA OUHAND
	TAD (7601
	DCA BLCK
	TAD I (7600
	JMS I (200
	3
BLCK,	7601
LENGTH,	0
	JMP I (NOROOM
	TAD BLCK
	DCA I (BLCKN
	TAD (BUF
	DCA I (OCPTR
	TAD (RPOS-1	/SPR 2286 (MH)
	DCA I (RPOS
	TAD (-1200	/NUMBER OF WORDS IN BUFFER
	DCA I (OUWDCT
	DCA I (CLEN
	TAD I (7605
	SNA
	JMP FINDSK	/V3C	IF NO DEVICE SPECIFIED, LOOKUP 'DSK'
SETDEV,	DCA I (7605
	TAD (7605
DOMOIN,	DCA INFPTR
	TAD (6601
	DCA AI1
	TAD I INFPTR
	SNA
	JMP I (ENDCHK
	JMS I (200
	1
AI1,	6601
	HLT
	TAD AI1
	DCA INHAND
	TAD (OUTCHR
	DCA OSWTCH
	JMS I (CRLF
	TAD I (DATE
	DCA I	(DATNOW	/SAVE CURRENT DATE (MH)
	TAD I	(DATE	/GET DATE BACK INTO AC (MH)
	JMS I (PDATE
	JMS I (CRLF
	JMS I (CRLF
	DCA I (ECOUNT
	CMA
	TAD I (EQLS
	SMA		/SET UP NEGATIVE COUNT
	CMA
	DCA I (ALNCNT	/SAVE FOR LATER
	TAD I (ALNCNT	/SAVE FOR LATER
	DCA I (LNCNT	/SAVE FOR LATER
	JMP I (PG1

AINO,	JMS I (ERROR
	ILLA+40
	JMP EOLIN
QINO,	JMS I (ERROR
	ILLQ+40
EOLIN,	TAD (215	/COME HERE TO ABORT DIRECTORY
	JMS I (TYPE	/AND PRINT CRLF
	JMP I (ABORT	/ABORT OPERATION AND  GOTO ENDUP

FINDSK,	DCA XX		/V3C
	JMS I (200	/CALL USR
	12		/TO DO AN INQUIRE
	5723		/TO LOCATE 'DSK'
XX,	0
	0
	JMP I (IDBLVT	/NO 'DSK' IMPOSSIBLE (SO SAY NO 'TTY')
	TAD XX		/RETURN DEVICE NUMBER OF DSK
	JMP SETDEV
	PAGE
\f	DIRCTY=0	/LOCATION OF INPUT DIRECTORY

PG1,	TAD I INFPTR
	TAD (7757
	DCA TEMP
	TAD I TEMP
	SMA CLA
	JMP NFIN
	CIF 0
	JMS I INHAND
	1400
	DIRCTY
	1
	JMP INDERR
	CDF 0		/CODE TO CHECK FOR
	TAD I (DIRCTY	/LEGALITY OF DIRECTORY
	CMA CLL
	TAD I (DIRCTY+2
	CDF 10
	SNL
	TAD (7700
	SZL CLA
	JMP BIDIR	/DIRECTORY IS BAD

/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
	TAD INFPTR
	SKP
GETCNT,	TAD PTR
	IAC
	DCA PTR
	TAD I PTR
	SZA CLA
	JMP NOSUB
	TAD (5200
	DCA I PTR
	TAD (3
	TAD PTR
	DCA TEMP
	TAD (5200
	DCA I TEMP
NOSUB,	TAD PTR
	TAD (4
	DCA PTR
	ISZ CNT
	TAD I (OPT2
	AND (10
	SZA CLA
	JMP NOPTIM
	TAD I PTR
	CIA
	TAD I INFPTR
	SNA CLA
	JMP GETCNT
NOPTIM,	TAD CNT
	CIA
	DCA INSCNT
	TAD PTR
	DCA I (MOIN
	DCA BDPTR
	JMP I (NBLOCK

BIDIR,	JMS I (ERROR
	BADDIR+40
	JMP I (EOLIN
NFIN,	JMS I (ERROR
	NFLEIN+40
	JMP I (EOLIN
INDERR,	JMS I (ERROR
	BADIRD+40
	JMP I (EOLIN

/THIS IS THE ERROR MESSAGE PRINTER

ERROR,	0
	ISZ I (ECHO
	CLA CLL
	TAD (TYPE
	DCA OSWTCH
	TAD (-100
	DCA CNT
PLOOP,	TAD I ERROR
	JMS I (GTSXBT
	DCA DFLAG
	TAD DFLAG
	JMS I (CONVTP
	ISZ CNT
	TAD DFLAG
	SZA CLA
	JMP PLOOP
	ISZ ERROR
	JMP I ERROR

DFLAG,	0
ABORT,	TAD I	(ALTOPT	/MOVED (MH)
	SMA CLA
	JMP I	(CDCALL
	CIF CDF 0
	JMP I	(7605
BADEQ,	JMS I	(ERROR
	BIGEQ+40
	JMP I	(EOLIN

	PAGE
\f
/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE

/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
/IS FOUND USING THE INPUT GROUPING
/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC

NBLOCK,	TAD BDPTR	/POINTER TO START OF DIR BLOCK
	DCA XR
	CDF 0
	TAD I XR	/GET BLOCK NUMBER FIRST FILE
	DCA BLOCK
	TAD I XR	/NEXT SEGMENT NUMBER
	DCA LFLAG	/IF IT 0 WE AT END
	ISZ XR		/SKIP TENTATIVE FILE WORD
	TAD I XR	/GET -NUMBER OF INFO WORDS
	CIA		/MAKE POSITVE
	DCA INFWDS
	TAD XR		/POINT TO FIRST
	IAC		/ENTRY
	DCA EPTR

BLOOP,	TAD I EPTR	/GET FILENAME WORD
	CDF 10
	SNA CLA		/SKIP IF FILE HERE
	JMP EMPTY	/NO... ITS REALLY AN EMPTY
	TAD INSCNT	/SET NUMBER OF INPUT TO LOOK
	DCA NCNT	/AT ALL AT ONCE
	DCA MATFLG	/CLEAR MATCH FLAG
	TAD INFPTR	/ADDRESS OF FIRST INPUT
	SKP
MN1,	TAD GPTR2	/ADDRESS OF CURRENT INPUT
	TAD (5		/GTSXBT SUBR REQUIRES US TO
	DCA GPTR2	/POINT TO END OF FIELD
	TAD EPTR	/POINT DIRECTORY POINTER TO
	TAD (4		/END OF ENTRY FOR SAME REASON
	DCA GPTR1
	TAD GPTR1	/SET EPNEXT TO POINT TO
	TAD INFWDS	/MINUS NUMBER OF BLOCKS IN
	DCA EPNEXT	/FILE WORD
	TAD (-10	/NUMBER OF CHARS TO LOOK AT
WILDNM,	DCA CNT
\f
MLP,	TAD GPTR2	/OK - GET A CHARACTER FROM
	JMS I (GTSXBT	/STRING
	TAD (-"*!7700	/IS IT AN *
	SNA		/SKIP IF NOT *
	JMP WILDA	/YEP... ITS A WILD CARD
	TAD ("*-"?	/IS IT A ?
	SNA		/SKIP IF NOT
	JMP WILD	/YES... FORCE MATCH ON THIS CHAR
	TAD ("?&77	/RESTORE VALUE
	CIA		/NEGATE
	DCA CHAR	/AND SAVE
	TAD GPTR1	/NOW GET CHAR FROM DIRECTORY
	CDF 0
	JMS I (GTSXBT
	CDF 10
	TAD CHAR	/DO CHARS MATCH
	SZA CLA		/SKIP IF THEY DO
	JMP NM1		/NO MATCH ON THIS INPUT
WILD,	ISZ CNT		/BUMP COUNT OF CHARS & POINTER
	JMP MLP		/COMPARE ALL 8
MEXT,	ISZ MATFLG	/A MATCH!!!!!!!
NM1,	CLA		/WILD CARD COMES HERE WITH ICHY AC
	ISZ NCNT	/HAVE WE CHECKED GROUP OF INPUTS
	JMP MN1		/NO CHECK WHOLE GROUP
	TAD MATFLG	/HAVE THERE BEEN ANY MATCHES
	SZA CLA		/SKIP IF NOT
	TAD (4		/WILL INVERT /V SWITCH
	TAD I (OPT2	/ADD SWITCH
	AND (4		/ISOLATE IT
	CDF 0
/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
/A MATCH WAS FOUND AND /V WAS SPECIFIED

/THIS ALLOWS /V TO MEAN EVERYTHING BUT...

	SZA CLA
	TAD I EPNEXT	/GET -NUMBER OF BLOCKS
	CDF 10
	SZA		/SKIPS IF TENTATIVE OR NOT CANDIDATE
	JMP I (GOT1	/PROCESS FILE
NENT,	TAD EPNEXT	/POINT EPTR TO BLOCK
	DCA EPTR	/COUNT OF FILE
	JMP NEMPTY
EMPTY,	ISZ EPTR	/ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
	JMS I (HEMPTY	/HANDLE EMPTY SLOTS
NEMPTY,	CDF 0
	TAD I EPTR	/GET BLOCK COUNT
	CIA		/MAKE POSITIVE
	TAD BLOCK
	DCA BLOCK	/KEEP SUM
	ISZ EPTR	/POINT TO NEXT ENTRY
	ISZ I BDPTR	/POINTS TO -NUMBER OF ENTRIES
	JMP BLOOP	/NOT DONE WITH SEGMENT
	CDF 10
	TAD (400	/BUMP TO NEXT SEGMENT
	TAD BDPTR
	DCA BDPTR
	TAD LFLAG	/DID WE PROCESS LAST SEGMENT
	SZA CLA		/SKIP IF WE DID
	JMP NBLOCK	/PROCESS NEW SEGNENT
	JMP I (SAYNON
\f
/HANDLE WILD CARDS

WILDA,	TAD CNT		/GET CURRENT CHAR POSITION
	TAD (6		/ADD SIZE OF FILENAME
	SPA		/SKIP IF IN EXTENSION FIELD
	JMP WILDNM	/THIS BUMPS TO EXTENSION
	JMP MEXT	/THIS MEANS IT HAS TO BE A MATCH


CHAR,	0
EPNEXT,	0
GPTR2,	0
LFLAG,	0
NCNT,	0
BLOCK,	0
MATFLG,	0


	PAGE
\fGOT1,	DCA IFCNT	/-# OF BLOCKS IN AC
	JMS I (DATCHK	/VERIFY /C AND /O SWITCHES
	TAD (OUTCHR
	DCA OSWTCH
	TAD I (OPT2
	SPA CLA
	JMP I (NENT
	JMS I (ADDINF	/SEE IF ADDITIONAL INFO WORDS
	TAD I (OPT2
	AND (100	/IS /R USED
	SNA CLA
	JMP NOR
	TAD INFPTR	/FILL IN *.* FOR FILENAME
	IAC
	DCA TEMP
	TAD (5200	/*
	DCA I TEMP
	ISZ TEMP
	ISZ TEMP
	ISZ TEMP	/POINT TO EXTENSION
	TAD (5200	/.*
	DCA I TEMP	/SUBSTITUTE IT
NOR,	TAD GPTR1
	CDF
	JMS I (PNMSUB
	TAD I (OPT1
	RTL
	SNL CLA
	JMP SKPBLK
	JMS I (CONVTP
	TAD I (BLOCK
	JMS BSPACE	/(MH) PATCH FOR /B/E
SKPBLK,	TAD I (OPT1
	AND (100
	SZA CLA
	JMP NODATE
	TAD IFCNT
	CIA
	JMS I (PRNUM
	TAD INFWDS
	SNA CLA
	JMP NODATE
	CDF
	TAD I GPTR1
	CDF 10
	JMS I (PDATE
NODATE,	ISZ LNCNT	/IS LINE FILLED?
	JMP MOROLN	/NO
	JMS CRLF
	TAD ALNCNT	/RESET COUNT
	DCA LNCNT
	JMP I (NENT
MOROLN,	TAD (5		/OUTPUT 5 BLANKS
	JMS I (BLANK
	JMP I (NENT

/BLANKS ROUTINE
BLANK,	0
	CIA
	DCA BLTMP
	JMS I (CONVTP
	ISZ BLTMP
	JMP .-2
	JMP I BLANK
BLTMP,	0


ALNCNT,	0
LNCNT,	0

OUTCHR,	0
	JMP I RPOS
RPOS1,	DCA I OCPTR
	JMS RPOS
RPOS2,	DCA HOLD
	JMS RPOS
RPOS3,	RTL
	RTL
	DCA HOLD2
	TAD HOLD2
	AND (7400
	TAD I OCPTR
	DCA I OCPTR
	ISZ OCPTR
	TAD HOLD2
	RTL
	RTL
	AND (7400
	TAD HOLD
	DCA I OCPTR
	ISZ OCPTR
	ISZ OUWDCT
	SKP
	JMS DUMP
	JMS RPOS
	JMP RPOS1
RPOS,	RPOS1
	JMP I OUTCHR

OUWDCT,	0
OCPTR,	0
HOLD,	0
HOLD2,	0
BSPACE,	0	/(MH) PATCH FOR /B/E
	JMS I	(OPRNT
	CLA!IAC
	JMS I	(BLANK
	JMP I	BSPACE

	PAGE
\f
GTSXBT,	HLT
	CLL RAL
	TAD CNT
	CML RAR
	DCA TEMP
	TAD I TEMP
	SNL
	JMS ROTR6
	AND (77
	JMP I GTSXBT


ROTR6,	0
	RTR
	RTR
	RTR
	JMP I ROTR6

CONVTP,	HLT
	SZA
	TAD (240
	AND (77
	TAD (240
	JMS I OSWTCH
	JMP I CONVTP

TYPE,	HLT
	DCA HOLD1
	TAD (217
	JMS I (CTYPE
	SKP
	DCA ECHO
	TAD ECHO
	SNA CLA
	JMP I TYPE
	JMS I (CINTER
	SKP
	JMP I (ABORT
	TAD HOLD1
	JMS TTY
	JMP I TYPE

HOLD1,	0

TTY,	0
	TLS
	TSF
	JMP .-1
	TAD (-215
	SZA CLA
	JMP I TTY
	TAD (12
	JMP TTY+1

ECHO,	1

OPRNT,	0
	DCA GTSXBT
	TAD (-4
	DCA CNT
OPLP,	TAD GTSXBT
	RTL CLL
	RAL
	DCA GTSXBT
	TAD GTSXBT
	RAL
	AND (7
	TAD (260
	JMS I (CONVTP
	ISZ CNT
	JMP OPLP
	JMP I OPRNT


/ROUTINE TO MAKE SURE USER SPECIFIED
//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE

DATCHK,	0
	TAD I (OPT1	/CHECK /C
	JMS MDATE
	NOP		/RETURN HERE WITH AC=0 IF NO /C
	SZA CLA		/RETURN HERE WITH AC=0 IF DATES MATCH
	JMP I (NENT	/DATES DONT MATCH AND /C GIVEN
	TAD I (OPT2	/CHECK /V
	JMS MDATE
	CMA CLA		/SET AC=-1 IF NO /V
	SNA CLA		/RETURN HERE AC=0 IF DATES SAME
	JMP I (NENT	/DATES SAME WITH /V-IGNORE FILE
	JMP I DATCHK	/CONTINUE

MDATE,	0		//O AND /V ARE AC2
	RTL		/IS IT OPTION ON?
	SMA CLA		/SKIP IF IT IS
	JMP I MDATE	/NO- RETURN WITH 0 AC
	ISZ MDATE	/SKIP RETURN
	CDF 0
	TAD I GPTR1	/GET DATE WORD
	CIA
	CDF 10
	TAD I (DATE	/COMPARE WITH MONITORS, 0 IF =
	JMP I MDATE

	PAGE
\f
PRNUM,	0
	DCA NUM
	TAD (PWRTEN
	DCA PTR
PRNTLP,	ISZ MPNTCNT
	SKP
	AC4000
	DCA PNTFLG
	DCA DIG
DIVLPY,	TAD I PTR
	SNA
	JMP I PRNUM
	CLL
	TAD NUM
	SNL
	JMP PRTDIG
	DCA NUM
	ISZ DIG
	JMP DIVLPY
PRTDIG,	CLA
	TAD DIG
	TAD PNTFLG
	SNA
STPBLK,	JMP PRBLNK
	TAD (260
	JMS I (CONVTP
	CLA CLL CML RAR
NXTPWR,	ISZ PTR
	JMP PRNTLP
PRBLNK,	JMS I (CONVTP
	JMP NXTPWR

NUM,	0
PNTFLG,	0
DIG,	0
MPNTCNT,0

PWRTEN,	-1750;-144;-12;-1;0

PDATE,	0
	SNA
	JMP FDATE
	DCA DATEY
	TAD	DATNOW	/WAS A DATE ENTERED AT BOOT TIME?(MH)
	SNA		/SKIP IF SO(MH)
	JMP	FDATE	/NO -- DON'T PRINT DATE IF NOT ENTERED(MH)
	AND	(7	/YES -- SAVE YR NEGATED(MH)
	CMA!IAC		/(MH)
	DCA	DATTMP	/SAVE THIS RESULT TEMP(MH)
	ISZ I (STPBLK
	JMS I (CONVTP
	ACM3
	DCA I (MPNTCNT
	TAD DATEY
	RTR
	RAR
	AND (37
	JMS I (PRNUM
	TAD ("-
	JMS I (CONVTP
	TAD DATEY
	CLL RTL
	RTL
	RAL
	AND (17
	DCA PRNUM
	TAD PRNUM
	TAD PRNUM
	TAD PRNUM
	TAD (DATTAB-4
	DCA XR
	ACM3
	DCA CNT
	TAD I XR
	JMS I OSWTCH
	ISZ CNT
	JMP .-3
	TAD ("-
	JMS I OSWTCH
	TAD DATEY
	AND (7
	TAD	DATTMP	/ADD -ENTERED YR(MH)
	CLL		/CLEAR LINK FOR FLAG USE(MH)
	SZA!SMA!CLA	/SKIP AND CLEAR IF ENTERED YR BIGGER,SAME(MH)
	CML		/SET LINK IF DIR YR BIGGER THAN ENETERED YR (MH)
	TAD	DATEY	/GET DATE BACK(MH)
	AND	(7	/GET THE YR(MH)
	SZL		/SKIP IF ENTERED YR WAS BIG OR SAME(MH)
	TAD	(-10	/SUBTRACT 10 OCTAL IF DIR YR WAS BIGGER(MH)
	TAD	DATINC	/ADD DATE INCREMENT(MH)
	TAD (106
	JMS I (PRNUM
	CLA CMA
	TAD I (STPBLK
	DCA I (STPBLK
	JMP I PDATE
FDATE,	TAD I (LNCNT	/SEE IF AT END OF LINE?
	IAC		/AC=0 NOW IF YES
	SNA CLA		/OUT PUT SPACES TO FILL DATE SLOT
	JMP I PDATE	/NO NEED FOR SPACES IF AT END OF LINE
	TAD (12		/10 SPACES IS WHATS NEEDED
	JMS I (BLANK
	JMP I PDATE	/LEAVE

DATEY,	0
DATNOW,	0	/CURRENT DATE IF ONE WAS ENTERED(MH)
DATINC,	0	/DATE ENXTENSION TO 1970 (0,10,20, OR 30) (MH)
DATTMP,	0	/TEMP STORE (MH)

	PAGE
\f
CTYPE,	0
	DCA T2
	TAD (200
	KRS
	CIA
	TAD T2
	SNA CLA
	KSF
	JMP I CTYPE
	KCC
	TAD ("^
	JMS I (TTY
	TAD T2
	TAD (100
	JMS I (TTY
	TAD (215
	JMS I (TTY
	ISZ CTYPE
	JMP I CTYPE

T2,	0

CINTER,	0
	TAD (203
	JMS CTYPE
	JMP UPPCK
	JMP SPURGE
UPPCK,	TAD (220
	JMS CTYPE
	JMP I CINTER
	SKP
SPURGE,	CMA
	DCA I (ALTOPT
	ISZ CINTER
	JMP I CINTER

HEMPTY,	0
	CDF 0
	TAD I EPTR
	CDF 10
	CIA
	TAD ECOUNT
	DCA ECOUNT
	TAD I (OPT1
	AND (200
	SZA CLA
	JMP LISTEM
	TAD I (OPT2
	SMA CLA
	JMP I HEMPTY
LISTEM,	TAD I (OPT1
	AND (10		/IS /I GIVEN
	SNA CLA		/IF YES PAD BY ADDIDTIONAL INFO WORDS
	JMP EMSG
	CLA CMA
	TAD INFWDS	/NUMBER OF SPACES=5*(INFWDS-1)
	DCA DFLAG
	TAD DFLAG
	RTL CLL
	TAD DFLAG
	SZA		/DONT OUTPUT 4096 BLANKS
	JMS I (BLANK
EMSG,	TAD (EMPTYM-1
	DCA XR1
	TAD (-11
	DCA CNT
EOLP,	TAD I XR1
	JMS I (OUTCHR
	ISZ CNT
	JMP EOLP
	TAD I (OPT1
	RTL
	SNL CLA
	JMP SKIPES
	JMS I (CONVTP
	TAD I (BLOCK
	JMS I	(BSPACE	/(MH) PATCH FOR /B/E
SKIPES,	CDF 0
	TAD I EPTR
	CDF 10
	CIA
	JMS I (PRNUM
	ISZ I (LNCNT	/AT END OF LINE
	JMP WORK	/NO. HAVE TO DO BLANK PADDING
	JMS I (CRLF
	TAD I (ALNCNT	/RESET COUNT
	DCA I (LNCNT
	JMP I HEMPTY
WORK,	TAD (5		/FORCES 5 BLANKS
	JMS I (BLANK
	TAD I (OPT1
	AND (100	/CHECK FOR /F
	SZA CLA		/ADD 10 SPACES TO COVER DATE
	JMP I HEMPTY
	TAD (12
	JMS I (BLANK
	JMP I HEMPTY

ECOUNT,	0

	PAGE
\f
PNMSUB,	0
	DCA NMEPLC
	RDF
	TAD (CDF
	DCA FLDFUD
	TAD (-10
	DCA CNT
PNLOOP,	TAD NMEPLC
FLDFUD,	HLT
	JMS I (GTSXBT
	CDF 10
	JMS I (CONVTP
	TAD (3
	TAD CNT
	SZA CLA
	JMP .+3
	TAD (".
	JMS I OSWTCH
	ISZ CNT
	JMP PNLOOP
	JMP I PNMSUB

NMEPLC,	0

WRTERR,	JMS I (ERROR
	OUERR+40
	JMP I (EOLIN
CLOERR,	JMS I (ERROR
	CLERR+40
	JMP I (EOLIN
NOROOM,	JMS I (ERROR
	SPRBLM+40
	JMP I (EOLIN
IDBLVT,	JMS I (ERROR
	NOTTY+40
	JMP I (EOLIN

SAYNON,	TAD (OUTCHR
	DCA OSWTCH
	JMS I (CRLF
	JMS I (CRLF
	TAD (-4		/FORCE PRINTING OF ONLY 1 DIGIT
	DCA I (MPNTCNT	/FOR 0 FREE BLOCKS
	TAD I (ECOUNT
	JMS I (PRNUM
	JMS I (CONVTP
	TAD (FRBLM-1
	DCA XR1
	TAD (-13
	DCA CNT
FRBLP,	TAD I XR1
	JMS I (OUTCHR
	ISZ CNT
	JMP FRBLP
	JMS I (CRLF
	TAD (14		/FORM FEED
	JMS I (OUTCHR
	TAD MOIN
	JMP I (DOMOIN

MOIN,	0

CRLF,	0
	TAD (215
	JMS OUTCHR
	TAD (212
	JMS OUTCHR
	JMP I CRLF

/ROUTINE TO DUMP ADDITIONAL INFO WORDS IF WANTED

ADDINF,	0
	TAD I (OPT1
	AND (10		/CHECK /I SWITCH
	SNA CLA
	JMP I ADDINF
	CLA CMA
	TAD INFWDS	/GET NUMBER
	SPA SNA		/MUST BE 2 OR MORE TO PRINT
	JMP CLARET	/RETURN
	CIA
	DCA CNTX
	TAD GPTR1
	IAC		/BUMP TO FIRST ONE
	DCA PGPTR1
ADDLP,	CDF 0
	TAD I PGPTR1	/GET WORD
	CDF 10
	JMS I (OPRNT	/PRINT IT IN OCTAL
	JMS I (CONVTP	/OUTPUT A BLANK
	ISZ PGPTR1	/BUMP
	ISZ CNTX	/COUNT NUMBER
	JMP ADDLP
CLARET,	CLA		/RETRN
	JMP I ADDINF

PGPTR1,	0
CNTX,	0

	PAGE
\f
VERNO,	TEXT /DIRECT V6A /
BADIRD,	TEXT /ERROR READING INPUT DIRECTORY/
SPRBLM,	TEXT /NO ROOM FOR OUTPUT FILE/
OUERR,	TEXT /ERROR WRITING FILE/
CLERR,	TEXT /ERROR CLOSING FILE/
NFLEIN,	TEXT /DEVICE DOES NOT HAVE DIRECTORY/
BIGEQ,	TEXT /EQUALS OPTION BAD/
ILLQ,	TEXT /ILLEGAL ?/
ILLA,	TEXT /ILLEGAL */
BADDIR,	TEXT /BAD INPUT DIRECTORY/
NOTTY,	TEXT /THERE IS NO HOPE-THERE IS NO TTY HANDLER IN YOUR SYSTEM/
EMPTYM,	"<;"E;"M;"P;"T;"Y;">;240;240
FRBLM,	"F;"R;"E;"E;240;"B;"L;"O;"C;"K;"S

	"B;"A;"D	/PROTECTION AGAINST BAD DATE
DATTAB, "J;"A;"N
	"F;"E;"B
	"M;"A;"R
	"A;"P;"R
	"M;"A;"Y
	"J;"U;"N
	"J;"U;"L
	"A;"U;"G
	"S;"E;"P
	"O;"C;"T
	"N;"O;"V
	"D;"E;"C
	"B;"A;"D	/PROTECTION AGAINST BAD DATE
	"B;"A;"D	/PROTECTION AGAINST BAD DATE
	"B;"A;"D	/PROTECTION AGAINST BAD DATE

DUMP,	0
	TAD I (LENGTH	/GET LENGTH AVAILABLE
	SNA		/IF ZERO ITS NON FILE STRUCTURE
	JMP NOMATR	/IF ZERO DOESNT MATTER
	CLL
	TAD I (CLEN	/ADD CURRENT SIZE
	TAD (5		/ADD # OF BLOCKS
	SZL CLA		/WE ARE OK IF SKIPS
	JMP I (NOROOM
	TAD I (CLEN	/UPDATE CLOSING LENGTH
	TAD (5		/BY NUMBER OF BLOCKS
	DCA I (CLEN	/SAVE FOR CLOSE
NOMATR,	TAD OUWDCT
	TAD (5210
	DCA CTLWD
	CIF 0
	JMS I OUHAND
CTLWD,	5210
BUFAD,	BUF
BLCKN,	0
	JMP WRTERR
	TAD (5
	TAD BLCKN	/UPDATE BLOCK # BY 5
	DCA BLCKN
	TAD (-1200
	DCA OUWDCT
	TAD BUFAD
	DCA OCPTR
	JMP I DUMP
/
\f
	*4600

	JMS INIT
	JMS INIT
	JMP I (2000
	JMP I (2001
INIT,	0
	ISZ INIT
	CLA CLL
	TAD (2000
	CDF 0
	DCA I (7745
	TAD (6403
	DCA I (7746
	CDF 10
	JMP I INIT
	$