Google
 

Trailing-Edge - PDP-10 Archives - bb-m836d-bm - tools/sed/sed1fi.mac
There are 10 other files named sed1fi.mac in the archive. Click here to see a list.
TITLE	SED1FI - SED SET-FILE AND WINDOW COMMANDS
SUBTTL	A CHRISTOPHER HALL FECIT

	SEARCH	SEDSYM
	SALL

IFN TOPS10,<
	SEARCH	UUOSYM
	TWOSEG
	RELOC	400000
>
IFE TOPS10,<
	SEARCH	MONSYM
>

;**********************************************************************
;HERE TO SET UP A NEW FILE FOR EDITING

SETFIL::HRRZM	P,SAVEAC+11	;SET READ-WRITE FLAG POSITIVE (IE, NONE)
	MOVEM	F,SAVEAC	;SAVE THE FLAGS FOR LATER
	TRZE	F,RDO		;ASSUME WILL WRITE FILE - CAN WRITE NOW?
	TLZA	F,CHG		;NO - FORGET ANY CHANGES THAT WERE MADE; SKIP
SETFLS::MOVEM	F,SAVEAC	;SAVE THE FLAGS FOR LATER
	MOVE	T2,PARPTR	;END PARAMETER WITH A NULL
	SETZ	T1,		;GET A NULL
	IDPB	T1,T2
	MOVE	PT,[POINT 7,PARBUF]
	ILDB	T1,PT		;GET FIRST CHARACTER OF FILESPECS
	CAIE	T1,"/"		;GOT JUST A STRING OF SWITCHES?
	JRST	SETFL0		;NO - CONTINUE
	PUSHJ	P,RESTPM	;YES - CLEAR ENTER MODE
	PUSHJ	P,SWHMNY	;SET UP THE SWITCHES
	SKIPN	AGNFLG		;WANT TO SET TO THE SAME FILE AGAIN?
	JRST	SETNPM		;NO - GO SET UP THE ALTERNATE FILE

	SETZM	AGNFLG		;YES - CLEAR THE AGAIN FLAG
	MOVE	T3,[POINT 7,FILSPC]
	MOVE	T4,[POINT 7,PARBUF]
SETAG0:	ILDB	T1,T3		;MOVE CURRENT FILESPECS TO PARM BUFFER
	IDPB	T1,T4		;AS IF THE USER TYPED THEM IN
	JUMPN	T1,SETAG0
	MOVEM	T4,PARPTR	;SAVE POINTER TO END OF PARAMETER

SETFL0:	MOVE	T1,[OLDSPC,,SVASPC] ;COPY OLD SPECS TO SAVE AREA
	BLT	T1,SVASPC+SPCSIZ+3  ;  (COPY THE SAVED POINTERS, TOO)
	MOVE	T1,[FILSPC,,OLDSPC] ;AND CURRENT SPECS TO OLD AREA
	BLT	T1,OLDSPC+SPCSIZ-1
IFE TOPS10,<
	DMOVE	T1,EXTPTR	;SAVE EXTENSION AND ITS POINTER
	DMOVEM	T1,SAVEXP
>
	SKIPA	T1,SAVEAC	;SAVE THE ORIGINAL CURRENT FLAGS
SETFLC::MOVE	T1,F		;SAVE THE CURRENT FLAGS
	MOVEM	T1,SAVEFG
	MOVE	T1,DISPTR	;SAVE CURRENT DISPLAY POINTER
	MOVEM	T1,SAVEDP
	MOVEM	SL,SAVESL	;SAVE SLIDE
	MOVE	T3,[POINT 7,FILSPC]
	PUSHJ	P,PELS.F	;PICK UP USER'S FILESPEC, IF ANY
	MOVEM	RW,SAVERW	;SAVE POSITION AGAIN IN CASE OF CUR MVMT
	HRLM	CM,SAVERW
	PUSHJ	P,ERASPM	;ERASE PARAMETER
	SETZM	WINDIS		;IF WINDOWING BE SURE TO DISPLAY THE FILE
	SETZM	MFLPTR		;FORGET INDIRECT STUFF IF USER GIVES A FILE
	TRZE	F,IND		;WANT TO LOOK AT FILES INDIRECTLY?
	JRST	SETIND		;YES - HANDLE SEPARATELY
	PUSHJ	P,PNTSTT	;SET UP POINTERS TO START OF FILE
	PUSHJ	P,PARSEF	;PARSE FILESPEC AND (MAYBE) SWITCHES
	TLZ	F,PCM!FLG!FNC	;CLEAR MARK AND PARSE FLAGS

IFN TOPS10,<
SETFL1::TLZ	F,FLG		;CLEAR FLAG FROM PARSEF
IFN FTSFD,<
	MOVE	T1,[SFDLVL+4,,FILPTH]
	PATH.	T1,
	  JRST	SETERR
>
	OPEN	2,FILBLK	;OPEN FILE FOR EDITING
	  JRST	SETERR
	LOOKUP	2,FILFIL	;SET UP FILE FOR READING
	  JRST	SETERR

	SETOM	INJFN		;SAY FILE HAS BEEN SET UP
	MOVE	T1,FILFIL+5	;GET SIZE OF FILE (IN WORDS)
	CAILE	T1,MAXSIZ*200	;IS FILE TOO BIG?
	JRST	SSZERR		;YES - ERROR
	MOVEM	T1,FILSIZ	;NO - SAVE FILE SIZE
	HRRZ	T2,DISPTR	;GET DISPLAY POINTER ADDRESS
	SUBI	T2,BUFFER
	CAMGE	T1,T2		;IS IT POINTING BEYOND THE BUFFER?
	JRST	[MOVE  T2,[010700,,BUFFER-1]
		 MOVEM T2,DISPTR ;YES - POINT TO START OF BUFFER
		 JRST  .+1]
;	LSH	T1,-7		;GET SIZE IN BLOCKS
;	MOVEM	T1,FILBSZ	;SAVE IT, TOO
IFE FTSFD,<
	MOVE	T1,FILFIL+16	;GET ACTUAL DEVICE NAME
	MOVEM	T1,FILBLK+1	;SAVE IN OPEN BLOCK, AND GET WHAT'S THERE
>
	ENTER	2,FILFIL	;SEE IF FILE CAN BE WRITTEN
	  TRO	F,RDO		;IT CAN'T - SET READ ONLY FLAG
	HLLZS	FILFIL+3	;CLEAN UP FILESPEC BLOCK
	SETZ	T1,
	EXCH	T1,FILFIL+4
	MOVEM	T1,SAVEAC+10
IFN FTSFD,<
	SETZM	FILFIL+5
	MOVEI	T2,2		;SEE WHAT THE PDP-10 THINKS THE PATH IS
	MOVEM	T2,FILPTH
	MOVE	T1,[SFDLVL+4,,FILPTH]
	PATH.	T1,
	  JRST	SETERR		;(THIS SHOULD NEVER HAPPEN)
	MOVN	T2,T2		;SAVE SET-PATH ARGUMENT
	EXCH	T2,FILPTH	;  AND GET THE DEVICE NAME
	MOVEM	T2,FILBLK+1	;SAVE DEVICE IN OPEN BLOCK
	SETZM	FILPTH+1	;CLEAN UP THE PATH BLOCK
	SETZM	FILFIL+1	;  AND THE LOOKUP BLOCK
	MOVE	T1,FILPTH+2	;GET THE PPN
>
IFE FTSFD,<
	MOVE	T1,[FILFIL+4,,FILFIL+5]
	BLT	T1,FILFIL+LUKLEN ;ZERO REST OF FILE BLOCK
	MOVE	T1,FILFIL+1
>
	MOVEM	T1,FILPPN	;SAVE THE REAL FILE PPN

	JUMPLE	DO,SETF10	;UNPARSE NOT NEEDED IF NO PARAMETER WAS GIVEN
	PUSHJ	P,UNPARS	;NOW UNPARSE THE FILESPECS
	SKIPE	RSCANF		;GOT A FILE FROM RESCAN?
	JRST	SETF10		;YES - DON'T SAVE PREVIOUS FILE
	TLNN	DO,200000	;WORKING ON AN INDIRECT FILE,
	SKIPN	OLDSPC		;  OR IS THERE A PREVIOUS FILE?
	JRST	SETF10		;EITHER - DON'T SAVE OLD FILE
	PUSHJ	P,SAMFIL	;AND SEE FILE IS SAME AS PREVIOUS ONE
	TLNE	F,SMF		;ARE FILES THE SAME?
	JRST	[RELEAS 2,
		 JRST   SETWIN] ;YES - JUST SET THE THE NEW POSITION
	MOVEI	T4,OLDSPC	;NO - PREPARE TO SAVE FILE
	MOVEI	PT,OLDBLK
	MOVE	T1,SAVEDP
	MOVEM	T1,DISPTR
IFN FTSFD,<
	MOVE	T1,[SFDLVL+4,,OLDPTH]
	PATH.	T1,		;SET THE PATH TO THE OLD FILE
	  JRST	SETERR
>
	PUSHJ	P,SAVFIL	;SAVE THE OLD FILE
	MOVE	T1,[010700,,BUFFER-1]
	EXCH	T1,DISPTR
	MOVEM	T1,SAVEDP

SETF10:	SETZM	RSCANF		;CLEAR FILE-FROM-RESCAN FLAG
IFN FTSFD,<
	MOVE	T1,[SFDLVL+4,,FILPTH]
	PATH.	T1,		;PATH BACK TO THE NEW FILE
	  JRST	SETERR
>
	MOVEI	T1,BUFFER-1	;SHRINK CORE TO GET RID OF OLD FILE
	CORE	T1,
	  HALT
	MOVE	T1,FILSIZ	;EXPAND CORE TO ACCOMMODATE NEW FILE
	ADDI	T1,BUFFER
	CAMGE	T1,.JBREL	;IS IT WITHIN PRESENT CORE?
	JRST	[SETZM BUFFER	;YES - CLEAR OUT ALL OF CORE
		 MOVE  T2,[BUFFER,,BUFFER+1]
		 MOVE  T3,.JBREL
		 BLT   T2,(T3)
		 JRST  .+1]
	ADDI	T1,2000
	CORE	T1,
	  JRST	SSZERR		;ERROR - FILE TOO BIG
	MOVN	T1,FILSIZ
	HRLM	T1,FILCCL	;READ ENTIRE FILE IN
	CAIE	T1,0		;UNLESS IT'S A ZERO-LENGTH FILE
	INPUT	2,FILCCL
	RELEAS	2,		;GET RID OF CHANNEL
	MOVE	T1,FILSIZ
>
IFE TOPS10,<
SETFL1::MOVE	T1,[GJ%OLD+GJ%SHT]
	HRROI	T2,FILSPC	;GET A JFN FOR THIS FILE
	GTJFN
	  JRST	SETERR
	JUMPLE	DO,SETF11	;UNPARSE NOT NEEDED IF NO PARAMETER WAS GIVEN
	HRRZM	T1,NEWJFN	;SAVE FILE'S JFN IN A SCRATCH AREA FOR NOW
	PUSHJ	P,UNPARS	;READ THE SPECS BACK FROM THE MONITOR

	SKIPE	RSCANF		;GOT A FILE FROM RESCAN?
	JRST	SETF10		;YES - DON'T SAVE PREVIOUS FILE
	TLNN	DO,200000	;WORKING ON AN INDIRECT FILE,
	SKIPN	OLDSPC		;  OR IS THERE A PREVIOUS FILE?
	JRST	SETF10		;EITHER - DON'T SAVE OLD FILE
	PUSHJ	P,SAMFIL	;SEE FILE IS SAME AS PREVIOUS ONE
	TLNE	F,SMF		;ARE FILES THE SAME?
	JRST	[MOVE  T1,NEWJFN ;YES - JUST SET THE THE NEW POSITION
		 CLOSF
		  JRST SETWIN
		 JRST  SETWIN]
	MOVEI	T4,OLDSPC	;NO - PREPARE TO SAVE FILE
	MOVE	T1,SAVEDP
	MOVEM	T1,DISPTR
	PUSHJ	P,SAVFIL	;SAVE THE OLD FILE
	MOVE	T1,[010700,,BUFFER-1]
	EXCH	T1,DISPTR
	MOVEM	T1,SAVEDP

