         SYSTEM   TRIGO
         PCC      0
         REF      M:LL,M:DO,M:LO,M:SI,M:OC,J:JIT,M:UC,J:TELFLGS
         REF      CMDTXT,CMDTV,CMDTL
         REF      DAY
         REF      J:DCBLINK         FOR DCB CLEANUP ON EXIT.
         SREF     FREEVM            PROGRAM FREE VIRTUAL ROUTINE
         SREF     PGMINIT           PROGRAM INITIALIZATION ROUTINE
         SREF     VERMSG            VERSION MESSAGE TEXTC
         SREF     TPROMPT           PROMPT TEXTC
*
         DEF      MAYBECR,CLIST
         DEF      ARGO,ARGH,ARGN,ARGT,ARGC
         DEF      OBUF
         DEF      BLANKS            4 BLANKS
         DEF      MLDTRC
         DEF      CMDBUF,CMDARG     COMMAND BUFFER AND CONTROL WORD
         DEF      WHUT              SCAN FOR COMMAND
         DEF      HUH               READ IN A COMMAND
         DEF      OYEAH             GROUSE ROUTINE
         DEF      LINK              M:LINK COMMAND HANDLER
         DEF      DOIT              PROCESSING LOOP
         DEF      AMIN              DO COMMAND ONCE A MINUTE
         DEF      EVERY             DO COMMAND EVERY # TICKS
         DEF      AGAIN             DO LAST THING AGAIN.
*
*        CMDSCN
*                 IS MEANT TO BE A GENERAL PURPOSE SCANNER PACKAGE.
*        IT PROVIDES INPUT AND SOMEWHAT SMART COMMAND SCANNING, ARGUMENT
*        COLLECTION ROUTINES, AND SOME COMMON PROGRAM SERVICES. THE COMMAND
*        TABLES THAT DRIVE IT, AS WELL AS THE COMMAND EXECUTION ROUTINES
*        ARE EXTERNAL. INPUT IS TAKEN FIRST FROM M:SI, FOR ONLINE AND
*        BATCH USE, AND FOR ONLINE, AFTER M:SI IS EXHAUSTED, THE TERMINAL
*        WILL BE USED FOR INPUT. IN GHOST MODE, THE OC IS USED FOR INPUT.
*
CODE     CSECT    1
         IDEF     CMDSCN
         TXTC     'CMDSCN'
         TITLE    'COMMUNICATIONS MODULE'
*
DATA     CSECT    0
*
*        FIXED DATA AREA
*
WHUTECB  DATA     0                 ECB WORD FOR M:KEYIN
*
INSWITCH DATA     0                 INITIAL READS COME FROM M:SI
*
MLDTRC   DATA     X'03000000'       M:LDTRC FOR RETURN ON M:LINK CALL
         DATA     0                 THE * FILE NAME GOES HERE.
*
MLINK    GEN,8,24 2,X'18'           M:LINK SKELETAL FPT
         REZ      7                 FOR @ COMMAND USEAGE.
*
CMDBUF   REZ      21                INPUT FROM M:KEYIN
CMDARG   DATA     0                 LENGTH, PTR TO ARGUMENT
CMDLEN   DATA     0                 LENGTH OF LAST THING READ
CMD      REZ      21                INDIVIDUAL COMMAND FOR PARSING
*
OBUF     REZ      44                AN OUTPUT BUFFER FOR PEOPLE TO USE
         PAGE
         USECT    CODE
BLANKS   TXT      '    '
MEH      TXTC     ' EH?'
MAMBIG   TXTC     ' WHAT?'
MQ       TXTC     '-'
MDIG     TXTC     'ILLEGAL DIGIT'
MRAN     TXTC     'VALUE OUT OF RANGE'
MHUH     TXTC     'UNREGOCNIZED VALUE'
MTL      TXTC     'STRING TOO LONG'
MCR      DATA     X'010D0000'       A CR FOR MISC USEAGE.
*
MKEYIN   GEN,8,24 4,0
         DATA     X'F0000000'       M:KEYIN
         DATA     MQ                QUERY MESSAGE.
         DATA     CMDBUF,80         INPUT BUFFER AND MAX LENGTH
         DATA     WHUTECB           AND ECB TO POST.
*
ZZ1      XPSD,0   1                 SLEEP FOR 1 TIC
*
TYPEIT   GEN,8,24 2,0               M:TYPE TO OPERATOR
         PZE      *0
         PZE      *R                OUT MSG IS POINTED TO BY R
READSI   GEN,8,24 X'10',M:SI
         DATA     X'F4000010'       ERR,ABN,BUF,SIZE,BTD,WAIT
         DATA     SIERR,SIERR       FOR ERROR AND ABNORMAL.
         DATA     CMDBUF,79,1
         PAGE
