File DIRECT.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/DIRECT FOR DECSYSTEM-8

/BY HARVEY MABRY - DIGITAL COMMUNICATIONS ASSOCIATES
/			ATLANTA, GEORGIA

/**UPDATE**

/5/24/73	-DEW
/	CONDITIONAL ASSEMBLY PARAMETER ADDED TO ALLOW
/	REMOVING LPT AS DEVAULT DEVICE AFTER DIR.  ALSO
/	IF TTY: IS OUT DEVICE NO FORMFEEDS ARE PRINTED
/	AND THE COMMAND LINE IS NOT ECHOED.

/ACCEPTED INTO DECSYSTEM-8 AFTER
/KV8I CODE ADDED BY JOHN COVERT, GT ICS
/CONSIDERABLE OPTIMIZING DONE 5/4/73, JRC


	FIELD 1

	LXR=14

/THE FOLLOWING DEFINES THE WIDTH AND HEIGHT OF DEVICES...
/MAY BE CHANGED BY PRECEDING ASSEMBLY WITH A DEFINITIONS FILE
	DECIMAL
	IFNDEF LPTWTH <
	LPTWTH=132
	>
	IFNDEF LPTHGT <
	LPTHGT=66
	>
	IFNDEF TTYWTH <
	TTYWTH=71
	>
	IFNDEF TTYHGT <
	TTYHGT=27
	>
/FOR KV8/I OUTPUT DEFINE KV8OPT=1

	IFNDEF KV8OPT <KV8OPT=0>

/THE NORMAL ORDER OF DEFAULT OUTPUT
/DEVICES ARE: DIR,LPT,TTY.  TO MAKE THE ORDER DIR,TTY
/WITH LPT OUTPUT ONLY ON /L OPTION:
/	DEFINE NOLPTDEFALT=1

IFNDEF NOLPTD <NOLPTD=0>

	OCTAL

	COMBUF=1600	/COMMAND BUFFER BEGINNING (PS/8)
	MDATE=7666	/MONITOR DATE LOCATION
	SBFTOP=6600
	SBUFST=0

	*4000
	NOP		/ALLOW EITHER RUN OR CHAIN
	CLA
	CDF 0
	TAD I (LXR
	CDF 10
	DCA TEXTPT
GNAME,	DCA WILD	/RETURN HERE TO GET A NAME (INITIALLY OR
	TAD (50 	/AFTER HANDLING A DEVICE)
	DCA MASK
	IAC
	DCA HALF
	TAD (MASK
	DCA NMFMPT
	DCA NM1 	/CLEAR OUT COMMAND LINE NAME FOR NEXT TIME
	DCA NM2
	DCA NM3
	DCA NM4
ONA,	CLA		/GET NEXT CHARACTER
	JMS GETCH
	JMS DISPATCH
	"
	ONA		/IGNORE SPACES ALTOGETHER
	"/
	OPTION		/SINGLE LETTER OPTION
	"(
	OPTS		/MULTIPLE OPTIONS
	"*
	ASTER		/HANDLE THIS KIND OF WILD CARD
	"?
	QMARK		/HANDLE THIS KIND
	".
	PER		/HANDLE EXTENSION
	":
	COL		/PREVIOUS STUFF WAS A DEVICE NAME
	0
	CONT		/END OF COMMAND LINE
	-1
	TAD CHAR	/ANY OTHER CHARACTER
	JMS DECODE
	JMP SYNTAX	/ERROR RETURN FROM DECODE
	SZL
	TAD (57
	IAC
	DCA CHAR
	CLL CML
	JMS SAVECH
	JMP ONA 	/GO TO HANDLE NEXT CHAR

OPTION, JMS GETCH	/HANDLE SINGLE LETTER OPT, GET CHARACTER
	JMS SLSHCH	/HANDLE THE OPTION LETTER - NUMBER
	JMP ONA 	/NOW GET NEXT CHAR

OPTS,	JMS GETCH	/MULTIPLE LETTER OPTIONS, GET CHAR
	TAD (-")	/IS IT ")" (END OF OPTIONS)
	SNA CLA
	JMP ONA 	/YES, GO ON WITH STANDARD SCAN
	TAD CHAR	/NO, GET CHAR BACK AND
	JMS SLSHCH	/HANDLE AS OPTION
	JMP OPTS	/NOW GET ANOTHER ONE UNTIL ")" FOUND

ASTER,	DCA CHAR	/HANDLE ASTERISK
	CLL
	JMS SAVECH
	SMA CLA
	JMP ASTER+1	/MARK THE REST AS WILD MATCH
OND,	ISZ WILD	/
	JMP ONA 	/GET NEXT CHARACTER

QMARK,	DCA CHAR	/HANDLE QMARK WILD
	CLL
	JMS SAVECH
	CLA
	JMP OND 	/FINISH UP ONE CHAR WILD, AND GO ON SCANNING

PER,	TAD NMFMPT	/THE REST IS AN EXTENSION
	CIA
	TAD (MASK	/PERIOD MUST COME AFTER A NAME HAS BEEN STARTED
	SZA CLA
	ISZ PERSW	/ALSO, THERE MUST BE ONLY ONE
	JMP SYNTAX
	DCA CHAR
	CLL CML
	JMS SAVECH	/MOVE OVER THE REST OF THE NAME
	SMA
	JMP .-3
	RAL
	CLL RAR
	DCA MASK
	JMP ONA 	/WE ARE SET UP, NOW GET THE EXTENSION

COL,	TAD WILD	/WE HAVE A COLON, SO PRECEDING IS DEV
	SNA CLA
	ISZ COLON
	JMP SYNTAX	/WE EITHER HAD WILD STUFF IN DEV, OR TWO ":"S
	TAD NM1
	DCA DEV1	/MOVE
	TAD NM2
	DCA DEV2
	JMP GNAME	/AND SET UP TO GET MORE NAME

GETCH,	0		/GET ONE CHARACTER FROM COMMAND BUFFER
	CDF 0
	TAD I TEXTPT
	CDF 10
	DCA CHAR	/SAVE FOR FUTURE REFERENCE
	TAD CHAR
	ISZ TEXTPT	/BUMP POINTER
	JMP I GETCH

TEXTPT, 0
	0	/LOCATION FOR NEG. # OF ADDITIONAL WORDS
MASK,	0
NM1,	0
NM2,	0
NM3,	0
NM4,	0
PERSW,	-1
COLON,	-1
WILD,	0
CHAR,	0
	PAGE

SLSHCH, 0		/HANDLE AN OPTION CHARACTER
	SZA
	JMS DECODE	/CHECK A-Z,0-9
	JMP SYNTAX	/ILLEGAL CHAR
	CLA
	TAD CHAR
	JMS DISPATCH	/CHECK THE CHAR AGAINST THE FOLLOWING TABLE
	"A
	OPA		/ALPHABETIZE
	"E
	OPE		/LIST EMPTIES
	"F
	OPF		/SHORT - ONLY FILE NAMES
	"L
	OPL		/GO TO LPT IF POSSIBLE
	"T
	OPT		/GO TO TTY
	"W
	OPW		/WIDE FORMAT - MAY BE FOLLOWED BY COLON...
	"H
	HEADER		/PARAMETER BLOCK HEADER.
	"N
	UDEVN		/JUST USER-DEVICE-NAME HEADER.
	-1
SLSHCR, JMP I SLSHCH	/RETURN - IGNORE ILLEGAL OPTIONS - NO ERROR

OPA,	CMA
	DCA OPTA	/SET ALPHABETIZE FLAG
	JMP I SLSHCH

OPE,	CMA
	DCA OPTE	/SET LIST EMPTIES FLAG
	JMP I SLSHCH

OPF,	CMA
	DCA OPTF	/SET  SHORT LISTING FLAG
	JMP I SLSHCH

OPW,	JMS GETCH	/WIDE LISTING - LOOK AT NEXT CHAR
	TAD (-":	/IF IT IS A COLON
	SZA CLA
	JMP NONUM	/NO, IT ISNT
	JMS GETCH	/IT WAS - LOOK AT NUMBER AFTERWARDS
	JMS DECODE	/CHECK TO SEE IF NUMERIC
	SKP		/NOT ALPHANUMERIC
	SNL		/SKIPS IF NUMERIC, NOT IF ALPHABETIC
	JMP SYNTAX	/WAS NOT A NUMBER
	DCA N		/STORE NUMBER IN N COLUMNS
	JMP I SLSHCH
NONUM,	CLA CMA 	/W WAS NOT FOLLOWED BY A COLON
	TAD TEXTPT	/BACK UP TEXT POINTER
	DCA TEXTPT
	DCA N		/IF N IS ZERO, USE DEFAULT WIDTH
	JMP I SLSHCH

DECODE, 0		/SUBROUTINE TO CHECK OPTION RANGE
	TAD (-"9-1	/VERIFIES IF WITHIN A-Z, 0-9
	CLL
	TAD ("9+1-"0
	SZL
	JMP DIGIT
	TAD ("0-"Z-1
	CLL CML
	TAD ("Z+1-"A
	SNL
DIGIT,	ISZ DECODE
	JMP I DECODE

OPL,	JMS SETLPT	/L OPT - SET TO GO TO LPT
	JMP I SLSHCH
	JMP LPTNA	/COULD ASSIGN LPT..

OPT,	JMS SETTTY	/OPTION T - SET TTY OUTPUT
	JMP I SLSHCH

SAVECH, 0		/SAVE NEXT CHARACTER OF A NAME
	TAD MASK
	SPA
	JMP I SAVECH	/DONT OVERFLOW NAME TABLE
	RAL
	DCA MASK
	TAD HALF	/SWITCH HALF
	CIA
	DCA HALF
	TAD CHAR	/GET CHAR AND HANG ON TO IT
	ISZ HALF	/WHILE WE DECIDE WHICH HALF
	JMP LOWER	/RIGHT
	ISZ NMFMPT	/LEFT
	CLL RTL
	RTL
	RTL
LOWER,	TAD I NMFMPT	/COMBINE WITH POSSIBLE PREVIOUS CHARACTER
	DCA I NMFMPT	/AND STORE BACK
	JMP I SAVECH

CONT,	TAD NMFMPT	/WE HAVE FINISHED SCANNING COMMAND LINE
	CIA
	TAD (MASK
	SNA CLA
	JMP CONTA	/WE HAD NO NAME SPECIFIED
ALLNOM, DCA CHAR
	CLL CML
	JMS SAVECH	/ZERO OUT REST OF NAME
	SMA
	JMP ALLNOM+1
	ISZ PERSW	/EXTENSION?
	JMP FINMSK	/WAS SPECIFIED
	RAL		/WAS NOT, ZERO IT OUT
	CLL RAR
	DCA MASK
	JMP ALLNOM+1
FINMSK, CLL RAL 	/FINISH UP MASKING
	CLL RAL
	RTL
CONTA,	DCA MASK
	JMP SETDEV	/GO ON TO SET UP DEVICES
OPTA,	0
N,	1
HALF,	1
NMFMPT, MASK
	PAGE

SETDEV, TAD XXDI	/DI   SET UP NAME FOR POSSIBLE OUTPUT FILE
	DCA I (7601
	TAD DEV1	/WILL BE DIXXXX.LS
	DCA I (7602	/WHERE XXXX IS THE INPUT (DIRECTORY) DEVICE
	TAD DEV2
	DCA I (7603
	TAD (1423	/LS
	DCA I (7604

	JMS USR 	/GET DEV NO OF INPUT DEVICE
	12		/INQUIRE
DEV1,	DEVICE DSK	/DSK IS DEFAULT - MAY BE CHANGED IN COMMAND
DEV2=.-1
	0
	JMP DEVNA	/DEVICE SPECIFIED IS NOT AVAILABLE
	TAD DEV2	/CHECK TO SEE IF DEVICE IS FILE STRUCTURED
	TAD (7760-1
	DCA DEV2+1
	TAD I DEV2+1
	SMA CLA
	JMP NODIR	/DEVICE DOESNT HAVE A DIRECTORY...
	TAD DEV2
	TAD (7640
	DCA NFILE
	TAD COLLEN	/IF COLLEN IS ALREADY SPECIFIED,
	SZA CLA
	JMP BYPASS	/THEN WE HAD /T OR /L -DONT LOOK FOR DIR
	JMS USR 	/SEE IF THERE IS A DEVICE CALLED DIR
	12		/INQUIRE
XXDI,	DEVICE DIR
DIRN=.-1
	0
	IFZERO KV8OPT <JMP LABG>	/NO DIR, SO TAKE DEFAULT
	IFNZRO KV8OPT <JMP I (SETKV8>	/FOR KV8, KV IS DEFAULT
	TAD DIRN
LABGY,	JMS LPDCAS	/DO THE SETUP PARAMS
	JMP BYPASS
LABG,
IFZERO NOLPTD <
	JMS SETLPT
	JMP BYPASS>
	JMS SETTTY
BYPASS, JMS OCRLF	/OUTPUT INPUT COMMAND LINE
			/BYPASS MODIFIED IF TTY OUT DEV.
	TAD (".
	JMS OPUTCH
	TAD (COMBUF
	DCA TEXTPT
TITLOP, JMS GETCH
	SNA
	JMP TITOUT	/FINISHED
	JMS OPUTCH
	JMP TITLOP
TITOUT, JMS OCRLF
	TAD I (MDATE
	JMS XDATE	/OUTPUT CURRENT DATE
	TAD (-14
	JMS XPRINT
	DA1
	JMS OCRLF
	JMP I (HEADR	/GO PRINT HEADER IF OPTED FOR

LPDCAS, 0		/DOES SOME DCA'S NEEDED A FEW TIMES.
	DCA I (7600	/DEVICE NUMBER
	TAD (LPTWTH
	DCA LWDTH
	TAD (LPTHGT-20
	DCA COLLEN
	JMP I LPDCAS

SETLPT, 0		/SET LPT AS OUTPUT DEVICE
	JMS USR
	12		/INQUIRE
	DEVICE LPT
	0
	ISZ SETLPT	/NO LPT, SET UP FOR ERROR EXIT
	TAD .-3
	JMS LPDCAS	/DO SETUP
	JMP I SETLPT


SETTTY, 0		/SET TTY AS OUTPUT DEVICE
	JMS USR 	/WE MUST GET DEVICE NUMBER OF TTY
	12		/BECUASE SOME BUILD MAY HAVE IT FUNNY
	DEVICE TTY
	0
	JMP I (TTYNA	/HUH?
	TAD .-3
	DCA I (7600	/DEVICE NUMBER
	TAD (TTYWTH
	DCA LWDTH
	TAD (TTYHGT-4
	DCA COLLEN
	TAD (212	/CHANGE FORMFEED TO 212
	DCA FORMF
	TAD (JMP TITOUT /(OR TAD TITLOP+2 IF NECESSARY
	DCA BYPASS	/NO COPY OF COMMAND IF TTY
	JMP I SETTTY
PAGE

CLRBUF, TAD STORAGE	/CLEAR OUT THE BUFFER
	DCA AUTO
	TAD (-SBFTOP+SBUFST
	DCA COUNT
	JMS DIAUTO
	ISZ COUNT
	JMP .-2
	DCA RECORD
	TAD STORAGE
	DCA AUTO
	TAD (MASK-1
	JMS DIRSRH	/FIRST SEARCH
	JMP CHECKR	/DIDNT FIND MATCHES, CHECK CASE
	JMP YES
PKLOOP, JMS DIRSRH	/LOOP ON LOOKUP
	JMP PACKED	/WE HAVE ALL ENTRIES
YES,	DCA ENTRY
	ISZ RECORD
	TAD (-4
	DCA COUNT
	JMS TENTRY
	SZA
	JMP LABI+1
	CMA
	JMS DIAUTO
	ISZ COUNT
	JMP .-2
	TAD OPTF
	SZA CLA
	JMP PKLOOP
	TAD MASK-1
	SZA CLA
	JMS DIAUTO
	JMP NODATE
LABI,	JMS TENTRY
	JMS DIAUTO
	ISZ COUNT
	JMP .-3
	TAD OPTF
	SZA CLA
	JMP PKLOOP
	TAD MASK-1
	SNA CLA
	JMP NODATE
	JMS TENTRY
	JMS DIAUTO
	TAD MASK-1
	CMA
	TAD ENTRY
	DCA ENTRY
NODATE, JMS TENTRY
	CIA
	JMS DIAUTO
	JMP PKLOOP
PACKED, JMS FREEOT	/WE HAVE FINISHED GETTING NAMES
	TAD AUTO
	DCA SORTH
	TAD OPTF
	SNA CLA
	JMP LABC
	TAD (4
	DCA RECLEN
	TAD (-16
	JMP SETLEN
LABC,	TAD MASK-1
	SZA CLA
	JMP LABD
	TAD (5
	DCA RECLEN
	TAD (-22
SETLEN, JMP SETL
TENTRY, 0
	TAD I ENTRY
	ISZ ENTRY
	JMP I TENTRY
DIAUTO, 0
	CDF 0
	DCA I AUTO
	CDF 10
	ISZ AUTO
	JMP I DIAUTO
AUTO,	0
ENTRY,	0
COUNT,	0
RECORD, 0
FBLK,	TEXT / FREE BLOCKS/

FREEOT, 0		/THIS SUBROUTINE PRINTS NUMBER OF FREE BLOCKS
	JMS OCTDEC
	TAD (-4
	JMS XPRINT
	NOBLK1
	TAD (-14
	JMS XPRINT
	FBLK
	JMS OCRLF
	JMP I FREEOT
CHECKR, JMS FREEOT	/FIRST OUTPUT THE FREE BLOCK (N IS IN AC)
	TAD I (NM1	/WE RETURNED FROM DIRSH WITH NO NAMES,
	SZA CLA 	/SO IF A NAME WAS SPECIFIED, WE MUST TELL
	JMP I (NMATCH	/HIM IT WAS NOT FOUND - THIS LINE DOES THAT
			/OTHERWISE, HE TRIED TO LIST A DEVICE WITH A
	JMP I (CLOSEN	/ZERO DIRECTORY, SO TELL HIM HOW BIG, AND QUIT

PAGE
LABD,	TAD (6
	DCA RECLEN
	TAD (-33
SETL,	DCA MCOLWD
	ISZ OPTA	/IS SORT OPTION SET?
	JMP .+4
	CDF 0
	JMS SORT	/YES, DO IN-PLACE SORT
	CDF 10
	TAD RECLEN
	CIA
	DCA CTTER
	TAD COLLEN
	ISZ CTTER
	JMP .-2
	DCA WDSNCL
	TAD COLLEN
	CIA
	DCA MCOLLN
	TAD N
	SZA
	JMP GOTNA+2
	TAD LWDTH
	TAD MCOLWD
	SPA
	JMP .+3
	ISZ NA
	JMP .-4
GOTNA,	CLA
	TAD NA
	CIA
	DCA NA
NXTPAG, DCA FLAGL
	DCA NR
	DCA NUMCOL
	TAD RECORD
	TAD MCOLLN
	SPA SNA
	JMP .+3
	ISZ NUMCOL
	JMP .-4
	SZA
	ISZ NR
	CIA
	TAD MCOLLN
	DCA FRACT
	TAD NR
	TAD NUMCOL
	TAD NA
	SPA SNA CLA
	JMP ALLOK
	CMA
	DCA FLAGL
	TAD NA
	CMA
	DCA NUMCOL
	TAD MCOLLN
	DCA FRACT
ALLOK,	TAD NUMCOL
	SZA CLA
	JMP .+3
	TAD FRACT
	SKP
	TAD MCOLLN
	DCA BCT
	TAD STORAGE
	DCA BASE
	JMP .+4
ONB,	TAD BASE
	TAD RECLEN
	DCA BASE
	TAD BASE
	DCA THSREC
	JMS OCRLF
	JMS PRTHSR
	TAD NUMCOL
	SNA
	JMP TSTB
	CIA
	DCA CCT
ONC,	TAD THSREC
	TAD WDSNCL
	DCA THSREC
	JMS PRTHSR
	ISZ CCT
	JMP ONC
	ISZ FRACT
	JMP TSTB
	CMA
	TAD NUMCOL
	DCA NUMCOL
TSTB,	ISZ BCT
	JMP ONB
	JMS OCRLF
	ISZ FLAGL
	SKP
	JMP MORE
CLOSEN, TAD ("Z-100	/PUT OUT A  Z, AND QUIT
	JMS OPUTCH	/OUTPUT ROUTINES QUIT ON  Z
CTTER,	0
MCOLWD, 0
WDSNCL, 0
MCOLLN, 0
LWDTH,	0
NA,	0
FLAGL,	0
NR,	0
NUMCOL, 0
FRACT,	0
BCT,	0
BASE,	0
THSREC, 0
CCT,	0
COLLEN, 0
PAGE

MORE,	TAD NA
	DCA CT
	TAD COLLEN
	ISZ CT
	JMP .-2
	DCA NRCRDS
	TAD NRCRDS
	CIA
	TAD RECORD
	DCA RECORD
	TAD RECLEN
	CIA
	DCA CT
	TAD NRCRDS
	ISZ CT
	JMP .-2
	TAD STORAGE
	DCA STORAGE
	TAD FORMF	/OUTPUT FORMFEED
	JMS OPUTCH
	JMP NXTPAG	/AND START A NEW PAGE

PRTHSR, 0
	TAD (-16
	DCA CT
	TAD (NME1
	DCA NRCRDS
	DCA I NRCRDS
	ISZ NRCRDS
	ISZ CT
	JMP .-3
	TAD THSREC
	DCA NRCRDS
	JMS TIBUF
	CMA
	SNA
	JMP OUTNA1
	CMA
	DCA NME1
	JMS TIBUF
	DCA NME2
	JMS TIBUF
	DCA NME3
	JMS TIBUF
	SNA
	JMP NAMOUT
	DCA ONTEMP
	TAD ONTEMP
	AND (7700
	CLL RTR
	RTR
	RTR
	TAD (5600
	DCA NME4
	TAD ONTEMP
	AND (77
	CLL RTL
	RTL
	RTL
	DCA NME5
NAMOUT, TAD OPTF
	SZA CLA
	JMP PR
	TAD MASK-1
	SZA CLA
	JMS DATE
	JMS TIBUF
	JMS OCTDEC
PR,	TAD MCOLWD
	JMS XPRINT
	NME1
	JMP I PRTHSR
DATE,	0
	JMS TIBUF
	JMS XDATE
	JMP I DATE
OUTNA1, TAD (7405		/<E
	DCA NME1
	TAD (1520		/MP
	DCA NME2
	TAD (2431		/TY
	DCA NME3
	TAD (7600		/>
	DCA NME4
	TAD (3
	TAD NRCRDS
	DCA NRCRDS
	JMP NAMOUT
TIBUF,	0
	CDF 0
	TAD I NRCRDS
	CDF 10
	ISZ NRCRDS
	JMP I TIBUF
CT,	0
NRCRDS, 0
ONTEMP, 0
STORAG, SBUFST	/STORAGE
FORMF,	214	/GETS CHANGED TO 212 IF TTY OUTDEV.


PAGE

XDATE,	0		/DECODE DATE
	SNA
	JMP I XDATE
	DCA DATEMP
	TAD DATEMP
	AND (7400
	CLL RAL
	RTL
	RTL
	JMS OCTDEC
	TAD NOBLK2
	DCA DA1
	TAD DATEMP
	AND (370
	CLL RAR
	RTR
	JMS OCTDEC
	TAD DECICH+2
	TAD (5700
	DCA DA2
	TAD DECICH+3
	CLL RTL
	RTL
	RTL
	TAD (57
	DCA DA3
	TAD DATEMP
	AND (7
	TAD (6760
	DCA DA4
	JMP I XDATE

OCTDEC, 0		/OCTAL-DECIMAL CONVERSION
	JMS DIV
	-1750
	DCA REM
	TAD INTEG
	DCA FIPFOP
	TAD INTEG
	JMS OCTDBL
	DCA DECICH
	TAD REM
	JMS DIV
	-144
	DCA REM
	TAD INTEG
	JMS OCTDBL
	DCA DECICH+1
	TAD REM
	JMS DIV
	-12
	TAD (60
	DCA DECICH+3
	TAD INTEG
	JMS OCTDBL
	DCA DECICH+2
	TAD DECICH
	CLL RTL
	RTL
	RTL
	TAD DECICH+1
	DCA NOBLK1
	TAD DECICH+2
	CLL RTL
	RTL
	RTL
	TAD DECICH+3
	DCA NOBLK2
	JMP I OCTDEC
OCTDBL, 0
	SZA
	JMP ODBL2
	TAD FIPFOP
	SZA CLA
	TAD (60
	JMP I OCTDBL
ODBL2,	DCA FIPFOP
	TAD FIPFOP
	TAD (60
	JMP I OCTDBL
DIV,	0
	DCA DITEMP
	TAD I DIV
	DCA DITEM2
	ISZ DIV
	DCA INTEG
	TAD DITEMP
	CLL		/FIX BUG
	TAD DITEM2
	SNL
	JMP .+3
	ISZ INTEG
	JMP .-5
	CIA
	TAD DITEM2
	CIA
	JMP I DIV
DATEMP, 0
NME1,	0
NME2,	0
NME3,	0
NME4,	0
NME5,	0
NOBLK1, 0
NOBLK2, 0
	0
DA1,	0
DA2,	0
DA3,	0
DA4,	0
	0
	0
REM,	0
INTEG,	0
FIPFOP, 0
DECICH, 0
	0
	0
	0
DITEMP, 0
DITEM2, 0

PAGE

XPRINT, 0		/ENTER WITH AC=-N CHARS
	DCA XPRCT
	TAD I XPRINT	/WILL RETURN WHEN COUNT OVERFLOWS
	DCA XPRPTR	/@ (00) GOES TO SPACE
	ISZ XPRINT
XPRNEX, TAD I XPRPTR
	CLL RTR
	RTR
	RTR
	JMS UTRM
	ISZ XPRCT	/HAS COUNT OVERFLOWED
	SKP
	JMP I XPRINT	/YES, RETURN
	TAD I XPRPTR
	JMS UTRM
	ISZ XPRPTR
	ISZ XPRCT	/HAS COUNT OVERFLOWED
	JMP XPRNEX	/NO, CONTINUE
	JMP I XPRINT	/YES, RETURN
UTRM,	0
	AND (77
	SZA		/WE CONVERT 00 TO 40 - @ TO SPACE
	TAD (-40
	SPA		/SKIP IF IT IS 240-277
	TAD (100	/IT IS 300-337
	TAD (240	/EVERBODY WAS THIS LOW
CALL,	JMS OPUTCH
	JMP I UTRM

OPUTCH, 0		/OUTPUT A CHARACTER
	DCA OCHAR
	TAD OCHAR
	TAD (-240
	SZA
	JMP .+3
	ISZ SPCT
	JMP I OPUTCH
	TAD (240-215
	SNA CLA
	DCA SPCT
	TAD SPCT
	SNA
	JMP NOBLOG
	CIA
	DCA SPCT
	TAD (240
	JMS OUT
	ISZ SPCT
	JMP .-3
NOBLOG, TAD OCHAR
	JMS OUT
	JMP I OPUTCH

OUT,	0		/OUTPUT CHAR TO PROPER DEVICE
	ISZ WHICH
	JMP OUTXX2
	JMS TYPE
	CMA
OUTXX1, DCA WHICH
	KRS		/CHECK FOR CONTROL C...
	TAD (100-"C	/CHECK FOR  C AND  O
	SNA
	JMP MEXIT	/HAD CTRLC, QUIT
	TAD ("C-"O	/ O CHECK
	SNA CLA
	JMP MEXIT	/WAS  O, QUIT
	JMP I OUT
OUTXX2, JMS I PTOPUT	/NORMALLY OPUTC, CHANGE FOR KV OPTION
	JMP OUTXX1
PTOPUT, OPUTC		/MAY BE CHANGED IF KVOPTION...

TYPE,	0		/OUTPUT TO TTY
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TYPE

NMATCH, CLA CMA 	/WE DIDNT FIND ANY MATCHING FILES
	DCA WHICH
	TAD (-21
	JMS XPRINT
	FNF
	JMP MEXIT
SYNTAX, CLA CMA
	DCA WHICH
	TAD (-16
	JMS XPRINT
	SYN
MEXIT,			/RETURN TO MONITOR...
	CIF CDF 0
	JMP I .+1
	7605
FNF,	TEXT /FILE(S) NOT FOUND/
SYN,	TEXT /ILLEGAL SYNTAX/	/KEEP EVEN NO. CHRS
XPRCT=.-1		/BECAUSE WE USE TERMINATOR FOR STORAGE
XPRPTR, 0
OCHAR,	0
SPCT,	0
WHICH,	0

OCRLF,	0		/OUTPUT CR-LF
	TAD (215
	JMS OPUTCH
	TAD (212
	JMS OPUTCH
	JMP I OCRLF
PAGE

	/DIRECTORY SEARCH ROUTINE

/DSFLD= /FIELD OF THIS PROGRAM

DIRSRH, 0
	SNA		/SET MASK POINTER & SEARCH FROM DIRECTORY BEGINNING?
	JMP DSLABB		/NO.
	DCA DSMSK1		/YES--SAVE POINTER.
	DCA DSFBLK	/ZERO FREE BLOCK ACCUMULATOR.
	IAC
	JMP DSREAD	/GO READ FIRST BLOCK OF DIRECTORY.
DSLABB, TAD DSMSK1
	SZA CLA 	/THEN DO WE HAVE A MASK?
	JMP DSLABA		/YES.
	CMA			/NO--TAKE ERROR EXIT.
	JMP I DIRSRH
DSLABC, TAD I DSMSK1	/SET ENTRY POINTER INCREMENT TO ADVANCE PAST AN ENTRY.
	CIA
	TAD (5
	DCA DSINC
DSLABA, ISZ DSCT	/ANY MORE ENTRIES IN THIS BLOCK?
	JMP DSNEXT		/YES--GET NEXT ENTRY.
	CMA			/NO.
	DCA DSCT	/RESET COUNTER TO OVERFLOW.
	TAD I DSLINK
	SZA CLA 	/IS THERE ANOTHER BLOCK? (CHECK DIRECTORY LINK.)
	JMP DSREAD		/YES--GO READ NEXT BLOCK.
	DCA DSMSK1		/NO--ZERO MASK POINTER--HAVE FINISHED WITH IT.
	TAD DSFBLK	/ERROR RETURN (CALL+1) WITH # OF FREE BLOCKS.
	JMP I DIRSRH
	DCA I DSMSK1	/SUPPLY TO CALLING PROGRAM.
DSNEXT, TAD DSENTP
	TAD DSINC
	DCA DSENTP	/ADVANCE ENTRY POINTER TO NEXT ENTRY.
	TAD I DSENTP
	SZA CLA 	/IS THIS AN EMPTY FILE ENTRY?
	JMP DSLABD		/NO.
	IAC			/YES.
	TAD DSENTP
	DCA DSTEMP
	TAD I DSTEMP
	CIA
	TAD DSFBLK	/ACCUMULATE # OF FREE BLOCKS.
	DCA DSFBLK
	CLA CLL CML RTL
	DCA DSINC	/SET INCREMENT TO ADVANCE OVER AN EMPTY FILE.
	TAD OPTF	/GET /F OPTION WORD.
	SZA CLA 	/IS OPTION /F SET?
	JMP DSLABA		/YES--IGNORE EMPTY FILE.
	TAD OPTE		/NO--GET /E OPTION WORD.
	SNA CLA 	/IS OPTION /E SET?
	JMP DSLABA		/NO--IGNORE EMPTY FILE.
	JMP DSNEXI		/YES--TAKE NORMAL EXIT TO OUTPUT EMPTY FILE.
DSLABD, TAD I DSADDW
	CMA		/DON'T INCREMENT IN TAKING NEG. SO CAN USE EXISTING CONS
STANT (5.
	TAD DSENTP
	TAD (5
	DCA DSTEMP	/SET UP POINTER TO FILE LENGTH.
	TAD I DSTEMP	/GET FILE LENGTH.
	SNA CLA 	/IS THIS A TEMPORARY FILE ENTRY?
	JMP DSLABC		/YES--IGNORE ENTRY.
	TAD DSENTP		/NO--"DOES ENTRY MATCH WILD CARD" ROUTINE FOLLOW
WS.
	DCA DSENP	/GET AN ENTRY POINTER IN THE ACTIVE POINTER.
	IAC
	TAD DSMSK1
	DCA DSNMFM	/NOW POINTS TO MASK WORD.
	TAD I DSNMFM	/GET MASK WORD
	DCA DSMASK
	ISZ DSNMFM	/ADVANCE TO POINTER TO FIRST NAME FORM WORD.
	TAD (-4
	DCA DSCT2	/SET COUNTER TO LOOP FOUR TIMES.
DSLOOP, TAD DSMASK
	SNA		/IS MASK ZERO?
	JMP DSES		/YES--FULL WILD CARD--IT DOES MATCH.
	CLL RAL
	SNL		/IS FIRST CHAR. WILD?
	JMP DSLABE		/YES.
	CLL RAL 		/NO.
	DCA DSMASK	/RESTORE MASK WORD.
	TAD (7700	/PRESERVE FIRST CHAR.
DSTWO,	SZL		/IS SECOND CHAR. WILD?
	TAD (77 		/NO--PRESERVE SECOND CHAR.
	DCA DSMSKW		/YES--SAVE MASKING WORD.
	TAD I DSENP
	AND DSMSKW	/MASK OFF ENTRY WORD
	CIA
	TAD I DSNMFM
	SZA CLA 	/ARE THEY EQUAL?
	JMP DSLABC		/NO--IT DOES NOT MATCH--IGNORE ENTRY.
DSMSK0, ISZ DSENP	/ADVANCE ACTIVE ENTRY POINTER.
	ISZ DSNMFM	/ADVANCE NAME FORM POINTER.
	ISZ DSCT2	/FINISHED LOOP?
	JMP DSLOOP		/NO--CONTINUE.
DSES,	TAD I DSADDW		/YES--THIS ENTRY DOES MATCH.
	CIA
	TAD (5
	DCA DSINC	/SET ENTRY INCREMENT TO ADVANCE OVER PERMANENT FILE.
DSNEXI, TAD DSENTP	/GET POINTER TO THIS ENTRY.
	ISZ DIRSRH	/ADVANCE TO NORMAL EXIT (CALL+2).
	JMP I DIRSRH
DSLABE, CLL RAL
	DCA DSMASK
	SZL
	JMP DSTWO+1
	JMP DSMSK0
/
/
DSTEMP, 0		/TEMPORARY STORAGE.
DSMSK1, 0		/MASK-1 POINTER, INITIALLY =0.
DSLINK, IBUFF+2 	/SEG. LENGTH POINTER.
DSFBLK, 0		/FREE BLOCK ACCUMULATOR.
DSINC,	0		/INCREMENT VALUE FOR ENTRY POINTER.
DSCT,	-1		/COUNTER FOR ENTRIES PER BLOCK (INITIALLY =-1).
DSENTP, 0		/ENTRY POINTER.
DSENP,	0		/ACTIVE ENTRY POINTER--IT ADVANCES FOR COMPARING.
DSNMFM, 0		/POINTER TO NAME FORM--I.E. SOUGHT CHARACTER IN NAME.
DSMASK, 0		/MASK WORD WHOSE BITS MASK OFF WILD CHARACTERS.
DSCT2,	0		/COUNTER FOR COMPARE LOOP.
DSMSKW, 0		/ACTUAL MASK WORD USED TO MASK OFF WILD CHARS.
DSADDW, IBUFF+4 	/POINTER TO NEG. # OF ADDITIONAL WORDS.
OPTE,	0
OPTF,	0

	PAGE

DSREAD, JMS BKIN	/READ A BLOCK.
	JMP DSUSR6	/EOF ENCOUNTERED--SHOULD NOT OCCUR => BAD DIR. OR FILE L
LENGTH.
	TAD I DSNENT	/GET ENTRY COUNTER.
	DCA DSCT
	DCA DSINC	/CLEAR ENTRY POINTER INCREMENT.
	IAC
	TAD DSADW2
	DCA DSENTP	/NOW POINTS TO FIRST ENTRY IN THIS BLOCK.
	TAD I DSADW2	/GET NEG. # OF ADDITIONAL WORDS PER ENTRY.
	JMP DSNEXT-1
DSNENT, IBUFF		/POINTER TO THE NUMBER OF ENTRIES IN THIS BLOCK.
DSADW2, IBUFF+4 	/POINTER TO NEG. # OF ADDITIONAL WORDS.
DSUSR6, CIF 10
	JMS USR
	7
	6



	/BLOCK INPUT ROUTINE.

/TEMPORARY DEFINITIONS FOR ASSEMBLY LISTING
BUFIFD=1
IBUFF=3200
FILTAB=NFILE
INHAND=6600
I2PAGE=1
USR=200

/THE FOLLOWING ARE ASSEMBLY TIME PARAMETERS:
/BUFIFD=		/FIELD OF INPUT BUFFER.
/IBUFF= 		/INPUT BUFFER ADDRESS.
/FILTAB=		/POINTER TO INPUT FILE TABLE.
/INHAND=		/LOCATION (IN FIELD 0) FOR INPUT HANDLER.
/I2PAGE=		/0 => ONLY ONE PAGE HANDLER ALLOWED,
/				/1 => SPACE AVAILABLE FOR TWO PAGE HANDLER.
/USR=			/ACCESS TO "USR" --
/				/IF USR WILL BE RESIDENT THEN USR=200
/				/ELSE USR=7700.
/
/
/THE FOLLOWING MONITOR "USER ERROR" MESSAGES ARE POSSIBLE:
/	"USER ERROR 4 AT XXXX"	=> NON-FILE STRUCTURED INPUT DEVICE.
/	"USER ERROR 5 AT XXXX"	=> NO SUCH DEVICE OR NO SPACE
/					FOR TWO PAGE HANDLER.
/	"USER ERROR 6 AT XXXX"	=> DEVICE HANDLER EOF OR INPUT ERROR
/
/THIS PROG. WILL WORK IN ANY FIELD BUT MUST BE CALLED FROM WITHIN THE SAME FIELD
D.


BKIN,	0
	SZA CLA 	/RESET INPUT FILE TABLE?
	JMP BKISRT		/YES--START OVER.
	TAD BKICT	/EXAMINE BLOCK COUNTER.
	SNA CLA 	/MORE BLOCKS IN THIS FILE?
	JMP BKINF		/NO--GET NEXT FILE.
BKINBK, ISZ BKIN		/YES--MORE BLOCKS, ADVANCE TO RETURN TO CALL+2
	CIF 0		/HANDLERS AR ALWAYS IN FIELD 0.
	JMS I BKIHND	/CALL HANDLER TO READ.
	BUFIFD 10+200	/# BLOCKS & FIELD OF BUFFER.
	IBUFF		/ADDRESS OF BUFFER.
BKINM,	0		/BLOCK # TO BE READ.
	JMP BKIER6	/HANDLER ERROR.
	ISZ BKINM	/ADVANCE BLOCK #.
	ISZ BKICT	/COUNT BLOCK JUST READ.
	NOP		/SKIPS AT END OF FILE.
	JMP I BKIN	/EXIT.
BKISRT, TAD BKIFT	/START OVER WITH INPUT FILES.
	DCA BKIFPT	/RESET FILE TABLE POINTER.
BKINF,	TAD BKIB	/NEXT FILE SET UP.
	DCA BKIHND	/RESET LOCATION FOR INPUT HANDLER IN USR FETCH.
	TAD I BKIFPT	/GET DEVICE # FROM INPUT FILE TABLE.
	SNA		/ANY MORE FILES?
	JMP I BKIN		/NO--MORE FILES--TAKE ERROR EXIT "CALL+1".
	CIF 10		/USR ACCESS IS ALWAYS IN FIELD 1.
	JMS USR
	1		/FETCH HANDLER IF ABSENT & GET ENTRY POINT.
BKIHND, INHAND&7600+I2PAGE/SPECIFY LOCATION FOR INPUT HANDLER--BECOMES
				/ENTRY TO HANDLER.
	JMP BKIER5	/FETCH ERROR.
	TAD I BKIFPT
	AND (7760	/GET # BLOCKS IN THIS FILE.
	SNA
	JMP BKIER4	/MUST BE FILE STRUCTURED DEVICE.
	CLL RTR
	RTR
	TAD (7400	/COMPLETE THE NEGATIVE # OF BLOCKS.
	DCA BKICT	/SET BLOCK COUNTER.
	ISZ BKIFPT	/ADVANCE INPUT TABLE POINTER.
	TAD I BKIFPT	/GET STARTING BLOCK OF FILE.
	DCA BKINM	/SET UP FOR HANDLER CALL.
	ISZ BKIFPT	/ADVANCE TO NEXT FILE IN INPUT TABLE.
	JMP BKINBK	/GO INPUT THE NEXT BLOCK.

BKIER6, CLA IAC 	/SET FOR USR 'USER ERROR' CALL
BKIER5, IAC
BKIER4, TAD (4
	DCA BKIER
	CIF 10
	JMS USR
	7		/USR 'USER ERROR' MESSAGE.
BKIER,	5		/ERROR NUMBER.

BKICT,	0		/BLOCK COUNTER, INITIALLY = 0.
BKIFT,	FILTAB		/CONSTANT POINTER TO INPUT FILE TABLE.
BKIFPT, FILTAB		/ACTIVE POINTER TO INPUT FILE TABLE.

BKIB,	INHAND&7600+I2PAGE/LOCATION FOR INPUT HANDLER FOR USR FETCH.


	PAGE
/ROUTINE TO SETUP FOR PRINTING HEADER FROM PARAMETER
/BLOCK.  SIGNALED BY /H OPTION FOR ALL HEADER INFO
/AND /U OPTION FOR JUST USER-DEVICE-NAME.

HEADER, STA
	DCA SLHFL	/SET /H FLAG
UDEVN,	STA
	DCA SLUFL	/AND /U FLAG
	JMP I (SLSHCR	/RETURN

SLHFL,	0
SLUFL,	0

/COME HERE TO CHECK HEADER OPTION

HEADR,	ISZ SLUFL	/ANY HEADER OPTIONS?
	JMP I (CLRBUF	/NO:GO ON TO LOOKUP STUFF IN DIRECTORY
	IAC
	JMS BKIN	/JUST TO LOAD HANDLER
	NOP
	TAD (6		/NOW TO GET BLOCK 6
	DCA BKINM	/WANT TO READ BLOCK 6
	JMS BKIN	/READ IT
	NOP
	ISZ I (IBUFF+2	/SKIPS IF PARAMETER BLOCK PRESENT
	JMP I (CLRBUF	/NO PARAM BLOCK=IGNORE OPT.
	JMS I (OCRLF
	TAD (-4 	/PRINT THE UDNAME
	JMS I (PARAMP
	 IBUFF+100
	TAD I (IBUFF+104 /VOLUME I.D.
	JMS I (OCTDEC	/CONVERT TO DECIMAL
	TAD (-12
	JMS I (XPRINT
	  VOLUME
	TAD (-4
	JMS I (PARAMP	/PRINT IT
	  DECICH
	JMS I (OCRLF	/NEW LINE
	ISZ SLHFL	/PRINT IT ALL?
	JMP PARAME	/NO:
	TAD (-177
	JMS I (PARAMP	/AND DESCRIPTIVE LABLE
	  IBUFF+200
	JMS I (OCRLF	/NEW LINE
	ISZ I (IBUFF+7	/SKP IF SYSTEM PRESENT
	JMP PARAME	/DONE.
	TAD I (IBUFF+105 /SYSTEM TYPE
	CIA		/MAKE POS.
	CLL RAL 	/*2 WORDS PER ENTRY
	TAD (TYPTAB	/INDEX INTO NAME TABLE
	DCA SLUFL	/A GOOD TEMP
	TAD I SLUFL	/PICK UP NAME POINTER
	DCA .+4
	ISZ SLUFL	/TO #CHARS
	TAD I SLUFL	/-#CHARS
	JMS I (XPRINT
	  0
	TAD (-6
	JMS I (XPRINT
	 MARK
	TAD I (IBUFF+106 /VERSION #
	JMS I (OCTDEC	/CONVERT
	TAD (-4
	JMS I (PARAMP	/PRINT IT
	  DECICH
	TAD (".
	JMS I (OPUTCH	/AND "."
	TAD I (IBUFF+107 /RELEASE NUMBER
	JMS I (OCTDEC	/CONVERT
	TAD (-4
	JMS I (PARAMP	/PRINT
	  DECICH
	TAD (-7
	JMS I (XPRINT
	  SYSTEM
	JMS I (OCRLF
PARAME, JMS I (OCRLF
	JMP I (CLRBUF	/AND GO ON

	TYPTAB=.
	SYS0;-1
	SYS1;-4
	SYS2;-4
	SYS3;-5
	SYS4;-13

SYS0,	0
SYS1,	TEXT  PS/8
SYS2,	TEXT  OS/8
SYS3,	TEXT  OS/12
SYS4,	TEXT  DECSYSTEM-8
SYSTEM, TEXT   SYSTEM
MARK,	TEXT   MARK

PAGE

DISPAT, 0		/DISPATCH
	CIA
	DCA DISTEM
	SKP
DISLOP, ISZ DISPATCH
	TAD I DISPATCH
	ISZ DISPATCH
	SMA
	JMP .+3
	CLA
	JMP I DISPATCH
	TAD DISTEM
	SZA CLA
	JMP DISLOP
	TAD I DISPATCH
	DCA DISPATCH
	JMP I DISPATCH
DISTEM, 0
LPTNA,	CLA CMA 	/LPT NOT AVAILABLE
	DCA WHICH
	TAD (-22
	JMS XPRINT
	LPNA
	JMP NAVAL+3
DEVNA,	CLA CMA 	/SPECIFIED DEVICE NOT AVAIL
	DCA WHICH
	TAD (-4
	JMS XPRINT
	DEV1
NAVAL,	TAD (-16	/GATHERING POINT FOR THE REST OF THE MESSAGE
	JMS XPRINT
	LPNA+2
	JMP MEXIT
NODIR,	CLA CMA 	/SPECIFIED DEVICE NOT DIR STRUCT
	DCA WHICH
	TAD (-11
	JMS XPRINT
	DIRY
	JMP NAVAL
TTYNA,	CLA CMA 	/TTY NOT AVAIL????? HOW?, OH WELL, BAD BUILD...
	DCA WHICH
	TAD (-4
	JMS XPRINT
	TTYDEV
	JMP NAVAL
TTYDEV, TEXT /TTY /
LPNA,	TEXT /LPT@ NOT AVAILABLE/
DIRY,	TEXT /DIRECTORY/
NFILE,	7641
	1
	0		/MUST BE ZERO--TERMINATES INPUT FILE TABLE.


/THE FOLLOWING IS USED BY THE OUTPUT ROUTINE.
/IT COMES HERE IN CASE OUTPUT CANNOT BE OPENED ON FIRST TRY.
OFAIL,	TAD I (7600
	AND (7760
	SNA CLA /SKIP IF NOT INDEFINITE REQUEST.

	ERROR1		/OUTPUT FILE PROBABLY TOO LARGE.
	TAD I (7600
	AND (17
	DCA I (7600
	JMP I (OUENTR	/TRY INDEFINITE.


/OUTPUT SOME STUFF FROM PARAMETER BLOCK.
/RETURNS WHEN MAX CHARS PRINTED OR  Z.
/CALL:	TAD (-NUMCHRS
/	JMS I (PARAMP
/	 BUFFADD

PARAMP, 0
	DCA DISPAT	/A GOOD TEMP
	TAD I PARAMP	/GET BUFFER ADD
	DCA DISTEM	/ANOTHER GOOD TEMP
	ISZ PARAMP	/POINT TO RETURN
PARAM1, TAD I DISTEM	/GET AN ASCII CHAR
	TAD (-"Z+100	/CHECK FOR  Z
	SNA
	JMP I PARAMP	/DONE.
	TAD ("Z-100	/GET CHAR BACK
	SZA		/DON'T PRINT 0'S
	JMS I (OPUTCH	/OUTPUT IT
	ISZ DISTEM	/NEXT CHAR
	ISZ DISPAT	/DONE?
	JMP PARAM1	/NO: LOOP FOR NEXT
	JMP I PARAMP	/YES.

VOLUME, TEXT	 VOLUME

PAGE

/ SORT SUBROUTINE FOR FIXED NUMBER OF RECORDS.
/ RECLEN = RECORD LENGTH.
/ SORLEN = NUMBER OF WORDS PER RECORD TO BE SORTED ON.
/ SORTL = LOC. CONTAINING 1 ST. WORD OF 1ST. RECORD.
/ SORTH = LOC+1 CONTAINING LAST WORD OF LAST RECORD.

SORT,	0
	TAD SORLEN
	CIA
	TAD RECLEN
	SPA CLA
	HLT	/ SORLEN > RECLEN
SET,	TAD SORTL
	DCA REC1	/ SET UP CURRENT RECORD POINTER.
	TAD SORTL
	TAD RECLEN
	NOP
	DCA REC2	/ SET UP CURRENT RECORD+1 POINTER.
	TAD SORTH
	DCA BUFFA	/ SET UP WORK AREA.
	TAD RECLEN
	CIA
	DCA MRELEN	/ SET UP RECORD ELEMENT COUNTER.
	JMP GEREDY
	TAD SORTL
	CIA
	TAD REC1
	SPA CLA
	JMP SET
GEREDY, TAD REC1	/ COPY CURRENT RECORD ADDRESSES.
	DCA REC1+1
	TAD REC1
	TAD SORST
	DCA REC1
	TAD REC2
	DCA REC2+1
	TAD REC2
	TAD SORST
	DCA REC2
	TAD SORLEN
	CIA
	DCA ZERCOT
COMPR,	TAD I REC1	/COMPARE RECORD AND RECORD+1.
	CIA CLL
	TAD I REC2
	SNA
	JMP ZERO	/ ELEMENTS WITHIN RECORDS ARE =.
	SZL CLA
	JMP OK	/ RECORDS ARE IN THE RIGHT ORDER.
	TAD MRELEN	/ RECORDS ARE IN THE WRONG ORDER.
	DCA COUNTA	/ CHANGE ROUND RECORD AND RECORD+1.
CHANGE, JMS RESET
	TAD I REC1
	DCA I BUFFA
	ISZ REC1
	ISZ BUFFA
	ISZ COUNTA
	JMP CHANGE+1
	TAD MRELEN
	TAD REC1
	DCA REC1
	TAD MRELEN
	TAD BUFFA
	DCA BUFFA
	TAD MRELEN
	DCA COUNTA
MOOV,	TAD I REC2
	DCA I REC1
	ISZ REC2
	ISZ REC1
	ISZ COUNTA
	JMP MOOV
	TAD MRELEN
	TAD REC1
	DCA REC1
	TAD MRELEN
	TAD REC2
	DCA REC2
	TAD MRELEN
	DCA COUNTA
COPIE,	TAD I BUFFA
	DCA I REC2
	ISZ REC2
	ISZ BUFFA
	ISZ COUNTA
	JMP COPIE
	TAD MRELEN
	TAD REC2
	DCA REC2
	TAD MRELEN
	TAD BUFFA
	DCA BUFFA
	TAD REC1
	DCA REC2
	TAD REC1
	TAD MRELEN
	DCA REC1
	JMP GEREDY-5
ZERO,	ISZ REC1	/ MOVE POINTER TO NEXT RECORD ELEMENTS.
	ISZ REC2
	ISZ ZERCOT	/	(WITHIN SORT KEY)
	JMP COMPR
OK,	JMS RESET	/ RECORDS ARE IN THE RIGHT ORDER,
	TAD REC2	/	MOVE TO NEXT PAIR.
	DCA REC1
	TAD REC2
	TAD RECLEN
	DCA REC2
	TAD SORTH
	CIA CLL
	TAD REC2
	SZL CLA
	JMP I SORT
	JMP GEREDY

RESET,	0	/ RESET RECORD POINTERS.
	TAD REC1+1
	DCA REC1
	TAD REC2+1
	DCA REC2
	JMP I RESET

BUFFA,	0
MRELEN, 0
REC1,	0
	0
REC2,	0
	0
COUNTA, 0
ZERCOT, 0
	0
RECLEN, 0
SORLEN, 4
SORTL,	0
SORTH,	0
SORST,	0
	PAGE
/ASCII I/O FOR PS-8

/DEFINITIONS REQUIRED FOR CHARACTER I/O ROUTINES.

OUTBUFF=3600
ODEV=7200	/WHERE INPUT HANDLER GOES
ERROR1=HLT	/WHAT TO DO WHEN AN ERROR IS DETECTED.

/DELIVERS A CHARACTER TO THE OUTPUT FILE. OUTPUT FILE NAME
/MUST HAVE BEEN DEFINED PREVIOUSLY!!
/ Z WILL CLOSE OUTPUT FILE.
/CALLED BY:
/	TAD CHAR
/	IOF		/SEE NOTE AT IGETC ABOVE.
/	CDF
/	CIF 10
/	JMS I (OPUTC
/	RETURN (ACC=0)


	IFNDEF XLSIO <XLSIO=1>
	XLIST XLSIO
OPUTC,	0
	DCA LAST

			/THIS CODE IS NOT NEEDED IN THIS CASE
	IFNZRO 0 <	/SEE ALSO LABEL ODONE CHANGE
	RDF
	TAD CDFCIF
	DCA ODONE
	>

	CDF CIF 10
	TAD LAST
OL02,	DCA I OPNTR
	TAD OUTINH
	SNA CLA 	/SKIP IF OUTPUT ENTERED.
	JMP OOPEN
OL01,	ISZ OPNTR
	TAD I OPNTR
	SMA		/SKIP WHEN 3 CHARACTERS SAVED.
	JMP OEXIT
	DCA OPNTR	/RESTORE POINTER.
	TAD OPNTR+3
	CLL RTL;RTL
	AND O7400
	TAD OPNTR+1
	DCA I OCA
	ISZ OCA
	TAD OPNTR+3
	CLL RTR;RTR;RAR /LEFT-SHIFT 8.
	AND O7400
	TAD OPNTR+2
	DCA I OCA
	ISZ OCA
O7400,	7400		/IN CASE OCA PASSES THRU 0.
	ISZ OWC 	/SKIP IF BUFFER FULL.
	JMP OEXIT

	ISZ OBLWC	/SKIP IF OUTPUT FILE TOO LARGE!
	SKP
	ERROR1
	CIF
	JMS I OUHAND
	 4210
OUTP,	 OUTBUFF
OUTBLK,  0		/MUST BE FILLED BY 'OOPEN'.
	ERROR1
	ISZ OUTBLK
	JMS ORESET
O7600,
OEXIT,	7600
	TAD LAST
	TAD (-232
	SZA CLA 	/SKIP IF  Z RECIEVED.
	JMP ODONE

/CLOSE THE OUTPUT FILE.

	TAD OUTBLK
	CIA
	DCA OUBLK	/SAVE -BLOCK.
	JMS OPUTC	/PACK WITH 0'S.
	TAD OUTBLK
	TAD OUBLK
	SNA CLA 	/SKIP WHEN LAST ONE WRITTEN.
	JMP .-4
	TAD OULENGTH
	CIA		/NOW HAVE +LENGTH.
	TAD OBLWC	/GET -LENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF 10	/FIXED UP FOR SPECIAL CASE
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=1>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	TAD I O7600
	SNA		/SKIP IF OUTPUT POSSIBLE.
	ERROR1
	JMS I (200
	 12		/CHECK HANDLER, OR FETCH IT.
OUHAND,  ODEV+O2PAGE
	ERROR1		/HUH?
	TAD .-2
	SNA CLA 	/SKIP IF NOW IN CORE.
	JMP OL03	/TRY TO LOAD IT.
OUENTR, TAD I O7600
	JMS I (200
	 3		/ENTER OUTPUT FILE.
OUBLK,	 7601
OULENG,  0
	JMP I (OFAIL	/CAN'T ENTER IT.
	TAD OUBLK
	DCA OUTBLK
	TAD OULENGTH
	DCA OBLWC
	JMS ORESET
	ISZ OUTINH
	JMP OL01

/RESET POINTERS.

ORESET, 0
	TAD OPNTR+4
	DCA OPNTR
	TAD O7600
	DCA OWC
	TAD OUTP
	DCA OCA
	JMP I ORESET

OPNTR,	.+1
	0		/SIMILAR TO IPNTR+1 ETC.
	0
	0
	OPNTR+1 	/SEE IPNTR+4 FOR WARNING!

LAST,	0		/CONTAINS LAST CHAR RECIEVED.
OWC,	-200		/"
OCA,	OUTBUFF 	/"
RETURN, 7605		/RETURN ADDRESS FOR RECURSIVE OPUTC.
				/(RETURN TO MONITOR)
OUTINH, 0		/0 WHEN NO OUTPUT FILE IN PROGRESS.
	PAGE

	XLIST 0 	/RE ENABLE LISTING
/COPYRIGHT BY DIGITAL EQUIPMENT CORPORATION 1969
/BASIC CHARACTER GENERATOR
/WRITTEN BY MURRAY RUBEN AS PART OF THE KV8/I SOFTWARE.


/NOTE: ROUTINE IS 332 DECIMAL LOCATIONS LONG.
/(2 2/3 PAGES)
	IFNDEF XLSKV8 <XLSKV8=1>
	XLIST XLSKV8
	IFNZRO KV8OPT <
	*2000
DSPY,	0	/CALL WITH ASCII CHAR IN ACCUMULATOR
	JMS I SRCHI	/IS IT A SEARCH CHARACTER?
	TAD I SAVE2	/CHECK FOR CONTROL CHAR
	TAD M240
	SPA CLA
	JMP I DSPY	/IGNORE CONTROL CHAR (NO ECHO)
	TAD I SAVE2
	JMS OUTCHM	/OUTPUT TO DISPLAY
DSPYI,	JMP I DSPY	/EXIT WITH AC=0

/THE FOLLOWING IS A "SHORT" DATA AREA:
M240,	-240
SAVE2,	SAVE1	/ANOTHER TEMPORARY STORAGE AREA.
SRCHI,	SEARCH
M7,	-7
M14,	-14
TOP,	516	/TOPMOST LINE OF THE SCREEN.


/ROUTINE -RESET- ACCOMPLISHES THE "VERTAB" FUNCTION (CTRL/K).
VERTAB, TAD TOP /ERASE SCREEN, RESET INTGEGRATORS AND CPR TO TOP LEFT
	6066	/EXECUTE
	DCA Y0	/SET Y TO TOP
CR,	TAD Y0
	TAD M14
	DCA Y0
	TAD MARGIN
XCUTE,	DCA X0
	TAD M240
	JMP DSPYI-1	/SET INTEGRATORS TO "MARGIN".

SYNC,	TAD M7	/"SYNCHRONIZE"	A STABLIZING FUNCTION .
	TAD X0
	JMP XCUTE

/VARIABLES USED BY CHARACTER GENERATOR
X0,	-400	/X CHARACTER POSITION REGISTER
Y0,	512	/Y CHARACTER POSITION REGISTER
A,	0	/CONTROL WORD
B,	0	/MASK WORD
C,	0	/MASK POINTER
H,	0	/HALFWORD SWITCH

/CONSTANTS
C7,	7
C77,	77
CEX,	400
SAR1,	SAR
MASKS,	MASK0-1


/THIS IS THE ROUTINE WHICH DEALS WITH THE "MASK" AND
/"DISPATCH" CONTROL WORDS FOR THE ACTUAL DETERMINATION
/AND EXECUTION OF THE APPROPRIATE VECTOR STROKES TO
/BE DISPLAYED ON THE SCOPE.....
OUTCHM, 0	/DISPLAY CHARCTER. ENTER WITH ASCII 240-337
	AND C77 /MASK TO 6 BITS
	CLL RAL /*2
	TAD SAR1	/ADD DISPATCH
	DCA A
	TAD I A /THIS IS MASK WORD
	AND C7	/MASK OFF MASK BITS
	CLL RAL /*2
	DCA B
	TAD B
	CLL RAL /*4
	TAD B	/*6 NOW
	TAD MASKS	/6 TIMES MASK + MASK HEAD POINTER
	DCA C	/PTR FOR MASK ADDRESSES
	TAD I A
	CLL RAR
	DCA B	/SETS INTENSIFY BLANKING BITS, FIRST ALWAYS BLANKED
	ISZ A
	TAD I A
	DCA A	/RETRIEVE CONTROL WORD
	DCA H	/SETS LEFT HALF
	TAD X0
	TAD C7
	DCA X0	/CHAR ADVANCE

VA,	TAD H
	CIA
	DCA H	/RESET HALFWORD SWITCH
	ISZ H
	ISZ C	/ADVANCE PTR ON ZERO H
	TAD A
	SNA	/TEST NEXT CONTROL BIT
	JMP I OUTCHM	/ZERO MEANS ALL VECTORS WERE EXECUTED, SO EXIT
	CLL RAL
	DCA A	/NEXT CONTROL BIT IN LINK
	SNL
	JMP VA	/NOT AN EXECUTION

	TAD C6064	/INITIALIZE VOUT
	DCA VSTATE
	TAD H	/0 IF RIGHT HALF, 1 IF LEFT HALF
	CLL RAR /INTO LINK
	TAD I C /GET MASK ADDRESS
	SNL
	JMP .+4 /R.H.
	CLL RTR
	RTR
	RTR	/L.H.
	DCA I SAVE2

	TAD I SAVE2
	RTR
	RAR
	AND C7
	TAD X0	/ADD X MASK TO CPR
	JMS VOUT	/LOAD X ABSOLUTE
	TAD I SAVE2
	AND C7
	TAD Y0	/ADD Y MASK TO CPR
	JMS VOUT	/LOAD Y ABSOLUTE

	TAD B
	CLL RAL
	DCA B	/RETRIEVE NEXT BLANKING BIT INTO LINK
	RAL	/AND THEN INTO BIT 11
	TAD CEX /EXECUTE ABSOLUTE (VISIBLE) VECTOR
	JMS VOUT
	JMP VA	/BACK FOR MORE VECTORS

/THIS IS THE ROUTINE WHICH ACTUALLY EXECUTES THE
/STROKES, POINT DISPLAYS, AND OTHER FUNCTIONS FOR
/THE KV8/I CONTROLLER...
/DISPLAY OUTPUT AUTO SEQUENCING ROUTINE:
VOUT,	0
	6071
	JMP .-1
VSTATE, 6064	/AUTO SEQUENCED INSTRUCTION
	ISZ VSTATE	/SEQUENCE
	CLA
	JMP I VOUT
C6064,	6064	/INITIALIZED TO LOAD X


/THE FOLLOWING ROUTINE EXECUTES THE "TAB" FUNCTION
/OF MOVING ALONG THE LINE TO THE NEXT TAB STOP.
/TAB STOPS ARE LOCATED EVERY 10 SPACES ALONG
/THE LINE FROM THE LEFT MARGIN.
TAB,	TAD TABHD	/ADVANCE X0.
	DCA A

TAB1,	ISZ A		/TO NEXT TAB STOP.
	TAD I A
	SNA		/END OF LIST=END OF LINE SO DO CRLF.
	JMP CR

	CIA
	TAD X0		/TEST X0 WITH THE TAB STOP LIST.
	SMA CLA
	JMP TAB1	/NOT BIG ENOUGH SO TRY AGAIN.

	TAD I A 	/O.K.	SET THE TAB AND RESET INTEGRATORS.
	JMP XCUTE

TABHD,	TABS-1	/HEAD OF TAB STOP TABLE..
/THE FOLLOWING IS THE ACTUAL "TABS STOP" LIST:

TABS=.
MARGIN, -440	/	/LEFTMOST TAB IS SPECIAL LEFT MARG FOR THIS PROG
	-252
	-144
	-36
	50
	156
	264

	0	/ZERO ENDS THE LIST..

/THE FOLLOWING "SEARCH" ROUTINE CHECKS THE INPUT
/ASCII CODE AGAINST THE "ACTIVE" CONTROL CHARACTERS.
SEARCH, 0	/SEARCH ROUTINE.
	DCA SAVE1	/SAVE THE INPUT ASCII CHARACTER
	TAD SRCH3
	DCA PTR

SRCH2,	ISZ PTR /FOLLOW ALONG DOWN THE CHARACTER TABLE.
	TAD I PTR	/BRING IN A LIST ELEMENT
	SNA
	JMP I SEARCH	/END OF TABLE FOUND AND NO MATCH!

	CIA	/COMPLEMENT TO TEST.
	ISZ PTR
	TAD SAVE1	/NOW TEST AGAINST THE "CHAR".
	SZA CLA
	JMP SRCH2	/NO MATCH FOUND SO TRY AGAIN!

	TAD I PTR	/"MATCH FOUND" !!
	DCA SEARCH	/DO DOUBLE INDIRECT JUMP
	JMP I SEARCH	/FROM DLIST POINTER.

/CONSTANTS FOR THE ABOVE
PTR,	0	/TEMP POINTER CELL USED IN "SEARCH" ROUTINE.
SAVE1,	0	/TEMP STORAGE AREA.
SRCH3,	DLIST-1 /BEGINNING OF THE CONTROL CHAR. TEST LIST.

DLIST=. /TABLE OF ACTIVE CONTROL CHARACTERS.
	215
	CR	/CARRIAGE RETURN
	213
	VERTAB	/VERTAB FUNCTION OF ERASE AND RESET INTEGRATORS.
	377
	DSPYI	/RUB OUT (IGNORED)
	375
	DSPYI	/ALT MODE KEY (IGNORED)
	211
	TAB	/HT
	"Z-100
	MEXIT		/CTRL Z GOES TO MEXIT
	237
	SYNC	/SYNC (CTRL/SHIFT/O) FUNCTION TO STABLIZE.

	0	/ZERO ENDS THE LIST....

/THE FOLLOWING PARTS ARE THE CHARACTER TABLES FOR THE CHARACTER
/GENERATOR .

/CHARACTER MASK COORDINATES


MASK0,	0301	/D,J,5,&,%,
2143
4145
2705
0747
0301
MASK1,	0701	/L,U,V,W,X,Y,I,T,N,M,0,1,(,),
0706
2447
2724
2141
0147
MASK2,	0141	/2,S,4,9,7,Z,$,/, ,<,>
0747
4404
0747
0141
2127
MASK3,	0424	/A,C,E,F,G,H,K,0,Q,R,P,3,6,8,L,B
3444
4147
0701
4144
2404
MASK4,	2622	/ ,B.A.,-,+,*
4305
4503
0426
4404


MASK5,	4525	/@,#,=
0503
2343
4721
2707
0141
MASK6,	0627	/",',;,:,?,!,,,
2525
4524
2323
1121
2147


/PART OF GETTING OUT DEVICE STUFF

SETKV8, TAD (DSPY
	DCA PTOPUT
	DCA N		/WIDE OPTION IS DEFAULT
	TAD ("K-100
	JMS I (DSPY	/CLEAR SCOPE
	JMP LABGY

	*4000	/PUT HERE, TO SAVE A BLOCK ON SYS DEV...
SAR=.	/CHARACTER DISPATCH TABLE
7745	/@
6347
5603	/A
4760
7703	/B
2175
7003	/C
0170
7700	/D
3551
5603	/E
5170
5403	/F
5160
7603	/G
0176
5203	/H
4760
5201	/I
1156
7000	/J
5404
6503	/K
6172
6003	/L
0070
7401	/M
3304
7001	/N
3005
7403	/O
0370
7403	/P
4560
7603	/Q
2370
7503	/R
4572
7602	/S
6360
5001	/T
1150
7001	/U
6005
6001	/V
4011
7401	/W
6205
5001	/X
1007
6401	/Y
1330
7002	/Z
0074
7001	/
0154
4002	/
0044
7000	/
3050
5404	/
6070
6404	/B.A.
2074


0000	/SP
7000	/EXECUTE 3 "INVISIBLE" VECTOR STROKES.
5006	/!
2046
5006	/"
3201
5245	/#
5572
7642	/$
6363
6740	/%
1675
6760	/&
3637
4006	/'
3000
6001	/(
0124
6001	/)
1202
5204	/*
7700
5004	/+
6014
4006	/,
0030
4004	/-
0014
4006	/.
0060
4002	//
4400
7601	/0
3107
6401	/1
0456
7602	/2
1714
5503	/3
4770
6402	/4
0364
7600	/5
3434
7603	/6
0175
6002	/7
0070
5703	/8
4770
7402	/9
0364
5006	/:
1460
5006	/;
1430
6002	/<
2120
5005	/=
5500
6002	/>
4240
7506	/?
6346
/THIS IS THE LAST OF THE CHARACTER DISPATCH TABLE.....



END=.
	>
	XLIST 0

$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search