gmgauthier/mvs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove the crent stuff

Browse Source
This commit is contained in:
Greg Gauthier 2025-01-21 20:22:54 +00:00
parent 85607f1391
commit c0548c4d18
2604 changed files with 0 additions and 166005 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
src/crent370/asm/@@aclose.asm
View File

@ -1,73 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* ACLOSE - Close a data set *
* *
***********************************************************************
@@ACLOSE FUNHEAD IO=YES,SAVE=(WORKAREA,WORKLEN,SUBPOOL) CLOSE
TM IOMFLAGS,IOFTERM TERMINAL I/O MODE?
BNZ FREEBUFF YES; JUST FREE STUFF
FIXWRITE , WRITE FINAL BUFFER, IF ONE
FREEBUFF LM R1,R2,ZBUFF1 Look at first buffer
LTR R0,R2 Any ?
BZ FREEDBF1 No
FREEMAIN RC,LV=(0),A=(1),SP=SUBPOOL Free BLOCK buffer
FREEDBF1 LM R1,R2,ZBUFF2 Look at first buffer
LTR R0,R2 Any ?
BZ FREEDBF2 No
FREEMAIN RC,LV=(0),A=(1),SP=SUBPOOL Free RECRD buffer
FREEDBF2 TM IOMFLAGS,IOFTERM TERMINAL I/O MODE?
BNZ NOPOOL YES; SKIP CLOSE/FREEPOOL
CLOSE MF=(E,OPENCLOS)
TM DCBBUFCA+L'DCBBUFCA-1,1 BUFFER POOL?
BNZ NOPOOL NO, INVALIDATED
SR R15,R15
ICM R15,7,DCBBUFCA DID WE GET A BUFFER?
BZ NOPOOL 0-NO
FREEPOOL ((R10))
NOPOOL DS 0H
FREEMAIN R,LV=ZDCBLEN,A=(R10),SP=SUBPOOL
FUNEXIT RC=0
*
LTORG ,
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@aclose.o
View File

67
src/crent370/asm/@@aline.asm
View File

@ -1,67 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* ALINE - See whether any more input is available *
* R15=0 EOF R15=1 More data available *
* *
***********************************************************************
@@ALINE FUNHEAD IO=YES,AM=YES,SAVE=(WORKAREA,WORKLEN,SUBPOOL)
FIXWRITE ,
TM IOMFLAGS,IOFTERM Terminal Input?
BNZ ALINEYES Always one more?
LA R3,KEPTREC
LA R4,KEPTREC+4
STM R2,R4,DWORK BUILD PARM LIST
* LA R15,@@AREAD
L R15,=V(@@AREAD)
LA R1,DWORK
BALR R14,R15 GET NEXT RECORD
SR R15,R15 SET EOF FLAG
LTR R6,R6 HIT EOF ?
BM ALINEX YES; RETURN ZERO
OI IOPFLAGS,IOFKEPT SHOW WE'RE KEEPING A RECORD
ALINEYES LA R15,1 ELSE RETURN ONE
ALINEX FUNEXIT RC=(R15)
*
LTORG ,
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@aline.o
View File

64
src/crent370/asm/@@anote.asm
View File

@ -1,64 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* ANOTE - Remember the position in the data set (BSAM/BPAM only) *
* *
***********************************************************************
@@ANOTE FUNHEAD IO=YES,AM=YES,SAVE=SAVEADCB,US=NO NOTE position
L R3,4(,R1) R3 points to the return value
FIXWRITE ,
GO24 , For old code
TM IOMFLAGS,IOFEXCP EXCP mode?
BZ NOTEBSAM No
L R4,DCBBLKCT Return block count
B NOTECOM
SPACE 1
NOTEBSAM NOTE (R10) Note current position
LR R4,R1 Save result
NOTECOM AMUSE ,
ST R4,0(,R3) Return TTR0 to user
FUNEXIT RC=0
*
LTORG , In case someone adds literals
*
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@anote.o
View File

766
src/crent370/asm/@@aopen.asm
View File

@ -1,766 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
*
*
*
* Start of functions
*
*
***********************************************************************
* *
* AOPEN - Open a data set *
* *
***********************************************************************
* *
* Parameters are: *
*1 DDNAME - space-padded, 8 character DDNAME to be opened *
*2 MODE = 0 INPUT 1 OUTPUT 2 UPDAT 3 APPEND Record mode *
* MODE = 4 INOUT 5 OUTIN *
* MODE = 8/9 Use EXCP for tape, BSAM otherwise (or 32<=JFCPNCP<=65) *
* MODE + 10 = Use BLOCK mode (valid 10-15) *
* MODE = 80 = GETLINE, 81 = PUTLINE (other bits ignored) *
* N.B.: see comments under Return value
*3 RECFM - 0 = F, 1 = V, 2 = U. Default/preference set by caller; *
* actual value returned from open. *
*4 LRECL - Default/preference set by caller; OPEN value returned. *
*5 BLKSIZE - Default/preference set by caller; OPEN value returned. *
* *
* August 2009 revision - caller will pass preferred RECFM (coded 0-2) *
* LRECL, and BLKSIZE values. DCB OPEN exit OCDCBEX will use these *
* defaults when not specified on JCL or DSCB merge. *
* *
*6 ZBUFF2 - pointer to an area that may be written to (size is LRECL) *
*7 MEMBER - *pointer* to space-padded, 8 character member name. *
* A member name beginning with blank or hex zero is ignored. *
* If pointer is 0 (NULL), no member is requested *
* *
* Return value: *
* An internal "handle" that allows the assembler routines to *
* keep track of what's what, when READ etc are subsequently *
* called. *
* *
* All passed parameters are subject to overrides based on device *
* capabilities and capacities, e.g., blocking may be turned off. *
* In particular, the MODE flag will have x'40' ORed in for a *
* unit record device. *
* *
* *
* Note - more documentation for this and other I/O functions can *
* be found halfway through the stdio.c file in PDPCLIB. *
* *
* Here are some of the errors reported: *
* *
* OPEN input failed return code is: -37 *
* OPEN output failed return code is: -39 *
* *
* FIND input member return codes are: *
* Original, before the return and reason codes had *
* negative translations added refer to copyrighted: *
* DFSMS Macro Instructions for Data Sets *
* RC = 0 Member was found. *
* RC = -1024 Member not found. *
* RC = -1028 RACF allows PDSE EXECUTE, not PDSE READ. *
* RC = -1032 PDSE share not available. *
* RC = -1036 PDSE is OPENed output to a different member. *
* RC = -2048 Directory I/O error. *
* RC = -2052 Out of virtual storage. *
* RC = -2056 Invalid DEB or DEB not on TCB or TCBs DEB chain. *
* RC = -2060 PDSE I/O error flushing system buffers. *
* RC = -2064 Invalid FIND, no DCB address. *
* *
***********************************************************************
PUSH USING
@@AOPEN FUNHEAD SAVE=(WORKAREA,OPENLEN,SUBPOOL)
LR R11,R1 KEEP R11 FOR PARAMETERS
USING PARMSECT,R11 MAKE IT EASIER TO READ
L R3,PARM1 R3 POINTS TO DDNAME
* Note that R5 is used as a scratch register
L R8,PARM4 R8 POINTS TO LRECL
* PARM5 has BLKSIZE
* PARM6 has ZBUFF2 pointer
L R9,PARM7 R9 POINTS TO MEMBER NAME (OF PDS)
LA R9,00(,R9) Strip off high-order bit or byte
TM 0(R9),255-X'40' Either blank or zero?
BNZ *+6 No
SR R9,R9 Set for no member
SPACE 1
L R4,PARM2 R4 is the MODE. 0=input 1=output
CH R4,=H'256' Call with value?
BL *+8 Yes; else pointer
L R4,0(,R4) Load C/370 MODE. 0=input 1=output
SPACE 1
AIF ('&SYS' NE 'S390').NOLOW
GETMAIN R,LV=ZDCBLEN,SP=SUBPOOL,LOC=BELOW
AGO .FINLOW
.NOLOW GETMAIN R,LV=ZDCBLEN,SP=SUBPOOL
.FINLOW LR R10,R1 Addr.of storage obtained to its base
USING IHADCB,R10 Give assembler DCB area base register
LR R0,R10 Load output DCB area address
LA R1,ZDCBLEN Load output length of DCB area
LA R15,0 Pad of X'00' and no input length
MVCL R0,R14 Clear DCB area to binary zeroes
*---------------------------------------------------------------------*
* GET USER'S DEFAULTS HERE, BECAUSE THEY MAY GET CHANGED
*---------------------------------------------------------------------*
L R5,PARM3 HAS RECFM code (0-FB 1-VB 2-U)
L R14,0(,R5) LOAD RECFM VALUE
STC R14,FILEMODE PASS TO OPEN
L R14,0(,R8) GET LRECL VALUE
ST R14,LRECL PASS TO OPEN
L R14,PARM5 R14 POINTS TO BLKSIZE
L R14,0(,R14) GET BLOCK SIZE
ST R14,BLKSIZE PASS TO OPEN
SPACE 1
*---------------------------------------------------------------------*
* DO THE DEVICE TYPE NOW TO CHECK WHETHER EXCP IS POSSIBLE
* ALSO BYPASS STUFF IF USER REQUESTED TERMINAL I/O
*---------------------------------------------------------------------*
OPCURSE STC R4,WWORK Save to storage
STC R4,WWORK+1 Save to storage
NI WWORK+1,7 Retain only open mode bits
TM WWORK,IOFTERM Terminal I/O ?
BNZ TERMOPEN Yes; do completely different
***> Consider forcing terminal mode if DD is a terminal?
MVC DWDDNAM,0(R3) Move below the line
DEVTYPE DWDDNAM,DWORK Check device type
BXH R15,R15,FAILDCB DD missing
ICM R0,15,DWORK+4 Any device size ?
BNZ OPHVMAXS
MVC DWORK+6(2),=H'32760' Set default max
SPACE 1
OPHVMAXS CLI WWORK+1,3 Append requested ?
BNE OPNOTAP No
TM DWORK+2,UCB3TAPE+UCB3DACC TAPE or DISK ?
BM OPNOTAP Yes; supported
NI WWORK,255-2 Change to plain output
*OR-FAIL BNM FAILDCB No, not supported
SPACE 1
OPNOTAP CLI WWORK+1,2 UPDAT request?
BNE OPNOTUP No
CLI DWORK+2,UCB3DACC DASD ?
BNE FAILDCB No, not supported
SPACE 1
OPNOTUP CLI WWORK+1,4 INOUT or OUTIN ?
BL OPNOTIO No
TM DWORK+2,UCB3TAPE+UCB3DACC TAPE or DISK ?
BNM FAILDCB No; not supported
SPACE 1
OPNOTIO TM WWORK,IOFEXCP EXCP requested ?
BZ OPFIXMD2
CLI DWORK+2,UCB3TAPE TAPE/CARTRIDGE device?
BE OPFIXMD1 Yes; wonderful ?
OPFIXMD0 NI WWORK,255-IOFEXCP Cancel EXCP request
B OPFIXMD2
OPFIXMD1 L R0,BLKSIZE GET USER'S SIZE
CH R0,=H'32760' NEED EXCP ?
BNH OPFIXMD0 NO; USE BSAM
ST R0,DWORK+4 Increase max size
ST R0,LRECL ALSO RECORD LENGTH
MVI FILEMODE,2 FORCE RECFM=U
SPACE 1
OPFIXMD2 IC R4,WWORK Fix up
OPFIXMOD STC R4,WWORK Save to storage
MVC IOMFLAGS,WWORK Save for duration
SPACE 1
*---------------------------------------------------------------------*
* Do as much common code for input and output before splitting
* Set mode flag in Open/Close list
* Move BSAM, QSAM, or EXCP DCB to work area
*---------------------------------------------------------------------*
STC R4,OPENCLOS Initialize MODE=24 OPEN/CLOSE list
NI OPENCLOS,X'07' For now
* OPEN mode: IN OU UP AP IO OI
TR OPENCLOS(1),=X'80,8F,84,8E,83,86,0,0'
CLI OPENCLOS,0 NOT SUPPORTED ?
BE FAILDCB FAIL REQUEST
SPACE 1
TM WWORK,IOFEXCP EXCP mode ?
BZ OPQRYBSM
MVC ZDCBAREA(EXCPDCBL),EXCPDCB Move DCB/IOB/CCW
LA R15,TAPEIOB FOR EASIER SETTINGS
USING IOBSTDRD,R15
MVI IOBFLAG1,IOBDATCH+IOBCMDCH COMMAND CHAINING IN USE
MVI IOBFLAG2,IOBRRT2
LA R1,TAPEECB
ST R1,IOBECBPT
LA R1,TAPECCW
ST R1,IOBSTART CCW ADDRESS
ST R1,IOBRESTR CCW ADDRESS
LA R1,TAPEDCB
ST R1,IOBDCBPT DCB
LA R1,TAPEIOB
STCM R1,7,DCBIOBAA LINK IOB TO DCB FOR DUMP FORM.ING
LA R0,1 SET BLOCK COUNT INCREMENT
STH R0,IOBINCAM
DROP R15
B OPREPCOM
SPACE 1
OPQRYBSM TM WWORK,IOFBLOCK Block mode ?
BNZ OPREPBSM
TM WWORK,X'01' In or Out
*DEFUNCT BNZ OPREPQSM
OPREPBSM MVC ZDCBAREA(BSAMDCBL),BSAMDCB Move DCB template to work
TM DWORK+2,UCB3DACC+UCB3TAPE Tape or Disk ?
BM OPREPCOM Either; keep RP,WP
NC DCBMACR(2),=AL1(DCBMRRD,DCBMRWRT) Strip Point
B OPREPCOM
SPACE 1
OPREPQSM MVC ZDCBAREA(QSAMDCBL),QSAMDCB
OPREPCOM MVC DCBDDNAM,0(R3)
MVC DEVINFO(8),DWORK Check device type
ICM R0,15,DEVINFO+4 Any ?
BZ FAILDCB No DD card or ?
N R4,=X'000000EF' Reset block mode
TM WWORK,IOFTERM Terminal I/O?
BNZ OPFIXMOD
TM WWORK,IOFBLOCK Blocked I/O?
BZ OPREPJFC
CLI DEVINFO+2,UCB3UREC Unit record?
BE OPFIXMOD Yes, may not block
SPACE 1
OPREPJFC LA R14,JFCB
* EXIT TYPE 07 + 80 (END OF LIST INDICATOR)
ICM R14,B'1000',=X'87'
ST R14,DCBXLST+4
LA R14,OCDCBEX POINT TO DCB EXIT
* Both S380 and S390 operate in 31-bit mode so need a stub
AIF ('&SYS' EQ 'S370').NODP24
ST R14,DOPE31 Address of 31-bit exit
OI DOPE31,X'80' Set high bit = AMODE 31
MVC DOPE24,DOPEX24 Move in stub code
LA R14,DOPE24 Switch to 24-bit stub
.NODP24 ANOP ,
ICM R14,8,=X'05' REQUEST IT
ST R14,DCBXLST AND SET IT BACK
LA R14,DCBXLST
STCM R14,B'0111',DCBEXLSA
MVC EOFR24(EOFRLEN),ENDFILE Put EOF code below the line
LA R1,EOFR24
STCM R1,B'0111',DCBEODA
RDJFCB ((R10)),MF=(E,OPENCLOS) Read JOB File Control Blk
*---------------------------------------------------------------------*
* If the caller did not request EXCP mode, but the user has BLKSIZE
* greater than 32760 on TAPE, then we set the EXCP bit in R4 and
* restart the OPEN. Otherwise MVS should fail?
* The system fails explicit BLKSIZE in excess of 32760, so we cheat.
* The NCP field is not otherwise honored, so if the value is 32 to
* 64 inclusive, we use that times 1024 as a value (max 65535)
*---------------------------------------------------------------------*
CLI DEVINFO+2,UCB3TAPE TAPE DEVICE?
BNE OPNOTBIG NO
TM WWORK,IOFEXCP USER REQUESTED EXCP ?
BNZ OPVOLCNT NOTHING TO DO
CLI JFCNCP,32 LESS THAN MIN ?
BL OPNOTBIG YES; IGNORE
CLI JFCNCP,65 NOT TOO HIGH ?
BH OPNOTBIG TOO BAD
*---------------------------------------------------------------------*
* Clear DCB wrk area and force RECFM=U,BLKSIZE>32K
* and restart the OPEN processing
*---------------------------------------------------------------------*
LR R0,R10 Load output DCB area address
LA R1,ZDCBLEN Load output length
LA R15,0 Pad of X'00'
MVCL R0,R14 Clear DCB area to zeroes
SR R0,R0
ICM R0,1,JFCNCP NUMBER OF CHANNEL PROGRAMS
SLL R0,10 *1024
C R0,=F'65535' LARGER THAN CCW SUPPORTS?
BL *+8 NO
L R0,=F'65535' LOAD MAX SUPPORTED
ST R0,BLKSIZE MAKE NEW VALUES THE DEFAULT
ST R0,LRECL MAKE NEW VALUES THE DEFAULT
MVI FILEMODE,2 USE RECFM=U
LA R0,IOFEXCP GET EXCP OPTION
OR R4,R0 ADD TO USER'S REQUEST
B OPCURSE AND RESTART THE OPEN
SPACE 1
OPVOLCNT SR R1,R1
ICM R1,1,JFCBVLCT GET VOLUME COUNT FROM DD
BNZ *+8 OK
LA R1,1 SET FOR ONE
ST R1,ZXCPVOLS SAVE FOR EOV
SPACE 1
OPNOTBIG CLI DEVINFO+2,UCB3DACC Is it a DASD device?
BNE OPNODSCB No; no member name supported
*---------------------------------------------------------------------*
* For a DASD resident file, get the format 1 DSCB
*---------------------------------------------------------------------*
* CAMLST CAMLST SEARCH,DSNAME,VOLSER,DSCB+44
*
L R14,CAMDUM Get CAMLST flags
LA R15,JFCBDSNM Load address of output data set name
LA R0,JFCBVOLS Load addr. of output data set volser
LA R1,DS1FMTID Load address of where to put DSCB
STM R14,R1,CAMLST Complete CAMLST addresses
OBTAIN CAMLST Read the VTOC record
SPACE 1
* The member name may not be below the line, which may stuff up
* the "FIND" macro, so make sure it is in 24-bit memory.
OPNODSCB LTR R9,R9 See if an address for the member name
BZ NOMEM No member name, skip copying
MVC MEMBER24,0(R9)
LA R9,MEMBER24
SPACE 1
*---------------------------------------------------------------------*
* Split READ and WRITE paths
* Note that all references to DCBRECFM, DCBLRECL, and DCBBLKSI
* have been replaced by ZRECFM, LRECL, and BLKSIZE for EXCP use.
*---------------------------------------------------------------------*
NOMEM TM WWORK,1 See if OPEN input or output
BNZ WRITING
*---------------------------------------------------------------------*
*
* READING
* N.B. moved RDJFCB prior to member test to allow uniform OPEN and
* other code. Makes debugging and maintenance easier
*
*---------------------------------------------------------------------*
OI JFCBTSDM,JFCNWRIT Don't mess with DSCB
CLI DEVINFO+2,UCB3DACC Is it a DASD device?
BNE OPENVSEQ No; no member name supported
*---------------------------------------------------------------------*
* See if DSORG=PO but no member; use member from JFCB if one
*---------------------------------------------------------------------*
TM DS1DSORG,DS1DSGPO See if DSORG=PO
BZ OPENVSEQ Not PDS, don't read PDS directory
TM WWORK,X'07' ANY NON-READ OPTION ?
BNZ FAILDCB NOT ALLOWED FOR PDS
LTR R9,R9 See if an address for the member name
BNZ OPENMEM Is member name - BPAM access
TM JFCBIND1,JFCPDS See if a member name in JCL
BZ OPENDIR No; read directory
MVC MEMBER24,JFCBELNM Save the member name
NI JFCBIND1,255-JFCPDS Reset it
XC JFCBELNM,JFCBELNM Delete it in JFCB
LA R9,MEMBER24 Force FIND to prevent 013 abend
B OPENMEM Change DCB to BPAM PO
*---------------------------------------------------------------------*
* At this point, we have a PDS but no member name requested.
* Request must be to read the PDS directory
*---------------------------------------------------------------------*
OPENDIR TM OPENCLOS,X'0F' Other than plain OPEN ?
BNZ BADOPIN No, fail (allow UPDAT later?)
LA R0,256 Set size for Directory BLock
STH R0,DCBBLKSI Set DCB BLKSIZE to 256
STH R0,DCBLRECL Set DCB LRECL to 256
ST R0,LRECL
ST R0,BLKSIZE
MVI DCBRECFM,DCBRECF Set DCB RECFM to RECFM=F (notU?)
B OPENIN
OPENMEM MVI DCBDSRG1,DCBDSGPO Replace DCB DSORG=PS with PO
OI JFCBTSDM,JFCVSL Force OPEN analysis of JFCB
B OPENIN
OPENVSEQ LTR R9,R9 Member name for sequential?
BNZ BADOPIN Yes, fail
TM IOMFLAGS,IOFEXCP EXCP mode ?
BNZ OPENIN YES
OI DCBOFLGS,DCBOFPPC Allow unlike concatenation
OPENIN OPEN MF=(E,OPENCLOS),TYPE=J Open the data set
TM DCBOFLGS,DCBOFOPN Did OPEN work?
BZ BADOPIN OPEN failed, go return error code -37
LTR R9,R9 See if an address for the member name
BZ GETBUFF No member name, skip finding it
*
FIND (R10),(R9),D Point to the requested member
*
LTR R15,R15 See if member found
BZ GETBUFF Member found, go get an input buffer
* If FIND return code not zero, process return and reason codes and
* return to caller with a negative return code.
SLL R15,8 Shift return code for reason code
OR R15,R0 Combine return code and reason code
LR R7,R15 Number to generate return and reason
CLOSE MF=(E,OPENCLOS) Close, FREEPOOL not needed
B FREEDCB
BADOPIN DS 0H
BADOPOUT DS 0H
FAILDCB N R4,=F'1' Mask other option bits
LA R7,37(R4,R4) Preset OPEN error code
FREEDCB FREEMAIN R,LV=ZDCBLEN,A=(R10),SP=SUBPOOL Free DCB area
LCR R7,R7 Set return and reason code
B RETURNOP Go return to caller with negative RC
SPACE 1
*---------------------------------------------------------------------*
* Process for OUTPUT mode
*---------------------------------------------------------------------*
WRITING LTR R9,R9
BZ WNOMEM
CLI DEVINFO+2,UCB3DACC DASD ?
BNE BADOPOUT Member name invalid
TM DS1DSORG,DS1DSGPO See if DSORG=PO
BZ BADOPOUT Is not PDS, fail request
TM WWORK,X'06' ANY NON-RITE OPTION ?
BNZ FAILDCB NOT ALLOWED FOR PDS
MVC JFCBELNM,0(R9)
OI JFCBIND1,JFCPDS
OI JFCBTSDM,JFCVSL Just in case
B WNOMEM2 Go to move DCB info
WNOMEM DS 0H
TM JFCBIND1,JFCPDS See if a member name in JCL
BO WNOMEM2 Is member name, go to continue OPEN
* See if DSORG=PO but no member so OPEN output would destroy directory
TM DS1DSORG,DS1DSGPO See if DSORG=PO
BZ WNOMEM2 Is not PDS, go OPEN
WTO 'MVSSUPA - No member name for output PDS',ROUTCDE=11
WTO 'MVSSUPA - Refuses to write over PDS directory', C
ROUTCDE=11
ABEND 123 Abend without a dump
SPACE 1
WNOMEM2 OPEN MF=(E,OPENCLOS),TYPE=J
TM DCBOFLGS,DCBOFOPN Did OPEN work?
BZ BADOPOUT OPEN failed, go return error code -39
SPACE 1
*---------------------------------------------------------------------*
* Acquire one BLKSIZE buffer for our I/O; and one LRECL buffer
* for use by caller for @@AWRITE, and us for @@AREAD.
*---------------------------------------------------------------------*
GETBUFF L R5,BLKSIZE Load the input blocksize
LA R6,4(,R5) Add 4 in case RECFM=U buffer
GETMAIN R,LV=(R6),SP=SUBPOOL Get input buffer storage
ST R1,ZBUFF1 Save for cleanup
ST R6,ZBUFF1+4 ditto
ST R1,BUFFADDR Save the buffer address for READ
XC 0(4,R1),0(R1) Clear the RECFM=U Record Desc. Word
LA R14,0(R5,R1) Get end address
ST R14,BUFFEND for real
SPACE 1
L R6,LRECL Get record length
LA R6,4(,R6) Insurance
GETMAIN R,LV=(R6),SP=SUBPOOL Get VBS build record area
ST R1,ZBUFF2 Save for cleanup
ST R6,ZBUFF2+4 ditto
LA R14,4(,R1)
ST R14,VBSADDR Save the VBS read/user write
L R5,PARM6 Get caller's BUFFER address
ST R14,0(,R5) and return work address
AR R1,R6 Add size GETMAINed to find end
ST R1,VBSEND Save address after VBS rec.build area
B DONEOPEN Go return to caller with DCB info
SPACE 1
PUSH USING
*---------------------------------------------------------------------*
* Establish ZDCBAREA for either @@AWRITE or @@AREAD processing to
* a terminal, or SYSTSIN/SYSTERM in batch.
*---------------------------------------------------------------------*
TERMOPEN MVC IOMFLAGS,WWORK Save for duration
NI IOMFLAGS,IOFTERM+IOFOUT IGNORE ALL OTHERS
MVC ZDCBAREA(TERMDCBL),TERMDCB Move DCB/IOB/CCW
MVC ZIODDNM,0(R3) DDNAME FOR DEBUGGING, ETC.
LTR R9,R9 See if an address for the member name
BNZ FAILDCB Yes; fail
L R14,PSATOLD-PSA GET MY TCB
USING TCB,R14
ICM R15,15,TCBJSCB LOOK FOR THE JSCB
BZ FAILDCB HUH ?
USING IEZJSCB,R15
ICM R15,15,JSCBPSCB PSCB PRESENT ?
BZ FAILDCB NO; NOT TSO
L R1,TCBFSA GET FIRST SAVE AREA
N R1,=X'00FFFFFF' IN CASE AM31
L R1,24(,R1) LOAD INVOCATION R1
USING CPPL,R1 DECLARE IT
MVC ZIOECT,CPPLECT
MVC ZIOUPT,CPPLUPT
SPACE 1
ICM R6,15,BLKSIZE Load the input blocksize
BP *+12 Use it
LA R6,1024 Arbitrary non-zero size
ST R6,BLKSIZE Return it
ST R6,LRECL Return it
LA R6,4(,R6) Add 4 in case RECFM=U buffer
GETMAIN R,LV=(R6),SP=SUBPOOL Get input buffer storage
ST R1,ZBUFF2 Save for cleanup
ST R6,ZBUFF2+4 ditto
LA R1,4(,R1) Allow for RDW if not V
ST R1,BUFFADDR Save the buffer address for READ
L R5,PARM6 R5 points to ZBUFF2
ST R1,0(,R5) save the pointer
XC 0(4,R1),0(R1) Clear the RECFM=U Record Desc. Word
MVC ZRECFM,FILEMODE Requested format 0-2
NI ZRECFM,3 Just in case
TR ZRECFM,=X'8040C0C0' Change to F / V / U
POP USING
SPACE 1
* Lots of code tests DCBRECFM twice, to distinguish among F, V, and
* U formats. We set the index byte to 0,4,8 to allow a single test
* with a three-way branch.
DONEOPEN LR R7,R10 Return DCB/file handle address
LA R0,8
TM ZRECFM,DCBRECU Undefined ?
BO SETINDEX Yes
BM GETINDFV No
TM ZRECFM,DCBRECTO RECFM=D
BZ SETINDEX No; treat as U
B SETINDVD
GETINDFV SR R0,R0 Set for F
TM ZRECFM,DCBRECF Fixed ?
BNZ SETINDEX Yes
SETINDVD LA R0,4 Preset for V
SETINDEX STC R0,RECFMIX Save for the duration
SRL R0,2 Convert to caller's code
L R5,PARM3 POINT TO RECFM
ST R0,0(,R5) Pass either RECFM F or V to caller
L R1,LRECL Load RECFM F or V max. record length
ST R1,0(,R8) Return record length back to caller
L R5,PARM5 POINT TO BLKSIZE
L R0,BLKSIZE Load RECFM U maximum record length
ST R0,0(,R5) Pass new BLKSIZE
L R5,PARM2 POINT TO MODE
MVC 3(1,R5),IOMFLAGS Pass (updated) file mode back
CLI DEVINFO+2,UCB3UREC
BNE NOTUNREC Not unit-record
OI 3(R5),IOFUREC flag unit-record
NOTUNREC DS 0H
*
* Finished with R5 now
*
RETURNOP FUNEXIT RC=(R7) Return to caller
*
* This is not executed directly, but copied into 24-bit storage
ENDFILE LA R6,1 Indicate @@AREAD reached end-of-file
LNR R6,R6 Make negative
BR R14 Return to instruction after the GET
EOFRLEN EQU *-ENDFILE
*
LTORG ,
SPACE 1
BSAMDCB DCB MACRF=(RP,WP),DSORG=PS,DDNAME=BSAMDCB, input and output *
EXLST=1-1 JFCB and DCB exits added later
BSAMDCBN EQU *-BSAMDCB
READDUM READ NONE, Read record Data Event Control Block *
SF, Read record Sequential Forward *
, (R10), Read record DCB address *
, (R4), Read record input buffer *
, (R5), Read BLKSIZE or 256 for PDS.Directory*
MF=L List type MACRO
READLEN EQU *-READDUM
BSAMDCBL EQU *-BSAMDCB
SPACE 1
EXCPDCB DCB DDNAME=EXCPDCB,MACRF=E,DSORG=PS,REPOS=Y,BLKSIZE=0, *
DEVD=TA,EXLST=1-1,RECFM=U
DC 8XL4'0' CLEAR UNUSED SPACE
ORG EXCPDCB+84 LEAVE ROOM FOR DCBLRECL
DC F'0' VOLUME COUNT
PATCCW CCW 1,2-2,X'40',3-3
ORG ,
EXCPDCBL EQU *-EXCPDCB PATTERN TO MOVE
SPACE 1
TERMDCB PUTLINE MF=L PATTERN FOR TERMINAL I/O
TERMDCBL EQU *-TERMDCB SIZE OF IOPL
SPACE 1
F65536 DC F'65536' Maximum VBS record GETMAIN length
*
* QSAMDCB changes depending on whether we are in LOCATE mode or
* MOVE mode
QSAMDCB DCB MACRF=P&OUTM.M,DSORG=PS,DDNAME=QSAMDCB
QSAMDCBL EQU *-QSAMDCB
*
*
* CAMDUM CAMLST SEARCH,DSNAME,VOLSER,DSCB+44
CAMDUM CAMLST SEARCH,*-*,*-*,*-*
CAMLEN EQU *-CAMDUM Length of CAMLST Template
POP USING
SPACE 1
*---------------------------------------------------------------------*
* Expand OPEN options for reference
*---------------------------------------------------------------------*
ADHOC DSECT ,
OPENREF OPEN (BSAMDCB,INPUT),MF=L QSAM, BSAM, any DEVTYPE
OPEN (BSAMDCB,OUTPUT),MF=L QSAM, BSAM, any DEVTYPE
OPEN (BSAMDCB,UPDAT),MF=L QSAM, BSAM, DASD
OPEN (BSAMDCB,EXTEND),MF=L QSAM, BSAM, DASD, TAPE
OPEN (BSAMDCB,INOUT),MF=L BSAM, DASD, TAPE
OPEN (BSAMDCB,OUTINX),MF=L BSAM, DASD, TAPE
OPEN (BSAMDCB,OUTIN),MF=L BSAM, DASD, TAPE
SPACE 1
PARMSECT DSECT , MAP CALL PARM
PARM1 DS A FIRST PARM
PARM2 DS A NEXT PARM
PARM3 DS A NEXT PARM
PARM4 DS A NEXT PARM
PARM5 DS A NEXT PARM
PARM6 DS A NEXT PARM
PARM7 DS A NEXT PARM
PARM8 DS A NEXT PARM
CSECT ,
SPACE 1
ORG CAMDUM+4 Don't need rest
SPACE 2
***********************************************************************
* *
* OPEN DCB EXIT - if RECFM, LRECL, BLKSIZE preset, no change *
* unless forced by device (e.g., unit record *
* not blocked) *
* for PDS directory read, F, 256, 256 are preset. *
* a) device is unit record - default U, device size, device size *
* b) all others - default to values passed to AOPEN *
* *
* For FB, if LRECL > BLKSIZE, make LRECL=BLKSIZE *
* For VB, if LRECL+3 > BLKSIZE, set spanned *
* *
* *
* So, what this means is that if the DCBLRECL etc fields are set *
* already by MVS (due to existing file, JCL statement etc), *
* then these aren't changed. However, if they're not present, *
* then start using the "LRECL" etc previously set up by C caller. *
* *
***********************************************************************
PUSH USING
DROP ,
USING OCDCBEX,R15
USING IHADCB,R1 DECLARE OUR DCB WORK SPACE
OCDCBEX LR R11,R1 SAVE DCB ADDRESS AND OPEN FLAGS
N R1,=X'00FFFFFF' NO 0C4 ON DCB ACCESS IF AM31
TM IOPFLAGS,IOFDCBEX Been here before ?
BZ OCDCBX1
OI IOPFLAGS,IOFCONCT Set unlike concatenation
OI DCBOFLGS,DCBOFPPC Keep them coming
OCDCBX1 OI IOPFLAGS,IOFDCBEX Show exit entered
SR R2,R2 FOR POSSIBLE DIVIDE (FB)
SR R3,R3
ICM R3,3,DCBBLKSI GET CURRENT BLOCK SIZE
SR R4,R4 FOR POSSIBLE LRECL=X
ICM R4,3,DCBLRECL GET CURRENT RECORD LENGTH
NI FILEMODE,3 MASK FILE MODE
MVC ZRECFM,FILEMODE GET OPTION BITS
TR ZRECFM,=X'90,50,C0,C0' 0-FB 1-VB 2-U
TM DCBRECFM,DCBRECLA ANY RECORD FORMAT SPECIFIED?
BNZ OCDCBFH YES
CLI DEVINFO+2,UCB3UREC UNIT RECORD?
BNE OCDCBFM NO; USE OVERRIDE
OCDCBFU CLI FILEMODE,0 DID USER REQUEST FB?
BE OCDCBFM YES; USE IT
OI DCBRECFM,DCBRECU SET U FOR READER/PUNCH/PRINTER
B OCDCBFH
OCDCBFM MVC DCBRECFM,ZRECFM
OCDCBFH LTR R4,R4
BNZ OCDCBLH HAVE A RECORD LENGTH
L R4,DEVINFO+4 SET DEVICE SIZE FOR UNIT RECORD
CLI DEVINFO+2,UCB3UREC UNIT RECORD?
BE OCDCBLH YES; USE IT
* REQUIRES CALLER TO SET LRECL=BLKSIZE FOR RECFM=U DEFAULT
ICM R4,15,LRECL SET LRECL=PREFERRED BLOCK SIZE
BNZ *+8
L R4,DEVINFO+4 ELSE USE DEVICE MAX
IC R5,DCBRECFM GET RECFM
N R5,=X'000000C0' RETAIN ONLY D,F,U,V
SRL R5,6 CHANGE TO 0-D 1-V 2-F 3-U
MH R5,=H'3' PREPARE INDEX
SR R6,R6
IC R6,FILEMODE GET USER'S VALUE
AR R5,R6 DCB VS. DFLT ARRAY
* DCB RECFM: --D--- --V--- --F--- --U---
* FILE MODE: F V U F V U F V U F V U
LA R6,=AL1(4,0,-4,4,0,-4,0,-4,0,0,-4,0) LRECL ADJUST
AR R6,R5 POINT TO ENTRY
ICM R5,8,0(R6) LOAD IT
SRA R5,24 SHIFT WITH SIGN EXTENSION
AR R4,R5 NEW LRECL
SPACE 1
* NOW CHECK BLOCK SIZE
OCDCBLH LTR R3,R3 ANY ?
BNZ *+8 YES
ICM R3,15,BLKSIZE SET OUR PREFERRED SIZE
BNZ *+8 OK
L R3,DEVINFO+4 SET NON-ZERO
C R3,DEVINFO+4 LEGAL ?
BNH *+8
L R3,DEVINFO+4 NO; SHORTEN
TM DCBRECFM,DCBRECU U?
BO OCDCBBU YES
TM DCBRECFM,DCBRECF FIXED ?
BZ OCDCBBV NO; CHECK VAR
DR R2,R4
CH R3,=H'1' DID IT FIT ?
BE OCDCBBF BARELY
BH OCDCBBB ELSE LEAVE BLOCKED
LA R3,1 SET ONE RECORD MINIMUM
OCDCBBF NI DCBRECFM,255-DCBRECBR BLOCKING NOT NEEDED
OCDCBBB MR R2,R4 BLOCK SIZE NOW MULTIPLE OF LRECL
B OCDCBXX AND GET OUT
* VARIABLE
OCDCBBV LA R5,4(,R4) LRECL+4
CR R5,R3 WILL IT FIT ?
BNH *+8 YES
OI DCBRECFM,DCBRECSB SET SPANNED
B OCDCBXX AND EXIT
* UNDEFINED
OCDCBBU LR R4,R3 FOR NEATNESS, SET LRECL = BLOCK SIZE
* EXEUNT (Save DCB options for EXCP compatibility in main code)
OCDCBXX STH R3,DCBBLKSI UPDATE POSSIBLY CHANGED BLOCK SIZE
STH R4,DCBLRECL AND RECORD LENGTH
ST R3,BLKSIZE UPDATE POSSIBLY CHANGED BLOCK SIZE
ST R4,LRECL AND RECORD LENGTH
MVC ZRECFM,DCBRECFM DITTO
AIF ('&SYS' EQ 'S370').NOOPSW
BSM R0,R14
AGO .OPNRET
.NOOPSW ANOP ,
BR R14 RETURN TO OPEN
.OPNRET ANOP ,
POP USING
SPACE 2
*
AIF ('&SYS' EQ 'S370').NODOP24
***********************************************************************
* *
* OPEN DCB EXIT - 24 bit stub *
* This code is not directly executed. It is copied below the line *
* It is only needed for AMODE 31 programs (both S380 and S390 *
* execute in this mode). *
* *
***********************************************************************
PUSH USING
DROP ,
USING DOPEX24,R15
*
* This next line works because when we are actually executing,
* we are executing inside that DSECT, so the address we want
* follows the code. Also, it has already had the high bit set,
* so it will switch to 31-bit mode.
*
DOPEX24 L R15,DOPE31-DOPE24(,R15) Load 31-bit routine address
*
* The following works because while the AMODE is saved in R14, the
* rest of R14 isn't disturbed, so it is all set for a BSM to R14
*
BSM R14,R15 Switch to 31-bit mode
DOPELEN EQU *-DOPEX24
POP USING
.NODOP24 ANOP ,
*
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@aopen.o
View File

