TITLE	NULL - COVER MODULE

COMMENT\

THIS MODULE REPRESENTS WORK DONE IN THE PUBLIC DOMAIN. THEREFORE, THIS
MODULE IS NOT COPYRIGHTED BY DIGITAL EQUIPMENT CORP.

\

PRGEND
TITLE	DTADIR - DECTAPE DIRECTORY PRINTER
SUBTTL	RIC WERME JAN. 1975

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

TWOSEG
RELOC	400000
VERSION	(1,,1,,%DTADIR)
ENTRY	DTADRS,DTADRL
DIRSIZ==200			;SIZE OF DTA DIRECTORY BLOCK
DIRADR==^D100			;ADDRESS OF DIRECTORY BLOCK
MAXFIL==^D22			;MAX # OF FILES THAT WILL FIT ON A TAPE
TAPLEN==^D578			;# OF BLOCKS ON A DECTAPE
DIRBYT==0			;RELATIVE ADDR OF DIRECTORY BYTE MAP (5 BIT BYTES)
DIRFIL==^D83			;RELATIVE ADDR OF FIRST FILENAME
DIREXT==^D105			;RELATIVE ADDR OF EXTENSION/DATE WORD
DIRLBL==^D127			;RELATIVE ADDR OF LABEL WORD

;SUBROUTINE TO PRINT A DECTAPE DIRECTORY POINTED AT BY T1 ON
;THE CURRENT OUTPUT CHANNEL. USES T1-T4
;WARNING: ZERDIR AND DIRXIT MAY BE REACHED WITHOUT SAVE1 BEING CALLED!!

DTADRS::HRLI	T1,-MAXFIL	;MAKE AN AOBJN POINTER (MUCH MORE USEFUL)
	SETZ	T2,		;USE T2 TO 'COUNT' FILES WE SEE
