Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/sed-for-vms/sed1fi.mar
There are 5 other files named sed1fi.mar in the archive. Click here to see a list.
.TITLE SED1FI - SED Set-file and Window Commands
.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG
.NOCROSS ;Disable cross referencing while defining the symbols
FLGDEF ;Define the flag bits
PRMDEF ; and the SED parameters
TRMDEF ; and the terminal table offsets
$NAMDEF ; and the NAM block offsets
$RABDEF ; and the RAB block offsets
$XABFHCDEF ; and the fixed-header XAB block offsets
$XABPRODEF ; and the protection XAB block offsets
.CROSS ;Re-enable cross referencing
.SUBTITLE Set up a new file for editing
SETFIL::MOVL #1,SAVEAC+36 ;Set read-write flag positive (ie none)
MOVL F,SAVEAC ;Save the flags for later
BBCC #V_RDO,F,SETFLS ;Assume will write file - can write now?
BICL #M_CHG,F ;No - forget any changes that were made
BRB SETFS1
SETFLS::MOVL F,SAVEAC ;Save the flags for later
SETFS1: CLRB JRNCRE ;Clear the journal create flag
CLRB @PARPTR ;End parameter with a null
MOVAB PARBUF,R2
MOVZBL (R2)+,R1 ;Get first character of filespecs
CMPB R1,#^A"/" ;Got just a string of switches?
BNEQ SETFL0 ;No - continue
JSB RESTPM ;Yes - clear enter mode
JSB SWHMNY
TSTB AGNFLG ;Want to set the same file again?
BNEQ 10$
BRW SETNPM ;No - go set up the alternate file
10$: CLRB AGNFLG ;Yes - clear the again flag
MOVAB FILSPC,R3
MOVAB PARBUF,R4
SETAG0: MOVZBL (R3)+,R1 ;Move current filespecs to parm buffer
MOVB R1,(R4)+ ; as if the user typed them in
BNEQ SETAG0
MOVL R4,PARPTR ;Save pointer to end of parameter
SETFL0: $FAB_STORE FAB=INPUT_FAB,DNA=#0,DNS=#0 ;Clear the default extension
PUSHR #^M<R5>
MOVC3 #100,OLDSPC,SVASPC ;Save old specs to save area
MOVC3 #100,FILSPC,OLDSPC ;Save previous filespec
POPR #^M<R5>
MOVL OLDLEN,SVALEN ;Save length of old specs
MOVL OLDTYP,SVATYP ;Save type of old file
MOVL OLDTYP_SIZE,SVATYP_SIZE ; and the number of characters
MOVL FSPLEN,OLDLEN ;Save length of filespec
MOVL FSPTYP,OLDTYP ;Save the file type
MOVL FSPTYP_SIZE,OLDTYP_SIZE ; and the number of characters
MOVL SAVEAC,R1 ;Save the original current flags
BRB SETFC1
SETFLC::MOVL F,R1 ;Save the current flags
SETFC1: MOVL R1,SAVEFG
MOVL DISPTR,SAVEDP ;Save current display pointer
MOVL SL,SAVESL ;Save slide
MOVAB FILSPC,R3
JSB PELS.F ;Pick up user's filespec, if any
MOVL R1,FSPLEN ;Save length of filespec
MOVQ R7,SAVERW ;Save position again in case of cur mvmt
JSB ERASPM ;Erase parameter
CLRB WINDIS ;If windowing be sure to display the file
CLRL MFLPTR ;Forget indirect stuff if user gives a file
BBCC #V_IND,F,10$ ;Want to look at files indirectly
JMP SETIND ;Yes - handle separately
10$: JSB PNTSTT ;Set up pointers to start of the file
JSB PARSEF ;Parse filespec and (maybe) switches
BICL #M_PCM!M_FLG!M_FNC,F ;Clear mark and parse flags
SETFL1::BICL #M_ACH,F ;Assume file attributes will not change
PUSHR #^M<R2,R3,R4,R5>
MOVC5 #0,REAL_NAME,#0,#100,REAL_NAME ;Clear the filespec area
MOVC5 #0,RESULT_NAME,#0,#100,RESULT_NAME
POPR #^M<R2,R3,R4,R5>
BICL #M_FLG,F ;Clear flag from PARSEF
MOVL FSPLEN,R1 ;Get length of filespec
$FAB_STORE FAB=INPUT_FAB,FNS=R1,- ;Store it in the FAB
FOP=<MXV,SQO>,FAC=<BIO,GET>
$OPEN FAB=INPUT_FAB ;Open the file
BLBS R0,10$ ;Skip if no errors
BRW SETERR
10$: MOVZBL INPUT_FAB+FAB$B_ORG,R2 ;Get the file organization
CMPB R2,#FAB$C_SEQ ;Is it sequential?
BEQL 18$ ;Yes
$CLOSE FAB=INPUT_FAB ;No - we can't handle the file
MOVAB ORGUNKERM,R1 ;Assume we don't know the organization
CMPB R2,#FAB$C_REL ;Is it relative?
BNEQ 12$ ;No
MOVAB ORGRELERM,R1 ;Yes - point to the right message
BRB 16$
12$: CMPB R2,#FAB$C_IDX ;Is it indexed?
BNEQ 14$ ;No
MOVAB ORGIDXERM,R1 ;Yes - point to the right message
BRB 16$
14$: CMPB R2,#FAB$C_HSH ;Is it hashed format?
BNEQ 16$ ;No
MOVAB ORGHSHERM,R1 ;Yes - point to the right message
16$: JMP STFERR ;Go output the error message
18$: MOVB #-1,INJFN ;Say file has been set up
MOVL MAIN_XAB+XAB$L_EBK,R1 ;Get size of the file
SUBL #1,R1 ;Don't want to count last block
MULL #512,R1 ;Convert it to words
MOVZWL MAIN_XAB+XAB$W_FFB,R2 ;Get next byte to be written
ADDL3 R2,R1,FILSIZ ;Compute actual size of the file
CMPL FILSIZ,#MAX_FILE_SIZE ;Is file too large?
BLEQ 20$ ;No
BRW SSZERR ;Yes - error
20$: SUBL3 #BUFFER,DISPTR,R2 ;Get display pointer address
CMPL FILSIZ,R2 ;Is it pointing beyond the buffer?
BGEQ 30$ ;No
MOVAB BUFFER,DISPTR ;Yes - point to start of buffer
30$: MOVL R5,-(SP) ;Save R5 for a moment
MOVC3 #100,RESULT_NAME,FILSPC ;Save the real file spec
CLRB FILE_SAVED ;File hasn't been saved yet
MOVZBL MAIN_NAM+NAM$B_RSL,FSPLEN ;Save the length of the real filespec
MOVZBL MAIN_NAM+NAM$B_TYPE,FSPTYP_SIZE ;Save the size of the file type
MOVL #^A" ",FSPTYP ;Initialize the file type
MOVL MAIN_NAM+NAM$L_TYPE,R2 ;Get the address of the file type
MOVC3 FSPTYP_SIZE,(R2),FSPTYP ;Save the file type
MOVL (SP)+,R5 ;Restore R5
TSTL R9 ;Was a parameter given?
BLEQ SETF10 ;No
TSTB RSCANF ;Got a file from rescan?
BNEQ SETF10 ;Yes - don't save previous file
BBS #30,R9,SETF10 ;Working on an indirect file?
TSTL OLDSPC ; or was there no previous file?
BEQL SETF10 ;Either way don't save old file
JSB SAMFIL ;See if file is same as previous one
BBC #V_SMF,F,40$
$CLOSE FAB=INPUT_FAB ;It is, so close the file
BRW SETWIN ;Set the new position
40$: MOVAB OLDSPC,R4 ;Prepare to save the file
MOVAL OLDLEN,R6
MOVL SAVEDP,DISPTR
BSBW SAVFIL ;Save the old file
MOVL DISPTR,SAVEDP
MOVAB BUFFER,DISPTR
SETF10: CLRB RSCANF ;Clear file-from-rescan flag
;Need to check protection codes here
MOVL PROT_XAB+XAB$L_UIC,OUTPUT_XAB+XAB$L_UIC
MOVW PROT_XAB+XAB$W_PRO,OUTPUT_XAB+XAB$W_PRO
SETF1A: MOVAB EDIT_BUFF_END,PAGE_RANGE_TABLE+4 ;Set up the limits
MOVAB EDIT_BUFF_START,PAGE_RANGE_TABLE
$DELTVA_S INADR=PAGE_RANGE_TABLE ;Shrink memory back
ADDL3 #^X200,FILSIZ,R2 ;Round file size to block boundary
BICL #^X1FF,R2
SUBL3 FILSIZ,R2,SAVEAC ;Compute number of excess bytes to be read
ADDL3 #BUFFER,R2,PAGE_RANGE_TABLE+4 ;Compute new ending address
CMPL #EDIT_BUFF_START,PAGE_RANGE_TABLE+4 ;Is ending address before
BLEQ 5$ ;the start of the edit buffer?
MOVAB EDIT_BUFF_START,PAGE_RANGE_TABLE+4 ;Yes, don't wipe out anything
5$: $CRETVA_S INADR=PAGE_RANGE_TABLE ;Allow enough room for file
BLBS R0,10$
BRW SSZERR ;Error if couldn't create
10$: MOVL R5,-(SP) ;Save register 5 for a moment
MOVC5 #0,BUFFER,#0,#EDIT_BUFF_START-BUFFER-1,BUFFER ;Clear the buffer
MOVL (SP)+,R5
$CONNECT RAB=INPUT_RAB
BLBS R0,50$
BRW SETERR
;Read the file in here
50$: MOVL #1,R4 ;Point to the record number
MOVAB BUFFER,R3 ;Point to the buffer
MOVL FILSIZ,R2 ;Get the size of the file
ADDL #^X200,R2 ;Round file length to the next
BICL #^X1FF,R2 ; block boundary
60$: MOVL R4,INPUT_RAB+RAB$L_BKT ;Save the record number
MOVL R3,INPUT_RAB+RAB$L_UBF ;and the buffer address
CMPL R2,#^X8000 ;Do we need to read in chunks?
BGTR 70$ ;Yes
MOVW R2,INPUT_RAB+RAB$W_USZ ;Store the byte count
BRB 80$ ;and go read the chunk
70$: MOVW #^X8000,INPUT_RAB+RAB$W_USZ ;and the byte count
80$: $READ RAB=INPUT_RAB ;Read the blocks
;Need to check for errors here
ADDL #^X8000,R3 ;Increment the buffer pointer
ADDL #^X40,R4 ;and the block number
SUBL #^X8000,R2 ;Count down the file size
BGTR 60$ ;If more file is left, go get it
$DISCONNECT RAB=INPUT_RAB
BLBS R0,95$
BRW SETERR
95$: $CLOSE FAB=INPUT_FAB ;Close the file
TSTL SAVEAC ;Any bytes to clear?
BEQL 97$
PUSHR #^M<R5,R6> ;Yes - save some registers
ADDL3 #BUFFER,FILSIZ,R6 ;Compute starting address
MOVC5 #0,(R6),#0,SAVEAC,(R6) ;Clear the rest of the block
POPR #^M<R5,R6> ;Then restore the registers
97$: MOVB INPUT_FAB+FAB$B_RAT,REC_ATT ;Get the record attributes
MOVZBL INPUT_FAB+FAB$B_RFM,R1 ;Get the record format
MOVL CONV_TABLE[R1],R2 ;Get the address of the conversion routine
JSB (R2) ;Call the proper conversion routine
SETRDY: BISL #M_GFL,F ;Note that a file has been set up
BICL #M_FLG!M_PCM,F ;Clear extension and mark flags
TSTL DISPTR ;Want to use pre-set pointers?
BNEQ 100$ ;No
JSB PRESET ;Yes - set them up
100$: CLRL EEEPTR ;Clear free-extension pointer
BBC #V_JRW,F1,110$ ;Want to write a journal?
JSB JRNSTT ;Yes - start it up
110$: MOVL EN,R1 ;Get pointer to end of file
BRB SETCR0 ;Make sure file ends with a CRLF
SETCR: DECL R1 ;Back up end pointer a notch
SETCR0: MOVZBL (R1),R2 ;Get a character
BEQL SETCR ;Skip if null
CMPB R2,#^O12 ;Else got a linefeed?
BNEQ SETCR2 ;No - go add a CRLF
MOVZBL -1(R1),R2 ;Get previous character
CMPB R2,#^O15 ;Got a <CR>?
BEQL SETRDO ;Yes - O.K.
SETCR2: MOVL EN,R1
MOVW #^X0A0D,1(R1) ;Save <CRLF> as last word of file
ADDL #4,EN
;Now see if file is read-only
SETRDO: BBS #V_RDO,F,SETRD5 ;Is file already read-only? Yes
MOVL SAVEAC+36,R1 ;Did user give a read or write switch?
BLEQ SETRD3 ;Yes - let it override anything else
TSTB GREFLG ;No - should all files be marked read-only?
BEQL SETACH ;No
BRB SETRD5 ;Yes - set read-only
SETRD3: TSTL R1 ;If user gave read, set read-only
BGEQ SETACH ;Otherwise, continue
SETRD5: MOVAB RDOEM1,R1 ;Get address of warning message
JSB ERRDSP ;Yes - display the message
BISL #M_RDO,F ;Mark file read-only
BRB SETWIN ;and skip test for file attribute change
SETACH: BBC #V_ACH,F1,SETWIN ;Will file attributes change?
MOVAB ACHMSG,R1 ;Yes - output the warning
JSB ERRDSP
SETWIN: BBS #V_WDW,F1,5$ ;Want windowing?
1$: BRW SETCUR ;No - just display the file
TSTB CRRFLG ; and want to replace the alternate file?
BNEQ 1$ ;Not both - just display the file
5$: TSTL HOMPOS ;Yes - in top window?
BEQL 10$ ;Yes
MOVL HOMPOS,R3 ;No - move to top
CLRL HOMPOS
CLRL CPG(R10) ;Make clear-to-eop not work
CLRL ILN(R10) ; and insert-lines
CLRL DLN(R10) ; and delete-lines
MOVZBL #^A"^",R1 ;Get upward-pointing separator
DECL R3
BRB SETWN1
10$: MOVL LPP(R10),R3 ;Get screen length for bottom window
MOVL R3,HOMPOS ;Save as row position of home
CVTBL #-1,R3 ;Put separation on line above home
MOVL SAVILN,ILN(R10) ;Restore insert- and delete-line sequences
MOVL SAVILN+4,DLN(R10)
MOVL SAVCPG,CPG(R10) ;Restore clear-to-eop sequence
MOVZBL #^A"v",R1 ;Get downward-pointing separator
SETWN1: BSBW WINSEP ;Output the new separator
TSTB WINDIS ;Is there a display in both windows?
BEQL 20$
MOVB #-1,DSPFLG ;Yes - don't display now
20$: MOVB #-1,WINDIS ;Either way, don't display next time
SETCUR: TSTB CRRFLG ;Want to replace the current (not old) file?
BEQL SETOUF ;No - go set the file
PUSHR #^M<R1,R2,R3,R4,R5>
MOVC3 #100,SVASPC,OLDSPC ;Yes - copy the old stuff back
POPR #^M<R1,R2,R3,R4,R5>
MOVL SVALEN,OLDLEN
MOVL SVATYP,OLDTYP
MOVL SVATYP_SIZE,OLDTYP_SIZE
SETOUF: CLRB CHGSPC ;Note that filespecs aren't changed (yet)
TSTB OUTFLG ;Need to finish up an /OUT: switch?
BEQL 10$ ;No
JSB OUTSET ;Yes - change the filespecs to those in newfil
10$:; MOVL DISPTR,R1 ;Is the display ptr at the start of line?
; MOVZBL -1(R1),R1
; CMPB R1,#^O12
; BEQL 20$
; MOVL #1,R4 ;Set to advance just 1 line
; BSBW ADVDPT ;No - move to the start of the next line
; BICL #M_FLG,F ;Make sure the flag is clear
20$: TSTB CHGSPC ;Have filespecs changed,
BNEQ 30$
BBC #V_SMF,F,40$ ; or are the two files the same?
30$: JMP NEWFL1 ;Yes
40$: JMP NEWFIL ;No - set up new file
RDOEM1: .ASCIZ /######File cannot be modified/
SSZERM: .ASCIZ /#####File is too large to edit/
ACHMSG: .ASCIZ /File attributes will change when file is saved/
SSZERR: $CLOSE FAB=INPUT_FAB
MOVAB SSZERM,R1
JMP STFERR
;Here if no parameter was typed - set up previous file, and save present
;one as the new previous one
SETNPM::TSTB OLDSPC ;Are there old file specs?
BNEQ 10$
BRW SETERX ;No - error
10$: BISL #^X80000000,R9 ;Make SETNPM look different from SETFIL
MOVAB FILSPC,R4 ;Point to specs for SAVFIL
MOVAL FSPLEN,R6
CLRB CRRFLG ;Make sure use-current-file flag is clear
BBS #V_SMF,F,20$ ;Are file and alternate file the same?
TSTB FILSPC ;Is there an active file?
BEQL 20$
BSBW SAVFIL ;Yes - save it now
20$: MOVL MFLPTR,R6 ;Got more files in TMP FILE?
BEQL 30$ ;No
JSB SETMFL ;Yes - set next one up as alternate
30$: MOVL #SPCSIZ-1,R1
SETNP1: MOVB L^FILSPC(R1),R2 ;Swap current and old filespecs
MOVB L^OLDSPC(R1),L^FILSPC(R1)
MOVB R2,L^OLDSPC(R1)
SOBGEQ R1,SETNP1
MOVL OLDLEN,R1 ;Swap lengths of filespecs
MOVL FSPLEN,OLDLEN
MOVL R1,FSPLEN
MOVL OLDTYP,R1 ;Swap file types
MOVL FSPTYP,OLDTYP
MOVL R1,FSPTYP
MOVL OLDTYP_SIZE,R1 ;Swap number of characters in file types
MOVL FSPTYP_SIZE,OLDTYP_SIZE
MOVL R1,FSPTYP_SIZE
MOVQ R7,R1 ;Swap row and column positions
MOVQ SAVERW,R7
MOVQ R1,SAVERW
MOVL DISPTR,R1 ;Swap display pointer
MOVL SAVEDP,DISPTR
MOVL R1,SAVEDP
MOVL SL,R1 ;Set up the slide
MOVL SAVESL,SL
MOVL R1,SAVESL
MOVL SAVEFG,R1 ;Get the alternate file's flags
MOVL F,SAVEFG ;Save current file's flags
BICL #M_RDO,F ;Use current flags, but alternate's read-only
BICL #^C<M_RDO>,R1
BISL R1,F
BBS #V_RDO,F,50$ ;Is the alternate file read-only?
CLRL R1 ;No - say it's writable
BRB 60$
50$: MOVL #-1,R1 ;Yes - mark as read-only
60$: MOVL R1,SAVEAC+36 ;Save the read-write flag
TSTL DISPTR ;Need to parse filespecs? (only from TMP file)
BNEQ 5$ ;No
JSB PARSEF ;Yes - do so
5$: BISL #M_XPC!M_XPL!M_XPB,F ;No pointers are valid
BICL #M_FLG!M_FNC,F ;Clear flag from parser and fence
BBS #V_SMF,F,10$ ;Are file and alternate file the same?
BRW SETFL1 ;No - go set up that file
10$: TSTL DISPTR ;Need to set up pre-set pointers?
BNEQ 20$
JSB PRESET ;Yes - do so
20$: BRW SETWIN ;Don't look file up; just use it
SETERR: BBSC #V_CRE,F,SETERC ;Really want to create?
BRW SETER0 ;No - it's a real error
SETERC: MOVB #-1,JRNCRE ;Indicate to journal that create is being done
TSTB RSCANF ;Got a file from rescan?
BNEQ 100$ ;Yes - don't save previous file
BBS #30,R9,100$ ;Working on an indirect file?
TSTL OLDSPC ; or was there no previous file?
BEQL 100$ ;Either way don't save old file
MOVAB OLDSPC,R4 ;Prepare to save the file
MOVAL OLDLEN,R6
MOVL SAVEDP,DISPTR
BSBW SAVFIL ;Save the old file
MOVL DISPTR,SAVEDP
MOVAB BUFFER,DISPTR
100$: PUSHR #^M<R5> ;Make sure R5 doesn't get clobbered
$PARSE FAB=INPUT_FAB ;Make sure the file type is set up
MOVZBL MAIN_NAM+NAM$B_TYPE,FSPTYP_SIZE ;Save the size of the file type
MOVL #^A" ",FSPTYP ;Initialize the file type
MOVL MAIN_NAM+NAM$L_TYPE,R2 ;Get the address of the file type
MOVC3 FSPTYP_SIZE,(R2),FSPTYP ;Save the file type
MOVC5 #0,BUFFER,#0,#EDIT_BUFF_START-BUFFER-1,BUFFER ;Clear the buffer
MOVW #^X0A0D,BUFFER ;Save <CRLF> as last word in the file
MOVAB BUFFER+4,EN ;Set up the end pointer
TSTB MSGFLG ;Does user want the message?
BEQL 10$ ;No
MOVAB BUFFER,R5 ;Yes - set up the pointer
MOVL FSPTYP,R1 ;Get the file type
BSBW FIND_TYPE_INDEX
MOVL R1,R3 ;Was anything found?
BLSS 3$ ;No - just use the default
MOVL PREFIX_TABLE[R3],R1 ;Yes - point to it
BEQL 3$ ;If something is there,
JSB PUTSTG ; move it to the buffer
BRB 4$
3$: MOVW #^A"! ",(R5)+ ;Put in the default comment characters
4$: MOVAB NEWMSG,R1 ;Move the message into the buffer
JSB PUTSTG
TSTL R3 ;Any file type pointer set up?
BLSS 8$ ;No
MOVL POSTFIX_TABLE[R3],R1 ;Yes - get the address of the postfix
BEQL 8$ ;Skip if none specified
JSB PUTSTG ;Otherwise, output it
8$: MOVW #^X0A0D,(R5)+ ;Tack on a CRLF
ADDL3 #4,R5,EN ;Set up the end pointer
10$: POPR #^M<R5> ;Restore R5
MOVB #-1,INJFN ;Indicate the file has been set up
MOVB #FAB$M_CR,REC_ATT ;Set carriage return attribute
CLRL SAVEAC+36 ;Mark file is always writable
BICL #M_RDO,F ;Ditto
BISL #M_CHG,F ;Indicate the file needs to be written
CLRB RSCANF ;Clear the rescan flag
BRW SETRDY ;Go finish up opening the file
SETER0: TSTL EEEPTR ;Working on a list of file types?
BEQL 10$ ;No
BRB SETER1 ;Yes - keep working
10$: BBS #NAM$V_EXP_TYPE,MAIN_NAM+NAM$L_FNB,SETER2 ;Was a file type given?
BISL #M_FLG,F ;No - try some usual file types
MOVAL EXTTBL,EEEPTR ;Point to the file type list
$FAB_STORE FAB=INPUT_FAB,DNA=DEXT ;Set up the default file type field
TSTL OLDTYP_SIZE ;Does the old file have a file type?
BEQL SETER1 ;No - don't try to use it
MOVL OLDTYP,DEXT ;Yes - try it on the new file
$FAB_STORE FAB=INPUT_FAB,DNS=OLDTYP_SIZE
BRW SETFL1
SETER1: $FAB_STORE FAB=INPUT_FAB,DNS=#4 ;Set up the size of the file type
MOVL @EEEPTR,DEXT ;Set up another file type
BEQL SETER2 ;Any more to try?
ADDL #4,EEEPTR ;Yes - go do it
BRW SETFL1
SETER2: $FAB_STORE FAB=INPUT_FAB,DNA=#0,DNS=#0 ;Reset the default file type field
CLRL EEEPTR
TSTB CREFLG ;/CREATE if not found?
BEQL 10$ ;No
BRW SETERC ;Yes - go do it
10$: MOVAB SETERM,R1
JMP STFERR ;Go display the error
SETERM: .ASCIZ /##########File not found/
SETEXM: .ASCIZ /#########No alternate file/
SETERX: MOVAB SETEXM,R1
JMP ERROR
SETERE: MOVAB SETENM,R1 ;Point to the error message
JMP STFERR ;Go display the error
SETENM: .ASCIZ /Unable to create new file/
EXTTBL: .ASCII /.MAR/ ;Table of common file types
.ASCII /.FOR/
.ASCII /.PAS/
.ASCII /.PLI/
.ASCII /.BAS/
.ASCII /.C /
.ASCII /.SPS/
.ASCII /.COM/
.ASCII /.DAT/
RNOEXT: .ASCII /.RNO/
.LONG 0 ;End the table with a null entry
;These are the character strings needed to start and end comments
;in the various languages.
PFX_MAR: .ASCIZ /; / ;Macro beginning
PFX_FOR: .ASCIZ /C / ;Fortran beginning
PFX_PAS: .ASCIZ /{ / ;Pascal beginning
PFX_PLI: .ASCIZ \/* \ ;PL-1 beginning
PFX_COM: .ASCIZ /$! / ;DCL beginning
PFX_RNX: .ASCIZ /.! / ;Runoff file beginning
POST_PAS: .ASCIZ /}/ ;Pascal ending
POST_PLI: .ASCIZ \*/\ ;PL-1 ending
;Table of pointers to the start-of-comment and end-of-comment character strings
;These tables must agree in order with EXTTBL
PREFIX_TABLE: .ADDRESS PFX_MAR ;Macro
.ADDRESS PFX_FOR ;Fortran
.ADDRESS PFX_PAS ;Pascal
.ADDRESS PFX_PLI ;PL-1
.LONG 0 ;Use default for basic
.ADDRESS PFX_PLI ;C is the same as PL-1
.LONG 0 ;Use default for SPSS
.ADDRESS PFX_COM ;DCL Command files
.LONG 0 ;Use default for data files
.ADDRESS PFX_RNX ;Runoff files
POSTFIX_TABLE: .LONG 0 ;None for macro
.LONG 0 ;None for fortran
.ADDRESS POST_PAS ;Pascal
.ADDRESS POST_PLI ;PL-1
.LONG 0 ;None for basic
.ADDRESS POST_PLI ;C is the same as PL-1
.LONG 0 ;None for SPSS
.LONG 0 ;None for DCL
.LONG 0 ;None for data files
.LONG 0 ;None for runoff files
.SUBTITLE Determine the file type index
;Subroutine to set the index for the file type. This index is used to
;determine the syntax for comments output because the /ID or /MESSAGE
;switches are set. The extension of the file is passed in R1, and the
;resulting index is returned in R1. -1 is returned if the file type is not
;found in the table.
FIND_TYPE_INDEX:
PUSHR #^M<R2,R3> ;Save the registers
MOVL R1,DEXT ;Save the desired file type
CMPC3 #3,DEXT,RNOEXT ;Is it some kind of runoff file?
TSTL R0
BNEQ 10$ ;No
MOVL #^[email protected]@,DEXT ;Yes - make sure the test will match
10$: CLRL R1 ;Initialize the index
20$: TSTL EXTTBL[R1] ;Are we at the end of the table?
BNEQ 30$ ;No
CVTBL #-1,R1 ;Yes - return entry not found
BRB 40$
30$: CMPL DEXT,EXTTBL[R1] ;Is this the one?
BEQL 40$ ;Yes
INCL R1 ;No - increment the counter
BRB 20$ ;and try again
40$: POPR #^M<R2,R3> ;Restore the registers
RSB ; and return
.SUBTITLE Convert from Variable format to internal format
CONVVAR:BICL #M_FLG,F ;Clear the flag
TSTB REC_ATT ;Is the record attribute 'None'?
BNEQ 5$ ;No
BISL #M_FLG,F ;Yes - set flag to suppress CRLF insertion
MOVB #FAB$M_CR,REC_ATT ;and set to write it out in CR format
5$: MOVAB BUFFER,R4 ;Point to the start of the buffer
ADDL3 R4,FILSIZ,R2 ;Point to the end of the buffer
BISL #M_NOC,F1 ;Don't want <CRLF> inserted at first
10$: MOVZWL (R4),R3 ;Get the length of this record
CLRW (R4) ;and clear the length word
BBS #V_FLG,F,20$ ;Bypass CR test if record attribute is 'None'
BBSC #V_NOC,F1,20$ ;Want to store a <CRLF>?
MOVW #^X0A0D,(R4) ;Yes
20$: CMPW #-1,R3 ;Is it the end of the file?
BEQL 50$ ;Yes
CMPW R3,#1 ;Is the line length 1?
BNEQ 30$ ;No
CMPB #^X0C,2(R4) ;Yes - is it a form feed?
BNEQ 30$ ;No
BISL #M_NOC,F1 ;Yes - don't want the next <CRLF>
30$: ADDL #2,R4 ;Step past the byte count
ADDL R3,R4 ;Step to next record
BBC #0,R4,40$ ;If byte count is odd, need to clear a byte
CLRB (R4)+ ; and step to next byte
40$: CMPL R4,R2 ;Reached the end yet?
BLSS 10$ ;If not, loop for another line
CMPW #-1,(R4) ;Is the last thing an end of file indicator?
BEQL 10$ ;Yes - need a final CRLF
MOVL R4,EN ;Set up pointer to end of file
BRB 60$ ;and return
50$: ADDL3 #4,R4,EN ;Make sure end is past the CRLF
60$: BICL #M_FLG,F ;Make sure the flag is clear
RSB ;Then return
.SUBTITLE Convert Input Format to Internal Format
;Dispatch table for conversion routines
CONV_TABLE: .ADDRESS CONVUDF ;Undefined
.ADDRESS CONVFIX ;Fixed format
.ADDRESS CONVVAR ;Variable format
.ADDRESS CONVVFC ;VFC format
.ADDRESS CONVSTM ;STM format
.ADDRESS CONVSTM ;STMLF format
.ADDRESS CONVSTM ;STMCR format
;Subroutine to convert from unknown format to internal format
CONVUDF:MOVAB UDFERM,R1 ;Point to the error message
MOVL (SP)+,R0 ;Fix up the stack
JMP STFERR
UDFERM: .ASCIZ /Undefined file format not yet supported by SED/
;Subroutine to convert from Stream format to internal format
CONVSTM:ADDL3 #BUFFER,FILSIZ,EN ;Compute the end pointer
BISL #M_CHG,F ;Indicate file changed so it will be rewritten
; in variable format
RSB ;and return - stream format is same as internal fmt
.SUBTITLE Convert from VFC format to internal format
CONVVFC:BICL #M_FLG,F ;Clear the flag
BBS #FAB$V_PRN,REC_ATT,3$ ;Is it print format?
TSTB REC_ATT ;Is the record attribute 'None'?
BNEQ 5$ ;No
BISL #M_FLG,F ;Yes - set flag to suppress CRLF insertion
3$: MOVB #FAB$M_CR,REC_ATT ;and set to write it out in CR format
5$: MOVAB BUFFER,R4 ;Point to the start of the buffer
ADDL3 R4,FILSIZ,R2 ;Point to the end of the buffer
BISL #M_NOC,F1 ;Don't want <CRLF> inserted at first
10$: MOVZWL (R4),R3 ;Get the length of this record
CLRW (R4) ;and clear the length word
BBS #V_FLG,F,20$ ;Bypass CR test if record attribute is 'None'
BBSC #V_NOC,F1,20$ ;Want to store a <CRLF>?
MOVW #^X0A0D,(R4) ;Yes
20$: ADDL #2,R4 ;Step past the byte count word
MOVZBL INPUT_FAB+FAB$B_FSZ,R0 ;Get the size of the fixed portion
SUBL R0,R3 ;Adjust for the fixed portion of the record
25$: CLRB (R4)+ ;Clear a byte
SOBGTR R0,25$ ;Loop until all bytes are done
CMPW R3,#1 ;Is the line length 1? cleared
BNEQ 30$ ;No
CMPB #^X0C,(R4) ;Yes - is it a form feed?
BNEQ 30$ ;No
BISL #M_NOC,F1 ;Yes - don't want the next <CRLF>
30$: ADDL R3,R4 ;Step to next record
BBC #0,R4,40$ ;If byte count is odd, need to clear a byte
CLRB (R4)+ ; and step to next byte
40$: CMPL R4,R2 ;Reached the end yet?
BLSS 10$ ;If not, loop for another line
CMPW #-1,(R4) ;Is the last thing an end of file indicator?
BEQL 10$ ;Yes - need a final CRLF
MOVL R4,EN ;Set up pointer to end of file
BRB 60$ ;and return
50$: ADDL3 #4,R4,EN ;Make sure end is past the CRLF
60$: BICL #M_FLG,F ;Make sure the flag is clear
BISL #M_ACH,F1 ;Let the user know we'll change to variable fmt
RSB ;Then return
.SUBTITLE Convert fixed format to internal format
CONVFIX:MOVZWL INPUT_FAB+FAB$W_MRS,R1 ;Get the record length
DIVL3 R1,FILSIZ,R2 ;Get the number of records in the file
MULL3 #3,R2,NUMCHR ;Compute the number of nulls to add
ADDL3 #BUFFER,FILSIZ,R1 ;Compute and set up the current end pointer
MOVW #^X0A0D,(R1)+ ;Make sure it ends with a null
MOVL R1,EN ;Save the end pointer
MOVAB BUFFER,CHRPTR ;Add them at the beginning of the file
JSB MAKNUL ;Expand the file
PUSHR #^M<R5,R6,R7,R8>;Save some registers
MOVAB BUFFER,R6 ;Point to the place to store the records
MOVL R4,R7 ; and to the place to get them
MOVZWL INPUT_FAB+FAB$W_MRS,R8 ;Get the record size
10$: MOVC3 R8,(R7),(R6) ;Move a line
ADDL R8,R7 ;Update the source pointer
CMPB (R6),#^X0C ;Is the first character a form feed?
BNEQ 30$ ;No - just continue
ADDL3 #1,R6,R1 ;Yes - are there any non-blank or non-null
SUBL3 #1,R8,R2 ; characters in the line?
20$: CMPB (R1),#^A" "
BEQL 25$
TSTB (R1)
BNEQ 30$
INCL R1
25$: SOBGTR R2,20$ ;Loop through the entire line
INCL R6 ;No - just save the form feed
BRB 40$
30$: ADDL R8,R6 ;Update the destination pointer
MOVW #^X0A0D,(R6)+ ;Append a CRLF
40$: CMPL R7,EN ;Reached the end of the file yet?
BLSS 10$ ;No - continue
CMPW #^X0A0D,-2(R6) ;Yes - is the last thing a CRLF?
BEQL 50$ ;Yes
MOVW #^X0A0D,(R6)+ ;No - stick one in
50$: CLRL (R6)+ ;Pad with a null longword
CLRL (R6) ;Make sure EN points to a null longword
MOVL R6,EN ;Save the new end pointer
POPR #^M<R5,R6,R7,R8> ;Restore the registers
BISL #M_ACH,F1 ;Let user know we'll change file to variable
RSB ;Done
.SUBTITLE Windowing Command
;**********************************************************************
;Here to set up or cancel windowing
WINCLR::JSB RESTPM ;Reset parameter
WINCL1: BSBB WNCLST ;Clear windowing
JSB DISPLL ;Re-display the screen
JMP DISCUR ;Position the cursor and loop
WNCLST::BICL #M_WDW,F1 ;Get out of windowing
CLRL HOMPOS ;Put home back home
MOVQ SAVRUP,RUP(R10) ;Restore saved roll up and down
MOVL SAVILN,ILN(R10) ;Restore saved insert line
MOVL SAVILN+4,DLN(R10) ; and saved delete line
MOVL SAVCPG,CPG(R10) ;Restore clear-to-eop, too
MOVL SAVLPP,R3 ;Set up full screen length
JMP SWHLPP ;Also set up as lines per page
WINSET::BBCS #V_WDW,F1,10$ ;Already in a window?
BRB WINCL1 ;Yes - cancel windowing
10$: MOVL LPP(R10),SAVLPP ;Save screen length for after windowing
ASHL #-1,LPP(R10),R3 ;Get half of screen length
CMPL R7,R3 ;Is cursor below window?
BLSS 20$ ;No
CLRL R7 ;Yes - move it home
CLRL R8
20$: BISL #M_XPL!M_XPC!M_XPB,F ;Cursor and line pointers are bad
MOVQ RUP(R10),SAVRUP ;Save roll up and roll down sequences
CLRQ RUP(R10) ;Clear them so rolls won't be done
MOVL ILN(R10),SAVILN ;Same with insert and delete line sequences
MOVL DLN(R10),SAVILN+4 ; (in the upper window only)
CLRL ILN(R10)
CLRL DLN(R10)
JSB SWHLPP ;Also set up as lines per page
MOVZBL #^A"^",R1 ;Get upward-pointing separator
BSBB WINSEP ;Put window separator up
TSTL CPG(R10) ;Is there a clear-to-eop sequence?
BEQL 30$ ;No
JSB CLEARP ;Yes - do it
30$: CLRB WINDIS ;Clear and save
MOVL CPG(R10),SAVCPG ; sequence for clear-to-eop
CLRL CPG(R10)
JMP DISCUR ;Re-position the cursor, done
;Subroutine to output window separator on line (R3)
;Enter with separator character in R1
WINSEP: PUSHR #^M<R1> ;Save separator character
MOVL R3,R4 ;Put position in the right register
JSB POSLIN ;Move to the start of line (R4)
SUBL3 #5,CPL.1,R2
JSB PROTON ;Output a protected separator
POPR #^M<R1> ;Restore the separator character
10$: MOVB R1,(R5)+ ;Put it in the type buffer
SOBGTR R2,10$
JSB PROTOF
JMP PUTTYP ;Output and return
.SUBTITLE Subroutine to save the current file
;Pointer to the filespec string is in R4
;Pointer to the length of the filespec string is in R6
SAVFIL::BBS #V_RDO,F,5$ ;Is file read-only?
BBSC #V_CHG,F,10$ ;No - has the file been modified?
5$: BRW SAVFNO ;Not modified or read only - don't save it
10$: BSBW SAVMGS ;Yes - output file modified message
MOVL R6,SAVEAC+4 ;Save pointer to file data
TSTB TAGFLG ;Want to put a tag line at start of file?
BEQL 11$ ;No
BSBW SAVTAG ;Yes - do so
11$: PUSHR #^M<R4,R6> ;Save pointer to file spec
BSBW TRAILL ;Chop out trailing spaces and nulls
POPR #^M<R4,R6> ;Restore the file pointer
MOVL SAVEAC+4,R6 ;Restore the pointer
SUBL3 #BUFFER,EN,OUTSIZ ;Compute the size of the file
DIVL3 #512,OUTSIZ,R1 ;Compute the number of blocks
INCL R1
$FAB_STORE FAB=OUTPUT_FAB,ALQ=R1,- ;Set the proper attributes
FAC=<BIO,PUT>,FNA=(R4),-
FNS=(R6),ORG=SEQ,RAT=REC_ATT,RFM=VAR
TSTB BAKFLG ;Is a backup wanted?
BEQL 15$ ;No
TSTB FILE_SAVED ;Yes - has one already been made?
BNEQ 15$ ;Yes - supersede the new file
$FAB_STORE FOP=MXV ;No - create a new version of the file
BRB 16$
15$: $FAB_STORE FOP=SUP ;Supersede this version
16$: CLRW OUTPUT_FAB+FAB$W_IFI
MOVW MAXLRL,OUTPUT_FHC+XAB$W_LRL ;Set the maximum record length
$CREATE FAB=OUTPUT_FAB
BLBS R0,20$
MOVL OUTPUT_FAB+FAB$L_STV,R1 ;Point to the status value
BICL #M_FLG2,F1 ;File is in external format
BRW SVEERR
20$: PUSHR #^M<R4,R5,R6> ;Save some registers
MOVL R4,R6 ;Get address of the filespec string
MOVC3 #100,RESULT_NAME,(R6) ;Save the new filename
POPR #^M<R4,R5,R6> ;Restore the registers
MOVZBL MAIN_NAM+NAM$B_RSL,(R6) ;Save the length of the string
$CONNECT RAB=OUTPUT_RAB
BLBS R0,25$
MOVL OUTPUT_RAB+RAB$L_STV,R1 ;Point to the status value
BICL #M_FLG2,F1 ;File is in external form
BRW SVEERR
25$: MOVAB BUFFER,R3 ;Point to the buffer
MOVL OUTSIZ,R2 ;Get the size of the file
MOVL #1,R4 ;Point to the correct block
30$: MOVL R4,OUTPUT_RAB+RAB$L_BKT ;Save the record number
MOVL R3,OUTPUT_RAB+RAB$L_RBF ;and the buffer address
CMPL R2,#^X8000 ;Do we need to write in chunks?
BGTR 40$ ;Yes
MOVW R2,OUTPUT_RAB+RAB$W_RSZ ;Store the byte count
BRB 50$
40$: MOVW #^X8000,OUTPUT_RAB+RAB$W_RSZ ;and the byte count
50$: $WRITE RAB=OUTPUT_RAB ;Write the blocks
BLBS R0,60$
MOVL OUTPUT_RAB+RAB$L_STV,R1 ;Get the auxiliary value
BICL #M_FLG2,F1 ;File is in external form
BRB SVEERR
60$: ADDL #^X8000,R3 ;Increment the buffer pointer
ADDL #^X40,R4 ;and the block number
SUBL #^X8000,R2 ;Count down the file size
BGTR 30$ ;Do some more if needed
$DISCONNECT RAB=OUTPUT_RAB
$CLOSE FAB=OUTPUT_FAB ;Close the file
RSB ;and return
SAVFNO: BSBW SAVMGN ;Tell user that file is not changed
SNOOZE 700 ;Sleep a bit
RSB
.SUBTITLE Error processor for SAVFIL operations
SVEERR::BISL #M_CHG,F ;Remember that the file was changed
BBSC #V_FLG2,F1,10$ ;Is file still in internal format?
PUSHR #^M<R0,R1> ;Save the error numbers
BSBW CONVVAR ;No, re-convert the buffer to internal format
POPR #^M<R0,R1> ;Restore the error numbers
10$: MOVL R1,-(SP) ;Save the auxiliary message
BSBB GETMSG ;Get the text of the system error message
MOVZWL ERROR_MESS_LENGTH,R1
CLRB L^ERROR_MESSAGE(R1) ;Make the system text into .ASCIZ
MOVAB ERROR_MESSAGE,R1
JSB ERRDSP ;and output the system message
MOVL (SP)+,R0 ;Restore the auxiliary message
BEQL 20$ ;Skip outputting it if it's not there
BSBB GETMSG ;Get the text of the message
MOVZWL ERROR_MESS_LENGTH,R1
CLRB L^ERROR_MESSAGE(R1) ;Make the message into .ASCIZ
MOVAB ERROR_MESSAGE,R1 ;Point to the message
JSB ERRDSP ;and output it
20$: JSB DISPLL ;Re-display the screen
MOVL STACK,SP ;Re-init the stack
JMP DISCUR ;Wait for further instructions
;Routine to get the text of a system error message
GETMSG::MOVL R0,ERROR_CODE ;Save the error code argument
$GETMSG_S MSGID=ERROR_CODE,MSGLEN=ERROR_MESS_LENGTH,-
BUFADR=ERROR_DESCR
BLBS R0,10$ ;Any errors?
CLRW ERROR_MESS_LENGTH ;Yes, pretend the message had zero length
10$: RSB ;Then return
;Subroutine to put a tag line at the start of the file before it's saved.
;The tag looks like: ";[SYSTEM]SED.MAC;1, 11-MAR-1982 09:25:27, Edit by SYSTEM"
SAVTAG: PUSHR #^M<R5> ;Save the type-out buffer pointer
MOVL #200,NUMCHR ;Insert 200 nulls
MOVAB BUFFER,R5
MOVL R5,CHRPTR ; at the start of the file
BISL #M_XPB!M_XPL!M_XPC,F ;Pointers are no longer valid
MOVL DISPTR,ADJWRD ;Tell MAKNUL to adjust the display pointer
PUSHR #^M<R4,R6>
JSB MAKNUL ;Insert the nulls
POPR #^M<R4,R6>
MOVL ADJWRD,R1 ;Get the adjusted display pointer
CLRL ADJWRD ; and clear it
CMPL DISPTR,#BUFFER ;At the start of the file?
BEQL 4$ ;Yes
MOVL R1,DISPTR ;No - save the adjusted display pointer
BRB 8$
4$: INCL R7 ;Leave display ptr alone; move one row down
8$: MOVL 4(R6),R1 ;Get the file extension
BSBW FIND_TYPE_INDEX ;Get its index into the comment tables
MOVL R1,R3 ;Save the index
BLSS 10$ ;If no entry was found, use the default
MOVL PREFIX_TABLE[R3],R1 ;Get the address of the prefix string
BEQL 10$ ;If there is no entry, use the default
JSB PUTSTG ;Otherwise, output the string
BRB 20$
10$: MOVW #^A"! ",(R5)+ ;Start with the default comment character
20$: MOVL R4,R1 ;Output the current filespec
JSB PUTSTG
MOVW #^A", ",(R5)+ ;Delimit with comma, space
$ASCTIM_S TIMBUF=TIME_DESC ;Get the current date and time
MOVAB EDIT_TIME,R1 ; and output it
JSB PUTSTG
MOVAB SVTGMS,R1 ;Output ", Edit by "
JSB PUTSTG
$GETJPI_S ITMLST=JPI_ITEMS ;Get the user's name
MOVAB USERNAME,R1 ;Point to the username
JSB PUTSTG ;Output it
TSTL R3 ;Any post-comment characters?
BLSS 30$ ;No
MOVL POSTFIX_TABLE[R3],R1 ;Maybe - get the address of it
BEQL 30$ ;If none, don't output any
JSB PUTSTG ;Otherwise, output it
30$: MOVW #^X0A0D,(R5)+ ;End the line with <CRLF>
POPR #^M<R5> ;Get the type-out buffer pointer back
RSB ;Done
SVTGMS: .ASCIZ /, Edit by /
.SUBTITLE Output File Save Messages
;Routines to output file save messages
;Enter with R4/addr of OLDSPC or FILSPC (whichever is current file)
SAVMGN::BBC #V_WDW,F1,10$ ;In a window?
RSB ;Yes - no message
10$: JSB CLRALL ;Tell user that file is not changed
MOVAB SAVMGA,R1
JSB PUTSTG
MOVL R4,R1 ;Output filespecs
JSB PUTSTG
BRB SAVMG1
SAVMGS: BBC #V_WDW,F1,10$ ;In a window?
RSB ;Yes - no message
10$: JSB CLRALL
MOVAB SAVMGB,R1
JSB PUTSTG
MOVL R4,R1 ;Output filespecs
BSBW PUTFIL
TSTB CHGSPC ;Are specs changed?
BNEQ 20$ ;Yes - say no backup
TSTB BAKFLG ;No - say whether there's a backup or not
BEQL 20$
MOVAB SAVMGC,R1 ;Say with backup
BRB 30$
20$: MOVAB SAVMGD,R1 ;Say no backup
30$: JSB PUTSTG
SAVMG1: MOVB #^O15,(R5)+ ;End with a carriage return
MOVB #^O12,(R5)+
JMP PUTTYP
SAVMGA: .ASCIZ /NOT MODIFIED: /
SAVMGB: .ASCIZ /SAVING FILE: /
SAVMGC: .ASCIZ / (WITH BACKUP)/
SAVMGD: .ASCIZ / (NO BACKUP)/
SAVMEA: .ASCIZ /Error creating file/
SAVMEB: .ASCIZ /Output error/
ORGUNKERM: .ASCIZ /File organization is not supported by SED/
ORGRELERM: .ASCIZ /Relative files are not supported by SED/
ORGIDXERM: .ASCIZ /Indexed files are not supported by SED/
ORGHSHERM: .ASCIZ /Hashed files are not supported by SED/
GLOB ;Define the global symbols
.END