ASMB,R,B,L,C
      HED ***   RTE 2607A LINE PRINTER DRIVER   *** 
* 
* 
      NAM DVR12 
* 
* 
      ENT I.12,C.12 
* 
* 
**************************************************
* 
*         RELOC. TAPE:   92200-16001   REV. A 
*         ERS:         A-92200-16001-1
*         LISTING:     A-92200-16001-2
*         SOURCE TAPE:   92200-18001   REV. A 
* 
**************************************************
* 
* 
*         M. SCHOENDORF  MAY 13, 1974    REV. A 
* 
* 
*     CALLING SEQUENCE
* 
*     A. CONTROL
*        -------
* 
*        EXT EXEC 
*         . 
*         . 
*        JSB EXEC      TRANSFER CONTROL TO RTE
*        DEF *+4(OR 3)*  POINT OF RETURN FROM RTE 
*        DEF ICODE     REQUEST CODE 
*        DEF ICNWD     CONTROL INFORMATION
*        DEF IPRAM     FORMAT 
* 
* 
*        1) LINE SPACING
* 
*           ICODE - DEC 3 (I/O CONTROL) 
*           ICNWD - OCT 11XX (LIST OUTPUT LINE SPACING) 
*                   WHERE XX IS THE LOGICAL UNIT NUMBER 
*           IPRAM - 
*                   DECIMAL            MEANING
*               PARAMETER WORD
* 
*                 LESS THAN 0       PAGE EJECT. 
* 
*                 0                 DRIVER PERFORMS NO ACTION.
* 
*                 1 TO 55           SPACE 1 TO 55, IGNORING 
*                                   PAGE BOUNDARIES.
* 
* 
*                 56 TO 63          USE CARRIAGE CONTROL CHAN-
*                                   NEL N, WHERE N = WORD-55. 
*                                   (SEE CARRIAGE CONTROL 
*                                   CHANNELS BELOW.)
* 
*                 64                SET AUTOMATIC PAGE EJECT MODE.
* 
*                 65                CLEAR AUTOMATIC PAGE EJECT MODE.
* 
*  CARRIAGE CONTROL CHANNELS
* 
*  IF THE PARAMETER WORD IS 56 TO 63, THE PRINTER 
*  SPACES USING THE STANDARD CARRIAGE CONTROL CHANNELS, 
*  WHICH HAVE THE FOLLOWING MEANINGS. 
* 
*  CHANNEL 1  (56)  SINGLE SPACE WITH AUTOMATIC PAGE EJECT. 
* 
*  CHANNEL 2  (57)  SKIP TO THE NEXT ODD LINE WITH AUTOMATIC
*                   PAGE EJECT. 
* 
*  CHANNEL 3  (58)  SKIP TO THE NEXT TRIPLE LINE WITH AUTO- 
*                   MATIC PAGE EJECT. 
* 
*  CHANNEL 4  (59)  SKIP TO THE NEXT 1/2 PAGE BOUNDARY..
* 
*  CHANNEL 5  (60)  SKIP TO THE NEXT 1/4 PAGE BOUNDARY. 
* 
*  CHANNEL 6  (61)  SKIP TO THE NEXT 1/6 PAGE BOUNDARY. 
* 
*  CHANNEL 7  (62)  SKIP TO THE BOTTOM OF THE PAGE. 
* 
*  CHANNEL 8  (63)  SKIP TO THE TOP OF THE NEXT PAGE. 
* 
*        2) DYNAMIC STATUS
* 
*           ICODE - DEC 3 (I/O CONTROL) 
*           ICNWD - OCT 6XX (DYNAMIC STATUS) XX IS THE
*                   LOGICAL UNIT NUMBER 
* 
* 
*     B. PRINTING 
*        -------- 
* 
*        EXT EXEC 
*         . 
*         . 
*        JSB EXEC      TRANSFER CONTROL TO RTE
*        DEF *+5       POINT OF RETURN FROM RTE 
*        DEF ICODE     REQUEST CODE 
*        DEF ICNWD     CONTROL INFORMATION
*        DEF IBUFR     BUFFER LOCATION
*        DEF IBUFL     BUFFER LENGTH
* 
*        ICODE - DEC 2 (PRINT)
*        ICNWD - OCT CONWD
*                WHERE CONWD CONTAINS SEVERAL FIELDS DEFINING 
*                THE NATURE OF THE DATA TRANSFER. 
*                (V BIT = BIT 7 AND X BIT = BIT 10) 
*        1) IF THE V BIT IS SET TO 1, THE DRIVER PRINTS THE 
*           FIRST CHARACTER IN THE BUFFER ALONG WITH THE REST 
*           OF THE BUFFER CONTENTS AND THE DRIVER SINGLE SPACES.
*        2) IF V IS SET TO ZERO, THE FIRST CHARACTER OF THE 
*           BUFFER IS USED FOR LINE CONTROL AND IS
*           PRINTED AS A BLANK IN COLUMN ONE OF THE PRINTER.
*           THE MEANING OF THE CONTROL CHARACTERS ARE:
* 
*           CHARACTER             MEANING 
* 
*        BLANK              SINGLE SPACE (PRINT ON EVERY LINE). 
*        0                  DOUBLE SPACE (PRINT ON EVERY OTHER
*                           LINE).
*        1                  EJECT THE CURRENT PAGE AND THEN PRINT.
*        *                  SINGLE SPACE (PRINT ON EVERY LINE). 
*        ANY OTHER CHAR.    SINGLE SPACE (PRINT ON EVERY LINE). 
* 
*     3) IF THE X-BIT = 1, HONESTY MODE IS SPECIFIED WHICH MEANS
*        THAT THE USER'S DATA IS OUTPUT DIRECTLY TO THE LINE
*        PRINTER. THIS MEANS THE USER IS RESPONSIBLE FOR
*        SUPPLYING HIS OWN CARRIAGE RETURN,LINE-FEED, OR FORM-
*        FEED CHARACTERS. 
* 
* 
*     STATUS WORD (EQT 5) 
*     ------------------- 
* 
*     BIT       CONTENTS
*      7      TOP OF FORM 
*      6      DEMAND (1=IDLE) 
*      5      ON LINE (1=ON LINE) 
*      4      READY (0=POWER ON)
*      1      AUTOMATIC PAGE EJECT MODE 
*     OTHER BITS FOR INTERNAL USE ONLY
* 
* 
      SKP 
