programs/fortran/src/frtn_5_of_5.asm

   1 *                       TAPE 5 OF 5 - BEGIN
   2 *
   3 WHOW    LDA     D0      (A)=NO. OF WORDS PER ITEM
   4         ALS     1       (A)=NO. OF CHARS, PER ITEM
   5         STA     NTID    NTID=NO. OF CHARS. TO BE OUTPUT
   6         SUB     HOLF
   7         SPL
   8         JMP     WERR
   9         LDA     ID      FIRST WORD
  10         JST     WSNG    OUTPUT IT
  11         LDA     ID+1    2ND WORD
  12         JST     WSNG    OUTPUT IT
  13         LDA     ID+2    3RD WORD
  14         JST     WSNG    OUTPUT IT
  15         LDA     ID+3    4TH WORD
  16         JST     OA00    OUTPUT IT
  17         JMP     W420    TO CHECK NEXT DATA
  18 *
  19 WSNG    PZE     0
  20         JST     OA00    OUTPUT (A)
  21         LDA     NTID    NO. OF CHARS, REMAINED TO BE OUTPUT
  22         SUB     K102
  23         STA     NTID    NTID=NTID-2
  24         SNZ
  25         JMP     W420    ALL FINISHED, CHECK NEXT ITEM
  26         JMP*    WSNG    SOME HOLLERITH CHARS,  REMAINED
  27 W403    LDA     TID+2   REAL OUTPUT
  28         JST     OA00
  29         LDA     TID+1
  30         JMP     W406
  31 W404    LDA     TID+2   DOUBLE PRECISION OUTPUT
  32         JST     OA00
  33         LDA     TID+1
  34         JST     OA00
  35 W405    LDA     TID     INTEGER OUTPUT
  36 W406    JST     OA00
  37         LDA     T0W4
  38         ERA     IM
  39         ANA     K105
  40         SNZ
  41         JMP     *+3
  42 *                            TO BE OUTPUT, RETURN
  43 WERR    JST     ER00
  44         BCI     1,DM    DATA AND DATA NAME MODE DO NOT AGREE
  45 W420    LDA     I
  46         SUB     K102
  47         STA     I       I = I-2
  48         CAS     KPRM
  49         NOP
  50         JMP     W4M     MORE TO DO
  51         SUB     G       TEST FOR COMPLETE
  52         SZE
  53         JMP     W4P
  54         LDA     K104
  55         JST     TS00
  56         LDA     T1W4
  57         STA     RPL
  58         JST     CH00    INPUT NEXT CHARACTER
  59         SUB     K5      ='254  (,)
  60         SZE             SKIP IF CHAR = COMMA
  61         JMP     A1      CHECK FOR  (CR)
  62         JMP     W4      PROCESS NEXT DATA GROUP
  63 W4P     LDA     K134
  64         JST     TS00
  65         JMP     W4E
  66 W4S     JST     FS00    FLUSH BUFFER IF NECESSARY
  67         LDA     AF      POSITION WITHIN COMMON BLOCK
  68         LRL     14
  69         LDA     K106    FORMAT BCD OUTPUT
  70         LGL     6
  71         LLL     6
  72         STA     OCI
  73         IAB
  74         ANA     K116
  75         STA     OCI+1
  76         JST     FL00    FETCH LINK
  77         LDA     DP+4,1
  78         SSM
  79         ALR     1
  80         SSM
  81         ARR     1
  82         LRL     8
  83         ERA     OCI+1
  84         STA     OCI+1
  85         LDA     DP+3,1
  86         IAB
  87         LDA     DP+4,1
  88         LLL     8
  89         STA     OCI+2
  90         LDA     DP+2,1
  91         IAB
  92         LDA     DP+3,1
  93         LLL     8
  94         STA     OCI+3
  95         LDA     DP+2,1
  96         LGL     2
  97         ADD     K103
  98         LGL     6
  99         STA     OCI+4
 100         LDA     K128
 101         STA     OCNT
 102         JST     STXI    I POINTS TO DATA TABLE
 103         LDA     DP-1,1  SET A TO VARIABLE
 104         STA     A
 105         JST     FA00
 106         JMP     W4O
 107 W4T     LDA     K101    =1  (=REL)
 108         IAB
 109         LDA     RPL
 110         JST     AF00    DEFINE AFT (AT=REL. AF=RPL)
 111         LDA     I       SET POINTER IN DATA POOL
 112         STA     0
 113         LDA     RPL
 114         STA     DP,1    DP(I) = RPL OF VARIABLE
 115         ADD     D0
 116         STA     RPL
 117         JMP     W4C
 118 *
 119 *
 120 *
 121 *             *********************************
 122 *             *BLOCK DATA SUBPROGRAM PROCESSOR*
 123 *             *********************************
 124 *          SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE
 125 R3      LDA     LSTF    =0 IF FIRST STATEMENT IN THE SUBPROGRAM
 126         SZE
 127         JMP     *+3
 128         JST     ER00    ERROR...NOT FIRST STATEMENT
 129         BCI     1,BL    'BLOCK DATA' NOT FIRST STATEMENT
 130         STA     BDF     SET BLOCK DATA FLAG ON (NON-ZERO)
 131         JST     CH00    INPUT NEXT CHARACTER
 132         JMP     A1      CHECK FOR (CR) AND EXIT
 133 *
 134 *
 135 *
 136 *
 137 *
 138 *
 139 *
 140 *             ***************************
 141 *             *TRACE STATEMENT PROCESSOR*
 142 *             ***************************
 143 *          SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG
 144 TRAC    JST     XN00    EXAMINE NEXT CHARACTER
 145         SZE             SKIP IF CHAR, WAS A DIGIT
 146         JMP     TRAD    JUMP IF CHAR. WAS A LETTER
 147         JST     IS00    INPUT STATEMENT NO.
 148         LDA     A       STATEMENT NO. POINTER
 149         STA     TRF     SET TRACE FLAG ON
 150         JMP     A1      TEST FOR (CR) AND EXIT
 151 *
 152 TRAD    JST     NA00    INPUT NAME
 153         JST     STXA    SET INDEX TO NAME ENTRY
 154         LDA     DP+4,1  TT(A)   TRACE TAG
 155         CHS
 156         STA     DP+4,1
 157         JMP     B1      (,) OR (CR) TEST
 158 *                            (RETURN TO TRAC IF (,)  )
 159 *
 160 *
 161 *
 162 *             ********************
 163 *             *OUTPUT OBJECT LINK*
 164 *             ********************
 165 OL00    DAC     **
 166         JST     CN00    CALL NAME
 167         CRA
 168         STA     DF      DF = 0
 169         LDA     ID      (A) = IP
 170         JST     OA00    OUTPUT +BS
 171 *
 172         JMP*    OL00
 173 *
 174 *             *****************
 175 *             *OUTPUT I/O LINK*
 176 *             *****************
 177 *          GENERATE I/O DRIVER LINKAGE CODE. NAME OF
 178 *               CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR
 179 *               IS A CONSTANT.
 180 OI00    DAC     **
 181         JST     IV00    INPUT INT VAR/CON
 182         LDA     NT
 183         SNZ             IF NT = 0
 184         JMP     OI20    GO TO 0I20
 185         LDA     ID      IF ID CR 9
 186         SUB     K126    G0 TU OI20
 187         SMI
 188         JMP     OI20
 189 *                           FORM F$RN OR F$WN
 190         LDA     NAMF+1
 191         ANA     K116
 192         ADD     ID
 193         ADD     K60     ='260  (SP)
 194         STA     NAMF+1
 195 OI10    JST     CN00    CALL NAME
 196         JMP*    OI00    RETURN
 197 OI20    LRL     32
 198         LDA     OMI7    OUTPUT OA
 199         JST     OB00    (LOAD A (UNIT N0.))
 200         JMP     OI10    FO TO OI10
 201 *
 202 *
 203 *             ***********
 204 *             *CALL NAME*
 205 *             ***********
 206 *          SET UP NAME AND GENERATE CODE FOR CALLING IT.
 207 CN00    DAC     **
 208         JST     FS00    FLUSH
 209         JST     PRSP    SET PRINT BUFFER TO SPACES
 210         LDA     K147    SET UP OCI FOR CALL
 211         STA     OCI
 212         LDA     NAMF+1  OCI = NAMF
 213         STA     PRI+9
 214         IAB             ALSO TO PRINT BUFFER
 215         LDA     NAMF
 216         STA     PRI+8
 217         LRL     8
 218         STA     OCI+1
 219         LLL     16
 220         STA     OCI+2
 221         LDA     NAMF+2
 222         STA     PRI+10
 223         IAB
 224         LDA     NAMF+1
 225         LLL     8
 226         STA     OCI+3
 227         LLL     16
 228         STA     OCI+4
 229         LDA     K128    ='14
 230         STA     OCNT    OCNT = 6
 231         LDA     CN90
 232         STA     PRI+5
 233         LDA     CN90+1
 234         STA     PRI+6
 235         LDA     RPL
 236         JST     OR80
 237         DAC     PRI
 238         SR2
 239         JMP     *+3     INHIBIT SYMBOLIC OUTPUT
 240         CALL    F4$SYM  OUTPUT SYMBOLIC LINE,
 241         DAC     PRI
 242         IRS     RPL     RPL = RPL + 1
 243         JST     PRSP    SET PRINT BUFFER TO SPACES
 244         JST     FS00    FLUSH
 245         JMP*    CN00    RETURN
 246 K147    OCT     55000
 247 CN90    BCI     2,CALL
 248 *             *************
 249 *             *OUTPUT PACK*
 250 *             *************
 251 *          OUTPUT THE PACK WORD WHEN IT IS FULL.
 252 PKF     PZE     0       PACK FLAG
 253 T0OK    PZE     0
 254 OK00    DAC     **
 255         CAS     CRET    IF (A) = C/R
 256         JMP     *+2
 257         JMP     OK30    GO TO OK30
 258         IRS     PKF     PKF = PKF + 1
 259         JMP     OK20    IF NON-ZERO, GO TO OK20
 260 OK10    ADD     T0OK    (A) = (A) + T0
 261         LRL     16
 262         STA     DF
 263         IAB
 264         JST     OA00    OUTPUT ABS
 265         JMP*    OK00
 266 OK20    LGL     8
 267         STA     T0OK
 268         LDA     K123    PKF = - 1
 269         STA     PKF
 270         JMP*    OK00    RETURN
 271 OK30    LDA     PKF     IF PKF = 0
 272         SNZ
 273         JMP*    OK00    RETURN
 274         LDA     K8      ELSE (A) = SPACE,
 275         STA     PKF
 276         JMP     OK10    GO TO OK10
 277 *
 278 *
 279 *              ***********
 280 *              *OUTPUT OA*
 281 *              ***********
 282 *           GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST
 283 *                THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY,
 284 *                EXTERNAL, RELATIVE, ABSOLUTE OR STRING
 285 *                REFERENCES PROPERLY.
 286 T1OB    PZE     0
 287 OB00    DAC     **
 288         STA     FTOP    FTOP = (A)
 289         IAB
 290         STA     T1OB
 291         JST     STXA    ESTABLISH A
 292         SNZ             IF A = 0
 293         JMP     OB08    GO TO OB08
 294         JST     FA00    FETCH ASSIGNS
 295         LDA     SOF     SPECIAL OUTPUT FLAT
 296         SZE
 297         JMP     OB60    SUBSCRIPT CONSTANT DEFLECTION
 298         LDA     AF
 299         STA     T1OB    T0 = AF
 300         LDA     AT
 301         SUB     K105    IF AT = 'DUM'
 302         SNZ
 303         JMP     OB15    GO TO OB15
 304         LDA     IU
 305         SUB     K101    IF IU = 'SUB'
 306         SNZ
 307         JMP     OB40    GO TO OB40
 308 OB06    LDA     AT
 309         CAS     K104    IF AT = 'COM'
 310         JMP     *+2
 311         JMP     OB20    GO TO OB20
 312         CAS     K101
 313         JMP     *+2     IF AT = 'REL'
 314         JMP     OB10    GO TO OB10
 315         LDA     K103
 316         IAB
 317         LDA     RPL
 318         JST     AF00    DEFINE AF AND AT
 319         LDA     AT      IF AT = 'STR-RE'
 320         SUB     K103
 321         SNZ
 322         JMP     OB10    GO TO OB10
 323         CRA
 324         STA     AF      AF = 0
 325 OB08    LDA     K102
 326         STA     DF      SET FLAG TO OUTPUT SYMBOLIC
 327         LDA     FTOP
 328         JST     OA00    OUTPUT ABSOLUTE
 329         JMP*    OB00    RETURN
 330 OB10    LDA     T1OB
 331         STA     AF
 332         LDA     FTOP
 333         JST     OR00    OUTPUT REL
 334         JMP*    OB00    RETURN
 335 OB15    LDA     FTOP
 336         CHS             REVERSE INDIRECT BIT
 337         STA     FTOP
 338         JMP     OB10    GO TO OB10
 339 OB20    JST     FS00    OUTPUT COMMON REOUEST
 340         LDA     T1OB    PACK ADDRESS INTO BLOCK
 341         LRL     14
 342         LDA     FTOP
 343         LGR     10
 344         ADD     K150
 345         LLL     6
 346         STA     OCI
 347         LLL     8
 348         STA     OCI+1
 349         JST     SAV
 350         JST     FL00
 351         LDA     DP+2,1
 352         STA     PRI+13  SET COMMON NAME INTO PRINT BUFFER
 353         LLR     8
 354         STA     OCI+4
 355         LLL     8
 356         LDA     DP+3,1
 357         STA     PRI+12  SET COMMON NAME INTO PRINT BUFFER
 358         LLR     8
 359         STA     OCI+3
 360         LLL     8
 361         LDA     DP+4,1
 362         ANA     K111    ='037777
 363         CAS     *+1     LOOK FOR BLANK COMMON
 364         OCT     020240
 365         ERA     K122
 366         ERA     HBIT
 367         STA     PRI+11  SET NAME INTO PRINT BUFFER
 368         LLR     8
 369         STA     OCI+2
 370         LLL     8
 371         LDA     OCI+1
 372         LLL     8
 373         STA     OCI+1
 374         LDA     K128    ='14
 375         STA     OCNT
 376         JST     RST
 377         LDA     0
 378         STA     A       RESTORE A TO POINT AT NAME
 379         LDA     RPL     SET RPL MINUS
 380         SSM             TO DISABLE WORD OUTPUT
 381         STA     RPL
 382         LDA     FTOP    OUTPUT WORD TO LIST
 383         JST     OR00    SYMBOLIC COMMAND
 384         LDA     RPL     RESTORE AND
 385         SSP             INCREMENT PROGRAM
 386         AOA             COUNTER FOR COMMON
 387         STA     RPL     OUTPUT
 388         JST     FS00    CLOSE OUT BLOCK
 389         JMP*    OB00    EXIT
 390 OB30    LDA     DP+4,1
 391         SSM
 392         ALR     1
 393         SSM
 394         ARR     1
 395         STA     NAMF
 396         LDA     DP+3,1
 397         STA     NAMF+1
 398         LDA     DP+2,1
 399         STA     NAMF+2
 400         JST     CN00
 401         JMP*    OB00
 402 OB40    LDA     AT
 403         SUB     K102
 404         SNZ
 405         JMP     OB30
 406         JMP     OB06
 407 OB50    OCT     140000
 408 *
 409 OB60    CRA
 410         STA     SOF     RESET SPECIAL OUTPUT FLAG
 411         LDA     AT      ADDRESS TYPE
 412         CAS     K105    TEST FOR DUMMY
 413         JMP     OB06    PROCESS NORMALLY
 414         JMP     OB61
 415         JMP     OB06    PROCESS NORMALLY
 416 OB61    LDA     T1OB
 417         STA     FTOP
 418         CRA
 419         JMP     OB08+1
 420 *
 421 K150    OCT     700
 422 *
 423 *
 424 *             **************
 425 *             OUTPUT TRIADS*
 426 *             **************
 427 *          PROCESSES THE TRIAD TABLE, HANDLES FETCH
 428 *               GENERATION AND RELATIONAL OPERATOR CODE
 429 *               GENERATION, DRIVES OUTPUT ITEM. ASSIGNS
 430 *               AND OUTPUT TEMP STORES.
 431 T0OT    PZE     0
 432 T2OT    PZE     0
 433 T1OT    PZE     0
 434 T3OT    PZE     0       TEMP STORE FOR P
 435 OT00    DAC     **
 436         JST     SAV
 437         LDA     L0
 438         STA     I       I = L0
 439         CRA
 440         STA     T0OT    T0 = 0
 441         STA     IFLG
 442 OT06    STA     T1OT    T1 = I
 443 OT10    LDA     I
 444         SUB     K103    I = I-3
 445         STA     I
 446         STA     T2OT    T2 = I
 447         SUB     L
 448         SPL
 449         JMP     OT60    IF FINISHED, GO TO OT60
 450         JST     STXI
 451         LDA     DP+2,1
 452         SSP             CHECK P (I)
 453         CAS     K139    X
 454         JMP     *+2
 455         JMP     OT10
 456         CAS     K138    H
 457         JMP     *+2
 458         JMP     OT10
 459         CAS     K142    I
 460         JMP     *+2
 461         JMP     OT50
 462         CAS     K143    T
 463         JMP     *+2
 464         JMP     OT40
 465         CAS     K151    Q
 466         JMP     *+2
 467         JMP     OT35
 468         STA     T3OT    SAVE P
 469         LDA     DP+1,1
 470         STA     A       A = O1(I)
 471         CAS     T1OT
 472         JMP     *+2
 473         JMP     OT30
 474         CAS     L0
 475         JMP     OT16
 476         JMP     OT99    MAYBE SPECIAL LOAD FOR (A=) STATEMENT
 477         JMP     OT16
 478 OT18    JST     STXI
 479         LDA     DP,1
 480         STA     A       A = O2 (I)
 481         LDA     DP+2,1
 482         SSP
 483         JST     OM00    OUTPUT ITEM(P(I),A = 02(I))
 484 OT22    JST     STXI
 485         LDA     DP+2,1
 486         SMI
 487         JMP     OT28
 488         CRA             ASSIGN TEMP STOR
 489         STA     NT      NT = 0
 490         LDA     K102
 491         STA     IU      IU = VAR
 492         LDA     T0OT
 493         LRL     6
 494         LDA     TCF     ID =
 495         LRL     3       TS-IM-TCF-T0
 496         LDA     MFL
 497         STA     IM
 498         LLL     9
 499         JST     OR80
 500         DAC     ID
 501         LDA     K77
 502         STA     ID
 503         IRS     T0OT    T0 = T0+1
 504         JST     AS00    ASSIGN ITEM
 505         JST     STXI
 506         LDA     A
 507         STA     DP,1    O2(I) = A
 508         LDA     K153
 509         SSM             SURPRESS TRACE OF TEMPORARY STORAGE
 510         JST     OM00    OUTPUT ITEM (=,A)
 511 OT28    LDA     I
 512         JMP     OT06
 513 OT30    JST     STXA
 514         LDA     DP+2,1
 515         SSP             IF P (A) = 0
 516         SZE
 517         JMP     OT32
 518 OT16    LDA     K152    GENERATE FETCH
 519         JST     OM00    OUTPUT ITEM
 520 OT32    LDA     T3OT    CHECK FOR RELATIONALS
 521         SUB     K125    ='10
 522         SPL
 523         JMP     OT18    NOT LOGICAL OR6RATOR
 524         SUB     K106    =6
 525         SMI
 526         JMP     OT18    NOT A LOGICAL QPERATOR
 527         STA     0       SET INDEX = -1 TO -6
 528         LDA     K103    =3 (LOG)
 529         STA     MFL     SET MODE TO LOGICAL
 530         CRA
 531         STA     A       SET FOR OCTAL ADDRESS
 532         JMP     *+7,1   BRANCH TO OPERATOR PROCESSOR
 533         JMP     OT3G    .LT.
 534         JMP     OT3E    .LE.
 535         JMP     OT3C    .EQ.
 536         JMP     OT3B    .GE.
 537         JMP     OT3A    .GT.
 538         LDA     OMJ4    .NE.  =ALS 16
 539         JST     OA00    OUTPUT ABSOLUTE
 540         LDA     OMJ6    =ACA
 541         JMP     OT3D
 542 OT3A    LDA     OMJ7    *TCA
 543         JMP     OT3F
 544 OT3B    LDA     OMK1    =CMA
 545         JMP     OT3F
 546 OT3C    LDA     OMJ4    = ALS 16
 547         JST     OA00
 548         LDA     OMK2    =SSC
 549         JST     OA00    OUTPUT ABSOLUTE
 550         LDA     OMK3    =AOA
 551 OT3D    JST     OA00    OUTPUT ABSOLUTE
 552         JMP     OT22
 553 OT3E    LDA     OMJ2    =SNZ
 554         JST     OA00    OUTPUT ABSOLUTE
 555         LDA     OMK4    =SSM
 556 OT3F    JST     OA00    OUTPUT ABSOLUTE
 557 OT3G    LDA     OMJ5    =LGR 15
 558         JMP     OT3D
 559 *
 560 OT35    LDA     DP+1,1
 561         STA     ID
 562         JST     NF00
 563         LDA     K78     NAMF = F $AR
 564         STA     NAMF+1
 565         JST     OL00    OUTPUT OBJECT LINK
 566         JMP     OT18    GO TO OT18
 567 OT40    LDA     DP,1
 568         ADD     DO
 569         STA     I       I = 02 (I) + DO
 570         JST     DQ00    DO TERMINATION
 571 OT45    LDA     T2OT
 572         STA     I       I = T2
 573         JMP     OT28
 574 OT50    LDA     DP,1
 575         ADD     DO      I=O2(I)+DO
 576         STA     I       IF I = DO
 577         SUB     DO
 578         SZE             GO TO OT45
 579         JST     DS00    DO INITIALIZE
 580         JMP     OT45    GO TO OT45
 581 OT60    JST     RST
 582         LDA     L0      RESET TRIAD TABLE
 583         STA     L
 584         JMP*    OT00
 585 *
 586 OT99    LDA     T3OT
 587         SUB     K153    CODE FOR =
 588         SZE
 589         JMP     OT16    NOT SPECIAL LOAD
 590         STA     MFL     SPECIAL LOAD, SET MFL=0
 591         JMP     OT18    OUTPUT A STORE
 592 K77     BCI     1,T$    T$
 593 K78     BCI     1,AR    AR
 594 K142    OCT     27
 595 K143    OCT     30
 596 K151    OCT     32
 597 K152    OCT     31
 598 *             *************
 599 *             *OUTPUT ITEM*
 600 *             *************
 601 *
 602 *          DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL
 603 *               SUBSCRIPT PROCESSING, GENERATES NECESSARY
 604 *               MODE CONVERSION CALLS AND HANDLES MODE
 605 *               CHECKING. IN-LINE ARITHMETIC CODE IS
 606 *               GENERATED WHERE POSSIBLE. OTHERWISE CALLS
 607 *               TO ARITHMETIC ROUTINES ARE GENERATED.
 608 *
 609 T0OM    PZE     0
 610 T1OM    PZE     0
 611 T2OM    PZE     0
 612 T8OM    PZE     0
 613 T9OM    PZE     0
 614 TXOM    PZE     0
 615 *
 616 *-------------OUTPUT ITEM
 617 OM00    DAC     **      RETURN ADDR
 618         STA     T8OM
 619         SSP
 620         STA     T0OM    R(0)=(A)='P' CODE
 621         CAS     K134
 622         JMP     *+2
 623         JMP     OMD1
 624         LDA     TXOM
 625         CAS     K101
 626         JMP     OME1
 627         JMP     OME5
 628 OM05    CRA
 629         STA     T1OM    T(1)=0
 630         STA     T9OM    T(9)=0
 631         LDA     A
 632         STA     T2OM    T(2)=A
 633         SZE
 634         JMP     OM07
 635         LDA     MFL
 636         JMP     OM13
 637 OM07    CAS     L0
 638         JMP     *+2
 639         JMP     OML1
 640         CAS     ABAR
 641         JMP     OM76    A .LE. ABAR....WITHIN TRIAD TABLE
 642         JMP     *+1
 643 OM10    JST     STXA    SET INDEX=A
 644         LDA     DP,1
 645         ARS     9       SES IM=MODE OF ITEM
 646         ANA     K107
 647 OM13    STA     IM
 648 OM14    LDA     MFL     SET MFL,IM AS DIGITS INTO NAMF
 649         ALS     8
 650         ADD     IM
 651         ERA     OM90    ADD '0''0'
 652         STA     NAMF+1
 653         LDA     K130
 654         STA     0       INDEX=-6
 655         LDA     T0OM
 656         CAS     OM50+6,1        CHECK FOR SPECIAL OPERATOR
 657         JMP     *+2     '1
 658         JMP*    OM52+6,1        'P'='Q',',','0','A'F', OR 'E'
 659         IRS     0
 660         JMP     *-4
 661         LDA     MFL
 662         SNZ
 663         JMP     OM62    SPECIAL LIBRARY FIX FOR  (  A=  )
 664         CAS     IM      CHECK FOR MODE MIXING
 665         JMP     *+2
 666         JMP     OMA1    ITEM MODE SAME AS CURRENT MODE
 667 OM20    LDA     K103
 668         JST     OM44    CHECK MODE FOR LOG
 669         LDA     K102    =2  (MODE CODE FOR REAL)
 670         CAS     MFL     MODE OF EXPRESSION
 671         JMP     *+2
 672         JMP     OM26    IF MODE=REAL, ALLOW COMPLEX MODE MIXING
 673         CAS     IM      MODE OF ITEM
 674         JMP     *+2
 675         JMP     OM26    IF MODE=REAL, ALLOW COMPLEX MODE MIXING
 676         LDA     K105
 677         JST     OM44    TEST FOR MODE = COMPLEX
 678 OM26    LDA     T0OM    OPERATOR BEING PROCESSED
 679         CAS     K153
 680         JMP     *+2
 681         JMP     OM36    T(0)='=' (ALLOW INTEGER MODE)
 682         LDA     K101
 683         JST     OM44    TEST FOR MODE=INTEGER
 684         LDA     IM
 685         CAS     MFL
 686         JMP     OM38    CONVERT MODE OF ACCUMULATOR
 687         JMP     *+1
 688 OM30    JST     NF00    SET LBUF+2 TO SPACES
 689         LDA     T0OM
 690         STA     0
 691         LDA     A9X4,1  PICK-UP PRINT CODE FOR 'P' OPERATOR
 692         ARS     6
 693         ANA     K100    ='377
 694         SNZ
 695         JMP     OM46    MODE MIXING ERROR
 696         LGL     8
 697         ERA     OM91    ADD '$'
 698         STA     NAMF
 699         LDA     K134
 700         STA     T0OM    T(0)=','
 701         JMP     OM40
 702 *
 703 OM36    LDA     K105
 704         JST     OM44    CHECK FOR MODE=COMPLEX
 705 OM38    LDA     IM
 706         STA     MFL
 707         JST     NF00    SET LBUF+2 TO SPACES
 708         LDA     OM92    'C$'
 709         STA     NAMF
 710 OM40    JST     CN00    OUTPUT....CALL NAMF
 711         LDA     MFL
 712         STA     IM      SET ITEM MODE TO CURRENT MODE
 713         LDA     NAMF
 714         CAS     OM96
 715         JMP     OM14
 716         JMP*    OM00
 717         JMP     OM14    OUTPUT ARGUMENT ADDRESS
 718 *
 719 *-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES,
 720 OM44    DAC     **      RETURN ADDR,
 721         CAS     IM      CHECK FOR IM0(A)
 722         JMP     *+2
 723         JMP     OM46    ERROR
 724         CAS     MFL     CHECK FOR MFL=(A)
 725         JMP*    OM44
 726         JMP     OM46    ERROR
 727         JMP*    OM44
 728 OM46    JST     ER00    NON-RECOVERABLE ERROR......
 729         BCI     1,MM    MODE MIXING ERROR
 730 *
 731 *------SPECIAL 'P' OPERATOR TABLE
 732 OM50    OCT     32      'Q'
 733         OCT     17      ','
 734         OCT     00      '0'
 735         OCT     22      'A'
 736         OCT     31      *F'
 737         OCT     20      'E'
 738 OM52    DAC     OMB3    ('Q')
 739         DAC     OMB3    (',')
 740         DAC     OMB3    ('0')
 741         DAC     OM56    ('A')
 742         DAC     OM60    ('F')
 743         DAC     OM70    ('E')
 744 *
 745 *
 746 OM56    LDA     OMI1    SET T(1) = ADD*
 747         JMP     OMB1
 748 *
 749 OM60    JST     STXA    SET INDEX = A
 750         LDA     DP+1,1
 751         LGR     14      SET UV=IU(A)
 752         STA     IU
 753         JST     STXI    SET INDEX=I
 754         LDA     DP+2,1  P(I)
 755         ANA     K133    ='77
 756         SNZ
 757         JMP     OM64    (POSSIBLE DUMMY ARRAY FETCH)
 758 OM62    LDA     IM
 759         STA     MFL     SET CURRENT MODE TO ITEM MODE
 760         LGL     8
 761         ADD     IM
 762         ERA     OM90
 763         STA     NAMF+1
 764         LDA     IU
 765         SUB     K101    CHECK FOR IU=1 (SUBROUTINE)
 766         SZE
 767         JMP     OMA1
 768         LDA     OMI2    SET T(1) = JST
 769         JMP     OM66
 770 OM64    LDA     IU
 771         SUB     K103    CHECK FOR IV=3 (ARRAY)
 772         SZE
 773         JMP     OM62
 774         LDA     K101    SET CURRENT MODE TO INTEGER
 775         STA     MFL
 776         LDA     OMI3    SET T(1) = LDA*
 777 OM66    STA     T1OM
 778         JMP     OMB3
 779 *
 780 OM70    LDA     K101
 781         CAS     IM      CHECK ITEM MODE EQUALS INTEGER
 782         JMP     *+2
 783         JMP     OM74
 784         LDA     K105    CHECK FOR MODE = COMPLEX
 785         JST     OM44
 786         JMP     OM20
 787 OM74    LDA     K103                CHECK FOR MODE = LOGICAL
 788         JST     OM44
 789         JMP     OM30    OUTPUT SUBROUTINE CALL
 790 *
 791 OM76    JST     STXA    INDEX=A
 792         LDA     DP,1    02(A)
 793         STA     T2OM    T(2)=02(A)
 794         LDA     DP+2,1  P(A)
 795         ANA     K133    ='77
 796         SNZ
 797         JMP     OM84    P(A)='0' (SUBSCRIPTED VARIABLE)
 798         CAS     K139
 799         JMP     *+2
 800         JMP     OM80    P(A) = 'X' (END OF ARRAY CALCULATION)
 801         CAS     K138
 802         JMP     *+2
 803         JMP     OMHW
 804 OM78    LDA     T2OM    P(4)= 'H' (HOLLERITH DATA)
 805         STA     A       RESET A
 806         JMP     OM10
 807 *
 808 OM80    JST     STXI    INDEX=I
 809         LDA     T2OM
 810         STA     DP+1,1  O1(I) = T(2)
 811         CRA
 812         STA     T1OT    SET T(1) OF OUTPUT TRIADS TO ZERO
 813         LDA     A       SAVE A
 814         STA     T1OM
 815         CRA             SET A=0  (NOT SYMBOLIC)
 816         STA     A
 817         LDA     RPL
 818         ADD     K102    AF = RPL+ 2
 819         STA     AF
 820         LDA     OMI4    =ADD INSTRUCTION
 821         JST     OR00    OUTPUT RELATIVE
 822         LDA     RPL
 823         ADD     K102    AF = RPL P+ 2
 824         STA     AF
 825         LDA     OMI5    = JMP INSTR,
 826         JST     OR00    OUTPUT RELATIVE
 827         LDA     T1OM
 828         STA     A       RESTORE A
 829         STA     SOF     SET SPECIAL OUTPUT FLAG TO NON-ZERO
 830         CRA             = DAC INSTR.
 831         STA     T1OM
 832         LDA     K101
 833         STA     AT
 834         JMP     OM88
 835 OM84    LDA     DP+1,1  O1(A)
 836         STA     A       A=O1(A)
 837         CAS     L0
 838         JMP     *+2
 839         JMP     OM86    A=L(0)....CONSTANT SUBSCRIPT ONLY
 840         LDA     OMI0    T(1) = INDIRECT BIT
 841         STA     T1OM
 842         JMP     OM10
 843 *
 844 OM86    LDA     T2OM    A=T(2)
 845         STA     A
 846         STA     0
 847         STA     SOF
 848         LDA     DP,1    T(2) = 02(A)
 849         STA     T2OM
 850 OM88    JST     STXA    INDEX=A
 851         LDA     DP+1,1  O1(A)
 852         STA     T9OM    T(9)=O1(A)
 853         JMP     OM78
 854 OMHW    LDA     T2OM
 855         STA     AF
 856         CRA
 857         STA     A
 858         JST     OR00
 859         JMP*    OM00
 860 *
 861 OM90    OCT     130260  '00'
 862 OM91    OCT     000244  ' $'
 863 OM92    OCT     141644  'C$'
 864 OM93    OCT     152322  'TR'
 865 OM94    OCT     000021  'C' CODE
 866 OM95    OCT     017777  (MASK)
 867 OM96    BCI     1,N$
 868 OM97    BCI     1,-1
 869 *
 870 OMA1    LDA     IM      CHECK FOR IM=LOGICAL
 871         CAS     K103
 872         JMP     *+2
 873         JMP     OMC1    IM=LOGICAL
 874         CAS     K101    CHECK FOR IM=INTEGER
 875         JMP     *+2
 876         JMP     OMA3    IM=INTEGER
 877         JMP     OM30
 878 *
 879 OMA3    LDA     T0OM    CHECK FOR T,0) = '+'
 880         CAS     K103    =3
 881         JMP     *+2
 882         JMP     OMA4    T(0)= '*'
 883         CAS     OM94    T(0) = 'C
 884         JMP     *+2
 885         JMP     OMA6    OUTPUT 'TCA'
 886         CAS     K101
 887         JMP     OMA5
 888         LDA     OMI4    =ADD INSTR.
 889         JMP     OMB1
 890 OMA4    LDA     T2OM    VALUE OF A
 891         SUB     K126    ='12  KNOWN LOCATION OF A FOR 2
 892         SZE             SMP IF MULTIPLIER IS A CONSTANT OF 2
 893         JMP     OM30    COUPLE TO THE MULTIPLY SUBROUTINE
 894         STA     A       SET A AND AF TO ZERO (FOR LISTING FLAGS)
 895         STA     AF
 896         LDA     *+3     ALS 1  INSTRUCTION
 897         JST     OA00    OUTPUT ABSOLUTE
 898         JMP*    OM00    EXIT UUTPUT ITEM
 899         ALS     1       (INSTRUCTION TO BE OUTPUT)
 900 OMA5    CAS     K102    CHECK FOR T(0) = '-'
 901         JMP     OMA7
 902         LDA     OMI6    =SUB INSTR,
 903         JMP     OMB1
 904 OMA6    CRA
 905         STA     A       CAUSE OCTAL ADDR LISTING
 906         STA     AF
 907         LDA     *+3     TCA
 908         JST     OA00    OUTPUT ABSOLUTE
 909         JMP*    OM00    EXIT
 910         TCA
 911 OMA7    CAS     K153    CHECK FOR T(0) = '='
 912         JMP     *+2
 913         JMP     OMA9    OUTPUT A STA INSTR,
 914         SUB     K152    CHECK FOR T(0) = 'F'
 915         SZE
 916         JMP     OM30
 917 OMA8    LDA     OMI7    =LDA INSTR,
 918         JMP     OMB1
 919 OMA9    LDA     OMI8    =STA INSTR,
 920 OMB1    ADD     T1OM    T(1) = T(1) + INSTR.
 921         STA     T1OM
 922 OMB3    LDA     T2OM    SET A=T(2)
 923         STA     A
 924         LDA     T9OM    OUTPUT INSTR. WITH T(1) AND T(9)
 925         IAB
 926         LDA     T1OM
 927         JST     OB00    OUTPUT OA
 928         LDA     T8OM    CHECK FOR T(8) = '='
 929         CAS     K153    ='16
 930         JMP*    OM00
 931         JMP     *+2
 932         JMP*    OM00    EXIT
 933         LDA     TRFA    POINTER TO FIRST VARIABLE OR ARRAY
 934         STA     A       PROCESSED IN EXPRESSION
 935         JST     TRSE    OUTPUT TRACE COUPLING IF REQUIRED
 936         JMP*    OM00    EXIT OUTPUT ITEM
 937 *
 938 *
 939 OMC1    LDA     T0OM
 940         CAS     K152    CHECK FOR T(0) = 'F'
 941         JMP     *+2
 942         JMP     OMA8    OUTPUT A LDA INSTR.
 943         CAS     K153    CHECK FOR T(0) = '='
 944         JMP     *+2
 945         JMP     OMA9    OUTPUT A STA INSTR,
 946         CAS     OM94    CHECK FOR T(0) = 'C'
 947         JMP     *+2
 948         JMP     OM30    OUTPUT COMPLEMENT CODING
 949         CAS     K106
 950         JMP     *+2
 951         JMP     OMC5    OUTPUT AN ANA INSTR.
 952         CAS     K107
 953         JMP     OM46    ERROR
 954         JMP     OM30
 955         JMP     OM46    ERR0R
 956 OMC5    LDA     OMI9    =ANA INSTR.
 957         JMP     OMB1
 958 OMD1    IRS     TXOM    T0 = T0+1
 959         JMP     OM05
 960 OME1    CRA
 961         STA     DF      DF = 0
 962         JST     OA00    OUTPUT ABSOLUTE
 963 OME5    CRA
 964         STA     TXOM    T0 = 0
 965         JMP     OM05
 966 *
 967 TRSE    DAC     0       SUBROUTINE TO OUTPUT TRACE COUPLING
 968         JST     STXA    SET INDEX = A
 969         SZE
 970         LDA     DP+4,1  CHECK STATUS OF TRACE TAG
 971         SPL
 972         JMP     TRS7
 973         SR4
 974         JMP     TRS7
 975         LDA     TRF     CHECK STATUS OF TRACE FLAG
 976         SNZ
 977         JMP*    TRSE
 978 TRS7    JST     NF00    SET LBUF TO 'F$', LSUF+2 TO SPACES
 979         LDA     OM93    ='TR'
 980         STA     NAMF+1
 981         JST     CN00    OUTPUT.....CALL NAMF
 982         JST     STXA    SET INDEX = A
 983         LDA     DP+4,1
 984         ANA     OM95
 985         STA     T1OM
 986         LDA     DP+3,1
 987         STA     T8OM
 988         LDA     DP+2,1
 989         STA     T9OM
 990         CRA
 991         STA     DF
 992         LDA     DP,1    MERGE IM WITH ITEM NAME
 993         ARS     9
 994         LGL     13
 995         ERA     T1OM
 996         JST     OA00    OUTPUT ABSOLUTE (FIRST 2 CHAR.)
 997         LDA     T8OM
 998         JST     OA00    OUTPUT ABSOLUTE (NEXT 2 CHAR.)
 999         LDA     T9OM
