sw/os8/v3d/sources/extensions/dectapes/dectape2/msbat.pa

   1 /MARK SENSE BATCH AND PIP
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 //
  10 /
  11 /
  12 /
  13 /
  14 /COPYRIGHT (C) 1974, 1975, 1977
  15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
  16 /
  17 /
  18 /
  19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
  20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
  21 /SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
  22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
  23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
  24 /AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
  25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
  26 /
  27 /
  28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
  29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
  30 /EQUIPMRNT COROPATION.
  31 /
  32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
  33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
  34 /
  35 /
  36 /
  37 /
  38 /
  39 /
  40 \f/MARK SENSE BATCH AND PIP              JANUARY 9, 1974
  41 /
  42 /
  43 /
  44 /                       AUTHOR:
  45 /                       MARK B. ROSENTHAL
  46 /                       DIGITAL EQUIPMENT CORPORATION
  47 /
  48 / VERSION 3A    M.H.    28-APR-77
  49 /
  50 /
  51 /
  52 /
  53 /
  54 /
  55 /
  56 /
  57 /
  58 /
  59 /
  60 /
  61 /
  62 /
  63
  64
  65
  66
  67 L7775=CLA CLL CMA RTL
  68 L7776=CLA CLL CMA RAL
  69 L7777=CLA CLL CMA
  70 L0002=CLA CLL CML RTL
  71 L0001=CLA CLL IAC
  72 CONTCH=3        /CONTINUATION CHARACTER
  73 RUBOUT=7        /RUBOUT BITS
  74 JOBBIT=0200     /BIT POSITION OF $JOB IN COLUMN 1
  75 EOFCHR=6004     /END OF FILE CARD CHARACTER IS _
  76 TABCHR=6010     /TAB CHARACTER
  77 FFCHR=3010      /FORM FEED CHARACTER
  78 NOCHR=6400      /# CHARACTER
  79 RCSE=6672       /CARD READER SELECT AND SKIP IF READY
  80 RCSD=6671       /CARD READER SKIP IF CARD DONE
  81 RCRD=6674       /CARD READER CLEAR CARD DONE FLAG
  82 RCSF=6631       /CARD READER SKIP IF DATA READY
  83 RCRB=6634       /CARD READER READ BINARY
  84 KCF=6030        /CLEAR KEYBOARD FLAG
  85 SYSNO=CLA CLL IAC       /OS8 DEVICE NUMBER FOR SYS:
  86 DSKNO=CLA CLL CML RTL   /OS8 DEVICE NUMBER FOR DSK:
  87 FETCH=1
  88 LOOKUP=2
  89 ENTER=3
  90 CLOSE=4
  91 DECODE=5
  92 CHAIN=6
  93 USRIN=10
  94 USROUT=11
  95 F0=0
  96 F1=10
  97 JSBITS=7746             /JOB STATUS WORD
  98
  99
 100
 101 *10
 102 XR1,    0
 103 XR2,    0
 104 XRCDR,  0
 105 XROPT,  0
 106
 107
 108 *20
 109 ERROR=JMS I .;  XERR
 110 CONVRT=JMS I .; XCONVR
 111 OUT=JMS I .;OUTAD,      XOUT
 112 SAVFLD=JMS I .;XSAVDF
 113 USR=JMS I .;    200
 114 KEYWD,  0;0;0;0
 115 TEMP1,  0
 116 TEMP2,  0
 117 TEMP3,  0
 118 TEMP4,  0
 119 TEMP5,  0
 120 OPTCNT, 0       /OUTPUT BUFFER COUNT
 121 OPTSW,  0       /OUTPUT BUFFER THREE WAY SWITCH
 122 KEYADR, 0
 123 KEYVAL, 0
 124 ERRFLG, 0
 125 ERRCNT, 0
 126 CONFLG, 0
 127 LNCNT,  0
 128 USRFLG, 0
 129 OFILE,  ZBLOCK 5        /OUTPUT FILE DEVICE, LENGTH, AND NAME
 130 CDRFLG, -1      /CDRIN TO PASSES LAST CARD IF 0
 131 BCLSW,  0
 132 CDREOF, -1
 133 DEVENT, 0       /ENTRY ADDRESS OF OUTPUT DEVICE HANDLER
 134 IOERR,  0       /ERROR NUMBER
 135 VERNO9, ISZ IOERR
 136 IOER8,  ISZ IOERR
 137 CDRER7, ISZ IOERR
 138 OPTER6, ISZ IOERR
 139 OPTER5, ISZ IOERR
 140 OPTER4, ISZ IOERR
 141 OPTER3, ISZ IOERR
 142 OPTER2, ISZ IOERR
 143 OPTER1, JMP I .+1
 144         IOERR1
 145
 146
 147 \f*200
 148 START,  ISZ USRFLG;SKP  /IS THE USR IN CORE?
 149         JMP CD          /YES
 150         CIF 10;JMS I (7700;USRIN  /LOCK USR IN CORE
 151 CD,     L7777           /SET FLAG FOR USR IN CORE
 152         DCA USRFLG
 153         CIF 10;USR;DECODE;0     /DELETE TENTATIVE FILES
 154         TAD (7577       /COPY OUTPUT FILE #1 (NAME AND DEVICE)
 155         DCA XR1
 156         CDF F1
 157         TAD I (7644     /TEST /V SWITCH
 158         AND (4
 159         SZA CLA
 160         JMP VERNO9      /YES - PRINT VERSION NUMBER
 161         TAD I XR1
 162         SNA             /IF NOT SPECIFIED,
 163         DSKNO           /USE DEVICE DSK:
 164         DCA OFILE
 165         TAD I XR1
 166         SNA             /WAS A NAME GIVEN?
 167         JMP OPTER1      /NO
 168 INIT1,  DCA OFILE+1
 169         TAD I XR1
 170         DCA OFILE+2
 171         TAD I XR1
 172         DCA OFILE+3
 173         TAD I XR1
 174         DCA OFILE+4
 175         TAD (OFILE+1
 176         DCA BLOKNO      /SET FILE NAME ADDRESS
 177         TAD I (7605     /GET SECOND OUTPUT DEVICE SPECIFICATION
 178         DCA I (7600     /MOVE TO FIRST FOR SPOOLING IN BATCH
 179         CDF
 180         TAD BLOKNO      /GET ADDRESS OF FILE NAME
 181         DCA I (CLOSNM   /AND SAVE FOR CALL TO CLOSE
 182         TAD (OPTDEV&7600+1      /SET DEVICE HANDLER SPACE
 183         DCA DEVHDL
 184         TAD OFILE
 185         CIF 10;USR;FETCH        /FETCH DEVICE HANDLER
 186 DEVHDL,         OPTDEV&7600+1   /2 PAGES
 187                 JMP OPTER2      /ERROR - CANNOT FETCH HANDLER
 188         TAD DEVHDL      /MOVE ENTRY ADDRESS
 189         DCA DEVENT      /TO PAGE ZERO
 190         TAD OFILE       /ENTER THE FILE NAME AS TENTATIVE
 191         CIF 10;USR;ENTER
 192 BLOKNO,         OFILE+1         /FILE NAME, STARTING BLOCK RETURNED HERE
 193 FILLEN,         0               /RETURNS FILE LENGTH HERE
 194                 JMP OPTER3      /CANNOT ENTER FILE
 195         CIF 10;USR;USROUT       /DISMISS THE USR
 196         DCA USRFLG      /CLEAR USR IN CORE FLAG
 197         CDF 10
 198         TAD BLOKNO      /SAVE STARTING BLOCK NO. FOR BATCH
 199         DCA I (7620
 200         TAD OFILE       /SAVE DEVICE NO. FOR BATCH
 201         AND (17
 202         DCA I (7617
 203         TAD I (7643     /GET OPTIONS
 204         CDF F0
 205         AND (2100       /      /B OR /F
 206         SNA
 207         DCA I (EOFJMP   /IF NEITHER, THEN WE CHAIN TO BATCH
 208         CLL RTL         /GET /B OUT OF AC
 209         SZA CLA         /IF AC=0 START WITH BASIC KEYWORDS
 210         TAD (FORKEY-BASKEY
 211         TAD (BASKEY-15
 212         DCA KEYADR
 213         JMP I (INIT5
 214
 215
 216 PAGE
 217 \fINIT5, TAD (BPRI2      /TAILOR IT FOR BATCH PROCESSING
 218         DCA I (BPRKEY   /"PRINT #4,"
 219         TAD (BINP2
 220         DCA I (BINKEY   /"INPUT #3,"
 221         TAD (BSTO2
 222         DCA I (BSTKEY   /"CLOSE# 4\STOP"
 223         TAD (BEND2
 224         DCA I (BENKEY   /"CLOSE #4\END"
 225         CDF F1
 226         DCA I (CBAS5    /NO JUMP
 227         DCA I (DATL48   /NO JUMP
 228         TAD (CL2M1A     /".R LOADER_*GENIOX"
 229         DCA I (CL2SX
 230         TAD I (7643     /TEST /I OPTION (INTERACTIVE)
 231         AND (10
 232         SNA CLA
 233         JMP INIT6
 234         TAD BASJMP      /SET UP FOR FILES 0 & 1
 235         DCA I (CBAS5    /SET UP THE JMP
 236         TAD BASJM1      /SET UP JUMP
 237         DCA I (DATL48
 238         TAD (CL2M1      /".R LOADER_*"
 239         DCA I (CL2SX
 240         CDF F0
 241         TAD (BPRI
 242         DCA I (BPRKEY
 243         TAD (BINP
 244         DCA I (BINKEY
 245         TAD (BSTO
 246         DCA I (BSTKEY
 247         TAD (BEND
 248         DCA I (BENKEY
 249 INIT6,  CDF 10
 250         TAD I (7644     /TEST /T OPTION
 251         AND (20
 252         SNA CLA
 253         TAD (BATLPT-BATTTY
 254         TAD (BATTTY
 255         CIF CDF F1
 256         JMS I (MOVODV
 257         TAD I (7645     /TEST /2 OPTION
 258         AND (200
 259         SNA CLA
 260         JMP INIT3
 261         TAD (CF2        /FORTRAN 2
 262         DCA I (FORADR
 263         TAD (CL2
 264         DCA I (LOAADR
 265         TAD (DATX2
 266         JMP INIT4
 267 INIT3,  TAD (CF4        /FORTRAN 4
 268         DCA I (FORADR
 269         TAD (CL4
 270         DCA I (LOAADR
 271         TAD (DATX4      /INITIALIZE $DATA
 272 INIT4,  DCA I (DATFTN
 273         TAD I (DATFTN
 274         DCA I (DATADR
 275         TAD (SAVARA
 276         DCA I (SAVPNT
 277         DCA I (NAMCNT
 278         CDF F0
 279         DCA BCLSW       /NO BCL CARDS YET
 280         L7777
 281         DCA CDREOF      /RESET EOF SWITCH
 282         TAD I (BLOKNO   /SET STARTING BLOCK NUMBER
 283         DCA I (OPTBLK
 284         TAD (OPTBUF-1
 285         DCA XROPT
 286         TAD (-200
 287         DCA OPTCNT
 288         L7775
 289         DCA OPTSW
 290         DCA ERRCNT      /CLEAR COUNT OF CARDS IN ERROR
 291         JMP I (READY
 292
 293 BASJMP, JMP CBAS7&177+INIT5
 294 BASJM1, JMP DATL49&177+INIT5
 295
 296
 297 PAGE
 298 \fREADY, JMS I (CDRIN    /READ A CARD
 299         JMP I (EOF      /END OF FILE SENSED
 300         TAD I XRCDR     /GET COLUMN 1
 301         DCA KEYWD       /SAVE AS KEYWORD BITS
 302         TAD XRCDR
 303         DCA XR2
 304
 305
 306 /TRANSLATE LINE NUMBER
 307         TAD (-5
 308         DCA TEMP1
 309         DCA LNCNT       /CLEAR COUNT
 310         DCA KEYWD+3     /CLEAR COLUMN 2-6 KEYWORD BITS
 311 LNLP,   TAD I XRCDR     /GET LINE NO. COLUMN
 312         DCA TEMP2       /SAVE CHAR
 313         TAD (6000
 314         AND TEMP2       /GET KEYWORD BITS
 315         CLL RAL
 316         RTL
 317         TAD KEYWD+3
 318         CLL RTL
 319         DCA KEYWD+3
 320         TAD (1777
 321         AND TEMP2       /GET CHAR
 322         SNA
 323         JMP LNLPEN      /IGNORE BLANKS
 324         CONVRT          /TRANSLATE
 325         JMP LNLPEN      /IGNORE RUBOUTS
 326         TAD (-"9
 327         SMA SZA
 328         JMP LNERR       /NOT A NUMBER
 329         TAD ("9-"0
 330         SPA
 331         JMP LNERR       /NOT A NUMBER
 332         TAD ("0
 333 LNLP1,  DCA I XR2       /INSERT CHARACTER IN OUTPUT BUFFER
 334         ISZ LNCNT       /COUNT THIS CHARACTER
 335 LNLPEN, ISZ TEMP1       /GOT ALL LINE NUMBER COLUMNS?
 336         JMP LNLP        /NO - LOOP.
 337         JMP I (KEYTRA   /GO TRANSLATE KEYWORD
 338
 339
 340 LNERR,  ERROR
 341         JMP LNLP1
 342
 343
 344 MAKNA2, 0               /FIELD 1 OUTPUT ROUTINE FOR MAKNAM
 345         CIF CDF F1
 346         JMS I (MAKNA3
 347         JMP I MAKNA2
 348
 349 OOUT2,  0
 350         OUT
 351         CIF CDF F1
 352         JMP I OOUT2
 353
 354 GETCD1, 0
 355         TAD I XRCDR
 356         CIF CDF F1
 357         JMP I GETCD1
 358
 359 /FOR RETURN TO CALLING FIELD
 360 /PRESERVES AC AND LINK WHILE PUTTING
 361 /CIF CDF TO DATA FIELD AT ADDRESS
 362 /SPECIFIED AS FIRST WORD AFTER CALL
 363 XSAVDF, 0
 364         DCA XSAVD1
 365         RDF
 366         TAD (CIF CDF
 367         DCA XSAVD2
 368         CDF
 369         TAD I XSAVDF
 370         ISZ XSAVDF
 371         DCA XSAVD3
 372         TAD XSAVD2
 373         DCA I XSAVD3
 374         TAD XSAVD1
 375         JMP I XSAVDF
 376 XSAVD1, 0
 377 XSAVD2, 0
 378 XSAVD3, 0
 379
 380 PAGE
 381 \fXERR,  0
 382 K7600,  7600
 383         TAD ("?         /OUTPUT A "?"
 384         ISZ ERRFLG      /FLAG ERROR ON THIS CARD
 385         JMP I XERR
 386
 387 TIME=12
 388
 389 CDRIN,  0               /READ A CARD INTO THE BUFFER
 390         SAVFLD;CDRCIF   /SAVE DATA FIELD FOR RETURN
 391         DCA ERRFLG      /CLEAR ERROR FLAG FOR THIS CARD
 392         ISZ CDREOF      /HAVE WE SEEN EOF?
 393         JMP CDRCIF      /YES - STILL EOF
 394         ISZ CDRFLG      /SHOULD WE PASS LAST CARD?
 395         JMP REINIT      /YES
 396 CDRIN6, JMS CDRIN5      /RESET TIME OUT COUNTERS
 397         TAD (-50        /YES - READ IT INTO THE CDR BUFFER
 398         DCA TEMP1       /40 COLUMNS (DECIMAL)
 399         TAD (CDRBUF-1
 400         DCA XRCDR
 401 CDRIN3, RCSE            /CARD READY?
 402         JMP CDRIN4      /TEST TIME OUT
 403         JMS CDRIN5      /RESET TIME OUT COUNT
 404 CDRIN1, JMS KBRD        /TEST KEYBOARD (AFTER TIME OUT LOOP)
 405         RCSD            /CARD DONE?
 406         SKP
 407         JMP CDRIN7      /YES - TOO FEW COLUMNS
 408         RCSF            /CHARACTER READY?
 409         JMP CDRIN1      /NO - TRY CARD DONE
 410         JMS CDRIN5      /RESET TIME OUT COUNT
 411         RCRB            /YES - READ BINARY
 412 CDRIN2, DCA I XRCDR     /AND STORE IT
 413         ISZ TEMP1       /DON'T READ MORE THAN BUFFER CAN HOLD
 414         JMP CDRIN1      /TRY CARD DONE AGAIN
 415         RCSD            /WAIT FOR END OF CARD - OR ELSE!
 416         JMP .-1
 417         RCRD    /IF THIS ISN'T CLEARED,
 418                 /FORTRAN IV BECOMES VERY UNHAPPY!
 419         JMP CDRIN8
 420 CDRIN7, RCRD    /FORTRAN IV AGAIN
 421         ISZ TEMP1       /ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL)
 422         JMP CDRER7      /ERROR!
 423         DCA I XRCDR
 424 CDRIN8, TAD (CDRBUF-1   /INIT BUFFER POINTERS AGAIN
 425         DCA XRCDR
 426         TAD (-50
 427         DCA TEMP1
 428         TAD (-EOFCHR    /TEST FOR FIRST COLUMN=EOFCHR AND REST =0
 429 EOFLP,  TAD I XRCDR     /GET NEXT COLUMN
 430         SZA CLA
 431         JMP REINIT      /NON-ZERO - NOT EOF
 432         ISZ TEMP1
 433         JMP EOFLP       /LOOP
 434         JMP CDRCIF      /END OF FILE CARD
 435 REINIT, TAD (CDRBUF-1
 436         DCA XRCDR
 437         ISZ CDRIN       /SKIP RETURN IF NOT EOF
 438         L7777           /RESET EOF SWITCH
 439 CDRCIF, 0
 440         DCA CDREOF
 441         L7777           /SET TO READ A NEW CARD NEXT TIME
 442         DCA CDRFLG
 443         JMP I CDRIN
 444
 445 CDRIN4, JMS KBRD        /TEST TIME OUT
 446         JMP CDRIN3      /TRY SELECTING CARD AGAIN
 447
 448 CDRIN5, 0       /RESET TIME OUT
 449         DCA TIMOUT
 450         TAD (-TIME
 451         DCA TIMOU2
 452         JMP I CDRIN5
 453
 454 KBRD,   0
 455         KSF             /KEYBOARD?
 456         JMP KBRDTM      /NO - TIME
 457         KRS             /IS IT ^C?
 458         AND (177
 459         TAD (-3
 460         SNA CLA
 461         JMP I K7600     /YES - RETURN TO OS-8
 462 KBRDTM, ISZ TIMOUT      /TIMED OUT YET?
 463         JMP I KBRD      /NO
 464         ISZ TIMOU2
 465         JMP I KBRD      /LIKEWISE
 466         KCF             /IGNORE ANYTHING TYPED BEFORE THIS
 467         TAD (207        /NOTHING - WAKE HIM UP
 468         JMS I (TOUT
 469         TAD (MSGJAM     /IT COULD BE JAMMED
 470         DCA TEMP1
 471         JMS I (TTYOUT
 472 KBRD1,  KSF             /WAIT FOR A CHARACTER OR READER
 473         JMP KBRD3
 474 KBRD2,  KRS             /GET THE CHAR
 475         AND (177        /WITHOUT PARITY
 476         TAD (-3         /IS IT ^C?
 477         SNA
 478         JMP I K7600     /YES - TO MONITOR
 479         KCF     /IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT.  ELSE CLEAR IT
 480         TAD (3-32       /IS IT ^Z?
 481         SNA CLA
 482         JMP CDRCIF      /YES - EOF
 483         JMP CDRIN6      /GO BACK AND TIME OUT AGAIN
 484 KBRD3,  RCSE            /SELECT A CARD?
 485         JMP KBRD1       /NO - TRY KEYBOARD
 486         TAD (-50        /RESET COUNT
 487         DCA TEMP1
 488         TAD (CDRBUF-1   /AND POINTER
 489         DCA XRCDR
 490         JMP CDRIN3+2    /YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT
 491
 492 CDRJA1, KSF
 493         JMP .-1
 494         JMP KBRD2
 495
 496 TIMOUT, 0
 497 TIMOU2, 0
 498
 499 PAGE
 500 \fKEYTRA,        TAD I XRCDR     /GET KEYWORD COLUMN
 501         DCA KEYWD+1
 502         TAD I XRCDR     /DITTO
 503         DCA KEYWD+2
 504 /CONVERT KEYWORD BITS TO NUMBER
 505         TAD (KEYWD-1    /POINT INDEX REGISTER TO KEYWORD BUFFER
 506         DCA XR1
 507         TAD (-4         /SET COUNT OF WORDS
 508         DCA TEMP1
 509         DCA KEYVAL      /ZERO KEYWORD VALUE
 510 WRDLP,  TAD (-14        /SET BIT COUNT
 511         DCA TEMP2
 512         TAD I XR1       /GET WORD
 513 BITLP,  ISZ KEYVAL      /BUMP BIT VALUE
 514         CLL RAL         /SHIFT INTO LINK
 515         SZL             /IS THIS ONE ON?
 516         JMP KEYFND      /YES - KEYWORD FOUND
 517         ISZ TEMP2       /COUNT BITS
 518         JMP BITLP
 519         ISZ TEMP1       /COUNT WORDS
 520         JMP WRDLP
 521         JMS I (LNOUT    /SEND THE LINE NO.
 522         JMP I (TEXTRA   /ALL BITS OFF - NO KEYWORD
 523
 524
 525 KEYBAD, ERROR
 526         OUT
 527         JMP KEYBLK
 528
 529
 530         TAD I XR1       /GET NEXT WORD
 531 KEYFND, SZA CLA         /TEST THIS WORD
 532         JMP KEYBAD      /ERROR - MORE THAN ONE KEYWORD MARKED
 533         ISZ TEMP1       /COUNT WORDS
 534         JMP KEYFND-1    /AND LOOP
 535
 536 /OUTPUT THE KEYWORD
 537         TAD KEYVAL      /IS IT A BATCH CONTROL LANGUAGE COMMAND?
 538         TAD (-14
 539         SMA SZA CLA
 540         JMP KEYOUT
 541         L7777           /FOUND A BCL CARD
 542         DCA BCLSW       /GENERATE "$END" BEFORE CLOSING FILE
 543         CIF CDF F1
 544         JMP I (BCLTRA   /YES - HANDLE THAT SPECIALLY
 545
 546
 547 KEYOUT, JMS I (LNOUT    /SEND LINE NUMBER
 548         TAD KEYADR
 549         TAD KEYVAL
 550         DCA TEMP1
 551         TAD I TEMP1     /GET ADDRESS OF KEYWORD
 552         SNA
 553         JMP KEYBAD      /IF ZERO - UNUSED KEYWORD
 554         DCA TEMP1       /ELSE SAVE IT
 555         TAD TEMP1       /IS THIS "INPUT" OR "PRINT
 556         TAD (-BPRI2     /BEING FUDGED UNDER BASIC?
 557         SNA
 558         JMP NOSGN       /PRINT - CHECK FOR NUMBER SIGN
 559         TAD (BPRI2-BINP2
 560         SZA CLA
 561         JMP KEYOU5      /NONE - ALL'S WELL
 562 NOSGN,  TAD (-40        /SET COUNT
 563         DCA TEMP3
 564 NOSGN1, TAD I XRCDR     /IS NEXT CHAR BLANK?
 565         SZA
 566         JMP NOSGN2      /NO - IS IT #
 567         ISZ TEMP3
 568         JMP NOSGN1
 569         JMP NOSGN3      /REST IS BLANK
 570 NOSGN2, TAD (-NOCHR     /IS IT "#"?
 571         SZA CLA
 572         JMP NOSGN3      /NO
 573         TAD TEMP1       /YES - USE "INPUT" OR "PRINT"
 574         TAD (-BPRI2
 575         SZA CLA
 576         TAD (BINP-BPRI
 577         TAD (BPRI
 578         DCA TEMP1
 579 NOSGN3, TAD (CDRBUF+7
 580         DCA XRCDR
 581 KEYOU5, JMS I (UNPACK   /AND OUTPUT KEYWORD
 582 KEYBLK, TAD ("          /INSERT BLANK AFTER KEYWORD
 583         OUT
 584         JMP I (TEXTRA
 585
 586
 587 PAGE
 588 \fUNPACK,        0       /OUTPUT PACKED 6-BIT ASCII TEXT
 589         TAD I TEMP1     /IS FIRST CHAR = 00?
 590         AND (7700
 591         SZA CLA
 592         JMP KEYOU1      /NO - NORMAL 6-BIT TRANSLATE
 593         TAD (211        /YES - THIS IS TAB RATHER THAN END
 594         OUT             /OUTPUT IT
 595         JMP KEYOU3      /AND GET SECOND CHARACTER
 596 KEYOU1, TAD I TEMP1     /GET FIRST CHARACTER
 597         CLL RTR
 598         RTR
 599         RTR
 600         JMS KEYOU2      /AND OUTPUT IT
 601 KEYOU3, TAD I TEMP1     /GET SECOND CHARACTER
 602         JMS KEYOU2      /AND OUTPUT IT
 603         ISZ TEMP1       /POINT TO NEXT TWO CHARACTERS
 604         JMP KEYOU1      /ETC.
 605
 606 KEYOU2, 0
 607         AND (77         /MASK FOR THE LOW ORDER BITS
 608         SNA
 609         JMP I UNPACK    /CHARACTER IS 00 - END OF KEYWORD
 610         TAD (-37        /<CR>?
 611         SNA
 612         TAD (215-337    /THIS WILL BE 215 WHEN WE'RE DONE
 613         SPA
 614         TAD (100
 615         TAD (237
 616         OUT             /OUTPUT THE CHARACTER
 617         JMP I KEYOU2
 618
 619 TTYOUT, 0       /USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY
 620         TAD (TOUT       /SWITCH OUTPUT ROUTINES
 621         DCA OUTAD
 622         JMS UNPACK
 623         TAD (XOUT       /RESET OUTPUT ROUTINES
 624         DCA OUTAD
 625         JMP I TTYOUT    /RETURN
 626
 627
 628 LNOUT,  0               /OUTPUT THE LINE NUMBER
 629         SAVFLD;LNCIF
 630         TAD LNCNT       /GET NUMBER OF CHARS
 631         CMA
 632         DCA TEMP1
 633         TAD (CDRBUF     /START WITH COLUMN 2
 634         DCA XR2
 635 LNOUT1, ISZ TEMP1;SKP   /MORE DIGITS?
 636         JMP LNOUT2      /NO
 637         TAD I XR2;OUT
 638         JMP LNOUT1
 639 LNOUT2, TAD LNCNT       /ANY DIGITS?
 640         SNA CLA
 641         JMP LNCIF
 642         TAD (" ;OUT     /YES - SUFFIX A BLANK
 643 LNCIF,  0
 644         JMP I LNOUT
 645
 646
 647 PAGE
 648 \f/TRANSLATE TEXT
 649 TEXTRA, DCA CONFLG      /CLEAR CONTINUATION FLAG
 650         DCA TEMP1       /CLEAR COUNT OF BLANK CHARACTERS
 651         TAD (-40        /32 COLUMNS OF TEXT (DECIMAL)
 652         DCA TEMP3
 653 TEXLP1, TAD I XRCDR
 654         SNA             /BLANK?
 655         JMP TEXBLK      /YES - COUNT A BLANK
 656         TAD (-CONTCH    /CONTINUATION CHARACTER?
 657         SNA
 658         JMP TEXCON      /YES - ENOUGH OF THIS CARD
 659         TAD (CONTCH
 660         CONVRT          /TRANSLATE THE CHARACTER
 661         JMP TEXLP2      /RUBOUT? - GET THE NEXT CHARACTER
 662         DCA TEMP2       /SAVE THE CHARACTER
 663         JMS TEXBOU      /OUTPUT THE COUNTED BLANKS
 664         TAD TEMP2
 665         OUT             /OUTPUT THE CHARACTER
 666 TEXLP2, ISZ TEMP3       /COUNT COLUMNS
 667         JMP TEXLP1
 668         TAD (215        /OUTPUT A <CR>
 669         OUT
 670         JMP TEXFIN
 671
 672
 673 TEXCON, JMS TEXBOU
 674         CLA CMA
 675         DCA CONFLG      /SET THE CONTINUATION FLAG
 676         JMP TEXFIN
 677
 678
 679 TEXBLK, ISZ TEMP1       /COUNT THE BLANKS
 680         JMP TEXLP2      /GET THE NEXT CHARACTER
 681
 682
 683 TEXBOU, 0               /OUTPUT BLANKS
 684         TAD TEMP1
 685         CMA
 686         DCA TEMP1
 687 TEXBO1, ISZ TEMP1       /MORE BLANKS
 688         SKP
 689         JMP I TEXBOU    /NO - RETURN
 690         TAD ("          /YES - OUTPUT A BLANK
 691         OUT
 692         JMP TEXBO1
 693
 694
 695 TEXFIN, TAD ERRFLG      /DID THIS CARD HAVE AN ERROR?
 696         SZA CLA
 697         ISZ ERRCNT      /YES - COUNT IT
 698         JMP I (READY    /PROCESS NEXT CARD
 699
 700
 701 \f/CARD CODE TO ASCII CONVERSION ROUTINE
 702 XCONVR, 0               /INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII
 703         SAVFLD;XCOCIF   /SAVE DATA FIELD FOR RETURN
 704         DCA CONVR1      /SAVE 12 BIT CARD CODE
 705         TAD (RUBOUT
 706         AND CONVR1
 707         TAD (-RUBOUT
 708         SNA CLA         /WAS CHARACTER RUBBED OUT?
 709         JMP XCOCIF      /YES - RETURN 0 IN AC
 710         ISZ XCONVR      /NOT RUBBED OUT - SKIP RETURN
 711         TAD CONVR1
 712         RTL
 713         RTL
 714         AND (7          /GET ZONE BITS
 715         CLL RAL
 716         DCA CONVR2      /2*ZONE BITS
 717         TAD CONVR2
 718         RTL
 719         TAD CONVR2      /10*ZONE BITS
 720         DCA CONVR2
 721         TAD CONVR1
 722         RTL
 723         RAL
 724         AND (7770       /1-9 "PUNCHES"
 725         SNA
 726         JMP CONVR3      /IF ALL OFF DON'T INCREMENT COUNT
 727         CLL RAL         /SHIFT NEXT BIT INTO LINK
 728         ISZ CONVR2      /COUNT THE BIT
 729         SNL
 730         JMP .-3         /LOOP IF OFF
 731         SZA CLA
 732         JMP CONILL      /IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER
 733 CONVR3, TAD CONVR2      /GET DISPLACEMENT OF CHAR IN TABLE
 734         CLL RAR         /GET WORD DISPLACEMENT IN AC
 735         TAD (TRTAB      /ADDRESS OF WORD
 736         DCA CONVR2
 737         TAD I CONVR2    /GET WORD
 738         SZL
 739         JMP .+4         /IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD
 740         RTR
 741         RTR
 742         RTR
 743         AND (77         /MASK FOR LOW PART OF WORD
 744         SNA
 745         JMP CONVR4      /ZERO IN TABLE IS ILLEGAL CODE (MAYBE)
 746         TAD (240
 747         JMP XCOCIF      /RETURN WITH 8 BIT ASCII IN AC
 748 CONVR4, TAD CONVR1      /GET 12-BIT CARD CODE
 749         TAD (-TABCHR    /IS IT A TAB CHAR?
 750         SNA
 751         JMP CONVR5      /YUP!
 752         TAD (TABCHR-FFCHR       /HOW ABOUT A FORM FEED?
 753         SZA CLA
 754         JMP CONILL      /NOPE - IT'S REALLY BAD
 755         TAD (214-211    /IT'S FORM FEED
 756 CONVR5, TAD (211        /IT'S TAB
 757         JMP XCOCIF
 758 CONILL, ERROR           /SET ERROR FLAG; RETURN "?" IN AC
 759 XCOCIF, 0
 760         JMP I XCONVR
 761
 762 CONVR1, 0
 763 CONVR2, 0
 764
 765
 766 PAGE
 767 \f/OUTPUT A CHARACTER.  RETURNS .+1 IF CHARACTER IS
 768 /JUST STORED IN BUFFER.  RETURNS .+2 IF NO MORE SPACE IN
 769 /EMPTY.  RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE
 770 /MORE BLOCKS IN THE EMPTY.
 771 XOUTP,  0               /OUTPUT ROUTINE
 772         ISZ OPTSW       /THREE WAY SWITCH
 773         JMP XOUT1
 774         DCA XOUT2       /SAVE CHAR IN TEMP
 775         L7777
 776         TAD XROPT       /BACK UP 2 WORDS
 777         DCA XOUT3
 778         TAD XOUT2       /GET FIRST HALF OF CHARACTER
 779         RTL
 780         RTL
 781         AND K7400
 782         TAD I XOUT3     /ADD IN FIRST CHARACTER
 783         DCA I XOUT3
 784         ISZ XOUT3
 785         TAD XOUT2       /GET SECOND HALF OF CHARACTER
 786         RTR
 787         RTR
 788         RAR
 789         AND K7400
 790         TAD I XOUT3     /ADD IN SECOND CHARACTER
 791         DCA I XOUT3
 792         ISZ OPTCNT      /IS BUFFER FULL?
 793         JMP XOUT6       /NO - RETURN NORMALLY
 794         JMS I DEVENT    /CALL DEVICE HANDLER
 795                 4200    /TWO PAGES OF OUTPUT FROM FIELD 0
 796                 OPTBUF  /BUFFER ADDRESS
 797 OPTBLK,         0       /BLOCK NUMBER
 798                 JMP OPTER4      /ERROR DOING OUTPUT
 799         ISZ OPTBLK      /INCREMENT BLOCK NUMBER
 800         TAD (OPTBUF-1   /RESET BUFFER POINTER
 801         DCA XROPT
 802         TAD (-200       /AND BUFFER LENGTH /2
 803         DCA OPTCNT
 804         ISZ XOUTP       /SKIP RETURN IF BLOCK WRITTEN
 805         ISZ I (FILLEN   /MORE BLOCKS IN EMPTY?
 806         ISZ XOUTP       /YES - SKIP AGAIN
 807 XOUT6,  L7775           /RESET 3-WAY SWITCH
 808         DCA OPTSW
 809         JMP I XOUTP     /RETURN
 810
 811 XOUT1,  DCA I XROPT     /SAVE CHARACTER IN BUFFER
 812         JMP I XOUTP
 813
 814 XOUT2,  0
 815 XOUT3,  0
 816
 817
 818 XOUT,   0
 819         DCA CLOSLN      /SAVE CHAR IN A CONVENIENT TEMP
 820         TAD CLOSLN
 821         JMS XOUTP       /OUTPUT THE CHARACTER
 822         SKP
 823         JMP OPTER5      /FILLED UP AVAILABLE SPACE BEFORE ^Z
 824         TAD CLOSLN      /WAS IT <CR>?
 825         TAD (-215
 826         SZA CLA
 827         JMP I XOUT      /RETURN
 828         TAD (212
 829         JMP XOUT+1
 830
 831
 832 EOF,    DCA KEYVAL      /FINISH UP ANY BCL CARD IN PROGRESS
 833         DCA CONFLG      /ZERO THESE TO GET US AROUND
 834         DCA LNCNT       /THE TESTS IN BCLHUH
 835         CIF CDF F1
 836         JMP I (BCLTRA
 837 EOF2,   ISZ BCLSW       /WERE THERE ANY BCL CARDS?
 838         JMP EOF1        /NO
 839         TAD (MEND       /YES - SEND "$END"
 840         DCA TEMP1
 841         JMS I (UNPACK
 842 EOF1,   TAD (32         /^Z
 843         JMS XOUTP       /OUTPUT CHAR
 844         JMP .-1         /BLOCK NOT YET FULL
 845 K7400,  7400            /BLOCK WRITTEN
 846         TAD I (BLOKNO   /BLOCK WRITTEN
 847         CIA
 848         TAD OPTBLK      /GET LENGTH OF FILE WRITTEN
 849         DCA CLOSLN      /SET LENGTH FOR CLOSE
 850         ISZ USRFLG;SKP  /IS USR IN CORE?
 851         JMP EOF3        /YES
 852         CIF 10;JMS I (7700;USRIN        /BRING IN THE USR
 853 EOF3,   L7777           /SET USR IN CORE FLAG
 854         DCA USRFLG
 855         TAD OFILE       /GET DEVICE NUMBER
 856         CIF 10;USR;CLOSE
 857 CLOSNM,         0       /POINTER TO NAME
 858 CLOSLN,         0       /LENGTH OF FILE
 859                 JMP OPTER6
 860         TAD CLOSLN
 861         CIA
 862         RTL
 863         RTL
 864         AND (7760       /GET MINUS LENGTH IN BITS 0-7
 865         CDF 10
 866         TAD I (7617
 867         DCA I (7617     /SET LENGTH AND DEVICE NO. FOR BATCH
 868         CDF
 869         JMP I (ERRDEC   /CONVERT NUMBER OF ERRORS TO DECIMAL
 870
 871
 872 PAGE
 873 \f/CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE
 874 ERRDEC, TAD (DECN-1     /START POWERS OF 10 AT 1000
 875         DCA XR1
 876         TAD (-4
 877         DCA TEMP1       /FOUR POWERS OF 10
 878         DCA TEMP5       /CLEAR LEADING ZEROES FLAG
 879         TAD ERRCNT      /SET VALUE
 880         DCA TEMP4
 881         TAD (TOUT       /FUDGE OUTPUT CALL
 882         DCA OUTAD
 883         JMS CONDEC      /CONVERT TO DECIMAL
 884         TAD (XOUT       /RESTORE OUTPUT CALL
 885         DCA OUTAD
 886         TAD (NOMES      /SET UP TO PRINT "NO"
 887         DCA TEMP1
 888         TAD TEMP5       /DID WE PRINT A NUMBER?
 889         SNA CLA
 890         JMS I (TTYOUT   /NO - PRINT "NO"
 891         TAD (CDMES      /PRINT "CARDS IN ERROR"
 892         DCA TEMP1
 893         JMS I (TTYOUT
 894 EOFJMP, JMP I (CD       /DONE WITH THIS ONE - CALL COMMAND DECODER
 895         SYSNO           /LOAD SYS: NUMBER FOR LOOKUP
 896         CIF 10;USR;LOOKUP
 897 BATBLK,         BATNAM
 898                 0
 899                 JMP IOER8
 900         TAD BATBLK
 901         DCA CHNBLK
 902         L0001
 903         DCA I (JSBITS   /KEEP USR ACROSS CHAIN
 904         CIF 10;USR;CHAIN        /NOW CHAIN TO BATCH
 905 CHNBLK,         0
 906
 907
 908 CONDEC, 0               /CONVERT A NUMBER TO DECIMAL
 909         SAVFLD;CONCIF   /SAVE DATA FIELD FOR RETURN
 910 DIGLP,  TAD I XR1       /GET THIS POWER OF 10
 911         DCA TEMP2       /AND SAVE IT
 912         DCA TEMP3       /CLEAR THIS DIGIT
 913 DIGLP1, TAD TEMP4       /GET NUMBER TO BE CONVERTED
 914         TAD TEMP2       /DIVIDE BY SUBTRACTING
 915         SPA
 916         JMP DIGLP2      /WENT NEGATIVE - DONE
 917         ISZ TEMP3       /BUMP COUNT
 918         DCA TEMP4       /SAVE REDUCED VALUE
 919         JMP DIGLP1
 920 DIGLP2, CLA
 921         TAD TEMP3       /GET VALUE OF THIS DIGIT
 922         SZA
 923         JMP DIGOUT      /NOT A ZERO - PRINT IT
 924         TAD TEMP5       /IF ZERO - IS IT LEADING?
 925         SNA CLA
 926         JMP DIGLPE      /YES - DON'T PRINT IT
 927 DIGOUT, ISZ TEMP5       /IF PRINTING, THEN ZEROES ARE NOT LEADING
 928         TAD (260        /CONVERT TO ASCII
 929         OUT
 930 DIGLPE, ISZ TEMP1       /LAST DIGIT?
 931         JMP DIGLP       /NO - LOOP
 932 CONCIF, 0
 933         JMP I CONDEC    /RETURN
 934
 935
 936 TOUT,   0               /SEND A CHARACTER TO THE TTY
 937         TLS
 938         TSF
 939         JMP .-1
 940         TAD (-215       /WAS THE CHARACTER <CR>?
 941         SZA CLA
 942         JMP I TOUT      /NO - RETURN
 943         TAD (212        /YES - TYPE A LINE FEED
 944         JMP TOUT+1
 945
 946
 947 IOERR1, CDF F0
 948         CLA             /TYPE ERROR MESSAGE
 949         TAD IOERR       /GET NUMBER
 950         CLL RAL
 951         TAD (IOETAB-1
 952         DCA XR1
 953         TAD I XR1       /GET ADDRESS OF MESSAGE
 954         DCA TEMP1
 955         DCA IOERR       /CLEAR ERROR NUMBER
 956         JMS I (TTYOUT   /PRINT IT
 957         TAD I XR1       /GO TO RESTART ADDRESS
 958         DCA TEMP1
 959         JMP I TEMP1
 960
 961
 962 PAGE
 963 \fOPTDEV,        ZBLOCK 400      /TWO PAGES FOR DEVICE HANDLER
 964 OPTBUF, ZBLOCK 400      /TWO PAGES FOR OUTPUT BUFFER
 965 CDRBUF, DECIMAL;ZBLOCK 40;OCTAL
 966 BATNAM, TEXT "BATCH@SV";*.-1
 967 MEND,   TEXT "_$END_"
 968 NOMES,  TEXT "NO"
 969 CDMES,  TEXT " CARDS IN ERROR_"
 970 MSGJAM, TEXT "LOAD MORE CARDS OR TYPE ^Z_"
 971 IOEM1,  TEXT "NO OUTPUT FILE SPECIFIED_"
 972 IOEM2,  TEXT "CAN'T FETCH DEVICE HANDLER_"
 973 IOEM3,  TEXT "CAN'T ENTER FILE_"
 974 IOEM4,  TEXT "OUTPUT ERROR_"
 975 IOEM5,  TEXT "FILE TOO BIG_"
 976 IOEM6,  TEXT "CAN'T CLOSE FILE_"
 977 IOEM7,  TEXT "CARD IN READER BACKWARDS.  TYPE SPACE TO CONTINUE._"
 978 IOEM8,  TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/
 979 VERM9,  TEXT "MSBAT - VERSION 3A_@@@@@@"
 980
 981 IOETAB, IOEM1;START
 982         IOEM2;START
 983         IOEM3;START
 984         IOEM4;START
 985         IOEM5;START
 986         IOEM6;START
 987         IOEM7;CDRJA1
 988         IOEM8;7600
 989         VERM9;START
 990
 991         DECIMAL
 992 DECN,   -1000
 993         -100
 994         -10
 995         -1
 996         OCTAL
 997
 998 /CHARACTER CODE TRANSLATION TABLE
 999 TRTAB,
1000 /0 IN ROWS 12-0
1001         0021 /?1
1002         2223 /23
1003         2425 /45
1004         2627 /67
1005         3031 /89
1006 /1
1007         2043 /0C
1008         4651 /FI
1009         5457 /LO
1010         6265 /RU
1011         7004 /X$
1012 /2
1013         1442 /,B
1014         4550 /EH
1015         5356 /KN
1016         6164 /QT
1017         6772 /WZ
1018 /3
1019         3632    />:
1020         0106    /!&
1021         7540    /]@
1022         0000    /<FORM FEED>  ?
1023         0000    /??
1024 /4
1025         1641 /.A
1026         4447 /DG
1027         5255 /JM
1028         6063 /PS
1029         6671 /VY
1030 /5
1031         3400 /<?
1032         0000 /??
1033         0000 /??
1034         0000 /??
1035         0000 /??
1036 /6
1037         3303    /;#
1038         0705    /'%
1039         7337    /[?     THE REAL ?
1040         0077    /<TAB>  _
1041         0000    /??
1042 /7
1043         7435    /\=
1044         1315    /+-
1045         1217    /*/
1046         7610    /^(
1047         1102    /)"
1048
1049
1050 \f/BASIC KEYWORDS
1051 BDAT,   TEXT "DATA"
1052 BCAL,   TEXT "CALL"
1053 BCLO,   TEXT "CLOSE"
1054 BDEF,   TEXT "DEFINE"
1055 BCHN,   TEXT "CHAIN"
1056 BDIM,   TEXT "DIMENSION"
1057 BCHG,   TEXT "CHANGE"
1058 BEND,   TEXT "END"
1059 BEND2,  TEXT "CLOSE #4\END"
1060 BFIL,   TEXT "FILE"
1061 BGOS,   TEXT "GOSUB"
1062 BIF,    TEXT "IF"
1063 BINP,   TEXT "INPUT"
1064 BINP2,  TEXT "INPUT #3:"
1065 BLIS,   TEXT "LIST"
1066 BNEX,   TEXT "NEXT"
1067 BOLD,   TEXT "OLD"
1068 BPRI,   TEXT "PRINT"
1069 BPRI2,  TEXT "PRINT #4:"
1070 BREA,   TEXT "READ"
1071 BRES,   TEXT "RESTORE"
1072 BRUN,   TEXT "RUN"
1073 BFOR,   TEXT "FOR"
1074 BGOT,   TEXT "GOTO"
1075 BIFE,   TEXT "IF END"
1076 BLET,   TEXT "LET"
1077 BLIN,   TEXT "LINPUT"
1078 BNEW,   TEXT "NEW"
1079 BON,    TEXT "ON"
1080 BRND,   TEXT "RANDOM"
1081 BOV,    TEXT "OVERLAY"
1082 BREP,   TEXT "REPLACE"
1083 BUNS,   TEXT "UNSAVE"
1084 BREM,   TEXT "REMARK"
1085 BRET,   TEXT "RETURN"
1086 BSAV,   TEXT "SAVE"
1087 BSTO,   TEXT "STOP"
1088 BSTO2,  TEXT "CLOSE #4\STOP"
1089
1090 /FORTRAN KEYWORDS
1091 FCMN,   TEXT "@COMMON"
1092 FASN,   TEXT "@ASSIGN"
1093 FCPX,   TEXT "@COMPLEX"
1094 FBKS,   TEXT "@BACKSPACE"
1095 FCNT,   TEXT "@CONTINUE"
1096 FBKD,   TEXT "@BLOCK DATA"
1097 FDTA,   TEXT "@DATA"
1098 FCAL,   TEXT "@CALL"
1099 FDEF,   TEXT "@DEFINE FILE"
1100 FDO,    TEXT "@DO"
1101 FEND,   TEXT "@END"
1102 FEQU,   TEXT "@EQUIVALENCE"
1103 FFOR,   TEXT "@FORMAT"
1104 FGOT,   TEXT "@GO TO"
1105 FINT,   TEXT "@INTEGER"
1106 FPAU,   TEXT "@PAUSE"
1107 FREAL,  TEXT "@REAL"
1108 FREW,   TEXT "@REWIND"
1109 FSBR,   TEXT "@SUBROUTINE"
1110 FCMT,   TEXT "C"        /COMMENT
1111 FDIM,   TEXT "@DIMENSION"
1112 FDBP,   TEXT "@DOUBLE PRECISION"
1113 FEF,    TEXT "@END FILE"
1114 FEXT,   TEXT "@EXTERNAL"
1115 FFUN,   TEXT "@FUNCTION"
1116 FIF,    TEXT "@IF"
1117 FLOG,   TEXT "@LOGICAL"
1118 FREAD,  TEXT "@READ"
1119 FRET,   TEXT "@RETURN"
1120 FSTO,   TEXT "@STOP"
1121 FWRI,   TEXT "@WRITE"
1122 \fBASKEY,
1123 /COLUMN 7               ROW
1124         BDEF            /12
1125         BIFE            /11
1126         BLET            /0
1127         BLIS            /1
1128         BNEW            /2
1129         BON             /3
1130         BOV             /4
1131         BRND            /5
1132         BREM            /6
1133         BRES            /7
1134         BRUN            /8
1135 BSTKEY, BSTO            /9
1136 /COLUMN 8               ROW
1137         BDIM            /12
1138 BINKEY, BINP            /11
1139         BLIN            /0
1140         BNEX            /1
1141         BOLD            /2
1142         BFIL            /3
1143 BPRKEY, BPRI            /4
1144         BREA            /5
1145         BREP            /6
1146         BRET            /7
1147         BSAV            /8
1148         BUNS            /9
1149 /COLUMNS 2-6    COLUMN  ROW
1150         BCAL    /2      12
1151 BENKEY, BEND    /2      11
1152         BCLO    /3      12
1153         BFOR    /3      11
1154         BCHN    /4      12
1155         BGOS    /4      11
1156         BCHG    /5      12
1157         BGOT    /5      11
1158         BDAT    /6      12
1159         BIF     /6      11
1160
1161
1162 FORKEY,
1163 /COLUMN 7               /ROW
1164         FCAL            /12
1165         FDEF            /11
1166         FDO             /0
1167         FEND            /1
1168         FEQU            /2
1169         FFOR            /3
1170         FGOT            /4
1171         FINT            /5
1172         FPAU            /6
1173         FREAL           /7
1174         FREW            /8
1175         FSBR            /9
1176 /COLUMN 8               ROW
1177         FCMT            /12
1178         FDIM            /11
1179         FDBP            /0
1180         FEF             /1
1181         FEXT            /2
1182         FFUN            /3
1183         FIF             /4
1184         FLOG            /5
1185         FREAD           /6
1186         FRET            /7
1187         FSTO            /8
1188         FWRI            /9
1189 /COLUMN 2-6     COLUMN  ROW
1190         0       /2      12
1191         0       /2      11
1192         0       /3      12
1193         FCMN    /3      11
1194         FASN    /4      12
1195         FCPX    /4      11
1196         FBKS    /5      12
1197         FCNT    /5      11
1198         FBKD    /6      12
1199         FDTA    /6      11
1200
1201
1202 \f       FIELD 1
1203
1204
1205
1206
1207
1208 *17
1209
1210
1211 OXR1,   0
1212 OTEMP1, 0
1213 CHAR,   0
1214 PUTPNT, 0
1215 GETPNT, 0
1216 DATFTN, 0               /ADDRESS OF FORTRAN $RUN
1217 GETCHR=JMS I .;XGETCH
1218 PUTCHR=JMS I .;XPUTCH
1219 BCLIN=JMS I .;XBCLIN
1220 OPTION=JMS I .;XOPTIO
1221 MOV6=JMS I .;XMOV6
1222 COLNAM=JMS I .;XCOLNA
1223 OUTNAM=JMS I .;XOUTNA
1224 ISIT=JMS I .;XISIT
1225 SEND=JMS I .;XSEND
1226 TSTCR=JMS I .;XTSTCR
1227 CDRTRA=JMS I .;BCLTRA+1
1228 ISNUM=JMS I .;XISNUM
1229 OUT1=JMS I .;OOUT1
1230 \f*200
1231
1232
1233 /PUT A CHARACTER INTO A 6-BIT BUFFER
1234 PUTCH1=XGETCH
1235 PUTCH4=CON628
1236 XPUTCH, 0
1237         TAD (-215       /IF <CR>, IT BECOMES 37
1238         SZA
1239         TAD (215-337
1240         TAD (337
1241         AND (77         /AND OFF 6 BITS
1242         DCA PUTCH1      /SAVE IT IN A TEMP
1243         TAD PUTPNT      /GET POINTER TO CHARACTER IN 6-BIT BUFFER
1244         ISZ PUTPNT      /AND BUMP POINTER
1245         CLL RAR         /GET WORD DISPLACEMENT
1246         TAD I XPUTCH    /ADD IN BASE ADDRESS
1247         ISZ XPUTCH      /BUMP RETURN ADDRESS
1248         DCA PUTCH4      /SAVE ADDRESS OF WORD CONTAINING CHAR
1249         SZL             /LINK HAS FIRST OR LAST HALF INDICATOR
1250         JMP PUTCH2
1251         TAD PUTCH1      /FIRST HALF - ROTATE CHAR INTO HIGH BITS
1252         CLL RTL;RTL;RTL
1253         DCA PUTCH1
1254         TAD I PUTCH4    /GET ANY CHARACTER ALREADY THERE
1255         AND (77
1256         JMP PUTCH3
1257 PUTCH2, TAD I PUTCH4
1258         AND (7700       /GET CHARACTER ALREADY THERE
1259 PUTCH3, TAD PUTCH1      /ADD IN NEW CHARACTER
1260         DCA I PUTCH4    /STORE THEM BOTH
1261         JMP I XPUTCH    /AND RETURN
1262
1263
1264 /GET A CHARACTER FROM A 6-BIT BUFFER
1265 XGETCH, 0
1266         TAD XGETCH      /MOVE RETURN ADDRESS TO CON628
1267         DCA CON628
1268         TAD GETPNT      /GET POINTER TO CHARACTER
1269         ISZ GETPNT      /BUMP IT FOR NEXT TIME
1270         JMP CON628+1    /ENTER CONVERSION ROUTINE
1271
1272
1273 /CONVERT 6-BIT ASCII TO 8-BIT
1274 /AC HAS POINTER TO CHARACTER
1275 /ARGUMENT IS BASE ADDRESS OF BUFFER
1276 CO628X=XGETCH
1277 CON628, 0
1278         CLL RAR /GET WORD DISPLACEMENT IN AC
1279         TAD I CON628    /ADD BASE ADDRESS OF BUFFER
1280         ISZ CON628      /BUMP RETURN ADDRESS
1281         DCA CO628X      /SAVE ADDRESS
1282         TAD I CO628X    /GET WORD CONTAINING CHARACTER
1283         SZL             /LINK HAS INDICATOR FOR FIRST OR LAST CHAR
1284         JMP .+4
1285         RTR;RTR;RTR     /FIRST CHAR - PUT IN LOW BITS
1286         AND (77
1287         JMS XSEND3   /GET PROPER 8-BIT REPRESENTATION
1288         DCA CHAR        /SAVE IT
1289         TAD CHAR        /RETURN WITH IT IN AC
1290         JMP I CON628    /RETURN
1291
1292
1293 XSEND3, 0
1294         TAD (-37
1295         SNA
1296         TAD (215-337
1297         SPA
1298         TAD (100
1299         TAD (237
1300         JMP I XSEND3
1301
1302
1303 GETCDR, 0
1304         CIF CDF F0
1305         JMS I (GETCD1   /GET A CHAR FROM THE CDR BUFFER
1306         JMP I GETCDR
1307
1308
1309 OOUT1,  0
1310         CIF CDF F0
1311         JMS I (OOUT2
1312         JMP I OOUT1
1313
1314
1315 MOVODV, 0
1316         DCA .+2
1317         MOV6;0;BATOUT
1318         CIF F0  /RETURN DF=1
1319         JMP I MOVODV
1320
1321
1322 XTSTCR, 0
1323         GETCHR;BCLBUF
1324         TAD (-215
1325         SNA CLA
1326         ISZ XTSTCR
1327         L7777
1328         TAD GETPNT
1329         DCA GETPNT
1330         JMP I XTSTCR
1331
1332
1333 PAGE
1334 \f/SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE
1335 /BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL.  AN OPTION IS
1336 /RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/".  IT'S NAME
1337 /IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," ,
1338 /"=",OR <CR>.  THE NAME IS TERMINATED BY ANY ONE OF THE
1339 /PREVIOUS DELIMITERS.  IF IT IS TERMINATED BY A "=" AND
1340 /THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME,
1341 /THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A
1342 /"/" , "," , OR <CR>.  THE SUBROUTINE CALL IS FOLLOWED BY A
1343 /POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY
1344 /A ZERO ENTRY.  EACH ENTRY POINTS TO AN OPTION CONTROL
1345 /BLOCK IN THE FOLLOWING FORM:
1346 /               OPTION CONTROL WORD
1347 /               (FILE NAME SPACE IF NEEDED - 6 WORDS)
1348 /               TEXT "OPTION NAME"
1349 /
1350 /THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS:
1351 /               BIT 0:  ON RETURN THIS BIT WILL BE SET IF
1352 /                       THE OPTION WAS FOUND, AND CLEARED
1353 /                       IF NOT
1354 /               BIT1:   ON RETURN THIS BIT IS SET IF A NAME
1355 /                       WAS GIVEN WITH THE OPTION
1356 /               BIT 2:  SET IF OPTION HAS ALLOCATED 6 WORDS
1357 /                       FOR A POSSIBLE FILE NAME.  CLEARED
1358 /                       IF NOT
1359 /               BITS 6-8:  NUMBER OF CHARACTERS -1 OF SHORT
1360 /                       FORM OF OPTION
1361 /               BITS 9-11: DIFFERENCE BETWEEN SIZES OF
1362 /                       SHORT AND LONG FORMS
1363 /                       THE SUM OF BITS 6-8 AND BITS 9-11
1364 /                       SHOULD TOTAL THE LENGTH OF THE
1365 /                       LONG FORM-1
1366 /
1367 /THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT
1368 /DEVICE, NAME, AND EXTENSION.
1369 /
1370 XOPTIO, 0
1371
1372 /TURN OFF ALL OPTIONS
1373         TAD I XOPTIO    /GET ADDRESS OF LIST OF OPTION ADDRESSES
1374         DCA OPTLIS      /SAVE IT
1375 OPTIO1, TAD I OPTLIS    /GET OPTION ADDRESS
1376         ISZ OPTLIS      /POINT TO NEXT ONE
1377         SNA
1378         JMP OPTIO2      /DONE TURNING OFF ALL OPTIONS
1379         DCA OPTCTL
1380         TAD I OPTCTL    /GET OPTION CONTROL WORD
1381         AND (1777       /CLEAR FIRST BIT
1382         DCA I OPTCTL
1383         JMP OPTIO1      /LOOP
1384
1385 /SEARCH BCL BUFFER FOR "/"
1386 OPTIO2, DCA GETPNT      /START AT BEGINNING OF BATCH CONTROL LINE
1387 OPTIO3, GETCHR;BCLBUF   /GET A CHARACTER FROM THE BUFFER
1388         ISIT            /IS IT "/" OR <CR>?
1389                 OPTIS3;OPTIS4-1
1390         JMP OPTIO3      /NO - KEEP LOOKING
1391 OPTI3A, TAD GETPNT      /YES - SAVE IT'S POSITION
1392         DCA OPTBEG
1393         TAD I XOPTIO    /GET ADDRESS OF LIST AGAIN
1394         DCA OPTLIS      /AND SAVE IT
1395
1396 /FOUND A "/" - TRY ALL OPTIONS
1397 OPTIO4, TAD OPTBEG      /START COMPARISON OF OPTION WITH CHARACTER AFTER "/"
1398         DCA GETPNT
1399         TAD I OPTLIS    /GET ADDRESS OF OPTION CONTROL WORD
1400         ISZ OPTLIS      /AND BUMP POINTER FOR NEXT TIME
1401         SNA             /IS THE LIST ENDED?
1402         JMP I (OPTIER   /YES - OPTION WAS INVALID
1403         DCA OPTCTL      /NO - SAVE ADDRESS OF CONTROL WORD
1404         TAD I OPTCTL    /GET CONTROL WORD
1405         RTL
1406         SPA CLA         /DOES IT HAVE SPACE FOR A FILE NAME
1407         TAD (6          /YES - ADD SIZE OF THE SPACE
1408         TAD OPTCTL      /ADD ADDRESS OF OPTION
1409         IAC             /BUMP ONE FOR CONTROL WORD
1410         DCA OPTTEX      /SAVE ADDRESS OF OPTION TEXT
1411         TAD I OPTCTL    /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD
1412         RAR;RTR
1413         AND (7
1414         CMA             /NEGATE IT (INCREMENTED BY ONE)
1415         DCA OPTCT1      /SAVE IN COUNTER
1416         DCA OPTCT2      /ZERO CHARACTER POSITION
1417 \f/COMPARE OPTION WITH CONTENTS OF BCL BUFFER
1418 OPTIO5, JMS OPTI6A
1419         SZA CLA         /ARE THEY THE SAME?
1420         JMP OPTIO4      /NO - TRY NEXT OPTION
1421         ISZ OPTCT1      /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE?
1422         JMP OPTIO5      /NO - KEEP COMPARING
1423
1424         TAD GETPNT      /SAVE CURRENT BUFFER POSITION
1425         DCA OPTTM2
1426         TAD I OPTCTL    /GET REMAINING LENGTH FROM CONTROL WORD
1427         AND (7
1428         CMA
1429         DCA OPTCT1
1430 OPTIO6, ISZ OPTCT1      /DONE WITH REMAINING CHARACTERS?
1431         SKP
1432         JMP OPTIO7      /YES - SUCCESS
1433         JMS OPTI6A
1434         SNA CLA         /ARE THEY THE SAME?
1435         JMP OPTIO6      /YES - KEEP GOING
1436         TAD OPTTM2      /NO - MOVE POINTER BACK TO SHORT FORM
1437         DCA GETPNT
1438         JMP OPTIO7
1439
1440 OPTI6A, 0
1441         TAD OPTCT2
1442         ISZ OPTCT2
1443         JMS I (CON628
1444 OPTTEX,         0
1445         CIA
1446         DCA OPTTM1
1447         GETCHR;BCLBUF
1448         TAD OPTTM1
1449         JMP I OPTI6A
1450
1451
1452 OPTRET, ISZ XOPTIO      /INCREMENT RETURN ADDRESS
1453         DCA GETPNT      /SET POINTER TO BEGINNING OF BUFFER
1454         JMP I XOPTIO
1455
1456
1457 OPTLIS, 0
1458 OPTCTL, 0
1459 OPTBEG, 0
1460 OPTCT1, 0
1461 OPTCT2, 0
1462 OPTTM1, 0
1463 OPTTM2, 0
1464
1465
1466 \f/TEST DELIMITER AFTER OPTION
1467 OPTIO7, GETCHR;BCLBUF   /GET NEXT BUFFER CHARACTER
1468         ISIT            /IS IT "=", "," ,"/", OR <CR>?
1469                 OPTIS1;OPTIS2-1
1470         JMP I (OPTIER   /NONE OF THESE
1471 OPTIO8, TAD I OPTCTL    /YES - GET CONTROL WORD
1472         RTL
1473         SMA CLA         /DOES IT TAKE A FILE NAME?
1474         JMP I (OPTIER      /NO - ERROR
1475         TAD OPTCTL      /GET ADDRESS OF FILE NAME SPACE
1476         IAC
1477         DCA .+2
1478         COLNAM          /AND COLLECT A NAME INTO IT
1479 OPTTM3,         0
1480                 JMP I (OPTIER      /ERROR RETURN
1481         TAD I OPTCTL    /TURN ON NAME BIT
1482         AND (1777
1483         TAD (2000
1484         DCA I OPTCTL
1485 OPTIO9, TAD I OPTCTL    /GET CONTROL WORD
1486         AND (3777
1487         TAD (4000       /TURN ON OPTION FOUND BIT
1488         DCA I OPTCTL
1489         JMP I (OPTI10
1490
1491
1492 PAGE
1493 \f/ON ERROR, REPORT IT
1494 OPTIER, TAD I (OPTBEG   /OPTION BEGINS AT THIS POSITION
1495         JMS OUTERR      /OUTPUT THE ERROR
1496                 OPTERM
1497
1498 /SQUISH THE CURRENT OPTION OUT OF BCL BUFFER
1499 OPTI10, L7777           /BACK UP OVER "/"
1500         TAD I (OPTBEG   /POINT TO BEGINNING OF OPTION
1501         JMS BCLSQU      /SQUISH OUT THIS OPTION
1502         L7777
1503         TAD I (OPTBEG
1504         JMP I (OPTIO2   /GO LOOK FOR MORE OPTIONS
1505
1506
1507 \f/SQUISH OUT A PORTION OF THE BCL BUFFER
1508 /       TAD X   /POSITION OF FIRST CHAR OF SQUISH
1509 /       JMS BCLSQU
1510 /GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER
1511 /SQUISH CHARS.  ONE CHAR PRECEDING IT IS TESTED,
1512 /AND IS KEPT IF IT IS A "/" OR <CR>
1513 BCLSQU, 0
1514         DCA PUTPNT      /AC POINTS TO BEGINNING OF AREA TO BE SQUISHED
1515         TAD PUTPNT      /SAVE THE POINTER
1516         DCA OUTERR
1517         L7777
1518         TAD GETPNT
1519         DCA GETPNT      /TEST LAST CHAR OF STUFF TO BE SQUISHED
1520         GETCHR;BCLBUF
1521         ISIT            /IS IT "/", OR <CR>?
1522                 BCLIS1;BCLIS2-1
1523 BCLSQ1, GETCHR;BCLBUF   /GET A CHAR
1524         TAD (-215       /IS IT <CR>?
1525         SNA CLA
1526         JMP BCLSQ3      /YES - DONE
1527 BCLSQ2, TAD CHAR        /RESTORE CHAR
1528         PUTCHR;BCLBUF   /PUT THE CHAR IN THE BUFFER
1529         JMP BCLSQ1      /GET ANOTHER CHAR
1530 BCLSQ3, TAD (215        /PUT A <CR>
1531         PUTCHR;BCLBUF
1532         TAD OUTERR      /RESTORE POINTER
1533         DCA GETPNT
1534         JMP I BCLSQU    /RETURN
1535
1536
1537 /SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER
1538 /TO THE OUTPUT BUFFER
1539 /       TAD X   /POSITION OF FIRST CHAR IN BUFFER TO BE SENT
1540 /       JMS OUTERR
1541 /       A       /ADDRESS OF ERROR MESSAGE TO PRECEDE IT
1542 /               /SIX-BIT ASCII
1543 OUTERR, 0
1544         DCA GETPNT      /SET BEGINNING OF BCL LINE TO OUTPUT
1545         TAD I OUTERR    /GET ERROR MESSAGE ADDRESS
1546         ISZ OUTERR
1547         SEND            /PRINT IT
1548 OUTER1, GETCHR;BCLBUF   /GET A CHARACTER
1549         ISIT            /IS IT "," ,"/", OR <CR>?
1550                 OUTIS1;OUTIS2-1
1551         TAD CHAR        /NO - SEND CHAR
1552         OUT1
1553         JMP OUTER1
1554 OUTER2, TAD (215
1555         OUT1
1556         JMP I OUTERR    /RETURN
1557
1558
1559 /TEST A CHAR AND JUMP IF IN LIST
1560 /       JMS XISIT
1561 /       A1      /ADDRESS OF LIST OF NEGATIVE OF CHARS
1562 /               /TERMINATED BY A POSITIVE OR ZERO
1563 /       A2-1    /ADDRESS -1 OF LIST OF
1564 /               /TRANSFER ADDRESSES
1565 XISIT,  0
1566         DCA ISIT1       /SAVE CHAR
1567         TAD I XISIT     /GET LIST OF CHARS
1568         ISZ XISIT
1569         DCA ISIT2
1570         TAD I XISIT     /GET LIST OF ADDRS - 1
1571         ISZ XISIT
1572         DCA ISIT3
1573 ISIT4,  TAD I ISIT2     /GET THE NEXT CHAR
1574         ISZ ISIT2
1575         ISZ ISIT3
1576         SMA
1577         JMP ISIT5       /END OF LIST SIGNALLED BY ENTRY>=0
1578         TAD ISIT1       /IS IT THE CHAR?
1579         SZA CLA
1580         JMP ISIT4       /NO - TRY THE NEXT
1581         TAD I ISIT3     /GET SEND ADDRESS
1582         DCA XISIT
1583 ISIT5,  CLA
1584         JMP I XISIT
1585
1586 ISIT1,  0
1587 ISIT2,  0
1588 ISIT3,  0
1589
1590
1591 PAGE
1592 \f/COLLECT A NAME FROM THE BUFFER
1593 /       JMS XCOLNA
1594 /               X       /ADDRESS OF SPACE TO RECEIVE NAME
1595 /       JMP ERR         /INVALID NAME
1596 XCOLNA, 0
1597         TAD I XCOLNA
1598         DCA .+3
1599         MOV6;ZER6;0
1600         TAD I XCOLNA    /ARGUMENT IS ADDRESS TO PUT NAME
1601         ISZ XCOLNA
1602         DCA COLPU1+2    /SAVE IT FOR USE AS PUTCHR ARG
1603         L7776           /SET NAME - EXTENSION SWITCH FOR NAME
1604         DCA COLSW
1605         TAD (COLIS1     /SET TO COLLECT ANYTHING
1606         DCA COLIS3      /I.E. DEVICE, FILE, OR EXTENSION
1607         TAD (COLIS2-1
1608         DCA COLIS3+1
1609         TAD GETPNT      /SAVE POINTER TO BEGINNING OF NAME
1610         DCA COLNP1
1611 COLGE1, TAD GETPNT      /SAVE POINTER TO BEGINNING OF SECTION
1612         DCA COLNP2      /OF NAME
1613 COLGE2, GETCHR;BCLBUF   /GET A CHAR
1614         ISIT            /IS IT ":",".","/", "," , OR <CR>?
1615 COLIS3,         0;0
1616         JMP COLGE2
1617
1618 COLDEV, JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0
1619         ISZ COLIS3      /REMOVE ":" FROM LIST
1620         ISZ COLIS3+1
1621         JMP COLGE1      /COLLECT NEXT PART OF NAME
1622
1623 COLFIL, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
1624         ISZ COLSW       /NEXT TIME COLLECT EXTENSION
1625         TAD (COLIS1+2   /REMOVE "." FROM LIST
1626         DCA COLIS3
1627         TAD (COLIS2+1
1628         DCA COLIS3+1
1629         JMP COLGE1      /COLLECT NEXT PART OF NAME
1630
1631 COLEXT, ISZ COLSW       /ARE WE COLLECTING NAME OR EXTENSION?
1632         JMP COLEX1      /NAME
1633         JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12
1634         JMP COLEX2
1635 COLEX1, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4
1636 COLEX2, ISZ XCOLNA      /NO ERRORS
1637         JMP COLEX3
1638
1639 COLERR, CLA
1640         TAD COLNP1      /POINT TO BEGINNING OF NAME
1641         JMS I (OUTERR   /SEND IT AS ERROR MESSAGE
1642                 COLERM
1643 COLEX3, TAD COLNP1      /POINT TO BEGINNING OF NAME
1644         JMS I (BCLSQU   /SQUISH IT OUT
1645         JMP I XCOLNA    /RETURN
1646
1647 COLMOV, 0
1648         TAD I COLMOV    /FIRST ARG IS POSITION
1649         ISZ COLMOV
1650         DCA PUTPNT
1651         TAD I COLMOV    /SECOND ARG IS COUNT
1652         ISZ COLMOV
1653         DCA COLCT1
1654         TAD CHAR        /GET DELIMITER
1655         CIA
1656         DCA COLCH1      /SAVE FOR TEST
1657         TAD CHAR
1658         TAD (-"Z
1659         DCA COLCH2      /ANOTHER TEST
1660         TAD COLNP2      /POINT TO BEGINNING OF THIS PART
1661         DCA GETPNT
1662 COLMV1, GETCHR;BCLBUF   /GET NEXT CHAR
1663         TAD COLCH1      /SUBTRACT THE DELIMITER
1664         SNA
1665         JMP I COLMOV    /DELIMITER - WE'RE DONE
1666         TAD COLCH2      /CHAR-"Z"
1667         SMA SZA
1668         JMP COLERR      /NOT ALPHA-NUMERIC
1669         TAD ("Z-"A
1670         SMA
1671         JMP COLPUT      /ALPHABETIC
1672         TAD ("A-"9
1673         SMA SZA
1674         JMP COLERR      /NOT NUMERIC
1675         TAD ("9-"0
1676         SPA
1677         JMP COLERR      /NOT NUMERIC
1678 COLPUT, CLA
1679         ISZ COLCT1      /HAVE WE USED UP OUR COUNT?
1680         JMP COLPU1      /NO - PUT THE CHAR
1681         L7777           /YES - SET COUNTER TO SKIP
1682         DCA COLCT1
1683         JMP COLMV1      /GET NEXT CHAR
1684 COLPU1, TAD CHAR
1685         PUTCHR;0        /PUT THE CHAR IN THE USER SPACE
1686         JMP COLMV1      /GET THE NEXT CHAR
1687
1688
1689 COLSW,  0       /FILE NAME OR EXTENSION SWITCH
1690 COLNP1, 0       /POINTER TO BEGINNING OF NAME
1691 COLNP2, 0       /POINTER TO BEGINNING OF NAME PART
1692 COLCH1, 0       /TEMP LOC FOR COLMOV
1693 COLCH2, 0       /DITTO
1694 COLCT1, 0       /DITTO
1695
1696 PAGE
1697 \fXMOV6, 0
1698         TAD I XMOV6     /GET "FROM" ADDRESS
1699         ISZ XMOV6
1700         DCA MOV61
1701         TAD I XMOV6     /GET "TO" ADDRESS
1702         ISZ XMOV6
1703         DCA MOV62
1704         TAD (-6
1705         DCA MOV63
1706 MOV64,  TAD I MOV61
1707         DCA I MOV62
1708         ISZ MOV61
1709         ISZ MOV62
1710         ISZ MOV63
1711         JMP MOV64
1712         JMP I XMOV6     /RETURN
1713 MOV61,  0
1714 MOV62,  0
1715 MOV63,  0
1716
1717
1718 XBCLIN, 0
1719         DCA PUTPNT      /START AT BEGINNING OF BCL BUFFER
1720         JMS I (SENDKY   /SEND THE KEYWORD
1721         DCA MOV61       /CLEAR THE BLANK COUNTER
1722 BCLIN5, JMS BCLIN3      /GET NEXT CARD AND PUT IT INTO BCL BUFFER
1723         JMP BCLIN7+2    /CARD NOT CONTINUED - DONE
1724         CIF F0
1725         JMS I (CDRIN    /READ ANOTHER CARD
1726         JMP BCLIN7+2    /EOF
1727         TAD (-10
1728         DCA BCLIN4
1729 BCLIN6, JMS I (GETCDR   /GET FIRST 8 CHARS
1730         SZA CLA         /TEST FOR ZERO
1731         JMP BCLIN7      /NON-ZERO - ERROR
1732         ISZ BCLIN4
1733         JMP BCLIN6
1734         JMP BCLIN5      /OK - PUT IT IN BUFFER
1735
1736 BCLIN7, CDF F0
1737         DCA I (CDRFLG   /SET CDRIN TO RETURN THIS CARD AGAIN
1738         CDF F1
1739         TAD (215        /PUT A <CR>
1740         PUTCHR;BCLBUF
1741         TAD (215;OUT1
1742         DCA GETPNT      /SET POINTER TO BEGINNING
1743         JMP I XBCLIN    /RETURN
1744
1745 BCLIN4, 0
1746 BCLIN3, 0
1747         TAD (-40
1748         DCA BCLIN4
1749 BCLIN9, JMS I (GETCDR   /GET NEXT CDR CHAR
1750         SNA
1751         JMP BCLI13      /BLANK
1752         TAD (-CONTCH
1753         SNA
1754         JMP BCLI10      /CONTINUATION
1755         TAD (CONTCH
1756         CIF F0
1757         JMS I (XCONVR
1758         JMP BCLIN8      /RUBOUT
1759         DCA XMOV6       /SAVE THE CHAR
1760         JMS BCLI14      /SEND THE BLANKS
1761         TAD XMOV6
1762         OUT1            /SEND IT
1763         TAD XMOV6
1764         PUTCHR;BCLBUF   /PUT IT
1765         TAD PUTPNT
1766         TAD (-BCLSIZ^2+2        /BCL BUFFER FULL?
1767         SMA CLA
1768         JMP BCLI11      /FULL - ERROR
1769 BCLIN8, ISZ BCLIN4      /COUNT COLUMNS
1770         JMP BCLIN9      /LOOP
1771         JMP I BCLIN3
1772 BCLI10, ISZ BCLIN3      /SKIP RETURN FOR CONTINUATION
1773         DCA MOV61       /CLEAR THE BLANK COUNTER
1774         SEND;BCL10E     /"_$"
1775         TAD (211;OUT1   /<TAB>
1776         JMP I BCLIN3    /RETURN
1777
1778 BCLI11, SEND;BCL11E     /SEND ERROR
1779 BCLI12, CIF F0
1780         JMS I (CDRIN    /GET THE NEXT CARD
1781         JMP BCLIN7+2
1782         JMS I (GETCDR   /GET THE NEXT COLUMN
1783         DCA BCLIN4      /SAVE THIS COLUMN
1784         TAD (JOBBIT     /IS THIS A $JOB CARD?
1785         AND BCLIN4
1786         SNA CLA
1787         JMP BCLI12      /NO - FLUSH TO $JOB
1788         TAD (-JOBBIT-1
1789         AND BCLIN4
1790         SZA CLA
1791         JMP BCLI12
1792         JMP BCLIN7      /YES - DONE
1793
1794 BCLI13, ISZ MOV61       /ANOTHER BLANK
1795         JMP BCLIN8
1796
1797 BCLI14, 0
1798         TAD MOV61
1799         CMA
1800         DCA MOV61
1801 BCLI15, ISZ MOV61;SKP
1802         JMP I BCLI14
1803         TAD (" ;OUT1
1804         JMP BCLI15
1805
1806
1807
1808
1809 PAGE
1810 \fBCLTRA,        JMP I .+1       /GO FINISH UP LAST BCL COMMAND
1811         BCLHUH  /HUH? - I.E. WHICH COMMAND WAS IT?
1812         CIF CDF F0
1813         JMP I (TEXFIN   /TO COPY A DECK UNTIL THE NEXT BCL
1814                         /COMMAND - JMS BCLTRA+1
1815
1816 BCLHU1, 0               /JMS HERE WITH ARG = TRANSFER ADDRESS
1817         TAD I BCLHU1    /GET TRANSFER ADDRESS
1818         DCA BCLHU1
1819         TAD (BCLHUH     /ON NEXT BCL CARD - NOTHING TO FINISH
1820         DCA BCLTRA+1
1821         CIF CDF F0      /FIELD 0!
1822         JMP I BCLHU1    /GO GO GO
1823
1824
1825 BCLHUH, CDF F0
1826         TAD I (KEYVAL   /GET KEYWORD VALUE
1827         CDF F1
1828         TAD (BCLGO      /USE IT TO GET TRANSFER ADDRESS
1829         DCA OTEMP1
1830         TAD I OTEMP1
1831         DCA OTEMP1
1832         CDF F0
1833         TAD I (CONFLG   /WAS LAST CARD CONTINUED?
1834         CDF F1
1835         SZA CLA
1836         JMS BCLHU2      /YES - ERROR
1837         CDF F0
1838         TAD I (LNCNT    /DID THIS CARD HAVE A LINE NUMBER?
1839         CDF F1
1840         SNA CLA
1841         JMP I OTEMP1    /YES - GO TO IT!
1842         CIF CDF F0
1843         JMS I (LNOUT    /OUTPUT THE LINE NUMBER
1844         JMS BCLHU2      /WHAT'S IT DOING WITH A NUMBER ANYWAY?
1845         JMP I OTEMP1    /NOW WE GO.
1846
1847 BCLHU2, 0
1848         CDF F0
1849         ISZ I (ERRFLG
1850         CDF F1
1851         SEND;BCLHM1     /"?_"
1852         JMP I BCLHU2
1853
1854
1855 BCLEOF, JMS BCLHU1;EOF2
1856
1857
1858 CERR,   JMS BCLHU1;KEYBAD
1859
1860
1861 \fXOUTNA,        0
1862         TAD I XOUTNA    /GET ADDRESS OF NAME
1863         ISZ XOUTNA
1864         DCA OUTNA2
1865         TAD GETPNT      /SAVE BUFFER INPUT POINTER
1866         DCA OUTNA6
1867         DCA OUTNA3      /SET FLAG FOR NO NAME
1868         JMS OUTNA4;0;-4 /SEND 4 CHARS FROM POSITION 0
1869         TAD OUTNA3
1870         SNA CLA
1871         JMP .+3         /NO DEVICE - NO ":"
1872         TAD (":
1873         OUT1
1874         JMS OUTNA4;4;-6 /SEND 6 CHARS FROM POSITION 4
1875         TAD (12         /SET UP TO GET EXTENSION
1876         DCA GETPNT
1877         JMS OUTNA1      /GET FIRST CHAR
1878         JMP OUTNA5      /NO EXTENSION
1879         CLA
1880         TAD (".
1881         OUT1
1882         JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12
1883 OUTNA5, TAD OUTNA6      /RESTORE BUFFER INPUT POINTER
1884         DCA GETPNT
1885         JMP I XOUTNA
1886
1887 OUTNA1, 0
1888         GETCHR
1889 OUTNA2, 0
1890         TAD (-300       /IS IT NULL?
1891         SNA
1892         JMP I OUTNA1    /YES - DONE
1893         ISZ OUTNA1      /SKIP RETURN
1894         TAD (300
1895         JMP I OUTNA1
1896 OUTNA3, 0       /NAME PRESENT SWITCH
1897
1898 OUTNA4, 0
1899         TAD I OUTNA4    /GET CHAR POSITION
1900         ISZ OUTNA4
1901         DCA GETPNT
1902         TAD I OUTNA4    /GET NO OF CHARS
1903         ISZ OUTNA4
1904         DCA OUTN41
1905 OUTN42, JMS OUTNA1      /GET A CHAR
1906         JMP I OUTNA4    /NULL - DONE
1907         OUT1
1908         ISZ OUTNA3      /SET NAME PRESENT
1909         ISZ OUTN41
1910         JMP OUTN42
1911         JMP I OUTNA4    /DONE - RETURN
1912 OUTN41, 0
1913 OUTNA6, 0
1914
1915
1916 PAGE
1917 \fXSEND, 0
1918         SZA             /IF AC =0, ADDRESS IS ARG OF CALL
1919         JMP XSEND4
1920         TAD I XSEND             /GET MESSAGE ADDRESS
1921         ISZ XSEND
1922 XSEND4, DCA OTEMP1
1923 XSEND1, TAD I OTEMP1
1924         CLL RTR;RTR;RTR
1925         JMS XSEND2
1926         TAD I OTEMP1
1927         JMS XSEND2
1928         ISZ OTEMP1
1929         JMP XSEND1
1930
1931 XSEND2, 0
1932         AND (77
1933         SNA
1934         JMP I XSEND     /NULL ENDS MESSAGE
1935         JMS I (XSEND3   /GET 8-BIT REPRESENTATION
1936         OUT1
1937         JMP I XSEND2
1938
1939
1940 MAKNAM, 0
1941         TAD (DECN       /START CONVERSION AT 100
1942         CDF F0
1943         DCA I (XR1
1944         L7775           /CONVERT 3 DIGITS
1945         DCA I (TEMP1
1946         ISZ NAMCNT      /BUMP NAME COUNTER
1947         TAD NAMCNT
1948         DCA I (TEMP4
1949         L0001
1950         DCA I (TEMP5    /SAVE LEADING ZEROES
1951         TAD (MAKNA2
1952         DCA I (OUTAD
1953         CDF F1
1954         TAD I MAKNAM    /MOVE DEFAULT NAME TO OUTPUT AREA
1955         DCA .+3
1956         MOV6;FILNAM;0
1957         TAD I MAKNAM
1958         ISZ MAKNAM
1959         DCA MAKNA3+2
1960         TAD (7          /PUT NUMBER AT POSITION 7-9
1961         DCA PUTPNT
1962         CIF F0
1963         JMS I (CONDEC   /OUTPUT NUMBER
1964         TAD (XOUT       /RESTORE OUTPUT ROUTINE
1965         CDF F0
1966         DCA I (OUTAD
1967         CDF F1
1968         JMP I MAKNAM    /RETURN
1969
1970 MAKNA3, 0
1971         PUTCHR;0
1972         CIF CDF F0
1973         JMP I MAKNA3
1974 NAMCNT, 0
1975
1976
1977 XISNUM, 0
1978         TAD (-"9
1979         SMA SZA
1980         JMP XISNU1
1981         TAD ("9-"0
1982         SMA
1983         ISZ XISNUM
1984 XISNU1, CLA
1985         JMP I XISNUM
1986
1987
1988 SAVNAM, 0
1989         TAD SAVPNT
1990         DCA SAV1+2      /PUT NAME IN LIST
1991         TAD SAVPNT
1992         TAD (-SAVTOP            /ARE WE AT TOP OF LIST?
1993         SNA
1994         JMP I SAVNAM    /YES - DON'T SAVE NAME
1995         TAD (SAVTOP+6
1996         DCA SAVPNT      /ADVANCE POINTER FOR NEXT TIME
1997         TAD I SAVNAM    /GET NAME TO SAVE
1998         DCA SAV1+1
1999         ISZ SAVNAM
2000 SAV1,   MOV6;0;0
2001         JMP I SAVNAM
2002
2003 SAVPNT, SAVARA          /POINT TO SAVE AREA
2004
2005
2006 UNSNAM, 0
2007         TAD I UNSNAM
2008         ISZ UNSNAM
2009         DCA UNSNA1+2    /POINT TO SPACE TO RECEIVE NAME
2010         TAD SAVPNT
2011         TAD (-6-SAVARA
2012         SPA
2013         JMP UNSNA2      /EMPTY - RETURN
2014         TAD (SAVARA
2015         DCA SAVPNT      /BACK UP
2016         TAD SAVPNT
2017         DCA UNSNA1+1    /SET ADDRESS FROM WHICH NAME WILL COME
2018 UNSNA1, MOV6;0;0
2019         ISZ UNSNAM      /SKIP RETURN UNLESS EMPTY
2020 UNSNA2, CLA
2021         JMP I UNSNAM
2022
2023
2024 PAGE
2025 \f/
2026 /
2027 /       $DECK
2028 /
2029 /
2030 CDECK,  BCLIN           /GET THE LINE
2031         OPTION;CDEOPT           /ANALYZE THE OPTIONS
2032         TSTCR           /END OF LINE?
2033         JMP CDECK1      /NO - GET A NAME
2034 CDECK3, MOV6;CDEDEF;NAME1       /YES - MOVE DEFAULT NAME
2035         JMP CDECK2
2036 CDECK1, COLNAM;NAME1    /COLLECT A NAME
2037                 JMP CDECK3      /FAIL - BAD NAME
2038 CDECK2, SEND;CDEM1      /".R PIP_*"
2039         OUTNAM;NAME1    /SEND THE NAME
2040         SEND;CDEM2      /"<BAT:_"
2041         TAD I (OPFOR    /WAS "/FOR" SPECIFIED?
2042         SMA CLA
2043         TAD (BASKEY-FORKEY      /NO - USE BASIC
2044         TAD (FORKEY-15
2045         CDF F0
2046         DCA I (KEYADR
2047         CDF F1
2048         CDRTRA          /TRANSLATE THE CARDS
2049         SEND;CMEOD      /"$EOD_"
2050         TAD I (OPNOL    /WAS "/NOLIST" SPECIFIED?
2051         SPA CLA
2052         JMP I (BCLHUH   /YES - DONE
2053         TAD ("*;OUT1
2054         JMS I (PIPOUT;BATOUT /SEND NAME OF LISTING DEVICE
2055         TAD ("<;OUT1
2056         OUTNAM;NAME1    /SEND NAME OF FILE
2057         TAD (215;OUT1
2058         JMP I (BCLHUH
2059
2060
2061 \f/
2062 /
2063 /       $BASIC
2064 /
2065 /
2066 CBAS,   BCLIN           /GET BCL LINE
2067         OPTION;CBAOPT   /ANALYZE OPTIONS
2068         TSTCR           /END OF LINE?
2069         JMP CBAS2       /NO - GET NAME
2070 CBAS1,  MOV6;CBATK;NAME1        /MOVE IN BAT:
2071         SEND;CBAM1      /.R PIP *PROG.BA<
2072         OUTNAM;NAME1    /SEND NAME
2073         JMP     CONT
2074 CBAS2,  COLNAM;NAME1    /COLLECT THE NAME
2075                 JMP CBAS1 /FAIL - USE DEFAULT
2076 CBAS3,  SEND;CBAM1      /".R PIP_*PROG.BA<"
2077         SEND;CBAM6
2078 CONT,   TAD (215;OUT1
2079 CBAS5,  JMP CBAS7       /SET OR CLOBBERED IN INIT
2080         TAD (211;OUT1
2081         SEND;CBAM3      /'FILE #0,"DATA.DA"\FILEV #1,"'
2082         OUTNAM;BATOUT   /"TTY:" OR "LPT:"
2083         SEND;CBAM4      /'"_'
2084 CBAS7,  TAD (BASKEY-15
2085         CDF F0
2086         DCA I (KEYADR   /SET KEYWORD LIST
2087         CDF F1
2088         CDRTRA          /TRANSLATE CARDS
2089         SEND;CMEOD      /"$EOD_"
2090         SEND;CBAM7
2091         SEND;CBAM5
2092         OUTNAM;NAME1
2093         SEND;CBAM8
2094         TAD I (OPNOL    /WAS "/NOLIST SPECIFIED?"
2095         SPA CLA
2096         JMP CBAS4
2097         SEND            /SEND AN EOD (MH)
2098         CMEOD           /(MH)
2099         SEND            /SEND AN .R PIP * (MH)
2100         CDEM1           /(MH)
2101         JMS I (PIPOUT;BATOUT
2102         SEND;CBAM2      /"<PROG.BA_"
2103 CBAS4,  TAD (DATBAS
2104         DCA I (DATADR   /SET "$DATA" ROUTINE
2105         JMP I (BCLHUH   /DONE
2106
2107
2108 /
2109 /
2110 /       $RUN            (AFTER $BASIC)
2111 /
2112 /
2113 DATBAS, BCLIN
2114         OPTION;ZER6     /NO OPTIONS
2115         SEND;DATBM1     /".R PIP_*DATA.DA<BAT:_"
2116         CDRTRA          /TRANSLATE THE CARDS
2117         SEND;DATBM2     /"$EOD_.R BCOMP_*PROG.BA_"
2118         TAD DATFTN      /$RUN IS FORTRAN NOW
2119         DCA I (DATADR
2120         JMP I (BCLHUH   /DONE
2121
2122
2123 PAGE
2124 \f/
2125 /
2126 /       $FORTRAN        (FORTRAN IV)
2127 /
2128 /
2129 CF4,    BCLIN           /GET BCL LINE
2130         OPTION;CF4OPT   /ANALYZE OPTIONS
2131         TSTCR           /END OF LINE?
2132         JMP CF42
2133 CF41,   JMS I (MAKNAM;NAME1     /YES - MAKE A NAME
2134         JMP CF43
2135 CF42,   COLNAM;NAME1    /NO - COLLECT A NAME
2136                 JMP CF41 /BAD NAME - MAKE ONE
2137 CF43,   SEND;CF4M1      /".R PIP_*"
2138         OUTNAM;NAME1    /SEND THE NAME
2139         TAD ("<;OUT1
2140         TAD I (OPSRC;RAL        /WAS A SOURCE FILE GIVEN
2141         SMA CLA
2142         JMP CF44        /NO
2143         OUTNAM;OPSRC+1  /YES - SEND IT
2144         TAD (215;OUT1
2145         JMP CF45
2146 CF44,   SEND;CF4M2      /"BAT:_"
2147 CF45,   TAD (FORKEY-15  /FORTRAN CARDS
2148         CDF F0
2149         DCA I (KEYADR
2150         CDF F1
2151         CDRTRA          /TRANSLATE THE CARDS
2152         SEND;CF4M3      /"$EOD_.R F4_*"
2153         OUTNAM;NAME1
2154         TAD I (OPNOL    /WAS "/NOLIST" SPECIFIED?
2155         SPA CLA
2156         JMP CF46        /YES - DON'T GENERATE LIST FILES
2157         TAD (",;OUT1
2158         TAD I (OPLIS
2159         RAL
2160         SPA CLA         /WAS A NAME GIVEN?
2161         JMP CF47        /YES - GET IT
2162         MOV6;BATOUT;OPLIS+1 /NO - GIVE LIST DEV
2163 CF47,   OUTNAM;OPLIS+1  /SEND NAME OF LISTING FILE
2164 CF46,   TAD ("<;OUT1
2165         OUTNAM;NAME1
2166         TAD I (OPRALF   /PRODUCE RALF LISTING?
2167         SMA CLA
2168         JMP CF48        /NO
2169         SEND;CF4M4      /"/F"
2170 CF48,   TAD (215;OUT1
2171         TAD (DATF4
2172         DCA I (DATADR   /SET "$DATA" ADDRESS
2173         JMS I (SAVNAM;NAME1     /SAVE NAME FOR "$LOAD"
2174         JMP I (BCLHUH   /DONE
2175
2176
2177 /
2178 /
2179 /       $RUN            (FORTRAN II)
2180 /
2181 /
2182 DATF2,  BCLIN
2183         JMS I (CL2S     /DO $LOAD STUFF
2184         JMP DATL21
2185 DATL2,  BCLIN
2186         OPTION;ZER6     /NO OPTIONS IF ALREADY LOADED
2187         JMP DATL21
2188 DATX2,  BCLIN
2189         JMS I (DATNAM   /GET A NAME
2190         TAD I (NAMELD   /WAS A DEVICE SPECIFIED?
2191         SZA CLA
2192         JMP DATL21      /YES
2193         TAD (0423       /NO - USE "DSK"
2194         DCA I (NAMELD
2195         TAD (1300
2196         DCA I (NAMELD+1
2197 DATL21, SEND;DTF2M1     /".RUN "
2198         OUTNAM;NAMELD
2199         TAD (215;OUT1
2200         CDRTRA          /WITH GENIOX, INPUT IS FROM BATCH STREAM
2201         SEND;CMEOD      /"$EOD_"
2202         TAD DATFTN      /$DATA IS NOW FORTRAN
2203         DCA I (DATADR
2204         JMP I (BCLHUH
2205
2206
2207
2208 PAGE
2209 \f/
2210 /
2211 /       $LOAD           (FORTRAN IV)
2212 /
2213 /
2214 /THIS SUBROUTINE IS USED WITH EITHER A $LOAD OR $RUN
2215 CL4S,   0
2216         OPTION;CL4OPT   /ANALYZE OPTIONS
2217         SEND;CL4SM1     /".R LOAD_*"
2218         TAD I (OPIMAG   /WAS "/IMAGE" FILE SPECIFIED
2219         RAL
2220         SMA CLA
2221         JMP CL4S1       /NO
2222         MOV6;OPIMAG+1;NAMELD /YES - MOVE NAME
2223         JMP CL4S2
2224 CL4S1,  MOV6;CL4DEF;NAMELD /USE DEFAULT NAME
2225 CL4S2,  OUTNAM;NAMELD   /SEND THE NAME OF THE IMAGE FILE
2226         TAD I (OPLIS    /WAS "/LIST" FILE GIVEN?
2227         SMA CLA
2228         JMP CL4S4
2229         TAD I (OPLIS;RAL
2230         SPA CLA
2231         JMP CL4S3
2232         MOV6;BATOUT;OPLIS+1
2233 CL4S3,  TAD (",;OUT1
2234         OUTNAM;OPLIS+1
2235 CL4S4,  TAD I (OPSSYM   /LIST SYSTEM SYMBOLS?
2236         SMA CLA
2237         JMP CL4S11      /NO
2238         SEND;CL4SM8     /"/S"
2239 CL4S11, SEND;CL4SM2     /"<_*"
2240         TAD I (OPLIB;RAL        /WAS "/LIBRARY" FILE SPECIFIED?
2241         SMA CLA
2242         JMP CL4S5
2243         OUTNAM;OPLIB+1  /SEND NAME OF LIBRARY
2244         SEND;CL4SM3     /"/L_*"
2245 CL4S5,  TAD I (OPNOA    /WAS "/NOAUTO" SPECIFIED?
2246         SPA CLA
2247         JMP CL4S7       /YES - DON'T BOTHER WITH SAVED NAMES
2248 CL4S6,  JMS I (UNSNAM;NAME1     /GET A SAVED NAME
2249                 JMP CL4S7 /OUT OF NAMES
2250         OUTNAM;NAME1    /SEND IT
2251         SEND;CL4SM4     /"/C_*"
2252         JMP CL4S6
2253 CL4S7,  TSTCR;SKP       /END OF LINE?
2254         JMP CL4S10
2255         GETCHR;BCLBUF   /GET NEXT CHARACTER
2256         DCA CHRSAV
2257         GETCHR;BCLBUF
2258         TAD (-"=
2259         SZA CLA
2260         JMP CL4S8
2261         TAD CHRSAV
2262         ISIT;CLIS1;CLIS2-1 /IS IT "L" OR "O"
2263 CL4S8,  L7776
2264         TAD GETPNT      /BACK UP 2
2265         DCA GETPNT
2266 CL4S9,  COLNAM;NAME1
2267                 JMP CL4S7 /BAD NAME
2268         OUTNAM;NAME1    /SEND THE NAME
2269         SEND;CL4SM4     /"/C_*"
2270         JMP CL4S7
2271 CL4SL,  SEND;CL4SM5     /"/O"
2272 CL4SO,  SEND;CL4SM6     /"_*"
2273         L7776
2274         TAD GETPNT      /BACK 2
2275         JMS I (BCLSQU
2276         JMP CL4S9
2277 CL4S10, SEND;CL4SM7     /"$_"
2278         DCA I (NAMCNT
2279         JMP I CL4S      /RETURN
2280
2281
2282 /$LOAD
2283 CL4,    BCLIN           /GET THE LINE
2284         JMS CL4S        /ANALYZE IT
2285         TAD (DATL4      /SET "$DATA" ADDRESS
2286         DCA I (DATADR
2287         JMS I (BCLHU1;TEXFIN
2288
2289 CHRSAV, 0
2290
2291 PAGE
2292 \f/
2293 /
2294 /       $RUN            (FORTRAN IV) - FORMERLY CALLED $DATA
2295 /
2296 /
2297 /THIS SUBROUTINE IS CALLED FROM DATF4 - THE REAL $RUN PROCESSOR
2298 DAT4,   0
2299         TAD (-12^7      /ZERO OUT CONTROL WORD
2300         DCA DEVASC      /FOR EACH DEVICE NUMBER
2301         TAD (DEVASN-1
2302         DCA OXR1
2303 DEVAS1, DCA I OXR1
2304         ISZ DEVASC
2305         JMP DEVAS1
2306         BCLIN           /GET THE INPUT LINE
2307 DAT41,  GETCHR;BCLBUF   /GET A CHAR
2308 DAT411, ISIT;OPTIS3;DATIS1-1 /IS IT "/" OR <CR>?
2309         JMP DAT41       /NO
2310 DAT42,  L7777
2311         TAD GETPNT      /SAVE POINTER TO "/"
2312         DCA DEVAST
2313         GETCHR;BCLBUF
2314         ISNUM
2315         JMP DAT411      /IT'S NOT A NUMBER
2316         TAD CHAR
2317         TAD (-"0
2318         CIA
2319         DCA DEVASC
2320         TAD DEVASC
2321         CIA
2322         CLL RAL;RTL
2323         TAD DEVASC      /NUMBER*7
2324         TAD (DEVASN
2325         DCA DEVASC
2326 DAT47,  GETCHR;BCLBUF   /GET ANOTHER CHAR
2327         ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="?
2328         JMP DAT411      /NO
2329 DAT44,  TAD I DEVASC    /"N" SETS BIT 1
2330         AND (5777
2331         TAD (2000
2332         DCA I DEVASC
2333         JMP DAT47
2334 DAT45,  TAD I DEVASC    /"C" SETS BIT 2
2335         AND (6777
2336         TAD (1000
2337         DCA I DEVASC
2338         JMP DAT47
2339 DAT46,  TAD GETPNT      /SAVE POINTER TO POSSIBLE NAME
2340         DCA DEVASP
2341         GETCHR;BCLBUF   /GET THE NEXT CHAR
2342         ISNUM
2343         JMP DAT48       /NOT A NUMBER
2344         TAD CHAR        /SAVE THE NUMBER
2345         DCA DEVASS
2346         GETCHR;BCLBUF
2347         ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR <CR>?
2348 DAT48,  TAD DEVASP      /RESET NAME POINTER
2349         DCA GETPNT
2350         TAD I DEVASC    /ZERO OUT NUMBER
2351         AND (7400
2352         DCA I DEVASC
2353         TAD DEVASC;IAC  /GET POINTER TO DEVICE BLOCK
2354         DCA .+2
2355         COLNAM;0        /COLLECT NAME
2356                 JMP DAT49       /BAD NAME
2357 DAT412, TAD I DEVASC    /NAME OR NUM OK - SET BIT 0
2358         AND (3777
2359         TAD (4000
2360         DCA I DEVASC
2361 DAT49,  TAD DEVAST      /SQUISH
2362         JMS I (BCLSQU
2363         JMP DAT41
2364 DAT410, TAD I DEVASC    /ADD NUMBER TO CONTROL WORD
2365         AND (7400
2366         TAD DEVASS
2367         DCA I DEVASC
2368         JMP DAT412
2369 DAT43,  JMP I DAT4
2370
2371
2372 DEVASP, 0
2373 DEVASC, 0
2374 DEVASS, 0
2375 DEVAST, 0
2376
2377
2378 /SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY:
2379 PIPOUT, 0
2380         TAD I PIPOUT    /GET ADDRESS OF NAME
2381         ISZ PIPOUT
2382         DCA PIPPNT
2383         OUTNAM          /SEND IT
2384 PIPPNT,         0
2385         TAD I PIPPNT    /GET CHAR OF DEVICE
2386         TAD (-2424      /IS IT "TT"?
2387         SZA CLA
2388         JMP I PIPOUT    /NO
2389         ISZ PIPPNT
2390         TAD I PIPPNT
2391         TAD (-3100      /IS IT "Y@"?
2392         SZA CLA
2393         JMP I PIPOUT    /NO
2394         SEND;PIPM1      /"/T"
2395         JMP I PIPOUT
2396
2397
2398 PAGE
2399 \f/$RUN (FORTRAN IV)
2400 DATF4,  JMS I (DAT4     /PROCESS DEVICE NUMBER STUFF
2401         JMS I (CL4S     /DO LOAD STUFF
2402         JMP DATL46
2403 DATL4,  JMS I (DAT4
2404         OPTION;ZER6     /NO OPTIONS
2405         JMP DATL46
2406 DATX4,  JMS I (DAT4     /DO DEVICE NUMBER STUFF
2407         JMS DATNAM      /COLLECT A NAME
2408 DATL46, SEND;DTF4M1     /".R PIP_*DATA.DA<BAT:_"
2409         CDRTRA          /TRANSLATE CARDS
2410         SEND;DTF4M2     /"$EOD_.R FRTS_*"
2411         OUTNAM;NAMELD   /SEND LOADER NAME
2412 DATL48, JMP DATL49      /ZEROED OR CREATED IN INIT
2413         SEND;DTF4M6     /"_*DATA.DA/4_*"
2414         OUTNAM;BATOUT
2415         SEND;DTF4M7     /"/5"
2416         JMP DTL410
2417 DATL49, SEND;DTF4M8     /"_*/5=4"
2418 DTL410, SEND;DTF4M3     /"_*"
2419         TAD (-12        /TRANSLATE THE DEVICE NUMBERS
2420         DCA DATF4C
2421         TAD (DEVASN-7
2422         DCA DATF4P
2423 DATL41, TAD (7
2424         TAD DATF4P
2425         DCA DATF4P
2426         TAD I DATF4P
2427         SMA CLA         /WAS THIS ONE SPECIFIED?
2428         JMP DATL47      /NO
2429         TAD I DATF4P
2430         AND (377        /WAS IT A NUMBER?
2431         SNA
2432         JMP DATL42
2433         DCA CHAR        /YES - SAVE IT
2434         TAD ("=;OUT1
2435         TAD CHAR;OUT1
2436         JMP DATL43
2437 DATL42, TAD DATF4P;IAC  /POINT TO NAME
2438         DCA .+2
2439         OUTNAM;0        /SEND IT
2440 DATL43, TAD I DATF4P    /"N"?
2441         RAL
2442         SMA CLA
2443         JMP DATL44      /NO
2444         TAD ("<;OUT1
2445 DATL44, TAD I DATF4P    /"C"?
2446         RTL
2447         SMA CLA
2448         JMP DATL45      /NO
2449         SEND;DTF4M4     /"/C"
2450 DATL45, TAD ("/;OUT1
2451         TAD DATF4C
2452         TAD ("0+12;OUT1
2453         SEND;DTF4M3     /"_*"
2454 DATL47, ISZ DATF4C
2455         JMP DATL41
2456         SEND;DTF4M5     /"$_"
2457         TAD DATFTN      /"$DATA" IS NOW FORTRAN
2458         DCA I (DATADR
2459         JMP I (BCLHUH
2460
2461 DATF4C, 0
2462 DATF4P, 0
2463
2464
2465 DATNAM, 0
2466         OPTION;ZER6     /NO OPTIONS
2467         TSTCR;SKP       /IS THERE A NAME?
2468         JMP DATNO       /NO
2469         COLNAM;NAMELD   /YES - COLLECT IT
2470                 JMP DATNO /INVALID NAME
2471         JMP I DATNAM    /RETURN
2472 DATNO,  SEND;DATNO1     /"?NO PROGRAM TO RUN_"
2473         JMS I (BCLHU1;TEXFIN
2474
2475
2476 PAGE
2477 \f/
2478 /
2479 /       $FORTRAN        (FORTRAN II)
2480 /
2481 /
2482 CF2,    BCLIN
2483         OPTION;CF2OPT   /ANALYZE OPTIONS
2484         TSTCR           /END OF LINE?
2485         JMP CF22
2486 CF21,   JMS I (MAKNAM;NAME1     /CREATE A NAME
2487         JMP CF23
2488 CF22,   COLNAM;NAME1    /COLLECT A NAME
2489                 JMP CF21 /FAIL - CREATE A NAME
2490 CF23,   SEND;CF2M1      /".R PIP_*"
2491         OUTNAM;NAME1
2492         TAD ("<;OUT1
2493         TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN?
2494         SMA CLA
2495         JMP CF24        /NO
2496         OUTNAM;OPSRC+1
2497         TAD (215;OUT1
2498         JMP CF25
2499 CF24,   SEND;CF2M2      /"BAT:_"
2500 CF25,   TAD (FORKEY-15  /FORTRAN CARDS
2501         CDF F0
2502         DCA I (KEYADR
2503         CDF F1
2504         CDRTRA          /TRANSLATE THE CARDS
2505         SEND;CF2M3      /"$EOD"
2506         TAD I (OPNOL    /WAS "/NOLIST" SPECIFIED?
2507         SPA CLA
2508         JMP CF27
2509         SEND;CF2M4      /"_*"
2510         TAD I (OPLIS;RAL /WAS A LISTING FILE GIVEN?
2511         SPA CLA
2512         JMP CF26        /YES
2513         MOV6;BATOUT;OPLIS+1 /NO - USE LISTING DEVICE
2514 CF26,   JMS I (PIPOUT;OPLIS+1
2515         TAD ("<;OUT1
2516         OUTNAM;NAME1
2517 CF27,   SEND;CF2M5      /"_.R FORT_*"
2518         OUTNAM;NAME1
2519         TAD I (OPNOL    /NOLIST?
2520         SPA CLA
2521         JMP CF28        /YES
2522         TAD I (OPSABR   /WAS "/SABR" SPECIFIED?
2523         SMA CLA
2524         JMP CF28        /NO
2525         TAD (",;OUT1
2526         OUTNAM;OPLIS+1
2527 CF28,   TAD ("<;OUT1
2528         OUTNAM;NAME1
2529         TAD (215;OUT1
2530         TAD (DATF2
2531         DCA I (DATADR   /ENABLE $DATA
2532         JMS I (SAVNAM;NAME1 /SAVE THE NAME FOR $LOAD
2533         JMP I (BCLHUH   /DONE
2534
2535
2536 \f/
2537 /
2538 /       $EOD
2539 /       $MSG
2540 /
2541 /
2542 CEOD,
2543 CMSG,
2544         JMS SENDKY      /OUTPUT THE BCL KEYWORD
2545         JMS I (BCLHU1;TEXTRA
2546
2547 /
2548 /
2549 /       $JOB
2550 /
2551 /
2552 CJOB,   TAD (SAVARA     /RESET SAVED NAMES
2553         DCA I (SAVPNT
2554         DCA I (NAMCNT   /ZERO MAKNAM COUNTER
2555         TAD DATFTN      /$RUN IS NOW FORTRAN
2556         DCA I (DATADR
2557         BCLIN           /SEND THE LINE TO THE BATCH STREAM
2558         SEND;MJOB1      /".R FOTP_*FIL???.*/D_"
2559         JMS I (BCLHU1;TEXFIN
2560
2561 SENDKY, 0
2562         CDF F0
2563         TAD I (KEYVAL
2564         CDF F1
2565         TAD (BCLKEY-1
2566         DCA OTEMP1
2567         TAD I OTEMP1
2568         SEND
2569         TAD (" ;OUT1
2570         JMP I SENDKY
2571
2572
2573 PAGE
2574 \f/
2575 /
2576 /       $LOAD           (FORTRAN II)
2577 /
2578 /
2579 /THIS SUBROUTINE IS CALLED BY CL2 OR DATF2
2580 CL2S,   0
2581         OPTION;CL2OPT   /ANALYZE OPTIONS
2582         SEND    /".R LOADER_*" OR ".R LOADER_*GENIOX"
2583 CL2SX,          CL2M1   /OR CL2M1A
2584         TAD I (OPINP    /WAS "/INPUT" SPECIFIED?
2585         SMA CLA
2586         JMP CL2S1
2587         SEND;CL2M3      /"/I"
2588 CL2S1,  TAD I (OPOPT    /WAS "/OUTPUT" SPECIFIED?
2589         SMA CLA
2590         JMP CL2S2
2591         SEND;CL2M4      /"/O"
2592 CL2S2,  TAD I (OPTWO    /WAS "/TWO" SPECIFIED?
2593         SMA CLA
2594         JMP CL2S3
2595         SEND;CL2M5      /"/H"
2596 CL2S3,  SEND;CL2M6      /"_*"
2597         TAD I (OPLIB;RAL /WAS A LIBRARY SPECIFIED?
2598         SMA CLA
2599         JMP CL2S4
2600         OUTNAM;OPLIB+1
2601         SEND;CL2M7      /"/L_*"
2602 CL2S4,  TAD I (OPLIS    /WAS "/LIST" SPECIFIED?
2603         SMA CLA
2604         JMP CL2S6
2605         TAD I (OPLIS;RAL /WAS A NAME GIVEN?
2606         SPA CLA
2607         JMP CL2S5       /YES
2608         MOV6;BATOUT;OPLIS+1
2609 CL2S5,  OUTNAM;OPLIS+1
2610         SEND;CL2M8      /"</M_*"
2611 CL2S6,  TAD I (OPNOA    /WAS "/NOAUTO" SPECIFIED?
2612         SPA CLA
2613         JMP CL2S8
2614 CL2S7,  JMS I (UNSNAM;NAME1     /GET A SAVED NAME
2615                 JMP CL2S8       /EMPTY
2616         OUTNAM;NAME1
2617         SEND;CL2M6      /"_*"
2618         JMP CL2S7
2619 CL2S8,  TSTCR;SKP       /END OF LINE?
2620         JMP CL2S9       /YES
2621         COLNAM;NAME1
2622         OUTNAM;NAME1
2623         SEND;CL2M6      /"_*"
2624         JMP CL2S8
2625 CL2S9,  SEND;CL2M9      /"$_.SAVE "
2626         TAD I (OPIMAG;RAL /WAS AN IMAGE FILE NAME GIVEN?
2627         SMA CLA
2628         JMP CL2S10      /NO - USE DEFAULT
2629         TAD I (OPIMAG+1 /WAS A DEVICE GIVEN?
2630         SZA CLA
2631         JMP CL2S11      /YES
2632         TAD (0423       /"DS"
2633         DCA I (OPIMAG+1
2634         TAD (1300       /"K"
2635         DCA I (OPIMAG+2
2636 CL2S11, MOV6;OPIMAG+1;NAMELD
2637 CL2S12, OUTNAM;NAMELD
2638         TAD (215;OUT1
2639         JMP I CL2S
2640
2641 CL2S10, MOV6;CL2SN2;NAMELD
2642         DCA I (NAMCNT
2643         JMP CL2S12
2644
2645
2646 /$LOAD
2647 CL2,    BCLIN
2648         JMS CL2S
2649         TAD (DATL2      /$DATA DOES NOT DO LOAD
2650         DCA I (DATADR
2651         JMS I (BCLHU1;TEXFIN
2652
2653
2654 PAGE
2655 \fBCLBUF,        ZBLOCK 400      /SPACE FOR A WHOLE BUNCH OF CONTINUATION CARDS
2656 BCLSIZ=.-BCLBUF
2657 SAVARA, ZBLOCK 6^62     /SPACE FOR SAVED NAMES
2658 SAVTOP=.
2659 /OPTION LISTS
2660 CDEOPT, OPBAS;OPFOR;OPNOL;0     /$DECK
2661 CBAOPT, OPNOL;0                 /$BASIC
2662 CF4OPT, OPSRC;OPNOL;OPLIS;OPRALF;0      /$FORTRAN (F4)
2663 CL4OPT, OPIMAG;OPLIS;OPLIB;OPNOA;OPSSYM;0 /$LOAD (F4)
2664 CF2OPT, OPSRC;OPNOL;OPLIS;OPSABR;0 /$FORTRAN (F2)
2665 CL2OPT, OPINP;OPOPT;OPTWO;OPIMAG;OPLIS;OPLIB;OPNOA;0 /$LOAD (F2)
2666 /OPTIONS WITHOUT ASSOCIATED FILE NAME
2667 OPBAS,  0004;TEXT "BASIC"       /B
2668 OPFOR,  0006;TEXT "FORTRAN"     /F
2669 OPNOL,  0023;TEXT "NOLIST";*.-1 /NOL
2670 OPRALF, 0003;TEXT "RALF";*.-1   /R
2671 OPNOA,  0023;TEXT "NOAUTO";*.-1 /NOA
2672 OPSSYM, 0013;TEXT "SSYMB"       /SS
2673 OPSABR, 0012;TEXT "SABR";*.-1   /SA
2674 OPINP,  0013;TEXT "INPUT"       /IN
2675 OPOPT,  0023;TEXT "OUTPUT";*.-1 /OUT
2676 OPTWO,  0020;TEXT "TWO"         /TWO
2677 /OPTIONS WITH ASSOCIATED FILE NAME
2678 OPSRC,  1002;ZBLOCK 6;TEXT "SRC"        /S
2679 OPLIS,  1003;ZBLOCK 6;TEXT "LIST";*.-1  /L
2680 OPIMAG, 1013;ZBLOCK 6;TEXT "IMAGE"      /IM
2681 OPLIB,  1024;ZBLOCK 6;TEXT "LIBRARY"    /LIB
2682 /FILE NAMES
2683 NAME1,  ZBLOCK 6
2684 NAMELD, ZBLOCK 6
2685 BATOUT, ZBLOCK 6
2686 ZER6,   ZBLOCK 6
2687 BATTTY, TEXT "TTY@@@@@@@@@";*.-1
2688 BATLPT, TEXT "LPT@@@@@@@@@";*.-1
2689 CDEDEF, TEXT "@@@@DECK@@@@";*.-1
2690 CBATK,  TEXT "BAT@@@@@@@@@";*.-1
2691 CL4DEF, TEXT "@@@@PROG@@LD";*.-1
2692 FILNAM, TEXT "@@@@FIL@@@@@";*.-1
2693 CL2SN2, TEXT "DSK@PROG@@@@";*.-1
2694 /SPACE FOR DEVICE ASSIGNMENTS UNDER FORTRAN 4
2695 DEVASN, ZBLOCK 7^12
2696 /LISTS FOR ISIT
2697 CLIS1,  -"L;-"O;0
2698 CLIS2,  CL4SL;CL4SO
2699 DATIS1, DAT42   /"/"
2700         DAT43   /<CR>
2701 DATIS2, -"N;-"C;-"=;0
2702 DATIS3, DAT44;DAT45;DAT46
2703 DATIS5, DAT410;DAT410;DAT410
2704 OPTIS2, OPTIO8  /"="
2705         OPTIO9  /","
2706         OPTIO9  /"/"
2707         OPTIO9  /<CR>
2708
2709 OPTIS4, OPTI3A
2710         OPTRET
2711
2712 OPTIS1, -"=
2713 DATIS4,
2714 OUTIS1, -",
2715 OPTIS3,
2716 BCLIS1, -"/;-215
2717 /LIST MUST BE TERMINATED BY A POSITIVE WORD
2718         0
2719
2720 COLIS2, COLDEV  /":"
2721         COLFIL  /"."
2722         COLEXT  /"/"
2723         COLEXT  /","
2724         COLEXT  /<CR>
2725
2726
2727 COLIS1, -":;-".;-"/;-",;-215
2728 /TERMINATE LIST WITH POSITIVE WORD
2729         0
2730
2731 BCLIS2, BCLSQ2  /"/"
2732         BCLSQ3  /<CR>
2733
2734 OUTIS2, OUTER2  /","
2735         OUTER2  /"/"
2736         OUTER2  /<CR>
2737
2738 /LIST OF BCL ROUTINE ADDRESSES
2739 BCLGO,  BCLEOF  /FOR FINISHING UP BEFORE CLOSING FILE
2740         CBAS    /$BAS
2741 FORADR, CF4     /$FOR
2742 DATADR, DATX4   /$DATA
2743 LOAADR, CL4     /$LOAD
2744         CJOB    /$JOB
2745         CMSG    /$MSG
2746         CDECK   /$DECK
2747         CEOD    /$EOD
2748         CERR
2749         CERR
2750         CERR
2751         CERR
2752 /LIST OF BCL KEYWORDS
2753 BCLKEY, MBAS
2754         MFOR
2755         MDATA
2756         MLOAD
2757         MJOB
2758         MMSG
2759         MDECK
2760         MEOD
2761 /ERROR MESSAGES
2762 OPTERM, TEXT "?INVALID OPTION: /"
2763 COLERM, TEXT "?INVALID FILE SPECIFICATION - "
2764 BCL11E, TEXT "?_BCL LINE TOO LONG_"
2765 /MESSAGES
2766 BCLHM1, TEXT "?_"
2767 BCL10E, TEXT "_$"
2768 CF4M1,
2769 CF2M1,
2770 CDEM1,  TEXT ".R PIP_*"
2771 CDEM2,  TEXT "<BAT:_"
2772 CMEOD,  TEXT "$EOD_"
2773 CBAM1,  TEXT ".R PIP"
2774         *.-1
2775 CBAM7,  TEXT    "_*PROG.BA<"
2776 CBAM2,  TEXT "<PROG.BA"
2777         *.-1
2778 CBAM8,  TEXT    "_"
2779 CBAM3,  TEXT 'FILE #3:"DATA.DA"\FILEV #4:"'
2780 CBAM4,  TEXT '"_'
2781 CBAM5,  TEXT    "PROG.BA,"
2782 CBAM6,  TEXT    "BAT:,"
2783 PIPM1,  TEXT "/T"
2784 DTF4M1,
2785 DATBM1, TEXT ".R PIP_*DATA.DA<BAT:_"
2786 DATBM2, TEXT "$EOD_.R BCOMP_*PROG.BA_"
2787 CF2M2,
2788 CF4M2,  TEXT "BAT:_"
2789 CF4M3,  TEXT "$EOD_.R F4_*"
2790 CF4M4,  TEXT "/F"
2791 CL4SM1, TEXT ".R LOAD_*"
2792 CL4SM2, TEXT "<_*"
2793 CL2M7,
2794 CL4SM3, TEXT "/L_*"
2795 CL4SM4, TEXT "/C_*"
2796 CL4SM5, TEXT "/O"
2797 DTF4M3,
2798 CF2M4,
2799 CL2M6,
2800 CL4SM6, TEXT "_*"
2801 DTF4M5,
2802 CL4SM7, TEXT "$_"
2803 CL4SM8, TEXT "/S"
2804 DTF4M2, TEXT "$EOD_.R FRTS_*"
2805 DTF4M4, TEXT "/C"
2806 DTF4M6, TEXT "_*DATA.DA/4_*"
2807 DTF4M7, TEXT "/5"
2808 DTF4M8, TEXT "_*/5=4"
2809 DATNO1, TEXT "?NO PROGRAM TO RUN_"
2810 CF2M3,  TEXT "$EOD"
2811 CF2M5,  TEXT "_.R FORT_*"
2812 CL2M1,  TEXT ".R LOADER_*"
2813 CL2M1A, TEXT ".R LOADER_*GENIOX"
2814 CL2M3,  TEXT "/I"
2815 CL2M4,  TEXT "/O"
2816 CL2M5,  TEXT "/H"
2817 CL2M8,  TEXT "</M_*"
2818 CL2M9,  TEXT "$_.SAVE "
2819 DTF2M1, TEXT ".RUN "
2820 MBAS,   TEXT "$BASIC"
2821 MFOR,   TEXT "$FORTRAN"
2822 MJOB1,  TEXT ".R FOTP_*FIL???.*/D_"
2823 MEOD,   TEXT "$EOD"
2824 MJOB,   TEXT "$JOB"
2825 MMSG,   TEXT "$MSG"
2826 MDECK,  TEXT "$DECK"
2827 MLOAD,  TEXT "$LOAD"
2828 MDATA,  TEXT "$RUN"
2829 \f$