*        704724   SIGMA 5/7         BPM M:ROOT
         SYSTEM   SIG7FDP
MODE     EQU      1
DEBUG    EQU      0
CFU      EQU      1
PATCHER  EQU      1
         DO       MODE=2
         DEF      J:JIT
J:JIT    EQU      X'8000'
         FIN
         REF      M:DO
         DO       PATCHER~=0
         CSECT    1
         DEF      PATCH
         DO       MODE=0
PATCH    RES      50
         ELSE
PATCH    RES      X'100'
         FIN
         FIN
         CSECT    1
         DEF      MCRT
MCRT     EQU      %
         DEF      M2,M3,M4,M5,M6,M7,M8,M15,M16,M17,M20,M32,MN1,MN2,;
                  MN3,MN4,MN8,MN9,MN16,M826,MSKFTYPE,Y1,Y2,Y4,Y8,Y01,;
                  Y02,Y08,Y0C,Y0F,Y001,Y002,Y004,Y008,Y00C,;
                  Y001F,Y00FFFF,Y0001,Y0002,Y0003,Y0004,Y0005,Y0006,;
                  Y0007,Y0008,Y000B,Y00F1,;
                  Y0301,Y0303,Y0343,Y0304,Y0405,Y0502,Y0643,Y0683,;
                  Y00FF,YFF00FFFF,Y000F,YFFF0FFFF,TXF:,TXM:,;
                  TXLIB,TX6F4:,TXASTL,TXASTA,TX5F4:,TX3DCB,TXHEAD,;
                  HEADWD,TXTREE,STK2,RFDFSTK2,PASSCODE
         DEF      Y000C
         DEF      M11
         DEF      Y003,Y00008,M1,M10
         DEF      VAL%SW,LIBFLG,ROOTFLG
         DEF      HEADADR
         DEF      LMNSW
         DEF      ER32
         DEF      M30
         DEF      SYMBOLTB,SYMTOP
         DEF      LHEADWD
         DEF      Y03
         DEF      Y005
         DEF      Y05
         DEF      Y68
         DEF      M9
         DEF      X8
         DEF      TXBLNK
         DEF      TXASTDIC,TXASTD
         DEF      TXM:DO
         DEF      EOF,ER8,ER9,ERB,ERC,ERD,ERE,ERF
         DEF      ER11,ER12
         DEF      ER15,ER16,ER18,ER19,ER1A,ER1B,ER17
         DEF      ER1F,ER20
         DEF      ER21
         DEF      ER22
        DEF      BLANKER,BINTOHEX
         DEF      READBILI,2BNUM,3BNUM,12BNUM,4BNUM,GBYTE,GETSEG
         DEF      DSTK2
         REF      INIT1,PASS1,INIT2,PASS2
         REF      FINISH
         DEF      DECLSTK,DECLSTK1,DECLBAS,RFDFBAS,RFDFSTK,;
                  RFDFSTK1,EXPRSTK,EXPRSTK1,EXPRBAS,BSEG1,BSEG2,;
                  CSEG1,CSEG2,CROM1,CROM2,CRFDF1,CRFDF2,CURBYTE,;
                  RCDSIZE,SEQNUM,SEVLEV,XSL,LASTCARD,BUF,BUF2,;
                  BFR,TEMPPTR,TREEPTR,FCOUNT,FTABLE,;
                  ERRTAB,ERRSTK,TCBSIZE,TCBPTR,FTAB,RSEG00,;
                  RSEG01,RSEG10,RREL00,RREL01,RREL10,CSEG00,;
                  CREL00,CREL01,CREL10,MAX00,;
                  MAX01,MAX10,DLOC,PLOC,SLOC,LOC,START,LOCCT,;
                  LOADBAS,MODBAS,RELDBAS,MBIAS,FBIAS,BIAS,;
                  RDIG,MODSIZ,NOTLLM,MAXRFDF,MAXEXPR,TOPOMEM,;
                  OPENEF,OPENDIC,USID,READDIC,CSECFLG
         DEF      LOCWD,LIB,XMKEY
         DEF      PBUF,PLIB,RFLDSG
         DEF      ROMTPTR,TEMPSIZE,DECLSIZE,EXPRDIS,;
                  RFLOADIS,RFDFDIS,NXROMDIS,SBLNKDIS,ROM1DIS,;
                  TMPSZDIS,NUNSTDIS,00DIS,01DIS,10DIS,NRWACCT,;
                  TREESIZE,TREEDIS,BIASDIS,LOWLIMDS,FCOMDIS,;
                  ERRDIS,LMNDIS,USACTDIS,LMPASS,LMEXPDIS,;
                  RDACT1,ROMSIZE,TCBBLNK
         DEF      LIBER
         DEF      MXRFDFSG
         DEF      FCOMSIZ
         DEF      NXTAVPG
         DEF      Y048,Y018
         DEF      XMEM3X,RLOC
         REF      XMRDERR
         DEF      ER14
         DEF      TRESIZ
         DEF      XMRKEY
         DEF      04LOC
         DEF      TSTACK
         DEF      BREFBIT,TXS:OVRL,DOREFPTR,RFLDMODS,RFLDTBSZ
         DEF      BREFERR
         DEF      PASS3RET
         DEF      ENTFLAG
         DO       MODE=1
         DEF      CORELIB
         DEF      M:FVP
         DEF      MREFLAG,MREFTAB,TOVBALPSD,TOVBPSD,YFF
         DO       CFU=1
         DEF      TXM:STAR
         FIN
         FIN
         DEF      ERFLAG
         DEF      HEADSIZE,HEADRFDF
         DEF      ER23
         DEF      ER7X
         DEF      ER10X
         DEF      FIRSTF,LASTF
         DEF      Y006
         DEF      XCSEG1
         DEF      DECLCHK
         DEF      CODE
         DEF      ER1X,ERAX
         DEF      KICKOUT,CFUPTR
         DO       MODE=0
         DEF      SNM:LM
         FIN
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         DO       MODE=0
         DEF      CJOB
