.MCALL .MODULE .MODULE SL,VERSION=70,COMMENT=,AUDIT=NO ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ;++ ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 02-NOV-90 Use $JOBS instead of FBMON$. ; Also, use definitions in ; SYSTEM.MLB. ;-- .Enable LC ; ; JFW 6-August-1982 ; ; Modified by: ; ; GLA 21-October-1984 Change to use 5 word global RCB under XM. ; ; RHH 29-Dec-86 Implement multiple old line FILO. ; Conditionalize per-job impure area and ; SPFUN support. ; 05-Jan-87 Change FILO delimiter to NULL ; Implement SET SL KED support ; 06-Jan-87 Implement RECALL command ; 16-Jan-87 Fix VT102 delword problem, fix DOWN when ; only one old line exists. Boost prompt ; length (ProSiz) to 40 chars. Implemented ; DELWLFT on LINEFEED, when in KED mode. ; 25-Feb-87 Make SLMIN act somewhat like new SL, in ; the way UP and DOWN arrow keys work ; 23-Mar-87 Fix SET SL VT102 for VT2xx terminals, ; add RECALL search capability. ; Fix SET CYCLE when UP'd beyond last line. ; 31-Mar-87 Fix RECALL then problem ; 08-Apr-87 Fix lower case bit on non-KMON GTLIN's ; 08-Jun-87 Fix TTYIN mode prompt, conditionalize DBG stuff, ; 10-Jun-87 Inhibit SL use if JSW's Inhibit-wait bit is ON ; 01-Aug-87 When XM install fails, deallocate region ; 13-Jan-88 Reset keypad direction to BACKWARDS, update cast ; 10-Feb-88 Add console logging support ; 18-May-88 Add Function Key Support and VT300 recognition ; 27-Jun-88 Expand LET buffers to 5 32-character strings ; 21-Dec-88 Enable/Disable PRO Function keys only during SL edit ; 17-Jul-89 Add VT420 DA response ; 28-Jun-1991 changed order of tests in keypad 2 code ; ; This handler implements single line command editor for RT-11. ; .SbTtl Assembly and link documentation ; INSTRUCTIONS FOR BUILDING SL_ FROM SOURCES: ; ; To generate an SLz to match a sysgened monitor use the sysgened ; monitor's CND file called yyyyyy.CND. The xxxxxx.CND file is one ; containing options for SL (only). Omitting xxxxxx will produce a ; reasonable SL (all SL options default to reasonable values/choices). ; It is important to note that the link command has 2 mandatory options: ; the /NoBitMap and /Boundary:512. ones. Omitting these options will ; produce an unusable SLz. (This means that SL can NOT be specified ; as a "user" handler to the standard SYSGEN procedure). ; ; All the SL options are listed on the page which defines the defaults ; for them and generates .SbTtls to display the choices. The only (known) ; invalid set of options would be a set containing NO terminal types ; (VT52$, VT100$, and VT102$ all turned off). ; ;$Macro xxxxxx.CND+yyyyyy.CND+SL/Cross ;$Link xxxxxx/NoBitMap/Boundary:512./Execute:SLz.SYG ;SETOVR ; ; .SbTtl Support documentation ; ; SL is an RT-11 Pseudo handler. It is treated by RT-11 as a handler, ; but has no vector or CSR assignments and controls no device directly. ; ; ; SL structure: ; ; SL uses interfaces to the operating system thru pointers in the RMON ; DATA base. In particular it uses the EMT16 (batch hooks) interface and ; probably will fail in the presence of an active BA handler. ; ; SL implements several complex functions as SET options. This has ; caused the set code to require space much in excess of the standard ; offsets 400-776 of block 0. The additional set code is found below ; offset 400 in block 0 and in several (3?) additional blocks of "set ; overlay" code. The set overlay code is read in over block 1 (handler ; queue manager code) by code in block 0. This overlay code is executed ; and may return to block 0 code or, in some instances, either call in ; other overlays or do a .EXIT with an indirect command list in the chain ; area. .SbTtl SLX "Installation" function ; ; SLX (the MMG$T version) also implements a "unique" installation code ; which is also overlayed in the same way as the set code is overlayed. ; The SLX installation code attempts to allocate a "permanent region" in ; memory above the XM monitor. If it can get the requested memory, it ; then reads in the code and data from the SLX PSECT into the memory. ; The first request to a newly $LOADed (or .FETCHed) SLX runs one-time- ; only code which searches for the "permanent" region and relocates ; pointers in the low memory and "permanent" memory areas of SLX to allow ; them to communicate. The purpose of this is to reduce the low memory ; requirements of SLX. ; ; SL also contains an essentially untested .SPFUN interface designed to ; allow a "multi-user" program (or a foreground program) to avail itself ; of the services SL provides for the background (and KMON). WARNING: ; this interface is very likely to change (or disappear) in future ; releases. ; ; SYS (SAV) image organization: ; ; Block0: Standard Handler prefix information ; Installation code ; Set code ; Block1: Queue manager entry point ; ... ; Blockx: overlays for additional set code ; ... ; Blocky: overlay for installation code [XM only] ; Blockz: "permanent" region code and data [XM only] ; ... ; .SbTtl Relocation function .SbTtl . for non-XM system ; ; "PIC" code: ; ; As a handler, SL must be PIC code. The Set Code and Installation ; code are generally PIC code in the traditional sense (relative ; references (Mov Foo,R3) and "ADDR" macro type constructions (Mov ; #A,R0 becomes Mov PC,R0 / Add .-A,R0)). ; ; The rest of SL uses a macro called $REL to provide relocation ; dynamically. First the operation of $REL in the non-XM version: ; ; For SJ/FB/RTEM $REL generates several relocation lists: ; ; 1) A single list from the $REL references marked SL, SLR, ; and SLX. This list is used to relocate references from ; SL back to itself. It works by building a list of addresses ; to relocate and by placing in the locations to be relocated ; the relocation bias. ; ; 2) A second list from the $REL references marked RMON and RMONX. ; This list is used to relocate references from SL to RMON's ; data area. It works the same as 1) above, using the value ; of the SYSCOM RMON pointer as the base. ; ; +-----------------------+ ; | | ; | | ; | "R M O N" | ; | | ; @$SYPTR: | | ; +-----------------------+ ; ^ ^ ; |RMON |RMONX ; | | ; +-----------------------+ ; | |----+ ; | | |SL ; | |<---+ ; | |----+ ; | "SLDRV" | |SLR ; | |<---+ ; | |----+ ; | | |SLX ; ??????: | |<---+ ; +-----------------------+ ; .SbTtl . for XM system ; For XM $REL generates several relocation lists and performs some ; relocation at assembly time: ; ; 1) A single list from the $REL references marked SL. This list ; works the same way as list 1) under SJ/FB/RTEM above. Note ; that only SL marked $REL entries are in this list under XM. ; ; 2) A second list from the $REL references marked RMON. This list ; works the same way as list 2) above. Note that RMONX is a ; separate list under XM. ; ; 3) All the entries for $REL marked SLX are statically relocated ; at assembly time since the address of SLX is fixed at 20000 ; (the first address in PAR1). There is not list, the locations ; are modified by .Words generated by $REL. ; ; 4) A third list from the $REL references marked RMONX. This list ; works the same as list 2) above, except it is relocated at ; INSTALL time. ; ; 5) A fourth list from the $REL references marked SLR. This list ; works the same as list 1) above, except that an "old bias" ; value OLDBASE is subtracted out as part of the relocation, ; since this relocation is done to the "resident" part and may ; be repeated several times. ; ; +-----------------------+ ; | |----+ ; | | |SLX ; | "S L X" |<---+ ; | |-----------+ ; 20000: | |<---+ | ; +-----------------------+ | | ; | | | ; |RMONX | | ; V | | ; +-----------------------+ | | ; | | | | ; | | | | ; | "R M O N" | |SLX |SLR ; | | | | ; @$SYPTR: | | | | ; +-----------------------+ | | ; ^ | | ; |RMON | | ; | | | ; +-----------------------+ | | ; | |----+ | ; | |<----------+ ; | "SLDRV" |----+ ; | | |SL ; ??????: | |<---+ ; +-----------------------+ ; .SbTtl System interface ; SYSTEM INTERFACE: ; ; SL interfaces with the system thru several avenues: ; ; Special .TTYIN and .PRINT requests ; Batch interface (EMT16 list ...): ; Standard Handler services (under XM, $GtByt ...) ; JSW bits ; $CNFG1 word in RMON ; ; Special .TTYIN and .PRINT requests AND ; Batch interface (EMT16 list ...): ; ; In the batch interface, SL hooks into the .TTYIN, .EXIT, and ; .PRINT requests. (Under XM it also hooks into a new PRINTR entry ; in the EMT16 list.) SL currently ignores any requests not coming ; from the BG, but code is in SL to assign impure areas for the ; other jobs and serve them as well. ; ; In the .TTYIN processing, SL classifies .TTYIN requests into ; several groups: ; ; 1) Plain .TTYINs ; 2) .TTYINs followed by MOV SP,SP ; 3) .TTYINs followed by MOV R5,R5 ; 4) .TTYINs followed by MOV R4,R4 ; ; Class 1 .TTYINs are just passed thru to normal RT-11 processing ; unless SET SL TTYIN is in effect, the character mode bit is cleared ; in the JSW, and the Edit$ bit is cleared in the JSW. If all these ; conditions are met, the request is treated as a ".GTLIN ,,*" with a ; prompt of . ; ; Class 2 .TTYINs are "recursive" .TTYIN requests issued by SL to ; get characters from the terminal as input to the editing process. ; They are ALWAYS passed directly thru to normal RT-11 processing. ; ; Class 3 .TTYINs are requests presumed to have been issued by the USR ; for input to a .GTLIN or .CSI* request. (They are also used by KMON ; which "fakes" a .GTLIN rather than using the real .GTLIN facility.) ; The first class 3 .TTYIN causes SL to collect input until a line ; is available, then the .TTYIN code in SL changes modes (using the ; STATE word in the impure area) and returns characters from the ; impure area buffer in response to class 3 .TTYINs. ; ; Class 4 .TTYINs are used in FB and XM to request SL to collect an ; input line so that a job collects a line before "LOCKing" the USR. ; If SL is ignoring a request because the EDIT$ bit is on in the JSW, ; then it blocks the job ... (WORK THIS OUT >>>) ; ; In the .PRINT processing, SL classifies .PRINT requests into ; 2 groups: ; ; 1) Plain .PRINTs ; 2) .PRINTs followed by MOV R5,R5 ; ; Class 1 .PRINTs are just passed thru to normal RT-11 processing. ; ; Class 2 .PRINTs are issued by KMON when it "fakes" a .GTLIN and by ; the USR in SJ (RMON in FB/XM) to display the prompt string. Under ; SJ and FB SL stores the address of the string and sets the state of ; the .TTYIN processing it indicate a prompt is available. Under XM ; the string itself is copied to the impure area to avoid mapping ; problems later. ; ; Under XM a call to PRINTR (which is a substitute for .PRINT to ; avoid mapping problems) in the .GTLIN processing is also hooked as ; the "17" entry of EMT16. This request is treated the same as a ; class 2 .PRINT. ; ; The .EXIT requests are also hooked via the EMT16 list. When a program ; terminates, any associated impure area pointer is cleared. ; .NList BEX,CND .NoCross .....1 ...Cnt ...V1 ...V2 .HiH2O .NoCross CtlBas CtlErr RM.Cnt RM.Did SL.Cnt SL.Did SLBase .SbTtl ***************************************** .SbTtl * Conditionals and defaults * .SbTtl ***************************************** .LIBRARY "SRC:SYSTEM.MLB" .SbTtl Defaults .List CND .IIf NDF ErL$g ErL$g = 0 ; assume no error logging support .IIf NDF MMg$t MMg$t = 0 ; assume no XM support .IIf NDF Tim$it Tim$it = 0 ; assume no timeout support .IIf NDF RTE$m RTE$m = 0 ; assume no RTEM support .IIf NDF Eis$I Eis$I=RTE$m!MMg$t ; maybe assume SOB instriction .IIf NDF VT52$ VT52$ = 0 ; assume NO VT52 support .IIf NDF VT100$ VT100$ = 1 ; assume VT100 support .IIf NDF VT102$ VT102$ = 1 ; Assume VT102 support (insert char) .IIf NDF HelpB$ HelpB$ = 1 ; assume "BIG" help .IIf NDF LET$ LET$ = 1 ; assume LET support .IIf NDF LETNo$ LETNo$ = 5 ; assume 5 LET variables .IIf NDF FunKey FunKey = ; Function key support .IIf NDF FunK$S FunK$S = 0 ; Function key store on GOLD Fnn .If NDF LETSz$ .If NE HelpB$ LETSz$ = 32. ; assume 32 char LET strings .IfF; NE HelpB$ LETSz$ = 14. ; 14 char LET strings for SLMIN .EndC; NE HelpB$ .EndC; NDF LETSz$ .IIf NDF LinSz$ LinSz$ = 79. ; assume 79. char lines .IIf NDF Job$ Job$ = 8. ; assume 8 jobs in system max .IIf NDF SL$SPF SL$SPF = 0 ; NO multi-job SPFUN support .IIf NDF SL$HBF SL$HBF = HelpB$ & <1-SL$SPF> ; old buffers not in impure unless ; support .IIf NDF SL$MLO SL$MLO = HelpB$ ; multi old line FILO buffer ; unless SLMIN .IIf NDF SL$KED SL$KED = HelpB$& ; KeyPad Editing, ; unless SLMIN .IIf NDF SL$RCL SL$RCL = MMg$t& ; RECALL command comes with XM ; and multiple old line stack .IIf NDF SL$DBG SL$DBG = 0 ; Normally, no debugging (SET SL BPT) .IIf NDF SL$CLO SL$CLO = 0 ; Include CONSOLE LOGGING code? .Sbttl Consistancy checking .IIf EQ VT52$!VT100$!VT102$ .Error ; No terminal type supported; .IIf EQ VT52$!VT100$!VT102$ .End ; no sense in assembling .IIf EQ VT52$+VT100$+VT102$-1 VTxxx$ = 0 ; single-type support .IIf GT VT52$+VT100$+VT102$-1 VTxxx$ = 1 ; multi-type support .IIf GT SL$KED- .Error ; Cant have KED w/o VT100 .IIf LT SL$KED-SL$RCL .Error ; Cant have RECALL w/o KED sup .IIf LT SL$MLO-SL$RCL .Error ; or w/o Multi-Old Line support .IIf GT Funk$S-FunKey .Error ; Bad Funk$S conditional .NList CND .If NE MMg$t ;***************************************************************************** .Save .PSect SLDvr RW,I,LCL,REL,CON ; Normal driver code psect .PSect SetOvr RW,I,LCL,REL,CON ; Set code overlay psect .PSect InsOvr RW,I,LCL,REL,CON ; Install code overlay psect .PSect SLX RW,I,LCL,REL,CON ; Hidden driver code psect SLXBase: .Restore ;***************************************************************************** .EndC; NE MMg$t ;Note: *** SET SL SYSGEN means that all vectored calls (thru area set ; up by .DrEnd can NOT be used .SbTtl Generate JobMsk depending on Job$ value .If LE Job$-8. JobMsk =: ^b111 ; 1-8 jobs mask .IfF .If LE Job$-16. JobMsk =: ^b1111 ; 9-16 jobs mask .IfF .If LE Job$-32. JobMsk =: ^b11111 ; 17-32 jobs mask .EndC; LE Job$-32. .EndC; LE Job$-16. .EndC; LE Job$-8. .SbTtl Display SYSGEN options .IIf NE RTE$m .SbTtl Supports RTEM (SLM) .IIf NE MMg$t .SbTtl Supports XM (SLX) .IIf EQ MMg$t .SbTtl Supports SB/FB (SL) .IIf NE ErL$g .SbTtl Error logging monitor allowed .IIf NE Tim$it .SbTtl I/O time out monitor allowed .IIf NE VT52$ .SbTtl Supports VT52 .IIf NE VT100$ .SbTtl Supports VT100 .IIf NE VT102$ .SbTtl Supports VT102 .IIf NE FunKey .SbTtl Supports LK201 Function Keys .IIf NE VTxxx$ .SbTtl Multiple terminal-type support .IIf EQ HelpB$ .SbTtl Minimal help support .IIf NE HelpB$ .SbTtl Maximum help support .IIf NE EIS$I .SbTtl Requires EIS instructions .IIf NE SL$HBF .SbTtl (OLD, SAV, DEL)BUFs in High Mem - Not Impure .IIf NE SL$SPF .SbTtl .SPFUN Support .IIf NE SL$MLO .SbTtl Multiple Old Line Support .IIf NE SL$KED .SbTtl Keypad Editing (KED) Support .IIf NE SL$RCL .SbTtl RECALL Command Support .IIf NE SL$CLO .SbTtl Console Logger Support .Radix 10 .List ME .Irp .. \Job$ .SbTtl Support up to .. Jobs (all but 1 with external IMPURES) .EndR .If NE LET$ .Irp .. \LETNo$ .SbTtl LET substitution support for .. variables .EndR .Irp .. \LETSz$ .SbTtl for .. character long variables .EndR .EndC ;NE LET$ .Radix 8 .NList ME .SbTtl ***************************************** .SbTtl * Macros and Definitions * .SbTtl ***************************************** .SbTtl MCalls .MCALL .CF1DF .CF2DF .CF3DF .MCALL .ERRDF .FIXDF .JSWDF .MCALL .SGNDF .SYCDF .MCALL .UEBDF .MCall .DrDef ; normal handler macro .MCall .DStat .Enter .Exit ; other macros .MCall .Print .Purge .ReadC ; other macros .MCall .SCCA .SpFun .TtInR ; other macros .MCall .TtyOut .MrkT .CMkT ; other macros .MCall .WritC .Wait .RCtrlO ; other macros .MCall .Assume .Br .Addr .If EQ Eis$I .MCall SOB ; don't use SOB instruction .EndC; EQ Eis$I .SbTtl Macro definitions SL.Cnt = 0 ; SL relocation counter RM.Cnt = 0 ; RMON relocation counter SLR.Cnt = 0 ; SL root from hidden counter SLX.Cnt = 0 ; SL hidden counter RMX.Cnt = 0 ; RMON from hidden counter ;+ ; $REL ; ; Used to mark words to relocate in the handler ; ; $Rel Loc Value Base ; ; Loc -- location of word to relocate ; Value -- value to relocate it to ; Base -- base relocation on (SL, SLR, SLX, RMON, or RMONX) ; ; .If NE MMg$t ; SL marks references to root code (from root code) ; SLR marks references to root code (from hidden code) ; SLX marks references to the hidden code (from root or hidden code) ; RMON marks references to RMON (from root code) ; RMONX marks references to RMON (from hidden code) .IfF; NE MMg$t ; SL, SLR, and SLX mark references to handler code ; RMON and RMONX mark references to RMON .EndC; NE MMg$t ;- .If NE MMg$t .Macro $Rel Loc Value Base .....1 = . . = Loc .If IDN SL.Cnt = SL.Cnt+1 .Irp x <\SL.Cnt> SL.'x: .Word Value-SLBase .EndR . = .....1 .MExit .EndC; IDN .If IDN RM.Cnt = RM.Cnt+1 .Irp x <\RM.Cnt> RM.'x: .Word Value .EndR . = .....1 .MExit .EndC; IDN .If IDN SLX.Cnt = SLX.Cnt+1 .Irp x <\SLX.Cnt> SX.'x: .Word Value-SLXBase+P1Addr .EndR . = .....1 .MExit .EndC; IDN .If IDN SLR.Cnt = SLR.Cnt+1 .Irp x <\SLR.Cnt> SLR.'x: .Word Value-SLBase .EndR . = .....1 .MExit .EndC; IDN .If IDN RMX.Cnt = RMX.Cnt+1 .Irp x <\RMX.Cnt> RMX.'x: .Word Value .EndR . = .....1 .MExit .EndC; IDN .Error ; Unknown B A S E "Base"; .EndM $Rel .IfF; NE MMg$t .Macro $Rel Loc Value Base .....1 = . . = Loc .If IDN SL.Cnt = SL.Cnt+1 .Irp x <\SL.Cnt> SL.'x: .Word Value-SLBase .EndR; IDN . = .....1 .MExit .EndC .If IDN RM.Cnt = RM.Cnt+1 .Irp x <\RM.Cnt> RM.'x: .Word Value .EndR . = .....1 .MExit .EndC; IDN .If IDN SL.Cnt = SL.Cnt+1 .Irp x <\SL.Cnt> SL.'x: .Word Value-SLBase .EndR . = .....1 .MExit .EndC; IDN .If IDN SL.Cnt = SL.Cnt+1 .Irp x <\SL.Cnt> SL.'x: .Word Value-SLBase .EndR . = .....1 .MExit .EndC; IDN .If IDN RM.Cnt = RM.Cnt+1 .Irp x <\RM.Cnt> RM.'x: .Word Value .EndR . = .....1 .MExit .EndC; IDN .Error ; Unknown B A S E "Base"; .EndM $Rel .EndC; NE MMg$t ;+ ; BOFF ; ; Used to define mnemonic branch after TST(B)/BIT(B) ; ; Boff Dst ; ; Dst -- location to branch to if bit/byte/word off (zero) ;- .Macro Boff Dst Beq Dst .EndM Boff ;+ ; BON ; ; Used to define mnemonic branch after TST(B)/BIT(B) ; ; Bon Dst ; ; Dst -- location to branch to if bit/byte/word on (non-zero) ;- .Macro Bon Dst Bne Dst .EndM Bon ;+ ; ...... ; ; indicate unconditional "branching" ; ; ...... ;- .Macro ...... .EndM ...... ;+ ; .DISABLE ; ; Allow .Disable to be used in place of .dsabl ; ; .Disable opt opt opt ;- .Macro .Disable a b c d e f .Dsabl a b c d e f .EndM .Disable ;+ ; CALLXR ; ; Provide multiple calling function (threaded code) ; Saves space in coding ; ; CallXR a,b,c,d,e,f ;- .Macro CallXR A,B,C,D,E,F Jsr R0,CallXR ...Cnt = 0 .Irp Dest, ...Cnt = ...Cnt+1 .If NB .If NE ...Cnt-6 .Word Dest-.-2 .IfF; NE ...Cnt-6 .Word Dest+1-.-2 .EndC; NE ...Cnt-6 .EndC; NB .EndR .EndM CallXR ;+ ; Push ; ; Place a word on the stack ;- .Macro Push Value .If IDN <#0> Clr -(SP) .Iff; IDN <#0> Mov Value,-(SP) .EndC; IDN <#0> .EndM Push ;+ ; PushB ; ; Place a byte on the stack ;- .Macro PushB Value .If IDN <#0> Clr -(SP) .Iff; IDN <#0> MovB Value,-(SP) .EndC; IDN <#0> .EndM PushB ;+ ; Pop ; ; Remove a word from the stack ;- .Macro Pop Value,Save .If B .If B Tst (SP)+ .IfF; B Bit @SP,(SP)+ .EndC; B .Iff; B Mov (SP)+,Value .EndC; B .EndM Pop ;+ ; PopB ; ; Remove a byte from the stack ;- .Macro PopB Value,Save .If B .If B TstB (SP)+ .IfF; B BitB @SP,(SP)+ .EndC; B .Iff; B MovB (SP)+,Value .EndC; B .EndM PopB .SbTtl Equates .CF1DF .CF2DF .CF3DF .ERRDF .FIXDF .JSWDF .SGNDF .SYCDF .UEBDF .SbTtl . Hardware references Blk =: 1000 ; block size for disks KTGran =: 32.*2 ; KT11 granularity (and PLAS too) P1Addr =: 20000 ; first address in PAR1 KISDR1 =: 172302 ; Kernel Instruction PDR1 AP$ACF =: 077406 ; 4KW page with no trap/abort KISAR1 =: 172342 ; Kernel Instruction PAR1 PS =: 177776 ; PSW in machines that have them CMKern =: 140000 ; Current mode kernel PMKern =: 030000 ; Previous mode kernel .SbTtl . Block0 references H.Gen =: 60 ; sysgen bits byte H.DPtr =: 70 ; pointer to data in handler file Ins.CSR =: 176 ; install CSR value Ins.DK =: 200 ; install EP for non-system device Ins.SY =: 202 ; install EP for system device BitMap =: 360 ; low address of bit map area .Sbttl . Chain area references CmdLen =: 510 ; command length word for KMON CmdStr =: 512 ; command string for KMON .SbTtl . RMON references MinVer =: 5 ; minimum version number supported Emt16 =: 316 ; offset to EMT16 table EmtTtI =: 0 ; position of .TtyIn in table EmtTtO =: 2 ; position of .TtyOut in table EmtDSt =: 4 ; position of .DStat in table EmtFet =: 6 ; position of .Fetch in table EmtCSG =: 10 ; position of .CSIGen in table EmtCSS =: 12 ; position of .CSISpc/.GtLin in table EmtLck =: 14 ; position of .Lock in table EmtUnL =: 16 ; position of .UnLock in table EmtXit =: 20 ; position of .Exit in table EmtPri =: 22 ; position of .Print in table EmtSRe =: 24 ; position of .SReset in table EmtQSe =: 26 ; position of .QSet in table EmtSet =: 30 ; position of .SetTop in table EmtRCt =: 32 ; position of .RCtrlO in table EmtAST =: 34 ; position of .ASTX in table EmtHRe =: 36 ; position of .HReset in table .If NE MMg$t SubPri =: 40 ; position of PrintR in table Old.PC =: 14. ; offset in stack to old PC when .IfF; NE MMg$t Old.PC =: 12. ; offset in stack to old PC when .EndC; NE MMg$t ; O.* is entered from RMON Emt16 list I.State =: 0 ; first word in IMPURE is I.STATE BatRn$ =: 000002 ; BATCH is running, skip address check BG.Job =: 0 ; background job is # 0 ErLg$ =: 000001 ; Error logging XMMon$ =: 000002 ; XM monitor Timit$ =: 000004 ; time out support RTEM$ =: 000010 ; RTEM monitor MTty$ =: 020000 ; MTTY monitor EmtRtn =: 400 ; address of EMT return routine ; or of DLTCB in MTTY $TCFig =: 424 ; address of terminal options word ;TTCnfg =: pointed to by $TCfig CrLf$ =: 2 ; free CRLF flag at term width if set MemPtr =: 430 ; fixed offset to memory pointers KMonIn =: 450 ; KMON running flag (0=not running) ;@ ; extended memory block $FLstX =: 0 ; beginning of free region list $FSize =: 0 ; size in 32words units $FAddr =: 2 ; address in 32words units ; ; repeated entries (0 size is empty) ; 177777 ; end of entries GR.Siz =: 0 ; offset to size word in global RCB GR.Adr =: 2 ; offset to address word in global RCB GR.Sta =: 4 ; offset to status word in global RCB GR.PRV =: 100000 ; PRIVATE region GR.Nam =: 6 ; offset to rad50 name in global RCB GR.Esz =: 10. ; size of entry in global RCB ; ; repeated entries (0 GR.Siz is empty) ; 177777 ; end of list XDealc =: -18. ; Jmp to XM DEALLOC routine XAlloc =: -6 ; Jmp to XM ALLOC routine BlkMov =: -2 ; Br to block move routine ; 0 ; P1Ext routine P1Ext =: 432 ; pointer to externalization routine .SbTtl Old-line buffer size .If NE ; Buffers are NOT in impure area - large old-line FILO enabled .IIf NDF OldBSz OldBSz =: 512. ; old line buffer FILO size .IfF; NE ; Buffers are in impure area. If multiple old line option is in effect, ; then the OldBuf and OldrBf buffers must be contiguous and are used as ; one storage area. .IIf NDF OldBSz OldBSz =: LinSz$+LinSz$+2 ; (combined OldBuf and OldrBf) .EndC; NE .SbTtl . EMT request block codes .Enter =: 2 ; request code for .Enter (byte value) .Read =: 10 ; request code for .Read_ (byte value) .Write =: 11 ; request code for .Writ_ (byte value) .MrkT =: 22*400 ; request code for .MrkT (word value) .CMkT =: 23*400 ; request code for .CMkT (word value) .SpFun =: 32 ; request code for .SpFun (byte value) .SCCA =: 35*400 ; request code for .SCCA (word value) ; Define .SpFun Codes ;* WARNING: These SpFun codes should not be considered a documented *; ;* interface. They are subject to change, refinement, or deletion *; ;* until such time as they appear in RT-11 documentation. *; Upd$Fn =: 372 ; update request for handler Copy$S =: 0 ; copy subfunction Conn$S =: 2 ; connect subfunction Disc$S =: 4 ; disconnect subfunction Size$S =: 6 ; SLSize subfunction SetI$S =: 10 ; set Impure address for job Init$S =: 12 ; SLInit subfunction Prmp$S =: 14 ; prompt definition subfunction Edit$S =: 16 ; SLEdit subfunction CLet$S =: 20 ; copy Let table subfunction ; Maximum valid SPFUN code for this version: .If EQ Let$ ; LET support? .If EQ SL$SPF ; If NO EXTENDED SPFUN support, SpFMax =: Disc$S ; Minimum SPFUNs, NO LET support .IfF; ; If EXTENDED SPFUN support, SpFMax =: Edit$S ; SPFUN support, NO LET support .EndC .IfF; SpFMax =: Clet$S ; LET support .EndC ; Parameters for .SpFun Codes ; Block Buffer Count Action ; ----- ----- ----- ---------------------------------------------- .If NE SL$SPF ; Copy$S Buffer Flag - flag => impure to buffer; + buffer to impure .EndC; NE SL$SPF ; Conn$S Impure* LinLen# Connect to BATCH hooks, establish impure area ; Disc$S ---- ---- Disconnect from BATCH hooks ; Size$S Reply LinLen# Determine impure size requirements ; SetI$S Impure* LinLen# Establish impure area w/o connecting to BATCH ; Init$S Reply LinLen# Init impure area return address of buffer .If NE SL$SPF ; Prmp$S ---- Prompt Set prompt string in impure area ; Edit$S ---- ---- Get an edited line from terminal .EndC; NE SL$SPF .If NE SL$SPF!Let$ ; CLet$S Buffer Flag - flag => Let to buffer; + buffer to Let .EndC; NE SL$SPF!Let$ ; ; * if BG job 0 means use internal Impure area ; # 0 means use default line length WrkChn =: 0 ; work channel BotChn =: 0 ; Boot time install channel SysChn =: 17 ; overlay channel .SbTtl . Character names NUL =: 000 ; Null char Ctrl.A =: 001 ; ^A char Ctrl.B =: 002 ; ^B char Ctrl.C =: 003 ; ^C char Ctrl.D =: 004 ; ^D char Ctrl.E =: 005 ; ^E char Ctrl.F =: 006 ; ^F char BEL =: 007 ; Bell (output only) BS =: 010 ; BackSpace HT =: 011 ; Horizontal Tab LF =: 012 ; LineFeed CR =: 015 ; Carriage Return SO =: 016 ; Shift out G1 set SI =: 017 ; Shift in G0 set Ctrl.R =: 022 ; ^R char Ctrl.U =: 025 ; ^U char Ctrl.V =: 026 ; ^V char Ctrl.W =: 027 ; ^W char Ctrl.Z =: 032 ; ^Z char ESC =: 033 ; Escape (without RSTS 233 hack) US =: 037 ; highest control char MaxCtl =: ; highest interesting Control char OldOfs =: 037 ; offset for cursor addressing in VT52 SPC =: 040 ; Space char (above all "Ctl chars") SCS1 =: 051 ; Intermediate for SCS 1 selection SCL1 =: 042 ; intermediate for select conformance level OldINT =: 057 ; intermediate for ESC oldINT x response Lev1B =: 061 ; ESC CSI Lev1A Lev1B SCL1 SCL2 ANM =: 062 ; DEC ANSI/VT52 mode ; (ESC CSI ANM RM) VT52 Mode IRM =: 064 ; Insert Replacement Mode ; ; (ESC CSI IRM SM) insert mode ; ; (ESC CSI IRM RM) replacement mode Lev1A =: 066 ; ESC CSI Lev1A Lev1B SCL1 SCL2 OM =: 066 ; Origin Mode ; (ESC CSI DEC OM SM) relative origin mode ; (ESC CSI DEC OM RM) absolute origin mode REVVID =: 067 ; Reverse Video graphic rendition SEP =: 073 ; parameter separator OldANSI =: 074 ; ANSI Mode (ESC OldANSI) DEC =: 077 ; dec private introducer CUU =: 101 ; Cursor Up terminator CUD =: 102 ; Cursor Down terminator CUF =: 103 ; Cursor Forward terminator CUB =: 104 ; Cursor Backwards terminator OldHom =: 110 ; Cursor Home for VT52 CUP =: 110 ; Cursor Position EL =: 113 ; erase in line SS3 =: 117 ; Single Shift 3 (intermediate for ; application keys) DCH =: 120 ; Delete CHaracter (ESC CSI n DCH) PF1 =: 120 ; PF1 terminator PF2 =: 121 ; PF2 terminator PF3 =: 122 ; PF3 terminator PF4 =: 123 ; PF4 terminator OldREV =: 124 ; ESC OldREV selects REVVID on VT62 OldNOR =: 125 ; ESC OldNOR selects NORVID on VT62 OldCUP =: 131 ; ESC OLDCUP OLDOFS+line OLDOFS+col ; is cursor addressing for VT52 OldDA =: 132 ; ESC OLDDA requests ID from terminals ; response values in SET overlay CSI =: 133 ; Control String Introducer (7-bit) OldNoH =: 134 ; ESC OLDNOH Exit hold screen LQuote =: 137 ; LET Quote char "_" underscore DA =: 143 ; ESC DA requests ID from terminals ; response values in SET overlay SM =: 150 ; Set Mode terminator C.BR =: 152 ; Bottom Right Corner C.TR =: 153 ; Top Right Corner RM =: 154 ; Reset Mode terminator C.TL =: 154 ; Top Left Corner C.BL =: 155 ; Bottom Left Corner SGR =: 155 ; select graphic rendition X.Line =: 156 ; crossing lines SCL2 =: 160 ; ESC CSI Lev1A Lev1B SCL1 SCL2 H.Line =: 161 ; Horizontal line dSTBM =: 162 ; Set Top Bottom Margins ; (ESC CSI # ; # dSTBM) T.L =: 164 ; Left Tee T.R =: 165 ; Right Tee T.B =: 166 ; Bottom Tee T.T =: 167 ; Top Tee V.Line =: 170 ; Vertical line DEL =: 177 ; Delete char NoCrLf =: 200 ; No CR LF on .Print and EOB byte .SbTtl . (Bill*2,Carlos,Dave,Don,Greg,Jim*2,Joe,Les,Linda,Marty,Sue) .SbTtl . (Bill,Dave,Don,George,Greg,Jim*2,Joe,Linda,Liz,Marty,Steve,Sue) .SbTtl . (Bill,Dave,Don,George,Greg,Jim*2,Joe,Linda,Liz,Marty,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Greg,Jim*2,Joe,Linda,Liz,Marty,Randy,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Greg,Jim*2,Joe,Liz,Marty,Randy,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Jim*2,Joe,Liz,Marty,Randy,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Jim*2,Joe,Marty,Randy,Steve,Sue) .SbTtl . (Bill*2,Carlos,Dave,Don,George,Jim*2,Joe,Marty,Randy,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Jim*2,Joe,Klara,Marty,Randy,Steve,Sue) .SbTtl . (Bill,Carlos,Dave,Don,George,Jim*2,Joe,Klara,Marty,Steve,Sue) .SbTtl . (Bill*2,Carlos,Dave,Don,George,Jim*2,Joe,Klara,Marty,Steve,Sue) .SbTtl . (Bill*2,Carlos,Dave,Don,George,Jim*2,Joe,Klara,Linda,Marty,Steve,Sue) .SbTtl . (Bill*2,Carlos,Dave,Deb,Don,George,Jim*2,Joe,Klara,Linda,Marty,Steve,Sue) .SbTtl . (Bill,Dave,Deb,Don,George,Jim*2,Joe,Klara,Linda,Marty,Steve,Sue) .SbTtl . (Bill,Dave,Deb,Don,George*2,Jim*2,Joe,Klara,Linda,Marty,Steve,Sue) .SbTtl . (Bill,Deb,Don,George*2,Jim*2,Joe,Klara,Linda,Marty,Steve,Sue) .SbTtl . (Bill,Deb,Don,George*2,Jim*2,Joe,Klara,Linda,Marty,Sue) .SbTtl . (Bill,Deb,Don,George*2,Jacqueline,Jim*2,Joe,Klara,Linda,Marty,Rob,Sue) .SbTtl . (Bill,Deb,Don,George*2,Irene,Jacqueline,Jim*2,Joe,Klara,Linda,Marty,Rob,Sue) .SbTtl . (Bill,Deb,Don,George*2,Irene,Jacqueline,Jennifer,Jim*2,Joe,Klara,Linda,Marty,Matthew,Meiling,Peggy,Rob,Sue) .SbTtl . (Bill,Deb,Don,George,Irene,Jacqueline,Jennifer,Jim*2,Joe,Klara,Linda,Marty,Matthew,Meiling,Peggy,Rob,Steve,Sue) .SbTtl . (Bill,Deb,Don,George,IB,Irene,Jacqueline,Jennifer,Jim*2,Joe,Klara,Linda,Matthew,Megan,Meiling,Peggy,Rob,Steve,Sue) .SbTtl . (Bill,Don,George,IB,Irene,Jacqueline,Jennifer,Jim*2,Joe,Klara,Linda,Matthew,Megan,Meiling,Peggy,Rob,Steve,Sue) .SbTtl . (Bill,Don,George,Irene,Jim*2,Joe,Klara,Linda,Matthew,Megan,Peggy,Rob,Steve,Sue) .SbTtl . (Bill,Don,George,Irene,Jim*2,Linda,Matthew,Megan,Peggy,Rob,Sue) .SbTtl Define handler characteristics .DrDef SL, 51, WOnly$!ROnly$!SpFun$, 0, 0, 0, DMA=NO .DrPtr UNLOAD=UNLOAD .IIf NE LET$ .DrESt CLASS=DvC.PS,DATA=LetImp,TYPE=SL .IIf EQ LET$ .DrESt CLASS=DvC.PS .DrSPF ; update request for handler ;NOTE: consider redoing this interface before making public (if ever) ;+ ; .Audit information ; ; 110: .Rad50 "release" ; 112: .Word "version" ; 114: .Word .SLGen options used to gen this SL ; 116: .Word .LetGen values used to gen LET support ; or ; 116: .Word 100000 no LET support ; 120: .Word -1 end of list marker ; ; .SLGen ; ; 000001 0 VT52$ ; 000002 1 VT100$ ; 000004 2 VT102$ ; 000010 3 reserved ; 000020 4 HelpB$ ; 000040 5 Let$ ; 000100 6 MMg$t ; 000200 7 EIS$I ; 007400 8-11 reserved ; 170000 12-15 Job$*10000 ; ; .LetGen ; ; 000377 0-7 size of a let entry ; 177400 8-15 number of let entries ;- .SLGen = !!!<000000*10> .SLGen = .SLGen!!!! .SLGen = .SLGen! .If NE Let$ .LetGen =: LetNo$+400*LetSz$ .IfF; NE Let$ .LetGen =: 100000 ; No let support .EndC; NE Let$ .If NE MMg$t .If NE SL$SPF ProSiz =: LinSz$ ; max length of prompt in impure area .IfF; NE SL$SPF ProSiz =: 41. ; max length of prompt in hi-mem .Endc;NE SL$SPF .IfF; NE MMg$t ProSiz =: 0 ; NO prompt buffer for SB/FB .EndC; NE MMg$t .SbTtl ***************************************** .SbTtl * Installation check code * .SbTtl ***************************************** .SbTtl Block 0 of handler file .Asect ; stuff for first block Block0 =: 0 ; origin of "set" block .Enable LSB .Audit .SL ; Major .audit info .Audit .SLgen ; assembly .audit info .Audit .LetGen ; Let .audit info .If EQ MMg$t .Assume . LE Ins.CSR .DrIns SL Ins$DK: Br 10$ ; non-system device ........... .Assume . EQ Ins.SY Ins$SY: Br InsNo ; system device, illegal ............. .IfF; EQ MMg$t .=...V5+2 ; start just after .audit stuff .IfTF; EQ MMg$t InsCk: ; also used as a subr by SET SL SYSGEN 10$: Mov @#$SYPTR,R0 ; get RMon address CmpB $SYSVE(R0),#MinVer ; is a new enough version? **GVAL** .IfT; EQ MMg$t Blo InsNo ; no, then do not allow .IfF; EQ MMg$t Blo InsCkN ; no, then do not allow .IfTF; EQ MMg$t Bit #XMMon$,$SYSGE(R0) ; running under XM? **GVAL** .IfT ;EQ MMG$T Bon InsNo ; No, it is XM, can't support .IfF; EQ MMG$T Boff InsCkN ; No, it is not XM, can't support .IfTF ;EQ MMG$T InsYes: Tst (PC)+ ; clear Carry, skip Sec InsNo: ; installation error .IfT; EQ MMg$t SetEr2: .IfF; EQ MMg$t SetEr1: .IfTF; NE MMg$t Sec ; error, do not install Return ...... .IfF; ;EQ MMG$T InsCkN: Com (SP)+ ; set carry Return ; return to caller's caller ...... .Assume . LE Ins.CSR .DrIns SL Ins$DK: Br 20$ ; non-system device ........... .Assume . EQ Ins.SY Ins$SY: Br InsNo ; system device, illegal ............. 20$: Call InsCk ; do the sysgen options match? ; get second block of install code .Wait #SysChn ; is this boot time? Bcc 30$ ; no, then channel 17 is used .Assume BotChn EQ 0 .Wait #0 ; is the boot channel open? Bcs InsNo ; no, then give up .Assume BotChn EQ 0 ClrB ReaChn ; use boot time channel Mov @R3,BlkAdd ; get increment value for block number .If NE SL$DBG Br 40$ ; join common code (skip BPT) .EndC; NE SL$DBG 30$: DBGIns: ;5 check for debugging $INSTALL code .If NE SL$DBG ;***************************************;5 next instruction put over NOP by BPT ;5 SET LD BPT=2 .=:DBGIns;******************************;5 NOP ;5 ;*************************************** .EndC; NE SL$DBG 40$: Mov #OvrIns/2,R3 ; point to overlay install code Br GetOvr ; go get it .............. .IfT; EQ MMg$t .If NE SL$DBG DBGIns: .BlkW 1 ; no installation code to bother with .EndC; NE SL$DBG .EndC; EQ MMg$t .Disable LSB .Sbttl ***************************************** .SbTtl * Set Code * .Sbttl ***************************************** .SbTtl GetOvr -- overlay handler for SET code ;+ ; GETOVR ; ; Get a SET overlay and jump to code in it ; ; R3 contains Addr/2 of the place to get control. ; ; R3 is destroyed ; ; Cond codes destroyed ;- .Enable LSB Go2Ovr: .If NE VTXXX$ MovB dVT100,(PC)+ ; save dVT100 flag for overlay code oVT100: .BlkW 1 ; readonly copy .EndC; NE VTXXX$ GetOvr: ; read a "set overlay" .If NE SL$DBG DBGSet: ;5 check for debugging SET code ;***************************************;5 next instruction put over NOP by BPT ;5 SET LD BPT=0 .=:DBGSet;******************************;5 NOP ;5 ;*************************************** .EndC; NE SL$DBG SwaB R3 ; get block number to low byte MovB R3,ReaBlk ; set block number to read .If NE MMg$t Add #.-.,ReaBlk ; add in offset (boot time install) BlkAdd =: .-4 .EndC; NE MMg$t Bic #377,R3 ; clear out old block number Bis #SLStrt/Blk,R3 ; use Queue code block for address Br 10$ ; join common code .SbTtl FakOvr -- overlay return handler for SET code ;+ ; FAKOVR ; ; Used to return from a SET overlay to normal SET code ; and reread the QUEUE code into block 1. ; ; R3 contains Addr/2 of the place to get control. ; ; R3 is destroyed ; ; Cond codes destroyed ;- FakOvr: ; special entry to load Block1 SwaB R3 ; get block number to low byte MovB #SLStrt/Blk,ReaBlk ; but Queue code block 10$: Jsr R0,20$ ; save R0, and point to arg block **PIC** ReaChn: .Byte SysChn+.-. ; channel ReaCod: .Byte .Read+.-. ; request code ReaBlk: .BlkW 1 ; block number to read ReaBuf: .BlkW 1 ; buffer address to read into .Word Blk/2 ; words to read .Word 0 ; .ReadW 20$: .Addr #SLStrt,R5,PUSH ; == Push R5/ ADDR SLStrt **PIC** Mov R5,ReaBuf ; set address of read buffer Pop R5 ; restore work register .ReadC Code=NOSET ; do the read ; This is really a .READW Pop R0,Save=Carry ;*C* restore saved register Bcs SYWLEr ; overlay read/write failed SwaB R3 ; get address back Asl R3 ; make into byte offset .Addr #Block0,R3,ADD ; make into real address **PIC** Jmp @R3 ; go to it. ........... .Assume . LE 400 .Disable LSB .SbTtl Set Option table ; Option data routine syntax ; ------ ------ ------- ------ .DrSet ASK OvrAsk/2 GoOvr ; overlay .If NE SL$DBG .Assume NOP EQ 240 .DrSet BPT NOP SetBPT ; local .EndC; NE SL$DBG .DrSet OFF OvrOff/2 GoOvr ; overlay .DrSet ON OvrOn/2 GoOvr ; overlay .DrSet KMON OvrKMo/2 GoOvr ; overlay .If NE VT100$!VT102$ .DrSet LEARN OvrLea/2 YesNo ; overlay .If NE SL$KED .DrSet KED 100000 SetKED ; local .EndC; NE SL$KED .EndC; NE VT100$!VT102$ .If NE SL$RCL .DrSet RECALL 100000 SetRCL ; local .IfF; NE SL$RCL .DrSet VT62 100000!VT.52 SetTyp ; local .DrSet VT101 100000!VT.100 SetTyp ; local .EndC; NE SL$RCL .If NE Let$ .DrSet LET 100000 SetLet ; local .EndC; NE Let$ .DrSet SYSGEN -1 SetSys ; local (in INSTALL area) .DrSet TTYIN 100000 SetTty ; local .If NE VT52$ .DrSet VT52 100000!VT.52 SetTyp ; local .EndC; NE VT52$ .If NE VT100$ .DrSet VT100 100000!VT.100 SetTyp ; local .EndC; NE VT100$ .If NE VT100$!VT102$ .DrSet VT102 100000!VT.102 SetTyp ; local .DrSet WIDTH WidLim SetWid ; local .EndC; NE VT100$!VT102$ .SbTtl SY: I/O error SYWLEr: BitB #1,ReaCod ; a read or a write? Boff SetEr2 ; read SYWLOv: ; entry from overlay write Mov @SP,R0 ; get return address Inc R0 ; point to returned opcode CmpB #BR/400,(R0)+ ; is it a BR ... ? Bne SetEr2 ; then no second return point Mov R0,@SP ; else take WRITELOCKED exit .If EQ MMg$t Br SetEr2 ; now .IfF; EQ MMg$t SetEr2: Br SetErr ; now .EndC; EQ MMg$t .SbTtl SET SL SYSGEN hook to command processing SetSys: ClrB R3 ; no extra bits Nop ; pad to proper location SetNoS: .Assume SetSys+4 EQ SetNoS Call InsCk ; could we be installed? ; (Ignoring sysgen mismatch) .If EQ MMg$t SetEr1: Bcs SetErr ; no .EndC; EQ MMg$t MovB $SYSGE(R0),H.Gen ; make us match the system BisB R3,H.Gen ; or not match if SET SL NOSYSGEN Br SetOk ; go to real code ............. .SbTtl SET SL [NO]TTYIN command processing SetTty: ; SET SL TTYIN Mov #1,R3 ; indicate true .Br SetNoT SetNoT: ; SET SL NOTTYIN .Assume SetTty+4 EQ SetNoT MovB R3,dTtyIn ; indicate if or not .TTYIN ; line mode is edited Br SetSav ; and done .............. .If NE Let$ .SbTtl SET SL [NO]LET command processing SetLet: ; SET SL LET Mov #1,R3 ; indicate true .Br SetNoL SetNoL: ; SET SL NOLET .Assume SetLet+4 EQ SetNoL MovB R3,dLet ; indicate if or not Let ; substitution is to be done Br SetSav ; and done .............. .EndC; NE Let$ .If NE SL$KED .SbTtl SET SL [NO]KED command processing SetKED: ; SET SL KED Mov #1,R3 ; indicate true SetNoK: ; SET SL NOKED .Assume SetKED+4 EQ SetNoK MovB R3,dKed ; indicate if or not KED ; substitution is to be done Br SetSav ; and done .............. .EndC; NE SL$KED .If NE SL$RCL .SbTtl SET SL [NO]RECALL command processing SetRCL: ; SET SL RECALL Mov #1,R3 ; indicate true SetNoR: ; SET SL NORECALL .Assume SetRCL+4 EQ SetNoR MovB R3,dRCL ; indicate if or not RECALL ; substitution is to be done Br SetSav ; and done .............. .EndC; NE SL$RCL .If NE SL$DBG .SbTtl SET SL [NO]BPT=n command processing .Enable LSB SetBPT: ; SET SL BPT=n .Assume BPT EQ 3 Mov #BPT,R3 ; put in a BPT .Br SetNoB SetNoB: ; SET SL NOBPT=n .Assume SetBPT+4 EQ SetNoB Cmp #BPTLen/2,R0 ; value in range? Blos SetErr ; no, error return (unsigned test) Asl R0 ; make into word index Jsr R1,10$ ; point to table **PIC** BPTTab: .Word DBGSet-TabBas ; SET SL [NO]BPT=0 ! debug SET code .Word DBGQue-TabBas ; SET SL [NO]BPT=1 ! debug QUEUE code .Word DBGIns-TabBas ; SET SL [NO]BPT=2 ! debug $INSTALL code .Word DBGTty-TabBas ; SET SL [NO]BPT=3 ! debug .TTYIN code .Word DBGPri-TabBas ; SET SL [NO]BPT=4 ! debug .PRINT code .Word DBGXit-TabBas ; SET SL [NO]BPT=5 ! debug .EXIT code .If NE MMg$t .Word DBGPrR-TabBas ; SET SL [NO]BPT=6 ! debug PRINTR code .EndC; NE MMg$t BPTLen =: .-BPTTab 10$: Add R1,R0 ; point into table **PIC** Mov @R0,R0 ; get offset Add PC,R0 ; and make into address PIC **PIC** TabBas=:. Mov R3,@R0 ; change location to BPT/NOP Pop R1 ; restore stack/R1 Br SetOk ; normal return ............. .Disable LSB .EndC; NE SL$DBG AskWid: ; alt entry from AskOvr MovB R0,dWidth ; save width SwaB R0 ; put type in low byte .Br AskTyp AskTyp: ; entry from AskOvr Mov R0,R3 ; move value for terminal type .Br SetTyp .SbTtl SET SL VT___ command processing .Enable LSB SetTyp: .If NE VTxxx$ MovB R3,dVt100 ; set default terminal type .EndC; NE VTxxx$ Br SetSav ; and done .............. .Disable LSB .SbTtl YesNo -- handle [NO] options in overlays .Enable LSB YesNo: Mov SP,R0 ; indicate yes (non-zero) Br 10$ ; and skip clearing R0 ........... NoYes: .Assume YesNo+4 EQ NoYes Clr R0 ; indicate no 10$: GoOvr: Jmp Go2Ovr ; go to overlay .Disable LSB .If NE VT100$!VT102$ .SbTtl SET SL WIDTH=n command processing .Enable LSB SetWid: WidLim =: 30.*400+132. ; max width in low byte, min in high CmpB R3,R0 ; within range? Blo SetErr ; too wide SwaB R3 ; try other limit CmpB R3,R0 ; too narrow Bhi SetErr ; yep MovB R0,dWidth ; set default terminal width .Br SetSav ; and done .Disable LSB .EndC; NE VT100$!VT102$ .SbTtl SetSav -- save a modified block 1 .Enable LSB SetSav: IncB ReaCod ; make the .Read into .Write Mov #10$/2,R3 ; point to rest of code Jmp FakOvr ; write out block 1 10$: DecB ReaCod ; back to a .Read .Br SetOk .Disable LSB .SbTtl SetOk/Err -- common exit code from SET .Enable LSB SetOk: Tst (PC)+ ; normal return (CLC) SetErr: Sec ; return error Return ; back to KMON set code ...... .Disable LSB .Assume . LE Blk .SbTtl ***************************************** .SbTtl * Queue Manager code * .SbTtl ***************************************** .SbTtl Queue manager and "call" dispatching .Enable LSB ;***************************************************************************** .DrBeg SL ; Queue manager entry Br Queue ; process I/O requests (.SpFuns) .SbTtl DATA local to SL used by SETs .If NE LET$ dLet: .Byte 0 ; LET substitution support flag .Assume dLet-SLStrt EQ 16 .EndC ;NE LET$ .If NE VTxxx$ dVT100: .Byte VT.100 ; assume VT100 by default .EndC ;NE VTxxx$ dWidth: .Byte LinSz$ ; default width dTtyIn: .Byte 0 ; .TTYIN support flag .If NE SL$KED dKED: .Byte 0 ; KED-type editing ON/OFF flag .EndC; NE SL$KED .If NE SL$RCL dRCL: .Byte 0 ; RECALL command disabled by default .EndC; NE SL$RCL .Even .Assume .-SLStrt LE Blk .If NE SL$CLO .Save ;***************************************************************************** .PSect SLX ; ************************* ; SL Console Logger Support ; ************************* BUFRDY =: 1 ; Buffer ready-for-writing CLACTV =: 2 ; Logging ACTIVE DOTTOU =: 4 ; Log TTYOUTs if set ; This must be the first stuff in the SLX region CLID: .RAD50 /SLOG / ; Identifier CLBUF1: .BLKW 256. ; Console Logger Buffer #1 CLBUF2: .BLKW 256. ; Console Logger Buffer #2 CLSTAT: .WORD 0 ; Console Logger Status Word DOOFST: .WORD 0 ; index into CLBUF1 .BLKW 4 ; spares LOCPBF: .BLKB 132. ; local .PRINT buffer ; Console Logger Support Code .SBTTL DOLINE - Output one line to log buffer ; Output a line pointed to by R0 to the list file. ; R0 gets destroyed. .ENABL LSB DOLINE: BIT #PMKern,@#PS ; .PRINT from KERNEL mode? BEQ DOLINL ; skip this stuff if so. MOV R1,-(SP) ; save regs MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV #LOCPBF,R1 ; point to beginning of loc string $REL .-2 LOCPBF SLX MOV R1,R2 ADD #131.,R2 ; point to end ; Move the string out of a job's virtual space, into the local ; string buffer "LOCPBF" (above). (otherwise, DOLINE can't see it.) 10$: Clr R4 ; clear flag register Mov R0,R3 ; copy input address Inc R0 ; point to next input char Asr R3 ; shift out low bit to carry Adc R4 ; save carry state in R4 Asl R3 ; shift back with low bit off Jsr R0,@#.-. ; call externalization routine P1Ext3 =: .-2 ; added in by Init .Word 20$-. ; length of request MFPD @R3 ; get a word from caller Pop R3 ; and return it in R3 20$: .Word P1Addr/KTGran ; Par1 value Tst R4 ; was it an odd address Beq 30$ ; no SwaB R3 ; yes, swap the bytes 30$: MovB R3,(R1)+ ; copy into buffer Beq 40$ ; done CmpB #,R3 ; other terminator? Beq 40$ ; done Cmp R1,R2 ; still room? Blo 10$ ; yes ClrB -(R1) ; force an end 40$: MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV #LOCPBF,R0 ; point to local copy again $REL .-2 LOCPBF SLX .DSABL LSB .ENABL LSB DOLINL: 10$: TSTB @R0 ; Is char a NULL? BEQ DOCRLF ; Branch if so CMPB @R0,#200 ; Is it a 200? BEQ DONE ; Branch if so MOV R0,-(SP) ; Save char pointer MOVB @R0,R0 ; Put char in R0 CALL DOPUTC ; Output it MOV (SP)+,R0 ; Restore its address INC R0 ; Point to next character BR 10$ ; Loop ...... ; Output to list file DOCRLF: MOV #CR,R0 ; Print CALL DOPUTC MOV #LF,R0 ; Print BR DOPUTC .SBTTL DOPUTC - Output one character to list file ; DOPUTC: Output a character (in R0) to the list file ; DOOUTC: Do same, but only if DOTTOU bit is set in CLSTAT DOOUTC: BIT #DOTTOU,CLSTAT ; Doing TTYOUTs? BEQ DONE DOPUTC: BIT #CLACTV,CLSTAT ; SLOG turned on? BEQ DONE ; return immediately if not. CMP DOOFST,#512. ; At end of buffer? BLO 30$ ; Branch if not. CALL DOWRIT ; Otherwise, dump the buffer. 30$: MOV R1,-(SP) MOV #CLBUF1,R1 ; Point to buffer, $REL .-2 CLBUF1 SLX ADD DOOFST,R1 ; Point to next available byte MOVB R0,@R1 ; Put character there INC DOOFST ; Inc buffer offset MOV (SP)+,R1 DONE: RETURN .SBTTL DOWRIT - Send one block to console log task ; Send a completed block to the console logger task DOWRIT: MOV R0,-(SP) ; Save R0 MOV R1,-(SP) ; and R1 MOV R2,-(SP) MOV R3,-(SP) MOV DOOFST,R1 ; Get buffer offset INC R1 ; Make word count ASR R1 MOV #CLBUF1,R2 ; point to buf 1 $REL .-2 CLBUF1 SLX MOV #CLBUF2,R3 ; and to buf 2, $REL .-2 CLBUF2 SLX 44$: MOV (R2)+,(R3)+ ; move one block's worth DEC R1 BGT 44$ MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 ; Restore R1 MOV (SP)+,R0 ; and R0 BIS #BUFRDY,CLSTAT ; Inform SLOG of full block. CLR DOOFST ; Reset buffer offset RETURN ENTTOU: BIS #DOTTOU,CLSTAT ; ENABLE .TTYOUT saving RETURN DITTOU: BIC #DOTTOU,CLSTAT ; DISABLE .TTYOUT saving RETURN .DSABL LSB .Restore ;***************************************************************************** .EndC; SL$CLO .SbTtl Queue -- Qmangr entry point processing .Enable LSB Queue: Call InitCk ; check initialization and debug Mov SLCQE,R4 ; load queue element pointer MovB Q$Func(R4),R0 ; get possible SpFunc code Bpl SLErr ; not an SpFun, then an error CmpB #Upd$Fn,R0 ; is it the update function? Bne SLErr ; then an error .Assume Q$BlkN EQ 0 Mov @R4,R0 ; get block number (function subcode) Bic #1,R0 ; ignoring all odds (evening them out) Cmp #SpFMax,R0 ; is it a legal subcode? Blo SLErr ; no out of range .If NE MMg$t Call MapX ; map to extended memory area Jmp @#QueueX ; Go to Queue routine dispatch ................ $Rel .-2 QueueX SLX .Save ;***************************************************************************** .PSect SLX QueueX: NOP ; Debug BPT can be placed here. .EndC; NE MMg$t Call SpFTab(R0) ; go to action routine $Rel .-2 SpFTab SLX .If NE MMg$t Jmp @#DrFinX ; return to low memory $Rel .-2 DrFinX SLR ............... .Restore ;***************************************************************************** DrFinX: .EndC; NE MMg$t Bcc SLDone ; normal completion SLErr: ; error return Mov SLCQE,R4 ; point to current element Bis #HdErr$,@-(R4) ; set error bit SLDone: ; normal return .If NE MMg$t Call UnMapX ; restore mapping .EndC; NE MMg$t .DrFin SL ; return to queue manager .......... .If NE MMg$t .Save ;***************************************************************************** .PSect SLX .EndC; NE MMg$t SpFTab: ; DISPATCH table KEEP in order! .Assume .-SpFTab EQ Copy$S .If NE SL$SPF Br SpCopy ; buffer copy routine .IfF; NE SL$SPF Br RetErr ; (COPY function not supported) .EndC; NE SL$SPF .Assume .-SpFTab EQ Conn$S Br SpConn ; connect to EMT17/assign impure .Assume .-SpFTab EQ Disc$S Br SpDisc ; disconnect from EMT17 .If NE SL$SPF .Assume .-SpFTab EQ Size$S Br SpSize ; do SLSize stuff .Assume .-SpFTab EQ SetI$S Br SpSetI ; establish impure address .Assume .-SpFTab EQ Init$S Br SpInit ; do SLInit stuff .Assume .-SpFTab EQ Prmp$S Br SpPrmp ; do prompt stuff .Assume .-SpFTab EQ Edit$S Br SpEdit ; do SLEdit stuff .IfF; NE SL$SPF ; If SPFUN support NOT included, .If NE Let$ ; but LET support is... .Assume .-SpFTab EQ Size$S Br RetErr ; (SIZE function not supported) .Assume .-SpFTab EQ SetI$S Br SpSetI ; establish impure address .Assume .-SpFTab EQ Init$S Br SpInit ; do SLInit stuff .Assume .-SpFTab EQ Prmp$S Br RetErr ; (PRMP function not supported) .Assume .-SpFTab EQ Edit$S Br RetErr ; (EDIT function not supported) .EndC; NE Let$ .EndC; NE SL$SPF .If NE Let$ .Assume .-SpFTab EQ CLet$S Br SpCLet ; Let copy routine .EndC; NE Let$ .If NE MMg$t .Restore ;***************************************************************************** .EndC; NE MMg$t .SbTtl InitCk -- check for first call, do BPT if debugging ;+ ; INITCK ; ; Do BPT if SET SL BPT=1 was issued ; Do relocation if first call. ;- .Enable LSB InitCk: .If NE SL$DBG ;***************************************; next instruction put over NOP by DBGQue: BPT ;3 SET SL BPT=1 .=:DBGQue;******************************;3 NOP ;3 ;*************************************** .EndC; NE SL$DBG .Assume .-SLStrt LE Blk ; ; next 2 NOPs put over Jsr R2,INIT ;***************************************; by Init code ...1st: Nop ;5 Nop ;5 .=:...1st;******************************;5 next instruction assembled in SLBase: ;5 base for SL relocation Jsr R2, Init ;5 for one time initialization ;*************************************** RtsPC: Return ; and return ...... SLINT: ; dummy interrupt routine address .Assume SLInt-2 EQ RtsPC .If NE MMg$t .Save ;***************************************************************************** .PSect SLX .EndC; NE MMg$t .SbTtl ***************************************** .SbTtl * SpFun request processing * .SbTtl ***************************************** .If NE SL$SPF ; If SPFUNS are supported... .SbTtl SpCopy -- copy data to/from internal impure area ;+ ; SPCOPY ; ; Perform the .SpFun Upd$Fn copy subfunction. ; Copies the IMPURE area to/from user BUFFER. ; ; Q$WCnt Positive means copy user buffer to impure ; Q$WCnt Negative means copy impure to user buffer ; Q$WCnt absolute value is ignored. ; ; Q$Buff is the user buffer address. ; ; Amount copied is determined by the size of the IMPURE ; area. ;- .Enable LSB SpCopy: Mov #Impure,R5 ; point to impure area $Rel .-2 Impure SLR .If EQ MMG$T Mov #ImpHi-ImpLow/2,R1 ; words to move .IfF; EQ MMG$T Mov #ImpHi-ImpLow,R1 ; bytes to move .EndC; EQ MMG$T Br ComCpy ; join common code .............. .Disable LSB .EndC; NE SL$SPF .If NE Let$!SL$SPF .SbTtl SpCLet -- Copy data to/from LET area ;+ ; SPCLET ; ; Perform the .SpFun Upd$Fn copy LET subfunction. ; Copies the LET area to/from user BUFFER. ; ; Q$WCnt Positive means copy user buffer to impure ; Q$WCnt Negative means copy impure to user buffer ; Q$WCnt absolute value is ignored. ; ; Q$Buff is the user buffer address. ; ; Amount copied is determined by the size of the LET ; area. ;- .Enable LSB SpCLet: Mov #LetImp,R5 ; point to Let area $Rel .-2 LetImp SLR .If EQ MMG$T Mov #LetHi-LetLo/2,R1 ; number of words to move .IfF; EQ MMG$T Mov #LetHi-LetLo,R1 ; number of bytes to move .IfT; EQ MMG$T ComCpy: Mov Q$Buff(R4),R2 ; point to user's buffer Tst Q$WCnt(R4) ; buffer to handler? Bpl 10$ ; yes Push R5 ; else from handler to buffer Mov R2,R5 ; exchange pointers Pop R2 ; ... 10$: 20$: Mov (R2)+,(R5)+ ; copy a word Sob R1,20$ ; count and continue until all moved .IfF; EQ MMG$T ComCpy: Tst Q$WCnt(R4) ; buffer to handler? Bpl 40$ ; yes ; ; no, handler to buffer 30$: PushB (R5)+ ; pass byte on stack Mov @#$PtByt,PutByt ; get address for routine $Rel .-4 $PtByt SLR Call @#.-. ; pass it thru MMG routine PutByt =: .-2 Sob R1,30$ ; move all bytes Br RetOk ; finished .............. 40$: 50$: Mov @#$GtByt,GetByt ; get address for routine $Rel .-4 $GtByt SLR Call @#.-. ; get a byte via MMG routine GetByt =: .-2 PopB (R5)+ ; put in handler Sob R1,50$ ; move all bytes .EndC; EQ MMG$T Br RetOk ...... .Disable LSB .EndC; NE Let$!SL$SPF .SbTtl SpDisc -- disconnect SL from EMT16 list hooks ;+ ; SPDISC ; ; Perform the .SpFun Upd$Fn disconnect from RMON ; The connection to the BATCH (EMT16) hooks is removed ; and the old values are restored. ;- .Enable LSB SpDisc: Clr R1 ; remove inpure area pointer for job Call SpPImp ; put 0 into this job's pointer Mov #.-.,R1 ; point to EMT16 list AEmt16 =: .-2 ; real address of EMT16 list .Assume EmtTtI EQ 0 Cmp @R1,#.-. ; are we hooked up now? Y.TtyI =: .-2 ; value should match if we are Bne RetErr ; no, then done (were not hooked up) .Assume EmtTtI EQ 0 Mov #.-.,@R1 ; restore TTYIN X.TtyI =: .-2 ; original entry value Mov #.-.,EmtXit(R1) ; restore EXIT X.Exit =: .-4 ; original entry value Mov #.-.,EmtPri(R1) ; restore PRINT X.Prin =: .-4 ; original entry value .If NE MMg$t Mov #.-.,SubPri(R1) ; restore PRINTR X.PriR =: .-4 ; original entry value .EndC; NE MMg$t .If NE SL$CLO MOV #.-.,EmtTtO(R1) ; restore .TTYOU X.TtyO =: .-4 ; original entry value .EndC; NE SL$CLO Br RetOk ............. .Disable LSB .If NE SL$SPF .SbTtl SPSize -- do impure area size calculation ;+ ; SPSIZE ; ; Perform the .SpFun Upd$Fn to return the size required ; for an inpure area given the size of a line. ; ; Q$WCnt is the length of a line to edit. ; Q$WCnt = 0 means use default width ; ; Q$Buff points to a word which is updated to indicate the ; number of bytes needed for the impure area. ;- .Enable LSB SpSize: Mov Q$WCnt(R4),R0 ; get line size Bne 10$ ; none supplied, use default MovB @#dWidth,R0 ; use SET SL WIDTH=n value $Rel .-2 dWidth SLR Bic #^c377,R0 ; clear any sign extension 10$: Call SLSize ; do calculation .If EQ MMg$t Mov R0,@Q$Buff(R4) ; return inpure area size .IfF; EQ MMg$t Push R0 ; return impure area size .Rem ~ ;>>> DO NOT USE Call @$PtWrd ; using XM routine $Rel .-2 $PtWrd SLR ~ ;>>> P1EXT this? Mov Q$Buff(R4),R0 ; get virt address of buffer ;>>> can the Mov above be dispensed with? MTPD @R0 ; return impure area size .EndC; EQ MMg$t Br RetOk ............. .Disable LSB .EndC; NE SL$SPF .SbTtl SpSetI -- establish impure area ;+ ; SPSETI ; ; Establish an impure area for a job #. The address of the ; impure area is placed in IMPTAB table and the impure area ; is initialized. ; ; Q$Buff is the address of the impure area. ; Q$Buff 0 and called from the BG job means use the internal ; impure area. ; ; Q$WCnt is the size of a line. ; Q$WCnt 0 means use the default width. ;- .Enable LSB SpSetI: .If NE MMg$t ;>>> HACK for now (use $MPPHY??) Clr R1 ; you MUST use internal buffer .IfF; NE MMg$t Mov Q$Buff(R4),R1 ; get buffer address Bic #1,R1 ; insure low bit is off (word addr) .EndC; NE MMg$t 10$: Call SpPImp ; put in table Tst R1 ; use default? Bne 20$ ; no, real address given .Assume BG.Job EQ 0 Tst R0 ; job 0 (BG)? Bne RetErr ; no, then an error Mov #Impure,R1 ; yes, use internal impure area $Rel .-2 Impure SLR Br 10$ ; and try again .......... 20$: .Br SpInit .Disable LSB .SbTtl SpInit -- initialize impure area ;+ ; SPINIT ; ; Initialize the impure area for a job. The address of the ; impure area is gotten from IMPTAB. ; ; Q$WCnt is the size of a line. ; Q$WCnt 0 means use the default width. ;- .Enable LSB SpInit: Call SpGImp ; get impure area address Beq RetErr ; none Mov Q$WCnt(R4),R1 ; get line size Bne 10$ ; value supplied MovB @#dWidth,R1 ; use default $Rel .-2 dWidth SLR Bic #^c377,R1 ; clear any sign extension 10$: Call SLInit ; initialize impure area RetOk: Tst (PC)+ ; ok RetErr: Sec ; error Return ; done ...... .Disable LSB .If NE SL$SPF .SbTtl SPPrmp -- initialize prompt info in impure area ;+ ; SPPRMP ; ; Set up a prompt string for a job. The address of the ; job's impure area is gotten from IMPTAB. ; ; ; Q$WCnt is the address of the prompt string. ; Q$WCnt 0 means use the default prompt (CRLF) ;- .Enable LSB SpPrmp: Call SpGImp ; get impure area address Beq RetErr ; none Mov Q$WCnt(R4),R1 ; get prompt address .If NE MMg$t CLR R1 ; debug for now .EndC; NE MMg$t Call SLPrmp ; initialize prompt info in impure area Br RetOk ............. .Disable LSB .SbTtl SPEdit -- get an edited line ;+ ; SPEDIT ; ; Collect an input line, editting it. The address of the impure ; area is gotten from IMPTAB ; ; The word pointed to by Q$WCnt is updated to indicate the ; address of the line buffer. ;- .Enable LSB SpEdit: Call SpGImp ; get impure area address Beq RetErr ; none Call SLEdit ; initialize impure area .If EQ MMg$t Mov R0,@Q$WCnt(R4) ; return buffer address .IfF; EQ MMg$t .Rem ~ Mov Q$WCnt(R4),Q$Buff(R4) ; get return location!!! ;>>> DO NOT USE Call @$PtWrd ; return it using XM routines $Rel .-2 $PtWrd SLR ~ ;>>> P1EXT this? Push R0 ; and value to return Mov Q$WCnt(R4),R0 ; get virtual address MTPD @R0 ; return buffer address .EndC; EQ MMg$t Br RetOk ............. .Disable LSB .EndC; NE SL$SPF .SbTtl SpConn -- connect SL to EMT16 list hooks ;+ ; SPCONN ; ; Connect SL to RMON using the BATCH hooks (EMT16). SL ; intercepts TTYINs, PRINTs, and EXITs. ;- .Enable LSB SpConn: Call SpSetI ; set up the impure area Bcs RetErr ; failed Mov AEmt16,R1 ; point to RMON EMT16 table **GVAL** Mov #I.TtyI,R0 ; get address of our intercept routine $Rel .-2 I.TtyI SLR Sub R1,R0 ; calculate offset from EMT16 to subr .Assume EmtTtI EQ 0 Cmp R0,@R1 ; are they the same? Beq RetOk ; yes, then we are hooked up, done .Assume EmtTtI EQ 0 Mov @#$SYPTR,R2 ; point to RMON Sub R1,R2 ; min valid neg offset within RMON Tst @R1 ; EmtTtI negative? **GVAL** .Assume EmtTtI EQ 0 Bpl 11$ ; no Cmp R2,@R1 ; hooked? .Assume EmtTtI EQ 0 Bhi RetErr 11$: Mov EmtXit(R1),R3 ; Get EmtXit **GVAL** Bpl 12$ ; EmtXit negative? Cmp R2,R3 ; hooked? Bhi RetErr ; yes 12$: Mov EmtPri(R1),R3 ; Get EmtPri **GVAL** Bpl 13$ ; EmtPri negative? Cmp R2,R3 ; hooked? Bhi RetErr ; yes 13$: .If NE MMg$t Mov SubPri(R1),R3 ; Get SubPri **GVAL** Bpl 14$ ; SubPri negative? Cmp R2,R3 ; hooked? Bhi RetErr ; yes 14$: .EndC; NE MMg$t ; .TTYIN hookup... .Assume EmtTtI EQ 0 Mov @R1,R2 ; get entry in table **GVAL** Mov R2,X.TtyI ; save it for disconnect Add R1,R2 ; relocate it Mov #O.TtyI,R3 ; point to $Rel .-2 O.TtyI SLR Sub R3,R2 ; relocate it Mov R2,@R3 ; and save it .Assume EmtTtI EQ 0 Mov R0,@R1 ; put intercept routine offset in table **PVAL** Mov R0,Y.TtyI ; value we stored in EMT16 ; used to check in disconnect ; .EXIT hookup... Mov EmtXit(R1),R2 ; get EXIT offset **GVAL** Mov R2,X.Exit ; save it for disconnect Add R1,R2 ; relocate it Mov #O.Exit,R3 ; point to return code $Rel .-2 O.Exit SLR Sub R3,R2 ; relocate it Mov R2,@R3 ; and save it Mov #I.Exit,R3 ; point to intercept routine $Rel .-2 I.Exit SLR Sub R1,R3 ; relocate it Mov R3,EmtXit(R1) ; put intcpt routine offset in table **PVAL** ; .PRINT hookup... Mov EmtPri(R1),R2 ; get PRINT offset **GVAL** Mov R2,X.Prin ; save it for disconnect Add R1,R2 ; relocate it Mov #O.Prin,R3 ; point to return code $Rel .-2 O.Prin SLR Sub R3,R2 ; relocate it Mov R2,@R3 ; and save it Mov #I.Prin,R3 ; point to intercept routine $Rel .-2 I.Prin SLR Sub R1,R3 ; relocate it Mov R3,EmtPri(R1) ; put intcpt routine offset in table **PVAL** .If NE MMg$t ; PRINTR hookup... Mov SubPri(R1),R2 ; get PRINTR offset **GVAL** Mov R2,X.PriR ; save it for disconnect Add R1,R2 ; relocate it Mov #O.PriR,R3 ; point to return code $Rel .-2 O.PriR SLR Sub R3,R2 ; relocate it Mov R2,@R3 ; and save it Mov #I.PriR,R3 ; point to intercept routine $Rel .-2 I.PriR SLR Sub R1,R3 ; relocate it Mov R3,SubPri(R1) ; put intcpt routine offset in table **PVAL** .EndC; NE MMg$t .If NE SL$CLO ; .TTYOU hookup... Mov EmtTtO(R1),R2 ; get PRINT offset **GVAL** Mov R2,X.TtyO ; save it for disconnect Add R1,R2 ; relocate it Mov #O.TtyO,R3 ; point to return code $Rel .-2 O.TtyO SLR Sub R3,R2 ; relocate it Mov R2,@R3 ; and save it Mov #I.TtyO,R3 ; point to intercept routine $Rel .-2 I.TtyO SLR Sub R1,R3 ; relocate it Mov R3,EmtTtO(R1) ; put intcpt routine offset in table **PVAL** .EndC; NE SL$CLO Br RetOk ............. .Disable LSB .SbTtl SpPImp -- put a value in ImpTab(JOB) ;+ ; SpPImp ; ; Set R1 value into ImpTab(Job). ; uses Job number in queue element ; ; destroys R0 ;- .Enable LSB SpPImp: Call SpGetJ ; get the job number Bcs RetErr ; illegal Mov R1,ImpTab(R0) ; put it in $Rel .-2 ImpTab SLR Br RetOk ............. .Disable LSB .SbTtl SpGImp -- get a pointer from ImpTab(JOB) ;+ ; SpGImp ; ; Load R0 with impure area address for this job ; If none, return carry set. ; ; expects R4 to point to current queue element ;- .Enable LSB SpGImp: Call SpGetJ ; get the job number Bcs RetErr ; illegal Mov ImpTab(R0),R0 ; get the address $Rel .-2 ImpTab SLR Beq RetErr ; none, error Br RetOk ............. .Disable LSB .SbTtl SpGetJ - Get job number out of queue element ;+ ; SPGETJ ; ; Get job number out of Queue Element and convert it ; to a word index. ; ; Job number*2 is returned in R0. Carry is set if the ; Job number is an index value outside IMPTAB's range ;- .Enable LSB SpGetJ: MovB Q$JNum(R4),R0 ; get job number byte .If EQ Job$-1 Bic #^c170,R0 ; clear all but job number CmpB #1,R0 ; set carry if not 0 .IfF; EQ Job$-1 Asr R0 ; slide down 2 bits (JJJxxx) Asr R0 ; to produce (JJJx) for word index Bic #^c,R0 ; and clean up junk bits CmpB #Job$-1*2,R0 ; in range? ;NOTE Carry is set if number out of range .EndC; EQ Job$-1 Return ...... .If NE MMg$t .Restore ;***************************************************************************** .EndC; NE MMg$t .SbTtl ***************************************** .SbTtl * EMT "Hooks" processing * .SbTtl ***************************************** .SbTtl I.Exit/I.TtyIn stubs I.Exit: .If NE SL$DBG ;***************************************; next instruction put over NOP by DBGXit: BPT ;3 SET LD BPT=5 .=:DBGXit;******************************;3 NOP ;3 ;*************************************** .EndC; NE SL$DBG .Assume .-SLStrt LE Blk Br J.Exit ; go to real code .............. I.TtyI: .If NE SL$DBG ;***************************************; next instruction put over NOP by DBGTty: BPT ;3 SET LD BPT=3 .=:DBGTty;******************************;3 NOP ;3 ;*************************************** .EndC; NE SL$DBG .Assume .-SLStrt LE Blk Br J.TtyI ; go to real code .............. .SbTtl *.Prin -- .PRINT interface ;+ ; I.PRIN ; O.PRIN ; R.PRIN ; ; communicate with RMON .PRINT code ; ;- .Enable LSB I.Prin: .If NE SL$DBG ;***************************************; next instruction put over NOP by DBGPri: BPT ;3 SET LD BPT=4 .=:DBGPri;******************************;3 NOP ;3 ;*************************************** .EndC; NE SL$DBG .Assume .-SLStrt LE Blk .If NE MMg$t .if NE SL$CLO CALL SAVLIN ; Save prompt .endc; NE SL$CLO MFPI @Old.PC(SP) ;get instruction following EMT Cmp (SP)+,(PC)+ ;2 is this a "prompt" being printed? .IfF; NE MMg$t Cmp @Old.PC(SP),(PC)+ ;2 is this a "prompt" being printed? .EndC; NE MMg$t Mov R5,R5 ;2 if so it is followed by this Opcode Bne R.Prin ; no, just pass it thru ; Call SLAct ; test for SL active Bit #SLEdi$!SLKmo$,@#$CNFG1 ;2 is SL enabled? **GVAL** $Rel .-2 $CNFG1 RMON ;2 Boff R.Prin ; no, pass thru Jsr R5,SaveR ; save registers Call GetImp ; test for active and get impure addr Beq 10$ ; this job has no impure area .If NE MMg$t Call MovPro ; copy prompt into internal buffer .IfF; NE MMg$t Mov R0,Prompt(R5) ; save prompt address .EndC; NE MMg$t Mov #TtGetL,State(R5) ; set .TTYIN to edit a ".GtLin" $Rel .-4 TtGetL SL 10$: .IrpC x,<012345> ; restore registers Pop R'x .EndR R.Prin: ; return doing .Print Add @PC,PC ; JMP to .Print code in RMON **PIC** O.Prin: .BlkW 1 ; offset to code ......... .Disable LSB .If NE MMg$t .SbTtl *.PriR -- PRINTR interface ;+ ; I.PRIR ; O.PRIR ; R.PRIR ; ; communicate with RMONXM PRINTR code ; ;- .Enable LSB I.PriR: .If NE SL$DBG ;***************************************; next instruction put over NOP by DBGPrR: BPT ;3 SET LD BPT=6 .=:DBGPrR;******************************;3 NOP ;3 ;*************************************** .EndC; NE SL$DBG .if NE SL$CLO CALL SAVLIN ; Save line in console log buffer .endc; NE SL$CLO .Assume .-SLStrt LE Blk Call SLAct ; is SL active Boff R.PriR ; no, pass thru Jsr R5,SaveR ; save registers Call GetImp ; test for active and get impure addr Beq 10$ ; this job has no impure area Call MovPro ; copy prompt into internal buffer Mov #TtGetL,State(R5) ; set .TTYIN to edit a ".GtLin" $Rel .-4 TtGetL SL 10$: .IrpC x,<012345> ; restore registers Pop R'x .EndR R.PriR: ; return doing PrintR Add @PC,PC ; JMP to PrintR code in RMON **PIC** O.PriR: .BlkW 1 ; offset to code ......... .Disable LSB .if NE SL$CLO .SbTtl *.TtyO -- TTYOUT interface ;+ ; I.TtyO ; O.TtyO ; R.TtyO ; ; communicate with RMONXM TTYOUT code ; ;- .Enable LSB I.TtyO: CALL SAVCHR ; Save char in console log buffer .Assume .-SLStrt LE Blk R.TtyO: ; return doing TTYOUT Add @PC,PC ; JMP to TTYOUT code in RMON **PIC** O.TtyO: .BlkW 1 ; offset to code ......... .Disable LSB .endc; NE SL$CLO .SbTtl MovPro -- copy prompt string to buffer .Enable LSB ; Move prompt from job's space. ; R0 contains job's prompt address MovPro: Mov ProBuf(R5),R1 ; load address of prompt buffer Mov R1,Prompt(R5) ; point to it for later Mov R1,R2 ; copy it Add #ProSiz,R2 ; point to end of buffer 10$: Clr R4 ; clear flag register Mov R0,R3 ; copy input address Inc R0 ; point to next input char Asr R3 ; shift out low bit to carry Adc R4 ; save carry state in R4 Asl R3 ; shift back with low bit off Jsr R0,@#.-. ; call externalization routine P1Ext1 =: .-2 ; added in by Init .Word 20$-. ; length of request MFPD @R3 ; get a word from caller Pop R3 ; and return it in R3 20$: .Word P1Addr/KTGran ; Par1 value Tst R4 ; was it an odd address Beq 30$ ; no SwaB R3 ; yes, swap the bytes 30$: MovB R3,(R1)+ ; copy into buffer Beq 40$ ; done CmpB #,R3 ; other terminator? Beq 40$ ; done Cmp R1,R2 ; still room? Blo 10$ ; yes ClrB -(R1) ; force an end 40$: Return ; done ...... .if NE SL$CLO SAVCHR: MOV R0,-(SP) ; save character in console log CALL MAPX ; map to high memory CALL @#DOOUTC ; store character $REL .-2 DOOUTC SLX BR 50$ ...... SAVLIN: MOV R0,-(SP) ; save line in console log buffer CALL MAPX CALL @#DOLINE $REL .-2 DOLINE SLX 50$: CALL UNMAPX MOV (SP)+,R0 RETURN ...... .endc; NE SL$CLO .Disable LSB .EndC; NE MMg$t .SbTtl *.Exit-- .Exit interface ;+ ; I.Exit ; R.Exit ; O.Exit ; ; ASSUMPTION: R4 is available to be used at will ;- .Enable LSB J.Exit: Push R5 ; save register Call GetImp ; get address of impure area Cmp R5,#Impure ; is it the internal one? $Rel .-2 Impure SL Beq 10$ ; yes, done Call GetJob ; get job number Clr ImpTab(R5) ; clear the impure addr for this job $Rel .-2 ImpTab SL 10$: Pop R5 ; restore register R.Exit: ; go to real .EXIT code Add @PC,PC ; in a PIC manner **PIC** O.Exit: .BlkW 1 ; address .............. .Disable LSB .SbTtl BatXit/DotXit - EXIT routines ;+ ; BatXit ; ; Routine to do a ".Exit" from Batch hooked code ; ; This routine expects SaveR to have been used, and ; the value of SP after SaveR to be in XitSP(Impure) ;- .Enable LSB BatXit: Mov XitSP(R5),SP ; reset stack .IrpC x,<012345> ; restore registers Pop R'x .EndR Mov SP,R0 ; soft exit Br R.Exit ; and go to .EXIT code in RMON .............. ;+ ; DotXit ; ; A simple, everyday .EXIT ;- DotXit: Mov SP,R0 ; soft exit .Exit ; easy ...... .Disable LSB .SbTtl *.TtyI -- .TTYIN interface ;+ ; I.TtyI ; R.TtyI ; O.TtyI ; ; ASSUMPTION: R4 is available to be used at will ;- .Enable LSB J.TtyI: Cmp @Old.PC(SP),(PC)+ ;2 is this a request from SL? Mov SP,SP ;2 if so it is followed by this Opcode ; under XM the Mov SP,SP must be ; clear of PAR1 (It's in SLX.SYS) Beq R.TtyI ; yes, just pass it thru Jsr R5,SaveR ; save registers Call GetImp ; check for active and buffer Beq 30$ ; this job has no impure area Mov SP,XitSP(R5) ; save SP value for possible .EXIT Call SLAct ; is SL active? Boff 30$ ; no, pass thru Bit #,@#$JSW ; any of these bits set? ..SLCN == .-4 ; SL condition mask Bon 30$ ; yes, pass thru to RMON Mov State(R5),R1 ; get TTYIN state word Bon 10$ ; not idle, process request TstB dTTYIN ; doing .TTYIN Line mode editing? Boff 30$ ; no Br TtIdle ; else begin "idle" code .............. 10$: Jmp @R1 ; go to selected processing ........... TtGetL: Mov Prompt(R5),R1 ; point to possible prompt string .If NE MMg$t MFPI @Old.PC+Old.R5+2(SP) ;get instruction following EMT Cmp (SP)+,(PC)+ ;2 is this a ".GtLin" TTYIN? .IfF; NE MMg$t Cmp @Old.PC+Old.R5+2(SP),(PC)+ ;2 is this a ".GtLin" TTYIN? .EndC; NE MMg$t Mov R5,R5 ;2 data for compare Beq TtEdit ; yes, go edit the input Cmp @Old.PC+Old.R5+2(SP),(PC)+ ;2 is this the ".GtLin" TTINR in RMON? Mov R4,R4 ;2 data for compare ; under XM the Mov R4,R4 must be ; clear of PAR1 (It's in RMON) Bne TtIdle ; no, just start a ttyin sequence TtLEdi: Call SLPnE ;set up prompt and edit a line Mov #TtRetB,State(R5) ; set to point to buffer $Rel .-4 TtRetB SL MovB #'~,R0 ; send a wierd char for DEBUGGING Br RetChr ; return a random char to TTINR/MOV R4R4 .............. TtIdle: Mov #PrmMsg,R1 ; point to default (empty) prompt $Rel .-2 PrmMsg SLX TtEdit: Call SLPnE ; set up prompt and edit TtRetB: Mov Buf$er(R5),Temp(R5) ; point to beginning of buffer Mov #TtRetn,State(R5) ; and set next state to return chars $Rel .-4 TtRetn SL TtRetn: MovB @Temp(R5),R0 ; get next char Beq 20$ ; end of line? Inc Temp(R5) ; point to next char Br RetChr ; and return a char .............. 20$: Mov #,R0 ; return a CR char Add #TtLF-TtRetn,State(R5) ; next state is return LF char Br RetChr ; and return a char .............. TtLF: Mov #,R0 ; return a LF char Clr State(R5) ; and next state is idle RetChr: .Assume Old.R0 EQ 0 Pop <> ; ignore old R0 value .IrpC x,<12345> ; restore registers Pop R'x .EndR Mov R0,@SP ; return R0 value in user's R0 R.RT11: ; return to common EMT exit code Jmp @#.-. ; RT-11 EMT common exit **PIC** EmtX =: .-2 ; to be filled in by init ............. 30$: Cmp @Old.PC+Old.R5+2(SP),(PC)+ ;2 is this the ".GtLin" TTINR in RMON? Mov R4,R4 ;2 data for compare ; under XM the Mov R4,R4 must be ; clear of PAR1 (It's in RMON) Bne 40$ ; no, then just exit Add #4,Old.PC+Old.R5+2(SP) ; skip the MOV R4,R4 and BR 22$ ; and go to the JSR R4,$SYSWT Mov @SP,R0 ; get R0 value to return (as is) Br RetChr ; and return to the $SYSWT .............. 40$: .IrpC x,<012345> ; restore registers Pop R'x .EndR R.TtyI: Add @PC,PC ; JMP to .TtyIn code in RMON **PIC** O.TtyI: .BlkW 1 ; offset to code ......... .Disable LSB .SbTtl SLAct -- test for SL active .Enable LSB SLAct: Bit #SLEdi$!SLKmo$,@#$CNFG1 ;2 is SL active? **GVAL** $Rel .-2 $CNFG1 RMON ;2 Boff 10$ ; no Bit #SLEdi$,@#$CNFG1 ;2 is it always active? **GVAL** $Rel .-2 $CNFG1 RMON ;2 Bon 10$ ; yes TKMON: Tst @#.-. ;3 is KMON running **PEEK** $Rel .-2 KMonIn RMON ;3 AKMonIn =: .-2 ;3 address of KMonIn word 10$: Return ; Z == off, NZ == on (active) ...... .Disable LSB .SbTtl GetImp -- Get address of impure area for this job ;+ ; GETIMP ; ; Get impure address from IMPTAB using Job number in RMON ; ; return address in R5, if 0, then no impure area for this job ;- .Enable LSB GetImp: Call GetJob ; return job number in R5 Bcc 10$ ; supporting this job Clr R5 ; no impure area Return ...... 10$: Mov ImpTab(R5),R5 ; point to impure area $Rel .-2 ImpTab SL Return ; and done ...... ; NOTE: Z set if no IMPURE address .SbTtl GetJob - return job number using value in RMON ;+ ; GETJOB ; ; Use the JobNum offset in RMON to return the current job ; number *2. Under SB/XB/ZB, always return 0. JobNum offset is ; used for something else in SB/XB/ZB. ; ; Return job number in R5. ;- GetJob: ;*************************************** Code if running under SB/XB/ZB Clr R5 ; use job number 0 for SB/XB/ZB Nop ; pad it out JobGet=:. ;*************************************** .=:GetJob ;*************************************** Code if running under FB/XM/ZM Mov @#$JOBNU,R5 ; get current job number **GVAL** ;*************************************** modified by Init code .Assume . EQ JobGet $Rel .-2 $JOBNU RMON ;>>>mod for multi job system CmpB #1,R5 ; set carry if not zero Return ...... .Disable LSB .SbTtl SLPnE -- set up prompt and edit a line ;+ ; SLPNE ; ; Set up a prompt and then get an editted line. ;- .Enable LSB SLPnE: Mov R5,R0 ; point to impure area Mov #BatXit,Exit(R5) ; indicate exit is from BATCH hooks $Rel .-4 BatXit SL .If NE MMg$t Call MapX ; map to hidden code .EndC; NE MMg$t Call @#SLPrmp ; set up a prompt $Rel .-2 SLPrmp SLX Mov R5,R0 ; point to impure area again .If NE MMg$t Call @#SLEdit ; call editing code $Rel .-2 SLEdit SLX .Br UnMapX ; restore mapping UnMapX: Cmp @#KISAR1,P1Old ; does it need to be restored? Beq 10$ ; no Mov #.-.,@#KISAR1 ; restore it P1Old =: .-4 ; vaule that was in PAR1 10$: Return ...... .IfF; NE MMg$t CallR SLEdit ; edit a line .............. .EndC; NE MMg$t .Disable LSB .If NE MMg$t MapX: Cmp @#KISAR1,P1New ; does it need to be set? Beq 10$ ; yes Mov @#KISAR1,P1Old ; else save it Mov #.-.,@#KISAR1 ; and set it now P1New =: .-4 ; value to use for PAR1 10$: Return ...... .Save ;***************************************************************************** .PSect SLX .EndC; NE MMg$t .SbTtl ***************************************** .SbTtl * "Call" processing * .SbTtl ***************************************** .Sbttl Size -- calculate impure area size ;+ ; SIZE ; ; calculate the impure area size given the buffer size. ; ; Mov #Buffer_Size,R0 ; in bytes ; "Call" Size [see actual calling proc elsewhere] ; Mov R0,#Impure_Size ; in bytes ; ; ; other registers preserved ;- .Enable LSB SLSize: ; (note: R0 should end up with a value that represents 1 line buffer ; if SL$HBF is TRUE, or 5 line buffers if it is FALSE.) .if EQ SL$HBF Mov R0,-(sp) Asl R0 ; multiply by 2 Asl R0 ; and again for multiply by 4 Add (sp)+,R0 ; and add original for mult by 5 .EndC; EQ SL$HBF Add #OverHd+ProSiz+1,R0 ; add in overheads ; and rounding increment Bic #1,R0 ; force even Return ...... .Disable LSB .SbTtl Init -- initialize impure area ;+ ; INIT ; ; Given the impure area address and the buffer size, initialize ; the impure area for use later. ; ; Mov #Impure_Area,R0 ; address of area at least the ; ; size returned by 'Size' call ; ; for the specified Buffer_Size ; Mov #Buffer_Size,R1 ; size of buffer in bytes ; Mov #Prompt,R2 ; if no prompt Clr R2 ; ; if specified must end with '200' ; ; for No CRLF .Print action ; "Call" Init ; ; all registers preserved ; ; Impure_Area is initialized, ;- .Enable LSB SLInit: Jsr R5,@#SaveR ; save R5-R0 on stack $Rel .-2 SaveR SLR Mov R0,R5 ; copy pointer to impure area Mov R1,R0 ; copy size Call SLSize ; do sizing again Mov R5,R4 ; copy pointer to impure area ; clear it 10$: ClrB (R4)+ Sob R0,10$ Mov R5,R4 ; copy pointer again Mov R5,R3 ; copy impure area pointer .Assume InTTy EQ 2 Tst (R3)+ ; point to TtyIn word in Impure Mov #GetChr,(R3)+ ; set up address of input char routine $Rel .-2 GetChr SLX .Assume OutTty EQ InTty+2 Mov #PutChr,(R3)+ ; set up address of output char routine $Rel .-2 PutChr SLX .Assume Print EQ OutTty+2 Mov #PutStr,(R3)+ ; set up address of output string routine $Rel .-2 PutStr SLX .Assume Exit EQ Print+2 Mov #DotXit,(R3)+ ; set up address of EXIT routine $Rel .-2 DotXit SLR Tst R1 ; was a width specified? Bne 20$ ; yes MovB @#dWidth,R1 ; else load default $Rel .-2 dWidth SLR Bic #^c377,R1 ; clear any sign extension 20$: .Assume Width EQ Exit+2 Mov R1,(R3)+ ; save width .Assume CurMax EQ Width+2 Mov R1,(R3)+ ; save CurMax for later use .Assume BufFre EQ CurMax+2 Mov R1,(R3)+ ; save BufFre for later use Inc R1 ; allow for null Add #OverHd,R4 ; point to BUFFER .Assume Buf$er EQ BufFre+2 Mov R4,(R3)+ ; load Buf$er Add R1,R4 ; point to OLDBUF .If EQ SL$HBF ; OLD, SAVE, DELETE buffers are in IMPURE area ... .Assume OldBuf EQ Buf$er+2 Mov R4,(R3)+ ; store pointer to OldBuf .If EQ SL$MLO Add R1,R4 ; point to OldrBf .Assume OldrBf EQ OldBuf+2 Mov R4,(R3)+ ; store pointer to OldrBf Add R1,R4 ; point to DelBuf buffer .IfF; EQ SL$MLO Mov R4,CurOld(r5) ; Initialize Current Old Line Mov R4,(R3)+ ; store pointer to OldrBf (dummy) Add #OldBSz,R4 ; point to DelBuf buffer .EndC; EQ SL$MLO .Assume DelBuf EQ OldrBf+2 Mov R4,(R3)+ ; store pointer to DelBuf Add R1,R4 ; point to SavBuf buffer .Assume SavBuf EQ DelBuf+2 Mov R4,(R3)+ ; store pointer to SavBuf Add R1,R4 ; point to ProBuf buffer .IfF; EQ SL$HBF ; OLD, DELETE, SAVE buffers are in High Memory (not in impure area)... .If NE SL$MLO Mov #OLDBF1,(R3) ; do pointers $Rel .-2 OLDBF1 SLX Mov (R3)+,CurOld(r5) ; Initialize Current Old Line .IfF; NE SL$MLO Mov #OLDBF1,(R3)+ ; do pointers $Rel .-2 OLDBF1 SLX .EndC; NE SL$MLO Mov #OLDBF2,(R3)+ $Rel .-2 OLDBF2 SLX Mov #DELBF1,(R3)+ $Rel .-2 DELBF1 SLX Mov #SAVBF1,(R3)+ $Rel .-2 SAVBF1 SLX .EndC; EQ SL$HBF .If NE MMg$t .Assume ProBuf EQ SavBuf+2 Mov R4,(R3)+ ; store pointer to ProBuf .IfF; NE MMg$t .Assume ProBuf EQ SavBuf+2 Clr (R3)+ ; indicate no ProBuf .EndC; NE MMg$t Mov #.SCCA,R4 ; code for .SCCA request .Assume ISCCA EQ ProBuf+2 Mov R4,(R3)+ ; setup for internal SCCA Mov R5,R2 ; get impure address again Add #CCFlag,R2 ; get real address of internal ^C flag .Assume ISCCAA EQ ISCCA+2 Mov R2,(R3)+ ; and finish init for internal SCCA .Assume OSCCA EQ ISCCAA+2 Mov R4,(R3)+ ; load first word of OSCCA MovB #2,OldSet(R5) ; Initialize Cycle at 2nd line .If NE VTxxx$ MovB @#dVT100,VT100(R5) ; load default VT100 flag value $Rel .-4 dVT100 SLR .EndC ;NE VTxxx$ ;;; ClrB ProLen(R5) ; assume no prompt Br Resto2 ; and done .............. .Disable LSB .SbTtl SLPrmp -- handle prompt string initialization .Enable LSB SLPrmp: Jsr R5,@#SaveR ; save registers $Rel .-2 SaveR SLR Mov R0,R5 ; point to impure area Mov R1,R0 ; point to prompt for length routine Mov R1,Prompt(R5) ; save address of prompt in IMPURE Beq 10$ ; null prompt Call Len ; how long is it? add r0,r1 ; point to prompt string terminator cmpb (r1),#200 ; look at prompt terminator... beq 10$ ; if <200>, do normal thing. clr r0 ; otherwise, prompt NL-terminated. ; - pretend it's zero length. 10$: MovB R0,ProLen(R5) ; save length Mov Width(R5),R2 ; get screen width Sub R0,R2 ; calc CurMax Mov R2,CurMax(R5) ; save it Mov R2,BufFre(R5) ; and as BufFre too Resto2: Jmp RestoR ; restore registers .............. .Disable LSB .SbTtl Edit -- get input and edit buffer contents ;+ ; EDIT ; ; Given the impure area address, process input until buffer ; is edited and then pass it to user via R0 on return ; ; Mov #Impure_Area,R0 ; "Call" Edit ; Mov R0,#Buffer_Address ; ; Other registers are preserved ; Impure area is modified ; ; If SCCA is active and ^C is input, SCCA flag is set and ; ^C will be found in buffer ; If SCCA not active, a .EXIT will be done if ^C is input. ;- .Enable LSB SLEdit: Jsr R5,@#SaveR ; save R5-R0 on stack $Rel .-2 SaveR SLR .If NE SL$CLO CALL DITTOU ; turn off TTYOUT saving while SL'ing .EndC; NE SL$SLO Mov R0,R5 ; copy impure area pointer Mov Buf$er(R5),R3 ; copy buffer address to register Add CurOfs(R5),R3 ; make bufptr (R3) and CurOfs track Mov @#$JSW,OJSW(R5) ; save old JSW Bic #^c,OJSW(R5) ; zap all but changed bit Bis #,@#$JSW ; and set it in the real JSW Add #ISCCA,R0 ; build address for request Call FxSCCA ; Do our own SCCA Mov R0,OSCCAA(R5) ; save user's SCCA address (if any) .if NE FunKey MovB #'h,R0 Call ProFKy ; Enable PRO Function keys .EndC; NE FunKey .If NE SL$KED Call KPOn ; turn keypad on (if KED mode) MOVB #1,KPDir ; return to backwards motion .EndC; NE SL$KED .If EQ SL$MLO ClrB FirstM(R5) ; Reset Non-multi-line line counter .EndC; EQ SL$MLO MovB #377,IRMode ; Reset Insert/Replace Mode ..IRDF == .-4 Call DoErLn ; erase rest of line 10$: Call Parse ; get input and parse it Br 10$ ; loop until forced out .......... ; Do local SCCA - This routine serves SL on both ENTRY and EXIT ; On entry, R0 should contain the address of the terminal status word. ; Instructions between BatRn1 and BatRn2 and those between BatRn3 and ; BatRn4 are NOP'ed out by INIT in SJ environments. FxSCCA: ; Fix SCCA BatRn1: ; Start of FB-only instructions ; replaced by NOPs if SJ .Assume I.State EQ 0 Mov @#$CNTXT,R1 ;2 point to I.State **GVAL** $Rel .-2 $CNTXT RMONX ;2 Mov #BatRn$,R2 ; load BatchRunning bit .Assume BatRn$&377 NE 0 MovB @R1,IState(R5) ; save low byte of I.State word .Assume I.State EQ 0 .Assume BatRn$&377 NE 0 BisB R2,@R1 ; skip address check BatRn2: ; end of FB only instructions .SCCA CODE=NOSET ; set up our SCCA BatRn3: ; another set of FB only instructions Mov R0,-(SP) ; save user's SCCA address (if any) ; replaced by NOPs if SJ Mov IState(R5),R0 ; +++ Com R0 ; +++ Com R2 ; build clearing mask .Assume BatRn$&377 NE 0 BicB R2,R0 ; +++ clear all but BatRn$ bit BicB R0,@R1 ; +++ restore the old BatRn$ Mov (SP)+,R0 ; Restore SCCA address (if any) BatRn4: Return .Disable LSB Old.R0 =: 0 ; stack offset for saved registers Old.R1 =: 2 Old.R2 =: 4 Old.R3 =: 6 Old.R4 =: 8. Old.R5 =: 10. .If NE MMg$t .Restore ;***************************************************************************** .IfTF; NE MMg$t SaveR: .IrpC x,<43210> ; save registers Push R'x .EndR Jmp @R5 ........... .Disable LSB .IFT; NE MMg$t .Save ;***************************************************************************** .Psect SLX .EndC; NE MMg$t .SbTtl HELP -- process PF2 by displaying error message or help text ;+ ; HELP ; ; Process HELP (PF2) by display last error message or help info. ; if there was no 'previous' error message. ;- .Enable LSB Help: .If EQ HelpB$ Call V.CrEl ; clear the current line .IfTF; EQ HelpB$ MovB Error(R5),R0 ; load error code if any .If NE VT100$!VT102$&VT52$!HelpB$ Bne 20$ ; print error message .EndC; NE VT100$!VT102$&VT52$!HelpB$ .IfT; EQ HelpB$ .If NE VT100$!VT102$&VT52$ .Assume HlpCod EQ 0 .Assume VT.52 LT 0 TstB VT100(R5) ; what kind of terminal is this? Bge 20$ ; is a VT52 Mov #H52Cod,R0 ; it is a VT52 .EndC; NE VT100$!VT102$&VT52$ .IfF; EQ HelpB$ .If NE VT52$ Mov #H52Msg,R1 ; load VT52 help message address $Rel .-2 H52Msg SLX .EndC; VT52$ .If NE VT100$!VT102$&VT52$ .Assume VT.52 LT 0 TstB VT100(R5) ; what kind of terminal is this? Blt 10$ ; is a VT52 .EndC; NE VT100$!VT102$&VT52$ .If NE VT100$!VT102$ Mov #HlpMsg,R1 ; load VT100(2) help message address $Rel .-2 HlpMsg SLX .EndC; NE VT100$!VT102$ .If NE VT100$!VT102$&VT52$ 10$: .EndC; NE VT100$!VT102$&VT52$ Call PToken ; print from token list JMP Refrsh ; reposition cursor (was Br - RHH) .............. .IfTF; EQ HelpB$ .If NE VT100$!VT102$&VT52$!HelpB$ 20$: .EndC; NE VT100$!VT102$&VT52$!HelpB$ .IfF; EQ HelpB$ Push ; save code Call V.CrEl ; clear line Pop .IfTF; EQ HelpB$ Mov Messag(R0),R0 ; print the message (0 == HELP) $Rel .-2 Messag SLX Add #Messag,R0 ; relocate it **PIC** $Rel .-2 Messag SLX Call V.Print ; print the message Call @InTty(R5) ; get a char PushB R0 ; and save it Call Refrsh ; do a refresh of the display PopB R0 ; get saved char ClrB Error(R5) ; dump error code Br Parse1 ; non-standard entry .............. .EndC; EQ HelpB$ .Disable LSB .SbTtl CANCEL -- process ^C ;+ ; CANCEL ; ; Process ^C input by setting user's SCCA word if any ; or by doing a .Exit if no SCCA for user. ; ;- .Enable LSB InsCtW: PushB # ; Pass CTRL/W to program Br 8$ Cancel: ; NOTE: does this make sense??? is a ^C at input = ^C^C w/o input ??? Mov #CtCMsg,R0 ; display ^C $Rel .-2 CtCMsg SLX PushB # ; and return it CtrlCZ: .If NE SL$CLO CALL ENTTOU ; make "^C/^Z" visible in log .EndC; NE SL$CLO Call V.Print ; on screen Call SavOld ; save current line as prev 8$: MovB @SP,(R3)+ ; put char in buffer ClrB @R3 ; and end with a NUL ; NOTE: check buffer boundary CmpB (SP)+,# ; are we doing cancel? Bne UsrXit ; no Mov OSCCAA(R5),R1 ; get user's SCCA value Beq 10$ ; none, just exit .If NE MMg$t Jsr R0,@#.-. ; call externalization routine P1Ext2 =: .-2 ; added in by Init .Word 11$-. ; length of request MFPD @R1 ; get scca word on stack Bis #100000,@SP ; set the bit flag ;NOTE make symbolic MTPD @R1 ; restore modified word 11$: .Word P1Addr/KTGran ; Par1 value .IfF; NE MMg$t Bis #100000,@R1 ; set the bit flag ;NOTE make symbolic .EndC; NE MMg$t Br UsrXit ; and return to user .............. 10$: Call WrapUp ; Silly? What about $REENTER? .If NE MMg$t Jmp @#ExitR ; go to exit code in normal code $Rel .-2 ExitR SLR ............... .Restore ;***************************************************************************** ExitR: Call UnMapX ; restore mapping .EndC; NE MMg$t Jmp @Exit(R5) ; and exit properly ................. .Disable LSB .If NE MMg$t .Save ;***************************************************************************** .Psect SLX .EndC; NE MMg$t .Sbttl USRXIT -- return buffer to user ;+ ; USRXIT ;- .Enable LSB ;NOTE: is this the way to do it for .SPFUN calls? ; or for the BATCH hooks??? UsrXit: Call WrapUp ; leave impure in a reasonable state Pop <> ; dump return address Mov Buf$er(R5),@SP ; return buffer address as R0 RestoR: .IrpC x,<012345> ; restore registers Pop R'x .EndR Return ...... .SbTtl WRAPUP -- clean up IMPURE before exiting .Enable LSB WrapUp: .If NE SL$CLO CALL DITTOU ; Turn off logging TTYOUTs .EndC; NE SL$CLO .if NE FunKey MovB #'l,R0 Call ProFKy ; Disable PRO Function keys .EndC; NE FunKey .If NE SL$KED Call KPOff ; Turn keypad OFF .EndC; NE SL$KED Call V.NL ; go to new line .If NE SL$CLO CALL ENTTOU ; Turn ON logging TTYOUTs .EndC; NE SL$CLO Mov CurMax(R5),BufFre(R5) ; update free count ClrB Error(R5) ; clear out any old error code Clr (R5) ; reset cursor offset Bic #,@#$JSW ; clear out changed bits in JSW Bis OJSW(R5),@#$JSW ; and put it back as it was. ; NOTE: is a simple MOV OJSW(R5),@#$JSW safe??? Mov R5,R0 ; point to area Add #OSCCA,R0 ; for the request ; .SCCA CODE=NOSET ; restore his SCCA trapping CallR FxSCCA ; restore his SCCA trapping ; Return ...... .Disable LSB .SbTtl .SbTtl ***************************************** .SbTtl * Editor Proper * .SbTtl ***************************************** .SbTtl .SbTtl ***************************************** .SbTtl * Parse input character stream * .SbTtl ***************************************** .SbTtl Parse -- Main parsing routine ;+ ; PARSE ; PARSE1 ; ; Parse input character stream. ; ; PARSE gets a character and parses it. ; PARSE1 expects a character in R0 ; ;- .Enable LSB Parse: .If NE SL$RCL Mov SP,SaveSP .EndC; NE SL$RCL Call @InTty(R5) ; get a character Parse1: ; entry if char is in R0 now CmpB R0,# ; is it the Delete character? Bne 10$ ; no, continue Clr R0 ; make DEL into NUL (hack ... 10$: ; NULs are never seen) .Assume ValueG*2 EQ 200 AslB FlagG(R5) ; get rid of "stale" GOLD BEQ 20$ ; skip if not now in GOLD sequence MOV R0,R1 ; MAKE COPY OF CHARACTER BIC #40,R1 ; MAKE IT UPPER CASE CMPB R1,#'S ; GOLD ? BNE 14$ JMP StrSAV 14$: CMPB R1,#'X ; GOLD ? BNE 20$ JMP GETSAV 20$: Jsr R1,Range ; check for a control char **PIC** .Byte , .Word CtlTab $Rel .-2 CtlTab SLX Data1: Jmp Data ; if not, then a data char ............ UsrXi1: Br UsrXit .SbTtl ESC - sequence flag Escap1: Call @InTty(R5) ; get a character .If NE VT100$!VT102$&VT52$ .Assume VT.52 LT 0 TstB VT100(R5) ; is this a VT52 terminal? Blt Esc52 ; yes, then do ESC parsing for it .EndC ;NE VT100$!VT102$&VT52$ .If NE VT100$!VT102$ CmpB R0,# ; possible arrow key? Beq Arrow ; yes CmpB R0,# ; possible PFx (or application arrow) Bne EscErr ; illegal escape sequence .SbTtl ESC SS3 - PF or application arrow keys Call @InTty(R5) ; get a character Jsr R1,Range ; check for a PFx char **PIC** .Byte 'M, .Word PFxTab $Rel .-2 PFxTab SLX .If NE SL$KED ; KED type editing? Jsr R1,Range ; check for other keypad character .Byte 'l,'u ; between COMMA key and '5' key .Word PFKED1 ; of keypad. $Rel .-2 PFKED1 SLX .EndC; NE SL$KED Br Arrow1 .............. .EndC ;NE VT100$!VT102$ .If NE VT52$ .SbTtl ESC 52 - VT52 ESC parsing Esc52: Jsr R1,Range ; check for PFx keys **PIC** .Byte , .Word P52Tab $Rel .-2 P52Tab SLX .EndC ;NE VT52$ .If NE VT100$!VT102$&VT52$ Br Arrow1 ; check for arrows with VT100 code .............. .EndC ;NE VT100$!VT102$&VT52$ .If NE VT100$!VT102$ Arrow: .If NE FunKey .SbTtl ESC CSI - LK201 Function Keys and Arrow Keys Clr R1 Funky0: .IfF; NE Funkey .SbTtl ESC CSI - Arrow keys .EndC; NE Funkey Call @InTty(R5) ; get a character .If NE FunKey Funky1: CmpB R0,#'~ ; tilda? Bne Funky2 Mov R1,R0 ; end of key sequence. Jsr R1,Range .If NE LET$ .Byte 17.,34. ; F6 through F20 .IfF; NE LET$ .Byte 23.,28. ; ESC through HELP .EndC; NE LET$ .Word FunTab $Rel .-2 FunTab SLX Br EscErr ; none of the above Funky2: CmpB R0,#'0 ; in range of 0 - 9? Blo Funky9 ; branch out if not CmpB R0,#'9 Bhi Funky9 Mov R1,-(SP) ; previous accumulator Asl R1 ; *2 Asl R1 ; *4 Add (SP)+,R1 ; *5 Asl R1 ; *10. Bic #177760,R0 ; get value of new digit, Add R0,R1 ; add in the value, Br Funky0 ; try another digit Funky9: Tst R1 ; any digits found? Bne EscErr ; if so, error. .Endc; NE FunKey Arrow1: .EndC ;NE VT100$!VT102$ Jsr R1,Range ; check for a Arrow terminal char **PIC** .Byte , .Word AroTab $Rel .-2 AroTab SLX CtlBas: ; base for CtlTab offsets EscErr: Call DoBEL .Word EscCod ; illegal escape sequence ...... .If NE FunKey&Let$ ; Function Key Vectoring - go to processing code .If NE Funk$S FunKyS: Jmp FunKS1 ; GOLD function key entry ...... .IfF; NE Funk$S FunKyS: .EndC; NE Funk$S FunKyL: Jmp FunKD1 ; go do Function Key LET insert ...... .EndC; NE FunKey&Let$ Escape: Br Escap1 ...... .Disable LSB .SbTtl ***************************************** .SbTtl * Command processing routines * .SbTtl ***************************************** .SbTtl EOF-- process ^Z ;+ ; EOF ; ; Process ^Z input as a terminator. Place ^Z (032) ; in the user buffer followed by null ; ;- .Enable LSB EOF: Mov #CtZMsg,R0 ; display ^Z $Rel .-2 CtZMsg SLX PushB # ; and return it ;; Br CtrlCZ ; join common code Jmp CtrlCZ ; join common code .............. .Disable LSB ; Cancel (see above for actual code) Canjmp: Jmp Cancel ; vector out of this limited space .SbTtl CRTRNC -- process GOLD CR by truncating and returning buffer ;+ ; CRTRUNC ; ; Process GOLD RETURN by truncating current line at cursor ; and returning buffer to user. ;- CRTrnc: ; GOLD RETURN (truncate) Call @InTty(R5) ; eat the associated LF .Br Trunc .SbTtl TRUNC -- process GOLD LF by truncating and returning buffer ;+ ; TRUNC ; ; Process GOLD LF by truncating current line at cursor ; and returning buffer to user. ;- Trunc: ; GOLD LF (truncate) Call DoErLn ; truncate it Br Enter ; process as an enter ............. .SbTtl LFeed -- process LINEFEED ;+ ; LFeed ; ; Process LineFeed character, depending on whether Keypad ; editing is in effect. ;- LFeed: .If NE SL$KED Jmp LFeed1 ; Go Process it. .IfF; NE SL$KED Br Enter .EndC; NE SL$KED .SbTtl CRENTR -- process CR by returning buffer ;+ ; CRENTR ; ; Process RETURN by returning current buffer to user. ;- .Enable LSB CREntr: Call @InTty(R5) ; eat the associated LF .Br Enter .Disable LSB .SbTtl ENTER -- process ENTER key by returning buffer ;+ ; ENTER ; ; Process ENTER key by returning current buffer to user. ;- .Enable LSB Enter: .If NE SL$RCL Mov SP,SaveSP ; (in case we want to JMP back in) .EndC; NE SL$RCL Call SavOld ; save current line as previous Br UsrXi1 ; and return buffer to user .............. .Disable LSB ; Help (go do real HELP code above) Hlpjmp: Jmp Help ; get out of this limited space area .SbTtl UNDCL -- process GOLD DEL by restoring previously deleted char ;+ ; UNDCL ; ; Process GOLD DEL to restore previously deleted data. ;- .Enable LSB UnDCL: MovB DelChr(R5),R0 ; get previously deleted char Bic #^c377,R0 ; force high byte 0 (8bit sign ext) Bne Data1 ; just do standard "data" insert ............. DelErr: ; if NUL then none to restore Call DoBEL ; and ding .Word DelCod ; indicate no deleted char ............. .Disable LSB .SbTtl REFRSH -- process [GOLD] ^R ^W by redisplaying prompt and buffer ;+ ; REFRSH ; ; Refresh a damaged display by erasing it, then displaying ; the prompt and buffer contents anew. ;- .Enable LSB Refrsk: .If NE SL$KED Call KPOn ; turn keypad on (if KED mode) .EndC; NE SL$KED Refrsh: CallXR V.Prompt,V.Buffer,V.EL,CurSet ..................................... .Disable LSB .SbTtl ILLCHR -- process invalid control characters ;+ ; ILLCHR ; ; Process unlikely control chars as errors ;- .Enable LSB CtlErr: Call DoBel ; just an error .Word CtlCod .............. .Disable LSB .SbTtl IRTogl -- Toggle Insert/Replace mode ;+ ; CTRL/A - Toggle Insert/Replace mode ;- .Enable LSB IRTogl: ComB IRMode Return .Disable LSB .SbTtl DELLL -- process ^U by deleting line BOL to cursor ;+ ; DELLL ; ; Process ^U by deleting (and saving) chars preceding the ; cursor. ;- .Enable LSB DelLL: .Assume CurOfs EQ 0 Tst (R5) ; at beginning of line? Beq BOLEr0 ; yes, nothing to delete PushB @R3 ; save current char ClrB @R3 ; indicate temp end of string Mov Buf$er(R5),R0 ; point to beginning of buffer Call Len ; find out how long it is PopB @R3 ; restore char Push R0 ; save length Call DoBOL ; go to beginning of the buffer Pop R0 ; restore length Mov #TypeLL,R2 ; indicate ^U type delete CallR DoDCh ; and delete from screen ............. .Disable LSB .SbTtl GOLD -- process PF1 by setting gold "shift" for next function ;+ ; GOLD ; ; Process PF1 by setting GOLD flag. ;- .Enable LSB Gold: MovB #ValueG,FlagG(R5) ; indicate GOLD shifted Ret4: Return ...... .Disable LSB .SbTtl DELLR -- process PF4 by deleting line cursor to EOL ;+ ; DELLR ; ; Process PF4 by deleting chars from cursor to end of ; line and saving them in the delete line buffer. ;- .Enable LSB DelLR: TstB @R3 ; at EOL? Beq EOLEr1 ; yes, then nothing to del Mov R3,R0 ; point to string to delete Call Len ; how long? Mov #TypeLR,R2 ; indicate PF4 loaded OldLin CallR DoDCh ; delete the chars .............. .Disable LSB .SbTtl SWAP -- Process BS by swapping characters ;+ ; SWAP ; ; Process BS by exchanging char under cursor with next char ; and move cursor forward a char. ;- .Enable LSB Swap: Mov R3,R0 ; copy buffer pointer MovB (R0)+,R1 ; get char under cursor Beq EOLEr1 ; it was EOL, error MovB @R0,R2 ; get char after cursor Beq EOLEr1 ; it was EOL, error MovB R2,@R3 ; exchange them MovB R1,@R0 ; ... CallXR DoFS,DoFS,DoBS ; print chars exchanged and position ...................... ; cursor .Disable LSB .SbTtl UNSWAP -- process GOLD BS by unswapping chars ;+ ; UNSWAP ; ; Process GOLD BS by exchanging char under cursor with previous ; char and positioning cursor on previous char position. ;- .Enable LSB UnSwap: TstB @R3 ; at EOL? Beq EOLEr1 ; yes, can't unswap .Assume CurOfs EQ 0 Tst (R5) ; at beginning of line? BOLEr0: Beq BOLEr1 ; yes, can't unswap CallXR DoBS,Swap,DoBS ...................... .Disable LSB .SbTtl UNDELL -- process GOLD ^U / PF4 by undeleting line ;+ ; UNDELL ; ; Process GOLD ^U and GOLD PF4 by inserting deleted line buffer. ;- .Enable LSB UnDeLL: Mov DelBuf(R5),R0 ; point to deleted string buffer TstB @R0 ; anything to undelete? Beq DelErr ; no .Assume CurOfs EQ 0 Push (R5) ; save cursor position Call Insert ; insert it Pop R0,Save=Carry ;*C* get old cursor pos/align stack Bcc 10$ Jmp InsErr ; no room 10$: TstB DelTyp(R5) ; was it PF4 or ^U? Bmi Ret4 ; ^U .Assume CurOfs EQ 0 UndFin: Mov R0,(R5) ; new cursor position Mov Buf$er(R5),R3 ; and fix buffer pointer too .Assume CurOfs EQ 0 Add (R5),R3 ; to point correctly CallR CurSet ; fix cursor on display .............. .Disable LSB .SbTtl STRSAV -- save current line in "save" buffer ;+ ; STRSAV ; ; The current line contents is saved in the "save" buffer ;- .Enable LSB StrSAV: Mov SavBuf(R5),R0 ; point to save buffer CallR SavXXX ; save the current line .............. .SbTtl DOWN -- get "save" buffer contents ;+ ; DOWN ; ; Process DOWN ARROW by getting saved line (even if empty) ; Current line is destroyed ... ; ; If MULTI-OLD-LINE (SL$MLO) is enabled, and the UP function ; has been used, then the DOWN function climbs back down the ; old-line FILO buffer. ;- Down: .If NE SL$MLO TstB FirstM(r5) ; already rolled over top? Bmi 15$ ; then don't care if cur=old. 10$: Cmp CurOld(r5),Oldbuf(r5) Blos 20$ ; none left? 15$: call DownM ; do multi-old command search Br UpDown ; finish up by displaying line. 20$: ClrB OldNum(r5) APBLCL: Call ClrLin ; Make apparent blank line Br 28$ .IfF; NE SL$MLO ; If NOT supporting Multi-Old-Lines... MovB FirstM(R5),R0 ; Find out which line is now displayed Beq NoLine ; No where to go down. Dec R0 Bne 10$ ; Branch if it was 2 or greater ClrB FirstM(R5) ; We were at OLD line. Now want Br NoLine ; blank line 10$: Dec R0 Bne 20$ ; Branch if it was 3 or greater Mov OldBuf(R5),R1 ; We were at OLDER line. Now want Br 30$ ; OLD line. 20$: Mov OldRbf(R5),R1 30$: DecB FirstM(R5) ; Indicate roll down Br UpDown .EndC; NE SL$MLO ; Get SAVE buffer GetSAV: Mov SavBuf(R5),R1 ; point to save buffer .If NE SL$MLO Call B.BOL ; set buffer pointer and cursor to BOL Mov R3,R0 ; point to dest for MovS Call MovS ; move from SAVBuf to current Buffer 28$: ClrB FirstM(r5) ; be ready for UP function .EndC; NE SL$MLO Br UpDown ; join common code .............. .Disable LSB .SbTtl UP -- process up arrow by getting previous line ;+ ; UP ; ; Process UP ARROW by getting previous line (if any) ; Current line is destroyed... ;- .Enable LSB Up: .If EQ SL$MLO MovB FirstM(R5),R0 ; Where are we now? Beq 10$ ; Branch if OLD is next. Dec R0 ; Were we at OLD line already? Bne 8$ ; If already at OLDER, do blank line OldR: Mov OldrBf(R5),R1 ; Otherwise, do OLDER now. Br 30$ 8$: MovB #3,FirstM(R5) ; Indicate just over the top. NoLine: Mov #BlnkLn,R1 ; Out of bounds? Do blank line. $Rel .-2 BlnkLn SLX Br 40$ 10$: Mov OldBuf(R5),R1 ; point to previous line 30$: IncB FirstM(R5) ; Indicate advancement 40$: .IfF; EQ SL$MLO call UpM ; Perform Multi-Old restore .EndC; EQ SL$MLO UpDown: ; common code Call B.BOL ; set buffer pointer and cursor to BOL .If EQ SL$MLO Mov R3,R0 ; point to dest for MovS Call MovS ; move from OLDBuf to current Buffer .EndC; EQ SL$MLO Mov CurMax(R5),BufFre(R5) ; calculate free space Sub R2,BufFre(R5) ; ... Call Refrsh ; display it CallR EOL1 ; go to end of line (ignore error) .............. .Disable LSB .SbTtl GET CYCLE - ;+ ; is GET CYCLE ;- Top: .If EQ SL$MLO MovB OldSet(R5),FirstM(R5) ; Get current setting, IncB FirstM(R5) ; Push value one greater Br Down ; Then pretend DOWN was pressed. .IfF; EQ SL$MLO MovB OldSet(r5),R1 ; Get desired old line number Call LineN ; Get Line #N Br UpDown ; Join common code .EndC; EQ SL$MLO .SbTtl SET CYCLE - SetOld: .If NE SL$MLO MovB OldNum(r5),OldSet(r5) ; Store current old line no. as .IfF; NE SL$MLO MovB FirstM(R5),OldSet(R5) ; Store current old line no. as .EndC; NE SL$MLO return ; desired N. .SbTtl LOOK -- unsupported ;+ ; LOOK ; ; PF3 is unsupported ;- Look: .Br CmdErr .SbTtl MODEL -- unsupported ;+ ; MODEL ; ; GOLD PF3 is unsupported ;- Model: .Br CmdErr CmdErr: Call DoBEL ; and ding .Word CmdCod ; "Unsupported command" ............. .SbTtl EOL -- process GOLD right arrow by moving to end of line ;+ ; EOL ; ; Process GOLD RIGHT ARROW by moving to the end of the line. ; ; EOL1 used to move to EOL with error if at EOL now ;- EOL: TstB @R3 ; At EOL? Bne EOL1 ; go do it (below). EOLEr2: Jmp EOLErr ; yes, then an error .SbTtl RIGHT -- process right arrow by moving 1 character right ;+ ; RIGHT ; ; Process RIGHT ARROW by moving forward a single char, if possible. ;- Right: TstB @R3 ; are we at EOL? EOLEr1: Beq EOLEr2 ; yes, at EOL now CallR DoFS ; else do a "forward space" ............ .SbTtl LEFT -- process left arrow by moving left 1 character ;+ ; LEFT ; ; Process LEFT ARROW by moving 1 char left, if possible. ;- Left: ; move left 1 char .Assume CurOfs EQ 0 Tst (R5) ; possible to go to the left? BOLEr1: Beq BOLEr2 ; no, then error condition CallR DoBS ; back a position on the screen ............ .SbTtl BOL -- process GOLD LEFT ARROW by moving to beginning of line ;+ ; BOL ; ; Process GOLD LEFT ARROW by moving to the beginning of the line ;- .Enable LSB BOL: ; move to beginning of line .Assume CurOfs EQ 0 Tst (R5) ; possible to move left? Beq BOLEr2 ; no, then an error .Br DoBOL ; do it .Disable LSB .SbTtl DoBOL -- perform BOL in buffer and on screen DoBOL: Call B.BOL ; set Buffer pointer and cursor offset CallR CurSet .............. .SbTtl TAB -- handle HT char ;+ ; TAB ; ; Process TAB char by substituting SPACE for it (KMON will anyway) ;- Tab: MovB #,R0 ; treat as space (KMON does) .If EQ SL$KED Br Data ; and join common code .IfF; EQ SL$KED Jmp Data ; and join common code .SbTtl KeyPad Edit Keys .SbTtl DELWR - Delete Word Right (vector out) ; ; Delete Word to Right of cursor (vector out of here) ; DelWR: Br DelWR1 .SbTtl UNDELW - UnDelete Word (vector out) ; ; UnDelete Word (vector out of here) ; UnDELW: Br UnDW1 .SbTtl DigKy - Process Keypad Digit Key (vector out) ; ; Process Keypad Digit Key (vector out of here) ; DigKy: Br DigKy1 .EndC; NE SL$KED .SbTtl DELCL -- process DEL by deleting previous char ;+ ; DELCL ; ; Delete character to the left of the cursor, if any ;- .Enable LSB DelCL: .Assume CurOfs EQ 0 Tst (R5) ; at the BOL? Bne 10$ ; Branch if not BOLEr2: Jmp BOLErr ; yes, can't del nothing 10$: Call DoBS ; put cursor (curse?) on victim Delc: Mov #1,R0 ; indicate 1 to delete .Assume TypeCL EQ 0 Clr R2 ; indicate char type delete CallR DoDCh ; and delete it ............. .Disable LSB .SbTtl DELCO -- process DELCHAR by deleting current char ;+ ; DELCO ; ; Delete character at the cursor, if any ;- .Enable LSB DelCO: .Assume CurOfs EQ 0 Mov Buf$er(R5),R0 Add (R5),R0 TstB (R0) Beq EOLEr2 ; at the EOS? MovB (R0),DelChr(R5) ; Save the character Br Delc ; go do it. UnDelc: TstB DelChr(R5) Beq DelEr2 ; no character to Undelete Mov #TheChr,R0 $Rel .-2 TheChr SLX ; Treat as inserting a string. MovB DelChr(R5),(R0) call Insert ; Insert the character, CallR DoBS ; and backspace to it. DelEr2: Jmp DelErr TheChr: .Byte 0 ; Place for Deleted Character .Byte 0 ; ALWAYS NULL .Even .Disable LSB .SbTtl EOL1 -- Move cursor to End-of-Line ; ; Move cursor to End-Of-Line ; .Enable LSB EOL1: 10$: .Assume CurOfs EQ 0 Inc (R5) ; bump cursor offset TstB (R3)+ ; at end of buffer? Bne 10$ ; no, keep moving Dec R3 ; adjust BufPtr value .Assume CurOfs EQ 0 Dec (R5) ; adjust CurOfs value too CallR CurSet ; go position cursor .............. .disable LSB .If NE SL$KED .SbTtl LFeed1 -- Process Line Feed (KED support enabled) LFeed1: .Br DelWL1 ; Delete Word Left .SbTtl DelWL1 - Delete Word LEFT ;+ ; Delete the word to the LEFT of the cursor. ;- .Enable LSB DelWL1: call MvWLft ; Move Word Left, mov r3,r0 ; Point again to word neg r2 ; Make count positive (again) bgt DelWn ; If so, delete with code below return .Disable LSB .SbTtl DelWR1 - Delete Word RIGHT ;+ ; Delete the word to the RIGHT of the cursor. ;- .Enable LSB DelWR1: TstB @R3 ; at EOL? Beq EOLEr3 ; yes, then nothing to delete. mov r3,r0 ; Point to cursor char call FindWD ; Find Word Delimiter DelWn: call DelNCh ; Delete N characters Add r2,BufFre(r5) ; account for space reclaimed mov r2,r1 ; Put count in R1 for Do1num... ClrB Temp(r5) ; Indicate DEL-type deletion, Jmp DoDFin ; Display the remainder of line .Disable LSB .SbTtl DigKy1 - Process Keypad Digit Key ;+ ; KED mode is in effect, and a digit has been pressed on the keypad. ; Translate the key value to a particular KED-type function. ; ; R0 should be holding the third character of the escape sequence. ; The zero key is represented by lowercase p. ;- .Enable LSB DigKy1: sub #'p,r0 ; Reduce key value to 0-offset Beq 2$ ; '0'? BLINE Dec r0 Beq 10$ ; '1'? MOVE WORD Dec r0 Beq 20$ ; '2'? EOL Dec r0 Beq 30$ ; '3'? MOVE CHAR Dec r0 Beq 40$ ; '4'? ADVANCE Dec r0 Beq 50$ ; '5'? BACKUP ; Keypad '0' key - go to BOL of next (previous) line 2$: clrB side ; Indicate want LEFT side of command tstB KPDir ; BOL. Going forwards or backwards? bne 6$ ; Branch if backwards 5$: call Down ; Go DOWN one line. br 8$ 6$: tst (r5) ; already at BOL? bne 9$ ; If not do just that. 7$: call Up ; Go UP one line. 8$: tstB side ; Want LEFT or RIGHT of line? bne 27$ ; Go to END of line. 9$: Jmp DoBOL ; Go to BEGINNING of line. ; Keypad '1' key - MOVE WORD 10$: tstB KPDir ; going forwards or backwards? beq MvWRgt br MvWLft ; Keypad '2' key - EOL 20$: IncB side ; Indicate RIGHT side, TstB @R3 ; at EOL? bne 27$ ; No, then go there tstB KPDir ; Keypad going forwards or backwards? Beq 5$ ; If so, do DOWN code br 7$ ; Branch to UP if backwards 27$: Jmp EOL1 ; Go to end of line. ; Keypad '3' key - MOVE CHARACTER 30$: tstB KPDir ; going forwards or backwards? beq RightV Jmp Left RightV: Jmp Right ; Keypad '4' key - GO FORWARD (ADVANCE) 40$: clrB KPDir ; forward mode return ; Keypad '5' key - GO BACKWARD (BACKUP) 50$: IncB KPDir ; backward mode return .Disable LSB .SbTtl UnDW1 - UnDelete Word ;+ ; Undelete Word ;- .Enable LSB UnDW1: Mov #WRDBUF,r0 $Rel .-2 WRDBUF SLX TstB r0 Bne 8$ Jmp DelErr 8$: Push (r5) ; save cursor position Call Insert Pop r0,Save=Carry ; recover cursor position Bcs InsErr ; report insert error if necessary 10$: Jmp UndFin ; Finish up like UnDeLL .Disable LSB .SbTtl MvWRgt, MvWLft - KED functions MOVE WORD RIGHT or LEFT ;+ ; KED mode MOVE WORD function (keypad '1') ;- .Enable LSB ; Move the cursor RIGHT to the next word. MvWRgt: tstb (r3) ; at EOL already? EOLEr3: beq EOLErr mov r3,r0 ; Put cursor location in R0 call FindWD ; Find next word location 8$: add r2,(r5) ; update cursor position add r2,r3 10$: callR CurSet ; Move the cursor LEFT to the next word. MvWLft: tst (r5) ; at BOL already? beq BOLErr mov r3,r0 ; Put cursor location in R0 call FindWR ; Find word in reverse neg r2 ; make count negative br 8$ .Disable LSB .EndC; NE SL$KED .SbTtl DATA -- insert data ;+ ; DATA ; ; Put data char into buffer if there is room. ;- .Enable LSB Data: Mov R0,Temp(R5) ; build a 1 char len string .If NE Let$ TstB @#dLet ; doing Let substitution? $Rel .-2 dLet SLR Boff 50$ ; no, skip it ; Is the entered character in the LET symbol table? Mov #LetSym,R1 ; point to symbol names $Rel .-2 LetSym SLR Mov #LetVal,R4 ; point to symbol value base $Rel .-2 LetVal SLR Mov #LetNo$,R2 ; and load count too 10$: CmpB (R1)+,R0 ; is this the symbol? Beq 20$ ; yes Add #LetSz$+1,R4 ; point to next value Sob R2,10$ ; try all of them Br 50$ ; not found ........... ; It's a LET symbol. Is it preceded by the LET QUOTE symbol? 20$: .Assume CurOfs EQ 0 Tst @R5 ; at the beginning at line? Beq 30$ ; then there is no "quote" CmpB -1(R3),# ; is the prev char "quote" Bne 30$ ; no Push R0 ; save "quoted" char Call DelCL ; and delete the "quote" Pop Temp(R5) ; now insert "quoted" char ; (DelCL crushes Temp) Br 50$ ; and just insert it ........... 30$: Mov R4,R0 ; transfer the value pointer to R0 Br 60$ ; and insert it ........... 50$: .EndC; NE Let$ ; Insert the typed character. It's located in TEMP(R5). Point ; to that location and drop through to insert. Mov R5,R0 ; point to it Add #Temp,R0 ; ... ; R0 points to a string to insert .If NE Let$ LetIns: ; Come here from FunKyL 60$: .EndC; NE Let$ TstB IRMode ; INSERT or REPLACE mode? Bmi 70$ ; Branch if INSERT 65$: TstB @R3 ; Sitting at end now? Beq 70$ ; If so, treat as insert. Mov R0,R1 ; Let R1 point to character TSTB @R0 ; End of string? BEQ 75$ ; return if so. Call LUCase ; so that LUCase can see it. MovB (R0)+,@R3 ; REPLACE... get the character, MOV R0,-(SP) MOVB (R3)+,R0 Call V.R0 ; Print the character MOV (SP)+,R0 Inc @R5 ; Bump cursor position Br 65$ ; any more? 70$: Call Insert ; insert the data char(s) 75$: Bcc Ret1 ; done InsErr: Call DoBEL ; and do it .Word InsCod ; do error ............. .Disable LSB .SbTtl ***************************************** .SbTtl * Command service routines * .SbTtl ***************************************** .SbTtl Error routines .SbTtl OldErr -- no old line to get ;OldErr: ; Call DoBel ; .Word OldCod ; .............. .SbTtl EolErr -- at EOL, can't to operation to the right EolErr: Call DoBel .Word EolCod .............. .SbTtl BOLERR -- at BOL, can't do operation to the left BolErr: Call DoBel .Word BolCod .............. .SbTtl GetChr - get next input char ;+ ; GETCHR ; ; Get next char from terminal, if a NULL try again. ; ; Call GetChr ;or ; Call @InTty(R5) ; vectored thru impure area ; ; On Return: ; R0 = char (high byte cleared) ; Carry cleared ; ; Other registers preserved ;- .Enable LSB GetChr: 10$: .TtInR ; Get a char Mov SP,SP ; indicate request from SL Bcs 10$ ; no char available ;NOTE: the .TtTnR is used because .TtyIn has a Bcs following the EMT ; which breaks the Mov R5,R5 test Bic #^c177,R0 ; ignore 8th bit (for now) Beq 10$ ; EAT NULs (unlikely, but ...) Ret1: Return ...... .Disable LSB .SbTtl Range - match a char within a range / dispatch if found ;+ ; RANGE ; ; try to find a char within a range of character values, ; dispatch to it if found, else return with carry set. ; ; Jsr R1,Range ; .Byte Low,High ; .Word Table ; Bcs NotFnd ; Low is lowest char in match range ; High is highest char in match range ; Table is address of dispatch table ; in the form .Byte Norm,Gold ; Norm and Gold are positive word offsets ; from CTLBAS to the action routine. Gold ; is used if previous command was a GOLD, ; else Norm is used. ; ; On return: ; ; R0 used ; R1 restored ; R2 used ; R3-R5 unchanged ; if no match, control passes to Bcs NotFnd ; location following the call with carry set. ; ; if match, control passes to action routine ; found in the dispatch table (see above) with ; carry cleared. When the action routine ; returns, it returns to the caller of PARSE. ; ;- .Enable LSB Range: MovB (R1)+,R2 ; get lowest value CmpB R0,R2 ; to "normalize" it and range check Blo 20$ ; too small CmpB (R1)+,R0 ; in range? Blo 30$ ; too large Neg R2 ; doing a "reverse" SUB Add R0,R2 ; R2 is now current char - lowest Asl R2 ; make into 2 byte index TstB FlagG(R5) ; is "Gold" shift on? Boff 10$ ; no Inc R2 ; else point to "Gold" action 10$: Add @R1,R2 ; add in table address MovB @R2,R1 ; get offset value Bic #^c377,R1 ; disallow sign extension Asl R1 ; change from word to byte offset Add #CtlBas,R1 ; and base value $Rel .-2 CtlBas SLX Clc ; clear Carry (not error exit) Br 40$ ; dispatch and restore R1 ........... 20$: MovB (R1)+,R2 ;*C* skip highest value byte 30$: Mov (R1)+,R2 ;*C* skip table address word 40$: Rts R1 .......... .Disable LSB .SbTtl SAVOLD -- save current buffer in old buffer ;+ ; SAVOLD ; ; Save the current buffer contents in the OLDBUF prior to ; returning to the user. ; ; Call SavOld ; ; R0 used ; R1 used ; R2 contains length of saved string (from MovS) ; R3-R5 unchanged ; BUFFER contents copied to OLDBUF ; unless BUFFER is "empty". If BUFFER ; is empty, then just return without ; changing OLDBUF. ;- .Enable LSB SavOld: .IF EQ SL$MLO TstB @Buf$er(R5) ; anything to save? Boff 20$ ; no Mov OldRBf(R5),R0 ; point to previous previous line Mov OldBuf(R5),R1 ; point to previous line Call SavYYY ; savit (if non-empty) Mov OldBuf(R5),R0 ; point to previous line .IfF; EQ SL$MLO .If NE SL$CLO ; BIS #DOTTOU,CLSTAT ; re-enable saving TTYOUTs MOV Buf$er(R5),R0 ; point to buffer CALL DOLINE ; save it in console log buffer .EndC; NE SL$CLO callr SaveM ; Save line in multi-line FILO .EndC; EQ SL$MLO SavXXX: Mov Buf$er(R5),R1 ; point to current buffer SavYYY: TstB @R1 ; anything to save? Boff 20$ ; no, then don't .Br MovS ; move the string .SbTtl MOVS -- do a string copy ;+ ; MOVS ; ; Move the ASCIZ string pointed to by R1 to the area ; pointed to by R0, Return the number of characters moved in R2 ; R0,and R1 are pointed to just following strings. ; ; Mov #Source_String,R1 ; Mov #Dest_String,R0 ; Call MovS ; Mov R2,Length ; ; R3-R5 unchanged ;- MovS: ; move a string Clr R2 ; clear length counter 10$: ; move old line into current Inc R2 ; count moved chars MovB (R1)+,(R0)+ ; move a char Bne 10$ ; no, keep moving it Dec R2 ; adjust counter 20$: Return ...... .Disable LSB .SbTtl CURSET -- put cursor in proper location ;+ ; CURSET ; ; position the cursor on the screen according to the length of ; the prompt and the CurOfs value. ;- .Enable LSB CurSet: Push R1 ; save work register Call V.CR ; go to beginning of line MovB ProLen(R5),R1 ; get length of prompt .Assume CurOfs EQ 0 Add (R5),R1 ; calculate the cursor position Beq 30$ ; at beginning, skip Esc [ 0 case Call DoCSI ; do 7 bit ESC CSI (ESC only for VT52) .If NE VTxxx$&VT52$ .Assume VT.52 LT 0 TstB VT100(R5) ; VT52? Blt 10$ ; yes .EndC ;NE VTxxx$&VT52$ .If NE VT100$!VT102$ Call Do1Num ; convert and send number in R1 Mov #,R0 ; and terminal char of move forward .If NE VT52$ Br 20$ ; print it ........... .IfF ;NE VT52$ .Br 20$ ; print it .EndC ;NE VT52$ .EndC ;NE VT100$!VT102$ .If NE VT100$!VT102$&VT52$ 10$: .EndC ;NE VT100$!VT102$&VT52$ .If NE VT52$ Mov #,R0 ; send VT52 cursor position Call V.R0 Mov #'~,R0 ; TRICK: illegal vertical position Call V.R0 ; value which leaves cursor on ; current line. ; NOTE: check this on real VT52 (and VT6xs???) Add #+1,R1 ; convert cursor offset to VT52 char ; in above R1 is number of chars ; from beginning of line OldOFS is the ; bias to add for VT52 addressing, ; +1 is to account for the fact that ; the CurOFS starts at 0, while VT52 ; starts at 1 Mov R1,R0 ; send final (char pos) part of OldCUP .EndC ;NE VT52$ 20$: Pop R1 ; restore work register V.R01: Br V.R0 ............ 30$: Pop R1 ; restore work register Return ...... .Disable LSB .If NE VT100$!VT102$ .SbTtl DO1NUM -- send binary number in R1 as ASCII decimal ;+ ; DO1NUM ; ; convert the number in R1 to ASCII DECIMAL and send it ; handles 000 thru 199 decimal only. 0 and 1 are not sent ; ; Mov #Number,R1 ; Call Do1Num ; ; R0 used ; R1 used ; R2-R5 unchanged ;- .Enable LSB Digtab: .word 100., 10., 1., 0 Do1Num: Cmp #1.,R1 ; is it 0 or 1? Bge Ret ; yes, the don't bother to send it ; since 0 and 1 are normally treated ; as 1 by escape parsing Do3Num: MOV R2,-(SP) ; save R2 MOV #Digtab,R2 ; Point to power table $REL .-2 Digtab SLX CLR -(SP) ; init z-supression flag 10$: CMP R1,@R2 ; digit needed? BGE 15$ ; if so, start in. TST @SP ; zero suppressing? BEQ 30$ ; branch if so 15$: Mov #'0-1,R0 ; convert tens to decimal ascii 20$: Inc R0 ; convert 10s part Sub @R2,R1 Bge 20$ Call V.R0 ; send the digit Add @R2,R1 ; restore value INC @SP ; not zero-suppressing 30$: TST (R2)+ ; point to next power entry TST @R2 ; more to go? BNE 10$ TST (SP)+ ; reclaim stack var MOV (SP)+,R2 ; restore R2 RETURN .Disable LSB .EndC ;NE VT100$!VT102$ .SbTtl V.CREL-- erase all of current line in display only ;+ ; V.CREL ; ; Clear the current line in the display ; ; Call V.CrEl ; ; R0 used ; R1-R5 unchanged ;- .Enable LSB V.CrEl: Call V.CR ; go to the beginning of the line Br V.EL ; and do the EL for this terminal ............ .Disable LSB .SbTtl DOERLN -- erase line in display and in buffer ;+ ; DOERLN ; ; Erase rest of current line in display and truncate buffer. ; Byte @R3 is cleared to truncate line ; ; Call DoErLn ; ; R0 used ; R1-R5 unchanged ;- .Enable LSB DoErLn: ; erase display to end of line ClrB @R3 ; truncate buffer contents .Br V.EL ; and erase display .Disable LSB .SbTtl V.EL -- Erase rest of line in display ;+ ; Erase rest of line in display ; ; Call V.El ; ; R0 is used ; R1-R5 unchanged ;- .Enable LSB V.EL: Call DoCSI ; send ESC CSI (only ESC for VT52) Mov #,R0 ; and erase line terminal char Br V.R0 ; and join common code ............ .Disable LSB .SbTtl DOCSI -- Send ESC CSI for VT1__ and ESC for VT52s ;+ ; DOCSI ; ; Send ESC (and CSI if VT100 or VT102) ; ; Call DoCSI ; ; R0 used ; R1-R5 unchanged ;- .Enable LSB DoCSI: ; Send ESC CSI for VT100 ; or just ESC for VT52 .If NE VT100$!VT102$ Call V.ESC ; send ESC .IfF; NE VT100$!VT102$ Mov #,R0 ; send ESC .EndC ;NE VT100$!VT102$ .If NE VTxxx$&VT52$ .Assume VT.52 LT 0 TstB VT100(R5) ; which terminal? Blt Ret ; VT52 .EndC ;NE VTxxx$&VT52$ .If NE VT100$!VT102$ Mov #,R0 ; introducer .EndC ;NE VT100$!VT102$ Br V.R0 ; join common code ............ .Disable LSB .SbTtl DOBEL -- ring bell and save error code ;+ ; DOBEL ; ; Send a BELl to the screen and set the error code, ; then return to caller's caller (a la KED) ; ; Jsr R0,DoBel ; .Word xxxCod ; ; R0 used ; R1-R5 unchanged ; ; Error(R5) is set to xxxCod (byte) ; Returns to caller's caller ;- .Enable LSB DoBEL: ; save error code and ring bell MovB @(SP)+,Error(R5) ; save error code and dump ret addr Mov #,R0 ; ring the bell Br V.R0 ; join common code ............ .Disable LSB .SbTtl DoDCH -- delete common code ;+ ; DoDCH ; ; Delete the number of chars specified in R0 from the screen ; R2 is the type of delete: ; -1 ^U ; +0 DEL ; +1 PF4 ; ; R3 is address of first char to delete (BufPtr(R5)) ; ; Mov #Del_Length,R0 ; Mov #-1/+0/+1,R2 ; Call DoDCh ; ; R2 value is moved to DelTyp(R5) (Byte) ; The R0 number of chars pointed to by R3 are removed ; from BUFFER and the gap is closed up. ; The characters deleted are moved to DELBUF if the R2 value ; was -1 or 0. The deleted char is moved to DELCHR(R5) if the ; R2 value is +1. The screen is updated. ; ; R0-R2 are used ; R3-R5 are unchanged ;- .Enable LSB DoDCh: Push R0 ; save del count Add R0,BufFre(R5) ; update free count .If NE VT102$ MovB R2,Temp(R5) ; save del type .IfF ;NE VT102$ TstB R2 ; what kind of delete? .EndC ;NE VT102$ Beq 20$ ; DEL char MovB R2,DelTyp(R5) ; indicate type of delete Mov R0,R2 ; number to delete Mov DelBuf(R5),R0 ; point to deleted string buffer Mov R3,R1 ; point to the string to delete 10$: MovB (R1)+,(R0)+ ; move a char Sob R2,10$ ; until no more to move ClrB @R0 ; and end with NUL Br 30$ ; and join common code ........... 20$: MovB @R3,DelChr(R5) ; save deleted char 30$: Mov R3,R0 ; copy pointer Mov R3,R1 ; and again .If NE VT102$ Add @SP,R1 ; point to source .IfF; NE VT102$ Add (SP)+,R1 ; point to source .IfTF ;NE VT102$ Call MovS ; copy it squeezing out deleted char(s) .IfT; NE VT102$ Pop R1 ; get deleted char count .EndC ;NE VT102$ DoDFin: .If NE VT52$!VT100$&VT102$ .Assume VT.102 GT 0 TstB VT100(R5) ; is this a VT102? Bgt 40$ ; yes .EndC ;NE VT52$!VT100$&VT102$ .If NE VT52$!VT100$ Mov R3,R0 ; point to rest of buffer CallXR V.String,V.EL,CurSet ............................ .EndC ;NE VT52$!VT100$ .If NE VT102$ 40$: .Assume TypeLR GT 0 TstB Temp(R5) ; what kind of delete was it Bgt V.EL ; PF4, use del to end of line Call DoCSI ; send ESC CSI Call Do1Num ; send it Mov #,R0 ; and delete char terminal Br V.R01 ; and done ............ .EndC ;NE VT102$ .Disable LSB .SbTtl DOBS -- do BS on screen and in buffer ;+ ; DOBS ; ; Do a backspace on the screen and in the line ;- .Enable LSB DoBS: ; move back one position on the screen .Assume CurOfs EQ 0 Dec (R5) ; update cursor position Dec R3 ; update buffer pointer Mov #,R0 ; and move back on the screen Br V.R0 ; print it ............ .Disable LSB .SbTtl DOFS -- do "forward space" on screen and in buffer ;+ ; DOFS ; ; Do a forward space in buffer and on the screen ;- .Enable LSB DoFS: ; move forward 1 logical character MovB (R3)+,R0 ; get char passing over .Assume CurOfs EQ 0 Inc (R5) ; bump cursor position Br V.R0 ; join common code ............ .Disable LSB .SbTtl V.CR -- send a CR to the display ;+ ; V.CR ; ; Send a CR to the display ;- .Enable LSB ; move to beginning of line V.CR: Mov #,R0 ; print a CarriageReturn .If NE VT100$!VT102$ Br V.R0 ; join common code ............ .Disable LSB .SbTtl V.ESC -- send an ESC to the terminal ;+ ; V.ESC ; ; Send an ESCape to the display ;- .Enable LSB V.ESC: Mov #,R0 ; and start sequence .EndC; NE VT100$!VT102$ .Br V.R0 ; join common code .Disable LSB .SbTtl V.R0 -- do a TTYOUT and return ;+ ; V.R0 ; ; Send the char in R0 to the display ;- .Enable LSB V.R0: CallR @OutTty(R5) ; vector thru impure area ................... PutChr: .TtyOut Ret: Return ...... .Disable LSB .SbTtl V.NL -- do a new line ;+ ; V.NL ; ; Do a NewLine on the display (CR LF) ;- .Enable LSB V.NL: Mov #NulMsg,R0 ; point to a NULL $Rel .-2 NulMsg SLX .Br V.Print ; and print it .Disable LSB .SbTtl V.PRINT -- print the string pointed to by R0 ;+ ; V.PRINT ; ; Print the string pointed to by R0 ;- .Enable LSB V.Print: CallR @Print(R5) ; vector thru impure area .................. PutStr: .If EQ MMg$t .Print ; do it .IfF; EQ MMg$t Push R1 ; get a work register Mov R0,R1 ; copy string pointer 10$: MovB (R1)+,R0 ; get a char Beq 20$ ; null end of string CmpB R0,# ; "200" end of string? Beq 30$ ; yes, done Call @OutTTy(R5) ; do a TTYOUT Br 10$ ; try for next char .......... 20$: Mov #NulMsg,R1 ; point to CR LF NoCrLf $Rel .-2 NulMsg SLX Br 10$ ; and handle null end recursively ........... 30$: Pop R1 ; restore work register .EndC; EQ MMg$t Return ...... .Disable LSB .SbTtl V.PROMPT -- print the prompt string ;+ ; V.PROMPT ; ; Display the prompt in the accustomed place ;- .Enable LSB V.Prompt: Call V.CR ; start at beginning of line Mov Prompt(R5),R0 ; simple, eh? ;;;.If NE MMg$T ;;; Bne 10$ ; one specified ;;; Mov #DBGPMT,R0 ; use debug prompt ;;;$REL .-2 DBGPMT SLX ;;; MOV #4,ProLen(r5) ;;; Br 10$ ;;; ........... ;;;DBGPMT:.Ascii "SLX>" ;;; .Even ;;;10$: ;;;.IfF; NE MMg$t Beq Ret2 ; none, very simple ;;;.EndC; Ne MMg$t ;;; Br V.String ; insure 200 termination br V.Print ; do prompt as defined (RHH) ................ .Disable LSB .SbTtl V.BUFFER -- Print the buffer ;+ ; V.BUFFER ; ; Print the buffer without CRLF ;- .Enable LSB V.Buffer: Mov Buf$er(R5),R0 ; simple .Br V.String .Disable LSB .SbTtl V.STRING -- print string pointed to by R0 ;+ ; V.STRING ; ; Print the string pointed to by R0 w/o CRLF ;- .Enable LSB V.String: Push R1 ; save work register Mov R0,R1 ; copy for call to LEN Call Len ; how long is it? Add R1,R0 ; point to end Push R0 ; save address of last char PushB @R0 ; save it MovB #,@R0 ; make into no CRLF terminator Mov R1,R0 ; print it Call V.Print PopB @(SP)+ ; restore terminator Pop R1 ; restore work register Ret2: Return ...... .Disable LSB .SbTtl LEN -- return string length ;+ ; LEN ; ; Return the length of the string pointed to by R0 ; in R0. The string may be terminated by 000 or 200 octal. ;- .Enable LSB Len: Push R1 ; save a work register Mov R0,R1 ; copy pointer Clr R0 ; start counter 10$: TstB @R1 ; end of string (NUL)? Beq 20$ ; yes CmpB (R1)+,# ; end of string (200)? Beq 20$ ; yes Inc R0 ; else count a char Br 10$ ; and try again 20$: Pop R1 ; restore work register Return ...... .Disable LSB .SbTtl CALLXR -- threaded code routine ;+ ; CALLXR ; ; Call compression routine. This routine is called ; by the CALLXR macro. It is passed a list of addresses ; to call. These are pushed on the stack and called in ; turn as each routine called returns. ;- .Enable LSB CallXR: Pop Temp(R5) ; get old R0 from stack 10$: Push (R0)+ ; stack routine address Add R0,@SP ; make into real address Bit #1,@SP ; is it the last one? Boff 10$ ; no, keep stacking Bic #1,@SP ; fix it Mov Temp(R5),R0 ; restore R0 Return ; call first routine ...... ; which calls second routine ... .Disable LSB .SbTtl INSERT -- insert a char ;+ ; INSERT ; ; Insert the character pointed to by R0 in the buffer location under the ; cursor. ;- .Enable LSB Insert: .If NE VT102$ Mov R4,-(SP) ; R4 will be used later .EndC; NE VT102$ Push R2 ; save work register Push R1 ; save work register Mov R0,R1 ; save address of string to insert Call Len ; how long is it? .If NE LET$ Tst R0 ; null insert? Beq 70$ ; yes, skip code .EndC; NE LET$ Cmp R0,BufFre(R5) ; space? Bgt 60$ ; no Push R0 ; save length of string to insert Push R1 ; save address of string to insert Sub R0,BufFre(R5) ; reduce free count Mov R0,R2 ; save count Mov R3,R0 ; point to rest of buffer Call Len ; how long is it? .If NE VT102$ Mov R0,R4 ; Save it for later .EndC; NE VT102$ Inc R0 ; include the null in the length Mov R0,R1 ; save length Add R3,R1 ; point to end Add R1,R2 ; and to new end 10$: MovB -(R1),-(R2) ; move a char Sob R0,10$ ; do whole string .If NE VT102$ Mov @SP,R1 ; point to string to insert Mov 2(SP),R0 ; load length .IfF; NE VT102$ Pop R1 ; point to string to insert Mov @SP,R0 ; load length .EndC ;NE VT102$ Mov R3,R2 ; and place to insert it 20$: Call LUCase ; Convert to UPPER if necessary MovB (R1)+,(R2)+ ; move a char Sob R0,20$ ; for length of insert string .If NE VT102$ Mov R4,R0 ; get back no. of chars to right .EndC; NE VT102$ .If NE VTxxx$&VT102$ .Assume VT.52 LT 0 .Assume VT.100 EQ 0 TstB VT100(R5) ; which type? Ble 30$ ; VT52 or VT100 Cmp R0,#8. ; at least 8 chars to right? blt 30$ ; If not, don't bother VT102 mode .EndC ;NE VTxxx$&VT102$ .If NE VT102$ ; Use VT102 mode to insert characters Mov #IRMSM,R0 ; set insert mode $Rel .-2 IRMSM SLX Call V.Print Pop R0 ; print new char(s) Call V.String Mov #IRMRM,R0 ; reset insert mode (replace) $Rel .-2 IRMRM SLX Call V.Print .If NE VTxxx$ Br 40$ ; and done ........... .EndC ;NE VTxxx$ .EndC ;NE VT102$ .If NE VT52$!VT100$ 30$: .If NE VT102$ Pop <> ; dump insert string address .EndC ;NE VT102$ Mov R3,R0 ; copy address rest of line Call V.String ; and print it .EndC ;NE VT52$!VT100$ 40$: .Assume CurOfs EQ 0 Add @SP,@R5 ; increment cursor position Add (SP)+,R3 ; and buffer pointer TstB @R3 ; at end now? Beq 50$ ; then cursor is positioned Call CurSet ; and reposition cursor 50$: Tst (PC)+ 60$: Sec .If NE LET$ 70$: .EndC; NE LET$ Pop R1,Save=Carry ;*C* restore work registers Pop R2,Save=Carry ;*C* restore work registers .If NE VT102$ Mov (SP)+,R4 ; restore register .EndC; NE VT102$ Return ...... LUCase: BIT #TtLC$,OJSW(R5) ; Lowercase allowed? BNE 80$ ; If so, move it in. CMPB (R1),#'a ; Otherwise, convert BLT 80$ ; any lowercase chars CMPB (R1),#'z ; to UPPER. BGT 80$ BICB #40,(R1) 80$: Return ...... .Disable LSB .SbTtl B.BOL -- set cursor offset and buffer pointer for BOL ;+ ; B.BOL ;- .Enable LSB B.BOL: Mov Buf$er(R5),R3 ; go to beginning of buffer .Assume CurOfs EQ 0 Clr @R5 ; and move cursor too Return ...... .If NE HelpB$ .SbTtl PToken -- Print a token string ;+ ; PTOKEN ;- .Enable LSB RepMax =: 10. PToken: Push R3 ; save work register 10$: MovB (R1)+,R3 ; get first byte in string Beq 40$ ; zero marks end of tokens Mov #1,R2 ; assume no repeating CmpB #RepMax,R3 ; is it a repeat count? Blo 20$ ; no Mov R3,R2 ; yes, use it (sign extend no problem) MovB (R1)+,R3 ; get thing to repeat 20$: Bic #^c377,R3 ; clear sign extension Asl R3 ; mult by 2 (was a word index) Add #TBase,R3 ; and relocate the char string address $Rel .-2 TBase SLX 30$: Mov R3,R0 ; print the string Call V.Print Sob R2,30$ ; and repeat it if need be Br 10$ ; get next token if any 40$: ; done Pop R3 ; restore work register Return ...... .Disable LSB .EndC; NE HelpB$ .If NE Let$&FunKey .SBTTL FunKD1 - Insert LET data as a result of F-key ; FunKD1 - Function Key (F6-F10, F14, F17-F20 on LK201 keyboard) ; These keys generate [17~ through [21~, [26~, and ; [31~ through [34~ respectively. The LET program manages ; these keys as 8-bit control codes expressed as octal 200 plus the ; F-number. ; ; On entry, R1 contains the escape-sequence number from [nnn~ .Enabl LSB FunKD1: TstB @#dLet ; doing LET substitution? $Rel .-2 dLet SLR Boff 30$ ; no, skip it Call FindKy ; Look for the symbol Bcs 30$ ; branch if not found. Jmp LetIns ; R0 points to LET value string ........... .If NE FunK$S ; This is a FUNCTION_KEY STORE sequence FunKS1: TstB @#dLet ; doing LET substitution? $Rel .-2 dLet SLR Boff 30$ ; no, skip it .Assume CurOfs EQ 0 Cmp @R5,#LetSz$ ; too long? Bge 30$ ; don't allow storing it Tst R5 ; empty line? Beq 30$ ; don't allow storing emptys Call FindKy ; Look for the key Bcc 10$ ; if found, replace value Mov R4,x1 ; save function key map code Clr R4 Call FindSy ; Look for an empty entry Bcs 30$ ; error if none Movb x1,-(R1) ; store the map code as symbol, 10$: Mov R3,-(SP) Mov Buf$er(R5),R3 ; point to start of line 20$: Movb (R3)+,(R0)+ ; Copy the current line Bne 20$ ; to the LET value string Mov (SP)+,R3 Return ...... x1: .Word 0 ; memory register .EndC; NE FunK$S 30$: Jmp EscErr ; undefined function key ...... .Sbttl Find a LET table entry ;+ ; FindKy: Find a LET symbol whose Function key code is in R1 ; ; On entry, R1 contains the Function key code to find ; On exit, the C-bit indicates success or failure. ; On SUCCESS, R0 points to the corresponding value. ; R0, R1, and R2 are altered. ;- FindKy: Sub #17.,R1 ; zero-base escape seq code MovB FunMap(R1),R4 ; get the corresponding ctrl code $Rel .-2 FunMap SLX .Br FindSy ;+ ; FindSy: Find a LET symbol whose value is in R4 ; ; On entry, R4 contains the key value to find ; On exit, the C-bit indicates success or failure. ; On SUCCESS, R0 points to the corresponding value. ; R0, R1, and R2 are altered. ;- FindSy: Mov #LetSym,R1 ; point to symbol names $Rel .-2 LetSym SLR Mov #LetVal,R0 ; point to value strings $Rel .-2 LetVal SLR Mov #LetNo$,R2 ; and load count too 40$: CmpB (R1)+,R4 ; is this the symbol? Beq 50$ ; yes Add #LetSz$+1,R0 ; point to next value string Sob R2,40$ ; try all of them SeC ; not found 50$: Return ........... .Dsabl LSB ; Function Key map - escape code index finds control value FunMap: .Byte 206,207,210,211,212 ; F6 - F10 codes .Byte 0 ; invisible key .Byte 0,0,0 ; F11 - F13 have different meanings .Byte 216 ; F14 .Byte 0 ; invisible key .Byte 0,0,0 ; HELP, DO, invisible .Byte 221,222,223,224 ; F17 - F20 codes .Even .EndC; NE Let$&FunKey .If NE SL$MLO .SbTtl Multi-old-line support .Enabl LSB ; BACK UP one old command (UP-arrow does this) UpM: mov CurOld(r5),r0 ; Point to "current" old line, tstb FirstM(r5) ; First UP call since reset? blt ClrLin ; Already beyond end? beq 20$ ; skip delimiter search if so. 10$: tstb (r0)+ ; end of this old line? bne 10$ ; if not keep looking. 20$: incb OldNum(r5) ; count the operation tstb (r0) ; look at char after NULL bne 70$ ; go move the line to Buf$er. movb #-1,FirstM(r5) ; indicate UPed off the end. ClrLin: clrb @Buf$er(r5) ; no more lines - return clear line. clr r2 ; set char count to zero. return ; ADVANCE one old command. (DOWN-arrow does this) DownM: mov CurOld(r5),r0 ; Point to current old line. tstb FirstM(r5) ; did we get UPed off the end? blt 60$ ; if so, use current old line. mov OldBuf(r5),r2 ; get old buffer address bitb -(r0),-(r0) ; skip backwards over NULL 30$: cmp r0,r2 ; backed up to beginning yet? bhis 40$ ; branch if still in area. clrb OldNum(r5) ; too far; set current old line to #0 br 100$ ; backed up against front end 40$: beq 60$ ; exactly at beginning. 50$: tstb -(r0) ; Did we hit a NULL? bne 30$ ; If not, try again. tstb (r0)+ ; Point to 1st character... 60$: decb OldNum(r5) ; count the operation ; Move one old command into current buffer for display and use 70$: mov r0,CurOld(r5) ; update the current old-cmd ptr mov Buf$er(r5),r2 ; Get current buffer address mov r2,r1 ; save in r1 for length calc 80$: movb (r0)+,(r2)+ ; Move a character to Buffer... bne 80$ ; if it was NULL, get out. movb #1,FirstM(r5) ; Indicate "GET NEXT string" dec r2 ; back up to NULL sub r1,r2 ; calculate string length 90$: tst (pc)+ ; good return 100$: sec ; "no more lines" return retdm: return .Dsabl LSB .SbTtl SAVEM - Save current buffer at front of Old-Line FILO .Enabl LSB SaveM: .If NE SL$RCL tstb @#dRCL ; Is RECALL SET ON? $Rel .-2 dRCL SLR beq 5$ ; If not, skip around check. call CHKREC ; Check instruction for RECALL beq retdm ; If so, GET OUT (if not JMPed out) 5$: .EndC; NE SL$RCL mov r4,-(sp) ; (save r4) mov OldBuf(r5),r4 ; get old buffer address mov Buf$er(r5),r2 ; get pointer to current text buffer tstb (r2) ; is first char a NULL? beq 90$ ; if so, get out now. ; Check new line against previous old line. If they're the same, don't ; re-insert it into the old buffer. ; (Note; This code was disabled to avoid confusion when using CYCLE -RHH) ;; mov r4,r0 ; compare new buffer with 1st old line ;; mov r2,r1 ;;10$: cmpb (r0),(r1)+ ;; bne 20$ ; If a char doesn't compare, go store. ;; tstb (r0)+ ; was the character a NULL? ;; bne 10$ ;; br 90$ ; if so, strings equal. Dont store. 20$: mov r3,-(sp) ; (save r3) mov r2,-(sp) ; Save pointer to buffer, 30$: tstb (r2)+ ; look for EOS, bne 30$ ; counting characters sub (sp),r2 ; how many was it? mov r4,r1 ; get FILO address, add #OldBSz,r1 ; point just beyond last character, mov r1,r3 ; (save a copy for later) mov r1,r0 ; r1 is destination pointer, sub r2,r0 ; sub char count - r0 is source ptr, 40$: cmp r0,r4 ; more to copy? blos 50$ ; if so, jump out. movb -(r0),-(r1) ; move characters forward br 40$ ; keep on copyin' ; The existing old buffer has been shifted to make room for the new line. ; Copy it in now... 50$: mov r4,r1 ; Re-get old-buffer pointer, mov (sp)+,r2 ; Re-get Buf$er pointer, 60$: movb (r2)+,(r1)+ ; Store string there bne 60$ ; until NULL clrb -(r3) ; Force the FILO to be terminated clrb -(r3) ; (avoiding embarrassing disasters) ; It is very likely that part of one of the commands on the end ran off ; into oblivion, so search backwards for the nearest NULL and terminate ; the list of commands there... 70$: tstb -(r3) ; look at chars starting at back end bne 70$ ; until NULL seen. inc r3 clrb (r3) ; place 2nd NULL to terminate list 80$: mov (sp)+,r3 ; restore regs, 90$: mov r4,CurOld(r5) ; Reset Current Old Pointer, mov (sp)+,r4 ; restore R4, 100$: clrb FirstM(r5) ; declare GET CURRENT for UP code clrb OldNum(r5) ; set current old line be #0 return InitB1: .If NE SL$RCL clrb SrchBf ; Indicate default non-search mode .EndC; NE SL$RCL InitBF: mov OldBuf(r5),CurOld(r5) ; Initialize for UP calls br 100$ .dsabl LSB .EndC; NE SL$MLO .If NE SL$KED .SbTtl Keypad ON/OFF for KED mode editing .enabl LSB KPOn: .If NE VTxxx$&VT102$ .Assume VT.52 LT 0 .Assume VT.100 EQ 0 TstB VT100(R5) ; which type? Ble 10$ ; VT52 or VT100 .EndC; NE VTxxx$&VT102$ .If NE VT102$ Mov #IRMRM,R0 ; reset insert mode (replace) $Rel .-2 IRMRM SLX Call V.Print .EndC; NE VT102$ 10$: movb #'=,r0 ; keypad ON is = br KPCom KPOff: movb #'>,r0 ; keypad OFF is > KPCom: .If NE VT52$ tstb VT100(R5) blt KPRetn ; branch out if terminal not VT100 .EndC; NE VT52$ call TKMode ; is SL SET to KED? beq KPRetn ; KED mode not on. Return. mov r0,-(sp) ; Stash the character, call V.ESC ; Send ESCAPE, mov (sp)+,r0 ; Get that character back here, CallR V.R0 ; Send '=' or '>' TKMode: tstb @#dKED ; Test for SET SL KED mode $Rel .-2 dKED SLR KPRetn: return .EndC; NE SL$KED .dsabl LSB .if NE FunKey .SBTTL ProFKy - Enable/Disable PRO Function Keys ;+ ; R0 = 'h enables Pro Function Key ; = 'l disables Pro Function Key ;- .Enabl LSB ; Turn ON/OFF the top row of function keys on Pro-300 keyboards ProFKy: Mov R0,-(SP) ; save ON/OFF indicator TstB ProKey ; SET SL LET active on a PRO? Beq 30$ ; branch if not MovB (SP)+,FKOnOf ; set l or h in escape sequence Jsr R0,20$ .ascii /[?39/ FKOnOf: .ascii /h/ .even 20$: Call V.Print ; turn on function keys 30$: Mov (SP)+,R0 ; pop ON/OFF indicator or rtn adrs Return ...... .Dsabl LSB .EndC; NE FunKey .If NE SL$KED!SL$RCL .SbTtl FindWD - Find Word Delimiter in buffer ;+ ; Find Word Delimiter in buffer. Current position is passed in R0. ; R2 returns with the number of characters bypassed. ;- .enabl LSB FindWD: mov r0,-(sp) ; save the buffer pointer mov r3,-(sp) ; and r3 clr r2 ; char counter clr r3 ; word boundary crossed indicator mov r0,r1 ; use R1 as the traveling register 10$: movb (r1)+,r0 ; Put character in r0 beq 40$ ; return immediately if NULL inc r2 ; count the character call TstDlm ; Test it for delimiterness bne 20$ ; If not, check for boundary crossed inc r3 ; If so, set the boundary crossed flag br 10$ ; branch if it was a delimiter 20$: tst r3 ; have we crossed a word boundary? beq 10$ ; If not, keep trying. 30$: dec r2 ; Discount first Inc. Done. 40$: mov (sp)+,r3 mov (sp)+,r0 return TstDlm: push r1 ; Is the character in R0 a word delimiter? mov #DlmTbl,r1 $Rel .-2 DlmTbl SLX 50$: tstb (r1) beq 60$ cmpb (r1)+,r0 ; character match? bne 50$ pop r1 cmpb r0,r0 ; set Z bit return 60$: pop r1 tst sp ; clear Z bit return .EndC; NE SL$KED!SL$RCL .If NE SL$KED ; Find word in reverse direction FindWR: mov r0,-(sp) mov r3,-(sp) clr r2 ; clear character count clr r3 ; clear crossed-word flag mov r0,r1 70$: cmp r1,Buf$er(r5) ; arrived at BOL? blos 40$ ; quit now. movb -(r1),r0 ; get the next character inc r2 ; count character bypassed call TstDlm ; Is the character a WORD delimiter? beq 80$ ; If not, do it again. inc r3 ; Not delimiter - within a word br 70$ ; keep searching. 80$: tst r3 ; delimiter found. Crossed word yet? beq 70$ ; If not, keep going. inc r1 ; If so, advance up to the word br 30$ ; Done. .dsabl LSB .SbTtl DelNCh - Delete N Characters from buffer, put in WORD buffer ;+ ; Delete N (R2) Characters from buffer. Put the deleted sequence into ; the Deleted Word Buffer. ; ; Current position is pointed to by R0. If NULL encountered, return ; with fewer characters deleted. ; ; Upon return, R2 contains the actual number of characters deleted. ;- .enabl LSB DelNCh: mov r0,r1 ; save pointer to string call Len ; get length cmp r0,r2 ; fewer chars than specified? bgt 10$ mov r0,r2 ; then delete that many. ble 40$ ; branch if no chars to delete 10$: push r1 ; store string pointer push r3 mov r2,r3 ; make copy of char count mov #WRDBUF,r0 ; point to saved word buffer $Rel .-2 WRDBUF SLX 20$: movb (r1)+,(r0)+ ; transfer N chars to word buffer, dec r3 ; and advance R1 to 1st char not bgt 20$ ; deleted. clrb (r0) ; store NULL at end of word buffer pop r3 ; recover saved r3, pop r0 ; and saved string pointer 30$: movb (r1)+,(r0)+ ; squeeze out old chars bne 30$ ; until NULL. 40$: return .dsabl LSB .EndC; NE SL$KED .If NE SL$RCL ; RECALL support? .SbTtl ************** RECALL Processing *************** ; ; SL's RECALL command; ; ; .REC[ALL] ; .REC n ; .REC search_string ; .RECall/All ; .RECall/Clear ; ; Inspect the buffer for the word RECALL. If present, trap ; the command and decode it locally. Signal the caller (SaveM) ; not to store the command in its FILO. .SbTtl CHKREC - Check for RECALL, if so parse and process it .enabl LSB CHKREC: mov r3,-(sp) ; Save cursor pointer mov Buf$er(r5),r0 ; Set up for string comparison... mov #RecCmd,r1 ; Point to RECALL command, $Rel .-2 RecCmd SLX mov #RecCml,R4 ; insist on at least 3 characters movb R4,Delimt ; set delimiter sensing flag call SCMPCI ; do case-insensitive string compare bne 180$ ; Branch if NOT a RECALL command. ; The command is RECALL. Position on the next token mov Buf$er(r5),r0 call FindWD ; position on next token tst r2 bgt 20$ ; no next token; recall last. 10$: mov #1,r1 ; let search count = 1 br 40$ ; and get 1st command. 20$: add r2,r0 ; point to token 30$: movb (r0),r3 ; get 1st char cmpb r3,#'0 blt 10$ ; treat as RECALL cmpb r3,#'9 ; is digit? bgt 60$ ; branch if not. (preserve R0) ; RECALL n -- Search the old line buffer for the R1'th old line. call VALNN ; get value of number (in r1) 40$: call LineN ; get line N in buffer ; The command is now in the Buffer. Return it to caller. 50$: call V.NL ; do a new line, call V.NL ; do another new line, mov SaveSP,SP ; eat return addresses, jmp UpDown ; and display the line. ; RECALL/OPTION or RECALL was typed. Check for /ALL or /CLEAR 60$: cmpb -1(r0),#40 ; Was delimiter a BLANK? beq 90$ ; If so, assume match string. call V.NL ; Print a blank line, bicb #40,r3 ; make UPPER case cmpb r3,#'A ; is it /ALL? beq 110$ ; Branch if list requested cmpb r3,#'C ; is it /CLEAR? beq 70$ ; if so, go CLEAR the buffer mov #InvCmd,r0 ; point to error message $rel .-2 InvCmd SLX call V.Print ; print it. br 170$ ; now get out. ; Clear the entire Old Buffer 70$: mov OldBuf(r5),r0 ; Clear the old buffer mov #OldBSz,r1 80$: clrb (r0)+ dec r1 bgt 80$ movb #2,OldSet(r5) ; Reset the CYCLE to default. br 170$ ; Now, get out of SL. ; Set up for search of specified string 90$: mov #SrchBf,r1 ; Point to search buffer $Rel .-2 SrchBf SLX mov r1,r4 100$: movb (r0)+,(r4)+ ; Move chars into search buffer bne 100$ ; until NULL is encountered. sub r1,r4 ; R4 has count of search string dec r4 ; (well at least NOW it does.) br 40$ ; Get that line. ; Print list of all known commands 110$: .If NE SL$CLO ; Include this only if we want RECALL/ALL list to go to console log CALL ENTTOU ; enable saving TTYOUTs .EndC; NE SL$CLO call InitBF clr r3 ; Init command number 120$: call UpM ; Get next line tstb @Buf$er(r5) ; was an old line available? beq 170$ ; if not, quit. inc r3 ; Bump command number, cmp r3,#100. ; is it REALLY BIG? bge 150$ ; If so, don't need leading BLANK. 130$: movb #40,r0 ; load a BLANK into R0, cmpb OldSet(r5),r3 ; if this is the OldSet line, bne 140$ movb #'*,r0 ; load an ASTERISK instead 140$: call V.R0 ; print BLANK or ASTERISK 150$: cmp r3,#10. ; is it SORT OF BIG? bge 160$ movb #40,r0 call V.R0 160$: mov r3,r1 ; Put count in R1 for cvt routine call Do3Num ; Convert it and print it. mov #40,r0 ; print another blank, call V.R0 mov Buf$er(r5),r0 call V.Print ; print the command line, br 120$ ; and get the next one. 170$: .RCtrlO ; sync terminal mode call V.NL ; Print a blank line, .If NE SL$CLO ; Include this only if we want RECALL/ALL list to go to console log CALL DITTOU ; disable saving TTYOUTs .EndC; NE SL$CLO call InitB1 ; Re-init buffer pointers, mov SaveSP,SP ; skip the ticker-tape parades, Baby Jmp ApBlCl ; Resume SL editing, with blank line. ; Not a RECALL command. Clear Z bit so that BNE will Branch. 180$: mov (sp)+,r3 ; Restore R3 (and clear Z doing so) return .dsabl LSB .SbTtl SCMPCI - Case-insensitive String Compare (RECALL support) ;+ ; Compare two strings pointed by R0 and R1 respectively. ; At least n characters must match, where n is specified in R4. ; The comparison is terminated when a NULL, BLANK, or SLASH is ; encountered on the (R0) string. ; On return, R2 contains the number of characters that matched, ; and the Z-bit indicates a match. ; ;- .enabl LSB SCMPCI: clr r2 mov r5,-(sp) 10$: movb (r0)+,r3 ; put buffer char in r3 beq 50$ ; if NULL, get out. tstB Delimt ; ignore delimiters? beq 20$ cmpb r3,#'/ ; SLASH? beq 50$ cmpb r3,#40 ; SPACE? beq 50$ 20$: cmpb r3,#'a ; If (r0) string char is LOWER, blt 30$ cmpb r3,#'z bgt 30$ bicb #40,r3 ; convert to UPPER case 30$: movb (r1)+,r5 ; if (r1) char is LOWER, cmpb r5,#'a blt 40$ cmpb r5,#'z bgt 40$ bicb #40,r5 ; make UPPER case 40$: cmpb r3,r5 ; compare with sample bne 60$ inc r2 ; count matched chars br 10$ 50$: cmp r2,r4 ; at least R4 matched chars? blt 60$ mov (sp)+,r5 sez ; Indicate match return 60$: mov (sp)+,r5 clz return ; with Z set appropriately. .dsabl LSB .enabl LSB VALNN: ; Determine value of 2-digit no. clr r1 ; clear accumulator 10$: movb (r0)+,r3 ; get character beq 20$ ; if NULL, done. cmpb r3,#', ; comma? beq 20$ ; if so, done. cmpb r3,#'- ; minus ("through") beq 20$ ; if so, done. mov r1,-(sp) ; save previous value, asl r1 ; multiply *2, asl r1 ; *4, add (sp)+,r1 ; *5, asl r1 ; *10 bic #177760,r3 ; get char's value, add r3,r1 ; add it to accumulator, br 10$ ; look for another... 20$: return .dsabl LSB .EndC; NE SL$RCL .If NE SL$MLO!SL$RCL .SbTtl Support routines for RECALL and MULTI-OLD-LINE .enabl LSB ; Service routine - Get Line N from old buffer to line buffer ; (N is passed in R1) LineN: call InitBF ; init buffer pointers, 10$: mov r1,-(sp) ; loop through commands... call UpM ; Get next old line... mov (sp)+,r1 ; restore the count-down tstb @Buf$er(r5) ; was an old line available? bne 14$ callr InitB1 ; if not, quit and re-init. 14$: .if NE SL$RCL ; If searching for a particular string, do that now. tstb SrchBf ; String searching? beq 20$ ; Branch if not. mov Buf$er(r5),r1 ; Beware: Hack follows... mov #SrchBf,r0 ; Assume #Buf$er GT $Rel .-2 SrchBf SLX ; (don't worry about clobbering count) clrB Delimt ; ignore delimiters call SCMPCI ; Do strings compare? beq 30$ ; They do? Oh Boy! .endC; NE SL$RCL 20$: dec r1 ; Count down... bne 10$ ; loop back or drop through. 30$: .If NE SL$RCL clrb SrchBf ; turn off string searching .endC; NE SL$RCL incb FirstM(r5) ; 1st line no longer current. return .dsabl LSB .EndC; NE SL$MLO!SL$RCL .SbTtl ***************************************** .SbTtl * DATA * .SbTtl ***************************************** .SbTtl Character dispatch tables .List MEB .HiH2O = 0 .Macro GenDef Normal Gold .Byte Normal-CtlBas/2,Gold-CtlBas/2 .IIf GT Normal-CtlBas/2-377 .Error Normal-CtlBas/2-377 ; Normal too far ; .IIf GT Gold-CtlBas/2-377 .Error Gold-CtlBas/2-377 ; Gold too far ; .IIf GT Normal-CtlBas/2-.HiH2O .HiH2O = Normal-CtlBas/2 .IIf GT Gold-CtlBas/2-.HiH2O .HiH2O = Gold-CtlBas/2 .EndM GenDef .Macro CtlDef Char Normal Gold . = CtlTab+ GenDef Normal Gold . = CtlEnd .EndM CtlDef CtlTab: ; MaxCtl+1 accounts for NUL .Rept MaxCtl+1 ; initialize table to data routine GenDef CtlErr CtlErr ; illegal char is default .EndR CtlEnd: ; end of table CtlDef Nul DelCL UnDCL ; NUL is "DEL" CtlDef Ctrl.C Canjmp Canjmp CtlDef BS Swap UnSwap CtlDef HT Tab Tab .If NE SL$KED CtlDef LF LFeed UnDelW .IfF; NE SL$KED CtlDef LF LFeed Trunc .EndC; NE SL$KED CtlDef CR CREntr CRTrnc CtlDef Ctrl.A IRTogl IRTogl CtlDef Ctrl.B Up Up CtlDef Ctrl.D Left BOL CtlDef Ctrl.E Up Up CtlDef Ctrl.F Right EOL CtlDef Ctrl.R Refrsk Refrsk CtlDef Ctrl.U DelLL UnDeLL CtlDef Ctrl.V Down Down CtlDef Ctrl.W Refrsk InsCtW CtlDef Ctrl.Z EOF EOF CtlDef ESC Escape Escape .If NE FunKey FunTab: .If NE Let$ Gendef FunKyL FunKyS ; F6 = [17~ Gendef FunKyL FunKyS ; F7 = [18~ Gendef FunKyL FunKyS ; F8 = [19~ Gendef FunKyL FunKyS ; F9 = [20~ Gendef FunKyL FunKyS ; F10 = [21~ Gendef EscErr EscErr ; ? = [22~ .IfTF; NE Let$ ; GenDef Escape Escape ;(ESC)= [23~ GenDef EscErr EscErr ;(ESC)= [23~ GenDef Swap UnSwap ; (BS)= [24~ .If NE SL$KED GenDef LFeed UnDelW ; (LF)= [25~ .IfF; NE SL$KED GenDef LFeed Trunc ; (LF)= [25~ .EndC; NE SL$KED .IfT; NE Let$ GenDef FunKyL FunKyS ; F14 = [26~ .IfF; NE Let$ GenDef EscErr EscErr ; F14 = [26~ .IfTF; NE Let$ GenDef EscErr EscErr ; ? = [27~ GenDef Hlpjmp Hlpjmp ; HELP= [28~ .IfT; NE Let$ GenDef EscErr EscErr ; DO = [29~ GenDef EscErr EscErr ; ? = [30~ Gendef FunKyL FunKyS ; F17 = [31~ Gendef FunKyL FunKyS ; F18 = [32~ Gendef FunKyL FunKyS ; F19 = [33~ Gendef FunKyL FunKyS ; F20 = [34~ .EndC; NE Let$ .EndC; NE FunKey .If NE VT100$!VT102$ PFxTab: GenDef Enter Enter ; 'Enter' esc O M GenDef EscErr EscErr ; esc O N GenDef EscErr EscErr ; esc O O GenDef Gold Gold ; PF1 - esc O P GenDef Hlpjmp Hlpjmp ; PF2 - esc O Q GenDef Look Model ; PF3 - esc O R GenDef DelLR UnDeLL ; PF4 - esc O S .If NE SL$KED PFKED1: GenDef DelCO UnDelc ; ',' esc O l GenDef DelWR UnDeLW ; '-' esc O m GenDef EscErr EscErr ; '.' esc O n GenDef EscErr EscErr ; 'nothing' esc O o GenDef DigKy APBLCL ; '0' esc O p GenDef DigKy DigKy ; '1' esc O q GenDef DigKy DelLR ; '2' esc O r GenDef DigKy DigKy ; '3' esc O s GenDef DigKy DigKy ; '4' esc O t GenDef DigKy DigKy ; '5' esc O u ; GenDef EscErr EscErr ; '6' esc O v ; GenDef EscErr EscErr ; '7' esc O w ; GenDef EscErr EscErr ; '8' esc O x ; GenDef EscErr EscErr ; '9' esc O y .EndC; NE SL$KED .EndC; NE VT100$!VT102$ AroTab: GenDef Up Top GenDef Down SetOld ;Bottom GenDef Right EOL GenDef Left BOL .If NE VT52$ P52Tab: GenDef Gold Gold GenDef Hlpjmp Hlpjmp GenDef DelLR UnDeLL .EndC ;NE VT52$ .NList MEB .HiH2O = .HiH2O ; biggest offset used .If GT .HiH2O-377 .HiH2O = .HiH2O-377 ; words above flood stage .IfF; GT .HiH2O-377 .HiH2O = 377-.HiH2O ; words below flood stage .EndC ;GT .HiH2O-377 .If NE SL$HBF ; Non-impure (High Memory in XM) Fixed Line buffers OLDBF1: .Byte 0 .If EQ SL$MLO .Blkb LinSz$ ; OLD buffer OLDBF2: .Byte 0 .Blkb LinSz$ ; OLDER buffer .IfF; EQ SL$MLO .Blkb OldBSz-1 ; OLD buffer FILO OLDBF2: .Byte 0 .Blkb 1 ; OLDER buffer (really a dummy) .EndC; EQ SL$MLO SAVBF1: .Byte 0 .Blkb LinSz$ ; SAVE buffer DELBF1: .Byte 0 .Blkb LinSz$ ; DELETED line buffer .even .Endc; NE SL$HBF .If NE SL$KED WRDBUF: .Byte 0 ; Deleted WORD Buffer .Blkb LinSz$ .even KPDir: .Byte 1 ; Keypad direction 0=fwd, 1=bkwd Side: .Byte 0 ; Side-of-line indicator .Even ..SLKD:: DlmTbl: .Byte ' , ',, '/, '(, '), 11, '. ;Word Delimiter Table .Byte ':, '=, 0, 0, 0 ;extra Delimiter space .Even .EndC; NE SL$KED .If NE SL$MLO .IfF; NE SL$MLO BlnkLn: .Byte 0 .Byte 0 .EndC; NE SL$MLO .If NE SL$RCL ; RECALL option-specific data SaveSP: .word 0 ..SLRC:: RecCml =: 3 ; No. of chars required for match RecCmd: .ASCIZ /RECALL/ ; the command name SrchBf: .Byte 0 .BlkB 78. Delimt: .Byte 0 ; Used by SCMPCI. Ignore/Sense delimiters InvCmd: .Asciz /?SL-E-Invalid command/ .EndC; NE SL$RCL IRMode: .Byte 0 .If NE FunKey ProKey: .Byte 0 .EndC; NE FunKey .Even .SbTtl DSECT for Impure area ;* WARNING: The layout of IMPURE should not be considered a documented *; ;* interface. It is subject to change, refinement, or deletion until *; ;* such time as it appears in RT-11 documentation. *; Offset = 0 .Macro $Word Label Label =: Offset Offset = Offset+2 .EndM $Word .Macro $Byte Label Label =: Offset Offset = Offset+1 .EndM $Byte $Word CurOfs ; cursor offset from beginning of ; "buffer" on display. (0 == on the ; first char position) $Word InTty ; address of input char routine $Word OutTty ; address of output char routine $Word Print ; address of output string routine $Word Exit ; address of .EXIT routine $Word Width ; width of screen $Word CurMax ; maximum CurOfs value $Word BufFre ; free space in buffer $Word Buf$er ; pointer to command buffer $Word OldBuf ; previous line buffer $Word OldrBf ; previous previous line buffer $Word DelBuf ; deleted line buffer $Word SavBuf ; pointer to save buffer $Word ProBuf ; pointer to internal prompt buffer ; only used in XM version $Word ISCCA ;*2* internal SCCA request block $Word ISCCAA ;*2* address of flag word $Word OSCCA ;*2* external SCCA request block $Word OSCCAA ;*2* address of flag word $Word OJSW ; user's JSW contents (or changed bits?) $Word CCFlag ; ^C flag word for internal SCCA $Word XitSP ; SP value for DotXit routine $Word Temp ; temporary available within any routine ; between calls to other routines ; use care in its use $Word State ; state flag for .TtyIn response $Word Prompt ; pointer to prompt string or ; 0 if there is no prompt string $Word CurOld ; pointer to current OLD string .If NE VTxxx$ $Byte VT100 ; terminal type (major family) .IFF ;NE VTxxx$ $Byte Filler ; unused .EndC ;NE VTxxx$ VT.52 =: -1 ; VT52 (62?) VT.100 =: 0 ; VT100 VT101 VT105 VT125 VT.102 =: +1 ; VT102 VT100 w/Printer VT131 VT132 VT.200 =: +2 ; VT220 VT240 VT241 ... $Byte FlagG ; GOLD flag ValueG =: 100 ; value used to set the GOLD flag ; this value when acted upon by ASLB ; becomes 200 the first time and is ; shifted out of the byte the second ; time. $Byte Error ; error message code $Byte ProLen ; length of prompt $Byte DelTyp ; 0 == ^U, 1 == PF4 filled buffer TypeLL =: -1 ; ^U delete flag value TypeCL =: 0 ; DELETE delete flag value (not used here) TypeLR =: +1 ; PF4 delete flag value $Byte DelChr ; deleted char buffer $Byte IState ; low byte of job's I.State word $Byte FirstM ; Indicates "Get first OLD line on UP" $Byte OldNum ; current Old line number $Byte OldSet ; Desired Old line number $Byte OverHd ; none N*Length area in impure ; ; current buffer starts here ; ; followed by previous line buffer ; ; and deleted line buffer, all same size .Disable LSB .If NE HelpB$ .Macro T q,w,e,r,t,y,u,i,o,p,a,s,d,f,g,h,j,k,l,z,x,c,v,b,n,m,qq .Irp .., .If NB <..> ...=0 .IrpC ....,<..> .IIf IDN <....> <$> ...=1 .EndR .If NE <...> .Byte ..-TBase/2 .IfF; NE <...> .Byte .. .EndC; NE <...> .EndC; NB <..> .EndR .EndM T .Enable LSB .If NE VT100$!VT102$ .SbTtl VT100 large help display HlpMsg: ;'-------.-------.-------.-------` '-------.-------.-------.-------` ;|GET OLD|GET SAV|LEFT C |RIGHT C| | | | |DEL LIN| ;| ^ | v | <--- | ---> | | GOLD | HELP | | | ;| CYCLE |SET CYC| BEGIN | END | | | | |UNDEL L| ;\-------~-------~-------+-------{ \-------~-------~-------~-------/ ; | SWAP | ; |BACK SP| SAVE ; |UNSWAP | UNSAVE ;'-------.-------.-------+-------+-------` ;|REFRESH|REFRESH|DEL LIN| RETURN|DEL CHR| ;|CTRL W |CTRL R |CTRL U |RETURN |DELETE | For more information, ;| | |UNDEL L| TRUNC |UNDEL C| type HELP SL ;\-------~-------~-------~-------~-------/ T 1$ T 72$,10$,<3>,16$,15$,11$,23$,10$,<3>,16$,15$,11$,23$,4$ .If NE SL$MLO T 72$,8$,64$,8$,67$,8$,28$,8$,29$,8$,23$,8$,5$,19$,6$,8$,7$,7$,30$,3$ .IfF; NE SL$MLO T 72$,8$,24$,8$,27$,8$,28$,8$,29$,8$,23$,8$,5$,19$,6$,8$,7$,7$,30$,3$ .EndC; NE SL$MLO T 72$,8$,31$,8$,26$,8$,32$,8$,33$,8$,23$,8$,5$,34$,6$,8$,35$,8$,7$,19$,3$ .If NE SL$MLO T 72$,8$,5$,68$,6$,8$,5$,69$,6$,8$,5$,36$,6$,8$ .IfF; NE SL$MLO T 72$,8$,5$,245$,6$,8$,5$,25$,6$,8$,5$,36$,6$,8$ .EndC; NE SL$MLO T 72$,5$,37$,6$,8$,23$,8$,5$,19$,6$,8$,7$,7$,5$,38$,6$,3$ T 72$,12$,17$,17$,15$,9$,15$,14$,23$,12$,<3>,17$,15$,13$,4$ T 72$,<3>,22$,8$,39$,3$ T 72$,<3>,22$,8$,40$,8$, 22$,23$,79$,81$,21$,25$,4$ T 72$,<3>,22$,8$,5$,41$,6$,8$, 22$,23$,79$,82$,21$,84$,4$ T 72$,10$,16$,16$,15$,9$,15$,9$,15$,11$, 4$ T 72$,8$,42$,8$,42$,8$,43$,8$,44$,8$,45$,3$ T 72$,8$,46$,8$,47$,8$,48$,8$,44$,8$,49$,8$, 23$,76$,4$ T 72$,8$,7$,7$,5$,38$,6$,8$,5$,50$,6$,8$,5$,51$,6$,8$, 22$,78$,4$ T 72$,12$,<4>,17$,15$,13$,2$ .Byte 000 .EndC; NE VT100$!VT102$ .NList BEX .Even TBase=:.-2-<2*RepMax> .If NE VT100$!VT102$ .Even 1$:.Ascii "0" .Even 2$:.Ascii "24" .Even 3$:.Asciz ; .Even 4$:.Asciz ; .Even 5$:.Ascii .Even 6$:.Ascii .Even 7$:.Asciz " " .Even 8$:.Ascii .Even 9$:.Ascii .Even 10$:.Ascii .Even 11$:.Ascii .Even 12$:.Ascii .Even 13$:.Ascii .Even 14$:.Ascii .Even 15$:.Ascii .Even 16$:.Ascii .Even 17$:.Ascii .Even ;;;18$:.Ascii " "" " .EndC; NE VT100$!VT102$ .Even 19$:.Ascii " " ; 7 spaces .Even 20$:.Ascii " " ; 5 spaces .Even 21$:.Ascii " " ; 3 spaces .Even 22$:.Ascii " " ; 8 spaces .Even 23$:.Ascii " " ; 4 spaces .Even 24$:.Ascii "GET OLD" .Even 245$:.Ascii " OLDER " .Even 25$:.Ascii " SAVE " .Even 26$:.Ascii " V " .Even 27$:.Ascii "GET SAV" .Even 28$:.Ascii "LEFT C " .Even 29$:.Ascii "RIGHT C" .Even 30$:.Ascii "DEL LIN" .Even 31$:.Ascii " ^ " .Even 32$:.Ascii " <--- " .Even 33$:.Ascii " ---> " .Even 34$:.Ascii " GOLD " .Even 35$:.Ascii " HELP " .Even 36$:.Ascii " BEGIN " .Even 37$:.Ascii " END " .Even 38$:.Ascii "UNDEL L" .Even 39$:.Ascii " SWAP " .Even 40$:.Ascii "BACK SP" .Even 41$:.Ascii "UNSWAP " .Even 42$:.Ascii "REFRESH" .Even 43$:.Ascii "DEL LIN" .Even 44$:.Ascii "RETURN " .Even 45$:.Ascii "DEL CHR" .Even 46$:.Ascii "CTRL W " .Even 47$:.Ascii "CTRL R " .Even 48$:.Ascii "CTRL U " .Even 49$:.Ascii "DELETE " .Even 50$:.Ascii " TRUNC " .Even 51$:.Ascii "UNDEL C" .Even .If NE VT52$ 52$:.Ascii .Even 53$:.Asciz "" ; .Even 54$:.Ascii .Even 55$:.Ascii " |" .Even 56$:.Ascii "|" .Even 57$:.Asciz "|" ; .Even 58$:.Ascii "+" .Even 59$:.Ascii "-------+" .Even ;;;60$:.Ascii " | " .Even 61$:.Ascii ; VT62 select reverse video .Even 62$:.Ascii ; VT62 select normal video .Even .EndC; NE VT52$ .If NE SL$MLO 64$:.Ascii "GET OLD" .Even 67$:.Ascii "GET NEW" .Even 68$:.Ascii " CYCLE " .Even 69$:.Ascii "SET CYC" .Even .EndC; NE SL$MLO 72$: .Ascii /#5/ ; single width/height .Even 76$: .Byte SI .Ascii /For more information,/ .Even 78$: .Byte SI .Ascii /type HELP SL/ .Even 79$: .Ascii / .Even 81$: .Ascii /S>/ .Even 82$: .Ascii /X>/ .Even 84$: .Ascii " UNSAVE" .Even .If NE VT52$ .SbTtl VT52 large help display ; +-------+ +-------+-------+-------+-------+ ; | SWAP | | | |DEL LIN|GET OLD| ; |BACK SP| | GOLD | HELP | | ^ | ; |UNSWAP | | | |UNDEL L| OLDER | ; +-------+ +-------+-------+-------+-------+ ; |DEL CHR| |GET SAV| ; |Delete | | v | ; |UNDEL C| | SAVE | ;+-------+-------+-------+ +-------+ +-------+ ;|REFRESH|REFRESH|DEL LIN| |RETURN | |RIGHT C| ;|Ctrl/W |Ctrl/R |Ctrl/U | |RETURN | | ---> | ;| | |UNDEL L| | TRUNC | | END | ;+-------+-------+-------+ +-------+ +-------+ ; |LEFT C | ; | <--- | ; | BEGIN | ; +-------+ ; H52Msg: T 52$ T <4>,22$,58$,59$,23$,58$,<4>,59$,53$ T <4>,22$,56$,39$,56$,23$,56$,61$,19$,62$,56$,55$,30$,56$,24$,57$ T <4>,22$,56$,40$,56$,23$,56$,61$,34$,62$,56$,35$,56$,55$,31$,57$ .If NE SL$MLO T <4>,22$,56$,61$,41$,62$,56$,23$,56$,61$,19$,62$,56$,55$,61$,38$,62$,56$,61$,68$,62$,57$ .IfF; NE SL$MLO T <4>,22$,56$,61$,41$,62$,56$,23$,56$,61$,19$,62$,56$,55$,61$,38$,62$,56$,61$,245$,62$,57$ .EndC; NE SL$MLO T <4>,22$,58$,59$,23$,58$,<4>,59$,53$ T <4>,22$,56$,45$,56$,23$,<3>,22$,56$,27$,56$,53$ T <4>,22$,56$,49$,56$,23$,<3>,22$,56$,26$,56$,53$ .If NE SL$MLO T <4>,22$,56$,61$,51$,62$,56$,23$,<3>,22$,56$,61$,69$,62$,56$,53$ .IfF; NE SL$MLO T <4>,22$,56$,61$,51$,62$,56$,23$,<3>,22$,56$,61$,25$,62$,56$,53$ .EndC; NE SL$MLO T 58$,<3>,59$,19$,58$,59$,23$,<3>,22$,58$,59$,53$ T 56$,42$,56$,42$,56$,43$,56$,55$,44$,56$,23$,<3>,22$,56$,29$,57$ T 56$,46$,56$,47$,56$,48$,56$,55$,44$,56$,23$,<3>,22$,56$,33$,57$ T 56$,55$,55$,61$,38$,62$,56$,55$,61$,50$,62$,56$,23$,<3>,22$,56$,61$,37$,62$,57$ T 58$,<3>,59$,19$,58$,59$,23$,<3>,22$,58$,59$,53$ T <8.>,22$,20$,56$,28$,57$ T <8.>,22$,20$,56$,32$,57$ T <8.>,22$,20$,56$,61$,36$,62$,57$ T <8.>,22$,20$,58$,59$,54$ .Byte 000 .EndC; NE VT52$ .EndC ;NE HelpB$ .SbTtl Messages .If EQ HelpB$ H52Msg: HlpMsg: .Ascii "See System User's Guide and Release Notes for help with SL" .EndC ;EQ HelpB$ BolMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-At left margin now" EolMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-At right margin now" DelMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-Nothing to undelete" CmdMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "W-Unsupported command" InsMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "W-No room to insert" EscMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "W-Invalid key" CtlMsg: .NLCSI PART=PREFIX,TYPE=I .Ascii "W-Invalid control char" CtZMsg: .Ascii "^Z" CtCMsg: .Ascii "^C" NulMsg: .Ascii ;*2* used to .Print CRLF PrmMsg: .Ascii ;*2* default prompt .If NE VT102$ IRMSM: .Ascii IRMRM: .Ascii .EndC ;NE VT102$ .Even Messag: .If NE VT100$!VT102$ HlpCod =: .-Messag ; no error, show help .Word HlpMsg-Messag .EndC ;NE VT100$!VT102$ .If NE VT52$ ;HelpB$&VT52$ H52Cod =: .-Messag ; help for VT52 .Word H52Msg-Messag .EndC ;NE VT52$ ;HelpB$&VT52$ CmdCod =: .-Messag ; unsupported command .Word CmdMsg-Messag BolCod =: .-Messag ; at BOL (for ^U DEL ...) .Word BolMsg-Messag DelCod =: .-Messag ; no deleted char to undelete .Word DelMsg-Messag InsCod =: .-Messag ; no room for insert .Word InsMsg-Messag EscCod =: .-Messag ; Illegal function .Word EscMsg-Messag CtlCod =: .-Messag ; Illegal char .Word CtlMsg-Messag EolCod =: .-Messag ; At EOL (for Right ...) .Word EolMsg-Messag .If NE MMg$t OldBase:.Word SLBase ; relocation bias save word $Rel .-2 SLBase SLR .Restore ;***************************************************************************** .EndC; NE MMg$t .SbTtl Initialization, one-time code .SbTtl ** in IMPURE AREA BUFFER ** .Enable LSB ; ; R0 -- work register ; R1 -- work register ; R2 -- SLBASE value ; R3 -- RMON base ; R4 -- reserved ; R5 -- reserved ; AImpTb: .Word ImpTab ; address of impure pointer table $Rel .-2 ImpTab SL ; placed here to be relocated Init: .Assume SLBase EQ ...1st .Assume NOP EQ 240 Mov #Nop,-(R2) ; replace JSR R2,Init Mov #Nop,-(R2) ; with Nop Nop ; ; R2 now points to SLBase ; ; and to place to return to Jsr R5,SaveR ; save registers Mov @#$SYPTR,R3 ; point to RMON .If NE MMg$t ;***NOTE: This code is essentially duplicated in OVRINS:, change it there ; if it changes here! Mov MemPtr(R3),R0 ; get offset to memory tables **GVAL** Add R3,R0 ; get real address Mov R3,R1 ; copy pointer Add CorPtX(R0),R1 ; get address of extended ALLOC **PEEK** 10$: Cmp #-1,(R1)+ ; look for end of free list Bne 10$ ; loop until found ; R1 now points to handler RCBs 20$: ; look for an empty one ;>>>??? Cmp #-1,@R1 ; end of list? ;>>>??? Beq InsNo0 ; yes, failure ;>>> What's to do? Cmp GR.Nam(R1),(PC)+ ; is it ours? .RModule ; our name Bne 25$ ; no, try next Cmp GR.Nam+2(R1),#<^r$ > ; second word right? Beq 30$ ; yes, then it is our name 25$: Add #GR.Esz,R1 ; point to next Br 20$ ; keep trying .......... 30$: Mov GR.Adr(R1),P1New ; save the value for mapping PAR1 Call MapX .EndC; NE MMg$t RM.Did = 1 .Rept RM.Cnt .Irp x <\RM.Did> Add R3,RM.'x ; relocate using RMon as base .EndR RM.Did = RM.Did+1 .EndR ;NOTE: the following is duplicated in the INSTALL overlay for XM ; If you change it here, change it there too! .If EQ MMg$t RMX.Did = 1 .Rept RMX.Cnt .Irp x <\RMX.Did> Add R3,@#RMX.'x ; relocate using RMon as base .If NE MMg$t $Rel .-2 RMX.'x SLX .EndC; NE MMg$t .EndR RMX.Did = RMX.Did+1 .EndR Mov R3,AEMT16 ; calculate real address Add EMT16(R3),AEMT16 ; of EMT16 list **GVAL** .EndC; EQ MMg$t Mov R3,R1 ; copy RMON pointer Add EmtRtn(R3),R1 ; calculate real address **GVAL** Mov R1,EmtX ; put in JMP instruction Jsr R0,40$ ; point to LD relocation list **PIC** ................... ; never returns, R0 pointed to table SL.Did = 1 SL.Lst: .Rept SL.Cnt .Irp x <\Sl.Did> ;;;.IIf EQ SL.'x-SlBase .Error ; SL.'x was zero ; .Word SL.'x-SlBase .EndR SL.Did = SL.Did+1 .EndR .Word 000000 ; end of list SLR.Did = 1 SLR.Lst: .Rept SLR.Cnt .Irp x <\SLR.Did> .Word SLR.'x $Rel .-2 SLR.'x SLX .EndR SLR.Did = SLR.Did+1 .EndR .Word 000000 ; end of list 40$: 50$: Mov (R0)+,R1 ; get next reloc list entry Beq 60$ ; done this list Add R2,R1 ; real address to locate Add R2,@R1 ; relocate value in address Br 50$ ; and do next .......... 60$: .If NE MMg$t Sub @#OldBase,R2 ; remove bias from last $Rel .-2 OldBase SLX ; (if any) relocation of the ; SLR list. .EndC; NE MMg$t 70$: Mov (R0)+,R1 ; get next reloc list entry Beq 80$ ; done this list Add R2,@R1 ; relocate value in address Br 70$ ; and do next .......... 80$: .Assume SLBUF+<2*Job$> LT . Mov AImpTb,R0 ; point to table Mov #Job$,R1 ; size of table 90$: Clr (R0)+ ; clear the impure pointer table Sob R1,90$ ; all of it .if NE FunKey Mov $CNFG2(R3),R0 ;Get configuration word for BUS check Bic #^c,R0 ;Isolate bus bits Cmp #,R0 ;CTI? ; Change next instruction to BR 95$ to defeat ..SLFK::Bne 95$ ; branch if not. Otherwise, if PRO, .if NE MMG$T ; (XM vs FB necessary; $REL done above MovB dLet,@#ProKey ; and SET SL LET, then use FUNC KEYs $Rel .-2 ProKey SLX .ifF; NE MMG$T MovB dLet,ProKey ; and SET SL LET, then use FUNC KEYs .EndC; NE MMG$T 95$: .EndC; NE FunKey .If EQ MMg$t CMPB #1,$JOBS(R3) ; Single-background monitor? BNE 100$ ; BR if not SB/XB/ZB. .Assume Clr EQ 005000 Mov #Clr+5,GetJob ; else substitute SB code (Clr R5) .Assume Nop EQ 000240 Mov #Nop,R0 ; load NOP instruction Mov R0,GetJob+2 ; and NOP .Addr #BatRn1,R1 ; point to instructions to zap **PIC** .Rept BatRn2-BatRn1/2 Mov R0,(R1)+ .EndR Add #BatRn3-BatRn2,R1 ; and point to second group **PIC** .Rept BatRn4-BatRn3/2 Mov R0,(R1)+ .EndR 100$: .IfF; EQ MMg$t .Addr #$RLPTR,R0 ; point to $RLPtr vector position**PIC** Mov R0,R1 ; copy it Cmp (R1)+,(R1)+ ; offset it by 2 words Mov $SYSGE(R3),R2 ; get sysgen bits **GVAL** Bic #^c,R2 ; clear all but Error log and timeout Beq 110$ ; neither set Cmp #ErLg$!Timit$,R2 ; both set? Beq 120$ ; yes, nothing to do ; Else 1 set Tst -(R1) ; change offset to 1 word 110$: ; adjust pointers .Rept 5 ; move the 5 XM pointers Mov (R1)+,(R0)+ .EndR 120$: Mov P1Ext(R3),R0 ; set up address of P1Ext Mov R0,P1Ext1 Mov R0,@#P1Ext2 $Rel .-2 P1Ext2 SLX .If NE SL$CLO Mov R0,@#P1Ext3 $Rel .-2 P1Ext3 SLX .EndC; NE SL$CLO .EndC; EQ MMg$t .IF NE VTxxx$ .Addr #Set52,R0 ; assume it is a VT52 .Assume VT.52 LT 0 TstB dVT100 ; what kind of terminal? Bmi 125$ ; VT52 .Addr #Set100,R0 ; assume VT100 .IF NE VT102$ CmpB #VT.200,dVT100 ; is it a VT200? Bne 125$ ; no .Addr #SetLv1,R0 ; set to 7 bit controls .ENDC; NE VT102$ .IFF; NE VTxxx$ .IF NE VT100$ .Addr #Set100,R0 ; set for VT100 .ENDC; NE VT100$ .IF NE VT102$ .Addr #SetLv1,R0 ; set to 7 bit controls .ENDC; NE VT102$ .ENDC; NE VTxxx$ 125$: .Print 130$: Pop R0 ; restore R0 from JSR R0, ... .IrpC x,<012345> ; restore from SaveR Pop R'x .EndR .If NE MMg$t Call UnMapX .EndC; NE MMg$t Rts R2 ; start again after initialization .......... Set52: .Ascii .Ascii .Ascii Set100: .Ascii .Ascii SetLv1: .Ascii ;;; .Ascii .Ascii /[62;1"p/ ; VT200 mode, 7-bit .Ascii InitSz ==: .-Init ; size of one time code InitHi: .SbTtl IMPURE - data area .Enable LSB .=Init SLBuf: ImpTab: .BlkW Job$ ; one entry for each supported job .Even ImpLow: .If EQ SL$HBF ; Buffers are in IMPURE area .If EQ SL$MLO NumBuf = 5 ; (Line BUFFER, OLDBUF, OLDRBF, DELBUF, SAVBUF) OldSiz = 0 ; No explicit Multi-old save buffer (old SL style) .IfF; EQ SL$MLO ; (This is basically for SJ/FB with Multi-Old Buffer Support) NumBuf = 3 ; (Line BUFFER, DELBUF, SAVBUF) OldSiz = OldBSz ; Multi-old save buffer size .EndC; EQ SL$MLO .IfF; EQ SL$HBF ; Line Buf$er is in IMPURE area, but ; DELBUF, SAVBUF, and OLDBUFs are in separate area, High Memory for XM NumBuf = 1 ; (Line BUFFER) OldSiz = 0 ; Multi-old save buffer size .EndC; EQ SL$HBF Impure: .BlkB OverHd+ProSiz+>+OldSiz+1 .Even ImpHi: SLBfSz ==: .-SLBuf ; size of buffer area in SL .IIf LT SLBfSz-InitSz .=InitHi ; overlay Init and Buffers .If NE Let$ .SbTtl LET Data area LetImp: LetLo: .Rad50 "SLL" ; SL LE table indicator .Byte LetNo$,LetSz$+1 LetSym: .BlkB LetNo$ ; LET symbol names LetVal: .BlkB LetNo$* ; LET symbol values .Even LetHi: .EndC; NE Let$ .DrEnd SL,FORCE=ErLg$!Timit$ .=. .SbTtl ***************************************** .SbTtl * Set Command Overlay(s) * .SbTtl ***************************************** .SbTtl OvrBk0 -- overlay block number zero ;***************************************************************************** .PSect SetOvr ; this PSect must be block aligned OvrBk0: ; base for this overlay .SbTtl OvrOff -- SET SL OFF overlay code .Enable LSB OvrOff: Mov SP,Ovr0SP ; save for error recovery Mov @#$SYPTR,R0 ; point to RMON Bic #SLKMo$!SLEdi$,$CNFG1(R0) ; Clear the SLEdi$ and SLKMo$ bits in CONFIG **PVAL** Tst OValid ; old TTCnfg value valid? Boff 10$ ; no Mov $TCFig(R0),R0 ; load address of TTCnfg **GVAL** Bis OTTCnf,@R0 ; restore old CLRF$ value **PEEK/POKE** Clr OValid ; and indicate no longer valid Call OWrite ; copy this block back to file 10$: Jsr R0,20$ ; point to message **PIC** .If NE VT100$!VT102$ .Ascii .Ascii "24" .EndC; NE VT100$!VT102$ .If NE VT52$ .Ascii ; release any screen hold on VT52 .IfF; NE VT52$ .Ascii .EndC; NE VT52$ .Even 20$: .If NE VTXXX$ .Assume VT.52 LT 0 TstB oVT100+ ; is this a VT52? Bmi 30$ ; yes, then don't print .IfTF; NE VTXXX$ .Print .IfT; NE VTXXX$ 30$: .EndC; NE VTXXX$ Pop R0 ; restore register and stack Br UnLdSL ; then Unload it .............. .Disable LSB .SbTtl OvrOn -- SET SL ON overlay code .Enable LSB OvrOn: Mov SP,Ovr0SP ; save for error recovery Call DStat ; are we loaded? Bcs OvrErr ; can't find out Beq LoadSL ; Not loaded, load, try again Call TTFix ; set NOCRLF and unhold a VT52 Mov #Conn$S,SpFCod ; connect request Call SpFun ; do it Bcs OvrErr ; failed Mov @#$SYPTR,R0 ; point to RMON Bis #SLEdi$,$CNFG1(R0) ; set the SLEdi$ bit in CONFIG **PVAL** Bic #SLKMo$,$CNFG1(R0) ; clear the KMON use SL bit **PVAL** Br OvrOk ; worked ............. .Disable LSB .SbTtl OvrKMo -- SET SL KMON overlay code .Enable LSB OvrKMo: Mov SP,Ovr0SP ; save for error recovery Call DStat ; are we loaded? Bcs OvrErr ; can't find out Beq LoadSK ; Not loaded, load, try again (KMON) Call TTFix ; set NOCRLF and unhold a VT52 Mov #Conn$S,SpFCod ; connect request Call SpFun ; do it Bcs OvrErr ; failed Mov @#$SYPTR,R0 ; point to RMON Bic #SLEdi$,$CNFG1(R0) ; Clr the SLEdi$ bit in CONFIG **PVAL** Bis #SLKMo$,$CNFG1(R0) ; set the KMON use SL bit **PVAL** Br OvrOk ; worked ............. .Disable LSB .SbTtl TTFix -- fix terminal characteristics TTFix: Mov @#$SYPTR,R0 ; point to RMON Mov $TCFig(R0),R0 ; load address of TTCnfg **GVAL** Mov SP,OValid ; indicate old TTCnfg value valid Mov @R0,OTTCnf ; save old value **PEEK** Bic #^cCrLf$,OTTCnf ; just crlf bit Bic #CrLf$,@R0 ;clear SET TERM CRLF **PEEK/POKE** Call OWrite ; copy this block back to the file .If NE VT52$ Jsr R0,10$ ; point to message **PIC** .Ascii ; release any screen hold on VT52 .Even 10$: .Print Pop R0 ; restore register and stack .EndC; NE VT52$ Return ...... .SbTtl UnLdSL -- issue UNLOAD SL command .Enable LSB UnLdSL: Call DStat ; are we loaded? Bcs OvrErr ; can't find out Beq OvrOk ; not loaded, done Mov #Disc$S,SpFCod ; disconnect request Call SpFun ; do it Bcs OvrErr ; failed Mov #UnLdS3/2,R3 ; point to overlay routine Br GetOv0 ; join common code .............. .Disable LSB LoadSK: Mov #LoadK3/2,R3 ; point to LOAD/SET KMON Br GetOv0 ; join common code LoadSL: Mov #LoadS3/2,R3 ; point to overlay routine .Br GetOv0 ; join common code GetOv0: Jmp GetOvr+ ; go to GetOvr code to do it .............................. .SbTtl OvrOk -- normal exit to set code .Enable LSB OvrOk: Mov #SetOk/2,R3 ; return to SetOk code after reloading ; SLStrt block Jmp FakOvr+ ; go to GetOvr code second entry .............................. .Disable LSB .SbTtl OvrErr -- error exit to set code .Enable LSB OvrErr: Jmp SetErr+ ; got to error code .............................. .Disable LSB .SbTtl OWrite -- write overlay to file .Enable LSB .SbTtl OWrite -- write overlay to file .Enable LSB OWrite: ; write this block back to the file Mov ReaBlk+,WriBlk ; select this block Mov ReaBuf+,WriBuf ; and this aera Call OWritn ; and write it Clr WriBlk ; select first block .Addr #OvrBk0-Blk,R5,PUSH ; == Push R5/ ADDR SLStrt **PIC** ;Note: figure this out later Mov R5,WriBuf ; set address of write buffer Pop R5 ; restore work register OWritn: ; do a block write Jsr R0,20$ ; save R0, and point to arg block **PIC** .Byte SysChn ; channel .Byte .Write ; request code WriBlk: .BlkW 1 ; block number to write WriBuf: .BlkW 1 ; buffer address to write from .Word Blk/2 ; words to write .Word 0 ; .WritW 20$: .WritC Code=NOSET ; do the write ; This is really a .WRITW Pop R0,Save=Carry ;*C* restore saved register Bcs OvrWL0 ; overlay write failed Return ; done ...... OvrWL0: Mov (PC)+,SP ; realign stack Ovr0SP: .BlkW 1 ; saved stack pointer Jmp SYWLOv+ ; do a writelocked error exit .Disable LSB .SbTtl SpFun -- do an SpFun on SL .Enable LSB SpFun: .Addr #Physical+1,R0 ; point to return +1 **PIC** Mov R0,XWord ; update request block .Purge #0 ; close the channel, just in case Jsr R0,10$ ; point to EMT arguments **PIC** .Byte WrkChn,.Enter ; enter SL on the work channel EnDBlk: .BlkW 1 ; address of DBLK .Word 0 ; length .Word 0 ; SeqNum XWord: .BlkW 1 ; bypass logical translation 10$: Jsr R5,20$ ; point to DBLOCK **PIC** .RModule ; our Rad50 name .Rad50 " " ; non-file structured 20$: Inc R5 ; make odd to cause look at 4th word Mov R5,EnDBlk ; put in argument block Pop R5 ; restore R5 .Assume WrkChn EQ 0 .Enter Code=NOSET ; open the SL handler Pop R0,Save=Carry ;*C* restore R0 Bcs 40$ ; failed Jsr R0,30$ ; point to EMT arguments **PIC** .Byte WrkChn,.SpFun ; do an .SpFun to SL SpFCod: .BlkW 1 ; subcode (block number) .Word 0 ; no buffer .Word 0 ; no word count .Byte 377 ; SPFUN marker .Byte Upd$Fn ; Update function .Word 0 ; ".SpFunW" 30$: .SpFun Code=NOSET ; tell the handler to disconnect Pop R0,Save=Carry ;*C* restore R0 Bcs 40$ ; failed .Assume WrkChn EQ 0 .Purge #0 ; purge the channel 40$: 50$: Return ...... Physical =: 50$+1 ; address of RETURN + 1 .Disable LSB .SbTtl SET Support Routines (continued) .SbTtl Dstat of BA says BA is LOADED .Enable LSB 50$: Pop R2 Jsr R0,60$ ; Tell user to unload BA .Asciz /?SL-F-Unload BA/ .Even 60$: .Print Pop R0 ; Recover R0 Tst (SP)+ ; Eat DSTAT's return, and CLC Br OvrOk ; and return to KMON. ...... .SbTtl DStat -- Do a DStat on SL DStat: ; do a DStat on ourselves Jsr R2,10$ ; point to return area **PIC** Status: .BlkW 1 ; status word .BlkW 1 ; handler size LoadAd: .BlkW 1 ; load address .BlkW 1 ; device size 10$: Inc R2 ; make odd to bypass logicals Jsr R0,20$ ; point to name **PIC** .RAD50 /BA/ ; BA's handler name 20$: .DStat R2,R0 ; get info about BA Pop R0 ; restore r0 Bcs 22$ ; branch if BA not installed. Tst LoadAd ; is BA loaded? Bne 50$ ; Get out now if BA is loaded 22$: Jsr R0,25$ ; point to name **PIC** .RModule ; SL's handler name 25$: .DStat R2,R0 ; get info about SL Pop R0 ; restore r0 Pop R2 ; restore R2 Bcs 30$ ; error Cmp #SlSts,Status ; is it us? Bne 30$ ; no Tst LoadAd ; is it loaded (Z=no) Br 40$ ; no carry set 30$: Sec ; error 40$: Return ...... .Disable LSB OValid: .Word 0 ; indicate next word not valid OTTCnf: .BlkW 1 ; old TTCnfg value .Assume . LE Blk+OvrBk0 .SbTtl OvrBk1 -- Set overlay block one .=:OvrBk0+Blk OvrBk1: .SbTtl OvrAsk -- SET SL ASK overlay code ;Note:***WARNING LdAddr always modifies R0*** .Macro LdAddr Locn,Dst ; **PIC** .NType .....1,Locn .IIf NE .....1-27 .Error .....1;Wrong mode for L O C N --"LOCN"; Tst Locn-Base1 .=.-4 Jsr R1,@R3 .=.+2 .If DIF , .NType .....1,Dst .If EQ <.....1&7>-<1> .Error .....1;R1 can not be referenced in D S T--"DST"; .IfF; EQ <.....1&7>-<1> .If EQ <.....1&7>-<6> .Error .....1;SP can not be referenced in D S T--"DST"; .IfF; EQ <.....1&7>-<6> Mov R0,Dst .EndC;EQ <.....1&7>-<6> .EndC; EQ <.....1&7>-<1> .EndC; DIF , .EndM LdAddr .Enable LSB OvrAsk: Br 10$ ; skip relocation routine ........... .Assume OvrBk1+2 EQ Base1 Base1: ; base address of OvrBk1+2 LdAddr: Mov R3,R0 ; copy base address Add (R1)+,R0 ; add in offset Rts R1 ; and return .......... TimOut: ; marktime completion routine Inc TimFlg ; set flag to indicate timed out Return ; 1 is first timeout, 2 is second... ...... 10$: Mov SP,#.-. ; save old SP OldSP =: .-2 Tst (R3)+ ; change address of OvrBk1 to Base1 Mov @#$JSW,#.-. ; save old JSW OldJSW =: .-2 Bis #Edit$!TcBit$!TtSpc$!TtLC$,@#$JSW ; LC, Char mode, no edit, no wait .RCtrlO ; sync terminal mode LdAddr #AskDA,R0 ; point to request device attributes msg .Print ; print it LdAddr #TimReq,R0 ; point to time request block Push R0 ; save address for later Mov R0,R2 ; and for use now Tst (R2)+ ; skip code word .Assume TimReq+2 EQ Time LdAddr #Ticks,(R2)+ ; put in Ticks address .Assume Time+2 EQ CRtn LdAddr #TimOut,(R2)+ ; and completion routine addres Pop R0 ; point to request again .MrkT CODE=NoSet ; set up time out routine AskESC: Call GetC ; get a character w/o waiting Br AskESC ; ESC, try again .............. AskCSI: ; ESC Call GetC ; Got ESC, try for second char CmpB #,R0 ; HACK for VT220 (233 not 033 133) Beq AskP1 ; HACK CmpB #,R0 ; is it intermediate for VTxx? Beq AskVTx ; yes, try for final char CmpB #,R0 ; is it the ANSI CSI? Bne AskESC ; no, start over AskDEC: ; ESC CSI Call GetC ; get next char CmpB #,R0 ; is it the "private" indicator? Bne AskESC ; no, start over AskP1: ; ESC CSI DEC Jsr R1,AskNum ; check for a numeric value **PIC** Parm1: .Word .-. Bne AskESC ; unexpected char, start over AskP2: ; ESC CSI DEC nnn ; Jsr R1,AskNum ; check for a numeric value **PIC** Parm2: .Word .-. Bne AskESC ; unexpected char, start over AskEAT: ; ESC CSI DEC nnn ; nnn ; Call GetC ; get a char Bne AskEAT ; no, keep looking AskFin: ; finished Mov Parm1,R0 ; load first parm value Cmp #MaxId,R0 ; within range? Bhis Force ; yes Cmp R0,#61. ; Class 1? Blo AskRng ; lower Cmp R0,#64. ; Class 4? Bhi AskRng ; higher than VT400? Sub #61.-CodLv1,R0 ; go to end of table entries Br Force ; join common code AskRng: ; value out of range .Assume UnkEnt EQ 0 Clr R0 ; no, use bad code value Force: Cmp #1,TimFlg ; is this the first timeout? Beq AskOld ; yes ; else ESC OLDDA failed too Asl R0 ; make into word index .Addr #AskTab,R0,ADD ; index into table **PIC** TablLd: Push R0 ; save R0 LdAddr #CanReq,R0 ; point to request block .CMkT ,ID=,TIME=,CODE=NoSet ; cancel any marktime request Pop R0 ; restore R0 MovB 1(R0),R3 ; copy support part .If NE EIS$I Ash #-4,R3 ; shift down 4 positions .IfF; NE EIS$I Asr R3 ; shift down 4 positions Asr R3 Asr R3 Asr R3 .EndC; NE EIS$I Bic #^c<16>,R3 ; clear junk bits ;NOTE "16" is Support/10000 .Addr #OvrTab,R3,ADD ; index into table **PIC** Mov @R3,R3 ; get overlay address Mov @R0,R0 ; get message offset Bic #Support,R0 ; clear support flags from message ptr Mov Parm2,R1 ; pass Parm2 to overlay Mov OldJSW,@#$JSW ; and restore JSW .RCtrlO ; sync terminal mode Jmp GetOvr+ ; go to it thru the "overlay" .............................. .Disable LSB .Enable LSB AskOld: LdAddr #AskODA,R0 ; point to Old DA request .Print LdAddr #TimReq,R0 ; point to request area again .MrkT Code=NoSet ; and start time out again Dec TimTst ; change test value to 177776 ; so that TimFlg=1 is NOT timeout ; but TimFlg=2 is. Br AskEsc .............. AskVTx: Call GetC ; get final char Sub #MinLtr,R0 ; remove bias Bmi AskRng ; unknown type CmpB #MaxLtr,R0 ; too high? Blo AskRng ; unknown type Asl R0 ; make into a word index .Addr #Tab52,R0,ADD ; index into table **PIC** Br TablLd ; join common code .............. .Disable LSB .Enable LSB GetC: 10$: .TTInR Bit #177777,#.-. ;*C* timed out? TimTst =: .-4 TimFlg =: .-2 Bne 20$ ; yes Bcs 10$ ; no, but no char either CmpB #,R0 ; compare with ESC Beq 30$ CmpB #,R0 ; final char? (set CondCode) Return ...... 20$: Sec ; timed out, set carry 30$: Mov OldSP,SP ; restore stack Bcc AskCSI ; got ESC .Br NoResp NoResp: Mov #NoREnt,R0 ; force to timed-out Br Force ............. .Disable LSB .Enable LSB AskNum: 10$: Tst (R1)+ ; assume exit Call GetC ; get a char Beq 20$ ; found final char CmpB #<'0>,R0 ; is it a number? Bhi 30$ ; no CmpB #<'9>,R0 ; final check Blo 30$ ; no Bic #^c377,R0 ; clear any junk Sub #<'0>,R0 ; convert to a number Push -(R1) ; save a copy of old value Asl @R1 ; *2 Asl @R1 ; *4 Add (SP)+,@R1 ; *5 Asl @R1 ; *10 Add R0,@R1 ; +n Br 10$ ; and try again ........... 20$: Mov OldSP,SP ; restore stack Br AskFin ; and process end of sequence .............. 30$: CmpB #,R0 ; is it the parm separator? Rts R1 .......... .Disable LSB TimReq: .Word .MrkT ; .MrkT request block Time: .BlkW 1 ; pointer to time CRtn: .BlkW 1 ; pointer to routine ;Note: first word of CanReq is used as ID value for TimReq CanReq: .Word .CMkT ; .CMkT request block ;NOTE: first word of time must be 0 and is used by CanReq as 0 id Ticks: .Word 0,1*60. ; 1 60Hz second (1.2 50Hz) AskDA: .Ascii AskODA: .Ascii ; release any VT52 screen hold .Ascii ; and ask for ID .Even sVT52 =: 000000 ; supported as VT52 sVT100 =: 020000 ; supported as VT100 sVT102 =: 040000 ; supported as VT102 sVT0r2 =: 060000 ; supported as VT100 or VT102 UnKnow =: 100000 ; unknown terminal response UnSupp =: 120000 ; unsupported terminal response TimedO =: 140000 ; no response (timed out) sVT200 =: 160000 ; supported as VT200 Support =: 160000 ; mask for these codes (above) OvrTab: .Assume sVT52 EQ <<.-OvrTab>*10000> .If NE VT52$ .Word Ask52/2 ; supported as VT52 .IfF; NE VT52$ .Word AskUn2/2 ; unsupported .EndC; NE VT52$ .Assume sVT100 EQ <<.-OvrTab>*10000> .If NE VT100$ .Word Ask100/2 ; supported as VT100 .IfF; NE VT100$ .Word AskUn2/2 ; unsupported .EndC; NE VT100$ .Assume sVT102 EQ <<.-OvrTab>*10000> .If NE VT102$ .Word Ask102/2 ; supported as VT102 .IfF; NE VT102$ .If NE VT100$ .Word Ask100/2 ; supported as VT100 .IfF; NE VT100$ .Word AskUn2/2 ; unsupported .EndC; NE VT100$ .EndC; NE VT102$ .Assume sVT0r2 EQ <<.-OvrTab>*10000> .If NE VT100$&VT102$ .Word Ask0r2/2 ; supported as VT100 or VT102 (Parm2>=8.) .IfF; NE VT100$&VT102$ .If NE VT102$ .Word Ask0r2/2 ; supported as VT102 or unsupported (Parm2>=8.) .IfF; NE VT102$ .If NE VT100$ .Word Ask100/2 ; supported as VT100 .IfF; NE VT100$ .Word AskUn2/2 ; unsupported .EndC;NE VT100$ .EndC; NE VT102$ .EndC; NE VT100$&VT102$ .Assume UnKnow EQ <<.-OvrTab>*10000> .Word AskUnk/2 .Assume UnSupp EQ <<.-OvrTab>*10000> .Word AskUn2/2 .Assume TimedO EQ <<.-OvrTab>*10000> .Word AskNoR/2 ;;;>>>??? .Assume sVT200 EQ <<.-OvrTab>*10000> .If NE VT100$&VT102$ .Word Ask200/2 ; supported as VT102 .IfF; NE VT100$&VT102$ .If NE VT102$ .Word Ask200/2 ; supported as VT102 .IfF; NE VT102$ .If NE VT100$ .Word Ask100/2 ; supported as VT100 .IfF; NE VT100$ .Word AskUn2/2 ; unsupported .EndC;NE VT100$ .EndC; NE VT102$ .EndC; NE VT100$&VT102$ NorXXX: ; timed out before response .Word TimedO! AskTab: NoREnt =:NorXXX-AskTab/2 UnkEnt =:.-AskTab/2 ; ESC CSI DEC 0 ; ... DA .Word UnKnow! ; unknown type (loopback???) ; ESC CSI DEC 1 ; ... DA .Word sVT0r2! ; VT100 (may be supported as VT102) ; ESC CSI DEC 2 ; ... DA .Word UnSupp! ; LA120 -- unsupported ; ESC CSI DEC 3 ; ... DA .Word UnSupp! ; LA34/38 -- Unsupported ; ESC CSI DEC 4 ; ... DA .Word sVT102! ; VT132 -- supported as VT102 ; ESC CSI DEC 5 ; ... DA .Word UnSupp! ; VK100 -- unsupported ; NOTE: 5;2 is VT100J??? ; ESC CSI DEC 6 DA .Word sVT102! ; VT102 -- VT102 ; ESC CSI DEC 7 DA .Word sVT102! ; VT131 -- supported as VT102 ; ESC CSI DEC 8 DA .Word UnSupp! ; VT278 -- unsupported ; ESC CSI DEC 9 DA .Word UnSupp! ; LQPSE-F -- unsupported ; ESC CSI DEC 10 DA .Word UnSupp! ; LA100 -- unsupported ; ESC CSI DEC 11 DA .Word UnSupp! ; LA120"J" -- unsupported ; ESC CSI DEC 12 DA .Word sVT100! ; VT125 -- supported as VT100 ; ESC CSI DEC 13 DA .Word UnSupp! ; LQP02 -- unsupported ; ESC CSI DEC 14 DA .Word UnSupp! ; LA12 -- unsupported ; ESC CSI DEC 15 DA .Word UnSupp! ; VT102J -- unsupported MaxId =: <.-AskTab/2>-1 ; ESC CSI DEC 61 DA .Word sVT100! ; PRO350, VT220 ... CodLv1 =: <.-AskTab/2>-1 ; ESC CSI DEC 62 DA .Word sVT200! ; VT220 VT240 VT241 ... ; ESC CSI DEC 63 DA .Word sVT200! ; VT3xx ... ; ESC CSI DEC 64 DA .Word sVT200! ; VT4xx ... Tab52: ;------------ Removed to create space in this overlay block ---------- ; for V5.5 ;MinLtr =: 'A ; .Word UnSupp! ; ESC / A VT50 ; .Word UnSupp! ; ESC / B VT50 w/copier ; .Word sVT52! ; ESC / C VT55 UC ; .Word UnKnow! ; ESC / D unassigned ; .Word sVT52! ; ESC / E VT55 UC/LC ; .Word UnKnow! ; ESC / F unassigned ; .Word UnKnow! ; ESC / G unassigned ; .Word UnSupp! ; ESC / H VT50H ; .Word UnKnow! ; ESC / I unassigned ; .Word UnSupp! ; ESC / J VT50H w/copier ;--------------------------------------------------------------------- MinLtr =: 'K .Word sVT52! ; ESC / K VT52 .Word sVT52! ; ESC / L VT52 w/copier .Word sVT52! ; ESC / M VT52 w/printer .Word UnKnow! ; ESC / N unassigned .Word UnKnow! ; ESC / O unassigned .Word UnKnow! ; ESC / P unassigned .Word UnSupp! ; ESC / Q VT52J 8 bit .Word UnSupp! ; ESC / R VT52J 7 bit .Word UnSupp! ; ESC / S VT52J 8 bit w/copier .Word UnSupp! ; ESC / T VT52J 7 bit w/copier .Word UnKnow! ; ESC / U unassigned .Word UnKnow! ; ESC / V unassigned .Word UnKnow! ; ESC / W unassigned .Word UnKnow! ; ESC / X unassigned .Word UnKnow! ; ESC / Y unassigned .Word sVT52! ; ESC / Z VT1__ running as VT52 .Word UnKnow! ; ESC / [ unassigned .Word UnKnow! ; ESC / \ unassigned .Word UnKnow! ; ESC / ] unassigned .Word UnKnow! ; ESC / ^ unassigned .Word UnKnow! ; ESC / _ unassigned .Word UnSupp! ; ESC / ` VT61 .Word UnSupp! ; ESC / a VT61 w/copier .Word UnSupp! ; ESC / b VT61 w/printer .Word UnSupp! ; ESC / c VT61 w/copier & printer MaxLtr =: 'c-MinLtr .Assume . LE Blk+OvrBk1 .SbTtl OvrBk2 -- Overlay block number two .=:OvrBk1+Blk OvrBk2: .Enable LSB .If NE VT52$ Ask52: .If NE VTxxx$ Push #VT.52*400!79. ; indicate VT52 with 79 char width .EndC; NE VTxxx$ Push R0 ; save real terminal string offset Mov #Typ52-MBase,R0 ; point to first part of message .If NE VT100$!VT102$ Mov #AskWid/2,R3 ; set width then type Br 20$ ........... .EndC; NE VT100$!VT102$ .EndC; NE VT52$ .If NE VT100$!VT102$ Ask0r2: .If NE VT102$ LPCode =: 8. ; bit added into 2nd parm for LP Cmp #LPCode,R1 ; is it a VT100 w/printer port? .EndC; NE VT102$ .If NE VT100$&VT102$ Blos Ask102 ; yes, then, treat as a VT102 .IfF; NE VT100$&VT102$ .If NE VT102$ Bhi AskUn2 ; no printer port, unsupported .EndC; NE VT102$ .EndC; NE VT100$&VT102$ .If NE VT100$ Ask100: .If NE VTxxx$ .Assume VT.100 EQ 0 Push #0 ; indicate VT100 .EndC; NE VTxxx$ Push R0 ; save real terminal string offset Mov #Typ100-MBase,R0 ; point to first part of message Br 10$ ........... .EndC; NE VT100$ .If NE VT102$ Ask200: .If NE VTxxx$ Push #VT.200 ; indicate VT200 Br 5$ ; join common code .EndC; NE VTxxx$ Ask102: .If NE VTxxx$ Push #VT.102 ; indicate VT102 .EndC; NE VTxxx$ 5$: Push R0 ; save real terminal string offset Mov #Typ102-MBase,R0 ; point to first part of message .ENDC; NE VT102$ 10$: Mov #AskTyp/2,R3 ; set up for restore of overlay 20$: Call AskPrt ; and print it Pop R0 ; get real terminal string offset Call AskPrt ; and print it .If NE VTxxx$ Pop R0 ; get terminal type .EndC; NE VTxxx$ Br FakOv2 ; go to it thru the "overlay" .............. .EndC; NE VT100$!VT102$ AskUn2: Push R0 ; save real terminal string offset Mov #UnsTyp-MBase,R0 ; point to first part of message Call AskPrt ; print it Pop R0 ; get offset to last part .Br AskNoR AskNoR: AskUnk: Call AskPrt ; print error message BisB #FATAL$,@#$USRRB ; set error code .Br Ovr2Ok .SbTtl OvrOk -- normal exit to set code .Enable LSB Ovr2Ok: Mov #SetOk/2,R3 ; return to SetOk code after reloading ; SLStrt block FakOv2: Jmp FakOvr+ ; go to GetOvr code second entry .............................. AskPrt: .Addr #MBase,R0,ADD ; calculate message address **PIC** .Print Return ...... .Disable LSB MBase: LA12.: .Asciz "LA12" LA100.: .Asciz "LA100" LA120.: .Asciz "LA120" LA348.: .Asciz "LA34/38" LQPSE.: .Asciz "LQPSE-F" LQP02.: .Asciz "LQP02" VK100.: .Asciz "VK100" VT50.: .Asciz "VT50" VT50H.: .Asciz "VT50H" VT52.: .Asciz "VT52" VT52J.: .Asciz "VT52J" VT55.: .Asciz "VT55" VT61.: .Asciz "VT61" VT100.: .Asciz "VT100" VT102.: .Asciz "VT102" VT102J: .Asciz "VT102J" VT125.: .Asciz "VT125" VT131.: .Asciz "VT131" VT132.: .Asciz "VT132" VT152.: .Asciz "VT1__ in VT52 mode" VT278.: .Asciz "VT278" Lvl1.: .Asciz "Generic VT100" Lvl2.: .Asciz "Generic VT200" Lvl3.: .Asciz "Generic VT300" Lvl4.: .Asciz "Generic VT400" NoRTyp: .NLCSI PART=PREFIX,TYPE=I .Asciz "F-no response to DA request" UnkTyp: .NLCSI PART=PREFIX,TYPE=I .Asciz "F-Unknown DA response" UnsTyp: .NLCSI PART=PREFIX,TYPE=I .Ascii "F-Unsupported device - " .If NE VT52$ Typ52: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-Supporting as a VT52, terminal is - " .EndC; NE VT52$ .If NE VT100$ Typ100: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-Supporting as a VT100, terminal is - " .EndC; NE VT100$ .If NE VT102$ Typ102: .NLCSI PART=PREFIX,TYPE=I .Ascii "I-Supporting as a VT102, terminal is - " .EndC; NE VT102$ .Even .Assume . LE Blk+OvrBk2 .SbTtl OvrBk3 -- overlay block number 3 .=:OvrBk2+Blk OvrBk3: .If NE VT100$!VT102$ .SbTtl OvrLea -- SET SL [NO]LEARN overlay code .Enable LSB OvrLea: .If NE VTXXX$ .Assume VT.52 LT 0 TstB oVT100+ ; is this a VT52? Bmi 10$ ; yes, then "you can't learn" ; can't teach an old terminal ; new tricks .... .EndC; NE VTXXX$ Mov #LeaMsg-OMsgBs,R3 ; assume LEARN Tst R0 ; is it Bon 20$ ; yes Mov #NLeMsg-OMsgBs,R3 ; no, then NOLEARN .If NE VTXXX$ Br 20$ ; join common print code ........... 10$: Mov #X52Msg-OMsgBs,R3 ;error message .EndC; NE VTXXX$ 20$: Mov R3,R0 ; put in standard register Add PC,R0 ; make PIC **PIC** OMsgBs: ; base for message address relocation .Print ; Print it .Br OvrOk3 ; and done .Disable LSB .EndC; NE VT100$!VT102$ .SbTtl OvrOk3 -- normal exit to set code .Enable LSB OvrOk3: Mov #SetOk/2,R3 ; return to SetOk code after reloading ; SLStrt block Jmp FakOvr+ ; go to GetOvr code second entry .............................. .Disable LSB LoadS3: Jsr R1,XitKmn ; send command to KMON on Exit **PIC** .Asciz "$LOAD SL" ; to load SL .Asciz "$SET SL ON" ; recursive, connect after $LOAD .Byte ; end of command(s) .Even ................ LoadK3: Jsr R1,XitKmn ; send command to KMON on Exit **PIC** .Asciz "$LOAD SL" ; to load SL .Asciz "$SET SL KMON" ; recursive, connect after $LOAD .Byte ; end of command(s) .Even ................ UnLdS3: Jsr R1,XitKmn ; send command to KMON on Exit **PIC** .Asciz "$UNLOAD SL" ; to unload SL .Byte ; end of command(s) .Even ................ .SbTtl XitKmn -- Issue KMON command on EXIT .Enable LSB XitKmn: TstB -1(R5) ; more set options follow? Beq 40$ ; no, all is well Jsr R0,10$ ; print message **PIC** .NlCsi PART=PREFIX,TYPE=I .Asciz "E-ON/KMON/OFF must be last option in set command" .Even 10$: .Print ; print it Pop R0 ; restore register and stack Jsr R0,20$ ; print second message **PIC** .NlCsi PART=PREFIX,TYPE=I .Ascii "I-Following options ignored - " .Even 20$: .Print ; print it 30$: .TtyOut -(R5) ; print a char TstB -1(R5) ; end of line? Bne 30$ ; no .TtyOut # ; end the message .TtyOut # ; with a Pop R0 ; restore R0 and stack 40$: Mov #CmdStr,R0 ; point to area for command string Clr R2 ; init counter register 50$: Inc R2 ; count char MovB (R1)+,(R0)+ ; copy command string .Assume 200 EQ NoCrLf Bpl 50$ ; until a is moved Dec R2 ; adjust count Mov R2,@#CmdLen ; put in low memory Clr R0 ; indicate hard exit Bis #SpXit$!ChnIF$,@#$JSW ; indicate command to do ;NOTE: stack is "unaligned" here (if anyone cares) .Exit ; and exit ...... .Disable LSB .If NE VT100$!VT102$ LeaMsg: .Ascii .Ascii "14" .Ascii "24" ;NOTE: fails on VT101 (VT100 w/o AVO) in 132 mode NLeMsg: .Ascii .Ascii "24" .EndC; NE VT100$!VT102$ .If NE VTXXX$ X52Msg: .NLCSI PART=PREFIX,TYPE=I .Ascii "E-SET SL LEARN is not supported for VT52" .EndC; NE VTXXX$ .Assume . LE OvrBk3+Blk .If NE MMg$t .SbTtl Installation overlay .Enable LSB ;***************************************************************************** .PSect InsOvr InsBk0: SLXSiz = SLX-SLXBase+KTGran-1/KTGran ; amount to allocate OvrIns: .Wait #SysChn ; are we running at INSTALL time? Bcc 10$ ; Yes, KMON is calling us .Assume BotChn EQ 0 .Wait #0 ; are we running at BOOT time? Bcs InsNoB ; no, then we can't read .Assume BotChn EQ 0 ClrB ORdChn ; use BOOT channel Add BlkAdd+,ORdBlk ; add in offset to SLX file 10$: ;***NOTE: This code is essentially duplicated in INIT:, change it there ; if it changes here! Mov @#$SYPTR,R1 ; point to RMON Mov MemPtr(R1),R0 ; get offset to memory tables **GVAL** Add R1,R0 ; get real address Mov CorPtX(R0),R5 ; get offset to extended ALLOC**PEEK** Add R1,R5 ; and real address MOV P1Ext(R1),P1EXTA ; save for possible deallocation 20$: Cmp #-1,(R5)+ ; look for end of free list **PEEK** Bne 20$ ; loop until found ; R5 now points to handler RCBs ; Search for existing region with our name "SLx$__" ; (why should there be such a region?) MOV R5,R0 ; save pointer to 1st entry 24$: CMP #-1,@R0 ; end of list? BEQ 30$ ; If so, go make an entry. TST @R0 ; empty entry? BEQ 26$ ; branch if so. CMP GR.Nam(R0),(PC)+ ; 1st 3 chars = "SLx"? .RModule BNE 26$ ; if not, try next entry. CMP (R0),#<^r$ > ; 2nd 3 chars "$ "? BNE 26$ ; if not, try next entry. MOV R0,RCBP ; point to the RCB MOV R0,-(SP) MOV R5,-(SP) CALL DEALLO ; De-allocate it. MOV (SP)+,R5 MOV (SP)+,R0 26$: ADD #GR.Esz,R0 ; point to next RCB BR 24$ ; continue searching. ; Search RCB table for an empty entry, and attach to it. 30$: ; look for an empty one Cmp #-1,@R5 ; end of list? **PEEK** Beq InsNo0 ; yes, failure Tst @R5 ; empty? **PEEK** Beq 40$ ; yes, got one to use Add #GR.Esz,R5 ; point to next ;GLA001 Br 30$ ; keep trying .......... 40$: Mov P1EXTA,R0 ; get address of P1EXT routine**GVAL** MOV R5,RCBP ; save for possible deallocation Mov #SLXSiz,R2 ; area needed Call XAlloc(R0) ; call routine to allocate it Bcs 45$ ; failed .Assume GR.Siz EQ 0 Mov R2,(R5)+ ; build RCB **POKE** .Assume GR.Adr EQ GR.Siz+2 Mov R1,(R5)+ ; **POKE** .Assume GR.Sta EQ GR.Adr+2 .IF NE SL$CLO Clr (R5)+ ; set status to SHARED **POKE** .IFF; NE SL$CLO Mov #GR.PRV,(R5)+ ; set status to PRIVATE **POKE** .ENDC; NE SL$CLO .Assume GR.Nam EQ GR.Sta+2 Mov (PC)+,(R5)+ ; put name in RCB **POKE .RModule ; our Rad50 name Mov #<^r$ >,@R5 ; second part of name is $ **POKE Mov @#PS,OldPS ; save the PSW **IOPAGE** Bic #CMKern,@#PS ; set current mode to Kernel**IOPAGE** Push @#KISDR1 ; save current mapping **IOPAGE** Push @#KISAR1 ; registers **IOPAGE** Mov R1,@#KISAR1 ; map to extended region ; (where are we?) **IOPAGE** Mov #AP$ACF,@#KISDR1 ; ... **IOPAGE** .Addr #ORead,R0 ; address of read request block**PIC** INSRED::.ReadC CODE=NOSET ; read into extended memory ; really a .READW Bcs UnMap0 ; failed ... kill install ;NOTE: the following is duplicated in the INIT (in buffer area) for SJ/FB/RTEM ; If you change it here, change it there too! Mov @#$SYPTR,R0 ; point to RMON RMX.Did = 1 .Rept RMX.Cnt .Irp x <\RMX.Did> Add R0,@#RMX.'x ; relocate using RMon as base $Rel .-2 RMX.'x SLX .EndR RMX.Did = RMX.Did+1 .EndR Mov R0,@#AEMT16 ; calculate real address $Rel .-2 AEMT16 SLX Add EMT16(R0),@#AEMT16 ; of EMT16 list **GVAL** $Rel .-2 AEMT16 SLX Pop @#KISAR1 ; restore mapping **IOPAGE** Pop @#KISDR1 ; **IOPAGE** Mov #.-.,@#PS ; restore psw **IOPAGE** OldPS =: .-4 ; ; if an error how to deallocate? ClC ; success Return ...... 45$: TstB ORdChn ; boot time? Beq InsNo0 ; yes, no message .Addr #NoHMem,R0 ; point to message **PIC** .Print InsNoB: Br InsNo0 .............. DEALLO: MOV RCBP,R1 ; Point to our RCB MOV P1EXTA,R0 ; and to monitor $P1EXT MOV GR.Siz(R1),R2 MOV GR.Adr(R1),R1 CALL XDEALC(R0) ; Deallocate our region CLR @RCBP ; Clear the RCB entry RETURN UnMap0: CALL DEALLO Pop @#KISAR1 ; restore mapping **IOPAGE** Pop @#KISDR1 ; **IOPAGE** Mov OldPS,@#PS ; restore psw **IOPAGE** InsNo0: Sec ; failed Return ...... .Disable LSB .Even ORead: ORdChn: .Byte SysChn+.-. ; channel number .Byte .Read ; request subcode ORdBlk: .Word SLXBase/Blk+.-. ; block number .Word P1Addr ; buffer is Par1 area .Word SLX-SLXBase+1/2 ; word count .Word 0 ; wait mode P1EXTA: .WORD 0 ; Address of $P1EXT RCBP: .WORD 0 ; Pointer to our Region Control Block NoHMem: .NLCSI TYPE=I,PART=PREFIX .Ascii "F-Insufficient high memory" .Assume . LE Blk+InsBk0 .EndC; NE MMg$t .Even .SbTtl UNLOAD code .Enable LSB Unload: Clc ; Assume not loaded MOV R1,-(SP) Mov @#$SYPTR,R1 ;*C* point to RMON Bit #SLEdi$!SLKMo$,$CNFG1(R1) ;*C* Are we connected? Beq 10$ ;*C* No, done .Addr #NoUnlo,R0 ; Point to message Sec ; Indicate error BisB #Fatal$,@#$USRRB ;*C* and in error byte, too 10$: MOV (SP)+,R1 Return ...... NoUnLo: .NLCSI TYPE=I, PART=PREFIX .AsciZ "F-SL cannot be unloaded while running" ;>>> .AsciZ "F-Not unloaded, 'SET SL OFF'" .SbTtl Align PSects on block boundaries ;***************************************************************************** .Psect SLDvr ; pad SLDvr up to block bound SLDvr ==: . ; display actual size .PSect SetOvr SetOvr ==: . ; display actual size .If NE MMg$t PadSet =: 4*Blk ; first block boundary .IIf LT .+Blk- .Error .+Blk- ; Decrease value; .IIf GT .- .Error .- ; Increase value; .=:OvrBk0+PadSet .IfTF; NE MMg$t .PSect InsOvr InsOvr =: . ; display actual size .IfT; NE MMg$t PadIns =: 1*Blk ; first block boundary .IIf LT .+Blk- .Error .+Blk- ; Decrease value; .IIf GT .- .Error .- ; Increase value; .=:InsBk0+PadIns .EndC; NE MMg$t .PSect SLX ; pad SLX up to block boundary SLX =: . ; display actual size ;***************************************************************************** .IIf NE SL.Cnt-SL.Did+1 .Error SL.Cnt-SL.Did+1 ; auto relocation error; .IIf NE SLR.Cnt-SLR.Did+1 .Error SLR.Cnt-SLR.Did+1 ; auto relocation error; .IIf NE RM.Cnt-RM.Did+1 .Error RM.Cnt-RM.Did+1 ; auto relocation error; .IIf NE RMX.Cnt-RMX.Did+1 .Error RMX.Cnt-RMX.Did+1 ; auto relocation error; .End