*DECK     ICD 
          IDENT  ICD,/CTI/ICDLOAD 
          PERIPH
*CALL,VERS
          TITLE  ICD         CTI INSTALL CTI ON DISK - "VERS" 
          COMMENT CTI INSTALL CTI ON DISK - "VERS"
          COMMENT COPYRIGHT CONTROL DATA CORPORATION, 1979
*CALL,CDCCRN
 SAD      SPACE  4,10 
*****     ICD - INSTALL CTI ON DISK. CTI. 
* 
*         R. A. TURGEON                06/26/78.
* 
*         ICD INSTALLS THE CTI PACKAGE ONTO AN 844 OR 885 RMS 
*         DEVICE AT 2 TO 1 INTERLACE FROM ANY DEADSTART DEVICE. 
          SPACE  4,10 
***       ICD - INSTALL CTI ON DISK. CTI. 
* 
* 
*         ICD PROVIDES TWO MAIN OPTIONS.
* 
*   1.    INSTALL CTI ON AN RMS DEVICE. 
*         ICD WILL GET A CONNECT CODE FROM THE OPERATOR AND 
*         THEN WRITE A NEW DEADSTART SECTOR AND COPY ALL OF 
*         THE CTI MODULES TO THE CTI CYLINDER.  THE FIRST 
*         MODULE WILL BE IPL AND THE LAST WILL BE ZZZ.
*         THE ADDRESS OF THE FIRST MODULE WILL BE KEPT IN 
*         CTI WORD 2 OF THE COMMON POINTER AREA.  THE ADDRESS 
*         OF THE FIRST MODULE WHICH IPL WILL LOAD WHEN DEADSTART
*         OCCURS IS KEPT IN CTI WORD 1 OF THE COMMON POINTER
*         AREA. 
* 
*   2.    RELEASE CMSE-RESERVED SPACE.
*         ICD WILL GET A CONNECT CODE FROM THE OPERATOR AND 
*         THEN READ THE CURRENT DEADSTART SECTOR, ZERO-OUT
*         THE CMSE AND DDS AND CTI WORDS OF THE COMMON
*         POINTER AREA, AND THEN REWRITE THE DEADSTART SECTOR.
* 
*         WHEN THE INSTALL OPTION HAS BEEN SELECTED,
*         THE OVERLAY *ICE* IS USED TO BUILD THE CTI CYLINDER.
          SPACE  4,10 
*         SPECIAL NOTE ON 885 DEADSTART SECTOR READS/WRITES 
* 
*         THE FOLLOWING SYMBOL INDICATES WHETHER OR NOT THE 
*         DEADSTART SECTOR ON AN 885 IS IN A FLAWED TRACK.
  
 DSIFT    EQU    0                 D.S. SECTOR NOT IN FLAWED TRACK
*         EQU    1                 D.S. SECTOR IN FLAWED TRACK
          TITLE  DEFINITIONS. 
**        DEADSTART PANEL WORDS.
* 
*         WORDS 5 - 20B OF THE DEADSTART PANEL MUST REMAIN INTACT 
*         DURING CTI EXECUTION. WORDS 0 - 4 MAY BE USED AS SCRATCH
*         DIRECT CELLS. 
 D0       EQU    0                 SCRATCH
 D1       EQU    1                 SCRATCH
 D2       EQU    2                 SCRATCH
 D3       EQU    3                 SCRATCH
 D4       EQU    4                 SCRATCH
 D5       EQU    5                 ZERO IF TAPE DEADSTART 
 D6       EQU    6                 FUNCTION WORD
*         (D6) = WARMSTART FUNCTION, IF MTS/ATS.
*              = DEADSTART FUNCTION, IF 844/885 DISK
 D7       EQU    7                 RESERVED 
*         (D7) = 1400B IF 3000 TYPE TAPE. 
 D10      EQU    10B               RESERVED 
 D11      EQU    11B               RESERVED 
 D12      EQU    12B               MSL PARAMETERS 
 D13      EQU    13B               OS PARAMETERS
 D14      EQU    14B               OS PARAMETERS
 D15      EQU    15B               UNUSED 
 D16      EQU    16B               C80/A170 RESERVED
 D17      EQU    17B               RESERVED 
 D20      EQU    20B               RESERVED 
 INS      SPACE  4,10 
**        INSTRUCTION EQUATES.
* 
 PSNC     EQU    0000B             PASS 
 UJNC     EQU    0300B             UNCONDITIONAL JUMP 
 ZJNC     EQU    0400B             ZERO JUMP
 SHNC     EQU    1000B             SHIFT
 LCNC     EQU    1500B             LOAD COMPLEMENT
 SBNC     EQU    1700B             SUBTRACT NO-ADDRESS
 LDCC     EQU    2000B             LOAD CONSTANT
 ADCC     EQU    2100B             ADD CONSTANT 
 LMCC     EQU    2300B             LOGICAL MINUS CONSTANT 
 LDDC     EQU    3000B             LOAD DIRECT
 AJMC     EQU    6400B             ACTIVE JUMP
 IAMC     EQU    7100B             INPUT MEMORY 
 OAMC     EQU    7300B             OUTPUT MEMORY
 ACNC     EQU    7400B             ACTIVATE CHANNEL 
 DCNC     EQU    7500B             DISCONNECT CHANNEL 
          SPACE  4,10 
          SPACE  4,10 
**        MISCELLANEOUS DEFINITIONS 
* 
* 
 RICHI$   EQU    0       ALLOW SELECTIVE CHANNEL REDEFINITION 
 TIMEOUT  EQU    70000             TIMEOUT COUNT FOR DISK 
 NAME     EQU    5                 OFFSET OF NAME IN PRFX TABLE 
 DEBUG$   EQU    0                 DEBUG MODE IF .GT. 0 
 DSP      SPACE  4,10 
**        DISPLAY CONTROLLER DEFINITIONS. 
* 
* 
 CHD      EQU    10B               DISPLAY CHANNEL
*         DISPLAY FUNCTION CODES. 
 F.SEL    EQU    7000B             SELECT CONSOLE DISPLAY 
 F.SLS    EQU    0000B             SELECT CONSOLE LEFT SCREEN 
 F.SRS    EQU    0100B             SELECT CONSOLE RIGHT SCREEN
 F.SBS    EQU    0200B             SELECT CONSOLE BOTH SCREEN 
 F.CHR    EQU    0000B             SELECT CHARACTER MODE
 F.DOT    EQU    0010B             SELECT DOT MODE
 F.KEY    EQU    0020B             SELECT KEYBOARD INPUT
 F.CHS    EQU    0000B             SET CHARACTER SIZE SMALL 
 F.CHM    EQU    0001B             SET CHARACTER SIZE MEDIUM
 F.CHL    EQU    0002B             SET CHARACTER SIZE LARGE 
*         COORDINATE DESIGNATION. 
 XSET     EQU    6000B             SET X COORDINATE 
 YSET     EQU    7000B             SET Y COORDINATE 
 YINCR    EQU    22B               Y INCREMENT PER LINE 
          TITLE  DEFINITION COMMON DECKS. 
          SPACE  4,10 
**        DEFINITION COMMON DECKS.
* 
**        ALL SYMBOL AND MACRO DEFINITION COMMON DECKS ARE CALLED HERE. 
*CALL     COMPCTI 
*CALL     COMPCHI 
*CALL     COMS844 
*CALL     COMS885 
*CALL     COMSCPA 
*CALL     COMSCTI 
          SPACE  4,10 
 DSLN     EQU    /CPA/DSLN
 PRU      EQU    /CPA/PRU 
          SPACE  4,10 
*         DEFINE 885 D.S. SECTOR FUNCTIONS
  
          IFEQ   DSIFT,0
 DSR885   EQU    /885/DRED
 DSW885   EQU    /885/DWLS
          ELSE
 DSR885   EQU    /885/DRFS
 DSW885   EQU    /885/DWFS
          ENDIF 
          TITLE  DIRECT-CELL AND LOW-CORE DEFINITIONS 