81
src/crent370/asm/@@apoint.asm
View File

@ -1,81 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* APOINT - Restore the position in the data set (BSAM/BPAM only) *
* Note that this does not fail; it just bombs on the *
* next read or write if incorrect. *
* *
***********************************************************************
@@APOINT FUNHEAD IO=YES,AM=YES,SAVE=SAVEADCB,US=NO NOTE position
L R3,4(,R1) R3 points to the TTR value
L R3,0(,R3) Get the TTR
ST R3,ZWORK Save below the line
FIXWRITE ,
GO24 , For old code
TM IOMFLAGS,IOFEXCP EXCP mode ?
BZ POINBSAM No
L R4,DCBBLKCT Get current position
SR R4,R3 Get new position's increment
BZ POINCOM
BM POINHEAD
POINBACK MVI TAPECCW,X'27' Backspace
B POINECOM
POINHEAD MVI TAPECCW,X'37' Forward space
POINECOM LA R0,1
STH R0,TAPECCW+6
LPR R4,R4
POINELUP EXCP TAPEIOB
WAIT ECB=TAPEECB
BCT R4,POINELUP
ST R3,DCBBLKCT
B POINCOM
SPACE 1
POINBSAM POINT (R10),ZWORK Request repositioning
POINCOM AMUSE ,
NI IOPFLAGS,255-IOFLEOF Valid POINT resets EOF
XC KEPTREC(8),KEPTREC Also clear record data
FUNEXIT RC=0
*
LTORG , In case someone adds literals
*
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@apoint.o
View File

331
src/crent370/asm/@@aread.asm
View File

