github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 19:21:02 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/rmtcon/rmtcop.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1285 lines
42 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
SUBTTL RMTCOP Parsing and Dispatch Module
SEARCH RMTCOT ;Get RMTCON symbols
TTITLE (RMTCOP,\DECVER,\VEDIT,Parsing and Dispatch)
;COPYRIGHT 1985
;LARGE SYSTEMS DIAGNOSTICS GROUP
;DIGITAL EQUIPMENT CORPORATION
;MARLBORO, MASS. 01752
;
; Author: Gary Papazian
;Update Author: Gregory A. Scott
SEARCH MONSYM,MACSYM,UUOSYM,GLXMAC ;Load universals
PROLOG (RMTCOP) ;Set GLXLIB symbols and macros
NOSYM ;No symbol table dump
SALL ;Suppress macro exps
.DIREC FLBLST ;First line binary listing only plesae
.FDSTG==1 ;For TOPS-20
SUBTTL Externs/Interns
;Routines local to this module
INTERN SOUT%%,BOUT%%,PCRLF,TAKCHR,TOPLVL
;Data local to this module
INTERN MONTYP,TAKIFN
;Routines found in RMTCOM
EXTERN RRID,$REMOT,RRCT,CTSAVE,SALLAD
EXTERN CTRSTR,RCADR
;Data found in RMTCOM
EXTERN TRCFLG,SPRFLG,DBGFLG,RRIFLG,TTEXIT,PRTNBR,LEVTAB,CHNTAB
EXTERN TARADH,TARADL,NODADH,NODADL,PWORDH,PWORDL
SUBTTL Storage
;General storage
PDL: BLOCK <PLEN==200> ;Stack
DPDL: BLOCK <DPLEN==200> ;Data stack
MONTYP: BLOCK 1 ;-1 if TOPS-20, 0 if TOPS-10
OPSNUM: BLOCK 1 ;10 if TOPS-10, 20 if TOPS-20
CPUSER: BLOCK 1 ;CPU serial number
CPUTYP: BLOCK 1 ;CPU type in sixbit
;Log/take file strorage
LOGIFN: BLOCK 1 ;IFN/JFN for log file
TAKIFN: BLOCK 1 ;IFN/JFN for take file
;Parser storage
CSB: BLOCK .CMGJB+1 ;The real CSB is here
BUFFER: BLOCK <BUFSIZ==500> ;Command buffer
ATMBUF: BLOCK <ATMSZ==100> ;Atom buffer
GJFBLK: BLOCK <GJFSIZ==.GJRTY+2> ;GTJFN block
;Help file reader storage
HLPBUF: BLOCK ATMSZ ;Atom buffer for help request
HLPLIN: BLOCK ^D135/5 ;Line of help text copied here
HLPEOF: BLOCK 1 ;-1=EOF on help file
HLPIFN: BLOCK 1 ;IFN of help file
SUBTTL GLXLIB Interface Blocks
;* IB - the GLXLIB Interface Block
IB: $BUILD IB.SZ ;Here to build the init block
$SET (IB.PRG,,%%.MOD) ;Program name
$SET (IB.OUT,,BOUT%%) ;Default output routine
$SET (IB.FLG,IT.OCT,1) ;Set open command terminal flag
$EOB ;End of block
;CSB template, BLTed into place at top level parsing
CSBTMP: $BUILD .CMGJB+1
$SET .CMFLG,RHMASK,REPARS ;Reparse address
$SET .CMBFP,,<POINT 7,BUFFER> ;Pointer to input buffer
$SET .CMPTR,,<POINT 7,BUFFER> ;Start the parse at the beginning
$SET .CMCNT,,BUFSIZ*5-1 ;Size of buffer
$SET .CMABP,,<POINT 7,ATMBUF> ;Pointer to start of atom buffer
$SET .CMABC,,ATMSZ*5-1 ;Size of atom buffer
$SET .CMRTY,,<Point 7,PROMPT> ;Prompt (retry) pointer
$SET .CMGJB,,GJFBLK ;GTJFN block
$EOB
;Program prompt
PROMPT: BYTE(7)"R","M","T","C","O","N",76,0 ;RMTCONalglebracket
;Fobs and FBs for opening the take file
TAKFOB: $BUILD (FOB.SZ) ;File open block
$SET (FOB.FD,,TAKFD) ;File descriptor area
$SET (FOB.CW,FB.BSZ,7) ;Seven bit bytes
$EOB
TAKFD: $BUILD (FDXSIZ) ;FD
$SET (.FDLEN,FD.LEN,FDXSIZ) ;Set size of block
$EOB
;FOBs and FDs for opening the LOG file.
LOGFOB: $BUILD (FOB.SZ) ;File open block
$SET (FOB.FD,,LOGFD) ;File descriptor area
$SET (FOB.CW,FB.BSZ,7) ;Seven bit bytes
$EOB
LOGFD: $BUILD (FDXSIZ) ;FD size
$SET (.FDLEN,FD.LEN,FDXSIZ) ;Set size of block
$EOB
;FOBs and FBs for opening the help file
HFOB20: $BUILD (FOB.SZ) ;File open block
$SET (FOB.FD,,HLPFD2) ;File descriptor area
$SET (FOB.CW,FB.BSZ,7) ;Seven bit bytes
$EOB
HLPFD2: $BUILD (.FDSTG+3) ;FD for TOPS-20
$SET (.FDLEN,FD.LEN,.FDSTG+3) ;Set size of block
$SET (.FDSTG,,<ascii/dsk:d/>) ;First 5 characters of filename
$SET (.FDSTG+1,,<ascii/fnis./>) ;Second 5
$SET (.FDSTG+2,,<asciz/hlp/>) ;Last 3
$EOB
HFOB10: $BUILD (FOB.SZ) ;File open block
$SET (FOB.FD,,HLPFD1) ;File descriptor area
$SET (FOB.CW,FB.BSZ,7) ;Seven bit bytes
$EOB
HLPFD1: $BUILD (.FDPPN+1) ;FD for TOPS-10
$SET (.FDLEN,FD.LEN,.FDPPN+1) ;Set size of block
$SET (.FDSTR,,<sixbit/DSK/>) ;Structure
$SET (.FDNAM,,<sixbit/RMTCON/>) ;Filename
$SET (.FDEXT,,<sixbit/HLP/>) ;Extension
$EOB
SUBTTL Command Parsing Tables
;#***********************************************************************
;addr: $STAB ;Start of table
; KEYTAB value,keyword,flags ;value=dispatch addr or table value
; ;keyword=word to parse
; ;flags=keyword flags (CM%INV, etc.)
; $ETAB ;end of table
;#***********************************************************************
;This is the top level command table.
MAINCM: $STAB ;Start command table, top level
KEYTAB CONECT,CONNECT ;Connect (to node/port) command
KEYTAB DISABL,DISABLE ;Disable spear, logging, trace, debug
KEYTAB ENABLE,ENABLE ;Enable spear, logging, trace, debug
KEYTAB .QUIT,EXIT ;Command to exit i.E. Quit
KEYTAB HELP,HELP ;Help command
KEYTAB REQU,IDENTIFY ;Request id command
KEYTAB .QUIT,QUIT ;Quit, exit to kcmon
KEYTAB RDCTRS,READ-COUNTERS ;Read counters
KEYTAB REDEFI,REDEFINE ;Redefine remote tty switch char
KEYTAB SETPW,SET-PASSWORD ;Set password
KEYTAB SHOW,SHOW ;Show local/remote/all node addresses
KEYTAB TAKE,TAKE ;Take commands from file
$ETAB ;End command table, top level
;This table is used with the ENABLE command.
ENATAB: $STAB ;Start of enable command table
KEYTAB EN.DEB,DEBUG ;Enable debug
KEYTAB EN.LOG,LOGGING ;Enable logging command
KEYTAB EN.SPE,SPEAR-REPORTING ;Enable spear command
KEYTAB EN.TRA,TRACE ;Enable program trace
$ETAB ;End of enable command table
;This table is used with the DISABLE command.
DIATAB: $STAB ;Start of enable command table
KEYTAB DA.DEB,DEBUG ;Enable debug
KEYTAB DA.LOG,LOGGING ;Enable logging command
KEYTAB DA.SPE,SPEAR-REPORTING ;Enable spear command
KEYTAB DA.TRA,TRACE ;Enable program trace
$ETAB ;End of enable command table
;These tables are used with the 'CONNECT' command.
CONTAB: $STAB ;Node or port table
KEYTAB .CONN,NODE ;12 digit hex
KEYTAB .CONP,PORT ;0,1,2,3
$ETAB ;End of CONTAB
PRTTAB: $STAB ;Port 0,1,2,3
KEYTAB 0,0 ;Port 0
KEYTAB 1,1 ;Port 1
KEYTAB 2,2 ;Port 2
KEYTAB 3,3 ;Port 3
$ETAB ;End of PRTTAB
;This table is used with the SHOW command.
SHOTAB: $STAB ;Start of display-address table
KEYTAB SHOALL,ALL ;Display state of all
KEYTAB SHODEB,DEBUG ;Display state of debug
KEYTAB SHOLOG,LOGGING ;Display state of logging
KEYTAB SHONOD,NODES ;Display nodes on network
KEYTAB SHOSPE,SPEAR-REPORTING ;Display state of spear
KEYTAB SHOTRA,TRACE ;Display state of trace
$ETAB ;End of display address command table
;This table is used with the REDIRECT command.
.TSWC: $STAB ;Table of exit characters possible
KEYTAB "A"-100,CONTROL-A
KEYTAB "D"-100,CONTROL-D
KEYTAB "E"-100,CONTROL-E
KEYTAB "F"-100,CONTROL-F
KEYTAB "N"-100,CONTROL-N
KEYTAB "P"-100,CONTROL-P
KEYTAB "V"-100,CONTROL-V
KEYTAB "W"-100,CONTROL-W
KEYTAB "X"-100,CONTROL-X
KEYTAB "Z"-100,CONTROL-Z
$ETAB ;End of .TSWC table
;PDB used for Help command.
HLPPRS: FLDDB. (.CMKEY,,MAINCM,<Help about a command,>,,HLPALL)
HLPALL: FLDDB. (.CMTOK,,<Point 7,[ASCIZ/*/]>,<for all of the help file,>,,CFM)
CFM: FLDDB. (.CMCFM)
; **************************************************************************
; * Top level command parser (see COMND JSYS for field/format defs) *
; **************************************************************************
;The macro used to build the command descriptor block is (cmddb.) And has the
;Following format (type,flags,data,help,default,additional command data block),
;The type field will contain the command function code, the function codes are:
;
; .Cmkey= 0 ;keyword .Cmusr= 12 ;user name
; .Cmnum= 1 ;number .Cmcma= 13 ;comma
; .Cmnoi= 2 ;guide (noise) word .Cmini= 14 ;init line
; .Cmswi= 3 ;switch .Cmdev= 16 ;device name
; .Cmifi= 4 ;input file .Cmtxt= 17 ;text to action char
; .Cmofi= 5 ;output file .Cmqst= 21 ;quoted string
; .Cmfil= 6 ;general filespec .Cmuqs= 22 ;unquoted string
; .Cmfld= 7 ;arbitrary field .Cmtok= 23 ;token
; .Cmcfm= 10 ;confirm .Cmnux= 24 ;number delimited
; .Cmdir= 11 ;directory name ; by non-digit
;
;The flag field will contain one of the following flags or will be represented
;By two commas (,,), this indicates to the macro that this field is blank.
;The flags are:
; Cm%hpp ;help pointer is present
; Cm%dpp ;default pointer is present
; Cm%sdh ;suppress default help message
;
;The data field is dependent on the command function, see tops20 monitor call
;Manual commd jsys v544. This field may be omitted by using two commas (,,).
;
;The help field points to a message to be printed if the question mark (?)
;Is typed. This field may be omitted by using two commas (,,).
;
;The default field is pointer to a string to be used if the escape is the first
;Character to be typed. This field may be omitted by using two commas (,,).
;
;The alternate command block is a pointer to a command block to be parsed if
;The parse failed in the first command block. This field may be omited.
;
;The function field is always used but not all other fields are necessarily
;Used. If a field to the right is to be used, the unused fields separating
;The fields must be represented by two commas (,,).
SUBTTL Program Initialization
;;*****************************************************************************
;* Determine if TOPS-10 or TOPS-20, and get GLXLIB going
;;*****************************************************************************
SETUP: MOVE P,[IOWD PLEN,PDL] ;Load stack pointer
MOVE S1,[112,,11] ;Load %CNMNT monitor type word
GETTAB S1, ;This will not call PA1050 on the -20
SETZ S1, ;Oops
TXNE S1,4B23 ;Skip if TOPS-10
SKIPA S1,[XWD .PRIIN,.PRIOU] ;TOPS-20, set up input/output JFNs
SKIPA S1,[XWD 377776,377777] ;TOPS-10, set up fake i/o JFNs
SKIPA S2,[DEC 20] ;TOPS-20, load a twenty
SKIPA S2,[DEC 10] ;TOPS-10, load a ten
SETOM MONTYP ;TOPS-20, set the flag indicating that
MOVEM S1,CSBTMP+.CMIOJ ;Set I/O JFNs properly for -10 or -20
MOVEM S2,OPSNUM ;Set ten or twenty
SKIPE MONTYP ;Skip if TOPS-10
RESET% ;Reset the orange world
SKIPN MONTYP ;Skip if TOPS-20
CALLI 0 ;Reset the blue world
;Get GLXLIB up.
MOVEI S1,IB.SZ ;Load size of the init block
MOVEI S2,IB ; and point to it
$CALL I%INIT ;Init the GLXLIB stuff
SETZM TAKIFN ;Clear any take file's IFN
SETZM LOGIFN ;Clear any log file IFN
$CALL CTSAVE ;Save terminal stuff
;Announce ourselves, set up data areas
$CALL CPUNUM ;Get CPU number, etc.
$TEXT (,<
^I/ANNOUN/^H/[-1]/
For help, type HELP at the program prompt>) ;Announce ourselves
;Enable capabilities if TOPS-20
SKIPN MONTYP ;TOPS-20?
JRST TOPLVL ;Nope, start parsing
MOVEI S1,.FHSLF ;Set up for current process
RPCAP% ;Get my capabilites
TRNN S2,SC%WHL!SC%OPR!SC%MNT ;Any good capabilites present?
$PMSGC (<% Not enough capabilities to run diagnostic - proceeding
>)
MOVEI S1,.FHSLF ;Incase PMSGC called above
MOVE T1,S2 ;Enable all capabilites
EPCAP% ;Enable TOPS-20 capabilities
JRST TOPLVL ;Enter top level parser
;Here to get the CPU number and so on from the monitor.
CPUNUM: SKIPE CPUSER ;Been here before?
$RET ;Yep, avoid GLXLIB bug
$CALL .CPUTY ;Ask GLXLIB for CPU type
CAIL S1,2 ;Is it
CAILE S1,5 ; in known range?
TDZA S2,S2 ;Nope, say nothing
MOVE S2,[EXP 'KI10 ','KL10 ','KS10 ']-2(S1)
MOVEM S2,CPUTYP ;Save sixbit CPU type
SKIPE MONTYP ;Skip if TOPS-10
JRST CPUN20 ;Tops-20
MOVE S1,[20,,11] ;Load %CNSER CPU0 serial number
GETTAB S1, ;Get it
SETZ S1, ;Error- punt it off
MOVEM S1,CPUSER ;Save it there
$RET ;Return to caller
CPUN20: MOVEI S1,.APRID ;Load table for APRID number
GETAB% ;Get it
SETZ S1, ;Error? punt
MOVEM S1,CPUSER ;Save it
$RET ;Return
;Here is the text string output to terminal and log file when we are started.
ANNOUN: ITEXT (<RMTCON Network Interconnect Services
Version ^V/.JBVER##/, ^W/CPUTYP/, TOPS-^D/OPSNUM/, CPU#=^D/CPUSER/
>)
SUBTTL Top Level Parser
;Here on a reparse.
REPARS: MOVE P,[IOWD PLEN,PDL] ;Here on reparse - reset stack
JRST PRSCM3 ; and restart parsing
;Here for top level commands, reloads the stack and parses a new command.
TOPLVL: MOVE P,[IOWD PLEN,PDL] ;Point to the stack (again)
MOVE S1,[XWD CSBTMP,CSB] ;Initialize the CSB by BLTing
BLT S1,CSB+.CMGJB ; the CSB template over it
;Normal commands loop.
PRSCM1: MOVE DP,[IOWD DPLEN,DPDL] ;Reset data stack
SKIPN S1,TAKIFN ;TAKE command in progress?
JRST PRSCM2 ;Not in a take command
HRLM S1,CSB+.CMIOJ ;Take command, set the input JFN
MOVE S1,[Point 7,[0]] ;Point to a zero
MOVEM S1,CSB+.CMRTY ;Reset the prompt to be nothing
PRSCM2: MOVEI S2,[FLDDB. (.CMINI)] ;Load address of init block
$CALL CMDPRS ;Init parser
;Enter here on reparse (after the CMINI call). Parse a keyword and dispatch.
PRSCM3: MOVEI S2,[FLDDB. (.CMKEY,,MAINCM)] ;Point to top level parsing block
$CALL CMDPRS ;parse top level command
HRRZ S1,@CR.RES(S2) ;Get the keyword address
$CALL (S1) ;Dispatch
JRST PRSCM1 ;Get another command
SUBTTL CONNECT Command
; ***********************************************************************
; 1. CONNECT PORT inputs a port number (0-3) & stores it in PRTNBR which
; is used as the CHANNEL-ID in LLMOP argument blocks.
;
; 2. CONNECT NODE inputs a 12 digit hex number (no spaces allowed) & stores
; it in TARADH & TARADL which is used as the destination address in the
; RESERVE CONSOLE argument block & other LLMOP's.
; ***********************************************************************
CONECT: MOVEI S2,[FLDDB. (.CMKEY,,CONTAB)] ;Point to connect table
$CALL CMDPRS ;Parse command
HRRZ S1,@CR.RES(S2) ;Get the keyword address
PJRST (S1) ;Dispatch
;Here for CONNECT PORT n
.CONP: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/number/]>)] ;Noise word
$CALL CMDPRS ;Output the noise
MOVEI S2,[FLDDB. (.CMKEY,,PRTTAB)] ;Point to port block
$CALL CMDPRS ;Parse the port number
HRRZ S1,@CR.RES(S2) ;Get port number
$CALL CMDCFM ;Confirm command first
MOVEM S1,PRTNBR ;Save
$RET
;Here for CONNECT ADDRESS nnnnnnnnnnnnnnnn
.CONN: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/address/]>)] ;Noise word
$CALL CMDPRS ;Output the noise
MOVEI S2,[FLDDB. (.CMFLD,,,<12 digit HEX address>)]
$CALL CMDPRS ;Parse that
$CALL HEX ;Input hex digits
CAIE T2,^D12 ;12 Digits ?
JRST [$CALL CMDLOG ;Log the command
$PMSGR <? Illegal format of HEX address>] ;Report error/return
$CALL CMDCFM ;Confirm that command
MOVEM P2,TARADH ;Put node number and entry bit in table
MOVEM P3,TARADL
PJRST $REMOT ;Do RCSEND & RCPOLL's (in RMTCOM)
SUBTTL ENABLE Command
;#***********************************************************************
; Enable debug, logging, spear or trace
;#***********************************************************************
ENABLE: MOVEI S2,[FLDDB. (.CMKEY,,ENATAB)] ;Enable commands
$CALL CMDPRS ;Parse keyword
HRRZ S1,@CR.RES(S2) ;Get the keyword address
PJRST (S1) ;Dispatch
;Here for ENABLE DEBUG
EN.DEB: SKIPE DBGFLG ;Skip if debugging now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Debug mode is already enabled>)] ;Give message
$CALL CMDCFM ;Confirm that command
SETOM DBGFLG ;Enable debug
$RET ;Return
;Here to ENABLE SPEAR-REPORTING
EN.SPE: SKIPE SPRFLG ;Skip if spearing now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? SPEAR Reporting is already enabled>)]
SKIPN MONTYP ;Must be a TOPS-20 system
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Cannot enable SPEAR reporting on TOPS-10>)]
$CALL CMDCFM ;Confirm that command
SETOM SPRFLG ;Enable spear
$RET
;Here to ENABLE TRACE
EN.TRA: SKIPE TRCFLG ;Skip if spearing now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Trace mode is already enabled>)]
$CALL CMDCFM ;Confirm that command
SETOM TRCFLG ;Enable trace
$RET
;Here for ENABLE LOGGING
EN.LOG: SKIPE LOGIFN ;Logging enabled now?
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Logging is already enabled, type DISABLE LOGGING first>)]
MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/to file/]>)]
$CALL CMDPRS ;Do it
SETZM GJFBLK ;Clear first word
MOVE S1,[GJFBLK,,GJFBLK+1] ;Set up to clear block
BLT S1,GJFBLK+GJFSIZ-1 ;Clear the block
SKIPN MONTYP ;Skip if TOPS-20
JRST EN.LO5 ;TOPS-10
;TOPS-20 ENABLE LOGGING command
MOVX S1,GJ%FOU ;File is for output
MOVEM S1,GJFBLK+.GJGEN ; into flags word
MOVE S1,CSB+.CMIOJ ;Load I/O JFNs
MOVEM S1,GJFBLK+.GJSRC ; into block
HRROI S1,[ASCIZ/RMTCON/] ;Point at default file name
MOVEM S1,GJFBLK+.GJNAM ;Save for GTJFN
HRROI S1,[ASCIZ/LOG/] ;Default extension
MOVEM S1,GJFBLK+.GJEXT ;Save in GTJFN block
HRROI S1,[ASCIZ/DSK/] ;Get the default structure
MOVEM S1,GJFBLK+.GJDEV ;Save the device
MOVEI S2,[FLDDB. (.CMFIL,,,,<RMTCON.LOG>)] ;Output file type
$CALL CMDPRS ;Hello GLXLIB
MOVE S2,CR.RES(S2) ;Load the resulting JFN
$CALL CMDCFM ;Confirm that
HRROI S1,LOGFD+.FDSTG ;Point to the FD
MOVX T1,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!FLD(.JSAOF,JS%GEN)!JS%PAF
JFNS% ;JFN to string
ERJMP .+1 ;Error, ignore it
MOVE S1,S2 ;Reload the JFN
RLJFN% ;Release it please
ERJMP .+1 ;Error? Punt it
JRST LOGOPN ;Open the logging file and return
;Here for TOPS-10 ENABLE LOGGING command
EN.LO5: MOVE S1,[SIXBIT/RMTCON/] ;Get file name
STORE S1,GJFBLK+.FDNAM ;Save in default block
MOVSI S1,'CMD' ;Get default extension
STORE S1,GJFBLK+.FDEXT ;Save in block
MOVSI S1,'DSK' ;Get structure name
STORE S1,GJFBLK+.FDSTR ;Save the structure
MOVEI S2,[FLDDB. (.CMOFI,,,,<RMTCON.LOG>)] ;Input file
$CALL CMDPRS ;Hello GLXLIB
MOVE S1,[GJFBLK,,LOGFD] ;Set up to copy into FD
BLT S1,LOGFD+GJFSIZ-1 ;Clear the block
$CALL CMDCFM ;Confirm the command
JRST LOGOPN ;Open the log file and return
SUBTTL DISABLE Command
;#***********************************************************************
; Disable debug, logging, spear or trace
;#***********************************************************************
DISABL: MOVEI S2,[FLDDB. (.CMKEY,,DIATAB)] ;Point to disable table
$CALL CMDPRS ;Parse keyword
HRRZ S1,@CR.RES(S2) ;Get the keyword address
PJRST (S1) ;Dispatch
;Here for DISABLE DEBUG
DA.DEB: SKIPN DBGFLG ;Skip if debugging now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Debug mode is already disabled>)] ;Give msg and ret
$CALL CMDCFM ;Confirm the command
SETZM DBGFLG ;Disable debug
$RET
;Here for DISABLE SPEAR
DA.SPE: SKIPN SPRFLG ;Skip if spearing now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? SPEAR is already disabled>)] ;Give message and ret
$CALL CMDCFM ;Confirm the command
SETZM SPRFLG ;Disable spear
$RET
;Here for DISABLE TRACE
DA.TRA: SKIPN TRCFLG ;Skip if trace now
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Tracing is already disabled>)] ;Give msg and ret
$CALL CMDCFM ;Confirm the command
SETZM TRCFLG ;Disable trace
$RET
;Here for DISABLE LOGGING
DA.LOG: SKIPN LOGIFN ;Skip if a log file there
JRST [$CALL CMDLOG ;Log the command
$PMSGR (<? Logging was not enabled>)] ;Owie
$CALL CMDCFM ;Confirm the command
PJRST LOGCLS ;Close the log file
SUBTTL REDEFINE Command
;#***************************************************************************
;Redefine the "EXIT CHAR" to be any of those listed below.
;note, the entire word "CONTROL" must be entered.
;#***************************************************************************
REDEFI: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/exit character/]>)]
$CALL CMDPRS ;Do it
MOVEI S2,[FLDDB. (.CMKEY,,.TSWC,,,CFM)]
$CALL CMDPRS ;Parse that command please
HRRZ T1,CR.PDB(S2) ;Load PDB used
CAIN T1,CFM ;Was it a conform?
JRST REDEF1 ;Yes
HRRZ S1,@CR.RES(S2) ;Load the resulting character
$CALL CMDCFM ;Confirm command
MOVEM S1,TTEXIT ;Set it up
REDEF1: MOVE S1,TTEXIT ;Load TTY exit character
ADDI S1,"A"-1 ;Convert to ASCII
$TEXT (,<TTY Exit character = control-^7/S1/>)
$RET ;Return
SUBTTL HELP Command
;Here on a HELP command
HELP: MOVE T4,[POINT 7,HLPBUF] ;Get pointer to help buffer
SETZB T3,HLPBUF ;Make easy check for nothing typed
MOVEI S2,HLPPRS ;Parse to help
$CALL CMDPRS ;Parse it
$CALL HLPATM ;Copy that atom please
;Command has been parsed and thing to get help on is in HLPBUF, set up flags
HELP1: SETZM HLPEOF ;Not EOF on help file
SETZM T4 ;Initially not outputting anything
MOVE S1,HLPBUF ;Load help buffer contents
CAME S1,[ASCIZ/*/] ;Was it star?
SKIPN HLPBUF ;Skip if something typed
SETOB T3,T4 ;Yes, output first text you see
;Open up the help file for reading.
DMOVE S1,[EXP <SIXBIT/DSK/>,<ASCII/dsk:d/>] ;Load first place to look
$CALL HFIND ;Try and find it there
JUMPT HELP2 ;Jump if we got it
DMOVE S1,[EXP <SIXBIT/HLP/>,<ASCII/hlp:d/>] ;Load second place
$CALL HFIND ;Try and find it there
JUMPT HELP2 ;Jump if we got it
DMOVE S1,[EXP <SIXBIT/SYS/>,<ASCII/sys:d/>] ;Load third place to look
$CALL HFIND ;Try and find it there
JUMPF HLPERR ;Jump if we didn't get it
;Ready to read help file, line at a time. First check EOF flag.
HELP2: SKIPE HLPEOF ;Eof?
JRST HELP7 ;Release it and return to top level
$CALL HREAD ;Read in a line from the file
;Check the first character on the line, if its a "*" then we must check more
HELP3: CAIE T1,"*" ;Is it a keyword start?
JRST HELP6 ;Nope
SETZM T4 ;Not outputting text any more
SKIPN HLPBUF ;Skip if some specific help request
SETOM HLPEOF ;Yes, simulate EOF at first "*"
HRROI S2,HLPLIN ;Point to help line
HRROI S1,HLPBUF ;Point to buffer
$CALL S%SCMP ;Call string comparison routine
MOVE S2,HLPBUF ;Load help buffer contents
CAME S2,[ASCIZ/*/] ;Was it star?
SKIPN S1 ;Exact match?
SETOB T3,T4 ;Yes, we should output text now
JRST HELP2 ;Get another line
;Here if line didn't begin with "*", output the line if output flag is set.
HELP6: HRROI S1,HLPLIN ;Point to line of text
SKIPE T4 ;Outputting now?
$CALL SOUT%% ;Output to terminal
JRST HELP2 ;Loop for more
;Here at end of file, determine if something has been printed.
HELP7: SKIPN T3 ;Skip if something was found
$TEXT (,<% Sorry, no information on "^T/HLPBUF/">)
MOVE S1,HLPIFN ;Load the help IFN
PJRST F%REL ;Release it and return
;Here to read a line from the help file into HLPLIN, returns S1/first character
HREAD: MOVE S1,HLPIFN ;Load the IFN
MOVE T2,[Point 7,HLPLIN] ;Load pointer to line of text
$CALL F%IBYT ;Get the first character of the line
JUMPF HREAD2 ;Punt - EOF
CAIE S2,"!" ;Eat this line?
SKIPA T1,S2 ;No, copy the character to T1
SETO T1, ;Indicate it was a comment line
CAIE S2,"*" ;Asterisk?
IDPB S2,T2 ;No, store the 1st character of line
HREAD1: $CALL F%IBYT ;Get a byte
JUMPT HREAD3 ;Jump if not EOF
HREAD2: SETOM HLPEOF ;Now it was an EOF
JRST HREAD5 ;Deposit a null and return
HREAD3: CAIN S2,.CHCRT ;Was it a return?
JRST HREAD1 ;Yes, eat it
CAIN S2,.CHLFD ;Was it a linefeed?
JRST HREAD4 ;Yes, end of line
IDPB S2,T2 ;Store the character
JRST HREAD1 ;Loop
HREAD4: JUMPL T1,HREAD ;If it was a comment start another line
CAIN T1,"*" ;Line start with a star?
JRST HREAD5 ;Yes
MOVEI S2,.CHCRT ;Load a return
IDPB S2,T2 ; and store it
MOVEI S2,.CHLFD ;Load a line feed
IDPB S2,T2 ; and store that
HREAD5: SETZ S2, ;Clear S2
IDPB S2,T2 ;Store it here
$RET ;Return
;Copy atom buffer to help text buffer, returns T1/PDB used
HLPATM: HRRZ T1,CR.PDB(S2) ;Load PDB used
CAIN T1,CFM ;Was it a confirm?
$RET ;Return, all set
CAIN T1,HLPALL ;Was it help all?
JRST HLPAT4 ;yes
HLRZ S1,@CR.RES(S2) ;Get address of ASCIZ text
HRLI S1,(Point 7,) ;Make byte pointer
HLPAT1: ILDB T1,S1 ;Get first character
IDPB T1,T4 ;Not zero, put it in help buffer
JUMPN T1,HLPAT1 ;Not null, loop for more
$RET ;Return
HLPAT4: MOVSI S1,(<ASCIZ/*/>) ;Load a star
MOVEM S1,HLPBUF ;Save it as the request type
JRST CMDCFM ;Confirm it and return
;Here to try and find the help file, called with S1/TOPS-10 dev, S2/TOPS-20 dev
;Returns false if not found, returns true with file open and HLPIFN set.
HFIND: MOVEM S1,HLPFD1+.FDSTR ;Save TOPS-10 structure name
MOVEM S2,HLPFD2+.FDSTG ;Save TOPS-20 first 5 characters
SKIPE MONTYP ;Skip if TOPS-10
SKIPA S2,[HFOB20] ;TOPS-20
MOVEI S2,HFOB10 ;TOPS-10
MOVEI S1,FOB.SZ ;Load size of the FOB
$CALL F%IOPN ;Open up input file
$RETIF ;Return if false
MOVEM S1,HLPIFN ;Save IFN of help file
$RETT ;Return OK
;Here if help file open problem
HLPERR: $TEXT (,<? Help not available - ^E/S1/>)
$RET ;Return
SUBTTL IDENTIFY Command
;#***********************************************************************
;Enter via "IDENTIFY" (addr) Command.
;Node does not have to be selected (reserved).
;The req id will return info (status) on desired node.
;#***********************************************************************
REQU: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/node/]>)]
$CALL CMDPRS ;Do it
MOVEI S2,[FLDDB. (.CMFLD,,,<12 digit HEX address>)]
$CALL CMDPRS ;Parse that
$CALL HEX ;Input hex digits
CAIE T2,^D12 ;12 Digits ?
JRST [$CALL CMDLOG ;Log the command
$PMSGR <? Illegal format of HEX address>] ;Report error/return
$CALL CMDCFM ;Confirm that command
;Save trace flag, do the request id
$SAVE <TRCFLG> ;Save trace flag
SETZM TRCFLG ;No trace right now
SETOM RRIFLG ;Do request ID printout flag
$CALL RRID ;Do Req-ID for this node
SETZM RRIFLG ;Clear req-id flag
$RET ;Return to parser
SUBTTL SET-PASSWORD Command
;#************************************************************************
;Enter via "SET-PASSWORD" command.
;Take up to 16 hex digits & store in PWORDH/L.
;The Password is used in RCRBT & RCRSV
;#************************************************************************
SETPW: MOVEI S2,[FLDDB. (.CMFLD,,,<12 digit HEX password>)]
$CALL CMDPRS ;Parse that
$CALL HEXPW ;Input hex password digits
$CALL CMDCFM ;Confirm that command please
MOVEM P2,PWORDH ;Hi = bytes 7,6,5,4,z
MOVEM P3,PWORDL ;Lo = bytes 3,2,1,0,z
$RET ;Return
SUBTTL READ-COUNTERS Command
;#*************************************************************************
;Enter via "READ-COUNTERS" (addr) Command.
;Node does not have to be selected (reserved).
;The counter information will be returned on the desired node.
;#*************************************************************************
RDCTRS: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/node/]>)]
$CALL CMDPRS ;Do it
MOVEI S2,[FLDDB. (.CMFLD,,,<12 digit HEX address>)]
$CALL CMDPRS ;Parse that
$CALL HEX ;Input hex digits
CAIE T2,^D12 ;12 Digits ?
JRST [$CALL CMDLOG ;Log the command
$PMSGR <? Illegal format of HEX address>] ;Report error/return
$CALL CMDCFM ;Confirm that command
PJRST RRCT ;Do read counters for this node
SUBTTL SHOW Command
;Here for the SHOW command to show things on the terminal.
SHOW: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/current state of/]>)]
$CALL CMDPRS ;Output the noise
MOVEI S2,[FLDDB. (.CMKEY,,SHOTAB)] ;Point to parse table
$CALL CMDPRS ;Parse command
HRRZ S1,@CR.RES(S2) ;Get the keyword address
$CALL CMDCFM ;Confirm that please
PJRST (S1) ;Dispatch
;SHOW LOGGING
SHOLOG: SKIPN LOGIFN ;Is logging enabled?
$PMSGC (<Logging is disabled>) ;Nope
SKIPE LOGIFN ;is logging enabled?
$TEXT (,<Logging is enabled to file ^F/LOGFD/>)
$RET
;SHOW DEBUG
SHODEB: SKIPN DBGFLG ;Is debug enabled?
SKIPA S1,[ASCIZ/dis/] ;Disabled
MOVEI S1,(ASCIZ/en/) ;Enabled
$TEXT (,<Program DEBUG is ^T/S1/abled>)
$RET
;SHOW SPEAR
SHOSPE: SKIPN SPRFLG ;Is spear enabled ?
SKIPA S1,[ASCIZ/dis/] ;Disabled
MOVEI S1,(ASCIZ/en/) ;Enabled
$TEXT (,<Reports to SPEAR are ^T/S1/abled>)
$RET
;SHOW ALL
SHOALL: $CALL SHODEB ;Show debug
$CALL SHOLOG ;Show logging
$CALL SHOSPE ;Show spear
;Fall through to show trace
;SHOW TRACE
SHOTRA: SKIPN TRCFLG ;Is trace enabled ?
SKIPA S1,[ASCIZ/dis/] ;Disabled
MOVEI S1,(ASCIZ/en/) ;Enabled
$TEXT (,<Program TRACE is ^T/S1/abled>)
$RET
;SHOW NODES
SHONOD: PUSHD <TRCFLG> ;Save TRACE flag
SETOM TRCFLG ;Force TRACE
$CALL RCADR ;Do the LLMOP to read local node addr
NOP ; error return
POPD <TRCFLG> ;Restore TRACE
PJRST SALLAD ;All REMOTE NODE addresses on network
SUBTTL TAKE Command
;Here to process TAKE command
TAKE: SKIPE TAKIFN ;In a TAKE already?
JRST TAKE7 ;Yep
SETZM GJFBLK ;Clear first word
MOVE S1,[GJFBLK,,GJFBLK+1] ;Set up to clear block
BLT S1,GJFBLK+GJFSIZ-1 ;Clear the block
MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/commands from/]>)]
$CALL CMDPRS ;Do the noise
SKIPN MONTYP ;Skip if TOPS-20
JRST TAKE1 ;TOPS-10
;TOPS-20 take command
MOVX S1,GJ%OLD ;File must exist
MOVEM S1,GJFBLK+.GJGEN ; into flags word
MOVE S1,CSB+.CMIOJ ;Load I/O JFNs
MOVEM S1,GJFBLK+.GJSRC ; into block
HRROI S1,[ASCIZ/RMTCON/] ;Point at default file name
MOVEM S1,GJFBLK+.GJNAM ;Save for GTJFN
HRROI S1,[ASCIZ/CMD/] ;Default extension
MOVEM S1,GJFBLK+.GJEXT ;Save in GTJFN block
HRROI S1,[ASCIZ/DSK/] ;Get the default structure
MOVEM S1,GJFBLK+.GJDEV ;Save the device
MOVEI S2,[FLDDB. (.CMFIL,,,,<RMTCON.CMD>)] ;Input file type
$CALL CMDPRS ;Hello GLXLIB
MOVE S2,CR.RES(S2) ;Load the resulting JFN
$CALL CMDCFM ;Confirm that
HRROI S1,TAKFD+.FDSTG ;Point to the FD
MOVEM S2,TAKIFN ;Save the take JFN
SETZ T1, ;Default format
JFNS% ;JFN to string
ERJMP .+1 ;Error, ignore it
MOVE S1,TAKIFN ;Get the JFN again
MOVX S2,OF%RD!FLD(7,OF%BSZ) ;Read 7 bit bytes
OPENF% ;Pry it open
ERJMP TAKE6 ;Error, punt
JRST TAKE3 ;Give startip message
;Here for TOPS-10 TAKE command
TAKE1: MOVE S1,[SIXBIT/RMTCON/] ;Get file name
STORE S1,GJFBLK+.FDNAM ;Save in default block
MOVSI S1,'CMD' ;Get default extension
STORE S1,GJFBLK+.FDEXT ;Save in block
MOVSI S1,'DSK' ;Get structure name
STORE S1,GJFBLK+.FDSTR ;Save the structure
MOVEI S2,[FLDDB. (.CMIFI,,,,<RMTCON.CMD>)] ;Input file
$CALL CMDPRS ;Hello GLXLIB
MOVE S1,[GJFBLK,,TAKFD] ;Set up to copy into FD
BLT S1,TAKFD+GJFSIZ-1 ;Clear the block
$CALL CMDCFM ;Confirm the command
MOVEI S1,FOB.SZ ;Load size of FOB
MOVEI S2,TAKFOB ;Point to the FOB
$CALL F%IOPN ;Open up the thing
JUMPF TAKE6 ;Punt if an error
MOVEM S1,TAKIFN ;Save the IFN
;Here to give startup message and then return for commands.
TAKE3: $TEXT (,<[Processing ^F/TAKFD/]>)
$RET ;Return to get commands from file
;Here if an error opening the file, etc.
TAKE6: $TEXT (,<? ^E/S1/>) ;Give error message
JRST TAKABT ;Abort the take
;Here if in a take already.
TAKE7: $CALL CMDLOG ;Log the command
$PMSGC (<? Nested TAKE files are illegal>)
;Here to get a character from the take file. Returns FALSE if no char return.
TAKCHR: SKIPN S1,TAKIFN ;Skip if a JFN there
$RETF ;Nope
SKIPN MONTYP ;Skip if orange
JRST TAKCH1 ;Blue, just call GLXFIL
BIN% ;Get a byte please
ERJMP TAKCH2 ;Owie if error
CAIN S2,.CHLFD ;Linefeed?
JRST TAKCHR ;Yep, loop for more charaters
MOVE S1,S2 ;Copy character to S1
$RETT ;Return with byte in S1
TAKCH1: $CALL F%IBYT ;Input a character
JUMPF TAKCH2 ;Jump if an error
CAIN S2,.CHLFD ;Linefeed?
JRST TAKCHR ;Yep, loop for more charaters
MOVE S1,S2 ;Copy to S1
$RETT ;Return if OK, fall thru if not
TAKCH2: $CALL TAKEOF ;Check for EOF
$RETF ;Return with no character
;Here to check if we had an EOF on the take file, gives message if end,
; returns TRUE if it was EOF, false if not take file or not EOF
TAKEOF: SKIPN MONTYP ;Skip if TOPS-20
JRST TAKEO1 ;TOPS-10
SKIPN S1,TAKIFN ;Get input file JFN for take file
$RETF ;No take file so not EOF
GTSTS% ;Get the file's status
TXNN S2,GS%EOF ;At end of file?
$RETF ;Nope, not EOF
JRST TAKEO2 ;Yep
TAKEO1: SKIPE TAKIFN ;Skip if no take file
CAIE S1,EREOF$ ;End of file?
$RETF ;Nope, no take file or not EOF
TAKEO2: $TEXT (,<
[End of ^F/TAKFD/]>) ;End of take file
$CALL TAKABT ;Abort take file and return
$RETT ;Return true, it was EOF
;Here to abort/close a TAKE file
TAKABT: SKIPN S1,TAKIFN ;Skip if an IFN there
$RET ;None there, return now
SKIPE MONTYP ;Skip if TOPS-10
CLOSF% ;TOPS-20, close the file
ERJMP .+1 ;Ignore errors
SKIPN MONTYP ;Skip if TOPS-20
$CALL F%REL ;TOPS-10, release the file
SETZM TAKIFN ;No longer an IFN/JFN
$RET ;Return
SUBTTL QUIT/EXIT Command
;#**************************************************************************
;* QUIT command - Exit this program (NI SERVER) & return to system monitor.
;#**************************************************************************
.QUIT: MOVEI S2,[FLDDB. (.CMNOI,,<Point 7,[ASCIZ/to monitor level/]>)]
$CALL CMDPRS ;Output the noise
$CALL CMDCFM ;Confirm that
$CALL CTRSTR ;Restore controlling terminal
$CALL LOGCLS ;Disable logging
$CALL I%EXIT ;Exit program
SUBTTL Logging Subroutines
;* LOGOPN - Subroutine to open the log file, LOGFB already set up.
LOGOPN: MOVEI S1,FOB.SZ ;Load size of FOB
MOVEI S2,LOGFOB ;Point to the FOB
$CALL F%AOPN ;Open up the thing append mode
JUMPF LOGOP2 ;Error.. punt it
MOVEM S1,LOGIFN ;Save the IFN
$TEXT (LOUT%%,<^I/ANNOUN/^F/LOGFD/ opened at ^H/[-1]/
>) ;Start the log file
$TEXT (T%TTY,<[^F/LOGFD/ opened]>) ;Output logging filename
$RET ;Return
LOGOP2: $TEXT (,<? ^E/S1/, logging not enabled>)
$RET ;Give message and return
;* PCRLF - output CRLF to terminal
PCRLF: $SAVE <S1> ;Save an AC
HRROI S1,[ASCIZ/
/] ;Fall through to SOUT%%
;* SOUT%% - Routine that is called for string output to terminal.
; S1/ address of ASCIZ string
SOUT%%: $SAVE <P1,P2> ;Save an AC
TLO S1,-1 ;Make default byte pointer for PSOUT
MOVEI P1,(S1) ;Load the address of the string
HRLI P1,(Point 7) ;Make a byte pointer out of it
SKIPE MONTYP ;Skip if not TOPS-20
PSOUT% ;Output string to terminal
SKIPN MONTYP ;Skip if not TOPS-10
OUTSTR (S1) ;Output string to terminal
SKIPN LOGIFN ;Skip if a log file opened
$RET ;Nope, return now
SOUT%1: ILDB S1,P1 ;Load a byte
JUMPE S1,.POPJ ;Jump if done
$CALL LOUT%% ;Output the byte to the file
JRST SOUT%1 ;Loop for all bytes in the string
;* BOUT%% - Routine that is called for printing a character in S1.
; Sends character to terminal and log file if opened.
BOUT%%: SKIPE LOGIFN ;Skip if no logging IFN
$CALL LOUT%% ;Output to log file
SKIPE MONTYP ;Skip if not orange
PBOUT% ;Output byte to terminal
SKIPN MONTYP ;Skip if not blue
IONEOU S1 ;Output character to terminal
$RETT ;Return true for GLXTXT
;* LOUT%% - Routine to output character to LOG file, S1/ character
LOUT%%: $SAVE <S1,S2> ;Save the ACs in question
MOVE S2,S1 ;Copy byte to S2
SKIPN S1,LOGIFN ;Load the IFN
$STOP (LOC,Output to Log file when not opened)
$CALL F%OBYT ;Output the byte
$RETIT ;Return if OK
$TEXT (T%TTY,<? Output error to LOG file: ^E/S1/>)
;Fall thru to close LOG file
;* LOGCLS - Suboroutine to close the log file, checks if it was open first
LOGCLS: SKIPN S1,LOGIFN ;Skip and load existing IFN
$RET ;Return now
$TEXT (LOUT%%,<
^F/LOGFD/ closed at ^H/[-1]/>)
$CALL F%REL ;Release the IFN
SETZM LOGIFN ;Clear that IFN
SKIPT ;Skip if it went well
$TEXT (,<? ^F/LOGFD/ close error: ^E/S1/>)
SKIPF ;Skip if it didn't go so well
$TEXT (,<[^F/LOGFD/ closed]>) ;Close message
$RET ;Return OK
SUBTTL Parsing Subroutines
;#**********************************************************************
;* HEX subroutine
;
; This subroutine is called to read in a 12 digit hex node address.
; When inputting the 12 digit address the digits will be in the form:
;
; P2 = Hi addr = z,z,z,z,z,z,1,2,3 rejust to: 1,2,3,4,5,6,7,8,z
; P3 = Lo addr = 4,5,6,7,8,9,10,11,12 rejust to: 9,10,11,12,z,z,z,z,z
;
; The bytes will then be in the form: Hi = 0,1,2,3,z
; Lo = 4,5,z,z,z
;
; This subroutine is also called to read in a 16 digit PASSWORD from RMTCOP
; When inputting the 16 digit password, the digits will be in the form:
;
; P2 = Hi = z,z,1,2,3,4,5,6,7 rejust to: 1,2,3,4,5,6,7,8,z
; P3 = Lo = 8,9,10,11,12,13,14,15,16 rejust to: 9,10,11,12,13,14,15,16,z
;
; PWSWAP will then re-arrange the digits to be:
;
; P2 = Hi = 15,16,13,14,11,12,9,10,z = bytes 7,6,5,4,z
; P3 = Lo = 7,8,5,6,3,4,1,2,z = bytes 3,2,1,0,z
;
; Hyphens will be ignored.
; Any other non hex digit will cause this subroutine to exit.
;#**********************************************************************
HEXPW: TDZA P4,P4 ;Clear P4 (password mode) and skip
HEX: SETO P4, ;Set P4/-1 (address)
SETZB P2,P3 ;Clear p2 and p3
SETZM T2 ;Set digit count to 0
MOVE T3,[POINT 7,ATMBUF] ;Set up byte pointer atom buffer
HEXA: ILDB S1,T3 ;Read in a char
JUMPE S1,HEXC ; 0 = end of field, rejustify it
CAIL S1,60 ;Less than a 0 ?
CAILE S1,71 ;Greater than a 9 ?
JRST HEXD ; Yes check for a-f
SUBI S1,60 ;No, so convert char to hex
HEXB: ROTC P2,4 ;Left 4 places (combined p2/11)
ADD P3,S1 ;Add new number to p3
AOJA T2,HEXA ;Bump digit counter and go get next
HEXD: CAIL S1,"A" ;Less than an "A"
CAILE S1,"F" ;Greater than an "F"
JRST HEXE ; Yes, see if lower case characters
SUBI S1,67 ;Convert char into hex number
JRST HEXB ;Pack it into the hex node number
HEXE: CAIL S1,"A"+40 ;Less than an a
CAILE S1,"F"+40 ;Greater than an f
JRST HEXG ; Yes, see if hyphen
SUBI S1,40+67 ;Make lower case into hex
JRST HEXB ;Pack it into the hex node number
HEXG: CAIE S1,"-" ;hyphen?
JRST HEXX ; no, error...exit
JRST HEXA ;yes, ignore & input next char
HEXC: JUMPN P4,REJUS ;Jump if address mode selected
PJRST PWSWAP ;Swap password bytes around
HEXX: $RET
;#**********************************************************************
;* REJUS subroutine
;
; Rejustifies a node address to the standard format used by
; LLMOP jsys/uuo's argument block.
;
; Upon return, P2 & P3 will be in the following format:
;
; P2 = Hi addr = x,x,x,x,x,x,1,2,3 rejust to: 1,2,3,4,5,6,7,8,z
; P3 = Lo addr = 4,5,6,7,8,9,10,11,12 rejust to: 9,10,11,12,z,z,z,z,z
;#**********************************************************************
REJUS: $SAVE <T1,S2,S1> ;Save some ac's
SETZM S1 ;Clear s1
LDB S2,[POINT 8,P3,^D27] ;Get hex digits 9 and 10
DPB S2,[POINT 8,S1,7] ;Put it in s1
LDB S2,[POINT 8,P3,^D35] ;Get hex digits 11 and 12
DPB S2,[POINT 8,S1,^D15] ;Put it in s1
MOVEM S1,T1 ;Store rejustified lo address
SETZM S1 ;Clear s1
LDB S2,[POINT 8,P2,^D31] ;Get hex digits 1 and 2
DPB S2,[POINT 8,S1,7] ;Put them in s1
LDB S2,[POINT 4,P2,^D35] ;Get hex digit 3
DPB S2,[POINT 4,S1,^D11] ;Put it in s1
LDB S2,[POINT 4,P3,^D3] ;Get hex digit 4
DPB S2,[POINT 4,S1,^D15] ;Put it in s1
LDB S2,[POINT 8,P3,^D11] ;Get hex digits 5 and 6
DPB S2,[POINT 8,S1,^D23] ;Put it in s1
LDB S2,[POINT 8,P3,^D19] ;Get hex digits 7 and 8
DPB S2,[POINT 8,S1,^D31] ;Put it in s1
MOVEM S1,P2 ;Put rejustified Hi addr back in P2
MOVEM T1,P3 ;Put rejustified Lo addr back in P3
$RET
;#**********************************************************************
;* PWSWAP subroutine
;
; Upon return, P2 & P3 will be in the following format:
;
; P2 = Hi bytes = 0,1,2,3,z rejust to: 7,6,5,4,z
; P3 = Lo bytes = 4,5,6,7,z rejust to: 3,2,1,0,z
;#**********************************************************************
PWSWAP: $SAVE <T1,T2,T3,T4> ;Save some ACs
ROTC P2,4 ;Yes, left 4 places combined
ROT P2,4
SETZB T1,T2
MOVE T4,[POINT 8,P2] ;Set byte pointer
ILDB T3,T4 ;Get byte 0
DPB T3,[POINT 8,T2,31] ; & put in T2
ILDB T3,T4 ;Get byte 1
DPB T3,[POINT 8,T2,23] ; & put in T2
ILDB T3,T4 ;Get byte 2
DPB T3,[POINT 8,T2,15] ; & put in T2
ILDB T3,T4 ;Get byte 3
DPB T3,[POINT 8,T2,7] ; & put in T2
ILDB T3,T4 ;Get byte 4
DPB T3,[POINT 8,T1,31] ; & put in T1
ILDB T3,T4 ;Get byte 5
DPB T3,[POINT 8,T1,23] ; & put in T1
ILDB T3,T4 ;Get byte 6
DPB T3,[POINT 8,T1,15] ; & put in T1
ILDB T3,T4 ;Get byte 7
DPB T3,[POINT 8,T1,7] ; & put in T1
DMOVE P2,T1 ;T1,T2 to P2,P3
$RET
;* CMDCFM - subroutine to parse a confirm.
CMDCFM: $SAVE <S1,S2> ;Save 2 ACs
MOVEI S2,CFM ;Just a confirm please
;Fall thru to parse it
;* CMDPRS - Come here to parse a command with function block in S2.
CMDPRS: MOVEI S1,CSB ;Point to the CSB
$CALL S%CMND ;Hello GLXLIB
JUMPF PARERR ;Pass along a false return
MOVE S1,CR.FLG(S2) ;Get flag word of reply block
TXNE S1,CM%NOP ;Was no-parse set?
JRST PARERR ;Yep
HRRZ S1,CR.PDB(S2) ;Load the PDB used
CAIE S1,CFM ;Was it the confirm one
$RET ;No, return to caller
;* CMDLOG - log a the contents of the command parse buffer
CMDLOG: $SAVE <P1,P2> ;Save a couple
MOVE P1,CSB+.CMPTR ;Copy buffer pointer so won't
SETZ P2, ; distrub it when we
IDPB P2,P1 ; insure a null at end of it
SKIPE LOGIFN ;Skip if not logging
$TEXT (LOUT%%,<^T/PROMPT/^T/BUFFER/^A>)
SKIPE TAKIFN ;Skip if not taking
$TEXT (T%TTY,<^T/PROMPT/^T/BUFFER/^A>)
$RET ;Return
;* PARERR - Come here on parse error to print standard message and return.
PARERR: $CALL TAKEOF ;Check for take command file EOF
JUMPT TOPLVL ;Return now if OK, end of take file
PARER1: $CALL S%ERR ;Load error text pointer to S1
SKIPT ;Skip if it was OK
MOVEI S1,[ASCIZ/Command error/] ;No? Load a default message
$CALL CMDLOG ;Log the command
$TEXT (,<? ^T/(S1)/, type HELP for help>) ;Publish message
SKIPN TAKIFN ;Skip if in a take
JRST TOPLVL ;No, restart everything
$TEXT (,<? Aborting TAKE file ^F/TAKFD/>) ;Give me a sign, o Leader
$CALL TAKABT ;Abort it
JRST TOPLVL ; and return to top level parser
SUBTTL Literals
;Here is the literal pool
LIT..P: XLIST ;LIT
LIT
LIST
END SETUP
;;;Local Modes:
;;;Mode: Macro
;;;Comment Column: 40
;;;End:
Reference in New Issue View Git Blame Copy Permalink