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

/ The monitor jumps to 12400, which jumps to here.

        *4200
START,  JMS SETSYS
        JMS I (TWAIT
        CDF 0
        TAD I (ENTRYN   / Get entry number.
        DCA PTR         / Save it.
        TAD I (VNO      / Get Version number.
        CDF 10
        TAD (-CCLTAB
        SNA CLA         / Version numbers agree?
        JMP .+3         / Yes.
        JMS OVSUB       / No.
        BADVNO
IFDEF   CM4  </ Enforce system date.
        TAD I (DATWD
        SZA CLA
        JMP .+3
        JMS OVSUB
        ESDSUB
        >/*CM4

        JMS KRSSUB

S7600,  CLA I
        TAD (BEGLN-1
        DCA LXR
ATLOOP, JMS I (GLXR
        SNA
        JMP ATOUT
        TAD (-"@
        SZA CLA
        JMP ATLOOP
        JMS I (OVSUB
        ATOVL
        JMP S7600       / "@"'s could be nested.

ATOUT,  JMS I (SCAN     / Scan to 1st significant char.
        TAD PTR         / Restore entry number.
        SPA SNA         / Normal entry?
        JMP ABNORM      / No- zero or negative entry.
        JMS XTLINK      / Yes- find command table entry.
GIT,    DCA PTR         / Set pointer into table.
        JMP I (GO

XTLINK, SUBR
        CIA             / Ac = N (entries to count).
        DCA T           / Save N.
        TAD (XTABLE
        JMP XTLNK2
XTLNK1, TAD I TT
        SPA CLA         / 3 or 7 words?
        CLL IAC RAL     / 7- set 2 to make 7.
        STL IAC RAL     / 3- set 3 (or 7).
        TAD TT
XTLNK2, DCA TT
        ISZ T           / Counted N entries?
        JMP XTLNK1      / No- count another.
        TAD TT          / Yes- get addr in table.
        TAD (-XFILES
        SMA SZA         / .DEFINEd command?
        CLA             / Yes- force all to same entry.
        TAD (XFILES
        JMP I XTLINK

ABNORM, TAD PTR         / Find addr in fake command table
        TAD PTR         / (immediately precedes real one).
        TAD (XTABLE-3   / Assume three word entries.
        JMP GIT

/       TAD RTRN        / Alternate return address.
/       JMS OVSUB
/       OVADDR
/       (Default return is to call + 2)

OVSUB,  SUBR
        SZA
        JMP OVSUB1
        TAD OVSUB
        IAC
OVSUB1, DCA JMSUB
        TAD I OVSUB
        JMS I (OVLOAD
        SKP
JMSUB,  0               /TAD (ADDR ; JMS JMSUB
        SNA
        JMP I JMSUB
        DCA T
        TAD JMSUB
        DCA I T
        ISZ T
        JMP I T

SETSYS, SUBR
KCDI0,  CDF CIF 0
        TAD KCDI0
        DCA I (7744     / Set restart address.
        TAD S7600
        DCA I (7745     / To 07600.
        TAD (3001
        DCA I (JSBITS
        CDF CIF 10
        JMP I SETSYS

KRSSUB, 0
        KSF
        JMP I KRSSUB
        TAD S7600
        KRS
        TAD (-7603
        SNA
        JMP I (LEAVE
        TAD (203
        JMP I KRSSUB

BADENT, JMS I (PRMESG
        OLDCCL

        PAGE
GO,     TAD I PTR       / Get flag.
        DCA FLAG        / Save it.
        ISZ PTR
        TAD FLAG
        SMA CLA
        JMP GO1         / No CD.
        TAD I PTR       / Get default input extension pntr.
        DCA DEFALT      / Save it.
        TAD (7641
        DCA XR
        TAD FLAG
        CDF 0
        TAD I (AMFLAG   / Combine altmode bits in bit 11.
        CDF 10
        RAR
        CLA RAR         / Put new bit alone in bit 0.
        DCA I XR        / Store in CD option table.
        ISZ PTR         / Store rest of options.
        TAD I PTR
        DCA I XR
        ISZ PTR
        TAD I PTR
        DCA I XR
        ISZ PTR
        TAD I PTR
        DCA I XR
        ISZ PTR
        DCA I XR        / Zero low order parameter.
GO1,    TAD I PTR
IFDEF   CM68 <
        TAD (-DATE
        SZA CLA         / DATE command requested?
        JMP GO2         / No- continue.
        TAD DELIM       / Yes.
        SZA CLA         / Any chars after "DATE"?
        TAD (KBMRET-DATE        / Yes- return to KBM.
GO2,    TAD I PTR       / Continue
        >/*CM68
        JMS I (OVLOAD   / Load overlay while SYS: is
        DCA SUBADR      / positioned at CCLX.
        JMS I (BKA      / Command line has a backarrow?
        JMP NORM        / Yes- CLXR will point to it.
        TAD FLAG        / No- fix the line up . . . .
        AND (400
        SZA CLA
        JMP NEWF        / Want output specs if no arrow.
        TAD DELIM
        SNA CLA         / Command line empty after keyword?
        JMS I (RCLREM   / Yes- recall a command line.
        JMP NORM

NEWF,   CDF 0           / Append backarrow.
        TAD ("<
        DCA I CLXR
        ISZ CLXR
        DCA I CLXR      / Append new EOL.
        CDF 10
NORM,   TAD FLAG
        SPA CLA
        JMS I (CD
        TAD FLAG
        RAL
        SMA CLA         / Spooling is prohibited?
        JMS I (SPOOLIT  / No.
        JMS I SUBADR    / Execute the subroutine.
        CDF 10          / Just in case.
IFDEF   CM30 <JMS I (BSOPTS>    / Process backslash options.
        JMS I (BKA      / Find backarrow again.
        NOP
        CDF 0
        TAD FLAG
IFNDEF  CM17 <AND (400>
IFDEF   CM17 <AND (600>
        SZA CLA         / Remember only output specs?
        DCA I CLXR      / Delete backarrow and what follows.
        CDF 10
        JMS I (REMEM    / Store a command line.
        ISZ PTR
        TAD I (DEFILE
        SNA             / CD set a file name to chain to?
        TAD I PTR       / No- try the command table.
        SNA             / Got one?
        JMP I (LEAVE    / No- return to monitor.
        DCA NMPTR       / Yes- store address of file name.
        JMS LOOK        / Look it up.
NMPTR,  0
        JMP I (CCER1    / Not found.
CHAIN,  JMS I (200      / Chain to it.
        6               / (CHAIN).
BLK,    0
SUBADR, 0


/ 'LOOK' looks up a file on a device.  The first argument
/ points to the file name; the second is the error return
/ if the file is not found.  The device number is in the Ac.
/ If 0, use SYS:.

LOOK,   0
        SNA
        IAC
        DCA DEV
        TAD I LOOK      / Get ptr to file name.
        ISZ LOOK        / Point to error return.
        DCA NAMPTR
        TAD DEV         / Get device number.
        JMS I (200
        2               / LOOKUP
NAMPTR, 0
        0
        JMP I LOOK      / Take error return if not found.
        TAD NAMPTR      / Store starting block # in 'BLK'
        DCA BLK
        ISZ LOOK        / Point to normal return.
        JMP I LOOK      / Return.
FLAG,   0
DEV,    0               / Device number.

        PAGE
CD,     0
        JMS I (200
        13              / Reset all handlers.
        JMS I (CDINIT
BEGGRP, TAD OUTSW
        SNA CLA         / On input side?
        TAD I (BEGDIF   / Yes- point to start of input area.
        TAD (MOFILE-1   / No- point to start of output area.
        DCA CLXR
        JMS I (GETSPC   / Process a file specification.
        JMS I (ASSIGN
        TAD OUTSW
        SNA CLA         / On input side?
        TAD I (LIMDIF   / Yes- minus addr of end of input.
        TAD I (OUTLIM   / No- minus addr of end of output.
        TAD CLXR        / Last addr stored in CD table.
        SMA CLA         / Ran over?
        JMP I (CDER1    / Yes- too many files.
        JMS I (CCLSWT   / Check for CCL switches ("-xx").
        TAD OUTSW
        SNA CLA         / On output side?
LKUPSW, JMP INFILE      / No- or in special decode mode?
                        / (zeroed for "special decode").
        TAD I (DVICE    / Yes- store complete file name.
        JMS PCLXR
        TAD NAME1
        JMS PCLXR
        TAD NAME2
        JMS PCLXR
        TAD NAME3
        JMS PCLXR
        TAD NAME4
        JMP LSTPUT
INFILE, JMS I (LOOKUP
        JMS PCLXR       / Store length and device number.
        TAD I (LNAME    / Get block.
LSTPUT, JMS PCLXR
        TAD OUTSW
        SNA CLA         / On input side?
        TAD I (FLAG     / Yes- maybe set output files:
        AND (206
        SZA CLA         / Features enabled?
        TAD LKUPSW      / Yes- hmmm.
        SNA CLA         / Output side or features disabled?
        JMP DLOOK       / Yes- do not set output files.
        TAD I (DVICE    / No- get right device.
        JMS I (NMOVE    / Move name to 1st output file.
        7600
        TAD I (DONBNO   / Get flag.
        SNA             / -NB or -NO was just set?
        JMP DLOOK       / No.
        DCA I (DONBNO   / Clear flag.
        TAD (MOFILE-1
        DCA XR2
        DCA I XR2       / Zero first word, etc.
        DCA I XR2
        DCA I XR2
        DCA I XR2
        DCA I XR2
DLOOK,  STA
        DCA I (DVFLAG
        TAD DELIM       / Get last char of last file name.
        SNA             / End of command line?
        JMP I CD        / Yes- bye.
        TAD (-"[
        SNA             / "["?
        JMP I (OLENGT   / Yes- get number and "]".
        TAD ("[-",
        SNA             / Comma?
        JMP I (FILLP    / Yes- jump into GETSPC subroutine,
                        / which returns to point of last
                        / call--BEGGRP + 6  (i.e., a nasty
                        / way of looping).
        TAD (",-"<      / No.
        SNA             / Backarrow?
        JMP BKAROW      / Yes.
        TAD ("<-"=
        SNA CLA         / "="?
        JMP I (STORNM   / Yes- get and store parameter.
CDER2,  JMS I (PRMESG   / Bad Syntax.
        BADSYN
BKAROW, ISZ OUTSW
        JMP CDER2       / Two backarrows.
        JMP BEGGRP

PCLXR,  0
        ISZ CLXR
        DCA I CLXR
        JMP I PCLXR

OUTSW,  -1      / -1 means output side, 0 input side.

/ Called from LOOKUP when a file lookup fails.  If an
/ extension was typed, or if there are no more default
/ extensions to look for, abort.
LFAILD, TAD I (NAMERM
        SNA CLA         / An extension was typed?
        TAD I DEF       / No- get next default.
        SNA CLA         / Typed or no default?
        JMP I (CDER3    / Yes- abort.
        JMP I (NEXTEXT  / No- look up next default.

/ Get device control word.
GETDCW, 0
        SNA
        TAD I (DVICE    / Get device number.
        TAD (17757      / Add base addr of table.
        DCA T
        TAD I T
        JMP I GETDCW

        PAGE
/ Look up a file.  Called from CD and by the "@" processor.
LOOKUP, 0
        DCA LNAME
        TAD NAME1
        SNA CLA         / Is there a file name?
        JMP LKUPST      / No- exit.
        TAD I (PERDSW
        TAD NAME4
        SNA CLA
        CLA IAC         /FORCE NAMERM NON-0 IF . AND NO EXT
        TAD NAME4
        DCA NAMERM      /REMEMBER TYPED EXTENSION
        TAD DEFALT
        DCA DEF
        TAD I (SETEXT
        SNA             /HAS AN EXTENSION BEEN SET?
        TAD NAMERM      /NO
        SNA             /DOES FILE HAVE EXTENSION?
        JMP EXT2        /NEITHER- DO SUCCESSIVE LOOK-UPS
        JMS I (EXTLUK   /LOOK FOR EXTENSION /VER C
        SNA CLA         /DID WE FIND IT?
        JMP EXT3        /NO, FORCE NULL EXTENSION TO MATCH
EXT2,   TAD I DEF
        IAC
        SNA CLA
        JMP NEXTEXT     /IGNORE -1'S
        TAD NAMERM
        SZA CLA
        JMP EXT3
        TAD I DEF
        DCA NAME4       /SET NEW EXTENSION
EXT3,   TAD (NAME1
        DCA LNAME
        TAD AS+2
        JMS I (200
        2
LNAME,  0               /NAME1
LENGTH, 0
        JMP I (LFAILD
        ISZ DEF         /POINT TO FOLLOW-UP LIST.
        TAD I DEF
        JMS I (EXTSUB   /PROCESS IT /VER C
        TAD LENGTH
        CLL
        TAD (400
        SNL
        CLA
        CLL RTL
        RTL
        AND (7760
LKUPST, TAD DVICE
        JMP I LOOKUP

/ Point to next possible default extension, and go try it.
NEXTEXT,ISZ DEF
        ISZ DEF
        JMP EXT2

NAMERM, 0
DVICE,  0

ASSIGN, 0
        TAD CLXR
        AND I (DVFLAG
        TAD I (OUTLIM
        SMA SZA CLA     /CHECK FOR OUTPUT OR FIRST INPUT
        JMP ASNORM      /IF DEVICE WAS SPECIFIC,
                        /OR IF WE ARE ON THE INPUT SIDE,
                        /PROCEED NORMALLY
        TAD NAME1
        SNA CLA
        JMP ASGNST
        TAD DFLTNM+1
        DCA DEV2
        TAD DFLTNM
        DCA DEV1
ASNORM, TAD DEV1
        DCA AS+1
        TAD DEV2
        DCA AS+2
        TAD I (OUTSW
        SNA CLA         /DON'T LOAD HANDLER
                        /IF WE ARE ON OUTPUT SIDE OF "_"
        TAD NAME1
SPKLG1, SNA CLA         /OR THERE IS NO FILE NAME TO LOOK UP
        TAD GETHND      /GETHND=11 NORMALLY,
                        /0 IF IN "SPECIAL DECODE" MODE
        IAC
        DCA AS
        TAD (HNDLR+1    /ALLOW TWO PAGE HANDLERS
        DCA ASADR
        JMS I (200
AS,     0
        0
        0
ASADR,  HNDLR+1
        JMP I (CDER0
        TAD AS+2
ASGNST, DCA DVICE
        JMP I ASSIGN
DFLTNM, DEVICE DSK
GETHND, 11              /1+11=12 (1=FETCH, 12=INQUIRE)

FUDG,   0       /CALLED FROM TECO COMMANDS, @PROCESSOR
        SZA CLA         /AC=POSSIBLE DEVICE #
        JMP FUDG1       /THAT IS ALREADY IN DVICE.
        STA             /PRETEND ON OUTPUT
        DCA I (OUTSW    /SO ONLY INQUIRE.
        TAD (7600
        DCA CLXR
        JMS ASSIGN
FUDG1,  TAD (HNDLR+1
        DCA FUJADR
        TAD DVICE
        SNA
        JMP I (CDER2    /SYNTAX
        JMS I (200
        1               /FETCH.
FUJADR, 0
        JMP I (CDER0
        JMP I FUDG

        PAGE
/ Get a name from the command line buffer via LXR.  Return
/ with delimiter in Ac.  On a bad name, abort.
TN,     /Don't call CCLSWT from GNAME unless this is moved.
GNAME,  0
        DCA NAME1       / Clear temporaries for the name.
        DCA NAME2
        DCA NAME3
        DCA NAME4
        TAD (NAME1
        DCA NMBASE
        STA             / Initialize the period switch.
        DCA PERDSW
        DCA NAMECT
        JMS I (GCH      / Get a char.
        TAD (-"#
        SNA             / Octal file name?
        JMP NUMCON      / Yes- read number into NAME1-4.
        TAD ("#         / Restore char.
        SKP
GTNMLP, JMS I (GCH      / Get a char.
        DCA DELIM       / Save it.
        TAD DELIM
        TAD (-"?
        SZA
        TAD ("?-"*
        SNA             / Wildcard char?
STARSW, JMP CDER6       / Yes.  (Changed to "JMP STARNM" if
                        / special decode mode).
        TAD ("*-".
        SNA CLA         / Period?
        JMP PERIOD      / Yes.
        TAD DELIM
        JMS I (DECODE
        JMP NUMCON+1    / Char is not alphanumeric- exit.

STARNM, CLA             / Do a letter, number, or maybe a
        TAD DELIM       / wildcard.
        AND (77         / Strip char to six bits.
        DCA DELIM
        TAD NAMECT      / Test length of name so far.
        TAD (-6
        SMA CLA         / Ignore this char?
        JMP GTNMLP      / Yes- look at next char.
        TAD NAMECT      / Make addr of right register for
        CLL RAR         / this char (NAME1-4).  Link is set
        TAD NMBASE      / for 2nd, 4th, 6th, and 8th chars
        DCA TT          / (the right bytes).
        TAD DELIM       / Retrieve char.
        SNL             / Right byte?
        JMS I (ROTL     / No- rotate char to left byte.
        TAD I TT        / Store into name.
        DCA I TT
        ISZ NAMECT      / Bump char count.
        JMP GTNMLP      / Look at next char.
PERIOD, TAD NAME1       / Come here for period.
        SZA CLA         / No name before the period?
        ISZ PERDSW      / No- second period?
        JMP I (CDER7    / Yes to both- abort.
        ISZ NMBASE      / Fiddle loop params to process
        TAD (4          / the extension.
        DCA NAMECT
        JMP GTNMLP      / Do first char of extension.

CDER6,  JMS I (PRMESG
        BADSTR

CCLSWT, 0               / Called from CD.
        TAD DELIM
        TAD (-"-
        SZA CLA         / Delimeter was "-"?
        JMP I CCLSWT    / No- nothing doing.
        TAD I (OUTSW
        SZA CLA         / Scan is still on output side?
        JMP CDER4       / Yes- bad switch.
        TAD (SWTCHS     / Point to start of switch
        DCA DEF         / recognition list.
        JMS GETL
        JMP CDER44      /NON-ALPHANUMERIC CCL SWITCH
        JMS I (ROTL
        DCA TN
        JMS GETL
        JMP XLK2        /ONE CHAR CCL SWITCH
        TAD TN
        DCA TN
        JMS GETL
XLK2,   SKP CLA         /2 CHAR CCL SWITCH
        JMP CDER44      /3 CHAR CCL-SWITCH
XLK,    TAD TN
        JMS I (EXTLUK
        CLA
        ISZ DEF
        TAD I DEF
        JMS I (EXTSUB   /PROCESS SWITCH
        JMP CCLSWT+1

CDER4,  JMS I (PRMESG
        BADSW
CDER44, JMS I (PRMESG
        BADSW2

GETL,   0
        JMS I (GCH
        DCA DELIM
        TAD DELIM
        JMS I (DECODE
        JMP I GETL      /NON-ALPHANUM IN CCL SWITCH
        CLA
        TAD DELIM
        AND (77
        ISZ GETL
        JMP I GETL

NUMCON, JMS I (NUMC
        CLA
        TAD DELIM
        JMP I GNAME

PERDSW, 0
NAMECT, 0

        PAGE
NUMBER, 0
        SZA CLA
        TAD (NUM&177+1200-SKP
        TAD SKPINS
        DCA NUMADD/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
        DCA HIORD
NUMLP,  DCA NUM
        JMS I (GCH
        ISZ NUMKNT
SKPINS, SKP
        JMP EONUM2
        CMA
        TAD NUMFUJ
        TAD ("8         /TEST INPUT CHARACTER FOR RANGE
        CLL CMA         /0-7 IF NUMFUJ=0
        TAD (10         /0-9 IF NUMFUJ=2
        TAD NUMFUJ
        SNL
        JMP EONUM
        DCA T
        CLA CLL CMA RTL
        DCA DELIM
        TAD NUM
ROTLP,  CLL RAL
        DCA NUMX
        TAD HIORD
        RAL
NUMSKP, SPA             /MODIFIED BY #
        JMP CDER5
        DCA HIORD
        TAD NUMX
        ISZ DELIM
        JMP ROTLP
NUMADD, TAD NUM         /SKP IF OCTAL
        TAD NUM
        TAD T
        JMP NUMLP

EONUM,  TAD ("0
EONUM2, DCA DELIM
        TAD NUMKNT
        SPA CLA
        JMP CDER5       /FEWER THAN CORRECT NUMBER OF DIGITS
        TAD NUM
        JMP I NUMBER

CDER5,  JMS I (PRMESG
        BADNUM

NUM,    0
NUMX,   0
NUMFUJ, 0
NUMKNT, 0               /SET TO -N-1 TO FORCE N DIGITS
HIORD,  0

NUMC,   0
        TAD SKPINS
        DCA NUMSKP
        TAD (-11
        DCA NUMKNT
        JMS NUMBER
        DCA NAME2
        TAD HIORD
        DCA NAME1
        STA
        TAD LXR
        DCA LXR
        TAD (-11
        DCA NUMKNT
        JMS NUMBER
        DCA NAME4
        TAD HIORD
        DCA NAME3
        TAD (SPA
        DCA NUMSKP
        JMP I NUMC

OLENGT, TAD I (OUTSW
        AND NAME1       /[N] IS ONLY LEGAL
                        /ON THE OUTPUT SIDE OF THE "_"
        SNA CLA         /AND ONLY AFTER A FILE NAME
        JMP I (CDER2
        TAD (-4
        TAD CLXR
        DCA NMBASE
        CLA CLL CML RTL
        DCA NUMFUJ      /SET "NUMBER" TO ACCEPT
                        /DIGITS 8 AND 9
        STA             /ALLOW DECIMAL
        JMS NUMBER
        CLL RTL
        RTL
        AND (7760
        TAD I NMBASE
        DCA I NMBASE
        TAD DELIM
        TAD (-"]        /IS THERE A CLOSING BRACKET?
        SNA             /IF NOT,
                        /"DLOOK" ROUTINE WILL DETECT IT
        JMS I (GCH
        DCA DELIM
        JMP I (DLOOK

STORNM, DCA NUMFUJ
        JMS NUMBER
        DCA I (MPARAM+3
        CLA CLL CML RAR
        AND I (MPARAM-1 /PRESERVE  ALTMODE
        TAD HIORD
        DCA I (MPARAM-1
        JMS I (CCLSWT
        JMP I (DLOOK

REMERR, JMS I (PRMESG
        BADREM
MEMBIG, JMS I (PRINT
        MEMWARN
        JMP I (REMGO

        PAGE
GCH,    0
        JMS GLXR
        TAD (-240
        SNA
        JMP GCH+1
        TAD (240-"/
IFDEF   CM30 < CLL
        SZA
        TAD ("/-"\ >/*CM30
        SNA
        JMP SLASH
IFDEF   CM30 <TAD ("\-"( >/*CM30
IFNDEF  CM30 <TAD ("/-"( >/*CM30
        SNA
        JMP OPENP
        TAD ("(
        JMP I GCH

SLASH,  JMS GLXR
        JMS SLSHCH
        JMP GCH+1

OPENP,  JMS GLXR
        TAD (-")
        SNA
        JMP GCH+1
        TAD (")
IFDEF   CM30 <CLL>/*CM30
        JMS SLSHCH
        JMP OPENP

GLXR,   0
        CDF 0
        ISZ LXR
        TAD I LXR
        CDF 10
        JMP I GLXR

SLSHCH, 0
        DCA DELIM
IFDEF   CM30 <SZL       / OR \  ?
        TAD (XPARAM-MPARAM      >/*CM30
        TAD (MPARAM-1
        DCA T
        TAD DELIM
        JMS DECODE
        JMP CDER8
        SZL
        TAD (32
        CMA STL         / Turn on the correct option bit:
        DCA TT
SLSHLP, SZL
        ISZ T
        RAR
        SNL
        ISZ TT
        JMP SLSHLP
        DCA TT
        TAD TT
        CMA
        AND I T
        TAD TT
        DCA I T
        JMP I SLSHCH

CDER8,  JMS I (PRMESG
        BADOPT


/ Scan to first significant character after the keyword.
/ Store pointer (less 1) to first significant char of
/ command line in LBEGIN, and the char itself in DELIM.
SCAN,   0
        CDF 0
        TAD I (LINPTR   / Get pntr to first char past
        DCA T           / keyword.
SCAN1,  TAD I T         / Get next char.
        ISZ T
        TAD (-240
        SNA             / Char is blank?
        JMP SCAN1       / Yes- scan another.
        CDF 10          / No.
        TAD (240        / Restore char.
        DCA DELIM       / Save it.
        STA CLL RAL     / Set pointer to first significant
        TAD T           / char.
        DCA LBEGIN
        JMP I SCAN
LBEGIN, NIL


/ Test whether a character is a letter, digit, or neither.
/ Call with char in Ac.
/ If letter, return to return addr plus 1 with letter-"A in
/ Ac and the Link clear.  If digit, return to return addr
/ plus 1 with digit-"0 in Ac and the Link set.  If neither,
/ return to return addr with char-"A in Ac.

DECODE, 0
        TAD (-"9-1      / Can be called with any data field.
        CLL
        TAD ("9+1-"0
        SZL
        JMP DCDYES
        TAD ("0-"Z-1
        STL
        TAD ("Z-"A+1
        SNL
DCDYES, ISZ DECODE
        JMP I DECODE

CDER1,  JMS I (PRMESG
        TOOMAN

CCER3,  CDF 10
        JMS I (PRMESG
        BADMON

CDER7,  JMS I (PRMESG
        BADX

CDER9,  JMS I (PRMESG
        TOOLNG

CCERA,  JMS I (PRMESG
        CONTRA

        PAGE
/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
/IT GIVES A FATAL ERRORR MESSAGE IF BAD.

GETSPC, 0
        STA
        DCA DVFLAG
        DCA DEV1
FILLP1, DCA DEV2
FILLP,  JMS I (GNAME
        TAD (-";        /AC CONTAINED DELIM
        SZA
        IAC             /TAD (";-":)
        SNA CLA
        JMP DEVNAM
        DCA GSTMP
        JMP I GETSPC
DEVNAM, CLA IAC
        TAD I (PERDSW
        TAD GSTMP
        SZA CLA
        JMP CDERA       /. OR # IN DEVICE NAME
        TAD NAME1
        DCA DEV1
        ISZ DVFLAG
        JMP CDERA       /CATCHES A:B:
        TAD NAME2
        JMP FILLP1

DVFLAG, 0

CDERA,  JMS I (PRMESG
        BADEV

BKA,    0
        TAD I (LBEGIN
        DCA CLXR
BKA1,   CDF 0
        ISZ CLXR
        TAD I CLXR
        CDF 10
        SNA
        JMP NOBKAR
        TAD (-"<
        SNA
        JMP I BKA
        TAD ("<-"_
        SZA CLA
        JMP BKA1
        TAD ("<
        CDF 0
        DCA I CLXR
        CDF 10
        JMP I BKA
NOBKAR, ISZ BKA
        JMP I BKA

GSTMP,
OTOD,   0
        DCA TT
        DCA T
        TAD TT
        TAD (-12
        ISZ T
        SMA
        JMP .-3
        TAD (72
        DCA TT
        STA
        TAD T
        SNA
        TAD (40-60
        TAD (60
        JMS ROTL
        TAD TT
        JMP I OTOD

ROTL,   0
        CLL RTL
        RTL
        RTL
        JMP I ROTL

/GET FROM INPUT LINE VIA XR

GETF,   0
        CDF 0
        TAD I XR
        CDF 10
        SZA
        ISZ GETF
        AND (77
        JMP I GETF

PUTF,   0
        AND (77
        SNA
        JMP PUTZ
        ISZ PUTF
        TAD (240
        AND (77
        TAD (240
PUTZ,   CDF 0
        DCA I XR
        CDF 10
        JMP I PUTF

IFDEF   CM30 <
BSOPTS, SUBR            /CLEAR OPTIONS SPECIFIED BY \X
        STA CLL RTL     /-3
        DCA OTOD
        TAD (XPARAM
        DCA T
        TAD (MPARAM
        DCA TT
BSLOOP, TAD I T
        CMA
        AND I TT
        DCA I TT
        DCA I T
        ISZ T
        ISZ TT
        ISZ OTOD
        JMP BSLOOP
        JMP I BSOPTS

XPARAM, ZBLOCK 3        /\OPTIONS
        >/*CM30
        PAGE
