home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
emulate
/
systems
/
pc370
/
demo
/
demosrc.alc
< prev
next >
Wrap
Text File
|
1987-05-24
|
9KB
|
328 lines
TITLE 'DEMOSRC - DEMOSRC PROGRAM ANALYSIS'
*
* AUTHOR. DON HIGGINS.
* DATE. 03/30/85.
* REMARKS. PC/370 DEMO PROGRAM TO READ SELECTED SOURCE TEXT FILES
* AND PRINT REPORT WITH COUNT OF RECORDS AND COMMENTS.
* MAINTENANCE.
*
* 05/24/87 CONVERT TO R2.0 USING NEW DCB, AND GET TFCB FROM COM PREFIX
*
*
*
* INPUT
*
* 1. DEMOSRC DRIVE:PREFIX.SUFFIX
*
* OUTPUT
*
* 1. CONSOLE LISTING OF DEMOSRC FILE NAMES AND
* COUNT OF LINES OF CODE IN EACH ONE.
*
*
DEMOSRC CSECT
LR R13,R15
USING DEMOSRC,R13
LA R2,=C'DEMOSRC PROGRAM ANALYSIS$'
SVC WTO
LA R2,=C' $'
SVC WTO
BAL R14,GETPARM
LTR R15,R15
BNZ EOJ
BAL R14,GETLIST
LTR R15,R15
BNZ EOJ
BAL R14,PROCLIST
EOJ EQU *
SVC EXIT
TITLE 'GETPARM - MOVE PARM TO DCB'
GETPARM EQU *
LA R2,SYSUT1
USING IHAFCB,R2
LRA R3,0 R1=A(ABSOLUTE ADDRESS OF ADDR. SPACE)
S R3,=A(X'110') R1=A(ABSOLUTE ADDRESS OF MS-DOS COM PREFIX
LA R4,1
MVCP FCUNIT(R4),TFCB+(FCUNIT-IHAFCB),R3 ** THIS IS REALLY
LA R4,8 ** TRICKY CODE AND
MVCP FCNAME(R4),TFCB+(FCNAME-IHAFCB),R3 ** MAGIC BY THE
LA R4,3 ** AUTHOR OF PC/370
MVCP FCTYPE(R4),TFCB+(FCTYPE-IHAFCB),R3 ** TO AVOID HAVING TO
DROP R2 ** SCAN PARMS (LAZY)
SR R15,R15
BR R14
TITLE 'GETLIST - BUILD LIST OF SORTED FILES FROM DIRECTORY'
GETLIST EQU *
LA R2,TBUFF
SVC SETDMA
LA R2,SYSUT1
SR R0,R0
SVC FNDDIR FIND FIRST DIRECTORY ENTRY
CLM R0,1,=X'FF'
BE NOFILES
BLDLIST EQU *
LA R3,TBUFF
SLL R0,5 R0=32*OFFSET
AR R3,R0 R3=DIRECTORY ENTRY
USING IHAFCB,R3
LA R1,LENTRY
SVC GMAIN
CLM R0,1,=X'00'
BNE MEMERR
USING ENTRY,R2
MVC ENAME,FCNAME
MVC ETYPE,FCTYPE
DROP R3
LA R1,LISTPTR R1 = LAST ENTRY
INSERT EQU *
L R3,ELINK-ENTRY(R1) R3 = NEXT ENTRY
LTR R3,R3
BZ ADDNOW
CLC ENAME,ENAME-ENTRY(R3)
BL ADDNOW
LR R1,R3
B INSERT
ADDNOW EQU *
ST R2,ELINK-ENTRY(R1) CHAIN CURRENT TO PREV.
ST R3,ELINK CHAIN NEXT TO CURRENT
NEXTFILE EQU *
DROP R2,R3
LA R2,SYSUT1
SR R0,R0
SVC NXTDIR GET NEXT MATCHING DIRECTORY
CLM R0,1,=X'FF'
BNE BLDLIST
SR R15,R15
BR R14 EXIT NORMALLY TO PROCESS LIST
MEMERR EQU *
LA R2,=C'OUT OF MEMORY$'
SVC WTO
SVC TRACE
DC C'BUG'
SVC EXIT
NOFILES EQU *
LA R2,=C'NO MATCHING FILES$'
SVC WTO
LA R15,16
BR R14
TITLE 'PROCLIST - PROCESS EACH DEMOSRC FILE IN LIST'
PROCLIST EQU *
LA R3,LISTPTR
NEXTLIST EQU *
L R3,0(R3)
LTR R3,R3
BZ PLEXIT
USING ENTRY,R3
LA R2,SYSUT2
USING IHADCB,R2
MVC DSNNAME,ENAME
TRT DSNNAME,FINDBLK
BNZ MOVSUF
LA R1,DSNNAME+8
MOVSUF EQU *
MVI 0(R1),X'2E' ASCII PERIOD
MVC 1(3,R1),ETYPE
MVI 4(R1),0
LA R2,4(R1)
LA R1,DSN
SR R2,R1
SVC ASCEBC CONVERT TO EBCDIC FOR MMS/370 OPEN
MVC DNAME,DNAME-1 CLEAR DSN ON TOTAL LINE
BCTR R2,0
EX R2,MVCDNAME MOVE DSN
LA R2,SYSUT2
SVC OPEN
ZAP PCOUNT,=P'0'
ZAP PCOMM,=P'0'
NEXTREC EQU *
LA R2,SYSUT2
LA R1,RECORD
SVC GET
AP PCOUNT,=P'1'
LA R1,RECORD
SKPN EQU *
TM 0(R1),X'80'
BZ SKPOK
LA R1,1(R1)
B SKPN
MVCDNAME MVC DNAME(0),DSNNAME
SKPOK EQU *
CLI 0(R1),ASCASK
BE COMM
CLI 0(R1),ASCSMI
BE COMM
B NEXTREC
COMM EQU *
AP PCOMM,=P'1'
B NEXTREC
EOFRTN EQU *
LA R2,SYSUT2
SVC CLOSE
MVC DCOUNT,MASK
ED DCOUNT,PCOUNT
MVC DCOMM,MASK
ED DCOMM,PCOMM
LA R2,TMSG
SVC WTO
AP PTOTAL,PCOUNT
AP PTCOMM,PCOMM
B NEXTLIST
PLEXIT EQU *
MVC DNAME,DNAME-1
MVC DNAME(5),=C'TOTAL'
MVC DCOUNT,MASK
ED DCOUNT,PTOTAL
MVC DCOMM,MASK
ED DCOMM,PTCOMM
LA R2,TMSG
SVC WTO
SR R15,R15
BR R14
SYN EQU *
LA R2,=C'IO ERROR$'
SVC WTO
SVC TRACE
DC C'BUG'
LTORG
*
* REGISTER USAGE
*
R0 EQU 0 SVC RETURN CODE
R1 EQU 1 SVC ARGUMENT
R2 EQU 2 SVC ARGUMENT (DCB ADDRESS, DMA, MSG, ETC.)
R3 EQU 3 DIRECTORY ADDRESS (TBUFF + OFFSET)
R4 EQU 4 LENGTH FOR CROSS MEMORY MOVE FROM TFCB
R13 EQU 13 BASE
R14 EQU 14 LINK FROM MAINLINE TO ROUTINES
R15 EQU 15 RETURN CODE FROM ROUTINES
*
* PC/370 SVC'S
*
EXIT EQU 0
OPEN EQU 1
CLOSE EQU 2
GET EQU 5
PUT EQU 6
TRACE EQU 9
GMAIN EQU 10
FMAIN EQU 11
ASCEBC EQU 12
WTO EQU 209
SETDMA EQU 226
FNDDIR EQU 217
NXTDIR EQU 218
*
* DATA AREAS
*
FINDBLK DC 32X'00',X'FF',(256-33)X'00' FIND ASCII BLANK
TFCB EQU X'5C' FCB BUILT BY MS-DOS IN COM PREFIX
TBUFF EQU X'80' BUFFER FOR DIRECTORY SEARCH (COPIED TO AS)
LISTPTR DC A(0) POINTER TO LIST OF FILE ENTRIES SELECTED
RECORD DS XL256 LOGICAL RECORD AREA
ASCASK EQU X'2A' ASCII ASTERISK FOR ALC COMMENT CHECK
ASCSMI EQU X'3B' ASCII SIMICOLON FOR MAC COMMENT CHECK
PCOUNT DC PL3'0' FILE RECORD COUNT
PCOMM DC PL3'0' FILE COMMENT COUNT
PTOTAL DC PL3'0' TOTAL RECORD COUNT
PTCOMM DC PL3'0' TOTAL COMMENT COUNT
TMSG DC C' '
DNAME DC CL12' ',C' RECORDS='
DCOUNT DC CL6' ',C' COMMENTS='
DCOMM DC CL6' '
DC AL1(EBCCR,EBCLF),C'$'
MASK DC X'402020202020' EDIT MASK FOR PL3
EBCCR EQU X'0D' EBCDIC CARRIAGE RETURN
EBCLF EQU X'0A' EBCDIC LINE FEED
DC C'SYSUT1 FCB FOR SEARCHES='
SYSUT1 DS 0XL37
DC X'00',CL8' ',CL3' '
DC HL2'0',XL2'8000' CURBLK, LRECL FOR MSDOS
DC XL16'00',X'00',XL4'00' RESV.,EXT RCD #, BLKPTR
*
* DSECTS
*
IHAFCB DSECT
FCUNIT DS X
FCNAME DS CL8
FCTYPE DS CL3
DS XL21
FCBLKPTR DS XL4
*
* DUMMY SECTION FOR DYNAMICALLY BUILT LINKED LIST OF SORTED FILES
*
ENTRY DSECT
ELINK DS A POINTER TO NEXT BLOCK
ENAME DS CL8 FILE NAME
ETYPE DS CL3 SUFFIX
LENTRY EQU *-ENTRY
****************************************************************************
*
* IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
*
* FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
*
****************************************************************************
IHADCB DSECT
DCBDCB DS CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
DCBDSN DS A ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
DCBFID DS H FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
DCBFLG DS X DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
DFOPEN EQU X'80' FILE OPEN
DFUBUF EQU X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
DFOUT EQU X'20' OPEN FOR OUTPUT
DFGEOF EQU X'10' END OF FILE PENDING ON SHORT BLOCK
DFTRAN EQU X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
DFADCB EQU X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
DSORG DS C DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
MACRF DS C DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
RECFM DS C DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
EOR DS X END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
EOF DS X END OF FILE CODE (DEFAULT IS CTL-Z X'1A')
LRECL DS H RECORD LENGTH (2<LRECL<64K-16)
BLKSZ DS H BLOCK LENGTH (2<BLKSZ<64K-16)
EODAD DS A END OF DATA EXIT ADDRESS
SYNAD DS A SYCHRONOUS ERROR EXIT ADDRESS
RCD DS A RECORD AREA ADDRESS FOR GET/PUT
BLK DS A BLOCK AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
RBA DS A RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
REN DS A RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
IOCNT DS F BLOCK I/O COUNT SINCE OPEN
PRECL DS H PHYSICAL BLOCK SIZE OF LAST READ/WRITE
*
* RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
*
DSNSG DS XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
EODSG DS XL4 SEGMENT:OFFSET OF EODAD EXIT
SYNSG DS XL4 SEGMENT:OFFSET OF SYNAD EXIT
RCDSG DS XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
RENSG DS XL4 SEGMENT:OFFSET OF RENAME FILE NAME
BLKSG DS XL4 SEGMENT:OFFSET OF BLOCK AREA
BLKPTR DS XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
BLKEOD DS XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
BLKEND DS XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
WLRECL DS H REVERSED LRECL
WBLKSZ DS H REVERSED BLKSZ
LDCB EQU *-IHADCB
DEMOSRC CSECT
DC C'SYSUT2 DCB FOR READS='
SYSUT2 DC 0F'0',C'ADCB'
DC A(DSN)
DC X'FFFF' FID
DC X'00' FLAGS
DC C'SGT' SEQ. GET TEXT
DC X'0A' EOR
DC X'1A' EOF
DC H'256' LRECL
DC H'8192' BLKSZ
DC A(EOFRTN) EODAD
DC A(SYN) SYN
DC XL(SYSUT2+LDCB-*)'00'
DC C'DSN FOR SYSUT2='
DSN DS 0XL64
DSNNAME DC CL8'DEMOSRC '
DC C'.'
DSNTYPE DC C'ALC'
DC X'00'
DC XL(DSN+64-*)'00'
END DEMOSRC