**        DIRECT CELL DEFINITIONS 
* 
* 
 REPADDR  EQU    20B
 RETRY    EQU    21B               RETRY COUNTER
 IOR      EQU    22B               INITIAL OPERATOR RESPONSE
 MSGLEN   EQU    23B               WHEN MSG LENGTH .GT. 77B 
 FCNF     EQU    24B               SAVE AREA FOR FCN
 GENSTAT  EQU    25B               GENERAL STATUS SAVE AREA 
 CHAN     EQU    26B               1ST WORD OF QOD COMM AREA
 UNIT     EQU    CHAN+1            2ND WORD OF QOD COMM AREA
 DTYPE    EQU    UNIT+1            0=885, 1=844S, 2=844D
 TRKSPER  EQU    DTYPE+1           TRACKS PER CYLINDER
 SECSPER  EQU    TRKSPER+1         SECTORS PER TRACK
 DSCYL    EQU    SECSPER+1         DEADSTART CYLINDER 
 DSTRK    EQU    DSCYL+1           DEADSTART TRACK
 DSSEC    EQU    DSTRK+1           DEADSTART SECTOR 
 CTICYL   EQU    DSSEC+1           CTI CYLINDER 
 CTITRK   EQU    CTICYL+1          CTI TRACK
 CTISEC   EQU    CTITRK+1          CTI SECTOR 
 RWADDR   EQU    CTISEC+1          ADDR OF DATA FOR RSEC/WSEC 
 LENGTH   EQU    RWADDR+1          LENGTH REMAINING 2 B WRITTEN 
 PREV     EQU    LENGTH+1          TTSS OF LAST GOOD WRITE
 RVLTRK   EQU    PREV+1 
 RVLSEC   EQU    RVLTRK+1 
 RVLLB2   EQU    RVLSEC+1 
 CMADDR   EQU    RVLLB2+1 
 CTICSC   EQU    CMADDR+1          CTI-CYLINDER SECTOR COUNT
          SPACE  4,10 
**        OTHER LOW-CORE DEFINITIONS
* 
 CPBLEN   EQU    40 
 CPBCTI   EQU    /CTI/ICDLOAD-CPBLEN-2
 CPBMS    EQU    CPBCTI+10
 CPBDS    EQU    CPBMS+10 
 CPBOS    EQU    CPBDS+10 
 CPBUFF   EQU    CPBCTI 
          TITLE  MAIN ROUTINE 
          ORG    /CTI/ICDLOAD 
          QUAL   ICD
          SPACE  4,10 
*         ICD - INSTALL CTI ON DISK.  CTI.
* 
* 
 ICD      UJN    S05               ENTRY POINT WHEN FIRST LOADED
 ICDALT   LJM    S129        ENTRY FOR NORMAL RETURN FROM ICE 
 ICDERR   RJM    ERROR       ENTRY FROM ICE FOR DEVICE ERROR
 ICDERR2  RJM    ERRFLO      ENTRY FROM ICE FOR CYLINDER OVERFLOW 
          SPACE  4,10 
*         HANG ALL OTHER PP-S.
 S05      RJM    HPP
          IFGT   DEBUG$,0 
*         CLEAR 65K OF CENTRAL MEMORY 
          LDN    0
          STD    CMADDR 
          STD    5
          STD    6
          STD    7
          STD    8
          STD    9
          LDC    177777B
 CC$2     CWD    5
          SBN    1
          PJN    CC$2 
          ENDIF 
          SPACE  4,10 
*         PRESENT MSG A AND WAIT FOR CR OR R. 
 S10      LDC    MSGAL
          STD    MSGLEN 
          LDC    MSGA 
          RJM    DIS
          LDC    ORTR 
          RJM    PKI
          ZJN    S10               IF NO VALID INPUT YET
          SBN    60B
          STD    IOR               SAVE INIT OPER RESP
          ZJN    S50               IF I.O.R. = CR 
          LJM    S200              IF TO RELEASE
          SPACE  4,10 
*         PRESENT MSG B AND WAIT FOR CR 
 S50      LDC    MSGBL
          STD    MSGLEN 
          LDC    MSGB 
          RJM    DIS
          LDC    ORTCR
          RJM    PKI
          ZJN    S50               IF NO CR YET 
          SPACE  4,10 
*         CALL QOD TO GET CONNECT CODE
 S60      RJM    CQOD 
          RJM    CLRCPB            CLEAR CPBUFF 
          SPACE  4,10 
*         READ DEADSTART SECTOR 
 S70      RJM    RDSS 
          ZJN    S100              IF OK AND FLAWED 
          PJN    S120              IF NOT FLAWED
*         UJN    S80               IF UNABLE TO ACCESS DEVICE 
          SPACE  4,10 
*         PRESENT MSG E/F AND WAIT FOR CR. THEN GOTO TOP. 
 S80      LDC    MSGEL*1S12+MSGE
          RJM    DIS
          LDC    MSGFL*1S12+MSGF
          RJM    DIS
          LDC    ORTCR
          RJM    PKI
          ZJN    S80               IF NO CR YET 
          LJM    S10
          SPACE  4,10 
*         COPY POINTER WORDS OF DEADSTART SECTOR JUST READ
*         TO OUR CPBUFF.
 S100     LDN    CPBLEN-1 
          STD    D1 
 S105     LDM    BUFFER+/CPA/CIDP-/CTI/IPLA,D1
          STM    CPBUFF,D1
          SOD    D1 
          PJN    S105 
          SPACE  4,10 
*         WRITE CTI MODULES TO THE CTI CYLINDER 
 S120     LDC    S120P
          LJM    /CTI/CDEP         CALL COMMON DRIVER TO LOAD OVERLAY 
 S120P    CON    /CTI/ICDLOAD      LOAD ADDRESS 
          CON    /CTI/ICDLOAD      TRANSFER ADDRESS 
          CON    0                 NO REWIND FIRST
          VFD    18/3LICE,6/0      NAME OF ICD OVERLAY
 S129     EQU    *
          LDC    CHTB 
          RJM    ICN               RESTORE CHANNEL INSTRUCTIONS 
          SPACE  4,10 
*         READ IPL FROM DEADSTART DEVICE
 S130     LDC    S130P
          LJM    /CTI/CDEP         CALL COMMON DRIVER 
 S130P    CON    BUFFER            LOAD ADDRESS 
          CON    S139              TRANSFER ADDRESS 
          CON    1,0,0             REWIND,READ NEXT,NO STRIPPING
 S139     LDM    BUFFER+NAME       VERIFY THAT IT IS IPL
          LMC    2RIP 
          NJN    S139T
          LDM    BUFFER+NAME+1
          LMC    1RL*100B 
          ZJN    S140 
 S139T    LDC    MSGKL*1S12+MSGK  IF NOT IPL
          RJM    DIS
          UJN    S139T
          SPACE  4,10 
*         COPY CPBUFF INTO IPL RECORD JUST READ 
 S140     LDN    CPBLEN-1 
          STD    D1 
 S145     LDM    CPBUFF,D1
          STM    BUFFER+/CPA/CIDP-/CTI/IPLA,D1
          SOD    D1 
          PJN    S145 
          SPACE  4,10 
*         WRITE NEW DEADSTART SECTOR
 S150     RJM    WDSS 
          LDN    /844/DOPC
          RJM    FCN               DROP RESERVE 
          SPACE  4,10 
*         PRESENT MSG H/F OR I/F AND WAIT FOR CR
 S190     LDD    IOR
          NJN    S195              IF I.O.R. NOT CR 
          LDC    MSGHL*1S12+MSGH
          UJN    S196 
 S195     LDC    MSGIL*1S12+MSGI
 S196     RJM    DIS
          LDC    MSGFL*1S12+MSGF
          RJM    DIS
          LDC    ORTCR
          RJM    PKI
          ZJN    S190              IF NO CR YET 
          LJM    S10
          SPACE  4,10 
*         HERE IF RELEASING 
 S200     RJM    CQOD              CALL QOD TO GET CONNECT CODE 
          RJM    CLRCPB            CLEAR CPBUFF 
          RJM    RDSS              READ DEADSTART SECTOR
          ZJN    S250              IF OK AND FLAWED 
          PJN    S270              IF NOT FLAWED
          LJM    S80               IF UNABLE TO ACCESS DEVICE 
          SPACE  4,10 
*         COPY OS WORDS OF DEADSTART SECTOR TO CPBUFF 
 S250     LDN    10-1 
          STD    D1 
 S255     LDM    BUFFER+/CPA/OSDP-/CTI/IPLA,D1
          STM    CPBOS,D1 
          SOD    D1 
          PJN    S255 
          SPACE  4,10 
*         PRESENT MSG G AND WAIT FOR CR 
 S270     LDC    MSGGL*1S12+MSGG
          RJM    DIS
          LDC    ORTCR
          RJM    PKI
          ZJN    S270              IF NO CR YET 
          LJM    S130 
          TITLE  SUBROUTINES
          SPACE  4,10 
