TITLE KERMIT-10 KL10 Error-free Reciprocol Micro Interchange over TTY-lines. SUBTTL DECsystem-10 version - Antonino N.J. Mione/NB/RCM/VJC ; Search the required universals SEARCH GLXMAC ; Galaxy definitions SEARCH ORNMAC ; Get parser definitions SEARCH UUOSYM ; Get symbols for Monitor calls ; Define parser globals PARSET ; Parser global definitions EXTERN PARSER ; Get main parser routine EXTERN P$HELP ; Get parser help routine EXTERN P$TAKE ; Get take file routine ; Define the proglogue .TEXT |REL:OPRPAR/SEG:LOW| ; Make sure we load OPRPAR in lowseg PROLOG (KERMIT) ; Define the version number for KERMIT-10 KERVER==1 ; Major version number KERMIN==0 ; Minor version number KERWHO==0 ; Last editor KEREDT==14 ; Edit number LOC <.JBVER==:137> ; Version number word VRSN. (KER) ; Expand the version number RELOC ; Back to normal SUBTTL Table of Contents SUBTTL Revision History COMMENT | 1 Create this program. 2 By: Nick Bush On: 22-Oct-82 Make it transfer ASCII files and have error processing work. 3 By: Robert C. McQueen On: 28-Oct-83 Make the quoting character not convert the quoting character on a receive (PUTCH). 4 By: Nick Bush On: 16-November-1982 Fix problem with GETCH when an EOF occurs on entry. Also fix error processing for IN and OUT UUO failures. Add check for control-C in input and abort when seen. 5 By: Nick Bush On: 9-February-1983 Add SET FILE-WARNING ON/OFF to use different name for output file if named file already exists. 6 By: Vanya J. Cooper (@Pima Community College) On: 23-Febuary-83 Add CONNECT command 7 By: Vanya J. Cooper (@Pima Community College) On: 1-March-83 Add some messages if transfer aborts and misc. fix ups. 10 By: Vanya J. Cooper (@Pima Community College) On: 1-March-83 Fix problems with 7-bit mode. GETCH did not work properly if there were quoted characters in the buffer because it used the output byte count to see if at end of word. PUTCH did not recognize a quoted quote character with parity on. Test input pointer in GETCH to see if last byte in word like PUTCH and fix PUTCH to ignore parity in 7-bit mode. 11 By: Vanya J. Cooper (@Pima Community College) On: 8-March-83 Use separate I/O channel for commands and data transfers and leave them opened all the time unless there is a conflict. Fixes several problems when using CONNECT or transfer over a different line. 12 By: Vanya J. Cooper (@Pima Community College) On: 9-March-83 Add SET ESCAPE command and some information messages when recieving files. Also add range check when setting quote character 13 By: Robert C. McQueen On: 12-April-1983 Merge edits by Vanya J. Cooper and Antonino into a single source. 14 By: Nick Bush On: 24-April-1983 Fix handling of quoting character to ignore parity bit when checking character being sent, and checking for quoted quote character on receive. | SUBTTL Definitions ND PDLLEN,^D200 ; Set up pushdown list SUBTTL Routine information blocks IB: $BUILD IB.SZ ; Initialization block $SET IB.FLG,IT.OCT,1 ; Set open command terminal $SET IB.OUT,,TYPCHR ; Default type out routine for $TEXT $SET IB.PRG,,%%.MOD ; Program name $EOB PRBLK: $BUILD PAR.SZ ; Size of the block $SET PAR.TB,,KERPAR ; Address of the first parse block $SET PAR.PM,,KERPMT ; Address of the prompt string $EOB KERPMT: ASCIZ |Kermit-10>| ; The KERMIT-10 prompt string SUBTTL Definitions of symbols and global variables STATE==P1 ; State accumulator RTOT==STATE+1 ; Number of chars received STOT==RTOT+1 ; Number of chars sent RCHR==STOT+1 ; Number of data chars received SCHR==RCHR+1 ; Number of data chars sent DATIND==SCHR+1 ; Index to data buffers COMPAR==DATIND+1 ; Comparisons and temp values WORK1==DATIND ; Alternate name for this register WORK2==COMPAR ; Alternate name for reg MXPACK=="~"-" " ; Maximum packet size SOH==.CHCNA ; Start of header character TTY==1 ;[011] Channel for my TTY CHAN==2 ; Symbol for channel of terminal device HDRLEN==2 ; Length of header TRLLEN==1 ; Length of trailer OVRLEN==HDRLEN+TRLLEN ; Total overhead length ; ; The following symbols are used for init packet offsets of the ; various control characters in the information data buffer ; SUBTTL Definitions of symbols and global variables -- init packet offsets MXPOF==0 ; Packet size offset TIMOF==1 ; Timeout offset PADOF==2 ; Padding amount offset PADCOF==3 ; Pad character offset EOLOF==4 ; Eol character offset QUOTOF==5 ; Quote character offset ; ; The following are more symbols used as offsets ; SUBTTL Definitions of symbols and global variables -- offsets and masks CWOFF==1 ; Offset of control word in FOB UDXOFF==1 ; Offset in arglist for termop of UDX OBTOFF==2 ; Offset of data byte word in arglist IBTOFF==2 ; Offset of input byte word in arglist ; The next symbol contains a standard break mask B1==1B<.CHCNC>!1B<.CHBEL>!1B<.CHBSP>!1B<.CHLFD>!1B<.CHVTB> B2==1B<.CHFFD>!1B<.CHCNR>!1B<.CHCNT>!1B<.CHCNV>!1B<.CHCNW> B3==1B<.CHCNZ>!1B<.CHESC>!1B<.CHCRT> BRKM==B1!B2!B3 ; Construct the entire break mask Purge B1,B2,B3 ; Get rid of those temporary symbols SXBMSK=MASKB(30,35) ; Mask for a six bit r-justified byte SBMASK=MASKB(29,35) ; Mask for a seven bit r-justified byte EBMASK=MASKB(28,35) ; Mask for an eight bit rj byte SUBTTL Definitions of symbols and global variables -- Default parameters ; The following are the defaults used for some of the settable parameters ND DQUOTE,"#" ; Default quoting character ND DPAKLN,^D60 ; Default max packet length ND DPADCH,.CHNUL ; Default padding character ND DPADLN,0 ; Default number of padding characters ND DMAXTR,^D20 ; Default max number of tries ND BUFLEN,200 ; Buffer for receive data ND DESCCH,.CHCNY ;[012] Default escape chr SUBTTL Definitions of symbols and global variables -- Data area $DATA PDL,PDLLEN ; Set up Push down list block LOWBEG:! ; $DATA INTVEC,4 ; Interupt vector $DATA PRTARG,2 ; Save are for parser return args $DATA SFDARG,2 ; Save area for FD pointers $DATA WORK,2 ; Scratch work area $DATA LOCAL ; Local/remote flag $DATA SIZE ; Size of present data $DATA FILNAM ; Name of file being transmitted $DATA MN ; Message number $DATA DELAY ; Delay time (secs) before first send $DATA DEBSWT ; Debugging switch $DATA USELOG ; Switch indicating log file use $DATA EOPBF ; Point to end of pckt in debug rtns $DATA TTYLIN ; TTY line number for transmission $DATA FBSIZ ; File byte size switch $DATA FILWRN ; File warning flag $DATA RPSIZ ; Max receive packet size $DATA SPSIZ ; Max send packet size $DATA RPAD ; Amount of pad expected by this Kermit $DATA RPADC ; Padding character for this Kermit $DATA REOL ; End of line character for this Kermit $DATA RQUOTE ; Quote character for this Kermit $DATA SQUOTE ; Quote character of other Kermit $DATA SPAD ; Padding needed by other Kermit $DATA SPADC ; Pad character for other Kermit $DATA SEOL ; End of line char for other Kermit $DATA RTIME ; Secs before time-out (this Kermit) $DATA STIME ; Secs before time-out (other Kermit) $DATA ESCCHR ;[012] Escape chr for CONNECT $DATA ESCTXT,3 ;[012] Ascii name for esc chr $DATA MAXTRY ; Maximum number of tries for a packet $DATA NUMTRY ; Number of tries on current packet $DATA OLDTRY ; Number of tries for prev packet $DATA DAT,^D20 ; Buffer for exchange of cntl chars $DATA FILIFN ; Internal file number $DATA OF.FOB,2 ; File Open Block $DATA FDB,FDXSIZ ; FD for file specified by remote $DATA JOBNO ; Job number running this program $DATA TRMUDX ; Udx for this terminal $DATA MYTRM ; UDX for controlling terminal $DATA NOTERM ; Flag whether we can type on controlling terminal during transfer (0 = yes) $DATA TRMOPN ; Flag whether data line terminal is open $DATA ERRIDX ; Index into send buffer for error characters $DATA ERRBUF,^D132/5+1 ; Buffer for last error message $DATA OFBUF,BUFLEN ; Output file buffer for putch $DATA CHKSUM ; Checksum register $DATA USEHDR ; Use file header for file name ind. $DATA ABUF ; Address of current buffer $DATA NUMBYT ; Number of bytes in termnl output buf $DATA BYTREM ; Number of bytes in file buffer $DATA BUFEMP ; Non-zero if buffer is empty $DATA EOFINP ; Eof indicator $DATA CURRBP ; Byte pointer to file buffer $DATA ERRCOD ; Error code return value $DATA K.RGSV,2 ; Register save area for interupt rtn $DATA TIMLIM,1 ; Time at which to fail on timeout $DATA T.SBUF,1 ; Size of allocated terminal buffers $DATA T.NBUF,1 ; Number of allocated terminal buffers $DATA T.IBA,1 ; Area to save the input buffer address $DATA T.OBA,1 ; Area to save output buffer address $DATA INBUF,MXPACK-OVRLEN ; Packet buffer $DATA OUTBUF,MXPACK-OVRLEN ; Output packet buffer K.TMFB: BLOCK 1 BLOCK 1 XWD T.OUTB,T.INB ; Pointers to input and output BCB's T.OUTB: BLOCK 1 ; Pointer to current output buffer T.OBP: BLOCK 1 ; Byte pointer to character in buffer T.OBC: BLOCK 1 ; Count of free bytes in buffer T.INB: BLOCK 1 ; Pointer to current input buffer T.IBP: BLOCK 1 ; Byte pointer to character in buffer T.IBC: BLOCK 1 ; Count of bytes remaining in buffer LOWSIZ==.-LOWBEG ; Size of this data area FBWRD: FLD (3507,7777B29) ; Used to set up byte pointer ACTION: [ASCIZ |SENDING |] [ASCIZ |SEND COMPLETE |] [ASCIZ |TRYING TO RECEIVE |] [ASCIZ |RECEIVED |] [ASCIZ |FAILED TO RECEIVE |] [ASCIZ |HIT INTERUPT ROUTINE |] [ASCIZ |TIMED OUT WAITING |] KERPAR: $INIT(KERKEY) ; Initial block for command tree KERKEY: $KEYDSP(KERCOM) ; Start of key table KERCOM: $STAB DSPTAB(KERCON,CNCT.,) ;[006] Connect command entry DSPTAB(KEREXI,EXIT.,) ; Exit command entry DSPTAB(KERHLP,HELP.,) ; Help command entry DSPTAB(KEREXI,EXIT.,) ; Quit command entry DSPTAB(KERREC,REC.,) ; Receive command entry DSPTAB(KERSEN,SEND.,) ; Send command entry DSPTAB(KERSET,SET.,) ; Set command entry DSPTAB(KERSHO,SHOW.,) ; Show command entry DSPTAB(KERSTA,STAT.,) ; Status command entry $ETAB CONFRM: $CRLF SUBTTL Macro Definitions ; In the following macro definitions, SRC refers to a memory word of the ; input to the macro and DEST is the output of the macro. AC is the work ; accumulator. (S1 is normally used unless another ac is given.) DEFINE CHAR (SRC,AC<1>,DEST) ; Move the char. to the range 40-137 < MOVE AC,SRC ; Get the value in the AC ADDI AC,40 ; Add 40 to make it a printable char. IFNB < MOVEM AC,DEST>; If they gave a destination - save ac > DEFINE UNCHAR (SRC,AC<1>,DEST) ; Move the char. to the range 0-77 < MOVE AC,SRC ; Move the value into the AC SUBI AC,40 ; Sub 40 to make it a ctl char. IFNB < MOVEM AC,DEST>; If there is a destination - save ac > DEFINE CTL (SRC,AC<1>,DEST) ; Change printability of ctl character < MOVE AC,SRC ; Move the value into the AC XORI AC,100 ; Set or reset the high order bit IFNB < MOVEM AC,DEST>; If there is a destination - use it. > DEFINE CLR (SRC,LEN<0>,AC) ; This macro zeros a block of storage < SETZM SRC ; Zero the first word of the block MOVE AC,[XWD SRC,SRC+1] ; Set up the BLT pointer BLT AC,SRC+LEN-1 ; Wipe out the block! > DEFINE INCN ; Incr. packet num mod 100 octal < AOS MN ; Increment the packet number MOVEI S1,SXBMSK ; Set it up to chop the extra stuff ANDM S1,MN ; CHOP! > DEFINE NAK < SETZB T1,T2 ; No data length or location for a NAK MOVE T3,MN ; Packet which we are NAKING MOVEI T4,"N" ; Code for a NAK $CALL S.PAK ; Send it out > ; Macro to return error to micro DEFINE $KERR(MSG),< $CALL KERROR ;; Call error processing routine JUMP [ITEXT()] ;; Generate the text > ; End of $KERR SUBTTL Program initialization KERMIT: JFCL ; Reset the flags RESET ; Reset the world CLR LOWBEG,LOWSIZ ; Clear the data area MOVE P,[IOWD PDLLEN,PDL] ; Set up the pointer to the pdl MOVX S1,IB.SZ ; Get the size of the GLXLIB initialization block MOVEI S2,IB ; And the address $CALL I%INIT ; And initialize GLXLIB MOVNI S1,1 ; Set the parm for WAKE to this jobno WAKE S1, ; Now set the wake bit JFCL ; Noop error return MOVX S1,HB.RWJ ; Set up for the HIBER call HIBER S1, ; Make sure no one else can wake us up JFCL ; Noop error return PJOB S1, ; Fetch the job number running this MOVEM S1,JOBNO ; Save it TRMNO. S1, ; Find what our UDX is SETZ S1, ; No terminal? MOVEM S1,TRMUDX ; Save the UDX MOVEM S1,MYTRM ; Remember the controlling terminal TXZ S1,.UXTRM ;[007] Make into line no MOVEM S1,TTYLIN ;[007] for SHOW command MOVEI T1,.CHCRT ; Initialize... MOVEM T1,REOL ; Receive and MOVEM T1,SEOL ; Send EOL characters MOVEI T1,DQUOTE ; Initialize... MOVEM T1,RQUOTE ; Receive and MOVEM T1,SQUOTE ; Send EOL characters MOVEI T1,DPAKLN ; Setup maximum... MOVEM T1,RPSIZ ; Receive and MOVEM T1,SPSIZ ; Send packet sizes MOVX T1,DPADCH ; Default the pad character MOVEM T1,RPADC ; on both the send and receive MOVEM T1,SPADC ; ends MOVX T1,DESCCH ;[012] Default escape MOVEM T1,ESCCHR ;[012] TRO T1,100 ;[012] Make the ASCIZ name $TEXT(<-1,,ESCTXT>,<^7/[.CHLAB]/CONTROL-^7/T1/^7/[.CHRAB]/^0>) ;[012] SETZM NUMBYT ; Also zero Number of bytes SETZM BYTREM ; Bytes remaining SETZM CURRBP ; Current byte pointer SETZM EOFINP ; EOF indicator SETZM ERRCOD ; Error code MOVEI T1,DPADLN ; Initalize the send and receive MOVEM T1,RPAD ; padding size to MOVEM T1,SPAD ; decimal 20 MOVX T1,DMAXTR ; Default maximum number of tries MOVEM T1,MAXTRY ; Initialize maxtry to decimal 20 MOVEI T1,5 ; Set default delay before first send MOVEM T1,DELAY ; to 5 seconds MOVEI T1,^D15 ; Set... MOVEM T1,RTIME ; receive and MOVEM T1,STIME ; send time-out limits REPEAT 0,< MOVEI S1,IBRDY ; The interrupt routine is in-buf ready MOVEM S1,INTVEC ; Move that address in SETZ S1, ; Zero the register IORX S1,PS.VDS!PS.RID!PS.ROD ; and set necessary status bits MOVEM S1,INTVEC+.PSVFL ; Store the status word MOVEI S1,INTVEC ; Get address of the int vec block PIINI. S1, ; Initialize software interupt system JFCL ; Noop error return > ; End of REPEAT 0 $CALL OCTERM ; Open the command terminal normally $CALL P$INIT ; Do the init for parser routines SETZB RTOT,STOT ; Zero all the status registers SETZB RCHR,SCHR SUBTTL Main routine PARLOP: MOVE P,[IOWD PDLLEN,PDL] ; Reset PDL in case of error SKIPN S1,PAR.CM+PRBLK ; Have any parsed data around... JRST NODAT ; No, skip it MOVX S2,COM.SZ-1 ; Get the size and... STORE S2,.MSTYP(S1),MS.CNT ; store it. NODAT: MOVEI S2,PRBLK ; Get the address and MOVX S1,PAR.SZ ; length of the parser data block $CALL PARSER ; Do the call to parser DMOVEM S1,PRTARG ; Save these in memory LOAD T1,PRT.CM(S2) ; Get the address of the parsed data STORE T1,PAR.CM+PRBLK ; Save for next try LOAD T2,PRT.FL(S2) ; Get the flags TXCN T2,P.ERRO ; Check for errors JUMPT CONPAR ; No errors so continue parsing $TEXT (,<^M^J? ^T/@PRT.EM(S2)/^A>) ; Print the error message JRST PARLOP ; Start the loop again CONPAR: MOVEI S1,COM.SZ(T1) ; Get the address $CALL P$SETU ; Set up addr. of the 1st data block $CALL P$KEYW ; Try for a keyword $CALL (S1) ; Found a keyword, jump to th routine JRST PARLOP ; Loop back to get another command SUBTTL CONNECT command -- Command tables KERCON: $NOISE(KERCN1,) ;[006] KERCN1: $NUMBER(KERCN2,10,,<$ALTERNATE(KERCN2)>) ;[006] KERCN2: $CRLF SUBTTL CONNECT command -- Command processing routine CNCT.: $CALL P$NUM ;[006] See if line no. given JUMPF CNCT.1 ;[006] Jump if none MOVEM S1,TTYLIN ;[006] Save line no for status ADDI S1,.UXTRM ;[006] Turn into UDX MOVEM S1,TRMUDX ;[006] Store away SKIPE TRMOPN ;[011] Was one already open? $CALL CLOTRM ;[011] Yes, need to re-open CNCT.1: MOVE S1,TRMUDX ;[006] Get line UDX CAME S1,MYTRM ;[006] My terminal? JRST CNCT.2 ;[006] No, ok $KERR() ;[006] $RETF ;[006] and fail ;[006] Ok, now do it CNCT.2: $TEXT(,<[Connecting to remote host via line ^O/TTYLIN/]>) ;[012] PUSH P,REOL ;[006] Save real EOL chr SETZM REOL ;[006] and force break on all chrs $CALL OPNTRM ;[006] Open in PIM mode JUMPF [POP P,REOL ;[006] Restore real EOL chr $KERR() ;[006] $RETF] ;[006] POP P,REOL ;[006] Restore EOL chr ;[006] The following is a bit kludgy because it takes advantage of ;[006] the fact that if the terminal is in PIM mode, SCNSER will do ;[006] all I/O, including TTCALLs and TRMOP.s, in image mode. This ;[006] greatly simplifies the handling of the controlling terminal, ;[006] but if this "feature" gets broken in a future monitor release, ;[006] this section of the code will have to be rewritten to use ;[006] asyncronous IN and OUT uuos, like the data line. SETSTS TTY,.IOPIM ;[011] Set PIM mode SETZM TIMLIM ;[006] Never wait for input $TEXT(CN.TYP,) ;[012] MOVEI STATE,"S" ;[006] Send chrs state ;[006] This the main CONNECT loop. Get chrs from terminal and ;[006] send them down the data line and vice versa. CN.LP: INCHRS S1 ;[006] Get a chr JRST CN.LP1 ;[006] none CAIN STATE,"E" ;[006] In escape sequence? JRST CN.ESC ;[006] Yes CAIN STATE,"C" ;[006] control chr mode? JRST CN.CTL ;[006] yes CAME S1,ESCCHR ;[012] Is this escape? JRST CN.SND ;[006] no, just send it MOVEI STATE,"E" ;[006] Yes, set escape mode JRST CN.LP ;[006] and loop ;[006] Previous chr was an escape chr, check for special commands CN.ESC: CAIE S1,"C" ;[006] Is is C CAIN S1,"c" ;[006] or lower case c? JRST CN.END ;[006] Yes done MOVEI STATE,"S" ;[006] Assume not send control chr CAMN S1,ESCCHR ;[012] Another escape? JRST CN.SND ;[006] Yes, send a real one CAIN S1,"?" ;[006] want help? JRST CN.HLP ;[006] Yes, do it CAIE S1,"S" ;[006] Want status? CAIN S1,"s" ;[006] or lower case "s" JRST CN.STS ;[006] Yes CAIE S1,"^" ;[006] Want control chr? JRST CN.ESE ;[012] No, bad MOVEI STATE,"C" ;[006] Yes, set state JRST CN.LP ;[006] and loop CN.ESE: MOVX S1,.CHBEL ;[012] Control-G $CALL CN.TYP ;[012] DING JRST CN.LP ;[012] And loop ;[006] Control chr mode - change next chr to control chr CN.CTL: MOVEI STATE,"S" ;[006] Next state CAIL S1,100 ;[006] See if reasonable CAILE S1,132 ;[006] also allow lower case JRST CN.LP ;[006] No, ignore it ANDI S1,37 ;[006] make a control chr JRST CN.SND ;[006] and send it ;[006] Process ? - give them some hints CN.HLP: $TEXT(CN.TYP,<^M^JCONNECT escape commands:>) ;[012] $TEXT(CN.TYP,< ^T/ESCTXT/C - Close connect and return to local KERMIT>) ;[012] $TEXT(CN.TYP,< ^T/ESCTXT/S - Type status>) ;[012] $TEXT(CN.TYP,< ^T/ESCTXT/? - Help (this message)>) ;[012] $TEXT(CN.TYP,< ^T/ESCTXT/^T/ESCTXT/ - Send actual ^T/ESCTXT/>) ;[012] MOVEI S1,[ASCIZ |^x (where x is A-Z,[,\,],^,_) - Send CONTROL-x. Only|] ;[012] $TEXT(CN.TYP,< ^T/ESCTXT/^Q/S1/>) ;[012] Avoid confusing $TEXT $TEXT(CN.TYP,< needed to send CONTROL-S and CONTROL-Q, since other>) ;[012] $TEXT(CN.TYP,< control characters can be typed directly.>) ;[012] JRST CN.LP ;[006] and loop ;[006] Process S - give status CN.STS: $TEXT(CN.TYP,<^M^J[Connected to remote host via line ^O/TTYLIN/]>) ;[012] JRST CN.LP ;[006] and loop ;[006] Send the chr in S1 down the data line CN.SND: $CALL COUT ;[006] Send chr down line JRST CN.LP ;[006] and loop ;[006] No more TTY input just now, see if we did any at all CN.LP1: HRRZ S1,T.OBP ;[006] Look at output buffer JUMPE S1,CN.LP2 ;[006] Jump if nothing there OUT CHAN, ;[006] got some, force out now JRST CN.LP2 ;[006] Sucess STATZ CHAN,IO.ERR ;[006] Check for errors JRST OUTERR ;[006] Error, give up ;[006] Must be no buffer available ;[006] Next COUT will handle CN.LP2: $CALL CIN ;[006] Get a chr from line JUMPF CN.HIB ;[006] None $CALL CN.TYP ;[012] Type it on TTY JRST CN.LP ;[006] go check for TTY input again ;[006] No output either, take a break CN.HIB: MOVE S1,[HB.RIO+HB.RTC+HB.RWJ+^D1000] ;[006] HIBER S1, ;[006] Wait a bit JFCL ;[006] ignore error JRST CN.LP ;[006] and again ;[006] Here when done to close line and reset TTY status CN.END: SETSTS TTY,IO.SUP!.IOASC ;[011] Reset tty mode $TEXT(,<^M^J[Connection closed. Returning to local KERMIT]>) ;[006] $RETT ;[006] CN.TYP: OUTCHR S1 ;[012] Type it $RETT ;[012] and return SUBTTL Exit command -- Command tables ; ; This routine merely looks for a confirm after the EXIT command and then ; halts the program. A true return is present after the halt in case ; the user wishes to reeenter or continue the program. ; KEREXI: $NOISE(CONFRM,) SUBTTL Exit command -- Command processing routine EXIT.: SKIPE TRMOPN ;[011] Data line open? $CALL CLOTRM ;[011] Yes, close it $HALT ; STOP! $RETT ; Just in case they want to continue SUBTTL HELP command -- Command tables ; ; The HELP command looks for a topic to give help on. If one is present, it ; prints help for that command from HLP:KERMIT.HLP, otherwise it will ; print the entire file. ; KERHLP: $NOISE(KERSUB,) KERSUB: $CTEXT(KERCFM,) KERCFM: $CRLF SUBTTL HELP command -- Command processing routine HLPFD: $BUILD FDMSIZ ; This is the FD for the help file $SET .FDLEN,FD.LEN,FDMSIZ ; Insert the length of this FD $SET .FDLEN,FD.TYP,.FDNAT ; The type of file is native $SET .FDSTR,, ; The device on which the file resides $SET .FDNAM,,%%.MOD ; The filename $SET .FDEXT,, ; And the extension $EOB HELP.: $CALL P$CFM ; Is there a confirm... JUMPT HELP.0 ; No, so print the whole file $CALL P$TEXT ; Get the text to look up in the file ADD S1,[POINT 7,PFD.D1] ; Set up byte pointer to text for the ; help routine's search string JRST HELP.1 ; Go print the help HELP.0: MOVE S1,[POINT 7,[BYTE (7).CHNUL,.CHNUL]]; Set up null byte pointer HELP.1: MOVEI S2,HLPFD ; Fetch the address of the file FD EXCH S1,S2 ; Make sure they are in the right regs. $CALL P$HELP ; Now let the help routine do the work $RETT ; And return SUBTTL RECEIVE command -- Command tables ; ; This routine parses and acts on the receive command. It tells this Kermit to ; expect an incomming file and optionally gives it a file name to use for ; output of the arriving data. This routine uses (=destroys) the ; following registers: ; ; S1-S2 : Work registers ; T1 : Work registers ; T1-T4 : Parameter passing to lower level subroutines ; KERREC: $NOISE(KRREC2,) KRREC2: $OFILE(KRREC3,,<$ALTERNATE(KRREC3)>) KRREC3: $CRLF SUBTTL RECEIVE command -- Command processing routines REC.: SETZM USEHDR ; Assume we have a file spec $CALL P$OFIL ; Try to parse an output file SKIPT ; Did we get a file spec? SETOM USEHDR ; No, use file spec from file-init packet DMOVEM S1,SFDARG ; Save the address of the file name $CALL OPNTRM ; Open up the terminal JUMPF [$KERR() $RETF] $CALL RSWT. ; process everything SKIPE NOTERM ;[011] If we are on the TTY $CALL CLOTRM ; And give up the terminal $RETT ; Return RSWT.: SETZB RTOT,STOT ; Zero all the character counters SETZB RCHR,SCHR ; used in status command SETZM MN ; Set packet counter to zero SETZM NUMTRY ; Reset tries SETZM EOFINP ; EOF indicator SETZM ERRCOD ; Error code RSWT.1: MOVEI STATE,"R" ; Start with state 'Receive-init' SETZM NUMTRY ; Zero number of tries for this packet CLR INBUF,MXPACK-OVRLEN ; Clear input buffer CLR OUTBUF,MXPACK-OVRLEN ; Clear output buffer CLR DAT,^D10 ; Clear info data buffer RSWT.2: CAIE STATE,"D" ; Is our state 'Receive-data' JRST RSWT.3 ; No, try another state $CALL RDAT. ; Yes, go to processing routine for it JRST RSWT.2 ; And loop again to get current state RSWT.3: CAIE STATE,"F" ; Is our state 'Receive-file' (header) JRST RSWT.4 ; No, try another one $CALL RFIL. ; Yes, process that routine JRST RSWT.2 ; Loop to get the current state RSWT.4: CAIE STATE,"R" ; Is our state 'Receive-init' JRST RSWT.5 ; No, next state $CALL RINI. ; Process the receive init JRST RSWT.2 ; Cycle back for the new state RSWT.5: CAIE STATE,"C" ; Is the state 'Complete' JRST RSWT.6 ; No, Looks pretty bad now $RETT ; Yes, file transfer done, true return RSWT.6: $KERR() ;[007] Complain $RETF ; The state at this point is either ; abort or unknown so do false ; return SUBTTL RECEIVE command -- Command processing routines -- Receive Init ; ; The receive init routine downloads the appropriate significant characters and ; values from the init packet sent by the other Kermit. When it ACKs this ; packet it returns a buffer with thwe significant characters it will be ; using for itself. ; RINI.: MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) Then JUMPLE RINI.1 ; We're ok, continue MOVEI STATE,"A" ; Else we took too many tries so abort $RETF ; and return RINI.1: AOS NUMTRY ; Increment the number of tries $CALL R.PAK ; Go fetch the Receive-init packet RINI.F: JUMPT RINI.S ; If we found something, continue NAK ; Nak the packet JRST RINI. ; Look for when they send it again RINI.S: CAIE T4,"S" ; Is the packet a Send-init... JRST RINI.O ; no, we can't use it MOVEM T3,MN ; Save the current packet number MOVE S1,MXPOF(T1) ; Get the max packet size it likes SUBI S1," " ; Convert to numeric value CAMGE S1,SPSIZ ; Is his size smaller than ours? MOVEM S1,SPSIZ ; Yes, use his MOVE S1,TIMOF(T1) ; Get the timeout it likes SUBI S1," " ; Convert to numeric value CAMLE S1,STIME ; Is his time longer? MOVEM S1,STIME ; Yes, use that UNCHAR PADOF(T1),S1,SPAD ; The amount of padding CTL PADCOF(T1),S1,SPADC ; The pad character UNCHAR EOLOF(T1),S1,SEOL ; And the EOL character SKIPN S1,QUOTOF(T1) ; Finally move in the send quote char. MOVEM S1,RQUOTE ; CLR DAT,^D10 ; Clear the data buffer MOVE S1,RPSIZ ; And start loading this Kermits stuff ADDI S1," " ; Begin with the... MOVEM S1,DAT+MXPOF ; packet size CHAR RTIME,S1,DAT+TIMOF ; Then the timeout length CHAR RPAD,S1,DAT+PADOF ; the amount of padding CTL RPADC,S1,DAT+PADCOF ; the pad character CHAR REOL,S1,DAT+EOLOF ; the EOL character MOVE S1,SQUOTE ; and... MOVEM S1,DAT+QUOTOF ; the quote character ; Start the calling sequence for ; the send-packet routine MOVEI T1,DAT ; Load the buffer address MOVEI T2,6 ; Load the length of the buffer MOVE T3,MN ; Load packet number MOVEI T4,"Y" ; And ACK code $CALL S.PAK ; Call the routine MOVEI STATE,"F" ; State should now be 'Receive-file' MOVE S1,NUMTRY ; Now we save the incase the ACK did MOVEM S1,OLDTRY ; not make it to the other Kermit SETZM NUMTRY ; And zero the number of tries INCN ; Increment the packet number $RETT ; Do a true return RINI.O: NAK ; NAK the last packet received JRST RINI. ; Did not see 'Send-init' so try again SUBTTL RECEIVE command -- Command processing routines -- Receive file header RFIL.: AOS T1,NUMTRY ; If (Numtry <= CAMG T1,MAXTRY ; Too many incorrect packets? JRST RFIL.1 ; We're ok, continue the routine MOVEI STATE,"A" ; Else we have to abort and $RETF ; return RFIL.1: $CALL R.PAK ; Try to fetch a packet JUMPT RFIL.2 ; Continue if we got something RFIL.N: NAK ; Nak the unreceived packet JRST RFIL. ; Try to fetch the packet again RFIL.2: CAMN T3,MN ; Packet number we were expecting? JRST RFIL.F ; Yes, go check if file header MOVE S1,MN ; No, get the packet number CAIE S1,1(T3) ; Is this a copy of the previous packet? JRST RFIL.N ; No, give a nak CAIE T4,"S" ; Was it a start CAIN T4,"Z" ; Or an EOF? JRST RFIL.Y ; Yes, give an ack and try again RFIL.A: MOVEI STATE,"A" ; Abort the link $RETF ; Make sure that is understood ; Here to ack the repeated packet and try again RFIL.Y: SETZB T1,T2 ; No data MOVEI T4,"Y" ; This is an ack $CALL S.PAK ; Send the ack (T3 still has message number) JRST RFIL. ; Go try again ; Here if the packet has the expected sequence number RFIL.F: CAIE T4,"F" ; Is this the file header? JRST RFIL.B ; No, check for a break SKIPE USEHDR ; Need to save this data for file name? $CALL GTSPEC ; Get the file spec from the packet MOVE T2,SFDARG ; Get the address of the FD MOVEI T1,"O" ; Want to open output file $CALL OFILE ; Do it JUMPT RFIL.3 ; If we got it, all is fine $KERR () ; Punt MOVEI STATE,"A" ; Want to abort now $RETF ; . . . RFIL.3: $TEXT(,) ;[012] SETZB T1,T2 ; No data MOVE T3,MN ; Get the message number to reply to MOVEI T4,"Y" ; Just an ack $CALL S.PAK ; Send it back INCN ; Bump the message number MOVEI STATE,"D" ; Now we want data $RETT ; Go back for dispatch ; Here if the packet is not a file header. Only other valid ;possibility is a Break packet RFIL.B: CAIE T4,"B" ; Is it the break packet? JRST RFIL.A ; No, abort SETZB T1,T2 ; Yes, return the ack MOVEI T4,"Y" ; . . . $CALL S.PAK ; . . . INCN ; Bump the message number MOVEI STATE,"C" ; State is now complete $RETT ; All done ; Subroutine to build the FD from the file header packet GTSPEC: $SAVE ; Save P1 and P2 CLR FDB,FDXSIZ ; Yes, clear out the FD MOVX S1,FDXSIZ ; Get the size of the FD STORE S1,.FDLEN+FDB,FD.LEN ; Store it MOVX S1, ; Get the default device MOVEM S1,.FDSTR+FDB ; Save it MOVE S2,[POINT 6,.FDNAM+FDB] ; Point to the name field SETZ P1, ; Start with first data item MOVEI P2,'.' ; Stop file name on a dot GTSP.1: MOVE S1,INBUF(P1) ; Get the character ANDX S1,177 ; Keep only 7 bits CAIL S1,"`" ; Lower case character? SUBX S1,"a"-"A" ; Yes, upcase it SUBX S1,"A"-'A' ; And then to sixbit JUMPLE S1,GTSP.E ; If control character, all done CAMN S1,P2 ; Terminator for this field? JRST GTSP.2 ; Yes, check if we now have extension CAXL S1,'0' ; Is this a legal character? CAXLE S1,'Z' ; . . . AOJA P1,GTSP.1 ; No, skip it CAXGE S1,'A' ; . . . CAXG S1,'9' ; . . . JRST .+2 ; Yes, store it AOJA P1,GTSP.1 ; No, try the next TXNE S2,BP.POS ; Any space left in this word? IDPB S1,S2 ; Yes, store the character AOJA P1,GTSP.1 ; Loop for the next character ; Here if we have the terminator for the field. Currently this ;can only be the "." that starts the extension GTSP.2: SETZ P2, ; No further terminator MOVE S2,[POINT 6,FDB+.FDEXT] ; Point to the extension word AOJA P1,GTSP.1 ; And go get the next character GTSP.E: MOVEI S1,FDB ; Get the address of the FDB MOVEM S1,SFDARG ; Save as address for open $RETT ; And return SUBTTL RECEIVE command -- Command processing routines -- Receive data RDAT.: MOVE S1,NUMTRY ; If (Numtry <= SUB S1,MAXTRY ; Maxtry) Then JUMPLE S1,RDAT.1 ; continue MOVEI STATE,"A" ; Else too many tries...abort $RETF ; and return RDAT.1: AOS NUMTRY ; Increment number of tries counter $CALL R.PAK ; Try to fetch a packet JUMPT RDAT.D ; Continue if we got something NAK ; Nak the unreceived packet JRST RDAT. ; Try to fetch another packet RDAT.D: CAIE T4,"D" ; Is the type 'Send-data' JRST RDAT.F ; No, try 'Send-file' CAME T3,MN ; Yes, now is it the correct packet JRST RDATAP ; No, but it may be the previous one MOVE S2,T2 ; Get the character count received $CALL PUTCH ; Yes, put the characters in the file JUMPF RDAT.A ; Something did not work, go abort SETZB T1,T2 ; No data MOVE T3,MN ; Get the message number this was MOVEI T4,"Y" ; This is an ACK $CALL S.PAK ; Send it INCN ; Bump the message number SETZM NUMTRY ; This one worked $RETT ; And return RDATAP: MOVE S1,OLDTRY ; If (Oldtry <= SUB S1,MAXTRY ; Maxtry) Then JUMPLE S1,RDATD1 ; continue MOVEI STATE,"A" ; Else, we tried enough times, abort $RETF ; and return RDATD1: AOS OLDTRY ; Increment tries for last packet MOVE S1,MN ; Get the current message number CAME S1,1(T3) ; Less than what we are looking for? JRST RDAT.O ; No, try again SETZB T1,T2 ; Yes, get ready to re-ACK the packet MOVEI T4,"Y" ; Enter code for ACK $CALL S.PAK ; Send the ACK packet SETZM NUMTRY ; Zero the try count for this packet $RETT ; and leave RDAT.F: CAIE T4,"F" ; See if we have a 'Send-file' packet JRST RDAT.Z ; No, go try for 'EOF' MOVE S1,OLDTRY ; Yes... If (Oldtry <= SUB S1,MAXTRY ; Maxtry Then JUMPLE S1,RDATF1 ; continue MOVEI STATE,"A" ; Else, abort $RETF ; and return RDATF1: AOS OLDTRY ; Increment try count for prev packet MOVE S1,MN ; Get the current message number CAME S1,1(T3) ; For previous packet? JRST RDAT.O ; No, try again SETZB T1,T2 ; Yes, so re-ACK the packet MOVEI T4,"Y" ; Enter type code for ACK $CALL S.PAK ; Send it SETZM NUMTRY ; Zero tries for current packet $RETT ; and return RDAT.Z: CAIE T4,"Z" ; Is this a 'Send-EOF' packet JRST RDAT.O ; No, we're out of packet types ; for this state, Nak and retry CAME T3,MN ; Correct sequence number JRST RDAT.O ; No, try again SKIPN BUFEMP ; Buffer have anything in it? $CALL P.WBUF ; Yes, write it out first MOVE S1,FILIFN ; Get the IFN of the file $CALL CFILE ; Yes, finish IO and close the file JUMPF RDAT.A ; Trouble on this end with file, abort $TEXT(,< OK>) ;[012] SETZB T1,T2 ; No data MOVE T3,MN ; Get the message number MOVEI T4,"Y" ; To send the ACK $CALL S.PAK ; Send it MOVE S1,NUMTRY ; Move current try count to previous MOVEM S1,OLDTRY ; SETZM NUMTRY ; Zero the current packet try count INCN ; Increment the packet sequence number MOVEI STATE,"F" ; State should be 'Receive-file' again $RETT ; Return a true RDAT.O: SETZB T1,T2 ; Get ready to NAK MOVEI T4,"N" ; Load the 'NAK' type code $CALL S.PAK ; Send the NAK-pack JRST RDAT. ; Go retry this one RDAT.A: SETZB T1,T2 ; Get ready to NAK MOVEI T4,"N" ; Load the 'NAK' type code $CALL S.PAK ; Send the NAK-pack MOVEI STATE,"A" ; Set state to abort $RETF ; Return a false SUBTTL SEND command -- Command tables ; ; This routine parses the file name of the file to be sent. It calls lower ; support routines to check on the existance of the file and to open ; it. After the initialization section, the main loop of this routine ; (at SSWT.1) is a large case statement which drives the entire routine ; as it progress through the various states of a send procedure. The ; routine uses the following registers: ; ; S1-S2 : Work registers ; T1 : Work registers ; T1-T4 : Parameter passing to lower level subroutines ; KERSEN: $NOISE(KERSN2,) KERSN2: $IFILE(KERSN3,,$DEFAULT(DSK:*.*)) KERSN3: $CRLF SUBTTL SEND command -- Command processing routines SEND.: $CALL P$IFIL ; Try for an input file $RETIF ; Punt if no file spec DMOVEM S1,SFDARG ; Save the pointer to the FD $CALL OPNTRM ; Open the terminal JUMPF [$KERR() $RETF] $CALL SSWT. ; Process the file SKIPE NOTERM ;[011] If we are using the TTY $CALL CLOTRM ; Give up the terminal $RETT ; And return SSWT.: MOVEI STATE,"S" ; State is now send-init SETZM MN ; Set packet counter to zero SETZM NUMTRY ; Reset tries SETZM EOFINP ; EOF indicator SETZM ERRCOD ; Error code CLR INBUF,MXPACK-3 ; Clear input buffer CLR OUTBUF,MXPACK-3 ; Clear output buffer CLR DAT,^D10 ; Clear info data buffer SETZB RTOT,STOT ; Reset char counters SETZB RCHR,SCHR ; Reset data char counters MOVE S1,DELAY ; Load seconds to delay SLEEP S1, ; and DISMISS the process SSWT.1: CAIE STATE,"D" ; Is the state 'Send-data' JRST SSWT.2 ; No, try next one $CALL SDAT. ; Yes, do it. JRST SSWT.1 ; and loop back for next action SSWT.2: CAIE STATE,"F" ; Is the state 'Send-file' (header) JRST SSWT.3 ; No, try the next state $CALL SFIL. ; Yes, do that process JRST SSWT.1 ; and loop back SSWT.3: CAIE STATE,"Z" ; Is it 'Send-EOF' JRST SSWT.4 ; No, next state $CALL SEOF. ; Yes, do that routine JRST SSWT.1 ; and jump back SSWT.4: CAIE STATE,"S" ; Is the state 'Send-init' JRST SSWT.5 ; No, try the next one $CALL SINI. ; Yes, process it JRST SSWT.1 ; and go back to the top SSWT.5: CAIE STATE,"B" ; Is it a 'Send-break' JRST SSWT.6 ; No $CALL SBRK. ; Yes, do it JRST SSWT.1 ; and return to top SSWT.6: CAIE STATE,"C" ; Is the state 'Complete' JRST SSWT.7 ; No, we just ran out of states, abort $RETT ; Yes, finish successfully SSWT.7: $KERR() ;[007] Complain $RETF ; Return FAIL SUBTTL SEND command -- Command processing routines -- Send data SDAT.: MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) Then JUMPLE T1,SDAT.1 ; continue MOVEI STATE,"A" ; Else we tried too many times, abort $RETF ; and return FAIL SDAT.1: AOS NUMTRY ; Increment number of tries for packet SDAT.G: MOVEI T1,OUTBUF ; Load the parms for s.pak - buf addr. MOVE T2,NUMBYT ; The packet size MOVE T3,MN ; The sequence number MOVEI T4,"D" ; and the type of packet $CALL S.PAK ; Send the packet $CALL R.PAK ; Try to receive an ACK packet SDAT.F: SKIPT ; If the packet was good, go on JRST SDAT. ; Else try to send the save packet SDAT.Y: CAIE T4,"Y" ; Is it an ACK? JRST SDAT.N ; No, go see if it is a NAK CAME T3,MN ; Yes, does it ack the right packet? JRST SDAT. ; No, Try to send this one again INCN ; Bump the message number since this was accepted CAIN S1,EREOF$ ; Is this the last? (did we reach EOF) JRST SDAT.L ; Yes, wrap it up MOVE S1,EOFINP ; Get the EOF flag JUMPE S1,SDAT.C ; Did we just send out the last buffer SETZM NUMBYT ; Make sure numbyt is zero so we end. JRST SDAT.L ; Yup, finish it and set new state SDAT.C: SETZM NUMTRY ; No, reset number of tries for packet $CALL GETCH ; Get more characters from the file SKIPF EOFINP ; If we haven't hit end of file, go on JRST SDAT.L ; Else close file and return $RETT ; Return Success SDAT.N: CAIE T4,"N" ; Is it a NAK packet? JRST SDAT.O ; No, it's something we don't recognize JRST SDAT. ; Try this packet again SDAT.O: MOVEI STATE,"A" ; Set the state to abort $RETF ; and return FAIL SDAT.L: SKIPE NUMBYT ; If we have stuff left to send $RETT ; then just return MOVE S1,FILIFN ; Fetch the file number $CALL CFILE ; Close the file MOVEI STATE,"Z" ; Finished sending data, state:='EOF' $RETIF ; Return if the close file did not work $TEXT (,< OK>) ; Acknowledge a good send $RET ; Return Success SUBTTL SEND command -- Command processing routines -- Send file header SFIL.: MOVEI T1,"I" ; Code for OFILE to open file input MOVE T2,SFDARG ; Point to the FD $CALL OFILE ; See if we can open the file JUMPT SFIL.C ; If we were successful, then continue $KERR () ; Print the error MOVEI STATE,"A" ; And abort $RETF SFIL.C: MOVE T2,SFDARG ; Point to the FD MOVE T3,2(T2) ; Point to file name MOVE T4,3(T2) ; Point to extension $TEXT (,) ; Print send notification SFIL.0: MOVE T1,SFDARG ;[007] Start building file name data block MOVE T2,2(T1) ; Modify pointer to point at filename SETZB S1,S2 ; SFIL.1: SETZ T1, ; Get T1 ready to accept characters ROTC T1,6 ; Rotate in a sixbit character CAIN T1,0 ; Is it a null JRST SFIL.2 ; Yes, we're at the end of file name ADDI T1,40 ; Convert it to ASCII MOVEM T1,DAT(S1) ; Move it into next data byte in buf AOJ S1, ; Increment the pointer to data buffer AOJ S2, ; CAIG S1,5 ; Do the above stuff at most 6 times JRST SFIL.1 ; Loop back SFIL.2: ADDI S2,3 ; Now S2 holds entire leng of file.ext MOVEI T1,"." ; Insert the 'dot' MOVEM T1,DAT(S1) ; And move it in MOVE T1,SFDARG ; Now get the address of the PDB again MOVE T2,3(T1) ; And fetch the word with the extension SFIL.3: SETZ T1, ; Clear T1 AOJ S1, ; And increment buf pointer (past dot) ROTC T1,6 ; Rotate in the next sixbit byte ADDI T1,40 ; Change it to ASCII MOVEM T1,DAT(S1) ; Drop it in the next word in buffer CAMG S1,S2 ; Have we reached the end of extension? JRST SFIL.3 ; No, loop back MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) Then JUMPLE T1,SFIL.4 ; continue MOVEI STATE,"A" ; Else, abort it $RETF ; Return the FAIL SFIL.4: AOS NUMTRY ; Increment tries for this packet MOVEI T1,DAT ; Load the parms - address of buffer MOVE T2,S1 ; The length of the data buffer MOVE T3,MN ; The sequence number MOVEI T4,"F" ; The type code ('Send-file') $CALL S.PAK ; Send the packet $CALL R.PAK ; Try to receive an ACK for it SFIL.F: SKIPT ; If we got something good, continue JRST SFIL.0 ;[007] SFIL.Y: CAIE T4,"Y" ; Is it an ACK? JRST SFIL.N ; No, try another type code CAME T3,MN ; Yes, is the sequence number right JRST SFIL.0 ;[007] Try again MOVEI STATE,"D" ; Success, state is now 'Send-data' SETZM NUMTRY ; Zero packet try count INCN ; and increment the sequence num $CALL GETCH ; Go get characters from the file $RET ; and return SFIL.N: CAIE T4,"N" ; Is it a NAK? JRST SFIL.O ; No, unrecognized type code JRST SFIL.0 ;[007] SFIL.O: MOVEI STATE,"A" ; Bad state, abort $RETF ; Return FAIL SUBTTL SEND command -- Command processing routines -- Send End-of-file SEOF.: MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) then JUMPLE T1,SEOF.1 ; continue MOVEI STATE,"A" ; Else, abort it $RETF ; and return the fail SEOF.1: AOS NUMTRY ; Increment the number of tries SETZB T1,T2 ; Load parms for an EOF packet MOVE T3,MN ; The sequence number MOVEI T4,"Z" ; The type code for "EOF" $CALL S.PAK ; Send the EOF packet $CALL R.PAK ; Try to get a reply SEOF.F: SKIPT ; If packet was good, continue JRST SEOF. ; Else, try and send it again SEOF.Y: CAIE T4,"Y" ; Is the response an ACK JRST SEOF.N ; No, try something else CAME T3,MN ; Yes, now is it the right one? $RETF ; No, we missed something, return FAIL SETZM NUMTRY ; Yes, zero try count for packet INCN ; and increment sequence number $CALL GNXTF ; Try to fetch another file to send JUMPT SEOF.G ; If so, continue MOVEI STATE,"B" ; If not, set state to 'Send-break' $RET ; and return to driver SEOF.G: MOVEI STATE,"F" ; Got another file, state:='Send-file' $RETT ; Return Success SEOF.N: CAIE T4,"N" ; Is this packet a NAK JRST SEOF.O ; No, we do not recognize the code JRST SEOF. ; Yes, try to send it again SEOF.O: MOVEI STATE,"A" ; Bad state, abort $RETF ; Return the FAIL SUBTTL SEND command -- Command processing routines -- Send init SINI.: MOVE S1,RPSIZ ; Start loading buffer with special ; values in 'Send-init' packet ADDI S1,40 ; Begin with the max packet size MOVEM S1,DAT+MXPOF ; Move it in CHAR RTIME,S1,DAT+TIMOF ; This is MY timeout length CHAR RPAD,S1,DAT+PADOF ; This is MY amount of padding CTL RPADC,S1,DAT+PADCOF ; This is MY expected padding character CHAR REOL,S1,DAT+EOLOF ; This is what I expect as EOL MOVE S1,RQUOTE ; And finally, MY quote character MOVEM S1,DAT+QUOTOF ; MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) Then JUMPLE T1,SINI.1 ; continue MOVEI STATE,"A" ; Else, set state to 'Abort' $RETF ; and return FAIL SINI.1: AOS NUMTRY ; Increment number of tries for packet MOVEI T1,DAT ; Load parms for s.pak - Buffer address MOVEI T2,6 ; The length of the data MOVE T3,MN ; The sequence number MOVEI T4,"S" ; And the type code ('Send-init') $CALL S.PAK ; Send the packet CLR DAT,5 ; Clear the data buffer $CALL R.PAK ; Try to receive an ACK to last packet SINI.F: SKIPT ; If we got something, go on JRST SINI. ; Else, try the init packet again SINI.Y: CAIE T4,"Y" ; Do we have the ACK we need? JRST SINI.N ; No, try for a NAK CAME T3,MN ; Yes, is sequence of the packet right? JRST SINI. ; No, go back and try again MOVEM T1,ABUF ; Save the address of the buffer UNCHAR INBUF+MXPOF,S1,S2 ; Now save HIS special characters -psiz CAMGE S2,SPSIZ ; Is his packet smaller than ours? MOVEM S2,SPSIZ ; Yes, use the smaller size UNCHAR INBUF+TIMOF,S1,S2 ; HIS timeout length CAMLE S2,STIME ; Does he want more time for packets? MOVEM S2,STIME ; Yes, use his value UNCHAR INBUF+PADOF,S1,SPAD ; HIS amount of padding expected CTL INBUF+PADCOF,S1,SPADC ; HIS pad character MOVEI COMPAR,0 ; Set this up to check the EOL char CAMN COMPAR,INBUF+EOLOF ; Is EOL set to zero? JRST SINI.2 ; Yes, use the default EOL character UNCHAR INBUF+EOLOF,S1,SEOL ; No, set it SINI.2: CAME COMPAR,INBUF+QUOTOF ; Is the quote character a zero? JRST SINI.3 ; No, go set it MOVEI COMPAR,"#" ; Yes, use the default MOVEM COMPAR,SQUOTE ; Move it in JRST SINI.4 ; Skip the next routine SINI.3: MOVE COMPAR,INBUF+QUOTOF ; Move the given quote character into MOVEM COMPAR,SQUOTE ; place SINI.4: MOVEI STATE,"F" ; Set the state to 'Send-file' SETZM NUMTRY ; and zero number of tries INCN ; Increment sequence number of packet $RETT ; Return Success SINI.N: CAIE T4,"N" ; Do we have a NAK here? JRST SINI.O ; No, this is an invalid state JRST SINI. ; Yes, try to send this packet again SINI.O: MOVEI STATE,"A" ; Unrecognized state, set to 'Abort' $RETF ; Return FAIL SUBTTL SEND command -- Command processing routines -- Send break SBRK.: MOVE T1,NUMTRY ; If (Numtry <= SUB T1,MAXTRY ; Maxtry) Then JUMPLE T1,SBRK.1 ; continue MOVEI STATE,"A" ; Else, abort it $RETF ; and return FAIL SBRK.1: AOS NUMTRY ; Increment try count for this packet SETZB T1,T2 ; Prepare to send the break MOVE T3,MN ; Load sequence number of packet MOVEI T4,"B" ; Load type code for 'Break' $CALL S.PAK ; Send the packet $CALL R.PAK ; Try to get ACK from the other Kermit SBRK.F: SKIPT ; If we got something, continue JRST SBRK. ; Otherwise send the break again SBRK.Y: CAIE T4,"Y" ; Is the something we got an ACK? JRST SBRK.N ; No, try for the NAK CAME T3,MN ; Yes, is it in sequence? JRST SBRK. ; No, try and send it again SETZM NUMTRY ; Yes, zero our try count for packet INCN ; and increment the sequence num MOVEI STATE,"C" ; Also, set our state to 'Complete' $RETT ; And return Success SBRK.N: CAIE T4,"N" ; Is the packet a NAK? JRST SBRK.O ; No, unrecognized state, abort JRST SBRK. ; Yes, a NAK, try this one again SBRK.O: MOVEI STATE,"A" ; Set state to 'Abort' $RETF ; Return a FAIL SUBTTL SET command -- Command tables ; ; SET can change the value of any parameter Kermit uses to function including ; all send and receive control characters as well as modes ; (file-byte-size and debug). It uses the following registers: ; ; S1-S2 - Return parms from oprpar, work registers ; KERSET: $KEYDSP(KERST1) KERST1: $STAB DSPTAB(KERDB1,SETDB.,) DSPTAB(KERDL1,SETDL.,) DSPTAB(KERES1,SETES.,) ;[012] DSPTAB(KERFB1,SETFB.,) DSPTAB(KERFW1,SETFW.,) DSPTAB(KERLN1,SETLN.,) DSPTAB(KERRC1,SETRC.,) DSPTAB(KERSN1,SETSN.,) $ETAB KERFW1: ; FILE-WARNING takes same args as DEBUGGING KERDB1: $KEYDSP(KERDB2) KERDB2: $STAB DSPTAB(KERDB3,0,) DSPTAB(KERDB3,-1,) $ETAB KERDB3: $CRLF KERDL1: $NUMBER(KERDL2,^D10,) KERDL2: $CRLF KERES1: $NOISE(KERES2,) ;[012] KERES2: $NUMBER(KERES3,10,) ;[012] KERES3: $CRLF ;[012] KERFB1: $KEYDSP(KERFB2) KERFB2: $STAB DSPTAB(KERFB3,-1,) DSPTAB(KERFB3,0,) $ETAB KERFB3: $CRLF KERLN1: $NUMBER(KERLN2,10,) KERLN2: $CRLF KERRC1: $KEYDSP(KERRC2) KERRC2: $STAB DSPTAB(KERREL,STREL.,) DSPTAB(KERRPL,STRPL.,) DSPTAB(KERRPD,STRPD.,) DSPTAB(KERRPC,STRPC.,) DSPTAB(KERRTM,STRTM.,) $ETAB KERREL: $NOISE(KRREL1,) KRREL1: $NUMBER(KERRCM,10,) KERRPL: $NOISE(KRRPL1,) KRRPL1: $NUMBER(KERRCM,^D10,) KERRPC: $NOISE(KRRPC1,) KRRPC1: $NUMBER(KERRCM,10,) KERRPD: $NOISE(KRRPD1,) KRRPD1: $NUMBER(KERRCM,^D10,) KERRTM: $NOISE(KRRTM1,) KRRTM1: $NUMBER(KERRCM,^D10,) KERRCM: $CRLF KERSN1: $KEYDSP(KERSND) KERSND: $STAB DSPTAB(KERSEL,STSEL.,) DSPTAB(KERSPL,STSPL.,) DSPTAB(KERSPD,STSPD.,) DSPTAB(KERSPC,STSPC.,) DSPTAB(KERSQC,STSQC.,) DSPTAB(KERSTM,STSTM.,) $ETAB KERSEL: $NOISE(KRSEL1,) KRSEL1: $NUMBER(KERSCM,10,) KERSPL: $NOISE(KRSPL1,) KRSPL1: $NUMBER(KERSCM,^D10,) KERSPC: $NOISE(KRSPC1,) KRSPC1: $NUMBER(KERSCM,10,) KERSPD: $NOISE(KRSPD1,) KRSPD1: $NUMBER(KERSCM,^D10,) KERSQC: $NOISE(KRSQC1,) KRSQC1: $CTEXT(KERSCM,) KERSTM: $NOISE(KRSTM1,) KRSTM1: $NUMBER(KERSCM,^D10,) KERSCM: $CRLF SUBTTL SET command -- Command processing routines SET.: $CALL P$KEYW ; Try and get a keyword JUMPT (S1) ; Got one, go to the routine for it $RET ; Return false SETDB.: $CALL P$KEYW ; Debug - try for a keyword $RETIF ; Return if we didn't get one SETDB1: HRRES S1,S1 ; Fill the rest of the word (w/1 or 0) MOVEM S1,DEBSWT ; And plop it into the debug switch $RETT ; Return True SETDL.: $CALL P$NUM ; Try to get a number $RETIF ; If we don't get a num, return False SETDL1: MOVEM S1,DELAY ; Move in the new delay time $RETT ; Return a True SETES.: $CALL P$NUM ;[012] Try for number $RETIF ;[012] return if none CAIL S1,0 ;[012] See if reasonable CAILE S1,37 ;[012] JRST SETESE ;[012] no MOVEM S1,ESCCHR ;[012] Yes, store it TRO S1,100 ;[012] Make ASCIZ name $TEXT(<-1,,ESCTXT>,<^7/[.CHLAB]/CONTROL-^7/S1/^7/[.CHRAB]/^0>) ;[012] $RETT ;[012] SETESE: $TEXT(,) ;[012] $RETF ;[012] SETFB.: $CALL P$KEYW ; Try to get a keyword $RETIF ; Return if we didn't get a keyword SETFB1: HRRES S1,S1 ; Make entire word 1's or 0's MOVEM S1,FBSIZ ; And set the switch in memory $RETT ; Return a True SETFW.: $CALL P$KEYW ; Get a keyword $RETIF ; Someone screwed up HRREM S1,FILWRN ; Save the value $RETT ; And return SETLN.: $CALL P$NUM ; Try to fetch a number $RETIF ; Return if we didn't get a number SETLN1: MOVEM S1,TTYLIN ; Move in the new TTY line number ADDI S1,.UXTRM ; Now make the line a UDX MOVEM S1,TRMUDX ; And save it SKIPE TRMOPN ;[011] Is the data line open? $CALL CLOTRM ;[011] Yes, need to re-open $RETT ; Return a True SUBTTL SET command -- Command processing routines -- Set receive parms SETRC.: $CALL P$KEYW ; Try to get a keyword JUMPT (S1) ; Jump to the appr routine if we did $RET ; Else return the False STREL.: $CALL P$NUM ; Try to get a number $RETIF ; Return if we didn't get it STREL1: CAIG S1," "-1 ; Is the EOL character in the correct ; range? JRST STRELG ; Number is < 37, good so far CAIN S1,.CHDEL ; It's > 37, is it a del? JRST STRELG ; Yes, continue STRELB: $TEXT (,) ; No, it is invalid $RETF ; Return the False STRELG: CAIG S1,0 ; Is it > 0 JRST STRELB ; The EOL char < 0, it's bad MOVEM S1,REOL ; Ok, move it into the Receive EOL slot $RETT ; Return True STRPL.: $CALL P$NUM ; Try to get a number $RETIF ; If we didn't, go back STRPL1: CAILE S1,^D96 ; Is the packet size within the max? JRST STRPLE ; No, give it an error MOVEM S1,RPSIZ ; Yes, move it into rec. packet size $RETT ; Return True STRPLE: $TEXT (,) ; No good, too large $RETF ; Return False STRPC.: $CALL P$NUM ; Try to get a number $RETIF ; Not a number, return False STRPC1: CAIG S1," "-1 ; Is the pad character in range? JRST STRPCG ; It is < 37 CAIN S1,.CHDEL ; Is it, perhaps, a del?? JRST STRPCG ; Yes, it should be ok STRPCB: $TEXT (,) ; The pad character is out of range $RETF ; Return False STRPCG: CAIGE S1,0 ; Is the number > 0 JRST STRPCB ; Nope, it's out of range MOVEM S1,RPADC ; Ok, set the receive pad character $RETT ; Return True STRPD.: $CALL P$NUM ; Try to parse a number $RETIF ; If we didn't get it, return STRPD1: MOVEM S1,RPAD ; Good number, save amount of padding $RETT ; Return True STRTM.: $CALL P$NUM ; Try to parse a number $RETIF ; If we didn't get one, go back STRTM1: MOVEM S1,RTIME ; Save to length for timeout on receive $RETT ; Return True SUBTTL SET command -- Command processing routines -- Set send parms SETSN.: $CALL P$KEYW ; Try to get a keyword JUMPT (S1) ; If we got one, go to routine for it $RET ; Return STSEL.: $CALL P$NUM ; Try to get a number $RETIF ; If false, return STSEL1: CAIG S1," "-1 ; Is the send EOL character in range? JRST STSELG ; It's < 37, good so far CAIN S1,.CHDEL ; Is it, perhaps, a del?? JRST STSELG ; Yup, it looks good STSELB: $TEXT (,) ; The character is not in range $RETF ; Return False STSELG: CAIG S1,0 ; Is the EOL character > 0 JRST STSELB ; No, then it is out of range MOVEM S1,SEOL ; Set up the new EOL character on send $RETT ; and return True STSPL.: $CALL P$NUM ; Try to parse a number $RETIF ; If we didn't get the number, return STSPL1: CAILE S1,MXPACK ; Is it less than maxpack?? JRST STSPLE ; No, it is out of allowable range CAIG S1,0 ; Is it positive? JRST STSPLE ; No, out of range, error MOVEM S1,SPSIZ ; Move the new packet size to memory $RETT ; Return True STSPLE: $TEXT (,) ; Error, the packet size is too big $RETF ; Return False STSPC.: $CALL P$NUM ; Try to parse a number $RETIF ; If we didn't find it, return False STSPC1: CAIG S1," "-1 ; Is the pad character in range? JRST STSPCG ; It's < 37, good so far CAIN S1,.CHDEL ; Is it a del? JRST STSPCG ; Yes, go on STSPCB: $TEXT (,) ; No, it is definitely invalid $RETF ; Return False STSPCG: CAIGE S1,0 ; Is the character value > 0 JRST STSPCB ; The value is negative, no good MOVEM S1,SPADC ; Save the new pad character $RETT ; Return True STSPD.: $CALL P$NUM ; Try to get a number $RETIF ; If we didn't find a number, return STSPD1: MOVEM S1,SPAD ; Save the amount of padding for send $RETT ; Return True STSQC.: $CALL P$TEXT ; Try to get some text $RETIF ; No text, return STSQC1: SUBI S2,2 ; We, got text, the length is in S2 ; Subtract off the CRLF JUMPG S2,STSQCE ; If length was longer 1, we have error MOVEI T1,PRT.CM(S1) ; Otherwise, get address of string HRL T1,FBWRD ; Finish forming the byte pointer LDB T2,T1 ; Fetch the byte MOVEM T2,SQUOTE ; and save it CAIL T2,41 ;[012] Check range CAILE T2,176 ;[012] Must be 41-76 or 140-176 JRST STSQCE ;[012] Nope CAILE T2,76 ;[012] CAIL T2,140 ;[012] SKIPA ;[012] OK JRST STSQCE ;[012] Nope $RETT ; Return True STSQCE: $TEXT(,) ;[012] $RETF ; Return False, there was an error STSTM.: $CALL P$NUM ; Try to Fetch a number $RETIF ; If not a number, Return False STSTM1: MOVEM S1,STIME ; Else, save it in timeout for send $RETT ; Return True SUBTTL SHOW command -- Command tables ; ; The SHOW command displays any or all of the parameters used by Kermit. It ; uses the following registers: ; ; S1-S2 - Return parms from oprpar, work registers ; T1-T4 - work registers ; KERSHO: $KEYDSP(KERSH1) KERSH1: $STAB DSPTAB(KSHCFM,SHALL.,) DSPTAB(KSHCFM,SHDEB.,) DSPTAB(KSHCFM,SHDEL.,) DSPTAB(KSHCFM,SHESC.,) ;[012] DSPTAB(KSHCFM,SHFB.,) DSPTAB(KSHCFM,SHFW.,) DSPTAB(KSHCFM,SHLIN.,) DSPTAB(KSHRC,SHREC.,) DSPTAB(KSHSN,SHSEN.,) $ETAB KSHCFM: $CRLF KSHRC: $KEYDSP(KSHRC1) KSHRC1: $STAB DSPTAB(KSHCFM,SHRALL,) DSPTAB(KSHCFM,SHREL,) DSPTAB(KSHCFM,SHRPL,) DSPTAB(KSHCFM,SHRPD,) DSPTAB(KSHCFM,SHRPC,) DSPTAB(KSHCFM,SHRQC,) DSPTAB(KSHCFM,SHRTM,) $ETAB KSHSN: $KEYDSP(KSHSN1) KSHSN1: $STAB DSPTAB(KSHCFM,SHSALL,) DSPTAB(KSHCFM,SHSEL,) DSPTAB(KSHCFM,SHSPL,) DSPTAB(KSHCFM,SHSPD,) DSPTAB(KSHCFM,SHSPC,) DSPTAB(KSHCFM,SHSQC,) DSPTAB(KSHCFM,SHSTM,) $ETAB SUBTTL SHOW command -- Command processing routines SHOW.: $CALL P$KEYW ; Try to parse a keyword JUMPT (S1) ; We got one, go process routine for it $RET ; Else, return ; We want to show all parameters SHALL.: $CALL SHDEB. ; Show debugging mode $CALL SHDEL. ; Delay $CALL SHESC. ;[012] Escape character $CALL SHFB. ; File-byte-size $CALL SHFW. ; File-warning $CALL SHLIN. ; Tty line $TEXT (,<>) ; Leave a free line between these and ; the next set of parameters $CALL SHRALL ; Show all the receive parms $CALL SHSALL ; Show all the send parms $RETT ; Return True SHDEB.: MOVE T1,DEBSWT ; Fetch the debug switch AOJE T1,SHDEBN ; This means that it is set on $TEXT (,) ; It's off, print that info $RETT ; Return True SHDEBN: $TEXT (,) ; It's on, show that information $RETT ; Return True SHDEL.: MOVE T1,DELAY ; Load the delay time into a register ; and display it in decimal $TEXT (,) $RETT ; Return True SHESC.: $TEXT (,) ;[012] $RETT ;[012] SHFW.: MOVX S1, ; Assume file warning is on SKIPN FILWRN ; Is it? MOVX S1, ; No, it is off $TEXT (,) ; Tell the user $RETT ; And return SHFB.: MOVE T1,FBSIZ ; Load the file-byte-size AOJE T1,SHFBEI ; This means that it is EIGHT-BIT bytes $TEXT (,) ; It's seven bits, show that $RETT ; Return True SHFBEI: $TEXT (,) ; Show byte size as eight $RETT ; Return True SHLIN.: MOVE T1,TTYLIN ; Load the present tty line number ; and print it in octal $TEXT (,) $RETT ; Return True SUBTTL SHOW command -- Command processing routines -- Show receive parms SHREC.: $CALL P$KEYW ; Parse keyword (which receive parm) JUMPT (S1) ; Jump to the appropriate routine $RET ; Else, return SHRALL: $CALL SHREL ; Show all the receive parms, do EOL $CALL SHRPL ; Show packet length $CALL SHRPC ; Show pad character $CALL SHRPD ; Show padding amount $CALL SHRQC ; Show quoting character $CALL SHRTM ; Show timeout delay $TEXT (,<>) ; Leave one line open $RETT ; return True SHREL: MOVE T1,REOL ; Get the receive EOL character ; and display it in octal $TEXT (,) $RETT ; Return True SHRPL: MOVE T1,RPSIZ ; Get the max receive packet size ; and display that in decimal $TEXT (,) $RETT ; Return True SHRPC: MOVE T1,RPADC ; Get the receive pad character ; and display ASCII value in oct. $TEXT (,) $RETT ; Return True SHRPD: MOVE T1,RPAD ; Fetch the padding amount for receive ; and write it in decimal $TEXT (,) $RETT ; Return True SHRQC: MOVE T1,RQUOTE ; Get the quote character ; and print it as 7-bit ASCII $TEXT (,) $RETT ; Return True SHRTM: MOVE T1,RTIME $TEXT (,) $RETT SHSEN.: $CALL P$KEYW JUMPT (S1) $RET SUBTTL SHOW command -- Command processing routines -- Show send parms SHSALL: $CALL SHSEL $CALL SHSPL $CALL SHSPC $CALL SHSPD $CALL SHSQC $CALL SHSTM $TEXT (,<>) $RETT SHSEL: MOVE T1,SEOL $TEXT (,) $RETT SHSPL: MOVE T1,SPSIZ $TEXT (,) $RETT SHSPC: MOVE T1,SPADC $TEXT (,) $RETT SHSPD: MOVE T1,SPAD $TEXT (,) $RETT SHSQC: MOVE T1,SQUOTE $TEXT (,) $RETT SHSTM: MOVE T1,STIME $TEXT (,) $RETT SUBTTL STATUS command -- Command tables KERSTA: $NOISE(CONFRM,) SUBTTL STATUS command -- Command processing routine STAT.: $CALL P$CFM JUMPT STAT.0 $RET STAT.0: $TEXT (,) $TEXT (,) $TEXT (,) $TEXT (,) MOVE WORK1,STOT SUB WORK1,SCHR IMULI WORK1,^D100 IDIV WORK1,STOT $TEXT (,) MOVE WORK1,RTOT SUB WORK1,RCHR IMULI WORK1,^D100 IDIV WORK1,RTOT $TEXT (,) $TEXT (,) $RETT SUBTTL Packet routines -- Send packet S.PAK: MOVE S1,DEBSWT ; Get the switch for debugging JUMPE S1,SP.ND ; If it isn't set, skip this stuff MOVE S1,[SIXBIT /S.PAK:/] ; Set up the sixbit name of the routine HRRZ S2,T4 ; Set up packet type and action index $CALL DEBG ; Call the debug output routine SP.ND: MOVN WORK1,SPAD ; Set up our byte counter JUMPE WORK1,SP.SOH ; If no padding, just start with SOH SP.OPC: MOVE S1,SPADC ; Get the padding character $CALL COUT ; Output a byte AOJN WORK1,SP.OPC ; Increment & test count, loop if <> 0 SP.SOH: MOVEI S1,SOH ; Put an SOH character in S2 $CALL COUT ; Send a character out ADDI T2,OVRLEN ; Adjust count to reflect extra chars ADD STOT,T2 ; Accumulate total number of chars SETZM CHKSUM ; Zero the chksum CHAR T2,COMPAR,S1 ; Load in char(count) to be sent ADDM COMPAR,CHKSUM ; Temp holds char(count), add to chksum SUBI T2,OVRLEN ; Readjust count to step through data $CALL COUT ; Send a character out CHAR T3,COMPAR,S1 ; Move char(seqno) to output area ADDM COMPAR,CHKSUM ; Temp holds char(seqno), do checksum $CALL COUT ; Send a character out MOVEM T4,S1 ; Set up the type code to go out $CALL COUT ; Send it ADDM T4,CHKSUM ; Figure it into the checksum MOVEM T1,ABUF ; Save the address of the buffer SETZ S2, ; Set up the byte counter JUMPE T2,SP.CHK ; If no data, go send checksum SP.OD: MOVE S1,(T1) ; Index into data array to get byte ADDM S1,CHKSUM ; Add curr data character to checksum $CALL COUT ; Send a character out AOJ T1, ; Increment the buffer pointer AOJ S2, ; Increment the byte counter CAMGE S2,T2 ; Check against data length, Done yet? JRST SP.OD ; No, continue ; Yup, do the checksum calculations SP.CHK: MOVE S2,CHKSUM ; Move the checksum into a work area ANDI S2,300 ; Separate out bits 7 & 8 LSH S2,-6 ; Flush those bits to the right side ADD S2,CHKSUM ; Add them into the original number ANDI S2,SXBMSK ; Take just the last six bits CHAR S2,COMPAR,S1 ; Make it a character & prepare to send $CALL COUT ; Send a character out MOVE S1,SEOL ; Fetch the send EOL character $CALL COUT ; Send a character out SP.FOR: OUT CHAN, ; Ship the whole buffer now JRST SP.COU ; We are done, return STATZ CHAN,IO.ERR ; Any error bits up? JRST OUTERR ; Yes, punt MOVX S1,HB.RIO!^D1000 ; Wait a bit HIBER S1, ; Hibernate until output done JFCL ; Noop error return JRST SP.FOR ; Go and try again SP.COU: MOVE S1,DEBSWT ; Get the debug switch JUMPE S1,SP.EX ; If not set, jump over this stuff MOVE S1,[SIXBIT /SP.COU/] ; Set up sixbit routine name HRRZ S2,T4 ; Load the packet type HRLI S2,1 ; and the action index $CALL DEBG ; Call the debugging routine SP.EX: HRRZ S1,T.OBP ; Get the output byte pointer SKIPN S1 ; If it's not zero, it is good HALT . ; Halt, bad byte pointer $RETT SUBTTL Packet routines -- Receive packet R.PAK: MOVE S1,DEBSWT ; Get the debug indicator switch JUMPE S1,RP.ND ; If not set, don;t do debugging MOVE S1,[SIXBIT /R.PAK:/] ; Set up the sixbit routine name HRRZ S2,T4 ; Get the packet type HRLI S2,2 ; and the action index $CALL DEBG ; Call the debug output routine RP.ND: SETZM CHKSUM ; Initialize the checksum to zeros $CALL SETTMR ; Go gen time limit for receive to wait RP.WS: $CALL CIN ; Go get a character SKIPT ; Skip if the routine worked JRST RP.FD ; Do debug and return false SOSE S1 ; Was the character an octal 1 (SOH) JRST RP.WS ; No, keep waiting for it RP.SP: SETZB T1,T2 ; Clear the registers for parms SETZB T3,T4 ; " SETZM CHKSUM ; Initialize the checksum MOVNI S2,6 ; Set up a count register RP.FLP: $CALL CIN ; Go get a character SKIPT ; Skip if the routine worked JRST RP.FD ; Do debug and return false RP.SR: AOJE S2,RP.FIN ; Have we seen the whole packet CAIN S1,SOH ; Is it a Start of Header JRST RP.SP ; Yes, restart the loop CAML S2,[-2] ; Avoid adding the checksum JRST @RP.JT+5(S2) ; Yes, go there ADDM S1,CHKSUM ; No, but add the byte into chksum RP.CAS: JRST @RP.JT+5(S2) ; Use the jump table ; ; The following section is a jump table used to simulate a case statement ; structure. The cases used are as follows: ; rp.c1 - accept the input byte as a character count ; rp.c2 - accept the byte as a packet number ; rp.c3 - accept the byte as a packet type ; rp.c4 - loop to accept all data bytes in the packet ; rp.c5 - finish up, do checksum calculations and exit ; RP.JT: EXP RP.C1 ; Save count EXP RP.C2 ; Save packet number EXP RP.C3 ; Save packet type EXP RP.C4 ; Buffer incomming data EXP RP.C5 ; Do checksum stuff RP.C1: UNCHAR S1,COMPAR,T2 ; Count := unchar(byte) ! Byte-40 JRST RP.FLP ; Return to top of loop RP.C2: UNCHAR S1,COMPAR,T3 ; Num := unchar(byte) ! Byte-40 JRST RP.FLP ; Back to top of loop RP.C3: MOVE T4,S1 ; Type := byte JRST RP.FLP ; Return RP.C4: SUBI T2,OVRLEN ; Adjust count to actual data length-1 JUMPLE T2,RP.SR ; If no data, go get next field MOVN DATIND,T2 ; Get the count MOVSI DATIND,(DATIND) ; Make an AOBJx pointer RP.DL: CAIN S1,SOH ; Is it a Start of Header? JRST RP.SP ; Yes, restart the entire packet ADDM S1,CHKSUM ; Total the character in the checksum MOVEM S1,INBUF(DATIND) ; Save the character RP.NDB: AOBJP DATIND,RP.FLP ; If we are done, go get next field $CALL CIN ; Go get a character JUMPF RP.FD ; Punt if message died JRST RP.DL ; Otherwise go store character RP.C5: MOVE S2,CHKSUM ; Fetch the checksum ANDI S2,300 ; Clear all but bits 7 and 8 LSH S2,-6 ; Shift them flush right ADD S2,CHKSUM ; Add in the original checksum value ANDI S2,SXBMSK ; Take only the low-order six bits UNCHAR S1,COMPAR ; convert chksum from char to actual CAME COMPAR,S2 ; Does this match the packet JRST RP.FIN ; NO, the packet was bad, return that MOVEI T1,INBUF ; Yes, load the last return parm RP.E1: REPEAT 0,< MOVX S2,BRKM ; Move the break mask to a reg $CALL CIN ; Go get a character SKIPT ; Skip if the routine worked JRST RP.FD ; Do debug and return false LSH S2,0(S1) ; Shift the mask to check for break SKIPL S2 ; Did we shift a 1 into bit 0? JRST RP.E1 ; No, not a break char, try again > ; End of REPEAT 0 ADDI T2,4 ; Adjust the character count ADD RTOT,T2 ; Accumulate the received char total MOVE S1,DEBSWT ; Get the debug switch JUMPE S1,RP.TR ; If it is not set, jsut return MOVE S1,[SIXBIT /RP.E1:/] ; Load the sixbit name of routine HRRZ S2,T4 ; And the packet we were working with HRLI S2,3 ; This is index of the action message $CALL DEBG ; Call the debugging routine RP.TR: $RETT ; Yes, return a true RP.FIN: REPEAT 0,< MOVX S2,BRKM ; Move the break mask to a reg $CALL CIN ; Go get a character SKIPT ; Skip if the routine worked JRST RP.FD ; Do debug and return false LSH S2,0(S1) ; Shift the mask to check for break SKIPL S2 ; Did we shift a 1 into bit 0? JRST RP.FIN ; No, not a break char, try again > ; End of REPEAT 0 ADDI T2,4 ; Adjust the character count ADD RTOT,T2 ; Accumulate the received char total RP.FD: MOVE S1,DEBSWT ; Fetch the debug switch JUMPE S1,RP.FR ; Not on, go to return MOVE S1,[SIXBIT /RP.FD:/] ; Load sixbit routine name HRLZI S2,4 ; Action message index (no packet type) $CALL DEBG ; Call the debugger for output RP.FR: $RETF ; We shouldn't end up here TIMOUT: MOVEI T4,"N" ; This means we didn't get anything $RETF SUBTTL Error processing -- KERROR ; This routine is called by the $KERR macro to send an error message to the ;micro. ;It will put the text in the buffer and send off a type 'E' packet. ;Usage: ; $CALL KERROR ; JUMP Address.of.ITEXT KERROR: HRRZ TF,@(P) ; Get the address of the text $SAVE ; Save some room PUSH P,TF ; Save the address of the text $TEXT (<-1,,ERRBUF>,<^I/@(P)/^0>) ; Store message for later type-out SKIPE NOTERM ;[011] Is TTY available? JRST KERR.1 ;[011] No, send on data line $TEXT(,) ;[011] Yes, give error POP P,(P) ;[011] Fix stack $RETT ;[011] and return KERR.1: SKIPN TRMOPN ;[011] Have a data line to send error on? JRST [POP P,(P) ; Clean up the stack $RETT] ; And return SETZM ERRIDX ; Start with first word of data packet $TEXT (KERCHR,) ; Store the text POP P,(P) ; Remove the text address from the stack MOVEI T1,OUTBUF ; Get the address of the buffer MOVE T2,ERRIDX ; And the number of characters MOVE T3,MN ; And the message number to send MOVEI T4,"E" ; Send an error packet $CALL S.PAK ; Send it $RETT ; And return KERCHR: CAIL S1," " ; Printing character? JRST KERC.1 ; Yes, just send it PUSH P,S1 ; No, save the character MOVE S1,SQUOTE ; Get the quoting character AOS S2,ERRIDX ; Get the index to store the character MOVEM S1,OUTBUF-1(S2) ; Save the quoting character POP P,S1 ; Get the control character back XORI S1,"A"-.CHCNA ; Convert to printing character KERC.1: AOS S2,ERRIDX ; Get the index MOVEM S1,OUTBUF-1(S2) ; Store the character $RETT ; And return SUBTTL File routines -- Get characters ; ; The GETCH routine fills the terminal output buffer with characters to be sent ; to the receiving Kermit. It makes use of registers S1-T4. Registers ; T1-T4 are preserved. ; ; CALL: No parms ; ; RETURN: TRUE: NUMBYT - Number of bytes in output buffer ; ; FALSE: ERRCOD - Error code ; GETCH: CLR OUTBUF,MXPACK-3 ; Clear the buffer SETZB S1,NUMBYT ; Nothing in the buffer MOVE S2,SPSIZ ; Set up bound for index SUBI S2,5 ; Adj to account for other packet chars MOVE T1,BYTREM ; Load count for bytes rem. in file buf CAIE T1,0 ; Is it zero? JRST GC.SLP ; No, go start the loop $CALL G.RBUF ; Yes, get some more chars form file JUMPT GC.SLP ; If we got some, go start loop MOVE S1,ERRCOD ; Get the error code from below CAIE S1,EREOF$ ; Was the failure and EOF? $RET ; No, it was something else SETOM EOFINP ; Set the EOF indicator on SETZM NUMBYT ; Zero the number of bytes acquired $RET ; Return GC.SLP: MOVE T1,BYTREM ; Fetch bytes remaining count GC.LP: CAIE T1,0 ; Any chars left in file buffer JRST GC.LP2 ; Yes, continue fetching them $CALL G.RBUF ; Try to fetch some more chars JUMPT GC.SLP ; If we got some, continue MOVEM S1,NUMBYT ; Else, save the number of bytes MOVE S1,ERRCOD ; Grab the error cod CAIE S1,EREOF$ ; Was it EOF $RET ; Nope, it was something else MOVE S1,NUMBYT ; Yes, get the number of bytes back SETOM EOFINP ; Set on the EOF indicator JRST GC.RG ; Jump to the 'good return' routine GC.LP2: ILDB T3,CURRBP ; Use the byte pointer to getnext byte ;[014];@GC.LP2+1 MOVE WORK1,T3 ;[014] Get a copy of the character ANDI WORK1,^O177 ;[014] Strip off parity bit (if any) CAIGE WORK1," " ;[014] Is it less than a space? JRST GC.QIT ; Yes,, quote it! CAIN WORK1,.CHDEL ;[014] Is it a delete? JRST GC.QIT ; Yes, quote it! CAME WORK1,SQUOTE ;[014] Is it a quote character?? JRST GC.STB ; Nope, go store the byte GC.QIT: MOVE T4,SQUOTE ; Must quote character MOVEM T4,OUTBUF(S1) ; Make next byte the quote character AOJ S1, ; Increment the buffer pointer ;[014];@GC.QIT + 3 CAMN WORK1,SQUOTE ;[014] Is char to be quoted a quote-char? JRST GC.STB ; Yes, just store it. CTL T3,COMPAR,T3 ; Nope, it must be 'controlled' GC.STB: ADDI SCHR,1 ; Increment count of data characters MOVE WORK1,CURRBP ;[010] Check if last byte TXNN WORK1, ;[010] of word and in SKIPE FBSIZ ;[010] 7-bit mode JRST GC.NLB ;[010] No, nothing special MOVE WORK1,@CURRBP ;[010] Yes, get whole word TRNE WORK1,1 ;[010] If bit 35 is on TRO T3,200 ;[010] Lite parity bit GC.NLB: MOVEM T3,OUTBUF(S1) ; Move the byte into the buffer AOJ S1, ; Increment the packet buffer pointer SOJ T1, ; Decrement bytes remaining in file buf CAMLE S1,S2 ; Are we at the end of the packet buf? JRST GC.RG ; Yes, return success JRST GC.LP ; No, go loop for more bytes GC.RG: MOVEM S1,NUMBYT ; Save it for the return MOVEM T1,BYTREM ; Save new byte remaining count $RETT ; Return Success! SUBTTL File routines -- Get characters -- Read buffer ; ; The G.RBUF routine reads another buffers-worth of data from the file. Since ; S1-T4 are preserved, it saves any return error code in ERRCOD. ; ; CALL: No parms ; ; RETURN: TRUE: CURRBP - The current byte pointer into the file buffer ; NUMBYT - The number of bytes available in the buffer ; ; FALSE: ERRCOD - The error code ; G.RBUF: $SAVE ; Preserve the registers MOVE S1,FILIFN ; Fetch the file number $CALL F%IBUF ; Get the next page JUMPT G.RG ; If we got data, go process it MOVEM S1,ERRCOD ; Else, move error code to mem $RET ; Return (restoring above regs) G.RG: SKIPE FBSIZ ; 7-bit mode? JRST GRB.8 ; No, 8-bit HRLI S2,(POINT 7,,34) ; Yes, set up the byte pointer IMULX S1,5 ; And convert count to bytes JRST GRB.0 ; And return GRB.8: HRLI S2,(POINT 8,,31) ; Set up for 8-bit mode IMULX S1,4 ; At 4 bytes per word GRB.0: MOVEM S2,CURRBP ; Save the new byte pointer MOVEM S1,BYTREM ; Save new byte remaining count $RET ; Return SUBTTL File routines -- Put characters PUTCH: SETZ S1, ; Zero the index to the packet buffer SUBI S2,OVRLEN+2 ; Adjust it to reflect only actual data MOVE T1,BYTREM ; Load the byte remaining count PT.LP: JUMPN T1,PT.LP2 ; Is the file buffer full SETZM BYTREM ; Yes, no room left $CALL P.WBUF ; Yes, write it MOVE T1,BYTREM ; Get the new count JUMPT PT.LP2 ; If that succeeded, continue $KERR () ; Write an error message $RETF ; Return false PT.LP2: MOVE T3,INBUF(S1) ; Load next byte from packet buffer AOJ S1, ; Increment packet buffer pointer CAME T3,RQUOTE ; Quoting character? JRST PT.LP4 ; No, just store it MOVE T3,INBUF(S1) ; Get the next character MOVE WORK1,T3 ;[010] Make a work copy and XOR WORK1,RQUOTE ;[010] "compare" to quote ;[014];@PT.LP2 + 7 ;[014]; SKIPN FBSIZ ;[007] If seven-bit mode ANDI WORK1,177 ;[010] strip off parity SKIPE WORK1 ;[010] Is this a quote? XORI T3,"A"-.CHCNA ;[010] No, un-CTL it AOJ S1, ; And bump the index PT.LP4: IDPB T3,CURRBP ; Deposit the byte in file buffer ADDI RCHR,1 ; Increment data characters received SKIPN FBSIZ ;[010] Eight bit mode? TRNN T3,200 ;[010] or parity not set? JRST PT.LP3 ;[010] Yes, continue on MOVE WORK1,CURRBP ; Get the byte pointer TXNE WORK1, ; Was this the last byte in the word? JRST PT.LP3 ; No, ignore the bit MOVEI WORK1,1 ; Otherwise get a bit IORM WORK1,@CURRBP ; And turn on LSN bit PT.LP3: SOJ T1, ; Decrement bytes remaining in file buf CAMG S1,S2 ; Have we finished moving the packet? JRST PT.LP ; No, loop back PT.RG: ADDI S1,5 ; Unadjust the count CAME T1,BYTREM ; Something actually written in buffer? SETZM BUFEMP ; Yes, flag it is there MOVEM T1,BYTREM ; Save the new byte remaining count $RETT ; Return true SUBTTL File routines -- Put characters -- Write buffer P.WBUF: $SAVE ; Save the important registers MOVEI T1,BUFLEN ; Reset the SKIPE FBSIZ ; 8-bit mode? MOVX T2,4 ; Yes, 4 bytes per word SKIPN FBSIZ ; 7-bit mode? MOVX T2,5 ; Yes, 5 bytes per word IMUL T1,T2 ; Get the number of bytes SUBM T1,BYTREM ; Determine how many bytes were written EXCH T1,BYTREM ; And store full size IDIV T1,T2 ; Get the number of words JUMPE T2,.+2 ; Exact? AOJ T1, ; No, account for piece in next word MOVE T2,[POINT 7,OFBUF] ; Set the byte pointer to 7 bit bytes SKIPE FBSIZ ; 8-bit mode? MOVE T2,[POINT 8,OFBUF] ; Set the byte pointer to 8 bit bytes MOVEM T2,CURRBP ; Save the byte pointer MOVE S1,FILIFN ; Load the file IFN for the call MOVEI S2,OFBUF ; Get the address of the buffer HRL S2,T1 ; And the size $CALL F%OBUF ; Output the buffer JUMPT P.RG ; If it worked return good, MOVEM S1,ERRCOD ; Otherwise, save the error code $RET ; and return P.RG: SETOM BUFEMP ; Flag buffer is empty CLR OFBUF,BUFLEN ; Clear out the buffer $RETT ; Return a true SUBTTL File routines -- Get next file GNXTF: $RETF ; Get next file (always false) SUBTTL File routines -- Open file ; ; OFILE is used to open files for input or output and to prepare them for ; processing. The parameters passed to it are as follows: ; ; CALL: T1 - Type code - "I";input, "O";output, "A";append ; T2 - FD pointer - points to FD from the PDB ; ; RETURN: TRUE: FILIFN - Internal file number ; FALSE: S1 - Error code ; OFILE: MOVEI S1,FOB.MZ ; Size of the FOB MOVEI S2,OF.FOB ; Address of the FOB MOVEM T2,OF.FOB+FOB.FD ; Set 1st word to point to FD MOVX T3,^D36 ; We want full word data MOVEM T3,OF.FOB+FOB.CW ; Drop it into the 2nd word of FOB CAIN T1,"I" ; Are we going to open the file input? JRST OF.I ; Yes, open it input MOVX T3,BUFLEN ; Get the length of the buffer in words SKIPE FBSIZ ; 8-bit bytes? IMULX T3,4 ; Yes, 4 bytes per word SKIPN FBSIZ ; 7-bit bytes? IMULX T3,5 ; Yes, 5 bits per word MOVEM T3,BYTREM ; Save the count of free bytes SKIPE FBSIZ ; 8-bit mode? SKIPA T3,[POINT 8,OFBUF] ; Yes, get the byte pointer MOVE T3,[POINT 7,OFBUF] ; No, use 7-bit byte pointer MOVEM T3,CURRBP ; Save to store characters CAIN T1,"O" ; Do we open it output? JRST OF.O ; Yes, do it OF.A: $CALL F%AOPN ; Neither of the above, open it append $RETIF ; If the open failed, return JRST OF.SFN ; Else, go save the file number OF.I: $CALL F%IOPN ; Open the file input $RETIF ; If it fails to open, return false SETZM BYTREM ; Zero bytes remaining in file buffer JRST OF.SFN ; Else, save the file number OF.O: MOVX T3,FB.NFO ; Get the no supersede bit SKIPE FILWRN ; Allowed to supersede file? IORM T3,FOB.CW(S2) ; No, flag that $CALL F%OOPN ; Open the file output JUMPT OF.SFN ; All is fine, continue on ; Here if we got an error, check if file being superseded. SKIPE FILWRN ; FILE-WARNING set? CAXE S1,ERFAE$ ; File already exist? $RETF ; No, just punt $TEXT(,<% File already exists ^F/@SFDARG/>) ;[012] ; First make the extension numeric (000), and increment it until we find ;a file name we can use. MOVX S1, ; Get the intial extension MOVEM S1,.FDEXT(T2) ; Store it in OF.OFW: MOVX S1,FOB.MZ ; Minimum FOB MOVEI S2,OF.FOB ; Address $CALL F%OOPN ; Open it JUMPT OF.OFX ; Got it CAXE S1,ERFAE$ ; File exist? $RETF ; No, something else HLRZ S1,.FDEXT(T2) ; Yes, get the extension TXO S1,707070 ; Turn on bits between digits AOJ S1, ; Bump to next extension TXZ S1,707070 ; Clear the extra bits TXO S1,<'000'> ; Make the digits sixbit again TXNE S1,LHMASK ; Run out of extensions? $RETE FAE ; Return the error HRLZM S1,.FDEXT(T2) ; Store the extension back JRST OF.OFW ; And try again ; Here when we have finally found a file name we can use OF.OFX: $TEXT (TYPCHR,<% Outputing file as ^F/(T2)/>) ; Tell user what we did OF.SFN: MOVEM S1,FILIFN ; Save the IFN $RET ; and return SUBTTL File routines -- Close file ; ; CFILE simply closes the current file being processed. If successful, it ; returns true, otherwise it prints an error on the file it was ; attempting to close. ; ; CALL S1 - IFN ; ; RETURN TRUE: - File is closed ; FALSE: S1 - Error code ; CFILE: $CALL F%REL ; Try to close the file $RETIT ; If successful, leave $KERR () ; Print error $RETF ; Return false SUBTTL Terminal routines -- Open terminal -- Open terminal for transfer OPNTRM: MOVE S1,TRMUDX ;[011] Get udx CAME S1,MYTRM ;[011] Is it me? JRST OPNT.1 ;[011] No RELEAS TTY, ;[011] Yes, release other chan SETOM NOTERM ;[011] and flag not open OPNT.1: SKIPE TRMOPN ;[011] Is it already open? JRST OPNT.B ;[011] Yes, just set break set MOVX S1,.IOPIM!IO.SUP!UU.AIO ; Set neccesary parameters for open MOVEM S1,K.TMFB ; Store that parameter MOVE S1,TRMUDX ; Get the trmudx to be used DEVNAM S1, ; Make it a sixbit physical name $RETF ; Bad terminal MOVEM S1,K.TMFB+1 ; and store that HRRI S1,T.INB ; Set up input buffer and HRLI S1,T.OUTB ; output buffer addresses MOVEM S1,K.TMFB+2 ; Save BCB addresses into open block OPEN CHAN,K.TMFB ; Open the device on channel 2 JRST OPNT.F ;[011] Bad terminal MOVEI S1,K.TMFB ; Load address of parms for DEVSIZ DEVSIZ S1, ; Get the default buffer size and num JRST OPNT.F ;[011] Bad terminal HRRZM S1,T.SBUF ; Save the default buffer size HLRZM S1,T.NBUF ; Save the default number of buffers ANDX S1,RHMASK ; Grab only the right side IMUL S1,T.NBUF ; Multiply size by number of bufs $CALL M%GMEM ; Allocate that much MOVEM S2,.JBFF ; Save this for the INBUF call MOVEM S2,T.IBA ; Also save it for deallocate later INBUF CHAN,0 ; Set up the buffer ring $CALL M%GMEM ; Allocate some more memory MOVEM S2,.JBFF ; Save the address MOVEM S2,T.OBA ; Save it for the deallocate OUTBUF CHAN,0 ; Set up the buffer ring SETOM TRMOPN ; Terminal is open now ; Set up the break set for the terminal to be the EOL character OPNT.B: MOVX S1, ;[011] Point to the arguments MOVX T1,.TOSET+.TOPBS ; Want to set the PIM break set MOVE T2,TRMUDX ; Get the UDX MOVE T3,REOL ; Get the end of line character LSH T3,^D36-^D9 ; Shift to correct place SKIPE T3 ;[011] Unless break on all TXO T3, ; Also break on ^C TRMOP. S1, ; Set he break set JFCL ; Will have to put up with break on all $RETT ; Return true ;If OPEN failed, re-INIT TTY to set IO.SUP OPNT.F: SKIPE NOTERM ;[011] Did we close TTY? $CALL OCTERM ;[011] Yes, re-open it normal $RETF ;[011] and return SUBTTL terminal routines -- Open terminal -- Open terminal for commands OCTERM: MOVX T1,IO.SUP!.IOASC ;[011] Mode MOVE T2,MYTRM ;[011] Device DEVNAM T2, ;[011] Make physical name MOVSI T2,'TTY' ;[011] Just use TTY SETZ T3, ;[011] No buffers OPEN TTY,T1 ;[011] Do it JFCL ;[011] ?? Maybe detached SETZM NOTERM ;[011] Flag as available $RETT ;[011] SUBTTL Terminal routines -- TYPCHR - Type a character ; This routine is called from $TEXT processing as the default type-out routine. ;It will only type the character if the terminal is currently available, i.e. ;is not being used for data transfer. TYPCHR: SKIPE NOTERM ; Are we allowed to type right now? $RETT ; No, just ignore the output PJRST T%TTY ; Yes, use normal GLXLIB routine SUBTTL Terminal routines -- Close terminal device CLOTRM: RELEAS CHAN, ;[011] Release the channel MOVE S2,T.OBA ; Grab base address of output buffer MOVE S1,T.SBUF ; Get buffer size IMUL S1,T.NBUF ; Calculate total size for all buffers $CALL M%RMEM ; Release that memory MOVE S2,T.IBA ; Get base address of input buffer $CALL M%RMEM ; Release that memory SETZM TRMOPN ;[011] Data line closed SKIPE NOTERM ;[011] Did we close TTY? PJRST OCTERM ;[011] Yes, re-open and return SETSTS TTY,IO.SUP!.IOASC ;[011] No, reset status incase CONNECT $RETT ; Return true SUBTTL Terminal routines -- Character in CIN: SOSL T.IBC ; Check if we have characters left JRST CIN.GO ; Yes! Get one. CIN.BF: IN CHAN, ; Try for the buffer JRST CIN.CN ; We should have one now, check char STATO CHAN,IO.ERR ; Any errors? JRST CIN.TM ; No, just nothing input yet, check timing GETSTS CHAN,S2 ; Get the I/O status $KERR () ; Complain CIN.F: $CALL CLOTRM ; Punt the terminal JRST PARLOP ; And go for a new command CIN.TM: MOVX S1,%CNSUP ; Prepare for GETTAB GETTAB S1, ; Get current system up time JFCL ; Noop error return CAML S1,TIMLIM ; Are we out of time JRST CIN.BD ; Yes, go do a time out SUB S1,TIMLIM ; No, get amount of time for Hiber PUSH P,S2 ; Save S2 MOVX S2,%CNTIC ; Set up GETTAB to find jiffies/sec GETTAB S2, ; Do it JFCL ; Noop error return IMULX S1,-^D1000 ; Convert to milliseconds doing the IDIV S1,S2 ; multiply first to save precision CAXLE S1,^D1000 ; Never wait more than a second MOVX S1,^D1000 ; . . . TXO S1,HB.RIO!HB.RTC!HB.RWJ ; Wake when I/O done HIBER S1, ; Hibernate! JFCL ; Noop error return POP P,S2 ; Restore S2 JRST CIN ; Go back to try for a character CIN.GO: ILDB S1,T.IBP ; Get the next character in buffer CAXE S1,.CHCNC ; Was this a control-C? CAXN S1,.CHCNC+200 ; Possibly with parity bit? JRST CIN.F ; Just go punt now $RETT ; and return true CIN.BD: MOVE S1,DEBSWT ; Fetch debug switch JUMPE S1,CIN.RF ; If not set, just return MOVE S1,[SIXBIT /CIN.BD/] ; Load routine name HRLZI S2,6 ; Load action message index (no packet) $CALL DEBG ; Call the debug routine CIN.RF: MOVEI T4,"N" ; We didn't get anything MOVEI S1,2 ; Code to return for timeout $RETF ; Fail CIN.CN: HRRZ S1,T.IBP ; Get the input buffer pointer SKIPN S1 ; If it is not zero, continue HALT JRST CIN SUBTTL Terminal routines -- Character out COUT: SOSGE T.OBC ; Any room in buffer? JRST COUT.F ; No, go send this one IDPB S1,T.OBP ; Yes, put the byte in $RETT ; And return true COUT.F: OUT CHAN, ; Output the buffer JRST COUT.C ; Go put character in new empty buffer STATZ CHAN,IO.ERR ; Any error bits up? JRST OUTERR ; Yes, punt SETZ S2, ; Zero the Ac for the hiber HIBER S2, ; Hibernate until output done JFCL ; Noop error return JRST COUT.F ; Go and try again COUT.C: HRRZ S2,T.OBP ; Get the output buffer pointer SKIPN S2 ; If it is not zero, continue HALT JRST COUT ; Continue ; Here if out UUO got an error (a real one). We can't do a whole lot, so ;just attempt to give an error message and punt. OUTERR: PUSH P,TRMOPN ; Save terminal open flag SETZM TRMOPN ; And pretend it isn't GETSTS CHAN,S2 ; Get the status $KERR () ; Complain to whoever POP P,TRMOPN ; Restore the flag $CALL CLOTRM ; Close the terminal JRST PARLOP ; And try again from the top SUBTTL Set timer function SETTMR: SKIPN RTIME ; Check if we are to wait forever JRST [MOVX S1,.INFIN ; Yes, don't punt too soon MOVEM S1,TIMLIM ; . . . $RETT] ; Return MOVX S1,%CNSUP ; Set up for GETTAB GETTAB S1, ; Get system uptime in jiffies JFCL ; Noop error return MOVEM S1,TIMLIM ; Save this in time limit MOVX S1,%CNTIC ; Set up GETTAB to find jiffies/sec GETTAB S1, ; Do it JFCL ; Noop error return IMUL S1,RTIME ; Get wait time on receive ADDM S1,TIMLIM ; Add this to current time $RETT ; Return a true SUBTTL Interupt routines -- Input buffer ready REPEAT 0,< IBRDY: MOVEM S1,K.RGSV ; Preserve register S1 MOVEM S2,K.RGSV+1 ; Preserve retister S2 MOVE S1,DEBSWT ; Get the debug switch JUMPE S1,IBR.C ; If not set, continue with interupt MOVE S1,[SIXBIT /IBRDY:/] ; Load routine name HRLZI S2,5 ; and action message index $CALL DEBG ; Call debug print routine IBR.C: MOVNI S1,1 ; Load monitor parm for this terminal WAKE S1, ; Wake the process JFCL ; Error return MOVE S1,K.RGSV ; Restore S1 MOVE S2,K.RGSV+1 ; Restore S2 DEBRK. ; Return from interupt > ; End of REPEAT 0 SUBTTL Debug Mode routines -- Print debug info DEBG: CAIN STATE,0 ; Check if we have just started $RETF ; If we have, go back CAIN STATE,"C" ; Check if the send or rec is complete $RETF ; If so, we don't need debug output $SAVE ; Preserve these regs SETZB WORK1,WORK2 ; Zero these regs (used for chksum) MOVX P1,%CNDTM ; Load code for date and time GETTAB P1, ; Do the gettab JFCL ; Noop error return HLRZ P2,S2 ; Fetch the action index HRRZ P3,S2 ; Get packet type MOVE P4,USELOG ; Get switch for log file usage JUMPN P4,PRDBLG ; If set, write this stuff to log file $TEXT (,<^H/P1/ ^W/S1/ - ^T/@ACTION(P2)/ - ^7/P3/>) ; output stuff ADD WORK1,P3 ; Add packet type to checksum CAIN P2,3 ; Was it a RECEIVED PACKET message? $CALL D.PRDT ; Yes, do extra data printout CAIN P2,0 ; Was it a SENDING PACKET message? $CALL D.PRDT ; Yes, do extra data printout $RETT ; Return true PRDBLG: $TEXT (,<^H/P1/ ^W/S1/ - ^T/@ACTION(P2)/ - ^7/P3/>) ; output stuff ADD WORK1,P3 ; Add packet type to checksum $RETT ; Return true SUBTTL Debug Mode routines -- Print extra data D.PRDT: $TEXT (,) $TEXT (,< Sequence Number of this packet is ^D/T3/>) CHAR T3,WORK2 ; Make this a printable char ADD WORK1,WORK2 ; Now add it to the checksum $TEXT (,< Number of Data characters is ^D/T2/>) CHAR T2,WORK2 ; Make this a printable char ADD WORK1,WORK2 ; Now add it to the checksum MOVEM T1,P1 ; Save the packet pointer elsewhere ADD P1,T2 ; Calculate the end of packet CAIN P3,"Y" ; If it was a send packet SUBI P1,4 ; adjust the data length MOVEM P1,EOPBF ; Save that CAIN P3,"Y" ; If send packet ADDI P1,4 ; correct data length SUB P1,T2 ; Restore the value to beginning D.PRCH: AOS P1 ; Increment the packet pointer CAML P1,EOPBF ; End of packet? JRST D.DONE ; Yes finished $CALL PRCHAR ; Call the routine to print char JRST D.PRCH ; Continue printing the packet D.DONE: $CALL D.CHKS ; Do the final checksum calcs $TEXT (,< The Checksum for the packet is ^O/WORK1/^M^J^M^J>) $RETT ; Return SUBTTL Debug Mode routines -- Print a packet character PRCHAR: MOVE P3,(P1) ; Fetch character we are pointing to ADD WORK1,P3 ; Add this to the checksum CAIE P3,.CHDEL ; Is it a DEL? JRST PRC.ND ; No, not a del $TEXT (,) ; Yes, write that out $RETT ; and return PRC.ND: ANDI P3,SBMASK ; Make sure high order bit isn't set CAIL P3," " ; Is it less than a SPACE? JRST PRC.NM ; Yes, it is a normal printable char ADDI P3,100 ; No, make it printable $TEXT (,<^^^7/P3/ ^A>) ; Output it with a '^' in front $RETT ; and return PRC.NM: ANDI P3,SBMASK ; Make sure high order bit isn't set CAILE P3,.CHDEL ; Is it greater than a del $RETF ; Yes, there is an error $TEXT (,<^7/P3/ ^A>) ; Print the character normally $RETT ; Return SUBTTL Debug Mode routines -- Do checksum D.CHKS: MOVE WORK2,WORK1 ; Save copy of checksum ANDI WORK1,300 ; Separate out bits 7 & 8 LSH WORK1,-6 ; Flush those bits to the right side ADD WORK1,WORK2 ; Add them into the original number ANDI WORK1,SXBMSK ; Take just the last six bits $RETT SUBTTL End of Kermit END KERMIT ; End of Kermit