SETF10:	SETZM	RSCANF		;CLEAR FILE-FROM-RESCAN FLAG
	MOVE	T1,NEWJFN	;MAKE THE NEW FILE'S JFN OFFICIAL
SETF11:	MOVEM	T1,INJFN	;  (AND GET JFN IN T1)
	MOVEI	T2,OF%THW+OF%RD+OF%WR+OF%DUD+OF%PDT
	OPENF
	  JRST	SETERC		;FAILED - TRY TO OPEN FROZEN
SETF12:	SETO	T1,		;UN-MAP THE PREVIOUS FILE
	MOVE	T2,[400000,,BUFBLK]
	MOVE	T3,[PM%CNT]
	HRR	T3,FILBSZ
	PMAP

	MOVE	T1,INJFN	;GET THE NEW FILE'S JFN
	MOVE	T2,[1,,.FBBYV]	;FIND BYTE SIZE OF THE FILE
	MOVEI	T3,T4		;  IN T4
	GTFDB
	HLRZ	T4,T4
	ANDI	T4,7700		;CLEAR OUT ALL FIELDS BUT BYTE SIZE
	MOVEI	PT,1		;ASSUME BYTE SIZE IS 7
	CAIN	T4,4400		;IS IT REALLY 36?
	MOVEI	PT,5		;YES - MAKE ADJUSTMENT

	SIZEF			;FIND THE SIZE OF THE FILE
	  JRST	SETERC		;FAILED - TRY TO OPEN FROZEN
	IMUL	T2,PT		;CONVERT BYTE COUNT INTO CHARACTER COUNT
	MOVEM	T2,FILSIZ	;AND SAVE IT
	MOVEM	T3,FILBSZ	;AND BLOCK COUNT

	CAIL	T3,777-BUFBLK	;IS FILE TOO BIG?
	JRST	SSZERR		;YES - TOUGH LUCK
	HRLZ	T1,INJFN	;NO - READ IN THE ENTIRE FILE
	MOVE	T2,[400000,,BUFBLK]
	MOVE	T4,T3		;SAVE NUMBER OF PAGES IN FILE
	ADD	T3,[PM%CNT+PM%RD+PM%CPY]
	PMAP

	SETO	T1,		;SNIFF ALL PAGES SO THEY'LL BE LOCALLY COPIED
	MOVEI	T2,BUFFER
SETF1A:	ANDM	T1,(T2)		;WRITE INTO A PAGE
	ADDI	T2,1000		;GO TO NEXT PAGE
	SOJG	T4,SETF1A	;LOOP THROUGH ALL PAGES
	MOVE	T1,INJFN	;DONE WITH THE INPUT FILE - GET RID OF IT
	HRLI	T1,(CO%NRJ)	;BUT KEEP THE JFN FOR THE BACKUP FILE
	CLOSF			;CLOSE THE FILE
	  JFCL
	MOVE	T1,FILSIZ	;GET BYTE SIZE
	IDIVI	T1,5		;CONVERT TO WORDS
>
	MOVE	EN,[010700,,BUFFER]
	ADD	EN,T1		;SET UP POINTER TO END OF FILE
	TRO	F,GFL		;NOTE THAT A FILE HAS BEEN SET UP
	TDZ	F,[FLG!PCM,,CRE] ;CLEAR EXTENSION, MARK, AND CREATE FLAGS
	SKIPN	DISPTR		;WANT TO USE PRE-SET POINTERS?
	PUSHJ	P,PRESET	;YES - SET THEM UP
	SETZM	EEEPTR		;CLEAR FREE-EXTENSION POINTER
IFN FTJOUR,<
	TLNE	TM,JRW		;WANT TO WRITE A JOURNAL?
	PUSHJ	P,JRNSTT	;YES - START IT UP
>
	SKIPN	(EN)		;GOT A WORD ENTIRELY OF NULLS?
	SOJA	EN,.-1		;YES - BACK UP OVER IT
	CAMN	EN,[010700,,BUFFER-1] ;IF THERE'S NOTHING IN THE BUFFER,
	AOJA	EN,SETCR2	      ;PUT IN A FREE CARRIAGE RETURN
	MOVE	T1,EN		;GET POINTER TO END OF FILE
	AOJA	EN,SETCR0	;MAKE SURE FILE ENDS WITH A CRLF

SETCR:	ADD	T1,[70000,,0]	;BACK UP END POINTER A NOTCH
	CAIGE	T1,0
	SUB	T1,[430000,,1]
SETCR0:	LDB	T2,T1		;GET CHARACTER
	JUMPE	T2,SETCR	;SKIP IF NULL
	CAIE	T2,12		;ELSE GOT A LINEFEED?
	JRST	SETCR2		;NO - GO ADD A CRLF
	ADD	T1,[70000,,0]	;YES - SEE IF IT'S PRECEDED BY A <CR>
	CAIGE	T1,0		;BACK UP A NOTCH
	SUB	T1,[430000,,1]
	LDB	T2,T1		;GET CHARACTER
	CAIN	T2,15		;GOT A <CR>
	JRST	SETRDO		;YES - O.K.
				;NO - FALL TO ADD A CRLF
SETCR2:	MOVE	T1,[BYTE (7) 15,12] ;GET A <CRLF>
	MOVEM	T1,1(EN)	;SAVE AS LAST WORD OF FILE
	AOJA	EN,SETRDO	;NOW GO CHECK FOR LINE NUMBERS

;NOW CHECK READ-WRITE STATUS. IF THE FILE ACCESS DOES NOT PERMIT WRITING,
;IT'S READ-ONLY. ELSE USE THE SWITCH THE USER GAVE IN THE SET-FILE COMMAND.
;ELSE IT'S READ-ONLY IF GREFLG IS SET. ELSE IT'S WRITEABLE.

;IF THE FILE IS WRITEABLE, SEE IF LOW ORDER BITS ARE ON IN FILE WORDS: IF
;SO, FILE HAS LINE NUMBERS OR IS NOT TEXT. IF THE USER WANTS TO STRIP LINE
;NUMBERS, DO SO AND CONTINUE. ELSE SET READ-ONLY FLAG AND WARN THE USER.

;(GOSH, YOU WONDER HOW ANY FILE ENDS UP WRITEABLE)