**        CLRCPB - CLEAR CPBUFF 
* 
 CLRCPB   ENM    X                 ENTRY/EXIT 
          LDN    CPBLEN-1 
          STD    D1 
 CLRCPB2  LDN    0
          STM    CPBUFF,D1
          SOD    D1 
          PJN    CLRCPB2
          UJN    CLRCPBX           RETURN 
          SPACE  4,10 
**        CQOD - CALL QOD AND INSERT CHANNEL NUMBER 
* 
*         ENTRY  (IOR) = 0 IF I.O.R. WAS CR 
 CQOD     ENM    X                 ENTRY/EXIT 
          LDN    0
          STD    CHAN 
          STD    UNIT 
          LDN    CHAN 
          STD    REPADDR
          LDD    IOR
          NJN    CQOD5             IF NOT CR
          LDC    MSGCL*1S12+MSGC
          UJN    CQOD7
 CQOD5    LDC    MSGDL*1S12+MSGD
 CQOD7    RJM    /QOD/QOD          CALL QOD 
          LDC    CHTB 
          RJM    ICN               INSERT CHANNEL NUMBER
          UJN    CQODX             RETURN 
          SPACE  4,10 
**        DIS - DISPLAY MESSAGE ON DD60 
* 
*         DIS OUTPUTS A SPECIFIED BUFFER TO THE DISPLAY.
* 
*         ENTRY  (A) = LLAAAA WHERE 
*                      LL = LENGTH OF MESSAGE BUFFER
*                      AAAA = FWA OF MESSAGE BUFFER.
*                      IF LL = 0, THEN MSGLEN HAS LENGTH
 DIS      ENM    X                 ENTRY/EXIT 
          STM    DISB              STORE FWA OF MSG 
          SHN    6
          LPN    77B               ISOLATE LENGTH 
          NJN    DIS4 
          LDD    MSGLEN 
 DIS4     FNC    F.SEL+F.SLS+F.CHR+F.CHM,CHD
          ACN    CHD
          OAM    **,CHD            OUTPUT MSG 
 DISB     EQU    *-1
          FJM    *,CHD       WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    CHD
          SBN    40B         DISPLAY REFRESH DELAY
          MJN    *-1
          UJN    DISX              RETURN 
          SPACE  4,10 
**        ERROR - PROCESS MESSAGES FOR DEVICE ERRORS
* 
*         DISPLAY MSG J/F, WAIT FOR CR, AND GOTO TOP. 
 ERROR    ENM    X                 ENTRY ONLY BECAUSE NO RETURN 
          LDC    CHTB        INSERT CHANNEL NUMBER
          RJM    ICN
          LDC    ERROR2      RESET ART SPECIAL EXIT 
          STM    ARTEC
          LDN    10                                                      DIMA369
          STD    RETRY                                                   DIMA369
          LDN    /844/DOPC
          RJM    FCN               DROP RESERVE 
 ERROR2   LDC    MSGJL*1S12+MSGJ
          RJM    DIS
          LDC    MSGFL*1S12+MSGF
          RJM    DIS
          LDC    ORTCR
          RJM    PKI
          ZJN    ERROR2            IF NO CR YET 
          LJM    S10               GOTO TOP 
          SPACE  4,10 
**        ERRFLO - PROCESS MESSAGES FOR CTI CYLINDER OVERFLOW 
* 
*         ERRFLO WILL PRESENT THE MESSAGES -CTI CYLINDER OVERFLOW-
*                AND -(CR) TO PROCESS DIFFERENT DEVICE-.  WHEN A
*                CR IS RECEIVED, WILL DISPLAY THE  B MESSAGE. 
* 
*         USES   NONE.
* 
*         CALLS  ICN,FCN,DIS,PKI. 
* 
*         EXIT   DOES NOT RETURN TO CALLER. 
  
 ERRFLO   ENM    X           ENTRY ONLY 
          LDC    CHTB        INSERT CHANNEL NUMBER
          RJM    ICN
          LDC    ERROR3      RESET ART SPECIAL EXIT 
          STM    ARTEC
          LDN    /844/DOPC
          RJM    FCN         DROP RESERVE 
 ERROR3   LDC    MSGLL*1S12+MSGL
          RJM    DIS         PRESENT MESSAGE -CTI CYLINDER OVERFLOW-
          LDC    MSGFL*1S12+MSGF
          RJM    DIS         PRESENT MESSAGE
          LDC    ORTCR
          RJM    PKI         PROCESS KEYBOARD INPUT 
          ZJN    ERROR3      IF NO CR 
          LJM    S50         GO TO PRESENT MESSAGE B
          SPACE  4,10 
**   HPP - HANG PP-S
* 
*         HPP HANGS ALL ACTIVE PP-S THEREBY FREEING ALL CHANNELS. 
* 
*         CALLS ICN 
* 
*         USES   CHAN 
 HPP      ENM    X                 ENTRY/EXIT 
          LDN    1
 HPP03    STD    CHAN              CURRENT CHANNEL
 HPP04    LDD    CHAN 
          SBN    12B
          MJN    HPP06             IF IN RANGE 1-11 
          NJN    HPP05             IF IN RANGE 20-32
          LDN    20B
          UJN    HPP03
 HPP05    SBN    32B-12B
          PJN    HPPX              IF DONE, RETURN
*         A VALID CHANNEL HAS BEEN FOUND. HANG THE ASSOC PP.
 HPP06    LDC    HPPE              FWA OF CHANNEL LIST
          RJM    ICN               INSERT CHANNEL NO. 
 HPPA     IJM    HPP07,40B         IF NOT ACTIVE
          LDN    2
 HPPB     OAM    HPPD,40B 
 HPPC     DCN    40B
 HPP07    AOD    CHAN 
          UJN    HPP04             CONTINUE 
 HPPD     CON    0,UJNC            PP HANG PROGRAM
 HPPE     CON    HPPA,HPPB,HPPC,0 
 ICN      SPACE  4,10 
**        ICN - INSERT CHANNEL NO.
* 
*         ICN INSERTS CHANNEL NO.S IN INSTRUCTIONS GIVEN
*         IN A LIST TERMINATED WITH A ZERO. 
* 
*         ENTRY  (A) = FWA OF CHANNEL LIST. 
*                (CHAN) = CHANNEL NO. 
* 
*         USES   D2, D3.
 ICN      ENM    X                 ENTRY/EXIT 
          STD    D2 
 ICN1     LDI    D2 
          ZJN    ICNX              IF LIST COMPLETE 
          STD    D3 
          LDI    D3 
          SCN    37B
          ADD    CHAN              ADD IN NEW CHANNEL NO. 
          STI    D3 
          AOD    D2 
          UJN    ICN1              CONTINUE PROCESSING
          SPACE  4,10 
**        PKI - PROCESS KEYBOARD INPUT
* 
*         PKI READS KEYBOARD AND CHECKS INPUT AGAINST A 
*         TABLE SUPPLIED BY THE CALLER. 
* 
*         ENTRY  (A) = FWA OF TABLE OF VALID RESPONSES. 
*                      TABLE TERMINATED BY ZERO BYTE. 
* 
*         EXIT   (A) = 0 IF NO INPUT OR INPUT NOT VALID.
*                        ELSE A HAS INPUT CHARACTER.
* 
*         USES   D1,D2
 PKI1     LDD    D2                LOAD CHARACTER READ
 PKI      ENM    X                 ENTRY/EXIT 
          STD    D1                SAVE ADDRESS OF RESPONSE TABLE 
          FNC    F.SEL+F.KEY,CHD
          ACN    CHD
          IAN    CHD
          DCN    CHD
          ZJN    PKIX              IF NO INPUT
          STD    D2                SAVE ENTRY 
 PKI2     LDI    D1                GET TABLE VALUE
          ZJN    PKIX              IF END OF TABLE REACHED
          SBD    D2 
          ZJN    PKI1              IF MATCH FOUND 
          AOD    D1 
          UJN    PKI2 
          SPACE  4,10 
          TITLE  DISK SUBROUTINES 
          SPACE  4,10 
          RICHI                    ENABLE CHANNEL MACROES 
 ART      SPACE  4,10 