1000         JST     OA00    OUTPUT ABSOLUTE (LAST 2 CHAR.)
1001         JMP*    TRSE
1002 *
1003 *.................INSTRUCTION TABLE
1004 OMI0    OCT     100000  INDIRECT BIT
1005 OMI1    OCT     114000  ADD*
1006 OMI2    OCT     020000  JST
1007 OMI3    OCT     104000  LDA*
1008 OMI4    OCT     014000  ADD
1009 OMI5    OCT     002000  JMP
1010 OMI6    OCT     016000  SUB
1011 OMI7    OCT     004000  LDA
1012 OMI8    OCT     010000  STA
1013 OMI9    OCT     006000  ANA
1014 OMJ1    OCT     102000  JMP*
1015 OMJ2    OCT     101040  SNZ
1016 OMJ3    OCT     101400  SMI
1017 OMJ4    ALS     16
1018 OMJ5    OCT     040461  LGR 15
1019 OMJ6    OCT     141216  ACA
1020 OMJ7    OCT     140407  TCA
1021 OMK1    OCT     140401  CMA
1022 OMK2    OCT     101001  SSC
1023 OMK3    OCT     141206  AOA
1024 OMK4    OCT     140500  SSM
1025 OMK5    OCT     042000  JMP 0,1
1026 OMK6    OCT     000000  DAC **
1027         ALS     1       ALS1
1028         TCA             TCA
1029 OMK7    OCT     176000  STG
1030 OMK9    CAS     0       CAS
1031         STA*    0
1032         SUB*    0
1033         DAC*    **
1034         OCT     131001
1035         OCT     030000  SUBR
1036         CAS*    0
1037 OMK8    OCT     0       (///)
1038 OML1    LDA     K101
1039         STA     AT
1040         JMP     OT10
1041 *
1042 *             ************
1043 *             *OUTPUT REL*
1044 *             ************
1045 *          ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT.
1046 OR00    DAC     **
1047         STA     FTOP
1048         LDA     K102    DF = NON ZER0
1049         STA     DF      CODE = 2
1050 OR10    STA     CODE
1051         LDA     RPL     LIST RPL
1052         SSP
1053         JST     OR80
1054         DAC     PRI
1055 OR12    LDA     DF      IF DF NOT ZERO
1056         SZE
1057         JMP     OR20    GO TO OR20
1058         LDA     OR18    ='147703
1059         STA     PRI+5
1060         LDA     OR19    SET 'OCT' INTO PRINT IMAGE
1061         STA     PRI+6
1062         LDA     FTOP
1063 OR13    JST     OR80
1064         DAC     PRI+8
1065 OR15    LDA     RPL     IF RPL PLUS
1066         SMI
1067         JST     OW00    OUTPUT WORD
1068         SR2
1069         JMP     *+3     SURPRESS SYMBOLIC OUTPUT
1070         CALL    F4$SYM  LIST LINE
1071         DAC     PRI
1072         JST     PRSP    SET PRINT BUFFER TO SPACES
1073         JMP*    OR00    RETURN
1074 OR18    OCT     147703  (0)(C)
1075 OR19    OCT     152240  (T)(SP)
1076 OR20    JST     SAV
1077         LDA     OR90    SEARCH OP-CODE LIST
1078         TCA
1079         STA     XR      PUT BCI IN PRINT IMAGE
1080         LDA     FTOP
1081         SSP
1082         SZE
1083         JMP     OR24
1084         LDA     AT
1085         CAS     K103
1086         SUB     K106
1087         ADD     K102
1088         CMA
1089         ANA     K107
1090         STA     CODE
1091 OR24    LDA     FTOP
1092         CAS     OR91+NINS,1
1093         JMP     *+2
1094         JMP     *+3
1095         IRS     XR
1096         JMP     *-4
1097         LDA     OR92+NINS,1
1098         STA     PRI+5
1099         LDA     OR93+NINS,1
1100         STA     PRI+6
1101         JST     RST
1102         LDA     A
1103         SZE
1104         JMP     OR30
1105         LDA     AF
1106         ANA     K111    MASK OUT HIGH BITS OF ADDRESS
1107         JMP     OR13
1108 OR30    JST     STXA
1109         LDA     DP,1
1110         SMI
1111         JMP     OR40
1112         LDA     K149
1113         STA     PRI+8   SET =' INTO LISTING
1114         LDA     DP,1    CHECK IM (A)
1115         LGL     4
1116         SPL             SKIP IF NOT COMPLEX
1117         JMP     *+4
1118         LGL     2
1119         SPL             SKIP IF INTEGER OR LOGICAL
1120         JMP     *+3
1121         LDA     DP+2,1
1122         JMP     *+2     LIST EXPONENT AND PART OF FRACTION
1123         LDA     DP+4,1  LIST INTEGER VALUE
1124         JST     OR80    CONVERT OCTAL
1125         DAC     PRI+9
1126         JMP     OR15
1127 OR40    LDA     DP+4,1  CONVERT AND PACK INTO
1128         ALR     1
1129         SSM             SYMBOLIC IMAGE
1130         ARR     1
1131         SSM
1132         STA     PRI+8
1133         LDA     DP+3,1
1134         STA     PRI+9
1135         LDA     DP+2,1
1136         STA     PRI+10
1137         JMP     OR15
1138 *             ***********
1139 *             *OUTPUT ABS*
1140 *             ***********
1141 OA00    DAC     **
1142         STA     FTOP
1143         LDA     OA00
1144         STA     OR00
1145         CRA
1146         JMP     OR10
1147 *             *******************
1148 *             *OUTPUT STRING-RPL*
1149 *             *******************
1150 OS00    DAC     00
1151         STA     AF
1152         LDA     OMK7
1153         STA     FTOP
1154         LDA     OS00
1155         STA     OR00    SET RETURN INTO OUTPUT REL
1156         LDA     K104
1157         STA     CODE
1158         STA     STFL    STRING FLAG = NON ZERO
1159         JST     PRSP    SET PRINT BUF. TO SPACES
1160         JMP     OR20    JMP-OUTPUT REL FOR SYMBOLIC AND BINARY
1161 OR80    DAC     **
1162         IAB
1163         LDA*    OR80
1164         STA     OR89
1165         CRA
1166         LRR     2
1167         IRS     OR80
1168         JST     OR85
1169         JST     OR85
1170         JST     OR85
1171         JMP*    OR80
1172 OR85    DAC     **
1173         ADD     K140
1174         LLR     3
1175         LGL     5
1176         ADD     K140
1177         LLL     3
1178         STA*    OR89
1179         IRS     OR89
1180         CRA
1181         JMP*    OR85
1182 OR89    PZE     0
1183 OR90    DAC     NINS
1184 K200    EQU     OMI7
1185 K201    EQU     OMI5
1186 K202    EQU     OMI8
1187 K203    EQU     OMI4
1188 K204    EQU     OMI6
1189 K205    EQU     OMJ3
1190 K206    EQU     OMJ1
1191 K207    EQU     OMK5
1192 OR91    EQU     OMI1
1193 OR92    BCI     22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA
1194         BCI     2,ALTC
1195         BCI     9,STCASTSUDAERSUCA//
1196 OR93    BCI     22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC
1197         BCI     2,S1A
1198         BCI     9,G S A*B*C*R/BRS*/
1199 NINS    EQU     32
1200 *
1201 PRSP    DAC     **      SUBR. T0 SET PRINT BUF. T0 SPACES
1202         LDA     PRSK    =-40
1203         STA     0
1204         LDA     KASP    (SP)(SP)
1205         STA     PRI+40,1
1206         IRS     0
1207         JMP     *-2
1208         JMP*    PRSP    EXIT
1209 PRSK    OCT     177730  =-40
1210 *
1211 *              *************************************
1212 *              *OUTPUT SUBROUTINE/COMMON BLOCK NAME*
1213 *              ************************************
1214 *           OUTPUT AN EXTERNAL REFERENCE NAME.
1215 *
1216 ON00    DAC     **
1217         STA     ONT1    SAVE ADDRESS
1218         JST     FS00    FLUSH BUFFER IF NECESSARY
1219         JST     STXA    SET INDEX=A
1220         LDA     ONT1    SUBR. ENTRY ADDR.
1221         LRL     14
1222         STA     ONT1    SAVE S/C BITS
1223         LDA     ON02    ='600  (=BLOCK CODE NO.)
1224         LLL     6
1225         STA     OCI     FILL BUFFER
1226         LRL     8
1227         JST     STXA    SET INDEX=A
1228         LDA     DP+4,1  FIHST 2 CHAR. 0F NAME
1229         ANA     K111    ='037777
1230         CAS     *+1
1231         OCT     020240
1232         ERA     K122
1233         ERA     HBIT    ='140000
1234         LRR     8
1235         STA     OCI+1   BUFFER
1236         LRL     8
1237         LDA     DP+3,1  SECOND 2 CHAR. OF NAME
1238         LRR     8
1239         STA     OCI+2   BUFFER
1240         LRL     8
1241         LDA     DP+2,1  LAST 2 CHAR. OF NAME
1242         LRR     8
1243         STA     OCI+3   BUFFER
1244         LLL     8
1245         LGL     2
1246         ADD     ONT1    S/C BITS
1247         LGL     6
1248         STA     OCI+4   BUFFER
1249         CRA             SET SIZE = 0
1250         STA     OCI+5   8UFFER
1251         LDA     K128    ='14
1252         STA     OCNT    SET 8LOCK SIZE (DOUBLED)
1253         JST     FS00    FLUSH BUFFER
1254         JMP*    ON00    EXIT
1255 ON02    OCT     600     BLOCK CODE NUMBER  (6)
1256 ONT1    OCT     0       TEMP STORE
1257 *
1258 K149    BCI     1,='
1259 K140    OCT     26
1260 *
1261 OW00    DAC     **
1262         JST     SAV
1263         LDA     RPL
1264         SUB     ORPL
1265         SPL
1266         TCA
1267         CAS     K101
1268         JST     FS00    FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1
1269         NOP
1270         LDA     OCNT
1271         ADD     K103
1272         CAS     K146
1273         NOP
1274         JST     FS00    FLUSH BUFFER
1275         LDA     OCNT
1276         ADD     K103
1277         STA     OCNT    OCNT = OCNT+3
1278         SUB     K103
1279         ARR     1       OCI (OUTPUT CARD IMAGE)
1280         STA     XR
1281         SMI             LEFT OR RIGHT POS,
1282         JMP     OW20
1283         JST     PU00
1284         LRL     8       IF BUFFER FULL
1285         IMA     OCI,1
1286         ANA     K116    CALL FLUSH (FS0O)
1287         ERA     OCI,1
1288 OW10    STA     OCI,1
1289         IAB
1290         STA     OCI+1,1
1291         LDA     PRI+16
1292         IAB
1293         LDA     PRI+14  USE LOW BIT OF PRI+14 DATA
1294         LLL     9
1295         LGR     1       STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO,
1296         LLL     3       SET DIGITS IN PRI+17, PRI+19
1297         JST     OR80
1298         DAC     PRI+16
1299         LDA     PRI+14
1300         LRL     6
1301         LGL     1       SHIFT ADDR. TO RIGHT BY 1 BIT
1302         LLL     5
1303         JST     OR80    SET DIGITS IN PRI+15, PRI+16
1304         DAC     PRI+14
1305         LDA     KASP    (SP)(SP)
1306         SR1
1307         JMP     OW14
1308         STA     PRI+15  OVERWRITE BINARY DATA IN
1309         STA     PRI+16  PRINT BUFFER WITH SPACES
1310         STA     PRI+17  IF NO BINARY LISTING IS WANTED
1311         STA     PRI+18
1312 OW14    STA     PRI+14
1313         JST     RST
1314         LDA     RPL
1315         STA     ORPL    ORPL=RPL
1316         CRA
1317         IMA     STFL    INDICATE WORD WAS KEY TO LOADER
1318         SNZ             THEN LEAVE RPL ALONE
1319         IRS     RPL     RPL = RPL+1
1320         JMP*    OW00
1321 STFL    PZE     0
1322 OW20    JST     PU00
1323         JMP     OW10
1324 ORPL    PZE     0
1325 PU00    DAC     **
1326         LDA     CODE    COMBINE CODES TO
1327         CAS     K104    =4
1328         NOP
1329         JMP     PU10
1330         SZE             SKIP IF ABS
1331         JMP     PU10    JUMP IF REL.
1332         LRL     8
1333         LDA     FTOP
1334 PU08    LRL     4
1335         STA     PRI+14  SAVE FOR LISTING
1336         IAB
1337         STA     PRI+16
1338         LRR     12      RESTORE POSITION
1339         JMP*    PU00
1340 PU10    LRL     4
1341         LDA     AF
1342         LRL     4
1343         ERA     FTOP
1344         JMP     PU08
1345 PU20    LRL     4
1346         LDA     AF
1347         ANA     K111
1348         LRL     4
1349         IMA     AF
1350         ANA     K114
1351         ERA     AF
1352         JMP     PU08
1353 K114    OCT     14000
1354 K146    OCT     117
1355 *
1356 *
1357 *             ******************
1358 *             *FLUSH SUBROUTINE*
1359 *             ******************
1360 FS00    DAC     **
1361         LDA     OCNT    BUFFER OCCUPANCY SIZE
1362         JST     SAV     SAVE INDEX REGESTER
1363         SUB     K104    CHECK FOR OCNT .GT. 4
1364         SPL
1365         JMP     FS20    SKIP OUTPUT IF BUFFER IS EMPTY
1366         ADD     K105    ADD 1/2 AT B14
1367         ARS     1       DIVIDE BY 2
1368         TCA
1369         STA     OCNT    OCNT = -WORDS/BUFFER
1370         SUB     K101    =1
1371         STA     PCNT    BUFFER SIZE INCLUDING CHECKSUM
1372         LDA     OCI     FIRST WORD IN BUFFER
1373         LRL     12
1374         CAS     K102    =2
1375         JMP     *+2
1376         JMP     FS30    BLOCK TYPE = 2 (RELOCATABLE CODE)
1377 *          EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST
1378 *          3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT
1379 *          ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN.
1380 *          TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING
1381 *          FS11 WITH   (FS10  CRA  ).
1382 FS10    SS1
1383         JMP     FS11    N0 BINARY LISTING UNLESS SSW-1 IS DOWN
1384         CALL    F4$SYM
1385         DAC     PRI     OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF.
1386         LDA     FS41    =(E)(O)
1387         STA     PRI+5   ENTER  'EOB'   INTO LISTING
1388         LDA     FS41+1  =(B)(SP)
1389         STA     PRI+6
1390         LDA     OCI
1391         JST     OR80    ENTER FIRST WORD FROM BUFFER INTO LISTING
1392         DAC     PRI+8
1393         LDA     OCI+1
1394         JST     OR80    ENTER WORD 2 FROM BUFFER INTO LISTING
1395         DAC     PRI+12
1396         LDA     OCI+2
1397         JST     OR80    ENTER WORD 3 FROM BUFFER INTO LISTING
1398         DAC     PRI+16
1399         CALL    F4$SYM  OUTPUT SYMBOLIC BUFFER
1400         DAC     PRI
1401         JST     PRSP    RESET SYMBOLIC BUFFER TO SPACES
1402 FS11    CRA
1403         STA     0       COMPUTE CHECKSUM
1404 FS12    ERA     OCI,1   MERGE BUFFER WORD INTO CHECKSUM
1405         IRS     0       INCREMENT BUFFER POSITION
1406         IRS     OCNT    DECREMENT BUFFER SIZE
1407         JMP     FS12
1408         STA     OCI,1   SET CHECKSUM INTO BUFFER
1409         LDA     PCNT    = NO. OF WORDS IN BUFFER
1410         IMA     0
1411         ADD     FS40    = OCI+1,1
1412         CALL    F4$OUT  PUNCH BUFFER
1413 FS20    LDA     RPL     SET UP BUFFER FOR NEXT OUTPUT
1414         LRL     8
1415         ADD     K145    =#'2000   (BLOCK CODE 2)
1416         STA     OCI
1417         IAB
1418         STA     OCI+1   SET FIRST 2 WORDS OF BUFFER
1419         LDA     K103    =O
1420         STA     OCNT    RESET BUFFER OCCUPANCY SIZE
1421         JST     RST     RESET INDEX REGISTER
1422         JMP*    FS00    EXIT
1423 *
1424 FS30    LGL     6       MERGE BUFFER SIZE INTO BLOCK HEADER
1425         SUB     OCNT    BUFFER SIZE
1426         ADD     K101    =1  (ACCOUNT FOR CHECKSUM)
1427         LLR     6
1428         LGR     6
1429         LLL     6       BRING IN UPPER HALF OF ADDRESSES
1430         STA     OCI     STORE INTO BUFFER
1431         JMP     FS10    COMPUTE CHECKSUM
1432 *
1433 FS40    DAC     OCI+1,1
1434 FS41    BCI     2,EOB   'EOB'
1435 K145    OCT     20000   BLOCK TYPE 2 CODE
1436 C499    OCT     060000
1437 *
1438 OCI     BSS     40      40 WORD CARD IMAGE INPUT BUFFER
1439 PRI     BSS     40      40 WORD PRINT BUFFER
1440         BCI     20,
1441         BSS     30      COMPILER PATCH AREA
1442 *
1443 *             ***********************
1444 *             *IOS (AND IOL) GO HERE*
1445 *             ***********************
1446 *
1447         END     A0