, 00002000 // EXEC ASGCG,PARM.DATA='MAP' 00004000 //SOURCE.INPUT DD * 00006000 TITLE 'TEST PROGRAM-XDECI,XDECO,XDUMP COMPATIBILITY MACROS' 00008000 * THIS PROGRAM TESTS THE MACROS XDUMP,XDECI,XDECO, WHICH * 00010000 * ARE HANDLED IN THE ASSIST SYSTEM AS SPECIAL MACHINE INSTRUCTIONS. * 00012000 * THE FUNCTIONS AND USAGE OF THESE COMMANDS ARE DESCRIBED IN THE * 00014000 * ASSIST USER MANUAL. * 00016000 SPACE 1 00018000 XDECTEST CSECT 00020000 USING XDECTEST,15 NOTE ENTRY POINT USING 00022000 STM 14,12,12(13) STORE REGS 00024000 LR 12,13 MOVE OLD SA PTR OVER 00026000 LA 13,XDECSAVE PTR TO NEW SAVE AREA 00028000 ST 12,4(13) PTR TO OLD SA 00030000 ST 13,8(12) PTR TO NEW SAVE AREA 00032000 BALR 12,0 NEW BASE 00034000 USING *,12 NOTE NEW BASE 00036000 SPACE 1 00038000 * TESTS FOR XDUMP. REGISTERS, THEN STORAGE AREAS. 00040000 XDUMP 00042000 XDUMP AREA,64 AREA WITH EXPLICIT LENGTH 00044000 XDUMP AREA DUMP, IMPLIED LENGTH = 4 00046000 SPACE 4 00048000 * TESTS FOR XDECI. CONVERT CHARACTER STRINGS, WHICH WOULD* 00050000 * NORMALLY BE READ IN FROM CARDS. * 00052000 SR 2,2 CLEAR FOR INDEX TO NUMBERS 00054000 LA 1,CARD INIT FOR SCANNING ACROSS 00056000 LOOP XDECI 0,0(1) SCAN AND CONVERT NEXT NUMBER 00058000 BO OVER BRANCH IF NOGOOD 00060000 ST 0,NUMBERS(2) STORE THE VALUE 00062000 LA 2,4(2) INCREMENT INDEX VALUE 00064000 B LOOP GO BACK FOR NEXT NUMBER 00066000 OVER CLI 0(1),C'$' WAS IT $ DELIMITER 00068000 BE DONE YES, QUIT 00070000 XPRNT =CL30'0*** BAD NUMBER ***',30 00072000 DONE XDUMP 00074000 XDUMP NUMBERS,60 DUMP ARRAY OUT 00076000 SRL 2,2 DIVIDE BY 4 FOR # NUMBERS 00078000 SPACE 2 00080000 * TEST XDECO - PRINT NUMBERS OUT. 00082000 SR 3,3 CLEAR FOR INDEX TO ARRAY 00084000 LOOP2 L 0,NUMBERS(3) GET NEXT VALUE 00086000 XDECO 0,OUTPUT CONVERT 00088000 XPRNT OUTPUT,12 PRINT NUMBER 00090000 LA 3,4(3) INCREMENT INDEX 00092000 BCT 2,LOOP2 CONTINUE FOR NEXT 00094000 SPACE 1 00096000 L 13,4(13) RESTORE PTR 00098000 LM 14,12,12(13) RESTORE REGS 00100000 BR 14 RETURN 00102000 SPACE 1 00104000 XDECSAVE DS 18F SAVE AREA 00106000 NUMBERS DC 16F'4095' FOR CONVERSIONS 00108000 CARD DC C'0 +1 -1 -000 +64 64 -64 123456789 ' 00110000 DC C' 1234567890 $' SHOULD STOP ON BIG # 00112000 AREA DC CL64'1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ,./$#@' 00114000 OUTPUT DC CL12' ' OUTPUT CONVERSION AREA 00116000 LTORG 00118000 END 00120000 /* 00122000 //DATA.XSNAPOUT DD SYSOUT=A 00124000 , 00126000 // EXEC ASGCG,PARM.DATA='MAP,EP=TEST' 00128000 //SOURCE.INPUT DD * 00130000 TITLE 'TEST PROGRAM XSNAP,XSTOP,XSET - VERSION 4.0' 00132000 PRINT GEN 00134000 TEST CSECT 00136000 XSAVE 00138000 L 1,=XL4'00FF0000' GET HUGE ADDRESS 00140000 XSNAP STORAGE=(*0(1),*20(1)) 00142000 L 2,=XL4'2FFF00' @ NEAR END OF MACHINE 00144000 XSNAP STORAGE=(*0(2),*400(2)) 00146000 XSNAP T=FLOAT 00148000 XSNAP T=(NO,FL) 00150000 XSNAP T=ST 00152000 XSNAP T=NO 00154000 XSNAP T=NOREGS 00156000 XSNAP T=NR 00158000 XSNAP T=FL 00160000 XSNAP T=(NO,FLOAT) 00162000 XSNAP T=(PR,FL,0101) 00164000 XSNAP T=ST,IF=(L1) 00166000 XSNAP IF=(L1,N,0) 00168000 XSNAP IF=(L1,L,1) 00170000 XSNAP IF=((0),NH,(1)) 00172000 XSNAP IF=(L1,E,L2,CLC) 00174000 XSNAP IF=((0),NE,=F'1') 00176000 XSNAP STORAGE=(L1,L2,L3,L4,L5,L6) 00178000 XSNAP STORAGE=(*L1+10,*L1+20,*L1+20,*L1+10,L2) 00180000 LA 1,10 SET LOOP LIMIT 00182000 LOOPA XSNAP LABEL='AT LOOPA',IF=((1),H,=H'5',CH) 00184000 XSNAP T=NOREGS,LABEL=' XSNAP WITH TRACE ONLY' 00186000 XSTOP N=7,ABEND=350 00188000 BCT 1,LOOPA LOOP THROUGH 00190000 XSNAP STORAGE=(*L1+L'L2+1000-L'L1-L'L2-1200+L2-L1,*L2) 00192000 XSET XSNAP=OFF,XSTOP=OFF 00194000 XSNAP T=STORE,LABEL='XXEXIT' 00196000 XSTOP N=1 00198000 XRETURN SA=* 00200000 L1 DC CL130'ABCDEFGHI' 00202000 L2 DC 30X'0' 00204000 L3 DC 50XL4'0' 00206000 L4 DC X'1' 00208000 L5 DC 64C'A' 00210000 DC 64C'B' 00212000 DC 64C'C' 00214000 DC 256C'E' 00216000 DC X'1' 00218000 L6 DS F 00220000 LTORG 00222000 END 00224000 /* 00226000 //DATA.SYSUDUMP DD SYSOUT=A 00228000 //DATA.XSNAPOUT DD UNIT=AFF=FT06F001 00230000 , 00232000 //* 00234000 //* TEST PROGRAM TO DEMONSTRATE THE FOLLOWING MACROS: 00236000 //* 1. EQUREGS 00238000 //* 2. XSAVE 00240000 //* 3. XRETURN 00242000 //* 4. XPRNT AND XSNAP (INDIRECTLY) 00244000 //* 00246000 //* THIS IS PART OF XMACRO PACKAGE VERSION 4.0 (APRIL 1972) 00248000 //* 00250000 //* THE CATALOGUED PROCEDURES ARE LOCAL TO PENN STATE UNIVERSITY 00252000 //* COMPUTATION CENTER, ARE FOR USE WITH ASSEMBLER G AND THE 00254000 //* LOADER, CORRESPONDING TO ASMFCG. 00256000 //* 00258000 // EXEC ASGCG,PARM.DATA='MAP' 00260000 //SOURCE.INPUT DD * 00262000 EQUREGS 00264000 * TYPICAL USAGE FOLLOWS. 00266000 XSAVE 00268000 CALL PROG2 00270000 XRETURN SA=*,RC=4 RETURN TO OS WITH RETURN CODE OF 4 00272000 * FOLLOWING CALLS EXTREME AND UNTYPICAL. 00274000 PROG2 XSAVE RGS=(R14,R0-R1,5-12),BR=(11,10),OPT=(TITLE,CSECT) 00276000 CALL LOWEST CALL LOWEST LEVEL ROUTINE 00278000 LA R3,5 SET UP LIMIT ON RECURSION DEPTH 00280000 CALL RECURSE CALL RECURSIVE ROUTINE 00282000 CALL PROG3 00284000 CALL PROG4 00286000 B BAD RETURN HERE| OR SKIP BRANCH VIA RP= 00288000 SR 15,15 CLEAR FOR RETURN CODE = 0 00290000 BAD XRETURN RGS=(14,0-1,5-12),SA=*,T=*,RC=(R15) 00292000 * LOWEST LEVEL ROUTINE FOLLOWS: NOTE CODE GENERATED. 00294000 LOWEST CSECT 00296000 XSAVE SA=NO,BR=15,TR=NO,ID=NO ZAP OPTIONS 00298000 XRETURN SA=NO,TR=NO 00300000 * FOLLOWING CSECT USES REEN FOR RECURSIVE CALLS. 00302000 PROGRAM CSECT 00304000 RECURSE XSAVE TR=('RECURSION',SNAP),REEN=0,OPT=ENTRY 00306000 BCT R3,CONTINU LOOP, RECURSING 00308000 B RETB GIVE UP NOW 00310000 CONTINU CALL RECURSE CALL MYSELF AGAIN 00312000 RETB XRETURN REEN=0 RETURN, FREE STORAGE 00314000 * ENTIRES PROG3 AND PROG4 HAVE SAME ADDRESSIBILITY, WITH AD. 00316000 PROG3 XSAVE OPT=ENTRY,SA=P3SAVE,BR=(12,11,10),AD=PROG3 00318000 PROG3A XRETURN RC=(R3),T=* 00320000 PROG4 XSAVE OPT=ENTRY,AD=PROG3,BR=(12,11,10),ID=PROG3ENTRYOFPROGRAM 00322000 LTR R0,R0 TEST TO DECIDE 00324000 BZ ZERO SKIP TO RP=0 00326000 XRETURN RP=4 BRANCH OVER BAD ABOVE 00328000 ZERO XRETURN RP=0,T=*,SA=* SAVE AREA, RP 00330000 END 00332000 //DATA.XPRNT DD SYSOUT=A 00334000 //DATA.XSNAPOUT DD SYSOUT=A 00336000 $JOB ASSIST 00007050 * FOLLOWING IS A REASONABLE TEST OF ASSIST'S XIO FACILITY 00007100 * 00007150 * READS CARDS FROM TWO FILES, WRITES THEM TO DISK, RECOVERS THEM 00007200 * AND PRINTS THEM ON A PRINTER 00007250 * 00007300 USING *,15 ADDRESSABILITY 00007350 INC EQU 3 RECORD COUNT INCREMENT REGISTER 00007400 IOREG EQU 1 XIO POINTER REGISTER 00007450 COUNT EQU 2 RECORD COUNTER REGISTER 00007500 LA INC,1 GET INCREMENT FOR RECORD COUNT 00007550 SR COUNT,COUNT INITIALIZE THE COUNTER 00007600 INLOOP LA IOREG,=CL8'XIN1' ADDRESS INPUT FILE 00007650 XREAD INAREA1,80 READ ACARD FROM NORMAL INPUT FILE 00007700 BM OUT ON E-O-F TERMINATE INPUT 00007750 AR COUNT,INC COUNT CARD JUST READ 00007800 XGET INAREA2,80 READ A CARD FROM THE SECOND 00007850 * INPUT FILE 00007900 BNE OUT ON E-O-F TERMINATE INPUT 00007950 AR COUNT,INC COUNT THE CARD JUST READ 00008000 LA IOREG,=CL8'DISK' 00008050 XPUT INAREA1,160 WRITE OUT A BLOCK 00008100 BNZ ERROR ON I/O ERROR TERMINATE 00008150 MVC INAREA1(160),BLANKS BLANK OUT INPUT AREA 00008200 B INLOOP LOOP FOR ALL CARDS 00008250 OUT XDECO COUNT,VAL CONVERT NUMBER OF CARDS READ 00008300 * TO PRINTABLE FORM 00008350 XPRNT HEAD,HLNG PRINT RUN HEADING 00008400 LA IOREG,=CL8'PRINT' POINT AT PRINT FILE 00008450 XPUT MESS,MLNG PRINT RECORD HEADER 00008500 SR 0,0 CLEAR FOR CLOSE 00008505 LA IOREG,=CL8'DISK' FILE 00008510 XPUT INAREA1,(0) CLOSE THE FILE 00008515 OUTLOOP LA IOREG,=CL8'DISK' POINT TO DISK FILE FOR INPUT 00008550 XGET INAREA1,160 READ DATA BACK IN 00008600 BNE DONE ON E-O-F TERMINATE RUN 00008650 XPRNT INAREA1-1,81 PRINT A CARD IMAGE 00008700 MVC INAREA1(80),INAREA2 MOVE NEXT CARD OVER 00008750 LA IOREG,=CL8'PRINT' POINT AT PRINTER FILE 00008800 XPUT INAREA1-1,81 PRINT A CARD IMAGE 00008850 B OUTLOOP LOOP FOR ALL CARDS 00008900 ERROR XPRNT =CL15'0I/O ERROR QUIT',15 00008950 RET BR 14 RETURN TO THE SYSTEM 00009000 DONE LA IOREG,=CL8'PRINT' POINT AT PRINT FILE 00009050 XPUT NORMTM,27 00009100 B RET TERMINATE NORMALLY 00009150 NORMTM DC C'***NORMAL TERMINATION***' 00009200 HEAD DC C'1BEGIN PRINT OF CARDS READ' 00009250 HLNG EQU *-HEAD HEADING LENGTH 00009300 MESS DC C' NUMBER OF CARDS READ = ' 00009350 VAL DS CL12' ',C'/' 00009400 MLNG EQU *-MESS VAL PRINT MESSAGE LENGTH 00009450 BLANKS DC CL160' ' INPUT BLANKS 00009500 DC C'0' 00009550 INAREA1 DC CL80' ' INPUT/OUTPUT AREA 1 00009600 INAREA2 DC CL80' ' INPUT/OUTPUT AREA2 00009650 END 00009700 $ENTRY 00009750 THE CARDS IN THIS FILE ARE READ WITH THE NORMAL DATA READER 00009800 ********* NORMAL # 2 ************* 00009850 ********* NORMAL 3 ************* 00009900 ********* NORMAL 4 ************* 00009950 ********* NORMAL 6 ************* 00010000 ********* NORMAL 7 ************* 00010050 ********* NORMAL 8 ************* 00010100 ********* NORMAL 9 ************* 00010150 ********* NORMAL 10 ************* 00010200 //DATA.PRINT DD SYSOUT=A,DCB=(RECFM=FA,LRECL=133,BLKSIZE=133) 00010250 //DATA.DISK DD UNIT=SYSDA,DISP=(NEW,DELETE),DSN=&&TEMP, *00010300 // DCB=(RECFM=FB,LRECL=160,BLKSIZE=160),SPACE=(CYL,(1,1)) 00010350 //DATA.XIN1 DD * 00010400 THESE CARDS ARE READ FROM THE SECOND CARD INPUT FILE ( XIO -> XGET ) 00010450 XXXXXXXXX SECOND READ FILE CARD 2 00010500 XXXXXXXXX SECOND READ FILE CARD 3 00010550 XXXXXXXXX SECOND READ FILE CARD 4 00010600 XXXXXXXXX SECOND READ FILE CARD 5 00010650 XXXXXXXXX SECOND READ FILE CARD 6 00010700 XXXXXXXXX SECOND READ FILE CARD 7 00010750 XXXXXXXXX SECOND READ FILE CARD 8 00010800 XXXXXXXXX SECOND READ FILE CARD 9 00010850 XXXXXXXXX SECOND READ FILE CARD 10 00010900 /* 00010950