*
*        COMM
*                 IS THE STARTING POINT. THE USER IS GREETED, AND WE
*        EAGERLY AWAIT COMMANDS. DAY IS CALLED TO PUT OUT THE DATE AND
*        TIME IN A FORMAT THAT PEOPLE CAN UNDERSTAND.
*
COMM     EQU      %
         STW,SR1  MLDTRC+1          SAVE FOR POSSIBLE M:LINK ENTRY.
         LI,R     PGMINIT           IS THERE AN INIT ROUTINE TO DO??
         BLE      %+2
         BAL,L    PGMINIT           B/YES, DO IT.
         BAL,L    DAY               PRINT OUT TIME AND DATE
         LI,T     VERMSG            IS THERE A VERSION MESSAGE??
         BLE      POBUF             B/NOPE.
         LI,TU1   BA(OBUF)+1        COPY TO ADDR
         LB,R     *T                GET TEXTC LENGTH
         SLS,T    2                 MAKE THAT A BA
         AI,T     1                 POINT AFTER COUNT BYTE.
         LB,RU1   OBUF              CURRENTLY
         AW,TU1   RU1
         STB,R    TU1
         MBS,T    0                 COPY IT IN
         AW,R     RU1               ADD THE LENGTHS
         STB,R    OBUF              MAKE THAT THE NEW LENGTH.
POBUF    M:PRINT  (MESS,OBUF)       IN SANE FORMAT.
         M:INT    BREAK             SET UP DEFAULT BREAK CONTROL
         LC       J:JIT
         BCR,4    %+3
         M:TYPE   (MESS,OBUF)       IF GHOST, GREET THE OC
         MTW,1    INSWITCH          AND SET INSWITCH TO READ FROM OC.
SETPC    M:PC     '-'               SET PROMPT CHARACTER
DOIT     BAL,L    WHUT              GO GET COMMAND IN S TO DO.
         CI,S     X'A000'           IS THERE SOMETHING THERE????
         BLE      DOIT              B/NOPE, NOT IMPLEMENTED.
         LI,L     DOIT              SET RETURN FOR NON-BAL INSTRUCTIONS
         EXU      S                 GO DO THE COMMAND
         B        DOIT              AND BACK TO TOP.
*
*        DEFAULT BREAK CONTROL
*
BREAK    LI,R     3
         LH,R     *J:TCB,R          USE COUNT IN TCB STACK
         LCW,R    R
         MSP,R    *J:TCB            FLUSH THE STACK
         LC       J:JIT
         BCR,8    DOIT              IF NOT ONLINE, HOP BACK TO PROCESS.
         M:PURGE  (WRITE)           IF ONLINE, PURGE TERMINAL OUTPUT
         B        DOIT              AND THEN BACK TO SCANNING.
         PAGE
*
*        HUH
*                 IS THE ENTRY FOR READING FROM THE USER. THE INPUT
*        LINE IS PROPERLY LOGGED ON M:LL FOR BATCH, GHOST, AND IF SET
*        TO A LISTING DEVICE OR A FILE FOR ONLINE USERS.
*
HUH      LC       J:JIT             ARE WE ONLINE
         BCR,8    %+5               B/NOPE
         LI,T     TPROMPT           IF WE ARE, IS THERE A PROMPT THING
         BE       %+3               B/NOPE
         LB,T     TPROMPT           GET ITS LENGTH
         M:WRITE  M:UC,(BUF,TPROMPT),(BTD,1),(SIZE,*T),(WAIT)
         LI,R     BA(CMDBUF)+1
         LI,RU1   BA(AGT)+1         COPY OLD BUFFER TO AGAIN THING
         LW,T     CMDLEN
         STB,T    RU1
         STB,T    AGT
         MBS,R    0                 FOR AGAIN COMMAND TO WORK
         MTW,0    INSWITCH          IS THIS INITIAL COMMAND READS?
         BG       HUH0              B/NOPE. USE KEYIN.
         CAL1,1   READSI            IF SO, READ FROM SI, BTD=1.
         LH,RU1   M:SI+4            ARS
         SLS,RU1  -1                AT LEAST NOW ITS ARS....
         STB,RU1  CMDBUF            MAKE LOOK LIKE TEXTC....
         B        HUH1              AND GO PROCESS.
HUH0     LI,T     0
         STW,T    WHUTECB           CLEAR ECB
         CAL1,2   MKEYIN            HOWDY...WHATCHA WANT??
         MTW,0    WHUTECB           DONE TYPING YET??
         BE       %+3               B/YUP, GO PROCESS
         CAL1,8   ZZ1
         B        %-3
         LB,RU1   CMDBUF            GET BYTE COUNT