CJOB     EQU      X'4F'
         FIN
         DEF      M24
         PAGE
*                 IMMEDIATE CONSTANTS FOR LOADER.
K0       EQU      0
K1       EQU      1
K2       EQU      2
K3       EQU      3
K4       EQU      4
K5       EQU      5
K6       EQU      6
K7       EQU      7
K8       EQU      8
K9       EQU      9
KA       EQU      X'A'
KB       EQU      X'B'
KC       EQU      X'C'
KD       EQU      X'D'
KE       EQU      X'E'
KF       EQU      X'F'
K10      EQU      X'10'
K11      EQU      X'11'
K12      EQU      X'12'
K16      EQU      X'16'
K17      EQU      X'17'
K19      EQU      X'19'
K1C      EQU      X'1C'
K1E      EQU      X'1E'
K1F      EQU      X'1F'
K20      EQU      X'20'
K24      EQU      X'24'
K39      EQU      X'39'
K3C      EQU      X'3C'
K3F      EQU      X'3F'
K40      EQU      X'40'
K43      EQU      X'43'
K6C      EQU      X'6C'
K78      EQU      X'78'
K80      EQU      X'80'
K81      EQU      X'81'
KF0      EQU      X'F0'
KFF      EQU      X'FF'
K100     EQU      X'100'
K120     EQU      X'120'
K1FF     EQU      X'1FF'
K200     EQU      X'200'
K202     EQU      X'202'
K256     EQU      X'256'
K800     EQU      X'800'
KC00     EQU      X'C00'
K3FFF    EQU      X'3FFF'
K7FFF    EQU      X'7FFF'
K8000    EQU      X'8000'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -1
KN2      EQU      -2
KN3      EQU      -3
KN4      EQU      -4
KN8      EQU      -8
KN16     EQU      -16
KN100    EQU      -100
KTE      EQU      'E'
KTR      EQU      'R'
         PAGE
BE       EQU      X'683'
BNEZ     EQU      X'693'
BGE      EQU      X'681'
BGEZ     EQU      X'681'
BL       EQU      X'691'
BAZ      EQU      X'684'
BCR8     EQU      X'688'
BLE      EQU      X'682'
BEZ      EQU      X'683'
BCR10    EQU      X'68A'
         DEF      MESSAGE
*        QUIT     ERROR,CONDITION,OUTPUT
QUIT     CNAME
         PROC
LF       EQU      %
         DO       NUM(AF)=3
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+4+MODE
         FIN
         STW,AF(3) CODE
         ELSE
         DO       AF(2)~=0
         GEN,12,20  AF(2),%+3+MODE
         FIN
         FIN
         LI,R3    AF(1)
         DO       MODE=1
         LI,R4    AF(3)=SR3
         FIN
         B        MESSAGE
         PEND
SNAPIT   CNAME
         PROC
LF       CAL1,3   %+1
         DATA     0
         GEN,1,31 AFA(1),AF(1)
         GEN,1,31 AFA(2),AF(2)
         DATA     AF(3),AF(4),X'02000000'
         PEND
         PAGE
*                 STATIC DATA FOR LOADER.
M1       DATA,4   X'1'
M10      DATA,4   X'02'
M2       DATA,4   X'3'
M3       DATA,4   X'7'
M4       DATA,4   X'F'
M5       DATA,4   X'1F'
M6       DATA,4   X'3F'
M7       DATA,4   X'7F'
M8       DATA,4   X'FF'
M9       DATA,4   X'1FF'
M11      DATA     X'7FF'
M15      DATA     X'7FFF'
M16     DATA,4    X'FFFF'
M17      DATA     X'1FFFF'
M20      DATA     X'FFFFF'
M24      DATA     X'FFFFFF'
M30      DATA     X'3FFFFFFF'
M32      DATA,4   X'FFFFFFFF'
MN1      DATA,4   X'FFFFFFFE'
MN2      DATA,4   X'FFFFFFFC'
MN3      DATA,4   X'FFFFFFF8'
MN4      DATA,4   X'FFFFFFF0'
MN8      DATA,4   X'FFFFFF00'
MN9      DATA,4   X'FFFFFE00'
MN16     DATA,4   X'FFFF0000'
M826     DATA,4   X'00C0'
Y1       DATA,4   X'10000000'
Y2       DATA,4   X'20000000'
Y4       DATA,4   X'40000000'
Y68      DATA,4   X'68000000'
Y8       DATA,4   X'80000000'
Y01      DATA,4   X'1000000'
Y018     DATA     X'01800000'
Y02      DATA,4   X'2000000'
Y03      DATA,4   X'3000000'
Y05      DATA     X'05000000'
Y041     DATA,4   X'4100000'
Y048     DATA     X'04800000'
Y08      DATA,4   X'8000000'
Y0C      DATA,4   X'C000000'
Y0F      DATA,4   X'F000000'
Y006     DATA,4   X'00600000'
Y001     DATA,4   X'100000'
Y002     DATA,4   X'200000'
Y003     DATA,4   X'300000'
Y004     DATA,4   X'400000'
Y008     DATA,4   X'800000'
Y005     DATA     X'00500000'
Y00C     DATA,4   X'C00000'
Y001F    DATA,4   X'1F0000'
Y00F1    DATA     X'F10000'
Y00FFFF  DATA,4   X'FFFF00'
Y0001    DATA,4   X'10000'
Y0002    DATA,4   X'20000'
Y0003    DATA,4   X'30000'
Y0004    DATA,4   X'40000'
Y0005    DATA,4   X'50000'
Y0006    DATA,4   X'60000'
Y0007    DATA,4   X'70000'
Y0008    DATA,4   X'80000'
Y00008   DATA,4   X'8000'
Y000B    DATA,4   X'B0000'
Y000C    DATA,4   X'C0000'
Y0301    DATA,4   X'3010000'
Y0302    DATA,4   X'3020000'
Y0303    DATA,4   X'3030000'
Y0343    DATA,4   X'3430000'
Y0304    DATA,4   X'3040000'
Y0405    DATA,4   X'4050000'
Y0502    DATA,4   X'5020000'
Y0643    DATA,4   X'6430000'
Y0683    DATA,4   X'6830000'
Y00FF    DATA,4   X'FF0000'
YFF      DATA,4   X'FF000000'
YFF00FFFF    DATA,4  X'FF00FFFF'
Y000F    DATA,4   X'F0000'
YFFF0FFFF    DATA,4  X'FFF0FFFF'
         PAGE
