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

1443 lines
47 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE SED1SW - SED SWITCH ROUTINES
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 FOR THE COMMAND TO SET A NUMBER OF SWITCHES
SWITCH::MOVE T1,PARPTR ;DID USER TYPE JUST ENTER SWITCH?
CAME T1,[POINT 7,PARBUF]
CAMN T1,[010700,,PARBUF-1]
JRST SWHSTS ;YES - GIVE HIM SOME STATUS INFORMATION
PUSHJ P,ERASPM ;ELSE ERASE PARAMETER
SETZ T1, ;END PARAMETER WITH A NULL
IDPB T1,PARPTR
MOVE PT,[POINT 7,PARBUF]
MOVE T3,PT
ILDB T1,T3 ;GET FIRST CHARACTER
CAIN T1,"/" ;SUPERFLUOUS SLASH?
MOVE PT,T3 ;YES - SKIP IT
PUSHJ P,SWHMNY ;HANDLE THE SWITCH(S) IN THE PARAMETER BUFFER
JRST DISCUR ;RE-POSITION CURSOR AND GET NEW COMMAND
;HERE ON SWITCH WITH NO PARAMETER: GIVE FILE STATUS
SWHNPM::PUSHJ P,SWHBOT ;SET UP THE BOTTOM LINE
MOVEI T1,[ASCIZ /FILE: /]
PUSHJ P,PUTSTG
MOVEI T1,"*" ;GET FILE-IS-CHANGED FLAG
TRNN F,RDO ;IS FILE WRITEABLE,
TLNN F,CHG ; AND HAS IT BEEN CHANGED?
CAIA ;NOT WRITEABLE OR NOT CHANGED - SKIP THIS
IDPB T1,TY ;BOTH - OUTPUT THE FACT THAT IT'S CHANGED
MOVEI T1,FILSPC
PUSHJ P,PUTSTF
PUSHJ P,MAKCPT ;MAKE A GOOD CHARACTER POINTER
MOVE T2,RW ;SAVE REAL ROW POINTER
MOVE PT,[010700,,BUFFER-1]
PUSHJ P,FINDRW ;COUNT PAGES AND LINES FROM START OF BUFFER
EXCH T2,RW
EXCH T2,SAVEAC
SKIPN PAGFLG ;WANT BOTH PAGES AND LINES?
JRST SWHNP1 ;NO - JUST LINES
MOVEI T1,[ASCIZ / PAGE: /]
PUSHJ P,PUTSTG
MOVEI T1,1(T3) ;GET PAGE NUMBER
PUSHJ P,PUTNUM ;OUTPUT PAGE
MOVEI T1,"-"
IDPB T1,TY
AOS T1,SAVEAC ;GET LINE NUMBER
PUSHJ P,PUTNUM ;OUTPUT IT
JRST SWHNP2 ;SKIP LINES-ONLY STUFF
SWHNP1: MOVEI T1,[ASCIZ / LINE: /]
PUSHJ P,PUTSTG
MOVEI T1,1(T2) ;GET LINE NUMBER
PUSHJ P,PUTNUM ;OUTPUT IT
SWHNP2: MOVEI T1,"("
IDPB T1,TY
HRRZ T1,LINPTR ;GET OFFET OF PAGE INTO BUFFER
SUBI T1,BUFFER-1
IMULI T1,^D100 ;TIMES 100
HRRZ T2,EN ;DIVIDED BY SIZE OF FILE
SUBI T2,BUFFER
IDIV T1,T2
PUSHJ P,PUTNUM ;OUTPUT PERCENT THROUGH FILE
MOVEI T1,[ASCIZ /%) POS: /]
PUSHJ P,PUTSTG
MOVEI T1,1(CM) ;OUTPUT COLUMN + SLIDE + 1
ADD T1,SL
PUSHJ P,PUTNUM
SKIPN OLDSPC ;GOT AN ALTERNATE FILE?
JRST SWHNPE ;NO - DON'T TALK ABOUT IT
MOVEI T1,[ASCIZ / ALT: /]
PUSHJ P,PUTSTG
MOVEI T1,OLDSPC
PUSHJ P,PUTSTF
SWHNPE::MOVEI T1," "
IDPB T1,TY
SETZ T1,
MOVE T2,CPL.1 ;GET TERMINAL WIDTH - 1
SUBI T2,3 ;(IN CASE THE TTY COUNTS THE PROT'N CHARS)
IFN TOPS10,<
IDIVI T2,5 ;FIND NUMBER OF WORDS + REMAINDER
ADD T2,[POINT 7,TYPBUF,6] ;ADJUST PTR TO THE RIGHT WIDTH
HRL T2,PTRTBL+1(T3)
>
IFE TOPS10,<
IFN FTECHO,<
ADJBP T2,[POINT 8,TYPBUF,7]
>
IFE FTECHO,<
ADJBP T2,[POINT 7,TYPBUF,6]
>>
DPB T1,T2 ;MAKE MESSAGE END AT WIDTH - 1
PUSHJ P,PUTTYP ;OUTPUT THE TEXT
PUSHJ P,PROTOF ;TURN PROTECTION OFF
TLO F,FBL ;SAY BOTTOM LINE HAS BEEN FRAGGED
JRST DISCUR ;RE-POSITION CURSOR AND RETURN
;SUBROUTINE TO SET UP THE BOTTOM OF THE SCREEN FOR THE SWITCH COMMAND ETC.
SWHBOT::PUSHJ P,RESTPM ;CLEAN UP THE PARAMETER ENTRY
PUSHJ P,CBOTOM ;PUT MESSAGE ON BOTTOM LINE
PUSHJ P,PROTON ;PROTECTED
JRST PUTTYP ;OUTPUT POSITIONING NOW AND RETURN
;HERE ON TOKEN SWITCH (ENTER, BUT NO PARAMETER): GIVE NOMINAL SETTINGS
SWHSTS: PUSHJ P,SWHBOT ;SET UP THE BOTTOM LINE
MOVEI T1,[ASCIZ / RL:/]
PUSHJ P,PUTSTG
MOVE T1,ROLLIN ;OUTPUT NUMBER OF LINES TO ROLL
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / RP:/]
PUSHJ P,PUTSTG
MOVE T1,ROLPGS ;OUTPUT NUMBER OF PAGES TO ROLL
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / PC:/]
PUSHJ P,PUTSTG
MOVE T1,GOPERC ;OUTPUT PERCENT-GOTO NOMINAL
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / SL:/]
PUSHJ P,PUTSTG
MOVE T1,SLIDES ;OUTPUT SIZE OF SLIDE
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / IL:/]
PUSHJ P,PUTSTG
MOVE T1,ADDLNS ;OUTPUT NUMBER OF LINES TO INSERT/DELETE
PUSHJ P,PUTNUM
SKIPN T1,ADDLSP ;GOT SPACES TO GO WITH THOSE LINES?
JRST SWHST1 ;NO - SKIP OUTPUT
MOVEI T1,","
IDPB T1,TY
MOVE T1,ADDLSP ;AND SPACES TO GO WITH THOSE LINES
PUSHJ P,PUTNUM
SWHST1: MOVEI T1,[ASCIZ / IS:/]
PUSHJ P,PUTSTG
MOVE T1,ADDSPC ;OUTPUT NUMBER OF SPACES TO INSERT/DELETE
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / PK:/]
PUSHJ P,PUTSTG
MOVE T1,PICKLN ;OUTPUT NUMBER OF LINES TO PICK
PUSHJ P,PUTNUM
SKIPN T1,PICKSP ;GOT SPACES TO GO WITH THOSE LINES?
JRST SWHST2 ;NO - SKIP OUTPUT
MOVEI T1,","
IDPB T1,TY
MOVE T1,PICKSP ;AND SPACES TO PICK, TOO
PUSHJ P,PUTNUM
SWHST2: MOVEI T1,[ASCIZ / CS:/]
PUSHJ P,PUTSTG
SKIPN T1,CASLNS ;CHANGING THE CASE OF ANY LINES?
JRST SWHS2A ;NO - SKIP OUTPUT
PUSHJ P,PUTNUM ;YES - OUTPUT THEM AND A COMMA
MOVEI T1,","
IDPB T1,TY
SWHS2A: MOVE T1,CASSPS ;OUTPUT NUMBER OF CHARS TO CHANGE CASE OF
PUSHJ P,PUTNUM
MOVEI T1,[ASCIZ / SU:/]
PUSHJ P,PUTSTG
MOVE T1,SUBCNT ;OUTPUT NUMBER OF SUBSTITUTES TO DO
PUSHJ P,PUTNUM
HLRZ T1,ISVNUM ;GOT AN INCREMENTAL SAVE?
JUMPN T1,SWHST3 ;NO
MOVEI T1,[ASCIZ / ISV:/]
PUSHJ P,PUTSTG
MOVE T1,ISVNUM
PUSHJ P,PUTNUM
SWHST3: HLRZ T1,SAVNUM ;GOT AN INCREMENTAL TYPEIN SAVE?
JUMPN T1,SWHST4 ;NO
MOVEI T1,[ASCIZ / SV:/]
PUSHJ P,PUTSTG
MOVE T1,SAVNUM
PUSHJ P,PUTNUM
SWHST4: SKIPG LMARGN ;GOT A CHANGED LEFT MARGIN?
JRST SWHST5 ;NO
MOVEI T1,[ASCIZ / LM:/]
PUSHJ P,PUTSTG
MOVE T1,LMARGN
PUSHJ P,PUTNPO
SWHST5: MOVE T1,RMARGN ;GOT A RIGHT MARGIN WITHIN THE SCREEN?
CAML T1,CPL.1
JRST SWHST6 ;NO
MOVEI T1,[ASCIZ / RM:/]
PUSHJ P,PUTSTG
MOVE T1,RMARGN
PUSHJ P,PUTNPO
SWHST6: MOVEI T1,[ASCIZ / TB:/]
PUSHJ P,PUTSTG ;OUTPUT SIZE OF TAB
TRNE F,WTB ;GOT WORD-WISE TABS?
JRST SWHS6W ;YES - CALL THEM SIZE "W" (RETURN TO SWHST7)
TLNE TM,STB ;GOT SETTABLE TABS?
JRST SWHS6S ;YES - CALL THEM SIZE "S" (RETURN TO SWHST7)
MOVE T1,TABLEN ;NO - OUTPUT SIZE OF TAB
PUSHJ P,PUTNUM
SWHST7: SKIPN SRCKEY ;GOT A SEARCH KEY?
JRST SWHST8 ;NO
MOVEI T1,[ASCIZ / KEY:/]
PUSHJ P,PUTSTG
MOVEI T1,SRCKEY
PUSHJ P,PUTSTC
SWHST8: SKIPN SUBSTG ;GOT A SUBSTITUTE STRING?
JRST SWHNPE ;NO
MOVEI T1,[ASCIZ / RPL:/]
PUSHJ P,PUTSTG
MOVEI T1,SUBSTG
PUSHJ P,PUTSTC
JRST SWHNPE ;FINISH OFF
SWHS6W: SKIPA T1,["W"] ;CALL WORD-WISE TABS SIZE "W"
SWHS6S: MOVEI T1,"S" ;CALL SETTABLE TABS SIZE "S"
IDPB T1,TY
JRST SWHST7
;SWITCH HANDLING SUBROUTINES. THERE BE:
;SWHMNY - HANDLES A STRING OF SWITCHES. PT POINTS TO START OF FIRST ONE
;SWHONE - HANDLES A SINGLE SWITCH IN PARBUF
;MANY SWITCHES: FIND CHARACTER AFTER NEXT SWITCH; SAVE IT; REPLACE IT
; WITH A NULL; CALL SWHONE; LOOP
;SWITCHES END WITH A RETURN OR A NULL
;CALL WITH PT POINTING AFTER THE "/" OF THE FIRST SWITCH
;FOR NON-EXECUTE SWITCHES, ^ANYTHING IS A REAL ANYTHING, AND THE UP-ARROW
;IS IGNORED (USEFUL FOR ^/ AND ^^).
SWHMNY::MOVEM PT,SAVEAC+4 ;SAVE THE POINTER TO THE START OF THE SWITCH
SWHMN1: ILDB T1,PT ;GET FIRST SWITCH CHARACTER
CAIE T1,"X" ;EXECUTE SWITCH?
CAIN T1,"x"
JRST SWHMNX ;YES - SPECIAL CASE
PUSHJ P,SWHNUL ;NO - FIND, SAVE, AND NULL CHAR. AFTER THE SWH
PUSHJ P,SWHONE ;NO - PROCESS THE SWITCH
SWHMN2: MOVE PT,SAVEAC+4 ;POINT TO THE START OF THE NEXT ONE
SKIPN SAVEAC+5 ;GOT MORE SWITCHES?
POPJ P, ;NO - DONE
JRST SWHMN1 ;YES - LOOP TO PROCESS THEM
SWHMN3: JUMPN T1,SWHMN1 ;JUMP IF GOT MORE SWITCHES
POPJ P, ;ELSE DONE
;SUBROUTINE TO FIND THE FIRST CHARACTER OF THE NEXT SWITCH,
;SAVE IT AND ITS POINTER IN SAVEAC+5 AND +4, AND CHANGE IT TO A NULL
SWHNUL: ILDB T1,PT ;GET THE NEXT CHARACTER
CAIN T1,"^" ;WANT TO FORCE THE NEXT CHARACTER?
JRST [ILDB T1,PT ;YES - SKIP OVER IT
JRST SWHNUL] ;AND GET THE NEXT ONE
CAIL T1,"0" ;IS THE CHARACTER INTERESTING?
JRST SWHNUL ;NO - JUST SKIP OVER IT
JUMPE T1,SWHNL1 ;YES - DONE IF NULL
CAIN T1,15 ;END OF A LINE?
JRST SWHMNS ;YES - SKIP TO LINEFEED AND RETURN
CAIE T1,"/" ;START OF ANOTHER SWITCH?
CAIN T1,"+"
TDZA T0,T0 ;YES - GET A NULL AND SKIP
JRST SWHNUL ;NO - KEEP SKIPPING
DPB T0,PT ;NULL OUT THE CHARACTER
SWHNL1: EXCH PT,SAVEAC+4 ;SAVE PTR TO NEXT SWITCH; GET PTR TO THIS ONE
MOVEM T1,SAVEAC+5 ;SAVE THE CHARACTER
POPJ P, ;DONE
SWHMNS: SETZ T1, ;NULL OUT THE CARRIAGE RETURN
DPB T1,PT
SWHMS1: ILDB T0,PT ;SKIP UNTIL NULL OR LINEFEED
JUMPE T0,SWHNL1 ;IF NULL, SAVE POINTERS AND FINISH
CAIN T0,12 ;LINEFEED?
JRST SWHNL1 ;YES - FINISH OFF
JRST SWHMS1 ;ELSE KEEP LOOKING
;HERE TO HANDLE THE EXECUTE SWITCH SEPARATELY
SWHMNX: MOVE T3,[POINT 7,PARBUF]
IDPB T1,T3 ;SAVE THE "X"
ILDB T1,PT ;SKIP THE COLON AFTER THE "X"
CAIE T1,":" ; (IF THERE IS ONE)
JRST SWMXL2
JRST SWMXL1
SWHMXL: IDPB T1,T3
SWMXL1: ILDB T1,PT ;SAVE BUFFER NAME IN PARM BUFFER
SWMXL2: JUMPE T1,SWHMN3 ;NULL - IGNORE THIS BAD FORMAT
CAIN T1,15 ;START OF ANOTHER SWITCH?
JRST SWHMN3 ;YES - IGNORE THIS BAD FORMAT
CAIN T1,"," ;START OF KEYSTROKE SEQUENCE?
JRST SWHMX0 ;YES - SET FLAG FOR IT
CAIE T1,":" ;START OF CONTENTS?
JRST SWHMXL ;NO - KEEP GOING
TDZA T1,T1 ;CLEAR T1 - NO KEYSTROKE COMING
SWHMX0: MOVSI T1,-1 ;T1/-1,,0 - KEYSTROKE COMING
MOVEM T1,SAVEAC+3 ;SAVE KEYSTROKE FLAG
TLO F,FLG ;SET TO GET A RETURN FROM XCT ROUTINES
IDPB T1,T3 ;END PARM BUFFER WITH A NULL
MOVEM PT,SAVEAC+4 ;SAVE POINTER
PUSHJ P,XCTSET ;SET UP THAT BUFFER
MOVE PT,SAVEAC+4 ;RESTORE POINTER
SKIPE SAVEAC+3 ;NOW GOT A KEYSTROKE SEQUENCE?
PUSHJ P,SWHMXK ;YES - GET KEYSTROKE, TOO
;FIND END OF SWITCH. SAVE IT AND REPLACE IT WITH A NULL.
MOVEM PT,SAVEAC+4 ;SAVE POINTER TO START OF SEQUENCE
SWHMX1: ILDB T1,PT ;GET THE NEXT CHARACTER
CAIN T1,"/" ;START OF A NEW SWITCH?
JRST SWHMX2 ;YES - SET UP CONTENTS
SWMX1A: JUMPE T1,SWMX1E ;NULL - TREAT LIKE END OF LINE
CAIN T1,15 ;END OF LINE?
JRST SWMX1E ;YES - SEE IF END OF BUFFER
CAIE T1,"^" ;NO - SPECIAL FLAG?
JRST SWHMX1 ;NO - CONTINUE
ILDB T1,PT ;YES - GET NEXT CHARACTER
CAIE T1,"/" ;IS IT A REAL SLASH?
JRST SWMX1A ;NO - JUST PROCESS NORMALLY
DPB T1,T3 ;YES - SAVE OVER THE UP-ARROW
JRST SWHMX1 ;AND THEN CONTINUE
SWMX1E: ILDB T1,PT ;END OF A LINE - GET THE LINEFEED
MOVE T0,PT ;SAVE THE CURRENT POINTER
CAIN T1,12 ;IS IT REALLY A LINEFEED?
ILDB T1,PT ;YES - GET FIRST CHARACTER OF NEXT LINE
CAIN T1,11 ;IS IT A TAB?
JRST SWHMX1 ;YES - IGNORE CRLF AND TAB AND CONTINUE
MOVE PT,T0 ;NO - END OF THIS DEFINITION - GET POINTER BACK
SETZ T1, ;SAVE A NULL AS THE TERMINATOR
SWHMX2: MOVEM T1,SAVEAC+5 ;SAVE TERMINATING CHARACTER
SETZ T1, ;COVER THE TERMINATOR WITH A NULL
DPB T1,PT
SWHMX3: EXCH PT,SAVEAC+4 ;SAVE PTR TO END OF SWITCH; GET PTR TO START
TLO F,FLG ;SET FLAG TO GET A RETURN
PUSHJ P,XCWRT0 ;WRITE THE BUFFER
JRST SWHMN2 ;FINISH OFF OR PROCESS NEXT SWITCH
;HERE TO READ AND SAVE THE EXECUTE KEY SEQUENCE
SWHMXK: MOVEI T4,XCTKEY(T1) ;GET POINTER TO PLACE TO STORE SEQUENCE
HRLI T4,440700 ;(INDEPENDENT OF T1)
MOVEM T4,SAVEAC+5 ;SAVE POINTER FOR LATER
SETZM XCTKEY(T1) ;CLEAR PREVIOUS KEYSTROKE (IF ANY)
TRO T1,200000 ;SET EXECUTE COMMAND FLAG
MOVEM T1,SAVEAC+6 ;SAVE EXECUTE BUFFER INDEX
SWMXK1: ILDB T0,PT ;GET CHARACTER OF SEQUENCE
CAIN T0,":" ;START OF CONTENTS?
JRST SWMXK2 ;YES - SEE IF COMMAND IS LEGAL
JUMPE T0,SWHMN3 ;NULL - IGNORE THIS BAD FORMAT
CAIN T0,15 ;START OF ANOTHER SWITCH?
JRST SWHMN3 ;YES - IGNORE THIS BAD FORMAT
CAIN T0,"^" ;CONTROL CHARACTER IN SEQUENCE?
PUSHJ P,SWMXKC ;YES - FIND WHICH CHARACTER IT SHOULD BE
TLNE T4,760000 ;ALREADY GOT 5 CHARACTERS?
IDPB T0,T4 ;NO - SAVE CHARACTER
JRST SWMXK1 ;AND GET ANOTHER
;SUBROUTINE TO READ THE CHARACTER AFTER AN "^". IT'S EITHER A CONTROL
;CHARACTER, A RUBOUT, OR A REAL "^" OR ":"
SWMXKC: ILDB T0,PT ;GET THE NEXT CHARACTER
CAIN T0,"?" ;WANT A RUBOUT?
JRST SWMXC1 ;YES - SET IT UP
CAIN T0,"=" ;WANT A REAL UP-ARROW?
JRST SWMXC2 ;YES (NOTE: ^^ IS A CONTROL CHARACTER)
CAIE T0,":" ;WANT A REAL COLON?
ANDI T0,37 ;NO - MAKE THE CHARACTER A CONTROL CHARACTER
POPJ P, ;DONE
SWMXC1: TROA T0,177 ;MAKE ^? BE A RUBOUT
SWMXC2: MOVEI T0,"^" ;MAKE ^= BE A REAL UP-ARROW
POPJ P, ;DONE
;HERE WHEN COMMAND DEFINITION IS COMPLETE. NOW SEE IF IT'S LEGAL
SWMXK2: SKIPE STTFLG ;INITIALIZING?
POPJ P, ;YES - DON'T CHANGE TABLE NOW
MOVE T2,SAVEAC+5 ;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+6, POINTER TO EXECUTE SEQUENCE IN T2
;INDEX SHOULD HAVE THE 200000 BIT SET
;IF INDEX IS -1, EDITOR COMMAND IS RESTORED IN TABLE
SUBTBX::MOVEM T2,SAVEAC+7 ;SAVE THE POINTER TO THE SEQUENCE
ILDB T4,T2 ;GET FIRST CHARACTER
CAIN T4,177 ;RUBOUT?
SETO T4, ;YES - USE -1 AS OFFSET
ADD T4,ITB(TM) ;GET OFFSET IN TERMINAL TABLE
MOVE T1,T4 ;REMEMBER TABLE ADDRESS
SKIPGE T4,(T4) ;IS IT A NORMAL COMMAND?
JRST SUBTAS ;NO - GO LOOK IN SUBTABLE
ILDB T0,T2 ;YES - GET NEXT COMMAND CHARACTER
SKIPGE T2,SAVEAC+6 ;GET EXECUTE INDEX - NEGATIVE?
JRST SUBTX1 ;YES - GO RESTORE OLD COMMAND
TRNE T4,200000 ;WAS SEQUENCE ALREADY SET UP AS AN EXECUTE?
AOJA T4,SUBTX0 ;YES - BUMP COUNTER AND SAVE
CAIE T0,0 ;IS EXECUTE SEQUENCE 1 CHARACTER LONG?
MOVEI T2,300000 ;NO - SET FLAG FOR MORE INPUT & ZERO COUNTER
DPB T4,[POINT 9,T2,29]
MOVEM T2,(T1) ;NO - SAVE EXECUTE CALL NOW
;NOW CONVERT ALL LOWER CASE CHARACTERS IN THE SEQUENCE TO UPPER CASE
SUBTBR: SKIPGE SAVEAC+6 ;REMOVING THE DEFINITION?
POPJ P, ;YES - DONE
MOVE T2,SAVEAC+7 ;NO - GET THE POINTER TO THE SEQUENCE
SUBTR1: ILDB T1,T2 ;CONVERT LOWER TO UPPER CASE - GET A CHARACTER
JUMPE T1,CPOPJ ;DONE IF NULL
CAIL T1,"a" ;ELSE IS IT LOWER CASE?
CAILE T1,"z"
JRST SUBTR1 ;NO - SKIP THIS CHARACTER
SUBI T1,40 ;YES - CONVERT TO UPPER
DPB T1,T2 ;SAVE IT BACK
JRST SUBTR1 ;AND LOOK AT THE NEXT CHARACTER
SUBTX0: MOVEM T4,(T1) ;SAVE EXECUTE CALL WITH BUMPED COUNTER
JRST SUBTBR ;DONE
SUBTX1: TRNN T4,100000 ;GOT AT LEAST TWO COMMANDS FOR THIS SEQUENCE?
JRST SUTX1A ;NO
TRNE T4,77
SOJA T4,SUTX1B ;YES - JUST DECREMENT COUNT AND SAVE
SUTX1A: TRZ T4,300000 ;GET ORIGINAL COMMAND BACK
LSH T4,-6
SUTX1B: MOVEM T4,(T1) ;SAVE IT
POPJ P, ;DONE
SUBTAS: ILDB T0,T2 ;GET NEXT USER-TYPED CHARACTER
SUBTS2: SKIPN T1,(T4) ;GET A SUBTABLE ENTRY - END?
JRST SUBTBR ;DONE
TRNN T1,-1 ;MATCH ON ANY CHARACTER?
JRST SUBTS3 ;YES - SET UP REAL COMMAND NOW
CAIE T0,(T1) ;DO USER'S AND TABLE'S CHARS MATCH?
AOBJN T4,SUBTS2 ;NO - LOOP ON THE TABLE
JUMPG T4,SUBTBR ;NOT LEGAL IF END OF TABLE AND NOT FOUND
SUBTS3: CAMLE T1,[137,,0] ;ELSE FOUND - WANT ANOTHER LEVEL?
JRST SUBTSS ;YES - SET IT UP
SBTS3A: HLR T1,(T4) ;NO - GET CURRENT POINTER
MOVE T0,SAVEAC+6 ;GET EXECUTE INDEX
JUMPL T0,SUBTS4 ;IF NONE RESTORE OLD COMMAND
TRNE T1,200000 ;WAS THIS ALREADY SET UP AS AN EXECUTE?
AOJA T1,SUBTSX ;YES - BUMP COUNTER AND SAVE
HLR T1,T1 ;ELSE SAVE OLD COMMAND WITH EXECUTE INDEX
DPB T1,[POINT 9,T0,29]
HRLM T0,(T4) ;SAVE INDEX AT END OF SUBTABLE
JRST SUBTBR ;DONE
SUBTSX: TRNE T1,100000 ;MORE THAN ONE COMMAND HERE ALREADY?
JRST SUTSX1 ;YES - JUST SAVE BUMPED COUNTER
TRO T1,300001 ;NO - THERE IS NOW (SET FLAG, CLEAR COUNTER)
TRZ T1,76
SUTSX1: HRLM T1,(T4) ;SAVE INDEX AT END OF SUBTABLE
JRST SUBTBR ;DONE
SUBTS4: TRNN T1,100000 ;GOT AT LEAST TWO COMMANDS FOR THIS SEQUENCE?
JRST SUTS4A ;NO
TRNE T1,77
SOJA T1,SUTS4B ;YES - DECREMENT COUNTER AND SAVE
SUTS4A: LSH T1,-6 ;GET ORIGINAL COMMAND BACK
TRZ T1,777000
SUTS4B: HRLM T1,(T4) ;SAVE IT IN THE SUBTABLE
POPJ P, ;DONE
SUBTSS: TLZE T1,200000 ;GOT AN EXECUTE COMMAND?
JRST SBTS3A ;YES - SET IT UP AFTER ALL
HLRZ T4,T1 ;POINT TO NEW SUBTABLE
HRLI T4,-^D40
JRST SUBTAS ;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 SWITCH.INI WAS PROCESSED, BY THE USER'S ENTRY ROUTINE
SETXCB::MOVEI DO,XBFNUM-1 ;LOOP THROUGH ALL EXECUTE BUFFERS
STXCB1: SKIPN XCTKEY(DO) ;DOES THIS BUFFER HAVE A BUTTON?
JRST STXCB2 ;NO - SKIP IT
MOVEI T2,200000(DO) ;YES - SET UP EXECUTE INDEX AND POINTER
MOVEM T2,SAVEAC+6
ADD T2,[440677,,XCTKEY-200000]
PUSHJ P,SUBTBX ;CHANGE TABLE IF THE COMMAND IS LEGAL
STXCB2: SOJGE DO,STXCB1 ;LOOP THROUGH ALL BUFFERS
POPJ P, ;THEN DONE
;SUBROUTINE TO PARSE AND HANDLE A SINGLE SWITCH, WHICH IS IN PARAMETER BUFFER.
;ENTER WITH PT/ POINTER TO SWITCH. THE SWITCH MUST BE TERMINATED BY A NULL.
SWHONE::SETO T4, ;ASSUME SWITCH WILL BE SET
SWHON1: PUSHJ P,SWHLUR ;GET FIRST CHARACTER
SWHON2: CAIL T1,"A" ;IS IT ALPHABETIC?
CAILE T1,"Z"
JRST SWHERR ;NO - ERROR
MOVE T2,T1 ;YES - SAVE FIRST CHARACTER
PUSHJ P,SWHLUR ;GET SECOND CHARACTER
JRST @SWHADR-"A"(T2) ;AND DISPATCH TO SWITCH ROUTINE
SWHNNN: SETZ T4, ;SAY "NO" HAS BEEN TYPED
CAIN T1,"O" ;IS 2ND CHARACTER AN "O"?
JRST SWHON1 ;YES - INGORE IT
JRST SWHON2 ;NO - DISPATCH ON IT
;SUBROUTINE TO READ THE NEXT SWITCH CHARACTER. DOESN'T RAISE CASE
;AND DOESN'T SKIP SPACES AND TABS.
SWHLRX: ILDB T1,PT ;GET THE NEXT CHARACTER
JRST SWHLR1 ;CHECK THE USUAL THINGS AND RETURN
;SUBROUTINE TO READ THE NEXT SWITCH CHARACTER. CONVERTS LOWER TO UPPER CASE
SWHLUR::ILDB T1,PT ;GET THE NEXT CHARACTER
CAIE T1,11 ;IS IT A TAB,
CAIN T1," " ; OR A SPACE?
JRST SWHLUR ;YES - IGNORE IT
CAIL T1,"a" ;LOWER CASE?
SUBI T1,40 ;YES - CONVERT TO UPPER
SWHLR1: CAIN T1,"^" ;WANT TO FORCE THE NEXT CHARACTER?
ILDB T1,PT ;YES - GET IT
POPJ P, ;RETURN
;ROUTINES TO HANDLE EACH SWITCH
;2ND SWITCH CHARACTER IS IN T1; POPJ WHEN DONE
SWHAAA: CAIN T1,"G" ;AGAIN SWITCH?
JRST SWHAGN ;YES - HANDLE IT
CAIN T1,"P" ;APPEND SWITCH?
JRST SWHAPP ;YES - HANDLE IT
CAIE T1,"L" ;ALTERNATE FILE SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
CAIE DO,$SETFI ;DOING A SET-FILE,
CAIN DO,$SWTCH ; OR A SWITCH COMMAND?
JRST SALERR ;YES - SWITCH IS ILLEGAL, THEN
MOVEI T1,SPCSIZ-1
MOVE T0,FILSPC(T1) ;NO - SWAP CURRENT AND ALTERNATE FILESPECS
EXCH T0,OLDSPC(T1)
MOVEM T0,FILSPC(T1)
SOJGE T1,.-3
JRST SWHAN1 ;IF THERE'S AN ARGUMENT, SET IT UP
SWHAGN: SKIPE CRRFLG ;HAS THE RCUR FLAG BEEN GIVEN?
JRST SWMERR ;YES - CAN'T MIX RCUR AND AGAIN
SETOM AGNFLG ;SET THE AGAIN FLAG TO SET TO SAME FILE TWICE
SWHAN1: PUSHJ P,SWHAG0 ;READ ARGUMENT, IF ANY
POPJ P, ;NO ARG - JUST RETURN
JRST SWHPC1 ;ARGUMENT - SET UP PERCENT-GOTO
SWHAPP: CAIE T4,0 ;WANT TO APPEND?
MOVE T4,[POINT 7,PIKBUF] ;YES - RESET THE APPEND POINTER
MOVEM T4,APPFLG ;SAVE 0 OR APPEND POINTER
POPJ P,
SWHUPP: MOVEM T4,UPPFLG ;SAVE UPPER-LOWER CASE FLAG
POPJ P,
SWHCCC: CAIN T1,"R" ;ALWAYS-CREATE SWITCH?
JRST SWHCRE ;YES - HANDLE IT
CAIE T1,"A" ;AFFECT CASE-DEPENDENCY OF SEARCHING?
JRST SWAERR ;NO - IT'S AMBIGUOUS
CAIGE T4,0 ;YES - MAKE SEARCHES CASE-DEPENDENT?
TRZA F,NLC ;YES
TRO F,NLC ;NO
POPJ P,
SWHCRE: MOVEM T4,CREFLG ;SAVE ALWAYS-CREATE-FILE FLAG
POPJ P,
SWHSSS: CAIN T1,"L" ;SLIDE SWITCH?
JRST SWHSLD ;YES - HANDLE IT
CAIN T1,"H" ;SHOW EXECUTE SWITCH?
JRST SWHSHW ;YES - HANDLE IT
CAIN T1,"A" ;SAVE SWITCH?
JRST SWHSAV ;YES - HANDLE IT
CAIN T1,"C" ;SCROLL-ON-CURSOR-MOVE SWITCH?
JRST SWHSCR ;YES - HANDLE IT
CAIE T1,"T" ;STRIP LINE NUMBERS SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
MOVEM T4,STRFLG ;YES - SAVE STRIP FLAG
POPJ P,
SWHSHW: MOVEM T4,XSHFLG ;SAVE SHOW FLAG
POPJ P,
SWHSCR: MOVEM T4,RLCFLG ;SAVE SCROLL-ON-CURSOR-MOVE FLAG
POPJ P,
SWHSLD: JUMPE T4,SWHSL2 ;IF /NOSLIDE DISABLE SLIDING (IGNORE ARG)
PUSHJ P,SWHAG0 ;ELSE SEE IF THERE'S AN ARGUMENT
JRST SWHSL2 ;NO - JUST ENABLE SLIDING
JUMPLE T3,SWHSL1 ;TREAT /SLIDE:0 LIKE /NOSLIDE
MOVEM T3,SLIDNM ;SET UP THE ARGUMENT AS THE NEW NOMINAL
MOVEM T3,SLIDES ; AND CURRENT SLIDE DISTANCES
SKIPA T4,[-1] ;ENABLE SLIDING AND RETURN
SWHSL1: SETZ T4, ;DISABLE SLIDING
SWHSL2: MOVEM T4,SLDFLG ;SAVE SLIDE FLAG
POPJ P,
SWHSAV: JUMPE T4,SWHSV1 ;JUMP IF USER SAID /NOSAVE
PUSHJ P,SWHAG0 ;ELSE READ ARGUMENT
JRST SWGERR ;NO ARG - ERROR
CAIG T3,0 ;DID USER SAY /SAVE:0?
SWHSV1: HRLO T3,P ;YES - USE A LARGE NUMBER (FOR NO SAVES)
MOVEM T3,SAVNUM ;ELSE SAVE # COMMANDS BETWEEN SAVES
MOVEM T3,SAVCNT ;SAVE AS COUNTDOWN VALUE, TOO
POPJ P,
SWHBBB: CAIN T1,"E" ;BEEP SWITCH?
JRST SWHBEP ;YES - HANDLE IT
CAIE T1,"A" ;BACKUP SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
MOVEM T4,BAKFLG ;YES - SAVE BACKUP FILE FLAG
POPJ P,
SWHBEP: CAIE T4,0 ;SET BEEP-ON-INSERT-MODE FLAG?
TLOA TM,BEP ;YES
TLZ TM,BEP ;NO
POPJ P,
SWHRRR: CAIN T1,"A" ;RAISE SWITCH?
JRST SWHRAI ;YES - HANDLE IT
CAIN T1,"E" ;RESET, READ-ONLY OR RECOVER SWITCH?
JRST SWHRR1 ;YES - READ ANOTHER CHARACTER
CAIN T1,"M" ;RMAR (RIGHT MARGIN) SWITCH?
JRST SWHRMR ;YES
CAIN T1,"C" ;REPLACE-CURRENT FILE SWITCH?
JRST SWHCUR ;YES - HANDLE IT
CAIE T1,"O" ;ROLL SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
CAIGE T4,0 ;ROLL IF USER TYPES RETURN ON BOTTOM LINE?
TRZA F,NRC ;NO
TRO F,NRC ;YES
POPJ P,
SWHRAI: SETCAM T4,UPCFLG ;SAVE RAISE-CASE FLAG
SETOM INVFLG ;DON'T TOGGLE; USE UPCFLG
POPJ P,
SWHCUR: SKIPE AGNFLG ;IS THE AGAIN FLAG SET?
JRST SWMERR ;YES - CAN'T MIX RCUR AND AGAIN
MOVEM T4,CRRFLG ;SAVE REPLACE-CURRENT-FILE FLAG
POPJ P,
SWHRMR: PUSHJ P,SWHAG0 ;READ NEW RMAR (RIGHT MARGIN) POSITION
JRST SWGERR ;NO ARG - ERROR
SOJ T3, ;MAKE THE VALUE ZERO-ORIGIN
CAMG T3,LMARGN ;IS IT TO THE RIGHT OF THE LEFT MARGIN?
JRST SWGERR ;NO - ERROR
MOVEM T3,RMARGN ;YES - SAVE IT
IFE TOPS10,<
IFN FTECHO,<
SWHRM1::CAML T3,CPL.1 ;OFF THE RIGHT OF THE SCREEN?
SKIPA T3,CPL.0 ;YES - SET THE FIELD WIDTH TO THE RIGHT
AOJ T3,
MOVEM T3,FLDWTH ;SAVE THE FIELD WIDTH
>>
POPJ P,
SWHRR1: PUSHJ P,SWHLUR ;GET 3RD SWITCH CHARACTER
CAIN T1,"A" ;REA == READ-ONLY?
JRST SWHRDO ;YES
IFN FTJOUR,<
CAIN T1,"C" ;REC == RECOVER JOURNAL?
JRST SWHREC ;YES
>
CAIE T1,"S" ;RES == RESET NOMINALS?
JRST SWAERR ;NO - IT'S AMBIGUOUS OR ILLEGAL
CAIE T4,0 ;SET RESET-NOMINALS FLAG?
TROA F,RST ;YES
TRZA F,RST ;NO
JRST RSTNOM ;IF YES, RESET ALL NOMINALS NOW AND RETURN
POPJ P, ;IF NO, JUST RETURN
IFE FTJOUR,<
SWHJJJ: JRST SWHJHD ;SET UP THE JUSTIFY PREFIX STRING
>
IFN FTJOUR,<
SWHREC: MOVEM T4,JRNFLG ;SAVE RECOVER-JOURNAL FLAG
POPJ P,
SWHJJJ: CAIN T1,"P" ;JUSTIFY-PREFIX SWITCH?
JRST SWHJHD ;YES - HANDLE IT
CAIE T1,"O" ;JOURNAL SWITCH?
JRST SWAERR ;NO - ERROR OR AMBIGUOUS
TLZ TM,JRW ;ASSUME NO JOURNAL
JUMPGE T4,CPOPJ ;WANT ONE AFTER ALL?
TLO TM,JRW ;YES
CAIN DO,$SWTCH ;SWITCH COMMAND OR SETTING UP A FILE?
JRST JRNSTT ;SWITCH - START THE JOURNAL FILE NOW
POPJ P, ;SETTING - JUST RETURN
>
SWHJHD: JUMPE T4,SWJHDN ;JUMP TO HANDLE /NOJHEAD
MOVE T4,[POINT 7,JUSHED]
PUSHJ P,SWHAGA ;READ THE JUSTIFY HEADER
JRST SWGERR ;NO ARG - ERROR
MOVE T4,[POINT 7,JUSHED]
SETZ T3, ;FIND LENGTH AND # CHARS IN HEADER
SWJHD1: ILDB T1,T4 ;GET A CHARACTER
JUMPE T1,SWJHD2 ;DONE IF NULL
CAIN T1,11 ;TAB?
TLO T3,7 ;YES - MOVE LENGTH TO NEXT TAB STOP
AOBJP T3,SWJHD1 ;BUMP BOTH HALVES AND LOOP
SWJHDN: SETZ T3, ;NO HEADER - CLEAR THE COUNTS
SWJHD2: MOVEM T3,JSHCNT ;SAVE THE COUNTS
POPJ P, ;DONE
SWHLLL: CAIN T1,"I" ;LINEFEED SWITCH?
JRST SWHLSD ;YES - HANDLE IT
CAIN T1,"M" ;LMAR SWITCH?
JRST SWHLMR ;YES - HANDLE IT
CAIE T1,"E" ;LENGTH SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
PUSHJ P,SWHAG0 ;YES - READ ARGUMENT
JRST SWGERR ;NO ARG - ERROR
TLNE TM,WDW ;GOT TWO WINDOWS ON THE SCREEN?
JRST SWHERR ;YES - ERROR
SKIPN STTFLG ;INITIALIZING?
JRST SWHLPP ;NO - SET THE LENGTH UP NOW
HRRM T3,STTFLG ;YES - SAVE FOR LATER
POPJ P, ;DONE FOR NOW
SWHLPP::MOVEM T3,LPP(TM) ;SAVE IN TERMINAL TABLE
MOVE T1,T3
CAMGE T1,LPP.0 ;USING ALL THE LINES ON THE SCREEN?
JRST STLPP0 ;NO - PUT ERRORS ON BOTTOM LINE
MOVSI T2,SLW!NEL ;YES - RESTORE SAVED SLW AND NEL FLAGS
AND T2,SAVFLG
TLZ TM,SLW!NEL
OR TM,T2
JRST SETLPP ;GO FINISH OFF
STLPP0: TLO TM,SLW!NEL ;MAKE ERRORS GO ON BOTTOM LINE
SETLPP::HRREI T3,-1(T1) ;(ENTER WITH T1/LINES PER PAGE)
IDIVI T1,3
MOVEM T1,LINROL ;SAVE NOMINAL NUMBER OF LINES TO ROLL
TRNE F,RST ;RESTORING NOMINALS?
MOVEM T1,ROLLIN ;YES - SAVE AS CURRENT NUMBER, TOO
MOVEM T3,LPP.1 ;SAVE LINES PER PAGE - 1
MOVEM T3,LPP.2 ;SAVE BOTTOM LINE OF SCREEN
TLNE TM,NEL ;IF BOTTOM IS SCRATCH, USE NEXT LINE UP
SOS LPP.2
POPJ P,
SWHLSD: CAIGE T4,0 ;SET LINEFEED-CURSOR DOWN FLAG?
TLZA TM,LSD ;NO
TLO TM,LSD ;YES
POPJ P,
SWHLMR: PUSHJ P,SWHAG0 ;READ NEW LMAR (LEFT MARGIN) POSITION
JRST SWGERR ;NO ARG - ERROR
SOJGE T3,SWLMR1 ;MAKE THE VALUE ZERO-ORIGIN
SETZ T3, ;BUT MAP ZERO INTO ZERO
SWLMR1: EXCH T3,LMARGN ;SAVE LEFT MARGIN AND GET THE OLD SETTING
SKIPE RMARGN ;HAS THE RIGHT MARGIN BEEN SET YET?
CAMGE T3,RMARGN ;YES - IS IT TO THE LEFT OF THE RIGHT MARGIN?
POPJ P, ;YES - DONE
EXCH T3,LMARGN ;NO - PUT OLD SETTING BACK
JRST SWGERR ;AND GIVE AN ERROR
SWHOFL: MOVE T4,[POINT 7,NEWSPC]
PUSHJ P,SWHAGA ;READ THE NEW FILESPECS INTO A TEMPORARY AREA
JRST SWGERR ;NO ARG - ERROR
SETOM OUTFLG ;SAY THERE WILL BE A CHANGE OF SPECS
JUMPE DO,CPOPJ ;DON'T CHANGE NOW IF INITIALIZING
CAIN DO,$SETFI ;O.K. TO MAKE THE CHANGE NOW?
POPJ P, ;NO - WAIT UNTIL END OF SET-FILE
;ELSE FALL INTO:
;SUBROUTINE TO SET UP PARSE THE FILESPECS GIVEN IN THE /OUT: SWITCH
;Note: TOPS-20 doesn't really parse now, so user can stick himself
OUTSET::HRRZM P,OUTFLG ;NOTE THAT SPEC IS CHANGING (BY OUTFLG .GT. 0)
MOVE T4,[POINT 7,NEWSPC]
MOVE T1,[FILSPC,,SVASPC]
BLT T1,SVASPC+SPCSIZ-1 ;SAVE THE CURRENT SPECS IN CASE PARSE FAILS
MOVE T1,[NEWSPC,,FILSPC]
BLT T1,FILSPC+7 ;MOVE IN THE NEW FILSPECS
PUSHJ P,PARSEF ;PARSE THE SPECS (ERROR ON FAILURE)
SETZM OUTFLG ;SAY SPEC CHANGE IS NO LONGER WANTED
SETOM CHGSPC ;SAY SPECS HAVE CHANGED
TLZ F,SMF ;THIS FILE AND THE ALTERNATE CAN'T BE THE SAME
TRNN F,RDO ;IS FILE READ-ONLY?
TLO F,CHG ;NO - FORCE THE FILE TO BE SAVED
POPJ P, ;DONE
SWHWWW: CAIN T1,"R" ;WRITE SWITCH?
JRST SWHWRT ;YES - HANDLE IT
CAIE T1,"I" ;WIDTH SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
PUSHJ P,SWHAG0 ;YES - READ ARGUMENT
JRST SWGERR ;NO ARG - ERROR
SKIPN STTFLG ;INITIALIZING?
JRST SWHWID ;NO - SET THE WIDTH UP NOW
HRLM T3,STTFLG ;YES - SAVE FOR LATER
POPJ P, ;DONE FOR NOW
SWHWID::MOVEM T3,CPL(TM) ;SWAP WITH WIDTH IN TERMINAL TABLE
SOJ T3, ;ALSO SAVE CPL - 1
MOVE T2,T3 ;PUT VALUE IN TWO PLACES
EXCH T2,CPL.1
CAMLE T2,RMARGN ;WAS RIGHT MARGIN .GE. WIDTH?
CAMGE T3,RMARGN ;NEED TO MOVE THE RIGHT MARGIN IN?
IFN TOPS10,<
MOVEM T3,RMARGN ;YES - DO SO
>
IFE TOPS10,<
IFN FTECHO,<
MOVEM T3,RMARGN ;YES - DO SO
>
IFN FTECHO,<
JRST [MOVEM T3,RMARGN ;YES - DO SO
AOJ T3,
MOVEM T3,FLDWTH ;ADJUST FIELD WIDTH, TOO
SOJA T3,.+1]
>>
MOVE T2,SAVFLG ;GET ORIGINAL TERMINAL FLAGS
TLNN T2,WRP ;DOES TERMINAL WRAP AROUND?
POPJ P, ;NO - IT STILL DOESN'T
CAMLE T3,CPL.0 ;YES - IS NEW LENGTH SHORTER THAN SCREEN?
TLOA TM,WRP ;NO - MAKE IT WRAP
TLZ TM,WRP ;YES - NO WRAP
POPJ P,
SWHRDO: SETCA T4, ;READ-ONLY - COMPLEMENT WRITE FLAG
SWHWRT: SETCAM T4,SAVEAC+11 ;STAGE THE VALUE IN CASE COMMAND IS SET-FILE
CAIN DO,$SETFI ;IS IT SET-FILE?
POPJ P, ;YES - DON'T SET THE FLAG NOW
SWHWR1: CAIE T4,0 ;SET READ-ONLY FLAG?
TRZA F,RDO ;NO
TRO F,RDO ;YES
POPJ P,
SWHDDD: CAIN T1,"C" ;DEFINE COMMAND SWITCH?
JRST SWHDCM ;YES - HANDLE IT
CAIN T1,"E" ;DELIM SWITCH?
JRST SWHDLM ;YES - HANDLE IT
CAIE T1,"T" ;DISPLAY TABS SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
CAIE T4,0 ;YES - SET DISPLAY TABS FLAG?
TROA F,DTB ;YES
TRZ F,DTB ;NO
POPJ P,
SWHDLM: SETZM CHBITS ;CLEAR CHARACTER FLAGS TABLE
MOVE T1,[CHBITS,,CHBITS+1]
BLT T1,CHBITS+14
SETZM DELIM ;ASSUME DELIMITERS ARE TURNED OFF
JUMPE T4,CPOPJ ;JUMP IF /NODELIM WAS TYPED
SWDLM0: ILDB T1,PT ;LOOK FOR THE COLON: GET A CHARACTER
JUMPE T1,CPOPJ ;IF NONE TREAT SAME AS /NODELIM
CAIE T1,":" ;ELSE IS IT A COLON?
JRST SWDLM0 ;NO - KEEP LOOKING
SETOM DELIM ;YES - SAY THERE IS A DELIMITER LIST
MOVEI T4,1 ;SET TO SET THE DELIMITER FLAG
SWDLM1: ILDB T1,PT ;GET A CHARACTER OF THE STRING
JUMPE T1,CPOPJ ;DONE IF CHARACTER IS NULL
CAIN T1,"^" ;FORCING THE NEXT CHARACTER?
ILDB T1,PT ;YES - FORCE IT
IDIVI T1,^D9 ;GET WORD AND POSITION IN WORD
DPB T4,CHRTAB(T2) ;SET THE FLAG
JRST SWDLM1 ;GO GET ANOTHER CHARACTER
;MOVE KEY SEQUENCE TO TOP OF PARBUF, POINT TO EXECUTE FREE SPACE
;POINT TO START OF COMMAND NAME
;FORMAT: /DC:^[P:^EL
;PROCEDURE: SAVE KEYSTROKES SOMEWHERE. PARSE COMMAND INTO T1
;NOTE: NEED TO KEEP KEYSTROKE/COMMAND UNTIL AFTER INIT, SO THEY
; GO INTO THE RIGHT TABLE. WHERE SHOULD THEY BE KEPT?
SWHDCM: HRRZ T4,XCFPTR ;GET POINTER TO EXECUTE FREE SPACE
ADD T4,[440700,,1]
SETZM (T4) ;CLEAR PREVIOUS CONTENTS
ILDB T0,PT ;SKIP COLON AFTER THE SWITCH, IF ANY
CAIN T0,":"
SWHDC1: ILDB T0,PT ;GET CHARACTER OF SEQUENCE
CAIN T0,":" ;START OF CONTENTS?
JRST SWHDC3 ;YES - SEE IF COMMAND IS LEGAL
JUMPE T0,SDCERR ;NULL - ERROR
CAIN T0,15 ;START OF ANOTHER SWITCH?
JRST SDCERR ;YES - ERROR
CAIE T0,"^" ;NO - GOT A CONTROL CHARACTER?
JRST SWHDC2 ;NO - PROCEED
ILDB T0,PT ;YES - GET NEXT CHARACTER
CAIN T0,"?" ;RUBOUT?
TROA T0,177 ;YES - SET IT UP SPECIALLY
ANDI T0,37 ;ELSE MAKE A CONTROL CHARACTER
SWHDC2: TLNE T4,760000 ;ALREADY GOT 5 CHARACTERS?
IDPB T0,T4 ;NO - SAVE CHARACTER
JRST SWHDC1 ;AND GET ANOTHER
;HERE WHEN KEYSTROKE IS FOUND - GET COMMAND INDEX IN T3
SWHDC3: ILDB T2,PT ;GET THE (HOPEFULLY) STARTING UP-ARROW
CAIN T2,"$" ;GOT THE ENTER COMMAND?
JRST [MOVEI T3,33 ;YES - SET UP ITS INDEX
JRST SWHD4A] ;AND SKIP ALL THIS CHECKING
PUSHJ P,XCWGET ;PUT 2ND CHARACTER IN WITH THE UP-ARROW
PUSHJ P,XCWGET ;DITTO 3RD CHARACTER
CAME T2,["^RF"] ;GOT A ROLL FORWARD
CAMN T2,["^RB"] ; OR BACKWARD?
JRST SWHDC5 ;YES - NEED TO GET ANOTHER CHARACTER
LSH T2,^D15 ;NO - LEFT-JUSTIFY COMMAND NAME
SWHDC4: ILDB T1,PT ;GET NEXT CHARACTER OF COMMAND
JUMPN T1,SDCERR ;ERROR IF THERE'S ANYTHING THERE
MOVEI T3,CMDLEN-1 ;LOOK FOR COMMAND AMONG NAMES
CAME T2,CMDNAM(T3) ;IS THIS IT?
SOJGE T3,.-1 ;NO - KEEP LOOKING
JUMPL T3,SDCERR ;ERROR IF NOT FOUND
SWHD4A: MOVE PT,XCFPTR ;GET POINTER TO KEYSTROKE SEQUENCE
SKIPE STTFLG ;INITIALIZING?
JRST CMDSAV ;YES - DON'T CHANGE TABLE NOW
;ELSE FALL TO SET UP COMMAND, AND RETURN
;SUBROUTINE TO CHANGE THE COMMAND TABLE
;CALL WITH PT/ POINTER TO KEYSTROKE, T3/ NEW COMMAND
SWHDCS: ILDB T4,PT ;GET THE FIRST CHARACTER
CAIN T4,177 ;RUBOUT?
SETO T4, ;YES - USE -1 AS OFFSET
ADD T4,ITB(TM) ;GET OFFSET IN TERMINAL TABLE
MOVE T1,T4 ;REMEMBER TABLE ADDRESS
SKIPGE T4,(T4) ;IS IT A NORMAL COMMAND?
JRST SWHDC0 ;NO - GO LOOK IN SUBTABLE
ILDB T0,PT ;YES - GET NEXT CHARACTER OF SEQUENCE
;@ JUMPN T0,SDCERR ;ERROR IF SEQUENCE IS NOT 1 CHARACTER LONG
;@
JUMPN T0,CPOPJ ;IF SEQUENCE IS NOT 1 CHARACTER LONG, IGNORE IT
MOVEM T3,(T1) ;SAVE THE NEW COMMAND IN THE TABLE
POPJ P, ;DONE
SWHDC0: ILDB T0,PT ;GET NEXT USER-GIVEN CHARACTER
SWHDS1: SKIPN T1,(T4) ;GET A SUBTABLE ENTRY - END?
;@ JRST SDCERR ;YES - COMMAND IS NOT LEGAL
;@
POPJ P, ;YES - COMMAND IS NOT LEGAL - IGNORE IT
TRNN T1,-1 ;MATCH ON ANY CHARACTER?
JRST SWHDS2 ;YES - SET UP REAL COMMAND NOW
CAIE T0,(T1) ;DO USER'S AND TABLE'S CHARS MATCH?
AOBJN T4,SWHDS1 ;NO - LOOP ON THE TABLE
;@ JUMPG T4,SDCERR ;NOT LEGAL IF END OF TABLE AND NOT FOUND
;@
JUMPG T4,CPOPJ ;NOT LEGAL IF END OF TABLE & NOT FOUND - IGNORE
SWHDS2: CAMLE T1,[137,,0] ;ELSE FOUND - WANT ANOTHER LEVEL?
JRST SWHDS3 ;YES - SET IT UP
SWDS2A::HRLM T3,(T4) ;SAVE THE NEW COMMAND IN THE SUBTABLE
POPJ P, ;DONE
SWHDS3: TLZE T1,200000 ;GOT AN EXECUTE COMMAND?
JRST SWDS2A ;YES - SET IT UP AFTER ALL
HLRZ T4,T1 ;POINT TO NEW SUBTABLE
HRLI T4,-^D40
JRST SWHDC0 ;AND PICK UP ANOTHER CHARACTER
SWHDC5: PUSHJ P,XCWGET ;GET REST OF COMMAND NAME
LSH T2,^D8 ;LEFT-JUSTIFY COMMAND NAME
JRST SWHDC4 ;GO FIND THE COMMAND
;HERE WHEN INITIALIZING - STORE THE COMMAND CHANGE IN THE CLOSE BUFFER
;CALL WITH PT/ COMMAND SEQUENCE, T3/ NEW COMMAND
CMDSAV: AOS T1,CLSBUF+400 ;GET THE SAVE POINTER
MOVE T2,1(PT) ;GET THE COMMAND SEQUENCE
MOVEM T2,CLSBUF+400(T1) ;SAVE THE COMMAND SEQUENCE
MOVEM T3,CLSBUF+401(T1) ;SAVE THE NEW COMMAND
AOS CLSBUF+400 ;ADVANCE THE POINTER
POPJ P, ;DONE
;HERE AFTER INITIALIZATION, TO MAKE THE CHANGES TO THE COMMAND TABLE
CMDSET::SOSGE T1,CLSBUF+400 ;ARE THERE ANY CHANGES?
POPJ P, ;NO - JUST RETURN
MOVEI PT,CLSBUF+400(T1) ;GET THE POINTER TO THE COMMAND SEQUENCE
HRLI PT,440700
MOVE T3,CLSBUF+401(T1) ;GET THE NEW COMMAND
PUSHJ P,SWHDCS ;MAKE THE CHANGE
SOS CLSBUF+400 ;SKIP OVER BOTH PIECES OF DATA
JRST CMDSET ;LOOP THROUGH ALL THE CHANGES
;NOW ON WITH THE NORMAL SWITCHES
SWHHLP: CAIE T4,0 ;SET NO-HELP-WANTED FLAG?
TRZA F,NHP ;NO
TRO F,NHP ;YES
POPJ P,
SWHIII: CAIN T1,"D" ;I.D. SWITCH?
JRST SWHIDD ;YES - HANDLE IT
CAIN T1,"M" ;INSERT-MODE SWITCH?
JRST SWHIMD ;YES - HANDLE IT
CAIN T1,"C" ;INSERT-CR-IN-INSERT-MODE SWITCH?
JRST SWHICR ;YES - HANDLE IT
CAIN T1,"N" ;INVERT CASE SWITCH?
JRST SWHINV ;YES - HANDLE IT
CAIN T1,"T" ;INSERT TABS SWITCH?
JRST SWHINT ;YES - HANDLE IT
CAIE T1,"S" ;INCREMENTAL SAVE SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
JUMPE T4,SWHII1 ;YES - JUMP IF USER SAID /NOISAVE
PUSHJ P,SWHAG0 ;ELSE READ ARGUMENT
JRST SWGERR ;NO ARG - ERROR
CAIG T3,0 ;DID USER SAY /ISAVE:0?
SWHII1: HRLO T3,P ;YES - USE -1 (FOR NO SAVES)
MOVEM T3,ISVNUM ;ELSE SAVE # COMMANDS BETWEEN ISAVES
MOVEM T3,ISVCNT ;SAVE AS COUNTDOWN VALUE, TOO
POPJ P,
SWHICR: CAIE T4,0 ;SET NO CR IN INSERT MODE FLAG?
TRZA F,NCR ;NO
TRO F,NCR ;YES
POPJ P,
SWHIMD: CAIN T4,0 ;SET INSERT-MODE?
TRZA F,IMD ;NO - CLEAR FLAG AND RETURN
IFN TOPS10,<
TRO F,IMD ;YES - SET FLAG AND RETURN
POPJ P,
>
IFE TOPS10,<
IFN FTECHO,<
TROA F,IMD ;YES - SET FLAG AND SKIP TO SET ECHOES
POPJ P,
JRST EKOALL ;SET NO ECHO; BREAK ON ALL CHARACTERS; RETURN
>
IFE FTECHO,<
TRO F,IMD ;YES - SET FLAG AND RETURN
POPJ P,
>>
SWHIDD: SETZM TAGFLG ;ASSUME THE USER WANTS /NOID
JUMPE T4,CPOPJ ;DONE IF HE DOES
SETZM TAGFLG+1
SETZM TAGFG1 ;ELSE ASSUME THERE'S NO ENDING COMMENT CHARS
MOVE T4,[POINT 7,TAGFLG]
PUSHJ P,SWHAGC ;READ THE STARTING CHARACTER(S)
JRST SWHIDS ;NO ARG - USE A SEMICOLON; DONE
JUMPE T1,CPOPJ ;DONE IF NO ENDING CHARACTER(S)
MOVE T4,[POINT 7,TAGFG1]
JRST SWHGC1 ;ELSE READ THE ENDING CHARACTER(S) AND RETURN
SWHIDS: MOVSI T1,(ASCII /;/) ;NO ARG - DEFAULT TO A COLON
MOVEM T1,TAGFLG
POPJ P, ;DONE
SWHINV: SETCAM T4,INVFLG ;SAVE SETTING OF INVERT-CASE SWITCH
POPJ P,
SWHINT: SETCAM T4,INSTBS ;SAVE SETTING OF INSERT-TABS SWITCH
POPJ P,
;this turns it off; need to turn it back on
SWHMMM: JUMPL T4,CPOPJ ;DO NOTHING IF TURNING MESSAGE BACK ON
MOVE T1,[BYTE (7) 15,12]
IFN TOPS10,<
MOVEM T1,NEWMSG ;ELIMINATE THE NEW-FILE MESSAGE
HRROS NEWCCL ;CHANGE THE CHANNEL COMMAND TO BE ONE WORD
>
IFE TOPS10,<
SETZM NEWMSG
>
SETZM NEWMSG+1 ;CLEAR THIS WORD AS A FLAG
TRNE F,GFL ;GOT A FILE TO EDIT?
POPJ P, ;YES - THE CHEERY MESSAGE NO LONGER EXISTS
MOVEM T1,BUFFER ;NO - ELIMINATE THE CHEERY MESSAGE
MOVE EN,[010700,,BUFFER]
SETZM BUFFER+1
MOVE T1,[BUFFER+1,,BUFFER+2]
BLT T1,BUFFEN
POPJ P, ;DONE
SWHTTT: JUMPE T1,SWHTB0 ;MAKE "/T" DEFAULT TO /TABS
CAIE T1,":" ;DITTO
CAIN T1,"A" ;AND /TA IS /TABS, TOO
JRST SWHTB0
CAIN T1,"R" ;/TRAIL FLAG?
JRST SWHTRL ;YES - HANDLE IT
CAIE T1,"S" ;TAB-SET?
JRST SWAERR ;NO - IT'S AMBIGUOUS
PUSHJ P,SWHAG0 ;TAB-SET - READ THE DECIMAL TAB POSITION
JRST SWGERR ;NO ARG - ERROR
TLO TM,STB ;TURN ON SETTABLE TABS
SWHTT0: SOS T2,T3 ;MAKE THE COLUMN ZERO-BASED
IDIVI T2,^D36 ;GET WORD AND POSITION IN WORD
MOVN T3,T3 ;NEGATE POSITION
MOVSI T0,400000 ;GET BIT FOR SHIFTING
LSH T0,(T3) ;SHIFT RIGHT TO THE RIGHT POSITION
JUMPE T4,SWHTT1 ;JUMP IF WANT TO CLEAR THE BIT
ORM T0,TABTBL(T2) ;SET THAT BIT
JRST SWHTT2 ;CONTINUE
SWHTT1: ANDCAM T0,TABTBL(T2) ;CLEAR THAT BIT
SWHTT2: JUMPE T1,CPOPJ ;RETURN IF THERE'S NO MORE
PUSHJ P,SWHAG2 ;ELSE READ THE NEXT VALUE
JRST SWHTT0 ;AND LOOP TO SET IT
SWHTB0: JUMPE T4,SWHTBW ;IF NOTABS, SET UP WORDWISE TABS
JUMPE T1,SWHTNW ;IF IF JUST "/T" SET UP NORMAL TABS
SWHTAB: CAIN T1,":" ;ELSE SKIP UNTIL THE COLON IS FOUND
JRST SWHTA1 ;GOT IT - PROCEED
ILDB T1,PT ;GET THE NEXT CHARACTER
JUMPN T1,SWHTAB ;MAYBE THIS IS THE COLON
JRST SWHTNW ;IF NO ARG, SET UP NORMAL TABS
SWHTA1: MOVE T0,PT ;SAVE POINTER TO START OF ARGUMENT
PUSHJ P,SWHLUR ;ELSE GET THE 1ST ARGUMENT CHARACTER
CAIN T1,"W" ;WANT WORDWISE TABS?
JRST SWHTBW ;YES - GO SET THEM
CAIE T1,"S" ;WANT "SETTABLE" TABS (FOR COMPATIBILITY)?
CAIN T1,"R" ;WANT REGULAR TABS?
JRST SWHTNW ;YES - GO SET THEM
MOVE PT,T0 ;NO - POINT TO THE ARGUMENT AGAIN
PUSHJ P,SWHAG1 ;READ THE REST OF THE NUMERIC ARGUMENT
JRST SWHTNW ;NO ARG - SET UP NORMAL TABS
MOVEM T3,TABLEN ;SAVE ARG AS LENGTH OF A TAB
PUSHJ P,TABINI ;INITIALIZE THE TAB TABLE
TLZ TM,STB ;MAKE SURE SETTABLE TAB FLAG IS OFF
SWHTNW: TRZA F,WTB ;CLEAR WORDWISE TAB FLAG
SWHTBW: TRO F,WTB ;SET WORDWISE TAB FLAG
POPJ P, ;DONE
SWHTRL: MOVEM T4,TRLFLG ;SAVE PRESERVE-TRAILING-SPACES FLAG
POPJ P, ;DONE
SWHGGG: JUMPE T1,SWHPRC ;TREAT A LONE "G" AS GOTO
CAIE T1,"O" ;WANT THE GOTO SWITCH,
CAIN T1,":" ; OR GOT JUST "G:"?
JRST SWHPRC ;YES - HANDLE IT
CAIE T1,"R" ;GLOBAL-READ-ONLY SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
MOVEM T4,GREFLG ;YES - SAVE THE DEFAULT-READ-ONLY FLAG
JRST SWHRDO ;SET OR CLEAR READ-ONLY FLAG AND RETURN
SWHPRC: PUSHJ P,SWHARG ;GET PERCENTAGE TO GO TO
SKIPA T3,GOPERC ;IF NO ARG USE CURRENT PERCENT
SWHPC1: CAIGE T3,0 ;GOT A NEGATIVE PERCENTAGE?
MOVEI T3,^D100 ;YES - TREAT AS 100%
CAILE T3,^D100 ;IS THE VALUE TOO BUG?
JRST SWGERR ;YES - ERROR
MOVEM T3,GOPRCT ;O.K. - SAVE STARTING PERCENT VALUE
POPJ P,
SWHPPP: CAIN T1,"A" ;PAGE-AND-LINE STATUS SWITCH?
JRST SWHPAG ;YES - HANDLE IT
CAIN T1,"I" ;PARAGRAPH INDENT SWITCH?
JRST SWHPAR ;YES - HANDLE IT
CAIE T1,"R" ;PROG TO RUN ON EXIT SWITCH?
JRST SWAERR ;NO - IT'S AMBIGUOUS
IFN TOPS10,<
PUSHJ P,SWHGS0 ;READ NAME OF SYSTEM CUSP TO RUN IN SIXBIT
JRST SWGERR ;NO ARG - ERROR
MOVEM T3,GOBLK+1 ;SAVE IN RUN BLOCK
>
IFE TOPS10,<
MOVE T4,[POINT 7,GOBLK]
PUSHJ P,SWHAGA ;READ NAME OF CUSP TO RUN IN ASCII
JRST SWGERR ;NO ARG - ERROR
>
POPJ P, ;THAT'S ALL
SWHPAG: MOVEM T4,PAGFLG ;SAVE PAGE/LINES FLAG
POPJ P,
SWHPAR: PUSHJ P,SWHAG0 ;READ AMOUNT TO INDENT A PARAGRAPH
SETZ T3, ;NO ARG - SET NO INDENT
MOVEM T3,PARIND ;SAVE THE VALUE
POPJ P, ;DONE
SWHEEE: ;HERE FOR EXT SWITCH - LIST OF DEFAULT EXT'S
IFN TOPS10,<
HLLZS EXTTBL ;CLEAN OUT THE EXTENSION TABLE
SETZM EXTTBL+1
MOVE T1,[EXTTBL+1,,EXTTBL+2]
BLT T1,EXTTBL+5
MOVSI T0,-^D10 ;SET UP COUNTER INTO EXTENSION TABLE
MOVE T4,[POINT 18,EXTTBL,17]
MOVEM T4,SAVEAC+10 ;AND POINTER INTO SAME
PUSHJ P,SWHSC0 ;READ THE FIRST EXTENSION IN SIXBIT
JRST SWGERR ;NO ARG - ERROR
JRST SWHEE2 ;JUMP INTO THE LOOP
SWHEE1: AOBJP T0,CPOPJ ;POINT TO THE PLACE TO STORE THE NEXT EXT'N
PUSHJ P,SWHSC1 ;READ THE NEXT EXTENSION
SWHEE2: HLRZ T3,T3 ;PUT THE EXTENSION IN THE RH
IDPB T3,SAVEAC+10 ;SAVE IT IN THE TABLE
JUMPN T1,SWHEE1 ;IF NOT END OF LIST, LOOP TO GET NEXT ONE
POPJ P, ;ELSE DONE
>
IFE TOPS10,<
SETZM EXTTBL+1 ;CLEAN OUT THE EXTENSION TABLE
MOVE T1,[EXTTBL+1,,EXTTBL+2]
BLT T1,EXTTBL+11
MOVSI T3,-^D10 ;SET UP COUNTER INTO EXTENSION TABLE
MOVE T4,[POINT 7,EXTTBL+1(T3)]
PUSHJ P,SWHAGC ;READ THE FIRST EXTENSION
JRST SWGERR ;NO ARG - ERROR
JRST SWHEE2 ;JUMP INTO THE LOOP
SWHEE1: AOBJP T3,CPOPJ ;POINT TO THE PLACE TO STORE THE NEXT EXT'N
MOVE T4,[POINT 7,EXTTBL+1(T3)]
PUSHJ P,SWHGC1 ;READ THE NEXT EXTENSION
SWHEE2: JUMPN T1,SWHEE1 ;IF NOT END OF LIST, LOOP TO GET NEXT ONE
POPJ P, ;THAT'S ALL
>
SWHQQQ: MOVEM T4,DSPFLG ;SAVE DISPLAY-ON-SETFIL FLAG
POPJ P,
SWHTRM: PUSHJ P,SWHAGS ;READ NAME OF TERMINAL TO USE
JRST SWGERR ;NO ARG - ERROR
MOVEM T3,TRMNAM ;SAVE TERMINAL NAME
POPJ P, ;THAT'S ALL
SWHFFF: JUMPE T1,SWAERR ;JUST "F" IS AMBIGUOUS
CAIN T1,"E" ;FENCE SWITCH?
JRST SWHFNC ;YES - HANDLE IT
CAIE T1,"I" ;JUSTIFY-FILL SWITCH?
JRST SWHSTT ;NO - GO HANDLE THE FILE SWITCHES
MOVEM T4,FLLFLG ;YES - SET THE FILL FLAG
POPJ P, ;DONE
SWHFNC: DMOVE T1,[ASCIZ / *FENCE* /] ;ASSUME SHORT FENCE IS WANTED
JUMPE T4,SWHFC1 ;REALLY WANT TO SET THE LONG FENCE?
DMOVE T1,[ASCII / *** Thi/] ;OF COURSE - SET IT BACK UP
SWHFC1: DMOVEM T1,FENCE
POPJ P, ;DONE
;HERE FOR VARIOUS FILE STATUS SWITCHES: FC, FR, FS, FD, FO
;IF THESE ARE USED, /FD MUST APPEAR AND BE FIRST
SWHSTT: MOVE T2,T1 ;SAVE FLAVOR OF SWITCH
PUSHJ P,SWHAG0 ;READ ITS ARGUMENT
JRST SWGERR ;NO ARG - ERROR
CAIN T2,"C" ;FC (COLUMN POSITION) SWITCH?
JRST SWHSTC ;YES - GO DO IT
CAIN T2,"R" ;FR (ROW POSITION) SWITCH?
JRST SWHSTR ;YES - GO DO IT
CAIN T2,"S" ;FS (SLIDE OFFSET) SWITCH?
JRST SWHSTL ;YES - GO DO IT
CAIN T2,"D" ;FD (DISPLAY POINTER) SWITCH?
JRST SWHSTD ;YES - GO DO IT
CAIN T2,"O" ;FO (ONE-SHOT) SWITCH?
JRST SWHOSH ;YES - GO DO IT
JRST SWHERR ;ANYTHING ELSE IS AN ERROR
SWHSTC: HRLM T3,PRERW ;SET UP COLUMN POSITION
POPJ P,
SWHSTR: HRRM T3,PRERW ;SET UP ROW POSITION
POPJ P,
SWHSTL: MOVEM T3,PRESL ;SET UP SLIDE OFFSET
POPJ P,
SWHOSH: MOVEM T3,PREONE ;SET UP ONE-SHOT POINTER
POPJ P,
SWHSTD: SETZM PRERW ;CLEAR THE OTHER POINTERS
SETZM PRESL
IDIVI T3,5 ;SEPARATE INTO WORD, POSITION IN WORD
ADDI T3,BUFFER ;MAKE POINTER RELATIVE TO START OF BUFFER
JUMPE T4,SWHSD1 ;HANDLE POINTING TO START OF WORD SPECIALLY
HRL T3,PTRTBL(T4) ;MAKE IT POINT AT THE RIGHT BIGHT
SWHSD0: MOVEM T3,PREDP ;SAVE POINTER IN THE RYTE PLACE
POPJ P, ;DONE
SWHSD1: HRLI T3,010700
SOJA T3,SWHSD0
;THE ONE-SHOT ARGUMENT IS THE CHARACTER IN THE FILE WHICH THE CURSOR SHOULD
;POINT TO. IT WILL BE SET UP 1/3 DOWN THE SCREEN. SO NEED TO CALCULATE
;CHRPTR, LINPTR, DISPTR, RW, CM, AND SL
;SWHOSH: IDIVI T3,5 ;SEPARATE INTO WORD, POSITION IN WORD
; ADDI T3,BUFFER ;MAKE POINTER RELATIVE TO START OF BUFFER
; HRL T3,PTRTBL(T4) ;MAKE IT POINT AT THE RIGHT BYTE
; MOVE PT,T3 ;SAVE POINTER IN THE RIGHT PLACE
; JRST SRCSET ;SET EVERYTHING UP AND RETURN
;SUBROUTINE TO READ COLON (MAYBE) AND NUMERIC ARGUMENT OF A SWITCH
;RETURNS T3/ VALUE, T1/ DELIMITER (0 OR ",")
;GIVES SKIP RETURN IF VALUE FOUND, NON-SKIP IF NO COLON FOUND
;TO READ THE 2ND AND FURTHER VALUES, ENTER AT SWHAG2
SWHAG0: ILDB T1,PT ;GET THE NEXT CHARACTER
SWHARG: CAIE T1,":" ;GOT A COLON?
JUMPN T1,SWHAG0 ;NO - TRY NEXT ONE, IF ANY
SWHAG1: JUMPE T1,CPOPJ ;NO COLON - NON-SKIP RETURN
AOS (P) ;GOT THE COLON - GIVE SKIP RETURN
SWHAG2: SETZB T3,T0 ;CLEAR TARGET AND NEGATIVE FLAG
PUSHJ P,SWHLUR ;GET FIRST DIGIT OR DASH
CAIN T1,"-" ;WANT TO NEGATE THE RESULT?
TDOA T0,[-1] ;YES - REMEMBER THAT FACT
CAIA ;NO - SKIP TO TREAT CHAR AS A DIGIT
SWHAG3: PUSHJ P,SWHLUR ;GET A DIGIT
JUMPE T1,SWHAG4 ;DONE IF NULL
CAIN T1,"," ;GOT ONE NUMBER OF A LIST?
POPJ P, ;YES - RETURN
SUBI T1,"0" ;ELSE CONVERT TO NUMERIC
JUMPL T1,SWGER0 ;ERROR IF NOT A NUMBER
CAILE T1,9
JRST SWGER0 ;DITTO
IMULI T3,^D10 ;ELSE MULTIPLY BY TEN
ADD T3,T1 ;ADD IN THE NEW DIGIT
JRST SWHAG3 ;AND GET ANOTHER ONE
SWHAG4: JUMPE T0,CPOPJ ;DONE IF NUMBER SHOULD BE POSITIVE
MOVN T3,T3 ;ELSE NEGATE THE RESULT
POPJ P, ;THEN RETURN
;SUBROUTINE TO READ COLON (MAYBE) AND SIXBIT ARGUMENT OF A SWITCH
;RETURNS VALUE, IN SIXBIT, IN T3
;GIVES SKIP RETURN IF VALUE FOUND, NON-SKIP IF NO COLON FOUND
SWHGS0: ILDB T1,PT ;GET THE COLON
SWHAGS: CAIE T1,":" ;IS IT REALLY?
JUMPN T1,SWHGS0 ;NO - TRY NEXT ONE, IF ANY
JUMPE T1,CPOPJ ;NO COLON - NON-SKIP RETURN
AOS (P) ;GOT THE COLON - GIVE SKIP RETURN
SETZ T3, ;CLEAR TARGET
MOVE T4,[POINT 6,T3] ;AND POINT TO TARGET
MOVEI T0,6 ;EXPECT A MAXIMUM OF SIX
SWHGS1: ILDB T1,PT ;GET A CHARACTER
JUMPE T1,CPOPJ ;RETURN, IF NULL
CAIL T1,"a" ;LOWER CASE?
TRZA T1,100 ;YES - MAKE IT SIXBIT
SUBI T1," " ;CONVERT TO SIXBIT
JUMPL T1,SWGER0 ;ERROR IF NOT LEGALLY SIXBIT
IDPB T1,T4 ;ELSE SAVE IT WITH THE REST
SOJG T0,SWHGS1 ;GET MORE - COUNTED OUT?
POPJ P, ;YES - USE ONLY 6 CHARACTERS
IFN TOPS10,<
;SUBROUTINE TO READ COLON (MAYBE) AND SIXBIT ARGUMENT OF A SWITCH
;RETURNS T3/ SIXBIT STRING, T1/ DELIMITER (0 OR ",")
;GIVES SKIP RETURN IF VALUE FOUND, NON-SKIP IF NO COLON FOUND
;FOR ALL BUT THE FIRST VALUE, ENTER AT SWHSC1: (RETURNS +1)
SWHSC0: ILDB T1,PT ;GET THE COLON
SWHGSC: CAIE T1,":" ;IS IT REALLY?
JUMPN T1,SWHSC0 ;NO - TRY NEXT ONE, IF ANY
JUMPE T1,CPOPJ ;NO COLON - NON-SKIP RETURN
AOS (P) ;GOT THE COLON - GIVE SKIP RETURN
SWHSC1: SETZ T3, ;CLEAR TARGET
MOVE T4,[POINT 6,T3] ;AND POINT TO TARGET
MOVEI T2,6 ;EXPECT A MAXIMUM OF SIX
SWHSC2: ILDB T1,PT ;GET A CHARACTER
CAIN T1,"," ;END OF THE STRING?
POPJ P, ;YES - DONE
JUMPE T1,CPOPJ ;RETURN, IF NULL
CAIL T1,"a" ;LOWER CASE?
TRZA T1,100 ;YES - MAKE IT SIXBIT
SUBI T1," " ;CONVERT TO SIXBIT
JUMPL T1,SWGER0 ;ERROR IF NOT LEGALLY SIXBIT
IDPB T1,T4 ;ELSE SAVE IT WITH THE REST
SOJG T2,SWHSC2 ;GET MORE - COUNTED OUT?
POPJ P, ;YES - USE ONLY 6 CHARACTERS
>
;SUBROUTINE TO READ ASCII ARGUMENT OF A SWITCH INTO (T4)
;GIVES SKIP RETURN IF VALUE FOUND, NON-SKIP IF NO COLON FOUND
SWHGA0: ILDB T1,PT ;GET THE COLON
SWHAGA: CAIE T1,":" ;IS IT REALLY?
JUMPN T1,SWHGA0 ;NO - TRY NEXT ONE, IF ANY
JUMPE T1,CPOPJ ;NO COLON - NON-SKIP RETURN
AOS (P) ;GOT THE COLON - GIVE SKIP RETURN
SWHGA1: PUSHJ P,SWHLRX ;GET A CHARACTER
IDPB T1,T4 ;SAVE IT WITH THE REST
JUMPN T1,SWHGA1 ;NO - LOOP IF NOT NULL
POPJ P, ;ELSE RETURN
;SUBROUTINE TO READ ASCII ARGUMENT OF A SWITCH INTO (T4)
;GIVES SKIP RETURN IF VALUE FOUND, NON-SKIP IF NO COLON FOUND
;DELIMITER (0 OR ",") IS RETURNED IN T1
;(LIKE ABOVE, BUT STOPS ON A ",")
SWHGC0: ILDB T1,PT ;GET THE COLON
SWHAGC: CAIE T1,":" ;IS IT REALLY?
JUMPN T1,SWHGC0 ;NO - TRY NEXT ONE, IF ANY
JUMPE T1,CPOPJ ;NO COLON - NON-SKIP RETURN
AOS (P) ;GOT THE COLON - GIVE SKIP RETURN
SWHGC1: PUSHJ P,SWHLRX ;GET A CHARACTER
JUMPE T1,CPOPJ ;DONE IF NULL
CAIN T1,"," ;END OF THIS VALUE?
POPJ P, ;YES - RETURN
IDPB T1,T4 ;ELSE SAVE IT WITH THE REST
JRST SWHGC1 ;AND LOOP
;IF SWITCH ERROR OUTPUT MESSAGE, RETURN TO CALLER OF SWHONE
SWHER0: POP P, ;RETURN TO CALLER OF SWHONE
SWHERR: MOVEI T1,[ASCIZ /############Illegal switch/]
SWHER1: CAIN DO,$SETFI ;DOING A SET-FILE?
JRST STFERR ;YES - GIVE SET-FILE-FLAVORED ERROR
JRST ERROR ;ELSE DISPLAY THE ERROR AND RETURN
SWAERR: JUMPN T1,SWHERR ;IF A CHARACTER WAS TYPED IT'S REALLY ILLEGAL
MOVEI T1,[ASCIZ /#########Ambiguous switch/]
JRST SWHER1 ;DISPLAY THE ERROR AND RETURN
SWGER0: POP P, ;RETURN TO CALLER OF SWHONE
SWGERR: MOVEI T1,[ASCIZ /######Illegal switch argument/]
JRST SWHER1 ;DISPLAY THE ERROR AND RETURN
SWMERR: SKIPA T1,[[ASCIZ ?Can't use /RCUR and /AGAIN together?]]
SDCERR: MOVEI T1,[ASCIZ ?######Illegal argument for /DC:?]
JRST ERROR ;(ALWAYS TREAT AS A NON-SET-FILE ERROR)
SALERR: MOVEI T1,[ASCIZ ?####Use /ALT only at monitor level?]
JRST ERROR ;(ALWAYS TREAT AS A NON-SET-FILE ERROR)
;SWITCH DISPATCH ADDRESSES
SWHADR: EXP SWHAAA,SWHBBB,SWHCCC,SWHDDD,SWHEEE ;A, B, C, D, E
IFE FTJOUR,<
EXP SWHFFF,SWHGGG,SWHHLP,SWHIII,SWHERR ;F, G, H, I, J
>
IFN FTJOUR,<
EXP SWHFFF,SWHGGG,SWHHLP,SWHIII,SWHJJJ ;F, G, H, I, J
>
EXP SWHERR,SWHLLL,SWHMMM,SWHNNN,SWHOFL ;K, L, M, N, O
EXP SWHPPP,SWHQQQ,SWHRRR,SWHSSS,SWHTTT ;P, Q, R, S, T
EXP SWHUPP,SWHERR,SWHWWW,SWHERR,SWHERR,SWHTRM ;U, V, W, X, Y, Z
END
Reference in New Issue View Git Blame Copy Permalink