.title CLE A simple command line editor, RSTS/E 9.x .ident /4.0.08/ ; V1.0-xx BDN 08-Aug-86 Original distribution to RSTS SIG tape '86 ; V2.0-xx TMK 03-Oct-87 SPC modifications, RSTS SIG tape '87 ; V3.0-xx K S 04-Apr-88 FCS modifications, undistributed ; V3.0-xx JAS 16-Jul-88 EGH modifications, undistributed ; V4.0-01 TMK 27-Jan-89 Implement rest of VMS controls, reduce use ; of escape sequences, correctly process ^F, ; ^Z characters, don't pass lines starting w/ ; ! to DCL (causes SWITCH for some reason)) ; V4.0-02 TMK 28-Jan-89 Remove all remaining cases of cursor save/ ; restore (RUB, LF, ^U), turn off echo so that ; logfiles are not messed up ; V4.0-03 TMK 29-Jan-89 Add hardcopy terminal support ; V4.0-04 TMK 20-Apr-89 Exit quietly if batch job, use different ; prompt when logfile is open. ; V4.0-05 TMK 04-May-89 Correct long-standing bug which caused com- ; mands entered after changing PPN to not be ; stored. ; V4.0-06 TMK 01-Jun-89 Correctly process ^D a la VMS, check for att- ; ach as another command to trap. ; V4.0-07 TMK 19-Jun-89 Fix bug of missing CRLF in some error messages. ; V4.0-08 TMK 30-Aug-89 Fix bug where a user with WACNT wound up in a ; connected, logged-out state in CLE if a "kill ; job" was done instead of a logout. *FINALLY* ; fix the spurious CR/LF when the buffer is full ; at 80 characters (extend to 125 as well). This ; changes the way things work a bit: Lines up to ; 125 characters (system limit of 127 - "$ ") may ; be input. No wrapping will occur. The system ; will beep if the user attempts to enter more ; than 125 characters. ; ; Who's who in CLE development: ; Brian Nelson (BDN) - Original author of the program. University of ; Toledo. ; John Santos (JAS) - Added private delimiter code at TMK's sug- ; gestion, added support for VT52's, ^J, ^T ; code. Evans, Griffith, and Hart. ; Kelvin Smith (K S) - Added support for use with RSX runtime sys- ; tem, priority boost. Financial Computer Ser- ; vices. ; Terry Kennedy (TMK) - Current maintainer, added the stuff listed ; after V4.0-00 above. St. Peter's College. ; ; This is a simple command line editor for RSTS/E 9.x. It is ; a run time system that one sets to be the current (NOT ; system) default RTS. It reads commands in ODT mode, ; allowing for editing with the normal arrow keys, rubout, ; control B, E, H and X keys. It stores up to 20 commands in ; a buffer allocated in a private 2KW dynamic region. Currently ; the maximum line length is 80 characters. Continuation lines ; are not supported. It will ONLY function on RSTS/E 9.2 or ; later. ; ; WARNING: ; ; This RTS runs in privileged mode and must be installed <232> ; in _SY0:[0,1]CLE.RTS in order to function properly. It's run- ; time system must also be set to CLE. It is assumed that after ; calling DCL, DCL will immediately drop privileges. If that is ; not the case, there is potential for a serious security viol- ; ation. Note that DCL's behavior is specified in RSTS/E system ; architecture, so this should not be a problem. ; ; Restrictions: ; ; Since the dynamic region is created to be permanent, this RTS ; tries to intercept the LOG command so it can delete the region. ; In other words, if jobs are killed that have created a region ; the region will not go away until you manually remove it via ; the REM/LIB command. The RTS also intercepts the SWITCH command ; when given without any arguments. I [tmk] suggest you apply the ; patch to LOGOUT which causes the CLE region to be removed after ; logging out. ; ; This RTS only works correctly on 9.2 or later due to modifica- ; tions to the Job Data Block (specifically the offset of JDFLG3) ; ; The code below is the patch to LOGOUT.BAS to remove the CLE ; region at logout time. This solves all of the problems mention- ; ed above regarding region deletion. ; ; 9035 ON ERROR GOTO 9040 & ; \ A$="CLEJ"+RIGHT(NUM1$(JOB%+100%),2%) & ; \ A$=MID(SYS(CHR$(6%)+CHR$(-10%)+A$),7%,4%) & ; \ A$=SYS(CHR$(6%)+CHR$(-18%)+CHR$(20%)+STRING$(3%,0%)+A$) & ; \ ON ERROR GOTO 19000 & ; ! CONSTRUCT CLE LIBRARY NAME FROM JOB NUMBER, & ; ! CONVERT TO RAD-50, AND REMOVE & ; $$SIMPLE == 1 ; Use a good encryption routine ; (CLECRY.MAC) if == 0 ; For performance reasons, it is a good idea to add the command ; ; $ LOAD/OVER TER ; ; to SY:[0,1]START.COM ; ; ; Please see the comments prefixing the entry point CHKBYE for ; security issues. .include /SY:[1,2]COMMON.MAC/ .include /SY:[1,2]KERNEL.MAC/ .iif ndf, JDFLG3, JDFLG3 = 34 .title CLE A simple command line editor, RSTS/E 9.x .enabl gbl .PSECT $RTQUE,RW,D,GBL,REL,OVR .PSECT $RWDAT,RW,D,GBL,REL,CON .PSECT $PDATA,RO,D,LCL,REL,CON .PSECT RWDATA,RW,D,LCL,REL,CON .PSECT CLECTX,RW,D,GBL,REL,CON .PSECT DESCOD ,RO,I,LCL,REL,CON .PSECT DESDAT ,RO,D,LCL,REL,CON .PSECT $CODE ,RO,I,LCL,REL,CON ; Files needed: ; CLE.MAC Runtime system ; CLEEDI.MAC Editor module ; CLEMAC.MAC Include file ; ; $ ass sy: in ; $ ccl macro in:cle=in:cle ; $ ccl macro in:cleedi=in:cleedi ; $ ccl link ; in:cle/z,in:cle,in:cle=in:cle,in:cleedi/x/h:#177776/u:#4000 ; .99998 ; $ run $silus ; in:cle.rts<232>,tt:=in:cle ; $ rem/run cle ; $ pip [0,1]cle.rts=in:cle.rts ; $ set file [0,1]cle.rts/runtime_system=cle ; $ ins/run [0,1]cle TAB = 11 LF = 12 FF = 14 CR = 15 ESC = 33 SPACE = 40 RUB = 177 FIEXST = ^D16 ER$EOF == -1 UNKNWN = 0 TTY = 1 VT5X = 2 VT1XX = 3 .macro SCAN ch,str mov str ,-(sp) clr -(sp) bisb ch ,@sp call scanch .endm SCAN .macro ATOR50 addr mov addr ,-(sp) call ascrad .endm ATOR50 .macro DECOUT val mov val ,-(sp) call putdec .endm DECOUT .macro OCTOUT val mov val ,-(sp) call putOCT .endm OCTOUT .macro SAVE list .if b , .ift save .iff .irp x, mov x,-(sp) .endr .endc .endm SAVE .macro UNSAVE list .if b , .ift unsave .iff .irp x, mov (sp)+,x .endr .endc .endm UNSAVE .macro STRCAT dst,src mov src ,-(sp) mov dst ,-(sp) jsr pc ,strcat .endm STRCAT .macro STRCMP s1,s2 mov s2 ,-(sp) mov s1 ,-(sp) call strcmp .endm STRCMP .macro STRCPY dst,src mov src ,-(sp) mov dst ,-(sp) jsr pc ,strcpy .endm STRCPY .macro STRLEN addr mov addr ,-(sp) call STRLEN .endm STRLEN .macro PRINT addr mov addr ,-(sp) call TTYOUT .endm PRINT .macro CLRXRB call $CLRXRB .endm CLRXRB .macro CLRFQB call $CLRFQB .endm CLRFQB .save ; Save current psect context .ASECT . = 140000 EDICMD::.BLKW 1 EDILEN::.BLKW 1 EDIPOS::.BLKW 1 EDIPPN::.BLKW 1 EDITIM::.BLKW 1 EDISTS::.BLKW 1 $ENCKE::.BLKB 62. $DECKE::.BLKB 62. $SKEY:: .BLKB 60 EDIEND == . ; End of fixed data LN$CNT == 20. ; Number of buffer LN$MAX == 124. ; Max line length LN$SIZE == LN$MAX+4 ; Allocation MAPSIZ == 100 ; Map 2KW (64*32 (10)) words .ASSUME LT 7770; Insure we will fit in 2KW .psect $RODATA ,RO,D,LCL,REL,CON edikey::.byte 'S!200 ; If using simple minded XOR .byte 'Z!200 ; encryption. Otherwise build .byte '1!200 ; one at run time. .byte 'p!200 .byte '#!200 .byte 'x!200 .byte '7!200 .byte 'c!200 .byte '[!200 .byte '.!200 .byte 'a!200 .byte ':!200 .byte 'k!200 .byte 0 ; we will never get a NULL. prm:: .asciz /_$ / ; A prompt logprm::.asciz /_$. / ; Another nulprm: .byte 0 .blkb 10 ; In case of patching? .even ; Please lastcn::.word LN$CNT ; Buffer count edisiz::.word LN$MAX ; $$BUFP = 0 ; Now generate command buffers lastli:: ; Start of buffer address table .rept LN$CNT ; Generate the structure $BADDR =EDIEND+; Compute the address .ASSUME $BADDR LT <147777-LN$SIZE> .word $BADDR ; Insert the address $$BUFP = $$BUFP+1 ; Move up .endr ; Next please .asect ; Local R/W data. You can NOT ; place data here that needs to be . = 1000 ; saved between commands. stklim::.blkw 300 ; A small stack stack:: .blkw 1 ; Top of it buf:: .blkb 200 ; A buffer for reading tmpbuf: .blkb 200 jobn: .blkw 1 ; Current job number kbn: .blkb 1 ; Current KB number .even regid: .blkw 1 ; Region id for dynamic region regnam: .blkw 2 ; Region name func: .blkw 1 ; Debugging vttype::.blkw 1 ; Terminal type (0=Hcopy, 1=CRT) vtwid:: .blkw 1 ; Terminal width curppn: .blkw 1 ; Current UIC prmadr: .blkw 1 ekbuf:: .blkb 2 ; Echo buffer for cursing inrub:: .blkw 1 ; Rubout status .restore .sbttl Entry to the run time system .psect $CODE ,ro,i,lcl,rel,con ...NEW::mov #stack ,sp ; Insure sufficient stack space mov #chain ,func ; Set up for possible error bit #jfnopr ,key ; Is this job logged-in? beq 1$ ; Yes, all is well... CLRFQB ; Nope, get KB number for hangup movb #UU.SYS ,FIRQB+FQFUN ; ... .UUO ; Do it movb FIRQB+FQSIZM,kbn CLRFQB ; Try for a hangup movb #UU.HNG ,FIRQB+FQFUN movb #1 ,FIRQB+FQSIZM movb kbn ,FIRQB+FQFIL .UUO .EXIT ; *Somebody* please kill me!!! 1$: CLRFQB ; A nice clean FIRQB movb #1 ,FIRQB+FQPPN ; Execute [0,1] ... mov #^RCLE ,FIRQB+FQNAM1 ; ... CLE. ... mov #^RRTS ,FIRQB+FQEXT ; ... RTS .CHAIN ; This should do the trick... jmp ..oops ; Print error and exit if failed ...RUN::mov #stack ,sp ; Insure sufficient stack space call init ; Start things up CLRXRB ; Set special run priority mov #JFSPRI ,XRB+XRLEN .SET 10$: call leftm ; Insure cursor at left margin clr @#edists ; Ensure insert mode is off to start mov #0 ,inrub ; and that rubout sequence is inactive mov #buf ,-(sp) ; Read, edit and store a line mov prmadr ,-(sp) ; Stuff buffer address and a mov sp ,r5 ; prompt. Point R5 to params. This call kbredi ; is because we use the editor with cmp (sp)+ ,(sp)+ ; Minitab and Kermit-11. Pop args. tst r1 ; Anything there? beq 10$ ; No mov #buf ,r2 ; Remove trailing control chars add r1 ,r2 ; Point to end of the line 20$: cmpb -(r2) ,#40 ; Well? bhi 30$ ; No more sob r1 ,20$ ; Found one, keep looking br 10$ ; Nothing, ignore it. 30$: mov #buf ,r2 ; address of buffer 35$: cmpb (r2)+ ,#40 ; skip leading spaces beq 35$ cmpb -(r2) ,#'! ; just a comment? beq 10$ ; yes, ignore cmp r1 ,#1 ; One character? bne 40$ ; No cmpb buf ,#'$ ; Just a '$' command beq 10$ ; Yes, ignore 40$: mov #buf ,-(sp) ; No. Now comes the REAL KLUDGE. call chkbye ; Since we can't tell the exec to bcs 50$ ; delete the region when its creator call detreg ; disappers, we will try to catch call delreg ; the likely logout message and then 50$: mov #buf ,-(sp) ; detach and delete the region here. CLRXRB ; Clear delimiters mov #11 ,XRB+XRLEN ; Function 11 (octal) movb #TTYHND ,XRB+XRBLKM ; Handler index for TTY's .spec ; Do it! .ttech ; re-enable echo on terminal call docmd ; Generate and execute '$ commandline' jmp ...huh ; This can't happen. .sbttl Utility routines ; DOCMD ; ; Passed: 2(sp) Command line to build ; Return: If '$' is a valid CCL command, it never returns Docmd: mov r4 ,-(sp) ; Save it mov r3 ,-(sp) ; This one also mov 2+4(sp) ,r3 ; Get string address STRLEN r3 ; Get the length now mov r0 ,r2 ; Copy it beq 100$ ; Nothing to do. add #5 ,r2 ; Room for '$ ' and null. bic #1 ,r2 ; Insure even value sub r2 ,sp ; Allocate a buffer mov sp ,r4 ; And a pointer to it movb #'$ ,(r4)+ ; Insert DCL prefix movb #40 ,(r4)+ ; ... STRCPY r4 ,r3 ; Make a copy of the command mov sp ,r4 ; Reset buffer address CLRXRB ; Insure XRB is cleared out STRLEN r4 ; Get total length mov r0 ,XRB+XRLEN ; Length of the CCL command mov r0 ,XRB+XRBC ; Again mov r4 ,XRB+XRLOC ; String address .CCL ; Try it out PRINT #200$ ; Huh? This can't happen add r2 ,sp ; But it did. Restore the stack 100$: mov (sp)+ ,r3 ; Pop registers mov (sp)+ ,r4 ; Simple mov (sp)+ ,(sp) ; Move return address up return ; And exit 200$: .asciz /$ (DCL) CCL command failed/ .even .sbttl Get started ; INIT ; ; Passed: Nothing ; ; Init handles all initialization whenever a user enters the RTS. ; It does the following things: ; ; 1. Save current UIC. ; 2. Get terminal type, reject entry if not a VT1xx, 2xx or 3xx. ; 3. Change name to ...CLE, Reset I/O channels, Get Job number, ; Reset terminal echoing and output. Enable multiple private ; delimiters. ; 4. Compute region name as CLEJnn, where NN is the job number. ; 5. Attempt to create the region. If this fails for any reason ; other that an already existing region, then exit. Thus one ; needs the INSTAL priv. If it was created, save region ID. ; 6. Attach to the region by name. Save the region id. ; 7. Create address window off of APR6 (the RTS is mapped on 7). ; 8. If region was just created, save current UIC in the region. ; 9. If current UIC <> Saved UIC, or the region was just created ; the clear the command line buffers. init:: .STAT ; Get current PPN mov XRB+10 ,curppn ; Save it mov #prm ,prmadr ; A real prompt CLRFQB ; Clear FIRQB out movb #UU.SYS ,FIRQB+FQFUN ; ... incb FIRQB+5 ; Subfunction 1 .UUO ; Do it mov FIRQB+32,XRB+0 ; Now get JDFLG3 add #JDFLG3 ,XRB+0 ; Offset to flag 3 .PEEK ; Do it tstb FIRQB ; Well? bne 6$ ; No bit #J2LOG ,XRB+0 ; Is a logfile open? beq 4$ mov #logprm ,prmadr ; Yes, substitute log prompt 4$: bit #J2ICF ,XRB+0 ; Running a command file? beq 5$ ; Nope mov #nulprm ,prmadr ; Yes, a null prompt 5$: bit #J2BAT ,XRB+0 ; Is this a batch job? bne 9$ ; If so, sneak out 6$: call inqter ; Get the terminal type mov r0 ,vttype ; And save the terminal type bne 10$ ; Must be a known terminal type PRINT #generr ; Print first part of message PRINT #notter ; And rest of message 9$: jmp ...dcl ; Back to DCL folks. 10$: call leftm ; See if we need a CRLF mov #unknown,func ; Unknown call mov #^R... ,FIRQB+FQNAM1+0 ; Change program name mov #^RDCL ,FIRQB+FQNAM1+2 ; to ...DCL .NAME ; Simple to do CLRFQB ; Reset I/O channels movb #RSTFQ ,FIRQB+FQFUN ; Simple CALFIP ; Do it movb FIRQB+FQJOB,jobn ; Save job number asrb jobn ; Not times two .TTRST ; Insure terminal is ok .ttnch ; disable echoing on terminal (due to ; bug of private delimiters not echoing ; but going to logfile if echo is on) CLRXRB ; Declare delimiters mov #11 ,XRB+XRLEN ; Function 11 (octal) mov #256./8.,XRB+XRBC ; 256 bits of delimiter mask mov #PDELIM ,XRB+XRLOC ; Address of mask movb #TTYHND ,XRB+XRBLKM ; Handler index for TTY's mov #1 ,XRB+XRMOD ; Sub-function 1 (set delimiters) .spec ; Do it! tstb FIRQB ; Any error? beq 15$ ; No PRINT #generr ; print generic error header PRINT #mpdreq ; and part about required features jmp ...dcl ; and then bail out .sbttl Initialize, continued... 15$: movb jobn ,r1 ; Convert to ASCII clr r0 ; Simple div #12 ,r0 ; Do it add #'0 ,r0 ; Convert to ascii now add #'0 ,r1 ; Ditto sub #4 ,sp ; Allocate a buffer mov sp ,r2 ; And a pointer movb #'J ,(r2)+ ; Generate the second half of movb r0 ,(r2)+ ; the dynamic region name now. movb r1 ,(r2)+ ; And then we convert to R50 mov sp ,r2 ; Fix the pointer ATOR50 r2 ; Convert add #4 ,sp ; Fix the stack back up mov #^RCLE ,regnam+0 ; Save the region's name mov r0 ,regnam+2 ; ...Save the region's name mov #$uurts ,func ; Error message header for UU.RTS CLRFQB ; Get set for a .CRRG movb #UU.RTS ,FIRQB+FQFUN ; On RSTS/E we use UU.RTS movb #30 ,FIRQB+FQFIL ; Subfunction to create region mov #^RCLE ,FIRQB+FQNAM1+0 ; First half of the regions name mov r0 ,FIRQB+FQNAM1+2 ; Second half of the region name movb #2 ,FIRQB+FQSIZ ; 2KW please mov #100000 ,FIRQB+FQMODE ; Keep the region around mov #1000 ,FIRQB+FQFLAG ; This region is private decb FIRQB+FQPFLG ; Next byte is real protection movb #60. ,FIRQB+FQPROT ; Owner only .UUO ; At last clr r5 ; Flag if the region was already there cmpb FIRQB ,#FIEXST ; Does the region already exit? beq 20$ ; Then just attach to it tstb FIRQB ; Otherwise, did this fail? bne ..oops ; Yes, it's fatal movb FIRQB+FQPPN,regid ; Save this for a moment. dec r5 ; First time 20$: mov #$atrfq ,func ; ATRFQ of .PLAS failed CLRFQB ; Zap the FIRQB again please movb #ATRFQ ,FIRQB+4 ; Attach to region subfunction of .PLAS mov regnam+0,FIRQB+12 ; Region name to attach to. mov regnam+2,FIRQB+14 ; ...Region name to attach to. mov #2 ,FIRQB+FQMODE ; We must have r/w access to it. .PLAS ; Well, lets get it done with tstb FIRQB ; Success ? bne ..oops ; No, die mov FIRQB+6 ,regid ; Yes, copy the region identification. .sbttl More init, do a CRAW$S and init the region if need be. mov #$crafq ,func ; Set debug address text CLRFQB ; Yes, once again, zap the FIRQB now. movb #CRAFQ ,FIRQB+4 ; Create an address window now movb #6 ,FIRQB+7 ; Based from APR6, 140000-157777 mov #MAPSIZ ,FIRQB+12 ; Set the map size mov regid ,FIRQB+14 ; The region ident word mov #MAPSIZ ,FIRQB+20 ; How much to map. mov #202 ,FIRQB+FQMODE ; Read/write + implicit MAP$S .PLAS ; Do it tstb FIRQB ; Did it work? bne ..oops ; No tst r5 ; First time here? beq 30$ ; No mov curppn ,@#edippn ; And save the current UIC please 30$: cmp curppn ,@#edippn ; Same UIC bne 40$ ; No, init the region then. tst r5 ; First time? beq 100$ ; No 40$: call inireg ; Yes, init things mov curppn ,@#edippn ; Save new ppn so we don't re-re-init 100$: clr @#edipos ; Clear out cursor position clr @#edilen ; Clear length return ; Exit ..oops: movb FIRQB ,r0 ; Dump the error code DECOUT r0 ; Do it PRINT #inierr ; Error text PRINT func ; Function jmp ...dcl ; Goto DCL .save .psect $RODATA ,D inierr: .asciz /. was the init error. / chain: .asciz !.CHAIN failed (is _SY0:[0,1]CLE.RTS set <232>/RTS=CLE?)! unknown:.asciz /Unknown init failure/ $uurts: .asciz /Failed to create region/ $atrfq: .asciz /.PLAS ATRFQ failed/ $crafq: .asciz /.PLAS CRAFQ failed/ generr: .asciz /??CLE-F / notter: .asciz /Unknown terminal type/ mpdreq: .asciz /CLE requires Multiple Private Delimiter monitor support/ crlf: .byte CR,LF,0 .even .restore .enabl LSB inireg::mov #-1 ,@#edicmd ; Init the current command to -1 clr @#edists ; Clear status mov #LN$CNT ,r0 ; Number of buffers to clear mov #lastli ,r1 ; Address of list 10$: mov (r1)+ ,r2 ; Address of current buffer clrb @r2 ; Zap it sob r0 ,10$ ; Next please CLRFQB ; Use UU.SYS for a key movb #UU.SYS ,FIRQB+FQFUN ; Function incb FIRQB+5 ; Part one .UUO ; mov #FIRQB+2,r1 ; A pointer mov #34 ,r0 ; Size mov #$skey ,r2 ; ... 20$: movb (r1)+ ,(r2) ; Copy bne 30$ ; Ok incb (r2) ; Insure > 0 30$: bisb #200 ,(r2)+ ; Insure > 200 sob r0 ,20$ ; Next clrb @r2 ; .ASCIZ .DATE ; Get current stuff movb XRB+5 ,@#editim ; Save ticks till minute mov #$ENCKEY,-(sp) ; Inittialize keys clr -(sp) ; Get ENCODE key mov #200$ ,-(sp) ; Using time info call kinit ; Do it inc 2(sp) ; Get DECODE key next mov #$DECKEY,4(sp) ; Simple call kinit ; Again add #3*2 ,sp ; Pop stack. return ; Exit ; Since the tables in CLECRY.MAC are key dependent, we will ; use the old one and do the en/decryption based on the ticks ; to next second at region creation. .save .radix 10 .psect $PDATA ,D 200$: .byte 31, 41, 59, 26, 53, 58, 97, 93, 238, 46, 26, 43, 38, 32, 79 .even .radix 8 .restore .dsabl lsb .sbttl Detach, delete region Detreg::CLRFQB ; Always do this movb #DTRFQ ,FIRQB+4 ; .PLAS subfunction mov regid ,FIRQB+6 ; Region ID .PLAS ; Simple clc ; Always say it worked. return ; Exit Delreg::CLRFQB ; Ditto, insure no oddball defaults mov regnam+0,FIRQB+FQNAM1+0 ; Stuff the region name in mov regnam+2,FIRQB+FQNAM1+2 ; ...Stuff the region name in movb #24 ,FIRQB+4 ; UU.RTS subfunction, delete region movb #UU.RTS ,FIRQB+FQFUN ; .UUO function code .UUO ; Simple clc ; Always say it works return ; And exit .sbttl Utility routines Clrcns::return Read1ch:: CLRXRB ; Insure XRB zapped clr -(sp) ; Allocate a buffer mov sp ,r1 ; A pointer mov r1 ,XRB+XRLOC ; Buffer address inc XRB+XRLEN ; One character size buffer cmp #nulprm ,prmadr ; Doing an ICF? bne 10$ ; No mov #100000 ,XRB+XRTIME ; Yes, KMON read 10$: .READ ; Simple clr r0 ; Return the character next tstb FIRQB ; Errors? bne 100$ ; Yes, return a NULL tst XRB+XRBC ; No data????? beq 100$ ; Should never happen. bisb @r1 ,r0 ; No, return the data then. 100$: tst (sp)+ ; Pop the buffer and exit return ; Bye kbread::return ; No-op for hardcopy terminals ; TTYOUT ; ; Passed: 2(sp) .ASCIZ string address ; ; ; The entry point MOUT is present for compatibility with K11EDI ; having been assembled for Kermit-11 with the K11MAC.MAC include ; file. MOUT:: TTYOUT::mov r0 ,-(sp) ; Save R0 mov r1 ,-(sp) ; Save R1 mov 2+4(sp) ,r0 ; no length, assume .asciz 10$: tstb (r0)+ ; move along looking for a null bne 10$ ; none yet so far sub 2+4(sp) ,r0 ; get the length dec r0 ; off by one ble 100$ ; Nothing to do, exit 20$: mov #XRB ,r1 ; address of xrb parameter block mov r0 ,(r1)+ ; buffer length mov r0 ,(r1)+ ; byte count for the i/o mov 2+4(sp) ,(r1)+ ; address of the buffer clr (r1)+ ; Channel zero clr (r1)+ ; unused clr (r1)+ ; unused mov #50000 ,@r1 ; stuff xrmod with transparent mode .WRITE ; Dump tstb FIRQB ; Success? beq 100$ ; Yes, exit sec ; No, set carry and then exit 100$: mov (sp)+ ,r1 ; Pop R1 mov (sp)+ ,r0 ; And also pop R0 mov (sp)+ ,(sp) ; Pop return return L$TTYO::mov (r5) ,-(sp) ; Convert to other form so K11EDI call TTYOUT ; will get it's globals resolved. return ; Exit .sbttl other junk ; Clear FIRQB and clear XRB $CLRXR::mov r0 ,-(sp) ; Clear the XRB out mov #XRB ,r0 ; Starting address of it 10$: clr (r0)+ ; Zap a word cmp r0 ,#XRB+14 ; Done? blos 10$ ; No mov (sp)+ ,r0 ; Pop R0 return ; And exit $CLRFQ::mov r0 ,-(sp) ; Clear the FIRQB out mov #FIRQB ,r0 ; Start address 10$: clr (r0)+ ; Do a word cmp r0 ,#FIRQB+36 ; Done? blos 10$ ; No mov (sp)+ ,r0 ; Yes, Pop R0 return ; And exit Leftm: CLRXRB ; See if we need a CRLF .POSTN ; Get current position tst XRB+2 ; Well? beq 100$ ; Not needed PRINT #crlf ; Needed, do a CRLF 100$: return ; Exit ; Convert 3 ascii to 1 rad50 ; ; Passed: ; 2(sp) Address of the string ; Return: R0 The rad50 value Ascrad: SAVE ; save the scratch registers . mov 2+10(sp),r4 ; the address of the ASCII str. clr r3 mov #3 ,r0 1$: mov #radchr ,r1 mov #40. ,r2 2$: cmpb (r4) ,(r1)+ beq 3$ ; Found the character. EXIT loop sob r2 ,2$ mov #40. ,r2 3$: dec r2 mul #40. ,r3 ; We accumulate the RAD50 chars sub r2 ,r3 ; in r3. R1 has the next rad50 add #39. ,r3 tstb (r4)+ ; to add on. Move to the next sob r0 ,1$ ; byte ( for a total of 3 bytes) mov r3 ,r0 UNSAVE ; return result in r0 and return mov (sp)+ ,(sp) ; Pop return address return ; And exit .nlist bex radchr: .ascii / ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:/ .list bex .even .sbttl strcat and strcpy ; STRCPY ; ; input: ; 0(sp) return address ; 2(sp) dst address ; 4(sp) src address ; output: r0 dest address STRCPY::mov r1 ,-(sp) ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address mov (sp)+ ,r1 ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return STRCAT::mov r1 ,-(sp) ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 5$: tstb (r0)+ ; look for the end of the dst string bne 5$ ; not found yet dec r0 ; found it, fix the pointer 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address mov (sp)+ ,r1 ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return STRCMP::mov 2(sp),r0 ;Pick up 'a' mov 4(sp),r1 ;And 'b' 10$: cmpb (r0)+,(r1) ;Are they the same bne 20$ ;No tstb (r1)+ ;At the end of the string bne 10$ ;No clr r0 ;Equal return br 100$ ; Exit 20$: blo 30$ ; Br if ab return br 100$ ; Exit 30$: mov #-1,r0 ; A mov #$cbomg ,r3 ; Octal conversion br pcom Putdec:: SAVE mov #$cbdmg ,r3 ; Decimal conversion Pcom: SAVE ; Save some more registers mov 10+2(sp),r1 ; The value sub #20 ,sp ; Create a buffer mov sp ,r0 ; The buffer ; movb #40 ,(r0)+ ; Stuff a blank in clr r2 ; Formatting options jsr pc ,@r3 ; Now format clrb @r0 ; Make it .ASCIZ now mov sp ,r0 ; Reset the buffer address PRINT r0 ; And dump the data add #20 ,sp ; Pop buffer UNSAVE ; Pop registers mov (sp)+ ,(sp) ; Move return address up return ; And exit Scanch::save ; save temps mov 6(sp) ,r2 ; get address of the string clr r0 ; initial found position 10$: tstb @r2 ; end of the string yet ? beq 90$ ; yes inc r0 ; no, pos := succ(pos) cmpb 4(sp) ,(r2)+ ; does the ch match the next one? bne 10$ ; no, try again br 100$ ; yes, exit loop 90$: clr r0 ; failure, return postion = 0 100$: unsave ; pop r2 mov @sp ,4(sp) ; move return address up cmp (sp)+ ,(sp)+ ; pop stack return ; and exit .sbttl RSX Syslib conversion routines $SAVRG::MOV R4,-(SP) MOV R3,-(SP) MOV R5,-(SP) MOV 6(SP),R5 CALL @(SP)+ MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RETURN $CBDMG::MOV #25012,-(SP) BR E00072 $CBDSG::MOV #25412,-(SP) BR E00072 $CBOMG::MOV #31010,-(SP) BR E00072 $CBOSG::MOV #31410,-(SP) BR E00072 $CBTMG::BIC #-400,R1 MOV #15010,-(SP) E00072: TST R2 BNE E00102 BIC #1000,(SP) E00102: MOV (SP)+,R2 $CBTA::JSR R5,$SAVRG MOVB R2,R5 CLRB R2 SWAB R2 ASR R2 BCC E00134 TST R1 BPL E00134 NEG R1 MOVB #55,(R0)+ E00134: MOV R0,R4 ROR R2 ROR R2 ROR R3 CLRB R3 BISB R2,R3 CLRB R2 BISB #60,R2 MOV R1,R0 E00160: MOV R0,R1 CLR R0 DIV R5,R0 CMP R1,#11 BLOS E00200 ADD #7,R1 E00200: ADD R2,R1 MOV R1,-(SP) DECB R3 BLE E00234 TST R0 BNE E00230 TST R2 BPL E00234 TST R3 BPL E00230 BIC #20,R2 E00230: CALL E00160 E00234: MOVB (SP)+,(R4)+ MOV R4,R0 RETURN .sbttl Get terminal type .enabl lsb ; Assume: Login.com did a $ SET TER/INQ ; ; INQTER ; ; Passed: Nothing ; Return: R0 = 0 if unknown ; R0 = 1 if hardcopy ; R0 = 2 if VT5x series ; R0 = 3 if VT1xx/2xx/3xx series ; VTWID = Current terminal width Inqter::CLRFQB ; Clear out again movb #UU.TRM ,FIRQB+FQFUN ; Terminal char function mov #0+<400*377>,FIRQB+4 ; Subfunction 0, KB: .UUO ; Read chars tstb FIRQB ; Success? bne 90$ ; No movb FIRQB+FQPPN,r0 bic #177400 ,r0 ; Chop off unwanted bits dec r0 ; and store as real width mov r0 ,vtwid ; Store width for later bit #1 ,FIRQB+FQEXT ; Scope? bne 5$ ; Yes, go find out what kind mov #TTY ,r0 ; No, say is TTY br 100$ ; And return 5$: CLRFQB ; Clear out again movb #UU.TRM ,FIRQB+FQFUN ; Terminal char function mov #1+<400*377>,FIRQB+4 ; Subfunction 1, KB: .UUO ; Read chars tstb FIRQB ; Success? bne 90$ ; No bit #1 ,FIRQB+FQDEVN ; ANSI terminal? beq 10$ ; No, check for VT52 PRINT #300$ ; VT series, ensure in 100 mode mov #VT1XX ,r0 ; Yes, return(VT100) br 100$ ; Exit 10$: mov #200$ ,r0 ; Yes, look for vt52 type term 20$: tstb @r0 ; End of list yet? beq 90$ ; Yes, return( TTY ) cmpb (r0)+ ,FIRQB+6 ; No, check for a match bne 20$ ; Not yet mov #VT5X ,r0 ; Remember it's a VT52 br 100$ ; and exit 90$: mov #UNKNWN ,r0 ; Nothing 100$: return ; Exit .save .psect $RODATA ,D 200$: .byte 3. ; VT52 .byte 4. ; VT55 .byte 25. ; VT50 .byte 26. ; VT50H .byte 0 ; End 300$: .byte ESC,74,15,0 ; Enter VT100 mode (vs. VT52) .even .restore .dsabl lsb .sbttl Try to catch LOGOUT, BYE, SWITCH or ATTACH commands ; This is a kludge. The problem is that we do not have a way ; to tell the EXEC at region creation time to get rid of the ; region when the creator process (your job) is removed (via ; UU.BYE or job kill). Ideally, one would like to be able to ; do so. But in the mean time, what we can do is to check for ; LIKELY logout strings, like LOG*OUT or BYE*, and if found ; detach and delete the region ourself. ; ; ; CHKBYE ; ; Passed: 2(sp) Command line address ; Return: C bit Cleared --> Logout command found ; C bit Set --> We did not find LOG*OUT, BYE or SW*ITCH? Chkbye::SAVE ; Save temps mov 2+<2*4>(sp),r1 ; Command line sub #LN$SIZE+4,sp ; Allocate a buffer mov sp ,r2 ; Point to it movb #SPACE ,(r2)+ ; start with a space 10$: movb (r1)+ ,(r2) ; Copy command character beq 20$ ; Alldone cmpb (r2) ,#SPACE ; Space? bhi 14$ ; No, possible alphabetic beq 11$ ; Yes, compress if necessary cmpb (r2) ,#TAB ; Tab? bne 12$ ; No movb #SPACE ,(r2) ; Yes, convert to space 11$: cmpb (r2) ,-1(r2) ; Multiple spaces? beq 10$ ; Yes, so toss it br 15$ ; include it 12$: cmpb (r2) ,#CR ; Carriage return? beq 20$ ; Yes, done 14$: cmpb (r2) ,#'A!40 ; Lower case? blo 15$ ; No cmpb (r2) ,#'Z!40 ; Well... bhi 15$ ; No bicb #40 ,(r2) ; Yes, force to upper case then. 15$: inc r2 ; Not done, point to the next one br 10$ ; Next 20$: clrb (r2) ; Done, insure .ASCIZ mov sp ,r2 ; Reset buffer pointer inc r2 ; (skip leading space) mov #log$lis,r3 ; Point to command list mov #log$abr,r4 ; Point to command abbreviation list 30$: mov (r3)+ ,r1 ; Done checking for logout commands? beq 90$ ; Yes, set carry and exit mov r2 ,r0 ; Point to current command tst (r4)+ ; Point to next length 40$: tstb (r0) ; End of command? beq 50$ ; Yes, check length cmpb (r0)+ ,(r1)+ ; Match? beq 40$ ; Yes, so loop dec r1 ; Point to mismatched character cmpb -(r0) ,#SPACE ; Was it a space? beq 50$ ; Yes, so might be valid cmpb (r0) ,#'/ ; Or a SLASH? bne 30$ ; No, so not a good match 50$: cmp r1 ,(r4) ; Enough of a match to consider correct? blo 30$ ; No add #LN$SIZE+4,sp ; Yes, pop buffer and exit clc ; Flag sucess br 100$ ; Exit 90$: add #LN$SIZE+4,sp ; Yes, pop buffer and exit sec ; Done, no match. 100$: UNSAVE ; Pop registers and exit mov (sp)+ ,(sp) ; Move return address up return ; And now exit. .save .psect $RODATA .even log$lis:: .word LOGOUT ,BYE ,SWITCH ,ATTACH LOG$ABR:: .word 0 .word LOGOUT+3,BYE+2 ,SWITCH+2,ATTACH+2 logout::.asciz /LOGOUT/ bye:: .asciz /BYE/ switch::.asciz /SWITCH/ attach::.asciz /ATTACH/ .even .restore .sbttl Encryption .iif ndf ,$$SIMPLE, $$SIMPLE = 1 .if ne ,$$SIMPLE .ift ; ENCRYPT ; ; Passed: ; 2(sp) String to do ; 4(sp) Key string ; Return: 2(sp) Output string ; ; This is simply an XOR encryption, which is trivial to break. ; It's better than nothing for now until I get a 'DES' routine ; or something similiar. It will prevent casual browsing. Decryp:: Encryp::SAVE ; Save all mov 2+<6*2>(sp),r5 ; Get pointer to string mov 4+<6*2>(sp),r4 ; Get pointer to key string mov #$skey ,r4 ; *** Override the key address *** STRLEN r4 ; Get length of the key mov r0 ,-(sp) ; Save the key length beq 100$ ; Nothing to do. clr r1 ; Offset into the key string 10$: clr r2 ; Copy the next character bisb (r5) ,r2 ; Get the character now. beq 100$ ; All done mov r4 ,r3 ; Key string add r1 ,r3 ; Point to current key char clr r0 ; Always avoid sign extension bisb @r3 ,r0 ; Get next key character xor r2 ,r0 ; Do the xor movb r0 ,(r5)+ ; And copy over the source inc r1 ; Next key character clr r0 ; Get remainder after division div (sp) ,r0 ; Do it br 10$ ; Next please 100$: clrb (r5) ; Insure .asciz tst (sp)+ ; Pop temp UNSAVE ; Pop all mov (sp) ,4(sp) ; Move return address up cmp (sp)+ ,(sp)+ return kinit: return .iff ; Use more advanced routine .enabl lsb Encryp:: Decryp:: 10$: mov r2 ,-(sp) mov sp ,r2 mov r3 ,-(sp) mov r4 ,-(sp) mov 6(r2) ,-(sp) mov 4(r2) ,r3 mov r3 ,-(sp) mov #LN$MAX ,r4 asr r4 asr r4 asr r4 20$: mov r3 ,(sp) movb editim ,r2 asr r2 asr r2 asr r2 inc r2 30$: call desalt sob r2 ,30$ add #10 ,r3 sob r4 ,20$ cmp (sp)+ ,(sp)+ mov (sp)+ ,r4 mov (sp)+ ,r3 mov (sp)+ ,r2 mov (sp) ,4(sp) cmp (sp)+ ,(sp)+ return .dsabl lsb .endc .sbttl Control C, Synch interupts and pseudo vector ...CC:: ; Control C things ...2CC::.TTECH ; Enable echoing .TTRST ; And reset other terminal stuff rti ; And dismiss the interupt .enabl lsb ...IOT::PRINT #210$ br ...DCL ..FPER:: ; Should never get here. ...BAD::movb FIRQB ,r2 ; Save exec's error code mov sp ,r3 ; Save stack PRINT #200$ ; Die PRINT #230$ ; Info OCTOUT r2 ; Error code PRINT #240$ OCTOUT @r3 ; PC PRINT #240$ OCTOUT 2(r3) ; PS PRINT #300$ ; CR/LF br ...dcl ; Exit ...HUH::PRINT #220$ ; A message br ...dcl ; And goto DCL ...DCL:: CLRXRB ; Clear delimiters mov #11 ,XRB+XRLEN ; Function 11 (octal) movb #TTYHND ,XRB+XRBLKM ; Handler index for TTY's .spec ; Do it! CLRXRB ; Clear XRB out CLRFQB ; Ditto for the FIRQB mov #^RDCL ,FIRQB+FQNAM1 ; Go to DCL now mov #-1 ,FIRQB+FQEXT ; Make it the default .RTS ; Try to do this .EXIT ; Go away now. .save .psect $RODATA ,D 200$: .asciz /??CLE-F FP error or other trap/ 210$: .asciz /IOT trap/ 220$: .asciz /??CLE-F $ (DCL) CCL Command failed/ 230$: .asciz /Error code, PC and PS:/ 240$: .asciz / / ;some spaces would be nice... 300$: .asciz .even PDELIM:: ; Private delimter mask .word 177777 ; every thing but ctrl/T .word 177745 .word 177777 .word 177777 .word 177777 .word 177777 .word 177777 .word 177777 .restore .psect .99998 .blkw 30 .psect .99999 ..psta::.word PF.KBM!PF.NER ; KBM and no error logging .rad50 /CLE/ ; Default 'runnable' extention .word 0 ; Reserved .word 1 ; 1 KW min size .word ..FPER ; FIS (an 11/40?) .word 0 ; Reserved .word 0 ; Reserved .word ...NEW ; 'New' user entry point .word ...RUN ; 'Run' entry .word ...BAD ; Junk .word ...BAD ; BPT .word ...IOT ; IOT .word ...BAD ; Non-exec EMT's .word ...BAD ; TRAP's .word ..FPER ; FPU errors .word ...CC ; Control C .word ...2CC ; Two of the things .word 1 ; P.SIZE, max size ..pend:: .end