/RTFLOP.PA  RT-11 TO OS78 FILE TRANSFER PROGRAM
/									JUN4
/FILE INTERCHANGE BETWEEN RT11 FORMAT FLOPPY AND OS/8 FORMAT ANY DEVICES


/	COPYRIGHT (C) 1980 BY
/	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
/ ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
/ INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS SOFTWARE OR ANY OTHER
/ COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
/ OTHER PERSON.     NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
/ TRANSFERRED.

/ THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
/ AND SHOULD NOT BE CONSTRUED AS  A  COMMITMENT  BY  DIGITAL  EQUIPMENT
/ CORPORATION.

/ DIGITAL  ASSUMED  NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/ SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

/	*************************************************************************
/	* EDIT HISTORY-- ORIGIN: RTPIP.MA: DICK MURPHY (DIGITAL CALIFORNIA)	*
/	*	**JRW**	ADD NEW HANDLER CODE FOR RX01/RX02 INTERCHANGE.		*
/	*	**JRW**	CHANGE AND CLEAN UP COMMAND SWITCHES.			*
/	*	**JRW**	ADD FULL WILD-CARD MATCHING FOR OS/8 INPUT ONLY.	*

/	****	OS/78 V4 CLAUDE DESALLIERS (DIGITAL MERRIMACK)	****
/	REWRITE SOURCE IN PAL.
/	COMBINE RXHAND AND RTFLOP INTO ONE SOURCE AS RTFLOP.PA.
/	TAKE OUT IMAGE MODE.
/	FORCE OUTPUT TO BE SAME FILE NAME & EXT AS INPUT, IF NO INPUT
/	SPECIFIED.
/	REPRINT INPUT STRING ON THE FOLLOWING ERROR CONDITIONS:
/		"FLOPPY I/O ERRROR"; "NO OPTION FLAG"; "BAD SLASH OPTION".
/	INCLUDE SUPPORT FOR VT278.

/	*************************************************************************


/	THIS PROGRAM ALLOWS AN OS/8 USER TO MANIPULATE
/	RT-11 FLOPPIES. FUNCTIONS ARE AVAILABLE FOR:

/	1. WRITING RT-11 FLOPPIES
/	2. READING RT-11 FILES
/	3. DELETING RT-11 FILES ON FLOPPIES
/	4. ZEROING FLOPPIES
/	5. LISTING RT-11 DIRECTORIES FROM FLOPPIES


/SAVE INSTRUCTIONS:

/ .LOAD RTFLOP

/ .SAVE SYS RTFLOP 0-7577,12000-17577;200=3003

/	BIT	DESCRIPTION
/	---	-----------
/	1	FILE DOES NOT LOAD INTO 0-1777 F1.
/	2	PROGRAM MAY NOT BE RESTARTED AFTER
/		A CTRL-C, BY START COMMAND.
/	10	LOCS 0-1777 F0, NEED NOT BE
/		PRESERVED, WHEN THE COMMAND DECODER
/		IS CALLED.
/	11	LOCS 0-1777 F1, NEED NOT BE
/		PRESERVED, WHEN THE USR IS CALLED.

/	STORAGE ALLOCATION:
/	FIELD ZERO
/ 0000 - 4577	CODE AND POINTERS
/ 4600 - 6577	DIRECTORY BUFFER
/ 6600 - 7030	TABLES (END OF THESE DEFINES BELOW)
/ 7030 - 7177	KEYBOARD INPUT BUFFER
/ 7200 - 7577	OS/8 HANDLER

/	FIELD ONE
/ 0000 - 1777	USR
/ 2000 - 2577	MESSAGES
/ 2600 - 5577	DATA BUFFER
/ 5600 - 6777	RX01/RX02 HANDLER

/	FIELD TWO
/ 0200 - 4177	RT-FILE BUFFER SPACE




/PROGRAM STATIC DEFINITIONS


/OS/8 USR FUNCTIONS

FETCH=	1
LOOKUP=	2
ENTER=	3
CLOSE=	4

/BATCH PROGRAM LOCATIONS

BATIN= 5400	/PLACE TO JMS TO GET A CHAR
BATOUT=7400	/PLACE TO JMS TO PRINT ON BATCH LOG

/DATA FIELDS DEFINITIONS

FLD0=00
FLD1=10
FLD2=20
FLD3=30


BFDATA=	FLD1
BUFRT=	FLD1
RXFLD=	FLD1
MSGS=	FLD1

BIGBUF=	FLD2

/OPTFLG BIT ASSIGNMENT MNEMONICS

INOS=	1	/INPUT FILE IS OS/8
OUTOS=	2	/OUTPUT FILE IS OS/8
INRT=	4	/INPUT IS RT-11
OUTRT=	10	/OUTPUT IS RT-11
NOIO=	20	/NO FILES
DIRIO=	40	/DIRECTORY (USED FOR DEFAULT OUT DEV)
BSW=	7002	/BYTE SWAP INSTRUCTION

	FIELD	0
	*0
WS0,	0	/WORKING STORAGE
WS1,	0	/DITTO
WS2,	0	/DOUBLE DITTO.
ACHGH,	0	/DOUBLE PRECISION AC HIGH ORDER
ACLOW,	0	/DOUBLE PRECISION AC LOW	ORDER.
OPLO,	0	/DOUBLE PRECISION SECONDARY OPERAND
OPHI,	0	/USED IN ADDITION ROUTINE.
ENTRY,	0	/STARTING BLOCK OF FILE
	*10
AX0,	0	/MISCELLANEOUS AUTOINDEX
AX1,	0	
AX2,	0	
RTPTR,	0	/RT-11 BUFFER POINTER
DIRECT, 0	/DIRECTORY SCAN POINTER
DIRPTR, 0	/CHARACTER OUTPUT BUFFER POINTER
TTPTR,	0	/OUTPUT BUFFER POINTER FOR OS/8
RTPTR2, 0	/CURRENT LOC IN BIGBUF
	*20
DNSWCH, 2	/DENSITY SWITCH: 0=NOT SET, ASK USER; 1=SINGLE; 2=DOUBLE
		/IF SWITCH NOT SET, WILL ASK USER ON INIT
BLKLFT, 0	/# BLOCKS LEFT TO PROCESS
RTBLOK, 0	/LOGICAL RT-11 BLOCK NUMBER.
NBLOK,	0	/NUMBER OF RT-11 BLOCKS TO READ.
BUFPTR, 0	/POINTER TO START OF PRESENT SECTOR'S
		/BUFFER. USED FOR RETRIES.
HIGHSG, 0	/LAST SEGMENT OF DIRECTORY
INCNT,	0	/NUMBER OF CHARACTERS IN INPUT BUFFER.
ESCAPE, 0	/SET TO ONE IF INPUT TERMINATED WITH ESCAPE.
OPTFLG, 0	/INPUT/OUTPUT FLAG. 1=OUT, 2=IN (RT)
OPTION, 0	/COMMAND DECODER OPTION
DEVNO,	0	/OS/8 HANDLER DEVICE NUMBER.
OSLEN,	0	/LENGTH OF OS/8 OUTPUT FILE.
MAXLEN, 0	/MAXIMUM LENGTH OF THE OUTPUT FILE.
DIRSG,	0	/SEGMENT NUMBER OF DIRECTORY SEGMENT IN CORE.
RTLEN,	0	/LENGTH OF THE RT-11 FILE.
SCNPTR, 0	/POINTER FOR DIRECTORY SCANS.
BIGMT,	0	/SIZE OF BIGGEST EMPTY FILE ON FLOPPY.
BIGSEG, 0	/SEGMENT # OF BIGGEST EMPTY.
BIGPTR, 0	
BIGBLK, 0	/BLOCK # OF BIGGEST EMPTY.
RTCTR,	0	/RT-11 BLOCK COUNTER
OSCTR,	0	/OS/8 BLOCK COUNTER.
RTSIZE, 0	/SIZE OF RT-11 FILE GENERATED.
BYTCNT, 0	/COUNTER FOR FILLING SECTOR BUFFER.
BATINP, BATIN	/BATCH INPUT POINTER.
RXHAND, RXA0	/ADDR OF CORRECT HANDLER ENTRY
RTWLD,	0	/RT-11 WILD CARD FLG
OSWLD,	0	/OS-8	WILD CARD FLG
EXTRA,	0	/NUMBER OF EXTRA BYTES IN A DIRECTORY ENTRY
TEMP,	0	/MISC TEMP WORD

	*200		/START THIS THING AT 200.
