/CONVEX				EDITED 10/8/73
/COPYRIGHT 1972, 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
/	AUTHOR: ANONYMOUS
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/

	FIXMRI CALL=4400
	FIXMRI EXIT=5400
	FIXMRI INCR=2000
	*100
NAME,	0		/DUMMY WC FOR NAME
NAM1,	0		/SET UP BY CALLS TO "SCAN", AMONG OTHER THINGS
NAM2,	0
NAM3,	0
NAMEXT,	0		/FOR USE BY DIRECTORY STUFF
	DIRECT=3400
DBLOCK,	0
PDCNT,	DIRECT
PDORG,	DIRECT+1
PDLINK,	DIRECT+2
PDWSTE,	DIRECT+4
	P77=20
	KGETC=24
	KPUTC=25
	KRDOIO=26
	KCDOIO=27
	LENGTH=44
	LPOCHR=35
	P7=40
	M1=45
	W0=46
	W1=47
	W2=50
	W3=51
	W4=52
	W5=53
	P70=65
	L7600=70
	KINIT=72
	KFINI=75
	KSPLIT=76
	SYSHND=77
	AC7777=STA
	AC7776=CLA CMA CLL RAL
	AC7775=CLA CMA CLL RTL
	AC0001=CLA IAC
	AC0002=CLA CLL CML RTL
	AC2000=CLA STL RTR
	AC4000=CLA STL RAR
/	KPUTC DOESN'T PUT IN WC *******

TABSET,	-10
ETMP,	0
EPTR,	0
DAVICE,	0
FILSZ,	0
UNIT,	0
	M4=66
	KMOVE=23
	OUTBUF=4000
	INBUF=0
OUTMODE,0
INMODE,	0
LINENO,	0
TEMP,	0
HNDLRI,	0
HNDLRO,	0		/ADDR OF OUTPUT HANDLER
BLOCKI,	0		/INPUT BLOCK (ON TAPE)
BLOCKO,	0
CHRKNT,	-1
CHKNT,	-1
	KPTRST=43
SYSBLK,	0
GLOC,	0		/PTS TO IZERO (TRY UNIT)
	IZERO=63
QINITI,	0	/ADDR OF INIT ROUTINE FOR INPUT
QINITO,	0
QFINII,	0		/ADDR OF FINI ROUTINE FOR INPUT
QFINIO,	0
	INBUFL=3000	/INPUT LINE BUFFER
	OUTBFL=3400	/OUTPUT LINE BUFFER (BOTH 512 CHARS)
BLKLEN,	0
TADR,	0
	TTOCHR=31
NKNT,	0
DEVNAM,	0
GTCHR,	0
PUTCHR,	0
INSIZE,	0		/NO. OF BLOCKS OF INPUT
			/ROUNDED UP TO NEAREST 10
			/ASSUMED HOLDING PS/8 CHARS
INLN,	0
OUTSIZE,0
PATCHB,	0
	STA
	TAD CHRKNT
	DCA CHRKNT
	CDF 0
	EXIT PATCHB

/3000	INBUFL			2 PAGES
/3400	OUTBFL/DIRECTORY	2 PAGES
/	FIELD 1
/0000	INPUT BUFFER	2K	INBUF
/4000	OUTPUT BUFFER	2K	OUTBUF
/MODE	CODE	MEANING
/D	0	COS DATA FILE
/A	1	OS/8 ASCII FILE
/S	2	COS SOURCE FILE

	*200