HUH1     LB,T     CMDBUF,RU1        LOOK AT LAST CHARACTER
         CI,T     X'15'
         BE       %+3               NASTY OLD NL......
         CI,T     X'D'
         BNE      %+3               OR NASTY OLD CR.....
         AI,RU1   -1                BUMP OFF CRUD CHARACTERS
         STB,RU1  CMDBUF            AND POKE LENGTH BACK
         LW,R     RU1               BEGIN CONTORTED LOGIC-SEE OYEAH....
         STW,RU1  CMDLEN            SAVE READ IN LENGTH.
SNEAK    LC       J:JIT             ARE WE ONLINE????
         BCR,8    HUH2              B/NOPE, LOG THE THING READ IN.
         LI,T     X'F'
         AND,T    M:LL              IS M:LO SET TO A DEVICE???
         CI,T     3
         BNE      HUH2              B/NOPE, LOG THE READ ON IT.
         LI,T     X'4000'           IF A DEVICE, IS IT A LISTING
         CW,T     M:LL+1            DEVICE??
         BAZ      HUH3              B/NOPE, DON'T LOG THE READ.
HUH2     LI,T     '-'               PROMPT CHARACTER USED ON READS.
         STB,T    CMDBUF
         AI,R     1                 BUMP COUNT COPY FOR A BIT...
         M:WRITE  M:LL,(BUF,CMDBUF),(SIZE,*R),(WAIT),(BTD,0)
         STB,RU1  CMDBUF
HUH3     LB,R     CMDBUF
         BNE      0,L               NON-NULL RETURN.
         B        HUH               ELSE GO READ AGAIN.
         PAGE
*
*        TO SIERR IF WE GET ERROR OR ABN RETURN ON M:SI. ASSUME
*        END OF FILE HIT, WITHOUT ACTUALLY CHECKING. TURN OFF
*        INSWITCH AND RE-READ USING KEYIN PROCEDURE.
*
SIERR    LI,R     1
         STW,R    INSWITCH          NO LONGER IN INITIAL PHASE...
         LC       J:JIT             ARE WE IN BATCH????
         BCR,12   SPLIT             IF SO, TIME TO QUIT.
         M:PC     ''                RESET PROMPT TO NULL.
         LI,R     X'F'
         AND,R    M:SI              IS M:SI A FILE????
         CI,R     1
         BNE      HUH               B/NOPE.
         LH,R     M:SI
         CI,R     X'0020'           IS IT OPEN????
         BAZ      HUH               B/NOPE
CLOSESI  M:CLOSE  M:SI,(SAVE)       IF OPEN, CLOSE IT.
         B        HUH               AND GO READ VIA M:KEYIN.
         PAGE
*
*        WE THINK THERE IS A COMMAND IN THE BUFFER NOW.
*
WHUT     PUSH     L
         LB,TU1   CMDBUF            HOW MUCH IN BUFFER????
         BG       %+3
WHUT0    BAL,L    HUH               NOT ENOUGH-GO READ MORE.
         B        WHUT+1
*
*        SKIP OVER LEADING BLANKS AND THEN MOVE THE COMMAND INTO
*        CMD, STOPPING IF A ';' IS HIT, OR RUN OUT OF STRING.
*        REMOVE ANY TRAILING BLANKS FROM COMMAND, AND SHUFFLE DOWN
*        REMAINING BYTES OF CMDBUF, READJUSTING THE COUNT.
*
         LI,7     1                 LOAD PTR FROM CMDBUF
         LI,6     1                 STORE PTR INTO CMD
         LB,O     CMDBUF,7
         CI,O     ' '
         BNE      WHUT1-1           FOUND A NON-BLANK.
         AI,7     1
         BDR,TU1  %-4               LOOK FOR NON-BLANKS.
         B        WHUT0             A LINE FULL OF BLANKS. CUTE....
*
*        MOVE STUFF UNTIL DELIMITER OR END HIT.
*
         LI,FF    ';'               STARTING DELIMITER