* 
*     ENTRY/EXIT OF INITIATION SECTION
* 
* 
I.12  NOP           ENTRY/EXIT
      JSB SETIO     SET I/O INSTRUCTIONS FOR UNIT 
      CLA           CLEAR SWITCHES
      STA EQT9,I    ASCII DATA TO BE OUTPUT 
      LDA SINGL     SINGLE SPACE W AUTO PAGE EJECT
      STA EQT10,I   END OF MESSAGE CODE INITIALIZED 
      LDA EQT5,I    STATUS WORD 
      AND MM402 
      STA EQT5,I    RESET BITS 0,2,3,4,5,6,7
      LDA .3        READY REJECT CODE 
      LDB EQT6,I    GET CONTROL WORD OF REQUEST 
      CPB B603      IS REQUEST FOR DYNAMIC STATUS 
      LDA .4        YES, GIVE IMMEDIATE COMPLETION
      JSB STAT      CHECK STATUS
      JMP I.12,I    STATUS EXIT 
      LDA EQT6,I    GET CONTROL WORD OF REQUEST 
      AND .3        ISOLATE 
      CPA .2        CHECK IF WRITE REQUEST
      JMP PRINT     YES, SO GO PROCESS
      CPA .3        CHECK IF CONTROL REQUEST
      JMP CNTRL     YES 
      CLA,INA       NO, REQUEST CODE ERROR
      JMP I.12,I    RETURN TO I/O CONTROL 
* 
.3    DEC 3 
B603  OCT 603 
B1103 OCT 1103
MM402 OCT 177402
* 
      SKP 
*     PROCESS CONTROL REQUEST 
      SPC 2 
CNTRL LDA EQT6,I    FETCH CONTROL WORD
      CPA B603      DYNAMIC STATUS? 
      JMP I.A.4     YES, EXIT 
      CPA B1103     LINE SPACING REQUEST ?
      JMP *+3       YES 
