/LOG - PROVIDES DIALOGUE AT LOGIN & KJOB
/
	/DEFINES TO MAIN PS/8
	SYSTEM=25
	LXR=14
	X1=15
	TM1=23
	TM2=24
	DIRPOI=21
/
	LINBUF=1000	/WE DONT USE ANY ROUTINES DOWN THERE
/
	*2000	/STARTING ADDRESS
	JMP I (7600	/DO NOT ALLOW RUN
	JMS I (CRLF
	JMS I (PRMG
	  WAITMG
	JMS I (CRLF
	JMS I XGETKY	/MAKE SURE KEYMON IN CORE!
	CIF 10
	JMS I SYSTEM
	13		/LETS HAVE NO TROUBLE WITH TENT. FILES
	CLA IAC
	CDF 10
	DCA I (7600
	TAD LOGDA
	DCA I (7601
	TAD LOGDA+1
	DCA I (7602
	TAD LOGDA+2
	DCA I (7603
	TAD LOGDA+3
	DCA I (7604
	CDF 0
	CIF 10
	CLA IAC
	JMS I SYSTEM
	2
LOGSBK, LOGDA
XGETKY, GETKEY		/USED AS INDIRECT FOR CALL (DESTROYED)
	JMP I (LOGIN	/NO FILE - WE MUST HAVE LOST DISK!
	CDF 10
	CLA IAC
	DCA I (7617
	TAD LOGSBK
	DCA I (7620
	DCA I (7621
	CDF 0
COPYLG, CIF 10
	JMS I (IGETC
	JMP I (COPIED	/SE GOT IT
	AND (177
	TAD (200
	DCA TM1
	TAD TM1
	JMS I (SORTB
	-260;	TYPEOK
	-261;	TYPEOK
	-262;	TYPEOK
	0;	JMP COPYLG	/IGNORE OTHERS
TYPEOK, TAD TM1
	DCA ITYPE
	TAD ITYPE
	JMS I (PUT1C
	JMS I (GET1C
	DCA LDATE1	/NEXT CHR IS FIRST PART OF DATE
	TAD LDATE1
	JMS I (PUT1C
	JMS I (GET1C
	DCA LDATE2	/2ND HALF OF DATE
	TAD LDATE2
	JMS I (PUT1C
COPYL2, JMS I (GET1C
	TAD (-212
	SNA
	JMP COPYL3	/GOT LF (EOL)
	TAD (212
	JMS I (PUT1C
	JMP COPYL2
COPYL3, TAD (212
	JMS I (PUT1C
	DCA LSTDSK
	JMP COPYLG
/
/THIS MUST BE ON FIRST PAGE OF PROGRAM!
LOGDA,	FILENAME SYSLOG.DA
/
ITYPE,	260
LDATE1, 0
LDATE2, 0
LSTDSK, -1	/ASSUME LOST UNTIL OTHERWISE INSTRUCTED
/
EXPLAI, TEXT /"K" TO DELETE NEW FILES, "I" TO INDIVIDUALLY DECIDE/
/
	PAGE
/
COPIED, CDF 10
	TAD I (7666	/DATE
	CDF 0
	SZA CLA
	JMP DATEOK
	TAD I (LDATE1
	RTL;RTL;RTL
	AND (7700
	DCA COPIED	/CONVENIENT TEMPORARY
	TAD I (LDATE2
	AND (77
	TAD COPIED
	CDF 10
	DCA I (7666	/RESTORE DATE
	CDF 0
DATEOK, TAD I (ITYPE
	JMS I (SORTB
	-260;	LOGIN	/LOAST ENTRY KJOB - SO LETS LOGIN
	-261;	WASIN	/HE WAS IN, MUST BE GOING OUT OR BOOTING
	-262;	WASIN	/SAME POSSIBILITIES WITH FAILURE ENTRY
	0;	HLT	/DONT ALLOW OTHERS
/
/
LOGINF, -1	/FLAG TO INDICATE WHETHER TO SAVE IMAGE OF DIRECTORY
LOGIN,	DCA LOGINF	/INDICATE WE ARE TO SAVE COPY OF DIRECTORY
	TAD (261	/CHARACTER 1
	JMS I (PUT1C
	JMS I (PRMG
	  NAMEC
	JMS I (GLINE
	JMS I (MOVINF	/GET THAT INFO INTO "BUFFER"
	36		/ALLOW 30 CHARACTERS IN HIS NAME
	14		/GOES 12 CHARACTERS OVER
	JMS I (GETTIM
	JMS I (PRMG
	  PURPOS
	JMS I (GLINE
	JMS I (MOVINF
	52		/HIS PURPOSE IS 42 CHRS
	52		/AND GOES 42 CHRS OVER
	CLA CMA
	DCA I (7745	/FOR "MESSAGE OF DAY"
	ISZ I (LSTDSK
	JMP I (WRAPUP	/DISK NOT LOST, OUTPUT AND QUIT
	JMS I (WLINE	/DISK LOST, FIRST WRITE THAT OUT
	CLA
	DCA I (1600
	JMS I (MOVINF	/BLANK OUT THE TIME ENTRY
	14
	0
	JMP DESCR	/DISK LOST, DESCRIBE FAILURE
/
WASIN,	TAD I (7777
	SNA CLA
	JMP I (KJOB	/IT IS KILL JOB TIME
	/HE IS LOGGING BACK ON AFTER FAILURE
	JMS I (GETTIM
DESCR,	TAD (262
	JMS I (PUT1C
	JMS I (PRMG
	  FAILUR
	JMS I (CRLF
	JMS I (GLINE
	JMS I (MOVINF
	110
	14
	TAD I (7777
	SZA CLA /CAN ONLY BE LOGGING OFF IF THIS WAS LOST DISK!
	JMP I (WRAPUP
	JMS I (WLINE	/WRITE THAT OUT BEFORE ACCEPTING NEW
	CLA CMA
	DCA I (LSTDSK
	JMP I (KJOB
/
DIRTM,	FILENAME DIRECT.TM
/
PRFLT,	0
PRFLNM, 0	/ENTER WITH POINTER TO NAME IN AC
	DCA PRFLT
	TAD I PRFLT
	JMS I (PRWD
	ISZ PRFLT
	TAD I PRFLT
	JMS I (PRWD
	ISZ PRFLT
	TAD I PRFLT
	JMS I (PRWD
	ISZ PRFLT
	TAD I PRFLT
	SNA CLA
	JMP I PRFLNM	/NO EXTENSION
	TAD (".
	JMS I (PCH
	TAD I PRFLT
	JMS I (PRWD
	JMP I PRFLNM
/
	PAGE
SAVDIR, 0
	CLA IAC
	JMS I (LKDRNZ
	TAD BUFDIR
	DCA DIRPOI
SAVDLP, JMS I (NXTENT
	SNA
	JMP SAVDI2
	DCA TM1 	/SAVE OFF POINTER TO FILE
	TAD I TM1
	SNA CLA
	JMP SAVDLP	/IGNORE EMPTY FILES
	JMS I (MFLENG
	SNA CLA
	JMP SAVDLP	/IGNORE TENTATIVES
	TAD (-4
	DCA TM2
SAVDL1, TAD I TM1
	CDF 10
	DCA I DIRPOI
	CDF 0
	ISZ TM1
	ISZ DIRPOI
	ISZ TM2
	JMP SAVDL1
	JMP SAVDLP
SAVDI2, CDF 10
	DCA I DIRPOI	/MARK END OF LIST
	CDF 0
	TAD DIRPOI
	TAD (-2000
	RTL;RTL;RAL
	IAC
	AND (7
	DCA SVBLKS
	TAD SVBLKS
	CLL RTL;RTL;IAC
	CIF 10
	JMS I SYSTEM
	3
SAVDIS, DIRTM
	0
	JMP I SAVDIR	/WE COULDNT DO IT
	TAD SAVDIS
	DCA DIRSB
	TAD SVBLKS
	CLL RTR;RTR;RTR
	TAD (4010
	DCA BUFDIR-1
	JMS I (7607
	0
BUFDIR, 2000		/AT 2000 IN FIELD 1
DIRSB,	0
	JMP I SAVDIR	/OH WELL
	CLA IAC
	CIF 10
	JMS I SYSTEM
	4
	DIRTM
SVBLKS, 0
	JMP I SAVDIR
	JMP I SAVDIR
/
KJDELE, 0
	CLA CLL
	TAD KJFPOI
	DCA KJDELP
	CLA IAC
	CIF 10
	JMS I SYSTEM
	4
KJDELP, 0
	0
	NOP	/SHOULDNT HAPPEN
	JMP I KJDELE
/
GETKEY, 0
	JMS I (7607
	0700		/0-1577 (DO NOT WIPE OUT LINE BUFFER YET
	0
KEYG7,	7
	HLT
	TAD (200
	DCA SYSTEM	/USR MUST BE IN CORE!
	TAD KEYG7
	CDF 10
	DCA I (7673	/KILL HASP
	CDF 0
	JMP I GETKEY
/
EXPL2,	TEXT /"K" TO DELETE THIS FILE, "P" TO PRESERVE IT/
/
	PAGE
WRAPUP, JMS WLINE
	TAD ("Z-100
	JMS PUT1C
	ISZ LOGINF	/SKIPS IF NOT LOGIN
	JMS I (SAVDIR	/SAVE A COPY OF THE DIRECTORY WHEN LOGGING IN
DATECH, CIF 10
	CLA IAC
	JMS I SYSTEM
	2
DATESB, DATESV
	0
	JMP I (7600
	TAD DATESB
	DCA DATE2B
	CIF 10
	JMS I SYSTEM
	6
DATE2B, 0
/
/
PUT1C,	0
	CIF 10
	JMS I (OPUTC
	JMP I PUT1C
/
GET1C,	0
	CIF 10
	JMS I (IGETC
	HLT
	JMP I GET1C
/
WLINE,	0
	CLA
	CDF 10
	TAD I (7666
	CDF 0
	DCA MOVINF	/GOOD TEMP
	TAD MOVINF
	RTR;RTR;RTR
	JMS ADDBIT
	JMS PUT1C
	TAD MOVINF
	JMS ADDBIT
	JMS PUT1C
	CLA CMA
	TAD (LINBUF
	DCA LXR
	TAD (LINBUF
	TAD (124
	DCA ADDBIT
WLINE0, CLA CMA
	TAD ADDBIT
	DCA ADDBIT
	TAD I ADDBIT
	TAD (-240
	SNA
	JMP WLINE0
	CLA
	ISZ ADDBIT
	DCA I ADDBIT
WLINE2, CLA CLL
	TAD I LXR
	SNA
	JMP WLINE3
	TAD (-240
	SPA
	JMP WLINE2	/IGNORE LESS THAN SPACE
	TAD (240
	JMS PUT1C
	JMP WLINE2
WLINE3, TAD (215
	JMS PUT1C
	TAD (212
	JMS PUT1C
	JMP I WLINE
/
ADDBIT, 0
	AND (77
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMP I ADDBIT
/
MOVINF, 0
	TAD I MOVINF
	CMA
	DCA WLINE	/TEMPORARY
	ISZ MOVINF
	TAD I MOVINF
	ISZ MOVINF
	TAD (LINBUF-1
	DCA LXR
	TAD (1577
	DCA X1
MOVIL1, ISZ WLINE
	SKP
	JMP I MOVINF
	TAD I X1
	SNA
	JMP MOVIL2
	DCA I LXR
	JMP MOVIL1
MOVIL2, TAD (240
	DCA I LXR
	ISZ WLINE
	JMP MOVIL2
	JMP I MOVINF
/
	PAGE
KJOB,	TAD (260	/KJOB SIGNAL
	JMS I (PUT1C
	ISZ I (LSTDSK	/DONT GET TIME IF WE LOST DISK
	JMS I (GETTIM
	JMS I (PRMG
	  REMARK
	JMS I (GLINE
	JMS I (MOVINF
	110
	14
	JMS I (WLINE
	TAD ("Z-100
	JMS I (PUT1C
	CLA IAC
	CIF 10
	JMS I SYSTEM
	2
KJDIRS, DIRTM
	0
	JMP KJOBYE	/NO FILE, JUST QUIT
	TAD KJDIRS
	DCA KJRDS
	TAD KJDIRS+1
	CIA CLL RTR;RTR;RTR
	AND (3700
	TAD (10
	DCA KJRDS-2	/BUILT FUNCWD
	JMS I (7607
	0
	2000
KJRDS,	0
	JMP KJOBYE	/WELL, THATS THE WAY IT GOES
	CLA IAC
	JMS I (LKDRNZ	/GET READY TO READ THE CURRENT DIRECTORY
KJDIRL, JMS I (NXTENT
	SNA
	JMP KJOBYE
	DCA KJFPOI
	TAD I KJFPOI
	SNA CLA
	JMP KJDIRL	/IGNORE EMPTY FILES
	JMS I (MFLENG
	SNA CLA
	JMP KJDIRL	/ALSO IGNORE A TENTATIVE
	TAD (3
	TAD KJFPOI
	DCA TM1
	TAD I TM1	/LOOK AT EXTENSION
	JMS I (SORTB
	-2415;	KJDEXT	/.TM
	-1423;	KJDEXT	/.LS
	-0213;	KJDEXT	/.BK
	0
	JMS KJNEW	/SKIPS IF NOT NEW
	JMS I (KJHANL	/NEW FILE, WE MUST DO SOMETHING
	JMP KJDIRL	/OK, GO ON TO NEXT
KJFPOI, 0
KJDEXT, JMS I (KJDELE
	JMP KJDIRL
KJNPOI, 0
KJNEW,	0
	TAD (2000
	DCA DIRPOI
KJNLP0, CDF 10
	TAD I DIRPOI
	CDF 0
	SNA CLA
	JMP I KJNEW	/HIT END, IT IS NEW, DONT SKIP
	TAD KJFPOI
	DCA KJNPOI
	TAD (-4
	DCA TM2
KJNLP1, TAD I KJNPOI
	CIA
	CDF 10
	TAD I DIRPOI
	CDF 0
	SZA CLA
	JMP KJNLP2
	ISZ DIRPOI
	ISZ KJNPOI
	ISZ TM2
	JMP KJNLP1
	ISZ KJNEW	/HALLELUJAH, WE FOUND AN OLD FILE
	JMP I KJNEW	/SKIP ON RETURN
KJNLP2, ISZ DIRPOI		/MOVE OUT ON THE MASTER LIST POINTER
	ISZ TM2
	JMP KJNLP2
	JMP KJNLP0
KJOBYE, JMS I (PRMG
	  GOODBY
KJOBLF, TAD (-11	/WE WONT BE COMING BACK THRU HERE
	DCA .-1
	JMS I (CRLF
	ISZ KJOBLF
	JMP .-2
	JMP I (DATECH
/
/
	PAGE
/SUBROUTINES
/
GLINE,	0
	CLA
	TAD (PCH
	DCA 26		/MAKE MONITOR CALL MY ROUTINE
	TAD (": 	/CHANGE THE SIGNAL FROM MONITOR
	DCA 164
	TAD (7000	/ALLOW A NULL LINE
	DCA I (1255	/WATCH OUT!!!!!!!!!!!!!!!
	JMS I 27	/CALL MONITOR GLINE
	JMP I GLINE
/
PCH,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I PCH
/
PCHAR,	0
	AND (77
	SNA
	JMP I PCHAR
	JMS I (ADDBIT
	JMS PCH
	JMP I PCHAR
/
PRWD,	0
	DCA PRWDTM
	TAD PRWDTM
	RTR;RTR;RTR
	JMS PCHAR
	TAD PRWDTM
	JMS PCHAR
	JMP I PRWD
PRWDTM, 0
/
PRMG,	0
	CLA CLL
	TAD I PRMG
	ISZ PRMG
	DCA CMPRTM
PRMGLP, TAD I CMPRTM
	JMS PRWD
	TAD I CMPRTM
	AND (77
	SNA CLA
	JMP I PRMG
	ISZ CMPRTM
	JMP PRMGLP
/
SORTB,	0
	DCA CMPRTM
	TAD I SORTB
	ISZ SORTB
	SNA
	JMP SORTBX
	TAD CMPRTM
	SNA CLA
	JMP SORTBN
	ISZ SORTB
	JMP SORTB+2
SORTBN, TAD I SORTB
	DCA CMPRTM
	JMP I CMPRTM
SORTBX, CLA CLL
	JMP I SORTB
CMPRTM, 0
/
CRLF,	0
	CLA
	TAD (215
	JMS PCH
	TAD (212
	JMS PCH
	JMP I CRLF
/
GETTIM, 0
	JMS PRMG
	  TIME
	JMS GLINE
	JMS I (MOVINF
	14
	0
	JMP I GETTIM
/
	PAGE
/
KJHBR,	KJHCON	/INITIALLY
KJHANL, 0
	JMP I KJHBR	/THIS WILL BE SET UP
KJHCON, JMS I (PRMG
	  CONFIR
	JMS I (GLINE	/SEE WHAT HE SAYS DO
	TAD I (1600
	JMS I (SORTB
	-"K;	KJHDA
	-"I;	KJHIND
	0
	JMS I (PRMG
	  EXPLAI
	JMS I (CRLF
	JMP KJHCON
KJHIND, TAD (KJHIN1-KJHD1	/HE WILL HANDLE THEM INDIVIDUALLY
KJHDA,	TAD (KJHD1	/HE WANTS TO DELETE ALL NEW FILES
	DCA KJHBR
	JMP I KJHBR	/GO FOR THIS ONE
KJHIN1, TAD I (KJFPOI
	JMS I (PRFLNM
	JMS I (GLINE
	TAD I (1600
	JMS I (SORTB
	-"K;	KJHD1
	-"P;	KJHRET
	0
	JMS I (PRMG
	  EXPL2
	JMS I (CRLF
	JMP KJHIN1
KJHD1,	TAD I (KJFPOI
	JMS I (KJDELE
KJHRET, JMP I KJHANL
/
/
REMARK, TEXT /REMARKS/
WAITMG, TEXT /WAIT../
NAMEC,	TEXT /NAME AND COURSE/
TIME,	TEXT /TIME/
FAILUR, TEXT /DESCRIBE FAILURE, IF POSSIBLE/
PURPOS, TEXT /PURPOSE OF USE/
CONFIR, TEXT /CONFIRM/
GOODBY, TEXT /GOODBYE/
DATESV, FILENAME DATE.SV
/
	PAGE
READIR, 0
	SNA
	JMP RIRCON	/IT WAS ZERO
	DCA RIRDEV	/NOT ZERO, NEW DEVICE
	ISZ READIR	/SET UP TO RETURN TO CALL+2
	TAD (IDEV
	DCA RIRCAL
	TAD RIRDEV	/GET DEV CODE
	CIF 10
	JMS I SYSTEM
	1		/FETCH HANDLER (IF NOT IN)
RIRCAL, 0
	HLT
	CLA CLL
	CDF CIF 0
	JMS I RIRCAL	/READ
	1400	/SIXBLOCKS
	4000		/BUFFER LOC
	1	/DIRECTORY
	HLT
	JMP I READIR	/RETURN
RIRDEV, 0
RIRCON, TAD I NSEGL	/LINK TO NEXT SEG
	SNA CLA
	JMP I READIR	/RETURN TO CALL+1 (NO NEXT SEG)
	TAD (400
	TAD NSEGL
	DCA NSEGL
	ISZ READIR
	JMP I READIR
NSEGL,	4002

	/SUBROUTINE LKDRNZ
	/INITIALIZES CORE IMAGE OF DIRECTORY AND
	/PERFORMS INITIALIZATIONS FOR NXTENT
	/CALL WITH DEVICE NUMBER IN ACC

LKDRNZ, 0
	JMS READIR	/READ SEG 1 OF DIR
	HLT		/WHAT! NO FIRST SEG?
	JMS LKDRST	/SET UP VARS
	JMP I LKDRNZ
LKDRST, 0
	CLA CMA
	TAD I SEGCT	/SET UP COUNTER IN NXTENT
	DCA NXTECT
	TAD SDPOIN
	DCA NXTEPT
	TAD (400
	TAD SDPOIN
	DCA SDPOIN
	TAD (400
	TAD SEGCT
	DCA SEGCT
	JMP I LKDRST
SEGCT,	4000
SDPOIN, 4005


	/SUBROUTINE NXTENT
	/RETURNS WITH POINTER TO NEXT FILE ENTRY IN ACC
	/RETURNS WITH AC=0 IF NO NEXT ENTRY
	/NOTE: NXTEPT ALREADY POINTS TO NEXT ENTRY
	/IT IS SET TO POINT TO WHERE THE NEXT FOLLOWING ENTRY SHOULD
	/BE BEFORE RETURN

NXTENT, 0
	CLA CLL
	ISZ NXTECT	/IS THERE ANOTHER ENTRY IN THIS SEGMENT
	JMP NXTEOK	/YES
	JMS READIR	/NO, GET NEXT SEGMENT
	JMP I NXTENT	/IF IT COMES BACK HERE, NO MORE ENTRIES AT
	JMS LKDRST	/SET UP VARS FOR NEW SEG
	ISZ NXTECT	/ON RECALL WE NEED THIS
NXTEOK, TAD NXTEPT	/THIS IS THE POINTER
	DCA NXTEVA	/SAVE IT WHILE WE SET UP FOR NEXT CALL
	TAD I NXTEPT
	SNA CLA
	JMP NXTEEM	/IT WAS AN EMPTY FILE
	CLA CMA 	/SET UP WITH -1
	TAD I (4004	/GET NUMBER OF ADDIT INFOWDS
			/MUST BE SAME THROUGHOUT
	DCA NXTEAE
	TAD NXTEPT
	TAD (5		/IF NOT EMPTY, INC AT LEAST 5
NXTELP, ISZ NXTEAE	/THEN INCREMENT FOR ADDITIONAL ENTRIES
	SKP
	JMP NXTEL2	/DONE WITH THIS NONSENSE
	IAC
	JMP NXTELP	/KEEP ON
NXTEL2, DCA NXTEPT	/STORE IT FOR NEXT CALL ON THIS ROUTINE
	TAD NXTEVA	/OK, LETS GET OUT OF HERE
	JMP I NXTENT
NXTEVA, 0
NXTECT, 0
NXTEPT, 0
NXTEAE, 0
NXTEEM, CLA CLL CML RTL /GET TWO TO ADD
	TAD NXTEPT
	JMP NXTEL2	/STORE BACK AND LEAVE
FLDATE, 0
	CLA CLL
	TAD I NXTEVA	/LOOK AT FIRST CHARACTER OF NAME
	SNA CLA
	JMP I FLDATE	/EMPTY FILE, RETURN DATE OF ZERO
	TAD (4		 /POINT TO DT WORD
	TAD NXTEVA
	DCA FLDAT1
	TAD I FLDAT1	/GOT IT
	JMP I FLDATE	/RETURN
FLDAT1, 0

	/SUBROUTINE MFLENG
	/RETURNS THE NEGATIVE IF THE FILE LENGTH
MFLENG, 0
	CLA CLL
	TAD I NXTEVA
	SNA CLA 	/SKIP IF NOT EMPTY FILE
	JMP MFLEMP
	TAD I (4004	/GET MINUS ADDIT INFO WDS
	CIA
	TAD (3		/GET PART WAY  PAST FILE NAME
MFLEMP, IAC		/REST OF THE WAY
	TAD NXTEVA	/POINT TO IT
	DCA FLDAT1
	TAD I FLDAT1	/GOT IT
	JMP I MFLENG	/RETURN

	PAGE
/ASCII I/O FOR PS-8

/DEFINITIONS REQUIRED FOR CHARACTER I/O ROUTINES.

INBUFF=6200
OUTBUFF=INBUFF+400
IDEV=4600	/WHERE INPUT HANDLER GOES
ODEV=5000	/WHERE OUTPUT HANDLER GOES.
ERROR1=HLT	/WHAT TO DO WHEN AN ERROR IS DETECTED.
IOAREA=7200

FIELD 1
IFNDEF I2PAGE <I2PAGE=0>

*IOAREA
/READ A CHARACTER FROM THE INPUT FILE.
/IF INPUT FILE NOT OPEN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVICES USED WILL GENERATE AN INTERRUPT.	THIS HAS NOT
/BEEN TRIED AS OF 3/2/71.


IGETC,	0
	CLA CLL 	/JUST IN CASE.
	RDF
	TAD (CDF CIF
	DCA IEXIT+1
	CDF CIF 10
IL00,	ISZ IPNTR
	TAD I IPNTR	/PICKUP A CHARACTER, IF ANY LEFT.
	TAD (-232
	SNA CLA 	/SKIP IF NOT  Z.
	JMP IEND	/NEXT INPUT FILE.
	TAD I IPNTR
	SMA		/SKIP IF ALL 3 CHARS USED UP.
	JMP IEXIT	/RETURN WITH CHAR IN ACC.
	DCA IPNTR	/RESTORE POINTER (SEE IPNTR+1 ETC.)

	ISZ IWC 	/SKIP IF BUFFER EMPTY.
	SKP
	JMP INNEXT	/GET NEXT ONE.

INGET,	TAD I ICA	/1ST WORD OF PAIR.
	AND (377
	DCA IPNTR+1
	TAD I ICA
	AND (7400
	DCA IPNTR+3
	ISZ ICA
	TAD I ICA
	AND (377
	DCA IPNTR+2
	TAD I ICA
	AND (7400
	CLL RTR;RTR
	TAD IPNTR+3
	CLL RTR;RTR
	DCA IPNTR+3
	ISZ ICA
I7600,	7600
	JMP IL00	/FETCH A CHARACTER.
INNEXT, ISZ INBLOK
	ISZ INBLWC	/SKIP IF INPUT FILE AT AN END.
	JMP INEXT


/INPUT BOOKKEEPER. IT USES FILE TABLE CREATED IN 17617 BY
/COMMAND DECODER, TO OPEN AND FETCH SUCCESSIVE FILES FOR THE
/IGETC ROUTINE. ROOM FOR A HANDLER FOR EACH INPUT FILE
/MAY BE 2 PAGES IF 'I2PAGE'=1,IN ANY CASE IT MUST EXIST AT
/'IDEV' IN FIELD 0, UNLESS IT IS A SYSTEMS DEVICE, OF COURSE.
/THE TERMINATOR FOR INPUT FILES IS A '0' FILE DEVICE TYPE.
/9 INPUT FILES ARE ALLOWED.

IEND,	TAD (11
IL01,	IAC
	DCA IL02
	TAD (IDEV+I2PAGE
	DCA INHNDL
	TAD I FPNTR
	AND (17
	SNA		/SKIP IF ANY MORE FILES.
	JMP IL03
	JMS I (200
IL02,	 12		/OR 1.
INHNDL,  IDEV+I2PAGE
	ERROR1		/HUH?
	TAD .-2
	SNA CLA 	/SKIP IF HANDLER IN CORE.
	JMP IL01	/LOAD IT IF NOT.
	TAD I FPNTR	/GET BLOCK-COUNT IN BITS 0-7.
	AND (7760
	SNA		/SKIP IF NOT INDETERMINATE.
	JMP .+4
	CLL RTR;RTR
	TAD (7400
	DCA INBLWC	/SETUP COUNT.
	ISZ FPNTR
	TAD I FPNTR
	DCA INBLOK	/INPUT FILE BLOCK NUMBER.
	ISZ FPNTR
	TAD IPNTR+4
	DCA IPNTR

INEXT,	CIF
	JMS I INHNDL
	 210
INP,	 INBUFF
INBLOK,  0		/NEXT INPUT BLOCK*
	JMP IL04
	TAD INP
	DCA ICA
	TAD I7600
	DCA IWC
	JMP INGET
IL04,	SPA CLA 	/SKIP IF 'SOFT' ERROR.
	ERROR1
	JMP INBLOK+2

/COME HERE AT END OF LAST FILE.

IL03,	TAD (7617
	DCA FPNTR
	TAD (232
	DCA IPNTR+1
	TAD IPNTR+4
	DCA IPNTR
	SKP

IEXIT,	ISZ IGETC	/NO EOF RETURN.
	CIF CDF
	JMP I IGETC

/VARIABLES USED BY IGETC

IPNTR,	.		/POINTER*
	232		/STORES 1ST OF 3 CHARACTERS*
	0		/2ND
	0		/3RD
	IPNTR		/TERMINATOR
			/**WARNING** THIS MUST FOLLOW
			/IPNTR+3, AND POINT TO LOCATION
			/ABOVE 14000!!
INBLWC, -1		/COUNTS FILE BLOCKS*
IWC,	0		/COUNTS 200 WORD-PAIRS.
ICA,	INBUFF		/POINTS TO NEXT WORD-PAIR.
FPNTR,	7617		/POINTS TO INPUT FILE TABLE IN LAST
			/PAGE OF FIELD 1.

/*	NOTE: THESE LOCATIONS FILLED BY INPUT BOOKKEEPER.
/USED BY OUTPUT ROUTINES.
/COME HERE IN CASE OUTPUT CANNOT BE OPENED ON FIRST TRY.
OFAIL,	TAD I I7600
	AND (7760
	SNA CLA 	/SKIP IF NOT INDEFINITE REQUEST.
	ERROR1		/OUTPUT FILE PROBABLY TOO LARGE.
	TAD I I7600
	AND (17
	DCA I I7600
	JMP I (OUENTR	/TRY INDEFINITE.
PAGE
/DELIVERS A CHARACTER TO THE OUTPUT FILE. OUTPUT FILE NAME/MUST HAVE BEEN DEFI
INED PREVIOUSLY!!
/ Z WILL CLOSE OUTPUT FILE.
/CALLED BY:
/	TAD CHAR
/	IOF		/SEE NOTE AT IGETC ABOVE.
/	CDF
/	CIF 10
/	JMS I (OPUTC
/	RETURN (ACC=0)


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

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

/CLOSE THE OUTPUT FILE.

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

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVICES USED WILL GENERATE AN INTERRUPT.	THIS HAS NOT
/BEEN TRIED AS OF 3/2/71.


IGETC,	0
	CLA CLL 	/JUST IN CASE.
	RDF
	TAD (CDF CIF
	DCA IEXIT+1
	CDF CIF 10
IL00,	ISZ IPNTR
	TAD I IPNTR	/PICKUP A CHARACTER, IF ANY LEFT.
	TAD (-232
	SNA CLA 	/SKIP IF NOT  Z.
	JMP IEND	/NEXT INPUT FILE.
	TAD I IPNTR
	SMA		/SKIP IF ALL 3 CHARS USED UP.
	JMP IEXIT	/RETURN WITH CHAR IN ACC.
	DCA IPNTR	/RESTORE POINTER (SEE IPNTR+1 ETC.)

	ISZ IWC 	/SKIP IF BUFFER EMPTY.
	SKP
	JMP INNEXT	/GET NEXT ONE.

INGET,	TAD I ICA	/1ST WORD OF PAIR.
	AND (377
	DCA IPNTR+1
	TAD I ICA
	AND (7400
	DCA IPNTR+3
	ISZ ICA
	TAD I ICA
	AND (377
	DCA IPNTR+2
	TAD I ICA
	AND (7400
	CLL RTR;RTR
	TAD IPNTR+3
	CLL RTR;RTR
	DCA IPNTR+3
	ISZ ICA
I7600,	7600
	JMP IL00	LENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVICSYMULATOR
/THIS CAN PROBABLY BE SHORTENED AND
/IMPROVED UPON.

FIELD 1
	IFZERO EAE <
*3000

SUDOMQ, 0
SUDOSC, 0
	>
	IFZERO EAE <	/FOR NON EAE ONLY

*3100
PSDNMI, 0		/NMI
	DCA PSDSCA	/SAVE AC
	DCA SUDOSC	/CLEAR STEP COUNTER.
	TAD PSDSCA
	SZA
	JMP .+5
	TAD SUDOMQ
	SNA CLA
	JMP I PSDNMI	/0 AC AND MQ.
NMIBK2, TAD PSDSCA
	RAL
	SZL
	JMP NMIOUT	/AC0=1
	SPA
	JMP NMIOUT+2	/AC0=0 AND AC1=1
	CLA		/AC0=AC1=0
NMIBCK, TAD SUDOMQ
	CLL RAL
	DCA SUDOMQ
	TAD PSDSCA
	RAL
	DCA PSDSCA
	ISZ SUDOSC
	JMP NMIBK2
NMIOUT, SPA
	JMP .+3 	/AC0=AC1=1
	RAR		/AC0 DOES NOT EQUAL AC1
	JMP I PSDNMI	/EXIT
	RAR		/TEST IF NUMBER 6000 0000
	TAD .+11
	SZA CLA
	JMP NMIBCK	/NOT 6000
	TAD SUDOMQ
	SZA
	JMP NMIBCK+1	/NOT 0000
	CML		/RESTORE LINK
	TAD PSLENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVICBIT COUNTER
	CMA
	DCA SUDOSC
	TAD SUDOMQ	/SHIFT COMBINED
	CLL RAL 	/AC AND MQ
	DCA SUDOMQ	/1 BIT TO THE
	TAD PSDCAM	/LEFT
	RAL
	DCA PSDCAM
	ISZ SUDOSC
	JMP .-7 	/MORE SHIFTING
	TAD PSDCAM
	JMP I PSDSHL	/EXIT
PSDLSR, 0		/LSR
	DCA PSDCAM	/SAVE AC
	TAD PSDLSR	/USE ASR
	DCA PSDASR	/ROUTINE
	CLL
	JMP PSDASR+5
	>
	IFZERO EAE <	/MORE EAE SIMULATOR

PSDASR, 0		/ASR
	CLL		/SET LINK=SIGN
	SPA
	CML
	DCA PSDCAM	/SAVE AC
	TAD I PSDASR	/SHIFT COUNT
	ISZ PSDASR	/EXIT POINT
	AND PSDSHL-1	/5 BIT COUNTER
	CMA
	DCA SUDOSC
	TAD PSDCAM	/RESTORE AC
	JMP .+4
	TAD PSDCAM
	SPA
	CML
	RAR
	DCA PSDCAM
	TAD SUDOMQ
	RAR
	DCA SUDOMQ
	CLL
	ISZ SUDOSC
	JMP .-12		/MORE SHIFTING
	TAD PSDCAM
	SPA
	CML		/LINK=AC0
	JMP I PSDASR
	7763
PSDDVI, 0		LENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVICCA MQLDVI
	TAD SUDOMQ
	RAR
	DCA SUDOMQ	/LOW ORDER PRODUCT
	ISZ PSDLSR
	JMP .-13
	TAD MQLDVI	/HIGH ORDER PRODUCT
	JMP I PSDMUY	/EXIT
	>
/DATE ROUTINE - PS/8

	FIELD 1
	*2000

IFZERO EAE <	/DEFINES TO SIMULATOR
MQL=JMS I (PSDMQL
DVI=JMS I (PSDDVI
MQLADVI=JMS I (MQLDVI
MQA=JMS I (PSDMQA
	>
/
IFNZRO EAE <	/DEFINE FOR COMPATIBILITY
MQL=7421
DVI=7407
MQLADVI=MQL DVI
MQA=7501
	>

	CLA CLL
	TAD 7666	/GET DATE FROM MONITOR PAGE
	AND (7
	DCA YR
	TAD 7666
	RTR; RAR
	AND (37
	SNA
	JMP I (BADDAT
	DCA DAY
	TAD 7666
	RTL; RTL; RAL
	AND (17
	SNA
	JMP I (BADDAT
	DCA MONTH
	JMS WKDAY
	TAD MONTH
	JMS PRNMON
	TAD DAY
	JMS OCTDEC
	TAD (CMSPC-1
	JMS PRINT
	TAD YR
	TAD (3662	/ADD 1970 TO YEAR
	JMS OCTDEC
	JMP I (MSGDAY
YR,	0LENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVIC.
	0
	0
	0
	0
	4000
DPMAX,	-.+2
DPT,	0
	TAD K260
	DCA I BUF
	ISZ BUF
	JMP I DPT
DPOUT,	CLA
	DCA I BUF
	TAD (BUFLO-1
	JMS PRINT
	JMP I OCTDEC
REM,	0
K260,	260
BUF,	0
BUFLO,	ZBLOCK 7
CMSPC,	",;" ;0


	*2200
PRNMON, 0
	TAD (MNTBL-1
	DCA MNIND
	TAD I MNIND
	JMS PRMSG
	TAD (240	/SPACE
	JMS PCH
	JMP I PRNMON
/
PRMSG,	0
	DCA PRMSGT	/ADDRESS OF MESSAGE REQ. ON ENTRY
PRMGLP, TAD I PRMSGT
	JMS PRWD
	TAD I PRMSGT
	AND (77
	SNA CLA
	JMP I PRMSG
	ISZ PRMSGT
	JMP PRMGLP
PRMSGT, 0
PRWD,	0
	DCA PRWDT
	TAD PRWDT
	RTR;RTR;RTR
	JMS PCHAR
	TAD PRWDT
	JMS PCHAR
	JMP I PRWD
PRWDT,	0
PCHAR,	0
	AND (77
	SNA
	JMP I PCHAR
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS I (PCH
	JMP I PCHAR
MNTBL,	JAN;FEB;MAR;APR;MAY;JUN;JUL;AUG;SLENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVIC	TAD (3
	TAD (2
	TAD (3
	NOP
	TAD (3
	TAD DAY
	MQLADVI
	7
	TAD (WKTBL
	DCA WKIND
	TAD I WKIND
	JMS I (PRMSG
	TAD (CMSPC-1
	JMS PRINT
	JMP I WKDAY
REMAIN, 0
DCOUNT, 0
WKIND,	0
WKTBL,	WED;THU;FRI;SAT;SUN;MON;TUE
SAT,	TEXT /SATURDAY/
	*2600
MON,	TEXT /MONDAY/
TUE,	TEXT /TUESDAY/
WED,	TEXT /WEDNESDAY/
THU,	TEXT /THURSDAY/
FRI,	TEXT /FRIDAY/
SUN,	TEXT /SUNDAY/
BADMG1, TEXT /BAD DATE ON SYSTEM/
BADMG2, TEXT /PLEASE ENTER DATE:/
BADMG3, TEXT '.DATE MM/DD/YY'
BADDAT, TAD (BADMG1
	JMS I (PRMSG
	JMS CRLF
	TAD (BADMG2
	JMS I (PRMSG
	JMS CRLF
	TAD (BADMG3
	JMS I (PRMSG
EXIT,	CIF CDF 0
	JMP I (7605
CRLF,	0
	TAD (215
	JMS I (PCH
	TAD (212
	JMS I (PCH
	JMP I CRLF

/ALL OF THIS STUFF IS NEW TO MAKE
/CHANGES INDICATED IN "UPDALENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,  7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF, CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (ODEV+O2PAGE
	DCA OUHAND
	DAD I O7600
	SNA	EN, THEN OPEN IT. IF INPUT FILE
/DONE, THEN GET THE NEXT. IF NO NEXT, THEN RETURN
/TO CALL+1, OTHERWISE RETURN TO CALL+2 WITH CHARACTER IN ACC.

SYSDEV=7607

/CALLED BY:
/	IOF		/SEE NOTE BELOW.
/	CDF
/	CIF 10
/	JMS I (IGETC
/	 RETURN (ACC=0) IF END OF ALL INPUT FILES.
/	 RETURN (ACC=CHAR) OTHERWISE.
/NOTE:	BOTH IGETC AND IPUTC COULD POSSIBLY RUN WITH ION, IF
/NO DEVIC SYS
	  0210		/INTO FIELD 1
	  .+400&7600	/TWO PAGES AWAY
MSGBLK,   0		/THE BLOCK
	JMP EXIT	/CAN'T HAPPEN
	CIF 0		/NOW WRITE IT OUT
	JMS I TTYENT	/ON THE TTY
	  4210
	  .+400&7600
	  0		/NOT USED
	JMP EXIT	/HUH..
	ISZ MSGBLK	/NEXT BLOCK
	ISZ MSGFIL+1	/ANY MORE?
	JMP NXTBLK	/YEP
	JMP EXIT	/NOPE.....

	PAGE
	STHAND=.
	/THIS CONTAINS TTY HANDLER FOR MESSAG.DY
	STBUFF=.+200
	/AND TWO PAGES OF BUFFER.
	ENDBUFF=.+600

$$$$$$$$$$$$

$NO DEVIC SYS
	  0210		/INTO FIELD 1
	  .+400&7600	/TWO PAGES AWAY
MSGBLK,   0		/THE BLOCK
	JMP EXIT	/CAN'T HAPPEN
	CIF 0		/NOW WRITE IT OUT
	JMS I TTYENT	/ON THE TTY
	  4210
	  .+400&7600
	  0		/NOT USED
	JMP EXIT	/HUH..
	ISZ MSGBLK	/NEXT BLOCK
	ISZ MSGFIL+1	/ANY MORE?
	JMP NXTBLK	/YEP
	JMP EXIT	/NOPE.....

	PAGE
	STHAND=.