@ -1,331 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* AREAD - Read from an open data set *
* *
***********************************************************************
@@AREAD FUNHEAD IO=YES,AM=YES,SAVE=SAVEADCB,US=NO READ / GET
L R3,4(,R1) R3 points to where to store record pointer
L R4,8(,R1) R4 points to where to store record length
SR R0,R0
ST R0,0(,R3) Return null in case of EOF
ST R0,0(,R4) Return null in case of EOF
FIXWRITE , For OUTIN request
L R6,=F'-1' Prepare for EOF signal
TM IOPFLAGS,IOFKEPT Saved record ?
BZ READQEOF No; check for EOF
LM R8,R9,KEPTREC Get prior address & length
ST R8,0(,R3) Set address
ST R9,0(,R4) and length
XC KEPTREC(8),KEPTREC Reset record info
NI IOPFLAGS,IOFKEPT Reset flag
SR R6,R6 No EOF
B READEXIT
SPACE 1
READQEOF TM IOPFLAGS,IOFLEOF Prior EOF ?
BNZ READEXIT Yes; don't abend
TM IOMFLAGS,IOFTERM GETLIN request?
BNZ TGETREAD Yes
* Return here for end-of-block or unlike concatenation
*
REREAD SLR R6,R6 Clear default end-of-file indicator
ICM R8,B'1111',BUFFCURR Load address of next record
BNZ DEBLOCK Block in memory, go de-block it
L R8,BUFFADDR Load address of input buffer
L R9,BLKSIZE Load block size to read
CLI RECFMIX,4 RECFM=Vxx ?
BE READ No, deblock
LA R8,4(,R8) Room for fake RDW
READ GO24 , For old code
TM IOMFLAGS,IOFEXCP EXCP mode?
BZ READBSAM No, use BSAM
*---------------------------------------------------------------------*
* EXCP read
*---------------------------------------------------------------------*
READEXCP STCM R8,7,TAPECCW+1 Read buffer
STH R9,TAPECCW+6 max length
MVI TAPECCW,2 READ
MVI TAPECCW+4,X'20' SILI bit
EXCP TAPEIOB Read
WAIT ECB=TAPEECB wait for completion
TM TAPEECB,X'7F' Good ?
BO EXRDOK Yes; calculate input length
CLI TAPEECB,X'41' Tape Mark read ?
BNE EXRDBAD NO
CLM R9,3,IOBCSW+5-IOBSTDRD+TAPEIOB All unread?
BNE EXRDBAD NO
L R1,DCBBLKCT
BCTR R1,0
ST R1,DCBBLKCT allow for tape mark
OI DCBOFLGS,X'04' Set tape mark found
L R0,ZXCPVOLS Get current volume count
SH R0,=H'1' Just processed one
ST R0,ZXCPVOLS
BNP READEOD None left - take End File
EOV TAPEDCB switch volumes
B READEXCP and restart
SPACE 1
EXRDBAD ABEND 001,DUMP bad way to show error?
SPACE 1
EXRDOK SR R0,R0
ICM R0,3,IOBCSW+5-IOBSTDRD+TAPEIOB
SR R9,R0 LENGTH READ
BNP BADBLOCK NONE ?
AMUSE , Restore caller's mode
LTR R6,R6 See if end of input data set
BM READEOD Is end, go return to caller
B POSTREAD Go to common code
SPACE 1
*---------------------------------------------------------------------*
* BSAM read
*---------------------------------------------------------------------*
READBSAM SR R6,R6 Reset EOF flag
GO24 , Get low
READ DECB, Read record Data Event Control Block C
SF, Read record Sequential Forward C
(R10), Read record DCB address C
(R8), Read record input buffer C
(R9), Read BLKSIZE or 256 for PDS.DirectoryC
MF=E Execute a MF=L MACRO
* If EOF, R6 will be set to F'-1'
CHECK DECB Wait for READ to complete
TM IOPFLAGS,IOFCONCT Did we hit concatenation?
BZ READUSAM No; restore user's AM
NI IOPFLAGS,255-IOFCONCT Reset for next time
ICM R6,8,DCBRECFM
SRL R6,24+2 Isolate top two bits
STC R6,RECFMIX Store
TR RECFMIX,=X'01010002' Filemode D, V, F, U
MVC LRECL+2(2),DCBLRECL Also return record length
MVC ZRECFM,DCBRECFM and format
B READBSAM Reissue the READ
SPACE 1
READUSAM AMUSE , Restore caller's mode
LTR R6,R6 See if end of input data set
BM READEOD Is end, go return to caller
L R14,DECB+16 DECIOBPT
USING IOBSTDRD,R14 Give assembler IOB base
SLR R1,R1 Clear residual amount work register
ICM R1,B'0011',IOBCSW+5 Load residual count
DROP R14 Don't need IOB address base anymore
SR R9,R1 Provisionally return blocklen
SPACE 1
POSTREAD TM IOMFLAGS,IOFBLOCK Block mode ?
BNZ POSTBLOK Yes; process as such
TM ZRECFM,DCBRECU Also exit for U
BNO POSTREED
POSTBLOK ST R8,0(,R3) Return address to user
ST R9,0(,R4) Return length to user
STM R8,R9,KEPTREC Remember record info
XC BUFFCURR,BUFFCURR Show READ required next call
B READEXIT
POSTREED CLI RECFMIX,4 See if RECFM=V
BNE EXRDNOTV Is RECFM=U or F, so not RECFM=V
ICM R9,3,0(R8) Get presumed block length
C R9,BLKSIZE Valid?
BH BADBLOCK No
ICM R0,3,2(R8) Garbage in BDW?
BNZ BADBLOCK Yes; fail
B EXRDCOM
EXRDNOTV LA R0,4(,R9) Fake length
SH R8,=H'4' Space to fake RDW
STH R0,0(0,R8) Fake RDW
LA R9,4(,R9) Up for fake RDW (F/U)
EXRDCOM LA R8,4(,R8) Bump buffer address past BDW
SH R9,=H'4' and adjust length to match
BNP BADBLOCK Oops
ST R8,BUFFCURR Indicate data available
ST R8,0(,R3) Return address to user
ST R9,0(,R4) Return length to user
STM R8,R9,KEPTREC Remember record info
LA R7,0(R9,R8) End address + 1
ST R7,BUFFEND Save end
SPACE 1
TM IOMFLAGS,IOFBLOCK Block mode?
BNZ READEXIT Yes; exit
TM ZRECFM,DCBRECU Also exit for U
BO READEXIT
*NEXT* B DEBLOCK Else deblock
SPACE 1
* R8 has address of current record
DEBLOCK CLI RECFMIX,4 Is data set RECFM=U
BL DEBLOCKF Is RECFM=Fx, go deblock it
*
* Must be RECFM=V, VB, VBS, VS, VA, VM, VBA, VBM, VSA, VSM, VBSA, VBSM
* VBS SDW ( Segment Descriptor Word ):
* REC+0 length 2 is segment length
* REC+2 0 is record not segmented
* REC+2 1 is first segment of record
* REC+2 2 is last seqment of record
* REC+2 3 is one of the middle segments of a record
* R5 has address of current record
DEBLOCKV CLI 0(R8),X'80' LOGICAL END OF BLOCK ?
BE REREAD YES; DONE WITH THIS BLOCK
LH R9,0(,R8) GET LENGTH FROM RDW
CH R9,=H'4' AT LEAST MINIMUM ?
BL BADBLOCK NO; BAD RECORD OR BAD BLOCK
C R9,LRECL VALID LENGTH ?
BH BADBLOCK NO
LA R7,0(R9,R8) SET ADDRESS OF LAST BYTE +1
C R7,BUFFEND WILL IT FIT INTO BUFFER ?
BL DEBVCURR LOW - LEAVE IT
BH BADBLOCK NO; FAIL
SR R7,R7 PRESET FOR BLOCK DONE
DEBVCURR ST R7,BUFFCURR for recursion
TM 3(R8),X'FF' CLEAN RDW ?
BNZ BADBLOCK
TM IOPFLAGS,IOFLSDW WAS PREVIOUS RECORD DONE ?
BO DEBVAPND NO
LH R0,0(,R8) Provisional length if simple
ST R0,0(,R4) Return length
ST R0,KEPTREC+4 Remember record info
CLI 2(R8),1 What is this?
BL SETCURR Simple record
BH BADBLOCK Not=1; have a sequence error
OI IOPFLAGS,IOFLSDW Starting a new segment
L R2,VBSADDR Get start of buffer
MVC 0(4,R2),=X'00040000' Preset null record
B DEBVMOVE And move this
DEBVAPND CLI 2(R8),3 IS THIS A MIDDLE SEGMENT ?
BE DEBVMOVE YES, PUT IT OUT
CLI 2(R8),2 IS THIS THE LAST SEGMENT ?
BNE BADBLOCK No; bad segment sequence
NI IOPFLAGS,255-IOFLSDW INDICATE RECORD COMPLETE
DEBVMOVE L R2,VBSADDR Get segment assembly area
SR R1,R1 Never trust anyone
ICM R1,3,0(R8) Length of addition
SH R1,=H'4' Data length
LA R0,4(,R8) Skip SDW
SR R15,R15
ICM R15,3,0(R2) Get amount used so far
LA R14,0(R15,R2) Address for next segment
LA R8,0(R1,R15) New length
STH R8,0(,R2) Update RDW
A R8,VBSADDR New end address
C R8,VBSEND Will it fit ?
BH BADBLOCK
LR R15,R1 Move all
MVCL R14,R0 Append segment
TM IOPFLAGS,IOFLSDW Did last segment?
BNZ REREAD No; get next one
L R8,VBSADDR Give user the assembled record
SR R0,R0
ICM R0,3,0(R8) Provisional length if simple
ST R0,0(,R4) Return length
ST R0,KEPTREC+4 Remember record info
B SETCURR Done
SPACE 2
* If RECFM=FB, bump address by lrecl
* R8 has address of current record
DEBLOCKF L R7,LRECL Load RECFM=F DCB LRECL
ST R7,0(,R4) Return length
ST R7,KEPTREC+4 Remember record info
AR R7,R8 Find the next record address
* If address=BUFFEND, zero BUFFCURR
SETCURR CL R7,BUFFEND Is it off end of block?
BL SETCURS Is not off, go store it
SR R7,R7 Clear the next record address
SETCURS ST R7,BUFFCURR Store the next record address
ST R8,0(,R3) Store record address for caller
ST R8,KEPTREC Remember record info
B READEXIT
SPACE 1
TGETREAD L R6,ZIOECT RESTORE ECT ADDRESS
L R7,ZIOUPT RESTORE UPT ADDRESS
MVI ZGETLINE+2,X'80' EXPECTED FLAG
GO24
GETLINE PARM=ZGETLINE,ECT=(R6),UPT=(R7),ECB=ZIOECB, *
MF=(E,ZIOPL)
GO31
LR R6,R15 COPY RETURN CODE
CH R6,=H'16' HIT BARRIER ?
BE READEOD2 YES; EOF, BUT ALLOW READS
CH R6,=H'8' SERIOUS ?
BNL READEXNG ATTENTION INTERRUPT OR WORSE
L R1,ZGETLINE+4 GET INPUT LINE
*---------------------------------------------------------------------*
* MVS 3.8 undocumented behavior: at end of input in batch execution,
* returns text of 'END' instead of return code 16. Needs DOC fix
*---------------------------------------------------------------------*
CLC =X'00070000C5D5C4',0(R1) Undocumented EOF?
BNE TGETNEOF
XC KEPTREC(8),KEPTREC Clear saved record info
LA R6,1
LNR R6,R6 Signal EOF
B TGETFREE FREE BUFFER AND QUIT
TGETNEOF L R6,BUFFADDR GET INPUT BUFFER
LR R8,R1 INPUT LINE W/RDW
LH R9,0(,R1) GET LENGTH
LR R7,R9 FOR V, IN LEN = OUT LEN
CLI RECFMIX,4 RECFM=V ?
BE TGETHAVE YES
BL TGETSKPF
SH R7,=H'4' ALLOW FOR RDW
B TGETSKPV
TGETSKPF L R7,LRECL FULL SIZE IF F
TGETSKPV LA R8,4(,R8) SKIP RDW
SH R9,=H'4' LENGTH SANS RDW
TGETHAVE ST R6,0(,R3) RETURN ADDRESS
ST R7,0(,R4) AND LENGTH
STM R6,R7,KEPTREC Remember record info
ICM R9,8,=C' ' BLANK FILL
MVCL R6,R8 PRESERVE IT FOR USER
SR R6,R6 NO EOF
TGETFREE LH R0,0(,R1) GET LENGTH
ICM R0,8,=AL1(1) SUBPOOL 1
FREEMAIN R,LV=(0),A=(1) FREE SYSTEM BUFFER
B READEXIT TAKE NORMAL EXIT
SPACE 1
READEOD OI IOPFLAGS,IOFLEOF Remember that we hit EOF
READEOD2 XC KEPTREC(8),KEPTREC Clear saved record info
LA R6,1
READEXNG LNR R6,R6 Signal EOF
READEXIT FUNEXIT RC=(R6) =1-EOF Return to caller
*
BADBLOCK WTO 'MVSSUPA - @@AREAD - problem processing RECFM=V(bs) file*
',ROUTCDE=11 Send to programmer and listing
ABEND 1234,DUMP Abend U1234 and allow a dump
*
LTORG , In case someone adds literals
*
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@aread.o
View File

119
src/crent370/asm/@@atrout.asm
View File

@ -1,119 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
*---------------------------------------------------------------------*
* Physical Write - called by @@ACLOSE, switch from output to input
* mode, and whenever output buffer is full or needs to be emptied.
* Works for EXCP and BSAM. Special processing for UPDAT mode
*---------------------------------------------------------------------*
ENTRY @@ATROUT
@@ATROUT B *+14-@@ATROUT(,R15) SKIP LABEL
DC AL1(9),CL(9)'@@ATROUT' EXPAND LABEL
AIF ('&SYS' NE 'S380').NOTRUBS
BSM R14,R0 PRESERVE AMODE
.NOTRUBS STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
LR R12,R15
USING @@ATROUT,R12
LA R15,ZIOSAVE2-ZDCBAREA(,R10)
ST R15,8(,R13)
ST R13,4(,R15)
LR R13,R15
USING IHADCB,R10 COMMON I/O AREA SET BY CALLER
TM IOPFLAGS,IOFLDATA PENDING WRITE ?
BZ TRUNCOEX NO; JUST RETURN
NI IOPFLAGS,255-IOFLDATA Reset it
GO24 , GET LOW
LM R4,R5,BUFFADDR START/NEXT ADDRESS
CLI RECFMIX,4 RECFM=V?
BNE TRUNLEN5
SR R5,R5
ICM R5,3,0(R4) USE BDW LENGTH
CH R5,=H'8' EMPTY ?
BNH TRUNPOST YES; IGNORE REQUEST
B TRUNTMOD CHECK OUTPUT TYPE
TRUNLEN5 SR R5,R4 CONVERT TO LENGTH
BNP TRUNCOEX NOTHING TO DO
TRUNTMOD DS 0H
TM IOMFLAGS,IOFEXCP EXCP mode ?
BNZ EXCPWRIT Yes
CLI OPENCLOS,X'84' Update mode?
BE TRUNSHRT Yes; just rewrite as is
CLI RECFMIX,4 RECFM=F ?
BNL *+8 No; leave it alone
STH R5,DCBBLKSI Why do I need this?
WRITE DECB,SF,(R10),(R4),(R5),MF=E Write block
B TRUNCHK
TRUNSHRT WRITE DECB,SF,MF=E Rewrite block from READ
TRUNCHK CHECK DECB
B TRUNPOST Clean up
SPACE 1
EXCPWRIT STH R5,TAPECCW+6
STCM R4,7,TAPECCW+1 WRITE FROM TEXT
NI DCBIFLGS,255-DCBIFEC ENABLE ERP
OI DCBIFLGS,X'40' SUPPRESS DDR
STCM R5,12,IOBSENS0-IOBSTDRD+TAPEIOB CLEAR SENSE
OI DCBOFLGS-IHADCB+TAPEDCB,DCBOFLWR SHOW WRITE
XC TAPEECB,TAPEECB
EXCP TAPEIOB
WAIT ECB=TAPEECB
TM TAPEECB,X'7F' GOOD COMPLETION?
BO TRUNPOST
*NEXT* BNO EXWRN7F NO
SPACE 1
EXWRN7F TM IOBUSTAT-IOBSTDRD+TAPEIOB,IOBUSB7 END OF TAPE?
BNZ EXWREND YES; SWITCH TAPES
CLC =X'1020',IOBSENS0-IOBSTDRD+TAPEIOB EXCEEDED AWS/HET ?
BNE EXWRB001
EXWREND L R15,DCBBLKCT
SH R15,=H'1'
ST R15,DCBBLKCT ALLOW FOR EOF 'RECORD'
EOV TAPEDCB TRY TO RECOVER
B EXCPWRIT
SPACE 1
EXWRB001 LA R9,TAPEIOB GET IOB FOR QUICK REFERENCE
ABEND 001,DUMP
SPACE 1
TRUNPOST XC BUFFCURR,BUFFCURR CLEAR
CLI RECFMIX,4 RECFM=V
BL TRUNCOEX F - JUST EXIT
LA R4,4 BUILD BDW
L R3,BUFFADDR GET BUFFER
STH R4,0(,R3) UPDATE
TRUNCOEX L R13,4(,R13)
LM R14,R12,12(R13) Reload all
QBSM 0,R14 Return in caller's mode
LTORG ,
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@atrout.o
View File

189
src/crent370/asm/@@awrite.asm
View File

@ -1,189 +0,0 @@
MACRO ,
&NM FIXWRITE ,
&NM L R15,=V(@@ATROUT)
BALR R14,R15 TRUNCATE CURRENT WRITE BLOCK
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
* YREGS
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* AWRITE - Write to an open data set *
* *
***********************************************************************
@@AWRITE FUNHEAD IO=YES,AM=YES,SAVE=SAVEADCB,US=NO WRITE / PUT
LR R11,R1 SAVE PARM LIST
WRITMORE NI IOPFLAGS,255-IOFCURSE RESET RECURSION
L R4,4(,R11) R4 points to the record address
L R4,0(,R4) Get record address
L R5,8(,R11) R5 points to length of data to write
L R5,0(,R5) Length of data to write
TM IOMFLAGS,IOFTERM PUTLIN request?
BNZ TPUTWRIT Yes
*
TM IOMFLAGS,IOFBLOCK Block mode?
BNZ WRITBLK Yes
CLI OPENCLOS,X'84' Running in update mode ?
BNE WRITENEW No
LM R2,R3,KEPTREC Get last record returned
LTR R3,R3 Any?
BNP WRITEEX No; ignore (or abend?)
CLI RECFMIX,4 RECFM=V...
BNE WRITUPMV NO
LA R0,4 ADJUST FOR RDW
AR R2,R0 KEEP OLD RDW
SR R3,R0 ADJUST REPLACE LENGTH
AR R4,R0 SKIP OVER USER'S RDW
SR R5,R0 ADJUST LENGTH
WRITUPMV MVCL R2,R4 REPLACE DATA IN BUFFER
OI IOPFLAGS,IOFLDATA SHOW DATA IN BUFFER
B WRITEEX REWRITE ON NEXT READ OR CLOSE
SPACE 1
WRITENEW CLI RECFMIX,4 V-FORMAT ?
BH WRITBLK U - WRITE BLOCK AS IS
BL WRITEFIX F - ADD RECORD TO BLOCK
CH R5,0(,R4) RDW LENGTH = REQUESTED LEN?
BNE WRITEBAD NO; FAIL
L R8,BUFFADDR GET BUFFER
ICM R6,15,BUFFCURR Get next record address
BNZ WRITEVAT
LA R0,4
STH R0,0(,R8) BUILD BDW
LA R6,4(,R8) SET TO FIRST RECORD POSITION
WRITEVAT L R9,BUFFEND GET BUFFER END
SR R9,R6 LESS CURRENT POSITION
TM ZRECFM,DCBRECSB SPANNED?
BZ WRITEVAR NO; ROUTINE VARIABLE WRITE
LA R1,4(,R5) GET RECORD + BDW LENGTH
C R1,LRECL VALID SIZE?
BH WRITEBAD NO; TAKE A DIVE
TM IOPFLAGS,IOFLSDW CONTINUATION ?
BNZ WRITEVAW YES; DO HERE
CR R5,R9 WILL IT FIT AS IS?
BNH WRITEVAS YES; DON'T NEED TO SPLIT
WRITEVAW CH R9,=H'5' AT LEAST FIVE BYTES LEFT ?
BL WRITEVNU NO; WRITE THIS BLOCK; RETRY
LR R3,R6 SAVE START ADDRESS
LR R7,R9 COPY LENGTH
CR R7,R5 ROOM FOR ENTIRE SEGMENT ?
BL *+4+2 NO
LR R7,R5 USE ONLY WHAT'S AVAILABLE
MVCL R6,R4 COPY RDW + DATA
ST R6,BUFFCURR UPDATE NEXT AVAILABLE
SR R6,R8 LESS START
STH R6,0(,R8) UPDATE BDW
STH R9,0(,R3) FIX RDW LENGTH
MVC 2(2,R3),=X'0100' SET FLAGS FOR START SEGMENT
TM IOPFLAGS,IOFLSDW DID START ?
BZ *+4+6 NO; FIRST SEGMENT
MVI 2(R3),3 SHOW MIDDLE SEGMENT
LTR R5,R5 DID WE FINISH THE RECORD ?
BP WRITEWAY NO
MVI 2(R3),2 SHOW LAST SEGMENT
NI IOPFLAGS,255-IOFLSDW-IOFCURSE RCD COMPLETE
OI IOPFLAGS,IOFLDATA SHOW WRITE DATA IN BUFFER
B WRITEEX DONE
WRITEWAY SH R9,=H'4' ALLOW FOR EXTRA RDW
AR R4,R9
SR R5,R9
STM R4,R5,KEPTREC MAKE FAKE PARM LIST
LA R11,KEPTREC-4 SET FOR RECURSION
OI IOPFLAGS,IOFLSDW SHOW RECORD INCOMPLETE
B WRITEVNU GO FOR MORE
SPACE 1
WRITEVAR LA R1,4(,R5) GET RECORD + BDW LENGTH
C R1,BLKSIZE VALID SIZE?
BH WRITEBAD NO; TAKE A DIVE
L R9,BUFFEND GET BUFFER END
SR R9,R6 LESS CURRENT POSITION
CR R5,R9 WILL IT FIT ?
BH WRITEVNU NO; WRITE NOW AND RECURSE
WRITEVAS LR R7,R5 IN LENGTH = MOVE LENGTH
MVCL R6,R4 MOVE USER'S RECORD
ST R6,BUFFCURR UPDATE NEXT AVAILABLE
SR R6,R8 LESS START
STH R6,0(,R8) UPDATE BDW
OI IOPFLAGS,IOFLDATA SHOW WRITE DATA IN BUFFER
TM DCBRECFM,DCBRECBR BLOCKED?
BNZ WRITEEX YES, NORMAL
FIXWRITE , RECFM=V - WRITE IMMEDIATELY
B WRITEEX
SPACE 1
WRITEVNU OI IOPFLAGS,IOFCURSE SET RECURSION REQUEST
B WRITPREP SET ADDRESS/LENGTH TO WRITE
SPACE 1
WRITEBAD ABEND 002,DUMP INVALID REQUEST
SPACE 1
WRITEFIX ICM R6,15,BUFFCURR Get next available record
BNZ WRITEFAP Not first
L R6,BUFFADDR Get buffer start
WRITEFAP L R7,LRECL Record length
ICM R5,8,=C' ' Request blank padding
MVCL R6,R4 Copy record to buffer
ST R6,BUFFCURR Update new record address
OI IOPFLAGS,IOFLDATA SHOW DATA IN BUFFER
C R6,BUFFEND Room for more ?
BL WRITEEX YES; RETURN
WRITPREP L R4,BUFFADDR Start write address
LR R5,R6 Current end of block
SR R5,R4 Current length
*NEXT* B WRITBLK WRITE THE BLOCK
SPACE 1
WRITBLK AR R5,R4 Set start and end of write
STM R4,R5,BUFFADDR Pass to physical writer
OI IOPFLAGS,IOFLDATA SHOW DATA IN BUFFER
FIXWRITE , Write physical block
B WRITEEX AND RETURN
SPACE 1
TPUTWRIT CLI RECFMIX,4 RECFM=V ?
BE TPUTWRIV YES
SH R4,=H'4' BACK UP TO RDW
LA R5,4(,R5) LENGTH WITH RDW
TPUTWRIV STH R5,0(,R4) FILL RDW
STCM R5,12,2(R4) ZERO REST
L R6,ZIOECT RESTORE ECT ADDRESS
L R7,ZIOUPT RESTORE UPT ADDRESS
GO24
PUTLINE PARM=ZPUTLINE,ECT=(R6),UPT=(R7),ECB=ZIOECB, *
OUTPUT=((R4),DATA),TERMPUT=EDIT,MF=(E,ZIOPL)
GO31
SPACE 1
WRITEEX TM IOPFLAGS,IOFCURSE RECURSION REQUESTED?
BNZ WRITMORE
FUNEXIT RC=0
*
LTORG ,
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@awrite.o
View File

268
src/crent370/asm/@@crt0.asm
View File

