TITLE 'CALCULATOR'
PRINT NOGEN
CALC SUBENTRY
EQUREGS
LOOP XREAD IN,40
BC B'0100',EXIT
XPRNT INP,L'INP+L'IN
LA R1,IN
MVI OUT,C' '
MVC OUT+1(L'OUT-1),OUT
XDECI R3,0(R0,R1) * FIRST OPND
BC B'001',ERR1
XDECO R3,OUT
XDECI R4,0(0,R1) * SECOND OPND
BC B'001',ERR2
XDECO R4,OUT+12
L5 CLI 0(R1),C' ' * FIND OPR
BNE L6
LA R1,1(R0,R1)
C R1,LIM
BH ERR4
B L5
L6 MVC OUT+27(1),0(R1)
MVC OUT+27(2),=C'->'
CLI 0(R1),C'+'
BNE SUB
ADD AR R3,R4
XDECO R3,OUT+29
XPRNT OUT,L'OUT
B LOOP
SUB CLI 0(R1),C'-'
BNE MULT
SR R3,R4
XDECO R3,OUT+29
XPRNT OUT,L'OUT
B LOOP
MULT CLI 0(R1),C'*'
BNE DIV
MR R2,R4
XDECO R3,OUT+29
XPRNT OUT,L'OUT
B LOOP
DIV CLI 0(R1),C'/'
BNE MOD
LR R2,R3
SRDA R2,32
DR R2,R4
XDECO R3,OUT+29
XPRNT OUT,L'OUT
B LOOP
MOD CLI 0(R1),C'%'
BNE ERR3
LR R2,R3
SRDA R2,32
DR R2,R4
XDECO R2,OUT+29
XPRNT OUT,L'OUT
B LOOP
ERR1 XPRNT ERRMSG1,L'ERRMSG1
B EXIT
ERR2 XPRNT ERRMSG2,L'ERRMSG2
B EXIT
ERR3 XPRNT ERRMSG3,L'ERRMSG3
B EXIT
ERR4 XPRNT ERRMSG4,L'ERRMSG4
EXIT SUBEXIT
INP DC C'INPUT = '
IN DS CL40
LIM DC A(*)
OUT DS CL50
* ERROR MSGS
ERRMSG1 DC C'FIRST OPERAND INPUT ERROR'
ERRMSG2 DC C'SECOND OPERAND INPUT ERROR'
ERRMSG3 DC C'OPERATOR ERROR'
ERRMSG4 DC C'OPERATOR NOT FOUND'
END
Example output:
INPUT = 22 33 +
22 33 -> 55
INPUT = 22 33 -
22 33 -> -11
INPUT = 22 33 *
22 33 -> 726
INPUT = 22 33 /
22 33 -> 0
INPUT = 22 33 %
22 33 -> 22
Figure 1 Calculator Program
===============================================================================
TITLE 'PRINT BIT STRINGS
PRINT NOGEN
BIN SUBENTRY
EQUREGS
L R6,ONE * INIT R6
SR R2,R2 * COUNTER
LOOP XDECO R6,OUT * CVT R6 TO DECIMAL
LA R1,PARMTAB * ADDR OF PARAMETER TABLE
L R15,=V(BPRNT) * ADDR OF SUB
BASR R14,R15 * CALL SUB
XPRNT OUT,L'OUT * PRINT RSLT
SLL R6,1 * SHIFT BIT LEFT
A R2,=F'1' * INC COUNTER
C R2,=F'31' * DONE?
BL LOOP * NOPE
SUBEXIT
ONE DC F'1'
OUT DC CL45' '
PARMTAB DC A(OUT)
LTORG
*
* SUB TO PRINT BIT STRINGS
*
BPRNT SUBENTRY
*
* INITIALIZE 2ND PART OF OUT
*
L R3,0(0,R1) * ADDRESS OF OUT
LA R3,13(0,R3) * OUT+13
MVI 0(R3),C'0' * SEED CHARACTER
MVC 1(31,R3),0(R3) * RIPPLE MOVE
*
* INITALIZE REGISTERS
*
LA R5,31(0,0) * COUNT
IC R2,CONE * LOAD CHAR 1
*
LOOP1 LR R4,R6 * COPY TO R4
N R4,MASK * AND WITH MASK
BZ L1 * LEAVE 0 IN OUT STR
STC R2,0(R5,R3) * PUT 1 IN OUT STR
L1 SRL R6,1 * SHIFT RIGHT
S R5,ONE1 * DEC COUNTER
C R5,ZERO * AT ZERO?
BNL LOOP1 * NOPE
SUBEXIT * SAY G'NITE GRACIE
CONE DC C'1'
ONE1 DC F'1'
N32 DC F'32'
ZERO DC F'0'
DS 0F
MASK DC X'00000001'
END
Output
1 00000000000000000000000000000001
2 00000000000000000000000000000010
4 00000000000000000000000000000100
8 00000000000000000000000000001000
16 00000000000000000000000000010000
32 00000000000000000000000000100000
64 00000000000000000000000001000000
128 00000000000000000000000010000000
256 00000000000000000000000100000000
512 00000000000000000000001000000000
1024 00000000000000000000010000000000
2048 00000000000000000000100000000000
4096 00000000000000000001000000000000
8192 00000000000000000010000000000000
16384 00000000000000000100000000000000
32768 00000000000000001000000000000000
65536 00000000000000010000000000000000
131072 00000000000000100000000000000000
262144 00000000000001000000000000000000
524288 00000000000010000000000000000000
1048576 00000000000100000000000000000000
2097152 00000000001000000000000000000000
4194304 00000000010000000000000000000000
8388608 00000000100000000000000000000000
16777216 00000001000000000000000000000000
33554432 00000010000000000000000000000000
67108864 00000100000000000000000000000000
134217728 00001000000000000000000000000000
268435456 00010000000000000000000000000000
536870912 00100000000000000000000000000000
1073741824 01000000000000000000000000000000
Figure 2 Bit String Printing
===============================================================================
#include <stdio.h>
int main() {
unsigned int i, a, b, x, N;
a=214013;
b=2531011;
N=32768;
x=79; // seed
for (i=1; i<1000; i++) {
x = ( a * x + b ) % N;
printf("%d\n",x);
}
}
Figure 3 Random Numbers in C
===============================================================================
PRINT NOGEN
EQUREGS
RAND SUBENTRY
WTO 'RANDOM NUMBERS'
LA R2,8(0,0) * LOAD R2 WITH 8
LOOP L R5,X * LOAD SEED OR LAST VALUE
M R4,A * MULT BY A
AL R5,B * ADD (LOGICAL) B
N R5,MASK * MODULO 32768
ST R5,X * STORE RESULT
XDECO R5,OUT * PRINT RESULT
XPRNT OUT,12
BCT R2,LOOP * DECR R2, BRANCH IF > 0
SUBEXIT
A DC F'214013'
B DC F'2531011'
X DC F'79'
MASK DC X'00007FFF'
OUT DS CL12
END RAND
Output:
RANDOM NUMBERS
6614
10561
26368
27075
11642
32341
14276
1911
Figure 4 Random Number Generator
===============================================================================
SUFFIX SUBENTRY
EQUREGS
XPRNT IN,L'IN
MVI OUT,C' ' * PUT BLANK IN 1ST POSITION
MVC OUT+1(19),OUT * PROPOGATE BLANK ACROSS FIELD
LA R2,IN * ADDRESS OF INPUT STRING
LA R3,OUT * ADDRESS OF OUTPUT STRING
LA R4,STACK * ADDRESS OF STACK
*
* LOOP TO EXAMINE AND PROCESS INPUT
*
LOOP CLI 0(R2),C'(' * IS INPUT CHAR ( ?
BNE L1 * NO
LA R2,1(R0,R2) * INCREMENT INPUT POINTER
B LOOP * PROCESS NEXT CHARACTER
L1 CLI 0(R2),C'$' * IS INPUT CHAR $ ?
BE FIN * YES - END OF INPUT
CLI 0(R2),C'+' * IS INPUT +. -, * OR / ?
BE OPR * YES
CLI 0(R2),C'-'
BE OPR
CLI 0(R2),C'*'
BE OPR
CLI 0(R2),C'/'
BE OPR
B L2
OPR MVC 0(1,R4),0(R2) * PUSH OPERATOR ONTO STACK
A R4,=F'1'
A R2,=F'1' * INCRMENT INPUT POINTER
B LOOP * PROCESS NEXT CHARACTER
L2 CLI 0(R2),C')'
BNE L3
S R4,=F'1'
MVC 0(1,R3),0(R4)
A R3,=F'1'
A R2,=F'1'
B LOOP
L3 MVC 0(1,R3),0(R2)
A R3,=F'1'
A R2,=F'1'
B LOOP
FIN XPRNT OUT,L'OUT
SUBEXIT
IN DC C'((A+B)*(C/D))$'
OUT DS CL20
STACK DS CL20
END
Output:
((A+B)*(C/D))$
AB+CD/*
Figure 5 Convert Infix to Suffix
===============================================================================
BUBBLE SUBENTRY
EQUREGS
OUTER SR R8,R8 * FLAG
SR R2,R2 * COUNTER
LOOP LR R4,R2
SLA R4,2 * MULT by 4
L R3,TAB(R4) * GET VALUE
LA R5,4(R0,R4) * OFFSET OF NEXT VALUE
C R3,TAB(R5) * COMP VALUES
BH SWAP
INC LA R2,1(R0,R2) * INCR COUNTER
C R2,=F'9' * INNER LOOP DONE?
BL LOOP
C R8,=F'0' * CHECK FLAG
BE DONE * DONE?
B OUTER * DO INNER LOOP AGIAN
SWAP L R6,TAB(R4) * LOWER
L R7,TAB(R5) * HIGHER
ST R7,TAB(R4) * HIGHER TO LOWER
ST R6,TAB(R5) * LOWER TO HIGHER
LA R8,1(0,0) * SET FLAG
B INC
DONE SR R2,R2 * LOOP AND PRINT RESULTS
PLOOP LR R4,R2
SLA R4,2
L R3,TAB(R4)
XDECO R3,OUT
XPRNT OUT,L'OUT
LA R2,1(0,R2)
C R2,=F'10'
BL PLOOP
SUBEXIT
*
* TABLE OF NUMBERS TO SORT
*
TAB DC F'9'
DC F'7'
DC F'3'
DC F'10'
DC F'4'
DC F'1'
DC F'2'
DC F'11'
DC F'5'
DC F'0'
OUT DS CL12
END
Figure 6 Bubble Sort
===============================================================================
PRIME SUBENTRY
EQUREGS
L R3,=F'3'
LOOP A R3,=F'1' * CANDIDATE NUMBER TO TEST
C R3,=F'1000' * DONE?
BE DONE
LR R4,R3 * CALCULATE INNER LOOP LIMIT
SRA R4,1 * DIVIDE BY 2
L R2,=F'1' * INNER LOOP COUNTER
INNER A R2,=F'1'
CR R2,R4 * INNER LOOP LIMIT TEST
BNL PRIME
LR R6,R3
SRDA R6,32 * PREPARE EVEN/ODD REGISTER PAIR
DR R6,R2
C R6,=F'0' * CHECK THE REMAINDER
BE LOOP * NOT PRIME
B INNER
PRIME XDECO R3,OUT
XPRNT OUT,L'OUT+L'OUT1
B LOOP
DONE SUBEXIT
OUT DS CL12
OUT1 DC C' IS PRIME'
END
Figure 7 Search for Prime Numbers
===============================================================================
PRINT NOGEN
EQUREGS
ADD SUBENTRY
SR R8,R8 zero accumulator
LOOP XREAD REC,L'REC read a record
BC B'0100',ATEND EOF?
XPRNT REC,L'REC write the record
MVI NEGFLG,C'0' set flag to 0
LA R1,REC addr 1st byte of REC
L2 CLI 0(R1),C' ' scan for 1st non-blank
BNE L1 found one
LA R1,1(0,R1) increment ptr
C R1,LIM at limit?
BNL ERR1 line is all blanks
B L2 again
L1 LR R2,R1 R2 addr 1st non-blank
CLI 0(R1),C'-' is is a minus sign?
BNE PLUS no
MVI NEGFLG,C'1' nbr is negative
LA R1,1(0,R1) incr ptr byte after -
LR R2,R1 remember start of nbr
B L5
PLUS CLI 0(R1),C'+' plus sign found?
BNE L5 no
LA R1,1(0,R1) yes incr ptr past it
LR R2,R1 remember start
L5 CLI 0(R1),C'0' scan for digits
BL L3 could be a blank
CLI 0(R1),C'9'
BH ERR2 char not a digit
LA R1,1(0,R1) incr ptr
C R1,LIM limit?
BNL L4 yes
B L5 no
L3 CLI 0(R1),C' ' blank after number?
BNE ERR2 no
L4 SR R1,R2 R1 is length of number
BCTR R1,R0 adjust for EX - 1 less
EX R1,PK pack the number into NBR
CLI NEGFLG,C'1' is this number neg?
BNE ADD no
NI NBR+7,X'FB' yes make sign neg
ADD CVB R7,NBR convert to binary
AR R8,R7 add to accumulator
B LOOP read next line
*
* EOF processing
*
ATEND CVD R8,SUM convert ans to decimal
MVC RSLT,PAT copy pattern to target
ED RSLT(L'RSLT+L'SIGN),SUM edit to RSLT + SIGN
LA R5,RSLT start addr RSLT
XPRNT RSLT,L'RSLT after ED example
L6 CLI 0(R5),C' ' find 1st digit in output
BNE L7 find 1st non blank
LA R5,1(0,R5) incr R5
B L6
* Load address of last byte of string into R6
L7 LA R6,RSLT+L'RSLT+L'SIGN addr last byte
SR R6,R5 lngth string to print
BCTR R6,R0 decr for EX
EX R6,MVC1 shift nbr to beginning
XPRNT RSLT,L'RSLT after text shifted
LA R7,RSLT+1(R6) address end of txt
MVI 0(R7),C' ' blank out end
XPRNT RSLT,L'RSLT after blank placed
LA R6,RSLT+L'RSLT+L'SIGN end
SR R6,R7 R6 is length to end
BCTR R6,R0 subtract 1
EX R6,MVC2 ripple the blank
XPRNT MSG,L'MSG+L'RSLT+6 answer is ...
RET SUBEXIT
ERR1 XPRNT ERRMSG1,L'ERRMSG1 all blanks
B RET
ERR2 XPRNT ERRMSG2,L'ERRMSG2 must be bad data
B RET
LTORG
REC DS CL40 actual input record
LIM DC A(*) addr of byte after rec
PK PACK NBR,0(0,R2)
MVC1 MVC RSLT(0),0(R5) for EX
MVC2 MVC 1(0,R7),0(R7) for EX
NBR DC PL8'0'
NEGFLG DC C'0'
SUM DS PL8
PAT DC X'402020206B2020206B2020206B2020206B202120'
MSG DC C'ANS = '
RSLT DS CL20
SIGN DC C' (NEG)' blanks if nbr positive
ERRMSG1 DC C'LINE ALL BLANK'
ERRMSG2 DC C'ERROR - BAD DATA'
END ADD
Example output
1234
-23456
+33244
-10000000
23456
9,965,522
9,965,522 (NEG)5,522
9,965,522 (NEG) ,522
ANS = 9,965,522 (NEG)
Figure 8 XDECI/XDECI Replacements
===============================================================================
PRINT NOGEN
EQUREGS
HEX SUBENTRY
WTO 'HEXADECIMAL'
L R2,STRLEN * LENGTH OF STRING
SR R4,R4 * OFFSET INTO INPUT STRING
SR R5,R5 * REGISTER TO RCV STRING CHARS
SR R6,R6 * OFFSET INTO OUTPUT STRING
LOOP IC R5,STRING(R4) * LOAD NEXT INPUT CHAR
SRA R5,4 * MAKE 4 HIGH BITS the 4 LOW BITS
IC R5,TABLE(R5) * LOAD CHAR FROM HEX TABLE
STC R5,OUT(R6) * STORE CHAR in OUTPUT STRING
LA R6,1(R0,R6) * INCREMENT OUTPUT OFFSET
IC R5,STRING(R4) * LOAD INPUT CHAR AGAIN
N R5,MASK * ZERO HIGH 4 bits
IC R5,TABLE(R5) * LOAD FROM HEX TABLE
STC R5,OUT(R6) * STORE TO OUTPUT
LA R6,1(R0,R6) * INCREMENT OUTPUT OFFSET
LA R4,1(R0,R4) * INCREMENT INPUT OFFSET
BCT R2,LOOP * DECR R2, BRANCH IF > 0
XPRNT OUT,STRX*2 * PRINT RESULTS
SUBEXIT
STRING DC C'THIS IS A TEST STRING 0123456789'
STRX EQU *-STRING
STRLEN DC A(STRX)
OUT DS CL(STRX*2)
MASK DC X'0000000F'
TABLE DC C'0123456789ABCDEF'
END HEX
Figure 9 Print Hex Equivalent
===============================================================================
PRINT NOGEN
EQUREGS
WORDS SUBENTRY
WTO 'WORDS'
LOOP XREAD IN,80
BC B'0100',EOF
TR IN,TRTAB * CVT TO UPPER & REM NON-ALPHAS
LA R3,IN
LA R4,80(R0,R3) * ADDRESS OF END OF INPUT
L1 CLI 0(R3),C' ' * BLANK?
BNE L2 * BRANCH IF NOT BLANK
L1A LA R3,1(R0,R3) * INCR PTR INTO INPUT
CR R3,R4 * AT END?
BNL LOOP * YES - END OF INPUT STRING
B L1 * NO - PROCESS NEXT CHARACTER
L2 LR R5,R3 * COPY WORD START ADDR TO R5
L3 LA R3,1(R0,R3) * INCR INPUT POINTER
CR R3,R4 * END?
BNL L4 * YES
CLI 0(R3),C' ' * BLANK?
BNE L3 * NO - CONTINUE
L4 LR R6,R3 * COPY WORD END ADDR TO R6
SR R6,R5 * LENGTH OF WORD IN R6
BCTR R6,R0
MVC OUT(1),BLANK * COPY BLANK TO POSITION 1
MVC OUT+1(29),OUT * PROPOGATE BLANK
EX R6,MVC * COPY WORD TO OUT
L R5,COUNT * NUMBER OF ENTRIES IN TABLE
LA R6,TAB * START OF ARRAY OF ENTRIES
L5 C R5,=F'0' * NO MORE ENTRIES IN TABLE?
BE L6 * YES
CLC OUT(8),0(R6) * COMPARE NEW WORD WITH TABLE ENTRY
BE L7 * FOUND WORD IN TABLE
LA R6,12(R0,R6) * INCREMENT PTR TO NEXT ENTRY
S R5,=F'1' * DECREMENT LOOP COUNTER
B L5 * CONTINUE
L7 L R5,8(R0,R6) * WORD FOUND - LOAD COUNT
A R5,=F'1' * INCR COUNT
ST R5,8(R0,R6) * STORE COUNT
B L1A * LOOK FOR NEXT WORD IN INPUT
L6 MVC 0(8,R6),OUT * COPY WORD TO TABLE
LA R7,1(R0,R0) * LOAD 1 INTO R7
ST R7,8(R0,R6) * STORE IN COUNT FIELD
L R5,COUNT * MAIN COUNT OF ENTRIES
LA R5,1(R0,R5) * INCR
C R5,=F'1000' * TEST LIMIT
BNL ERROR * OVER LIMIT
ST R5,COUNT * STORE UPDATED COUNT
B L1A * PROCESS NEXT INPUT WORD
EOF LA R5,TAB * TABLE ADDRESS
L R6,COUNT * COUNT OF ENTRIES
C R6,=F'0' * EMPTY?
BE BYE * DONE
L8 MVC OUT(8),0(R5) * COPY WORD TO OUTPUT STRING
L R7,8(R0,R5) * LOAD WORD COUNT
XDECO R7,OUT+8 * CVT WORD COUNT TO CHARS
XPRNT OUT,20 * WRITE WORD AND COUNT
LA R5,12(R0,R5) * INCR TO NEXT ENTRY
BCT R6,L8 * DECR R6 AND REPEAT IF > 0
BYE L R5,COUNT * TOTAL NUMBER OF ENTRIES
XDECO R5,OUT * CVT TO PRINTABLE
XPRNT OUT,12 * PRINT TOTAL
SUBEXIT
ERROR WTO 'ERROR - TABLE OVERFLOW'
SUBEXIT
BLANK DC C' '
OUT DS CL30 * OUTPUT STRING & TEMP STORE
MVC MVC OUT(0),0(R5) * FOR EX INSTRUCTION
IN DS CL80 * INPUT STRING
COUNT DC F'0' * NBR ENTRIES COUNT
*
* TRT TABLE TO CONVERT TO UPPER CASE AND REMOVE NON-ALPHAS
*
TRTAB DC 256C' '
ORG TRTAB+C'a'
DC C'ABCDEFGHI'
ORG TRTAB+C'A'
DC C'ABCDEFGHI'
ORG TRTAB+C'j'
DC C'JKLMNOPQR'
ORG TRTAB+C'J'
DC C'JKLMNOPQR'
ORG TRTAB+C's'
DC C'STUVWXYZ'
ORG TRTAB+C'S'
DC C'STUVWXYZ'
ORG TRTAB+C'-' * RETAIN HYPHENS
DC C'-'
ORG TRTAB+C'''' * RETAIN SINGLE QUOTES
DC C''''
ORG
LTORG * LTERALS NEED TO BE PRIOR TO TABLE
DS 0F * FULL WORD ALIGN
*
* TABLE IS 1000 ENTRIES. EACH ENTRY IS 8 CHARS FOR WORD
* AND 4 BYTES COUNT.
*
TAB DS 12000C
END HEX
Figure 10 Word Count Program
===============================================================================
PRINT NOGEN
EQUREGS
WORDS SUBENTRY
WTO 'WORDS'
USING NODE,R6
LOOP XREAD IN,80
BC B'0100',EOF
TR IN,TRTAB * CVT UPR CASE REM NON-ALPHAS
LA R3,IN
LA R4,80(R0,R3) * ADDRESS OF END OF INPUT
L1 CLI 0(R3),C' ' * BLANK?
BNE L2 * BRANCH NOT BLANK TO PROCESS WORD
L1A LA R3,1(R0,R3) * INCR PTR INTO INPUT
CR R3,R4 * AT END?
BNL LOOP * YES - END OF INPUT STRING
B L1 * NO - PROCESS NEXT CHARACTER
L2 LR R5,R3 * COPY WORD START ADDR TO R5
L3 LA R3,1(R0,R3) * INCR INPUT POINTER
CR R3,R4 * END?
BNL L4 * YES
CLI 0(R3),C' ' * BLANK?
BNE L3 * NO - CONTINUE
L4 LR R6,R3 * COPY WORD END ADDR TO R6
SR R6,R5 * LENGTH OF WORD IN R6
BCTR R6,R0 * decrement R6
MVC OUT(1),BLANK * COPY BLANK TO POSITION 1
MVC OUT+1(29),OUT * PROPOGATE BLANK
EX R6,MVC * COPY WORD TO OUT
L R5,COUNT * NUMBER OF ENTRIES IN TABLE
LA R6,TAB * START OF ARRAY OF ENTRIES
L5 C R5,=F'0' * NO MORE ENTRIES TO LOOK AT?
BE L6 * YES
CLC OUT(8),WRD * COMPARE NEW WORD WITH TABLE ENTRY
BE L7 * FOUND WORD IN TABLE
LA R6,NODELEN(R0,R6) * INCREMENT PTR TO NEXT ENTRY
S R5,=F'1' * DECREMENT LOOP COUNTER
B L5 * CONTINUE
L7 L R5,FREQ * WORD FOUND - LOAD COUNT
A R5,=F'1' * INCR COUNT
ST R5,FREQ * STORE COUNT
B L1A * LOOK FOR NEXT WORD IN INPUT
L6 MVC WRD,OUT * COPY WORD TO TABLE
LA R7,1(R0,R0) * LOAD 1 INTO R7
ST R7,FREQ * STORE IN COUNT FIELD
L R5,COUNT * MAIN COUNT OF ENTRIES
LA R5,1(R0,R5) * INCR
C R5,=F'1000' * TEST LIMIT
BNL ERROR * OVER LIMIT
ST R5,COUNT * STORE UPDATED COUNT
B L1A * PROCESS NEXT INPUT WORD
EOF LA R6,TAB * TABLE ADDRESS
L R5,COUNT * COUNT OF ENTRIES
C R5,=F'0' * EMPTY?
BE BYE * DONE
L8 MVC OUT(8),WRD * COPY WORD TO OUTPUT STRING
L R7,FREQ * LOAD WORD COUNT
XDECO R7,OUT+8 * CVT WORD COUNT TO CHARS
XPRNT OUT,20 * WRITE WORD AND COUNT
LA R6,NODELEN(R0,R6) * INCR TO NEXT ENTRY
BCT R5,L8 * DECR R6 AND REPEAT IF > 0
BYE L R5,COUNT * TOTAL NUMBER OF ENTRIES
XDECO R5,OUT * CVT TO PRINTABLE
XPRNT OUT,12 * PRINT TOTAL
SUBEXIT
ERROR WTO 'ERROR - TABLE OVERFLOW'
SUBEXIT
NODE DSECT
WRD DS CL8
FREQ DS F
NODELEN EQU *-NODE
WORDS CSECT
BLANK DC C' '
OUT DS CL30 * OUTPUT STRING & TEMP STORE
MVC MVC OUT(0),0(R5) * FOR EX INSTRUCTION
IN DS CL80 * INPUT STRING
COUNT DC F'0' * NBR ENTRIES COUNT
*
* TRT TABLE TO CONVERT TO UPPER CASE AND REMOVE NON-ALPHAS
*
TRTAB DC 256C' '
ORG TRTAB+C'a'
DC C'ABCDEFGHI'
ORG TRTAB+C'A'
DC C'ABCDEFGHI'
ORG TRTAB+C'j'
DC C'JKLMNOPQR'
ORG TRTAB+C'J'
DC C'JKLMNOPQR'
ORG TRTAB+C's'
DC C'STUVWXYZ'
ORG TRTAB+C'S'
DC C'STUVWXYZ'
ORG TRTAB+C'-' * RETAIN HYPHENS
DC C'-'
ORG TRTAB+C'''' * RETAIN SINGLE QUOTES
DC C''''
ORG
LTORG * LTERALS NEED TO BE AHEAD OF TABLE
DS 0F * FULL WORD ALIGN
*
* TABLE IS 1000 ENTRIES. EACH ENTRY IS 8 CHARS FOR WORD
* AND 4 BYTES COUNT.
*
TAB DS 12000C
END WORDS
Figure 11 Word Count with DSECT
===============================================================================
PRINT NOGEN
EQUREGS
WORDS SUBENTRY
WTO 'WORDS'
USING NODE,R6 * DSECT BASE
LOOP XREAD IN,80
BC B'0100',EOF
*
* EXTRACT WORDS FROM INPUT LINE
*
TR IN,TRTAB * CVT UPPER CASE & REMOVE NON-ALPHAS
LA R3,IN
LA R4,80(R0,R3) * ADDRESS OF END OF INPUT
L1 CLI 0(R3),C' ' * BLANK?
BNE L2 * BRANCH IF NOT BLANK TO PROCESS WORD
L1A LA R3,1(R0,R3) * INCR PTR INTO INPUT
CR R3,R4 * AT END?
BNL LOOP * YES - END OF INPUT STRING
B L1 * NO - PROCESS NEXT CHARACTER
L2 LR R5,R3 * COPY WORD START ADDR TO R5
L3 LA R3,1(R0,R3) * INCR INPUT POINTER
CR R3,R4 * END?
BNL L4 * YES
CLI 0(R3),C' ' * BLANK?
BNE L3 * NO - CONTINUE
L4 LR R6,R3 * COPY WORD END ADDR TO R6
SR R6,R5 * LENGTH OF WORD IN R6
MVC OUT(1),BLANK * COPY BLANK TO POSITION 1
MVC OUT+1(29),OUT * PROPOGATE BLANK
EX R6,MVC * COPY WORD TO OUT
L R6,START * START ADDR OF ENTRIES
L5 C R6,=F'0' * NO MORE ENTRIES TO LOOK AT?
BE L6 * YES
*
* SEARCH SECTION
*
CLC OUT(L'WRD),WRD * COMP NEW WORD WITH TABLE ENTRY
BE L7 * FOUND WORD IN TABLE
L R6,NEXT
B L5 * CONTINUE
L7 L R5,FREQ * WORD FOUND - LOAD COUNT
A R5,=F'1' * INCR COUNT
ST R5,FREQ * STORE COUNT
B L1A * LOOK FOR NEXT WORD IN INPUT
L6 L R6,CRNT
LA R5,NODELEN(0,R6)
C R5,LIMIT
BNL ERROR
ST R5,CRNT
MVC WRD,OUT * COPY WORD TO TABLE
LA R7,1(R0,R0) * LOAD 1 INTO R7
ST R7,FREQ * STORE IN COUNT FIELD
L R7,START
ST R7,NEXT
ST R6,START
B L1A * PROCESS NEXT INPUT WORD
*
* OUTPUT SECTION
*
EOF L R6,START * FIRST NODE ADDRESS
SR R8,R8 * COUNT WORDS
L8A C R6,=F'0' * NO NODE?
BE BYE * DONE
L8 MVC OUT(L'WRD),WRD * COPY WORD TO OUTPUT STRING
L R7,FREQ * LOAD WORD COUNT
XDECO R7,OUT+8 * CVT WORD COUNT TO CHARS
XPRNT OUT,20 * WRITE WORD AND COUNT
L R6,NEXT * INCR TO NEXT ENTRY
LA R8,1(0,R8) * INCR WORD COUNT
B L8A
BYE XDECO R8,OUT * CVT TO PRINTABLE
XPRNT OUT,12 * PRINT TOTAL
SUBEXIT
ERROR WTO 'ERROR - TABLE OVERFLOW'
SUBEXIT
NODE DSECT
WRD DS CL8
FREQ DS F
NEXT DS A
NODELEN EQU *-NODE
WORDS CSECT
START DC A(0)
BLANK DC C' '
OUT DS CL30 * OUTPUT STRING & TEMP STORE
MVC MVC OUT(0),0(R5) * FOR EX INSTRUCTION
IN DS CL80 * INPUT STRING
COUNT DC F'0' * NBR ENTRIES COUNT
*
* TRT TABLE TO CONVERT TO UPPER CASE AND REMOVE NON-ALPHAS
*
TRTAB DC 256C' '
ORG TRTAB+C'a'
DC C'ABCDEFGHI'
ORG TRTAB+C'A'
DC C'ABCDEFGHI'
ORG TRTAB+C'j'
DC C'JKLMNOPQR'
ORG TRTAB+C'J'
DC C'JKLMNOPQR'
ORG TRTAB+C's'
DC C'STUVWXYZ'
ORG TRTAB+C'S'
DC C'STUVWXYZ'
ORG TRTAB+C'-' * RETAIN HYPHENS
DC C'-'
ORG TRTAB+C'''' * RETAIN SINGLE QUOTES
DC C''''
ORG
LTORG * LTERALS AHEAD OF TABLE
DS 0F * FULL WORD ALIGN
*
* TABLE IS 1000 ENTRIES. EACH IS 8 CHARS FOR WORD
* AND 4 BYTES COUNT.
*
CRNT DC A(TAB)
LIMIT DC A(TAB+16000)
TAB DS 16000C
END WORDS
Figure 12 Word Count with List
===============================================================================
#include <stdio.h>
int main() {
int i,j=3;
double pi = 1.0;
for (i=0;i<500000; i++) {
if (i%2!=0) pi=pi+1.0/j;
else pi=pi-1.0/j;
j=j+2;
}
printf("iterations=%d pi=%f\n",i,4*pi);
return 0;
}
Figure 13 C Calculation of PI
===============================================================================
PRINT NOGEN
TITLE 'Gregory-Leibniz series calculation of PI'
EQUREGS
LCLA &ITER
&ITER SETA 100 * NUMBER OF ITERATIONS
PICALC SUBENTRY
SR R3,R3
ZAP B,=P'1'
XPRNT HDR,L'HDR
LOOP AP B,=P'2' * INCR DENOM: 3, 5, 7
ZAP A,=P'10000000000' * INIT numerator
DP A,B * 1/3, 1/5, 1/7 ...
MVC DEC_FRAC,PAT2
ED DEC_FRAC,A * AMOUNT TO ADD/SUB
MVC DENOM,PAT1
ED DENOM,B * 3, 5, 7 ...
X R3,=F'1' * TOGGLE R3
BNE SUB * NOT ZERO -> SUBTRACT
MVI SGN,C'+'
AP PI,A(6) * ADD
B L1
SUB SP PI,A(6) * SUBTRACT
MVI SGN,C'-'
L1 ZAP P_CRNT,PI
MP P_CRNT,=P'4' * MULT BY 4
MVC P4,PAT2
ED P4,P_CRNT
XPRNT DENOM,OUT_END-DENOM * LEN IS DIFF OF ADDRS
CP B,=P'&ITER' * AGAIN?
BNH LOOP
XPRNT DENOM,OUT_END-DENOM * LEN IS DIFF OF ADDRS
SUBEXIT
A DS PL10
B DS PL4
HDR DC C' DENOM S AMOUNT PI'
DENOM DS CL8
DC C' '
SGN DS C * ADD OR SUBTRACT TERM
DEC_FRAC DS CL12
DC C' '
P4 DS CL13
OUT_END EQU *
PAT1 DC X'F0212020202020202020202020202020' * EXTRA DIGITS
PAT2 DC X'40214B2020202020202020202020'
PI DC PL6'10000000000'
P_CRNT DS PL6
LTORG
END
Figure 14 Iterative Calculation of PI
00009977 + .000100230 3.1417930932
00009979 - .000100210 3.1413922516
00009981 + .000100190 3.1417930128
00009983 - .000100170 3.1413923320
00009985 + .000100150 3.1417929328
00009987 - .000100130 3.1413924124
00009989 + .000100110 3.1417928528
00009991 - .000100090 3.1413924928
00009993 + .000100070 3.1417927728
00009995 - .000100050 3.1413925728
00009997 + .000100030 3.1417926928
00009999 - .000100010 3.1413926528
00010001 + .000099990 3.1417926128
00010001 + .000099990 3.1417926128
Figure 15 PI Iterations
===============================================================================
#include <stdio.h>
#include <stdlib.h7>
int main() {
int arows, acols, brows, bcols;
int *a, *b, *c;
int i, j, k, m;
// read dimensions
scanf("%d %d %d %d",&arows, &acols, &brows, &bcols);
if (acols != brows) {
printf("Incompatible matrices\n");
return 16;
}
// allocate matrices
a = (int *) malloc (arows * acols * 4);
b = (int *) malloc (brows * bcols * 4);
c = (int *) malloc (arows * bcols * 4);
// initialize result matrix
for (i = 0; i< arows * bcols; i++) * (c + i) = 0;
// read a and b matrices
for (i = 0; i < arows * acols; i++) scanf("%d", a + i);
for (i = 0; i < brows * bcols; i++) scanf("%d", b + i);
printf("Matrix A\n");
for (i = 0; i < arows; i++) {
for (j = 0; j < acols; j++) {
printf("%3d ",*(a + i * acols + j));
}
printf("\n");
}
printf("\n");
printf("Matrix B\n");
for (i = 0; i < brows; i++) {
for (j = 0; j < bcols; j++) {
printf("%3d ", * ( b + i * bcols + j));
}
printf("\n");
}
printf("\n");
// calculate product of a and b
for (i = 0; i < arows; i++) { // for each a row
for (j = 0; j < bcols; j++) { // for each b column
for (k = 0; k < acols; k++) { // sum ( a[i][k] * b[k][j] )
*(c+ i * bcols +j) = *(c+ i * bcols +j) + * (a + i * acols
+ k) * *(b+ k * bcols + j);
}
}
}
printf("Matrix C\n");
for (i = 0; i < arows; i++) {
for (j = 0; j < bcols; j++) {
printf("%3d ",* (c + i * bcols + j));
}
printf("\n");
}
return 0;
}
Figure 16 Matrix Multiplication in C
===============================================================================
* #include <stdio.h>
* #include <stdlib.h>
PRINT NOGEN
EQUREGS
* int main()
* {
MAIN SUBENTRY
B L1
* int arows, acols, brows, bcols;
AROWS DS F * NBR ROWS A MATRIX
ACOLS DS F * NBR COLS A MATRIX
BROWS DS F * NBR ROWS B MATRIX
BCOLS DS F * NBR COLS B MATRIX
CROWS DS F * NBR ROWS C MATRIX
CCOLS DS F * NBR COLS A MATRIX
* int *a, *b, *c;
APTR DS A * A ARRAY START
BPTR DS A * B ARRAY START
CPTR DS A * C ARRAY START
AADDR DS A * TEMP
BADDR DS A * TEMP
CADDR DS A * TEMP
* int i, j, k;
* // read dimensions
* scanf("%d %d %d %d",&arows, &acols, &brows,
&bcols);
L1 XREAD IN,L'IN
LA R1,IN
XDECI R2,0(0,R1)
ST R2,AROWS * A ROWS
XDECI R2,0(0,R1)
ST R2,ACOLS * A COLS
XDECI R2,0(0,R1)
ST R2,BROWS * B ROWS
XDECI R2,0(0,R1)
ST R2,BCOLS * B COLS
* if (acols != brows) {
* printf("Incompatible matrices\n");
* return 16;
* }
L R2,ACOLS
C R2,BROWS
BE L2
XPRNT ERR1,L'ERR1
SUBEXIT
ERR1 DC C'Incompatible matrices'
* // allocate matrices
* a = (int *) malloc (arows * acols * 4);
* b = (int *) malloc (brows * bcols * 4);
* c = (int *) malloc (arows * bcols * 4);
L2 L R2,AROWS
ST R2,CROWS * C ROWS
L R2,BCOLS
ST R2,CCOLS * C COLS
* CALCULATE MEMORY NEEDS
SR R2,R2
L R3,AROWS
M R2,ACOLS * AROWS * ACOLS
SLA R3,2 * TIMES 4
LR R4,R3 * NBR BYTES A MATRIX
SR R2,R2
L R3,BROWS
M R2,BCOLS
SLA R3,2
LR R5,R3 * NBR BYTES B MATRIX
SR R2,R2
L R3,AROWS
M R2,BCOLS
SLA R3,2 * NBR BYTES C MATRIX
LR R6,R3
LR R7,R6
AR R7,R5
AR R7,R4 * TOT NBR BYTES NEEDED
GETMAIN RU,LV=(R7) * ALLOCATE MEM - RSLT in R1
ST R1,GADDR * ADDR ALLOC MEM
ST R7,GLEN * LEN ALLOC MEM
* CALCULATE ADDRS OF MATRICES IN ALLOC MEM
ST R1,APTR * ADDR A MATRIX
AR R1,R4 * ADD SIZE OF A MATRIX
ST R1,BPTR * ADDR B MATRIX
AR R1,R5 * ADD SIZE OF B MATRIX
ST R1,CPTR * ADDR C MATRIX
* // initialize result matrix
* for (i = 0; i < arows * bcols; i++) * (c + i) = 0;
L R3,AROWS * NBR A ROWS
SR R2,R2 * ZERO
M R2,BCOLS * TIMES NBR B COLS. ANS IN R3
L R4,CPTR * START OF C MATRIX
L3 ST R2,0(0,R4) * R2 IS ZERO
LA R4,4(0,R4) * INCR TO NXT C WORD
BCT R3,L3 * MORE?
* // read a and b matrices
* for (i = 0; i < arows * acols; i++) scanf("%d",
a + i);
SR R4,R4
L R5,AROWS * NBR A ROWS
M R4,ACOLS * TIMES NBR A COLS
L R6,APTR * ADDR OF A MATRIX
XREAD IN,L'IN * READ LINE
LA R1,IN * ADDR OF INPUT REC
L4 XDECI R3,0(0,R1) * SCAN INPUT
ST R3,0(0,R6)
LA R6,4(0,R6)
BCT R5,L4 * R5 IS COUNT NBR VALS TO READ
* for (i = 0; i < brows * bcols; i++)
scanf("%d", b + i);
SR R4,R4
L R5,BROWS * NBR B ROWS
M R4,BCOLS * TIMES NBR B COLS
L R6,BPTR * ADDR OF B
XREAD IN,L'IN * READ LINE
LA R1,IN * ADDR OF INPUT REC
L5 XDECI R3,0(0,R1) * SCAN INPUT
ST R3,0(0,R6)
LA R6,4(0,R6)
BCT R5,L5 * R5 IS COUNT NBR VALS TO READ
*********************************************************
* printf("Matrix A\n");
* for (i = 0; i < arows; i++) {
* for (j = 0; j < acols; j++) {
* printf("%3d ",*(a + i * acols + j));
* printf("\n");
* }
* printf("\n");
XPRNT MSG1,L'MSG1
L R3,APTR
L R5,AROWS
L7 MVI ROWOUT,C' '
MVC ROWOUT+1(L'ROWOUT-1),ROWOUT
L R6,ACOLS
LA R7,ROWOUT
L6 MVC NUM,NUMPAT * ED PATTERN
L R8,0(0,R3) * MATRIX VALUE
CVD R8,OUT * CVT TO DECIMAL
ED NUM,OUT+6 * CVT TO ZONED
MVC 0(4,R7),NUM * ADD TO ROW
LA R7,4(0,R7) * ROW PTR
LA R3,4(R3) * MATRIX PTR
BCT R6,L6 * FOR EACH ROW
XPRNT ROWOUT,L'ROWOUT
BCT R5,L7 * FOR EACH COL
XPRNT MSG2,L'MSG2
L R3,BPTR * PRINT B - AS ABOVE
L R5,BROWS
L7A MVI ROWOUT,C' '
MVC ROWOUT+1(L'ROWOUT-1),ROWOUT
L R6,BCOLS
LA R7,ROWOUT
L6A MVC NUM,NUMPAT
L R8,0(0,R3)
CVD R8,OUT
ED NUM,OUT+6
MVC 0(4,R7),NUM
LA R7,4(0,R7)
LA R3,4(R3)
BCT R6,L6A
XPRNT ROWOUT,L'ROWOUT
BCT R5,L7A
*********************************************************
* // calculate product of a and b
* for (i = 0; i < arows; i++) { // for each a row
* for (j = 0; j < bcols; j++) { // for each b col
* for (k = 0; k < acols; k++) {
// sum ( a[i][k] * b[k][j] )
* *(c+ i * bcols +j) =
* *(c+ i * bcols + j) + * (a + i * acols + k)
* *(b+ k * bcols + j);
* }
* }
* }
SR R2,R2 * i
SR R3,R3 * j
SR R4,R4 * k
* LOOP ENTRY PTS
L8 SR R3,R3 * re-init j
L9 SR R4,R4 * re-init k
L10 NOPR R0
L R6,CPTR * c
SR R8,R8 * ready for mult
LR R9,R2 * i
M R8,BCOLS * i * bcols
AR R9,R3 * add j
SLA R9,2 * mult by 4.
AR R6,R9 * *(c + i * bcols +j)
ST R6,CADDR
L R6,APTR * a
SR R8,R8 * ready for mult
LR R9,R2 * i
M R8,ACOLS * i * acols
AR R9,R4 * add k
SLA R9,2 * mult by 4.
AR R6,R9 * *(a + i * acols + k)
ST R6,AADDR
L R6,BPTR * b
SR R8,R8 * ready for mult
LR R9,R4 * k
M R8,BCOLS * k * bcols
AR R9,R3 * add j
SLA R9,2 * mult by 4.
AR R6,R9 * *(b + k * bcols + j)
ST R6,BADDR
L R7,CADDR
L R5,0(0,R7) * LOAD C VALUE
SR R8,R8
L R9,AADDR
L R9,0(0,R9) * LOAD A VALUE
L R6,BADDR
M R8,0(0,R6) * MULT B VALUE BY A VALUE
AR R5,R9 * ADD TO C
ST R5,0(0,R7) * STORE TO C
LA R4,1(0,R4)
C R4,ACOLS * k < ACOLS ?
BL L10 * NO - ITERATE
LA R3,1(0,R3)
C R3,BCOLS * j < BCOLS
BL L9 * NO - ITERATE
LA R2,1(0,R2)
C R2,AROWS * i < AROWS ?
BL L8 * NO - ITERATE
*********************************************************
* printf("Matrix C\n");
* for (i = 0; i < arows; i++) {
* for (j = 0; j < bcols; j++) {
* printf("%3d ",* (c + i * bcols + j));
* }
* printf("\n");
* }
XPRNT LINE,L'LINE
* PRINT RESULT - SAME TECHNIQUE USED ABOVE
L R3,CPTR
L R5,CROWS
L11 MVI ROWOUT,C' '
MVC ROWOUT+1(L'ROWOUT-1),ROWOUT
L R6,CCOLS
LA R7,ROWOUT
L12 MVC NUM,NUMPAT
L R8,0(0,R3)
CVD R8,OUT
ED NUM,OUT+6
MVC 0(4,R7),NUM
LA R7,4(0,R7)
LA R3,4(R3)
BCT R6,L12
XPRNT ROWOUT,L'ROWOUT
BCT R5,L11
* return 0;
* }
SUBEXIT
GADDR DS A * ADDR OF GETMAIN AREA
GLEN DS F * AMOUNT GOT
IN DS CL80
OUT DS D
ROWOUT DS CL130
MSG1 DC C'A Matrix'
MSG2 DC C'B Matrix'
NUMPAT DC X'40202120'
NUM DS CL4
LINE DC C'-------------------------
-----------------'
TEMP DS CL12
LTORG
END
Input:
2 3 3 2
1 2 3 4 5 6
7 8 9 10 11 12
Output:
A Matrix
1 2 3
4 5 6
B Matrix
7 8
9 10
11 12
------------------------------------------
58 64
139 154
Figure 17 Matrix Multiplication
===============================================================================