RJECT LDA .2        CONTROL REQUEST CODE ERROR
      JMP EXIT
      LDA EQT7,I    CONTROL FUNCTION PARAMETER
      SZA,RSS       IF PARAMETER ZERO,
      JMP I.A.4     IGNORE SUPPRESS SPACE 
      SSA               IF NEG, THEN PAGE EJECT 
      JMP NEG           GO PAGE EJECT 
      ADA M64 
      SSA,RSS       SKIP IF NOT AUTO-PAGE EJECT MODE
      JMP E6465     GO HANDLE AUTO-PAGE EJECT FUNCTION
      LDA EQT7,I    CONTROL FUNCTION PARAMETER
      STA B 
      ADA M56       IS REQUEST FOR A TAPE LEVEL 
      SSA,RSS       NO, SKIP TESTS
      JMP B5663     YES, DO TESTS 
      JSB SLEW      B HAS NO. OF LINES TO SLEW
      JMP EXIT0     A=0 EXIT - SUCCESSFUL INITIATION
B5663 ADB .10       ADD 10 TO TAPE LEVEL
      CPB B110      IS VALUE NOW 110B 
      ADB M7        YES, SET IT TO LEVEL #2 
      CPB B111      IS VALUE NOW 111B 
      ADB M9        YES, SET TO LEVEL #1
      LDA B 
      IOR MNEG      SET SPACE COMMAND BIT 
      JMP SPACE     GO SPACE
E6465 ADA M2        =B-2
      SSA,RSS       SKIP IF CODE LEGAL
      JMP RJECT     GO REJECT 
      ADA .2
      ALS           SHIFT INTO POSITION 
      STA B 
      LDA EQT5,I    PICK UP STATUS
      AND M3        CLEAR AUTO-PAGE-EJECT BIT 
      IOR B         SET NEW VALUE 
      STA EQT5,I
I.A.4 LDA .4        IMMEDIATE COMPLETION EXIT 
      JMP EXIT
NEG   LDA EQT5,I
      IOR B200      SET TOP-OF-FORM STATUS
      STA EQT5,I
      LDA PEJEC     PAGE EJECT CODE 
SPACE JSB POUT      OUTPUT
EXIT0 CLA 
EXIT  JSB CLEAR     CLEAR HONESTY MODE FLAGS
      JMP I.12,I         EXIT 
* 
.2    DEC 2 
M3    DEC -3
M7    DEC -7
M9    DEC -9
M56   DEC -56 
M64   DEC -64 
B110  OCT 110 
B111  OCT 111 
SING  OCT 100001
* 
      SKP 
*     PROCESS A PRINT REQUEST 
      SPC 2 
PRINT LDA EQT7,I    CONVERT BUFFER ADDRESS TO 
      RAL            BUFFER CHARACTER 
      STA EQT7,I      ADDRESS 
      LDA EQT5,I
      AND .2        CHECK FOR SS WITHOUT PAGE EJECT 
      SZA,RSS 
      JMP *+3 
      LDA SING
      STA EQT10,I   SS WITHOUT PAGE EJECT IS DESIRED
      LDA EQT8,I    CONVERT WORD OR CHARACTER 
      SSA                COUNT TO CHARACTER 
      JMP *+3 
      ALS 
      CMA,INA 
      STA EQT9,I    STORE CHARACTER COUNT 
      SZA,RSS       SKIP IF NOT ZERO LENGTH LINE
      JMP CHARS 
      SPC 1 
      JSB CKNAM     CHECK IF ASMB,FTN,ALGOL, OR EDIT
      JMP CHARS 
      SPC 1 
      LDB EQT7,I    GET BUFFER CHARACTER
      RBR           ADDRESS 
      LDA B,I       GET FIRST CHARACTER IN BUFFER 
      ALF,ALF 
      AND B177
      JSB HNSTY     CHECK IF HONESTY MODE 
      JMP GTCWD     NOT IN HONESTY MODE 
      JMP I.A.0     HONESTY MODE
      JMP I.A.4     HONESTY MODE (NO MORE DATA) 
      LDB EQT7,I    GET BUFFER CHARACTER
      ERB           ADDRESS 
      LDA B,I       GET SECOND CHARACTER IN BUFFER
      AND B177
      JSB HNSTY     CHECK IF HONESTY MODE 
      NOP           MUST BE HONESTY 
      JMP I.A.0     HONESTY EXIT
GTCWD LDB EQT6,I    GET CONTROL WORD
      BLF,BLF       BIT 7=1? I.E.,
      SSB           1ST CHAR = LINE CNTRL.
      JMP VEQ1       NO. OUTPUT AS DATA 
      CPA B61       CHECK IF PAGE EJECT 
      RSS 
      JMP CNEQ1 
      LDA EQT5,I
      IOR B10       SET FLAG FOR RETURN 
      STA EQT5,I
      JMP NEG 
