*
*
 TITLE 'CP-V/CP-R CONTROL PROG. ELLA. 708007-51A00 6.27.74'
*
*
*
         PAGE
*
*
*
*  ******************************************************
*  IMPORTANT NOTE:
*-------------------
*  ANYTIME ANY MODULE OF THE ERROR LOG LIST/ANALYSIS PROG
*  IS TO BE CHANGED TO ANOTHER LETTER VERSION.. PLEASE REVISE
*  THE OUTPUT HEADER OF ELLA IN THE TEXT STATEMENT WITH LABEL
*  NAME  'HEAD1'
*
*
*
*
*
*
*  *********************************************************
*
*
*
         PAGE
         SYSTEM   SIG7FDP
         CSECT
*
*
*PROCEDURES.
*
*  THESE PROCS WILL SUPRESS LISTING OF TEXT OBJECT CODE
*
*
*
*
*
*
*
TEXTS    CNAME
         PROC
         DISP     %
         LIST     0
LF       TEXT     AF
         LIST     1
         PEND
*
* THIS PROC WILL GENERATE A STRING OF BYTE FIELDS.
*
BS       CNAME
         PROC
         BOUND    4
LF       EQU      %
I        DO       NUM(AF)
         DATA,1   AF(I)
         FIN
         BOUND    4
         PEND
*
*
*
         PAGE
*
*        DEFINITIONS.
         DEF      EL:DCB
*
         DEF      R:COM,REW:FLAG,READ:ERF
         DEF      L:PRINT,E:PRINT
         DEF      L:SPACE
         DEF      TYPEF,:TYPE:,MODF,:MOD:,DEVF,:DEV:
         DEF      HEXDEC:,HEXDECE,DECHEX:,HEXFIVE,BINEBC,HEXTWO
         DEF      HEXEBC,EBCHEX8,EBCHEX1
         DEF      MS:HMSN,HMSN:MS,JD:MD,MD:JD
         DEF      HEXFOUR
         DEF      BUFFER
         DEF      CT:PRINT
         DEF      COMBUFF
         DEF      YEAR:0,YEAR:1,YEAR:2
         DEF      DATE:0,DATE:1,DATE:2
         DEF      TIME:00,TIME:1,TIME:2
         DEF      XFOX,XF9X
         DEF      COB,CAB,X4BD5
         DEF      A:7
         DEF      S:SYS,DSP:,F:F
         DEF      TIME:ZR,S:FLAG,YEAR:3,DATE:3,TIME:3
         DEF      GETDT
        DEF       CF
        DEF      JD:R,YR:R,TM:R
         DEF      MOD:EBC
         DEF      MDIO,PAGECNT,MODTBL:,READFIL,TABPNTR
         DEF      IOMD
         DEF      RSE:
         DEF      FLAG:PR
         DEF      BRK:CHK
         DEF      IONDD
* MESSAGES 1-19 DEFINITIONS.........
*
         DEF      MSG1,MSG2,MSG3,MSG4,MSG5,MSG6
         DEF      MSG7,MSG8,MSG9,MSG10,MSG11,MSG12
         DEF      MSG13,MSG14,MSG15,MSG16,MSG17,MSG18
         DEF      MSG19
         DEF      MSG154
         DEF      MSG1A,MSG1B,MSG1C
         DEF      MSG2A,MSG2B,MSG3A,MSG3B,MSG4A,MSG4B
         DEF      MSG5A,MSG5B,MSG6A,MSG6B,MSG7A,MSG7B
         DEF      MSG8A,MSG8B,MSG9A,MSG9B,MSG10A,MSG10B
         DEF      MSG11A,MSG11B,MSG12A,MSG12B,MSG13A,MSG13B
         DEF      MSG14A,MSG14B,MSG15A,MSG15B,MSG16A,MSG16B
         DEF      MSG17A,MSG17B,MSG18A,MSG18B,MSG19A,MSG19B
         PAGE
*
*
*        THIS INSERT IS FOR THE BENEFIT OF DDEBUGGING ON THE
*        CP-R SYSTEM............ DELETE AFTER USE.......
*
*
         DEF      BIOPEN,ELASSIGN
*
*
*
*
*
*
         PAGE
*
*        REFERENCES.
*
          REF     J:JIT,JB:PRIV  REFERENCE TO CP-V JIT TABLE...
         REF      M:SI,M:OC,M:LO,M:BI
         REF      SUM:0,CLIS:0,SLIS:0,DISP:0,TIME:0
         REF      TYPE:0,DEV:0,MOD:0
         REF      CSTAB        REFERENCE TO THE DUMMY SEGMENT
*                              USED FOR CP-R (SORT TABLE USE)
         PAGE
*
*        DIRECTORY TABLE:
*
*        FORMAT FOR THE TABLE OF COMMANDS.
*
*        TEXTX    COMMAND NAME
*        DATA     ADDRESS OF ENTRY TO COMMAND OVERLAY.
*
*        THIS TABLE ENDS WITH A ZERO.
*
TABLE:   DATA     %+1
TA:CLIS  TEXTS    'CLIS'            CHRONOLOGICAL
         DATA     CLIS:
         DATA     0
TA:SUM   TEXTS    'SUM'             SUMMARY
         DATA     SUM:
         DATA     0
TA:SLIS  TEXTS    'SLIS'            SORTED
         DATA     SLIS:
         DATA     0
TA:DISP  TEXTS    'DISP'            DISPLAY GRAPHIC
         DATA     DISP:
         DATA     2
TA:ANLZ  TEXTS    'ANLZ'            ANALYZE
         DATA     ANLZ:
         DATA     0
TA:DSPL  TEXTS    'DSPL'            DISPLAY BOUNDARIES
         DATA     DSPL:
         DATA     0
TA:TIME  TEXTS    'TIME'            TIME SELECTOR
         DATA     TIME:
         DATA     1
TA:TYPE  TEXTS    'TYPE'            TYPE SELECTOR
         DATA     TYPE:
         DATA     1
TA:MOD   TEXTS    'MOD'             MODEL SELECTOR
         DATA     MOD:
         DATA     1
TA:DEV   TEXTS    'DEV'             DEVICE SELECTOR
         DATA     DEV:
         DATA     1
TA:RSET  TEXTS    'RSET'            RESET TIME AND SELECT PARAMETERS
         DATA     RSET:
         DATA     0
TA:END   TEXTS    'END'             END PROGRAM
         DATA     END:
         DATA     0
TA:SET   TEXTS    'SET'             SET
         DATA     SET:
         DATA     1
         DATA     0
         PAGE
* MSG1 THRU MSG19 ARE RESERVED FOR USER'S DATA AREA.
TE:TABLE EQU      %
         DATA     160               TABL CNT
         DATA     MSG1
         DATA     MSG2
         DATA     MSG3
         DATA     MSG4
         DATA     MSG5
         DATA     MSG6
         DATA     MSG7
         DATA     MSG8
         DATA     MSG9
         DATA     MSG10
         DATA     MSG11
         DATA     MSG12
         DATA     MSG13
         DATA     MSG14
         DATA     MSG15
         DATA     MSG16
         DATA     MSG17
         DATA     MSG18
         DATA     MSG19
* TEXT AREA STARTS FROM MSG20 :
         DATA     MSG20
         DATA     MSG21
         DATA     MSG22
         DATA     MSG23
         DATA     MSG24
         DATA     MSG25
         DATA     MSG26
         DATA     MSG27
         DATA     MSG28
         DATA     MSG29
         DATA     MSG30
         DATA     MSG31
         DATA     MSG32
         DATA     MSG33
         DATA     MSG34
         DATA     MSG35
         DATA     MSG36
         DATA     MSG37
         DATA     MSG38
         DATA     MSG39
         DATA     MSG40
         DATA     MSG41
         DATA     MSG42
         DATA     MSG43
         DATA     MSG44
         DATA     MSG45
         DATA     MSG46
         DATA     MSG47
         DATA     MSG48
         DATA     MSG49
         DATA     MSG50
         DATA     MSG51
         DATA     MSG52
         DATA     MSG53
         DATA     MSG54
         DATA     MSG55
         DATA     MSG56
         DATA     MSG57
         DATA     MSG58
         DATA     MSG59
         DATA     MSG60
         DATA     MSG61
         DATA     MSG62
         DATA     MSG63
         DATA     MSG64
         DATA     MSG65
         DATA     MSG66
         DATA     MSG67
         DATA     MSG68
         DATA     MSG69
         DATA     MSG70
         DATA     MSG71
         DATA     MSG72
         DATA     MSG73
         DATA     MSG74
         DATA     MSG75
         DATA     MSG76
         DATA     MSG77
         DATA     MSG78
         DATA     MSG79
         DATA     MSG80
         DATA     MSG81
         DATA     MSG82
         DATA     MSG83
         DATA     MSG84
         DATA     MSG85
         DATA     MSG86
         DATA     MSG87
         DATA     MSG88
         DATA     MSG89
         DATA     MSG90
         DATA     MSG91
         DATA     MSG92
         DATA     MSG93
         DATA     MSG94
         DATA     MSG95
         DATA     MSG96
         DATA     MSG97
         DATA     MSG98
         DATA     MSG99
         DATA     MSG100
         DATA     MSG101
         DATA     MSG102
         DATA     MSG103
         DATA     MSG104
         DATA     MSG105
         DATA     MSG106
         DATA     MSG107
         DATA     MSG108
         DATA     MSG109
         DATA     MSG110
         DATA     MSG111
         DATA     MSG112
         DATA     MSG113
         DATA     MSG114
         DATA     MSG115
         DATA     MSG116
         DATA     MSG117
         DATA     MSG118
         DATA     MSG119
         DATA     MSG120
         DATA     MSG121
         DATA     MSG122
         DATA     MSG123
         DATA     MSG124
         DATA     MSG125
         DATA     MSG126
         DATA     MSG127
         DATA     MSG128
         DATA     MSG129
         DATA     MSG130
         DATA     MSG131
         DATA     MSG132
         DATA     MSG133
         DATA     MSG134
         DATA     MSG135
         DATA     MSG136
         DATA     MSG137
         DATA     MSG138
         DATA     MSG139
         DATA     MSG140
         DATA     MSG141
         DATA     MSG142
         DATA     MSG143
         DATA     MSG144
         DATA     MSG145
         DATA     MSG146
         DATA     MSG147
         DATA     MSG148
         DATA     MSG149
         DATA     MSG150
         DATA     MSG151
         DATA     MSG152
         DATA     MSG153
         DATA     MSG154
         DATA     MSG155
         DATA     MSG156
         DATA     MSG157
         DATA     MSG158,MSG159,MSG160
         DATA     MSG161,MSG162,MSG163,MSG164,MSG165
         DATA     MSG166,MSG167,MSG168,MSG169,MSG170
         DATA     MSG171,MSG172,MSG173,MSG174,MSG175,MSG176
*
*
*
         PAGE
*
*        MESSAGE AREA FOR THE TEXT COMPRESSION TABLE.
*
MSG1     DATA     X'0C40407A'
MSG1A    DATA     X'40407A40'
MSG1B    DATA     X'407A4040'
MSG1C    DATA     X'40404040'
MSG2     DATA     0
MSG2A    DATA     0
MSG2B    DATA     0
MSG3     DATA     0
MSG3A    DATA     0
MSG3B    DATA     0
MSG4     DATA     0
MSG4A    DATA     0
MSG4B    DATA     0
MSG5     DATA     0
MSG5A    DATA     0
MSG5B    DATA     0
MSG6     DATA     0
MSG6A    DATA     0
MSG6B    DATA     0
MSG7     DATA     0
MSG7A    DATA     0
MSG7B    DATA     0
MSG8     DATA     0
MSG8A    DATA     0
MSG8B    DATA     0
MSG9     DATA     0
MSG9A    DATA     0
MSG9B    DATA     0
MSG10    DATA     0
MSG10A   DATA     0
MSG10B   DATA     0
MSG11    DATA     0
MSG11A   DATA     0
MSG11B   DATA     0
MSG12    DATA     0
MSG12A   DATA     0
MSG12B   DATA     0
MSG13    DATA     0
MSG13A   DATA     0
MSG13B   DATA     0
MSG14    DATA     0
MSG14A   DATA     0
MSG14B   DATA     0
MSG15    DATA     0
MSG15A   DATA     0
MSG15B   DATA     0
MSG16    DATA     0
MSG16A   DATA     0
MSG16B   DATA     0
MSG17    DATA     0
MSG17A   DATA     0
MSG17B   DATA     0
MSG18    DATA     0
MSG18A   DATA     0
MSG18B   DATA     0
MSG19    DATA     0
MSG19A   DATA     0
MSG19B   DATA     0
         RES      20
*
MSG20    TEXTC    ' '               A DUMMY SPACE
MSG21    TEXTC    '***'
MSG22    TEXTC    'SIO'
MSG23    TEXTC    'FAILURE'
MSG24    TEXTC    'TIME'
MSG25    TEXTC    'MDL'
MSG26    TEXTC    'I/O'
MSG27    TEXTC    'HIO'
MSG28    TEXTC    'TDV'
MSG29    TEXTC    'SUBC'
MSG30    TEXTC    'TDV CUR'
MSG31    TEXTC    'REM'
MSG32    TEXTC    'ADRS'
MSG33    TEXTC    'STAT'
MSG34    TEXTC    'CC'
MSG35    TEXTC    'COMM'
MSG36    TEXTC    'DA'
MSG37    TEXTC    'BYTES'
MSG38    TEXTC    'UNEXP. INTERRUPT'
MSG39    TEXTC    'AIO'
MSG40    TEXTC    'VOLUME'
MSG41    TEXTC    'SERIAL'
MSG42    TEXTC    'COUNT'
MSG43    TEXTC    'DEVICE'
MSG44    TEXTC    'TIO'
MSG45    TEXTC    'CUR COMM DW'
MSG46    TEXTC    '-RETRY-'
MSG47    TEXTC    '...'
MSG48    TEXTC    'MFI'
MSG49    TEXTC    'REQ'
MSG50    TEXTC    'STATUS'
MSG51    TEXTC    'DEVICE ERROR SECONDARY'
MSG52    TEXTC    'SEEK'
MSG53    TEXTC    'TIMEOUT'
MSG54    TEXTC    'SENSE'
MSG55    TEXTC    'INFORMATION'
MSG56    TEXTC    '---------'
MSG57    TEXTC    'RBT'
MSG58    TEXTC    'SYMB'
MSG59    TEXTC    'CODE'
MSG60    TEXTC    'PARITY'
MSG61    TEXTC    '------PSDW-------'
MSG62    TEXTC    'REAL'
MSG63    TEXTC    'TRAPPED'
MSG64    TEXTC    'EFF.'
MSG65    TEXTC    '1'
MSG66    TEXTC    '2'
MSG67    TEXTC    '3'
MSG68    TEXTC    '4'
MSG69    TEXTC    'MEMORY  FAULT INTERRUPT'
MSG70    TEXTC    'INSTRUCT'
MSG71    TEXTC    'TRAP.INST.'
MSG72    TEXTC    'WATCHDOG TIMER'
MSG73    TEXTC    'SYSTEM STARTUP'
MSG74    TEXTC    'DATE'
MSG75    TEXTC    'START'
MSG76    TEXTC    'RECOV'
MSG77    TEXTC    'SCREECH'
MSG78    TEXTC    'SUB-'
MSG79    TEXTC    'TYPE'
MSG80    TEXTC    'BAD GRANULES RELEASE'
MSG81    TEXTC    'PROCESSOR FAULT INTERRUPT'
MSG82    TEXTC    'DCT'
MSG83    TEXTC    'INDEX'
MSG84    TEXTC    'PRIM'
MSG85    TEXTC    'ALTN'
MSG86    TEXTC    'CONFIGURATION'
MSG87    TEXTC    'SYSTEM IDENTIFICATION'
MSG88    TEXTC    'CORE'
MSG89    TEXTC    'SITE'
MSG90    TEXTC    'SYSTEM'
MSG91    TEXTC    '(K)'
MSG92    TEXTC    'RT'
MSG93    TEXTC    'RES'
MSG94    TEXTC    'OPTIONS'
MSG95    TEXTC    'CPU'
MSG96    TEXTC    'SYMBIONT'
MSG97    TEXTC    'REL.'
MSG98    TEXTC    'BAD'
MSG99    TEXTC    'SECT'
MSG100   TEXTC    'INSTRUCTION FAIL'
MSG101   TEXTC    'RIO'
MSG102   TEXTC    '-'
MSG103   TEXTC    '--'
MSG104   TEXTC    '---'
MSG105   TEXTC    'ACTIVITY COUNT'
MSG106   TEXTC    'INSTRUCTION EXCEPTION'
MSG107   TEXTC    'POWER FAILSAFE'
MSG108   TEXTC    'I.D.'
MSG109   TEXTC    'RB'
MSG110   TEXTC    'LOST'
MSG111   TEXTC    'ENTRIES'
MSG112   TEXTC    'ENTRY'
MSG113   TEXTC    'UNIT'
MSG114   TEXTC    'LAST'
MSG115   TEXTC    'DUPLICATE'
MSG116   TEXTC    'SECONDARY POLL RECORD'
MSG117   TEXTC    'NAME'
MSG118   TEXTC    'POLL'
MSG119   TEXTC    'FILE COPY'
MSG120   TEXTC    'ERROR'
MSG121   TEXTC    'DCB '
MSG122   TEXTC    'ENQUEUE TABLE OVERFLOW'
MSG123   TEXTC    'USER'
MSG124   TEXTC    'PARTITIONED'
MSG125   TEXTC    'RESOURCE'
MSG126   TEXTC    'CONTRLR'
MSG127   TEXTC    'RETURNED'
MSG128   TEXTC    'PRIVATE PACK'
MSG129   TEXTC    'NO.'
MSG130   TEXTC    'ERRLOG'
MSG131   TEXTC    'CALL'
MSG132   TEXTC    'PROCESSOR'
MSG133   TEXTC    'CL'
MSG134   TEXTC    'UN'
MSG135   TEXTC    'POLR'
MSG136   TEXTC    'RESULTS'
MSG137   TEXTC    'PARITY SECONDARY'
MSG138   TEXTC    'MEMORY'
MSG139   TEXTC    'PAR.'
MSG140   TEXTC    'LOCATIONS'
MSG141   TEXTC    'STATUS WORDS'
MSG142   TEXTC    '----'
MSG143   TEXTC    'FILE'
MSG144   TEXTC    'INCONSISTENCY'
MSG145   TEXTC    'ACCOUNT'
MSG146   TEXTC    'RELATIVE'
MSG147   TEXTC    'MODE'
MSG148   TEXTC    'ORG'
MSG149   TEXTC    'HEX DUMP'
MSG150   TEXTC    'CALLERS ADRS/'
MSG151   TEXTC    'NO. GRANULES '
MSG152   TEXTC    'UNKNOWN'
MSG153   TEXTC    ' = '
MSG154   DATA     0,0,0
MSG155   TEXTC    '-RETRY-'
MSG156   TEXTC    'OPERATOR MESSAGE'
MSG157   TEXTC    'ERRS'
MSG158   TEXTC    'COPY'
MSG159   TEXTC    '('
MSG160   TEXTC    ')'
MSG161   TEXTC    'RIF'
MSG162   TEXTC    'ANLZ'
MSG163   TEXTC    'REMOTE PROCESSING ERROR'
MSG164   TEXTC    'WORKSTAT'
MSG165   TEXTC    'RB:FLAGS'
MSG166   TEXTC    'RP'
MSG167   TEXTC    'HARDWARE'
MSG168   TEXTC    'TERTIARY'
MSG169   TEXTC    'LOGICAL'
MSG170   TEXTC    'OR'
MSG171   TEXTC    'AND'
MSG172   TEXTC    'CONTENTS'
MSG173   TEXTC    'LMS'
MSG174   TEXTC    'OF'
MSG175   TEXTC    'LOWEST'
MSG176   TEXTC    'HIGHEST'
         PAGE
*
*
*
*  DATA AREA
*
*
*
CIDFG    DATA     0            FLAG :SET = CID=KP
*                                   :RESET = CID = CR
X40X     DATA     X'40404040'       SPACES
ERRMSG3  TEXT     'INVALID REQUEST '
MTCF     DATA     0
CF       DATA     0
MCF      DATA     0
COB      DATA     0
CAB      DATA     0            BYTE TRANSFER LOCATION.
RB       DATA     0
CONF     DATA     0
X4BD5    BS       X'40',X'6B',X'D',X'15',X'F',X'7'
XFFFF    DATA     X'FFFF'
BYTEIN   DATA     0
XC0X     DATA     X'C0000000'
         PAGE
