Google
 

Trailing-Edge - PDP-10 Archives - de-10-omona-v-mc9 - twice.mac
There are 6 other files named twice.mac in the archive. Click here to see a list.
TITLE TWICE - DRIVER FOR USER MODE ONCE ONLY  V4A(25)



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978 BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
SUBTTL D BLACK/JSL/EVS/TW 27 AUG 78


VTWICE==4	;VERSION NUMBER
VEDIT==25	;EDIT NUMBER
VMINOR==1	;MINOR VERSION NUMBER
VWHO==0		;EDITED BY DEC

JOBVER==137
	LOC	JOBVER
	BYTE	(3)VWHO(9)VTWICE(6)VMINOR(18)VEDIT
	RELOC

;SEARCH S AND F LIBRARIES
SEARCH F,S

;DECLARE EXTERNS SO CAN SEARCH MONITOR LIBRARY FILE IN LIBRARY SEARCH MODE

EXTERN	ONCMOD,REFSTR,FILFND,FILIO,FILUUO

;MISC PARAMETERS

DSK==1		;CHANNEL FOR DISK IO
.UPOFL==1B1	;BIT IN DSKCHR AC RETURN=1 IF UNIT OFF LINE
.STNAM==4	;NAME OF FILE STRUCTURE
.UNCHR==5	;WORD IN DSKCHR BLOCK RETURN=CHARACTERISTICS OF UNIT
.UNBPU==6	;WORD IN DSKCHR BLOCK RETURN=CAPACITY OF UNIT
.UNHID==16	;UNIT ID
.UNMAX==17	;LARGEST SIZE DSKCHR BUFFER NEEDED
LINSIZ==100	;SIZE OF TTY LINE BUFFER
PDLEN==100	;LENGTH OF PUSH DOWN LIST
MJOBN==-^D64	;MINUS MAX NUMBER OF JOBS (NOT REALLY NEEDED)
SPBCOR==3	;LENGTH OF CORE FOR A SPOOLING BLOCK (NOT NEEDED)
PAVJSP==0
PROTM::0
SCDSWP::0
BLKSPK==3	;SHIFT FOR BLOCKS PER K
MBKSPK==-3	;RIGHT SHIFT FOR BLOCKS PER K
PIOMOD==0
DSKPIN==0
DSKPIF==0
PION==0
PIOFF==0
PIPROG==0
INDPPN==0
ICPFAC==0

IFNDEF JIFSEC,<JIFSEC==^D60>
JIFMIN==JIFSEC*^D60

IFNDEF RETRYN,<RETRYN==^D360	;NUMBER OF TIMES TO RETRY TO CREATE SCRATCH FILE>
IFNDEF BLKPUN,<BLKPUN==^D50	;BLOCKS PER UNIT IN SCRATCH FILE>

;DUMMY INTERNS (603)
DONE::M.SWCT::THIS::PROT1::.PDACS::TTCCIS::SWPCHK::ERPTMX::
QQRUN1::SWPPIK::TT2CI2::DIAMTA::TYPSCD::TTCCOS::TT2CO1::MPOPJ::
CNFST2::FILMSG::.PDDIA::SWPHNG::.PDDFL::PDYFSP::%SIFDA::TRPSET::DEVSRG::
SENDSP::ESVIDX::DPXREG::FSXREG::PRTDDB::RPXREG::EPKIDX::SWPSCN::
.C0ASN::MACTSL::ERPTBK::.IPCFD::.IPCFP::FHXREG::SCNCNT::FNDPDS::
PDVTIM::SETHNG::DECIN1::QMXTAB::QMLTAB::FDAJOB::SNDMDC::MDCJOB::
PIDTAB::RTZER1::PCRLF::MAXACS::.PDEPA::SQREQ::QADTAB::
	POPJ	P,
WPOPJ1::AOS	-1(P)
WPOPJ::	POP	P,W
	POPJ	P,

TKBUDB::CNFMTK::M.XFFA::TKBKDB:: 0
	INTERN	BLKSPK,MBKSPK,DSKPIN,DSKPIF,PION,PIOFF,ICPFAC,JIFSEC,JIFMIN
	INTERN	PIPROG,INDPPN,PIOMOD,MJOBN,SPBCOR,PAVJSP,PROTM,SCDSWP

	EXTERN	DEVBLK,DEVDMP,FILOPT,UNINAM,.JBFF,UUOPWQ,.UONCE,DIFUSY,UNISYS,UNISTS
	EXTERN	UNIDES,UNILOG,UNIHID,GETUNI,SVMOUT

TWICE:	JFCL			;IN CASE OF CCL ENTRY
	RESET
	SETOM	OPTQIK##	;DONT ASK ABOUT OFF-LINE UNITS
	MOVE	P,[IOWD PDLEN,PDLIST]
	SETZ	T1,		;WRITE ENABLE HIGH SEGMENT
	SETUWP	T1,
	  JRST	[OUTSTR [ASCIZ/? CANNOT WRITE ENABLE HIGH SEGMENT
/]
		 EXIT]
	MOVE	T1,.JBFF	;FIRST FREE LOCATION
	MOVEM	T1,ONCEND
	CALLI	T1,14		;TODAY'S DATE
	MOVEM	T1,THSDAT
	TIMER	T1,		;TIME OF DAY
	MOVEM	T1,TIME
	MOVE	T1,[XWD 44,11]
	GETTAB	T1,
	MOVEI	T1,^D60
	MOVEM	T1,TICSEC
	IMULI	T1,^D60
	MOVEM	T1,TICMIN
	MOVE	T1,[53,,11]
	GETTAB	T1,
	  SETZ	T1,
	MOVEM	T1,DATE
	MOVE	T1,[XWD 14,16]	;GET NUMBER OF MONITOR BUFFERS
	GETTAB	T1,
	  CAIA			;USE WHAT WAS THERE ALREADY IF ERROR
	MOVEM	T1,MBFNUM##	;ITS THERE, USE THAT INSTEAD.
	MOVE	T1,[DOLBLK]	;SETUP .JBINT TO INTERCEPT DISK OFF LINE
	MOVEM	T1,.JBINT##
	MOVE	T1,[PJRST	USRDIO]
	MOVEM	T1,UUOPWQ	;PATCH FILIO TO CALL OUR DISK I/O ROUTINE
	SETOM	.UONCE		;NOTE USER MODE ONCE ONLY
	MOVEI	U,DIFUSY	;PTR TO LIST OF UNITS IN OUR SYSTEM
	MOVSI	T1,UNPSAF	;SINGLE ACCESS BIT TO CLEAR FOR EACH UNIT
	JRST	USTSCF		;CLEAR IMPORTANT FLAGS FOR EACH UNIT
USTSCL:	SETZM	UNISTS(U)	;MAKE SURE STATUS WORD CLEAR
	SETZM	UNILOG(U)	;MAKE SURE KEEP FLAG CLEAR TOO
	ANDCAM	T1,UNIDES(U)	;AND CLEAR WRITABLE FLAG
	MOVE	T2,UNINAM(U)	;NAME OF UNIT
	MOVEM	T2,CHRBUF	;STORE IN DSKCHR BUFFER
	MOVE	T2,[XWD .UNHID+1,CHRBUF] ;ARG PTR
	DSKCHR	T2,		;GET UNIT ID
	  TDZA	T2,T2		;NOT A DISK?
	MOVE	T2,CHRBUF+.UNHID ;UNIT ID
	MOVEM	T2,UNIHID(U)	;PICK UP NOW SO CAN SPECIFY READ/WRITE UNITS
				;WITH UNIT ID SO DONT NEED TO KNOW WHICH
				;PHYSICAL UNIT THEY'RE MOUNTED ON
USTSCF:	HLRZ	U,UNISYS(U)	;NEXT UNIT IN OUR SYSTEM
	JUMPN	U,USTSCL	;LOOP FOR ALL OUR UNITS
	SETZM	CURUNI
	GETPPN	T1,		;GET OUR PPN
	  JFCL			;IN CASE JACCT ON
	MOVEM	T1,OURPPN
	SETZM	DEBUGF		;MAKE SURE NOT IN DEBUG MODE