FSTLOP:	SKIPE	T3,DIRFIL(T1)	;THIS IS SO EASY MIGHT AS WELL DO IT IN A SEPARATE LOOP
	DISIX	[[SIXBIT\%.%#!\];CRAM FILE AND EXTENSION
		 WSIX	6,DIRFIL(T1);ON EACH LINE
		 WSIX	3,DIREXT(T1)]
	IOR	T2,T3		;OR IT IN...NON 0 WILL SAY WE FOUND SOME
	AOBJN	T1,FSTLOP	;GET ANOTHER
	JUMPE	T2,ZERDIR	;SAY IF DIRECTORY EMPTY
	JRST	DIRXIT		;A COUPLE OF CRLFS AND RETURN

;HERE TO PRINT ALL THE USEFUL DIRECTORY INFORMATION FOR THE LONG FORMAT
DTADRL::PUSHJ	P,SAVE1##	;NEED A PERMANENT AC FOR DIRECTORY ADDR
	HRLI	T1,-MAXFIL	;MAKE T1 BE AOBJN POINTER
	MOVE	P1,T1		;KEEP A COPY OF THE AOBJN WORD FOR LATER USE

;COUNT ALL THE FREE FILES (SHOWN BY A ZERO FILE NAME)
	SETZ	T2,		;CLEAR FILE COUNTER
FILLOP:	SKIPN	DIRFIL(T1)	;FREE FILES HAVE A ZERO NAME
	MOVEI	T2,1(T2)	;WHICH THIS ONE DOES
	AOBJN	T1,FILLOP	;LOOK AT REST
	MOVEM	T2,FREFIL	;SAVE FOR LATER USE.

;FIGURE OUT HOW MANY BLOCKS EACH FILE HAS ALLOCATED
	SETZM	FILSIZ		;CLEAR OUT COUNT LIST OF FILE SIZES
	MOVE	T1,[FILSIZ,,FILSIZ+1]
	BLT	T1,FILSIZ+MAXFIL-1;USING TRIED, TRUE AND SLOW BLT
	MOVEI	T1,TAPLEN-1	;# OF BLOCKS TO SCAN (0 ISN'T IN BYTE MAP)
	MOVX	T2,<POINT 5,DIRBYT(P1)>;POINT TO BEFORE FIRST BYTE IN MAP
SIZLOP:	ILDB	T3,T2		;GET OWNER OF THIS BLOCK
	AOS	FILSIZ(T3)	;COUNT IT (N.B. - FREE BLOCKS ARE IN FILSIZ)
	SOJG	T1,SIZLOP	;GO FOR NEXT
;COLLECTED ALL THE DATA WE NEED, PRINT THE HEADER NOW
	DISIX	[[SIXBIT\D&IRECTORY %#&F&REE: % BLOCKS, % FILES#!\]
		 PUSHJ	P,DATTIM##;PRINT DIRECTORY HEADER. FIRST DATE AND TIME
		 WDEC	FILSIZ	;THEN THE FREE BLOCKS
		 WDEC	FREFIL]	;AND THE FREE FILES
	SKIPE	T1,DIRLBL(P1)	;DOES THIS TAPE HAVE A LABEL?
	DISIX	[[SIXBIT\T&APE &ID: %#!\]
		 WNAME	T1]
	W2CHI	CRLF		;SEPARATE HEADER FROM DATA

	MOVE	T1,FREFIL	;CHECK TO SEE IF ANY REASON TO PRINT
	CAIN	T1,MAXFIL	;  DIRECTORY. SAY EMPTY IF NO FILES WRITTEN
ZERDIR:	DISIX	[CPOPJ##,,[SIXBIT\D&IRECTORY EMPTY###!\]]
	MOVEI	T4,1		;MAKE INDEX INTO FILSIZ FOR BLOCKS USED
				;NO NEED TO SAVE P1 NOW, USE IT AS AOBJN WORD

;NOW PRINT OUT INFO FOR EACH FILE
DIRLOP:	SKIPN	DIRFIL(P1)	;DOES THIS FILE EXIST?
	JRST	DIRAOB		;NO, TRY NEXT
	LDB	T1,[POINT 12,DIREXT(P1),35];GET LOW 12 BITS OF CREATION DATE
	MOVEI	T2,1		;CHECK THE BYTE MAP FOR THE TOP 3 BITS
	TDNE	T2,DIRBYT(P1)
	IORI	T1,1B23		;BRING UPTO 1985
	TDNE	T2,DIRBYT+MAXFIL(P1)
	IORI	T1,1B22		;UPTO 2007
	TDNE	T2,DIRBYT+<2*MAXFIL>(P1)
	IORI	T1,1B21		;UPTO 2051 (FOR THE PDP-10 IN THE SMITHSONIAN)
	DISIX	[[SIXBIT\%.% %  %#!\]
		 WSIX	6,DIRFIL(P1);FILE
		 WSIX	3,DIREXT(P1);AND EXTENSION
		 WDEC	3,FILSIZ(T4);THEN LENGTH
		 PUSHJ	P,DATTHN##]   ;AND CREATION DATE
DIRAOB:	MOVEI	T4,1(T4)	;POINT TO NEXT FILE NUMBER
	AOBJN	P1,DIRLOP	;AND LOOP FOR NEXT FILE
DIRXIT:	WSIX	[SIXBIT\##!\]	;ADD A LITTLE SPACE
	POPJ	P,		;OR RETURN WHEN DONE

	RELOC	0
FREFIL:	BLOCK	1		;WHERE WE PUT # OF FREE FILES
FILSIZ:	BLOCK	40		;NEED 40 ENTRIES FOR ANY BYTE SIZE

	RELOC
	PRGEND
TITLE	FILSPC - SIMPLE FILENAME PARSER

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

TWOSEG
RELOC	400000
VERSION(1,A,2,,%FILSPC)

XP(FB,11)			;REGISTER THAT CONTAINS ADDRESS OF FILEBLOCK TO FILL
ENTRY	SIXLXC,SIXLXR,FILLXC,FILLXR

SIXLXC::LCH	T1		;BACKUP TO COMPENSATE FOR LEXINT
	JRST	SIXLXR

FILLXC::LCH	FB
FILLXR::SKIPA	FB,T1		;GET FILE BLOCK ADDRESS
SIXLXR::SKIPA	T1,[SIXSCN,,FILSPC]
	MOVEI	T1,FILSPC
	PJRST	LEXINT##

;PRODUCTIONS TO PARSE THE CLASSIC FILE SPECIFIER (DEV:FILE.EXT[P,PN]
;IN ITS BIGGEST FORM)
;CALL WITH REGISTER FB POINTING TO THE LOSEG FILE BLOCK TO FILL.
	TBLBEG(FILSPC)

	PROD(	<SG>		,FILI, ,      )	;INIT FILE PARSER FLAGS
NXTATM:	PROD(	<SG>		,CALL, ,SIXSCN)	;GET A NAME
	PROD(	":"		,DEV ,*,NXTATM)	;COLON MEANS A DEVICE
	PROD(	"."		,NAME,*,NXTATM)	;AND PERIOD MEANS NAME
	PROD(	"["		,NAMX, ,PPNSCN)	;THEN BRACKET MEANS NAME OR EXT
	PROD(	<SG>		,NAMX, ,      )	;ANYTHING ELSE IS SAME
PPNDON:	PROD(	<SG>		,RET , ,      )	;QUIT WHILE AHEAD

PPNSCN:	PROD(	<SG>		,GPRJ, ,      )	;GET PROJECT NUMBER
	PROD(	<SG>		,PROJ, ,      )	;SAVE PROJECT. PROJ WILL FAKE CALL
	PROD(	"]"		,    ,*,      )	;OPTIONAL CLOSE BRACKET
	PROD(	<SG>		,PROG, ,PPNDON)	;MERGE WITH PROJECT

SIXSCN:	PROD(	<BLANK>		,    ,*,.     )	;SKIP BLANKS
	PROD(	<SG>		,SIXI, ,      )	;SETUP SIXBIT PACKER
	PROD(	<LETTER!DIGIT>	,SIXS,*,.     )	;SAVE ANY ALPHANUMERICS
SKPBLA:	PROD(	<BLANK>		,    ,*,.     )	;IGNORE BLANKS
	PROD(	<SG>		,RET , ,      )	;AND RETURN

	TBLEND
SUBTTL	FILE SPECIFIER ROUTINES

A.FILI:	TDZA	T3,T3		;ALL WE NEED DO IS NOTE WE HAVEN'T SEEN A FILENAME
A.DEV:	MOVEM	T1,FILDEV(FB)	;SAVE DEVICE NAME
	POPJ	P,		;THESE ROUTINES ARE OFTEN THIS SHORT!

A.NAME:				;GOT NAME, PRSDFL WILL BE OFF AND MUST BE SET
A.NAMX:	TROE	T3,-1		;SET FILE SEEN FLAG AND CHECK TO SEE IF IT WAS
	JRST	A.EXT		;YES, MUST BE EXTENSION
	JUMPE	T1,CPOPJ##	;DON'T OVERWRITE DEFAULT
	MOVEM	T1,FILNAM(FB)	;SAVE FILE NAME
	POPJ	P,

A.EXT:	MOVEM	T1,FILEXT(FB)	;SAVE EXTENSION
	POPJ	P,

A.GPRJ==OCTLXR##
A.PROJ:	HRLZM	T1,FILPPN(FB)	;SAVE PROJECT (LEFT HALF)
	PJRST	OCTLXR##	;AND CALL OCTLXR AGAIN FOR THE SECOND HALF

A.PROG:	HRRM	T1,FILPPN(FB)	;AND REMEMBER IT
	POPJ	P,		;BEFORE RETURNING


;ROUTINE TO HANDLE DATA FLOW WHILE PARSING A SIXBIT WORD. RETURNS:
;	T1/	SIXBIT DATA
;	T2/	BYTE POINTER POINTING TO LAST BYTE
A.SIXS:	TRNE	P3,LGLSIX	;THIS IS CUTE. WE MAY HAVE ONE OF 3 TYPES OF CHARS:
				;NUM, RANGE 60-71 (SIXBIT 20-31)
				;UC, RANGE 101-132 (41-72)
				;LC, RANGE 141-172 (41-72)
				;SO, IF IT IS LEGAL SIXBIT, WE HAVE TO COMPLEMENT
				;BIT 40:
	XORI	P2,40		;LIKE THAT, WHILE LEAVING LOWER CASE ALONE
	TLNE	T2,770000	;MORE CUTENESS. THIS FIELD IS 0 AFTER T1 IS FILLED
	IDPB	P2,T2		;STUFF INTO T1
	POPJ	P,		;AND BACK FOR MORE

A.SIXI:	MOVE	T2,[POINT 6,T1]	;SETUP POINTER TO WHERE WE'LL ACCUMULATE THE NAME
	SETZ	T1,		;AND CLEAR THAT OF ANY GARBAGE IT MIGHT HAVE
	POPJ	P,		;BACK TO SCAN FIRST CHARACTER

	PRGEND
TITLE	NUMGET - GET A DECIMAL/OCTAL NUMBER FROM INPUT STREAM
SUBTTL	RIC WERME, SEPT. 1976

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

TWOSEG
RELOC	400000
VERSION(1,A,2,,%DECGET)
ENTRY	DECLXC,DECLXR,OCTLXC,OCTLXR

;SUBROUTINE TO READ A DECIMAL NUMBER FROM THE INPUT STREAM AND
;RETURN IT IN T1

DECLXC::LCH	T1		;COMPENSATE FOR LEXINT
DECLXR::MOVEI	T1,12		;DECIMAL BASE
	JRST	CALLEX		;SAVE BASE AND DO THE PARSE

OCTLXC::LCH	T1		;JUST LIKE DECLX?
OCTLXR::MOVEI	T1,10		;USE BASE 8
CALLEX:	MOVEM	T1,BASE		;SAVE IT
	MOVEI	T1,NUMSPC	;ADDRESS OF PRODUCTION TABLE
	PJRST	LEXINT##	;DO IT AND RETURN


	TBLBEG(NUMSPC)

	PROD(	<BLANK>		,    ,*,.     )
	PROD(	<SG>		,NUMI, ,      )
	PROD(	<DIGIT>		,NUMS,*,.     )
	PROD(	<BLANK>		,    ,*,.     )
	PROD(	<SG>		,RET , ,      )

	TBLEND

A.NUMI:	SETZ	T1,		;START AT 0 (WHAT ELSE?)
	POPJ	P,

A.NUMS:	IMUL	T1,BASE		;MAKE SOME SPACE
	ADDI	T1,-"0"(P2)	;ADD IN THIS DIGIT
	POPJ	P,


RELOC	0

BASE:	BLOCK	1		;NUMBER BASE USED STORED HERE

	PRGEND
TITLE	DATTIM - UTILITY PRINTERS

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

TWOSEG
RELOC	400000
VERSION(1,,2,,%DATTIM)
ENTRY	DATTIM,DATPRT,DATTHN,TIMPRT,TIMTHN

;SUBROUTINE TO PRINT CURRENT DATE AND TIME AS
;	'ON <DATE> AT <TIME>'
;USES T1-T4

DATTIM::DISIX	[CPOPJ##,,[SIXBIT\&ON % AT %!\];PRINT DATE, TIME, THEN RETURN
		 PUSHJ	P,DATPRT ;PRINT CURRENT DATE
		 PUSHJ	P,TIMPRT];PRINT CURRENT TIME


;SUBROUTINE TO PRINT EITHER CURRENT DATE (ENTER AT DATPRT) OR DATE
;PASSED IN T1 (ENTER AT DATTHN). USES T1-T4

DATPRT::MOVX	T3,%CNDTM	;GET SMITHSONIAN DATE/TIME
	GETTAB	T3,		;SINCE IT'S VERY EASY TO CALCULATE THE DAY OF WEEK
	  SETO	T3,		;KLUDGE THAT WILL PRINT 'SOMEDAY' FOR US
	HLRE	T3,T3		;EXTRACT DATE (OR -1)
DATTHN::IDIVI	T3,7		;CONVERT TO DAY OF WEEK (0-6) OR SOMEDAY (-1)
	DATE	T1,		;GET TODAY'S DATE
	IDIVI	T1,^D<12*31>	;T1_YEAR-64
	IDIVI	T2,^D<   31>	;T2_MONTH-1, T3_DAY-1
	DISIX	[CPOPJ##,,[SIXBIT\%, % %, %!\]
		WSIX	@DAYTAB+1(T4)	;DAY OF WEEK
		WSIX	@MONTAB(T2)	;MONTH
		WDECI	1(T3)		;DAY
		WDECI	^D1964(T1)]	;AND YEAR


;SUBROUTINE TO PRINT TODAYS TIME. USES T1-T3, EXITS WITH LZEFLG OFF

TIMPRT::MSTIME	T1,		;TOP OFF WITH TIME
TIMTHN::IDIVI	T1,^D1000	;DISCARD THOUSANTHS
	IDIVI	T1,^D<60*60>	;T1_HOURS
	IDIVI	T2,^D<   60>	;T2_MINUTES; T3_SECONDS
	TXO	F,LZEFLG	;PRINT TIME WITH LEADING ZEROS
	DISIX	[[SIXBIT\%:%:%!\]
		 WDEC	2,T1	;HOURS
		 WDEC	2,T2	;MINUTES
		 WDEC	2,T3]	;SECONDS
	TXZ	F,LZEFLG	;TURN OFF AS PROMISED
	POPJ	P,		;AND RETURN
DEFINE	MAKLST	(A)<
	IRP	A<[SIXBIT/A!/]>>

MONTAB:	MAKLST	<J&ANUARY,F&EBRUARY,M&ARCH,A&PRIL,M&AY,J&UNE,J&ULY,A&UGUST,
S&EPTEMBER,O&CTOBER,N&OVEMBER,D&ECEMBER>

DAYTAB:	MAKLST	<S&OMEDAY,W&EDNESDAY,T&HURSDAY,F&RIDAY,S&ATURDAY,S&UNDAY,M&ONDAY,T&UESDAY>

	PRGEND
TITLE	SIXSRC - SIXBIT TABLE SEARCH ROUTINE

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

TWOSEG
RELOC	400000
ENTRY	SIXSRC
COMMENT	\ROUTINE TO SCAN A SIXBIT LIST LOOKING FOR EXACT OR PARTIAL MATCH
ENTER WITH
T1/ SIXBIT NAME TYPED
T2/ MASK TO USE
T3/ AOBJN WORD POINTING TO A TABLE OF SIXBIT NAMES

INTERNAL USE:
T1-T3 - AS ABOVE
T4/ TEMPORARY (CURRENT NAME AND ABBREVIATION
P1/ COROUTINE PC
P2/ USED BY COROUTINE CODE...SEE COMMENTS THERE

RETURNS
T1/ NAME TYPED
T2/ MASK
T3/ RH - RELATIVE INDEX FOR COMMAND (NOT ADDRESS!!)

IF THERE ARE ANY SHORT COMMANDS THAT ARE ABBREVIATIONS OF LONGER ONES,
THEY MUST PRECEDE THE LONG ONE OR ELSE SIXSRC WILL BECOME QUITE CONFUSED,
E. G. IF FOOBAR AND FOONLY PRECEDED FOO, AND SIXSRC WAS ASKED TO SCAN
FOR FOO, AN ERROR MESSAGE WILL RESULT COMPLAINING THAT FOOBAR AND FOONLY ARE
AMBIGUOUS YET SIXSRC WILL TAKE THE SUCCESSFUL RETURN SINCE FOO IS AN
EACT MATCH.\

SIXSRC::PUSHJ	P,SAVE2##	;4 TEMP ACS NOT ENOUGH HERE
	HRLM	T3,(P)		;SAVE TABLE ADDR SO WE CAN RETURN CMD INDEX
	MOVEI	P1,SIXMAT	;SETUP COROUTINE ADDR
SIXS1:	MOVE	T4,(T3)		;GET REAL COMMAND NAME
	CAMN	T1,T4		;EXACT MATCH?
	JRST	SIXS2		;YES, WE HAVE WHAT WE WANT!
	AND	T4,T2		;TRIM NAME DOWN TO SIZE (OF WHAT WAS TYPED)
	CAMN	T1,T4		;NOW DOES IT MATCH?
	JSP	P1,(P1)		;CALL COROUTINE TO DETERMINE CORRECTNESS
				;  OF THIS MATCH

	AOBJN	T3,SIXS1	;GO TRY ANOTHER
CJSP1:	JSP	P1,1(P1)	;DONE. LET AMBIGUOUS CHECKER FINISH UP IF NECESSARY
SIXS2:	  AOS	(P)		;THE JSP WILL DO A SKIP RETURN IF ERROR
	HLRZ	T4,(P)		;GET SWITCH TABLE ADDRESS BACK
	SUB	T3,T4		;MAKE T3 BE INDEX. NOTE THAT T3 WILL BE
				;  GARBAGE IF WE WILL TAKE THE ERROR RETURN.

	POPJ	P,		;TELL CALLER HOW WE DID
COMMENT	\
COROUTINE USED TO HANDLE PARTIAL MATCHES FOUND BY SIXSRC. THIS SCHEME ALLOWS
BOTH THE EASE OF A LOOP TO SEARCH A LIST WHILE AT THE SAME TIME ALLOWING THE
EASE OF A COROUTINE TO BE USED INSTEAD OF INCREMENTING AND CHECKING AN
EVENT COUNTER.
THE COROUTINE IS CALLED BY EITHER:

	JSP	P1,(P1)		;FOR EACH MATCH DETECTED. THE FIRST
	 TIME IT IS CALLED, THE FIRST MATCH WILL HAVE BEEN FOUND AND MAY
	 REPRESENT A VALID MATCH. NOT UNTIL THE THE SECOND CALL MAY IT REPORT
	 AN ERROR, AND THEN IT MUST REPORT 2 OF THEM SINCE 2 MATCHES WILL
	 HAVE OCCURED. ALL FUTURE CALLS WILL HAVE TO REPORT ONE ERROR.

	JSP	P1,1(P1)	;AT THE END OF SIXSRC. THE COROUTINE IS
	 QUERIED AS TO WHAT IT HAS FOUND AND MUST DO A SKIP RETURN IF A BAD
	 (AMBIGUOUS OR NONEXISTANT) NAME WAS SEARCHED FOR. THIS CALL ALSO ALLOWS
	 SIXMAT TO FINISH ANY ERROR REPORTING IF NECESSARY. IF
	 THIS IS THE FIRST CALL TO SIXMAT, NO MATCHES HAVE BEEN FOUND AND
	 SIXMAT REPORTS SO. IF THIS IS THE SECOND CALL, THEN PRECISELY
	 ONE MATCH HAS BEEN FOUND, AND THE NON-SKIP RETURN IS TAKEN TO
	 SIGNIFY SUCCESS WITH T3 POINTING TO THE COMMAND.
	 IF THIS THE THIRD OR GREATER CALL, THEN THE AMBIGUOUS
	 ERROR MESSAGE IS FINISHED WITH A ')'. IN THE CASE OF THE SUCCESSFUL
	 RETURN, ACCUMULATOR T3 WILL BE SETUP WITH ADDRESS OF MATCHED SWITCH.

THE CJSP1 LABEL BACK IN SIXSRC IS SIMPLY A MEANS TO SAVE AN INSTRUCTION
HERE. IT MAY BE USED SINCE THE COROUTINE WILL BE CALLED NO LONGER.
ALL WE NEED TO DO IS A SKIP RETURN, AND A JSP DOES IT QUITE WELL.
COROUTINES ARE NEAT!\

SIXMAT:	JRST	SIXMA1		;FIRST MATCH, NOTHING TO WORRY ABOUT
	 EDISIX	[CJSP1,,[SIXBIT\? % &IS NOT DEFINED.#!\]
		 WNAME	T1]	;IDENTIFY IT
SIXMA1:	MOVE	P2,T3		;REMEMBER MATCH IN CASE OF SUCCESSFUL RETURN
				;  AND FOR AMBIGUOUS ERROR CODE BELOW
	JSP	P1,(P1)		;FROM SIXERR. JUST GO GET SOME MORE

	EDISIX	[SIXAMB,,[SIXBIT\? % &IS AMBIGUOUS (%, %!\]
		 WNAME	T1	;SWITCH HE TYPED
		 WNAME	(P2)	;LAST MATCH
		 WNAME	(T3)]	;THIS MATCH
	  MOVEI	T3,(P2)		;HERE FROM END OF SIXSRC TO WHEN WE FOUND JUST
				;  THE ONE MATCH WE WERE HOPING FOR.
				;  RETURN T3/ ADDR OF MATCH
SIXAMB:	JSP	P1,(P1)		;DO COROUTINE CALL BACK TO CALLER

	EDISIX	[SIXAMB,,[SIXBIT\, %!\];HERE FOR 3RD OR GTR MATCH
		 WNAME	(T3)]	;CURRENT MATCH
	 EDISIX	[CJSP1,,[SIXBIT\)#!\]]

	PRGEND
TITLE	SAVT - ROUTINE TO SAVE/RESTORE ALL TEMPORARY ACS
SUBTTL	RIC WERME, JUNE 1977

	SEARCH	TULIP		;TULLIB DEFINITIONS
	SEARCH	JOBDAT, MACTEN, UUOSYM	;STANDARD DEFINITIONS
	SALL			;PRETTY LISTINGS
	.DIRECT	FLBLST		;PRETTIER LISTINGS

VERSION(1,,1,,%SAVT)
ENTRY	SAVT

SAVT::	EXCH	T1,(P)		;SAVE T1, GET RETURN
	HRLI	T1,(P)		;MAKE A JRA POINTER
	PUSH	P,T2
	PUSH	P,T3
	PUSH	P,T4
	PUSHJ	P,[JRA T1,(T1)]	;CALL CALLER
	  SOS	-4(P)		;COMPENSATE FOR AOS BELOW
	POP	P,T4
	POP	P,T3
	POP	P,T2
	POP	P,T1
	PJRST	CPOPJ1##	;GIVE SKIP OR NORMAL RETURN

	END