S:SYS     DATA    0      SYSTEM CONFIGURATION.
*                              1ST BYTE= 00: CP-R
*                                        01: CP-V
*                              2ND BYTE= 00: SIGMA 5
*                                        01= SIGMA 5-7
*                                        02= SIGMA 9
*                                        03= TAURUS
*                              3RD BYTE= 00= BATCH MODE.
*                                        01= GHOST JOB.
*                                        02= ON-LINE MODE.
*
*
SYSIDF   DATA     0     SYSTEM ID SONFIGURATION....
*
*        BYTE 0 = CP-R OR CP-V OR OTHERS..... LOOK AT X'2B' SIGNIF.
*        BYTE 1 = SIGMA TAURUS BYTE........
*        BYTES 3-4   0...........
*
*
S:FLAG   DATA     0            SORT FLAG USE FOR THE READ ERRFILE
*                              AND THE SORT ROUTINE.
SLIS:F   DATA     0            SLIS FLAG TO SIGNIFY (1) SLIF MOD.
SUM:F DATA   0        SUM FLAG PRESENCE FLAG.
DISP:F   DATA     0
         PAGE
*
*        DATA     PARAMETER AREA.
*
TYPEF    DATA     0
:TYPE:   DATA     0,0,0,0,0
MODF     DATA     0
:MOD:    DATA     0,0,0,0,0
DEVF     DATA     0
:DEV:    DATA     0,0,0,0,0
YEAR:1   DATA     0            BEG. YEAR.
YEAR:2   DATA     0            ENDING YEAR.
DATE:1   DATA     0            BEG. DATE
DATE:2   DATA     0            ENDING DATE
TIME:1   DATA     0            BEG. TIME
TIME:2   DATA     0            ENDING TIME.
YEAR:0   DATA     0            CURRENT YEAR..
YEAR:3   DATA     99           DEFAULT YEAR....
DATE:0   DATA     0            CURRENT DATE..
DATE:3   DATA     365          DEFAULT DATE....
TIME:ZR  DATA     0            DEFAULT TIME.. (0)
TIME:3   DATA     (24*60*60*1000)-1  DEFAULT TIME (ENDING)
TIME:00  DATA     0            CURRENT TIME..
         PAGE
*
*
*  FPT'S USED FOR THE OPENING MESSAGE.............
*
*
CID:OPEN GEN,1,7,7,17  1,X'14',0,CID:DCB
         DATA     X'C0000000',WRI:ERR,WRI:ABN
CM:CRS   GEN,1,7,7,17  1,X'2B',0,CID:DCB
         GEN,1,14,17   1,0,MD:DCB
HED:WR1  GEN,1,7,7,17  1,X'11',0,CID:DCB
         BS       X'F0',0,0,X'10'
         DATA     WRI:ERR,WRI:ABN,HEAD1,15
HEAD1    TEXT     'ELLA 708006-A00'
         PAGE
*
*
*
*
*
*
*
*
*   DCB USED BY ELLA.
*
*
CID:DCB  DATA     M:SI
LD:DCB   DATA     M:LO
EL:DCB   DATA     M:BI
MD:DCB   DATA     M:OC
*
*
*
         PAGE
*
*
*  BREAK KEY INTERRUPT. WHENEVER BREAK IS HIT, ROUTINE
*  BRANCHES TO HERE.
*
*
*
*
*  BREAK INTERRUPT ROUTINE.
*
*
INT:BRK  EQU      %
         MTW,0    BK:FG        CHECK FOR INTERRUPT FLAG SET.
         BNEZ     INT:BRKX     BRANCH IF SET .
         LW,14    *1           FETCH PSD IN TCB...
         AND,14   XFFF
         LI,15    R:COM        START TO CHANGE ADDRESS.
         LI,5     1
         STH,15   14,5
         STW,14   *1           ALTER THE PSD.......
         LI,1     1
         LI,0     0
         STW,1    BK:FG        SET FLAG IF NOT SET.
         STW,1    BRK:CHK           SET BREAK OUT FLAG
         BAL,15   RSE:         ISSUE RESET FOR SORTED TABLES
         LI,14    5
         BAL,15   E:PRINT
         DATA     BRK:MSG
         STW,0    BK:FG        RESET FLAG BEFORE EXITING.
INT:BRKX EQU      %            EXIT.
         CAL1,9      5          EXIT BREAK CONTROL.
*
BK:FG    DATA     0            FLAG.
BRK:FPT  GEN,8,24 X'0E',INT:BRK
BRK:MSG  TEXT     'BREAK'
BRK:CHK  DATA     0
XFFF     DATA     X'FFF00000'
         PAGE
*
*        START OF PROGRAM.
*
*
*
START    EQU      %
         LI,0     0            INITIALIZE 0,1,2,3
         LI,1     1
         LI,2     2
         LI,3     3
         STW,0    SG:DEST      CLEAR DESTINATION SEGLOAD LOC.
         STW,0    S:FLAG       INITIALIZE S:FLAG.
         STW,0    TAB1ST       CLEAR OUT SORT TABLE INDICATOR......
         STW,0    TIME:ZR      CLEAR OUT TIME:ZR FOR USE.
         STW,0    DEF:FLG      CLEAR DEFAULT FLAG.....
         STW,0    PAS:FLG      CLEAR THE DEFAULT PASS FLAG.....
         LI,14    0            CLEAR 14
         LB,13    X'2B'
         SLS,13   -4           FETCH THE MOST SIGNIFICANT HALF BYTE
         CI,13    8            IS IT CP-R (8)
         BE       S:1          B: IF CP-R SYSTEM.............
         CI,13    7            IS IT CP-V (7)
         BNE      M:ABORT      B: IF NOT EQUAL TO CP-V NOR CP-R
         STB,1    14           SET A ONE IN 14 IF CP-V
S:1      EQU      %            SET A ZERO IN 14 IF CP-R
         LW,13    X'2B'        FETCH CPU TYPE. 2ND BYTE
         LI,15    X'C0'        00 = 5, 01 = 5/7, 10 = 9, 11 = 560
         AND,13   15
         SLS,13   10
         OR,14    13           OR'ED INTO REG.14
         STW,14   S:SYS        SAVE IN S:SYS.
         LI,13    0            RESET REG. 13
         MTB,0    S:SYS        CHECK CP-V/CP-R SYSTEM.
         BEZ      S:2          BRANCH : ZERO
         LB,13    J:JIT        FETCH MODE OF OPERATION.
         SLS,13   -6           00 = BATCH, 01 = GHOST, 10 = ON-LINE
S:2      EQU      %
         STB,13   S:SYS,2      SAVE IN S:SYS.
         BAL,15   GETDT
*
*  ...........................
*
*
*  INITIALIZE M:BI TO FILE NAMED 'ERRFILE'
*
*  IN CP-R USE ASSIGN CAL FOR SP AREA
*  IN CP-V USE AN M:OPEN TO 'ERRFILE',':SYS'
*
         LB,14    S:SYS        FETCH INDICATOR (CP-R/CP-V)
         BEZ      START:1      BRANCH IF CP-R
*
*
*
*
* THIS SECTION WILL BE RESERVED TO ALTER THE M:BI OPEN
* TO ASSIGN THE M:BI ERRFILE TO M:BI.
* THIS SECTION OF CODE MAY BE USED TO ALTER THE FPT ADDRESS
* OF M:OPEN TO M:BI TO ASSIGN THE ERRFILE TO M:BI.
*
* FOR THE MOMENT WE WILL JUST ISSUE THE M:INT BREAK FOR CP-V
*
*  CONNECT INTERRUPT BREAK.
*
         CAL1,8   BRK:FPT      CONNECT INTERRUPT BREAK.
*
*
*  SET UP THE PROMPT CALL TO BE USED UNDER A ON-LINE ENVIRONMENT.
*
         CAL1,1   PROMPT
*
*
*        SET THE TOP OF FORM HEADER PRINT....... FOR CP-V
*
         BAL,15   PAX          SET UP THE DATE.....
         CAL1,1   LP:HEAD      TOP OF FORM HEADER CAL.....
*
*
*
*
*  CHECK PRIVILEGE LEVEL OF A0 OR HIGHER.
*
         LB,14    JB:PRIV      CHECK PRIVILIGE LEVEL.
         CI,14    X'A0'        A0 OR HIGHER.
         BGE      ST:23        OK: PRIV .GT. .EQ.  A00
JB:ER    LI,14    34           BYTE COUNT
         BAL,15   E:PRINT      PRINT ERROR IN PRIVILEGE.
         DATA     PRIV:ERR
         B        M:ABORT
PRIV:ERR TEXTS    'INSUFFICIENT PRIVILEGE LEVEL,ABORT'
*
PROMPT   DATA     X'2C00005C'
*
*        WAKE ERR:FIL UP.
*
ST:23    EQU      %
         CAL1,6   JOB:FPT      WAKE UP ERR:FILL (GHOST JOB)
         BCS,8    JB:ER        BRANCH IF ERROR.
         BCS,1    JB:EX        BRANCH IF JOB NOT EXIXTENT.
         CAL1,8   WAIT:6       WAIT FOR 6 SECONDS.
         B        START:2      CONTINUE.
*
*
*
JOB:FPT  GEN,8,24 X'06',0
         TEXTC    'ERR:FIL'
WAIT:6   GEN,8,24 X'0F',5      5 TIMES 1.2 SECONDS. TICKS.
*
*        ERROR ROUTINES FOR THE DIAGNOSTIC CALS 'ERR:FIL' , WAIT.
*
JB:EX    EQU      %
         LI,14    21           SET BYTE COUNT
         BAL,15   E:PRINT
         DATA     JB:EXM
         B        M:ABORT      ABORT
JB:EXM   TEXTS    '**ERRLOG NON-EXISTENT'
*
*
*
         PAGE
*
*
*  CP-R SYSTEM
*  ISSUE A CAL1,1 X'08'
*
START:1  EQU      %
         CAL1,1   ELASSIGN     CAL ASSIGN.
*
*
*  SET UP THE VPN LOW 8 BIT PAGE NO. FOR CP-R
*
*
         LI,14    CSTAB        FETCH SEGMENT START VPN LOW ADRS.
         SLS,14   -9           SHIFT RIGHT 9 BITS.
         STB,14   VPNLOW,3     SAVE IN VPN LOW
         B        START:2
*
*
*
         PAGE
*
*        DATA AREA FOR THE CAL'S FOR ASSIGNING M:BI TO ERRFILE
*
*
*        ..........CP-R..........
*
ELASSIGN GEN,8,1,23            X'08',1,M:BI
         GEN,1,1,1,1,28        1,0,0,1,0
         DATA     WRI:ABN
         DATA     %+1
         TEXT     '  SP'
         TEXT     'ERRFILE'
JAN:     TEXT     ' JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
VFCSIRS  GEN,1,7,7,17  1,X'05',0,CID:DCB
         DATA     0
*
*        DATA CAL AREA FOR GETTING THE CURRENT DATE-TIME.
*
GETDATE  GEN,8,8,16  X'10',0,DATIME
DATIME   RES      4
HEDWRI2  GEN,1,7,7,17  1,X'11',0,CID:DCB
         BS       X'F0',0,0,X'10'
         DATA     WRI:ERR,WRI:ABN,DATIME,16
HOUR:0   DATA     0
MINS:0   DATA     0
MONT:0   DATA     0
DAY:0    DATA     0
*
*
*
DRCRST   GEN,8,24  X'8B',CID:DCB
         DATA     0
         PAGE
*
*        ERROR IN SYSTEM TIME FORMAT.
*
E:R:R    EQU      %
         LI,14    20
         BAL,15   E:PRINT      ERROR PRINT
         DATA     SYSTIME
         B        M:ABORT      ABORT PROGRAM
*
*
*
SYSTIME  TEXT     'ERROR IN SYSTEM TIME'
*
*
*
         PAGE
*
*
*
*
*
*        DETERMINE WHETHER INPUT (CID:DCB) IS A BI-DIRECTIONAL
*        DEVICE.
*        USE THE CORRESPONDENCE CAL TO FIND OUT BETWEEN
*        CID:DCB VS MD:DCB
*        THE STANDARD HERE IS TO ASSUME THAT MD:DCB IS ALWAYS
*        EITHER THE USER CONSOLE OR THE OPERATOR CONSOLE.
*        IF CID:DCB = MD:DCB , CIDFG = 1
*        IF CID:DCB NOT = MD:DCB , CIDFG = 0
*
START:2  EQU      %
         STW,0    CIDFG        RESET CIDFG. ASSUMED NOT CONDITION
         LW,14    *CID:DCB     FETCH DCB PARAMETER.
         AND,14   X200         MASK IN BIT 10
         BNEZ     ST:12        BRANCH IF ALREADY OPEN.
         CAL1,1   CID:OPEN     OPEN CID DEVICE.
ST:12    EQU      %
         LW,14    *MD:DCB      FETCH DCB PARAMETER
         AND,14   X200
         BNEZ     ST:34        BRANCH IF ALREADY OPEN.
         CAL1,1   C:OPENM
ST:34    EQU      %
         CAL1,1   CM:CRS       ISSUE CORRESPONDENCE CAL
         MTW,0    8            IF REG.8 = 0, CID = CR
         BEZ      ST:56        BRANCH DIRECTLY TO R:COM IF 0=
         STW,1    CIDFG        CID = KP
         LB,15    S:SYS        CP:R
         BNEZ     %+2          B: NO
         CAL1,1   VFCSIRS      RESET VFC....
         CAL1,1   HEDWRI2      OUTPUT TIME AND DATE(CURRENT)
         CAL1,1   HED:WR1      PRINT HEADER MESSAGE.....
         LB,15    S:SYS        CP:R
         BNEZ     %+2          B: NO........
         CAL1,1   VFCSIST      SET VFC.....
ST:56    BAL,15   RESET        RE-INITIALIZE DATE-TIME
*
*
*
         PAGE
*
*        EFFECTIVE START HERE. ALL HOUSEKEEPING DONE.
*
R:COM    EQU      %
         STW,0    SYSIDF       CLEAR SYSTEM ID ...........CONFIGURATION
      STW,0     SUM:F     RESET SUM PRESENCE FLAG.
         STW,0    SLIS:F       RESET THE SORT MODULE FLAG HERE.
         STW,0    BRK:CHK           RESET BREAK FLAG
         STW,0    SECHFLG      CLEAR SORTED SEARCH FLAG
         STW,0    DISP:F       RESET DISPLAY GRAPHIC PRESENCE FLG
RR:1     EQU      %
         BAL,15   READ:COM     READ A RECORD (COMMAND FROM CID)
*
*
*
         PAGE
*
*
* ANALIZE COMMANDS:
*
COMMAND  EQU      %
         LI,13    TA:CLIS      FETCH AND INITIALIZE FIRST
         STW,13   TABLE:       TABLE ADDRESS .
         STW,0    MTCF              MULTIPLE COMMANDS
         STW,0    CF                COMMA FLAG
         STW,0    CAB          RESET POINTER CARRIER.
COMM     STW,0    MCF               MULTIPLE MATCH, SAME COMM.
         STW,0    COB               CURRECNT BYTE COUNT
         STW,0    RB                REAL BYTE COUNT (NO BLANKS)
*
*
A:0      EQU      %
         LW,4     COB               FETCH CURRENT BYTE COUNT
         CI,4     79                CK FOR 80 COL.
         BG       A:1               BRANCH TO A:1
         LB,14    COMBUFF,4         LOAD A BYTE FROM INPUT BUFFER
         CB,14    X4BD5             IS THIS A BLANK?
         BE       A:6               IGNORE BLANKS
           CB,14    X4BD5,1       IS THIS A COMMA
         BE       A:5               BRANCH TO SET CONDITIONS
         CB,14    X4BD5,2      IS THIS LINE FEED.
         BE       A:1          RANCH IF EQUAL
         CB,14    X4BD5,3      IS THIS CARRIAGE RETURN.
         BE       A:1          BRANCH IF EQUAL
         STB,14   BYTEIN
         LW,4     RB                INDEX FOR REAL BYTE
         CI,4     3                 IS REAL BYTE MORE THAN 4
         BG       A:7          TOO MUCH PARAMETERS.
A:01     LB,14    *TABLE:,4    FETCH ONE BYTE AT A TIME.
*
         CB,14    BYTEIN
         BNE      A:4
         STW,1    MCF          SET MATCH FLAG.
         MTW,1    RB                ADD 1 TO RB
A:6      MTW,1    COB               ADD 1 TO COB
         B        A:0               FETCH NEXT BYTE
*
A:5      EQU      %
         MTW,1    CF                SET COMMA FLAG
*
A:1      EQU      %
         MTW,0    MCF          MCF FLAG = SET ?
         BEZ      A:4          BRANCH IF ZERO. (NOT SET)
         MTW,1    MTCF         INCREMENT MULTIPLE MATCH.
         LW,14    *TABLE:,1    FETCH ADDRESS TO BRANCH TO:
         STW,14   COMADRS:          FOR A GOO OVERLAY CALLING
         LW,14    *TABLE:,2  FETCH COMMA OR NO COMMA INDICATOR.
         STW,14   CONF         STORE IN SAVE LOCATION.
         LW,14    COB          FETCH CURRENT BYTE POINTER INDEX.
         STW,14   CAB          TRANSFER FOR RECEIVING MODULE.
*
A:4      EQU      %
         MTW,3    TABLE:       INCREMENT TO NEXT TABLE TEXT.
         LW,14    *TABLE:      END OF COMMANDS ?
         BEZ      A:9          BRANCH IF YES.
         LI,14    0            SET 14 FOR ZERO
         B        COMM              REPEAT THE PROCESS
*
A:9      EQU      %
         LW,14    MTCF         CHECK FOR MULTIPLE INTRIES.
         BEZ      A:7
         CI,14    1
         BE       A:11              SUCCESS PATH
A:7      EQU      %
         LI,14    15
         BAL,15   E:PRINT
         DATA     ERRMSG3
         B        R:COM             READ ANOTHER COM.
*
A:11     EQU      %
         LW,14    CONF         FETCH COMMA OR NO COMMA INDICATOR.
         BEZ      CK10         BRANCH IF NO COMMA NEEDED.
         CI,14    1
         BE       CK20         BRANCH IF COMMA NEEDED.
*
CKOK     B        *COMADRS:         BRANCH TO RESPECTIVE ROUTINE
COMADRS: DATA     0
*
*
CK10     LW,14    CF           FETCH COMMA FLAG. (SET OR NOT)
         BEZ      CKOK              COMMANDS, NO COMMA ALLOWED
         B        A:7               MUST HAVE NO COMMA BUT WITH COMMA
CK20     LW,14    CF
         BNEZ     CKOK         COMMANDS WITH COMMAS
         B        A:7               COMMANDS MUST HAVE COMMA BUT NOT
*
*
*
*
         PAGE
*
*
*
*        SELECTION BRANCHES.
*
*
*
         DATA     CLIS:0
CLIS:    LW,14    %-1          CHRONOLOGICAL.
         B        SLIS:11
         DATA     SLIS:0
SLIS:    LW,14    %-1          SORTED LIST
           STW,1     SLIS:F    SET SORT SLIS FLAG.
SLIS:11  LI,15    1            FETCH 1ST ROM SEGMENT NO.
         B        SEGLOAD      SEGMENT LOAD.
*
*  ......................
*
         DATA     TYPE:0
TYPE:    LW,14    %-1          TYPE DELIMITER.
         B        TIM:A
         DATA     MOD:0
MOD:     LW,14    %-1          MODEL DELIMITER
         B        TIM:A
         DATA     DEV:0
DEV:     LW,14    %-1          DEVICE DELIMITER
         B        TIM:A
         DATA     TIME:0
TIME:    LW,14    %-1          TIME DELIMITER
TIM:A    LI,15    2            FETCH SEGMENT ROM NO.
         B        SEGLOAD      SEGMENT LOAD.
*
*  .......................
*
         DATA     SUM:0
SUM:     LW,14    %-1          SUMMARY.
         LI,15    3            FETCH SEGMENT NO ROM.
         STW,1   SUM:F    SET SUM PRESENCE FLAG.
         B        SEGLOAD      SEGMENT LOAD.
*
*  .......................
*
         DATA     DISP:0
DISP:    LW,14    %-1          DISPLAY DELIMITER COMMAND.
         LI,15    4            FETCH SEGMENT ROM NO.
         STW,1    DISP:F
         B        SEGLOAD      SEGMENT LOAD.
*
*  ........................
*
ANLZ:    LI,14    38           ANALIZE IS NOT IMPLEMENTED
         BAL,15   L:PRINT      AT THIS MOMENT.
         DATA     A:MSGL
         B        R:COM
A:MSGL   TEXT     'ANLZ IS NOT IMPLEMENTED AT THIS MOMENT'
*
*  .........................
*
END:     EQU      %
         B        EXIT:M       EXIT PROGRAM.
*
*  .........................
*
DSPL:    EQU      %
         BAL,15   DSPL:0       DISPLAY BOUNDARIES.
         B        R:COM        FETCH NEXT COMMAND.
*
*        ......................
*
RSET:    EQU      %
         BAL,15   RESET        RE-INITIALIZE
         B        R:COM
*
*
RESET    EQU      %
         STW,0    YEAR:1       RESET YR,DATE,TIME (:1)
         STW,0    DATE:1
         STW,0    TIME:1
         LW,14    YEAR:3       RE:INITIALIZE YR,DATE,TIME (:2)
         STW,14   YEAR:2
         LW,14    DATE:3
         STW,14   DATE:2
         LW,14    TIME:3
         STW,14   TIME:2
         STW,0    MODF
         STW,0    TYPEF        RESET THE SELECTION BOUNDARIES.
         STW,0    DEVF