MSKFTYPE EQU      Y000F
TXBLNK   DATA    X'40404040'
TXF:     DATA,4   X'C67A00'
TXM:     DATA,4   X'D47A00'
TXLIB    TEXTC    ':LIB'
TX6F4:   DATA,4   X'06C6F47A'
TXASTL   DATA     X'030000D3'
TXASTA   DATA     X'030000C1'
TXASTPL  DATA,4   X'037AD7D3'
TXASTDIC TEXTC    ':DIC'
TXASTD   DATA     X'030000C4'
TXM:DO   TEXTC    'M:DO'
TXS:OVRL TEXTC    'S:OVRLY'
         DO       MODE=1
         DO       CFU=1
TXM:STAR TEXTC    'M:*'
         FIN
         FIN
TX5F4:   DATA,4   X'05C6F47A'
TX3DCB   TEXTC    'DCB'
TXHEAD   GEN,8,24 4,'HEA'
         GEN,8,24 'D',0
STK2     GEN,1,15,1,15   1,STKSIZE,1,0
DSTK2   GEN,1,15,1,15   1,DECLSIZE,1,0
RFDFSTK2 GEN,1,15,1,15   1,K3FFF,1,0
PASSCODE GEN,8,8,8,8     3,1,2,2
HEADWD   DATA     X'8000FF18'
LHEADWD  DATA     X'8100FF18'
TXTREE   GEN,8,24 4,'TRE'
         GEN,8,24 'E',0
TXLOCCT  TEXTC    'LOCCT'
IN1      TEXTC    'IN1'
         TEXT     '    '
PS1      TEXTC    'PS1'
         TEXT     '    '
IN2      TEXTC    'IN2'
         TEXT     '    '
PS2      TEXTC    'PS2'
FIN      TEXTC    'FIN'
         TEXT     '    '
X8       DATA     8
         DO       MODE~=0
M:FVP    GEN,8,24 5,0
GVP      GEN,8,24 4,0
FCP      DATA     X'0D0000FF'
YE       DATA     X'E0000000'
         FIN
FDP      DATA     X'090000FF'
BREFBIT  EQU      Y4                BREF FLAG IN LOCWD
RFLDMODS DATA     X'40000004'       REF AND BREF FLAGS
IMPOSS   TEXTC    '  BAD ERROR MESSAGE FILE'
         PAGE
         DEF      READLM,WRITELM,CLOSE,WRITELL;
                  ,READEF,PRINT
         DEF      SEGLOAD
         DEF      KBDIC
M:LL     DSECT    1
         DATA     X'103'
         GEN,15,17 2,4
         DATA     0,0,0,0
         DATA     FPLLL
         DATA     0,0,0
         DATA     KBLL
         DO       11
         DATA     0
         FIN
FPLLL    DATA     X'01000003'
         DATA     0,0,0
         DATA     X'02000002',0,0,X'03000002',0,0
         DATA     X'07000003'
         DATA     0,0,0
         DATA     X'08010003'
         DATA     0,0,0
KBLL     RES      8
M:EF     DSECT    1
         DATA     0,0,0,0,0,0,FPLEF,0,0,0,KBEF
         DO       11
         DATA     0
         FIN
FPLEF    DATA     X'1000003'
         RES      3
         DATA     X'2000002',0,0,X'3000002',0,0,X'7010002',0,0
KBEF     RES      8
         REF      NOASGNS
M:LM     DSECT    1
         DATA     0,0,0,NOASGNS,0,X'80000000',FPLLM,0,0,0,KBLM
         DATA     0,X'0F000000'
         DO       9
         DATA     0
         FIN
FPLLM    DATA     X'1000003'
         RES      3
         DATA     X'2000002',0,0,X'3000002',0,0,X'4000002',0,0
         DATA     X'5000010'
         DO       16
         DATA     0
         FIN
         DATA     X'06000010'
         DO       16
         DATA     0
         FIN
         DO       MODE=0
SNM:LM   DATA     X'07000002'
         DO       2
         DATA     0
         FIN
         FIN
         DO       MODE=0
         DATA     X'0B010202',0,0
         ELSE
         DATA     X'0B000202',0,0
         DATA     X'14000010'
         DO       16
         DATA     0
         FIN
         DATA     X'15010003',0,0,0
         FIN
KBLM     RES      8
M:DIC    DSECT    1
         DATA     0,0,0,0,0,X'80000000',FPLDIC,0,0,0,KBDIC
         DO       11
         DATA     0
         FIN
FPLDIC   DATA     X'01000202'
         TEXTC    ':DIC'
         DATA     X'02010002',0,0
