home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
k10mit-135.tar.gz
/
k10mit-135.tar
/
k10mit-135
/
k10mit.mac
< prev
next >
Wrap
Text File
|
2001-06-19
|
183KB
|
5,603 lines
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==135 ; 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 Art Krewat/AAK On: 18-Jun-2001
CAX macros under TOPS-10 7.03 didn't work for full-words,
so I changed them to CAM or CAI where appropriate.
MOVX macros appear to work correctly.
Modules: K10MIT
|
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>) ; CONTINUE command
DSPTAB (MON040,KERCMD,<KERMIT>) ; KERMIT command
DSPTAB (MON030,SHOVER,<RUN>) ; RUN command
DSPTAB (MON030,IGNORE,<START>) ; 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>) ; Bye command
DSPTAB (CON000,C$CONNECT,<Connect>) ; CONNECT to terminal line
DSPTAB (DFN000,C$DEFINE,<Define>) ;[107] Define set of parameters
DSPTAB (EXI000,C$EXIT,<Exit>) ; EXIT to monitor level
DSPTAB (FIN000,C$FINISH,<Finish>) ; Finish command
DSPTAB (GET000,C$GET,<Get>) ; GET command
DSPTAB (HLP000,C$HELP,<Help>) ; HELP command
DSPTAB (LCL000,C$LOCAL,<Local>) ; LOCAL command
DSPTAB (LOG000,C$LOG,<Log>) ; LOG command
DSPTAB (LGO000,C$LOGOUT,<Logout>) ; LOGOUT remote kermit
DSPTAB (CONFRM,C$PROMPT,<PROMPT>,CM%INV) ; PROMPT command
DSPTAB (EXI000,C$EXIT,<Quit>) ; QUIT command
DSPTAB (RCV000,C$RECEIVE,<R>,CM%INV!CM%ABR) ; Receive command
DSPTAB (RCV000,C$RECEIVE,<Receive>) ; RECEIVE command
DSPTAB (REM000,C$REMOTE,<Remote>) ;[116] Remote xxx command
DSPTAB (SND000,C$SEND,<S>,CM%INV!CM%ABR) ; SEND command
DSPTAB (SND000,C$SEND,<Send>) ; SEND command
DSPTAB (SRV000,C$SERVER,<Server>) ; SERVER command
DSPTAB (SET000,C$SET,<Set>) ; SET command
DSPTAB (SHO000,C$SHOW,<Show>) ; Show information
DSPTAB (STA000,C$STATUS,<Status>) ; STATUS command
DSPTAB (TAKFDB##,.KYTAK,<Take>) ;[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>) ; CONNECT to terminal line
DSPTAB (DFN000,C$DEFINE,<Define>) ;[107] Define set of parameters
DSPTAB (EXI000,C$EXIT,<Exit>) ; EXIT to monitor level
DSPTAB (HLP000,C$HELP,<Help>) ; HELP command
DSPTAB (LCL000,C$LOCAL,<Local>) ; LOCAL command
DSPTAB (LOG000,C$LOG,<Log>) ; LOG command
DSPTAB (CONFRM,C$PROMPT,<PROMPT>,CM%INV) ; PROMPT command
DSPTAB (EXI000,C$EXIT,<Quit>) ; QUIT command
DSPTAB (RCV000,C$RECEIVE,<Receive>) ; RECEIVE command
DSPTAB (SND000,C$SEND,<S>,CM%INV!CM%ABR) ; SEND command
DSPTAB (SND000,C$SEND,<Send>) ; SEND command
DSPTAB (SRV000,C$SERVER,<Server>) ; SERVER command
DSPTAB (SET000,C$SET,<Set>) ; SET command
DSPTAB (SHO000,C$SHOW,<Show>) ; Show information
DSPTAB (STA000,C$STATUS,<Status>) ; STATUS command
DSPTAB (TAKFDB##,.KYTAK,<Take>) ;[111] Take command
$ETAB
SUBTTL Command tables -- Final state
CONFRM: $CRLF
SUBTTL Command tables -- BYE command
BYE000: $NOISE (CONFRM,<to remote server>)
SUBTTL Command tables -- CONNECT command
CON000: $NOISE (CON010,<to line>)
TOPS20<
CON010: $NUMBER (CONFRM,^D8,<line number to use for virtual terminal>,$ALTERNATE(CONFRM))
>; End of TOPS20 conditional
TOPS10<
CON010: $DEV (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON020),$ERRPDB(CON020)>)
CON020: $NODNM (CON030,<Node name terminal line is connected to>,<$ALTERNATE(CON050),$ERRPDB(CON050)>)
CON030: $NOISE (CON040,<Line number>)
CON040: $NUMBER (CONFRM,^D8,<Line number on specified node>)
CON050: $NUMBER (CONFRM,^D8,<line number to use for virtual terminal>,$ALTERNATE(CONFRM))
>; End of TOPS10 conditional
CON100: $NOISE (CON110,<to line>)
TOPS20<
CON110: $NUMBER (CONFRM,^D8,<line number to use for virtual terminal>)
>; End of TOPS20 conditional
TOPS10<
CON110: $DEV (CONFRM,<$HELP(Name of terminal to use),$ALTERNATE(CON120),$ERRPDB(CON120)>)
CON120: $NODNM (CON130,<Node name terminal line is connected to>,<$ALTERNATE(CON150),$ERRPDB(CON150)>)
CON130: $NOISE (CON140,<Line number>)
CON140: $NUMBER (CONFRM,^D8,<Line number on specified node>)
CON150: $NUMBER (CONFRM,^D8,<line number to use for virtual terminal>)
>; End of TOPS10 conditional
SUBTTL Command tables -- DEFINE command
;[107] Format:
;[107] DEFINE macro-name {List of set options}
;[107] DEFINE macro-name <CRLF> ! to delete macro definition
DFN000: $NOISE (DFN010,<macro name>)
DFN010: $KEY (DFN020,DFNTAB,<$ALTERNATE(DFN030)>)
DFN020: $CRLF (<$HELP(Confirm to delete macro)>)
DFN030: $FIELD (SET001,<macro name to define>)
;[107] Tables used during macro expansion
SMC000: $KEY (SMC010,KER020) ;[107] Allow any command (can only be define anyway)
SMC010: $NOISE (SMC020,<macro name>)
SMC020: $KEY (SET001,DFNTAB) ;[107] Allow any macro name then set options
SUBTTL Command tables -- EXIT command
EXI000: $NOISE (CONFRM,<to the monitor>)
SUBTTL Command tables -- FINISH command
FIN000: $NOISE (CONFRM,<remote server operation>)
SUBTTL Command tables -- GET command
GET000: $NOISE (GET010,<remote files>)
GET010: $FIELD (CONFRM,<File specification>,<$BREAK(FILBRK)>)
SUBTTL Command tables -- HELP command
HLP000: $NOISE (HLP010,<with>)
HLP010: $CTEXT (CONFRM,<Topic for which help is wanted>,$ALTERNATE(CONFRM))
SUBTTL Command tables -- LOGOUT command
LGO000: $NOISE (CONFRM,<remote server>)
SUBTTL Command tables -- LOG command
LOG000: $KEY (LOG010,LOG001)
LOG001: $STAB
KEYTAB (DBGLOG,<Debugging-output>)
KEYTAB (SESLOG,<Session>)
KEYTAB (TRNLOG,<Transactions>)
$ETAB
LOG010: $NOISE (LOG020,<to file>)
LOG020: $OFILE (LOG030,<Log file name>,$ALTERNATE(CONFRM))
LOG030: $SWITCH (CONFRM,LOG031,$ALTERNATE(CONFRM))
LOG031: $STAB
KEYTAB (0,<Append>)
$ETAB
SUBTTL Command tables -- RECEIVE command
RCV000: $NOISE (RCV010,<into files>)
RCV010: $OFILE (CONFRM,<File name to receive information into>,$ALTERNATIVE(CONFRM))
SUBTTL Command tables -- REMOTE command
REM000: $KEYDSP (REM010)
REM010: $STAB
DSPTAB (REM080,<[XWD GETNFL,GC%COPY##]>,<Copy>) ; Copy file
DSPTAB (REM070,<[XWD GETPSW,GC%CONNECT##]>,<CWD>) ; Change working directory
DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,<Delete>) ; Delete file
DSPTAB (REM030,<[XWD 0,GC%DIRECTORY##]>,<Directory>) ; Directory command
DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Disk-usage>) ; Disk-usage report
DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,<Erase>) ; Delete file
DSPTAB (CONFRM,<[XWD 0,GC%EXIT##]>,<Exit>) ; Exit
DSPTAB (REM050,<[XWD 0,GC%HELP##]>,<Help>) ; Help command
DSPTAB (REM060,<[XWD 0,GC%COMMAND##]>,<Host-command>) ; Host command
DSPTAB (REM100,<[XWD GETLGN,GC%LGN##]>,<Login>) ; Login
DSPTAB (CONFRM,<[XWD 0,GC%LOGOUT##]>,<Logout>) ; Logout command
DSPTAB (REM090,<[XWD GETNFL,GC%RENAME##]>,<Rename>) ; Rename file
DSPTAB (REM120,<[XWD GETMSG,GC%SEND%MSG##]>,<Send-message>) ; Send message command
DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Space>) ; Disk-usage report
DSPTAB (CONFRM,<[XWD 0,GC%STATUS##]>,<Status>) ; Status command
DSPTAB (REM020,<[XWD 0,GC%TYPE##]>,<Type>) ; Type file command
DSPTAB (REM110,<[XWD GETOPT,GC%WHO##]>,<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##]>,<CWD>) ; Change path
DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,<Delete>) ; Delete file
DSPTAB (REM030,<[XWD 0,GC%DIRECTORY##]>,<Directory>) ; Directory command
DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Disk-usage>) ; Disk-usage report
DSPTAB (REM020,<[XWD 0,GC%DELETE##]>,<Erase>) ; Delete file
DSPTAB (REM050,<[XWD 0,GC%HELP##]>,<Help>) ; Help command
DSPTAB (REM070,<[XWD 0,GC%CONNECT##]>,<Set-path>) ; Set default path
DSPTAB (REM040,<[XWD 0,GC%DISK%USAGE##]>,<Space>) ; Disk-usage report
DSPTAB (CONFRM,<[XWD 0,GC%STATUS##]>,<Status>) ; Status command
DSPTAB (REM020,<[XWD 0,GC%TYPE##]>,<Type>) ; Type file command
$ETAB
; Here for items which take a required file spec (Type and Delete)
REM020: $NOISE (REM021,<file>)
REM021: $CTEXT (CONFRM,<file specification>)
; Here for a directory command. Accept an optional file spec.
REM030: $NOISE (REM031,<of files>)
REM031: $CTEXT (CONFRM,<file specification>,$ALTERNATE(CONFRM))
; Here for a disk-usage and CWD commands
REM040: $NOISE (REM041,<of directory>)
REM070: $NOISE (REM041,<to directory>)
REM041: $CTEXT (REM042,<directory specification>,$ALTERNATE(REM042))
REM042: $CRLF (<$HELP(<Confirm for default directory>)>)
; Here for a help command
REM050: $NOISE (REM051,<with Kermit server>)
REM051: $CTEXT (CONFRM,<Topic for which help is wanted>,$ALTERNATE(CONFRM))
; Here for a remote HOST command
REM060: $CTEXT (CONFRM,<Command to be executed by the remote host>)
; Here for copy and rename commands
REM080: $NOISE (REM081,<from file>)
REM090: $NOISE (REM081,<old file>)
REM081: $CTEXT (CONFRM,<old file name>)
; Here for login command
REM100: $NOISE (REM101,<as user>)
REM101: $CTEXT (CONFRM,<User identification>)
; Here for WHO command
REM110: $NOISE (REM111,<is using system>)
REM111: $CTEXT (CONFRM,<user identification or network host>,<$ALTERNATE(CONFRM)>)
; Here for send message
REM120: $NOISE (REM121,<to>)
REM121: $CTEXT (CONFRM,<destination identification>)
SUBTTL Command tables -- SEND command
SND000: $NOISE (SND010,<from files>)
SND010: $FIELD (CONFRM,<File specification>,<$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,<mode>)
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]>,<block-check-type>)
DSPTAB (DBG000,<[EXP SETDBG]>,<debugging>)
DSPTAB (DEL000,<[XWD DELAY##,SETNUM]>,<delay>)
DSPTAB (ESC000,<[EXP SETESC]>,<escape>)
DSPTAB (FIL000,<[EXP SETFIL]>,<file>)
;[115]; DSPTAB (FBS000,<[XWD FILTYP,SETKYW]>,<file-byte-size>)
;[115];TOPS10< DSPTAB (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,<file-warning>)>; End of TOPS10
DSPTAB (HSK000,<[EXP SETHSK]>,<handshake>); [131]
;[133] DSPTAB (ONOFF,<[XWD IBM%FLAG##,SETKYW]>,<IBM-mode>)
DSPTAB (ABT000,<[XWD ABT%FLAG##,SETKYW]>,<incomplete-file>)
DSPTAB (LIN000,<[EXP SETLIN]>,<line>)
DSPTAB (ONOFF,<[XWD LCLECH,SETKYW]>,<local-echo>)
DSPTAB (MSG000,<[EXP SETMSG]>,<message>)
DSPTAB (PAR000,<[XWD PARITY%TYPE##,SETKYW]>,<parity>)
DSPTAB (PRM000,<[EXP SETPRM]>,<prompt>)
DSPTAB (SRC000,<[EXP SETRCV]>,<receive>)
DSPTAB (RPT000,<[EXP SETRPT]>,<repeat>)
DSPTAB (RTY000,<[EXP SETRTY]>,<retry>)
DSPTAB (SSN000,<[EXP SETSND]>,<send>)
DSPTAB (SSR000,<[XWD SRV%TIMEOUT##,SETNUM]>,<server-timer>)
DSPTAB (XXP000,<[XWD XXPMOD,SETKYW]>,<XON-XOFF-processing>) ;[127]
$ETAB
SUBTTL Command tables -- SET command -- ON/OFF table
ONOFF: $KEYDSP (ONOFFT)
ONOFFT: $STAB
DSPTAB (SET005,BLSFAL,<off>)
DSPTAB (SET005,BLSTRU,<on>)
$ETAB
SUBTTL Command tables -- SET command -- incomplete-file
ABT000: $NOISE (ABT010,<disposition>)
ABT010: $KEY (SET005,ABT01T)
ABT01T: $STAB
KEYTAB (BLSTRU,<discard>)
KEYTAB (BLSFAL,<keep>)
$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##,<one-character-checksum>)
KEYTAB (CHK%CR##,<three-character-CRC-CCITT>)
KEYTAB (CHK%2C##,<two-character-checksum>)
$ETAB
SUBTTL Command tables -- SET command -- DEBUGGING
DBG000: $KEYDSP(DBG00T)
DBG00T: $STAB
DSPTAB (DBG010,<[XWD SETODF,0]>,<log-file>)
DSPTAB (SET005,<[XWD SETCDF,0]>,<no-log-file>)
DSPTAB (SET005,<[XWD SETDBF,BLSFAL]>,<off>)
DSPTAB (SET005,<[XWD SETDBF,BLSTRU]>,<on>)
$ETAB
DBG010: $NOISE (DBG011,<to>)
DBG011: $OFILE (SET005,<File name for debugging log>)
SUBTTL Command tables -- SET command -- DELAY
DEL000: $NOISE (DEL010,<to>)
DEL010: $NUMBER (SET005,^D10,<decimal number of seconds>,<$ACTION(CHKPOS)>)
SUBTTL Command tables -- SET command -- ESCAPE
ESC000: $NOISE (ESC010,<character for connect to>)
ESC010: $NUMBER (SET005,^D8,<Octal value of ASCII control character>,<$DEFAULT(31)>)
SUBTTL Command tables -- SET command -- FILE
FIL000: $NOISE (FIL010,<parameter>)
FIL010: $KEYDSP (FIL020)
FIL020: $STAB
DSPTAB (FBS000,<[XWD FILTYP,SETKYW]>,<byte-size>)
DSPTAB (FNM000,<[XWD FIL%NORMAL%FORM##,SETKYW]>,<naming>)
TOPS10< DSPTAB (ONOFF,<[XWD WARN%FLAG##,SETKYW]>,<warning>)>; End of TOPS10
$ETAB
SUBTTL Command tables -- SET command -- FILE -- BYTE-SIZE
FBS000: $NOISE (FBS010,<to>)
FBS010: $KEYDSP (FBS020)
FBS020: $STAB
DSPTAB (SET005,$FBS36,<36-bit>) ;[127]
DSPTAB (SET005,$FBS7,<7-bit>)
DSPTAB (SET005,$FBS8,<8-bit>)
DSPTAB (SET005,$FBAUT,<auto-byte>)
DSPTAB (SET005,$FBS8,<eight-bit>)
DSPTAB (SET005,$FBS7,<seven-bit>)
DSPTAB (SET005,$FBS36,<thirty-six-bit>) ;[127]
$ETAB
SUBTTL Command tables -- SET command -- FILE -- BYTE-SIZE
FNM000: $NOISE (FNM010,<to>)
FNM010: $KEYDSP (FNM020)
FNM020: $STAB
DSPTAB (SET005,FNM%FULL##,<full-file-specification>)
DSPTAB (SET005,FNM%NORMAL##,<normal-form>)
DSPTAB (SET005,FNM%UNTRAN##,<untranslated>)
$ETAB
SUBTTL Command tables -- SET command -- HANDSHAKE
HSK000: $NOISE (HSK010,<character for IBM handshake>) ;[131]
HSK010: $NUMBER (SET005,^D8,<Octal value of ASCII character>,<$DEFAULT(-1)>) ;[131]
SUBTTL Command tables -- SET command -- Line
LIN000: $NOISE (LIN010,<to>)
TOPS20<
LIN010: $NUMBER (SET005,^D8,<line number to use for virtual terminal>)
>; End of TOPS20 conditional
TOPS10<
LIN010: $DEV (SET005,<$HELP(Name of terminal to use),$ALTERNATE(LIN020),$ERRPDB(LIN020)>)
LIN020: $NODNM (LIN030,<Node name terminal line is connected to>,<$ALTERNATE(LIN050),$ERRPDB(LIN050)>)
LIN030: $NOISE (LIN040,<Line number>)
LIN040: $NUMBER (SET005,^D8,<Line number on specified node>)
LIN050: $NUMBER (SET005,^D8,<line number to use for virtual terminal>,$ALTERNATE(SET005))
>; End of TOPS10 conditional
SUBTTL Command tables -- SET command -- Message
MSG000: $NOISE (MSG010,<type out to be>)
MSG010: $KEY (MSG020,MSG030,<$ALTERNATE(MSG020)>)
MSG020: $KEY (SET005,MSG040)
MSG030: $STAB
KEYTAB (BLSFAL,<no>)
$ETAB
MSG040: $STAB
KEYTAB (TY%FIL##,<file-specifications>)
KEYTAB (TY%PKT##,<packet-numbers>)
$ETAB
SUBTTL Command tables -- SET command -- Parity
PAR000: $NOISE (PAR010,<to>)
PAR010: $KEYDSP (PAR020)
PAR020: $STAB
DSPTAB (SET005,PR%EVEN##,<even>)
DSPTAB (SET005,PR%MARK##,<mark>)
DSPTAB (SET005,PR%NONE##,<none>)
DSPTAB (SET005,PR%ODD##,<odd>)
DSPTAB (SET005,PR%SPAC##,<space>)
$ETAB
SUBTTL Command tables -- SET command -- Prompt
PRM000: $FIELD (SET005,<KERMIT prompt>,<$ALTERNATE(SET005),$BREAK(FILBRK)>)
SUBTTL Command tables -- SET command -- Receive
SRC000: $KEYDSP (SRC010)
SRC010: $STAB
DSPTAB (R8Q000,SETR8Q,<8th-bit-quote>)
DSPTAB (R8Q000,SETR8Q,<eighth-bit-quote>)
DSPTAB (REO000,SETREL,<end-of-line>)
DSPTAB (RPL000,SETRPL,<packet-length>)
DSPTAB (RPC000,SETRPC,<padchar>)
DSPTAB (RPD000,SETRPD,<padding>)
DSPTAB (RQU000,SETRQU,<quote>)
DSPTAB (RSH000,SETRSH,<start-of-packet>)
DSPTAB (RTI000,SETRTI,<timeout>)
$ETAB
R8Q000: $NOISE (R8Q010,<to>)
R8Q010: $NUMBER (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
REO000: $NOISE (REO010,<to>)
REO010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKCTL)>)
RPL000: $NOISE (RPL010,<to>)
RPL010: $NUMBER (SET005,^D10,<decimal number between 10 and 1000>,<$ACTION(CHKPKT)>) ; [134]
RPC000: $NOISE (RPC010,<to>)
RPC010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37 or 177>,<$ACTION(CHKPDC)>)
RPD000: $NOISE (RPD010,<to>)
RPD010: $NUMBER (SET005,^D10,<positive decimal number of padding characters>,<$ACTION(CHKPOS)>)
RQU000: $NOISE (RQU010,<to>)
RQU010: $NUMBER (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
RSH000: $NOISE (RSH010,<to>)
RSH010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKSHC)>)
RTI000: $NOISE (RTI010,<to>)
RTI010: $NUMBER (SET005,^D10,<Number of seconds before timing out, between 1 and 94>,<$ACTION(CHKTIM)>)
SUBTTL Command tables -- SET command -- Repeat-quote
RPT000: $NOISE (RPT010,<to>)
RPT010: $KEY (SET005,RPT011,<$ALTERNATE(RPT020)>)
RPT011: $STAB
KEYTAB (<" ">,<none>)
$ETAB
RPT020: $NUMBER (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
SUBTTL Command tables -- SET command -- Retry
RTY000: $NOISE (RTY010,<maximum for>)
RTY010: $KEY (RTY030,RTY020)
RTY020: $STAB
KEYTAB (SI%RETRIES##,<initial-connection>)
KEYTAB (PKT%RETRIES##,<packets>)
$ETAB
RTY030: $NUMBER (SET005,^D10,<Number of retries>,<$ACTION(CHKPOS)>)
SUBTTL Command tables -- SET command -- Send
SSN000: $KEYDSP (SSN010)
SSN010: $STAB
DSPTAB (SEO000,SETSEL,<end-of-line>)
DSPTAB (SPL000,SETSPL,<packet-length>)
DSPTAB (SPC000,SETSPC,<padchar>)
DSPTAB (SPD000,SETSPD,<padding>)
DSPTAB (SQU000,SETSQU,<quote>)
DSPTAB (SSH000,SETSSH,<start-of-packet>)
DSPTAB (STI000,SETSTI,<timeout>)
$ETAB
SEO000: $NOISE (SEO010,<to>)
SEO010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKCTL)>)
SPL000: $NOISE (SPL010,<to>)
SPL010: $NUMBER (SET005,^D10,<decimal number between 10 and 1000>,<$ACTION(CHKPKT)>) ; [134]
SPC000: $NOISE (SPC010,<to>)
SPC010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37 or 177>,<$ACTION(CHKPDC)>)
SPD000: $NOISE (SPD000,<to>)
SPD010: $NUMBER (SET005,^D10,<positive decimal number of padding characters>,<$ACTION(CHKPOS)>)
SQU000: $NOISE (SQU010,<to>)
SQU010: $NUMBER (SET005,^D8,<Octal number between 41 and 76 or 140 and 176>,<$ACTION(CHK8QU)>)
SSH000: $NOISE (SSH010,<to>)
SSH010: $NUMBER (SET005,^D8,<Octal number of character between 0 and 37>,<$ACTION(CHKSHC)>)
STI000: $NOISE (RTI010,<to>)
STI010: $NUMBER (SET005,^D10,<Number of seconds before timing out, between 1 and 94>,<$ACTION(CHKTIM)>)
SUBTTL Command tables -- SET SERVER-TIMER
SSR000: $NOISE (SSR001,<to>)
SSR001: $NUMBER (SET005,^D10,<Number of seconds between idle server NAK's>)
SUBTTL Command tables --SET command -- XON-XOFF-processing
XXP000: $NOISE (XXP010,<during connect to>) ;[127]
XXP010: $KEYDSP (XXP020) ;[127]
XXP020: $STAB ;[127]
DSPTAB (SET005,$XXDEF,<default>) ;[127]
DSPTAB (SET005,$XXLCL,<local>) ;[127]
DSPTAB (SET005,$XXREM,<remote>) ;[127]
$ETAB
SUBTTL Command tables -- STATUS command
STA000: $NOISE (CONFRM,<of Kermit>)
SUBTTL Command tables -- SHOW command
SHO000: $KEYDSP (SHO010,<$DEFAULT(all)>)
SHO010: $STAB
DSPTAB (CONFRM,SHOALL,<all>)
DSPTAB (CONFRM,SHODAY,<daytime>)
DSPTAB (CONFRM,SHODEB,<debugging>)
DSPTAB (CONFRM,SHOFIL,<file-information>)
DSPTAB (CONFRM,SHOLIN,<line-information>)
DSPTAB (CONFRM,SHOMAC,<macros>)
DSPTAB (CONFRM,SHOPKT,<packet-information>)
DSPTAB (CONFRM,SHOTIM,<timing-information>)
DSPTAB (CONFRM,SHOVER,<version>)
$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,<SIXBIT |CTY|> ; 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(,<? ^T/@PRT.EM(S2)/>) ; 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,<Macro expansion>)
;[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 <MNAME>,<...MNL==...MNL+1> ;;[107] Count characters in the name
IRPC <MTEXT>,<...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,<Bad macro definition>)]
> ;[107] End of DFNMAC
;[107]
;[107] Now actually define our default macro(s)
;[107]
;[133] DFNMAC(IBM,<Handshake 21, IBM-mode on, Parity mark, Local-echo on>)
DFNMAC(IBM,<Handshake 21, Parity mark, Local-echo on>)
$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,<<SIXBIT |INI|>> ;[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 ;[MF] Again assume no .INI file
REDIN0: MOVX S1,<<SIXBIT |DSK|>> ;[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,<XWD .TCRRF,T1> ; Get the arg pointer
MOVX T1,<SIXBIT |KER|> ; 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,<SIXBIT |KER|> ; Get the name
MOVX S1,<XWD .TCRDF,T1> ; Get the pointer
TMPCOR S1, ; And read the file
$STOP TFD,<Temp file disappeared> ; 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,<INSVL.(7,BP.POS)> ; Back up the position
JUMPG S1,.+2 ; Go over a word boundary?
SUBX S1,<INSVL.(^D35,BP.POS)+1> ; 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,<XWD .PRIIN,.PRIOU> ; 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,<ANSLEN*5>-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
CAIN 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,<INSVL.(7,BP.POS)> ;; Back up the position
JUMPG T1,.+2 ;; Go over a word boundary?
SUBX T1,<INSVL.(^D35,BP.POS)+1> ; 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 <CRLF>?
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 (<Can not connect to your terminal line>)
$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,<Type ^T/ESCTXT/C to return to local KERMIT, ^T/ESCTXT/? for help>) ;
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 (<Cannot open session log file ^F/SESLOG+$LGFD/ - ^E/S1/>)
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 <escape chr>? - 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 <escape chr>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##,<S1> ; 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 (<Macro table inconsistent>) ;[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 (<Macro table inconsistent>) ;[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 (<Cannot define macro ^T/$MBNAM(T1)/>) ;[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 <<MPRDAT,PAR.SZ>> ;[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 (<Error parsing macro expansion - Internal table conflict>)
$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(<Must use SET LINE first>)
$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,<MAX%MSG##+4>/5 ; Get length of arguments
MOVEI S2,GEN%1DATA## ; First buffer address
$CALL .ZCHNK ; Clear it
MOVEI S1,<MAX%MSG##+4>/5 ; Get length of arguments
MOVEI S2,GEN%2DATA## ; First buffer address
$CALL .ZCHNK ; Clear it
MOVEI S1,<MAX%MSG##+4>/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 <CRLF>. 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(<Must use SET LINE first>)
$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(<Must use SET LINE first>)
$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##,<P1>)
$CALL CLSTRM ; Close the terminal
$RETT ; Give a good return
; Subroutines to get arguments.
; Get login information
GETLGN: MOVEI S1,[ITEXT(<Account: >)] ; 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(<Password: >)]] ; Point at the prompt, no echo
GETMSG: MOVEI S1,[ITEXT(<Message: >)] ; 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(<New file name: >)]] ; Get the prompt
GETOPT: MOVEI S1,[ITEXT(<Options: >)] ; 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##,<P1,[EXP LCLSTR],[EXP LCLSIZ],[EXP LCLRTN]> ; Generate result
CAIN 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 <TY%FIL##> ; Save type files flag
SETZB S1,TY%FIL## ; Want to read the file
BLSCAL FILE%OPEN,<S1>
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(<Must use SET LINE first>)
$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
CAIE 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>,<TTY^O/S1/^0>) ; 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,<XWD .NDRNN,S1> ; Point to the arguments
NODE. T1, ; Do it
JRST [$KERR (<Illegal node name>)
$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 (<Terminal not available>)
$RETF] ; Punt
MOVEM S1,XFRTRM+$TTUDX ; Store the UDX
MOVE S1,T2 ; Reget device name
DEVTYP S1, ; Get the device type bits
JRST [$KERR (<Illegal terminal name>)
$RETF] ; Give up
TXNN S1,TY.AVL ; Device available?
JRST [$KERR (<Terminal in use by job ^D/S1,TY.JOB/>)
$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 (<Cannot open terminal>)
$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 (<Nonexistent device>) ; Must not be valid
$RETF] ; Can't set the line here
CAIL S2,.UXTRM ; Check if valid terminal
CAILE S2,.UXTRM+^O777 ; . . .
JRST [$KERR (<Device is not a terminal>) ; 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
;
CAILE 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 (,<TOPS-10 KERMIT version ^V/.JBVER/>)
$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 (,<File specification type out is ^T/(S1)/>)
MOVE S1,TY%PKT## ; Get the packet number type out flag
$CALL TONOFF ; Get the text associated with it
$TEXT (,<Packet number type out is ^T/(S1)/>)
MOVE S1,DEBUG%FLAG## ; Get the flag value
$CALL TONOFF ; Get the text
$TEXT (,<Debugging is ^T/(S1)/>)
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 (,<File type is ^T/@FBSTBL(S1)/>)
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 (,<File naming: ^T/(S1)/ file specifications>)
TOPS10<
MOVE S1,WARN%FLAG## ; Get the flag value
$CALL TONOFF ; Get the value
$TEXT (,<File warning is ^T/(S1)/>)
>; 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 (,<Disposition for incomplete received files: ^T/(S1)/>)
$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 (,<Line being used is ^W/S1/: ^A>)
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 (,<Packet parameters:^M^J Receive Send>)
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 (,<Timing parameters:^M^J Receive Send>)
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 <P1> ; 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,<FUNCTION>)
TOPS10<
$SAVE <T1,T2,T3,T4> ; Save a few registers
$SAVE <TF,S2> ; Save this too
$SAVE <P1> ; 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 (<Cannot write files without LOGIN first>) ;[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 (<Wild file specifications illegal on RECEIVE>)
BLSRET RMS32]
MOVE S1,FILTYP ; Get the file type we are using
CAIE S1,$FBS8 ; 8-bit file?
IFE .IOASC,<TDZA S1,S1> ; No, Use ASCII mode
IFN .IOASC,<SKIPA S1,[EXP .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(<DEVSIZ UUO failure (^D/S1/)>)
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,<POINT 7,,34> ; Assume ASCII files
MOVX S2,$FBS8 ; Is it really 8-bit?
CAMN S2,FILTYP ; . . .
MOVX S1,<POINT 8,,31> ; 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,(<SIXBIT |000|>) ; 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(<DEVSIZ UUO failure (^D/S1/)>)
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,<XWD .FOMAX,FLP> ; 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 (,<Sending: ^A>) ;[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
CAIE S2,$FBAUT ; Automatic?
JRST OPNRE2 ; No, use what was set
LOAD S1,ELB+.RBPRV,RB.MOD ; Get the mode the file was written in
CAIE S1,.IOIMG ; Image?
CAIN S1,.IOIBN ; Or image binary?
MOVX S2,$FBS8 ; Yes, 8-bit
CAIE S1,.IOBIN ; Binary?
CAIN S1,.IODPR ; Or dump record?
MOVX S2,$FBS8 ; Yes, 8-bit
OPNRE2: MOVEM S2,CURFTP ; Save the file type for this file
MOVX S1,<POINT 7,,34> ; Assume ASCII files
CAIN S2,$FBS8 ; Is it ASCII?
MOVX S1,<POINT 8,,31> ; 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 (<No such files as ^F/FX/>)
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 <P1> ; 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 <P1> ; 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
CAIE S1,$FBS8 ; 8-bit?
IFE .IOASC,<TDZA S1,S1> ; No, use ascii
IFN .IOASC,<SKIPA S1,[EXP .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 <P1,P2,P3> ; 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,<ABTFLG>)
$SAVE <TF,S2> ; 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 <S2,TF> ; Save some registers
$SAVE <T1,T2,T3,T4> ; That will be used
$SAVE <P1> ; 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,<CHARACTER>)
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
CAIE S1,$FBS36 ;[127][MF] Is this 36 bit?
BLSRET NORMAL ; Give a good return
MOVE S1,BH+.BFPTR ; Get the buffer pointer
TXNE S1,<FLD(76,BP.POS)> ; 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 (<Input error, status = ^O60/S1/>)
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,<CHARACTER>)
$SAVE <S2> ; 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
CAIN S2,$FBS36 ;[127][MF] 36 bit?
TRNN S1,200 ;[MF] Yes, is the high order bit on?
BLSRET NORMAL ; No, Give a good return
MOVX S2,<FLD(76,BP.POS)> ; 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 (<Output error, status = ^O60/S1/>)
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 <P1,P2> ; 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,<SIXBIT /DSK/> ; 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 <P1,P2> ; 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 <P2> ; 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,<SUBTYPE,TYPE>)
$SAVE <TF,S1,S2> ; Save a few registers
$SAVE <T1,T2,T3,T4> ; . . .
$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)<ASCII /A/>
PKTTXT: PKTITM
DEFINE PKT(A,B)<EXP 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>,<TTY^O/S2/^0>) ; 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,<SIXBIT |KERMIT|> ; 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 <P1> ; 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 (<Cannot open debugging log file ^F/DBGLOG+$LGFD/ - ^E/S1/>)
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 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,<MSGLEN,MSGADR>)
$SAVE <TF,S2,T1,T2> ; 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 (<Output error, status ^O60/S2/>)
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 <TF,S2> ; 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 [CAIN 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,<MSGLEN,MSGADR>)
$SAVE <TF,S2>
$SAVE <T1,T2,T3,T4> ; 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 (<Receive error, status ^O60/S1/>)
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 ; . . .
CAILE 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
CAIE S1,.CHCRT ; Carriage return?
CAIN S1,.CHCNA ; Control-A?
JRST CHKKB2 ; Yes, go set flag and give correct return
CAIN S1,.CHCND ; Control-D?
XORM S2,DEBUG%FLAG## ; Yes, toggle debugging
CAIE S1,.CHCNX ; Control-X?
CAIN S1,.CHCNZ ; or control-Z?
JRST .+2 ; Yes, set correct flag
JRST CHKKB1 ; No, check if more there
CHKKB2: CAIN S1,.CHCNX ; Control-X?
MOVEM S2,ABT%CUR%FILE## ; Yes, abort current file
CAIN S1,.CHCNZ ; No, control-Z?
MOVEM S2,ABT%ALL%FILE## ; Yes, abort entire stream
CAIN S1,.CHCNA ; Control-A?
MOVEM S2,TYP%STS%FLAG## ; Flag that user wants some info
CAIN S1,.CHCND ; Control-D?
XORM S2,DEBUG%FLAG## ; Yes, toggle debugging
CAIN 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 <P1,P2,P3,P4> ; 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(<DEVSIZ UUO failure (^D/S1/)>)
$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,<XWD .FONBF+1,FLP> ; 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,<XWD 2,P2> ; 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
CAIL S1,.CHNUL ;[133] Is it a character?
JRST .+2 ; Yes, need to clear TTY PAGE
$RETT ; No, leave things alone
MOVX S1,<XWD 3,P2> ; 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 (<Terminal open failure ^T/FILERR##(S1)/>)
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 <P1,P2,P3,P4> ; 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,<XWD 3,P2> ; 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,<XWD 1,S2> ; 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,<XWD 1,TF> ; 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 <S1,S2> ; 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,<XWD 1,S1> ; 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 <P1,P2,P3> ; 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 <P1> ; Save this registers
MOVE P1,S1 ; Copy the address
MOVX S1,<<XWD .NDTCN,T1>> ;[MF] 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
CAME S1,[XWD .NDTCN,T1] ; 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?
$RET
TCON.E: $TEXT (,<?Error determining TTY name>)
MOVE S1,[SIXBIT/TTY0/]
$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,<BYTE(9)0,0,Character,second character>
; 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 <P1,P2,P3> ; 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,<BYTE (9)0,0,.CHCNC,.CHCNC!^O200> ; 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
CAIGE 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,<XWD 3,P1> ; 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,<COUNT,BUFFER>)
$SAVE <TF,S1> ; 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,<COUNT,BUFFER>)
$SAVE <TF,S1,S2> ; 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 <TF,S1,S2> ; Save a few registers
$SAVE <T1,T2,T3,T4> ; And a few more
$TEXT (<-1,,MSGTXT>,<?Kermit-10 ^I/@.TEMP/^0>) ; Type the text
JRST KRERR ; Join the common code
SUBTTL Error processing -- KRM%ERROR - Handle the KERMSG errors
;+
;.hl1 KRM%ERROR
;This routine will handle the errors that KERMSG will generate.
;-
BLSRTN(KRM%ERROR,<ERRTYP>)
$SAVE <TF,S2> ; Save a few registers
$SAVE <T1,T2,T3,T4> ; 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>,<?Kermit-10 ^T/@ERRTXT(S2)/^0>) ; Write the text
; Here to count the characters and call the BLISS routine to write the
; error packet to the remote
KRERR: 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)<EXP VALUE>
ERRTBL: KERRORS
ERRLEN==.-ERRTBL
DEFINE KER(TYPE,VALUE,TEXT)<EXP [ASCIZ |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,<LEN,BYTEPTR>) ; Define the routine
$SAVE <T1,T2,T3,T4> ; 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,,<SIXBIT /HLP/> ; HLP:
$SET .FDNAM,,%%.MOD ; KERMIT
$SET .FDEXT,,<SIXBIT /HLP/> ; .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,,<SIXBIT |DSK|> ; Device is DSK
$SET .FDEXT,,<SIXBIT |TMP|> ; 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,,<SIXBIT |DSK|> ; Device is DSK
$SET .FDNAM,,<SIXBIT |KERMIT|> ; Name is KERMIT
$SET .FDEXT,,<SIXBIT |INI|> ; .INI
>; End of TOPS10 conditional
TOPS20<
$SET .FDSTG,,<ASCIZ |DSK:KERMIT.INI|>
>; 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>