**        ART - ADJUST RETRY COUNTER
* 
*         DECREMENT COUNTER AND 
*         RETURN TO CALLER IF COUNTER .GE. 0
*         ELSE GOTO ERROR IF ARTEC = 0
*         RDSSERR OR ERROR2 OR ERROR3 IF ARTEC .NE. 0.
* 
 ART      ENM    X                 ENTRY/EXIT 
          SOD    RETRY
          PJN    ARTX              EXIT IF MORE RETRIES AVAILABLE 
          LDM    ARTEC             CHECK EXIT CODE
          NJN    ART5              IF SPECIAL EXIT
          RJM    ERROR             IF NO MORE RETRIES AVAILABLE 
 ART5     LJM    ** 
 ARTEC    EQU    *-1
 AWD      SPACE  4,10 
**        AWD - ACTIVATE CHANNEL AND WAIT FOR DATA. 
* 
*         AWD ACTIVATES THE FUNCTIONED CHANNEL AND TIMES OUT A FULL 
*         CONDITION.
* 
*         EXIT   (A) .NE. 0, DATA ON CHANNEL. 
*                (A) = 0, NO DATA RECEIVED, CHANNEL DISCONNECTED. 
 AWD      ENM    X                 ENTRY/EXIT 
          ACN    40B               ACTIVATE CHANNEL 
          LDC    TIMEOUT
 AWD1     FJM    AWDX,0            IF FULL, RETURN
          SBN    1
          NJN    AWD1              IF TIME OUT NOT EXPIRED
          DCN    40B               DISCONNECT 
          UJN    AWDX              RETURN 
 FCN      SPACE  4,10 
**        FCN - FUNCTION DEVICE.
* 
*         ENTRY  (A) = FUNCTION CODE. 
* 
*         RETURNS TO CALLER IF NO ERRORS
*         ELSE GO TO ERROR PROCESSOR. 
 FCN      ENM    X                 ENTRY/EXIT 
          STD    FCNF              SAVE FUNCTION CODE 
 FCN3     LDD    FCNF              GET FUNCTION CODE
          FAN    40B               ISSUE FUNCTION 
          LDC    TIMEOUT
 FCN1     IJM    FCNX,0            IF FUNCTION ACCEPTED, RETURN 
          SBN    1
          NJN    FCN1              IF TIMEOUT NOT EXPIRED 
          DCN    40B
          RJM    ART               ASK TO RETRY 
          UJN    FCN3              TRY AGAIN
          SPACE  4,10 
**        GDS - GET DETAIL STATUS 
* 
*         GDS GETS DETAIL STATUS INTO BUFFER *DETAIL* 
* 
*         EXIT   (DETAIL) = DETAIL STATUS 
 GDS      ENM    X                 ENTRY/EXIT 
 GDS2     LDN    /844/DDSS
          RJM    FCN
          RJM    AWD
          NJN    GDS5              IF DATA ON CHANNEL 
          RJM    ART
          UJN    GDS2 
 GDS5     LDN    DETAILL
          IAM    DETAIL,0 
          DCN    40B
          UJN    GDSX              RETURN 
 DETAIL   BSSZ   /844/SLNS
 DETAILL  EQU    *-DETAIL 
 GGS      SPACE  4,10 
**        GGS - GET GENERAL STATUS. 
* 
*         GGS ISSUES THE GENERAL STATUS FUNCTION  AND UPDATES 
*         THE DIRECT CELL *GENSTAT*.  THE STATUS IS ALSO RETURNED 
*         IN (A). 
* 
*         EXIT   (GENSTAT) = GENERAL STATUS REPLY.
*                (A) = GENERAL STATUS REPLY.
* 
 GGS2     RJM    ART               ASK TO RETRY 
          UJN    GGS3              TRY AGAIN
 GGS      ENM    X                 ENTRY/EXIT 
 GGS3     LDN    /844/DGST
          RJM    FCN               FUNCTION DEVICE
          RJM    AWD               ACTIVATE CHAN AND WAIT FOR DATA
          ZJN    GGS2              IF NO DATA COMING
          IAN    0                 READ STATUS
          DCN    40B
          STD    GENSTAT
          UJN    GGSX              RETURN 
          SPACE  4,10 
**        CON  - CONNECT DISK DRIVE 
* 
*         CON CONNECTS TO THE DISK UNIT AND WAITS FOR 
*         DRIVE NOT RESERVED. 
* 
*         ENTRY  (UNIT) = UNIT NUMBER 
*         EXIT   (A)    = GENERAL STATUS WORD 
* 
*         CALLS  FCN,GGS. 
  
  
 CON      ENM    X                 ENTRY/EXIT 
 CON2     LDN    /844/DCON
          RJM    FCN               ISSUE CONNECT FUNCTION 
          ACN    0
          LDD    UNIT 
          OAN    0                 CONNECT UNIT 
          FJM    *,0
          DCN    40B
          RJM    GGS               GET GENERAL STATUS 
          LPN    /844/MP.GSDR 
          NJN    CON2              IF DRIVE RESERVED
          LDD    GENSTAT
          UJN    CONX 
          SPACE  4,10 
**        WNB  - WAIT NOT BUSY
* 
*         WNB WAITS FOR DRIVE NOT BUSY STATUS.
* 
*         EXIT   (A) = GENERAL STATUS WORD
* 
*         CALLS  GGS,CON. 
  
  
 WNB2     LDD    GENSTAT
 WNB      ENM    X                 ENTRY/EXIT 
          RJM    GGS
 WNB4     ZJN    WNBX              IF NOT BUSY AND NO ERRORS
          LPN    /844/MP.GSBS 
          ZJN    WNB2              IF NOT BUSY
          RJM    CON
          UJN    WNB4 
          SPACE  4,10 
**        RDSS - READ D.S. SECTOR FROM 844 (885)
* 
*         EXIT  (A) .LT. 0 IF UNABLE TO ACCESS DEVICE 
*               (A) = 0    IF OK AND FLAWED (NOT FLAWED)
*               (A) .GT. 0 IF OK BUT NOT FLAWED (FLAWED)
 RDSS     ENM    X                 ENTRY/EXIT 
          LDC    RDSSERR
          STM    ARTEC             SET SPECIAL EXIT 
          LDN    10B
          STD    RETRY             INITIALIZE RETRY COUNT 
 RDSS2    RJM    GGS               GET GENERAL STATUS 
          SHN    17-10
          MJN    RDSS2             IF CONTROLLER RESERVED 
 RDSS4    RJM    CON               WAIT FOR UNIT NOT RESERVED 
          SHN    17-11
          PJN    RDSS15            IF NO ALERT STATUS 
          RJM    ART
          UJN    RDSS4
  
 RDSS15   RJM    GDS               GET DETAIL STATUS
*         DETERMINE DEVICE TYPE 
          LDM    DETAIL+/844/DSWRV
          SHN    17-10
          MJN    RDSS45            IF 885 OR 844-DOUBLE 
          LDM    DETAIL+/844/DSWUD
          SHN    17-5 
          MJN    RDSS50            IF 844-DOUBLE
          LDC    D44SD             HERE IF 844-SINGLE 
          UJN    RDSS70 
 RDSS45   SHN    10-5 
          MJN    RDSS60            IF 885 
 RDSS50   LDC    D44DD             HERE IF 844-DOUBLE 
          UJN    RDSS70 
 RDSS60   LDM    DETAIL+/844/DSWCV DETERMINE IF WRITE ENABLED 
          LPN    20B
          NJN    RDSS65            IF WRITE ENABLED 
 RDSS64   LDC    MSGML*1S12+MSGM   IF WRITE NOT ENABLED 
          RJM    DIS               DISPLAY MESSAGE
          UJN    RDSS64            LOOP ON MESSAGE
 RDSS65   LDC    D885              IF 885 
 RDSS70   STM    RDSS75A           MOVE DISK ATTRIBUTES INTO PLACE
          LDN    D44DD-D44SD-1
          STD    D1 
 RDSS75   LDM    **,D1
 RDSS75A  EQU    *-1
          STM    DTYPE,D1 
          SOD    D1 
          PJN    RDSS75 