RSE:     LW,14    TAB1ST       CHECK SORT TABLE INDICATOR.....
         BEZ      RS:1         NO SORT NOT DONE.
         LB,14    S:SYS        CPR OR NOT
         BEZ      RS:2         B: CR-R
         CAL1,8   PAGE:FR      FREE CP:V PAGES....
         B        RS:1         DONE GO
RS:2     LW,14    VPNLOW       FETCH THE VPN LOW STARTING.
         AI,14    1            ADD ONE.
         STB,14   VIPL,3       SET FPT.........
         LW,14    VPNHIGH      FETCH VPN HIGH ENDING.
         AI,14    1            ADD ONE
         STB,14   VIPH,3       SET FPT
         CAL1,7   RELPAG       RELEASE THE PAGE.....
         CAL1,7   PAGER        ERASE SEGMENT 5
RS:1     EQU      %            CONTINUE
         LW,14    *EL:DCB      PREPARE TO CLOSE EL:DCB....
         AND,14   X200
         BEZ      %+2
         CAL1,1   CLOSEL       CLOSE EL:DCB.....(ERRFILE)
         STW,0    MDIO
         STW,0    S:FLAG       CLEAR SORT FLAG
         STW,0    TAB1ST       CLEAR SORT TABLE INDICATOR.....
         STW,0    MODTBL:      ZERO OUT MODEL TABLE.
         B        *15
PAGE:FR  GEN,1,7,7,17  1,9,0,PAGECNT
RELPAG   GEN,8,1,7,16  X'58',1,0,5
         DATA     X'06000000'
VIPL     DATA     0
VIPH     DATA     0
PAGER    GEN,8,1,7,16          X'54',1,0,5
         DATA     X'80400000',WRI:ERR,0
*        .........................
*
*
*        SET COMMAND.
*        THE SET COMMAND IS CODED TO THE SPECIFICATION ACCORDING
*        TO 703118.
*        RETURN WILL BY R:COM AFTER TERMINATION.
*
SET:     EQU      %
         LW,14    CAB          TRANSFER THE BYTE COUNT INDEX.
         STW,14   COB
         LI,14    S:COM        ADDRESS OF TABLE LOOKUP.
         BAL,15   SEARCH       SEARCH FOR THE MATCH.
         B        A:7          **INVALID INPUT**
         LW,4     15           TRANSFER THE POINTER.
         LW,15    S:L,4        FETCH THE ADDRESS POINTED TO.
         B        *15          BRANCH TO IT.
*
*
*
*
*        LIST CODE.            (LIST DEVICE)
*
0:LIST   EQU      %
         LW,14    *LD:DCB      CHECK LD DCB DEVICE.
         AND,14   X200         CHECK OPEN BITS.
         BEZ      1:LIST       BRANCH IF CLOSED.
         CAL1,1   CLOSELD      CLOSE THE LD DEVICE.
1:LIST   LI,14    S:COM11      FETCH SEARCH TABLE #2
         BAL,15   SEARCH       SEARCH
         B        A:7          **INVALID INPUT**
         LB,14    S:SYS        DETERMINE IF CP-R/CP-V
         BEZ      2:LIST       BRANCH IF CP:R SYSTEM
         LW,5     15           FETCH THE POINTER. (0 OR 1)
         LH,15    LPOCTX,5     FETCH RIGHT OP-LABEL.
         AND,15   XFFFF        MASK OUT LEAST HALF.
         STW,15   OPENLD+2     STORE TO LOCATION OF FPT.
         CAL1,1   OPENLD       ASSIGN THE DEVICE BY AND M:OPEN.
         CAL1,1   LP:HEAD      TOP OF FORM HEADER CALL.....
         B        R:COM        RETURN TO R:COM.
*
*
*
*
*CP-R LIST DEVICE ASSIGNMENT.
*
2:LIST   EQU      %
         CI,15    0            15 = 0
         BE       3:LIST       BRANCH IF 15 = 0
         LW,15    CPRSIA       FETCH OC LABEL........
         B        4:LIST
3:LIST   LW,15    LOTX         FETCH THE OP-LABEL (LP)
4:LIST   STW,15   CPRMSS       STORE TO FPT TABLE.
         CAL1,1   CPRASS       AGSSIGN CP-R SYSTEM.
         B        R:COM        RETURN TO R:COM.
*
*
*        FILE,XX(YYYY) CODE. (ERROR FILE DEVICE ASSIGNMENT)
*
*
0:FILE   EQU      %
         LI,14    38           PRINT THE MESSAGE.
         BAL,15   E:PRINT      'THIS COMMAND NOT IN OPERATION YET'
         DATA     FILEMSG
         B        R:COM        RETURN TO R:COM
         BAL,15   RSE:         AFTER THOUGHT OF RESETTING SORT TABLES
FILEMSG  TEXT     'FILE ASSIGNMENT IS NOT IMPLEMENTED YET'
*
*
*
         SPACE    5