WHUT1    LB,O     CMDBUF,7
         CW,O     FF                DELIMITER HIT??
         BE       WHUT2-1           B/YUP, SPLIT.
         CI,O     '"'               IS THIS A FUNNY??
         BE       WHUT10            B/INDEED IT IS.
         CI,O     ''''              THE OTHER FUNNY????
         BNE      WHUT11            B/NOPE
WHUT10   CI,FF    ';'               WELL, IS IT THE THING TO DO
         BNE      %+2               B/NOPE.
         LW,FF    O                 IF IT'S THE RIGHT THING, LOAD IT.
WHUT11   STB,O    CMD,6             ELSE POKE THE BYTE AWAY
         AI,6     1
         AI,7     1                 BUMP POINTERS
         BDR,TU1  WHUT1             KEEP COPYING
         AI,7     -1                RE-BUMP POINTERS TO MAKE SANE
         AI,6     -1
WHUT2    LB,O     CMD,6             EXAMINE LAST CHR IN CMD
         CI,O     ' '
         BNE      %+2               B/NONBLANK
         BDR,6    WHUT2             KEEP LOOKING
         STB,6    CMD               LENGTH WITHOUT TRAILING BLNKS.
         CI,TU1   0                 WAS THERE ANYTHING LEFT?
         BE       WHUT3             B/NOPE
         LI,RU1   BA(CMDBUF)+1
         LI,R     BA(CMDBUF)+1
         AW,R     S
         AI,TU1   -1
         STB,TU1  RU1
         MBS,R    0                 SHUFFLE DOWN REMAINING STRING
WHUT3    STB,TU1  CMDBUF            SAVE REMAINING BYTE COUNT
         CI,L     0                 COMMAND LENGTH NON-ZERO??
         BE       WHUT+1            NOPE. LOOK SOME MORE.
*
*        ASSEMBLE UP TO 7 CHARACTERS OF COMMAND NAME AS A
*        TEXTC IN SR1 AND SR2 FOR COMPARISON.
*
         LB,L     CMD               LENGTH OF CMD
         LI,S     1                 LOAD/STORE/COUNT REGISTER
WHUT4    LB,O     CMD,S
         CI,O     ' '               STOP ON BLANKS
         BE       WHUT5
         CI,O     '='               OR EQUAL SIGN
         BE       WHUT5
         STB,O    SR1,S
         AI,S     1
         CI,S     8
         BG       WTF               A FUNNY.....LOOOOOOONNNNNGGGGG CMD.
         BDR,L    WHUT4
WHUT5    AI,S     -1
         STB,S    SR1               POKE BACK COUNT TO MAKE TEXTC
         CI,L     0                 ANYTHING LEFT
         BE       WHUT7             NOPE.
         AI,S     1                 POINT AT THE DELIMITER AGAIN
WHUT6    LB,O     CMD,S
         CI,O     ' '               SKIP OVER BLANKS AND =
         BE       %+3
         CI,O     '='
         BNE      WHUT8             ARG START FOUND
         AI,S     1
         BDR,L    WHUT6
WHUT7    LI,L     0
         STW,L    CMDARG            NO ARG.
         B        %+3
WHUT8    STW,S    CMDARG            FIRST ARG BYTE HERE
         STB,L    CMDARG            AND ARG LENGTH
         PAGE
*
*        WE SEARCH THE TEXTC DOUBLEWORD TABLE CMDTXT TO TRY AND MATCH ON
*        THE SIGNIFICANT CHARACTERS PRESENT IN SR1 AND SR2.
*
WHUTS    LI,T     BA(CMDTXT)        GOT TO GET SNEEKY. START LOOKIN HERE
         LI,TU1   33                =BA(R8)+1 TO IGNORE COUNT BYTES.
         LB,SR3   SR1               THE LENGTH
         STB,SR3  TU1               FOR THE CBS
         LI,L     0                 MATCH FLAG AND MATCH INDEX
         LI,S     0                 AND SEARCH INDEX
WHUTS1   AI,T     8                 LOOK AT NEXT DWORD ENTRY
         AI,S     1
         CI,S     CMDTL             RUN OUT OF LIST YET?
         BG       WHUTS2            YUP. SEE IF WE FOUND SOMETHING.
         LD,R     T
         AI,R     1                 POINT PAST LENGTH BYTE
         CBS,R    0                 DONT CLOBBER THE SET UP REGS.
         BNE      WHUTS1            NOT THIS ONE. LOOK MORE.
         CB,SR3   0,T               SEE IF THIS IS EXACT MATCH
         BE       WHUTHIT           B/YES, EXACT MATCH.
         CI,L     0
         BNE      WHUTSA            OOPS. SECOND MATCH HIT IN TABLE.
         LW,L     S                 SAVE MATCH INDEX IF FIRST...
         B        WHUTS1            AND LOOK SOME MORE.
WHUTSA   LI,L     -1                MARK AMBIGUOUS HIT
         B        WHUTS1            BUT KEEP LOOKING FOR EXACT HITS...
WHUTS2   CI,L     0
         BE       WTF               B/NOTHING FOUND, SPLIT
         BG       %+3
         LI,TU1   MAMBIG            IF TOO MUCH FOUND,
         B        OYEAH             COMPLAIN JUST AS MUCH.
         LW,S     L                 OF ONE, GET INDEX BACK.
WHUTHIT  LW,S     CMDTV,S           PICK UP ROUTINE ADDRESS
         LI,T     0    <========   THIS IS A KLUDGE ===================
RJ       PULL     L                 RESTORE LINK
         B        0,L               AND RETURN TO CALLER.
         PAGE
*
*        WTF- WTF DOES THIS MEAN????
*
WTF      LI,TU1   MEH               GROUSE MSG
*
*        OYEAH
*                 IS THE GENERAL GRIPE ROUTINE. THE ADDRESS OF A
*        TEXTC IS IN TU1. THE MESSAGE IS WRITTEN TO M:DO.
*
OYEAH    LB,R     *TU1              GET THE LENGTH
         LC       J:JIT
         BCR,8    %+2               B/NOT ONLINE.
OYEAHP   M:WRITE  M:DO,(BUF,*TU1),(BTD,1),(WAIT),(SIZE,*R)
         LW,T     TU1
         SLS,T    2                 MAKE BA.
         LI,TU1   BA(CMDBUF)        CLOSE YOUR EYES, THIS IS GOING TO
         STB,R    TU1               HURT A BIT.....
         MBS,T    0                 COPY MSG INTO INPUT BUFFER
         LI,RU1   0                 THIS WILL CLEAR THE COUNT
         PULL     L
         STW,RU1  CMDBUF            BUT MUST DO STORE IN CASE OF ONLINE
         LI,S     0                 TO RETURN TRASH COMMAND ADDRESS.
         BDR,R    SNEAK             AND SNEAK INTO LOGGING CODE.
*
*        MAYBECR SPITS OUT A CR IF WE ARE RUNNING ONLINE.
*
MAYBECR  MTW,0    J:JIT
         BG       0,L
         LI,R     MCR
         CAL1,2   TYPEIT
         B        0,L
         PAGE
*
*        ARGO     OCTAL NUMBER, VALUE RETURNED IN O
*        ARGN     DECIMAL NUMBER, VALUE RETURNED IN O
*        ARGH     HEX NUMBER, VALUE RETURNED IN O
*        ARGT     TEXT STRING, MAX # CHRS IN SR1, PUT INTO (S)
*        ARGC     TEXTC, MAX # CHRS IN SR1, PUT INTO (S) (WORD ADDR)
*
*        THE NUMERIC ROUTINES MAY DECLARE AN ERROR ON ILLEGAL DIGITS,
*        THE CHARACTER ROUTINES DECLARE ERROR ON TOO LONG STRING.
*        IF NO ARG WAS THERE, CC1 WILL BE SET ON RETURN. IF AN ARG IS
*        PRESENT, CC1 WILL BE RESET ON RETURN.
*
ARGO     LI,SR2   8                 LOAD OCTAL BASE
         B        ARGM
ARGN     LI,SR2   10
         B        ARGM
ARGH     LI,SR2   16
ARGM     PUSH     8,T
         LI,T     0
         LW,TU1   CMDARG            ANYTHING FOR US TO LOOK AT?
         BE       ARGSX             NOPE. BYE.....
         LI,O     0                 PRESET RESULT TO ZERO
         LI,L     1                 PRESET SIGN INDICATOR TO +
         LB,SR3   CMDARG            # OF BYTES REMAINING
         LB,T     CMD,TU1           LOOKY AT BYTE
         CI,T     '-'               FOR A MINUS SIGN.
         BNE      %+3               B/THAT'S NOT IT.
         LI,L     0                 SET FOR MINUS NUMBER.
         B        ARGML             AND PICK UP NEXT CHR
ARGM1    LB,T     CMD,TU1
         CI,T     ' '
         BE       ARGMS             END OF ARG HIT
         CI,T     ','
         BE       ARGMS
         CI,T     '9'
         BLE      %+3
ARGMD    LI,TU1   MDIG              DIGIT OUT OF PERMISSIBLE RANGE
         B        ARGGRP
         CI,T     '0'
         BGE      %+2
         AI,T     X'39'
         AI,T     -'0'              CONVERT TO X'0'-X'F'
         BL       ARGMD             OOPS. ROTTEN APPLE
         CW,T     SR2
         BGE      ARGMD             MUST BE LESS THAN RADIX.
         MW,O     SR2
         AW,O     T                 ADD IN NEW DIGIT
ARGML    AI,TU1   1
         BDR,SR3  ARGM1
         B        %+1,L
         LCW,O    O
         LI,TU1   0
         B        ARGM3             OUT OF STUFF.
ARGMS    B        %+1,L             FLIP SIGN IF MINUS
         LCW,O    O
ARGM2    LB,T     CMD,TU1
         CI,T     '.'
         BE       %+9
         CI,T     ' '               DID WE END ON A SPACE
         BE       %+3               B/YUP, SKIP SPACES
         CI,T     ','               BUT IF WE COME TO A COMMA,
         BE       %+5               DONT SKIP OVER THAT.
         AI,TU1   1
         BDR,SR3  ARGM2
         LI,TU1   0
         B        ARGM3
         AI,TU1   1                 COMMA HIT. BEWARE NULL ARG ',,'
         AI,SR3   -1
         BG       ARGM3             IF STUFF LEFT, OK.
         LI,TU1   0
ARGM3    STW,TU1  CMDARG            THIS IS WHATS LEFT
         STB,SR3  CMDARG
ARGX     PULL     8,T
         LCI      0                 RETURN CLEARING CC'S
         B        0,L               BYE......
ARGT     LI,SR2   0                 STRAIGHT TEXT
         LI,T     0
         B        ARGC+2
ARGC     LI,SR2   1                 RETURN TEXTC
         LI,T     1                 STARTING STORE INDEX FOR TEXTC
         PUSH     8,T               FOR EXIT THRU ARGM3.
         LW,TU1   CMDARG
         BE       ARGSX             NOTHING TO DO...
         LB,SR3   CMDARG
         LI,SR4   0                 DELIMITER TO SEARCH FOR
         LB,FF    CMD,TU1           SEE IF CHR IS SINGLE OR DOUBLE
         CI,FF    '"'               QUOTE MARK FOR TEXT DELIMITING
         BE       ARGC0             B/YES
         CI,FF    ''''              SINGLE QUOTE??
         BNE      ARGC1+1           B/NOPE
