TITLE KERMIT-10 - KL10 Error-free Reciprocol Micro Interface Transfer ; Universals SEARCH GLXMAC ; Galaxy definitions SEARCH ORNMAC ; Parser interface definitions SEARCH KERUNV ; Kermit definitions ; Directives PROLOG (KERMIT) .DIREC FLBLST ; List file line of binary only PARSET ; Define entries into the parser ; Version number MITVER==2 ; Major version number MITMIN==0 ; Minor version number MITEDT==106 ; Edit level MITWHO==0 ; Customer edit TWOSEG 400K ; Make this a two segment program RELOC 0 ; Low segment RELOC ; Back to the high segment TOPS10< SEARCH SCNMAC ; WILD interface definitions LOC <.JBVER==:137> ; Version number location VRSN.(KER) ; Store version number RELOC ; Back to the high segment >; End of TOPS10 condition SUBTTL Table of Contents SUBTTL Revision History COMMENT | 100 By: Robert C. McQueen On: Yes. Lots of rewritting and other things. 101 By: Nick Bush On: 22-August-1983 Fix setting up of seven or eight bit byte pointers for file I/O. Do this once when the file is opened, not each time a buffer is read. TOPS-10 is quite happy to use whatever byte size is stored in the buffer header byte pointer, and will use that size to determine the byte count. 102 By: Robert C. McQueen On: 29-August-1983 Remove the TT% routines and use the common TT_ routines in the Bliss module KERTT. 103 By: Robert C. McQueen On: 16-September-1983 Add XFR%STATUS and baud rate stats. 104 By: Robert C. McQueen & Nick Bush On: Many days - Add CRC support - Redo the SHOW command processing - Fix random bugs. 105 By: Robert C. McQueen & Nick Bush On: Many days - Implement IBM mode - Implement file disposition - Make CCL entry work 106 By: Nick Bush On: 3-November-1983 Fix terminal handling for non-network systems. Also make sure the terminal will be available when we try to use it by grabing it when we set the line. Modules: KERMIT | SUBTTL Command processing -- Prompt strings ; The following are the various prompt strings that we can use. PROMPT: TOPS10 ASCIZ |Kermit-10>| TOPS20 ASCIZ |Kermit-20>| SUBTTL Commands tables -- Initial state ; The following is the initial state for the command tables. These ; point to all of the other tables. MON000: $INIT (MON010) MON010: $KEYDSP (MON020,$ALTERNATE(KER010)) MON020: $STAB DSPTAB (MON030,IGNORE,) ; CONTINUE command DSPTAB (MON040,KERCMD,) ; KERMIT command DSPTAB (MON030,SHOVER,) ; RUN command DSPTAB (MON030,IGNORE,) ; START command $ETAB MON030: $UQSTR (CONFRM,IGNBRK) MON040: $CRLF ($ALTERNATE(KER010)) IGNORE: $RETT BRINI$(IGN) ; Mask for ignoring monitor commands BRKCH$(IGN,.CHLFD,.CHFFD) ; Only break on command terminators IGNBRK: BRGEN$(IGN) ; Generate the mask KER000: $INIT (KER010) KER010: $KEYDSP (KER020) ; Dispatch table KER020: $STAB DSPTAB (,C$EXI0,\"<.CHCNZ>,CM%INV) ; Control-Z is same as EXIT DSPTAB (BYE000,C$BYE,) ; Bye command DSPTAB (CON000,C$CONNECT,) ; CONNECT to terminal line DSPTAB (EXI000,C$EXIT,) ; EXIT to monitor level DSPTAB (FIN000,C$FINISH,) ; Finish command DSPTAB (GET000,C$GET,) ; GET command DSPTAB (HLP000,C$HELP,) ; HELP command DSPTAB (LGO000,C$LOGOUT,) ; LOGOUT remote kermit DSPTAB (CONFRM,C$PROMPT,,CM%INV) ; PROMPT command DSPTAB (EXI000,C$EXIT,) ; QUIT command DSPTAB (RCV000,C$RECEIVE,) ; RECEIVE command DSPTAB (SND000,C$SEND,,CM%INV!CM%ABR) ; SEND command DSPTAB (SND000,C$SEND,) ; SEND command DSPTAB (SRV000,C$SERVER,) ; SERVER command DSPTAB (SET000,C$SET,) ; SET command DSPTAB (SHO000,C$SHOW,) ; Show information DSPTAB (STA000,C$STATUS,) ; STATUS command $ETAB SUBTTL Commands tables -- Final state CONFRM: $CRLF SUBTTL Command tables -- BYE command BYE000: $NOISE (CONFRM,) SUBTTL Command tables -- CONNECT command CON000: $NOISE (CON010,) TOPS20< CON010: $NUMBER (CONFRM,^D8,,$ALTERNATE(CONFRM)) >; End of TOPS20 conditional TOPS10< CON010: $DEV (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON020),$ERRPDB(CON020)>) CON020: $NODNM (CON030,,<$ALTERNATE(CON050),$ERRPDB(CON050)>) CON030: $NOISE (CON040,) CON040: $NUMBER (CONFRM,^D8,) CON050: $NUMBER (CONFRM,^D8,,$ALTERNATE(CONFRM)) >; End of TOPS10 conditional SUBTTL Command tables -- EXIT command EXI000: $NOISE (CONFRM,) SUBTTL Command tables -- FINISH command FIN000: $NOISE (CONFRM,) SUBTTL Command tables -- GET command GET000: $NOISE (GET010,) GET010: $FIELD (CONFRM,,<$BREAK(FILBRK)>) SUBTTL Command tables -- HELP command HLP000: $NOISE (HLP010,) HLP010: $CTEXT (CONFRM,,$ALTERNATE(CONFRM)) SUBTTL Command tables -- LOGOUT command LGO000: $NOISE (CONFRM,) SUBTTL Command tables -- RECEIVE command RCV000: $NOISE (RCV010,) RCV010: $OFILE (CONFRM,,$ALTERNATIVE(CONFRM)) SUBTTL Command tables -- SEND command SND000: $NOISE (SND010,) SND010: $FIELD (CONFRM,,<$BREAK(FILBRK)>) BRINI$(FIL,ALL) ; Initialize the mask UNBRK$(FIL,"A","Z") ; Allow alphabetics UNBRK$(FIL,"a","z") ; And lower case UNBRK$(FIL,"0","9") ; And numbers UNBRK$(FIL,"*") ; Full wild card UNBRK$(FIL,"%") ; Single character wild-card UNBRK$(FIL,"[") ; Start of PPN or UIC UNBRK$(FIL,"]") ; End of PPN or UIC .CHCMA=="," ; Value of a comma UNBRK$(FIL,.CHCMA) ; Separator in PPN's and UIC's UNBRK$(FIL,".") ; Between file name and extension (and generation) UNBRK$(FIL,":") ; After device names UNBRK$(FIL,"$") ; Part of VMS device names UNBRK$(FIL,";") ; Before generation or attributes UNBRK$(FIL,"-") ; For TOPS-20 file names UNBRK$(FIL,.CHLAB) ; Left angle bracket for TOPS-20 directories UNBRK$(FIL,.CHRAB) ; Right angle bracket for TOPS-20 FILBRK: BRGEN$(FIL) ; Generate the mask SUBTTL Command tables -- SERVER command SRV000: $NOISE (CONFRM,) SUBTTL Command tables -- SET command -- Dispatch table SET000: $KEYDSP (SET010) SET010: $STAB DSPTAB (BLK000,<[XWD CHKTYPE##,SETKYW]>,) DSPTAB (DBG000,<[EXP SETDBG]>,) DSPTAB (DEL000,<[XWD DELAY##,SETDEL]>,) DSPTAB (ESC000,<[EXP SETESC]>,) DSPTAB (FBS000,<[XWD FILTYP,SETKYW]>,) TOPS10< DSPTAB (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,)>; End of TOPS10 DSPTAB (ONOFF,<[XWD IBM%flag##,SETKYW]>,) DSPTAB (ABT000,<[XWD ABT%FLAG##,SETKYW]>,) DSPTAB (LIN000,<[EXP SETLIN]>,) DSPTAB (ONOFF,<[XWD LCLECH,SETKYW]>,) DSPTAB (MSG000,<[EXP SETMSG]>,) DSPTAB (PAR000,<[XWD PARITY%TYPE##,SETKYW]>,) DSPTAB (SRC000,<[EXP SETRCV]>,) DSPTAB (RPT000,<[EXP SETRPT]>,) DSPTAB (RTY000,<[EXP SETRTY]>,) DSPTAB (SSN000,<[EXP SETSND]>,) $ETAB SUBTTL Command tables -- SET command -- ON/OFF table ONOFF: $KEYDSP (ONOFFT) ONOFFT: $STAB DSPTAB (CONFRM,BLSFAL,) DSPTAB (CONFRM,BLSTRU,) $ETAB SUBTTL Command tables -- SET command -- incomplete-file ABT000: $NOISE (ABT010,) ABT010: $KEY (CONFRM,ABT01T) ABT01T: $STAB KEYTAB (BLSTRU,) KEYTAB (BLSFAL,) $ETAB SUBTTL Command tables -- SET command -- Block-check-type BLK000: $KEY (CONFRM,BLK01T) BLK01T: $STAB KEYTAB (CHK%1C##,<1-character-checksum>) KEYTAB (CHK%2C##,<2-character-checksum>) KEYTAB (CHK%CR##,<3-character-CRC-CCITT>) KEYTAB (CHK%1C##,) KEYTAB (CHK%CR##,) KEYTAB (CHK%2C##,) $ETAB SUBTTL Command tables -- SET command -- DEBUGGING DBG000: $KEYDSP(DBG00T) DBG00T: $STAB DSPTAB (DBG010,<[XWD SETODF,0]>,) DSPTAB (CONFRM,<[XWD SETCDF,0]>,) DSPTAB (CONFRM,<[XWD SETDBF,BLSFAL]>,) DSPTAB (CONFRM,<[XWD SETDBF,BLSTRU]>,) $ETAB DBG010: $NOISE (DBG011,) DBG011: $OFILE (CONFRM,) SUBTTL Command tables -- SET command -- DELAY DEL000: $NOISE (DEL010,) DEL010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPOS)>) SUBTTL Command tables -- SET command -- ESCAPE ESC000: $NOISE (ESC010,) ESC010: $NUMBER (CONFRM,^D8,,<$DEFAULT(31)>) SUBTTL Command tables -- SET command -- FILE-BYTE-SIZE FBS000: $NOISE (FBS010,) FBS010: $KEYDSP (FBS020) FBS020: $STAB DSPTAB (CONFRM,$FBS7,<7-bit>) DSPTAB (CONFRM,$FBS8,<8-bit>) DSPTAB (CONFRM,$FBAUT,) DSPTAB (CONFRM,$FBS8,) DSPTAB (CONFRM,$FBS7,) $ETAB SUBTTL Command tables -- SET command -- Line LIN000: $NOISE (LIN010,) TOPS20< LIN010: $NUMBER (CONFRM,^D8,) >; End of TOPS20 conditional TOPS10< LIN010: $DEV (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(LIN020),$ERRPDB(LIN020)>) LIN020: $NODNM (LIN030,,<$ALTERNATE(LIN050),$ERRPDB(LIN050)>) LIN030: $NOISE (LIN040,) LIN040: $NUMBER (CONFRM,^D8,) LIN050: $NUMBER (CONFRM,^D8,,$ALTERNATE(CONFRM)) >; End of TOPS10 conditional SUBTTL Commands tables -- SET command -- Message MSG000: $NOISE (MSG010,) MSG010: $KEY (MSG020,MSG030,<$ALTERNATE(MSG020)>) MSG020: $KEY (CONFRM,MSG040) MSG030: $STAB KEYTAB (BLSFAL,) $ETAB MSG040: $STAB KEYTAB (TY%FIL##,) KEYTAB (TY%PKT##,) $ETAB SUBTTL Command tables -- SET command -- Parity PAR000: $NOISE (PAR010,) PAR010: $KEYDSP (PAR020) PAR020: $STAB DSPTAB (CONFRM,PR%EVEN##,) DSPTAB (CONFRM,PR%MARK##,) DSPTAB (CONFRM,PR%NONE##,) DSPTAB (CONFRM,PR%ODD##,) DSPTAB (CONFRM,PR%SPAC##,) $ETAB SUBTTL Command tables -- SET command -- Receive SRC000: $KEYDSP (SRC010) SRC010: $STAB DSPTAB (R8Q000,SETR8Q,<8th-bit-quote>) DSPTAB (R8Q000,SETR8Q,) DSPTAB (REO000,SETREL,) DSPTAB (RPL000,SETRPL,) DSPTAB (RPC000,SETRPC,) DSPTAB (RPD000,SETRPD,) DSPTAB (RQU000,SETRQU,) DSPTAB (RSH000,SETRSH,) DSPTAB (RTI000,SETRTI,) $ETAB R8Q000: $NOISE (R8Q010,) R8Q010: $NUMBER (CONFRM,^D8,,<$ACTION(CHK8QU)>) REO000: $NOISE (REO010,) REO010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKCTL)>) RPL000: $NOISE (RPL010,) RPL010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPKT)>) RPC000: $NOISE (RPC010,) RPC010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKPDC)>) RPD000: $NOISE (RPD010,) RPD010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPOS)>) RQU000: $NOISE (RQU010,) RQU010: $NUMBER (CONFRM,^D8,,<$ACTION(CHK8QU)>) RSH000: $NOISE (RSH010,) RSH010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKSHC)>) RTI000: $NOISE (RTI010,) RTI010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKTIM)>) SUBTTL Command tables -- SET command -- Repeat-quote RPT000: $NOISE (RPT010,) RPT010: $KEY (CONFRM,RPT011,<$ALTERNATE(RPT020)>) RPT011: $STAB KEYTAB (<" ">,) $ETAB RPT020: $NUMBER (CONFRM,^D8,,<$ACTION(CHK8QU)>) SUBTTL Command tables -- SET command -- Retry RTY000: $NOISE (RTY010,) RTY010: $KEY (RTY030,RTY020) RTY020: $STAB KEYTAB (SI%RETRIES##,) KEYTAB (PKT%RETRIES##,) $ETAB RTY030: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPOS)>) SUBTTL Command tables -- SET command -- Send SSN000: $KEYDSP (SSN010) SSN010: $STAB DSPTAB (SEO000,SETSEL,) DSPTAB (SPL000,SETSPL,) DSPTAB (SPC000,SETSPC,) DSPTAB (SPD000,SETSPD,) DSPTAB (SQU000,SETSQU,) DSPTAB (SSH000,SETSSH,) DSPTAB (STI000,SETSTI,) $ETAB SEO000: $NOISE (SEO010,) SEO010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKCTL)>) SPL000: $NOISE (SPL010,) SPL010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPKT)>) SPC000: $NOISE (SPC010,) SPC010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKPDC)>) SPD000: $NOISE (SPD000,) SPD010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKPOS)>) SQU000: $NOISE (SQU010,) SQU010: $NUMBER (CONFRM,^D8,,<$ACTION(CHK8QU)>) SSH000: $NOISE (SSH010,) SSH010: $NUMBER (CONFRM,^D8,,<$ACTION(CHKSHC)>) STI000: $NOISE (RTI010,) STI010: $NUMBER (CONFRM,^D10,,<$ACTION(CHKTIM)>) SUBTTL Command tables -- STATUS command STA000: $NOISE (CONFRM,) SUBTTL Command tables -- SHOW command SHO000: $KEYDSP (SHO010,<$DEFAULT(all)>) SHO010: $STAB DSPTAB (CONFRM,SHOALL,) DSPTAB (CONFRM,SHODAY,) DSPTAB (CONFRM,SHODEB,) DSPTAB (CONFRM,SHOFIL,) DSPTAB (CONFRM,SHOLIN,) DSPTAB (CONFRM,SHOPKT,) DSPTAB (CONFRM,SHOTIM,) DSPTAB (CONFRM,SHOVER,) $ETAB SUBTTL Entry vector and initialization TOPS20< KERMIT: JRST START ; Start program entry JRST START ; Reenter address BYTE (3)KERWHO(9)KERVER(6)KERMIN(18)KEREDT >; End of TOPS20 entry vector TOPS10< KERMIT: TDZA S1,S1 ; Determine if CCL entry or not SETO S1, ; Flag CCL entry MOVEM S1,CCLOFS ; Store the CCL offset >; End of TOPS10 conditional START: RESET ; Reset everthing MOVE P,[IOWD PDLLEN,PDL] ; Set up the stack MOVE S1,[XWD PHABEG,LOWPHA] ; Set up to move the phased code BLT S1,PHAEND ; All of it MOVEI S1,IB.SZ ; Get the initialization block size XMOVEI S2,IB ; And the address $CALL I%INIT ; Initialize GLXLIB $CALL MSG%INIT## ; Initialize the message processing $CALL TT%INIT## ; Initialize the type out routines MOVEI S1,LOWSIZ ; Get the size of the low seg XMOVEI S2,LOWBEG ; And the start address $CALL .ZCHNK ; Clear the low segment out $CALL INIKER ; Initialize Kermit processing $CALL INITRM ; Initialize the terminal processing $CALL INIFIL ; Initialize the file processing ; Initialize the parser interface blocks XMOVEI S1,KER000 ; Start of the tables MOVEM S1,PRBLK+PAR.TB ; Store it XMOVEI S1,PROMPT ; Address of the prompt string MOVEM S1,PRBLK+PAR.PM ; Store it TOPS10< XMOVEI S1,MON000 ; Monitor command block MOVEM S1,MONBLK+PAR.TB ; Store it XMOVEI S1,[EXP 0] ; No prompt string MOVEM S1,MONBLK+PAR.PM ; Store it SETOM MONBLK+PAR.SR ; Rescan the monitor command >; End of TOPS10 conditional SETZB S1,S2 ; No arguments $CALL P$INIT ; Initialize the parser $CALL REDINI ; Read the KERMIT.INI file TOPS10< SKIPE CCLOFS ; CCL Entry ? $CALL SETTMP ; Yes, set up CCL file MOVEI S2,MONBLK ; Get the monitor Kermit paring SKIPE CCLOFS ; CCL Entry ? >; End of TOPS10 conditional MOVEI S2,PRBLK ; No, use other JRST PARL.0 ; Enter the parsing loop ; Here to set up to call the parser again PARLOP: TOPS10< SKIPN TMPADR ; Have a TMPCOR file? SKIPE CCLIFN ; Of a take file? JRST PARL.8 ; Yes, don't exit yet >; End of TOPS10 conditional SKIPE INIIFN ; Processing a KERMIT.INI? JRST PARL.8 ; Yes, can not exit yet SKIPE XITFLG ; No, want out? JRST [SKIPE DBFIFN ; Have an IFN? PUSHJ P,SETCDF ; Yes, close the file $CALL I%EXIT ; And exit JRST .+1] ; In case I%EXIT ever returns TOPS10< PARL.8: SKIPE TMPADR ; Have TMPCOR data? $CALL ADVTMP ; Yes, advance it >; End of TOPS10 conditional SKIPN S1,PAR.CM+PRBLK ; Have some parsed data around? JRST PARL.1 ; No, skip this MOVX S2,COM.SZ-1 ; Get the size STORE S2,.MSTYP(S1),MS.CNT ; Store it PARL.1: MOVEI S2,PRBLK ; Get the address of the arguments PARL.0: MOVX S1,PAR.SZ ; And the size $CALL PARSER## ; Parse a command DMOVEM S1,PRTARG ; Save the argument pointers 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 TXC T2,P.CTAK!P.ERRO ; Error? TXCN T2,P.CTAK!P.ERRO ; from a TAKE file? JRST PARL.D ; Yes, display the line also TXNE T2,P.DSPT ; Need to display this? PARL.D: $TEXT (,<^T/PROMPT/^T/@PRT.MS(S2)/^A>) ; Yes, do it JUMPF PARL.E ; Get an error on the command? MOVEI S1,COM.SZ(T1) ; No, get the address $CALL P$SETU ; Set up to parse the command $CALL P$KEYW ; Get the first keyword $CALL (S1) ; And call the processor for it JUMPT PARLOP ; If no error, keep going $CALL ABRTAK ; Abort any TAKE processing JRST PARLOP ; And try again ; Here if the command parsing got and error. Check for running out of data ;on TMPCOR processing or rescan processing. If we have run out of TMPCOR ;If we have run out of data on a rescan, we will just prompt. PARL.E: TXNE T2,P.CEOF!P.ENDT ; Run out of data? JRST PARL.F ; Yes, go check what we should do $TEXT(,) ; Give the error PARL.F: TXNN T2,P.ENDT ; End of TAKE file? JRST PARL.G ; No, punt the take file if any SKIPE INIIFN ; Doing KERMIT.INI? $RETT ; Yes, pop up a level $CALL ABRT.0 ; No, end of normal TAKE file or CCL entry SKIPA ; And continue on PARL.G: $CALL ABRTAK ; Abort what TAKE processing we can SKIPE INIIFN ; .INI file? $RETT ; Yes, all done with it SKIPE CCLOFS ; CCL entry? $HALT ; Yes, exit, but let him continue JRST PARLOP ; Go for next command ; Here to handle the monitor command dispatch. We just see if we have ; a CRLF or an item to dispatch on. If we have a CRLF just return, else ; we dispatch KERCMD: SETOM XITFLG ; Flag we must exit $CALL P$CFM ; Is this a confirm? JUMPF KERCM0 ; If this is not a confirm, jump $CALL SHOVER ; Show the version SETZM XITFLG ; Clear the exit flag $RETT ; Give a good return to the caller ; Here if we got a command that we are to process KERCM0: $CALL P$KEYW ; Must have a keyword $RETIF ; Return if something else $CALL (S1) ; Call the routine $RET ; Pass back failures SUBTTL Kermit initialization ;+ ;.hl1 INIKER ;This routine will initialize the Kermit processing. It will get whatever ;general information is required for Kermit. ;.literal ; ; Usage: ; $CALL INIKER ; (Return) ; ;.end literal ;- INIKER: MOVX S2,JI.USR ; Get the user directory number SETO S1, ; for this job $CALL I%JINF ; Get it MOVEM S2,.MYPPN ; Store for later MOVX S1,D$ESCAPE ; Get the default escape character MOVEM S1,ESCAPE ; Store it ADDI S1,"A"-.CHCNA ; Convert to printing character $TEXT (<-1,,ESCTXT>,<^^^7/S1/^0>) ; Store the text $RETT ; Return to the caller SUBTTL KERMIT.INI processing ; This routine will set up for processing KERMIT.INI REDINI: SETZM INIIFN ; Assume no .INI file GETPPN S1, ; Get our logged in PPN JFCL ; Silly return STORE S1,INIFD+.FDPPN ; Store for where to find the KERMIT.INI MOVEI S1,INIFD ; Get the FD address SETZ S2, ; And clear the LOG file FD $CALL P$TAKE ; Set it up $RETIF ; Just punt if none MOVEM S1,INIIFN ; Save the IFN $CALL PARL.1 ; Parse the file SETZM INIIFN ; Clear the IFN $RETT ; And return SUBTTL CCL entry processing -- SETTMP ; This routine will set up to read from either TMPCOR or a .TMP file on ;disk. This is used when we have been started at CCL entry. TOPS10< SETTMP: SETZM CCLIFN ; Clear the IFN for disk file MOVX S1, ; Get the arg pointer MOVX T1, ; And the file name SETZ T2, ; No buffer TMPCOR S1, ; See if the file exists JRST SETT.D ; No, try on DSK: AOJ S1, ; Yes, bump the size MOVEM S1,TMPSIZ ; And remember it $CALL M%GMEM ; Get the memory MOVEM S2,TMPADR ; Save the address MOVN T2,TMPSIZ ; Get the buffer size MOVSI T2,(T2) ; In the left half HRRI T2,-1(S2) ; And make the IOWD MOVX T1, ; Get the name MOVX S1, ; Get the pointer TMPCOR S1, ; And read the file $STOP TFD, ; Where did it go? MOVE S1,TMPADR ; Get the address HRLI S1,(POINT 7,) ; And make it a byte pointer STORE S1,PRBLK+PAR.SR ; Save the source ADD S1,TMPSIZ ; Point to last word+2 HRLI S1,(POINT 7,,34) ; Point at last character SUBI S1,2 ; . . . MOVE T1,TMPSIZ ; Get the size SOJ T1, ; Minus one word IMULI T1,5 ; Make it the max number of characters SETT.0: LDB S2,S1 ; Get the character CAIN S2,.CHLFD ; End of command? $RETT ; Yes, no problem JUMPN S2,SETT.1 ; Some non-null character? MOVX S2,-1 ; No, back up ADJBP S2,S1 ; . . . MOVE S1,S2 ; Put the byte pointer back SOJG T1,SETT.0 ; Try again if anything left PJRST ABRTAK ; Nothing really there, all done SETT.1: MOVX S2,.CHLFD ; Doesn't end with a LF, get one IDPB S2,S1 ; And store it $RETT ; And return ; Here to attempt to read the file from disk SETT.D: SETZM TMPADR ; Flag nothing in core MOVE S1,[POINT 6,CCLFD+.FDNAM] ; Get the byte pointer to the name field MOVEM S1,TMPBP ; Save it PJOB S1, ; Get out job number $TEXT (TMPDBP,<^D3R0/S1/KER^A>) ; Store the name MOVEI S1,CCLFD ; Get the FD for the file SETZ S2, ; Want no log file $CALL P$TAKE ; Set up the file $RETIF ; If not found, just return MOVEM S1,CCLIFN ; Save the IFN so we can abort any TAKE file ; Now cheat and delete the file on another channel MOVEI S1,FOB.MZ ; Get the size MOVEI S2,CCLFOB ; And the address $CALL F%DEL ; And delete it (other channel has open copy) $RETT ; And return ; Routine to store sixbit characters TMPDBP: CAIL S1,"`" ; Lower case? SUBI S1,"a"-"A" ; Yes, make upper SUBI S1,"A"-'A' ; Convert to SIXBIT JUMPL S1,.RETT ; Ignore control characters IDPB S1,TMPBP ; Store the character $RETT ; And return >; End of TOPS10 conditional SUBTTL CCL entry processing -- ADVTMP ; This routine is used to advance the byte pointer for the TMPCOR data. ;It will step through the parsed data returned from PARSER while advancing ;our own byte pointer to the TMPCOR data. TOPS10< ADVTMP: MOVE S1,PRTARG+1 ; Get the address of the arg block MOVE S1,PRT.MS(S1) ; Get the address of OPRPAR's buffer HRLI S1,(POINT 7,) ; Make it a byte pointer ADVT.1: ILDB S2,S1 ; Get a character JUMPE S2,ADVT.2 ; Done? IBP PRBLK+PAR.SR ; No, advance the pointer JRST ADVT.1 ; And try again ADVT.2: MOVE S1,PRBLK+PAR.SR ; Get the current pointer ILDB S2,S1 ; And peek at the next character JUMPN S2,.RETT ; If something left, try again $CALL ABRTAK ; All done, clear the take file SKIPE CCLOFS ; CCL entry? $HALT ; Yes, then exit $RETT ; Otherwise, try again >; End of TOPS10 conditional SUBTTL CCL entry processing -- ABRTAK ; This routine will abort the current take file. TOPS10< ABRTAK: SKIPN S2,TMPADR ; Have an incore file? JRST ABRT.1 ; No, check for disk .TMP or TAKE file MOVE S1,TMPSIZ ; Yes, get the size $CALL M%RMEM ; Return the memory SETZM TMPADR ; Clear the address SETZM PRBLK+PAR.SR ; Clear the source pointer $RETT ; And return ABRT.1: SKIPE S1,INIIFN ; Have a KERMIT.INI file? $CALL F%REL ; Yes, release it SKIPN S1,CCLIFN ; Have something? $RETT ; No, all done SETO S2, ; Yes, position it to EOF $CALL F%POS ; . . . ABRT.0: SETZM CCLIFN ; Remember we have done this $RETT ; And return >; End of TOPS10 conditional SUBTTL Command parsing utility routines -- CHKCTL ;+ ;.HL1 Command parsing utility routines ; These routines are called as $ACTION routines during parsing to ;check if the values typed for a field are reasonable. If the ;value is not, an error is returned. ; ;.HL2 CHKCTL ; This routine will check that the value typed represents a valid ASCII ;control character. ;octal. ;- CHKCTL: SKIPL T1,CR.RES(S2) ; Get the result value CAIL T1," " ; Legal character? TRNA ; Failed, skip $RETT ; Everything is OK $CALL FIXIT ; Back up the pointer MOVEI S2,[ASCIZ |Value must be between 0 and 37 octal|] $RETF ; Pass back the error ;+ ;.HL2 CHK8QU ; This routine will check that the value typed is a valid 8-bit quoting ;character. ;- CHK8QU: MOVE T1,CR.RES(S2) ; Get the result value CAIL T1,41 ; Less than 41? CAILE T1,76 ; And less than 76 (range of 41 to 76) TRNA ; No, continue checks $RETT ; Yes, give a good return CAIL T1,140 ; Within the range of 140 to CAILE T1,176 ; 176 TRNA ; No, give an error return $RETT ; Yes, give an ok return $CALL FIXIT ; Fix up the pointers MOVEI S2,[ASCIZ |Value must be within the ranges of 41 to 76 or 140 to 176|] $RETF ; Give a failure return ;+ ;.HL2 CHKTIM ;This routine will check to see if the time out time is valid. Valid time out ;times are within the range of 1 to 94. ;- CHKTIM: SKIPL T1,CR.RES(S2) ; Get the result value CAILE T1,^D94 ; Within range? TRNA ; No, give the error return $RETT ; Valid, return now $CALL FIXIT ; Fix up the command block MOVEI S2,[ASCIZ |Time out must be between 0 and 94|] $RETF ; Give a failure return ;+ ;.HL2 CHKPOS ;This routine will check to see if the number is positive. If it is not then ;an error will be issued. ;- CHKPOS: SKIPL CR.RES(S2) ; Valid number? $RETT ; Yes, just return $CALL FIXIT ; No, error out MOVEI S2,[ASCIZ |Must be a positive number|] $RETF ; Give a failure return ;+ ;.HL2 CHKPKT ;This routine will check to see if the packet length if valid. ;- CHKPKT: MOVE T1,CR.RES(S2) ; Get the value given CAIL T1,^D10 ; Is this within range? CAILE T1,^D94 ; . . . TRNA ; No, issue an error $RETT ; it is ok, just return $CALL FIXIT ; Fix up pointers MOVEI S2,[ASCIZ |Packet length must be between 10 and 94|] $RETF ; Give a failure return ;+ ;.HL2 CHKPDC ;This routine will check to see if the padding character is valid. It will ;make sure that it is either 177 or in the range of 0 to 37. ;- CHKPDC: MOVE T1,CR.RES(S2) ; Get the value CAIN T1,.CHDEL ; Delete? $RETT ; Yes, just return CAIL T1,.CHNUL ; At least a null CAILE T1," "-1 ; And less than a space? TRNA ; No, illegal value $RETT ; Yes, give a good return $CALL FIXIT ; Fix up the pointers MOVEI S2,[ASCIZ |Illegal padding character|] $RETF ; Give a failure return ;+ ;.HL2 CHKSHC ;This routine will check to see if the start of header character is valid. ;It will make sure that it is either 177 or in the range of 0 to 37. ;- CHKSHC: MOVE T1,CR.RES(S2) ; Get the value CAIL T1,.CHNUL ; At least a null CAILE T1," "-1 ; And less than a space? TRNA ; No, illegal value $RETT ; Yes, give a good return $CALL FIXIT ; Fix up the pointers MOVEI S2,[ASCIZ |Illegal start of packet character|] $RETF ; Give a failure return ;+ ;.HL2 FIXIT ;This routine will adjust the pointers back so that the command ;can be Ctl-H'd. ;- FIXIT: HRRZ T4,CR.FLG(S2) ; Get the address of the command block MOVE T1,.CMPTR(T4) ; Get the command pointer MOVE T2,.CMABP(T4) ; Get the byte pointer to the atom buffer FIXI.1: SETO T3, ; Back up one byte ADJBP T3,T1 ; Adjust it MOVE T1,T3 ; Move it back AOS .CMCNT(T4) ; Increment the count ILDB T3,T2 ; Get a character JUMPN T3,FIXI.1 ; If zero then finished MOVEM T1,.CMPTR(T4) ; Store the adjusted byte pointer POPJ P,0 SUBTTL Command execution -- CONNECT command ;+ ;.hl1 C$CONNECT ;This routine will parse and process the CONNECT command. This routine ;will check to determine that the line that is being set is not the same as ;a line that is currently being used. ;- C$CONNECT: $CALL P$CFM ; User type a CONNECT ? JUMPT CNCT.1 ; Yes, skip the setting of this $CALL LINSBR ; Parse the line information $RETIF ; Just return if that failed CNCT.1: MOVE S1,XFRTRM+$TTNOD ; Get the transfer line node number MOVE S2,XFRTRM+$TTLIN ; Get the transfer line number CAMN S1,MYTERM+$TTNOD ; Different from this? CAME S2,MYTERM+$TTLIN ; Same node and line number? JRST CNCT.0 ; No, different, so open the terminals $KERR () $RETF ; Return a failure ; Here if we can open the terminal lines. CNCT.0: RELEAS TTY, ; Close this terminal channel XMOVEI S1,XFRTRM ; Point to the remote terminal $CALL T$OPEN ; Open the terminal $RETIF ; Return if that fails SETZ S1, ; Break on all characters XMOVEI S2,XFRTRM ; Point to the block $CALL T$SBRK ; Set the break information XMOVEI S1,MYTERM ; Now open my terminal $CALL T$OPEN ; Open it JUMPF [XMOVEI S1,XFRTRM ; Close the other terminal $CALL T$CLOS ; . . . $RETF] ; And return SETZ S1, ; Break on all characters XMOVEI S1,MYTERM ; Point to the block $CALL T$SBRK ; Set the PIM mode break set MOVE S1,$TTUDX+XFRTRM ; Get the UDX we are using DEVNAM S1, ; Convert to real name SETZ S1, ; No device? $TEXT(CN.TYP,<[Connecting to remote host via line ^W/S1/:^A>) SKIPE XFRTRM+$TTNOD ; If no network, don't confuse him $TEXT(CN.TYP,< (^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>) $TEXT(CN.TYP,<]>) $TEXT(CN.TYP,) ; MOVEI P1,"S" ; Send chrs state ; This the main CONNECT loop. Get chrs from terminal and ; send them down the data line and vice versa. CN.LP: XMOVEI S2,MYTERM ; Get the address of my terminal block $CALL T$CIN ; Input a character if possible JUMPF CN.LP1 ; Failed, try to output CAIN P1,"E" ; In escape sequence? JRST CN.ESC ; Yes CAIN P1,"C" ; control chr mode? JRST CN.CTL ; yes CAME S1,ESCAPE ; Is this escape? JRST CN.SND ; no, just send it MOVEI P1,"E" ; Yes, set escape mode JRST CN.LP ; and loop ; Previous chr was an escape chr, check for special commands CN.ESC: CAIE S1,"C" ; Is is C CAIN S1,"c" ; or lower case c? JRST CN.END ; Yes done MOVEI P1,"S" ; Assume not send control chr CAMN S1,ESCAPE ; Another escape? JRST CN.SND ; Yes, send a real one CAIN S1,"?" ; want help? JRST CN.HLP ; Yes, do it CAIE S1,"S" ; Want status? CAIN S1,"s" ; or lower case "s" JRST CN.STS ; Yes CAIE S1,"^" ; Want control chr? JRST CN.ESE ; No, bad MOVEI P1,"C" ; Yes, set state JRST CN.LP ; and loop CN.ESE: MOVX S1,.CHBEL ; Control-G $CALL CN.TYP ; DING JRST CN.LP ; And loop ; Control chr mode - change next chr to control chr CN.CTL: MOVEI P1,"S" ; Next state CAIL S1,"@" ; See if reasonable CAILE S1,"~" ; also allow lower case JRST CN.LP ; No, ignore it ANDI S1,37 ; make a control chr JRST CN.SND ; and send it ; Process ? - give them some hints CN.HLP: $TEXT(CN.TYP,<^M^JCONNECT escape commands:>) ; $TEXT(CN.TYP,< ^T/ESCTXT/C - Close connect and return to local KERMIT>) ; $TEXT(CN.TYP,< ^T/ESCTXT/S - Type status>) ; $TEXT(CN.TYP,< ^T/ESCTXT/? - Help (this message)>) ; $TEXT(CN.TYP,< ^T/ESCTXT/^T/ESCTXT/ - Send actual ^T/ESCTXT/>) ; MOVEI S1,[ASCIZ |^x (where x is A-Z,[,\,],^,_) - Send CONTROL-x. Only|] ; $TEXT(CN.TYP,< ^T/ESCTXT/^Q/S1/>) ; Avoid confusing $TEXT $TEXT(CN.TYP,< needed to send CONTROL-S and CONTROL-Q, since other>) ; $TEXT(CN.TYP,< control characters can be typed directly.>) ; JRST CN.LP ; and loop ; Process S - give status CN.STS: MOVE S1,$TTUDX+XFRTRM ; Get the UDX we are using DEVNAM S1, ; Convert to real name SETZ S1, ; No device? $TEXT(CN.TYP,<^M^J[Connecting to remote host via line ^W/S1/:^A>) SKIPE XFRTRM+$TTNOD ; If no network, don't confuse him $TEXT(CN.TYP,< (^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>) $TEXT(CN.TYP,<]>) JRST CN.LP ; and loop ; Send the chr in S1 down the data line CN.SND: XMOVEI S2,XFRTRM ; Get the terminal control block $CALL T$CCOT ; Send chr down line SKIPN LCLECH ; Check if local echo JRST CN.LP ; No, just get another character XMOVEI S2,MYTERM ; Yes, output to our terminal also $CALL T$CCOT ; . . . JRST CN.LP ; and loop ; No more Terminal input just now, see if we did any at all CN.LP1: XMOVEI S2,XFRTRM ; Point to the remote terminal line $CALL T$CIN ; Get a chr from line JUMPF CN.HIB ; None $CALL CN.TYP ; Type it on TTY JRST CN.LP ; go check for TTY input again ; No output either, take a break CN.HIB: MOVE S1,[HB.RIO+HB.RTC+HB.RWJ+^D1000] ; HIBER S1, ; Wait a bit JFCL ; ignore error JRST CN.LP ; and again ; Here when done to close line and reset TTY status CN.END: XMOVEI S1,XFRTRM ; Close all the channels $CALL T$CLOS ; Close this off XMOVEI S1,MYTERM ; Point to my terminal block $CALL T$CLOS ; Close that one too $CALL OCTERM ; Kludge the terminal back $TEXT(,<^M^J[Connection closed. Returning to local KERMIT]>) ; $RETT ; CN.TYP: XMOVEI S2,MYTERM ; Point to the terminal block $CALL T$CCOT ; Output the character $RETT ; and return SUBTTL Command execution -- EXIT command C$EXIT: $CALL P$CFM ; Make sure we have a confirm $RETIF ; Return if we don't ; Here on a control-Z C$EXI0: $HALT ; Exit to the monitor $RETT ; Allow continues SUBTTL Command execution -- BYE command ;+ ;.hl1 C$BYE ;This routine will process the BYE command. It will cause the remote ;server to exit and then will cause the local Kermit to exit. ;.literal ; ; Usage: ; $CALL C$BYE ; (Return) ; ;.end literal ;- C$BYE: $CALL C$FINISH ; Cause the remote to go away $RETIF ; Return if that failed SETOM XITFLG ; Flag we must exit $RETT ; Give a good return SUBTTL Command execution -- FINISH command ;+ ;.hl1 C$FINISH ;This routine will cause the remote server to exit to its operating system. ;.literal ; ; Usage: ; $CALL C$FINISH ; (Return) ; ;.end literal ;- C$FINISH: $CALL T$LOCAL ; Is this my terminal? JUMPT [$KERR() $RETF] ; And return $CALL OPNTRM ; Open the terminal $RETIF ; Just return if this fails BLSCAL (DO%GENERIC##,<[EXP GC%EXIT##]>) $CALL CLSTRM ; Close the terminal $RETT ; Give a good return SUBTTL Command execution -- LOGOUT command ;+ ;.hl1 C$LOGOUT ;This routine will cause the remote server to LOGOUT of the remote system. ;.literal ; ; Usage: ; $CALL C$LOGOUT ; (RETURN) ; ;.END LITERAL ;- C$LOGOUT: $CALL T$LOCAL ; Is this my terminal? JUMPT [$KERR() $RETF] $CALL OPNTRM ; Open the terminal $RETIF ; Just return if this fails BLSCAL (DO%GENERIC##,<[EXP GC%LOGOUT##]>) $CALL CLSTRM ; Close the terminal $RETT ; Give a good return SUBTTL Command execution -- HELP command ;+ ;.hl1 C$HELP ;This routine will process the HELP command. It will call the OPRPAR routine ;to do the actual processing of the HELP command. ;.literal ; ; Usage: ; $CALL C$HELP ; (Return) ; ;.end literal ;- C$HELP: $CALL P$CFM ; Confirm? JUMPT HELP.0 ; Yes, Skip this then $CALL P$TEXT ; Parse the text ADD S1,[POINT 7,PFD.D1] ; Point to the data JRST HELP.1 ; Continue on HELP.0: MOVE S1,[POINT 7,[BYTE (7).CHNUL,.CHNUL]] ; Null string HELP.1: MOVEI S2,HLPFD ; Point to the FD to use EXCH S1,S2 ; Put into the right registers $CALL P$HELP## ; Call the help processor $RETT ; Give a good return SUBTTL Command execution -- PROMPT command ;+ ;.HL1 PROMPT ;This routine will just cause KERMIT-10 to prompt the user again. ;It is used when the user needs to get to the KERMIT-10> prompt when ;KERMIT is run from the monitor KERMIT command. ;.LITERAL ; ; Usage: ; $CALL C$PROMPT ; (Return) ; ;.end literal ;- C$PROMPT: $CALL P$CFM ; See if there is a confirm $RETIF ; Just return if false SETZM CCLOFS ; Clear the CCL offset SETZM XITFLG ; Don't exit now $CALL SHOVER ; Show the version (ala KERMIT-20) $RETT ; Give a good return SUBTTL Command execution -- SEND command ;+ ;.HL1 C$SEND ;This routine will parse the SEND command for KERMIT-10. It will call ;the lower level routines with the ASCIZ of the file specification. ;- C$SEND: $CALL P$QSTR ; Parse the argument SKIPT ; Ok? $CALL P$FLD ; Parse a field $RETIF ; Return if that failed ADD S1,[POINT 7,PFD.D1] ; Point to the data MOVE T1,[POINT 7,FILE%NAME##] ; Point to the information IMULX S2,5 ; Determine the number of characters SUBX S2,PFD.D1*5 ; Remove the size of the header SETZM FILE%SIZE## ; Clear the character count SEND.0: SOJL S2,SEND.1 ; Finished? ILDB T2,S1 ; Get a byte IDPB T2,T1 ; Store it JUMPE T2,SEND.2 ; Null byte finally AOS FILE%SIZE## ; Increment the count of the characters JRST SEND.0 ; Loop for all characters SEND.1: SETZ T2, ; Clear this IDPB T2,T1 ; End of file specification ; Now that the file specification is copied to the KERMSG area we can now ; attempt to transfer the file SEND.2: $CALL OPNTRM ; Open the terminal $RETIF ; Return if that failed $CALL SEND%SWITCH## ; Send the file specification $CALL CLSTRM ; Close the terminal $RETT ; Return to the caller SUBTTL Command execution -- GET command ;+ ;.hl1 C$GET ;this routine will get a file(s) from the remote Kermit. It will ;use the RECEIVE routine for most of the work. ;.literal ; ; Usage: ; $CALL C$GET ; (Return) ; ;.end literal ;- C$GET: SETZM USRFIL ; No user supplied name $CALL T$LOCAL ; Is this my terminal? JUMPT [$KERR() $RETF] $CALL P$QSTR ; Parse the argument SKIPT ; Ok? $CALL P$FLD ; Parse a field $RETIF ; Return if that failed ADD S1,[POINT 7,PFD.D1] ; Point to the data MOVE T1,[POINT 7,FILE%NAME##] ; Point to the information IMULX S2,5 ; Determine the number of characters SUBX S2,PFD.D1*5 ; Remove the size of the header SETZM FILE%SIZE## ; Clear the character count GET.0: SOJL S2,GET.1 ; Finished? ILDB T2,S1 ; Get a byte IDPB T2,T1 ; Store it JUMPE T2,GET.2 ; Null byte finally AOS FILE%SIZE## ; Increment the count of the characters JRST GET.0 ; Loop for all characters GET.1: SETZ T2, ; Clear this IDPB T2,T1 ; End of file specification GET.2: JRST RECE.1 ; Get the files SUBTTL Command execution -- RECEIVE command ;+ ;.HL1 C$RECEIVE ;This routine will copy the unquoted string that is the file specification ;to the FILE%NAME data area in KERMSG and the length of the string into ;FILE%SIZE. ; After that is done the terminal will be opened and the SEND%SWITCH ;BLISS routine called. ;- C$RECEIVE: SETZM USRFIL ; Flag user didn't supply specification $CALL P$OFIL ; Have an output file specification? JUMPF RECE.0 ; No, skip this SETOM USRFIL ; User supplied output specification HRL S1,S1 ; Get set to move it HRRI S1,USRFX ; Point to the user block ADDI S2,USRFX ; Point to the end BLT S1,-1(S2) ; Move all of the file specification SETOM USRFX+.FDNMM ; Flag not wild HLLOS USRFX+.FDEXM ; . . . SETOM USRFX+.FDDIM ; . . . MOVE S1,[XWD USRFX+.FDDIM,USRFX+.FDSFM] ; Fill all of the path BLT S1,USRFX+.FDSFM+4 ; All SFDs $CALL P$CFM ; Parse the confirm $RETIF ; Return if that fails JRST RECE.1 ; Continue processing RECE.0: $CALL P$CFM ; Parse the confirm $RETIF ; Return if that fails SETZM FILE%SIZE## ; No file specification RECE.1: $CALL OPNTRM ; Open the terminal $RETIF ; Return if that fails $CALL REC%SWITCH## ; Call the BLISS routine $CALL CLSTRM ; Close the terminal $RETT ; Return to the caller FILSTO: IDPB S1,FILPTR ; Store the byte AOS FILE%SIZE## ; Increment the number of characters $RETT ; Return to the caller SUBTTL Command execution -- SERVER command ;+ ;.hl1 SERVER ;This command will cause KERMIT to go into SERVER mode as desribed in ;the protocol manual version 2 or later. ;- SRVTXT: ASCIZ | [Kermit Server running on the DEC host. Please type your escape sequence to return to your local machine. Shut down the server by typing the Kermit BYE command on your local machine.] | C$SERVER: $CALL P$CFM ; Have a confirm? $RETIF ; Just return if not $TEXT (,<^T/SRVTXT/>) ; Output the text $CALL OPNTRM ; Open the user terminal $RETIF ; Return if it failed $CALL SERVER## ; Call the server processor MOVE P1,S1 ; Copy the value returned $CALL CLSTRM ; Close the terminal CAXE P1,ABORTED ; Was the transfer aborted (Ctl-C)? SETOM XITFLG ; No, flag we must exit $RETT ; Give a good return SUBTTL Command execution -- SET command -- Top level ;+ ;.hl1 C$SET ;This routine will handle the SET command. It will determine which of ;the keywords was typed and then dispatch to the correct routine to process ;the command. ;- C$SET: $CALL P$KEYW ; Parse a keyword $RETIF ; Return if that fails MOVE S1,(S1) ; Get the information supplied HLRZ P1,S1 ; Get the extra data $CALL (S1) ; Call the correct routine $RET ; Return to the top level SUBTTL Command execution -- SET command -- SETKYW - Parse a keyword and store the value ;+ ;.HL2 SETKYW ;This routine is used for the various SET commands that take only a keyword. ;It will then store the information into the address pointed to by P1. ;- SETKYW: $CALL P$KEYW ; Get the keyword supplied $RETIF ; Return if there is no keyword MOVEM S1,(P1) ; Store the information $RETT ; Give a good return SUBTTL Command execution -- SET command -- DEBUGGING parameter ;+ ;.HL2 SETDBG ; This routine will handle the SET DEBUG command. This command allows ;debugging typeout to be turned on or off, and also allows a log file ;of debugging info to be created. ; It will determine which format of the command was given, and either ;store the ON/OFF value or open/close the log file. ;- SETDBG: $CALL P$KEYW ; Get the keyword HLRZ S2,(S1) ; Get the routine to call HRRZ S1,(S1) ; And a possible value JRST (S2) ; Go handle type of keyword ; Here for SET DEBUGGING ON/OFF SETDBF: MOVEM S1,DEBUG%FLAG## ; Store the flag value $RETT ; And return ; Here for SET DEBUGGING LOG-FILE filename SETODF: SKIPE S1,DBFIFN ; Is there a file still open? $CALL F%REL ; Yes, release it first SETZM DBFIFN ; No file open now $CALL P$OFIL ; Get an output file FD STORE S1,DBFFOB+FOB.FD ; Store the pointer to the FD MOVEI S1,FOB.MZ ; Miniumu size FOB MOVEI S2,DBFFOB ; Point at the FOB $CALL F%AOPN ; Open the .LOG file for append JUMPT [MOVEM S1,DBFIFN ; Save the debugging file IFN MOVX S1,BLSTRU ; Flag this as true MOVEM S1,DEBUG%FLAG## ; . . . $RET] ; And pass back the true return $KERR () $RETF ; And return the error ; Here for SET DEBUGGING NO-LOG-FILE. SETCDF: SKIPN S1,DBFIFN ; Have a file? JRST [$KERR() $RETF] ; No, give an error $CALL F%REL ; Yes, release it MOVX S1,BLSFAL ; Flag it as false MOVEM S1,DEBUG%FLAG## ; Store it SETZM DBFIFN ; No log file anymore $RETT ; And return SUBTTL Command execution -- SET command -- Initial DELAY ;+ ;.HL2 SETDEL ;This routine will handle the SET DELAY n command. It will store the ;number of seconds to delay into DELAY in KERMSG. ;- SETDEL: $CALL P$NUM ; Get the number supplied $RETIF ; Return if not a number MOVEM S1,DELAY## ; Store for KERMSG $RETT ; Return to the caller ;+ ;.HL2 SETESC ;This routine will set the escape character. It will check to determine if the ;escape character is valid. ;- SETESC: $CALL P$NUM ; get the number JUMPF SETES0 ; Failed, issue an error JUMPLE S1,SETES0 ; Issue an error CAIL S1," " ; Must be a control character JRST SETES0 ; Failed MOVEM S1,ESCAPE ; Store the character ADDI S1,"A"-.CHCNA ; Convert to printing equivalent $TEXT (<-1,,ESCTXT>,<^^^7/S1/^0>) ; Store the text $RETT SETES0: $KERR (Illegal escape character ^O/S1/) $RETF ; Failure return SUBTTL Command execution -- SET command -- LINE to use ;+ ;.HL2 SETLIN ;This routine will store the line number to use to talk to the remote ;Kermit. ;- SETLIN: $CALL P$CFM ; Do we have a confirm? JUMPF LINSBR ; No, do the set stuff MOVE S1,$TTNOD+MYTERM ; Use my terminal MOVEM S1,$TTNOD+XFRTRM ; Store it MOVE S1,$TTLIN+MYTERM ; . . . MOVEM S1,$TTLIN+XFRTRM ; Store it RELEAS TTYHLD, ; Give up on terminal we grabbed $RETT ; Return to the caller ; Here to set the line to use for transfering information LINSBR: $CALL P$NUM ; Get the line number JUMPF SETLI0 ; Failed, see if other type $TEXT (<-1,,.TEMP>,) ; Build the device name HRROI S1,.TEMP ; Point to the text JRST SETLI2 ; Convert to node and line number SETLI0: $CALL P$NODE ; Parse a node name/number JUMPF SETLI1 ; Failed, try for device TLNN S1,-1 ; Is this a name? JRST SETLI4 ; No, store the number MOVE S2,S1 ; Move the information MOVEI S1,2 ; Get the length of this MOVX T1, ; Point to the arguments NODE. T1, ; Do it JRST [$KERR () $RETF] MOVE S1,T1 ; Get the number now SETLI4: MOVEM S1,XFRTRM+$TTNOD ; Store the node information $CALL P$NUM ; Parse the line number MOVEM S1,XFRTRM+$TTLIN ; Store as the line number $CALL P$CFM ; Parse the confim ; Now make sure we can get the terminal SETLI6: MOVEI S1,XFRTRM ; Get the terminal descriptor address $CALL T$CONN ; Make sure the terminal is MOVE T2,S1 ; Get the name IONDX. S1, ; Available JRST [$KERR () $RETF] ; Punt MOVEM S1,XFRTRM+$TTUDX ; Store the UDX MOVE S1,T2 ; Reget device name DEVTYP S1, ; Get the device type bits JRST [$KERR () $RETF] ; Give up TXNN S1,TY.AVL ; Device available? JRST [$KERR () $RETF] ; We can't get the terminal $CALL T$LOCAL ; Check if using own terminal JUMPT [RELEAS TTYHLD, ; Yes, let go of other terminal $RETT] ; And return MOVX T1,.IOASC ; Get the mode SETZ T3, ; No buffers OPEN TTYHLD,T1 ; Get the terminal so no one steals it JRST [$KERR () $RETF] ; Give up $RETT ; And return to the caller SETLI1: $CALL P$DEV ; Parse the terminal name $RETIF ; Return if that failed ADD S1,[POINT 7,PFD.D1] ; Point to the data area SETLI2: $CALL S%SIXB ; Convert to a device name $RETIF ; Return if this fails MOVE S1,S2 ; Save a copy GTNTN. S2, ; Convert to node and line number JRST SETLI3 ; Failed, issue error message HLRZM S2,XFRTRM+$TTNOD ; Store the node number HRRZM S2,XFRTRM+$TTLIN ; And the line number JRST SETLI6 ; Go grab the terminal SETLI3: CAMN S2,S1 ; Non-network system? JRST SETLI5 ; Yes, go store correct things $KERR (<^T/@GTNERR(S2)/>) ; Issue the error $RETF ; Return to the caller ; Here if system does not have network support SETLI5: SETZM XFRTRM+$TTNOD ; No node IONDX. S2, ; Convert to UDX (for line number) JRST [$KERR () ; Must not be valid $RETF] ; Can't set the line here CAXL S2,.UXTRM ; Check if valid terminal CAXLE S2,.UXTRM+^O777 ; . . . JRST [$KERR () ; Nope, give up $RETF] ; Give up MOVEM S2,XFRTRM+$TTUDX ; Store UDX SUBX S2,.UXTRM ; Convert to line number MOVEM S2,XFRTRM+$TTLIN ; And line number JRST SETLI6 ; Go grab the terminal ; Error text GTNERR: [ASCIZ /Nonexistent device/] [ASCIZ /Device is not a terminal/] [ASCIZ /Terminal is not connected/] SUBTTL Command execution -- SET command -- MESSAGE parameters ;+ ;.hl2 SETMSG ;This routine will set the level of message type out the user wishes to see. ;This current parameters include the typing of file specifications on ;receive or send and the packet numbers. ;- SETMSG: $CALL P$KEYW ; Parse a keyword $RETIF ; Return if that failed MOVE P1,S1 ; Get the information parsed $CALL P$KEYW ; Get the next keyword (could have ; gotten NO as the first) JUMPF [MOVX S1,TRUE ; If no second keyword, get a true MOVEM S1,(P1) ; And set the argument $RETT] ; All done MOVEM P1,(S1) ; Otherwise, store the false $RETT ; Return to the caller SUBTTL Command execution -- SET command -- RECEIVE parameters ;+ ;.hl2 SETRCV ;This routine is used to set the various RECEIVE parameters. It will ;dispatch to lower level routines to do the real work. ;- SETRCV: $CALL P$KEYW ; Get the keywd the user supplied $RETIF ; Return if false $CALL (S1) ; Call the user routine $RET ; Return to the user ;+ ;.HL2 SETR8Q ;This routine will set the 8bit quoting character. ;- SETR8Q: $CALL P$NUM ; Get the number MOVEM S1,RCV%8QUOTE%CHAR## ; Store the value $RETT ; Give a good return ;+ ;.hl2 SETREL ;Routine to set the end of line character for the receiver side. ;- SETREL: $CALL P$NUM ; Get the number $RETIF ; Return MOVEM S1,RCV%EOL## ; Store the parameter $RETT ; Give a good return ;+ ;.HL2 SETRPC ;This routine will set the padding character for the receive side. ;- SETRPC: $CALL P$NUM ; Parse a number $RETIF ; Return if false CAIN S1,.CHDEL ; Is this a delete? JRST STRPC0 ; Yes, ok SKIPL S1 ; Less than zero? CAILE S1,^O37 ; Or greater than 37? JRST STRPC1 ; Yes, illegal STRPC0: MOVEM S1,RCV%PADCHAR## ; Store the padding character $RETT ; Give a good return STRPC1: $KERR (Illegal padding cahracter) $RETF ; Give a failure return ;+ ;.HL2 SETRPD ;This routine will store the number of padding characters that should be ;sent to the remote Kermit. ;- SETRPD: $CALL P$NUM ; Get the number we parsed $RETIF ; Return if that failed JUMPL S1,[$KERR(Must be a postive number) $RETF ] ; Issue the error and return MOVEM S1,RCV%NPAD## ; Store the number of characters $RETT ; Give a good return ;+ ;.hl2 SETRPL ;This routine will set the length of the packets to receive. ;- SETRPL: $CALL P$NUM ; Get the number parsed $RETIF ; Return if that failed CAIL S1,^D10 ; Min length CAILE S1,^D94 ; Max length JRST [$KERR(Illegal packet size) $RETF] ; Issue error and return MOVEM S1,RCV%PKT%SIZE## ; Store the packet length $RETT ; Return to the caller ;+ ;.hl2 SETRQU ;This routine will set the receive quoting character. ;- SETRQU: $CALL P$NUM ; Get the value MOVEM S1,RCV%QUOTE## ; Store the quote character $RETT ;+ ;.HL2 SETRSH ; This routine will store the parsed start of header character. ;- SETRSH: $CALL P$NUM ; Get a number $RETIF ; Punt if we can't MOVEM S1,RCV%SOH## ; Store it $RETT ; And give a good return ;+ ;.HL2 SETRTI ;This routine will store the parsed time out time. ;- SETRTI: $CALL P$NUM ; Get the number $RETIF ; Return if that fails MOVEM S1,RCV%TIMEOUT## ; Store it $RETT ; Give a good return ;+ ;.HL2 SETRTY ;This routine will set the retry count for either the initial connection or ;the number of packets. ;- SETRTY: $CALL P$KEYW ; Parse a keyword $RETIF ; Return if that fails MOVE P1,S1 ; Copy the store address $CALL P$NUM ; Get the number of retries allowed $RETIF ; Return if that fails MOVEM S1,(P1) ; Store the number of retries $RETT ; Give a good return to the caller ;+ ;.HL2 SETSND ;This routine will set the various SEND parameters. It will dispatch ;to lower level routines to do the real work. ;- SETSND: $CALL P$KEYW ; Parse a keyword $RETIF ; Return if it isn't $CALL (S1) ; Call the routine $RET ; Return to the caller ;+ ;.HL2 SETSEL ;This routine will set the send side end of line character. ;- SETSEL: $CALL P$NUM ; Get the number $RETIF ; Return MOVEM S1,SND%EOL## ; Store the parameter $RETT ; Give a good return ;+ ;.HL2 SETSPC ;This routine will store the send padding character. ;- SETSPC: $CALL P$NUM ; Parse a number $RETIF ; Return if false CAIN S1,.CHDEL ; Is this a delete? JRST STSPC0 ; Yes, ok SKIPL S1 ; Less than zero? CAILE S1,^O37 ; Or greater than 37? JRST STRPC1 ; Yes, illegal STSPC0: MOVEM S1,SND%PADCHAR## ; Store the padding character $RETT ; Give a good return ;+ ;.hl2 SETSPD ;This routine will store the number of send padding characters to expect. ;- SETSPD: $CALL P$NUM ; Get the number we parsed $RETIF ; Return if that failed JUMPL S1,[$KERR(Must be a postive number) $RETF ] ; Issue the error and return MOVEM S1,SND%NPAD## ; Store the number of characters $RETT ; Give a good return ;+ ;.HL2 SETSPL ;This routine will set the send packet length. ;- SETSPL: $CALL P$NUM ; Get the number parsed $RETIF ; Return if that failed CAIL S1,^D10 ; Min length CAILE S1,^D94 ; Max length JRST [$KERR(Illegal packet size) $RETF] ; Issue error and return MOVEM S1,SND%PKT%SIZE## ; Store the packet length $RETT ; Return to the caller ;+ ;.HL2 SETSQU ;This routine will set the sending quoting character ;- SETSQU: $CALL P$NUM ; Gett he value MOVEM S1,SND%QUOTE## ; Store the quote character $RETT ;+ ;.HL2 SETSSH ; This routine will store the parsed start of header character. ;- SETSSH: $CALL P$NUM ; Get a number $RETIF ; Punt if we can't MOVEM S1,SND%SOH## ; Store it $RETT ; And give a good return ;+ ;.hl2 SETSTI ;This routine will set the sending time out time. ;- SETSTI: $CALL P$NUM ; Get the number $RETIF ; Return if that fails MOVEM S1,SND%TIMEOUT## ; Store it $RETT ; Give a good return ;+ ;.HL2 SETRPT ;This routine will set the repeat quoting character ;- SETRPT: $CALL P$NUM ; Get the number JUMPT SETRP0 ; If we got it, store it $CALL P$KEYW ; Otherwise, get a keyword $RETIF ; If not, give up SETRP0: MOVEM S1,SET%REPT%CHR## ; Store the repeat character $RETT SUBTTL Command execution -- SHOW command ;+ ;.HL1 C$SHOW ;This command will show the current values of the parameters that can be ;set with the SET command. This routine is called after the SHOW command ;has been parsed. ;- C$SHOW: $CALL P$KEYW ; Get the keyword parsed $RETIF ; Return if not a keyword $CALL (S1) ; Call the correct routine $RET ; Return to the caller ;+ ;.HL2 SHOALL ;This routine will show all of the various parameters. This routine ;is called from the SHOW command dispatch routine. ;.literal ; ; Usage: ; $CALL SHOALL ; (Return) ; ;.end literal ;- SHOALL: $CALL SHOVER ; Show the version first $CALL SHODAY ; Show the date/time $TEXT (,<>) ; Issue a blank line $CALL SHOLIN ; Output the line information $TEXT (,<>) ; Issue a blank line. $CALL SHOFIL ; Show the file information $TEXT (,<>) ; Issue a blank line. $CALL SHODEB ; Show debugging flag $TEXT (,<>) ; Issue a blank line. $CALL SHOPKT ; Show the packet information $TEXT (,<>) ; Issue a blank line. $CALL SHOTIM ; Show the timing information $TEXT (,<>) ; Issue a blank line $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW VERSION ;+ ;.HL2 SHOVER ;This routine will display the version of KERMIT-10. This is compatible with ;KERMIT-20. ;.literal ; ; Usage: ; $CALL SHOVER ; (Return) ; ;.end literal ;- SHOVER: $TEXT (,) $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW DAYTIME ;+ ;.HL2 SHODAY ;This routine will display the current date/time. This is compatible with ;KERMIT-20. ;.literal ; ; Usage: ; $CALL SHODAY ; (Return) ; ;.end literal ;- SHODAY: $TEXT (,<^H/[EXP -1]/>) ; Output the date/time $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW DEBUGGING ;+ ;.HL2 SHODEB ;This rotine will display the state of the debugging parameters. This ;routine is called by the SHOW command dispatcher and SHOW ALL command. ;.literal ; ; Usage: ; $CALL SHODEB ; (Return) ; ;.end literal ;- SHODEB: MOVE S1,TY%FIL## ; Get the file specification type out $CALL TONOFF ; Get the text associated with it $TEXT (,) MOVE S1,TY%PKT## ; Get the packet number type out flag $CALL TONOFF ; Get the text associated with it $TEXT (,) MOVE S1,DEBUG%FLAG## ; Get the flag value $CALL TONOFF ; Get the text $TEXT (,) SKIPN S1,DBFIFN ; Do we have a debugging log file? $RETT ; No, just return SETO S2, ; Want FD for actual file $CALL F%FD ; Get the FD back with the file info $TEXT (,) ; Say what it is $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW FILE-INFORMATION ;+ ;.HL2 SHOFIL ;This routine will display the various file information parameters that ;are possible to set. ;- SHOFIL: MOVE S1,FILTYP ; Get the file type being used $TEXT (,) TOPS10< MOVE S1,WARN%FLAG## ; Get the flag value $CALL TONOFF ; Get the value $TEXT (,) >; End of TOPS10 conditional MOVE S1,ABT%FLAG## ; Get aborted file flag TXNE S1,BLSTRU ; True? SKIPA S1,[[ASCIZ |Discard|]] ; Yes, discard MOVEI S1,[ASCIZ |Keep (whatever portion was received)|] ; No, Keep $TEXT (,) $RETT ; Return to the caller DEFINE FT(NUM,TEXT)<[ASCIZ |TEXT|]> FBSTBL: $FLTYP SUBTTL Command execution -- SHOW command -- SHOW LINE-INFORMATION ;+ ;.hl2 SHOLIN ;This routine will display the line that is being used for the transfer of ;information to the remote Kermit. ;- SHOLIN: MOVEI S1,XFRTRM ; Point to the information $CALL T$CONN ; Connect the terminal to the system $TEXT (,) SKIPE XFRTRM+$TTNOD ; Non-network? $TEXT (,<(^N/XFRTRM+$TTNOD/:: line # ^O/XFRTRM+$TTLIN/)^A>) $TEXT (,<>) ; And a CRLF MOVE S1,IBM%FLAG## ; Get the flag $CALL TONOFF ; Get the value $TEXT (,< IBM-mode: ^T/(S1)/^A>) MOVE S1,IBM%CHAR## ; Get the IBM hand shake character $CALL CHITXT ; Get the text for it $TEXT (,<, Handshake: ^T/.TEMP/>) MOVE S1,PARITY%TYPE## ; Get the parity type MOVE S2,IBM%FLAG## ; Get the IBM flag TXNN S2,BLSTRU ; Is it on? CAIN S1,PR%MARK ; Mark? MOVEI S2,[ASCIZ |mark|] ; Yes, either mark set or IBM mode CAIN S1,PR%NONE ; None? MOVEI S2,[ASCIZ |none|] ; Yes CAIN S1,PR%SPACE ; Space? MOVEI S2,[ASCIZ |space|] ; Yes CAIN S1,PR%ODD ; Odd? MOVEI S2,[ASCIZ |odd|] ; Yes CAIN S1,PR%EVEN ; Even parity? MOVEI S2,[ASCIZ |even|] ; Yes $TEXT (,< Parity: ^T/(S2)/>) ; MOVE S1,DUPLEX## ; Get the duplex variable ; MOVEI S2,[ASCIZ /Half/] ; Default text ; CAIN S1,DP%FULL## ; Is this full duplex? ; MOVEI S2,[ASCIZ /Full/] ; Yes, use this text instead ; $TEXT (,< Duplex: ^T/(S2)/>) MOVE S1,LCLECH ; Get the flag $CALL TONOFF ; Get the value $TEXT (,< Local echo: ^T/(S1)/^A>) MOVE S1,ESCAPE ; Get the escape character $CALL CHITXT ; Get the correct way to type it $TEXT (,< Escape: ^T/.TEMP/>) $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW PACKET-INFORMATION ;+ ;.hl2 SHOPKT ;This routine will show the packet information. ;- SHOPKT: $TEXT (,) MOVM S1,SND%PKT%LENGTH## ; Get the length $TEXT (,< Size: ^D7 /RCV%PKT%LENGTH##/ ^D5 /S1/ chars>) MOVM S1,SND%NPAD## ; Get the padding value $TEXT (,< Padding: ^D7 /RCV%NPAD##/ ^D5 /S1/>) MOVE S1,RCV%PAD## ; Get the padding character $CALL CHITXT ; Convert it to text $TEXT (,< Pad Character: ^T7R /.TEMP/ ^A>) MOVM S1,SND%PAD ; Get the send pad character $CALL CHITXT ; Get the text $TEXT (,<^T5R /.TEMP/>) MOVE S1,RCV%EOL## ; Get the receive EOL character $CALL CHITXT ; Convert it $TEXT (,< End-Of-Line: ^T7R /.TEMP/ ^A>) MOVM S1,SND%EOL## ; Get the end of line character $CALL CHITXT ; Get the text $TEXT (,<^T5R /.TEMP/>) MOVE S1,RCV%QUOTE## ; Get the receive quoting character $CALL CHITXT ; Convert it to text $TEXT (,< Control Quote: ^T7R /.TEMP/ ^A>) MOVM S1,SND%QUOTE## ; Get the send quoting character $CALL CHITXT ; Convert it to text $TEXT (,<^T5R /.TEMP/>) MOVE S1,RCV%SOH## ; Get the start of header character $CALL CHITXT ; Make it text $TEXT (,< Start-of-Packet: ^T7R /.TEMP/ ^A>) MOVM S1,SND%SOH## ; Get the send start of header $CALL CHITXT ; Make it text $TEXT (,<^T5R /.TEMP/>) ; Output it MOVE S1,RCV%8QUOTE## ; Get the quoting character $CALL CHITXT ; Convert to text $TEXT (,<^M^J 8th-bit Quote character ^T/.TEMP/>) MOVE S1,SET%REPT%CHR## ; Get the repeat character $CALL CHITXT ; Make it printable MOVE S1,SET%REPT%CHR## ; Get the charcter back CAIN S1," " ; Is it a space? JRST [MOVE S1,[ASCII |None|] ; Yes, that really means no repeats MOVEM S1,.TEMP ; So say that JRST .+1] ; Continue $TEXT (,< Repeat Quote character ^T/.TEMP/>) MOVE S1,CHKTYPE## ; Get the block check type MOVE S1,SHOBLT-CHK%1C##(S1) ; Get the text to type $TEXT (,< Block check type is ^T/(S1)/>) ; Type it $RETT ; And return SHOBLT: EXP [ASCIZ |1 character checksum|] EXP [ASCIZ |2 character checksum|] EXP [ASCIZ |3 character CRC-CCITT|] SUBTTL Command execution -- SHOW command -- SHOW TIMING-INFORMATION ;+ ;.hl2 SHOTIM ;This routine will show the timing parameters. ;- SHOTIM: $TEXT (,) MOVM S1,SND%TIMEOUT## ; Get the time out $TEXT (,< Time out: ^D7 /RCV%TIMEOUT##/ ^D5 /S1/ secs>) $TEXT (,<^M^J Delay before sending first packet: ^D/DELAY##/ secs>) $TEXT (,< Packet retries before timeout: ^D/PKT%RETRIES##/>) $TEXT (,< Number of retries for initial packet: ^D/SI%RETRIES##/>) ; $TEXT (,< Server NAKs every ^D/???/ seconds while waiting for commands>) $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- Support routines -- TONOFF ;+ ;.hl3 TONOFF ;This routine is a utility routine that will return the address of the ;string "on" or "off" or "unknown" depending on if the value passed to ;it is either the BLISS value for TRUE or FALSE or neither. ;.literal ; ; Usage: ; MOVE S1,Value ; $CALL TONOFF ; (Return) ; ; On return: ; S1/ Address of the text ; ;.end literal ;- TONOFF: MOVE S2,S1 ; Copy this MOVEI S1,[ASCIZ |unknown|] ; Start with unknown CAIN S2,BLSTRU ; On? MOVEI S1,[ASCIZ |on|] ; Yes, use this CAIN S2,BLSFAL ; Off? MOVEI S1,[ASCIZ |off|] ; Yes, use this instead $RET ; Return to the caller SUBTTL Command execution -- SHOW command -- Support routines -- CHITXT ;+ ;.hl3 CHITXT ;This routine will store the text associated with the character that is ;passed to it. The text will be stored in .TEMP in the low segment. ;.literal ; ; Usage: ; MOVE S1,Character value ; $CALL CHITXT ; (Return) ; ; On return: ; .TEMP/ Contains the ASCIZ text of the character ; ;.end ltieral ;- CHITXT: CAIE S1,.CHDEL ; Delete? JRST CHITX0 ; No, skip this $TEXT (<-1,,.TEMP>,<^7/[EXP .CHLAB]/del^7/[EXP .CHRAB]/^0>) ; Yes, get the text $RET ; Return to the caller CHITX0: CAIGE S1," " ; Greater than a space? JRST CHITX1 ; No, control characer $TEXT (<-1,,.TEMP>,<^7/S1/^0>) ; Yes, normal character $RET ; Return to the caller CHITX1: MOVEI S2,"A"-1(S1) ; Make it a printing character $TEXT (<-1,,.TEMP>,<^^^7/S2/^0>) ; Get the text $RET ; Return to the caller SUBTTL Command execution -- STATUS command ;+ ;.HL1 C$STATUS ;This routine will give some information about the last transfer and ;all transfers that we have done. ;- C$STATUS: $TEXT (,<^M^JTotals since Kermit was started>) $TEXT (,< Characters sent ^D/SND%TOTAL%CHARS##/>) $TEXT (,< Characters received ^D/RCV%TOTAL%CHARS##/>) $TEXT (,< Data characters sent ^D/SND%DATA%CHARS##/>) $TEXT (,< Data characters received ^D/RCV%DATA%CHARS##/>) $TEXT (,< NAKs sent ^D/SND%NAKS##/>) $TEXT (,< NAKs received ^D/RCV%NAKS##/>) $TEXT (,< Total packets sent ^D/SND%COUNT/>) $TEXT (,< Total packets received ^D/RCV%COUNT/>) SKIPN T2,TOTAL%TIME## ; Get the amount of time JRST STAT.0 ; None, so skip this MOVE T1,RCV%DATA%CHARS## ; Get the number of data characters ; received ADD T1,SND%DATA%CHARS## ; Add in to get total data characters ; transfered IMULI T1,^D10 ; Make this 10 times for baud rate ADDI T2,^D500 ; Round up IDIVI T2,^D1000 ; Milliseconds to seconds IDIV T1,T2 ; Compute the baud rate $TEXT (,< Effective data rate: ^D/T1/ baud>) STAT.0: $TEXT (,<^M^JTotals for the last transfer>) $TEXT (,< Characters sent ^D/SMSG%TOTAL%CHARS##/>) $TEXT (,< Characters received ^D/RMSG%TOTAL%CHARS##/>) $TEXT (,< Data characters sent ^D/SMSG%DATA%CHARS##/>) $TEXT (,< Data characters received ^D/RMSG%DATA%CHARS##/>) $TEXT (,< NAKs sent ^D/SMSG%NAKS##/>) $TEXT (,< NAKs received ^D/RMSG%NAKS##/>) SKIPN T2,XFR%TIME## ; Get the time of the last transfer JRST STAT.1 ; Skip it, hasn't happened MOVE T1,RMSG%DATA%CHARS## ; Get the number of data characters ; received CAMGE T1,SMSG%DATA%CHARS## ; Should we use the other? MOVE T1,SMSG%DATA%CHARS## ; Yes, get it IMULI T1,^D10 ; Make this 10 times for baud rate ADDI T2,^D500 ; Round up IDIVI T2,^D1000 ; Milliseconds to seconds IDIV T1,T2 ; Compute the baud rate $TEXT (,< Effective data rate: ^D/T1/ baud>) STAT.1: $TEXT (,<>) $RETT SUBTTL File processing -- INIFILE - Initialization ;+ ;.hl1 INIFIL ;This routine will initialize the file processing for KERMIT. ;.LITERAL ; ; Usage: ; $CALL INIFIL ; (Return) ; ; ;.end literal ;- INIFIL: MOVX S1,D$FTP ; Get the default file type MOVEM S1,FILTYP ; Store it $RETT ; Return to the caller SUBTTL File processing -- FILE%OPEN ;+ ;.HL1 FILE%OPEN (Function) ; This routine will open the file for reading or writing. ;- BLSRTN(FILE%OPEN,) TOPS10< $SAVE ; Save a few registers $SAVE ; Save this too $SAVE ; Save as a flag MOVEI S1,.FDSIZ ; Get the size of the FX block MOVEI S2,FX ; And the address $CALL .ZCHNK ; Clear out the block SETZ P1, ; Flag from FILE%OPEN MOVE S1,[POINT 7,FILE%N##] ; Point to the file name MOVEI S2,FX ; Point to the FX block $CALL PRSFIL ; Parse the file spec MOVE S1,FUNCTION ; Get the function JUMPE S1,OPNREA ; Open for reading? ; Here if we are opening the file for writing. We just make sure that we are ; not overwriting any files if WARN%FLAG is true. SETO S1, ; Flag for output $CALL SETFLP ; Set up FILOP block MOVEI T1,FX ; Point to the scanner block SKIPE USRFIL ; User supply a file specification? MOVEI T1,USRFX ; Yes, point to that block instead MOVEI T2,FLP+.FOIOS ; Point to the open block MOVEI T3,ELB ; Point to the LOOKUP/ENTER block MOVEI T4,PTH ; Point to the path block $CALL .STOPB ; Convert to FILOP block JRST [KERERR () BLSRET RMS32] MOVX S1,FO.PRV ; Use priv's if we have any MOVEM S1,FLP+.FOFNC ; Store it MOVX S1,FIL ; Get the channel STORE S1,FLP+.FOFNC,FO.CHN ; Store the channel MOVX S1,.FOCRE ; Create a new file MOVX S2,BLSTRU ; File warning on or off? CAME S2,WARN%FLAG## ; On? MOVX S1,.FOWRT ; No, just write this file STORE S1,FLP+.FOFNC,FO.FNC ; Store the function MOVEI S1,FLP+.FOIOS ; Point to the argument block DEVSIZ S1, ; Get the buffer size JRST [KERERR() BLSRET RMS32] ; Claim RMS error HLRZ S2,S1 ; Get the number of buffers MOVEI S1,(S1) ; Get the size IMULI S1,(S2) ; Compute the total size MOVEM S1,FBFSIZ ; Store the number of words $CALL M%GMEM ; Allocate the memory JUMPF [KERERR(<^E/S1/>) BLSRET RMS32] MOVEM S2,FBFADR ; Store the buffer address EXCH S2,.JBFF ; Exchange with .JBFF MOVE S1,[XWD .FOMAX-1,FLP] ; Point to the argument block FILOP. S1, ; Do the FILOP. JRST OPNWR0 ; Failed, see why OPNWR3: MOVEM S2,.JBFF ; Restore .JBFF ; Set up byte pointer in buffer header. The monitor will correctly calculate ;the byte count if we do so. MOVX S1, ; Assume ASCII files MOVX S2,$FBS8 ; Is it really 8-bit? CAMN S2,FILTYP ; . . . MOVX S1, ; Yes, use 8 bit HLLM S1,BH+.BFPTR ; Store in the pointer MOVE S1,TY%FIL## ; Get the type file flag TXNN S1,BLSTRU ; Want type out? BLSRET NORMAL ; Give a good return MOVEI S1,[ASCIZ | as |] ; Get the text to type $CALL TYPFIL ; Type the file specification BLSRET NORMAL ; Give a good return ; Here if we have gotten an error. Restore .JBFF and then see if the error ; is allowed (WARN%FLAG and superceeding error) OPNWR0: MOVE T1,S1 ; Copy the error code MOVEM S2,.JBFF ; Store .JBFF back MOVX S2,BLSFAL ; Get the false value CAME S2,WARN%FLAG## ; Can we change the name (to protect the inocent?) JRST OPNWR1 ; Yes, change the name OPNWR2: MOVE S1,FBFSIZ ; Get the size of the buffers MOVE S2,FBFADR ; Get the address $CALL M%RMEM ; Return the memory KERERR (<^T/FILERR##(T1)/>) BLSRET RMS32 ; Failure return ; Here to change the extension of the file to something different. OPNWR1: CAIE T1,ERAEF% ; Already exist error? JRST OPNWR2 ; No, just return the buffers and exit MOVSI S1,() ; Get the initial extension MOVEM S1,ELB+.RBEXT ; Store it MOVE S2,FBFADR ; Get the buffer's address again EXCH S2,.JBFF ; Exchange this OPNWR4: MOVE S1,[XWD .FOMAX-1,FLP] ; Point to the argument block FILOP. S1, ; Do it SKIPA ; Failed JRST OPNWR3 ; Worked this time, just exit now CAIE T1,ERAEF% ; Same problem still? JRST OPNWR0 ; No, something else this time HLRZ S1,ELB+.RBEXT ; Get the extension TXZ S1,<'000'> ; Turn this off TXO S1,707070 ; Turn this on AOJ S1, ; Increment this TXZ S1,707070 ; Reverse it TXO S1,<'000'> ; Make it sixbit again HRLZM S1,ELB+.RBEXT ; Store this back JRST OPNWR4 ; Try again >; End of TOPS10 conditional ; Here if we are reading a stream of files. Call .LKWLD if we are under ; TOPS-10, else TOPS-20 will do the right thing. TOPS10< OPNREA: SETZ S1, ; Clear this $CALL SETFLP ; Set up the FILOP. block MOVEI S1,FX ; Point to the argument block MOVEM S1,WLD+$LKFDB ; Store it MOVX S1,.FOMAX ; Get the length STORE S1,WLD+$LKFLP,LK$FLN ; Store the length MOVEI S1,FLP ; Point to the argument block STORE S1,WLD+$LKFLP,LK$FLP ; Store the address MOVX S1,LK$FRS ; Flag this is the first time SKIPGE P1 ; First time? SETZ S1, ; No, not the first time MOVEM S1,WLD+$LKFLG ; Store in the flag word MOVEI S1,$LKLEN ; Get the length MOVEI S2,WLD ; And the argument block $CALL LOKWLD## ; Look for the file. JUMPF OPNRE0 ; Failed, process error ; Here if we have the a file from the remote MOVEI S1,FIL ; Get the channel number STORE S1,FLP+.FOFNC,FO.CHN ; Store it MOVEI S1,.FORED ; Get the function STORE S1,FLP+.FOFNC,FO.FNC ; Store the function MOVX S1,FO.PRV ; Use privs IORM S1,FLP+.FOFNC ; Light the bit MOVEI S1,FLP+.FOIOS ; Point to the open block DEVSIZ S1, ; Attempt to determine the size JRST [KERERR() BLSRET RMS32] ; Error return HLRZ S2,S1 ; Get the number of buffers MOVEI S1,(S1) ; Get the buffer size IMULI S1,(S2) ; Compute the total size MOVEM S1,FBFSIZ ; Store it $CALL M%GMEM ; Allocate the memory JUMPF [KERERR(<^E/S1/>) ; Output the error BLSRET RMS32] ; Return the failure MOVEM S2,FBFADR ; Store the address EXCH S2,.JBFF ; Exchange with the first free MOVX S1, ; Point to the argument block FILOP. S1, ; Attempt to read the file JRST OPNRE1 ; Failed, try again MOVEM S2,.JBFF ; Store .JBFF back MOVE S1,[POINT 7,FILE%NAME##] ; Point to the file name MOVEM S1,FILPTR ; Store the byte pointer SETOM FILE%SIZE## ; Clear the count $TEXT (FILSTO,<^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^0>) ; Now set up the correct size byte pointers. MOVE S2,FILTYP ; Get the file type CAXE S2,$FBAUT ; Automatic? JRST OPNRE2 ; No, use what was set LOAD S1,ELB+.RBPRV,RB.MOD ; Get the mode the file was written in CAXE S1,.IOIMG ; Image? CAXN S1,.IOIBN ; Or image binary? MOVX S2,$FBS8 ; Yes, 8-bit CAXE S1,.IOBIN ; Binary? CAXN S1,.IODPR ; Or dump record? MOVX S2,$FBS8 ; Yes, 8-bit OPNRE2: MOVEM S2,CURFTP ; Save the file type for this file MOVX S1, ; Assume ASCII files CAXN S2,$FBS8 ; Is it ASCII? MOVX S1, ; No, use 8 bit HLLM S1,BH+.BFPTR ; Store in the pointer $CALL T$LOCAL ; Check if local JUMPT [BLSRET NORMAL] ; If no terminal, just return MOVE S1,TY%FIL## ; Get the type file flag TXNN S1,BLSTRU ; Want type out? BLSRET NORMAL ; Give a good return MOVEI S1,[ASCIZ ||] ; Get the text $CALL TYPFIL ; Type the file specification $TEXT (,< as ^A>) ; Say what we send it out as BLSRET NORMAL ; Give a good return ; Here if there were no files OPNRE0: JUMPN P1,[BLSRET NOMORFILES] ; Flag no more and return KERERR () BLSRET RMS32 ; Give a failure ; Here if the FILOP. failed. OPNRE1: PUSH P,S1 ; Save the error code MOVE S1,FBFSIZ ; Get the size of the buffers MOVE S2,FBFADR ; Get the address of them $CALL M%RMEM ; Return the memory POP P,S1 ; Restore S1 KERERR (<^T/FILERR##(S1)/ - ^F/FX/>) BLSRET RMS32 ; Give the failure return >; End of TOPS10 conditional SUBTTL Routine to type the file specification ;+ ;.hl1 TYPFIL ;This routine will type the file specification that we are processing ;on the user's terminal. It will output the text passed to this routine ;first. Type out will only happen if we are using a different terminal ;line other than the controlling terminal. ;.literal ; ; Usage: ; MOVEI S1,[ASCIZ |Text|] ; $CALL TYPFIL ; (Return) ; ;.end literal ;- TYPFIL: $SAVE ; Save a registers MOVE P1,S1 ; Copy the text $CALL T$LOCAL ; Are we connected to a different line? $RETIT ; If nowhere to type, just return $TEXT (,<^T/(P1)/^W/FLP+.FODEV/:^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^A>) SKIPN FPTH+.PTPPN ; Is there a PPN? JRST TYPF.0 ; No, finish up and return $TEXT (,<[^O/FPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>) MOVSI S1,-5 ; Get the number of SFDs possible TYPF.2: SKIPN FPTH+.PTSFD(S1) ; Finished? JRST TYPF.1 ; Yes, close off $TEXT (,<,^W/FPTH+.PTSFD(S1)/^A>) ; Type the SFD AOBJN S1,TYPF.2 ; Loop for all SFDs TYPF.1: $TEXT (,<]^A>) ; Type the closing bracket SKIPA TYPF.0: $RETT ; Return to the caller SUBTTL Routine to setup FILOP/ELB/PATH blocks ;+ ;.HL1 SETFLP ;This routine will clear and initialize the FILOP. block. ;.literal ; ; Usage: ; S1/ -1 for output, 0 for input ; $CALL SETFLP ; (Return) ; ;.end literal ;- TOPS10< SETFLP: $SAVE ; Save the flag MOVE P1,S1 ; Copy the flag MOVEI S1,.FOMAX ; Get the length MOVEI S2,FLP ; Get the address $CALL .ZCHNK ; Clear the block MOVEI S1,.PTMAX ; Get the length MOVEI S2,PTH ; Get the address $CALL .ZCHNK ; Clear the block MOVEI S1,.RBMAX ; Get the length MOVEI S2,ELB ; Get the address $CALL .ZCHNK ; Clear the block MOVX S1,.RBMAX ; Get the length MOVEM S1,ELB+.RBCNT ; Store it MOVEI S1,PTH ; Get the PATH block address MOVEM S1,ELB+.RBPPN ; Store it MOVEI S1,ELB ; Point to the LOOKUP/ENTER block MOVEM S1,FLP+.FOLEB ; Store it MOVE S1,[XWD .PTMAX,FPTH] ; Get the file found in path block MOVEM S1,FLP+.FOPAT ; Store it for later MOVEI S1,BH ; Get the buffer header address SKIPGE P1 ; Output? MOVSS S1 ; Yes, move to the other half MOVEM S1,FLP+.FOBRH ; Store the buffer header SKIPL P1 ; Input? HLLOS FLP+.FONBF ; Yes, set default number of buffers SKIPGE P1 ; Output? HRROS FLP+.FONBF ; Yes, set the other way MOVE S1,FILTYP ; Get the file type CAXE S1,$FBS8 ; 8-bit? IFE .IOASC, ; No, use ascii IFN .IOASC, ; No, use ascii MOVX S1,.IOBIN ; Get the mode MOVEM S1,FLP+.FOIOS ; Store the status $RET ; Return to the caller >; End of TOPS10 conditional SUBTTL ROUTINE TO CONVERT SCAN BLOCKS ;.STOPB -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS ; WILD-CARDS ARE ILLEGAL ;CALL: MOVEI T1,SCAN BLOCK ; LH(T1)=LENGTH IF .GT. 24 ; MOVEI T2,OPEN BLOCK (3 WORDS) ; MOVEI T3,LOOKUP BLOCK (6 WORDS OR MORE) ; LH(T3)=LENGTH IF .GT. 6 ; MOVEI T4,PATH BLOCK (9 WORDS) ; PUSHJ P,.STOPB ;ERROR RETURN IF WILD-CARDS ;SKIP RETURN IF SETUP OK ;USES T1-4 TOPS10< .STOPB: $SAVE ; Save a few registers SKIPN P3,.FDSTR(T1) ;GET DEVICE MOVSI P3,'DSK' ;DEFAULT IF BLANK MOVEM P3,1(T2) ;STORE IN OPEN BLOCK MOVE P1,.FDMOD(T1) ;GET SWITCHES SETZM (T2) ; Clear the first word SKIPE P3,.FDNAM(T1) ;IF NAME NOT BLANK, SETCM P3,.FDNMM(T1) ;GET NAME MASK JUMPN P3,.POPJ## ;ERROR IF WILD MOVE P3,.FDNAM(T1) ;GET NAME MOVEM P3,.RBNAM(T3) ;STORE IN LOOKUP BLOCK SKIPN P3,.FXEXT(T1) ;GET EXTENSION JRST STOP.0 ; Ok, skip this AND P3,.FDEXM(T1) ; AND with the mask CAME P3,.FDEXT(T1) ; Still the same POPJ P, ; No, fail STOP.0: MOVEM P3,.RBEXT(T3) ;STORE IN LOOKUP BLOCK MOVEI P3,0 ;CLEAR DIRECTORY MOVX P1,FD.DIR ;GET DIRECTORY BIT TDNN P1,.FDMOD(T1) ;SEE IF SET JRST STOPND ;NO--USE [-] SETCM P3,.FDDIM(T1) ;GET UFD MASK JUMPN P3,.POPJ## ;ERROR IF WILD MOVE P3,.FDPPN(T1) ;GET UFD TLNN P3,-1 ;SEE IF PROJECT HLL P3,.MYPPN ;NO--USE LOGGED IN NUMBER TRNN P3,-1 ;SEE IF PROGRAMMER HRR P3,.MYPPN ;NO--USE LOGGED IN NUMBER MOVEM P3,.FDPPN(T1) ;STORE FOR ERROR MESSAGES SKIPN .FDPAT(T1) ;SEE IF SFDS JRST STOPND ;NO--GO STORE AND RETURN SETZM (T4) ;CLEAR PATH HRLZI P1,(T4) ; .. HRRI P1,1(T4) ; .. BLT P1,.PTMAX-1(T4) ; .. MOVEM P3,.PTPPN(T4) ;STORE UFD MOVEI P1,.FDPAT(T1) ;POINT TO ARGUMENT SFD MOVSI P2,-D$MSFD+1 ;COUNT SFDS HRRI P2,(T4) ;INDICATE START OF SFD BLOCK STOPNS: SKIPN P3,(P1) ;SEE IF DONE JRST STOPNT ;YES--FINISH UP MOVEM P3,.PTPPN+1(P2) ;NO--STORE IN PATH SETCM P3,.FDD2M(P1) ;GET MASK JUMPN P3,.POPJ## ;ERROR IF WILD AOJ P1, ; Advane to the next AOBJN P2,STOPNS ;LOOP UNTIL DONE STOPNT: MOVEI P3,(T4) ;INDICATE SFD STOPND: MOVEM P3,.RBPPN(T3) ;SET INTO LOOKUP JRST .POPJ1## ;SKIP RETURN >; End of TOPS10 conditional SUBTTL File processing -- FILE%CLOSE ;+ ;.hl1 FILE%CLOSE ;This routine will close the file that is currently open. ;- BLSRTN(FILE%CLOSE,) $SAVE ; Save a few registers MOVE S2,ABTFLG ; Get the abort flag MOVEI S1,FIL ; Get the channel TXNN S2,BLSTRU ; Want to punt file? JRST FILCL2 ; No, go close it RESDV. S1, ; Kill the channel JFCL ; Ignore error JRST FILCL3 ; Go return buffer space ; Here if we want to close the file normally FILCL2: RELEASE FIL, ; Release the file channel (OK if already RESDV.'ed) FILCL3: MOVE S1,FBFSIZ ; Get the size of the buffers MOVE S2,FBFADR ; Get the address of them $CALL M%RMEM ; Return the memory to the OTS BLSRET NORMAL ; Give a good return SUBTTL File processing -- NEXT%FILE ;+ ;.hl1 NEXT%FILE ;This routine will advance to the wild card file. ;- BLSRTN(NEXT%FILE) $SAVE ; Save some registers $SAVE ; That will be used $SAVE ; Save the flag SETO P1, ; Flag from here PJRST OPNREA ; Open attempting to read the next file SUBTTL File processing -- GET%FILE - Get a byte ;+ ;.hl1 GET%FILE(Character) ;This routine will input a character from the file. It will then store ;the character in the address that is passed to it. ;.literal ; ; Usage: ; GET%FILE (Character); ; ;.end literal ;- BLSRTN(GET%FILE,) TOPS10< GETFI2: SOSGE BH+.BFCNT ; Decrement the count JRST GETFI0 ; Need a new buffer ILDB S1,BH+.BFPTR ; Get a character MOVEM S1,@CHARACTER ; Store the character MOVE S1,CURFTP ; Get the file type CAXN S1,$FBS8 ; Is this seven bit? BLSRET NORMAL ; Give a good return MOVE S1,BH+.BFPTR ; Get the buffer pointer TXNE S1, ; Is this the end? BLSRET NORMAL ; No, just return MOVE S1,@BH+.BFPTR ; Get the full work TRNN S1,1 ; LSA bit on? BLSRET NORMAL ; No, just return MOVX S1,200 ; Turn on the high order bit IORM S1,@CHARACTER ; . . . BLSRET NORMAL ; And return to the caller ; Here to get a new buffer GETFI0: IN FIL, ; Get the next buffer JRST GETFI2 ; Loop GETSTS FIL,S1 ; Get the status TXNN S1,IO.EOF ; End of file? JRST GETFI1 ; No, an error BLSRET EOF ; Yes, return end of file GETFI1: KERERR () BLSRET RMS32 ; Close enough >; End of TOPS10 conditional SUBTTL File processing -- PUT%FILE - Store a byte ;+ ;.hl1 PUT%FILE(Character) ;This routine will store a character into the file. It will then ;return to the caller. ;.literal ; ; Usage: ; PUT%FILE(Character); ; ;.end literal ;- BLSRTN(PUT%FILE,) $SAVE ; Save a register TOPS10< PUTFI1: SOSGE BH+.BFCNT ; Decrement the count JRST PUTFI0 ; Need to dump the buffer MOVE S1,CHARACTER ; Get the character IDPB S1,BH+.BFPTR ; Store the character MOVE S2,FILTYP ; Get the file type CAXE S2,$FBS8 ; 8 bit? TRNN S1,200 ; No, is the high order bit on? BLSRET NORMAL ; No, Give a good return MOVX S2, ; Is this word aligned? TDNE S2,BH+.BFPTR ; . . . BLSRET NORMAL ; No, just return MOVEI S1,1 ; Yes, light the LSA bit IORM S1,@BH+.BFPTR ; in the output BLSRET NORMAL ; Just return ; Here to dump the buffer into the file. PUTFI0: OUT FIL, ; Dump the buffer JRST PUTFI1 ; Adjust the buffer header GETSTS FIL,S1 ; Get the status, it failed KERERR () BLSRET RMS32 ; Close enough SUBTTL File processing -- FILE%DUMP - Not needed ;+ ;.hl1 FILE%DUMP ;This routine is a dummy routine to handle the end of message processing ;that a record oriented file system must have (ie RMS-32). ;.literal ; ; Usage: ; FILE%DUMP(); ; ;.END LITERAL ;- BLSRTN(FILE%DUMP,<>) BLSRET NORMAL ; Return normal to the caller SUBTTL Support routines -- PRSFIL - Parse a file specification ;+ ;.hl1 PRSFIL ;This routine will parse a file specification. Is assumes that the file ;specification is in the following format: ;.literal ; ; Device:File.Extension[Path] ; ;.en literal ;This routine will accept wild cards in the file names, extensions and the ;path specification. ;.literal ; ; Usage: ; S1/ Byte pointer to the string ; S2/ Address to store the information in ; $CALL PRSFIL ; (Return) ; ; On a true return: ; - The file specification parsed correctly ; ; On a false return: ; - Invalid file specification ; ;.end literal ;- TOPS10< PRSFIL: $SAVE ; Save two registers DMOVE P1,S1 ; Copy the arguments MOVX T1,.FDNAT ; Get the type STORE T1,.FDLEN(P2),FD.TYP ; Store this MOVX T1,.FDSIZ ; Get the size STORE T1,.FDLEN(P2),FD.LEN ; Store this too $CALL PRSWS$ ; Parse a sixbit item (with wilds) CAIE S1,":" ; Device delimiter? JRST [MOVX T3, ; Use disk MOVEM T3,.FDSTR(P2) ; Store it JRST PRSF.5] ; Continue processing MOVEM T1,.FDSTR(P2) ; Store the device name PRSF.1: $CALL PRSWS$ ; Input the file name PRSF.5: CAIE S1,.CHLAB ; Start of directory? CAIN S1,"[" ; Normal start of directory? JUMPE T1,PRSF.4 ; Yes, go handle it if nothing before it MOVEM T1,.FDNAM(P2) ; Store the name MOVEM T2,.FDNMM(P2) ; And the mask JUMPE S1,.RETT ; End of the spec? CAIN S1,"[" ; Is this a path? JRST PRSF.4 ; Yes, go get it CAIE S1,"." ; Correct delimiter? JRST PRSF.6 ; No, check for semi-colon (Files-11) $CALL PRSWS$ ; No, get the extension ANDX T1,LHMASK ; Keep only three characters MOVEM T1,.FDEXT(P2) ; Store the extension MOVEM T2,.FDEXM(P2) ; Store the mask also JUMPE S1,.RETT ; End of the spec? CAIE S1,.CHLAB ; Also allow angle brackets (in case of dumb terminal) CAIN S1,"[" ; Start of the path? JRST PRSDIR ; Yes, go handle it CAIE S1,"." ; Have another dot (TOPS-20) PRSF.6: CAIN S1,";" ; Or semi-colon (Files-11)? $RETT ; Yes, return $RETF ; No, bad file spec ; Here if we have a directory before the file name PRSF.4: PUSHJ P,PRSDIR ; Get the directory $RETIF ; If bad, just give up now JUMPE S1,.RETT ; If all done, just return JRST PRSF.1 ; Otherwise, try again for file name ; Here to parse the path specification. ; The open bracket has already been read PRSDIR: MOVX S2,FD.DIR ; Get the directory specified bit TDNE S2,.FDMOM(P2) ; Directory given yet? TDNN S2,.FDMOD(P2) ; . . . JRST .+2 ; No, all is fine $RETF ; Yes, punt IORM S2,.FDMOD(P2) ; Flag it IORM S2,.FDMOM(P2) ; . . . $CALL PRSOC$ ; Input the programmer number TXNE T1,LHMASK ; Anything in the left half? JRST PRSD.1 ; See if "[-]" HRLM T1,.FDPPN(P2) ; Store the directory HRLM T2,.FDDIM(P2) ; Store the mask too CAIE S1,"," ; Good delimiter? $RETF ; No, bad file spec $CALL PRSOC$ ; Get the programmer number TXNE T1,LHMASK ; Is it valid? $RETF ; No, very bad HRRM T1,.FDPPN(P2) ; Store the programmer number HRRM T2,.FDDIM(P2) ; And the mask JUMPE S1,.RETT ; If nothing else, just return CAIE S1,.CHRAB ; Allow angle bracket end CAIN S1,"]" ; Valid end? $RETT ; Yes, all done with directory CAIE S1,"," ; SFDs coming? $RETF ; No, Give a failure return ; Here to loop for all the Sub file directories $SAVE ; Save the pointer here HRLI P2,-5 ; Make the AOBJN pointer ADDI P2,.FDPAT ; Point to the first SFD PRSD.2: $CALL PRSWS$ ; Parse the SFD name MOVEM T1,(P2) ; Store the SFD name MOVEM T2,.FDD2M(P2) ; Store the mask also CAIE S1,"," ; Delimited by a comma? JRST PRSD.3 ; No, Try for other items ADDI P2,1 ; Point down one more AOBJN P2,PRSD.2 ; Loop for all items $RETF ; Too many SFDs ; Here to check for default directory given by the user. PRSD.1: CAIE S1,"-" ; Use default? $RETF ; No, error MOVX S2,FD.DFX ; Use default IORM S2,.FDMOD(P2) ; Light it IORM S2,.FDMOD(P2) ; . . . $CALL INPCH$ ; Get the next character PRSD.3: JUMPE S1,.RETT ; If finished, just return CAIE S1,"]" ; Valid end? CAIN S1,.CHRAB ; . . . $RETT ; Give a good return $RETF ; No, Give a failure return >; End of TOPS10 conditional SUBTTL Support routines -- PRSSX$ - Parse a sixbit field ;+ ;.hl1 PRSSX$ ;This routine will arse a non:wild sixbit field. It will return the value ;in T1. ;.literal ; ; Usage: ; P1/ Byte pointer ; $CALL PRSSX$ ; (Return) ; ; On return: ; S1/ Delimiter character ; T1/ Sixbit token ; ;.end literal ;- TOPS10< PRSSX$: SETZ T1, ; Clear the destination MOVE S2,[POINT 6,T1] ; Gget the byte pointer PRSS.0: $CALL INPCH$ ; Input a character $CALL CHKAL$ ; Check to see if alphanumeric $RETIF ; Return if it is not SUBI S1,"A"-'A' ; Convert to sixbit TRNN T1,77 ; Finished? IDPB S1,S2 ; No, Store the character JRST PRSS.0 ; Loop for more >; End of TOPS10 conditional SUBTTL Support routines -- PRSWS$ - Parse a wild sixbit field ;+ ;.hl1 PRSWS$ ;This routine will parse a wild sixbit field. It will only accept ;the following types of wild cards: ;.literal ; * - All wild ; xxx* - Remainder of the field wild ; XXX??? - Same as above ; XXX%%% - Same as above ; XXX%XX - Single wild character ; XXX?XX - Same as above ; ; Usage: ; P1/ Byte pointer to the string to parse ; $CALL PRSWS$ ; (Return) ; ; On return: ; S1/ Delimiter character ; T1/ Sixbit token ; T2/ Mask for the item ; ;.end literal ;- TOPS10< PRSWS$: SETZ T1, ; Clear where we are storing them SETO T2, ; Assume not wild MOVE T3,[POINT 6,T1] ; Byte pointer to the name MOVE T4,[POINT 6,T2] ; And to the mask PRSW.0: $CALL INPCH$ ; Input the first character $CALL CHKAL$ ; Check to see if alphanumeric JUMPF PRSW.1 ; See if a wild card MOVX S2,-1 ; Get the mask to store PRSW.3: SUBI S1,"A"-'A' ; Convert to sixbit TRNE T1,77 ; Finished? JRST PRSW.0 ; Yes, loop eating characters IDPB S1,T3 ; Store the character IDPB S2,T4 ; Store the mask JRST PRSW.0 ; Loop back for more characters ; Here if the character is not an alphanumeric. Check for single character ; wild cards and the remainder of the word wildcards PRSW.1: CAIE S1,"?" ; Is it valid single character CAIN S1,"%" ; wild card? SKIPA ; Yes, Keep going JRST PRSW.2 ; No, Try for full word SETZ S2, ; Clear the mask JRST PRSW.3 ; Store the byte ; Here if we are to check to see if the remainder of thw word is to be wild PRSW.2: CAIE S1,"*" ; Remainder wild? JRST PRSW.5 ; Go skip bad characters MOVEI S1,'*' ; Make it a sixbit * TXNE T3,BP.POS ; Filled? IDPB S1,T3 ; No, Store the wild character SETZ S1, ; Clear the character TXNE T4,BP.POS ; Done? PRSW.4: IDPB S1,T4 ; No, clear the mask character TXNE T4,BP.POS ; Done yet? JRST PRSW.4 ; No, keep clearing things $CALL INPCH$ ; Get the next character ; And eat any extra characters ; Here for a character which is not a valid part of a sixbit thing. ;We will skip any characters which are not break characters for some field ;of the filename. PRSW.5: JUMPE S1,.RETT ; If null, all done CAIE S1,"[" ; Open bracket? CAIN S1,"]" ; Or close? $RETT ; Yes, just return CAIE S1,"." ; Start of extension? CAIN S1,"," ; Or directory element delimeter? $RETT ; Yes, good break character CAIN S1,":" ; End of device name? $RETT ; Yes, return now JRST PRSW.0 ; And try again >; End of TOPS10 conditional SUBTTL Support routines -- CHKAL$ - Check for alphanumeric ;+ ;.hl1 CHKAL$ ;This routine will check to see if the character specified is an alphanumeric ;character. ;.literal ; ; Usage: ; S1/ Character to check ; $CALL CHKAL$ ; (Return) ; ; On a true return: ; S1/ Upper case A to Z or 0 to 9. ; ; On a false return: ; S1/ Non-alphanumeric character ; ;.end literal ;- TOPS10< CHKAL$: CAIL S1,"0" ; Numeric? CAILE S1,"9" ; . . . SKIPA ; No, Continue $RETT ; Yes, Give a true return CAIL S1,"A" ; Upper case? CAILE S1,"Z" ; . . . SKIPA ; No, Continue $RETT ; Yes, Give a good return CAIL S1,"a" ; Lower case? CAILE S1,"z" ; . . . $RETF ; No, Give a failure return MOVEI S1,"A"-"a"(S1) ; Convert to upper case $RETT ; Give a good return >; End of TOPS10 conditional SUBTTL Support routines -- PRSOC$ - Parse a wild octal number ;+ ;.hl1 PRSOC$ ;This routine will parse a wild octal number. It will accept either ;question mark (?) or percent sign (%) as the single wild card characters. ;.literal ; ; Usage: ; P1/ Byte pointer ; $CALL PRSOC$ ; (Return) ; ; On return: ; T1/ Number (Right half only) ; T2/ Mask ; ;.end literal ;- TOPS10< PRSOC$: SETZB T1,T2 ; Clear the number and the mask $CALL INPCH$ ; Get the first character CAIN S1,"*" ; Full wild-card? $RETT ; Yes, all done SOJA T2,PRSO.3 ; No, go check other possibilities PRSO.0: $CALL INPCH$ ; Get a character PRSO.3: CAIL S1,"0" ; Within range? CAILE S1,"7" ; . . . JRST PRSO.1 ; No, check for wilds MOVX S2,7 ; Flag not wild PRSO.2: LSH T1,3 ; Move this over a digit LSH T2,3 ; And the mask ADDI T1,-"0"(S1) ; Fill in this character TDO T2,S2 ; Get the mask item JRST PRSO.0 ; Loop for all the digits PRSO.1: CAIE S1,"?" ; Question mark? CAIN S1,"%" ; Or a percent? SKIPA ; Yes, Continue $RETT ; No, Return to the user SETZ S2, ; Clear the mask item MOVEI S1,"0" ; Use a zero JRST PRSO.2 ; Loop all digits >; End of TOPS10 conditional SUBTTL Support routines -- INPCH$ - Input a character ;+ ;.hl1 INPCH$ ;This routine will input a single character. It will cause any extranous ;bits to be remoted. It will return the character in S1. ;.literal ; ; Usage: ; P1/ Byte pointer ; $CALL INPCH$ ; (Return) ; ; On a true return: ; S1/ Character input ; ; On a false return: ; S1/ Null ; ;.end literal ;- TOPS10< INPCH$: ILDB S1,P1 ; Get a character ANDX S1,177 ; Clear the junk JUMPE S1,.RETF ; Return if this is zero $RETT ; Give a good return >; End of TOPS10 conditional SUBTTL Packet count processing -- XFR%STATUS ;+ ;.hl1 XFR%STATUS ;This routine will handle the status that must be displayed on the user ;terminal for the udpated counts of the packets and NAKs. ;.LITERAL ; ; Usage: ; XFR_STATUS (Type, Sub-type); ; ;.end literal ;.ls ;.LE;Type - "S" or "R" for either Send or Receive. ;.LE;Sub-type - "P" or "N" for either packet or NAK. ;.els ;- BLSRTN(XFR%STATUS,) $SAVE ; Save a few registers $SAVE ; . . . $CALL T$LOCAL ; Is this a local terminal? $RETIT ; No, just skip this MOVE TF,TY%PKT## ; Want to type the packet information? TXNN TF,BLSTRU ; Want type out? $RETT ; No, all done MOVE T1,SUBTYPE ; Get the sub type MOVEI S1,0 ; Assume send packet CAIN T1,"N" ; Is this a NAK? MOVEI S1,1 ; Yes, use NAK offset MOVE T1,TYPE ; Get the type now CAIN T1,"R" ; Is this receive MOVEI S1,2(S1) ; Yes, add in the other offset $TEXT (,< ^T/PKTTXT(S1)/^D/@PKTCNT(S1)/^A>) $RET ; Just return to the caller DEFINE PKTITM,< PKT S,SND%COUNT## PKT SN,SMSG%NAK## PKT R,RCV%COUNT## PKT RN,RMSG%NAK## >; End of PKTITM DEFINE PKT(A,B) PKTTXT: PKTITM DEFINE PKT(A,B) PKTCNT: PKTITM SUBTTL Terminal processing -- Message routines -- Initialization ;+ ;.hl1 INITRM ;This routine will initialize the terminal processing. It will get the ;line number for the command terminal. ;.literal ; ; Usage: ; $CALL INITRM ; (Return) ; ; ; On a true return: ; - Terminal line number set up ; ;.end literal ;- INITRM: MOVX S2,JI.TNO ; Get terminal number SETO S1, ; for this job $CALL I%JINF ; Get it TOPS20< MOVEM S2,XFRTRM+$TTLIN ; Store the line to use MOVEM S2,MYTERM+$TTLIN ; Store here also >; End of TOPS20 conditional TOPS10< PUSH P,S2 ; Save this $TEXT (<-1,,.TEMP>,) ; Get the text HRROI S1,.TEMP ; Point to the location $CALL S%SIXB ; Convert to sixbit MOVEM S2,MYTERM+$TTDEV ; Store here MOVEM S2,XFRTRM+$TTDEV ; And also here POP P,S2 ; Restore S2 ADDI S2,.UXTRM ; Convert to a UDX GTNTN. S2, ; Get the node and line number SUBI S2,.UXTRM ; Can only fail because no network support HRRZM S2,XFRTRM+$TTLIN ; Store the line number HLRZM S2,XFRTRM+$TTNOD ; Store the node number HRRZM S2,MYTERM+$TTLIN ; Store the line number HLRZM S2,MYTERM+$TTNOD ; Store the node number MOVX S1,%CNTIC ; Get the number of jiffies per second GETTAB S1, ; From the monitor MOVX S1,^D60 ; Assume 60 MOVEM S1,JIFSEC ; Store for later use >; End of TOPS10 conditional SETZM LCLECH ; Default is no local echo $RETT ; Return to the caller SUBTTL Terminal processing -- Message routines -- Open the terminal ;+ ;.hl1 OPNTRM ;This routine will open the terminal that has been sepecified or the ;the command terminal if none has been specified. ;.literal ; ; Usage: ; $CALL OPNTRM ; (Return) ; ; On a true return: ; - Terminal open ; ; On a false return: ; - Terminal not open, error message issued. ; ;.end literal ;- OPNTRM: TOPS10< $SAVE ; Save P1 MOVEI P1,XFRTRM ; Point to the transfer terminal info CLOSE TTY, ; Just close incase it was open ; (KLUDGE, since we can not get the ; terminal number GLXLIB is using ; and we should process commands after ; a send/receive) MOVE S1,P1 ; Get the address $CALL T$OPEN ; Open the terminal $RETIF ; Return if that failed MOVE S1,RCV%EOL## ; Get the end of line character MOVE S2,S1 ; Get a copy LSH S2,^D9 ; Up nine bits TRO S1,^O200(S2) ; Break even if parity on MOVE S2,P1 ; Get the address of the control block $CALL T$SBRK ; Set the break set MOVX T1,BLSTRU ; Assume it is MOVE S1,$TTLIN(P1) ; Get this terminal line number MOVE S2,$TTNOD(P1) ; Get the node number CAMN S1,MYTERM+$TTLIN ; Is this the same? CAME S2,MYTERM+$TTNOD ; . . . MOVX T1,BLSFAL ; No, false MOVEM T1,CONNECT%FLAG## ; Store the flag ; Now clear the terminal input buffer. This will allow us to dump any NAKs ; that were sent by the remote server into the bit bucket and not confuse ; the protocol. MOVX T1,.TOCIB ; Clear the input buffer MOVE T2,$TTUDX(P1) ; Get the UDX MOVX S1,[XWD 2,T1] ; Point to the argument TRMOP. S1, ; Clear the input buffer JFCL ; Don't care $RETT ; Give a good return ; Here to reset the terminal for commands (KLUDGE for GLXLIB) OCTERM: MOVX T1,IO.SYN!.IOASC!IO.SUP ; Get the mode MOVE T2,$TTDEV+MYTERM ; Get my terminal name SETZ T3, ; Clear this OPEN TTY,T1 ; Open the terminal JFCL ; Don't care $RETT ; Give a good return >; End of TOPS10 conditional SUBTTL Terminal processing -- Message routines -- Close the terminal ;+ ;.hl1 CLSTRM ;This routine will close the terminal that has been opened by OPNTRM. ;.literal ; ; Usage: ; $CALL CLSTRM ; (Return) ; ;.end literal ;- CLSTRM: MOVEI S1,XFRTRM ; Point to the transfer terminal info $CALL T$CLOS ; Close the terminal MOVX S1,BLSFAL ; Get the false value EXCH S1,CONNECT%FLAG## ; Store it TOPS10< CAIN S1,BLSTRU ; Was it true? $CALL OCTERM ; Open the command terminal again >; End of TOPS10 conditional $RETT ; Return to the caller SUBTTL Terminal processing -- Message routines -- Send a message ;+ ;.hl1 SEND ;This routine will send a message to the remote Kermit. It is called with ;the address of the message and the length of it. ;.literal ; ; Usage: ; SEND(Address, Length); ; ;.end literal ;- BLSRTN(SEND,) $SAVE ; Save some registers MOVE T1,MSGADR ; Get the address of the message HRLI T1,(POINT 8) ; Point to it MOVE T2,MSGLEN ; Get a copy of the message length SEND0: SOJL T2,SEND1 ; Finished? ILDB S1,T1 ; No, get a character XMOVEI S2,XFRTRM ; Point to the information block $CALL T$COUT ; Output the character JUMPT SEND0 ; True return, try for the next character SEND2: MOVE S2,$TTIOS+XFRTRM ; Get the status TXNE S2,IO.ERR ; Any errors? JRST SEND4 ; Yes, handle it SETZ S2, ; Clear this HIBER S2, ; Wait until done JFCL ; Don't care JRST SEND2 ; Try again SEND1: XMOVEI S2,XFRTRM ; Point to the block $CALL T$DMPO ; Dump the character output buffer JUMPT [BLSRET NORMAL] ; Give a good return MOVE S2,$TTIOS+XFRTRM ; Get the IO status TXNN S2,IO.ERR ; Any errors? JRST [SETZ S2, ; No, just sleep a little HIBER S2, ; . . . JFCL ; Don't care about errors JRST SEND1] ; Try again ; Here if there was an error SEND4: KERERR () BLSRET SNDERR ; Return the error SUBTTL Terminal processing -- Message routines -- Wait for turnaround ;+ ;.hl1 IBM%WAIT ; This routine will wait for the turnaround character from the line. ;.literal ; ; Usage: ; STATUS = IBM_WAIT(); ; ;.end literal ;- BLSRTN(IBM%WAIT) $SAVE ; Save the temps IBMW.0: XMOVEI S2,XFRTRM ; Point to the argument block $CALL T$CIN ; Attempt to read a character JUMPT IBMW.1 ; If we got a character, check it out $CALL RECEIE ; Check out possible error TXNN S1,BLSTRU ; Still ok? JRST [CAXN S1,TIMEOUT ; No, time out? MOVX S1,NORMAL ; Yes, pretend all ok $RET] ; And return IBMW.1: ANDX S1,177 ; Strip parity bit CAME S1,IBM%CHAR## ; This the turnaround character? JRST IBMW.0 ; No, try again BLSRET NORMAL ; Give good return SUBTTL Terminal processing -- Message routines -- Receive a message ;+ ;.hl1 RECEIVE ;This routine will receive a message from the remote Kermit. This routine ;will time out if the message is not received in the correct number of ;seconds. ;.literal ; ; Usage: ; RECEIVE(Address, Length); ; ;.end literal ;- BLSRTN(RECEIVE,) $SAVE $SAVE ; Save a few registers SETZM @MSGLEN ; Clear the count of characters MOVE T1,MSGADR ; Get the address to store into HRLI T1,(POINT 8) ; Build a byte pointer to it TOPS10< $CALL SETTMR ; Set the timer RECEI0: XMOVEI S2,XFRTRM ; Point to the argument block $CALL T$CIN ; Attempt to read a character JUMPF [$CALL RECEIE ; Check out error TXNN S1,BLSTRU ; Some type of error? $RET ; Yes, give up JRST RECEI0] ; No, just nothing there, try again ANDI S1,^O177 ; Strip parity bit (if still there) MOVE S2,S1 ; Get a copy of the character CAMN S2,RCV%SOH## ; Start of header character? JRST RECEI1 ; Yes, go store it CAIN S2,.CHCNC ; Control-C? BLSRET ABORTED ; Yes, abort JRST RECEI0 ; Not a character we are interested in, ; ignore it RECEI1: IDPB S1,T1 ; Store the character AOS S1,@MSGLEN ; Increment the count CAIL S1,MAX%MSG## ; Fill entire buffer? JRST RECEIN ; Yes, give good return CAIN S2,.CHCNC ; Control-C? BLSRET ABORTED ; Yes, finished CAME S2,RCV%EOL ; End of line character? JRST RECEI2 ; No, get another character ; Here to give "normal" return RECEIN: $CALL CHKKBD ; Check for keyboard input first BLSRET NORMAL ; Then return normal RECEI2: XMOVEI S2,XFRTRM ; Point to the argument block $CALL T$CIN ; Attempt to read a character JUMPF [$CALL RECEIE ; Check out error TXNN S1,BLSTRU ; Some type of error? $RET ; Yes, give up JRST RECEI2] ; No, just nothing there, try again ; Check what type of parity being used. If other than none, we ;must strip the parity bits off of everything. MOVE S2,PARITY%TYPE## ; Get the type CAIE S2,PR%NONE## ; No parity? ANDI S1,^O177 ; No, strip parity bit MOVE S2,S1 ; Get copy of character ANDI S2,^O177 ; Strip parity bit CAME S2,RCV%SOH## ; Start of header again? JRST RECEI1 ; No, go store character ; Here if we got a second start of header. Restart the message RECEI3: SETZM @MSGLEN ; Clear the length MOVE T1,MSGADR ; Get the address to store into HRLI T1,(POINT 8) ; Build a byte pointer to it JRST RECEI1 ; Go store the SOH ; Here if there are not more characters in the input buffer RECEIE: MOVE S1,XFRTRM+$TTIOS ; Get the IO status TXNN S1,IO.ERR ; Any errors? JRST RECEIT ; No, ASYNC blocking KERERR () BLSRET RECERR ; Return the value ; Here if we are waiting for the input. TOPS-10 timer processing RECEIT: $CALL CHKKBD ; Check for keyboard input SKIPN RCV%TIMEOUT## ; Any timeout? JUMPT [BLSRET TIMEOUT] ; No, pretend we just timed out MOVX T3,%CNSUP ; Get the system uptime GETTAB T3, ; . . . . JFCL ; Failed? CAML T3,TIMLIM ; Output of time? BLSRET TIMEOUT ; Yes, time out SUB T3,TIMLIM ; Get the amount to hibernate IMULX T3,-^D1000 ; Convert to milliseconds IDIV T3,JIFSEC ; . . . CAXLE T3,^D1000 ; Never wait more than a second MOVX T3,^D1000 ; (in case monitor screws up) TXO T3,HB.RIO!HB.RTC!HB.RWJ ; Wake when I/O done HIBER T3, ; Go away JFCL ; Don't care BLSRET NORMAL ; Return OK SUBTTL Terminal processing -- Message routines -- Check for keyboard input ;+ ;.HL1 CHKKBD ; This routine will check to see if the user has typed an interesting character ;on the keyboard (assuming we still have one). ; This allows for aborting the current file or an entire stream. ;.literal ; ; Usage: ; $CALL CHKKBD ; ; On true return: ; Some interesting character seen. ; ; On a false return: ; Nothing of interest seen. ; ;.end literal ;- CHKKBD: MOVX S2,BLSTRU ; Get the flag value TDNE S2,CONNECT%FLAG## ; Check if connected $RETF ; Yes, no keyboard to poll CHKKB1: INCHRS S1 ; No, get a character from the keyboard $RETF ; Nothing there CAXE S1,.CHCNX ; Control-X? CAXN S1,.CHCNZ ; or control-Z? JRST .+2 ; Yes, set correct flag JRST CHKKB1 ; No, check if more there CHKKB2: CAXN S1,.CHCNX ; Control-X? MOVEM S2,ABT%CUR%FILE## ; Yes, abort current file CAXN S1,.CHCNZ ; No, control-Z? MOVEM S2,ABT%ALL%FILE## ; Yes, abort entire stream INCHRS S1 ; Any more characters? $RETT ; No, return but remember we had something JRST CHKKB2 ; Yes, go check if interesting SUBTTL Terminal processing -- Message routines -- Set time out timer ;+ ;.hl1 SETTMR ;This routine will set the time out timer for inputting and outputting a ;message. It will be called by the RECEIVE and SEND routines. ;.literal ; ; Usage: ; $CALL SETTMR ; (Return) ; ; On return: ; TIMLIM set up ; ;.end literal ;- TOPS10< SETTMR: SKIPN RCV%TIMEOUT## ; Have a value? JRST [MOVX S1,.INFIN ; No, use infinity MOVEM S1,TIMLIM ; Store the time limit $RET] ; Return to the caller MOVX S1,%CNSUP ; Get the current uptime GETTAB S1, ; From the system JFCL ; Don't care MOVEM S1,TIMLIM ; Store this MOVE S1,RCV%TIMEOUT## ; Get the time out again IMUL S1,JIFSEC ; Mul by jiffies per second ADDM S1,TIMLIM ; Update for the delta $RET ; Return to the caller >; End of TOPS10 conditional SUBTTL Terminal processing -- General -- Determine using local line ;+ ;.hl1 T$LOCAL ;This routine will determine if we are using a local line or not. It ;will return TRUE if the line in XFRTRM is the same as MYTERM. ;.literal ; ; Usage: ; $CALL T$LOCAL ; (Return) ; ; Return true: ; MYTERM == XFRTRM ; ; Return false: ; MYTERM <> XFRTRM ; ;.end literal ;- T$LOCAL: MOVE S1,$TTLIN+XFRTRM ; Get this terminal line number MOVE S2,$TTNOD+XFRTRM ; Get the node number CAMN S1,MYTERM+$TTLIN ; Is this the same? CAME S2,MYTERM+$TTNOD ; . . . $RETF ; Not the same $RETT ; Same SUBTTL Terminal processing -- General -- Open a terminal ;+ ;.hl1 T$OPEN ;This routine will open a terminal for input and output. It is called with ;the address of the terminal information block. It will store the address ;and size of the buffers, the channel number and device name into the ;information block. ;.literal ; ; Usage: ; XMOVEI S1,Terminal information block ; $CALL T$OPEN ; (Return) ; ; On a true return: ; - Terminal is open ; ; On a false return: ; - Terminal failed to open ; ;.end literal ;- TOPS10< T$OPEN: $SAVE ; Save a registers MOVE P1,S1 ; Copy the argument $CALL T$CONN ; Connect the terminal MOVEM S1,$TTDEV(P1) ; Store the device name MOVEM S1,FLP+.FODEV ; Store the name IONDX. S1, ; Get the UDX also SETO S1, ; Pretend it is us MOVEM S1,$TTUDX(P1) ; Remember the UDX MOVX S1,.IOPIM!IO.SUP!UU.AIO ; Get the mode and other information MOVEM S1,FLP+.FOIOS ; Store the status information HRLI S1,$TTOBH(P1) ; Get the output buffer header HRRI S1,$TTIBH(P1) ; Get the input buffer header MOVEM S1,FLP+.FOBRH ; Store them MOVX S1,-1 ; Assume defaults MOVEM S1,FLP+.FONBF ; Store the number of buffers SETZM FLP+.FOFNC ; Clear this MOVX S1,.FORED ; Claim reading STORE S1,FLP+.FOFNC,FO.FNC ; Store the function MOVX S1,FO.ASC ; Assign a channel IORM S1,FLP+.FOFNC ; Turn this on MOVEI S1,FLP+.FOIOS ; Point to the block DEVSIZ S1, ; Get the size of the buffers JRST [$KERR() $RETF] ; Return to the caller HLRZ S2,S1 ; Get the number of buffers MOVEI S1,(S1) ; Get the size IMULI S1,(S2) ; Compute the total size LSH S1,1 ; Double it (input and output) MOVEM S1,$TTBSZ(P1) ; Store the number of words $CALL M%GMEM ; Allocate the memory $RETIF ; Failed? MOVEM S2,$TTBAD(P1) ; Store the buffer address EXCH S2,.JBFF ; Exchange with .JBFF MOVX S1, ; Point to the argument block FILOP. S1, ; Open terminal, allocate buffers JRST OPEN.0 ; Failed, restore and get out MOVEM S2,.JBFF ; Store .JBFF back LOAD S1,FLP+.FOFNC,FO.CHN ; Get the channel assigned MOVEM S1,$TTCHN(P1) ; Store it ; Remember any parameters we need to change, then change them MOVX P2,.TOPAG ; Get the TT PAGE (on/off) setting MOVE P3,$TTUDX(P1) ; Get the UDX MOVX S1, ; Point at the block TRMOP. S1, ; And get the bit SETZ S1, ; Must not know about it MOVEM S1,$TTPAG(P1) ; Save the bit setting MOVE S1,IBM%FLAG## ; IBM mode? TXNN S1,BLSTRU ; . . . $RETT ; No, all done MOVE S1,IBM%CHAR## ; Yes, get the character CAXE S1,.CHCNQ ; XON? CAXN S1,.CHCNS ; Or XOFF? JRST .+2 ; Yes, need to clear TTY PAGE $RETT ; No, leave things alone MOVX S1, ; Get the pointer ADDX P2,.TOSET ; Change to set function MOVEI P4,1B35 ; Turn page on TRMOP. S1, ; Do it JFCL ; Ignore error $RETT ; Give a good return ; Here if the FILOP. failed to open the terminal. OPEN.0: MOVEM S2,.JBFF ; Store .JBFF back $KERR () SETZB S1,S2 ; Clear these EXCH S1,$TTBSZ(P1) ; Get the size and clear entry EXCH S2,$TTBAD(P1) ; Get the address and clear it $CALL M%RMEM ; Return the memory $RETF ; Return to the caller >; End of TOPS10 conditional SUBTTL Terminal processing -- General -- T$CLOS - Close the terminal channel ;+ ;.hl1 T$CLOS ;This routine will close the terminal channel and return the buffers ;associated with the terminal. ;.literal ; ; Usage: ; XMOVEI S1,Terminal information block ; $CALL T$CLOSE ; (Return) ; ; On return: ; Terminal channel closed and the buffers returned. ; ;.end literal ;- T$CLOS: $SAVE ; Save P1 MOVE P1,S1 ; Copy the argument into here ; First reset the parameters correctly MOVX P2,.TOSET+.TOPAG ; Reset TTY PAGE correctly MOVE P3,$TTUDX(P1) ; . . . MOVE P4,$TTPAG(P1) ; . . . MOVX S1, ; Point at block TRMOP. S1, ; And set bit back the way we found it JFCL ; We tried SETZ S2, ; Clear this word MOVE S1,$TTCHN(P1) ; Get the channel number STORE S1,S2,FO.CHN ; Store the channel number MOVX S1,.FOREL ; Get the function STORE S1,S2,FO.FNC ; Store the function MOVX S1, ; Point to the argument block FILOP. S1, ; Release the channel JFCL ; Don't care MOVE S1,$TTBSZ(P1) ; Get the number of words MOVE S2,$TTBAD(P1) ; Get the address $CALL M%RMEM ; Return the memory $RETF ; Return if that fails $RETT ; Give a good return SUBTTL Terminal processing -- General -- Input a character ;+ ;.hl1 T$CIN ;This routine will input a character given the terminal information ;block address. This routine assumes that the terminal has been opened. ;.literal ; ; Usage: ; XMOVEI S2,Terminal info block ; $CALL T$CIN ; (Return) ; ; On a true return: ; S1/ Character ; ; On a false return: ; $TTIOS word of terminal block contains the status ; ;.end literal ;- T$CIN: SOSGE $TTIBH+.BFCNT(S2) ; Decrement the character count JRST CIN.0 ; Get a buffer ILDB S1,$TTIBH+.BFPTR(S2) ; Read one character $RETT ; And return it ; Here to get the next buffer from the terminal CIN.0: SETZ TF, ; Clear a registers MOVX S1,.FOINP ; Get the FILOP. function STORE S1,TF,FO.FNC ; Store the function MOVE S1,$TTCHN(S2) ; Get the channel STORE S1,TF,FO.CHN ; Store the channel MOVX S1, ; Get the argument pointer FILOP. S1, ; Attempt to read characters TRNA ; Failed, store status JRST T$CIN ; Loop to get the characters ; Here if the FILOP. failed, store the status and give a fail return MOVEM S1,$TTIOS(S2) ; Store the status $RETF ; And fail SUBTTL Terminal processing -- General -- Output a character ;+ ;.hl1 T$COUT ;This routine will output a character given the character and the terminal ;information block. ;.literal ; ; Usage: ; MOVEI S1,Character ; XMOVEI S2,Terminal information block ; $CALL T$COUT ; (Return) ; ; On a true return: ; - Character stuffed in the buffer ; ; On a false return: ; - Problems outputting the character. ; ;.end literal ;- T$COUT: SOSGE $TTOBH+.BFCNT(S2) ; Decrement the count JRST COUT.0 ; Output the buffer IDPB S1,$TTOBH+.BFPTR(S2) ; Store the character $RETT ; Give a good return COUT.0: $CALL T$DMPO ; Output the buffer JUMPT T$COUT ; Try again $RET ; Pass back the error T$DMPO: $SAVE ; Save two registers SETZ S1, ; Clear this MOVE TF,$TTCHN(S2) ; Get the channel STORE TF,S1,FO.CHN ; Store it MOVX TF,.FOOUT ; Get the function STORE TF,S1,FO.FNC ; Store it MOVX TF, ; Point to the argument block FILOP. TF, ; Output the information SKIPA ; Failed, store the status and return $RETT ; Give a good return MOVEM TF,$TTIOS(S2) ; Store the status $RETF ; Give a failure return SUBTTL Terminal processing -- General -- Output a character for CONNECT ;+ ;.hl1 T$CCOT ;This routine will output a character given the character and the terminal ;information block. It will send only the single character using ;a TRMOP. ;.literal ; ; Usage: ; MOVEI S1,Character ; XMOVEI S2,Terminal information block ; $CALL T$CCOT ; (Return) ; ; On a true return: ; - Character stuffed in the buffer ; ; On a false return: ; - Problems outputting the character. ; ;.end literal ;- T$CCOT: $SAVE ; Save some registers MOVE P2,$TTUDX(S2) ; Get the terminal UDX MOVX P1,.TOOIC ; Output an image character MOVE P3,S1 ; And the character MOVE S1,[XWD 3,P1] ; Get the argument pointer TRMOP. S1, ; Send the character JRST [MOVE S1,P3 ; Couldn't, get the character back PJRST T$COUT] ; And try the other way MOVE S1,P3 ; Get the character back $RETT ; And return SUBTTL Terminal processing -- General -- Connect a terminal line ;+ ;.hl1 T$CONN ;This routine will connect a terminal to the system. This is a TOPS-10 ;only routine ;.literal ; ; Usage: ; MOVEI S1,Terminal information block ; $CALL T$CONN ; (Return) ; ; On return: ; S1/ Terminal name in sixbit ; ;.end literal ;- TOPS10< T$CONN: $SAVE ; Save this registers MOVE P1,S1 ; Copy the address MOVX S1, ; Point to the argument block MOVX T1,2 ; Number of words MOVE T2,$TTLIN(P1) ; Get the line number HRL T2,$TTNOD(P1) ; Get the node number NODE. S1, ; Connect the terminal JRST .+2 ; Not a network system $RET ; Return to the caller MOVE S1,$TTLIN(P1) ; Get the line number ADDX S1,.UXTRM ; Convert to UDX DEVNAM S1, ; Convert to terminal name SETO S1, ; Not a device? $RET ; Return >; End of TOPS10 conditional SUBTTL Terminal processing -- General -- Set PIM break set ;+ ;.hl1 T$SBRK ;This routine will set the PIM mode break set. It will be called with ;the character to use and the address of the terminal control block. ;.literal ; ; Usage: ; MOVEI S1, ; XMOVE S2,Terminal control block ; $CALL T$SBRK ; (Return) ; ; On a true return; ; - Mask set ; ; On a false return: ; - It failed. ; ;.end literal ;- TOPS10< T$SBRK: $SAVE ; Save a few registers MOVE P2,$TTUDX(S2) ; Get the terminal UDX HRLZ P3,S1 ; Copy the character JUMPE P3,.+2 ; If no desired break char, break on all TXO P3, ; Otherwise, also break on Ctl-C MOVE S1,IBM%FLAG## ; Check if we are talking to IBM TXNN S1,BLSTRU ; Are we? TDZA S1,S1 ; No, no additional break char MOVE S1,IBM%CHAR## ; Yes, get the character LSH S1,^D9 ; Position to correct place JUMPE P3,.+2 ; If already breaking on all, stay that way TRO P3,(S1) ; Turn it on MOVX P1,.TOSET+.TOPBS ; Get the function MOVX S1, ; Point to the argument block TRMOP. S1, ; Do the function $RETF ; Pass back the error $RETT ; Give a good return >; End of TOPS10 conditional SUBTTL Terminal processing -- Text output -- TERM%DUMP & DBG%DUMP ;+ ;.HL1 TERM%DUMP ;This routine will dump the terminal buffer that the BLISS routines have been ;keepng on the user's terminal. ;.hl1 DBG%DUMP ; This routine will dump the buffer onto either the terminal or into ;the debugging file. ;- BLSRTN(TERM%DUMP,) $SAVE ; Save TF and S1 MOVX S1,BLSFAL ; Determine if connected CAMN S1,CONNECT%FLAG## ; Are we? $TEXT (,<^T/@BUFFER/^A>) ; No, type it $RET ; And return BLSRTN(DBG%DUMP,) $SAVE ; Save a few registers MOVE S2,CONNECT%FLAG## ; Get the flag SKIPE DBFIFN ; Debugging file open? JRST TRMD.1 ; Yes, just dump the buffer CAXN S2,BLSFAL ; Communicating on controlling term? $TEXT (,<^T/@BUFFER/^A>) ; No, we can type on it $RET ; And return ; Here to output the text to the debugging file TRMD.1: MOVE S1,DBFIFN ; Get the IFN MOVE S2,BUFFER ; Get the address of the buffer HRL S2,COUNT ; And the count $CALL F%OBUF ; Output the buffer $RETIT ; If no error, return MOVE S1,DBFIFN ; Get the IFN back SETZM DBFIFN ; No debugging file anymore PJRST F%REL ; Try to keep what we wrote already SUBTTL Error processing -- .KERERR - Handle KERMIT-10 errors ;+ ;.hl1 _.KERERR ;This routine is called by the KERERR macro. It is used to pass error ;text to the remote KERMIT. ;- .KERERR:: HRRZ TF,@(P) ; Get the address of the text MOVEM TF,.TEMP ; Save it here $SAVE ; Save a few registers $SAVE ; And a few more $TEXT (<-1,,MSGTXT>,<^I/@.TEMP/^0>) ; Type the text JRST KRERR ; Join the common code SUBTTL Error processing -- KRM%ERROR - Handle the KERMSG errors ;+ ;.hl1 KRM%ERROR ;This routine will handle the errors that KERMSG will generate. ;- BLSRTN(KRM%ERROR,) $SAVE ; Save a few registers $SAVE ; And a few more MOVE S1,ERRTYP ; Get the error type MOVSI S2,-ERRLEN ; Get the size of the table KRMER0: CAME S1,ERRTBL(S2) ; Is this the error? AOBJN S2,.-1 ; Look until we find it $TEXT (<-1,,MSGTXT>,<^T/@ERRTXT(S2)/^0>) ; Write the text ; Here to count the characters and call the BLISS routine to write the ; error packet to the remote KRERR: MOVE S1,[POINT 7,MSGTXT] ; Point to the text SETZ S2, ; Clear the counter KRERR0: ILDB T1,S1 ; Get a character JUMPE T1,KRERR1 ; Finished? AOJA S2,KRERR0 ; No, count it up and loop KRERR1: PUSH P,S2 ; Push this on the stack XMOVEI S1,MSGTXT ; Point to the text PUSH P,S1 ; Save this on the stack too PUSHJ P,SND%ERROR## ; Send the error message ADJSP P,-2 ; Remove the information BLSRET NORMAL ; Give a normal return for now ; BLISS error text DEFINE KER(TYPE,VALUE,TEXT) ERRTBL: KERRORS ERRLEN==.-ERRTBL DEFINE KER(TYPE,VALUE,TEXT) ERRTXT: KERRORS EXP [ASCIZ |Unknown error code|] SUBTTL CRC calculation routine ;+ ;.hl1 CRC calculation ; This routine will calculate the CRC for a string. It will use ;the CRC-CCITT polynomial. ;.lit ; ; Usage: ; CRC = CRCCLC(.Address, .Length) ; ;.end lit ;- BLSRTN(CRCCLC,) ; Define the routine $SAVE ; Save T1-T4 ; AC usage: ; S1/ Accumulated CRC ; T4/ Remaining length ; T3/ Byte pointer to string ; T2/ temp ; T1/ temp SETZ S1, ; Initial CRC is 0 MOVE T4,LEN ; Get the length MOVE T3,BYTEPTR ; And the address CRCC.1: ILDB T1,T3 ; Get a character XORI T1,(S1) ; Add in with current CRC LDB T2,[POINT 4,T1,31] ; Get high 4 bits ANDI T1,^O17 ; And low 4 bits MOVE T1,CRCTB2(T1) ; Get low portion of CRC factor XOR T1,CRCTAB(T2) ; Plus high portion LSH S1,-^D8 ; Shift off a byte from previous CRC XOR S1,T1 ; Add in new value SOJG T4,CRCC.1 ; Loop for all characters $RET ; Return (value already in S1) ; Data tables for CRC-CCITT generation CRCTAB: OCT 0 OCT 10201 OCT 20402 OCT 30603 OCT 41004 OCT 51205 OCT 61406 OCT 71607 OCT 102010 OCT 112211 OCT 122412 OCT 132613 OCT 143014 OCT 153215 OCT 163416 OCT 173617 CRCTB2: OCT 0 OCT 10611 OCT 21422 OCT 31233 OCT 43044 OCT 53655 OCT 62466 OCT 72277 OCT 106110 OCT 116701 OCT 127532 OCT 137323 OCT 145154 OCT 155745 OCT 164576 OCT 174367 SUBTTL Data area RELOC ; To the low segment PDL: BLOCK PDLLEN ; Stack TOPS10< CCLOFS: BLOCK 1 ; CCL offset >; End of TOPS10 conditional LOWBEG:! XITFLG: BLOCK 1 ; Exit flag PRTARG: BLOCK 2 ; Saved parser information PRBLK: BLOCK PAR.SZ ; Parser interface block TOPS10< MONBLK: BLOCK PAR.SZ ; Monitor command block TMPBP: BLOCK 1 ; Byte pointer for building .TMP file name TMPSIZ: BLOCK 1 ; TMP file size TMPADR: BLOCK 1 ; Address of TMP pointer CCLIFN: BLOCK 1 ; CCL file IFN .MYPPN: BLOCK 1 ; My ppn >; End of TOPS10 conditional INIIFN: BLOCK 1 ; KERMIT.INI IFN ; IFN for debugging log file DBFIFN: BLOCK 1 ; 0 if no file, IFN if file open ; Terminal I/O information TOPS10< TIMLIM: BLOCK 1 ; Time out time JIFSEC::BLOCK 1 ; Number of jiffies per second >; End of TOPS10 conditional ESCAPE: BLOCK 1 ; CONNECT escape character ESCTXT: BLOCK 1 ; Escape character in ASCII LCLECH: BLOCK 1 ; Local echo flag XFRTRM: BLOCK $TTSIZ ; Transfer terminal information MYTERM: BLOCK $TTSIZ ; My terminal information ; File I/O information FILTYP: BLOCK 1 ; Type of file being read/written CURFTP: BLOCK 1 ; File byte size for currently read file FILPTR: BLOCK 1 ; Location containing a byte pointer to store FILE%NAME TOPS10< USRFIL: BLOCK 1 ; Non-zero if user supply spec USRFX: BLOCK .FDSIZ ; Length of the file spec area FX: BLOCK .FDSIZ ; File specification length BH: BLOCK 3 ; Buffer header FBFADR: BLOCK 1 ; Address of the file buffers FBFSIZ: BLOCK 1 ; Size of the file buffers WLDPTR: BLOCK 1 ; Pointer used by .LKWLD FLP: BLOCK .FOMAX ; FILOP. block ELB: BLOCK .RBMAX ; Enter/Lookup block PTH: BLOCK .PTMAX ; Path block FPTH: BLOCK .PTMAX ; File found in path ; LOKWLD interface WLD: BLOCK $LKLEN ; Length of block >; End of TOPS10 conditional ; Random information and storage .TEMP: BLOCK 10 ; Temp storage for strings MSGTXT: BLOCK 50 ; Area for 250 character of message LOWEND:! LOWSIZ==.-LOWBEG RELOC ; Back to the high segment PHABEG: PHASE LOWEND LOWPHA:! IB: $BUILD IB.SZ $SET IB.FLG,,IT.OCT!IB.NPF $SET IB.PRG,,%%.MOD $EOB HLPFD: $BUILD FDMSIZ $SET .FDLEN,FD.LEN,FDMSIZ ; Size of the block $SET .FDLEN,FD.TYP,.FDNAT ; Native file specification $SET .FDSTR,, ; HLP: $SET .FDNAM,,%%.MOD ; KERMIT $SET .FDEXT,, ; .HLP $EOB CCLFD: $BUILD FDMSIZ ; Minimum size FD $SET .FDLEN,FD.LEN,FDMSIZ ; Size of the FDB $SET .FDLEN,FD.TYP,.FDNAT ; Native spec $SET .FDSTR,, ; Device is DSK $SET .FDEXT,, ; Extension $EOB ; End of block CCLFOB: $BUILD FOB.MZ ; Build an FOB $SET FOB.FD,,CCLFD ; Address of FD $SET FOB.CW,FB.BSZ,7 ; Byte size $EOB ; End of block ; FD for KERMIT.INI INIFD: $BUILD FDMSIZ ; Minimum size FD $SET .FDLEN,FD.LEN,FDMSIZ ; Size $SET .FDLEN,FD.TYP,.FDNAT ; Native FD TOPS10< $SET .FDSTR,, ; Device is DSK $SET .FDNAM,, ; Name is KERMIT $SET .FDEXT,, ; .INI >; End of TOPS10 conditional TOPS20< $SET .FDSTG,, >; End of TOPS20 conditional $EOB ; End of block ; FOB for debugging file DBFFOB: $BUILD FOB.MZ ; Build an FOB $SET FOB.CW,FB.BSZ,7 ; Byte size $EOB ; End of block PHALEN==.-LOWEND PHAEND: DEPHASE RELOC ; Back to the low segment BLOCK PHALEN ; Allocate the phased space RELOC ; Back to the high segment SUBTTL End of Kermit TOPS20< END <3,,KERMIT>> TOPS10< END KERMIT>