*  PROGRAMMER - PAUL L. STENDAL                                         P:SYS  1
         OPEN     PLOC,CHEX,FCHEX,INOA,SEBN,%PEND,IAF,LBL,;             P:SYS  2
   T0,T1,SECT,P,UK,%FIN,#X1,#X3,#4,#1,#1U1,#X2,RP,;                     P:SYS  3
   FLIMF09,LIMF09,CP,DDEF,%FIN1,%FIN2,%FIN3,I,J,K,L,M,IIAF,;            P:SYS  4
   FLIMC16,LIMC16,SHXBN,FHEXBIN,IFE,FEBCBIN,;                           P:SYS  5
   TCBTD,TX,TSZ,Q,N,STORE,LOAD,MOVE,#LT,LT,LTBAD,VT,#4TMP,;             P:SYS  6
   FSBNHX,SBNHX,#BA,#WA,FLPTBL,LPTBL,TBLK,AST,FERRMSG,;                 P:SYS  7
   CLSDO,CLSXX,KBF,OPNXX,RBF,RDXX,R10TMP,R8TMP,TXBDER,TXDCB,WRTDO,;     P:SYS  8
   FLOPEN,FPT%VLP,FSCAN,FTBLSRCH,OPENDCB,OUTBUFF,SCAN,SCN,;             P:SYS  9
   STKADR,SPDPNTR,TBLSRCH,%DEV,SKPCHR,SB,FLFNDVLP,FNDVLP,;              P:SYS 10
   BABUF,BATBL,DELIMS                                                   P:SYS 11
UK       EQU      'P:SYSTEM:  UNRECOGNIZED KEY'                         P:SYS 12
INOA     EQU      'P:SYSTEM:  IMPROPER # OF AFS'                        P:SYS 13
CP       EQU      'P:SYSTEM:  CONFLICTING PARAMETER'                    P:SYS 14
DDEF     EQU      'P:SYSTEM:  DBL DEF PARAMETER'                        P:SYS 15
IFE      EQU      'P:SYSTEM:  INSTRUCTION FORMAT ERROR'                 P:SYS 16
IAF      EQU      'P:SYSTEM:  ILLEGAL AF'                               P:SYS 17
IIAF     EQU      'P:SYSTEM:  ILLEGAL INDIRECT AF'                      P:SYS 18
#X1      SET      1                 INDEX                               P:SYS 19
#X2      SET      2                 INDEX                               P:SYS 20
#X3      SET      3                 ODD INDEX                           P:SYS 21
#4       SET      11                ANY                                 P:SYS 22
#1       SET      12                EVEN                                P:SYS 23
#1U1     SET      13                #1U1 (#1+1)                         P:SYS 24
FCHEX,FLIMF09,FHEXBIN,FEBCBIN,FLPTBL,#LT,FSBNHX,FERRMSG SET 0           P:SYS 25
FLOPEN,FSCAN,FTBLSRCH,FLFNDVLP SET 0                                    P:SYS 26
T0       SET      1                                                     P:SYS 27
T1       SET      2                                                     P:SYS 28
PLOC     SET      %                                                     P:SYS 29
P:PT0    CSECT    0                                                     P:SYS 30
SECT(T0) SET      %                                                     P:SYS 31
P:PT1    CSECT    1                                                     P:SYS 32
SECT(T1) SET      %                                                     P:SYS 33
         ORG      PLOC                                                  P:SYS 34
TBLK     EQU      '                                     '               P:SYS 35
AST      EQU      '************************************'                P:SYS 36
         PAGE                                                           P:SYS 37
*  CHANGE CONTROL SECTIONS.                                             P:SYS 38
P:TOSECT CNAME                                                          P:SYS 39
         PROC                                                           P:SYS 40
LF       SET      %                                                     P:SYS 41
         ORG      AF                                                    P:SYS 42
         PEND                                                           P:SYS 43
         PAGE                                                           P:SYS 44
*  CHANGE THE PROTECTION TYPES OF P:SYSTEM'S CONTROL SECTIONS.          P:SYS 45
P:PT     CNAME                                                          P:SYS 46
         PROC                                                           P:SYS 47
P        SET      SCOR(AF,0,1,NORMAL)                                   P:SYS 48
         ERROR,3,NUM(AF)>0&P=0    IAF                                   P:SYS 49
T0       SET      P:S(P,1,1,2,1)                                        P:SYS 50
T1       SET      P:S(P,2,1,2,2)                                        P:SYS 51
         PEND                                                           P:SYS 52
         PAGE                                                           P:SYS 53
*  RETURN AF POINTED TO BY AF(1)+2.                                     P:SYS 54
P:S      FNAME                                                          P:SYS 55
         PROC                                                           P:SYS 56
         PEND     AF(AF(1)+2)                                           P:SYS 57
         PAGE                                                           P:SYS 58
P:MAX    FNAME    0                                                     P:SYS 59
P:MIN    FNAME    1                                                     P:SYS 60
         PROC                                                           P:SYS 61
         PEND     P:S((AF(1)>AF(2))=NAME,AF(1),AF(2))                   P:SYS 62
         PAGE                                                           P:SYS 63
*  RETURN AF(1), SET AF(1) TO AF(2) OR 1 IF NO AF(2).                   P:SYS 64
P:FLAG   FNAME                                                          P:SYS 65
         PROC                                                           P:SYS 66
%FIN     SET      AF(1)                                                 P:SYS 67
AF(1)    SET      AF(2)+(NUM(AF)=1)                                     P:SYS 68
         PEND     %FIN                                                  P:SYS 69
         PAGE                                                           P:SYS 70
P:CHAR   CNAME                                                          P:SYS 71
         PROC                                                           P:SYS 72
P        SET      S:KEYS(0,24,TAB,NL,CR,NULL,LNF)                       P:SYS 73
LF       DO1      (P(2)&X'80')>0                                        P:SYS 74
TAB EQU ' '                                                             P:SYS 75
         DO1      (P(2)&X'40')>0                                        P:SYS 76
NL       EQU      '
'                                                   P:SYS 77
         DO1      (P(2)&X'20')>0                                        P:SYS 78
CR       EQU      '
'                                                   P:SYS 79
         DO1      (P(2)&X'10')>0                                        P:SYS 80
NULL     EQU      ' '                                                   P:SYS 81
         DO1      (P(2)&8)>0                                            P:SYS 82
LNF      EQU      ' '                                                   P:SYS 83
         PEND                                                           P:SYS 84
         PAGE                                                           P:SYS 85
P:TCS    FNAME    24,(16,8),('  ',' ')                                  P:SYS 86
P:TCD    FNAME    56,(48,40,32,24,16,8),('      ','     ',;             P:SYS 87
                  '    ','   ','  ',' ')                                P:SYS 88
         PROC                                                           P:SYS 89
I        SET      S:NUMC(AF)                                            P:SYS 90
         PEND     I**NAME(1)+AF**NAME(2,I)+NAME(3,I)                    P:SYS 91
         PAGE                                                           P:SYS 92
P:DL     FNAME                                                          P:SYS 93
         PROC                                                           P:SYS 94
         LOCAL    I,J                                                   P:SYS 95
J        SET      AF(1)**(32*(NUM(AF)=2))+AF(2)                         P:SYS 96
I        DO       #LT                                                   P:SYS 97
         GOTO,LT(I)=J    %PEND                                          P:SYS 98
         FIN                                                            P:SYS 99
#LT,I    SET      #LT+1                                                 P:SYS100
LT(I)    SET      J                                                     P:SYS101
%PEND    PEND     LTBAD+I*2-2                                           P:SYS102
         PAGE                                                           P:SYS103
P:END    CNAME                                                          P:SYS104
         PROC                                                           P:SYS105
         DO1      NUM(AF)=1                                             P:SYS106
         USECT    AF                                                    P:SYS107
         BOUND    8                                                     P:SYS108
LTBAD    DATA,8   LT                                                    P:SYS109
         PEND                                                           P:SYS110
         PAGE                                                           P:SYS111
P:DISP   CNAME                                                          P:SYS112
         PROC                                                           P:SYS113
         LOCAL    TCWA                                                  P:SYS114
TCBTD,%FIN3  SET  1                                                     P:SYS115
LF(1)    EQU      %                                                     P:SYS116
TX       SET                                                            P:SYS117
N        WHILE    N<NUM(AF)                                             P:SYS118
         DO       TCOR(S:C,AF(N))=1                                     P:SYS119
TX       SET      TX,AF(N)                                              P:SYS120
TCBTD    SET      TCBTD+S:NUMC(AF(N))                                   P:SYS121
         ELSE                                                           P:SYS122
         DO       SCOR(AF(N,1),NOPRINT)                                 P:SYS123
%FIN3    SET      0                                                     P:SYS124
         ELSE                                                           P:SYS125
         CONV,TCWA    AF(N)                                             P:SYS126
         FIN                                                            P:SYS127
         FIN                                                            P:SYS128
         FIN                                                            P:SYS129
         DO       %FIN3>0                                               P:SYS130
,,(TCWA,LF(2))     P:PRINT,0    S:PT(TX)                                P:SYS131
         ELSE                                                           P:SYS132
PLOC     P:TOSECT SECT(T0)                                              P:SYS133
TCWA,LF(2) TEXTC  S:PT(TX)                                              P:SYS134
SECT(T0) P:TOSECT PLOC                                                  P:SYS135
         FIN                                                            P:SYS136
         PEND                                                           P:SYS137
CONV     CNAME                                                          P:SYS138
         PROC                                                           P:SYS139
Q  SET S:KEYS(2,20,LZ,*24,BUF,BTD,*SIZE,27,HEX,DEC,X,HEXX,*31,TRNSLT)   P:SYS140
   ERROR,3,(Q(2)&X'C0')=0|(Q(2)&X'1F')=0    IAF,': AF(',P:BD(N),')'     P:SYS141
   ERROR,3,AFA(Q(3),2)|AFA(Q(4),2)|AFA(Q(5),2)|AFA(Q(5),3)         ;    P:SYS142
                  IIAF,': AF(',P:BD(N),')'                              P:SYS143
         GOTO,(Q(2)&X'12')=0    LBL                                     P:SYS144