*
*        INPT ASSIGNS THE KEYBOARD.(/
*        THIS ASSIGNMENT VALID ONLY FOR CP-R SYSTEM.
*
0:INPT   EQU      %
         LB,14    S:SYS        CP-R OR CP-V SYSTEM.
         BNEZ     4:INPT       BRANCH IF CP-V SYSTEM.
         LW,14    2:INPT       PASS CONTROL. (ONCE ASSIGNED,NOT
         BNEZ     5:INPT             RE-ASSIGNABLE)
         LI,14    S:COM31      FETCH TABLE  ADDRESS.
         BAL,15   SEARCH
         B        A:7          **INVALID INPUT**
         LW,14    M:SI         FETCH DCB BIT (OPEN / CLOSED)
         AND,14   X200         BRANCH THRU IF CLOSED.
         BEZ      1:INPT
         CAL1,1   CLOSI        CLOSE THE SI DEVICE.
1:INPT   CAL1,1   CPRSIS       ASSIGN THE CP:R M:SI TO OC DEVICE.
         STW,1    2:INPT       SET FLAG FOR ENTRNANCE ONLY ONCE
         STW,1    CIDFG             SET CID FLAG.
         B        R:COM        RETURN TO R:COM.
2:INPT   DATA     0            ENTRANCE FLAG.
*
*        ERROR MESSAGES ROUTINE.
*
4:INPT   LI,14    27
         LI,15    CPVNVM
         B        6:INPT
5:INPT   LI,14    16
         LI,15    CPRASN
6:INPT   STW,15   7:INPT
         BAL,15   E:PRINT
7:INPT   DATA     0
         B        R:COM        RETURN TO R:COM
CPVNVM   TEXTS    'COMMAND LEGAL ON CP:R ONLY'
CPRASN   TEXTS    'NON-REASSIGNABLE'
*
*
*
         PAGE
*
*        TABLE OF ADDRESS AREA.
*
S:COM    GEN,8,8,8,8  3,4,1,1
S:LIST   TEXTS    'LIST'
S:FILE   TEXTS    'FILE'
S:INPT   TEXTS    'INPT'
*
*
*
S:COM11  GEN,8,8,8,8  2,2,1,0
S:LTLP   TEXTS    'LP'
S:LTKP   TEXTS    'KP'
*
*
*
S:COM22  GEN,8,8,8,8  2,2,1,0
S:FERD   TEXTS    'RD'
S:FEMT   TEXTS    'MT'
S:COM31  GEN,8,8,8,8  1,2,1,0
S:ITKP   TEXTS    'KP'
*
*
*
         PAGE
*
*        ADDRESS TABLES.
*
S:L      DATA     0:LIST,0:FILE,0:INPT
*
*
*
         PAGE
*
*        THE FPT'S AREA FOR THE OPEN , CLOSE OF DCB'S.
*
CLOSELD  GEN,1,7,7,17  1,X'15',0,LD:DCB  FOR CLOSING THE LD DEVICE
         DATA     0
OPENLD   GEN,1,7,7,17  1,X'14',0,LD:DCB  FOR OPENING (ASSIGN) LD DEVICE.
         DATA     X'40000',0
CPRASS   GEN,8,1,23  8,1,M:LO  CP-R ASSIGN FOR LO DEVICE.
         GEN,1,1,1,1,28  0,1,0,0,0
CPRMSS   DATA     0
CLOSI    GEN,8,7,17  X'15',0,M:SI  CP-R CLOSING M:SI DEVICE.
         DATA     0
CPRSIS   GEN,8,1,23  8,1,M:SI  CP-R ASSIGN SI DEVICE TO KP
         GEN,1,1,1,1,28  0,1,0,0,0
CPRSIA   DATA     X'D6C3'
*
*
*
LPOCTX   TEXT     'LPOC'
LOTX     DATA     X'D3D6'      'LO'
*
*
*
         PAGE
*
*
*        SEARCH ROUTINE.
*        SEARCH FOR A MATCH FROM A GIVEN TABLE ADDRESS OF
*        MATCHES (ADDRESS START LOCATION IN REGISTER 14)
*        AND GIVE THE CORRECT NUMBER WHICH POINTS TO THE
*        CORRECT ADDRESS ROUTINE.
*
*        THIS IS A SPECIALIXED SUBROUTINE NOT BE USED ELSEWHERE.
*
*
*        CALL:
*        LI,14    TABLE ADDRESS START.
*        BAL,15   SEARCH
*        ERROR RETURN.
*        GOOD RETURN.
*        REGISTER 15 HAS THE INDEX UPON RETURN.
*
*        REGISTER 14,15 VOLATILE.
*
*
SEARCH EQU        %
         STW,4    SCH:V        SAVE REG. 4
         STW,15   SCH:V+2      SAVE REG 15
         LW,15    *14          FETCH TABLE ADDRESS.
         AI,14    1            INCREMENT BY ONE.
         STW,14   SCH:V+1      SAVE REG. 14
         STB,15   CFF,3        SAVE THE VARIOUS BYTE INFORMATIONS.
         SLS,15   -8
         STB,15   CFP,3
         SLS,15   -8
         STB,15   BPW,3
         SLS,15   -8
         STB,15   NOW,3
         STW,0    MTCF         CLEAR MULTIPLE MATCH FLAG.
         STW,0    ACAM         RESET THE POINTER CARRY INDEX.
         STW,0    CAM          RESET THE POINTER COUNT.
         LW,15    COB          EXCHANGE THE BYTE INPUT INDEX.
         STW,15   CAB
1:SCH    STW,0    PASS         RESET THE PASS FLAG.
         STW,0    MCF          RESET MATCH FLAG.
         STW,0    RB           RESET THE INTERNAL INDEX.
         LW,15    CFP
         STW,15   CF           FETCH COMMA FLAG SET.
         LW,15    CAB          RESET THE POINTER.
         STW,15   COB
*
*
*
2:SCH    BAL,15   F:F          FETCH A CHARACTER.
         B        5:SCH        **INVALID INPUT**
         STW,1    PASS         SET THE PASS FLAG.
         CB,14    X4BD5,1
         BE       3:SCH        BRANCH IF A COMMA.
         STW,0    CF           RESET COMA FLAG.
         LW,4     RB           FETCH INTERNAL COUNTER.
         CW,4     BPW          IT IS WITHIN LIMITS.
         BGE      7:SCH        **ERROR** OUT OF BOUNDS.
         CB,14    *SCH:V+1,4   COMPARE TO TABLE ADDRESS.
         BNE      4:SCH        BRANCH IF NOT EQUAL
         STW,1    MCF          MATCH !! SET MATCH FLAG.
         MTW,1    RB           INCREMENT INTERNAL FOUNDTER
         B        2:SCH        B:
*
*
*
*        NO MATCH..
*
*
*
4:SCH    STW,0    MCF          RESET MATCH FLAG.
         B        8:SCH
*
*
*
*        COMMA ENCOUNTERED.
*
*
*
3:SCH    MTW,0    CF           COMMA PREVIOUS TO THIS.
         BNEZ     7:SCH        **ERROR** COMMA FLAG SUPPOSED = 0
         STW,1    CF           CF FLAG OK! SET COMMA FLAG NOW.
*
*        TERMINATION
*
*
*
5:SCH    MTW,0    PASS         CHECK PASS FLAG.
         BEZ      7:SCH        IF ZERO **ERROR** (BRANCH)
         LW,14    CF           CHECK COMMA FLAG.
         CW,14    CFF          CHECK AGAINST THE FORWARD COMMA INDICATOR.
         BNE      7:SCH        **ERROR** NO GO.
8:SCH    MTW,1    CAM          INCREMENT COUNT.
         MTW,1    SCH:V+1           INCREMENT TABLE ADDRESS.
         MTW,0    MCF          CHECK MATCH FLAG.
         BEZ      9:SCH        BRANCH IF ZERO
         LW,14    CAM          FOUND A MATCH, TRANSFER COUNT.
         STW,14   ACAM
         MTW,1    MTCF         SET (INCREMENT) MTCF.
         LW,14    COB               TRANSFER THE COB.
         STW,14   CEB               TO CEB.......
9:SCH    LW,14    CAM          CHECK BOUNDS.
         CW,14    NOW          (WITHIN BOUNDS??)
         BL       1:SCH        BRANCH IF YES.
*
*        FALL THRU IF OVER........
*
*        ALL OVER.....
*
6:SCH    EQU      %
         LW,4     MTCF
         CI,4     1
         BNE      7:SCH        **ERROR**
         MTW,1    SCH:V+2      INCREMENT RETURN ADDRESS.
7:SCH    LW,4     SCH:V        RESTORE 4
         LW,14    CEB               RESTORE THE COB POINTER.
         STW,14   COB
         LW,14    SCH:V+1      RESOTE 14
         LW,15    ACAM
         AI,15    -1           DECREMENT REGISTER 15
         B        *SCH:V+2     RETURN.
SCH:V    RES      3
CAM      DATA     0
ACAM     DATA     0
CFF      DATA     0
CFP      DATA     0
BPW      DATA     0
NOW      DATA     0
PASS     DATA     0
CEB      DATA     0
*
*
*
*
*
*
         PAGE
*
*
*  SEGMENT LOAD ROUTINE.
*  THIS ROUTINE WILL LOAD THE APPROPIATE SEGMENT FROM MEMORY
*
*  THE SEGMENT NO. WILL BE FOUND IN REGISTER 15 UPON ENTRY.
*  THIS SEGMENT NO. IS USEFUL FOR CP-R AS A SEGMENT NO.
*  IT IS USEFUL FOR CP-V AS THE INDEX TO THE BYTE STRING
*  CONTAINING THE EBCDIC NAME OF THE SEGMENT ROM.
*
*  THIS IS NOT A SUBROUTINE. THE ENTRY INTO SEGLOAD WILL
*  EFFECTIVELY TRANSFER TO THE DESTINATION ADDRESS FOUND IN
*  REGISTER 14 UPON ENTRY.
*
*
SEGLOAD  EQU      %
*
         LW,5     15           FETCH THE SEGMENT #
         CI,15    2            IS IT THE BOUNDARY SEGMENT
         BE       SGAM         B: EQUAL........
         BAL,15   SKIPTP       SKIP AND NEW PAGE EJECT.
         BAL,15   L:SPACE
         BAL,15   L:SPACE
         BAL,15   L:SPACE
SGAM     EQU      %
*
*
*
         CW,14    SG:DEST      SEGMENT LOADED??
         BE       SG:4         B: EQUAL
         STW,14   SG:DEST      SAVE DESTINATION ADDRESS.
         LB,14    S:SYS        FETCH CP-V/CP-R DIFFERENCE
         BEZ      SG:1         BRANCH IF CP-R
         AI,5     -1           CP-V SYSTEM. SET UP INDEX
         LW,15    CSL:1,5
         STW,15   CPV:FPT1     SET UP ADDRESS TO CORRECT STRING.
         CAL1,8   CPV:FPT      LOAD CPV SEGMENTS.
         B        SG:4         BRANCH TO DESTINATION.
SG:1     EQU      %
         LW,15    CPR:FPT
         AND,15   XFFFF        ANY MODULES LOADED.(ACTIVATED)
         CI,15    0
         BEZ      SG:5         B: NO.. NONE...
         LI,15    X'54'        ERASE IMMEDIATEDLY......
         STB,15   CPR:FPT
         CAL1,7   CPR:FPT
SG:5     LI,15    X'52'        ACTIVATE NEXT SEGMENT....
         STB,15   CPR:FPT
         STH,5    CPR:FPT,1
         CAL1,7   CPR:FPT      ACTIVATE.........
SG:4     B        *SG:DEST
*
*
*
SG:DEST  DATA     0
*
*
*
CSL:0    TEXTC    'CSL'
TMD:0    TEXTC    'TMD'
SIM:0    TEXTC    'SUM'
DSP:0    TEXTC    'DSP'
*
*
*
CSL:1    DATA     CSL:0        CHRONOLOGICAL AND SORTED.
TMD:1    DATA      TMD:0       BOUNDARY.
SIM:1    DATA       SIM:0      SUMMARY.
DSP:1    DATA        DSP:0     DISPLAY.
*
*
*
CPV:FPT  GEN,8,24  X'01',0
CPV:FPT1 DATA     CSL:0
*
*
*
CPR:FPT  GEN,8,1,23  X'52',1,0
         DATA     X'80000000'
         DATA     ERRADRS
*
*
*
ERRADRS  EQU      %
         BAL,15   ERR:PRN      ERROR PRINTOUT.
         LH,14    CPR:FPT,1         FETCH SEGMENT NO.
         BAL,15   HEXEBC
         STH,15   ERMSG4+6     STORE SEGMENT NO.
         LI,14    28           FETCH BYTE COUNT.
         BAL,15   E:PRINT           PRINT ERROR MESSAGE
         DATA     ERMSG4
         B        R:COM        BRANCH TO START AGAIN.
*
*
ERMSG4   TEXT     'UNABLE TO LOAD SEGMENT=     '
         PAGE
*
*
*  SKIP TO TOP OF PAGE IN LINE PRINTER,,,,IGNORE IN KP
*
*   PRIMARILY FOR LINE PRINTTER........
*
SKIPSAV  DATA     0,0
SKIPTP   EQU      %
         LCI      2            SAVE REG.. 14,15
         STM,14   SKIPSAV      SAVE.........
         CAL1,1   VFCSET       SET VFC.......
         LI,14    4            SET BYTE COUNT 4
         BAL,15   L:PRINT      PRINT..........
         DATA     KIPMSG       TOPOF PAGE CHARACTER.....
         CAL1,1   VFCRST       VFC RESET.......
         LCI      2            RESTORE REGISTERS.....
         LM,14    SKIPSAV
         B        *15          RETURN.............
KIPMSG   TEXT     '1   '
VFCSET   GEN,1,7,7,17  1,X'05',0,LD:DCB
         DATA     X'10'
VFCRST   GEN,1,7,7,17   1,X'05',0,LD:DCB
         DATA     0
         PAGE
*
*
*  THIS ROUTINE READS A RECORD FROM A CARD READER.
*
READ:COM EQU      %
         LCI      2
         STM,14   R:SAVE            SAVE R14 AND R15
         STW,4    R:SAVE+2
         STW,5    R:SAVE+3      SAVE REGISTER 5
         LI,4     -20
         LW,15    X40X
         STW,15   COMBUFF+20,4      STORE SPACES
         BIR,4    %-1
*
         LW,4     DEF:FLG      DEFAULT.........
         BNEZ     RED:DEF      B: IF YES.......
         LB,15    S:SYS        CHECK ON CP-R OR CP-V SYSTEM
         BNEZ     REB:         B: CP-V.......
         CAL1,1   DRCRST       RESET DRC BIT.......
         CAL1,1   VFCSIST      SET THE VFC M:SI DCB (BIT)
         LI,15    X'F2'        SET THE EXTRA PROMPT BIT.......
         STB,15   FPT:READ+1   .......................
REB:     EQU      %
         CAL1,1   FPT:READ     READ A COMMAND.......
         STW,1    PAS:FLG      SET THE PASS FLAG.... NO DEFAULT
         LI,4     4            SET INDEX.
         LW,14    *CID:DCB,4   FETCH THE ARS PARAMETER IN DCB.
         SLS,14   -17          SHIFT RIGHT 17 BITS.
REB:0    LI,5     0            CLEAR REG. 5
         LI,4     1            SET INDEX 4
REBUNT   LB,15    COMBUFF,5    FETCH BYTE AND TRANSFER TO
         STB,15   OUTXT,4       OUTPUT BUFFER.
         AI,4     1            INDEX INCREMENT.
         AI,5     1
         CW,5     14           ALL BYTES INTO OUTPUT BUFFER.
         BL       REBUNT       BRANCH IF NO.
         BAL,15   E:PRINT      PRINT OUT TO OC AND/OR LO OR NONE.
R:HELL   DATA     OUTXT
         LW,4     R:SAVE+2          RESTORE X4
         LW,5     R:SAVE+3     RESTORE REGISTER 5
         LI,15    X'F0'
         STB,15   FPT:READ+1   RESTORE THE BYTE IN CASE OF CP-V BENEFIT.
         LW,15    R:SAVE+1          RESTORE R15
         LW,14    R:SAVE       RESTORE REG. 14
         B        *R:SAVE+1
OUTXT    TEXT     '*   '
         RES      20
*
*
R:COMAAD EQU      %
         LB,10    10           FETCH THE TYPE CODE.......
         CI,10    5            END OF FILE.........
         BE       RED:DEF      B: IF YES......
         CI,10    6            END OF DATA.........
         BE       RED:DEF      B: IF YES......
         BAL,15   ABN:PRN      ABNORMAL ERROR PRINTOUT
         B        R:COM        BRANCH (READ ANOTHER INPUT)
*
*
VFCSIST  GEN,1,7,7,17 1,5,0,CID:DCB
         DATA     X'10'
R:SAVE   RES 4
COMBUFF  RES      20
FPT:READ GEN,8,24 X'90',CID:DCB
         DATA     X'F0000010',WRI:ERR,R:COMAAD,COMBUFF,80,X'5C'
PAS:FLG  DATA     0
DEF:FLG  DATA     0
         DATA     X'E2E4D415',X'C3D3C915',X'E2D3C915'
         DATA     X'C4C9E215',X'C5D5C415'
*
*
*
RED:DEF  LW,14    PAS:FLG      DEFAULT REGION..... ANY COMMANDS
         BNEZ     RED:1        B: IF YES... COMMANDS ENTERED...
         LW,14    DEF:FLG      CHECK DEFAULT FLAG.
         BNEZ     %+2          B: IF YES.
         STW,1    DEF:FLG      SET DEF:FLG.....
         LW,4     DEF:FLG      FETCH FLAG/ NOW A COUNTER.
RED:2    LW,14    DEF:FLG,4    FETCH A COMMAND.......
         STW,14   COMBUFF      STORE TO COMMAND BUFFER...
         LI,14    4
         MTW,1    DEF:FLG      BUMP DEF FLAG....
         B        REB:0        BRANCH TO EXECUTE.......
RED:1    LI,4     5            SET THE END OF ELLA COMMAND.
         B        RED:2        B: EXECUTE IT.....
         PAGE
*
*
*
RD:14    LB,15    BUFFER       FETCH TYPE CODE........
         CI,15    X'15'        DEVICE ERROR......
         BNE      RD:EX        BRANCH NOT EQUAL.......
         LI,15    -1           NITIALIZE 15 WITH A MINUS ONE...
         STW,15   SECFL
         LH,15    BUFFER+2,1
         LW,4     SECPNTR
         STH,15   SECLIST,4
         AI,4     1            INCR. POINTER MODULO 32
         CI,4     32
         BL       RD:A14
         LI,4     0
RD:A14   STW,4    SECPNTR
         B        RD:EX
SECFL    DATA     0            PRIME FLAG '42-44'
SECPNTR  DATA     0            SECLIST POINTER....
SECLIST  DO1      16           LAST 32 DEV. ADR. FROM ACCEPTED 15'S
         DATA     0
*
*
*
         PAGE
*
*
* THIS ROUTINE REWINDS AND OR READS A RECORD FROM ERROR FILE.
* IF R15 IS RESET IT INDICATES EITHER EOF OR EOD CONDITION OCCURRED.
* R15 IS SET IF IT IS A GOOD READ.
* REW:FLAG IS SET ONLY FOR THE FIRST READ.
*
*
READ:ERF EQU      %
         LCI      0            SAVE THE REGISTER BLOCK
         STM,0    E:SAVE
         LI,4     -256         RESETTO BLANKS THE BUFFER.
         LW,5     X40X
         STW,5    BUFFER+256,4
         BIR,4    %-1
         LW,4     REW:FLAG     CHECK REWIND OR NOT.
         BEZ      RD:01        B: IF ZERO
         STW,0    PSSF         RESET THE PASS FLAGAND SEQ. COUNT.
         LB,4     S:SYS        CHECK FOR SYSTEM TYPE.
         BEZ      %+2          B: IF CP:R
ASIGN    CAL1,1   BIOPEN       M:OPEN. ASSIGN M:BI ERRFILE.
REWIND   CAL1,1   REW          ISSUE A REWIND TO M:BI
         STW,0    REW:FLAG     RESET REW FLAG.
         STW,0    YR:R         RESET THE TIME BOUNDS.
         STW,0    JD:R
         STW,0    TM:R
         LI,4     16           INITIALIZE SECLIST.......
         STW,0    SECLIST-1,4
         BDR,4    %-1
         LB,4     S:SYS        CHECK SYSTEM
         BEZ      RD:01        B: IF CP:R
*
*        CP-V SYSTEM . GET THE KEY SET-UP
*
         LW,14    TIME:1       FETCH THE TIME.
         BAL,15   MS:HMSN      CONVERT TO HR,MIN
         STW,13   KEYLOC       SAVE IN KEYLOC AS TEMP.
         LI,13    0            SET THE BYTE POINTER TO 0
         LW,14    12           FETCH THE HRS.
         BAL,15   HEXTWO
         DATA     KEYLOC+1
         LI,13    2
         LW,14    KEYLOC       FETCH MINS.
         BAL,15   HEXTWO
         DATA     KEYLOC+1
         LW,14    DATE:1       FETCH THE DATE JULIAN.
         BAL,15   HEXDEC:      CONVERT TO PACK DECIMAL
         STW,15   KEYLOC
         LW,14    YEAR:1       FETCH YEAR.
         BAL,15   HEXDEC:      CONVERT TO PACK DECIMAL
         OR,15    X0700
         STH,15   KEYLOC
*
*  KEYED READ.
*
RD:02    LW,15    BRK:CHK           CHECK BREAK FLAG
         BNEZ     RD:FIN            B: WANTS OUT NOW......
         LI,15    X'F8'             SET THE KEYED READ
         STB,15   FPT:RDE+1
         CAL1,1   FPT:RDE      READ CAL.
         B        RD:03
*
*  SEQUENTIAL READ.
*
RD:01    LW,15    BRK:CHK           CHECK BREAK FLAG......
         BNEZ     RD:FIN            B:  WANTS OUT NOW...
         LI,15    X'F0'             SET SEQUENTIAL READ.
         STB,15   FPT:RDE+1
         CAL1,1   FPT:RDE      READ CAL.
RD:03    MTW,1    PSSF
         LB,4     S:SYS        CHECK SYSTEM TYPE
         BEZ      RD:05        B: IF CP:R
         LI,4     10           SET COUNTER.
         LW,13    *EL:DCB,4    FETCH ADDRESS OF KEY.
         AND,13   X1FFFF       AND ADDRESS IN.
         LB,14    *13,1
         BAL,15   DECHEX:      CONVERT TO HEX.
         B        RD:ERRX      **ERROR** NOT DECIMAL.
         STW,15   YR:R         STORE TO YEAR .
          LH,14   *13,1
         AND,14   XFFFF        FETCH DATE (JULIAN)
         BAL,15   DECHEX:      CONVERT
         B        RD:ERRX      **ERROR** NOT DECIMAL.
         STW,15   JD:R         SCVE
         B        RD:04
*
*  CP:R SECTION **
*
RD:05    LB,15    BUFFER       FETCH TYPE CODE
         CI,15    X'18'        TYPE CODE 18
         BE       RD:06        B: IF YES
         CI,15    X'23'        TYPE CODE 23
         BNE      RD:04        B: NOT EQUAL.
RD:06    LB,15    BUFFER+2,1   FETCH YEAR FROM RECORD
         STW,15   YR:R         SAVE IN YEAR.
         LH,15    BUFFER+2,1   FETCH DATE.
         AND,15   XFFFF        AND
         STW,15   JD:R         SAVE IN DATE.
*
*
*
RD:04    LB,15    BUFFER       FETCH TYPE
         LI,4     41
         CB,15    CDE,4        CHECK ON VALID TYPE CODES.
         BE       %+3          B: EQUA
         BDR,4    %-2          LOOP
         B        %+3
         LW,15    BUFFER+1     FETCH RELATIVE TIME.
         STW,15   TM:R         SAVE
*
*
*        FETCH AND UPDATE SISIDF IF TYPE IS SYSTEM ID......
*
*
         LB,15    BUFFER       FETCH TYPE
         CI,15    X'22'        B: IF SYSTEM ID
         BNE      RD:04A       B: NOT EQUALLLLLLLL
         LW,15    BUFFER+2     FETCH THE SYSTEM ID CONFIGURATION.
         LI,4     X'C0'        FETCH THE MASK.
         AND,15   4            MASK.........
         SLS,15   10           SHIFT RIGHT 10
         STW,15   SYSIDF
         LB,15    BUFFER+2
         SLS,15   -4           SHIFT THE CP-R/CP-V OR OTHERS...
         STB,15   SYSIDF       STORE..........
RD:04A   EQU      %
*
*        CHECK TIME BOUNDS.
*
         LW,15    YR:R         FETCH THE YEAR GOTTEN FROM RECORDS/KEY
         CW,15    YEAR:1       COMPARE TO BEGGINNING BOUNDARY.YEAR
         BL       RD:01        B: IF LESS THAN (READ AGAIN)
         BG       RD:07        B: IF GREATER THAN 1ST BOUNDS.
         LW,15    JD:R         (YEAR=YEAR:1,CHECK DATE)
         CW,15    DATE:1       CHECK AGAINST DATE 1ST BOUND.
         BL       RD:01        B: LESS THAN 1ST DATE....
         BG       RD:07        B: GREATER THAN 1ST DATTE.....
         LW,15    TM:R         (DATE=DATE:1,CHECK TIME)
         CW,15    TIME:1       CHECK AGAINST 1ST TIME.....
         BL       RD:01        B: LESS THAN 1ST TIME.....
         BE       RD:09        B: IF EQUAL TO 1ST TIME(YEAR=YEAR1,DATE=DATE1)
*
*        CODE HERE IS FOR THE TIME,DATE,YEAR BOUNDS GREATER THAN 1ST
*        BOUNDARY....CONTINUE HERE IF THE TIME IS GREATER(YEAR,DATE,TIMEE)
*
RD:07    LW,15    YR:R         FETCH THE RECORD YEAR AGAIN...
         CW,15    YEAR:2       CHECK AGAINST 2ND BOUND....
         BL       RD:08A       B: IF LESS THAN........
         BG       RD:FIN       TERMINATE....GREATER THAN 2ND BOUND...
         LW,15    JD:R         (YER = YEAR:2) CONTINUE
         CW,15    DATE:2       CHECK AGAINST 2ND DATE BOUND
         BL       RD:08A       B: IF LESS THAN.........CONTINUE
         BG       RD:FIN       B: IF GREATHER THAN. TERMINATE.....
         LW,15    TM:R         (DATE=DATE:2)  CONTINUE
         CW,15    TIME:2       (DATE=DATE:2) CHECK TIME.......
         BLE      RD:09        B: IF LESS THAN OR EQUAL TO........GOOD
*
*        CHECK FOR TIME GREATER THAN 23:59:59:999.........
*
         CW,15    TIME:3       CHECK AGAINST THE LMIT (23:59:59:999)
         BL       RD:FIN       B: LESS THAN (NOT THE SPECIAL CASE)
RD:08    LW,15    DISP:F       DO NOT GIVE TO DISPLAY GRAPHIC IF TIME GREATER 23
         BNEZ     RD:01        READ ANOTHER RECORD.
         B        RD:09        PASS THROUGH. SPECIAL CASE.....
*
*        THIS CODE FOR THE YEAR OR DATE LESS THAN YEAR:2 OR DATE:2
*
RD:08A   LW,15    TM:R         FETCH THE TIME FOR CHECK...
         CW,15    TIME:3       NOTMORE THAN THE LIMIT (23:59:59:999)
         BL       RD:09        GOOD CONTINUE........
         B        RD:08        YES.....GO FOR MORE CHECKNG......
*
*
*
*  ELIMINATTE X'28'   IOCOUNT.....
*
*
RD:09    EQU      %
         LW,15    SUM:F
         BNEZ     %+4
         LB,15    BUFFER
         CI,15    X'28'
         BE       RD:XXX       X'28' B: READ AGAIN.....
*
*  GOOD BRANCH THRU.
GOOB     EQU      %
*
         LW,15    SLIS:F       CHECK SLIS FLAG............
         BEZ      RD:10        B: NOT THE SLIS MODULE IN CORE.
         LW,15    SECHFLG      CHECK SEARCH SORT FLAG
         BNEZ     RD:EX        B: NOT ZERO
*
*         SLIS:F =1 COMMENCE BUILDING SORT TABLES.
*
         LW,15    S:FLAG       TABLE DONE YET.
         BNEZ     RD:FIN       TABLE DONE. B: FIN.
*
*
*   BUILD MOD,IO TABLE HERE.....
*  ONLY TYPES 21,12,11,13,15,36-39,51,52 WILL BE LOOKED AT
*
         LB,15    BUFFER            FETCH TYPE CODE.
         LI,4     3                 SET COUNTER.
MIO:1    CB,15    DVTY,4            CHECK TYPE
         BE       MIO:3             B: EQUAL
         CI,4     12                ALL DONE
         BGE      MIO:2             B: GT. OR. EQ.
         AI,4     1                 BUMP ONE
         B        MIO:1             LOOP
MIO:2    CI,15    X'21'
         BNE      MIO:5             B:NOT EQQUAL
         LI,4     2                 SET COUNTER
MIO:4    CB,4     BUFFER,1          CONFIGURATION. COUNT DONE.
         BGE      MIO:5             B: DONE.
         LW,13    BUFFER,4          FETCH MODEL
         SLS,13   -16               SHIFT RIGHT 16 BITS.
         AI,4     1
         LW,14    BUFFER,4          FETCH IO ADDRESS.
         AND,14   XFFFF             MSK IN.
         BAL,15   MIO:GO
         B        MIO:6             OVERFLOW OF 50 LOCATIONS.
         AI,4     1
         B        MIO:4
MIO:3    LW,13    BUFFER
         AND,13   XFFFF             MASK IN
         LW,14    BUFFER+2          FETCH MODEL AND IO ADDRESS.
         AND,14   XFFFF             MASK IN.
         BAL,15   MIO:GO
         B        MIO:6             OVERFLOW OF 50 LOCATION.
MIO:5    EQU      %
         BAL,15   TABLD             BUILD SORT TABLE.
         B        MIO:6             OVERFLOW OF SORT TABLE.
         B        RD:01             READ ANOTHER RECORD.....
*
*
*   CHECK FOR TYPE 28...IF IT IS ASKED FOR...PRINT IT OUT.
*    IF IT IS NOT ASKED FOR....IGNORE IT.......
*
*
RD:XXX   EQU      %
         LW,4     TYPEF        FETCH THE TYPES....
         BEZ      RD:01        BRANCH IF NO ENTRIES....IGNORE 28
         LW,15    TYPEF,4      START ........
         CI,15    X'28'
         BE       GOOB         B: IF IT IS ASKED.......GOOD BRANCH
         BDR,4    %-3
         B        RD:01        NONE.....IGNORE 28
*
*  OVERFLOW,,OF EITHER THE MODEL/IO TABLE OR SORT TABLE....
*
MIO:6    LI,14    35
         BAL,15   E:PRINT
         DATA     OVER:M
         B        RD:FIN
OVER:M   TEXT     '**OVERFLOW OF SORT OR MOD/IO TABLES'
CDE      DATA     X'00101112'
         DATA     X'13151617'
         DATA     X'18191A1B',X'1D1E1F20',X'21222324'
         DATA     X'27272830',X'31323435',X'36373839',X'41424344'
         DATA     X'50515253'
         DATA     X'26490000'
*
*
*
*    INPUT OF MODEL AND IO ADDRESS........
*     AT INPUT TIME REGISTER 13 CONTAINS MODEL NUMBER.
*                    REGISTER 14 CONTAINS IO ADDRESS.
*      CALL IS    BAL,15            MIO:GO
*                   OVERFLOW RETURN..**ERROR**
*                    GOOD RETURN..
*
MIO:GO   STW,4    MIO:GOS
         LW,4     MODTBL:           FETCH COUNT
         BEZ      MIO:GOX
         CW,13    MODTBL:,4
         BE       MIO:GCN
         BDR,4    %-2
MIO:GOX  LW,4     MODTBL:
         AI,4     1
         STW,13   MODTBL:,4
         STW,4    MODTBL:
MIO:GCN  EQU      %
         LW,4     MDIO
         BEZ      MIO:G3
MIO:G5   CW,14    IOMD,4       ANY IO ADDRESS IN THE TABLE....
         BE       MIO:G1
         B        MIO:G6       BRANCH TO LOOP.......
MIO:G1   CW,13    MDIO,4
         BE       MIO:G2
MIO:G6   BDR,4    MIO:G5       LOOP TILL ALL IO ADDRESS DONE.....
MIO:G3   LW,4     MDIO
         CI,4     50
         BGE      MIO:G4
         AI,4     1
         STW,13   MDIO,4
         STW,14   IOMD,4
         STW,4    MDIO
MIO:G2   AI,15    1
MIO:G4   LW,4     MIO:GOS
         B        *15               RETURN
MIO:GOS  DATA     0
*
*   TABLES.....
*
MDIO     DATA     0
         RES      50
IOMD     EQU      %-1
         RES      50
MODTBL:  DATA     0
         RES      50
*
*
*   BUILD SORT TABLES SUBROUTINE.
*
*
TABLD    EQU      %
         LCI      0
         STM,0    TABREGS           SAVE REGISTERS
         MTW,0    TAB1ST            IS THIS THE FIRST TIME THRU
         BNE      TABADD            NO- ADD TO CURRENT PAGE
         STW,0    PAGECNT      CLEAR PAGE COUNT.......
         STW,1    TAB1ST            SET RE-ENTRY FLAG
         LB,9     S:SYS        CP-R OR CP-V
         BNEZ     TABCPV0      B: CP-V
         LW,9     VPNLOW       FETCH THE START VPN LOW
         STB,9    VPNL,3       SET FPT
         STB,9    VPNH,3       SET FPT
         STW,9    VPNHIGH      SET THE NEXT PAGE.....
         CAL1,7   CPRPAG       GET PAGE (CP-R STYLE)
         LI,9     CSTAB        GET THE STARTING ADDRESS ....
         B        TABVR
TABCPV0  EQU      %
          CAL1,8     PAG::       GET PAGE
         BCS,8    *TABREGS+15       NO PAGES- ERR RETURN
TABVR    STW,9    TABDEX       INITIALIZE STARTING ADDRESS.
         STW,9    TABPNTR           STR TAB PNTR START ADDRESS
         STW,0    *TABDEX           CLR ENTRY COUNT
         STW,1    PAGECNT      RESET PAGE COUNT
TABADD   LI,8     0                 CLR R IN PREP FOR DIVIDE
         LW,9     TABDEX            FETCH CURRENT STR INDEX
         DW,8     PAGE              (PAGE=512)
         MTW,0    8                 IF ANY REMAINDER,...
         BCS,3    SAMPAGE           USE THE CURRENT PAGE
         LB,9     S:SYS        CP-R OR CP-V
         BNEZ     TABCPV2      B: IF CP-V
         LW,9     VPNHIGH      FETCH THE CURRENT
         AI,9     1
         STB,9    VPNL,3       SET FPT
         STB,9    VPNH,3       SET FPT
         CAL1,7   CPRPAG       GET PAGE (CP-R)
         B        TABVR:0
TABCPV2  EQU      %
          CAL1,8    PAG::        OTHERWISE GET NEW PAGE
         BCS,8    *TABREGS+15       NO PAGES- ERR RETURN
TABVR:0  MTW,1    PAGECNT      INCREMENT PAGE COUNT...
SAMPAGE  MTW,1    TABDEX            POINT TO 1ST LOC OF THIS ENTRY
         STW,0    *TABDEX,2
         STW,0    *TABDEX           CLR 1ST LOC OF THIS ENTRY
         STW,0    *TABDEX,1         CLR 2ND LOC
         LB,8     BUFFER            FETCH TYPE CODE
         STB,8    *TABDEX           STORE IN ENTRY
         LB,4     S:SYS        CP:R
         BEZ      SAMPALO      B: YES........
         LI,4     10
         LW,13    *EL:DCB,4
         LW,13    *13,2
         LB,13    13
         STB,13   *TABDEX,1
SAMPALO  EQU      %
         CI,8     X'11'        IF TYPE CODE IS:
         BCR,3    STORMOD      11,12,13,15,36-39
         CI,8     X'12'             51 OR 52- STR MODEL#
         BCR,3    STORMOD
         CI,8     X'13'
         BE       STORMOD
         CI,8     X'15'
         BE       STORMOD
         CI,8     X'36'
         BE       STORMOD
         CI,8     X'37'
         BE       STORMOD
         CI,8     X'38'
         BE       STORMOD
         CI,8     X'39'
         BE       STORMOD
         CI,8     X'51'
         BE       STORMOD
         CI,8     X'52'
         BE       STORMOD
         B        STRIO
*
STORMOD  LH,12    BUFFER,1          GET MODEL# FROM BUFFER
         AND,12   XFFFF
         STH,12   *TABDEX,3         STORE IN THE MINI TABLE
         LH,12    BUFFER+2,1   GET I/O ADDRESS
         AND,12   XFFFF
         STH,12   *TABDEX,1         STORE IN 1ST WRD OF ENTRY
         B        KEYIN             NOW STORE KEYS
*
STRIO    CI,8     X'16'             IF TYPE CODE = 16 OR 34,
         BE       %+3               STORE ONLY I/O ADDRESS
         CI,8     X'34'
         BNE      KEYIN             OTHERWISE, STORE KEYS
*
         LH,12    BUFFER,1          GET I/O ADDRESS
         STH,12   *TABDEX,1
*
KEYIN    MTW,2    TABDEX            POINT TO KEY WRD AREA
         LB,4     S:SYS             IS THIS CPV
         BNEZ     %+3               IF SO BRANCH
         LW,13    PSSF              OTHERWISE, GET CPR KEY
         B        TABEXIT           GO STORE ENTRY &THEN EXIT
*
         LI,4     10
         LW,13    *EL:DCB,4         GET KEY ADDRESS
         AND,13   X1FFFF            MASK FOR ADDRESS ONLY
         LW,12    *13               R12= KEY WORD 1
         LW,13    *13,1             R13= KEY WORD 2
         STW,12   *TABDEX           STR KEY1
TABEXIT  MTW,1    TABDEX
         STW,13   *TABDEX           STR KEY2
         MTW,1    *TABPNTR          INCREMENT ENTRY COUNT
         MTW,1    TABREGS+15        INCREMENT RETURN
TABXT    B        *TABREGS+15  RETURN
*
TABPNTR  PZE                        TABLE STARTING ADDRESS
TAB1ST   PZE                        FIRST TIME FLAG
PAGE     PZE      512               DIVISOR FOR PAGE MATH
TABDEX   PZE                        STORING INDEX
TABREGS  RES      16                TEMP REG STORAGE
PAGECNT  DATA     0
PAG::     DATA     X'8000001'
CPRPAG   GEN,8,1,7,16  X'57',1,0,5
         DATA     X'86000000',TABN
VPNL     DATA     0
VPNH     DATA     0
*
TABN     BAL,15   ABN:PRN
         B        TABXT
*
VPNLOW   DATA     0
VPNHIGH  DATA     0
*
*
* TYPE CHECK.
*
RD:10    LW,15     SUM:F     SUM MODULE PRESENCE FLAG SET.
         BEZ       RD:10A    B: NO.
         LB,15     BUFFER      FETCH TYPE
         CI,15     X'18'
         BE        RD:EX      BRANCH IF SYSTEM START UP RECORD.
RD:10A   LW,15     TYPEF     ANY TYPE DELIMITER.
         BEZ      RD:12        B: NONE.
         LB,15    BUFFER       FETCH TYPE
         LW,4     TYPEF        FETCH COUNU.
RD:A10   CW,15    TYPEF,4
         BE       RD:12        B: EQUAL TO
         BDR,4    RD:A10       LOOP
         LW,4     TYPEF        CHECK FOR UNKNOWN TYPE ASKED FOR..
R:1      LW,13    TYPEF,4
         CI,13    X'FF'        B: IF EQUAL.....
         BE       R:2
         BDR,4    R:1          LOOP.......
         B        RD:01        NONE ASKED FOR....
R:2      LI,4     41                IS THE BUFFER TYPE AN UNKNOWN.
         CB,15    CDE,4
         BE       RD:01        B: IF NO.....
         BDR,4    %-2          LOOP
         B        RD:12        YES... AN  UNKNOWN....CONTINUE
*
*  CHECK FOR ANY DEVICE ORIENTED
*
RD:11    LI,4     12
RD:A11   CB,15    DVTY,4
         BE       RD:B11       B: EQUAL
         BDR,4    RD:A11
         LW,4     SECFL        CHK: FOR PARITY 2NDARIES IF PRIMED.
         BCR,1    RD:B11+1     BRANCH CONDITION RESET.......
         LI,4     3
         LB,15    BUFFER       FETCH TYPE CODE.....
RD:C11   CB,15    SEC4X,4
         BE       RD:EX        PRINT IF 42-44
         BDR,4    RD:C11
         STW,0    SECFL        RESET SECFL.....
         B        RD:B11+1
SEC4X    BS       0,X'42',X'43',X'44'
*
*
*
RD:B11   AI,13    1
         B        *13
*
*  MODEL AND DEVICE  CHECK.
*  ONLY ALLOWED FOR DEVICE ORIENTED TYPES.
*
RD:12    LW,15    MODF         ANY MODELS
         BEZ      RD:13        B: ZERO
         LB,15    BUFFER       FETCH TYPE
         BAL,13   RD:11        CHECK DEVICE ORIENTED TYPE
         B        RD:01        NONE.
         CI,4     2            IS ANY OF THE CHECKS THE LAST TWO
         BE       RD:01        CHK: FOR PRINTING OF TYPE 16
         BG       %+6          B: IF GREATER....
         LI,4     -32
RD:B12   LH,15    SECLIST+16,4
         CH,15    BUFFER,1
         BE       RD:EX        B: IF EQUAL TO...
         BIR,4    RD:B12
         LW,4     MODF         FETCH COUNTER.
         LW,15    BUFFER       FETCH MODEL
         AND,15   XFFFF
RD:A12   CW,15    MODF,4       FETCH
         BE       RD:13        B: EQUAL
         BDR,4    RD:A12       LOOP
         B        RD:01        NONE HERE.
*
*
*
RD:13    LW,15    DEVF         ANY DEVICE CHECKS.
         BEZ      RD:14        B: ZERO.
         LB,15    BUFFER
         BAL,13   RD:11
         B        RD:01        NONE.
         LW,4     DEVF         COUNTER.
         CI,15    X'16'        IS IT DEVICE SECONDARY.
         BNE      RD:A13       B: NOT EAL
         LW,15    BUFFER
         B        RD:B13
RD:A13   LW,15    BUFFER+2
RD:B13   AND,15   XFFFF
RD:C13   CW,15    DEVF,4
         BE       RD:14        B: EQUAL TO
         BDR,4    RD:C13
         B        RD:01
*
*
*
RD:EX    LI,15    1
         LCI      15
         LM,0     E:SAVE
         B        *E:SAVE+15
*
*
*
RD:FIN   LW,15    SECHFLG      CHECK SEARCH SORT FLAG.
         BNEZ     RD:FB1       B: NOT ZERO
         CAL1,1   CLOSEL       CLOSE M:BI DCB
         LW,15    PSSF         ANY RECORDS.
         BNEZ     RD:FB        B: NOT EQUAL ZERO
         LI,14    18
         BAL,15   L:PRINT
         DATA     MSGRF
RD:FB    LW,15    SLIS:F            SORT IN.
         BEZ      RD:FB1
         MTW,0    TAB1ST       CHECK SORT TABLE INDICATOR.....
         BNEZ     %+2          IF SOMETHINGIN THE SORT TABLE FINE..
         STW,1    BRK:CHK      IF NOT .. SET TERMINATION INDICATOR...
         LW,15    S:FLAG
 BNEZ RD:FB1
 LI,4 MODTBL: FETCH ADDRESS OF MODEL IO TABLE.
 LW,5 MODTBL: FETCH COUNT/.
 BAL,6 SETSTR: SET STRAIGHT.....STARINGHTEN TABLES..
 LI,5 1 SET REG 5
 LI,4 1
STS:B1 CW,4 MODTBL: CW,COUNT TO TABLE.
 BG STS:B6 B: GREATER THAN
 LW,13 MODTBL:,4 START TO SORT IN ASCENDING ORDER
STS:B2 CW,5 MDIO
 BG STS:B5 BRANCH GREATER
 LW,6 5 STORE TO 6 CONTENTS OF 5
 LW,14 MDIO,5 MODEL NO
 LW,15 IOMD,5 I ADDRESS.
STS:B3 CW,13 MDIO,6 EQUAL OR NOT
 BE STS:B4 B: EQUAL
 AI,6 1 BUMP 6
 CW,6 MDIO GREATER
 BLE STS:B3 B: LESS EQUAL
 B STS:B5
STS:B4 XW,14 MDIO,6
 XW,15 IOMD,6 XCHANGE MODEL AND IO WITH MEMORY
 STW,14 MDIO,5 STORE TO OTHER HIGHER TABLE.
 STW,15 IOMD,5
         AI,5     1            BUMP 5 ONE
         STW,5    CK           SAVE 5
 B STS:B2
STS:B5 AI,4 1 BUMP 4
 LW,5 CK FETCH CK
 B STS:B1
STS:B6 EQU %
         LI,7     1            INITIALIZE
STS:B9   CW,7     MDIO         LESS OR GREATER.
         BG       STS:B10
         LW,5     7            ADJUST
         AI,5     -1           LESS ONE
         STW,5    STP
         LW,6     MDIO,7       FETCH BEGINNING MODEL.
         LI,5     0            ZERO5
STS:B7   CW,6     MDIO,7       MATCH.
         BNE      STS:B8       B: NO MATCH
         AI,5     1            MATCH..
         AI,7     1
         CW,7     MDIO         GREATER THAN
         BLE      STS:B7       LOOP
STS:B8   CI,5     2            LESS THAN 2
         BL       STS:B9
         LI,4     IOMD         FETCH ADDRESS OF IO
         AW,4     STP
         BAL,6    SETSTR:      SORT INTO ASCENDING
         B        STS:B9       LOOP
STS:B10  EQU      %
RD:FB2 STW,1 S:FLAG SET SORT FLAG.
RD:FB1 LI,15 0 SET EOD FLAG.
 B RD:EX+1
CK DATA 0
DONE DATA 0
STP DATA 0
*
MSGRF    TEXTS    'NOTHING IN ERRFILE'
*
RD:ERRX  LI,14    46
         BAL,15   E:PRINT
         DATA     %+2
         B        RD:04        ASSUME JD:R OR YR:R SAME AS PREVIOUS
   TEXT   'ERROR IN KEY FORMAT(YEAR/DATE NOT IN PACK DECIMAL)'
*
         PAGE
*
*
*  READFIL WILL READ A RECORD FROM THE ERRFILE
*
* IF CP-R THE KEY WILL BE IN A FORM OF SEQUENCE NUMBER.
*  IF CP-V THE KEY WILL BE THE ACTUAL KEY FOR THE RECORD.
*
*  UPON ENTRY: REGISTER 13 = KEY1  , 14 = KEY2  (CP-V)
*                        13 = 0     , 14 = SEQUENCE NUMBER (CP-R)
*
*CALL:
*        BAL,15   READFIL
*
*UPON RETURN. RECORD WILL BE IN BUFFER.
*
*        R15 = 1  GOOD RETURN........
*        R15 = 0   BAD RETURN. EOF OR AND ERROR.
*
* THIS SUBROUTINE USES READ:ERF AS THE LEGS FOR THE READ.
*
* SECHFLG MUST BE 1 UPON GOING IN.
*
READFIL  LCI      0            SAVE ALL EGISTER.
         STM,0    E:SAVE
         STW,1    SECHFLG      SET SECHFLG
         LB,7     S:SYS        B: IF CP-V
         BNEZ     RDE:1
*
*
*  CP-R SECTION.... SEQUENTIAL READ ........
*
*
         B        CP:R:BR
*
*
*  CP-V SECTION ... SET UP KEYS, BRANCH TO KEYED READ...
*
*
RDE:1    STW,13   KEYLOC
         STW,14   KEYLOC+1     SET UP KEYS
         STB,12   KEYLOC+2
         B        RD:02
*
*
SECHFLG  DATA     0
*
*
*
*  SET UP THE CP:R READ BY THE SEQUENCE NUMBER.....
*  UPON ENTRANCE   REGISTER 14 HAS THE SEQENCE NUMBER...
*
*   FLAG:PR =0 IF A REWIND IS NEEDED.
*    FLAG:PR =1 IF ANOTHER READ WITHOUT REWIND
*
CP:R:BR  EQU      %
         LW,7     FLAG:PR      FETCH FLAG
         BNEZ     CPRRF1       B: NO REWIND.
         CAL1,1   REW          REWIND EL:DCB FILE.
         STW,1    FLAG:PR      SET FLAG
         STW,0    REC#         SET UP RECORD NUMBER
CPRRF1   LW,13    14           SAVE SEQUENCE NUMBER
         SW,14    REC#         SUBTRACT.
         STW,13   REC#         SUBSTITUTE NEW REC #
         AI,14    -1           ADJUST BY ONE.
         CI,14    0            IS SKIPS TO BE DONE NEGATIVE??
         BGEZ     CPRFWD       B: SKIPS ARE POSITIVE.
         LCW,14   14           FETCH THE ABSOULUTE.
         LI,7     X'10'
         STB,7    SKIPFPT+1,3  SET THE SKIP BACKWARD BIT.
         B        CPRFWD+1
CPRFWD   STB,0    SKIPFPT+1,3  SET THE FWD SKIP BIT
         CI,14    0            SKIP ZERO
         BE       CPRRF2       B: IS YES.
         STW,14   SKIPREW      STORE THE AMOUNT TO BE SKIPPED
         CAL1,1   SKIPFPT      SKIP..
CPRRF2   B        RD:01        BRACH TO READ.....
*
*
*
REC#     DATA     0
FLAG:PR  DATA     0
SKIPFPT  GEN,8,1,3,20  X'9D',0,0,EL:DCB
         GEN,1,1,6,1,1,16,1,1,1,3 1,1,0,0,0,0,0,0,0,0
SKIPREW  DATA     0
         DATA     R:ERFAAD
*
*
*
R:ERFEAD EQU      %
         LW,14    SECHFLG      CHECK SEARCH SORTED FLAG.
         BNEZ     RD:FIN
       LB,14    10
         CI,14    X'43'
         BE       RD:01        KEY NO FOUND. READ AGAIN.
         BAL,15   ERR:PRN           PRINT ERROR MSG
         B        RD:FIN
*
R:ERFAAD EQU      %
         LB,14    10                FETCH ERROR CODE
         CI,14    5                 CK EOD
         BE       RD:FIN
         CI,14    6                 CK EOF
         BE       RD:FIN
*
         BAL,15   ABN:PRN           PRINT ABNORMAL ERROR MSG
R:ERRC   B        RD:FIN
*
*
*  SUBROUTINE TO SORT A TABLE INTO ASCEDNIGN ORDER.
*  UPON ENTRY REG 4= ADDRESS. START ADDRESS OF TALBE. (ADDRESS-1)
*              REG 5= NUMBER OF WORDS IN TABLE
*
*    BAL,6  SETSTR:
*
*
*
SETSTR:  LCI      3            SAVE REISTER 4,5,6
 STM,4 ADDRESS
 LI,4 1
 LI,5 1
 LW,6 :NO: FETCH NUMBER OF WORDS.
 CI,6 1
 BLE STS:0
STS:4 LW,6 *ADDRESS,4
STS:3 CW,4 :NO:
 BG STS:1
 CW,6 *ADDRESS,4
 BL STS:2
 XW,6 *ADDRESS,4
STS:2 AI,4 1
 B STS:3
STS:1 STW,6 *ADDRESS,5
 AI,5 1
 CW,5 :NO:
 BG STS:0
 LW,4 5
 B STS:4
STS:0 LCI 3
 LM,4 ADDRESS
 B *6
ADDRESS DATA 0
:NO: DATA 0,0
*
*
*
*
*
*
REW      GEN,8,1,23  X'81',1,EL:DCB
         GEN,24,8 0,X'10'
REW:FLAG DATA     0
BUFFER   RES      256
E:SAVE   RES      16
FPT:RDE  GEN,8,24 X'90',EL:DCB
         DATA     X'F0000010',R:ERFEAD,R:ERFAAD,BUFFER,1024
         DATA     KEYLOC
         BOUND    8
KEYLOC   DATA     0,0,0
PSSF     DATA     0
YR:R     DATA     0
JD:R     DATA     0
TM:R     DATA     0
X1FFFF   DATA     X'1FFFF'
X0700    DATA     X'700'
DVTY     DATA     X'00163411'
         DATA     X'12131536'
         DATA     X'37383951'
         DATA      X'52000000'
CLOSEL   GEN,1,7,7,17  1,X'15',0,EL:DCB
         DATA     0
BIOPEN   GEN,8,24 X'94',EL:DCB
         GEN,8,24 X'E7',9
         DATA     R:ERFEAD,BIOPAR,BUFFER,2,2,1
         BS       1,0,2,2
         TEXTC    'ERRFILE'
         BS       2,1,2,2
         TEXT     ':SYS'
         TEXT     '    '
*
*
*
BIOPAR   LB,14    10
         CI,14    X'14'
         BNE      WRI:ABN      B: NOT EQAL
         LB,14    10,1
         CI,14    1            IS IT CODE 14 SUBCODE 1
         BNE      WRI:ABN
         LI,14    30
         BAL,15   E:PRINT
         DATA     BIOARM
         B        ASIGN
BIOARM   TEXT     'ERRFILE IS BUSY,WILL TRY AGAIN'
*
         SPACE    10
         PAGE
*
*
         PAGE
*
*        DISPLAY BOUNDARIES ROUTINE.
*
*        THE DISPLAY BOUNDARY ROUTINE IS SET UP AS A SUB-
*        ROUTINE  TO PERMIT ENTRY BOTH AS A COMMAND AND AS
*        A VIADUCT BY CALLING PROGRAMS (ROMS).
*        IF THE ENTRY IS THRU LABEL DSP: (BAL,15 DSP:),THEN
*        THE OUTPUT WILL BE VIA THE LD DEVICE. (M:LO)
*        IF THE ENTRY IS THRU LABEL DSPL:0 (BAL,15 DSPL:0),
*        THEN THE OUTPUT WILL BE VIA THE MD DEVICE. (M:LO AND
*        M:OC).
*
*
DSP:     STW,4    DS:SAVE      SAVE REG. 4 LD OUTPUT ENTRY.
         LW,4     L:PS         SET UP LINE PRINTER DEVICE.
         B        DSP::1
DSPL:0   STW,4    DS:SAVE      SAVE REG. 4 SET UP OC OUPUT
         LW,4     E:PS
DSP::1   STW,4    1:D          SET UP OUTPUT BRANHCES.
         STW,4    2:D
         STW,4    3:D
         STW,4    4:D
         LCI      2
         STM,5    DS:SAVE+1    SAVE REGISTERS. 5,6 (+1,+2)
         LCI      4
         STM,12   DS:SAVE+3    SAVE REG. 12-15 (+3,+4,+5,+6)
*
*
*    RSESORT THE PARAMETERS.
*
*
         LW,5     MODF
         CI,5     1            B: LEES EQ TO 1
         BLE      %+3
         LI,4     MODF
         BAL,6    SETSTR:
         LW,5     DEVF
         CI,5     1
         BLE      %+3
         LI,4     DEVF
         BAL,6    SETSTR:
         LW,5     TYPEF
         CI,5     1
         BLE      %+3
         LI,4     TYPEF
         BAL,6    SETSTR:
*
*        TYPE OUTPUT.
*
         LW,5     TYPEF        DETERMINE TYPE OUTPUT.
         BEZ      DS:1         BRANCH IF NO.
         LI,6     7            SET UP INDEX.
         BAL,15   FILL:1       FILL X40 IN TO MESSAGE BEFORE OUTPUT
         DATA     T:MSG+1
         LB,4     T:NO,5       FETCH INDEX BYTE CONTROL.
2:DSO    LW,14    TYPEF,5      FETCH VALUE.
         BAL,15   HEXEBC       CONVERT
         LI,6     -2           SET UP INDEX OF 2 VALUES/ENTRY
1:DSO    STB,15   T:MSG,4      STORE BYTE INTO MESSAGE.
         SLS,15   -8           SHIFT NEXT BYTE IN.
         AI,4     -1           DECREMENT
         BIR,6    1:DSO        LOOP FOR NEXT BYTE.
         AI,4     -1           DEC.
         AI,5     -1           DEC.
         BNEZ     2:DSO        BRANCH TILL DONE.
         LW,14    TYPEF        SET UP BYTE COUNT.
         SLS,14   1            MULTIFPY BY TWO
         AW,14    TYPEF
         AI,14    6
1:D      BAL,15   L:PRINT      PRINT TYPE PARAMETERS
         DATA     T:MSG
*
*        DEVICE OUTPUT
*
DS:1     EQU      %
         LW,5     DEVF         DETERMINE IF OUTPUT
         BEZ      DS:2         BRANCH IF NO.
         LI,6     12           SET UP INDEX
         BAL,15   FILL:1       FILL X40 INTO MESSAGE
         DATA     D:MSG+1
         LB,4     MD:NO,5      FETCH INDEX BYTE CONTROL
4:DSO    LW,14    DEVF,5       FETCH VALUE.
         BAL,15   HEXEBC       CONVERT
         LI,6     -4           SET UP INDEX OF PARAMETER / ENTRY
3:DSO    STB,15   D:MSG,4
         SLS,15   -8           SHIFT FOR NEXT BYTE
         AI,4     -1           DEC.
         BIR,6    3:DSO        LOOP TILL ALL BYTES IN.
         AI,4     -1           DEC.
         AI,5     -1           DEC.
         BNEZ     4:DSO        BRANCH TILL ALL DONE.
         LW,14    DEVF         SET UP BYTE COUNT.
         SLS,14   2            MULTIPLY BY 4
         AW,14    DEVF
         AI,14    6
2:D      BAL,15   L:PRINT
         DATA     D:MSG
*
*        MODEL OUTPUT
*
DS:2     EQU      %
         LW,5     MODF         DETERMINE IF OUTPUT
         BEZ      DS:3         BRANCH IF NO.
         LI,6     12           SET UP INDEX FOR BLANKS FILL
         BAL,15   FILL:1
         DATA     M:MSG+1
         LB,4     MD:NO,5      FETCH INDEX BYTE CONTROL.
6:DSO    LW,14    MODF,5       PREPARE OUTPUT MODEL VALUES.
         BAL,15    MOD:EBC       FETCH MODEL OUTPUT
         LI,6     -4
7:DSO    STB,15   M:MSG,4      STORE TO MSG
         SLS,15   -8           SHIFT NEXT BYTE
         AI,4     -1           DEC.
         BIR,6    7:DSO        BRANCH TILL ALL BYTE IN.
         AI,4     -1           DEC
         AI,5     -1           DEC
         BNEZ     6:DSO        BRANCH WHEN NOT DONE.
         LW,14    MODF         PREPARE BYTE COUNT.
         SLS,14   2            MULTIPLY BY 4
         AW,14    MODF
         AI,14    6
3:D      BAL,15   L:PRINT      PRINT MODEL.
         DATA     M:MSG
*
*        DATE AND TIME OUTPUT.
*
DS:3     EQU      %
         LW,14    T1:MSG       OUTPUT DATE-TIME 'FROM-TO'
         LI,4     0            SET UP HALFWORD INDEX.
         BAL,15   DS:OUT       PRINT.
         LW,14    T2:MSG
         LI,4     1
         BAL,15   DS:OUT
         LCI      3            RESTORE REGISTERS 4-6,12-15
         LM,4     DS:SAVE
         LCI      4
         LM,12    DS:SAVE+3
         B        *15          RETURN.
DS:SAVE  RES      7
*
*
*
         PAGE
*
*
*        SUBROUTINE TO OUTPUT DATE AND TIME FOR THE FILL:1
*        THIS ROUTINE IS GEARED TO THE DISPLAY SECTION.
*
*
DS:OUT   EQU      %
         STW,15   DS:UTS       SAVE REGISTER 15
         STW,14   T3:MSG       DEPOSIT HEADER.
         LW,14    DATE:1,4     FETCH CORRECT DATE.
         BAL,15   JD:MD        CONVERT TO MONTHS -DAYS.
         STW,15   MSG2A        SAVE IN TEMPORARY.
         LI,13    9
         BAL,15   HEXTWO       CONVERT AND STORE.
         DATA     T3:MSG
         LW,14    MSG2A        FETCH FROM TEMPORARY.(DAYS)
         LI,13    6
         BAL,15   HEXTWO       CONVERT AND STORE.
         DATA     T3:MSG
         LI,13    12
         LW,14    YEAR:1,4
         BAL,15   HEXTWO       CONVERT AND STORE YEARS.
         DATA     T3:MSG
         LW,14    TIME:1,4     FETCH TIME:1,4
         BAL,15   MS:HMSN      CONVERT TO HR,MIN,SEC,MS.
         LCI      4
         STM,12   MSG2         SAVE THE VALUES IN TEMPORARY.
         LI,13    16
         LW,14    MSG2
         BAL,15   HEXTWO       C/S HRS.
         DATA     T3:MSG
         LI,13    19
         LW,14    MSG2A
         BAL,15   HEXTWO       C/S MINS.
         DATA     T3:MSG
         LI,13    22
         LW,14    MSG2B
         BAL,15   HEXTWO       C/S SECS.
         DATA     T3:MSG
         LW,14    MSG3
         BAL,15   HEXDEC:      CONVERT MS.
         LW,14    15
         BAL,15   HEXEBC
         LI,14    X'7A'
         STB,14   15
         STW,15   T3:MSG+6     STORE MILLISEC.
         LI,14    28
4:D      BAL,15   L:PRINT      PRINT THE DATE-TIME.
         DATA     T3:MSG
         B        *DS:UTS      RETURN.
DS:UTS   DATA     0
*
*
*
         PAGE
*
*        DATA AREA FOR THE DISPLAY ROUTINE
T:MSG    TEXTS    'TYPE =XX XX XX XX XX    '
D:MSG    TEXTS    'DEV  =XXXX XXXX XXXX XXXX XXXX  '
M:MSG    TEXTS    'MODL =XXXX XXXX XXXX XXXX XXXX  '
T1:MSG   TEXTS    'FROM'
T2:MSG   TEXTS    'TO  '
T3:MSG   TEXTS    '      MM/DD/YY  HH:MM:SS:NNN'
L:PS     BAL,15   L:PRINT
E:PS     BAL,15   E:PRINT
T:NO     BS       0,7,10,13,16,19
MD:NO    BS       0,9,14,19,24,29
*
*
*
         PAGE
*
*
*        ROUTINE TO FILL IN BLANKS.
*        ONLY DESIGNED FOR THE DISPLAY ROUTINE.
*        ON ENTRANCE ,REGISTER 6 HAS START OF WHICH HALFWORD (0,1)
*        ALL REGISTER CONSIDERED SAFE XCEPT 6,15
*
*        LI,6     NUMBER OF HALFWORDS WANTED TO BLANK.
*        BAL,15   FILL:0 OR BAL,15 FILL:1.
*        DATA     ADDRESS OF STARTING LOCATION.
*
*        FILL:0   START AT HALFWORD 0
*        FILL:1   START AT HALFWORD +1
*
*
FILL:0   EQU      %
         STW,4    F:SAV        SAVE REGI 4
         LI,4     0            SET 4
         B        FIL:
FILL:1   EQU      %
         STW,4    F:SAV        SAVE REGI 4
         LI,4     1            SET 4
         STW,15   F:SAV+3      SAVE REGISTER 15
         LW,15    *15          FETCH THE ADDRESS OF THE ADDRESS.
FIL:     LCI      2            SAVE REGISTERS 5,6
         STM,5    F:SAV+1
         LW,5     X40X         SET UP BLANKS.
FIL:1    STH,5    *15,4        FILL.
         AI,4     1
         CW,4     6            BRANCH WHEN DONE.
         BLE      FIL:1
         LCI      3
         LM,4     F:SAV        RESTORE REGISTER 4,5,6
         MTW,1    F:SAV+3      INCREMENT RETURN ADDRESS.
         B        *F:SAV+3     RETURN.
F:SAV    RES      4
*
*
*        PAGE
         PAGE
***
* HEX TO EBCDIC CONVERSION
***
*
* CALL SEQUENCES:
* LW,14   HEXWORD
* BAL,15  HEXEBC
* RESULT IN REGISTERS 14,15
*
HEXEBC   EQU      %
         LCI      4
         STM,12   HE:SAVE           SAVE (R12,13,14,15)
         STW,4    HE:SAVE+4         SAVE (X4)
         STW,14   12         TRANSFER HEX WORD TO 12
         LI,4     7                 (X4)=7, FOR R14 AND 15
LHEXEBC  EQU      %
         LI,13    X'F0'
         SLD,12   -4                SHIFT IN LO-ORDER 4 BITS TO RIGHT
         SCS,13   4                 SHIFT CIRCLE 4BITS TO LEFT
         CB,13    XF9X       CHECK FOR 0-9
         BLE      %+2               N0. 0-9
         AI,13    -X'39'            ADJUST FOR A-F
         STB,13   14,4              STORE BYTE FROM BYTE3 OF REG.15
         AI,4     -1                DECREMENT STORE BYTE POSITION BY 1
         CI,4     0                 CLEAR (X4)
         BGEZ     LHEXEBC           LOOP UNTIL 8 BYTES ARE ALL STORED
         LCI      2                 SET CONDITION CODE=4
         LM,12    HE:SAVE           RESTORE (R12,13,14)
         LW,4     HE:SAVE+4         RESTORE (X4)
         B        *HE:SAVE+3        BRANCH TO MAIN PROG.
XF9X     DATA     X'F9000000'
HE:SAVE  DATA     0,0,0,0,0
         PAGE
***
* EBCDIC TO HEXWORD CONVERSION
***
*
* CALL SEQUENCES:
* LD,13   EBCWORDS
* BAL,15  EBCHEX8
* ERROR RETURN
* GOOD  RETURN
* RESULT IN R15
*
EBCHEX8  EQU      %
         STW,4    HC:SAVE+4         SAVE (X4)
         LCI      4
         STM,12   HC:SAVE           SAVE (R12,13,14,15)
         LI,4     0                 INDEX REG.4=0
         STW,13   12
         STW,14   13
LEBCHEX8 LB,15    12,4              LOAD BYTE FROM BYTE0 OF REG. 12
         CB,15    XFOX              CK FOR 0-9
         BGE      TAG               0 AND UP
         CB,15    XC6X
         BG       ERRCHAR           ERROR CHARACTER PRINT
         CB,15    XC1X
         BL       ERRCHAR           ERROR CHARACTER
         AI,15    9                 ADJUST FOR A THRU F
TAG      EQU      %
         SCS,15   -4                SHIFT 4 BITS TO RIGHT,CIRCLE
         SLD,14   4                 SHIFT DOUBLE 4 BITS TO LEFT
         AI,4     1                 INCREMENT REG.4 BY 1
         CI,4     8                 CK CONTENTS OF INDEX REG. 4
         BL       LEBCHEX8          LESS THAN 8, LOOP UNTIL 8 DIGITS
         SLD,14   -32               SHIFT 32 BITS TO RIGHT, R14 TO R15
         MTW,1    HC:SAVE+3  INCREMENT RETRUN ADDRESS.
ERRCHAR  LCI      3          SET CONDITION CODES
         LM,12    HC:SAVE           RESTORE (R12,13,14)
         LW,4     HC:SAVE+4         RESTORE X4
         B        *HC:SAVE+3 RETURN.
*
HC:SAVE  DATA     0,0,0,0,0
XFOX     DATA     X'F0000000'
XC6X     DATA     X'C6000000'
XC1X     DATA     X'C1000000'
*
         PAGE
***
* JULIAN DAY TO MONTH AND DAY CONVERSION
***
*
* CALL SEQUENCES:
* LW,14   JULIANDAY
* BAL,15  JD:MD
* RESULT IN REGISTERS 15=MONTH AND REGISTER 14=DAY
*
JD:MD    EQU      %
         STW,4    J:SAVE+2          SAVE (X4)
         LCI      2
         STM,14   J:SAVE            SAVE (R14 AND R15)
         LI,15    1
         CI,14    0
         BE       FIXMD2            JULIAN DAY =0
         LI,4     -12               INITIALIZE X4=-12
LJD:MD   LW,14    J:SAVE     FETCH JUL. DAY
         SW,14    MONTHTBL+12,4    SUBTRACT EACH MONTH.
         BLEZ     FIXMD      BRANCH LESS OR EQUAL
         STW,14   J:SAVE     SAVE REMAINDER OF OPERATION.
         AI,15    1                 ADD 1 TO MONTH COUNT
         BIR,4    LJD:MD            INCREMENT X4 AND BRANCH TO LJD:MD
FIXMD    EQU      %
         LW,14    J:SAVE     FETCH LAST REMAINDER = DAYS.
         LW,4     J:SAVE+2          RESTORE (X4)
         B        *J:SAVE+1         RETURN TO MAIN PROG.
FIXMD2   LI,15    0                 JULIAN DAY=0
         B        FIXMD
*
*
J:SAVE   DATA     0,0,0
MONTHTBL DATA     31,28,31,30,31,30,31,31
         DATA     30,31,30,31
         PAGE
***
* MONTH AND DAY TO JULIAN DAY CONVERSION
***
*
* CALL SEQUENCES:
* LW,13   MONTH
* LW,14   DAY
* BAL,15  MD:JD
* RESULTS  IN REGISTER 15
*
* IF DAYS OR MONTHS  = 0 THEN RESULTS WILL BE ZERO.
*
MD:JD    EQU      %
         LCI      3
         STM,13   M:SAVE            SAVE (R13,14,15)
         STW,4    M:SAVE+3          SAVE (X4)
         LI,13    1          SET 13 TO ONE.
         LI,15    0          CLEAR REG 15
         LW,4     M:SAVE     FETCH MONTHS AND SET AS INDEX.
         BLEZ     FIXJD      BRANCH LESS OR EQUAL ZERO
         LW,15    M:SAVE+1   FETCH DAYS.
         BLEZ     FIXJD      BRANCH LESS OR EQUAL ZERO.
LMD:JD   EQU      %
         SW,4     13         SUBTRACT A ONE.
         BLEZ     FIXJD      BRANCH WHEN DONE WITH MONTHS.
         AW,15    MONTHTBL-1,4   ADD DAYS OF EACH MONTHS.
         B        LMD:JD     BRANCH FOR ANOTHER ROUND.
FIXJD    EQU      %
         LCI      2
         LM,13    M:SAVE            RESTORE (R13,14)
         LW,4     M:SAVE+3          RESTORE (X4)
         B        *M:SAVE+2         BRANCH BACK TO MAIN PROG.
M:SAVE DATA 0,0,0,0
         PAGE
***
* MILLISECOND TO HR, MIN, SEC, AND MS CONVERSION
***
*
* CALL SEQUENCES:
* LW,14   MS
* BAL,15  MS:HMSN
*  THE RESULTS WILL BE REGISTER 12 = HOURS
*                               13 = MINUTES
*                               14 = SECONDS
*                               15 = MILLISECS.
*
*
*  IF MILLISECONDS (INPUT) IS GREATER THAN 30:59:59:999, AN
*  ERROR MESSAGE WILL BE PRINTED ON THE E:PRINT AND THE
*  REGISTERS WILL BE AS FOLLOWS.
*                            12 = 0
*                            13 = 0
*                            14 = VOLATILE
*                            15 = 0
*
MS:HMSN  EQU      %
         LCI      2          SAVE REGISTERS 14,15
         STM,14   MS:SAVE
         LI,12    0          CLEAR 12,13 AND MS:TEMP
         LI,13    0
         STW,13   MS:TEMP
         CW,14    MS:MAX     COMPARE TO MAX TIME.
         BG       MS:EXIT    BRANCH IF GREATER.
         STW,14   MS:TEMP    IF NOT, SAVE IN MS:TEMP
MS:HM1   SW,14    MS:6HRS    START AT 6 HOURS SUBTRACT.
         BLZ      MS:H1      BRANCH LESS ZERO
         STW,14   MS:TEMP    SAVE REAMINDER IN MS:TEMP
         AI,12    6          ADD 6 TO HOURS.
         B        MS:HM1     BRANCH TILL DONE WITH 6 HOURS.
MS:H1    LW,14    MS:TEMP    FETCH REMAINDER OF LAST 6 HOURS.
MS:HM2   SW,14    MS:1HR     SUBTRACT 1 HOUR
         BLZ      MS:H2      BRANCH LESS ZERO
         STW,14   MS:TEMP    SAVE IN TEMPORARY
         AI,12    1          ADD HOURS BY ONE.
         B        MS:HM2     BRANCH TILL DONE
MS:H2    LW,14    MS:TEMP    FETCH REMAINDER OF LAST 1 HOURS
MS:HM3   SW,14    MS:1MIN    SUBTRACT 1 MINUTE
         BLZ      MS:H3      BRANCH LESS ZERO
         STW,14   MS:TEMP    SAVE
         AI,13    1          ADD 1 TO MINUTES.
         B        MS:HM3     BRANCH TILL DONE WITH MINUTES.
MS:H3    LI,14    0          CLEAR 14 , START WITH SECONDS.
         LW,15    MS:TEMP    FETCH INTO REGISTER 15
MS:HM4   SW,15    MS:1SEC    SUBTRACT 1 SECOND
         BLZ      MS:H4      BRANCH LESS ZERO
         AI,14    1          ADD 1 TO SECONDS.
         STW,15   MS:TEMP
         B        MS:HM4     BRANCH TILL DONE
MS:H4    LW,15    MS:TEMP
         B        *MS:SAVE+1 RETURN
MS:SAVE  DATA     0,0
MS:TEMP  DATA     0          TEMPORARY STORAGE.
MS:MAX   DATA     99*60*60*1000   MAX TIME = MILLISECONDS.
MS:6HRS  DATA     6*60*60*1000 6 HOURS (MILLISEC.)
MS:1HR   DATA     60*60*1000 1 HOUR (MILLISEC.)
MS:1MIN  DATA     60*1000    1 MINUTE (MILLISEC.)
MS:1SEC  DATA     1000       1 SECOND (MILLISEC.)
*
MS:EXIT  EQU      %
         LI,14    32           BYTE COUNT
         BAL,15   E:PRINT    PRINT IN THE E:PRINT ROUTINE
         DATA     ERRMSGMS
         B        MS:H4      BRANCH TO RETURN
ERRMSGMS TEXT     'ERROR: TIME .GT. 99:59:59:999'
*
*
*
         PAGE
***
* EBCDIC BYTE TO HEX CONVERSION
***
*
* CALL SEQUENCES:
* LB,14   EBCBYTE
* BAL,15  EBCHEX1
* ERROR RETURN
* GOOD  RETURN
* RESULT IN REGISTER 15,BYTE 3
*  REGISTER 14 UPON EXIT HAS CONTENTS SHIFTED RIGHT 8 PLACES.
*
EBCHEX1  EQU      %
         STW,15   E1:SAVE    SAVE REGISTER 15
         AND,14   XFF          MASK OUT.
         CB,14    XC1X       COMPARE BYTE TO EBCDIC 'A'
         BL       EBERROR    BRANCH IF NOT A HEX NUMBER.
         CB,14    XC6X       COMPARE TO EBCDIC 'F'
         BLE      EBC1C6     BRANCH IF WITHIN C1-C6
         CB,14    XFOX       COMPARE TO EBCDIC 0 (ZERO)
         BL       EBERROR    BRANCH IF NOT A NUMBER
         CB,14    XF9X       COMPARE TO EBCDIC 9
         BLE      EBF0F9     BRANCH IF WITHIN 0-9
         B        EBERROR    ERROR BRANCH.
*
EBC1C6   AI,14    9          CONVERT TO HEX BY ADD OF NINE.
EBF0F9   SLD,14   -8         SHIFT LOGICAL DOUBLE RIGHT 8 BITS.
         SLS,15   -24        SHIFT LOGICAL SINGLE RIGHT 24 BITS.
         AND,15   XF         MASK OUT BITS 0-27
         MTW,1    E1:SAVE    INCREMENT RETURN ADDRESS.
EBERROR  B        *E1:SAVE   BRANCH OUT.
E1:SAVE  DATA     0
XFF      DATA     X'FF'
*
XF       DATA     X'F'
*
         PAGE
***
* BINARY TO EBCDIC CONVERSION ROUTINE
***
*
* CALL SEQUENCES:
* LW,14 BINARY(BIT 28 TO 31)
* BAL,15  BINEBC
* RESULT IN REGISTER 15
*
BINEBC   EQU      %
         LCI      3
         STM,13   B:SAVE            SAVE (R13-15)
         LI,13    -4                INITIALIZE COUNT
         LW,15    EBCZEROS          INITIALIZE TO EBC ZEROS
         SLD,14   -1                SHIFT BINARY BIT INTO R15
         SCS,15   -7                SHIFT TO CHARACTER POSITION
         BIR,13   %-2               LOOP FOR 4 BITS
         LCI      2
         LM,13    B:SAVE            RESTORE R13 AND 14
         B        *B:SAVE+2         RETURN TO MAIN PROG.
*
B:SAVE   DATA     0,0,0
EBCZEROS TEXT     '0000'
         PAGE
***
* HOUR AND MIN. TO MILLISECOND CONVERSION
***
*
* CALL SEQUENCES:
* LW,13   HOUR
* LW,14   MINUTE
* BAL,15   HMSN:MS
* BAD RETURN
* GOOD RETURN
*
*  UPON EXIT REGISTER 15 = RESULTS.
HMSN:MS  EQU      %
         LCI      3
         STM,13   HM:SAVE           SAVE (R13-15)
         CI,13    24                CK FOR 24 HOUR
         BGE      BADTM      BRANCH IF GREATER OR EQUAL TO 24 HRS
         CI,14    60
         BGE      BADTM      BRANCH .GE. TO 60 MINUTES.
         MW,13    TOTALMIN   MULTIPLY HOURS BY TOTAL MIN. = 60
         AW,13    14         ADD TO MINUTES.
         MW,13    MS:1MIN    MULTIPLY TO GET TOTAL MILLISECS.
         LW,15    13         TRANSFER TO REGISTER 15
         MTW,1    HM:SAVE+2  INCREMENT RETURN FOR GOOD RETURN.
BADTM    LCI      2          RESTORE REGISTER 13,14
         LM,13    HM:SAVE
         B        *HM:SAVE+2 RETURN
TOTALMIN DATA     60
HM:SAVE  DATA     0,0,0
*
         PAGE
*
*
*
*
*  TEXT COMPRESSION OUTPUT ROUTINE
*        THIS ROUTINE WILL PRINT MESSAGES FROM THE
*        TEXT COMPRESSION INFORMATION BYTE STRING
*        (TCIS)
*
*  CALL MODE:     BAL,15  CT:PRINT
*                 DATA         ADDRESS OF TCIS.
*
*        THE FORMAT USED FOR TCIS BYTE STRINGS IS.
*
*        1ST BYTE=             BIT 0 SET: SKIP AFTER 1ST GR. DONE.
*                                    RESET: NO SKIP
*
*                 BITS 1-4     CONTAINS THE # OF LINES TO BE
*                              SKIPPED AFTER TEXT IS
*                              IS COMPLETED. THIS FIELD VALID
*                              ONLY WHEN LENGHT OF DEVICE IS
*                              72 BYTES LONG. A MAX OF 7 LINES
*                              PERMITTED.
*
*        BITS 5-7   CONTAINS THE # OF TEXT'S (132 BYTES IN LENGHT
*                   EACH LINE TERMINATED BY THE HEX CHARACTERS
*                   X'FF'. A MAX OF 5 LINES PERMITTED.
*
*        THE REST OF THE  BYTES WILL ALTERNATED BETWEEN BEING
*        THE INDEX TO THE TEXT TABLE AND BEING THE NUMBER OF
*        SPACES BETWEEN EACH TEXT TRANSFERED BEGINNING WITH
*        THE INDEX NUMBER.
*
*        ERROR PRINTS WILL OCCUR IF ANY OF THE LIMITS ARE EXCEEDED
*        OR AN ERROR OCCURS IN THE ACTUAL PRINT ROUTINE.
*
*
*
*
*
*        DETERMINING THE OUTPUT MODE MD:DCB WILL BE ASSUMED
*        TO BE ALWAYS A 72 BYTE LENGHT DEVICE.EITHER A
*        USER CONSOLE OR A OPERATOR CONSOLE.
*
*
*
*        DATA AREA.............
*
*
*
CT:SAVE  RES      6            SAVE REGISTER AREA
CT:TCIS  DATA     0            ADDRESS OF TCIS BYTE STRING.
CT:IBC   DATA     0            INTERNAL BYTE COUNT TO TCIS
CT:BCT   DATA     0            BYTE COUNT TO EACH TEXT
CT:BCB   DATA     0            RUNNING BYTE COUNT.
CT#LNS   DATA     0            NUMBER OF LINES TO OUTPUT
CT:SKIP  DATA     0            AMOUNT OF SKIP'S AFTER 1ST GROUP
CT:ADRS  DATA     0            CURRENT OUTE: BUFFER ADDRESS.
CT:BADRS DATA     0            ADDRESS OF CURRENT TEXT TABLE
*
*
*
*        OUTPUT BUFFER AREA
*
*
*
OUTE:1   RES      34
OUTE:2   RES      34
OUTE:3   RES      34
OUTE:4   RES      34
OUTE:5   RES      34
*
*
*
*
*        BYTE COUNT TO EACH OUTPUT  BUFFER
*
*
*
BCNT:1   BS       0,0,0,0,0
*
*
*
*
*        FLAGS............
*
*
*
1:FLAG   DATA     0            SET=72 BYTES,RESET=132 BYTES
2:FLAG   DATA     0            1ST TIME AROUND (FOR 72 BYTES FLAG)
3:FLAG   DATA     0            SKIP AT THE END OR NOT FLAG.
*
*
*
*
*        OPEN MD:DCB FOR CORRES CAL.
*
*
*
C:OPENM  GEN,1,7,7,17  1,X'14',0,MD:DCB
         DATA     X'C0000000',WRI:ERR,WRI:ABN
*
*
*
*
*
*
*        START OF PROUTINE.
*
*
*
CT:PRINT EQU      %
         LCI      4            SAVE REGISTER 5-8,14-15
         STM,5    CT:SAVE
         STW,14   CT:SAVE+4
         LW,14    *15          FETCH TCIS ADDRESS
         STW,14   CT:TCIS      SAVE TCIS ADRS.
         AI,15    1            INCREMENT RETURN ADDRESS+1
         STW,15   CT:SAVE+5    RETURN ADDRESS IN CT:SAVE+5
*
*        HOUSE KEEPING CHORES.
*
         LW,14    X40X         INITIALIZE THE OUTPUT BUFFERS
         LI,7     -165         WITH BLANKS. 165 WORDS.
         STW,14   OUTE:1+165,7
         BIR,7    %-1
         LI,0     0            SET ZERO TO ZERO
         LI,1     1
         LI,2     2
         LI,3     3            RESET 1,2,3 TO 1,2,3
         STW,0    CT:IBC       RESET ALL PERTINENT LOCATIONS.
         STW,0    CT:BCT
         STW,0    CT:BCB
         STW,0    1:FLAG
         STW,0    2:FLAG
         STW,0    3:FLAG
*
*        DETERMINE WHETHER OUTPUT (LO) DEVICE IS 72 BYTES
*        LONG OR 132 BYTES LONG DEVICE.
*
*        ASSUMPTION AT THIS POINT IS THAT MD:DCB IS EITHER
*        THE USER'S CONSOLE OR THE OPERATOR'S CONSOLE.
*
*
         LW,14    *LD:DCB      FETCH 1ST WORD OF LD:DCB(M:LO)
         AND,14   X200         MASK IN BIT 10
         BNEZ     CT:H         BRANCH IF ALREADY OPENED.
         CAL1,1   E:OPENL      OPEN LD:DCB
CT:H     LW,14    *MD:DCB      FETCH 1ST WORD OF MD:DCB(M:OC)
         AND,14   X200         MASK IN BIT 10
         BNEZ     CT:I         BRANCH IF DCB IS ALREADY OPENED.
         CAL1,1   C:OPENM      OPEN.
CT:I     CAL1,1   E:CORRS      CHECK IF BOTH DEVICE ARE =
         MTW,0    8            REG. 8 IF NON-ZERO LD = MD.
         BEZ      CT:J         BRANCH IF LD NOT = TO MD
         STW,1    1:FLAG       SET FLAG. (LD =72 BYTES LONG)
CT:J     EQU      %
*
*
*
         LI,14    OUTE:1       INITIALIZE TO FIRST BUFFER ADRS.
         STW,14   CT:BADRS
         LB,14    *CT:TCIS     FETCH 1ST BYTE OF BYTE STRING.
         LB,15    X4BD5+1,1    SET MASK OF X'7'
         AND,14   15           MASK 3 BITS IN.
         CI,14    5            BRANCH IF GREATER THAN 5 LINES.
         BG       CT:X
         STW,14   CT#LNS       SAVE IN LINES LOCATION
         LB,14    *CT:TCIS     FETCH 1ST BYTE AGAIN.
         SLS,14   -3           THIS TIME FOR BITS 1-4
         LB,15    X4BD5+1      FETCH MASK OF X'F'
         AND,14   15           MASK 4 BITS IN
         STW,14   CT:SKIP      SAVE IN C:SKIP LOCATION.
         MTW,0    *CT:TCIS     IS BIT 0 SET OR NOT
         BGEZ     CT:P1        BRANCH IF NOT SET.
         STW,1    3:FLAG
CT:P1    EQU      %
*
*        EVERYTHING READY TO GO.
*        START TO TRANSFER MESSAGE TEXT TO OUTPUT BUFFERS.
*
*
CT:D     EQU      %
         MTW,1    CT:IBC       INCREMENT TCIS BYTE COUNT
         LW,7     CT:IBC       FETCH INDEX
         LB,6     *CT:TCIS,7   FETCH INDEX TO TE:TABLE.
         BEZ      CT:CA        B:IF ZERO
         CI,6     X'FF'        TERMINATION CHARACTER
         BE       CT:B         BRANCH IF EQUAL. LINE TERMINATED.
         LW,14    TE:TABLE,6   FETCH TEXT ADDRESS.
         STW,14   CT:ADRS      STORE TO CT:ADRS LOCATION
         LB,7     *CT:ADRS     FETCH CURRENT BYTE COUNT.
         AW,7     CT:BCB       TEST TO SEE IF EXCEEDS 132
         CI,7     132
         BG       CT:X         **ERROR** EXCEEDS 132 BYTES.
         LI,7     1            RESET INDEX 7 TO 1
         LW,5     CT:BCB       SET THE INDEX TO MOVE CHARACTERS
CT:A     LB,14    *CT:ADRS,7   FETCH TEXT BYTES.
         STB,14   *CT:BADRS,5  TRANSFER TO OUTE:1 BUFFERS.
         AI,5     1            INCREMENT 5 AND 7
         AI,7     1
         CB,7     *CT:ADRS     CHECK FOR COMPLETION
         BLE      CT:A         BRANCH LESS THAN/EQUAL TO NOT DONE
CT:C     STW,5    CT:BCB       SAVE THE LAST AMOUNT
*
*        PROCESS THE SPACES BETWEEN EACH WORD.
*
CT:CA    EQU      %
         MTW,1    CT:IBC       INCREMENT INDEX.
         LW,7     CT:IBC       FETCH INDEX 7
         LB,6     *CT:TCIS,7   FETCH NEXT BYTE FROM TCIS
         CI,6     X'FF'        CHECK FOR END OF LINE.
         BE       CT:B         BRANCH IF LINE TERMINATED.
         AW,6     CT:BCB       ADD TO TOTAL AMOUNT OF BYTES.
         CI,6     132          CHECK FOR EXCEEDS 132.
         BG       CT:X         **ERROR** EXCEEDS 132 BYTES.
         STW,6    CT:BCB       SAVE IN BYTES LOCATION.
         B        CT:D         BRANCH FOR CONTINUATION.
*
*
*        END OF LINE. TERMINATION CHARACTER X'FF' ENCOUNTERED
*
*
CT:B     EQU      %
         LW,14    CT:BCB       FETCH TOTAL BYTES ACCUMULATED
         LW,7     CT:BCT       FETCH INDEX TO BCNT:1
         STB,14   BCNT:1,7     SAVE IN BYTE SUM LOCATION
         MTW,1    CT:BCT       INCREMENT TO NEXT BYTE SAVE LOC.
         LW,14    CT:BCT       FETCH FOR COMPARISON
         CW,14    CT#LNS       BRANCH IF ALL LINES PROCESSED.
         BGE      CT:E         BRANCH IF GREATER OR EQUAL
         LW,14    CT:BADRS     SET UP NEXT OUTPUT BUFFER
         AI,14    34           ADDRESS.
         STW,14   CT:BADRS
         STW,0    CT:BCB       RESET BYTE COUNT OF OUTPUT BUFFERS.
         B        CT:D         CONTINUE.
*
*
*        ALL LINES TAKEN CARE OF . START PRINT.
*
*
CT:E     EQU      %
         LI,14    OUTE:1       INITIALIZE FIRST OUTPUT BUFFER
         STW,14   CT:BADRS     FOR PRINT ROUTINE.
         STW,0    CT:BCT       RESET BCNT:1 BYTE COUNT.
*
*        WHAT OUTPUT DESIRED. 72 OR 132 BYTES LENGHT
*
CT:NA    EQU      %
         LW,7     CT:BCT       GET BYTE COUNT.
         CW,7     CT#LNS       BRANCH IF ALL LINES DONE.
         BGE      CT:AA
         MTW,0    1:FLAG       SET=72 , RESET=132
         BEZ      CT:L         BRANCH IF 132
         LB,14    BCNT:1,7     BEGIN TO ADJUST FOR 72 BYTES LENGHT.
         AI,14    -72
         BLZ      CT:L         BRANCH IF LESS THAN 72
         AI,14    8            ADD 8 MORE BYTES TO THE SECOND LINE.
         STB,14   BCNT:1,7     SAVE THE REMAINDER
         LI,14    72           SET FOR MAX OF 72
         B        CT:M         BRANCH TO PRINT.
*
*
*
CT:L     EQU      %
         LB,14    BCNT:1,7     FETCH BYTE COUNT.
         STB,0    BCNT:1,7     RESET WHAT WE TOOK OUT.
CT:M     MTW,0    14           IF BYTE SUM = 0 , DO NOT PRINT
         BEZ      CT:N         BRANCH IF EQUAL TO ZERO
         LW,6     CT:BADRS     FETCH ADDRESS.
         STW,6    CT:DA        INSERT TO DATA AFTER BAL
         BAL,15   L:PRINT      PRINT TEXT OUT.
CT:DA    DATA     OUTE:1
CT:N     EQU      %
         LW,6     CT:BADRS     UPDATE CT:BADRS TO NEXT BUFFER
         AI,6     34
         STW,6    CT:BADRS
         MTW,1    CT:BCT       INCREMENT INDEX TO NEXT BYTE COUNT
         B        CT:NA        CONTINUE
*
*
*
CT:AA    EQU      %
         MTW,0    1:FLAG       CHECK 132 -72 BYTE FLAG.
         BEZ      CT:DONE      IF 132,BRANCH TO DONE.
         MTW,0    2:FLAG       ALREADY BEEN THRU HERE ???
         BNEZ     CT:DONE      BRANCH IF YES. ONCE THRU ALREADY
         LW,14    X40X         FETCH BLANKS.........
         STW,14   OUTE:1+16    FILL THE 8 PREVIOUS BYTES WITH BLANKS.
         STW,14   OUTE:1+17
         STW,14   OUTE:2+16
         STW,14   OUTE:2+17
         STW,14   OUTE:3+16
         STW,14   OUTE:3+17
         STW,14   OUTE:4+16
         STW,14   OUTE:4+17
         STW,14   OUTE:5+16
         STW,14   OUTE:5+17
         LI,14    OUTE:1+16    INITIALIZE FOR NEXT OUTPUT RUN
         STW,14   CT:BADRS     THIS TIME FOR THE REST .
         STW,0    CT:BCT       RESET BYTE COUNT.
         STW,1    2:FLAG       SET 'ALREADY THRU' FLAG
         LW,14    3:FLAG       ANY SKIP AFTER 1ST GROUP DONE
         BEZ      CT:NA        BRANCH IF NONE.....
         BAL,15   L:SPACE      SKIP
         B        CT:NA        BRANCH BACK.
*
*        ALL DONE.
*
CT:DONE  EQU      %
         MTW,0    1:FLAG       CHCK IF 72O/ OR 132 LENGHT.
         BEZ      CT:D1        BRANCH IF 132. (NO SKIP IF 132)
         LW,7     CT:SKIP      ANY SKIPS  TO BE DONE AFTER ALL
         BEZ      CT:D1          DONE. ALL GROUPS)
         LCW,7    CT:SKIP      YES, FETCH THE NEGATIVE INDEX.
         BAL,15   L:SPACE      SKIP
         BIR,7    %-1          GO UNTIL ALL DONE.