@ -1,268 +0,0 @@
@@CRT0 TITLE '@ @ C R T 0 *** MVS startup routine for C main pgm'
***********************************************************************
* Original code and concepts provided by: PAUL EDWARDS. *
* Extensive modifications provided by: Mike Rayborn *
* *
* This startup code requires elements from the CLIB datasets. *
* *
* RELEASED TO THE PUBLIC DOMAIN *
***********************************************************************
COPY PDPTOP
PRINT OFF
*
SUBPOOL EQU 0
USING PSA,R0
PRINT ON
COPY CLIBCRT
COPY CLIBPPA CLIB Program Properties Area
CSECT
ENTRY @@CRT0
@@CRT0 DS 0H
SAVE (14,12),,@@CRT0
LA R12,0(,R15)
USING @@CRT0,R12
LR R11,R1
*
WXTRN @@STKLEN
ICM R1,15,=V(@@STKLEN) Get stack length address
BZ USEDFLT No, use default
L R8,0(R1) Yes, load stack size value
C R8,=F'4096' At least 4K?
BNL PLUSPPA Yes, continue
USEDFLT DS 0H
L R8,=A(STACKLEN) Default stack length
PLUSPPA DS 0H
AL R8,=A(L'CLIBPPA+7) Add in our CLIBPPA length
N R8,=X'00FFFFF8' Round to nearest double word
LA R0,SUBPOOL Subpool number
SLL R0,24 Shift into high byte
ALR R0,R8 Plus size of storage we want
GETMAIN R,LV=(0)
XC 0(L'CLIBPPA,R1),0(R1) Clear PPA
ST R13,4(,R1)
ST R1,8(,R13)
LR R6,R1 -> PPA
USING CLIBPPA,R6 Program Properties Area
MVC PPAEYE,=A(PPAEYE$)
ST R8,PPASTKLN Save length of stack area
LA R0,SUBPOOL Subpool number
STC R0,PPASUBPL Save subpool number
*
LA R1,L'CLIBPPA(,R6) -> New Save Area
ST R6,4(,R1)
ST R1,8(,R6)
LR R13,R1
USING STACK,R13 Our Save Area
*
L R2,PSATOLD
USING TCB,R2
SR R15,R15
ICM R15,B'0111',TCBFSAB => TCB first save area
L R0,8(,15) get "next" value from fsa
ST R0,PPASAVE save old "next" value in PPA
ST R6,8(,R15) save PPA as fsa "next" value
*
CRTSETUP DS 0H
LA R0,0
ST R0,DUMMYPTR Unused in C, used by PL/1
LA R0,MAINSTK Next available stack location
ST R0,THEIRSTK => Next available stack (NAB)
*
* Create our CLIBCRT
L R15,=V(@@CRTSET)
BALR R14,R15 Create our CLIBCRT area
L R15,=V(@@GRTSET)
BALR R14,R15 Anchor a CLIBGRT area as CRTGRT
*
* Save R13 in CRTSAVE
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
ST R13,CRTSAVE-CLIBCRT(,R15) Save our save area address
*
L R7,TCBRBP
USING RBBASIC,R7
SLR R8,R8
ICM R8,B'0111',RBCDE1
DROP R7 (RBBASIC)
*
USING CDENTRY,R8
MVC PGMNAME,CDNAME
MVI PGMNAMEN,0
DROP R8 (CDENTRY)
*
L R2,TCBJSCB
USING IEZJSCB,R2
LH R2,JSCBTJID
ST R2,TYPE TSO terminal job identifier
DROP R2 (IEZJSCB)
*
PPASETUP DS 0H
EXTRACT WORKAREA,FIELDS=(TIOT,TSO,PSB),MF=(E,EXTRLIST)
LM R1,R3,WORKAREA R1 R2 R3
ST R1,PPATIOT SAVE POINTER TO TIOT
TM 0(R2),X'80' Is this TSO forground?
BNO PPASET10 No, check TSO background
OI PPAFLAG,PPATSOFG Yes, set TSO flag
*
PPASET10 DS 0H
LTR R3,R3 Do we have PSCB?
BZ PPASET20 No, continue
ST R3,PPAPSCB Yes, save PSCB
OI PPAFLAG,PPATSOBG Yes, set TSO background flag
*
PPASET20 DS 0H
*
ST R11,PGMR1 R11 == R1 on entry to @@CRT0
L R2,0(,R11) A(arguments to program)
LA R2,0(,R2) ... clean address value
ST R2,ARGPTR A(execution parameters)
LA R2,PGMNAME
ST R2,PGMNPTR A(program name)
*
L R1,=A(CTHREAD) A(thread driver routine)
LA R0,=CL8'CTHREAD'
IDENTIFY EPLOC=(0),ENTRY=(1)
*
LA R1,PARMLIST A(parms,program,type)
L R15,=V(@@START)
BALR R14,R15 Should never return
*
* The call to @@START never returns because it will call @@EXIT
* after it calls main().
* But just in case @@START returns here, we'll call @@EXIT which
* eventually calls @@EXITA below.
LA R1,=F'-1'
L R15,=V(@@EXIT)
BR R15 Just in case @@START returns
LTORG
TITLE 'CTHREAD - subtask driver (IDENTIFY entry point)'
ENTRY CTHREAD
CTHREAD DS 0H
SAVE (14,12),,'CTHREAD &SYSDATE &SYSTIME'
LA R12,0(,R15)
USING CTHREAD,R12
*
LA R11,0(,R1)
USING CTHDTASK,R11
*
* Chain stack with callers save area
LA R1,CTHDSTK => stack for function
ST R13,4(,R1) ... chain stack areas
ST R1,8(,R13) ... chain stack areas
LR R13,R1 new stack
USING STK,R13
*
* Save thread handle in stack
ST R11,STKCTHD A(CTHDTASK)
*
* Set next available byte in stack
LA R0,STKNAB next available byte in stack
ST R0,STKSVNAB next available byte in stack
*
* Allocate CLIBCRT area in PPA
L R15,=V(@@CRTSET)
BALR R14,R15 Create CLIBCRT in PPA
*
* Save R13 in CRTSAVE
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
ST R13,CRTSAVE-CLIBCRT(,R15) Save our save area address
*
* Call thread function
L R15,CTHDFUNC get function address from plist
LA R1,CTHDARG1 => parameters for function
BALR R14,R15 call function
ST R15,CTHDRC save return code from function
*
* Call thread exit
LA R1,CTHDRC => return code
L R15,=A(@@CTEXIT)
BR R15 exit thread environment
LTORG
TITLE '@@CTEXIT - exit C thread environment'
ENTRY @@CTEXIT
@@CTEXIT DS 0H
LA R12,0(,R15)
USING @@CTEXIT,R12
L R9,0(R1) Get @@EXITB(rc) value
*
* Get save area address from CLIBCRT area
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
L R13,CRTSAVE-CLIBCRT(,R15) Restore thread stack
USING STK,R13
*
* Get thread task control block
L R11,STKCTHD => thread task control block
USING CTHDTASK,R11
*
* Get return code passed to us
* L R9,0(R1) Get @@EXITB(rc) value
ST R9,CTHDRC save as return code
*
* Do thread cleanup
WXTRN @@CTCLUP
ICM R15,15,=V(@@CTCLUP) Get thread level cleanup
BZ THRDDONE
BALR R14,R15 Call __ctclup() routine
*
* Deallocate CLIBCRT area
THRDDONE DS 0H
L R15,=V(@@CRTRES)
BALR R14,R15 release CLIBCRT area from PPA
*
* Get callers save area
L R13,STKSV+4 switch back to callers stack
LR R15,R9 restore return code
RETURN RETURN (14,12),RC=(15)
* Note:
* The task level area CTHDTASK persists until the main thread or
* thread manager code calls @@CTDEL() to delete the thread.
*
LTORG ,
TITLE 'Dummy Sections'
* Stack for C thread
STK DSECT
STKSV DS 18F 00 (0) callers registers go here
STKSVLWS DS A 48 (72) PL/I Language Work Space N/A
STKSVNAB DS A 4C (76) next available byte -------+
STKCTHD DS A 50 (80) A(CTHDTASK) |
STKAVAIL DS F 54 (84) unused/available |
STKNAB DS 0D 58 stack next available byte <-----+
*
* C thread parameter list
CTHDTASK DSECT
CTHDEYE DS CL8 00 eye catcher for dumps
CTHDTCB DS F 08 subtask TCB address
CTHDOTCB DS F 0C subtask owner TCB address
CTHDECB DS F 10 posted by MVS when task ends
CTHDRC DS F 14 return code from function
CTHDSSIZ DS F 18 stack size in bytes
CTHDFUNC DS A 1C subtask function address
CTHDARG1 DS A 20 arg1 for subtask function
CTHDARG2 DS A 24 arg2 for subtask function
CTHDSTK DS F 28 start of stack for driver
*
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
STACK DSECT
SAVEAREA DS 18F
DUMMYPTR DS F => PL/I Language Work Space N/A
THEIRSTK DS F => Next Available Byte (NAB)
WORKAREA DS 4F work area
EXTRLIST EXTRACT MF=L EXTRACT PARAMETER LIST
PARMLIST DS 0F Parameter list passed to @@START
ARGPTR DS F A(parms)
PGMNPTR DS F A(program name)
TYPE DS F F'TSO job id'
PGMR1 DS F R1 at entry to program
PGMNAME DS CL8
PGMNAMEN DS C NUL BYTE FOR C
DS 0D
MAINSTK DS 65536F stack for @@START -> main()
MAINLEN EQU *-MAINSTK
STACKLEN EQU *-STACK
END

0
src/crent370/asm/@@crt0.o
View File

271
src/crent370/asm/@@crt1.asm
View File

@ -1,271 +0,0 @@
@@CRT0 TITLE '@ @ C R T 0 *** MVS startup routine for C main pgm'
***********************************************************************
* Original code and concepts provided by: PAUL EDWARDS. *
* Extensive modifications provided by: Mike Rayborn *
* *
* Copy of @@CRT0 without the IDENTIFY for CTHREAD *
* *
* This startup code requires elements from the CLIB datasets. *
* *
* RELEASED TO THE PUBLIC DOMAIN *
***********************************************************************
COPY PDPTOP
PRINT OFF
*
SUBPOOL EQU 0
USING PSA,R0
PRINT ON
COPY CLIBCRT
COPY CLIBPPA CLIB Program Properties Area
CSECT
ENTRY @@CRT0
@@CRT0 DS 0H
SAVE (14,12),,@@CRT0
LA R12,0(,R15)
USING @@CRT0,R12
LR R11,R1
*
WXTRN @@STKLEN
ICM R1,15,=V(@@STKLEN) Get stack length address
BZ USEDFLT No, use default
L R8,0(R1) Yes, load stack size value
C R8,=F'4096' At least 4K?
BNL PLUSPPA Yes, continue
USEDFLT DS 0H
L R8,=A(STACKLEN) Default stack length
PLUSPPA DS 0H
AL R8,=A(L'CLIBPPA+7) Add in our CLIBPPA length
N R8,=X'00FFFFF8' Round to nearest double word
LA R0,SUBPOOL Subpool number
SLL R0,24 Shift into high byte
ALR R0,R8 Plus size of storage we want
GETMAIN R,LV=(0)
*
XC 0(L'CLIBPPA,R1),0(R1) Clear PPA
ST R13,4(,R1)
ST R1,8(,R13)
LR R6,R1 -> PPA
USING CLIBPPA,R6 Program Properties Area
MVC PPAEYE,=A(PPAEYE$)
ST R8,PPASTKLN Save length of stack area
LA R0,SUBPOOL Get subpool number
STC R0,PPASUBPL Save subpool number
*
LA R1,L'CLIBPPA(,R6) -> New Save Area
ST R6,4(,R1)
ST R1,8(,R6)
LR R13,R1
USING STACK,R13 Our Save Area
*
L R2,PSATOLD
USING TCB,R2
SR R15,R15
ICM R15,B'0111',TCBFSAB => TCB first save area
L R0,8(,15) get "next" value from fsa
ST R0,PPASAVE save old "next" value in PPA
ST R6,8(,R15) save PPA as fsa "next" value
*
CRTSETUP DS 0H
LA R0,0
ST R0,DUMMYPTR Unused in C, used by PL/1
LA R0,MAINSTK Next available stack location
ST R0,THEIRSTK => Next available stack (NAB)
*
* Create our CLIBCRT
L R15,=V(@@CRTSET)
BALR R14,R15 Create our CLIBCRT area
L R15,=V(@@GRTSET)
BALR R14,R15 Anchor a CLIBGRT area as CRTGRT
*
* Save R13 in CRTSAVE
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
ST R13,CRTSAVE-CLIBCRT(,R15) Save our save area address
*
L R7,TCBRBP
USING RBBASIC,R7
SLR R8,R8
ICM R8,B'0111',RBCDE1
DROP R7 (RBBASIC)
*
USING CDENTRY,R8
MVC PGMNAME,CDNAME
MVI PGMNAMEN,0
DROP R8 (CDENTRY)
*
L R2,TCBJSCB
USING IEZJSCB,R2
LH R2,JSCBTJID
ST R2,TYPE TSO terminal job identifier
DROP R2 (IEZJSCB)
*
PPASETUP DS 0H
EXTRACT WORKAREA,FIELDS=(TIOT,TSO,PSB),MF=(E,EXTRLIST)
LM R1,R3,WORKAREA R1 R2 R3
ST R1,PPATIOT SAVE POINTER TO TIOT
TM 0(R2),X'80' Is this TSO forground?
BNO PPASET10 No, check TSO background
OI PPAFLAG,PPATSOFG Yes, set TSO flag
*
PPASET10 DS 0H
LTR R3,R3 Do we have PSCB?
BZ PPASET20 No, continue
ST R3,PPAPSCB Yes, save PSCB
OI PPAFLAG,PPATSOBG Yes, set TSO background flag
*
PPASET20 DS 0H
*
ST R11,PGMR1 R11 == R1 on entry to @@CRT0
L R2,0(,R11) A(arguments to program)
LA R2,0(,R2) ... clean address value
ST R2,ARGPTR A(execution parameters)
LA R2,PGMNAME
ST R2,PGMNPTR A(program name)
*
*** L R1,=A(CTHREAD) A(thread driver routine)
*** LA R0,=CL8'CTHREAD'
*** IDENTIFY EPLOC=(0),ENTRY=(1)
*
LA R1,PARMLIST A(parms,program,type)
L R15,=V(@@START)
BALR R14,R15 Should never return
*
* The call to @@START never returns because it will call @@EXIT
* after it calls main().
* But just in case @@START returns here, we'll call @@EXIT which
* eventually calls @@EXITA below.
LA R1,=F'-1'
L R15,=V(@@EXIT)
BR R15 Just in case @@START returns
LTORG
TITLE 'CTHREAD - subtask driver (IDENTIFY entry point)'
ENTRY CTHREAD
CTHREAD DS 0H
SAVE (14,12),,'CTHREAD &SYSDATE &SYSTIME'
LA R12,0(,R15)
USING CTHREAD,R12
*
LA R11,0(,R1)
USING CTHDTASK,R11
*
* Chain stack with callers save area
LA R1,CTHDSTK => stack for function
ST R13,4(,R1) ... chain stack areas
ST R1,8(,R13) ... chain stack areas
LR R13,R1 new stack
USING STK,R13
*
* Save thread handle in stack
ST R11,STKCTHD A(CTHDTASK)
*
* Set next available byte in stack
LA R0,STKNAB next available byte in stack
ST R0,STKSVNAB next available byte in stack
*
* Allocate CLIBCRT area in TCBUSER
L R15,=V(@@CRTSET)
BALR R14,R15 Create CLIBCRT as TCBUSER
*
* Save R13 in CRTSAVE
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
ST R13,CRTSAVE-CLIBCRT(,R15) Save our save area address
*
* Call thread function
L R15,CTHDFUNC get function address from plist
LA R1,CTHDARG1 => parameters for function
BALR R14,R15 call function
ST R15,CTHDRC save return code from function
*
* Call thread exit
LA R1,CTHDRC => return code
L R15,=A(@@CTEXIT)
BR R15 exit thread environment
LTORG
TITLE '@@CTEXIT - exit C thread environment'
ENTRY @@CTEXIT
@@CTEXIT DS 0H
LA R12,0(,R15)
USING @@CTEXIT,R12
*
* Get save area address from CLIBCRT area
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
L R13,CRTSAVE-CLIBCRT(,R15) Restore thread stack
USING STK,R13
*
* Get thread task control block
L R11,STKCTHD => thread task control block
USING CTHDTASK,R11
*
* Get return code passed to us
L R9,0(R1) Get @@EXITB(rc) value
ST R9,CTHDRC save as return code
*
* Do thread cleanup
WXTRN @@CTCLUP
ICM R15,15,=V(@@CTCLUP) Get thread level cleanup
BZ THRDDONE
BALR R14,R15 Call __ctclup() routine
*
* Deallocate CLIBCRT area
THRDDONE DS 0H
L R15,=V(@@CRTRES)
BALR R14,R15 release CLIBCRT area from PPA
*
* Get callers save area
L R13,STKSV+4 switch back to callers stack
LR R15,R9 restore return code
RETURN RETURN (14,12),RC=(15)
* Note:
* The task level area CTHDTASK persists until the main thread or
* thread manager code calls @@CTDEL() to delete the thread.
*
LTORG ,
TITLE 'Dummy Sections'
* Stack for C thread
STK DSECT
STKSV DS 18F 00 (0) callers registers go here
STKSVLWS DS A 48 (72) PL/I Language Work Space N/A
STKSVNAB DS A 4C (76) next available byte -------+
STKCTHD DS A 50 (80) A(CTHDTASK) |
STKAVAIL DS F 54 (84) unused/available |
STKNAB DS 0D 58 stack next available byte <-----+
*
* C thread parameter list
CTHDTASK DSECT
CTHDEYE DS CL8 00 eye catcher for dumps
CTHDTCB DS F 08 subtask TCB address
CTHDOTCB DS F 0C subtask owner TCB address
CTHDECB DS F 10 posted by MVS when task ends
CTHDRC DS F 14 return code from function
CTHDSSIZ DS F 18 stack size in bytes
CTHDFUNC DS A 1C subtask function address
CTHDARG1 DS A 20 arg1 for subtask function
CTHDARG2 DS A 24 arg2 for subtask function
CTHDSTK DS F 28 start of stack for driver
*
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
STACK DSECT
SAVEAREA DS 18F
DUMMYPTR DS F => PL/I Language Work Space N/A
THEIRSTK DS F => Next Available Byte (NAB)
WORKAREA DS 4F work area
EXTRLIST EXTRACT MF=L EXTRACT PARAMETER LIST
PARMLIST DS 0F Parameter list passed to @@START
ARGPTR DS F A(parms)
PGMNPTR DS F A(program name)
TYPE DS F F'TSO job id'
PGMR1 DS F R1 at entry to program
PGMNAME DS CL8
PGMNAMEN DS C NUL BYTE FOR C
DS 0D
MAINSTK DS 65536F stack for @@START -> main()
MAINLEN EQU *-MAINSTK
STACKLEN EQU *-STACK
END

0
src/crent370/asm/@@crt1.o
View File

168
src/crent370/asm/@@crtm.asm
View File

@ -1,168 +0,0 @@
@@CRT0 TITLE '@ @ C R T 0 *** Mini startup routine for C main pgm'
***********************************************************************
* Provided by: Mike Rayborn *
* *
* This startup code create a minimal environment for C programs *
* *
* RELEASED TO THE PUBLIC DOMAIN *
***********************************************************************
COPY PDPTOP
PRINT OFF
*
SUBPOOL EQU 0
USING PSA,R0
PRINT ON
COPY CLIBCRT
COPY CLIBPPA CLIB Program Properties Area
CSECT
ENTRY @@CRT0
@@CRT0 DS 0H
SAVE (14,12),,@@CRT0
LA R12,0(,R15)
USING @@CRT0,R12
LR R10,R0
LR R11,R1
*
WXTRN @@STKLEN
ICM R8,15,=V(@@STKLEN) Get stack length address
BZ USEDFLT No, use default
L R8,0(R8) Yes, load stack size value
C R8,=F'4096' At least 4K?
BNL ROUNDUP Yes, continue
USEDFLT DS 0H
L R8,=A(STACKLEN) Default stack length
ROUNDUP DS 0H
LA R8,7(,R8) Plus 7 for rounding
N R8,=X'00FFFFF8' Round to nearest double word
LA R0,SUBPOOL Subpool number
SLL R0,24 Shift into high byte
ALR R0,R8 Plus size of storage we want
GETMAIN R,LV=(0)
*
ST R13,4(,R1)
ST R1,8(,R13)
LR R13,R1
USING STACK,R13 Our Save Area
*
CRTSETUP DS 0H
LA R0,0
ST R0,DUMMYPTR Unused in C, used by PL/1
LA R0,MAINSTK Next available stack location
ST R0,THEIRSTK => Next available stack (NAB)
*
* Save R13 in CRTSAVE
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
L R0,CRTSAVE-CLIBCRT(,R15) Get previous save area
ST R0,OLDSAVE Save for later
ST R13,CRTSAVE-CLIBCRT(,R15) Save our save area address
*
L R2,PSATOLD
USING TCB,R2
*
L R7,TCBRBP
USING RBBASIC,R7
SLR R8,R8
ICM R8,B'0111',RBCDE1
DROP R7 (RBBASIC)
*
USING CDENTRY,R8
MVC PGMNAME,CDNAME
MVI PGMNAMEN,0
DROP R8 (CDENTRY)
*
L R2,TCBJSCB
USING IEZJSCB,R2
LH R2,JSCBTJID
ST R2,TYPE TSO terminal job identifier
DROP R2 (IEZJSCB)
*
ST R10,PGMR0 R10 == R0 on entry to @@CRT0
ST R11,PGMR1 R11 == R1 on entry to @@CRT0
LA R2,PGMNAME
ST R2,PGMNPTR A(program name)
*
LA R1,PARMLIST A(parms,program,type)
L R15,=V(@@START)
BALR R14,R15 Should never return
*
* The call to @@START never returns because it will call @@EXIT
* after it calls main().
* But just in case @@START returns here, we'll call @@EXIT which
* eventually calls @@EXITA below.
LA R1,=F'-1'
L R15,=V(@@EXIT)
BR R15 Just in case @@START returns
*** LTORG
TITLE '@@EXITA - exit C runtime environment'
ENTRY @@EXITA
@@EXITA DS 0H
* SWITCH BACK TO OUR OLD SAVE AREA
LA R12,0(,R15)
USING @@EXITA,R12
L R9,0(R1) Get exit(rc) value
*
* Get save area address from CLIBCRT area
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
L R13,CRTSAVE-CLIBCRT(,R15) Restore original stack
L R0,OLDSAVE Get old CRTSAVE value
ST R0,CRTSAVE-CLIBCRT(,R15) restore CRTSAVE
*
* Release stack storage
*
LR R1,R13 R1=A(storage to be freed)
L R13,4(,R1) Original save area
*** WXTRN @@STKLEN
ICM R8,15,=V(@@STKLEN) Get stack length address
BZ EXITDFLT No, use default
L R8,0(R8) Yes, load stack size value
C R8,=F'4096' At least 4K?
BNL EXITSIZE Yes, continue
EXITDFLT DS 0H
L R8,=A(STACKLEN) Default stack length
EXITSIZE DS 0H
LA R8,7(,R8) Plus 7 for rounding
N R8,=X'00FFFFF8' Round to nearest double word
LA R0,SUBPOOL Subpool number
SLL R0,24 Shift into high byte
ALR R0,R8 Plus size of storage we want
FREEMAIN R,LV=(0),A=(R1)
*
* Return to system
LR R15,R9 Get exit(rc) value
RETURN (14,12),RC=(15)
LTORG
TITLE 'Dummy Sections'
* Stack for C thread
STK DSECT
STKSV DS 18F 00 (0) callers registers go here
STKSVLWS DS A 48 (72) PL/I Language Work Space N/A
STKSVNAB DS A 4C (76) next available byte -------+
STKCTHD DS A 50 (80) A(CTHDTASK) |
STKAVAIL DS F 54 (84) unused/available |
STKNAB DS 0D 58 stack next available byte <-----+
*
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
STACK DSECT
SAVEAREA DS 18F
DUMMYPTR DS F => PL/I Language Work Space N/A
THEIRSTK DS F => Next Available Byte (NAB)
PARMLIST DS 0F Parameter list passed to @@START
PGMR0 DS F R0 at entry to program
PGMNPTR DS F A(program name)
TYPE DS F F'TSO job id'
PGMR1 DS F R1 at entry to program
PGMNAME DS CL8
PGMNAMEN DS C NUL BYTE FOR C
OLDSAVE DS F Old CRTSAVE value
DS 0D
MAINSTK DS 16384F stack for @@START -> main()
MAINLEN EQU *-MAINSTK
STACKLEN EQU *-STACK
END

0
src/crent370/asm/@@crtm.o
View File

121
src/crent370/asm/@@crtsvc.asm
View File

@ -1,121 +0,0 @@
@@CRTSVC TITLE '@ @ C R T S V C *** MVS startup routine for C SVC'
COPY PDPTOP
SUBPOOL EQU 250 Used for C style stack allocation
USING PSA,R0
PRINT ON
CSECT
ENTRY @@CRTSVC
USING @@CRTSVC,R6
@@CRTSVC DS 0H Note: we do not save registers
B AROUND Skip over eye catcher
DC AL1(EYELEN)
EYE DC C'@@CRTSVC &SYSDATE &SYSTIME'
EYELEN EQU *-EYE
AROUND DS 0H
LA R12,0(,R6) Establish base register
DROP R6 (@@CRTSVC)
USING @@CRTSVC,R12
LR R8,R14 Save R14
LR R9,R15 Save R15
LR R10,R0 Save R0
LR R11,R1 Save R1
*
* Allocate a save area + stack space
GETMAIN RC,LV=STACKLEN,SP=SUBPOOL
LTR R2,R15 Save return code and test
BZ CHAINSTG Success
*
* No storage available
* fail the request (GETMAIN RC in R0, 0 in R1, -1 in R15)
WTO '*** Out Of Memory ***'
LR R0,R2 Save return code from GETMAIN
SLR R1,R1 Clear R1
L R15,=F'-1' Indicate failure
LR R14,R8 Get return address
BR R14 Return to caller
*
* Chain the save areas
CHAINSTG DS 0H
ST R13,4(,R1) Chain prev save area
*** ST R1,8(,R13) Chain next save area
LR R13,R1 Use next save area
USING STACK,R13 Our Save Area
*
* Create C style stack frame
LA R0,0
ST R0,DUMMYPTR Unused in C, used by PL/1
LA R0,MAINSTK Next available stack location
ST R0,STACKNAB => Next available stack (NAB)
*
* Build parameter list for @@SVC
LA R1,SVCREGS => SVC registers
ST R1,PARMREGS Save in parameter list
STM R9,R11,SVCREGS Save R15, R0, R1
STM R3,R7,SVCCVT Save CVT, TCB, SVRB, SVC, ASCB
SLR R0,R0 Clear for insert
ICM R0,B'0111',RBLINKB-RBBASIC(R5)
ST R0,SVCRBLNK Save RBLINK address
USING TCB,R4
MVC SVCJSCB,TCBJSCB Save JSCB address
*
* Call @@SVC with parameter list
LA R1,PARMLIST => @@SVC paremeter list
L R15,=V(@@SVC)
BALR R14,R15
*
* We should be in supervisor state and key 0
MODESET EXTKEY=ZERO
*
* Get return regs (R15,R0,R1) from @@SVC
LM R9,R11,SVCREGS save R15,R0,R1
*
* Release our savearea and stack storage
LR R1,R13 R1=A(storage to be freed)
L R13,4(,R1) Original save area
FREEMAIN RU,LV=STACKLEN,A=(R1),SP=SUBPOOL
DROP R13 (STACK)
*
* Return to system
LR R14,R8 Callers R14
LR R15,R9 Return R15
LR R0,R10 Return R0
LR R1,R11 Return R1
BR R14 Return to caller
LTORG ,
TITLE 'Our Save Area, Variables and Stack Frame'
STACK DSECT
SAVEAREA DS 18F Standard MVS style save area
DUMMYPTR DS F => PL/I Language Work Space N/A
STACKNAB DS F => Next Available Byte (NAB)
*
* Parameter list for @@SVC
PARMLIST DS 0D Parameter list passed to @@SVC
PARMREGS DS A => SVC registers
*
* Values passed to @@SVC via pointer reference
SVCREGS DS 0F
SVCR15 DS F SVC R15 (input/output)
SVCR0 DS F SVC R0 (input/output)
SVCR1 DS F SVC R1 (input/output)
SVCCVT DS A CVT address (input)
SVCTCB DS A TCB address (input)
SVCSVRB DS A SVRB address (input)
SVCEPA DS A SVC entry address (input)
SVCASCB DS A ASCB address (input)
SVCRBLNK DS A RBLINK address (input)
SVCJSCB DS A JSCB address (input)
DS 2F unused
*
* Stack area (next available byte 'STACKNAB' points here)
DS 0D
MAINSTK DS 8192F stack for @@SVC -> svcmain()
MAINLEN EQU *-MAINSTK
STACKLEN EQU *-STACK
TITLE 'Dummy Sections'
*
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
END

0
src/crent370/asm/@@crtsvc.o
View File

206
src/crent370/asm/@@dynal.asm
View File

@ -1,206 +0,0 @@
MACRO , PATTERN FOR @@DYNAL'S DYNAMIC WORK AREA
&NM DYNPAT &P=MISSING-PFX
.* NOTE THAT EXTRA FIELDS ARE DEFINED FOR FUTURE EXPANSION
.*
&NM DS 0D ALLOCATION FIELDS
&P.ARBP DC 0F'0',A(X'80000000'+&P.ARB) RB POINTER
&P.ARB DC 0F'0',AL1(20,S99VRBAL,0,0)
DC A(0,&P.ATXTP,0,0) SVC 99 REQUEST BLOCK
&P.ATXTP DC 10A(0)
&P.AXVOL DC Y(DALVLSER,1,6)
&P.AVOL DC CL6' '
&P.AXDSN DC Y(DALDSNAM,1,44)
&P.ADSN DC CL44' '
&P.AXMEM DC Y(DALMEMBR,1,8)
&P.AMEM DC CL8' '
&P.AXDSP DC Y(DALSTATS,1,1)
&P.ADSP DC X'08' DISP=SHR
&P.AXFRE DC Y(DALCLOSE,0) FREE=CLOSE
&P.AXDDN DC Y(DALDDNAM,1,8) DALDDNAM OR DALRTDDN
&P.ADDN DC CL8' ' SUPPLIED OR RETURNED DDNAME
&P.ALEN EQU *-&P.ARBP LENGTH OF REQUEST BLOCK
SPACE 1
&P.URBP DC 0F'0',A(X'80000000'+&P.URB) RB POINTER
&P.URB DC 0F'0',AL1(20,S99VRBUN,0,0)
DC A(0,&P.UTXTP,0,0) SVC 99 REQUEST BLOCK
&P.UTXTP DC A(X'80000000'+&P.UXDDN)
&P.UXDDN DC Y(DUNDDNAM,1,8)
&P.UDDN DC CL8' ' RETURNED DDNAME
&P.ULEN EQU *-&P.URBP LENGTH OF REQUEST BLOCK
&P.DYNLN EQU *-&P.ARBP LENGTH OF ALL DATA
MEND ,
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* CALL @@DYNAL,(ddn-len,ddn-adr,dsn-len,dsn-adr),VL *
* *
* "-len" fields are self-defining values in the calling list, *
* or else pointers to 32-bit signed integer values *
* *
* "ddn-adr" is the address of the DD name to be used. When the *
* contents is hex zero or blank, and len=8, gets assigned. *
* *
* "dsn-adr" is the address of a 1 to 44 byte data set name of an *
* existing file (sequential or partitioned). *
* *
* Calling @@DYNAL with a DDNAME and a zero length for the DSN *
* results in unallocation of that DD (and a PARM error). *
* *
*---------------------------------------------------------------------*
* *
* Author: Gerhard Postpischil *
* *
* This program is placed in the public domain. *
* *
*---------------------------------------------------------------------*
* *
* Assembly: Any MVS or later assembler may be used. *
* Requires SYS1.MACLIB *
* Intended to work in any 24 and 31-bit environment. *
* *
* Linker/Binder: RENT,REFR,REUS *
* *
*---------------------------------------------------------------------*
* Return codes: R15:04sssnnn it's a program error code: *
* 04804 - GETMAIN failed; 1400000n PARM list error *
* *
* Otherwise R15:0-1 the primary allocation return code, and *
* R15:2-3 the reason codes. *
***********************************************************************
* Maintenance: new on 2008-06-07 *
* *
***********************************************************************
@@DYNAL FUNHEAD , DYNAMIC ALLOCATION
LA R11,16(,R13) REMEMBER RETURN CODE ADDRESS
MVC 0(4,R11),=X'04804000' PRESET
LR R9,R1 SAVE PARAMETER LIST ADDRESS
LA R0,DYNALDLN GET LENGTH OF SAVE AND WORK AREA
GETMAIN RC,LV=(0) GET STORAGE
LTR R15,R15 SUCCESSFUL ?
BZ DYNALHAV YES
STC R15,3(,R11) SET RETURN VALUES
B DYNALRET RELOAD AND RETURN
*
* CLEAR GOTTEN STORAGE AND ESTABLISH SAVE AREA
*
DYNALHAV ST R1,8(,R13) LINK OURS TO CALLER'S SAVE AREA
ST R13,4(,R1) LINK CALLER'S TO OUR AREA
LR R13,R1
USING DYNALWRK,R13
MVC 0(4,R11),=X'14000001' PRESET FOR PARM LIST ERROR
MVC DYNLIST(ALLDYNLN),PATLIST INITIALIZE EVERYTHING
LDINT R4,0(,R9) DD NAME LENGTH
L R5,4(,R9) -> DD NAME
LDINT R6,8(,R9) DSN LENGTH
L R7,12(,R9) -> DATA SET NAME
* NOTE THAT THE CALLER IS EITHER COMPILER CODE, OR A COMPILER
* LIBRARY ROUTINE, SO WE DO MINIMAL VALIDITY CHECKING
*
* PREPARE DYNAMIC ALLOCATION REQUEST LISTS
*
LA R0,ALLARB
STCM R0,7,ALLARBP+1 REQUEST POINTER
LA R0,ALLATXTP
ST R0,ALLARB+8 TEXT UNIT POINTER
LA R0,ALLAXDSN
LA R1,ALLAXDSP
LA R2,ALLAXDDN
O R2,=X'80000000'
STM R0,R2,ALLATXTP TEXT UNIT ADDRESSES
* COMPLETE REQUEST WITH CALLER'S DATA
*
LTR R4,R4 CHECK DDN LENGTH
BNP DYNALEXT OOPS
CH R4,=AL2(L'ALLADDN) REASONABLE SIZE ?
BH DYNALEXT NO
BCTR R4,0
EX R4,DYNAXDDN MOVE DD NAME
OC ALLADDN,=CL11' ' CONVERT HEX ZEROES TO BLANKS
CLC ALLADDN,=CL11' ' NAME SUPPLIED ?
BNE DYNALDDN YES
MVI ALLAXDDN+1,DALRTDDN REQUEST RETURN OF DD NAME
CH R4,=AL2(L'ALLADDN-1) CORRECT SIZE FOR RETURN ?
BE DYNALNDD AND LEAVE R5 NON-ZERO
B DYNALEXT NO
DYNALDDN SR R5,R5 SIGNAL NO FEEDBACK
* WHEN USER SUPPLIES A DD NAME, DO AN UNCONDITIONAL UNALLOCATE ON IT
LA R0,ALLURB
STCM R0,7,ALLURBP+1 REQUEST POINTER
LA R0,ALLUTXTP
ST R0,ALLURB+8 TEXT UNIT POINTER
LA R2,ALLUXDDN
O R2,=X'80000000'
ST R2,ALLUTXTP TEXT UNIT ADDRESS
MVC ALLUDDN,ALLADDN SET DD NAME
LA R1,ALLURBP POINT TO REQUEST BLOCK POINTER
DYNALLOC , REQUEST ALLOCATION
DYNALNDD LTR R6,R6 CHECK DSN LENGTH
BNP DYNALEXT OOPS
CH R6,=AL2(L'ALLADSN) REASONABLE SIZE ?
BH DYNALEXT NO
STH R6,ALLADSN-2 SET LENGTH INTO TEXT UNIT
BCTR R6,0
EX R6,DYNAXDSN MOVE DS NAME
* ALLOCATE
LA R1,ALLARBP POINT TO REQUEST BLOCK POINTER
DYNALLOC , REQUEST ALLOCATION
STH R15,0(,R11) PRIMARY RETURN CODE
STH R0,2(,R11) REASON CODES
LTR R5,R5 NEED TO RETURN DDN ?
BZ DYNALEXT NO
MVC 0(8,R5),ALLADDN RETURN NEW DDN, IF ANY
B DYNALEXT AND RETURN
DYNAXDDN MVC ALLADDN(0),0(R5) COPY DD NAME
DYNAXDSN MVC ALLADSN(0),0(R7) COPY DATA SET NAME
* PROGRAM EXIT, WITH APPROPRIATE RETURN CODES
*
DYNALEXT LR R1,R13 COPY STORAGE ADDRESS
L R9,4(,R13) GET CALLER'S SAVE AREA
LA R0,DYNALDLN GET ORIGINAL LENGTH
FREEMAIN R,A=(1),LV=(0) AND RELEASE THE STORAGE
LR R13,R9 RESTORE CALLER'S SAVE AREA
DYNALRET FUNEXIT , RESTORE REGS; SET RETURN CODES
LTORG ,
PUSH PRINT
PRINT NOGEN DON'T NEED TWO COPIES
PATLIST DYNPAT P=PAT EXPAND ALLOCATION DATA
POP PRINT
* DYNAMICALLY ACQUIRED STORAGE
*
DYNALWRK DSECT , MAP STORAGE
DS 18A OUR OS SAVE AREA
DYNLIST DYNPAT P=ALL EXPAND ALLOCATION DATA
DYNALDLN EQU *-DYNALWRK LENGTH OF DYNAMIC STORAGE
CSECT , RESTORE
LTORG ,
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@dynal.o
View File

58
src/crent370/asm/@@exita.asm
View File

@ -1,58 +0,0 @@
@@EXITA TITLE '@ @ E X I T A *** Terminate C environment'
COPY PDPTOP
PRINT OFF
USING PSA,R0
PRINT ON
COPY CLIBCRT
COPY CLIBPPA CLIB Program Properties Area
CSECT
ENTRY @@EXITA
@@EXITA DS 0H
* SWITCH BACK TO OUR OLD SAVE AREA
LA R12,0(,R15)
USING @@EXITA,R12
L R9,0(R1) Get exit(rc) value
*
* Get save area address from CLIBCRT area
L R15,=V(@@CRTGET)
BALR R14,R15 Get our CLIBCRT area
L R13,CRTSAVE-CLIBCRT(,R15) Restore original stack
*
* Cleanup C process level area
L R15,=V(@@GRTRES)
BALR R14,R15 Reset CLIBGRT area
*
* Cleanup C main task (thread) area
L R15,=V(@@CRTRES)
BALR R14,R15 Release CLIBCRT, reset TCBUSER
*
* Release stack storage
*
L R2,PSATOLD
USING TCB,R2
SR R15,R15
ICM R15,B'0111',TCBFSAB => TCB first save area
L R6,8(,R15) get PPA from fsa next value
USING CLIBPPA,R6
*
L R0,PPASAVE get original "next" value
ST R0,8(,R15) save original "next" in fsa
LR R1,R6 R1=A(storage to be freed)
L R13,4(,R1) Original save area
ICM R0,1,PPASUBPL Get subpool number
SLL R0,24 Put subpool in high byte
AL R0,PPASTKLN Plus size of storage
FREEMAIN R,LV=(0),A=(R1)
DROP R6 (CLIBPPA)
*
* Return to system
LR R15,R9 Get exit(rc) value
RETURN (14,12),RC=(15)
LTORG
TITLE 'Dummy Sections'
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
END

0
src/crent370/asm/@@exita.o
View File

25
src/crent370/asm/@@freem.asm
View File

@ -1,25 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* FREEM - FREE MEMORY *
* *
***********************************************************************
@@FREEM FUNHEAD ,
*
L R1,0(,R1)
S R1,=F'8'
L R0,0(,R1)
*
FREEMAIN RU,LV=(0),A=(1),SP=SUBPOOL
*
FUNEXIT RC=(15)
LTORG ,
END

0
src/crent370/asm/@@freem.o
View File

35
src/crent370/asm/@@getclk.asm
View File

@ -1,35 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* GETCLCK - GET THE VALUE OF THE MVS CLOCK TIMER AND MOVE IT TO AN *
* 8-BYTE FIELD. THIS 8-BYTE FIELD DOES NOT NEED TO BE ALIGNED IN *
* ANY PARTICULAR WAY. *
* *
* E.G. CALL 'GETCLCK' USING WS-CLOCK1 *
* *
* THIS FUNCTION ALSO RETURNS THE NUMBER OF SECONDS SINCE 1970-01-01 *
* BY USING SOME EMPIRICALLY-DERIVED MAGIC NUMBERS *
* *
***********************************************************************
@@GETCLK FUNHEAD , GET TOD CLOCK VALUE
*
L R2,0(,R1)
STCK 0(R2)
L R4,0(,R2)
L R5,4(,R2)
SRDL R4,12
SL R4,=X'0007D910'
D R4,=F'1000000'
SL R5,=F'1220'
*
RETURNGC FUNEXIT RC=(R5)
LTORG ,
END

0
src/crent370/asm/@@getclk.o
View File

43
src/crent370/asm/@@getm.asm
View File

@ -1,43 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* GETM - GET MEMORY *
* *
***********************************************************************
@@GETM FUNHEAD ,
*
LDINT R3,0(,R1) LOAD REQUESTED STORAGE SIZE
SLR R1,R1 PRESET IN CASE OF ERROR
LTR R4,R3 CHECK REQUEST
BNP GETMEX QUIT IF INVALID
*
* To reduce fragmentation, round up size to 64 byte multiple
*
A R3,=A(8+(64-1)) OVERHEAD PLUS ROUNDING
N R3,=X'FFFFFFC0' MULTIPLE OF 64
*
AIF ('&SYS' NE 'S380').NOANY
GETMAIN RU,LV=(R3),SP=SUBPOOL,LOC=ANY
AGO .FINANY
.NOANY ANOP ,
GETMAIN RU,LV=(R3),SP=SUBPOOL
.FINANY ANOP ,
*
* WE STORE THE AMOUNT WE REQUESTED FROM MVS INTO THIS ADDRESS
ST R3,0(,R1)
* AND JUST BELOW THE VALUE WE RETURN TO THE CALLER, WE SAVE
* THE AMOUNT THEY REQUESTED
ST R4,4(,R1)
A R1,=F'8'
*
GETMEX FUNEXIT RC=(R1)
LTORG ,
END

0
src/crent370/asm/@@getm.o
View File

64
src/crent370/asm/@@getpfx.asm
View File

@ -1,64 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
**********************************************************************
* *
* GETPFX - get TSO prefix *
* *
**********************************************************************
ENTRY @@GETPFX
@@GETPFX DS 0H
SAVE (14,12),,@@GETPFX
LR R12,R15
USING @@GETPFX,R12
*
LA R15,0
LA R0,0 Not really needed, just looks nice
USING PSA,R0
ICM R2,15,PSATOLD
BZ RETURNGP
USING TCB,R2
ICM R3,15,TCBJSCB
BZ RETURNGP
USING IEZJSCB,R3
ICM R4,15,JSCBPSCB
BZ RETURNGP
USING PSCB,R4
ICM R5,15,PSCBUPT
BZ RETURNGP
USING UPT,R5
LA R6,UPTPREFX
LR R15,R6
*
RETURNGP DS 0H
RETURN (14,12),RC=(15)
LTORG
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@getpfx.o
View File

27
src/crent370/asm/@@gettz.asm
View File

@ -1,27 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* GETTZ - Get the offset from GMT in 1.048576 seconds *
* *
***********************************************************************
* @@GETTZ FUNHEAD , get timezone offset
*
* L R3,CVTPTR
* USING CVT,R3
* L R4,CVTTZ
*
* RETURNGS FUNEXIT RC=(R4)
* LTORG ,
ENTRY @@GETTZ
@@GETTZ L R15,CVTPTR
L R15,CVTTZ-CVTMAP(,R15) GET GMT TIME-ZONE OFFSET
BR R14
LTORG ,
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
END

0
src/crent370/asm/@@gettz.o
View File

125
src/crent370/asm/@@idcams.asm
View File

@ -1,125 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* INVOKE IDCAMS: CALL @@IDCAMS,(@LEN,@TEXT) *
* *
***********************************************************************
PUSH USING
DROP ,
@@IDCAMS FUNHEAD SAVE=IDCSAVE EXECUTE IDCAMS REQUEST
LA R1,0(,R1) ADDRESS OF IDCAMS REQUEST (V-CON)
* ST R1,IDC@REQ SAVE REQUEST ADDRESS
LA R14,IDC@REQ
ST R1,0(,R14)
*
* MVI EXFLAGS,0 INITIALIZE FLAGS
LA R14,EXFLAGS
MVI 0(R14),0
*
LA R1,AMSPARM PASS PARAMETER LIST
LINK EP=IDCAMS INVOKE UTILITY
FUNEXIT RC=(15) RESTORE CALLER'S REGS
POP USING
SPACE 1
***********************************************************************
* *
* XIDCAMS - ASYNCHRONOUS EXIT ROUTINE *
* *
***********************************************************************
PUSH USING
DROP ,
XIDCAMS STM R14,R12,12(R13)
LR R12,R15
USING XIDCAMS,R12
LA R9,XIDSAVE SET MY SAVE AREA
ST R13,4(,R9) MAKE BACK LINK
ST R9,8(,R13) MAKE DOWN LINK
LR R13,R9 MAKE ACTIVE SAVE AREA
SR R15,R15 PRESET FOR GOOD RETURN
LM R3,R5,0(R1) LOAD PARM LIST ADDRESSES
SLR R14,R14
IC R14,0(,R4) LOAD FUNCTION
B *+4(R14)
B XIDCEXIT OPEN CODE IN R14 = X'00'
B XIDCEXIT CLOSE CODE IN R14 = X'04'
B XIDCGET GET SYSIN CODE IN R14 = X'08'
B XIDCPUT PUT SYSPRINT CODE IN R14 = X'0C'
XIDCGET TM EXFLAGS,EXFGET X'01' = PRIOR GET ISSUED ?
BNZ XIDCGET4 YES, SET RET CODE = 04
L R1,IDC@REQ GET REQUEST ADDRESS
LDINT R3,0(,R1) LOAD LENGTH
L R2,4(,R1) LOAD TEXT POINTER
LA R2,0(,R2) CLEAR HIGH
STM R2,R3,0(R5) PLACE INTO IDCAMS LIST
* OI EXFLAGS,EXFGET X'01' = A GET HAS BEEN ISSUED
LA R14,EXFLAGS
OI 0(R14),EXFGET
*
B XIDCEXIT
XIDCGET4 LA R15,4 SET REG 15 = X'00000004'
B XIDCEXIT
XIDCPUT TM EXFLAGS,EXFSUPP+EXFSKIP ANY FORM OF SUPPRESSION?
BNZ XIDCPUTZ YES; DON'T BOTHER WITH REST
LM R4,R5,0(R5)
LA R4,1(,R4) SKIP CARRIAGE CONTROL CHARACTER
BCTR R5,0 FIX LENGTH
ICM R5,8,=C' ' BLANK FILL
LA R14,XIDCTEXT
LA R15,L'XIDCTEXT
MVCL R14,R4
TM EXFLAGS,EXFMALL PRINT ALL MESSAGES?
BNZ XIDCSHOW YES; PUT THEM ALL OUT
CLC =C'IDCAMS ',XIDCTEXT IDCAMS TITLE ?
BE XIDCEXIT YES; SKIP
CLC XIDCTEXT+1(L'XIDCTEXT-1),XIDCTEXT ALL BLANK OR SOME?
BE XIDCEXIT YES; SKIP
CLC =C'IDC0002I',XIDCTEXT AMS PGM END
BE XIDCEXIT YES; SKIP
XIDCSHOW DS 0H
*DEBUG* WTO MF=(E,AMSPRINT) SHOW MESSAGE
XIDCPUTZ SR R15,R15
B XIDCEXIT
*XIDCSKIP OI EXFLAGS,EXFSKIP SKIP THIS AND REMAINING MESSAGES
XIDCSKIP DS 0H
LA R15,EXFLAGS
OI 0(R15),EXFSKIP
*
SR R15,R15
*---------------------------------------------------------------------*
* IDCAMS ASYNC EXIT ROUTINE - EXIT, CONSTANTS & WORKAREAS
*---------------------------------------------------------------------*
XIDCEXIT L R13,4(,R13) GET CALLER'S SAVE AREA
L R14,12(,R13)
RETURN (0,12) RESTORE AND RETURN TO IDCAMS
IDCSAVE DC 18F'0' MAIN ROUTINE'S REG SAVEAREA
XIDSAVE DC 18F'0' ASYNC ROUTINE'S REG SAVEAREA
AMSPRINT DC 0A(0),AL2(4+L'XIDCTEXT,0)
XIDCTEXT DC CL132' '
AMSPARM DC A(HALF00,HALF00,HALF00,X'80000000'+ADDRLIST)
ADDRLIST DC F'2'
DC A(DDNAME01)
DC A(XIDCAMS)
IDC@REQ DC A(0) ADDRESS OF REQUEST POINTER
DC A(DDNAME02)
DC A(XIDCAMS)
DC A(0)
HALF00 DC H'0'
DDNAME01 DC CL10'DDSYSIN '
DDNAME02 DC CL10'DDSYSPRINT'
EXFLAGS DC X'08' EXIT PROCESSING FLAGS
EXFGET EQU X'01' PRIOR GET WAS ISSUED
EXFNOM EQU X'04' SUPPRESS ERROR WTOS
EXFRET EQU X'08' NO ABEND; RETURN WITH COND.CODE
EXFMALL EQU X'10' ALWAYS PRINT MESSAGES
EXFSUPP EQU X'20' ALWAYS SUPPRESS MESSAGES
EXFSKIP EQU X'40' SKIP SUBSEQUENT MESSAGES
EXFGLOB EQU EXFMALL+EXFSUPP+EXFRET GLOBAL FLAGS
POP USING
LTORG ,
SPACE 2
COPY CLIBSUPA
END

0
src/crent370/asm/@@idcams.o
View File

17
src/crent370/asm/@@longj.asm
View File

@ -1,17 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* LONGJ - RESTORE REGISTERS FROM ENV *
* *
***********************************************************************
ENTRY @@LONGJ
@@LONGJ L R1,0(,R1) get the env variable
L R15,60(,R1) get the return code
LM R0,R14,0(R1) restore registers
BR R14 return to caller
LTORG ,
END

0
src/crent370/asm/@@longj.o
View File

78
src/crent370/asm/@@ppaget.asm
View File

@ -1,78 +0,0 @@
@@PPAGET TITLE '@ @ P P A G E T *** Retrieve CLIBPPA from stack'
COPY PDPTOP
PRINT OFF
USING PSA,R0
PRINT ON
COPY CLIBCRT
COPY CLIBPPA CLIB Program Properties Area
CSECT
ENTRY @@PPAGET
@@PPAGET DS 0H
SAVE (14,12),,@@PPAGET
LA R12,0(,R15)
USING @@PPAGET,R12
SR R15,R15
*
USING PSA,R0
L R2,PSATOLD
USING TCB,R2
SR R3,R3
ICM R3,B'0111',TCBFSAB -> first TCB save area
BZ PPAOWNER No save area, try owner TCB
ICM R3,B'1111',8(R3) -> next TCB save area
BZ PPAOWNER No next, try owner TCB
CL R3,=F'16777215' GT X'FFFFFF'?
BH PPAOWNER Yes, not 24 bit address
USING CLIBPPA,R3 Program Properties Area
CLC PPAEYE,=A(PPAEYE$) Valid eye catcher?
BE PPAFND Yes, PPA found
*
* See if owner TCB has PPA
PPAOWNER DS 0H
ICM R2,B'0111',TCBOTC+1 Get owner TCB
BZ PPASTCK None, check stack
*
SR R3,R3
ICM R3,B'0111',TCBFSAB -> first TCB save area
BZ PPAONEXT No save area, try next owner
ICM R3,B'1111',8(R3) -> next TCB save area
BZ PPAONEXT No next, try next owner TCB
CL R3,=F'16777215' GT X'FFFFFF'?
BH PPAONEXT Yes, not 24 bit address
CLC PPAEYE,=A(PPAEYE$) Valid eye catcher?
BE PPAFND Yes, PPA found
*
PPAONEXT DS 0H
C R2,TCBJSTCB Is this the Job Step TCB?
BE PPASTCK Yes, check stack
B PPAOWNER No, try owner TCB
*
* We didn't find the PPA as the "next" SA in the TCBFSA.
* So we'll run the SA chain backward and try to find it.
PPASTCK DS 0H
L R2,PSATOLD
ICM R3,B'1111',4(R13) Get prev SA
PPALOOP DS 0H
CLC PPAEYE,=A(PPAEYE$) Valid eye catcher?
BE PPAFND Yes, PPA found
ICM R3,B'1111',4(R3) Get prev SA
BZ PPAFAIL Zero, not found
CLM R3,B'0111',TCBFSAB Same as TCBFSAB?
BE PPAFAIL Yes, not found
B PPALOOP
*
PPAFND DS 0H
B PPAEXIT
PPAFAIL DS 0H
SR R3,R3
PPAEXIT DS 0H
LR R15,R3 Return PPA
RETURN (14,12),RC=(15)
LTORG ,
TITLE 'Dummy Sections'
IKJTCB LIST=YES
IEZJSCB
IHAPSA
IHARB
IHACDE
END

0
src/crent370/asm/@@ppaget.o
View File

17
src/crent370/asm/@@setj.asm
View File

@ -1,17 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* SETJ - SAVE REGISTERS INTO ENV *
* *
***********************************************************************
ENTRY @@SETJ
@@SETJ L R1,0(,R1) get the env variable
LA R15,0 setjmp needs to return 0
STM R0,R14,0(R1) save registers to be restored
BR R14 return to caller
LTORG ,
END

0
src/crent370/asm/@@setj.o
View File

24
src/crent370/asm/@@ssctbn.asm
View File

@ -1,24 +0,0 @@
TITLE 'Find SSCT by subsystem name'
ENTRY @@SSCTBN
@@SSCTBN DS 0H
SAVE (14,12),,@@SSCTBN
LA 12,0(,15) => our base
USING @@SSCTBN,12
L 1,0(,1) => CL4'subsystem name'
L 15,FLCCVT-PSA(,0) => CVT
L 15,CVTJESCT-CVT(,15) => JESCT
L 15,JESSSCT-JESCT(,15) => SSCT
USING SSCT,15
AGAIN DS 0H
CLC SSCTSNAM,0(1) Is this the subsystem?
BE RETURN Yes, return now
ICM 15,B'1111',SSCTSCTA Next subsystem
BNZ AGAIN
RETURN DS 0H
RETURN (14,12),RC=(15)
PRINT NOGEN
IHAPSA
CVT DSECT=YES
IEFJESCT
IEFJSCVT
END

0
src/crent370/asm/@@ssctbn.o
View File

89
src/crent370/asm/@@svc99.asm
View File

@ -1,89 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
*-----------------------ASSEMBLY OPTIONS------------------------------*
SUBPOOL EQU 0 *
*---------------------------------------------------------------------*
SPACE 1
***********************************************************************
* *
* CALL @@SVC99,(rb) *
* *
* Execute DYNALLOC (SVC 99) *
* *
* Caller must provide a request block, in conformance with the *
* MVS documentation for this (which is very complicated) *
* *
***********************************************************************
PUSH USING
DROP ,
ENTRY @@SVC99
@@SVC99 DS 0H
SAVE (14,12),,@@SVC99 Save caller's regs.
LR R12,R15
USING @@SVC99,R12
LR R11,R1
*
GETMAIN RU,LV=WORKLEN,SP=SUBPOOL
ST R13,4(,R1)
ST R1,8(,R13)
LR R13,R1
LR R1,R11
USING WORKAREA,R13
*
* Note that the SVC requires a pointer to the pointer to the RB.
* Because this function (not SVC) expects to receive a standard
* parameter list, where R1 so happens to be a pointer to the
* first parameter, which happens to be the address of the RB,
* then we already have in R1 exactly what SVC 99 needs.
*
* Except for one thing. Technically, you're meant to have the
* high bit of the pointer on. So we rely on the caller to have
* the parameter in writable storage so that we can ensure that
* we set that bit.
*
L R2,0(R1)
O R2,=X'80000000'
ST R2,0(R1)
SVC 99
LR R2,R15
*
RETURN99 DS 0H
LR R1,R13
L R13,SAVEAREA+4
FREEMAIN RU,LV=WORKLEN,A=(1),SP=SUBPOOL
*
LR R15,R2 Return success
RETURN (14,12),RC=(15) Return to caller
*
DROP R12
POP USING
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@svc99.o
View File

221
src/crent370/asm/@@system.asm
View File

@ -1,221 +0,0 @@
COPY MVSMACS
COPY PDPTOP
CSECT ,
PRINT GEN
SPACE 1
***********************************************************************
* *
* CALL @@SYSTEM,(req-type,pgm-len,pgm-name,parm-len,parm),VL *
* *
* "-len" fields are self-defining values in the calling list, *
* or else pointers to 32-bit signed integer values *
* *
* "pgm-name" is the address of the name of the program to be *
* executed (one to eight characters) *
* *
* "parm" is the address of a text string of length "parm-len", *
* and may be zero to one hundred bytes (OS JCL limit) *
* *
* "req-type" is or points to 1 for a program ATTACH *
* 2 for TSO CP invocation *
* *
*---------------------------------------------------------------------*
* *
* Author: Gerhard Postpischil *
* *
* This program is placed in the public domain. *
* *
*---------------------------------------------------------------------*
* *
* Assembly: Any MVS or later assembler may be used. *
* Requires SYS1.MACLIB. TSO CP support requires additional *
* macros from SYS1.MODGEN (SYS1.AMODGEN in MVS). *
* Intended to work in any 24 and 31-bit environment. *
* *
* Linker/Binder: RENT,REFR,REUS *
* *
*---------------------------------------------------------------------*
* Return codes: when R15:0 R15:1-3 has return from program. *
* R15 is 04806nnn ATTACH failed *
* R15 is 1400000n PARM list error: n= 1,2, or 3 (req/pgm/parm) *
* R15 is 80sss000 or 80000uuu Subtask ABENDED (SYS sss/User uuu)*
* *
***********************************************************************
@@SYSTEM FUNHEAD SAVE=(SYSATWRK,SYSATDLN,78) ISSUE OS OR TSO COMMAND
L R15,4(,R13) GET CALLER'S SAVE AREA
LA R11,16(,R15) REMEMBER THE RETURN CODE ADDRESS
LR R9,R1 SAVE PARAMETER LIST ADDRESS
SPACE 1
MVC 0(4,R11),=X'14000002' PRESET FOR PARM ERROR
LDINT R4,0(,R9) REQUEST TYPE
LDINT R5,4(,R9) LENGTH OF PROGRAM NAME
L R6,8(,R9) -> PROGRAM NAME
LDINT R7,12(,R9) LENGTH OF PARM
L R8,16(,R9) -> PARM TEXT
SPACE 1
* NOTE THAT THE CALLER IS EITHER COMPILER CODE, OR A COMPILER
* LIBRARY ROUTINE, SO WE DO MINIMAL VALIDITY CHECKING
*
* EXAMINE PROGRAM NAME LENGTH AND STRING
*
CH R5,=H'8' NOT TOO LONG ?
BH SYSATEXT TOO LONG; TOO BAD
SH R5,=H'1' LENGTH FOR EXECUTE
BM SYSATEXT NONE; OOPS
MVC SYSATPGM(L'SYSATPGM+L'SYSATOTL+1),=CL11' ' PRE-BLANK
EX R5,SYSAXPGM MOVE PROGRAM NAME
CLC SYSATPGM,=CL11' ' STILL BLANK ?
BE SYSATEXT YES; TOO BAD
* BRANCH AND PROCESS ACCORDING TO REQUEST TYPE
*
MVI 3(R11),1 SET BAD REQUEST TYPE
CH R4,=H'2' CP PROGRAM ATTACH ?
BE SYSATCP YES
CH R4,=H'1' OS PROGRAM ATTACH ?
BNE SYSATEXT NO; HAVE ERROR CODE
* OS PROGRAM ATTACH - PREPARE PARM, ETC.
*
* NOW LOOK AT PARM STRING
LTR R7,R7 ANY LENGTH ?
BM SYSATEXT NO; OOPS
STH R7,SYSATOTL PASS LENGTH OF TEXT
BZ SYSATNTX
CH R7,=AL2(L'SYSATOTX) NOT TOO LONG ?
BH SYSATEXT TOO LONG; TOO BAD
BCTR R7,0
EX R7,SYSAXTXT MOVE PARM STRING
SYSATNTX LA R1,SYSATOTL GET PARAMETER ADDRESS
ST R1,SYSATPRM SET IT
OI SYSATPRM,X'80' SET END OF LIST BIT
B SYSATCOM GO TO COMMON ATTACH ROUTINE
* TSO CP REQUEST - PREPARE PARM, CPPL, ETC.
*
SYSATCP LTR R7,R7 ANY LENGTH ?
BM SYSATEXT NO; OOPS
LA R1,SYSATOTX-SYSATOPL(,R7) LENGTH WITH HEADER
STH R1,SYSATOPL PASS LENGTH OF COMMAND TEXT
LA R1,1(,R5) BYTE AFTER COMMAND NAME
STH R1,SYSATOPL+2 LENGTH PROCESSED BY PARSER
BZ SYSATXNO
CH R7,=AL2(L'SYSATOTX) NOT TOO LONG ?
BH SYSATEXT TOO LONG; TOO BAD
BCTR R7,0
EX R7,SYSAXTXT MOVE PARM STRING
SYSATXNO LA R1,SYSATOPL GET PARAMETER ADDRESS
ST R1,SYSATPRM SET IT
* TO MAKE THIS WORK, WE NEED THE UPT, PSCB, AND ECT ADDRESS.
* THE FOLLOWING CODE WORKS PROVIDED THE CALLER WAS INVOKED AS A
* TSO CP, USED NORMAL SAVE AREA CONVENTIONS, AND HASN'T MESSED WITH
* THE TOP SAVE AREA.
MVI 3(R11),4 SET ERROR FOR BAD CP REQUEST
LA R2,SYSATPRM+8 CPPLPSCB
EXTRACT (R2),FIELDS=PSB GET THE PSCB
PUSH USING
L R1,PSATOLD-PSA GET THE CURRENT TCB
USING TCB,R1
L R1,TCBFSA GET THE TOP LEVEL SAVE AREA
N R1,=X'00FFFFFF' KILL TCBIDF BYTE
POP USING
L R1,24(,R1) ORIGINAL R1
LA R1,0(,R1) CLEAN IT
LTR R1,R1 ANY?
BZ SYSATEXT NO; TOO BAD
TM 0(R1),X'80' END OF LIST?
BNZ SYSATEXT YES; NOT CPPL
TM 4(R1),X'80' END OF LIST?
BNZ SYSATEXT YES; NOT CPPL
TM 8(R1),X'80' END OF LIST?
BNZ SYSATEXT YES; NOT CPPL
CLC 8(4,R1),SYSATPRM+8 MATCHES PSCB FROM EXTRACT?
BNE SYSATEXT NO; TOO BAD
MVC SYSATPRM+4(3*4),4(R1) COPY UPT, PSCB, ECT
L R1,12(,R1)
LA R1,0(,R1) CLEAR EOL BIT IN EITHER AMODE
LTR R1,R1 ANY ADDRESS?
BZ SYSATCOM NO; SKIP
PUSH USING (FOR LATER ADDITIONS?)
USING ECT,R1 DECLARE ECT
LM R14,R15,SYSATPGM GET COMMAND NAME
LA R0,7 MAX TEST/SHIFT
SYSATLCM CLM R14,8,=CL11' ' LEADING BLANK ?
BNE SYSATLSV NO; SET COMMAND NAME
SLDL R14,8 ELIMINATE LEADING BLANK
IC R15,=CL11' ' REPLACE BY TRAILING BLANK
BCT R0,SYSATLCM TRY AGAIN
SYSATLSV STM R14,R15,ECTPCMD
NI ECTSWS,255-ECTNOPD SET FOR OPERANDS EXIST
EX R7,SYSAXBLK SEE IF ANY OPERANDS
BNE SYSATCOM HAVE SOMETHING
OI ECTSWS,ECTNOPD ALL BLANK
POP USING
SYSATCOM LA R1,SYSATPRM PASS ADDRESS OF PARM ADDRESS
LA R2,SYSATPGM POINT TO NAME
LA R3,SYSATECB AND ECB
ATTACH EPLOC=(R2), INVOKE THE REQUESTED PROGRAM *
ECB=(R3),SF=(E,SYSATLST) SZERO=NO,SHSPV=78
LTR R15,R15 CHECK RETURN CODE
BZ SYSATWET GOOD
MVC 0(4,R11),=X'04806000' ATTACH FAILED
STC R15,3(,R11) SET ERROR CODE
B SYSATEXT FAIL
SYSATWET ST R1,SYSATTCB SAVE FOR DETACH
WAIT ECB=SYSATECB WAIT FOR IT TO FINISH
L R2,SYSATTCB GET SUBTASK TCB
USING TCB,R2 DECLARE IT
MVC 0(4,R11),TCBCMP COPY RETURN OR ABEND CODE
TM TCBFLGS,TCBFA ABENDED ?
BZ *+8 NO
MVI 0(R11),X'80' SET ABEND FLAG
DETACH SYSATTCB GET RID OF SUBTASK
DROP R2
B SYSATEXT AND RETURN
SYSAXPGM OC SYSATPGM(0),0(R6) MOVE NAME AND UPPER CASE
SYSAXTXT MVC SYSATOTX(0),0(R8) MOVE PARM TEXT
SYSAXBLK CLC SYSATOTX(0),SYSATOTX-1 TEST FOR OPERANDS
* PROGRAM EXIT, WITH APPROPRIATE RETURN CODES
*
SYSATEXT FUNEXIT , RESTORE REGS; SET RETURN CODES
SPACE 1 RETURN TO CALLER
* DYNAMICALLY ACQUIRED STORAGE
*
SYSATWRK DSECT , MAP STORAGE
DS 18A OUR OS SAVE AREA
SYSATCLR DS 0F START OF CLEARED AREA
SYSATLST ATTACH EPLOC=SYSATPGM,ECB=SYSATECB,SHSPV=78,SZERO=NO,SF=L
SYSATECB DS F EVENT CONTROL FOR SUBTASK
SYSATTCB DS A ATTACH TOKEN FOR CLEAN-UP
SYSATPRM DS 4A PREFIX FOR CP
SYSATOPL DS 2Y 1/4 PARM LENGTH / LENGTH SCANNED
SYSATPGM DS CL8 2/4 PROGRAM NAME (SEPARATOR)
SYSATOTL DS Y 3/4 OS PARM LENGTH / BLANKS FOR CP CALL
SYSATZER EQU SYSATCLR,*-SYSATCLR,C'X' ADDRESS & SIZE TO CLEAR
SYSATOTX DS CL247 4/4 NORMAL PARM TEXT STRING
SYSATDLN EQU *-SYSATWRK LENGTH OF DYNAMIC STORAGE
CSECT , RESTORE
SPACE 2
COPY CLIBSUPA
*
SPACE 2
PRINT NOGEN
IHAPSA , MAP LOW STORAGE
CVT DSECT=YES
IKJTCB , MAP TASK CONTROL BLOCK
IKJECT , MAP ENV. CONTROL BLOCK
IKJPTPB , PUTLINE PARAMETER BLOCK
IKJCPPL ,
IKJPSCB ,
IEZJSCB ,
IEZIOB ,
IEFZB4D0 , MAP SVC 99 PARAMETER LIST
IEFZB4D2 , MAP SVC 99 PARAMETERS
IEFUCBOB ,
MYTIOT DSECT ,
IEFTIOT1 ,
IHAPDS PDSBLDL=YES
SPACE 1
IFGACB , GP14233
SPACE 1
IFGRPL , GP14233
IEFJESCT ,
IKJUPT ,
END

0
src/crent370/asm/@@system.o
View File

3
src/crent370/asm/dummy.asm
View File

@ -1,3 +0,0 @@
PRINT GEN
$PDDB
END

0
src/crent370/asm/dummy.o
View File

26
src/crent370/asm/files.txt
View File

@ -1,26 +0,0 @@
@@aclose.asm
@@aline.asm
@@anote.asm
@@aopen.asm
@@apoint.asm
@@aread.asm
@@atrout.asm
@@awrite.asm
@@crt0.asm
@@crt1.asm
@@crtsvc.asm
dummy.asm
@@dynal.asm
@@freem.asm
@@getclk.asm
@@getm.asm
@@getpfx.asm
@@gettz.asm
gettzoff.asm
@@idcams.asm
@@longj.asm
@@setj.asm
@@ssctbn.asm
ssireq01.asm
@@svc99.asm
@@system.asm

75
src/crent370/asm/gettzoff.asm
View File

@ -1,75 +0,0 @@
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
ENTRY GETTZOFF
GETTZOFF DS 0H
STM R0,R12,20(R13) Save the register we're using
LA R12,0(,R15)
USING GETTZOFF,R12
*
L R15,CVTPTR
L R15,CVTTZ-CVTMAP(,R15) GET GMT TIME-ZONE OFFSET
* The CVTTZ value offset is in 1.048576 second increments.
* The maximum offset people have managed to define is 14 hours
* (Kirribati) and when mulplied by 16384, this doesn't exceed a 32-bit
* signed integer, so we're safe.
*
* However, the TZ offset value is actually truncated, e.g. -27465.8
* is stored as -27465, which combined with the 1.048576 granularity
* means that we don't have 1-second accuracy.
* So we round to the nearest minute.
LR 4,15
SLL 4,14 o = o * 16384;
SRDA 4,32
L 8,=F'15625'
DR 4,8 o /= 15625
*
SR 2,2
SRDA 2,32
LA 8,60
DR 2,8 r = o % 60
*
SR 6,6
SRDA 6,32
DR 6,8 o /= 60 convert to minutes
*
LR 15,7
LTR 7,7
BL GETTZ010
LA 3,29
CR 2,3
BNH GETTZ010
A 15,=F'1' o += 1
B GETTZ020
GETTZ010 DS 0H
LTR 15,15
BH GETTZ020
L 8,=F'-30'
CR 2,8
BH GETTZ020
BCTR 15,0 o -= 1
GETTZ020 DS 0H
LR 2,15
SLL 2,4
SR 2,15
SLL 2,2 o = o * 60 convert to seconds
LR R15,R2 Time zone offset
LM R0,R12,20(R13) Restore registers we used
BR R14
LTORG
IHAPSA
CVT DSECT=YES
END

0
src/crent370/asm/gettzoff.o
View File

62
src/crent370/asm/makefile
View File

@ -1,62 +0,0 @@
#
# makefile for crent370/asm (asm files)
#
# asm source code files
A_FILES := @@aclose.asm \
@@aline.asm \
@@anote.asm \
@@aopen.asm \
@@apoint.asm \
@@aread.asm \
@@atrout.asm \
@@awrite.asm \
@@crt0.asm \
@@crt1.asm \
@@crtm.asm \
@@crtsvc.asm \
dummy.asm \
@@dynal.asm \
@@exita.asm \
@@freem.asm \
@@getclk.asm \
@@getm.asm \
@@getpfx.asm \
@@gettz.asm \
gettzoff.asm \
@@idcams.asm \
@@longj.asm \
@@ppaget.asm \
@@setj.asm \
@@ssctbn.asm \
@@svc99.asm \
@@system.asm
#deprecated:
# object files (one for each .asm source file)
O_FILES := $(foreach filename,$(A_FILES),$(filename:.asm=.o))
# export MACn variables for mvsasm->jobasm script
export MAC1=MDR.CRENT370.MACLIB
export MAC2=SYS2.MACLIB
# export dataset names used by mvsasm script
export MVSASM_PUNCH=MDR.CRENT370.OBJECT
export MVSASM_SYSLMOD=MDR.CRENT370.NCALIB
all: $(O_FILES)
@echo "Done"
# Note: PHONY is important here. Without it, implicit rules will try
# to build the executable "all", since the prereqs are ".o" files.
.PHONY: all
# build object files from assembler files (.asm)
%.o: %.asm
@echo "mvsasm $(notdir $<)"
@mvsasm "$<"
@touch "$@"
# remove generated files
clean:
@rm -f $(O_FILES)

404
src/crent370/asm/ssireq01.asm
View File

@ -1,404 +0,0 @@
SSIREQ01 TITLE '- DOCUMENTATION'
SSIREQ01 AMODE 31
SSIREQ01 RMODE 24
SPLEVEL SET=4
*********************************************************************
* FUNCTION: THIS PROGRAM PERFORMS THE FOLLOWING FUNCTIONS: *
* *
* 1. REQUESTS A SYSOUT DATA SET FROM JES THROUGH A WRITER *
* NAME (SHOWS AN EXAMPLE OF USING ONE OF THE AVAILABLE *
* SELECTION CRITERIA TO INFLUENCE WHICH SYSOUT DATA SET *
* IS SELECTED). THIS PROGRAM IS INTENDED TO RUN ON JES3 *
* ONLY, AS IT SHOWS SELECTION CRITERIA AVAILABLE ONLY TO *
* JES3. (SPECIFICALLY, BIT SSSOHLD IS USED.) *
* 2. IF ONE IS NOT AVAILABLE, THE OPERATOR CAN WAIT UNTIL *
* ONE IS AVAILABLE, OR EXIT THE PROGRAM. *
* 3. IF ONE IS AVAILABLE, IT IS DYNAMICALLY ALLOCATED. *
* 4. EACH RECORD IS READ AND DISPLAYED TO THE OPERATOR. *
* 5. UPON END-OF-DATA, THE SYSOUT DATA SET IS DEALLOCATED. *
* THE SYSOUT CLASS IS CHANGED TO 'A', AND THE *
* DESTINATION IS CHANGED TO 'PRT803'. *
* (SHOWS AN EXAMPLE OF USING THE AVAILABLE DYNAMIC *
* ALLOCATION TEXT UNIT TO CHANGE THE ATTRIBUTES OF THE *
* RECEIVE SYSOUT DATA SET DURING UNALLOCATION.) *
* 6. THE PROGRAM THEN CYCLES BACK AND ASKS JES FOR THE NEXT *
* DATA SET (GOES TO STEP 1). *
* *
* NAME OF MODULE: SSIREQ01 *
* *
* REGISTER USE: *
* *
* 0 PARM REGISTER *
* 1 PARM REGISTER *
* 2 SSOB *
* 3 SSSO *
* 4 DCB *
* 5 RB *
* 6 MAX RECORD LENGTH *
* 7 DUMP CODE *
* 8 ABEND VALUE REGISTER *
* 9 IEFSSREQ RETURN CODES *
* 10 BASE REGISTER *
* 11 TEXT RECORD STRUCTURE PTR *
* 12 UNUSED *
* 13 SAVE AREA CHAIN REGISTER *
* 14 PARM REGISTER / RETURN ADDR *
* 15 PARM REGISTER / COND CODE *
* *
* ATTRIBUTES: SUPERVISOR STATE, AMODE(31), RMODE(24) *
* *
* *
* NOTE: THIS IS A SAMPLE. *
*********************************************************************
TITLE '- EQUATES'
*********************************************************************
* GENERAL EQUATES *
*********************************************************************
EQUHOBON EQU X'80000000' HIGH ORDER BIT ON
FF EQU X'FF' ALL BITS ON IN A BYTE
*********************************************************************
* AFTER COMPARE INSTRUCTIONS *
*********************************************************************
GT EQU 2 A HIGH
LT EQU 4 A LOW
NE EQU 7 A NOT EQUAL B
EQ EQU 8 A EQUAL B
GE EQU 11 A NOT LOW
LE EQU 13 A NOT HIGH
*
*********************************************************************
* AFTER ARITHMETIC INSTRUCTIONS *
*********************************************************************
OV EQU 1 OVERFLOW
PLUS EQU 2 PLUS
MINUS EQU 4 MINUS
NZERO EQU 7 NOT ZERO
ZERO EQU 8 ZERO
ZEROS EQU 8 ZERO
NMINUS EQU 11 NOT MINUS
NOV EQU 12 NOT OVERFLOW
NPLUS EQU 13 NOT PLUS
*
*********************************************************************
* AFTER TEST UNDER MASK INSTRUCTIONS *
*********************************************************************
ALLON EQU 1 ALL ON
MIXED EQU 4 MIXED
NALLOFF EQU 5 ALLON+MIXED
ALLOFF EQU 8 ALL OFF
NALLON EQU 12 ALLOFF+MIXED
*********************************************************************
* ABEND CODE INDICATIONS *
*********************************************************************
BADR15 EQU 1 IEFSSREQ R15 NON-ZERO
BADRETN EQU 2 SSOBRETN NON-ZERO AND NOT 8
BADS99A EQU 3 DYNALLOC ALLOC FAILED
BADOPEN EQU 4 OPEN DCB FAILED
BADS99U EQU 5 DYNALLOC UNALLC FAILED
BADRLEN EQU 6 PSO DATASET TOO LARGE (RECLEN)
*********************************************************************
* GENERAL PURPOSE REGISTERS *
*********************************************************************
R0 EQU 0 PARM REGISTER
R1 EQU 1 PARM REGISTER
R2 EQU 2 SSOB
R3 EQU 3 SSSO
R4 EQU 4 DCB
R5 EQU 5 RB
R6 EQU 6 MAX RECORD LENGTH
R7 EQU 7 DUMP CODE
R8 EQU 8 ABEND VALUE REGISTER
R9 EQU 9 RETURN CODES OR REASONS
R10 EQU 10 BASE REGISTER
R11 EQU 11 TEXT RECORD STRUCTURE PTR
R12 EQU 12 UNUSED
R13 EQU 13 SAVE AREA CHAIN REGISTER
R14 EQU 14 PARM REGISTER / RETURN ADDR
R15 EQU 15 PARM REGISTER / COND CODE
TITLE '- CVT - COMMUNICATIONS VECTOR TABLE'
CVT DSECT=YES,LIST=NO
TITLE 'DCBD'
DCBD DSORG=PS
TITLE '- IEFJESCT - JES CONTROL TABLE'
IEFJESCT TYPE=DSECT
TITLE '- SSOB'
IEFSSOBH
SSOBGN EQU * START OF FUNCTIONAL EXTENSION
TITLE '- SSSO'
IEFSSSO SOEXT=YES
TITLE '- IEFZB4D0 - SVC99 DSECTS'
IEFZB4D0
TITLE '- IEFZB4D2 - TU KEYS'
IEFZB4D2
*********************************************************************
* HOUSEKEEPING *
*********************************************************************
SSIREQ01 CSECT
SAVE (14,12) FORM ID
BALR R10,0 ESTABLISH BASE REG
USING *,R10 INFORM ASSEMBLER
LA R2,SA CHAIN SAVEAREAS
ST R13,4(R2) OLD IN NEW
ST R2,8(R13) NEW IN OLD
LR R13,R2 RECHAIN THE SAVE AREAS
TITLE '- PROCESS SYSOUT'
WTO 'SSI CODE 01 Version 1' LET OP KNOW WHAT LEVEL
STORAGE OBTAIN, GET STORAGE FOR SSOB/SSSO
LENGTH=SSOBLEN1,
COND=NO
LR R2,R1 SAVE BEGINNING OF STORAGE
USING SSOBEGIN,R2 INFORM ASSEMBLER
LA R3,SSOBGN PT TO BEGINNING OF SSSO
USING SSSOBGN,R3 INFORM ASSEMBLER
TITLE '- SSOB PROCESSING'
*********************************************************************
* NOW WORK ON THE SSOB. THE LIFE-OF-JOB IS USED HERE, SO THE *
* SSOBSSIB IS ZERO. *
*********************************************************************
XC SSOB(SSOBHSIZ),SSOB CLEAR THE SSOB
MVC SSOBID,=CL4'SSOB' SSOB INITIALS INTO SSOB
MVC SSOBFUNC,=AL2(SSOBSOUT) MOVE FUNCTION ID INTO SSOB
MVC SSOBLEN,=AL2(SSOBHSIZ) MOVE SIZE INTO SSOB
ST R3,SSOBINDV SAVE THE SSSO ADDRESS
TITLE '- SSSO PROCESSING'
*********************************************************************
* NOW WORK ON THE SSSO. SELECT A SELECTION CRITERIA BASED ON *
* AN EXTERNAL WRITER NAME OF 'ANDREW'. *
*********************************************************************
XC SSSOBGN(SSSOSIZE),SSSOBGN CLEAR THE SSSO
MVC SSSOLEN,=AL2(SSSOSIZE) SET THE SIZE OF THE SSSO
MVI SSSOVER,SSSOCVER SET THE VERSION NUMBER
OI SSSOFLG1,SSSOSPGM+SSSOHLD SELECT BY WRITER NAME AND
* THE HOLD QUEUE
OI SSSOFLGA,SSSOWTRN IND. THAT SELECTION IS BY
* WRITER NAME, NOT USERID
MVC SSSOPGMN,=CL8'ANDREW' IND. CORRECT WRITER NAME
* THAT IS USED AS SELECTION
OI SSSOFLG2,SSSOPSEE IND. LONG FORM OF IEFSSSO
*********************************************************************
* NOW GO TAP JES ON THE SHOULDER FOR A DATASET! *
*********************************************************************
NEXTDS DS 0H GET NEXT DSNAME FROM JES
MODESET MODE=SUP GET INTO SUPERVISOR STATE
LR R1,R2 R1=ADDRESS OF SSOB
O R1,=A(EQUHOBON) TURN ON THE HIGH-ORDER BIT
ST R1,MYSSOBPT SAVE POINTER FOR SSREQ
LA R1,MYSSOBPT POINT TO SSOB POINTER
IEFSSREQ , GO TO JES FOR A DATASET
MODESET MODE=PROB BACK TO PROBLEM STATE
LA R8,BADR15 ASSUME BAD REG 15 RETURN
LTR R9,R15 DID THE IEFSSREQ WORK OK?
BC NZERO,ABEND NOT GOOD...TAKE AN ABEND
LA R8,BADRETN ASSUME BAD SSOBRETN
ICM R9,B'1111',SSOBRETN CHECK OUT SSOBRETN
BC NZERO,TESTIT NON-ZERO, INVESTIGATE FURTHER
*********************************************************************
* WE HAVE A DATA SET. NOW DYNAMICALLY ALLOCATE IT, READ AND DISPLAY*
* THE RECORDS USING SEQUENTIAL ACCESS METHOD AS EXAMPLE OF HOW TO *
* RETRIEVE THE DATA. *
*********************************************************************
TITLE '- ALLOCATE RETURNED DATASET'
*********************************************************************
* ALLOCATE THE RETURNED SYSOUT DATASET *
*********************************************************************
LA R8,BADRLEN ASSUME SIZE TOO LARGE FOR WTO
SR R6,R6 CLEAR REG 6
ICM R6,B'0011',SSSOMLRL GET MAX RECORD LENGTH
CH R6,=H'150' IS MAX RCD LENGTH>150??
BC GT,ABEND YES - TIME FOR US TO GO HOME
STH R6,RECLEN SAVE MAX RECORD LENGTH
LA R5,MY99RB PT TO RB
USING S99RB,R5 ADDRESSABILITY TO THE RB
XC S99RB(RBLEN),S99RB ZERO THE RB
MVI S99RBLN,RBLEN RB LENGTH
MVI S99VERB,S99VRBAL RB VERB CODE=ALLOC
LA R1,MY99TPTA ADDR SVC 99 ALLOC TU PTRS
ST R1,S99TXTPP STORED IN RB
LA R1,MY99RBPT PT TO RB POINTER
MVC TXTDSNAM,SSSODSN MOVE DATASET NAME TO BE ALLOCATED
DYNALLOC ISSUE DYNAMIC ALLOCATION
LA R8,BADS99A ASSUME IT DIDN'T WORK
LR R9,R1 COPY FOR DUMP
LTR R15,R15 SVC 99 WORK OKAY??
BC NZERO,ABEND NO, TAKE A DUMP
*********************************************************************
* SYSOUT DATASET ALLOCATED OKAY. MOVE RETURNED DDNAME INTO *
* THE DCB PRIOR TO OPENING IT. *
*********************************************************************
LA R4,INDCB PT TO THE INPUT DCB
USING IHADCB,R4 ADDRESSABILITY
MVC DCBDDNAM(8),TXTDDA99 MOVE IN RETURNED DDNAME
MVC TXTDDU99,TXTDDA99 SAVE FOR UNALLOCATION
MVC DCBLRECL,SSSOMLRL MOVE MAX LENGTH RECORD IN
* *
OPEN INDCB OPEN THE DCB
LA R8,BADOPEN ASSUME THE OPEN FAILED
LR R9,R4 COPY FOR DUMP
TM DCBOFLGS,DCBOFOPN DID IT WORK?
BC ALLOFF,ABEND NOPE, TAKE A DUMP
TITLE '- GET THE RECORDS - DISPLAY TO PROGRAM'
GETNEXT DS 0H LOOP FOR READING/DISPLAYING
*********************************************************************
* SWITCH TO 24 BIT MODE FOR GET MACRO *
*********************************************************************
LA R15,SSITO24 SWITCH TO 24 BIT MODE ...
BSM 0,R15 ... FOR RESTRICTED MACRO
SSITO24 DS 0H
GET INDCB R1==> RECORD AFTER THE GET
L R15,SSITO31A RETURN TO 31 BIT MODE ...
BSM 0,R15 ... AND CONTINUE
SSITO31A DC A(SSITO31+EQUHOBON) FOR MODE SWITCHING
*********************************************************************
* RETURN TO 31 BIT MODE AND CONTINUE *
*********************************************************************
SSITO31 DS 0H
EX R6,MOVEIT MOVE UP TO 150 BYTES OF REC
LA R11,RECLEN POINT TO RECORD FOR OUTPUT
WTO TEXT=(11),ROUTCDE=11 DISPLAY TO JOBLOG
MVI RECTEXT,C' ' CLEAR RECORD OUT...
MVC RECTEXT+1(L'RECTEXT-1),RECTEXT ..FOR NEXT ONE
B GETNEXT GO GET NEXT RECORD
TITLE '- EODAD ROUTINE'
MYEODAD DS 0H END-OF-DATASET
CLOSE INDCB CLOSE THE INPUT DCB
DROP R4 IHADCB
*********************************************************************
* UNALLOCATE THE SYSOUT DATASET, CHANGING CLASS + DESTINATION *
*********************************************************************
XC S99RB(RBLEN),S99RB ZERO THE RB
MVI S99RBLN,RBLEN RB LENGTH
MVI S99VERB,S99VRBUN RB VERB CODE=UNALLOC
LA R1,MY99TPTU ADDR SVC 99 ALLOC TU PTRS
ST R1,S99TXTPP STORED IN RB
LA R1,MY99RBPT PT TO RB POINTER
DYNALLOC ISSUE DYNAMIC UNALLOCATION
LA R8,BADS99U ASSUME IT DIDN'T WORK
LR R9,R1 COPY FOR DUMP
LTR R15,R15 SVC 99 WORK OKAY??
BC NZERO,ABEND NO, TAKE A DUMP
B NEXTDS GO GET NEXT DATA SET
TITLE '- BAD RETURN FROM IEFSSREQ'
TESTIT DS 0H
*********************************************************************
* R8 HAS THE 'BADRETN' ASSUMPTION VALUE FOR POSSIBLE ABEND. *
* R9 HAS A NON-ZERO VALUE FROM SSOBRETN FROM THE IEFSSREQ. *
*********************************************************************
CH R9,NOMORE END OF DATA SET RETURN?
BC NE,ABEND NOPE - QUIT!
*********************************************************************
* WE RECEIVED THE END-OF-DATA CONDITION. ASK WHETHER WE *
* SHOULD WAIT ON RETURNED ECB, OR COMPLETE NOW, *
*********************************************************************
XC MYECB,MYECB CLEAR THE ECB
WTOR 'ENTER 'W' OR WAIT, ANYTHING ELSE TO EXIT',
MYREPLY,
1,
MYECB
WAIT ECB=MYECB
OI MYREPLY,C' ' FORCE REPLY TO UPPER CASE
CLI MYREPLY,C'W' SHOULD WE WAIT?
BC NE,EXIT NO, EXIT
*********************************************************************
* WAIT INDICATED. SET UP WAIT ON THE RETURNED ECB. *
*********************************************************************
MODESET KEY=ZERO GET INTO KEY 0
L R1,SSSOWTRC POINT TO RETURNED DATA AREA
WAIT ECB=(1) R1==>RETURNED WAIT-FOR ECB
MODESET KEY=NZERO BACK TO ORIGINAL
B NEXTDS WE'RE POSTED - GO GET IT!
TITLE '- CLOSE OUT ROUTINES'
EXIT DS 0H FINAL CALL, RETURN TO MVS
MVI SSSOFLG2,SSSOCTRL IND. FINAL CALL TO JES
MODESET MODE=SUP GET INTO SUPERVISOR STATE
LA R1,MYSSOBPT POINT TO SSOB POINTER
IEFSSREQ , GO TO JES FOR GIVE BACK
MODESET MODE=PROB BACK TO PROBLEM STATE....
STORAGE RELEASE, FREE SSOB/SSSO
LENGTH=SSOBLEN1,
ADDR=(R2) HERE'S WHERE IT LIVES
L R13,4(,R13) OLD SA PTR
RETURN (14,12),RC=0 BACK TO MVS
TITLE '- ABEND ROUTINES'
*********************************************************************
* THIS IS THE ABEND ROUTINE. R8 CONTAINS THE PROGRAM REASON CODE, *
* R9 CONTAINS SPECIFIC ERROR/REASON CODE AS RETURNED BY THE *
* SERVICE ROUTINE. *
*********************************************************************
ABEND DS 0H ISSUE THE ABEND MACRO
ABEND (8),DUMP,STEP TAKE A DUMP IF WANTED
TITLE '- DATA AREAS'
SA DS 9D SAVE AREAS
MYECB DS F DOUBLEWORD FOR WTOR
*
MYREPLY DS CL1 REPLY AREA FOR WTORS
RESRV DS XL3 ROUND TO FULL WORD
TITLE '- DYNALLOC DATA'
*********************************************************************
* THE FOLLOWING CONTROL BLOCKS ARE FOR DYNAMIC ALLOCATION AND *
* UNALLOCATION. *
*********************************************************************
* S99 REQUEST BLOCK POINTER *
*********************************************************************
MY99RBPT DC A(EQUHOBON+MY99RB) S99 RB PTR
*********************************************************************
* S99 REQUEST BLOCK *
*********************************************************************
MY99RB DS CL(RBLEN) MY SVC 99 RB
RBLEN EQU (S99RBEND-S99RB) LENGTH OF RB FOR MY99RB
*********************************************************************
* TEXT UNIT POINTERS FOR ALLOCATION *
*********************************************************************
MY99TPTA DC A(TXTDALDS) TU FOR DATASET NAME
DC A(TXTSSREQ) NAME OF SUBSYSTEM TU PTR
DC A(EQUHOBON+TXTRTDDN) RETURN DD NAME TU
*********************************************************************
* TEXT UNIT POINTERS FOR UNALLOCATION *
*********************************************************************
MY99TPTU DC A(TXTDUNDD) TU FOR UNALLOC BY DDNAME
DC A(TXTDUNNH) NOHOLD TU
DC A(TXTDUNCL) CHANGE THE CLASS TU
DC A(EQUHOBON+TXTDUNDS) CHANGE THE DEST TU
*********************************************************************
* TEXT UNITS FOR ALLOCATION *
*********************************************************************
TXTDALDS DC AL2(DALDSNAM) DATASET NAME KEY
DC X'0001' NUMBER
DC AL2(44) DSNAME LENGTH
TXTDSNAM DS CL44' ' DSNAME FROM IEFSSREQ
TXTCLOSE DC AL2(DALCLOSE) UNALLOCATE AT CLOSE KEY
DC X'0000' # FIELD (0000 REQUIRED)
TXTSSREQ DC AL2(DALSSREQ) REQUEST OF SUBSYSTEM
DC X'0001' # FIELD (0001 REQUIRED)
DC X'0004' LEN OF SS NAME FOLLOWING
DC CL4'JES3' NAME OF SUBSYSTEM
TXTRTDDN DC AL2(DALRTDDN) RETURN DDNAME FIELD
DC X'0001' # FIELD (0001 REQUIRED)
DC X'0008' LEN OF PARM
TXTDDA99 DC CL8' ' RETURNED DDNAME PARM FIELD
*********************************************************************
* TEXT UNITS FOR UNALLOCATION *
*********************************************************************
TXTDUNDD DC AL2(DUNDDNAM) TU FOR DDNAME UNALLOC
DC X'0001' NUMBER
DC AL2(8) DDNAME LENGTH
TXTDDU99 DS CL8' ' DDNAME FROM DYNALLOC
TXTDUNNH DC AL2(DUNOVSNH) TU FOR NOHOLD
DC X'0000' # FIELD (0000 REQUIRED)
TXTDUNCL DC AL2(DUNOVCLS) TU FOR CHANGE OF CLASS
DC X'0001' # FIELD (0001 REQUIRED)
DC X'0001' LEN OF SYSOUT CLASS
DC CL1'A' CHANGED SYSOUT CLASS
TXTDUNDS DC AL2(DUNOVSUS) TU FOR CHANGE OF REMOTE
DC X'0001' # FIELD (0001 REQUIRED)
DC X'0008' LEN OF CHANGED REMOTE
DC CL8'PRT803' CHANGED REMOTE NAME
MYSSOBPT DS F POINTER TO SSOB FOR IEFSSREQ
NOMORE DC AL2(SSSOEODS) NO MORE DATASETS FROM JES
MOVEIT MVC RECTEXT(*-*),0(R1) OBJ OF AN EXECUTE
RECLEN DS H LENGTH OF OUTPUT RECORD
RECTEXT DS CL150 UP TO 150 BYTES OF SYSOUT
INDCB DCB DSORG=PS,MACRF=GL,BUFNO=2,EODAD=MYEODAD, X
DDNAME=WILLCHNG
TITLE '- LITERALS'
LTORG ,
END

0
src/crent370/asm/ssireq01.o
View File

20
src/crent370/clib/'mdr.httpd.h'
View File

@ -1,20 +0,0 @@

20
src/crent370/clib/@@64add.c
View File

@ -1,20 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_add'");
void __64_add(__64* a, __64* b, __64* c)
{
__64_DTYPE_TMP tmp;
int carry = 0;
int i;
if (a && b && c) {
for (i = __64_ARRAY_SIZE - 1; i >=0 ; i--) {
tmp = (__64_DTYPE_TMP)a->array[i] + b->array[i] + carry;
carry = (tmp > __64_MAX_VAL);
c->array[i] = (tmp & __64_MAX_VAL);
}
}
}

0
src/crent370/clib/@@64add.o
View File

83
src/crent370/clib/@@64add.s
View File

@ -1,83 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64add.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_add'
* Program text area
DS 0F
EJECT
* external function '__64_add' prologue
* frame base=88, local stack=0, call args=0
&FUNC SETC '__64_add'
@@64ADD PDPPRLG CINDEX=0,FRAME=88,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_add' code
L 7,0(11) ==> a
L 6,4(11) ==> b
L 5,8(11) ==> c
SLR 4,4 ==> carry
LTR 7,7 ==> a
BE @@L1
LTR 6,6 ==> b
BE @@L1
LTR 5,5 ==> c
BE @@L1
LA 15,3(0,0) ==> i
@@L8 EQU *
LR 2,15 ==> i
MH 2,=H'2'
LH 3,0(2,7) ==> .array
N 3,=XL4'0000FFFF'
LH 2,0(2,6) ==> .array
N 2,=XL4'0000FFFF'
AR 3,2
LR 2,3 ==> tmp
AR 2,4 ==> tmp,carry
SLR 4,4 ==> carry
L 3,=F'65535'
CLR 2,3 ==> tmp
BNH @@L7
LA 4,1(0,0) ==> carry
@@L7 EQU *
LR 3,15 ==> i
MH 3,=H'2'
N 2,=F'65535'
STH 2,0(3,5) ==> .array
BCTR 15,0 ==> i
LTR 15,15 ==> i
BNL @@L8
@@L1 EQU *
* Function '__64_add' epilogue
PDPEPIL
* Function '__64_add' literal pool
DS 0D
LTORG
* Function '__64_add' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

21
src/crent370/clib/@@64ai32.c
View File

@ -1,21 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_add_i32'");
void __64_add_i32(__64* a, int32_t b, __64* c)
{
__64 tmp;
if (a && c) {
/* make tmp value positive */
__64_from_u32(&tmp, (uint32_t) (b < 0 ? -b : b));
if (b < 0) {
__64_sub(a, &tmp, c);
}
else {
__64_add(a, &tmp, c);
}
}
}

0
src/crent370/clib/@@64ai32.o
View File

81
src/crent370/clib/@@64ai32.s
View File

@ -1,81 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64ai32.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_add_i32'
* Program text area
DS 0F
EJECT
* external function '__64_add_i32' prologue
* frame base=88, local stack=8, call args=16
&FUNC SETC '__64_add_i32'
@@64AI32 PDPPRLG CINDEX=0,FRAME=112,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_add_i32' code
L 3,0(11) ==> a
L 5,4(11) ==> b
L 4,8(11) ==> c
LTR 3,3 ==> a
BE @@L1
LTR 4,4 ==> c
BE @@L1
LA 2,104(,13)
ST 2,88(13)
LPR 2,5 ==> b
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64FU32)
BALR 14,15
LTR 5,5 ==> b
BNL @@L3
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 4,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64SUB)
BALR 14,15
B @@L1
@@L3 EQU *
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 4,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64ADD)
BALR 14,15
@@L1 EQU *
* Function '__64_add_i32' epilogue
PDPEPIL
* Function '__64_add_i32' literal pool
DS 0D
LTORG
* Function '__64_add_i32' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

20
src/crent370/clib/@@64and.c
View File

@ -1,20 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_and'");
void __64_and(__64* a, __64* b, __64* c)
{
if (a && b && c) {
#if 1 /* gccmvs can AND 64 bit values */
c->u64 = a->u64 & b->u64;
#else
int i;
for (i = 0; i < __64_ARRAY_SIZE; ++i) {
c->array[i] = (a->array[i] & b->array[i]);
}
#endif
}
}

0
src/crent370/clib/@@64and.o
View File

64
src/crent370/clib/@@64and.s
View File

@ -1,64 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64and.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_and'
* Program text area
DS 0F
EJECT
* external function '__64_and' prologue
* frame base=88, local stack=0, call args=0
&FUNC SETC '__64_and'
@@64AND PDPPRLG CINDEX=0,FRAME=88,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_and' code
L 4,0(11) ==> a
L 15,4(11) ==> b
L 5,8(11) ==> c
LTR 4,4 ==> a
BE @@L1
LTR 15,15 ==> b
BE @@L1
LTR 5,5 ==> c
BE @@L1
L 2,0(4) ==> .u64
N 2,0(15) ==> .u64
L 3,4(4) ==> .u64
N 3,4(15) ==> .u64
ST 2,0(5) ==> .u64
ST 3,4+0(5) ==> .u64
@@L1 EQU *
* Function '__64_and' epilogue
PDPEPIL
* Function '__64_and' literal pool
DS 0D
LTORG
* Function '__64_and' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

15
src/crent370/clib/@@64au32.c
View File

@ -1,15 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_add_u32'");
void __64_add_u32(__64* a, uint32_t b, __64* c)
{
__64 tmp;
if (a && c) {
__64_from_u32(&tmp, b);
__64_add(a, &tmp, c);
}
}

0
src/crent370/clib/@@64au32.o
View File

68
src/crent370/clib/@@64au32.s
View File

@ -1,68 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64au32.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_add_u32'
* Program text area
DS 0F
EJECT
* external function '__64_add_u32' prologue
* frame base=88, local stack=8, call args=16
&FUNC SETC '__64_add_u32'
@@64AU32 PDPPRLG CINDEX=0,FRAME=112,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_add_u32' code
L 3,0(11) ==> a
L 4,8(11) ==> c
LTR 3,3 ==> a
BE @@L1
LTR 4,4 ==> c
BE @@L1
LA 2,104(,13)
ST 2,88(13)
MVC 92(4,13),4(11) ==> b
LA 1,88(,13)
L 15,=V(@@64FU32)
BALR 14,15
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 4,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64ADD)
BALR 14,15
@@L1 EQU *
* Function '__64_add_u32' epilogue
PDPEPIL
* Function '__64_add_u32' literal pool
DS 0D
LTORG
* Function '__64_add_u32' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

15
src/crent370/clib/@@64au64.c
View File

@ -1,15 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_add_u64'");
void __64_add_u64(__64* a, uint64_t b, __64* c)
{
__64 tmp;
if (a && c) {
__64_from_u64(&tmp, b);
__64_add(a, &tmp, c);
}
}

0
src/crent370/clib/@@64au64.o
View File

71
src/crent370/clib/@@64au64.s
View File

@ -1,71 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64au64.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_add_u64'
* Program text area
DS 0F
EJECT
* external function '__64_add_u64' prologue
* frame base=88, local stack=8, call args=16
&FUNC SETC '__64_add_u64'
@@64AU64 PDPPRLG CINDEX=0,FRAME=112,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_add_u64' code
L 3,0(11) ==> a
L 4,4(11) ==> b
L 5,4+4(11) ==> b
L 6,12(11) ==> c
LTR 3,3 ==> a
BE @@L1
LTR 6,6 ==> c
BE @@L1
LA 2,104(,13)
ST 2,88(13)
ST 4,92(13) ==> b
ST 5,4+92(13) ==> b
LA 1,88(,13)
L 15,=V(@@64FU64)
BALR 14,15
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 6,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64ADD)
BALR 14,15
@@L1 EQU *
* Function '__64_add_u64' epilogue
PDPEPIL
* Function '__64_add_u64' literal pool
DS 0D
LTORG
* Function '__64_add_u64' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

14
src/crent370/clib/@@64ci32.c
View File

@ -1,14 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_cmp_i32'");
int __64_cmp_i32(__64* a, int32_t b)
{
__64 tmp;
__64_from_i32(&tmp, b);
return __64_cmp(a, &tmp);
}

0
src/crent370/clib/@@64ci32.o
View File

60
src/crent370/clib/@@64ci32.s
View File

@ -1,60 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64ci32.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_cmp_i32'
* Program text area
DS 0F
EJECT
* external function '__64_cmp_i32' prologue
* frame base=88, local stack=8, call args=8
&FUNC SETC '__64_cmp_i32'
@@64CI32 PDPPRLG CINDEX=0,FRAME=104,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_cmp_i32' code
LA 2,96(,13)
ST 2,88(13)
MVC 92(4,13),4(11) ==> b
LA 1,88(,13)
L 15,=V(@@64FI32)
BALR 14,15
MVC 88(4,13),0(11) ==> a
LA 2,96(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64CMP)
BALR 14,15
* Function '__64_cmp_i32' epilogue
PDPEPIL
* Function '__64_cmp_i32' literal pool
DS 0D
LTORG
* Function '__64_cmp_i32' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

52
src/crent370/clib/@@64cmp.c
View File

@ -1,52 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_cmp'");
int __64_cmp(__64* a, __64* b)
{
int i;
if (a && b) {
#if 1 /* gccmvs can compare 64 bit values */
__asm__("DS\t0H\tif (a->u64 > b->u64) return __64_LARGER;");
if (a->u64 > b->u64) return __64_LARGER;
__asm__("DS\t0H\tif (a->u64 < b->u64) return __64_SMALLER;");
if (a->u64 < b->u64) return __64_SMALLER;
#else
for(i=0; i < __64_ARRAY_SIZE; i++) {
if (a->array[i] > b->array[i]) {
return __64_LARGER;
}
else if (a->array[i] < b->array[i]) {
return __64_SMALLER;
}
}
#endif
}
__asm__("DS\t0H\treturn __64_EQUAL;");
return __64_EQUAL;
}
#if 0
int __64_cmp(__64* a, __64* b)
{
if (a && b) {
int i = __64_ARRAY_SIZE;
do {
i -= 1; /* Decrement first, to start with last array element */
if (a->array[i] > b->array[i]) {
return __64_LARGER;
}
else if (a->array[i] < b->array[i]) {
return __64_SMALLER;
}
} while (i != 0);
}
return __64_EQUAL;
}
#endif

0
src/crent370/clib/@@64cmp.o
View File

81
src/crent370/clib/@@64cmp.s
View File

@ -1,81 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64cmp.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_cmp'
* Program text area
DS 0F
EJECT
* external function '__64_cmp' prologue
* frame base=88, local stack=0, call args=0
&FUNC SETC '__64_cmp'
@@64CMP PDPPRLG CINDEX=0,FRAME=88,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_cmp' code
L 3,0(11) ==> a
L 15,4(11) ==> b
LTR 3,3 ==> a
BE @@L2
LTR 15,15 ==> b
BE @@L2
DS 0H if (a->u64 > b->u64) return __64_LARGER;
L 2,0(3) ==> .u64
CL 2,0(15) ==> .u64
BH @@L4
BNE @@L3
L 2,4(3) ==> .u64
CL 2,4(15) ==> .u64
BNH @@L3
@@L4 EQU *
LA 15,1(0,0)
B @@L1
@@L3 EQU *
DS 0H if (a->u64 < b->u64) return __64_SMALLER;
L 2,0(15) ==> .u64
CL 2,0(3) ==> .u64
BH @@L6
BNE @@L2
L 2,4(15) ==> .u64
CL 2,4(3) ==> .u64
BNH @@L2
@@L6 EQU *
L 15,=F'-1'
B @@L1
@@L2 EQU *
DS 0H return __64_EQUAL;
SLR 15,15
@@L1 EQU *
* Function '__64_cmp' epilogue
PDPEPIL
* Function '__64_cmp' literal pool
DS 0D
LTORG
* Function '__64_cmp' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

20
src/crent370/clib/@@64copy.c
View File

@ -1,20 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_copy'");
void __64_copy(__64 *src, __64* dst)
{
if (src && dst) {
#if 1 /* gccmvs can copy 64 bit values */
dst->u64 = src->u64;
#else
int i;
for (i = 0; i < __64_ARRAY_SIZE; ++i) {
dst->array[i] = src->array[i];
}
#endif
}
}

0
src/crent370/clib/@@64copy.o
View File

56
src/crent370/clib/@@64copy.s
View File

@ -1,56 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64copy.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_copy'
* Program text area
DS 0F
EJECT
* external function '__64_copy' prologue
* frame base=88, local stack=0, call args=0
&FUNC SETC '__64_copy'
@@64COPY PDPPRLG CINDEX=0,FRAME=88,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_copy' code
L 2,0(11) ==> src
L 15,4(11) ==> dst
LTR 2,2 ==> src
BE @@L1
LTR 15,15 ==> dst
BE @@L1
MVC 0(8,15),0(2) ==> .u64
@@L1 EQU *
* Function '__64_copy' epilogue
PDPEPIL
* Function '__64_copy' literal pool
DS 0D
LTORG
* Function '__64_copy' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

14
src/crent370/clib/@@64cu32.c
View File

@ -1,14 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_cmp_u32'");
int __64_cmp_u32(__64* a, uint32_t b)
{
__64 tmp;
__64_from_u32(&tmp, b);
return __64_cmp(a, &tmp);
}

0
src/crent370/clib/@@64cu32.o
View File

60
src/crent370/clib/@@64cu32.s
View File

@ -1,60 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64cu32.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_cmp_u32'
* Program text area
DS 0F
EJECT
* external function '__64_cmp_u32' prologue
* frame base=88, local stack=8, call args=8
&FUNC SETC '__64_cmp_u32'
@@64CU32 PDPPRLG CINDEX=0,FRAME=104,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_cmp_u32' code
LA 2,96(,13)
ST 2,88(13)
MVC 92(4,13),4(11) ==> b
LA 1,88(,13)
L 15,=V(@@64FU32)
BALR 14,15
MVC 88(4,13),0(11) ==> a
LA 2,96(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64CMP)
BALR 14,15
* Function '__64_cmp_u32' epilogue
PDPEPIL
* Function '__64_cmp_u32' literal pool
DS 0D
LTORG
* Function '__64_cmp_u32' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

14
src/crent370/clib/@@64cu64.c
View File

@ -1,14 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_cmp_u64'");
int __64_cmp_u64(__64* a, uint64_t b)
{
__64 tmp;
__64_from_u64(&tmp, b);
return __64_cmp(a, &tmp);
}

0
src/crent370/clib/@@64cu64.o
View File

60
src/crent370/clib/@@64cu64.s
View File

@ -1,60 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64cu64.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_cmp_u64'
* Program text area
DS 0F
EJECT
* external function '__64_cmp_u64' prologue
* frame base=88, local stack=8, call args=16
&FUNC SETC '__64_cmp_u64'
@@64CU64 PDPPRLG CINDEX=0,FRAME=112,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_cmp_u64' code
LA 2,104(,13)
ST 2,88(13)
MVC 92(8,13),4(11) ==> b
LA 1,88(,13)
L 15,=V(@@64FU64)
BALR 14,15
MVC 88(4,13),0(11) ==> a
LA 2,104(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64CMP)
BALR 14,15
* Function '__64_cmp_u64' epilogue
PDPEPIL
* Function '__64_cmp_u64' literal pool
DS 0D
LTORG
* Function '__64_cmp_u64' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

30
src/crent370/clib/@@64dec.c
View File

@ -1,30 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_dec'");
void __64_dec(__64* n)
{
if (n) {
#if 0 /* gccmvs can't decrement 64 bit values */
n->u64--;
#else
__64_DTYPE tmp; /* copy of n */
__64_DTYPE res;
int i;
for (i = __64_ARRAY_SIZE - 1; i >= 0; i--) {
tmp = n->array[i];
res = tmp - 1;
n->array[i] = res;
if (!(res > tmp)) {
/* no borrow needed, we're done */
break;
}
}
#endif
}
}

0
src/crent370/clib/@@64dec.o
View File

66
src/crent370/clib/@@64dec.s
View File

@ -1,66 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64dec.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_dec'
* Program text area
DS 0F
EJECT
* external function '__64_dec' prologue
* frame base=88, local stack=0, call args=0
&FUNC SETC '__64_dec'
@@64DEC PDPPRLG CINDEX=0,FRAME=88,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_dec' code
L 5,0(11) ==> n
LTR 5,5 ==> n
BE @@L1
LA 15,3(0,0) ==> i
@@L8 EQU *
LR 2,15 ==> i
MH 2,=H'2'
LH 4,0(2,5) ==> tmp,array
LR 3,4 ==> res,tmp
BCTR 3,0 ==> res
STH 3,0(2,5) ==> res,array
STH 4,80(,13) ==> tmp
CLM 3,3,80(13) ==> res
BNH @@L1
BCTR 15,0 ==> i
LTR 15,15 ==> i
BNL @@L8
@@L1 EQU *
* Function '__64_dec' epilogue
PDPEPIL
* Function '__64_dec' literal pool
DS 0D
LTORG
* Function '__64_dec' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

20
src/crent370/clib/@@64di32.c
View File

@ -1,20 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_div_i32'");
void __64_div_i32(__64* a, int32_t b, __64* c)
{
__64 tmp;
if (a && c) {
__64_from_u32(&tmp, (uint32_t) (b < 0 ? -b : b));
if (b < 0) {
__64_mul(a, &tmp, c);
}
else {
__64_div(a, &tmp, c);
}
}
}

0
src/crent370/clib/@@64di32.o
View File

81
src/crent370/clib/@@64di32.s
View File

@ -1,81 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64di32.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_div_i32'
* Program text area
DS 0F
EJECT
* external function '__64_div_i32' prologue
* frame base=88, local stack=8, call args=16
&FUNC SETC '__64_div_i32'
@@64DI32 PDPPRLG CINDEX=0,FRAME=112,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_div_i32' code
L 3,0(11) ==> a
L 5,4(11) ==> b
L 4,8(11) ==> c
LTR 3,3 ==> a
BE @@L1
LTR 4,4 ==> c
BE @@L1
LA 2,104(,13)
ST 2,88(13)
LPR 2,5 ==> b
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64FU32)
BALR 14,15
LTR 5,5 ==> b
BNL @@L3
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 4,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64MUL)
BALR 14,15
B @@L1
@@L3 EQU *
ST 3,88(13) ==> a
LA 2,104(,13)
ST 2,92(13)
ST 4,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64DIV)
BALR 14,15
@@L1 EQU *
* Function '__64_div_i32' epilogue
PDPEPIL
* Function '__64_div_i32' literal pool
DS 0D
LTORG
* Function '__64_div_i32' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

87
src/crent370/clib/@@64div.c
View File

@ -1,87 +0,0 @@
#include <stdio.h>
#include <string.h>
#include <clib64.h>
__asm__("\n&FUNC SETC '__64_div'");
void __64_div(__64* a, __64* b, __64* c)
{
__64 current;
__64 denom;
__64 tmp;
const __64_DTYPE_TMP half_max = 1 + (__64_DTYPE_TMP)(__64_MAX_VAL / 2);
int overflow = 0;
if (a && b && c) {
__64_from_i32(&current, 1); // int current = 1;
__64_assign(&denom, b); // denom = b
__64_assign(&tmp, a); // tmp = a
#if 0
wtodumpf(&current, sizeof(__64), "%s: current", __func__);
wtodumpf(&denom, sizeof(__64), "%s: denom", __func__);
wtodumpf(&tmp, sizeof(__64), "%s: tmp", __func__);
wtof("%s: half_max=%u", __func__, half_max);
wtof("%s: while (__64_cmp(&denom, a) != __64_LARGER) {", __func__);
#endif
while (__64_cmp(&denom, a) != __64_LARGER) { // while (denom <= a) {
if (denom.array[0] >= half_max) {
overflow = 1;
break;
}
__64_lshift_one_bit(&current); // current <<= 1;
/* wtodumpf(&current, sizeof(__64), "%s: current <<=1", __func__); */
__64_lshift_one_bit(&denom); // denom <<= 1;
/* wtodumpf(&denom, sizeof(__64), "%s: denom <<=1", __func__); */
}
#if 0
wtof("%s: }", __func__);
wtof("%s: if (!overflow) { // overflow=%d", __func__, overflow);
#endif
if (!overflow) {
__64_rshift_one_bit(&denom); // denom >>= 1;
/* wtodumpf(&denom, sizeof(__64), "%s: denom >>=1", __func__); */
__64_rshift_one_bit(&current); // current >>= 1;
/* wtodumpf(&current, sizeof(__64), "%s: current >>=1", __func__); */
}
/* wtof("%s: }", __func__); */
__64_init(c); // int answer = 0;
#if 0
wtodumpf(c, sizeof(__64), "%s: c", __func__);
wtof("%s: while (!__64_is_zero(&current)) {", __func__);
#endif
while (!__64_is_zero(&current)) { // while (current != 0)
/* wtof("%s: if (__64_cmp(&tmp, &denom) != __64_SMALLER) {", __func__); */
if (__64_cmp(&tmp, &denom) != __64_SMALLER) { // if (dividend >= denom)
#if 0
wtof("%s: __64_sub()", __func__);
wtodumpf(&tmp, sizeof(__64), "%s: tmp", __func__);
wtodumpf(&denom, sizeof(__64), "%s: denom", __func__);
#endif
__64_sub(&tmp, &denom, &tmp); // dividend -= denom;
#if 0
wtodumpf(&tmp, sizeof(__64), "%s: tmp", __func__);
wtof("%s: __64_or()", __func__);
wtodumpf(c, sizeof(__64), "%s: c", __func__);
wtodumpf(&current, sizeof(__64), "%s: current", __func__);
#endif
__64_or(c, &current, c); // answer |= current;
/* wtodumpf(c, sizeof(__64), "%s: c", __func__); */
}
/* wtof("%s: }", __func__); */
__64_rshift_one_bit(&current); // current >>= 1;
/* wtodumpf(&current, sizeof(__64), "%s: current >>=1", __func__); */
__64_rshift_one_bit(&denom); // denom >>= 1;
/* wtodumpf(&denom, sizeof(__64), "%s: denom >>=1", __func__); */
} // return answer;
/* wtof("%s: }", __func__); */
}
}

0
src/crent370/clib/@@64div.o
View File

170
src/crent370/clib/@@64div.s
View File

@ -1,170 +0,0 @@
TITLE '/home/projects/crent370/clib/@@64div.c'
COPY PDPTOP
CSECT
* GNU C version 3.2.3 - c2asm370 version 1.0 (mvs)
* compiled by GNU C version 11.4.0.
*
* options passed: -lang-c -I. -I/home/projects/crent370/include
* -iprefix -D__GNUC__=3 -D__GNUC_MINOR__=2 -D__GNUC_PATCHLEVEL__=3
* -D__GXX_ABI_VERSION=102 -D__GCC__ -D__MVS__ -D__GCC__ -D__MVS__
* -Asystem=mvs -Acpu=i370 -Amachine=i370 -D__OPTIMIZE__
* -D__STDC_HOSTED__=1 -trigraphs -O1 -fverbose-asm
*
* options enabled: -fdefer-pop -fthread-jumps -fpeephole
* -ffunction-cse -fkeep-static-consts -fpcc-struct-return -fgcse-lm
* -fgcse-sm -fsched-interblock -fsched-spec -fbranch-count-reg
* -fcprop-registers -fcommon -fverbose-asm -fgnu-linker
* -fargument-alias -fmerge-constants -fident
* -fguess-branch-probability -fmath-errno -ftrapping-math
* -mchar-instructions -mno-pickax -mno-constants-first
*
&FUNC SETC '__64_div'
* Program text area
DS 0F
EJECT
* external function '__64_div' prologue
* frame base=88, local stack=24, call args=16
&FUNC SETC '__64_div'
@@64DIV PDPPRLG CINDEX=0,FRAME=128,BASER=12,ENTRY=YES
B @@FEN0
LTORG
@@FEN0 EQU *
DROP 12
BALR 12,0
USING *,12
@@PG0 EQU *
LR 11,1
L 10,=A(@@PGT0)
* Function '__64_div' code
L 3,0(11) ==> a
L 4,4(11) ==> b
L 5,8(11) ==> c
SLR 6,6 ==> overflow
LTR 3,3 ==> a
BE @@L1
LTR 4,4 ==> b
BE @@L1
LTR 5,5 ==> c
BE @@L1
LA 2,104(,13)
ST 2,88(13)
MVC 92(4,13),=F'1'
LA 1,88(,13)
L 15,=V(@@64FI32)
BALR 14,15
ST 4,88(13) ==> b
LA 2,112(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64COPY)
BALR 14,15
ST 3,88(13) ==> a
LA 2,120(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64COPY)
BALR 14,15
B @@L3
@@L7 EQU *
LH 2,112(13)
CLM 2,3,=H'32767'
BNH @@L6
LA 6,1(0,0) ==> overflow
B @@L4
@@L6 EQU *
LA 2,104(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64LSH1)
BALR 14,15
LA 2,112(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64LSH1)
BALR 14,15
@@L3 EQU *
LA 2,112(,13)
ST 2,88(13)
ST 3,92(13) ==> a
LA 1,88(,13)
L 15,=V(@@64CMP)
BALR 14,15
LA 2,1(0,0)
CLR 15,2
BNE @@L7
@@L4 EQU *
LTR 6,6 ==> overflow
BNE @@L8
LA 2,112(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64RSH1)
BALR 14,15
LA 2,104(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64RSH1)
BALR 14,15
@@L8 EQU *
ST 5,88(13) ==> c
LA 1,88(,13)
L 15,=V(@@64INIT)
BALR 14,15
B @@L9
@@L13 EQU *
LA 2,120(,13)
ST 2,88(13)
LA 2,112(,13)
ST 2,92(13)
LA 1,88(,13)
L 15,=V(@@64CMP)
BALR 14,15
L 2,=F'-1'
CLR 15,2
BE @@L12
LA 2,120(,13)
ST 2,88(13)
LA 2,112(,13)
ST 2,92(13)
LA 2,120(,13)
ST 2,96(13)
LA 1,88(,13)
L 15,=V(@@64SUB)
BALR 14,15
ST 5,88(13) ==> c
LA 2,104(,13)
ST 2,92(13)
ST 5,96(13) ==> c
LA 1,88(,13)
L 15,=V(@@64OR)
BALR 14,15
@@L12 EQU *
LA 2,104(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64RSH1)
BALR 14,15
LA 2,112(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64RSH1)
BALR 14,15
@@L9 EQU *
LA 2,104(,13)
ST 2,88(13)
LA 1,88(,13)
L 15,=V(@@64IS0)
BALR 14,15
LTR 15,15
BE @@L13
@@L1 EQU *
* Function '__64_div' epilogue
PDPEPIL
* Function '__64_div' literal pool
DS 0D
LTORG
* Function '__64_div' page table
@@PGT0 DS 0F
DC A(@@PG0)
END

Some files were not shown because too many files have changed in this diff Show More