TSZ      SET      P:S(NUM(AF(Q(5)))=3,AF(Q(5),2)*2,AF(Q(5),3))          P:SYS145
TX       SET    TX,P:S(Q(2)&2,P:BLANKS(TSZ),,('X''',P:BLANKS(TSZ),''''))P:SYS146
         P:BINHEX (BTD,TCBTD+(Q(2)&2)),(SIZE,TSZ),;                     P:SYS147
         (BUF,CF(2)),(SUB),(BIN,#BA(AF(Q(3),2))+AF(Q(4),2))             P:SYS148
TCBTD    SET      TCBTD+3*((Q(2)&2)>0)+TSZ                              P:SYS149
         GOTO     %PEND                                                 P:SYS150
LBL      DO       (Q(2)&8)>0                                            P:SYS151
         DO1      (#1U1=AF(Q(3),2)&(Q(2)&X'40')=0)=0                    P:SYS152
         LOAD     #1U1,(AF(Q(5),2),WA(AF(Q(3),2))+#WA(AF(Q(4),2)),;     P:SYS153
                  #BA(AF(Q(3),2))+BA(AF(Q(4),2))),AF(Q(5),2)            P:SYS154
TSZ      SET  P:S(NUM(AF(Q(5)))=3,P:S(AF(Q(5),2),3,3,5,8,10),AF(Q(5),3))P:SYS155
         DO       TSZ>1&(Q(2)&X'800')=0                                 P:SYS156
         LW,1     SECT(T1)                                              P:SYS157
         MBS,0    BA(=X'00405C00')+1                                    P:SYS158
PLOC     P:TOSECT SECT(T1)                                              P:SYS159
         GEN,8,24 TSZ-1,BA(CF(2))+TCBTD                                 P:SYS160
SECT(T1) P:TOSECT PLOC                                                  P:SYS161
         FIN                                                            P:SYS162
         DO       (Q(2)&X'800')>0                                       P:SYS163
         P:BINDEC (BIN,#1U1),(BUF,CF(2)),(BTD,TCBTD),(SIZE,TSZ),(LZ)    P:SYS164
         ELSE                                                           P:SYS165
         P:BINDEC (BIN,#1U1),(BUF,CF(2)),(BTD,TCBTD),(SIZE,TSZ)         P:SYS166
         FIN                                                            P:SYS167
TCBTD    SET      TCBTD+TSZ                                             P:SYS168
         ELSE                                                           P:SYS169
         LW,#1U1  SECT(T1)                                              P:SYS170
         MBS,#1U1 #BA(AF(Q(3),2))+AF(Q(4),2)-BA(CF(2))-TCBTD            P:SYS171
         GOTO,(Q(2)&1)=0    PLOC                                        P:SYS172
         LW,1     SECT(T1)                                              P:SYS173
         TBS,0    P:S(NUM(AF(Q(6)))=1,AF(Q(6),2),LPTBL)                 P:SYS174
PLOC     P:TOSECT SECT(T1)                                              P:SYS175
         GEN,8,24 AF(Q(5),2),BA(CF(2))+TCBTD                            P:SYS176
         GOTO,P:S(NUM(AF(Q(6)))=1,1,P:FLAG(FLPTBL))|(Q(2)&4)>0 LBL      P:SYS177
LPTBL    EQU      %                                                     P:SYS178
 TEXT '..............................................................',;P:SYS179
   '.. ...........<(+|&.........|%*);.-/.........,%.>...........:#@''=.'P:SYS180
 TEXT '................................................................'P:SYS181
 TEXT '.ABCDEFGHI.......JKLMNOPQR........STUVWXYZ......0123456789......'P:SYS182
LBL,SECT(T1) P:TOSECT PLOC                                              P:SYS183
TCBTD    SET      TCBTD+AF(Q(5),2)                                      P:SYS184
         FIN                                                            P:SYS185
TX       SET      TX,P:BLANKS(P:S((Q(2)&5)>0,TSZ,AF(Q(5),2)))           P:SYS186
%PEND    PEND                                                           P:SYS187
#BA      FNAME                                                          P:SYS188
         PROC                                                           P:SYS189
         PEND     P:S(TCOR(AF,1),BA(AF),4*AF)                           P:SYS190
#WA      FNAME                                                          P:SYS191
         PROC                                                           P:SYS192
         PEND     P:S(TCOR(AF,1),WA(AF),AF/4)                           P:SYS193
LOAD     CNAME    2                                                     P:SYS194
STORE    CNAME    5                                                     P:SYS195
MOVE     CNAME    0                                                     P:SYS196
         PROC                                                           P:SYS197
   ERROR,3,NAME>0&AF(3)>4    'P:SYSTEM:  FIELD LENGTH > 4: AF(',P:BD(I),P:SYS198
         DO       (NAME>0|(ABSVAL(AF(1,3))&3)=0)&(ABSVAL(AF(2,3))&3)=0; P:SYS199
                  &(AF(3)=1|AF(3)=2|AF(3)=4)                            P:SYS200
J        DO       NAME=0                                                P:SYS201
         GEN,4,4,4,20,4,4,4,20    7-(AF(3)&6),2,#X3,AF(1,2),;           P:SYS202
                                  7-(AF(3)&6),5,#X3,AF(2,2)             P:SYS203
         ELSE                                                           P:SYS204
         GEN,4,4,4,20  7-(AF(3)&6),NAME,AF(1),AF(2,2)                   P:SYS205
         FIN                                                            P:SYS206
         ELSE                                                           P:SYS207
         DO1      NAME=2&AF(3)<4                                        P:SYS208
         LI,AF(1) 0                                                     P:SYS209
  LW,#X3   =AF(3)**24+P:S(NAME**-1,AF(2,3),AF(1)*4+4-AF(3),AF(2,3))     P:SYS210
         MBS,#X3  P:S(NAME**-1,AF(1,3),AF(2,3),AF(1)*4+4-AF(3))-;       P:SYS211
                  P:S(NAME**-1,AF(2,3),AF(1)*4+4-AF(3),AF(2,3))         P:SYS212
         FIN                                                            P:SYS213
         PEND                                                           P:SYS214
         PAGE                                                           P:SYS215
*  GENERATE ADD, COMPARE, LOAD, OR MULTIPLY INSTRUCTION--               P:SYS216
*  IMMEDIATE OPERAND IF AF ISN'T INDIRECT, ELSE WORD ADDRESS OPERAND.   P:SYS217
*  NOTHING GENERATED IF INDIRECT TO SAME REGISTER AND LOAD INSTRUCTION. P:SYS218
*        P:LI,REG AF                                                    P:SYS219
P:AI     CNAME    X'20'                                                 P:SYS220
P:CI     CNAME    X'21'                                                 P:SYS221
P:LI     CNAME    X'22'                                                 P:SYS222
P:MI     CNAME    X'23'                                                 P:SYS223
         PROC                                                           P:SYS224
LF       DO1      P:S(TCOR(AF(1),1),0,(CF(2)=AF(1)&NAME=X'22'&AFA(1)))=0P:SYS225
         GEN,8,4,20    NAME+AFA(1)*X'10',CF(2),AF(1)                    P:SYS226
         PEND                                                           P:SYS227
         PAGE                                                           P:SYS228
*  LOAD OR STORE WORD UNLESS LW,X  X OR STW,X  X; THEN NOTHING.         P:SYS229
P:LW     CNAME    X'32'                                                 P:SYS230
P:STW    CNAME    X'35'                                                 P:SYS231
         PROC                                                           P:SYS232
LF       DO1      AFA(1)|(CF(2)=AF(1))=0                                P:SYS233
         GEN,1,7,4,20    AFA(1),NAME,CF(2),AF(1)                        P:SYS234
         PEND                                                           P:SYS235
         PAGE                                                           P:SYS236
*  ANALYZE AF, CHECK FOR KEYWORDS, BUILD LIST SPECIFYING RESULTS.       P:SYS237
*        P:KEYS((CMNDKEYFLD),KEY1,KEY2,KEY3,...,KEYN)                   P:SYS238
P:KEYS   FNAME                                                          P:SYS239
         PROC                                                           P:SYS240
         LOCAL    I,J,K                                                 P:SYS241
RP       SET      0                                                     P:SYS242
I        DO       NUM(AF(1))                                            P:SYS243
J        DO       NUM(AF)-1                                             P:SYS244
K        SET      SCOR(AF(1,I,1),AF(J+1))                               P:SYS245
         GOTO,K=0    %FIN2                                              P:SYS246
         ERROR,3,RP(J,1)=K    DDEF,': AF(',P:BD(I),')'                  P:SYS247
         ERROR,3,RP(J,1)~=K&RP(J,1)>0    CP,': AF(',P:BD(I),')'         P:SYS248
         GOTO,RP(J,1)~=0    %FIN1                                       P:SYS249
RP(J)    SET      K,I                                                   P:SYS250
RP(1,3,I)   SET   J                                                     P:SYS251
         GOTO     %FIN1                                                 P:SYS252
%FIN2    FIN                                                            P:SYS253
         ERROR,3  UK,': AF(',P:BD(I),')'                                P:SYS254
%FIN1    FIN                                                            P:SYS255
         PEND     RP                                                    P:SYS256
         PAGE                                                           P:SYS257
P:BD     FNAME    '0','1','2','3','4','5','6','7','8','9'               P:SYS258
         PROC                                                           P:SYS259
         PEND     S:PT(P:S(AF>9,,P:BD(AF/10)),NAME(AF-AF/10*10+1))      P:SYS260
P:BH     FNAME    '0','1','2','3','4','5','6','7','8','9','A','B',;     P:SYS261
                  'C','D','E','F'                                       P:SYS262
         PROC                                                           P:SYS263
         PEND     S:PT(P:S(AF>15,,P:BH(AF/16)),NAME(AF-AF/16*16+1))     P:SYS264
         PAGE                                                           P:SYS265
P:BLANKS FNAME                                                          P:SYS266
         PROC                                                           P:SYS267
%FIN     SET      ' '                                                   P:SYS268
         DO1      AF(1)-1                                               P:SYS269
%FIN     SET      %FIN,' '                                              P:SYS270
         PEND     S:PT(%FIN)                                            P:SYS271
         PAGE                                                           P:SYS272
*  PROVIDE SYMBOLIC REGISTER DEFINITIONS.                               P:SYS273
P:REGDEF CNAME                                                          P:SYS274
         PROC                                                           P:SYS275
LF       EQU      %                                                     P:SYS276
R0       EQU      0                                                     P:SYS277
R1,X1    EQU      1                                                     P:SYS278
R2,X2    EQU      2                                                     P:SYS279
R3,X3    EQU      3                                                     P:SYS280
R4,X4    EQU      4                                                     P:SYS281
R5,X5    EQU      5                                                     P:SYS282
R6,X6    EQU      6                                                     P:SYS283
R7,X7    EQU      7                                                     P:SYS284
R8,SR1   EQU      8                                                     P:SYS285
R9,SR2   EQU      9                                                     P:SYS286
R10,SR3  EQU      10                                                    P:SYS287
R11,SR4  EQU      11                                                    P:SYS288
R12,D1   EQU      12                                                    P:SYS289
R13,D2   EQU      13                                                    P:SYS290
R14,D3   EQU      14                                                    P:SYS291
R15,D4   EQU      15                                                    P:SYS292
         PEND                                                           P:SYS293
         PAGE                                                           P:SYS294
*  BUILD LCI, PLW, PSW, PLM, AND/OR PSM FOR STACK OPERATIONS.           P:SYS295
P:PSM    CNAME    X'B',9                                                P:SYS296
P:PLM    CNAME    X'A',8                                                P:SYS297
         PROC                                                           P:SYS298
P        SET      S:S((NUM(CF)=2)*8+(NUM(AF)>1)*4+(NUM(AF)>0)*2+;       P:SYS299
   (NUM(AF(1))>1),(0,16),,(AF(1),1),(AF(1,1),AF(1,2)-AF(1,1)+1),,,;     P:SYS300
   (AF(2),AF(1)),,(CF(2),1),,(CF(2),AF(1)))                             P:SYS301
         ERROR,3,(P(1)=0)&(P(2)=0)    IFE                               P:SYS302
P(2)     SET      S:S(P(2)<0,S:S(P(2)=16,P(2)),P(2)+16)                 P:SYS303
LF       DO1      P(2)~=1                                               P:SYS304
         LCI      P(2)                                                  P:SYS305
         GEN,8,4,20    NAME((P(2)=1)+1),P(1),TSTACK                     P:SYS306
         PEND                                                           P:SYS307
         PAGE                                                           P:SYS308
*  GENERATE FORTRAN-LIKE SUBROUTINE CALLING SEQUENCE.                   P:SYS309
P:CALL   CNAME                                                          P:SYS310
         PROC                                                           P:SYS311
LF       LI,14    NUM(AF)-1                                             P:SYS312
         BAL,15   AF(1)                                                 P:SYS313
P        DO       NUM(AF)-1                                             P:SYS314
         GEN,1,7,24    AFA(P+1),1-TCOR(AF(P+1),S:EXT),WA(AF(P+1))       P:SYS315
         FIN                                                            P:SYS316
         PEND                                                           P:SYS317
         PAGE                                                           P:SYS318
*  GENERATE MOVE OR COMPARE BYTE STRING INSTRUCTION SEQUENCE            P:SYS319
P:MOVE   CNAME    X'61'                                                 P:SYS320
P:MBS    CNAME    X'61'                                                 P:SYS321
P:COMP   CNAME    X'60'                                                 P:SYS322
P:CBS    CNAME    X'60'                                                 P:SYS323
         PROC                                                           P:SYS324
P        SET      S:KEYS(2,*27,*FROM,*TO,SIZE,TEXTC)                    P:SYS325
         ERROR,3,NUM(AF)<2|NUM(AF)>3|AFA(P(3),2)|AFA(P(4),2)         IFEP:SYS326
         DO       (P(2)&2)>0                                            P:SYS327
LF(1)    LI,#1U1  BA(AF(P(4),2))                                        P:SYS328
         LB,#1    WA(AF(P(3),2))                                        P:SYS329
         STB,#1   #1U1                                                  P:SYS330
         GEN,8,4,20    NAME,#1U1,BA(WA(AF(P(3),2)))+1-BA(AF(P(4),2))    P:SYS331
         ELSE                                                           P:SYS332
         DO       AFA(P(5),2)                                           P:SYS333
LF(1)    LI,#1U1  BA(AF(P(4),2))                                        P:SYS334
         DO       P:S(TCOR(AF(P(5),2),1),,AF(P(5),2)<16)                P:SYS335
         STB,AF(P(5),2)    #1U1                                         P:SYS336
         ELSE                                                           P:SYS337
         LW,#1    AF(P(5),2)                                            P:SYS338
         STB,#1   #1U1                                                  P:SYS339
         FIN                                                            P:SYS340
         ELSE                                                           P:SYS341
LF(1)    LW,#1U1  =AF(P(5),2)**24+BA(AF(P(4),2))                        P:SYS342
         FIN                                                            P:SYS343
         GEN,8,4,20    NAME,#1U1,BA(AF(P(3),2))-BA(AF(P(4),2))          P:SYS344
         FIN                                                            P:SYS345
         PEND                                                           P:SYS346
         PAGE                                                           P:SYS347
*  GENERATE CAL1,2, FPT, AND TEXTC.                                     P:SYS348
P:MESSAGE CNAME   0                                                     P:SYS349
P:PRINT  CNAME    1                                                     P:SYS350
P:TYPE   CNAME    2                                                     P:SYS351
         PROC                                                           P:SYS352
         DO       NAME=1                                                P:SYS353
         DO1      TCOR(M:LL,S:FR)                                       P:SYS354
         REF      M:LL                                                  P:SYS355
         ELSE                                                           P:SYS356
         DO1      TCOR(M:OC,S:FR)                                       P:SYS357
         REF      M:OC                                                  P:SYS358
         FIN                                                            P:SYS359
LF(1)    CAL1,2   SECT(T1)                                              P:SYS360
PLOC     P:TOSECT SECT(T1)                                              P:SYS361
VT       SET      P:S(NUM(CF)=2,T1,(CF(2)=1)+1)                         P:SYS362
LF(2)    GEN,8,25,63    NAME,1,SECT(VT)+3*(VT=T1)                       P:SYS363
SECT(T1) P:TOSECT SECT(VT)                                              P:SYS364
LF(3)    TEXTC    AF                                                    P:SYS365
SECT(VT) P:TOSECT PLOC                                                  P:SYS366
         PEND                                                           P:SYS367
         PAGE                                                           P:SYS368
*  ANALYZE I-O ERROR AND ABNORMAL RETURNS.                              P:SYS369
P:ABNERR CNAME    1,2,3,4,5,6,7,8,9,10,11,12,19,20,21,22,23,24,28,29,;  P:SYS370
  46,63,64,65,66,67,68,69,70,71,73,74,81,84,85,86,87,X'75'              P:SYS371
         PROC                                                           P:SYS372
         LOCAL    I,J,K,L,N                                             P:SYS373
LF       LB,#1    10                                                    P:SYS374
Q        SET      P:KEYS((AF),1,2,3,(BOF,4),(EOD,TM,5),(EOF,6),;        P:SYS375
   (LOSTDATA,7),8,9,A,B,C,13,14,15,16,17,18,(EOT,1C),(BOT,1D),;         P:SYS376
   3E,3F,40,(READERR,41),42,43,44,(WRITERR,45),46,47,(NODRIVE,49),;     P:SYS377
   4A,51,54,55,56,(NODISC,57),75,(EXIT,ERROR,ABORT,ELSE,MERC),END,;     P:SYS378
   ERRMSG)                                                              P:SYS379
N        SET      NUM(NAME)                                             P:SYS380
         GOTO,Q(N+2,1)=0    I                                           P:SYS381
         CLM,#1   P:DL(5,6)                                             P:SYS382
         BCR,9    AF(Q(N+2,2),2)                                        P:SYS383
I        DO       NUM(AF)                                               P:SYS384
         GOTO,Q(1,3,I)>N    %FIN                                        P:SYS385
         CI,#1    NAME(Q(1,3,I))                                        P:SYS386
         BE       AF(I,2)                                               P:SYS387
%FIN     FIN                                                            P:SYS388
         DO1      Q(N+3,1)                                              P:SYS389
         P:ERRMSG                                                       P:SYS390
         GOTO,Q(N+1,1)+1    %PEND,J,J,J,L,K                             P:SYS391
L        B        AF(Q(N+1,2),2)                                        P:SYS392
         GOTO     %PEND                                                 P:SYS393
J        CAL1,9   Q(N+1,1)                                              P:SYS394
         GOTO     %PEND                                                 P:SYS395
K        CAL1,2   =X'10000000'                                          P:SYS396
%PEND    PEND                                                           P:SYS397
         PAGE                                                           P:SYS398
*  GENERATE MBS,0 TO ZERO, BLANK, OR * A BUFFER AREA.                   P:SYS399
*        P:ZERO   (BUF,ADDR),(SIZE,VALUE),(BTD,VALUE)                   P:SYS400
*        P:BLANK  (BUF,ADDR),(SIZE,VALUE),(BTD,VALUE)                   P:SYS401
P:ZERO   CNAME    0                                                     P:SYS402
P:BLANK  CNAME    1                                                     P:SYS403
P:STAR   CNAME    2                                                     P:SYS404
         PROC                                                           P:SYS405
P        SET      S:KEYS(2,*29,*BUF,*SIZE,BTD)                          P:SYS406
LF       LW,1     =AF(P(4),2)**24+BA(AF(P(3),2))+AF(P(5),2)             P:SYS407
         MBS,0    BA(=X'00405C00')+NAME                                 P:SYS408
         PEND                                                           P:SYS409
         PAGE                                                           P:SYS410
*  CONVERT SINGLE-PRECISION BINARY TO EBCDIC INTEGER.                   P:SYS411
*        P:BINEBC (BIN,ADDR),(BUF,ADDR),(BTD,VALUE),(SIZE,VALUE)        P:SYS412
P:BINDEC CNAME                                                          P:SYS413
P:BINEBC CNAME                                                          P:SYS414
         PROC                                                           P:SYS415
P        SET      S:KEYS(2,*27,*BIN,BUF,BTD,*SIZE,31,(LZ,NOLZ))         P:SYS416
         LOCAL    I                                                     P:SYS417
LF       P:LW,#1U1    AF(P(3),2)                                        P:SYS418
         LI,#4    AF(P(6),2)                                            P:SYS419
         LI,#X1   AF(P(5),2)+AF(P(6),2)-1                               P:SYS420
I        LI,#1    0                                                     P:SYS421
         DW,#1    =10                                                   P:SYS422
         AI,#1    '0'                                                   P:SYS423
         STB,#1   AF(P(4),2),#X1                                        P:SYS424
         DO       (P(2)&1)=0                                            P:SYS425
         CI,#1U1  0                                                     P:SYS426
         BEZ      %+3                                                   P:SYS427
         FIN                                                            P:SYS428
         AI,#X1   -1                                                    P:SYS429
         BDR,#4   I                                                     P:SYS430
         PEND                                                           P:SYS431
         PAGE                                                           P:SYS432
*  CONVERT SINGLE-PRECISION BINARY TO EBCDIC HEX.                       P:SYS433
*        P:BINHEX (BIN,ADDR),(BUF,ADDR),(BTD,VALUE),(SIZE,VALUE)        P:SYS434
P:BINHEX CNAME                                                          P:SYS435
         PROC                                                           P:SYS436
P        SET      S:KEYS(2,*25,*BIN,BUF,BTD,*SIZE,30,SUB,(NOLZ,LZ))     P:SYS437
    DO       AF(P(6),2)>8|AFA(P(6),2)|(P(2)&2)>0|AFA(P(4),2)|AFA(P(5),2)P:SYS438
LF       P:LI,#X1 BA(AF(P(3),2))                                        P:SYS439
         DO       AFA(P(4),2)|AFA(P(5),2)                               P:SYS440
%FIN     SET      2                                                     P:SYS441
         DO       (P(2)&X'20')>0                                        P:SYS442
%FIN     SET      0                                                     P:SYS443
         DO       AFA(P(4),2)                                           P:SYS444
         LW,#X2   AF(P(4),2)                                            P:SYS445
         SLS,#X2  2                                                     P:SYS446
         ELSE                                                           P:SYS447
         LI,#X2   BA(AF(P(4),2))                                        P:SYS448
         FIN                                                            P:SYS449
         FIN                                                            P:SYS450
         DO1      (P(2)&X'10')>0                                        P:SYS451
         GEN,4,4,4,20    2+AFA(P(5),2),%FIN,#X2,WA(AF(P(5),2))          P:SYS452
         ELSE                                                           P:SYS453
         LI,#X2   BA(AF(P(4),2))+BA(AF(P(5),2))                         P:SYS454
         FIN                                                            P:SYS455
         P:LI,#4  AF(P(6),2)                                            P:SYS456
         BAL,#1   SBNHX+7*(AFA(P(6),2)=0&AF(P(6),2))                    P:SYS457
         GOTO,P:FLAG(FSBNHX)    %FIN                                    P:SYS458
PLOC     P:TOSECT SECT(T1)                                              P:SYS459
         AI,#X1   1                                                     P:SYS460
         AI,#X2   1                                                     P:SYS461
SBNHX    LB,#X3   0,#X1                                                 P:SYS462
         SLS,#X3  -4                                                    P:SYS463
         LB,#X3   CHEX,#X3                                              P:SYS464
         STB,#X3  0,#X2                                                 P:SYS465
         BDR,#4   %+2                                                   P:SYS466
         B        *#1                                                   P:SYS467
         AI,#X2   1                                                     P:SYS468
         LB,#X3   0,#X1                                                 P:SYS469
         AND,#X3  =X'F'                                                 P:SYS470
         LB,#X3   CHEX,#X3                                              P:SYS471
         STB,#X3  0,#X2                                                 P:SYS472
         BDR,#4   SBNHX-2                                               P:SYS473
         B        *#1                                                   P:SYS474
SECT(T1) P:TOSECT PLOC                                                  P:SYS475
         ELSE                                                           P:SYS476
         LOCAL    I                                                     P:SYS477
LF       P:LW,#1U1    AF(P(3),2)                                        P:SYS478
         LI,#4    AF(P(6),2)                                            P:SYS479
         LI,#X1   AF(P(5),2)+AF(P(6),2)-1                               P:SYS480
I        LW,#X3   #1U1                                                  P:SYS481
         AND,#X3  =X'F'                                                 P:SYS482
         LB,#X3   CHEX,#X3                                              P:SYS483
         STB,#X3  AF(P(4),2),#X1                                        P:SYS484
         AI,#X1   -1                                                    P:SYS485
         SLS,#1U1 -4                                                    P:SYS486
         DO       P(2)&1                                                P:SYS487
         LW,#X3   #1U1                                                  P:SYS488
         BEZ      %+2                                                   P:SYS489
         FIN                                                            P:SYS490
         BDR,#4   I+(P(2)&1)                                            P:SYS491
%FIN     FIN                                                            P:SYS492
         GOTO,P:FLAG(FCHEX)    %PEND                                    P:SYS493
PLOC     P:TOSECT SECT(T1)                                              P:SYS494
CHEX     TEXT     '0123456789ABCDEF'                                    P:SYS495
SECT(T1) P:TOSECT PLOC                                                  P:SYS496
%PEND    PEND                                                           P:SYS497
         PAGE                                                           P:SYS498
*  CONVERT EBCDIC INTEGER TO SINGLE-PRECISION BINARY.                   P:SYS499
*        P:EBCBIN (BIN,ADDR),(BUF,ADDR),(BTD,VALUE),(SIZE,VALUE),       P:SYS500
*                 (ERR,ADDR),(ERROR),(ABORT)                            P:SYS501
P:DECBIN CNAME    X'020',X'049',X'049'                                  P:SYS502
P:EBCBIN CNAME    X'020',X'049',X'049'                                  P:SYS503
         PROC                                                           P:SYS504
P    SET    S:KEYS(2,*24,NULL,*BIN,BUF,BTD,*SIZE,ERR,30,ABORT,ERROR)    P:SYS505
         DO       SCOR(AF(P(7),2),TEXTC)                                P:SYS506
LF       LI,#X1   1                                                     P:SYS507
         LB,#1    AF(P(5),2)                                            P:SYS508
         DO1      (P(2)&X'80')>0                                        P:SYS509
         BEZ      AF(P(3),2)                                            P:SYS510
         ELSE                                                           P:SYS511
LF       P:LI,#X1 AF(P(6),2)                                            P:SYS512
         P:LI,#1  AF(P(7),2)                                            P:SYS513
         FIN                                                            P:SYS514
         P:LI,#X3     AF(P(5),2)                                        P:SYS515
         BAL,#X2  SEBN                                                  P:SYS516
         DO       (P(2)&4)>0                                            P:SYS517
         B        AF(P(8),2)                                            P:SYS518
         ELSE                                                           P:SYS519
         GEN,12,20    NAME((P(2)&3)+1),((P(2)&3)+1)                     P:SYS520
         FIN                                                            P:SYS521
         P:STW,#1U1   AF(P(4),2)                                        P:SYS522
         GOTO,P:FLAG(FEBCBIN)    %PEND                                  P:SYS523
PLOC     P:TOSECT SECT(T1)                                              P:SYS524
SEBN     LI,#1U1  0                                                     P:SYS525
         LB,#4    *#X3,#X1                                              P:SYS526
         CI,#4    X'40'                                                 P:SYS527
         BE       %+6                                                   P:SYS528
         CLM,#4   LIMF09                                                P:SYS529
         BCS,9    0,#X2                                                 P:SYS530
         AI,#4    -'0'                                                  P:SYS531
         MI,#1U1  10                                                    P:SYS532
         AW,#1U1  #4                                                    P:SYS533
         AI,#X1   1                                                     P:SYS534
         BDR,#1   %-9                                                   P:SYS535
         B        1,#X2                                                 P:SYS536
         GOTO,P:FLAG(FLIMF09)    LBL                                    P:SYS537
         BOUND    8                                                     P:SYS538
LIMF09   DATA     '0','9'                                               P:SYS539
LBL,SECT(T1) P:TOSECT PLOC                                              P:SYS540
%PEND    PEND                                                           P:SYS541
         PAGE                                                           P:SYS542
*  CONVERT EBCDIC HEX TO SINGLE-PRECISION BINARY.                       P:SYS543
*        P:HEXBIN (BIN,ADDR),(BUF,ADDR),(BTD,VALUE),(SIZE,VALUE)        P:SYS544
*                 (ERR,ADDR),(ERROR),(ABORT)                            P:SYS545
P:HEXBIN CNAME    X'020',X'049',X'049'                                  P:SYS546
         PROC                                                           P:SYS547
P    SET    S:KEYS(2,*24,NULL,*BIN,BUF,BTD,*SIZE,ERR,30,ABORT,ERROR)    P:SYS548
         DO       SCOR(AF(P(7),2),TEXTC)                                P:SYS549
LF       LI,#X1   1                                                     P:SYS550
         LB,#1    AF(P(5),2)                                            P:SYS551
         DO1      (P(2)&X'80')>0                                        P:SYS552
         BEZ      AF(P(3),2)                                            P:SYS553
         ELSE                                                           P:SYS554
LF       P:LI,#X1 AF(P(6),2)                                            P:SYS555
         P:LI,#1  AF(P(7),2)                                            P:SYS556
         FIN                                                            P:SYS557
         P:LI,#X3     AF(P(5),2)                                        P:SYS558
         BAL,#X2  SHXBN                                                 P:SYS559
         DO       (P(2)&4)>0                                            P:SYS560
         B        AF(P(8),2)                                            P:SYS561
         ELSE                                                           P:SYS562
         GEN,12,20    NAME((P(2)&3)+1),(P(2)&3)+1                       P:SYS563
         FIN                                                            P:SYS564
         P:STW,#1U1   AF(P(4),2)                                        P:SYS565
         GOTO,P:FLAG(FHEXBIN)    %PEND                                  P:SYS566
PLOC     P:TOSECT SECT(T1)                                              P:SYS567
SHXBN    LI,#1U1  0                                                     P:SYS568
         LB,#4    *#X3,#X1                                              P:SYS569
         CLM,#4   LIMF09                                                P:SYS570
         BCR,9    %+6                                                   P:SYS571
         CI,#4    X'40'                                                 P:SYS572
         BE       %+7                                                   P:SYS573
         CLM,#4   LIMC16                                                P:SYS574
         BCS,9    0,#X2                                                 P:SYS575
         AI,#4    X'FA'-X'C1'                                           P:SYS576
         AI,#4    -'0'                                                  P:SYS577
         SLS,#1U1 4                                                     P:SYS578
         AW,#1U1  #4                                                    P:SYS579
         AI,#X1   1                                                     P:SYS580
         BDR,#1   %-12                                                  P:SYS581
         B        1,#X2                                                 P:SYS582
         BOUND    8                                                     P:SYS583
LIMC16   DATA     'A','F'                                               P:SYS584
         DO1      P:FLAG(FLIMF09)=0                                     P:SYS585
LIMF09   DATA     '0','9'                                               P:SYS586
SECT(T1) P:TOSECT PLOC                                                  P:SYS587
%PEND    PEND                                                           P:SYS588
         PAGE                                                           P:SYS589
P:ERRMSG CNAME                                                          P:SYS590
         PROC                                                           P:SYS591
LF       BAL,#4   P:ERRMSG                                              P:SYS592
         GOTO,P:FLAG(FERRMSG)    %PEND                                  P:SYS593
         LOCAL    I,J,K,L,N                                             P:SYS594
N        DO1      TCOR(M:DO,S:FR)                                       P:SYS595
         REF      M:DO                                                  P:SYS596
         DO1      TCOR(M:XX,S:FR)                                       P:SYS597
         REF      M:XX                                                  P:SYS598
         DO1      TCOR(J:DCBLINK,S:FR)                                  P:SYS599
         REF      J:DCBLINK                                             P:SYS600
P:ERRMSG DSECT    T1=2                                                  P:SYS601
         STW,#4   #4TMP                                                 P:SYS602
         LH,#1    M:XX                                                  P:SYS603
         CI,#1    X'20'                                                 P:SYS604
         BAZ      %+2                                                   P:SYS605
         CAL1,1   CLSXX                                                 P:SYS606
         LI,#1U1  X'1FFFF'                                              P:SYS607
         LW,#1    8                                                     P:SYS608
         AI,#1    -1                                                    P:SYS609
         STS,#1   R8TMP                                                 P:SYS610
         LW,#1    10                                                    P:SYS611
         STS,#1   R10TMP                                                P:SYS612
         SLD,#1   -24                                                   P:SYS613
         SLS,#1   1                                                     P:SYS614
         SLD,#1   7                                                     P:SYS615
         MTB,3    #1                                                    P:SYS616
         STW,#1   KBF                                                   P:SYS617
         CAL1,1   OPNXX                                                 P:SYS618
         CAL1,1   RDXX                                                  P:SYS619
         LW,#1U1  M:XX+13                                               P:SYS620
         AI,#1U1  -2                                                    P:SYS621
J        CAL1,1   WRTDO                                                 P:SYS622
         LW,#1U1  =16**24+BA(RBF)+2                                     P:SYS623
         MBS,#1U1 BA(TXDCB)-BA(RBF)-2                                   P:SYS624
         P:BINHEX (BIN,BA(R8TMP)+1),(SIZE,5),(BUF,RBF),(BTD,5),(SUB)    P:SYS625
         LI,#1U1  10                                                    P:SYS626
         AI,10    0                                                     P:SYS627
         BLEZ     L                                                     P:SYS628
         LW,#1    R10TMP                                                P:SYS629
         BLEZ     L                                                     P:SYS630
         LW,#X2   J:DCBLINK                                             P:SYS631
         B        %+2                                                   P:SYS632
K        AW,#X2   #X3                                                   P:SYS633
         AI,#X2   1                                                     P:SYS634
         LB,#X3   *#X2                                                  P:SYS635
         BEZ      L                                                     P:SYS636
         AI,#X3   4                                                     P:SYS637
         SLS,#X3  -2                                                    P:SYS638
         CW,#1    *#X2,#X3                                              P:SYS639
         BNE      K                                                     P:SYS640
         LB,#X1   *#X2                                                  P:SYS641
         SLS,#X2  2                                                     P:SYS642
         LI,#1U1  BA(RBF)+18                                            P:SYS643
         STB,#X1  #1U1                                                  P:SYS644
         LW,#1    #X2                                                   P:SYS645
         MBS,#1   1                                                     P:SYS646
         SW,#1U1  =BA(RBF)+1        IN CASE LOADED INTO LIBRARY         P:SYS647
L        CAL1,1   WRTDO                                                 P:SYS648
         CAL1,1   CLSDO                                                 P:SYS649
         CAL1,1   CLSXX                                                 P:SYS650
         B        *#4TMP                                                P:SYS651
I        CAL1,1   SETXX                                                 P:SYS652
         LW,#1U1  =20**24+BA(RBF)+2                                     P:SYS653
         MBS,#1U1 BA(TXBDER)-BA(RBF)-2                                  P:SYS654
         LI,#1U1  21                                                    P:SYS655
         B        J                                                     P:SYS656
OPNXX    GEN,8,24 X'14',M:XX                                            P:SYS657
         DATA     X'C1000009',I,I,1,X'01000202'                         P:SYS658
         TEXTC    'ERRMSG'                                              P:SYS659
         DATA     X'02010202',':SYS','    '                             P:SYS660
RDXX     GEN,8,24 X'10',M:XX                                            P:SYS661
         DATA     X'38000010',RBF,80,KBF                                P:SYS662
CLSXX    GEN,8,24 X'15',M:XX                                            P:SYS663
         DATA     X'80000000',2                                         P:SYS664
SETXX    GEN,8,24 6,M:XX                                                P:SYS665
         DATA     X'C0000000',,                                         P:SYS666
WRTDO    GEN,8,24 X'11',M:DO                                            P:SYS667
         DATA     X'34000010',RBF,1**31+#1U1,1                          P:SYS668
CLSDO    GEN,8,24 X'15',M:DO                                            P:SYS669
         DATA     X'80000000',2                                         P:SYS670
TXDCB    TEXT     'AT       ON DCB'                                     P:SYS671
TXBDER   TEXT     'BAD ERRMSG FILE READ'                                P:SYS672
P:ERMSG0 DSECT    0                                                     P:SYS673
RBF      TEXT     ' '                                                   P:SYS674
         RES      20-%+RBF                                              P:SYS675
KBF      RES      1                                                     P:SYS676
R8TMP    DATA                                                           P:SYS677
R10TMP   DATA                                                           P:SYS678
#4TMP    RES      1                                                     P:SYS679
         USECT    N                                                     P:SYS680
%PEND    PEND                                                           P:SYS681
         PAGE                                                           P:SYS682
P:DATA   CNAME                                                          P:SYS683
         PROC                                                           P:SYS684
         BOUND    P:S(NUM(CF)=2,4,P:S(CF(2)=8,4,8))                     P:SYS685
LF       DATA,P:S(NUM(CF)-1,4,CF(2))    NUM(AF),AF                      P:SYS686
         PEND                                                           P:SYS687
         PAGE                                                           P:SYS688
*  SCAN BUF, STOPPING ON SPECIFIED DELIMITERS, TRANSFERRING FIELD TO    P:SYS689
*  OUTBUF IN TEXTC, TAKING SPECIFIED ACTION AT END OF FIELD.            P:SYS690
P:SCAN   CNAME    0                                                     P:SYS691
P:SCANSU CNAME    1                                                     P:SYS692
         PROC                                                           P:SYS693
P        SET      S:KEYS(2,*26,DELIM,BUF,BTD,OUTBUF,END,SIZE,;          P:SYS694
                  *22,LAST,LC,BIAS,STCF,*16,SKIP,SCANPT)                P:SYS695
LF(1)    EQU      %                                                     P:SYS696
LF(2),AF(P(14),2)    EQU    SPDPNTR                                     P:SYS697
         GOTO,(P(2)&X'20')=0    LBL                                     P:SYS698
         P:LI,#X2 AF(P(3),2)                                            P:SYS699
         STW,#X2  DELIMS                                                P:SYS700
LBL      GOTO,(P(2)&X'8000')=0    LBL                                   P:SYS701
         P:LI,#1U1    AF(P(13),2)                                       P:SYS702
         STW,#1U1 SKPCHR                                                P:SYS703
LBL      GOTO,(P(2)&X'18')=0    LBL                                     P:SYS704
         DO       SCOR(AF(P(8),2),TEXTC)                                P:SYS705
         LI,#X3   BA(WA(BA(AF(P(4),2))+AF(P(5),2)))+1                   P:SYS706
         ELSE                                                           P:SYS707
         LI,#X3   BA(AF(P(4),2))+AF(P(5),2)                             P:SYS708
         FIN                                                            P:SYS709
         STW,#X3  SPDPNTR                                               P:SYS710
LBL      GOTO,(P(2)&4)=0    LBL                                         P:SYS711
         P:LI,#1  AF(P(6),2)                                            P:SYS712
         STW,#1   OUTBUFF                                               P:SYS713
LBL      GOTO,(P(2)&1)=0    LBL                                         P:SYS714
         DO       SCOR(AF(P(8),2),TEXTC)                                P:SYS715
         DO       (P(2)&X'10')>0                                        P:SYS716
         LB,#4    WA(BA(AF(P(4),2))+AF(P(5),2))                         P:SYS717
         ELSE                                                           P:SYS718
         DO       NUM(AF(P(8)))=3                                       P:SYS719
         LB,#4    AF(P(8),3)                                            P:SYS720
         ELSE                                                           P:SYS721
         LW,#4    SPDPNTR                                               P:SYS722
         SLS,#4   -2                                                    P:SYS723
         LB,#4    *#4                                                   P:SYS724
         FIN                                                            P:SYS725
         FIN                                                            P:SYS726
         ELSE                                                           P:SYS727
         P:LI,#4  AF(P(8),2)                                            P:SYS728
         FIN                                                            P:SYS729
         SLS,#4   16                                                    P:SYS730
         DO1      (P(2)&X'80')>0                                        P:SYS731
         P:AI,#4  AF(P(11),2)                                           P:SYS732
         STW,#4   SPDPNTR+1                                             P:SYS733
LBL      GOTO,NAME=1    %PEND                                           P:SYS734
         BAL,#4   SCAN                                                  P:SYS735
         DO1      (P(2)&2)>0                                            P:SYS736
         BCS,1    AF(P(7),2)                                            P:SYS737
         DO1      (P(2)&X'200')>0                                       P:SYS738
         BCS,4    AF(P(9),2)                                            P:SYS739
         DO1      (P(2)&X'100')>0                                       P:SYS740
         LC       AF(P(10),2),#X3                                       P:SYS741
         DO1      (P(2)&X'40')>0                                        P:SYS742
         STCF     AF(P(12),2)                                           P:SYS743
         GOTO,P:FLAG(FSCAN)    %PEND                                    P:SYS744
         LOCAL    I,J,K                                                 P:SYS745
PLOC     P:TOSECT SECT(T1)                                              P:SYS746
SCAN     LW,#X3   =1**31                                                P:SYS747
         STS,#X3  SPDPNTR+1                                             P:SYS748
         STB,#X3  *OUTBUFF                                              P:SYS749
         LI,#1    X'7FFF'                                               P:SYS750
         AH,#1    SPDPNTR+1                                             P:SYS751
         BNC      *#4                                                   P:SYS752
         LI,#1U1  K                                                     P:SYS753
         LI,#1    1                                                     P:SYS754
         BAL,#X1  SB                                                    P:SYS755
         BE       %-1                                                   P:SYS756
I        LB,#X3   *DELIMS                                               P:SYS757
         CB,#X2   *DELIMS,#X3                                           P:SYS758
         BE       J                                                     P:SYS759
         BDR,#X3  %-2                                                   P:SYS760
         B        *#1U1                                                 P:SYS761
K        MTB,1    *OUTBUFF                                              P:SYS762
         LB,#X1   *OUTBUFF                                              P:SYS763
         STB,#X2  *OUTBUFF,#X1                                          P:SYS764
         BAL,#X1  SB                                                    P:SYS765
         BNE      I                                                     P:SYS766
         LI,#1U1  J+2                                                   P:SYS767
SB       LW,#X2   SPDPNTR                                               P:SYS768
         MSP,#1   SPDPNTR                                               P:SYS769
         BSO      *#4                                                   P:SYS770
         LB,#X2   0,#X2                                                 P:SYS771
         CW,#X2   SKPCHR                                                P:SYS772
         B        0,#X1                                                 P:SYS773
J        BAL,#X1  SB                                                    P:SYS774
         BE       %-1                                                   P:SYS775
         LI,#X2   -1                                                    P:SYS776
         MSP,#X2  SPDPNTR                                               P:SYS777
         B        *#4                                                   P:SYS778
SECT(T1) P:TOSECT SECT(1)                                               P:SYS779
         BOUND    8                                                     P:SYS780
SPDPNTR  DATA     ,                                                     P:SYS781
OUTBUFF  DATA                                                           P:SYS782
DELIMS   DATA                                                           P:SYS783
SKPCHR   DATA     ' '                                                   P:SYS784
SECT(1)  P:TOSECT PLOC                                                  P:SYS785
%PEND    PEND                                                           P:SYS786
         PAGE                                                           P:SYS787
P:SCANBR CNAME                                                          P:SYS788
         PROC                                                           P:SYS789
P        SET      S:KEYS(2,*28,END,LAST,LC,STCF)                        P:SYS790
LF       DO1      (P(2)&8)>0                                            P:SYS791
         BCS,1    AF(P(3),2)                                            P:SYS792
         DO1      (P(2)&4)>0                                            P:SYS793
         BCS,4    AF(P(4),2)                                            P:SYS794
         DO1      (P(2)&2)>0                                            P:SYS795
         LC       AF(P(5),2),#X3                                        P:SYS796
         DO1      P(2)&1                                                P:SYS797
         STCF     AF(P(6),2)                                            P:SYS798
         PEND                                                           P:SYS799
         PAGE                                                           P:SYS800
*  BUILD PARAMETER TABLE FOR P:SCAN (SPDPNTR, OUTBUFF, DELIMS, SKIP).   P:SYS801
P:SCANPT CNAME                                                          P:SYS802
         PROC                                                           P:SYS803
P   SET   S:KEYS(2,*26,DELIM,BUF,BTD,OUTBUF,BIAS,SIZE,*20,SKIP)         P:SYS804
         ERROR,3,AFA(P(3),2)|AFA(P(4),2)|AFA(P(5),2)|AFA(P(6),2);       P:SYS805
                  |AFA(P(7),2)|AFA(P(8),2)|AFA(P(9),2)    IIAF          P:SYS806
LF       EQU      %                                                     P:SYS807
         BOUND    8                                                     P:SYS808
         DO       (P(2)&X'1B')>0                                        P:SYS809
         DO       SCOR(AF(P(8),2),TEXTC)                                P:SYS810
   GEN,32,16,16   BA(WA(BA(AF(P(4),2))+AF(P(5),2)))+1,0,AF(P(7),2)      P:SYS811
         ELSE                                                           P:SYS812
   GEN,32,16,16   BA(AF(P(4),2))+AF(P(5),2),AF(P(8),2),AF(P(7),2)       P:SYS813
         FIN                                                            P:SYS814
         FIN                                                            P:SYS815
         DO1      (P(2)&X'824')>0                                       P:SYS816
         DATA     WA(AF(P(6),2)),WA(AF(P(3),2)),;                       P:SYS817
                  P:S((P(2)&X'800')>0,' ',AF(P(9),2))                   P:SYS818
         PEND                                                           P:SYS819
         PAGE                                                           P:SYS820
P:TC     CNAME    0                                                     P:SYS821
P:TX     CNAME    1                                                     P:SYS822
         PROC                                                           P:SYS823
         BOUND    4                                                     P:SYS824
LF       DO1      SCOR(C,CF)>0                                          P:SYS825
         DATA     NUM(AF)                                               P:SYS826
I        DO       NUM(AF)*(NAME=0)                                      P:SYS827
         TEXTC    AF(I)                                                 P:SYS828
         FIN                                                            P:SYS829
I        DO       NUM(AF)*(NAME=1)                                      P:SYS830
         TEXT     AF(I)                                                 P:SYS831
         FIN                                                            P:SYS832
         DO1      SCOR(0,CF)>0                                          P:SYS833
         DATA     0                                                     P:SYS834
         PEND                                                           P:SYS835
         PAGE                                                           P:SYS836
*  SEARCH TEXTC TABLE FOR MATCH WITH TEXTC STRING, RETURN STRING COUNT. P:SYS837
P:SEARCH CNAME                                                          P:SYS838
         PROC                                                           P:SYS839
P        SET      S:KEYS(2,*25,BUF,TABLE,ERR,COUNT,B)                   P:SYS840
LF       EQU      %                                                     P:SYS841
         GOTO,(P(2)&X'40')=0    LBL                                     P:SYS842
         P:LI,#X1 BA(AF(P(3),2))                                        P:SYS843
         STW,#X1  BABUF                                                 P:SYS844
LBL      DO       (P(2)&X'20')>0                                        P:SYS845
         P:LI,#X3 BA(AF(P(4),2))                                        P:SYS846
         STW,#X3  BATBL                                                 P:SYS847
         FIN                                                            P:SYS848
         BAL,#X2  TBLSRCH                                               P:SYS849
         DO       (P(2)&X'10')>0                                        P:SYS850
         B        AF(P(5),2)                                            P:SYS851
         ELSE                                                           P:SYS852
         NOP                                                            P:SYS853
         FIN                                                            P:SYS854
         DO1      (P(2)&8)>0                                            P:SYS855
         P:STW,#X1    AF(P(6),2)                                        P:SYS856
         DO1      (P(2)&4)>0                                            P:SYS857
         B        AF(P(7),2),#X1                                        P:SYS858
         GOTO,P:FLAG(FTBLSRCH)    %PEND                                 P:SYS859
         LOCAL    I                                                     P:SYS860
PLOC     P:TOSECT SECT(T1)                                              P:SYS861
TBLSRCH  LW,#X1   BABUF                                                 P:SYS862
         LB,#X3   0,#X1                                                 P:SYS863
         AI,#X3   1                                                     P:SYS864
         STB,#X3  BABUF                                                 P:SYS865
         LI,#X1   1                                                     P:SYS866
         LW,#X3   BATBL                                                 P:SYS867
I        LB,#4    0,#X3                                                 P:SYS868
         BEZ      0,#X2                                                 P:SYS869
         LW,#1    #X3                                                   P:SYS870
         LW,#1U1  BABUF                                                 P:SYS871
         CBS,#1   0                                                     P:SYS872
         BE       1,#X2                                                 P:SYS873
         AI,#X1   1                                                     P:SYS874
         AW,#X3   #4                                                    P:SYS875
         AND,#X3  =X'FFFFFFFC'                                          P:SYS876
         AI,#X3   4                                                     P:SYS877
         B        I                                                     P:SYS878
SECT(T1) P:TOSECT SECT(1)                                               P:SYS879
BATBL    RES      1                                                     P:SYS880
BABUF    RES      1                                                     P:SYS881
SECT(1)  P:TOSECT PLOC                                                  P:SYS882
%PEND    PEND                                                           P:SYS883
         PAGE                                                           P:SYS884
P:FNDVLP CNAME    (5,4,,3),(11,6)                                       P:SYS885
         PROC                                                           P:SYS886
P        SET      S:KEYS(2,*24,FPARAM,FLP,VLP,*TYPE,*ENTADR,NONE,ERROR) P:SYS887
%FIN1    SET      NAME(1,P(2)**-5)                                      P:SYS888
         DO       AFA(P(%FIN1),2)                                       P:SYS889
         P:LW,#X1 AF(P(%FIN1),2)                                        P:SYS890
         DO1      %FIN1]=5                                              P:SYS891
         LW,#X1   NAME(2,%FIN1-2),#X1                                   P:SYS892
         ELSE                                                           P:SYS893
         LI,#X1   AF(P(%FIN1),2)+NAME(2,%FIN1-2)                        P:SYS894
         FIN                                                            P:SYS895
         DO       AFA(P(6),2)                                           P:SYS896
         LW,#1    AF(P(6),2)                                            P:SYS897
         ELSE                                                           P:SYS898
%FIN1    SET      SCOR(AF(P(6),2),FILE,ACN,PASS,EXPIRE,READ,WRITE,SN,;  P:SYS899
   OUTSN,,MODATE,SYNON,,SIZE,CRDATE,ACDATE,BUDATE,)                     P:SYS900
         LI,#1    P:S(%FIN1>0,AF(P(6),2),%FIN1)                         P:SYS901
         FIN                                                            P:SYS902
         BAL,#X3  FNDVLP                                                P:SYS903
         P:STW,#X1    AF(P(7),2)                                        P:SYS904
         DO       (P(2)&X'18')=X'18'&(AF(P(8),2)=AF(P(9),2))            P:SYS905
         BNE      AF(P(8),2)                                            P:SYS906
         ELSE                                                           P:SYS907
         DO1      (P(2)&X'10')>0                                        P:SYS908
         BG       AF(P(8),2)                                            P:SYS909
         DO1      (P(2)&8)>0                                            P:SYS910
         BL       AF(P(9),2)                                            P:SYS911
         FIN                                                            P:SYS912
         GOTO,P:FLAG(FLFNDVLP)    %PEND                                 P:SYS913
         LOCAL    I                                                     P:SYS914
PLOC     P:TOSECT SECT(T1)                                              P:SYS915
FNDVLP   LW,#4    #X1                                                   P:SYS916
         AI,#4    89                                                    P:SYS917
I        LW,#1U1  0,#X1                                                 P:SYS918
         CB,#1    #1U1                                                  P:SYS919
         BE       0,#X3                                                 P:SYS920
         CW,#1U1  =X'FF0000'                                            P:SYS921
         BANZ     0,#X3                                                 P:SYS922
         AND,#1U1 =X'FF'                                                P:SYS923
         AI,#1U1  1                                                     P:SYS924
         AW,#X1   #1U1                                                  P:SYS925
         CW,#4    #X1                                                   P:SYS926
         BGE      I                                                     P:SYS927
         B        0,#X3                                                 P:SYS928
SECT(T1) P:TOSECT PLOC                                                  P:SYS929
%PEND    PEND                                                           P:SYS930
         PAGE                                                           P:SYS931
P:OPEN   CNAME                                                          P:SYS932
         PROC                                                           P:SYS933
LF(1)    EQU      %                                                     P:SYS934
LF(2)    EQU      FPT%VLP                                               P:SYS935
P   SET   S:KEYS(7,*0,ERR,ABN,BUF,RECL,TRIES,(ORG,CONSEC,KEYED,RANDOM),;P:SYS936
   (ACS,SEQUEN,DIRECT),(MODE,IN,OUT,INOUT,OUTIN),,(FIL1,REL,SAVE),;     P:SYS937
   FPARAM,TLABEL,KEYM,,BTD,VOL,NEWX,SPARE,,RSTORE,;                     P:SYS938
   21,NXTF,29,NXTA,NOSEP,CYLINDER)                                      P:SYS939
Q        SET      S:KEYS(7,*20,INBUF,*ERROR,FPTBUF,STACK,SIZE,SCANDISP,;P:SYS940
                  28,NOCAL1,TEXTC,SCANPT)                               P:SYS941
         ERROR,3,P(1)+Q(1)~=NUM(AF)-1    UK                             P:SYS942
PLOC     P:TOSECT SECT(T0)                                              P:SYS943
LF(3)    GEN,1,7,3,4,17,32    AFA(1),X'14',P(2)&7,,AF(1),0              P:SYS944
J    SET    (AF(P(3),2),17),(AF(P(4),2),17),(AF(P(5),2),17),;           P:SYS945
  (AF(P(6),2),16),(AF(P(7),2),8),(SCOR(AF(P(8),1),CONSEC,KEYED,;        P:SYS946
  RANDOM),2),(SCOR(AF(P(9),1),SEQUEN,DIRECT),2),;                       P:SYS947
  (SCOR(AF(P(10),1),IN,OUT,,INOUT,,,,OUTIN),4),,;                       P:SYS948
  (SCOR(AF(P(12),1),REL,SAVE),2),(AF(P(13),2),17),(AF(P(14),2),17),;    P:SYS949
  (AF(P(15),2),5),1,(AF(P(17),2),2),(AF(P(18),2),8),(AF(P(19),2)**8;    P:SYS950
  +AF(P(19),3),16),(AF(P(20),2),16),,(AF(P(22),2),20)                   P:SYS951
P(2)     SET      P(2)&X'400'                                           P:SYS952
K        WHILE    K<20                                                  P:SYS953
         GOTO,(P(K+2)=NUM(AF)+1)&NUM(J(K))~=1      %FIN                 P:SYS954
         DO1      NUM(J(K))=1                                           P:SYS955
%DEV     SET      %                                                     P:SYS956
P(2)     SET      P(2)|1**(32-K)                                        P:SYS957
         DO       AFA(P(K+2),2)                                         P:SYS958
         PZE      AF(P(K+2),2)                                          P:SYS959
         ELSE                                                           P:SYS960
         GEN,32-J(K,2),J(K,2)    0,J(K,1)                               P:SYS961
         FIN                                                            P:SYS962
%FIN     FIN                                                            P:SYS963
%FIN     SET      %                                                     P:SYS964
         ORG,4    SECT(T0)+1                                            P:SYS965
         DATA     P(2)                                                  P:SYS966
         ORG,4    %FIN                                                  P:SYS967
         DATA,2   %-SECT(T0),%DEV-SECT(T0)+1                            P:SYS968
         DO       (Q(2)&2)>0                                            P:SYS969
         MSP,#1U1 SPDPNTR                                               P:SYS970
         ELSE                                                           P:SYS971
         DO       (Q(2)&X'40')>0                                        P:SYS972
         AWM,#1U1 AF(Q(8),2)                                            P:SYS973
         ELSE                                                           P:SYS974
         NOP                                                            P:SYS975
         FIN                                                            P:SYS976
         FIN                                                            P:SYS977
SECT(T0) P:TOSECT PLOC                                                  P:SYS978
         DO       AFA(Q(6),2)                                           P:SYS979
         P:LI,#X3 AF(Q(6),2)                                            P:SYS980
         STW,#X3  STKADR                                                P:SYS981
         FIN                                                            P:SYS982
         LI,#X3   SECT(T0)-2                                            P:SYS983
         LCI      0                                                     P:SYS984
         PSM,0    *STKADR                                               P:SYS985
         DO       (Q(2)&2)>0                                            P:SYS986
         LW,4     SPDPNTR                                               P:SYS987
         INT,12   SPDPNTR+1                                             P:SYS988
         ELSE                                                           P:SYS989
         DO       AFA(Q(3),2)                                           P:SYS990
         GEN,12,20 X'324',AF(Q(3),2)                                    P:SYS991
         ELSE                                                           P:SYS992
         LI,4     BA(AF(Q(3),2))+((Q(2)&X'80')=0)                       P:SYS993
         FIN                                                            P:SYS994
         DO       (Q(2)&X'80')>0                                        P:SYS995
         P:LI,12  AF(Q(7),2)                                            P:SYS996
         ELSE                                                           P:SYS997
         DO       AFA(Q(3),2)                                           P:SYS998
         LB,12    *4                                                    P:SYS999
         SLS,4    2                                                     P:SY1000
         AI,4     1                                                     P:SY1001
         ELSE                                                           P:SY1002
         LB,12    AF(Q(3),2)                                            P:SY1003
         FIN                                                            P:SY1004
         FIN                                                            P:SY1005
         FIN                                                            P:SY1006
         BAL,6    OPENDCB                                               P:SY1007
   GEN,1,7,24 AFA(Q(5),2),P:S((Q(2)&X'200')>0,X'72',X'32'),AF(Q(5),2)-1 P:SY1008
         B        AF(Q(4),2)                                            P:SY1009
         DO1      (Q(2)&8)=0                                            P:SY1010
         CAL1,1   *FPT%VLP                                              P:SY1011
         GOTO,P:FLAG(FLOPEN)    %PEND                                   P:SY1012
         OPEN     CHKEND,ERTRN,CC%REG6,SCN,TBL1,RET,SETDEV,TXDEV,;      P:SY1013
                  TXSNS,%6,%1,%2,%3,%4,%5,%8,#DEV,I,J,K,REG4,CHTBL      P:SY1014
PLOC     P:TOSECT SECT(1)                                               P:SY1015
         DO       (Q(2)&X'100')=0                                       P:SY1016
         BOUND    8                                                     P:SY1017
         DATA     %+1,50**16                                            P:SY1018
         RES      50                                                    P:SY1019
STKADR   DATA     %-52                                                  P:SY1020
         ELSE                                                           P:SY1021
STKADR   DATA     AF(Q(6),2)                                            P:SY1022
         FIN                                                            P:SY1023
CC%REG6  RES      1                                                     P:SY1024
LF(4),REG4    RES    1                                                  P:SY1025
FPT%VLP  RES      1                                                     P:SY1026
SECT(1)  P:TOSECT PLOC                                                  P:SY1027
P:OPEN   DSECT    T1=2                                                  P:SY1028
CHTBL    TEXTC    './# ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789%*%:@-'      P:SY1029
TBL1     DATA     X'07010001',X'03000002',X'02000002',X'01000808'       P:SY1030
#DEV     DATA     X'000B0B0C'                                           P:SY1031
TXSNS    DATA     'FT','LTDP'                                           P:SY1032
TXDEV    TEXT     '//NOTYPRPPCRCPLP'                                    P:SY1033
OPENDCB  STW,6    CC%REG6                                               P:SY1034
         STW,4    REG4                                                  P:SY1035
         LW,6     *STKADR                                               P:SY1036
         LW,2     *STKADR                                               P:SY1037
         AH,2     *#X3                                                  P:SY1038
         AI,2     2                                                     P:SY1039
         STW,2    FPT%VLP                                               P:SY1040
         LCH,2    *#X3                                                  P:SY1041
         LW,10    *#X3,2                                                P:SY1042
         PSW,10   *STKADR                                               P:SY1043
         BIR,2    %-2                                                   P:SY1044
         LI,1     4                                                     P:SY1045
         LW,11    ='    '                                               P:SY1046
         LW,10    TBL1-1,1                                              P:SY1047
         PSW,10   *STKADR                                               P:SY1048
         AND,10   =X'FF'                                                P:SY1049
         PSW,11   *STKADR                                               P:SY1050
         BDR,10   %-1                                                   P:SY1051
         BDR,1    %-5                                                   P:SY1052
         LI,0     8                                                     P:SY1053
         LI,11    1                                                     P:SY1054
         LI,3     1**8                                                  P:SY1055
         LI,13    32                                                    P:SY1056
         BAL,15   SCN                                                   P:SY1057
         STB,8    *FPT%VLP                                              P:SY1058
         LW,14    *FPT%VLP                                              P:SY1059
         SLS,14   8                                                     P:SY1060
         LH,14    14                                                    P:SY1061
         LC       CC%REG6                                               P:SY1062
         BCS,2    %3                                                    P:SY1063
         BCS,4    %6                                                    P:SY1064
         BCR,15   %2                                                    P:SY1065
%1       LI,3     3                 DELIM = #                           P:SY1066
         CH,14    TXSNS,3                                               P:SY1067
         BE       %+3                                                   P:SY1068
         BDR,3    %-2                                                   P:SY1069
         B        ERTRN                                                 P:SY1070
         LB,0     #DEV,3            L/DEV CODE IF FT, LT, DP            P:SY1071
         LI,3     (15*4)**8+15*4-1                                      P:SY1072
         LI,13    5                                                     P:SY1073
         AI,11    X'40'                                                 P:SY1074
         BAL,15   SCN               SCAN SN                             P:SY1075
         CI,14    X'F0000'+'FT'                                         P:SY1076
         BNE      %5                B/NOT FT                            P:SY1077
         BAL,15   CHKEND                                                P:SY1078
         LI,3     X'B'                                                  P:SY1079
         B        %8                                                    P:SY1080
%5       BL       %+2                                                   P:SY1081
         AI,11    1                                                     P:SY1082
         LC       CC%REG6                                               P:SY1083
         BCR,2    ERTRN             B/DELIM NOT /                       P:SY1084
%4       LI,3     1**8                                                  P:SY1085
         LI,13    32                                                    P:SY1086
         BAL,15   SCN                                                   P:SY1087
         STB,8    *FPT%VLP                                              P:SY1088
         BCR,15   SETDEV                                                P:SY1089
         BCR,4    ERTRN             B/DELIM NOT .                       P:SY1090
%6       LI,3     (9*4)**8+9*4-1                                        P:SY1091
         LI,9     0                                                     P:SY1092
         LI,13    9                                                     P:SY1093
         AI,11    8                                                     P:SY1094
         BAL,15   SCN+1                                                 P:SY1095
         BCR,15   SETDEV                                                P:SY1096
         BCR,4    ERTRN                                                 P:SY1097
         AI,8     0                                                     P:SY1098
         BNEZ     %+3                                                   P:SY1099
         STB,8    *FPT%VLP,3                                            P:SY1100
         AI,11    -8                                                    P:SY1101
         LI,3     (12*4)**8+12*4-1                                      P:SY1102
         LI,13    9                                                     P:SY1103
         AI,11    X'200'                                                P:SY1104
         BAL,15   SCN                                                   P:SY1105
         LI,15    SETDEV                                                P:SY1106
CHKEND   LC       CC%REG6                                               P:SY1107
         BCR,15   *15                                                   P:SY1108
         B        ERTRN                                                 P:SY1109
%3       CI,14    X'F0000'+'DC'     DELIM WAS /                         P:SY1110
         BNE      ERTRN                                                 P:SY1111
         B        %4                                                    P:SY1112
%2       CI,8     2                 END OF FIELD, NO DELIMS             P:SY1113
         BNE      SETDEV                                                P:SY1114
         LI,3     7                                                     P:SY1115
         CH,14    TXDEV,3                                               P:SY1116
         BE       %8                                                    P:SY1117
         BDR,3    %-2                                                   P:SY1118
         B        SETDEV                                                P:SY1119
%8       AI,11    -1                                                    P:SY1120
         LW,0     3                                                     P:SY1121
SETDEV   SLS,0    8                                                     P:SY1122
         AI,0     X'18000'-1**8                                         P:SY1123
         STS,11   2,6                                                   P:SY1124
         LW,3     -15+#X3,6                                             P:SY1125
         INT,3    0,3                                                   P:SY1126
         STW,0    *6,3                                                  P:SY1127
         ANLZ,2   *CC%REG6                                              P:SY1128
         BCR,8    RET                                                   P:SY1129
         LW,3     *STKADR                                               P:SY1130
         SW,3     6                                                     P:SY1131
         LW,10    *6,3                                                  P:SY1132
         STW,10   *2,3                                                  P:SY1133
         BDR,3    %-2                                                   P:SY1134
RET      STW,6    FPT%VLP                                               P:SY1135
         MTW,1    FPT%VLP                                               P:SY1136
         MTW,1    CC%REG6                                               P:SY1137
ERTRN    MTW,1    CC%REG6                                               P:SY1138
         SW,4     REG4                                                  P:SY1139
         STW,4    REG4                                                  P:SY1140
         SW,6     *STKADR                                               P:SY1141
         MSP,6    *STKADR                                               P:SY1142
         LCI      0                                                     P:SY1143
         PLM,0    *STKADR                                               P:SY1144
         LW,#1U1  REG4                                                  P:SY1145
         EXU      1,#X3                                                 P:SY1146
         B        *CC%REG6                                              P:SY1147
SCN      LI,9     1                 L/MIN SIZE                          P:SY1148
         SCS,3    -8                                                    P:SY1149
         LI,8     0                 L/CUR SIZE                          P:SY1150
         LB,5     CHTBL             L/CHTBL LEN                         P:SY1151
         LB,10    0,4               L/CHAR                              P:SY1152
         CI,10    X'40'             C/BLANK                             P:SY1153
         BNE      I                 B/NOT BLANK                         P:SY1154
         AI,4     1                                                     P:SY1155
         BDR,12   %-4               BDR                                 P:SY1156
         B        ERTRN             B/END; ALL BLNK FLD                 P:SY1157
I        LB,10    0,4               L/CHAR                              P:SY1158
         LW,2     5                 L/CHTBL LEN                         P:SY1159
         CB,10    CHTBL,2           C/W/LEGAL                           P:SY1160
         BE       %+3               B/ABOVE                             P:SY1161
         BDR,2    %-2               BDR                                 P:SY1162
         B        J                 B/END                               P:SY1163
         AI,4     1                 INC IN PNTR                         P:SY1164
         AI,2     -4                -4 TO INDEX                         P:SY1165
         BGZ      K                 B/LEGAL CHAR                        P:SY1166
         BLZ      %+3               B/DELIM                             P:SY1167
         LI,5     4                 L/CHTBL LEN                         P:SY1168
         B        J-1               B/BLANK                             P:SY1169
         BDR,12   J+1               BDR                                 P:SY1170
         B        ERTRN             B/END; BAD                          P:SY1171
K        BDR,13   %+2               BDR,OUTMAX CNT                      P:SY1172
         B        ERTRN             B/REAL ERROR (OVER-RUN)             P:SY1173
         STB,10   *FPT%VLP,3        STORE CHAR                          P:SY1174
         AI,3     1                 INC OUT PNTR                        P:SY1175
         AI,8     1                                                     P:SY1176
         BDR,12   I                 BDR                                 P:SY1177
J        LI,2     -4                L/DUMMY DELIM PNTR                  P:SY1178
         CW,8     9                 C/CUR AND MIN                       P:SY1179
         BL       ERTRN             B/LESS THAN MIN                     P:SY1180
         LB,3     3                                                     P:SY1181
         BEZ      %+4                                                   P:SY1182
         LB,10    *FPT%VLP,3                                            P:SY1183
         AI,3     -1                                                    P:SY1184
         STB,10   *FPT%VLP,3                                            P:SY1185
         LC       WA(=X'402010')+1,2                                    P:SY1186
         STCF     CC%REG6                                               P:SY1187
         B        *15                                                   P:SY1188
         USECT    PLOC                                                  P:SY1189
         CLOSE    CHKEND,ERTRN,CC%REG6,SCN,TBL1,RET,SETDEV,TXDEV,;      P:SY1190
                  TXSNS,%6,%1,%2,%3,%4,%5,%8,#DEV,I,J,K,REG4,CHTBL      P:SY1191
%PEND    PEND                                                           P:SY1192
         PAGE                                                           P:SY1193
         OPEN     BASE,BD,BH,CMPRS,D,DB,FCMPRS,HB,S,FLDESC           *X*P:SY1194
FCMPRS,FLDESC    SET    0                                               P:SY1195
         PAGE                                                           P:SY1196
*  CHANGE THE REGISTERS USED IN P:SYSTEM.                               P:SY1197
*        P:REG    R#X1,R#X2,R#X3,R#4,R#1,R#1U1                          P:SY1198
P:REG    CNAME                                                          P:SY1199
         PROC                                                           P:SY1200
LF       SET      %                                                     P:SY1201
         ERROR,3,NUM(AF)~=6    INOA                                     P:SY1202
         GOTO,NUM(AF)~=6    %PEND                                       P:SY1203
#X1      SET      AF(1)                                                 P:SY1204
#X2      SET      AF(2)                                                 P:SY1205
#X3      SET      AF(3)                                                 P:SY1206
#4       SET      AF(4)                                                 P:SY1207
#1       SET      AF(5)                                                 P:SY1208
#1U1     SET      AF(6)                                                 P:SY1209
         ERROR,3,#X1=0|#X3=0|#X1>7|#X3>7|(#1&1)=1|#1U1~=#1+1;           P:SY1210
  |(#X3&1)=0|#X2=0|#X2>7    'P:SYSTEM:  IMPROPER REGISTER ASSIGNMENT'   P:SY1211
         DISP     #X1**24+#X2**20+#X3**16+#4**12+#1**8+#1U1**4+1        P:SY1212
%PEND    PEND                                                           P:SY1213
         PAGE                                                           P:SY1214
P:B      CNAME                                                          P:SY1215
         PROC                                                           P:SY1216
LF       EQU      %                                                     P:SY1217
I        DO       NUM(AF)                                               P:SY1218
         B        AF(I,1)                                               P:SY1219
         FIN                                                            P:SY1220
         PEND                                                           P:SY1221
         PAGE                                                           P:SY1222
P:IOCDW  CNAME                                                          P:SY1223
         PROC                                                           P:SY1224
         BOUND    8                                                     P:SY1225
P        SET      S:KEYS(2,*18,ORDER,BUF,CDA,SIZE,;                     P:SY1226
         24,DC,IZC,CC,ICE,HTE,IUE,SIL,SKIP)                             P:SY1227
LF       GEN,8,5,19,8,8,16    AF(P(3),2),0,P:S((P(2)&X'1000')>0,;       P:SY1228
   DA(AF(P(5),2)),BA(AF(P(4),2))),P(2)&X'FF',,AF(P(6),2)                P:SY1229
         PEND                                                           P:SY1230
         PAGE                                                           P:SY1231
P:PSD    CNAME                                                          P:SY1232
         PROC                                                           P:SY1233
         BOUND    8                                                     P:SY1234
P        SET      S:KEYS(2,*0,CC,IA,WK,RP,MA,EA,21,RES,FS,FZ,FN,;       P:SY1235
                  (SLAVE,MASTER),MAP,DM,AM,CI,II,EI)                    P:SY1236
LF   GEN,((P(2)&X'400')>0)*64,4,1,7,3,17,2,2,1,3,1,1,6,8,4,4    ;       P:SY1237
   ,AF(P(3),2),,P(2)**-3&X'7F',,AF(P(4),2),,AF(P(5),2),,P(2)&7,;        P:SY1238
   (NUM(AF(P(7)))=1)+AF(P(7),2),,AF(P(8),2),,AF(P(6),2),                P:SY1239
         PEND                                                           P:SY1240
         PAGE                                                           P:SY1241
P:RES    CNAME    (3,0,1,,2,,,,3),(0,2,1,,0,,,,-1)                      P:SY1242
         PROC                                                           P:SY1243
         BOUND    P:S(NAME(1,CF(2)),1,2,4,8)                            P:SY1244
LF       EQU      BASE                                                  P:SY1245
BASE     SET      P:S(NAME(1,CF(2)),BA(BASE),HA(BASE),;                 P:SY1246
         WA(BASE),DA(BASE))+AF**NAME(2,CF(2))                           P:SY1247
         PEND                                                           P:SY1248
         PAGE                                                           P:SY1249
P:DESC   CNAME    P:FLAG(FLDESC)                                        P:SY1250
         DO       FLDESC                                                P:SY1251
SIZE,BIN,BC EQU   1                                                     P:SY1252
WA,HEX   EQU      2                                                     P:SY1253
BA,DEC   EQU      3                                                     P:SY1254
BTD      EQU      4                                                     P:SY1255
WD       EQU      5                                                     P:SY1256
TYPE     EQU      6                                                     P:SY1257
         FIN                                                            P:SY1258
         PROC                                                           P:SY1259
         DISP     %                                                     P:SY1260
         LIST     0                                                     P:SY1261
LF(1)    EQU      %                                                     P:SY1262
I        DO       NUM(AF)                                               P:SY1263
         RES,1    AF(I,2,2)                                             P:SY1264
AF(I,1,1) EQU     AF(I,2,1),WA(%),BA(%),BA(%)-BA(LF(1)),;               P:SY1265
                  WA(%)-WA(LF(1)),SCOR(AF(I,3,1),BIN,HEX,DEC)           P:SY1266
         DO       P:MAX(AF(I,1,2),1)                                    P:SY1267
         DO       NUM(AF(I))<4                                          P:SY1268
         RES,1    AF(I,2,1)                                             P:SY1269
         ELSE                                                           P:SY1270
         DO       SCOR(AF(I,4),BLANK)*AF(I,2,1)                         P:SY1271
         DATA,1   X'40'                                                 P:SY1272
         ELSE                                                           P:SY1273
         DATA,AF(I,2,1)  AF(I,4)                                        P:SY1274
         FIN                                                            P:SY1275
         FIN                                                            P:SY1276
         FIN                                                            P:SY1277
         FIN                                                            P:SY1278
LF(2)    EQU      BA(%)-BA(LF(1))                                       P:SY1279
         LIST     1                                                     P:SY1280
         PEND                                                           P:SY1281
         PAGE                                                           P:SY1282
P:COMFLD CNAME    X'60'                                                 P:SY1283
P:MOVFLD CNAME    X'61'                                                 P:SY1284
         PROC                                                           P:SY1285
LF       EQU      %                                                     P:SY1286
I        DO       NUM(AF)                                               P:SY1287
K        SET      AF(I)                                                 P:SY1288
J        SET      P:S(TCOR(K(2),S:LIST),BA(K(2)),K(2,3))                P:SY1289
         LW,#1U1  =P:S(TCOR(K(2),S:LIST),K(1,1),K(2,1))**24+J           P:SY1290
         GEN,8,4,20   NAME,#1U1,P:S(TCOR(K(1),S:LIST),BA(K(1)),K(1,3))-JP:SY1291
         FIN                                                            P:SY1292
         PEND                                                           P:SY1293
         PAGE                                                           P:SY1294
P:MOV    CNAME                                                          P:SY1295
         PROC                                                           P:SY1296
LF       EQU      %                                                     P:SY1297
I        DO       NUM(AF)                                               P:SY1298
S        SET      P:S(TCOR(AF(I,1),S:LIST),(4,P:S(TCOR(AF(I,1),1),;     P:SY1299
   WA(AF(I,1)),AF(I,1)/4),BA(AF(I,1)),0,0,0),AF(I,1))                   P:SY1300
D        SET      P:S(TCOR(AF(I,2),S:LIST),(4,P:S(TCOR(AF(I,2),1),;     P:SY1301
   WA(AF(I,2)),AF(I,2)/4),BA(AF(I,2)),0,0,0),AF(I,2))                   P:SY1302
         GOTO,S(6)**2+D(6) M,M,M,M,M,BH,BD,M,HB,M,M,M,DB,M,M            P:SY1303
M        MOVE     (S(1),S(2),S(3)),(D(1),D(2),D(3)),P:MIN(D(1),S(1))    P:SY1304
         GOTO     %FIN                                                  P:SY1305
BH       BOUND    1                                                     P:SY1306
         P:BINHEX (BIN,S(3)),(BTD,D(3)),(SIZE,D(1)),(SUB)               P:SY1307
         GOTO     %FIN                                                  P:SY1308
BD       LOAD     #1U1,(S(1),S(2),S(3)),S(1)                            P:SY1309
         P:BINDEC (BIN,#1U1),(BTD,D(3)),(SIZE,D(1))                     P:SY1310
         GOTO     %FIN                                                  P:SY1311
HB       P:HEXBIN (BIN,#1U1),(BTD,S(3)),(SIZE,S(1))                     P:SY1312
         STORE    #1U1,(D(1),D(2),D(3)),D(1)                            P:SY1313
         GOTO     %FIN                                                  P:SY1314
DB       P:DECBIN (BIN,#1U1),(BTD,S(3)),(SIZE,S(1))                     P:SY1315
         STORE    #1U1,(D(1),D(2),D(3)),D(1)                            P:SY1316
%FIN     FIN                                                            P:SY1317
         PEND                                                           P:SY1318
         PAGE                                                           P:SY1319
P:SIZE   FNAME                                                          P:SY1320
         PROC                                                           P:SY1321
K        SET      0                                                     P:SY1322
J        SET      %                                                     P:SY1323
I        DO       NUM(AF)                                               P:SY1324
         USECT    AF(I)                                                 P:SY1325
K        SET      K+(ABSVAL(BA(%))+7)/8*2                               P:SY1326
         FIN                                                            P:SY1327
         ORG      J                                                     P:SY1328
         PEND     K                                                     P:SY1329
         PAGE                                                           P:SY1330
*  TAB TO GIVEN DISP IN BUFFER, GENERATE TEXT.                          P:SY1331
P:TAB    CNAME                                                          P:SY1332
         PROC                                                           P:SY1333
J        SET      %                                                     P:SY1334
         LIST     0                                                     P:SY1335
I        DO       NUM(AF)                                               P:SY1336
K        SET      AF(I,1)                                               P:SY1337
  ORG,1 BA(LF(1))+P:S(TCOR(K,S:LIST),(K),K(4))-P:S(SCOR(AF(I,3),RJ,LJ),;P:SY1338
  SCOR(CF(2),RJ),1,0)*(S:NUMC(AF(I,2))-1-P:S(TCOR(K,S:LIST),0,K(1)-1))  P:SY1339
         DATA,1   S:UT(AF(I,2))                                         P:SY1340
         FIN                                                            P:SY1341
         ORG,4    J                                                     P:SY1342
         LIST     1                                                     P:SY1343
         PEND                                                           P:SY1344
         PAGE                                                           P:SY1345
*  COMPRESS A TEXTC BUFFER, REPLACING MULTIPLE BLANKS WITH SINGLE BLANKSP:SY1346
P:COMPRESS    CNAME                                                     P:SY1347
         PROC                                                           P:SY1348
P        SET      S:KEYS(2,*30,BUF)                                     P:SY1349
LF(1)    P:LI,#1U1 WA(AF(P(3),2))                                       P:SY1350
         BAL,#X1  CMPRS                                                 P:SY1351
         GOTO,P:FLAG(FCMPRS)    %PEND                                   P:SY1352
PLOC     P:TOSECT SECT(T1)                                              P:SY1353
         LOCAL    I,J                                                   P:SY1354
CMPRS    LB,#1    *#1U1                                                 P:SY1355
         LI,#X2   1                                                     P:SY1356
         LI,#X3   0                                                     P:SY1357
I        LB,#4    *#1U1,#X2                                             P:SY1358
         AI,#X2   1                                                     P:SY1359
         AI,#X3   1                                                     P:SY1360
         STB,#4   *#1U1,#X3                                             P:SY1361
         CI,#4    X'40'                                                 P:SY1362
         BE       J                                                     P:SY1363
         BDR,#1   I                                                     P:SY1364
         B        J+1                                                   P:SY1365
         CB,#4    *#1U1,#X2                                             P:SY1366
         BNE      I                                                     P:SY1367
         AI,#X2   1                                                     P:SY1368
J        BDR,#1   %-3                                                   P:SY1369
         STB,#X3  *#1U1                                                 P:SY1370
         B        0,#X1                                                 P:SY1371
SECT(T1) P:TOSECT PLOC                                                  P:SY1372
%PEND    PEND                                                           P:SY1373
         CLOSE    BASE,BD,BH,CMPRS,D,DB,FCMPRS,HB,S,FLDESC           *X*P:SY1374
   ERROR,* TBLK,AST,AST                                                 P:SY1375
   ERROR,* TBLK,'*  P:SYSTEM:'                                          P:SY1376
   ERROR,* TBLK,'*  LAST UPDATE:       15 AUG 74'                       P:SY1377
   ERROR,* TBLK,'*  REGISTERS USED:    1, 2, 3, 11, 12, AND 13'         P:SY1378
   ERROR,* TBLK,'*  CONTROL SECTIONS:  ',P:BH(CS(SECT(T0))),;           P:SY1379
   ' (PT 0) AND ',P:BH(CS(SECT(T1))),' (PT 1)'                          P:SY1380
   ERROR,* TBLK,AST,AST                                                 P:SY1381
         CLOSE    PLOC,CHEX,FCHEX,INOA,SEBN,%PEND,IAF,LBL,;             P:SY1382
   T0,T1,SECT,P,UK,%FIN,#X1,#X3,#4,#1,#1U1,#X2,RP,;                     P:SY1383
   FLIMF09,LIMF09,CP,DDEF,%FIN1,%FIN2,%FIN3,I,J,K,L,M,IIAF,;            P:SY1384
   FLIMC16,LIMC16,SHXBN,FHEXBIN,IFE,FEBCBIN,;                           P:SY1385
   TCBTD,TX,TSZ,Q,N,STORE,LOAD,MOVE,#LT,LT,LTBAD,VT,#4TMP,;             P:SY1386
   FSBNHX,SBNHX,#BA,#WA,FLPTBL,LPTBL,TBLK,AST,FERRMSG,;                 P:SY1387
   CLSDO,CLSXX,KBF,OPNXX,RBF,RDXX,R10TMP,R8TMP,TXBDER,TXDCB,WRTDO,;     P:SY1388
   FLOPEN,FPT%VLP,FSCAN,FTBLSRCH,OPENDCB,OUTBUFF,SCAN,SCN,;             P:SY1389
   STKADR,SPDPNTR,TBLSRCH,%DEV,SKPCHR,SB,FLFNDVLP,FNDVLP,;              P:SY1390
   BABUF,BATBL,DELIMS                                                   P:SY1391
         END                                                            P:SY1392