CT:D1    EQU      %
         LCI      4            RESTORE ALL REGISTERS.
         LM,5     CT:SAVE      5-8,14-15
         LCI      2
         LM,14    CT:SAVE+4
         B        *15
*
*
*
*  **ERROR**  ROUTINE.
*
*
*
CT:X     EQU      %
         LI,14    34           PRINT OUT ERROR MSG.
         BAL,15   E:PRINT      PRINT.......
         DATA     CT:XMSG
         B        CT:D1        BRANCH TO EXIT
CT:XMSG  TEXT     'ERROR:TOO MANY CHARACTERS OR LINES'
*
*
*
*
*
*
*
*
         PAGE
*
*
*  SUBROUTINE TO PRINT A SPACE OUT THRU THE L:PRINT DEVICE.
*
*
*
L:SPACE  EQU      %
         LCI      2            SAVE REGISTERS 14,15
         STM,14   L:SAVEP
         LI,14    1
         BAL,15   L:PRINT      PRINT THE SPACE
         DATA     SPACEMSG
         LCI      2            RESTORE THE REGISTERS
         LM,14    L:SAVEP
         B        *15
L:SAVEP  DATA     0,0          RESERVED LOCATIONS.
SPACEMSG TEXT     ' '
*
*
*
*
*
         PAGE
