home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / emulate / systems / pc370 / demo / demosrc.alc < prev    next >
Text File  |  1987-05-24  |  9KB  |  328 lines
  1.     TITLE 'DEMOSRC - DEMOSRC PROGRAM ANALYSIS'
  2. *
  3. * AUTHOR.    DON HIGGINS.
  4. * DATE.      03/30/85.
  5. * REMARKS.   PC/370 DEMO PROGRAM TO READ SELECTED SOURCE TEXT FILES
  6. *            AND PRINT REPORT WITH COUNT OF RECORDS AND COMMENTS.
  7. * MAINTENANCE.
  8. *
  9. * 05/24/87 CONVERT TO R2.0 USING NEW DCB, AND GET TFCB FROM COM PREFIX
  10. *
  11. *
  12. *
  13. * INPUT
  14. *
  15. *  1.  DEMOSRC DRIVE:PREFIX.SUFFIX
  16. *
  17. * OUTPUT
  18. *
  19. *  1.  CONSOLE LISTING OF DEMOSRC FILE NAMES AND
  20. *      COUNT OF LINES OF CODE IN EACH ONE.
  21. *
  22. *
  23. DEMOSRC   CSECT
  24.     LR    R13,R15
  25.     USING DEMOSRC,R13
  26.     LA    R2,=C'DEMOSRC PROGRAM ANALYSIS$'
  27.     SVC   WTO
  28.     LA    R2,=C' $'
  29.     SVC   WTO
  30.     BAL   R14,GETPARM
  31.     LTR   R15,R15
  32.     BNZ   EOJ
  33.     BAL   R14,GETLIST
  34.     LTR   R15,R15
  35.     BNZ   EOJ
  36.     BAL   R14,PROCLIST
  37. EOJ      EQU   *
  38.     SVC   EXIT
  39.     TITLE  'GETPARM - MOVE PARM TO DCB'
  40. GETPARM  EQU   *
  41.     LA    R2,SYSUT1
  42.     USING IHAFCB,R2
  43.     LRA   R3,0          R1=A(ABSOLUTE ADDRESS OF ADDR. SPACE)
  44.     S     R3,=A(X'110') R1=A(ABSOLUTE ADDRESS OF MS-DOS COM PREFIX
  45.     LA    R4,1
  46.     MVCP  FCUNIT(R4),TFCB+(FCUNIT-IHAFCB),R3  ** THIS IS REALLY
  47.     LA    R4,8                                ** TRICKY CODE AND
  48.     MVCP  FCNAME(R4),TFCB+(FCNAME-IHAFCB),R3  ** MAGIC BY THE
  49.     LA    R4,3                                ** AUTHOR OF PC/370
  50.     MVCP  FCTYPE(R4),TFCB+(FCTYPE-IHAFCB),R3  ** TO AVOID HAVING TO
  51.     DROP  R2                                  ** SCAN PARMS (LAZY)
  52.     SR    R15,R15
  53.     BR    R14
  54.     TITLE 'GETLIST - BUILD LIST OF SORTED FILES FROM DIRECTORY'
  55. GETLIST  EQU   *
  56.     LA    R2,TBUFF
  57.     SVC   SETDMA
  58.     LA    R2,SYSUT1
  59.     SR    R0,R0
  60.     SVC   FNDDIR  FIND FIRST DIRECTORY ENTRY
  61.     CLM   R0,1,=X'FF'
  62.     BE    NOFILES
  63. BLDLIST  EQU   *
  64.     LA    R3,TBUFF
  65.     SLL   R0,5  R0=32*OFFSET
  66.     AR    R3,R0           R3=DIRECTORY ENTRY
  67.     USING IHAFCB,R3
  68.     LA    R1,LENTRY
  69.     SVC   GMAIN
  70.     CLM   R0,1,=X'00'
  71.     BNE   MEMERR
  72.     USING ENTRY,R2
  73.     MVC   ENAME,FCNAME
  74.     MVC   ETYPE,FCTYPE
  75.     DROP  R3
  76.     LA    R1,LISTPTR      R1 = LAST ENTRY
  77. INSERT   EQU   *
  78.     L     R3,ELINK-ENTRY(R1) R3 = NEXT ENTRY
  79.     LTR   R3,R3
  80.     BZ    ADDNOW
  81.     CLC   ENAME,ENAME-ENTRY(R3)
  82.     BL    ADDNOW
  83.     LR    R1,R3
  84.     B     INSERT
  85. ADDNOW   EQU   *
  86.     ST    R2,ELINK-ENTRY(R1)  CHAIN CURRENT TO PREV.
  87.     ST    R3,ELINK            CHAIN NEXT    TO CURRENT
  88. NEXTFILE EQU   *
  89.     DROP  R2,R3
  90.     LA    R2,SYSUT1
  91.     SR    R0,R0
  92.     SVC   NXTDIR  GET NEXT MATCHING DIRECTORY
  93.     CLM   R0,1,=X'FF'
  94.     BNE   BLDLIST
  95.     SR    R15,R15
  96.     BR    R14  EXIT NORMALLY TO PROCESS LIST
  97. MEMERR   EQU   *
  98.     LA    R2,=C'OUT OF MEMORY$'
  99.     SVC   WTO
  100.     SVC   TRACE
  101.     DC    C'BUG'
  102.     SVC   EXIT
  103. NOFILES  EQU   *
  104.     LA    R2,=C'NO MATCHING FILES$'
  105.     SVC   WTO
  106.     LA    R15,16
  107.     BR    R14
  108.     TITLE 'PROCLIST - PROCESS EACH DEMOSRC FILE IN LIST'
  109. PROCLIST EQU   *
  110.     LA    R3,LISTPTR
  111. NEXTLIST EQU   *
  112.     L     R3,0(R3)
  113.     LTR   R3,R3
  114.     BZ    PLEXIT
  115.     USING ENTRY,R3
  116.     LA    R2,SYSUT2
  117.     USING IHADCB,R2
  118.     MVC   DSNNAME,ENAME
  119.     TRT   DSNNAME,FINDBLK
  120.     BNZ   MOVSUF
  121.     LA    R1,DSNNAME+8
  122. MOVSUF   EQU   *
  123.     MVI   0(R1),X'2E'     ASCII PERIOD
  124.     MVC   1(3,R1),ETYPE
  125.     MVI   4(R1),0
  126.     LA    R2,4(R1)
  127.     LA    R1,DSN
  128.     SR    R2,R1
  129.     SVC   ASCEBC  CONVERT TO EBCDIC FOR MMS/370 OPEN
  130.     MVC   DNAME,DNAME-1   CLEAR DSN ON TOTAL LINE
  131.     BCTR  R2,0
  132.     EX    R2,MVCDNAME     MOVE DSN
  133.     LA    R2,SYSUT2
  134.     SVC   OPEN
  135.     ZAP   PCOUNT,=P'0'
  136.     ZAP   PCOMM,=P'0'
  137. NEXTREC  EQU   *
  138.     LA    R2,SYSUT2
  139.     LA    R1,RECORD
  140.     SVC   GET
  141.     AP    PCOUNT,=P'1'
  142.     LA    R1,RECORD
  143. SKPN     EQU   *
  144.     TM    0(R1),X'80'
  145.     BZ    SKPOK
  146.     LA    R1,1(R1)
  147.     B     SKPN
  148. MVCDNAME MVC   DNAME(0),DSNNAME
  149. SKPOK    EQU   *
  150.     CLI   0(R1),ASCASK
  151.     BE    COMM
  152.     CLI   0(R1),ASCSMI
  153.     BE    COMM
  154.     B     NEXTREC
  155. COMM     EQU   *
  156.     AP    PCOMM,=P'1'
  157.     B     NEXTREC
  158. EOFRTN   EQU   *
  159.     LA    R2,SYSUT2
  160.     SVC   CLOSE
  161.     MVC   DCOUNT,MASK
  162.     ED    DCOUNT,PCOUNT
  163.     MVC   DCOMM,MASK
  164.     ED    DCOMM,PCOMM
  165.     LA    R2,TMSG
  166.     SVC   WTO
  167.     AP    PTOTAL,PCOUNT
  168.     AP    PTCOMM,PCOMM
  169.     B     NEXTLIST
  170. PLEXIT   EQU   *
  171.     MVC   DNAME,DNAME-1
  172.     MVC   DNAME(5),=C'TOTAL'
  173.     MVC   DCOUNT,MASK
  174.     ED    DCOUNT,PTOTAL
  175.     MVC   DCOMM,MASK
  176.     ED    DCOMM,PTCOMM
  177.     LA    R2,TMSG
  178.     SVC   WTO
  179.     SR    R15,R15
  180.     BR    R14
  181. SYN      EQU   *
  182.     LA    R2,=C'IO ERROR$'
  183.     SVC   WTO
  184.     SVC   TRACE
  185.     DC    C'BUG'
  186.     LTORG
  187. *
  188. * REGISTER USAGE
  189. *
  190. R0       EQU   0 SVC RETURN CODE
  191. R1       EQU   1 SVC ARGUMENT
  192. R2       EQU   2 SVC ARGUMENT (DCB ADDRESS, DMA, MSG, ETC.)
  193. R3       EQU   3 DIRECTORY ADDRESS (TBUFF + OFFSET)
  194. R4       EQU   4 LENGTH FOR CROSS MEMORY MOVE FROM TFCB
  195. R13      EQU   13 BASE
  196. R14      EQU   14 LINK FROM MAINLINE TO ROUTINES
  197. R15      EQU   15 RETURN CODE FROM ROUTINES
  198. *
  199. * PC/370 SVC'S
  200. *
  201. EXIT     EQU   0
  202. OPEN     EQU   1
  203. CLOSE    EQU   2
  204. GET      EQU   5
  205. PUT      EQU   6
  206. TRACE    EQU   9
  207. GMAIN    EQU   10
  208. FMAIN    EQU   11
  209. ASCEBC   EQU   12
  210. WTO      EQU   209
  211. SETDMA   EQU   226
  212. FNDDIR   EQU   217
  213. NXTDIR   EQU   218
  214. *
  215. * DATA AREAS
  216. *
  217. FINDBLK  DC    32X'00',X'FF',(256-33)X'00' FIND ASCII BLANK
  218. TFCB     EQU   X'5C' FCB BUILT BY MS-DOS IN COM PREFIX
  219. TBUFF    EQU   X'80'  BUFFER FOR DIRECTORY SEARCH (COPIED TO AS)
  220. LISTPTR  DC    A(0) POINTER TO LIST OF FILE ENTRIES SELECTED
  221. RECORD   DS    XL256   LOGICAL RECORD AREA
  222. ASCASK   EQU   X'2A'   ASCII ASTERISK FOR ALC COMMENT CHECK
  223. ASCSMI   EQU   X'3B'   ASCII SIMICOLON FOR MAC COMMENT CHECK
  224. PCOUNT   DC    PL3'0'  FILE RECORD COUNT
  225. PCOMM    DC    PL3'0'  FILE COMMENT COUNT
  226. PTOTAL   DC    PL3'0'  TOTAL RECORD COUNT
  227. PTCOMM   DC    PL3'0'  TOTAL COMMENT COUNT
  228. TMSG     DC    C' '
  229. DNAME    DC    CL12' ',C'  RECORDS='
  230. DCOUNT   DC    CL6' ',C'  COMMENTS='
  231. DCOMM    DC    CL6' '
  232.     DC    AL1(EBCCR,EBCLF),C'$'
  233. MASK     DC    X'402020202020'  EDIT MASK FOR PL3
  234. EBCCR    EQU   X'0D'   EBCDIC CARRIAGE RETURN
  235. EBCLF    EQU   X'0A'   EBCDIC LINE FEED
  236.     DC    C'SYSUT1 FCB FOR SEARCHES='
  237. SYSUT1   DS    0XL37
  238.     DC    X'00',CL8' ',CL3' '
  239.     DC    HL2'0',XL2'8000'    CURBLK, LRECL FOR MSDOS
  240.     DC    XL16'00',X'00',XL4'00' RESV.,EXT RCD #, BLKPTR
  241. *
  242. * DSECTS
  243. *
  244. IHAFCB   DSECT
  245. FCUNIT   DS    X
  246. FCNAME   DS    CL8
  247. FCTYPE   DS    CL3
  248.     DS    XL21
  249. FCBLKPTR DS    XL4
  250. *
  251. * DUMMY SECTION FOR DYNAMICALLY BUILT LINKED LIST OF SORTED FILES
  252. *
  253. ENTRY    DSECT
  254. ELINK    DS    A     POINTER TO NEXT BLOCK
  255. ENAME    DS    CL8   FILE NAME
  256. ETYPE    DS    CL3   SUFFIX
  257. LENTRY   EQU   *-ENTRY
  258. ****************************************************************************
  259. *
  260. * IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
  261. *
  262. * FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
  263. *
  264. ****************************************************************************
  265. IHADCB   DSECT
  266. DCBDCB   DS    CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
  267. DCBDSN   DS    A   ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
  268. DCBFID   DS    H   FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
  269. DCBFLG   DS    X   DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
  270. DFOPEN   EQU   X'80' FILE OPEN
  271. DFUBUF   EQU   X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
  272. DFOUT    EQU   X'20' OPEN FOR OUTPUT
  273. DFGEOF   EQU   X'10' END OF FILE PENDING ON SHORT BLOCK
  274. DFTRAN   EQU   X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
  275. DFADCB   EQU   X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
  276. DSORG    DS    C   DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
  277. MACRF    DS    C   DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
  278. RECFM    DS    C   DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
  279. EOR      DS    X   END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
  280. EOF      DS    X   END OF FILE CODE   (DEFAULT IS CTL-Z X'1A')
  281. LRECL    DS    H   RECORD LENGTH (2<LRECL<64K-16)
  282. BLKSZ    DS    H   BLOCK  LENGTH (2<BLKSZ<64K-16)
  283. EODAD    DS    A   END OF DATA EXIT ADDRESS
  284. SYNAD    DS    A   SYCHRONOUS ERROR EXIT ADDRESS
  285. RCD      DS    A   RECORD AREA ADDRESS FOR GET/PUT
  286. BLK      DS    A   BLOCK  AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
  287. RBA      DS    A   RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
  288. REN      DS    A   RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
  289. IOCNT    DS    F   BLOCK I/O COUNT SINCE OPEN
  290. PRECL    DS    H   PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  291. *
  292. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  293. *
  294. DSNSG    DS    XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  295. EODSG    DS    XL4 SEGMENT:OFFSET OF EODAD EXIT
  296. SYNSG    DS    XL4 SEGMENT:OFFSET OF SYNAD EXIT
  297. RCDSG    DS    XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  298. RENSG    DS    XL4 SEGMENT:OFFSET OF RENAME FILE NAME
  299. BLKSG    DS    XL4 SEGMENT:OFFSET OF BLOCK AREA
  300. BLKPTR   DS    XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  301. BLKEOD   DS    XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  302. BLKEND   DS    XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
  303. WLRECL   DS    H   REVERSED LRECL
  304. WBLKSZ   DS    H   REVERSED BLKSZ
  305. LDCB     EQU   *-IHADCB
  306. DEMOSRC  CSECT
  307.     DC    C'SYSUT2 DCB FOR READS='
  308. SYSUT2   DC    0F'0',C'ADCB'
  309.     DC    A(DSN)
  310.     DC    X'FFFF' FID
  311.     DC    X'00'   FLAGS
  312.     DC    C'SGT'  SEQ. GET TEXT
  313.     DC    X'0A'   EOR
  314.     DC    X'1A'   EOF
  315.     DC    H'256'  LRECL
  316.     DC    H'8192' BLKSZ
  317.     DC    A(EOFRTN) EODAD
  318.     DC    A(SYN)    SYN
  319.     DC    XL(SYSUT2+LDCB-*)'00'
  320.     DC    C'DSN FOR SYSUT2='
  321. DSN      DS    0XL64
  322. DSNNAME  DC    CL8'DEMOSRC '
  323.     DC    C'.'
  324. DSNTYPE  DC    C'ALC'
  325.     DC    X'00'
  326.     DC    XL(DSN+64-*)'00'
  327.     END   DEMOSRC
  328.