*         READ DEADSTART SECTOR 
 RDSS77   LDN    DSCYL
          RJM    SEK               SEEK 
          LDM    RDSST,DTYPE
          RJM    FCN               READ OR READ-FLAWED
          ACN    40B
          LDC    TIMEOUT
 RDSS78   FJM    RDSS79,0          WAIT UNTIL FULL
          SBN    1
          NJN    RDSS78 
          DCN    40B               TIMED OUT
          UJN    RDSS79J                                                 DIMA332
  
 RDSS79   LDC    DSLN 
          IAM    BUFFER,0          READ IN D.S. SECTOR
          DCN    40B
 RDSS79J  RJM    GGS               GET GENERAL STATUS 
          RJM    GDS               GET DETAIL STATUS
          LDD    GENSTAT
          ZJN    RDSS80            IF NO ERRORS 
          LDM    DETAIL+/844/DSWAE
          LPN    17B
          SBN    10B
          ZJN    RDSS80            IF FLAW ERROR
          RJM    ART               ELSE ASK TO RETRY
          LJM    RDSS77            TRY AGAIN
*         DETERMINE IF D.S. SECTOR  FLAWED. 
 RDSS80   LDN    0                 RESET ART EXIT CODE
          STM    ARTEC
          LDD    GENSTAT
          NJN    RDSS83            IF FLAW ERROR
          LDN    0
          LJM    RDSSX             RETURN 
 RDSS83   LDN    1                                                       DIMA332
          LJM    RDSSX             RETURN 
 RDSSERR  LDN    0
          STM    ARTEC             RESET ART EXIT ADDRESS 
          LCN    0                 SET A .LT. 0 
          LJM    RDSSX             RETURN 
          SPACE  4,10 
 RDSST    CON    /885/DRFS,/844/DRFS,/844/DRFS
 ADDR0    BSSZ   3
          SPACE  4,10 
 D44SD    CON    1,/844/MTKS,/844/MSRS
          CON    /844/CSDD,/844/TSDD,/844/SSDD
          CON    /844/DSSC,0,0
 D44DD    CON    2,/844/MTKS,/844/MSRS
          CON    /844/CDDS,/844/TDDD,/844/SDDD
          CON    /844/DSDC,0,0
 D885     CON    0,/885/MTKS,/885/MSRS
          CON    /885/CSDD,/885/TSDD,/885/SSDD
          CON    /885/DSSC,0,0
 SEK      SPACE  4,10 
**        SEK - SEEK DISK ADDRESS.
* 
*         SEK ISSUES A SEEK FUNCTION, AND WILL CONTINUE TO ISSUE AS LONG
*         AS THE DRIVE HEADS ARE IN MOTION. 
* 
*         ENTRY  (UNIT) = UNIT NUMBER 
*                (A) = ADDRESS OF CYL/TRACK/SECTOR VECTOR 
* 
*         RETURNS TO CALLER IF NO ERRORS
*         ELSE GO TO ERROR PROCESSOR
 SEK      ENM    X                 ENTRY/EXIT 
          STM    SEKB              STORE ADDRESS OF DISK ADDRESS
 SEK1     LDN    /844/D2SK
          RJM    FCN               SEEK 2:1 
          ACN    40B
          LDD    UNIT 
          OAN    0                 OUTPUT UNIT
          LDN    3
          OAM    **,0              OUTPUT CYL/TRACK/SECTOR
 SEKB     EQU    *-1
          FJM    *,0         WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    40B
          RJM    GGS               GET GENERAL STATUS 
          ZJN    SEKX              IF ON CYLINDER 
          LPN    /844/MP.GSBS 
          NJN    SEK1              IF BUSY
          RJM    ART               ASK TO RETRY 
          UJN    SEK1              TRY AGAIN
          SPACE  4,10 
**        WDSS - WRITE DEADSTART SECTOR 
* 
*         RETURN TO CALLER IF NO ERRORS 
*         ELSE GOTO ERROR PROCESSING
 WDSS     ENM    X                 ENTRY/EXIT 
          LDN    10 
          STD    RETRY             INIT RETRY COUNTER 
          LDC    PRU
          STM    BUFFER            SET DATA LENGTH
 WDSS2    LDN    DSCYL             ADDR OF CYL/TRACK/SECTOR 
          RJM    SEK               SEEK 
*         IF 885 DO NOT TRY TO SET FLAW 
          LDD    DTYPE
          ZJN    WDSS20            IF 885 
          LDN    /844/DSCF
          RJM    FCN               SET/CLEAR FLAW FUNCTION
          ACN    40B
          LDN    2                 CODE FOR SET SECTOR FLAW 
          OAN    0
          FJM    *,0         WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    40B
          RJM    WNB
          ZJN    WDSS8             IF OK TO PROCEED 
          RJM    ART               ASK TO RETRY 
          UJN    WDSS2             TRY AGAIN
 WDSS8    LDN    DSCYL
          RJM    SEK               RE-SEEK TO D.S. SECTOR 
*         WRITE D.S. SECTOR USING EITHER WRITE-FLAWED (844) OR
*                                        WRITE (885)  . 
 WDSS20   LDM    WDSST,DTYPE
          RJM    FCN
          ACN    40B
          LDC    DSLN 
          OAM    BUFFER,0 
          FJM    *,0         WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    40B
          RJM    WNB
          ZJN    WDSS30            IF NO ERRORS 
          RJM    ART
          UJN    WDSS8             TRY AGAIN
 WDSS30   LJM    WDSSX             RETURN 
 WDSST    CON    /885/DWFS,/844/DWFS,/844/DWFS
          SPACE  4,10 
          RSTC                     DISABLE CHANNEL INSTRUCTIONS 
          TITLE  DISPLAYS 
          SPACE  4,10 
 MSGA     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*ENTER ONE OF THE FOLLOWING*
 LINE     SET    LINE+3 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H* (CR) - INSTALL DEADSTART* 
 LINE     SET    LINE+1 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*        MODULE ON DISK*
 LINE     SET    LINE+2 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*   R  - RELEASE CMSE-RESERVED* 
 LINE     SET    LINE+1 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*        DISK SPACE*
 MSGAL    EQU    *-MSGA 
          SPACE  4,10 
 MSGB     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H/          * WARNING */ 
 LINE     SET    LINE+3 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*PERMANENT FILES MAY BE LOST IF*
 LINE     SET    LINE+1 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*DISK DEADSTART MODULE NOT* 
 LINE     SET    LINE+1 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*PREVIOUSLY INSTALLED ON DEVICE*
 LINE     SET    LINE+3 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H* (CR)  TO CONTINUE*
 MSGBL    EQU    *-MSGB 
          SPACE  4,10 
 MSGC     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*INSTALL DISK DEADSTART MODULE* 
 MSGCL    EQU    *-MSGC 
          SPACE  4,10 
 MSGD     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*RELEASE CMSE-RESERVED DISK SPACE*
 MSGDL    EQU    *-MSGD 
          SPACE  4,10 
 MSGE     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*UNABLE TO ACCESS DISK* 
 MSGEL    EQU    *-MSGE 
          SPACE  4,10 
 MSGF     EQU    *
 LINE     SET    8
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*(CR) TO PROCESS DIFFERENT DEVICE*
 MSGFL    EQU    *-MSGF 
          SPACE  4,10 
 MSGG     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*ENTRY OF (CR) WILL CAUSE*
 LINE     SET    LINE+2 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*RELEASE OF CMSE-RESERVED SPACE*
 MSGGL    EQU    *-MSGG 
          SPACE  4,10 
 MSGH     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*INSTALL COMPLETE*
 MSGHL    EQU    *-MSGH 
          SPACE  4,10 
 MSGI     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*RELEASE COMPLETE*
 MSGIL    EQU    *-MSGI 
          SPACE  4,10 
 MSGJ     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*ERRORS IN INSTALL* 
 MSGJL    EQU    *-MSGJ 
          SPACE  4,10 
 MSGK     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*IPL NOT FOUND* 
 MSGKL    EQU    *-MSGK 
          SPACE  4,10 
 MSGL     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*CTI CYLINDER OVERFLOW* 
 MSGLL    EQU    *-MSGL 
          SPACE  4,10 
 MSGM     EQU    *
 LINE     SET    5
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*UNABLE TO INSTALL CTI* 
 LINE     SET    LINE+3 
          CON    YSET+762B-LINE*YINCR 
          CON    XSET+0 
          DATA   H*READ ONLY SWITCH ACTIVE* 
 MSGML    EQU    *-MSGM 
          SPACE  4,10 
*         OPERATOR RESPONSE TABLES
 ORTR     CON    1RR
 ORTCR    CON    60B
          CON    0                 END OF TABLE 
          TITLE  BUFFERS
          SPACE  4,10 
*         CHTB - TABLE OF REDEFINED CHANNEL INSTRUCTIONS
 CHTB     CHTB
          SPACE  4,10 