KBDIC    RES      8
M:LIB    DSECT    1
         DATA     0,0,0,0,0,0,FPLLIB,0,0,0,KBLIB
         DO       11
         DATA     0
         FIN
FPLLIB   DATA     X'01000202'
         TEXTC    ':LIB'
         DATA     X'02010202',0,0
KBLIB    RES      8
M:MSG    DSECT    1
         DATA     1,X'20000',PBUF+4
         DATA     BADERMSG,BADERMSG
         DATA     X'80000022',FPLMSG,0,0,0,KBMSG,0
         DATA     X'04000000'
         DO       9
         DATA     0
         FIN
FPLMSG   DATA     X'01000202'
         TEXTC    'ERRMSG'
         DATA     X'02010202'
         TEXT     ':SYS    '
KBMSG    RES      8
         CSECT    1
READLM   GEN,8,24 X'10',M:LM
         DATA     X'38000010'
         DATA     X'80000005',X'80000006',X'80000007'
WRITELM  GEN,8,24 X'11',M:LM
         DATA     X'38000070'
         DATA     X'80000005',X'80000006',X'80000007'
CLOSE    DATA     X'95000005',X'80000010',2
PRINT    GEN,8,24 1,M:LL
         GEN,1,31 1,0
         DATA     X'80000005'
READEF  GEN,8,24 X'10',M:EF
         DATA     X'7C000010'
         DATA     EOF,X'80000004',X'80000006',X'80000005',0
WRITELL  GEN,8,24 X'11',M:LL
         DATA     X'34000000'
         DATA     X'80000005',83,1
SEGLOAD  GEN,8,24 1,0
         DATA     X'80000005'
READDIC  GEN,8,24 X'10',M:DIC
         DATA     X'38000010'
         DATA     X'80000005',X'C',X'80000008'
RDMSG    GEN,8,24 X'10',M:MSG
         DATA     X'D8000000'
         DATA     BADERMSG
         DATA     BADERMSG
         DATA     X'80'
         DATA     ERFLAG
         PAGE
         CSECT
STUFF    RES      195
         BOUND    8
TSTACK   RES      256-(%-STUFF)
         RES      30                ALLOW EXTRA SPACE FOR
*                                    M:LM OPEN PLIST
SAVELOC  EQU      %
LNGTH    EQU      %-STUFF
DECLSTK  EQU      STUFF+0
DECLSTK1 EQU      STUFF+1
RFDFSTK  EQU      STUFF+2
RFDFSTK1 EQU      STUFF+3
EXPRSTK  EQU      STUFF+4
EXPRSTK1 EQU      STUFF+5
DECLBAS  EQU      STUFF+6
RFDFBAS  EQU      STUFF+7
EXPRBAS  EQU      STUFF+8
BSEG1    EQU      STUFF+9
BSEG2    EQU      STUFF+10
CSEG1    EQU      STUFF+11
CSEG2    EQU      STUFF+12
CROM1    EQU      STUFF+13
CROM2    EQU      STUFF+14
CRFDF1   EQU      STUFF+15
CRFDF2   EQU      STUFF+16
CURBYTE  EQU      STUFF+17
RCDSIZE  EQU      STUFF+18
SEQNUM   EQU      STUFF+19
SEVLEV   EQU      STUFF+20
XSL      EQU      STUFF+21
LASTCARD EQU      STUFF+22
BUF      EQU      STUFF+23
BUF2     EQU      STUFF+53
TEMPPTR  EQU      STUFF+57
TREEPTR  EQU      STUFF+58
ERRPTR   EQU      STUFF+59
FCOUNT   EQU      STUFF+60
FTABLE   EQU      STUFF+61
ERRTAB   EQU      STUFF+62
ERRSTK   EQU      STUFF+63
TCBSIZE  EQU      STUFF+64
TCBPTR   EQU      STUFF+65
FTAB     EQU      STUFF+66
RSEG00   EQU      STUFF+67
RSEG01   EQU      STUFF+68
RSEG10   EQU      STUFF+69
RREL00   EQU      STUFF+70
RREL01   EQU      STUFF+71
RREL10   EQU      STUFF+72
CSEG00   EQU      STUFF+73
CSEG01   EQU      STUFF+74
CSEG10   EQU      STUFF+75
CREL00   EQU      STUFF+76
CREL01   EQU      STUFF+77
CREL10   EQU      STUFF+78
MAX00    EQU      STUFF+79
MAX01    EQU      STUFF+80
MAX10    EQU      STUFF+81
DLOC     EQU      STUFF+82
PLOC     EQU      STUFF+83
SLOC     EQU      STUFF+84
LOC      EQU      STUFF+85
START    EQU      STUFF+86
LOCCT    EQU      STUFF+87
LOADBAS  EQU      STUFF+88
MODBAS   EQU      STUFF+89
RELDBAS  EQU      STUFF+90
MBIAS    EQU      STUFF+91
FBIAS    EQU      STUFF+92
BIAS     EQU      STUFF+93
RDIG     EQU      STUFF+94
MODSIZ   EQU      STUFF+95
NOTLLM   EQU      STUFF+96
MAXRFDF  EQU      STUFF+97
MAXEXPR  EQU      STUFF+98
TOPOMEM  EQU      STUFF+99
OPENEF   EQU      STUFF+100
OPENDIC  EQU      STUFF+117
PBUF     EQU      STUFF+132
CSECFLG  EQU      STUFF+153
PLIB     EQU      STUFF+154
LIB      EQU      STUFF+155
XMKEY    EQU      STUFF+156
LOCWD    EQU      STUFF+157
USID     EQU      STUFF+158
RFLDSG   EQU      STUFF+159
ERFLAG   EQU      STUFF+160
MXRFDFSG EQU      STUFF+161
NXTAVPG  EQU      STUFF+162
RLOC     EQU      STUFF+163
01SIZ    EQU      STUFF+164
TRESIZ   EQU      STUFF+165
FCOMSIZ  EQU      STUFF+166
XMRKEY   EQU      STUFF+167
04LOC    EQU      STUFF+168
DOREFPTR EQU      STUFF+169
RFLDTBSZ EQU      STUFF+170
BREFERR  EQU      STUFF+171
PASS3RET EQU      STUFF+172
ENTFLAG  EQU      STUFF+173
CORELIB  EQU      STUFF+174
BFR      EQU      STUFF+175
FIRSTF   EQU      STUFF+176
LASTF    EQU      STUFF+177
XCSEG1   EQU      STUFF+178
SYMBOLTB EQU      STUFF+179
SYMTOP   EQU      STUFF+180
TRAPCC   EQU      STUFF+181
CODE     EQU      STUFF+182
KICKOUT  EQU      STUFF+183
LIBFLG   EQU      STUFF+184
ROOTFLG  EQU      STUFF+185
VAL%SW   EQU      STUFF+186
HEADADR  EQU      STUFF+187
LMNSW    EQU      STUFF+188
MREFLAG  EQU      STUFF+190
MREFTAB  EQU      STUFF+191
TOVBALPSD EQU     STUFF+192
TOVBPSD  EQU      STUFF+193
CFUPTR   EQU      STUFF+194
DDSIZE   EQU      CFUPTR-DECLSTK+1
STKSIZE  EQU      256-DDSIZE-2
TEMPSIZE EQU      DDSIZE+STKSIZE+2
         DEF      01SIZ
        PAGE
