sw/os8/v3d/sources/devext/dectapes/dectape1/cclcd.ma

   1 /
   2 /
   3 /
   4 /COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
   5 /
   6 /
   7 /
   8 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
   9 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  10 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  11 /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  12 /
  13 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  14 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  15 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  16 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  17 /
  18 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  19 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  20 /DIGITAL.
  21 /
  22 /
  23 /
  24
  25 \f
  26 /VERSION=V3A (D.H.)
  27 \f/4     CCL'S COMMAND DECODER
  28         .EXTERNAL TABLES,FNAME1
  29         .EXTERNAL SWTCHS
  30         .ENTRY GETSPC
  31 /THE FOLLOWING DON'T HAVE TO BE ENTRY'S BECAUSE THEY ARE LINKED TO
  32 /FROM THE EXTENSION MODULE (CCLCDX) THAT KNOWS CCLCD IS IN MEMORY
  33         .GLOBAL LV
  34         .EXTERNAL EQLPRM,POUND,DNUMB
  35         MULTI=1         /SET TO 0 TO GET RID OF MULTIPLE CHARACTER SWITCHES
  36         PTR=36
  37         .GLOBAL BADEV,CDER2,DVICE       /******
  38         .GLOBAL ASADR,LNAME             /*****
  39         .ENTRY CCER1
  40         .RSECT CCLCD
  41         .GLOBAL UNKN
  42         .EXTERNAL FLAG,MOVE,PRMESG
  43         .EXTERNAL PRNAME,PRWD
  44         .EXTERNAL LBEGIN,DECODE
  45         .EXTERNAL ARLOC
  46         .EXTERNAL DEFILE
  47         .ENTRY CD,ASSIGN,LOOKUP,ZEROCD,GLXR
  48         .EXTERNAL OUTSW,OUTLIM
  49         .ENTRY GCH,SETDEV,SETEXT
  50         .ENTRY NMOVE
  51         .EXTERNAL DONB
  52         .EXTERNAL NAMPTR
  53         FIELD 1
  54         MOFILE=7600
  55         MIFILE=7617
  56         MPARAM=7643
  57
  58         XR2=15
  59         XR=16
  60         T=20
  61         TT=21
  62         DEF=22
  63         NAME1=23
  64         NAME2=24
  65         NAME3=25
  66         NAME4=26
  67         NAME5=27
  68         NMBASE=37
  69         DEV1=30
  70         DEV2=31
  71         DELIM=32
  72         DEFALT=33       /POINTS TO DEFAULT EXTENSION LIST
  73         LXR=34
  74         CLXR=35
  75         BEGLN=1000
  76         HNDLR=4400
  77 \fCD,    0
  78         JMS I (CDINIT
  79 BEGGRP, TAD I (OUTSW
  80         SNA CLA
  81         TAD I (BEGDIF   /DIFF BETWEEN INPUT & OUTPUT AREAS
  82         TAD (MOFILE-1
  83         DCA CLXR
  84         JMS I (GETSPC   /FAKE-OUT TO GETSPC CAN CAUSE EFFECTIVE BRANCH HERE
  85         JMS I (ASSIGN
  86         TAD I (OUTSW
  87         SNA CLA
  88         TAD I (LIMDIF   /DIFF BETWEEN END OF OUTPUT & INPUT AREAS
  89         TAD I (OUTLIM   /END OF OUTPUT AREA
  90         TAD CLXR
  91         SMA CLA
  92         JMP I (CDER1
  93         TAD I (OUTSW
  94         SNA CLA
  95 LKUPSW, JMP IN$         /ZEROED IF IN "SPECIAL DECODE" MODE
  96         TAD I (DVICE
  97         JMS PCLXR
  98         TAD NAME1
  99         JMS PCLXR
 100         TAD NAME2
 101         JMS PCLXR
 102         TAD NAME3
 103         JMS PCLXR
 104         TAD NAME4
 105         JMP 2$
 106 IN$:    JMS I (LOOKUP
 107         JMS PCLXR       /STORE LENGTH AND DEV NUMBER
 108         TAD I (LNAME    /GET BLOCK
 109 2$:     JMS PCLXR
 110         JMS I (CCLSWT
 111         TAD I (OUTSW
 112         SNA CLA
 113         TAD I (FLAG
 114         CLL RTL
 115         SPA CLA         /FEATURE ENABLED?
 116         TAD LKUPSW
 117         SNA CLA
 118         JMP DLOOK       /IN SPECIAL MODE OR ON OUTPUT SIDE
 119         TAD DELIM
 120         TAD (-"+
 121         SNA CLA
 122         JMP NBS
 123         TAD DONB
 124         SZA CLA
 125         JMP NBS
 126         TAD (7600       /V1A NOW TAKES ARG IN AC
 127         JMS I (NMOVE    /MOVE NAME TO OUTPUT FILE NAMES
 128         JMP DLOOK
 129 \fNBS,   JMS I (ZERR
 130 DLOOK,  STA
 131         DCA I (DVFLAG
 132         TAD DELIM
 133         SNA
 134         JMP I CD
 135         TAD (-"[
 136         SNA
 137         JMP I (OLENGT
 138         TAD ("[-"+
 139         SZA
 140         TAD ("+-",
 141         SNA
 142         JMP I (FILLP    /**** JUMPING INTO ROUTINE (IS THIS A BUG?)
 143         TAD (",-"<
 144         SZA
 145         TAD ("<-"_
 146         SNA
 147         JMP 5$          /BACK-ARROW (UNDERSCORE) MEANS SAME AS "<"
 148         TAD ("_-"=
 149         SZA CLA         /SKIP ON AN EQUAL SIGN (=)
 150         JMP I (CDER2    /BAD CHAR
 151         JMS I (GLXR
 152         JMS I (DECODE
 153         CLL
 154         STA             /LINK=0 MEANS LETTER
 155         TAD LXR         /NOW LINK=1 MEANS LETTER
 156         DCA LXR
 157         SZL
 158         JMP 5$          /= MEANS "<"
 159         JMS I (EQLPRM   /= MEANS = (NUMERIC PARAMETER)
 160 DL2:    JMS I (CCLSWT
 161         JMP DLOOK
 162 5$:     ISZ I (OUTSW    /FOUND BACK-ARROW (<)
 163         JMP I (CDER2    /TWO BACK-ARROWS
 164         TAD LXR         /GET PTR TO ARROW
 165         DCA I (ARLOC    /SAVE IT ('EDIT' MIGHT NEED IT)
 166         JMP BEGGRP
 167
 168 PCLXR,  0
 169         ISZ CLXR
 170         DCA I CLXR
 171         JMP I PCLXR
 172 \f       PAGE
 173 \fZERR,  0
 174         DCA I (DONB     /ZERO 1ST OUTPUT FILE
 175         TAD (7577
 176         DCA XR2
 177         DCA I XR2
 178         DCA I XR2
 179         DCA I XR2
 180         DCA I XR2
 181         DCA I XR2
 182         JMP I ZERR
 183 \fASSIGN,        0
 184         TAD CLXR
 185         AND I (DVFLAG
 186         TAD I (OUTLIM
 187         SMA SZA CLA     /CHECK FOR OUTPUT OR FIRST INPUT
 188         JMP ASNORM      /IF DEVICE WAS SPECIFIC,
 189                         /OR IF WE ARE ON THE INPUT SIDE,
 190                         /PROCEED NORMALLY
 191         TAD NAME1
 192         SNA CLA
 193         JMP ASGNST
 194         TAD DFLTNM+1
 195         DCA DEV2
 196         TAD DFLTNM
 197         DCA DEV1
 198 ASNORM, TAD DEV1
 199         DCA AS+1
 200         TAD DEV2
 201         DCA AS+2
 202         TAD I (OUTSW
 203         SNA CLA         /DON'T LOAD HANDLER
 204                         /IF WE ARE ON OUTPUT SIDE OF "_"
 205         TAD NAME1
 206 SPKLG1, SNA CLA         /OR THERE IS NO FILE NAME TO LOOK UP
 207         TAD GETHND      /GETHND=11 NORMALLY,
 208                         /0 IF IN "SPECIAL DECODE" MODE
 209         IAC
 210         DCA AS
 211         TAD (HNDLR+1    /ALLOW TWO PAGE HANDLERS
 212         DCA ASADR
 213         CIF 10
 214         JMS I (200
 215 AS,     0
 216         0
 217         0
 218 ASADR,  HNDLR+1
 219         JMP I (CDER0
 220         TAD AS+2
 221 ASGNST, DCA I (DVICE
 222         JMP I ASSIGN
 223 \fDFLTNM,        DEVICE DSK
 224 GETHND, 11              /1+11=12 (1=FETCH, 12=INQUIRE)
 225 \fGETL,  0
 226         JMS I (GCH
 227         DCA DELIM
 228         TAD DELIM
 229         JMS I (DECODE
 230         JMP I GETL      /NON-ALPHANUM IN CCL SWITCH
 231         CLA
 232         TAD DELIM
 233         AND (77
 234         ISZ GETL
 235         JMP I GETL
 236 \fCCLSWT,        0
 237         TAD DELIM
 238         TAD (-"/
 239         SNA
 240         JMP I (SLASH
 241         TAD ("/-"-
 242         SZA CLA
 243         JMP I CCLSWT
 244         TAD I (OUTSW
 245         SZA CLA
 246         JMP I (CDER4    /CCL EXT ON OUTPUT FILE
 247         TAD (SWTCHS
 248         DCA DEF
 249         JMS GETL
 250         JMP I (CDER44   /NON-ALPHANUMERIC CCL SWITCH
 251         JMS I (ROTL
 252         DCA TN$
 253         JMS GETL
 254         JMP 1$          /ONE CHAR CCL SWITCH
 255         TAD TN$
 256         DCA TN$
 257         JMS GETL
 258 1$:     SKP CLA         /2 CHAR CCL SWITCH
 259         JMP I (CDER44   /3 CHAR CCL-SWITCH
 260         TAD TN$
 261         JMS I (EXTLUK
 262         CLA
 263         ISZ DEF
 264         CDF 0
 265         TAD I DEF
 266         DCA G$          /GET PTR TO ARGUMENT PAIR
 267         TAD I G$        /GET SUBROUTINE
 268         DCA H$
 269         ISZ G$
 270         TAD I G$        /GET ARGUMENT
 271         CDF 10
 272         JMS I H$        /CALL SUBR, ARG IN AC
 273         JMP CCLSWT+1
 274 G$:     0
 275 H$:     0
 276 TN$:    0
 277         PAGE
 278 \f/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
 279 /RETURNS WITH DELIMETER IN AC
 280 /GIVES ERROR MESSAGE IF NAME IS BAD
 281
 282 GNAME,  0
 283         DCA NAME1
 284         DCA NAME2
 285         DCA NAME3
 286         DCA NAME4
 287         DCA NAME5
 288         TAD (NAME1
 289         DCA NMBASE
 290         CLA CMA
 291         DCA PERDSW
 292         DCA NAMECT
 293         JMS I (GCH
 294         TAD (-"#
 295         SNA
 296         JMS I (NUMC     /BUG IF MAKE COMMAND USES A # (OVERLAYS LOOP)
 297         TAD ("#
 298         SKP
 299 GTNMLP, JMS I (GCH
 300 P2,     DCA DELIM
 301         TAD DELIM
 302         TAD (-"%
 303         SNA
 304         JMP PER
 305         TAD ("%-"?
 306         SZA
 307         TAD ("?-"*
 308         SNA
 309 STARSW, JMP I (CDER6    /"JMP STARNM"
 310                         /IF "SPECIAL DECODE" MODE
 311         TAD ("*-".
 312         SNA CLA
 313         JMP PERIOD
 314         TAD DELIM
 315         JMS I (DECODE
 316         JMP LV
 317 STARNM, CLA             /THIS CODE HANDLES *'S AND ?'S CORRECTLY
 318         TAD DELIM
 319         AND (77
 320         DCA DELIM
 321         TAD NAMECT
 322         TAD (-6
 323         SMA CLA
 324         JMP GTNMLP
 325         TAD NAMECT
 326         CLL RAR
 327         TAD NMBASE
 328         DCA TT
 329         TAD DELIM
 330         SNL
 331         JMS I (ROTL
 332         TAD I TT
 333         DCA I TT
 334         ISZ NAMECT
 335         JMP GTNMLP
 336 PERIOD, TAD NAME1
 337         SZA CLA
 338         ISZ PERDSW
 339         JMP I (CDER7    /NULL NAME OR DOUBLE EXTENSION
 340         ISZ NMBASE
 341         ISZ NMBASE
 342         STL CLA RTL     /2 (ALLOW 4 CHARACTER EXTENSION)
 343         DCA NAMECT
 344         JMP GTNMLP
 345 LV,     CLA
 346         TAD DELIM
 347         JMP I GNAME
 348
 349 PER,    TAD ("?
 350         JMP P2
 351 \fPERDSW,        0
 352 NAMECT, 0
 353 \f       SOFSET=7747
 354
 355 CDER6,  CDF 0
 356         TAD I (7777
 357         CDF 10
 358         RAL
 359         SPA CLA
 360         JMP CD6E        /ERROR IF BATCH IS RUNNING
 361         TAD I (FLAG
 362         RTL
 363         SMA CLA
 364         JMP CD6E        /ONLY IF -LS WORKS
 365         TAD (-12
 366         JMS I (MOVE
 367         CDF 10
 368         MUNGC
 369         CDF 10
 370         7600
 371         TAD (-34
 372         JMS I (MOVE
 373         CDF 0
 374         1000
 375         CDF 10
 376         7612
 377         DCA I (7646     /SAFETY
 378         CDF 0
 379         TAD I (SOFSET
 380         CDF 10
 381         DCA BLK
 382         JMS I (200
 383         6               /CHAIN TO CCL.SV
 384 BLK,    0
 385
 386
 387 CD6E,   JMS I (PRMESG
 388         BADSTR
 389
 390         PAGE
 391 \fLOOKUP,        0
 392         DCA LNAME
 393         TAD NAME1
 394         SNA CLA
 395         JMP LKUPST
 396         TAD I (PERDSW
 397         TAD NAME4
 398         SNA CLA
 399         CLA IAC         /FORCE NAMERM NON-0 IF . AND NO EXT
 400         TAD NAME4
 401         DCA NAMERM      /REMEMBER TYPED EXTENSION
 402         TAD DEFALT
 403         DCA DEF
 404         TAD I (SETEXT
 405         SNA             /HAS AN EXTENSION BEEN SET?
 406         TAD NAMERM      /NO
 407         SNA             /DOES FILE HAVE EXTENSION?
 408         JMP EXT2        /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
 409         JMS EXTLUK      /LOOK FOR EXTENSION
 410         SNA CLA         /DID WE FIND IT?
 411         JMP EXT3        /NO, FORCE NULL EXTENSION TO MATCH
 412 EXT2,   CDF 0
 413         TAD I DEF
 414         IAC
 415         SNA CLA
 416         JMP NEXTEXT     /IGNORE -1'S
 417         TAD NAMERM
 418         SZA CLA
 419         JMP EXT3
 420         TAD I DEF
 421         DCA NAME4       /SET NEW EXTENSION
 422 EXT3,   CDF 10
 423         TAD (NAME1
 424         DCA LNAME
 425         TAD I (AS+2
 426         JMS I (200
 427         2
 428 LNAME,  0               /NAME1
 429 LENGTH, 0
 430         JMP LFAILD
 431         TAD NAME4
 432         DCA I (SETEXT
 433         ISZ DEF         /POINT TO ASSOCIATED CUSP NAME
 434         CDF 0
 435         TAD I DEF
 436         CDF 10
 437         DCA I (DEFILE   /SAVE IT AWAY
 438         TAD LENGTH
 439         CLL
 440         TAD (400
 441         SNL
 442 CLACON, 7600            /CLA
 443         CLL RTL
 444         RTL
 445         AND (7760
 446 LKUPST, TAD DVICE
 447         JMP I LOOKUP
 448 \fLFAILD,        TAD NAMERM
 449         CDF 0
 450         SNA CLA         /WAS THERE AN EXPLICIT EXTENSION?
 451         TAD I DEF       /NO - WAS THERE A DEFAULT EXTENSION?
 452         SNA CLA
 453         JMP XYZ
 454 NEXTEXT,CDF 10
 455         ISZ DEF         /NO EXPLICIT EXT AND YES DEFAULT EXT
 456         ISZ DEF         /POINT TO NEXT POSSIBLE DEFAULT EXTENSION
 457         JMP EXT2        /AND TRY FOR IT
 458
 459 NAMERM, 0
 460 DVICE,  0
 461
 462 EXTLUK, 0
 463         CIA
 464         DCA T
 465 1$:     CDF 0
 466         TAD I DEF
 467         CDF 10
 468         SNA             /AT NULL?
 469         JMP I EXTLUK    /YES
 470         TAD T           /NO
 471         SNA CLA         /MATCH?
 472         JMP 2$          /YES
 473         ISZ DEF         /NO
 474         ISZ DEF         /POINT TO NEXT ENTRY
 475         JMP 1$          /TRY AGAIN
 476 2$:     TAD T           /RETURN WITH IT IN AC
 477         CIA
 478         JMP I EXTLUK
 479 XYZ,    CDF 10
 480         JMP I (CDER3    /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
 481 \fBADSYN,        TEXT    /#ILLEGAL SYNTAX/
 482 TOOMAN, TEXT    /#TOO MANY FILES/
 483 /AMBIGY,        TEXT    /#AMBIGUOUS SWITCH/
 484 CDER1,  JMS I (PRMESG
 485         TOOMAN
 486 \fNFOU,  TAD NAME1
 487         AND (77
 488         SNA CLA
 489         JMP I (ONE              /ONE-CHARACTER SWITCH
 490         JMS I (PRNAME
 491         JMS I (PRMESG
 492         SWNF
 493         PAGE
 494 \f/TAKES A LETTER OR A DIGIT IN AC
 495 /AND TURNS ON APPROPRIATE BIT IN OPTION TABLE
 496
 497 SLSHCH, 0
 498         DCA DELIM
 499         TAD (MPARAM-1
 500         DCA T
 501         TAD DELIM
 502         JMS I (DECODE
 503         JMP CDER8
 504         SZL
 505         TAD (32
 506         CMA STL         /THE FOLLOWING TURNS
 507                         /ON THE CORRECT OPTION BIT
 508         DCA TT
 509 L$:     SZL
 510         ISZ T
 511         RAR
 512         SNL
 513         ISZ TT
 514         JMP L$
 515         DCA TT
 516         TAD TT
 517         CMA
 518         AND I T
 519         TAD TT
 520         DCA I T
 521         JMP I SLSHCH
 522
 523 CDER8,  CLA
 524         JMS I (PRMESG
 525         BADOPT
 526 \fZEROCD,        0
 527         TAD (-42        /AC MAY BE NON-0
 528         DCA T
 529         TAD (MOFILE-1
 530         DCA XR
 531         DCA I XR        /ZERO THE COMMAND DECODER OUTPUT AREA
 532         ISZ T
 533         JMP .-2
 534         JMP I ZEROCD
 535
 536 GCH,    0
 537         JMS GLXR
 538         TAD (-240
 539         SNA
 540         JMP GCH+1       /IGNORE SPACES
 541         TAD (240-"(
 542         SNA
 543         JMP OPENP$
 544         TAD ("(
 545         JMP I GCH
 546         JMP GCH+1
 547 OPENP$: JMS GLXR
 548         TAD (-")
 549         SNA
 550         JMP GCH+1
 551         TAD (")
 552         JMS SLSHCH
 553         JMP OPENP$
 554
 555 GLXR,   0
 556         CDF 0
 557         ISZ LXR
 558         TAD I LXR
 559         CDF 10
 560         JMP I GLXR
 561
 562         IFZERO MULTI <
 563 SLASH,  JMS GLXR
 564         JMS SLSHCH
 565         JMS GLXR
 566         DCA DELIM
 567         JMP I (CCLSWT+1
 568         >
 569
 570         IFNZRO MULTI <
 571 SLASH,  CDF TABLES      /POINT TO SWITCH TABLE POINTER
 572         TAD I PTR       /GET PTR TO SWITCH TABLE
 573         CDF 10
 574         JMS I (TRANSL
 575         JMP I (CCLSWT+1
 576         >
 577 \fOLENGT,        TAD I (OUTSW
 578         AND NAME1       /[N] IS ONLY LEGAL
 579                         /ON THE OUTPUT SIDE OF THE "_"
 580         SNA CLA         /AND ONLY AFTER A FILE NAME
 581         JMP I (CDER2
 582         TAD (-4
 583         TAD CLXR
 584         DCA NMBASE
 585         JMS I (DNUMB
 586         CLL RTL
 587         RTL
 588         AND (7760
 589         TAD I NMBASE
 590         DCA I NMBASE
 591         CDF 0
 592         TAD DELIM
 593         TAD (-"]        /IS THERE A CLOSING BRACKET?
 594         SNA             /IF NOT,
 595                         /"DLOOK" ROUTINE WILL DETECT IT
 596         JMS GCH
 597         DCA DELIM
 598         JMP I (DL2
 599 \fSETDSK,        0
 600         TAD DSKDEV
 601         SZA
 602         JMP I SETDSK
 603         JMS I (200
 604         12              /INQUIRE
 605         5723            /PACKED ENCODING FOR 'DSK:'
 606 DSKDEV, 0               /SET TO DEVICE NUMBER
 607         0
 608         HLT             /NO 'DSK' !
 609         TAD DSKDEV
 610         JMP I SETDSK
 611 \f       .ENABLE ASCII
 612         .DISABLE FILL
 613 MUNGC,  TEXT    /MUNG WILD,/
 614         .ENABLE SIXBIT
 615         .ENABLE FILL
 616         PAGE
 617 \fCCER1, TAD I (NAMPTR
 618         DCA X$
 619         TAD (-5
 620         JMS I (MOVE
 621         CDF 10
 622 X$:     0
 623         CDF 10
 624         NAME1
 625 CDER3,  TAD (4300
 626         JMS I (PRWD     /#
 627         JMS I (PRNAME
 628         JMS I (PRMESG
 629         NF
 630
 631 CCER2,  TAD I (DVNM1
 632         DCA DEV1
 633         TAD I (DVNM2
 634         DCA DEV2
 635 CDER0,  TAD DEV1
 636         SNA CLA
 637         JMP I (CDER2    /B DOES NOT EXIST
 638         TAD (4300       /#
 639         JMS I (PRWD
 640         TAD DEV1
 641         JMS I (PRWD
 642         TAD DEV2
 643         JMS I (PRWD
 644         JMS I (PRMESG
 645         DNE
 646 \fNF,    TEXT    / NOT FOUND/
 647 DNE,    TEXT    / DOES NOT EXIST/
 648 BADSW,  TEXT    /#SWITCH NOT ALLOWED HERE/
 649 BADSW2, TEXT    /#BAD CCL SWITCH/
 650 CONTRA, TEXT    /#CONTRADICTORY SWITCHES/
 651 \fBKA,   0
 652         TAD I (LBEGIN
 653         DCA CLXR
 654 1$:     CDF 0
 655         ISZ CLXR
 656         TAD I CLXR
 657         CDF 10
 658         SNA
 659         JMP NOBKR$
 660         TAD (-"<
 661         SNA
 662         JMP I BKA
 663         TAD ("<-"_
 664         SNA
 665         JMP I BKA
 666         TAD ("_-"=
 667         SZA CLA
 668         JMP 1$
 669         ISZ CLXR        /= MEANS _ IF NOT FOLLOWED BY A DIGIT
 670         CDF 0
 671         TAD I CLXR
 672         CDF 10
 673         JMS I (DECODE
 674         SKP CLA         /NOT A DIGIT
 675         SNL CLA         /MAYBE A DIGIT
 676         JMP I BKA       /= FOLLOWED BY A NON-DIGIT MEANS _
 677         JMP 1$          /IT'S AN =NNNN
 678
 679 NOBKR$: ISZ BKA
 680         JMP I BKA
 681 BADEV,  TEXT    /#BAD DEVICE/
 682         PAGE
 683 \fCDINIT,        0
 684         ISZ PTR         /POINT TO SWITCH TABLE
 685         JMS I (200
 686         13              /RESET ALL HANDLERS
 687         CDF 0
 688         TAD I DEFALT
 689         CDF 10
 690         TAD (-5200
 691         SZA CLA         /IS THIS A REQUEST FOR A
 692                         /"SPECIAL DECODE"?
 693         JMP CDCONT      /NO
 694         TAD ALTLIM
 695         DCA I (OUTLIM   /YES, SET UP THE PROPER LOCATIONS
 696         TAD ALTDF1
 697         DCA LIMDIF      /TO GET 1 OUTPUT AND 5 INPUT FILES
 698         TAD ALTDF2
 699         DCA BEGDIF      /ALL OF WHICH ARE
 700                         /5-WORD <DEVICE,NAME> ENTRIES
 701         DCA I PLKUPS
 702         TAD STARJM
 703         DCA I PSTARS    /AND ALLOW *
 704                         /AS A FILE OR EXTENSION NAME
 705         TAD L7600       /STOPS FETCHES IN SPECIAL MODE
 706         DCA I PSPKG1    /NO HANDLER FETCHES NECESSARY EITHER
 707                         /SINCE NO LOOKUPS
 708 CDCONT, JMS I (BKA      /SCAN AHEAD FOR <
 709         STA             /SKIP RETURN IF NOT FOUND
 710         DCA I (OUTSW
 711         JMS I (ZEROCD
 712         TAD I (LBEGIN
 713         DCA LXR
 714         JMP I CDINIT
 715 /CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
 716 ALTLIM, 1-MOFILE-5
 717 ALTDF1, MOFILE+5-MPARAM+5
 718 ALTDF2, 5
 719 PLKUPS, LKUPSW
 720 PSTARS, STARSW
 721 PSPKG1, SPKLG1
 722
 723 BEGDIF, MIFILE-MOFILE
 724 LIMDIF, MIFILE-MPARAM+2
 725 \f/STARJM,       RELOC STARNM    /DUMP LITERALS AT LAST POSSIBLE MOMENT
 726 /       JMP STARNM
 727 /       RELOC
 728 STARJM, 5200+<STARNM&177>
 729 \fSETDEV,        0               /V1A ARG NOW IN AC
 730         DCA 1$
 731         CLL STA RAL     /-2
 732         JMS I (MOVE
 733         CDF 0
 734 1$:     0               /PTS TO DEVICE NAME
 735         CDF 10
 736         DVNM1
 737         JMS I (SETOUT
 738         JMP I SETDEV
 739
 740 UNKN,   0
 741         TAD SETEXT
 742         SZA
 743         TAD T           /NEG OF SWITCH REQUEST
 744         SZA CLA
 745         JMP CCERA       /CAN'T HAVE 2ND DEFAULT EXTENSION
 746         TAD T
 747         CIA
 748         DCA SETEXT      /SET DEFAULT EXTENSION
 749         TAD DEFALT      /SEE IF IT'S IN COMMAND'S SEARCH LIST
 750         DCA DEF
 751         TAD SETEXT
 752         JMS I (EXTLUK
 753         SNA CLA         /DID WE FIND IT?
 754         JMP CDER4       /NO
 755         ISZ DEF         /YES
 756 /       TAD I (JMSUB    /ALLOW RECURSIVE CALL
 757 /       DCA HOLD
 758         CDF 0
 759         TAD I DEF
 760         CDF 10
 761         JMS I (JMSUB    /CALL ITS SUBR
 762 /       TAD HOLD
 763 /V1A RECURSIVE CALL NO LONGER THREATENS
 764 /       DCA I (JMSUB
 765         JMP I UNKN
 766
 767 SETEXT, 0               /EXT WHICH HAS BEEN SET BY A CCL SWITCH
 768 \fCCERA, JMS I (PRMESG
 769         CONTRA
 770 CDER2,  JMS PRMESG
 771         BADSYN
 772
 773 L7600,
 774 CCERB,
 775 CDER4,  7600            /CLA
 776         JMS I (PRMESG
 777         BADSW
 778 CDER44, CLA
 779         JMS I (PRMESG
 780         BADSW2
 781 CDER7,  JMS I (PRMESG
 782         BADX
 783 \fBADSTR,        TEXT    /#ILLEGAL * OR ?/
 784 SWNF,   TEXT    / OPTION UNKNOWN/
 785 BADOPT, TEXT    /#BAD SWITCH OPTION/
 786         PAGE
 787 \fBADX,  TEXT    /#BAD EXTENSION/
 788
 789 /THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
 790 /PUTTING RESULT IN DEV1,DEV2, NAME1-4.
 791 /IT GIVES A FATAL ERROR MESSAGE IF BAD.
 792 GETSPC, 0
 793         STA
 794         DCA DVFLAG
 795         DCA DEV1
 796 FILLP1, DCA DEV2
 797 FILLP,  JMS I (GNAME
 798         TAD (-":        /AC CONTAINED DELIM
 799         SNA CLA
 800         JMP 3$          /IT'S A DEVICE NAME
 801         DCA NUMC
 802         TAD (-4
 803         JMS I (MOVE
 804         CDF 10
 805         NAME1
 806         CDF 0
 807         FNAME1          /SAVE AWAY FILE NAME
 808         JMP I GETSPC
 809 3$:     CLA IAC         /PARSE FILENAME AFTER DEV:
 810         TAD I (PERDSW
 811         TAD NUMC
 812         SZA CLA
 813         JMP CDERA       /. OR # IN DEVICE NAME
 814         TAD NAME1
 815         DCA DEV1
 816         ISZ DVFLAG
 817         JMP CDERA       /CATCHES A:B:
 818         TAD NAME2
 819         JMP FILLP1
 820
 821 DVFLAG, 0
 822 CDERA,  JMS I (PRMESG
 823         BADEV
 824
 825 NUMC,   0               /USED AS FLAG INDICATING SAW #
 826         JMS I (POUND
 827         JMP I NUMC
 828 \fNMOVE, 0
 829         DCA 2$          /V1A ARG IN AC
 830         TAD I (FLAG
 831         RTL
 832         SMA CLA         /FEATURE ENABLED?
 833         JMP I (CCERB    /NO
 834         TAD I (OUTSW
 835         SZA CLA
 836         JMP I (CCERB    /ON OUTPUT SIDE
 837         TAD I (MOFILE   /V3C
 838         SNA CLA         /DON'T CHANGE OUT DEV IF SPECIFIED
 839         TAD I (FLAG     /LOOK AT 'COPY EXT' BIT
 840         AND (200
 841         SNA CLA
 842         JMP 1$          /IT WASN'T SET
 843         TAD I (MIFILE   /GET FIRST INPUT DEVICE
 844         AND (17         /ISOLATE DEVICE BITS
 845         DCA I (MOFILE   /FORCE THIS TO BE FIRST OUTPUT DEVICE
 846 1$:     TAD I 2$
 847         SNA
 848         JMS I (SETDSK   /CHANGE TO 'IAC' TO ALWAYS USE SYS:
 849         DCA I 2$        /SET DEVICE TO SYS IF NONE
 850         ISZ 2$
 851         TAD I 2$        /WAS THERE A SPECIFICATION THERE?
 852         SZA CLA
 853         JMP I NMOVE     /YES, DO NOTHING
 854         TAD I (FLAG
 855         AND (200        /GET 'COPY EXTENSION' BIT
 856         SMA SZA CLA     /'SMA' IS UNNECESSARY
 857         STA             /COPY 4 WORDS IF BIT 4 WAS ON
 858         TAD (-3         /OTHERWISE ONLY COPY 3 WORDS
 859         JMS I (MOVE
 860         CDF 0
 861         FNAME1
 862         CDF 10
 863 2$:     0
 864         JMP I NMOVE
 865 \fROTL,  0
 866         CLL RTL
 867         RTL
 868         RTL
 869         JMP I ROTL
 870
 871 JMSUB,  0
 872         SNA
 873         JMP I JMSUB
 874         DCA T$
 875         JMS I T$
 876         JMP I JMSUB
 877 T$:     0
 878 \fAMBIG, TAD NAME1
 879         AND (77
 880         SNA CLA
 881         JMP I (ONE
 882         JMS I (PRNAME
 883         JMS I (PRMESG
 884         AMBIGY
 885 AMBIGY, TEXT    / OPTION AMBIGUOUS/
 886         PAGE
 887 \fSETOUT,        0
 888         TAD I (FLAG
 889         RTR
 890         SZL CLA
 891         TAD (5
 892         TAD (7600
 893         DCA OLOC
 894         TAD I OLOC
 895         SZA CLA
 896         JMP I SETOUT    /HE'S SPECIFIED SOMETHING
 897         JMS I (200
 898         12              /INQUIRE
 899 DVNM1,  0
 900 DVNM2,  0
 901         0
 902         JMP I (CCER2    /NO SUCH DEVICE
 903         TAD DVNM2
 904         DCA I OLOC
 905         TAD OLOC
 906         AND (5
 907         SNA CLA         /USING 2ND OUT DEV?
 908         JMP I SETOUT    /NO
 909         ISZ OLOC        /YES
 910         TAD (-4
 911         JMS I (MOVE
 912         CDF 0
 913         FNAME1
 914         CDF 10
 915 OLOC,   7600            /INITIALLY 7600 OR 7605
 916         JMP I SETOUT
 917 \f/      TAD (PTR TO SWITCH TABLE ENTRY (IN FIELD 0)
 918 /       JMS TRANSL
 919 /       IT PARSES SWITCH, SETS BIT
 920 /       PARSES :VALUE, SETS = OPTION
 921 /       LEAVES DELIMETER IN DELIM
 922
 923 TRANSL, 0
 924         DCA SPTR        /POINT INTO A SWITCH TABLE
 925         JMS I (GNAME    /GET A NAME
 926         DCA DEL
 927 /       TAD NAME4
 928 /       SZA CLA
 929 /       HLT             /EXTENSION ON A SWITCH
 930         JMS SRCH
 931         JMP I (NFOU     /SWITCH NOT FOUND
 932         STA
 933         TAD SRPTR
 934         DCA SSPTR       /SAVE PTR INTO LONG NAME
 935         JMS SRCH        /SEARCH SOME MORE
 936         SKP             /SHOULDN'T FIND ANYTHING
 937         JMP I (AMBIG    /AMBIGUOUS SWITCH
 938         CDF 0
 939 L$:     TAD I SSPTR     /SCAN PAST END OF LONG NAME
 940         ISZ SSPTR
 941         AND (77
 942 X240:   SZA CLA
 943         JMP L$
 944         TAD I SSPTR
 945         CDF 10
 946 SL,     AND (377        /ISOLATE CORRESPONDING ONE-CHARACTER SWITCH
 947         SZA
 948         JMS I (SLSHCH   /SET APPROPRIATE BIT
 949         TAD DEL
 950         DCA DELIM
 951         TAD DELIM
 952         TAD (-":
 953         SNA CLA
 954         JMS I (EQLPRM
 955         JMP I TRANSL
 956
 957 ONE,    TAD NAME1
 958         CLL RTR
 959         RTR
 960         RTR
 961         TAD X240
 962         AND (77
 963         TAD X240
 964         JMP SL
 965
 966 SPTR,   0
 967 SSPTR,  0
 968 DEL,    0
 969 \f/RETURN 1 IF NAME NOT FOUND
 970 /RETURN 2 IF NAME FOUND
 971
 972 SRCH,   0
 973 1$:     TAD (NAME1
 974         DCA NPTR
 975         CLL STA RTL     /-3
 976         DCA NCNT
 977         CDF 0
 978         TAD I SPTR
 979         CDF 10
 980         ISZ SPTR
 981         SNA
 982         JMP I SRCH      /NOT FOUND
 983         DCA SRPTR
 984 2$:     TAD I NPTR
 985         SNA
 986         JMP 3$
 987         AND (77
 988         SZA CLA
 989         TAD (77         /MUST MATCH BOTH BYTES
 990         TAD (7700       /NEED ONLY MATCH LEFT BYTE
 991         CDF 0
 992         AND I SRPTR
 993         CDF 10
 994         CIA
 995         TAD I NPTR
 996         SZA CLA
 997         JMP 1$          /THIS SWITCH AIN'T IT
 998         ISZ SRPTR
 999         ISZ NPTR
1000         ISZ NCNT
1001         JMP 2$
1002 3$:     ISZ SRCH
1003         JMP I SRCH
1004
1005 SRPTR,  0               /POINTS INTO LONG NAME TABLE
1006 NCNT,   0
1007 NPTR,   0               /POINTS INTO NAME1-3
1008         PAGE
1009 \f