CNEQ1 CPA B60       CHECK IF DOUBLE SPACE 
      JMP I.12K 
      LDA B40       ASCII BLANK CHARACTER 
VEQ1  JSB POUT
      ISZ EQT7,I    ELSE BLANK - INC BUF CHR ADDRESS
      ISZ EQT9,I
      NOP 
      JSB TIMER     WAIT FOR FLAG 
      RSS           NO FLAG 
CHARS JSB LOUT      OUTPUT CHARS AND PRINT
      JMP EXIT0 
I.12K LDA EQT5,I
      IOR B10       SET FLAG FOR RETURN 
      STA EQT5,I
      LDA SINGL     SINGLE SPACE W AUTO PAGE EJECT
      JMP SPACE 
I.A.0 CLA 
      JMP I.12,I    EXIT
* 
.4    DEC 4 
M2    DEC -2
M5    DEC -5
B10   OCT 10
B60   OCT 60
B61   OCT 61
B177  OCT 177 
B200  OCT 200 
* 
      SKP 
*     ENTRY/EXIT OF COMPLETION SECTION
      SPC 2 
C.12  NOP           ENTRY/EXIT
      JSB SETIO     SET I/O INSTRUCTIONS FOR UNIT 
      LDA EQT1,I    SPURRIOUS INTERRUPT?
      SZA,RSS 
      JMP C.12E     YES, EXIT.
      CLA,INA       READY REJECT CODE 
      JSB STAT      CHECK STATUS
      JMP CEXIT     STATUS ERROR EXIT 
      LDB EQT6,I    GET CONTROL WORD OF REQUEST.
      BLF,RBL 
      SSB           HONESTY MODE? 
      JMP C10.C     YES 
      LDA EQT5,I    GET STATUS WORD 
      SLA,RSS       TIMER FLAG SET? 
      JMP CA        NO
      AND M2        YES, RESET FLAG AND FINISH THE
      STA EQT5,I      OPERATION 
      JMP C10.C 
CA    LDA EQT5,I    GET STATUS WORD 
      AND .4        ISOLATE SLEW BIT
      SZA,RSS 
      JMP C.12B     CHECK DATA OUT, NO LINES TO SLEW
      LDA EQT5,I    MORE LINES TO SLEW
      AND M5        CLEAR SLEW BIT
      STA EQT5,I    STORE NEW STATUS
      LDB EQT7,I    GET NO OF LINES LEFT TO SLEW
      JSB SLEW      SLEW SOME MORE LINES
      JMP C.12E     TAKE CONTINUATION RETURN
C.12B LDA EQT9,I    GET DATA COUNTER
      SZA,RSS       ALL DATA OUT? 
      JMP COMPL     YES, SO GO TO COMPLETION PROCESS
      LDA EQT5,I    CHECK LAST OPERATION FOR DOUBLE 
      AND B10         SPACE OR PAGE EJECT 
      SZA,RSS 
      JMP C10.C     NEITHER 
      XOR EQT5,I    LAST OP WAS DBL SP OR PG EJ 
      STA EQT5,I    RESET BIT 3 
      LDA B40       ASCII BLANK CHARACTER 
      JSB POUT      OUTPUT BLANK
      ISZ EQT7,I    INCREMENT BUFFER CHARACTER ADDR 
      ISZ EQT9,I    INCREMENT CHARACTER OUTPUT COUNT
      NOP 
      JSB TIMER     WAIT FOR FLAG 
      JMP C.12E     NO FLAG, EXIT 
      JMP C.12L     FLAG, GET NEXT CHARACTER
C10.C LDA EQT11,I   ANY BLANKS LEFT TO OUTPUT?
      SZA,RSS 
      JMP C.12D     NO
      JSB BLOUT     YES, GO OUTPUT THEM 
      JMP C.12E     EXIT
C.12L JSB LOUT      GO PRINT LINE 
C.12E ISZ C.12
      JMP CEXIT     CONTINUATION EXIT 
C.12D LDA EQT9,I    GET DATA COUNTER
      SZA,RSS 
      JMP COMPL     NO MORE DATA, EXIT
      JMP C.12L     MORE DATA, GET NEXT CHARACTER 
      SPC 2 