ROMTPTR  EQU      CROM1
DECLSIZE EQU      X'40'
EXPRDIS  EQU      8
RFLOADIS EQU      10
RFDFDIS  EQU      6
NXROMDIS EQU      2
SBLNKDIS EQU      4
ROM1DIS  EQU      3
TMPSZDIS EQU      8
NUNSTDIS EQU      8
00DIS    EQU      5
01DIS    EQU      7
10DIS    EQU      9
NRWACCT  EQU      9
TREESIZE EQU      11
TREEDIS  EQU      2
BIASDIS  EQU      4
LOWLIMDS EQU      5
FCOMDIS  EQU      6
ERRDIS   EQU      7
LMNDIS   EQU      10
USACTDIS EQU      13
LMPASS   EQU      15
LMEXPDIS EQU      17
LIBPASS  EQU      19
RDACT1   EQU      21
ROMSIZE  EQU      7
ROMSIZEL EQU      X'70000'
TCBBLNK  EQU      2
HEADRFDF EQU      5
         DO       MODE=0
HEADSIZE  EQU     6
         ELSE
HEADSIZE EQU      12
         FIN
         PAGE
*                 FILL UP REMAINDER OF LOADER'S 00 ROOT AREA WITH CODE
         ORG      SAVELOC
         DEF      LOADER
LOADER   EQU      %
         DO       DEBUG=1
         LI,R7    0
         FIN
*                                   IF TREE SIZE IS X'C',DONT DO
*                                   SEGLOADS-THERE WAS NO TREE CARD
*  (R7) = 0       IF ENTRY FROM CCI
*  (R7) = X'00FF0000' IF ENTRY FROM SYSGEN 'PASS3'
*                 THEREFORE, RETURN VIA M:LDTRC TO ID IN SR1
         DO       MODE~=0
         DO       DEBUG=0
         LI,R5    IN1
         CAL1,8   SEGLOAD
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD1
         LI,R5    PS1
         CAL1,8   SEGLOAD
         BAL,SR4  PASS1
         LI,R5    IN2
         CAL1,8   SEGLOAD
         BAL,SR4  INIT2
         BAL,SR4  PASS2
FIN%LD1  EQU      %
         LI,R5    FIN
         CAL1,8   SEGLOAD
         BAL,SR4  FINISH            DO MODIFYS AND MAP
         ELSE
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD2
         BAL,SR4  PASS1
         BAL,SR4  INIT2
         BAL,SR4  PASS2
FIN%LD2  EQU      %
         BAL,SR4  FINISH            DO MODIFYS AND MAP
         FIN
         ELSE
         LI,R5    M:LL
         AND,R5   MN9
         AI,R5    2
         LW,R5    *R5
         CI,R5    KC
         BLE      %+3
         LI,R5    IN1
         CAL1,8   SEGLOAD
         BAL,SR3  INIT1
         LW,R5    LMNSW
         BNEZ     FIN%LD3
         LW,R5    TRESIZ
         BEZ      NOLDPS1
         LI,R5    PS1
         CAL1,8   SEGLOAD
NOLDPS1  EQU      %
         BAL,SR4  PASS1
         LW,R5    TRESIZ
         BEZ      %+3
         LI,R5    IN2
         CAL1,8   SEGLOAD
         BAL,SR4  INIT2
         LW,R5    TRESIZ
         BEZ      %+3
         LI,R5    PS2
         CAL1,8   SEGLOAD
         BAL,SR4  PASS2
         LW,R5    TRESIZ
         BEZ      %+3
FIN%LD3  EQU      %
         LI,R5    FIN
         CAL1,8   SEGLOAD
         BAL,SR4  FINISH            DO MODIFYS AND MAP
*                                   NORMAL EXIT FROM LOADER
         FIN
         LI,D4    0                 SET OK FLAG FOR PASS3.
LEAVE    EQU      %
         LW,R7    ENTFLAG           RESTORE ENTRY FLAG
         DO       MODE=0
         CW,R7    L(X'00FF0000')    ENTERED VIA M:LINK CALL FROM PASS3
         BAZ      CCIEXIT
         ELSE
         BGEZ     CCIEXIT
