github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-05-04 23:35:54 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/sed/sed1fi.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1654 lines
51 KiB
Plaintext
Raw Blame History

TITLE SED1FI - SED SET-FILE AND WINDOW COMMANDS
SUBTTL A CHRISTOPHER HALL FECIT
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979,1983.
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
>
EXCH F,SAVEFG ;GET OLD FILE FLAGS
PUSHJ P,SAVFIL ;SAVE THE OLD FILE
EXCH F,SAVEFG ;GET NEW FILE'S FLAGS BACK
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: TLZ F,FLG ;CLEAR PROJECT FLAG
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
Reference in New Issue View Git Blame Copy Permalink