ARGC0    LW,SR4   FF                THE DELIMITER TO TAG ON
         B        ARGC10
ARGC1    LB,FF    CMD,TU1
         CI,SR4   0                 ARE WE WORKING ON A DELIMITER?
         BE       %+4               B/NOPE, STD DELIMITERS APPLY
         CW,FF    SR4               IS THIS IT??
         BE       ARGC2             B/YES, WE HIT IT.
         B        %+7
         CI,FF    ','
         BE       ARGC2
         CI,FF    ' '
         BE       ARGC2
         CI,FF    '.'               FILE NAME OR ACCOUNT END.
         BE       ARGC2
         STB,FF   *S,T
         AI,T     1
         CW,T     SR1               HIT MAX YET????
         BG       ARGCL             TOOOOO LONG.....
ARGC10   AI,TU1   1
         BDR,SR3  ARGC1
         LI,TU1   0
         CI,SR2   0
         BE       ARGM3             GO CLEAN UP.
         AI,T     -1
         STB,T    *S                IF TEXTC, PLUG IN COUNT
         B        ARGM3             AND GO CLEAN UP.
ARGC2    CI,SR2   0
         BE       ARGM2             GO FIND NEXT ARG START, IF ANY.
         AI,T     -1
         STB,T    *S
         B        ARGM2
