* THIS WAS DEVELOPED ON Z390. TO USE IT IN AN MVS ENVIRONMENT,
* THE DCB'S WILL HAVE TO BE UPDATED. YOU'LL WANT TO TAKE THE
* RECFM + LRECL OFF THE //OUT FILE, SO THAT THE PGM CAN COPY
* THEM FROM THE //IN FILE. (TAKE 'EM OFF SYSIN TOO.)
* IF THERE ARE OTHER QUESTIONS, LET ME KNOW.
*
* YOU'LL ALSO WANT TO:
* REMOVE ALL THE WTO INSTRUCTIONS
* TAKE THE @@PAD STUFF OUT AT THE TNE. IT'S FOR TESTING.
* ADD A DCBD MACRO TO GET IHADCB LABELS.
*
* IN Z390, I NEED TO DO MOVE MODE READS. I THINK YOU CAN
* CHANGE THAT TO MACRF=GL IM MVS. IT SHOULD WORK JUST FINE.
*
* THE PUSH+POP PRINT STATEMENTS WERE SIMPLY TO SKIP THE DCB LABELS.
* YOU CAN REMOVE THEM. I WOULD BECAUSE I WANT TO SEE GENERATED CODE.
*
* OF LATE, I ALWAYS USE REG-13 AS BOTH BASE AND SAVE AREA AT THE
* START OF A PROGRAM. THAT DOES 2 THINGS:
* - SAVES A REG, WHICH ISN'T IMPORTANT TODAY, AND
* - MAKES LABEL OFFSETS MATCH PROGRAMLOCATIONS, WHICH I LIKE.
*
* C:\USERS\LIN\DOCUMENTS\Z390CODE\ADSTRING
*
ADDFIELD START 0
USING *,13
STM 14,12,12(13)
ST 15,8(13)
ST 13,4(15)
LA 13,0(15)
L R2,0(R1)
* PARM='C"DEF",32,X"D1D2D3"'
LH R1,0(R2)
SH R1,=H'1' Q. PARM FIELD?
BNM *+14 YES, GO SAVE IT
MVC PARM(5),=C'SYSIN' NO, ASSUME //SYSIN
B OPENSYSP
*
MVC PARM(0),2(R2)
EX R1,*-6
B OPENSYSP
DW DC D'0'
DC 02F'0' REST OF THE SAVE AREA.
*
PUSH PRINT
PRINT NOGEN
OPENSYSP MVC DCBMSG(8),DCBDDNAM-IHADCB+SYSPRINT
OPEN (SYSPRINT,OUTPUT)
BAL R9,PUTLINE
LA R1,SYSPRINT
BAL R9,LISTDCB
MVC DCBMSG(8),DCBDDNAM-IHADCB+IN
OPEN (IN,INPUT)
LA R1,IN
BAL R9,LISTDCB
POP PRINT
*
LH R3,DCBLRECL-IHADCB+IN
LR R4,R3
SLL R4,1
LA R0,4000(R4)
ST R0,LGETMAIN
*
GETMAIN R,LV=(0) GET A 32K INPUT BUFFER
ST R1,AGETMAIN AND A 32K OUTPUT BUFFER.
LA R14,0(R1,R3)
ST R14,ARECORD
LA R15,2000(R14)
ST R15,ALIST
A R1,LGETMAIN
ST R1,EGETMAIN
*
QSYSIN CLC =C'SYSIN',PARM PARM=SYSIN (OR NO PARM AT ALL)
BNE PARMBEG IMPLIES THAT THE CONTROL CARDS
MVC DCBMSG(8),DCBDDNAM-IHADCB+IN
OPEN (SYSIN,INPUT) WILL BE IN THE //SYSIN FILE.
LA R1,SYSIN
BAL R9,LISTDCB
MVC PARMWTO+4(5),=C'SYSIN'
GETIN1 GET SYSIN,PARM
CLI PARM,C'*'
BNH GETIN1
B PARMBEG OKAY, GO START PARM ANALYSIS
*
PARMBEG LA R8,PARM R8 = PARM
L R7,ALIST R7 = MVC LIST
*
PUT SYSPRINT,PARMWTO+4
B PARMLOOP
*
MORSYSIN TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN
BZ EOS
GET SYSIN,PARM
CLI PARM,C'*'
BNH MORSYSIN
CLI PARM,C' '
BNH MORSYSIN
*
PARMLOOP CLI 0(R8),C' ' END OF PARM? NOTE THAT THE PARM
BE MORSYSIN YES, TRY TO READ PROCESSING IS THE
CLI 0(R8),C'C' CHARACTER? NOTE THAT THE PARM
BE PARMCHAR YES, GO SAVE IT PROCESSING IS THE
CLI 0(R8),C'X' HEX? SAVE THAT MOST COMPLICATED PART
BE PARMHEX OF THIS PGM
CLI 0(R8),C'9' LENGTH OF
BH WHAT FILE TO COPY WHAT WE'LL DO IS CREATE
CLI 0(R8),C'0' BEFORE ADDING A TABLE THAT CONTAINS
BNL GETNUM FIELD. DATA LENGTH TO COPY,
CLC =C'SKIP=',0(R8)
BE SAVSKIP
WHAT CLC =C', ',0(R8) THIS INDICATES INTERSPERSED WITH
BE MORSYSIN THAT WE NEED SYSIN ENTRIES TO COPY CHAR
*
CLI 0(R8),C',' SOMETIMES WE OR HEX DATA FROM PARM.
BNE *+12 COME BACK AND
LA R8,1(R8) STILL POINT TO
B PARMLOOP THE END OF THE
CLI 1(R8),C',' PRIOR FIELD.
BNE *+12 -- FIX THAT --
LA R8,2(R8)
B PARMLOOP
BAL R14,BADPARM
* -----------------------------------------------
GETNUM LR R1,R8 FROM THE PARM, WE'LL EITHER
BAL R9,GET#1 HAVE A ## OF BYTES TO COPY,
SH R0,=H'1' OR A C"STRING" OR X"..."
BNM *+8
BAL R14,BADPARM
ST R0,0(R7) THIS SECTION DOES THE ## OF
MVI 0(R7),C'R' BYTES, AND WE INDICATE WITH
LA R7,4(R7) "R" THAT IT COMES FROM THE
MVI 0(R7),C'Z' INPUT RECORD, NOT THE PARM.
LA R8,1(R1)
B PARMLOOP
GET#1 SR R0,R0 CRAPPY % CONVERT, BECAUSE
IC R14,0(R1) I'M TOO LAZY TO
N R14,=F'15' WRITE A GOOD ONE.
MH R0,=H'10' IT'S ONLY USED A COUPLE
AR R0,R14 TIMES, SO WHO CARES!!!!
LA R1,1(R1)
CLI 0(R1),C'0'
BNL GET#1+2
BR R9
* -------------------------------------------
SAVSKIP LA R1,5(R8) WE WANT TO SKIP ## BYTES
CLI 0(R1),C'0' FROM THE INPUT FILE
BNL *+8
BAL R14,BADPARM
BAL R14,GET#1
ST R0,0(R7) SAVE THE ## TO SKIP
MVI 0(R7),C'S' AND THE 'SKIP' FLAG
LA R7,4(R7) BUMP REGS
LH R14,LLBB
SR R14,R1
STH R14,LLBB
LA R8,2(R1) AND LOOP.
B PARMLOOP
PARMCHAR CLI 1(R8),C'L'
BNE PARMC09
MVI 1(R7),C' '
PARMC01 MVI 0(R7),C'L' CL22,
LA R1,2(R8)
BAL R9,GET#1
LTR R0,R0
BZ CL00ERR
LH R14,LLBB
AR R14,R0
STH R14,LLBB
SH R0,=H'2'
STH R0,2(R7)
* ---------------------------------------------------------
CLI 0(R1),C',' THIS SECTION ALLOWS USER TO
BE PARMC08 SPECIFY C23, OR C23'R' TO
CLI 0(R1),C' ' SPECIFY THE CHAR TO INIT THE
BE PARMC08 SPACE.
CLI 0(R1),C'"' OR, X32, OR X32'C1' TO SPECIFY
BE PARMC03 THE HEX CHARACTER TO INIT THE
CLI 0(R1),C'''' SPACE.
BE PARMC03
BAL R14,BADPARM
*
PARMC03 CLI 0(R8),C'C' Q. CHAR?
BE PARMC07 YES, GO MOVE THAT CHAR.
TRT 1(2,R1),TESTHEX NO, TEST FOR GOOC HEX
BZ *+8
BAL R14,BADPARM
TR 1(2,R1),MAKEHEX TRANSLATE AND
PACK 12(2,R13),1(3,R1) PACK THE HEX TO 1 BYTE
MVC 1(1,R7),12(R13) AND MOVE TO LIST ENTRY
LA R1,4(R1) X23'AB' POINT TO 2ND QUOTE
B PARMC08 AND FINISH UP
*
PARMC07 MVC 1(1,R7),1(R1) SAVE CHAR
LA R1,3(R1) AND POINT TO 2ND QUOTE
* ---------------------------------------------------------
PARMC08 LA R7,4(R7) BUMP LIST ADDR
MVI 0(R7),C'Z' INDICATE END OF LIST
LA R8,1(R1) BUMP PAST COMMA
AP #FIELDS,=P'1' COUNT THE FIELD
B PARMLOOP AND LOOK FOR MORE.
* ---------------------------------------------------------
PARMC09 LA R3,1(R8) C'ABC' THIS IS THE C"STRING" STUFF.
PARMC10 LA R3,1(R3) WE SAVE IT
CLC SPACES(22),0(R3)
BE BADPARM
CLC 1(1,R8),0(R3)
BNE PARMC10
*
PARMC12 LR R4,R3 CALC LENGTH OF CHAR STRING
SR R4,R8
SH R4,=H'3' SUBT C" AND 1 MORE FOR EX
LA R1,2(R8) POINT TO CHAR STRING
QPSAV LA R14,9(R7,R4)
C R14,EGETMAIN
BNL TOOMANY
ST R4,0(R7) SAVE LENGTH IN LIST TABLE
MVC 4(0,R7),0(R1) SAVE IT
EX R4,*-6 (USE CORRECT LENGTH)
AP #FIELDS,=P'1' COUNT # FIELDS
MVI 0(R7),C'P' INDICATE THIS COMES FROM PARM
LA R8,2(R3) POINT TO NEXT PARM ..
LA R7,5(R7,R4) BUMP LIST POINTER
MVI 0(R7),C'Z' INDICATE END OF LIST
LH R2,LLBB LOAD VB LLBB LENGTH
LA R2,1(R4,R2) ADD LENGTH OF THIS STRING
STH R2,LLBB AND SAVE FOR I/O SECTION
QNEXTP CLC SPACES(12),0(R8) Q. END OF SELECT CRITERIA?
BNE PARMLOOP NO, LOOP.
B MORSYSIN
* --------------------------------------------------
PARMHEX MVI 1(R7),0
CLI 1(R8),C'L'
BE PARMC01
LA R3,2(R8) X"C1C2C3"
LA R4,12(R13)
LA R15,1(R4)
PARMHEXT TRT 0(2,R3),TESTHEX Q. VALID HEX? 2 BYTES AT A TIME
BZ *+8 YES.
BAL R14,BADHEX NO, ERROR
TR 0(2,R3),MAKEHEX MAKE IT HONEXT HEX
PACK 0(2,R4),0(3,R3) PACK IT TO 1 STRING BYTE
LA R3,2(R3) POINT TO NEXT PARM
LA R4,1(R4) AND NEXT DATA LOC
CLC SPACES(12),0(R3) Q. PREMATURE END?
BNE *+8 NO.
BAL R14,BADHEX YES, ERRORL
CLC 1(1,R8),0(R3) Q. END OF STRING?
BNE PARMHEXT NO, LOOP.
*
SR R4,R15 CALC DATA LENGTH-1
LA R1,12(R13)
B QPSAV
*
EOSM DC C'FIELD EXECUTE LIST USED ..... BYTES OF .,,.. AVAILABLE,X
GETMAIN LENGTH ....... '
EOS LR R0,R7
S R0,ALIST
CVD R0,12(R13)
L R0,ALIST
S R0,EGETMAIN
ST R0,LISTUSED
CVD R0,20(R13)
L R0,LGETMAIN
CVD R0,28(R13)
OI 19(R13),X'0F'
OI 27(R13),X'0F'
OI 35(R13),X'0F'
UNPK EOSM+24(5),17(3,R13)
UNPK EOSM+39(5),25(3,R13)
UNPK EOSM+71(7),32(4,R13)
MVC LINE(L'EOSM),EOSM
BAL R9,PUTLINE
*
PUSH PRINT
PRINT NOGEN
MVC DCBMSG(8),DCBDDNAM-IHADCB+OUT
OPEN (OUT,OUTPUT)
LA R1,OUT
BAL R9,LISTDCB
POP PRINT
B GET
* --------------------------------------
PUT L R2,AGETMAIN POINT TO NEW RECORD
TM DCBRECFM-IHADCB+OUT,X'80' RECFM=VB?
BO *+16 NO.
LH R0,0(R2) YES, ADD ## TO REC LEN
AH R0,LLBB
STH R0,0(R2)
*
PUT OUT,(2) WRITE
AP #RECORDS,=P'1' AND COUNT
*
GET L R2,ARECORD INPUT BUFFER
GET IN,(2) AND READ.
LH R5,DCBLRECL-IHADCB+IN LOAD LENGTH
TM DCBRECFM-IHADCB+IN,X'80' VB?
BO *+8 NO.
LH R5,0(R2) YES, LOAD FROM LLBB HEADER
LA R6,0(R2,R5) POIN TO END OF RECORD
*
L R3,AGETMAIN OUTPUT BUFFER
L R7,ALIST EXECUTE LIST TO MOVE FIELDS.
MOVELOOP CLI 0(R7),C'Z' Q. END OF LIST?
BE MOVEREST YES, MOVE THE REST OF THE DATA
CLI 0(R7),C'P' Q. DATA FROM PARM?
BE MOVEP YES, GO MOVE THAT.
CLI 0(R7),C'R' Q. DATA FROM INPUT RECORD?
BE MOVEREC YES, GO MOVE THAT.
CLI 0(R7),C'L'
BE MAKSTR
CLI 0(R7),C'S'
BE *+8
EX 0,* WE CANNOT GET HERE !!!!
*
AH R3,2(R7) NEW FEATURE, WE'RE GOING TO SKIP
LA R7,4(R7) THIS MANY RECORDS FROM THE INPUT
B MOVELOOP FILE. GEE, WASN'T THAT EASY.
*
* THIS SECTION PROCESSES CL## AND XL##, WHERE YOU WANT TO
* ADD A LONG STRING OF EITHER SPACES (CL##)
* OR HEX-ZEROS (XL##). NOTE THAT THE LENGTH THAT WAS SAVED
* IS THE LENGTH SPECIFIED -2. WE MOVE 1 CHAR RIGHT AWAY.
* THEN WE EXECUTE THE MVC. IF WE WANT 3 BYTES, THE LENGTH
* SAVED IS 1. WE MOVE THE FIRST CHAR. THEN WE PROPOGATE
* THAT CHAR 2 MORE TIMES, AND THE MVC INST LENGTH IS 1 LESS THAN
* THE ACTUAL LENGHT TO BE MOVED. YEAH, THIS TWISTS MY HEAD TOO!!
*
MAKSTR MVC 0(1,R3),1(R7)
LH R4,2(R7)
*
LA R0,1(R3,R4)
CR R0,R6
BNH MAKSTR2
LR R0,R5
SR R0,R3 LENGTH REMAINING
SH R0,=H'1' -1 FOR MVC INST
CR R4,R0
BNH MAKSTR2
O R7,=X'80000000'
LR R4,R0
AP #TRUNCAT,=P'1'
CLI DATATRUN,C' '
BE MAKSTR2
OI RC+1,4
MVI DATATRUN,C' '
MVC LINE(L'DATATRUN),DATATRUN
BAL R9,PUTLINE
B MAKSTR2
DATATRUN DC C'DATA WAS TRUNCATED FROM RECORDS'
*
LTR R4,R4
BNM MAKSTR2
*
LA R3,1(R3)
LA R7,4(R7)
*
MAKSTR2 CH R4,=H'255'
BL MAKSTR3
MVC 1(254,R3),0(R3)
LA R3,254(R3)
SH R4,=H'254'
B MAKSTR2
MVC 1(0,R3),0(R3)
MAKSTR3 EX R4,MAKSTR3-6
LA R3,2(R3,R4)
LTR R7,R7
BP PUT
LA R7,4(R7)
B MOVELOOP
*
* NOTE, WHEN WE MOVE FROM PARM DATA, IT'S NEVER LONG, SO WE JUST
* MOVE UP TO 255 BYTES.
* BUT WHEN WE MOVE FROM RECORD, IT CAN BE QUITE LONG, SO WE
* HAVE TO CHECK LENGTH, AND MOVE 256 BYTES AT A TIME, UNTIL
* WE GET DOWN BELOW 256 BYTES REMAINING.
*
MVC 0(0,R3),4(R7)
MOVEP LH R4,2(R7)
L R1,4(R7)
EX R3,MOVEP-6 MOVE PARM DATA
LA R3,1(R4,R3) BUMP OUTPUT RECORD LOC
CLI 8(R7),C'Y' Q. TRUNCATE RECORD?
BE PUT YES, JUST GO WRITE
LA R7,5(R7,R4) NO, BUMP EXECUTE LIST
B MOVELOOP AND MOVE NEXT BLOCK
*
MOVEREST LR R4,R6
SR R4,R2
B MOVEMORE
*
MOVEREC LH R4,2(R7)
*
* MOVEMORE CH R4,=H'12' THIS CODE TESTS MOVING
* BL MOVELAST PARTS OF A LONG RECORD.
* MVC 0(12,R3),0(R2) WE MOVE 12 BTES AT A TIME
* LA R3,12(R3) UNTIL WE HAVE LESS THAN
* LA R2,12(R2) 12 BYTES REMAINING.
* SH R4,=H'12' JUST TO MAKE SURE THAT THE
* BL PUT CODE TO MOVE SECTIONS WORKS RIGHT.
*
MOVEMORE CH R4,=H'256' Q. LESS THAN 256 BYTES?
BL MOVELAST YES, GO MOVE THAT.
MVC 0(256,R3),0(R2) NO, MOVE 256
LA R3,256(R3) BUMP FROM/TO
LA R2,256(R2) LOCATIONS, AND
SH R4,=H'256' DECREMENT LENGTH.
BL PUT Q. LENGTH=0, GO WRITE REC
B MOVEMORE NO, GO MOVE MORE DATA.
*
MVC 0(0,R3),0(R2) MOVE LESS THAN 256 BYTES
MOVELAST EX R4,MOVELAST-6 HERE, WITH EXECUTE INST
LA R3,1(R4,R3) BUMP OUTPUT BUFFER LOC
LA R2,1(R4,R2) BUMP INPUT BUGGER LOC
CLI 0(R7),C'W' Q. MORE DATA?
BH PUT NO, GO WRITE REC
LA R7,4(R7) BUMP EXECUTE LIST POINTER
B MOVELOOP AND GO MOVE MORE STUFF.
* --------------------------------------
DCBLIST DC A(SYSIN,IN,OUT,SYSPRINT),X'FF'
EDIT15 DC X'402020206B2020206B2020206B2020206B212020'
ENDMSG DC C' RECORDS COPIED, ... BYTES ADDED TO EACH, IN ... FIELDS.'
ENDREP MVC LINE(20),EDIT15
ED LINE(20),#RECORDS ALL DONE, WRITE PRETTY
LH R0,LLBB ADVERTISING MESSAGE
CVD R0,12(13) SO THAT THE BOSS
OI 19(13),X'0F' WILL CONTINUE TO PAY US.
UNPK ENDMSG+17(3),18(2,R13)
OI #FIELDS+1,X'0F'
UNPK ENDMSG+45(3),#FIELDS
MVC LINE+20(L'ENDMSG),ENDMSG
B PUTLINE
*
EOD BAL R9,ENDREP GO DO END REPORT
LM R0,R1,LGETMAIN
LTR R1,R1 Q. DID WE DO GETMAIN?
BZ NOFREE NO, DON'T DO FREEMAIN
FREEMAIN R,LV=(0),A=(1)
*
NOFREE LA R2,DCBLIST POINT TO DCB'S,
L R3,0(R2) TEST EACH ONE,
USING IHADCB,3 AND CLOSE THE ONES
TM DCBOFLGS,DCBOFOPN THAT ARE OPEN.
BZ NOCLO
CLOSE ((3))
DROP 3
NOCLO LA R2,4(R2)
CLI 0(R2),0
BE NOFREE+4
*
EXIT LH R15,RC PRETTY NORMAL
L 13,4(13) EXIT STUFF.
L 14,12(13)
LM 0,12,20(13)
BR 14
*
PUTLINE PUT SYSPRINT,LINE WRITE A LINE
* WTO MF=(E,LINE-5) AND WTO IT IN Z390.
MVC LINE,LINE-1
BR R9
*
CL00ERRM DC C'CANNOT SPECIFY CL00 OR XL00. '
CL00ERR MVC LINE+7(L'CL00ERRM),CL00ERRM
LA R1,LINE+7+L'CL00ERRM
B PUTERR
TOOMANYM DC C'TOO MANY ADD STRINGS, LIMIT=256 BYTES. AT='
TOOMANY MVC LINE+7(L'TOOMANYM),TOOMANYM
LA R1,LINE+7+L'TOOMANYM
B PUTERR
BADPARMM DC C'PARM ERROR =' THERE ARE A
BADPARM MVC LINE+7(L'BADPARMM),BADPARMM COUPLE DIFFERENT
LA R1,LINE+7+L'BADPARMM ERROR MSGS
B PUTERR FOR DIFFERENT ERRORS.
BADHEXM DC C'BAD HEX = IN PARM='
BADHEX MVC BADHEXM+9(2),0(R14) THEY ALL COME FROM
MVC LINE+7(L'BADHEXM),BADHEXM PARM/SYSIN STUFF.
LA R1,LINE+7+L'BADHEXM
* B PUTERR
*
PUTERR MVC 0(32,R1),0(R8) WE ALSO PRINT THE PGM LOCATION
LA R14,0(R14) FROM WHICH WE CAME, SO THAT I
SR R14,R13 CAN FIGURE OUT WHERE AN ERROR
ST R14,12(R13) OCCURRED, AND HOW TO FIX IT.
UNPK 20(9,R13),12(5,R13)
TR 20(8,R13),HEX-240
MVI LINE,C'('
MVC LINE+1(4),24(R13)
MVI LINE+5,C')'
BAL R9,PUTLINE
MVI RC+1,12 SET ERROR RETURN CODE
B EOD AND GO TO NORMAL EXIT.
HEX DC C'0123456789ABCDEF'
*
USING IHADCB,1
LISTDCB LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK DCBMSG+15(5),DW+5(3)
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK DCBMSG+29(5),DW+5(3)
UNPK DCBMSG+41(3),DCBRECFM(2)
TR DCBMSG+41(2),HEX-240
MVI DCBMSG+43,C' '
MVC LINE(L'DCBMSG),DCBMSG
B PUTLINE
DROP 1
DCBMSG DC C' LRECL=..... BLKSIZE=,,,,. RECFM= '
*
EXLST DC 0F'0',X'85',AL3(EXLST+4) THIS OPEN EXIT
PUSH USING COPIES LRECL
DROP 13 AND RECFM
USING *,15 FROM //IN TO
CLC =H'0',DCBLRECL-IHADCB+OUT //OUT
BNER 14 ADDING THE LENGTH
LH R1,DCBLRECL-IHADCB+IN OF THE FIELDS THAT
AH R1,LLBB WERE SPECIFIED.
STH R1,DCBLRECL-IHADCB+OUT
CLI DCBRECFM-IHADCB+OUT,0
BNER 14
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
BR 14
DROP 15
POP USING
*
PUSH PRINT
PRINT NOGEN
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=106
SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GM,EODAD=EOS
IN DCB DDNAME=IN,DSORG=PS,MACRF=GM,EODAD=EOD
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,EXLST=EXLST
POP PRINT
*
LTORG
*
RC DC H'0'
LLBB DC F'0'
LGETMAIN DC A(32768*2+2000)
AGETMAIN DC F'0'
EGETMAIN DC F'0'
ARECORD DC F'0'
ALIST DC F'0'
LISTUSED DC F'0'
#RECORDS DC PL8'0'
#TRUNCAT DC PL8'0'
#FIELDS DC PL2'0'
*
DC H'90,0',C' '
LINE DC CL133'ADDFIELD, V02.03 ASM &SYSDATE &SYSTIME ADD COLS TOX
SEQ FILE'
*
PARMWTO DC H'90,0',C' PARM='
PARM DC CL101' '
*
* BY DOING STUPID STUFF, LIKE OVERLAPPING THE TR AND TRT TABLES,
* AND OVERLAYING THE CODE STARTING AT GETMAIN, WE KEEP THE
* PROGRAM LENGTH UNDER 3K. THAT'S WHAT US OLD FOLKS DO,
* JUMP THROUGH HOOPS TO SAVE A COUPLE BYTES. :-(
*
SPACES EQU *
TESTHEX EQU *-100
DC CL093' ',XL6'00',CL41' ',XL10'00'
*ESTHEX DC CL193' ',XL6'00',CL41' ',XL10'00'
MAKEHEX EQU *-193
DC AL1(10,11,12,13,14,15),CL41' ',AL1(0,1,2,3,4,5,6,7,8,9)
*
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
*
END ADDFIELD