COMPL CLA 
      LDB EQT8,I    GET BUFFER LENGTH 
      SSB           MAKE B POSITIVE CHARACTER OR
      CMB,INB           WORD COUNT
I04   CLC 0         CLEAR CONTROL 
CEXIT STB TEMP1     SAVE B REGISTER 
      STA TEMP2     SAVE A REGISTER 
      LDA EQT6,I    GET CONTROL WORD
      ALF,RAL 
      SSA           HONESTY MODE? 
      JMP EXIT2     YES, EXIT 
      JSB CLEAR     NO, CLEAR H. M. COUNTERS/FLAG 
EXIT2 LDB TEMP1     RESTORE B REGISTER
      LDA TEMP2     RESTORE A REGISTER
      JMP C.12,I    COMPLETION EXIT 
* 
TEMP1 NOP 
TEMP2 NOP 
.10   DEC 10
B40   OCT 40
MNEG  OCT 100000
* 
      SKP 
* 
*  SUBROUTINE TO OUTPUT BLANKS IF IN HONESTY MODE 
*  AND ONLY A LINE FEED IS OUTPUTTED
* 
BLOUT NOP 
      LDA B40       ASCII BLANK 
OTAIN OTA 0         OUTPUT IT 
STCIN STC 0,C       ENCODE DEVICE 
      ISZ EQT11,I   INCREMENT BLANK COUNTER 
      JMP SFCIN     MORE BLANKS 
      ISZ BLOUT     NO MORE BLANKS
      JMP BLOUT,I 
SFCIN SFC 0         CHECK FOR FLAG
      JMP OTAIN     FLAG
      JSB TIMER     WAIT FOR FLAG 
      JMP BLOUT,I   NO FLAG, EXIT 
      JMP BLOUT+1   FLAG, OUTPUT NEXT BLANK 
* 
*  SUBROUTINE TO CONFIGURE I/O INSTRUCTIONS 
* 
SETIO NOP           ENTRY/EXIT
      IOR SFC       FORM SFC COMMAND
      STA LOU1
      STA TIM1
      STA SFCIN 
      ADA B400      FORM OTA I/O COMMAND
      STA POUT+1
      STA OTAIN 
      ADA B1100     FORM STC COMMAND
      STA POUT+2
      STA STCIN 
      ADA B2600     FORM LIB COMMAND
      STA STAT1 
      ADA B200      FORM CLC COMMAND
      STA I04 
      JMP SETIO,I        EXIT 
* 
SFC   SFC 0 
B400  OCT 400 
B1100 OCT 1100
B2600 OCT 2600
* 
* 
*  SUBROUTINE TO GET CHARACTER AND OUTPUT IT
* 
LOUT  NOP           ENTRY/EXIT
      LDA EQT9,I    PICK UP NUMBER OF CHARS 
      SZA,RSS       SKIP IF ANY LEFT
      JMP LOU3      NO, GO OUTPUT END-OF-LINE CHAR
      JMP LOU6
LOU1  SFC 0         SKIP IF PREV CHAR NOT ACCEPTED
      JMP LOU2      GO OUTPUT NEXT CHAR 
      JSB TIMER     GO TIME OUT 
      JMP LOUT,I      TIME-OUT,TAKE ERROR EXIT
LOU2  LDA EQT9,I    GET DATA COUNTER
      SZA           MORE DATA?
      JMP LOU6      YES, GO GET NEXT CHARACTER
LOU3  LDA EQT6,I    GET CONTROL WORD
      ALF,RAL 
      SSA           HONESTY MODE? 
      JMP LOUT,I    YES, EXIT 
      LDA EQT10,I   GET END -OF-LINE CHAR.
      JSB POUT      OUTPUT IT 
      CLA 
      STA EQT13,I   CLEAR LINE LENGTH COUNTER 
      JMP LOUT,I    TAKE COMPLETION EXIT
LOU6  LDB EQT7,I    PICK UP ADDRESS OF CHAR 
      CLE,ERB 
      LDA B,I       PICK UP WORD CONTAINING CHAR
      SEZ,RSS       SKIP IF RIGHT CHAR
      ALF,ALF       ROTATE
      AND B177      MASK OFF ANY EXTRANEOUS BITS
      JSB HNSTY     CHECK IF HONESTY MODE 
      JMP LOU7      NOT HONESTY MODE
      JMP LOUT,I    HONESTY MODE
      JMP COMPL     HONESTY MODE, NO MORE DATA
      JMP C.12L     HON. MODE, LAST OP LF OR CR/LF