*
* L:PRINT LIST OUT TO THE LISTING DEVICE (LD)
*
* CALL MODE:                   IF ABNORMAL OR ERROR CODE OCCUR
*                              THE SYSTEM WILL ABORT AND GO TO
*        LB,14    BYTE COUNT   E:RPINT FOR OUTPUT.
*        BAL,15   L:PRINT      REGISTERS. 1,8,10 = VOLATILE THEN.
*        DATA     TEXT         ADDRESS.
*
L:PRINT  EQU      %
         STW,14   L:PSAVE      SAVE REG. 14.15.8
         STW,15   L:PSAVE+1
         STW,8    L:PSAVE+2
         STW,14   WRI:BCNT     SAVE BYTE COUNT
         LW,14    *15          FETCH TEXT ADDRESS.
*
         STW,14   WRI:BUF      SAVE IN BUFFER ADDRESS.
         BAL,15   PAX          SIDE OF THE SHOW TO UPDATE THE TOP OF
* FORM HEADER FOR THE HEADER CAL.....FOR THE LP.....
         CAL1,1   WRI:FPT      WRITE OUT TO M:LO
         LW,14    L:PSAVE      RESTORE REG. 14.15 8
         LW,15    L:PSAVE+1
         LW,8     L:PSAVE+2
         MTW,1    L:PSAVE+1    INCREMENT RETURN ADDRESS.
         B        *L:PSAVE+1   RETURN.
