File: CCLCD.MA of Disk: V50/Source/Source-Listing-MAC-1
(Source file text)
/CCL COMMAND DECODER FOR KBM V50
/
/
/
/
/
/ CCL'S COMMAND DECODER
/ VERSION=5A
.RSECT CCLCD
.EXTERNAL TABLES,FNAME1
.EXTERNAL SWTCHS
.EXTERNAL DONB,REGO
.EXTERNAL NAMPTR
.EXTERNAL FLAG,MOVE
.EXTERNAL PRNAME,PRWD,ERROR
.EXTERNAL LBEGIN,DECODE
.EXTERNAL ARLOC
.EXTERNAL DEFILE
.EXTERNAL OUTSW,OUTLIM
.EXTERNAL EQLPRM,POUND,DNUMB
.ENTRY GETSPC,CDNORM
.ENTRY CD,ASSIGN,LOOKUP,ZEROCD,GCH
.ENTRY SETDEV
.ENTRY NMOVE
.ENTRY CCER1
/THE FOLLOWING DON'T HAVE TO BE ENTRY'S BECAUSE THEY ARE LINKED TO
/FROM THE EXTENSION MODULE (CCLCDX) THAT KNOWS CCLCD IS IN MEMORY
.GLOBAL LV
.GLOBAL DVICE /******
.GLOBAL ASADR,LNAME /******
.GLOBAL UNKN,SETEXT /******
.GLOBAL CDER0 /** CALLED BY OPNSUB
FIELD 1
.NOLIST
.INCLUDE IN:CCLDEF.MA
.LIST
MULTI=1 /SET TO 0 TO GET RID OF MULTIPLE CHARACTER SWITCHES
CD, 0
JMS I (CDINIT
BEGGRP, TAD I (OUTSW
SNA CLA
TAD BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS
TAD (MOFILE-1
DCA CLXR
JMS I (GETSPC /FAKE-OUT TO GETSPC CAN CAUSE EFFECTIVE BRANCH HERE
JMS I (ASSIGN
TAD I (OUTSW
SNA CLA
TAD LIMDIF /DIFF BETWEEN END OF OUTPUT & INPUT AREAS
TAD I (OUTLIM /END OF OUTPUT AREA
TAD CLXR
SMA CLA
JMP I (CDER1
JMS I (CCLSWT
TAD I (OUTSW
SNA CLA
LKUPSW, HLT /0 IF SPEC. DECODE MODE, JMP LKUPIN IF NORMAL
TAD I (DVICE
JMS I (PCLXR
TAD NAME1
JMS I (PCLXR
TAD NAME2
JMS I (PCLXR
TAD NAME3
JMS I (PCLXR
TAD NAME4
JMP NLKUPI
LKUPIN, JMS I (LOOKUP
JMS I (PCLXR /STORE LENGTH AND DEV NUMBER
TAD I (LNAME /GET BLOCK
NLKUPI, JMS I (PCLXR
JMS I (ALLSWT
TAD I (OUTSW
SNA CLA
TAD I (FLAG
CLL RTL
SPA CLA /FEATURE ENABLED?
TAD LKUPSW
SNA CLA
JMP DLOOK /IN SPECIAL MODE OR ON OUTPUT SIDE
TAD DELIM
TAD (-"+
SNA CLA
JMP NBS
TAD I (DONB
SZA CLA
JMP NBS
TAD (7600 /V1A NOW TAKES ARG IN AC
JMS I (NMOVE /MOVE NAME TO OUTPUT FILE NAMES
JMP DLOOK
NBS, JMS I (ZERR
DLOOK, STA
DCA I (DVFLAG
TAD DELIM
SNA
JMP I CD
TAD (-"[
SNA
JMP I (OLENGT
TAD ("[-"+
SZA
TAD ("+-",
SNA
JMP I (FILLP /**** JUMPING INTO ROUTINE (IS THIS A BUG?)
TAD (",-"<
SZA
TAD ("<-"_
SNA
JMP 5$ /BACK-ARROW (UNDERSCORE) MEANS SAME AS "<"
TAD ("_-"=
SZA CLA /SKIP ON AN EQUAL SIGN (=)
JMP I (CDER2 /BAD CHAR
JMS I (GLXR
JMS I (DECODE
CLL
STA /LINK=0 MEANS LETTER
TAD LXR /NOW LINK=1 MEANS LETTER
DCA LXR
SZL
JMP 5$ /= MEANS "<"
JMS I (EQLPRM /= MEANS = (NUMERIC PARAMETER)
DL2: JMS I (ALLSWT
JMP DLOOK
5$: ISZ I (OUTSW /FOUND BACK-ARROW (<)
JMP I (CDER2 /TWO BACK-ARROWS
TAD LXR /GET PTR TO ARROW
DCA I (ARLOC /SAVE IT ('EDIT' MIGHT NEED IT)
JMP BEGGRP
LIMDIF, MIFILE-MPARAM+2 /OR MOFILE+5-MPARAM+5: IN SPEC. MODE
BEGDIF, MIFILE-MOFILE /OR 5: IN SPEC. MODE
PAGE
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 /OR THERE IS NO FILE NAME TO LOOK UP
SPKLG1, HLT /CLA: SPEC. MODE, SNA CLA: NORMAL MODE
TAD GETHND /GETHND=11
IAC
DCA AS
TAD (HNDLR+1 /ALLOW TWO PAGE HANDLERS
DCA ASADR
CIF 10
JMS I (USR
AS, 0
0
0
ASADR, HNDLR+1
JMP OCTES /TEST OPEN/CLOSE SPECIAL
TAD AS+2
ASGNST, DCA I (DVICE
JMP I ASSIGN
OCTES, CLA CLL IAC RTL /=4
AND I (FLAG
SZA CLA
JMP ASGNST /DEVICE 0 IS NONE
JMP I (CDER0
DFLTNM, DEVICE DSK
GETHND, 11 /1+11=12 (1=FETCH, 12=INQUIRE)
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
ALLSWT, 0
TAD DELIM
TAD (-"/
SNA
JMP I (SLASH
TAD ("/-"-
SZA CLA
JMP I ALLSWT
JMS CCLSWT
JMP ALLSWT+1
CCLSWT, 0
TAD DELIM
TAD (-"-
SZA CLA
JMP I CCLSWT
TAD I (OUTSW
SZA CLA
JMP I (CDER4 /CCL EXT ON OUTPUT FILE
TAD (SWTCHS
DCA DEF
JMS GETL
JMP I (CDER44 /NON-ALPHANUMERIC CCL SWITCH
BSW
DCA TN$
JMS GETL
JMP 1$ /ONE CHAR CCL SWITCH
TAD TN$
DCA TN$
JMS GETL
1$: SKP CLA /2 CHAR CCL SWITCH
JMP I (CDER44 /3 CHAR CCL-SWITCH
TAD TN$
JMS I (EXTLUK
CLA
ISZ DEF
CDF 0
TAD I DEF
DCA G$ /GET PTR TO ARGUMENT PAIR
TAD I G$ /GET SUBROUTINE
DCA H$
ISZ G$
TAD I G$ /GET ARGUMENT
CDF 10
JMS I H$ /CALL SUBR, ARG IN AC
JMP CCLSWT+1
G$: 0
H$: 0
TN$: 0
PAGE
/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
/RETURNS WITH DELIMETER IN AC
/GIVES ERROR MESSAGE IF NAME IS BAD
GNAME, 0
DCA NAME1
DCA NAME2
DCA NAME3
DCA NAME4
DCA NAME5
TAD (NAME1
DCA NMBASE
CLA CMA
DCA PERDSW
DCA NAMECT
JMS I (GCH
TAD (-"#
SNA
JMS I (NUMC /BUG IF MAKE COMMAND USES A # (OVERLAYS LOOP)
TAD ("#
SKP
GTNMLP, JMS I (GCH
P2, DCA DELIM
TAD DELIM
TAD (-"%
SNA
JMP PER
TAD ("%-"?
SZA
TAD ("?-"*
SNA
STARSW, HLT /JMP CDER6:NORMAL MODE, JMP STARNM: SPEC. MODE
TAD ("*-".
SNA CLA
JMP PERIOD
TAD DELIM
JMS I (DECODE
JMP LV
STARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY
TAD DELIM
AND (77
DCA DELIM
TAD NAMECT
TAD (-6
SMA CLA
JMP GTNMLP
TAD NAMECT
CLL RAR
TAD NMBASE
DCA TT
TAD DELIM
SNL
BSW
TAD I TT
DCA I TT
ISZ NAMECT
JMP GTNMLP
PERIOD, TAD NAME1
SZA CLA
ISZ PERDSW
JMS I (ERROR /NULL NAME OR DOUBLE EXTENSION
12. /#Illegal extension
ISZ NMBASE
ISZ NMBASE
STL CLA RTL /2 (ALLOW 4 CHARACTER EXTENSION)
DCA NAMECT
JMP GTNMLP
LV, CLA
TAD DELIM
JMP I GNAME
PER, TAD ("?
JMP P2
PERDSW, 0
NAMECT, 0
CDER6, TAD I (FLAG
RTL
SMA CLA
JMP CD6E /ONLY IF -LS WORKS
TAD (-112
JMS I (MOVE
CDF 0
BEGLN
CDF 0
BFR
TAD (-<MUNGCE-MUNGC>
JMS I (MOVE
CDF 10
MUNGC
CDF 0
BEGLN
TAD (-<112-<MUNGCE-MUNGC>>
JMS I (MOVE
CDF 0
BFR
CDF 0
BEGLN+MUNGCE-MUNGC
CDF 0
DCA I (BEGLN+111 /SAFETY
CDF 10
JMP I (REGO
CD6E, JMS I (ERROR
2. /#Illegal * or ?
PAGE
LOOKUP, 0
DCA LNAME
TAD NAME1
SNA CLA
JMP LKUPST
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 /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
JMS EXTLUK /LOOK FOR EXTENSION
SNA CLA /DID WE FIND IT?
JMP EXT3 /NO, FORCE NULL EXTENSION TO MATCH
EXT2, CDF 0
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, CDF 10
TAD (NAME1
DCA LNAME
TAD I (AS+2
JMS I (USR
2
LNAME, 0 /NAME1
LENGTH, 0
JMP LFAILD
TAD NAME4
DCA I (SETEXT
ISZ DEF /POINT TO ASSOCIATED CUSP NAME
CDF 0
TAD I DEF
CDF 10
DCA I (DEFILE /SAVE IT AWAY
TAD LENGTH
CLL
TAD (400
SNL
CLACON, 7600 /CLA
CLL RTL
RTL
AND (7760
LKUPST, TAD DVICE
JMP I LOOKUP
LFAILD, TAD NAMERM
CDF 0
SNA CLA /WAS THERE AN EXPLICIT EXTENSION?
TAD I DEF /NO - WAS THERE A DEFAULT EXTENSION?
SNA CLA
JMP XYZ
NEXTEXT,CDF 10
ISZ DEF /NO EXPLICIT EXT AND YES DEFAULT EXT
ISZ DEF /POINT TO NEXT POSSIBLE DEFAULT EXTENSION
JMP EXT2 /AND TRY FOR IT
NAMERM, 0
DVICE, 0
EXTLUK, 0
CIA
DCA T
1$: CDF 0
TAD I DEF
CDF 10
SNA /AT NULL?
JMP I EXTLUK /YES
TAD T /NO
SNA CLA /MATCH?
JMP 2$ /YES
ISZ DEF /NO
ISZ DEF /POINT TO NEXT ENTRY
JMP 1$ /TRY AGAIN
2$: TAD T /RETURN WITH IT IN AC
CIA
JMP I EXTLUK
XYZ, CDF 10
JMP I (CDER3 /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
CDER1, JMS I (ERROR
3. /#Too many files
GLXR, 0 /NEW LOWER CASE GLXR
CDF 0
ISZ LXR
TAD I LXR
TAD (-340
SMA
TAD (-40
TAD (340
CDF 10
JMP I GLXR
NFOU, TAD NAME1
AND (77
SNA CLA
JMP I (ONE /ONE-CHARACTER SWITCH
TAD ('#@
JMS I (PRWD
JMS I (PRNAME
JMS I (ERROR
4. /#XXXXXX Option is unknown
PAGE
/TAKES A LETTER OR A DIGIT IN AC
/AND TURNS ON APPROPRIATE BIT IN OPTION TABLE
SLSHCH, 0
DCA DELIM
TAD (MPARAM-1
DCA T
TAD DELIM
JMS I (DECODE
JMP CDER8
SZL
TAD (32
CMA STL /THE FOLLOWING TURNS
/ON THE CORRECT OPTION BIT
DCA TT
L$: SZL
ISZ T
RAR
SNL
ISZ TT
JMP L$
DCA TT
TAD TT
CMA
AND I T
TAD TT
DCA I T
JMP I SLSHCH
CDER8, JMS I (ERROR
5. /#Illegal Switch option
ZEROCD, 0
TAD (-42 /AC MAY BE NON-0
DCA T
TAD (MOFILE-1
DCA XR
DCA I XR /ZERO THE COMMAND DECODER OUTPUT AREA
ISZ T
JMP .-2
JMP I ZEROCD
GCH, 0
JMS I (GLXR
TAD (-240
SNA
JMP GCH+1 /IGNORE SPACES
TAD (240-"(
SNA
JMP OPENP$
TAD ("(
JMP I GCH
JMP GCH+1
OPENP$: JMS I (GLXR
TAD (-")
SNA
JMP GCH+1
TAD (")
JMS SLSHCH
JMP OPENP$
IFZERO MULTI <
SLASH, JMS I (GLXR
JMS SLSHCH
JMS I (GLXR
DCA DELIM
JMP I (ALLSWT+1
>
IFNZRO MULTI <
SLASH, CDF TABLES /POINT TO SWITCH TABLE POINTER
TAD I PTR /GET PTR TO SWITCH TABLE
CDF 10
JMS I (TRANSL
JMP I (ALLSWT+1
>
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
JMS I (DNUMB
CLL RTL
RTL
AND (7760
TAD I NMBASE
DCA I NMBASE
CDF 0
TAD DELIM
TAD (-"] /IS THERE A CLOSING BRACKET?
SNA /IF NOT,
/"DLOOK" ROUTINE WILL DETECT IT
JMS GCH
DCA DELIM
JMP I (DL2
SETDSK, 0
TAD DSKDEV
SZA
JMP I SETDSK
JMS I (USR
12 /INQUIRE
5723 /PACKED ENCODING FOR 'DSK:'
DSKDEV, 0 /SET TO DEVICE NUMBER
0
HLT /NO 'DSK' !
TAD DSKDEV
JMP I SETDSK
.ENABLE ASCII
.DISABLE FILL
MUNGC, TEXT /TT* / /REALLY CALLS TECO.TEC WITH TTL COMMAND
MUNGCE=.
.ENABLE SIXBIT
.ENABLE FILL
PAGE
CCER1, TAD I (NAMPTR
DCA X$
TAD (-5
JMS I (MOVE
CDF 10
X$: 0
CDF 10
NAME1
CDER3, TAD ('#@
JMS I (PRWD
JMS I (PRNAME
JMS I (ERROR
6. /#XXXXXX not found
CCER2, TAD I (DVNM1
DCA DEV1
TAD I (DVNM2
DCA DEV2
CDER0, TAD DEV1
SNA CLA
JMP I (CDER2 /B DOES NOT EXIST
TAD ('#@
JMS I (PRWD
TAD DEV1
JMS I (PRWD
TAD DEV2
JMS I (PRWD
JMS I (ERROR
7. /#YYYY does not exist
BKA, 0
TAD I (LBEGIN
DCA CLXR
1$: CDF 0
ISZ CLXR
TAD I CLXR
CDF 10
SNA
JMP NOBKR$
TAD (-"<
SNA
JMP I BKA
TAD ("<-"_
SNA
JMP I BKA
TAD ("_-"=
SZA CLA
JMP 1$
ISZ CLXR /= MEANS _ IF NOT FOLLOWED BY A DIGIT
CDF 0
TAD I CLXR
CDF 10
JMS I (DECODE
SKP CLA /NOT A DIGIT
SNL CLA /MAYBE A DIGIT
JMP I BKA /= FOLLOWED BY A NON-DIGIT MEANS _
JMP 1$ /IT'S AN =NNNN
NOBKR$: ISZ BKA
JMP I BKA
PCLXR, 0
ISZ CLXR
DCA I CLXR
JMP I PCLXR
ZERR, 0
DCA I (DONB /ZERO 1ST OUTPUT FILE
TAD (MOFILE-1
DCA XR2
DCA I XR2
DCA I XR2
DCA I XR2
DCA I XR2
DCA I XR2
JMP I ZERR
PAGE
CDINIT, 0
ISZ PTR /POINT TO SWITCH TABLE
JMS I (USR
13 /RESET ALL HANDLERS
CDF 0
TAD I DEFALT
CDF 10
TAD (-5200
SZA CLA /IS THIS A REQUEST FOR A
/"SPECIAL DECODE"?
JMP CDCONT /NO: SET NORMAL MODE
TAD (1-MOFILE-5
DCA I (OUTLIM /YES, SET UP THE PROPER LOCATIONS
TAD (MOFILE+5-MPARAM+5
DCA I (LIMDIF /TO GET 1 OUTPUT AND 5 INPUT FILES
TAD (5
DCA I (BEGDIF /ALL OF WHICH ARE
/5-WORD <DEVICE,NAME> ENTRIES
DCA I (LKUPSW
TAD STARJM
DCA I (STARSW /AND ALLOW *
/AS A FILE OR EXTENSION NAME
TAD (CLA /STOPS FETCHES IN SPECIAL MODE
DCA I (SPKLG1 /NO HANDLER FETCHES NECESSARY EITHER
/SINCE NO LOOKUPS
SKP
CDCONT, JMS CDNORM /SET NORMAL MODE
JMS I (BKA /SCAN AHEAD FOR <
STA /SKIP RETURN IF NOT FOUND
DCA I (OUTSW
JMS I (ZEROCD
TAD I (LBEGIN
DCA LXR
JMP I CDINIT
CDNORM, 0
TAD (1-MIFILE
DCA I (OUTLIM
TAD (MIFILE-MPARAM+2
DCA I (LIMDIF
TAD (MIFILE-MOFILE
DCA I (BEGDIF
TAD LKUPJM
DCA I (LKUPSW
TAD CDERJM
DCA I (STARSW
TAD (SNA CLA
DCA I (SPKLG1
JMP I CDNORM
SETDEV, 0 /V1A ARG NOW IN AC
DCA 1$
CLL STA RAL /-2
JMS I (MOVE
CDF 0
1$: 0 /PTS TO DEVICE NAME
CDF 10
DVNM1
JMS I (SETOUT
JMP I SETDEV
UNKN, 0
TAD SETEXT
SZA
TAD T /NEG OF SWITCH REQUEST
SZA CLA
JMS I (ERROR /CAN'T HAVE 2ND DEFAULT EXTENSION
8. /#Contradictory switches
TAD T
CIA
DCA SETEXT /SET DEFAULT EXTENSION
TAD DEFALT /SEE IF IT'S IN COMMAND'S SEARCH LIST
DCA DEF
TAD SETEXT
JMS I (EXTLUK
SNA CLA /DID WE FIND IT?
JMP CDER4 /NO
ISZ DEF /YES
CDF 0
TAD I DEF
CDF 10
DCA I (DEFILE /SET FILE; SETEXT ALREADY SET
JMP I UNKN
SETEXT, 0 /EXT WHICH HAS BEEN SET BY A CCL SWITCH
STARJM, 5200+<STARNM&177>
LKUPJM, 5200+<LKUPIN&177>
CDERJM, 5200+<CDER6&177>
CDER2, JMS I (ERROR
9. /#Illegal syntax
CCERB,
CDER4, JMS I (ERROR
10. /#Switch not allowed here
CDER44, JMS I (ERROR
11. /#Illegal CCL switch
CDER7, JMS I (ERROR
12. /#Illegal extension ?NOT USED?
PAGE
/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
/IT GIVES A FATAL ERROR MESSAGE IF BAD.
GETSPC, 0
STA
DCA DVFLAG
DCA DEV1
FILLP1, DCA DEV2
FILLP, JMS I (GNAME
TAD (-": /AC CONTAINED DELIM
SNA CLA
JMP 3$ /IT'S A DEVICE NAME
DCA NUMC
TAD (-4
JMS I (MOVE
CDF 10
NAME1
CDF 0
FNAME1 /SAVE AWAY FILE NAME
JMP I GETSPC
3$: CLA IAC /PARSE FILENAME AFTER DEV:
TAD I (PERDSW
TAD NUMC
SZA CLA
CDERA, JMS I (ERROR /. OR # IN DEVICE NAME
13. /#Bad device (name?)
TAD NAME1
DCA DEV1
ISZ DVFLAG
JMP CDERA /CATCHES A:B:
TAD NAME2
JMP FILLP1
DVFLAG, 0
NUMC, 0 /USED AS FLAG INDICATING SAW #
JMS I (POUND
JMP I NUMC
NMOVE, 0
DCA 2$ /V1A ARG IN AC
TAD I (FLAG
RTL
SMA CLA /FEATURE ENABLED?
JMP I (CCERB /NO
TAD I (OUTSW
SZA CLA
JMP I (CCERB /ON OUTPUT SIDE
TAD I (MOFILE /V3C
SNA CLA /DON'T CHANGE OUT DEV IF SPECIFIED
TAD I (FLAG /LOOK AT 'COPY EXT' BIT
AND (200
SNA CLA
JMP 1$ /IT WASN'T SET
TAD I (MIFILE /GET FIRST INPUT DEVICE
AND (17 /ISOLATE DEVICE BITS
DCA I (MOFILE /FORCE THIS TO BE FIRST OUTPUT DEVICE
1$: TAD I 2$
SNA
JMS I (SETDSK /CHANGE TO 'IAC' TO ALWAYS USE SYS:
DCA I 2$ /SET DEVICE TO SYS IF NONE
ISZ 2$
TAD I 2$ /WAS THERE A SPECIFICATION THERE?
SZA CLA
JMP I NMOVE /YES, DO NOTHING
TAD I (FLAG
AND (200 /GET 'COPY EXTENSION' BIT
SMA SZA CLA /'SMA' IS UNNECESSARY
STA /COPY 4 WORDS IF BIT 4 WAS ON
TAD (-3 /OTHERWISE ONLY COPY 3 WORDS
JMS I (MOVE
CDF 0
FNAME1
CDF 10
2$: 0
JMP I NMOVE
JMSUB, 0
SNA
JMP I JMSUB
DCA T$
JMS I T$
JMP I JMSUB
T$: 0
AMBIG, TAD NAME1
AND (77
SNA CLA
JMP I (ONE
TAD ('#@
JMS I (PRWD
JMS I (PRNAME
JMS I (ERROR
14. /#XXXXXX Option ambiguous
PAGE
SETOUT, 0
TAD I (FLAG
RTR
SZL CLA
TAD (5
TAD (MOFILE
DCA OLOC
TAD I OLOC
SZA CLA
JMP I SETOUT /HE'S SPECIFIED SOMETHING
JMS I (USR
12 /INQUIRE
DVNM1, 0
DVNM2, 0
0
JMP I (CCER2 /NO SUCH DEVICE
TAD DVNM2
DCA I OLOC
TAD OLOC
AND (5
SNA CLA /USING 2ND OUT DEV?
JMP I SETOUT /NO
ISZ OLOC /YES
TAD (-4
JMS I (MOVE
CDF 0
FNAME1
CDF 10
OLOC, 7600 /INITIALLY 7600 OR 7605
JMP I SETOUT
/ TAD (PTR TO SWITCH TABLE ENTRY (IN FIELD 0)
/ JMS TRANSL
/ IT PARSES SWITCH, SETS BIT
/ PARSES :VALUE, SETS = OPTION
/ LEAVES DELIMETER IN DELIM
TRANSL, 0
DCA SPTR /POINT INTO A SWITCH TABLE
JMS I (GNAME /GET A NAME
DCA DEL
JMS SRCH
JMP I (NFOU /SWITCH NOT FOUND
STA
TAD SRPTR
DCA SSPTR /SAVE PTR INTO LONG NAME
JMS SRCH /SEARCH SOME MORE
SKP /SHOULDN'T FIND ANYTHING
JMP I (AMBIG /AMBIGUOUS SWITCH
CDF 0
L$: TAD I SSPTR /SCAN PAST END OF LONG NAME
ISZ SSPTR
AND (77
X240: SZA CLA
JMP L$
TAD I SSPTR
CDF 10
SL, AND (377 /ISOLATE CORRESPONDING ONE-CHARACTER SWITCH
SZA
JMS I (SLSHCH /SET APPROPRIATE BIT
TAD DEL
DCA DELIM
TAD DELIM
TAD (-":
SNA CLA
JMS I (EQLPRM
JMP I TRANSL
ONE, TAD NAME1
BSW
TAD X240
AND (77
TAD X240
JMP SL
SPTR, 0
SSPTR, 0
DEL, 0
/RETURN 1 IF NAME NOT FOUND
/RETURN 2 IF NAME FOUND
SRCH, 0
1$: STA
DCA SRSW /LONGS AT LEAST 2 LONG
TAD (NAME1
DCA NPTR
CLL STA RTL /-3
DCA NCNT
CDF 0
TAD I SPTR
CDF 10
ISZ SPTR
SNA
JMP I SRCH /NOT FOUND
DCA SRPTR
2$: TAD I NPTR
SNA
JMP 3$
ISZ SRSW /ALWAYS MATCH 2 FIRST BYTES
AND (77
SZA CLA
TAD (77 /MUST MATCH BOTH BYTES
TAD (7700 /NEED ONLY MATCH LEFT BYTE
CDF 0
AND I SRPTR
CDF 10
CIA
TAD I NPTR
SZA CLA
JMP 1$ /THIS SWITCH AIN'T IT
ISZ SRPTR
ISZ NPTR
ISZ NCNT
JMP 2$
3$: ISZ SRCH
JMP I SRCH
SRSW, -1
SRPTR, 0 /POINTS INTO LONG NAME TABLE
NCNT, 0
NPTR, 0 /POINTS INTO NAME1-3
PAGE