LOU7  JSB POUT      OUTPUT CHAR 
      ISZ EQT7,I    INCREMENT BUF. CHAR. ADDRESS
      ISZ EQT9,I    INCREMENT CHAR. OUTPUT COUNTER
      NOP 
      JMP LOU1      CHECK FOR FLAG
* 
.12   DEC 12
.13   DEC 13
PEJEC OCT 100100
SINGL OCT 100102
* 
*  SUBROUTINE TO DETERMINE IF IN HONESTY MODE 
* 
HNSTY NOP 
      LDB EQT6,I    GET CONTROL WORD
      BLF,RBL 
      SSB,RSS       HONESTY MODE? 
      JMP HNSTY,I   NO, EXIT
      ISZ HNSTY     INCREMENT RETURN ADDRESS
      CPA .12       ASCII CHAR. = PAGE EJECT? 
      LDA PEJEC     YES, LOAD PAGE EJECT CODE 
      CPA .13       ASCII CHAR. = CAR. RET.?
      LDA SINGL     YES, LOAD CAR. RET. CODE
      CPA .10       ASCII CHAR. = LINE FEED?
      JMP LINFD     YES, PROCESS LINE FEED
      JSB POUT      OUTPUT DATA 
      CPA PEJEC     ASCII CHAR. = PAGE EJECT
      JSB CLEAR     YES, CLEAR H. M. COUNTERS/FLAG
      CPA SINGL     ASCII CHAR. = CAR. RET.?
      JMP CARTN     YES, PROCESS CAR. RET.
      CLA           CLEAR HONESTY MODE FLAG 
      STA EQT12,I 
INCR  ISZ EQT7,I    INCREMENT BUF. CHAR. ADDRESS
      ISZ EQT9,I    INCREMENT CHAR. OUTPUT COUNTER
      NOP 
      JMP HNSTY,I   EXIT
LINFD LDA EQT12,I   WAS LAST OPERATION A CAR. RET.? 
      SSA 
      JMP LOU8      YES, DON'T GIVE A LINE FEED 
      LDA SINGL     GET LINE FEED CODE
      LDB EQT13,I   GET PRESENT LINE LENGTH 
      CMB,INB 
      STB EQT11,I   STORE IT
      JSB POUT      OUTPUT LINE FEED
      CCA 
      ADA EQT13,I   DECREMENT PRESENT LINE
      STA EQT13,I   LENGTH AND STORE IT 
      JMP INCR      EXIT
LOU8  JSB CLEAR     CLEAR HON. MODE COUNTERS/FLAG 
      ISZ HNSTY     INCREMENT RETURN ADDRESS
      ISZ EQT7,I    INCREMENT BUFFER CHAR. ADDRESS
      ISZ EQT9,I    INCREMENT CHAR. OUTPUT COUNTER
      ISZ HNSTY     MORE DATA, INCR. RETURN ADDRESS 
      JMP HNSTY,I 
CARTN JSB CLEAR     CLEAR HONESTY MODE FLAGS
      CCB           RESET CARRIAGE RETURN/ LINE 
      STB EQT12,I   FEED FLAG 
      JMP INCR      EXIT
* 
*  SUBROUTINE TO WAIT FOR FLAG FROM LINE PRINTER
* 
TIMER NOP 
      LDA M100      PICK UP LOOP COUNTER
TIM1  SFC 0         SKIP IF CHAR NOT ACCEPTED 
      JMP TIM2
      INA,SZA       SKIP IF DELAY TIME EXCEEDED 
      JMP TIM1
      ISZ EQT5,I    SET BIT 0 
      JMP TIMER,I   TAKE ERROR EXIT 
TIM2  ISZ TIMER 
      JMP TIMER,I   TAKE NORMAL EXIT