START,	CLA CLL
	TAD (JMP CALLDC	//ENTER FROM CCL CHAIN
	DCA START	/DON'T DO INIT AGAIN.
	CIF 10		/GO TO USR FIELD
	JMS I [7700	/LOCK USR IN
	10
	CDF 10		/CHECK OS/8 SCOPE WORD
	TAD I (7726	/WHICH IS AT 17726
	CDF 0
	AND [0200	/BIT 4 IS THE SCOPE BIT.
	SNA CLA
	JMP NOSCOP	/NOT A SCOPE IF BIT 4 NOT SET.
	JMS MOVE	/MOVE SCOPE OVERLAY OVER RUBOUT
	INBUF		/CODE
	RUBOUT
	-RUBLEN
NOSCOP, TAD I [7777	/GET BATCH RUNNING FLAG-
	CLL RAL
	SMA CLA
	JMP CALLDC	/BATCH NOT RUNNING.
	JMS MOVE	/MOVE BATCH OVERLAY.
	INPAT		/SET TO GET INPUT FROM BATCH
	INBAT
	-3
	JMS MOVE
	TTPAT		/SET TO GIVE OUTPUT TO BATCH
	TTOUT+2
	-3
	JMS MOVE
	BATRT		/SET TO IGNORE MESSAGE AND ASSUME
	RTBAT		/USER KNOWS WHAT HE IS DOING
	-1
	JMS MOVE
	BATESC		/EXIT TO 7605 ON ESCAPE CHAR FROM BATCH
	ESCBAT
	-1
	TAD I [7777	/GET BATCH FIELD
	AND [70
	TAD (CIF	/MAKE CIF BATCH
	DCA WS0
	TAD WS0
	DCA I (TTOUT+1
	TAD WS0
	DCA I (INBAT
	TAD (LFPAT	/PATCH LINE FEEDS TO BE IGNORED.
	DCA I (LINPAT


/CALL THE COMMAND DECODER (NOT OS/8'S) ; DECODE
/THE DESIRED FUNCTION AND EXECUTE IT.

CALLDC, JMS I (DECODE	/GET AND DECODE A COMMAND LINE.
	JMP I OPTION	/GO TO DESIRED ROUTINE.

DIR,	JMS I (SIXBIT	/DIRECTORY LISTING - GET OUTPUT FILE.
	JMS I (OSFECH	/FETCH OUTPUT HANDLER
	JMS I (OSENTR	/ENTER THE OUTPUT FILE
	JMS I (LISTDR	/LIST THE DIRECTORY
	JMS I (OSCLOS	/CLOSE THE OUTPUT FILE
	JMP ESCHK

WRTRT,	JMS I (SIXBIT	/WRITING RT-11 FLOPPY.
	JMS I (OSFECH	/GET OS/8 HANDLER
	JMS I (OSLOOK	/LOOK UP INPUT FILE
	JMS I (RTENTR	/ENTER OUTPUT FILE
	JMS I (OSREAD	/WRITE OUTPUT
	JMS I (RTCLOS	/CLOSE OUTPUT
	JMP ESCHK

RDRT,	JMS I (SIXBIT	/READING RT-11 FLOPPY.
	JMS I (OSFECH	/GET OS/8 HANDLER.
	JMS I (RTLOOK	/LOOK UP THE RT-11 FILE
	JMP NOFILE	/FILE DOES NOT EXIST
	JMS I (OSENTR	/ENTER THE OUTPUT FILE.
	JMS I (RTREAD	/READ AND REPACK.
	JMS I (OSCLOS	/CLOSE THE FILE.
	JMP ESCHK	/LOOP FOR MORE COMMANDS.

RTZERO, JMS I (RTZER	/ZERO RT11 FLOPPY DIRECTORY
	JMP ESCHK

DELETE, JMS I (RTDEL	/DELETE FILE ON RT11 FLOPPY
	JMP NOFILE
	JMP ESCHK

NOFILE, JMS I [PRTZRO
	NOTFND		/"FILE NOT FOUND"
	JMP CALLDC


ESCHK,	TAD ESCAPE	/CHECK ESCAPE FLAG
	SZA CLA
	JMP I [7605	/IF COMMAND ENDED WITH $, QUIT.
	JMP CALLDC	/LOOP FOR MORE.

FLOPER, CDF 0		/RESET POSSIBLE LOST DATA FIELD.
	JMS I [PRTZRO
	RXERR
	JMP I (REPEAT

MOVE,	0
	STA
	TAD I MOVE	/FROM
	DCA AX1
	ISZ MOVE
	STA
	TAD I MOVE	/TO
	DCA AX2
	ISZ MOVE
	TAD I MOVE	/COUNT
	DCA WS0
	ISZ MOVE
MOVER,	TAD I AX1
	DCA I AX2
	ISZ WS0 
	JMP MOVER
	JMP I MOVE

	PAGE


/ROUTINE TO READ A BLOCK FROM THE RT-11 FLOPPY
/INTO THE SPECIFIED BUFFER. BEFORE CALLING, SET UP

/	BUFPTR TO THE START OF THE DESIRED BUFFER
/	NBLOK	TO THE NUMBER OF BLOCKS TO TRANSFER
/	RTBLOK TO THE STARTING BLOCK NUMBER.

/	THE DATA FIELD SHOULD BE SET TO THE BUFFER FIELD.


REDBLK, 0
	RDF		/GET THE FIELD TO TRANSFER TO
	CDF 0		/RETURN TO THIS FIELD.
	DCA TEMP
	TAD TEMP
	TAD (CDF
	DCA FIXCDF	/INS FOR RETURNING IN DATA FIELD WE CAME IN WITH.
	TAD NBLOK	/GET #BLOCKS.
	CLL RAL		/MULTIPLY BLOCK COUNT BY TWO TO GET
			/# PAGES TO READ.
	CLL RTL		/MOVE OVER SIX PLACES FOR FUNC WORD
	CLL RTL
	CLL RTL
	TAD TEMP	/.OR. IN THE FIELD NUMBER.
	DCA FUNC	/AND THIS IS THE FUNCTION CODE!!
	TAD BUFPTR	/BUFFER LOC IN BUFADR
	DCA BUFADR	/SAVE FOR HANDLER CAL
	TAD RTBLOK	/FIRST BLOCK # TO READ
	DCA BLKNUM	/SAVE FOR HANDLER CAL
	CIF RXFLD
	JMS I RXHAND	/GO DO IT...
FUNC,	0		/HANDLER FUNC RW+NOPAGES+FLD
BUFADR, 0		/BUFFER ADDRESS
BLKNUM, 0		/BLOCK NUMBER.
	JMP I [FLOPER	/SOLID ERROR. OH WELL.
FIXCDF, HLT		/CDF INS GOES HERE
	JMP I REDBLK	/ALL DONE...


/FIRST THE CHARACTER LOOKING FOR, THEN
/A POINTER TO THE ROUTINE TO EXECUTE

CHRLST, "C-100; 7605	/^C - RETURN TO OS/8
	"U-100; CLRIN	/^U - DELETE LINE
	215;	RETURN	/C/R
	212;	REPEAT	/L/F
	377;	RUBOUT
	233;	ESC
	375;	ESC
	376;	ESC	/ALL BRANDS OF ESCAPE
	"$;	ESC	/INCLUDING "$"
	"*;	INLOOP	/IGNORE "*"
	"?;	INLOOP	/AND	"?"
	0

/ROUTINE TO UNPACK RAD50 FILENAME INTO ASCII BUFFER.
/UNPACKS THE NEXT SIX BYTES OF THE DIRECTORY (POINTED TO BY
/DIRECT) INTO THE OUTPUT BUFFER (POINTED TO BY DIRPTR).

GTNAME, HLT
	TAD [-3		/HAVE THREE CHAR TRIPLETS.
	DCA NAMECT
NAMELP, JMS TWOBYT	/GET NEXT TWO BYTES INTO D.P. AC
	JMS I (DIV50	/DIVIDE BY 50
	TAD ACHGH	/GET THIRD CHAR
	DCA WS0		/SAVE IT.
	DCA ACHGH	/CLEAR OUT REMAINDER.
	JMS I (DIV50	/DIVIDE AGAIN.
	TAD ACLOW	/FIRST CHAR
	JMS I (RAD50	/STASH IN OUTPUT BUFFER.
	TAD ACHGH	/MIDDLE CHAR.
	JMS I (RAD50	/STASH
	TAD WS0		/THIRD CHAR.
	JMS I (RAD50
	ISZ NAMECT	/DONE ALL THREE?
	JMP NAMELP	/NOPE.
	JMP I GTNAME	/YUP.

NAMECT, 0


/ROUTINE TO GET NEXT TWO BYTES FROM THE DIRECTORY
/BUFFER INTO THE DOUBLE PRECISION AC.

TWOBYT, HLT
	TAD I DIRECT	/GET LOW BYTE
	DCA WS0
	TAD I DIRECT	/AND HIGH BYTE
	DCA WS1
	TAD WS1
	AND (360	/HIGH BITS OF HIGH BYTE
	CLL RTR;RTR	/SHIFT INTO POSITION
	DCA ACHGH	/SAVE IN D.P. AC
	TAD WS1
	AND [17		/LOW FOUR BITS OF HIGH BYTE NOW.
	CLL RTR;RTR;RAR /SHIFT INTO POSITION.
	TAD WS0		/ADD (OR) IN LOW BYTE
	DCA ACLOW	/SAVE IN LOW D.P. AC
	JMP I TWOBYT

/LIST PRINTER - BUFFERS AND PRINTS LIST OF CHARACTERS.
/CALL:
/	JMS PRTLST
/	NCHAR
/	MESSAGE

/	WHERE NCHAR IS THE LENGTH AND MESSAGE IS THE
/	LOCATION OF THE TEXT TO TYPE.

PRTLST, HLT
	TAD I PRTLST	/GET LENGTH
	CIA		/NEGATIVE NOW
	DCA LSTCTR
	ISZ PRTLST	/POINT TO LOCATION.
	STA		/MINUS ONE FOR AUTOINDEX
	TAD I PRTLST	/GET LOCATION POINTER
	DCA AX0		/STORE
	ISZ PRTLST	/POINT TO RETURN
PRTLP,	TAD I AX0
	JMS I [TTBUF	/PRINT CHAR.
	ISZ LSTCTR	/CHECK IF DONE.
	JMP PRTLP
	JMP I PRTLST

LSTCTR, 0

/MOVE NAME TO THE TENTATIVE ENTRY IN THE DIRECTORY BUFFER.

MOVNAM, HLT
	TAD (-6		/NUMBER OF BYTES IN NAME.
	DCA WS0
	TAD (RTNAM-1
	DCA AX0		/FROM THE RT NAME BUFFER,
MVNAM,	TAD I AX0
	CIA		/REMOVE CIA DONE BY LOOKUP.
	DCA I DIRECT	/INTO DIRECTORY BUFFER.
	ISZ WS0
	JMP MVNAM
	CLA CLL
	JMP I MOVNAM

	PAGE


/SIMPLIFIED COMMAND DECODER
/ALLOWS FORMAT SIMILAR TO OS/8 TO BE USED.
/DOES NOT SUPPORT PARENTHESIS; ONLY /0,/1,/W,/R,/Z,/D,/L
/FORMAT:	*DEV:OUT<DEV:IN/OPTIONS (C/R OR ESC.)
/DEVICE NAMES ARE ILLEGAL FOR THE RT-11 DEVICE.


/OPTIONS--	SELECT: /0 DRIVE 0 (DEFAULT)
/			/1 DRIVE 1.

/		I/O:	/W OUTPUT IS RT-11
/			/R INPUT IS RT-11
/LAST I/O OPTION IS USED (EX. A<B/W/R/W/R; /R IS USED.

/	  FUNCTIONS:	/Z ZERO FLOPPY DIRECTORY
/			/D DELETE A FILE FROM FLOPPY DIRECTORY
/			
/			/L LIST FLOPPY DIRECTORY


DECODE, HLT
REDO,	JMS I (GETIN	/GET A LINE OF INPUT
	TAD INCNT
	SZA CLA
	JMP INPOK
	TAD ESCAPE	/CHECK FOR ESCAPE
	SZA CLA
	JMP I [7600	/QUIT.
	JMP PRVER	/PRINT VERSION, AND TRY AGAIN.
INPOK,	JMS I [RSTPTR	//RESET POINTER
	DCA OPTION	/INIT FLAGS.
	TAD (RXA0	/INITIAL ADDR TO RXA0
	DCA RXHAND	/AND UNIT NUMBER.
SLASH,	JMS I (SCAN	/LOOK FOR A SLASH
	"/
	JMP DONE	/NOT FOUND, CONTINUE.
	TAD I AX0	/GET THE OPTION.
	DCA WS0		/SAVE IT.
	TAD WS0
	TAD (-"0
	SNA
	JMP OPT0	/SAID /0
	TAD ("0-"1
	SNA CLA
	JMP OPT1	/SAID /1
	TAD (OPTLST-1
	DCA AX1
OPTLOP, TAD I AX1	/GET CHAR TO TEST: Z, D, L, W, R
	SNA
	JMP ENDOPT	/BAD OPTION.
	TAD WS0
	SNA CLA
	JMP OPTFND	/FOUND MATCH.
	ISZ AX1		/POINT PAST SUBROUTINE POINTER.
	ISZ AX1		/AND PAST FLAG SETTING.
	JMP OPTLOP	/KEEP TRYING.

OPTFND, TAD I AX1	/GET POINTER
	DCA OPTION	/SAVE.
	TAD I AX1
	DCA OPTFLG	/AND I/O FLAG
	JMP SLASH

ENDOPT, JMS I [PRTZRO	/BAD OPTION.
	BADOPT		/"BAD SLASH OPTION"
	JMP I (REPEAT	/TRY AGAIN

OPT0,	CLA		/CLEAR AC
	TAD (RXA0	/SET TO UNIT 0
	JMP SETUNT	/SET CORRECT JMS LOC
OPT1,	CLA		/CLEAR AC
	TAD (RXA1	/SET TO UNIT 1
SETUNT, DCA RXHAND	/STORE 0 OR 1 IN UNIT.
	JMP SLASH

DONE,	TAD OPTION
	SZA CLA
	JMP NAMES	/GAVE SOME OPTION; GO PARSE NAMES
	JMS I [PRTZRO
	NOOPT		/"NO OPTION SELECTED"
	JMP I (REPEAT	/TRY AGAIN.
 
/PARSE OFF THE RT-11 AND OS/8 FILE NAMES.
/ALSO GET THE OS/8 DEVICE.

NAMES,	JMS I [RSTPTR	//RESET BUFFER POINTER
	TAD OPTFLG
	AND [INOS+OUTOS+INRT+OUTRT	/NOW NON-ZERO IF ANY
			/FILE NAMES NEEDED.
	SNA
	JMP I DECODE	/NO NAMES.
	AND [OUTRT	/CHECK IF FIRST IS RT-11 OR OS/8
	SNA CLA
	JMP OSOUT
	JMS I [SCAN	//SEE IF AN OUTPUT FILENAME SPECIFIED
	"<
	JMP CHKDEV	//NO. CHECK FOR AN OS78 DEVICE.
	TAD AX0		//MAYBE A FILE NAME
	TAD [-INBUF	//IF "<" AT BEGINNING OF BUFFER
	SZA CLA		//THERE WAS NO FILENAME.
	JMP RTFILE	//WAS A FILENAME, GO AND GET IT.
CHKDEV,	JMS I [RSTPTR	//RESET POINTER TO BEGINNING OF LINE BUFFER.
	JMS I [SCAN	/SEE IF THERE WAS A DEVICE
	":		/AND MAKE SURE TO IGNORE IT
	SKP		/NO DEVICE
	SKP		//GET RT11 FILENAME FROM OS78 NAME
RTFILE,	JMS I [RSTPTR	//RESET BUFFER POINTER
	JMS I (RTNAME	/GET RT-11 NAME.
	SKP
OSOUT,	JMS I (OSNAME	/GET OS/8 NAME
	TAD OPTFLG	/SEE IF ANY INPUT FILE
	AND (INOS+INRT
	SNA CLA
	JMP I DECODE	/NONE. ALL DONE
	JMS I [RSTPTR
	JMS I (SCAN	/LOOK FOR END OF OUTPUT FILE
	"<
	JMP NOBKAR	/NO <; CHECK FOR =
LESSTN, TAD OPTFLG
	AND [INRT	/CHECK TYPE OF INPUT
	SNA CLA
	JMP OSIN
	JMS I (RTNAME	/GET NAME
	JMP I DECODE	/DONE
OSIN,	JMS I (OSNAME
	JMP I DECODE	/DONE

NOBKAR,	JMS I [RSTPTR	//RESET POINTER
	JMS I [SCAN
	"=
	JMP NOINP	/NO EQUAL EITHER; NO INPUT FILE
	JMP LESSTN	/CONTINUE.

NOINP,	JMS I [RSTPTR	//RESET POINTER
	JMS I [SCAN
	":		/MOVE POINTER PAST THE DEVICE NAME
	JMP READIN	/RESET POINTER AND READ INPUT FILE
	TAD OPTFLG	
	AND [OUTRT	/IF OUTPUT IS RT11, RESET POINTER TO BE SURE
	SNA CLA		/TO PICK UP THE OS8 DEVICE
	JMP LESSTN	/FORCE INPUT TO BE SAME FILENAME & EXT AS OUPUT
READIN,	JMS I [RSTPTR	//RESET POINTER
	JMP LESSTN

PRVER,	JMS I [PRTZRO
	VERS
	JMP REDO

	PAGE


/READS, DECODES AND PRINTS THE DIRECTORY OF
/THE SELECTED UNIT.

LISTDR, HLT
	CLA IAC		/START WITH SEGMENT ONE.
	DCA DIRSG
READSG, JMS I [GETDIR	/READ THE SEGMENT
	TAD I (BHISEG	/GET THE HIGHEST SEGMENT
	DCA HIGHSG	/SAVE IT.
LOOPDR, TAD I (BLOCK1	/GET STARTING BLOCK OF FIRST FILE
	DCA BLK
	TAD (FILE1-1	/POINTER TO FIRST FILE ENTRY
	DCA DIRECT
	TAD (NAMBUF-1
	DCA DIRPTR	/INITIALIZE NAME BUFFER POINTER
NXENTR, ISZ DIRECT	/SKIP LOW BYTE OF FILE TYPE
	TAD I DIRECT	/GET FILE TYPE BYTE
	DCA TYPE	/SAVE IT.
	TAD TYPE
	CLL RAR
	SNA
	JMP TENT	/1=TENTATIVE FILE
	RAR
	SNA
	JMP EMPT	/2=EMPTY FILE
	RAR
	SZA CLA
	JMP NXTSEG	/10=END OF DIRECTORY SEGMENT
	JMS I (GTNAME	/PERMANENT ENTRY - GET NAME
	JMS I [PRTLST	/PRINT NAME
	6
	NAMBUF
	TAD (".		/PRINT PERIOD BETWEEN NAME & EXT.
	JMS I [TTBUF
	JMS I [PRTLST	/PRINT EXTENSION
	3
	NAMBUF+6
	TAD (NAMBUF-1
	DCA DIRPTR	/RESET NAME POINTER

/PRINT REST OF INFORMATION NOW THAT PAST NAME.

PASTNM, JMS I (SPACE3	/PRINT THREE SPACES
	JMS I [TWOBYT	/GET LENGTH OF FILE
	TAD ACLOW
	JMS I [PRTDEC	/PRINT IN DECIMAL
	ISZ DIRECT
	ISZ DIRECT	/POINT PAST JOB #, CHANNEL BYTES.
	JMS I (SPACE3
	TAD BLK		/STARTING BLOCK OF THIS FILE
	JMS I [PRTOCT	/PRINT IT
	TAD BLK
	TAD ACLOW
	DCA BLK		/UPDATE BLOCK COUNTER
	TAD TYPE	/ONLY PRINT DATE FOR PERM. FILES.
	AND [4		/PERMANENT?
	SNA CLA
	JMP PASTDT	/NO DATE.
	JMS I [TWOBYT	/GET DATE
	JMS I (SPACE3
	JMS I (RTDATE	/PRINT IT
PAST,	TAD DIRECT	/POINT PAST EXTRA WORDS,
	TAD EXTRA	/IF ANY.
	DCA DIRECT
	JMS I (CRLFBF	/SKIP TO NEXT LINE.
	JMP NXENTR

PASTDT, TAD [2
	TAD DIRECT
	DCA DIRECT
	JMP PAST

TYPE,	0
BLK,	0


TENT,
EMPT,	TAD (6		/POINT PAST NAME
	TAD DIRECT
	DCA DIRECT
	JMS I [PRTLST	/PRINT "<UNUSED>" INSTEAD OF NAME.
	12
	UNUSED
	JMP PASTNM	/DO REST OF ENTRY.

NXTSEG, TAD I (SEGLNK	/GET LINK TO NEXT SEGMENT
	SNA		/IS THERE ANOTHER?
	JMP CLOSBF	/FINISH TYPING.
	DCA DIRSG	/SAVE THE LINK.
	JMP READSG	/READ AND DECODE IT.

CLOSBF, JMS I (CLOSTT
	JMP I LISTDR


/GET A CHAR FROM TERMINAL OR FROM BATCH

INPUT,	0		/**NEXT 3 LOCATIONS REPLACED IF BATCH IS RUNNING BY:
INBAT,	KSF		/**CIF (BATCH FIELD)
	JMP .-1		/**JMS I BATINP
	KRB		/**JMP I [7605		/EOF ERROR
	AND [177	/SET THE PARITY BIT
	TAD [200
	JMP I INPUT

RSTPTR,	0		//RESET LINE BUFFER POINTER
	TAD (INBUF-1
	DCA AX0
	JMP I RSTPTR


	PAGE


/ROUTINE TO CONVERT RAD50 CHAR TO ASCII
/AND PUT IN BUFFER.

/TRANSLATION TABLE:

/	CHAR	RAD50
/	----	-----
/	BLANK	0
/	A-Z	1-32
/	$	33
/	.	34
/	UNUSED	35
/	0-9	36-47


RAD50,	HLT
	SNA
	JMP BLANK	/ZERO IS A BLANK
	TAD (-33	/CHECK FOR A-Z
	SMA
	JMP MORE50	/NOPE, TRY THE REST.
	TAD (333	/RESTORE AND CONVERT TO ASCII
STSH50, DCA I DIRPTR	/STASH IT AWAY
	JMP I RAD50

MORE50, SNA
	JMP DOLLAR	/33 IS DOLLAR SIGN.
	CIA
	CMA
	SNA
	JMP PERIOD	/34 IS A PERIOD
	TAD (260-2	/MUST BE A NUMBER. CONVERT
	JMP STSH50	/AND STORE.

BLANK,	TAD [240
	JMP STSH50

DOLLAR, TAD ("$
	JMP STSH50

PERIOD, TAD [".
	JMP STSH50


/GETS RT-11 FORMAT DATE FROM ACHGH AND ACLOW AND
/CONVERTS TO STANDARD DATE STRING, OUTPUTTING
/TO THE TTY BUFFER.

RTDATE, HLT
	TAD ACLOW	/FIRST CHECK FOR NO DATE-
	SZA CLA
	JMP GOTDAT	/WE SEEM TO HAVE A DATE.
	TAD ACHGH	/IS THIS ZERO?
	SNA CLA		/NOPE. HAVE A DATE.
	JMP NONE	/PRINT "NO DATE" INSTEAD.
GOTDAT, TAD ACLOW
	AND [37		/YEAR BITS ONLY.
	DECIMAL
	TAD (72		/ADD IN STARTING YEAR.
	OCTAL
	DCA YEAR	/SAVE IT.
	TAD ACLOW
	AND [1740	/GET DAY BITS
	CLL RTR;RTR;RAR /INTO POSITION
	DCA DAY		/AND SAVE
	TAD ACLOW	/GET LOW ORDER MONTH BITS
	AND [6000
	CLL RTL;RAL
	DCA WS0		/SAVE FOR AWHILE
	TAD ACHGH	/HIGH ORDER MONTH BITS
	AND [7		/KEEP ONLY GOOD STUFF
	CLL RTL
	TAD WS0		/AND GET LOW ORDER TOO.
	DCA MONTH
	TAD DAY		/NOW PRINT DAY
	JMS I [TWODEC
	TAD ["-
	JMS I [TTBUF
	TAD MONTH	/GET POINTER TO MONTH NAME
	DECIMAL
	TAD [-13	/IS MONTH WITHIN RANGE?
	SPA CLA
	JMP MONOK	/YUP
	TAD (13		/SET TO 13 (PRINTS BAD FOR MONTH)
	OCTAL
	SKP
MONOK,	TAD MONTH
	CIA		/SUBTRACT ONE (JAN=0, FEB=1, ETC.)
	CLL CMA RTL	/EACH MONTH IS FOUR CHARS LONG
	TAD (MONTHS	/ADD START OF MONTHS NAME LIST
	DCA DATLOC	/PUT AS ARG OF SUBROUTINE CALL.
	JMS I [PRTLST	/PRINT MONTH NAME
	4
DATLOC, HLT
	TAD YEAR	/NOW PRINT YEAR
	JMS I [TWODEC
	JMP I RTDATE

/ROUTINE TO PRINT "NO DATE" WHEN THERE IS NONE.

NONE,	JMS I [PRTLST
	11
	NODATE
	JMP I RTDATE	/ALL DONE HERE.


MONTH,	0
DAY,	0
YEAR,	0
 
/ROUTINE TO READ A DIRECTORY SEGMENT INTO
/THE DIRECTORY BUFFER. THE SEGMENT DESIRED
/IS IN DIRSG.

GETDIR, HLT
	TAD DIRSG	/CHECK FOR REAL SEGMENT (<10)
	TAD [-10
	SMA CLA
	JMP BADDIR	/BAD SEGMENT #
	TAD [2		/A SEGMENT IS TWO BLOCKS LONG.
	DCA NBLOK
	TAD [DIRBUF
	DCA BUFPTR	/READ TO THE DIRECTORY BUFFER
	TAD DIRSG	/COMPUTE BLOCK NUMBER FROM SEGMENT NUMBER
	CLL RAL
	TAD [4
	DCA RTBLOK	/READ STARTING AT THIS BLOCK.
	CDF 0		/MAKE SURE WE'RE IN THIS FIELD!!
	JMS I [REDBLK	/READ IT.
	TAD I (BEXTRA
	DCA EXTRA
	TAD [-4		/MAKE SURE WE HAVE AN RT-11 DIRECTORY
	TAD I (BHISEG	/4 MEANS RT-11
	SNA CLA		/NOT AN RT-11
	JMP I GETDIR	/ALL DONE.
BADDIR, JMS I [PRTZRO
	DIRBAD
	JMP I [CALLDC
 
/LOOKS FOR SPECIFIED CHAR IN A BUFFER POINTED
/TO BY AX0.
/CALL:	JMS SCAN
/	CHAR TO LOOK FOR
/	FOUND
/	NOT FOUND

SCAN,	0
	TAD I SCAN
	CIA
	DCA WS1
	ISZ SCAN
SCANLP, TAD I AX0	/GET NEXT BUFFERED
	SNA
	JMP I SCAN	/NOT FOUND
	TAD WS1		/SEE IF MATCHES
	SZA CLA
	JMP SCANLP	/NO MATCH; KEEP LOOKING.
	ISZ SCAN	/FOUND; RETURN TO CALLER.
	JMP I SCAN

	PAGE

 
TTOUT,	HLT
	TLS
	TSF
	JMP .-1
	CLA CLL
	JMP I TTOUT

SPACE3, HLT		/PRINT 3 SPACES.
	TAD [-3
	DCA SPCTR
SPLOOP, TAD (" 
	JMS TTBUF
	ISZ SPCTR
	JMP SPLOOP
	JMP I SPACE3
SPCTR,	0

/PRINT CR-LF
CRLF,	HLT
	TAD [215
	JMS I [TTOUT
	TAD [212
	JMS I [TTOUT
	JMP I CRLF

CRLFBF, HLT
	TAD [215
	JMS TTBUF
	TAD [212
	JMS TTBUF
	JMP I CRLFBF

TTBUF,	HLT
CHANGE, JMP SETUP	/CHANGED TO NOP AFTER INIT.
	CDF 10
	DCA I TTPTR	/STASH CHARACTER
	CDF 0
	ISZ FULL	/CHECK FOR FULL BUFFER.
	JMP I TTBUF	/NOW THERE - GO BACK.
	TAD MAXLEN	/CHECK IF THERE IS ROOM LEFT
	SNA CLA
	JMP FULLDV	/MORE WILL OVERFLOW THE FILE.
	JMS I (OSHAND	/CALL THE HANDLER
	4210		/WRITE 2 PAGES FROM FIELD 1
	ISZ OSLEN	/COUNT A BLOCK
	ISZ I [BLOCK
	ISZ MAXLEN
	NOP		/COVER SKIP
	TAD [-400
	DCA FULL
	TAD [DATABF-1
	DCA TTPTR	/RESET BUFFER POINTER
	JMP I TTBUF	/RETURN.

SETUP,	DCA WS0		/SAVE THE CHAR.
	TAD [-400
	DCA FULL	/FLAG THE BUFFER AS EMPTY
	TAD [DATABF-1
	DCA TTPTR	/SET THE POINTER
	TAD [NOP
	DCA CHANGE	/DON'T DO THIS AGAIN.
	TAD WS0
	JMP CHANGE

FULL,	0


CLOSTT, HLT		/CLOSE THE OUTPUT BUFFER.
	STA
	DCA FULL	/SET TO IMMEDIATELY OVERFLOW.
	TAD CLOSTT	/MOVE RETURN TO BUFFERING ROUTINE
	DCA TTBUF
	TAD (232	/GET END FILE CHAR.
	JMP TTBUF+1

/PRINT A STRING OF CHARACTERS
/PRINTS UNTIL HITS A ZERO.

PRTZRO, HLT
	STA
	TAD I PRTZRO
	DCA AX2
	ISZ PRTZRO
PZLOOP, CDF MSGS	/FIELD OF MESSAGES.
	TAD I AX2
	CDF 0
	SNA
	JMP DONE0
	JMS I [TTOUT
	JMP PZLOOP
DONE0,	JMS I [CRLF	/GO TO NEW LINE
	JMP I PRTZRO

/PRINT THE AC AS A DECIMAL NUMBER
	DECIMAL
PRTDEC, HLT		/LIFTED FROM FUTIL, V6.
	JMS NUMOUT
	-1000
	-100
	-10
	0
	JMP I PRTDEC
	OCTAL

TWODEC, HLT		/TWO DIGIT DECIMAL PRINT
	AND [0177
	JMS NUMOUT
	-12
	0
	JMP I TWODEC

/ACTUAL NUMBER OUTPUT ROUTINE

NUMOUT, HLT
	DCA NUMB	/SAVE IT
NUM01,	DCA NUMDGT	/CLEAR DIGIT COUNTER
	CLA CLL
	TAD NUMB	/GET CURRENT VALUE
	TAD I NUMOUT	/MINUS DIGIT BEING PRINTED.
	SNL		/DID IT OVERFLOW?
	JMP NUM02	/NO, TOO FAR!
	ISZ NUMDGT	/YES, BUMP DIGIT.
	DCA NUMB	/AND UPDATE VALUE
	JMP NUM01+1

NUM02,	CLA CLL
	TAD NUMDGT	/OUTPUT THE DIGIT
	TAD [260
	JMS TTBUF
	ISZ NUMOUT	/GET NEXT ARG
	TAD I NUMOUT	/DONE ENOUGH?
	SZA CLA
	JMP NUM01	/NOPE, MORE TO DO.
	TAD NUMB	/ALL DONE - OUTPUT LAST DIGIT
	TAD [260
	JMS TTBUF
	JMP I NUMOUT	/AND RETURN
NUMB,	0
NUMDGT, 0
FULLDV, JMS I [PRTZRO
	NOROOM
	JMP I [7605

	PAGE
 
/ROUTINE TO GET INPUT FROM CONSOLE. READS INPUT FROM
/KEYBOARD TO INPUT BUFFER. RETURNS WHEN RETURN HIT, UNLESS
/THERE ARE NO CHARS IN THE BUFFER. SETS INCNT TO THE
/NUMBER OF CHARACTERS HIT.

GETIN,	HLT
	CLA CLL
	DCA INCNT	/INIT COUNTER TO ZERO.
	DCA ESCAPE	/CLEAR TERMINATED BY ESCAPE FLAG.
	TAD (INBUF-1	/SETUP POINTER TO BUFFER.
	DCA AX0
PRMPT,	JMS PROMP	/PRINT PROMPT CHAR.
INLOOP, JMS I [INPUT	/GET A CHAR
	CIA		/NEGATE FOR SCANNING TABLE
	DCA WS0		/SAVE IT
	TAD (CHRLST-1
	DCA AX1		/POINT TO CHARACTER TABLE
CHKCHR, TAD I AX1
	SNA		/TABLE END?
	JMP STORE	/NO. STORE IT.
	TAD WS0
	SNA CLA
	JMP GETADR	/MATCH!
	ISZ AX1		/SKIP ROUTINE ADDRESS
	JMP CHKCHR

GETADR, TAD I AX1
	DCA WS0		/GET ROUTINE ADDRESS
	JMP I WS0

STORE,	TAD WS0
	CIA		/GET CHAR. BACK
	DCA WS0		/SAVE IT.
	TAD WS0
	AND [140	/CHECK IF CONTROL CHAR.
	SNA CLA
	JMP BEEP	/RING THE BELL IF IT IS.
	TAD WS0		/GET IT BACK.
	JMS I [TTOUT
	TAD WS0
	DCA I AX0	/STORE IN BUFFER.
	ISZ INCNT	/BUMP COUNTER
	JMP INLOOP
BEEP,	TAD ("G-100	/^G - BELL
	JMS I [TTOUT
	JMP INLOOP

LFPAT=JMP INLOOP	/BATCH PATCH FOR LOC. LINPAT

/SPECIAL CHARACTER HANDLERS

RETURN, DCA ESCAPE	/CLEAR ESCAPE FLAG
	JMS I [CRLF	/SKIP TO NEXT LINE
	DCA I AX0	/FLAG END OF BUFFER.
	JMP I GETIN	/AND RETURN.

LINPAT,			/PATCHED FOR BATCH TO "JMP INLOOP"
REPEAT, JMS I [CRLF	/REPEAT HIS INPUT - NEW LINE
	JMS PROMP	/PRINT THE PROMPT.
	TAD INCNT	/ANY INPUT?
	SNA
	JMP INLOOP	/IF NONE, SIMPLY PROMPT.
	DCA LINCNT
	JMS I [TTYLST
LINCNT, 0
	INBUF
	JMP INLOOP	/NOW ECHO IS DONE, BACK TO HIM.

ESC,	TAD ("$
	JMS I [TTOUT	/** NEXT LOCATION CHANGED IF BATCH IS RUNNING BY:**
ESCBAT,	CLA CLL IAC	/SET ESCAPE FLAG. **JMP I [7605
	JMP RETURN

CLRIN,	TAD ("^
	JMS I [TTOUT
	TAD ("U
	JMS I [TTOUT	/TYPE "^U"
	JMS I [CRLF
	JMP GETIN+1	/RESET BUFFER, CR/LF, PROMPT.

/ROUTINE TO PRINT THE PROMPT MESSAGE

PROMP,	0		
	TAD MESGPR	/GET MESSAGE POINTER
	DCA PRMPTR	/SET UP POINTER
	JMS I [CRLF
PROMP1,	CDF 10		/CHANGE TO MESSAGE FIELD
	TAD I PRMPTR	/GET CHAR TO BE PRINTED
	CDF 0
	ISZ PRMPTR	/BUMP POINTER
	SNA
	JMP I PROMP	/ALL DONE, EXIT
	JMS I [TTOUT	/PRINT THE CHAR
	JMP PROMP1	/CONTINUE
MESGPR,	PROMPT
PRMPTR,	0


/RUBOUT ROUTINE. THIS STARTS OUT AS SIMPLY A ROUTINE TO
/ECHO THE CHAR BEING RUBBED OUT. THE INITIALIZATION ROUTINE
/CHECKS FOR SCOPE MODE AND OVERWRITES THIS WITH A SCOPE
/MODE ROUTINE IF APPLICABLE.

RUBOUT, TAD INCNT	/ANYTHING TO BE RUBBED OUT?
	SNA CLA
	JMP PRMPT	/NOPE.
	TAD AX0		/GET POINTER TO LAST CHAR
	DCA WS0		/WHICH IS THE ONE TO KILL.
	TAD I WS0	/GET THE CHAR
	JMS I [TTOUT
	STA
	TAD INCNT	/REDUCE INPUT COUNTER
	DCA INCNT
	STA
	TAD AX0		/AND BACK UP POINTER.
	DCA AX0
	JMP INLOOP

	ZBLOCK	5	/FILL FOR OVERLAY.
 
/	OS/8 HANDLER CALL ROUTINE.

/	CALL: JMS OSHAND
/	FUNCT
/	WHERE FUNCT IS THE HANDLER CONTROL WORD.

/	DATABF IS ALWAYS USED FOR THE TRANSFER.


OSHAND, HLT
	TAD I OSHAND	/GET FUNCTION
	DCA FUNCT
	ISZ OSHAND
	JMS I ENTRY	/CALL HANDLER
FUNCT,	0
	DATABF
BLOCK,	0		/SET BY LOOKUP/ENTER
	JMP OSERR
	JMP I OSHAND	/SUCCESSFUL

OSERR,	SPA CLA		/FATAL ERROR?
	JMP BADERR	/YUP.
	TAD OSCTR	/CLEAR DATA AVAILABLE COUNTERS.
	CIA
	DCA OSLEN
	JMP I OSHAND	/THIS FORCES EOF ON INPUT.

BADERR, JMS I [PRTZRO
	OS8ERR		/"OS/8 I/O ERROR"
	JMP I [7600

	PAGE


/ASCII TO RAD50 CONVERSION ROUTINE

/CONVERTS THE THREE CHARS POINTED TO BY AX0
/TO RAD50. USES THE FIVBIT ROUTINE TO GET THE
/FIVE BIT FORM OF THE CHARACTER AND PACKS THE THREE
/CHARS INTO THE DOUBLE PRECISION AC.

/FORMULA:RAD50=(((C1*50)+C2)*50+C3)

PAKNAM, HLT
	CLA CLL		/JUST IN CASE.
	TAD I AX0	/GET FIRST CHARACTER
	JMS FIVBIT	/CONVERT TO FIVE BIT.
	DCA ACLOW
	DCA ACHGH	/STORE IN D.P. AC
	JMS MULT50	/MULTIPLY BY 50.
	TAD I AX0
	JMS FIVBIT	/GET FIVE BIT EQUIVALENT
	DCA OPLO
	DCA OPHI	/SAVE AS OPERAND FOR ADD.
	CLL
	JMS DPADD	/ADD THE SECOND CHAR TO THE D.P. AC
	JMS MULT50	/MULTIPLY BY 50.
	TAD I AX0	/THIRD CHAR.
	JMS FIVBIT
	CLL
	DCA OPLO
	DCA OPHI
	JMS DPADD	/ALL DONE NOW.
	JMP I PAKNAM


/8 BIT ASCII TO 5 BIT RAD50 CONVERSION ROUTINE

/CONVERTS THE SIXBIT EQUIVALENT OF THE	CHARACTER
/TO THE SPECIAL FORM USED FOR RAD50. SEE THE RAD50
/ROUTINE FOR DETAILS.

FIVBIT, HLT
	SNA		/ZERO STAYS ZERO.
	JMP I FIVBIT
	AND [0077	/SIX BITS ONLY.
	TAD (-40	/SEE IF IT IS A LETTER.
	SPA
	JMP LETTER	/SURE IS.
	SNA
	JMP I FIVBIT	/BLANK IS ZERO.
	TAD (-4
	SNA
	JMP DOLR5	/IS A DOLLAR SIGN.
	TAD (-12
	SNA
	JMP PERD5	/IS A PERIOD.
	TAD (34		/MUST BE A DIGIT, SO CONVERT.
	JMP I FIVBIT

LETTER, TAD (40	/RESTORE THE LETTER
	JMP I FIVBIT

DOLR5,	TAD (33
	JMP I FIVBIT

PERD5,	TAD (34
	JMP I FIVBIT


/MULTIPLY D.P. AC BY 50. USED BY RAD50 PACKING ROUTINE.

/DONE BY MULTIPLYING BY 4 (SHIFTING LEFT 2)
/AND ADDING ITSELF; THEN MULTIPLYING BY 10 (SHIFTING
/LEFT THREE).

/I.E. A*50 = (A*4+A)*10

MULT50, HLT
	TAD ACLOW	/SAVE THE AC
	DCA OPLO	/FOR THE ADDITION COMING UP.
	TAD ACHGH
	DCA OPHI
	CLL		/JUST IN CASE.
	JMS I (DPRAL	/SHIFT TWICE.
	JMS I (DPRAL
	JMS DPADD	/ADD IN THE ORIGINAL
	JMS I (DPRAL
	JMS I (DPRAL
	JMS I (DPRAL	/SHIFT LEFT THREE
	JMP I MULT50	/RETURN.

/DOUBLE PRECISION ADD ROUTINE. ADDS OP (OPLO & OPHI)
/TO THE D.P. AC.

DPADD,	HLT
	CLL		/JUST IN CASE.
	TAD ACLOW
	TAD OPLO	/GET LOW ORDER SUM
	DCA ACLOW	/STORE
	RAL		/OVERFLOW BIT TO AC11
	TAD ACHGH
	TAD OPHI	/ADD HIGH ORDER AND OVERFLOW
	DCA ACHGH	/STORE
	JMP I DPADD


/DIVIDES DOUBLE PRECISION AC BY 50.
/USED TO UNPACK RAD50 CHARS.
/LEAVES REMAINDER IN ACHGH, QUOTIENT IN ACLOW.

DIV50,	HLT
	TAD (-14	/SETUP LOOP COUNTER
	DCA DIV5CT
DIV5LP, CLL		/JUST IN CASE!
	TAD ACHGH	/ADD -(24 0000) TO DP AC
	TAD (-24
	DCA ACHGH
	TAD ACHGH	/GET SIGN OF ACHGH IN LINK.
	RAL
	CLA SZL
	JMP SHIFT0	/IF LINK CLEAR, RESTORE AND SHIFT
			/A ZERO TO QUOTIENT. OTHERWISE, DON'T
			/RESTORE AND SHIFT A ONE.
	CML		/SET LINK TO CORRECT SENSE
ROTAT,	JMS DPRAL	/SHIFT D.P. AC LEFT ONCE.
	ISZ DIV5CT	/DONE DIVIDING YET?
	JMP DIV5LP
	JMP I DIV50	/ALL DONE.

SHIFT0, TAD ACHGH	/RESTORE D.P. AC
	TAD (0024
	DCA ACHGH
	JMP ROTAT	/SHIFT ZERO TO QUOTIENT.

DIV5CT, 0

DPRAL,	HLT		/SHIFTS D.P. AC LEFT ONE
	TAD ACLOW
	RAL
	DCA ACLOW	/ROTATE LOW ORDER, SAVE LINK.
	TAD ACHGH
	RAL		/LINK NOW IN AC11
	DCA ACHGH
	JMP I DPRAL	/WHICH IS O.K.


/PRINT A STRING ON THE TTY
TTYLST, 0
	TAD I TTYLST	/GET NUMBER OF CHARS TO PRINT
	CIA
	DCA TTCTR
	ISZ TTYLST
	STA
	TAD I TTYLST	/POINTER TO MESSAGE
	DCA AX0
	ISZ TTYLST
TTLOOP, TAD I AX0
	JMS I [TTOUT	/PRINT IT.
	ISZ TTCTR
	JMP TTLOOP
	JMP I TTYLST

TTCTR,	0

	PAGE


/PARSE A RT-11 FILENAME FROM THE INPUT BUFFER.

/NAME GOES TO RTNAM (SIZ CHARS) AND RTEXT (3 CHARS.)
/INITALLY NAME AND EXTENSION SET TO BLANKS.

RTNAME, HLT
	JMS I (SETZRO	/INITIALIZE NAME AND EXTENSION.
	11		/9 (DECIMAL) LOCATIONS.
	RTNAM
	TAD (RTNAM-1
	DCA AX1		/POINT TO OUTPUT BUFFER.
	DCA RTWLD	/CLEAR RT WILD CARD FLG

GETRT,	JMS I (NAMSCN	/PARSE NEXT CHAR.
	JMP PAKBYT	/PACK THE NAME INTO 6 BYTES
	JMP DEVERR	/CANNOT GIVE DEVICE FOR RT-11
	JMP SETEXT	/HIT A PERIOD
	JMP SRTWLD	/SET RT-WILD FLAG
	DCA I AX1	/STORE CHARACTER.
	JMP GETRT	/LOOP FOR MORE.

SRTWLD, DCA RTWLD	/SET WILD FLG ON
	JMP GETRT

SETEXT, JMS I (SETZRO	/CLEAR THE EXTENSION NOW.
	3
	RTEXT
	TAD (RTEXT-1	/NOW STORE IN EXTENSION BUFFER.
	DCA AX1
	JMP GETRT

DEVERR, JMS I [PRTZRO	/PRINT ERROR AND RETRY.
	NORTDV		/"CANNOT SPECIFY RT-11 DEVICE"
	JMP I [CALLDC

PAKBYT, CLA
	TAD RTWLD	/RT WILD CARD SPECIFIED?
	SZA CLA
	JMP GOTWLD
	JMS I [BYTNAM
	JMP I RTNAME
GOTWLD, JMS I (SETZRO
	11
	RTNAM
	JMP I RTNAME	/AND RETURN

/PARSE THE OS/8 NAME.

OSNAME, HLT
	JMS I (SETZRO	/INITIALIZE NAME AND EXTENSION.
	6
	OSNAM
	JMS I (SETZRO
	3
	OSEXT
	TAD OPTFLG	/GET DIRECTORY FLAG.
	AND (DIRIO
	SZA CLA
	TAD [4		/DEFAULT IS TTY; NOT DSK.
	TAD (DEFDV-1	/POINT TO DEFAULT DEVICE LIST
	DCA AX1
	DCA OSWLD	/CLEAR OS/8 WILDCARD FLAG
	TAD [-4		/NUMBER OF CHARS IN DEVICE NAMES.
	DCA WS0
	TAD (OSDEV-1
	DCA AX2
MOV1,	CDF 10
	TAD I AX1	/MOVE DEFAULT DEVICE NAME
	CDF 0
	DCA I AX2	/TO OSDEV
	ISZ WS0
	JMP MOV1
	TAD (OSNAM-1	/SETUP STORE POINTER
	DCA AX1

/NOW SCAN THE INPUT FOR THE OS/8 DEVICE NAME, ETC.

GETOS,	JMS I (NAMSCN	/PARSE INPUT
	JMP I OSNAME	/ALL DONE.
	JMP DEVC	/HIT A :
	JMP EXTN	/HIT .
	JMP WLDOS	/SET WILD CARD FLG
STRBT,	DCA I AX1	/OTHERS.
	JMP GETOS	/LOOP FOR MORE.

WLDOS,	DCA I AX1	/SAVE WILD CARD CHAR
	IAC
	DCA OSWLD	/SET OS/8 WILD CARD FLAG
	JMP GETOS	/AND RETURN

DEVC,	TAD (-4		/MOVE NAME TO DEVICE WORDS.
	DCA WS0
	TAD (OSNAM
	DCA WS1
	TAD (OSDEV
	DCA WS2
MOVELP, TAD I WS1	/GET A CHAR FROM THE NAME BUFFER
	DCA I WS2	/STORE IT IN THE EXTENSION BUFFER.
	DCA I WS1	/CLEAR OUT THE NAME BUFFER.
	ISZ WS1
	ISZ WS2		/INCREMENT THE POINTERS
	ISZ WS0		/CHECK COUNTER
	JMP MOVELP
	TAD (OSNAM-1	/RESET POINTER TO START OF NAME BUFFER.
	DCA AX1
	JMP GETOS

EXTN,	TAD (OSEXT-1	/POINT TO EXTENSION BUFFER.
	DCA AX1
	JMP GETOS

/PRINT A 4 DIGIT OCTAL NUMBER

PRTOCT,	0
	DCA OCTNUM	/SAVE OCTAL NUMBER
	TAD OCTNUM	/GET FIRST DIGIT
	CLL RTL;RAL
	JMS I (OCTPRT	/OUTPUT IT
	TAD OCTNUM	/GET SECOND DIGIT
	BSW
	JMS I (OCTPRT	/OUTPUT IT
	TAD OCTNUM	/GET THIRD DIGIT
	CLL RTR;RAR
	JMS I (OCTPRT	/OUTPUT IT
	TAD OCTNUM	/GET FOURTH DIGIT
	JMS I (OCTPRT	/OUTPUT IT
	JMP I PRTOCT	/ALL DONE
OCTNUM,	0

OCTPRT,	0
	AND [7		/MASK DIGIT
	TAD [260	/BUILD THE ASCII CODE
	JMS I [TTBUF	/PUT IT IN PRINT BUFFER
	JMP I OCTPRT

	PAGE

/NAME SCANNER
/USED BY COMMAND DECODER TO FIND CERTAIN CHARS.
/CALL:	JMS I (NAMSCN
/	END OF NAME	(END OF BUFFER,OR < FOUND.)
/	COLON
/	PERIOD
/	WILD-CARDS (* .OR. ?)
/	ANY OTHER CHARS.

/SPECIAL CHARS. RETURN WITH AC = 0; OTHERS WITH
/AC = THE CHAR TAKEN FROM THE BUFFER.

NAMSCN, HLT
	TAD I AX0	/GET NEXT CHAR.
	SNA
	JMP I NAMSCN	/END OF BUFFER.
	TAD (-"/	/CHECK FOR SLASH OPTION.
	SNA
	JMP SLSH	/IF SO, SKIP NEXT.
	TAD ("/-"<	/IS IT <?
	SNA
	JMP I NAMSCN	/YUP.
	TAD ("<-"=	/HOW 'BOUT =?
	SNA
	JMP I NAMSCN	/YUP. TREAT LIKE <.
	ISZ NAMSCN	/NOT END OF NAME.
	TAD ("=-":	/HOW 'BOUT COLON?
	SNA
	JMP I NAMSCN	/YUP.
	ISZ NAMSCN	/NOPE.
	TAD (":-".	/PERIOD?
	SNA
	JMP I NAMSCN	/YUP.
	ISZ NAMSCN
	TAD (".-"?	/QUES MARK?
	SNA
	JMP QUES	/YES, SET AND RETURN
	TAD ("?-"*	/HOW ABOUT A REAL-WILD CARD SYMBOL
	SNA
	JMP STARS	/YES, SET AND RETURN
	ISZ NAMSCN
	TAD ("*		/RESTORE AND RETURN.
	JMP I NAMSCN
QUES,	CLA
	TAD ("?		/LOAD SPEC CHAR
	JMP I NAMSCN	/AND RETURN
STARS,	CLA
	TAD ("*		/LOAD WILD CHAR
	JMP I NAMSCN	/AND RETURN

SLSH,	ISZ AX0		/SKIP THE CHAR. AFTER THE SLASH.
	JMP NAMSCN+1	/AND CONTINUE


/SET SPECIFIED LOCATIONS TO ZERO

/CALL:	JMS I (SETZRO
/	NUMBER OF LOCATIONS
/	STARTING LOC.

SETZRO, HLT
	RDF		/GET BUFFER FIELD
	TAD SETZR1	/BUILD DATA FIELD INSTRUCTION
	DCA SETZR2	/SAVE FIELD OF BUFFER TO BE ZEROED
SETZR1,	CDF		/MAKE SURE WE ARE IN FIELD 0
	TAD I SETZRO	/GET NO. OF LOCATIONS
	CIA
	DCA WS0
	ISZ SETZRO
	STA
	TAD I SETZRO	/GET POINTER
	DCA AX1
	ISZ SETZRO
SETZR2,	0		/CONTAINS DATA FIELD INSTRUCTION FOR BUFFER
STLOOP, DCA I AX1
	ISZ WS0
	JMP STLOOP
	CDF 0		/MAKE SURE TO RETURN TO CALLER IN FIELD ZERO
	JMP I SETZRO


/PACK THE ASCII DEVICE, FILENAME AND EXTENSION
/INTO SIXBIT.

SIXBIT, HLT
	JMS SIXPAC	/PACK THE DEVICE NAME
	4		/FOUR CHARS. LONG
	OSDEV		/FROM
	DEVIC		/INTO THE "FETCH" CALL.
	JMS SIXPAC	/NOW THE NAME
	6
	OSNAM
	NAME		/INTO THE NAME BUFFER
	JMS SIXPAC	/AND FINALLY THE EXTENSION
	2
	OSEXT
	NAME+3
	JMP I SIXBIT


/DO THE ACTUAL ASCII TO SIXBIT PACKING

/CALL:	JMS SIXBIT
/	NO. CHARS TO PACK
/	SOURCE
/	DEST


SIXPAC, HLT	
	TAD I SIXPAC	/GET # CHARS
	CLL RAR		/DIVIDED BY TWO TO GET NO. PAIRS.
	CIA
	DCA WS0		/SAVE COUNTER
	ISZ SIXPAC
	STA
	TAD I SIXPAC	/GET SOURCE POINTER
	DCA AX0
	ISZ SIXPAC
	STA
	TAD I SIXPAC	/AND DESTINATION
	DCA AX1
	ISZ SIXPAC
PACKLP, TAD I AX0	/GET FIRST
	AND [77		/ONLY SIX BITS
	CLL RTL;RTL;RTL /SHIFT INTO PLACE
	DCA WS1		/AND SAVE
	TAD I AX0	/GET NEXT
	AND [77		/ONLY SIX BITS
	TAD WS1		/GET HIGH BYTE
	DCA I AX1	/STORE IT
	ISZ WS0
	JMP PACKLP
	JMP I SIXPAC
 
/FETCH THE OS/8 HANDLER

OSFECH, HLT
	TAD (OS8HND+1
	DCA DEVN+1	/SET UP HANDLER LOC. AND SIZE.
	CIF 10		/CALL THE USR
	JMS I [200
	FETCH
DEVIC,	0		/SET UP BY DECODE AND SIXBIT.
DEVN,	0		/GETS DEVICE NUMBER
	OS8HND+1	/SPACE FOR 2 PAGE HANDLER.
	JMP BADHND	/HANDLER DOES NOT EXIST!
	TAD DEVN+1	/MOVE ENTRY POINT
	DCA ENTRY	/TO PAGE ZERO
	TAD DEVN	/ALSO DEVICE NUMBER
	DCA DEVNO
	JMP I OSFECH	/ALL DONE

BADHND, JMS I [PRTZRO
	NOHND		/HANDLER DOES NOT EXIST
	JMP I [CALLDC


	PAGE


/OS/8 ENTER ROUTINE. DOES AN ENTER ON THE SPECIFIED
/OUTPUT DEVICE.

OSENTR, HLT
	CLA CLL IAC	/SET INITIALLY INFINITE FILE LENGTH.
	DCA MAXLEN
	JMS OSCHK	/SKIP IF FILE STRUCTURED.
	JMP I OSENTR	/DON'T NEED TO ENTER NON FILE-STRUCT.

	TAD I (NAME	/NOW SEE IF WE HAVE A NAME.
	SZA CLA
	JMP NAMOK	/YUP.
	JMS I [PRTZRO	/NO NAME - THAT'S BAD!
	FILNAM
	JMP I [CALLDC	/TRY AGAIN, SPORT!

NAMOK,	TAD (NAME	/POINT TO NAME
	DCA BLOK
	TAD DEVNO
	CIF 10		/CALL USR
	JMS I [200
	ENTER
BLOK,	NAME
LEN,	0
	JMP IOERR	/OOPS!
	TAD BLOK	/MOVE STARTING BLOCK TO HANDLER
	DCA I [BLOCK	/CALL ROUTINE
	TAD LEN		/AND THE LENGTH TO
	DCA MAXLEN	/PAGE ZERO.
	DCA OSLEN	/ZERO THE FILE LENGTH COUNTER
	JMP I OSENTR

/CHECK FOR FILE STRUCTURED DEVICE

OSCHK,	HLT
	TAD DEVNO	/THIS DEVICE
	TAD (7757	/POINT TO DEVICE CONTROL WORD TABLE
	DCA WS0
	CDF 10		/IN FIELD 1
	TAD I WS0	/GET ENTRY
	CDF 0
	SPA CLA		/BIT 0 = 1 IF FILES.
	ISZ OSCHK	/SKIP RETURN.
	JMP I OSCHK



/OS/8 CLOSE ROUTINE
/CLOSES OPEN TENTATIVE FILE.

OSCLOS, HLT
	TAD OSLEN	/GET LENGTH OF FILE
	DCA CLOSLN	/STASH IN USR CALL.
	TAD DEVNO	/NEED DEVICE #
	CIF 10
	JMS I [200
	CLOSE
	NAME
CLOSLN, 0
	JMP IOERR
	JMP I OSCLOS
	JMP I OSENTR


IOERR,	JMS I [PRTZRO
	OS8ERR		/OS-8 I/O ERROR
	JMP I [7605


/RT FILE LOOKUP ROUTINE

/ROUTINE TO LOOK UP THE SPECIFIED FILE
/ON THE RT-11 DEVICE. SKIPS ON RETURN IF THE FILE
/WAS FOUND; SETS RTBLOK TO THE STARTING BLOCK,
/RTLEN TO THE FILE LENGTH.

RTLOOK, HLT
	CLA CLL IAC
	DCA DIRSG	/START WITH DIRECTORY SEGMENT 1.
LP,	JMS I [GETDIR	/READ THE DIRECTORY SEGMENT.
	TAD (FILE1	/SETUP POINTER TO FIRST FILENAME
	DCA SCNPTR
	TAD (BLOCK1-1
	DCA DIRECT	/POINT TO STARTING BLOCK OF FIRST
	JMS I [TWOBYT	/FILE AND GET INTO D.P. AC
	TAD ACLOW
	DCA RTBLOK	/SAVE STARTING BLOCK
COMPAR, TAD SCNPTR	/POINT TO STATUS WORD FOR THIS ENTRY
	DCA DIRECT
	TAD I DIRECT	/GET STATUS BYTE
	CLL RAR
	SNA
	JMP CNTBLK	/1 = TENTATIVE ENTRY; COUNT BLOCKS.
	CLL RAR
	SNA
	JMP CNTBLK	/2 = EMPTY FILE; COUNT BLOCKS.
	CLL RAR
	SZA CLA
	JMP NXTSG	/10= END OF SEGMENT.
	TAD (-6		/MUST BE PERMANENT ENTRY; CHECK NAME.
	DCA WS0		/COUNTER FOR NUMBER OF BYTES IN NAME.
	TAD (RTNAM-1	/POINT TO NAME ENTERED.
	DCA AX0
NAMLP,	TAD I AX0	/GET ENTERED BYTE (ALREADY NEGATED)
	TAD I DIRECT	/ADD THIS FILE'S NAME.
	SZA CLA
	JMP CNTBLK	/OOPS! NOT THIS ONE.
	ISZ WS0		/CHECKED 'EM ALL?
	JMP NAMLP	/NO.
	JMS I [TWOBYT	/YUP. GET THE LENGTH.
	TAD ACLOW
	DCA RTLEN
	ISZ RTLOOK	/FLAG SUCCESS
	JMP I RTLOOK

/COUNT THE BLOCKS OF EITHER EMPTY OR INCORRECT
/PERMANENT FILES

CNTBLK, TAD (7		/POINT TO LENGTH BYTES
	TAD SCNPTR
	DCA DIRECT
	JMS I [TWOBYT	/GET THE LENGTH
	TAD ACLOW
	TAD RTBLOK	/ADD THE START OF THIS FILE
	DCA RTBLOK	/TO GET START OF NEXT.

NXT,	TAD (16		/UPDATE SCAN POINTER TO NEXT
	TAD SCNPTR	/ENTRY.
	TAD EXTRA
	DCA SCNPTR
	JMP COMPAR	/KEEP GOING.

NXTSG,	TAD I (SEGLNK	/CHECK IF ANY MORE SEGMENTS.
	SNA
	JMP I RTLOOK	/GUESS NOT. RETURN WITHOUT SKIP.
	DCA DIRSG	/READ NEXT SEGMENT.
	JMP LP

	PAGE


/GENERATES RAD50 EQUIVALENT OF THE ENTERED
/FILENAME AS SIX BYTES IN RTNAM. NEGATES THE VALUES
/BEFORE STORING.

BYTNAM, HLT
	TAD (RTNAM-1	/SOURCE POINTER
	DCA AX0
	TAD (RTNAM-1	/DEST. POINTER
	DCA AX1
	TAD [-3		/NUMBER OF BYTE PAIRS.
	DCA BYTCNT
BYTLP,	JMS I (PAKNAM	/PACK THREE CHARS INTO D.P. AC
	TAD ACLOW
	AND [377	/CONVERT TO TWO BYTES.
	CIA		/COMPLEMENT.
	DCA I AX1	/STORE.
	TAD ACLOW	/HIGH BYTE NOW.
	AND [7400
	CLL RTL;RTL;RAL
	DCA WS1
	TAD ACHGH
	AND (0017	/HIGH BITS OF HIGH BYTE.
	CLL RTL;RTL
	TAD WS1
	CIA		/NEGATE IT.
	DCA I AX1	/STORE THIS TOO.
	ISZ BYTCNT	/DONE YET?
	JMP BYTLP	/NOPE.
	JMP I BYTNAM	/ALL DONE!

/EMPTY FILE ENTRY CREATION ROUTINE

MAKMT,	HLT
ENDLP,	TAD SCNPTR	/LOOK FOR THE END OF THE SEGMENT
	DCA DIRECT
	TAD I DIRECT	/GET TYPE BYTE
	TAD [-10
	SNA CLA		/END OF SEGMENT?
	JMP ENDSEG	/YUP.
	TAD SCNPTR
	TAD [16
	TAD EXTRA	/POINT TO NEXT
	DCA SCNPTR
	TAD SCNPTR	/CHECK IF OUT OF RANGE (PAST END OF SEGMENT)
	TAD (-DIRBUF-2000+16
	SPA SZA CLA
	JMP ENDLP	/O.K. KEEP LOOKING.
	JMS I [PRTZRO	/TELL HIM THE SEGMENT IS FULL.
	FULLSEG		/HE MUST SQUEEZE, OR SOMETHING.
	JMP I [CALLDC

ENDSEG, TAD SCNPTR	/INSERT NEW END OF SEGMENT FLAG
	TAD [16
	TAD EXTRA
	DCA WS0
	DCA I WS0
	ISZ WS0
	TAD [10
	DCA I WS0
	TAD SCNPTR	/MOVE THE ENTRIES STARTING FROM
			/THE EMPTY FOUND DOWN.
	TAD [15
	TAD EXTRA	/TO POINTER.
	DCA WS0
	STA
	TAD SCNPTR
	DCA WS1		/FROM POINTER.
MOVEDN, TAD I WS1
	DCA I WS0
	STA		/BACK UP POINTERS.
	TAD WS0
	DCA WS0
	STA
	TAD WS1
	DCA WS1
	TAD WS1		/CHECK IF DONE.
	CMA
	TAD BIGPTR
	SZA CLA
	JMP MOVEDN
	JMP I MAKMT	/FINISHED.

/ROUTINE TO WRITE A DIRECTORY SEGMENT.

/USED TO REWRITE THE SEGMENT OF THE DIRECTORY THAT THE
/FILE WAS ENTERED INTO. THIS MAKES THE FILE PERMANENT.

PUTDIR, 0
	TAD DIRSG	/GET CURRENT SEGMENT NO.
	CLL RAL		/*2
	TAD [4		/CONVERT TO BLOCK NUMBER.
	DCA SEG
	CIF RXFLD
	JMS I RXHAND
	4400		/WRITE+4 PGS(2 BLOCKS)+FEILD 0
	DIRBUF		/BUFFER
SEG,	0		/AND STARTING BLOCK NUMBER
	JMP I [FLOPER
	JMP I PUTDIR	/FINIS.

/OS/8 LOOKUP ROUTINE

OSLOOK, HLT
	JMS I (OSCHK	/CHECK FILENAME, ETC.
	JMP I OSLOOK	/NO LOOKUP NECESSARY (NON FILE STRUCT.)
	TAD (NAME
	DCA LOOKBL
	TAD DEVNO
	CIF 10		/CALL USR
	JMS I [200
	LOOKUP
LOOKBL, NAME		/NAME ON CALL, CHANGED TO BLOCK #
LOOKLN, 0		/BECOMES LENGTH OF FILE.
	JMP I (NOFILE	/NO FILE FOUND.
	TAD LOOKBL
	DCA I [BLOCK	/MOVE BLOCK TO PAGE 0
	TAD LOOKLN
	DCA OSLEN	/LENGTH TOO.
	JMP I OSLOOK


/CONVERT AC TO TWO BYTES IN BUFFER
/POINTED TO BY DIRECT.

BYTTWO, HLT
	DCA WS0		/SAVE IT.
	TAD WS0
	AND [377
	DCA I DIRECT
	TAD WS0
	AND [7400
	CLL RTL;RTL;RAL
	DCA I DIRECT
	JMP I BYTTWO

	PAGE


/READ A FILE FROM THE RT-11 FLOPPY AND COPY IT
/TO THE OS/8 FILE.

RTREAD, HLT
	TAD RTBLOK	/SAVE THE STARTING BLOCK
	DCA BLKSAV
READLP, TAD BLKSAV
	DCA RTBLOK	/POINT HANDLER TO FIRST BLOCK
	TAD (DATABF	/AND THE RIGHT BUFFER.
	DCA BUFPTR
	TAD RTLEN
	TAD [-3		/WANT TO READ 3 BLOCKS; IS THERE
	SPA CLA		/THAT MANY LEFT?
	JMP LEFT	/NOPE.
	TAD [3		/READ 3 RT-11 BLOCKS.
	SKP
LEFT,	TAD RTLEN	/READ WHATEVER'S LEFT.
	DCA BLKS	/SAVE FOR LATER CALCULATIONS.
	TAD BLKS
	DCA NBLOK	/STASH FOR HANDLER.
	CDF 10		/BUFFER IN FIELD 1
	JMS I [REDBLK
	CDF 0
	JMS REPACK	/REPACK AS OS/8 OUTPUT.
	CLA CLL IAC	/#OS/8	BLOCKS IS ONE MORE THAN THE NUMBER
	TAD BLKS	/OF RT-11 BLOCKS.
	DCA WS0		/SAVE.
	TAD WS0		/SEE IT OS/8 HAS THAT MUCH ROOM.
	TAD MAXLEN
	DCA MAXLEN	/LINK FLIPS ON OVERFLOW.
	SZL CLL
	JMP OVEROS	/NOT ENOUGH ROOM.
	TAD WS0		/RESTORE SIZE.
	CLL RTR;RTR;RTR /SET UP PAGE COUNT FOR OS/8 HANDLER
	TAD (4010	/GET REST OF FUNCTION CODE
			/(WRITE; FIELD 1)
	DCA WTCMD
	JMS I (OSHAND	/CALL HANDLER FOR WRITE.
WTCMD,	HLT
	CLA IAC		/UPDATE BLOCK COUNT.
	TAD BLKS
	TAD OSLEN	
	DCA OSLEN
	TAD I [BLOCK	/UPDATE OS/8 BLOCK #
	TAD BLKS
	IAC
	DCA I [BLOCK
	TAD BLKS	/DECREMENT LENGTH LEFT.
	CIA
	TAD RTLEN
	DCA RTLEN
	TAD BLKSAV	/UPDATE BLOCK POINTER
	TAD BLKS
	DCA BLKSAV
	TAD RTLEN	/SEE IF ANY LEFT.
	SZA CLA
	JMP READLP	/KEEP READING.
	JMP I RTREAD	/ALL DONE.

/PACK THE RT-11 INPUT (ONE BYTE PER WORD) INTO
/OS/8 FORMAT (3 BYTES IN TWO WORDS)


REPACK, HLT
	TAD (DATABF-1	/INITIALIZE BUFFER POINTERS
	DCA AX0
	TAD AX0
	DCA AX1
	TAD [-1000	/AND THE COUNTERS. THIS COUNTS
	DCA WS0		/1000 GROUPS OF 4 12-BIT WORDS.
	CDF 10		/POINT TO BUFFER
RPKLP,	JMS TDIAX0
	DCA WD1		/GET THE NEXT THREE BYTES.
	JMS TDIAX0
	DCA WD2
	JMS TDIAX0
	DCA WD3
	TAD WD3		/GET THE FIRST WORD.
	AND (360	/HIGH BITS OF THIRD CHAR
	CLL RTL;RTL	/INTO PLACE.
	TAD WD1		/FIRST CHAR
	DCA I AX1	/STASH IN OUTPUT
	TAD WD3		/GET LOW BITS
	AND (17
	CLL RTR;RTR;RAR
	TAD WD2		/GET SECOND CHAR
	DCA I AX1	/STASH IN BUFFER.
	ISZ WS0
	JMP RPKLP
	CDF 0		/ALL DONE (AT LAST!)
	JMP I REPACK

TDIAX0, HLT
	TAD I AX0
IMAGE,	SZA
	JMP I TDIAX0
	TAD ("Z-100	/MAKE NULLS (RT-11 EOF) INTO
	JMP I TDIAX0	/^Z (OS/8 EOF).
WD1,	0
WD2,	0
WD3,	0
BLKSAV, 0
BLKS,	0


OVEROS, JMS I [PRTZRO	/PRINT "OS/8 FILE OVERFLOW"
	OSBIG
	JMP I [CALLDC

	PAGE


/ENTER A TENTATIVE FILE ON THE RT-11 DEVICE.
/RETURNS STARTING BLOCK IN RTBLOK
/	LENGTH IN	RTLEN.


RTENTR, HLT
	DCA BIGMT	/INITIALIZE: BIGGEST EMPTY TO 0 BLOCKS,
	DCA BIGSEG	/SEGMENT # OF BIGGEST EMPTY.
	JMS I [RTLOOK	/TRY TO FIND FILE WITH SAME NAME
	JMP NOSAME	/FILE NOT FOUND.
	JMS I (RTDEL	/DELETE IT.
	NOP		/SHOULD SKIP (MEANS FILE WAS FOUND)
NOSAME, CLA IAC		/FIND THE BIGGEST EMPTY.
	DCA DIRSG
MTLOOP, JMS I [GETDIR
	TAD (FILE1	/START SCANNING THIS SEGMENT.
	DCA SCNPTR
	TAD (BLOCK1-1
	DCA DIRECT
	JMS I [TWOBYT	/GET STARTING BLOCK # OF FIRST FILE
	TAD ACLOW
	DCA RTBLOK
MTFIND, TAD SCNPTR	/POINT TO FILE TYPE BYTE
	DCA DIRECT
	TAD I DIRECT
	TAD [-2		/EMPTY?
	SZA
	JMP NOTMT	/NOPE.
	TAD SCNPTR	/POINT TO LENGTH.
	TAD [7
	DCA DIRECT
	JMS I [TWOBYT	/GET LENGTH
	TAD BIGMT	/CHECK IF BIGGEST.
	CIA
	TAD ACLOW
	SPA SNA CLA
	JMP SMALR	/SMALLER THAN LAST.
	TAD ACLOW	/SAVE DATA ABOUT THIS ENTRY.
	DCA BIGMT
	TAD DIRSG
	DCA BIGSEG
	TAD SCNPTR
	DCA BIGPTR
	TAD RTBLOK
	DCA BIGBLK
	JMP SMALR


NOTMT,	TAD (-6		/CHECK IF END OF SEGMENT.
	SNA CLA
	JMP NEWSEG
	TAD DIRECT	/GET LENGTH.
	TAD [6
	DCA DIRECT
	JMS I [TWOBYT

SMALR,	TAD ACLOW	/UPDATE STARTING BLOCK
	TAD RTBLOK
	DCA RTBLOK
	TAD SCNPTR	/POINT TO NEXT ENTRY.
	TAD [16
	DCA SCNPTR
	JMP MTFIND



/RT-11 ENTER ROUTINE CONTINUED

NEWSEG, TAD I (SEGLNK	/ANY NEXT SEGMENT?
	SNA CLA
	JMP FNDEND	/ALL DONE LOOKING.
	DCA DIRSG	/LOOK HERE NOW.
	JMP MTLOOP

FNDEND, TAD BIGMT	/FOUND ANY EMPTIES AT ALL?
	SNA CLA
	JMP I (RTFULL	/OOPS! NO EMPTIES!
	TAD BIGSEG	/READ THE SEGMENT.
	DCA DIRSG
	JMS I [GETDIR
	TAD BIGPTR	/POINT TO THE ENTRY
	DCA SCNPTR
	TAD SCNPTR
	TAD [16		/CHECK IF NEXT IS EMPTY.
	DCA DIRECT
	TAD I DIRECT	/GET TYPE BYTE.
	TAD [-2
	SNA CLA
	JMP NEXTMT	/NEXT IS EMPTY.
	JMS I (MAKMT	/MAKE AN EMPTY.
MOVE1,	STA		/POINT TO START OF ENTRY
	TAD BIGPTR
	DCA DIRECT
	DCA I DIRECT
	TAD [4		/FLAG AS PERMANENT FILE ENTRY.
	DCA I DIRECT
	JMS I (MOVNAM
	TAD DIRECT
	TAD [4		/POINT TO DATE WORDS.
	DCA DIRECT
	JMS I (OSDATE	/SET UP DATE.
	TAD BIGMT
	DCA RTLEN	/SAVE LENGTH.
	TAD BIGBLK	/RESTORE BLOCK NUMBER.
	DCA RTBLOK
	JMP I RTENTR	/DONE!


NEXTMT, TAD DIRECT
	TAD [6		/POINT TO SIZE
	DCA DIRECT
	JMS I [TWOBYT	/GET SIZE
	TAD ACLOW
	TAD BIGMT	/MERGE THE FILES.
	DCA BIGMT	/INTO ONE EMPTY.
	JMP MOVE1

/RT-11 FLOPPY CLOSE ROUTINE.
/UPDATES SIZE OF ENTERED FILE AND EMPTY FOLLOWING IT;
/ALSO DELETES ANY FILE WITH SAME NAME.

RTCLOS, HLT
	TAD RTCTR	/CONVERT SECTOR COUNTER TO BLOCK
			/COUNT. THIS IS DONE BY DIVIDING THE
			/NUMBER OF SECTORS BY FOUR.
	DCA RTSIZE	/SAVE SIZE.
	TAD BIGPTR	/GET POINTER TO FILE ENTRY
	TAD [7		/POINT TO SIZE.
	DCA DIRECT
	TAD RTSIZE	/GET SIZE OF FILE CREATED
	JMS I [BYTTWO	/CONVERT AC TO TWO BYTES, PUT IN BUFFER.
	TAD BIGPTR
	TAD [25		/POINT TO SIZE OF EMPTY.
	DCA DIRECT
	TAD RTSIZE	/DECREASE EMPTY BY SIZE OF FILE.
	CIA
	TAD BIGMT
	JMS I [BYTTWO
	JMS I [PUTDIR	/WRITE OUT DIRECTORY
	JMP I RTCLOSE	/ALL DONE.

	PAGE


/READ THE OS/8 FILE FOUR BLOCKS AT A TIME. UNPACK
/THIS DATA AND WRITE AS THREE RT-11 BLOCKS.

OSREAD, HLT
	DCA RTCTR	/COUNTS NUMBER OF RT-11 BLOCKS WRITTEN
	DCA SKIP	/CLEAR EOF FLAG
	TAD RTBLOK	/SAVE STARTING BLOCK.
	DCA BLK2	/WORD FOR HANDLER CAL, BLK# TO START WRIT AT.
	TAD RTLEN	/GET SIZE COUNTER FOR EMPTY.
	CIA
	DCA MAXLEN	/SAVE COUNTER.
OSRDLP, CLA CLL
	TAD OSLEN	/LENGTH LEFT
	TAD [4		/WANT TO READ 4 BLOCKS.
	SNL CLA
	JMP RD4		/HAVE 4 OR MORE LEFT.
	TAD OSLEN
	CIA		/READ WHATEVER IS LEFT.
	SKP
RD4,	TAD [4
	DCA OSCTR	/NO. OS/8 BLOCKS TO READ.
	TAD OSCTR	/# BLKS WE ARE DEALING WITH
	CIA		/NEGATE
	DCA BLKLFT	/SAVE FOR PROCESS LOOP
	TAD OSCTR
	CLL RTR;RTR;RTR	/BLOCK COUNT INTO POSITION AS PAGE COUNT.
	TAD [10		/FIELD OF BUFFER
	DCA RDCMD	/SAVE CONSTRUCTED COMMAND.
	JMS I [OSHAND	/CALL HANDLER
RDCMD,	0		/HANDLER COMMAND GOES HERE.
	TAD I [BLOCK	/POINT TO NEXT BLOCK OF FILE.
	TAD OSCTR	/FOR OS/8 HANDLER CAL
	DCA I [BLOCK
	TAD [DATABF-1	/POINT TO BUFFER
	DCA RTPTR
	TAD (RTBUF-1
	DCA RTPTR2	/SAVE BUFFER ADDR OF AUTO IND
	CDF BIGBUF	/CLEAR RT BUFFER AREA TO ZEROS
	JMS I [SETZRO
	2000
	RTBUF		/CLEAR FOUR RT BLOCKS WORTH
	CDF BIGBUF
	JMS I [SETZRO
	2000
	RTBUF+2000
	DCA RTBYTS	/CLEAR TOTAL # BYTES
RTLOP,	TAD (-600	/# BYTES TO MOVE PER BLOCK FOR NON-IMAGE COPY
	DCA BYTCNT	/ASSUME NOT IMAGE MODE
TOTBYT, TAD BYTCNT	/# BYTES WE PROCESS THIS LOOP
	CIA		/POSITIVE NUMBER PLEASE
	TAD RTBYTS	/+ TOTAL SO FAR
	DCA RTBYTS	/TOTAL THEM UP
NOTIM,	TAD SKIP	/IS SKIP FLAG SET?
	SZA CLA		/SKIP IF NOT
	JMP YESZ	/YES, IGNORE REST OF FILE
	CDF BFDATA	/CHANGE TO OS/8 BUFFER FIELD.
	JMS I (OSUNPK	/GET A BYTE.
	CDF BIGBUF	/FIELD OF RT-BUFFER
	DCA I RTPTR2	/SAVE THIS NEW BYTE
	CDF 0		/RETURN TO OUR FIELD
YESZ,	ISZ BYTCNT	/LOOP FOR ALL BYTES HERE
	JMP NOTIM
	ISZ BLKLFT	/DECREMENT # BLKS LEFT TO PROCESS (ALREADY READ)
	JMP RTLOP	/CONTINUE THROUGH ALL OS/8 BLOCKS WE READ
	DCA FUNC2	/CLEAR BLOCK COUNT WORD
	TAD RTBYTS
	TAD [-1
	DCA RTBYTS
RTCOUN, CLA
	TAD FUNC2	/CURRENT # BLOCKS TO WRITE
	IAC		/ADD ONE MORE
	DCA FUNC2	/SAVE NEW VALUE
	ISZ MAXLEN	/CHECK FOR RT FILE OVERFLOW
	SKP
	JMP RTFULL	/NO ROOM LEFT HERE
	TAD RTBYTS	/GET # BYTES PACKED
	TAD (-1000	/ONE BLOCK WORTH OF BYTES
	DCA RTBYTS	/SAVE NEW VALUE
	TAD RTBYTS	/AND GET IT BACK
	SMA CLA		/SKIP IF LESS THAN 1 BLOCK OF BYTES LEFT
	JMP RTCOUN	/KEEP COUNTING
	TAD FUNC2	/GET BLOCK COUNT
	DCA RTBYTS	/SAVE FOR LATER CALC
	TAD FUNC2	/GET BACK COUNT 
	CLL RAL		/BLOCKS * 2 = #PAGES TO READ
	CLL RTL
	CLL RTL
	CLL RTL
	TAD (4000+BIGBUF/ADD WRITE FUNC+FIELD FOR BUFFER
	DCA FUNC2	/AND SAVE IT	

FILLOK, CIF RXFLD
	JMS I RXHAND
FUNC2,	0
BADD2,	RTBUF
BLK2,	0
	JMP I [FLOPER

CHKDN,	TAD RTCTR	/TOTAL # BLOCKS USED IN RT FILE
	TAD RTBYTS	/+ NUMBER JUST WRITTEN
	DCA RTCTR	/= TOTAL SO FAR
	TAD OSLEN	/SEE IF MORE TO READ.
	TAD OSCTR
	SNA
	JMP I OSREAD	/ALL THROUGH.
	DCA OSLEN	/SAVE NEW COUNT.
	TAD BLK2	/CURRECT RT BLOCK NUMBER
	TAD RTBYTS	/+ NUMBER JUST WRITTEN
	DCA BLK2	/SAVE NEW BLOCK ADDRESS
	JMP OSRDLP

RTFULL, JMS I [PRTZRO
	NOROOM		/PRINT "NO ROOM ON FLOPPY"
	JMP I [CALLDC
RTBYTS, 0		/TOTAL # RT-BYTES WE PACK INTO RT BUFFER
SKIP,	0		/EOF FLAG

	PAGE


/OS/8 BUFFER UNPACKING ROUTINE

/UNPACKS THE THREE-FOR-TWO OS/8 DATA INTO
/A STREAM OF BYTES. CONVERTS ^Z (OS/8 END FILE)
/TO ZEROES (RT-11 END OF FILE.)

OSUNPK, HLT
	CLA
	JMP I GET	/CALL PROPER ROUTINE.
GET,	FIRST		/INITIALLY FIRST OF THREE.
	DCA TEMP	/SAVE NEW CHAR FOR A SEC
	TAD TEMP
	TAD (-232	/ IS THIS OS/8 END OF FILE ??
	SZA CLA		/YES SKIP
	JMP NOTZ	/OTHERWISE JUST RETURN NORMALLY
	CDF 0		/REVERT TO THIS FIELD PLEASE
	TAD (FIRST	/SET LOC BACK
	DCA GET
	IAC
	DCA I (SKIP	/SET SKIP FLAG (WE MIGHT HAVE A LINK HERE)CDF^
	JMP I OSUNPK	/RETURN WITH ZERO .. EOF TIME
NOTZ,	TAD TEMP	/GET CHAR BACK
	JMP I OSUNPK	/AND RETURN

FIRST,	TAD I RTPTR	/GET FIRST CHAR.
	DCA HI		/SAVE FOR MAKING THIRD.
	TAD HI
	JMS GET		/RETURN; POINTS GET TO SECOND (SNEAKY!)
SECOND, TAD I RTPTR	/GET SECOND
	DCA LO		/SAVE FOR THIRD.
	TAD LO
	JMS GET		/POINT TO THIRD.
THIRD,	TAD HI		/ASSEMBLE THIRD CHAR.
	AND [7400
	CLL RTR;RTR
	DCA WS0
	TAD LO
	AND [7400
	BSW
	CLL RTR
	TAD WS0
	JMS GET		/RETURN; POINTS TO JMP TO FIRST.
	JMP FIRST

HI,	0
LO,	0


/RT-11 DELETE ROUTINE. DELETES GIVEN FILE
/FROM THE FLOPPY. SKIPS ON RETURN IF THE FILE
/EXISTED.

RTDEL,	HLT
	JMS I [RTLOOK	/LOOK UP THE FILE
	JMP I RTDEL	/NOT FOUND.
	ISZ RTDEL
	TAD SCNPTR	/GET POINTER TO START OF ENTRY
	TAD [16		/POINT TO NEXT FILE.
	DCA AX1
	TAD I AX1	/TYPE OF FOLLOWING FILE
	TAD [-2		/IS IT AN EMPTY?
	SNA CLA
	JMP SQUISH	/YUP. MOVE IT OVER ME
	TAD SCNPTR
	DCA AX1
	TAD [2		/FLAG FOR EMPTY
	DCA I AX1	/PUT IN BUFFER
	JMS I [PUTDIR	/REWRITE DIRECTORY
RTRET,	JMP I RTDEL


SQUISH, TAD SCNPTR
	TAD [7		/POINT TO SIZE OF THE EMPTY
	DCA DIRECT
	JMS I [TWOBYT	/GET THE SIZE
	TAD ACLOW
	DCA WS2		/SAVE IT
	TAD DIRECT
	TAD (14		/SIZE OF THE NEXT ONE
	TAD EXTRA
	DCA DIRECT
	JMS I [TWOBYT
	TAD WS2
	TAD ACLOW	/COMBINED SIZE
	DCA WS0
	TAD SCNPTR
	DCA AX1
	TAD [2		/FLAG AN EMPTY
	DCA I AX1
	TAD SCNPTR
	TAD [7		/SIZE OF FIRST
	DCA DIRECT
	TAD WS0		/GET SIZE
	JMS I [BYTTWO	/STORE IT
	TAD SCNPTR
	TAD (15
	TAD EXTRA
	DCA AX1		/MOVE THE ENTRIES TO HERE
	TAD AX1
	TAD [16		/FROM HERE
	TAD EXTRA
	DCA AX2
MOVUP,	TAD I AX2
	DCA I AX1
	TAD AX2		/CHECK FOR DONE
	TAD (-DIRBUF-2000
	SZA CLA
	JMP MOVUP
	TAD (10		/FLAG END OF SEG.
	DCA I AX1
	JMS I [PUTDIR	/REWRITE SEGMENT
	JMP RTRET	/DONE
PAGE

/RT-11 DATE SETTING ROUTINE. USED BY CLOSE
/TO SET EITHER THE CREATION OR CURRENT DATE
/INTO THE FILE.

OSDATE, HLT
	DCA ACLOW	/INIT RT DATE STORAGE
	DCA ACHGH
	CDF 10
	TAD I [7666	/GET OS/8 DATE
	DCA DATE
	TAD I [1404	/GET NO. ADDL. INFO. WORDS FROM USR
	SNA CLA
	JMP NOAIW	/NO AIW'S, NO DATE, USE CURRENT DATE.
	STA
	TAD I [17	/POINTER TO DATE.
	DCA WS0
	TAD I WS0	/ACTUAL DATE WORD.
	SZA
	DCA DATE	/SAVE DATE, IF GIVEN.
NOAIW,	CDF 0
	TAD DATE
	SNA
	JMP NODAT	/NO DATE.
	AND [7		/YEAR ONLY.
	DCA WS0		/SAVE.
	CDF 10
	TAD I (7666	/GET OS/8 DATE.
	CDF 0
	AND [7		/YEAR ONLY.
	CIA
	TAD WS0		/GET FILE'S DATE.
	SMA SZA CLA	/SKIP IF LESS THAN CURRENT YEAR.
	TAD [-200
	TAD I [7777	/GET EXTENSION BITS.
	SPA
	CLA
	AND [600
	CLL RTR;RTR	/INTO POSITION.
	TAD WS0		/NOW YEAR-1970
	TAD [-2		/NOW RT-11 YEAR-1972.
	DCA ACLOW	/SAVE
	TAD DATE
	AND [370	/DAY BITS
	CLL RTL		/INTO POSITION FOR RT-11
	TAD ACLOW	/GET YEAR SAVED
	DCA ACLOW	/SAVE AGAIN
	TAD DATE
	AND [1400	/LOW TWO MONTH BITS.
	CLL RTL		/INTO POSITION.
	TAD ACLOW
	DCA ACLOW	/INTO SAVED LOW WORD.
	TAD DATE
	AND [6000	/HIGH TWO MONTH BITS.
	CLL RTL;RAL	/INTO POSITION.
	DCA ACHGH	/SAVE
NODAT,	TAD ACLOW
	AND [0377
	DCA I DIRECT
	TAD ACLOW
	AND [7400
	CLL RTL;RTL;RAL
	DCA WS0
	TAD ACHGH
	AND [17
	CLL RTL;RTL
	TAD WS0
	DCA I DIRECT
	JMP I OSDATE	/RETURN.
DATE,	0


	PAGE

/RT-11 FLOPPY ZERO (INIT) ROUTINE.
/WRITES ZERO DIRECTORY ON FLOPPY.

RTZER,	HLT
	CLA		/**NEXT LOCATION CHANGED IF BATCH IS RUNNING BY:**
RTBAT,	NOP		/**JMP RTZER1
	JMS I [PRTZRO
	AREYOU		/PRINT "ARE YOU SURE?"
	JMS I [INPUT
	TAD [-"Y
	SZA CLA
	JMP I RTZER	/NO.
	TAD ["Y
	JMS I [TTOUT	/PRINT HIS RESPONSE.
	JMS I [CRLF	/NEW LINE
RTZER1,	CIF RXFLD
	JMS I RXHAND
	0		/FUNC= READ DENSITY
	0
	-1		/ILL BLOCK ADDR YIELDS MEDIA DENSITY
	NOP		/ALWAYS RETURNS HERE WITH NEG BLKS IN AC.??
	CIA		/POSITIVE # BLOCKS ON FLOPPY
	TAD [-14	/LESS DIRECTORY AND HOME BLOCKS
	DCA WS0		/SAVE TEMP
	TAD WS0
	AND [7400	/GET SECOND BYTE
	CLL RTR
	RTR;RTR;RTR
	DCA I (ZSIZ+1
	TAD WS0
	AND [377	/AND FIRST BYTE
	DCA I (ZSIZ
ZMOV,	TAD [DIRBUF-1
	DCA AX1
	TAD [ZDIR-1
	DCA AX0
ZLOOP,	TAD I AX0
	SPA
	JMP ZEND
	DCA I AX1
	JMP ZLOOP
ZEND,	CLA IAC
	DCA DIRSG
	JMS I [PUTDIR	/WRITE AS DIRECTORY SEGMENT.
	JMP I RTZER

	PAGE

/DIRECTORY INPUT BUFFER.
DIRBUF,
BHISEG, 0;0		/HIGHEST DIRECTORY SEGMENT
SEGLNK, 0;0		/LINK TO NEXT SEGMENT
	0;0
BEXTRA, 0;0		/NUMBER OF EXTRA BYTES
BLOCK1, 0;0		/STARTING BLOCK OF FIRST FILE
FILE1,	0;0		/START OF FILE ENTRIES.

	*DIRBUF+2000	/ORIGIN PAST BUFFER.

MONTHS, "J;"A;"N;"-	/MONTHS LIST
	"F;"E;"B;"-
	"M;"A;"R;"-
	"A;"P;"R;"-
	"M;"A;"Y;"-
	"J;"U;"N;"-
	"J;"U;"L;"-
	"A;"U;"G;"-
	"S;"E;"P;"-
	"O;"C;"T;"-
	"N;"O;"V;"-
	"D;"E;"C;"-
	"B;"A;"D;"-

/RT-11 ZERO DIRECTORY

ZDIR,	4;0		/4 SEGMENTS IN THE DIRECTORY.
	0;0		/LINK TO NEXT SEGMENT.
	1;0		/HIGHEST OPEN SEGMENT
	0;0		/EXTRA BYTES.
	16;0		/FIRST STORAGE BLOCK
	0;2		/EMPTY FILE ENTRY
	325;0		/	0;0	/NAME
	71;147		/	0;0
	364;46		/	0;0	/EXTENSION
ZSIZ,	340;1		/SIZE
	0;0		/JOB, CHANNEL # (F/B)
	0;0		/DATE
	0;10		/END OF SEGMENT
	4000		/TERMINATOR.

OPTLST, -"Z;RTZERO;NOIO		/COMMAND DECODER OPTION TABLE.
	-"D;DELETE;OUTRT	/FORMAT: NEGATIVE OPTION CHARACTER;
	-"W;WRTRT;OUTRT+INOS	/ADDRESS OF ROUTINE TO DO; OPTFLG SETTING
	-"R;RDRT;OUTOS+INRT
	-"L;DIR;OUTOS+DIRIO
	0			/TERMINATOR.

UNUSED, "<;"U;"N;"U;"S;"E;"D;">;" ;" ;" 
NODATE, "N;"O;" ;"D;"A;"T;"E;" ;" ;" 

NAMBUF, ZBLOCK 12	/FILENAME BUFFER
NAME,	ZBLOCK 4	/NAME BUFFERS
OSNAM,	ZBLOCK 10
OSEXT,	ZBLOCK 5
OSDEV,	ZBLOCK 4
RTNAM,	ZBLOCK 6
RTEXT,	ZBLOCK 6
INBUF=	.


/******************************************************************************

NOPUNCH
*RUBOUT
ENPUNCH


	TAD INCNT	/INPUT BUFFER - CONTAINS SCOPE
	SNA CLA		/RUBOUT ROUTINE
	JMP INLOOP	/DON'T DO ANYTHING IF NO CHARS.
	TAD BS		/PRINT BACKSPACE
	JMS I TTPRT
	TAD SPC		/SPACE
	JMS I TTPRT
	TAD BS		/BACKSPACE
	JMS I TTPRT
	STA		/REDUCE CHARACTER COUNTER
	TAD INCNT
	DCA INCNT
	STA		/BACK UP POINTERS
	TAD AX0
	DCA AX0
	JMP INLOOP
TTPRT,	TTOUT
BS,	10
SPC,	240

RUBLEN=.-RUBOUT

	*7200		/OS-8 NON-SYSTEM HANDLER LOADS HERE
OS8HND=.

/******************************************************************************

NOPUNCH
*TTOUT+2
ENPUNCH

TTPAT=OS8HND

	JMS I BATPTR
	JMP I TTOUT
BATPTR, BATOUT

/******************************************************************************

NOPUNCH
*INBAT
ENPUNCH


INPAT=TTPAT+3

	NOP
	JMS I BATINP
	JMP I [7605	/EOF ERROR

/******************************************************************************

NOPUNCH
*RTBAT
ENPUNCH

BATRT=INPAT+3
	
	JMP RTZER1

/******************************************************************************

NOPUNCH
*ESCBAT
ENPUNCH

BATESC=BATRT+1

	JMP I [7605

/******************************************************************************

	*OS8HND+400	/OS/8 SYTEM HANDLER LOADS HERE.

	FIELD	1
	*2000	/PAST USR.
PAGE

/MESSAGES

AREYOU, "Z;"E;"R;"O;"-;"A;"R;"E;" ;"Y;"O;"U;" ;"S;"U;"R;"E;"?;0
BADOPT, "B;"A;"D;" ;"S;"L;"A;"S;"H;" ;"O;"P;"T;"I;"O;"N;0
DEFDV,	"D;"S;"K;0
	"T;"T;"Y;0
DIRBAD, "B;"A;"D;" ;"D;"I;"R;"E;"C;"T;"O;"R;"Y;0
FILNAM, "N;"E;"E;"D;" ;"F;"I;"L;"E;" ;"N;"A;"M;"E;0
FULLSEG,"S;"E;"G;"M;"E;"N;"T;" ;"F;"U;"L;"L;0
NOHND,	"H;"A;"N;"D;"L;"E;"R;" ;"F;"E;"T;"C;"H;" ;"F;"A;"I;"L;"E;"D;0
NOOPT,	"N;"O;" ;"O;"P;"T;"I;"O;"N;" ;"F;"L;"A;"G;0
NOROOM, "O;"U;"T;"P;"U;"T;" ;"D;"E;"V;"I;"C;"E;" ;"F;"U;"L;"L;0
NORTDV, "C;"A;"N;"';"T;" ;"S;"P;"E;"C;"I;"F;"Y;" ;"R;"T;"-;"1;"1;" ;"D;"E;"V;0
NOTFND, "F;"I;"L;"E;" ;"N;"O;"T;" ;"F;"O;"U;"N;"D;0
OS8ERR, "O;"S;"/;"7;"8;" ;"I;"/;"O;" ;"E;"R;"R;"O;"R;0
OSBIG,	"O;"S;"/;"7;"8;" ;"F;"I;"L;"E;" ;"O;"V;"E;"R;"F;"L;"O;"W;0
PROMPT,	"R;"T;"F;"L;"O;"P;">;0
RXERR, 	"R;"T;"-;"1;"1;" ;"F;"L;"O;"P;"P;"Y;" ;"I;"/;"O;" ;"E;"R;"R;"O;"R;0
VERS,	"V;"E;"R;":;" ;"A;"0;0


	*2600

DATABF=.
	*.+3000		/6 OS/8 BLOCKS



/RX01/RX02 HANDLER.


/DEFINITIONS OF RX8/E IOT'S

DEVCOD= 750		/DEVICE CODE

LCD=	6001+DEVCOD	/LOAD COMMAND REGISTER
XDR=	6002+DEVCOD	/TRANSFER DATA REGISTER
STR=	6003+DEVCOD	/SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
SER=	6004+DEVCOD	/SKIP ON ERROR FLAG, CLEAR FLAG
SDN=	6005+DEVCOD	/SKIP ON DONE FLAG, CLEAR FLAG
INTR=	6006+DEVCOD	/INTERRUPT ENABLE/DISABLE
INIT=	6007+DEVCOD	/INITIALIZE CONTROLLER AND RECALIBRATE DRIVES


/NOTES ON THIS HANDLER:

/THIS HANDLER READS AND WRITES THE DISK IN "8-BIT" MODE.

/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
/ARE WRITTEN IN THE SEQUENCE:
/	1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
/WITH A 6-SECTOR SKEW ADDED ACCROSS TRACKS

/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO

AC4000=CLL CLA CML RAR	/SET AC TO 4000
AC7776=CLL CLA CMA RAL	/SET AC TO 7776
AC0002=CLL CLA CML RTL	/SET AC TO 0002
AC7775=CLL CLA CMA RTL	/SET AC TO 7775
/DEFINITIONS OF RX8/E IOT'S

DEVCOD= 750	/DEVICE CODE

LCD=	6001+DEVCOD	/LOAD COMMAND REGISTER
XDR=	6002+DEVCOD	/TRANSFER DATA REGISTER
STR=	6003+DEVCOD	/SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
SER=	6004+DEVCOD	/SKIP ON ERROR FLAG, CLEAR FLAG
SDN=	6005+DEVCOD	/SKIP ON DONE FLAG, CLEAR FLAG
INTR=	6006+DEVCOD	/INTERRUPT ENABLE/DISABLE
INIT=	6007+DEVCOD	/INITIALIZE CONTROLLER AND RECALIBRATE DRIVES


/NOTES ON THIS HANDLER:

/THIS HANDLER READS AND WRITES THE DISK IN "8-BIT" MODE.

/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
/ARE WRITTEN IN THE SEQUENCE:
/	1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
/WITH A 6-SECTOR SKEW ADDED ACCROSS TRACKS

/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO

AC4000=CLL CLA CML RAR	/SET AC TO 4000
AC7776=CLL CLA CMA RAL	/SET AC TO 7776
AC0002=CLL CLA CML RTL	/SET AC TO 0002
AC7775=CLL CLA CMA RTL	/SET AC TO 7775


T1,	0
UNIT,	0
/
/	LIST OF VECTORS TO SECOND PAGE
/
LQUO,	QUO		/LQUO MUST LEAD OFF LIST
LRETRY, RETRY
LREC,	REC
LSIZE,	SIZE
LREMD,	REMD
LFN,	FN
LDENSW, DENSW
LENTRY, ENTRY1
LCONT,	CONT
RXA0,	0
	JMS ZOO		/COMMON ENTRY ROUTINE
L402,	402		/UNIT 0, 402 FOR CONVENIENCE
	-1		/MINUS SAYS STILL HAVE TO INIT IT;
/			/SINGLE=0, DOUBLE=20, QUAD=22
RXA1,	0
	JMS ZOO
L422,	422		/20 SAYS UNIT 1, 402 FOR CONVENIENCE
	-1		/GETS SAME TYPE CODE AS OTHER ENTRY POINT
/
/
L416,	416		/SOME LITERALS
L1000,	1000
L32,	32
L33,	33
LM32,	-32
LM6,	-6
L1734,	1734
L4110,
LM3670, -3670


/	ZOO	SUBROUTINE
/
/	TO SET UP ENTRY POINT PROCESSING, AND INIT CODE
/
ZOO,	0		/ADDR OF 'HIT' ENTRY POINT +2 COMES HERE
	CLA		/FOR SAFETY
	RDF		/SAVE CALLERS FIELD SETTING
	TAD (CDF 0	/ADD IN CDF 0
	DCA CLLFLD	/RESET WHEN GOING TO I/O SUB
	CDF 10		/DATA FIELD HERE FOR INDIRECTS
	AC7775		/SET RETRY COUNTER
	DCA I LRETRY
	TAD I ZOO	/GET UNIT NUMBER*20+402
	DCA UNIT	/HOLD FOR LATER
	ISZ ZOO		/MOVE TO TYPE CODE
	TAD I ZOO	/HAS THIS DRIVE BEED INIT'ED
L7700,	SMA CLA		/SKIP IF NO
	JMP NORMAL	/GO TO NORMAL PATH
RSTART, TAD UNIT	/PICK UP UNIT BIT, DOUBLE DENSITY +2
	TAD L10		/MAKE A READ STATUS CODE
	SDN
	JMP .-1
	LCD
	SDN
	JMP .-1
	XDR		/GET STATUS WORD
	AND L32		/KEEP DENSITY ERROR; DOUBLE; QUAD
	DCA I LCONT
	TAD I LCONT
	TAD L10		/SINGLE=10;SING/DOUB=40;DOUB=20;QUAD=22
	AND L422	/SINGLE=0;SING/DOUB=0;DOUB=20;QUAD=22
	DCA I ZOO	/PLACE TYPE CODE
	SER		/CLEAR ERROR FLAG
L10,	10		/MAY SKIP
	TAD L416	/SET DONE FLAG AGAIN
	LCD
NORMAL, TAD I ZOO	/FETCH BACK TYPE CODE
	SZA CLA		/SKIP IF A SINGLE DENSITY
	TAD L7700	/DOUBLE
	TAD L7700	/SINGLE=7700, DOUBLE=7600
	DCA I LDENSW	/PLACE FOR LOOP CONTROL
	TAD I ZOO
	CLL RTR		/PUT QUAD BIT TO LINK
	SNA CLA		/SKIP IF DOUBLE OR QUAD
	TAD L1734	/SINGLE
	TAD L4110	/D&Q=4110, S=6044
	SNL		/SKIP ON QUAD, IT'S OK RIGHT NOW
	CLL CML RAR	/SINGLE AND DOUBLE DIVIDE BY 2
	DCA I LSIZE	/S=7022, D=6044, Q=4110
	TAD I LDENSW	/7700 IF SINGLE, 7600 IF DOUBLE
	CLL CMA RTL	/375 IF SINGLE, 775 IF DOUBLE
	AND UNIT	/VOILA, 400*DOUBLE	+	20*UNIT
	DCA I LFN	/PLACE INTO FUNCTION CONTROL WORD
	AC7775		/BACK UP ZOO TO FETCH CALLING ADDR
	TAD ZOO
	DCA T1		/HOLD TEMPORARY
	TAD I T1	/HERE IS CALLING ADDR
CLLFLD, HLT		/PUT CDF TO CALLING FIELD HERE
	JMP I LENTRY	/GO TO SECOND PAGE, LEAVING POINTER TO DIVSUB
/
/	DIVSUB SUBROUTINE !!MUST!! FOLLOW IMMEDIATELY
/
/
/	DIVSUB
/
/	CALL TO SET UP TRACK, SECTOR, FROM OVERALL SECTOR #
/	ALSO, SET UNIT WITH HEAD COMMAND IF WE ARE ON TO SECOND SIDE
/
/	CALL WITH AC <0 IF IT IS REALLY AN ERROR RETRY
/	CALL WITH AC >=0 IF CALL TO DIVSUB
/
DIVSUB, 0
	CDF 10		/AND DATA FIELD MUST BE TO HERE
	SPA CLA		/SKIP IF REALLY A DIVIDE REQUEST
	JMP RSTART	/NO, IT WAS AN ERROR RETRY!!
	DCA I LQUO	/CLEAR DIVIDE QUOTIENT
	TAD I ZOO	/IS IT A TWO HEADER
	RTR		/PUT QUAD BIT TO LINK
	SNL CLA		/SKIP IF YES
	JMP SHUNT	/NO, GO DO DIVIDE
	TAD I LREC	/WHICH RECORD ARE WE WORKING ON
	TAD LM3670	/NUMBER OF SECTORS ON FIRST SIDE
	SZL CLA		/SKIP IF SECOND SIDED IT
	JMP SHUNT	/NO, JUST REGULAR
	TAD I LFN	/FORCE HEAD BIT ON
	AND L422	/KEEP DOUBLE, UNIT, READ-WRITE
	TAD L1000	/ADD IN SECOND SIDE
	DCA I LFN
	TAD LM3670	/BUT DECREASE RECORD NUMBER
SHUNT,	TAD I LREC	/THIS FOR TRACK-SECTOR
DIVLOO, ISZ I LQUO	/MAIN DIVIDE LOOP
	TAD LM32	/DIVIDE BY 26 TO GET TRACK
	SMA		/SKIP IF DONE
	JMP DIVLOO
	CLL RAL		/MULTIPLY BY 2
	TAD L33
	SMA SZA
	TAD LM32	/DIVIDE BY 26 TO GET SECTOR
	TAD L32		/RESTORE POSITIVE VALUE TO BE SECTOR
	SZL
	IAC
	TAD LM6
	DCA T1
	TAD I LQUO
	CLL RAL
	TAD I LQUO
	CLL RAL
	TAD T1
	TAD LM32
	SMA SZA
	JMP .-2
	TAD L32
	DCA I LREMD
	JMP I DIVSUB	/OUT

	PAGE
/
/
/	VARIABLES, ALSO INIT CODE LIVES HERE
/
/
CONT,	0		/DENSITY ERROR; DOUBLE; QUAD
BUF,	0		/POINTER TO CALLER'S BUFFER
RETRY,	0		/RETRY COUNT
SIZE,	0		/SIZE OF DEVICE
SYS,	0		/POINTER TO CALL
QUO,	0		/DIVIDE QUOTIENT, WHICH IS TRACK NUMBER
REC,	0		/SECTOR NUMBER OF FLOPPY
BC,	0		/CONTROL COUNT, WORDS TO TRANSFER
FN,	0		/0 FOR WRITE; 2 FOR READ; HEAD, DENSITY, UNIT
DENSW,	0		/7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
/
/	IO SUBROUTINE
/
/	ENTRY POINT AT END OF LAST LISTING PAGE
/
/
LDIVSUB,DIVSUB
ENTRY1, DCA SYS		/POINTER TO ARG'S, EXIT
	RDF		/DATA FIELD OF USER CALL
	TAD (CDF CIF 0	/MAKE CDF CIF TO CALLER'S FIELD
	DCA EXFLD	/SET UP FOR CALL
	AC4000		/SET LINK=0, AC=4000
	TAD I SYS	/CARRY READ-WRITE BIT TO LINK
	AND (70		/KEEP FIELD FOR BUFFER
	TAD (CDF 0)	/MAKE CDF TO BUFFER FIELD
	DCA BUFCDF	/PLACE INTO I/O LOOP
	CML RTL		/MAKE FUNCTION CODE, 0=WRITE, 2=READ
	TAD FN		/START-UP CODE HAS SET HEAD, DENSITY, UNIT ETC.
	DCA FN
	TAD I SYS	/MAKE LOOP CONTROL COUNT
	RAL
	AND L7600
	CIA		/0 FOR WHOLE FIELD
	DCA BC		/MINUS TOTAL NUMBER OF WORDS
	ISZ SYS		/NEXT
	TAD I SYS	/IS BUFFER ADDRESS
	DCA BUF
	ISZ SYS		/NEXT
	TAD (175	/CARRY WITH DENSW IF SINGLE DENSITY
	TAD DENSW	/BLOCK # TO SECTOR #
	SMA CLA		/SKIP IF DOUBLE, MULTIPLY BY 2
	TAD I SYS	/SINGLE, MULTIPLY BY FOUR
	SMA		/NEGATIVE BLOCK # ERROR, FORCE LINK TO BE ON
	TAD I SYS
	ISZ SYS		/MOVE POINTER TO ERROR EXIT
	CLL RAL
	DCA REC		/SAVE SECTOR NUMBER
	SZL		/SKIP IF LEGAL BLOCK #
	JMP ERREX	/FORCE DISK SIZE TO BE SET UP BEFORE EXIT!
	JMS I LDIVSUB	/CALL DIVISION SUBROUTINE OTHER PAGE
	TAD FN		/SPLIT READ AND WRITE
	JMS I (PATCH)
	DCA TRLOOP
	SZL
	JMP STREAD	/READ GOES TO START IN MIDDLE OF LOOP
/			/WRITE FALLS THRU TO NEXT LISTING PAGE
/WRITE FALLS THRU TO THIS LOOP
/
/	TOP OF MAIN LOOP
/
TOP,	TAD FN		/SET SILO TO LOAD-UNLOAD
	JMS LDCMD	/COMMAND TO CONTROLLER
	TAD DENSW	/MAKE SILO LOOP COUNT, S=7700, D=7600
	CLL RAL
	DCA FLPWC	/LDCMD ENTRY SAFE TEMPORARY
BUFCDF, HLT		/CDF TO BUFFER FIELD PLACED HERE
TRLOOP, HLT		/NOP IF READ, TAD I BUF IF WRITE
	STR		/SKIP IF READY TO PASS DATA
	JMP .-1		/NO
	XDR		/TO OR FROM AC
	DCA I BUF	/PLACE WORD FOR READ
	ISZ BUF		/MOVE BUFFER POINTER, (MAY SKIP)
REMD,	0		/DIVIDE REMAINDER, WHICH IS SECTOR NUMBER
	ISZ FLPWC	/DONE YET
	JMP TRLOOP
	TAD DENSW	/ADDING 77 (SINGLE) 177 (DOUBLE)
	CMA		/ONCE WE CMA, THAT IS
	TAD BC		/LOOP CONTROL TO FINISH READ
	SNA
	JMP OKEX	/OK, DONE
	DCA BC		/REPLACE AND KEEP GOING
/
/	MIDDLE OF MAIN LOOP
/
STREAD, TAD FN		/READ STARTS HERE
	TAD (4		/TURN SILO COMMAND INTO READ-WRITE COMMAND
	JMS LDCMD	/I/O COMMAND TO CONTROLLER
	TAD REMD	/PRECOMPUTED SECTOR #
	STR
	JMP .-1
	XDR
L7600,	7600		/CLEAR AC, AND IS LITERAL
	TAD QUO		/TRACK #
	STR
	JMP .-1
	XDR		/TRACK # IS ALWAYS NON0 !!
	ISZ REC		/MOVE TO NEXT RECORD NUMBER
	JMS I LDIVSUB	/DO TRACK SECTOR FOR NEXT OPERATION
	TAD (16		/WAIT FOR OPERATION TO COMPLETE
	JMS LDCMD
	ISZ BC		/CHECK FOR WRITE EXIT
	JMP TOP		/STILL MORE
OKEX,	ISZ SYS		/KICK TO OK EXIT
EXFLD,	HLT		/CDF CIF TO CALLER
	JMP I SYS	/OUT
/
/
/	LDCMD	SUBROUTINE
/
/	CHECK FOR CONTROL C, LOAD A COMMAND
/
FLPWC=.	/ENTRY POINT A TEMPORARY
LDCMD,	0
	TAD (100)	/XFER IS 8-BIT MODE
	DCA TRANS	/SAVE COMMAND
	SDN		/IS RX CONTROLLER READY
	JMP .-1		/NOPE, GO CHECK TTY
	TAD TRANS	/GET BACK COMMAND
	LCD		/TO CONTROLLER
	TAD CONT
	AND (10)
	SNA CLA
	JMP OK
	TAD TRANS
	CLL RTL
	RTL
	RAL
	STR
	JMP .-1
	XDR
	CLA
OK,	SER		/SKIP IF AN ERROR
	JMP I LDCMD
	AC4000		/AC CODE FOR EXIT, ALSO TO TELL DIVSUB WE'RE A RETRY!
	SKP
ERREX,	TAD SIZE	/BLOCK TOO LARGE ENTRY, SET AC CODE
	ISZ RETRY	/TRY THREE TIMES?
	JMS I LDIVSUB	/NO, AC ZERO SAYS RETRY NOT DIVIDE!!
	JMP EXFLD	/BACK TO CALLER
/
TRANS,	0		/TEMPORARY FOR LDCMD TO SAVE COMMAND
/
	PAGE
/
PATCH,	0
	RTR		/READ-WRITE BIT TO LINK
	SZL CLA		/WRITE SKIPS
	TAD (NOP-1601)	/NOP-<TAD I BUF>
	TAD (1601)	/<TAD I BUF>
	JMP I PATCH



/RT BUFFER IN FIELD 2

	FIELD	2
	*200
RTBUF=.
	*.+4000		/4 RT-11 BLOCKS
$