* 
*  DIAGNOSTIC OUTPUT SUBROUTINE: <DIAG> 
* 
*  PURPOSE: THIS ROUTINE WRITES ON THE
*           SYSTEM TELETYPE (LU #1) THE 
*           MESSAGE:
* 
*            "/EDIT: 'DIAGNOSTIC' " 
* 
*           THE ADDRESS OF THE 'DIAGNOSTIC' 
*           PART IS SUPPLIED TO THE ROUTINE.
*           THE FORMAT OF THE MESSAGE IS: 
* 
*            WORD 1:  # CHARS (NEGATIVE)
*            WORDS 2-N: TEXT
* 
*  CALLING SEQUENCE:
* 
*            (A) = ADDRESS OF MESSAGE 
*        (P)     JSB DIAG 
*        (P+1)   - RETURN - 
* 
* 
DIAG  NOP 
      LDB A,I      GET AND
      STB DIAGL     SET NEG. CHAR. LENGTH 
      INA          SET
      STA DIAGB     ADDRESS OF MESSAGE
* 
      JSB EXEC     WRITE
      DEF *+5 
      DEF C.02      "/EDIT:"
      DEF C.01        W/O R/LF
      DEF EDIDM       ON SYSTEM 
      DEF CM8         TELETYPE
* 
      JSB EXEC     WRITE
      DEF *+5       MESSAGE 
      DEF C.02       PART 
      DEF C.01        OF
DIAGB NOP           DIAGNOSTIC
      DEF DIAGL 
* 
      JMP DIAG,I   RETURN 
      SKP 
OVFM  DEF *+1 
      DEC -16 
      ASC 8,MEM OVERFLOW : *  
ILCM  DEF *+1 
      DEC -10 
      ASC 5,CS ERR : *  
NERM  DEF *+1 
      DEC -12 
      ASC 6,PARAM ERR: *  
SEQM  DEF *+1 
      DEC -10 
      ASC 5,SEQ ERR: *  
INEM  DEF *+1 
      DEC -10 
      ASC 5,/I ERR : *  
RPEM  DEF *+1 
      DEC -10 
      ASC 5,/R ERR : *  
CHOM  DEF *+1 
      DEC -10 
      ASC 5,/C OVF : *  
EOFEA DEF *+1 
      DEC -13 
      ASC 7,END EDIT FILE 
* 
ENDED DEF *+1 
      DEC -15 
      ASC 8,END OF EDIT RUN 
FLUND DEF *+1 
      DEC -7
      ASC 4,FILE UN 
DOVFM DEF *+1 
      DEC -8
      ASC 4,DISK OVF
NFILE DEF *+1 
      DEC -20 
      ASC 10,TRACKS IN NEW FILE : 
TRAKN DEF *+1 
      DEC -8
      ASC 4,LU, TRAC
* 
EDIDM ASC 4,/EDIT: *  
      SKP 
* 
* SUBROUTINE: <OUTS>
* 
*  PURPOSE: THIS ROUTINE OPERATES IN
*           CONJUCTION WITH 'DIAG' TO 
*           WRITE AN ILLEGAL CONTROL
*           STATEMENT AFTER 'DIAG' IS 
*           CALLED. 
* 
*  CALL:  (P)     JSB OUTS
*         (P+1)   -RETURN-
* 
* 
OUTS  NOP 
      LDA SEDA     USE PREVIOUS CS ADDRESS
      SZA,RSS       IF NON-ZERO; OTHERWISE
      LDA EDAD      USE CURRENT.
      LDB A,I      GET CHAR. LENGTH,
      CMB,INB       SET NEG.
      STB DIAGL     SET FOR WRITE.
      INA          SET ADDRESS
      STA OUTAD     OF STATEMENT. 
* 
      JSB EXEC     WRITE ILLEGAL
      DEF *+5       CONTROL 
      DEF C.02      STATEMENT 
      DEF C.01      ON
OUTAD NOP           SYSTEM
      DEF DIAGL     TELETYPE
* 
      JMP OUTS,I   -RETURN- 
      SKP 
* 
*  CONSTANT AND STORAGE SECTION 
* 
EDAD  OCT 0         EDIT FILE RECORD ADDRESS
SEDA  OCT 0         -PREVIOUS EDIT FILE ADDRESS-
N1XX  OCT 0         HOLDS N1 IN PARAMETER 
N2XX  OCT 0         HOLDS N2 IN PARAMETER 
C1XX  OCT 0         HOLDS C1 IN PARAMETER 
C2XX  OCT 0         HOLDS C2 IN PARAMETER 
FFCT  OCT 0         COUNTER WORD
SYCT  OCT 0         HOLDS COUNT OF SYM. FILE RECORD 
SYSQ  OCT 0         SYMBOLIC FILE SEQUENCE NO.
CSAF  OCT 0         FLAG FOR CONTROL STATEMENT ACTIVE 
CSFL  OCT 0         DEFINES CURRENT STATEMENT 
C.FL  OCT 0         TYPE OF CHARACTER STATEMENT 
CMV1  BSS 2         HOLDS MOVE PARAMETERS 
CMV2  BSS 2         -NO. OF CHARS. AND
CMV3  BSS 2          ORIGIN ADDRESSES 
NXRA  OCT 0         TEMPORARY CELLS FOR 
NXSG  OCT 0          NXAD SUBROUTINE
LENG  OCT 110       72 (10) CHARS. FOR INPUT
MLEN  OCT 44        36 (10) WORDS FOR INPUT 
* 
C.01  OCT 1 
C.02  OCT 2 
C.03  OCT 3 
C.04  OCT 4 
C.05  OCT 5 
C.06  OCT 6 
C.07  OCT 7 
C.72  EQU LENG
CM8   DEC -8
CM72  DEC -72 
CM73  DEC -73 
* 
C.M1  OCT 177777
CHMK  OCT 377       8-BIT CHARACTER MASK
DELX  OCT 6577      RETURN/RUB-OUT
SLSH  OCT 57         SLASH
SLEN  OCT 105        E
SLLS  OCT 114        L
SLIN  OCT 111        I
SLDL  OCT 104        D
SLRP  OCT 122        R
SLCH  OCT 103        C
SLAB  OCT 101 
EXMK  OCT 41         !
COMA  OCT 54        COMMA 
BLKX  OCT 40         SPACE(BLNK)
CHCT  OCT 0          CHARACTER COUNT WORD FOR -GETC-
M525  OCT 52525      UPPER/LOWER CHAR. INDICATOR TO SE
F525  OCT 0          FLAG - 0=UPPER, 1=LOWER
CSAD  OCT 0         HOLDS STATEMENT ADDRESS FOR -GETC 
RSLT  OCT 0         HOLDS PARTIAL RESULT FOR -CONV- 
CNBR  OCT 0         HOLDS CURRENT NUMBER -COV-
MXNO  OCT 0         HOLDS NEGATIVE FIELD LENGTH -CONV 
CM60  OCT 177720    MINUS 60(8) 
CM12  OCT 177766    MINUS 12(8) 
LSTB  DEF *+2       DEFINES ADDRESS OF -LIST- BUFFER
SBUF  DEF *+4       ADDRESS OF SYM. FILE BUFFER 
SEQN  OCT 0         WORDS FOR LIST SEQUENCE NUMBER
      OCT 0          NUMBERS
BLNK  OCT 20040     BLANK WORD
INBUF BSS 36
CBUF  DEF *+1        CHARACTER BUFFER ADDRESS 
      BSS 44B        CHARACTER BUFFER 
* 
* 
UFLNG NOP 
DIAGL NOP 
EFLUN NOP 
SFLUN NOP 
UFLUN NOP 
EFCON OCT 700 
* 
B     EQU  1
A     EQU  0
* 
* DEFINE FWA OF EDIT FILE AREA
* 
F.AM  DEF NMBR+100B      SKIP SOURCE READ/WRITE ROUT
      HED ** R/T EDITOR  - INITIALIZATION SECTION **
* 
*  THE R/T EDITOR IS SCHEDULED BY THE OPERATOR
* CONTROL STATEMENT:
* 
*     'ON,EDIT,P1,P2,P3,P4' 
* 
* THE PARAMETER LIST IS OPTIONAL AND IS PRESENT 
* ONLY IF THE INPUT UNITS DIFFER FROM THE 
* STANDARD UNITS OR IF A 'LIST' PASS IS DESIRED.
* THE DEFINITION OF THE PARAMETERS IS:
* 
*  P1 - LOGICAL UNIT # FOR INPUT OF 'EDIT FILE' 
*       (IF P1 NOT PRESENT, UNIT 5 IS ASSUMED)
* 
*  P2 - LOGICAL UNIT # FOR INPUT OF 'SYMBOLIC FILE' 
*       (IF P2 NOT PRESENT, UNIT 5 IS ASSUMED)
*       LUN=2 IF FILE FROM DISK 
* 
*  P3 - LOGICAL UNIT # FOR OUTPUT OF 'UPDATED FILE' 
*       (IF P3 NOT PRESENT, UNIT 4 IS ASSUMED FOR 
*        NORMAL EDIT OPERATION; UNIT 6 IS ASSUMED 
*        FOR 'LIST ONLY' PASS)
*       LUN=2 IF FILE TO DISK 
* 
*  P4 - =1 : A LISTING OF THE 
*       SYMBOLIC FILE IS TO BE GENERATED WITH 
*            SEQUENCE NUMBERS ON EACH RECORD
*       =2 : A DISK-FILE OF THE SYMBOLIC FILE IS
*            TO BE GENERATED
*            =0 OR NOT PRESENT : NORMAL EDIT RUN
* 
* ON ENTRY AT 'EDIT', THE B-REGISTER CONTAINS 
* THE ADDRESS OF THE PARAMETER LIST FROM THE
* 'ON' STATEMENT. 
* 
      SKP 
EDIT  LDA B,I      GET 'P1' 
      SZA,RSS      IF = 0 
      LDA C.05      USE LU # 5 FOR EDIT FILE. 
      STA EFLUN    SET AS CONTROL WORD. 
      IOR EFCON    ADD 700(8) WITH LU # 
      STA EFCON     FOR CONTROL FUNCTION. 
* 
      INB 
      LDA B,I      GET 'P2' 
      SZA,RSS      IF = 0,
      LDA C.05      USE LU # 5 FOR SYMBOLIC FILE. 
      STA SFLUN    SET AS CONTROL WORD. 
* 
      INB 
      LDA B,I      GET 'P3' 
      STA DIAGL     AND SAVE IT.
* 
      INB 
      LDA B,I      GET 'P4' 
      CPA C.01      IF =1, GO 
      JMP LISTI     TO LIST SYMBOLIC FILE.
      CPA C.02      CREATE ORIGINAL SOURCE FILE?
      JMP GFILE     YES 
* 
      LDA DIAGL    GET 'P3' AGAIN.
      CPA C.02      OUTPUT TO DISK ?
      JMP EDIT4     YES 
      SZA,RSS      IF = 0,
      LDA C.04      USE LU #4 FOR UPDATED FILE. 
      IOR LTGCW    SET 'P' BIT FOR PUNCHING 'ASCII' 
      STA LTGCW     ON ASR-35 AND SET CONTROL WORD
      STA UFLUN     FOR WRITE AND LEADER. 
EDIT1 LDA EFLUN 
      CPA C.02      EDIT FILE FROM DISK ? 
      JMP FLERR 
* 
      JSB EXEC     GET
      DEF *+4       STATUS
      DEF C.13      OF EDIT FILE
      DEF EFLUN     UNIT. 
      DEF STATS 
* 
      LDA STATS     STATUS WORD 
      ALF,ALF      EXAMINE
      AND M77       EQUIP. TYPE CODE. 
      CLB          (B) = 0 IF NOT TTY.
      SZA,RSS      IF CODE = 0, 
      LDB M400      SET (B) FOR KEYBOARD INPUT
      ADB EFLUN      IF UNIT IS TELETYPE. 
      STB EFLUN    -RESET CONTROL WORD. 
* 
      LDA SFLUN     SOURCE FILE 
      CPA C.02      FROM DISK ? 
      JMP EDIT3 
EDIT2 LDA F.AM      INITIALIZE FWA
      STA EDAD      AVAILABLE MEMORY
* 
      LDB EFLUN 
      CPB M401      EDIT FILE FROM SYSTEM TTY ? 
      RSS           YES 
      JMP ED02      BEGIN EDIT OPERATION. 
      LDA EFMES 
      JSB DIAG      PRINT MESSAGE 
      JMP ED02      BEGIN EDIT OPERATION
EFMES DEF *+1 
      DEC -16 
      ASC 8,ENTER EDIT FILE:
EDIT3 LDA 1767B 
      SZA,RSS       IS DISK SOURCE-FILE DEFINED ? 
      JMP FLERR     NO, ABORT AFTER ERROR MESSAGE 
      CLB 
      LSL 1 
      ADB C.02
      LSL 8         FORM LUN-TRACK NO.
      STB RTRK1     SET READ-TRACK NO.1 
      STB RTRKC     = CURRENT READ-TRACK
      JMP EDIT2 
EDIT4 STA UFLUN     LUN(OUTPUT)= 2
      JSB %WRIN     INITIALIZE WRITE SOURCE 
      JMP DOVF      FULL DISK,ABORT EDIT
      STA WTRK1     SET 1ST WRITE-TRACK 
      STA WTRKC     = CURRENT WRITE TRACK 
      JMP EDIT1 
RTRK1 BSS 1         LUN-READ TRACK FOR 1ST READ-TRAK
RTRKC BSS 1                        CURRENT READ-TRAK
WTRK1 BSS 1                        1ST WRITE TRACK
WTRKC BSS 1                        CURRENT WRITE TRK
STATS BSS 1 
M401  OCT 401 
      SKP 
* 
* LIST OPTION SELECTED
* 
* 
LISTI JSB DNGI     INITIALIZE SEQUENCE NUMBER.
      LDA DIAGL    GET 'P3' AGAIN.
      SZA,RSS      IF 0,
      LDA C.06      USE LU #6 FOR LIST OUTPUT 
      STA UFLUN      UNIT, SET LU # 
      IOR LSPCW      IN CONTROL WORD
      STA LSPCW      FOR LINE SPACING.
* 
LIST  JSB SYMI      GET SYMBOLIC FILE RECORD
      SZA,RSS       IF 'TERMINATION,
      JMP LISTE      GO TO FINISH.
      ADA C.06      ADD 6 TO RECORD LENGTH
      CMA,INA       SET NEGATIVE, 
      STA CSAF      SAVE CHAR. LENGTH 
      JSB DNGE      GET SEQUENCE NUMBER 
      STA SEQN        FOR RECORD AND STORE IN 
      STB SEQN+1       BUFFER 
      LDA CM72     (A) = -72
      LDB C.72     SUBTRACT RECORD
      ADB CSAF      LENGTH FROM 72. 
      SSB          IF GT 72,
      STA CSAF      USE MAX OF 72 CHARACTERS. 
* 
      ISZ LINCT    INDEX LINE COUNT 
      JMP LIST1     -NOT 0, OUTPUT RECORD.
* 
      LDA CM61     RESET
      STA LINCT     LINE COUNT
* 
      JSB EXEC     SKIP 
      DEF *+4       5 
      DEF C.03      LINES FOR 
      DEF LSPCW     PAGE FORMAT.
      DEF C.05
* 
* 
LIST1 JSB EXEC     WRITE
      DEF *+5       SYMBOLIC
      DEF C.02       FILE 
      DEF UFLUN      RECORD 
      DEF SEQN       CONCATENATED TO
      DEF CSAF       4-DIGIT SEQUENCE #.
* 
      JMP LIST     GET NEXT RECORD
* 
LISTE JSB EXEC     SKIP 
      DEF *+4       TO
      DEF C.03      BOTTOM
      DEF LSPCW      OF PAGE
      DEF LINCT 
* 
      JMP EN03     GO TO TERMINATE LIST RUN.
* 
LSPCW OCT 1100
C.13  DEC 13
LINCT DEC -1
CM61  DEC -61 
M77   OCT 77
M400  OCT 400 
      SKP 
* 
*  SUBROUTINE TO GENERATE SEQUENTIAL DECIMAL NUMBERS
*   - 1 TO 999 WITH LEADING BLANKS
*  CALLED BY: JSB DNGE  (JSB DNGI TO INITIALIZE)
*  ON RETURN A AND B CONTAIN ASCII OF NUMBER- 
*    RIGHT JUSTIFIED TO B.  NO ERROR RETURNS
* 
DNGE  NOP           ENTRY 
      LDB NMBR      DETERMINE THOUSANDS POSITION
      ADB THCT      ADDRESS FOR VALUE 
      LDA BREG,I    LOAD NUMERIC VALUE IN A 
      ALF,ALF       ROTATE CHARACTER TO HIGH A
      LDB NMBR       DETERMINE HUNDREDS POSITION
      ADB HDCT      ADDRESS FOR VALUE 
      IOR BREG,I    PACK CHARACTERS IN A
      STA DNG1      SAVE THOUS. AND HUNDREDS
      LDB NMBR      DETERMINE TENS POSITION 
      ADB TECT      ADDRESS FOR VALUE 
      LDA BREG,I    NUMERIC (ASCII) VALUE TO A
      ALF,ALF       ROTATE CHAR. TO HIGH A
      LDB NMBR      DETERMINE UNITS POSITION
      ADB UNCT      ADDRESS FOR VALUE 
      IOR BREG,I    PACK CHAR. IN A 
      STA DNG2       SAVE TENS AND UNIT 
      ISZ UNCT      INCREASE UNIT POINTER 
      JMP DNGX       EXIT 
      LDA MI10      EQUAL TO 9. RESET TO
      STA UNCT      ZERO POSITION 
      ISZ TECT      INCREASE TENS POINTER 
      JMP DNGX       EXIT 
      STA TECT      RESET TO ZERO POSITION
      ISZ HDCT      INCREASE HUNDREDS POINTER 
      JMP DNGX       EXIT 
      STA HDCT      RESET TO ZERO POSITION
      ISZ THCT      INCREASE THOUSANDS POINTER
      JMP DNGX       EXIT 
      STA THCT      RESET TO ZERO POSITION
DNGX  LDA DNG1      SET A = THOUS/HUNDRED 
      LDB DNG2      SET B = TENS/UNITS
      JMP DNGE,I     EXIT 
DNGI  NOP           INITIALIZATION SECTION
      LDA MI10       SET TENS, HUNDREDS 
      STA TECT       AND THOUSANDS TO 
      STA HDCT       ZERO POSITION. 
      STA THCT      SET UNITS TO
      INA            ONE POSITION FOR 
      STA UNCT       FIRST NUMBER 
      JMP DNGI,I     EXIT 
DNG1  OCT 0         HOLDS DECIMAL NUMBER
DNG2  OCT 0          GENERATED (IN ASCII) 
MI10  OCT 177766    MINUS 10
BREG  OCT 100001    ADDRESS OF B-REGISTER 
UNCT  OCT 0         POSITION
TECT  OCT 0          POINTERS 
HDCT  OCT 0 
THCT  OCT 0 
* 
*  FOLLOWING TABLE CONTAINS ASCII CODES CORRESPONDING 
*    TO ZERO TO NINE. 
      OCT 60        ASCII - ZERO
      OCT 61         1
      OCT 62         2
      OCT 63         3
      OCT 64         4
      OCT 65         5
      OCT 66         6
      OCT 67         7
      OCT 70         8
      OCT 71         9
NMBR  DEF * 
* 
      END EDIT