TITLE KERMIT-10 ; 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==3 ; Major version number MITMIN==0 ; Minor version number MITEDT==136 ; 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 ;+ ;.pag.lit ; Table of Contents of KERMIT ; ; ; Section Page ; 1. Revision History . . . . . . . . . . . . . . . . . . . . . . . . 3 ; 2. Command tables ; 2.1. Prompt strings. . . . . . . . . . . . . . . . . . . . . . . 4 ; 2.2. Initial state . . . . . . . . . . . . . . . . . . . . . . . 5 ; 2.3. Final state . . . . . . . . . . . . . . . . . . . . . . . . 5 ; 2.4. BYE command . . . . . . . . . . . . . . . . . . . . . . . . 5 ; 2.5. CONNECT command . . . . . . . . . . . . . . . . . . . . . . 6 ; 2.6. DEFINE command. . . . . . . . . . . . . . . . . . . . . . . 7 ; 2.7. EXIT command. . . . . . . . . . . . . . . . . . . . . . . . 8 ; 2.8. FINISH command. . . . . . . . . . . . . . . . . . . . . . . 9 ; 2.9. GET command . . . . . . . . . . . . . . . . . . . . . . . . 9 ; 2.10. HELP command. . . . . . . . . . . . . . . . . . . . . . . . 9 ; 2.11. LOGOUT command. . . . . . . . . . . . . . . . . . . . . . . 10 ; 2.12. RECEIVE command . . . . . . . . . . . . . . . . . . . . . . 10 ; 2.13. SEND command. . . . . . . . . . . . . . . . . . . . . . . . 10 ; 2.14. SERVER command. . . . . . . . . . . . . . . . . . . . . . . 11 ; 2.15. SET command ; 2.15.1. Dispatch table. . . . . . . . . . . . . . . . . . . . 12 ; 2.15.2. ON/OFF table. . . . . . . . . . . . . . . . . . . . . 13 ; 2.15.3. incomplete-file . . . . . . . . . . . . . . . . . . . 14 ; 2.15.4. Block-check-type. . . . . . . . . . . . . . . . . . . 14 ; 2.15.5. DEBUGGING . . . . . . . . . . . . . . . . . . . . . . 14 ; 2.15.6. DELAY . . . . . . . . . . . . . . . . . . . . . . . . 14 ; 2.15.7. ESCAPE. . . . . . . . . . . . . . . . . . . . . . . . 14 ; 2.15.8. FILE-BYTE-SIZE. . . . . . . . . . . . . . . . . . . . 15 ; 2.15.9. Line. . . . . . . . . . . . . . . . . . . . . . . . . 16 ; 2.15.10. Message . . . . . . . . . . . . . . . . . . . . . . . 17 ; 2.15.11. Parity. . . . . . . . . . . . . . . . . . . . . . . . 18 ; 2.15.12. Receive . . . . . . . . . . . . . . . . . . . . . . . 19 ; 2.15.13. Repeat-quote. . . . . . . . . . . . . . . . . . . . . 20 ; 2.15.14. Retry . . . . . . . . . . . . . . . . . . . . . . . . 21 ; 2.15.15. Send. . . . . . . . . . . . . . . . . . . . . . . . . 22 ; 2.16. STATUS command. . . . . . . . . . . . . . . . . . . . . . . 23 ; 2.17. SHOW command. . . . . . . . . . . . . . . . . . . . . . . . 24 ; 3. Entry vector and initialization. . . . . . . . . . . . . . . . . 25 ; 4. Kermit initialization. . . . . . . . . . . . . . . . . . . . . . 29 ; 5. KERMIT.INI processing. . . . . . . . . . . . . . . . . . . . . . 30 ; 6. CCL entry processing ; 6.1. SETTMP. . . . . . . . . . . . . . . . . . . . . . . . . . . 31 ; 6.2. ADVTMP. . . . . . . . . . . . . . . . . . . . . . . . . . . 32 ; 6.3. ABRTAK. . . . . . . . . . . . . . . . . . . . . . . . . . . 33 ; 7. Command parsing utility routines ; 7.1. CHKCTL. . . . . . . . . . . . . . . . . . . . . . . . . . . 34 ; 8. Command execution ; 8.1. CONNECT command . . . . . . . . . . . . . . . . . . . . . . 35 ; 8.2. DEFINE command. . . . . . . . . . . . . . . . . . . . . . . 36 ; 8.3. EXIT command. . . . . . . . . . . . . . . . . . . . . . . . 37 ; 8.4. BYE command . . . . . . . . . . . . . . . . . . . . . . . . 38 ; 8.5. FINISH command. . . . . . . . . . . . . . . . . . . . . . . 39 ; 8.6. LOGOUT command. . . . . . . . . . . . . . . . . . . . . . . 40 ; 8.7. HELP command. . . . . . . . . . . . . . . . . . . . . . . . 41 ; 8.8. PROMPT command. . . . . . . . . . . . . . . . . . . . . . . 42 ; 8.9. SEND command. . . . . . . . . . . . . . . . . . . . . . . . 43 ; 8.10. GET command . . . . . . . . . . . . . . . . . . . . . . . . 44 ; 8.11. RECEIVE command . . . . . . . . . . . . . . . . . . . . . . 45 ; 8.12. SERVER command. . . . . . . . . . . . . . . . . . . . . . . 46 ; 8.13. SET command ; 8.13.1. Top level . . . . . . . . . . . . . . . . . . . . . . 47 ; 8.13.2. SETKYW - Parse a keyword and store the value. . . . . 47 ; 8.13.3. DEBUGGING parameter . . . . . . . . . . . . . . . . . 48 ; 8.13.4. Initial DELAY . . . . . . . . . . . . . . . . . . . . 49 ; 8.13.5. LINE to use . . . . . . . . . . . . . . . . . . . . . 50 ; 8.13.6. MESSAGE parameters. . . . . . . . . . . . . . . . . . 51 ; 8.13.7. RECEIVE parameters. . . . . . . . . . . . . . . . . . 52 ; 8.14. SHOW command. . . . . . . . . . . . . . . . . . . . . . . . 55 ; 8.14.1. SHOW MACROS . . . . . . . . . . . . . . . . . . . . . 56 ; 8.14.2. SHOW VERSION. . . . . . . . . . . . . . . . . . . . . 57 ; 8.14.3. SHOW DAYTIME. . . . . . . . . . . . . . . . . . . . . 57 ; 8.14.4. SHOW DEBUGGING. . . . . . . . . . . . . . . . . . . . 58 ; 8.14.5. SHOW FILE-INFORMATION . . . . . . . . . . . . . . . . 59 ; 8.14.6. SHOW LINE-INFORMATION . . . . . . . . . . . . . . . . 60 ; 8.14.7. SHOW PACKET-INFORMATION . . . . . . . . . . . . . . . 61 ; 8.14.8. SHOW TIMING-INFORMATION . . . . . . . . . . . . . . . 62 ; 8.14.9. Support routines ; 8.14.9.1. TONOFF . . . . . . . . . . . . . . . . . . . . . 63 ; 8.14.9.2. CHITXT . . . . . . . . . . . . . . . . . . . . . 64 ; 8.15. STATUS command. . . . . . . . . . . . . . . . . . . . . . . 65 ; 9. File processing ; 9.1. INIFILE - Initialization. . . . . . . . . . . . . . . . . . 66 ; 9.2. FILE%OPEN . . . . . . . . . . . . . . . . . . . . . . . . . 67 ; 9.3. Routine to type the file specification. . . . . . . . . . . 69 ; 10. Routine to setup FILOP/ELB/PATH blocks . . . . . . . . . . . . . 70 ; 11. File processing ; 11.1. Routine to convert FX blocks . . . . . . . . . . . . . . . 71 ; 11.2. FILE%CLOSE . . . . . . . . . . . . . . . . . . . . . . . . 72 ; 11.3. NEXT%FILE. . . . . . . . . . . . . . . . . . . . . . . . . 73 ; 11.4. GET%FILE - Get a byte. . . . . . . . . . . . . . . . . . . 74 ; 11.5. PUT%FILE - Store a byte. . . . . . . . . . . . . . . . . . 75 ; 11.6. FILE%DUMP - Not needed . . . . . . . . . . . . . . . . . . 76 ; 12. Support routines ; 12.1. PRSFIL - Parse a file specification. . . . . . . . . . . . 77 ; 12.2. PRSSX$ - Parse a sixbit field. . . . . . . . . . . . . . . 78 ; 12.3. PRSWS$ - Parse a wild sixbit field . . . . . . . . . . . . 79 ; 12.4. CHKAL$ - Check for alphanumeric. . . . . . . . . . . . . . 80 ; 12.5. PRSOC$ - Parse a wild octal number . . . . . . . . . . . . 81 ; 12.6. INPCH$ - Input a character . . . . . . . . . . . . . . . . 82 ; 13. Packet count processing ; 13.1. XFR%STATUS . . . . . . . . . . . . . . . . . . . . . . . . 83 ; 14. Terminal processing ; 14.1. Message routines ; 14.1.1. Initialization. . . . . . . . . . . . . . . . . . . . 84 ; 14.1.2. Open the terminal . . . . . . . . . . . . . . . . . . 85 ; 14.1.3. Close the terminal. . . . . . . . . . . . . . . . . . 86 ; 14.1.4. Send a message. . . . . . . . . . . . . . . . . . . . 87 ; 14.1.5. Wait for turnaround . . . . . . . . . . . . . . . . . 88 ; 14.1.6. Receive a message . . . . . . . . . . . . . . . . . . 89 ; 14.1.7. Check for keyboard input. . . . . . . . . . . . . . . 90 ; 14.1.8. Set time out timer. . . . . . . . . . . . . . . . . . 91 ; 14.2. General ; 14.2.1. Determine using local line. . . . . . . . . . . . . . 92 ; 14.2.2. Open a terminal . . . . . . . . . . . . . . . . . . . 93 ; 14.2.3. T$CLOS - Close the terminal channel . . . . . . . . . 94 ; 14.2.4. Input a character . . . . . . . . . . . . . . . . . . 95 ; 14.2.5. Output a character. . . . . . . . . . . . . . . . . . 96 ; 14.2.6. Output a character for CONNECT. . . . . . . . . . . . 97 ; 14.2.7. Connect a terminal line . . . . . . . . . . . . . . . 98 ; 14.2.8. Set PIM break set . . . . . . . . . . . . . . . . . . 99 ; 14.3. Text output ; 14.3.1. TERM%DUMP & DBG%DUMP. . . . . . . . . . . . . . . . . 100 ; 15. Error processing ; 15.1. .KERERR - Handle KERMIT-10 errors. . . . . . . . . . . . . 101 ; 15.2. KRM%ERROR - Handle the KERMSG errors . . . . . . . . . . . 102 ; 16. CRC calculation routine. . . . . . . . . . . . . . . . . . . . . 104 ; 17. Data area. . . . . . . . . . . . . . . . . . . . . . . . . . . . 105 ; 18. End of Kermit. . . . . . . . . . . . . . . . . . . . . . . . . . 107 ; ;.end lit.pag ;- 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 107 By: Nick Bush On: 12-November-1983 Add macro definition capability for SET options. Modules: KERMIT 111 By: Nick Bush On: 16-November-1983 Add TAKE command. Modules: KERMIT 112 By: Nick Bush On: 17-November-1983 Clear the input buffer before we send a message. This ignores any garbage which came in on the line since the last message we received. Modules: KERMIT 113 By: Nick Bush On: 14-December-1983 Add some more single character commands for use during transfers. Control-A will type a status line, control-D will toggle debugging, and carriage return will force a timeout (therefore either a NAK or retransmission). Modules: KERMIT 114 By: Nick Bush On: 19-December-1983 Default the transfer terminal to KERMIT: if the logical name exists and is a terminal. Remove FILE%DUMP, since KERMSG no longer references it. Modules: KERMIT 115 By: Nick Bush On: 5-January-1983 Add support for different types of file names. This changes the SET FILE-xxx commands to be SET FILE xxx and adds a SET FILE NAMING command. Modules: KERMIT 116 By: Nick Bush On: 14-March-1984 Add parsing for all REMOTE commands. Add support for some generic and local commands. Fix wild card processing to handle pathological names correctly. Modules: KERMIT,KERSYS,KERWLD 120 By: Robert C. McQueen On: 28-March-1984 Add bug fixes from WMU. Many thanks to the people out in Kalamazoo. Modules: KERMIT,KERWLD 121 By: Robert C. McQueen On: 28-March-1984 Add SET PROMPT command. Start adding support for generic COPY and RENAME commands. Modules: KERUNV,KERMIT,KERWLD 122 By: Robert C. McQueen On: 29-March-1984 Remove ADJBP instructions and add the five instructions that adjust byte pointers for the KI10s that use Kermit.' Modules: KERMIT 123 By: Nick Bush On: 2-April-1984 Change SPACE generic command to use PPN of default path instead of users PPN if no argument is supplied. Make DIRECTORY and DELETE generic commands print out a header at the top of the list, and print file size in both words and allocated blocks. Add SPACE as synonym for DISK-USAGE command and ERASE as synonym for DELETE. Modules: KERMIT,KERSYS Start of Version 3(124) 125 By: Nick Bush On: 26-June-1984 Add patches from CSM: - Wrong AC when setting PIM break set. - Checks for not-logged-in Kermits - Parity for CONNECT (implemented differently) Modules: KERMIT,KERSYS 126 By: Nick Bush On: 11-July-1984 RECEIVE FOO.BAR would not work correctly. It thought the extension was wild-carded. Modules: KERMIT 127 By: David Stevens On: 9-July-1985 Add patches from PIMA: - Fix IFN stopcode if syntax error in KERMIT.INI. - Add help text for connect mode escape commands Q (quit) and R (resume) logging - Add SET XON-XOFF-PROCESSING to determine how XON/XOF should be handled during CONNECT. - Add a new file byte-size 36-bit for 10 to 10/20 transfers. Modules: KERMIT, KERUNV 130 By: David Stevens On: 15-July-1985 Fix multiple file sending problem. - note this resulted in a patch to all kermits using KERMSG Modules: KERMIT, KERMSG 131 By: David Stevens On: 25-July-1985 Add SET HANSHAKE to set up an IBM hanshaking character Modules: KERMIT 132 By David Stevens On: 29-July-1985 Fix DFNMAC - IBM to set the handshake character instead of the IBM-MODE Modules: KERMIT 133 By David Stevens On: 30-July-1985 Eliminate SET IBM-MODE. Modules: KERMIT 134 By Dan Norstedt On: 17-June-1989 Incorperated VMS enhancements, added Extended Length packets Modules: KERMIT, KERMSG (VMS version + updates), KERGLB 135 By Nick Bush On: 1-April-2006 Kludge implemented by OCTERM to reset terminal status for GLXLIB appears to no longer be necessary. Until we can determine which version of GLXLIB fixed it, just treat the routine as a noop. 136 By Nick Bush On: 17-April-2006 Try better fix for OCTERM - get bits for K%OPEN and just call that routine. Previous fix left echoing as "$". Also fix CAXE in T$CONN to have double brackets to avoid problem with the macro. This fix was one originally identified by Miike Freeman, but was not included in the source with other fixes. This edit also officializes the other Mike Freeman fixes that have been in the .BWR file. | SUBTTL Command 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 (DFN000,C$DEFINE,) ;[107] Define set of parameters 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 (LCL000,C$LOCAL,) ; LOCAL command DSPTAB (LOG000,C$LOG,) ; LOG 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,,CM%INV!CM%ABR) ; Receive command DSPTAB (RCV000,C$RECEIVE,) ; RECEIVE command DSPTAB (REM000,C$REMOTE,) ;[116] Remote xxx 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 DSPTAB (TAKFDB##,.KYTAK,) ;[111] Take command $ETAB KER100: $INIT (KER110) KER110: $KEYDSP (KER120) ; Dispatch table KER120: $STAB DSPTAB (,C$EXI0,\"<.CHCNZ>,CM%INV) ; Control-Z is same as EXIT DSPTAB (CON100,C$CONNECT,) ; CONNECT to terminal line DSPTAB (DFN000,C$DEFINE,) ;[107] Define set of parameters DSPTAB (EXI000,C$EXIT,) ; EXIT to monitor level DSPTAB (HLP000,C$HELP,) ; HELP command DSPTAB (LCL000,C$LOCAL,) ; LOCAL command DSPTAB (LOG000,C$LOG,) ; LOG command 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 DSPTAB (TAKFDB##,.KYTAK,) ;[111] Take command $ETAB SUBTTL Command 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 CON100: $NOISE (CON110,) TOPS20< CON110: $NUMBER (CONFRM,^D8,) >; End of TOPS20 conditional TOPS10< CON110: $DEV (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON120),$ERRPDB(CON120)>) CON120: $NODNM (CON130,,<$ALTERNATE(CON150),$ERRPDB(CON150)>) CON130: $NOISE (CON140,) CON140: $NUMBER (CONFRM,^D8,) CON150: $NUMBER (CONFRM,^D8,) >; End of TOPS10 conditional SUBTTL Command tables -- DEFINE command ;[107] Format: ;[107] DEFINE macro-name {List of set options} ;[107] DEFINE macro-name ! to delete macro definition DFN000: $NOISE (DFN010,) DFN010: $KEY (DFN020,DFNTAB,<$ALTERNATE(DFN030)>) DFN020: $CRLF (<$HELP(Confirm to delete macro)>) DFN030: $FIELD (SET001,) ;[107] Tables used during macro expansion SMC000: $KEY (SMC010,KER020) ;[107] Allow any command (can only be define anyway) SMC010: $NOISE (SMC020,) SMC020: $KEY (SET001,DFNTAB) ;[107] Allow any macro name then set options 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 -- LOG command LOG000: $KEY (LOG010,LOG001) LOG001: $STAB KEYTAB (DBGLOG,) KEYTAB (SESLOG,) KEYTAB (TRNLOG,) $ETAB LOG010: $NOISE (LOG020,) LOG020: $OFILE (LOG030,,$ALTERNATE(CONFRM)) LOG030: $SWITCH (CONFRM,LOG031,$ALTERNATE(CONFRM)) LOG031: $STAB KEYTAB (0,) $ETAB SUBTTL Command tables -- RECEIVE command RCV000: $NOISE (RCV010,) RCV010: $OFILE (CONFRM,,$ALTERNATIVE(CONFRM)) SUBTTL Command tables -- REMOTE command REM000: $KEYDSP (REM010) REM010: $STAB DSPTAB (REM080,<[XWD GETNFL,GC%COPY##]>,) ; Copy file DSPTAB (REM070,<[XWD GETPSW,GC%CONNECT##]>,) ; Change working directory DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,) ; Delete file DSPTAB (REM030,<[XWD 0,GC%DIRECTORY##]>,) ; Directory command DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,) ; Disk-usage report DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,) ; Delete file DSPTAB (CONFRM,<[XWD 0,GC%EXIT##]>,) ; Exit DSPTAB (REM050,<[XWD 0,GC%HELP##]>,) ; Help command DSPTAB (REM060,<[XWD 0,GC%COMMAND##]>,) ; Host command DSPTAB (REM100,<[XWD GETLGN,GC%LGN##]>,) ; Login DSPTAB (CONFRM,<[XWD 0,GC%LOGOUT##]>,) ; Logout command DSPTAB (REM090,<[XWD GETNFL,GC%RENAME##]>,) ; Rename file DSPTAB (REM120,<[XWD GETMSG,GC%SEND%MSG##]>,) ; Send message command DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,) ; Disk-usage report DSPTAB (CONFRM,<[XWD 0,GC%STATUS##]>,) ; Status command DSPTAB (REM020,<[XWD 0,GC%TYPE##]>,) ; Type file command DSPTAB (REM110,<[XWD GETOPT,GC%WHO##]>,) ; Who is logged in $ETAB ; LOCAL commands. Basically the same as the remote commands, the ;results are just typed locally instead of being transmitted. LCL000: $KEYDSP (LCL010) LCL010: $STAB DSPTAB (REM070,<[XWD 0,GC%CONNECT##]>,) ; Change path DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,) ; Delete file DSPTAB (REM030,<[XWD 0,GC%DIRECTORY##]>,) ; Directory command DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,) ; Disk-usage report DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,) ; Delete file DSPTAB (REM050,<[XWD 0,GC%HELP##]>,) ; Help command DSPTAB (REM070,<[XWD 0,GC%CONNECT##]>,) ; Set default path DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,) ; Disk-usage report DSPTAB (CONFRM,<[XWD 0,GC%STATUS##]>,) ; Status command DSPTAB (REM020,<[XWD 0,GC%TYPE##]>,) ; Type file command $ETAB ; Here for items which take a required file spec (Type and Delete) REM020: $NOISE (REM021,) REM021: $CTEXT (CONFRM,) ; Here for a directory command. Accept an optional file spec. REM030: $NOISE (REM031,) REM031: $CTEXT (CONFRM,,$ALTERNATE(CONFRM)) ; Here for a disk-usage and CWD commands REM040: $NOISE (REM041,) REM070: $NOISE (REM041,) REM041: $CTEXT (REM042,,$ALTERNATE(REM042)) REM042: $CRLF (<$HELP()>) ; Here for a help command REM050: $NOISE (REM051,) REM051: $CTEXT (CONFRM,,$ALTERNATE(CONFRM)) ; Here for a remote HOST command REM060: $CTEXT (CONFRM,) ; Here for copy and rename commands REM080: $NOISE (REM081,) REM090: $NOISE (REM081,) REM081: $CTEXT (CONFRM,) ; Here for login command REM100: $NOISE (REM101,) REM101: $CTEXT (CONFRM,) ; Here for WHO command REM110: $NOISE (REM111,) REM111: $CTEXT (CONFRM,,<$ALTERNATE(CONFRM)>) ; Here for send message REM120: $NOISE (REM121,) REM121: $CTEXT (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 ;[107] ;[107] Can be either a macro name or list of keyword/value pairs ;[107] SET000: $KEY (CONFRM,DFNTAB,<$ALTERNATE(SET001)>) SET001: $KEYDSP (SET010) ;[107] Return here after comma SET005: $COMMA (SET001,<$ALTERNATE(CONFRM)>) SET010: $STAB DSPTAB (BLK000,<[XWD CHKTYPE##,SETKYW]>,) DSPTAB (DBG000,<[EXP SETDBG]>,) DSPTAB (DEL000,<[XWD DELAY##,SETNUM]>,) DSPTAB (ESC000,<[EXP SETESC]>,) DSPTAB (FIL000,<[EXP SETFIL]>,) ;[115]; DSPTAB (FBS000,<[XWD FILTYP,SETKYW]>,) ;[115];TOPS10< DSPTAB (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,)>; End of TOPS10 DSPTAB (HSK000,<[EXP SETHSK]>,); [131] ;[133] 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 (PRM000,<[EXP SETPRM]>,) DSPTAB (SRC000,<[EXP SETRCV]>,) DSPTAB (RPT000,<[EXP SETRPT]>,) DSPTAB (RTY000,<[EXP SETRTY]>,) DSPTAB (SSN000,<[EXP SETSND]>,) DSPTAB (SSR000,<[XWD SRV%TIMEOUT##,SETNUM]>,) DSPTAB (XXP000,<[XWD XXPMOD,SETKYW]>,) ;[127] $ETAB SUBTTL Command tables -- SET command -- ON/OFF table ONOFF: $KEYDSP (ONOFFT) ONOFFT: $STAB DSPTAB (SET005,BLSFAL,) DSPTAB (SET005,BLSTRU,) $ETAB SUBTTL Command tables -- SET command -- incomplete-file ABT000: $NOISE (ABT010,) ABT010: $KEY (SET005,ABT01T) ABT01T: $STAB KEYTAB (BLSTRU,) KEYTAB (BLSFAL,) $ETAB SUBTTL Command tables -- SET command -- Block-check-type BLK000: $KEY (SET005,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 (SET005,<[XWD SETCDF,0]>,) DSPTAB (SET005,<[XWD SETDBF,BLSFAL]>,) DSPTAB (SET005,<[XWD SETDBF,BLSTRU]>,) $ETAB DBG010: $NOISE (DBG011,) DBG011: $OFILE (SET005,) SUBTTL Command tables -- SET command -- DELAY DEL000: $NOISE (DEL010,) DEL010: $NUMBER (SET005,^D10,,<$ACTION(CHKPOS)>) SUBTTL Command tables -- SET command -- ESCAPE ESC000: $NOISE (ESC010,) ESC010: $NUMBER (SET005,^D8,,<$DEFAULT(31)>) SUBTTL Command tables -- SET command -- FILE FIL000: $NOISE (FIL010,) FIL010: $KEYDSP (FIL020) FIL020: $STAB DSPTAB (FBS000,<[XWD FILTYP,SETKYW]>,) DSPTAB (FNM000,<[XWD FIL%NORMAL%FORM##,SETKYW]>,) TOPS10< DSPTAB (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,)>; End of TOPS10 $ETAB SUBTTL Command tables -- SET command -- FILE -- BYTE-SIZE FBS000: $NOISE (FBS010,) FBS010: $KEYDSP (FBS020) FBS020: $STAB DSPTAB (SET005,$FBS36,<36-bit>) ;[127] DSPTAB (SET005,$FBS7,<7-bit>) DSPTAB (SET005,$FBS8,<8-bit>) DSPTAB (SET005,$FBAUT,) DSPTAB (SET005,$FBS8,) DSPTAB (SET005,$FBS7,) DSPTAB (SET005,$FBS36,) ;[127] $ETAB SUBTTL Command tables -- SET command -- FILE -- BYTE-SIZE FNM000: $NOISE (FNM010,) FNM010: $KEYDSP (FNM020) FNM020: $STAB DSPTAB (SET005,FNM%FULL##,) DSPTAB (SET005,FNM%NORMAL##,) DSPTAB (SET005,FNM%UNTRAN##,) $ETAB SUBTTL Command tables -- SET command -- HANDSHAKE HSK000: $NOISE (HSK010,) ;[131] HSK010: $NUMBER (SET005,^D8,,<$DEFAULT(-1)>) ;[131] SUBTTL Command tables -- SET command -- Line LIN000: $NOISE (LIN010,) TOPS20< LIN010: $NUMBER (SET005,^D8,) >; End of TOPS20 conditional TOPS10< LIN010: $DEV (SET005,<$HELP(Name of terminal to use),$ALTERNATE(LIN020),$ERRPDB(LIN020)>) LIN020: $NODNM (LIN030,,<$ALTERNATE(LIN050),$ERRPDB(LIN050)>) LIN030: $NOISE (LIN040,) LIN040: $NUMBER (SET005,^D8,) LIN050: $NUMBER (SET005,^D8,,$ALTERNATE(SET005)) >; End of TOPS10 conditional SUBTTL Command tables -- SET command -- Message MSG000: $NOISE (MSG010,) MSG010: $KEY (MSG020,MSG030,<$ALTERNATE(MSG020)>) MSG020: $KEY (SET005,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 (SET005,PR%EVEN##,) DSPTAB (SET005,PR%MARK##,) DSPTAB (SET005,PR%NONE##,) DSPTAB (SET005,PR%ODD##,) DSPTAB (SET005,PR%SPAC##,) $ETAB SUBTTL Command tables -- SET command -- Prompt PRM000: $FIELD (SET005,,<$ALTERNATE(SET005),$BREAK(FILBRK)>) 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 (SET005,^D8,,<$ACTION(CHK8QU)>) REO000: $NOISE (REO010,) REO010: $NUMBER (SET005,^D8,,<$ACTION(CHKCTL)>) RPL000: $NOISE (RPL010,) RPL010: $NUMBER (SET005,^D10,,<$ACTION(CHKPKT)>) ; [134] RPC000: $NOISE (RPC010,) RPC010: $NUMBER (SET005,^D8,,<$ACTION(CHKPDC)>) RPD000: $NOISE (RPD010,) RPD010: $NUMBER (SET005,^D10,,<$ACTION(CHKPOS)>) RQU000: $NOISE (RQU010,) RQU010: $NUMBER (SET005,^D8,,<$ACTION(CHK8QU)>) RSH000: $NOISE (RSH010,) RSH010: $NUMBER (SET005,^D8,,<$ACTION(CHKSHC)>) RTI000: $NOISE (RTI010,) RTI010: $NUMBER (SET005,^D10,,<$ACTION(CHKTIM)>) SUBTTL Command tables -- SET command -- Repeat-quote RPT000: $NOISE (RPT010,) RPT010: $KEY (SET005,RPT011,<$ALTERNATE(RPT020)>) RPT011: $STAB KEYTAB (<" ">,) $ETAB RPT020: $NUMBER (SET005,^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 (SET005,^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 (SET005,^D8,,<$ACTION(CHKCTL)>) SPL000: $NOISE (SPL010,) SPL010: $NUMBER (SET005,^D10,,<$ACTION(CHKPKT)>) ; [134] SPC000: $NOISE (SPC010,) SPC010: $NUMBER (SET005,^D8,,<$ACTION(CHKPDC)>) SPD000: $NOISE (SPD000,) SPD010: $NUMBER (SET005,^D10,,<$ACTION(CHKPOS)>) SQU000: $NOISE (SQU010,) SQU010: $NUMBER (SET005,^D8,,<$ACTION(CHK8QU)>) SSH000: $NOISE (SSH010,) SSH010: $NUMBER (SET005,^D8,,<$ACTION(CHKSHC)>) STI000: $NOISE (RTI010,) STI010: $NUMBER (SET005,^D10,,<$ACTION(CHKTIM)>) SUBTTL Command tables -- SET SERVER-TIMER SSR000: $NOISE (SSR001,) SSR001: $NUMBER (SET005,^D10,) SUBTTL Command tables --SET command -- XON-XOFF-processing XXP000: $NOISE (XXP010,) ;[127] XXP010: $KEYDSP (XXP020) ;[127] XXP020: $STAB ;[127] DSPTAB (SET005,$XXDEF,) ;[127] DSPTAB (SET005,$XXLCL,) ;[127] DSPTAB (SET005,$XXREM,) ;[127] $ETAB 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,SHOMAC,) 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: PORTAL .+2 ; Allow EXO entry PORTAL .+2 ; Allow EXO entry 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 SY%INIT## ; Initialize KERSYS $CALL LOKINI## ; Initialize KERWLD data $CALL INIKER ; Initialize Kermit processing $CALL INITRM ; Initialize the terminal processing $CALL INIFIL ; Initialize the file processing ; Determine node number of central site TOPS10< MOVX S1, ; Get console's name WHERE S1, ; Determine location SETZ S1, ; Assume no network support HRRZM S1,HSTNOD ; Save host node number TXNE S1,RHMASK ; Network support on? SKIPA S1,[EXP [ITEXT(<^N/HSTNOD/::>)]] ; Yes, use node name MOVEI S1,[ITEXT(<>)] ; No, don't print node names MOVEM S1,HSTITX ; Save host name ITEXT address ; Determine if we are logged in. PJOB S1, ;[125] Get our job number MOVNS S1 ;[125] Set up for JOBSTS JOBSTS S1, ;[125] Get status for us MOVX S1,JB.ULI ;[125] If it doesn't work, this must be ancient TXNN S1,JB.ULI ;[125] Logged in? SETZ S1, ;[125] No, remember that MOVEM S1,LOGDIN ;[125] Save flag for file creation time > ; End of TOPS10 ; 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 SKIPN CCLOFS ; CCL Entry ? JRST PARL.0 ; Monitor entry, use rescan block >; End of TOPS10 conditional JRST PARL.1 ; 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? $CALL C$EXI0 ;[125] And exit 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 SETZM COM.CM(S1) ; And clear text pointer PARL.1: $CALL T$LOCAL ; Determine if we are a local or remote MOVEI S1,KER000 ; Assume remote SKIPF ; Are we? MOVEI S1,KER100 ; No, use local table MOVEM S1,PRBLK+PAR.TB ; Store it 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 CAIN S1,.KYTAK ;[111] Take command is special JRST PARLOP ;[111] It gets handled before the return $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: $CALL DEFPRM ; Default the prompt 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 ;[107] Now define any default macros. We will use a macro to do this. ;[107]Arguments to the macro are: ;[107]DFNMAC(macro.name,) ;[107] ;[107] Macro expansion must be a completely valid set of SET keywords/values ;[107] DEFINE DFNMAC(MNAME,MTEXT)< ...MNL==<...MTL==0> ;;[107] Clear length counters .XCREF ...MNL,...MTL ;;[107] No need to CREF these IRPC ,<...MNL==...MNL+1> ;;[107] Count characters in the name IRPC ,<...MTL==...MTL+1> ;;[107] And in the expansion text ...MTL==<6+1+...MNL+1+...MTL+2+5>/5 ;;[107] Length of full expansion in words ...MNL==<...MNL+5>/5 ;;[107] Get length of name in words (with null) ;;[107] Now generate the code to insert the items into the table MOVEI S1,$MBNAM+...MNL+...MTL ;;[107] Get the length of the block $CALL M%GMEM ;;[107] Get the memory we need STORE S1,$MBLEN(S2),MB$LEN ;;[107] Store the length of the block MOVEI S1,SETMAC ;;[107] Store the routine HRLI S1,(S2) ;;[107] And block address MOVEM S1,$MBRTN(S2) ;;[107] . . . MOVEI S1,...MNL+$MBNAM ;;[107] Store offset to expansion STORE S1,$MBOFS(S2),MB$OFS ;;[107] . . . MOVEI S1,$MBNAM(S2) ;;[107] Point at name storage HRLI S1,[ASCIZ |'MNAME'|] ;;[107] And at name text BLT S1,$MBNAM+...MNL-1(S2) ;;[107] Copy the name MOVEI S1,$MBNAM+...MNL(S2) ;;[107] Point at expansion storage HRLI S1,[ASCIZ |DEFINE MNAME MTEXT |] ;;[107] And at the text BLT S1,$MBNAM+...MNL+...MTL-1(S2) ;;[107] Copy it HRLI S2,$MBNAM(S2) ;;[107] Point at the name MOVEI S1,DFNTAB ;;[107] And at the table header $CALL S%TBAD ;;[107] Put the macro in the table JUMPF [$STOP(BMD,)] > ;[107] End of DFNMAC ;[107] ;[107] Now actually define our default macro(s) ;[107] ;[133] DFNMAC(IBM,) DFNMAC(IBM,) $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 MOVX S1,<> ;[125] Try INI:KERMIT.INI first MOVEM S1,INIFD+.FDSTR ;[125] for global defs MOVEI S1,INIFD ;[125] Get the FD address SETZ S2, ;[125] No log file FD $CALL P$TAKE ;[125] Set up the take JUMPF REDIN0 ;[125] If not there, don't worry about it MOVEM S1,INIIFN ;[125] Found the file, save the IFN $CALL PARL.1 ;[125] Parse the file SETZM INIIFN ;[136] Again assume no .INI file REDIN0: MOVX S1,<> ;[125] Now we will use MOVEM S1,INIFD+.FDSTR ;[125] DSK:KERMIT.INI[,] 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? ADDX S1, ; Back up the position JUMPG S1,.+2 ; Go over a word boundary? SUBX S1, ; Back to previous word 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: SKIPN S1,INIIFN ;[127] Have a KERMI.INI file? MOVE S1,CCLIFN ;[127] or anything else JUMPE S1,.RETT ;[127] All done if not SETO S2, ; Yes, position it to EOF $CALL F%POS ; . . . ABRT.0: SKIPN INIIFN ;[127] Unless doing KERMIT.INI SETZM CCLIFN ; Remember we have done this $RETT ; And return >; End of TOPS10 conditional SUBTTL Command parsing utility routines -- GETANS - Get an answer ; This routine will prompt the user and get his string answer. ; ; Usage: ; S1/ Echo flag,,address of prompt(as ITEXT) ; S2/ Length in chars,,address for answer ; $CALL GETANS ; (return true always, S1= Length of response in characters) ; ND ANSLEN, ^D40 ; Allow lots of room for answers GETANS: DMOVE T1,S1 ; Get the args MOVEI S1,.RDRTY+1 ; Get the length MOVEI S2,TXIBLK ; Get the address of the block $CALL .ZCHNK ; Clear it out MOVEI S1,ANSLEN ; Get the buffer length MOVEI S2,ANSBUF ; And the address $CALL .ZCHNK ; Clear it out MOVX S1,.RDRTY ; Get the last word we have MOVEM S1,TXIBLK+.RDCWB ; Save it MOVX S1,RD%TOP!RD%CRF!RD%JFN ; Get the flags TXNE T1,LHMASK ; Want no echo? TXO S1,RD%NEC ; Yes, flag that also MOVEM S1,TXIBLK+.RDFLG ; Store the flags MOVX S1, ; Get the JFN's for the terminal MOVEM S1,TXIBLK+.RDIOJ ; Save them MOVE S1,[POINT 7,ANSBUF] ; Get the buffer pointer MOVEM S1,TXIBLK+.RDDBP ; Save it for storing the prompt MOVX S1,-1 ; Get the length of the buffer MOVEM S1,TXIBLK+.RDDBC ; Save as initial count $TEXT(ANSDBP,<^I/(T1)/^A>) ; Get the prompt into the buffer MOVE S1,TXIBLK+.RDDBP ; Get the updated byte pointer MOVEM S1,TXIBLK+.RDBFP ; Save as start of destination buffer also $TEXT(<-1,,PRMPTB>,<^I/(T1)/^A^0>) ; Store in prompt buffer HRROI S1,PRMPTB ; Get the address of the buffer MOVEM S1,TXIBLK+.RDRTY ; Save it for ^R $CALL K%SOUT ; Output the string also MOVEI S1,TXIBLK ; Get the block address $CALL K%TXTI ; And do the TEXTI simulation TXNE T1,LHMASK ; No-echo flag? $TEXT (,<>) ; Yes, force a CRLF MOVE T1,TXIBLK+.RDBFP ; Get the pointer to the text we got HRLI T2,(POINT 7,) ; Get the destination byte pointer SETO S1, ; Clear the character counter GETA.L: ILDB S2,T1 ; Get a character CAXN S2,.CHLFD ; Line break? SETZ S2, ; Yes, change to a null IDPB S2,T2 ; Store the character AOJ S1, ; Count the character JUMPN S2,GETA.L ; And loop for more unless done $RETT ; And return ANSDBP: SOSLE TXIBLK+.RDDBC ; Count the character IDPB S1,TXIBLK+.RDDBP ; Store the character $RETT ; And return 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,^D1000 ; [134] 94 ; . . . 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 1000|] ; [134] $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: ADDX T1, ;; Back up the position JUMPG T1,.+2 ;; Go over a word boundary? SUBX T1, ; Back to previous word 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 S2,MYTERM ;[125] Point to the block $CALL T$SBRK ; Set the PIM mode break set MOVE S1,XXPMOD ;[127] Get XON-XOFF-processing CAIN S1,$XXDEF ;[127] Should we set it? JRST CNCT.2 ;[127] No, skip this MOVX T1,.TOPAG+.TOSET ;[127] want to set it MOVE T2,MYTERM+$TTUDX ;[127] and UDX CAIN S1,$XXLCL ;[127] Local mode? MOVEI T3,1 ;[127] Yes, turn page on CAIN S1,$XXREM ;[127] Remote mode? MOVEI T3,0 ;[127] Yes, turn page off MOVE S1,[XWD 3,T1] ;[127] TRMOP. S1, ;[127] do it JFCL ;[127] oh well MOVE T2,XFRTRM+$TTUDX ;[127] Also do Xfr line MOVE S1,[XWD 3,T1] ;[127] TRMOP. S1, ;[127] do it JFCL ;[127] oh well CNCT.2: ;[127] 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 ; Set up session log if desired SETZ P2, ; Assume no log file MOVE T1,SESLOG+$LGFLG ; Get flags TXNN T1,LG$SET ; Have one? JRST CN.LP ; No, just enter loop MOVX S1,FOB.MZ ; Yes, get size of FOB MOVEI S2,SESLOG+$LGFOB ; Point at FOB TXNE T1,LG$APP ; Want to append? $CALL F%AOPN ; Yes, do it TXON T1,LG$APP ; No, we will next time $CALL F%OOPN ; Create new file this time MOVEM S1,SESLOG+$LGIFN ; Save possible IFN TXO T1,LG$OPN ; Assume file opened OK MOVEM T1,SESLOG+$LGFLG ; Save new flags MOVE P2,S1 ; Get IFN in convenient place JUMPT CN.LP ; And go enter loop $KERR () SETZB P2,SESLOG+$LGFLG ; Give up on session log ; This the main CONNECT loop. Get chrs from terminal and ; send them down the data line and vice versa. ; Within this loop, P1 contains the state, P2 the IFN of the session log ;file (if any). 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 MOVE S2,S1 ;[125] Get a copy of the character ANDI S2,177 ;[125] Keep only 7 bits CAIN P1,"E" ; In escape sequence? JRST CN.ESC ; Yes CAIN P1,"C" ; control chr mode? JRST CN.CTL ; yes CAME S2,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 S2,"C" ; Is is C CAIN S2,"c" ; or lower case c? JRST CN.END ; Yes done MOVEI P1,"S" ; Assume not send control chr CAMN S2,ESCAPE ; Another escape? JRST CN.SND ; Yes, send a real one CAIN S2,"?" ; want help? JRST CN.HLP ; Yes, do it CAIE S2,"S" ; Want status? CAIN S2,"s" ; or lower case "s" JRST CN.STS ; Yes CAIE S2,"O" ; Clear buffers? CAIN S2,"o" ; . . . JRST CN.CLR ; Yes, go clear terminal buffers CAIE S2,"Q" ; Quit logging? CAIN S2,"q" ; . . . JRST CN.QUT ; Quit logging CAIE S2,"R" ; Resume logging CAIN S2,"r" ; . . . JRST CN.RSM ; Yes, do it CAIE S2,"^" ; Want control chr? JRST CN.ESE ; No, bad MOVEI P1,"C" ; Yes, set state JRST CN.LP ; and loop ; Here to ding the user because he typed a bad command CN.ESE: MOVX S1,.CHBEL ; Control-G $CALL CN.TYP ; DING JRST CN.LP ; And loop ; Quit logging CN.QUT: JUMPN P2,CN.QU1 ; Are we logging now? $TEXT (CN.TYP,<[^I/@HSTITX/Logging already disabled]>) JRST CN.LP ; Try again CN.QU1: $TEXT (CN.TYP,<[^I/@HSTITX/Logging disabled]>) SETZ P2, ; Flag no log JRST CN.LP ; And back to top of loop ; Resume logging to session log CN.RSM: MOVX S2,LG$OPN ; File open? TDNE S2,SESLOG+$LGFLG ; Is it? JRST CN.RS1 ; Yes, go get IFN $TEXT (CN.TYP,<[^I/@HSTITX/No log file open]>) JRST CN.LP ; No, back to top of loop CN.RS1: $TEXT (CN.TYP,<[^I/@HSTITX/Logging to file ^F/SESLOG+$LGFD/ resumed]>) MOVE P2,SESLOG+$LGIFN ; Yes, get the IFN JRST CN.LP ; Try next character ; 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.ESE ; No, ignore it CAIL S1,"`" ;[125] Lower case range? XORI S1,240 ;[125] Yes, toggle parity bit and convert to upper XORI S1,300 ;[125] Convert to control character JRST CN.SND ; and send it ; Process ? - give them some hints CN.HLP: $TEXT(CN.TYP,<^M^J^I/@HSTITX/CONNECT escape commands:>) ; $TEXT(CN.TYP,< ^T/ESCTXT/C - Close connect and return to local KERMIT>) ; $TEXT(CN.TYP,< ^T/ESCTXT/O - Clear terminal input and output buffer>) $TEXT(CN.TYP,< ^T/ESCTXT/Q - Turn off session logging (if enabled)>) ;[127] $TEXT(CN.TYP,< ^T/ESCTXT/R - Resume session logging after ^T/ESCTXT/Q>) ;[127] $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[^I/@HSTITX/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,<]>) JUMPE P2,CN.LP ; Session log open? $TEXT (CN.TYP,<[^I/@HSTITX/Logging session to ^F/SESLOG+$LGFD/]>) JRST CN.LP ; and loop ; Clear terminal buffers CN.CLR: MOVX T1,.TOCIB ; Clear input buffer MOVE T2,XFRTRM+$TTUDX ; Get UDX MOVE S1,[XWD 2,T1] ; Arg pointer TRMOP. S1, ; Clear input MOVE S1,[XWD 2,T1] ; Reload pointer MOVX T1,.TOCOB ; Clear output buffer also TRMOP. S1, ; Clear it JFCL ; Ignore error JRST CN.LP ; And loop back ; Send the chr in S1 down the data line CN.SND: BLSCAL GEN%PARITY##, ; Generate correct parity for other terminal 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 $CALL CN.PAR ; Tack on even parity bit unless PR%NONE XMOVEI S2,MYTERM ; Yes, output to our terminal also $CALL T$CCOT ; . . . CN.LOG: JUMPE P2,CN.LP ; If we echo it, log it also MOVE S2,S1 ; Get the character MOVE S1,P2 ; And the IFN $CALL F%OBYT ; Write the character JUMPT CN.LP ; Return to loop $TEXT (CN.TYP,<% Output error for log file - ^E/S1/, logging disabled>) SETZ P2, ; Disable the logging 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.LOG ; Go log the character (maybe) and try 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: MOVX S2,LG$OPN ; Log file open? TDNN S2,SESLOG+$LGFLG ; Is it? JRST CN.EN1 ; No, continue ANDCAM S2,SESLOG+$LGFLG ; Clear open flag MOVE S1,SESLOG+$LGIFN ; Get the IFN $CALL F%REL ; Close it CN.EN1: 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: $CALL CN.PAR ;[125] Tack on even parity bit if needed XMOVEI S2,MYTERM ; Point to the terminal block $CALL T$CCOT ; Output the character $RETT ; and return ;[125] Here to put even parity on a character. CN.PAR: MOVE S2,PARITY%TYPE## ;[125] Get the parity type CAIN S2,PR%NONE## ;[125] No parity? $RET ;[125] Yes, leave it alone ANDI S1,177 ;[125] Keep only 7 bits MOVEI S2,(S1) ;[125] Get a copy LSH S2,-4 ;[125] Shift back 4 bits XORI S2,(S1) ;[125] Combine halves TRCE S2,14 ;[125] Left bits both 0 TRNN S2,14 ;[125] Or both 1? XORI S1,200 ;[125] Yes, change high bit TRCE S2,3 ;[125] Right bits both zero TRNN S2,3 ;[125] Or both one? XORI S1,200 ;[125] Yes, change high bit $RET ;[125] All done SUBTTL Command execution -- DEFINE command ;[107] ;[107] This command allows definition (and deletion) of macros which ;[107]consist of options setable by the SET command. ;[107] ;[107] The table is a standard TBLUK table. The value stored in the ;[107]right halfword will be the address of the macro block. Each macro block ;[107]has the following format: ;[107] ;[107] XWD block address,SETMAC ;[111] So SET dispatch works ;[107] XWD offset to macro text,length of block in words ;[107] ASCIZ /macro name/ ;[107] ASCIZ /macro text/ ;[107] ;[107] These blocks are allocated using M%GMEM. C$DEFINE: $CALL P$KEYW ;[107] Get a keyword JUMPF DEFI.1 ;[107] If not a keyword, go get new definition ;[107] Here if we got a macro to delete. We must remove the keyword from ;[107]the table and delete the text storage. The storage is the keyword ;[107]value. First we must find the correct entry in the table. MOVE P1,S1 ;[107] Copy macro block address HRROI S2,$MBNAM(P1) ;[107] Point at macro name MOVEI S1,DFNTAB ;[107] And point to table $CALL S%TBLK ;[107] Lookup in table TXNN S2,TL%EXM ;[107] Must be exact match (we put it there) JRST [$KERR () ;[107] Give up $RETF] ;[107] Since table is screwed up MOVE S2,S1 ;[107] Get address of entry MOVEI S1,DFNTAB ;[107] Point at table $CALL S%TBDL ;[107] Delete the entry JUMPF [$KERR () ;[107] Couldn't? $RETF] ;[107] Then punt MOVE S2,P1 ;[107] Get the macro block address LOAD S1,$MBLEN(S2),MB$LEN ;[107] Get the length $CALL M%RMEM ;[107] Return the block $RETT ;[107] And return ;[107] Here to define a new macro DEFI.1: $CALL P$FLD ;[107] Must be a field here if not keyword $RETIF ;[107] Give up if not (should really be here) MOVE T2,S2 ;[107] Save the length (+1) MOVEI T1,PFD.D1(S1) ;[107] Point at the data MOVE S1,PRTARG+1 ;[107] Get the address of returned arguments MOVE S1,PRT.CM(S1) ;[107] Get the address of the command message ADD S1,COM.CM(S1) ;[107] And get offset to command string MOVEI T3,PFD.D1(S1) ;[107] Save the pointer LOAD S1,PFD.HD(S2),PF.LEN ;[107] Get the length of the text (+1) ADDI S1,$MBNAM-2(T1) ;[107] Get the length of the block we need $CALL M%GMEM ;[107] Get a block STORE S1,$MBLEN(S2),MB$LEN ;[107] Store the block length MOVEI S1,SETMAC ;[107] Get the address of the action routine HRLI S1,(S2) ;[107] Also save pointer to the block MOVEM S1,$MBRTN(S2) ;[107] Store it ADDI T2,$MBNAM-1 ;[107] Get offset to text STORE T2,$MBOFS(S2),MB$OFS ;[107] Store the offset $TEXT (<-1,,$MBNAM(S2)>,<^T/(T1)/^0^A>) ;[107] Move the name text ADDI T2,(S2) ;[107] Point at macro expansion storage $TEXT (<-1,,(T2)>,<^T/(T3)/^0>) ;[107] Store the string ;[107] Now insert the table entry MOVEI S1,DFNTAB ;[107] Point at the table header HRLI S2,$MBNAM(S2) ;[107] Get the entry value MOVE T1,S2 ;[107] Save copy just in case $CALL S%TBAD ;[107] Put it in $RETIT ;[107] If it went in ok, all done $KERR () ;[107] Couldn't do it? HRRZ S2,T1 ;[107] Point at macro block LOAD S1,$MBLEN(T1),MB$LEN ;[107] Get the length $CALL M%RMEM ;[107] Return it $RETF ;[107] And return ;[107] Macro expansion routine ;[107]This routine is called from the SET command processor when it is ;[107]given a macro name. We must now parse the text of the macro ;[107]expansion. ;[107] We enter with the macro block address in P1 SETMAC: STKVAR <> ;[107] Allocate the space for the args to parser MOVEI S1,SMC000 ;[107] Get address of initial macro expansion PDB MOVEM S1,PAR.TB+MPRDAT ;[107] Store it MOVEI S1,[ASCIZ ||] ;[107] No prompt MOVEM S1,PAR.PM+MPRDAT ;[107] . . . SETZM PAR.CM+MPRDAT ;[107] Let OPRPAR get a page LOAD S1,$MBOFS(P1),MB$OFS ;[107] Get offset to expansion of macro ADDI S1,(P1) ;[107] Point at the text MOVEM S1,PAR.SR+MPRDAT ;[107] Store the pointer MOVEI S1,PAR.SZ ;[107] Get the size of the block MOVEI S2,MPRDAT ;[107] And the address $CALL PARSER ;[107] And parse the expansion JUMPF [$KERR () $RETF] ;[107] Should never get an error, we did this once MOVE S1,PRT.CM(S2) ;[107] Get address of data MOVEM S1,PAR.CM+MPRDAT ;[107] Save the page so we know what to return ADDI S1,COM.SZ ;[107] Point at first word $CALL P$SETU ;[107] Set up for P$xxx routines $CALL P$KEYW ;[107] First field is a keyword $CALL P$KEYW ;[107] And another $CALL C$SET ;[107] Can now process set options MOVE S1,PAR.CM+MPRDAT ;[107] Get the address of the data page back $CALL M%RPAG ;[107] Return it $RETT ;[107] 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: SKIPN LOGDIN ;[125] Are we logged in? JRST [$TEXT (,<.KJOB^M^J.^A>) ;[125] No, make a nice message LOGOUT 1, ;[125] And quit JRST .+1] ;[125] Shouldn't really get here, but... $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$LOGOUT ; 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 $CALL CLRGEN ; Clear generic arguments BLSCAL (DO%GENERIC##,<[EXP GC%EXIT##]>) $CALL CLSTRM ; Close the terminal $RETT ; Give a good return ; Subroutine to clear generic arguments CLRGEN: SETZM GEN%1SIZE## ; No first argument SETZM GEN%2SIZE## ; Nor second SETZM GEN%3SIZE## ; Or third MOVEI S1,/5 ; Get length of arguments MOVEI S2,GEN%1DATA## ; First buffer address $CALL .ZCHNK ; Clear it MOVEI S1,/5 ; Get length of arguments MOVEI S2,GEN%2DATA## ; First buffer address $CALL .ZCHNK ; Clear it MOVEI S1,/5 ; Get length of arguments MOVEI S2,GEN%3DATA## ; First buffer address $CALL .ZCHNK ; Clear it $RETT ; Return SUBTTL Command execution -- LOG command ;+ ;.hl1 C$LOG ; This routine will store the file specification for various log files. ;- C$LOG: $CALL P$KEYW ; Next item should be a keyword MOVE P1,S1 ; Save the address of the storage $CALL P$OFIL ; Now we want an output file spec JUMPT LOG.1 ; If we got one, go store it ; Here for LOG keyword . This means we no longer want the ;specified log file. SETZM $LGFLG(P1) ; Clear flags to indicate no file $RETT ; And return ; Here with S1 pointing at FD returned from P$OFIL. Copy the FD to ;the correct storage. LOG.1: ADDI S2,$LGFD(P1) ; Point at end of FD HRLI S1,(S1) ; Set up pointer to move FD HRRI S1,$LGFD(P1) ; . . . BLT S1,-1(S2) ; Copy it $CALL P$SWITCH ; Get a switch SKIPT ; Get something? SETZ S1, ; No, get a zero TXO S1,LG$SET ; Flag we have the file spec MOVEM S1,$LGFLG(P1) ; Store the flags $RETT ; And 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 $CALL CLRGEN ; Clear the generic args 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 -- REMOTE command ;+ ;.HL1 C$REMOTE ;This routine will parse the REMOTE command. It will set up the ;correct arguments and call KERMSG to handle the generic command. ;- C$REMOTE: $CALL T$LOCAL ; Is this my terminal? JUMPT [$KERR() $RETF] ; And return $CALL CLRGEN ; Clear the generic args $CALL P$KEYW ; Get a keyword $RETIF ; Should really be there MOVE P1,(S1) ; Get the command type (arg for DO_GENERIC) $CALL P$TEXT ; Get some text JUMPF REMO.2 ; If none, go do the command ADD S1,[POINT 7,PFD.D1] ; Point at the data MOVE S2,[POINT 7,GEN%1DATA##] ; Point at where to store it REMO.1: ILDB T1,S1 ; Get a character IDPB T1,S2 ; Store it AOS GEN%1SIZE## ; Count it JUMPN T1,REMO.1 ; And copy all the characters SOS GEN%1SIZE## ; Don't count the null ; If more arguments are needed, get them HLRZ S1,P1 ; Get routine address JUMPE S1,REMO.2 ; Any routine to call? SKIPE GEN%1SIZE ; If no first arg, don't need rest $CALL (S1) ; Yes, do it ; Here to request KERMSG to perform the command. REMO.2: $CALL OPNTRM ; Open the terminal $RETIF ; Just return if this fails TXZ P1,LHMASK ; Clear any left half data BLSCAL (DO%GENERIC##,) $CALL CLSTRM ; Close the terminal $RETT ; Give a good return ; Subroutines to get arguments. ; Get login information GETLGN: MOVEI S1,[ITEXT()] ; Get the prompt, echo input MOVE S2,[XWD MAX%MSG##,GEN%3DATA##] ; Point at storage $CALL GETANS ; Get the result MOVEM S1,GEN%3SIZE## ; Store size ; PJRST GETPSW ; And get password ; Get a password. This is done with no echo. The password is put in ; GEN%2DATA. ; Get message for short send GETPSW: SKIPA S1,[XWD -1,[ITEXT()]] ; Point at the prompt, no echo GETMSG: MOVEI S1,[ITEXT()] ; Get the prompt GET2GN: MOVE S2,[XWD MAX%MSG##,GEN%2DATA##] ; Point at buffer $CALL GETANS ; Get the result MOVEM S1,GEN%2SIZE## ; Store size we got $RETT ; And return ; Get a new file specification ; Get options for "finger" GETNFL: SKIPA S1,[XWD 0,[ITEXT()]] ; Get the prompt GETOPT: MOVEI S1,[ITEXT()] ; Get the prompt for options JRST GET2GN ; Go get the second argument SUBTTL Command execution -- LOCAL command ;+ ;.HL1 C$LOCAL ;This routine will parse the LOCAL command. It will set up the ;correct arguments and call SY%GENERIC to generate the text. ;The resulting text will then be typed on the terminal. ;- C$LOCAL: $CALL CLRGEN ; Clear the generic args $CALL P$KEYW ; Get a keyword $RETIF ; Should really be there MOVE P1,(S1) ; Get the command type (arg for DO_GENERIC) $CALL P$TEXT ; Get some text JUMPF LOCA.2 ; If none, go do the command ADD S1,[POINT 7,PFD.D1] ; Point at the data MOVE S2,[POINT 7,GEN%1DATA##] ; Point at where to store it LOCA.1: ILDB T1,S1 ; Get a character IDPB T1,S2 ; Store it AOS GEN%1SIZE## ; Count it JUMPN T1,LOCA.1 ; And copy all the characters SOS GEN%1SIZE## ; Don't count the null LOCA.2: SETZM LCLSIZ ; Make sure these are clear now SETZM LCLRTN ; . . . BLSCAL SY%GENERIC##, ; Generate result CAXN S1,RMS32 ; File processing error? $RETF ; Yes, just give up, error already typed TXNN S1,BLSTRU ; Good result? JRST [$KERR(Unimplemented local command) $RETF] ; Punt SKIPN LCLSIZ ; Have a string result? JRST LOCA.3 ; No, check for routine $TEXT (,<^T/@LCLSTR/>) ; Yes, type it $RETT ; And return ; Here if we did not get a string result. Check if we have a routine ;to call for each character. LOCA.3: SKIPE LCLRTN ; Have one? JRST LOCA.4 ; Yes, go handle it ; Here if we have a file to type. The file spec is in FILE%NAME, all ;set up for FILE%OPEN to open it up. Just open it and then type ;the file. $SAVE ; Save type files flag SETZB S1,TY%FIL## ; Want to read the file BLSCAL FILE%OPEN, TXNN S1,BLSTRU ; Error? $RETF ; Yes, should have been typed already MOVEI S1,GET%FILE ; Now use get file to fetch chars TXO S1,1B0 ; Remember file is open MOVEM S1,LCLRTN ; Save the address ; Here to fetch characters and type them LOCA.4: BLSCAL @LCLRTN,<[EXP LCLCHR]> ; Get a character TXNE S1,BLSTRU ; Error? CAIN S1,EOF ; End of file? JRST LOCA.5 ; Yes, assume EOF OUTCHR LCLCHR ; Type it JRST LOCA.4 ; Keep looping until eof ; Here when all has been typed, close file (if necessary), and return LOCA.5: SKIPL LCLRTN ; Need to close a file? $RETT ; No, all done BLSCAL FILE%CLOSE,<[EXP 0]> ; Close the file $RETT ; And 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 FILE%SIZE## ; Flag we will accept whatever we get 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 ;[126];@C$RECEIVE + 9 HRROS USRFX+.FDEXM ;[126] . . . 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.] | ;[127] 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 CAIN S1,SETMAC ;[107] Macro setting is special PJRST (S1) ;[107] We just go there $CALL (S1) ; Call the correct routine $CALL P$COMMA ;[107] Check for a comma JUMPT C$SET ;[107] If we get one, we have another keyword $RETT ;[107] 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 -- SETNUM - Parse a number ;+ ;.HL2 SETNUM ;This routine is used for the various SET commands that take only a ;numeric value. ;It will then store the information into the address pointed to by P1. ;- SETNUM: $CALL P$NUM ; Get the number supplied $RETIF ; Return if there is no number 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: $CALL P$OFIL ; Get an output file FD HRLI S1,(S1) ; Set up pointer to copy file HRRI S1,DBGLOG+$LGFD ; Point at destination ADDI S2,DBGLOG+$LGFD ; And final word BLT S1,-1(S2) ; Copy block MOVX S1,LG$SET!LG$APP ; Get the flags MOVEM S1,DBGLOG+$LGFLG ; Save them MOVX S1,BLSTRU ; Get a true MOVEM S1,DEBUG%FLAG## ; Save it so debugging runs $RETT ; And return ; Here for SET DEBUGGING NO-LOG-FILE. SETCDF: MOVX S1,BLSFAL ; Flag it as false MOVEM S1,DEBUG%FLAG## ; Store it SETZM DBGLOG+$LGFLG ; No log file anymore $RETT ; And return ;+ ;.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 -- FILE parameters ;+ ; This will handle the dispatch of the SET FILE command. ;- SETFIL: $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 ; And return SUBTTL Command execution -- SET command -- HANDSHAKE ;+ ;[131] This routine will set up the IBM handshaking character ;- SETHSK: $CALL P$NUM ;[131] Get the number CAIN S1,"" ;[131] Is it a NULL JRST SETHS0 ;[131] Yes, set default value CAIG S1,"" ;[131] Is it a negative number JRST SETHS1 ;[131] Yes, give error MOVEM S1,IBM%CHAR## ;[131] Move in Handshake character $RETT ;[131] True return SETHS0: SETOM IBM%CHAR## ;[131] Move in default character $RETT ;[131] True return SETHS1: $KERR (Illegal handshake character ^O/S1/) ;[131] $RETF ;[131] 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 ; 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 -- PROMPT ;+ ;.HL2 SETPRM ;This routine will set the user prompt. This is used to allow the user ;to set how he/she wants Kermit to prompt for commands. This allows you ;to be connected through various Kermits and always keep which wants input ;straight. ;- SETPRM: $CALL P$FLD ; Parse an unquoted string JUMPF DEFPRM ; Failed, so reset the prompt ; ; Here to copy the new prompt to the low segment ; CAXLE S2,D$PSIZ ; Smaller than max? $RETF ; Don't set it if it is ADD S1,[POINT 7,PFD.D1] ; Point to the data SPRM.0: MOVE T1,[POINT 7,PROMPT] ; Point to the prompt area SPRM.1: ILDB S2,S1 ; Get a character IDPB S2,T1 ; Store it JUMPN S2,SPRM.1 ; Loop for all characters $RET ; Return to the caller DEFPRM: MOVE S1,[POINT 7,[ASCIZ /Kermit-10>/]] ; Get the prompt JRST SPRM.0 ; Join common code 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,^D1000 ; [134] 94 ; 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,^D1000 ; [134] 94 ; 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 $CALL SHOMAC ; Show the defined macros $TEXT (,<>) ; And a CRLF $RETT ; Give a good return SUBTTL Command execution -- SHOW command -- SHOW MACROS ;+ ;.hl2 SHOMAC ; This routine will list all defined macros. ;See definition of macro blocks in header of routine C$DEFINE ;- SHOMAC: HLRZ P1,DFNTAB ; Get the count of defined macros JUMPE P1,[$TEXT (,< No defined macros>) ; If nothing, say so $RETT] ; And return MOVN P1,P1 ; Negate the count HRLI P1,DFNTAB+1 ; Build the pointer MOVS P1,P1 ; . . . $TEXT (,< Macros:>) ; Say what we are typing SHOM.1: HRRZ S1,(P1) ; Get the macro block address LOAD S2,$MBOFS(S1),MB$OFS ; Get offset to string ADD S1,S2 ; Point at it $TEXT (,< ^T/(S1)/^A>) ; Type the definition (includes name and CRLF) AOBJN P1,SHOM.1 ; Loop for all macros $RETT ; And 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 (,) MOVEI S1,DBGLOG ; Point at debugging log info MOVEI S2,[ASCIZ |Debugging|] ; And the text $CALL SDEB.1 ; Type out if necessary MOVEI S1,SESLOG ; Point at session info MOVEI S2,[ASCIZ |Session|] ; And text $CALL SDEB.1 ; Type it MOVEI S1,TRNLOG ; And transaction log MOVEI S2,[ASCIZ |Transaction|] ; And its text ; PJRST SDEB.1 ; Type it out SDEB.1: MOVE TF,S2 ; Copy text to type MOVE S2,$LGFLG(S1) ; Get log file flags TXNN S2,LG$SET ; File set? $RETT ; No, just return TXNE S2,LG$APP ; Want to append to it? SKIPA S2,[[ASCIZ |/Append|]] ; Yes, get the switch MOVEI S2,[ASCIZ ||] ; No, no switch $TEXT (,<^T/@TF/ log file is ^F/$LGFD(S1)/^T/(S2)/>) ; 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 (,) MOVEI S1,[ASCIZ |Unknown|] ; Unkown file naming MOVE S2,FIL%NORMAL%FORM## ; Get the file name type CAIN S2,FNM%NORMAL## ; Normalized file names? MOVEI S1,[ASCIZ |Normal form|] ; Yes, use that CAIN S2,FNM%FULL## ; Full file specs? MOVEI S1,[ASCIZ |Full|] ; Yes, say so CAIN S2,FNM%UNTRAN## ; Untranslated? MOVEI S1,[ASCIZ |Untranslated|] ; Yes, get the text $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 ;[133] MOVE S1,IBM%FLAG## ; Get the flag ;[133] $CALL TONOFF ; Get the value ;[133] $TEXT (,< IBM-mode: ^T/(S1)/^A>) MOVE S1,IBM%CHAR## ; Get the IBM hand shake character $CALL CHITXT ; Get the text for it ;[133] $TEXT (,<, Handshake: ^T/.TEMP/>) $TEXT (,< Handshake: ^T/.TEMP/>) MOVE S1,PARITY%TYPE## ; Get the parity type ;[133] MOVE S2,IBM%FLAG## ; Get the IBM flag ;[133] 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/>) MOVE S1,XXPMOD ;[127] get XON-XOFF-processing CAIN S1,$XXDEF ;[127] Default? MOVEI S2,[ASCIZ /default/] ;[127] CAIN S1,$XXLCL ;[127] Local? MOVEI S2,[ASCIZ /local/] ;[127] CAIN S1,$XXREM ;[127] Remote? MOVEI S2,[ASCIZ /remote/] ;[127] $TEXT (,< XON-XOFF-processing: ^T/(S2)/>) ;[127] $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/SRV%TIMEOUT##/ 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: MOVEI S1,T%TTY ; Output to terminal $CALL WRTSTS ; Do totals $TEXT (,<^M^JTotals for the last transfer>) MOVE T1,XFR%TIME## ; Get the total time spent IDIVX T1,^D<60*60*1000> ; Get hours IDIVX T2,^D<60*1000> ; Minutes IDIVX T3,^D1000 ; Seconds and milliseconds MOVE S1,XFR%TIME## ; Also get IDIVI S1,^D1000 ; As seconds and milliseconds $TEXT (,< Last transfer time ^D/T1/:^D2R0/T2/:^D2R0/T3/.^D3R0/T4/(^D/S1/.^D3R0/S2/ seconds)>) $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 ; All done ; Here to write total values. This is also used for generic status command. WRTSTS::$SAVE ; Save P1 MOVE P1,S1 ; Get the output routine $TEXT (@P1,<^M^JTotals since Kermit was started>) MOVE T1,TOTAL%TIME## ; Get the total time spent IDIVX T1,^D<60*60*1000> ; Get hours IDIVX T2,^D<60*1000> ; Minutes IDIVX T3,^D1000 ; Seconds and milliseconds MOVE S1,TOTAL%TIME## ; Also get IDIVI S1,^D1000 ; As seconds and milliseconds $TEXT (@P1,< Total transfer time ^D/T1/:^D2R0/T2/:^D2R0/T3/.^D3R0/T4/(^D/S1/.^D3R0/S2/ seconds)>) $TEXT (@P1,< Characters sent ^D/SND%TOTAL%CHARS##/>) $TEXT (@P1,< Characters received ^D/RCV%TOTAL%CHARS##/>) $TEXT (@P1,< Data characters sent ^D/SND%DATA%CHARS##/>) $TEXT (@P1,< Data characters received ^D/RCV%DATA%CHARS##/>) $TEXT (@P1,< NAKs sent ^D/SND%NAKS##/>) $TEXT (@P1,< NAKs received ^D/RCV%NAKS##/>) $TEXT (@P1,< Total packets sent ^D/SND%COUNT/>) $TEXT (@P1,< Total packets received ^D/RCV%COUNT/>) SKIPN T2,TOTAL%TIME## ; Get the amount of time JRST WRTS.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 (@P1,< Effective data rate: ^D/T1/ baud>) WRTS.0: LDB S1,[POINT 7,LAST%ERROR##] ; Check if any error text JUMPE S1,WRTS.1 ; If none, don't type line $TEXT (,<^M^JLast error: ^T/LAST%ERROR/>) WRTS.1: $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. SKIPN LOGDIN ; Are we logged in? JRST [KERERR () ;[125] No, don't write files now BLSRET RMS32] ;[125] So we don't compromise security 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] MOVE S1,FILTYP ; Get the file type we are using CAXE S1,$FBS8 ; 8-bit file? IFE .IOASC, ; No, Use ASCII mode IFN .IOASC, ; No, Use ASCII mode MOVX S1,.IOBIN ; Yes, use binary mode MOVEM S1,FLP+.FOIOS ; Store the mode 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 T4,ELB+.RBPPN ;[125] Remember path or PPN in case of failure 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: MOVEM T4,ELB+.RBPPN ;[125] Reset path or PPN so file goes correct place 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 SKIPGE P1 ;[130] Skip if first pass $TEXT (,) ;[130] Give prompt 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 MOVE S2,FIL%NORMAL%FORM## ; Get name type CAIE S2,FNM%FULL## ; Full file specs? JRST OPNRE8 ; No, use short name $TEXT (FILSTO,<^W/FLP+.FODEV/:^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^A>) SKIPN FPTH+.PTPPN ; Is there a PPN? JRST OPNRE5 ; No, finish up and return $TEXT (FILSTO,<[^O/FPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>) MOVSI S1,-5 ; Get the number of SFDs possible OPNRE6: SKIPN FPTH+.PTSFD(S1) ; Finished? JRST OPNRE7 ; Yes, close off $TEXT (FILSTO,<,^W/FPTH+.PTSFD(S1)/^A>) ; Type the SFD AOBJN S1,OPNRE6 ; Loop for all SFDs OPNRE7: $TEXT (FILSTO,<]^A>) ; Type the closing bracket OPNRE5: $TEXT (FILSTO,<^0>) ; Store final null JRST OPNRE9 ; And go set up pointers OPNRE8: $TEXT (FILSTO,<^W/ELB+.RBNAM/.^W/ELB+.RBEXT,LHMASK/^0>) ; Now set up the correct size byte pointers. OPNRE9: 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 File processing -- 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 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 File processing -- Routine to convert FX 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 HRRZS (T2) ; Clear left half of 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 CAXE S1,$FBS36 ;[127][136] Is this 36 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 CAXN S2,$FBS36 ;[127][136] 36 bit? TRNN S1,200 ;[136] Yes, 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 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 PRSD.0 ; 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,PRSD.0 ; 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 ; ; Usage: ; S1/ Byte pointer to text ; S2/ Address of FD ; $CALL PRSDIR ; ; or ; ; P1/ byte pointer to text ; P2/ Address of FD ; $CALL PRSD.0 ; PRSDIR::$SAVE ; Save two registers DMOVE P1,S1 ; Copy the arguments $CALL INPCH$ ; Get a character CAIE S1,"[" ; Open bracket? CAIN S1,.CHLAB ; Other type? JRST PRSD.0 ; Good bracket $RETF ; Error return PRSD.0: 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 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 ; Now check if we have a logical device KERMIT:. If we do, that is our default ;transfer device. MOVX S1, ; Get the name DEVNAM S1, ; Check if it exists JRST INIT.1 ; No, leave things as they are MOVE S2,S1 ; Get a copy DEVCHR S2, ; Make sure it is a terminal TXNN S2,DV.TTY ; Is it? JRST [$KERR (Device KERMIT: is not a terminal, using TTY: instead) JRST INIT.1] ; Just continue using console MOVEM S1,XFRTRM+$TTDEV ; And also here IONDX. S1, ; Get the UDX for the terminal JRST INIT.1 ; Should never fail, since DEVCHR worked GTNTN. S1, ; Get the node and line number SUBI S1,.UXTRM ; Can only fail because no network support HRRZM S1,XFRTRM+$TTLIN ; Store the line number HLRZM S1,XFRTRM+$TTNOD ; Store the node number INIT.1: >; End of TOPS10 conditional SETZM LCLECH ; Default is no local echo MOVX S1,$XXDEF ;[127] Get default for XON-XOFF MOVEM S1,XXPMOD ;[127] and store it $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 ; Now open any debugging log file MOVE T1,DBGLOG+$LGFLG ; Get flags for debug file TXNN T1,LG$SET ; Check if file is set $RETT ; No, nothing to open MOVX S1,FOB.MZ ; Get length of FOB MOVEI S2,DBGLOG+$LGFOB ; Point at FOB TXNE T1,LG$APP ; Want to append to file? $CALL F%AOPN ; Yes, do it TXON T1,LG$APP ; Next time we will want to append $CALL F%OOPN ; Even if we created file this time MOVEM S1,DBGLOG+$LGIFN ; Save the IFN TXO T1,LG$OPN ; Flag file is open MOVEM T1,DBGLOG+$LGFLG ; Save new flags $RETIT ; If we got the file open, continue $KERR () SETZM DBGLOG+$LGFLG ; Ignore log file from now on $RETT ; Give a good return ; Here to reset the terminal for commands (KLUDGE for GLXLIB) OCTERM: MOVX S1,1B0!1B1 ;[136] Open controlling terminal in image mode PJRST K%OPEN## ;[136] and go re-open the terminal ;[136]; $RETT ;[135] Skip this for now. It appears ;[136]; ;[135] that GLXLIB has been fixed. 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 ; ; Close the debugging log (if any) MOVE T1,DBGLOG+$LGFLG ; Get the flags TXZN T1,LG$OPN ; File open? $RETT ; No, just return MOVEM T1,DBGLOG+$LGFLG ; Save new flags MOVE S1,DBGLOG+$LGIFN ; Yes, get the IFN $CALL F%REL ; Close the file $RETT ; And return 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 ;[112] First clear the input buffer to dump any junk which showed up since ;[112] we last received a message. MOVX T1,.TOCIB ;[112] Clear input buffer function MOVE T2,XFRTRM+$TTUDX ;[112] Get the UDX for the transfer terminal MOVE S1,[XWD 2,T1] ;[112] Point at arguments TRMOP. S1, ;[112] Clear the buffer CLRBFI ;[112] Assume using console terminal 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 TOPS10< $CALL SETTMR ; Set the timer RECEI0: 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 $CALL RECSUB ; Get a character $RETIF ; Give up if failed 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 CAIE S2,.CHCNC ; Control-C? JRST RECEI0 ; Not a character we are interested in, RECEIC: $CALL RECSUB ; Get a character $RETIF ; Give up on failure ANDI S1,^O177 ; Strip the parity bit MOVE S2,S1 ; Get a copy CAMN S2,RCV%SOH## ; Start of packet? JRST RECEI1 ; Yes, go read the packet CAIE S2,.CHCNC ; Control-C? JRST RECEI0 ; No, just eat it BLSRET ABORTED ; Yes, give up 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? JRST RECEIC ; Yes, go see if we get a second 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: $CALL RECSUB ; Get a character $RETIF ; Just pass back errors 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 SEND%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 ; Subroutine to get a character and handle timing RECSUB: XMOVEI S2,XFRTRM ; Point to the argument block $CALL T$CIN ; Attempt to read a character JUMPF RECS.1 ; If error, go check it out MOVE S2,PARITY%TYPE## ; Get the type CAIE S2,PR%NONE## ; No parity? ANDI S1,^O177 ; No, strip parity bit $RET ; Pass back true return RECS.1: $CALL RECEIE ; Check out error TXNN S1,BLSTRU ; Some type of error? $RET ; Yes, give up (passing back failure) JRST RECSUB ; Try again 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,.CHCRT ; Carriage return? CAXN S1,.CHCNA ; Control-A? JRST CHKKB2 ; Yes, go set flag and give correct return CAXN S1,.CHCND ; Control-D? XORM S2,DEBUG%FLAG## ; Yes, toggle debugging 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 CAXN S1,.CHCNA ; Control-A? MOVEM S2,TYP%STS%FLAG## ; Flag that user wants some info CAXN S1,.CHCND ; Control-D? XORM S2,DEBUG%FLAG## ; Yes, toggle debugging CAXN S1,.CHCRT ; Carriage return? SETOM TIMLIM ; Yes, force immediate timeout 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 SEND%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,SEND%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 ;[134] MOVX S1,-1 ; Assume defaults ;[134] 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 MOVEI S2,MAX%MSG##/4+1 ;[134] ; Get maximum message size PUSH P,S2+1 ; [134] IDIVI S2,-3(S1) ; [134] ; Compute no of buffers (3 word header) POP P,S2+1 ; [134] ADDI S2,1 ; [134] ; Result was truncated, add a buffer HRL S2,S2 ; [134] ; Set up for both input and output MOVEM S2,FLP+.FONBF ; [134] ; Store 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 SETOM TRMOPN ; Transfer terminal is now open ;[133] MOVE S1,IBM%FLAG## ; IBM mode? ;[133] TXNN S1,BLSTRU ; . . . ;[133] $RETT ; No, all done MOVE S1,IBM%CHAR## ; Yes, get the character CAXL S1,.CHNUL ;[133] Is it a character? 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 SETZM TRMOPN ; Transfer terminal now closed 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 CAXE S1,<> ; Non-network system? JRST TCON.E ; No, some other error 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? TCON.E: $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 ;[133] MOVE S1,IBM%FLAG## ; Check if we are talking to IBM MOVE S1,IBM%CHAR## ;[133] See if we are talkng to IBM CAXGE S1,.CHNUL ;[133] Are we? TDZA S1,S1 ; No, no additional break char 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,BLSTRU ; Determine if connected TDNN S1,CONNECT%FLAG## ; Are we? $TEXT (,<^T/@BUFFER/^A>) ; No, type it $RET ; And return BLSRTN(DBG%DUMP,) $SAVE ; Save a few registers MOVX S2,LG$OPN ; Is the debugging log open? TDNE S2,DBGLOG+$LGFLG ; . . . JRST TRMD.1 ; Yes, just dump the buffer MOVE S2,CONNECT%FLAG## ; Get the flag TXNN S2,BLSTRU ; 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,DBGLOG+$LGIFN ; 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,DBGLOG+$LGIFN ; Get the IFN back MOVX S2,LG$OPN ; Get the open flag ANDCAM S2,DBGLOG+$LGFLG ; Flag file not open 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>,) ; 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>,) ; Write the text ; Here to count the characters and call the BLISS routine to write the ; error packet to the remote KRERR: SKIPN TRMOPN ; Transfer terminal open? JRST [$TEXT (,<^T/MSGTXT/>) ; No, just type the error message BLSRET ABORTED] ; And punt 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:! HSTNOD::BLOCK 1 ; Host node number HSTITX::BLOCK 1 ; Host node ITEXT string XITFLG: BLOCK 1 ; Exit flag PRTARG: BLOCK 2 ; Saved parser information PRBLK: BLOCK PAR.SZ ; Parser interface block PROMPT: BLOCK D$PSIZ ; User prompt TXIBLK: BLOCK .RDRTY+1 ; TEXTI block ANSBUF: BLOCK ANSLEN ; Answer buffer PRMPTB: BLOCK ANSLEN ; Prompt buffer TOPS10< LOGDIN::BLOCK 1 ;[125] Flag if we are logged in 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 ; LOCAL command processing storage LCLSTR: BLOCK 1 ; Address of string to type LCLSIZ: BLOCK 1 ; Size of string LCLRTN: BLOCK 1 ; Address of get a char routine LCLCHR: BLOCK 1 ; Location to fetch character into ; Terminal I/O information TOPS10< TIMLIM: BLOCK 1 ; Time out time JIFSEC::BLOCK 1 ; Number of jiffies per second >; End of TOPS10 conditional TRMOPN: BLOCK 1 ; Transfer terminal open ESCAPE: BLOCK 1 ; CONNECT escape character ESCTXT: BLOCK 1 ; Escape character in ASCII LCLECH: BLOCK 1 ; Local echo flag XXPMOD: BLOCK 1 ;[127] XON-XOFF-processing 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 ; Blocks for log files DEFINE LGBLK(NAM)< NAM'LOG: $BUILD $LGSIZ ; Build an LG block $SET $LGFLG,,0 ; No flags (file no set) $SET $LGFOB+FOB.CW,FB.BSZ,7 ; Byte size $SET $LGFOB+FOB.FD,,NAM'LOG+$LGFD ; Address of FD $EOB ; End of block > ; End of LGBLK macro definition ; Now expand the macro for each type of log file LGBLK(DBG) ; Debugging log file LGBLK(SES) ; Session log file LGBLK(TRN) ; Transaction log file ; FOB for debugging file DBFFOB: $BUILD FOB.MZ ; Build an FOB $SET FOB.CW,FB.BSZ,7 ; Byte size $EOB ; End of block ;[107] Macro name table for DEFINE/SET DFNTAB: XWD 0,D$MAXD ;[107] Current number, maximum BLOCK D$MAXD ;[107] Leave the space 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>