**        CALL COMPQOD HERE.
*CALL     COMPQOD 
          SPACE  4,10 
*         GENERAL I/O BUFFER
 BUFFERX  BSSZ   2                 EXTRA FOR LINKAGE BYTES
 BUFFER   EQU    *
          QUAL   *
          TITLE  ICE OVERLAY
          IDENT  ICE,/CTI/ICDLOAD 
          SPACE  4,10 
          COMMENT CTI ICD OVERLAY 
          COMMENT COPYRIGHT CONTROL DATA CORPORATION, 1979
*CALL,CDCCRN
          SPACE  2
          ORG    /CTI/ICDLOAD 
          SPACE  2
**        ICE - OVERLAY FOR ICD 
* 
*         ICE IS CALLED TO WRITE THE CTI MODULES TO THE 
*         CTI CYLINDER.  ALL MODULES FROM IPL THRU ZZZ ARE
*         WRITTEN.  IT WILL ALSO SET THE CTI POINTER WORDS SO 
*         THAT CTI WORD 1 POINTS TO THE FIRST RECORD WHICH IS 
*         LOADED BY IPL AT DEADSTART TIME.  CTI WORD 2 WILL 
*         POINT TO THE FIRST RECORD IN THE CTI FILE IE. IPL.
* 
*         WHEN ICE IS DONE, IT WILL RELOAD ICD WHICH WILL 
*         FINISH THE INSTALLATION PROCESS.
          SPACE  2
          QUAL   ICE
          TITLE  MAIN ROUTINE 
          SPACE  4,10 
 ICE      EQU    *                 ENTRY POINT
          LDC    CHTB 
          RJM    ICN               FIX CHANNEL INSTRUCTIONS 
          SPACE  2
          LDN    0
          STD    PREV              INIT PREV = 0
          STD    CTICSC            INIT SECTOR COUNT
          SPACE  4,10 
*         SET INPUT BUFFER AREA TO ALL 7777B
 E20      LDC    /CTI/CTIFWA-BUFFER-1 
          STD    D1 
 E22      LDC    7777B
 FILL     EQU    *-1
          STM    BUFFER,D1
          SOD    D1 
          PJN    E22
          SPACE  4,10 
*         CALL COMMON DRIVER TO (REWIND), READ NEXT RECORD, 
*         WITH NO STRIPPING.  REWIND OCCURS ONLY 1ST TIME.
 E30      LDC    E30P 
          LJM    /CTI/CDEP
 E30P     CON    BUFFER            LOAD ADDR
          CON    E39               TRANSFER ADDR
 E30R     CON    1,0,0             REWIND,READ NEXT,NO STRIP
 E39      EQU    *
          LDN    0
          STM    E30R              SET NO REWIND ANY MORE 
          SPACE  4,10 
*         COMPUTE LENGTH OF RECORD JUST READ AND INIT RWADDR
 E40      LDC    /CTI/CTIFWA-1
          STD    D1 
 E42      LDI    D1 
          LMM    FILL 
          NJN    E44               IF NON-7777B REACHED 
          SOD    D1 
          UJN    E42
 E44      LDD    D1 
          ADC    1-BUFFER 
          STD    LENGTH            STORE LENGTH 
*         NOW ADJUST THE LENGTH AS FOLLOWS
*         TAPE - 5 LESS FOR TRAILER AND DISCONNECT BYTE 
*         DISK - 2 LESS BECAUSE OF LINKAGE BYTES SHIFT. 
          SBN    2
          STD    LENGTH 
          LDM    /CTI/CDTYPE       GET DEVICE TYPE CODE 
          SBN    /CTI/D844
          PJN    E46               IF NOT FROM TAPE 
          LDD    LENGTH 
          SBN    3
          STD    LENGTH 
 E46      EQU    *
          LDC    BUFFER 
          STD    RWADDR            RWADDR = A(BUFFER) 
          SPACE  4,10 
*         WRITE A DISK SECTOR 
 E60      RJM    WSEC              WRITE SECTOR 
          ZJN    E100              IF NO ERRORS 
 E90      RJM    IDA               INCREMENT DISK ADDRESS 
          UJN    E60               TRY AGAIN
          SPACE  4,10 
*         SET PREV TO POINT TO SECTOR JUST WRITTEN
 E100     LDD    CTITRK 
          SHN    6
          ADD    CTISEC 
          STD    PREV 
          AOD    CTICSC            COUNT NUMBER OF SECTORS WRITTEN
          SPACE  4,10 
*         TEST IF LAST SECTOR OF CURRENT RECORD HAS BEEN WRITTEN
 E110     LDD    LENGTH 
          ZJN    E120              IF NO MORE TO WRITE
          UJN    E90
          SPACE  4,10 
*         TEST IF ZZZ RECORD JUST FINISHED
 E120     LDM    BUFFER+NAME
          LMC    2RZZ 
          NJN    E130              IF NOT ZZZ 
          LDM    BUFFER+NAME+1
          LMC    1RZ*100B 
          NJN    E130              IF NOT ZZZ 
*         REVERSE LINKS AND SET CTI POINTER WORDS 
          RJM    RVL
*         HERE IF ALL DONE. RELOAD ICD TO FINISH INSTALL. 
 DONE     LDC    E120P
          LJM    /CTI/CDEP         GOTO COMMON DRIVER 
 E120P    CON    /CTI/ICDLOAD 
 E120PT   CON    /ICD/ICDALT
          CON    1
          VFD    18/3LICD,6/0 
          SPACE  4,10 
*         INCREMENT DISK ADDRESS AND GO PROCESS NEXT RECORD 
 E130     RJM    IDA
          LJM    E20
          TITLE  DISK SUBROUTINES 
          SPACE  4,10 
          RICHI                    ENABLE CHANNEL MACROES 
 ART      SPACE  4,10 
**        ART - ADJUST RETRY COUNTER
* 
*         DECREMENT COUNTER AND 
*         RETURN TO CALLER IF COUNTER .GE. 0
*         ELSE GOTO ERROR IF ARTEC = 0
*                   (ARTEC) IF ARTEC .NE. 0 
* 
 ART      ENM    X                 ENTRY/EXIT 
          SOD    RETRY
          PJN    ARTX              EXIT IF MORE RETRIES AVAILABLE 
          LDM    ARTEC             CHECK EXIT CODE
          NJN    ART5              IF SPECIAL EXIT
          RJM    ERROR             IF NO MORE RETRIES AVAILABLE 
 ART5     LJM    0
 ARTEC    EQU    *-1               SPECIAL EXIT ADDRESS 
 AWD      SPACE  4,10 
**        AWD - ACTIVATE CHANNEL AND WAIT FOR DATA. 
* 
*         AWD ACTIVATES THE FUNCTIONED CHANNEL AND TIMES OUT A FULL 
*         CONDITION.
* 
*         EXIT   (A) .NE. 0, DATA ON CHANNEL. 
*                (A) = 0, NO DATA RECEIVED, CHANNEL DISCONNECTED. 
 AWD      ENM    X                 ENTRY/EXIT 
          ACN    40B               ACTIVATE CHANNEL 
          LDC    TIMEOUT
 AWD1     FJM    AWDX,0            IF FULL, RETURN
          SBN    1
          NJN    AWD1              IF TIME OUT NOT EXPIRED
          DCN    40B               DISCONNECT 
          UJN    AWDX              RETURN 
          SPACE  4,10 
**        CPO - COMPUTE PRU OFFSET
* 
*         COMPUTES PRU OFFSET FROM (CTITRK,CTISEC) TO 
*                                  (RVLTRK,RVLSEC)
* 
*         EXIT   (A) = PRU OFFSET 
 CPO      ENM    X                 ENTRY/EXIT 
          LDD    CTISEC 
          ADD    RVLSEC 
          LPN    1
          ZJN    CPO8              IF BOTH EVEN OR BOTH ODD 
          LDD    RVLTRK 
          RJM    MPY
          ADD    RVLSEC 
          UJN    CPOX              RETURN 
 CPO8     LDD    RVLTRK 
          SBD    CTITRK 
          RJM    MPY
          ADD    RVLSEC 
          SBD    CTISEC 
          UJN    CPOX              RETURN 
          SPACE  4,10 
