home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibmtsonih / tsnmac.alp < prev    next >
Text File  |  2020-01-01  |  268KB  |  9,209 lines
  1. //MWCMACRO JOB (ZZXZ,504,E,60,30),'COMMON MACROS'
  2. /*ROUTE  XEQ  MSS
  3. /*RERUN
  4. /*CNTL MILWYL,EXCLUSIVE
  5. //PROCLIB DD DSN=ZZXZMWC.PROCLIB.XA,DISP=SHR
  6. //  EXEC  MWCMLIBF,LIBRARY=COMMON,SIZE=350,INCR=50,DIR=20
  7. //SYSIN DD *
  8. ./       ADD   LIST=ALL,NAME=AAAAAAAA
  9. TITLE 'COMMON MACRO LIBRARY';
  10. BAL;
  11. ./       ADD   LIST=ALL,NAME=ADDB
  12.          MACRO
  13. &L       ADDB  &R,&A
  14.          GBLC  &SIM370
  15. &L       MMVC  4*3+3+&SIM370,&A,1
  16.          AL    &R,4*3+&SIM370
  17.          MEND
  18. ./       ADD   LIST=ALL,NAME=ADDF
  19.          MACRO
  20. &L       ADDF  &R,&A
  21.          GBLC  &CPU,&SIM370
  22.          AIF   ('&CPU' EQ '360').S360
  23. &L       UAOP  A,&R,&A
  24.          MEXIT
  25. .S360    ANOP
  26. &L       MMVC  &SIM370,&A,4
  27.          A     &R,&SIM370
  28.          MEND
  29. ./       ADD   LIST=ALL,NAME=ADDH
  30.          MACRO
  31. &L       ADDH  &R,&A
  32.          GBLC  &CPU,&SIM370
  33.          AIF   ('&CPU' EQ '360').S360
  34. &L       UAOP  AH,&R,&A
  35.          MEXIT
  36. .S360    ANOP
  37. &L       MMVC  &SIM370,&A,2
  38.          AH    &R,&SIM370
  39.          MEND
  40. ./       ADD   LIST=ALL,NAME=ADDLF
  41.          MACRO
  42. &L       ADDLF &R,&A
  43.          GBLC  &CPU,&SIM370
  44.          AIF   ('&CPU' EQ '360').S360
  45. &L       UAOP  AL,&R,&A
  46.          MEXIT
  47. .S360    ANOP
  48. &L       MMVC  &SIM370,&A,4
  49.          AL    &R,&SIM370
  50.          MEND
  51. ./       ADD   LIST=ALL,NAME=ADDLH
  52.          MACRO
  53. &L       ADDLH &R,&A
  54.          GBLC  &SIM370
  55. &L       MMVC  4*2+2+&SIM370,&A,2
  56.          AL    &R,4*2+&SIM370
  57.          MEND
  58. ./       ADD   LIST=ALL,NAME=ADDP
  59.          MACRO
  60. &L       ADDP  &R,&A
  61.          GBLC  &SIM370
  62. &L       MMVC  4*1+1+&SIM370,&A,3
  63.          AL    &R,4*1+&SIM370
  64.          MEND
  65. ./       ADD   LIST=ALL,NAME=AI
  66.          MACRO
  67. &L       AI    &R,&V
  68.          LCLA  &X
  69. .*
  70. .LOOP    ANOP
  71. &X       SETA  &X+1
  72.          AIF   (&X GT K'&V).INT
  73.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  74. .*
  75.          AIF   ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0').LA
  76. &L       AL    &R,=A(&V)
  77.          MEXIT
  78. .*
  79. .INT     ANOP
  80.  AIF ('&R' NE '0' AND '&R' NE 'R0' AND '&R' NE 'VR0' AND &V LT 4096).LA
  81. &L       AL    &R,=F'&V'
  82.          MEXIT
  83. .*
  84. .LA      ANOP
  85. &L       LA    &R,&V.(,&R)
  86.          MEND
  87. ./       ADD   LIST=ALL,NAME=APRIVSCN
  88. ALP;
  89.  
  90. MACRO &&L: APRIVSCN &&BYTE,&&TYPE=;
  91.    LCLC &&LBL;
  92.    &&LBL: SETC 'ASCN&SYSNDX';
  93.  
  94.    SYSKWT TYPE,&&TYPE,(NO),COND=NO;
  95.  
  96.    &&L: SYSLBL;
  97.    BEGIN SCAN *;
  98.       SCKW &&TYPE.MAILBOX,&&LBL,CODE=AL1(KWRAFMB);
  99.       SCKW &&TYPE.MAILPEND,&&LBL,CODE=AL1(KWRAFMP);
  100.       SCKW &&TYPE.PROFILE,&&LBL,CODE=AL1(KWRAFPRO);
  101.       SCKW &&TYPE.MILTENRECOVERY,&&LBL,CODE=AL1(KWRAFRCM);
  102.       SCKW &&TYPE.TSORECOVERY,&&LBL,CODE=AL1(KWRAFRCT);
  103.       SCKW ,*,B;
  104.  
  105.       &&LBL:
  106.       ASM IF ('&TYPE' EQ 'NO')
  107.       THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
  108.       ELSE EXI VRE,OI,&&BYTE,0;
  109.       SCANEND; END;
  110.    MEND;
  111. BAL;
  112. ./       ADD   LIST=ALL,NAME=APRIVSEG
  113. ALP;
  114.  
  115. MACRO &&L: APRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
  116.  
  117.    &&L: SYSLBL;
  118.    SELECT;
  119.       <TM &&BYTE,KWRAFMB>: BEGIN
  120.          APRIVSG1 'MAILBOX',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  121.          END;
  122.       <TM &&BYTE,KWRAFMP>: BEGIN
  123.         APRIVSG1 'MAILPEND',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  124.          END;
  125.       <TM &&BYTE,KWRAFPRO>: BEGIN
  126.          APRIVSG1 'PROFILE',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  127.          END;
  128.       <TM &&BYTE,KWRAFRCM>: BEGIN
  129.   APRIVSG1 'MILTENRECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  130.          END;
  131.       <TM &&BYTE,KWRAFRCT>: BEGIN
  132.      APRIVSG1 'TSORECOVERY',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  133.          END;
  134.       ENDSEL;
  135.    MEND;
  136. BAL;
  137. ./       ADD   LIST=ALL,NAME=APRIVSG1
  138. ALP;
  139.  
  140. MACRO &&L: APRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
  141.    &&L: SYSLBL;
  142.    ASM IF ('&BEFORE' NE '')
  143.    THEN APRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
  144.    APRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
  145.    ASM IF ('&AFTER' NE '')
  146.    THEN APRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
  147.    MEND;
  148. BAL;
  149. ./       ADD   LIST=ALL,NAME=APRIVSG2
  150. ALP;
  151.  
  152. MACRO &&L: APRIVSG2 &&VAREA,&&A,&&N;
  153.    &&L: SYSLBL;
  154.    ASM IF ('&VAREA' EQ '')
  155.    THEN TSEG &&A,&&N
  156.    ELSE VSEG &&VAREA,&&A,&&N;
  157.    MEND;
  158. BAL;
  159. ./       ADD   LIST=ALL,NAME=AREA
  160.          MACRO
  161. &L       AREA  &ALIGN,&DSECT=
  162.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  163.          GBLA  &AREAN,&AREAP(10)
  164. .*
  165.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  166.          SYSKWT DSECT,&DSECT,(YES,NO),COND=NO
  167. .*
  168.          AIF   (&AREAN EQ 0 OR '&DSECT' NE 'YES').OKDSECT
  169.          MNOTE 12,'"DSECT=YES" ILLEGAL FOR NESTED AREA'
  170. .OKDSECT ANOP
  171. .*
  172. &AREAN   SETA  &AREAN+1
  173. &AREAL(&AREAN) SETC '&L'
  174.          AIF   ('&L' NE '').LBL
  175. &AREAL(&AREAN) SETC 'AREA&SYSNDX'
  176. .LBL     ANOP
  177. &AREAC(&AREAN) SETC '*'
  178. .*
  179. &AREAB(&AREAN) SETC '0X'
  180.          AIF   ('&ALIGN' EQ '').AOK
  181. &AREAB(&AREAN) SETC '&ALIGN'
  182.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  183. &AREAB(&AREAN) SETC '0&ALIGN'
  184. .AOK     ANOP
  185. .*
  186. &AREAP(&AREAN) SETA 0
  187. .*
  188.       AIF (('&DSECT' EQ '' OR '&DSECT' EQ 'YES') AND &AREAN EQ 1).DSECT
  189. &AREAL(&AREAN) DS &AREAB(&AREAN)
  190.          MEXIT
  191. .*
  192. .DSECT   ANOP
  193. &AREAC(&AREAN) SETC '&SYSECT'
  194. &AREAL(&AREAN) DSECT
  195.          MEND
  196. ./       ADD   LIST=ALL,NAME=AREAEND
  197.          MACRO
  198. &L       AREAEND &ALIGN
  199.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  200.          GBLA  &AREAN,&AREAP(10)
  201. .*
  202.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  203.          AIF   (&AREAN LE 0).ERR
  204. .*
  205.          AIF   ('&ALIGN' EQ '').AOK
  206. &AREAB(&AREAN) SETC '&ALIGN'
  207.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  208. &AREAB(&AREAN) SETC '0&ALIGN'
  209. .AOK     ANOP
  210. .*
  211.          DS    &AREAB(&AREAN)
  212. .*
  213.          AIF   (&AREAP(&AREAN) LE 0).NORG
  214. .ORGLOOP ANOP
  215.          ORGHIGH *,&AREAO(&AREAP(&AREAN)),BASE=&AREAL(&AREAN)
  216. &AREAP(&AREAN) SETA &AREAP(&AREAN)-1
  217.          AIF   (&AREAP(&AREAN) LE 0).NORG
  218.          AIF   (&AREAN LE 1).ORGLOOP
  219.          AIF   (&AREAP(&AREAN) GT &AREAP(&AREAN-1)).ORGLOOP
  220. .NORG    ANOP
  221. .*
  222.          AIF   ('&L' EQ '').NLEN
  223. &L       EQU   *-&AREAL(&AREAN)
  224. .NLEN    ANOP
  225. .*
  226.          AIF   ('&AREAC(&AREAN)' EQ '*').NCSECT
  227. &AREAC(&AREAN) CSECT
  228. .NCSECT  ANOP
  229. .*
  230. &AREAN   SETA  &AREAN-1
  231.          MEXIT
  232. .*
  233. .ERR     ANOP
  234.          MNOTE 12,'NO MATCHING AREA MACRO'
  235.          MEND
  236. ./       ADD   LIST=ALL,NAME=AREAORG
  237.          MACRO
  238. &L       AREAORG &ALIGN
  239.          GBLC  &AREAL(10),&AREAB(10),&AREAC(10),&AREAO(50)
  240.          GBLA  &AREAN,&AREAP(10)
  241.          LCLC  &A
  242. .*
  243.    SYSKWT ALIGNMENT,&ALIGN,(X,0X,C,0C,H,0H,Y,0Y,F,0F,A,0A,D,0D),COND=NO
  244.          AIF   (&AREAN LE 0).ERR
  245. .*
  246. &A       SETC  '&AREAB(&AREAN)'
  247.          AIF   ('&ALIGN' EQ '').AOK
  248. &A       SETC  '&ALIGN'
  249.          AIF   ('&ALIGN'(1,1) EQ '0').AOK
  250. &A       SETC  '0&ALIGN'
  251. .AOK     ANOP
  252. .*
  253.          AIF   ('&A' EQ '0X' OR '&A' EQ '0C').NDS
  254.          DS    &A
  255. .NDS     ANOP
  256. .*
  257.          AIF   ('&L' EQ '').NLEN
  258. &L       EQU   *-&AREAL(&AREAN)
  259. .NLEN    ANOP
  260. .*
  261. &AREAP(&AREAN) SETA &AREAP(&AREAN)+1
  262.          AIF   (&AREAP(&AREAN) GT 1 OR &AREAN EQ 1).NPREV
  263. &AREAP(&AREAN) SETA &AREAP(&AREAN-1)+1
  264. .NPREV   ANOP
  265. .*
  266. AREA&SYSNDX EQU *
  267. &AREAO(&AREAP(&AREAN)) SETC 'AREA&SYSNDX'
  268.          ORG   &AREAL(&AREAN)
  269.          MEXIT
  270. .*
  271. .ERR     ANOP
  272.          MNOTE 12,'NO MATCHING AREA MACRO'
  273.          MEND
  274. ./       ADD   LIST=ALL,NAME=BEH
  275.          MACRO
  276. &L       BEH   &A
  277. &L       BNL   &A
  278.          MEND
  279. ./       ADD   LIST=ALL,NAME=BEHR
  280.          MACRO
  281. &L       BEHR  &R
  282. &L       BNLR  &R
  283.          MEND
  284. ./       ADD   LIST=ALL,NAME=BER
  285.          MACRO
  286. &L       BER   &R
  287. &L       BCR   8,&R
  288.          MEND
  289. ./       ADD   LIST=ALL,NAME=BHR
  290.          MACRO
  291. &L       BHR   &R
  292. &L       BCR   2,&R
  293.          MEND
  294. ./       ADD   LIST=ALL,NAME=BLDLLIST
  295.          MACRO
  296. &L       BLDLLIST &LENGTH=58
  297.          LCLA  &C,&X,&Y,&Z
  298.          LCLB  &SW(32)
  299. .*
  300. &L       DC    Y(BLDL&SYSNDX,&LENGTH)
  301. .*
  302. &X       SETA  0-1
  303. .LOOP    ANOP
  304. &X       SETA  &X+2
  305.          AIF   (&X GT N'&SYSLIST).DONE
  306. &Z       SETA  0
  307. &Y       SETA  0-1
  308. .SELECT  ANOP
  309. &Y       SETA  &Y+2
  310.          AIF   (&Y GT N'&SYSLIST).HAVE
  311.          AIF   ('&SYSLIST(&Y+1)' EQ '').SELECT
  312.          AIF   (&SW(&Y)).SELECT
  313.          AIF   (&Z EQ 0).LOW
  314.    AIF ('&SYSLIST(&Z+1)        '(1,8) LE '&SYSLIST(&Y+1)        '(1,8))*
  315.                .SELECT
  316. .LOW     ANOP
  317. &Z       SETA  &Y
  318.          AGO   .SELECT
  319. .*
  320. .HAVE    ANOP
  321. &SYSLIST(&Z) DC CL8'&SYSLIST(&Z+1)'
  322.          DC    XL4'000000FF'
  323.          DC    XL(&LENGTH-12)'00'
  324. &SW(&Z)  SETB  1
  325. &C       SETA  &C+1
  326.          AGO   .LOOP
  327. .*
  328. .DONE    ANOP
  329. BLDL&SYSNDX EQU &C
  330.          MEND
  331. ./       ADD   LIST=ALL,NAME=BLE
  332.          MACRO
  333. &L       BLE   &A
  334. &L       BNH   &A
  335.          MEND
  336. ./       ADD   LIST=ALL,NAME=BLER
  337.          MACRO
  338. &L       BLER  &R
  339. &L       BNHR  &R
  340.          MEND
  341. ./       ADD   LIST=ALL,NAME=BLH
  342.          MACRO
  343. &L       BLH   &A
  344. &L       BNE   &A
  345.          MEND
  346. ./       ADD   LIST=ALL,NAME=BLHR
  347.          MACRO
  348. &L       BLHR  &R
  349. &L       BNER  &R
  350.          MEND
  351. ./       ADD   LIST=ALL,NAME=BLR
  352.          MACRO
  353. &L       BLR   &R
  354. &L       BCR   4,&R
  355.          MEND
  356. ./       ADD   LIST=ALL,NAME=BMP
  357.          MACRO
  358. &L       BMP   &A
  359. &L       BNZ   &A
  360.          MEND
  361. ./       ADD   LIST=ALL,NAME=BMPR
  362.          MACRO
  363. &L       BMPR  &R
  364. &L       BNZR  &R
  365.          MEND
  366. ./       ADD   LIST=ALL,NAME=BMZ
  367.          MACRO
  368. &L       BMZ   &A
  369. &L       BNP   &A
  370.          MEND
  371. ./       ADD   LIST=ALL,NAME=BMZR
  372.          MACRO
  373. &L       BMZR  &R
  374. &L       BNPR  &R
  375.          MEND
  376. ./       ADD   LIST=ALL,NAME=BMR
  377.          MACRO
  378. &L       BMR   &R
  379. &L       BCR   4,&R
  380.          MEND
  381. ./       ADD   LIST=ALL,NAME=BNEH
  382.          MACRO
  383. &L       BNEH  &A
  384. &L       BL    &A
  385.          MEND
  386. ./       ADD   LIST=ALL,NAME=BNEHR
  387.          MACRO
  388. &L       BNEHR &R
  389. &L       BLR   &R
  390.          MEND
  391. ./       ADD   LIST=ALL,NAME=BNER
  392.          MACRO
  393. &L       BNER  &R
  394. &L       BCR   7,&R
  395.          MEND
  396. ./       ADD   LIST=ALL,NAME=BNHR
  397.          MACRO
  398. &L       BNHR  &R
  399. &L       BCR   13,&R
  400.          MEND
  401. ./       ADD   LIST=ALL,NAME=BNLE
  402.          MACRO
  403. &L       BNLE  &A
  404. &L       BH    &A
  405.          MEND
  406. ./       ADD   LIST=ALL,NAME=BNLER
  407.          MACRO
  408. &L       BNLER &R
  409. &L       BHR   &R
  410.          MEND
  411. ./       ADD   LIST=ALL,NAME=BNLH
  412.          MACRO
  413. &L       BNLH  &A
  414. &L       BE    &A
  415.          MEND
  416. ./       ADD   LIST=ALL,NAME=BNLHR
  417.          MACRO
  418. &L       BNLHR &R
  419. &L       BER   &R
  420.          MEND
  421. ./       ADD   LIST=ALL,NAME=BNLR
  422.          MACRO
  423. &L       BNLR  &R
  424. &L       BCR   11,&R
  425.          MEND
  426. ./       ADD   LIST=ALL,NAME=BNMP
  427.          MACRO
  428. &L       BNMP  &A
  429. &L       BZ    &A
  430.          MEND
  431. ./       ADD   LIST=ALL,NAME=BNMPR
  432.          MACRO
  433. &L       BNMPR &R
  434. &L       BZR   &R
  435.          MEND
  436. ./       ADD   LIST=ALL,NAME=BNMZ
  437.          MACRO
  438. &L       BNMZ  &A
  439. &L       BP    &A
  440.          MEND
  441. ./       ADD   LIST=ALL,NAME=BNMZR
  442.          MACRO
  443. &L       BNMZR &R
  444. &L       BPR   &R
  445.          MEND
  446. ./       ADD   LIST=ALL,NAME=BNMR
  447.          MACRO
  448. &L       BNMR  &R
  449. &L       BCR   11,&R
  450.          MEND
  451. ./       ADD   LIST=ALL,NAME=BNOR
  452.          MACRO
  453. &L       BNOR  &R
  454. &L       BCR   14,&R
  455.          MEND
  456. ./       ADD   LIST=ALL,NAME=BNPR
  457.          MACRO
  458. &L       BNPR  &R
  459. &L       BCR   13,&R
  460.          MEND
  461. ./       ADD   LIST=ALL,NAME=BNZP
  462.          MACRO
  463. &L       BNZP  &A
  464. &L       BM    &A
  465.          MEND
  466. ./       ADD   LIST=ALL,NAME=BNZPR
  467.          MACRO
  468. &L       BNZPR &R
  469. &L       BMR   &R
  470.          MEND
  471. ./       ADD   LIST=ALL,NAME=BNZR
  472.          MACRO
  473. &L       BNZR  &R
  474. &L       BCR   7,&R
  475.          MEND
  476. ./       ADD   LIST=ALL,NAME=BOR
  477.          MACRO
  478. &L       BOR   &R
  479. &L       BCR   1,&R
  480.          MEND
  481. ./       ADD   LIST=ALL,NAME=BPR
  482.          MACRO
  483. &L       BPR   &R
  484. &L       BCR   2,&R
  485.          MEND
  486. ./       ADD   LIST=ALL,NAME=BZP
  487.          MACRO
  488. &L       BZP   &A
  489. &L       BNM   &A
  490.          MEND
  491. ./       ADD   LIST=ALL,NAME=BZPR
  492.          MACRO
  493. &L       BZPR  &R
  494. &L       BNMR  &R
  495.          MEND
  496. ./       ADD   LIST=ALL,NAME=BZR
  497.          MACRO
  498. &L       BZR   &R
  499. &L       BCR   8,&R
  500.          MEND
  501. ./       ADD   LIST=ALL,NAME=CAMODE
  502. ALP;
  503.  
  504. MACRO &&L: CAMODE &&AMODE,&®=RTNR;
  505.    GBLC &&OS;
  506.  
  507.    SYSKWT AMODE,&&AMODE,(24,31),NULL=NO,COND=NO;
  508.  
  509.    ASM CASE '&OS';
  510.       'MVS','MVT','MFT': &&L: SYSLBL;
  511.       'XA': BEGIN
  512.          &&L:
  513.          LA &®,AMOD&&@;
  514.          ASM IF ('&AMODE' EQ '31') THEN O &®,=XL4'80000000';
  515.          BSM 0,&®
  516.          AMOD&&@: SYSLBL;
  517.          END;
  518.       ENDCASE;
  519.    MEND;
  520. BAL;
  521. ./       ADD   LIST=ALL,NAME=CBAL
  522. ALP;
  523.  
  524. MACRO &&L: CBAL &®,&&ADDR;
  525.    GBLC &&CPU;
  526.  
  527.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  528.    THEN <&&L: BAL &®,&&ADDR>
  529.    ELSE <&&L: BAS &®,&&ADDR>;
  530.    MEND;
  531. BAL;
  532. ./       ADD   LIST=ALL,NAME=CBALR
  533. ALP;
  534.  
  535. MACRO &&L: CBALR &®1,&®2;
  536.    GBLC &&CPU;
  537.  
  538.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  539.    THEN <&&L: BALR &®1,&®2>
  540.    ELSE <&&L: BASR &®1,&®2>;
  541.    MEND;
  542. BAL;
  543. ./       ADD   LIST=ALL,NAME=CBASE
  544. ALP;
  545.  
  546. MACRO &&L: CBASE &®
  547.    GBLC &&CPU;
  548.  
  549.    ASM IF ('&CPU' EQ '360' OR '&CPU' EQ '370')
  550.    THEN <&&L: BALR &®,0>
  551.    ELSE <&&L: BASR &®,0>;
  552.    MEND;
  553. BAL;
  554. ./       ADD   LIST=ALL,NAME=CBDELINK
  555.          MACRO
  556. &L    CBDELINK &PREV,&DEL,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=,&ZOT=
  557.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  558.          AIF   ('&BACK' NE '').BACK
  559. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  560.          LTR   &PREV,&PREV
  561.          BNZ   CBD&SYSNDX.A
  562.          ST    &WORK,&HEAD
  563.          B     *+8
  564. CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
  565.          AIF   ('&TAIL' EQ '').NTAIL
  566.          LTR   &WORK,&WORK
  567.          BNZ   *+8
  568.          ST    &PREV,&TAIL
  569. .NTAIL   ANOP
  570.          AIF   ('&ZOT' NE 'YES').END
  571.          SLR   &WORK,&WORK
  572.          ST    &WORK,&NEXT-&CB.(,&DEL)
  573.          MEXIT
  574. .*
  575. .BACK    ANOP
  576. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  577.          LTR   &PREV,&PREV
  578.          BNZ   CBD&SYSNDX.A
  579.          ST    &WORK,&HEAD
  580.          B     *+8
  581. CBD&SYSNDX.A ST &WORK,&NEXT-&CB.(,&PREV)
  582.          AIF   ('&TAIL' EQ '').NTAILB
  583.          LTR   &WORK,&WORK
  584.          BNZ   CBD&SYSNDX.B
  585.          ST    &PREV,&TAIL
  586.          B     *+8
  587.          AGO   .TAILB
  588. .*
  589. .NTAILB  ANOP
  590.          LTR   &WORK,&WORK
  591.          BZ    *+8
  592. .TAILB   ANOP
  593. .*
  594. CBD&SYSNDX.B ST &PREV,&BACK-&CB.(,&WORK)
  595.          AIF   ('&ZOT' NE 'YES').END
  596.          SLR   &WORK,&WORK
  597.          ST    &WORK,&NEXT-&CB.(,&DEL)
  598.          ST    &WORK,&BACK-&CB.(,&DEL)
  599. .END     MEND
  600. ./       ADD   LIST=ALL,NAME=CBINIT
  601. ALP;
  602.  
  603. MACRO &&L: CBINIT &&TYPE,&&LOC,&&LEN,&&ALIGN=F;
  604.    GBLC &&CBINITB,&&CBINITE,&&CBINITL,&&CBINITA;
  605.  
  606.    ASM CASE '&TYPE';
  607.       'BEGIN': BEGIN
  608.          ASM IF ('&CBINITB' NE '') THEN BEGIN
  609.             MNOTE 12,'MISSING CBINIT END';
  610.             &&CBINITE: SYSLBL;
  611.             END;
  612.          &&CBINITB: SETC 'CBI&@.B';
  613.          &&CBINITE: SETC 'CBI&@.E';
  614.          ASM IF ('&L' NE '') THEN <&&CBINITE: SETC '&L'>;
  615.          &&CBINITL: SETC 'CBI&@.L';
  616.          ASM IF ('&LEN' NE '') THEN <&&CBINITL: SETC '&LEN'>;
  617.          &&CBINITA: SETC '&LOC';
  618.  
  619.          GOTO &&CBINITE;
  620.          &&CBINITB: DS 0&&ALIGN;
  621.          END;
  622.  
  623.       'END': BEGIN
  624.          ASM IF ('&CBINITB' EQ '') THEN BEGIN
  625.             MNOTE 12,'NO MATCHING CBINIT BEGIN';
  626.             &&L: SYSLBL;
  627.             MEXIT;
  628.             END;
  629.  
  630.          &&CBINITL: EQU *-&&CBINITB;
  631.          &&L: SYSLBL;
  632.          &&CBINITE: MMVC &&CBINITA,&&CBINITB,&&CBINITL;
  633.  
  634.          &&CBINITB: SETC '';
  635.          END;
  636.       ENDCASE
  637.    ELSE BEGIN
  638.       MNOTE 12,'TYPE=&TYPE IS ILLEGAL';
  639.       &&L: SYSLBL;
  640.       END;
  641.    MEND;
  642. BAL;
  643. ./       ADD   LIST=ALL,NAME=CBDLINKH
  644.          MACRO
  645. &L       CBDLINKH &DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
  646.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  647.          AIF   ('&BACK' NE '').BACK
  648. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  649.          ST    &WORK,&HEAD
  650.          AIF   ('&TAIL' EQ '').NTAIL
  651.          LTR   &WORK,&WORK
  652.          BNZ   *+8
  653.          ST    &WORK,&TAIL
  654. .NTAIL   ANOP
  655.          AIF   ('&ZOT' NE 'YES').END
  656.          SLR   &WORK,&WORK
  657.          ST    &WORK,&NEXT-&CB.(,&DEL)
  658.          MEXIT
  659. .*
  660. .BACK    ANOP
  661. &L       L     &WORK,&NEXT-&CB.(,&DEL)
  662.          ST    &WORK,&HEAD
  663.          LTR   &WORK,&WORK
  664.          AIF   ('&TAIL' EQ '').NTAILB
  665.          BZ    CBD&SYSNDX
  666.          XC    &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
  667.          B     *+8
  668. CBD&SYSNDX ST  &WORK,&TAIL
  669.          AGO   .ZOTB
  670. .*
  671. .NTAILB  ANOP
  672.          BZ    *+10
  673.          XC    &BACK-&CB.(4,&WORK),&BACK-&CB.(&WORK)
  674. .*
  675. .ZOTB    ANOP
  676.          AIF   ('&ZOT' NE 'YES').END
  677.          SLR   &WORK,&WORK
  678.          ST    &WORK,&NEXT-&CB.(,&DEL)
  679.          ST    &WORK,&BACK-&CB.(,&DEL)
  680. .END     MEND
  681. ./       ADD   LIST=ALL,NAME=CBDLINKT
  682.          MACRO
  683. &L CBDLINKT &PREV,&DEL,&WORK,&HEAD=,&TAIL=,&NEXT=,&BACK=,&CB=0,&ZOT=
  684.          SYSKWT ZOT,&ZOT,(YES,NO),COND=NO
  685.          AIF   ('&BACK' NE '').BACK
  686. &L       ST    &PREV,&TAIL
  687.          LTR   &PREV,&PREV
  688.          BNZ   *+8
  689.          ST    &PREV,&HEAD
  690.          AIF   ('&ZOT' NE 'YES').END
  691.          SLR   &WORK,&WORK
  692.          ST    &WORK,&NEXT-&CB.(,&DEL)
  693.          MEXIT
  694. .*
  695. .BACK    ANOP
  696. &L       ST    &PREV,&TAIL
  697.          LTR   &WORK,&PREV
  698.          BZ    CBD&SYSNDX
  699.          SLR   &WORK,&WORK
  700.          ST    &WORK,&NEXT-&CB.(,&PREV)
  701.          B     *+8
  702. CBD&SYSNDX ST  &PREV,&HEAD
  703.          AIF   ('&ZOT' NE 'YES').END
  704.          ST    &WORK,&NEXT-&CB.(,&DEL)
  705.          ST    &WORK,&BACK-&CB.(,&DEL)
  706. .END     MEND
  707. ./       ADD   LIST=ALL,NAME=CBLINK
  708.          MACRO
  709. &L       CBLINK &CUR,&ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  710.          AIF   ('&BACK' NE '').BACK
  711. &L       LTR   &CUR,&CUR
  712.          BNZ   CBL&SYSNDX.A
  713.          L     &WORK,&HEAD
  714.          ST    &WORK,&NEXT-&CB.(,&ADD)
  715.          ST    &ADD,&HEAD
  716.          B     CBL&SYSNDX.B
  717. CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
  718.          ST    &WORK,&NEXT-&CB.(,&ADD)
  719.          ST    &ADD,&NEXT-&CB.(,&CUR)
  720.          AIF   ('&TAIL' EQ '').NTAIL
  721. CBL&SYSNDX.B LTR  &WORK,&WORK
  722.          BNZ   *+8
  723.          ST    &ADD,&TAIL
  724.          MEXIT
  725. .*
  726. .NTAIL   ANOP
  727. CBL&SYSNDX.B DS 0H
  728.          MEXIT
  729. .*
  730. .BACK    ANOP
  731. &L       LTR   &CUR,&CUR
  732.          BNZ   CBL&SYSNDX.A
  733.          ST    &CUR,&BACK-&CB.(,&ADD)
  734.          L     &WORK,&HEAD
  735.          ST    &WORK,&NEXT-&CB.(,&ADD)
  736.          ST    &ADD,&HEAD
  737.          B     CBL&SYSNDX.B
  738. CBL&SYSNDX.A L &WORK,&NEXT-&CB.(,&CUR)
  739.          ST    &ADD,&NEXT-&CB.(,&CUR)
  740.          ST    &WORK,&NEXT-&CB.(,&ADD)
  741.          ST    &CUR,&BACK-&CB.(,&ADD)
  742. CBL&SYSNDX.B LTR &WORK,&WORK
  743.          AIF   ('&TAIL' EQ '').NTAILB
  744.          BNZ   *+12
  745.          ST    &ADD,&TAIL
  746.          B     *+8
  747.          AGO   .TAILB
  748. .*
  749. .NTAILB  ANOP
  750.          BZ    *+8
  751. .TAILB   ANOP
  752.          ST    &ADD,&BACK-&CB.(,&WORK)
  753.          MEND
  754. ./       ADD   LIST=ALL,NAME=CBLINKH
  755.          MACRO
  756. &L       CBLINKH &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  757.          AIF   ('&BACK' NE '').BACK
  758. &L       L     &WORK,&HEAD
  759.          ST    &ADD,&HEAD
  760.          ST    &WORK,&NEXT-&CB.(,&ADD)
  761.          AIF   ('&TAIL' EQ '').END
  762.          LTR   &WORK,&WORK
  763.          BNZ   *+8
  764.          ST    &ADD,&TAIL
  765.          MEXIT
  766. .*
  767. .BACK    ANOP
  768. &L       L     &WORK,&HEAD
  769.          ST    &ADD,&HEAD
  770.          ST    &WORK,&NEXT-&CB.(,&ADD)
  771.          LTR   &WORK,&WORK
  772.          AIF   ('&TAIL' EQ '').NTAILB
  773.          BNZ   *+12
  774.          ST    &ADD,&TAIL
  775.          B     *+8
  776.          AGO   .TAILB
  777. .*
  778. .NTAILB  ANOP
  779.          BZ    *+8
  780. .TAILB   ANOP
  781.          ST    &ADD,&BACK-&CB.(,&WORK)
  782.          SLR   &WORK,&WORK
  783.          ST    &WORK,&BACK-&CB.(,&ADD)
  784. .END     MEND
  785. ./       ADD   LIST=ALL,NAME=CBLINKT
  786.          MACRO
  787. &L       CBLINKT &ADD,&WORK,&CB=0,&NEXT=,&BACK=,&HEAD=,&TAIL=
  788.          AIF   ('&BACK' NE '').BACK
  789. &L       L     &WORK,&TAIL
  790.          ST    &ADD,&TAIL
  791.          LTR   &WORK,&WORK
  792.          BNZ   CBL&SYSNDX.A
  793.          ST    &ADD,&HEAD
  794.          B     *+8
  795. CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
  796.          SLR   &WORK,&WORK
  797.          ST    &WORK,&NEXT-&CB.(,&ADD)
  798.          MEXIT
  799. .*
  800. .BACK    ANOP
  801. &L       L     &WORK,&TAIL
  802.          ST    &ADD,&TAIL
  803.          LTR   &WORK,&WORK
  804.          BNZ   CBL&SYSNDX.A
  805.          ST    &ADD,&HEAD
  806.          B     *+8
  807. CBL&SYSNDX.A ST &ADD,&NEXT-&CB.(,&WORK)
  808.          ST    &WORK,&BACK-&CB.(,&ADD)
  809.          SLR   &WORK,&WORK
  810.          ST    &WORK,&NEXT-&CB.(,&ADD)
  811.          MEND
  812. ./       ADD   LIST=ALL,NAME=CCALL
  813.          MACRO
  814. &L       CCALL &SUBR,&TYPE,&RETURN=,&TEST=,&VRE=,&VRF=,&VR0=,&VR1=
  815.          LCLC  &LBL
  816. &LBL     SETC  '&L'
  817.          SYSKWT TYPE,&TYPE,(A,V),COND=NO
  818.          SYSKWT TEST,&TEST,(YES,NO),COND=NO
  819. .*
  820.          AIF   ('&VRE' EQ '' OR '&VRE' EQ '(VRE)').NVRE
  821. &LBL     SYSLR VRE,&VRE
  822. &LBL     SETC  ''
  823. .NVRE    ANOP
  824. .*
  825.          AIF   ('&VRF' EQ '' OR '&VRF' EQ '(VRF)').NVRF
  826. &LBL     SYSLR VRF,&VRF
  827. &LBL     SETC  ''
  828. .NVRF    ANOP
  829. .*
  830.          AIF   ('&VR0' EQ '' OR '&VR0' EQ '(VR0)').NVR0
  831. &LBL     SYSLR VR0,&VR0
  832. &LBL     SETC  ''
  833. .NVR0    ANOP
  834. .*
  835.          AIF   ('&VR1' EQ '' OR '&VR1' EQ '(VR1)').NVR1
  836. &LBL     SYSLR VR1,&VR1
  837. &LBL     SETC  ''
  838. .NVR1    ANOP
  839. .*
  840.          AIF   ('&SUBR'(1,1) EQ '(').REG
  841.          AIF   ('&TYPE' EQ 'A').A
  842. &LBL     L     RTNR,=V(&SUBR)
  843. &LBL     SETC  ''
  844. .*
  845. .BALR    ANOP
  846.          AIF   ('&TEST' NE 'YES').NTEST
  847.          LTR   RTNR,RTNR
  848.          BZ    *+6
  849. .NTEST   ANOP
  850.          CBALR RTNR,RTNR
  851.          CSAVGEN
  852.          MEXIT
  853. .*
  854. .A       ANOP
  855. &LBL     L     RTNR,=A(&SUBR)
  856. &LBL     SETC  ''
  857.          AGO   .BALR
  858. .*
  859. .REG     ANOP
  860.          AIF   ('&TEST' NE 'YES').NTESTR
  861. &LBL     LTR   &SUBR,&SUBR
  862. &LBL     SETC  ''
  863.          BZ    *+6
  864. .NTESTR  ANOP
  865. &LBL     CBALR RTNR,&SUBR
  866. &LBL     SETC  ''
  867.          CSAVGEN
  868.          MEND
  869. ./       ADD   LIST=ALL,NAME=CDESRCH
  870. ALP;
  871.  
  872. MACRO &&L: CDESRCH &&LOC,&&WORK=;
  873.    GBLC &&OS;
  874.    LCLC &&SRCH,&&TEST;
  875.  
  876.    &&SRCH: SETC 'SRCH&@';
  877.    &&TEST: SETC 'TEST&@';
  878.  
  879.    ASM CASE '&OS';
  880.       'XA': BEGIN
  881.          &&L:
  882.          SYSLR VR0,&&LOC,OP=L;  % LOCATION
  883.          STM XRA,HIGHR,20+XRA*4(STKR);  % SAVE REGS
  884.          &&SRCH: DO BEGIN
  885.             L XRA,CVTPTR;  % ADDRESS OF CVT
  886.             L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA);  % ADDR OF TCB
  887.             L XRB,TCBJSTCB-TCB(,XRA);  % ADDR OF JOB STEP TCB
  888.             L XRB,TCBJPQ-TCB(,XRB);  % JOB PACK QUEUE
  889.             WHILE <RNZ XRB> DO BEGIN
  890.                CBAL RTNR,&&TEST;  % CHECK THIS CDE
  891.                L XRB,CDCHAIN-CDE(,XRB);  % NEXT CDE
  892.                END;
  893.             L XRC,TCBLLS-TCB(,XRA);  % TRY THE LOAD LIST
  894.             WHILE <RNZ XRC> DO BEGIN
  895.                L XRB,LLECDPT-LLE(,XRC);  % POINTER TO CDE
  896.                IF <RNZ XRB> THEN CBAL RTNR,&&TEST;
  897.                L XRC,LLECHN-LLE(,XRC);  % NEXT LLE
  898.                END;
  899.             L XRB,CVTPTR;  % ADDR OF CVT
  900.             L XRB,CVTQLPAQ-CVT(,XRB);  % TRY THE LPA QUEUE
  901.             L XRB,0(,XRB);
  902.             WHILE <RNZ XRB> DO BEGIN
  903.                CBAL RTNR,&&TEST;
  904.                L XRB,CDCHAIN-CDE(,XRB);
  905.                END;
  906.             L XRB,CVTPTR;
  907.             L XRB,CVTLPDIA-CVT(,XRB);  % LINK PACK DIRECTORY
  908.             UNTIL <MCLC LPDENAME-LPDE(XRB),=8X'FF',8> DO BEGIN
  909.                CBAL RTNR,&&TEST;
  910.                AI XRB,LPDESIZE;
  911.                END;
  912.             LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  913.             SYSLR VR1,&&WORK,ERR='WORK AREA REQUIRED';  % ADDR FOR NAME
  914.             NUCLKUP BYADDR,NAME=(1),ADDR=(0);  % TRY THE NUCLEUS
  915.             IF <RNZ VRF> THEN <ZR VR1; EXIT FROM &&SRCH>;
  916.             LR VRE,VR0; N VRE,=XL4'7FFFFFFF';  % LOAD POINT
  917.             SYSLR VRF,&&LOC,OP=L;  % LOCATION BEING SEARCHED FOR
  918.             SR VRF,VRE;  % OFFSET
  919.             LI VR0,1;  % EXTENT NUMBER
  920.             EXIT FROM &&SRCH;
  921.  
  922.             &&TEST:
  923.             RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
  924.             RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>;  % NO XL
  925.             IF <TM CDATTRB-CDE(XRB),CDELPDE> THEN BEGIN  % REALLY LPDE
  926.                RGOTO RTNR IF <CL VR0,LPDEXTAD-LPDE(,XRB); CC L>;  % LOW
  927.                LR VRF,VR0;
  928.                S VRF,LPDEXTAD-LPDE(,XRB);  % GET DISPLACEMENT
  929.                RGOTO RTNR IF <CL VRF,LPDEXTLN-LPDE(,XRB); CC NL>; % HIGH
  930.                END
  931.             ELSE BEGIN
  932.                RGOTO RTNR IF <TM CDATTRB-CDE(XRB),CDIDENTY>;
  933.                L XRD,CDXLMJP-CDE(,XRB);  % XL POINTER
  934.                RGOTO RTNR IF <RZ XRD>;  % NO XL
  935.                L VRF,4(,XRD);  % NO. OF EXTENTS
  936.                RGOTO RTNR IF ^<CI VRF,1>;  % NO EXTENTS
  937.                L VRE,12(XRD);  % LOAD ADDRESS
  938.                RGOTO RTNR IF <CR VR0,VRE; CC L>;  % TOO LOW
  939.                LR VRF,VR0; SR VRF,VRE;  % GET DISPLACEMENT
  940.                RGOTO RTNR IF <CMPP VRF,9(XRD); CC NL>  % TOO HIGH
  941.                | <C VRF,=XL4'00FFFFFF'; CC H>;
  942.                END;
  943.             LA VR1,CDNAME-CDE(XRB);  % MODULE NAME
  944.             LI VR0,1;  % EXTENT NUMBER
  945.             LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  946.             END;  % OF &&SRCH
  947.          LTR VR1,VR1;  % SET CC
  948.          END;
  949.       'MVT','MVS': BEGIN
  950.          &&L:
  951.          SYSLR VRF,&&LOC,OP=L;  % LOCATION
  952.          STM XRA,HIGHR,20+XRA*4(STKR);  % SAVE REGS
  953.          &&SRCH: DO BEGIN
  954.             L XRA,CVTPTR;  % ADDRESS OF CVT
  955.             L XRA,CVTTCBP-CVT(,XRA); L XRA,0(,XRA);  % ADDR OF TCB
  956.             L XRB,TCBJSTCB-TCB(,XRA);  % ADDR OF JOB STEP TCB
  957.             L XRB,TCBJPQ-TCB(,XRB);  % JOB PACK QUEUE
  958.             WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
  959.                CBAL RTNR,&&TEST;  % CHECK THIS CDE
  960.                L XRB,CDCHAIN-CDE(,XRB);  % NEXT CDE
  961.                END;
  962.             L XRC,TCBLLS-TCB(,XRA);  % TRY THE LOAD LIST
  963.             WHILE <ZHBR XRC; RNZ XRC> DO BEGIN
  964.                L XRB,LLECDPT-LLE(,XRC);  % POINTER TO CDE
  965.                IF <ZHBR XRB; RNZ XRB> THEN CBAL RTNR,&&TEST;
  966.                L XRC,LLECHN-LLE(,XRC);  % NEXT LLE
  967.                END;
  968.             L XRB,CVTPTR;  % ADDR OF CVT
  969.             L XRB,CVTQLPAQ-CVT(,XRB);  % TRY THE LPA QUEUE
  970.             L XRB,0(,XRB);
  971.             WHILE <ZHBR XRB; RNZ XRB> DO BEGIN
  972.                CBAL RTNR,&&TEST;
  973.                L XRB,CDCHAIN-CDE(,XRB);
  974.                END;
  975.             ZR VR1;  % INDICATE NOT FOUND
  976.             EXIT FROM &&SRCH;
  977.  
  978.             &&TEST:
  979.             RGOTO RTNR IF <TM CDATTR-CDE(XRB),CDNIC+CDMIN>;
  980.             RGOTO RTNR IF ^<TM CDATTR2-CDE(XRB),CDXLE>;  % NO XL
  981.             L XRD,CDXLMJP-CDE(,XRB);  % XL POINTER
  982.             RGOTO RTNR IF <ZHBR XRD; RZ XRD>;  % NO XL
  983.             L VR0,4(,XRD);  % NO. OF EXTENTS
  984.             RGOTO RTNR IF <RZ VR0>;  % NO EXTENTS
  985.             LA VRE,8(,XRD);  % LIST OF LENGTHS
  986.             LR VR1,VR0; SLL VR1,2; AR VR1,VRE;  % LIST OF LOCATIONS
  987.             DO BEGIN  % SEARCH EXTENTS
  988.                IF <CMPP VRF,1(VR1); CC NL> THEN BEGIN  % NOT TOO LOW
  989.                   LR XRE,VRF; SL XRE,0(,VR1);  % GET DISPL.
  990.                   IF <CMPP XRE,1(VRE); CC L> THEN BEGIN  % WITHIN RANGE
  991.                      LA VRF,0(,XRE);  % RETURN DISPL.
  992.                      LOADP VRE,1(VR1);  % ORIGIN
  993.                      LCR VR0,VR0; A VR0,4(,XRD);  % EXTENT NO.
  994.                      LA VR1,CDNAME-CDE(,XRB);  % MODULE NAME
  995.                      LTR VR1,VR1;  % SET CC
  996.                      EXIT FROM &&SRCH;
  997.                      END;
  998.                   END;
  999.                RGOTO RTNR IF <TM 0(VR1),X'80'> | <TM 0(VRE),X'80'>;
  1000.                AI VR1,4; AI VRE,4;
  1001.                END FOR VR0;
  1002.             RGOTO RTNR;
  1003.             END;  % OF &&SRCH
  1004.          LM XRA,HIGHR,20+XRA*4(STKR);  % RESTORE REGISTERS
  1005.          END;
  1006.       ENDCASE
  1007.    ELSE BEGIN
  1008.       &&L: ZR VR1;
  1009.       MNOTE 4,'CDESRCH NOT DEFINED FOR &OS';
  1010.       END;
  1011.    MEND;
  1012. BAL;
  1013. ./       ADD   LIST=ALL,NAME=CENTER
  1014.          MACRO
  1015. &L       CENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=
  1016.          LCLC  &LBL
  1017.          SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
  1018.          SYSKWT BASE,&BASE,(YES,NO),COND=NO
  1019.          SYSKWT WAR,&WAR,(YES,NO),COND=NO
  1020. &LBL     SETC  '&L'
  1021.          AIF   ('&R&S' EQ '' OR ('&R' NE '' AND '&S' NE '')).OK
  1022.          MNOTE 12,'ILLEGAL REGISTER SPECIFICATION'
  1023. .OK      ANOP
  1024. .*
  1025. .*  GENERATE ENTRY CARD
  1026. .*
  1027.          AIF   ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
  1028.          AIF   ('&L'(1,1) EQ '@').NENTRY
  1029.          ENTRY &L
  1030. .NENTRY  ANOP
  1031. .*
  1032. .*  SAVE REGISTERS
  1033. .*
  1034.          AIF   ('&R' EQ '').NSTM
  1035. &LBL     STM   &R,&S,0(STKR)
  1036. &LBL     SETC  ''
  1037. .NSTM    ANOP
  1038. .*
  1039. .*  LOAD WORK AREA REGISTER
  1040. .*
  1041.          AIF ('&WAR' EQ 'NO' OR '&R&SIZE' EQ '' OR '&SIZE' EQ '0').NWAR
  1042. &LBL     LR    WAR,STKR
  1043. &LBL     SETC  ''
  1044. .NWAR    ANOP
  1045. .*
  1046. .*  BUMP STACK POINTER BY SIZE REQUESTED
  1047. .*
  1048.          AIF   ('&SIZE' EQ '' AND '&R' NE '').RSIZE
  1049.          AIF   ('&SIZE' EQ '0' OR '&SIZE' EQ '').NSIZE
  1050. &LBL     LA    STKR,(&SIZE+3)/4*4(,STKR)
  1051. &LBL     SETC  ''
  1052.          AGO   .NSIZE
  1053. .*
  1054. .RSIZE   ANOP
  1055. &LBL     LA    STKR,(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1)))*4(,STKR)
  1056. &LBL     SETC  ''
  1057. .NSIZE   ANOP
  1058. .*
  1059. .*  LOAD BASE REGISTER
  1060. .*
  1061.          AIF   ('&BASE' EQ 'NO').NBASE
  1062. &LBL     CBASE BASER
  1063. &LBL     SETC  ''
  1064.          USING *,BASER
  1065. .NBASE   ANOP
  1066. &LBL     CSAVGEN
  1067.          MEND
  1068. ./       ADD   LIST=ALL,NAME=CEXIT
  1069.          MACRO
  1070. &L       CEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=
  1071.          LCLC  &LBL
  1072. &LBL     SETC  '&L'
  1073.          SYSKWT WAR,&WAR,(YES,NO),COND=NO
  1074.          SYSKWT LTR,<R,(VRF,VRE,VR0,VR1),COND=NO
  1075.          SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
  1076. .*
  1077. .*  ADJUST STACK POINTER
  1078. .*
  1079.          AIF   ('&WAR' EQ 'NO' OR '&SIZE' EQ '0').NWAR
  1080. &LBL     LR    STKR,WAR
  1081. &LBL     SETC  ''
  1082.          AGO   .NSIZE
  1083. .*
  1084. .NWAR    ANOP
  1085.          AIF   ('&SIZE' EQ '').RSIZE
  1086.          AIF   ('&SIZE' EQ '0').NSIZE
  1087. &LBL     SL    STKR,=A((&SIZE+3)/4*4)
  1088. &LBL     SETC  ''
  1089.          AGO   .NSIZE
  1090. .*
  1091. .RSIZE   ANOP
  1092. &LBL     SL    STKR,=A(4*(&S+1-(&R)+16*((&R)/(&S+1))/((&R)/(&S+1))))
  1093. &LBL     SETC  ''
  1094. .NSIZE   ANOP
  1095. .*
  1096. .*  RESTORE REGISTERS
  1097. .*
  1098. &LBL     LM    &R,&S,0(STKR)
  1099. &LBL     SETC  ''
  1100. .*
  1101. .*  GENERATE LTR INSTRUCTION
  1102. .*
  1103.          AIF   ('<R' EQ '').NLTR
  1104.          LTR   <R,<R
  1105. .NLTR    ANOP
  1106. .*
  1107.          AIF   ('&BRANCH' EQ 'NO').NBRANCH
  1108.          BR    RTNR
  1109. .NBRANCH ANOP
  1110.          MEND
  1111. ./       ADD   LIST=ALL,NAME=CHKACCT
  1112. ALP;
  1113.  
  1114. MACRO &&L: CHKACCT;
  1115.    GBLA &&LACCT;
  1116.    GBLC &&SITE;
  1117.  
  1118.    &&L:
  1119.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1120.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1121.    CHEK&&@: DO BEGIN
  1122.       EXIT IF ^<CI VR0,&&LACCT>;  % NOT CORRECT LENGTH
  1123.  
  1124.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1125.          ASM IF (&&LACCT EQ 4)
  1126.          THEN EXIT IF <MCLC 0(VR1),=C'NONE',4>;
  1127.  
  1128.          DO BEGIN  % CHECK EACH CHARACTER
  1129.             EXIT FROM CHEK&&@
  1130.             IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
  1131.             | <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
  1132.             | <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
  1133.             | <<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>;
  1134.             AI VR1,1;
  1135.             END FOR VR0;
  1136.          END;
  1137.       END
  1138.    THEN ZR VRE;  % INDICATE SUCCESS
  1139.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1140.    LTR VRE,VRE;  % SET CC
  1141.    MEND;
  1142. BAL;
  1143. ./       ADD   LIST=ALL,NAME=CHKBOX
  1144. ALP;
  1145.  
  1146. MACRO &&L: CHKBOX;
  1147.    GBLA &&LBOX;
  1148.    GBLC &&SITE;
  1149.  
  1150.    &&L:
  1151.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1152.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1153.    CHEK&&@: DO BEGIN
  1154.       EXIT IF <CI VR0,&&LBOX; CC H>;  % NOT CORRECT LENGTH
  1155.  
  1156.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1157.          IF <CLI 0(VR1),C'M'> THEN BEGIN
  1158.             AI VR1,1;
  1159.             SI VR0,1;
  1160.             END;
  1161.          DO BEGIN  % CHECK EACH CHARACTER
  1162.             EXIT FROM CHEK&&@
  1163.             IF ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>;
  1164.             AI VR1,1;
  1165.             END FOR VR0;
  1166.          END;
  1167.       END
  1168.    THEN ZR VRE;  % INDICATE SUCCESS
  1169.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1170.    LTR VRE,VRE;  % SET CC
  1171.    MEND;
  1172. BAL;
  1173. ./       ADD   LIST=ALL,NAME=CHKINIT
  1174. ALP;
  1175.  
  1176. MACRO &&L: CHKINIT;
  1177.    GBLA &&LINIT;
  1178.    GBLC &&SITE;
  1179.  
  1180.    &&L:
  1181.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1182.    LI VRE,4;  % INIT TO BAD RETURN CODE
  1183.    CHEK&&@: DO BEGIN
  1184.       EXIT IF ^<CI VR0,&&LINIT>;  % NOT CORRECT LENGTH
  1185.  
  1186.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1187.          EXIT FROM CHEK&&@
  1188.          IF ^<<<CLI 0(VR1),C'A'; CC NL> & <CLI 0(VR1),C'I'; CC NH>>
  1189.          | <<CLI 0(VR1),C'J'; CC NL> & <CLI 0(VR1),C'R'; CC NH>>
  1190.          | <<CLI 0(VR1),C'S'; CC NL> & <CLI 0(VR1),C'Z'; CC NH>>
  1191.          %| <CLI 0(VR1),C'#'> | <CLI 0(VR1),C'$'> | <CLI 0(VR1),C'@'>
  1192.          >;
  1193.          SI VR0,1;
  1194.          DO BEGIN
  1195.             EXIT FROM CHEK&&@
  1196.             IF ^<<<CLI 1(VR1),C'A'; CC NL> & <CLI 1(VR1),C'I'; CC NH>>
  1197.             | <<CLI 1(VR1),C'J'; CC NL> & <CLI 1(VR1),C'R'; CC NH>>
  1198.             | <<CLI 1(VR1),C'S'; CC NL> & <CLI 1(VR1),C'Z'; CC NH>>
  1199.             | <<CLI 1(VR1),C'0'; CC NL> & <CLI 1(VR1),C'9'; CC NH>
  1200.                & ^<<CLI 0(VR1),C'0'; CC NL> & <CLI 0(VR1),C'9'; CC NH>>>
  1201.             %| <CLI 1(VR1),C'#'> | <CLI 1(VR1),C'$'> | <CLI 1(VR1),C'@'>
  1202.             >;
  1203.             AI VR1,1;
  1204.             END FOR VR0;
  1205.          END;
  1206.       END
  1207.    THEN ZR VRE;  % INDICATE SUCCESS
  1208.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1209.    LTR VRE,VRE;  % SET CC
  1210.    MEND;
  1211. BAL;
  1212. ./       ADD   LIST=ALL,NAME=CHKKW
  1213. ALP;
  1214.  
  1215. MACRO &&L: CHKKW;
  1216.    GBLA &&LKW;
  1217.    GBLC &&SITE;
  1218.  
  1219.    &&L:
  1220.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1221.    LI VRE,4;  % KW TO BAD RETURN CODE
  1222.    CHEK&&@: DO BEGIN
  1223.       EXIT IF ^<CI VR0,&&LKW>;  % NOT CORRECT LENGTH
  1224.  
  1225.       DO BEGIN  % CHECK EACH CHARACTER
  1226.          EXIT FROM CHEK&&@ IF <CLI 0(VR1),C' '>;
  1227.          AI VR1,1;
  1228.          END FOR VR0;
  1229.       END
  1230.    THEN ZR VRE;  % INDICATE SUCCESS
  1231.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1232.    LTR VRE,VRE;  % SET CC
  1233.    MEND;
  1234. BAL;
  1235. ./       ADD   LIST=ALL,NAME=CHKTERM
  1236. ALP;
  1237.  
  1238. MACRO &&L: CHKTERM;
  1239.    GBLA &<ERM;
  1240.    GBLC &&SITE;
  1241.  
  1242.    &&L:
  1243.    WPUSHREG VRF,VR1;  % SAVE REGISTERS
  1244.    LI VRE,4;  % TERM TO BAD RETURN CODE
  1245.    CHEK&&@: DO BEGIN
  1246.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1247.          IF <CI VR0,4> & <MCLC 0(VR1),=C'NONE',4> THEN BEGIN
  1248.             WPOPREG VRF,VR1;
  1249.             LA VRF,=&<ERM.C'*';
  1250.             LR VR1,VRF; LI VR0,&<ERM;
  1251.             WPUSHREG VRF,VR1;
  1252.             ZR VRE;
  1253.             EXIT;
  1254.             END;
  1255.          END;
  1256.  
  1257.       EXIT IF ^<CI VR0,&<ERM>;  % NOT CORRECT LENGTH
  1258.  
  1259.       ASM IF ('&SITE' EQ 'NIH') THEN BEGIN
  1260.          IF <CLI 0(VR1),C'0'; CC HE> & <CLI 0(VR1),C'9'; CC LE>
  1261.          THEN BEGIN
  1262.             SI VR0,2;  % ALLOW FOR 1ST DIGIT AND LETTER
  1263.             DO BEGIN
  1264.                AI VR1,1;
  1265.                EXIT FROM CHEK&&@
  1266.                IF ^<<CLI 0(VR1),C'0'; CC HE>
  1267.                   & <CLI 0(VR1),C'9'; CC LE>>;
  1268.                END FOR VR0;
  1269.             EXIT FROM CHEK&&@
  1270.             IF ^<<<CLI 1(VR1),C'A'; CC HE> & <CLI 1(VR1),C'I'; CC LE>>
  1271.             | <<CLI 1(VR1),C'J'; CC HE> & <CLI 1(VR1),C'R'; CC LE>>
  1272.             | <<CLI 1(VR1),C'S'; CC HE> & <CLI 1(VR1),C'Z'; CC LE>>>;
  1273.             END
  1274.          ELSE BEGIN
  1275.             EXIT FROM CHEK&&@
  1276.             IF ^<<<CLI 0(VR1),C'A'; CC HE> & <CLI 0(VR1),C'I'; CC LE>>
  1277.             | <<CLI 0(VR1),C'J'; CC HE> & <CLI 0(VR1),C'R'; CC LE>>
  1278.             | <<CLI 0(VR1),C'S'; CC HE> & <CLI 0(VR1),C'Z'; CC LE>>>;
  1279.             FOREVER DO BEGIN
  1280.                AI VR1,1; SI VR0,1;
  1281.                EXIT IF <RNP VR0>;
  1282.                EXIT FROM CHEK&&@
  1283.                IF ^<<CLI 0(VR1),C'0'; CC HE>
  1284.                   & <CLI 0(VR1),C'9'; CC LE>>;
  1285.                END;
  1286.             END;
  1287.          END;
  1288.       END
  1289.    THEN ZR VRE;  % INDICATE SUCCESS
  1290.    WPOPREG VRF,VR1;  % RESTORE REGISTERS
  1291.    LTR VRE,VRE;  % SET CC
  1292.    MEND;
  1293. BAL;
  1294. ./       ADD   LIST=ALL,NAME=CI
  1295.          MACRO
  1296. &L       CI    &R,&V
  1297.          LCLA  &X
  1298. .LOOP    ANOP
  1299. &X       SETA  &X+1
  1300.          AIF   (&X GT K'&V).F
  1301.          AIF   ('&V'(&X,1) GE '0').LOOP
  1302.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  1303. &L       C     &R,=A(&V)
  1304.          MEXIT
  1305. .F       ANOP
  1306. &L       C     &R,=F'&V'
  1307.          MEND
  1308. ./       ADD   LIST=ALL,NAME=CIL
  1309.          MACRO
  1310. &L       CIL   &R,&V
  1311.          LCLA  &X
  1312. .LOOP    ANOP
  1313. &X       SETA  &X+1
  1314.          AIF   (&X GT K'&V).F
  1315.          AIF   ('&V'(&X,1) GE '0').LOOP
  1316.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  1317. &L       CL    &R,=A(&V)
  1318.          MEXIT
  1319. .F       ANOP
  1320. &L       CL    &R,=F'&V'
  1321.          MEND
  1322. ./       ADD   LIST=ALL,NAME=CMPB
  1323.          MACRO
  1324. &L       CMPB  &R,&A
  1325.          GBLC  &CPU,&SIM370
  1326.          AIF   ('&CPU' EQ '360').S360
  1327. &L       CLM   &R,1,&A
  1328.          MEXIT
  1329. .S360    ANOP
  1330. &L       ST    &R,&SIM370
  1331.          MCLC  3+&SIM370,&A,1
  1332.          MEND
  1333. ./       ADD   LIST=ALL,NAME=CMPF
  1334.          MACRO
  1335. &L       CMPF  &R,&A
  1336.          GBLC  &CPU,&SIM370
  1337.          AIF   ('&CPU' EQ '360').S360
  1338. &L       UAOP  C,&R,&A
  1339.          MEXIT
  1340. .S360    ANOP
  1341. &L       MMVC  &SIM370,&A,4
  1342.          C     &R,&SIM370
  1343.          MEND
  1344. ./       ADD   LIST=ALL,NAME=CMPH
  1345.          MACRO
  1346. &L       CMPH  &R,&A
  1347.          GBLC  &CPU,&SIM370
  1348.          AIF   ('&CPU' EQ '360').S360
  1349. &L       UAOP  CH,&R,&A
  1350.          MEXIT
  1351. .S360    ANOP
  1352. &L       MMVC  &SIM370,&A,2
  1353.          CH    &R,&SIM370
  1354.          MEND
  1355. ./       ADD   LIST=ALL,NAME=CMPLF
  1356.          MACRO
  1357. &L       CMPLF &R,&A
  1358.          GBLC  &CPU,&SIM370
  1359.          AIF   ('&CPU' EQ '360').S360
  1360. &L       UAOP  CL,&R,&A
  1361.          MEXIT
  1362. .S360    ANOP
  1363. &L       MMVC  &SIM370,&A,4
  1364.          CL    &R,&SIM370
  1365.          MEND
  1366. ./       ADD   LIST=ALL,NAME=CMPLH
  1367.          MACRO
  1368. &L       CMPLH &R,&A
  1369.          GBLC  &CPU,&SIM370
  1370.          AIF   ('&CPU' EQ '360').S360
  1371. &L       CLM   &R,3,&A
  1372.          MEXIT
  1373. .S360    ANOP
  1374. &L       ST    &R,&SIM370
  1375.          MCLC  2+&SIM370,&A,2
  1376.          MEND
  1377. ./       ADD   LIST=ALL,NAME=CMPP
  1378.          MACRO
  1379. &L       CMPP  &R,&A
  1380.          GBLC  &CPU,&SIM370
  1381.          AIF   ('&CPU' EQ '360').S360
  1382. &L       CLM   &R,7,&A
  1383.          MEXIT
  1384. .S360    ANOP
  1385. &L       ST    &R,&SIM370
  1386.          MCLC  1+&SIM370,&A,3
  1387.          MEND
  1388. ./       ADD   LIST=ALL,NAME=CPARMALL
  1389. *
  1390. *  NIH/COMMON - NO ASSEMBLY PARAMETER VALUES FOR ALL VERSIONS
  1391. *
  1392. ./       ADD   LIST=ALL,NAME=CPARMGBL
  1393. ./       NUMBER NEW1=0,INCR=0
  1394. *
  1395. *  NIH/COMMON - ASSEMBLY PARAMETER DEFINITIONS
  1396. *
  1397.          GBLC  &CPU                    CPU TYPE
  1398.          GBLC  &MP                     MULTIPROCESSOR OPTION
  1399.          GBLC  &OS                     OPERATING SYSTEM
  1400.          GBLC  &JES                    TYPE OF JES TO BE USED
  1401.          GBLA  &LJOBNUM                LENGTH OF JOB NUMBER
  1402.          GBLA  &MJOBNUM                MAXIMUM JOB NUMBER
  1403.          GBLC  &MSGCLAS                DEFAULT MESSAGE CLASS
  1404.          GBLA  &MREMOTE                MAXIMUM REMOTE NUMBER
  1405.          GBLA  &LJESCMD                MAX. LENGTH OF JES COMMAND
  1406.          GBLA  &LJESMSG                MAX. LENGTH OF JES NOTIFY MSG
  1407.          GBLC  &JESCHAR                STARTING CHARACTER FOR JES CMDS
  1408.          GBLC  &DBC                    USE DBC (DEBUGGING CONTROLLER)
  1409.          GBLA  &DBCSP                  SUBPOOL TO BE USED BY DBC
  1410.          GBLC  &SITE                   SITE OF INSTALLATION
  1411.          GBLC  &SITENAM(8)             INSTALLATION NAME
  1412.          GBLC  &FORHELP(8)             WHERE TO GO FOR HELP
  1413.          GBLA  &LINIT                  LENGTH OF INITIALS
  1414.          GBLA  &LACCT                  LENGTH OF ACCOUNT
  1415.          GBLA  &LKW                    LENGTH OF KEYWORD
  1416.          GBLA  <ERM                  LENGTH OF TERMINAL ID
  1417.          GBLA  &LBOX                   LENGTH OF BOX NUMBER
  1418.          GBLC  &INITNAM                NAME FOR INITIALS
  1419.          GBLC  &ACCTNAM                NAME FOR ACCOUNT
  1420.          GBLC  &KWNAME                 NAME FOR KEYWORD
  1421.          GBLC  &TERMNAM                NAME FOR TERMINAL ID
  1422.          GBLC  &BOXNAME                NAME FOR BOX
  1423.          GBLC  &RACF                   RACF SUPPORT
  1424.          GBLC  &RACFID                 NAME FOR RACF USERID
  1425.          GBLA  &RACFSP                 SUBPOOL FOR RACF
  1426.          GBLA  &SVCGEN1                GENERAL PURPOSE TYPE 1 SVC NO.
  1427.          GBLA  &SVCGEN2                GENERAL PURPOSE TYPE 2 SVC NO.
  1428.          GBLA  &SVCJES                 REMOTE JOB ENTRY SVC NUMBER
  1429.          GBLA  &SVCKW                  KEYWORD SVC NUMBER
  1430.          GBLA  &SVCACCT                ACCOUNTING SVC NUMBER
  1431.          GBLA  &VAREA                  LENGTH OF A VAREA
  1432.          GBLA  &LSCAN                  SCANNER TOKEN SIZE FOR PADDING
  1433.          GBLC  &LNMIN                  MINIMUM LINE NUMBER
  1434.          GBLC  &LNMAX                  MAXIMUM LINE NUMBER
  1435.          GBLC  &LNMAXZ                 &LNMAX WITH 0S INSTEAD OF 9S
  1436.          GBLC  &LN1                    LINE NUMBER 1
  1437.          GBLC  &LNDP                   DECIMAL PLACES IN LINE NUMBER
  1438.          GBLC  &LNIP                   INTEGER PLACES IN LINE NUMBER
  1439.          GBLC  &LNMASK                 LINE NUMBER MASK
  1440.          GBLC  &LNBITS                 NO. OF BITS IN LINE NUMBER
  1441.          GBLC  &SIM370                 WORK AREA FOR 370 SIMULATION
  1442.          GBLA  &TIME128                128 DAYS IN 100THS OF A SECOND
  1443.          GBLA  &WTOMAX                 MAXIMUM TEXT LENGTH IN A WTO
  1444.          GBLA  &WTOMC              WTO ROUTECDE - MASTER CONSOLE
  1445.          GBLA  &WTOMCI             WTO ROUTECDE - MASTER CONSOLE INFO
  1446.          GBLA  &WTOTAPE            WTO ROUTECDE - TAPE POOL
  1447.          GBLA  &WTODISK            WTO ROUTECDE - DISK POOL
  1448.          GBLA  &WTOTLIB            WTO ROUTECDE - TAPE LIBRARY
  1449.          GBLA  &WTODLIB            WTO ROUTECDE - DISK LIBRARY
  1450.          GBLA  &WTOUREC            WTO ROUTECDE - UNIT RECORD POOL
  1451.          GBLA  &WTOTPC             WTO ROUTECDE - TELEPROCESSING
  1452.          GBLA  &WTOSSEC            WTO ROUTECDE - SYSTEM SECURITY
  1453.          GBLA  &WTOERR             WTO ROUTECDE - ERROR LOG
  1454.          GBLA  &WTOPROG            WTO ROUTECDE - PROGRAMMER
  1455.          GBLA  &WTOEMUL            WTO ROUTECDE - EMULATION
  1456.          GBLA  &WTOURC1            WTO ROUTECDE - USER CODE 1
  1457.          GBLA  &WTOURC2            WTO ROUTECDE - USER CODE 2
  1458.          GBLA  &WTOURC3            WTO ROUTECDE - USER CODE 3
  1459.          GBLA  &WTOFAIL            WTO DESC - SYSTEM FAILURE
  1460.          GBLA  &WTOIACT            WTO DESC - IMMEDIATE ACTION
  1461.          GBLA  &WTOEACT            WTO DESC - EVENTUAL ACTION
  1462.          GBLA  &WTOSTAT            WTO DESC - SYSTEM STATUS
  1463.          GBLA  &WTOCMDR            WTO DESC - COMMAND RESPONSE
  1464.          GBLA  &WTOJOB             WTO DESC - JOB STATUS
  1465.          GBLA  &WTOAPPL            WTO DESC - APPLICATION PROGRAM
  1466.          GBLA  &WTOOUTL            WTO DESC - OUT-OF-LINE MESSAGE
  1467.          GBLA  &WTODISP            WTO DESC - DYNAMIC STATUS DISPLAYS
  1468.          GBLA  &WTOCRIT            WTO DESC - CRITICAL EVENTUAL ACTION
  1469.          GBLA  &TEMP                   WORK VARIABLE
  1470. ./       ADD   LIST=ALL,NAME=CPARMPRT
  1471. *
  1472. *  NIH/COMMON - ASSEMBLY PARAMETER LISTING
  1473. *
  1474.          MNOTE *,'&&CPU=&CPU'
  1475.          MNOTE *,'&&MP=&MP'
  1476.          MNOTE *,'&&OS=&OS'
  1477.          MNOTE *,'&&JES=&JES'
  1478.          MNOTE *,'&&LJOBNUM=&LJOBNUM'
  1479.          MNOTE *,'&&MJOBNUM=&MJOBNUM'
  1480.          MNOTE *,'&&MSGCLAS=&MSGCLAS'
  1481.          MNOTE *,'&&MREMOTE=&MREMOTE'
  1482.          MNOTE *,'&&LJESCMD=&LJESCMD'
  1483.          MNOTE *,'&&LJESMSG=&LJESMSG'
  1484.          MNOTE *,'&&JESCHAR=&JESCHAR'
  1485.          MNOTE *,'&&DBC=&DBC'
  1486.          MNOTE *,'&&DBCSP=&DBCSP'
  1487.          MNOTE *,'&&SITE=&SITE'
  1488.          MNOTE *,'&&SITENAM=''&SITENAM(1)&SITENAM(2)&SITENAM(3)&SITENAM*
  1489.                (4)&SITENAM(5)&SITENAM(6)&SITENAM(7)&SITENAM(8)'''
  1490.          MNOTE *,'&&FORHELP=''&FORHELP(1)&FORHELP(2)&FORHELP(3)&FORHELP*
  1491.                (4)&FORHELP(5)&FORHELP(6)&FORHELP(7)&FORHELP(8)'''
  1492.          MNOTE *,'&&LINIT=&LINIT'
  1493.          MNOTE *,'&&LACCT=&LACCT'
  1494.          MNOTE *,'&&LKW=&LKW'
  1495.          MNOTE *,'&<ERM=<ERM'
  1496.          MNOTE *,'&&LBOX=&LBOX'
  1497.          MNOTE *,'&&INITNAM=&INITNAM'
  1498.          MNOTE *,'&&ACCTNAM=&ACCTNAM'
  1499.          MNOTE *,'&&KWNAME=&KWNAME'
  1500.          MNOTE *,'&&TERMNAM=&TERMNAM'
  1501.          MNOTE *,'&&BOXNAME=&BOXNAME'
  1502.          MNOTE *,'&&RACF=&RACF'
  1503.          MNOTE *,'&&RACFID=&RACFID'
  1504.          MNOTE *,'&&RACFSP=&RACFSP'
  1505.          MNOTE *,'&&SVCGEN1=&SVCGEN1'
  1506.          MNOTE *,'&&SVCGEN2=&SVCGEN2'
  1507.          MNOTE *,'&&SVCJES=&SVCJES'
  1508.          MNOTE *,'&&SVCKW=&SVCKW'
  1509.          MNOTE *,'&&SVCACCT=&SVCACCT'
  1510.          MNOTE *,'&&VAREA=&VAREA'
  1511.          MNOTE *,'&&LSCAN=&LSCAN'
  1512.          MNOTE *,'&&LNMIN=&LNMIN'
  1513.          MNOTE *,'&&LNMAX=&LNMAX'
  1514.          MNOTE *,'&&LNMAXZ=&LNMAXZ'
  1515.          MNOTE *,'&&LN1=&LN1'
  1516.          MNOTE *,'&&LNDP=&LNDP'
  1517.          MNOTE *,'&&LNIP=&LNIP'
  1518.          MNOTE *,'&&LNMASK=&LNMASK'
  1519.          MNOTE *,'&&LNBITS=&LNBITS'
  1520.          MNOTE *,'&&SIM370=&SIM370'
  1521.          MNOTE *,'&&TIME128=&TIME128'
  1522.          MNOTE *,'&&WTOMAX=&WTOMAX'
  1523.          MNOTE *,'&&WTOMC=&WTOMC'
  1524.          MNOTE *,'&&WTOMCI=&WTOMCI'
  1525.          MNOTE *,'&&WTOTAPE=&WTOTAPE'
  1526.          MNOTE *,'&&WTODISK=&WTODISK'
  1527.          MNOTE *,'&&WTOTLIB=&WTOTLIB'
  1528.          MNOTE *,'&&WTODLIB=&WTODLIB'
  1529.          MNOTE *,'&&WTOUREC=&WTOUREC'
  1530.          MNOTE *,'&&WTOTPC=&WTOTPC'
  1531.          MNOTE *,'&&WTOSSEC=&WTOSSEC'
  1532.          MNOTE *,'&&WTOERR=&WTOERR'
  1533.          MNOTE *,'&&WTOPROG=&WTOPROG'
  1534.          MNOTE *,'&&WTOEMUL=&WTOEMUL'
  1535.          MNOTE *,'&&WTOURC1=&WTOURC1'
  1536.          MNOTE *,'&&WTOURC2=&WTOURC2'
  1537.          MNOTE *,'&&WTOURC3=&WTOURC3'
  1538.          MNOTE *,'&&WTOFAIL=&WTOFAIL'
  1539.          MNOTE *,'&&WTOIACT=&WTOIACT'
  1540.          MNOTE *,'&&WTOEACT=&WTOEACT'
  1541.          MNOTE *,'&&WTOSTAT=&WTOSTAT'
  1542.          MNOTE *,'&&WTOCMDR=&WTOCMDR'
  1543.          MNOTE *,'&&WTOJOB=&WTOJOB'
  1544.          MNOTE *,'&&WTOAPPL=&WTOAPPL'
  1545.          MNOTE *,'&&WTOOUTL=&WTOOUTL'
  1546.          MNOTE *,'&&WTODISP=&WTODISP'
  1547.          MNOTE *,'&&WTOCRIT=&WTOCRIT'
  1548. ./       ADD   LIST=ALL,NAME=CPARMRNG
  1549.          SYSKWT &&CPU,&CPU,(360,370,370BS),COND=NO,NULL=NO
  1550.          SYSKWT &&MP,&MP,(YES,NO),NULL=NO,COND=NO
  1551.          SYSKWT &&OS,&OS,(MVT,MFT,VS1,SVS,MVS,XA),COND=NO,NULL=NO
  1552.          SYSKWT &&JES,&JES,(NIHHASP3,NIHJES2A),COND=NO,NULL=NO
  1553.          SYSRNG &&LJOBNUM,&LJOBNUM,GT,0,LE,8
  1554.          SYSRNG &&MJOBNUM,&MJOBNUM,GT,0,LE,99999999
  1555. .*       NO CHECK ON &MSGCLAS
  1556.          SYSRNG &&MREMOTE,&MREMOTE,GT,0,LE,99999
  1557.          SYSRNG &&LJESCMD,&LJESCMD,GT,0,LE,255
  1558.          SYSRNG   &&LJESMSG,&LJESMSG,GT,0,LT,&LJESCMD
  1559. .*       NO CHECK ON &JESCHAR
  1560.          SYSKWT DBC,&DBC,(YES,NO),NULL=NO,COND=NO
  1561.          SYSRNG &&DBCSP,&DBCSP,GE,2,LE,127,NE,78
  1562. .*       NO CHECK ON &SITE
  1563. .*       NO CHECK ON &SITENAM
  1564. .*       NO CHECK NO &FORHELP
  1565.          SYSRNG &&LINIT,&LINIT,GE,0,LE,8
  1566.          SYSRNG &&LACCT,&LACCT,GE,0,LE,8
  1567.          SYSRNG &&LKW,&LKW,GE,0,LE,8
  1568.          SYSRNG &<ERM,<ERM,GE,0,LE,8
  1569.          SYSRNG &&LBOX,&LBOX,GE,0,LE,8
  1570. .*       NO CHECK ON &INITNAM
  1571. .*       NO CHECK ON &ACCTNAM
  1572. .*       NO CHECK ON &KWNAME
  1573. .*       NO CHECK ON &TERMNAM
  1574. .*       NO CHECK ON &BOXNAME
  1575.          SYSKWT &&RACF,&RACF,(YES,NO),NULL=NO,COND=NO
  1576. .*       NO CHECK ON &RACFID
  1577.          SYSRNG &&RACFSP,&RACFSP,GE,0,LE,127
  1578.          SYSRNG &&SVCGEN1,&SVCGEN1,GE,0,LE,255
  1579.          SYSRNG &&SVCGEN2,&SVCGEN2,GE,0,LE,255
  1580.          SYSRNG &&SVCJES,&SVCJES,GE,0,LE,255
  1581.          SYSRNG &&SVCKW,&SVCKW,GE,0,LE,255
  1582.          SYSRNG &&SVCACCT,&SVCACCT,GE,0,LE,255
  1583.          SYSRNG &&VAREA,&VAREA,EQ,36
  1584.          SYSRNG &&LSCAN,&LSCAN,GE,16
  1585.          SYSRNG &&LNDP,&LNDP,GE,0,LE,8
  1586.          SYSRNG &&LNIP,&LNIP,GE,0,LE,8
  1587. &TEMP    SETA   &LNIP+&LNDP
  1588.          SYSRNG &&LNIP+&&LNDP,&TEMP,GT,0,LE,8
  1589. .*       NO CHECK ON &SIM370
  1590. .*       NO CHECK ON &TIME128
  1591.          SYSRNG &&WTOMAX,&WTOMAX,GE,9,LT,255
  1592. .*       NO CHECK ON WTO CODES
  1593. .*       NO CHECK ON &TEMP
  1594. ./       ADD   LIST=ALL,NAME=CPARMSET
  1595. *
  1596. *  NIH/COMMON - ASSEMBLY PARAMETER DEFAULTS
  1597. *
  1598. &CPU     SETC  '370BS'                 CPU TYPE
  1599. &MP      SETC  'YES'                   MULTIPROCESSOR OPTION
  1600. &OS      SETC  'MVS'                   OPERATING SYSTEM
  1601. &JES     SETC  'NIHJES2A'
  1602. &LJOBNUM SETA  4                       LENGTH OF JOB NUMBER
  1603. &MJOBNUM SETA  9999                    MAXIMUM JOB NUMBER
  1604. &MSGCLAS SETC  'A'                     DEFAULT MESSAGE CLASS
  1605. &MREMOTE SETA  999                     MAXIMUM REMOTE NUMBER
  1606. &LJESCMD SETA  132                     MAX. LENGTH OF JES COMMAND
  1607. &LJESMSG SETA  106                     MAX. LENGTH OF JES NOTIFY MSG
  1608. &JESCHAR SETC  '$'                     STARTING CHARACTER FOR JES CMDS
  1609. &DBC     SETC  'NO'                    USE DBC (DEBUGGING CONTROLLER)
  1610. &DBCSP   SETA  2
  1611. &SITE    SETC  'NIH'                   SITE OF INSTALLATION
  1612. &SITENAM(1) SETC 'NIH/DCRT'            INSTALLATION NAME
  1613. &SITENAM(2) SETC '/CCB'
  1614. &SITENAM(3) SETC '  WYLBUR'
  1615. &FORHELP(1) SETC 'SEE THE '            HELP MESSAGE
  1616. &FORHELP(2) SETC 'PAL UNIT'
  1617. &LINIT   SETA  3                       LENGTH OF INITIALS
  1618. &LACCT   SETA  4                       LENGTH OF ACCOUNT
  1619. &LKW     SETA  3                       LENGTH OF KEYWORD
  1620. <ERM   SETA  3                       LENGTH OF TERMINAL ID
  1621. &LBOX    SETA  4                       LENGTH OF BOX NUMBER
  1622. &INITNAM SETC  'INITIALS'              NAME FOR INITIALS
  1623. &ACCTNAM SETC  'ACCOUNT'               NAME FOR ACCOUNT
  1624. &KWNAME  SETC  'KEYWORD'               NAME FOR KEYWORD
  1625. &TERMNAM SETC  'TERMINAL'              NAME FOR TERMINAL ID
  1626. &BOXNAME SETC  'BOX'                   NAME FOR BOX NUMBER
  1627. &RACF    SETC  'NO'                    RACF SUPPORT
  1628. &RACFID  SETC  'USERID'                NAME FOR RACF USERID
  1629. &RACFSP  SETA  3                       SUBPOOL FOR RACF
  1630. &SVCGEN1 SETA  251                     GENERAL PURPOSE TYPE 1 SVC NO.
  1631. &SVCGEN2 SETA  244                     GENERAL PURPOSE TYPE 2 SVC NO.
  1632. &SVCJES  SETA  254                     REMOTE JOB ENTRY SVC
  1633. &SVCKW   SETA  254                     KEYWORD SVC
  1634. &SVCACCT SETA  242                     ACCOUNTING SVC
  1635. &VAREA   SETA  36                      LENGTH OF A VAREA
  1636. &LSCAN   SETA  16                      SCANNER TOKEN SIZE FOR PADDING
  1637. &LNDP    SETC  '3'                     DECIMAL PLACES IN LINE NUMBER
  1638. &LNIP    SETC  '5'                     INTEGER PLACES IN LINE NUMBER
  1639. &SIM370  SETC  'SIM370'                WORK AREA FOR 370 SIMULATION
  1640. &TIME128 SETA  128*24*3600*100         128 DAYS IN 100THS OF A SECOND
  1641. &WTOMAX  SETA  62                      MAXIMUM TEXT LENGTH IN A WTO
  1642. &WTOMC   SETA  1                   WTO ROUTECDE - MASTER CONSOLE
  1643. &WTOMCI  SETA  2                   WTO ROUTECDE - MASTER CONSOLE INFO
  1644. &WTOTAPE SETA  3                   WTO ROUTECDE - TAPE POOL
  1645. &WTODISK SETA  4                   WTO ROUTECDE - DISK POOL
  1646. &WTOTLIB SETA  5                   WTO ROUTECDE - TAPE LIBRARY
  1647. &WTODLIB SETA  6                   WTO ROUTECDE - DISK LIBRARY
  1648. &WTOUREC SETA  7                   WTO ROUTECDE - UNIT RECORD POOL
  1649. &WTOTPC  SETA  8                   WTO ROUTECDE - TELEPROCESSING
  1650. &WTOSSEC SETA  9                   WTO ROUTECDE - SYSTEM SECURITY
  1651. &WTOERR  SETA  10                  WTO ROUTECDE - ERROR LOG
  1652. &WTOPROG SETA  11                  WTO ROUTECDE - PROGRAMMER
  1653. &WTOEMUL SETA  12                  WTO ROUTECDE - EMULATION
  1654. &WTOURC1 SETA  13                  WTO ROUTECDE - USER CODE 1
  1655. &WTOURC2 SETA  14                  WTO ROUTECDE - USER CODE 2
  1656. &WTOURC3 SETA  15                  WTO ROUTECDE - USER CODE 3
  1657. &WTOFAIL SETA  1                   WTO DESC - SYSTEM FAILURE
  1658. &WTOIACT SETA  2                   WTO DESC - IMMEDIATE ACTION
  1659. &WTOEACT SETA  3                   WTO DESC - EVENTUAL ACTION
  1660. &WTOSTAT SETA  4                   WTO DESC - SYSTEM STATUS
  1661. &WTOCMDR SETA  5                   WTO DESC - COMMAND RESPONSE
  1662. &WTOJOB  SETA  6                   WTO DESC - JOB STATUS
  1663. &WTOAPPL SETA  7                   WTO DESC - APPLICATION PROGRAM
  1664. &WTOOUTL SETA  8                   WTO DESC - OUT-OF-LINE MESSAGE
  1665. &WTODISP SETA  9                   WTO DESC - DYNAMIC STATUS DISPLAYS
  1666. &WTOCRIT SETA  10                  WTO DESC - CRITICAL EVENTUAL ACTION
  1667. ./       ADD   LIST=ALL,NAME=CPARMVER
  1668. *
  1669. *  NIH/COMMON - NO VERSION-SPECIFIC ASSEMBLY PARAMETER VALUES
  1670. *
  1671. ./       ADD   LIST=ALL,NAME=CPOP
  1672.          MACRO
  1673. &L       CPOP  &R,&SIZE,&EXTRA=0
  1674.          AIF   ('&R' EQ '').SIZE
  1675. &L       LR    STKR,&R
  1676.          MEXIT
  1677. .*
  1678. .SIZE    ANOP
  1679.          AIF   ('&SIZE'(1,1) EQ '(').RSIZE
  1680. &L       SL    STKR,=A((&SIZE+&EXTRA+3)/4*4)
  1681.          CSAVGEN
  1682.          MEXIT
  1683. .*
  1684. .RSIZE   ANOP
  1685. &L       SLR   STKR,&SIZE
  1686.          AIF   ('&EXTRA' EQ '0').NEXTRA
  1687.          SI    STKR,&EXTRA
  1688. .NEXTRA  ANOP
  1689.          N     STKR,=XL4'FFFFFFFC'
  1690.          CSAVGEN
  1691.          MEND
  1692. ./       ADD   LIST=ALL,NAME=CPOPREG
  1693.          MACRO
  1694. &L       CPOPREG &R,&S
  1695.          GBLC  &CSVLINK(4)
  1696.          LCLC  &SAVLINK
  1697. .*
  1698. &SAVLINK SETC  '&CSVLINK(1)'
  1699. &CSVLINK(1) SETC ''
  1700. .*
  1701.          AIF   ('&S' EQ '').ONE
  1702. &L       CPOP  ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
  1703.          LM    &R,&S,0(STKR)
  1704. &CSVLINK(1) SETC '&SAVLINK'
  1705.          CSAVGEN
  1706.          MEXIT
  1707. .*
  1708. .ONE     ANOP
  1709. &L       CPOP  ,4
  1710.          L     &R,0(,STKR)
  1711. &CSVLINK(1) SETC '&SAVLINK'
  1712.          CSAVGEN
  1713.          MEND
  1714. ./       ADD   LIST=ALL,NAME=CPUSH
  1715.          MACRO
  1716. &L       CPUSH &R,&SIZE,&EXTRA=0
  1717.          LCLC  &LBL
  1718. &LBL     SETC  '&L'
  1719.          AIF   ('&R' EQ '').NR
  1720. &LBL     LR    &R,STKR
  1721. &LBL     SETC  ''
  1722. .NR      ANOP
  1723. .*
  1724.          AIF   ('&SIZE'(1,1) EQ '(').REG
  1725. &LBL     LA    STKR,(&SIZE+&EXTRA+3)/4*4(,STKR)
  1726.          CSAVGEN
  1727.          MEXIT
  1728. .*
  1729. .REG     ANOP
  1730. &LBL     LA    STKR,&EXTRA+3(&SIZE,STKR)
  1731.          AIF   ('&SIZE' NE '(0)' AND '&SIZE' NE '(R0)' AND             *
  1732.                '&SIZE' NE '(VR0)').NZREG
  1733.          AR    STKR,&SIZE
  1734. .NZREG   ANOP
  1735.          N     STKR,=XL4'FFFFFFFC'
  1736.          CSAVGEN
  1737.          MEND
  1738. ./       ADD   LIST=ALL,NAME=CPUSHREG
  1739.          MACRO
  1740. &L       CPUSHREG &R,&S
  1741.          AIF   ('&S' EQ '').ONE
  1742. &L       STM   &R,&S,0(STKR)
  1743.          CPUSH ,4*(&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))
  1744.          MEXIT
  1745. .*
  1746. .ONE     ANOP
  1747. &L       ST    &R,0(,STKR)
  1748.          CPUSH ,4
  1749.          MEND
  1750. ./       ADD   LIST=ALL,NAME=CREGS
  1751.          MACRO
  1752.          CREGS
  1753. *
  1754. *  REGISTER USAGE
  1755. *
  1756. VR0      EQU   0                       PARAMETER REGISTER
  1757. VR1      EQU   1                       PARAMETER REGISTER
  1758. XRA      EQU   2                       WORK REGISTER
  1759. XRB      EQU   3                       WORK REGISTER
  1760. XRC      EQU   4                       WORK REGISTER
  1761. XRD      EQU   5                       WORK REGISTER
  1762. XRE      EQU   6                       WORK REGISTER
  1763. XRF      EQU   7                       WORK REGISTER
  1764. XRG      EQU   8                       WORK REGISTER
  1765. RTNR     EQU   9                       RETURN REGISTER
  1766. BASER    EQU   10                      BASE REGISTER
  1767. WAR      EQU   11                      WORK AREA REGISTER
  1768. GCBR     EQU   12                      GLOBAL CONTROL BLOCK REGISTER
  1769. STKR     EQU   13                      STACK REGISTER
  1770. VRE      EQU   14                      PARAMETER REGISTER
  1771. VRF      EQU   15                      PARAMETER REGISTER
  1772. *
  1773. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  1774. HIGHR    EQU   WAR                     HIGHEST REGISTER TO SAVE
  1775.          MEND
  1776. ./       ADD   LIST=ALL,NAME=CSA
  1777.          MACRO
  1778. &L       CSA   &R,&S,&EQU=
  1779.          LCLA  &X
  1780.          LCLC  &LBL
  1781. .*
  1782. &LBL     SETC  '&L'
  1783.          AIF   ('&L' NE '' OR '&EQU' EQ '').NLBL
  1784. &LBL     SETC  'CSA&SYSNDX'
  1785. .NLBL    ANOP
  1786. .*
  1787. &LBL     DS    (&S+1-(&R)+16*(((&R)/(&S+1))/((&R)/(&S+1))))A
  1788. .*
  1789. &X       SETA  0-1
  1790. .LOOP    ANOP
  1791. &X       SETA  &X+2
  1792.          AIF   (&X GT N'&EQU).DONE
  1793. &EQU(&X) EQU   &LBL+(&EQU(&X+1)-(&R)+16*(((&R)/(&EQU(&X+1)+1))/((&R)/(&*
  1794.                EQU(&X+1)+1))))*4
  1795.          AGO   .LOOP
  1796. .*
  1797. .DONE    ANOP
  1798. .*
  1799.          MEND
  1800. ./       ADD   LIST=ALL,NAME=CSAVGEN
  1801.          MACRO
  1802. &L       CSAVGEN
  1803.          GBLC  &CSVLINK(4)
  1804.          AIF   ('&CSVLINK(1)' EQ '').NONE
  1805. &L       MVC   0(12,STKR),=XL12'00'
  1806.    SYSLST 4(STKR),NEW=&CSVLINK(1)&CSVLINK(2)&CSVLINK(3)&CSVLINK(4),OP=L
  1807.          MEXIT
  1808. .*
  1809. .NONE    ANOP
  1810. &L       SYSLBL
  1811.          MEND
  1812. ./       ADD   LIST=ALL,NAME=CSAVLINK
  1813.          MACRO
  1814. &L       CSAVLINK &SAVE
  1815.          GBLC  &CSVLINK(4)
  1816.          LCLA  &X,&Y
  1817. .*
  1818. &L       SYSLBL
  1819. .*
  1820. .LOOP    ANOP
  1821. &X       SETA  &X+1
  1822. &CSVLINK(&X) SETC ''
  1823. &Y       SETA  K'&SAVE-(&X-1)*8
  1824.          AIF   (&Y LE 0).NULL
  1825.          AIF   (&Y LE 8).SHORT
  1826. &Y       SETA  8
  1827. .SHORT   ANOP
  1828. &CSVLINK(&X) SETC '&SAVE'(1+(&X-1)*8,&Y)
  1829. .*
  1830. .NULL    ANOP
  1831.          AIF   (&X LT 4).LOOP
  1832.          MEND
  1833. ./       ADD   LIST=ALL,NAME=CSETUP
  1834.          MACRO
  1835. &L       CSETUP ®S=YES,&SETS=YES,&CBS=YES,&SCABBRS=YES,&CSECT=YES,  *
  1836.                &SYMDEL=YES,&KWR=NO,&MDC=NO,&NAT=NO,&SCT=NO,            *
  1837.                &CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO,               *
  1838.                &TCB=NO,&CDE=NO,&PQE=NO,&RB=NO,&IQE=NO,&LPDE=NO,        *
  1839.                &ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&SSOB=NO,&LRC=NO,      *
  1840.                &SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO,    *
  1841.                &ASXB=NO,&SMCA=NO,&JSCB=NO,&RIB=NO,&ACEE=NO,            *
  1842.                &R15=VRF,&R14=VRE,&R13=STKR,&BASER=BASER,               *
  1843.                &R1=VR1,&R0=VR0
  1844. .*
  1845.          COPY  CPARMGBL
  1846.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  1847.          GBLC  &SYSSPLV
  1848.          LCLA  &X,&Y
  1849. .*
  1850. .*  SET OS REGISTER NAMES
  1851. .*
  1852. &#R15    SETC  '&R15'
  1853. &#R14    SETC  '&R14'
  1854. &#R13    SETC  '&R13'
  1855. &#BASER  SETC  '&BASER'
  1856. &#R1     SETC  '&R1'
  1857. &#R0     SETC  '&R0'
  1858. .*
  1859. .*  CHECK MACRO PARAMETER VALUES
  1860. .*
  1861.          SYSKWT SETS,&SETS,(YES,NO),COND=NO
  1862.          SYSKWT SCABBRS,&SCABBRS,(YES,NO),COND=NO
  1863.          SYSKWT REGS,®S,(YES,NO,NEVER),COND=NO
  1864.          SYSKWT CBS,&CBS,(YES,NO,ALL),COND=NO
  1865.          SYSKWT CSECT,&CSECT,(YES,NO),COND=NO
  1866.          SYSKWT SYMDEL,&SYMDEL,(YES,NO),COND=NO
  1867.          SYSKWT MDC,&MDC,(YES,NO),COND=NO
  1868.          SYSKWT SCT,&SCT,(YES,NO,NEVER),COND=NO
  1869.          SYSKWT NAT,&NAT,(YES,NO),COND=NO
  1870.          SYSKWT ACB,&ACB,(YES,NO),COND=NO
  1871.          SYSKWT ACEE,&ACEE,(YES,NO),COND=NO
  1872.          SYSKWT ASCB,&ASCB,(YES,NO),COND=NO
  1873.          SYSKWT ASXB,&ASXB,(YES,NO),COND=NO
  1874.          SYSKWT CDE,&CDE,(YES,NO),COND=NO
  1875.          SYSKWT CVT,&CVT,(YES,NO),COND=NO
  1876.          SYSKWT DCB,&DCB,(YES,NO),COND=NO
  1877.          SYSKWT DEB,&DEB,(YES,NO),COND=NO
  1878.          SYSKWT DECB,&DECB,(YES,NO),COND=NO
  1879.          SYSKWT IQE,&IQE,(YES,NO),COND=NO
  1880.          SYSKWT JESCT,&JESCT,(YES,NO),COND=NO
  1881.          SYSKWT JSCB,&JSCB,(YES,NO),COND=NO
  1882.          SYSKWT LLE,&LLE,(YES,NO),COND=NO
  1883.          SYSKWT LPDE,&LPDE,(YES,NO),COND=NO
  1884.          SYSKWT LRC,&LRC,(YES,NO),COND=NO
  1885.          SYSKWT PCCA,&PCCA,(YES,NO),COND=NO
  1886.          SYSKWT PQE,&PQE,(YES,NO),COND=NO
  1887.          SYSKWT PSA,&PSA,(YES,NO),COND=NO
  1888.          SYSKWT RB,&RB,(YES,NO),COND=NO
  1889.          SYSKWT RPL,&RPL,(YES,NO),COND=NO
  1890.          SYSKWT SDWA,&SDWA,(YES,NO),COND=NO
  1891.          SYSKWT SMCA,&SMCA,(YES,NO),COND=NO
  1892.          SYSKWT SSOB,&SSOB,(YES,NO),COND=NO
  1893.          SYSKWT S99,&S99,(YES,NO),COND=NO
  1894.          SYSKWT TCB,&TCB,(YES,NO),COND=NO
  1895.          SYSKWT TQE,&TQE,(YES,NO),COND=NO
  1896.          SYSKWT UCB,&UCB,(YES,NO),COND=NO
  1897. .*
  1898. .*  ASSEMBLY PARAMETER VALUES
  1899. .*
  1900.          AIF   ('&SETS' EQ 'NO').NSETS
  1901.          COPY  CPARMSET
  1902.          COPY  CPARMALL
  1903.          COPY  CPARMVER
  1904. .*
  1905. .*  CHECK ASSEMBLY PARAMETER VALUES
  1906. .*
  1907.          COPY  CPARMRNG
  1908. .*
  1909. .*  COMPUTE LINE NUMBER VALUES
  1910. .*
  1911. &LNMIN   SETC  '0'
  1912. .*
  1913. &Y       SETA  1
  1914. &X       SETA  &LNDP
  1915. .LNLOOP  ANOP
  1916. &Y       SETA  &Y*10
  1917. &X       SETA  &X-1
  1918.          AIF   (&X GE 0).LNLOOP
  1919. &Y       SETA  &Y/10
  1920. &LN1     SETC  '&Y'
  1921. .*
  1922. &LNMAX   SETC  ''
  1923. &LNMAXZ  SETC  ''
  1924. &X       SETA  &LNIP+&LNDP
  1925. .LNMLOOP ANOP
  1926. &LNMAX   SETC  '&LNMAX.9'
  1927. &LNMAXZ  SETC  '&LNMAXZ.0'
  1928. &X       SETA  &X-1
  1929.          AIF   (&X GT 0).LNMLOOP
  1930. .*
  1931. &X       SETA  1
  1932. &Y       SETA  0
  1933. .LNBLOOP ANOP
  1934. &X       SETA  &X*2
  1935. &Y       SETA  &Y+1
  1936.          AIF   (&LNMAX GE &X).LNBLOOP
  1937. &LNBITS  SETC  '&Y'
  1938. .*
  1939.          AIF   (&Y EQ &Y/4*4 AND &Y GT 4).LNNM4
  1940. &LNMASK  SETC  '0137'(1+&Y-&Y/4*4,1)
  1941. .LNNM4   ANOP
  1942.          AIF   (&Y LT 4).LNBLT4
  1943. &LNMASK  SETC  '&LNMASK'.'FFFFFFFF'(1,&Y/4)
  1944. .LNBLT4  ANOP
  1945. .*
  1946. .*  PERFORM RACF CHECK
  1947. .*
  1948.          AIF   ('&RACF' NE 'YES').NRACF
  1949.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').NRACF
  1950. &RACF    SETC  'NO'
  1951. .NRACF   ANOP
  1952. .*
  1953. .*  PERFORM XA CHECK
  1954. .*
  1955.          AIF   ('&OS' NE 'XA').NXA
  1956. &CPU     SETC  '370BS'
  1957. .NXA     ANOP
  1958. .*
  1959. .*  PRINT ASSEMBLY PARAMETER VALUES
  1960. .*
  1961.          COPY  CPARMPRT
  1962. .*
  1963. .NSETS   ANOP
  1964. .*
  1965. .*  SET PROPER SPLEVEL FOR MVS/370 AND MVS/XA
  1966. .*
  1967.          AIF   ('&OS' EQ 'XA').SPLXA
  1968.          AIF   ('&OS' NE 'MVS').SPLDONE
  1969.          SPLEVEL SET=1                 REQUEST MVS/370 MACRO EXPANSIONS
  1970.          AGO   .SPLDONE
  1971. .*
  1972. .SPLXA   ANOP
  1973.          SPLEVEL SET=2                 REQUEST MVS/XA MACRO EXPANSIONS
  1974. .SPLDONE ANOP
  1975.          SPLEVEL TEST
  1976.          MNOTE *,'SPLEVEL=&SYSSPLV'
  1977. .*
  1978. .*  SCANNER ABBREVIATIONS
  1979. .*
  1980.          AIF   ('&SCABBRS' EQ 'NO').NSCABBR
  1981.          SCABBRS
  1982. .NSCABBR ANOP
  1983. .*
  1984. .*  CONTROL BLOCKS
  1985. .*
  1986.          AIF   ('&CBS' EQ 'NO').NCBS
  1987.          AIF   ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NSYMDEL
  1988. SYMDEL   DSECT
  1989. .NSYMDEL ANOP
  1990. .*
  1991. .*  KWR
  1992. .*
  1993.          AIF   ('&KWR' EQ 'NO' AND '&CBS' NE 'ALL').NKWR
  1994.          TITLE 'KWR - KEYWORD RECORD'
  1995. KWR      DSECT
  1996.          KWR2
  1997. .NKWR    ANOP
  1998. .*
  1999. .*  MDC
  2000. .*
  2001.          AIF   ('&MDC' EQ 'NO' AND '&CBS' NE 'ALL').NMDC
  2002.          TITLE 'MDC - MACHINE DEPENDENT CELLS'
  2003. MDC      DSECT
  2004.          MDC
  2005. .NMDC    ANOP
  2006. .*
  2007. .*  NAT
  2008. .*
  2009.          AIF   ('&NAT' EQ 'NO' AND '&CBS' NE 'ALL').NNAT
  2010.          TITLE 'NAT - NUCLEUS ADDRESS TABLE'
  2011. NAT      DSECT
  2012.          NAT
  2013. .NNAT    ANOP
  2014. .*
  2015. .*  SCT
  2016. .*
  2017.  AIF (('&SCT' EQ 'NEVER') OR ('&SCT' EQ 'NO' AND '&CBS' NE 'ALL')).NSCT
  2018.          TITLE 'SCT - SCAN CONTROL TABLE'
  2019. SCT      DSECT
  2020.          SCT
  2021. .NSCT    ANOP
  2022. .*
  2023. .*  ACB
  2024. .*
  2025.          AIF   ('&ACB' EQ 'NO' AND '&CBS' NE 'ALL').NACB
  2026.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NACB
  2027.          TITLE 'ACB - OS ACCESS METHOD CONTROL BLOCK'
  2028.          IFGACB ,
  2029. *
  2030. ACB      EQU   IFGACB
  2031. .NACB    ANOP
  2032. .*
  2033. .*  ACEE
  2034. .*
  2035.          AIF   ('&ACEE' EQ 'NO' AND '&CBS' NE 'ALL').NACEE
  2036.          AIF   ('&RACF' EQ 'NO').NACEE
  2037.          TITLE 'ACEE - RACF ACCESSOR ENVIRONMENT ELEMENT'
  2038.          IHAACEE
  2039. .NACEE   ANOP
  2040. .*
  2041. .*  ASCB
  2042. .*
  2043.          AIF   ('&ASCB' EQ 'NO' AND '&CBS' NE 'ALL').NASCB
  2044.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASCB
  2045.          TITLE 'ASCB - OS ADDRESS SPACE CONTROL BLOCK'
  2046.          IHAASCB ,
  2047. .NASCB   ANOP
  2048. .*
  2049. .*  ASXB
  2050. .*
  2051.          AIF   ('&ASXB' EQ 'NO' AND '&CBS' NE 'ALL').NASXB
  2052.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NASXB
  2053.          TITLE 'ASXB - OS ADDRESS SPACE EXTENSION BLOCK'
  2054.          IHAASXB ,
  2055. .NASXB   ANOP
  2056. .*
  2057. .*  CDE
  2058. .*
  2059.          AIF   ('&CDE' EQ 'NO' AND '&CBS' NE 'ALL').NCDE
  2060.          TITLE 'OS CONTENTS DIRECTORY ENTRY'
  2061.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHACDE
  2062. CDE      DSECT
  2063.          CDEMVT
  2064.          AGO   .NCDE
  2065. .*
  2066. .IHACDE  ANOP
  2067.          IHACDE ,
  2068. *
  2069. CDE      EQU   CDENTRY
  2070. .NCDE    ANOP
  2071. .*
  2072. .*  CVT
  2073. .*
  2074.          AIF   ('&CVT' EQ 'NO' AND '&CBS' NE 'ALL').NCVT
  2075.          TITLE 'CVT - OS COMMUNICATIONS VECTOR TABLE'
  2076.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSCVT
  2077.          AIF   ('&OS' EQ 'SVS' OR '&OS' EQ 'VS1').VSCVT
  2078. CVT      DSECT
  2079.          CVT
  2080.          AGO   .NCVT
  2081. .*
  2082. .VSCVT   ANOP
  2083.          CVT   DSECT=YES,LIST=YES
  2084. .NCVT    ANOP
  2085. .*
  2086. .*  DCB
  2087. .*
  2088.          AIF   ('&DCB' EQ 'NO' AND '&CBS' NE 'ALL').NDCB
  2089.          TITLE 'DCBD - OS DATA CONTROL BLOCK DSECT'
  2090.          DCBD  DSORG=(PS,PO,DA),DEVD=DA
  2091. *
  2092. DCB      EQU   IHADCB
  2093. .NDCB    ANOP
  2094. .*
  2095. .*  DEB
  2096. .*
  2097.          AIF   ('&DEB' EQ 'NO' AND '&CBS' NE 'ALL').NDEB
  2098.          TITLE 'DEB - OS DATA EXTENT BLOCK'
  2099.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').VSDEB
  2100. DEB      DSECT
  2101.          DEBMVT
  2102.          AGO   .NDEB
  2103. .*
  2104. .VSDEB   ANOP
  2105.          IEZDEB LIST=YES
  2106. .NDEB    ANOP
  2107. .*
  2108. .*  DECB
  2109. .*
  2110.          AIF   ('&DECB' EQ 'NO' AND '&CBS' NE 'ALL').NDECB
  2111.          TITLE 'DECB - OS DATA EVENT CONTROL BLOCK'
  2112. DECB     DSECT
  2113.          DECBMVT
  2114. .NDECB   ANOP
  2115. .*
  2116. .*  IQE
  2117. .*
  2118.          AIF   ('&IQE' EQ 'NO' AND '&CBS' NE 'ALL').NIQE
  2119.          TITLE 'IQE - OS INTERRUPTION QUEUE ELEMENT'
  2120.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAIQE
  2121. IQE      DSECT
  2122.          IQEMVT
  2123.          AGO   .NIQE
  2124. .*
  2125. .IHAIQE  ANOP
  2126.          IHAIQE ,
  2127. IQE      EQU   IQESECT
  2128. .NIQE    ANOP
  2129. .*
  2130. .*  JESCT
  2131. .*
  2132.          AIF   ('&JESCT' EQ 'NO' AND '&CBS' NE 'ALL').NJESCT
  2133.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NJESCT
  2134.          TITLE 'JESCT - OS JES COMMUNICATION TABLE'
  2135.          IEFJESCT ,
  2136. .NJESCT  ANOP
  2137. .*
  2138. .*  JSCB
  2139. .*
  2140.          AIF   ('&JSCB' EQ 'NO' AND '&CBS' NE 'ALL').NJSCB
  2141.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NJSCB
  2142.          TITLE 'JSCB - OS JOB STEP CONTROL BLOCK'
  2143.          IEZJSCB ,
  2144. JSCB     EQU   IEZJSCB
  2145. .NJSCB   ANOP
  2146. .*
  2147. .*  LLE
  2148. .*
  2149.          AIF   ('&LLE' EQ 'NO' AND '&CBS' NE 'ALL').NLLE
  2150.          TITLE 'LLE - OS LOAD LIST ELEMENT'
  2151.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHALLE
  2152. LLE      DSECT
  2153.          LLEMVT
  2154.          AGO   .NLLE
  2155. .*
  2156. .IHALLE  ANOP
  2157.          IHALLE ,
  2158. .NLLE    ANOP
  2159. .*
  2160. .*  LPDE
  2161. .*
  2162.          AIF   ('&LPDE' EQ 'NO' AND '&CBS' NE 'ALL').NLPDE
  2163.          AIF   ('&OS' NE 'XA' AND '&OS' NE 'MVS').NLPDE
  2164.          TITLE 'LPDE - OS LINK PACK DIRECTORY ELEMENT'
  2165.          IHALPDE ,
  2166. LPDESIZE EQU   *-LPDE
  2167. .NLPDE   ANOP
  2168. .*
  2169. .*  LRC
  2170. .*
  2171.          AIF   ('&LRC' EQ 'NO' AND '&CBS' NE 'ALL').NLRC
  2172.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NLRC
  2173. *
  2174. &L       CSECT
  2175.          $LRC  DOC=YES
  2176. *
  2177. LRC      EQU   LRCDSECT
  2178. .NLRC    ANOP
  2179. .*
  2180. .*  PCCA
  2181. .*
  2182.          AIF   ('&PCCA' EQ 'NO' AND '&CBS' NE 'ALL').NPCCA
  2183.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPCCA
  2184.          TITLE 'PCCA - OS PHYSICAL CONFIGURATION COMMUNICATION AREA'
  2185.          IHAPCCA ,
  2186. .NPCCA   ANOP
  2187. .*
  2188. .*  PQE
  2189. .*
  2190.          AIF   ('&PQE' EQ 'NO' AND '&CBS' NE 'ALL').NPQE
  2191.          TITLE 'OS PARTITION QUEUE ELEMENT'
  2192.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IHAPQE
  2193. PQE      DSECT
  2194.          PQEMVT
  2195.          AGO   .NPQE
  2196. .*
  2197. .IHAPQE  ANOP
  2198.          IHAPQE ,
  2199. *
  2200. PQE      EQU   PQESECT
  2201. .NPQE    ANOP
  2202. .*
  2203. .*  PSA
  2204. .*
  2205.          AIF   ('&PSA' EQ 'NO' AND '&CBS' NE 'ALL').NPSA
  2206.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NPSA
  2207.          TITLE 'PSA - OS PREFIX STORAGE AREA'
  2208.          IHAPSA ,
  2209. .NPSA    ANOP
  2210. .*
  2211. .*  RB
  2212. .*
  2213.          AIF   ('&RB' EQ 'NO' AND '&CBS' NE 'ALL').NRB
  2214.          TITLE 'OS REQUEST BLOCK'
  2215.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MVT').IHARB
  2216. RB       DSECT
  2217.          RBMVT
  2218.          AGO   .NRB
  2219. .*
  2220. .IHARB   ANOP
  2221.          AIF   ('&OS' EQ 'VS1').IHARB1
  2222.          IHARB ,
  2223. *
  2224. RB       EQU   RBBASIC
  2225.          AGO   .NRB
  2226. .*
  2227. .IHARB1  ANOP
  2228.          IHARB SYS=AOS1                VS1 RB
  2229. *
  2230. RB       EQU   RBBASIC
  2231. .NRB     ANOP
  2232. .*
  2233. .*  RIB
  2234. .*
  2235.          AIF   ('&RIB' EQ 'NO' AND '&CBS' NE 'ALL').NRIB
  2236.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NRIB
  2237.          TITLE 'RIB - OS RESOURCE INFORMATION BLOCK'
  2238.          ISGRIB ,
  2239. .NRIB    ANOP
  2240. .*
  2241. .*  RPL
  2242. .*
  2243.          AIF   ('&RPL' EQ 'NO' AND '&CBS' NE 'ALL').NRPL
  2244.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NRPL
  2245.          TITLE 'RPL - OS REQUEST PARAMETER LIST'
  2246.          IFGRPL ,
  2247. *
  2248. RPL      EQU   IFGRPL
  2249.          EJECT
  2250.          IDARMRCD ,
  2251.          AIF   ('&JES' NE 'NIHJES2A').NRPL
  2252.          EJECT
  2253.          JESNRPL
  2254. .NRPL    ANOP
  2255. .*
  2256. .*  SDWA
  2257. .*
  2258.          AIF   ('&SDWA' EQ 'NO' AND '&CBS' NE 'ALL').NSDWA
  2259.          AIF   ('&OS' EQ 'MVT' OR '&OS' EQ 'MFT').NSDWA
  2260.          TITLE 'SDWA - OS SYSTEM DIAGNOSTIC WORKAREA'
  2261.          IHASDWA ,
  2262. .NSDWA   ANOP
  2263. .*
  2264. .*  SMCA
  2265. .*
  2266.          AIF   ('&SMCA' EQ 'NO' AND '&CBS' NE 'ALL').NSMCA
  2267.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSMCA
  2268.          TITLE 'SMCA - OS SYSTEM MANAGEMENT FACILITIES CONTROL AREA'
  2269.          IEESMCA ,
  2270. SMCA     EQU   SMCABASE
  2271. .NSMCA   ANOP
  2272. .*
  2273. .*  SSOB
  2274. .*
  2275.          AIF   ('&SSOB' EQ 'NO' AND '&CBS' NE 'ALL').NSSOB
  2276.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NSSOB
  2277.          TITLE 'SSOB - OS SUBSYSTEM OPTIONS BLOCK'
  2278.          IEFJSSOB (SO,CS,AL,DA,US),CONTIG=YES
  2279.          AIF   ('&JES' NE 'NIHJES2A').NSSOB
  2280.          EJECT
  2281.          JESNSSOB (SO,JC,FC)
  2282. .NSSOB   ANOP
  2283. .*
  2284. .*  S99
  2285. .*
  2286.          AIF   ('&S99' EQ 'NO' AND '&CBS' NE 'ALL').NS99
  2287.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NS99
  2288.          TITLE 'OS DYNAMIC ALLOCATION DEFINITIONS'
  2289. S99      DSECT
  2290.          IEFZB4D0 ,
  2291.          EJECT
  2292.          IEFZB4D2 ,
  2293. .NS99    ANOP
  2294. .*
  2295. .*  TCB
  2296. .*
  2297.          AIF   ('&TCB' EQ 'NO' AND '&CBS' NE 'ALL').NTCB
  2298.          TITLE 'TCB - OS TASK CONTROL BLOCK'
  2299.          AIF   ('&OS' NE 'MVT' AND '&OS' NE 'MFT').IKJTCB
  2300. TCB      DSECT
  2301.          TCBMVT
  2302.          AGO   .NTCB
  2303. .*
  2304. .IKJTCB  ANOP
  2305.          AIF   ('&OS' EQ 'VS1').IKJTCB1
  2306.          IKJTCB LIST=YES
  2307.          AGO   .NTCB
  2308. .*
  2309. .IKJTCB1 ANOP
  2310.          IKJTCB SYS=AOS1,LIST=YES      VS1 TCB
  2311. .NTCB    ANOP
  2312. .*
  2313. .*  TQE
  2314. .*
  2315.          AIF   ('&TQE' EQ 'NO' AND '&CBS' NE 'ALL').NTQE
  2316.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NTQE
  2317.          TITLE 'TQE - TIMER QUEUE ELEMENT'
  2318.          IHATQE ,
  2319. .NTQE    ANOP
  2320. .*
  2321. .*  UCB
  2322. .*
  2323.          AIF   ('&UCB' EQ 'NO' AND '&CBS' NE 'ALL').NUCB
  2324.          TITLE 'UCB - OS UNIT CONTROL BLOCK'
  2325.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').UCBMVS
  2326. UCB      DSECT
  2327.          IEFUCBOB
  2328.          AGO   .NUCB
  2329. .*
  2330. .UCBMVS  ANOP
  2331. UCB      DSECT
  2332.          IEFUCBOB LIST=YES
  2333. .NUCB    ANOP
  2334. .*
  2335.          AIF   ('&DBC' EQ 'NO' OR '&SYMDEL' EQ 'NO').NCBS
  2336. SYMNODEL DSECT
  2337. .NCBS    ANOP
  2338. .*
  2339. .*  REGISTERS
  2340. .*
  2341.          AIF   (('&CSECT' EQ 'NO') AND                                 *
  2342.                (('®S' EQ 'NO') OR ('®S' EQ 'NEVER'))).NTITLE
  2343.          TITLE 'REGISTER DEFINITIONS'
  2344. .NTITLE  ANOP
  2345.          AIF   ('&CSECT' EQ 'NO').NCSECT
  2346. &L       CSECT
  2347. .NCSECT  ANOP
  2348. .*
  2349.          AIF   ('®S' EQ 'NEVER').NREGS
  2350.          AIF   (('®S' EQ 'NO') AND (('&CBS' EQ 'NO')                *
  2351.                OR ('&SCT' EQ 'NEVER')                                  *
  2352.                OR (('&SCT' EQ 'NO') AND ('&CBS' NE 'ALL')))).NREGS
  2353.          CREGS
  2354. .NREGS   ANOP
  2355.          MEND
  2356. ./       ADD   LIST=ALL,NAME=CSPOST
  2357.          MACRO
  2358. &L       CSPOST &ECB,&PC
  2359.          GBLC  &OS
  2360. .*
  2361. &L       SYSLR VR1,&ECB,ERR='ECB REQUIRED'
  2362.          AIF   ('&OS' EQ 'MVS' OR '&OS' EQ 'XA').VSPOST
  2363.          SYSLR VR0,&PC
  2364.          POST  (1),(0)
  2365.          MEXIT
  2366. .*
  2367. .VSPOST  ANOP
  2368.          AIF   ('&PC' EQ '' OR '&PC' EQ '0').ZPC
  2369.          SYSLR VR0,&PC
  2370.          O     VR0,=XL4'40000000'
  2371.          AGO   .POST
  2372. .*
  2373. .ZPC     ANOP
  2374.          L     VR0,=XL4'40000000'
  2375. .POST    ANOP
  2376.          L     VRF,0(,VR1)
  2377. PST&SYSNDX.A LTR VRF,VRF
  2378.          BM    PST&SYSNDX.B
  2379.          CS    VRF,VR0,0(VR1)
  2380.          BNE   PST&SYSNDX.A
  2381.          B     PST&SYSNDX.C
  2382. PST&SYSNDX.B POST (1),(0)
  2383. PST&SYSNDX.C DS 0H
  2384.          MEND
  2385. ./       ADD   LIST=ALL,NAME=CVBTA
  2386.          MACRO
  2387. &L       CVBTA &LOC,&LEN,&WORD
  2388. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2389.          SYSLR VR0,&LEN
  2390.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2391.          OSCALL CVBTA,VRF=(VRF)
  2392.          MEND
  2393. ./       ADD   LIST=ALL,NAME=CVBTD
  2394.          MACRO
  2395. &L       CVBTD &LOC,&LEN,&WORD
  2396. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2397.          SYSLR VR0,&LEN
  2398.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2399.          OSCALL CVBTD,VRF=(VRF)
  2400.          MEND
  2401. ./       ADD   LIST=ALL,NAME=CVBTR
  2402.          MACRO
  2403. &L       CVBTR &LOC,&LEN,&WORD
  2404. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2405.          SYSLR VR0,&LEN
  2406.          SYSLR VR1,&LOC,ERR='LOCATION OF DECIMAL AREA REQUIRED'
  2407.          OSCALL CVBTR,VRF=(VRF)
  2408.          MEND
  2409. ./       ADD   LIST=ALL,NAME=CVBTX
  2410.          MACRO
  2411. &L       CVBTX &LOC,&LEN,&BIN
  2412. &L       SYSLR VRF,&BIN,ERR='ADDRESS OF BINARY DATA REQUIRED'
  2413.          SYSLR VR0,&LEN,ERR='LENGTH OF HEX AREA REQUIRED'
  2414.          SYSLR VR1,&LOC,ERR='LOCATION OF HEX AREA REQUIRED'
  2415.          OSCALL CVBTX,VRF=(VRF)
  2416.          MEND
  2417. ./       ADD   LIST=ALL,NAME=CVBT$
  2418.          MACRO
  2419. &L       CVBT$   &LOC,&LEN,&WORD
  2420. &L       SYSLR VRF,&WORD,OP=L,ERR='BINARY DATA REQUIRED'
  2421.          SYSLR VR0,&LEN
  2422.          SYSLR VR1,&LOC,ERR='LOCATION OF RESULT AREA REQUIRED'
  2423.          OSCALL CVBT$,VRF=(VRF)
  2424.          MEND
  2425. ./       ADD   LIST=ALL,NAME=CVDATE
  2426.          MACRO
  2427. &L       CVDATE &LOC,&DATE,&WEEKDAY=
  2428.          SYSKWT WEEKDAY,&WEEKDAY,(YES,NO)
  2429. &L    SYSLR VR1,&LOC,TYPE=&WEEKDAY,SELECT=(YES),ERR='LOCATION REQUIRED'
  2430.          SYSLR VR0,&DATE,OP=L,ERR='DATE REQUIRED'
  2431.          OSCALL CVDATE
  2432.          MEND
  2433. ./       ADD   LIST=ALL,NAME=CVDTB
  2434.          MACRO
  2435. &L       CVDTB &LOC,&LEN,&EXACT=
  2436.          SYSKWT EXACT,&EXACT,NO
  2437. &L       SYSLR VR1,&LOC,TYPE=&EXACT,ERR='LOCATION REQUIRED'
  2438.          SYSLR VR0,&LEN,ERR='LENGTH REQUIRED'
  2439.          OSCALL CVDTB
  2440.          MEND
  2441. ./       ADD   LIST=ALL,NAME=CVTIME
  2442.          MACRO
  2443. &L       CVTIME &LOC,&TIME,&M=
  2444.          SYSKWT AMPM,&M,YES
  2445. &L       SYSLR VR1,&LOC,TYPE=&M,ERR='LOCATION REQUIRED'
  2446.          SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
  2447.          OSCALL CVTIME
  2448.          MEND
  2449. ./       ADD   LIST=ALL,NAME=CVTIM128
  2450.          MACRO
  2451. &L       CVTIM128 &TIME
  2452. &L       SYSLR VR0,&TIME,OP=L,ERR='TIME REQUIRED'
  2453.          OSCALL CVTIM128
  2454.          MEND
  2455. ./       ADD   LIST=ALL,NAME=CVXTB
  2456.          MACRO
  2457. &L       CVXTB &LOC,&LEN,&BIN
  2458. &L       SYSLR VR1,&LOC,ERR='LOCATION OF HEX STRING REQUIRED'
  2459.          SYSLR VR0,&LEN,ERR='LENGTH OF HEX STRING REQUIRED'
  2460.          SYSLR VRF,&BIN,ERR='LOCATION FOR BINARY RESULT REQUIRED'
  2461.          OSCALL CVXTB,VRF=(VRF)
  2462.          MEND
  2463. ./       ADD   LIST=ALL,NAME=DALLIST
  2464. ALP;
  2465.  
  2466. MACRO &&L: DALLIST &&TYPE,&&VERB,&&ERROR=,&&INFO=,&&FLAGS1=,_
  2467.                    &&FLAGS2=,&&MF=,&&SVC=,&&INIT=;
  2468.  
  2469.    GBLC &&DALMF,&&DALPL,&&DALLBL(25),&&DALEND,&&DALLEN,&&DALPTR;
  2470.    GBLC &&DALINIT;
  2471.    GBLA &&DALNUM;
  2472.    GBLB &&DALSW;
  2473.    GBLC &&OS;
  2474.  
  2475.    LCLA &&X,&&Y;
  2476.    LCLC &&STORE,&&LOAD,&&LQ;
  2477.  
  2478.    &&LQ: SETC 'L''';
  2479.  
  2480.    SYSKWT MF,&&MF(1),(L,E,R),COND=NO;
  2481.    SYSKWT SVC,&&SVC,(YES,NO),COND=NO;
  2482.    SYSKWT INIT,&&INIT,(YES,NO),COND=NO;
  2483.  
  2484.    ASM CASE '&TYPE';
  2485.       'BEGIN': BEGIN
  2486.          ASM IF ('&OS' NE 'MVS' AND '&OS' NE 'XA')
  2487.          THEN MNOTE 12,'DALLIST VALID ONLY FOR &&OS=MVS OR &&OS=XA';
  2488.          ASM IF (&&DALSW) THEN MNOTE 12,'MISSING DALLIST END';
  2489.          &&DALSW: SETB 1;  % SET BEGIN SWITCH
  2490.          &&DALMF: SETC '&MF(1)';  % SAVE MF VALUE
  2491.          &&DALPL: SETC '&MF(2)';
  2492.          &&DALINIT: SETC '&INIT';
  2493.          &&DALLEN: SETC '24';  % SET INITIAL LENGTH
  2494.          &&DALPTR: SETC 'DALP&@';
  2495.          &&DALNUM: SETA 0;
  2496.          ASM CASE '&MF(1)';
  2497.             '','L': BEGIN
  2498.                ASM CASE '&MF(1)';
  2499.                   'L': <&&L: DS 0F>;
  2500.                   '': BEGIN
  2501.                      &&DALEND: SETC 'DALE&@';  % END SYMBOL
  2502.                      &&L: GOTO &&DALEND;
  2503.                      &&DALPL: SETC 'DALA&@';
  2504.                      &&DALPL: DS 0F;
  2505.                      END;
  2506.                   ENDCASE;
  2507.                DC A(X'80000000'+*+4);  % PARM LIST
  2508.                DC AL1(20,&&VERB);
  2509.                ASM IF ('&FLAGS1(1)' EQ '') THEN DC AL1(0)
  2510.                ELSE DC AL1(&&FLAGS1(1));
  2511.                ASM IF ('&FLAGS1(2)' EQ '') THEN DC AL1(0)
  2512.                ELSE DC AL1(&&FLAGS1(2));
  2513.                &&ERROR: DC AL2(0);
  2514.                &&INFO: DC AL2(0);
  2515.                DC A(&&DALPTR);
  2516.                DC A(0);
  2517.                ASM IF ('&FLAGS2(1)' EQ '') THEN DC AL1(0)
  2518.                ELSE DC AL1(&&FLAGS2(1));
  2519.                ASM IF ('&FLAGS2(2)' EQ '') THEN DC AL1(0)
  2520.                ELSE DC AL1(&&FLAGS2(2));
  2521.                ASM IF ('&FLAGS2(3)' EQ '') THEN DC AL1(0)
  2522.                ELSE DC AL1(&&FLAGS2(3));
  2523.                ASM IF ('&FLAGS2(4)' EQ '') THEN DC AL1(0)
  2524.                ELSE DC AL1(&&FLAGS2(4));
  2525.                END;
  2526.             'E': BEGIN
  2527.                &&L: SYSLBL;
  2528.                ASM IF ('&DALINIT' NE 'NO') THEN BEGIN
  2529.                   SYSLST &&MF(2),NEW=4+&&MF(2);
  2530.                   OI &&MF(2),X'80';
  2531.                   MZC 4+&&MF(2),20;
  2532.                   MVI 4+&&MF(2),20;
  2533.                   SYSLST 12+&&MF(2),NEW=&&DALPTR;
  2534.                   ASM IF ('&VERB' EQ '')
  2535.                   THEN MNOTE 12,'VERB REQUIRED WITH MF=E AND INIT=YES';
  2536.                   END;
  2537.                ASM IF ('&VERB' NE '')
  2538.                THEN SYSLST 5+&&MF(2),NEW=&&VERB,STORE=STC;
  2539.                ASM IF ('&FLAGS1(1)' NE '')
  2540.                THEN SYSLST 6+&&MF(2),NEW=&&FLAGS1(1),STORE=STC;
  2541.                ASM IF ('&FLAGS1(2)' NE '')
  2542.                THEN SYSLST 7+&&MF(2),NEW=&&FLAGS1(2),STORE=STC;
  2543.                ASM IF ('&FLAGS2(1)' NE '')
  2544.                THEN SYSLST 20+&&MF(2),NEW=&&FLAGS2(1),STORE=STC;
  2545.                ASM IF ('&FLAGS2(2)' NE '')
  2546.                THEN SYSLST 21+&&MF(2),NEW=&&FLAGS2(2),STORE=STC;
  2547.                ASM IF ('&FLAGS2(3)' NE '')
  2548.                THEN SYSLST 22+&&MF(2),NEW=&&FLAGS2(3),STORE=STC;
  2549.                ASM IF ('&FLAGS2(4)' NE '')
  2550.                THEN SYSLST 23+&&MF(2),NEW=&&FLAGS2(4),STORE=STC;
  2551.                END;
  2552.             'R': BEGIN
  2553.                &&L: SYSLBL;
  2554.                END;
  2555.             ENDCASE ELSE;
  2556.          END;
  2557.       'TEXT': BEGIN
  2558.          ASM IF (NOT &&DALSW) THEN BEGIN
  2559.             MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
  2560.             &&L: SYSLBL;
  2561.             MEXIT;
  2562.             END;
  2563.          &&DALNUM: SETA &&DALNUM+1;
  2564.          BAL;
  2565. &DALLBL(&DALNUM) SETC 'DALT&@'
  2566. ALP;
  2567.          ASM CASE '&DALMF';
  2568.             '','L': BEGIN
  2569.                DALT&&@: DS 0X;
  2570.                &&X: SETA N'&&SYSLIST-2;
  2571.                &&L: DC AL2(&&VERB,&&X);
  2572.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2573.                   &&Y: SETA &&X-2;
  2574.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2575.                      ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2576.                         DC AL2(&&SYSLIST(&&X,2)),&&SYSLIST(&&X,1);
  2577.                         END
  2578.                      ELSE BEGIN
  2579.                        DC AL2(&&SYSLIST(&&X,2)),XL(&&SYSLIST(&&X,2))'0';
  2580.                         END;
  2581.                      END
  2582.                   ELSE BEGIN
  2583.                      DC AL2(L'DAC&&Y&&@);
  2584.                      DAC&&Y&&@: DC &&SYSLIST(&&X,1);
  2585.                      END;
  2586.                   END;
  2587.                END;
  2588.             'E': BEGIN
  2589.                &&L: SYSLBL;
  2590.                ASM IF ('&MF' NE 'L' AND '&DALINIT' NE 'NO') THEN BEGIN
  2591.                   SYSLST &&DALLEN+&&DALPL,NEW=&&VERB,STORE=STOREH;
  2592.                   &&X: SETA N'&&SYSLIST-2;
  2593.                   SYSLST &&DALLEN+2+&&DALPL,NEW=&&X,STORE=STOREH;
  2594.                   END;
  2595.                DALT&&@: EQU &&DALLEN+4;
  2596.                &&DALLEN: SETC 'DALT&@';
  2597.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2598.                   &&Y: SETA &&X-2;
  2599.                   ASM IF ('&MF' NE 'L') THEN BEGIN
  2600.                      ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
  2601.                         ASM IF ('&DALINIT' NE 'NO')
  2602.                         THEN SYSLST &&DALLEN+&&DALPL,_
  2603.                                     NEW=&&SYSLIST(&&X,2),STORE=STOREH;
  2604.                         ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2605.                            DALLISTM &&DALLEN+2+&&DALPL,_
  2606.                            &&SYSLIST(&&X,1),&&SYSLIST(&&X,2);
  2607.                            END;
  2608.                         END
  2609.                      ELSE BEGIN
  2610.                         ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
  2611.                         THEN BEGIN
  2612.                            SYSLST &&DALLEN+&&DALPL,_
  2613.                            NEW=&&SYSLIST(&&X,3),STORE=STOREH;
  2614.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2615.                               DALLISTM &&DALLEN+2+&&DALPL,_
  2616.                               &&SYSLIST(&&X,1),&&SYSLIST(&&X,3);
  2617.                               END;
  2618.                            END
  2619.                         ELSE BEGIN
  2620.                            &&STORE: SETC '&SYSLIST(&X,3)'(2,_
  2621.                                       K'&&SYSLIST(&&X,3)-2);
  2622.                            ASM CASE '&STORE';
  2623.                               'STC','STOREB': <&&Y: SETA 1>;
  2624.                               'STH','STOREH','STORELH': <&&Y: SETA 2>;
  2625.                               'STOREP': <&&Y: SETA 3>;
  2626.                               'ST','STOREF','STORELF': <&&Y: SETA 4>;
  2627.                               ENDCASE
  2628.                            ELSE BEGIN
  2629.                               MNOTE 12,'UNABLE TO DETERMINE LENGTH '_
  2630.                               'FROM OPCODE (&STORE)';
  2631.                               &&Y: SETA 0;
  2632.                               END;
  2633.                            ASM IF ('&DALINIT' NE 'NO' OR _
  2634.                            '&Y' NE '&SYSLIST(&X,2)')
  2635.                            THEN SYSLST &&DALLEN+&&DALPL,NEW=&&Y,_
  2636.                                        STORE=STOREH;
  2637.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2638.                               SYSLST &&DALLEN+2+&&DALPL,_
  2639.                                      NEW=&&SYSLIST(&&X,1),STORE=&&STORE;
  2640.                               END;
  2641.                            END;
  2642.                         END;
  2643.                      END;
  2644.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2645.                      DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
  2646.                      END
  2647.                   ELSE BEGIN
  2648.                      ASM IF ('&MF' NE 'L') THEN BEGIN
  2649.                         DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
  2650.                         END
  2651.                      ELSE BEGIN
  2652.                         DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
  2653.                         DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
  2654.                         END;
  2655.                      END;
  2656.                   &&DALLEN: SETC 'DAL&Y&@';
  2657.                   END;
  2658.                END;
  2659.             'R': BEGIN
  2660.                &&L: SYSLBL;
  2661.                DALT&&@: EQU &&DALLEN+4;
  2662.                &&DALLEN: SETC 'DALT&@';
  2663.                ASM FOR &&X FROM 3 TO N'&&SYSLIST DO BEGIN
  2664.                   &&Y: SETA &&X-2;
  2665.                   ASM IF ('&MF' NE 'L') THEN BEGIN
  2666.                      ASM IF ('&SYSLIST(&X,3)' EQ '') THEN BEGIN
  2667.                         ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2668.                            DALLISTM &&SYSLIST(&&X,1),_
  2669.                            &&DALLEN+2+&&DALPL,&&SYSLIST(&&X,2);
  2670.                            END;
  2671.                         END
  2672.                      ELSE BEGIN
  2673.                         ASM IF ('&SYSLIST(&X,3)'(1,1) NE '''')
  2674.                         THEN BEGIN
  2675.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2676.                               DALLISTM &&SYSLIST(&&X,1),_
  2677.                               &&DALLEN+2+&&DALPL,&&SYSLIST(&&X,3);
  2678.                               END;
  2679.                            END
  2680.                         ELSE BEGIN
  2681.                            &&STORE: SETC '&SYSLIST(&X,3)'(2,_
  2682.                                       K'&&SYSLIST(&&X,3)-1);
  2683.                            ASM IF ('&SYSLIST(&X,1)' NE '') THEN BEGIN
  2684.                               ASM CASE '&STORE';
  2685.                                  'STC','STOREB': <&&LOAD: SETC 'IC'>;
  2686.                                  'STOREH','STOREH','STORELH':
  2687.                                  <&&LOAD: SETC 'LOADH'>;
  2688.                                  'STOREP': <&&LOAD: SETC 'LOADP'>;
  2689.                                  'ST','STOREF','STORELF':
  2690.                                  <&&LOAD: SETC 'LOADF'>;
  2691.                                  ENDCASE
  2692.                               ELSE BEGIN
  2693.                                  MNOTE 12,'UNABLE TO DETERMINE PROPER '_
  2694.                                  'LOAD OPERATION FOR STORE OPERATION '_
  2695.                                  '&STORE';
  2696.                                  &&LOAD: SETC '?';
  2697.                                  END;
  2698.                               SYSLST &&DALLEN+2+&&DALPL,OLD=RTNR,_
  2699.                               LOAD=&&LOAD;
  2700.                               SYSLST &&SYSLIST(&&X,1),NEW=(RTNR),_
  2701.                               STORE=&&STORE;
  2702.                               END;
  2703.                            END;
  2704.                         END;
  2705.                      END;
  2706.                   ASM IF ('&SYSLIST(&X,2)' NE '') THEN BEGIN
  2707.                      DAL&&Y&&@: EQU &&DALLEN+2+&&SYSLIST(&&X,2);
  2708.                      END
  2709.                   ELSE BEGIN
  2710.                      ASM IF ('&MF' NE 'L') THEN BEGIN
  2711.                         DAL&&Y&&@: EQU &&DALLEN+2+&&LQ&&SYSLIST(&&X,1);
  2712.                         END
  2713.                      ELSE BEGIN
  2714.                         DAC&&Y&&@: DS 0&&SYSLIST(&&X,1);
  2715.                         DAL&&Y&&@: EQU &&DALLEN+2+L'DAC&&Y&&@;
  2716.                         END;
  2717.                      END;
  2718.                   &&DALLEN: SETC 'DAL&Y&@';
  2719.                   END;
  2720.                END;
  2721.             ENDCASE ELSE;
  2722.          END;
  2723.       'END': BEGIN
  2724.          ASM IF (NOT &&DALSW) THEN BEGIN
  2725.             MNOTE 12,'NO CORRESPONDING DALLIST BEGIN';
  2726.             &&L: SYSLBL;
  2727.             MEXIT;
  2728.             END;
  2729.          ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'L') THEN BEGIN
  2730.             &&L: SYSLBL TYPE=F;
  2731.             &&DALPTR: DS 0F;
  2732.             ASM IF (&&DALNUM LE 0)
  2733.             THEN MNOTE 12,'NO DALLIST TEXT ITEMS'
  2734.             ELSE BEGIN
  2735.                ASM FOR &&X FROM 1 TO &&DALNUM-1 DO BEGIN
  2736.                   DC A(&&DALLBL(&&X));
  2737.                   END
  2738.                THEN BEGIN
  2739.                   DC A(X'80000000'+&&DALLBL(&&DALNUM));
  2740.                   END;
  2741.                END;
  2742.             END;
  2743.          ASM IF ('&DALMF' EQ 'E' OR '&DALMF' EQ 'R') THEN BEGIN
  2744.             &&L: SYSLBL;
  2745.             END;
  2746.          ASM IF ('&DALMF' EQ 'E' AND '&DALINIT' NE 'NO') THEN BEGIN
  2747.             &&DALPTR: EQU (&&DALLEN+3)/4*4+&&DALPL;
  2748.             &&Y: SETA 0;
  2749.             ASM FOR &&X FROM 1 TO &&DALNUM DO BEGIN
  2750.                &&Y: SETA (&&X-1)*4;
  2751.                SYSLST &&DALPTR+&&Y,NEW=&&DALLBL(&&X)-4+&&DALPL;
  2752.                END;
  2753.             OI &&DALPTR+&&Y,X'80';
  2754.             END;
  2755.          ASM IF ('&DALMF' EQ '' OR '&DALMF' EQ 'E') THEN BEGIN
  2756.             ASM IF ('&DALMF' EQ '') THEN <&&DALEND: SYSLBL>;
  2757.             ASM IF ('&SVC' NE 'NO') THEN BEGIN
  2758.                SYSLR VR1,&&DALPL;
  2759.                DYNALLOC;
  2760.                END;
  2761.             END;
  2762.          &&DALSW: SETB 0;
  2763.          END;
  2764.       ENDCASE
  2765.    ELSE BEGIN
  2766.       MNOTE 12,'"DALLIST &TYPE" IS ILLEGAL';
  2767.       &&L: SYSLBL;
  2768.       END;
  2769.    MEND;
  2770. BAL;
  2771. ./       ADD   LIST=ALL,NAME=DALLISTM
  2772. ALP;
  2773.  
  2774. MACRO &&L: DALLISTM &&TO,&&FROM,&&LEN;
  2775.    ASM IF ('&LEN' EQ '') THEN MMVC &&TO,&&FROM
  2776.    ELSE BEGIN
  2777.       ASM IF ('&LEN'(1,1) NE '(')
  2778.       THEN MMVC &&TO,&&FROM,&&LEN
  2779.       ELSE IF <RP &&LEN> THEN EXI &&LEN,MMVC,&&TO,&&FROM,DECR=YES,_
  2780.                                   INCR=YES;
  2781.       END;
  2782.    MEND;
  2783.  
  2784. BAL;
  2785. ./       ADD   LIST=ALL,NAME=DALMSG
  2786. ALP;
  2787.  
  2788.  MACRO &&LBL: DALMSG &&DALLIST=,&&RC=,&&MSG1=,_
  2789.  &&FLAGS1=,&&FLAGS2=,_
  2790.  &&MSG2=,&&MSG2LEN=,&&MSG1LEN=,&&MF=L;
  2791.     LCLC  &&Q,&&OP,&&F1,&&F2;
  2792. &&Q:     SETC  '&SYSNDX';
  2793. &&F1: SETC '40';  % DEFAULT FLAGS
  2794. &&F2: SETC '33';  % DEFAULT FLAGS2
  2795.     &&OP:    SETC  'DC';  % ASSUME LIST FORM
  2796.  ASMIF ('&MF(1)' EQ 'L') THEN
  2797.     BEGIN
  2798.        ASMIF ('&FLAGS1' NE '') THEN &&F1: SETC '&FLAGS1';
  2799.        ASMIF ('&FLAGS2' NE '') THEN &&F2: SETC '&FLAGS2';
  2800.     DAMS&&Q:   DS    0F;
  2801.     &&LBL:     &&OP    A(0);
  2802.     &&OP    A(DAMR&&Q); %RETURN CODE
  2803.     &&OP    A(*+8); %ZEROES
  2804.     &&OP    A(DAMF&&Q); %FLAGS
  2805.     &&OP    A(0);
  2806.     &&OP    A(DAMB&&Q); %BUFFER
  2807.     DAMR&&Q:   &&OP   A(0); %WILL CONTAIN RETURN CODE
  2808.     DAMF&&Q:   &&OP   X'&F1',X'&F2'; %FLAGS
  2809.     DAMB&&Q:   DS   0H;
  2810.     &&MSG1LEN: &&OP   H'0',H'0'; %LENGTH OF 1ST MSG, 0
  2811.     &&MSG1:    &&OP    CL251' '; %TEXT OF 1ST MESSAGE
  2812.     &&MSG2LEN: &&OP   H'0',H'0'; %LENGTH OF 2ND MSG, 0
  2813.     &&MSG2:    &&OP    CL251' ';
  2814.        MEXIT;
  2815.        END;
  2816.     &&LBL:   SYSLR VR0,&&RC,OP=L;
  2817.     SYSLR VR1,&&MF(2);
  2818.     ST    VR0,24(,VR1);
  2819.     ASMIF ('&FLAGS1' NE '') THEN
  2820.     BEGIN
  2821.        MVI   28(VR1),X'&F1';
  2822.        END;
  2823.     ASMIF ('&FLAGS2' NE '') THEN
  2824.     BEGIN
  2825.        MVI   29(VR1),X'&F2';
  2826.        END;
  2827.     SYSLR VR1,&&DALLIST,OP=L;
  2828.     ST    VR1,&&MF(2);
  2829.     LA    VR1,&&MF(2);
  2830.     LINK  EP=IKJEFF18;
  2831.     MEND;
  2832. BAL;
  2833. ./       ADD   LIST=ALL,NAME=DBCCALL
  2834. ALP;
  2835.  
  2836. MACRO &&L: DBCCALL &&STR,&&IF=;
  2837.    GBLC &&DBC;
  2838.    LCLC &&LBL,&&CODE,&&MSG(8);
  2839.    LCLA &&LEN,&&P,&&Q,&&X;
  2840.  
  2841.    ASM IF ('&IF' EQ '') THEN BEGIN  % UNCONDITIONAL CALL
  2842.       ASM IF ('&DBC' NE 'YES') THEN BEGIN
  2843.          ASM IF ('&STR' EQ '')
  2844.          THEN <&&L: DC H'0'>
  2845.          ELSE <&&L: DC 0H'0',X'00',C&&STR>;
  2846.          END
  2847.       ELSE BEGIN
  2848.          ASM IF ('&STR' EQ '') THEN <&&L: DC 0H'0',X'00DEAD00'>
  2849.          ELSE BEGIN
  2850.             &&LBL: SETC 'DBC&@.A';
  2851.             ASM IF ('&L' NE '') THEN <&&LBL: SETC '&L'>;
  2852.             &&LBL: DC 0H'0',X'00DEAD',AL1(DBC&&@.L),C&&STR;
  2853.             DBC&&@.L: EQU *-&&LBL-4;
  2854.             END;
  2855.          END;
  2856.       END
  2857.    ELSE BEGIN  % CONDITIONAL CALL
  2858.       &&P: SETA 1;
  2859.       ASM FOR &&X FROM 2 TO K'&&STR-2 DO BEGIN
  2860.          &&LEN: SETA &&LEN+1;
  2861.          ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
  2862.          &&MSG(&&P): SETC '&MSG(&P)'.'&STR'(&&X,1);
  2863.          ASM IF ('&STR'(&X,1) EQ ''''''(1,1)) THEN BEGIN
  2864.             &&Q: SETA (&&Q+1)-(&&Q+1)/2*2;
  2865.             &&LEN: SETA &&LEN-&&Q;
  2866.             END;
  2867.          END;
  2868.       &&CODE: SETC '';  % X'00'
  2869.       ASM IF ('&DBC' EQ 'YES') THEN BEGIN
  2870.          &&CODE: SETC '#[';  % X'00DEAD'
  2871.          ASM SELECT FIRST;
  2872.             (&&LEN LT 64): &&CODE: SETC '&CODE'._
  2873. '     
  2874. '_
  2875.             ''(&&LEN,1);
  2876.             (&&LEN LT 2*64): &&CODE: SETC '&CODE'._
  2877. ' &akb+ .<(+|&&)*[%c(!$*);^-/_\]^,:,%_>?W012|V{`:#@''="'_
  2878.             ''(&&LEN-64,1);
  2879.             (&&LEN LT 3*64): &&CODE: SETC '&CODE'._
  2880. 'xabcdefghi$s/.E jklmnopqrNq~H~stuvwxyzo@Z[ry56}789f;<=Y?]XD'_
  2881.             ''(&&LEN-2*64,1);
  2882.             (&&LEN LT 4*64): &&CODE: SETC '&CODE'._
  2883. '{ABCDEFGHIKJ>hlm}JKLMNOPQR!-ut#\gSTUVWXYZ idQ01234567893wpz''_
  2884.             ''(&&LEN-3*64,1);
  2885.             ENDSEL;
  2886.          END;
  2887.       ASM IF ((&&LEN+K'&&CODE) NE (&&LEN+K'&&CODE)/2*2) THEN BEGIN
  2888.          &&LEN: SETA &&LEN+1;
  2889.          ASM IF (K'&&MSG(&&P) GE 8) THEN <&&P: SETA &&P+1>;
  2890.          &&MSG(&&P): SETC '&MSG(&P)'.' ';
  2891.          END;
  2892.       SYSPRED =C'&CODE&MSG(1)&MSG(2)&MSG(3)&MSG(4)&MSG(5)&MSG(6)'_
  2893.       '&MSG(7)&MSG(8)',IF=&&IF;
  2894.       END;
  2895.    MEND;
  2896. BAL;
  2897. ./       ADD   LIST=ALL,NAME=DCC
  2898.          MACRO
  2899. &L       DCC   &CONST,&LENGTH=
  2900.          AIF   ('&LENGTH' EQ '').NULL
  2901.          AIF   ('&LENGTH' EQ '0').ZERO
  2902. &L       DC    &CONST
  2903.          MEXIT
  2904. .*
  2905. .NULL    ANOP
  2906.          MNOTE 12,'LENGTH MUST BE SPECIFIED'
  2907. .*
  2908. .ZERO    ANOP
  2909.          AIF   ('&L' EQ '').END
  2910. &L       EQU   *,0
  2911. .END     MEND
  2912. ./       ADD   LIST=ALL,NAME=DEBLANK
  2913.          MACRO
  2914. &L       DEBLANK &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=,     *
  2915.                &FILL=C' ',&FILADDR=
  2916.          LCLB  &END
  2917.          LCLC  &LL,&R
  2918.          LCLA  &D
  2919.          SYSKWT TYPE,&TYPE,(LEFT,RIGHT,BOTH,NONE),COND=NO,NULL=NO
  2920.          SYSKWT ZERO,&ZERO,(YES,NO),COND=NO,NULL=NO
  2921.          SYSKWT NULL,&NULL,(YES,NO),COND=NO,NULL=NO
  2922.          AIF   ('&TYPE' EQ '').NONE
  2923. &LL      SETC  '&L'
  2924. &R       SETC  'DEBL&SYSNDX'
  2925.          AIF   ('&LABEL' EQ '' OR '&NULL' EQ 'NO').NR
  2926. &R       SETC  '&LABEL'
  2927. .NR      ANOP
  2928.          AIF   ('&TYPE' EQ 'LEFT').LEFT
  2929.          AIF   ('&W' NE '' AND '&W' NE '&S').DIFF
  2930.          AIF   ('&ZERO' EQ 'NO').NZ1
  2931. &LL      LTR   &N,&N                   TEST LENGTH
  2932.          BNP   &R                      BR IF ZERO
  2933. &END     SETB  1
  2934. &LL      SETC  ''
  2935. .NZ1     ANOP
  2936. &LL      ALR   &S,&N                   POINT AT END OF STRING
  2937. &LL      SETC  ''
  2938.          BCTR  &S,0                    NEXT CHARACTER
  2939.          DEBLANKT &S,&FILL,&FILADDR    IS IT BLANK?
  2940.    AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN1
  2941.          BNE   *+12                    BR IF NOT BLANK
  2942.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2943.          B     &R                      BR IF NULL RESULT
  2944. &END     SETB  1
  2945.          SLR   &S,&N                   COMPUTE START OF STRING
  2946.          LA    &S,1(,&S)
  2947.          AGO   .LEFT
  2948. .NN1     BNE   *+8                     BR IF NOT BLANK
  2949.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2950.          SLR   &S,&N                   COMPUTE START OF STRING
  2951.          LA    &S,1(,&S)
  2952.          AGO   .LEFT
  2953. .DIFF    ANOP
  2954. &LL      LTR   &W,&N                   COUNT TO WORK REGISTER
  2955. &LL      SETC  ''
  2956.          AIF   ('&ZERO' EQ 'NO').NZ2
  2957.          BNP   &R                      BR IF NULL STRING
  2958. &END     SETB  1
  2959. .NZ2     ALR   &W,&S                   POINT AT END OF STRING
  2960.          BCTR  &W,0                    NEXT CHARACTER
  2961.          DEBLANKT &W,&FILL,&FILADDR    IS IT BLANK?
  2962.    AIF ('&NULL' EQ 'NO' OR ('&LABEL' EQ '' AND '&TYPE' EQ 'RIGHT')).NN2
  2963.          BNE   *+12                    BR IF NOT BLANK
  2964.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2965.          B     &R                      BR IF NULL RESULT
  2966. &END     SETB  1
  2967.          AGO   .LEFT
  2968. .NN2     BNE   *+8                     BR IF NOT BLANK
  2969.          BCT   &N,*-10                 DECR. COUNT AND TRY AGAIN
  2970. .LEFT    AIF   ('&TYPE' EQ 'RIGHT').DONE
  2971.          AIF   ('&ZERO' EQ 'NO' OR '&TYPE' NE 'LEFT').NZ3
  2972. &LL      LTR   &N,&N                   TEST FOR ZERO LENGTH
  2973.          BNP   &R                      BR IF ZERO
  2974. &END     SETB  1
  2975. &LL      SETC  ''
  2976. .NZ3     ANOP
  2977. &LL      DEBLANKT &S,&FILL,&FILADDR    CHARACTER BLANK?
  2978. &LL      SETC  ''
  2979. &D       SETA  12
  2980.          AIF   ('&R' EQ 'DEBL&SYSNDX').N16
  2981. &D       SETA  16
  2982. .N16     ANOP
  2983.          AIF   ('&TYPE' NE 'LEFT' AND ('&W' EQ '' OR '&W' EQ '&S')).NLA
  2984.          BNE   *+&D                    BR IF NOT BLANK
  2985.          LA    &S,1(,&S)               NEXT CHARACTER
  2986.          AGO   .BCT
  2987. .NLA     ANOP
  2988. &D       SETA  &D-4
  2989.          BNE   *+&D
  2990. .BCT     BCT   &N,*-12                 DECR. COUNT AND TRY AGAIN
  2991.          AIF   ('&R' EQ 'DEBL&SYSNDX').DONE
  2992.          B     &R                      NULL RESULT
  2993. .DONE    AIF   (&END EQ 0 OR '&R' NE 'DEBL&SYSNDX').NL
  2994. DEBL&SYSNDX DS 0H
  2995. .NL      MEXIT
  2996. .NONE    ANOP
  2997. &L       SYSLBL
  2998.          MEND
  2999. ./       ADD   LIST=ALL,NAME=DEBLANKT
  3000.          MACRO
  3001. &L       DEBLANKT &R,&FILL,&FILADDR
  3002.          AIF   ('&FILADDR' EQ '').FILL
  3003. &L       CLC   0(1,&R),&FILADDR
  3004.          MEXIT
  3005. .*
  3006. .FILL    ANOP
  3007. &L       CLI   0(&R),&FILL
  3008.          MEND
  3009. ./       ADD   LIST=ALL,NAME=DF
  3010.          MACRO
  3011. &L       DF    &INIT=
  3012.          LCLA  &X,&Y,&Z,&V
  3013.          LCLC  &T(8),&S,&I(10)
  3014. .*
  3015. &T(1)    SETC  '80'
  3016. &T(2)    SETC  '40'
  3017. &T(3)    SETC  '20'
  3018. &T(4)    SETC  '10'
  3019. &T(5)    SETC  '08'
  3020. &T(6)    SETC  '04'
  3021. &T(7)    SETC  '02'
  3022. &T(8)    SETC  '01'
  3023. .*
  3024. &Y       SETA  1
  3025. &I(1)    SETC  '0'
  3026. .*
  3027.          AIF   ('&L' EQ '').NLBL
  3028. &V       SETA  (N'&SYSLIST+7)/8
  3029. &L       DS    0XL&V
  3030. .NLBL    ANOP
  3031. .*
  3032. .LOOP    ANOP
  3033.          AIF   ((&X EQ 0 OR &X/8*8 NE &X) AND &X LT N'&SYSLIST).NDS
  3034. .*
  3035. .CLEAR   ANOP
  3036. &Y       SETA  &Y+1
  3037. &I(&Y)   SETC  ''
  3038.          AIF   (&Y LT 9).CLEAR
  3039. &Y       SETA  1
  3040. .*
  3041.          DC    AL1(&I(1)&I(2)&I(3)&I(4)&I(5)&I(6)&I(7)&I(8)&I(9))
  3042. .NDS     ANOP
  3043. .*
  3044. &X       SETA  &X+1
  3045.          AIF   (&X GT N'&SYSLIST).END
  3046. &S       SETC  '&T(&X-(&X-1)/8*8)'
  3047. &SYSLIST(&X) DS 0XL(X'&S')
  3048. .*
  3049. &Z       SETA  0
  3050. .INIT    ANOP
  3051. &Z       SETA  &Z+1
  3052.          AIF   (&Z GT N'&INIT).LOOP
  3053.          AIF   ('&SYSLIST(&X)' NE '&INIT(&Z)').INIT
  3054. &Y       SETA  &Y+1
  3055. &I(&Y)   SETC  '+X''&S'''
  3056.          AGO   .LOOP
  3057. .*
  3058. .END     MEND
  3059. ./       ADD   LIST=ALL,NAME=DI
  3060.          MACRO
  3061. &L       DI    &R,&V
  3062.          LCLA  &X
  3063. .*
  3064. .LOOP    ANOP
  3065. &X       SETA  &X+1
  3066.          AIF   (&X GT K'&V).INT
  3067.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  3068. .*
  3069. &L       D     &R,=A(&V)
  3070.          MEXIT
  3071. .*
  3072. .INT     ANOP
  3073. &L       D     &R,=F'&V'
  3074.          MEND
  3075. ./       ADD   LIST=ALL,NAME=DSC
  3076.          MACRO
  3077. &L       DSC   &CONST,&LENGTH=
  3078.          AIF   ('&LENGTH' EQ '').NULL
  3079.          AIF   ('&LENGTH' EQ '0').ZERO
  3080. &L       DS    &CONST
  3081.          MEXIT
  3082. .*
  3083. .NULL    ANOP
  3084.          MNOTE 12,'LENGTH MUST BE SPECIFIED'
  3085. .*
  3086. .ZERO    ANOP
  3087.          AIF   ('&L' EQ '').END
  3088. &L       EQU   *,0
  3089. .END     MEND
  3090. ./       ADD   LIST=ALL,NAME=EDIT
  3091.          MACRO
  3092. &L       EDIT  &T,&F,&TL,&FL,&CALC=YES,&DIGITS=1,&MARK=NO
  3093.          LCLA  &TOLEN,&FLEN,&D,&IX
  3094.          LCLC  &H(16),&MK
  3095. .*
  3096.          AIF   ('&TL' NE '').USETL
  3097.          AIF   (T'&T NE 'N' AND T'&T NE 'O' AND T'&T NE 'T' AND        X
  3098.                T'&T NE 'W' AND T'&T NE 'U' AND T'&T NE '$' AND         X
  3099.                T'&T NE 'M').TOOK
  3100.        MNOTE 12,'TO FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
  3101.          MEXIT
  3102. .TOOK    ANOP
  3103. &TOLEN   SETA  L'&T
  3104.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&TOLEN)'
  3105.          AGO   .CKFL
  3106. .USETL   ANOP
  3107. &TOLEN   SETA  &TL
  3108. .CKFL    ANOP
  3109.          AIF   ('&FL' NE '').USEFL
  3110.          AIF   (T'&F NE 'N' AND T'&F NE 'O' AND T'&F NE 'T' AND        X
  3111.                T'&F NE 'W' AND T'&F NE 'U' AND T'&F NE '$' AND         X
  3112.                T'&F NE 'M').FOK
  3113.      MNOTE 12,'FROM FIELD DOES NOT HAVE AN EXPLICIT OR IMPLICIT LENGTH'
  3114.          MEXIT
  3115. .FOK     ANOP
  3116. &FLEN    SETA  L'&F
  3117.          AGO   .LENDONE
  3118. .USEFL   ANOP
  3119. &FLEN    SETA  &FL
  3120.          MNOTE *,'LENGTH ATTRIBUTE OF SECOND OPERAND USED (&FLEN)'
  3121. .LENDONE ANOP
  3122. .*
  3123.          AIF   (2*(&TOLEN/2) EQ &TOLEN).LENOK
  3124.          MNOTE 4,'LENGTH OF &T MUST BE EVEN'
  3125.          MEXIT
  3126. .LENOK   ANOP
  3127.          AIF   (&FLEN+&FLEN GE &TOLEN).NEXT
  3128.          MNOTE 4,'&F DOES NOT HAVE ENOUGH SOURCE DIGITS'
  3129.          MEXIT
  3130. .NEXT    ANOP
  3131.          AIF   ('&MARK' EQ 'NO').NOMK
  3132. &MK      SETC  'MK'
  3133. .NOMK    ANOP
  3134. .*
  3135. &IX      SETA  1
  3136. &H(1)    SETC  '40'
  3137. .L1      ANOP
  3138. &IX      SETA  &IX+1
  3139. &H(&IX)  SETC  '20'
  3140.          AIF   (&IX LT &TOLEN).L1
  3141. .*
  3142. &D       SETA  &DIGITS
  3143.          AIF   (&D EQ 0 OR &TOLEN EQ 2).NOSIG
  3144. &H(&IX-&D) SETC '21'
  3145. .NOSIG   ANOP
  3146. .*
  3147. &L       SYSXXCB MVC,&T,=X'&H(1)&H(2)&H(3)&H(4)&H(5)&H(6)&H(7)&H(8)&H(9X
  3148.                )&H(10)&H(11)&H(12)&H(13)&H(14)&H(15)&H(16)',&TOLEN
  3149.          AIF   ('&MARK' EQ 'NO').NOMK2
  3150.          LA    1,&T+&TOLEN-&D
  3151. .NOMK2   ANOP
  3152. .*
  3153.          AIF   ('&CALC' EQ 'YES').CALC
  3154.          SYSXXCB ED&MK,&T,&F,&TOLEN
  3155.          MEXIT
  3156. .CALC    ANOP
  3157.          SYSXXCB ED&MK,&T,&FLEN-(&TOLEN-1)/2-1+&F,&TOLEN
  3158.          MEND
  3159. ./       ADD   LIST=ALL,NAME=EXI
  3160.          MACRO
  3161. &L       EXI   &R,&OP,&A,&B,&DECR=NO,&INCR=NO
  3162.          GBLC  &EXOP(25),&EXA(250),&EXB(250)
  3163.          GBLA  &EXORG,&EXN
  3164.          LCLA  &X,&Z
  3165.          LCLC  &LBL
  3166. .*
  3167.          SYSKWT DECR,&DECR,(YES,NO),COND=NO,NULL=NO
  3168.          SYSKWT INCR,&INCR,(YES,NO),COND=NO,NULL=NO
  3169. .*
  3170. &LBL     SETC  '&L'
  3171. .*
  3172.          AIF   ('&DECR' NE 'YES').NDECR
  3173. &LBL     SI    &R,1
  3174. &LBL     SETC  ''
  3175. .NDECR   ANOP
  3176. .*
  3177. &X       SETA  0
  3178. .SLOOP   ANOP
  3179. &X       SETA  &X+1
  3180.          AIF   (&X GT &EXN).SDONE
  3181.          AIF   ('&OP' NE '&EXOP(&X)').SLOOP
  3182. &Z       SETA  (&X-1)*10
  3183.          AIF   ('&A' NE '&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&*
  3184.                Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10)'*
  3185.                ).SLOOP
  3186.          AIF   ('&B' NE '&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&*
  3187.                Z+5)&EXB(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)'*
  3188.                ).SLOOP
  3189. .*
  3190. &X       SETA  &EXORG+&X
  3191. &LBL     EX    &R,EXI#&X
  3192.          AGO   .INCR
  3193. .*
  3194. .SDONE   ANOP
  3195. .*
  3196.          AIF   (&EXN LT 25).OK
  3197.          MNOTE 12,'EXI TABLE FULL'
  3198. &LBL     EX    &R,0
  3199.          AGO   .INCR
  3200. .*
  3201. .OK      ANOP
  3202. .*
  3203. &EXN     SETA  &EXN+1
  3204. .*
  3205. &X       SETA  &EXORG+&EXN
  3206. &LBL     EX    &R,EXI#&X
  3207. .*
  3208. &EXOP(&EXN) SETC '&OP'
  3209. .*
  3210. &X       SETA  0
  3211.          AIF   ('&A' EQ '').AFILL
  3212. .ALOOP   ANOP
  3213. &X       SETA  &X+1
  3214.          AIF   (&X*8 GE K'&A).ADONE
  3215. &EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,8)
  3216.          AIF   (&X LT 10).ALOOP
  3217.          MNOTE 12,'OPERAND TOO LONG'
  3218.          AGO   .AFILLED
  3219. .*
  3220. .ADONE   ANOP
  3221. &EXA((&EXN-1)*10+&X) SETC '&A'((&X-1)*8+1,K'&A-(&X-1)*8)
  3222. .AFILL   ANOP
  3223. &X       SETA  &X+1
  3224.          AIF   (&X GT 10).AFILLED
  3225. &EXA((&EXN-1)*10+&X) SETC ''
  3226.          AGO   .AFILL
  3227. .*
  3228. .AFILLED ANOP
  3229. .*
  3230. &X       SETA  0
  3231.          AIF   ('&B' EQ '').BFILL
  3232. .BLOOP   ANOP
  3233. &X       SETA  &X+1
  3234.          AIF   (&X*8 GE K'&B).BDONE
  3235. &EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,8)
  3236.          AIF   (&X LT 10).BLOOP
  3237.          MNOTE 12,'OPERAND TOO LONG'
  3238.          AGO   .BFILLED
  3239. .*
  3240. .BDONE   ANOP
  3241. &EXB((&EXN-1)*10+&X) SETC '&B'((&X-1)*8+1,K'&B-(&X-1)*8)
  3242. .BFILL   ANOP
  3243. &X       SETA  &X+1
  3244.          AIF   (&X GT 10).BFILLED
  3245. &EXB((&EXN-1)*10+&X) SETC ''
  3246.          AGO   .BFILL
  3247. .*
  3248. .BFILLED ANOP
  3249. .*
  3250. .INCR    ANOP
  3251.          AIF   ('&INCR' NE 'YES').NINCR
  3252.          AI    &R,1
  3253. .NINCR   ANOP
  3254. .*
  3255.          MEND
  3256. ./       ADD   LIST=ALL,NAME=EXORG
  3257.          MACRO
  3258. &L       EXORG
  3259.          GBLC  &EXOP(25),&EXA(250),&EXB(250)
  3260.          GBLA  &EXORG,&EXN
  3261.          LCLA  &X,&Y,&Z
  3262. .*
  3263. &L       SYSLBL
  3264. .*
  3265. &Y       SETA  &EXN
  3266. &EXN     SETA  0
  3267. .*
  3268. .LOOP    ANOP
  3269. &X       SETA  &X+1
  3270.          AIF   (&X GT &Y).END
  3271. &Z       SETA  (&X-1)*10
  3272. &EXORG   SETA  &EXORG+1
  3273.          AIF   ('&EXOP(&X)' EQ 'MCLC').MCLC
  3274.          AIF   ('&EXOP(&X)' EQ 'MMVC').MMVC
  3275.          AIF   ('&EXOP(&X)' EQ 'MNC').MNC
  3276.          AIF   ('&EXOP(&X)' EQ 'MOC').MOC
  3277.          AIF   ('&EXOP(&X)' EQ 'MXC').MXC
  3278.          AIF   ('&EXOP(&X)' EQ 'MTC').MTC
  3279.          AIF   ('&EXOP(&X)' EQ 'MTR').MTR
  3280.          AIF   ('&EXOP(&X)' EQ 'MTRT').MTRT
  3281.          AIF   ('&EXOP(&X)' EQ 'MZC').MZC
  3282. EXI#&EXORG EXORGA &EXOP(&X),&EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EX*
  3283.                A(&Z+5)&EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+1*
  3284.                0),&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EX*
  3285.                B(&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)
  3286.          AGO   .LOOP
  3287. .*
  3288. .MCLC    ANOP
  3289. EXI#&EXORG MCLC      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3290.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3291.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3292.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3293.          AGO   .LOOP
  3294. .*
  3295. .MMVC    ANOP
  3296. EXI#&EXORG MMVC      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3297.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3298.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3299.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3300.          AGO   .LOOP
  3301. .*
  3302. .MNC     ANOP
  3303. EXI#&EXORG MNC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3304.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3305.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3306.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3307.          AGO   .LOOP
  3308. .*
  3309. .MOC     ANOP
  3310. EXI#&EXORG MOC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3311.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3312.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3313.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3314.          AGO   .LOOP
  3315. .*
  3316. .MTC     ANOP
  3317. EXI#&EXORG MTC   &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
  3318.                (&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
  3319.          AIF   ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
  3320.                (&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
  3321.                MTCOK
  3322.          MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MTC'
  3323. .MTCOK   ANOP
  3324.          AGO   .LOOP
  3325. .*
  3326. .MTR     ANOP
  3327. EXI#&EXORG MTR       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3328.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3329.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3330.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3331.          AGO   .LOOP
  3332. .*
  3333. .MTRT    ANOP
  3334. EXI#&EXORG MTRT      &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3335.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3336.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3337.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3338.          AGO   .LOOP
  3339. .*
  3340. .MXC     ANOP
  3341. EXI#&EXORG MXC       &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)*
  3342.                &EXA(&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),&EXB*
  3343.                (&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB(&Z+6)*
  3344.                &EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10),0,N=1
  3345.          AGO   .LOOP
  3346. .*
  3347. .MZC     ANOP
  3348. EXI#&EXORG MZC   &EXA(&Z+1)&EXA(&Z+2)&EXA(&Z+3)&EXA(&Z+4)&EXA(&Z+5)&EXA*
  3349.                (&Z+6)&EXA(&Z+7)&EXA(&Z+8)&EXA(&Z+9)&EXA(&Z+10),0,N=1
  3350.          AIF   ('&EXB(&Z+1)&EXB(&Z+2)&EXB(&Z+3)&EXB(&Z+4)&EXB(&Z+5)&EXB*
  3351.                (&Z+6)&EXB(&Z+7)&EXB(&Z+8)&EXB(&Z+9)&EXB(&Z+10)' EQ '').*
  3352.                MZCOK
  3353.          MNOTE 12,'TWO OPERANDS ILLEGAL FOR EXI MZC'
  3354. .MZCOK   ANOP
  3355.          AGO   .LOOP
  3356. .*
  3357. .END     MEND
  3358. ./       ADD   LIST=ALL,NAME=EXORGA
  3359.          MACRO
  3360. &L       EXORGA &OP,&A,&B
  3361.          AIF   ('&B' EQ '').ONE
  3362. &L       &OP   &A,&B
  3363.          MEXIT
  3364. .*
  3365. .ONE     ANOP
  3366. &L       &OP   &A
  3367.          MEND
  3368. ./       ADD   LIST=ALL,NAME=FASTPOST
  3369. ALP;
  3370.  
  3371. MACRO &&L: FASTPOST &&ECB,&&CODE,&®=,&&SUPMODE=,&&SAVELOC=,_
  3372. &&ENABLED=;
  3373.    GBLC &&OS;
  3374.  
  3375.    SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
  3376.    SYSKWT ENABLED,&&ENABLED,(YES,NO),COND=NO;
  3377.  
  3378.    &&L: SYSLBL;
  3379.    ASM CASE '&OS';
  3380.       'MFT','MVT': ;  % NO FAST POST
  3381.       'MVS','XA': BEGIN
  3382.          ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
  3383.             FPDO&&@: DO BEGIN
  3384.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3385.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3386.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3387.                   SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3388.                   ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3389.                   THEN L VR0,=XL4'40000000'
  3390.                   ELSE BEGIN
  3391.                      ASM IF ('&CODE' NE '(0)') THEN SYSLR VR0,&&CODE;
  3392.                      O VR0,=XL4'40000000';
  3393.                      END;
  3394.                   DO BEGIN
  3395.                      L VRF,0(,VR1);  % GET CURRENT VALUE OF ECB
  3396.                      IF <RNM VRF> THEN BEGIN  % NOT WAITED ON
  3397.                         CS VRF,VR0,0(VR1);  % TRY TO POST
  3398.                         EXIT FROM FPDO&&@ IF <CC E>;  % GOT IT
  3399.                         NEXT;  % TRY AGAIN
  3400.                         END;
  3401.                      END;
  3402.                   POST (1),(0);
  3403.                   EXIT;
  3404.                   NSUP&&@: ;
  3405.                   END;
  3406.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3407.                SYSCMP XRA,EQ,2;
  3408.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % GO KEY ZERO
  3409.                ASM IF ('&ENABLED' NE 'NO') THEN
  3410.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3411.                SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3412.                ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3413.                THEN L VR0,=XL4'40000000'
  3414.                ELSE BEGIN
  3415.                   SYSLR VR0,&&CODE;
  3416.                   O VR0,=XL4'40000000';
  3417.                   END;
  3418.                ST VR0,0(,VR1);  % POST THE ECB
  3419.                IF <CLI &&SAVELOC,255> THEN BEGIN  % WAIT FLAG ON
  3420.                   MVI &&SAVELOC,0;  % TURN WAIT FLAG OFF
  3421.                   STM 3,13,12(STKR);  % SAVE REGISTERS
  3422.                   LR XRB,STKR;  % SAVE STACK POINTER
  3423.                   SYSCMP XRB,EQ,3;
  3424.                   LM 4,5,&&SAVELOC;  % GET TCB AND RB ADDRESSES
  3425.                   RESUME TCB=(4),RB=(5);  % FORCE OUT OF WAIT
  3426.                   LM 3,13,12(XRB);  % RESTORE REGISTERS
  3427.                   END;
  3428.                ASM IF ('&ENABLED' NE 'NO') THEN
  3429.                SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3430.                MODESET KEYADDR=(2);  % RESTORE KEY
  3431.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3432.                END;
  3433.             ASM EXIT;
  3434.             END;
  3435.          ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
  3436.             FPDO&&@: DO BEGIN
  3437.                SYSLR VR1,&&ECB,ERR='ECB REQUIRED';
  3438.                ASM IF ('&CODE' EQ '' OR '&CODE' EQ '0')
  3439.                THEN L VR0,=XL4'40000000'
  3440.                ELSE BEGIN
  3441.                   SYSLR VR0,&&CODE;
  3442.                   O VR0,=XL4'40000000';
  3443.                   END;
  3444.                DO BEGIN
  3445.                   L VRF,0(,VR1);  % GET CURRENT VALUE OF ECB
  3446.                   IF <RNM VRF> THEN BEGIN  % NOT WAITED ON
  3447.                      CS VRF,VR0,0(VR1);  % TRY TO POST
  3448.                      EXIT FROM FPDO&&@ IF <CC E>;  % GOT IT
  3449.                      NEXT;  % TRY AGAIN
  3450.                      END;
  3451.                   END;
  3452.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3453.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3454.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3455.                   POST (1),(0);
  3456.                   EXIT;
  3457.                   NSUP&&@: ;
  3458.                   END;
  3459.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3460.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % KEY ZERO
  3461.                ASM IF ('&ENABLED' NE 'NO') THEN
  3462.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=SAVE,_
  3463.                RELATED=*;
  3464.                STM 10,11,12(STKR);  % SAVE REGISTERS
  3465.                SYSCMP STKR,EQ,13;
  3466.                LR 11,VR1;  % ECB ADDRESS
  3467.                LR 10,VR0;  % COMPLETION CODE
  3468.                L VRF,CVTPTR;  % CVT ADDRESS
  3469.                L VRF,CVT0PT01-CVT(VRF);  % ENTRY POINT TO POST
  3470.                CBALR VRE,VRF;  % CALL POST ROUTINE
  3471.                LM 10,11,12(STKR);  % RESTORE REGISTERS
  3472.                ASM IF ('&ENABLED' NE 'NO') THEN
  3473.                SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3474.                MODESET KEYADDR=(2);  % RESTORE KEY
  3475.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3476.                END;
  3477.             ASM EXIT;
  3478.             END;
  3479.          END;
  3480.       ENDCASE
  3481.    ELSE MNOTE 4,'FASTPOST UNDEFINED FOR &OS, NORMAL POST USED'
  3482.    THEN BEGIN
  3483.       POST &&ECB,&&CODE;
  3484.       END;
  3485.    MEND;
  3486. BAL;
  3487. ./       ADD   LIST=ALL,NAME=FASTWAIT
  3488. ALP;
  3489.  
  3490. MACRO &&L: FASTWAIT &&COUNT,&&ECB=,&&ECBLIST=,&®=,&&SUPMODE=,_
  3491. &&LABEL=,&&SAVELOC=;
  3492.    GBLC &&OS;
  3493.  
  3494.    SYSKWT SUPMODE,&&SUPMODE,(YES,NO);
  3495.  
  3496.    ASM CASE '&OS';
  3497.       'MFT','MVT': ;  % NO FAST WAIT
  3498.       'MVS','XA': BEGIN
  3499.          ASM IF ('&SUPMODE(1)' EQ 'YES' AND '&SAVELOC' NE '') THEN BEGIN
  3500.             ASM IF ('&COUNT' NE '' AND '&COUNT' NE '1') THEN BEGIN
  3501.                MNOTE 4,'WAIT COUNT OF 1 REQUIRED WITH SAVELOC OPTION';
  3502.                END;
  3503.             &&L: SYSLBL;
  3504.             DO BEGIN
  3505.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3506.                   ASM IF ('&LABEL' NE '') THEN BEGIN
  3507.                      MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
  3508.                      END;
  3509.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3510.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3511.                   WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3512.                   EXIT;
  3513.                   NSUP&&@: ;
  3514.                   END;
  3515.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3516.                SYSCMP XRA,EQ,2;
  3517.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % GO KEY ZERO
  3518.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3519.                FWDO&&@: DO BEGIN
  3520.                   ASM IF ('&ECBLIST' EQ '') THEN BEGIN
  3521.                      SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED';
  3522.                      IF <TM 0(VR1),X'40'> THEN BEGIN  % ECB IS POSTED
  3523.                         SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3524.                         EXIT;
  3525.                         END;
  3526.                      END
  3527.                   ELSE BEGIN
  3528.                      SYSLR VR1,&&ECB&&ECBLIST;
  3529.                      DO BEGIN
  3530.                         L VRF,0(,VR1);  % GET ECB ADDRESS
  3531.                         IF <TM 0(VRF),X'40'> THEN BEGIN  % ECB IS POSTED
  3532.                           SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3533.                            EXIT FROM FWDO&&@;
  3534.                            END;
  3535.                         IF <RNM VRF> THEN BEGIN  % NOT LAST ECB
  3536.                            AI VR1,4;  % NEXT ECB
  3537.                            NEXT;
  3538.                            END;
  3539.                         END;
  3540.                      END;
  3541.                   L VRF,CVTPTR;  % GET ADDRESS OF CVT
  3542.                   L VRE,CVTTCBP-CVT(,VRF); L VRE,0(,VRE);  % GET TCB
  3543.                   L VRF,TCBRBP-TCB(,VRE);  % GET RB ADDRESS
  3544.                   ASM IF ('&OS' EQ 'MVS') THEN ZHBR VRF;
  3545.                   STM VRE,VRF,&&SAVELOC;  % SAVE TCB AND RB ADDRESS
  3546.                   MVI &&SAVELOC,255;  % INDICATE WAIT
  3547.                   ST &®,12(STKR);  % SAVE REGISTER
  3548.                   STM 11,13,12+4(STKR);  % SAVE SUSPEND REGS
  3549.                   LR &®,STKR;  % SAVE STACK REG
  3550.                   SUSPEND RB=CURRENT;  % GO INTO WAIT STATE
  3551.                   SETLOCK RELEASE,TYPE=LOCAL,RELATED=*;  % RELEASE LOCK
  3552.                   LM 11,13,12+4(&®);  % RESTORE REGISTERS
  3553.                   L &®,12(,STKR);
  3554.                   IF <CLI &&SAVELOC,255> THEN BEGIN
  3555.                      CALLDISP BRANCH=YES;  % GO TO MVS DISPATCHER
  3556.                      &&LABEL: SYSLBL;
  3557.                      END;
  3558.                   END;
  3559.                MODESET KEYADDR=(2);  % RESTORE KEY
  3560.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3561.                END;
  3562.             ASM EXIT;
  3563.             END;
  3564.          ASM IF ('&SUPMODE(1)' EQ 'YES') THEN BEGIN
  3565.             &&L: SYSLBL;
  3566.             DO BEGIN
  3567.                ASM IF (N'&&SUPMODE GT 1) THEN BEGIN
  3568.                   ASM IF ('&LABEL' NE '') THEN BEGIN
  3569.                      MNOTE 12,'LABEL INVALID WITH CONDITIONAL SUPMODE';
  3570.                      END;
  3571.                   SYSPRED NSUP&&@,IF=(&&SUPMODE(2),&&SUPMODE(3),_
  3572.                   &&SUPMODE(4),&&SUPMODE(5)),BRANCH=FALSE;
  3573.                   WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3574.                   EXIT;
  3575.                   NSUP&&@: ;
  3576.                   END;
  3577.                SYSLR &®,(XRA);  % SAVE REGISTER 2
  3578.                SYSCMP XRA,EQ,2;
  3579.                MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=2;  % KEY ZERO
  3580.                SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3581.                L VRF,CVTPTR;  % GET ADDRESS OF CVT
  3582.                L VR1,CVTTCBP-CVT(,VRF); L VR1,0(,VR1);  % GET TCB ADDR
  3583.                STM VR0,VRF,TCBGRS-TCB(VR1);  % SAVE REGS IN TCB
  3584.                L VR1,TCBRBP-TCB(,VR1);  % GET RB ADDRESS
  3585.                LA VR0,WAIT&&@; ST VR0,RBOPSW+4-RB(,VR1); %RESUME ADDR
  3586.                SYSLR VR0,&&COUNT,NULL=1;  % WAIT COUNT
  3587.                ASM IF ('&ECBLIST' EQ '')
  3588.                THEN SYSLR VR1,&&ECB,ERR='ECB OR ECBLIST REQUIRED'  % ECB
  3589.                ELSE SYSLR VR1,&&ECB&&ECBLIST,TYPE=LCR;  % ECBLIST ADDR
  3590.                L VRF,CVTVWAIT-CVT(,VRF);  % ADDR OF WAIT ROUTINE
  3591.                RGOTO VRF;  % GO TO WAIT ROUTINE
  3592.                &&LABEL: SYSLBL;
  3593.                WAIT&&@:  % RESUME ADDRESS
  3594.                MODESET KEYADDR=(2);  % RESTORE KEY
  3595.                SYSLR XRA,(&®);  % RESTORE REGISTER 2
  3596.                END;
  3597.             ASM EXIT;
  3598.             END;
  3599.          END;
  3600.       ENDCASE
  3601.    ELSE MNOTE 4,'FASTWAIT UNDEFINED FOR &OS, NORMAL WAIT USED'
  3602.    THEN BEGIN
  3603.       &&L:
  3604.       WAIT &&COUNT,ECB=&&ECB,ECBLIST=&&ECBLIST;
  3605.       &&LABEL: SYSLBL;
  3606.       END;
  3607.    MEND;
  3608. BAL;
  3609. ./       ADD   LIST=ALL,NAME=FLAGSEG
  3610. ALP;
  3611.  
  3612. MACRO &&L: FLAGSEG &®=,&&VAREA=,&&ACCT=,&&INIT=,&&LABEL=;
  3613.    GBLA &&LACCT,&&LINIT;
  3614.    GBLC &&SITE,&&INITNAM,&&ACCTNAM;
  3615.  
  3616.    &&L: SYSLBL;
  3617.    ASM CASE '&SITE';
  3618.       'NIH': BEGIN
  3619.          CASE &® MAX 12;
  3620.             0: BEGIN
  3621.                FLAGSEG2 &&VAREA,&&LABEL;
  3622.                FLAGSEG1 &&VAREA,'PLEASE CONTACT THE PAL UNIT '_
  3623.                'AS SOON AS POSSIBLE DURING REGULAR HOURS';
  3624.                END;
  3625.             4: BEGIN
  3626.                FLAGSEG2 &&VAREA,&&LABEL;
  3627.                FLAGSEG1 &&VAREA,'FOR AN IMPORTANT MESSAGE REGARDING '_
  3628.                '&INITNAM ';
  3629.                FLAGSEG1 &&VAREA,&&INIT,&&LINIT,DEBLANK=YES;
  3630.                END;
  3631.             8: BEGIN
  3632.                FLAGSEG2 &&VAREA,&&LABEL;
  3633.                FLAGSEG1 &&VAREA,'TELEPHONE (301) 496-5525 '_
  3634.                'OR SUBMIT A "CRITICAL" PTR USING THE PTR COMMAND,'_
  3635.                ' GIVING A PHONE NUMBER WHERE YOU CAN BE REACHED';
  3636.                END;
  3637.             12: BEGIN
  3638.                LTR &®,&®  % SET NON-ZERO CC
  3639.                EXIT;  % DO NOT BUMP REGISTER
  3640.                END;
  3641.             ENDCASE
  3642.          THEN BEGIN
  3643.             AI &®,4;  % BUMP TO NEXT CASE
  3644.             CR &®,&®  % SET ZERO CC
  3645.             END;
  3646.          END;
  3647.       ENDCASE
  3648.    ELSE BEGIN
  3649.       CLI *,0;  % SET NON-ZERO CC
  3650.       END;
  3651.    MEND;
  3652. BAL;
  3653. ./       ADD   LIST=ALL,NAME=FLAGSEG1
  3654. ALP;
  3655.  
  3656. MACRO &&L: FLAGSEG1 &&VA,&&LOC,&&LEN,&&DEBLANK=;
  3657.    &&L: SYSLBL;
  3658.    ASM IF ('&VA' EQ '') THEN TSEG &&LOC,&&LEN,DEBLANK=&&DEBLANK
  3659.    ELSE VSEG &&VA,&&LOC,&&LEN,DEBLANK=&&DEBLANK;
  3660.    MEND;
  3661. BAL;
  3662. ./       ADD   LIST=ALL,NAME=FLAGSEG2
  3663. ALP;
  3664.  
  3665. MACRO &&L: FLAGSEG2 &&VAREA,&&LABEL;
  3666.    &&L: SYSLBL;
  3667.    ASM IF ('&LABEL' EQ '') THEN MEXIT;
  3668.    ASM CASE '&LABEL(1)';
  3669.       '': FLAGSEG1 &&VAREA,&&LABEL(2),&&LABEL(3);
  3670.       'MMSGINIT': MMSGINIT &&LABEL(2);
  3671.       'WMSGINIT': WMSGINIT &&LABEL(2);
  3672.       ENDCASE
  3673.    ELSE BEGIN
  3674.       BAL;
  3675.  &LABEL(1) &LABEL(2),&LABEL(3)
  3676.       ALP;
  3677.       END;
  3678.    MEND;
  3679. BAL;
  3680. ./       ADD   LIST=ALL,NAME=FREESWAM
  3681. ALP;
  3682.  
  3683. MACRO &&L: FREESWAM &&TCB=,&&ASCB=,&&SAVEXRA=,&&SAVEXRB=,_
  3684. &&SAVEXRC=,&&SAVER7=,&&R7=;
  3685.    GBLC &&OS;
  3686.  
  3687.    ASM CASE '&OS';
  3688.       'MVS','XA': BEGIN
  3689.          &&L:
  3690.          L VRF,&&TCB;  % ADDRESS OF TCB
  3691.          L VR1,TCBSWASA-TCB(VRF);  % GET ADDR OF SWA MGR SAVE AREA
  3692.          IF <RNZ VR1> & ^<C VRF,TCBJSTCB-TCB(VRF)> THEN BEGIN
  3693.             SYSLR &&SAVEXRA,(XRA);  % SAVE REGISTER 2
  3694.             SYSCMP XRA,EQ,2;
  3695.             MODESET EXTKEY=ZERO,SAVEKEY=(2),WORKREG=(2);  % KEY 0
  3696.             SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND,REGS=USE,RELATED=*;
  3697.             SYSLR &&SAVEXRB,(XRB);  % SAVE REGISTERS USED BY FREEMAIN
  3698.             SYSLR &&SAVEXRC,(XRC);
  3699.             SYSLR &&SAVER7,(&&R7);
  3700.             L &&R7,&&ASCB;  % ASCB ADDRESS FOR FREEMAIN
  3701.             SYSCMP &&R7,EQ,7;
  3702.             SYSCMP &&R7,NE,BASER;
  3703.             L XRC,&&TCB;  % TCB ADDRESS FOR FREEMAIN
  3704.             SYSCMP XRC,EQ,4;
  3705.             L VR1,TCBSWASA-TCB(XRC);  % AREA TO FREE
  3706.             Z VR0,TCBSWASA-TCB(XRC);  % CLEAR POINTER IN TCB
  3707.             L VRF,0(,VR1);  % LENGTH AND SUBPOOL TO FREE
  3708.             ZR VRE; SLDL VRE,8; SRL VRF,8;  % SPLIT SUBPOOL AND LENGTH
  3709.             FREEMAIN RU,A=(1),LV=(VRF),SP=(VRE),KEY=1,BRANCH=YES;
  3710.             SYSCMP XRB,EQ,3;
  3711.             SYSLR XRB,(&&SAVEXRB);
  3712.             SYSLR XRC,(&&SAVEXRC);
  3713.             SYSLR &&R7,(&&SAVER7);
  3714.             SETLOCK RELEASE,TYPE=LOCAL,REGS=USE,RELATED=*;
  3715.             MODESET KEYREG=XRA;  % RESTORE KEY
  3716.             SYSLR XRA,(&&SAVEXRA);  % RESTORE REGISTER 2
  3717.             END;
  3718.          END;
  3719.       ENDCASE
  3720.    ELSE <&&L: SYSLBL>;
  3721.    MEND;
  3722. BAL;
  3723. ./       ADD   LIST=ALL,NAME=GBLSET
  3724. ALP;
  3725.  
  3726. MACRO &&L: GBLSET;
  3727.    GBLC &&CPU,&&MP,&&OS;
  3728.    LCLA &&X;
  3729.  
  3730.    &&L: SYSLBL;
  3731.  
  3732.    ASM FOR &&X FROM 1 TO N'&&SYSLIST DO BEGIN
  3733.       ASM CASE '&SYSLIST(&X,1)';
  3734.          'CPU': BEGIN
  3735.             &&CPU: SETC '&SYSLIST(&X,2)';
  3736.             SYSKWT &&&&CPU,&&CPU,(360,370),COND=NO,NULL=NO;
  3737.             END;
  3738.          'MP': BEGIN
  3739.             &&MP: SETC '&SYSLIST(&X,2)';
  3740.             SYSKWT &&&&MP,&&MP,(YES,NO),COND=NO,NULL=NO;
  3741.             END;
  3742.          'OS': BEGIN
  3743.             &&OS: SETC '&SYSLIST(&X,2)';
  3744.             SYSKWT &&&&OS,&&OS,(MFT,MVT,VS1,SVS,MVS,XA),_
  3745.             COND=NO,NULL=NO;
  3746.             END;
  3747.          ENDCASE
  3748.       ELSE MNOTE 12,'"&SYSLIST(&X,1)" IS ILLEGAL';
  3749.       END;
  3750.  
  3751.    MEND;
  3752. BAL;
  3753. ./       ADD   LIST=ALL,NAME=IPRIVSCN
  3754. ALP;
  3755.  
  3756. MACRO &&L: IPRIVSCN &&BYTE,&&TYPE=;
  3757.    LCLC &&LBL;
  3758.    &&LBL: SETC 'ISCN&SYSNDX';
  3759.  
  3760.    SYSKWT TYPE,&&TYPE,(NO),COND=NO;
  3761.  
  3762.    &&L: SYSLBL;
  3763.    BEGIN SCAN *;
  3764.       SCKW &&TYPE.SYSTEMS,&&LBL,CODE=AL1(KWRIFSPR);
  3765.       SCKW &&TYPE.ACCOUNTING,&&LBL,CODE=AL1(KWRIFAPR);
  3766.       SCKW &&TYPE.OPERATOR,&&LBL,CODE=AL1(KWRIFOPR);
  3767.       SCKW &&TYPE.BASIC,&&LBL,CODE=AL1(KWRIFBPR);
  3768.       SCKW &&TYPE.UNDER,&&LBL,CODE=AL1(KWRIFUPR);
  3769.       SCKW &&TYPE.PROJECT,&&LBL,CODE=AL1(KWRIFPRJ);
  3770.       SCKW &&TYPE.FLAG,&&LBL,CODE=AL1(KWRIFFLG);
  3771.       SCKW ,*,B;
  3772.  
  3773.       &&LBL:
  3774.       ASM IF ('&TYPE' EQ 'NO')
  3775.       THEN <X VRE,=XL4'FF'; EXI VRE,NI,&&BYTE,0>
  3776.       ELSE EXI VRE,OI,&&BYTE,0;
  3777.       SCANEND; END;
  3778.    MEND;
  3779. BAL;
  3780. ./       ADD   LIST=ALL,NAME=IPRIVSEG
  3781. ALP;
  3782.  
  3783. MACRO &&L: IPRIVSEG &&BYTE,&&BEFORE=,&&AFTER=,&&VAREA=;
  3784.  
  3785.    &&L: SYSLBL;
  3786.    SELECT;
  3787.       <TM &&BYTE,KWRIFSPR>: BEGIN
  3788.          IPRIVSG1 'SYSTEMS',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3789.          END;
  3790.       <TM &&BYTE,KWRIFAPR>: BEGIN
  3791.       IPRIVSG1 'ACCOUNTING',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3792.          END;
  3793.       <TM &&BYTE,KWRIFOPR>: BEGIN
  3794.         IPRIVSG1 'OPERATOR',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3795.          END;
  3796.       <TM &&BYTE,KWRIFBPR>: BEGIN
  3797.          IPRIVSG1 'BASIC',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3798.          END;
  3799.       <TM &&BYTE,KWRIFUPR>: BEGIN
  3800.          IPRIVSG1 'UNDER',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3801.          END;
  3802.       <TM &&BYTE,KWRIFPRJ>: BEGIN
  3803.          IPRIVSG1 'PROJECT',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3804.          END;
  3805.       <TM &&BYTE,KWRIFFLG>: BEGIN
  3806.          IPRIVSG1 'FLAG',AFTER=&&AFTER,BEFORE=&&BEFORE,VAREA=&&VAREA;
  3807.          END;
  3808.       ENDSEL;
  3809.    MEND;
  3810. BAL;
  3811. ./       ADD   LIST=ALL,NAME=IPRIVSG1
  3812. ALP;
  3813.  
  3814. MACRO &&L: IPRIVSG1 &&STRING,&&BEFORE=,&&AFTER=,&&VAREA=;
  3815.    &&L: SYSLBL;
  3816.    ASM IF ('&BEFORE' NE '')
  3817.    THEN IPRIVSG2 &&VAREA,&&BEFORE(1),&&BEFORE(2);
  3818.    IPRIVSG2 &&VAREA,&&STRING(1),&&STRING(2);
  3819.    ASM IF ('&AFTER' NE '')
  3820.    THEN IPRIVSG2 &&VAREA,&&AFTER(1),&&AFTER(2);
  3821.    MEND;
  3822. BAL;
  3823. ./       ADD   LIST=ALL,NAME=IPRIVSG2
  3824. ALP;
  3825.  
  3826. MACRO &&L: IPRIVSG2 &&VAREA,&&A,&&N;
  3827.    &&L: SYSLBL;
  3828.    ASM IF ('&VAREA' EQ '')
  3829.    THEN TSEG &&A,&&N
  3830.    ELSE VSEG &&VAREA,&&A,&&N;
  3831.    MEND;
  3832. BAL;
  3833. ./       ADD   LIST=ALL,NAME=KWR2
  3834.          MACRO
  3835.          KWR2
  3836.          GBLA  &LINIT,&LACCT,&LKW
  3837. *
  3838. *  NIH/COMMON - KEYWORD RECORD
  3839. *
  3840. *
  3841. *    OPERATION CODES
  3842. *
  3843. KWRCWR   EQU   X'80'                   WRITE
  3844. KWRCRD   EQU   X'40'                   READ
  3845. KWRCRDNA EQU   X'20'                   READ NEXT ACCOUNT
  3846. KWRCRDNI EQU   X'10'                   READ NEXT INITIALS
  3847. KWRCALL  EQU   X'08'                   READ WHOLE LRECD
  3848. KWRCLONG EQU   X'04'                   8-BYTE KW, 4-BYTE INITIALS
  3849. KWRC31   EQU   X'02'                   PARM LIST FOR 31 BIT MODE
  3850. KWRCXTND EQU   X'01'                   EXTENDED AREAS USED
  3851. *
  3852. *
  3853. KWRSTART DS    0F
  3854. KWRACCT  DCC   CL&LACCT'AAAA',LENGTH=&LACCT  ACCOUNT NO.
  3855. KWRINIT  DCC   CL&LINIT'ABC',LENGTH=&LINIT  INITIALS
  3856. KWRKW    DCC   CL&LKW'XXX',LENGTH=&LKW  KEYWORD
  3857. KWRHFL   DC    X'00'                   HASP STATUS FLAGS
  3858. *
  3859. KWRHFCK  EQU   X'80'                   KEYWORD CHECKING IN EFFECT
  3860. KWRHFUOK EQU   X'40'                   UPDATE SUCCESSFUL
  3861. KWRHFROK EQU   X'40'                   READ SUCCESSFUL
  3862. KWRHFREJ EQU   X'20'                   REQUEST REJECTED (INVALID)
  3863. KWRHFIVI EQU   X'10'                   INVALID INITIALS
  3864. KWRHFIVA EQU   X'08'                   INVALID ACCOUNT
  3865. *
  3866. KWRIFL   DC    AL1(KWRIFVAL)           INITIALS FLAGS
  3867. *
  3868. KWRIFVAL EQU   X'80'                   VALID
  3869. KWRIFSPR EQU   X'40'                   SYSTEM PRIVILIGE
  3870. KWRIFAPR EQU   X'20'                   ACCOUNT PRIVILIGE
  3871. KWRIFOPR EQU   X'10'                   OPERATOR PRIVILIGE
  3872. KWRIFUPR EQU   X'08'                   UNDERPRIVILIGED
  3873. KWRIFPRJ EQU   X'04'                   PROJECT
  3874. KWRIFBPR EQU   X'02'                   BASIC PRIVILEGE
  3875. KWRIFFLG EQU   X'01'                   CONTACT USER SERVICES FLAG
  3876. KWRIFRSV EQU   X'00'                   RESERVED BITS
  3877. *
  3878. KWRAFL   DC    AL1(KWRAFVAL)           ACCOUNT FLAGS
  3879. *
  3880. KWRAFVAL EQU   X'80'                   VALID
  3881. KWRAFFLG EQU   X'40'                   CONTACT USER SERVICES (OBSOLETE)
  3882. KWRAFCIB EQU   X'20'                   CHECK KW IN BATCH  (OBSOLETE)
  3883. KWRAFMB  EQU   X'10'                   MAIL BOX ACCOUNT
  3884. KWRAFMP  EQU   X'08'                   MAIL PENDING
  3885. KWRAFPRO EQU   X'04'                   WYLBUR PROFILE EXISTS
  3886. KWRAFRCM EQU   X'02'                   WYLBUR RECOVERY - MILTEN
  3887. KWRAFRCT EQU   X'01'                   WYLBUR RECOVERY - TSO
  3888. KWRAFRSV EQU   X'00'+KWRAFCIB+KWRAFFLG RESERVED BITS
  3889. *
  3890. KWRPTR   DS    0AL3                    OLD NAME
  3891. KWRRSV   DC    X'000000'               FOR FUTURE USE
  3892.          DS    0F
  3893. KWRSIZE  EQU   *-KWRSTART
  3894. *
  3895. *        EXTENDED AREA
  3896. *
  3897. KWRIEXT  DS    XL24'00'                FOR FUTURE USE
  3898. KWRAEXT  DS    XL9'00'                 FOR FUTURE USE
  3899. KWREKW   DC    CL8' '                  LONG KW
  3900. KWREINIT DC    CL4' '                  LONG INITIALS
  3901. KWRESIZE EQU   *-KWRSTART
  3902.          MEND
  3903. ./       ADD   LIST=ALL,NAME=LI
  3904.          MACRO
  3905. &L       LI    &R,&V
  3906.          LCLA  &X
  3907. .*
  3908. .LOOP    ANOP
  3909. &X       SETA  &X+1
  3910.          AIF   (&X GT K'&V).INT
  3911.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  3912. .*
  3913. .LA      ANOP
  3914. &L       LA    &R,&V
  3915.          MEXIT
  3916. .*
  3917. .INT     ANOP
  3918.          AIF   (&V LT 4096).LA
  3919. &L       L     &R,=F'&V'
  3920.          MEND
  3921. ./       ADD   LIST=ALL,NAME=LQS
  3922.          MACRO
  3923. &L       LQS   &R,&S,&QS,&N
  3924. &L       SYSQS &R,&S,&QS,&N
  3925.          MEND
  3926. ./       ADD   LIST=ALL,NAME=LOADB
  3927.          MACRO
  3928. &L       LOADB &R,&A,&JUNK=
  3929.          SYSKWT JUNK,&JUNK,(OK,YES)
  3930.          AIF   ('&JUNK' NE '').JUNK
  3931. &L       SLR   &R,&R
  3932.          IC    &R,&A
  3933.          MEXIT
  3934. .JUNK    ANOP
  3935. &L       IC    &R,&A
  3936.          MEND
  3937. ./       ADD   LIST=ALL,NAME=LOADF
  3938.          MACRO
  3939. &L       LOADF &R,&A,&JUNK=
  3940.          GBLC  &CPU,&SIM370
  3941.          SYSKWT JUNK,&JUNK,(OK,YES)
  3942.          AIF   ('&CPU' EQ '360').S360
  3943. &L       UAOP  L,&R,&A
  3944.          MEXIT
  3945. .S360    ANOP
  3946. &L       MMVC  &SIM370,&A,4
  3947.          L     &R,&SIM370
  3948.          MEND
  3949. ./       ADD   LIST=ALL,NAME=LOADH
  3950.          MACRO
  3951. &L       LOADH &R,&A,&JUNK=
  3952.          GBLC  &CPU,&SIM370
  3953.          SYSKWT JUNK,&JUNK,(OK,YES)
  3954.          AIF   ('&CPU' EQ '360').S360
  3955. &L       UAOP  LH,&R,&A
  3956.          MEXIT
  3957. .S360    ANOP
  3958. &L       MMVC  &SIM370,&A,2
  3959.          LH    &R,&SIM370
  3960.          MEND
  3961. ./       ADD   LIST=ALL,NAME=LOADLF
  3962.          MACRO
  3963. &L       LOADLF &R,&A,&JUNK=
  3964. &L       LOADF &R,&A,JUNK=&JUNK
  3965.          MEND
  3966. ./       ADD   LIST=ALL,NAME=LOADLH
  3967.          MACRO
  3968. &L       LOADLH &R,&A,&JUNK=
  3969.          GBLC  &CPU,&SIM370
  3970.          SYSKWT JUNK,&JUNK,(OK,YES)
  3971.          AIF   ('&CPU' EQ '360').S360
  3972.          AIF   ('&JUNK' NE '').J370
  3973. &L       SLR   &R,&R
  3974.          ICM   &R,3,&A
  3975.          MEXIT
  3976. .J370    ANOP
  3977. &L       ICM   &R,3,&A
  3978.          MEXIT
  3979. .S360    ANOP
  3980. &L       MMVC  4*2+2+&SIM370,&A,2
  3981.          L     &R,4*2+&SIM370
  3982.          MEND
  3983. ./       ADD   LIST=ALL,NAME=LOADP
  3984.          MACRO
  3985. &L       LOADP &R,&A,&JUNK=
  3986.          GBLC  &CPU,&SIM370
  3987.          SYSKWT JUNK,&JUNK,(OK,YES)
  3988.          AIF   ('&CPU' EQ '360').S360
  3989.          AIF   ('&JUNK' NE '').J370
  3990. &L       SLR   &R,&R
  3991.          ICM   &R,7,&A
  3992.          MEXIT
  3993. .J370    ANOP
  3994. &L       ICM   &R,7,&A
  3995.          MEXIT
  3996. .S360    ANOP
  3997. &L       MMVC  4*1+1+&SIM370,&A,3
  3998.          L     &R,4*1+&SIM370
  3999.          MEND
  4000. ./       ADD   LIST=ALL,NAME=LT
  4001.          MACRO
  4002. &L       LT    &R,&A
  4003. &L       L     &R,&A
  4004.          LTR   &R,&R
  4005.          MEND
  4006. ./       ADD   LIST=ALL,NAME=MCCW
  4007.          MACRO
  4008. &L       MCCW  &OP,&A,&F,&N,&CODE=0
  4009. &L       CCW   &OP,&A,&F,&N
  4010.          AIF   ('&CODE' EQ '' OR '&CODE' EQ '0').END
  4011.          ORG   *-3
  4012.          DC    AL1(&CODE)
  4013.          ORG   *+2
  4014. .END     MEND
  4015. ./       ADD   LIST=ALL,NAME=MCLC
  4016.          MACRO
  4017. &L       MCLC  &A,&B,&C,&N=*,&ZERO=
  4018.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4019.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4020. &L       SYSXXC CLC,&A,&B,&C,N=&N,BC=BNE
  4021.          MEXIT
  4022. .*
  4023. .NULL    ANOP
  4024. &L       CLI   *+1,0
  4025.          MEND
  4026. ./       ADD   LIST=ALL,NAME=MCLCL
  4027.          MACRO
  4028. &L       MCLCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4029.          GBLC  &CPU
  4030.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4031.          AIF   ('&CPU' EQ '360').S360
  4032. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4033.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4034.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4035.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
  4036.          AIF   ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
  4037.          SYSLR &RB+1,&LB
  4038.          AIF   ('&FILADDR' NE '').FILADDR
  4039.          AIF   ('&FILL' EQ '0').Z370
  4040.          O     &RB+1,=AL1(&FILL,0,0,0)
  4041.          AGO   .Z370
  4042. .*
  4043. .FILADDR ANOP
  4044.          ICM   &RB+1,8,&FILADDR
  4045. .Z370    CLCL  &RA,&RB
  4046.          MEXIT
  4047. .EQ370   ANOP
  4048.          LR    &RB+1,&RA+1
  4049.          CLCL  &RA,&RB
  4050.          MEXIT
  4051. .*
  4052. .*  360 LOOP
  4053. .*
  4054. .S360    ANOP
  4055.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
  4056. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4057.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4058.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4059.          SYSLR &RB+1,&LB
  4060. &L       SR    &RA+1,&RB+1
  4061.          BNM   *+8
  4062.          AR    &RB+1,&RA+1
  4063.          SLR   &RA+1,&RA+1
  4064.          AIF  ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').NE360AZ
  4065.          AIF  ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').NE360BZ
  4066.          LTR   &RB+1,&RB+1
  4067.          BNP   CLC&SYSNDX.A
  4068.          MCLCLC &RA,&RB,&RB+1,CLC&SYSNDX.B
  4069.          LA    &RA,1(&RA,&RB+1)
  4070. CLC&SYSNDX.A LTR &RA+1,&RA+1
  4071.          BNP   CLC&SYSNDX.B
  4072.          MCLCLF &RA,&RA+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4073. CLC&SYSNDX.B DS 0H
  4074.          MEXIT
  4075. .*
  4076. .NE360AZ ANOP
  4077.          XR    &RA,&RA+1
  4078.          XR    &RA+1,&RA
  4079.          XR    &RA,&RA+1
  4080.          LTR   &RB+1,&RB+1
  4081.          BNP   CLC&SYSNDX.A
  4082.          MCLCLC &RA+1,&RB,&RB+1,CLC&SYSNDX.B
  4083.          LA    &RA+1,1(&RA+1,&RB+1)
  4084. CLC&SYSNDX.A LTR &RB+1,&RA
  4085.          BNP   CLC&SYSNDX.B
  4086.          MCLCLF &RA+1,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4087. CLC&SYSNDX.B DS 0H
  4088.          MEXIT
  4089. .*
  4090. .NE360BZ ANOP
  4091.          XR    &RB,&RA+1
  4092.          XR    &RA+1,&RB
  4093.          XR    &RB,&RA+1
  4094.          LTR   &RB+1,&RB+1
  4095.          BNP   CLC&SYSNDX.A
  4096.          MCLCLC &RA,&RA+1,&RB+1,CLC&SYSNDX.B
  4097.          LA    &RA,1(&RA,&RB+1)
  4098. CLC&SYSNDX.A LTR &RB+1,&RB
  4099.          BNP   CLC&SYSNDX.B
  4100.          MCLCLF &RA,&RB+1,CLC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4101. CLC&SYSNDX.B DS 0H
  4102.          MEXIT
  4103. .*
  4104. .*  360 EQUAL LENGTH
  4105. .*
  4106. .EQ360   ANOP
  4107.          AIF   ('&INLINE' EQ 'YES').INLINE
  4108.          AIF  ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQ360AZ
  4109.          AIF  ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQ360BZ
  4110. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4111.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4112.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4113.          BNP   CLC&SYSNDX.A
  4114.          MCLCLC &RA,&RB,&RA+1,CLC&SYSNDX.A
  4115. CLC&SYSNDX.A DS 0H
  4116.          MEXIT
  4117. .*
  4118. .EQ360AZ ANOP
  4119. &L       SYSLR &RB+1,&AA
  4120.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4121.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4122.          BNP   CLC&SYSNDX.A
  4123.          MCLCLC &RB+1,&RB,&RA+1,CLC&SYSNDX.A
  4124. CLC&SYSNDX.A DS 0H
  4125.          MEXIT
  4126. .*
  4127. .EQ360BZ ANOP
  4128. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4129.          SYSLR &RB+1,&AB
  4130.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4131.          BNP   CLC&SYSNDX.A
  4132.          MCLCLC &RA,&RB+1,&RA+1,CLC&SYSNDX.A
  4133. CLC&SYSNDX.A DS 0H
  4134.          MEXIT
  4135. .*
  4136. .*  INLINE
  4137. .*
  4138. .INLINE  ANOP
  4139. &L       MCLC  &AA,&AB,&LA,N=&N
  4140.          MEND
  4141. ./       ADD   LIST=ALL,NAME=MCLCLC
  4142.          MACRO
  4143. &L       MCLCLC &A,&B,&C,&LEND
  4144.          LCLC  &LBL
  4145. .*
  4146. &LBL     SETC  '&L'
  4147.          AIF   ('&L' NE '').OKLBL
  4148. &LBL     SETC  'CLC&SYSNDX.X'
  4149. .OKLBL   ANOP
  4150. .*
  4151. &LBL     C     &C,=F'256'
  4152.          BNH   CLC&SYSNDX.Z
  4153.          CLC   0(256,&A),0(&B)
  4154.          BNE   &LEND
  4155.          LA    &A,256(,&A)
  4156.          LA    &B,256(,&B)
  4157.          S     &C,=F'256'
  4158.          B     &LBL
  4159. CLC&SYSNDX.Y CLC 0(0,&A),0(&B)
  4160. CLC&SYSNDX.Z BCTR &C,0
  4161.          EX    &C,CLC&SYSNDX.Y
  4162.          MEND
  4163. ./       ADD   LIST=ALL,NAME=MCLCLF
  4164.          MACRO
  4165. &L       MCLCLF &A,&C,&LEND,&FILL=0,&FILADDR=
  4166. .*
  4167.          AIF   ('&FILADDR' EQ '').FILL
  4168. &L       CLC   0(1,&A),&FILADDR
  4169.          AGO   .BNE
  4170. .*
  4171. .FILL    ANOP
  4172. &L       CLI   0(&A),&FILL
  4173. .BNE     BNE   &LEND
  4174.          BCTR  &C,0
  4175.          LTR   &C,&C
  4176.          BNP   &LEND
  4177. CLC&SYSNDX.P C &C,=F'256'
  4178.          BNH   CLC&SYSNDX.R
  4179.          CLC   1(256,&A),0(&A)
  4180.          BNE   &LEND
  4181.          LA    &A,256(,&A)
  4182.          S     &C,=F'256'
  4183.          B     CLC&SYSNDX.P
  4184. CLC&SYSNDX.Q CLC 1(0,&A),0(&A)
  4185. CLC&SYSNDX.R BCTR &C,0
  4186.          EX    &C,CLC&SYSNDX.Q
  4187.          MEND
  4188. ./       ADD   LIST=ALL,NAME=MDC
  4189.          MACRO
  4190.          MDC
  4191. *
  4192. *  MACHINE DEPENDENT CELLS
  4193. *
  4194. EXOLDPSW EQU   24                      EXTERNAL OLD PSW
  4195. SVOLDPSW EQU   32                      SVC OLD PSW
  4196. PIOLDPSW EQU   40                      PROGRAM OLD PSW
  4197. MKOLDPSW EQU   48                      MACHINE CHECK OLD PSW
  4198. IOOLDPSW EQU   56                      I/O OLD PSW
  4199. CSW      EQU   64                      CHANNEL STATUS WORD
  4200. CSWKEY   EQU   64                      PROTECT KEY PORTION
  4201. CSWADDR  EQU   65                      ADDRESS PORTION OF CSW
  4202. CSWSTAT  EQU   68                      STATUS BYTES
  4203. *
  4204. CSWSATTN EQU   X'80'                   ATTENTION
  4205. CSWSSM   EQU   X'40'                   STATUS MODIFIER
  4206. CSWSCUE  EQU   X'20'                   CONTROL UNIT END
  4207. CSWSBUSY EQU   X'10'                   CONTROL UNIT BUSY
  4208. CSWSCE   EQU   X'08'                   CHANNEL END
  4209. CSWSDE   EQU   X'04'                   DEVICE END
  4210. CSWSUC   EQU   X'02'                   UNIT CHECK
  4211. CSWSUE   EQU   X'01'                   UNIT EXCEPTION
  4212. *
  4213. CSWSTAT2 EQU   69                      2ND STATUS BYTE
  4214. *
  4215. CSWSPCI  EQU   X'80'                   PCI
  4216. CSWSIL   EQU   X'40'                   INCORRECT LENGTH
  4217. CSWSPC   EQU   X'20'                   PROGRAM CHECK
  4218. CSWSSPC  EQU   X'10'                   STORAGE PROTECTION CHECK
  4219. CSWSCDC  EQU   X'08'                   CHANNEL DATA CHECK
  4220. CSWSCCC  EQU   X'04'                   CHANNEL CONTROL CHECK
  4221. CSWSICC  EQU   X'02'                   INTERFACE CONTROL CHECK
  4222. CSWSCC   EQU   X'01'                   CHAINING CHECK
  4223. *
  4224. CSWLEN   EQU   70                      UNUSED LENGTH
  4225. CAW      EQU   72                      CHANNEL ADDRESS WORD
  4226. INTTIMER EQU   80                      INTERVAL TIMER
  4227. EXNEWPSW EQU   88                      EXTERNAL NEW PSW
  4228. SVNEWPSW EQU   96                      SVC NEW PSW
  4229. PINEWPSW EQU   104                     PROGRAM NEW PSW
  4230. MKNEWPSW EQU   112                     MACHINE CHECK NEW PSW
  4231. IONEWPSW EQU   120                     I/O NEW PSW
  4232. DSCANA   EQU   128                     DIAGNOSTIC SCAN-OUT AREA
  4233. *
  4234. *  CCW DEFINITIONS
  4235. *
  4236. CCWCC    EQU   0                       COMMAND CODE
  4237. *
  4238. CCWCNOP  EQU   X'03'                   NO OPERATION
  4239. CCWCTIC  EQU   X'08'                   TRANSFER IN CHANNEL
  4240. CCWCSNS  EQU   X'04'                   SENSE
  4241. *
  4242. CCWADDR  EQU   1                       ADDRESS
  4243. CCWFL    EQU   4                       FLAGS
  4244. *
  4245. CCWFDCH  EQU   X'80'                   DATA CHAINING BIT
  4246. CCWFCCH  EQU   X'40'                   COMMAND CHAINING BIT
  4247. CCWFSLI  EQU   X'20'                   SUPPRESS INCORRECT LENGTH BIT
  4248. CCWFSKIP EQU   X'10'                   SUPPRESS DATA TRANSFER BIT
  4249. CCWFPCI  EQU   X'08'                   PROGRAM CONTROLLED INTERRUPT
  4250. CCWFIDA  EQU   X'04'                   INDIRECT DATA ADDRESS
  4251. *
  4252. CCWLEN   EQU   6                       LENGTH
  4253. *
  4254. *  SENSE BYTES
  4255. *
  4256. SNSBYTE1 EQU   0                       SENSE BYTE 1
  4257. *
  4258. SNSBCR   EQU   X'80'                   COMMAND REJECT
  4259. SNSBIR   EQU   X'40'                   INTERVENTION REQUIRED
  4260. SNSBBOPC EQU   X'20'                   BUS OUT PARITY CHECK
  4261. SNSBEC   EQU   X'10'                   EQUIPMENT CHECK
  4262. SNSBDC   EQU   X'08'                   DATA CHECK
  4263. SNSBOR   EQU   X'04'                   OVERRUN
  4264. SNSBLD   EQU   X'02'                   LOST DATA
  4265. SNSBTO   EQU   X'01'                   TIMEOUT
  4266. *
  4267. *  EBCDIC CONTROL CHARACTERS
  4268. *
  4269. EBCNUL   EQU   X'00'           ASCII   NULL
  4270. EBCSOH   EQU   X'01'           ASCII   SOH
  4271. EBCSTX   EQU   X'02'           ASCII   STX
  4272. EBCETX   EQU   X'03'           ASCII   ETX
  4273. EBCEDI   EQU   X'04'  (1)      MILTEN  END DIM INTENSITY
  4274. EBCPF    EQU   X'04'  (2)      IBM     PUNCH OFF
  4275. EBCHT    EQU   X'05'           ASCII   HORIZONTAL TAB
  4276. EBCEBC   EQU   X'06'  (1)      MILTEN  END BOLD CHARACTERS
  4277. EBCLC    EQU   X'06'  (2)      IBM     LOWER CASE
  4278. EBCDEL   EQU   X'07'           ASCII   DELETE
  4279. EBCGE    EQU   X'08'           IBM     GRAPHIC ESCAPE
  4280. EBCRLF   EQU   X'09'           IBM     REVERSE LINE FEED
  4281. EBCSTOP  EQU   X'0A'  (1)      MILTEN  STOP CODE
  4282. EBCSMM   EQU   X'0A'  (2)      IBM     START OF MANUAL MESSAGE
  4283. EBCVT    EQU   X'0B'           ASCII   VERTICAL TAB
  4284. EBCFF    EQU   X'0C'           ASCII   FORM FEED
  4285. EBCCR    EQU   X'0D'           ASCII   CARRIAGE RETURN
  4286. EBCSO    EQU   X'0E'           ASCII   SHIFT OUT
  4287. EBCSI    EQU   X'0F'           ASCII   SHIFT IN
  4288. EBCDLE   EQU   X'10'           ASCII   DATA LINK ESCAPE
  4289. EBCDC1   EQU   X'11'           ASCII   DEVICE CONTROL 1
  4290. EBCDC2   EQU   X'12'           ASCII   DEVICE CONTROL 2
  4291. EBCSVF   EQU   X'13'  (1)      MILTEN  START OF VARIABLE FIELD
  4292. EBCTM    EQU   X'13'  (2)      IBM     TAPE MARK
  4293. EBCEVF   EQU   X'14'  (1)      MILTEN  END OF VARIABLE FIELD
  4294. EBCRES   EQU   X'14'  (2)      IBM     RESTORE
  4295. EBCNL    EQU   X'15'           IBM     NEW LINE
  4296. EBCBS    EQU   X'16'           ASCII   BACKSPACE
  4297. EBCIL    EQU   X'17'           IBM     IDLE CHARACTER
  4298. EBCCAN   EQU   X'18'           ASCII   CANCEL
  4299. EBCEM    EQU   X'19'           ASCII   END OF MEDIUM
  4300. EBCFONT  EQU   X'1A'  (1)      WYLBUR  SELECT NEW FONT
  4301. EBCCC    EQU   X'1A'  (2)      IBM     CURSOR CONTROL
  4302. EBCHLF   EQU   X'1B'  (1)      MILTEN  HALF LINE FEED
  4303. EBCCU1   EQU   X'1B'  (2)      IBM     CUSTOMER USE 1
  4304. EBCIFS   EQU   X'1C'           ASCII   INTERCHANGE FILE SEPARATOR
  4305. EBCIGS   EQU   X'1D'           ASCII   INTERCHANGE GROUP SEPARATOR
  4306. EBCIRS   EQU   X'1E'           ASCII   INTERCHANGE RECORD SEPARATOR
  4307. EBCIUS   EQU   X'1F'           ASCII   INTERCHANGE UNIT SEPARATOR
  4308. EBCNDBS  EQU   X'20'  (1)      MILTEN  NON-DESTRUCTIVE BACKSPACE
  4309. EBCDS    EQU   X'20'  (2)      IBM     DIGIT SELECT
  4310. EBCSOS   EQU   X'21'           IBM     START OF SIGNIFICANCE
  4311. EBCFS    EQU   X'22'           IBM     FIELD SEPARATOR (EDIT)
  4312. EBCCTB   EQU   X'23'           MILTEN  CLEAR TERMINAL BUFFER
  4313. EBCBYP   EQU   X'24'           IBM     BYPASS
  4314. EBCLF    EQU   X'25'           ASCII   LINE FEED
  4315. EBCETB   EQU   X'26'           ASCII   END OF TRANSMISSION BLOCK
  4316. EBCESC   EQU   X'27'           ASCII   ESCAPE
  4317. EBCHTS   EQU   X'28'           MILTEN  SET HORIZONTAL TAB
  4318. EBCHTCA  EQU   X'29'           MILTEN  CLEAR ALL HORIZONTAL TABS
  4319. EBCSUL   EQU   X'2A'  (1)      MILTEN  START UNDERLINE
  4320. EBCSM    EQU   X'2A'  (2)      IBM     SET MODE
  4321. EBCRHLF  EQU   X'2B'  (1)      MILTEN  REVERSE HALF LINE FEED
  4322. EBCCU2   EQU   X'2B'  (2)      IBM     CUSTOMER USE 2
  4323. EBCEUL   EQU   X'2C'           MILTEN  END UNDERLINE
  4324. EBCENQ   EQU   X'2D'           ASCII   ENQUIRY
  4325. EBCACK   EQU   X'2E'           ASCII   ACKNOWLEDGE
  4326. EBCBEL   EQU   X'2F'           ASCII   BELL
  4327. EBCVTS   EQU   X'30'           MILTEN  SET VERTICAL TAB
  4328. EBCVTCA  EQU   X'31'           MILTEN  CLEAR ALL VERTICAL TABS
  4329. EBCSYN   EQU   X'32'           ASCII   SYNCHRONOUS IDLE
  4330. EBCREN   EQU   X'33'           MILTEN  REENTER
  4331. EBCSDI   EQU   X'34'  (1)      MILTEN  START DIM INTENSITY
  4332. EBCPN    EQU   X'34'  (2)      IBM     PUNCH ON
  4333. EBCDC3   EQU   X'35'  (1)      ASCII   DEVICE CONTROL 3
  4334. EBCRS    EQU   X'35'  (2)      TSO     READER STOP
  4335. EBCSBC   EQU   X'36'  (1)      MILTEN  START BOLD CHARACTERS
  4336. EBCUC    EQU   X'36'  (2)      IBM     UPPER CASE
  4337. EBCEOT   EQU   X'37'           ASCII   END OF TRANSMISSION
  4338. EBCSRF   EQU   X'38'           MILTEN  START REVERSE FIELD
  4339. EBCERF   EQU   X'39'           MILTEN  END REVERSE FIELD
  4340. EBCSBK   EQU   X'3A'           MILTEN  START BLINK
  4341. EBCEBK   EQU   X'3B'  (1)      MILTEN  END BLINK
  4342. EBCCU3   EQU   X'3B'  (2)      IBM     CUSTOMER USE 3
  4343. EBCDC4   EQU   X'3C'           ASCII   DEVICE CONTROL 4
  4344. EBCNAK   EQU   X'3D'           ASCII   NEGATIVE ACKNOWLEDGE
  4345. EBCCTM   EQU   X'3E'           MILTEN  CLEAR TERMINAL MESSAGE
  4346. EBCSUB   EQU   X'3F'           ASCII   SUBSTITUTE
  4347. *
  4348. *  EBCDIC GRAPHIC CHARACTERS
  4349. *
  4350. EBCSP    EQU   X'40'           ASCII   SPACE
  4351. EBCDIGSP EQU   X'41'           MILTEN  DIGIT SPACE
  4352. EBCUNSP  EQU   X'42'           MILTEN  UNIT SPACE
  4353. EBCCENT  EQU   X'4A'           IBM     CENT SIGN
  4354. EBCIHYPH EQU   X'62'           MILTEN  INSERTED HYPHEN
  4355. EBCACCNT EQU   X'79'           ASCII   GRAVE ACCENT
  4356. EBCLCURL EQU   X'8B'           ASCII   LEFT CURLY BRACKET
  4357. EBCRCURL EQU   X'9B'           ASCII   RIGHT CURLY BRACKET
  4358. EBCPLMIN EQU   X'9E'           IBM     PLUS/MINUS SIGN
  4359. EBCDEGR  EQU   X'A1'  (1)      IBM     DEGREE MARK
  4360. EBCTILDE EQU   X'A1'  (2)      ASCII   TILDE
  4361. EBCLSQB  EQU   X'AD'           ASCII   LEFT SQUARE BRACKET
  4362. EBCRSQB  EQU   X'BD'           ASCII   RIGHT SQUARE BRACKET
  4363. EBCCFLEX EQU   X'BE'           ASCII   CIRCUMFLEX
  4364. EBCBKSL  EQU   X'E0'           ASCII   BACKSLASH
  4365.          MEND
  4366. ./       ADD   LIST=ALL,NAME=MFC
  4367.          MACRO
  4368. &L       MFC   &A,&C,&FILL=C' ',&FILADDR=,&N=*,&ZERO=
  4369.          LCLA  &X,&Y
  4370.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4371.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4372.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4373. .*
  4374.          AIF   ('&C' NE '').NDLEN
  4375.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  4376.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  4377.                T'&A NE '$').OKLEN
  4378.          MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
  4379. &L       MFCMVI &A,&FILL,&FILADDR
  4380.          MEXIT
  4381. .*
  4382. .OKLEN   ANOP
  4383. &X       SETA  L'&A
  4384. &L       MFC   &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
  4385.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
  4386.          MEXIT
  4387. .*
  4388. .NDLEN   ANOP
  4389. .*
  4390. &L       MFCMVI &A,&FILL,&FILADDR
  4391.          AIF   ('&N' EQ '' OR '&N' EQ '*').STAR
  4392. .ONE     SYSXXC MVC,&A,&A,&C-1,D1=1,N=&N
  4393.          MEXIT
  4394. .*
  4395. .STAR    ANOP
  4396.          AIF   ('&C' EQ '').ONE
  4397. .CHECK   ANOP
  4398. &Y       SETA  &Y+1
  4399.          AIF   (&Y GT K'&C).OK
  4400.          AIF   ('&C'(&Y,1) LT '0').ONE
  4401.          AGO   .CHECK
  4402. .OK      ANOP
  4403. &X       SETA  &C-1
  4404.          AIF   (&X LE 0).END
  4405.          SYSXXC MVC,&A,&A,&X,D1=1,N=*
  4406.          MEXIT
  4407. .*
  4408. .Z       ANOP
  4409. &L       MXC   &A,&A,&C,N=&N
  4410.          MEXIT
  4411. .*
  4412. .NULL    ANOP
  4413. &L       SYSLBL
  4414. .END     MEND
  4415. ./       ADD   LIST=ALL,NAME=MFCMVI
  4416.          MACRO
  4417. &L       MFCMVI &A,&FILL,&FILADDR
  4418.          AIF   ('&FILADDR' NE '').FILADDR
  4419.          AIF   ('&A' EQ '').NREG
  4420.          AIF   ('&A'(1,1) NE '(').NREG
  4421. &L       MVI   0&A,&FILL
  4422.          MEXIT
  4423. .*
  4424. .NREG    ANOP
  4425. &L       MVI   &A,&FILL
  4426.          MEXIT
  4427. .*
  4428. .FILADDR ANOP
  4429. &L       MMVC  &A,&FILADDR,1
  4430.          MEND
  4431. ./       ADD   LIST=ALL,NAME=MFCL
  4432.          MACRO
  4433. &L       MFCL  &R,&A,&C,&S,&FILL=C' ',&FILADDR=,&INLINE=,&N=*
  4434.          GBLC  &CPU
  4435.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4436.          AIF   ('&CPU' EQ '360').S360
  4437. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4438.          SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
  4439.          LR    &S,&R
  4440.          AIF   ('&FILADDR' NE '').FILADDR
  4441.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  4442.          L     &S+1,=AL1(&FILL,0,0,0)
  4443.          AGO   .MMVCL
  4444. .*
  4445. .FILADDR ANOP
  4446.          SR    &S+1,&S+1
  4447.          ICM   &S+1,8,&FILADDR
  4448. .MMVCL   ANOP
  4449.          MVCL  &R,&S
  4450.          MEXIT
  4451. .*
  4452. .Z370    SLR   &S+1,&S+1
  4453.          MVCL  &R,&S
  4454.          MEXIT
  4455. .*
  4456. .*  360
  4457. .*
  4458. .S360    ANOP
  4459.          AIF   ('&INLINE' EQ 'YES').MFC
  4460.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z360
  4461.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ360
  4462. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4463.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4464.          BNP   MFC&SYSNDX.A
  4465.          MFCLF &R,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  4466. MFC&SYSNDX.A DS 0H
  4467.          MEXIT
  4468. .*
  4469. .RZ360   ANOP
  4470. &L       SYSLR &S,&A
  4471.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4472.          BNP   MFC&SYSNDX.A
  4473.          MFCLF &S,&R+1,MFC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  4474. MFC&SYSNDX.A DS 0H
  4475.          MEXIT
  4476. .*
  4477. .*  360 CLEAR TO ZERO
  4478. .*
  4479. .Z360    ANOP
  4480.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').ZRZ360
  4481. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  4482.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4483.          BNP   MFC&SYSNDX.A
  4484.          MFCLZ &R,&R+1
  4485. MFC&SYSNDX.A DS 0H
  4486.          MEXIT
  4487. .*
  4488. .ZRZ360  ANOP
  4489. &L       SYSLR &S,&A
  4490.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  4491.          BNP   MFC&SYSNDX.A
  4492.          MFCLZ &S,&R+1
  4493. MFC&SYSNDX.A DS 0H
  4494.          MEXIT
  4495. .*
  4496. .*  MFC
  4497. .*
  4498. .MFC     ANOP
  4499. &L       MFC   &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
  4500.          MEND
  4501. ./       ADD   LIST=ALL,NAME=MFCLF
  4502.          MACRO
  4503. &L       MFCLF &A,&C,&LEND,&FILL=,&FILADDR=
  4504.          AIF   ('&FILADDR' EQ '').FILL
  4505. &L       MVC   0(1,&A),&FILADDR
  4506.          AGO   .BCT
  4507. .*
  4508. .FILL    ANOP
  4509. &L       MVI   0(&A),&FILL
  4510. .BCT     BCT   &C,*+8
  4511.          B     &LEND
  4512. MFC&SYSNDX.X C &C,=F'256'
  4513.          BNH   MFC&SYSNDX.Z
  4514.          MVC   1(256,&A),0(&A)
  4515.          LA    &A,256(,&A)
  4516.          S     &C,=F'256'
  4517.          B     MFC&SYSNDX.X
  4518. MFC&SYSNDX.Y MVC 1(0,&A),0(&A)
  4519. MFC&SYSNDX.Z BCTR &C,0
  4520.          EX    &C,MFC&SYSNDX.Y
  4521.          MEND
  4522. ./       ADD   LIST=ALL,NAME=MFCLZ
  4523.          MACRO
  4524. &L       MFCLZ &A,&C
  4525.          LCLC  &LBL
  4526. &LBL     SETC  '&L'
  4527.          AIF   ('&L' NE '').LBL
  4528. &LBL     SETC  'MFC&SYSNDX.X'
  4529. .LBL     ANOP
  4530. .*
  4531. &LBL     C     &C,=F'256'
  4532.          BNH   MFC&SYSNDX.Z
  4533.          XC    0(256,&A),0(&A)
  4534.          LA    &A,256(,&A)
  4535.          S     &C,=F'256'
  4536.          B     &LBL
  4537. MFC&SYSNDX.Y XC 0(0,&A),0(&A)
  4538. MFC&SYSNDX.Z BCTR &C,0
  4539.          EX    &C,MFC&SYSNDX.Y
  4540.          MEND
  4541. ./       ADD   LIST=ALL,NAME=MI
  4542.          MACRO
  4543. &L       MI    &R,&V
  4544.          LCLA  &X,&Y,&Z
  4545. .*
  4546. .LOOP    ANOP
  4547. &X       SETA  &X+1
  4548.          AIF   (&X GT K'&V).INT
  4549.          AIF   ('&V'(&X,1) GE '0' AND '&V'(&X,1) LE '9').LOOP
  4550.     AIF ((&X EQ 1) AND (('&V'(1,1) EQ '-') OR ('&V'(1,1) EQ '+'))).LOOP
  4551. .*
  4552. &L       MH    &R,=AL2(&V)
  4553.          MEXIT
  4554. .*
  4555. .INT     ANOP
  4556.          AIF   ('&V' EQ '0').ZERO
  4557.          AIF   ('&V' EQ '1').ONE
  4558. &X       SETA  0
  4559. &Y       SETA  1
  4560. &Z       SETA  &V
  4561. .POWER   ANOP
  4562. &X       SETA  &X+1
  4563. &Y       SETA  &Y*2
  4564.          AIF   (&Y EQ &Z).SHIFT
  4565.          AIF   (&Y LT &Z AND &Y LT 16384).POWER
  4566. &L       MH    &R,=H'&V'
  4567.          MEXIT
  4568. .*
  4569. .ZERO    ANOP
  4570. &L       LA &R,0
  4571.          MEXIT
  4572. .*
  4573. .ONE     ANOP
  4574. &L       SYSLBL
  4575.          MEXIT
  4576. .*
  4577. .SHIFT   ANOP
  4578. &L       SLL   &R,&X
  4579.          MEND
  4580. ./       ADD   LIST=ALL,NAME=MMVC
  4581.          MACRO
  4582. &L       MMVC  &A,&B,&C,&N=*,&ZERO=
  4583.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4584.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4585. &L       SYSXXC MVC,&A,&B,&C,N=&N
  4586.          MEXIT
  4587. .*
  4588. .NULL    ANOP
  4589. &L       SYSLBL
  4590.          MEND
  4591. ./       ADD   LIST=ALL,NAME=MMVCL
  4592.          MACRO
  4593. &L       MMVCL &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4594.          GBLC  &CPU,&SIM370
  4595.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4596.          AIF   ('&CPU' EQ '360').S360
  4597. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4598.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4599.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4600.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ370
  4601.          AIF   ('&LB' EQ '(&RA+1)' OR '&LA' EQ '(&RB+1)').EQ370
  4602.          SYSLR &RB+1,&LB
  4603.          AIF   ('&FILADDR' NE '').FILADDR
  4604.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  4605.          O     &RB+1,=AL1(&FILL,0,0,0)
  4606.          AGO   .Z370
  4607. .*
  4608. .FILADDR ANOP
  4609.          ICM   &RB+1,8,&FILADDR
  4610. .*
  4611. .Z370    MVCL  &RA,&RB
  4612.          MEXIT
  4613. .EQ370   ANOP
  4614.          LR    &RB+1,&RA+1
  4615.          MVCL  &RA,&RB
  4616.          MEXIT
  4617. .*
  4618. .*  360 LOOP
  4619. .*
  4620. .S360    ANOP
  4621.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ360
  4622. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4623.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4624.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4625.          SYSLR &RB+1,&LB
  4626.          SR    &RA+1,&RB+1
  4627.          BNM   *+6
  4628.          AR    &RB+1,&RA+1
  4629.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ1
  4630.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ1
  4631.          LTR   &RB+1,&RB+1
  4632.          BNP   MVC&SYSNDX.X
  4633.          MMVCLM &RA,&RB,&RB+1
  4634.          LA    &RA,1(&RA,&RB+1)
  4635. MVC&SYSNDX.X LTR &RA+1,&RA+1
  4636.          BNP   MVC&SYSNDX.Y
  4637.          MMVCLP &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4638. MVC&SYSNDX.Y DS 0H
  4639.          MEXIT
  4640. .*
  4641. .RAZ1    ANOP
  4642.          XR    &RA,&RA+1
  4643.          XR    &RA+1,&RA
  4644.          XR    &RA,&RA+1
  4645.          LTR   &RB+1,&RB+1
  4646.          BNP   MVC&SYSNDX.X
  4647.          MMVCLM &RA+1,&RB,&RB+1
  4648.          LA    &RA+1,1(&RA+1,&RB+1)
  4649. MVC&SYSNDX.X LTR &RB+1,&RA
  4650.          BNP   MVC&SYSNDX.Y
  4651.          MMVCLP &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4652. MVC&SYSNDX.Y DS 0H
  4653.          MEXIT
  4654. .*
  4655. .RBZ1    ANOP
  4656.          XR    &RA+1,&RB
  4657.          XR    &RB,&RA+1
  4658.          XR    &RA+1,&RB
  4659.          LTR   &RB+1,&RB+1
  4660.          BNP   MVC&SYSNDX.X
  4661.          MMVCLM &RA,&RA+1,&RB+1
  4662.          LA    &RA,1(&RA,&RB+1)
  4663. MVC&SYSNDX.X LTR &RB+1,&RB
  4664.          BNP   MVC&SYSNDX.Y
  4665.          MMVCLP &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4666. MVC&SYSNDX.Y DS 0H
  4667.          MEXIT
  4668. .*
  4669. .*  360 EQUAL LENGTH
  4670. .*
  4671. .EQ360   ANOP
  4672.          AIF   ('&INLINE' EQ 'YES').INLINE
  4673.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ2
  4674.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ2
  4675. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4676.          BNP   MVC&SYSNDX.Z
  4677.          SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4678.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4679.          MMVCLM &RA,&RB,&RA+1
  4680. MVC&SYSNDX.Z DS 0H
  4681.          MEXIT
  4682. .*
  4683. .RAZ2    ANOP
  4684. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4685.          BNP   MVC&SYSNDX.Z
  4686.          SYSLR &RB+1,&AA
  4687.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4688.          MMVCLM &RB+1,&RB,&RA+1
  4689. MVC&SYSNDX.Z DS 0H
  4690.          MEXIT
  4691. .*
  4692. .RBZ2    ANOP
  4693. &L       SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4694.          BNP   MVC&SYSNDX.Z
  4695.          SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4696.          SYSLR &RB+1,&AB
  4697.          MMVCLM &RA,&RB+1,&RA+1
  4698. MVC&SYSNDX.Z DS 0H
  4699.          MEXIT
  4700. .*
  4701. .*  INLINE
  4702. .*
  4703. .INLINE  ANOP
  4704. &L       MMVC  &AA,&AB,&LA,N=&N
  4705.          MEND
  4706. ./       ADD   LIST=ALL,NAME=MMVCLM
  4707.          MACRO
  4708. &L       MMVCLM &A,&B,&C
  4709.          LCLC  &LBL
  4710. .*
  4711. &LBL     SETC  '&L'
  4712.          AIF   ('&L' NE '').OKLBL
  4713. &LBL     SETC  'MVC&SYSNDX.A'
  4714. .OKLBL   ANOP
  4715. .*
  4716. &LBL     C     &C,=F'256'
  4717.          BNH   MVC&SYSNDX.C
  4718.          MVC   0(256,&A),0(&B)
  4719.          LA    &A,256(,&A)
  4720.          LA    &B,256(,&B)
  4721.          S     &C,=F'256'
  4722.          B     &LBL
  4723. MVC&SYSNDX.B MVC 0(0,&A),0(&B)
  4724. MVC&SYSNDX.C BCTR &C,0
  4725.          EX    &C,MVC&SYSNDX.B
  4726.          MEND
  4727. ./       ADD   LIST=ALL,NAME=MMVCLP
  4728.          MACRO
  4729. &L       MMVCLP &A,&C,&FILL=0,&FILADDR=
  4730.          AIF   ('&FILADDR' EQ '').FILL
  4731. &L       MVC   0(1,&A),&FILADDR
  4732.          AGO   .BCT
  4733. .*
  4734. .FILL    ANOP
  4735.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').ZOT
  4736. &L       MVI   0(&A),&FILL
  4737. .BCT     BCT   &C,*+8
  4738.          B     MVC&SYSNDX.G
  4739. MVC&SYSNDX.D C &C,=F'256'
  4740.          BNH   MVC&SYSNDX.F
  4741.          MVC   1(256,&A),0(&A)
  4742.          LA    &A,256(,&A)
  4743.          S     &C,=F'256'
  4744.          B     MVC&SYSNDX.D
  4745. MVC&SYSNDX.E MVC 1(0,&A),0(&A)
  4746. MVC&SYSNDX.F BCTR &C,0
  4747.          EX    &C,MVC&SYSNDX.E
  4748. MVC&SYSNDX.G DS 0H
  4749.          MEXIT
  4750. .*
  4751. .ZOT     ANOP
  4752. &L       SYSLBL
  4753. MVC&SYSNDX.D C     &C,=F'256'
  4754.          BNH   MVC&SYSNDX.F
  4755.          XC    0(256,&A),0(&A)
  4756.          LA    &A,256(,&A)
  4757.          S     &C,=F'256'
  4758.          B     MVC&SYSNDX.D
  4759. MVC&SYSNDX.E XC 0(0,&A),0(&A)
  4760. MVC&SYSNDX.F BCTR &C,0
  4761.          EX    &C,MVC&SYSNDX.E
  4762.          MEND
  4763. ./       ADD   LIST=ALL,NAME=MNC
  4764.          MACRO
  4765. &L       MNC   &A,&B,&C,&N=*,&ZERO=
  4766.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  4767.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  4768. &L       SYSXXC NC,&A,&B,&C,N=&N
  4769.          MEXIT
  4770. .*
  4771. .NULL    ANOP
  4772. &L       SYSLBL
  4773.          MEND
  4774. ./       ADD   LIST=ALL,NAME=MNCL
  4775.          MACRO
  4776. &L    MNCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=X'FF',&FILADDR=,&INLINE=,&N=*
  4777.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4778.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  4779. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4780.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4781.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4782.          SYSLR &RB+1,&LB
  4783.          SR    &RA+1,&RB+1
  4784.          BNM   *+6
  4785.          AR    &RB+1,&RA+1
  4786.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  4787.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  4788.          LTR   &RB+1,&RB+1
  4789.          BNP   NC&SYSNDX.A
  4790.          MNCLN &RA,&RB,&RB+1
  4791.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4792.                AND '&FILADDR' EQ '').FF
  4793.          LA    &RA,1(&RA,&RB+1)
  4794.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4795. NC&SYSNDX.A LTR &RA+1,&RA+1
  4796.          BNP   NC&SYSNDX.B
  4797.          MNCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4798. NC&SYSNDX.B DS 0H
  4799.          MEXIT
  4800. .Z       ANOP
  4801. NC&SYSNDX.A LTR &RA+1,&RA+1
  4802.          BNP   NC&SYSNDX.B
  4803.          MFCLZ &RA,&RA+1
  4804. NC&SYSNDX.B DS 0H
  4805.          MEXIT
  4806. .FF      ANOP
  4807. NC&SYSNDX.A DS 0H
  4808.          MEXIT
  4809. .*
  4810. .RAZ     ANOP
  4811.          XR    &RA,&RA+1
  4812.          XR    &RA+1,&RA
  4813.          XR    &RA,&RA+1
  4814.          LTR   &RB+1,&RB+1
  4815.          BNP   NC&SYSNDX.A
  4816.          MNCLN &RA+1,&RB,&RB+1
  4817.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4818.                AND '&FILADDR' EQ '').RAZFF
  4819.          LA    &RA+1,1(&RA+1,&RB+1)
  4820.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  4821. NC&SYSNDX.A LTR &RB+1,&RA
  4822.          BNP   NC&SYSNDX.B
  4823.          MNCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4824. NC&SYSNDX.B DS 0H
  4825.          MEXIT
  4826. .RAZZ    ANOP
  4827. NC&SYSNDX.A LTR &RB+1,&RA
  4828.          BNP   NC&SYSNDX.B
  4829.          MFCLZ &RA+1,&RB+1
  4830. NC&SYSNDX.B DS 0H
  4831.          MEXIT
  4832. .RAZFF   ANOP
  4833. NC&SYSNDX.A DS 0H
  4834.          MEXIT
  4835. .*
  4836. .RBZ     ANOP
  4837.          XR    &RB,&RA+1
  4838.          XR    &RA+1,&RB
  4839.          XR    &RB,&RA+1
  4840.          LTR   &RB+1,&RB+1
  4841.          BNP   NC&SYSNDX.A
  4842.          MNCLN &RA,&RA+1,&RB+1
  4843.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4844.                AND '&FILADDR' EQ '').RBZFF
  4845.          LA    &RA,1(&RA,&RB+1)
  4846.          AIF   (('&FILL' EQ '' OR '&FILL' EQ '0')                      *
  4847.                AND '&FILADDR' EQ '').RBZZ
  4848. NC&SYSNDX.A LTR &RB+1,&RB
  4849.          BNP   NC&SYSNDX.B
  4850.          MNCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4851. NC&SYSNDX.B DS 0H
  4852.          MEXIT
  4853. .*
  4854. .RBZZ    ANOP
  4855. NC&SYSNDX.A LTR &RB+1,&RB
  4856.          BNP   NC&SYSNDX.B
  4857.          MFCLZ &RA,&RB+1
  4858. NC&SYSNDX.B DS 0H
  4859.          MEXIT
  4860. .RBZFF   ANOP
  4861. NC&SYSNDX.A DS 0H
  4862.          MEXIT
  4863. .*
  4864. .*   EQUAL LENGTH
  4865. .*
  4866. .EQ      ANOP
  4867.          AIF   ('&INLINE' EQ 'YES').MNC
  4868.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  4869.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  4870. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4871.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4872.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4873.          LTR   &RA+1,&RA+1
  4874.          BNP   NC&SYSNDX.A
  4875.          MNCLN &RA,&RB,&RA+1
  4876. NC&SYSNDX.A DS 0H
  4877.          MEXIT
  4878. .*
  4879. .EQRAZ   ANOP
  4880. &L       SYSLR &RB+1,&AA
  4881.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4882.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4883.          BNP   NC&SYSNDX.A
  4884.          MNCLN &RB+1,&RB,&RA+1
  4885. NC&SYSNDX.A DS 0H
  4886.          MEXIT
  4887. .*
  4888. .EQRBZ   ANOP
  4889. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4890.          SYSLR &RB+1,&AB
  4891.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  4892.          BNP   NC&SYSNDX.A
  4893.          MNCLN &RA,&RB+1,&RA+1
  4894. NC&SYSNDX.A DS 0H
  4895.          MEXIT
  4896. .*
  4897. .*  MNC
  4898. .*
  4899. .MNC     ANOP
  4900. &L       MNC   &AA,&AB,&LA,N=&N
  4901.          MEND
  4902. ./       ADD   LIST=ALL,NAME=MNCLN
  4903.          MACRO
  4904. &L       MNCLN &A,&B,&C
  4905.          LCLC  &LBL
  4906. &LBL     SETC  '&L'
  4907.          AIF   ('&L' NE '').LBL
  4908. &LBL     SETC  'NC&SYSNDX.X'
  4909. .LBL     ANOP
  4910. .*
  4911. &LBL     C     &C,=F'256'
  4912.          BNH   NC&SYSNDX.Z
  4913.          NC    0(256,&A),0(&A)
  4914.          LA    &A,256(,&A)
  4915.          LA    &B,256(,&B)
  4916.          S     &C,=F'256'
  4917.          B     &LBL
  4918. NC&SYSNDX.Y NC 0(0,&A),0(&A)
  4919. NC&SYSNDX.Z BCTR &C,0
  4920.          EX    &C,NC&SYSNDX.Y
  4921.          MEND
  4922. ./       ADD   LIST=ALL,NAME=MNCLF
  4923.          MACRO
  4924. &L       MNCLF &A,&C,&FILL=,&FILADDR=
  4925.          AIF   ('&FILADDR' EQ '').FILL
  4926. &L       NC    0(1,&A),&FILADDR
  4927.          LA    &A,1(,&A)
  4928.          BCT   &C,*-10
  4929.          MEXIT
  4930. .*
  4931. .FILL    ANOP
  4932. &L       NI    0(&A),&FILL
  4933. .LA      LA    &A,1(,&A)
  4934.          BCT   &C,*-8
  4935.          MEND
  4936. ./       ADD   LIST=ALL,NAME=MOC
  4937.          MACRO
  4938. &L       MOC   &A,&B,&C,&N=*,&ZERO=
  4939. &L       SYSXXC OC,&A,&B,&C,N=&N
  4940.          MEXIT
  4941. .*
  4942. .NULL    ANOP
  4943. &L       SYSLBL
  4944.          MEND
  4945. ./       ADD   LIST=ALL,NAME=MOCL
  4946.          MACRO
  4947. &L       MOCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  4948.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  4949.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  4950. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  4951.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  4952.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  4953.          SYSLR &RB+1,&LB
  4954.          SR    &RA+1,&RB+1
  4955.          BNM   *+6
  4956.          AR    &RB+1,&RA+1
  4957.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  4958.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  4959.          LTR   &RB+1,&RB+1
  4960.          BNP   OC&SYSNDX.A
  4961.          MOCLN &RA,&RB,&RB+1
  4962.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  4963.          LA    &RA,1(&RA,&RB+1)
  4964.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4965.                AND '&FILADDR' EQ '').FF
  4966. OC&SYSNDX.A LTR &RA+1,&RA+1
  4967.          BNP   OC&SYSNDX.B
  4968.          MOCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  4969. OC&SYSNDX.B DS 0H
  4970.          MEXIT
  4971. .FF      ANOP
  4972. OC&SYSNDX.A LTR &RA+1,&RA+1
  4973.          BNP   OC&SYSNDX.B
  4974.          MFCLF &RA,&RA+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  4975. OC&SYSNDX.B DS 0H
  4976.          MEXIT
  4977. .Z       ANOP
  4978. OC&SYSNDX.A DS 0H
  4979.          MEXIT
  4980. .*
  4981. .RAZ     ANOP
  4982.          XR    &RA,&RA+1
  4983.          XR    &RA+1,&RA
  4984.          XR    &RA,&RA+1
  4985.          LTR   &RB+1,&RB+1
  4986.          BNP   OC&SYSNDX.A
  4987.          MOCLN &RA+1,&RB,&RB+1
  4988.       AIF (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  4989.          LA    &RA+1,1(&RA+1,&RB+1)
  4990.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  4991.                AND '&FILADDR' EQ '').RAZFF
  4992. OC&SYSNDX.A LTR &RB+1,&RA
  4993.          BNP   OC&SYSNDX.B
  4994.          MOCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  4995. OC&SYSNDX.B DS 0H
  4996.          MEXIT
  4997. .RAZFF   ANOP
  4998. OC&SYSNDX.A LTR &RB+1,&RA
  4999.          BNP   OC&SYSNDX.B
  5000.          MFCLF &RA+1,&RB+1,OC&SYSNDX.B,FILL=&FILL,FILADDR=&FILADDR
  5001. OC&SYSNDX.B DS 0H
  5002.          MEXIT
  5003. .RAZZ    ANOP
  5004. OC&SYSNDX.A DS 0H
  5005.          MEXIT
  5006. .*
  5007. .RBZ     ANOP
  5008.          XR    &RB,&RA+1
  5009.          XR    &RA+1,&RB
  5010.          XR    &RB,&RA+1
  5011.          LTR   &RB+1,&RB+1
  5012.          BNP   OC&SYSNDX.A
  5013.          MOCLN &RA,&RA+1,&RB+1
  5014.          AIF   (('&FILL' EQ '255' OR '&FILL' EQ 'X''FF''')             *
  5015.                AND '&FILADDR' EQ '').RBZFF
  5016.          LA    &RA,1(&RA,&RB+1)
  5017.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RBZZ
  5018. OC&SYSNDX.A LTR &RB+1,&RB
  5019.          BNP   OC&SYSNDX.B
  5020.          MOCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5021. OC&SYSNDX.B DS 0H
  5022.          MEXIT
  5023. .*
  5024. .RBZZ    ANOP
  5025. OC&SYSNDX.A LTR &RB+1,&RB
  5026.          BNP   OC&SYSNDX.B
  5027.          MFCLZ &RA,&RB+1
  5028. OC&SYSNDX.B DS 0H
  5029.          MEXIT
  5030. .RBZFF   ANOP
  5031. OC&SYSNDX.A DS 0H
  5032.          MEXIT
  5033. .*
  5034. .*   EQUAL LENGTH
  5035. .*
  5036. .EQ      ANOP
  5037.          AIF   ('&INLINE' EQ 'YES').MOC
  5038.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  5039.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  5040. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5041.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5042.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5043.          LTR   &RA+1,&RA+1
  5044.          BNP   OC&SYSNDX.A
  5045.          MOCLN &RA,&RB,&RA+1
  5046. OC&SYSNDX.A DS 0H
  5047.          MEXIT
  5048. .*
  5049. .EQRAZ   ANOP
  5050. &L       SYSLR &RB+1,&AA
  5051.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5052.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5053.          BNP   OC&SYSNDX.A
  5054.          MOCLN &RB+1,&RB,&RA+1
  5055. OC&SYSNDX.A DS 0H
  5056.          MEXIT
  5057. .*
  5058. .EQRBZ   ANOP
  5059. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5060.          SYSLR &RB+1,&AB
  5061.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5062.          BNP   OC&SYSNDX.A
  5063.          MOCLN &RA,&RB+1,&RA+1
  5064. OC&SYSNDX.A DS 0H
  5065.          MEXIT
  5066. .*
  5067. .*  MOC
  5068. .*
  5069. .MOC     ANOP
  5070. &L       MOC   &AA,&AB,&LA,N=&N
  5071.          MEND
  5072. ./       ADD   LIST=ALL,NAME=MOCLN
  5073.          MACRO
  5074. &L       MOCLN &A,&B,&C
  5075.          LCLC  &LBL
  5076. &LBL     SETC  '&L'
  5077.          AIF   ('&L' NE '').LBL
  5078. &LBL     SETC  'OC&SYSNDX.X'
  5079. .LBL     ANOP
  5080. .*
  5081. &LBL     C     &C,=F'256'
  5082.          BNH   OC&SYSNDX.Z
  5083.          OC    0(256,&A),0(&A)
  5084.          LA    &A,256(,&A)
  5085.          LA    &B,256(,&B)
  5086.          S     &C,=F'256'
  5087.          B     &LBL
  5088. OC&SYSNDX.Y OC 0(0,&A),0(&A)
  5089. OC&SYSNDX.Z BCTR &C,0
  5090.          EX    &C,OC&SYSNDX.Y
  5091.          MEND
  5092. ./       ADD   LIST=ALL,NAME=MOCLF
  5093.          MACRO
  5094. &L       MOCLF &A,&C,&FILL=,&FILADDR=
  5095.          AIF   ('&FILADDR' EQ '').FILL
  5096. &L       OC    0(1,&A),&FILADDR
  5097.          LA    &A,1(,&A)
  5098.          BCT   &C,*-10
  5099.          MEXIT
  5100. .*
  5101. .FILL    ANOP
  5102. &L       OI    0(&A),&FILL
  5103.          LA    &A,1(,&A)
  5104.          BCT   &C,*-8
  5105.          MEND
  5106. ./       ADD   LIST=ALL,NAME=MPARMGBL
  5107. *
  5108. *  NIH/COMMON - DUMMY FOR MILTEN GLOBAL DECLARATIONS
  5109. *
  5110. ./       ADD   LIST=ALL,NAME=MPNI
  5111.          MACRO
  5112. &L       MPNI  &A,&B,&BASE=,®S=
  5113.          GBLC  &OS,&MP
  5114.          LCLC  &LBL
  5115.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5116.          AIF   ('&MP' EQ 'NO').NMP
  5117.          AIF   ('&BASE' EQ '').NBASE
  5118.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5119. .*
  5120. &L       LA    ®S(3),255-(&B)
  5121.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5122.          X     ®S(3),=XL4'FFFFFFFF'
  5123.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5124.          LR    ®S(2),®S(1)
  5125.          NR    ®S(2),®S(3)
  5126.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5127.          BNE   *-8
  5128.          MEXIT
  5129. .*
  5130. .BASER   ANOP
  5131. &L       LA    ®S(3),255-(&B)
  5132.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5133.          X     ®S(3),=XL4'FFFFFFFF'
  5134.          L     ®S(1),(&A)/4*4&BASE
  5135.          LR    ®S(2),®S(1)
  5136.          NR    ®S(2),®S(3)
  5137.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5138.          BNE   *-8
  5139.          MEXIT
  5140. .*
  5141. .NBASE   ANOP
  5142. &LBL     SETC  '&L'
  5143.          AIF   ('&L' NE '').NLBL
  5144. &LBL     SETC  'MPNI&SYSNDX'
  5145. .NLBL    ANOP
  5146. &LBL     SYSLR ®S(1),&A
  5147.          LR    ®S(2),®S(1)
  5148.          N     ®S(1),=XL4'FFFFFFFC'
  5149.          SLR   ®S(2),®S(1)
  5150.          SLL   ®S(2),3
  5151.          L     ®S(3),=AL1(255-(&B),0,0,0)
  5152.          SRL   ®S(3),0(®S(2))
  5153.          X     ®S(3),=XL4'FFFFFFFF'
  5154.          L     ®S(2),0(®S(1))
  5155.          NR    ®S(3),®S(2)
  5156.          CS    ®S(2),®S(3),0(®S(1))
  5157.          BNE   &LBL
  5158.          MEXIT
  5159. .*
  5160. .NMP     ANOP
  5161.          AIF   ('&BASE' EQ '').NMPNB
  5162.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5163. &L       NI    &A&BASE,&B
  5164.          MEXIT
  5165. .*
  5166. .NMPNB   ANOP
  5167. &L       NI    &A,&B
  5168.          MEND
  5169. ./       ADD   LIST=ALL,NAME=MPOI
  5170.          MACRO
  5171. &L       MPOI  &A,&B,&BASE=,®S=
  5172.          GBLC  &OS,&MP
  5173.          LCLC  &LBL
  5174.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5175.          AIF   ('&MP' EQ 'NO').NMP
  5176.          AIF   ('&BASE' EQ '').NBASE
  5177.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5178. .*
  5179. &L       LA    ®S(3),&B
  5180.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5181.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5182.          LR    ®S(2),®S(1)
  5183.          OR    ®S(2),®S(3)
  5184.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5185.          BNE   *-8
  5186.          MEXIT
  5187. .*
  5188. .BASER   ANOP
  5189. &L       LA    ®S(3),&B
  5190.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5191.          L     ®S(1),(&A)/4*4&BASE
  5192.          LR    ®S(2),®S(1)
  5193.          OR    ®S(2),®S(3)
  5194.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5195.          BNE   *-8
  5196.          MEXIT
  5197. .*
  5198. .NBASE   ANOP
  5199. &LBL     SETC  '&L'
  5200.          AIF   ('&L' NE '').NLBL
  5201. &LBL     SETC  'MPOI&SYSNDX'
  5202. .NLBL    ANOP
  5203. &LBL     SYSLR ®S(1),&A
  5204.          LR    ®S(2),®S(1)
  5205.          N     ®S(1),=XL4'FFFFFFFC'
  5206.          SLR   ®S(2),®S(1)
  5207.          SLL   ®S(2),3
  5208.          L     ®S(3),=AL1(&B,0,0,0)
  5209.          SRL   ®S(3),0(®S(2))
  5210.          L     ®S(2),0(®S(1))
  5211.          OR    ®S(3),®S(2)
  5212.          CS    ®S(2),®S(3),0(®S(1))
  5213.          BNE   &LBL
  5214.          MEXIT
  5215. .*
  5216. .NMP     ANOP
  5217.          AIF   ('&BASE' EQ '').NMPNB
  5218.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5219. &L       OI    &A&BASE,&B
  5220.          MEXIT
  5221. .*
  5222. .NMPNB   ANOP
  5223. &L       OI    &A,&B
  5224.          MEND
  5225. ./       ADD   LIST=ALL,NAME=MPXI
  5226.          MACRO
  5227. &L       MPXI  &A,&B,&BASE=,®S=
  5228.          GBLC  &OS,&MP
  5229.          LCLC  &LBL
  5230.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5231.          AIF   ('&MP' EQ 'NO').NMP
  5232.          AIF   ('&BASE' EQ '').NBASE
  5233.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5234. .*
  5235. &L       LA    ®S(3),&B
  5236.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5237.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5238.          LR    ®S(2),®S(1)
  5239.          XR    ®S(2),®S(3)
  5240.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5241.          BNE   *-8
  5242.          MEXIT
  5243. .*
  5244. .BASER   ANOP
  5245. &L       LA    ®S(3),&B
  5246.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5247.          L     ®S(1),(&A)/4*4&BASE
  5248.          LR    ®S(2),®S(1)
  5249.          XR    ®S(2),®S(3)
  5250.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5251.          BNE   *-8
  5252.          MEXIT
  5253. .*
  5254. .NBASE   ANOP
  5255. &LBL     SETC  '&L'
  5256.          AIF   ('&L' NE '').NLBL
  5257. &LBL     SETC  'MPXI&SYSNDX'
  5258. .NLBL    ANOP
  5259. &LBL     SYSLR ®S(1),&A
  5260.          LR    ®S(2),®S(1)
  5261.          N     ®S(1),=XL4'FFFFFFFC'
  5262.          SLR   ®S(2),®S(1)
  5263.          SLL   ®S(2),3
  5264.          L     ®S(3),=AL1(&B,0,0,0)
  5265.          SRL   ®S(3),0(®S(2))
  5266.          L     ®S(2),0(®S(1))
  5267.          XR    ®S(3),®S(2)
  5268.          CS    ®S(2),®S(3),0(®S(1))
  5269.          BNE   &LBL
  5270.          MEXIT
  5271. .*
  5272. .NMP     ANOP
  5273.          AIF   ('&BASE' EQ '').NMPNB
  5274.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5275. &L       XI    &A&BASE,&B
  5276.          MEXIT
  5277. .*
  5278. .NMPNB   ANOP
  5279. &L       XI    &A,&B
  5280.          MEND
  5281. ./       ADD   LIST=ALL,NAME=MPZI
  5282.          MACRO
  5283. &L       MPZI  &A,&B,&BASE=,®S=
  5284.          GBLC  &OS,&MP
  5285.          LCLC  &LBL
  5286.          AIF   ('&OS' NE 'MVS' AND '&OS' NE 'XA').NMP
  5287.          AIF   ('&MP' EQ 'NO').NMP
  5288.          AIF   ('&BASE' EQ '').NBASE
  5289.          AIF   ('&BASE'(1,1) EQ '(').BASER
  5290. .*
  5291. &L       LA    ®S(3),&B
  5292.          SLL   ®S(3),24-8*(&A-(&BASE)-(&A-(&BASE))/4*4)
  5293.          X     ®S(3),=XL4'FFFFFFFF'
  5294.          L     ®S(1),&BASE+(&A-(&BASE))/4*4
  5295.          LR    ®S(2),®S(1)
  5296.          NR    ®S(2),®S(3)
  5297.          CS    ®S(1),®S(2),&BASE+(&A-(&BASE))/4*4
  5298.          BNE   *-8
  5299.          MEXIT
  5300. .*
  5301. .BASER   ANOP
  5302. &L       LA    ®S(3),&B
  5303.          SLL   ®S(3),24-8*(&A-(&A)/4*4)
  5304.          X     ®S(3),=XL4'FFFFFFFF'
  5305.          L     ®S(1),(&A)/4*4&BASE
  5306.          LR    ®S(2),®S(1)
  5307.          NR    ®S(2),®S(3)
  5308.          CS    ®S(1),®S(2),(&A)/4*4&BASE
  5309.          BNE   *-8
  5310.          MEXIT
  5311. .*
  5312. .NBASE   ANOP
  5313. &LBL     SETC  '&L'
  5314.          AIF   ('&L' NE '').NLBL
  5315. &LBL     SETC  'MPNI&SYSNDX'
  5316. .NLBL    ANOP
  5317. &LBL     SYSLR ®S(1),&A
  5318.          LR    ®S(2),®S(1)
  5319.          N     ®S(1),=XL4'FFFFFFFC'
  5320.          SLR   ®S(2),®S(1)
  5321.          SLL   ®S(2),3
  5322.          L     ®S(3),=AL1(&B,0,0,0)
  5323.          SRL   ®S(3),0(®S(2))
  5324.          X     ®S(3),=XL4'FFFFFFFF'
  5325.          L     ®S(2),0(®S(1))
  5326.          NR    ®S(3),®S(2)
  5327.          CS    ®S(2),®S(3),0(®S(1))
  5328.          BNE   &LBL
  5329.          MEXIT
  5330. .*
  5331. .NMP     ANOP
  5332.          AIF   ('&BASE' EQ '').NMPNB
  5333.          AIF   ('&BASE'(1,1) NE '(').NMPNB
  5334. &L       NI    &A&BASE,255-(&B)
  5335.          MEXIT
  5336. .*
  5337. .NMPNB   ANOP
  5338. &L       NI    &A,255-(&B)
  5339.          MEND
  5340. ./       ADD   LIST=ALL,NAME=MTC
  5341.          MACRO
  5342. &L       MTC   &A,&C,&FILL=,&FILADDR=,&N=*,&ZERO=
  5343.          LCLA  &X,&Y
  5344.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5345.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5346.          AIF   ('&FILL' NE '' OR '&FILADDR' NE '').CLC
  5347. &L       SYSXXC OC,&A,&A,&C,N=&N,BC=BNZ
  5348.          MEXIT
  5349. .*
  5350. .CLC     ANOP
  5351.          AIF   ('&C' NE '').NDLEN
  5352.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  5353.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  5354.                T'&A NE '$').OKLEN
  5355.          MNOTE 12,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE'
  5356. &L       MTCCLI &A,&FILL,&FILADDR
  5357.          MEXIT
  5358. .*
  5359. .OKLEN   ANOP
  5360. &X       SETA  L'&A
  5361. &L       MTC   &A,&X,FILL=&FILL,FILADDR=&FILADDR,N=&N
  5362.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&X)'
  5363.          MEXIT
  5364. .*
  5365. .NDLEN   ANOP
  5366. &L       MTCCLI &A,&FILL,&FILADDR
  5367.          AIF   ('&N' EQ '' OR '&N' EQ '*').STAR
  5368. .ONE     BNE   MTC&SYSNDX.A
  5369.          SYSXXC CLC,&A,&A,&C-1,D1=1,N=&N,BC=(BNE,MTC&SYSNDX.B)
  5370. MTC&SYSNDX.A DS 0H
  5371.          MEXIT
  5372. .*
  5373. .STAR    ANOP
  5374.          AIF   ('&C' EQ '').ONE
  5375. .CHECK   ANOP
  5376. &Y       SETA  &Y+1
  5377.          AIF   (&Y GT K'&C).OK
  5378.          AIF   ('&C'(&Y,1) LT '0').ONE
  5379.          AGO   .CHECK
  5380. .OK      ANOP
  5381. &X       SETA  &C-1
  5382.          AIF   (&X LE 0).END
  5383.          BNE   MTC&SYSNDX.A
  5384.          AIF   (&X EQ 1).ONE2
  5385.          SYSXXC CLC,&A,&A,&X,D1=1,N=*,BC=(BNE,MTC&SYSNDX.B)
  5386. MTC&SYSNDX.A DS 0H
  5387.          MEXIT
  5388. .*
  5389. .ONE2    ANOP
  5390.          MTCCLI &A,&FILL,&FILADDR,D=1
  5391. MTC&SYSNDX.A DS 0H
  5392.          MEXIT
  5393. .*
  5394. .NULL    ANOP
  5395. &L       CLI   *+1,0
  5396. .END     MEND
  5397. ./       ADD   LIST=ALL,NAME=MTCCLI
  5398.          MACRO
  5399. &L       MTCCLI &A,&FILL,&FILADDR,&D=0
  5400.          AIF   ('&FILADDR' NE '').FILADDR
  5401.          AIF   ('&A' EQ '').NREG
  5402.          AIF   ('&A'(1,1) NE '(').NREG
  5403. &L       CLI   &D&A,&FILL
  5404.          MEXIT
  5405. .*
  5406. .NREG    ANOP
  5407.          AIF   ('&D' EQ '0').ZD
  5408. &L       CLI   &D+&A,&FILL
  5409.          MEXIT
  5410. .*
  5411. .ZD      ANOP
  5412. &L       CLI   &A,&FILL
  5413.          MEXIT
  5414. .*
  5415. .FILADDR ANOP
  5416.          AIF   ('&A' EQ '').NREGFA
  5417.          AIF   ('&A'(1,1) NE '(').NREGFA
  5418. &L       CLC   &D.(1,&A),&FILADDR
  5419.          MEXIT
  5420. .*
  5421. .NREGFA  ANOP
  5422.          AIF   ('&D' EQ '0').ZDFA
  5423. &L       MCLC  &D+&A,&FILADDR,1
  5424.          MEXIT
  5425. .*
  5426. .ZDFA    ANOP
  5427. &L       MCLC  &A,&FILADDR,1
  5428.          MEND
  5429. ./       ADD   LIST=ALL,NAME=MTCL
  5430.          MACRO
  5431. &L       MTCL  &R,&A,&C,&S,&FILL=0,&FILADDR=,&INLINE=,&N=*
  5432.          GBLC  &CPU
  5433.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5434.          AIF   ('&CPU' EQ '360').S360
  5435. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  5436.          SYSLR &R+1,&C,ERR='LENGTH REQUIRED'
  5437.          AIF   ('&FILADDR' NE '').FILADDR
  5438.          AIF   ('&FILL' EQ '' OR '&FILL' EQ '0').Z370
  5439.          L     &S+1,=AL1(&FILL,0,0,0)
  5440.          AGO   .CLCL
  5441. .*
  5442. .FILADDR ANOP
  5443.          ICM   &S+1,8,&FILADDR
  5444. .CLCL    CLCL  &R,&S
  5445.          MEXIT
  5446. .*
  5447. .Z370    ANOP
  5448.          SLR   &S+1,&S+1
  5449.          CLCL  &R,&S
  5450.          MEXIT
  5451. .*
  5452. .*  360 LOOP
  5453. .*
  5454. .S360    ANOP
  5455.          AIF   ('&INLINE' EQ 'YES').INLINE
  5456.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').RZ
  5457. &L       SYSLR &R,&A,ERR='ADDRESS REQUIRED'
  5458.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5459.          BNP   MTC&SYSNDX.A
  5460.          MTCLC &R,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  5461. MTC&SYSNDX.A DS 0H
  5462.          MEXIT
  5463. .*
  5464. .RZ      ANOP
  5465. &L       SYSLR &S,&A
  5466.          SYSLR &R+1,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5467.          BNP   MTC&SYSNDX.A
  5468.          MTCLC &S,&R+1,MTC&SYSNDX.A,FILL=&FILL,FILADDR=&FILADDR
  5469. MTC&SYSNDX.A DS 0H
  5470.          MEXIT
  5471. .*
  5472. .*  INLINE
  5473. .*
  5474. .INLINE  ANOP
  5475. &L       MTC   &A,&C,FILL=&FILL,FILADDR=&FILADDR,N=&N
  5476.          MEND
  5477. ./       ADD   LIST=ALL,NAME=MTCLC
  5478.          MACRO
  5479. &L       MTCLC &A,&C,&LEND,&FILL=,&FILADDR=
  5480.          AIF   ('&FILADDR' EQ '').FILL
  5481. &L       CLC   0(1,&A),&FILADDR
  5482.          AGO   .BNE
  5483. .*
  5484. .FILL    ANOP
  5485. &L       CLI   0(&A),&FILL
  5486. .BNE     BNE   &LEND
  5487.          BCTR  &C,0
  5488.          LTR   &C,&C
  5489.          BNP   &LEND
  5490. MTC&SYSNDX.X C &C,=F'256'
  5491.          BNH   MTC&SYSNDX.Z
  5492.          CLC   1(256,&A),0(&A)
  5493.          BNE   &LEND
  5494.          LA    &A,256(,&A)
  5495.          S     &C,=F'256'
  5496.          B     MTC&SYSNDX.X
  5497. MTC&SYSNDX.Y CLC 1(0,&A),0(&A)
  5498. MTC&SYSNDX.Z BCTR &C,0
  5499.          EX    &C,MTC&SYSNDX.Y
  5500.          MEND
  5501. ./       ADD   LIST=ALL,NAME=MTR
  5502.          MACRO
  5503. &L       MTR   &A,&T,&C,&N=*,&ZERO=
  5504. &L       SYSXXC1 TR,&A,&T,&C,N=&N
  5505.          MEXIT
  5506. .*
  5507. .NULL    ANOP
  5508. &L       CLI   *+1,0
  5509.          MEND
  5510. ./       ADD   LIST=ALL,NAME=MTRL
  5511.          MACRO
  5512. &L       MTRL  &RA,&A,&T,&RC,&C,&INLINE=,&N=*
  5513.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5514.          AIF   ('&INLINE' EQ 'YES').INLINE
  5515. &L       SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
  5516.          SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5517.          BNP   TR&SYSNDX.D
  5518. TR&SYSNDX.A C  &RC,=F'256'
  5519.          BNH   TR&SYSNDX.C
  5520.          MTR   0(&RA),&T,256
  5521.          LA    &RA,256(,&RA)
  5522.          S     &RC,=F'256'
  5523.          B     TR&SYSNDX.A
  5524. TR&SYSNDX.B MTR 0(&RA),&T,0
  5525. TR&SYSNDX.C BCTR &RC,0
  5526.          EX    &RC,TR&SYSNDX.B
  5527. TR&SYSNDX.D DS 0H
  5528.          MEXIT
  5529. .*
  5530. .INLINE  ANOP
  5531. &L       MTR   &A,&C,&T,N=&N
  5532.          MEND
  5533. ./       ADD   LIST=ALL,NAME=MTRT
  5534.          MACRO
  5535. &L       MTRT  &A,&T,&C,&N=*,&ZERO=
  5536.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5537.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5538. &L       SYSXXC1 TRT,&A,&T,&C,N=&N,BC=BNZ
  5539.          MEXIT
  5540. .*
  5541. .NULL    ANOP
  5542. &L       CLI   *+1,0
  5543.          MEND
  5544. ./       ADD   LIST=ALL,NAME=MTRTL
  5545.          MACRO
  5546. &L       MTRTL &RA,&A,&T,&RC,&C,&INLINE=,&N=*
  5547.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5548.          AIF   ('&INLINE' EQ 'YES').INLINE
  5549. &L       SYSLR &RA,&A,ERR='ADDRESS REQUIRED'
  5550.          SYSLR &RC,&C,LTR=YES,ERR='LENGTH REQUIRED'
  5551.          BNP   TRT&SYSNDX.D
  5552. TRT&SYSNDX.A C &RC,=F'256'
  5553.          BNH   TRT&SYSNDX.C
  5554.          MTRT  0(&RA),&T,256
  5555.          BNZ   TRT&SYSNDX.D
  5556.          LA    &RA,256(,&RA)
  5557.          S     &RC,=F'256'
  5558.          B     TRT&SYSNDX.A
  5559. TRT&SYSNDX.B MTRT 0(&RA),&T,0
  5560. TRT&SYSNDX.C BCTR &RC,0
  5561.          EX    &RC,TRT&SYSNDX.B
  5562. TRT&SYSNDX.D DS 0H
  5563.          MEXIT
  5564. .*
  5565. .INLINE  ANOP
  5566. &L       MTRT  &A,&C,&T,N=&N
  5567.          MEND
  5568. ./       ADD   LIST=ALL,NAME=MXC
  5569.          MACRO
  5570. &L       MXC   &A,&B,&C,&N=*,&ZERO=
  5571.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5572.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5573. &L       SYSXXC XC,&A,&B,&C,N=&N
  5574.          MEXIT
  5575. .*
  5576. .NULL    ANOP
  5577. &L       SYSLBL
  5578.          MEND
  5579. ./       ADD   LIST=ALL,NAME=MXCL
  5580.          MACRO
  5581. &L       MXCL  &RA,&AA,&LA,&RB,&AB,&LB,&FILL=0,&FILADDR=,&INLINE=,&N=*
  5582.          SYSKWT INLINE,&INLINE,(YES,NO),COND=NO
  5583.          AIF   ('&LB' EQ '' OR '&LB' EQ '&LA').EQ
  5584. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5585.          SYSLR &RA+1,&LA,ERR='TO LENGTH REQUIRED'
  5586.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5587.          SYSLR &RB+1,&LB
  5588.          SR    &RA+1,&RB+1
  5589.          BNM   *+6
  5590.          AR    &RB+1,&RA+1
  5591.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').RAZ
  5592.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').RBZ
  5593.          LTR   &RB+1,&RB+1
  5594.          BNP   XC&SYSNDX.A
  5595.          MXCLN &RA,&RB,&RB+1
  5596.         AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').Z
  5597.          LA    &RA,1(&RA,&RB+1)
  5598. XC&SYSNDX.A LTR &RA+1,&RA+1
  5599.          BNP   XC&SYSNDX.B
  5600.          MXCLF &RA,&RA+1,FILL=&FILL,FILADDR=&FILADDR
  5601. XC&SYSNDX.B DS 0H
  5602.          MEXIT
  5603. .Z       ANOP
  5604. XC&SYSNDX.A DS 0H
  5605.          MEXIT
  5606. .*
  5607. .RAZ     ANOP
  5608.          XR    &RA,&RA+1
  5609.          XR    &RA+1,&RA
  5610.          XR    &RA,&RA+1
  5611.          LTR   &RB+1,&RB+1
  5612.          BNP   XC&SYSNDX.A
  5613.          MXCLN &RA+1,&RB,&RB+1
  5614.      AIF  (('&FILL' EQ '' OR '&FILL' EQ '0') AND '&FILADDR' EQ '').RAZZ
  5615.          LA    &RA+1,1(&RA+1,&RB+1)
  5616. XC&SYSNDX.A LTR &RB+1,&RA
  5617.          BNP   XC&SYSNDX.B
  5618.          MXCLF &RA+1,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5619. XC&SYSNDX.B DS 0H
  5620.          MEXIT
  5621. .RAZZ    ANOP
  5622. XC&SYSNDX.A DS 0H
  5623.          MEXIT
  5624. .*
  5625. .RBZ     ANOP
  5626.          XR    &RB,&RA+1
  5627.          XR    &RA+1,&RB
  5628.          XR    &RB,&RA+1
  5629.          LTR   &RB+1,&RB+1
  5630.          BNP   XC&SYSNDX.A
  5631.          MXCLN &RA,&RA+1,&RB+1
  5632.          LA    &RA,1(&RA,&RB+1)
  5633.          AIF   ('&FILL' EQ '0' AND '&FILADDR' EQ '').RBZZ
  5634. XC&SYSNDX.A LTR &RB+1,&RB
  5635.          BNP   XC&SYSNDX.B
  5636.          MXCLF &RA,&RB+1,FILL=&FILL,FILADDR=&FILADDR
  5637. XC&SYSNDX.B DS 0H
  5638.          MEXIT
  5639. .*
  5640. .RBZZ    ANOP
  5641. XC&SYSNDX.A DS 0H
  5642.          MEXIT
  5643. .*
  5644. .*   EQUAL LENGTH
  5645. .*
  5646. .EQ      ANOP
  5647.          AIF   ('&INLINE' EQ 'YES').MXC
  5648.          AIF   ('&RA' EQ '0' OR '&RA' EQ 'R0' OR '&RA' EQ 'VR0').EQRAZ
  5649.          AIF   ('&RB' EQ '0' OR '&RB' EQ 'R0' OR '&RB' EQ 'VR0').EQRBZ
  5650. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5651.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5652.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5653.          LTR   &RA+1,&RA+1
  5654.          BNP   XC&SYSNDX.A
  5655.          MXCLN &RA,&RB,&RA+1
  5656. XC&SYSNDX.A DS 0H
  5657.          MEXIT
  5658. .*
  5659. .EQRAZ   ANOP
  5660. &L       SYSLR &RB+1,&AA
  5661.          SYSLR &RB,&AB,ERR='FROM ADDRESS REQUIRED'
  5662.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5663.          BNP   XC&SYSNDX.A
  5664.          MXCLN &RB+1,&RB,&RA+1
  5665. XC&SYSNDX.A DS 0H
  5666.          MEXIT
  5667. .*
  5668. .EQRBZ   ANOP
  5669. &L       SYSLR &RA,&AA,ERR='TO ADDRESS REQUIRED'
  5670.          SYSLR &RB+1,&AB
  5671.          SYSLR &RA+1,&LA,LTR=YES,ERR='TO LENGTH REQUIRED'
  5672.          BNP   XC&SYSNDX.A
  5673.          MXCLN &RA,&RB+1,&RA+1
  5674. XC&SYSNDX.A DS 0H
  5675.          MEXIT
  5676. .*
  5677. .*  MXC
  5678. .*
  5679. .MXC     ANOP
  5680. &L       MXC   &AA,&AB,&LA,N=&N
  5681.          MEND
  5682. ./       ADD   LIST=ALL,NAME=MXCLN
  5683.          MACRO
  5684. &L       MXCLN &A,&B,&C
  5685.          LCLC  &LBL
  5686. &LBL     SETC  '&L'
  5687.          AIF   ('&L' NE '').LBL
  5688. &LBL     SETC  'XC&SYSNDX.X'
  5689. .LBL     ANOP
  5690. .*
  5691. &LBL     C     &C,=F'256'
  5692.          BNH   XC&SYSNDX.Z
  5693.          XC    0(256,&A),0(&A)
  5694.          LA    &A,256(,&A)
  5695.          LA    &B,256(,&B)
  5696.          S     &C,=F'256'
  5697.          B     &LBL
  5698. XC&SYSNDX.Y XC 0(0,&A),0(&A)
  5699. XC&SYSNDX.Z BCTR &C,0
  5700.          EX    &C,XC&SYSNDX.Y
  5701.          MEND
  5702. ./       ADD   LIST=ALL,NAME=MXCLF
  5703.          MACRO
  5704. &L       MXCLF &A,&C,&FILL=,&FILADDR=
  5705.          AIF   ('&FILADDR' EQ '').FILL
  5706. &L       XC    0(1,&A),&FILADDR
  5707.          LA    &A,1(,&A)
  5708.          BCT   &C,*-10
  5709.          MEXIT
  5710. .*
  5711. .FILL    ANOP
  5712. &L       XI    0(&A),&FILL
  5713.          LA    &A,1(,&A)
  5714.          BCT   &C,*-8
  5715.          MEND
  5716. ./       ADD   LIST=ALL,NAME=MZC
  5717.          MACRO
  5718. &L       MZC   &A,&C,&N=*,&ZERO=
  5719.          SYSKWT ZERO,&ZERO,(NULL),COND=NO
  5720.          AIF   ('&ZERO' EQ 'NULL' AND ('&C' EQ '0' OR '&C' EQ '')).NULL
  5721. &L       SYSXXC XC,&A,&A,&C,N=&N
  5722.          MEXIT
  5723. .*
  5724. .NULL    ANOP
  5725. &L       SYSLBL
  5726.          MEND
  5727. ./       ADD   LIST=ALL,NAME=MZCL
  5728.          MACRO
  5729. &L       MZCL  &R,&A,&C,&S,&INLINE=,&N=*
  5730. &L       MFCL  &R,&A,&C,&S,FILL=0,INLINE=&INLINE,N=&N
  5731.          MEND
  5732. ./       ADD   LIST=ALL,NAME=NAT
  5733.          MACRO
  5734.          NAT
  5735. *
  5736. *  NIH/COMMON - NUCLEUS ADDRESS TABLE
  5737. *
  5738. NATSTART DS    0F
  5739. NATIBMT  DC    V(IBMORG)               FIRST SVC TABLE ENTRY
  5740. NATUSERT DC    V(USERORG)              FIRST USER SVC ENTRY
  5741. NATTYPE1 DC    V(IEATYPE1)             TYPE 1 SVC SWITCH
  5742. NATSCSAV DC    V(IEASCSAV)             SVC SAVE AREA
  5743. NATINT   DC    V(IECINT)               ENTRY TO IOS FOR I/O INTERRUPT
  5744. NATDISMS DC    V(DISMISS)              RETURN POINT FROM IOS TO IO FLIH
  5745. NATIORG  DC    V(IORGSW)               I/O INTERRUPT IN IOS SWITCH
  5746. NATQIO00 DC    V(IEAQIO00)             I/O 1ST LEVEL INTERRUPT HANDLER
  5747. *
  5748.          DS    0F
  5749. NATSIZE  EQU   *-NATSTART              SIZE OF NAT
  5750.          MEND
  5751. ./       ADD   LIST=ALL,NAME=OPENP
  5752.          MACRO
  5753. &L       OPENP &DCB
  5754.          AIF   ('&DCB' EQ '').NULL
  5755.          AIF   ('&DCB'(1,1) EQ '(').REG
  5756. &L       TM    (DCBOFLGS-IHADCB)+&DCB,X'10'
  5757.          MEXIT
  5758. .*
  5759. .REG     ANOP
  5760. &L       TM    (DCBOFLGS-IHADCB)+0&DCB,X'10'
  5761.          MEXIT
  5762. .*
  5763. .NULL    ANOP
  5764. &L       SYSLBL
  5765.          MNOTE 12,'NO DCB SPECIFIED'
  5766.          MEND
  5767. ./       ADD   LIST=ALL,NAME=ORGHIGH
  5768. ALP;
  5769.  
  5770. MACRO &&L: ORGHIGH &&A,&&B,&&BASE=;
  5771.    LCLA &&X;
  5772.  
  5773.    &&L: SYSLBL;
  5774.    ORG &&A+(&&B-&&A)*((&&B+1-&&BASE)/(&&A+1-&&BASE))/((&&B+1-&&BASE)/_
  5775.        (&&A+1-&&BASE));
  5776.  
  5777.    ASM FOR &&X FROM 3 TO N'&&SYSLIST
  5778.    DO ORGHIGH *,&&SYSLIST(&&X),BASE=&&BASE;
  5779.    MEND;
  5780.  
  5781. BAL;
  5782. ./       ADD   LIST=ALL,NAME=OSCALL
  5783.          MACRO
  5784. &L       OSCALL &R,&TYPE,&VRF=,&VR0=,&VR1=,&R15=,&R0=,&R1=,&RCR=,      *
  5785.                &PARAM=,&VL=,&PARAMA=,&PARAML=,&CC=,&TEST=,&CHECK=
  5786.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  5787.          GBLC  &OS
  5788.          LCLA  &X,&Y,&Z
  5789.          LCLC  &LBL,&EP
  5790.          SYSKWT TYPE,&TYPE,(A,V),COND=NO
  5791.          SYSKWT TEST,&TEST,(YES,NO),COND=NO
  5792.          SYSKWT CC,&CC,(YES,NO),COND=NO
  5793. &LBL     SETC  '&L'
  5794. &EP      SETC  '&#R15'
  5795. .*
  5796.          AIF   ('&VRF&R15&RCR' EQ '').NVRF
  5797. &EP      SETC  '&#R14'
  5798.          AIF   ('&VRF&R15&RCR' EQ '(&#R15)').NVRF
  5799. &LBL     SYSLR &#R15,&VRF&R15&RCR
  5800. &LBL     SETC  ''
  5801. .NVRF    ANOP
  5802. .*
  5803.          AIF   ('&VR0&R0' EQ '' OR '&VR0&R0' EQ '(&#R0)').NVR0
  5804. &LBL     SYSLR &#R0,&VR0&R0
  5805. &LBL     SETC  ''
  5806. .NVR0    ANOP
  5807. .*
  5808.          AIF   ('&VR1&R1' EQ '' OR '&VR1&R1' EQ '(&#R1)').NVR1
  5809. &LBL     SYSLR &#R1,&VR1&R1
  5810. &LBL     SETC  ''
  5811. .NVR1    ANOP
  5812. .*
  5813.          AIF   ('&PARAM' EQ '').NPARAM
  5814.          AIF   ('&PARAMA' NE '').PARAMA
  5815. &X       SETA  0
  5816. &Y       SETA  0-4
  5817. .PLOOP   ANOP
  5818. &X       SETA  &X+1
  5819. &Y       SETA  &Y+4
  5820.          AIF   (&X GT N'&PARAM).PDONE
  5821. &LBL     SYSLST &Y.(,&#R13),NEW=&PARAM(&X),REG=&#R1
  5822. &LBL     SETC  ''
  5823.          AIF   ('&VL' EQ '').PLOOP
  5824.          AIF   (&X NE N'&PARAM).PLOOP
  5825.          OI    &Y.(&#R13),X'80'
  5826.          AGO   .PLOOP
  5827. .*
  5828. .PDONE   ANOP
  5829.          CPUSH &#R1,&Y
  5830.          AGO   .PCHECK
  5831. .*
  5832. .PARAMA  ANOP
  5833. &X       SETA  0
  5834. &Z       SETA  0-4
  5835. .PLOOPA  ANOP
  5836. &X       SETA  &X+1
  5837. &Z       SETA  &Z+4
  5838.          AIF   (&X GT N'&PARAM).PDONEA
  5839. &LBL     SYSLST &Z+&PARAMA,NEW=&PARAM(&X),REG=&#R1
  5840. &LBL     SETC  ''
  5841.          AIF   ('&VL' EQ '').PLOOPA
  5842.          AIF   (&X NE N'&PARAM).PLOOPA
  5843.          OI    &Z+&PARAMA,X'80'
  5844.          AGO   .PLOOPA
  5845. .*
  5846. .PDONEA  ANOP
  5847.          LA    &#R1,&PARAMA
  5848.          AIF   ('&PARAML' EQ '').PCHECK
  5849.       SYSCMP &Z,LE,&PARAML,MSG='ERROR BELOW IF PARAMETER LIST TOO LONG'
  5850. .*
  5851. .PCHECK  ANOP
  5852.          AIF   ('&VR1&R1' EQ '').NPARAM
  5853.          MNOTE 12,'BOTH &#R1 AND PARAM SPECIFIED'
  5854. .*
  5855. .NPARAM  ANOP
  5856. .*
  5857.          AIF   ('&R'(1,1) EQ '(').REG
  5858.          AIF   ('&TYPE' EQ 'A').A
  5859. &LBL     L     &EP,=V(&R)
  5860.          AGO   .BALR
  5861. .*
  5862. .A       ANOP
  5863. &LBL     L     &EP,=A(&R)
  5864.          AGO   .BALR
  5865. .*
  5866. .REG     ANOP
  5867.          AIF   ('&EP' EQ '&#R14').REG14
  5868. &LBL     SYSLR &EP,&R
  5869.          AGO   .BALR
  5870. .*
  5871. .REG14   ANOP
  5872. &EP      SETC  '&R(1)'
  5873. &LBL     SYSLBL
  5874. .*
  5875. .BALR    ANOP
  5876.          AIF   ('&TEST' NE 'YES').NTEST
  5877.          LTR   &EP,&EP
  5878.          BZ    *+6
  5879. .NTEST   ANOP
  5880.          CBALR &#R14,&EP
  5881.          AIF   (&Y LE 0).END
  5882.          AIF   ('&CC' EQ 'NO').POP
  5883.          AIF   ('&OS' EQ 'XA').IPM
  5884.          BALR  &#R14,0
  5885.          AGO   .POP
  5886. .*
  5887. .IPM     ANOP
  5888.          IPM   &#R14
  5889. .POP     ANOP
  5890.          CPOP  ,&Y
  5891.          AIF   ('&CC' EQ 'NO').END
  5892.          SPM   &#R14
  5893. .END     MEND
  5894. ./       ADD   LIST=ALL,NAME=OSENTER
  5895.          MACRO
  5896. &L       OSENTER &ENTRY=,&BASE=,&SAVE=,&PACK=,&ID=,&FORWARD=
  5897.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  5898.          LCLA  &X
  5899.          LCLC  &LBL
  5900.          LCLC  &LENSYM,&LENSYM2
  5901.          LCLA  &LENCNT
  5902. .*
  5903.          SYSKWT ENTRY,&ENTRY,(YES,NO),COND=NO
  5904.          SYSKWT BASE,&BASE,(YES,NO),COND=NO
  5905.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  5906.          SYSKWT FORWARD,&FORWARD,(YES,NO),COND=NO
  5907. .*
  5908. &LBL     SETC  '&L'
  5909. .*
  5910.          AIF   ('&ENTRY' EQ 'NO' OR '&L' EQ '').NENTRY
  5911.          AIF   ('&L'(1,1) EQ '@').NENTRY
  5912.          ENTRY &L
  5913. .NENTRY  ANOP
  5914. .*
  5915.          AIF   ('&ID' EQ '').NOID
  5916.          AIF   ('&ID' EQ '*' AND '&L&SYSECT' EQ '').NOID
  5917. &LBL     B     OSE&SYSNDX.B-*(&#R15)
  5918. &LBL     SETC  'OSE&SYSNDX.B'
  5919.          DC    AL1(L'OSE&SYSNDX.A)
  5920.          AIF   ('&ID' EQ '*').IDSTAR
  5921.          AIF   ('&ID'(1,1) EQ '''').IDSTR
  5922. OSE&SYSNDX.A DC C'&ID'
  5923.          AGO   .NOID
  5924. .*
  5925. .IDSTR   ANOP
  5926. OSE&SYSNDX.A DC C&ID
  5927.          AGO   .NOID
  5928. .*
  5929. .IDSTAR  ANOP
  5930.          AIF   ('&L' EQ '').IDCSECT
  5931. OSE&SYSNDX.A DC C'&L'
  5932.          AGO   .NOID
  5933. .*
  5934. .IDCSECT ANOP
  5935. OSE&SYSNDX.A DC C'&SYSECT'
  5936. .*
  5937. .NOID    ANOP
  5938. .*
  5939.          AIF   ('&PACK' EQ 'YES').PACK
  5940. .LOOP    ANOP
  5941. &X       SETA  &X+1
  5942.          AIF   (&X GT N'&SYSLIST).DONE
  5943.          AIF   (N'&SYSLIST(&X) GE 2).STM
  5944. &LBL ST &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,&#R13)
  5945. &LBL     SETC  ''
  5946.          AGO   .LOOP
  5947. .STM     ANOP
  5948. &LBL     STM   &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
  5949.                YSLIST(&X,1))/14))*4(&#R13)
  5950. &LBL     SETC  ''
  5951.          AGO   .LOOP
  5952. .*
  5953. .PACK    ANOP
  5954. &LENSYM  SETC  '12'
  5955. .*
  5956. .PLOOP   ANOP
  5957. &X       SETA  &X+1
  5958.          AIF   (&X GT N'&SYSLIST).DONE
  5959.          AIF   (N'&SYSLIST(&X) GE 2).PSTM
  5960. &LBL     ST    &SYSLIST(&X),&LENSYM.(,&#R13)
  5961. &LBL     SETC  ''
  5962.          AIF   (&X EQ N'&SYSLIST).DONE
  5963. &LENCNT  SETA  &LENCNT+1
  5964. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  5965. &LENSYM2 EQU   &LENSYM+4
  5966. &LENSYM  SETC  '&LENSYM2'
  5967.          AGO   .PLOOP
  5968. .*
  5969. .PSTM    ANOP
  5970. &LBL     STM   &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(&#R13)
  5971. &LBL     SETC  ''
  5972.          AIF   (&X EQ N'&SYSLIST).DONE
  5973. &LENCNT  SETA  &LENCNT+1
  5974. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  5975. &LENSYM2 EQU   &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
  5976.                X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
  5977.                &X,2)))+1)
  5978. &LENSYM  SETC  '&LENSYM2'
  5979.          AGO   .PLOOP
  5980. .*
  5981. .DONE    ANOP
  5982. .*
  5983.          AIF   ('&BASE' EQ 'NO').NBASE
  5984. &LBL     CBASE &#BASER
  5985. &LBL     SETC  ''
  5986.          USING *,&#BASER
  5987. .NBASE   ANOP
  5988. .*
  5989.          AIF   ('&SAVE' EQ '').NSAVE
  5990.          AIF   ('&FORWARD' EQ 'YES').FORWARD
  5991. &LBL     ST    &#R13,&SAVE+4
  5992. &LBL     SETC  ''
  5993.          LA    &#R13,&SAVE
  5994.          AGO   .NSAVE
  5995. .*
  5996. .FORWARD ANOP
  5997. &LBL     SYSLR &#R14,&SAVE
  5998. &LBL     SETC  ''
  5999.          ST    &#R13,4(,&#R14)
  6000.          ST    &#R14,8(,&#R13)
  6001.          LR    &#R13,&#R14
  6002. .NSAVE   ANOP
  6003. .*
  6004. &LBL     SYSLBL
  6005.          MEND
  6006. ./       ADD   LIST=ALL,NAME=OSEXIT
  6007.          MACRO
  6008. &L       OSEXIT &SAVE=,<R=,&PACK=,&RC=,&FLAG=NO,&BRANCH=
  6009.          GBLC  &#R15,&#R14,&#R13,&#BASER,&#R1,&#R0
  6010.          LCLA  &X
  6011.          LCLC  &LBL
  6012.          LCLC  &LENSYM,&LENSYM2
  6013.          LCLA  &LENCNT
  6014. .*
  6015.          SYSKWT LTR,<R,(&#R0,&#R1,&#R15,R0,R1,R15),COND=NO
  6016.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  6017.          SYSKWT FLAG,&FLAG,(YES,NO),COND=NO
  6018.          SYSKWT BRANCH,&BRANCH,(YES,NO),COND=NO
  6019. .*
  6020. &LBL     SETC  '&L'
  6021. .*
  6022.          AIF   ('&SAVE' EQ '').NSAVE
  6023. &LBL     L     &#R13,4+&SAVE
  6024. &LBL     SETC  ''
  6025. .NSAVE   ANOP
  6026. .*
  6027.          AIF   ('&PACK' EQ 'YES').PACK
  6028. .LOOP    ANOP
  6029. &X       SETA  &X+1
  6030.          AIF   (&X GT N'&SYSLIST).DONE
  6031.          AIF   (N'&SYSLIST(&X) GE 2).LM
  6032. &LBL  L &SYSLIST(&X),20+(&SYSLIST(&X)-16*((&SYSLIST(&X))/14))*4(,&#R13)
  6033. &LBL     SETC  ''
  6034.          AGO   .LOOP
  6035. .LM      ANOP
  6036. &LBL     LM    &SYSLIST(&X,1),&SYSLIST(&X,2),20+(&SYSLIST(&X,1)-16*((&S*
  6037.                YSLIST(&X,1))/14))*4(&#R13)
  6038. &LBL     SETC  ''
  6039.          AGO   .LOOP
  6040. .*
  6041. .PACK    ANOP
  6042. &LENSYM  SETC  '12'
  6043. .*
  6044. .PLOOP   ANOP
  6045. &X       SETA  &X+1
  6046.          AIF   (&X GT N'&SYSLIST).DONE
  6047.          AIF   (N'&SYSLIST(&X) GE 2).PLM
  6048. &LBL     L     &SYSLIST(&X),&LENSYM.(,&#R13)
  6049. &LBL     SETC  ''
  6050.          AIF   (&X EQ N'&SYSLIST).DONE
  6051. &LENCNT  SETA  &LENCNT+1
  6052. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  6053. &LENSYM2 EQU   &LENSYM+4
  6054. &LENSYM  SETC  '&LENSYM2'
  6055.          AGO   .PLOOP
  6056. .*
  6057. .PLM     ANOP
  6058. &LBL     LM    &SYSLIST(&X,1),&SYSLIST(&X,2),&LENSYM.(&#R13)
  6059. &LBL     SETC  ''
  6060.          AIF   (&X EQ N'&SYSLIST).DONE
  6061. &LENCNT  SETA  &LENCNT+1
  6062. &LENSYM2 SETC  'OSE&SYSNDX'.'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(&LENCNT,1)
  6063. &LENSYM2 EQU   &LENSYM+4*(&SYSLIST(&X,2)-&SYSLIST(&X,1)+16*((&SYSLIST(&*
  6064.                X,1)+1)/(&SYSLIST(&X,2)))/((&SYSLIST(&X,1)+1)/(&SYSLIST(*
  6065.                &X,2)))+1)
  6066. &LENSYM  SETC  '&LENSYM2'
  6067.          AGO   .PLOOP
  6068. .*
  6069. .DONE    ANOP
  6070. .*
  6071.          AIF   ('&FLAG' NE 'YES').NFLAG
  6072. &LBL     MVI   12(&#R13),X'FF'
  6073. &LBL     SETC  ''
  6074. .NFLAG   ANOP
  6075. .*
  6076.          AIF   ('&RC' EQ '').NRC
  6077. &LBL     SYSLR &#R15,&RC
  6078. &LBL     SETC  ''
  6079. .NRC     ANOP
  6080. .*
  6081.          AIF   ('<R' EQ '').NLTR
  6082. &LBL     LTR   <R,<R
  6083. &LBL     SETC  ''
  6084. .NLTR    ANOP
  6085. .*
  6086.          AIF   ('&BRANCH' EQ 'NO').NBRANCH
  6087. &LBL     BR    &#R14
  6088. &LBL     SETC  ''
  6089. .NBRANCH ANOP
  6090. .*
  6091. &LBL     SYSLBL
  6092.          MEND
  6093. ./       ADD   LIST=ALL,NAME=OSREGPLI
  6094.          MACRO
  6095.          OSREGPLI
  6096. *
  6097. *  REGISTER USAGE
  6098. *
  6099. *    ABSOLUTE REGISTER DEFINITIONS
  6100. *
  6101. R0       EQU   0
  6102. R1       EQU   1
  6103. R2       EQU   2
  6104. R3       EQU   3
  6105. R4       EQU   4
  6106. R5       EQU   5
  6107. R6       EQU   6
  6108. R7       EQU   7
  6109. R8       EQU   8
  6110. R9       EQU   9
  6111. R10      EQU   10
  6112. R11      EQU   11
  6113. R12      EQU   12
  6114. R13      EQU   13
  6115. R14      EQU   14
  6116. R15      EQU   15
  6117. *
  6118. *    SYMBOLIC REGISTER DEFINITIONS
  6119. *
  6120. VR0      EQU   0                       PARAMETER REGISTER
  6121. VR1      EQU   1                       PARAMETER REGISTER
  6122. XRA      EQU   2                       WORK REGISTER
  6123. XRB      EQU   3                       WORK REGISTER
  6124. XRC      EQU   4                       WORK REGISTER
  6125. XRD      EQU   5                       WORK REGISTER
  6126. XRE      EQU   6                       WORK REGISTER
  6127. XRF      EQU   7                       WORK REGISTER
  6128. XRG      EQU   8                       WORK REGISTER
  6129. XRH      EQU   9                       WORK REGISTER
  6130. XRI      EQU   10                      WORK REGISTER
  6131. BASER    EQU   11                      BASE REGISTER
  6132. GCBR     EQU   12                      GLOBAL CONTROL BLOCK REGISTER
  6133. SAVER    EQU   13                      SAVE AREA REGISTER
  6134. RTNR     EQU   14                      RETURN ADDRESS REGISTER
  6135. RCR      EQU   15                      RETURN CODE REGISTER
  6136. *
  6137. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  6138. HIGHR    EQU   BASER                   HIGHEST REGISTER TO SAVE
  6139.          MEND
  6140. ./       ADD   LIST=ALL,NAME=OSREGS
  6141.          MACRO
  6142.          OSREGS
  6143. *
  6144. *  REGISTER USAGE
  6145. *
  6146. *    ABSOLUTE REGISTER DEFINITIONS
  6147. *
  6148. R0       EQU   0
  6149. R1       EQU   1
  6150. R2       EQU   2
  6151. R3       EQU   3
  6152. R4       EQU   4
  6153. R5       EQU   5
  6154. R6       EQU   6
  6155. R7       EQU   7
  6156. R8       EQU   8
  6157. R9       EQU   9
  6158. R10      EQU   10
  6159. R11      EQU   11
  6160. R12      EQU   12
  6161. R13      EQU   13
  6162. R14      EQU   14
  6163. R15      EQU   15
  6164. *
  6165. *    SYMBOLIC REGISTER DEFINITIONS
  6166. *
  6167. VR0      EQU   0                       PARAMETER REGISTER
  6168. VR1      EQU   1                       PARAMETER REGISTER
  6169. XRA      EQU   2                       WORK REGISTER
  6170. XRB      EQU   3                       WORK REGISTER
  6171. XRC      EQU   4                       WORK REGISTER
  6172. XRD      EQU   5                       WORK REGISTER
  6173. XRE      EQU   6                       WORK REGISTER
  6174. XRF      EQU   7                       WORK REGISTER
  6175. XRG      EQU   8                       WORK REGISTER
  6176. XRH      EQU   9                       WORK REGISTER
  6177. XRI      EQU   10                      WORK REGISTER
  6178. XRJ      EQU   11                      WORK REGISTER
  6179. BASER    EQU   12                      BASE REGISTER
  6180. SAVER    EQU   13                      SAVE AREA REGISTER
  6181. RTNR     EQU   14                      RETURN ADDRESS REGISTER
  6182. RCR      EQU   15                      RETURN CODE REGISTER
  6183. *
  6184. LOWR     EQU   XRA                     LOWEST REGISTER TO SAVE
  6185. HIGHR    EQU   BASER                   HIGHEST REGISTER TO SAVE
  6186.          MEND
  6187. ./       ADD   LIST=ALL,NAME=OSSA
  6188.          MACRO
  6189. &L       OSSA  &PACK=,&EQU=
  6190.          GBLA  &OSSACNT
  6191.          LCLA  &X,&Y
  6192.          LCLC  &LBL,&EQUL1,&EQUL2
  6193. .*
  6194.          SYSKWT PACK,&PACK,(YES,NO),COND=NO
  6195. .*
  6196. &LBL     SETC  '&L'
  6197.          AIF   ('&LBL' NE '').LBLOK
  6198. &LBL     SETC  'OSSA&SYSNDX'
  6199. .LBLOK   ANOP
  6200. .*
  6201.          AIF   ('&PACK' EQ 'YES').PACK
  6202. &LBL     DC    18A(0)
  6203.          AIF   ('&EQU' EQ '').END
  6204. &Y       SETA  0-1
  6205. .EQU     ANOP
  6206. &Y       SETA  &Y+2
  6207.          AIF   (&Y GT N'&EQU).END
  6208. &EQU(&Y) EQU   &LBL+12+4*(&EQU(&Y+1)-14+16*((14/(&EQU(&Y+1)+1))/(14/(&E*
  6209.                QU(&Y+1)+1))))
  6210.          AGO   .EQU
  6211. .*
  6212. .PACK    ANOP
  6213. &LBL     DC    3A(0)
  6214. .*
  6215. .PACKGO  ANOP
  6216. &X       SETA  &X+1
  6217.          AIF   (&X GT N'&SYSLIST).PACKEQU
  6218.          AIF   (N'&SYSLIST(&X) EQ 1).ONE
  6219.          DC    (&SYSLIST(&X,2)+1-&SYSLIST(&X,1)+16*(((&SYSLIST(&X,1))/(*
  6220.                &SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))*
  6221.                ))A(0)
  6222.          AGO   .PACKGO
  6223. .*
  6224. .ONE     ANOP
  6225.          DC    A(0)
  6226.          AGO   .PACKGO
  6227. .*
  6228. .PACKEQU ANOP
  6229.          AIF   ('&EQU' EQ '').END
  6230. &Y       SETA  0-1
  6231. .PEQU1   ANOP
  6232. &Y       SETA  &Y+2
  6233.          AIF   (&Y GT N'&EQU).END
  6234. &OSSACNT SETA  &OSSACNT+1
  6235. OSSA&OSSACNT.A EQU &LBL+12
  6236. &EQUL1   SETC  '0'
  6237. &EQUL2   SETC  'OSSA&OSSACNT.A'
  6238. &X       SETA  0
  6239. .PEQU2   ANOP
  6240. &X       SETA  &X+1
  6241.          AIF   (&X GT N'&SYSLIST).PDONE
  6242. &OSSACNT SETA  &OSSACNT+1
  6243.          AIF   (N'&SYSLIST(&X) LE 1).PONE
  6244. OSSA&OSSACNT.A EQU 4*(&EQU(&Y+1)-&SYSLIST(&X,1))
  6245. OSSA&OSSACNT.B EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6246.                LIST(&X,1))))*(((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIS*
  6247.                T(&X,2))/(&EQU(&Y+1))))
  6248. OSSA&OSSACNT.C EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1))+16)
  6249. OSSA&OSSACNT.D EQU (((&SYSLIST(&X,2))/(&EQU(&Y+1)))/((&SYSLIST(&X,2))/(*
  6250.                &EQU(&Y+1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
  6251.                SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
  6252. OSSA&OSSACNT.E EQU 4*(&EQU(&Y+1)-(&SYSLIST(&X,1)))
  6253. OSSA&OSSACNT.F EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6254.                LIST(&X,1))))*(((&SYSLIST(&X,1))/(&SYSLIST(&X,2)+1))/((&*
  6255.                SYSLIST(&X,1))/(&SYSLIST(&X,2)+1)))
  6256. OSSA&OSSACNT.G EQU 4*(&SYSLIST(&X,2)+1-(&SYSLIST(&X,1))+16*(((&SYSLIST(*
  6257.                &X,1))/(&SYSLIST(&X,2)+1))/((&SYSLIST(&X,1))/(&SYSLIST(&*
  6258.                X,2)+1))))
  6259. OSSA&OSSACNT.H EQU &EQUL1+OSSA&OSSACNT.B+OSSA&OSSACNT.D+OSSA&OSSACNT.F
  6260. OSSA&OSSACNT.I EQU &EQUL2+(OSSA&OSSACNT.A*OSSA&OSSACNT.B+OSSA&OSSACNT.C*
  6261.                *OSSA&OSSACNT.D+OSSA&OSSACNT.E*OSSA&OSSACNT.F)*(1-&EQUL1*
  6262.                )+OSSA&OSSACNT.G*(1-OSSA&OSSACNT.H)
  6263. &EQUL1   SETC  'OSSA&OSSACNT.H'
  6264. &EQUL2   SETC  'OSSA&OSSACNT.I'
  6265.          AGO   .PEQU2
  6266. .*
  6267. .PONE    ANOP
  6268. OSSA&OSSACNT.A EQU (((&EQU(&Y+1))/(&SYSLIST(&X,1)))/((&EQU(&Y+1))/(&SYS*
  6269.                LIST(&X,1))))*(((&SYSLIST(&X,1))/(&EQU(&Y+1)))/((&SYSLIS*
  6270.                T(&X,1))/(&EQU(&Y+1))))
  6271. OSSA&OSSACNT.B EQU &EQUL1+OSSA&OSSACNT.A*(1-&EQUL1)
  6272. OSSA&OSSACNT.C EQU &EQUL2+4*(1-OSSA&OSSACNT.B)
  6273. &EQUL1   SETC  'OSSA&OSSACNT.B'
  6274. &EQUL2   SETC  'OSSA&OSSACNT.C'
  6275.          AGO   .PEQU2
  6276. .*
  6277. .PDONE   ANOP
  6278.         SYSCMP &EQUL1,EQ,1,MSG='ERROR BELOW IF &EQU(&Y+1) OUT OF RANGE'
  6279. &EQU(&Y) EQU   &EQUL2
  6280.          AGO   .PEQU1
  6281. .END     MEND
  6282. ./       ADD   LIST=ALL,NAME=OSSETUP
  6283.          MACRO
  6284. &L       OSSETUP ®S=YES,&CBS=YES,                                   *
  6285.                &MDC=NO,&CVT=NO,&DCB=NO,&DEB=NO,&UCB=NO,&DECB=NO,       *
  6286.                &NAT=NO,&SCT=NO,&TCB=NO,&CDE=NO,&PQE=NO,&RB=NO,         *
  6287.                &ASCB=NO,&S99=NO,&ACB=NO,&RPL=NO,&LRC=NO,&SSOB=NO,      *
  6288.                &SDWA=NO,&JESCT=NO,&PSA=NO,&PCCA=NO,&TQE=NO,&LLE=NO,    *
  6289.                &ASXB=NO,                                               *
  6290.                &R15=RCR,&R14=RTNR,&R13=SAVER,&BASER=BASER,             *
  6291.                &R1=VR1,&R0=VR0
  6292. .*
  6293. &L       CSETUP REGS=NO,SCABBRS=NO,CBS=&CBS,                           *
  6294.                MDC=&MDC,CVT=&CVT,DCB=&DCB,DEB=&DEB,UCB=&UCB,DECB=&DECB,*
  6295.                NAT=&NAT,SCT=&SCT,TCB=&TCB,CDE=&CDE,PQE=&PQE,RB=&RB,    *
  6296.                ASCB=&ASCB,S99=&S99,ACB=&ACB,RPL=&RPL,LRC=&LRC,         *
  6297.                SSOB=&SSOB,SDWA=&SDWA,JESCT=&JESCT,PSA=&PSA,PCCA=&PCCA, *
  6298.                TQE=&TQE,LLE=&LLE,ASXB=&ASXB,                           *
  6299.                R15=&R15,R14=&R14,R13=&R13,BASER=&BASER,R1=&R1,R0=&R0
  6300. .*
  6301.          AIF   ('®S' EQ 'NO').NREGS
  6302.          AIF   ('®S' EQ 'PLI').PLIREGS
  6303.          OSREGS
  6304.          AGO   .NREGS
  6305. .*
  6306. .PLIREGS ANOP
  6307.          OSREGPLI
  6308. .NREGS   ANOP
  6309.          MEND
  6310. ./       ADD   LIST=ALL,NAME=RM
  6311.          MACRO
  6312. &L       RM    &R
  6313. &L       LTR   &R,&R
  6314.          MEND
  6315. ./       ADD   LIST=ALL,NAME=RMP
  6316.          MACRO
  6317. &L       RMP   &R
  6318. &L       LTR   &R,&R
  6319.          MEND
  6320. ./       ADD   LIST=ALL,NAME=RMZ
  6321.          MACRO
  6322. &L       RMZ   &R
  6323. &L       LTR   &R,&R
  6324.          MEND
  6325. ./       ADD   LIST=ALL,NAME=RNM
  6326.          MACRO
  6327. &L       RNM   &R
  6328. &L       LTR   &R,&R
  6329.          MEND
  6330. ./       ADD   LIST=ALL,NAME=RNMP
  6331.          MACRO
  6332. &L       RNMP  &R
  6333. &L       LTR   &R,&R
  6334.          MEND
  6335. ./       ADD   LIST=ALL,NAME=RNMZ
  6336.          MACRO
  6337. &L       RNMZ  &R
  6338. &L       LTR   &R,&R
  6339.          MEND
  6340. ./       ADD   LIST=ALL,NAME=RNP
  6341.          MACRO
  6342. &L       RNP   &R
  6343. &L       LTR   &R,&R
  6344.          MEND
  6345. ./       ADD   LIST=ALL,NAME=RNZ
  6346.          MACRO
  6347. &L       RNZ   &R
  6348. &L       LTR   &R,&R
  6349.          MEND
  6350. ./       ADD   LIST=ALL,NAME=RNZP
  6351.          MACRO
  6352. &L       RNZP  &R
  6353. &L       LTR   &R,&R
  6354.          MEND
  6355. ./       ADD   LIST=ALL,NAME=RP
  6356.          MACRO
  6357. &L       RP    &R
  6358. &L       LTR   &R,&R
  6359.          MEND
  6360. ./       ADD   LIST=ALL,NAME=RZ
  6361.          MACRO
  6362. &L       RZ    &R
  6363. &L       LTR   &R,&R
  6364.          MEND
  6365. ./       ADD   LIST=ALL,NAME=RZP
  6366.          MACRO
  6367. &L       RZP   &R
  6368. &L       LTR   &R,&R
  6369.          MEND
  6370. ./       ADD   LIST=ALL,NAME=SCABBR
  6371.          MACRO
  6372.          SCABBR &W
  6373.          GBLC  &SCABWRD(400),&SCABWDF(400),&SCABABR(500),&SCABABF(500)
  6374.          GBLA  &SCABP(400),&SCABC(400),&SCABN,&SCABAN
  6375.          GBLB  &SCABAC(500)
  6376.          LCLA  &X
  6377.          LCLC  &A,&B
  6378. .*
  6379.          AIF   ('&W' EQ '').END
  6380. .*
  6381.          AIF   (&SCABN LT 400).ROOM
  6382.          MNOTE 12,'SCABBR WORD TABLE IS FULL'
  6383.          MEXIT
  6384. .*
  6385. .ROOM    ANOP
  6386.          AIF   ('&W'(1,1) EQ '''').Q
  6387. .*
  6388.          AIF   (&SCABN LE 0).NTEST
  6389. &A       SETC  '''&W''                '(1,16)
  6390.          AIF   (K'&W LE 14).OK
  6391. &A       SETC  '&A'(1,15).''''
  6392. .OK      ANOP
  6393. &B       SETC  '&SCABWRD(&SCABN)                '(1,16)
  6394.          AIF   ('&A' GT '&B').NTEST
  6395.          MNOTE 12,'WORD BELOW IS OUT OF ORDER'
  6396.          MNOTE 12,'&W'
  6397.          MEXIT
  6398. .*
  6399. .NTEST   ANOP
  6400.          AIF   (N'&SYSLIST LE 1).END
  6401. &SCABN   SETA  &SCABN+1
  6402. &SCABWDF(&SCABN) SETC '''&W'''
  6403. &SCABWRD(&SCABN) SETC '''&W'''
  6404.          AIF   (K'&W LE 14).APUT
  6405. &SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
  6406.          AGO   .APUT
  6407. .*
  6408. .Q       ANOP
  6409.          AIF   (&SCABN LE 0).NTESTQ
  6410. &A       SETC  '&W                '(1,16)
  6411.          AIF   (K'&W LE 16).OKQ
  6412. &A       SETC  '&A'(1,15).''''
  6413. .OKQ     ANOP
  6414. &B    SETC  '&SCABWRD(&SCABN)                '(1,16)
  6415.          AIF   ('&A' GT '&B').NTEST
  6416.          MNOTE 12,'WORD BELOW IS OUT OF ORDER'
  6417.          MNOTE 12,&W
  6418.          MEXIT
  6419. .*
  6420. .NTESTQ  ANOP
  6421.          AIF   (N'&SYSLIST LE 1).END
  6422. &SCABN   SETA  &SCABN+1
  6423. &SCABWDF(&SCABN) SETC '&W'
  6424. &SCABWRD(&SCABN) SETC '&W'
  6425.          AIF   (K'&W LE 16).APUT
  6426. &SCABWRD(&SCABN) SETC '&SCABWRD(&SCABN)'(1,15).''''
  6427. .*
  6428. .APUT    ANOP
  6429. &SCABP(&SCABN) SETA &SCABAN+1
  6430. &X       SETA  1
  6431. .*
  6432. .ALOOP   ANOP
  6433. &X       SETA  &X+1
  6434.          AIF   (&X GT N'&SYSLIST).ADONE
  6435.          AIF   ('&SYSLIST(&X,1)' EQ '').ALOOP
  6436.          AIF   (&SCABAN LT 500).AOK
  6437.          MNOTE 12,'SCABBR SYNONYM TABLE IS FULL'
  6438.          MEXIT
  6439. .*
  6440. .AOK     ANOP
  6441. &SCABAN  SETA  &SCABAN+1
  6442. &SCABC(&SCABN) SETA &SCABC(&SCABN)+1
  6443. &SCABAC(&SCABAN) SETB ('&SYSLIST(&X)' NE '&SYSLIST(&X,1)')
  6444.          AIF   ('&SYSLIST(&X,1)'(1,1) EQ '''').AQ
  6445. &SCABABF(&SCABAN) SETC '''&SYSLIST(&X,1)'''
  6446. &SCABABR(&SCABAN) SETC '''&SYSLIST(&X,1)'''
  6447.          AIF   (K'&SYSLIST(&X,1) LE 14).ALOOP
  6448. &SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
  6449.          AGO   .ALOOP
  6450. .*
  6451. .AQ      ANOP
  6452. &SCABABF(&SCABAN) SETC '&SYSLIST(&X,1)'
  6453. &SCABABR(&SCABAN) SETC '&SYSLIST(&X,1)'
  6454.          AIF   (K'&SYSLIST(&X,1) LE 16).ALOOP
  6455. &SCABABR(&SCABAN) SETC '&SCABABR(&SCABAN)'(1,15).''''
  6456.          AGO   .ALOOP
  6457. .*
  6458. .ADONE   ANOP
  6459. .*
  6460. .END     MEND
  6461. ./       ADD   LIST=ALL,NAME=SCABBRS
  6462.          MACRO
  6463.          SCABBRS
  6464.          SCABBR ABBREVIATION,ABB,ABBR,ABBREV
  6465.          SCABBR ABBREVIATIONS,ABBS,ABBRS,ABBREVS
  6466.          SCABBR ACCOUNT,ACC,ACCT
  6467.          SCABBR ACCOUNTC,ACCC,ACCTC
  6468.          SCABBR ACCOUNTS,ACCS,ACCTS
  6469.          SCABBR ACTIVE,ACT
  6470.          SCABBR ACTIVES,ACTS
  6471.          SCABBR ADDRESS,ADDR
  6472.          SCABBR ADJUST,ADJ
  6473.          SCABBR AFTER,AFT
  6474.          SCABBR ALIGN,ALI
  6475.          SCABBR ALTER,ALT,(A)
  6476.          SCABBR ALWAYS,ALW
  6477.          SCABBR AND,'&&'
  6478.          SCABBR APPARENT,APP
  6479.          SCABBR ARGUMENT,ARG
  6480.          SCABBR ATTENTION,ATTN
  6481.          SCABBR AUTOMATIC,AUTO
  6482.          SCABBR BACKLOG,BKL
  6483.          SCABBR BACKSLASH,BKSL
  6484.          SCABBR BACKSPACE,BKSP,BS
  6485.          SCABBR BACKWARD,BKWD,BKW,(B)
  6486.          SCABBR BACKWARDS,BKWDS,BKWS
  6487.          SCABBR BATCH,BAT
  6488.          SCABBR BEFORE,BEF
  6489.          SCABBR BETWEEN,BET
  6490.          SCABBR BLANK,BL
  6491.          SCABBR BLANKS,BLS
  6492.          SCABBR BLOCK,BLK
  6493.          SCABBR BLOCKS,BLKS
  6494.          SCABBR BOOLEAN,BOOL
  6495.          SCABBR BOX,B
  6496.          SCABBR BURST,BUR
  6497.          SCABBR CANCEL,CAN
  6498.          SCABBR CARRIAGERETURN,CR
  6499.          SCABBR CATALOG,CAT,CATLG,CTLG
  6500.          SCABBR CEILING,CEIL
  6501.          SCABBR CENTER,CEN
  6502.          SCABBR CENTRAL,CEN,LOCAL
  6503.          SCABBR CENTSIGN,CENT
  6504.          SCABBR CHANGE,CH
  6505.          SCABBR CHARACTER,CHAR
  6506.          SCABBR CHARACTERS,CHARS
  6507.          SCABBR CHECK,CHK
  6508.          SCABBR CHECKPOINT,CKPT
  6509.          SCABBR CIRCUMFLEX,CFX
  6510.          SCABBR CLASS,CLS
  6511.          SCABBR CLEAN,CLN
  6512.          SCABBR CLEAR,CLR
  6513.          SCABBR COLLECT,COL,(C)
  6514.          SCABBR COLUMN,COL
  6515.          SCABBR COLUMNA,COLA
  6516.          SCABBR COLUMNS,COLS
  6517.          SCABBR COLUMNSA,COLSA
  6518.          SCABBR COMMAND,CMD
  6519.          SCABBR COMMANDS,CMDS
  6520.          SCABBR COMMON,COM
  6521.          SCABBR COMMONS,COMS
  6522.          SCABBR COMPARE,COMP
  6523.          SCABBR CONDENSE,COND
  6524.          SCABBR CONSOLE,CON
  6525.          SCABBR CONSTANT,CONST
  6526.          SCABBR CONTENT,CONT
  6527.          SCABBR CONTENTS,CONTS
  6528.          SCABBR CONTINUE,CONT
  6529.          SCABBR CONTROL,CTL,CNTL
  6530.          SCABBR COPIES,COPS,COPYS,CPYS
  6531.          SCABBR COPY,COP,CPY
  6532.          SCABBR COUNT,CNT
  6533.          SCABBR COUNTERS,CTRS
  6534.          SCABBR COUNTS,CNTS
  6535.          SCABBR CREATE,CRE
  6536.          SCABBR CURRENT,CUR,C
  6537.          SCABBR CYCLE,CYC
  6538.          SCABBR CYLINDER,CYL
  6539.          SCABBR CYLINDERS,CYLS
  6540.          SCABBR DATED,DTD
  6541.          SCABBR DDNAME,DDN,DD
  6542.          SCABBR DDNAMES,DDNS,DDS
  6543.          SCABBR DEFAULT,DEF
  6544.          SCABBR DELETE,DEL,(D)
  6545.          SCABBR DELIMITER,DLM
  6546.          SCABBR DENSITY,DEN
  6547.          SCABBR DEVICE,DEV
  6548.          SCABBR DIGIT,DIG
  6549.          SCABBR DIRECTORY,DIR
  6550.          SCABBR DISCOUNT,DISC,DIS
  6551.          SCABBR DITTO,DIT
  6552.          SCABBR DOUBLE,DBL
  6553.          SCABBR DOWN,DN
  6554.          SCABBR DSNAME,DSN
  6555.          SCABBR DSNAMES,DSNS
  6556.          SCABBR DUPLICATE,DUP
  6557.          SCABBR DUPLICATES,DUPS,DUP
  6558.          SCABBR EBCDIC,EBC
  6559.          SCABBR EMPTY,EMP
  6560.          SCABBR ENCLOSE,ENC
  6561.          SCABBR END,E
  6562.          SCABBR ENDBLINK,EBK
  6563.          SCABBR ENDBOLD,EBD
  6564.          SCABBR ENDFIELD,EFD
  6565.          SCABBR ENDREVERSE,ERV
  6566.          SCABBR ENDUNDERLINE,EUL
  6567.          SCABBR ENTER,ENT
  6568.          SCABBR ERROR,ERR
  6569.          SCABBR ERRORS,ERRS
  6570.          SCABBR ESCAPE,ESC
  6571.          SCABBR EVERY,EV
  6572.          SCABBR EXCHANGE,EXCH
  6573.          SCABBR EXCLUSIVE,EXC
  6574.          SCABBR EXECUTE,EX,EXEC,XEQ,(X)
  6575.          SCABBR EXPLAIN,EXPL
  6576.          SCABBR FETCH,FET
  6577.          SCABBR FIRST,F
  6578.          SCABBR FLAG,FLG
  6579.          SCABBR FLAGGED,FLGD
  6580.          SCABBR FOLLOWING,FOL
  6581.          SCABBR FOOTING,FOOT
  6582.          SCABBR FORGET,FGT
  6583.          SCABBR FORGOTTEN,FGTN
  6584.          SCABBR FORMAT,FMT
  6585.          SCABBR FORMFEED,FF
  6586.          SCABBR FORMLETTER,FORMLTR,FORML
  6587.          SCABBR FORWARD,FWD,(F)
  6588.          SCABBR FORWARDS,FWDS
  6589.          SCABBR FROM,FR
  6590.          SCABBR GLOBAL,GBL
  6591.          SCABBR GLOBALS,GBLS
  6592.          SCABBR GROUP,GRP
  6593.          SCABBR HALFLINEFEED,HLF
  6594.          SCABBR HEADING,HEAD
  6595.          SCABBR HEIGHT,HGT
  6596.          SCABBR HORIZONTALTAB,HT
  6597.          SCABBR HYPHENATE,HYP,HY
  6598.          SCABBR INCREMENT,INCR
  6599.          SCABBR INDENT,IND
  6600.          SCABBR INFINITY,INF
  6601.          SCABBR INITIAL,INIT
  6602.          SCABBR INITIALS,INIT,INITS
  6603.          SCABBR INITIALSC,INITC,INITSC
  6604.          SCABBR INSERT,INS,(I)
  6605.          SCABBR INTEGER,INT
  6606.          SCABBR ISBOOLEAN,ISBOOL
  6607.          SCABBR ISINTEGER,ISINT
  6608.          SCABBR ISNUMBER,ISNUM
  6609.          SCABBR JOBNUMBER,JOBNUM
  6610.          SCABBR JOIN,(J)
  6611.          SCABBR JUSTIFIED,JUS,JUST
  6612.          SCABBR JUSTIFY,JUS,JUST
  6613.          SCABBR KEYWORD,KEY,KW
  6614.          SCABBR KEYWORDS,KEYS,KWS
  6615.          SCABBR LABEL,LAB,LBL
  6616.          SCABBR LAST,L
  6617.          SCABBR LEFTCURLY,LCURL
  6618.          SCABBR LEFTSQUARE,LSQ
  6619.          SCABBR LENGTH,LEN
  6620.          SCABBR LENGTHA,LENA
  6621.          SCABBR LETTER,LTR
  6622.          SCABBR LEVEL,LEV
  6623.          SCABBR LIMIT,LIM
  6624.          SCABBR LINEFEED,LF
  6625.          SCABBR LIST,LIS,(L)
  6626.          SCABBR LOCAL,LOC,LCL
  6627.          SCABBR LOCALS,LOCS,LCLS
  6628.          SCABBR LOCATE,LOC
  6629.          SCABBR LOGOFF,LOGOUT
  6630.          SCABBR LOGON,LOGIN
  6631.          SCABBR LOWER,LOW
  6632.          SCABBR MARKER,MAR,MARK
  6633.          SCABBR MASTER,MAS,MAST
  6634.          SCABBR MAXIMUM,MAX
  6635.          SCABBR MEMBER,MEM
  6636.          SCABBR MEMBERS,MEMS
  6637.          SCABBR MESSAGE,MSG
  6638.          SCABBR MESSAGES,MSGS
  6639.          SCABBR MILTEN,MIL
  6640.          SCABBR MINIMUM,MIN
  6641.          SCABBR MODIFY,MOD,(M)
  6642.          SCABBR MONITOR,MON
  6643.          SCABBR MULTICOLUMN,MULTICOL
  6644.          SCABBR MULTICOLUMNS,MULTICOLS
  6645.          SCABBR MULTIPLE,MUL,MULT
  6646.          SCABBR NEQ,NE
  6647.          SCABBR NEWFONT,NF
  6648.          SCABBR NEWLINE,NL
  6649.          SCABBR NO,N
  6650.          SCABBR NOACCOUNT,NOACC,NOACCT
  6651.          SCABBR NOACCOUNTS,NOACCS,NOACCTS
  6652.          SCABBR NOADJUST,NOADJ
  6653.          SCABBR NOATTENTION,NOATTN
  6654.          SCABBR NOBOX,NOB
  6655.          SCABBR NOCLEAN,NOCLN
  6656.          SCABBR NOCOLUMN,NOCOL
  6657.          SCABBR NOCOLUMNS,NOCOLS
  6658.          SCABBR NOCONTINUE,NOCONT
  6659.          SCABBR NOCOPIES,NOCOPS,NOCOPYS,NOCPYS
  6660.          SCABBR NOCOPY,NOCOP,NOCPY
  6661.          SCABBR NOCREATE,NOCRE
  6662.          SCABBR NODEFAULT,NODEF
  6663.          SCABBR NODISCOUNT,NODISC,NODIS
  6664.          SCABBR NODOWN,NODN
  6665.          SCABBR NODSNAME,NODSN
  6666.          SCABBR NOESCAPE,NOESC
  6667.          SCABBR NOEXCLUSIVE,NOEXC
  6668.          SCABBR NOEXECUTE,NOEXEC,NOEX,NOXEQ
  6669.          SCABBR NOFLAG,NOFLG
  6670.          SCABBR NOFORMFEED,NOFF
  6671.          SCABBR NOHEIGHT,NOHGT
  6672.          SCABBR NOHYPHENATE,NOHYP,NOHY
  6673.          SCABBR NOINDENT,NOIND
  6674.          SCABBR NOINITIALS,NOINITS,NOINIT
  6675.          SCABBR NOJOBNUMBER,NOJOBNUM
  6676.          SCABBR NOJUSTIFY,NOJUS,NOJUST
  6677.          SCABBR NOKEYWORD,NOKEY,NOKW
  6678.          SCABBR NOKEYWORDS,NOKEYS,NOKWS
  6679.          SCABBR NOLABEL,NOLAB,NOLBL
  6680.          SCABBR NOLENGTH,NOLEN
  6681.          SCABBR NOLIMIT,NOLIM
  6682.          SCABBR NOLIST,NOL
  6683.          SCABBR NOMARKER,NOMAR,NOMARK
  6684.          SCABBR NOMESSAGE,NOMSG
  6685.          SCABBR NOMESSAGES,NOMSGS
  6686.          SCABBR NOMULTICOLUMN,NOMULTICOL
  6687.          SCABBR NOMULTICOLUMNS,NOMULTICOLS
  6688.          SCABBR NONOTIFY,NONTF
  6689.          SCABBR NONSTANDARD,NONSTD,NSTD
  6690.          SCABBR NONUMBER,NONUM
  6691.          SCABBR NOOPERATOR,NOOPER,NOOPR
  6692.          SCABBR NOOVERLAP,NOOVLAP
  6693.          SCABBR NOOVERLAY,NOOVLAY
  6694.          SCABBR NOPOINT,NOPNT,NOPT
  6695.          SCABBR NOPREFIX,NOPRE
  6696.          SCABBR NOPREVIEW,NOPV
  6697.          SCABBR NOPRIORITY,NOPRIO,NOPRI
  6698.          SCABBR NOPRIVILEGE,NOPRIV
  6699.          SCABBR NOPROGRAMMER,NOPGMR
  6700.          SCABBR NOPURGE,NOPUR
  6701.          SCABBR NOQUICK,NOQCK
  6702.          SCABBR NORECOVERY,NORECOV
  6703.          SCABBR NORETRY,NORT
  6704.          SCABBR NORETURN,NORTN
  6705.          SCABBR NOROUTE,NORTE
  6706.          SCABBR NOSCRATCH,NOSCR
  6707.          SCABBR NOSECOND,NOSEC
  6708.          SCABBR NOSECONDS,NOSECS
  6709.          SCABBR NOSPACE,NOSP
  6710.          SCABBR NOSTATEMENT,NOSTMT
  6711.          SCABBR NOSTATEMENTS,NOSTMTS
  6712.          SCABBR NOSUBTITLE,NOSUBTTL
  6713.          SCABBR NOT,^
  6714.          SCABBR NOTEMPORARY,NOTEMP
  6715.          SCABBR NOTERSE,NOTER
  6716.          SCABBR NOTEXT,NOTXT,NOTX
  6717.          SCABBR NOTIFY,NTF
  6718.          SCABBR NOTIMEOUT,NOTIME
  6719.          SCABBR NOTITLE,NOTTL
  6720.          SCABBR NOVERIFY,NOVER
  6721.          SCABBR NOVOLUME,NOVOL
  6722.          SCABBR NOWIDTH,NOWID
  6723.          SCABBR NUMBER,NUM
  6724.          SCABBR NUMBERED,NUMD
  6725.          SCABBR OCCURRENCES,OCCURS,OCCUR,OCCS,OCC
  6726.          SCABBR OFFLINE,OFF
  6727.          SCABBR OPERATOR,OPER,OPR
  6728.          SCABBR OR,|
  6729.          SCABBR OUTPUT,OUT
  6730.          SCABBR OVERLAP,OVLAP
  6731.          SCABBR OVERLAY,OVLAY
  6732.          SCABBR PAGE,PG
  6733.          SCABBR PAGINATE,PAG
  6734.          SCABBR PARAGRAPH,PAR,PGH
  6735.          SCABBR PATTERN,PAT
  6736.          SCABBR POINT,PNT,PT,(P)
  6737.          SCABBR POSITION,POS
  6738.          SCABBR POSITIONAL,POS
  6739.          SCABBR PRECEDING,PREC
  6740.          SCABBR PREFIX,PRE
  6741.          SCABBR PREVIEW,PV
  6742.          SCABBR PREVIOUS,PREV,PRV
  6743.          SCABBR PRINT,PRT,PRNT
  6744.          SCABBR PRIORITY,PRI,PRIO
  6745.          SCABBR PRIVILEGE,PRIV
  6746.          SCABBR PROCEDURE,PROC
  6747.          SCABBR PROCEDURES,PROCS
  6748.          SCABBR PROGRAM,PROG,PGM
  6749.          SCABBR PROGRAMMER,PGMR
  6750.          SCABBR PUNCH,PUN
  6751.          SCABBR PUNCTUATION,PUNC
  6752.          SCABBR PURGE,PUR
  6753.          SCABBR QUICK,QCK
  6754.          SCABBR QUIET,QUI
  6755.          SCABBR RECATALOG,RECAT,RECTLG,RECATLG
  6756.          SCABBR RECEIVE,RCV
  6757.          SCABBR RECOVERY,RECOV
  6758.          SCABBR RELEASE,RLSE,RLS
  6759.          SCABBR REMEMBER,REMEM
  6760.          SCABBR REMOTE,REM,RMT
  6761.          SCABBR RENAME,REN
  6762.          SCABBR RENUMBER,RENUM
  6763.          SCABBR REPLACE,REP,(R)
  6764.          SCABBR RESAVE,RSV
  6765.          SCABBR RETRIEVE,RTV,RETRV
  6766.          SCABBR RETRY,RT
  6767.          SCABBR RETURN,RTN
  6768.          SCABBR RETURNS,RTNS
  6769.          SCABBR REVERSEHALFLINEFEED,RHLF
  6770.          SCABBR REVERSELINEFEED,RLF
  6771.          SCABBR REVERSESLASH,RSLASH
  6772.          SCABBR RIGHTCURLY,RCURL
  6773.          SCABBR RIGHTSQUARE,RSQ
  6774.          SCABBR ROUTE,RTE
  6775.          SCABBR SAVE,SV
  6776.          SCABBR SCRATCH,SCR
  6777.          SCABBR SECOND,SEC
  6778.          SCABBR SECONDS,SECS
  6779.          SCABBR SEPARATOR,SEP
  6780.          SCABBR SHARED,SHR
  6781.          SCABBR SHIFTIN,SI
  6782.          SCABBR SHIFTOUT,SO
  6783.          SCABBR SHOW,SH
  6784.          SCABBR SPACE,SP
  6785.          SCABBR SPACES,SPS
  6786.          SCABBR SPACING,SPN
  6787.          SCABBR SPLIT,SPL,(S)
  6788.          SCABBR STARTBLINK,SBK
  6789.          SCABBR STARTBOLD,SBD
  6790.          SCABBR STARTFIELD,SFD
  6791.          SCABBR STARTREVERSE,SRV
  6792.          SCABBR STARTUNDERLINE,SUL
  6793.          SCABBR STATEMENT,STMT
  6794.          SCABBR STATEMENTS,STMTS
  6795.          SCABBR STATUS,STAT
  6796.          SCABBR STOPCODE,SC
  6797.          SCABBR STORAGE,STOR
  6798.          SCABBR STRING,STR
  6799.          SCABBR STRINGM,STRM
  6800.          SCABBR STRINGZ,STRZ
  6801.          SCABBR SUBSTITUTE,SUBST
  6802.          SCABBR SUBSTRING,SUBSTR
  6803.          SCABBR SUBSTRINGA,SUBSTRA
  6804.          SCABBR SUBTITLE,SUBTTL
  6805.          SCABBR SUGGEST,SUG
  6806.          SCABBR TABLE,TBL
  6807.          SCABBR TEMPORARY,TEMP
  6808.          SCABBR TERMINAL,TERM
  6809.          SCABBR TERMINATE,TERM
  6810.          SCABBR TERSE,TER
  6811.          SCABBR TEXT,TXT,TX
  6812.          SCABBR TITLE,TTL
  6813.          SCABBR TRACK,TRK
  6814.          SCABBR TRACKS,TRKS
  6815.          SCABBR TRIPLE,TRI,TPL
  6816.          SCABBR TRUNCATE,TRUNC
  6817.          SCABBR TYPE,TYP,(T)
  6818.          SCABBR UNCATALOG,UNCAT,UNCTLG,UNCATLG
  6819.          SCABBR UNDERLINE,UNDL,ULINE
  6820.          SCABBR UNDERLINED,UNDLD,ULINED
  6821.          SCABBR UNDERSCORE,UNDSC,USCORE
  6822.          SCABBR UNFLAGGED,UNFLGD,UFLGD
  6823.          SCABBR UNNUMBERED,UNN
  6824.          SCABBR UPLOW,UPL
  6825.          SCABBR UPPER,UPP,UPR
  6826.          SCABBR USING,USN
  6827.          SCABBR VARIABLE,VAR
  6828.          SCABBR VARIABLES,VARS
  6829.          SCABBR VERBATIM,VBTM,VB
  6830.          SCABBR VERIFY,VER
  6831.          SCABBR VERIFYA,VERA
  6832.          SCABBR VERIFYN,VERN
  6833.          SCABBR VERIFYNA,VERNA
  6834.          SCABBR VERTICALBAR,VBAR
  6835.          SCABBR VERTICALTAB,VTAB
  6836.          SCABBR VIEW,(V)
  6837.          SCABBR VOLUME,VOL
  6838.          SCABBR VOLUMES,VOLS
  6839.          SCABBR WIDTH,WID
  6840.          SCABBR WYLBUR,WYL
  6841.          SCABBR YES,Y
  6842.          MEND
  6843. ./       ADD   LIST=ALL,NAME=SCAN
  6844.          MACRO
  6845. &L       SCAN  &PRT,&BRANCH=,&LIMIT=,&SCT=SCTSTART
  6846.          GBLC  &SCANEND(10),&SCANPRT(10)
  6847.          GBLA  &SCANCNT
  6848.          GBLA  &SCANNDX
  6849. &SCANNDX SETA  &SCANNDX+1
  6850.          SYSKWT BRANCH,&BRANCH,(YES,NO)
  6851. .*
  6852.          AIF   ('&PRT' EQ '*').STAR
  6853. &L       SYSLR VR1,&PRT,TYPE=&BRANCH,SELECT=(NO)
  6854.          SYSLR VR0,&LIMIT
  6855.          SYSLR VRF,&SCT
  6856.          SCCALL SCAN
  6857.          MEXIT
  6858. .*
  6859. .STAR    ANOP
  6860. &SCANCNT SETA  &SCANCNT+1
  6861. &SCANEND(&SCANCNT) SETC 'SCN&SCANNDX.E'
  6862. &SCANPRT(&SCANCNT) SETC 'SCN&SCANNDX.T'
  6863. &L       SYSLR VR1,SCN&SCANNDX.T,TYPE=&BRANCH,SELECT=(NO)
  6864.          SYSLR VR0,&LIMIT
  6865.          SYSLR VRF,&SCT
  6866.          SCCALL SCAN
  6867.          B     &SCANEND(&SCANCNT)
  6868. SCN&SCANNDX.T DS 0X
  6869.          MEND
  6870. ./       ADD   LIST=ALL,NAME=SCANEND
  6871.          MACRO
  6872. &L       SCANEND
  6873.          GBLC  &SCANEND(10)
  6874.          GBLA  &SCANCNT
  6875.          AIF   (&SCANCNT GE 0).OK
  6876.          MNOTE 12,'NO MATCHING SCAN *'
  6877.          MEXIT
  6878. .*
  6879. .OK      ANOP
  6880. &L       SYSLBL
  6881. &SCANEND(&SCANCNT) SYSLBL
  6882. &SCANCNT SETA  &SCANCNT-1
  6883.          MEND
  6884. ./       ADD   LIST=ALL,NAME=SCBACK
  6885.          MACRO
  6886. &L       SCBACK &SCT=SCTSTART
  6887. &L       MMVC  SCTLEN-SCTSTART+&SCT,SCTBLEN-SCTSTART+&SCT,8
  6888.          MEND
  6889. ./       ADD   LIST=ALL,NAME=SCCALL
  6890.          MACRO
  6891. &L       SCCALL &R,&RETURN=
  6892. &L       CCALL &R,RETURN=&RETURN
  6893.          MEND
  6894. ./       ADD   LIST=ALL,NAME=SCDONE
  6895.          MACRO
  6896. &L       SCDONE &SCT=SCTSTART
  6897.          GBLA  &SCANNDX
  6898. &SCANNDX SETA  &SCANNDX+1
  6899. .*
  6900. &L       SCAN  SCT=&SCT
  6901.          BNP   SCD&SCANNDX.X
  6902.          SCERROR OLD=RTNR,SCT=&SCT
  6903.          LI    VRF,SCTCSCD
  6904.          SCCALL (RTNR)
  6905. SCD&SCANNDX.X DS 0H
  6906.          MEND
  6907. ./       ADD   LIST=ALL,NAME=SCDQUOTE
  6908.          MACRO
  6909. &L       SCDQUOTE &LOC,&LEN,&SCT=
  6910. &L       SYSQS VR1,VR0,&LOC,&LEN
  6911.          SCCALL SCDQUOTE
  6912.          MEND
  6913. ./       ADD   LIST=ALL,NAME=SCERROR
  6914.          MACRO
  6915. &L       SCERROR &NEW=,&OLD=,&NEWPARM=,&OLDPARM=,&SCT=SCTSTART
  6916.          LCLC  &LBL
  6917. .*
  6918. &LBL     SETC  '&L'
  6919. .*
  6920.          AIF   ('&NEW&OLD' EQ '' AND '&NEWPARM&OLDPARM' NE '').PARM
  6921. &LBL     SYSLST SCTERROR-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD
  6922. &LBL     SETC  ''
  6923.          AIF   ('&NEWPARM&OLDPARM' EQ '').END
  6924. .*
  6925. .PARM    ANOP
  6926. &LBL     SYSLST SCTERRP-SCTSTART+&SCT,NEW=&NEWPARM,OLD=&OLDPARM
  6927. .END     MEND
  6928. ./       ADD   LIST=ALL,NAME=SCEXTRA
  6929.          MACRO
  6930. &L       SCEXTRA
  6931. &L       SCAN  *
  6932.          SCKW  ,*,B
  6933.          SCANEND
  6934.          MEND
  6935. ./       ADD   LIST=ALL,NAME=SCINIT
  6936.          MACRO
  6937. &L       SCINIT &LOC,&LEN,&SCT=SCTSTART
  6938. &L       MZC   SCTINIT-SCTSTART+&SCT,SCTINITL
  6939.          AIF   ('&LEN,&LOC' EQ '(VRE),(VRF)').STM
  6940.          AIF   ('&LEN,&LOC' EQ '(VRF),(VR0)').STM
  6941.          AIF   ('&LEN,&LOC' EQ '(VR0),(VR1)').STM
  6942.          AIF   ('&LEN,&LOC' EQ '(VR1),(XRA)').STM
  6943.          AIF   ('&LEN,&LOC' EQ '(XRA),(XRB)').STM
  6944.          AIF   ('&LEN,&LOC' EQ '(XRB),(XRC)').STM
  6945.          AIF   ('&LEN,&LOC' EQ '(XRC),(XRD)').STM
  6946.          AIF   ('&LEN,&LOC' EQ '(XRD),(XRE)').STM
  6947.          AIF   ('&LEN,&LOC' EQ '(XRE),(XRF)').STM
  6948. .*
  6949.          AIF   ('&LEN' EQ '').LRLEN
  6950.          AIF   ('&LEN'(1,1) NE '(').LRLEN
  6951.          ST    &LEN,SCTLEN-SCTSTART+&SCT
  6952.          AGO   .LOC
  6953. .*
  6954. .LRLEN   ANOP
  6955.          SYSLR RTNR,&LEN,ERR='LENGTH MISSING'
  6956.          ST    RTNR,SCTLEN-SCTSTART+&SCT
  6957. .*
  6958. .LOC     ANOP
  6959.          AIF   ('&LOC' EQ '').LRLOC
  6960.          AIF   ('&LOC'(1,1) NE '(').LRLOC
  6961.          ST    &LOC,SCTLOC-SCTSTART+&SCT
  6962.          MEXIT
  6963. .*
  6964. .LRLOC   ANOP
  6965.          SYSLR RTNR,&LOC,ERR='LOCATION MISSING'
  6966.          ST    RTNR,SCTLOC-SCTSTART+&SCT
  6967.          MEXIT
  6968. .*
  6969. .STM     ANOP
  6970.          STM   &LEN,&LOC,SCTLEN-SCTSTART+&SCT
  6971.          MEND
  6972. ./       ADD   LIST=ALL,NAME=SCKW
  6973.          MACRO
  6974. &L       SCKW  &WORD,&RTN,&OPTS,&LIMIT=,&CODE=
  6975.          GBLC  &SCKWABR(50)
  6976.          GBLA  &SCKWN
  6977.          GBLB  &SCKWHD,&SCKWAC
  6978.          GBLC  &SCKWAVS,&SCKWRTN
  6979.          GBLA  &SCKWAVC
  6980.          GBLC  &SCKWTBL(42)
  6981.          LCLA  &X,&Y,&Z,&TYPE,&LIML,&CODL
  6982.          LCLB  &B,&J,&P,&TL
  6983.          LCLC  &CH,&LBL
  6984. .*
  6985. &LBL     SETC  '&L'
  6986.          SCKWR INIT
  6987. .*
  6988. &SCKWAC  SETB  0
  6989. .LOOP    ANOP
  6990. &X       SETA  &X+1
  6991.          AIF   (&X GT N'&OPTS).LOOPEND
  6992.          AIF   ('&OPTS(&X)' EQ 'P').P
  6993.          AIF   ('&OPTS(&X)' EQ 'I').I
  6994.          AIF   ('&OPTS(&X)' EQ 'PI').PI
  6995.          AIF   ('&OPTS(&X)' EQ 'O').O
  6996.          AIF   ('&OPTS(&X)' EQ 'PO').PO
  6997.          AIF   ('&OPTS(&X)' EQ 'LN').LN
  6998.          AIF   ('&OPTS(&X)' EQ 'PLN').PLN
  6999.          AIF   ('&OPTS(&X)' EQ 'QS').QS
  7000.          AIF   ('&OPTS(&X)' EQ 'OQS').OQS
  7001.          AIF   ('&OPTS(&X)' EQ 'PS').PS
  7002.          AIF   ('&OPTS(&X)' EQ 'OPS').OPS
  7003.          AIF   ('&OPTS(&X)' EQ 'B').B
  7004.          AIF   ('&OPTS(&X)' EQ 'J').J
  7005.          AIF   ('&OPTS(&X)' EQ 'SC').SC
  7006.          AIF   ('&OPTS(&X)' EQ 'SCI').SCI
  7007.          AIF   ('&OPTS(&X)' EQ 'AC').AC
  7008.          AIF   ('&OPTS(&X)' EQ 'VC').VC
  7009.          AIF   ('&OPTS(&X)' EQ 'C').C
  7010.          AIF   ('&OPTS(&X)' EQ 'TL').TL
  7011.          MNOTE 12,'"&OPTS(&X)" IS AN ILLEGAL OPTION'
  7012.          AGO   .LOOP
  7013. .*
  7014. .*  P
  7015. .*
  7016. .P       ANOP
  7017. &P       SETB  1
  7018.          AGO   .LOOP
  7019. .*
  7020. .*  I
  7021. .*
  7022. .I       ANOP
  7023. &TYPE    SETA  1
  7024.          AGO   .LOOP
  7025. .*
  7026. .*  PI
  7027. .*
  7028. .PI      ANOP
  7029. &TYPE    SETA  2
  7030.          AGO   .LOOP
  7031. .*
  7032. .*  O
  7033. .*
  7034. .O       ANOP
  7035. &TYPE    SETA  3
  7036.          AGO   .LOOP
  7037. .*
  7038. .*  PO
  7039. .*
  7040. .PO      ANOP
  7041. &TYPE    SETA  4
  7042.          AGO   .LOOP
  7043. .*
  7044. .*  LN
  7045. .*
  7046. .LN      ANOP
  7047. &TYPE    SETA  5
  7048.          AGO   .LOOP
  7049. .*
  7050. .*  PLN
  7051. .*
  7052. .PLN     ANOP
  7053. &TYPE    SETA  6
  7054.          AGO   .LOOP
  7055. .*
  7056. .*  QS
  7057. .*
  7058. .QS      ANOP
  7059. &TYPE    SETA  7
  7060.          AGO   .LOOP
  7061. .*
  7062. .*  OQS
  7063. .*
  7064. .OQS     ANOP
  7065. &TYPE    SETA  8
  7066.          AGO   .LOOP
  7067. .*
  7068. .*  PS
  7069. .*
  7070. .PS      ANOP
  7071. &TYPE    SETA  9
  7072.          AGO   .LOOP
  7073. .*
  7074. .*  OPS
  7075. .*
  7076. .OPS     ANOP
  7077. &TYPE    SETA  10
  7078.          AGO   .LOOP
  7079. .*
  7080. .*  B
  7081. .*
  7082. .B       ANOP
  7083. &B       SETB  1
  7084.          AGO   .LOOP
  7085. .*
  7086. .*  J
  7087. .*
  7088. .J       ANOP
  7089. &J       SETB  1
  7090.          AGO   .LOOP
  7091. .*
  7092. .*  SC
  7093. .*
  7094. .SC      ANOP
  7095. &SCKWAVS SETC  'SL2'
  7096. &SCKWAVC SETA  2
  7097.          AGO   .LOOP
  7098. .*
  7099. .*  SCI
  7100. .*
  7101. .SCI     ANOP
  7102. &SCKWAVS SETC  'SL2'
  7103. &SCKWAVC SETA  3
  7104.          AGO   .LOOP
  7105. .*
  7106. .*  AC
  7107. .*
  7108. .AC      ANOP
  7109. &SCKWAVS SETC  'AL4'
  7110. &SCKWAVC SETA  0
  7111.          AGO   .LOOP
  7112. .*
  7113. .*  VC
  7114. .*
  7115. .VC      ANOP
  7116. &SCKWAVS SETC  'VL4'
  7117. &SCKWAVC SETA  1
  7118.          AGO   .LOOP
  7119. .*
  7120. .C       ANOP
  7121. &SCKWAC  SETB  1
  7122.          AGO   .LOOP
  7123. .*
  7124. .TL      ANOP
  7125. &TL      SETB  1
  7126.          AGO   .LOOP
  7127. .*
  7128. .LOOPEND ANOP
  7129. .*
  7130.          SCKWR ADDR,&RTN
  7131. .*
  7132.          AIF   ('&LIMIT' EQ '').NLIM
  7133.          AIF   (K'&LIMIT LT 4).ERRLIM
  7134.          AIF   ('&LIMIT'(1,2) EQ 'AL').LIML
  7135.          AIF   ('&LIMIT'(1,2) EQ 'YL').LIML
  7136.          AIF   ('&LIMIT'(1,2) EQ 'FL').LIML
  7137.          AIF   ('&LIMIT'(1,2) EQ 'HL').LIML
  7138.          AIF   ('&LIMIT'(1,2) EQ 'XL').LIML
  7139.          AIF   ('&LIMIT'(1,2) EQ 'BL').LIML
  7140.          AIF   ('&LIMIT'(1,2) EQ 'CL').LIML
  7141. .ERRLIM  MNOTE 12,'ILLEGAL LIMIT'
  7142.          AGO   .NLIM
  7143. .*
  7144. .LIML    ANOP
  7145.          AIF   ('&LIMIT'(2,1) NE 'L').ERRLIM
  7146. &CH      SETC  '&LIMIT'(3,1)
  7147.          AIF   ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRLIM
  7148. &LIML    SETA  &CH
  7149.          AIF   ('&LIMIT'(4,1) NE '(' AND '&LIMIT'(4,1) NE '''').ERRLIM
  7150. &LIML    SETA  &LIML-&LIML/4
  7151. .NLIM    ANOP
  7152. .*
  7153.          AIF   ('&CODE' EQ '').NCOD
  7154.          AIF   (K'&CODE LT 4).ERRCOD
  7155.          AIF   ('&CODE'(1,2) EQ 'AL').CODL
  7156.          AIF   ('&CODE'(1,2) EQ 'YL').CODL
  7157.          AIF   ('&CODE'(1,2) EQ 'FL').CODL
  7158.          AIF   ('&CODE'(1,2) EQ 'HL').CODL
  7159.          AIF   ('&CODE'(1,2) EQ 'XL').CODL
  7160.          AIF   ('&CODE'(1,2) EQ 'BL').CODL
  7161.          AIF   ('&CODE'(1,2) EQ 'CL').CODL
  7162. .ERRCOD  MNOTE 12,'ILLEGAL CODE'
  7163.          AGO   .NCOD
  7164. .*
  7165. .CODL    ANOP
  7166.          AIF   ('&CODE'(2,1) NE 'L').ERRCOD
  7167. &CH      SETC  '&CODE'(3,1)
  7168.          AIF   ('&CH' NE '1' AND '&CH' NE '2' AND '&CH' NE '4').ERRCOD
  7169. &CODL    SETA  &CH
  7170.          AIF   ('&CODE'(4,1) NE '(' AND '&CODE'(4,1) NE '''').ERRCOD
  7171. &CODL    SETA  &CODL-&CODL/4
  7172. .NCOD    ANOP
  7173. .*
  7174. &SCKWN   SETA  0
  7175. &SCKWHD  SETB  0
  7176. &X       SETA  0
  7177. .WLOOP   ANOP
  7178. &X       SETA  &X+1
  7179.          AIF   (&X GT N'&WORD).WDONE
  7180.          AIF   ('&WORD(&X)' EQ '').WLOOP
  7181.          AIF   ('&WORD(&X)'(1,1) EQ '''').WQ
  7182.          SCKWA '&WORD(&X)'
  7183.          AGO   .WLOOP
  7184. .*
  7185. .WQ      SCKWA &WORD(&X)
  7186.          AGO   .WLOOP
  7187. .*
  7188. .WDONE   ANOP
  7189. .*
  7190. &X       SETA  0
  7191. &Y       SETA  0
  7192. .GLOOP   ANOP
  7193. .*
  7194.          AIF   ('&SCKWTBL(1)' EQ '').NTBLP
  7195. &Z       SETA  0
  7196.          AIF   (&SCKWN LT 1).TBLP
  7197.          AIF   (&X EQ 0).TBLPC
  7198.          AIF   (&X+1 GT &SCKWN).NTBLP
  7199.          AIF   ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).NTBLP
  7200. .TBLPC   ANOP
  7201.          AIF   ('&SCKWABR(&X+1)'(2,1) LT 'A').TBLP
  7202.          AIF   ('&SCKWABR(&X+1)'(2,1) GT 'Z').TBLP
  7203. &CH      SETC  'C'''.'&SCKWABR(&X+1)'(2,1).''''
  7204. &Z       SETA  &CH-C'A'+1
  7205. .TBLP    ANOP
  7206. &LBL     SYSLBL TYPE=X
  7207. &LBL     SETC  ''
  7208. &Z       SETA  &Z+1
  7209. &SCKWTBL(&Z) SCKWTBLP &Z
  7210. .NTBLP   ANOP
  7211. .*
  7212. &X       SETA  &X+1
  7213.          AIF   (&X GT &SCKWN).GDONE
  7214.          AIF   (&X+1 GT &SCKWN).NA3
  7215.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,2).'''').NA1
  7216. &Y       SETA  &Y+1
  7217.          AGO   .GLOOP
  7218. .*
  7219. .NA1     ANOP
  7220.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,3).'''').NA2
  7221. &Y       SETA  &Y+2
  7222.          AGO   .GLOOP
  7223. .*
  7224. .NA2     ANOP
  7225.     AIF ('&SCKWABR(&X)' NE '&SCKWABR(&X+1)    '(1,4).'''').NA3
  7226. &Y       SETA  &Y+4
  7227.          AGO   .GLOOP
  7228. .*
  7229. .NA3     ANOP
  7230. &LBL     SCKWB &SCKWABR(&X),&Y
  7231. &LBL     SETC  ''
  7232. &Y       SETA  0
  7233. .*
  7234.          AIF   ('&SCKWTBL(1)' EQ '').GLOOP
  7235.          AIF   (&X+1 GT &SCKWN).GLOOP
  7236.          AIF   ('&SCKWABR(&X)'(2,1) EQ '&SCKWABR(&X+1)'(2,1)).GLOOP
  7237. .*
  7238. .GDONE   ANOP
  7239. .*
  7240. &LBL     DC    AL.1(1),AL.1(0),AL.2(&SCKWAVC),AL.2(&LIML),AL.2(&CODL)
  7241. &LBL     SETC  ''
  7242.          DC    AL.1(&TL),AL.1(&P),AL.1(&B),AL.1(&J),AL.4(&TYPE)
  7243.          DC    &SCKWAVS.(&SCKWRTN)
  7244.          AIF   ('&LIMIT' EQ '').NGLIM
  7245.          DC    &LIMIT
  7246. .NGLIM   ANOP
  7247. .*
  7248.          AIF   ('&CODE' EQ '').NGCOD
  7249.          DC    &CODE
  7250. .NGCOD   ANOP
  7251. .*
  7252.          AIF   (&X LT &SCKWN).GLOOP
  7253. .*
  7254. .END     MEND
  7255. ./       ADD   LIST=ALL,NAME=SCKWA
  7256.          MACRO
  7257.          SCKWA &W,&SW
  7258.          GBLC  &SCKWABR(50)
  7259.          GBLA  &SCKWN
  7260.          GBLB  &SCKWHD,&SCKWAC
  7261.          GBLC  &SCABWRD(400),&SCABABR(500)
  7262.          GBLA  &SCABP(400),&SCABC(400),&SCABN,&SCABAN
  7263.          GBLB  &SCABAC(500)
  7264.          LCLC  &A,&B
  7265.          LCLA  &X,&Y,&Z
  7266. .*
  7267. &A       SETC  '&W                '(1,16)
  7268.          AIF   (K'&W LE 16).LENOK
  7269. &A       SETC  '&A'(1,15).''''
  7270. .LENOK   ANOP
  7271. .*
  7272. .TLOOP   ANOP
  7273. &X       SETA  &X+1
  7274.          AIF   (&X GT &SCKWN).TDONE
  7275. &B       SETC  '&SCKWABR(&X)                '(1,16)
  7276.          AIF   ('&A' GT '&B').TLOOP
  7277.          AIF   ('&A' LT '&B').TDONE
  7278.          AIF   ('&SW' NE '').END
  7279.          MNOTE 12,'WORD BELOW IS DUPLICATED'
  7280.          MNOTE 12,&W
  7281. &SCKWHD  SETB  0
  7282.          AGO   .END
  7283. .*
  7284. .TDONE   ANOP
  7285. .*
  7286.          AIF   (&SCKWN LT 50).OK
  7287.          MNOTE 12,'SCKW TABLE OVERFLOW'
  7288.          MEXIT
  7289. .*
  7290. .OK      ANOP
  7291. .*
  7292. &SCKWN   SETA  &SCKWN+1
  7293.          AIF   (&X GE &SCKWN).MDONE
  7294. &Y       SETA  &SCKWN+1
  7295. .MLOOP   ANOP
  7296. &Y       SETA  &Y-1
  7297.          AIF   (&Y LE &X).MDONE
  7298. &SCKWABR(&Y) SETC '&SCKWABR(&Y-1)'
  7299.          AGO   .MLOOP
  7300. .*
  7301. .MDONE   ANOP
  7302. &SCKWABR(&X) SETC '&W'
  7303.          AIF   (K'&W LE 16).MN2
  7304. &SCKWABR(&X) SETC '&SCKWABR(&X)'(1,15).''''
  7305. .MN2     ANOP
  7306. .*
  7307.          AIF   (&SCABN LT 1).END
  7308. &X       SETA  1
  7309. &Y       SETA  &SCABN
  7310. .BLOOP   ANOP
  7311.          AIF   (&X GT &Y).END
  7312. &Z       SETA  &X+(&Y-&X)/2
  7313. &B       SETC  '&SCABWRD(&Z)                '(1,16)
  7314.          AIF   ('&A' EQ '&B').BFOUND
  7315.          AIF   (&X EQ &Y).END
  7316.          AIF   ('&A' LT '&B').BLEFT
  7317. &X       SETA  &Z+1
  7318.          AGO   .BLOOP
  7319. .*
  7320. .BLEFT   ANOP
  7321. &Y       SETA  &Z-1
  7322.          AGO   .BLOOP
  7323. .*
  7324. .BFOUND  ANOP
  7325. &X       SETA  &SCABP(&Z)-1
  7326. &Y       SETA  &SCABC(&Z)
  7327. .*
  7328. .CLOOP   ANOP
  7329. &X       SETA  &X+1
  7330. &Y       SETA  &Y-1
  7331.          AIF   (&Y LT 0).END
  7332.          AIF   (&SCABAC(&X) AND NOT &SCKWAC).CLOOP
  7333.          AIF   (&SCKWHD).NHD
  7334. &SCKWHD  SETB  1
  7335.          MNOTE *,'ABBREVIATIONS/SYNONYMS'
  7336. .NHD     MNOTE *,&SCABABR(&X)
  7337.          SCKWA &SCABABR(&X),NO
  7338.          AGO   .CLOOP
  7339. .*
  7340. .END     MEND
  7341. ./       ADD   LIST=ALL,NAME=SCKWB
  7342.          MACRO
  7343. &L       SCKWB &W,&A
  7344.          LCLA  &X,&LEN
  7345. .*
  7346. &X       SETA  1
  7347. .COUNT   ANOP
  7348. &X       SETA  &X+1
  7349.          AIF   (&X GT K'&W-1).COUNTED
  7350. &LEN     SETA  &LEN+1
  7351.     AIF ('&W'(&X,2) NE ''''''(1,2) AND '&W'(&X,2) NE '&&&&'(1,2)).COUNT
  7352. &X       SETA  &X+1
  7353.          AGO   .COUNT
  7354. .*
  7355. .COUNTED ANOP
  7356. &L       DC    AL.1(0),AL.3(&A),AL.4(&LEN),C&W
  7357.          MEND
  7358. ./       ADD   LIST=ALL,NAME=SCKWR
  7359.          MACRO
  7360. &L       SCKWR &TYPE,&RTN
  7361.          GBLC  &SCANEND(10)
  7362.          GBLA  &SCANCNT
  7363.          GBLC  &SCKWAVS,&SCKWRTN
  7364.          GBLA  &SCKWAVC
  7365.          LCLA  &X
  7366.          AIF   ('&TYPE' EQ 'INIT').INIT
  7367.          AIF   ('&TYPE' EQ 'ADDR').ADDR
  7368.          MNOTE 12,'SCKWR &TYPE IS ILLEGAL'
  7369.          MEXIT
  7370. .*
  7371. .INIT    ANOP
  7372. &SCKWAVS SETC  'AL4'
  7373. &SCKWAVC SETA  0
  7374. &SCKWRTN SETC '0'
  7375.          MEXIT
  7376. .*
  7377. .ADDR    ANOP
  7378.          AIF   ('&RTN' EQ '' OR '&RTN' EQ '0').ZSC
  7379.          AIF   ('&RTN' EQ '*').STAR
  7380. &SCKWRTN SETC  '&RTN'
  7381.          MEXIT
  7382. .*
  7383. .STAR    ANOP
  7384.          AIF   (&SCANCNT LE 0).STARERR
  7385. &SCKWRTN SETC  '&SCANEND(&SCANCNT)'
  7386.          MEXIT
  7387. .*
  7388. .STARERR ANOP
  7389.          MNOTE 12,'SCKW * MUST BE IN RANGE OF SCAN *'
  7390. .*
  7391. .ZSC     ANOP
  7392. &SCKWRTN SETC '0'
  7393. &SCKWAVS SETC  'SL2'
  7394. &SCKWAVC SETA  2
  7395.          MEND
  7396. ./       ADD   LIST=ALL,NAME=SCKWTBL
  7397.          MACRO
  7398. &L       SCKWTBL &TYPE
  7399.          GBLC  &SCKWTBL(42)
  7400.          LCLA  &X
  7401.          LCLC  &LBL
  7402. .*
  7403.          AIF   ('&TYPE' EQ 'BEGIN').BEGIN
  7404.          AIF   ('&TYPE' EQ 'END').END
  7405.          MNOTE 12,'"&TYPE" IS ILLEGAL'
  7406. &L       SYSLBL TYPE=X
  7407.          MEXIT
  7408. .*
  7409. .BEGIN   ANOP
  7410.          AIF   ('&SCKWTBL(1)' EQ '').BEGOK
  7411.          MNOTE 12,'MISSING SCKWTBL END'
  7412.          SCKWTBL END
  7413. .BEGOK   ANOP
  7414. &LBL     SETC  '&L'
  7415. .BEGLOOP ANOP
  7416. &X       SETA  &X+1
  7417. &LBL     SCKWTBLP &X
  7418. &LBL     SETC  ''
  7419.          AIF   (&X LT 42).BEGLOOP
  7420.          MEXIT
  7421. .*
  7422. .END     ANOP
  7423. &L       SYSLBL TYPE=X
  7424.          AIF   ('&SCKWTBL(1)' NE '').ENDOK
  7425.          MNOTE 12,'NO MATCHING SCKWTBL BEGIN'
  7426.          MEXIT
  7427. .ENDOK   ANOP
  7428. .ENDLOOP ANOP
  7429. &X       SETA  &X+1
  7430. &SCKWTBL(&X) EQU 0
  7431. &SCKWTBL(&X) SETC ''
  7432.          AIF   (&X LT 42).ENDLOOP
  7433.          MEND
  7434. ./       ADD   LIST=ALL,NAME=SCKWTBLP
  7435.          MACRO
  7436. &L       SCKWTBLP &X
  7437.          GBLC  &SCKWTBL(42)
  7438. &SCKWTBL(&X) SETC 'SCKW&SYSNDX'
  7439. &L       DC    AL4(&SCKWTBL(&X))
  7440.          MEND
  7441. ./       ADD   LIST=ALL,NAME=SCLAST
  7442.          MACRO
  7443. &L       SCLAST &SCT=SCTSTART
  7444. &L       LM    VR0,VR1,SCTTLEN-SCTSTART+&SCT
  7445.          MEND
  7446. ./       ADD   LIST=ALL,NAME=SCPOP
  7447.          MACRO
  7448. &L       SCPOP &SCT=SCTSTART
  7449. &L       MZC   SCTINIT-SCTSTART+&SCT,SCTINITL
  7450.          SCPOPA 8
  7451.          MMVC  SCTLEN-SCTSTART+&SCT,0(STKR),8
  7452.          MEND
  7453. ./       ADD   LIST=ALL,NAME=SCPOPA
  7454.          MACRO
  7455. &L       SCPOPA &S
  7456. &L       CPOP  ,&S
  7457.          MEND
  7458. ./       ADD   LIST=ALL,NAME=SCPUSH
  7459.          MACRO
  7460. &L       SCPUSH &SCT=SCTSTART
  7461. &L       MMVC  0(STKR),SCTLEN-SCTSTART+&SCT,8
  7462.          SCPUSHA 8
  7463.          MEND
  7464. ./       ADD   LIST=ALL,NAME=SCPUSHA
  7465.          MACRO
  7466. &L       SCPUSHA &S
  7467. &L       CPUSH ,&S
  7468.          MEND
  7469. ./       ADD   LIST=ALL,NAME=SCRTN
  7470.          MACRO
  7471. &L       SCRTN &PRT,&RTNR=YES,&SCT=SCTSTART
  7472.          GBLC  &SCANPRT(10)
  7473.          GBLA  &SCANCNT
  7474.          LCLC  &LBL
  7475.          SYSKWT RTNR,&RTNR,(YES,NO),COND=NO,NULL=NO
  7476. .*
  7477. &LBL     SETC  '&L'
  7478. .*
  7479.          AIF   ('&PRT' EQ '').NPRT
  7480.          AIF   ('&PRT' NE '*').NSTAR
  7481.          AIF   (&SCANCNT GT 0).STAR
  7482.          MNOTE 12,'SCRTN * MUST BE IN RANGE OF SCAN *'
  7483.          AGO   .NPRT
  7484. .*
  7485. .STAR    ANOP
  7486. &LBL     SYSLR VR1,&SCANPRT(&SCANCNT)
  7487. &LBL     SETC  ''
  7488.          ST    VR1,SCTSCKWS-SCTSTART+&SCT
  7489.          AGO   .NPRT
  7490. .*
  7491. .NSTAR   ANOP
  7492. &LBL     SYSLR VR1,&PRT
  7493. &LBL     SETC  ''
  7494.          ST    VR1,SCTSCKWS-SCTSTART+&SCT
  7495. .NPRT    ANOP
  7496. .*
  7497.          AIF   ('&RTNR' NE 'YES').NRTNR
  7498. &LBL     BR    RTNR
  7499.          MEXIT
  7500. .*
  7501. .NRTNR   ANOP
  7502. &LBL     B     SCTRET-SCTSTART+&SCT
  7503.          MEND
  7504. ./       ADD   LIST=ALL,NAME=SCSEMI
  7505.          MACRO
  7506. &L       SCSEMI &SCT=SCTSTART
  7507. &L       L     RTNR,SCTLEN-SCTSTART+&SCT
  7508.          LTR   RTNR,RTNR
  7509.          BNP   SCSC&SYSNDX
  7510.          L     RTNR,SCTLOC-SCTSTART+&SCT
  7511.          CLI   0(RTNR),C';'
  7512.          BNE   SCSC&SYSNDX
  7513.          LA    RTNR,1(,RTNR)
  7514.          ST    RTNR,SCTLOC-SCTSTART+&SCT
  7515.          L     RTNR,SCTLEN-SCTSTART+&SCT
  7516.          BCTR  RTNR,0
  7517.          ST    RTNR,SCTLEN-SCTSTART+&SCT
  7518. SCSC&SYSNDX DS 0H
  7519.          MEND
  7520. ./       ADD   LIST=ALL,NAME=SCT
  7521.          MACRO
  7522. &L       SCT
  7523.          GBLA  &LSCAN
  7524. &L       SYSLBL TYPE=F
  7525. *
  7526. *  NIH/COMMON - SCAN CONTROL TABLE
  7527. *
  7528. SCTSTART DS    0F
  7529. *
  7530. SCTINIT  DS    0F                      START OF AREA TO INITIALIZE
  7531. *
  7532. SCTLEN   DC    F'0'                    LENGTH REMAINING
  7533. SCTLOC   DC    A(0)                    CURRENT LOCATION
  7534. SCTBLEN  DC    F'0'                    LENGTH FOR SCBACK
  7535. SCTBLOC  DC    A(0)                    LOCATION FOR SCBACK
  7536. SCTTLEN  DC    F'0'                    LENGTH OF LAST TOKEN
  7537. SCTTLOC  DC    A(0)                    LOCATION OF LAST TOKEN
  7538. *
  7539. SCTINITL EQU   *-SCTINIT
  7540. *
  7541. SCTERROR DC    A(0)                    LOCATION OF ERROR ROUTINE
  7542. SCTERRP  DC    A(0)                    PARAMETER FOR ERROR ROUTINE
  7543. SCTRTN   DC    A(0)                    SAVED RETURN ADDRESS
  7544. SCTSCKWS DC    A(0)                    SAVED ADDRESS OF SCKW LIST
  7545. SCTTYPE  DC    F'0'                    SCAN TYPE/TABLE
  7546. SCTTOKEN DC    CL&LSCAN.' '            TOKEN PADDED WITH BLANKS
  7547. *
  7548. SCTS370  DC    4F'0'                   370 SIMULATION AREA
  7549.          ORG   SCTS370                 OVERLAY WITH LINKAGE
  7550. *
  7551. SCTCALL  DS    0F                      LINKAGE TO PROCESSING ROUTINE
  7552.          CBASE RTNR                    GET BASE
  7553. SCTBASE1 L     RTNR,SCTENTRY-SCTBASE1(,RTNR)  ENTRY ADDRESS
  7554.          CBALR RTNR,RTNR               CALL PROCESSING ROUTINE
  7555. SCTRET   CBASE VRF                     GET BASE ON RETURN
  7556. SCTBASE2 L     RTNR,SCTREENT-SCTBASE2(,VRF)  ENTRY ADDR FOR SCANNER
  7557.          BR    RTNR                    GO TO SCANNER
  7558. SCTREENT DC    A(0)                    SCANNER ADDRESS
  7559. SCTCALLL EQU   *-SCTCALL               LENGTH OF LINKAGE
  7560. SCTENTRY DC    A(0)                    ENTRY POINT OF PROCESSING RTN
  7561. *
  7562.          DS    0F
  7563. SCTSIZE  EQU   *-SCTSTART
  7564. *
  7565. *  ENTRY CODES FOR ERROR ROUTINE
  7566. *
  7567. SCTCUBQ  EQU   00                      UNBALANCED QUOTES
  7568. SCTCUBP  EQU   04                      UNBALANCED PARENTHESES
  7569. SCTCIXM  EQU   08                      INTEGER EXCEEDS MAXIMUM
  7570. SCTCOXM  EQU   12                      ORDINAL EXCEEDS MAXIMUM
  7571. SCTCLNXM EQU   16                      LINE NUMBER EXCEEDS MAXIMUM
  7572. SCTCZNG  EQU   20                      "POSITIVE" VALUE WAS ZERO
  7573. SCTCLXM  EQU   24                      TOKEN LENGTH EXCEEDS MAXIMUM
  7574. SCTCUE   EQU   28                      TOKEN MISSING (UNEXPECTED END)
  7575. SCTCZBV  EQU   32                      ZERO BRANCH VALUE (A OR V)
  7576. SCTCSCD  EQU   36                      SOMETHING FOUND BY SCDONE
  7577. SCTCBXN  EQU   40                      BAD HEX NUMBER
  7578. SCTCBXS  EQU   44                      BAD HEX STRING
  7579. SCTCNQ   EQU   48                      REQUIRED QUOTES MISSING
  7580. SCTCNP   EQU   52                      REQUIRES PARENTHESES MISSING
  7581. SCTCBINT EQU   56                      BAD INTEGER
  7582. SCTCBORD EQU   60                      BAD ORDINAL
  7583. SCTCBLN  EQU   64                      BAD LINE NUMBER
  7584. *
  7585. SCTCMAX  EQU   SCTCBLN                 MAX CODE
  7586.          MEND
  7587. ./       ADD   LIST=ALL,NAME=SCTELL
  7588.          MACRO
  7589. &L       SCTELL &SCT=SCTSTART
  7590. &L       LM    VR0,VR1,SCTLEN-SCTSTART+&SCT
  7591.          MEND
  7592. ./       ADD   LIST=ALL,NAME=SCTYPE
  7593.          MACRO
  7594. &L       SCTYPE &NEW=,&OLD=,&SCT=SCTSTART
  7595. &L  SYSLST SCTTYPE-SCTSTART+&SCT,NEW=&NEW,OLD=&OLD,LOAD=LOADB,STORE=STC
  7596.          MEND
  7597. ./       ADD   LIST=ALL,NAME=SF
  7598.          MACRO
  7599. &L       SF
  7600.          LCLA  &X,&Y,&Z,&I
  7601.          LCLC  &F(16)
  7602. .*
  7603.          AIF   (N'&SYSLIST LT 1).NONE
  7604. .LOOP    ANOP
  7605. &X       SETA  &X+1
  7606.          AIF   (&X GT N'&SYSLIST).DONE
  7607. .*
  7608.          AIF   (&Z GE 16).MANY
  7609. .*
  7610. &F(&Z+1) SETC  '+L'''(1,3)
  7611. &F(&Z+2) SETC  '&SYSLIST(&X)'
  7612. &I       SETA  0
  7613. .SCAN    ANOP
  7614. &I       SETA  &I+1
  7615.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  7616.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  7617.          AIF   (&I LE 1).SCANOK
  7618. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  7619. .SCANOK  ANOP
  7620. .*
  7621. &Y       SETA  &Z+2
  7622. .CHECK   ANOP
  7623. &Y       SETA  &Y-2
  7624.          AIF   (&Y LT 2).UNIQUE
  7625.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  7626.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  7627. &F(&Z+1) SETC  ''
  7628. &F(&Z+2) SETC  ''
  7629.          AGO   .LOOP
  7630. .*
  7631. .UNIQUE  ANOP
  7632.          AIF   (&X LE 1).NTEST
  7633.          OI    0,(&F(&Z+2)-&F(2))*256
  7634.          ORG   *-4
  7635. .NTEST   ANOP
  7636. &Z       SETA  &Z+2
  7637.          AGO   .LOOP
  7638. .*
  7639. .DONE    ANOP
  7640. &F(1)    SETC  'L'''(1,2)
  7641. &L       OI    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  7642.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  7643.          MEXIT
  7644. .*
  7645. .NONE    ANOP
  7646.          MNOTE 12,'NO FLAGS SPECIFIED'
  7647.          CLI   *+1,0
  7648.          MEXIT
  7649. .*
  7650. .MANY    ANOP
  7651.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  7652.          AGO   .DONE
  7653.          MEND
  7654. ./       ADD   LIST=ALL,NAME=SI
  7655.          MACRO
  7656. &L       SI    &R,&V
  7657.          LCLA  &X
  7658.          AIF   ('&V' EQ '2').BCTR2
  7659.          AIF   ('&V' EQ '1').BCTR1
  7660. .LOOP    ANOP
  7661. &X       SETA  &X+1
  7662.          AIF   (&X GT K'&V).F
  7663.          AIF   ('&V'(&X,1) GE '0').LOOP
  7664.          AIF  (&X EQ 1 AND ('&V'(1,1) EQ '-' OR '&V'(1,1) EQ '+')).LOOP
  7665. &L       SL    &R,=A(&V)
  7666.          MEXIT
  7667. .F       ANOP
  7668. &L       SL    &R,=F'&V'
  7669.          MEXIT
  7670. .BCTR2   ANOP
  7671. &L       BCTR  &R,0
  7672.          BCTR  &R,0
  7673.          MEXIT
  7674. .BCTR1   ANOP
  7675. &L       BCTR  &R,0
  7676.          MEND
  7677. ./       ADD   LIST=ALL,NAME=SIM370
  7678.          MACRO
  7679. &L       SIM370 &WORDS,&CLEAR=
  7680.          GBLC  &SIM370
  7681.          SYSKWT CLEAR,&CLEAR,(YES,NO),COND=NO
  7682.          AIF   ('&CLEAR' EQ 'YES').CLEAR
  7683. &L       SYSLBL
  7684. &SIM370  SETC  '&WORDS'
  7685.          AIF   ('&WORDS' NE '').END
  7686. &SIM370  SETC  '*NO*370*'
  7687.          MEXIT
  7688. .*
  7689. .CLEAR   ANOP
  7690. &L       MZC   &WORDS,16
  7691. &SIM370  SETC  '&WORDS'
  7692. .END     MEND
  7693. ./       ADD   LIST=ALL,NAME=STOREB
  7694.          MACRO
  7695. &L       STOREB &R,&A
  7696. &L       STC   &R,&A
  7697.          MEND
  7698. ./       ADD   LIST=ALL,NAME=STOREF
  7699.          MACRO
  7700. &L       STOREF &R,&A
  7701.          GBLC  &CPU,&SIM370
  7702.          AIF   ('&CPU' EQ '360').S360
  7703. &L       UAOP  ST,&R,&A
  7704.          MEXIT
  7705. .S360    ANOP
  7706. &L       ST    &R,&SIM370
  7707.          SYSXXCB MVC,&A,&SIM370,4
  7708.          MEND
  7709. ./       ADD   LIST=ALL,NAME=STOREH
  7710.          MACRO
  7711. &L       STOREH &R,&A
  7712.          GBLC  &CPU,&SIM370
  7713.          AIF   ('&CPU' EQ '360').S360
  7714. &L       UAOP  STH,&R,&A
  7715.          MEXIT
  7716. .S360    ANOP
  7717. &L       ST    &R,&SIM370
  7718.          MMVC  &A,2+&SIM370,2
  7719.          MEND
  7720. ./       ADD   LIST=ALL,NAME=STORELF
  7721.          MACRO
  7722. &L       STORELF &R,&A
  7723. &L       STOREF &R,&A
  7724.          MEND
  7725. ./       ADD   LIST=ALL,NAME=STORELH
  7726.          MACRO
  7727. &L       STORELH &R,&A
  7728. &L       STOREH &R,&A
  7729.          MEND
  7730. ./       ADD   LIST=ALL,NAME=STOREP
  7731.          MACRO
  7732. &L       STOREP &R,&A
  7733.          GBLC  &CPU,&SIM370
  7734.          AIF   ('&CPU' EQ '360').S360
  7735. &L       STCM  &R,7,&A
  7736.          MEXIT
  7737. .S360    ANOP
  7738. &L       ST    &R,&SIM370
  7739.          MMVC  &A,1+&SIM370,3
  7740.          MEND
  7741. ./       ADD   LIST=ALL,NAME=STRIP
  7742.          MACRO
  7743. &L       STRIP &S,&N,&W,&TYPE=RIGHT,&ZERO=YES,&NULL=YES,&LABEL=,&FILL=0
  7744. &L       DEBLANK &S,&N,&W,TYPE=&TYPE,ZERO=&ZERO,NULL=&NULL,            *
  7745.                LABEL=&LABEL,FILL=&FILL
  7746.          MEND
  7747. ./       ADD   LIST=ALL,NAME=SUBB
  7748.          MACRO
  7749. &L       SUBB  &R,&A
  7750.          GBLC  &SIM370
  7751. &L       MMVC  4*3+3+&SIM370,&A,1
  7752.          SL    &R,4*3+&SIM370
  7753.          MEND
  7754. ./       ADD   LIST=ALL,NAME=SUBF
  7755.          MACRO
  7756. &L       SUBF  &R,&A
  7757.          GBLC  &CPU,&SIM370
  7758.          AIF   ('&CPU' EQ '360').S360
  7759. &L       UAOP  S,&R,&A
  7760.          MEXIT
  7761. .S360    ANOP
  7762. &L       MMVC  &SIM370,&A,4
  7763.          S     &R,&SIM370
  7764.          MEND
  7765. ./       ADD   LIST=ALL,NAME=SUBH
  7766.          MACRO
  7767. &L       SUBH  &R,&A
  7768.          GBLC  &CPU,&SIM370
  7769.          AIF   ('&CPU' EQ '360').S360
  7770. &L       UAOP  SH,&R,&A
  7771.          MEXIT
  7772. .S360    ANOP
  7773. &L       MMVC  &SIM370,&A,2
  7774.          SH    &R,&SIM370
  7775.          MEND
  7776. ./       ADD   LIST=ALL,NAME=SUBLF
  7777.          MACRO
  7778. &L       SUBLF &R,&A
  7779.          GBLC  &CPU,&SIM370
  7780.          AIF   ('&CPU' EQ '360').S360
  7781. &L       UAOP  SL,&R,&A
  7782.          MEXIT
  7783. .S360    ANOP
  7784. &L       MMVC  &SIM370,&A,4
  7785.          SL    &R,&SIM370
  7786.          MEND
  7787. ./       ADD   LIST=ALL,NAME=SUBLH
  7788.          MACRO
  7789. &L       SUBLH &R,&A
  7790.          GBLC  &SIM370
  7791. &L       MMVC  4*2+2+&SIM370,&A,2
  7792.          SL    &R,4*2+&SIM370
  7793.          MEND
  7794. ./       ADD   LIST=ALL,NAME=SUBP
  7795.          MACRO
  7796. &L       SUBP  &R,&A
  7797.          GBLC  &SIM370
  7798. &L       MMVC  4*1+1+&SIM370,&A,3
  7799.          SL    &R,4*1+&SIM370
  7800.          MEND
  7801. ./       ADD   LIST=ALL,NAME=SUBTITLE
  7802.          MACRO
  7803. &L       SUBTITLE &T
  7804. &L       SYSLBL
  7805.          TITLE &T
  7806.          MEND
  7807. ./       ADD   LIST=ALL,NAME=SYSBIT
  7808.          MACRO
  7809. &L       SYSBIT &A,&B,&SET=,&RESET=
  7810.          SYSKWT SET,&SET,(YES,NO,ONLY),COND=NO
  7811.          SYSKWT RESET,&RESET,(YES,NO,ONLY),COND=NO
  7812.          AIF   ('&SET' EQ '' OR '&RESET' EQ '').OK
  7813.          AIF   ('&SET' EQ 'NO' OR '&RESET' EQ 'NO').OK
  7814.          MNOTE 12,'CANNOT SPECIFY BOTH SET AND RESET'
  7815. .OK      ANOP
  7816.          AIF   ('&RESET' NE '' AND '&RESET' NE 'NO').RESET
  7817. .*
  7818. .*  SET
  7819. .*
  7820.          AIF   ('&SET' EQ 'ONLY').SONLY
  7821. &L       TM    &A,&B
  7822.          AIF   ('&SET' NE 'YES').END
  7823.          BO    *+12
  7824.          OI    &A,&B
  7825.          CLI   *+1,0
  7826.          MEXIT
  7827. .SONLY   ANOP
  7828. &L       OI    &A,&B
  7829.          MEXIT
  7830. .*
  7831. .*  RESET
  7832. .*
  7833. .RESET   ANOP
  7834.          AIF   ('&RESET' EQ 'ONLY').RONLY
  7835. &L       TM    &A,&B
  7836.          BZ    *+12
  7837.          NI    &A,255-(&B)
  7838.          TM    *+1,255
  7839.          MEXIT
  7840. .RONLY   ANOP
  7841. &L       NI    &A,255-(&B)
  7842. .END     MEND
  7843. ./       ADD   LIST=ALL,NAME=SYSCMP
  7844.          MACRO
  7845. &L       SYSCMP &A,&R,&B,&MSG=
  7846. &L       SYSLBL
  7847.          AIF   ('&MSG' EQ '').STD
  7848.          MNOTE *,&MSG
  7849.          AGO   .COM
  7850. .STD     ANOP
  7851.          MNOTE *,'ERROR BELOW IF &A NOT &R &B'
  7852. .COM     ANOP
  7853. .*
  7854. .*  BRANCH ON RELATION
  7855. .*
  7856.          AIF   ('&R' EQ 'LT').LT
  7857.          AIF   ('&R' EQ 'NGE').LT
  7858.          AIF   ('&R' EQ 'LE').LE
  7859.          AIF   ('&R' EQ 'NGT').LE
  7860.          AIF   ('&R' EQ 'EQ').EQ
  7861.          AIF   ('&R' EQ 'GE').GE
  7862.          AIF   ('&R' EQ 'NLT').GE
  7863.          AIF   ('&R' EQ 'GT').GT
  7864.          AIF   ('&R' EQ 'NLE').GT
  7865.          AIF   ('&R' EQ 'NEQ' OR '&R' EQ 'NE').NEQ
  7866.          MNOTE 12,'"&R" IS AN ILLEGAL RELATION'
  7867.          MEXIT
  7868. .*
  7869. .LT      DS    0CL(&B-(&A))
  7870.          MEXIT
  7871. .*
  7872. .LE      DS    0CL(&B+1-(&A))
  7873.          MEXIT
  7874. .*
  7875. .EQ      DS    0CL(&B+1-(&A)),0CL(&A+1-(&B))
  7876.          MEXIT
  7877. .*
  7878. .GE      DS    0CL(&A+1-(&B))
  7879.          MEXIT
  7880. .*
  7881. .GT      DS    0CL(&A-(&B))
  7882.          MEXIT
  7883. .*
  7884. .NEQ     DS    0CL(2-((&A)/(&B))/((&A)/(&B))-((&B)/(&A))/((&B)/(&A)))
  7885.          MEND
  7886. ./       ADD   LIST=ALL,NAME=SYSKWT
  7887.          MACRO
  7888. &L       SYSKWT &NAME,&KWS,&LEGAL,&COND=,&NULL=
  7889.          LCLA  &X
  7890.          AIF   ('&KWS' EQ '' AND '&NULL' NE '').ERROR
  7891.          AIF   ('&KWS' EQ '').END
  7892.          AIF   ('&COND' EQ '').COND
  7893.          AIF   ('&COND' EQ 'YES').COND
  7894.          AIF   ('&COND'(1,1) EQ '(').CONDL
  7895.          AIF   ('&KWS'(1,1) EQ '(').ERROR
  7896.          AGO   .COND
  7897. .CONDL   AIF   ('&KWS'(1,1) NE '(').COND
  7898. &X       SETA  1
  7899. .LOOPL   AIF   (&X GT N'&COND).ERROR
  7900.          AIF   ('&KWS(1)' EQ '&COND(&X)').COND
  7901. &X       SETA  &X+1
  7902.          AGO   .LOOPL
  7903. .COND    ANOP
  7904. &X       SETA  1
  7905. .LOOP    AIF   (&X GT N'&LEGAL).ERROR
  7906.          AIF   ('&KWS(1)' EQ '&LEGAL(&X)').END
  7907. &X       SETA  &X+1
  7908.          AGO   .LOOP
  7909. .ERROR   AIF   ('&NAME' EQ '').POSERR
  7910.          MNOTE 12,'"&NAME=&KWS" IS ILLEGAL'
  7911.          MEXIT
  7912. .POSERR  MNOTE 12,'"&KWS" IS ILLEGAL'
  7913. .END     MEND
  7914. ./       ADD   LIST=ALL,NAME=SYSLBL
  7915.          MACRO
  7916. &L       SYSLBL &TYPE=H
  7917.          AIF   ('&L' EQ '').END
  7918. &L       DS    0&TYPE
  7919. .END     MEND
  7920. ./       ADD   LIST=ALL,NAME=SYSLR
  7921.          MACRO
  7922. &L      SYSLR &R,&P,&TYPE=,&SELECT=,&NULL=0,&ERR=,&OP=LA,<R=,&STRLEN=
  7923.          LCLA  &X,&PT,&KC(32)
  7924.          LCLB  &LCR
  7925.          LCLC  &C(32),&LABEL,&OPC
  7926. .*
  7927. .*  CHECK FOR LITERAL STRING
  7928. .*
  7929.          AIF   ('&P' EQ '').NSTRING
  7930.          AIF   ('&P'(1,1) NE '''' OR '&STRLEN' EQ '').NSTRING
  7931. &L       SYSLR &R,=CL&STRLEN&P,TYPE=&TYPE,SELECT=&SELECT,NULL=&NULL,   *
  7932.                ERR=&ERR,OP=&OP,LTR=<R
  7933.          MEXIT
  7934. .*
  7935. .NSTRING ANOP
  7936. .*
  7937. .*  CHECK FOR COMPLEMENT CONDITIONS
  7938. .*
  7939.          AIF   ('&TYPE' EQ '').GO
  7940. &LCR     SETB  1
  7941.          AIF   ('&SELECT' EQ '').GO
  7942. &X       SETA  1
  7943. .LOUP    AIF   (&X GT N'&SELECT).LOUPEND
  7944.          AIF   ('&TYPE(1)' EQ '&SELECT(&X)').GO
  7945. &X       SETA  &X+1
  7946.          AGO   .LOUP
  7947. .LOUPEND ANOP
  7948. &LCR     SETB  0
  7949. .GO      ANOP
  7950. .*
  7951. .*  CHECK FOR AND HANDLE OMITTED OPERAND
  7952. .*
  7953.          AIF   ('&P' NE '').NBL
  7954.          AIF   ('&ERR' EQ '').NERR
  7955.          MNOTE 12,&ERR
  7956. .NERR    AIF   ('&NULL' EQ '').LBL
  7957.          AIF   ('&NULL' EQ '0').SR
  7958. &L       SYSLR &R,&NULL,NULL=,OP=&OP,TYPE=&TYPE,SELECT=&SELECT,LTR=<R
  7959.          MEXIT
  7960. .LBL     ANOP
  7961.          AIF   ('<R' NE '').LBLLTR
  7962. &L       SYSLBL
  7963.          MEXIT
  7964. .LBLLTR  ANOP
  7965. &L       LTR   &R,&R
  7966.          MEXIT
  7967. .*
  7968. .*  CHECK FOR REGISTER OR ZERO
  7969. .*
  7970. .NBL     AIF   ('&P'(1,1) EQ '(').REG
  7971.          AIF   ('&P' EQ '0').SR
  7972. .*
  7973. .*  ISOLATE OPCODE AND PROCESS
  7974. .*
  7975. &LABEL   SETC  '&L'
  7976. &OPC     SETC  '&OP'
  7977.          AIF   (K'&P LE 2).EXPR
  7978.          AIF   ('&P'(1,2) EQ 'L:').L
  7979.          AIF   (K'&P LE 3).EXPR
  7980.          AIF   ('&P'(1,3) EQ 'LA:').LX
  7981.          AIF   ('&P'(1,3) EQ 'LH:').LX
  7982.          AIF   ('&P'(1,3) EQ 'IC:').IC
  7983.          AIF   (K'&P LE 6).EXPR
  7984.          AIF   ('&P'(1,6) EQ 'LOADB:').LOADX
  7985.          AIF   ('&P'(1,6) EQ 'LOADH:').LOADX
  7986.          AIF   ('&P'(1,6) EQ 'LOADP:').LOADX
  7987.          AIF   ('&P'(1,6) EQ 'LOADF:').LOADX
  7988.          AIF   (K'&P LE 7).EXPR
  7989.          AIF   ('&P'(1,7) EQ 'LOADLH:').LOADXX
  7990.          AIF   ('&P'(1,7) EQ 'LOADLF:').LOADXX
  7991.          AGO   .EXPR
  7992. .LOADX   ANOP
  7993. &PT      SETA  6
  7994.          AGO   .DO
  7995. .LOADXX  ANOP
  7996. &PT      SETA  7
  7997.          AGO   .DO
  7998. .IC      ANOP
  7999. &L       SLR   &R,&R
  8000. &LABEL   SETC  ''
  8001. .LX      ANOP
  8002. &PT      SETA  3
  8003.          AGO   .DO
  8004. .L       ANOP
  8005. &PT      SETA  2
  8006. .DO      ANOP
  8007. &OPC     SETC  '&P'(1,&PT-1)
  8008. .EXPR    ANOP
  8009. &X       SETA  1
  8010. .LOOP    AIF   (K'&P-&PT LE &X*8).BIT
  8011. &KC(&X)  SETA  8
  8012. &C(&X)   SETC  '&P'(&PT+(&X-1)*8+1,8)
  8013. &X       SETA  &X+1
  8014.          AGO   .LOOP
  8015. .BIT     ANOP
  8016. &KC(&X)  SETA  K'&P-&PT-(&X-1)*8
  8017. &C(&X)   SETC  '&P'(&PT+(&X-1)*8+1,&KC(&X))
  8018.          AIF   ('&C(1)'(1,1) NE ':').NLIT
  8019. &C(1)    SETC  '='.'&C(1)'(2,&KC(1)-1)
  8020. .NLIT    ANOP
  8021.          AIF   ('&OPC' EQ 'LOADB').LOADB
  8022.          AIF   ('&OPC' EQ 'LOADH').LOADH
  8023.          AIF   ('&OPC' EQ 'LOADLH').LOADLH
  8024.          AIF   ('&OPC' EQ 'LOADP').LOADP
  8025.          AIF   ('&OPC' EQ 'LOADF').LOADF
  8026.          AIF   ('&OPC' EQ 'LOADLF').LOADLF
  8027.          AIF   ('&OPC' EQ 'LITA').LITA
  8028.          AIF   ('&OPC' EQ 'LITF').LITF
  8029.          AIF   ('&OPC' EQ 'LITH').LITH
  8030.          AIF   ('&OPC' EQ 'LITY').LITY
  8031. &LABEL  SYSLROP &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8032.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8033.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8034.                )&C(30)&C(31)&C(32),OP=&OPC
  8035. .COM     AIF   (NOT &LCR).COMLTR
  8036.          SYSTANDB &TYPE,2,LCR,&R,&R
  8037.          AIF   ('&TYPE'(1,1) NE '(').END
  8038. .COMLTR  ANOP
  8039.          AIF   ('<R' EQ '').END
  8040.          LTR   &R,&R
  8041.          MEXIT
  8042. .LOADB   ANOP
  8043. &LABEL   LOADB  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8044.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8045.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8046.                )&C(30)&C(31)&C(32)
  8047.          AGO   .COM
  8048. .LOADH   ANOP
  8049. &LABEL   LOADH  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8050.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8051.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8052.                )&C(30)&C(31)&C(32)
  8053.          AGO   .COM
  8054. .LOADLH  ANOP
  8055. &LABEL   LOADLH &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8056.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8057.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8058.                )&C(30)&C(31)&C(32)
  8059.          AGO   .COM
  8060. .LOADP   ANOP
  8061. &LABEL   LOADP  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8062.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8063.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8064.                )&C(30)&C(31)&C(32)
  8065.          AGO   .COM
  8066. .LOADF   ANOP
  8067. &LABEL   LOADF  &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8068.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8069.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8070.                )&C(30)&C(31)&C(32)
  8071.          AGO   .COM
  8072. .LOADLF  ANOP
  8073. &LABEL   LOADLF &R,&C(1)&C(2)&C(3)&C(4)&C(5)&C(6)&C(7)&C(8)&C(9)&C(10)&*
  8074.                C(11)&C(12)&C(13)&C(14)&C(15)&C(16)&C(17)&C(18)&C(19)&C(*
  8075.                20)&C(21)&C(22)&C(23)&C(24)&C(25)&C(26)&C(27)&C(28)&C(29*
  8076.                )&C(30)&C(31)&C(32)
  8077.          AGO   .COM
  8078. .LITA    ANOP
  8079. &LABEL   L     &R,=A(&P)
  8080.          AGO   .COM
  8081. .LITF    ANOP
  8082. &LABEL   L     &R,=F'&P'
  8083.          AGO   .COM
  8084. .LITH    ANOP
  8085. &LABEL   LH    &R,=H'&P'
  8086.          AGO   .COM
  8087. .LITY    ANOP
  8088. &LABEL   LH    &R,=AL2(&P)
  8089.          AGO   .COM
  8090. .*
  8091. .*  HANDLE ZERO
  8092. .*
  8093. .SR      ANOP
  8094. &L       SLR   &R,&R
  8095.          MEXIT
  8096. .*
  8097. .*  HANDLE REGISTER
  8098. .*
  8099. .REG     AIF   (&LCR).LCR
  8100.          AIF   ('(&R)' EQ '&P').LBL
  8101.          AIF   ('<R' NE '').LTR
  8102. &L       LR    &R,&P
  8103.          MEXIT
  8104. .LTR     ANOP
  8105. &L       LTR   &R,&P
  8106.          MEXIT
  8107. .LCR     ANOP
  8108.          AIF   ('&TYPE'(1,1) EQ '(').LCRX
  8109. &L       LCR   &R,&P
  8110.          MEXIT
  8111. .LCRX    ANOP
  8112. &L       LR    &R,&P
  8113.          SYSTANDB &TYPE,2,LCR,&R,&R
  8114.          AIF   ('<R' EQ '').END
  8115.          LTR   &R,&R
  8116. .END     MEND
  8117. ./       ADD   LIST=ALL,NAME=SYSLROP
  8118.          MACRO
  8119. &L       SYSLROP &R,&A,&OP=
  8120. &L       &OP   &R,&A
  8121.          MEND
  8122. ./       ADD   LIST=ALL,NAME=SYSLST
  8123.          MACRO
  8124. &L       SYSLST &LOC,&NEW=,&OLD=,&LOAD=L,&STORE=ST,&OP=LA,®=RTNR
  8125.          AIF   ('&NEW' EQ '').NNEW
  8126.          AIF   ('&OLD' EQ '').NEWNOLD
  8127.          AIF   ('&NEW'(1,1) EQ '(' AND '&NEW' NE '(&OLD)').RNEWOLD
  8128.          AIF   (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB')           *
  8129.                OR '&OP' NE 'LA').NMVI
  8130.          AIF   ('&NEW'(1,1) EQ '(').NMVI
  8131.          AIF   (K'&NEW LE 2).MVI
  8132.          AIF   ('&NEW'(1,2) EQ 'L:').NMVI
  8133.          AIF   (K'&NEW LE 3).MVI
  8134.          AIF   ('&NEW'(1,3) EQ 'LA:').NMVI
  8135.          AIF   ('&NEW'(1,3) EQ 'LH:').NMVI
  8136.          AIF   ('&NEW'(1,3) EQ 'IC:').NMVI
  8137.          AIF   (K'&NEW LE 6).MVI
  8138.          AIF   ('&NEW'(1,6) EQ 'LOADB:').NMVI
  8139.          AIF   ('&NEW'(1,6) EQ 'LOADH:').NMVI
  8140.          AIF   ('&NEW'(1,6) EQ 'LOADP:').NMVI
  8141.          AIF   ('&NEW'(1,6) EQ 'LOADF:').NMVI
  8142.          AIF   (K'&NEW LE 7).MVI
  8143.          AIF   ('&NEW'(1,7) EQ 'LOADLH:').NMVI
  8144.          AIF   ('&NEW'(1,7) EQ 'LOADLF:').NMVI
  8145.          AGO   .MVI
  8146. .NMVI    ANOP
  8147. &L       SYSLR ®,&NEW,OP=&OP
  8148.          SYSLR &OLD,&LOC,OP=&LOAD
  8149.          SYSLSTS &STORE,®,&LOC
  8150.          MEXIT
  8151. .*
  8152. .MVI     ANOP
  8153. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8154.          MVI   &LOC,&NEW
  8155.          MEXIT
  8156. .*
  8157. .RNEWOLD ANOP
  8158. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8159.          SYSLSTS &STORE,&NEW,&LOC
  8160.          MEXIT
  8161. .*
  8162. .NEWNOLD ANOP
  8163.          AIF   ('&NEW'(1,1) EQ '(').RNEWNOL
  8164.          AIF   (('&STORE' NE 'STC' AND '&STORE' NE 'STOREB')           *
  8165.                OR '&OP' NE 'LA').NMVINOL
  8166.          AIF   ('&NEW'(1,1) EQ '(').NMVINOL
  8167.          AIF   (K'&NEW LE 2).MVINOLD
  8168.          AIF   ('&NEW'(1,2) EQ 'L:').NMVINOL
  8169.          AIF   (K'&NEW LE 3).MVINOLD
  8170.          AIF   ('&NEW'(1,3) EQ 'LA:').NMVINOL
  8171.          AIF   ('&NEW'(1,3) EQ 'LH:').NMVINOL
  8172.          AIF   ('&NEW'(1,3) EQ 'IC:').NMVINOL
  8173.          AIF   (K'&NEW LE 6).MVINOLD
  8174.          AIF   ('&NEW'(1,6) EQ 'LOADB:').NMVINOL
  8175.          AIF   ('&NEW'(1,6) EQ 'LOADH:').NMVINOL
  8176.          AIF   ('&NEW'(1,6) EQ 'LOADP:').NMVINOL
  8177.          AIF   ('&NEW'(1,6) EQ 'LOADF:').NMVINOL
  8178.          AIF   (K'&NEW LE 7).MVINOLD
  8179.          AIF   ('&NEW'(1,7) EQ 'LOADLH:').NMVINOL
  8180.          AIF   ('&NEW'(1,7) EQ 'LOADLF:').NMVINOL
  8181.          AGO   .MVINOLD
  8182. .NMVINOL ANOP
  8183. &L       SYSLR ®,&NEW,OP=&OP
  8184.          SYSLSTS &STORE,®,&LOC
  8185.          MEXIT
  8186. .*
  8187. .MVINOLD ANOP
  8188. &L       MVI   &LOC,&NEW
  8189.          MEXIT
  8190. .*
  8191. .RNEWNOL ANOP
  8192. &L       SYSLSTS &STORE,&NEW,&LOC
  8193.          MEXIT
  8194. .*
  8195. .NNEW    ANOP
  8196.          AIF   ('&OLD' EQ '').ERROR
  8197. &L       SYSLR &OLD,&LOC,OP=&LOAD
  8198.          MEXIT
  8199. .*
  8200. .ERROR   ANOP
  8201.          MNOTE 12,'EITHER NEW OR OLD (OR BOTH) MUST BE SPECIFIED'
  8202.          MEND
  8203. ./       ADD   LIST=ALL,NAME=SYSLSTS
  8204. ALP;
  8205.  
  8206. MACRO &&L: SYSLSTS &&OP,&&R,&&A;
  8207.    ASM CASE '&OP';
  8208.       'STOREB': <&&L: STOREB &&R,&&A>;
  8209.       'STOREH','STORELH': <&&L: STOREH &&R,&&A>;
  8210.       'STOREP': <&&L: STOREP &&R,&&A>;
  8211.       'STOREF','STORELF': <&&L: STOREF &&R,&&A>;
  8212.       ENDCASE
  8213.    ELSE BEGIN
  8214.       BAL;
  8215. &L &OP &R,&A
  8216. ALP;
  8217.       END;
  8218.    MEND;
  8219. BAL;
  8220. ./       ADD   LIST=ALL,NAME=SYSLV
  8221.          MACRO
  8222. &L       SYSLV
  8223.          LCLA  &X,&Y,&V
  8224.          LCLB  &SW(97)
  8225. .*
  8226. .*  COMPUTE INITIAL VALUE FOR REGISTER
  8227. .*
  8228. &X       SETA  2-3
  8229. .VLOOP   ANOP
  8230. &X       SETA  &X+3
  8231.          AIF   (&X GT N'&SYSLIST).VDONE
  8232.          AIF   ('&SYSLIST(&X+1)' EQ '').VLOOP
  8233.          AIF   ('&SYSLIST(&X+2)' EQ '').VADD
  8234. &Y       SETA  1
  8235. .SLOOP   ANOP
  8236.          AIF   ('&SYSLIST(&X+1,1)' EQ '&SYSLIST(&X+2,&Y)').VADD
  8237. &Y       SETA  &Y+1
  8238.          AIF   (&Y LE N'&SYSLIST(&X+2)).SLOOP
  8239.          AGO   .VLOOP
  8240. .VADD    ANOP
  8241. &SW(&X)  SETB  1
  8242.          AIF   ('&SYSLIST(&X+1)'(1,1) EQ '(').VLOOP
  8243. &V       SETA  &V+&SYSLIST(&X+0)
  8244.          AGO   .VLOOP
  8245. .VDONE   ANOP
  8246.          AIF   (&V LT 4096).LA
  8247. &L       L     &SYSLIST(1),=F'&V'
  8248.          AGO   .DOTEST
  8249. .*
  8250. .LA      ANOP
  8251. &L       SYSLR &SYSLIST(1),&V
  8252. .*
  8253. .*  SEARCH FOR TEST REQUESTS
  8254. .*
  8255. .DOTEST  ANOP
  8256. &X       SETA  2-3
  8257. .TLOOP   ANOP
  8258. &X       SETA  &X+3
  8259.          AIF   (&X GT N'&SYSLIST).TDONE
  8260.          AIF   (NOT &SW(&X)).TLOOP
  8261.          AIF   ('&SYSLIST(&X+1)'(1,1) NE '(').TLOOP
  8262.          AIF   ('&SYSLIST(1)' EQ 'VR0').VR0
  8263.     SYSTANDB &SYSLIST(&X+1),4,LA,&SYSLIST(1),&SYSLIST(&X)(,&SYSLIST(1))
  8264.          AGO   .TLOOP
  8265. .*
  8266. .VR0     SYSTANDB &SYSLIST(&X+1),4,A,VR0,=F'&SYSLIST(&X)'
  8267.          AGO   .TLOOP
  8268. .*
  8269. .TDONE   ANOP
  8270.          MEND
  8271. ./       ADD   LIST=ALL,NAME=SYSPRED
  8272. ALP;
  8273.  
  8274. MACRO &&L: SYSPRED &&LBL,&&IF=,&&BRANCH=TRUE;
  8275.    LCLA &&X;
  8276.    LCLC &&LBLEND;
  8277.  
  8278.    SYSKWT BRANCH,&&BRANCH,(TRUE,FALSE),COND=NO,NULL=NO;
  8279.  
  8280.    &&L: SYSLBL;
  8281.    ASM FOR &&X FROM 1 BY 5 TO N'&&IF DO BEGIN
  8282.       ASM CASE '&IF(&X)';  % GENERATE INSTRUCTION
  8283.          'TF': BEGIN
  8284.             ASM IF ('&IF(&X+2)' EQ '')
  8285.             THEN TF &&IF(&&X+1)
  8286.             ELSE TF &&IF(&&X+1),&&IF(&&X+2);
  8287.             END;
  8288.          '': BEGIN
  8289.             ASM IF ('&IF(&X+1)&IF(&X+2)' NE '')
  8290.             THEN MNOTE 12,'NULL OPCODE MUST HAVE NULL OPERANDS';
  8291.             END;
  8292.          ENDCASE
  8293.       ELSE BEGIN
  8294.          BAL;
  8295.          &IF(&X) &IF(&X+1),&IF(&X+2)
  8296.          ALP;
  8297.          END;
  8298.       ASM CASE '&BRANCH';
  8299.          'TRUE','': BEGIN
  8300.             ASM CASE '&IF(&X+4)';
  8301.                'OR': BEGIN
  8302.                   SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8303.                   END;
  8304.                '': BEGIN
  8305.                   ASM IF (&&X+5 LT N'&&IF)
  8306.                   THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
  8307.                   SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8308.                   END;
  8309.                'AND': BEGIN
  8310.                   &&LBLEND: SETC 'PRED&@';
  8311.                   SYSPREDB N&&IF(&&X+3),&&LBLEND;  % BR IF FALSE
  8312.                   END;
  8313.                ENDCASE
  8314.             ELSE BEGIN
  8315.                MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
  8316.                SYSPREDB &&IF(&&X+3),&&LBL;  % BR IF TRUE
  8317.                END;
  8318.             END;
  8319.          'FALSE': BEGIN
  8320.             ASM CASE '&IF(&X+4)';
  8321.                'OR': BEGIN
  8322.                   &&LBLEND: SETC 'PRED&@';
  8323.                   SYSPREDB &&IF(&&X+3),&&LBLEND;
  8324.                   END;
  8325.                'AND': BEGIN
  8326.                   SYSPREDB N&&IF(&&X+3),&&LBL;
  8327.                   END;
  8328.                '': BEGIN
  8329.                   ASM IF (&&X+5 LT N'&&IF)
  8330.                   THEN MNOTE 12,'"" IS AN ILLEGAL OPERATOR';
  8331.                   SYSPREDB N&&IF(&&X+3),&&LBL;
  8332.                   END;
  8333.                ENDCASE
  8334.             ELSE BEGIN
  8335.                MNOTE 12,'"&IF(&X+4)" IS AN ILLEGAL OPERATOR';
  8336.                SYSPREDB N&&IF(&&X+3),&&LBL;  % BR IF FALSE
  8337.                END;
  8338.             END;
  8339.          ENDCASE ELSE;
  8340.       END;
  8341.    &&LBLEND: SYSLBL;
  8342.    MEND;
  8343.  
  8344. BAL;
  8345. ./       ADD   LIST=ALL,NAME=SYSPREDB
  8346. ALP;
  8347.  
  8348. MACRO &&L: SYSPREDB &&CC,&&LBL;
  8349.    LCLC &&C;
  8350.  
  8351.    &&C: SETC '&CC';
  8352.    ASM IF (K'&&CC GE 2) THEN ASM IF ('&CC'(1,2) EQ 'NN')
  8353.    THEN <&&C: SETC '&CC'(3,K'&&CC-2)>;
  8354.    BAL;
  8355. &L B&C &LBL
  8356.    ALP;
  8357.    MEND;
  8358.  
  8359. BAL;
  8360. ./       ADD   LIST=ALL,NAME=SYSQS
  8361.          MACRO
  8362. &L     SYSQS &AR,&LR,&AP,&LP,&NULL=,&TYPEA=,&TYPEL=,&SELECTA=,&SELECTL=
  8363.          LCLA  &X,&N
  8364.          LCLC  &C
  8365.          AIF   ('&AP' EQ '').NSTR
  8366.          AIF   ('&AP'(1,1) EQ '''').STR
  8367. .NSTR    ANOP
  8368.          AIF   ('&AP&LP' EQ '').NULL
  8369. &L       SYSLR &AR,&AP,TYPE=&TYPEA,SELECT=&SELECTA,                    *
  8370.                ERR='STRING LOCATION MISSING'
  8371.          SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL,                    *
  8372.                ERR='STRING LENGTH MISSING'
  8373.          MEXIT
  8374. .*
  8375. .*  PROCESS OMITTED OPERANDS
  8376. .*
  8377. .NULL    ANOP
  8378.          AIF   ('&NULL(1)&NULL(2)' EQ '').NULLNUL
  8379. &L       SYSQS &AR,&LR,&NULL(1),&NULL(2),TYPEA=&TYPEA,TYPEL=&TYPEL,    *
  8380.                SELECTA=&SELECTA,SELECTL=&SELECTL
  8381.          MEXIT
  8382. .*
  8383. .NULLNUL ANOP
  8384. &L       SYSQS &AR,&LR,0,0
  8385.          MNOTE 12,'STRING MISSING'
  8386.          MEXIT
  8387. .*
  8388. .*  PROCESS QUOTED STRING
  8389. .*
  8390. .STR     AIF   ('&LP' NE '').LG
  8391. &L       SYSLR &AR,=C&AP,TYPE=&TYPEA,SELECT=&SELECTA
  8392. &X       SETA  1
  8393. &C       SETC  '&&'
  8394. .LOOP    ANOP
  8395. &X       SETA  &X+1
  8396.          AIF   (&X GE K'&AP).EL
  8397. &N       SETA  &N+1
  8398.          AIF   ('&AP'(&X,1) NE '''' AND '&AP'(&X,1) NE '&C'(1,1)).LOOP
  8399. &X       SETA  &X+1
  8400.          AGO   .LOOP
  8401. .EL      SYSLR &LR,&N,TYPE=&TYPEL,SELECT=&SELECTL
  8402.          MEXIT
  8403. .*
  8404. .*  PROCESS STRING WITH LENGTH GIVEN
  8405. .*
  8406. .LG      ANOP
  8407. &L       SYSLR &AR,=CL(&LP)&AP,TYPE=&TYPEA,SELECT=&SELECTA
  8408.          SYSLR &LR,&LP,TYPE=&TYPEL,SELECT=&SELECTL
  8409. .END     MEND
  8410. ./       ADD   LIST=ALL,NAME=SYSRNG
  8411.          MACRO
  8412.          SYSRNG &NAME,&VAL,&REL,&LIM
  8413.          LCLA  &X
  8414.          SYSKWT SYSRNG-RELATION,&REL,                                  *
  8415.                (LT,NLT,LE,NLE,EQ,NE,NEQ,GE,NGE,GT,NGT,MULT),           *
  8416.                NULL=NO,COND=NO
  8417. .*
  8418. &X       SETA  0
  8419. .TEST    ANOP
  8420. &X       SETA  &X+1
  8421.          AIF   (&X GT K'&VAL).NUM
  8422.          AIF   ('&VAL'(&X,1) GE '0' AND '&VAL'(&X,1) LE '9').TEST
  8423.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE ALL NUMERIC'
  8424.          MEXIT
  8425. .*
  8426. .NUM     ANOP
  8427. .*
  8428. &X       SETA  0
  8429. .LTEST   ANOP
  8430. &X       SETA  &X+1
  8431.          AIF   (&X GT K'&LIM).LNUM
  8432.          AIF   ('&LIM'(&X,1) GE '0' AND '&LIM'(&X,1) LE '9').LTEST
  8433.          MNOTE 12,'"SYSRNG-LIMIT=&LIM" IS ILLEGAL, MUST BE ALL NUMERIC'
  8434.          AGO   .OK
  8435. .*
  8436. .LNUM    ANOP
  8437. .*
  8438.          AIF   ('&REL' EQ 'LT' AND &VAL LT &LIM).OK
  8439.          AIF   ('&REL' EQ 'LE' AND &VAL LE &LIM).OK
  8440.          AIF   ('&REL' EQ 'EQ' AND &VAL EQ &LIM).OK
  8441.          AIF   ('&REL' EQ 'GE' AND &VAL GE &LIM).OK
  8442.          AIF   ('&REL' EQ 'GT' AND &VAL GT &LIM).OK
  8443.          AIF   ('&REL' EQ 'NLT' AND &VAL GE &LIM).OK
  8444.          AIF   ('&REL' EQ 'NLE' AND &VAL GT &LIM).OK
  8445.          AIF   ('&REL' EQ 'NEQ' AND &VAL NE &LIM).OK
  8446.          AIF   ('&REL' EQ 'NE' AND &VAL NE &LIM).OK
  8447.          AIF   ('&REL' EQ 'NGE' AND &VAL LT &LIM).OK
  8448.          AIF   ('&REL' EQ 'NGT' AND &VAL LE &LIM).OK
  8449.          AIF   ('&REL' EQ 'MULT').MULT
  8450.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE &REL &LIM'
  8451. .*
  8452. .OK      ANOP
  8453. &X       SETA  5
  8454. .LOOP    ANOP
  8455.          AIF   (&X GT N'&SYSLIST).END
  8456.          SYSRNG &NAME,&VAL,&SYSLIST(&X),&SYSLIST(&X+1)
  8457. &X       SETA  &X+2
  8458.          AGO   .LOOP
  8459. .*
  8460. .MULT    ANOP
  8461.          AIF   (&VAL EQ &VAL/&LIM*&LIM).OK
  8462.          MNOTE 12,'"&NAME=&VAL" IS ILLEGAL, MUST BE A MULTIPLE OF &LIM'
  8463.          AGO   .OK
  8464. .END     MEND
  8465. ./       ADD   LIST=ALL,NAME=SYSTANDB
  8466.          MACRO
  8467. &L       SYSTANDB &T,&C,&OP,&A,&B,&BC=N
  8468.          LCLC  &CC
  8469.          LCLA  &K
  8470.          AIF   ('&T' EQ '').END
  8471.          AIF   ('&T'(1,1) NE '(').OP
  8472.          AIF   ('&T(2)' EQ 'LT').LT
  8473.          AIF   ('&T(2)' EQ 'TF').TF
  8474.          AIF   ('&T(4)' EQ '').TEST1
  8475. &L       &T(2) &T(3),&T(4)
  8476.          AGO   .DOB
  8477. .*
  8478. .TEST1   ANOP
  8479. &L       &T(2) &T(3)
  8480.          AGO   .DOB
  8481. .*
  8482. .LT      ANOP
  8483. &L       LT    &T(3),&T(4)
  8484.          AGO   .DOB
  8485. .*
  8486. .TF      ANOP
  8487.          AIF   ('&T(4)' EQ '').TF1
  8488. &L       TF    &T(3),&T(4)
  8489.          AGO   .DOB
  8490. .*
  8491. .TF1     ANOP
  8492. &L       TF    &T(3)
  8493. .*
  8494. .DOB     ANOP
  8495. &CC      SETC  '&BC.NZ'
  8496. &K       SETA  K'&BC+2
  8497.          AIF   ('&T(5)' EQ '').TCC
  8498. &CC      SETC  '&BC&T(5)'
  8499. &K       SETA  K'&BC+K'&T(5)
  8500. .TCC     ANOP
  8501.          AIF   (&K LE 2).DCC
  8502.          AIF   ('&CC'(1,2) NE 'NN').DCC
  8503. &CC      SETC  '&CC'(3,&K-2)
  8504. .DCC     ANOP
  8505.          AIF   ('&CC' EQ 'LE').BLE
  8506.          AIF   ('&CC' EQ 'EH').BEH
  8507.          AIF   ('&CC' EQ 'LH').BLH
  8508.          AIF   ('&CC' EQ 'NLE').BNLE
  8509.          AIF   ('&CC' EQ 'NEH').BNEH
  8510.          AIF   ('&CC' EQ 'NLH').BNLH
  8511.          AIF   ('&CC' EQ 'MZ').BMZ
  8512.          AIF   ('&CC' EQ 'ZP').BZP
  8513.          AIF   ('&CC' EQ 'MP').BMP
  8514.          AIF   ('&CC' EQ 'NMZ').BNMZ
  8515.          AIF   ('&CC' EQ 'NZP').BNZP
  8516.          AIF   ('&CC' EQ 'NMP').BNMP
  8517.          B&CC  *+4+&C
  8518. .BOP     &OP   &A,&B
  8519.          MEXIT
  8520. .*
  8521. .BLE     BLE   *+4+&C
  8522.          AGO   .BOP
  8523. .*
  8524. .BEH     BEH   *+4+&C
  8525.          AGO   .BOP
  8526. .*
  8527. .BLH     BLH   *+4+&C
  8528.          AGO   .BOP
  8529. .*
  8530. .BNLE    BNLE  *+4+&C
  8531.          AGO   .BOP
  8532. .*
  8533. .BNEH    BNEH  *+4+&C
  8534.          AGO   .BOP
  8535. .*
  8536. .BNLH    BNLH  *+4+&C
  8537.          AGO   .BOP
  8538. .*
  8539. .BMZ     BMZ   *+4+&C
  8540.          AGO   .BOP
  8541. .*
  8542. .BZP     BZP   *+4+&C
  8543.          AGO   .BOP
  8544. .*
  8545. .BMP     BMP   *+4+&C
  8546.          AGO   .BOP
  8547. .*
  8548. .BNMZ    BNMZ  *+4+&C
  8549.          AGO   .BOP
  8550. .*
  8551. .BNZP    BNZP  *+4+&C
  8552.          AGO   .BOP
  8553. .*
  8554. .BNMP    BNMP  *+4+&C
  8555.          AGO   .BOP
  8556. .*
  8557. .OP      ANOP
  8558. &L       &OP   &A,&B
  8559. .END     MEND
  8560. ./       ADD   LIST=ALL,NAME=SYSXXC
  8561.          MACRO
  8562. &L       SYSXXC &OP,&A,&B,&C,&D1=0,&D2=0,&N=,&BC=
  8563.          LCLC  &LBL,&BCLBL,&LQ
  8564.          LCLA  &M,&X,&Y
  8565. &LBL     SETC  '&L'
  8566.          AIF   ('&N' NE '' AND '&N' NE '*').N
  8567. .*
  8568. .*  NO. OF INSTRUCTIONS NOT SPECIFIED
  8569. .*
  8570.          AIF   ('&C' NE '').CHECK
  8571.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  8572.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  8573.                T'&A NE '$').OKLEN
  8574.          MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
  8575.                O MACROS'
  8576. &LQ      SETC  'L'''
  8577. &L       SYSXXC &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2,N=&N,BC=&BC
  8578.          MEXIT
  8579. .*
  8580. .OKLEN   ANOP
  8581. &M       SETA  L'&A
  8582. &L       SYSXXC &OP,&A,&B,&M,D1=&D1,D2=&D2,N=&N,BC=&BC
  8583.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&M)'
  8584.          MEXIT
  8585. .*
  8586. .CHECK   ANOP
  8587. &Y       SETA  &Y+1
  8588.          AIF   (&Y GT K'&C).OK
  8589.          AIF   ('&C'(&Y,1) LT '0').ONE
  8590.          AGO   .CHECK
  8591. .OK      ANOP
  8592. .*
  8593.          AIF   (&C LE 256).ONE
  8594. .NEXT    ANOP
  8595. &LBL     SYSXXCA &OP,&A,&B,256,D1=&D1+&X,D2=&D2+&X
  8596. &LBL     SETC  ''
  8597.          AIF   ('&BC(1)' EQ '').NBC
  8598.          AIF   ('&BCLBL' NE '').BCA
  8599. &BCLBL   SETC  '&BC(2)'
  8600.          AIF   ('&BCLBL' NE '').BCA
  8601. &BCLBL   SETC  '&OP&SYSNDX'
  8602. .BCA     &BC(1) &BCLBL
  8603. .NBC     ANOP
  8604. &X       SETA  &X+256
  8605. &Y       SETA  &C-&X
  8606.          AIF   (&Y GT 256).NEXT
  8607.          SYSXXCA &OP,&A,&B,&Y,D1=&D1+&X,D2=&D2+&X
  8608. &BCLBL   SYSLBL
  8609.          MEXIT
  8610. .*
  8611. .*  NO. OF INSTRUCTIONS SPECIFIED
  8612. .*
  8613. .N       ANOP
  8614. &M       SETA  &N
  8615.          AIF   (&M LE 1).ONE
  8616. .LOOP    ANOP
  8617.          AIF   (&X GE &M-1).LAST
  8618. &LBL     SYSXXCA &OP,&A,&B,(&C)/&M,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
  8619. &LBL     SETC  ''
  8620. &X       SETA  &X+1
  8621.          AIF   ('&BC(1)' EQ '').LOOP
  8622.          AIF   ('&BCLBL' NE '').BCB
  8623. &BCLBL   SETC  '&BC(2)'
  8624.          AIF   ('&BCLBL' NE '').BCB
  8625. &BCLBL   SETC  '&OP&SYSNDX'
  8626. .BCB     &BC(1) &BCLBL
  8627.          AGO   .LOOP
  8628. .LAST    ANOP
  8629.     SYSXXCA &OP,&A,&B,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X,D2=&D2+(&C)/&M*&X
  8630. &BCLBL   SYSLBL
  8631.          MEXIT
  8632. .*
  8633. .ONE     ANOP
  8634. &L       SYSXXCA &OP,&A,&B,&C,D1=&D1,D2=&D2
  8635. .END     MEND
  8636. ./       ADD   LIST=ALL,NAME=SYSXXCA
  8637.          MACRO
  8638. &L       SYSXXCA &OP,&A,&B,&C,&D1=0,&D2=0
  8639.          LCLA  &LEN
  8640.          LCLC  &LQ
  8641. .*
  8642.          AIF   ('&C' NE '').NDLEN
  8643.          AIF  (T'&A NE 'M' AND T'&A NE 'N' AND T'&A NE 'O' AND         *
  8644.                T'&A NE 'T' AND T'&A NE 'U' AND T'&A NE 'W' AND         *
  8645.                T'&A NE '$').OKLEN
  8646.          MNOTE *,'LENGTH NOT CODED AND LENGTH ATTRIBUTE NOT AVAILABLE T*
  8647.                O MACROS'
  8648. &LQ      SETC  'L'''
  8649. &L       SYSXXCA &OP,&A,&B,&LQ&A,D1=&D1,D2=&D2
  8650.          MEXIT
  8651. .*
  8652. .OKLEN   ANOP
  8653. &LEN     SETA  L'&A
  8654. &L       SYSXXCA &OP,&A,&B,&LEN,D1=&D1,D2=&D2
  8655.          MNOTE *,'LENGTH ATTRIBUTE OF FIRST OPERAND USED (&LEN)'
  8656.          MEXIT
  8657. .*
  8658. .NDLEN   ANOP
  8659. .*
  8660.          AIF   ('&A'(1,1) EQ '(').AR
  8661.          AIF   ('&B'(1,1) EQ '(').C2
  8662. .*
  8663. .C1      ANOP
  8664.          AIF   ('&D1' EQ '0').D1Z
  8665.          AIF   ('&D2' EQ '0').C1B
  8666. .*
  8667. .C1A     ANOP
  8668. &L       SYSXXCB &OP,&D1+&A,&D2+&B,&C
  8669.          MEXIT
  8670. .*
  8671. .C1B     ANOP
  8672. &L       SYSXXCB &OP,&D1+&A,&B,&C
  8673.          MEXIT
  8674. .*
  8675. .D1Z     ANOP
  8676.          AIF   ('&D2' EQ '0').C1D
  8677. .*
  8678. .C1C     ANOP
  8679. &L       SYSXXCB &OP,&A,&D2+&B,&C
  8680.          MEXIT
  8681. .*
  8682. .C1D     ANOP
  8683. &L       SYSXXCB &OP,&A,&B,&C
  8684.          MEXIT
  8685. .*
  8686. .C2      ANOP
  8687.          AIF   ('&D1' EQ '0').C2B
  8688. .*
  8689. .C2A     ANOP
  8690. &L       SYSXXCB &OP,&D1+&A,&D2&B,&C
  8691.          MEXIT
  8692. .*
  8693. .C2B     ANOP
  8694. &L       SYSXXCB &OP,&A,&D2&B,&C
  8695.          MEXIT
  8696. .*
  8697. .AR      AIF   ('&B'(1,1) EQ '(').C4
  8698. .*
  8699. .C3      ANOP
  8700.          AIF   ('&D2' EQ '0').C3B
  8701. .*
  8702. .C3A     ANOP
  8703. &L       SYSXXCB &OP,&D1&A,&D2+&B,&C
  8704.          MEXIT
  8705. .*
  8706. .C3B     ANOP
  8707. &L       SYSXXCB &OP,&D1&A,&B,&C
  8708.          MEXIT
  8709. .*
  8710. .C4      ANOP
  8711. &L       SYSXXCB &OP,&D1&A,&D2&B,&C
  8712.          MEND
  8713. ./       ADD   LIST=ALL,NAME=SYSXXCB
  8714.          MACRO
  8715. &L       SYSXXCB &OP,&A,&B,&C
  8716.          LCLA  &X,&Y,&Z
  8717.          LCLC  &CL(8),&CR(8)
  8718.          AIF   ('&A' NE '').OK
  8719. &L       &OP   0(&C),&B
  8720.          MEXIT
  8721. .*
  8722. .OK      ANOP
  8723.          AIF   ('&A'(K'&A,1) EQ ')').SCAN
  8724. .*
  8725. .SIMPLE  ANOP
  8726. &L       &OP   &A.(&C),&B
  8727.          MEXIT
  8728. .*
  8729. .SCAN    ANOP
  8730. &X       SETA  &X+1
  8731.          AIF   (&X GT K'&A).SIMPLE
  8732.          AIF   ('&A'(&X,1) EQ '''').QUOTE
  8733.          AIF   ('&A'(&X,1) NE '(').SCAN
  8734.          AIF   (&X EQ 1).SCAN
  8735.          AIF   ('&A'(&X-1,1) EQ '+').SCAN
  8736.          AIF   ('&A'(&X-1,1) EQ '-').SCAN
  8737.          AIF   ('&A'(&X-1,1) EQ '*').SCAN
  8738.          AIF   ('&A'(&X-1,1) EQ '/').SCAN
  8739.          AIF   ('&A'(&X-1,1) EQ '(').SCAN
  8740. .LOOPL   ANOP
  8741. &Y       SETA  &Y+1
  8742.          AIF   (&Y*8 GE &X).DONEL
  8743. &CL(&Y) SETC   '&A'((&Y-1)*8+1,8)
  8744.          AGO   .LOOPL
  8745. .*
  8746. .DONEL   ANOP
  8747. &CL(&Y)  SETC  '&A'((&Y-1)*8+1,&X-(&Y-1)*8)
  8748. .*
  8749. .LOOPR   ANOP
  8750. &Z       SETA  &Z+1
  8751.          AIF   (&Z*8 GE K'&A-&X).DONER
  8752. &CR(&Z)  SETC  '&A'(&X+(&Z-1)*8+1,8)
  8753.          AGO   .LOOPR
  8754. .*
  8755. .DONER   ANOP
  8756. &CR(&Z) SETC   '&A'(&X+(&Z-1)*8+1,K'&A-&X-(&Z-1)*8)
  8757. .*
  8758. &L       &OP   &CL(1)&CL(2)&CL(3)&CL(4)&CL(5)&CL(6)&CL(7)&CL(8)&C,&CR(1*
  8759.                )&CR(2)&CR(3)&CR(4)&CR(5)&CR(6)&CR(7)&CR(8),&B
  8760.          MEXIT
  8761. .*
  8762. .QUOTE   ANOP
  8763.          AIF   (&X EQ 1).QUOTEL
  8764.          AIF   ('&A'(&X-1,1) EQ 'L').SCAN
  8765. .*
  8766. .QUOTEL  ANOP
  8767. &X       SETA  &X+1
  8768.          AIF   (&X GE K'&A).SIMPLE
  8769.          AIF   ('&A'(&X,1) NE '''').QUOTEL
  8770.          AGO   .SCAN
  8771.          MEND
  8772. ./       ADD   LIST=ALL,NAME=SYSXXC1
  8773.          MACRO
  8774. &L       SYSXXC1 &OP,&A,&T,&C,&D1=0,&N=,&BC=
  8775.          LCLC  &LBL,&BCLBL
  8776.          LCLA  &M,&X,&Y
  8777. &LBL     SETC  '&L'
  8778.          AIF   ('&N' NE '' AND '&N' NE '*').N
  8779. .*
  8780. .*  NO. OF INSTRUCTIONS NOT SPECIFIED
  8781. .*
  8782.          AIF   ('&C' EQ '').ONE
  8783. .CHECK   ANOP
  8784. &Y       SETA  &Y+1
  8785.          AIF   (&Y GT K'&C).OK
  8786.          AIF   ('&C'(&Y,1) LT '0').ONE
  8787.          AGO   .CHECK
  8788. .OK      ANOP
  8789. .*
  8790.          AIF   (&C LE 256).ONE
  8791. .NEXT    ANOP
  8792. &LBL     SYSXXCA &OP,&A,&T,256,D1=&X
  8793. &LBL     SETC  ''
  8794.          AIF   ('&BC(1)' EQ '').NBC
  8795.          AIF   ('&BCLBL' NE '').BCA
  8796. &BCLBL   SETC  '&BC(2)'
  8797.          AIF   ('&BCLBL' NE '').BCA
  8798. &BCLBL   SETC  '&OP&SYSNDX'
  8799. .BCA     &BC(1) &BCLBL
  8800. .NBC     ANOP
  8801. &X       SETA  &X+256
  8802. &Y       SETA  &C-&X
  8803.          AIF   (&Y GT 256).NEXT
  8804.          SYSXXCA &OP,&A,&T,&Y,D1=&X
  8805. &BCLBL   SYSLBL
  8806.          MEXIT
  8807. .*
  8808. .*  NO. OF INSTRUCTIONS SPECIFIED
  8809. .*
  8810. .N       ANOP
  8811. &M       SETA  &N
  8812.          AIF   (&M LE 1).ONE
  8813. .LOOP    ANOP
  8814.          AIF   (&X GE &M-1).LAST
  8815. &LBL     SYSXXCA &OP,&A,&T,(&C)/&M,D1=&D1+(&C)/&M*&X
  8816. &LBL     SETC  ''
  8817. &X       SETA  &X+1
  8818.          AIF   ('&BC(1)' EQ '').LOOP
  8819.          AIF   ('&BCLBL' NE '').BCB
  8820. &BCLBL   SETC  '&BC(2)'
  8821.          AIF   ('&BCLBL' NE '').BCB
  8822. &BCLBL   SETC  '&OP&SYSNDX'
  8823. .BCB     &BC(1) &BCLBL
  8824.          AGO   .LOOP
  8825. .LAST    ANOP
  8826.          SYSXXCA &OP,&A,&T,&C-(&C)/&M*&X,D1=&D1+(&C)/&M*&X
  8827. &BCLBL   SYSLBL
  8828.          MEXIT
  8829. .*
  8830. .ONE     ANOP
  8831. &L       SYSXXCA &OP,&A,&T,&C,D1=&D1
  8832. .END     MEND
  8833. ./       ADD   LIST=ALL,NAME=TF
  8834.          MACRO
  8835. &L       TF
  8836.          LCLA  &X,&Y,&Z,&I
  8837.          LCLC  &F(16)
  8838. .*
  8839.          AIF   (N'&SYSLIST LT 1).NONE
  8840. .LOOP    ANOP
  8841. &X       SETA  &X+1
  8842.          AIF   (&X GT N'&SYSLIST).DONE
  8843. .*
  8844.          AIF   (&Z GE 16).MANY
  8845. .*
  8846. &F(&Z+1) SETC  '+L'''(1,3)
  8847. &F(&Z+2) SETC  '&SYSLIST(&X)'
  8848. &I       SETA  0
  8849. .SCAN    ANOP
  8850. &I       SETA  &I+1
  8851.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  8852.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  8853.          AIF   (&I LE 1).SCANOK
  8854. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  8855. .SCANOK  ANOP
  8856. .*
  8857. &Y       SETA  &Z+2
  8858. .CHECK   ANOP
  8859. &Y       SETA  &Y-2
  8860.          AIF   (&Y LT 2).UNIQUE
  8861.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  8862.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  8863. &F(&Z+1) SETC  ''
  8864. &F(&Z+2) SETC  ''
  8865.          AGO   .LOOP
  8866. .*
  8867. .UNIQUE  ANOP
  8868.          AIF   (&X LE 1).NTEST
  8869.          TM    0,(&F(&Z+2)-&F(2))*256
  8870.          ORG   *-4
  8871. .NTEST   ANOP
  8872. &Z       SETA  &Z+2
  8873.          AGO   .LOOP
  8874. .*
  8875. .DONE    ANOP
  8876. &F(1)    SETC  'L'''(1,2)
  8877. &L       TM    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  8878.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  8879.          MEXIT
  8880. .*
  8881. .NONE    ANOP
  8882.          MNOTE 12,'NO FLAGS SPECIFIED'
  8883.          CLI   *+1,0
  8884.          MEXIT
  8885. .*
  8886. .MANY    ANOP
  8887.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  8888.          AGO   .DONE
  8889.          MEND
  8890. ./       ADD   LIST=ALL,NAME=TIME128
  8891.          MACRO
  8892. &L       TIME128
  8893. &L       OSCALL TIME128
  8894.          MEND
  8895. ./       ADD   LIST=ALL,NAME=TIOTSRCH
  8896.          MACRO
  8897. &L       TIOTSRCH &R,&S,&DD,&UCB=YES
  8898.          LCLC  &LBL
  8899.          SYSKWT UCB,&UCB,(YES,NO),NULL=NO,COND=NO
  8900. &L       L     &R,16
  8901.          L     &R,0(,&R)
  8902.          L     &R,0(,&R)
  8903.          L     &R,12(,&R)
  8904.          LA    &R,24(,&R)
  8905.          SLR   &S,&S
  8906. TIO&SYSNDX.A IC &S,0(,&R)
  8907.          LTR   &S,&S
  8908.          BZ    TIO&SYSNDX.C
  8909.          CLC   4(8,&R),&DD
  8910.          BE    TIO&SYSNDX.B
  8911.          ALR   &R,&S
  8912.          B     TIO&SYSNDX.A
  8913. &LBL     SETC  'TIO&SYSNDX.B'
  8914.          AIF   ('&UCB' EQ 'NO').NUCB
  8915. &LBL     L     &R,16(,&R)
  8916. &LBL     SETC  ''
  8917.          LA    &R,0(,&R)
  8918. .NUCB    ANOP
  8919. &LBL     LTR   &S,&S
  8920. &LBL     SETC  ''
  8921. TIO&SYSNDX.C DS 0H
  8922.          MEND
  8923. ./       ADD   LIST=ALL,NAME=UAOP
  8924.          MACRO
  8925. &L       UAOP  &OP,&R,&A
  8926. &L       &OP   &R,*-*
  8927.          ORG   *-2
  8928.          DC    S(&A)
  8929.          MEND
  8930. ./       ADD   LIST=ALL,NAME=VAREA
  8931.          MACRO
  8932. &L       VAREA
  8933.          GBLA  &VAREA
  8934. &L       DS    0F,XL&VAREA
  8935.          MEND
  8936. ./       ADD   LIST=ALL,NAME=VCLEAR
  8937.          MACRO
  8938. &L       VCLEAR &AREA
  8939.          AIF   ('&AREA' NE '').AOK
  8940.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  8941.          MEXIT
  8942. .*
  8943. .AOK     ANOP
  8944. .*
  8945.          AIF   ('&AREA'(1,1) EQ '(').REG
  8946. &L       MMVC  12+&AREA,4+&AREA,8
  8947.          MEXIT
  8948. .*
  8949. .REG     ANOP
  8950. &L       MMVC  12&AREA,4&AREA,8
  8951.          MEND
  8952. ./       ADD   LIST=ALL,NAME=VINIT
  8953.          MACRO
  8954. &L       VINIT &AREA,&RTN,&LOC,&LEN
  8955.          AIF   ('&AREA' NE '').AOK
  8956.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  8957.          MEXIT
  8958. .*
  8959. .AOK     ANOP
  8960. .*
  8961. &L       SYSLR VRF,&RTN,ERR='OUTPUT ROUTINE ADDRESS REQUIRED'
  8962.          SYSQS VR1,VR0,&LOC,&LEN
  8963.          AIF   ('&AREA'(1,1) EQ '(').REG
  8964.          STM   VRF,VR1,&AREA
  8965.          STM   VR0,VR1,12+&AREA
  8966.          MEXIT
  8967. .*
  8968. .REG     ANOP
  8969.          STM   VRF,VR1,0&AREA
  8970.          STM   VR0,VR1,12&AREA
  8971.          MEND
  8972. ./       ADD   LIST=ALL,NAME=VOUT
  8973.          MACRO
  8974. &L       VOUT  &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
  8975.          AIF   ('&LOC&LEN' EQ '').NVSEG
  8976. &L      VSEG &AREA,&LOC,&LEN,DEBLANK=&DEBLANK,WGET=&WGET,OFFSET=&OFFSET
  8977.          AGO   .COM
  8978. .*
  8979. .NVSEG   ANOP
  8980. &L       SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
  8981. .*
  8982. .COM     ANOP
  8983.          LM    VR0,VR1,4(VRE)
  8984.          S     VR0,12(VRE)
  8985.          MVC   12(8,VRE),4(VRE)
  8986.          L     RTNR,0(VRE)
  8987.          SLR   VRF,VRF
  8988.          CCALL (RTNR)
  8989.          MEND
  8990. ./       ADD   LIST=ALL,NAME=VSEG
  8991.          MACRO
  8992. &L       VSEG  &AREA,&LOC,&LEN,&DEBLANK=,&WGET=,&OFFSET=
  8993.          SYSKWT DEBLANK,&DEBLANK,(YES,NO),COND=NO
  8994.          SYSKWT WGET,&WGET,(YES,NO)
  8995. &L       SYSLR VRE,&AREA,ERR='VAREA ADDRESS REQUIRED'
  8996.          SYSQS VR1,VR0,&LOC,&LEN,TYPEA=&WGET,SELECTA=(YES)
  8997.          SYSLR VRF,&OFFSET
  8998.          AIF   ('&DEBLANK' EQ 'YES').DB
  8999.          CCALL VSEG
  9000.          MEXIT
  9001. .*
  9002. .DB      CCALL VSEGDB
  9003.          MEND
  9004. ./       ADD   LIST=ALL,NAME=VTELL
  9005.          MACRO
  9006. &L       VTELL &AREA
  9007.          AIF   ('&AREA' NE '').AOK
  9008.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  9009.          MEXIT
  9010. .*
  9011. .AOK     ANOP
  9012. .*
  9013.          AIF   ('&AREA'(1,1) EQ '(').REG
  9014. &L       LM    VR0,VR1,4+&AREA
  9015.          L     VRF,12+&AREA
  9016.          SLR   VR0,VRF
  9017.          MEXIT
  9018. .*
  9019. .REG     ANOP
  9020. &L       LM    VR0,VR1,4&AREA
  9021.          L     VRF,12&AREA
  9022.          SLR   VR0,VRF
  9023.          MEND
  9024. ./       ADD   LIST=ALL,NAME=VTEST
  9025.          MACRO
  9026. &L       VTEST &AREA,&LEN
  9027.          AIF   ('&AREA' NE '').AOK
  9028.          MNOTE 12,'VAREA ADDRESS REQUIRED'
  9029.          MEXIT
  9030. .*
  9031. .AOK     ANOP
  9032. .*
  9033. &L       SYSLR RTNR,&LEN,ERR='LENGTH REQUIRED'
  9034.          AIF   ('&AREA'(1,1) EQ '(').REG
  9035.          S     RTNR,12+&AREA
  9036.          LCR   RTNR,RTNR
  9037.          MEXIT
  9038. .*
  9039. .REG     ANOP
  9040.          S     RTNR,12&AREA
  9041.          LCR   RTNR,RTNR
  9042.          MEND
  9043. ./       ADD   LIST=ALL,NAME=WADDR
  9044.          MACRO
  9045. &L       WADDR &R,&LOC
  9046. &L       L     &R,&LOC
  9047.          MEND
  9048. ./       ADD   LIST=ALL,NAME=WCALL
  9049.          MACRO
  9050. &L       WCALL &SUBR,&TYPE,&RETURN=,&TEST=,                            *
  9051.                &VRE=,&VRF=,&VR0=,&VR1=
  9052. &L       CCALL &SUBR,&TYPE,RETURN=&RETURN,TEST=&TEST,                  *
  9053.                VRE=&VRE,VRF=&VRF,VR0=&VR0,VR1=&VR1
  9054.          MEND
  9055. ./       ADD   LIST=ALL,NAME=WENTER
  9056.          MACRO
  9057. &L       WENTER &R,&S,&SIZE,&ENTRY=,&BASE=,&WAR=,                      *
  9058.                &CHECK=,&TRACE=,&ID=
  9059. &L       CENTER &R,&S,&SIZE,ENTRY=&ENTRY,BASE=&BASE,WAR=&WAR
  9060.          MEND
  9061. ./       ADD   LIST=ALL,NAME=WEXIT
  9062.          MACRO
  9063. &L       WEXIT &R,&S,&SIZE,&WAR=,<R=,&BRANCH=,                       *
  9064.                &CHECK=,&TRACE=,&ID=
  9065. &L       CEXIT &R,&S,&SIZE,LTR=<R,WAR=&WAR,BRANCH=&BRANCH
  9066.          MEND
  9067. ./       ADD   LIST=ALL,NAME=WPARMGBL
  9068. *
  9069. *  NIH/COMMON - DUMMY FOR WYLBUR GLOBAL DECLARATIONS
  9070. *
  9071. ./       ADD   LIST=ALL,NAME=WPOP
  9072.          MACRO
  9073. &L       WPOP  &R,&SIZE,&EXTRA=0,&CHECK=
  9074. &L       CPOP  &R,&SIZE,EXTRA=&EXTRA
  9075.          MEND
  9076. ./       ADD   LIST=ALL,NAME=WPOPREG
  9077.          MACRO
  9078. &L       WPOPREG &R,&S,&CHECK=
  9079. &L       CPOPREG &R,&S
  9080.          MEND
  9081. ./       ADD   LIST=ALL,NAME=WPUSH
  9082.          MACRO
  9083. &L       WPUSH &R,&SIZE,&EXTRA=0,&CHECK=
  9084. &L       CPUSH &R,&SIZE,EXTRA=&EXTRA
  9085.          MEND
  9086. ./       ADD   LIST=ALL,NAME=WPUSHREG
  9087.          MACRO
  9088. &L       WPUSHREG &R,&S,&CHECK=
  9089. &L       CPUSHREG &R,&S
  9090.          MEND
  9091. ./       ADD   LIST=ALL,NAME=WSA
  9092.          MACRO
  9093. &L       WSA   &R,&S,&EQU=
  9094. &L       CSA   &R,&S,EQU=&EQU
  9095.          MEND
  9096. ./       ADD   LIST=ALL,NAME=Z
  9097.          MACRO
  9098. &L       Z     &R,&A
  9099.          AIF   ('&R' NE '').REG
  9100. &L       MZC   &A,4
  9101.          MEXIT
  9102. .REG     ANOP
  9103. &L       SLR   &R,&R
  9104.          ST    &R,&A
  9105.          MEND
  9106. ./       ADD   LIST=ALL,NAME=ZB
  9107.          MACRO
  9108. &L       ZB    &R,&A
  9109.          AIF   ('&R' NE '').REG
  9110. &L       MVI   &A,0
  9111.          MEXIT
  9112. .REG     ANOP
  9113. &L       SLR   &R,&R
  9114.          STC   &R,&A
  9115.          MEND
  9116. ./       ADD   LIST=ALL,NAME=ZF
  9117.          MACRO
  9118. &L       ZF
  9119.          LCLA  &X,&Y,&Z,&I
  9120.          LCLC  &F(16)
  9121. .*
  9122.          AIF   (N'&SYSLIST LT 1).NONE
  9123. .LOOP    ANOP
  9124. &X       SETA  &X+1
  9125.          AIF   (&X GT N'&SYSLIST).DONE
  9126. .*
  9127.          AIF   (&Z GE 16).MANY
  9128. .*
  9129. &F(&Z+1) SETC  '+L'''(1,3)
  9130. &F(&Z+2) SETC  '&SYSLIST(&X)'
  9131. &I       SETA  0
  9132. .SCAN    ANOP
  9133. &I       SETA  &I+1
  9134.          AIF   (&I GT K'&F(&Z+2)).SCANOK
  9135.          AIF   ('&F(&Z+2)'(&I,1) GE 'A').SCAN
  9136.          AIF   (&I LE 1).SCANOK
  9137. &F(&Z+2) SETC  '&F(&Z+2)'(1,&I-1)
  9138. .SCANOK  ANOP
  9139. .*
  9140. &Y       SETA  &Z+2
  9141. .CHECK   ANOP
  9142. &Y       SETA  &Y-2
  9143.          AIF   (&Y LT 2).UNIQUE
  9144.          AIF   ('&F(&Z+2)' NE '&F(&Y)').CHECK
  9145.          MNOTE 4,'"&F(&Z+2)" IS SPECIFIED MORE THAN ONCE'
  9146.          AGO   .LOOP
  9147. .*
  9148. .UNIQUE  ANOP
  9149.          AIF   (&X LE 1).NTEST
  9150.          NI    0,(&F(&Z+2)-&F(2))*256
  9151.          ORG   *-4
  9152. .NTEST   ANOP
  9153. &Z       SETA  &Z+2
  9154.          AGO   .LOOP
  9155. .*
  9156. .DONE    ANOP
  9157. &F(1)    SETC  'L'''(1,2)
  9158. &L       ZI    &SYSLIST(1),&F(1)&F(2)&F(3)&F(4)&F(5)&F(6)&F(7)&F(8)&F(9*
  9159.                )&F(10)&F(11)&F(12)&F(13)&F(14)&F(15)&F(16)
  9160.          MEXIT
  9161. .*
  9162. .NONE    ANOP
  9163.          MNOTE 12,'NO FLAGS SPECIFIED'
  9164.          CLI   *+1,0
  9165.          MEXIT
  9166. .*
  9167. .MANY    ANOP
  9168.          MNOTE 12,'TOO MANY FLAGS SPECIFIED'
  9169.          AGO   .DONE
  9170.          MEND
  9171. ./       ADD   LIST=ALL,NAME=ZH
  9172.          MACRO
  9173. &L       ZH    &R,&A
  9174.          AIF   ('&R' NE '').REG
  9175. &L       MZC   &A,2
  9176.          MEXIT
  9177. .REG     ANOP
  9178. &L       SLR   &R,&R
  9179.          STH   &R,&A
  9180.          MEND
  9181. ./       ADD   LIST=ALL,NAME=ZHB
  9182.          MACRO
  9183. &L       ZHB   &R,&A
  9184. &L       ZB    &R,&A
  9185.          MEND
  9186. ./       ADD   LIST=ALL,NAME=ZHBR
  9187.          MACRO
  9188. &L       ZHBR  &R
  9189.          AIF   ('&R' EQ '0' OR '&R' EQ 'R0' OR '&R' EQ 'VR0').N
  9190. &L       LA    &R,0(,&R)
  9191.          MEXIT
  9192. .*
  9193. .N       ANOP
  9194. &L       N     &R,=XL4'00FFFFFF'
  9195.          MEND
  9196. ./       ADD   LIST=ALL,NAME=ZI
  9197.          MACRO
  9198. &L       ZI    &A,&B
  9199. &L       NI    &A,255-(&B)
  9200.          MEND
  9201. ./       ADD   LIST=ALL,NAME=ZR
  9202.          MACRO
  9203. &L       ZR    &R
  9204. &L       SR    &R,&R
  9205.          MEND
  9206. ./       ADD   LIST=ALL,NAME=ZZZZZZZZ
  9207. ALP;
  9208. END;
  9209.