L:PSAVE  DATA     0,0,0
*
*
*  ERROR RETURN FOR BOTH L:PRINT AND E:PRINT.
*
*
WRI:ERR  EQU      %
         BAL,15   ERR:PRN      ERROR PRINTOUT.
         B        M:ABORT      ABORT
*
*
*        ABNORMAL ERROR RETURN FOR L:PRINT AND E:PRNT
*
*
WRI:ABN  EQU      %
         BAL,15   ABN:PRN      ERROR ABNORMAL PRINTOUT.
         B        M:ABORT      ABORT JOB.
*
*
WRI:FPT  GEN,1,7,7,17   1,X'11',0,LD:DCB
         DATA         X'F0000010',WRI:ERR,WRI:ABN
WRI:BUF  DATA         0
WRI:BCNT DATA         0
*
*
*
         PAGE
*
*
* E:PRINT LIST THE ERROR MSG. TO THE CID AND LD DEVICE.
*
* CALL MODE:                   THE M:OPEN HAS ERROR AND ABN.
*                              RETURN BUT THE ERROR PRINT HAS
*        LW,14    BYTE COUNT   NONE.
*        BAL,15   E:PRINT
*        DATA     TEXT         ADDRESS.
*
*
* ISSUE A M:CORRES TO LD:DCB VS. MD:DCB.
* IF THE DEVICE ARE EQUAL , DO NOT PRINT TO LD:DCB DEVICE.
*
E:PRINT  EQU      %
         STW,14   E:PSAVE      SAVE REGISTER 14,15,8
         STW,15   E:PSAVE+1
         STW,8    E:PSAVE+2
         STW,14   WRIEBCNT     SET BYTE COUNT
         LW,14    *15          FETCH TEXT ADDRESS.
         STW,14   WRIEBUF      SET IN BUFFER ADDRESS.
         CI,15    1:D+1
         BE       E:PRS2
         CI,15    2:D+1
         BE       E:PRS2
         CI,15    3:D+1
         BE       E:PRS2
         CI,15    4:D+1
         BE       E:PRS2
         CI,15    R:HELL       IS THIS THE COMMAND OUTPUT ENTRY..?
         BNE      E:PRS4       BRANCH IF ABSOLUTELY NOT!!!!.....
EPI      LW,14    CIDFG        FLAG.  SI=OC (0) SI .NE. OC (1)
         BEZ      E:PRS1       BRANCH IF ENFATICALLY YES!!!>>...
         B        E:PRS3       IF NOT CHECK LO=OC OR NOT.
E:PRS2   CAL1,1   VFC0CRS
         CAL1,1   WRIEFPT      WRITE OUT
E:PRS3   LW,14    *LD:DCB      CHECK M:LO DEVICE DCB OPEN OR NOT
         AND,14   X200         MASK IN BIT 10
         BNEZ     E:P1         BRANCH IF NOT ZERO
         CAL1,1   E:OPENL      OPEN BEFORE DOING THE M:CORRES.
E:P1     EQU      %            DCB IS OPEN  HERE.
         CAL1,1   E:CORRS      CHECK DCB'S (EQUAL?)
         MTW,0    8            CHECK SR1
         BNEZ     E:P2         BRANCH IF NOT ZERO
E:PRS1   LW,15    WRIEBUF      SET UP THE M:LO PRINT.
         STW,15   E:P3
         LW,14    WRIEBCNT     BYTE COUNT
         CAL1,1   VFCRST       RESET VFC.....
         BAL,15   L:PRINT