;HERE TO ASK IF SCRATCH FILE TO BE USED

	SETOM	FILFLG		;ASSUME SCRATCH FILE
	MOVEI	T1,[ASCIZ .
SCRATCH FILE? (Y OR <CR>) .]
	PUSHJ	P,YESNO		;ASK AND YE SHALL RECEIVE
	SETZM	FILFLG		;DON'T USE SCRATCH FILE


;HERE TO FIND OUT WHICH UNITS TO USE

NOSCR:	MOVEI	T1,[ASCIZ .
READ UNITS: .]
	PUSHJ	P,SVMOUT	;ASK FOR UNITS TO READ
NXTRED:	PUSHJ	P,GETUNI	;GET NEXT UNIT TO READ
	  JRST	NOREAD		;NO MORE UNITS TO READ
	JUMPE	U,ALLRED	;JUMP IF ALL TYPED
	PUSHJ	P,KEEPRD	;JUST ONE, KEEP IT
	JRST	NXTRED		;LOOP FOR NEXT TYPED
ALLRED:	MOVEI	U,DIFUSY	;ALL, PTR TO FIRST UNIT
NXARED:	HLRZ	U,UNISYS(U)	;NEXT UNIT IN OUR SYS
	JUMPE	U,LSTRED	;JUMP IF NO MORE
	PUSHJ	P,KEEPRD	;KEEP THIS UNIT
	JRST	NXARED		;LOOP FOR NEXT UNIT IN OUR SYSTEM
NOREAD:
LSTRED:	MOVEI	T1,[ASCIZ .
WRITE UNITS: .]
	PUSHJ	P,SVMOUT	;ASK FOR UNITS TO WRITE ON
NXTWRT:	PUSHJ	P,GETUNI	;GET NEXT UNIT TO WRITE
	  JRST	NOWRIT		;NO MORE
	JUMPE	U,ALLWRT	;JUMP IF ALL TYPED
	PUSHJ	P,KEEPWT	;KEEP THIS UNIT FOR WRITING
	JRST	NXTWRT		;LOOP FOR NEXT TYPED
ALLWRT:	MOVEI	U,DIFUSY	;ALL, PTR TO FIRST UNIT
NXAWRT:	HLRZ	U,UNISYS(U)	;GET NEXT UNIT IN SYSTEM
	JUMPE	U,LSTWRT	;JUMP IF NO MORE
	PUSHJ	P,KEEPWT	;KEEP THIS UNIT FOR WRITING
	JRST	NXAWRT		;LOOP FOR NEXT UNIT IN OUR SYSTEM
;HERE TO REMOVE UNWANTED UNITS FROM OUR LISTS

NOWRIT:
LSTWRT:	PUSHJ	P,SAVKON	;PATCH OUT SETKON SO STATUS OF OFF LINE
				; AND DOWN UNITS IS PRESERVED
	MOVEI	U,DIFUSY	;PTR TO FIRST UNIT IN OUR SYSTEM
NXTKEP:	HLRZ	U,UNISYS(U)	;NEXT UNIT
	JUMPE	U,SHORTD	;JUMP IF NO MORE UNITS
	SKIPN	UNILOG(U)	;SKIP IF KEEPING THIS UNIT
	PUSHJ	P,FLGDW		;NO, FLAG IT AS DOWN
	SETZM	UNILOG(U)	;CLEAR FLAG
	JRST	NXTKEP		;LOOP FOR ALL UNITS
;TYPING ESCAPE DURING ONCE WILL BRING YOU BACK HERE TO TRY AGAIN.

SHORTD::
	SETZB	P1,SHUTUP##	;CLEAR SHORT FLAG
	SKIPGE	DEBUGF
	JRST	QUICK
	MOVEI	T1,[ASCIZ/
STARTUP OPTION: /]
	PUSHJ	P,ASKGET	;ASK QUESTION
	JRST	ONCHLP		;GIVE SOME HELP
	PUSHJ	P,CTEXT		;GET FIRST WORD
	JUMPN	T2,LNG1		;JUMP IF WORD GIVEN
	CAIN	T3,"/"		;SEE IF /H
	JRST	LNGHLP		;YES--LONG HELP
	JRST	ONCHLP		;NO--SHORT HELP

LNG1:	MOVE	T1,[-OPTLEN,,OPTTAB]
	PUSHJ	P,FNDNAM	;LOOKUP NAME
	  JRST	ONCHLP		;GIVE SOME HELP
	XCT	OPTXCT(T1)	;DO YOUR THING

	JRST SHORTD

;DONE BY XCT ABOVE

OPTXCT:	PUSHJ	P,SHRTPM##
	PUSHJ	P,SHRTST##
	JRST	QUICK
	PUSHJ	P,FILOPT##
	JRST	PVQCK
	PUSHJ	P,SHRTRF##
	PUSHJ	P,SHRTID##
PVQCK::
	SETOM	OPTQIK##
	JRST	QUICK