*
*                                   RETURN TO PASS3.
*                                   RELEASE ALL DYNAMIC DATA.
         REF      JB:VLH,JB:LMAP,J:DDLL
         CAL1,8   FCP               RELEASE COMMON.
         CAL1,8   FDP               RELEASE DYNAMIC.
         LB,R2    JB:VLH            GET HEAD OF VIRTUAL CHAIN.
RELMORE  EQU      %
         LW,R1    R2
         BEZ      RETURN
         LB,R2    JB:LMAP,R1
         CLM,R1   J:DDLL
         BCR,9    INLIMITS
         B        RELMORE
INLIMITS EQU      %                 RELEASE REMAINDER
         SLS,R1   9                 OF PAGES OBTAINED
         AW,R1    Y05             VIRTUALLY.
         CAL1,8   1
         B        RELMORE
RETURN   EQU      %
         FIN
         LW,SR1   PASS3RET
         LW,R7    L(X'03000000')    YES--DO RETURN VIA
         CAL1,8   R7                   M:LDTRC BACK TO SYSGEN PASS3
CCIEXIT  EQU      %
         MTB,0    D4
         BNEZ     EXITE
         CAL1,9   1
EXITE    CAL1,9   3
         PAGE
*                 GET BYTE IN R5.  READ A CARD IF NECESSARY. IF EOF
*                 OCCURS, DATA ERROR. IF LAST CARD OF BINARY DECK,
*                 SET LASTCARD. IF LASTCARD SET AND BYTES READ PAST
*                 END, DATA ERROR. CHECK SEQUENCE AND CHECKSUM. RECORD
*                 SIZE MUST BE LESS THAN OR EQUAL TO 108.
*
*                                   CURRENT BYTE NEGATIVE IS A SPECIAL
*                                   CASE TO JUST RUN CHECKS IN THE
*                                   FIRST WORD.
GBYTE   LCI      K4
         PSM,R1   *R0
         PSW,R6   *R0
         LW,R1    CURBYTE
         BLZ      GBYTE3
         CW,R1    RCDSIZE
         BL       NXTBYTE
         PSW,SR4  *R0
         BAL,SR4  READBILI
         B        ER1X
         PLW,SR4  *R0
GBYTE3   EQU      %
         LW,R5    BFR
         LB,R1    *R5
         CI,R1    K3C
         BE       GBYTE1
         CI,R1    K1C
         BE       GBYTE0
         CI,R1    K81
         BL       ER2X
         CI,R1    X'83'
         BG       ER2X
GBYTE0   STW,R1   LASTCARD
GBYTE1   LI,R1    K1
         LW,R2    SEQNUM
         AI,R2    K1
         LW,R4    BFR
         CB,R2    *R4,R1
         QUIT     ER3,BE
         STW,R2   SEQNUM
         LI,R1    K3
         LB,R1    *R4,R1
         CI,R1    K5
         BL       ER4X
         CI,R1    K6C
         BG       ER4X
         AI,R1    KN1
         STW,R1   RCDSIZE
         LI,R2    K2
         LB,R5    *R5
GBYTE2   LW,R4    BFR
         LB,R4    *R4,R1
         AW,R5    R4
         BDR,R1   GBYTE2
         LW,R4    BFR
         LB,R4    *R4,R2
         CI,R4    KFF
         BE       CHKSMOK
         SW,R5    R4
         LW,R1    BFR
         CB,R5    *R1,R2
         QUIT     ER5,BE
CHKSMOK  LI,R1    K3
NXTBYTE  AI,R1    K1
         STW,R1   CURBYTE
         LW,R5    BFR
         LB,R5    *R5,R1
         PLW,R6   *R0
         LCI      K4
          PLM,R1  *R0
         B        *SR4
         PAGE
         DO       MODE=1
         DEF      TRAP,CHKLM
TRAP     EQU      %
         STCF     TRAPCC
         LW,R0    0,R1
         LCI      15
         LM,1     3,1
         ANLZ,R0  *R0
         STCF     2
         SLS,2    -30
         SLS,0    -2,2
         AND,R0   MN9
         AW,R0    GVP
         CAL1,8   0
         BCS,8    STMPSM
         CAL1,9   5
CHKLM    PSW,R6   *R0
         MTB,0    *R5,R6            5=BUFFER
         AI,R6    -X'800'           6=SIZE
         BGZ      %-2
         MTB,0    *R5
         PLW,R6   *R0
         B        *SR4
STMPSM   EQU      %
         AI,0     X'200'
         CAL1,8   0
         BCR,8    STMPSM1
         LW,R1    YE
         CW,R1    TRAPCC
         BAZ      MEMTRAP
LDRTRAP  QUIT     X'2A',,R0
MEMTRAP  AND,R0   M17
         CW,R0    LOCCT
         BL       LDRTRAP
         CW,R0    TOPOMEM
         BG       LDRTRAP
         QUIT     ER1F,,R0
STMPSM1  CAL1,9   5
         FIN
         PAGE
*                                   ROUTINES TO READ 1,2,3 OR 4 BYTE
*                                   NUMBERS.
*                                   RESULTS IN R7.
2BNUM    PSW,SR4  *R0
2BNUM2   BAL,SR4  GBYTE
         LW,R7    R5
2BNUM1   BAL,SR4  GBYTE
         STB,R5   R7
         SCS,R7   8
         PLW,SR4  *R0
         B        *SR4
*                 READ A THREE BYTE NUMBER. RESULTS IN R7.
3BNUM    PSW,SR4  *R0
         BAL,SR4  2BNUM
         B        2BNUM1