SETRDO:
IFE TOPS10,<
	TLNE	DO,100000	;IS THIS THE END OF A SAVE (COMMAND OR INC'L)?
	JRST	SETWIN		;YES - IT CAN'T BE READ-ONLY
>
	TRNE	F,RDO		;IS FILE ALREADY READ-ONLY?
	JRST	SETRD5		;YES - NO FURTHER CHECKING IS NECESSARY
	SKIPG	T1,SAVEAC+11	;DID USER GIVE A READ OR WRITE SWITCH?
	JRST	SETRD3		;YES - LET IT OVERRIDE ANYTHING ELSE
	SKIPE	GREFLG		;NO - SHOULD ALL FILES BE MARKED READ-ONLY?
	JRST	SETRD7		;YES - SET READ-ONLY; NO ERROR MESSAGE
;	JRST	SETRD5		;YES - SET READ-ONLY
	JRST	SETRD4		;NO - SKIP THIS

SETRD3:	JUMPL	T1,SETRD5	;IF USER GAVE READ, SET READ-ONLY
SETRD4:	MOVE	T2,BUFFER	;GET FIRST WORD OF BUFFER
	TRNN	T2,1		;IS THE LINE NUMBER FLAG ON?
	JRST	SETWIN		;NO - GO CHECK FOR A WINDOW
	SKIPE	STRFLG		;YES - WANT TO STRIP LINE NUMBERS?
	JRST	SETSTP		;YES - DO SO (RETURN TO SETWIN)
	SKIPA	T1,[[ASCIZ /######Line numbers - read only/]]
SETRD5:	MOVEI	T1,[ASCIZ /######File cannot be modified/]
SETRD6:	PUSHJ	P,ERRDSP	;DISPLAY THE MESSAGE
SETRD7:	TRO	F,RDO		;MARK FILE AS READ ONLY

;NOW SEE IF WINDOWING IS IN EFFECT. IF SO, CHANGE WINDOWS (MAYBE).

SETWIN:	TLNE	TM,WDW		;WANT WINDOWING,
	SKIPE	CRRFLG		;  AND WANT TO REPLACE THE ALTERNATE FILE?
	JRST	SETCUR		;NOT BOTH - JUST DISPLAY THE FILE
IFE TOPS10,<
	TLNE	DO,100000	;IS THIS THE END OF A SAVE (COMMAND OR INC'L)?
	JRST	SETCUR		;YES - DON'T CHANGE WINDOWS
>
	SKIPE	HOMPOS		;BOTH - IN TOP WINDOW?
	JRST	[SETZ  T3,	;NO - MOVE TO TOP
		 EXCH  T3,HOMPOS
		 MOVEI T1,"^"	;GET UPWARD-POINTING SEPARATOR
		 SETZM CPG(TM)	;MAKE CLEAR-TO-EOP NOT WORK
		 SETZM ILN(TM)	;AND INSERT-LINES
		 SETZM DLN(TM)	;AND DELETE-LINES
		 SOJA  T3,SETWN1]
	MOVE	T3,LPP(TM)	;YES - GET CURRENT SCREEN LENGTH
	MOVEM	T3,HOMPOS	;SAVE AS ROW POSITION OF HOME
	SETO	T3,		;PUT SEPARATOR ON LINE ABOVE HOME
	DMOVE	T1,SAVILN	;RESTORE INSERT- AND DELETE-LINE SEQUENCES
	MOVEM	T1,ILN(TM)
	MOVEM	T2,DLN(TM)
	MOVE	T1,SAVCPG	;RESTORE CLEAR-TO-EOP SEQUENCE
	MOVEM	T1,CPG(TM)
	MOVEI	T1,"v"		;GET DOWNWARD-POINTING SEPARATOR
SETWN1:	PUSHJ	P,WINSEP
	SKIPE	WINDIS		;IS THERE A DISPLAY IN BOTH WINDOWS?
	SETOM	DSPFLG		;YES - DON'T DISPLAY NOW
	SETOM	WINDIS		;EITHER WAY, DON'T DISPLAY NEXT TIME
SETCUR:	MOVS	T1,[OLDSPC,,SVASPC]
	SKIPE	CRRFLG		;WANT TO REPLACE THE CURRENT (NOT OLD) FILE?
	BLT	T1,OLDSPC+SPCSIZ+2 ;YES - COPY THE OLD STUFF BACK
	SETZM	CRRFLG		;CLEAR USE CURRENT FILE FLAG
	SETZM	CHGSPC		;NOTE THAT FILESPECS AREN'T CHANGED (YET)
	SKIPE	OUTFLG		;NEED TO FINISH UP AN /OUT: SWITCH?
	PUSHJ	P,OUTSET	;YES - CHANGE THE FILESPECS TO THOSE IN NEWFIL
	TRZ	F,200		;MAKE SURE CREATE-FILE FLAG IS OFF
	LDB	T1,DISPTR	;IS THE DISPLAY PTR AT THE START OF LINE?
	MOVEI	T4,1
	CAIE	T1,12
	PUSHJ	P,ADVDPT	;NO - MOVE TO THE START OF THE NEXT LINE
IFE TOPS10,<
	TLNE	DO,100000	;IS THIS THE END OF A SAVE (COMMAND OR INC'L)?
	JRST	SETREP		;YES - DON'T RE-DISPLAY IT
>
	SKIPN	CHGSPC		;HAVE FILESPECS CHANGED,
	TLNE	F,SMF		;  OR ARE THE TWO FILES THE SAME?
	JRST	NEWFIL+1	;EITHER - START EDITING THE SAME FILE
	JRST	NEWFIL		;NEITHER - SET UP NEW FILE

IFE TOPS10,<
;HERE WHEN A SAVE (INCREMENTAL OR THE SAVE COMMAND) WAS DONE. INCSAV WENT
;TO SET-FILE TO GET THE FILE BACK. THIS CODE REPAIRS THE SCREEN WITHOUT
;RE-DISPLAYING IT AND MAKES SURE THE FILE IS STILL MARKED "CHANGED".

SETREP:	TLO	F,CHG		;NOTE THAT THE FILE HAS BEEN CHANGED
	TRZ	F,RDO		;AND IT'S NOT READ-ONLY
	PUSHJ	P,FIXBLN	;REPAIR THE BOTTOM LINE OF THE SCREEN
	PUSHJ	P,POSCUR	;RE-POSITION THE CURSOR
	JRST	LOOP		;AND GO GET A NEW COMMAND
>
SSZERR:
IFE TOPS10,<
	MOVE	T1,INJFN	;CLOSE THE NEWLY-GTJFN-ED FILE
	CLOSF
	  JFCL
>
	MOVEI	T1,[ASCIZ /#####File is too large to edit/]
	JRST	STFERR

;HERE TO STRIP THE LINE NUMBERS FROM THE FILE (IF /STRIP SET)
;THE TAB AFTER THE LINE NUMBER HAS TO BE STRIPPED TOO

SETSTP:	MOVEI	PT,BUFFER	;POINT TO START OF BUFFER
	SETZ	T2,		;GET A ZERO TO SAVE
	MOVE	T3,[003777,,-1]	;AND THE ANTI-TAB MASK
SETST1:	MOVE	T1,(PT)		;GET A WORD FROM THE BUFFER
	TRNN	T1,1		;IS THE LINE NUMBER BIT ON?
	JRST	SETST2		;NO - LEAVE IT ALONE
	MOVEM	T2,(PT)		;YES - ZERO THE WORD IN THE BUFFER
	ANDM	T3,1(PT)	;ZERO THE FOLLOWING TAB, TOO
SETST2:	CAIG	PT,(EN)		;AT END OF BUFFER?
	AOJA	PT,SETST1	;NO - LOOP
	MOVEI	T1,[ASCIZ /#######Stripping line numbers/]
	PUSHJ	P,ERRDSP	;DISPLAY THE MESSAGE
	JRST	SETWIN		;YES - DONE

;HERE IF NO PARAMETER WAS TYPED - SET UP PREVIOUS FILE, AND SAVE PRESENT
;ONE AS NEW PREVIOUS ONE

SETNPM::SKIPN	OLDSPC		;ARE THERE OLD FILE SPECS?
	JRST	SETERX		;NO - ERROR
	TLO	DO,400000	;MAKE SETNPM LOOK DIFFERENT FROM SETFIL
IFN TOPS10,<
	MOVEI	PT,FILBLK	;POINT TO NAME OF CURRENT FILE
>
	SETZM	CRRFLG		;MAKE SURE USE-CURRENT-FILE FLAG IS CLEAR
	MOVEI	T4,FILSPC	;POINT TO SPECS (BOTH FOR SAVFIL)
	TLNE	F,SMF		;ARE FILE AND ALTERNATE FILE THE SAME?
	JRST	SETNP0		;YES - DON'T SAVE
	SKIPE	FILSPC		;IS THERE AN ACTIVE FILE?
	PUSHJ	P,SAVFIL	;YES - SAVE IT NOW
SETNP0:	SKIPE	PT,MFLPTR	;GOT MORE FILES IN nnnSED.TMP?
	PUSHJ	P,SETMFL	;YES - SET NEXT ONE UP AS ALTERNATE
	MOVEI	T1,SPCSIZ-1
SETNP1:	MOVE	T2,FILSPC(T1)
	EXCH	T2,OLDSPC(T1)
	MOVEM	T2,FILSPC(T1)
	SOJGE	T1,SETNP1
IFE TOPS10,<
	DMOVE	T1,SAVEXP	;GET SAVED EXTENSION AND ITS POINTER
	EXCH	T1,EXTPTR	;SWAP WITH THE CURRENT ONES
	EXCH	T2,EXTTBL
	DMOVEM	T1,SAVEXP
>
	HRL	RW,CM		;SWAP ROW AND COLUMN POSITIONS
	EXCH	RW,SAVERW
	HLRZ	CM,RW
	HRRZ	RW,RW
	MOVE	T1,DISPTR	;SWAP DISPLAY POINTER
	EXCH	T1,SAVEDP
	MOVEM	T1,DISPTR
	EXCH	SL,SAVESL	;SET UP SLIDE
	MOVE	T1,SAVEFG	;GET THE ALTERNATE FILE'S FLAGS
	MOVEM	F,SAVEFG	;SAVE CURRENT FILE'S FLAGS
	TRZ	F,RDO		;USE CURRENT FLAGS, BUT ALTERNATE'S READ-ONLY
	ANDI	T1,RDO
	OR	F,T1
	TRNN	F,RDO		;IS THE ALTERNATE FILE READ-ONLY?
	TDZA	T1,T1		;NO - SAY IT'S WRITEABLE
	SETO	T1,		;YES - MARK AS READ-ONLY
	MOVEM	T1,SAVEAC+11	;SAVE THE READ-WRITE FLAG
	SKIPN	DISPTR		;NEED TO PARSE SPECS (FROM .TMP)?
	PUSHJ	P,PARSFN	;YES - DO SO
IFN TOPS10,<
IFE FTSFD,<
	MOVE	T1,FILFIL+1	;SET UP THIS FILE'S PPN
	MOVEM	T1,FILPPN
>>
IFE TOPS10,<
	SETOM	SAVEAC+12	;FLAG FILES AS NOT SAME, IF THEY'RE NOT SAME
>
	TLO	F,XPC!XPL!XPB	;NO POINTERS ARE VALID
	TLZ	F,FNC!FLG	;CLEAR FLAG FROM PARSEF AND FENCE
	TLNN	F,SMF		;ARE FILE AND ALTERNATE FILE THE SAME?
	JRST	SETFL1		;NO - GO SET UP THAT FILE
	SKIPN	DISPTR		;NEED TO SET UP PRE-SET POINTERS?
	PUSHJ	P,PRESET	;YES - DO SO
	JRST	SETWIN		;DON'T LOOK FILE UP; JUST USE IT

;HERE TO CREATE FILE. WRITE FIRST LINE IN IT, CLOSE IT,
;AND PRETEND IT WAS THERE ALL THE TIME
;RETURNS +1 ON FAILURE, +2 ON SUCCESS

IFN TOPS10,<
SETCRE:	MOVE	T1,FILBLK+1	;MAKE SURE DEVICE IS RIGHT
	MOVEM	T1,GENBLK+1
	OPEN	5,GENBLK	;OPEN A DUMP MODE OUTPUT FILE ON CHANNEL 5
	  POPJ	P,		;OOPS - CAN'T
	MOVSI	T1,'DSK'	;RESTORE GENBLK'S GENERALITY
	MOVEM	T1,GENBLK+1
	ENTER	5,FILFIL
	  POPJ	P,
	HLLZS	FILFIL+3
	SETZM	FILFIL+4
	SETZM	FILFIL+5
IFN FTSFD,<
	SETZM	FILFIL+1
>
IFE FTSFD,<
	MOVE	T1,FILPPN	;PUT USER'S PPN BACK IN
	MOVEM	T1,FILFIL+1
>
	OUTPUT	5,NEWCCL	;OUTPUT CHEERY MESSAGE
	RELEAS	5,		;CLOSE THE FILE
>
IFE TOPS10,<
SETCRE:	HRROI	T2,FILSPC	;SET UP NEW FILE FOR OUTPUT
	PUSHJ	P,SETOUT
	JUMPE	T1,CPOPJ	;GIVE ERROR RETURN IF FILE CAN'T BE CREATED
	MOVE	T2,[POINT 7,NEWMSG]
	SETZ	T3,
	SOUT			;WRITE STARTING MESSAGE TO NEW FILE
	MOVEI	T2,15		;END IT ALL WITH A <CR>
	BOUT
	MOVEI	T2,12
	BOUT
	CLOSF			;COMPLETE THE FILE
	  POPJ	P,		;OOPS - GIVE ERROR RETURN
>
	SETZM	SAVEAC+11	;SUCCESS - MARK FILE IS ALWAYS WRITEABLE
	TRZ	F,RDO		;DITTO
	AOS	(P)		;RETURN SUCCESS
	POPJ	P,		;RETURN TO LOOK UP THE FILE FOR EDITING

;HERE ON A FILE-NOT-FOUND ERROR. MAY WANT TO LOOK FOR OTHER FILES

IFE TOPS10,<
SETERC:	MOVE	T1,INJFN	;TRY TO OPEN THE FILE FROZEN
	MOVEI	T2,OF%RD+OF%WR+OF%PDT
	OPENF
	  TROA	F,RDO		;NOPE - TRY TO GET THE FILE READ-ONLY
	JRST	SETF12		;YES - CONTINUE
	MOVE	T1,INJFN	;TRY TO OPEN THE FILE THAWED, READ-ONLY
	MOVEI	T2,OF%THW+OF%RD+OF%DUD
	OPENF
	  SKIPA	T1,INJFN	;NOPE - TRY FROZEN, READ-ONLY
	JRST	SETF12		;YES - CONTINUE
	MOVEI	T2,OF%RD
	OPENF
	  SKIPA	T1,INJFN	;NOPE - CLOSE THE NEWLY-GTJFN-ED FILE
	JRST	SETF12		;SUCCESS - CONTINUE SETTING UP THE FILE
	CLOSF			;CLOSE, AND FALL INTO ERROR CODE
	  JFCL
	TRZ	F,RDO		;CLEAR READ-ONLY FLAG
>
SETERR:	SKIPE	EEEPTR		;NO - WORKING ON A LIST OF EXT'S?
	JRST	SETER1		;YES - KEEP WORKING
IFN TOPS10,<
	SKIPE	FILFIL+3	;IS THERE A CURRENT EXTENSION?
	JRST	SETRRC		;YES - CREATE THE FILE OR GIVE AN ERROR
	TLO	F,FLG		;NO - TRY SOME USUAL EXTENSIONS
	MOVE	PT,[POINT 18,EXTTBL]
	HLLZ	T1,OLDFIL+3	;GET EXTENSION OF PREVIOUS FILE
	HLLM	T1,EXTTBL	;SAVE AS FIRST EXTENSION TO TRY
	CAIN	T1,0		;DID PREVIOUS FILE HAVE AN EXTENSION?
	IBP	PT		;NO - SKIP OVER IT
	MOVEM	PT,EEEPTR	;SAVE EXTENSION POINTER
	HLRZ	T1,FILBLK+1	;GET DEVICE NAME
	CAIE	T1,'DSK'	;IS IT DISK?
	JRST	SETR1A		;NO - TRY USING DEVICE AS EXT, TOO

SETER1:	ILDB	T1,EEEPTR	;SET UP ANOTHER EXTENSION
	JUMPE	T1,STRRC0	;UNLESS NONE LEFT, THEN ERROR OR CREATE
SETR1A:	HRLZM	T1,FILFIL+3
	JRST	SETFL1
>
IFE TOPS10,<
	SKIPN	T2,EXTPTR	;IS THERE A CURRENT EXTENSION?
	JRST	SETRRC		;YES - CREATE THE FILE OR GIVE AN ERROR
	SETOM	EEEPTR
	MOVEI	PT,EXTTBL
	SKIPN	T1,(PT)		;NO - IS FIRST EXT NULL?
	AOJA	PT,SETR1A	;YES - SKIP IT
	JRST	SETR1B		;NO - WORK WITH IT

SETER1:	MOVE	T2,EXTPTR	;GET POINTER TO WHERE TO STORE EXT
SETR1A:	SKIPN	T1,(PT)		;SET UP ANOTHER EXTENSION - ANY?
	JRST	STRRC0		;NO - ERROR OR CREATE
SETR1B:	MOVEI	T0,"."		;YES - PUT IN THE DOT
	DPB	T0,T2
	LSHC	T0,7		;GET AN EXTENSION CHARACTER
	IDPB	T0,T2		;SAVE IT
	JUMPN	T1,.-2		;LOOP THROUGH ALL CHARS
	IDPB	T1,T2		;SAVE A NULL AT THE END
	AOJA	PT,SETFL1	;TRY TO FIND THAT FILE
>
SETER3:	SKIPA	T1,[[ASCIZ /######Unable to create file/]]
SETER2:	MOVEI	T1,[ASCIZ /##########File not found/]
	SETZM	EEEPTR
	JRST	STFERR		;GO DISPLAY THE ERROR
SETERX:	MOVEI	T1,[ASCIZ /#########No alternate file/]
	JRST	ERROR

;HERE IF FILE IS NOT FOUND (PERHAPS EVEN AFTER TRYING THE EXTENSION LIST)
;IF /CREATE IS SET, CREATE THE FILE, ELSE IT'S AN ERROR

STRRC0:
IFN TOPS10,<
	SETZM	FILFIL+3	;MAKE THE FILESPEC BE EXTENSIONLESS AGAIN
>
IFE TOPS10,<
	SETZ	T1,
	MOVE	T2,EXTPTR
	IDPB	T1,T2
>
SETRRC:	TRZE	F,CRE		;WANT TO CREATE THIS FILE?
	JRST	STRRC1		;YES - GO CREATE IT
	SKIPN	CREFLG		;WANT TO CREATE EVERY FILE?
	JRST	SETER2		;NO - GIVE THE FILE-NOT-FOUND ERROR
STRRC1:	PUSHJ	P,SETCRE	;YES - CREATE THE FILE
	  JRST	SETER3		;CREATE FAILED - ERROR
	JRST	SETFL1		;O.K. - NOW LOOK IT UP

;SUBROUTINE TO READ NEXT LINE OF STAT.TMP FILE INTO (T4 - FRAGGED)
;ENTER ALSO WITH PT/MFLPTR

SETMFE::MOVE	T4,[POINT 7,OLDSPC] ;HERE AFTER SETERR - READ INTO ALT SPECS
	SETZM	SAVEDP		;CLEAR SAVED DISPLAY POINTER
	JRST	SETMF0		;CONTINUE

SETMFL:	SKIPE	MFLPT0		;GET HERE FROM SETMFB?
	JRST	SETMFC		;NO - CONTINUE
	MOVE	T1,SAVEAC	;YES - SET UP REAL MFLPT0
	MOVEM	T1,MFLPT0
	POPJ	P,		;AND DO NOTHING MORE

SETMFC:	SETZM	DISPTR		;CLEAR DISPLAY PTR SO SPECS WILL BE PARSED
	TLC	DO,600000	;CLEAR NPM AND SET INDIRECT FLAGS
	MOVE	T4,[POINT 7,FILSPC] ;POINT TO FILSPC BLOCK
SETMF0:	EXCH	PT,MFLPT0	;SAVE POINTER TO ALTERNATE SPECS
	MOVEM	PT,MFLPT1	;AND CURRENT SPECS
	MOVE	PT,MFLPT0	;GET CURRENT POINTER BACK
	PUSHJ	P,SETINF	;READ IN INDIRECT FILE
	TRZ	F,GFL		;CURRENT FILE IS NO LONGER AROUND
	PUSHJ	P,TMPGET	;READ NEW SPECS INTO CURRENT FILE AREA
	CAIGE	T1,"!"		;IS THERE AT LEAST A COMMENT ON THE NEXT LINE?
	SETZM	MFLPTR		;NO - FORGET THE POINTER
	POPJ	P,

;SUBROUTINE TO READ IN THE INDIRECT FILESPEC FILE

SETINF:	SETZ	T2,		;CLEAR T2 FOR TMPGET
	SKIPN	INDFLG		;IS FILE ALREADY HERE?
	POPJ	P,		;YES - NOTHING TO DO
	PUSHJ	P,SETIDI	;GO FIND THE TEMPORARY FILE
IFN TOPS10,<
	INPUT	5,SEDCCL	;READ STATUS INTO PICK BUFFER
	RELEAS	5,
>
IFE TOPS10,<
	MOVE	T2,[POINT 7,PIKBUF+PCBSIZ-400]
	SETZ	T3,		;READ THE FILE INTO THE PICK BUFFER
	SIN
	CLOSF			;CLOSE THE FILE
	  HALTF
>
	SETZM	INDFLG		;NOTE THAT FILE IS HERE
	POPJ	P,		;DONE

;HERE ON ENTER SET-FILE, TO SET TO THE PREVIOUS ONE ON THE LIST
;CONTROL GOT HERE FROM PEEL.F, WHICH WAS CALLED BY SETFIL
;CONTROL PASSES TO SETNPM, NOT BACK TO SETFIL. VERY UNSTRUCTURED.

SETMFB::MOVEI	T1,SETNPM	;FAKE RETURN TO SETNPM
	MOVEM	T1,(P)
	MOVE	PT,MFLPT1	;GET POINTER TO CURRENT FILE
	CAMN	PT,[POINT 7,PIKBUF+PCBSIZ-400]
	POPJ	P,		;IF AT START, JUST TOGGLE
	MOVEM	PT,SAVEAC	;SAVE TO PUT IN MFLPT0 LATER
	SETZ	T1,		;CLEAR ALTERNATE PTR AS A FLAG
	EXCH	T1,MFLPT0
	MOVEM	T1,SAVEAC+1
	PUSHJ	P,SETINF	;SET UP THE INDIRECT FILE
STMFB1:	ADD	PT,[70000,,0]	;BACK UP ONE CHARACTER
	CAIGE	PT,0
	SUB	PT,[430000,,1]
	LDB	T1,PT		;GET THE CHARACTER
	JUMPE	T1,STMFB2	;END OF LINE IF NULL
	CAIE	T1,12		;END OF PREVIOUS LINE?
	JRST	STMFB1		;NO - KEEP LOOPING
STMFB2:	MOVEM	PT,MFLPT1	;SAVE POINTER TO (MAYBE) CURRENT FILE
	ILDB	T1,PT		;GET THE FIRST CHARACTER OF THE LINE
	MOVE	PT,MFLPT1	;GET THE REAL POINTER BACK
	CAIE	T1,";"		;IS THE LINE A COMMENT?
	CAIN	T1,"!"
	JRST	STMFB1		;YES - BACK UP ONE MORE LINE

	MOVE	T4,[POINT 7,OLDSPC] ;NO - POINT TO OLD FILESPEC BLOCK
	SETZM	SAVEDP		;CLEAR DISPLAY PTR SO SPECS WILL BE PARSED
	PUSHJ	P,TMPGET	;READ NEW SPECS INTO ALTERNATE FILE AREA
	MOVE	T1,SAVEAC+1	;GET REAL POINTER TO NEXT FILE
	MOVEM	T1,MFLPTR	;SAVE IT
	POPJ	P,		;RETURN TO SET UP THE FILE

;HERE ON "@FILSPC" TO USE GIVEN FILE AS A LIST OF FILES TO EDIT

SETIND:	MOVE	T1,SEDFIL	;SAVE ORIGINAL .TMP FILE NAME
	SKIPN	SAVSED		;UNLESS IT'S SAVED ALREADY
	MOVEM	T1,SAVSED
	MOVE	PT,[POINT 7,FILSPC]
	MOVE	T3,[POINT 7,SEDFIL]
IFN TOPS10,<
	MOVEI	T4,'DIR'	;GET DEFAULT EXTENSION
>
IFE TOPS10,<
	MOVE	T4,[ASCII /DIR/]
>
	PUSHJ	P,PARSFX	;PARSE THESE FILE SPECS
	MOVEI	T4,OLDSPC	;PREPARE TO SAVE FILE
IFN TOPS10,<
	MOVEI	PT,OLDBLK
>
	TRNN	F,GFL		;HAS A FILE BEEN SET UP?
	JRST	SETID1		;NO - DON'T SAVE
	SKIPE	OLDSPC		;IS THERE AN ACTIVE FILE?
	PUSHJ	P,SAVFIL	;YES - SAVE IT
SETID1:	PUSHJ	P,SETIDI	;LOOK UP INDIRECT FILE
	PUSHJ	P,REDTM0	;TREAT @FILE JUST LIKE nnnSED.TMP
	TLZ	F,SMF		;FILES CAN'T BE THE SAME
	TLO	DO,200000	;NOTE THAT AN INDIRECT FILE IS BEING SET UP
	JRST	INDIRE

SETIDI:	HRROI	T2,SEDFIL
	PUSHJ	P,SETINP	;FIND THE FILE
	JUMPN	T1,PIKFRG	;IF O.K., CHECK PICK BUFFER AND RETURN
	MOVEI	T1,[ASCIZ /######Indirect file not found/]
	JRST	STFERR		;TREAT LIKE A NORMAL BAD FILE

;**********************************************************************
;HERE TO SET UP OR CANCEL WINDOWING

WINCLR::PUSHJ	P,RESTPM	;RESET PARAMETER
WINCL1:	PUSHJ	P,WNCLST	;CLEAR WINDOWING
	PUSHJ	P,DISPLL	;RE-DISPLAY THE SCREEN
	JRST	DISCUR		;POSITION THE CURSOR AND LOOP

WNCLST::TLZN	TM,WDW		;GET OUT OF WINDOWING - IN IT?
	POPJ	P,		;NO - DO NOTHING
	SETZM	HOMPOS		;PUT HOME BACK HOME
	DMOVE	T1,SAVRUP	;RESTORE SAVED ROLL UP AND DOWN
	DMOVEM	T1,RUP(TM)
	DMOVE	T1,SAVILN	;RESTORE SAVED INSERT AND DELETE LINE
	MOVEM	T1,ILN(TM)
	MOVEM	T2,DLN(TM)
	MOVE	T1,SAVCPG	;RESTORE CLEAR-TO-EOP, TOO
	MOVEM	T1,CPG(TM)
	MOVE	T3,SAVLPP	;SET UP FULL SCREEN LENGTH
	JRST	SWHLPP		;ALSO SET UP AS LINES PER PAGE, AND RETURN

WINSET::TLOE	TM,WDW		;ALREADY IN A WINDOW?
	JRST	WINCL1		;YES - CANCEL WINDOWING
	MOVE	T3,LPP(TM)	;GET THE SCREEN LENGTH
	MOVEM	T3,SAVLPP	;SAVE IT FOR AFTER WINDOWING
	LSH	T3,-1		;DIVIDE IN TWO, ONE FOR EACH WINDOW
	CAML	RW,T3		;IS CURSOR BELOW WINDOW?
	SETZB	RW,CM		;YES - MOVE IT HOME
	TLO	F,XPL!XPC!XPB	;CURSOR, LINE, BOTTOM POINTERS ARE BAD
	SETZB	T1,T2		;CLEAR AND GET
	EXCH	T1,RUP(TM)	;  ROLL UP AND ROLL DOWN SEQUENCES
	EXCH	T2,RLD(TM)	;  (SO ROLLS WON'T BE DONE)
	DMOVEM	T1,SAVRUP	;SAVE THEM
	SETZB	T1,T2		;SAME WITH INSERT AND DELETE LINE SEQUENCES
	EXCH	T1,ILN(TM)	;  (IN THE UPPER WINDOW ONLY)
	EXCH	T2,DLN(TM)
	DMOVEM	T1,SAVILN	;SAVE THEM
	PUSHJ	P,SWHLPP	;ALSO SET UP AS LINES PER PAGE
	MOVEI	T1,"^"		;GET UPWARD-POINTING SEPARATOR
	PUSHJ	P,WINSEP	;PUT WINDOW SEPARATOR UP
	SKIPE	CPG(TM)		;IS THERE A CLEAR-TO-EOP SEQUENCE?
	PUSHJ	P,CLEARP	;YES - DO IT
	SETZB	T1,WINDIS	;CLEAR AND SAVE
	EXCH	T1,CPG(TM)	;  SEQUENCE FOR CLEAR-TO-EOP
	MOVEM	T1,SAVCPG
	JRST	DISCUR		;RE-POSITION THE CURSOR; DONE

;SUBROUTINE TO OUTPUT WINDOW SEPARATOR ON LINE (T3)
;ENTER WITH SEPARATOR CHARACTER IN T1

WINSEP:	PUSH	P,T1		;SAVE SEPARATOR CHARACTER
	MOVE	T4,T3		;PUT POSITION IN THE RIGHT AC
	PUSHJ	P,POSLIN	;MOVE TO THE START OF LINE (T4)
	MOVE	T2,CPL.1
	SUBI	T2,5
	PUSHJ	P,PROTON	;OUTPUT A PROTECTED SEPARATOR
	POP	P,T1
	IDPB	T1,TY
	SOJG	T2,.-1
	PUSHJ	P,PROTOF
	JRST	PUTTYP		;OUTPUT AND RETURN

;************************************************************************
;SUBROUTINE TO SAVE THE CURRENT FILE
;TOPS10: ENTER WITH ADDRESS OF FILBLK OR OLDBLK SET UP IN AC PT
;BOTH:	 ENTER WITH ADDRESS OF FILSPC OR OLDSPC SET UP IN AC T4

SAVFIL::
IFE TOPS10,<
	TRZ	F,GFL		;SAY FILE IS NO LONGER AROUND
>
	TRNN	F,RDO		;IS FILE READ-ONLY?
	TLZN	F,CHG		;NO - HAS IT BEEN MODIFIED?
	JRST	SAVFNO		;READ-ONLY OR NOT MODIFIED - DON'T SAVE FILE
	PUSHJ	P,SAVMGS	;YES - OUTPUT FILE-MODIFIED MESSAGE
IFN TOPS10,<
	MOVEM	PT,SAVEAC+1	;SAVE POINTER TO TOPS10 FILE DATA
	SKIPE	TAGFLG		;WANT TO PUT A TAG LINE AT START OF FILE?
	PUSHJ	P,SAVTAG	;YES - DO SO
	PUSHJ	P,TRAILL	;CHOP OUT TRAILING SPACES AND NULLS
	MOVE	PT,SAVEAC+1	;RESTORE TOPS10 POINTER
SAVFLC::
>
IFE TOPS10,<
	SETZ	T1,		;MAKE SURE ENDING CHARACTERS ARE NULLS
	MOVE	T2,EN
	DPB	T1,T2
	IDPB	T1,T2
	PUSHJ	P,SVFSET	;GET THE OUTPUT JFN
	SKIPE	TAGFLG		;WANT TO PUT A TAG LINE AT START OF FILE?
	PUSHJ	P,SAVTAG	;YES - DO SO
	PUSHJ	P,TRAILL	;CHOP OUT TRAILING SPACES AND NULLS
>
SAVFL1:	SETZ	T1,		;MAKE SURE THE REST OF LAST WORD IS NULL
	MOVE	T2,EN
	IDPB	T1,T2
	IDPB	T1,T2
	IDPB	T1,T2
	IDPB	T1,T2
	IDPB	T1,T2
	SETZM	(T2)
	MOVEI	T1,1(T2)	;THEN NULL OUT FROM END OF FILE
	HRL	T1,T2		;(TO END OF CORE OR END OF PAGE)
IFN TOPS10,<
	MOVE	EN,T2
	HRRZ	T2,.JBREL	;TO END OF CORE
	BLT	T1,(T2)
	OPEN	3,(PT)		;SET UP CHANNEL FOR THE EXISTING FILE
	  HALT
	DMOVE	T0,5(PT)	;GET FILE NAME AND EXTENSION
	SETZ	T2,
	MOVE	T3,4(PT)	;GET FILE PPN
	SKIPN	CHGSPC		;ARE SPECS UNCHANGED,
	SKIPN	BAKFLG		;AND IS A BACKUP FILE WANTED?
	JRST	SAVFLB		;NOT BOTH - NO BACKUP
	MOVSI	T1,'BAK'	;YES - SET UP A BACKUP FLAVORED FILE
	DMOVEM	T0,BAKFIL	;SAVE BACKUP NAME AND EXT
	MOVEM	T3,BAKFIL+3	;SAVE BACKUP PPN
	OPEN	5,(PT)		;ELIMINATE CURRENT BACKUP FILE (IF ANY)
	  HALT
	LOOKUP	5,BAKFIL
	  CAIA			;(DON'T DO IT IF IT'S NOT THERE)
	RENAME	5,DELFIL
	  JFCL
	RELEAS	5,
	DMOVEM	T0,BAKFIL	;GET A CLEAN LOOKUP BLOCK
	DMOVEM	T2,BAKFIL+2
	LOOKUP	3,3(PT)		;RENAME THE OLD FILE TO *.BAK
	  JRST	SAVFLA+1	;IF NONE, DON'T WORRY ABOUT IT
	LDB	T1,[POINT 9,7(PT),8] ;ELSE GET THE FILE PROTECTION
	CAIGE	T1,300		;IS IT BETWEEN 200 AND 277?
	CAIGE	T1,200
	  JRST	SAVFLA		;NO - NO NEED TO LOWER THE PROTECTION
	DMOVE	T0,5(PT)	;YES - GET THE ORIGINAL FILENAME
	HLLZ	T1,T1		;ZERO THE UNWANTED PART
	DMOVEM	T0,PRTFIL	;AND SAVE IT
	DMOVEM	T2,PRTFIL+2	;SET UP THE REST OF THE BLOCK
	LDB	T1,[POINT 9,7(PT),8] ;GET THE PROTECTION
	XORI	T1,300		;MAKE IT IN THE 100'S
	DPB	T1,[POINT 9,PRTFIL+2,8]	;AND SAVE IT
	RENAME	3,PRTFIL	;LOWER THE PROTECTION
	  JFCL			;IGNORE THE ERROR
SAVFLA:	RENAME	3,BAKFIL
	  JFCL
	CLOSE	3,
	HLL	T1,6(PT)	;GET REAL FILE'S EXTENSION
	HLLZ	T2,7(PT)	;  AND ITS PROTECTION
	TLZ	T2,000777
	DMOVEM	T0,5(PT)	;SET UP EXT AND PROTECTION IN FILE BLOCK
	MOVEM	T2,7(PT)	;SAVE FILE PROTECTION
	MOVEM	T3,4(PT)	;  AND PPN

SAVFLB:
IFE FTSFD,<
	SETZM	3+11(PT)	;ALLOW FILE NOT TO BE CONTIGUOUS IF NECESSARY
>
	ENTER	3,3(PT)		;FIND THE FILE AGAIN (FOR OUTPUT)
	  JRST	SVEERR		;ERROR - OVER QUOTA OR DISK FULL
	DMOVEM	T0,5(PT)	;CLEAN UP FILE BLOCK
	MOVEM	T2,7(PT)
	MOVEM	T3,4(PT)
	MOVE	T1,EN
	SUBI	T1,BUFFER
	MOVN	T1,T1
	HRLM	T1,FILCCL	;SET UP FILE SIZE IN COMMAND
	OUTPUT	3,FILCCL	;OUTPUT THE ENTIRE FILE
	RELEAS	3,		;CLOSE THE FILE UP
>
IFE TOPS10,<
	HRRZ	T2,EN		;CLEAR TO END OF PAGE
	TRO	T2,777
	BLT	T1,(T2)

SAVFLB:	LDB	T1,EN		;BACK UP END PTR TO LAST REAL CHARACTER
	JUMPN	T1,SAVFB1	;DONE IF NON-NULL
	ADD	EN,[70000,,0]	;ELSE BACK UP A NOTCH
	CAIGE	EN,0
	SUB	EN,[430000,,1]
	JRST	SAVFLB		;AND TRY THE PREVIOUS CHARACTER

SAVFB1:	HRRZI	T1,1(EN)	;FIND FINAL FILE SIZE
	SUBI	T1,BUFFER
	MOVE	T3,T1		;FIND IT IN BYTES
	ADDI	T3,777		;ROUND TO NEXT HIGHER PAGE
	LSH	T3,-11
	MOVEM	T3,FILBSZ

	SOJ	T1,		;FIND IT IN CHARACTERS
	IMULI	T1,5
	HLRZ	T0,EN		;GET POINTER PART OF POINTER
	SETZ	T2,		;FIND NUMBER OF CHARACTERS IN FINAL WORD
	CAME	T0,PTRTBL(T2)
	AOJA	T2,.-1
	ADD	T1,T2
	MOVEM	T1,FILSIZ

	MOVE	T1,SAVCAP	;GET THE USER'S CAPABILITIES
	TRNE	T1,SC%WHL+SC%OPR ;IS HE WHEEL OR OPERATOR?
	JRST	SAVFB3		;YES - DON'T ENFORCE THE DIRECTORY QUOTA
	SETZM	SAVEAC		;CLEAR BEEN-HERE-ONCE FLAG
	MOVSI	T1,(RC%EMO)	;GET THE DIRECTORY NUMBER
	MOVE	T2,OUTJFN	;  OF THE OUTPUT FILESPEC
	RCDIR			;(MAKE IT AN EXACT MATCH)
	MOVE	T1,T3
	MOVE	T4,T3		;SAVE THE DIRECTORY NUMBER
SAVFB2:	GTDAL			;GET THE DISK ALLOCATION
	SUB	T1,T2		;FIND HOW MUCH WILL BE LEFT
	SUB	T1,FILBSZ	;  AFTER THIS FILE HAS BEEN SAVED
	JUMPG	T1,SAVFB3	;JUMP IS THERE IS ENOUGH ROOM
	EXCH	T4,SAVEAC	;SAVE DIRECTORY NUMBER AND GET WHAT'S THERE
	JUMPN	T4,SVERR0	;ERROR IF BEEN HERE ONCE & STILL NOT ENOUGH ROOM
	MOVEI	T1,[ASCIZ/Quota exceeded or disk full - Expunging directory/]
	PUSHJ	P,ERRDSP	;TELL THE USER WHAT'S GOING ON
	MOVE	T2,SAVEAC	;GET THE DIRECTORY NUMBER
	SETZ	T1,
	DELDF			;EXPUNGE THAT DIRECTORY
	MOVE	T1,SAVEAC	;GET THE DIRECTORY NUMBER
	JRST	SAVFB2		;SEE IF THERE'S ENOUGH ROOM NOW

SAVFB3:	MOVE	T1,OUTJFN	;GET THE OUTPUT JFN
	MOVEI	T2,OF%THW+OF%WR	;OPEN THE FILE FOR WRITING
	OPENF
	  ERJMP	SVEERR		;IF CAN'T, JUST FINISH OFF
	MOVE	T1,[400000,,BUFBLK]
	HRLZ	T2,OUTJFN	;WRITE ALL OF BUFFER INTO FILE
	MOVE	T3,[PM%CNT+PM%WR]
	ADD	T3,FILBSZ
	PMAP

	SKIPN	CHGSPC		;ARE SPECS UNCHANGED,
	SKIPN	BAKFLG		;AND IS A BACKUP FILE WANTED?
	JRST	NOBAK		;NOT BOTH - NO BACKUP
	HRROI	T1,BAKSPC	;YES - GET BACKUP SPECS
	MOVE	T2,INJFN	;  WITH INPUT FILE NAME
	MOVE	T3,[221000,,1]
	SETZ	T4,
	JFNS
	  ERJMP	NBKERR		;FAILED - NO BACKUP
	HRROI	T2,[ASCII /.BAK/] ;CHANGE EXTENSION TO .BAK
	MOVNI	T3,5
	SOUT			;MOVE THE STRING
	  ERJMP	NBKERR		;FAILED - NO BACKUP
	MOVSI	T1,(GJ%FOU+GJ%SHT) ;OPEN THE BACKUP FILE
	HRROI	T2,BAKSPC
	GTJFN
	  ERJMP	NBKERR		;FAILED - NO BACKUP
	MOVE	T2,T1
	MOVE	T3,T1
	MOVE	T1,INJFN	;SET TO RENAME THE ORIGINAL FILE
	RNAMF
	  ERJMP	NBKERR		;FAILED - NO BACKUP
	SKIPA	T1,T3		;SET TO RELEASE THE BACKUP JFN
NOBAK:	MOVE	T1,INJFN	;(OR RELEASE THE INPUT JFN)
	RLJFN
	  JFCL
	HRLI	T1,(CO%NRJ)	;CLOSE FILE; DON'T RELEASE JFN
	HRR	T1,OUTJFN
	CLOSF
	  JRST	SVEERR
	HRLI	T1,.FBSIZ	;CHANGE FILE SIZE IN DESCRIPTOR BLOCK
	OR	T1,[CF%NUD]
	SETO	T2,
	MOVE	T3,FILSIZ
	CHFDB
	HRLI	T1,.FBBYV	;TELL FILE ITS BYTE SIZE IS NOW 7
	MOVE	T2,[FB%BSZ]
	MOVSI	T3,700
	CHFDB
	MOVE	T1,OUTJFN	;NOW RELEASE THE JFN
	RLJFN
	  JRST	SVEERR
>
	POPJ	P,

IFE TOPS10,<
;ENTER AT SAVFLC FOR INCREMENTAL SAVES AND THE SAVE COMMAND

SAVFLC::PUSHJ	P,SVFST1	;GET OUTPUT JFN - DON'T BUMP VERSION
	JRST	SAVFL1		;JUMP INTO THE FLOW

SVFSET:	MOVE	T1,EXTTBL	;IS .TMP THE EXTENSION OF THIS FILE?
	CAMN	T1,[ASCII /TMP/]
SVFST1:	SKIPA	T1,[GJ%SHT]	;YES - DON'T BUMP VERSION NUMBER (ELSE DO)
	MOVE	T1,[GJ%FOU+GJ%SHT]
	HRRO	T2,T4		;GET A JFN FOR THE OUTPUT FILE
	GTJFN
	  ERJMP	SVEERR		;OOPS - FILE IS READ-ONLY - JUST FINISH OFF
	HRRZM	T1,OUTJFN	;SAVE THE OUTPUT JFN
	POPJ	P,		;DONE
>
SAVFNO:
IFE TOPS10,<
	MOVE	T1,INJFN	;RELEASE THE INPUT JFN
	RLJFN
	  JFCL
>
	PUSHJ	P,SAVMGN	;TELL USER THAT FILE IS NOT CHANGED
	SNOOZE	^D0700		;SLEEP A BIT
	POPJ	P,

IFE TOPS10,<
NBKERR:	MOVEI	T1,[ASCIZ / *Error - no backup file generated* /]
	PUSHJ	P,PUTSTG	;OUTPUT THE ERROR MESSAGE
	PUSHJ	P,PUTTYP
	JRST	NOBAK		;GO FINISH OFF

SVERR0:	TRO	F,GFL		;SAY FILE REALLY IS AROUND
>
SVEERR:	TLO	F,CHG		;REMEMBER THAT FILE WAS CHANGED
	IBP	EN		;POINT BEYOND THE LAST CHARACTER OF THE FILE
	MOVEI	T1,[ASCIZ /Can't save - quota exceeded or disk full/]
	HRRZ	T2,DO		;IS THIS PART OF A SET-FILE COMMAND?
	CAIN	T2,$SETFI
	JRST	STFERR		;YES - TREAT IT AS A SET-FILE ERROR
	PUSHJ	P,ERRDSP	;NO - OUTPUT THE MESSAGE
IFN TOPS10,<				;is this necessary?
	PUSHJ	P,INITTY	;RE-INIT THE TERMINAL
>
	PUSHJ	P,DISPLL	;RE-DISPLAY THE SCREEN
	MOVE	P,[IOWD STKSIZ,STACK]
	JRST	DISCUR		;WAIT FOR FURTHER INSTRUCTIONS

;SUBROUTINE TO PUT A TAG LINE AT THE START OF THE FILE BEFORE IT'S SAVED.
;THE TAG LOOKS LIKE: ";<CHALL>SED.MAC.1, 11-Mar-82 09:25:27, Edit by CHALL"

SAVTAG:	MOVEM	TY,SAVEAC	;SAVE THE TYPE-OUT BUFFER POINTER
	MOVEI	T1,^D100	;INSERT 100 NULLS
	MOVEM	T1,NUMCHR
	MOVE	TY,[010700,,BUFFER-1]
	MOVEM	TY,CHRPTR	;AT THE START OF THE FILE
	HRRZ	T1,DISPTR	;TELL MAKNUL TO ADJUST THE DISPLAY POINTER
	MOVEM	T1,ADJWRD
	TLO	F,XPB!XPL!XPC	;POINTERS ARE NO LONGER VALID
	PUSHJ	P,MAKNUL	;AND POINT TO START OF FILE
	SETZ	T1,		;CLEAR AND GET ADJUSTED DISPLAY ADDRESS
	EXCH	T1,ADJWRD
	MOVE	T2,DISPTR	;AT THE START OF THE FILE?
	CAMN	T2,[010700,,BUFFER-1]
	AOJA	RW,SAVTG0	;YES - LEAVE DISPTR ALONE; MOVE ONE ROW DOWN
	HRRM	T1,DISPTR	;SAVE IT WITH THE DISPLAY POINTER
SAVTG0:	MOVEI	T1,TAGFLG	;GET THE STARTING COMMENT CHARACTER(S)
	PUSHJ	P,PUTSTG	;OUTPUT IT (THEM)
IFN TOPS10,<
	MOVEI	T1,FILSPC	;OUTPUT THE CURRENT FILESPECS
	PUSHJ	P,PUTSTG
	MOVEI	T3,","		;DELIMIT WITH COMMA, SPACE
	IDPB	T3,TY
	MOVEI	T3," "
	IDPB	T3,TY

	MOVS	T4,[60,,11]	;SET UP INDEX FOR DATES IN CONFIG TABLE
	PUSHJ	P,SAVTAD	;READ DAY
	PUSHJ	P,SVTATN 	;OUTPUT IT AS TWO DIGITS
	PUSHJ	P,SAVTAD 	;READ MONTH
	MOVE	T1,MONTAB-1(T1)	;GET ITS NAME
	PUSHJ	P,PUTSQ1 	;OUTPUT IT
	PUSHJ	P,SAVTAD 	;READ YEAR
	PUSHJ	P,PUTNUM 	;OUTPUT IT
	IDPB	T3,TY		;SEPARATE DATE FROM TIME WITH A SPACE

	MOVS	T4,[61,,11]	;SET UP INDEX FOR TIMES IN CONFIG TABLE
	MOVEI	T3,":"		;GET A COLON FOR DELIMITING
	PUSHJ	P,SAVTAT 	;READ AND OUTPUT THE HOUR
	IDPB	T3,TY		;DELIMIT WITH A COLON
	PUSHJ	P,SAVTAT 	;READ AND OUTPUT THE MINUTE
	IDPB	T3,TY		;DELIMIT WITH A COLON
	PUSHJ	P,SAVTAT 	;READ AND OUTPUT THE SECOND
>
IFE TOPS10,<
	MOVE	T1,TY		;SET UP POINTER FOR JSYS'S
	MOVE	T2,OUTJFN	;GET THE JFN OF THE OUTPUT FILE
	MOVE	T3,[2B2+1B5+1B8+1B11+1B14+1B35]
	JFNS			;OUTPUT THE COMPLETE FILESPEC
	MOVEI	T2,","		;DELIMIT WITH COMMA, SPACE
	IDPB	T2,T1
	MOVEI	T2," "
	IDPB	T2,T1
	SETO	T2,		;OUTPUT THE CURRENT DATE AND TIME
	SETZ	T3,
	ODTIM
	MOVE	TY,T1		;UPDATE THE CHARACTER POINTER
>
	MOVEI	T1,[ASCIZ /, Edit by /]
	PUSHJ	P,PUTSTG
IFN TOPS10,<
	MOVE	PT,TY
	PJOB	T4,		;GET JOB NUMBER
	HRL	T2,T4
	HRRI	T2,31		;READ FIRST PART OF USER NAME
	GETTAB	T2,
	  SETZ	T2,		;(IT BETTER WORK)
	PUSHJ	P,PUTSIX	;OUTPUT THE SIXBIT FIRST PART
	HRL	T2,T4
	HRRI	T2,32		;READ SECOND PART OF USER NAME
	GETTAB	T2,
	  SETZ	T2,
	PUSHJ	P,PUTSIX	;OUTPUT THE SIXBIT SECOND PART
	MOVE	TY,PT		;PUT THE POINTER BACK IN AC TY
>
IFE TOPS10,<
	GJINF			;GET LOGGED-IN DIRECTORY NUMBER
	MOVE	T2,T1		;PUT IN THE RIGHT PLACE FOR DIRST
	MOVE	T1,TY
	DIRST			;WRITE USER NAME
	 PUSHJ	P,SAVTGN	;UNKNOWN - SAY SO
	MOVE	TY,T1		;PUT THE POINTER BACK IN AC TY
>
	SKIPE	T1,TAGFG1	;ARE THERE ANY ENDING COMMENT CHARACTER(S)?
	PUSHJ	P,PUTSQ1	;YES - CLOSE THE COMMENT
SAVTGE:	MOVEI	T1,15		;END WITH A CRLF
	IDPB	T1,TY
	MOVEI	T1,12
	IDPB	T1,TY
	MOVE	TY,SAVEAC	;GET THE READ TYPE-OUT BUFFER POINTER BACK
	POPJ	P,		;DONE

IFE TOPS10,<
SAVTGN:	MOVEI	T1,[ASCIZ /Unknown user
/]
	JRST	PUTSTG		;DIRST FAILED - SAY SOMETHING USEFUL & RETURN
>
IFN TOPS10,<
SAVTAD:	MOVS	T1,T4		;READ THE NEXT DATE TABLE ENTRY
	GETTAB	T1,
	  HALT			;(IT BETTER WORK)
	SOJA	T4,CPOPJ

SAVTAT:	MOVS	T1,T4		;READ THE NEXT TIME TABLE ENTRY
	AOJ	T4,
	GETTAB	T1,
	  HALT			;(IT BETTER WORK)
SVTATN:	IDIVI	T1,^D10		;SEPARATE INTO TWO DIGITS
	ADDI	T1,"0"		;MAKE THEM BOTH ASCII
	ADDI	T2,"0"
	IDPB	T1,TY		;SAVE THEM
	IDPB	T2,TY
	POPJ	P,

MONTAB:	ASCII	/-Jan-/		;TABLE OF NAMES OF MONTHS
	ASCII	/-Feb-/
	ASCII	/-Mar-/
	ASCII	/-Apr-/
	ASCII	/-May-/
	ASCII	/-Jun-/
	ASCII	/-Jul-/
	ASCII	/-Aug-/
	ASCII	/-Sep-/
	ASCII	/-Oct-/
	ASCII	/-Nov-/
	ASCII	/-Dec-/
>
;ROUTINES TO OUTPUT FILE SAVE MESSAGES
;ENTER WITH T4/ ADDR OF OLDSPC OR FILSPC (WHICHEVER IS CURRENT FILE)

SAVMGN::TLNE	TM,WDW		;IN A WINDOW?
	POPJ	P,		;YES - NO MESSAGE
	PUSHJ	P,CLRALL	;TELL USER THAT FILE IS NOT CHANGED
	MOVEI	T1,[ASCIZ /NOT MODIFIED: /]
	PUSHJ	P,PUTSTG
	MOVE	T1,T4		;OUTPUT FILESPECS
	PUSHJ	P,PUTSTG
	JRST	SAVMG1

SAVMGS:	TLNE	TM,WDW		;IN A WINDOW?
	POPJ	P,		;YES - NO MESSAGE
	PUSHJ	P,CLRALL
	MOVEI	T1,[ASCIZ /SAVING FILE: /]
	PUSHJ	P,PUTSTG
	MOVE	T1,T4		;OUTPUT FILESPECS
	PUSHJ	P,PUTSTG
	SKIPN	CHGSPC		;ARE SPECS UNCHANGED,
	SKIPN	BAKFLG		;AND IS A BACKUP FILE WANTED?
	SKIPA	T1,[[ASCIZ / (NO BACKUP)/]]
	MOVEI	T1,[ASCIZ / (WITH BACKUP)/]
	PUSHJ	P,PUTSTG

SAVMG1:	MOVEI	T1,15		;END WITH A CARRIAGE RETURN
	IDPB	T1,TY
	MOVEI	T1,12
	IDPB	T1,TY
	JRST	PUTTYP

;************************************************************************
;SUBROUTINE TO PARSE THE FILE SPECS IN FILSPC INTO THE OPEN AND LOOKUP BLOCKS
;ALSO HANDLES SWITCHES. IF TOPS20, PARSEF HANDLES ONLY SWITCHES

PARSFN:
IFN TOPS10,<
	MOVEI	T1,2		;SET UP CURRENT PATH AS DEFAULT
PARFN1:	MOVE	T2,OLDPTH(T1)	;(THIS IS USED ONLY IN SETNPM,
	MOVEM	T2,FILPTH(T1)	; FOR THE 2ND FILE IN .TMP OR
	JUMPE	T2,PARSEF	; AN INDIRECT FILE)
	AOJA	T1,PARFN1

PARSEF::MOVE	PT,[POINT 7,FILSPC]
	MOVEI	T1,16		;SET UP OPEN BLOCK
	MOVSI	T2,'DSK'	;  (MODE AND DEVICE)
	DMOVEM	T1,FILBLK
	SETZB	T1,T2		;ZERO OUT FILE SPEC AREA
	DMOVEM	T1,FILFIL+1	;(NOTE: PATH STAYS THE SAME AS LAST TIME
	DMOVEM	T1,FILFIL+3	; UNTIL USER GIVES A PPN)
	SETZM	FILFIL+5
IFE FTSFD,<
	SETZM	FILPPN
>

PARSF0:	MOVE	T4,[POINT 6,FILFIL+2]
	MOVEI	T0,^D9		;SAVE AT MOST 9 CHARACTERS
PARSF1:	ILDB	T1,PT		;GET A CHARACTER
	JUMPE	T1,CPOPJ	;DONE, IF NULL
	CAIN	T1,11		;(TREAT TAB LIKE A NULL)
	POPJ	P,
	CAIN	T1," "		;IGNORE SPACES
	JRST	PARSF1
	CAIN	T1,":"		;END OF DEVICE?
	JRST	PARSED		;YES - GO SET DEVICE UP
	CAIN	T1,"."		;START OF EXTENSION?
	JRST	PARSEE		;YES - GO PARSE IT
	CAIN	T1,"["		;START OF PPN?
	JRST	PARSEP		;YES - GO PARSE IT
	CAIN	T1,"/"		;START OF SWITCHES?
	JRST	PARSES		;YES - GO HANDLE THEM
	CAIL	T1,"a"		;LOWER CASE?
	TRZA	T1,100		;YES - CONVERT TO SIXBIT
	SUBI	T1,40		;NO - CONVERT TO SIXBIT
	JUMPL	T1,PRSERR	;ERROR IF CHARACTER IS NOT ALPHANUMERIC
	CAIGE	T1,'0'
	JRST	PRSERR
	CAIG	T1,'9'
	JRST	PARSF2
	CAIL	T1,'A'
	CAILE	T1,'Z'
	JRST	PRSERR

PARSF2:	SOJL	T0,PARSF1	;IGNORE, IF GOT TOO MANY CHARACTERS
	IDPB	T1,T4		;ELSE SAVE IT
	JRST	PARSF1		;AND GET ANOTHER

PARSED:	SKIPN	T1,FILFIL+2	;GET DEVICE NAME - ANY?
	JRST	PRSERR		;NO - JUST A COLON - ERROR
	MOVEM	T1,FILBLK+1	;SAVE AS DEVICE
	SETZM	FILFIL+2	;CLEAR FILE NAME
	JRST	PARSF0		;GO GET FILE NAME AGAIN

PARSEE:	MOVE	T4,[POINT 6,FILFIL+3]
	MOVEI	T0,3		;SAVE AT MOST 3 CHARACTERS
PRSEE1:	ILDB	T1,PT		;GET A CHARACTER
	JUMPE	T1,CPOPJ	;DONE, IF NULL
	CAIE	T1,11		;IGNORE TABS
	CAIN	T1," "		;  AND SPACES
	JRST	PRSEE1
	CAIN	T1,"["		;START OF PPN?
	JRST	PARSEP		;YES - GO PARSE IT
	CAIN	T1,"/"		;START OF SWITCHES?
	JRST	PARSES		;YES - GO HANDLE THEM
	CAIL	T1,"a"		;LOWER CASE?
	TRZA	T1,100		;YES - CONVERT TO SIXBIT
	SUBI	T1,40		;NO - CONVERT TO SIXBIT
	JUMPL	T1,PRSERR	;ERROR IF CHARACTER IS NOT ALPHANUMERIC
	CAIGE	T1,'0'
	JRST	PRSERR
	CAIG	T1,'9'
	JRST	PARSE2
	CAIL	T1,'A'
	CAILE	T1,'Z'
	JRST	PRSERR

PARSE2:	SOJL	T0,PRSEE1	;IGNORE, IF GOT TOO MANY CHARACTERS
	IDPB	T1,T4		;SAVE CHARACTER
	JRST	PRSEE1		;AND GET ANOTHER

PARSEP:	SETZ	T1,		;CLEAR TARGET
PARSP1:	ILDB	T2,PT		;GET CHARACTER OF PPN
	JUMPE	T2,PARSP3	;DONE IF NULL
	CAIN	T2,","		;END OF PROJECT NUMBER?
	JRST	PARSP2		;YES - SAVE IT AND GET PROG NUMBER
	CAIE	T2,"/"		;END OF PROGRAMMER NUMBER?
	CAIN	T2,"]"
	JRST	PARSP3		;YES - SAVE IT AND QUIT
	CAIL	T2,"0"		;ERROR IF NOT OCTAL
	CAILE	T2,"7"
	JRST	PRSERR
	ROT	T2,-3		;ELSE SHIFT IT INTO TARGET
	LSHC	T1,3
	JRST	PARSP1		;AND GET SOME MORE

IFN FTSFD,<
PARSP2:	TLOE	F,FLG		;IT THIS PROGRAMMER NUMBER?
	JRST	PARSSF		;YES - THERE'S AN SFD COMING
	JUMPE	T1,PARSEP	;NO - IF NOTHING THERE, DON'T SAVE
	HRLM	T1,FILPTH+2	;ELSE SAVE PROJECT NUMBER
	JRST	PARSEP		;AND GET PROGRAMMER NUMBER

PARSSF:	SETZ	T2,		;FINISH OFF PPN
	PUSHJ	P,PARSP3+1
	TLZ	F,FLG		;CLEAR PROJECT NUMBER FLAG
	SETZ	T1,		;CLEAR SFD LEVEL COUNTER
PARSS0:	MOVE	T4,[POINT 6,T3]
	MOVEI	T0,^D6		;SAVE AT MOST 6 CHARACTERS
	SETZ	T3,		;CLEAR TARGET OF SFD NAME
PARSS1:	ILDB	T2,PT		;GET CHARACTER OF SFD
	JUMPE	T2,PARSS3	;DONE IF NULL
	CAIN	T2,","		;START OF ANOTHER SFD LEVEL?
	AOJA	T1,PARSS2	;YES - SET UP FOR IT
	CAIE	T2,"/"		;END OF SFDS?
	CAIN	T2,"]"
	JRST	PARSS3		;YES - SAVE IT AND QUIT
	CAIL	T2,"a"		;LOWER CASE?
	TRZA	T2,100		;YES - CONVERT TO SIXBIT
	SUBI	T2,40		;NO - CONVERT TO SIXBIT
	JUMPL	T2,PRSERR	;ERROR IF ILLEGAL SIXBIT
	CAILE	T2,77
	JRST	PRSERR
	IDPB	T2,T4		;O.K. - ADD TO SFD NAME
	SOJGE	T0,PARSS1	;AND GET SOME MORE
	JRST	PRSERR		;UNLESS COUNTED OUT

PARSS2:	CAIE	T3,0		;USE OLD SFD NAME IF NONE GIVEN
	MOVEM	T3,FILPTH+2(T1)	;ELSE SAVE SFD NAME
	CAIGE	T1,SFDLVL	;DOWN TOO MANY SFD LEVELS?
	JRST	PARSS0		;NO - GO PARSE THE NEXT LEVEL
	JRST	PRFERR		;YES - ERROR

PARSP3:	SETZM	FILPTH+3	;PATH ENDS WITH PPN
	CAIE	T1,0		;IS PROGRAMMER NUMBER NON-0?
	HRRM	T1,FILPTH+2	;YES - SAVE IT
	JUMPE	T2,CPOPJ	;DONE IF LAST CHARACTER WAS NULL
	CAIN	T2,"/"		;ELSE GOT SOME SWITCHES?
	JRST	PARSES		;YES - READ THEM, TOO
	JRST	PARSF0		;NO - SEE WHAT ELSE THERE IS

PARSS3:	CAIE	T3,0		;WANT DEFAULT FOR THIS SFD?
	MOVEM	T3,FILPTH+3(T1)	;NO - SAVE WHAT THE USER TYPED
	SETZM	FILPTH+4(T1)	;CLEAR WORD AFTER LAST SFD NAME
	JUMPE	T2,CPOPJ	;DONE IF LAST CHARACTER WAS NULL
	CAIE	T2,"/"		;ELSE GOT SOME SWITCHES?
	JRST	PARSF0		;NO - SEE WHAT ELSE THERE IS
>
IFE FTSFD,<
PARSP2:	HRLM	T1,FILFIL+1	;SAVE PROJECT NUMBER
	JRST	PARSEP		;AND GET PROGRAMMER NUMBER

PARSP3:	HLL	T1,FILFIL+1	;GET ENTIRE PPN
	TLNN	T1,-1		;MISSING THE PROJECT?
	HLL	T1,USRPPN	;YES - USE THE USER'S OWN
	TRNN	T1,-1		;MISSING THE PROGRAMMER?
	HRR	T1,USRPPN	;YES - USE THE USER'S OWN
	MOVEM	T1,FILFIL+1	;STORE ENTIRE PPN
	MOVEM	T1,FILPPN	;HERE, TOO
PARSS3:	JUMPE	T2,CPOPJ	;DONE IF LAST CHARACTER WAS NULL
	CAIE	T2,"/"		;ELSE GOT SOME SWITCHES?
	JRST	PARSF0		;NO - SEE WHAT ELSE THERE IS
>
PARSES:	SETZ	T1,		;NULL OUT THE FIRST SLASH
	DPB	T1,PT
	JRST	SWHMNY		;HANDLE THE SWITCHES AND RETURN

IFN FTSFD,<
PRFERR:	SKIPA	T1,[[ASCIZ /#########SFD level too deep/]]
>
PRSERR:	MOVEI	T1,[ASCIZ /###########Bad file specs/]
	SKIPG	OUTFLG		;PARSING SPECS FROM AN /OUT: SWITCH?
	JRST	STFERR		;NO - OUTPUT THE ERROR AND CONTINUE
	MOVS	T2,[FILSPC,,SVASPC]
	BLT	T2,FILSPC+SPCSIZ-1 ;YES - RESTORE ORIGINAL FILESPECS
	SETZM	OUTFLG		;SAY NO LONGER PARSING /OUT: SPECS
	MOVEI	T1,[ASCIZ /######Bad file specs in switch/]
	JRST	ERROR		;AND GIVE THE RIGHT ERROR MESSAGE
>
IFE TOPS10,<
PARSEF::MOVE	PT,[POINT 7,FILSPC]
	SETZM	SAVEAC+12	;CLEAR VERSION-NUMBER-GIVEN FLAG
	SETZB	T3,EXTPTR	;CLEAR FOUND-EXTENSION FLAG
	SETZ	T4,		;CLEAR POINTER TO EXTENSION
PARSF1:	ILDB	T1,PT		;GET A CHARACTER
	JUMPE	T1,PARSF2	;DONE IF NULL
	CAIN	T1,"."		;START OF EXTENSION?
	JRST	PARSFE		;MAYBE - CHECK AND SEE
	CAIN	T1,74		;START OF USER I.D.?
	JRST	PARSFU		;YES - GO SKIP OVER IT
	CAIE	T1,"/"		;START OF SWITCHES?
	JRST	PARSF1		;NO - KEEP LOOKING

PARSFS:	SETZ	T1,		;NULL OUT THE FIRST SLASH
	DPB	T1,PT
	PUSHJ	P,PARSF2	;SEE IF EXTENSION FOUND
	JRST	SWHMNY		;HANDLE THE SWITCHES AND RETURN

PARSFE:	CAIE	T4,0		;GOT ONE DOT ALREADY?
	SETOM	SAVEAC+12	;YES - FLAG THE START OF THE VERSION NUMBER
	MOVE	T4,PT		;SAVE POINTER TO THE DOT
	ILDB	T1,PT		;IF EXT IS JUST A DOT IT'S NOT AN EXT
	JUMPE	T1,PARSF2	;LIKE DOT<NULL> - DONE
	CAIN	T1,"/"		;START OF SWITCHES?
	JRST	PARSFS		;YES - GO DO THEM
	JRST	PARSF1		;NO - CONTINUE

PARSFU:	ILDB	T1,PT		;SKIP OVER USER I.D. - READ CHARACTER
	JUMPE	T1,PARSF2	;DONE IF NULL
	CAIN	T1,76		;END OF USER I.D.?
	JRST	PARSF1		;YES - BACK TO THE FLOW
	JRST	PARSFU		;NO - KEEP LOOKING

PARSF2:	JUMPN	T4,CPOPJ	;IF SOME EXTENSION FOUND JUST RETURN
	MOVEM	PT,EXTPTR	;SAVE PTR TO END OF SPECS (IE, START OF EXT)
	POPJ	P,
>
;SUBROUTINE TO UNPARSE THE FILE SPEC BLOCKS INTO FILSPC

IFN TOPS10,<
UNPARS:	MOVE	PT,[POINT 7,FILSPC]
	MOVE	T2,FILBLK+1	;GET DEVICE
	PUSHJ	P,PUTSIX	;OUTPUT IT
	MOVEI	T1,":"
	IDPB	T1,PT

	MOVE	T2,FILFIL+2	;SET UP FILE NAME
	PUSHJ	P,PUTSIX
	MOVEI	T1,"."
	IDPB	T1,PT
	HLLZ	T2,FILFIL+3	;SET UP EXTENSION
	PUSHJ	P,PUTSIX
	SKIPN	FILPPN		;IS THERE A PPN?
	JRST	UNPRSX		;NO - DON'T OUTPUT IT
	MOVEI	T1,"["		;START THE PPN
	IDPB	T1,PT

	SETO	T3,
	HLRZ	T1,FILPPN	;GET THE PROJECT
	SKIPA	T4,[","]	;GET SEPARATOR CHARACTER
UNPRSP:	HRRZ	T1,FILPPN	;GET THE PROGRAMMER
	MOVSI	T2,700000
	LSHC	T1,-3
	JUMPN	T1,.-1		;PUT NUMBER ENTIRELY IN T2
UNPSP1:	SETZ	T1,
	LSHC	T1,3		;GET A DIGIT IN T1
	JUMPE	T2,UNPSP2	;DONE IF NOTHING LEFT
	ADDI	T1,"0"
	IDPB	T1,PT
	JRST	UNPSP1

UNPSP2:	IDPB	T4,PT		;SAVE SEPARATOR OR END BRACKET
	MOVEI	T4,"]"		;GET THE END BRACKET
	AOJE	T3,UNPRSP	;IF DID PROJ, GO DO PROG
IFN FTSFD,<
	SETZ	T3,		;CLEAR SFD INDEX
UNPSSF:	SKIPN	T2,FILPTH+3(T3)	;GOT AN(OTHER) SFD NAME?
	JRST	UNPRSX		;NO - FINISH OFF
	MOVEI	T1,","		;YES - CHANGE BRACKET TO A COMMA
	DPB	T1,PT
	PUSHJ	P,PUTSIX	;OUTPUT SIXBIT SFD NAME
	IDPB	T4,PT		;END WITH A RIGHT BRACKET
	AOJA	T3,UNPSSF	;GET NEXT LEVEL, IF ANY
>
UNPRSX:	SETZ	T2,
	IDPB	T2,PT		;END WITH A NULL
	POPJ	P,		;AND RETURN

PUTSIX::SETZ	T1,		;GET A SIXBIT CHARACTER
	LSHC	T1,6
	JUMPE	T1,PUTSX2	;IF NULL CHECK TO SEE IF DONE
PUTSX1:	ADDI	T1,40		;ELSE CONVERT TO ASCII
	IDPB	T1,PT		;STORE CHARACTER
	JRST	PUTSIX		;AND LOOP

PUTSX2:	JUMPN	T2,PUTSX1	;GOT NULL OR SPACE - IF THERE IS MORE FOLLOWING
	POPJ	P,		;  OUTPUT THE SPACE, ELSE RETURN
>
IFE TOPS10,<
;UNPARSE - READ SPECS BACK FROM MONITOR. FIND EXTENSION AND SAVE FOR
;DEFAULTING NEXT TIME. EXPECTS JFN IN T1

UNPARS:	MOVE	T2,T1		;READ FILESPECS BACK INTO FILSPC
	HRROI	T1,FILSPC
	MOVE	T3,[221100,,1]
	SETZ	T4,
	JFNS			;AND FALL INTO:

;SUBROUTINE TO FIND AN EXTENSION IN THE FILESPECS AT (T4) AND SAVE IT AT (PT)

UNPEX0::MOVE	T4,[POINT 7,FILSPC]
	MOVE	PT,[POINT 7,EXTTBL]
	MOVEI	T0,5		;SET MAXIMUM EXTENSION SIZE TO 5 CHARACTERS
UNPEXT::ILDB	T1,T4		;GET A CHARACTER
	JUMPE	T1,CPOPJ	;DONE IF NULL
	CAIN	T1,"."		;START OF EXTENSION?
	JRST	UNPEXE		;YES - GO SAVE
	CAIE	T1,74		;START OF USER I.D.?
	JRST	UNPEXT		;NO - GET MORE

UNPEXU:	ILDB	T1,T4		;GET A CHARACTER OF THE USER I.D.
	JUMPE	T1,CPOPJ	;DONE IF NULL
	CAIN	T1,76		;END OF I.D.?
	JRST	UNPEXT		;YES - BACK TO THE MAIN FLOW
	JRST	UNPEXU		;NO - KEEP SKIPPING

UNPEXE:	ILDB	T1,T4		;GET A CHARACTER OF THE EXTENSION
	JUMPE	T1,CPOPJ	;DONE IF NULL
	CAIE	T1,"."		;START OF VERSION NUMBER,
	CAIN	T1,"/"		;  OR START OF SWITCHES?
	POPJ	P,		;YES - DONE
	SOJL	T0,UNPEXE	;SAVED MORE THAN FOUR EXTENSION CHARACTERS?
	IDPB	T1,PT		;NO - SAVE THIS ONE, TOO
	JRST	UNPEXE		;AND KEEP LOOKING
>
;HERE TO READ FILE.EXT INTO A NORMAL LOOKUP BLOCK
;FILESPEC TO PARSE IS IN (PT); TARGET ADDRESS IS IN (T3)
;DEFAULT EXTENSION IS IN T4

IFN TOPS10,<
PARSFX::MOVEM	T4,SAVEAC	;SAVE DEFAULT EXTENSION
	SETZB	T1,T2		;ZERO OUT FILE SPEC AREA
	DMOVEM	T1,0(T3)	;(NOTE: PATH STAYS THE SAME AS LAST TIME
	DMOVEM	T1,2(T3)	; UNTIL USER GIVES A PPN)
PARSP0:	MOVEI	T0,^D9		;SAVE AT MOST 9 CHARACTERS
	MOVE	T4,[POINT 6,(T3)]
PARFP1:	ILDB	T1,PT		;GET A CHARACTER
	JUMPE	T1,PARSPX	;DONE, IF NULL
	CAIN	T1,15		;ALSO DONE IF CR
	JRST	PARSPX
	CAIN	T1," "		;IGNORE SPACES
	JRST	PARFP1
	CAIN	T1,"."		;START OF EXTENSION?
	JRST	PARSPE		;YES - GO PARSE IT
	CAIN	T1,"["		;START OF PPN?
	JRST	PARSPP		;YES - GO PARSE IT
	CAIL	T1,"a"		;LOWER CASE?
	TRZA	T1,100		;YES - CONVERT TO SIXBIT
	SUBI	T1,40		;NO - CONVERT TO SIXBIT
	JUMPL	T1,PRPERR	;ERROR IF CHARACTER IS NOT ALPHANUMERIC
	CAIGE	T1,'0'
	JRST	PRPERR
	CAIG	T1,'9'
	JRST	PARFP2
	CAIL	T1,'A'
	CAILE	T1,'Z'
	JRST	PRPERR

PARFP2:	SOJL	T0,PARFP1	;IGNORE IF GOT TOO MANY CHARACTERS
	IDPB	T1,T4		;ELSE SAVE IT
	JRST	PARFP1		;AND GET ANOTHER

PARSPE:	MOVE	T4,[POINT 6,1(T3)]
	MOVEI	T0,3		;SAVE AT MOST 3 CHARACTERS
PRSPE1:	ILDB	T1,PT		;GET A CHARACTER
	JUMPE	T1,PARSPX	;DONE, IF NULL
	CAIN	T1,"["		;START OF PPN?
	JRST	PARSPP		;YES - GO PARSE IT
	CAIL	T1,"a"		;LOWER CASE?
	TRZA	T1,100		;YES - CONVERT TO SIXBIT
	SUBI	T1,40		;NO - CONVERT TO SIXBIT
	JUMPL	T1,PRPERR	;ERROR IF CHARACTER IS NOT ALPHANUMERIC
	CAIGE	T1,'0'
	JRST	PRPERR
	CAIG	T1,'9'
	JRST	PAREP2
	CAIL	T1,'A'
	CAILE	T1,'Z'
	JRST	PRPERR

PAREP2:	SOJL	T0,PRSPE1	;IGNORE, IF GOT TOO MANY CHARACTERS
	IDPB	T1,T4		;SAVE CHARACTER
	JRST	PRSPE1		;AND GET ANOTHER

PARSPP:	SETZ	T1,		;CLEAR TARGET
PARPP1:	ILDB	T2,PT		;GET CHARACTER OF PPN
	JUMPE	T2,PARPP3	;DONE IF NULL
	CAIN	T2,","		;END OF PROJECT NUMBER?
	JRST	PARPP2		;YES - SAVE IT AND GET PROG NUMBER
	CAIN	T2,"]"		;END OF PROGRAMMER NUMBER?
	JRST	PARPP3		;YES - SAVE IT AND QUIT
	CAIL	T2,"0"		;ERROR IF NOT OCTAL
	CAILE	T2,"7"
	JRST	PRPERR
	ROT	T2,-3		;ELSE SHIFT IT INTO TARGET
	LSHC	T1,3
	JRST	PARPP1		;AND GET SOME MORE

PARPP2:	HRLM	T1,3(T3)	;SAVE PROJECT NUMBER
	JRST	PARSPP		;AND GET PROGRAMMER NUMBER

PARPP3:	HRRM	T1,3(T3)	;SAVE PROGRAMMER NUMBER
	JUMPN	T2,PARSP0	;IF NOT END, SEE WHAT ELSE AWAITS
PARSPX:	MOVE	T1,SAVEAC	;GET DEFAULT EXTENSION
	SKIPN	1(T3)		;GOT AN EXTENSION?
	HRLM	T1,1(T3)	;NO - SAVE DEFAULT
	MOVE	T1,USRPPN	;GET USER'S PPN
	SKIPN	3(T3)		;DID USER GIVE ONE HERE?
	MOVEM	T1,3(T3)	;NO - SAVE USER'S
	POPJ	P,		;THEN RETURN

PRPERR:	MOVEI	T1,[ASCIZ /###########Bad file specs/]
	JRST	ERROR
>
IFE TOPS10,<
;TOPS20 - JUST MOVE SPECS FROM (PT) TO (T3)
;APPEND DEFAULT EXTENSION (IN T4) IF NONE GIVEN
;FILESPEC TO PARSE IS IN (PT); TARGET ADDRESS IS IN (T3)

PARSFX::SETZ	T0,		;CLEAR EXTENSION FLAG
PRSFX1:	ILDB	T1,PT		;GET A CHARACTER
	IDPB	T1,T3		;ELSE SAVE CHARACTER
	CAIN	T1,74		;GOT AN OPEN-BRACKET?
	JRST	PRSFXD		;YES - SKIP THE DIRECTORY
	CAIN	T1,"."		;GOT AN EXTENSION?
	SETO	T0,		;YES - SET FLAG
	JUMPN	T1,PRSFX1	;LOOP IF NOT NULL
	JUMPN	T0,CPOPJ	;RETURN IF EXTENSION GIVEN
	MOVEI	T1,"."		;ELSE APPEND EXTENSION
	DPB	T1,T3
	MOVEI	T0,4
	ROT	T4,7
	IDPB	T4,T3
	SOJG	T0,.-2
	POPJ	P,		;DONE

PRSFXD:	ILDB	T1,PT		;SKIP OVER DIRECTORY - GET A CHARACTER
	JUMPE	T1,CPOPJ	;DONE IF NULL
	CAIN	T1,76		;ELSE GOT A CLOSE BRACKET?
	JRST	PRSFX1		;YES - CONTINUE NORMAL PROCESSING
	JRST	PRSFXD		;NO - KEEP SKIPPING
>
	END