ARGCL    LI,5     MTL               TOOOO LOOOOONNNNNGGG.
ARGGRP   LB,R     *TU1              GET THE LENGTH OF GRIPE.
         EXU      OYEAHP            COMPLAIN TO USER.....
ARGSX    PULL     8,T
         LCI      8                 SET CC1
         B        0,L               AND RETURN
         PAGE
*
*        LIST
*                 LIST ALL ENTRIES IN COMMAND TABLE
*
CLIST    PUSH     L
         LI,T     CMDTL-1           # OF COMMANDS DEFINED
         LI,TU1   CMDTXT+2          FETCH ADDRESS FOR COMMANDS
         LI,S     ' '               A BLANK FOR CLOBBERING TEXTC'S
CLIST0   LI,RU1   OBUF              WHERE TO PUT BODY
         LI,R     8                 # PER LINE
CLIST1   LD,SR1   *TU1              FETCH DW TEXTC
         STB,S    SR1               BLITZ COUNT BYTE
         STD,SR1  *RU1              POKE AWAY
         AI,TU1   2
         AI,RU1   2                 BUMP POINTERS
         BDR,T    %+2               RUN THRU LIST
         B        CLIST2            B/DONE
         BDR,R    CLIST1            8 PER LINE
         LI,R     63
         STB,R    OBUF              COUNT OF CHRS IN BUFFER
         LI,R     OBUF
         CAL1,2   TYPEIT            PRINT THAT LINE
         BAL,L    MAYBECR
         B        CLIST0            AND CONTINUE
CLIST2   AI,RU1   -OBUF             #WORDS
         SLS,RU1  2                 *4=#BYTES
         AI,RU1   -1
         STB,RU1  OBUF
         LI,R     OBUF
         CAL1,2   TYPEIT
         BAL,L    MAYBECR
         B        RJ
         PAGE
