Trailing-Edge
-
PDP-10 Archives
-
tops20tools_v6_9-jan-86_dumper
-
tools/sed-for-vms/sed1sw.mar
There are 5 other files named sed1sw.mar in the archive. Click here to see a list.
.TITLE SED1SW - SED Switch Routines
.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG
PRMDEF ;Define the SED parameters
FLGDEF ; and the flag bits
TRMDEF ; and the offsets in the terminal tables
SEQDEF ; and the command sequence definitions
.SUBTITLE Switch Command
;Here for the command to set a number of switches
SWITCH::CMPL PARPTR,#PARBUF ;Did user type just enter switch?
BNEQ 10$
BRW SWHSTS ;Yes - give him some status information
10$: JSB ERASPM ;Else erase parameter
CLRB @PARPTR ;End parameter with a null
MOVAB PARBUF,R2
CVTBL #-1,SAVEAC ;Don't let SWHMNX try to get a second line
MOVL R2,R3
MOVZBL (R3)+,R1 ;Get first character
CMPB R1,#^A"/" ;Superfluous slash?
BNEQ 20$
MOVL R3,R2 ;Yes - skip it
20$: BSBW SWHMNY ;Handle the switch(s) in the parameter buffer
JMP DISCUR ;Re-position cursor and get new command
;Here on switch with no parameter: give file status
SWHNPM::BSBW SWHBOT ;Set up the bottom line
MOVAB SWHNM1,R1
JSB PUTSTG
BBS #V_RDO,F,5$ ;Is the file writable? No
BBC #V_CHG,F,5$ ;and has it been changed? No
MOVB #^A"*",(R5)+ ;Both - output the fact that it's changed
5$: MOVAB FILSPC,R1
JSB PUTSTF
BSBW MAKCPT ;Make a good character pointer
MOVL R7,R2 ;Save real row pointer
MOVAB BUFFER,R6
BSBW FINDRW ;Count pages and lines from start of buffer
MOVL R2,R0
MOVL SAVEAC,R2
MOVL R7,SAVEAC
MOVL R0,R7
TSTB PAGFLG ;Want both pages and lines?
BNEQ 10$ ;Yes
BRB SWHNP1 ;No - just lines
10$: MOVAB SWHNM2,R1
JSB PUTSTG
ADDL3 #1,R3,R1 ;Get page number
JSB PUTNUM ;Output page
MOVB #^A"-",(R5)+
INCL SAVEAC
MOVL SAVEAC,R1 ;Get line number
JSB PUTNUM ;Output it
BRB SWHNP2 ;Skip lines-only stuff
SWHNP1: MOVAB SWHNM3,R1
JSB PUTSTG
ADDL3 #1,R2,R1 ;Get line number
JSB PUTNUM ;Output it
SWHNP2: MOVB #^A"(",(R5)+
SUBL3 #BUFFER-1,LINPTR,R1 ;Get offset of page into buffer
MULL #100,R1 ;times 100
SUBL3 #BUFFER,EN,R2 ;divided by size of file
DIVL R2,R1
JSB PUTNUM ;Output percent through file
MOVAB SWHNM4,R1
JSB PUTSTG
ADDL3 R8,SL,R1 ;Output column + slide + 1
INCL R1
JSB PUTNUM
TSTL OLDSPC ;Got an alternate file?
BEQL SWHNPE ;No - don't talk about it
MOVAB SWHNM5,R1
JSB PUTSTG
MOVAB OLDSPC,R1
JSB PUTSTF
SWHNPE::MOVB #^A" ",(R5)+
SUBL3 #TYPBUF,R5,R1 ;Compute length of message
CMPL R1,CPL.1 ;Is it too long?
BLEQ 10$ ;No
ADDL3 #TYPBUF,CPL.1,R5 ;Make message end at the right place
10$: JSB PUTTYP ;Output the text
JSB PROTOF ;Turn protection off
BISL #M_FBL,F ;Say bottom line has been fragged
JMP DISCUR ;Re-position the cursor and return
SWHNM1: .ASCIZ /FILE: /
SWHNM2: .ASCIZ / PAGE: /
SWHNM3: .ASCIZ / LINE: /
SWHNM4: .ASCIZ /%) POS: /
SWHNM5: .ASCIZ / ALT: /
;Subroutine to set up the bottom of the screen for the switch command, etc.
SWHBOT::JSB RESTPM ;Clean up the parameter entry
JSB CBOTOM ;Put message on bottom line
JSB PROTON ;Protected
JMP PUTTYP ;Output positioning now
;Here on token switch (enter, but no parameter): give nominal settings
SWHSTS: BSBB SWHBOT ;Set up the bottom line
MOVAB SWHS01,R1 ;Output " RL:"
JSB PUTSTG
MOVL ROLLIN,R1 ;Output number of lines to roll
JSB PUTNUM
MOVAB SWHS02,R1 ;Output " RP:"
JSB PUTSTG
MOVL ROLPGS,R1 ;Output number of pages to roll
JSB PUTNUM
MOVAB SWHS03,R1 ;Output " PC:"
JSB PUTSTG
MOVL GOPERC,R1 ;Output percent-goto nominal
JSB PUTNUM
MOVAB SWHS04,R1 ;Output " SL:"
JSB PUTSTG
MOVL SLIDES,R1 ;Output size of slide
JSB PUTNUM
MOVAB SWHS05,R1 ;Output " IL:"
JSB PUTSTG
MOVL ADDLNS,R1 ;Output number of lines to insert/delete
JSB PUTNUM
MOVL ADDLSP,R1 ;Get number of spaces to go with the lines
BEQL SWHST1 ;None - skip output
MOVB #^A",",(R5)+ ;Output the comma
JSB PUTNUM ;Output the value
SWHST1: MOVAB SWHS06,R1 ;Output " IS:"
JSB PUTSTG
MOVL ADDSPC,R1 ;Output number of spaces to insert/delete
JSB PUTNUM
MOVAB SWHS07,R1 ;Output " PK:"
JSB PUTSTG
MOVL PICKLN,R1 ;Output number of lines to pick
JSB PUTNUM
MOVL PICKSP,R1 ;Get spaces to go with those lines
BEQL SWHST2 ;Any there? No - so skip output
MOVB #^A",",(R5)+ ;Yes - output the comma
JSB PUTNUM ;And the space count
SWHST2: MOVAB SWHS15,R1 ;Output " CS:"
JSB PUTSTG
MOVL CASLNS,R1 ;Changing the case of any lines?
BEQL SWHS2A ;No - skip output
JSB PUTNUM ;Yes - output them and a comma
MOVB #^A",",(R5)+
SWHS2A: MOVL CASSPS,R1 ;Output number of chars to change case of
JSB PUTNUM
MOVAB SWHS16,R1 ;Output " SU:"
JSB PUTSTG
MOVL SUBCNT,R1 ;Output number of substitutes to do
JSB PUTNUM
TSTL ISVNUM ;Got an incremental save?
BLEQ SWHST3 ;No
MOVAB SWHS08,R1 ;Yes - output " ISV:"
JSB PUTSTG
MOVL ISVNUM,R1
JSB PUTNUM
SWHST3: TSTL SAVNUM ;Got an incremental typein save?
BLEQ SWHST4 ;No
MOVAB SWHS09,R1 ;Output " SV:"
JSB PUTSTG
MOVL SAVNUM,R1
JSB PUTNUM
SWHST4: TSTL LMARGN ;Got a changed left margin?
BLEQ SWHST5 ;No
MOVAB SWHS10,R1 ;Yes - output " LM:"
JSB PUTSTG
MOVL LMARGN,R1
BSBW PUTNPO
SWHST5: CMPL RMARGN,CPL.1 ;Got a changed right margin?
BEQL SWHST6 ;No
MOVAB SWHS11,R1 ;Yes - output " RM:"
JSB PUTSTG
MOVL RMARGN,R1
BSBW PUTNPO
SWHST6: MOVAB SWHS12,R1 ;Output " TB:"
JSB PUTSTG
BBC #V_WTB,F,10$ ;Got word-wise tabs?
MOVB #^A"W",(R5)+ ;Yes - call them size "W"
BRB SWHST7
10$: BBC #V_STB,F1,20$ ;Got settable tabs?
MOVB #^A"S",(R5)+ ;Yes - call them size "S"
BRB SWHST7
20$: MOVL TABLEN,R1 ;No - output size of tab
JSB PUTNUM
SWHST7: TSTL SRCKEY ;Got a search key?
BEQL SWHST8 ;No
MOVAB SWHS13,R1 ;Output " KEY:"
JSB PUTSTG
MOVAB SRCKEY,R1
JSB PUTSTC
SWHST8: TSTB SUBSTG ;Got a substitute string?
BEQL 10$ ;No
MOVAB SWHS14,R1 ;Yes - output " RPL:"
JSB PUTSTG
MOVAB SUBSTG,R1
JSB PUTSTC
10$: BRW SWHNPE ;Finish off
SWHS01: .ASCIZ / RL:/
SWHS02: .ASCIZ / RP:/
SWHS03: .ASCIZ / PC:/
SWHS04: .ASCIZ / SL:/
SWHS05: .ASCIZ / IL:/
SWHS06: .ASCIZ / IS:/
SWHS07: .ASCIZ / PK:/
SWHS08: .ASCIZ / ISV:/
SWHS09: .ASCIZ / SV:/
SWHS10: .ASCIZ / LM:/
SWHS11: .ASCIZ / RM:/
SWHS12: .ASCIZ / TB:/
SWHS13: .ASCIZ / KEY:/
SWHS14: .ASCIZ / RPL:/
SWHS15: .ASCIZ / CS:/
SWHS16: .ASCIZ / SU:/
.SUBTITLE Switch Handling Subroutines
;Switch handling subroutines. There be:
;SWHMNY - handles a string of switches. R2 points to start of first one
;SWHONE - handles a single switch in PARBUF
;Many switches: transfer each to PARBUF; call SWHONE; loop
;Switches end with a return or a null
;Switches are nulled out of (R2) as they are transferred
;Call with R2 pointing after the "/" of the first switch
SWHMNY::MOVAB PARBUF,R3
MOVL R3,PARPTR
MOVZBL (R2)+,R1 ;Get first switch character
CMPB R1,#^A"X" ;Execute switch?
BEQL SWHMNX ;Yes - special case
CMPB R1,#^A"x"
BEQL SWHMNX ;Yes
TSTB R1
BRB SWHMN4
SWHMN0: MOVZBL (R2)+,R1 ;Transfer switch to parameter buffer
SWHMN4: BEQL SWHMN1 ;If null, handle last switch
CLRB -1(R2) ;Null out the source character
CMPB R1,#^A" " ;Ignore spaces
BEQL SWHMN0
CMPB R1,#^A"/" ;Start of another switch?
BEQL SWHMN1
CMPB R1,#^A"+"
BEQL SWHMN1 ;Yes - process the switch
CMPB R1,#^O15 ;End of line?
BEQL SWHMN1
MOVB R1,(R3)+ ;Else save character
BRB SWHMN0 ;and get another
SWHMN1: MOVQ R1,SAVEAC+16 ;Save latest character and switch pointer
CLRB (R3)+ ;End with a null
BSBW SWHONE ;Process the switch
SWHMN2: MOVQ SAVEAC+16,R1 ;Get character and pointer back
SWHMN3: TSTL R1 ;If done, return
BNEQ 10$
RSB
10$: CMPB R1,#^O15 ;At end of line?
BEQL SWHMNS
BRB SWHMNY ;No - look for another switch
SWHMNS: MOVZBL (R2)+,R1 ;Skip rest of line
BEQL 10$ ;Return, if null
CLRB -1(R2) ;nulling along the way
CMPB R1,#^O12 ;Until linefeed
BNEQ SWHMNS
10$: RSB ;Done
;Here to handle the execute switch separately
SWHMNX: MOVB R1,(R3)+ ;Save the "X"
MOVZBL (R2)+,R1 ;Skip the colon after the "X"
CMPB R1,#^A":" ; (if there is one)
BEQL 20$
TSTB R1
BRB 30$
10$: MOVB R1,(R3)+
20$: MOVZBL (R2)+,R1 ;Save buffer name in parm buffer
30$: BEQL SWHMN3 ;Null - ignore this bad format
CMPB R1,#^O15 ;Start of another switch?
BEQL SWHMN3 ;Yes - ignore this bad format
CMPB R1,#^A"," ;Start of keystroke sequence?
BEQL 40$ ;Yes - set flag for it
CMPB R1,#^A":" ;Start of contents?
BNEQ 10$ ;No - keep going
CLRL R1 ;Clear R1 - no keystroke coming
BRB 50$
40$: CVTBL #-1,R1 ;R1/-1 - keystroke coming
50$: MOVL R1,SAVEAC+12 ;Save keystroke flag
BISL #M_FLG,F ;Set to get a return from XCT routines
CLRB (R3)+ ;End parm buffer with a null
MOVL R2,SAVEAC+16 ;Save pointer
JSB XCTSET ;Set up that buffer
MOVL SAVEAC+16,R2 ;Restore pointer
MOVAB PARBUF+1,R3
TSTL SAVEAC+12 ;Got a keystroke sequence?
BEQL SWHMX1 ;No
PUSHR #^M<R3>
BSBW SWHMXK ;Yes - get keystroke, too
POPR #^M<R3>
SWHMX1: MOVZBL (R2)+,R1 ;Move contents to parm buffer
CMPB R1,#^A"/" ;Start of a new switch?
BNEQ 10$ ;No
BRW SWHMX2 ;Yes - go write the buffer
10$: TSTB R1 ;Null?
BEQL 15$ ;Yes - treat like end of line
CMPB R1,#^O15 ;End of line?
BEQL 20$ ;Yes - see if end of buffer
MOVB R1,(R3)+ ;No - save character
CMPB R1,#^A"^" ;Special flag?
BNEQ SWHMX1 ;No - continue
MOVZBL (R2)+,R1 ;Yes - get next character
CMPB R1,#^A"/" ;Is it a real slash?
BNEQ 10$ ;No - just process normally
MOVB R1,-1(R3) ;Yes - save over the up-arrow
BRB SWHMX1 ; and then continue
15$: MOVL R2,R0 ;Save the current pointer
MOVL SAVEAC+4,R2 ;Get address of next line
MOVL SAVEAC,R1 ;Get byte count of next line
CMPW #-1,R1 ;If byte count = -1, end of file
BEQL 30$
CMPL R2,END_INI ;or if at end of data, call it end of file
BGEQ 30$
CMPB #9,2(R2) ;Is 1st char on next line a tab?
BNEQ 30$ ;No - call it end of line
ADDL R2,R1 ;Compute address of next line
ADDL #2,R1
BBC #0,R1,18$ ;At an odd address?
INCL R1 ;Yes - step to the next one
18$: MOVL R1,SAVEAC+4 ;Save it for next time
MOVZWL (R1),SAVEAC ;Also save the byte count
CLRW (R1) ;Make sure line ends with a null
ADDL #2,R2 ;Go to the start of the line
INCL R2 ;Step past the tab
BRB SWHMX1 ; and continue
20$: MOVL R2,R0 ;Save the current pointer
MOVZBL (R2)+,R1 ;Get the linefeed
CMPB R1,#^O12 ;Is it really?
BNEQ 30$
MOVZBL (R2)+,R1 ;Yes - get first character of next line
CMPB R1,#9 ;Is it a tab?
BNEQ 30$
BRW SWHMX1 ;Yes - ignore CRLF and tab and continue
30$: MOVL R0,R2 ;No - end of this execute buffer
MOVZBL #^O15,R1 ;Get CR and pointer to it back
SWHMX2: MOVQ R1,SAVEAC+16 ;Save character and pointer
CLRB (R3)+
BISL #M_FLG,F ;Set flag to get a return
JSB XCTWRT ;Write the buffer
BRW SWHMN2 ;Restore ACs and continue
SWHMXK: MOVAQ XCTKEY[R1],R4 ;Get pointer to place to store sequence
MOVL R4,SAVEAC+20 ;Save pointer for later
TSTL (R4) ;Any previous keystroke?
BEQL 10$ ;No
PUSHR #^M<R1,R2,R3,R4>
MOVL R1,R2 ;Yes - point to it in the right register
JSB XCTKLK ;Restore the command in the table
POPR #^M<R1,R2,R3,R4>
10$: BISL #^X8000,R1 ;Set execute command flag
MOVL R1,SAVEAC+24 ;Save execute buffer index
CLRL R1 ;Set up character counter
SWMXK1: MOVZBL (R2)+,R0 ;Get character of sequence
BNEQ 10$ ;If null,
5$: BRW SWHMN3 ; ignore this bad format
10$: CMPB R0,#^A":" ;Start of contents?
BEQL SWMXK2 ;Yes - see if command is legal
CMPB R0,#^O15 ;Start of another switch?
BEQL 5$ ;Yes - bad format
CMPB R0,#^A"^" ;No - control character in sequence?
BNEQ 30$
MOVZBL (R2)+,R0 ;Yes - get character
CMPB R0,#^A"?" ;Rubout?
BEQL 20$ ;Yes
BICB #^C^X1F,R0 ;No - make it a control character
BRB 30$
20$: MOVZBL #^O177,R0 ;Set up the rubout
30$: CMPL R1,#8 ;Already stored enough characters?
BGEQ SWMXK1 ;Yes
MOVB R0,(R4)+ ;No - store it
INCL R1 ;and count it
BRB SWMXK1
SWMXK2: TSTL STTFLG ;Initializing?
BEQL 10$ ;No
RSB ;Yes - don't change table now
10$: MOVL SAVEAC+20,R6 ;No - get pointer to sequence
;Fall to change table and return
;Subroutine to change input table - set up or clear execute command
;Enter with execute index in SAVEAC+24, pointer to execute sequence in R6
;Index should have bit 15 set
;If index is -1, editor command is restored in table
;The format of the table is as follows:
;For the normal dispatch table:
; Bit 15 is on if the command is an execute buffer
; Bit 14 is on if the execute buffer contains more than one command
; Bits 13-7 contain the formar (normal) editor command
; Bits 6-0 contain the number of execute commands defined for this
; command
SUBTBX::MOVZBL (R6)+,R4 ;Get the first character of the sequence
CMPB R4,#^O177 ;Rubout?
BNEQ 10$ ;No
CVTBL #-1,R4 ;Yes - use -1 as offset
10$: MULL #4,R4
ADDL ITB(R10),R4 ;Get offset in terminal table
MOVL R4,R1 ;Remember table address
MOVL (R4),R4 ;Is it a normal command?
BLSS SUBTAS ;No - go look in subtable
MOVZBL (R6)+,R0 ;Yes - get next command character
MOVL SAVEAC+24,R6 ;Get execute index
BLSS SUBTX1 ;If negative, go restore old command
BBS #15,R4,SUBTX0 ;Was sequence already set up as an execute?
TSTB R0 ;Is execute sequence 1 character long?
BEQL 20$ ;Yes
MOVZWL #^XC000,R6 ;No - set flag for more input and zero counter
20$: INSV R4,#7,#7,R6 ;Save original command character
MOVL R6,(R1) ;Save the execute call
RSB ;Done
SUBTX0: INCL R4 ;Bump the count of commands
MOVL R4,(R1) ;Save execute call with bumped counter
RSB ;Done
SUBTX1: BBC #14,R4,SUTX1A ;Got at least two commands for this sequence?
BITL #^O77,R4
BEQL SUTX1A ;No
DECL R4 ;Yes - just decrement count and save
BRB SUTX1B
SUTX1A: BICL #^XC000,R4 ;Get original command back
ASHL #-7,R4,R4
SUTX1B: MOVL R4,(R1) ;Save it
RSB ;Done
SUBTAS: MOVZBL (R6)+,R0 ;Get next user-typed character
MOVL R4,TEMP ;Save subtable pointer
SUBTS1: MOVZWL TEMP,R4 ;Compute address of subtable
ADDL R10,R4
CVTWL TEMP+2,R3 ;Get the length of the subtable
SUBTS2: MOVL (R4),R1 ;Get a subtable entry
BNEQ 10$ ;End of the table?
5$: RSB ;Yes - command is not legal
10$: TSTW R1 ;Match on any character?
BEQL SUBTS3 ;Yes - set up real command now
CMPB R0,R1 ;Do user's and table's chars match?
BEQL 20$ ;Yes
ADDL #4,R4 ;Increment to next entry
ADDL #4,R3 ;Also increment the count
BLSS SUBTS2 ;Loop if not finished with table
20$: TSTL R3 ;Not legal if end of table and not found
BGTR 5$
SUBTS3: MOVZWL 2(R4),R1
CMPL R1,#^O137 ;Want another table?
BGTR SUBTSS ;Yes - go get it
SUBTS5: MOVL SAVEAC+24,R0 ;Get execute index
BLSS SUBTS4 ;If none, restore old command
BBC #15,R1,10$ ;Was this already set up as an execute?
INCL R1 ;Yes - bump counter and save
BRB SUBTSX
10$: INSV R1,#7,#7,R0 ;Else save old command with execute index
MOVW R0,2(R4)
RSB ;Done
SUBTSX: BBS #14,R1,SUTSX1 ;More than one command already here? Yes
BISL #^XC001,R1 ;No - there is now (set flag, clear counter)
BICL #^X7E,R1
SUTSX1: MOVW R1,2(R4) ;Save it
RSB ;Done
SUBTS4: BBC #14,R1,SUTS4A ;Got at least two commands for this sequence?
BITL #^O77,R1
BEQL SUTS4A
DECL R1 ;Yes - decrement counter
BRB SUTS4B
SUTS4A: ASHL #-7,R1,R1 ;Get original command back
BICL #^XFF80,R1
SUTS4B: MOVW R1,2(R4) ;Save it in the subtable
RSB ;Done
SUBTSS: BBS #15,R1,SUBTS5 ;Got an execute command? Yes - set it up after all
MOVW R1,TEMP ;No - point to the new subtable
MOVW #-160,TEMP+2
MOVZBL (R6)+,R0 ;Get nex tuser-typed character
BRW SUBTS1 ;and pick up another character
;Subroutine to set up all execute buffer button sequences in the
;terminal input table. This is done on startup in case the table was
;changed after SED.INI was processed, by the user's entry routine
SETXCB::MOVL #XBFNUM-1,R9 ;Loop through all execute buffers
STXCB1: MOVQ XCTKEY[R9],R3 ;Does this buffer have a button?
BEQL STXCB2 ;No - skip it
ADDL3 #^X8000,R9,SAVEAC+24 ;Yes - set up execute index
MOVAQ XCTKEY[R9],R6 ; and pointer
BSBW SUBTBX ;Change table if command is legal
STXCB2: SOBGEQ R9,STXCB1 ;Loop through all buffers
RSB ;Then done
;Subroutine to parse and handle a single switch, which is in parameter buffer
SWHONE::MOVAB PARBUF,R6
CVTBL #-1,R4 ;Assume switch will be set
SWHON1: BSBB SWHLUR ;Get first character
SWHON2: CMPB R1,#^A"A" ;Is it alphabetic?
BLSS 10$
CMPB R1,#^A"Z"
BLEQ 20$
10$: BRW SWHERR ;No - error
20$: MOVL R1,R2 ;Yes - save first character
BSBB SWHLUR ;Get second character
SUBL #^A"A",R2
MOVL SWHADR[R2],R2 ;Get proper dispatch address
JMP (R2) ;Dispatch to switch routine
SWHNNN: CLRL R4 ;Say "NO" has been typed
CMPB R1,#^A"O" ;Is 2nd character an "O"?
BNEQ SWHON2 ;No - dispatch on it
BRB SWHON1 ;Yes - ignore it
;Subroutine to read the next switch character. Doesn't raise case
;and doesn't skip spaces and tabs.
SWHLRX: MOVZBL (R6)+,R1 ;Get the next character
BRB SWHLR1 ;Check the usual things and return
;Subroutine to read the next switch characters. Converts lower to upper case
SWHLUR::MOVZBL (R6)+,R1 ;Routine to get next character
CMPB R1,#9 ;Is it a tab?
BEQL SWHLUR ;Yes - ignore it
CMPB R1,#^A" " ;Is it a space?
BEQL SWHLUR ;Yes - ignore it
CMPB R1,#^A"a" ;Lower case?
BLSS SWHLR1 ;No
SUBB #^O40,R1 ;Yes - convert to upper
SWHLR1: CMPB R1,#^A"^" ;Want to force the next character?
BNEQ 10$ ;No
MOVZBL (R6)+,R1 ;Yes - get it
10$: RSB ;Return
;Routines to handle each switch
;2nd switch character is in R1, RSB when done
SWHAAA: CMPB R1,#^A"G" ;AGAIN switch?
BNEQ 4$ ;Yes - handle it
BRW SWHAGN
4$: CMPB R1,#^A"P" ;Append switch?
BNEQ 7$ ;Yes
BRW SWHAPP ;Yes
7$: CMPB R1,#^A"L" ;ALTERNATE file switch?
BEQL 10$ ;Yes
BRW SWAERR ;No - it's ambiguous
10$: CMPL R9,#$SETFI ;Doing a set-file command?
BEQL 15$ ;Yes - switch is illegal
CMPL R9,#$SWTCH ; or doing a switch command?
BNEQ 20$ ;No
15$: BRW SALERR ;Yes - switch is illegal then
20$: MOVL #SPCSIZ-1,R1
30$: MOVB L^FILSPC(R1),R0 ;Swap current and alternate filespecs
MOVB L^OLDSPC(R1),L^FILSPC(R1)
MOVB R0,L^OLDSPC(R1)
SOBGEQ R1,30$
MOVL FSPLEN,R0
MOVL OLDLEN,FSPLEN
MOVL R0,OLDLEN
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
BRB SWHAN1
SWHAPP: CLRL APPFLG ;Assume don't want to append
TSTL R4 ;Want to append?
BEQL 10$ ;No
MOVAB PIKBUF,APPFLG ;Yes - reset the append pointer
10$: RSB
SWHAGN: TSTB CRRFLG ;Has the RCUR flag been given?
BEQL 10$ ;No
BRW SWMERR ;Yes - can't mix RCUR and AGAIN
10$: MOVB #-1,AGNFLG ;Set the AGAIN flag to set to same file twice
SWHAN1: BSBW SWHAG0 ;Read argument, if any
BLBS R0,10$
RSB ;No arg - just return
10$: BRW SWHPC1 ;Argument - set up percent-goto
SWHUPP: MOVB R4,UPPFLG ;Save upper-lower case flag
RSB
SWHCCC: CMPB R1,#^A"A" ;CASE switch?
BEQL SWHCAS ;Yes - handle it
CMPB R1,#^A"R" ;CREATE switch?
BEQL 10$
BRW SWAERR ;No - it's ambiguous
10$: MOVB R4,CREFLG ;Yes - save CREATE flag
RSB ;Done
SWHCAS: TSTL R4 ;Make searches case-dependent?
BGEQ 10$
BICL #M_NLC,F ;Yes
RSB
10$: BISL #M_NLC,F ;No
RSB
SWHSSS: CMPB R1,#^A"L" ;SLIDE switch?
BEQL SWHSLD ;Yes - handle it
CMPB R1,#^A"H" ;Show execute switch?
BEQL SWHSHW ;Yes - handle it
CMPB R1,#^A"C" ;SCROLL switch?
BEQL SWHSCR ;Yes
CMPB R1,#^A"A" ;SAVE switch?
BNEQ 10$
BRB SWHSAV ;Yes - handle it
10$: CMPB R1,#^A"T" ;Strip line numbers switch?
BEQL 20$
BRW SWAERR ;No - it's ambiguous
20$: MOVB R4,STRFLG ;Yes - save strip flag
RSB
SWHSHW: MOVB R4,XSHFLG ;Save show flag
RSB
SWHSLD: TSTL R4 ;If /NOSLIDE disable sliding (ignore arg)
BEQL SWHSL2
BSBW SWHAG0 ;Else see if there's an argument
BLBC R0,SWHSL2 ;No - just enable sliding
TSTL R3 ;Treat /SLIDE=0 like /NOSLIDE
BLEQ SWHSL1
MOVL R3,SLIDNM ;Set up the argument as the new nominal
MOVL R3,SLIDES ; and current slide distances
MOVL #-1,R4 ;Enable sliding and return
BRB SWHSL2
SWHSL1: CLRL R4 ;Disable sliding
SWHSL2: MOVL R4,SLDFLG ;Save slide flag
RSB
SWHSCR: MOVB R4,RLCFLG ;Save the scroll flag
RSB ;Done
SWHSAV: TSTL R4
BEQL SWHSV1 ;Jump if user said /NOSAVE
BSBW SWHAG0 ;Else read argument
BLBS R0,10$
BRW SWGERR ;No arg - error
10$: TSTL R3 ;Did user say /SAVE:0?
BGTR SWHSV2
SWHSV1: CVTBL #-1,R3 ;Yes - use -1 (for no saves)
SWHSV2: MOVL R3,SAVNUM ;Else save # commands between saves
MOVL R3,SAVCNT ;Save as countdown value, too
RSB
SWHBBB: CMPB R1,#^A"E" ;BEEP switch?
BEQL SWHBEP ;Yes - handle it
CMPB R1,#^A"A" ;BACKUP switch?
BEQL 10$
BRW SWAERR ;No - it's ambiguous
10$: MOVB R4,BAKFLG ;Yes - save backup file flag
RSB
SWHBEP: TSTL R4 ;Set beep-on-insert-mode flag?
BEQL 10$
BISL #M_BEP,F1 ;Yes
RSB
10$: BICL #M_BEP,F1 ;No
RSB
SWHRRR: CMPB R1,#^A"A" ;RAISE switch?
BEQL SWHRAI ;Yes - handle it
CMPB R1,#^A"E" ;Reset, read-only or recover switch?
BNEQ 10$
BRB SWHRR1 ;Yes - read another character
10$: CMPB R1,#^A"M" ;RMAR (right margin) switch?
BEQL SWHRMR ;Yes
CMPB R1,#^A"C" ;Replace-current-file switch?
BEQL SWHCUR ;Yes
CMPB R1,#^A"O" ;ROLL switch?
BEQL 20$
BRW SWAERR ;No - it's ambiguous
20$: TSTL R4 ;Roll if user types return on bottom line?
BGEQ 30$
BICL #M_NRC,F ;No
RSB
30$: BISL #M_NRC,F ;Yes
RSB
SWHRAI: MCOMB R4,UPCFLG ;Save raise-case flag
MOVB #-1,INVFLG ;Don't toggle, use UPCFLG
RSB
SWHCUR: TSTB AGNFLG ;Is the AGAIN flag set?
BNEQ 10$ ;No
BRW SWMERR ;Yes - can't mix RCUR and AGAIN
10$: MOVB R4,CRRFLG ;Save replace-current-file switch
RSB
SWHRMR: BSBW SWHAG0 ;Read the RMAR (right margin) position
BLBS R0,10$
BRW SWGERR ;No arg - error
10$: DECL R3 ;Make the value zero-origin
CMPL R3,LMARGN ;Is it to the right of the left margin?
BGTR 20$
BRW SWGERR ;No - error
20$: MOVL R3,RMARGN ;Yes - save it
RSB
SWHRR1: BSBW SWHLUR ;Get 3rd switch character
CMPB R1,#^A"A" ;REA == read-only?
BNEQ 10$
BRW SWHRDO ;Yes
10$: CMPB R1,#^A"C" ;REC == recover journal?
BEQL SWHREC ;Yes
CMPB R1,#^A"S" ;RES == reset nominals?
BEQL 20$
BRW SWAERR ;No - it's ambiguous
20$: TSTL R4 ;Set reset-nominals flag?
BEQL 30$
BISL #M_RST,F ;Yes
JMP RSTNOM ;Reset all nominals now and return
30$: BICL #M_RST,F ;No
RSB
SWHREC: MOVL R4,JRNFLG ;Save recover-journal flag
RSB
SWHJJJ: CMPB R1,#^A"P" ;Justify-prefix switch?
BEQL SWHJHD ;Yes - handle it
CMPB R1,#^A"O" ;Journal switch?
BEQL 10$ ;Yes
BRW SWAERR ;No - error or ambiguous
10$: BICL #M_JRW,F1 ;Assume no journal
TSTL R4 ;Want one after all?
BGEQ 20$ ;No
BISL #M_JRW,F1 ;Yes
CMPL R9,#$SWTCH ;Switch command or set-up?
BNEQ 20$
JMP JRNSTT ;Command - start the journal file now
20$: RSB ;Switch - just return
SWHJHD: TSTL R4 ;Jump to handle /NOJHEAD
BEQL SWJHDN
MOVAB JUSHED,R4 ;Point to the justify header buffer
BSBW SWHAGA ;Read it
BLBS R0,10$ ;Any argument?
BRW SWGERR ;No - error
10$: MOVAB JUSHED,R4
CLRL R3 ;Find length and # characters in header
CLRL R2
SWJHD1: MOVZBL (R4)+,R1 ;Get a character
BEQL SWJHD2 ;Done if null
CMPB R1,#9 ;Tab?
BNEQ 10$ ;No
BISL #7,R3 ;Yes - move length to next tab stop
10$: INCL R3 ;Count the character
INCL R2
BRB SWJHD1
SWJHDN: CLRL R3 ;No header - clear the counts
CLRL R2
SWJHD2: MOVL R2,JSHCNT ;Save number of characters in string
MOVL R3,JSHCHR ;and the number of character positions needed
RSB ;Done
SWHLLL: CMPB R1,#^A"M" ;LMAR switch?
BNEQ 20$
BRW SWHLMR ;Yes - handle it
20$: CMPB R1,#^A"E" ;Length switch?
BEQL 30$
BRW SWAERR ;No - it's ambiguous
30$: BSBW SWHAG0 ;Yes - read argument
BLBS R0,40$
BRW SWGERR ;No arg - error
40$: BBC #V_WDW,F1,50$ ;Got two windows on the screen?
BRW SWHERR ;Yes - error
50$: TSTL STTFLG ;Initializing?
BEQL SWHLPP ;No - set the length up now
MOVW R3,STTFLG+2 ;Yes - save for later
RSB ;Done for now
SWHLPP::MOVL R3,LPP(R10) ;Save in terminal table
MOVL R3,R1
CMPL R1,LPP.0 ;Using all the lines on the screen?
BLSS SETLP1 ;No - put errors on bottom line
BICL3 #^C<M_SLW!M_NEL>,SAVFLG,R2 ;Yes - restore saved SLO and NEL flags
BICL2 #M_SLW!M_NEL,F1
BISL2 R2,F1
BRB SETLPP ;Go finish off
SETLP1: BISL #M_SLW!M_NEL,F1 ;Make errors go on bottom line
SETLPP::MOVL R1,R3 ;(Enter with R1/lines per page)
DECL R3
DIVL3 #3,R1,LINROL ;Compute lines to roll
MOVL R3,LPP.1 ;Save lines per page - 1
MOVL R3,LPP.2 ;Save bottom line of screen
BBC #V_NEL,F1,10$ ;If bottom is scratch, use next line up
DECL LPP.2
10$: RSB
SWHLMR: BSBW SWHAG0 ;Read new LMAR (left margin) position
BLBS R0,10$
BRW SWGERR ;No arg - error
10$: SOBGEQ R3,20$ ;Make value zero-origin
CLRL R3 ;But map zero into zero
20$: CMPL R3,RMARGN ;Is it to the left of the right margin?
BLSS 30$
TSTL RMARGN ;Allow any /LM if no /RM yet
BEQL 30$
BRW SWGERR ;No - error
30$: MOVL R3,LMARGN ;Yes - save it
RSB
SWHOFL: MOVAB NEWSPC,R4
BSBW SWHAGA ;Read the new filespec into a temporary area
TSTL R0 ;Any argument?
BNEQ 10$ ;Yes
BRW SWGERR ;No arg - error
10$: MOVB #-1,OUTFLG ;Say there will be a change of specs
TSTL R9 ;Don't change now if initializing
BNEQ 30$
20$: RSB
30$: CMPB R9,#$SETFI ;O.K. to make the change now?
BEQL 20$ ;No - wait until end of set-file
;Subroutine to set up parse the filespecs given in the /OUT: switch
OUTSET::MOVB #1,OUTFLG ;Note that spec is changing (by OUTFLG gt 0)
MOVAB NEWSPC,R4
PUSHR #^M<R2,R3,R4,R5>
MOVC3 #100,FILSPC,SVASPC ;Save the current specs in case parse fails
MOVC3 #100,NEWSPC,FILSPC ;Move in the new filespecs
POPR #^M<R2,R3,R4,R5>
BSBW PARSEF ;Parse the specs (error on failure)
CLRB OUTFLG ;Say spec change is no longer wanted
MOVB #-1,CHGSPC ;Say specs have changed
BICL #M_SMF,F ;This file and alternate can't be the same
BBS #V_RDO,F,10$ ;Is file read-only?
BISL #M_CHG,F ;No - force the file to be saved
10$: RSB ;Done
SWHWWW: CMPB R1,#^A"R" ;Write switch?
BNEQ 10$
BRB SWHWRT ;Yes - handle it
10$: CMPB R1,#^A"I" ;Width switch?
BEQL 20$
BRW SWAERR ;No - it's ambiguous
20$: BSBW SWHAG0 ;Yes - read argument
BLBS R0,30$
BRW SWGERR ;No arg - error
30$: TSTL STTFLG ;Initializing?
BEQL SWHWID ;No - set the width up now
MOVW R3,STTFLG ;Yes - save for later
RSB ;Done
SWHWID::MOVL R3,CPL(R10) ;Save in terminal table
DECL R3 ;Also save CPL - 1
MOVL R3,CPL.1
CMPL R3,RMARGN ;Need to move the right margin in?
BGEQ 40$
MOVL R3,RMARGN ;Yes - do so
40$: BITL #M_WRP,SAVFLG ;Does terminal wrap around?
BNEQ 50$
RSB ;No - it still doesn't
50$: CMPL R3,CPL.0 ;Yes - is new length shorter than screen?
BLEQ 60$
BISL #M_WRP,F1 ;No - make it wrap
RSB
60$: BICL #M_WRP,F1 ;Yes - no wrap
RSB
SWHRDO: MCOML R4,R4 ;Read-only - complement write flag
SWHWRT: MCOML R4,SAVEAC+36 ;Stage the value in case command is set-file
CMPL R9,#$SETFI ;Is it set-file?
BNEQ SWHWR1 ;No
RSB ;Yes - don't set the flag now
SWHWR1: TSTL R4 ;Set read-only flag?
BEQL 10$
BICL #M_RDO,F ;No
RSB
10$: BISL #M_RDO,F ;Yes
RSB
SWHTBB: TSTL R4 ;Set display tabs flag?
BEQL 10$
BISL #M_DTB,F ;Yes
RSB
10$: BICL #M_DTB,F ;No
RSB
SWHHLP: TSTL R4 ;Set no-help-wanted flag?
BEQL 10$
BICL #M_NHP,F ;No
RSB
10$: BISL #M_NHP,F ;Yes
RSB
SWHIII: CMPB R1,#^A"M" ;Insert mode switch?
BNEQ 10$
BRB SWHIMD ;Yes - handle it
10$: CMPB R1,#^A"C" ;Insert-cr-in-insert-mode switch?
BNEQ 20$
BRB SWHICR ;Yes - handle it
20$: CMPB R1,#^A"D" ;Cheery message (File ID) switch?
BNEQ 30$
BRB SWHID ;Yes - handle it
30$: CMPB R1,#^A"T" ;Insert Tabs switch?
BNEQ 40$
BRB SWHINT ;Yes - handle it
40$: CMPB R1,#^A"S" ;Incremental save switch?
BEQL 50$ ;Yes - handle it
CMPB R1,#^A"N" ;Invert case switch?
BEQL SWHINV ;Yes - handle it
BRW SWAERR ;No - it's ambiguous
50$: TSTL R4 ;Jump if user said /NOISAVE
BEQL SWHII1
BSBW SWHAG0 ;Else read argument
BLBS R0,60$
BRW SWGERR ;No arg - error
60$: TSTL R3 ;Did user say /ISAVE:0?
BGTR SWHII2 ;No
SWHII1: CVTBL #-1,R3 ;Yes - use -1 (for no saves)
SWHII2: MOVL R3,ISVNUM ;Else save # commands between ISAVES
MOVL R3,ISVCNT ;Save as countdown value, too
RSB
SWHICR: TSTL R4 ;Set no cr in insert mode flag?
BEQL 10$
BICL #M_NCR,F ;No
RSB
10$: BISL #M_NCR,F ;Yes
RSB
SWHIMD: TSTL R4 ;Set insert mode?
BEQL 10$
BISL #M_IMD,F ;Yes
RSB
10$: BICL #M_IMD,F ;No
RSB
SWHINV: MCOMB R4,INVFLG ;Save setting of invert-case switch
RSB
SWHID: MOVB R4,TAGFLG ;Save setting of I.D. switch
RSB
SWHINT: MOVB R4,INSTBS ;Save setting of insert-tabs switch
RSB
SWHKKK: MOVB R4,KEYPAD ;Set /KEYPAD switch value
TSTL STTFLG ;Initializing?
BEQL 20$ ;No
10$: RSB ;Yes - wait until later to make the change
20$: MOVL KPD(R10),R4 ;Get address of the keypad manipulation routine
BEQL 10$ ;If it doesn't exist, just return
JMP (R4) ;If it does, call it and return
SWHMMM: MOVB R4,MSGFLG ;Save setting of message switch
RSB
SWHTTT: TSTL R1 ;Make "/T" default to /TABS
BEQL SWHTB0
CMPB R1,#^A":" ;Ditto
BEQL SWHTB0
CMPB R1,#^A"=" ;Ditto
BEQL SWHTB0
CMPB R1,#^A"A" ;and /TA is /TABS, too
BEQL SWHTB0
CMPB R1,#^A"E" ;/TERMINAL?
BNEQ 5$ ;No
BRW SWHTRM ;Yes
5$: CMPB R1,#^A"R" ;/TRAIL switch?
BNEQ 7$ ;No
MOVB R4,TRLFLG ;Yes - save preserve-trailing-spaces flag
RSB ;Done
7$: CMPB R1,#^A"S" ;Tab-set?
BEQL 10$ ;Yes
BRW SWAERR ;No - it's ambiguous
10$: BSBW SWHAG0 ;Tab-set - read the decimal tab position
BLBS R0,20$
BRW SWHERR ;No arg - error
20$: BBSS #V_STB,F1,30$ ;Insure automatic /T:s
JSB TABINI ;Preset /T:n tabs in TABTBL if needed
30$: MOVL R4,-(SP) ;Save the assertion
DECL R3 ;Make column zero-based
BGEQ 40$ ;Was it already zero?
BRW SWGERR ;Yes - it's a bad value
40$: CLRL R4 ;Prepare for EDIV
EDIV #32,R3,R3,R2 ;Get word and position in word
MOVL (SP)+,R4 ;Restore assertion
MULL #4,R3 ;Convert offset to bytes
INSV R4,R2,#1,L^TABTBL(R3) ;Set or clear the bit
RSB
SWHTB0: TSTL R4 ;If notabs,
BEQL SWHTBW ; set up wordwise tabs
SWHTAB: CMPB R1,#^A":" ;Else skip until the colon is found
BEQL SWHTA1 ;Got it - proceed
CMPB R1,#^A"=" ;Also accept an equals sign
BEQL SWHTA1
MOVZBL (R6)+,R1 ;Get the next character
BNEQ SWHTAB ;Maybe this is the colon
BRB SWHTNW ;If no arg, set up normal tabs
SWHTA1: MOVL R6,R0 ;Save pointer to start of argument
BSBW SWHLUR ;Get the 1st argument character
CMPB R1,#^A"W" ;Want wordwise tabs?
BEQL SWHTBW ;Yes - go set them
CMPB R1,#^A"S" ;Want settable tabs?
BEQL SWHTBS ;Yes - go set them
MOVL R0,R6 ;No - point to the argument again
BSBW SWHAG1 ;Read the rest of the numeric argument
BLBC R0,SWHTNW ;No arg - set up normal tabs
MOVL R3,TABLEN ;Save arg as length of a tab
SWHTNW: JSB TABINI ;Preset /T:n tabs in TABTBL (for ruler)
BICL #M_STB,F1 ;Make sure settable tab flag is off
BICL #M_WTB,F ;Clear wordwise tab flag
RSB
SWHTBW: BISL #M_WTB,F ;Set wordwise tab flag
RSB ;Done
SWHTBS: TSTL R4 ;Setting settable tabs?
BEQL SWHTS1 ;No
BICL #M_WTB,F ;Yes - make sure ww tab flag is off
BISL #M_STB,F1 ;Set settable tab flag
RSB
SWHTS1: BICL #M_STB,F1 ;Clear settable tab flag
RSB ;Done
SWHGGG: TSTL R1 ;Treat a lone "G" as GOTO
BEQL SWHPRC
CMPB R1,#^A"O" ;Want the GOTO switch?
BEQL SWHPRC ;Yes
CMPB R1,#^A":" ; or got just "G:"?
BEQL SWHPRC ;Yes
CMPB R1,#^A"=" ; or got just "G="?
BEQL SWHPRC ;Yes
CMPB R1,#^A"R" ;Global-read-only switch?
BEQL 10$
BRW SWAERR ;No - error
10$: MOVB R4,GREFLG ;Yes - save the default read-only flag
BRW SWHRDO ;Set or clear read-only flag and return
SWHPRC: BSBW SWHARG ;Get percentage to go to
BLBS R0,SWHPC1 ;Skip return?
MOVL GOPERC,R3 ;No - so use current percent
BRB SWHPC2
SWHPC1: TSTL R3 ;Got a negative percentage?
BGEQ SWHPC2
MOVL #100,R3 ;Yes - treat as 100%
SWHPC2: CMPL R3,#100 ;Is the value too big?
BLEQ 10$
BRW SWGERR ;Yes - error
10$: MOVL R3,GOPRCT ;O.K. - save starting percent value
RSB
SWHPPP: CMPB R1,#^A"A" ;Page-and-line status switch?
BEQL SWHPAG ;Yes - handle it
CMPB R1,#^A"I" ;Paragraph indent switch?
BEQL SWHPAR ;Yes - handle it
CMPB R1,#^A"R" ;Prog to run on exit switch?
BEQL 10$ ;Yes
BRW SWAERR ;No - it's ambiguous
10$: MOVZBL (R6)+,R1 ;Any argument given?
BEQL 30$ ;No
CMPB R1,#^A":" ;Check for colon or equals sign
BEQL 20$
CMPB R1,#^A"="
BNEQ 10$
20$: BRW SET_PROG ;Set up the program to run and return
30$: CLRB PROG_NAME ;If no argument, just clear the name
RSB ;and return
SWHPAG: MOVB R4,PAGFLG ;Save page/lines flag
RSB
SWHPAR: BSBW SWHAG0 ;Read amount to indent a paragraph
BLBS R0,10$ ;Any argument?
CLRL R3 ;No arg - set no indent
10$: MOVL R3,PARIND ;Save the value
RSB ;Done
SWHQQQ: MOVB R4,DSPFLG ;Save DISPLAY-ON-SETFIL flag
RSB
SWHTRM: MOVL #^A" ",XCTFIL ;Initialize term type to spaces (use execute
MOVL #^A" ",XCTFIL+4 ;file name buffer for temporary)
MOVAB XCTFIL,R4 ;Point to the argument storage
BSBW SWHAGA ;Go get the terminal type
BLBS R0,10$ ;Was a value found?
BRW SWGERR ;No - error
10$: MOVB #^A" ",-1(R4) ;Put a space in where the null was put by SWHAGA
PUSHR #^M<R1,R2,R3,R4,R5,R6>
MOVL #NAMLEN,R6 ;Get the number of entries
DIVL #4,R6
20$: MOVAQ TRMNAM[R6],R4 ;Point to the name
CMPC3 #8,XCTFIL,(R4) ;Is this the one?
TSTL R0
BEQL 30$ ;Yes
SOBGEQ R6,20$ ;No - loop through the table
POPR #^M<R1,R2,R3,R4,R5,R6>
BRW SWGERR ;Not found - error
30$: MOVL NAMTAB[R6],TERMTYPE ;Save the terminal type code
POPR #^M<R1,R2,R3,R4,R5,R6>
RSB ;and return
SWHFFF: TSTB R1 ;Just "F" is ambiguous
BNEQ 10$
BRW SWAERR
10$: CMPB R1,#^A"E" ;Fence switch?
BEQL SWHFNC ;Yes - handle it
CMPB R1,#^A"I" ;Justify-fill switch?
BNEQ SWHSTT ;No - go handle the file switches
MOVB R4,FLLFLG ;Yes - set the fill flag
RSB ;Done
SWHFNC: BRW SWHERR ;/FENCE not yet implemented
;Here for various file status switches: FC, FR, FS, FD, FO
;If these are used, /FD must appear and be first
SWHSTT: MOVL R1,R2 ;Save flavor of switch
BSBB SWHAG0 ;Read its argument
BLBS R0,10$
BRW SWHERR ;No arg - error
10$: CMPB R2,#^A"C" ;FC (column position) switch?
BEQL SWHSTC ;Yes - go do it
CMPB R2,#^A"R" ;FR (row position) switch?
BEQL SWHSTR ;Yes - go do it
CMPB R2,#^A"S" ;FS (slide offset) switch?
BEQL SWHSTL ;Yes - go do it
CMPB R2,#^A"D" ;FD (display pointer) switch?
BEQL SWHSTD ;Yes - go do it
CMPB R2,#^A"O" ;FO (one-shot) switch?
BEQL SWHOSH ;Yes - go do it
BRW SWHERR ;Anything else is an error
SWHSTC: MOVL R3,PRERW+4 ;Set up column position
RSB
SWHSTR: MOVL R3,PRERW ;Set up row position
RSB
SWHSTL: MOVL R3,PRESL ;Set up slide offset
RSB
SWHOSH: MOVL R3,PREONE ;Set up one-shot pointer
RSB
SWHSTD: CLRQ PRERW ;Clear the other pointers
CLRL PRESL
ADDL3 #BUFFER,R3,PREDP ;Point to the right place
RSB
;Subroutine to read colon (maybe) and numeric argument of a switch
;Returns value in R3; uses R1
;Returns R0=1 if value found, R0=0 if no colon found
SWHAG0: MOVZBL (R6)+,R1 ;Get the colon
SWHARG: CMPB R1,#^A":" ;Got a colon?
BEQL SWHAG1 ;Yes
CMPB R1,#^A"=" ;or an equals sign?
BEQL SWHAG1 ;Yes
TSTB R1 ;No - try next one, if any
BNEQ SWHAG0
SWHAG1: TSTB R1 ;Was a colon found?
BNEQ 10$ ;Yes
CLRL R0 ;No - give the non-skip return
RSB
10$: MOVL #1,R0 ;Indicate colon was found
CLRL R3 ;Clear the target
SWHAG2: MOVZBL (R6)+,R1 ;Get a digit
BNEQ 10$ ;Return if null
RSB
10$: SUBL #^A"0",R1 ;Convert to numeric
BLSS SWGER0 ;Error if not a number
CMPL R1,#9
BGTR SWGER0 ;Not a number
MULL #10,R3 ;Else multiply by ten
ADDL R1,R3 ;Add in new digit
BRB SWHAG2 ;and get another one
;Subroutine to read ascii argument of a switch into (R4)
;Returns R0/1 if a value was found, R0/0 if no value found
SWHGA0: MOVZBL (R6)+,R1 ;Get the colon
SWHAGA: CMPB R1,#^A":" ;Is it really?
BEQL 10$
CMPB R1,#^A"=" ;How about an equal sign?
BEQL 10$ ;Yes - accept it in place of the colon
TSTB R1 ;No - try next one, if any
BNEQ SWHGA0
CLRL R0 ;No colon - indicate that
RSB
10$: MOVL #1,R0 ;Indicate colon was found
20$: MOVB (R6)+,(R4)+ ;Save characters
BNEQ 20$ ; until a null is found
RSB ;Then return
;If switch error output message, return to caller of SWHONE
SWHER0: MOVL (SP)+,R0 ;Return to caller of SWHONE
SWHERR: MOVAB SWHERM,R1
SWHER1: MOVAB PARBUF,ERRCOD ;Bad switch is in PARBUF
CMPL R9,#$SETFI ;Doing a set-file?
BNEQ 10$ ;No
BRW STFERR ;Yes - give set-file-flavored error
10$: BRW ERROR ;Else display the error and return
SWAERR: MOVAB SWHERM,R1
BRB SWHER1
SWGER0: MOVL (SP)+,R0 ;Return to caller of SWHONE
SWGERR: MOVAB SWGERM,R1
BRB SWHER1
SALERR: MOVAB SALERM,R1
JMP ERROR ;(Always treat as a non-set-file error)
SWMERR: MOVAB SWMERM,R1
JMP ERROR ;(Always treat as a non-set-file error)
SDCERR: MOVAB SDCERM,R1
JMP ERROR ;(Always treat as a non-set-file error)
SWHERM: .ASCIZ /#####Illegal switch "^A"/
SWAERM: .ASCIZ /##Ambiguous switch "^A"/
SWGERM: .ASCIZ /######Illegal or missing switch argument "^A"/
SALERM: .ASCIZ ?####Use /ALT only at DCL level?
SWMERM: .ASCIZ ?Can't use /RCUR and /AGAIN together?
SDCERM: .ASCIZ ?######Illegal argument for /DC:?
;Subroutine to set up the program to run or command to execute
;Called from the /PROG= switch and at exit time if a parameter is given
SET_PROG::
CLRB PROG_FLAG ;Assume a program is to be run
MOVAB PROG_NAME,R4 ;Tell where to store the data
MOVZBL (R6)+,R1 ;Get a character
BNEQ 5$ ;Give an error if no argument is given
BRW SWGERR
5$: CMPB R1,#^A"$" ;Is it a dollar sign?
BNEQ 10$ ;No
MOVB #-1,PROG_FLAG ;Yes - indicate want to execute a command
BRB 30$ ; and leave out the dollar sign
10$: CMPB R1,#^A"@" ;Want to execute a command file?
BNEQ 20$ ;No
MOVB #-1,PROG_FLAG ;Yes - remember it
20$: MOVB R1,(R4)+ ;Save the character
30$: MOVB (R6)+,(R4)+ ;Store the next character
BNEQ 30$ ;Loop until all are copied
SUBL3 #PROG_NAME+1,R4,R1 ;Compute the number of characters
MOVW R1,PROG_BLOCK ; and save them in the descriptor
RSB ;Then return
.SUBTITLE Switch Dispatch Table
SWHADR: .ADDRESS SWHAAA ;A
.ADDRESS SWHBBB ;B
.ADDRESS SWHCCC ;C
.ADDRESS SWHTBB ;D
.ADDRESS SWHERR ;E
.ADDRESS SWHFFF ;F
.ADDRESS SWHGGG ;G
.ADDRESS SWHHLP ;H
.ADDRESS SWHIII ;I
.ADDRESS SWHJJJ ;J
.ADDRESS SWHKKK ;K
.ADDRESS SWHLLL ;L
.ADDRESS SWHMMM ;M
.ADDRESS SWHNNN ;N
.ADDRESS SWHOFL ;O
.ADDRESS SWHPPP ;P
.ADDRESS SWHQQQ ;Q
.ADDRESS SWHRRR ;R
.ADDRESS SWHSSS ;S
.ADDRESS SWHTTT ;T
.ADDRESS SWHUPP ;U
.ADDRESS SWHERR ;V
.ADDRESS SWHWWW ;W
.ADDRESS SWHERR ;X
.ADDRESS SWHERR ;Y
.ADDRESS SWHERR ;Z
GLOB ;Define the global symbols
.END