;SHORT HELP
ONCHLP:	MOVEI	T1,[ASCIZ "
CHANGE,DESTROY,GO,LONG,QUICK,REFRESH,UNITID
/H FOR HELP
"]
	JRST	ONCHL1		;TYPE THAT OUT
LNGMSG:	ASCIZ "
CHANGE	- CHANGE DISK PARAMETERS
DESTROY	- REBUILD ALL DISKS.  DELETES ALL FILES, SETS ALL DEFAULTS.
GO	- START THE SYSTEM IF ALL IS OK.
LONG	- ENTERS LONG DIALOGUE
QUICK	- SAME AS GO BUT DO NOT ASK ABOUT OFF-LINE DEVICES.
REFRESH	- REFRESH SELECTED STRUCTURES
UNITID	- CHANGE UNIT ID'S
"
LNGHLP:	MOVEI	T1,LNGMSG
ONCHL1:	PUSHJ	P,ICONM
	PUSHJ	P,OPOUT
	JRST	SHORTD
OPTTAB:	SIXBIT	/CHANGE/
	SIXBIT	/DESTRO/
	SIXBIT	/GO/
	SIXBIT	/LONG/
	SIXBIT	/QUICK/
	SIXBIT	/REFRES/
	SIXBIT	/UNITID/

OPTLEN==.-OPTTAB
;THE LONG DIALOGUE BEGINNETH HERE.....

LONGD:	SETOM	(P)		;SET "ALTMOD"-TYPED FLAG

	INTERNAL FTDISK
IFN FTDISK, <
	EXTERNAL FILOPT
	PUSHJ	P,FILOPT	;GO THROUGH THE REFRESH DIALOGUE(S) [LEVEL C]
				; TYPE STATE OF WHOLE DISK SYSTEM, THEN
				; ACCEPT CHANGES TO UNITS AND STR'S & REFRESH [LEVEL D]
>
QUICK:	PUSHJ	P,RESKON	;RESTORE SETKON ROUTINE IN CASE TWICE 
				; IS RESTARTED
	EXIT			;ALL DONE

;SUBROUTINE TO MARK UNIT DOWN WITHOUT REMOVING IT FROM LIST OF UNITS
; USED TO BE USED ONLY WHEN SCRATCH FILE IN USE SO UNITS ALWAYS IN SAME
; PLACE IN FILE, BUT SINCE HIGH AVAILABLITY (602), ALL UNITS REMAIN
; IN UNIT DATA BLOCK CHAIN, SO THIS ROUTINE USED ALL THE TIME.

FLGDW:	MOVEI	T1,UNVDWN##	;VALUE TO MARK UNIT DOWN
	DPB	T1,UNYUST##	;STORE IN UNIT STATE
	MOVSI	T1,UNPOFL##	;UNIT OFF LINE
	IORM	T1,UNIDES##(U)	;STORE
	SETZB	T1,UNILOG##(U)	;CLEAR UNILOG
	DPB	T1,UNYSIC##	;AND SATS IN CORE
	POPJ	P,

;FNDNAM--ROUTINE TO SEARCH FOR ABBREV. NAME IN TABLE
;CALL	MOVE	T1,AOBJN POINTER TO LIST OF NAMES
;	MOVE	T2,SIXBIT ABBREVIATION
;	PUSHJ	P,FNDNAM
;NON-SKIP IF UNKNOWN (T1=0) OR DUPLICATE (T1 .NE. 0)
;SKIP RETURN IF FOUND WITH T1=INDEX IN TABLE


FNDNAM::PUSHJ	P,SAVE3		;SAVE P1,P2
	SETZB	P1,T4		;CLEAR MATCH MASK AND POINTER
	MOVSI	P2,(77B5)	;START AT LEFT END
FNDNM1:	TDNE	T2,P2		;SEE IF SPACE
	IOR	P1,P2		;NO--IMPROVE MASK
	LSH	P2,-6		;MOVE RIGHT ONE CHAR
	JUMPN	P2,FNDNM1	;LOOP FOR SIX CHARS
	SETOM	P2		;SET ABBREV COUNTER
	MOVE	P3,T1		;SAVE POINTER
FNDNM2:	MOVE	T3,(T1)		;GET NEXT CANDIDATE
	XOR	T3,T2		;COMPARE
	JUMPE	T3,FNDNMW	;WIN
	AND	T3,P1		;MASK IT
	JUMPN	T3,FNDNM3	;LOOSE
	MOVE	T4,T1		;WIN--SAVE POINTER
	AOS	P2		;COUNT SUCCESS
FNDNM3:	AOBJN	T1,FNDNM2	;LOOP FOR ALL ENTRIES
	MOVE	T1,T4		;RESTORE POSSIBLE WINNER
	JUMPN	P2,CPOPJ	;JUMP IF UNSUCCESSFUL
FNDNMW:	SUB	T1,P3		;COMPUTE INDEX
	TLZ	T1,-1		;REMOVE JUNK
	JRST	CPOPJ1		;SKIP RETURN
;SUBROUTINE TO SEE IF SHOULD KEEP UNIT FOR READING OR WRITING
;FOR READING MUST BE 1,2 OR SINGLE ACCESS
;FOR WRITING MUST BE SINGLE ACCESS OR 1,2 AND NOT IN A FILE STRUCTURE

	EXTERN	UNPSAF

KEEPWT:	SKIPE	FILFLG		;SKIP UNLESS USING SCRATCH FILE
	JRST	KEEPW1		;OK TO WRITE
	MOVE	T1,UNINAM(U)	;NAME OF UNIT
	MOVEM	T1,CHRBUF	;STORE IN DSKCHR ARGUMENT BUFFER
	MOVE	T1,[XWD .STNAM+1,CHRBUF]
	DSKCHR	T1,		;FIND OUT ABOUT UNIT
	  POPJ	P,		;NOT A DISK?
	TLNN	T1,UNPSAF	;SKIP IF SINGLE ACCESS - OK TO WRITE
	SKIPN	CHRBUF+.STNAM	;NO, OK IF NOT IN AN STR
	JRST	KEEPW1		;OK TO WRITE ON THIS UNIT
	MOVEI	T1,[ASCIZ .CANT WRITE.]
	PUSHJ	P,SVMOUT	;TELL USER CANT WRITE THAT UNIT
	JRST	KEEPRD		;BUT KEEP IF FOR READING IF POSSIBLE
KEEPW1:	MOVSI	T1,UNPSAF	;OK TO WRITE, BORROW BIT AS WRITABLE FLAG
	IORM	T1,UNIDES(U)	;SET WRITABLE FLAG IN OUR UNIT DATA BLOCK
KEEPRD:	SETOM	UNILOG(U)	;SET FLAG TO KEEP UNIT
	MOVE	T1,OURPPN	;GET OUR PPN
	SKIPN	FILFLG		;SKIP IF SCRATCH FILE - OK TO READ
	CAMN	T1,FSFPPN	;OK IF WE HAVE PRIVILEGES
	POPJ	P,		;USER HAS PRIVILEGES TO ACCESS UNIT
	MOVE	T2,UNINAM(U)	;GET NAME OF UNIT
	MOVEI	T1,T2		;PTR TO DSKCHR ARGS
	DSKCHR	T1,		;GET CHARACTERISTICS
	  POPJ	P,		;NOT A DISK?
	TLNE	T1,UNPSAF	;SKIP IF NOT SINGLE ACCESS - CANT READ
	POPJ	P,		;OK, SINGLE ACCESS MEANS USER CAN READ THIS UNIT
	MOVEI	T1,[ASCIZ .CANT READ.]
	PJRST	SVMOUT		;TELL USER CANT READ THIS UNIT
SUBTTL TTY INPUT SUBROUTINES
	INTERN	YESNO

YESNO:	PUSHJ	P,ASKGET	;ASK QUESTION, GET ANSWER
	  POPJ P,0		;JUST C-R
	PUSHJ	P,ONCTYI	;GET NEXT CHAR
	TRZ	T3,40		;FIRST CHAR OF RESPONSE (U.C.)
	CAIN	T3,"Y"		;WAS IT A Y ?
	AOS	0(P)		;YES. SKIP
	POPJ	P,		;NO, MAYBE IT WAS "N". SO DON'T SKIP


ASKGET:	PUSHJ	P,ICONM		;OUTPUT THE QUESTION
	PUSHJ	P,OPOUT
	PJRST	GETLIN		;GET ANSWER

;SUBROUTINE TO READ A LINE
; CALL:	PUSHJ	P,GETLIN
;	JUST A CR TYPED IN
;	NORMAL RETURN (NOT A BLANK LINE)

	INTERN	GETLIN

GETLIN:	MOVE	T1,LINEP	;BYTE POINTER TO LINE
	MOVEM	T1,ONCTIP
	SETZ	J,

GET1:	INCHWL	T3		;READ NEXT CHAR
	CAIN	T3,177		;SKIP IF NOT RUBOUT
	JRST	GET1		;IGNORE RUBOUTS
	CAIE	T3,33		;SKIP IF ALTMODE
	CAIL	T3,175		;SKIP IF NOT ALTMODE
	JRST	GETLN1		;JUMP IF ALTMODE
	CAIL	T3,140		;SKIP IF NOT LOWER CASE
	TRZ	T3,40		;CONVERT TO UPPER CASE
	IDPB	T3,T1		;STORE IN LINE BUFFER
	CAIE	T3,15		;SKIP IF CARRIAGE RETURN
	AOJA	J,GET1		;NO, COUNT CHARS
	INCHWL	T3		;READ LINE FEED FOLLOWING
GET2:	IDPB	T3,T1		;STORE LINE FEED
	SETZ	T3,		;NULL FOR END OF LINE
	IDPB	T3,T1		;STORE THE NULL
	JUMPN	J,CPOPJ1	;JUMP IF NON-BLANK LINE
	POPJ	P,		;NO, EMPTY LINE

GETLN1:	HRROS	J		;NOTE PRESENCE OF ALTMODE
	MOVEI	T3,15		;STORE CRLF
	IDPB	T3,T1		;STORE CR
	MOVEI	T3,12		;LF
	JRST	GET2		;STORE THAT AND EXIT
;ROUTINE TO RETURN NEXT ALPHANUMERIC STRING
; IN COMMAND LINE (SIXBIT)
;CALL:	PUSHJ	P, CTEXT
; SIXBIT STRING RETURN LEFT JUSTIFIED IN AC T2

INTERNAL CTEXT,CTEXT1

CTEXT:	PUSHJ	P,SKIPS		;CALL HERE IF AT START OF LINE
	  POPJ	P,		;NOTHING THERE.

CTEXT1:	PUSHJ	P,SKIPS1	;SKIP LEAD SPACES,TABS,NULLS AND CLEAR T2
	  POPJ	P,		;NOTHING THERE.
	SKIPA	W,[POINT 6,T2]
CTEX0:	PUSHJ	P,COMTYS	;ROUTINE IN SCNSER TO PICK UP CHAR.

CTEX1:	PUSHJ	P, CTEX		;IS IT ALPHANUMERIC
	  POPJ P,0		;NO
	TRC	T3,40		;CONVERT TO SIXBIT
	TLNE	W,770000	;SIX CHARS YET?
	IDPB	T3,W		;NO. BUILD WORD
	JRST	CTEX0		;LOOP FOR MORE

;SCAN FOR ALPHANUMERIC CHAR IN T3
CTEX:	CAILE	T3,"Z"+40	;GREATER THAN LC Z?
	POPJ	P,0		;YES. NOT SIXBIT.
	CAIL	T3,"A"+40	;LOWER CASE LETTER?
	TRZ	T3,40		;YES. MAKE UPPER CASE.
	CAIL	T3, "0"
	CAILE	T3, "Z"		;LETTERS ARE LARGER THAN NOS.
	POPJ	P,0		;NEITHER
	CAILE	T3, "9"
	CAIL	T3, "A"
	JRST	CPOPJ1		;LETTER OR NUMBER RETURN
	POPJ	P,0		;NOT-LETTER/NUMBER RETURN

CTXDEV::PUSHJ	P,CTEXT1	;GET A WORD
	CAIN	T3,":"		;AND IF TERM IS A COLON,
	PUSHJ	P,COMTYS	;DISCARD IT
	POPJ	P,0		;RETURN FROM CTXDEV
;SUBROUTINE TO READ A DECIMAL NUMBER
;VALUES	T2=DECIMAL NUMBER

	INTERN	DECIN,OCTIN

DECIN:	PUSHJ	P,SKIPS		;SKIP TO FIRST NON-BLANK CHAR
	  POPJ	P,
	MOVEI	P4,12		;DECIMAL RADIX
	JRST	ANYRIN

;SUBROUTINE TO READ AN OCTAL NUMBER
;VALUES	T2=OCTAL NUMBER

OCTIN:	PUSHJ	P,SKIPS
	  POPJ	P,
	PUSHJ	P,ANYR1
	  POPJ	P,
	  JRST	.+2
	  POPJ	P,
	MOVEI	P4,10

ANYRIN:	PUSHJ	P,SKIPS1
	  POPJ	P,

OCT0:	CAIL	T3,"0"		;SKIP IF NOT A LEGAL DIGIT
	CAIL	T3,"0"(P4)	;SKIP IF LEGAL DIGIT
	JRST	ANYR1
	IMUL	T2,P4		;BUILD NUMBER
	ADDI	T2,-"0"(T3)
	PUSHJ	P,ONCTYI	;READ NEXT CHAR
	JRST	OCT0		;AND LOOP TILL ILLEGAL CHAR

ANYR1:	CAILE	T3,40		;SKIP IF BREAK CHAR
	CAIN	T3,","
	JRST	CPOPJ2
	CAIE	T3,"["
	CAIN	T3,"]"
	JRST	CPOPJ2
	CAIN	T3,"-"
	JRST	CPOPJ2
	JRST	CPOPJ1
;SUBROUTINE TO GET THE NEXT NON-BLANK CHAR
;CALL:	PUSHJ	P,SKIPS
;	NON-SKIP RETURN IF BREAK CHAR
;	SKIP RETURN IF NOT BREAK CHAR

	INTERN	SKIPS,SKIPS1,TPOPJ1,TPOPJ,CPOPJ2,CPOPJ1,CPOPJ,UPOPJ,UPOPJ1,T2POPJ
	INTERN	LPOPJ,JPOPJ,JPOPJ1

SKIPS:	PUSHJ	P,ONCTYI	;GET NEXT CHAR
SKIPS1:	SETZ	T2,
	MOVE	T3,TTCMCH	;GET THIS CHAR
	CAIE	T3,"	"	;SKIP IF A TAB
	CAIN	T3," "		;NO SKIP IF SPACE
	JRST	SKIPS		;SKIP THIS CHAR
	CAIL	T3,40		;SKIP IF A BREAK CHAR
CPOPJ1:	AOS	(P)		;SKIP RETURN IF NOT A BREAK CHAR
CPOPJ:	POPJ	P,
CPOPJ2:	AOS	(P)
	JRST	CPOPJ1

;SUBROUTINE TO GET NEXT CHAR BUT CONVERT ; TO LF
;VALUES	T3=NEXT CHAR

COMTYS:	PUSHJ	P,ONCTYI
	CAIN	T3,";"		;SKIP IF NOT ;
	MOVEI	T3,12
	MOVEM	T3,TTCMCH
	POPJ	P,

;SUBROUTINE TO GET NEXT CHAR FROM TTY LINE BUFFER
;VALUES	T3=ASCII CHAR

ONCTYI:	ILDB	T3,ONCTIP
	MOVEM	T3,TTCMCH	;SAVE CHAR FOR LATER
	POPJ	P,

TPOPJ1:	AOS	-1(P)
TPOPJ:	POP	P,T1
	POPJ	P,

UPOPJ1:	AOS	-1(P)		;GIVE SKIP RETURN
LPOPJ:
UPOPJ:	POP	P,U		;RESTORE U
	POPJ	P,		;RETURN

T2POPJ:	POP	P,T2		;RESTORE T2
	POPJ	P,		;RETURN
JPOPJ1:	AOS	-1(P)
JPOPJ:	POP	P,J
	POPJ	P,
SUBTTL TTY OUTPUT ROUTINES
;SUBROUTINE TO OUTPUT CARRIAGE RETURN LINE FEED

	INTERN	CRLF

CRLF:	MOVEI	T1,[ASCIZ /
/]
	PJRST	CONMES		;OUTPUT CARRIAGE RETURN LINE FEED

;SUBROUTINE TO INITIALIZE OUTPUT BUFFER AND TYPE AN ASCII LINE
;ARGS	T1=ADDR OF ASCII LINE

	INTERN	ICONM

ICONM:	PUSHJ	P,OTSET		;INITIALIZE BUFFER

;SUBROUTINE TO TYPE AN ASCII LINE
;ARGS	T1=ADDR OF ASCII LINE

	INTERN	CONMES

CONMES:	HRLI	T1,(POINT 7,)	;MAKE T1 A BYTE POINTER
CON0:	ILDB	T3,T1		;NEXT CHAR
	JUMPE	T3,CPOPJ	;EXIT AT NULL
	PUSHJ	P,ONCTYO	;TYPE CHAR
	JRST	CON0		;LOOP TILL NULL

;SUBROUTINE TO INITIALIZE OUTPUT BUFFER

	INTERN	OTSET

OTSET:	MOVEI	T3,ONCTSZ	;SIZE OF BUFFER
	MOVEM	T3,ONCCNT	;SO CANT OVERFLOW
	MOVE	T3,LINEP	;BYTE POINTER
	MOVEM	T3,ONCTOP
	POPJ	P,

;SUBROUTINE TO ACTUALLY OUTPUT THE OUTPUT BUFFER

	INTERN	OPOUT

OPOUT:	SKPINL			;CLEAR CONTROL O FLAG
	  JFCL			;DONT CARE ABOUT INPUT
OPOUTX:	MOVEI	T3,0
	IDPB	T3,ONCTOP	;MAKE SURE NULL AT END
	OUTSTR	LINBUF		;OUTPUT BUFFER
	POPJ	P,

;SUBROUTINE TO TYPE SIXBIT STRING IN T2
;ARGS	T2=SIXBIT STRING

	INTERN	PRNAME

PRNAME:	SETZ	T1,
	LSHC	T1,6		;T1=NEXT CHAR
	JUMPE	T1,CPOPJ	;EXIT AT END OF STRING
	MOVEI	T3," "-' '(T1)	;CONVERT TO ASCII
	PUSHJ	P,ONCTYO	;STORE IN BUFFER
	JRST	PRNAME		;LOOP

;SUBROUTINE TO TYPE A DECIMAL NUMBER
;ARGS	T1=NUMBER TO TYPE

	INTERN	RADX10

RADX10:	IDIVI	T1,12
	HRLM	T2,(P)
	JUMPE	T1,.+2
	PUSHJ	P,RADX10
	HLRZ	T1,(P)
	MOVEI	T3,"0"(T1)
	PJRST	ONCTYO

;SUBROUTINE TO TYPE A QUESTION MARK

	INTERN	PRQM

PRQM:	MOVEI	T3,"?"
	PJRST	ONCTYO		;TYPE QUESTION MARK

;SUBROUTINE TO STORE A CHAR IN TTY OUTPUT BUFFER
;ARGS	T3=CHAR

ONCTYO:	SOSLE	ONCCNT		;SKIP IF BUFFER FULL
	IDPB	T3,ONCTOP	;STORE CHAR IN BUFFER
	POPJ	P,

INTERN	COMTYI

COMTYI:	INCHWL	T3
	POPJ	P,
SUBTTL DISK I/O ROUTINES
;SUBROUTINE TO HANDLE USER MODE DISK I/O
;ARGS	F=ADDR OF DDB
;	S=STATUS BITS (IO=0 FOR READ, =1 FOR WRITE)
;VALUES	S=STATUS FROM GETSTS

	INTERN	USRDIO
	EXTERN	UNPSAF,FSFPPN

USRDIO:	SKIPN	FILFLG		;SKIP IF USING SCRATCH FILE
	JRST	USRDI1		;NO, REGULAR WAY
	SKIPG	FILFLG		;SKIP IF FILE OPEN
	PUSHJ	P,OPNFIL	;NO, OPEN IT
	PUSHJ	P,FNDUNI	;FIND 1ST BLOCK FOR THIS UNIT
	  STOPCD .,HALT,NM1,	;NO SUCH UNIT?
	IMULI	T1,BLKPUN	;TIMES BLOCKS=BEGINNING OF THIS UNIT
	MOVE	T2,DEVBLK(F)	;BLOCK ON UNIT
	CAILE	T2,BLKPUN-1	;SKIP IF IN RANGE
	MOVEI	T2,BLKPUN-1	;DONT OVERFLOW TO FOLLOWING UNITS
	ADD	T1,T2		;ADD IN BLOCK ON UNIT, = BLOCK FOR IO
	SETZ	T2,		;CLEAR END OF IOWD LIST
	TLNE	S,IO		;SKIP IF READ, NOT IF WRITE
	JRST	USRDI0		;DO WRITE
	USETI	DSK,1(T1)	;FIRST BLOCK OF FILE IS BLOCK 1, NOT 0
	MOVE	T1,DEVDMP(F)	;GET IOWD
	INPUT	DSK,T1		;READ BLOCK
	JRST	USRDFN		;FINISH UP
USRDI0:	USETO	DSK,1(T1)	;1ST BLOCK OF FILE IS BLOCK 1, NOT 0
	MOVE	T1,DEVDMP(F)	;GET IOWD
	OUTPUT	DSK,T1		;WRITE BLOCK
	JRST	USRDFN		;FINISH UP
USRDI1:	CAME	U,CURUNI	;SKIP IF UNIT OPEN
	PUSHJ	P,OPNUNI	;NO, OPEN UNIT
	  SKIPA	T1,DEVDMP(F)	;GET IOWD
	POPJ	P,		;CANT WRITE UNIT
	SETZ	T2,
	TLNE	S,IO		;SKIP IF READ
	JRST	USRDO		;NO, WRITE
	USETI	DSK,DEVBLK(F)	;SET TO READ THE BLOCK
	INPUT	DSK,T1		;AND READ IT
	JRST	USRDFN		;FINISH UP

USRDO:	MOVSI	T2,UNPSAF
	TDZN	T2,UNIDES(U)	;SKIP IF MAY WRITE THIS UNIT
	JRST	USRDOE		;NO, ERROR
	USETO	DSK,DEVBLK(F)	;SET TO WRITE THE BLOCK
	OUTPUT	DSK,T1		;OUTPUT IT
USRDFN:	GETSTS	DSK,T1		;GET STATUS
	HRR	S,T1		;SAVE IN S
	TRZE	T1,740000	;CLEAR ERROR BITS AND SKIP IF NO ERRORS
	SETSTS	DSK,(T1)	;CLEAR ERRORS IN STATUS FOR FUTURE I/O
USRDX:	JRST	CPOPJ1		;ALWAYS SKIP OVER UNWANTED ROUTINES IN FILIO

USRDOE:	TRO	S,740000
	JRST	USRDX

OPNUNI:	PUSHJ	P,SAVE3
	MOVEI	P1,17
	MOVE	P2,UNINAM(U)
	SETZ	P3,
	OPEN	DSK,P1
	  JRST	OPNUNN		;CANT DO I/O IF CANT OPEN
	MOVEM	U,CURUNI	;REMEMBER OPEN UNIT
	POPJ	P,

OPNUNN:	SETZM	CURUNI		;DONT REMEMBER UNIT NAME
	JRST	CPOPJ1		;AND NOTE CANT WRITE
;SUBROUTINE TO OPEN SCRATCH FILE

OPNFIL:	INIT	DSK,17		;START BY OPENING DSK
	SIXBIT	.DSK.
	0
	  STOPCD .,HALT,NM2,
	MOVE	T1,[SIXBIT .TWICE.] ;FILE NAME
	MOVEM	T1,TWCFIL	;STORE FILE NAME
	MOVSI	T1,'BIN'	;EXT
	MOVEM	T1,TWCFIL+1	;STORE EXT
	SETZM	TWCFIL+2	;CLEAR ATTRIBUTES
	MOVEI	T1,RETRYN	;NUMBER OF TIMES TO RETRY FOR FBM
	MOVEM	T1,RETRYC	;SET RETRY COUNTER
OPNFL1:	SETZM	TWCFIL+3	;CLEAR DIRECTORY
	LOOKUP	DSK,TWCFIL	;SEE IF FILE ALREADY EXISTS
	  JRST	OPNFL2		;NO, MUST CREATE IT
	SETZM	TWCFIL+3	;CLEAR DIRECTORY AGAIN
	ENTER	DSK,TWCFIL	;SET FOR UPDATE
	  JRST	OPNFL3		;CANT UPDATE?
	PUSH	P,U		;SAVE U
	SETZ	U,		;LOOK FOR END OF LIST
	PUSHJ	P,FNDUNI	;TO GET NUMBER OF UNITS IN OUR "SYS"
;*** NORMALLY WOULD BE A SKIP RETURN POSSIBLE, BUT CAN NEVER FIND UNIT 
;0 BECAUSE 0 IS END OF  LIST
	IMULI	T1,BLKPUN	;TIMES BLOCKS FOR EACH UNIT
	USETO	DSK,1(T1)	;ALLOCATE THAT MANY BLOCKS AND CLEAR
	HRRZS	FILFLG		;NOTE FILE READY TO WRITE
	JRST	UPOPJ		;RESTORE U AND RETURN

OPNFL2:	HRRZ	T1,TWCFIL+1	;GET ERROR CODE
	JUMPN	T1,		;CANT GO ON
	SETZM	TWCFIL+3	;CLEAR DIRECTORY
	ENTER	DSK,TWCFIL	;TRY TO CREATE FILE
	  JRST	OPNFL3		;CANT
	CLOSE	DSK,		;FILE NOW EXISTS
	JRST	OPNFL1		;TRY TO UPDATE AGAIN
OPNFL3:	HRRZ	T1,TWCFIL+1	;GET ERROR CODE
	CAIE	T1,14		;SKIP IF NO ROOM
	CAIN	T1,3		;SKIP IF NOT FILE BEING MODIFIED
	SOSG	T1,RETRYC	;DECREMENT RETRY COUNTER
	STOPCD	.,HALT,NM3,	;DONT RETRY OR TOO MANY RETRIES
	CAIN	T1,RETRYN-^D10	;SKIP UNLESS 10 SECONDS LATER
	OUTSTR	[ASCIZ .% WAIT PLEASE.]
	MOVEI	T1,1		;1 SECOND FOR SLEEP
	SLEEP	T1,		;WAIT A WHILE
	JRST	OPNFL1		;TRY AGAIN

;SUBROUTINE TO FIND POSITION OF UNIT IN LIST OF UNITS
;ARGS	U=ADDR OF UNIT DATA BLOCK
;VALUES	T1=POSITION OF UNIT IN LIST OF UNITS (0=1ST, ETC)
;NONSKIP IF UNIT NOT FOUND, T1=NUMBER OF UNITS
;SKIP	IF UNIT FOUND, T1 SET UP

FNDUNI:	SETZ	T1,		;CLEAR T1 IN CASE NO UNITS
	HLRZ	T2,SYSUNI##	;ADDR OF 1ST UNIT IN SYS
FNDUN1:	JUMPE	T2,CPOPJ	;JUMP IF THAT WAS LAST UNIT
	CAMN	T2,U		;SKIP IF NOT DESIRED UNIT
	JRST	CPOPJ1		;FOUND UNIT, GOOD RETURN
	HLRZ	T2,UNISYS(T2)	;MOVE TO NEXT UNIT IN SYS
	AOJA	T1,FNDUN1	;COUNT UNITS
STRTAD=200000

;SUBROUTINE TO FIND N CONSECUTIVE 0'S IN A TABLE
;ENTER WITH P1 = AOBJN WORD TO THE TABLE
;P2 = PREVIOUS BEST SO FAR
;RH(P3)= HOW MANY,  BIT STRTAD =1 IF START LOC SPECIFIED
;EXIT CPOPJ1 IF FOUND, WITH P4 = WHERE THE HOLE IS
;EXIT CPOPJ IF UNSUCCESSFUL, P2 = LARGEST HOLE FOUND
;P1,P2,P4 CHANGED

	INTERN	GETZ,GETZR,SETOS

GETZ:	TLNE	P3,STRTAD	;START LOC SPECIFIED?  (NOTE THAT ENTRY TO ROUTINE
				; IS AT GETZR IF START LOC SPECIFIED)
	POPJ	P,		;YES, ERROR RETURN
	MOVEI	T4,^D36		;NO. SET UP COUNT
	SETCM	T1,(P1)		;WORD TO INVESTIGATE
	JUMPE	T1,GETZ4	;FULL IF 0
	JUMPG	T1,GETZ3	;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1:	SETCA	T1,		;SET TO REAL CONTENTS
	JFFO	T1,.+2		;COUNT THE NUMBER OF 0'S
	MOVEI	T2,^D36		;36 OF THEM
GETZR:	MOVE	T3,T2		;SHIFT COUNT (T3 CAN BE >36 AT GETZ2)
	MOVEM	P1,P4		;SAVE POSITION IN P4
	HRLM	T4,P4		;LOC OF HOLE
GETZ2:	CAIL	T3,(P3)		;FOUND ENOUGH?
	JRST	CPOPJ1		;YES. GOOD RETURN
	CAILE	T3,(P2)		;NO. BEST SO FAR?
	HRRI	P2,(T3)		;YES. SAVE IT
	SUBI	T4,(T2)		;DECREASE POSITION COUNTER
	JUMPLE	T4,GETZ5	;0'S ON END
	TLNE	P3,STRTAD	;THIS HOLE NOT GOOD ENOUGH
	POPJ	P,		;ERROR RETURN IF START ADDRESS GIVEN
	SETCA	T1,		;NOW WE WANT TO COUNT 1'S
	LSH	T1,1(T2)	;REMOVE BITS WE ALREADY LOOKED AT
GETZ3:	JFFO	T1,.+1		;NUMBER OF (REAL) 1'S
	LSH	T1,(T2)		;GET RID OF THEM
	CAIN	T4,^D36		;1ST POSITION IN WORD?
	ADDI	T4,1		;YES, SUBTRACT REAL JFFO COUNT
	SUBI	T4,1(T2)	;DECREASE POSITION COUNT
	JUMPG	T4,GETZ1	;TRY NEXT 0 - HOLE
GETZ4:	AOBJN	P1,GETZ		;1'S ON END - START FRESH AT NEXT WORD

;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT THE WORD HAD 0'S ON THE END
GETZ5:	AOBJP	P1,CPOPJ	;THROUGH IF END OF SAT
	SKIPGE	T1,(P1)		;NEXT WORD POSITIVE?
	JRST	GETZ		;NO. THIS HOLE NOT GOOD ENOUGH
	JFFO	T1,.+2		;YES. COUNT THE 0'S
	MOVEI	T2,^D36		;36 0'S
	ADDI	T3,(T2)		;ADD TO PREVIOUS ZERO-COUNT
	MOVEI	T4,^D36		;RESET T4
	JRST	GETZ2		;AND TEST THIS HOLE
;SUBROUTINE TO MARK BITS AS TAKEN IN TABLE
;USES ACS AS RETURNED FROM GETZ
;CHANGES P4, RESPECTS T1

	INTERN	SETOS

SETOS:	MOVEI	T3,(P3)		;NUMBER OF CLUSTERS TO MARK
	MOVEI	T2,1		;SET A BIT
	HLRZ	T4,P4		;LOC OF FIRST BIT TO MARK
	LSH	T2,-1(T4)	;POSITION IT
SETO1:	TDNE	T2,(P4)		;BIT ALREADY =1?
	JRST	SETO2		;YES. CLEAR 0NE-BITS AND NON-SKIP RETURN
	ORM	T2,(P4)		;MARK A BIT 
	ROT	T2,-1		;STEP TO NEXT BIT
	SKIPG	T2		;NEXT WORD?
	AOS	P4		;YES
	SOJG	T3,SETO1	;GO MARK NEXT
	JRST	CPOPJ1		;AND RETURN


;HERE IF ONE OF THE BITS WE ARE TRYING TO SET IS ALREADY A 1
;THIS CAN HAPPEN BY INTERRUPTING OUT OF GET4WD, AND TAKING BLOCKS
;FOR AN EXTENDED PUSH DOWN LIST
SETO2:	SUBI	T3,(P3)		;T3=-# OF BITS ALREADY SET
SETO3:	JUMPGE	T3,CPOPJ	;RETURN IF ALL SET BITS CLEARED
	SKIPG	T2		;BIT IN PREVIOUS WORD?
	SOS	P4		;YES
	ROT	T2,1		;STEP TO PREVIOUS BIT
	ANDCAM	T2,(P4)		;CLEAR IT
	AOJA	T3,SETO3	;AND TEST NEXT BIT
;SUBROUTINE TO SET ZEROS IN A TABLE
;ARG	T1=HOW MANY BITS TO CLEAR
;	T2=AOBJN POINTER FOR TABLE
;	T3=POSITION IN WORD OF FIRST BIT TO CLEAR
;	(0=BIT 0, 1=BIT 1, ETC.)

INTERN	SETZRS
SETZRS:	MOVSI	T4,400000	;SET A BIT
	MOVNS	T3
	LSH	T4,(T3)		;POSITION TO 1ST BIT TO RETURN
GIVCR2:	ANDCAM	T4,(T2)		;CLEAR A BIT
	SOJLE	T1,CPOPJ	;THROUGH IF T1=0
	ROT	T4,-1		;POSITION TO NEXT BIT
	JUMPG	T4,GIVCR2	;GO CLEAR IT IF IN SAME WORD
	AOBJN	T2,GIVCR2	;STEP TO NEXT WORD
	STOPCD	CPOPJ,HALT,SZR,	;PAST TOP OF TABLE - ERROR

INTERN	DIE

DIE:	PUSHJ	P,OTSET		;INITIALIZE BUFFERS AND POINTERS
	MOVEI	T1,[ASCIZ .?STOPCD .]
	PUSHJ	P,CONMES
	HRLZ	T2,@(P)
	PUSHJ	P,PRNAME
	PUSHJ	P,CRLF
	PUSHJ	P,OPOUT
	EXIT

INTERN	ILLINP

ILLINP:	STOPCD	.,HALT,INP
;SUBROUTINES TO SAVE AND RESTORE PRESERVED ACS
;SAVEN IS CALLED AT THE BEGINNING OF A SUBROUTINE
;FOR CONVENIENCE NO MATCHING SUB IS NEEDED TO BE CALLED
;TO RESTORE THIS ACS.
;INSTEAD AN EXTRA RETURN IS PUT ON STACK
;5 CHAR NAME INDICATES IT VIOLATES
;SUBROUTINE CALLING CONVENTIONS
;CALL:	PUSHJ	P,SAVEN
;	RETURN	HERE IMMEDIATELY WITH EXTRA RETURN ON STACK
;	RESPECTS ALL ACS

;NOTE:	THIS CODE USES 1 LOC BEYOND END OF STACK BUT THEN PUSHES ON TOP OF IT
;SO GET OVERFLOW INTERUPT IF TOO FULL.  OK TO DO 1(P) SINCE THIS WORD WRITTEN ON OVERFLOW
INTERN	SAVE1,SAVE2,SAVE3,SAVE4

SAVE1:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,(P)		;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	JRST	RES1
	AOS	-1(P)
	JRST	RES1

SAVE2:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,-1(P)	;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	JRST	RES2
	AOS	-2(P)
	JRST	RES2

SAVE3:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2
	PUSH	P,P3
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,-2(P)	;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	JRST	RES3
	AOS	-3(P)
	JRST	RES3

SAVE4:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,-3(P)	;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	JRST	RES4
	AOS	-4(P)
RES4:	POP	P,P4
RES3:	POP	P,P3
RES2:	POP	P,P2
RES1:	POP	P,P1
	POPJ	P,
SAVT::	EXCH	T4,(P)
	PUSH	P,T3
	PUSH	P,T2
	PUSHJ	P,(T4)
	  SKIPA
	AOS	-3(P)
	POP	P,T2
	POP	P,T3
	POP	P,T4
	POPJ	P,
SUBTTL DISK OFF LINE INTERCEPTION

;WHEN A FILE STRUCTURE IS REMOVED VIA STRUUO, AND THE OPERATOR
; REMOVES THE PACK(S), THE RP10 HARDWARE DOES NOT INTERRUPT
; AS THE UNIT GOES OFF LINE, NOR IS THERE ANY WAY TO PASSIVELY CHECK
; TO SEE IF THE UNIT IS OFF LINE.  THEREFORE, TWICE MUST INTERCEPT
; THE DISK OFF LINE MESSAGE.

DOLBLK:	XWD	4,DOLINT	;INTERRUPT TO DOLINT
	EXP	1B0+1B33	;INHIBIT MESSAGE, TRAP ON DISK OFF LINE
DOLPC:	0			;STARTS OUT ZERO
	0			;EXTRA STUFF
DOLINT:	MOVEM	T1,DOLSAV	;SAVE T1
	SETZ	T1,		;CLEAR DOLPC SO WE CAN INTERRUPT AGAIN
	EXCH	T1,DOLPC	;
	EXCH	T1,DOLSAV	;GET PC INTO DOLSAV, RESTORE T1
	OUTSTR	[ASCIZ/% UNEXPECTED DISK OFF LINE CONDITION
/]
	JRST	@DOLSAV		;RETURN


DOLSAV:	BLOCK	1

;ROUTINES TO SAVE AND RESTORE SETKON ROUTINE SO THAT TWICE CAN CONTROL
; WHEN UNIT STATUS' ARE CLEARED.
; CALL ONCE BEFORE ENTERING ACTUAL ONCE CODE, AND BEFORE EXITING.

SAVKON:	PUSHJ	P,SETKON##	;CALL SAVKON NOW TO CLEAR OUT STATUS'
	MOVE	T1,CPOPJ	;GET A POPJ
	EXCH	T1,SETKON##+1	;GET INSTRUCTION TO BE REPLACED, MAKE IT POPJ
	MOVEM	T1,KONSAV	;SAVE THE INSTRUCTION
	POPJ	P,		;RETURN

RESKON:	MOVE	T1,KONSAV	;GET OLD INSTRUCTION
	MOVEM	T1,SETKON##+1	;RESTORE OLD INSTRUCTION
	POPJ	P,		;RETURN

KONSAV:	BLOCK	1		;PLACE TO SAVE INSTRUCTION
SUBTTL ROUTINES TO SATISFY KONTROLLER REQUESTS IN ONCMOD
	INTERN	FHXUPA,DPXUPA,DPXSTS,USRCPY
	INTERN	FHXRCL,DPXRCL,FHXSTP,DPXSTP,FHXRED,DPXRED,FHXWRT,DPXWRT
	INTERN	DPXINT,FHXINT,FHXWTS,DPXWTS,FHXRDS,DPXRDS,FHXINT,DPXINT
	INTERN	FHXLTM,DPXLTM,FH0SAV,FH1SAV,DP0SAV,DP1SAV,DP2SAV
	INTERN	DPXPOS,FHXPOS,DPXKON,FHXKON
	INTERN FSXUPA,FSXRCL,FSXSTP,FSXRED,FSXWRT,FSXINT,FSXWTS
	INTERN FSXKON,FSXRDS,FSXWTF,FSXLTM,FS0SAV,FS1SAV,FSXPOS

USRCPY:	MOVE	T1,UNINAM(U)	;NAME OF UNIT
	MOVEM	T1,CHRBUF	;STORE FOR DSKCHR
	MOVE	T1,[XWD .UNBPU+1,CHRBUF]
	DSKCHR	T1,		;FIND OUT ABOUT UNIT
	  JRST	USRCP1		;NO SUCH UNIT
	HRRZ	T2,CHRBUF+.UNCHR	;BLOCKS PER CYLINDER
	LDB	T3,[POINT 9,CHRBUF+.UNCHR,17]
	LDB	T4,[POINT 3,T1,32]	;UNIT TYPE
	TLNE	T1,(.UPOFL)	;SKIP UNLESS UNIT OFF LINE
	TLOA	T4,KOPUHE##	;FLAG THAT ONCMOD EXPECTS
	AOS	(P)		;ON LINE, SKIP RETURN
	MOVE	T1,CHRBUF+.UNBPU	;CAPACITY OF UNIT
	POPJ	P,
USRCP1:	MOVSI	T4,KOPUHE##	;SET FLAG FOR ONCMOD
	TLO	T4,KOPNSU##	;NOTE ALSO NO SUCH UNIT
	POPJ	P,		;RETURN

RPXUPA::
FSXUPA:
FHXUPA:
DPXUPA:	MOVEI	T1,1		;RETURN WRITE HEADER LOCKOUT SWITCH OFF
	JRST	CPOPJ1		;ALWAYS RETURN KONTROLLER ON LINE

UVACKS::SKIPA	T2,T1
DODTI4::
DPXSTS:	MOVEI	T2,0
	POPJ	P,
DEFINE	CHNCB(N),<
	INTERN	CHN'N'CB
CHN'N'CB==0
>
CHNCB	(\M.CHN)

FHXRCL:
DPXRCL:
FSXRCL:
FHXSTP:
DPXSTP:
FSXSTP:
FHXRED:
DPXRED:
FSXRED:
FHXWRT:
DPXWRT:
FSXWRT:
FHXINT:
DPXINT:
FSXINT:
FHXWTS:
DPXWTS:
FSXWTS:
FHXRDS:
DPXRDS:
FSXRDS:
FHXKON:
DPXKON:
FSXKON:
FHXLTM:
DPXLTM:
FSXLTM:
FH0SAV:FH1SAV:
DP0SAV:DP1SAV:DP2SAV:
FS0SAV:FS1SAV:
FSXWTF:
FHXPOS:
DPXPOS:
FSXPOS:
RPXPOS::DPXRDF::DPXRDC::RPXSTP::DPXERR::FSXWTC::FHXERR::RPXECC::FSXUNL::
FSXECC::FHXECC::RPXERR::FSXERR::RPXKON::FSXRDF::FSXRDC::
FHXUNL::DPXWTC::RPXRED::RPXRDF::RPXRDC::RPXRDS::RPXRCL::FHXRDF::FHXRDC::
RPXLTM::RPXWTF::RPXWTC::RPXWTS::RPXINT::DPXECC::RPXWRT::DPXUNL::rp0sav::RP1SAV::
RP2SAV::FHXWTC::RPXUNL::
SUBTTL ROUTINES TO SATISFY UNNEEDED GLOBAL REQUESTS

	INTERN	REFLOG,CDVSBT,PDVCNT,HNGSTP,TTYSTR,TTYFUW,TTYFND,PJOBN,SYSSIZ
	INTERN	PROT,PROT0,GETWD1,GETWDU,HIGHJB,GETJOB,INLMES,COMCHK,LOCOCW,UADCK1
	INTERN	USRJDA,USRHCU,MQWAIT,MQREQ,MQAVAL,CBAVAL,DAAVAL,CBREQ,DAWAIT
	INTERN	UUOERR,WSYNC,DEVLST,STOTAC,STOIOS,AUREQ,CBWAIT,AUWAIT,AUAVAL,CVTSBT,OPRLDB
	INTERN	JBTPPN,JBTADR,JBTNAM,JBTLOC,JBTSTS,JBTSPL,STDIOD,SWPINT,OUT,PUUOAC
	INTERN	REGSIZ,SETACT,CLRACT,CLOSE1,CLOCK,FREPTR,GET4WD,GIV4WD,GETWDS,GIVWDS
	INTERN	DEVLG,ADVBFE,IOIERR,JOB,SAVDDL,ADRERR,ADVBFF,SERIAL,WAIT1,USCHED
	INTERN	STOP1,REMSEG,DSKINI,IADRCK,DVCNSG,RTM1,RTZER,SYSINI,IPOPJ,IPOPJ1
	INTERN	DPDONE,FHALCL,JBTPRV,SYSINA,STOTC1,GTWST2,PUTWDU,PUTWD1
	INTERN	TICMIN,TICSEC,LGLPRC,DPXWTF,FHXWTF,ILLOUT
	INTERN	CHNMPE,CHNDPE,DAEERR,SVEUB,MAPIO,SETINT,RTNIOW,DAFREE,DAUSER,NU0DAC,SVEUF
	INTERN	CLRBTS,AUFREE,CBFREE,AUUSER,GIVRES,WRDCNT,CBUSER,CHNNXM,HOLD0,WSCHED
	INTERN MP3,MPDPRA,MTXCHB,CNIMTS,CNIMTC,CNFMTA,MTXCDB,FLG256
	INTERN .C0JOB,SETDVL,PUTWRD,UADRCK,TSETBI,ILLINS,CNOCLR

;MACRO TO SATISFY GLOBAL REQUESTS FOR ERROR RETURN LABELS

	DEFINE ERCALC(A),<ECOD'A::>

;GENERATE THE LABELS
	.N==0
	REPEAT ECDMAX,<
	ERCALC(\.N)
	.N==.N+1
>
;GENERATE SKPCPU MACRO LABELS
	DEFINE	SKPXXX(A),<
	IRP A,<$SCP'A::>
>
;GENERATE THE LABELS
	SKPXXX(<A,I,L,AI,AL,IA,IL,LI,LA>)
.PDJSE::.PDJSL::COMERA::CPUJOB::CTLJBD::DAEEIM::FNDQSR::GETWRD::MEMSIZ::
QSRSPL::SETLGL::SLEEP::TTYFNU::TTYTAB::%SIQSR::
DODELE::FNDPDB::GCH4WD::JBTST2::T2POJ1::VIRTAL::
TDVKDB::TDVUDB::TKBCDB::TTMCIC::TTMCIS::TTMCOC::TTXCIS::TTXCOS::
MCUALT::MCUATP::TYPTAB::TUYKTP::
RPXCPY::DPXCPY::FSXCPY::FHXCPY::
GTWST2:PUTWDU:PUTWD1:DPDONE:FHALCL:JBTPRV:IPOPJ:IPOPJ1:PUUOAC:IADRCK:
STOTC1:DVCNSG:RTM1:RTZER:SYSINI:DSKINI:REMSEG:STOP1:WAIT1:SERIAL:JOB:
SAVDDL:DEVLG:IOIERR:ADVBFE:SYSSIZ:SETACT:CLRACT:CLOSE1:CLOCK:REGSIZ:STDIOD:
SWPINT:OUT:JBTPPN:JBTADR:JBTNAM:JBTLOC:JBTSTS:JBTSPL:USRJDA:USRHCU:UUOERR:
WSYNC:DEVLST:STOTAC:STOIOS:ADRERR:ADVBFF:USCHED:CVTSBT:OPRLDB:MQREQ:
MQAVAL:CBAVAL:CBREQ:PJOBN:FREPTR:GET4WD:GIV4WD:GETWDS:GIVWDS:UADCK1:
LOCOCW:DAAVAL:AUAVAL:AUREQ:COMCHK:INLMES:GETJOB:HIGHJB:GETWDU:
GETWD1:PROT:PROT0:REFLOG:CDVSBT:PDVCNT:HNGSTP:TTYSTR:TTYFUW:
LGLPRC:DPXWTF:FHXWTF:ILLOUT:CHNNXM:
DAUSER:NU0DAC:SVEUF:CLRBTS:CHNMPE:CHNDPE:DAEERR:SVEUB:MAPIO:SETINT:RTNIOW:
AUUSER:GIVRES:WRDCNT:CBUSER:HOLD0:WSCHED:
MP3:MPDPRA:
MTXCHB:CNIMTS:CNIMTC:CNFMTA:MTXCDB:FLG256:.C0JOB:SETDVL:PUTWRD:
UADRCK:TSETBI:ILLINS:CNOCLR:RTM2::
TTYFND:	STOPCD	.,HALT,NM4,

	INTERN	REFLAG,DDSTAR,DAREQ,LOCORE,THSDAT,TIME,ONCEND,RSPWT1,SYSDSP
	INTERN	DEBUGF,FINISH,SKPCPI,DATE,.C0AEF,MQFREE,T4POPJ

DAFREE:AUFREE:CBFREE:MQFREE:MQWAIT:CBWAIT:DAWAIT:AUWAIT:
PRVJ::
RSPWT1:	POPJ	P,
T4POPJ:	POP	P,T4
	POPJ	P,
REFLAG:	BLOCK	1
DDSTAR:	BLOCK	1
DAREQ:	BLOCK	1
LOCORE:	BLOCK	1
ONCEND:	BLOCK	1
SYSINA:SYSDSP:	SYSINI
THSDAT:	BLOCK	1
TIME:	BLOCK	1
TICMIN:	EXP	^D60*^D60
TICSEC:	EXP	^D60
DEBUGF:	BLOCK	1
FINISH:	BLOCK	1
SKPCPI:	JFCL
DATE:	BLOCK	1
.C0AEF:	BLOCK	1
FILFLG:	BLOCK	1	;SCRATCH FILE FLAG
TWCFIL:	BLOCK	4	;LOOKUP/ENTER BLOCK FOR SCRATCH FILE
RETRYC:	BLOCK	1	;RETRY COUNTER FOR CREATING SCRATCH FILE

	INTERN	JOBMAX,K2PLSH
	INTERN SKPCPA,MSK22B

IFN M.KA10,<K2PLSH==0
		PAGSIZ==:2000>
IFN M.KI10!M.KL10,<K2PLSH==1
			PAGSIZ==:1000>
JOBMAX=M.JOB
SKPCPA==0
MSK22B==0
SUBTTL DATA AND STORAGE
LINEP:	POINT 7,LINBUF

CHRBUF:	BLOCK	.UNMAX
CURUNI:	BLOCK	1
LINBUF:	BLOCK	LINSIZ
ONCTSZ==LINSIZ*5-1

ONCTIP:	BLOCK	1
ONCTOP:	BLOCK	1
ONCCNT:	BLOCK	1
TTCMCH:	BLOCK	1
OURPPN:	BLOCK	1

	INTERN	ONCPDL
ONCPDL:

PDLIST:	BLOCK	PDLEN
	INTERN	PATCH
PATCH:	BLOCK	100

	END	TWICE