**        MPY - CONVERT TRACKS TO SECTORS 
* 
*         ENTRY  (A) = TRACKS 
*         EXIT   (A) = TRACKS * SECSPER 
 MPY1     LDD    D2 
 MPY      ENM    X                 ENTRY/EXIT 
          STD    D1 
          LDN    0
          STD    D2 
 MPY3     SOD    D1 
          MJN    MPY1 
          LDD    SECSPER
          RAD    D2 
          UJN    MPY3 
          SPACE  4,10 
**        ERROR - INTERCEPTS ERROR STATES 
* 
*         RELOADS ICD AND ENTERS IT AT THE ERROR ENTRY. 
 ERROR    ENM    X                 ENTRY ONLY 
          LDC    /ICD/ICDERR
          STM    E120PT            CHANGE TRANSFER ADDRESS
          LJM    DONE 
 FCN      SPACE  4,10 
**        ERROROF - USED WHEN CTI OVERFLOWS ASSIGNED DISK CYLINDER
* 
*         RELOADS ICD AND ENTERS ICD AT ICDERR2 ENTRY POINT 
* 
*         CALLS  ICD. 
* 
*         USES   NONE.
* 
*         EXIT   DOES NOT RETURN TO CALLER. 
* 
  
 ERROROF  ENM    X           ENTER ONLY 
          LDC    /ICD/ICDERR2  CHANGE TRANSFER ADDRESS
          STM    E120PT 
          LJM    DONE 
          SPACE  4,10 
**        FCN - FUNCTION DEVICE.
* 
*         ENTRY  (A) = FUNCTION CODE. 
* 
*         RETURNS TO CALLER IF NO ERRORS
*         ELSE GO TO ERROR PROCESSOR. 
 FCN      ENM    X                 ENTRY/EXIT 
          STD    FCNF              SAVE FUNCTION CODE 
 FCN3     LDD    FCNF              GET FUNCTION CODE
          FAN    40B               ISSUE FUNCTION 
          LDC    TIMEOUT
 FCN1     IJM    FCNX,0            IF FUNCTION ACCEPTED, RETURN 
          SBN    1
          NJN    FCN1              IF TIMEOUT NOT EXPIRED 
          DCN    40B
          RJM    ART               ASK TO RETRY 
          UJN    FCN3              TRY AGAIN
          SPACE  4,10 
**        GDS - GET DETAIL STATUS 
* 
*         GDS GETS DETAIL STATUS INTO BUFFER *DETAIL* 
* 
*         EXIT   (DETAIL) = DETAIL STATUS 
 GDS      ENM    X                 ENTRY/EXIT 
 GDS2     LDN    /844/DDSS
          RJM    FCN
          RJM    AWD
          NJN    GDS5              IF DATA ON CHANNEL 
          RJM    ART
          UJN    GDS2 
 GDS5     LDN    DETAILL
          IAM    DETAIL,0 
          DCN    40B
          UJN    GDSX              RETURN 
 DETAIL   BSSZ   /844/SLNS
 DETAILL  EQU    *-DETAIL 
 GGS      SPACE  4,10 
**        GGS - GET GENERAL STATUS. 
* 
*         GGS ISSUES THE GENERAL STATUS FUNCTION  AND UPDATES 
*         THE DIRECT CELL *GENSTAT*.  THE STATUS IS ALSO RETURNED 
*         IN (A). 
* 
*         EXIT   (GENSTAT) = GENERAL STATUS REPLY.
*                (A) = GENERAL STATUS REPLY.
* 
 GGS2     RJM    ART               ASK TO RETRY 
          UJN    GGS3              TRY AGAIN
 GGS      ENM    X                 ENTRY/EXIT 
 GGS3     LDN    /844/DGST
          RJM    FCN               FUNCTION DEVICE
          RJM    AWD               ACTIVATE CHAN AND WAIT FOR DATA
          ZJN    GGS2              IF NO DATA COMING
          IAN    0                 READ STATUS
          DCN    40B
          STD    GENSTAT
          UJN    GGSX              RETURN 
 ICN      SPACE  4,10 
**        ICN - INSERT CHANNEL NO.
* 
*         ICN INSERTS CHANNEL NO.S IN INSTRUCTIONS GIVEN
*         IN A LIST TERMINATED WITH A ZERO. 
* 
*         ENTRY  (A) = FWA OF CHANNEL LIST. 
*                (CHAN) = CHANNEL NO. 
* 
*         USES   D2, D3.
 ICN      ENM    X                 ENTRY/EXIT 
          STD    D2 
 ICN1     LDI    D2 
          ZJN    ICNX              IF LIST COMPLETE 
          STD    D3 
          LDI    D3 
          SCN    37B
          ADD    CHAN              ADD IN NEW CHANNEL NO. 
          STI    D3 
          AOD    D2 
          UJN    ICN1              CONTINUE PROCESSING
          SPACE  4,10 
**        IDA - INCREMENT DISK ADDRESS
* 
*         IDA INCREMENTS THE CTI DISK ADDRESS VECTOR, 
*                        (CTICYL,CTITRK,CTISEC),
*         TO THE NEXT POSSIBLE LOCATION.
 IDA      ENM    X                 ENTRY/EXIT 
          LDN    2                 ADD 2 TO SECTOR
          RAD    CTISEC 
          SBD    SECSPER
          MJN    IDAX              IF .LE. MAX, RETURN
          STD    CTISEC 
          AOD    CTITRK            ADD 1 TO TRACK 
          SBD    TRKSPER
          MJN    IDAX              IF .LE. MAX, RETURN
          LDD    CTISEC 
          ZJN    IDA3 
          RJM    ERROROF     CALLS AND ENTERS ICD, DOES NOT RETURN
 IDA3     LDN    0                 SET TRACK=0, SECTOR=1
          STD    CTITRK 
          AOD    CTISEC 
          UJN    IDAX              RETURN 
          SPACE  4,10 
**        RSEC - READ SECTOR
* 
*         READS SECTOR (CTICYL,CTITRK,CTISEC) INTO BUFFERX
* 
*         RETURNS TO CALLER IF NO ERRORS
*         ELSE GOTO ERROR PROCESSOR 
 RSEC     ENM    X                 ENTRY/EXIT 
          LDN    10 
          STD    RETRY             INIT RETRY COUNTER 
 RSEC20   LDN    CTICYL 
          RJM    SEK               SEEK 
          LDN    /844/DRED
          RJM    FCN               READ 
          ACN    40B
          LDC    TIMEOUT
 RSEC25   FJM    RSEC30,0          WAIT UNTIL FULL
          SBN    1
          NJN    RSEC25 
          DCN    40B
 RSEC27   RJM    ART               ASK TO RETRY 
          UJN    RSEC20            TRY AGAIN
 RSEC30   LDC    DSLN 
          IAM    BUFFERX,0         READ IN DATA 
          DCN    40B
          RJM    GGS               GET GENERAL STATUS 
          ZJN    RSEC40            IF NO ERRORS 
          RJM    GDS               GET DETAIL STATUS
          UJN    RSEC27            TRY AGAIN
 RSEC40   LJM    RSECX             OK,RETURN
          SPACE  4,10 
**        RVL - REVERSE LINKS AND SET CTI POINTERS
* 
*         RVL READS (IN REVERSE ORDER), THE SECTORS WRITTEN IN THE
*         CTI CYLINDER AND REWRITES THEM SO THAT THE 2ND LINKAGE
*         BYTE OF EACH SECTOR IS A FORWARD POINTING PRU OFFSET. 
*         IT WILL ALSO SET THE CTI POINTER WORDS SO THAT THE CTI
*         POINTER WORD 1 HAS THE ADDRESS OF THE CTI MODULE WHICH
*         IS LOADED BY IPL AT DEADSTART TIME, AND CTI POINTER 
*         WORD 2 HAS THE ADDRESS OF THE 1ST CTI MODULE, IE. IPL.
* 
*         RETURNS TO THE CALLER IF NO ERRORS
*         ELSE GOTO ERROR PROCESSOR.
 RVL      ENM    X                 ENTRY/EXIT 
          LDD    CTITRK 
          STD    RVLTRK 
          LDD    CTISEC 
          STD    RVLSEC 
 RVL10    RJM    RSEC              READ CURRENT SECTOR INTO BUFFERX 
          LDM    BUFFERX+1
          STD    RVLLB2            SAVE 2ND LINKAGE BYTE
          LDM    BUFFERX
          ZJN    RVL18             IF FULL-LAST SECTOR
          ADC    -500B
          NJN    RVL18
          LDN    1                 FORCE WSEC TO NOT CHANGE 500 TO 0
 RVL18    ADC    500B 
 RVL20    STD    LENGTH            SAVE LENGTH OF DATA
          LDC    BUFFER 
          STD    RWADDR 
          RJM    CPO               COMPUTE PRU OFFSET 
          STD    PREV 
          RJM    WSEC              REWRITE SECTOR WITH NEW LINK 
          ZJN    RVL30             IF NO ERRORS 
          RJM    ERROR             ELSE TOO BAD 
