/2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975 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.
/
/
/
/
/
/
/
/
/
/
	DTRB=6772
	DTLB=6774
	DTXA=6764
	DTCA=6762
	DTRA=6761
	DTSF=6771


/WRITTEN BY MARK BRAMHALL 1970
/MODIFIED FOR TD8E BY R. LARY 1973
/DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
/
/PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
/
/COMMAND DECODER RULES:
/
/*OUTPUT_INPUT,INPUT,...
/
/OUTPUT IS:
/	DEV:FILE.EXT[NN]
/	DEFAULT DEVICE IS DSK:
/	[NN] IGNORED IF PDP-10 OUTPUT
/	IF /L OR /F DEFAULT OUTPUT IS TTY:
/
/INPUT IS:
/	DEV:FILE.EXT
/	DEFAULT DEVICE IS DSK:
/	FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
/	UP TO NINE (9) INPUT FILES
/
/OPTIONS ARE:
/	/L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
/	/F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
/	/Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
/	/D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
/	/B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
/	/I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
/	/P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)


/	MAINTENACE RELEASE FIXES:

/1.	DATE 75 STUFF
/2.	TD8E RELIABILITY IMPROVEMENTS
/3.	ANSI DATE OUTPUT FORMAT
/4.	INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
/	RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
/	DECTAPES ON A TD8E.
/COMMAND DECODER SETS UP:
/
/AT "MOUTPU" THE LIST--
/	LLL LLL LLD DDD		OR		UUU 100 000 000
/	NAME (TRIMMED)				NAME (EXCESS 40)
/	NAME					NAME
/	NAME					NAME
/	EXTENSION				EXTENSION
/	0					EXTENSION
/
/	OS8 FILE		OR		PDP-10 FILE
/
/WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
/
/AT "MINPUT" THE LIST--
/	LLL LLL LLD DDD		OR		UUU 100 000 000
/	START BLOCK				ANY BLOCK
/
/	OS8 FILE		OR		PDP-10 FILE
/
/THE LIST ENDS WITH A ZERO (0) WORD
/
/AT "MPARAM" THE BLOCK--
/	ABC DEF GHI JKL
/	MNO PQR STU VWX
/	YZ0 123 456 789
/
/WHICH ARE THE OPTION CHARACTERS
/
/THE = CONSTRUCTION IS NOT IMPLEMENTED
/DEFINITIONS

VERSION=	3	/VERSION NUMBER
SUBVER=	01		/PATCH LEVEL
			/LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER

DIRECT=7000		/PDP-10 DIRECTORY BUFFER (FIELD 1)
IBUF10=3000		/PDP-10 INPUT BUFFER (FIELD 1)
INBUF=3000		/OS8 INPUT BUFFER (FIELD 1)
OBUF10=5000		/PDP-10 OUTPUT BUFFER (FIELD 1)
OUBUF=5000		/OS8 OUTPUT BUFFER (FIELD 1)

OUDEVH=7200		/OUTPUT DEVICE (FIELD 0)
INDEVH=6600		/INPUT DEVICE (FIELD 0)

INCTL=1010		/INPUT CONTROL
OUCTL=5010		/OUTPUT CONTROL
INRECS=4		/INPUT RECORDS

MDATE=7666		/MONITOR'S DATE (FIELD 1)

MINPUT=7617		/INPUT LIST (FIELD 1)
MOUTPU=7600		/OUTPUT LIST (FIELD 1)
MPARAM=7643		/PARAMETER LIST (FIELD 1)
JSBITS=7746		/0S8 JOB STATUS BITS

DCB=7760		/DEVICE CONTROL BLOCK (FIELD 1)
PTP=20			/DCB VALUE OF THE PAPER TAPE PUNCH
/PAGE ZERO AND POINTERS

*10

INDEX0,	0		/AUTO-INDEX REGISTERS
INDEX1,	0
INDEX2,	0
INDEX3,	0
INDEX4,	0
INDEX5,	0
INDEX6,	0
IXR,	0		/INPUT LIST INDEX REGISTER

*20

UNIT10,	0		/CURRENT PDP-10 UNIT (U400)

POINT,	0		/GENERAL POINTER

CNTR,	0		/GENERAL COUNTER

TEMP1,	0		/TEMPORARIES
TEMP2,	0
TEMP3,	0
TEMP4,	0
TEMP5,	0
TEMP6,	0

CHARNI,	0		/CHARACTER INPUT NUMBER
CHARNO,	0		/CHARACTER OUTPUT NUMBER

OUNIT,	0		/OUTPUT UNIT
IUNIT,	0		/INPUT UNIT

IBLOCK,	0		/INPUT BLOCK
OBLOCK,	0		/OUTPUT BLOCK

INPUT,	0		/INPUT ROUTINE POINTER
OUTPUT,	0		/OUTPUT ROUTINE POINTER

IPOINT,	0		/INPUT POINTER
OPOINT,	0		/OUTPUT POINTER

SAVELN,	0		/OPTION /P SWITCH

MODE,	0		/OPTION /I AND /B SWITCH

WORDS,	0		/WORDS LEFT COUNTER

DATE,	0		/TODAY'S DATE

FREEP,	0		/POINT TO FREE SPOT

PRINT0,	0		/PRINT ROUTINE TEMPORARIES
PRINT1,	0
PRINT2,	0
PRINT3,	0
PRINTC,	0		/240 FOR LEADING SPACES

RBFLAG,	0		/RUBOUT FLAG

CDDEVF,	0		/DEFAULT DEVICE NAME
	0

CDNAME,	0		/FILE NAME
	0
	0
CDEXT,	0		/FILE EXTENSION
	0
	0		/FILLER WORD

PERSW,	0		/PERIOD SWITCH

DEVSW,	0		/DEVICE SWITCH

CDDEV,	0		/DEVICE
	0

INSEG,	0		/PDP-10 UNIT WITH DIRECTORY IN CORE

PDP10D,	ZBLOCK 10	/LIST OF KNOWN PDP-10 UNITS

CDCNT,	0		/INPUT LIST COUNTER

CDI04,	0		/POINTER SAVE

XDSK,	TEXT /DSK/	/DEFAULT DEVICE DSK:

OCHARY,	0		/TEMPORARY
DVTYPE,	0		/DEVICE TYPE HOLDER
TDUNIT,	0		/0 OR 4000
TAPFUN,	0		/DECTAPE FUNCTION
DATE75,	0		/1 MEANS HAD H.O. BIT ON
XDATE,	0		/POINTS TO EXTRA DATE BIT
HIDATE,	0		/HIGH-ORDER BIT OF TODAY'S DATE

/	KLUDGE FOR DATE-75 BUG:
/	ONLY CONSIDER 1 MORE BIT OF PRECISION
/	INSTEAD OF ALL 3 EXTRA BITS
/	SINCE OS/8 DATE WILL RUN OUT BEFORE
/	THAT FAILS
	PAGE
	JMP I (PIP10	/NORMAL ENTRY
	JMS	ERROR	/PIP10 CANNOT BE CHAINED TO
	ERMES0-1

/ERROR ROUTINES

IOERR,	JMS ERROR	/I/O ERROR
	ERMES1-1

NOROOM,	JMS ERROR	/NO ROOM IN TAPE OR DIRECTORY
	ERMES2-1

NOOFIL,	JMS ERROR	/NO SUCH DEVICE
	ERMES3-1

FNOTFD,	JMS	ERROR		/FILE NOT FOUND
	ERMES9-1
NOT10F,	JMS ERROR	/NOT A PDP-10 FILE
	ERMES4-1

ERDELF,	JMS ERROR	/ERROR DELETING A FILE
	ERMES5-1

NOTPSF,	JMS ERROR	/NOT A OS8 FILE
	ERMES6-1

NOOOFL,	JMS ERROR	/ERROR OPENING THE OUTPUT FILE
	ERMES7-1

SYNTAX,	JMS ERROR	/SYNTAX ERROR
	ERMES8-1

ERROR,	0		/ERROR ROUTINE
	CLA
	CDF
	TAD I ERROR
	DCA INDEX0	/POINT TO MESSAG-1
	TAD (ERROR3
	DCA OUTPUT	/SET TTY: OUTPUT
	JMS ERROR4	/PRINT THE STRING
	JMP I (PIPCD	/AND BACK TO NORMAL

ERROR4,	0		/PRINT THE STRING POINTED BY INDEX0
	TAD I INDEX0
	DCA TEMP1	/SAVE WORD
	TAD TEMP1
	RTR
	RTR
	RTR
	JMS ERROR2	/BREAK IT DOWN
	TAD TEMP1
	JMS ERROR2
	JMP ERROR4+1	/LOOP

ERROR2,	0
	AND [77		/USE 6 BITS
	SNA
	JMP I ERROR4	/END
	DCA TEMP2
	TAD TEMP2
	AND (40
	SNA CLA
	TAD (100
	TAD [200	/MAKE A CHAR
	TAD TEMP2
	TAD (-337	/_ IS SPECIAL
	SNA
	TAD (215-337
	TAD (337
	JMS ERROR7	/PUT IT
	JMP I ERROR2

ERROR7,	0
	DCA TEMP2
	TAD TEMP2
	JMS I OUTPUT
	TAD TEMP2
	TAD (-215
	SZA CLA
	JMP I ERROR7
	TAD (212
	JMP ERROR7+1

ERROR3,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I ERROR3
/PRINT ROUTINE

PRINT,	0
	DCA PRINT0
PRINT7,	DCA PRINTC	/SET SWITCH
	TAD (PRINTL
	DCA PRINT1
	CLL CLA CMA RTL
	DCA PRINT3
PRINT4,	DCA PRINT2
	JMP .+3

	DCA PRINT0
	ISZ PRINT2
	TAD PRINT0
	TAD I PRINT1
	SMA
	JMP .-5
	CLA
	ISZ PRINT1
	TAD PRINT2
	SZA
	JMP PRINT5	/IT IS NON-ZERO
	TAD PRINTC
	SZA
	JMS I OUTPUT	/PRINT LEADING SPACE IF DESIRED
	JMP PRINT6

PRINT5,	TAD ("0
	JMS I OUTPUT
	CLL CLA CML RAR
PRINT6,	ISZ PRINT3
	JMP PRINT4
	TAD PRINT0
	TAD ("0
	JMS I OUTPUT
	JMP I PRINT
	PAGE
/PDP-10 DECTAPE SERVICE ROUTINE
/
/CALL:
/	JMS READT	/READ PDP-10 DECTAPE
/	BUFFER		/BUFFER ADDRESS - FIELD 1
/	BLOCK		/BLOCK NUMBER
/
/	JMS WRITET	/WRITE PDP-10 DECTAPE
/	BUFFER		/BUFFER ADDRESS - FIELD 1
/	BLOCK		/BLOCK NUMBER
/
/THE UNIT IS IN "UNIT10"

TCON2,	2		/MUST BE AT BEGINNING OF PAGE!

WRITET,	0		/WRITE PDP-10 DECTAPE
	CDF		/BE SURE OF FIELD 0
	TAD	WRITET
	STL
	JMS I	(TDIOCK	/CHECK FOR TD IO
	TAD I WRITET	/GET BUFFER ADDRESS
	DCA TBUF	/AND SAVE IT
	JMS RWTEST	/TEST DIRECTION
WRITE2,	JMS I (FLIP	/REVERSE - FLIP BUFFER NOW
	TAD (50
WRITE1,	DCA TAPFUN	/SET FUNCTION (30=READ, 50=WRITE)
	DTLB		/SEARCH INTO FIELD 0
	TAD (TBLK
	DCA I TCA	/TAPE BLOCK INTO "TBLK"
TERR,	RTL		/ERROR BIT IS 0 INITIALLY
	RAL		/SHIFT END ZONE BIT INTO LINK
	CML CLA		/CLEAR REST OF THE JUNK
	TAD [200	/'GO' BIT
TSTART,	SNL		/SKIP IF NO REVERSE DIRECTION
	TAD [400	/'REVERSE' BIT
	DTXA		/START DRIVE GOING
TLOOP,	JMS I	(DTWAIT

TOUT,	SPA		/ERROR?
	JMP TERR	/YES - CHECK IT
	DTRA		/CHECK DIRECTION
	RTL
	RTL		/DIRECTION BIT INTO LINK
TMOD1,	SZL CLA		/'SNL CLA' IF REVERSE MODE
TMOD4,	TAD TCON2	/'CLL CLA CMA RAL' IF REVERSE MODE
	TAD TBLK	/GET BLOCK FOUND
	CMA
	TAD I WRITET	/GET BLOCK DESIRED
	CMA
	SZA CLA		/SKIP IF FOUND THE BLOCK
	JMP TSTART	/NOT FOUND - GO AGAIN
TMOD2,	SZL CLA		/'SNL CLA' IF REVERSE MODE
	JMP TSTART+1	/FOUND BUT WRONG DIRECTION - REVERSE IT
	CLA CMA
	TAD TBUF	/GET BUFFER ADDRESS-1
	DCA I TCA	/SET ADDRESS
	TAD (10
	DTLB		/SET FIELD 1 BUFFER
	TAD TAPFUN
	DTXA		/SET READ OR WRITE
	TAD TM600
	DCA I TWC	/SET WORD COUNT OF 600 OCTAL WORDS
	DTSF		/FLAG?
	JMP .-1		/NO - WAIT
	DTRB		/CHECK FOR ERRORS
	SPA CLA
	JMP I (IOERR	/ERROR!!
	TAD [200
	DTXA		/STOP THE DRIVE
TMOD3,	JMS I (FLIP	/POSSIBLE FLIP AFTER READ
	ISZ WRITET
	JMP I WRITET	/EXIT

TCA,	7755		/DECTAPE CURRENT ADDRESS
TWC,	7754		/DECTAPE WORD COUNT
TBLK,	0		/SET TO BLOCK FOUND IN SEARCH
TBUF,	0		/HOLDS BUFFER ADDRESS

/READ ENTRY POINT

READT,	0		/PDP-10 DECTAPE READ
	CDF		/INSURE FIELD 0
	TAD	READT
	CLL
	JMS I	(TDIOCK	/CHECK FOR TD IO
	TAD I READT	/GET BUFFER ADDRESS
	DCA TBUF	/AND SAVE IT
	TAD READT
	DCA WRITET	/MOVE RETURN ADDRESS
	JMS RWTEST	/CHECK DIRECTION
	NOP		/NO INITIAL FLIP IF REVERSE
	TAD (30		/READ FUNCTION
	JMP WRITE1	/GO DO REST OF THE ROUTINE
RWTEST,	0		/CHECK DIRECTION TO READ/WRITE AND SEARCH
	ISZ WRITET
	JMS I	(GOLDBK	/GET OLD BLOCK NUMBER (NEGATIVE)
	TAD I WRITET	/GET DESIRED BLOCK
	DCA TBLK	/SAVE FOR FUTURE USE
	SZL CLA
	TAD (10		/FORWARD - SZL CLA
	TAD TMOD6	/REVERSE - SNL CLA
	DCA TMOD1	/SET UP FOR DIRECTION
	TAD TMOD1
	DCA TMOD2
	SNL CLA
	TAD WRITE2	/REVERSE - FLIP BUFFER AFTER
	DCA TMOD3	/FORWARD - NO BUFFER FLIP
TMOD6,	SNL CLA
	TAD (7344-1200	/REVERSE - CLL CLA CMA RAL
	TAD TMOD5	/FORWARD - TAD TCON2
	DCA TMOD4	/X0002 OR 17776
	SZL CLA
	ISZ RWTEST	/FORWARD - 2ND EXIT
	IAC
	SNL
	CIA		/REVERSE DIRECTION
	TAD I WRITET
	SPA
TM600,	CLA		/NO LOWER THAN 0
	DCA I TAPFUN	/SET NEW LAST SERVICED BLOCK
	TAD TBLK	/REMEMBER SAVING THIS?
	CLL
	SMA SZA		/<0 AND 0 SKIP AND HAVE LINK=0
	CLL CML CIA	/>0 BECOMES <0 AND HAS LINK=1
TMOD5,	TAD TCON2
	CLA RTR		/LINK HAS SEARCH DIRECTION
	RTR
	TAD (10		/ADD 'SEARCH' BIT
	DTCA DTXA	/LOAD SEARCH AND DIRECTION
	TAD UNIT10	/GET UNIT
	DTXA		/ADD UNIT (ALSO FLIPS DIRECTION)
	JMP I RWTEST	/EXIT
	PAGE
/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS

OLDTBL,	0;0;0;0;0;0;0;0
/FLIP THE BUFFER ROUTINE

FLIP,	0		/FLIP A 600 WORD BUFFER (FIELD 1)
	TAD I (TBUF	/BUFFER START
	DCA FLIP1	/SET START
	TAD (577
	TAD I (TBUF
	DCA FLIP2	/SET END (END=START+577)
	TAD (-300
	DCA FLIP3	/SET COUNT (600/2=300)
	CDF 10		/BUFFER IS IN FIELD 1
FLIP6,	TAD I FLIP1	/GET START
	JMS FLIP4	/FLIP IT
	DCA FLIP5	/SAVE TEMPORARILY
	TAD I FLIP2	/GET END
	JMS FLIP4	/FLIP IT
	DCA I FLIP1	/PUT END INTO START
	TAD FLIP5
	DCA I FLIP2	/PUT START INTO END
	ISZ FLIP1	/BUMP POINTERS
	CLA CMA
	TAD FLIP2
	DCA FLIP2
	ISZ FLIP3	/DONE?
	JMP FLIP6	/NO - LOOP
	CDF		/BACK TO FIELD 0
	JMP I FLIP	/EXIT

FLIP1,	0		/START POINTER
FLIP2,	0		/END POINTER
FLIP3,	0		/COUNTER
FLIP5,	0		/TEMPORARY
FLIP7,	0		/FLIPPING TEMPORARIES
FLIP8,	0		/"        "

FLIP4,	0		/FLIP A CELL
	DCA FLIP7	/SAVE IT
	TAD FLIP7
	RTL
	RTL
	AND (7		/GET ...1
	DCA FLIP8	/ACCUMULATE RESULT
	TAD FLIP7
	RTR
	RAR
	AND (70		/GET ..2.
	TAD FLIP8
	DCA FLIP8	/BUILD RESULT
	TAD FLIP7
	AND (70
	CLL RTL
	RAL		/GET .3..
	TAD FLIP8
	DCA FLIP8	/BUILD RESULT
	TAD FLIP7
	AND (7
	CLL RTR
	RTR		/GET 4...
	TAD FLIP8
	CMA		/GET NOT 4321
	JMP I FLIP4	/EXIT
/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE

TDIOCK,	0
	DCA	TDRET	/SAVE RETURN ADDR
	RAR
	DCA	TDFUN	/SAVE READ/WRITE
	JMS I	(GET10D	/GET TYPE OF DECTAPE
	TAD	(-2
	SZA CLA
	JMP I	TDIOCK	/TC08 - CONTINUE
	TAD I	TDRET
	DCA	TDBUF	/SAVE BUF ADDR
	ISZ	TDRET
	JMS	GOLDBK	/GET OLD BLOCK #
	TAD I	TDRET
	CLA RAL		/GET DIRECTION
	TAD	(110	/ONE BLOCK, FIELD 1
	TAD	TDFUN
	DCA	TDFUN	/SAVE FINAL FUNCTION WORD
	JMS I	(TDUSET	/SET UP HANDLER
	TAD	TDUNIT
	SPA CLA
	TAD	(DTA1-DTA0
	TAD	(DTA0
	DCA	TDIOCK	/SET UP HANDLER ENTRY PTR
	TAD I	TDRET
	DCA I	TAPFUN
	TAD I	TAPFUN
	DCA	TDBLK
	JMS I	TDIOCK
TDFUN,	0
TDBUF,	0
TDBLK,	0
	JMP I	(IOERR
	ISZ	TDRET
	JMP I	TDRET
TDRET,	0

GOLDBK,	0
	TAD UNIT10	/GET THE UNIT WE NEED
	CLL RTL
	RTL		/SHIFT INTO BITS 9-11
	TAD (OLDTBL
	DCA TAPFUN	/POINT TO THIS UNIT'S POSITION
	TAD I TAPFUN	/GET LAST SERVICED BLOCK
	CLL CIA
	JMP I	GOLDBK
	PAGE
/GET A LINE ROUTINE

GLINE,	0		/GET A LINE
	TAD ["*
	JMS I [ERROR3	/ANNOUNCE US WITH A *
	DCA RBFLAG	/RESET RUBOUT FLAG
	TAD [LINBUF-1
	DCA IXR		/POINT TO THE BUFFER
CHLOOP,	KSF
	JMP CHLOOP	/WAIT FOR TTY:
	TAD [200
	KRS		/READ TTY:
	DCA TEMP1
	KCC
	TAD [SPADR-1
	DCA INDEX0	/SET LIST SEARCH
	TAD I INDEX0
	SNA
	JMP .+6		/END OF LIST
	TAD TEMP1
	SNA CLA
	JMP I INDEX0	/FOUND SO JUMP
	ISZ INDEX0
	JMP .-7		/LOOP

	JMS PRNT	/PRINT IT
CINSRT,	TAD TEMP1
	DCA I IXR	/STORE THE CHARACTER
	TAD IXR
	TAD (-LINBUF-100
	SZA CLA
	JMP CHLOOP	/GET ANOTHER CHARACTER
	JMS CRCR
	JMP I (SYNTAX	/ERROR

CARRET,	JMS CRCR
CLFINI,	DCA I IXR	/SET END
	DCA I IXR
	JMP I GLINE	/EXIT

SPADR,	-225;JMP CTRLU
	-215;JMP CARRET
	-377;JMP RUBOUT
	-375;JMP ALTMOD
	-376;JMP ALTMOD
	-233;JMP ALTMOD
	-200;JMP CHLOOP
	-217;JMP CHLOOP
	-337;JMP BAKARR
	-212;JMP LFEED
	-203;JMP CTRLC
	0

BAKARR,	JMS PRNT	/"_"
	TAD ["<
	JMP CINSRT+1	/USE "<" INSTEAD

CTRLC,
CTRLU,	TAD ["^
	JMS I [ERROR3	/CONTROL CHARACTERS
	TAD TEMP1
	TAD [100
CLRLIN,	JMS I [ERROR3
	JMS CRCR
	TAD I INDEX0
	SZA CLA
	JMP GLINE+1	/NOT "^C"
	TSF
	JMP .-1
	JMP I (7605	/TO MONITOR

CRCR,	0
	TAD [215
	DCA TEMP1
	JMS PRNT
	TAD [212
	JMS I [ERROR3	/PRINT CR-LF
	JMP I CRCR

ALTMOD,	TAD ["$
	DCA TEMP1	/ALTMODE IS "$"
	JMS PRNT
	JMP CLFINI	/ENDS THE LINE

RUBOUT,	TAD IXR
	TAD (1-LINBUF
	SNA CLA
	JMP RBSPCL	/SPECIAL TREATMENT
	TAD ("\
	ISZ RBFLAG
	JMS I [ERROR3	/PRINT \
	CLA CMA
	DCA RBFLAG	/SET FLAG
	TAD IXR
	DCA TEMP2
	TAD I TEMP2
	JMS I [ERROR3	/PRINT RUBED CHAR
LBCKUP,	CLA CMA
	TAD IXR
	JMP CHLOOP-1	/GO GET ANOTHER

RBSPCL,	ISZ RBFLAG
	JMP CLRLIN+1	/NOT INTO RUBOUTS
	TAD ("\
	JMP CLRLIN

PRNT,	0
	ISZ RBFLAG
	JMP .+3
	TAD ("\
	JMS I [ERROR3	/END OF RUBOUTS
	DCA RBFLAG
	TAD TEMP1
	JMS I [ERROR3	/PRINT CHAR
	JMP I PRNT

LFEED,	JMS CRCR
	DCA I IXR	/SET END
	TAD [LINBUF-1
	DCA IXR
	TAD ["*
	JMS I [ERROR3
	TAD I IXR	/PRINT THE LINE
	SNA
	JMP LBCKUP
	JMP .-4
	PAGE
/FIND A SLOT ROUTINE
/SLOT NUMBERS BETWEEN 0 AND 1101
/RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
/
/CALL:
/	JMS FINDSL	/FIND A SLOT
/	SLOT#		/SLOT NUMBER
/	(AC)		/VALUE OF SLOT RETURNED
/
/SLOT NUMBER OF 0 RETURNS 7777

FINDSL,	0		/FIND A SLOT
	CLA CMA
	TAD I FINDSL	/GET SLOT NUMBER-1
	ISZ FINDSL
	SPA		/WAS IT 0?
	JMP FINDSA	/YES
	JMS DIV7	/NO - DIVIDE BY 7
	TAD (JMP I FINDS0+7
	DCA DIV1	/USE REMAINDER FOR JUMPING
	CDF 10		/BUFFER IS IN FIELD 1
DIV1,	HLT		/TEMPORARY AND JUMP CELL

FINDSA,	CLA CMA
	JMP I FINDSL	/EXIT WITH 7777 FOR SLOT NUMBER 0

FINDS0,	FINDS1		/JUMP TABLE
	FINDS2
	FINDS3
	FINDS4
	FINDS5
	FINDS6
	FINDS7

/DIVIDE BY 7 ROUTINE

DIV7,	0		/DIVIDE BY 7
	DCA DIV1	/SAVE IT
	TAD (DIRECT
	DCA POINT	/POINT TO DIRECTORY
	TAD DIV1
DIV3,	TAD (-7		/SUBTRACT 7'S
	SPA
	JMP I DIV7	/EXIT WITH REMAINDER
	ISZ POINT	/BUMP POINTER BY 3
	ISZ POINT
	ISZ POINT
	JMP DIV3	/AND LOOP

/FIND SLOT ROUTINE #1
/USE WORD 1 BITS 0-4

FINDS1,	TAD I POINT	/GET CELL
	RTL
	RTL
	RTL		/GET FIRST 5 BITS
FINDS8,	AND [37		/ONLY 5 BITS
	CDF		/BACK TO FIELD 0
	JMP I FINDSL	/AND EXIT WITH VALUE IN AC

/FIND SLOT ROUTINE #2
/USE WORD 1 BITS 5-9

FINDS2,	TAD I POINT
	RTR		/USE BITS 5-9
	JMP FINDS8

/FIND SLOT ROUTINE #3
/USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2

FINDS3,	TAD I POINT
	AND [3		/USE BITS 10-11 OF 1ST WORD
	CLL RTL
	RAL		/SHIFT TO BITS 7-8
	DCA DIV1	/SAVE IT
	ISZ POINT	/NEXT WORD
	TAD I POINT
	CLL RTL
FINDS9,	RTL		/GET INTO BITS 8-11
	AND [17		/GET ONLY BITS 8-11
	TAD DIV1	/ADD OTHER BITS
	JMP FINDS8

/FIND SLOT ROUTINE #4
/USE WORD 2 BITS 3-7

FINDS4,	ISZ POINT	/USE 2ND WORD
	TAD I POINT
	RTR		/USE BITS 3-7
	JMP FINDS2+1

/FIND SLOT ROUTINE #5
/USE WORD 2 BITS 8-11 AND WORD 3 BIT 0

FINDS5,	ISZ POINT	/USE 2ND WORD
	TAD I POINT
	AND [17
	CLL RAL		/GET BITS 7-10
	DCA DIV1	/AND SAVE THEM
	ISZ POINT	/NEXT WORD
	CLL CLA CML RAR
	AND I POINT	/GET BIT 0
	JMP FINDS9

/FIND SLOT ROUTINE #6
/USE WORD 2 BITS 1-5

FINDS6,	ISZ POINT
	ISZ POINT	/USE 3RD WORD
	TAD I POINT
	RAL
	JMP FINDS1+1

/FIND SLOT ROUTINE #7
/USE WORD 3 BITS 6-10

FINDS7,	ISZ POINT
	ISZ POINT	/USE 3RD WORD
	TAD I POINT
	RAR		/GET RID OF LAST BIT
	JMP FINDS8
/DELETE A PDP-10 ENTRY
/
/CALL:
/	(AC)		/POINT TO NAME-1 (FIELD 1)
/	JMS DELETE	/DELETE A PDP-10 ENTRY
/	-NO-		/NOT FOUND
/	-OK-		/ENTRY DELETED

DELETE,	0		/DELETE A PDP-10 ENTRY
	JMS I	(FIND	/TRY TO FIND IT FIRST
	JMP I DELETE	/NOT FOUND
	ISZ DELETE	/FOUND - 2ND EXIT
	DCA DELET1	/SAVE SLOT NUMBER
	CLA IAC
	DCA DELET2	/START AT SLOT 1
	TAD (-1101
	DCA DELET3	/DO 1101 SLOTS
	JMS FINDSL	/FIND A SLOT
DELET2,	0		/SLOT NUMBER
	CIA
	TAD DELET1	/IS IT ONE OF OURS?
	SZA CLA
	JMP DELET4	/NO
	TAD DELET2	/YES
	DCA .+2		/SET SLOT NUMBER AGAIN
	JMS I (FILLSL	/FILL WITH A 0
	0
	0		/FILL WITH A 0
DELET4,	ISZ DELET2	/NEXT SLOT
	ISZ DELET3	/MORE?
	JMP DELET2-1	/YES - LOOP
	CDF 10		/DIRECTORY IS IN FIELD 1
	DCA I INDEX0	/REMEMBER "FIND" SETTING THIS UP?
	DCA I INDEX0	/REMOVE THE FILE NAME
	DCA I INDEX0
	TAD INDEX0
	TAD [77
	DCA INDEX0	/POINT TO EXTENSION
	DCA I INDEX0
	DCA I INDEX0	/REMOVE EXTENSION
	DCA I INDEX0
	CDF
	JMP I DELETE	/EXIT

DELET1,	0		/HOLDS FOUND SLOT NUMBER
DELET3,	0		/COUNTER
	PAGE
/FILL A SLOT ROUTINE
/
/CALL:
/	JMS FILLSL	/FILL A SLOT
/	SLOT#		/SLOT NUMBER
/	VALUE		/VALUE TO FILL SLOT WITH
/
/SLOT NUMBER 0 IS ILLEGAL!

FILLSL,	0		/FILL A SLOT ROUTINE
	CLA CMA
	TAD I FILLSL	/GET SLOT NUMBER-1
	ISZ FILLSL
	JMS I (DIV7	/DIVIDE BY 7
	TAD (JMP I FILLS0+7
	DCA FILLS9	/USE REMAINDER FOR JUMPING
	TAD I FILLSL	/GET VALUE
	ISZ FILLSL
	AND [37		/5 BIT VALUE ONLY
	CDF 10		/DIRECTORY IS IN FIELD 1
FILLS9,	HLT		/TEMPORARY AND JUMP CELL

/JUMP TABLE

FILLS0,	FILLS1
	FILLS2
	FILLS3
	FILLS4
	FILLS5
	FILLS6
	FILLS7

FILLSA,	0		/TEMPORARY

/FILL SLOT ROUTINE #1
/BITS 0-4 OF WORD 1

FILLS1,	CLL RTR
	RTR		/VALUE INTO BITS 0-4
	RTR
	DCA FILLS9	/SAVE VALUE
	TAD I POINT
	AND [177	/AND OFF BITS 0-4
FILLS8,	TAD FILLS9	/ADD IN VALUE
	DCA I POINT	/SET NEW WORD
	CDF		/BACK TO FIELD 0
	JMP I FILLSL	/EXIT

/FILL SLOT ROUTINE #2
/BITS 5-9 OF WORD 1

FILLS2,	CLL RTL		/VALUE INTO BITS 5-9
	DCA FILLS9	/SAVE VALUE
	TAD I POINT
	AND (7603	/AND OFF BITS 5-9
	JMP FILLS8

/FILL SLOT ROUTINE #3
/BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2

FILLS3,	DCA FILLS9	/SAVE VALUE
	TAD FILLS9
	CLL RAR
	CLL RAR		/GET BITS 10-11
	CLL RAR
	DCA FILLSA	/SAVE
	TAD I POINT
	AND (7774	/AND OFF BITS 10-11
	TAD FILLSA	/ADD IN BITS 10-11
	DCA I POINT	/SET NEW WORD
	ISZ POINT	/GOTO WORD 2
	TAD FILLS9
	AND [7		/GET BITS 0-2
	CLL RTR
	RTR		/SHIFT THEM
	DCA FILLS9	/SAVE VALUE
	TAD I POINT
	AND (777	/AND OFF BITS 0-2
	JMP FILLS8

/FILL SLOT ROUTINE #4
/BITS 3-7 OF WORD 2

FILLS4,	CLL RTL
	RTL		/SHIFT INTO POSITION
	DCA FILLS9	/AND SAVE
	ISZ POINT	/USE WORD 2
	TAD I POINT
	AND (7017	/AND OFF BITS 3-7
	JMP FILLS8

/FILL SLOT ROUTINE #5
/BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3

FILLS5,	DCA FILLS9
	TAD FILLS9	/GET VALUE
	CLL RAR		/GET BITS 8-11
	DCA FILLSA	/AND SAVE
	ISZ POINT	/USE WORD 2 FIRST
	TAD I POINT
	AND [7760	/AND OFF BITS 8-11
	TAD FILLSA	/ADD IN THOSE BITS
	DCA I POINT	/SET NEW WORD 2
	ISZ POINT	/NOW WORD 3
	CLA IAC
	AND FILLS9	/GET BIT 0
	CLL RTR		/AND SHIFT INTO POSITION
	DCA FILLS9	/AND SAVE IT
	CLL CLA CMA RAR
	AND I POINT	/AND OFF BIT 0
	JMP FILLS8

/FILL SLOT ROUTINE #6
/BITS 1-5 OF WORD 3

FILLS6,	CLL RTL
	RTL		/SHIFT INTO POSITION
	RTL
	DCA FILLS9	/AND SAVE
	ISZ POINT
	ISZ POINT	/USE WORD 3
	TAD I POINT
	AND (4077	/AND OFF BITS 1-5
	JMP FILLS8

/FILL SLOT ROUTINE #7
/BITS 6-10 OF WORD 3
/BIT 11 OF WORD 3 A 0

FILLS7,	CLL RAL		/SHIFT INTO POSITION
	DCA FILLS9	/AND SAVE
	ISZ POINT
	ISZ POINT	/USE WORD 3
	TAD I POINT
	AND [7700	/AND OFF BITS 6-11
	JMP FILLS8
FIX75,	0		/DF 10
	CDF		/SET H.O. DATE WORD OF FILE
	TAD I (SLOTNO	/ENTRY NO. OF FILE
	CLL RAL		/*3
	TAD I (SLOTNO	/SINCE 1 -10 WORD= 3 -8 WORDS
	TAD (DIRECT-1	/POINT TO HIGH ORDER BIT OF DATE
	DCA FIXPTR	/V3C
	CDF 10
	STA CLL RAL	/OTHER STUFF IS VERY IMPORTANT
	AND I FIXPTR	/SO KEEP IT
	TAD HIDATE	/OR IN THIS BIT
	DCA I FIXPTR	/AND WRITE IT BACK
	JMP I FIX75

FIXPTR,	0		/POINTS TO WORD CONTAINING H.O. DATE
	PAGE
/GET NEXT SLOT ROUTINE
/GOES BY 5'S EITHER FORWARD OR BACKWARD
/
/CALL:
/	(AC)		/CURRENT BLOCK NUMBER
/	JMS NEXTSL	/GET NEXT SLOT
/	(AC)		/NEXT BLOCK NUMBER
/
/GOES TO "NOROOM" IF DIRECTORY FULL

NEXTSL,	0		/GET NEXT SLOT
	TAD NEXTDI	/ADD IN DIRECTION FACTOR
	SPA
	JMP NEXTS2	/<0 MEANS REVERSE DIRECTION
	TAD [-1102
	SMA
	JMP NEXTS2	/>1101 MEANS REVERSE DIRECTION
	TAD (1102
	DCA NEXTS1	/SET NEW BLOCK NUMBER
	JMS I (FINDSL	/IS THIS SLOT FREE?
NEXTS1,	0		/BLOCK NUMBER
	SZA CLA
	JMP NEXTS3	/NO - NOT FREE
	TAD NEXTS1	/FREE
	DCA NEXTS7+1	/SET BLOCK AGAIN
NEXTS7,	JMS I (FILLSL	/FILL THIS SLOT THEN
	0		/SLOT TO FILL
SLOTNO,	0		/VALUE TO FILL WITH
	TAD NEXTDI
	SMA CLA		/MAKE SURE DIRECTION IS -4 OR 4
	TAD (10
	TAD (-4
	DCA NEXTDI
	TAD NEXTS7+1	/GET NEW BLOCK
	JMP I NEXTSL	/EXIT

NEXTS2,	CLA		/REVERSE DIRECTION
	TAD NEXTDI
	SMA CLA		/SET 0 OR 1101
	TAD (1101
	DCA NEXTS1	/INTO BLOCK NUMBER
	TAD NEXTDI
	CIA		/REVERSE DIRECTION
	JMP NEXTS3+1	/GO PRETEND WE FOUND A FULL SLOT

NEXTS3,	TAD NEXTDI
	SMA CLA		/MAKE DIRECTION -1 OR 1
	CLL CLA CMA RAL
	CMA
	DCA NEXTDI	/DIRECTION IS -1 OR 1
	TAD [-1102
	DCA NEXTS4	/CHECK 1102 BLOCKS
	TAD NEXTS1
	DCA NEXTS5	/SET START BLOCK
	JMS I (FINDSL	/CHECK A SLOT
NEXTS5,	0		/SLOT TO CHECK
	SNA CLA
	JMP NEXTS6	/FOUND A FREE SLOT
	ISZ	NEXTS4	/TRY MORE?
	SKP		/YES
	JMP I	(NOROOM	/NO - OUT OF ROOM
	TAD NEXTS5
	TAD NEXTDI	/ADD DIRECTION TO SLOT
	SPA
	JMP NEXTS2	/<0 IS TOO FAR
	TAD [-1102
	SMA
	JMP NEXTS2	/>1101 IS TOO FAR
	TAD (1102
	DCA NEXTS5	/SET NEW BLOCK
	JMP	NEXTS5-1	/KEEP GOING

NEXTS6,	TAD NEXTS5	/GET FREE BLOCK
	JMP NEXTS7-1	/AND SET IT

NEXTS4,	0		/COUNTER

NEXTDI,	0		/DIRECTION (5, -5, 1, -1)

/MORE PDP-10 OUTPUT

/OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3

OCHAR3,	TAD OCHARY
	CLL RTR
	RTR
	AND [7
	TAD I OPOINT
	DCA I OPOINT
	ISZ OPOINT
	TAD OCHARY
	AND [17
	CLL RTR
	RTR
	RAR
	JMP I (OCHARD
MONTBL,	"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
	PAGE
/PDP-10 CHARACTER OUTPUT ROUTINE
/
/CALL:
/	(AC)		/CHARACTER
/	JMS OCHR10	/OUTPUT TO PDP-10
/	-RETURN-	/O.K. RETURN

OCHR10,	0		/OUTPUT TO PDP-10
	DCA OCHARY	/SAVE CHAR
	TAD MODE	/IMAGE MODE?
	SZA
	JMP OC10A1	/YES /I OR /B
	TAD OCHARY	/NO - USE 7 BITS
	AND [177
OC10A2,	DCA OCHARY
OC10A3,	TAD CHARNO	/GET CHAR NUMBER
	TAD (JMP I OCHARX
	DCA OCHARZ	/USE TO SET UP JUMP
	CDF 10		/BUFFER IS IN FIELD 1
OCHARZ,	0		/JUMP TO THE ROUTINE

OC10A1,	SMA CLA		/BINARY?
	JMP OC10A3	/NO
	TAD OCHARY	/YES
	AND [377
	JMP OC10A2

OCHARX,	OCHAR0
	OCHAR1
	OCHAR2
	OCHAR3
	OCHAR4

/OUTPUT CHARACTER #0 - BITS 0-6 WORD 1

OCHAR0,	TAD I [OBUF10+2
	AND [177	/GET COUNT
	TAD (-177
	SZA CLA
	JMP OCHARA	/STILL ROOM IN BUFFER
	CDF		/NO ROOM IN BUFFER
	TAD OBLOCK
	JMS I (NEXTSL	/GET THE NEXT BLOCK NUMBER
	DCA OCHARZ	/AND SAVE IT
	CDF 10		/BACK TO FIELD 1
	TAD OCHARZ
	AND [7700
	CLL RTR
	RTR
	RTR		/GET LINK POINTER
	DCA I [OBUF10
	TAD OCHARZ
	AND [77
	CLL RTL
	RTL
	RTL
	TAD I [OBUF10+1
	DCA I [OBUF10+1	/AND SET POINTER
	TAD OUNIT
	DCA UNIT10	/SET OUR UNIT
	TAD OBLOCK
	DCA .+3		/AND OUR BLOCK
	JMS I (WRITET	/WRITE PDP-10 DECTAPE
	OBUF10
	0		/BLOCK NUMBER IS SET
	CDF 10		/BACK TO FIELD 1
	DCA I [OBUF10
	TAD I [OBUF10+1
	AND [77
	DCA I [OBUF10+1	/CLEAR POINTER
	TAD OCHARZ
	DCA OBLOCK	/SET NEW BLOCK
	TAD I [OBUF10+2
	AND [7400
	DCA I [OBUF10+2	/ZERO COUNT
	TAD (OBUF10+3
	DCA OPOINT	/RESET POINTER
OCHARA,	ISZ I [OBUF10+2	/BUMP COUNT
	TAD MODE	/IMAGE MODE?
	SNA
	JMP OCHARB	/NO
	SMA CLA		/BINARY?
	JMP OC10A4	/NO
	DCA I OPOINT	/YES
	ISZ OPOINT
	DCA I OPOINT
	ISZ OPOINT
	TAD OCHARY
	DCA I OPOINT	/SET 8 BITS
	ISZ OPOINT
OCHARC,	CDF		/BACK TO FIELD 0
	JMP I OCHR10	/EXIT

OC10A5,	ISZ OPOINT
OC10A4,	TAD OCHARY
	JMP OCHARD

OCHARB,	TAD OCHARY
	CLL RTL
	RTL
	RAL		/USE BITS 0-6
OCHARD,	DCA I OPOINT	/SET IT
	ISZ CHARNO	/BUMP CHARACTER NUMBER
	JMP OCHARC

/OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2

OCHAR1,	TAD MODE
	SZA CLA
	JMP OC10A5
	TAD OCHARY
	CLL RAR		/GET BITS 7-11
	CLL RAR
	TAD I OPOINT
	DCA I OPOINT	/SET WORD 1
	ISZ OPOINT	/NOW WORD 2
	TAD OCHARY
	AND [3
	CLL RTR
	RAR		/GET BITS 0-1
	JMP OCHARD

/OUTPUT CHARACTER #2 - BITS 2-8 WORD 2

OCHAR2,	TAD MODE
	SZA CLA
	JMP OC10A6
	TAD OCHARY
	CLL RTL
	RAL		/GET BITS 2-8
	TAD I OPOINT
	JMP OCHARD

/OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
/BIT 11 WORD 3 IS 0

OCHAR4,	TAD OCHARY
	CLL RAL		/BITS 4-10
	TAD I OPOINT
OC10A7,	DCA I OPOINT	/SET WORD 3
	ISZ OPOINT
	DCA CHARNO	/RESET CHARACTER NUMBER
	JMP OCHARC

OC10A6,	ISZ OPOINT
	TAD OCHARY
	JMP OC10A7
	PAGE
/PDP-10 CHARACTER INPUT
/
/CALL:
/	JMS ICHR10	/PDP-10 INPUT
/	-EOF-		/END OF FILE RETURN
/	(AC)		/NORMAL RETURN - CHARACTER IN AC

ICHR10,	0		/PCP-10 INPUT ROUTINE
	TAD CHARNI
	TAD (JMP I ICHARX
	DCA ICHARY	/USE CHARACTER NUMBER TO FORM JUMP
	CDF 10		/BUFFER IS IN FIELD 1
ICHARY,	0		/TEMPORARY AND JUMP CELL

ICHARX,	ICHAR0
	ICHAR1
	ICHAR2
	ICHAR3
	ICHAR4

/INPUT CHARACTER #0 - BITS 0-6 WORD 1

ICHAR0,	TAD WORDS	/GET NUMBER OF WORD LEFT
	SZA CLA
	JMP ICHARA	/STILL MORE WORDS LEFT
	TAD IBLOCK	/GET NEXT BLOCK
	SNA
	JMP ICHARC+1	/NONE - EOF
	DCA .+5		/SET NEXT BLOCK
	TAD IUNIT
	DCA UNIT10	/SET OUR UNIT
	JMS I (READT	/READ PDP-10 DECTAPE
	IBUF10
	0		/OUR BLOCK IS SET
	CDF 10		/BACK TO FIELD 1
	TAD I [IBUF10+2
	AND [177
	DCA WORDS	/SET NUMBER OF WORDS
	TAD I [IBUF10+1
	RTR
	RTR
	RTR
	AND [77
	DCA IBLOCK	/SET NEXT BLOCK
	TAD I [IBUF10
	AND [77
	CLL RTL
	RTL
	RTL
	TAD IBLOCK
	DCA IBLOCK	/SET NEXT BLOCK
	TAD (IBUF10+3
	DCA IPOINT	/RESET POINTER
	JMP ICHAR0

ICHARA,	CLA CMA
	TAD WORDS
	DCA WORDS	/COUNT DOWM ON NUMBER OF WORDS
	TAD MODE	/IMAGE MODE?
	SNA
	JMP ICHARB	/NO
	SMA CLA
	JMP IC10A1
	ISZ IPOINT	/YES
	ISZ IPOINT
	TAD I IPOINT	/GET WORD 3
	ISZ IPOINT
	AND [377	/USE 8 BITS
ICHARC,	ISZ ICHR10	/2ND EXIT
	CDF		/BACK TO FIELD 0
	JMP I ICHR10	/EXIT

ICHARB,	TAD SAVELN	/PRESERVE OPTION?
	SZA CLA
	JMP ICHARF	/YES
	CLL CLA CML RTL	/NO
	TAD IPOINT
	DCA ICHARY	/POINT TO WORD 3
	TAD I ICHARY
	CLL RAR
	SNL CLA
	JMP ICHARF	/WORD O.K.
	ISZ IPOINT
	ISZ IPOINT	/IGNORE THIS WORD
	ISZ IPOINT
	JMP ICHAR0

ICHARF,	TAD I IPOINT
	RTR
	RTR		/GET BITS 0-6
	RAR
ICHARD,	ISZ CHARNI	/BUMP COUNTER
	AND [177	/USE 7 BITS
	TAD [200	/ADD BIT 8
	JMP ICHARC

/INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2

ICHAR1,	TAD MODE
	SZA CLA
	JMP IC10A1
	TAD I IPOINT
	AND [37
	CLL RTL		/GET BITS 7-11
	DCA ICHARY
	ISZ IPOINT	/USE WORD 2 NOW
	TAD I IPOINT
	CLL RTL
	RAL
	AND [3		/GET BITS 0-1
ICHARE,	TAD ICHARY	/ADD IN OTHER BITS
	JMP ICHARD

/INPUT CHARACTER #2 - BITS 2-8 WORD 2

ICHAR2,	TAD MODE
	SZA CLA
	JMP IC10A3
	TAD I IPOINT
	RAR
	RTR		/GET BITS 2-8
	JMP ICHARD

/INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3

ICHAR3,	TAD I IPOINT
	AND [7
	CLL RTL
	RTL		/GET BITS 9-11
	DCA ICHARY
	ISZ IPOINT	/USE WORD 3 NOW
	TAD I IPOINT
	RTL
	RTL
	RAL
	AND [17		/GET BITS 0-3
	JMP ICHARE

/INPUT CHARACTER #4 - BITS 4-10 WORD 3

ICHAR4,	DCA CHARNI	/RESET CHARACTER COUNT
	TAD I IPOINT
	ISZ IPOINT
	RAR
	JMP ICHARD+1

IC10A3,	DCA CHARNI
	SKP
IC10A1,	ISZ CHARNI
	TAD I IPOINT
	ISZ IPOINT
	JMP ICHARC
	PAGE
/CLOSE A PDP-10 FILE
/
/CALL:
/	JMS CLOS10	/CLOSE A PDP-10 FILE
/	-RETURN-

CLOS10,	0		/CLOSE A PDP-10 FILE
	TAD MODE	/IMAGE MODE?
	SPA CLA
	JMP CLOS1A	/YES - NO FILL NEEDED
	TAD CHARNO
	SNA CLA
	JMP CLOS1A	/CHARACTER NUMBER IS 0 - FILL DONE
	JMS I (OCHR10	/0 FILL
	JMP .-4		/LOOP

CLOS1A,	TAD OUNIT
	DCA UNIT10	/SET OUR UNIT
	TAD OBLOCK
	DCA .+3		/SET THE BLOCK
	JMS I (WRITET	/WRITE PDP-10 DECTAPE
	OBUF10
	0		/BLOCK IS SET
	TAD (MOUTPU
	JMS I (DELETE	/DELETE THE OLD FILE
	NOP		/O.K. IF IT IS NOT THERE
	TAD FREEP
	DCA INDEX0	/POINT TO THE FREE SPOT
	TAD [MOUTPU
	DCA INDEX1	/POINT TO THE FILE NAME
	CDF 10		/TO FIELD 1
	TAD I INDEX1
	DCA I INDEX0
	TAD I INDEX1	/SET THE NAME
	DCA I INDEX0
	TAD I INDEX1
	DCA I INDEX0
	TAD INDEX0
	TAD [77
	DCA INDEX0	/POINT TO THE EXTENSION
	TAD I INDEX1
	DCA I INDEX0	/SET THE EXTENSION
	TAD I INDEX1
	DCA I INDEX0
	TAD DATE
	DCA I INDEX0	/SET THE DATE
	JMS I (FIX75	/V3C SET HIGH ORDER BIT TOO
	JMS I (WRITET	/WRITE PDP-10 DECTAPE
	DIRECT		/DIRECTORY
	144		/BLOCK 100 BASE 10
	JMP I CLOS10	/EXIT
/OPEN A PDP-10 FILE FOR OUTPUT
/
/CALL:
/	JMS OOPN10	/OPEN A PDP-10 FILE
/	-RETURN-

OOPN10,	0		/OPEN A PDP-10 FILE
	TAD (ZFREE-1
	JMS I (FIND	/FIND A FREE SPOT
	JMP I (NOROOM	/NO ROOM LEFT
	DCA I (SLOTNO	/SET THIS SLOT
	TAD INDEX0
	DCA FREEP	/SAVE POINTER TO FREE SPOT
	CLA CMA
	DCA I (NEXTDI	/SET DIRECTION = -1
	TAD (144
	JMS I (NEXTSL	/FIND FIRST OPEN SLOT
	DCA OBLOCK	/AND SET IT
	CDF 10
	TAD I [MOUTPU
	DCA OUNIT	/SET UNIT
	TAD OBLOCK
	AND [17
	CLL RTR
	RTR
	RAR
	DCA I [OBUF10+2	/SET FIRST BLOCK POINTER
	TAD OBLOCK
	CLL RTR
	RTR
	AND [77
	DCA I [OBUF10+1	/SET FIRST BLOCK POINTER
	DCA I [OBUF10	/ZERO LINK POINTER
	DCA CHARNO	/RESET CHARACTER NUMBER
	TAD (OBUF10+3
	DCA OPOINT	/RESET POINTER
	CDF
	JMP I OOPN10	/EXIT
/OPEN PDP-10 INPUT FILE
/
/CALL:
/	(AC)		/POINT TO FILE NAME-1
/	JMS IOPN10	/OPEN PDP-10 INPUT FILE
/	-NO-		/NOT THERE
/	(AC)		/ANY BLOCK OF THE FILE

IOPN10,	0		/OPEN PDP-10 INPUT FILE
	JMS I (FIND	/FIND THE FILE
	JMP I IOPN10	/NOT THERE
	DCA IOPN1B	/SAVE SLOT NUMBER
	TAD (143
	DCA IOPN1A
	TAD (CLA CMA
	DCA IOPN1D
IOPN1F,	JMS I (FINDSL	/FIND A SLOT
IOPN1A,	0		/SLOT TO FIND
	CIA
	TAD IOPN1B	/IS IT US?
	SNA CLA
	JMP IOPN1C	/YES
IOPN1D,	CLA CMA
	TAD IOPN1A	/BUMP BLOCK NUMBER
	SPA
	JMP IOPN1E	/TOO FAR
	TAD [-1102
	SMA
	JMP I IOPN10	/TOO FAR - EXIT
	TAD (1102
	DCA IOPN1A	/SET NEW BLOCK
	JMP IOPN1F	/RETRY

IOPN1B,	0		/SLOT THAT WE WANT

IOPN1E,	CLA
	TAD (CLA IAC
	JMP IOPN1F-1	/CHANGE DIRECTION AND RETRY

IOPN1C,	TAD IOPN1A
	CDF
	ISZ IOPN10
	JMP I IOPN10	/EXIT
	PAGE
/CONVERT OS8 DATE TO PDP-10 DATE

CVDATE,	0
	SNA
	JMP I CVDATE	/0 CONVERTS TO 0
	DCA TEMP1
	TAD TEMP1	/V3C
	RTR
	RAR
	AND [37
	TAD (-1		/GET DAY
	DCA DATE4	/V3C
	TAD TEMP1
	AND [7		/GET OS8 YEAR (-1970)
DECIMAL
	TAD (1970-1964
OCTAL
	DCA DATE1	/SAVE YEAR
	TAD DATE1
	CLL RAL		/*2
	TAD DATE1	/*2+1=*3
	CLL RTL		/*3*4=*12
	DCA DATE1	/DATE1=DATE1*12
	TAD TEMP1
	RTL
	RTL
	RAL
	AND [17		/GET MONTH
	TAD (-1
	TAD DATE1	/ADD IN MONTH
	DCA DATE1
	TAD DATE1
	CLL RAL		/*2
	TAD DATE1	/*2+1=*3
	DCA TEMP2
	TAD TEMP2
	CLL RTL		/*3*4=*12
	TAD TEMP2	/*12+*3=*15
	CLL RAL		/*15*2=*30
	TAD DATE1	/*30+1=*31
	TAD DATE4	/V3C ADD IN DAY
	DCA DATE1	/DATE1=DATE1+MONTH-1 * 31
	RAL		/V3C LINK NOW HAS HIGH ORDER DATE BIT
	DCA HIDATE	/ONLY WITHIN RANGE OF OS/8
	TAD DATE1	/RETURN LOW ORDER 12 BITS OF DATE
	JMP I CVDATE

DATE1,	0
DATE4,	0

/TYPE A PDP-10 DATE
DATE10,	0
	SZL		/LINK HAD HIGH ORDER BIT
	TAD (4		/IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
	DCA DATE1	/SAVE VALUE
	RAL		/V3C
	DCA DATE75	/SAVE FACT THAT NEED 'NUTHER 11 YEARS
	TAD (100	/V3C BASE IS (19)64
	DCA DATE2	/WILL BE YEAR
DATE11,	TAD DATE1
	SMA CLA
	JMP DATE12	/MUST BE POSITIVE
	ISZ DATE2	/BUMP YEAR
	TAD DATE1
	TAD (-564	/-372 DECIMAL (DAYS PER YEAR)
	DCA DATE1
	JMP DATE11

DATE12,	DCA DATE3	/WILL BE MONTH
	TAD DATE1	/DIVIDE BY 31
	TAD (-37
	SPA
	JMP .+4
	ISZ DATE3	/BUMP MONTH
	DCA DATE1
	JMP .-6

	CLA
	ISZ DATE1	/+1 IS DAY
	TAD DATE3	/DIVIDE BY 12
	TAD (-14
	SPA
	JMP .+4
	ISZ DATE2	/BUMP YEAR
	DCA DATE3
	JMP .-6

	CLA
	TAD DATE1
	TAD (-12
	SMA CLA
	JMP DATE9
	TAD ("0
	JMS I OUTPUT	/PRINT LEADING 0 IF NECESSARY
DATE9,	TAD DATE1
	JMS I (PRINT	/PRINT DAY
	TAD ("-
	JMS I OUTPUT
	TAD DATE3
	TAD DATE3
	TAD DATE3	/V3C MULTIPLY BY 3
	TAD (MONTBL	/ADD IN BASE OF MONTH NAMES
	DCA MONPTR	/POINT TO PROPER MONTH NAME
	TAD I MONPTR	/GET CHAR 1
	JMS I OUTPUT	/PRINT IT
	ISZ MONPTR	/POINT TO NEXT CHAR
	TAD I MONPTR	/GET CHAR 2
	JMS I OUTPUT	/PRINT IT
	ISZ MONPTR	/V3C
	TAD I MONPTR
	JMS I OUTPUT
	TAD ("-
	JMS I OUTPUT
	TAD DATE75	/V3C
	SZA CLA
	TAD (13		/ADD 11 YEARS IF H.O. BIT ON
	TAD DATE2
	JMS I (PRINT	/PRINT YEAR
	JMP I DATE10

DATE2,	0		/YEAR
DATE3,	0		/MONTH
MONPTR,	0		/V3C POINTS TO MONTH NAME
	PAGE
DECIMAL
PRINTL,	-1000
	-100
	-10
OCTAL

PRINTZ,	0		/PRINT WITH LEADING SPACES
	DCA PRINT0
	TAD PRINTZ
	DCA I (PRINT
	TAD (240
	JMP I (PRINT7

/ZERO A DIRECTORY (PDP-10)

ZERO10,	0		/ZERO THE PDP-10 DIRECTORY
	TAD I [MOUTPU
	AND [17
	SZA CLA
	JMP I (NOT10F	/NOT A PDP-10
	TAD I [MOUTPU
	DCA UNIT10	/SET UNIT
	TAD (DIRECT-1
	DCA INDEX0	/POINT TO DIRECTORY
	TAD (-600
	DCA CNTR	/COUNT OF 600
	DCA I INDEX0	/ZERO THE DIRECTORY
	ISZ CNTR
	JMP .-2		/LOOP
	TAD (7570
	DCA I (DIRECT	/SAVE BLOCKS 1 AND 2
	TAD (170
	DCA I (DIRECT+52	/SAVE BLOCK 144
	TAD (777
	DCA I (DIRECT+367	/SAVE BLOCKS 1102 ON UP
	CLA CMA
	DCA I (DIRECT+370
	JMS I (WRITET	/WRITE PDP-10 DECTAPE
	DIRECT		/DIRECTORY
	144		/DIRECTORY BLOCK
	CDF 10
	JMP I ZERO10	/EXIT
/DELETE A PDP-10 FILE

DELE10,	0		/DELETE A PDP-10 FILE
	TAD I [MOUTPU
	AND [17
	SZA
	JMP DELOS8	/DELETE A OS8 FILE
	TAD I [MOUTPU
	DCA UNIT10	/SET UNIT
	TAD [MOUTPU
	CDF
	JMS I (DELETE	/DELETE THE PDP-10 FILE
	JMP I (ERDELF	/NOT THERE
	JMS I (WRITET	/WRITE PDP-10 DECTAPE
	DIRECT
	144		/DIRECTORY BLOCK
	JMP I DELE10	/EXIT

DELOS8,	CIF CDF 10
	JMS I (DELPS1	/DELETE A OS8 FILE
	JMP I DELE10
	JMP I (ERDELF	/ERROR DELETING THE FILE
PAGE

/GET THE NEXT INPUT FILE

NEXIFL,	0		/GET THE NEXT INPUT FILE
	DCA CHARNI	/RESET STUFF
	DCA WORDS
	CDF 10
	CLA CMA
	DCA I (INCHCT
	DCA I (INEOF
	TAD (INDEVH+1
	DCA INDEVX
	TAD I IXR	/GET NEXT
	SNA
	JMP NEXIF2	/E.O.F
	DCA IUNIT
	TAD I IXR
	DCA IBLOCK	/SET START BLOCK
	CDF
	TAD IUNIT
	AND [17
	SNA
	JMP NEXIF1	/PDP-10 FILE
	CIF 10
	JMS I [200
	1
INDEVX,	0
	JMP I (NOOFIL
	CDF 10
	TAD INDEVX
	DCA I (INHNDL
	TAD IBLOCK
	DCA I (INREC
	TAD IUNIT
	AND [7760
	SZA
	TAD [17
	CLL CML RTR
	RTR
	DCA I (INCTR
	TAD (ICHRPS
	JMP NEXIF3

NEXIF1,	TAD IUNIT
	DCA UNIT10
	TAD IBLOCK
	DCA .+3
	JMS I (READT
	IBUF10
	0		/READ ANY BLOCK
	CDF 10
	TAD I [IBUF10+2
	RTL
	RTL
	RAL
	AND [17
	DCA IBLOCK
	TAD I [IBUF10+1
	AND [77
	CLL RTL
	RTL
	TAD IBLOCK
	DCA IBLOCK	/SET START BLOCK
	TAD (ICHR10
NEXIF3,	DCA INPUT	/SET ROUTINE POINTER
	ISZ NEXIFL
NEXIF2,	CDF
	JMP I NEXIFL	/EXIT

ICHRPS,	0
	CIF CDF 10
	JMS I (ICHARP
	SKP
	ISZ ICHRPS
	JMP I ICHRPS

OCHRPS,	0
	CIF 10
	JMS I (OCHARP
	JMP I (IOERR
	JMP I OCHRPS
	PAGE
PIP10,	CDF 10		/STARTS HERE - JUMPED TO FROM 200
	DCA HIDATE	/V3C
	TAD I (MDATE	/GET TODAY'S DATE
	CDF
	JMS I (CVDATE	/CONVERT IT
	DCA DATE	/AND STORE IT
	TAD	(3401	/UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
	DCA I	(JSBITS
PIPCD,	CDF
	JMS I (CD	/COMMAND DECODE
	CDF 10
	TAD I (MPARAM
	AND (2010
	CLL RAL
	DCA MODE	/SET /I SWITCH
	TAD I (MPARAM+1
	AND (400
	DCA SAVELN	/SET /P SWITCH
	TAD I (MPARAM
	AND (101
	SZA CLA
	JMP I (LIST10	/EITHER /F OR /L
	TAD I [MOUTPU
	SZA CLA
	JMP PIP001	/IS AN OUTPUT FILE
	TAD I (MINPUT
	SNA CLA
	JMP PIPCD	/NO OUTPUT OR INPUT FILES
	JMP I (NOOOFL	/INPUT, BUT NO OUTPUT

PIP001,	CLL CLA CML RTR
	AND I (MPARAM+2
	SZA CLA
	JMS I (ZERO10	/IT IS /Z OPTION
	TAD (OUDEVH+1
	DCA OUDEVX
	TAD I [MOUTPU
	AND [17
	SZA
	JMP PIPB	/OUTPUT IS OS8
	TAD I [MOUTPU
	DCA UNIT10	/SET UNIT
	JMS I (READT
	DIRECT		/GET DIRECTORY INTO CORE
	144
PIPA,	CDF 10
	TAD OUDEVX
	DCA I (OUHNDL
	TAD I (MPARAM
	AND (400
	SZA CLA
	JMS I (DELE10	/DELETE A PDP-10 FILE FIRST
	CDF 10
	TAD (MINPUT-1
	DCA IXR
	TAD I IXR
	SNA CLA
	JMP PIPCD	/NO INPUT
	TAD (MINPUT-1
	DCA IXR		/SET INPUT LIST
	TAD I [MOUTPU
	AND [17
	CDF
	SZA CLA
	JMP PIPC	/OUTPUT IS OS8
	JMS I (OOPN10	/OPEN PDP-10 OUTPUT
	TAD (OCHR10
PIPD,	DCA OUTPUT	/SET OUTPUT ROUTINE
PIPE,	SZA CLA		/IS IT ERROR OR EOF
	JMP I (IOERR	/ERROR
	JMS I (NEXIFL	/GET NEXT FILE
	JMP PIPF	/FINAL EOF
	JMS I INPUT	/GET INPUT
	JMP PIPE	/EOF OR ERROR
	JMS I OUTPUT	/OUTPUT
	JMP .-3		/LOOP

PIPC,	CIF CDF 10
	JMS I (OOPNPS	/OPEN OS8 OUTPUT
	JMP I (NOOOFL
	TAD (OCHRPS
	JMP PIPD

PIPB,	CDF 0
	CIF 10
	JMS I [200
	1		/GET OS8 OUTPUT HANDLER
OUDEVX,	0
	JMP I (NOOFIL
	JMP PIPA

PIPF,	CDF 10
	TAD I [MOUTPU	/NOW CLOSE THE OUTPUT FILE
	AND [17
	CDF
	SZA CLA
	JMP PIPG
	JMS I (CLOS10
	JMP PIPCD

PIPG,	CIF CDF 10
	JMS I (OCLOSE
	JMP I (IOERR
	JMP PIPCD
	PAGE
LIST10,	TAD (OUDEVH+1
	DCA OUDEVY
	TAD (OUDEVH+1
	DCA OUDEVZ
	TAD (3100	/RESET THINGS
	DCA LISTDV+1
	TAD I [MOUTPU
	SZA
	JMP LIST11	/OUTPUT FILE EXISTS
	CDF 0
	CIF 10
	JMS I [200
	1
LISTDV,	TEXT /TTY/	/LOOKUP THE TTY:
OUDEVY,	0
	JMP I (NOOOFL
	CDF 10
	TAD LISTDV+1
	DCA I [MOUTPU	/SET TTY: DEVICE NUMBER
	TAD I [MOUTPU
LIST11,	AND [17
	SNA
	JMP I (NOTPSF	/NOT A OS8 FILE
	CDF 0
	CIF 10
	JMS I [200
	1		/LOOKUP DEVICE
OUDEVZ,	0
	JMP I (NOOFIL
LIST12,	CDF CIF 10
	TAD OUDEVZ
	DCA I (OUHNDL
	JMS I (OOPNPS	/OPEN OUTPUT FILE
	JMP I (NOOOFL
	TAD (OCHRPS
	DCA OUTPUT	/SET OUTPUT ROUTINE
	CDF 10
	TAD I (MINPUT
	DCA UNIT10
	CDF
	TAD UNIT10
	SNA
	JMP I (PIPCD	/NO INPUT
	AND [17
	SZA CLA
	JMP I (NOT10F
	JMS I (READT	/READ THE DIRECTORY
	DIRECT
	144
	TAD (LISTL-1
	DCA INDEX0
	TAD (-40
	DCA CNTR
	DCA I INDEX0	/CLEAR THE COUNTS
	ISZ CNTR
	JMP .-2
	TAD (-1101
	DCA LIST13
	CLA IAC
	DCA LIST14
	JMS I (FINDSL	/FIND ALL SLOTS
LIST14,	0
	TAD (LISTL
	DCA LIST15
	ISZ I LIST15	/COUNT THE NUMBER IN EACH SLOT
	ISZ LIST14
	ISZ LIST13
	JMP LIST14-1
	JMS I	(CRLF
	TAD I (LISTL
	JMS I (PRINTZ	/PRINT FREE BLOCKS
	TAD (LISTM1-1
	DCA INDEX0
	JMS I (ERROR4	/"FREE BLOCKS"
	JMS I	(CRLF
	TAD (-26
	DCA LIST13
	TAD (DIRECT+370
	DCA INDEX6
	TAD (DIRECT+2	/HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
	DCA XDATE	/PDP-10 WORD AT BEGIN OF DIRECTORY
			/THIS IS END OF EVERY 3RD PDP-8 WORD
LIST17,	CDF 10		/MAIN LOOP
	TAD I INDEX6
	SNA
	JMP I (LIST16	/DO NOT PRINT THIS BLANK ENTRY
	JMS I (LIST18
	TAD I INDEX6
	JMS I (LIST18
	TAD I INDEX6
	JMS I (LIST18
	CDF
	TAD (".
	JMS I OUTPUT
	JMP I (LIST22

LIST13,	0
LIST15,	0
	PAGE
LIST22,	CDF 10
	TAD INDEX6
	TAD [77
	DCA INDEX5
	TAD I INDEX5	/GET EXTENSION
	JMS LIST18
	TAD I INDEX5
	AND [7700
	JMS LIST18
	CLA IAC
	AND I (MPARAM
	SNA CLA
	JMP LIST19	/NO EXTRA IF NOT /L
	JMS LIST18
	CDF
	TAD I (LIST13
	TAD (LISTL+27
	DCA LIST23
	TAD I LIST23	/GET NUMBER OF BLOCKS
	JMS I (PRINTZ
	JMS LIST18
	TAD I XDATE	/V3C
	RAR		/HIGH ORDER BIT OF DATE TO LINK
	CLA
	TAD I INDEX5
	CDF
	JMS I (DATE10
LIST19,	CDF
	JMS CRLF
LIST20,	CDF
	TAD XDATE	/V3C
	TAD (3		/POINT TO NEXT DATE H.O. BIT
	DCA XDATE
	ISZ I (LIST13
	JMP I (LIST17	/LOOP
	JMS CRLF
	JMP I (PIPG	/CLOSE THE FILE

LIST16,	ISZ INDEX6
	ISZ INDEX6
	JMP LIST20

CRLF,	0
	TAD [215
	JMS I OUTPUT
	TAD [212
	JMS I OUTPUT
	JMP I CRLF

LIST23,	0

LIST18,	0
	CDF
	DCA TEMP1
	TAD TEMP1
	RTR
	RTR
	RTR
	JMS LIST21
	TAD TEMP1
	JMS LIST21
	CDF 10
	JMP I LIST18

LIST21,	0
	AND [77
	TAD [240
	JMS I OUTPUT
	JMP I LIST21
/FIND A PDP-10 ENTRY IN DIRECTORY
/
/CALL:
/	(AC)		/POINT TO NAME-1 (FIELD 1)
/	JMS FIND	/FIND A PDP-10 ENTRY
/	-NO-		/NOT FOUND
/	(AC)		/SLOT NUMBER IF FOUND

FIND,	0		/FIND A PDP-10 FILE
	DCA FIND4	/SAVE POINTER
	TAD (DIRECT+370
	DCA INDEX0	/POINT TO DIRECTORY START
	TAD (-26
	DCA CNTR	/22 DECIMAL FILES
	CDF 10		/DIRECTORY IS IN FIELD 1
FIND2,	TAD FIND4		/GET POINTER
	DCA INDEX2	/POINT TO NAME,EXT
	TAD I INDEX0
	CIA
	TAD I INDEX2	/CHECK WORD 1
	SZA CLA
	JMP FIND1	/NO
	TAD I INDEX0
	CIA
	TAD I INDEX2	/CHECK WORD 2
	SZA CLA
	JMP FIND1+1	/NO
	TAD I INDEX0
	CIA
	TAD I INDEX2	/CHECK WORD 3
	SZA CLA
	JMP FIND1+2	/NO
	TAD INDEX0
	TAD [77
	DCA INDEX1	/POINT TO EXTENSIONS
	TAD I INDEX1
	CIA
	TAD I INDEX2	/CHECK WORD 4
	SZA CLA
	JMP FIND1+2	/NO
	TAD I INDEX1
	AND [7700
	CIA
	TAD I INDEX2	/CHECK WORD 5
	SZA CLA
	JMP FIND1+2	/NO
	CLL CLA CMA RTL
	TAD INDEX0
	DCA INDEX0	/POINT TO ENTRY AGAIN
	TAD CNTR
	TAD (27
	ISZ FIND	/WE FOUND IT - 2ND EXIT
FIND3,	CDF		/BACK TO FIELD 0
	JMP I FIND	/EXIT

FIND1,	ISZ INDEX0	/EXTRA POINTER BUMPS
	ISZ INDEX0
	ISZ CNTR	/MORE FILES?
	JMP FIND2	/YES - LOOP
	JMP FIND3	/NO - NOT FOUND

FIND4,	0		/POINTER TO NAME-1
	PAGE
LINBUF=.
LISTL,	ZBLOCK 105

LISTM1,	TEXT / FREE BLOCKS   PIP10  V/
VERLOC,	*.-1
	60+VERSION^100+SUBVER
	3700

ERMES0,	TEXT	/_PIP10 CANNOT BE CHAINED TO_/
ERMES1,	TEXT #_I/O ERROR_#

ERMES2,	TEXT /_DEVICE FULL_/

ERMES3,	TEXT /_NO SUCH DEVICE_/

ERMES4,	TEXT /_NOT PDP-10 FILE_/

ERMES5,	TEXT /_ERROR DELETING FILE_/

ERMES6,	TEXT /_NOT OS8 FILE_/

ERMES7,	TEXT /_OUTPUT FILE OPEN ERROR_/

ERMES8,	TEXT /_SYNTAX ERROR_/
ERMES9,	TEXT	/_FILE NOT FOUND_/
/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10

TDUSET,	0
	TAD	UNIT10
	CLL RTL
	RAL
	AND	(7
	TAD	(DVCTBL
	DCA	DVCPTR
	RAR
	DCA	TDUNIT	/SAVE EVEN/ODD BIT
	TAD	(TDUTBL
	DCA	TDUPTR
TDULP,	TAD I	TDUPTR
	SNA
	JMP I	TDUSET
	DCA	TDUT
	TAD I	TDUT
	AND	(7
	TAD I	DVCPTR
	DCA I	TDUT
	ISZ	TDUPTR
	JMP	TDULP
TDUPTR,	0
TDUT,	0
DVCPTR,	0
DVCTBL,	6770;6760;6750;6740

TDUTBL,	DIO01
	DIO02
	DIO03
	DIO04
	DIO05
	DIO06
	DIO07
	DIO08
	DIO09
	DIO10
	DIO11
	DIO12
	DIO13
	DIO14
	DIO15
	DIO16
	DIO17
	DIO18
	DIO19
	DIO20
	DIO21
	DIO22
	IOTX1
	IOTX2
	IOTX3
	IOTX4
	IOTX5
	IOTX6
	IOTX7
	IOTX8
	0
	PAGE
/GET A CHARACTER

GCH,	0
	TAD I IXR	/GET A CHAR
	TAD (-240
	SNA
	JMP GCH+1	/IGNORE SPACES
	TAD (240-"/
	SNA
	JMP SLASH
	TAD ("/-"(
	SNA
	JMP OPENP
	TAD ("(
	JMP I GCH	/EXIT

SLASH,	TAD I IXR
	JMS SLSHCH	/GET OPTION
	JMP GCH+1

OPENP,	TAD I IXR
	TAD (-")
	SNA
	JMP GCH+1	/END
	TAD (")
	JMS SLSHCH	/GET OPTION
	JMP OPENP

SLSHCH,	0
	SNA
	JMP I (SYNTAX	/ERROR
	DCA TEMP6
	TAD (MPARAM-1
	DCA TEMP5	/POINT TO PARAMETERS
	JMS DECODE
	JMP I (SYNTAX
	SZL
	TAD (32		/ADD
	TAD (-14
	ISZ TEMP5
	SMA
	JMP .-3		/FIND DIVIDED BY 12
	DCA TEMP4
	CLL CML
	RAL
	ISZ TEMP4
	JMP .-2		/SHIFT A BIT
	DCA TEMP4	/SAVE IT
	CDF 10
	TAD TEMP4
	CMA
	AND I TEMP5
	TAD TEMP4	/OR IN THAT BIT
	DCA I TEMP5
	CDF
	JMP I SLSHCH

DECODE,	0
	TAD TEMP6
	TAD (-"9-1
	CLL
	TAD ("9+1-"0
	SZL
	JMP DECOD1
	TAD ("0-"Z-1
	CLL CML
	TAD ("Z-"A+1
	SNL
DECOD1,	ISZ DECODE
	JMP I DECODE

EXA40,	0
	TAD (CDNAME
	DCA TEMP5
	TAD (-5
	DCA TEMP4
EXA401,	CLL CLA CML RAR
	TAD I TEMP5
	AND [7700
	CLL RAL
	SZA
	RAR
	DCA TEMP3
	TAD I TEMP5
	TAD (40
	AND [77
	TAD (-40
	SZA
	TAD (40
	TAD TEMP3
	DCA I TEMP5
	ISZ TEMP5
	ISZ TEMP4
	JMP EXA401
	JMP I EXA40
	PAGE
/GET A NAME ROUTINE

GNAME,	0
	DCA CDDEV	/CLEAR AREA
	DCA CDDEV+1
	CLA CMA
	DCA DEVSW	/ALLOW DEVICES
GNAME1,	DCA CDNAME	/CLEAR NAME,EXTENSION
	DCA CDNAME+1
	DCA CDNAME+2
	DCA CDEXT
	DCA CDEXT+1
	CLA CMA
	DCA PERSW	/ALLOW EXTENSIONS
	TAD (CDNAME
	DCA POINT	/SET POINTER
	DCA CNTR	/SET SWITCH
GNAME2,	JMS I (GCH	/GET A CHAR
	DCA TEMP6
	TAD TEMP6
	SNA
	JMP GNAME6	/END
	TAD (-":
	SNA
	JMP GNAME5	/: IS DEVICE
	TAD (":-".
	SNA
	JMP GNAME4	/. IS EXTENSION
	TAD (".
	DCA TEMP6	/SAVE THE CHAR
	JMS I (DECODE
	JMP GNAME6-1	/NOT 0-9 OR A-Z IS END
	CLA
	TAD TEMP6
	AND [77		/GET TRIMMED ASCII
	ISZ CNTR
	JMP GNAME3	/LEFT HALF
	TAD I POINT
	DCA I POINT	/SET RIGHT HALF
	ISZ POINT
	JMP GNAME2	/LOOP

GNAME3,	CLL RTL
	RTL
	RTL
	DCA I POINT	/SET LEFT HALF
	CLA CMA
	DCA CNTR
	TAD POINT
	TAD (-CDEXT-2
	SZA CLA
	JMP GNAME2	/LOOP
	JMP GNAME2-1	/LOOP - IGNORE

GNAME4,	TAD CDNAME
	SZA CLA
	ISZ PERSW
	JMP I (SYNTAX	/ERROR
	DCA CDEXT
	DCA CDEXT+1	/CLEAR EXTENSION
	TAD (CDEXT
	JMP GNAME2-2	/GET EXTENSION

GNAME5,	ISZ DEVSW
	JMP I (SYNTAX	/ERROR
	ISZ PERSW
	JMP I (SYNTAX	/ERROR
	TAD CDNAME
	SNA
	JMP I (SYNTAX	/ERROR
	DCA CDDEV
	TAD CDNAME+1
	DCA CDDEV+1	/SET DEVICE
	JMP GNAME1	/NOW GET THE NAME

	CLA
GNAME6,	DCA CDEXT+2
	TAD CDEXT+1
	AND [7700
	DCA CDEXT+1
	ISZ PERSW
	JMP I GNAME	/EXIT
	DCA CDEXT
	DCA CDEXT+1	/CLEAR EXTENSION
	JMP I GNAME	/EXIT
	PAGE
CD,	0
	TAD [MOUTPU-1
	DCA INDEX0
	TAD (-47
	DCA CNTR
	CDF 10
	DCA I INDEX0	/CLEAR AREAS
	ISZ CNTR
	JMP .-2
	CDF
	CIF 10
	JMS I [200
	13		/RESET TABLES
	0
	DCA INSEG	/NO DIRECTORY IN CORE
	DCA PDP10D	/NO KNOWN PDP-10 DRIVES
	DCA PDP10D+1
	DCA PDP10D+2
	DCA PDP10D+3
	DCA PDP10D+4
	DCA PDP10D+5
	DCA PDP10D+6
	DCA PDP10D+7
	DCA CDCNT	/ZERO INPUT COUNT
	JMS I (GLINE	/GET A LINE
	TAD [LINBUF-1
	DCA IXR
	TAD I IXR
	SNA
	JMP NOBAKB	/NO "<" IS LINE
	TAD (-"<
	SZA CLA
	JMP .-5
	TAD [LINBUF-1
	DCA IXR
	TAD XDSK
	DCA CDDEVF	/SET "DSK" AS DEFAULT
	TAD XDSK+1
	DCA CDDEVF+1
	JMS I (GNAME	/GET THE NAME
	TAD TEMP6
	TAD (-"[
	SZA CLA
	JMP CDX03	/NO SIZE SPECIFIED
CDX01,	JMS I (GCH
	TAD (-"]
	SNA
	JMP CDX02	/END OF SIZE
	TAD ("]-"0
	SPA
	JMP I (SYNTAX	/ERROR
	DCA TEMP1
	TAD CDEXT+2
	CLL RTL
	TAD CDEXT+2
	RAL
	TAD TEMP1
	DCA CDEXT+2	/ADD IN NUMBER
	TAD TEMP1
	TAD (-11
	SMA SZA CLA
	JMP I (SYNTAX	/ERROR
	JMP CDX01

CDX02,	JMS I (GCH
	SKP
CDX03,	TAD TEMP6
	TAD (-"<
	SZA CLA
	JMP I (SYNTAX	/ERROR
	JMS I (CDOUTX	/SET OUTPUT STUFF
NOBAKA,	TAD (MINPUT-1
	DCA INDEX6
	TAD XDSK
	DCA CDDEVF	/SET DEFAULT
	TAD XDSK+1
	DCA CDDEVF+1
	TAD IXR
	DCA CDI04	/SAVE POINTER
	JMS I (GCH
	SNA CLA
	JMP I CD	/NO INPUT FILES
	TAD CDI04
	DCA IXR		/RESET POINTER
CDI01,	JMS I (GNAME	/GET A FILE
	ISZ DEVSW
	JMP CDI02	/DEVICE SPECIFIED
	TAD CDDEVF
	DCA CDDEV
	TAD CDDEVF+1
	DCA CDDEV+1	/SET DEFAULT DEVICE
CDI02,	TAD CDDEV
	DCA CDDEVF
	TAD CDDEV+1
	DCA CDDEVF+1	/SET NEW DEFAULT
	ISZ CDCNT	/COUNT INPUT FILES
	TAD CDCNT
	TAD (-12
	SMA CLA
	JMP I (SYNTAX	/TOO MANY FILES
	JMS I (CDINX	/SET INPUT STUFF
	TAD TEMP6
	SNA
	JMP I CD	/MAIN EXIT
	TAD (-",
	SNA CLA
	JMP CDI01
	JMP I (SYNTAX	/ERROR

NOBAKB,	TAD [LINBUF-1
	DCA IXR
	JMP NOBAKA
	PAGE
CDOUTX,	0		/SET OUTPUT STUFF
	ISZ DEVSW
	JMP CDOUT9	/DEVICE SPECIFIED
	TAD CDNAME
	SNA CLA
	JMP I CDOUTX	/NO NAME AND NO DEVICE IS NOTHING
	TAD CDDEVF
	DCA CDDEV
	TAD CDDEVF+1
	DCA CDDEV+1	/SET DEFAULT DEVICE
CDOUT9,	TAD (OUDEVH+1
	DCA CDOUT2	/SET OUTPUT HANDLER ADDRESS
	TAD [MOUTPU-1
	DCA INDEX6
	TAD CDDEV
	DCA CDOUT1
	TAD CDDEV+1
	DCA CDOUT1+1	/SET DEVICE
	CIF 10
	JMS I [200
	12		/FIND HANDLER
CDOUT1,	0
	0
CDOUT2,	0
	JMP I (NOOFIL
	TAD CDOUT1+1
	JMS I	(GTDVTP	/GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
	SZA CLA
	JMP CDOUT3	/NOT DECTAPE
	TAD (OUDEVH+1
	DCA CDOUT5
	TAD CDOUT1+1
	CIF 10
	JMS I [200
	1		/GET HANDLER
CDOUT5,	0
	JMP I (NOOFIL
	TAD CDOUT5
	JMS	SETUNT	/SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
	JMS I (ROCK	/CHECK THE TAPE
	JMP CDOUT3	/NOT PDP-10 DECTAPE
	JMS I (EXA40	/EXCESS 40 CONVERSION
	TAD UNIT10
	JMP CDOUT4	/SET PARAMETERS

CDOUT3,	DCA CDEXT+1
	TAD CDEXT+2	/GET LENGTH
	TAD (-400
	SPA CLA
	TAD CDEXT+2	/O.K. - USE LENGTH
	CLL RTL
	RTL
	AND [7760	/8 BIT LENGTH
	TAD CDOUT1+1	/ADD IN DEVICE NUMBER
CDOUT4,	CDF 10
	DCA I INDEX6	/SET DEVICE
	TAD CDNAME
	DCA I INDEX6	/SET NAME
	TAD CDNAME+1
	DCA I INDEX6
	TAD CDNAME+2
	DCA I INDEX6
	TAD CDEXT
	DCA I INDEX6
	TAD CDEXT+1
	DCA I INDEX6
	CDF
	JMP I CDOUTX	/EXIT

SETUNT,	0
	STL
	TAD	(-7607
	SZA		/IF IT IS 7607,
	TAD	(7	/ITS UNIT 0
	AND	(7
	CLL CML RTR
	RTR
	DCA	UNIT10
	TAD	DVTYPE
	AND	(10
	SNA CLA
	JMP I	SETUNT	/TC08 - FINISHED
	CLL
	TAD	UNIT10
	AND	(7000	/TD8E ENTRY POINTS ARE STRANGE -
	TAD	UNIT10	/MUST ROTATE UNIT NUMBER LEFT 1
	SZL
	TAD	(1000
	DCA	UNIT10
	JMS I	(TDUSET	/SET UP TD8E OPCODES
	JMP I	SETUNT
	PAGE
CDINX,	0		/SET INPUT STUFF
	TAD (OUDEVH+1
	DCA CDIN1
	TAD CDDEV
	DCA CDIN2	/SET DEVICE
	TAD CDDEV+1
	DCA CDIN2+1
	CIF 10
	JMS I [200
	1		/GET HANDLER
CDIN2,	0
	0
CDIN1,	0
	JMP I (NOOFIL
	TAD CDIN2+1
	JMS	GTDVTP	/COMPARE DCB ENTRY WITH TC08 OR TD8E
	SZA CLA
	JMP CDIN3	/NOT DECTAPE
	TAD CDIN1
	JMS I	(SETUNT	/SET UP UNIT NUMBER
	JMS I (ROCK	/CHECK THE TAPE
	JMP CDIN3	/NOT PDP-10 DECTAPE
	JMS I (EXA40	/DO EXCESS 40
	TAD INSEG
	CIA
	TAD UNIT10	/IS DIRECTORY IN CORE?
	SNA CLA
	JMP CDIN8	/YES - NO READ
	TAD CDNAME
	SNA CLA
	JMP CDIN7	/NO NAME - NO READ
	JMS I (READT
	DIRECT		/READ DIRECTORY
	144
	TAD UNIT10
	DCA INSEG	/SET DIRECTORY IN CORE
CDIN8,	TAD (-5
	DCA CNTR
	TAD (CDNAME-1
	DCA INDEX0
	TAD (CDINXX-1
	DCA INDEX1
	TAD I INDEX0
	CDF 10
	DCA I INDEX1
	CDF
	ISZ CNTR
	JMP .-5
	TAD (CDINXX-1
	JMS I (IOPN10	/OPEN THE PDP-10 FILE
	JMP I (FNOTFD
CDIN7,	DCA CDIN4
	TAD UNIT10
	JMP CDIN6

CDIN3,	TAD (CDNAME
	DCA CDIN4
	TAD CDNAME
	SNA CLA
	JMP CDIN9	/NO LOOKUP IF NO NAME
	TAD CDIN2+1
	CIF 10
	JMS I [200
	2
CDIN4,	CDNAME		/LOOKUP
CDIN5,	0
	JMP I (FNOTFD
	TAD CDIN5
	TAD (400
	SPA
	CLA
	CLL RTL
	RTL
	AND [7760	/GET LENGTH
	TAD CDIN2+1	/ADD DEVICE
CDIN6,	CDF 10
	DCA I INDEX6
	TAD CDIN4
	DCA I INDEX6	/SET BLOCK STARTING
	CDF
	JMP I CDINX

CDIN9,	DCA CDIN4
	JMP CDIN6-1

GTDVTP,	0
	TAD (DCB-1
	DCA TEMP1
	CDF 10
	TAD I TEMP1	/GET DCB ENTRY
	CDF
	DCA	DVTYPE
	TAD	DVTYPE
	AND	(770
	TAD	(-210
	SZA
	TAD	(30
	JMP I	GTDVTP
	PAGE
ROCK,	0
	JMS	GET10D	/GET ENTRY IN TAPE TYPE TABLE
	SNA
	JMP ROCK4	/UNKNOWN - ROCK IT
	SMA CLA
	ISZ ROCK
	JMP I ROCK	/EXIT

GET10D,	0
	TAD UNIT10
	CLL RTL
	RTL
	TAD (PDP10D
	DCA TEMP5	/POINT TO KNOWN TABLE
	TAD I TEMP5
	JMP I	GET10D

ROCK4,	CLA CMA
	DCA I TEMP5
	TAD	DVTYPE
	AND	(10
	SZA CLA		/WHAT KIND OF TAPE?
	JMP	TDCHK	/TD8E
	TAD (OBUF10-1
	DCA I (7755
	TAD (10
	DTLB
ROCK1,	RTL
	RAL
	SZL CLA
	TAD (-400
	TAD UNIT10
	TAD (210
	DTCA DTXA
ROCK2,	JMS	DTWAIT

ROCK3,	SPA
	JMP ROCK1
	CLA
	TAD (OBUF10-1
	DCA I (7755
	TAD (-600
	DCA I (7754
	TAD (30
	DTXA
	DTSF DTRB
	JMP .-1
	SPA CLA
	JMP ROCK4	/RETRY
	TAD [200
	DTXA		/STOP DRIVE
	TAD I (7754
	SZA CLA
	JMP I ROCK	/OS8 UNIT
	CLA IAC
SET10,	DCA I TEMP5
	ISZ ROCK
	JMP I ROCK	/PDP-10 UNIT

DTWAIT,	0		/WAIT FOR DECTAPE FLAG
	DTSF DTRB
	SKP CLA
	JMP I	DTWAIT
	KSF
	JMP DTWAIT+1
	TAD [200
	KRS
	TAD (-203
	SZA CLA
	JMP DTWAIT+1
	TAD	[200
	DTXA	/STOP THE TAPE
	JMP I [7600

TDCHK,	CLA STL RTR
	TAD	TDUNIT
IOTX1,	SDLC
	CLA
IOTX2,	SDRC
	AND	(100	/CHECK FOR TAPE NOT READY
	SZA CLA
	JMP	TDCHK	/WAIT FOR TAPE TO COME UP
	TAD	TDUNIT
	TAD	(1000
IOTX3,	SDLC
	JMS	SKIP4
	JMS	SKIP4
IOTX4,	SDSS
	JMP	.-1
IOTX5,	SDRC
	AND	[77
	TAD	(-26
	SZA CLA		/WAIT FOR GUARD
	JMP	IOTX4
	DCA	TDT
TDCLP,	JMS	SKIP4
	ISZ	TDT
	AND	[77
	TAD	(-51	/SEARCH FOR SOME CRAP NEAR END OF RECORD
	SZA CLA
	JMP	TDCLP
	TAD I	(UNIT
IOTX6,	SDLC		/STOP TAPE
	CLA
	TAD	TDT
	TAD	(-611	/9 WORDS FOR GOOD LUCK
	SZA CLA
	JMP I	ROCK
	STL RTL		/SET TABLE ENTRY TO 2 FOR TD8E TAPE
	JMP	SET10

SKIP4,	0
IOTX7,	SDSQ
	JMP	.-1
IOTX8,	SDRC
	JMP I	SKIP4
TDT,	0
	PAGE
	FIELD 0		/DUMP PG 0 LITERALS HERE
/TD8E DECTAPE ROUTINE
/VERSION 01

/JULY 2 1971		GB/RL/EF

/COPYRIGHT 1971		DIGITAL EQUIPMENT CORP.
/			MAYNARD, MASS.

/ABSTRACT--
/	THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
/WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
/SEQUENCES.

/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
/CONTROL:
/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
/B) THE ORIGIN OF THE TWO PAGE ROUTINE
/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN

/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
/DEC VERSION OF THIS ROUTINE:

	DRIVE=10	/UNITS 0 AND 1 SELECTED
	ORIGIN=6200	/ENTRIES AT 6200 AND 6204
	AFIELD=0	/INITIAL FIELD SETTING
	MFIELD=00	/AFIELD*10=MFIELD
	WDSBLK=600	/384 WORDS PER BLOCK

/THE USE OF THE PARAMETERS IS AS FOLLOWS:

/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
/	DRIVE=10 IMPLIES UNITS 0 &1
/	DRIVE=20 IMPLIES UNITS 2&3
/	DRIVE=30 IMPLIES UNITS 4&5
/	DRIVE=40 IMPLIES UNITS 6&7

/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
/	MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
/THAT THIS IS A TWO PAGE ROUTINE.

/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
/	LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.

/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
/	THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
/	THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.

/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE 
/	IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
/	128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
/	BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
/	FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
/	FORMATTED TO CONTAIN.

/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
/PER BLOCK, THE PARAMETERS WOULD BE:
/	DRIVE=20
/	ORIGIN=3000
/	AFIELD=2
/	MFIELD=20
/	WDSBLK=400

/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
/CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
/THE CALLING SEQUENCE IS:

/	CDF CURRENT
/	CIF MFIELD	/MFIELD=FIELD ASSEMBLED IN
/	JMS ENTRY	/ENTRY=ORIGIN (EVEN NUMBERED DRIVE
			/AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
/	ARG1
/	ARG2
/	ARG3
/	ERROR RETURN
/	NORMAL RETURN

/THE ARGUMENTS ARE:

/ARG1: FUNCTION WORD	BIT0: 0=READ, 1=WRITE
/			BITS 1-5: # BLOCKS IN OPERATION
/			BITS 6-8: FIELD OF BUFFER AREA
/			BIT 9: UNUSED
/			BIT 10: # OF WORDS/BLOCK.
/			0= WDSBLK, 1=WDSBLK-1
/			BIT 11: 1=START FORWARD, 0=REVERSE

/ARG2: BUFFER ADDRESS FOR OPERATION
/ARG3: STARTING BLOCK FOR OPERATION

/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
/		TOO GREAT A BLOCK NUMBER
/	FATAL ERRORS TAKE ERROR RETURN WITH THE
/	AC=4000.
/B) NON-FATAL- SELECT ERROR.
/	IF NO PROPER UNIT IS SELECTED, THE ERROR
/	RETURN IS TAKEN WITH CLEAR AC.
/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.

/THE TD8E IOT'S ARE:
	SDSS=7001-DRIVE	/SKIP ON SINGLE LINE FLAG
	SDST=7002-DRIVE	/SKIP ON TIMING ERROR
	SDSQ=7003-DRIVE	/SKIP ON QUAD LINE FLAG
	SDLC=7004-DRIVE	/LOAD COMMAND REGISTER
	SDLD=7005-DRIVE	/LOAD DATA REGISTER
	SDRC=7006-DRIVE	/READ COMMAND REGISTER
	SDRD=7007-DRIVE	/READ DATA REGISTER

/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
/THE OTHERS CONTROL UNITS 2-7.

	BLOCK=DTA1

	FIELD AFIELD
	*ORIGIN
DTA0,	0		/ENTRY POINT FROM UNIT 0
	CLA CLL		/0 TO LINK
	JMP DTA1X
C1000,	1000
DTA1,	0		/UNIT 2 ENTRY
	CLA CLL CML	/1 TO LINK
	TAD DTA1
	DCA DTA0	/PICK UP ARGS AT DTA0
DTA1X,	RAR
	DCA UNIT	/LINK TO UNIT POSITION
	RDF
	TAD C6203	/GET DATA FIELD AND SETUP RETURN
	DCA LEAVE
	TAD I DTA0	/GET FUNCTION WORD
DIO01,	SDLD		/PUT FUNCTION INTO DATA REGISTER
	CLL RTR		/AC STILL HAS FUNCTION. PUT # WORDS PER
			/BLOCK INTO LINK
	SZL CLA		/KNOCK ONE OFF WDSBLK?
	IAC 		/YES
	TAD MWORDS
	DCA WCOUNT	/STORE MASTER WORD COUNT
	ISZ DTA0	/TO BUFFER
	TAD I DTA0
	DCA BUFF
	ISZ DTA0	/TO BLOCK NUMBER
	TAD I DTA0
	DCA BLOCK
	ISZ DTA0	/POINT TO ERROR EXIT
	CIF CDF MFIELD	/TO ROUTINES DATA FIELD
DIO02,	SDRD		/GET FUNCTION INTO AC
	CLL RAL
	AND CM200	/GET # PAGES TO XFER
	DCA PGCT
DIO03,	SDRD
C374,	AND C70		/GET FIELD FOR XFER
	TAD C6203	/FORM CDF N
	DCA XFIELD	/IF=0 AND DF=N AT XFER.
	CLA CLL CMA RTL
	DCA TRYCNT	/3 ERROR TRIES
	TAD UNIT	/TEST FOR SELECT ERROR
DIO04,	SDLC
DIO05,	SDRC
	AND C100
	SZA CLA
	JMP FATAL-1

DIO06,	SDRD		/PUT FUNCT INTO XFUNCT IN SECOND PG.
	DCA I CXFUN
	TAD WCOUNT
	DCA I CXWCT
DIO07,	SDRD		/GET MOTION BIT TO LINK
	CLL RAR
	JMP GO		/AND START THE MOTION.
DIO08,
RWCOM,	SDST		/ANY CHECKSUM ERRORS?
	SZA CLA		/OR CHECKSUM ERRORS?
	JMP TRY3	/PLEASE NOTE THAT THE LINK IS ALWAYS
			/SET AT RWCOM. GETCHK SETS IT.
	TAD PGCT	/NO ERROR..FINISHED XFER?
	TAD CM200
	SNA
	JMP EXIT	/ALL DONE. GET OUT
	DCA PGCT	/NEW PAGE COUNT
	ISZ BLOCK	/NEXT BLOCK TO XFER
	TAD WCOUNT	/FORM NEXT BUFFER ADDRESS
	CIA
	TAD BUFF
	DCA BUFF
	CLL CML		/FORCES MOTION FORWARD
GO,	CLA CML RTR	/LINK BECOMES MOTION BIT
	TAD C1000
	TAD UNIT	/PUT IN 'GO' AND UNIT #
DIO09,	SDLC		/LOOK FOR BLOCK NO.

	JMS I CRDQUD	/WAIT AT LEAST 6 LINES TO LOOK
	JMS I CRDQUD
CM200,	7600		/COULD HAVE SAVED A LOC. HERE
DIO10,
SRCH,	SDSS
	JMP .-1		/WAIT FOR SINGLE LINE FLAG
DIO11,	SDRC
	CLL RTL		/DIRECTION TO LINK. INFO BITS 
			/ARE SHIFTED.
	AND C374	/ISOLATE MARK TRACK BITS
	TAD M110	/IS IT END ZONE?
	SNA		/THE LINK STAYS SAME THRU THIS
	JMP ENDZ
	TAD M20		/CHECK FOR BLOCK MARK
	SZA CLA
	JMP SRCH
DIO12,	SDRD		/GET THE BLOCK NUMBER
	SZL		/IF WE ARE IN REVERSE, LOOK FOR 3
			/BLOCKS BEFORE TARGET BLOCK. THIS
			/ALLOWS TURNAROUND AND UP TO SPEED.
	TAD C3		/REVERSE
	CMA
	TAD BLOCK
	CMA		/IS IT RIGHT BLOCK?
	SNA
	JMP FOUND	/YES..HOORAY!
M110,	SZL SNA CLA	/NO, BUT ARE WE HEADED FOR IT?
			/ABOVE SNA IS SUPERFLUOUS.
	JMP SRCH	/YES
DIO13,
ENDZ,	SDRC		/WE ARE IN THE END ZONE
	CLL RTL		/DIRECTION TO LINK
/V3C	SZL CLA		/ARE WE IN REVERSE?
	JMP GO		/YES..TURN US AROUND
/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
TRY3,	CLA CLL		/V3C
	ISZ TRYCNT
	JMP GO		/TRY 3 TIMES
	JMP FATAL		/LINK OFF MEANS AC=4000 ON RETURN
EXIT,	ISZ DTA0
	CLL CML		/AC=0 ON NORMAL RETURN
FATAL,	TAD UNIT
DIO14,	SDLC		/STOP THE UNIT
	CLA CML RAR
LEAVE,	HLT
	JMP I DTA0


C6203,	6203
CRDQUD,	RDQUAD
WCOUNT,	0
BUFF,	0
MWORDS,	-WDSBLK
UNIT,	0
CXFUN,	XFUNCT
M20,	-20
PGCT,	0
CXWCT,	XWCT
C100,	100
TRYCNT,	-3


	*ORIGIN+170
FOUND,	SZL CLA		/RIGHT BLOCK. HOW ABOUT DIRECTION?
	JMP GO		/WRONG..TURN AROUND
	TAD UNIT	/PUT UNIT INTO LINK
	CLL RAL		/AC IS NOW 0
C70,	70		/********DON'T MOVE THIS!!!!******
C3,	3
	TAD BUFF	/GET BUFFER ADDRESS
XFIELD,	HLT		/INTO NEXT PAGE

	*ORIGIN+200

	CIF MFIELD
	DCA XBUFF	/SAVE ADDRESS
	RAR		/NOW GET UNIT #
	DCA XUNIT
	SDRC		/V3C
	SDLC		/V3C
	TAD XWCT
	DCA DWORDS	/WORD COUNTER
DIO15,
REVGRD,	SDSS
	JMP .-1		/LOOK FOR REVERSE GUARD
DIO16,	SDRC
	AND K77
	TAD CM32	/IS IT REVERSE GUARD?
	SZA CLA
	JMP REVGRD	/NO.KEEP LOOKING
	TAD XFUNCT	/GET FUNCTION  READ OR WRITE
K7700,	SMA CLA
	JMP READ	/NEG. IS WRITE
DIO17,
WRITE,	SDRC
	AND C300	/CHECK FOR WRITE LOCK AND SELECT ERROR
	CLL CML		/LOCK OUT AND SELECT ARE AC 0 ERRORS
	SZA CLA
	JMP I CFATAL	/FATAL ERROR. LINK MUST BE ON
/	JMS RDQUAD	/NO ONE EVER USES THIS WORD!
/	CLA
	STA		/V3C HACK FOR PDP-6
	JMS WRQUAD	/V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
	TAD C1400
	TAD XUNIT	/INITIATE WRITE MODE
DIO18,	SDLC
	CLA CMA
	JMS WRQUAD	/PUT 77 IN REVERSE CHECKSUM
	CLA CMA
	DCA CHKSUM
WRLP,	TAD I XBUFF	/GLORY BE! THE ACTUAL WRITE!
	JMS WRQUAD
	ISZ XBUFF	/BUMP CORE POINTER
K77,	77		/ABOVE MAY SKIP
	ISZ DWORDS	/DONE THIS BLOCK?
	JMP WRLP	/NOT YET..LOOP A WHILE
	TAD XFUNCT	/IS THE OPERATION FOR WDSBLK PER BLOCK?
	CLL RTR		/IF NO, WRITE A 0 WORD
	SZL CLA

	JMS WRQUAD	/WRITE A WORD OF 0
	JMS GETCHK	/DO THE CHECK SUM
	JMS WRQUAD	/WRITE FORWARD CHECKSUM
	JMS WRQUAD	/ALLOW CHECKSUM TO BE WRITTEN
	JMS WRQUAD	/V3C WRITE REST OF CHECKSUM [PDP-6]
	JMP I CRWCOM


READ,	JMS RDQUAD
	JMS RDQUAD
	JMS RDQUAD	/SKIP CONTROL WORDS
	AND K77
	TAD K7700	/TACK 7700 ONTO CHECKSUM.
	DCA CHKSUM	/CHECKSUM ONLY LOW 6 BITS ANYWAY
RDLP,	JMS RDQUAD
	JMS EQUFUN	/COMPUT CHECKSUM AS WE GO
	DCA I XBUFF	/IT GETS CONDENSED LATER
	ISZ XBUFF
C300,	300		/PROTECTION
	ISZ DWORDS	/DONE THIS OP?
	JMP RDLP	/NO SUCH LUCK
	TAD XFUNCT	/IF OP WAS FOR WDSBLK-1, READ AND
	CLL RTR		/CHECKSUM THE LAST TAPE WORD
	SNL CLA
	JMP RDLP2
	JMS RDQUAD	/NOT NEEDED FOR WDSBLK/BLOCK
	JMS EQUFUN	/CHECKSUM IT
RDLP2,	JMS RDQUAD	/READ CHECKSUM
	AND K7700
	JMS EQUFUN
	JMS GETCHK	/GET SIX BIT CHECKSUM
	JMP I CRWCOM

WRQUAD,	0		/WRITE OUT A 12 BIT WORD
	JMS EQUFUN	/ADD THIS TO CHECKSUM
DIO19,	SDSQ		/SKIP ON QUADLINE FLAG
	JMP .-1
DIO20,	SDLD		/LOAD DATA  ONTO BUS
	CLA		/SDLD DOESN'T CLEAR AC
	JMP I WRQUAD

RDQUAD,	0		/READ A 12 BIT WORD
DIO21,	SDSQ
	JMP .-1
DIO22,	SDRD		/READ DATA
	JMP I RDQUAD


EQUFUN,	0		/COMPUTE EQUIVALENCE CHECKSUM
	CMA
	DCA EQUTMP	/ACTUALLY CHECKSUMS ON DECTAPE ARE
	TAD EQUTMP	/EQUIVALENCE OF ALL WORDS IN A RECORD
	AND CHKSUM	/SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
	CIA		/IS ASSOCIATIVE, WE CAN DO IT 12
	CLL RAL		/BITS AT A TIME AND CONDENSE LATER.
	TAD EQUTMP	/THIS ROUTINE USES THESE IDENTITIES:
	TAD CHKSUM	/A+B=(A.XOR.B)+2*(A.AND.B)
	DCA CHKSUM	/A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
	TAD EQUTMP	/A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
	CMA
	JMP I EQUFUN

GETCHK,	0		/FORM 6 BIT CHECKSUM
	CLA
	TAD CHKSUM	
	CMA
	CLL RTL
	RTL
	RTL
	JMS EQUFUN
	CLA CLL CML	/FORCES LINK ON AT RWCOM
	TAD CHKSUM
	AND K7700
	JMP I GETCHK

CFATAL,	FATAL
CRWCOM,	RWCOM
XFUNCT,	0
CM32,	-32
C1400,	1400
CHKSUM,	0
DWORDS,	0
XBUFF,	0
XWCT,	0
EQUTMP,	0
XUNIT,	0
	PAGE
FIELD 1

*2000

ZFREE,	ZBLOCK 5

INCTR,	0
INHNDL,	0
INPTR,	0

DELPS1,	0
	JMS I (200
	4
	MOUTPU+1
	0
	ISZ DELPS1
	CIF CDF 0
	JMP I DELPS1

ICHARP,	0
	ISZ INJMP
	ISZ INCHCT
INJMPP,	JMP INJMP
	TAD INEOF
	SZA CLA
	JMP INEXIT
INGBUF,	TAD INCTR
	CLL
	TAD (INRECS
	SNL
	DCA INCTR
	SZL
	ISZ INEOF
	CLL CML CMA RTR
	RTR
	RTR
	TAD (INCTL+1
	DCA INCTLW
	CIF 0
	JMS I INHNDL
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMP INERRX
INBREC,	TAD INREC
	TAD (INRECS
	DCA INREC
	TAD INCTLW
	AND (7600
	CLL RAL
	TAD INCTLW
	AND (7600
	CMA
	DCA INCHCT
	TAD INJMPP
	DCA INJMP
	TAD INBUFP
	DCA INPTR
	JMP ICHARP+1

INERRX,	ISZ INEOF
	SMA CLA
	JMP INBREC
INERR,	CLL CLA CML RAR
	JMP INEXIT

INJMP,	HLT
	JMP INCHR1
	JMP INCHR2
INCHR3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
	AND (7400
	CLL RTR
	RTR
	TAD INCTLW
	RTR
	RTR
	ISZ INPTR
	JMP INCOMN

INCHR2,	CDF 0
	TAD I (MODE
	CDF 10
	SMA SZA CLA
	JMP IC8A1
	TAD I INPTR
	AND (7400
	DCA INCTLW
	ISZ INPTR
IC8A2,	TAD I INPTR
INCOMN,	AND (377
	TAD (-232
	SNA
	JMP INEXIT
	TAD (232
	ISZ ICHARP
INEXIT,	CIF CDF 0
	JMP I ICHARP

INEOF,	1
INCHCT,	-1

INCHR1,	CDF 0
	TAD I (MODE
	CDF 10
	SPA SNA CLA
	JMP IC8A2
IC8A3,	TAD I INPTR
	ISZ INPTR
	JMP INEXIT-1

IC8A1,	TAD INJMPP
	DCA INJMP
	ISZ INCHCT
	JMP IC8A3
	PAGE
OOPNPS,	0
	TAD (MOUTPU+1
	DCA OUBLK
	TAD I (MOUTPU
	JMS I (200
	3
OUBLK,	0
OUELEN,	0
	JMP OUEFAL
	DCA OUCCNT
	JMS I (OUSETP
	ISZ OOPNPS
OUEEXT,	CIF CDF 0
	JMP I OOPNPS

OUEFAL,	TAD I (MOUTPU
	AND (7760
	SNA CLA
	JMP OUEEXT
	TAD I (MOUTPU
	AND (17
	DCA I (MOUTPU
	JMP OOPNPS+1

OUHNDL,	0

OUTDMP,	0
	DCA OUCTLW
	TAD OUCCNT
	SNA
	ISZ OUCTLW
	TAD OUBLK
	DCA OUREC
	TAD OUCTLW
	CLL RTL
	RTL
	RTL
	AND (17
	TAD OUCCNT
	DCA OUCCNT
	TAD OUCCNT
	CLL CML
	TAD OUELEN
	SNL SZA CLA
	JMP I OUTDMP
	CIF 0
	JMS I OUHNDL
OUCTLW,	0
	OUBUF
OUREC,	0
	JMP I OUTDMP
	ISZ OUTDMP
	JMP I OUTDMP

OCLOSE,	0
	CDF 0
	TAD I (MODE
	CDF 10
	SMA SZA CLA
	JMP OULLLP+2
	JMS I (OTYPE
	AND (770
	TAD (-PTP
	SZA CLA
	TAD (232
	JMS I (OCHARP
	JMP OURET
	JMS I (OCHARP
	JMP OURET
OULLLP,	JMS I (OCHARP
	JMP OURET
	JMS I (OTYPE
	SPA CLA
	TAD (100
	TAD (77
	AND I (OUDWCT
	SZA CLA
	JMP OULLLP
	TAD I (OUDWCT
	TAD (OUCTL&3700
	SNA
	JMP OUDUMP
	TAD (4010
	JMS OUTDMP
	JMP OURET
OUDUMP,	TAD I (MOUTPU
	JMS I (200
	4
	MOUTPU+1
OUCCNT,	0
	SKP
	ISZ OCLOSE
OURET,	CIF CDF 0
	JMP I OCLOSE
	PAGE
OUTEMP,	0

OUJMP,	HLT
	JMP OCHR1
	JMP OCHR2
OCHR3,	TAD OUTEMP
	CLL RTL
	RTL
	AND (7400
	TAD I OUPOLD
	DCA I OUPOLD
	TAD OUTEMP
	CLL RTR
	RTR
	RAR
	AND (7400
	TAD I OUPTR
OC8A1,	DCA I OUPTR
	TAD OUJMPP
	DCA OUJMP
	ISZ OUPTR
	ISZ OUDWCT
	JMP OUCOMN
	TAD (OUCTL
	JMS I (OUTDMP
	JMP OUCRET
	JMS OUSETP
	JMP OUCOMN

OUSETP,	0
	TAD (OUCTL&3700
	CIA
	DCA OUDWCT
	TAD (OUBUF
	DCA OUPTR
	TAD OUJMPP
	DCA OUJMP
	JMP I OUSETP

OCHARP,	0
	DCA OUTEMP
	RDF
	TAD (CIF CDF 0
	DCA OUCRET
	CDF 0
	TAD I (MODE
	SMA SZA CLA
	JMP .+4
	TAD OUTEMP
	AND (377
	DCA OUTEMP
	CDF 10
	ISZ OUJMP
OUJMPP,	JMP OUJMP

OCHR2,	CDF 0
	TAD I (MODE
	CDF 10
	SMA SZA CLA
	JMP OC8A2
	TAD OUPTR
	DCA OUPOLD
	ISZ OUPTR
OCHR1,	TAD OUTEMP
	DCA I OUPTR
OUCOMN,	ISZ OCHARP
OUCRET,	CIF CDF 0
	JMP I OCHARP

OUPOLD,	0
OUPTR,	0
OUDWCT,	0

OTYPE,	0
	TAD I (MOUTPU
	AND (17
	TAD (DCB-1
	DCA OUSETP
	TAD I OUSETP
	JMP I OTYPE

CDINXX,	ZBLOCK 5

OC8A2,	ISZ OUPTR
	TAD OUTEMP
	JMP OC8A1
	PAGE
$-$-$

