|
=={{header|360 Assembly}}==
For maximum compatibility, this program uses only the basic instruction set.
<lang 360 Assembly>* Bubble Sort 01/11/2014 & 23/06/2016
BUBBLE CSECT
USING BUBBLE,R13,R12 establish base registers
SAVEAREA B STM-SAVEAREA(R15) skip savearea
DC 17F'0' my savearea
STM STM DC R14,R12,12(R13) CL8'BUBBLE'save calling context
STM STM ST R14 R13,R12,124(R13R15) save calling context link mySA->prevSA
ST R13R15,48(R15R13) link prevSA->mySA
STLR R15,8(R13),R15 set mySA & set 4K addessability
LRLA R12,2048(R13,R15 ) set addessability.
LA R12,40952048(R13R12) set 8K addessability
LAL R12 RN,1(R12)N n
BCTR RN,0 n-1
MORE EQU *
LADO R8UNTIL=(LTR,0RM,Z,RM) repeat R8=no more------------------------+
LA R1RM,A0 R1 more=Addr(A(I))false |
LA R2,2(R1),A R2=Addr @a(A(I+1)i) |
LA R4R2,04(R1) to start@a(i+1) at 1 |
LA R6RI,1 increment i=1 |
LDO R7WHILE=(CR,NRI,LE,RN) for i=1 to n-1 ------------+ R7=N |
BCTRL R7 R3,0(R1) a(i) | | R7=N-1
LOOP BXH R4IF C,R6R3,ENDLOOPGT,0(R2) for R4= if a(i)>a(i+1) then to N-1--+ | |
LHL R3 R9,0(R1) R3 r9=Aa(Ii) | | |
CHL R3,0(R2) A r3=a(I)::A(Ii+1) | | |
BNHST NOSWAP R3,0(R1) if A a(Ii)<=A(I+1)r3 then| goto| NOSWAP|
LHST R9,0(R1R2) R9=A a(Ii+1)=r9 | | |
LHLA R3RM,0(R2)1 R3 more=A(I+1)true | | |
STHENDIF , R3,0(R1) end if <---------------+ | A(I)=R3|
STHLA R9 RI,01(R2RI) A(I i=i+1)=R9 | |
LA R8R1,14(R1) R8=more next a(i) | |
LA R2,4(R2) next a(i+1) | |
NOSWAP EQU *
LAENDDO , R1,2(R1) end for next<------------------+ A(I)|
LAENDDO , R2,2(R2) until not more next A(I<---------------+1)
BLA R3,PG LOOP pgi=0
LA RI,1 i=1
ENDLOOP EQU *
LTRDO WHILE=(C,RI,LE,N) R8,R8 do i=1 to n -------+
BNZLR MORE R1,RI i |
LASLA R3R1,A2 . R3=Addr(A(I))|
LAL R4 R2,0A-4(R1) a(i) to start at 1|
LAXDECO R2,XDEC R6,1 edit a(i) increment|
LMVC 0(4,R3),XDEC+8 R7,N output a(i) |
PRNT BXH R4LA R3,R6,ENDPRNT4(R3) for R4 pgi=1pgi+4 to N|
LHLA R5RI,01(R3RI) R5 i=A(I)i+1 |
CVDENDDO , R4,P Store Iend todo packed P<-----------+
UNPKXPRNT ZPG,PL'PG print Z=Pbuffer
MVCL C,Z R13,4(0,R13) restore caller C=Zsavearea
OILM C+L'C-1R14,X'F0'R12,12(R13) ZAPrestore SIGNcontext
MVCXR BUFFER(4) R15,C+12R15 set return code to 0
CVDBR R5,P R14 Store A(I) to packed P return to caller
A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
UNPK Z,P Z=P
DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
MVC C,Z C=Z
N DC OI C+A((N-A)/L'C-1,X'F0'A) number of items of ZAPa SIGN*
PG DC MVC CL80' BUFFER+10(6),C+10'
XDEC DS WTO MF=(E,WTOMSG)CL12
LA R3,2(R3) next A(I)
B PRNT
ENDPRNT EQU *
CNOP 0,4
L R13,4(0,R13)
LM R14,R12,12(R13) restore context
XR R15,R15 set return code to 0
BR R14 return to caller
N DC A((AEND-A)/2) number of items in A, so N=F'80'
A DC H'223',H'356',H'018',H'820',H'664',H'845',H'927',H'198' 8
DC H'261',H'802',H'523',H'982',H'242',H'192',H'913',H'230' 16
DC H'353',H'565',H'195',H'174',H'665',H'807',H'050',H'539' 24
DC H'436',H'249',H'848',H'010',H'006',H'794',H'100',H'433' 32
DC H'782',H'728',H'259',H'358',H'206',H'081',H'701',H'997' 40
DC H'880',H'520',H'780',H'293',H'861',H'942',H'735',H'091' 48
DC H'503',H'582',H'716',H'836',H'135',H'653',H'856',H'142' 56
DC H'919',H'498',H'303',H'894',H'536',H'211',H'539',H'986' 64
DC H'356',H'796',H'644',H'552',H'771',H'443',H'035',H'780' 72
DC H'474',H'278',H'332',H'949',H'351',H'282',H'558',H'904' 80
AEND EQU *
P DS PL8 packed
Z DS ZL16 zoned
C DS CL16 character
WTOMSG DS 0F
DC H'80' length of WTO buffer
DC H'0' must be binary zeroes
BUFFER DC 80C' '
LTORG
YREGS
RI EQU 6 i
RN EQU 7 n-1
RM EQU 8 more
END BUBBLE</lang>
{{out}}
<pre>
<pre style="height:20ex">0001 000006
-31 0 1 2 2 4 45 58 65 69 74 82 82 83 88 89 99 104 112 782
0002 000010
</pre>
0003 000018
0004 000035
0005 000050
0006 000081
0007 000091
0008 000100
0009 000135
0010 000142
0011 000174
0012 000192
0013 000195
0014 000198
0015 000206
0016 000211
0017 000223
0018 000230
0019 000242
0020 000249
0021 000259
0022 000261
0023 000278
0024 000282
0025 000293
0026 000303
0027 000332
0028 000351
0029 000353
0030 000356
0031 000356
0032 000358
0033 000433
0034 000436
0035 000443
0036 000474
0037 000498
0038 000503
0039 000520
0040 000523
0041 000536
0042 000539
0043 000539
0044 000552
0045 000558
0046 000565
0047 000582
0048 000644
0049 000653
0050 000664
0051 000665
0052 000701
0053 000716
0054 000728
0055 000735
0056 000771
0057 000780
0058 000780
0059 000782
0060 000794
0061 000796
0062 000802
0063 000807
0064 000820
0065 000836
0066 000845
0067 000848
0068 000856
0069 000861
0070 000880
0071 000894
0072 000904
0073 000913
0074 000919
0075 000927
0076 000942
0077 000949
0078 000982
0079 000986
0080 000997</pre>
=={{header|ACL2}}==
|