/ CCLX6.PA - Command Control Language
/ Version 01.91  (Aerospace version number for this file.)

////    ENFORCE SYSTEM DATE OVERLAY

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

        IFDEF CM4       <CM4X18=1>
        IFDEF CM18      <CM4X18=1>
        IFDEF CM4X18    </ Enforce system date.

        ESDDY=NAME1
        ESDMO=NAME2
        ESDYR=NAME3

ESDSUB=.+LOCFUJ
        OVSUBR
        JMS I (BATCH)
        JMP ESD2        /BATCH NOT RUNNING.
        CLA
        JMP I ESDSUB-LOCFUJ     /POOR FOOL WON'T HAVE A DATE.

ESD1,   JMS I (CRLF)
        JMS I (PRINT)
        BADDAT
ESD2,   STA
        JMS I (PRINT)
        ESDMES
        JMS ESDNUM
        "-&177          /TERMINATE ON "-"
        DCA ESDDY
        JMS ESDNUM
        "-&177
        DCA LEAPYR
        JMS ESDNUM
ESD15,  15              /END ON CR
        TAD M1970
        DCA ESDYR
        AND I (CRLF)    /OPTIONAL
        TAD ESD15+1
        DCA ESDLP+1
        DCA ESDMO
ESDLP,  ISZ .+1         /VERIFY MONTH.
        HLT
        SNA
        JMP ESD1
        ISZ ESDMO
        TAD LEAPYR
        SZA CLA
        JMP ESDLP
        JMS LEAPYR      /VERIFY DAY.
        TAD ESDDY
        SZA
        TAD I T
        SMA CLA
        JMP ESD1
        TAD ESDYR       /VERIFY YEAR.
        AND ESDM40
        SZA CLA
        JMP ESD1
        JMS I (ADW
        JMS I (CRLF)
        JMP I ESDSUB-LOCFUJ

ESDNUM, SUBR
        KSF
        JMP .-1
        DCA T
        KRS
        JMS I (TYPE)    /ECHO
        KRB
        AND (177
        CIA
        TAD I ESDNUM    /TERMINATOR?
        SNA
        JMP ESDNX       /YES.
        TAD ESD15
        CIA
        TAD I ESDNUM
        SNA
        JMP ESD1        /TERMINATED TOO SOON.
        TAD (15-140
        SMA
        TAD ESDM40      /LC-TO-UC
        TAD (140-60
        DCA TT
        TAD T
        CLL RTL         /MULT OLD BY TEN
        TAD T
        CLL RAL
        TAD TT
        JMP ESDNUM+1

ESDNX,  TAD T
        ISZ ESDNUM
        JMP I ESDNUM

LEAPYR, SUBR
        STL RTL         /LEAP YEAR?
        TAD ESDYR
        CLL RTR
        SNL SMA CLA
        CMA CLL RAL     /YES
        TAD ESDMO
        SZA CLA
        TAD ESDMO
        TAD (ESDTBL
        DCA T
        JMP I LEAPYR

        DECIMAL
ESDTBL, -30;-32;-29;-32;-31;-32;-31;-32;-32;-31;-32;-31;-32
ESDM40= .-1

M1970,  -70/-(("J-"0)*100+("A-"0)*10+"N-"0)
        -2800;-2428;-3104;-2054;-3111;-3000
        -2998;-2093;-3742;-3326;-3348;-2229
OCTAL;    0

        PAGE
///     .YESTERDAY AND .TOMORROW

TOMORROW=.+LOCFUJ
        OVSUBR
        JMS DDW
        JMS I (LEAPYR
        TAD ESDDY
        IAC
        TAD I T
        SPA CLA
        JMP TOM3
        TAD ESDMO
        TAD (-14
        SPA CLA
        JMP TOM2
        ISZ ESDYR
        TAD ESDYR
        AND (37
        SNA CLA
        JMP I TOMORROW-LOCFUJ
        DCA ESDMO
TOM2,   ISZ ESDMO
        DCA ESDDY
TOM3,   ISZ ESDDY
        TAD TOMORROW-LOCFUJ
        DCA YESTERDAY-LOCFUJ
        JMP YESTX

YESTERDAY=.+LOCFUJ
        OVSUBR
        JMS DDW
        STA
        TAD ESDDY
        SZA
        JMP YEST3
        STA
        TAD ESDMO
        SZA
        JMP YEST2
        TAD ESDYR
        SNA
        JMP I YESTERDAY-LOCFUJ
        TAD (-1
        DCA ESDYR
        TAD (14
YEST2,  DCA ESDMO
        JMS I (LEAPYR
        TAD I T
        CMA
YEST3,  DCA ESDDY
YESTX,  JMS ADW
        TAD YESTERDAY-LOCFUJ    /TELL OVSUB WHERE TO RETURN
        JMS I (OVSUB    /BECAUSE WE WILL BE OVERLAYED
        OUTDAT

DDW,    SUBR            /DISASSEMBLE DATE.
        TAD I (DATWD
        AND (7
        DCA ESDYR
        TAD I (DATWD
        RAR
        RTR
        AND (37
        DCA ESDDY
        TAD I (DATWD
        CLL RAL
        RTL
        RTL
        AND (37
        DCA ESDMO
        CDF 0
        TAD I (BATWD
        AND (600
        CLL RTR
        RTR
        TAD ESDYR
        DCA ESDYR
        CDF 10
        JMP I DDW

ADW,    SUBR            /ASSEMBLE DATE.
        CDF 0
        TAD I (BATWD    /EXTENDED DATE...
        AND (7177
        DCA I (BATWD
        TAD ESDYR
        RTL
        RTL
        AND (600
        TAD I (BATWD
        DCA I (BATWD
        CDF 10
        TAD ESDYR
        AND (7
        DCA ESDYR
        TAD ESDMO
        CLL RAL
        RTL
        RTL
        TAD ESDDY
        RAL
        RTL
        TAD ESDYR
        DCA I (DATWD
        JMP I ADW

BADDAT, TEXT \BAD DATE\

ESDMES, TEXT \ENTER DATE (DD-MMM-YY): \
        >/*CM4 AND/OR CM18

        PAGE
        RELOC
////    RUCCLX and CCLSUB

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

RUCCLX, JMS I (MONPRS
        JMS I (RDMON
        CDF 0
        TAD I (0        /CHECK OUT MONITOR.
        CDF 10
        TAD (-7607
        SNA CLA
        JMP I (CCER3
        TAD (-300
        STL
        TAD I (BLK
        SZL CLA
        JMP .+3
        JMS I (PRINT
        FASMES
        CIF 0
        JMS I (7607
        4200            /WRITE 1 RECORD FROM FIELD 0
        400             /LOCATIONS 400-777
        CCLBLK          /INTO THE SYSTEM'S CCL BLOCK
        JMP I (IOERR
        CDF 0
        TAD I (2000+CCLSW
        CDF 10
        TAD (-GETCCL
        SNA
        JMP MONOK       /MONITOR ALREADY MODIFIED.
        TAD (GETCCL-PRQMRK
        SZA CLA
        JMP I (CCER3
        TAD (KEYWRD&7400+400-KEYLWA
        CIA
        DCA T
        TAD (KEYLWA     /REMOVE ANY "DEFINED" COMMANDS.
        DCA TT
        CDF 0
        DCA I TT
        ISZ TT
        ISZ T
        JMP .-3
        TAD I (CCLBLC
        CDF 10
        IAC
        DCA KBLOK
        CIF 0
        JMS I (7607
        4200
        KEYWRD&7400
KBLOK,  30      /INNOCUOUS.
        JMP I (IOERR
MONOK,  TAD (GETCCL
        CDF 0
        DCA I (2000+CCLSW
        STA
        DCA I (2000+DEASADR     /DELETE DEASSIGN
        CDF 10
        JMS WRMON
        TAD I (BLK
        TAD FBLK
        DCA FBLK
        JMS I (LOOK     /LOOK FOR FORT IV COMPILER.
        YF4
        TAD (YF2-YF4    /NOT FOUND.  USE FORT II COMPILER.
        TAD .-2
        DCA .+4
        TAD (-10
        JMS I (MOVE     /MOVE CORRECT FILENAMES IN.
        CDF 10
        0
        CDF 10
        YFORT
        CDF 10
        CIF 0
        JMS I (7607
        4210            /WRITE 1 RECORD FROM FIELD 1
        YFORT&7400
FBLK,   YFORT-2000&7400%400+1
        JMP I (IOERR
        CDF CIF 0
        JMP I (7605

WRMON,  SUBR
        CDF 10
        CIF 0
        JMS I (7607
        4200
        2400
        10
        JMP I (IOERR
        JMP I WRMON

CCLSUB=.+LOCFUJ
        OVSUBR
        JMS I (RDMON
        CDF 0
        TAD (PRQMRK
        DCA I (2000+CCLSW
        TAD (-405
        DCA I (2000+DEASADR
        CDF 10
        JMS WRMON
        JMP I CCLSUB-LOCFUJ

        PAGE
        RELOC   /FOLLOWING CODE IS EXECUTED IN FIELD 0.

MAIN,   CDF 10          /MOVE KEYWRDS TO FIELD 0,
        TAD I P2
        CDF 0
        DCA I P3
        TAD I P1        /AND MOVE THIS BLOCK UP TO
        CDF 10          /THE OVERLAY BLOCK, WHICH
        DCA I P2        /INITIALLY HAS KEYWORDS.
        ISZ P1
        ISZ P2
        ISZ P3
        ISZ C1
        JMP MAIN
        CDF CIF 10
MAINA,  JMP I .+1
        MONCHN
        RUCCLX
P1,     MAIN&7400
P2,     OVLBAS
P3,     KEYWRD&7400
C1,     -400

        RELOC .-LOCFUJ

MONCHN, JMS MONPRS
        TAD (-44
        JMS I (MOVE     /ASSUME COMMAND LINE IS IN
        CDF 10          /17600-17643
        7600
        CDF 0
        BEGLN           /MOVE TO OS/8 LINE BUFFER
        JMS I (ZEROCD)  /FLUSH CD BUFFER.
REGO,
        TAD (-111       /72 WORDS MAX ON UA,UB,UC RECALL
        JMS I (MOVE
        CDF 0
        BEGLN
        CDF 0
        2000
        CIF 0
        JMS I (7607     /RESTORE KBM
        1000
        0
        7
        HLT             /NO WAY TO RECOVER
        TAD (-111
        JMS I (MOVE
        CDF 0
        2000
        CDF 0
        BEGLN
        CDF CIF 0
        JMP I (FAKBM

USRSUB=.+LOCFUJ
        OVSUBR
        JMS I (KRSSUB   /CHECK FOR ^C
        CLA
        TAD I (REMADR
        SZA CLA         / Recalled a command?
        JMP REGO        / Yes- give it back to OS/8.
IFDEF   CM56 <DCA I (NOREM>   / Remember even if -R.
        JMP I USRSUB-LOCFUJ

KBMRETURN=.+LOCFUJ
        OVSUBR
        JMP REGO

MONPRS, SUBR
        JMS I (SETSYS
        JMS I (7700
        10              /USRIN
        JMS I (LOOK
        YCCLX
        JMP I (CCER1
        TAD I (BLK
        CDF 0
        DCA I (CCLBLC
        CDF 10
        JMP I MONPRS

YF2,    FILENAME FORT.SV
        FILENAME LOADER.SV
YF4,    FILENAME F4.SV
        FILENAME LOAD.SV
FASMES, TEXT /HINT: ^CCLX^ RUNS BETTER WHEN NEARER SYSTEM AREA!/

        PAGE
        RELOC
////    DEFINE OVERLAY

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

DEFINE=.+LOCFUJ
        OVSUBR          /.DEFINE KEY1,KEY2,KEY3
        TAD I (LBEGIN
        DCA LXR
DEFS1,  TAD DELIM
        SNA CLA
        JMP DEFXIT      /NO MORE DEFINITIONS.
        TAD LXR         /REMOVE PREVIOUS KEYWORD.
        DCA DEFTX
        JMS I (GNAME
        DCA DELIM
        TAD DELIM
        SZA             /DELIM IN AC.
        TAD (-",
        SZA CLA
        JMP I (CDER2    /SYNTAX
        ISZ I (PERDSW   /WAS PERIOD PROCESSED?
        JMP I (CDER2    /YES - SYNTAX ERROR
        TAD NAME1
        SNA CLA
        JMP I (CDER2
        CIF 0           /TRY TO MATCH EXISTING KEYWORDS.
        JMS I (FINDIT
DEFTX,  NIL
        SMA CLA
        JMP DEFER1      /ALREADY EXISTS.
        TAD (2326       /MAKE SURE FILE EXISTS.
        DCA NAME4
        JMS I (LOOK
        NAME1
        JMP I (CCER1    /NOT FOUND.
        DCA NAME4       /TRANSFER IN, GUARANTEE ZERO BYTE.
        CDF 0
        TAD I (KPTR     /CHEAT..
DCIF,   CDF CIF 10
        DCA KEYTX
        TAD (-KEYWRD&7400+5
        TAD KEYTX
        SMA CLA         /WILL STAY IN SAME BLOCK?
        JMP DEFER2      /NO. TOO MANY COMMANDS.
        TAD NAME1       /CHECK FOR NUMBERS.
        AND (4040
        SNA
        TAD NAME2
        AND (4040
        SNA
        TAD NAME3
        AND (4040
        SZA CLA
        JMP DEFER3
        TAD (-4
        JMS I (MOVE
        CDF 10
        NAME1
        CDF 0
KEYTX,  0
        JMP DEFS1

DEFXIT, TAD KEYTX
        SNA CLA
        JMP I DEFINE-LOCFUJ     /NO DEFINITIONS.
        CDF 0
        TAD I (CCLBLC           / Not CCLBLK!
        CDF 10
        IAC
        DCA DEFBLK
        CIF 0
        JMS I (7607     /REWRITE KEYWORD TABLE.
        4200
        KEYWRD&7400
DEFBLK, 30              /SCRATCH IN CASE..
        JMP I (IOERR
        JMP I DEFINE-LOCFUJ

DEFER1, JMS I (PRNAME
        JMS I (PRINT
        DEFM1
        JMP DEFS1

DEFER2, JMS I (PRMESG
        DEFM2

DEFER3, TAD (4300
        JMS I (PRWD
        JMS I (PRNAME
        JMS I (PRMESG
        DEFM3

        PAGE
FILSUB=.+LOCFUJ
        OVSUBR
        CDF 0
        TAD I (LINPTR
        DCA YDUMMY
        TAD I YDUMMY
        DCA FILTX       /SAVE DELIM CHAR.
        DCA I YDUMMY    /MAKE GNAME STOP.
        CDF 10
        TAD (BEGLN-1
        DCA LXR
        JMS I (GNAME    /CONSTRUCT FILE NAME.
        TAD FILTX       /RESTORE DELIMITER.
        CDF 0
        DCA I YDUMMY
        CDF 10
        TAD NAME1
        DCA YDUMMY
        TAD NAME2
        DCA YDUMMY+1
        TAD NAME3
        DCA YDUMMY+2
        TAD FILTX
        TAD (-",
        SNA CLA
        JMP FILS1       /CMD,TEXT
        TAD (XFILCD
        DCA PTR
        JMP I (GO       /GO DO THE COMMAND DECODE TYPE.

FILS1,  CLA STL RTL     /+2
        TAD I (LBEGIN
        DCA FILTX
        TAD (-44        /MOVE REMAINDER OF INPUT INTO CD AREA.
        JMS I (MOVE
        CDF 0
FILTX,  0
        CDF 10
        7600
        JMP I FILSUB-LOCFUJ     /LET USER WORRY ABOUT OVERFLOW..

YDUMMY, FILENAME DUMMY.SV

DEFM1,  TEXT / IS ALREADY DEFINED/
DEFM2,  TEXT /#COMMAND TABLE OVERFLOW/
DEFM3,  TEXT / HAS BAD CHAR/

IFDEF   CM60 </ Insert / for .BOOT.
BOOT=.+LOCFUJ
        OVSUBR
        TAD I (LBEGIN           / Point to char before 1st
        DCA T                   / significant one.
        TAD I (LBEGIN           / Autoindex--point to 1st
        DCA XR                  / significant char.
        CDF 0
        TAD I XR                / Get 1st significant char.
        TAD (-"/
        SNA CLA                 / Slash?
        JMP I BOOT-LOCFUJ       / Yes- do nothing.
        TAD ("/                 / No- install a slash over
        DCA I T                 / last space.
        JMP I BOOT-LOCFUJ
        >/*CM60

IFDEF   CM61 </ .FILL
FILL=.+LOCFUJ
        OVSUBR
        TAD I (MOFILE           / Get file length specified
        AND (7760               / for 1st output file.
        SNA                     / None?
        JMP I (CDER2            / Yes- bad syntax.
        CLL RTR                 / Justify length right.
        RTR
        DCA I (MPARAM+3         / Store as "=" parameter.
        JMP I FILL-LOCFUJ
        >/*CM61

IFDEF   CM62 </ .DUP with no output sets /R.
DUPLICATE=.+LOCFUJ
        OVSUBR
        TAD I (MOFILE           / Look at 1st output.
        SZA CLA                 / Output file given?
        JMP I DUPLICATE-LOCFUJ  / Yes- do nothing.
        TAD I (MPARAM+1         / No- force /R (verify).
        AND (7677
        TAD (100
        DCA I (MPARAM+1
        JMP I DUPLICATE-LOCFUJ
        >/*CM62

        PAGE
        RELOC
////    @ PROCESSOR OVERLAY.

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

ATOVL=.+LOCFUJ
        OVSUBR
        TAD LXR
        DCA SAVL
        JMS I (ATPRS
        TAD LXR
        DCA SAVEND
        STA
        TAD LXR
        DCA LXR         /IN CASE @ GOES TO EOL
        JMS I (GLXR     /SEARCH FOR EOL
        SZA CLA
        JMP .-2
        TAD LXR
        CMA
        TAD SAVEND
        DCA ENDLEN
        TAD (BEGLN+400-1
        DCA SAVEND
        TAD ENDLEN
        DCA COUNT
        CDF 0
MOVEND, TAD I LXR       /MOVE END SEGMENT
        DCA I SAVEND    /UP TO TOP OF ALLOWED BUFFER.
        CMA
        TAD SAVEND
        DCA SAVEND
        CMA
        TAD LXR
        DCA LXR
        ISZ COUNT
        JMP MOVEND
        CDF 10
        ISZ SAVEND
        TAD (-200       /INSERT INDIRECT COMMAND.
        DCA COUNT
        TAD I (NWB
        DCA T
        CDF 0
ALP,    JMS ALP1
        JMS ALP1
        JMS I (ALP2
        ISZ COUNT
        JMP ALP
        CDF 10
        JMS I (GETDCW
        SMA CLA
        JMP CTZ         /SOFT EOF.
ATOVER, CDF 10
        JMS I (PRMESG
        OVFLOW

ENDLEN, 0       /-NUMBER CHARS INCLUDING 0 WORD.
COUNT,  0

ALP1,   SUBR
        DCA TT
        TAD I T
        JMS ALP2
        TAD I T
        ISZ T
        AND (7400
        CLL RAL
        TAD TT
        RTL
        RTL
        JMP I ALP1

CTZ,    CDF 10
        TAD SAVL
        CIA
        TAD SAVEND
        SNA
        JMP I ATOVL-LOCFUJ
        SPA CLA
        JMP ATOVER
        TAD ENDLEN
        JMS I (MOVE
        CDF 0
SAVEND, 0
        CDF 0
SAVL,   0
        JMP I ATOVL-LOCFUJ

ALP2,   0
        AND (177
        SNA
        JMP POGO
        TAD (-32
        SNA
        JMP CTZ
        TAD (32-16      /IGNORE CR,LF,FF,VT
        CLL
        TAD (16-12
        SZL
        JMP POGO
        TAD (212        /FORCE 8-BIT
        DCA I SAVL
        ISZ SAVL
POGO,   CLA
        JMP I ALP2

OVFLOW, TEXT    /#COMMAND LINE OVERFLOW/

        PAGE
ATPRS,  SUBR
        JMS I (GETSPC
        JMS I (FUDG
        DCA I (SETEXT
        TAD (EXTCM
        DCA DEFALT
        JMS I (LOOKUP
        SNA CLA
        JMP ATERR       /NOTHING AFTER THE @.
        TAD I (LNAME    /GET BLOCK NUMBER
        DCA BLN
        TAD I (FUJADR   /GET HANDLER ADDRESS
        DCA T
        CIF 0
        JMS I T
        200             /READ 2 PAGES
NWB,    BFR             /INTO BUFFER
BLN,    0               /FROM THIS BLOCK
        SMA CLA         / I/O ERROR.
        SKP
        JMP ATERR       /IF FATAL.
        TAD DELIM       /ALLOW @SPECS'
        TAD (-"'
        SNA CLA
        ISZ LXR
        JMP I ATPRS

ATERR,  CDF 10
        JMS I (PRMESG
        ATIO
ATIO,   TEXT    /#INPUT ERROR READING INDIRECT FILE/


IFDEF   CM52 </ .FLIST.
FLIST=.+LOCFUJ
        OVSUBR
        TAD I (REMADR
        SNA CLA         / Command line was just recalled?
        JMP I FLIST-LOCFUJ      / No- do not touch it.
FLPNTR, TAD (7600       / Start of CD area.
FLIST1, DCA FLPNTR      / Store pointer.
        DCA I FLPNTR    / Clear next word in CD area.
        TAD FLPNTR
        TAD (-7616
        SNA             / Just cleared 7616?
        TAD (2          / Increment past 1st input file.
        TAD (7616-7646
        SNA             / Just cleared 7646?
        JMP I FLIST-LOCFUJ      / Yes- exit.
        TAD (7646+1     / Restore and increment pointer.
        JMP FLIST1
        >/*CM52

        PAGE
        RELOC
////    VERSION OVERLAY.

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

V77,    77              /FOR V200
VERSION=.+LOCFUJ
        OVSUBR
        JMS I (RDMON    /READ MONITOR
        CDF 0
        TAD I (2031     /GET PATCH LEVEL
        SNA
        TAD ("!
V200,   AND V77
        DCA T
        TAD I (OS78BIT
        AND V200
        SZA CLA
        TAD (1000
        TAD (5770
        DCA VMES+2
        TAD I (2000     /GET VERSION #
        CDF 10
        SPA
        CLA             /"0" MEANS OLD
        TAD (60
        JMS I (ROTL
        TAD T
        DCA VMES+7
        JMS  I (PRINT
        VMES
IFDEF   CM31            <
NOECK,  TAD I (7643     /E?
        AND V200
        SZA CLA
        TAD (YVERSN
        DCA I (DEFILE   >/*CM31
        JMP I VERSION-LOCFUJ
IFDEF   CM31 <
YVERSN, FILENAME VERSN3.SV >/*CM31

BADVNO=.+LOCFUJ
        OVSUBR
IFDEF   CM31 <DCA NOECK>
        JMS VERSION-LOCFUJ
        JMS I (PRMESG
        BADVMS

VMES,   TEXT    \#^OS/8 - KBM V?? - CCLX V??(CM??)\
        *VMES+14
        CCLNUM&77+2600
        CCLVER&77^100+50
        *.+1
        CMVERS
        *.+1
BADVMS, TEXT    /^CCL^ /
        *.-1
        CCLTAB&77+6300
        TEXT    / PROGRAM AND OVERLAY INCOMPATIBLE/

///     PASS A COMMAND STRING TO LDF

IFDEF   CM38 </ .LDF
LDFSA=  00100           /START ADRESS OF LDF
LDFOCAL=.+LOCFUJ
        OVSUBR
        TAD LDFB0       /USE BUFFER/0
        DCA XR2
        TAD I (LBEGIN
        DCA XR          /COMMAND LINE
        CDF 0
        TAD DELIM       /NULL STRING?
        SZA CLA
        STA             /SET FLAG
LDF1,   DCA I XR2
        ISZ .+1
        TAD LDFB0       /MOVE 'I T'
        SMA
        JMP LDF1
LDF2,   AND (177
        DCA I XR2
        TAD I XR        /MOVE CMD BUF
        SZA
        JMP LDF2
        TAD (15         /CR
        DCA I XR2
        DCA I XR2       /EOF
        TAD (LDFSA
        DCA I (7745     /FIX S.A.
        CDF 10
        JMP I LDFOCAL-LOCFUJ

LDFB0,  2000-1          /MUST PRECEDE 'I T'
        "I&177
        " &177
        "T&177
        ";&177!4000
        >/*CM38

        PAGE
////    FIX Overlay.

IFDEF   CM59 </ .FIX
FIXSUB=.+LOCFUJ
        OVSUBR
        TAD I (LBEGIN   / Point to first char to
        DCA LXR         / parse.
FIX0,   JMS I (GLXR
        SNA             / End of command?
        JMP FIX1        / Yes- exit.
        JMS I (DECODE
        JMP FIXTST      / Maybe space or comma.
        SZL CLA         / Letter?
        JMP I (CDER2    / No- Bad syntax.
        STA
        TAD LXR         / Should be first char of keyword.
        DCA FIXPTR      / Store pntr for FINDIT.
        CIF 0
        JMS I (FINDIT
FIXPTR, NIL             / FINDIT puts new "LBEGIN" here.
        SPA             / Recognized a keyword?
        JMP FIXBAD      / No- error.
        JMS I (XTLINK   / Find corresponding addr
        TAD (-XFILES    / in CCL command table.
        SNA             / Found a defined command?
        JMP FIXBAD      / Yes- error.
        TAD (XFILES-1   / No- restore addr (-1 for
        DCA XR          / autoindexing).
        TAD I XR        / Get flag word.
        SMA CLA         / CD for this command?
        JMP FIXBAD      / No- error.
        ISZ XR          / Skip default extension.
        TAD I XR        / Move option words into
        DCA I (MPARAM   / CD table (to call GCH as
        TAD I XR        / if from CD).
        DCA I (MPARAM+1
        TAD I XR
        DCA I (MPARAM+2
        JMS I (SCAN     / Scan to 1st significant char.
        TAD I (LBEGIN   / Set pntr for GCH.
        DCA LXR
        JMS I (GCH      / Scan /'s and \'s.
        DCA DELIM       / Save delimiter.
        JMS I (BSOPTS   / Process backslashes.
        CLL STA RTL     / Ac = -3.
        TAD XR          / Back up to 1st word.
        DCA XR
        TAD I (MPARAM   / Move revised options back
        DCA I XR        / to CCL table.
        TAD I (MPARAM+1
        DCA I XR
        TAD I (MPARAM+2
        DCA I XR
        DCA FIXFLG      / Clear comma flag.
        TAD DELIM       / Retrieve delimiter.
        JMP FIX0+1      / Test if more commands.

FIX1,   TAD FIXBLK      / Block number relative
        CDF CIF 0       / to start of CCLX.SV.
        TAD I (CCLBLC   / Add absolute block number
        CDF 10          / of CCLX.SV.
        DCA FIXBLK      / Store as block to write.
        JMS I (7607     / Call system handler.
        FIXADR=XTABLE&7400
        XFILES-FIXADR+375&7400%2!4010
        FIXADR          / Write from this addr to
FIXBLK, XTABLE-2000&7400%400+1  / this block.
        JMP I (IOERR    / Error return.
        JMP I FIXSUB-LOCFUJ

FIXTST, TAD ("A-240
        SNA             / Blank?
        JMP FIX0        / Yes- scan more.
        TAD (240-",
        SZA             / 2nd comma, any other char?
        JMP I (CDER2    / Yes- Bad Syntax.
        CLA STL RAR     / No- set Ac to 4000.
        TAD FIXFLG      / 0 or 4000.
        SNA             / Second comma?
        JMP I (CDER2    / Yes- Bad Syntax.
        DCA FIXFLG      / No- post flag and scan
        JMP FIX0        / more.

FIXCDI, CDF CIF 10
FIXFLG, 4000            / Initial comma is error.

FIXBAD, JMS I (PRMESG
        .+1
        TEXT "#BAD COMMAND"

        PAGE
        >/*CM59
        RELOC
////    HELP OVERLAY

        *.+377&7400
        LOCFUJ=.-OVLBAS
        RELOC OVLBAS

IFDEF   CM65 </ More helpful HELP.
/ CCLX has already run the command decoder in special mode.
/ The topic name, if any, was interpreted as the first
/ file, and is stored as such in the CD table, in words
/ 17606, 17607, and 17610, as HELP.SV expects.  This sub-
/ routine extends abbreviated topic names to full length
/ (but not more than six chars) if they correspond to CCLX
/ commands.  But if such a command calls only one program,
/ the topic name is changed to the name of that program.

HELP=.+LOCFUJ
        OVSUBR
HLPFUJ, TAD I (7605     / Get 1st word of 1st output file.
        SNA CLA         / Was a topic given?
        JMP I HELP-LOCFUJ/ No- leave it alone.
        TAD I (LBEGIN   / Yes- name of topic starts at
        DCA HLPPTR      / LBEGIN.
        CIF 0
        JMS I (FINDIT   / Search for name in keyword table.
HLPPTR, NIL
        SPA             / Found it?
        JMP I HELP-LOCFUJ/ No- a topic, but not a command.
        JMS I (XTLINK   / Calculate addr in command table.
        TAD (-1         / Decrement for autoindexing.
        DCA XR          / Point to flag word.
        STL RAR         / Set upper case switch.
        DCA I (LCFLG
        JMS I (HLPOUT   / Print "COMMAND:  ".
        HLPTX1
        CDF 0           / Get addr of full topic name (as
        TAD I (KEYSAV   / recognized in keyword table).
        DCA LXR         / Set pntr.
        TAD (7606-1     / Set pntr to topic name in CD
        DCA XR2         / table.
        TAD (-3         / Only copy three words to topic
        DCA HLPCNT      / name.
HLP10,  JMS I (GLXR     / Get next word of two chars.
        DCA T           / Save it.
        TAD T           / Retrieve it.
        AND (3737       / Mask off the 40 bits.
HLP12,  DCA I XR2       / Overwrite topic name (maybe).
        TAD T           / Retrieve word again.
        RTR             / Shift left byte to right.
        RTR
        RTR
        JMS I (HLPCHR   / Print what was left byte.
        TAD T           / Retrieve word again.
        JMS I (HLPCHR   / Print right byte.
        ISZ HLPCNT      / Just overwrote third word?
        JMP HLP10       / No- do next word.
        TAD (CLA        / Yes- zap the instruction that
        DCA HLP12       / overwrites the topic name.
        JMP HLP10       / Do next word.

HLP20,  JMS I (CRLF     / Carriage return.
        TAD (EXCEPT-1   / Point to list of command names
        DCA XR2         / that should be passed as is.
HLP22,  TAD I XR2       / Get minus addr from list.
        SNA             / End of list?
        JMP HLP28       / Yes- not an exception.
        TAD XR          / Add addr of flag word of command.
        SNA CLA         / Command is an exception?
        JMP HLPBYE+1    / Yes- exit.
        JMP HLP22       / No- loop.
HLP28,  CLA STL RAR     / Get file name(s) from table.
        AND I XR        / Get CD bit from command table.
        IAC STL RAL     / Put in link; bias Ac to 2nd entry.
        TAD I XR        / Get default extension (or junk).
        SZL             / CD?
        DCA HLPEXT      / Yes- not junk, point to 2nd entry.
        CLA RTL         / If CD,
        RAL             / Ac = 4.
        TAD XR          / Point to addr of program name.
        DCA XR
        TAD I XR        / Get addr of program name.
        SNA             / Is there one?
        JMP HLPBYE+1    / No- monitor or defined command.
        TAD (-1         / Yes- minus 1 for autoindexing.
        DCA XR          / Point to program name.
        TAD (7606-1     / Point to topic name.
        DCA XR2
        DCA I (PRWD     / Flag: zero unless PRWD is called.
        TAD I HLPEXT    / Get 2nd entry in extension list.
        SNA CLA         / Command can call only one program?
        JMP HLP30       / Yes- overwrite topic name but do
                        / not print program name.
        TAD HLPJMS      / No- print program names but do
        DCA HLP32       / not overwrite topic name.
        JMS I (CRLF     / Carriage return.
        JMS I (HLPOUT   / Print "PROGRAMS: ".
        HLPTX2
HLP30,  TAD (-3         / Three words hath both program and
        DCA HLPCNT      / topic names.
HLP31,  TAD I XR        / Get word of program name.
HLP32,  DCA I XR2       / Overwrite topic name or print.
        ISZ HLPCNT      / Third word yet?
        JMP HLP31       / No- do next word.
        TAD I (PRWD     / Yes- test flag.
        SNA CLA         / Program name was printed?
        JMP HLPBYE+1    / No- bye.
        TAD (56         / Yes- print ".".
HLPJMS, JMS I (PRWD
        TAD (2326       / Print "SV" file extension.
        JMS I (PRWD
        TAD I HLPEXT    / Next entry in extension list.
        SNA             / More program names?
        JMP HLPBYE      / No- carriage return, then bye.
        IAC             / Yes- point to addr of next name.
        DCA XR
        STA             / -1 for autoindexing.
        TAD I XR        / Point to next program name.
        DCA XR
        JMS I (CRLF     / Carriage return.
        JMS I (HLPOUT   / Space to column.
        HLPTX4
        ISZ HLPEXT      / Point to next entry in extension
        ISZ HLPEXT      / list.
        JMP HLP30       / Print new file name.

HLPBYE, JMS I (CRLF     / Carriage return.
        DCA I (LCFLG    / Reset lower case.
        JMP I HELP-LOCFUJ

HLPCNT= HLPFUJ
HLPEXT, DONBNO  / During HELP command, DONBNO will be 0.

        PAGE
/ Subroutine to print text strings without changing LCFLG
/ or putting out a CRLF.
HLPOUT, SUBR
        CLA
        TAD I HLPOUT    / Get addr of string.
        ISZ HLPOUT      / Bump return addr.
        DCA HLPCHR      / Point to first word of string.
HLP100, TAD I HLPCHR    / Get word from string.
        JMS I (PRWD     / Print it.
        TAD I HLPCHR    / Get it back.
        ISZ HLPCHR      / Bump pointer.
        AND (77         / Isolate right byte.
        SZA CLA         / Zero (end of string)?
        JMP HLP100      / No- do next word.
        JMP I HLPOUT    / Yes- return.

/ Subroutine to print one byte, in lower case if bit 40 set.
HLPCHR, SUBR
        AND (77         / Isolate right byte.
        SNA             / Zero (end of keyword)?
        JMP I (HLP20    / Yes- exit calling loop.
        CLL             / Clear link.
        TAD (7740       / Set link if 40 bit set.
        AND (77         / Clear left byte.
        TAD (240        / Make an eight bit char.
        SZL             / Bit 40 was set?
        TAD (100        / Yes- convert to lower case.
        JMS I (TYPE     / Print it.
        JMP I HLPCHR    / Return.

EXCEPT,	IFDEF CM25	<
	-XDESCRIBE+1>   / Describe command.
	IFDEF CM61	<
        -XFILL+1>       / Fill command.
        0               / Terminater.
HLPTX1, TEXT /COMMAND:  /
HLPTX2, TEXT /PROGRAMS: /
HLPTX4, TEXT /          /

        PAGE
        RELOC
        >/*CM65

        $$$$$$