*
*        PRINT
*                 ISSUE A SUPERCLOSE CAL.
*
         DEF      PRINT
PRINT    CAL1,9   6
         B        0,L
*
*        XXX
*                 DO IMMEDIATE M:XXX CAL (ABORT)
*
         DEF      XXX
*
XXX      CAL1,9   3                 FAREWELL....
         PAGE
*
*        CLSDCBS
*                 RUN DOWN DCB CHAIN AND CLOSE ALL OPEN OUT OR OUTIN
*        DCBS WITH SAVE
*
CLSDCBS  LW,R     J:DCBLINK         THE START IS HERE.
         LW,S     =X'00200000'      Y002-DCB OPEN IF SET IN WORD 0
CLSD0    AI,R     1                 POINT TO DCB NAME
         LB,T     *R
         BNE      CLSD1             B/BYTE COUNT FOUND.
         LW,R     0,R               SEE IF DONE OR FLINK TO ANOTHER
         BE       0,L               BLOCK; BE-WE'RE DONE, END OF CHAIN.
         B        CLSD0             ELSE IS POINTER TO ANOTHER TABLE.
CLSD1    AI,T     4
         SLS,T    -2
         AW,R     T                 POINT TO DCB ADDRESS
         LW,RU1   0,R               GET DCB ADDRESS
         CW,S     0,RU1             SEE IF OPEN
         BAZ      CLSD0             B/NOPE.
         CW,O     1,RU1             IS IT OPEN OUT OR OUTIN???
         BAZ      CLSD0             B/NOPE, IN OR INOUT-DEFAULT IS SAVE.
         M:CLOSE  *RU1,(SAVE)       SLAM.
         B        CLSD0             AND LOOK AT NEXT ONE.
         PAGE
*
*        SPLIT
*                 EXIT THE PROGRAM
*
         DEF      SPLIT
*
SPLIT    BAL,L    CLSDCBS           CLOSE OUT AND OUTIN DCBS
         LB,R     MLDTRC+1
         CI,R     3                 WAS THIS M:LINK INVOCATION??
         BE       %+2               B/YES
         CAL1,9   1                 EXIT IF NOT.
         CAL1,8   MLDTRC            LOAD AND TRANSFER BACK.
*
*        OFF
*                 GOODBYE, CRUEL WORLD- LOG OFF.
*
         DEF      OFF
*
OFF      BAL,L    CLSDCBS           CLEAN UP DCBS
         M:LDTRC  'LOGON',':SYS'    AND SPLIT.
*        TIME
*                 GIVES THE TIME AND DATE.
*
         DEF      TIME
*
TIME     PUSH     L
         BAL,L    DAY
         EXU      POBUF             M:PRINT (MESS,OBUF)
         LI,R     PGMINIT           IN REF OVERLAY MODE, FORCE IN OVERLAY....
         B        RJ
         PAGE
*
*        THE @ COMMAND DOES A M:LINK TO A SPECIFIED FILE.
*
LINK     PUSH     L
         LI,R     7
         LW,RU1   BLANKS
         STW,RU1  MLINK,R           PRESET TO BLANKS
         BDR,R    %-1
         LI,S     MLINK+1           PUT IT IN MLINK AREA
         LI,SR1   11                11 CHRS MAX
         BAL,L    ARGC              GET TEXTC NAME
         BCS,8    WTF               B/OOPS....NO NAME...NO GOOD...
         LB,S     MLINK+1           HOW MANY CHARACTERS???
         AI,S     4
         SLS,S    -2                CVT TO # WORDS
         AI,S     MLINK+1           WHERE TO PUT ACCOUNT.
         LI,SR1   8
         BAL,L    ARGT              AN ACCOUNT????
         BCS,8    LINKG             B/NOPE, GO DO LINK.
         LI,RU1   2
         STS,RU1  MLINK             SET ACCOUNT PRESENT
         LI,SR1   8
         AI,S     2                 POKE PASSWORD HERE.
         BAL,L    ARGT              PASSWORD MAYBE????
         BCS,8    LINKG             B/NOPE, DOIT..
         LI,RU1   1
         STS,RU1  MLINK             SET PASSWORD PRESENT
LINKG    LI,R     FREEVM            IS THERE A FREE VIRTUAL ROUTINE??
         BE       %+2
         BAL,L    FREEVM            DO IT. CAN'T HAVE CVM PAGES...
         CAL1,8   MLINK             DO THE M:LINK CAL.
         EXU      SETPC             SET UP PROMPT AGAIN.
         LI,R     PGMINIT           AN INIT ROUTINE????
         BE       RJ                B/NOPE
         BAL,L    PGMINIT
         B        RJ                WHEN WE RETURN.
         PAGE