*         IF APPROPRIATE DRIVER, SET CTI POINTER WORD 1 
 RVL30    LDM    BUFFER+NAME       LOOKING FOR CD4 OR CD8 
          LMC    2RCD 
          NJN    RVL50             IF NOT 
          LDM    BUFFER+NAME+1
          LMM    RVLTAB,DTYPE 
          NJN    RVL50             IF NOT 
          LDD    CTICYL            SAVE ADDRESS OF DRIVER 
          STM    CPBCTI+0 
          LDD    CTITRK 
          STM    CPBCTI+1 
          LDD    CTISEC 
          STM    CPBCTI+2 
 RVL50    LDD    CTITRK            RVLTRK/RVLSEC = CTITRK/CTISEC
          STD    RVLTRK 
          LDD    CTISEC 
          STD    RVLSEC 
          SOD    CTICSC            DECREMENT RECORDS WRITTEN COUNT
          NJN    RVL60             IF MORE RECORDS TO READ
          LDD    CTICYL            SAVE ADDRESS OF 1ST CTI RECORD 
          STM    CPBCTI+5+0 
          LDD    CTITRK 
          STM    CPBCTI+5+1 
          LDD    CTISEC 
          STM    CPBCTI+5+2 
          LJM    RVLX              RETURN 
 RVL60    LDD    RVLLB2 
          LPN    77B               CTITRK/CTISEC = RVLLB2 
          STD    CTISEC 
          LDD    RVLLB2 
          SHN    -6 
          STD    CTITRK 
          LJM    RVL10
 RVLTAB   CON    1R8*100B,1R4*100B,1R4*100B 
 SEK      SPACE  4,10 
**        SEK - SEEK DISK ADDRESS.
* 
*         SEK ISSUES A SEEK FUNCTION, AND WILL CONTINUE TO ISSUE AS LONG
*         AS THE DRIVE HEADS ARE IN MOTION. 
* 
*         ENTRY  (UNIT) = UNIT NUMBER 
*                (A) = ADDRESS OF CYL/TRACK/SECTOR VECTOR 
* 
*         RETURNS TO CALLER IF NO ERRORS
*         ELSE GO TO ERROR PROCESSOR
 SEK      ENM    X                 ENTRY/EXIT 
          STM    SEKB              STORE ADDRESS OF DISK ADDRESS
 SEK1     LDN    /844/D2SK
          RJM    FCN               SEEK 2:1 
          ACN    40B
          LDD    UNIT 
          OAN    0                 OUTPUT UNIT
          LDN    3
          OAM    **,0              OUTPUT CYL/TRACK/SECTOR
 SEKB     EQU    *-1
          FJM    *,0         WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    40B
          RJM    GGS               GET GENERAL STATUS 
          ZJN    SEKX              IF ON CYLINDER 
          LPN    /844/MP.GSBS 
          NJN    SEK1              IF BUSY
          RJM    ART               ASK TO RETRY 
          UJN    SEK1              TRY AGAIN
          SPACE  4,10 
**        TRAP - YOU CAN JUMP HERE WHEN THAT CASE THAT
*                 SHOULD NEVER HAPPEN, FINALLY OCCURS.
 TRAP     CON    0                 HOLDS CALLERS ADDRESS
          UJN    *                 HANG 
          SPACE  4,10 
**        WSEC - WRITE SECTOR 
* 
*         WSEC TRIES TO WRITE A SPECIFIED DATA BLOCK TO A 
*         SPECIFIED DISK ADDRESS. 
* 
*         ENTRY  (CTICYL,CTITRK,CTISEC) = SECTOR TO BE WRITTEN
*                (RWADDR) = ADDRESS OF DATA BLOCK 
*                (LENGTH) = LENGTH YET TO BE WRITTEN
*                (PREV) = TTSS OF LAST GOOD WRITE 
* 
*         TWO BYTES PRECEDING THE DATA BLOCK ARE
*         CHANGED BY WSEC.  THE FIRST WILL HAVE THE 
*         LENGTH OF DATA IN THIS SECTOR, UNLESS THIS IS 
*         A LAST-FULL SECTOR IN WHICH CASE THE LENGTH BYTE = 0. 
*         THE SECOND BYTE WILL HAVE (PREV), A LINK TO THE 
*         PREVIOUS SECTOR.
* 
*         EXIT   (LENGTH) IS REDUCED BY THE AMOUNT WRITTEN. 
*                (RWADDR) IS ADVANCED BY THE AMOUNT WRITTEN.
*                (A) = 0 IF NO ERRORS 
*                (A) .NE. 0 IF UNABLE TO WRITE CURRENT SECTOR.
 WSEC     ENM    X                 ENTRY/EXIT 
          LDN    10 
          STD    RETRY
          LDC    WSECERR
          STM    ARTEC             SET ART EXIT ADDRESS 
          LDD    RWADDR 
          SBN    2
          STD    D1                (D1) = (RWADDR) - 2
          STM    WSEC20B
          LDD    LENGTH            DETERMINE VALUE FOR 1ST LINKAGE BYTE 
          ADC    -500B
          ZJN    WSEC10 
          MJN    WSEC8
          LDN    0
 WSEC8    ADC    500B 
 WSEC10   STI    D1                STORE 1ST LINKAGE BYTE 
          STM    WSEC60B
          LDD    PREV 
          STM    1,D1              STORE 2ND LINKAGE BYTE 
 WSEC20   LDN    CTICYL 
          RJM    SEK               SEEK 
          LDM    WSECWFT,DTYPE
          RJM    FCN               WRITE
          ACN    40B
          LDC    DSLN 
          OAM    **,0              OUTPUT ONE SECTOR
 WSEC20B  EQU    *-1
          FJM    *,0         WAIT FOR TRANSFER TO COMPLETE               IPLR5A0
          DCN    40B
          RJM    GGS               GET GENERAL STATUS 
          ZJN    WSEC40            IF NO ERRORS 
          RJM    GDS               GET DETAIL STATUS
 WSEC30   RJM    ART               ASK TO RETRY 
          UJN    WSEC20            TRY AGAIN
 WSEC40   EQU    *
*         HERE IF SUCCESSFUL WRITE COMPLETED
          IFGT   DEBUG$,0 
*         MAKE COPY IN CENTRAL MEMORY 
          LDD    CMADDR 
          SHN    7
          CWD    CTICYL            WRITE CYL/TRK/SEC/X/X
          LDC    101B 
          STD    D1                STORE LENGTH 
          LDM    WSEC20B
          STM    WCM555 
          LDD    CMADDR 
          SHN    7
          ADN    1
          CWM    **,D1             WRITE 101B WORDS 
 WCM555   EQU    *-1
          AOD    CMADDR 
          ENDIF 
 WSEC60   LDC    **                LENGTH BYTE JUST WRITTEN 
 WSEC60B  EQU    *-1
          NJN    WSEC62 
          LDC    500B 
 WSEC62   STD    D1                STORE LENGTH JUST WRITTEN
          RAD    RWADDR            UPDATE DATA ADDRESS FOR NEXT SECTOR
          LDD    LENGTH 
          SBD    D1 
          STD    LENGTH            UPDATE LENGTH REMAINING
          LDN    0
          STM    ARTEC             RESET ART EXIT CODE
          LJM    WSECX             RETURN 
*         HERE IF UNABLE TO WRITE GOOD SECTOR 
 WSECERR  LDN    0
          STM    ARTEC             RESET ART EXIT CODE
          LDN    1
          LJM    WSECX             RETURN (A) .NE. 0
  
*         WRITE FUNCTION TABLE
  
 WSECWFT  CON    /885/DWLS,/844/DWRT,/844/DWRT
          TITLE  BUFFERS
          SPACE  4,10 
*         CHTB - TABLE OF REDEFINED CHANNEL INSTRUCTIONS
 CHTB     CHTB
          SPACE  4,10 
*         GENERAL I/O BUFFER
 BUFFERX  BSSZ   2                 EXTRA FOR LINKAGE BYTES
 BUFFER   EQU    *
          END 