START,	CLA
	TAD IZERO
	DCA GLOC	/SAVE PTR TO IZERO
	TAD I (7774
	DCA SYSHND
	CLA IAC
	CALL KCDOIO
	VERSE-1
	JMP .-3
RESTRT,	CALL [TYPE
	INMES		/INPUT MODE
	JMS GETMOD
	JMP RESTRT
	DCA INMODE
	DCA OUTMODE
	TAD (INITIN
	TAD INMODE
	JMS IND
	DCA QINITI
	TAD (GETRTN
	TAD INMODE
	JMS IND
	DCA GTCHR
	TAD (ENDIN
	TAD INMODE
	JMS IND
	DCA QFINII
	CALL QINITI
OUTSTRT,CALL [TYPE
	OUTMES		/OUTPUT MODE
	JMS GETMOD
	JMP OUTSTRT
	DCA OUTMODE
	TAD (INITOUT
	TAD OUTMODE
	JMS IND
	DCA QINITO
	TAD (PUTRTN
	TAD OUTMODE
	JMS IND
	DCA PUTCHR
	TAD (ENDOUT
	TAD OUTMODE
	JMS IND
	DCA QFINIO
	CALL QINITO
GETCHA,	CALL GTCHR
	JMP END		/END OF INPUT DATA
	CALL PUTCHR
	JMP GETCHA
END,	CALL QFINIO
	CALL QFINII
	JMP RESTRT

IND,	0
	DCA TEMP
	TAD I TEMP
	EXIT IND
GETMOD,	0
	CALL [GETCHR
	TAD (-42	/A
	SNA
	JMP ITSA
	TAD (42-45
	SNA		/D
	JMP ITSD
	TAD (45-64	/S
	SZA CLA
	EXIT GETMOD
ITSS,	IAC
ITSA,	IAC
ITSD,	INCR GETMOD
	EXIT GETMOD

GETRTN,	GETCOS
	GETOS8
	GETFIL
PUTRTN,	PUTCOS
	PUTOS8
	PUTFIL
INITIN,	INITDI
	INITAI
	INITSI
INITOUT,INITDO
	INITAO
	INITSO
ENDIN,	DIFINI
	AIFINI
	SIFINI
ENDOUT,	DOFINI
	AOFINI
	SOFINI
	PAGE

/GET COS DATA FILE USING RDOIO AND GETC
GETCOS,	0
	TAD LFLAG
	SNA CLA
	JMS COSRD	/NEED NEW RECORD
	TAD (INBUFL
	CALL KGETC	/GET NEXT CHAR
CHRPTR,	0
	INCR GETCOS
	SNA
	JMP COSEOL	/END OF LINE
	INCR CHRPTR	/BUMP PTR
	TAD (-75
	SNA		/IS IT TAB?
	TAD (11-37-75	/YES
	TAD (37+75	/NO, CONVERT TO ASCII
	AND [177
	EXIT GETCOS	/RETURN 2
LFLAG,	0		/0 MEANS MUST READ NEW LINE
COSEOL,	DCA LFLAG
	EXIT GETCOS	/RETURN 2 WITH 0 IN AC
COSRD,	0
	TAD (-1000
	DCA LENGTH
	CLA IAC		/FIELD 0, IFN 1
	CALL KRDOIO
	INBUFL-1
	EXIT GETCOS	/END OF FILE, RET 1 TO GETCOS
/	TAD INMODE
	DCA CHRPTR	/SET FIRST CHAR (0 OR 2)
	INCR LFLAG
	EXIT COSRD
/INMODE -	0	COS DATA FILE
/	-	1	OS8 ASCII FILE
/	-	2	COS SOURCE FILE

DEVTBL,	-4565;6610	/DT
	-4554;6410	/DK
	0
/	-CHAR1,CHAR2; ADDR OF HANDLER

/PUT COS DATA FILE USING RDOIO AND PUTC
PUTCOS,	0
	AND [177
	SNA
	JMP PEOL	/END OF LINE
	JMS TCHAR
	EXIT PUTCOS
	JMS PTC
	EXIT PUTCOS
TCHAR,	0
	TAD (-177
	SNA
	EXIT TCHAR	/IGNORE RUBOUT
	TAD (177-15
	SNA
	EXIT TCHAR	/IGNORE CARRIAGE RETURN
	IAC
	SNA
	EXIT TCHAR	/IGNORE FORM FEED
	IAC
	SNA
	EXIT TCHAR	/IGNORE VERTICAL TAB
	TAD (13-137
	SNA
	TAD (74-137	/CONVERT _ TO LT
	TAD (137-11
	SNA
	JMP TAB		/CONVERT TAB TO SPACES
	TAD (11-173
	SMA
	JMP BADCHR	/ GT 372 IS BAD
	TAD (173-141
	SMA
	TAD [-40	/CONVERT LC TO UC
	TAD (141-40
	SPA
	JMP BADCHR	/LT 300 IS BAD
	IAC		/CONVERT TO -237
	INCR TCHAR
	EXIT TCHAR
PTC,	0
	CALL KPUTC
POUTBFL,OUTBFL
OUTPTR,	0
	INCR OUTPTR
	EXIT PTC

BADCHR,	CLA IAC
	CALL KCDOIO
	BDCHR-1
M1000,	NOP
	EXIT TCHAR
PEOL,	TAD M1000
	DCA LENGTH
	TAD OUTPTR
	IAC
	CLL RAR
	CIA
	SNA
	EXIT PUTCOS
	DCA I POUTBFL
	DCA OUTPTR
	STL CLA RTL	/FIELD 0, IFN2
	CALL KRDOIO
	OUTBFL-1
	JMS TUBA
	EXIT PUTCOS
TAB,	CLA IAC
	JMS PTC		/INSERT A SPACE
	TAD OUTPTR
	AND P7
	SZA CLA
	JMP TAB
	EXIT PUTCOS
TUBA,	0
	CLA IAC
	CALL KCDOIO
	TOOBIG-1	/LINE TOO BIG
	JMP .-3
	EXIT TUBA
	PAGE

/GET OS8 FILE
GETOS8,	0
	CDF 10
	JMP I PX
PX,	CHR1
WORD1,	INBUF
WORD2,	INBUF+1
CHR1,	TAD (CHR2
	DCA PX
	ISZ CHRKNT
	SKP
	JMS RDMORE
	TAD I WORD1	/GET WORD 1
	JMP TEST
CHR2,	TAD (CHR3
	DCA PX
	TAD I WORD2	/GET WORD 2
	JMP TEST
CHR3,	TAD (CHR1
	DCA PX
	TAD I WORD2	/GET LOWER HALF WORD 3
	AND [7400
	CLL RTR
	RTR
	DCA GTEMP
	TAD I WORD1	/GET UPPER HALF WORD 3
	AND [7400
	TAD GTEMP
	RTR
	RTR		/COMBINE
	INCR WORD1
	INCR WORD1
	INCR WORD2
	INCR WORD2
TEST,	AND [177
	SNA
	JMP I PX	/IGNORE LEADER OR NULL
	TAD (-15
	SNA
	JMP I PX	/IGNORE CR
	TAD (15-12
	SNA		/LINE FEED GOES TO ZERO (INDICATES EOL)
	JMP LVOSM
	TAD (12-32
	SNA
	JMP LVOS	/CTRL/Z IS END OF DATA
	TAD (32	/RESTORE
LVOSM,	INCR GETOS8
LVOS,	CDF 0
	EXIT GETOS8	/RETURN WITH CHAR IN AC
GTEMP,	0

RDMORE,	0
	CDF 0
	ISZ INLN
	SKP
	JMP ENDOFIN
	TAD BLOCKI
	CALL KSPLIT
	CALL HNDLRI
ARG1,	2010		/READ 10 BLOCKS FROM FIELD 1
	INBUF
	0		/SET BY SPLIT
	TAD BLOCKI
	TAD (10
	DCA BLOCKI	/READ 10 BLOCKS AT A TIME
	JMS ISET
	CDF 10
	EXIT RDMORE
ISET,	0
	TAD (INBUF
	DCA WORD1
	TAD (INBUF+1
	DCA WORD2
	TAD (-2000	/(LENGTH)
	DCA CHRKNT
	EXIT ISET
ENDOFIN,CLA IAC
	CALL KCDOIO
	NOEND-1
	JMP ENDOFIN
	JMP I [END

ENTIER,	0
	CLL
	TAD OUTSIZE
	TAD (-1540
	SZL CLA		/50 HUNKS
	JMP WOW
	TAD OUTSIZE
ENTRY,	CALL (ENTER
	JMP NORO	/NO ROOM
	INCR ENTIER	/OK
	EXIT ENTIER
NORO,	TAD OUTSIZE
	TAD (-20
	DCA OUTSIZE
	TAD OUTSIZE
	SMA SZA
	JMP ENTRY
	CLA IAC
	CALL KCDOIO
	NORM-1
	NOP
	EXIT ENTIER
WOW,	TAD (1540
	DCA OUTSIZE
	TAD OUTSIZE
	JMP ENTRY
	PAGE

PTEM,	0
PUTOS8,	0
	DCA PTEM
	CDF 10
	JMP I PY
PY,	CH1
WD1,	OUTBUF
WD2,	OUTBUF+1
CH1,	TAD (CH2
	DCA PY
	JMS CNV
	DCA I WD1
	JMP LV
CH2,	TAD (CH3
	DCA PY
	JMS CNV
	DCA I WD2
	JMP LV
CH3,	TAD (CH1
	DCA PY
	JMS CNV
	DCA PTEM
	TAD PTEM
	RTL
	RTL
	AND [7400
	TAD I WD1
	DCA I WD1
	TAD PTEM
	RAR
	RTR
	RTR
	AND [7400
	TAD I WD2
	DCA I WD2
	INCR WD1
	INCR WD1
	NOP
	INCR WD2
	NOP
	INCR WD2
	ISZ CHKNT
	SKP
	JMS WTMORE
LV,	CDF 0
	EXIT PUTOS8

CNV,	0
	TAD PTEM
	SZA
	EXIT CNV
	TAD PUTOS8
	DCA SVRET	/SAVE RET ADDR
	TAD (NEWRET
	DCA PUTOS8
	TAD (215	/OUTPUT CR
	EXIT CNV
NEWRET,	TAD SVRET
	DCA PUTOS8
	TAD (212
	JMP PUTOS8+1
SVRET,	0

WTMORE,	0
	CDF 0
	TAD BLOCKO
	CALL KSPLIT
	CALL HNDLRO
ARG2,	6010		/WRITE 10 BLOCKS FIELD 1
	OUTBUF
	0
	TAD BLOCKO
	TAD (10
	DCA BLOCKO
	TAD CHKNT
	SZA CLA
	EXIT WTMORE	/FINI
	JMS OSET
	ISZ BLKLEN	/AT END OF FILE?
	SKP		/NO
	CALL (INITAO	/YES, INIT A NEW OUTPUT FILE
	CDF 10
	EXIT WTMORE
OSET,	0
	TAD (OUTBUF
	DCA WD1
	TAD (OUTBUF+1
	DCA WD2
	TAD (-2000	/
	DCA CHKNT
	EXIT OSET
DEVERR,	-4
	4546
	6701
	4663
	6300
/DEV ERR
	PAGE

/SR SET UP NAM1-NAM4 TO HOLD NAME + EXTENSION
/ROUTINE TO DO LOOKUPS ON PS/8 DIRECTORIES
/CALL:
/JMS LOOKUP
/POINTER-1 TO NAME
/NOT FOUND RETURN
/FOUND RETURN, ST. BLK. # IN AC, LENGTH IN "FILSZ"
/(IN 400 WD BLOCKS)
/
/PROGRAM MUST HAVE PREVIOUSLY SET UP:
/UNIT=PHYSICAL UNIT #
/DAVICE=DEVICE HANDLER ADDRESS
/DBLOCK=0
/DIRECT=ADDRESS OF WHERE TO PUT THE DIRECTORY BLOCK READ IN (FIELD 0)
/
	XR=10
	XR1=12
	XR2=11
LOOKUP,	0
/	DCA	DBLOCK
	TAD I	LOOKUP
	DCA	PTNAME
	ISZ	LOOKUP
	JMS	MRDCAT
	JMS	MDSRCH
	JMP I	LOOKUP
	TAD	SBLOCK
	CIA
	TAD I	PDORG
	ISZ	LOOKUP
	JMP I	LOOKUP
/
MRDCAT,	0
	SZA
	JMP	MRDREN
	DCA	SBLOCK
	DCA	FILSZ
	CLA IAC
MRDREN,	TAD	DAVICE		/FORM A UNIQUE VALUE FOR EACH DEVICE'S DIRECTORY BLOCKS
	CIA
	TAD	DBLOCK
	SNA
	JMP	INLRDY
	CIA
	TAD	DBLOCK
	DCA	DBLOCK
	JMS	MREADC
INLRDY,	TAD I	PDCNT
	DCA	NFILES
	TAD	PDWSTE
	DCA	XR
	JMP I	MRDCAT

MDSRCH,	0
FSRCLP,	TAD	PTNAME
	DCA	XR2
	TAD	M4
	DCA	CT
	TAD I	XR
	SNA
	JMP	SKPMTF
	SKP
SRCWDL,	TAD I	XR
	CIA
	TAD I	XR2
	SZA CLA
	JMP	NXTFIL
	ISZ	CT
	JMP	SRCWDL
	JMS	BUMPXR
	TAD I	XR
	SNA
	JMP	SKPMTF+1
	CIA			/MAKE +
	DCA	FILSZ
	ISZ	MDSRCH
	JMP I	MDSRCH
NXTFIL,	TAD	CT
	IAC
	JMS	BUMPXR
SKPMTF,	TAD I	XR
	TAD	SBLOCK
	DCA	SBLOCK
	ISZ	NFILES
	JMP	FSRCLP
	DCA	SBLOCK
	TAD I	PDLINK
	SZA
	JMP	MRDREN
	JMP I	MDSRCH
/
BUMPXR,	0
	TAD I	PDWSTE
	CIA
	TAD	XR
	DCA	XR
	JMP I	BUMPXR

MREADC,	0
	TAD	(200
	TAD	UNIT
	DCA	DIOCTL
	TAD	DBLOCK
	AND	P7
	JMS I	KSPLIT
	JMS I	DAVICE
DIOCTL,	0
	DIRECT
	0
	TAD I	PDCNT		/QUICK CHECK FOR LEGAL DIRECTORY
	TAD	(100
	SPA CLA
	AC2000			/MAKE NEXT TEST FAIL
	TAD I	PDLINK
	AND	TABSET		/7770 IN DISGUISE
	SNA CLA
	JMP I	MREADC
	CLA IAC
	CALL KCDOIO
	BADDIR-1
L12,	12
	JMP I [RESTRT
/
SBLOCK,	0
CT,	0
NFILES,	0
PTNAME,	0
MEOVLS,	ZBLOCK 7		/SCRATCH SPACE USED BY DIRECTORY EXPANSION ROUTINE
/
DIGIT,	0
	CALL (GETCHR
	SNA
	JMP I (LVD
	TAD (-33
	CLL
	TAD L12
	SZL
	EXIT DIGIT	/RETURN WITH DEC DIGIT IN AC
	CLA
	JMP I (BADFL	/BAD DIGIT
	PAGE

PURGE,	0
	JMS I	(LOOKUP
	NAM1-1
	JMP I	PURGE
	CLA
	AC0001
	JMS I	KCDOIO
	REPL-1	
K0123,	0123
	JMS	I (GETYES
	SZA CLA
	JMP I (LVENT
DOPUR,	ISZ	PURGE
	AC7776
	TAD	XR
	DCA	XR
	TAD	XR
	DCA	XR2
	DCA I	XR2
	AC7775
	TAD I	PDWSTE
	JMS	SQUISH
	JMS	CONSOL
	AC4000
	JMS I	(MREADC
	JMP I	PURGE
CONSOL,	0
	TAD	PDWSTE
	DCA	XR
	TAD I	PDCNT
	DCA	XR2
CONLP,	TAD I	XR
	SNA CLA
	JMP	PEMPTY
PSKIPF,	TAD	M4
	JMS I	(BUMPXR
	ISZ	XR2
	JMP	CONLP
	JMP I	CONSOL

PEMPTY,	ISZ	XR
	TAD	XR
	DCA	PTMP
	ISZ	XR2
	SKP
	JMP I	CONSOL
	TAD I	XR
	SZA CLA
	JMP	PSKIPF
	TAD I	XR
	TAD I	PTMP
	DCA I	PTMP
	AC7776
	JMS	SQUISH
	ISZ I	PDCNT
	JMP	CONSOL+1
SQUISH,	0
	TAD	XR
	DCA	XR1
SQLOOP,	TAD I	XR
	DCA I	XR1
	TAD	XR
	TAD	(-DIRECT-377
	SZA CLA
	JMP	SQLOOP
	JMP I	SQUISH
PTMP,	0
/
PUT,	0
	CALL KPUTC
	NAME
NMKNT,	0
	INCR NMKNT
	EXIT PUT

DFLNAM,0
	TAD (-7
	DCA NKNT
	DCA NMKNT
DFLOOP,	CALL (GETCHR
	SNA
	JMP SLSH	/END OF NAME, NO UNIT
	TAD (-20
	SNA
	JMP SLSH	/FOUND SLASH
	TAD (20		/RESTORE CHAR
	JMS PUT
	ISZ NKNT
	JMP DFLOOP
BADFL,	EXIT DFLNAM	/NAME TOO LONG
SLSH,	ISZ NKNT
	SKP
	JMP GETUNIT
	CLA IAC
	JMS PUT		/PAD WITH BLANKS
	JMP SLSH
GETUNIT,DCA UNIT
	CALL (DIGIT
	DCA UNIT
	CALL (DIGIT
	DCA TEMM
	TAD UNIT
	CLL RTL		/X4
	TAD UNIT	/X5
	CLL RAL		/10
	TAD TEMM
	DCA UNIT
	TAD UNIT
	AND (7760
	SZA CLA
	DCA UNIT	/UNIT TOO BIG
LVD,	INCR DFLNAM
	TAD UNIT
	DCA I GLOC
	EXIT DFLNAM
TEMM,	0
	PAGE

/TAD	(LENGTH OF FILE
/JMS	ENTER
/<ERROR RETURN>	/REFUSE TO REPLACE OR NO ROOM
/DONE, BLK # IN AC
/
ENTER,	0
	DCA	ELENGT
	DCA	DBLOCK		/FIX CATASTROPHIC BUG
	JMS I	(PURGE
	NOP
RENTER,	JMS I	(MRDCAT
	TAD	((0))
	DCA	EPTR
	DCA	EBLOCK
ELOOP,	TAD I	XR
	SNA CLA
	JMP	EMPTY
	AC7775
	JMS I	(BUMPXR
	TAD I	XR
ELEND,	TAD	EBLOCK
	DCA	EBLOCK
	ISZ I	(NFILES
	JMP	ELOOP
	TAD	XR
	DCA	ETMP
	TAD I	EPTR
	SZA
	JMP	EINSRT
	TAD I	PDLINK
	SZA
	JMP I	(MRDREN
	JMP	NOSPAC
/
EMPTY,	TAD I	XR
	DCA	ETMP
	CLA CLL CMA
	TAD	ETMP
	TAD	ELENGT
	SZL CLA
	TAD	ETMP
	CIA CLL
	TAD I	EPTR
	SZL CLA
	JMP	ENOGD
	TAD	XR
	DCA	EPTR
	TAD	EBLOCK
	DCA	EBLK
ENOGD,	TAD	ETMP
	JMP	ELEND

EINSRT,	TAD	ELENGT
	SNA CLA	/IF JUST FITS, DELETE HOLE
	AC0002
	TAD	M4
	JMS I	(BUMPXR
	TAD I	PDWSTE
	CIA
	TAD	XR
	TAD	(-DIRECT-372
	SMA CLA
	JMP I	(MEOVLP		/GOT TO EXPAND DIRECTORY
	JMS	MOVEUP
EMDONE,	TAD I	EPTR
	TAD	ELENGT
	SZA
	DCA I	XR
	CLA CMA
	TAD	ETMP
	DCA	XR
	TAD	NAM1
	DCA I	XR
	TAD	NAM2
	DCA I	XR
	TAD	NAM3
	DCA I	XR
	TAD	NAMEXT
	DCA I	XR
	TAD I	M1		/GET DATE
	DCA I	XR
	IAC
	JMS I	(BUMPXR
	TAD	ELENGT
	CIA
	DCA I	XR
	TAD I	XR
	SNA CLA
	CLA CMA
	TAD I	PDCNT
	DCA I	PDCNT
	CLA CLL CML RAR
	JMS I	(MREADC
	TAD	EBLK
	CIA
	TAD I	PDORG
	INCR ENTER
LVENT,	JMP I	ENTER
EBLOCK,	0
EBLK,	0

MOVEUP,	0
EMLOOP,	TAD I	ETMP
	DCA I	XR
	TAD	ETMP
	CMA
	TAD	EPTR
	SNA CLA
	JMP I	MOVEUP
	CLA CMA
	TAD	ETMP
	DCA	ETMP
	AC7776
	TAD	XR
	DCA	XR
	JMP	EMLOOP
NOSPAC,	JMP I ENTER
/NOSPAC,	CLA IAC
/	CALL KCDOIO
/	NORM-1
/	NOP
/	JMP LVENT
ELENGT,	0
/
	PAGE

/DIRECTORY EXPANSION ROUTINE
/CALLED IN MOMENTS OF EXTREME DURESS
/ADDS ANOTHER BLOCK TO THE LINKED DIRECTORY (IN THEORY, AT LEAST)
/
MEOVLP,	TAD I	PDLINK
	SNA CLA		/ANY SEGMENTS AFTER THIS ONE?
	JMP	MELAST	/LAST ONE, MUST CREATE ANOTHER (PAIN AND AGONY)
	ISZ I	PDCNT	/BUMP ENTRY COUNT DOWN
	CLA CLL CML RAR
	JMS I	(MREADC		/WRITE OUT THIS SEGMENT
	JMS	MSKIPF		/FIND END OF SHORTENED DIRECTORY
	DCA	MEFCNT		/PREPARE TO TRANSFER LAST ENTRY
	TAD	(MEOVLS-1
	DCA	XR1		/INTO NEXT DIRECTORY SEGMENT
	TAD I	XR
	DCA I	XR1
	ISZ	MEFCNT
	TAD	XR
	CIA
	TAD	ETMP		/ETMP WAS SET UP BY ENTER
	SZA CLA			/(IT SAYS HERE IN FINE PRINT...)
	JMP	.-7
	TAD I	ETMP		/GET LENGTH OF MOVED ENTRY
	DCA	MEOCNT
	TAD I	PDLINK
	JMS I	(MRDCAT		/READ NEXT SEGMENT
	JMS I	(CONSOL		/MAKE SURE IT IS AT ITS SMALLEST
	TAD I	PDORG
	TAD	MEOCNT
	DCA I	PDORG		/BUMP FILE ORIGIN DOWN
	JMS	MSKIPF		/FIND LAST LOC IN NEW SEGMENT
	TAD	XR
	DCA	ETMP
	CLA CMA
	TAD	XR
	TAD	MEFCNT
	DCA	XR		/PREPARE TO PUSH ALL ENTRIES UP
	TAD	(DIRECT+6
	DCA	EPTR

	JMS I	(MOVEUP
	TAD	(MEOVLS-1
	DCA	XR		/PREPARE TO MOVE THE SAVED ENTRY
	CLA CMA			/INTO THE NEW SEGMENT
	TAD I	PDCNT
	DCA I	PDCNT		/INCREASE ENTRY COUNT OF NEW SEGMENT
	TAD	MEFCNT
	CIA
MECOMN,	DCA	MEFCNT		/STORE NUMBER OF WORDS TO MOVE
	TAD	PDWSTE
	DCA	XR1
	TAD I	XR
	DCA I	XR1
	ISZ	MEFCNT
	JMP	.-3		/MOVE THE ENTRY IN
	JMS	MSKIPF
	TAD	XR
	DCA	ETMP		/ETMP= LAST LOC IN SEGMENT
	JMS I	(BUMPXR
	TAD	XR
	TAD	(-DIRECT-372
	SMA CLA			/HAVE WE MADE THE SEGMENT TOO BIG?
	JMP	MEOVLP		/YES - LOOP UNTIL WE GET IT RIGHT
	CLA CLL CML RAR
	JMS I	(MREADC		/WRITE OUT SEGMENT
	JMP I	(RENTER		/AND CONTINUE WITH ENTER

MELAST,	TAD I	PDCNT
	CLL CML RAR		/GIVE THE NEW SEGMENT HALF THE OLD ENTRIES
	DCA	EPTR		/LENGTH OF NEW SEGMENT
	TAD	EPTR
	CIA
	TAD I	PDCNT
	DCA I	PDCNT		/ADJUST LENGTH OF OLD SEGMENT
	JMS	MSKIPF		/FIND BOUNDARY LOC BETWEEN SEGS
	TAD	DBLOCK
	AND	P7
	IAC
	DCA I	PDLINK		/LINK THE OLD SEGMENT TO THE NEW
	TAD I	PDLINK
	TAD	(-7
	SMA CLA
	JMP I	(NOSPAC		/PROVIDED THERE IS ROOM FOR ANOTHER
	CLA CLL CML RAR
	JMS I	(MREADC		/WRITE OUT NEXT-TO-LAST SEG
	ISZ	DBLOCK
	TAD	EPTR
	DCA I	PDCNT
	TAD	MEOCNT
	CIA
	TAD I	PDORG
	DCA I	PDORG		/SET UP PARAMS FOR NEW SEG
	DCA I	PDLINK		/MARK IT AS THE NEW LAST SEGMENT
	TAD	XR
	TAD	(-DIRECT-377	/SET UP COUNT OF WORDS TO SLIDE DOWN
	JMP	MECOMN		/USE COMMON SLIDING CODE, & EXIT

MSKIPF,	0			/SUBR TO FIND LAST LOC USED IN SEGMENT
	TAD I	PDCNT		/AND ALSO FINDS # OF BLOCKS USED BY SEG
	DCA	MNOFIL
	TAD	PDWSTE
	DCA	XR
	DCA	MEOCNT
MSKPLP,	TAD I	XR
	SNA CLA			/EMPTY ENTRY?
	JMP	MEOMTY		/IT SURE IS
	AC7775
	JMS I	(BUMPXR		/POINT TO LENGTH WORD OF FILE YNTRY
MEOMTY,	TAD I	XR
	TAD	MEOCNT		/GET LENGTH
	DCA	MEOCNT		/& ANDD IT UP
	ISZ	MNOFIL
	JMP	MSKPLP
	JMP I	MSKIPF
MEFCNT,	0
MEOCNT,	0
MNOFIL,	0
/
	PAGE

GETYES,	0
	TAD M4
	DCA LENGTH
	CALL KCDOIO
	MEOVLS-1
KNOP,	NOP
	TAD KNOP
	DCA LENGTH
	TAD I [MEOVLS+1
	AND [7700
	TAD [-7200
	EXIT GETYES
REPL,	-4		/REPLACE?
	6346
	6155
	4244
	4640
BADDIR,	-7
	4342
	4501
	4552
	6346
	4465
	6063
	7200
NORM,	-4	/"NO ROOM"
	5760
	0163
	6060
	5600
BDCHR,	-4
	4342
	4501
	4451
	4263	/"BAD CHAR"
NOEND,	-3	/"NO END" (TO INPUT FILE)
	5760
	0146
	5745

TOOBIG,	-4	/"TOO BIG"
	6560
	6001
	4352
	5000
INMES,	-6	/INPUT MODE -
	5257
	6166
	6501
	5660
	4546
	1600
OUTMES,	-6		/OUTPUT MODE
	6066
	6561
	6665
	0156
	6045
	4616
NOTFND,	-5
	5760		/NOT FOUND
	6501
	4760
	6657
	4500
FILMES,	-5		/FILE NAME-
	4752
	5546
	0157
	4256
	4616
LINBUF,	ZBLOCK 20
VERSE,	-7	/VERSION 3.07
	6746
	6364
	5260
	5701
	2417	/3.
	2130	/07
	0000	/AND ROOM TO PATCHH
NONCE,	-6
	5760	/NONCE ERROR
	5744
	4601
	4663
	6360
	6300

/WHERE SPECIFY UNIT, ETC.????????
SYSINI,	0
/	AC SHOULD CONTAIN LOGICAL UNIT # (0 IS SYSTEM DEVICE)
/RICHIE CLAIMS LOW ORDER BITS IS PHYSICAL UNIT #
	JMS I KPTRST
	TAD I SYSINI
	DCA I W0
	ISZ SYSINI
	TAD I	W0
	AND	P7
	TAD I SYSINI
	ISZ SYSINI
	DCA I W1
	TAD SYSBLK	/
	CLL RAR
	RTR
	RTR
	DCA TEMP
	TAD TEMP
	AND [7400
	DCA I W5
	TAD TEMP
	RAL
	AND [377
	DCA I W4
	DCA I W3
	ISZ SYSINI
	JMP I SYSINI
	PAGE

INITDI,	0		/INIT COS DATA FILE FOR INPUT (IFN 1)
GIN2,	CALL [TYPE
	FILMES
	CALL (DFLNAM
	JMP GIN2	/BAD FILE NAME
	CLA IAC
	CALL KINIT
L2010,	2010		/READ 2K FIELD 1
	0		/0-3777
	NAM1-1
	DCA I GLOC
	CDF 10
	TAD I (6
	CDF 0		/GET LENGTH IN HUNKS
	SNA
	TAD (50		/*** MULTI REEL
	DCA TEMD
	DCA INSIZE
	TAD TEMD
	CLL RTL		/X4
	CLL RTL		/X20
LP,	CLL
	TAD [-3
	INCR INSIZE
	SZL
	JMP LP
	CLA IAC
	TAD INSIZE
	CLL RTL		/X20 X 4/3
	DCA INSIZE
	EXIT INITDI
TEMD,	0

INITDO,	0		/INIT COS DATA FILE FOR OUTPUT (IFN 2)
GOUT2,	CALL [TYPE
	FILMES
	CALL (DFLNAM
	JMP GOUT2
	STL CLA RTL
	CALL KINIT
L6010,	6010	/4000-7777
	4000	/	WRITE 2K FIELD 1
	NAM1-1
	DCA I GLOC
	EXIT INITDO

INITAI,	0		/INIT COS FILE FOR INPUT
GIN,	CALL [TYPE
	FILMES
	CALL (FILNAM
	JMP GIN
	DCA HNDLRI
	TAD HNDLRI
	DCA DAVICE
	TAD L2010
	TAD UNIT
	DCA I [ARG1
	DCA DBLOCK
	CALL (LOOKUP
	NAM1-1
	JMP NOTFN
	DCA BLOCKI
	TAD FILSZ
	DCA INSIZE
	TAD (CHR1
	DCA I (PX
	TAD INSIZE
	CLL RTR
	RAR
	IAC		/BUG FIX FOR V12.28
	CMA
	DCA INLN
	CALL (RDMORE
	JMS PATCHB
	EXIT INITAI
NOTFN,	CLA IAC
	CALL KCDOIO
	NOTFND-1
	JMP NOTFN
	JMP GIN

INITAO,	0
GOUT,	CALL [TYPE
	FILMES
	CALL (FILNAM
	JMP GOUT
	DCA HNDLRO
	TAD HNDLRO
	DCA DAVICE
	TAD L6010
	TAD UNIT
	DCA I (ARG2
	TAD INSIZE	/***
	TAD [10
	AND [7770
	DCA OUTSIZE
	CALL (ENTIER
	JMP GOUT
	DCA BLOCKO
	TAD OUTSIZE
	CLL RAR
	RTR
	CIA
	DCA BLKLEN
	TAD (CH1
	DCA I (PY
	CALL (OSET
	EXIT INITAO

DIFINI,	0
	CLA IAC		/IFN 1
	CALL KFINI
	EXIT DIFINI
DOFINI,	0
	CALL (PUTCOS	/END LINE
	STL CLA RTL	/IFN 2
	CALL KFINI
	EXIT DOFINI
	PAGE

TYPE,	0		/TYPE MESSAGE WITH NO CR & READ ANSWER
	TAD I TYPE
	INCR TYPE
	DCA TADR
	DCA TNUM
	TAD (215	/XRLF
	CALL TTOCHR
	TAD (212
	CALL TTOCHR
TLOOP,	TAD TADR
	CALL KGETC	/GET CHAR
TNUM,	0
	SNA
	JMP READ
	TAD (237	/CONVERT TO ASCII
	CALL TTOCHR	/PRINT ON TTY
	INCR TNUM
	JMP TLOOP	/POINT TO NEXT CHAR
READ,	TAD (-20
	DCA LENGTH	/ANSWER BUFFER IS 20 CHARS
	CALL KCDOIO	/READ REPLY FROM KBD
	LINBUF-1
	NOP
	DCA LINUM	/PT TO FIRST CHAR
	EXIT TYPE
GETCHR,	0
	TAD (LINBUF
	CALL KGETC
LINUM,	0
	INCR LINUM
	EXIT GETCHR

FILNAM,	0
	DCA NAM1	/RETURN 1 IF BAD
	DCA NAM2	/SET UP PHYSICAL UNIT # IN UNIT
	DCA NAM3	/LEAVE HANDLER ADDRESS IN AC
	DCA NAMEXT
	TAD (-7
	DCA NKNT
	DCA I (NMKNT
FLOOP,	JMS GETCHR
	SNA
	JMP SYS		/END OF NAME, NO DEVICE
	TAD (-17
	SNA
	JMP DOT		/READY FOR EXTENSION
	TAD (17-15
	SNA
	JMP COM		/FOUND COMMA
	TAD (15+37	/RESTORE TO SIXBIT
	AND P77
	CALL (PUT
	ISZ NKNT
	JMP FLOOP
	EXIT FILNAM	/NAME OR EXTENSION TOO LONG
DOT,	TAD (-3
	DCA NKNT
	TAD (6
	DCA I (NMKNT
	JMP FLOOP

COM,	JMS GETCHR
	CLL RTL
	RTL
	RTL
	DCA DEVNAM
	JMS GETCHR
	TAD DEVNAM
	DCA DEVNAM
	JMS GETCHR
	TAD (-33
	SMA
	EXIT FILNAM	/BAD PHYSICAL DEVICE
	TAD (33-21
	SPA
	EXIT FILNAM	/"
	DCA UNIT
	X6=16
	TAD (DEVTBL-2
	DCA X6
DLOOP,	INCR X6
	TAD I X6
	SNA
	EXIT FILNAM	/BAD DEV NAME
	TAD DEVNAM
	SZA CLA
	JMP DLOOP
LVV,	INCR FILNAM	/TAKE GOOD RETURN
	TAD (-2
	TAD OUTMODE
	SZA CLA
	JMP .+3
	TAD (0123	/AS
	DCA NAMEXT
	TAD I X6	/GET HANDLER ADDRESS
	EXIT FILNAM
SYS,	DCA UNIT	/UNIT 0
	TAD (SYSHND-1
	DCA X6
	JMP LVV

AOFINI,	0
	TAD (232
	CALL (PUTOS8	/INSERT A CTRL/Z
	CALL (WTMORE
	EXIT AOFINI
AIFINI,	0
	EXIT AIFINI
	PAGE

	0	/INBUFL	(2 PAGES)
	PAGE
	0
	PAGE
	0	/OUTBFL	(2 PAGES)
	PAGE
	0
	PAGE

GETFIL,	0
	HLT
PUTFIL,	0
	AND [177
	SNA
	JMP FEOL	/END OF LINE
	TAD (-11
	SNA
	JMP TB	/TAB IS OK
	TAD (11	/RESTORE
	CALL (TCHAR
	EXIT PUTFIL	/CHARACTER IGNORED
PTCIN,	JMS TPCX
	EXIT PUTFIL
FEOL,	TAD (-120
	DCA LENGTH
	TAD OTPTR
	IAC
	CLL RAR
	CIA
	IAC
	SNA
	EXIT PUTFIL	/NULL LINE
	TAD M1
	DCA I POTB
	CLL
	TAD I POTB
	CIA
	IAC
	TAD TOTSIZ
	DCA TOTSIZ
	SZL
	JMP FULL
	TAD LINENO
	TAD (5
	DCA LINENO	/INCREMENT LINE #
	TAD LINENO
	DCA I (OUTBFL+1
	STL CLA RTL	/FIELD 0, IFN 2
	CALL KRDOIO
	OUTBFL-1
	CALL (TUBA	/LINE TOO BIG
	STL CLA RTL	/2
	DCA OTPTR
	EXIT PUTFIL

TPCX,	0
	CALL KPUTC
POTB,	OUTBFL
OTPTR,	2
	INCR OTPTR
	EXIT TPCX
TB,	TAD (75
	JMP PTCIN
TOTSIZ,	0
FFULL,	-2	/***
	4766
	5555
ERRR,	CLA IAC
	CALL KCDOIO
	DEVERR-1
	JMP .-3
	JMP GOUT3

	GPBUF=41
FULL,	CLA IAC
	CALL KCDOIO
	FFULL-1		/FILE FULL
	JMP FULL
	JMP I [END
SOFINI,	0
	STL CLA RTL	/IFN2
	JMS I KRDOIO
	ZERO-1
	JMS I GPBUF
	EXIT SOFINI
SIFINI,	0
	HLT

INITSO,	0
GOUT3,	CALL [TYPE
	FILMES
	CALL (FILNAM
	JMP GOUT3
	CIA		/COMPL HANDLER ADDRESS
	TAD SYSHND
	SZA CLA
	JMP ERRR	/NOT SYSTEM DEVICE HANDLER
	TAD SYSHND
	DCA DAVICE
	TAD (20
	CALL (ENTER
	JMP GOUT3	/NO ROOM
	DCA SYSBLK
	TAD (6010
	TAD UNIT
	DCA FNW
	STL CLA RTL	/IFN2
	CALL (SYSINI
FNW,	6010		/WRITE 2K FIELD 1
	4000		/4000-7777
	HLT
	STA CLL RAR
	DCA I W2
	STL CLA RAR
	DCA I W3
	STL CLA RTL	/2
	DCA OTPTR
	DCA LINENO
	DCA TOTSIZ
	EXIT INITSO
INITSI,	0
	CLA IAC
	CALL KCDOIO
	NONCE-1
ZERO,	0
	JMP I [RESTRT
	$