*                 READ ONE OR TWO BYTES DEPENDING ON NUMBER OF DECL'S.
12BNUM   PSW,SR4  *R0
         LI,SR4   K7FFF
         AND,SR4  DECLSTK1
         CI,SR4   K100
         BG       2BNUM2
         LI,R7    K0
         B        2BNUM1
*
4BNUM    PSW,SR4  *R0
         BAL,SR4  3BNUM
         BAL,SR4  2BNUM1
         PAGE
*                                   READBILI READS A RECORD FROM M:EF.
*                                   IF THE RECORD IS KEYED "HEAD" IS
*                                   USED AND THE HEADER IS RETURNED.
*                                   NORMAL RETURN IS +2, END OF FILE
*                                   IS +1. IF "NO-SUCH-KEY" IS
*                                   RETURNED AN ATTEMPT IS MADE TO
*                                   READ WITH THE LIBRARY LOAD MODULE
*                                   NAME IN FRONT OF HEAD.IF THIS
*                                   FAILS THE ROUTINE ABORTS.
READBILI EQU      %
         LI,R5    TXHEAD
CALEF    LI,R4    BUF
         LI,R6    K78
         CAL1,1   READEF
         AI,SR4   K1
         B        *SR4
EOF      LI,SR1   K6
         CB,SR1   SR3
         BE       *SR4
         B        ER6X
LIBER    LI,SR1   K43
         CB,SR1   SR3
         BNE      ER6X
         LI,R4    BUF2
         LW,R5    CROM1
         AW,R5    R2
         LI,R6    PBUF
         LCI      3
         LM,SR1   *R5
         STM,SR1  *R4
         STM,SR1  *R6
         MTB,4    *R4
         LB,R5    *R4
         CI,R5    X'F'              IS LMN NAME LESS THAN 12 CHARS.
         QUIT     X'26',BLE,R5
         LI,R6    K4
         LB,SR1   TXHEAD,R6
         STB,SR1  *R4,R5
         BDR,R5   %+1
         BDR,R6   %-3
         LW,R5    R4
         CAL1,1   SETERR
         B        CALEF
SETERR   GEN,8,24 6,M:EF
         DATA     X'80000000',ER6X
         PAGE
*                                   THIS ROUTINE FOLLOWS A TREE
*                                   STRUCTURE. R4 IS THE CURRENT
*                                   SEGMENT AND R5 CONTAINS THE BASE
*                                   SEG. THE RETURNS USE +1 FOR A
*                                   SUBLINK, +2 FOR AN OVERLAY AND
*                                   +3 FOR NO MORE SEGMENTS.
         CSECT    1
GETSEG   LW,R6    *R4
         CW,R6    *R5
         BL       SEGMENT0
         AI,R6    SBLNKDIS
         LW,R7    *R1,R6
         LH,R7    R7
         BNEZ     CHGCSEG
GOVERLAY AI,SR4   K1
GOVERLY1 LW,R7    *R1,R6
         AND,R7   M16
         BNEZ     CHGCSEG
         AI,R6    KN1
         LW,R6    *R1,R6
         AND,R6   M16
         LW,R7    R6
         CW,R6    *R5
         BE       SEGMENT0
         BL       CHGCSEG
         AI,R6    SBLNKDIS
         B        GOVERLY1
SEGMENT0 CI,R6    K0
         BNE      BACKSEG
         AI,SR4   K1
         B        *SR4
BACKSEG  AI,R6    ROM1DIS
         LW,R7    *R1,R6
         AND,R7   M16
CHGCSEG  STW,R7   *R4
         B        *SR4
         PAGE
*                                   GENERAL ERROR ROUTINE FOR PRINTING
*                                   A MESSAGE, THE LAST E.F. NAME AND
*                                   THE LAST SEQUENCE #.
ER1      EQU      X'01'
ER2      EQU      X'02'
ER3      EQU      X'03'
ER4      EQU      X'04'
ER5      EQU      X'05'
ER6      EQU      X'06'
ER7      EQU      X'07'
ER8      EQU      X'08'
ER9      EQU      X'09'
ERA      EQU      X'0A'
ERB      EQU      X'0B'
ERC      EQU      X'0C'
ERD      EQU      X'0D'
ERE      EQU      X'0E'
ERF      EQU      X'0F'
ER10     EQU      X'10'
ER11     EQU      X'11'
ER12     EQU      X'12'
ER13     EQU      X'13'
ER14     EQU      X'14'
ER15     EQU      X'15'
ER16     EQU      X'16'
ER17     EQU      X'17'
ER18     EQU      X'18'
ER19     EQU      X'19'
ER1A     EQU      X'1A'
ER1B     EQU      X'1B'
ER1F     EQU      X'1F'
ER20     EQU      X'20'
ER21     EQU      X'21'
ER22     EQU      X'22'
ER23     EQU      X'23'
* ER22 NO ROOM TO READ LIBRARY REF/DEF STACK.
*ER23  NO ROOM TO UPDATE LIBRARY                                     WRT
ER32     EQU      X'32'
MESSAGE  EQU      %
         DO       MODE=1
         CI,R4    K0
         BE       NOTIO
         BAL,SR4  BLANKER           IF I/O ERROR OCCURRED,
         LI,SR4   X'0300'           FIRST ACCESS ERRMSG
         SCD,SR3  8                 FILE FOR APPROPRIATE
         SLS,SR3  -1                CODE FOR C(SR3)
         SCD,SR3  8
         STW,SR4  ERFLAG
         LI,R5    PBUF
         CAL1,2   PRINT
         LW,R7    ERFLAG
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+1
         LI,R5    X'4040'
         STH,R5   PBUF+1
         STW,D4   PBUF+2
         CAL1,1   RDMSG
         LI,R5    PBUF
         CAL1,2   PRINT
