From 35925c6bc3d5d01db2cf622325a6154fe0b2d049 Mon Sep 17 00:00:00 2001 From: moshix Date: Thu, 21 Sep 2017 03:50:19 -0500 Subject: [PATCH] Added ackerman function in S/370 assembler may not yet work properly because it needs the XDECO and XPRNT macros from Assist --- acker360.jcl | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 acker360.jcl diff --git a/acker360.jcl b/acker360.jcl new file mode 100644 index 0000000..a7361bf --- /dev/null +++ b/acker360.jcl @@ -0,0 +1,101 @@ +//HERC01U JOB (BAL), +// 'Ackerman function', +// CLASS=A, +// MSGCLASS=H, +// TIME=1440, +// MSGLEVEL=(1,1), +// USER=HERC01,PASSWORD=BARR +//SYSLIB DD DSN=SYS2.MACLIB,DSN=SHR +/ +//******************************************************************** +//* +//* +//* +//******************************************************************** +//ULAM EXEC ASMFCG,PARM.ASM=(OBJ,NODECK),MAC1='SYS2.MACLIB', +// REGION.GO=328K,PARM.GO='/1000' +//ASM.SYSIN DD * + PRINT GEN +ACKERMAN CSECT + USING ACKERMAN,R12 r12 : base register + LR R12,R15 establish base register + ST R14,SAVER14A save r14 + LA R4,0 m=0 +PROPEN OPEN (SYSPRINT,OUTPUT) +LOOPM CH R4,=H'3' do m=0 to 3 + BH ELOOPM + LA R5,0 n=0 +LOOPN CH R5,=H'8' do n=0 to 8 + BH ELOOPN + LR R1,R4 m + LR R2,R5 n + BAL R14,ACKER r1=acker(m,n) + XDECO R1,PG+19 + XDECO R4,XD + MVC PG+10(2),XD+10 + XDECO R5,XD + MVC PG+13(2),XD+10 + PUT SYSPRINT,PG XPRNT PG,44 + LA R5,1(R5) n=n+1 + B LOOPN +ELOOPN LA R4,1(R4) m=m+1 + B LOOPM +ELOOPM L R14,SAVER14A restore r14 + BR R14 return to caller +SAVER14A DS F static save r14 +PG DC CL44'Ackermann(xx,xx) = xxxxxxxxxxxx' +XD DS CL12 +ACKER CNOP 0,4 function r1=acker(r1,r2) + LR R3,R1 save argument r1 in r3 + LR R9,R10 save stackptr (r10) in r9 temp + LA R1,STACKLEN amount of storage required + GETMAIN RU,LV=(R1) allocate storage for stack + USING STACK,R10 make storage addressable + LR R10,R1 establish stack addressability + ST R14,SAVER14B save previous r14 + ST R9,SAVER10B save previous r10 + LR R1,R3 restore saved argument r1 +START ST R1,M stack m + ST R2,N stack n +IF1 C R1,=F'0' if m<>0 + BNE IF2 then goto if2 + LR R11,R2 n + LA R11,1(R11) return n+1 + B EXIT +IF2 C R2,=F'0' else if m<>0 + BNE IF3 then goto if3 + BCTR R1,0 m=m-1 + LA R2,1 n=1 + BAL R14,ACKER r1=acker(m) + LR R11,R1 return acker(m-1,1) + B EXIT +IF3 BCTR R2,0 n=n-1 + BAL R14,ACKER r1=acker(m,n-1) + LR R2,R1 acker(m,n-1) + L R1,M m + BCTR R1,0 m=m-1 + BAL R14,ACKER r1=acker(m-1,acker(m,n-1)) + LR R11,R1 return acker(m-1,1) +EXIT L R14,SAVER14B restore r14 + L R9,SAVER10B restore r10 temp + LA R0,STACKLEN amount of storage to free +* FREEMAIN A=(R10),LV=(R0) free allocated storage + LR R1,R11 value returned + LR R10,R9 restore r10 + BR R14 return to caller + LTORG + DROP R12 base no longer needed +SYSPRINT DCB MACRF=PM,DDNAME=SYSPRINT,DSORG=PS,LRECL=121,RECFM=FBA +DEC DS XL8 cvd work area +STACK DSECT dynamic area +SAVER14B DS F saved r14 +SAVER10B DS F saved r10 +M DS F m +N DS F n +STACKLEN EQU *-STACK + YREGS + END ACKERMAN +/* +//SYSPRINT DD SYSOUT=H +//GO.OUTDD DD SYSOUT=H +//