E:P3     DATA     0
E:P2     EQU      %
         LW,14    E:PSAVE      RESTORE REGISTERS.
         LW,15    E:PSAVE+1
         LW,8     E:PSAVE+2
         MTW,1    E:PSAVE+1    INCREMENT ADDRESS.
         B        *E:PSAVE+1
*
E:PSAVE  DATA     0,0,0
VFC0CRS  GEN,1,7,7,17  1,5,0,MD:DCB
         DATA     0
X200     DATA     X'200000'
E:OPENL  GEN,1,7,7,17   1,X'14',0,LD:DCB
         DATA     X'C0000000',WRI:ERR,WRI:ABN
E:CORRS  GEN,1,7,7,17  1,X'2B',0,MD:DCB
         GEN,1,14,17   1,0,LD:DCB
WRIEFPT  GEN,1,7,7,17   1,X'11',0,MD:DCB
         DATA     X'30000010'
WRIEBUF  DATA     0
WRIEBCNT DATA     0
*
*
*
*        SET UP BUFFER FOR THE ERROR OUPUT.
* (BUFFER IS 132 BYTES LENGHT...)
*
*
E:PRS4   LCI      2            SAVE TWO REGISTERS.......
         STM,5    E:PRSX       SAVE.....
         LW,5     WRIEBCNT     FETCH BYTE COUNT...
         CI,5     131          MAXXX..
         BGE      E:PRS6
         MTW,2    WRIEBCNT     ADD TWO.....
         LI,5     2            INITIALIZE.........
         LI,6     0
E:PRS5   LB,14    *WRIEBUF,6
         STB,14   TEXOUT,5     TRANSFER THE BYTES.....
         AI,6     1            BUMP
         AI,5     1
         CW,5     WRIEBCNT     B: IF GREATER
         BL       E:PRS5
         LI,14    TEXOUT
         STW,14   WRIEBUF
E:PRS6   LCI      2            EXIT....RESTORE....
         LM,5     E:PRSX
         B        E:PRS2
E:PRSX   DATA     0,0
TEXOUT   TEXT     '**  '
         RES      32
         PAGE
*
*
*        ERROR RETURN FOR MOST CAL'S.
*        THE FUNCTION IS JUST TO PRINT OUT ERROR CODE AND
*        LOCATION OF ERROR CAL.
*        CALL MODE. :   BAL,15 ERR:PRN
*
*
ERR:PRN  EQU      %
         LCI      0
         STM,0    ERR:PSAV     SAVE REGISTERS 0-15
         LB,14    10           FETCH CODE FROM REG. 10
         BAL,15   HEXEBC       CONVERT TO EBCDIC
         STH,15   ERR:MSG+5    SAVE INTO TEXT MSG.
         LB,14    10,1
         BAL,15   HEXEBC       CONVERT TO EBCDIC
         STH,15   ERR:MSG+8
         LI,14    36
         BAL,15   E:PRINT      ERROR PRINTOUT.
         DATA     ERR:MSG
         LCI      0            RESTORE REGISTERS 0-15
         LM,0     ERR:PSAV
         B        *15          RETURN.
ERR:PSAV RES      16           RESERVE FOR 16 REGISTERS.0-15
*
*
ERR:MSG  TEXTS    'ERROR OCCURRED:CODE=XX  SUBCODE=XX'
*
*
*
         PAGE
*
*
*
*        ABNORMAL ERROR RETURN FOR MOST CAL'S
*        THE FUNCTION IS ESSENTIALLY THE SAME FOR ABNORMAL
*        CALL MODE:            BAL,15  ABN:PRN
*
*
*
ABN:PRN  EQU      %
         LCI      0            SAVE REGISTERS 0-15
         STM,0    ABN:SAV
         LB,14    10           FETCH ERROR CODE
         BAL,15   HEXEBC       CONVERT TO EBCDIC
         STH,15   ABN:MSG+5
         LB,14    10,1
         BAL,15   HEXEBC
         STH,15   ABN:MSG+8
         LI,14    36           BYTE COUNT
         BAL,15   E:PRINT
         DATA     ABN:MSG
         LCI      0            RESTORE REGISTERS 0-15
         LM,0     ABN:SAV
         B        *15          RETURN
ABN:SAV  RES      16
*
*
ABN:MSG  TEXTS    'ABNORMAL ERROR CODE=XX  SUBCODE=XX'
*
*
*
*
         PAGE
*
*
*  HEXDEC:        CONVERT A HEX NUMBER TO DECIMAL DIGITS.
*
*  CALL MODE:                 INPUT = X'10000000' IN REG 14
*                             OUTPUT = X'2' IN REG 14
*                                      X'68435456' IN REG 15
*        LW,14    HEW WORD
*        BAL,15   HEXDEC:
*        RESULT IN REGISTERS 14,15
*
HEXDEC:  EQU      %
         LCI      3          SAVE REGISTERS 13-15,5-7
         STM,13   HX:SAVE
         STM,5    HX:SAVE+3
         LI,15    0          CLEAR 15
         LI,14    0          CLEAR 14
         LI,5     0          CLEAR 5
         LI,6     -9
HEXDEC0  EQU      %
         LW,13    HX:SAVE+1  FETCH HEW WORD.
         SW,13    HX:10:9+9,6  DECREMENT CONSTANTS.
         BLZ      HEXDEC2    BRANCH IF LESS THAN ZERO (NEGATIVE)
         AI,15    1          INCREMENT 15
         STW,13   HX:SAVE+1  SAVE REMAINDER
         B        HEXDEC0    BRANCH AGAIN.
HEXDEC2  EQU      %
         SLD,14   4            SHIFT LEFT 4
         BIR,6    HEXDEC0    BRANCH AND INCREMENT
         AW,15    HX:SAVE+1  ADD LAST DECIMAL DIGIT.
         LCI      3
         LM,5     HX:SAVE+3  RESTORE REG. 5-7,13-15
         LW,13    HX:SAVE
         B        *HX:SAVE+2 RETURN.
HX:SAVE  DATA     0,0,0,0,0,0
HX:10:9  DATA     1000000000,100000000,10000000,1000000,100000
         DATA     10000,1000,100,10
*
*
*
         PAGE
*
* HEXDECE         CONVERT HEX WORD INTO EBCDIC DECIMAL
*                 DEPOSIT IN LOCATION OF USER CHOICE.
*                 10 DECIMAL LONG.
*
*  CALL MODE:     LI,13      START BYTE COUNT WITHIN A WORD.(0-3)
*                 LW,14      HEX WORD TO BE CONVERTED.
*                 BAL,15     HEXDECE
*                 DATA       ADDRESS OF LOCATION WHERE DECIMAL
*                            DIGITS TO BE DEPOSITED.
*
*
HEXDECE  EQU      %
         LCI      3          SAVE REGISTERS 13-15,5-7
         STM,13   HX:FSAVE
         STM,5    HX:FSAVE+3
         LW,13    *15        FETCH ADDRESS OF LOCATION
         STW,13   HX:FADR    SAVE
         BAL,15   HEXDEC:    CONVERT TO DECIMAL DIGITS.
         SLS,14   24         SHIFT LEFT 24 BITS.
         LW,7     HX:FSAVE   FETCH BYTE COUNT.
         LI,6     -2         SET INDEX 6 AT -2
A:HX     LI,13    0          CLEAR 13
         SLD,13   4          SHIFT LEFT 4 BITS
         AI,13    X'F0'      ADD X'F0'
         STB,13   *HX:FADR,7 STORE TO DATA LOCATION.
         AI,7     1          INCREMENT INDEX 7
         BIR,6    A:HX       BRANCH ON INCRMENTING
         LI,6     -8           SET UP INDEX
         B        2:HD         CONTINUE IN  REGULAR HEX CONV.
*
*
*
*
*
*  CALL MODE:
*        LI,13    START BYTE LOCATION.
*        LW,14    HEX WORD
*        BAL,15   HEXTWO,HEXFOUR,HEXFIVE,HEXEIGHT
*        DATA     LOCATION TO BE DEPOSITED.
HEXTWO   EQU      %
         LCI      3            CONVERT TO TWO DEC. EBCDIC.
         STM,5    HX:FSAVE+3
         LI,6     -2           SET UP INDEX.
         LI,7     24
         B        0:HD
HEXFOUR  EQU      %
         LCI      3
         STM,5    HX:FSAVE+3
         LI,6     -4
         LI,7     16
         B        0:HD
HEXFIVE  EQU      %
         LCI      3
         STM,5    HX:FSAVE+3
         LI,6     -5
         LI,7     12
         B        0:HD
HEXEIGHT EQU      %
         LCI      3
         STM,5    HX:FSAVE+3
         LI,6     -8
         LI,7     0
0:HD     EQU      %
         STW,7    HD:SHT       SAVE THE SHIFT FACTOR.
         LCI      3            GO ON TO SAVE REG 13-15
         STM,13   HX:FSAVE
         LW,13    *15
         STW,13   HX:FADR      SAVE IN THE ADDRESS
         BAL,15   HEXDEC:
         CI,7     0            CHECK SHIFT FACTOR
         BE       1:HD         BRANCH IF ZERO
         SLS,15   *HD:SHT      SHIFT BY FACTOR.
1:HD     EQU      %
         LW,7     HX:FSAVE
2:HD     EQU      %
         LI,14    0          CLEAR REGISTER 14
         SLD,14   4          SHIFT LEFT 4BITS DOUBLE REGISTERS
         AI,14    X'F0'
         STB,14   *HX:FADR,7 STORE INTO LOCATION
         AI,7     1          INCREMENT BY ONE
         BIR,6    2:HD       BRANCH INCREMENT
         LCI      3          RESTORE REIGSTERS. 13-15,5-7
         LM,5     HX:FSAVE+3
         LM,13    HX:FSAVE
         MTW,1    HX:FSAVE+2 INCREMENT RETURN ADDRESS.
         B        *HX:FSAVE+2 RETURN.
HX:FSAVE DATA     0,0,0,0,0,0
HD:SHT   DATA     0
HX:FADR  DATA     0
*
*
*
         PAGE
*
*
*
*
*        DECIMAL TO HEXADECIMAL CONVERSION.
*
*        THIS ROUTINE WILL CONVERT DECIMAL (4 BITS FORMAT)
*        VALUES INTO HEXADECIMAL VALUES.
*
*        THE MAX INPUT DECIMAL VALUE IS LIMITED TO 8 DECIMAL
*        CHARACTERS. (A WORD) AND THE MAX IS DECIMAL 99999999
*
*        CALLING MODE:
*        LW,14    DECIMAL WORD.
*        BAL,15   DECHEX:
*        ERROR RETURN. (VALUE WAS NOT DECIMAL)
*        SUCCESFUL RETURN.
*          (RESULTS IN REGISTER 15)
*          ALL OTHER REGISTER CONSIDERED SAFE
*
DECHEX:  EQU      %
         LCI      2            SAVE REGISTERS 14,15
         STM,14   DX:SAVE
         LCI      4            SAVE REGISTERS 4,5,6,7
         STM,4    DX:SAVE+2
         LI,15    0            CLEAR 14,15
         LI,14    0
         LI,4     -7           INITIALIZE INDEX REG 4 TO -7
         LI,5     0            RESET INDEXES 5,6
         LI,6     0
         LW,7     DX:SAVE      FETCH DECIMAL VALUE
DX:0     EQU      %
         SLD,6    4            SHIFT DECIMAL VALUE LEFT 4 INTO...
         CI,6     0             LEAST SIGNIFICANT 4 BITS OF REG 6
         BL       DX:EXIT      CHECK FOR DECIMALI'TY (0-9)
         CI,6     9
         BG       DX:EXIT      ERROR
         CI,6     0            CHECK FOR ZERO
         BE       DX:1
         LCW,6    6            FETCH THE NEGATIVE VALUE
         AW,15    HX:10:9+2,5   ADD THE HEX VALUE (MULTIPLY)
         BIR,6    %-1
DX:1     EQU      %
         AI,5     1            INCREMENT INDEX 5
         BIR,4    DX:0         DO UNTIL ALL 8 CHARACTERS DONE
         SLD,6    4            SHIFT THE LAST CHARACTER IN.
         AW,15    6            ADD TO ACCUMMULATED SUM.
         MTW,1    DX:SAVE+1    INCREMENT RETURN FOR GOOD RETURN.
DX:EXIT  EQU      %
         LCI      4            RESTORE 4,5,6,7
         LM,4     DX:SAVE+2
         LW,14    DX:SAVE
         B        *DX:SAVE+1   RETURN.
DX:SAVE  RES      6            RESERVED SAVE LOCATIONS.
*
*
*
*
*
*
*
         PAGE
*
*
*        FETCH BYTES FROM COMBUFF SUBROUTINE.
*
*        EVERYTIME AN ENTRY IS DONE,COB ISINCREMENTED.
*        CALL IS BY:
*        BAL,15   F:F
*        BRANCH HERE IS A TERMINATION RETURN.
*        BRANCH HERE IS A CONTINUATION RETURN.
*
*        REGISTERS 14,15 ARE DISTURBED.
*        REGISTER 14 WILL HAVE THE BYTE INPUT FROM COMBUFF.
*        TERMINATION RETURN MEANS TERMINATED BY THE END OF
*        THE 80 BYTES INPUT OR BY CARRIAGE RETURN OR NEW LINE.
*        ALL OTHER REGISTER ARE SAVED.
*        THIS ROUTINE IS FOR THE BENEFIT OF THE SET AND BOUNDARY
*        COMMANDS. (SPECIALIZED ROUTINE)
*
*
F:F      EQU      %
         STW,4    FS:          SAVE REG. 4
FN:      EQU      %
         MTW,1    COB          INCREMENT INDEX POINTER
         LW,4     COB          FETCH INDEX 4
         CI,4     79           COMPARE TO 79
         BG       FX:          BRANCH IF GREATER THAN.
         LB,14    COMBUFF,4    FETCH BYTE.
         CB,14    X4BD5        BRANCH IF BLANK.
         BE       FN:
         CB,14    X4BD5,2      BRANCH IF CARRIAGE RETURN.
         BE       FX:
         CB,14    X4BD5,3      BRANCH IF NEW LINE.
         BE       FX:
         AI,15    1            INCREMENT RETURN ADDRESS.
FX:      EQU      %
         LW,4     FS:          RESTORE REG.4
         B        *15          RETURN.
FS:      DATA     0
*
*
GETDT    LCI      4
         STM,12   GETSVT       SAVE 12-15
         STW,5    GETSV5
*        GET CURRENT TIME-DATE.
*        INITIALIZE PARAMETERS DATE:0,TIME:0,YEAR:0
*
         CAL1,8   GETDATE      CAL GET DATE.
         LI,13    0            RESET 14
         LH,12    DATIME       FETCH HOURS.
         AND,12   XFFFF
         SCD,12   -4
         SCS,12   -4
         SCD,12   -4
         SLS,13   -24
         LW,14    13
         BAL,15   DECHEX:
         B        E:R:R
         STW,15   HOUR:0
*
*  ......................
*
         LW,12    DATIME       FETCH MINUTES.
         LW,13    DATIME+1
         SLS,13   4
         SLD,12   -4
         SLS,13   -24
         LW,14    13
         BAL,15   DECHEX:
         B        E:R:R
         STW,15   MINS:0
*
*  .......................
*
         LW,12    DATIME+1     FETCH MONTHS.
         LW,13    DATIME+2
         SLD,12   8
         LI,5     0
DA:TI1   CW,12    JAN:,5
         BE       DA:TI2
         AI,5     1            INCREMENT INDEX TO MONTHS
         CI,5     11
         BLE      DA:TI1       BRANCH LESS OR EQUAL
         B        E:R:R
DA:TI2   AI,5     1
         STW,5    MONT:0
*
*  ........................
*
         LI,13    0            FETCH DAYS.
         LW,12    DATIME+2
         AND,12   XFFFF
         SCD,12   -4
         SCS,12   -4
         SCD,12   -4
         SLS,13   -24
         LW,14    13
         BAL,15   DECHEX:
         B        E:R:R
         STW,15   DAY:0
*
*  ..........................
*
         LI,13    0            FETCH YEAR.
         LW,12    DATIME+3
         AND,12   XFFFF
         SCD,12   -4
         SCS,12   -4
         SCD,12   -4
         SLS,13   -24
         LW,14    13
         BAL,15   DECHEX:
         B        E:R:R
         STW,15   YEAR:0
*
*  ..........................
*
         LW,13    MONT:0       FIX DATE:0
         LW,14    DAY:0
         BAL,15   MD:JD        CONVERT TO JULIAN DAYS.
         STW,15   DATE:0
*
*  ..........................
*
         LW,13    HOUR:0       FIX TIME:0
         LW,14    MINS:0
         BAL,15   HMSN:MS      CONVERT TO MILLISECS.
         B        E:R:R
         STW,15   TIME:00
*
*        EXIT
*
         LCI      4
         LM,12    GETSVT       RESTORE 12-15
         LW,5     GETSV5       RESTORE 5
         B        *15
GETSVT   RES      4
GETSV5   DATA     0
         PAGE
*
*   GET MODEL INTO A EBCDIC FORMAT.
*   CALL MODE.    BAL,15  MOD:EBC
*         RESULTS IN REGISTERS 14,15
*         FETCH THE MODEL FROM BUFFER INTO REG 14 (RIGHT JUST)
*
MOD:EBC   EQU     %
         LCI      0
          STM,0     COMBUFF
         LB,15    S:SYS     FETCH SYSTEM TYPE CODE
         BNEZ     MOD:EAB
         BAL,15    HEXDEC:
         LW,14    15
MOD:EAB   EQU    %
         BAL,15    HEXEBC
         LCI     14
         LM,0     COMBUFF
         B       *COMBUFF+15
*
*
*
         PAGE
*
* IONDD CONVERTS THE PHYSICAL IO ADDRESS INTO LOGICAL .....
* THIS IS DEPENDING UPON THE SYSIDF........CP-R OR CP-V
* SIGMA OR TAURUS SIGNIFICANCE......
*
* THE TAURUS CONVERSION REQUIRES A MATRIX CONVERSION..
* THE SIGMA IS A STRAITHGT FORWARD CONVERSION.
*
* ENTERING REQUIRES HAVING THE DEVICE ADDRESS IN REG. 14
*        BAL,15   IONDD        IS THE CALL.
*        RESULTS IN REGISTER 15 (EBCDIC)
*        (3 CHARACTERS RIGHT JUSTIFIED)
*
*
IONDD    STW,7    ION7         SAVE 7
         STW,14   IONS         SAVE 14
         STW,15   IONS+1
         BAL,15   HEXEBC       CONVERT...
         STH,15   IONT,1       SAVE IN TEMPORARY.
         LB,15    SYSIDF,1     FETCH TAURUS/SIGMA SIGN..
         CI,15    3            IS IT TAURUS./
         BE       IONDTAU      B: YES.......
         LW,14    IONS         FETCH THE DEVICE
         SLS,14   -8
         AND,14   X7
         AI,14    X'C1'
         STB,14   IONT,1
         B        IONX
IONDTAU  LW,7     IONS         FETCH THE DEVICE..
         SLS,7    -8
         AND,7    X7
         LW,14    UNADR#,7
         STW,14   WKAD:        INTO WORD ADDRESS.
         LW,7     IONS         FETCH THE CLUSTER....
         SLS,7    -11
         AND,7    X7
         LB,14    *WKAD:,7     FETCH THE CHARACTER.
         STB,14   IONT,1
IONX     LW,7     ION7
         LW,14    IONS
         LW,15    IONT
         B        *IONS+1
X7       DATA     7
ION7     DATA     0
IONS     DATA     0,0
IONT     DATA     0
WKAD:    DATA     0
*
*
UN#0     TEXT     'ABHNTZ5.'
UN#1     TEXT     '%CIOU06.'
UN#2     TEXT     '#DJPV17.'
UN#3     TEXT     '!EKQW28.'
UN#4     TEXT     ':FLRX39.'
UN#5     TEXT     '.GMSY4..'
UN#6     TEXT     '........'
UN#7     TEXT     '........'
UNADR#   DATA     UN#0,UN#1,UN#2,UN#3,UN#4,UN#5,UN#6,UN#7
         PAGE
*
*
*
*  PAX ......SET UP THE HEADER DATE FOR THE CAL1,1 LP:HEAD CALL..
*
*
PAX      EQU      %
         STW,4    PAX:DA+1     SAVE 4
         STW,15   PAX:DA
         CAL1,8   GETDATE      GET THE CURRENT DATE...
         LI,4     4            INITIALIZE THE COUNT
         LW,15    DATIME-1,4   FETCH THE INFO....
         STW,15   BUFDAT,4
         BDR,4    %-2
         LW,4     PAX:DA+1
         B        *PAX:DA
PAX:DA   DATA     0,0
LP:HEAD  GEN,1,7,7,17  1,X'26',0,LD:DCB
         GEN,4,28       X'C',0
         DATA     BUFDAT,113
BUFDAT   TEXTC    '                    '
*
*
*
*
         PAGE
M:ABORT  CAL1,9   3            ABORT WITH ERROR.
*
EXIT:M   CAL1,9   1
*
*
         END      START