NOTIO    EQU      %
         FIN
         LW,R4    Y0302
         STW,R4   ERFLAG
         AWM,R3   ERFLAG
         BAL,SR4  BLANKER
         LI,R5    PBUF
         CAL1,2   PRINT
         LW,R7    ERFLAG
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+1
         LI,R5    X'4040'
         STH,R5   PBUF+1
         STW,D4   PBUF+2
         CAL1,1   RDMSG             GET RECORD
         LI,R5    PBUF
         CAL1,2   PRINT             PRINT IT
*                                   ABORT CONDITION
         BAL,SR4  BLANKER
*                                   MOVE COL. HEADINGS TO PBUF & PRINT
         LCI      3
         LM,R6    TXEF
         STM,R6   PBUF+1
         LCI      2
         LM,R6    TXSEQ
         STM,R6   PBUF+5
         LW,R7    CODE
         BEZ      VARDATA
         LCI      3
         LM,R6    TXCODE
         STM,R6   PBUF+8
VARDATA  EQU      %
         CAL1,2   PRINT
         BAL,SR4  BLANKER
*                                   PRINT EF NAME, SEQNUM AND CODE
         LCI      3
         LM,R6    OPENEF+8
         STM,R6   PBUF+1
         LI,R2    K40
         STB,R2   PBUF+1            BLANK OUT BYTE COUNT OF NAME
         LW,R7    SEQNUM
         BNEZ     MESSAGE4
         LI,R2    X'F0'
         STB,R2   PBUF+6
         B        %+4
MESSAGE4 EQU      %
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+5
         STW,D4   PBUF+6
         LW,R7    CODE
         BAL,SR4  BINTOHEX
         STW,D3   PBUF+9
         STW,D4   PBUF+10
ERROUT   EQU      %
         CAL1,2   PRINT
         CI,R3    X'2A'
         BNE      %+2               IN CASE OF LOADER TRAP, SNAP
SNAP     CAL1,3   SNAPFPT           DATA PAGE, RFDF & EXPR STKS
         LI,R5    M:LL
         CAL1,1   CLOSE
         LI,D4    -1                SET BAD FLAG FOR PASS3
*
         B        LEAVE
BADERMSG EQU      %
         CAL1,2   PRINT
         LI,R5    IMPOSS
         B        ERROUT
TXEF     TEXT     'INPUT FILE'
TXSEQ    TEXT     'SEQ. NO.'
TXCODE   TEXT     'CODE/SIZE/SL'
SNAPFPT  DATA     SNAPFPT+7
         DATA     DECLSTK
         DATA     DECLSTK+512
         TEXT     'DATAPAGE'
         NOP
         GEN,8,24 X'68',SNAP+1
         DATA     SNAPFPT+14
         GEN,1,31 1,RFDFBAS
         GEN,1,31 1,RFDFSTK
         TEXT     'RFDF STK'
         NOP
         GEN,8,24 X'68',SNAP+1
         DATA     0                 END OF FPT CHAIN
         GEN,1,31 1,EXPRBAS
         GEN,1,31 1,EXPRSTK
         TEXT     'EXPR STK'
         NOP
         GEN,8,24 X'68',SNAP+1
         PAGE
 ERROR,X'F',(%-DECLSTK)>X'1FF' 'LOADER 00 AREA EXCEEDS ONE PAGE'
         CSECT    1
*                                   THIS ROUTINE FILLS PBUF WITH BLANKS.
BLANKER  EQU      %
         LI,R4    -12
         LW,D1    TXBLNK
         LW,D2    TXBLNK
         STD,D1   PBUF+22,R4
         BIR,R4   %-1
         LI,R4    83
         STB,R4   PBUF              BYTE COUNT
         B        *SR4
        PAGE
*                                   THIS ROUTINE TAKES A BINARY # IN R7
*                                   AND CONVERTS IT TO AN 8-DIGIT
*                                   EBCDIC DOUBLEWORD IN D3 & D4 WITH
*                                   LEAD ZEROS SUPPRESSED.
BINTOHEX LI,R1    K8
         LI,R2    K0
BXLOOP   LI,R6    K0
         SLD,R6   4
         CI,R6    K0
         BE       ZSUP
         LW,R2    R6
FORMX    CI,R6    K9
         BLE      DIGIT
         AI,R6    TXA-KA
         B        STOIT
DIGIT    AI,R6    KF0
STOIT    STB,R6   D3
         SCD,D3   8
         BDR,R1   BXLOOP
         B        *SR4
ZSUP      CI,R2    K0
         BNE      DIGIT
         LI,R6    K40
         B        STOIT
TXA      EQU      X'C1'
         PAGE
         DO       MODE=0
         REF      XMEMEOF
         DEF      XMEMEOFX
XMEMEOFX B        XMEMEOF
         FIN
XMEM3X   B        XMRDERR
ER1X     QUIT     ER1,,SR3
ER2X     QUIT     ER2,,R1
ER4X     QUIT     ER4,,R1
ER6X     QUIT     ER6,,SR3
ER7X     QUIT     ER7,,SR3
ER10X    QUIT     ER10,,SR3
ERAX     QUIT     ERA,,R1
         PAGE
*                                   THIS ROUTINE CHECKS THE VALIDITY
*                                   OF DECLARATION NUMBERS INVOLVED IN
*                                   EXPRESSIONS.
DECLCHK  EQU      %
         LW,R3    DECLSTK+1
         AND,R3   M15
         CW,R7    R3
         BLE      *SR4
         QUIT     X'28',,R7
* ERROR 28 = INVALID DECLARATION NUMBER REFERENCE
         END      LOADER