*
*        AMIN
*                 DOES THE NEXT COMMAND ONCE A MINUTE
*
AMIN     PUSH     L
         BAL,L    WHUT              GO GET SOMETHING TO DO
         LW,SR1   CMDARG            MUST SAVE SCAN PTRS
         LW,R     =X'0F000031'
         STW,R    ZZN
AMIN1    PUSH     2,S               FOR RESCANNING EVERY MINUTE
         BAL,L    TIME              PRINT DATE AND TIME
         STW,SR1  CMDARG            RESTORE SCAN PTR
         LI,T     0
         LI,L     %+2
         EXU      S                 DO THE COMMAND (MAY BE CAL3)
         CAL1,8   ZZN               SNOOZE A WHILE
         PULL     2,S
         B        AMIN1             KEEP DOING IT.
*
*        EVERY DOES THINGS EVERY # TICKS.
*
EVERY    PUSH     L
         BAL,L    ARGN
         BCS,8    RJ                WHAT IS THIS CRUD??
         OR,O     =X'0F000000'      MAKE IT WAIT FPT
         STW,O    ZZN               AND PUT IT AWAY.
         BAL,L    WHUT              GET SOMETHING TO DO
         LW,SR1   CMDARG            LOAD IN SCAN PTRS
         B        AMIN1             AND DOIT...
         PAGE
*
*        AGAIN
*                 DOES THE LAST LINE OF COMMANDS AGAIN.
*
         USECT    DATA
AGT      RES      20                UP TO 80 CHRS.
         USECT    CODE
AGAIN    LI,R     BA(AGT)
         LI,RU1   BA(CMDBUF)
         LB,T     AGT
         STB,T    RU1               MOVE THIS MANY BYTES
         MBS,R    0
         PUSH     L
         BAL,L    WHUT              DECODE COMMAND
         PULL     L
         CI,S     X'A000'
         BL       0,L               SPLIT IF CRUMMY ADDRESS
         EXU      S                 ELSE RETURN THRU THING.
         PAGE
*
*        READ
*                 SWITCH COMMAND STREAM TO COME FROM A FILE
*
         DEF      READ
*
READ     PUSH     L
         LI,S     FNAME             PUT THE NAME HERE
         LI,SR1   31                CAN BE PRETTY LONG, ALL IN ALL
         BAL,L    ARGC              GIMMIE A TEXTC ALREADY.
         BCS,8    WTF               O YEAH????
         LW,R     =X'02000002'      SKELETAL ACCOUNT ENTRY
         STW,R    FACN-1            POOF IN TO RESET
         LW,R     BLANKS
         STW,R    FACN              PRECLEAR FIRST WORD
         LI,S     FACN
         LI,SR1   8                 8 CHRS FOR ACCOUNT MAX
         BAL,L    ARGT              IN TEXT FORMAT
         BCS,8    READ1             NO ACCT PRESENT.
         LW,R     =X'02000202'      SAY ACCT PRESENT
READ1    LW,R     =X'03010002'      SAY INITIALLY NO PASSWORD
         STW,R    FPSW-1
         LW,T     BLANKS
         STW,T    FPSW
         LI,S     FPSW
         LI,SR1   8                 8 CHRS FOR PASSWORD
         BAL,L    ARGT              IN TEXT FORM
         BCS,8    READ2
         LB,R     FPSW
         CI,R     X'40'             IS SOMETHING THERE??
         BE       READ2             B/NOPE
         LW,R     =X'03010202'      IF NONBLANK, MARK
         STW,R    FPSW-1            PASSWORD VLP ACTIVE
READ2    LI,R     X'0020'
         CH,R     M:SI              IS THE DCB OPEN ALREADY??
         BAZ      %+2               B/NOPE
         EXU      CLOSESI           CLOSE IT IF SO
         CAL1,1   READIT            OPEN US TO THE FILE.
         LI,R     0
         STW,R    INSWITCH          SET TO READ FROM THE FILE
         B        RJ                AND SPLIT.
*
         USECT    DATA
READIT   GEN,8,24 X'14',M:SI
         DATA     X'03400031'       P7,P8,P10,FILE,ACCT,PASSWORD
         DATA     1,1,2
         DATA     X'01000808'       NAME VLP
FNAME    RES      8
         DATA     X'02000202'       ACCT VLP
FACN     RES      2
         DATA     X'03010202'       PASSWORD
FPSW     RES      2
*
*        FOR AMIN, EVERY
*
ZZN      GEN,8,24 X'F',0            M:WAIT FPT LIVES HERE.
         USECT    CODE
         END      COMM