* 
M100  DEC -100
* 
*  SUBROUTINE TO CHECK IF ASMB, FTN, ALGOL, OR EDIT 
* 
CKNAM NOP           ENTRY/EXIT
      LDB EQT1,I    DEVICE SUSPEND LIST POINTER 
      ADB .12       ADD 12 TO GET  ADD. OF PROG. NAME 
      LDA NUTAB     INIT. SEARCH ADDRESS COUNTER
      STA NEWTB 
      LDA M13       INIT. SEARCH COUNTER
      STA COUNT 
      LDA B,I       GET FIRST TWO CHARACTERS
      JSB GTCKC     CHECK IF IN LIST
      LDA B,I       GET SECOND TWO CHARACTERS 
      JSB GTCKC     CHECK IF IN LIST
      LDA B,I       GET LAST CHARACTER
      AND M256      CLEAR LOWER 8 BITS
      JSB GTCKC     CHECK IF IN LIST
      JMP CKNAM,I   EXIT
* 
M13   DEC -13 
M256  DEC -256
NUTAB DEF *+1 
      ASC 2,ASMB
      OCT 20000 
      ASC 2,FTN 
      OCT 20000 
      ASC 2,ALGO
      OCT 46000 
      ASC 2,EDIT
      OCT 20000 
* 
*  SUBROUTINE TO SEARCH FOR CALLING PROGRAM 
* 
GTCKC NOP 
      CLE,INB 
GTNEW SEZ           CHARACTER MATCHES?
      JMP GTCKC,I   YES, EXIT 
      CPA NEWTB,I   CHARACTERS MATCH? 
      CCE           YES 
      ISZ NEWTB     INCREMENT COUNTERS
      ISZ COUNT 
      JMP GTNEW     KEEP CHECKING 
      ISZ CKNAM     NO MATCH, INCR. RETURN ADDRESS
      JMP CKNAM,I   EXIT
* 
COUNT NOP 
NEWTB NOP 
* 
*  SUBROUTINE TO CHECK STATUS 
* 
STAT  NOP                ENTRY/EXIT 
STAT1 LIB 0         FETCH HARDWARE STATUS 
      STB STATW     SAVE STATUS RETURNED
      BLF 
      RBL,RBL 
      SWP           SWAP A AND B REGISTERS
      AND B160      MASK OFF BITS 4-6 
      IOR EQT5,I    MERGE WITH STATUS WORD
      SWP 
      STB EQT5,I    AND STORE 
      LDB STATW     GET STATUS RETURNED 
      SSB,RSS       IS 2607 ON LINE?
      JMP STAT,I    NO, EXIT
      RBL 
      SSB,RSS       IS 2607 READY (POWER ON)? 
      ISZ STAT      YES 
      JMP STAT,I         EXIT 
* 
STATW NOP 
B160  OCT 160 
* 
*  SUBROUTINE TO SLEW UP TO 15 LINES AT A TIME
* 
SLEW  NOP 
      LDA B         B HAS LINE COUNT
      ADB M16       SUB 16 TO SEE IF LINE COUNT 
      SSB           GT 15 
      JMP SLW1      SLEW 15 LINES 
      INB           SAVE NUMBER OF LINES
      STB EQT7,I    LEFT TO BE SLEWED 
      LDA EQT5,I    SET SLEW STATUS 
      IOR .4
      STA EQT5,I
      LDA B17       SLEW 15 LINES 
SLW1  ADA MNEG      FIX UP SLEW CODE
      JSB POUT      OUTPUT CODE 
      JMP SLEW,I
* 
M16   DEC -16 
B17   OCT 17
* 
*  SUBROUTINE TO OUTPUT A CHARACTER 
* 
POUT  NOP 
      OTA 0         OUTPUT WORD IN A REG
      STC 0,C 
      ISZ EQT13,I 
      JMP POUT,I
* 
*  SUBROUTINE TO CLEAR HONESTY MODE COUNTERS AND FLAGS
* 
CLEAR NOP 
      CLB 
      STB EQT11,I 
      STB EQT12,I 
      STB EQT13,I 
      JMP CLEAR,I 
* 
B     EQU 1         ADDRESS OF B REGISTER 
* 
*  BASE PAGE COMMUNICATION AREA 
* 
.     EQU 1660B 
EQT1  EQU . 
EQT5  EQU .+4 
EQT6  EQU .+5 
EQT7  EQU .+6 
EQT8  EQU .+7 
EQT9  EQU .+8 
EQT10 EQU .+9 
EQT11 EQU .+10
EQT12 EQU .+73
EQT13 EQU .+74
      END 
                                                                                                            