mirror of
https://github.com/pkimpel/retro-220.git
synced 2026-04-07 14:03:59 +00:00
Commit initial MRS-081 sample BALGOL program.
This is the original version of the program and data as transcribed from the report described in the README.txt file. It has the original version of the UNPACK machine-language subroutine, which cannot be used with the version of the BALGOL compiler recovered for the retro-220 project.
This commit is contained in:
Paul Kimpel
21
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card
Normal file
21
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card
Normal file
@@ -0,0 +1,21 @@
|
||||
777 MRS-081 SAMPLE CASE-DATA CARDS FROM TECHNICAL BULLETIN EXAMPLE RUNS
|
||||
5 0967 $LDR$ 01 00 10 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED
|
||||
5 0967 $LDR$ 01 00 10 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 11 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED
|
||||
5 0967 $LDR$ 01 00 09 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 0967 $LDR$ 00 00 10 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED
|
||||
5 0967 $LDR$ 00 00 10 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 11 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED
|
||||
5 0967 $LDR$ 00 00 09 05 11 61 00 *CASE IDENTIFICATION
|
||||
5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
5 0967 $LDR$ 00 00 09 05 11 61 01 *CASE IDENTIFICATION
|
||||
5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT
|
||||
777 PUSHER CARD FOR 087
|
||||
777 PUSHER CARD FOR 087
|
||||
435
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card
Normal file
435
software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card
Normal file
@@ -0,0 +1,435 @@
|
||||
2 COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. CHDD0001
|
||||
2 FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES CHDD0002
|
||||
2 FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING CHDD0003
|
||||
2 PRESENT IN THE PATIENT UNDER CONSIDERATION IS CHDD0004
|
||||
2 CALCULATED AND THOSE GREATER THAN ONE PERCENT CHDD0005
|
||||
2 ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION CHDD0006
|
||||
2 AND CASE INFORMATION. CHDD0007
|
||||
2
|
||||
2 FRED B FIELDING CHDD0008
|
||||
2 SAN FRANCISCO DISTRICT OFFICE CHDD0009
|
||||
2
|
||||
2 CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH CHDD0010
|
||||
2 CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. CHDD0011
|
||||
2 FIRST RELEASE 05 - 31 - 61 $CHDD0012
|
||||
2
|
||||
2
|
||||
2 INTEGER CASENO , CASEIN , SHEET , XRAY , EQUATION , CHDD0013
|
||||
2 MO , DAY , YEAR , LAST , CHDD0014
|
||||
2 E , J , K , P , X , CHDD0015
|
||||
2 TOTE , TOTP , TOTX , OUTSHEET , CHDD0016
|
||||
2 T22 , T2021 , T4243 , T4445 , T6789 , CHDD0017
|
||||
2 ( SYE() , SYP() ) , ( TE() , TP() ) , CHDD0018
|
||||
2 ROW () , MX () , M (,) $ CHDD0019
|
||||
2 REAL SUM , FTROW () , FTMX () , PYKX () , PYX () $ CHDD0020
|
||||
2
|
||||
2 ARRAY ( SYE(20) , SYP(20) ) , ( TE(50) , TP(50) ) , CHDD0021
|
||||
2 ( ROW(51) , FTROW(50) ) , ( MX(10) , FTMX(10) ) , CHDD0022
|
||||
2 PYKX (33) , PYX (33) , M (33,18) $ CHDD0023
|
||||
2
|
||||
2 EXTERNAL PROCEDURE UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $CHDD0024
|
||||
2
|
||||
2 COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX. $CHDD0025
|
||||
2 INPUT MATRIX(FOR K=(1,1,33) $ FOR J=(1,1,18) $ M(K,J) ) $CHDD0026
|
||||
2 READ ( $ $ MATRIX ) $ CHDD0027
|
||||
2
|
||||
2 COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS CHDD0028
|
||||
2 ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, CHDD0029
|
||||
2 THE NUMBER OF SYMPTOMS ARE CALCULATED, CHDD0030
|
||||
2 AND THE EQUATION TYPE DETERMINED. $ CHDD0031
|
||||
2
|
||||
2 NEWCASE.. FOR P = (1,1,20) $ SYP (P) = 0 $ CHDD0032
|
||||
2 FOR J = (1,1,50) $ TP (J) = ROW (J) = 0 $ CHDD0033
|
||||
2 FOR J = (1,1,50) $ FTROW (J) = 0.0 $ CHDD0034
|
||||
2 INPUT CASE (CASENO,CASEIN,SHEET,XRAY,EQUATION, CHDD0035
|
||||
2 MO,DAY,YEAR,LAST ) $ CHDD0036
|
||||
2 CARD1.. READ ( $ $ CASE ) $ CHDD0037
|
||||
2 OUTPUT IDOUT ( CASENO , CASEIN , MO , DAY , YEAR ) $ CHDD0038
|
||||
2 FORMAT IDFORM (B5,*CASE NUMBER*,I7,B5, CHDD0039
|
||||
2*PATIENT*,B2,A3,B5,*DATE*,B1,3(I3),W3 ) $ CHDD0040
|
||||
2 WRITE ( $ $ IDOUT , IDFORM) $ CHDD0041
|
||||
2 INPUT PRESENT ( FOR P = (1,1,20) $ SYP (P) ) $ CHDD0042
|
||||
2 CARD2.. READ ( $ $ PRESENT ) $ CHDD0043
|
||||
2 P = 1 $ CHDD0044
|
||||
2 FOR J = (1,1,50) $ CHDD0045
|
||||
2 BEGIN CHDD0046
|
||||
2 IF SYP (P) EQL J $ CHDD0047
|
||||
2 ( TP (J) = 1 $ P = P+1 ) CHDD0048
|
||||
2 END $ CHDD0049
|
||||
2 TOTP = P - 1 $ CHDD0050
|
||||
2 OUTPUT POUT ( FOR P = (1,1,TOTP) $ SYP (P) ) $ CHDD0051
|
||||
2 FORMAT PFORM (B5,*SYMPTOMS PRESENT*,B4,20(I4),W4) $ CHDD0052
|
||||
2 WRITE ( $ $ POUT , PFORM ) $ CHDD0053
|
||||
2 K = 1 $ CHDD0054
|
||||
2 IF SHEET EQL 1 $ CHDD0055
|
||||
2 ( OUTSHEET = 6600000000 $ GO TO EQTEST ) $ CHDD0056
|
||||
2 OUTSHEET = 4200000000 $ CHDD0057
|
||||
2 EQTEST.. IF EQUATION EQL 10 $ GO TO EQ10 $ CHDD0058
|
||||
2
|
||||
2 COMMENT CALCULATE PROBABILITIES USING EQUATION 9. $ CHDD0059
|
||||
2
|
||||
2
|
||||
2 COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE CHDD0060
|
||||
2 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED. $CHDD0061
|
||||
2
|
||||
2 XP9.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0062
|
||||
2 FOR J = (8,1,16), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0063
|
||||
2 ( IF TP (J) EQL 1 $ ROW (J) = 1000 - ROW (J) ) $CHDD0064
|
||||
2
|
||||
2 COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.$CHDD0065
|
||||
2 PYKX (K) = M (K,1) $ CHDD0066
|
||||
2 FOR P = (1,1,TOTP) $ CHDD0067
|
||||
2 BEGIN CHDD0068
|
||||
2 IF ROW ( SYP(P) ) EQL 0 $ CHDD0069
|
||||
2 ( PYKX (K) = 0.0 $ GO TO TAL9 ) $ CHDD0070
|
||||
2 FTROW (P) = ROW ( SYP(P) ) CHDD0071
|
||||
2 END $ CHDD0072
|
||||
2
|
||||
2 FOR P = (1,1,TOTP) $ CHDD0073
|
||||
2 PYKX (K) = PYKX (K).FTROW (P) $ CHDD0074
|
||||
2
|
||||
2 TAL9.. K = K+1 $ CHDD0075
|
||||
2 IF K LEQ 33 $ GO TO XP9 $ CHDD0076
|
||||
2 GO TO NORM $ CHDD0077
|
||||
2
|
||||
2
|
||||
2 COMMENT CALCULATE PROBABILITIES USING EQUATION 10. $ CHDD0078
|
||||
2
|
||||
2 EQ10.. FOR J = (1,1,50) $ TE (J) = 0 $ CHDD0079
|
||||
2 FOR E = (1,1,20) $ SYE (E) = 0 $ CHDD0080
|
||||
2 FOR X = (1,1,10) $ MX (X) = 0 $ CHDD0081
|
||||
2 FOR X = (1,1,10) $ FTMX (X) = 0.0 $ CHDD0082
|
||||
2
|
||||
2 COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF CHDD0083
|
||||
2 OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS CHDD0084
|
||||
2 TO BE OMITTED FOR THIS CASE IS CALCULATED. $ CHDD0085
|
||||
2
|
||||
2 INPUT ( EXCLUDE ( FOR E = (1,1,20) $ SYE (E) ) ) $ CHDD0086
|
||||
2 CARD3.. READ ( $ $ EXCLUDE ) $ CHDD0087
|
||||
2 E = 1 $ CHDD0088
|
||||
2 FOR J = (1,1,50) $ CHDD0089
|
||||
2 BEGIN CHDD0090
|
||||
2 IF SYE (E) EQL J $ CHDD0091
|
||||
2 ( TE (J) = 1 $ E = E+1 ) CHDD0092
|
||||
2 END $ CHDD0093
|
||||
2 TOTE = E-1 $ CHDD0094
|
||||
2 OUTPUT EOUT ( FOR E = (1,1,TOTE+1) $ SYE (E) ) $ CHDD0095
|
||||
2 FORMAT EFORM (B5,*SYMPTOMS OMITTED*,B4,20(I4),W4) $ CHDD0096
|
||||
2 WRITE ( $ $ EOUT , EFORM ) $ CHDD0097
|
||||
2 TOTX = SHEET+8 $ CHDD0098
|
||||
2
|
||||
2 COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE CHDD0099
|
||||
2 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, CHDD0100
|
||||
2 AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED. $CHDD0101
|
||||
2
|
||||
2 XP10.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0102
|
||||
2 FOR J = (8,1,15) , 24, 25, (30,1,33), 38, 39, 50 $CHDD0103
|
||||
2 BEGIN CHDD0104
|
||||
2 IF TP(J) EQL 1 $ ROW (J) = 1000 - ROW (J) $ CHDD0105
|
||||
2 IF ROW (J) EQL 0 $ CHDD0106
|
||||
2 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0107
|
||||
2 IF TE (J) EQL 1 $ ROW (J) = 0 CHDD0108
|
||||
2 END $ CHDD0109
|
||||
2
|
||||
2 COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT CHDD0110
|
||||
2 SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED CHDD0111
|
||||
2 FOR, AND EACH ELEMENT SCALED. $CHDD0112
|
||||
2
|
||||
2 PYKX (K)= M (K,1) $ CHDD0113
|
||||
2 FOR J= (8,1,15), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0114
|
||||
2 BEGIN CHDD0115
|
||||
2 FTROW(J) = ROW(J) $ FTROW(J) = FTROW(J)/100.0 $ CHDD0116
|
||||
2 IF FTROW (J) NEQ 0.0 $ CHDD0117
|
||||
2 PYKX (K) = PYKX(K).FTROW(J) CHDD0118
|
||||
2 END $ CHDD0119
|
||||
2
|
||||
2
|
||||
2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0120
|
||||
2 EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND CHDD0121
|
||||
2 WHITE SYMPTOM CHECK SHEETS PER TABLE V. $ CHDD0122
|
||||
2
|
||||
2 X1TO3.. MX (1) = ROW ( SYP (1) ) $ CHDD0123
|
||||
2 X4TO7.. IF TE (4) EQL 1 $ CHDD0124
|
||||
2 ( MX (2) = 100 $ GO TO X26 ) $ CHDD0125
|
||||
2 IF SYP (2) LEQ 7 $ CHDD0126
|
||||
2 ( MX (2) = ROW ( SYP(2) ) $ GO TO X26 ) $ CHDD0127
|
||||
2 MX (2) = 1000 - ROW(4) - ROW(5) - ROW(6) - ROW(7) $CHDD0128
|
||||
2 X26.. X = 3 $ CHDD0129
|
||||
2 FOR J = 26 , 28, 34, 36 $ CHDD0130 // WAS: FOR J =*26 , ... (407 MISPRINT?)
|
||||
2 BEGIN CHDD0131
|
||||
2 IF TE (J) EQL 1 $ CHDD0132
|
||||
2 ( MX (X) = 100 $ GO TO LAB5 ) $ CHDD0133
|
||||
2 IF TP (J) EQL TP (J+1) $ CHDD0134
|
||||
2 ( MX(X) = 1000 - ROW(J) - ROW(J+1) $ GO TO LAB5 ) $CHDD0135
|
||||
2 IF TP (J) EQL 1 $ CHDD0136
|
||||
2 ( MX (X) = ROW (J) $ GO TO LAB5 ) $ CHDD0137
|
||||
2 MX (X) = ROW (J+1) $ CHDD0138
|
||||
2 LAB5.. X = X+1 CHDD0139
|
||||
2 END $ CHDD0140
|
||||
2
|
||||
2 BNORWH.. IF SHEET EQL 1 $ GO TO WHITE $ CHDD0141
|
||||
2
|
||||
2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0142
|
||||
2 EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION. $CHDD0143
|
||||
2
|
||||
2 BROWN.. IF TP (16) EQL 1 $ ROW (16) = 1000 - ROW (16) $CHDD0144
|
||||
2 IF ROW (16) EQL 0 $ CHDD0145
|
||||
2 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0146
|
||||
2 IF TE (16) EQL 1 $ CHDD0147
|
||||
2 ( ROW (16) = 0 $ GO TO X17TO19 ) $ CHDD0148
|
||||
2 BEGIN CHDD0149
|
||||
2 FTROW (16) = ROW (16) $ CHDD0150
|
||||
2 PYKX (K) = PYKX (K).FTROW (16) / 100.0 CHDD0151
|
||||
2 END $ CHDD0152
|
||||
2 X17TO19.. IF TE (17) EQL 1 $ CHDD0153
|
||||
2 ( MX (7) =100 $ GO TO X20 ) $ CHDD0154
|
||||
2 IF ( TP(17) EQL TP(18) ) AND ( TP(18) EQL TP(19) ) $CHDD0155
|
||||
2 BEGIN CHDD0156
|
||||
2 MX(7) =(1000-ROW(17)).(1000-ROW(18)).(1000-ROW(19)) $CHDD0157
|
||||
2 GO TO X20 CHDD0158
|
||||
2 END $ CHDD0159
|
||||
2 IF TP (19) EQL 1 $ CHDD0160
|
||||
2 ( MX (7) = ROW (19) $ GO TO X20 ) $ CHDD0161
|
||||
2 IF TP (17) EQL 0 $ CHDD0162
|
||||
2 ( MX(7) = ROW(18).(1000 - ROW(17) ) $ GO TO X20 ) $CHDD0163
|
||||
2 IF TP (18) EQL 0 $ CHDD0164
|
||||
2 ( MX(7) = ROW(17).(1000 - ROW(18) ) $ GO TO X20 ) $CHDD0165
|
||||
2 MX (7) = ROW(17).ROW(18) $ CHDD0166
|
||||
2
|
||||
2 X20.. IF TE (20) EQL 1 $ CHDD0167
|
||||
2 ( MX (8) = 100 $ GO TO FLTMX ) $ CHDD0168
|
||||
2 T2021 = ( 1000 - ROW (20) - ROW (21) ) $ CHDD0169
|
||||
2 T22 = ( 1000 0 ROW (22) ) $ CHDD0170
|
||||
2
|
||||
2 IF ( TP(20) EQL TP(21) ) AND ( TP(21) EQL TP(22) ) CHDD0171
|
||||
2 AND ( TP(22) EQL TP(23) ) $ CHDD0172
|
||||
2 (MX(8) = T2021.T22.(1000 - ROW(23) ) $ GO TO FLTMX )$CHDD0173
|
||||
2 IF TP (20) EQL 1 $ CHDD0174
|
||||
2 BEGIN CHDD0175
|
||||
2 IF TP (22) EQL 1 $ CHDD0176
|
||||
2 ( MX(8) = ROW(20).ROW(22) $ GO TO FLTMX ) $ CHDD0177
|
||||
2 MX (8) = ROW (20).T22 $ GO TO FLTMX CHDD0178
|
||||
2 END $ CHDD0179
|
||||
2 CHDD0180
|
||||
2 IF TP (21) EQL 1 $ CHDD0181
|
||||
2 BEGIN CHDD0182
|
||||
2 IF TP (22) EQL 1 $ CHDD0183
|
||||
2 ( MX(8) = ROW(21).ROW(22) $ GO TO FLTMX ) $ CHDD0184
|
||||
2 MX (8) = ROW (21).T22 $ GO TO FLTMX CHDD0185
|
||||
2 END $ CHDD0186
|
||||
2 IF TP (22) EQL 1 $ CHDD0187
|
||||
2 ( MX(8) = ROW(22).T2021 $ GO TO FLTMX ) $ CHDD0188
|
||||
2 MX (8) = ROW (23) $ GO TO FLTMX $ CHDD0189
|
||||
2
|
||||
2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0190
|
||||
2 EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION. $CHDD0191
|
||||
2
|
||||
2 WHITE.. IF (TE(19) EQL TE(42) ) AND ( TE(42) EQL TE(44) ) CHDD0192
|
||||
2 AND ( TE(44) EQL 1 ) $ CHDD0193
|
||||
2 ( MX (7) = 100 $ GO TO X40 ) $ CHDD0194
|
||||
2 T4243 = ( 1000 - ROW(42) - ROW(43) ) $ CHDD0195
|
||||
2 T4445 = ( 1000 - ROW(44) - ROW(45) ) $ CHDD0196
|
||||
2
|
||||
2 IF ( TP(19) EQL TP(42) ) AND ( TP(42) EQL TP(43) ) CHDD0197
|
||||
2 AND ( TP(43) EQL TP(44) ) AND ( TP(44) EQL TP(45) ) $CHDD0198
|
||||
2 ( MX(7) = (1000 - ROW(19)).T4243.T4445 $ GO TO X40 )$CHDD0199
|
||||
2 IF TP (19) EQL 1 $ CHDD0200
|
||||
2 ( MX(7) = ROW(19) $ GO TO X40 ) $ CHDD0201
|
||||
2 IF TP (42) EQL 1 $ CHDD0202
|
||||
2 BEGIN CHDD0203
|
||||
2 IF TP(44) EQL 1 $ CHDD0204
|
||||
2 ( MX(7) = ROW(42).ROW(44) $ GO TO X40 ) $ CHDD0205
|
||||
2 IF TP (45) EQL 1 $ CHDD0206
|
||||
2 ( MX(7) = ROW(42).ROW(45) $ GO TO X40 ) $ CHDD0207
|
||||
2 MX (7) = ROW (42).T4445 $ GO TO X40 CHDD0208
|
||||
2 END $ CHDD0209
|
||||
2 IF TP (43) EQL 1 $ CHDD0210
|
||||
2 BEGIN CHDD0211
|
||||
2 IF TP (44) EQL 1 $ CHDD0212
|
||||
2 ( MX(7) = ROW(43).ROW(44) $ GO TO X40 ) $ CHDD0213
|
||||
2 IF TP (45) EQL 1 $ CHDD0214
|
||||
2 ( MX(7) = ROW(43).ROW(45) $ GO TO X40 ) $ CHDD0215
|
||||
2 MX (7) = ROW (43).T4445 $ GO TO X40 CHDD0216
|
||||
2 END $ CHDD0217
|
||||
2 IF TP (44) EQL 1 $ CHDD0218
|
||||
2 ( MX(7) = ROW(44).T4243 $ GO TO X40 ) $ CHDD0219
|
||||
2 MX (7) = ROW (45).T4243 $ CHDD0220
|
||||
2
|
||||
2 X40.. IF TE (40) EQL 1 $ CHDD0221
|
||||
2 ( MX (8) = 100 $ GO TO X2369 ) $ CHDD0222
|
||||
2 IF TP (40) EQL TP (41) $ CHDD0223
|
||||
2 ( MX(8) = 1000 - ROW(40) - ROW(41) $ GO TO X2369 ) $CHDD0224
|
||||
2 IF TP (40) EQL 1 $ CHDD0225
|
||||
2 ( MX(8) = ROW(40) $ GO TO X2369 ) $ CHDD0226
|
||||
2 MX (8) = ROW (41) $ CHDD0227
|
||||
2
|
||||
2 X2369.. IF ( TE(22) EQL TE(46) ) AND ( TE(46) EQL 1 ) $ CHDD0228
|
||||
2 ( MX (9) = 100 $ GO TO FLTMX ) $ CHDD0229
|
||||
2 T22 = 1000 - ROW (22) $ CHDD0230
|
||||
2 T6789 = 1000 - ROW(46) - ROW(47) - ROW(48) - ROW(49)$CHDD0231
|
||||
2 IF ( TP(22) EQL TP(23) ) AND ( TP(23) EQL TP(46) ) CHDD0232
|
||||
2 AND ( TP(46) EQL TP(47) ) AND ( TP(47) EQL TP(48) ) CHDD0233
|
||||
2 AND ( TP(48) EQL TP(49) ) $ CHDD0234
|
||||
2 ( MX(9) = T22.(1000 - ROW(23)).T6789 $ GO TO FLTMX)$CHDD0235
|
||||
2 IF TP (22) EQL 1 $ CHDD0236
|
||||
2 BEGIN CHDD0237
|
||||
2 FOR J = (46,1,49) $ CHDD0238
|
||||
2 BEGIN CHDD0239
|
||||
2 IF TP (J) EQL 1 $ CHDD0240
|
||||
2 ( MX(9) = ROW(J).ROW(22) $ GO TO FLTMX ) CHDD0241
|
||||
2 END $ CHDD0242
|
||||
2 MX (9) = ROW (22).T6789 $ GO TO FLTMX CHDD0243
|
||||
2 END $ CHDD0244
|
||||
2 FOR J = (46,1,49) $ CHDD0245
|
||||
2 BEGIN CHDD0246
|
||||
2 IF TP (J) EQL 1 $ CHDD0247
|
||||
2 ( MX(9) = ROW(J).T22 $ GO TO FLTMX ) CHDD0248
|
||||
2 END $ CHDD0249
|
||||
2 MX (9) = ROW (23) $ GO TO FLTMX $ CHDD0250
|
||||
2
|
||||
2 FLTMX.. FOR X = (1,1,TOTX) $ CHDD0251
|
||||
2 ( FTMX(X) = MX(X) $ FTMX(X) = FTMX(X)/100.00 ) $ CHDD0252
|
||||
2 FOR X = (1,1,TOTX) $ CHDD0253
|
||||
2 PYKX (K) = PYKX (K).FTMX (X) $ CHDD0254
|
||||
2
|
||||
2 COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED CHDD0255
|
||||
2 AND A TEST IS MADE TO DETERMINE WHETHER THERE CHDD0256
|
||||
2 ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT. $CHDD0257
|
||||
2
|
||||
2 TAL10.. K = K+1 $ CHDD0258
|
||||
2 IF K LEQ 33 $ GO TO XP10 $ CHDD0259
|
||||
2 GO TO NORM $ CHDD0260
|
||||
2
|
||||
2 COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A CHDD0261
|
||||
2 TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED. $CHDD0262
|
||||
2
|
||||
2 NORM.. SUM = 0.0 $ CHDD0263
|
||||
2 OUTPUT SHOUT ( OUTSHEET ) $ CHDD0264
|
||||
2 FORMAT SHFORM(B5,*SYMPTOMS USED*,B3,A2,W4) $ CHDD0265
|
||||
2 WRITE ( $ $ SHOUT , SHFORM ) $ CHDD0266
|
||||
2 FOR K = (1,1,33) $ CHDD0267
|
||||
2 SUM = SUM + PYKX (K) $ CHDD0268
|
||||
2 OUTPUT EQOUT ( EQUATION ) $ CHDD0269
|
||||
2 FORMAT EQFORM(B5,*EQUATION USED*,I5,W6) $ CHDD0270
|
||||
2 WRITE ( $ $ EQOUT , EQFORM ) $ CHDD0271
|
||||
2 FOR K = (1,1,33) $ CHDD0272
|
||||
2 PYX (K) = PYKX (K) / SUM $ CHDD0273
|
||||
2
|
||||
2
|
||||
2
|
||||
2 FORMAT HEAD(B15,*DISEASE*,B5,*PROBABILITY*,W6) $ CHDD0274
|
||||
2 WRITE ( $ $ HEAD ) $ CHDD0275
|
||||
2
|
||||
2 COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE CHDD0276
|
||||
2 PERCENT OR GREATER TOGETHER WITH DISEASE I. D. . $CHDD0277
|
||||
2
|
||||
2 K = 1 $ CHDD0278
|
||||
2 PRINT.. IF PYX (K) LSS 0.01 $ GO TO TALPT $ CHDD0279
|
||||
2 SWITCH K, ( Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, CHDD0280
|
||||
2 Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, CHDD0281
|
||||
2 Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33 ) $CHDD0282
|
||||
2 OUTPUT ANS ( FOR X = K $ PYX (X) ) $ CHDD0283
|
||||
2 FORMAT FORM1 (B8,*Y01*,B7,*N*,S16.4,W0) $ CHDD0284
|
||||
2 Y01.. WRITE ( $ $ ANS , FORM1 ) $ GO TO TALPT $ CHDD0285
|
||||
2 FORMAT FORM2 (B8,*Y02*,B5,*A S D*,S14.4,W0) $ CHDD0286
|
||||
2 Y02.. WRITE ( $ $ ANS , FORM2 ) $ GO TO TALPT $ CHDD0287
|
||||
2 FORMAT FORM3 (B8,*Y03*,B2,*A S D - P S*,S11.4,W0) $ CHDD0288
|
||||
2 Y03.. WRITE ( $ $ ANS , FORM3 ) $ GO TO TALPT $ CHDD0289
|
||||
2 FORMAT FORM4 (B8,*Y04*,B2,*A S D - P H*,S11.4,W0) $ CHDD0290
|
||||
2 Y04.. WRITE ( $ $ ANS , FORM4 ) $ GO TO TALPT $ CHDD0291
|
||||
2 FORMAT FORM5 (B8,*Y05*,B4,*C E C D*,S13.4,W0) $ CHDD0292
|
||||
2 Y05.. WRITE ( $ $ ANS , FORM5 ) $ GO TO TALPT $ CHDD0293
|
||||
2 FORMAT FORM6 (B8,*Y06*,B3,*P A P V C*,S12.4,W0) $ CHDD0294
|
||||
2 Y06.. WRITE ( $ $ ANS , FORM6 ) $ GO TO TALPT $ CHDD0295
|
||||
2 FORMAT FORM7 (B8,*Y07*,B3,*T A P V C*,S12.4,W0) $ CHDD0296
|
||||
2 Y07.. WRITE ( $ $ ANS , FORM7 ) $ GO TO TALPT $ CHDD0297
|
||||
2 FORMAT FORM8 (B8,*Y08*,B6,*T A*,S15.4,W0) $ CHDD0298
|
||||
2 Y08.. WRITE ( $ $ ANS , FORM8 ) $ GO TO TALPT $ CHDD0299
|
||||
2 FORMAT FORM9 (B8,*Y09*,B5,*EBST.*,S14.4,W0) $ CHDD0300
|
||||
2 Y09.. WRITE ( $ $ ANS , FORM9 ) $ GO TO TALPT $ CHDD0301
|
||||
2 FORMAT FORM10(B8,*Y10*,B1,*V S D - V P S*,S10.4,W0) $ CHDD0302
|
||||
2 Y10.. WRITE ( $ $ ANS , FORM10 ) $ GO TO TALPT $ CHDD0303
|
||||
2 FORMAT FORM11(B8,*Y11*,B1,*V S D - I P S*,S10.4,W0) $ CHDD0304
|
||||
2 Y11.. WRITE ( $ $ ANS , FORM11 ) $ GO TO TALPT $ CHDD0305
|
||||
2 FORMAT FORM12(B8,*Y12*,B5,*V P S*,S14.4,W0) $ CHDD0306
|
||||
2 Y12.. WRITE ( $ $ ANS , FORM12 ) $ GO TO TALPT $ CHDD0307
|
||||
2 FORMAT FORM13(B8,*Y13*,B5,*I P S*,S14.4,W0) $ CHDD0308
|
||||
2 Y13.. WRITE ( $ $ ANS , FORM13 ) $ GO TO TALPT $ CHDD0309
|
||||
2 FORMAT FORM14(B8,*Y14*,B3,*P. ATRES.*,S12.4,W0) $ CHDD0310
|
||||
2 Y14.. WRITE ( $ $ ANS , FORM14 ) $ GO TO TALPT $ CHDD0311
|
||||
2 FORMAT FORM15(B8,*Y15*,B2,*COARCT. P A*,S11.4,W0) $ CHDD0312
|
||||
2 Y15.. WRITE ( $ $ ANS , FORM15 ) $ GO TO TALPT $ CHDD0313
|
||||
2 FORMAT FORM16(B8,*Y16*,B6,*P H*,S15.4,W0) $ CHDD0314
|
||||
2 Y16.. WRITE ( $ $ ANS , FORM16 ) $ GO TO TALPT $ CHDD0315
|
||||
2 FORMAT FORM17(B8,*Y17*,B5,*A P W*,S14.4,W0) $ CHDD0316
|
||||
2 Y17.. WRITE ( $ $ ANS , FORM17 ) $ GO TO TALPT $ CHDD0317
|
||||
2 FORMAT FORM18(B8,*Y18*,B5,*P D A*,S14.4,W0) $ CHDD0318
|
||||
2 Y18.. WRITE ( $ $ ANS , FORM18 ) $ GO TO TALPT $ CHDD0319
|
||||
2 FORMAT FORM19(B8,*Y19*,B2,*P A-V FIST.*,S11.4,W0) $ CHDD0320
|
||||
2 Y19.. WRITE ( $ $ ANS , FORM19 ) $ GO TO TALPT $ CHDD0321
|
||||
2 FORMAT FORM20(B8,*Y20*,B6,*M S*,S15.4,W0) $ CHDD0322
|
||||
2 Y20.. WRITE ( $ $ ANS , FORM20 ) $ GO TO TALPT $ CHDD0323
|
||||
2 FORMAT FORM21(B8,*Y21*,B4,*MYOC. D*,S13.4,W0) $ CHDD0324
|
||||
2 Y21.. WRITE ( $ $ ANS , FORM21 ) $ GO TO TALPT $ CHDD0325
|
||||
2 FORMAT FORM22(B8,*Y22*,B2,*A O COR. A*,S12.4,W0) $ CHDD0326
|
||||
2 Y22.. WRITE ( $ $ ANS , FORM22 ) $ GO TO TALPT $ CHDD0327
|
||||
2 FORMAT FORM23(B8,*Y23*,B2,*A S - VALV.*,S11.4,W0) $ CHDD0328
|
||||
2 Y23.. WRITE ( $ $ ANS , FORM23 ) $ GO TO TALPT $ CHDD0329
|
||||
2 FORMAT FORM24(B8,*Y24*,B2,*A S - SUB.*,S12.4,W0) $ CHDD0330
|
||||
2 Y24.. WRITE ( $ $ ANS , FORM24 ) $ GO TO TALPT $ CHDD0331
|
||||
2 FORMAT FORM25(B8,*Y25*,B3,*COARCT. A*,S12.4,W0) $ CHDD0332
|
||||
2 Y25.. WRITE ( $ $ ANS , FORM25 ) $ GO TO TALPT $ CHDD0333
|
||||
2 FORMAT FORM26(B8,*Y26*,B4,*TRUNC.*,S14.4,W0) $ CHDD0334
|
||||
2 Y26.. WRITE ( $ $ ANS , FORM26 ) $ GO TO TALPT $ CHDD0335
|
||||
2 FORMAT FORM27(B8,*Y27*,B3,*TRANSP.*,S14.4,W0) $ CHDD0336
|
||||
2 Y27.. WRITE ( $ $ ANS , FORM27 ) $ GO TO TALPT $ CHDD0337
|
||||
2 FORMAT FORM28(B8,*Y28*,B3,*C TRANSP.*,S12.4,W0) $ CHDD0338
|
||||
2 Y28.. WRITE ( $ $ ANS , FORM28 ) $ GO TO TALPT $ CHDD0339
|
||||
2 FORMAT FORM29(B8,*Y29*,B4,*AB. A O*,S13.4,W0) $ CHDD0340
|
||||
2 Y29.. WRITE ( $ $ ANS , FORM29 ) $ GO TO TALPT $ CHDD0341
|
||||
2 FORMAT FORM30(B8,*Y30*,B5,*V S D*,S14.4,W0) $ CHDD0342
|
||||
2 Y30.. WRITE ( $ $ ANS , FORM30 ) $ GO TO TALPT $ CHDD0343
|
||||
2 FORMAT FORM31(B8,*Y31*,B2,*V S D - P H*,S11.4,W0) $ CHDD0344
|
||||
2 Y31.. WRITE ( $ $ ANS , FORM31 ) $ GO TO TALPT $ CHDD0345
|
||||
2 FORMAT FORM32(B8,*Y32*,B2,*P D A - P H*,S11.4,W0) $ CHDD0346
|
||||
2 Y32.. WRITE ( $ $ ANS , FORM32 ) $ GO TO TALPT $ CHDD0347
|
||||
2 FORMAT FORM33(B8,*Y33*,B1,*T A - TRANSP.*,S10.4,W0) $ CHDD0348
|
||||
2 Y33.. WRITE ( $ $ ANS , FORM33 ) $ GO TO TALPT $ CHDD0349
|
||||
2
|
||||
2 TALPT.. K = K+1 $ CHDD0350
|
||||
2 IF K LEQ 33 $ GO TO PRINT $ CHDD0351
|
||||
2
|
||||
2 COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE CHDD0352
|
||||
2 CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS CHDD0353
|
||||
2 H W APPEAR IN THE A-REG. UPON COMPLETION. $CHDD0354
|
||||
2
|
||||
2 IF LAST EQL 0 $ GO TO NEWCASE $ CHDD0355
|
||||
2 STOP 7270061216 $ GO TO NEWCASE $ CHDD0356
|
||||
2 FINISH $ CHDD0357
|
||||
2 UNPACK
|
||||
605 7009901000080002400088800014000898000046008680000100104
|
||||
605 8041040009080401260090800001000918000041010380210370012
|
||||
605 8021626008680000300053802042600868000044006580000300066
|
||||
605 8020526008680421260090800001000948000044006580000300066
|
||||
605 0000001000080427260090800001000968000044006580000300066
|
||||
605 8000010010180201360040800001000908041040003500000010000
|
||||
605 8020126008680433270090800001000928000044006580000300066
|
||||
605 0000046000080000300060000000100000000001000000000010000
|
||||
605 8000010010480000120097804104000488000010009980000120093
|
||||
605 8041040004600000100000000004800060031040000000000010000
|
||||
605 8020226008680409270090800001000958000044006580000300066
|
||||
605 8000030006000000010000000000100000000001000000000010000
|
||||
605 8000042008880000410089800001000008041040006400000300000
|
||||
605 0000030000080000420090800001200998041040007280410400070
|
||||
605 0000041000080401260072000001000000000149000410310400000
|
||||
605 8000120007600001490003103104000008000120007900001490003
|
||||
605 1031040000080001200082802012700868000032007180000460086
|
||||
602 8000030006500000000001
|
||||
604 00000010000000000100000000001000000000010000
|
||||
604 00000 2000000000070000000000800000000009
|
||||
604 00000 15000000000180000000001900000000001
|
||||
601 40000000007
|
||||
601 40000990000
|
||||
2 FINISH $
|
||||
777 SYMPTOM-DISEASE MATRIX DATA CARDS FOLLOW THIS CARD
|
||||
777 CASE DATA CARDS FOLLOW THIS CARD
|
||||
85
software/BALGOL/BALGOL-Examples/MRS-081/README.txt
Normal file
85
software/BALGOL/BALGOL-Examples/MRS-081/README.txt
Normal file
@@ -0,0 +1,85 @@
|
||||
Index of folder retro-220/software/BALGOL/BALGOL-Examples/MRS-081:
|
||||
|
||||
Source, object, and compilation listings for BALGOL program from
|
||||
Burroughs Technical Bulletin 156, 8 June 1961, Mathematical Report
|
||||
Series MRS-081, "Diagnosis of Congenital Heart Disease from Clinical
|
||||
Data Using the Burroughs 220 Computer". The program listing is included
|
||||
in the report and is noted as having been written by Fred B. Fielding of
|
||||
the Burroughs San Francisco District office in May 1961.
|
||||
|
||||
This report was discovered in the Burroughs Corporation Records, Product
|
||||
Literature (CBI 90), Charles Babbage Institute, University of
|
||||
Minnesota, Minneapolis, Series 74, Box 43, Folder 8.
|
||||
|
||||
The program and report are based on a paper, "A Mathematical Approach to
|
||||
Medical Diagnosis Applied to Congenital Heart Disease" by H. R. Warner,
|
||||
A. F. Toronto, L.G. Veasy, and R. Stevenson. Journal of the American
|
||||
Medical Association,
|
||||
|
||||
The report describes a program for computing the probability of a set of
|
||||
congenital heart diseases occurring in a patient given the presence of a
|
||||
set of symptoms observed in the patient. It includes sample data and an
|
||||
example of using a machine-language routine with a BALGOL program.
|
||||
|
||||
To run the program, load the following decks into the Cardatron card
|
||||
reader in the order indicated and compile with the BALGOL compiler:
|
||||
|
||||
1. BALGOL compiler call-out card.
|
||||
2. MRS-081.card deck -- BALGOL source and machine-language cards.
|
||||
3. SYMPTOM-DATA.card deck.
|
||||
4. Case-data card deck, e.g., MRS-081-DATA.card.
|
||||
|
||||
|
||||
MRS-081.card
|
||||
The BALGOL source deck, including the object deck for the machine-
|
||||
language subprogram. This is the original version, as transcribed
|
||||
from the report.
|
||||
|
||||
MRS-081-DATA.card
|
||||
Sample case-data card deck for input to the program, derived from
|
||||
sample run data in the report. This data must be inserted at the end
|
||||
of MRS-081.card deck when the program is run.
|
||||
|
||||
SYMPTOM-DATA.card
|
||||
Card deck for the symptom-disease probability matrix used by the
|
||||
program. This must be inserted after the cards in the MRS-081.card
|
||||
deck and before any case-data cards.
|
||||
|
||||
UNPACK.card
|
||||
Source deck for the machine-language UNPACK subprogram used by the
|
||||
BALGOL program to unpack rows from the symptom-disease probability
|
||||
matrix during execution. This deck was reverse-engineered from the
|
||||
numeric object code in the MRS-081.card deck. Assemble with the
|
||||
BAC-Assembler.
|
||||
|
||||
As published, the machine-language routine was written for the
|
||||
BALGOL parameter-passing sequence used in the compiler dated
|
||||
1961-02-20 -- the one used in the report. The compiler available to
|
||||
and recovered as part of the retro-220 project (dated 1962-02-01)
|
||||
passes parameters in the reverse order. Thus, this version of the
|
||||
subprogram cannot be used with the available compiler. See Appendix
|
||||
F, "Construction of Machine Language Programs" in the March 1963
|
||||
Revised Edition of the BAC-220 Burroughs Algebraic Compiler manual
|
||||
(220-21017).
|
||||
|
||||
UNPACK.lst
|
||||
Assembly listing generated from UNPACK.card.
|
||||
|
||||
UNPACK-ML.card
|
||||
Object machine-language card deck generated by assembling
|
||||
UNPACK.card. The BAC-Assembler produces a machine-language deck with
|
||||
six words per card. That output has been manually reformatted to
|
||||
match the (mostly) five word-per-card layout shown in the report.
|
||||
This reformatting was done to match the machine-language deck as
|
||||
presented in the report and to allow direct verification of the
|
||||
assembled object code with the transcribed object code. The
|
||||
transcribed object code may never have had an assembler source and
|
||||
was likely programmed directly in numeric machine language.
|
||||
|
||||
|
||||
Paul Kimpel
|
||||
December 2019
|
||||
Original version, transcribe program listing and data, disassemble
|
||||
machine-language routine to BAC-Assembler notation, prepare sample
|
||||
data deck.
|
||||
|
||||
133
software/BALGOL/BALGOL-Examples/MRS-081/SYMPTOM-DATA.card
Normal file
133
software/BALGOL/BALGOL-Examples/MRS-081/SYMPTOM-DATA.card
Normal file
@@ -0,0 +1,133 @@
|
||||
777 MRS-081 SYMPTOM-DISEASE MATRIX DATA CARDS (132 COUNT) *ROW 00@0
|
||||
5 100 *ROW 01@1
|
||||
5 010490500 010000010 000990990 900970950 950970950 990700020 *ROW 01@2
|
||||
5 070000800 010050990 999010010 150050900 970990990 010020020 *ROW 01@3
|
||||
5 020980980 010000020 700040030 000000800 050900000 *ROW 01@4
|
||||
5 081 *ROW 02@1
|
||||
5 100500500 020010020 000990650 500950980 600990980 980300200 *ROW 02@2
|
||||
5 020050900 020020990 990010010 600010200 990990990 700050050 *ROW 02@3
|
||||
5 850980980 010020010 300020200 050010900 010400000 *ROW 02@4
|
||||
5 005 *ROW 03@1
|
||||
5 300600100 200100200 000990400 300950980 900900980 980050050 *ROW 03@2
|
||||
5 020570400 010030990 990010020 300150600 990950990 850020200 *ROW 03@3
|
||||
5 700980980 010010010 050010050 600010380 010300000 *ROW 03@4
|
||||
5 001 *ROW 04@1
|
||||
5 100200700 300100250 000990200 100950950 850900980 980150200 *ROW 04@2
|
||||
5 020050400 200010990 990010010 950010500 990950990 850050200 *ROW 04@3
|
||||
5 700980980 010020010 150200020 050010400 010600000 *ROW 04@4
|
||||
5 027 *ROW 05@1
|
||||
5 200500300 150050100 000990600 500950950 700950400 850900400 *ROW 05@2
|
||||
5 020100200 100010990 990010010 700020600 900900990 050700050 *ROW 05@3
|
||||
5 850980980 150010850 050020200 020200200 200200000 *ROW 05@4
|
||||
5 005 *ROW 06@1
|
||||
5 100400500 010010010 000990850 800990950 950990980 980020020 *ROW 06@2
|
||||
5 020020600 050050990 990100150 400020900 990990990 150020020 *ROW 06@3
|
||||
5 150980980 020020020 200020020 020020600 020700000 *ROW 06@4
|
||||
5 001 *ROW 07@1
|
||||
5 200700100 650100050 000990300 200950950 800950980 980100150 *ROW 07@2
|
||||
5 100050750 050200990 990100150 850020200 990990990 900020250 *ROW 07@3
|
||||
5 750980980 020020300 100010300 050010800 020300000 *ROW 07@4
|
||||
5 018 *ROW 08@1
|
||||
5 500480020 300650010 000900200 100800950 850900980 950650050 *ROW 08@2
|
||||
5 050200200 020050990 990010010 020600990 800700990 020900020 *ROW 08@3
|
||||
5 020100900 050020500 150050020 200200200 200500000 *ROW 08@4
|
||||
5 001 *ROW 09@1
|
||||
5 100450450 220440010 000780200 200900700 850780950 750950250 *ROW 09@2
|
||||
5 050050150 020050990 990010010 020350900 800900990 100200020 *ROW 09@3
|
||||
5 600980980 250250450 450250250 150150050 050500000 *ROW 09@4
|
||||
5 054 *ROW 10@1
|
||||
5 400550050 250250100 000700250 100950950 900800980 980200020 *ROW 10@2
|
||||
5 050650250 020050980 980100150 100600800 990980990 950020850 *ROW 10@3
|
||||
5 100980980 020020200 050020020 600050250 050100000 *ROW 10@4
|
||||
5 063 *ROW 11@1
|
||||
5 400550050 300300100 000600250 100950950 900750980 980200020 *ROW 11@2
|
||||
5 050650250 020050980 980100150 100600800 990980990 950020850 *ROW 11@3
|
||||
5 100980980 020020200 050020020 600050250 050100000 *ROW 11@4
|
||||
5 045 *ROW 12@1
|
||||
5 200700100 010010010 000990500 350990990 990900980 980100020 *ROW 12@2
|
||||
5 050700200 020100980 980010010 100600800 990950990 950020850 *ROW 12@3
|
||||
5 100980980 010010010 100020020 680010250 010200000 *ROW 12@4
|
||||
5 013 *ROW 13@1
|
||||
5 200700100 010010010 000990500 350990990 990900980 980100020 *ROW 13@2
|
||||
5 020700200 020020980 980010010 100600800 990950990 950020850 *ROW 13@3
|
||||
5 100980980 010010010 100010010 680010250 010200000 *ROW 13@4
|
||||
5 014 *ROW 14@1
|
||||
5 900090010 100900000 000200100 010950000 950650980 980400050 *ROW 14@2
|
||||
5 050010020 020050980 980100100 010900800 990980990 950020850 *ROW 14@3
|
||||
5 100980980 020010300 400020050 010010020 020800000 *ROW 14@4
|
||||
5 001 *ROW 15@1
|
||||
5 050450500 010010010 000990990 990990990 990990960 990020010 *ROW 15@2
|
||||
5 010020250 020010800 980500050 100020900 990990990 100020100 *ROW 15@3
|
||||
5 020980980 010010020 020010000 020010250 020400000 *ROW 15@4
|
||||
5 013 *ROW 16@1
|
||||
5 100450450 010010010 000990300 050600900 900900990 990300050 *ROW 16@2
|
||||
5 010010050 300020980 980020020 950000700 990900990 950020900 *ROW 16@3
|
||||
5 050980980 010010010 300150050 020020050 020800000 *ROW 16@4
|
||||
5 001 *ROW 17@1
|
||||
5 300600100 050010010 000990900 000950990 900990950 900200050 *ROW 17@2
|
||||
5 600010100 050200980 980020020 700010800 600990990 010150020 *ROW 17@3
|
||||
5 020400950 100020100 200050020 020020100 050250000 *ROW 17@4
|
||||
5 072 *ROW 18@1
|
||||
5 200400400 010010010 000990800 800900990 900950950 850100020 *ROW 18@2
|
||||
5 500020130 050850980 980030050 500010800 600980990 010100020 *ROW 18@3
|
||||
5 020500950 100020050 100020020 050020200 100150000 *ROW 18@4
|
||||
5 002 *ROW 19@4
|
||||
5 200300500 450450010 000990900 800950990 990900950 980100020 *ROW 19@2
|
||||
5 200020100 020050990 990050700 050050800 990990990 050050020 *ROW 19@3
|
||||
5 020980980 020020100 100020020 020020100 100700000 *ROW 19@4
|
||||
5 008 *ROW 20@1
|
||||
5 200500300 010010010 000990500 500600950 900900200 800100100 *ROW 20@2
|
||||
5 020050100 020020980 980010010 500010800 950980990 500020100 *ROW 20@3
|
||||
5 400980980 200200100 100100100 050050100 100300000 *ROW 20@4
|
||||
5 013 *ROW 21@1
|
||||
5 700290010 010010010 000990600 500800990 950950850 980050020 *ROW 21@2
|
||||
5 020020050 020020900 980010010 200020900 500980990 050100050 *ROW 21@3
|
||||
5 050600100 020020100 100020020 020020050 050900000 *ROW 21@4
|
||||
5 001 *ROW 22@1
|
||||
5 700290010 010010010 000990700 700700200 850800950 990010010 *ROW 22@2
|
||||
5 010010010 010010990 990010010 200020990 950990990 050100050 *ROW 22@3
|
||||
5 050800100 010010010 010010010 010010010 010900000 *ROW 22@4
|
||||
5 036 *ROW 23@1
|
||||
5 100800100 010010010 000990800 700800850 990650800 980200100 *ROW 23@2
|
||||
5 020050050 010010050 950010010 200100990 600990950 050150020 *ROW 23@3
|
||||
5 020300850 020020020 200100020 050010050 010100000 *ROW 23@4
|
||||
5 009 *ROW 24@1
|
||||
5 100800100 010010010 000990800 700800850 990650800 980200100 *ROW 24@2
|
||||
5 020050050 010010050 950010010 200100990 600990950 050150020 *ROW 24@3
|
||||
5 020300850 020020020 200100020 050010050 010100000 *ROW 24@4
|
||||
5 054 *ROW 25@1
|
||||
5 100700200 010010010 000990800 700800990 990950950 990200100 *ROW 25@2
|
||||
5 020020100 010050850 900800150 100100990 700990010 050050020 *ROW 25@3
|
||||
5 020600960 010010050 200100020 020020100 050350000 *ROW 25@4
|
||||
5 005 *ROW 26@1
|
||||
5 500400100 300600010 000850850 700950990 800900980 980700020 *ROW 26@2
|
||||
5 020100100 020020980 980050100 400100700 950990990 300100400 *ROW 26@3
|
||||
5 100800950 020020400 400020020 100100100 100600000 *ROW 26@4
|
||||
5 063 *ROW 27@1
|
||||
5 900100000 200600050 100950400 300800990 950900950 980500020 *ROW 27@2
|
||||
5 020030100 020020950 980010010 200100800 800980980 400200300 *ROW 27@3
|
||||
5 050800950 020020300 300020020 030030100 100500000 *ROW 27@4
|
||||
5 001 *ROW 28@1
|
||||
5 300300300 300050100 000990900 800990990 990990950 980700020 *ROW 28@2
|
||||
5 020050300 020020950 980010010 200100900 900990990 200100100 *ROW 28@3
|
||||
5 100900900 020020300 300020020 050050300 300400000 *ROW 28@4
|
||||
5 001 *ROW 29@1
|
||||
5 600390010 010010010 800700900 500950800 990800950 980500020 *ROW 29@2
|
||||
5 020100300 020020950 980010010 900020600 950990900 700050800 *ROW 29@3
|
||||
5 050900950 020020300 300020020 100100300 300800000 *ROW 29@4
|
||||
5 252 *ROW 30@1
|
||||
5 150700150 010010010 000990800 700950990 850950950 800950050 *ROW 30@2
|
||||
5 020100100 050010980 950010010 300020950 700990990 300100050 *ROW 30@3
|
||||
5 050850950 200020920 050050010 010100010 100150000 *ROW 30@4
|
||||
5 081 *ROW 31@1
|
||||
5 300600100 300500100 000950400 300800900 800900950 990500100 *ROW 31@2
|
||||
5 020050050 250010980 950010010 900020700 950950990 700050750 *ROW 31@3
|
||||
5 150900950 010010300 300100020 010050010 050500000 *ROW 31@4
|
||||
5 005 *ROW 32@1
|
||||
5 300400300 010010050 500990800 700900990 900950980 980100100 *ROW 32@2
|
||||
5 020020200 100020980 980020020 900020700 950950990 700050750 *ROW 32@3
|
||||
5 150900950 020020100 100020020 020020200 200800000 *ROW 32@4
|
||||
5 009 *ROW 33@1
|
||||
5 400550050 500200100 000990200 100800990 700950950 900700050 *ROW 33@2
|
||||
5 020100300 100020980 990010010 300100990 800700990 020900020 *ROW 33@3
|
||||
5 020100900 100020300 300050050 100100300 300500000 *ROW 33@4
|
||||
23
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card
Normal file
23
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card
Normal file
@@ -0,0 +1,23 @@
|
||||
605 7009901000080002400088800014000898000046008680000100104
|
||||
605 8041040009080401260090800001000918000041010380210370012
|
||||
605 8021626008680000300053802042600868000044006580000300066
|
||||
605 8020526008680421260090800001000948000044006580000300066
|
||||
605 0000001000080427260090800001000968000044006580000300066
|
||||
605 8000010010180201360040800001000908041040003500000010000
|
||||
605 8020126008680433270090800001000928000044006580000300066
|
||||
605 0000046000080000300060000000100000000001000000000010000
|
||||
605 8000010010480000120097804104000488000010009980000120093
|
||||
605 8041040004600000100000000004800060031040000000000010000
|
||||
605 8020226008680409270090800001000958000044006580000300066
|
||||
605 8000030006000000010000000000100000000001000000000010000
|
||||
605 8000042008880000410089800001000008041040006400000300000
|
||||
605 0000030000080000420090800001200998041040007280410400070
|
||||
605 0000041000080401260072000001000000000149000410310400000
|
||||
605 8000120007600001490003103104000008000120007900001490003
|
||||
605 1031040000080001200082802012700868000032007180000460086
|
||||
602 8000030006500000000001
|
||||
604 00000010000000000100000000001000000000010000
|
||||
604 00000 2000000000070000000000800000000009
|
||||
604 00000 15000000000180000000001900000000001
|
||||
601 40000000007
|
||||
601 40000990000
|
||||
150
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card
Normal file
150
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card
Normal file
@@ -0,0 +1,150 @@
|
||||
1 REM UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM
|
||||
1 REM
|
||||
1 REM UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE
|
||||
1 REM PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW.
|
||||
1 REM PARAMETERS..
|
||||
1 REM M() 1-DIMENSIONAL SOURCE ROW
|
||||
1 REM (HIDDEN) STRIDE OF M PASSED BY BALGOL
|
||||
1 REM SHEET SHEET TYPE (0=BROWN, 1=WHITE)
|
||||
1 REM XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL)
|
||||
1 REM EQUATION EQUATION NUMBER (9 OR 10)
|
||||
1 REM ROW() DESTINATION ROW FOR UNPACKED CODES
|
||||
1 REM (HIDDEN) STRIDE OF ROW PASSED IN A-REG
|
||||
1 REM
|
||||
1 REM THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE
|
||||
1 REM PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS
|
||||
1 REM WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING
|
||||
1 REM SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD
|
||||
1 REM SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR
|
||||
1 REM THE VERSION OF THE COMPILER DATED 1961-02-20.
|
||||
1 REM
|
||||
1 UNPAK NOP 7 *-*,PARAM ENTRY POINT
|
||||
1 STB 8 SAVEB SAVE B+R REGS
|
||||
1 STR 8 SAVER
|
||||
1 CLL 8 COUNT ZERO THE WORD COUNT
|
||||
1 CAD 8 ROW LOAD ROW() BASE ADDR
|
||||
1 STA 8 ROWA,04 SET ADDR IN ROWA
|
||||
1 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1)
|
||||
1 CAD 8 K2 OFFSET TO M(2)
|
||||
1 LDR 8 EQNR R = EQUATION NR
|
||||
1 BFR 8 A+,02,10 BRANCH IF EQNR=10
|
||||
1 REM
|
||||
1 REM UNPACK FOR EQUATION NR NEQ 10
|
||||
1 REM
|
||||
1 IFL 8 COUNT,02,16 SET COUNT=16
|
||||
1 BUN 8 F+ BRANCH TO FINISH UP
|
||||
1 REM
|
||||
1 REM UNPACK FOR EQUATION NR EQL 10
|
||||
1 REM
|
||||
1 *A IFL 8 COUNT,02,4 SET COUNT = 4
|
||||
1 STP 8 UPW CALL TO UPACK 5 WORDS
|
||||
1 BUN 8 UPW+1
|
||||
1 IFL 8 COUNT,02,5 SET COUNT = 5
|
||||
1 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22)
|
||||
1 CAD 8 K9 OFFSET TO M(9)
|
||||
1 STP 8 UPW CALL TO UNPACK 6 WORDS
|
||||
1 BUN 8 UPW+1
|
||||
1 NOP 0 (NOT USED)
|
||||
1 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49)
|
||||
1 CAD 8 K18 OFFSET TO M(18)
|
||||
1 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0)
|
||||
1 BUN 8 UPW+1
|
||||
1 CAD 8 SHEET A = SHEET PARAM
|
||||
1 BFA 8 B+,02,1 BRANCH IF SHEET=01
|
||||
1 REM
|
||||
1 REM PROCESS SHEET NEQ 1 CASE
|
||||
1 REM
|
||||
1 CAD 8 ROWA LOAD CURR ROW() ADDR
|
||||
1 STA 8 C+,04 SET CLL ADDRESS BELOW
|
||||
1 NOP 0 (NOT USED)
|
||||
1 IFL 8 COUNT,02,1 SET COUNT = 1
|
||||
1 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16)
|
||||
1 CAD 8 K7 OFFSET TO M(7)
|
||||
1 STP 8 UPW CALL TO UNPACK 2 WORDS
|
||||
1 BUN 8 UPW+1
|
||||
1 *C CLL *-* CLEAR ROW() CELL SET ABOVE
|
||||
1 BUN 8 EXIT ALL DONE
|
||||
1 NOP 0 (NOT USED)
|
||||
1 NOP 0 (NOT USED)
|
||||
1 NOP 0 (NOT USED)
|
||||
1 REM
|
||||
1 REM PROCESS SHEET EQL 1 CASE
|
||||
1 REM
|
||||
1 *B CAD 8 ROW LOAD ROW() BASE ADDRESS
|
||||
1 ADD 8 K19 OFFSET TO ROW(19)
|
||||
1 STA 8 D+,04 SET STA ADDRESS BELOW
|
||||
1 CAD 8 M LOAD BASE ADDRESS OF M()
|
||||
1 ADD 8 K8 OFFSET TO M(8)
|
||||
1 STA 8 *+1,04 SET CAD ADDRESS, NEXT
|
||||
1 CAD *-* LOAD M(8) WORD AS SET ABOVE
|
||||
1 SRA 6 SHIFT WORD TO 1ST CODE
|
||||
1 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE
|
||||
1 NOP 0 (NOT USED)
|
||||
1 IFL 8 COUNT,02,2 SET COUNT = 2
|
||||
1 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10)
|
||||
1 CAD 8 K15 OFFSET TO M(15)
|
||||
1 *F STP 8 UPW CALL TO UNPACK 3 WORDS
|
||||
1 BUN 8 UPW+1
|
||||
1 BUN 8 EXIT ALL DONE
|
||||
1 NOP 0 (NOT USED)
|
||||
1 NOP 0 (NOT USED)
|
||||
1 NOP 0 (NOT USED)
|
||||
1 NOP 0 (NOT USED)
|
||||
1 EXIT LDB 8 SAVEB RESTORE B-REG
|
||||
1 LDR 8 SAVER RESTORE R-REG
|
||||
1 CAD 8 UNPAK EXTRACT RETURN ADDRESS
|
||||
1 STA 8 *+1,04 SET RETURN ADDRESS, NEXT
|
||||
1 BUN *-* RETURN TO CALLER
|
||||
1 REM
|
||||
1 REM UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS
|
||||
1 REM A-REG OFFSET IN M() TO 1ST SOURCE WORD
|
||||
1 REM COUNT COUNT -1 OF WORDS TO UNPACK
|
||||
1 REM ROWA ADDR IN ROW() TO 1ST DESTINATION WORD
|
||||
1 REM RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0
|
||||
1 REM
|
||||
1 UPW BUN *-* RETURN TO CALLER
|
||||
1 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR
|
||||
1 ADD 8 M ADD ADDRESS OF M() TO OFFSET
|
||||
1 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET
|
||||
1 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET
|
||||
1 LDR *-* LOAD FIRST WORD OF RANGE
|
||||
1 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS
|
||||
1 *MA CAD *-* LOAD NEXT WORD INTO A
|
||||
1 SLT 4 ROTATE A+R LEFT TO 1ST CODE
|
||||
1 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW()
|
||||
1 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
1 SLT 3 ROTATE A+R TO 2ND CODE
|
||||
1 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW()
|
||||
1 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
1 SLT 3 ROTATE A+R TO 3RD CODE
|
||||
1 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW()
|
||||
1 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
1 DFL 8 COUNT,02,1 DECREMENT WORD COUNT
|
||||
1 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED
|
||||
1 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND
|
||||
1 BUN 8 UPW EXIT SUBROUTINE
|
||||
1 REM
|
||||
1 REM STORAGE, CONSTANTS, AND PARAMETERS
|
||||
1 REM
|
||||
1 COUNT CNST 1 WORD COUNT FOR UNPACKING
|
||||
1 NOP 0 (NOT USED)
|
||||
1 SAVEB NOP 0 SAVED B-REG
|
||||
1 SAVER NOP 0 SAVED R-REG
|
||||
1 ROWA NOP 0 CURRENT ROW() ADDR
|
||||
1 K2 HLT 2 CONSTANT 2
|
||||
1 K7 HLT 7 CONSTANT 7
|
||||
1 K8 HLT 8 CONSTANT 8
|
||||
1 K9 HLT 9 CONSTANT 9
|
||||
1 K15 HLT 15 CONSTANT 15
|
||||
1 K18 HLT 18 CONSTANT 18
|
||||
1 K19 HLT 19 CONSTANT 19
|
||||
1 HLT 1 (NOT USED)
|
||||
1 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS
|
||||
1 M DEFN PARAM+0 ADDR OF ARRAY M()
|
||||
1 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1)
|
||||
1 SHEET DEFN PARAM+2 SHEET TYPE
|
||||
1 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED)
|
||||
1 EQNR DEFN PARAM+4 EQUATION NUMBER
|
||||
1 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY
|
||||
1 CNST 40000990000
|
||||
1 FINI
|
||||
168
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst
Normal file
168
software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst
Normal file
@@ -0,0 +1,168 @@
|
||||
Assembler for the Burroughs 220 BALGOL Compiler & Library -- 2019-12-21 15:07
|
||||
|
||||
Source File: UNPACK.card
|
||||
|
||||
START PASS 2
|
||||
|
||||
UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM
|
||||
|
||||
UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE
|
||||
PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW.
|
||||
PARAMETERS..
|
||||
M() 1-DIMENSIONAL SOURCE ROW
|
||||
(HIDDEN) STRIDE OF M PASSED BY BALGOL
|
||||
SHEET SHEET TYPE (0=BROWN, 1=WHITE)
|
||||
XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL)
|
||||
EQUATION EQUATION NUMBER (9 OR 10)
|
||||
ROW() DESTINATION ROW FOR UNPACKED CODES
|
||||
(HIDDEN) STRIDE OF ROW PASSED IN A-REG
|
||||
|
||||
THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE
|
||||
PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS
|
||||
WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING
|
||||
SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD
|
||||
SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR
|
||||
THE VERSION OF THE COMPILER DATED 1961-02-20.
|
||||
|
||||
21 0000 7 0099 01 0000 UNPAK NOP 7 *-*,PARAM ENTRY POINT
|
||||
22 0001 8 0002 40 0088 STB 8 SAVEB SAVE B+R REGS
|
||||
23 0002 8 0001 40 0089 STR 8 SAVER
|
||||
24 0003 8 0000 46 0086 CLL 8 COUNT ZERO THE WORD COUNT
|
||||
25 0004 8 0000 10 0104 CAD 8 ROW LOAD ROW() BASE ADDR
|
||||
26 0005 8 0410 40 0090 STA 8 ROWA,04 SET ADDR IN ROWA
|
||||
27 0006 8 0401 26 0090 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1)
|
||||
28 0007 8 0000 10 0091 CAD 8 K2 OFFSET TO M(2)
|
||||
29 0008 8 0000 41 0103 LDR 8 EQNR R = EQUATION NR
|
||||
30 0009 8 0210 37 0012 BFR 8 A+,02,10 BRANCH IF EQNR=10
|
||||
|
||||
UNPACK FOR EQUATION NR NEQ 10
|
||||
|
||||
34 0010 8 0216 26 0086 IFL 8 COUNT,02,16 SET COUNT=16
|
||||
35 0011 8 0000 30 0053 BUN 8 F+ BRANCH TO FINISH UP
|
||||
|
||||
UNPACK FOR EQUATION NR EQL 10
|
||||
|
||||
39 0012 8 0204 26 0086 *A IFL 8 COUNT,02,4 SET COUNT = 4
|
||||
40 0013 8 0000 44 0065 STP 8 UPW CALL TO UPACK 5 WORDS
|
||||
41 0014 8 0000 30 0066 BUN 8 UPW+1
|
||||
42 0015 8 0205 26 0086 IFL 8 COUNT,02,5 SET COUNT = 5
|
||||
43 0016 8 0421 26 0090 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22)
|
||||
44 0017 8 0000 10 0094 CAD 8 K9 OFFSET TO M(9)
|
||||
45 0018 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 6 WORDS
|
||||
46 0019 8 0000 30 0066 BUN 8 UPW+1
|
||||
47 0020 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
48 0021 8 0427 26 0090 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49)
|
||||
49 0022 8 0000 10 0096 CAD 8 K18 OFFSET TO M(18)
|
||||
50 0023 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0)
|
||||
51 0024 8 0000 30 0066 BUN 8 UPW+1
|
||||
52 0025 8 0000 10 0101 CAD 8 SHEET A = SHEET PARAM
|
||||
53 0026 8 0201 36 0040 BFA 8 B+,02,1 BRANCH IF SHEET=01
|
||||
|
||||
PROCESS SHEET NEQ 1 CASE
|
||||
|
||||
57 0027 8 0000 10 0090 CAD 8 ROWA LOAD CURR ROW() ADDR
|
||||
58 0028 8 0410 40 0035 STA 8 C+,04 SET CLL ADDRESS BELOW
|
||||
59 0029 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
60 0030 8 0201 26 0086 IFL 8 COUNT,02,1 SET COUNT = 1
|
||||
61 0031 8 0433 27 0090 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16)
|
||||
62 0032 8 0000 10 0092 CAD 8 K7 OFFSET TO M(7)
|
||||
63 0033 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 2 WORDS
|
||||
64 0034 8 0000 30 0066 BUN 8 UPW+1
|
||||
65 0035 0 0000 46 0000 *C CLL *-* CLEAR ROW() CELL SET ABOVE
|
||||
66 0036 8 0000 30 0060 BUN 8 EXIT ALL DONE
|
||||
67 0037 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
68 0038 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
69 0039 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
|
||||
PROCESS SHEET EQL 1 CASE
|
||||
|
||||
73 0040 8 0000 10 0104 *B CAD 8 ROW LOAD ROW() BASE ADDRESS
|
||||
74 0041 8 0000 12 0097 ADD 8 K19 OFFSET TO ROW(19)
|
||||
75 0042 8 0410 40 0048 STA 8 D+,04 SET STA ADDRESS BELOW
|
||||
76 0043 8 0000 10 0099 CAD 8 M LOAD BASE ADDRESS OF M()
|
||||
77 0044 8 0000 12 0093 ADD 8 K8 OFFSET TO M(8)
|
||||
78 0045 8 0410 40 0046 STA 8 *+1,04 SET CAD ADDRESS, NEXT
|
||||
79 0046 0 0000 10 0000 CAD *-* LOAD M(8) WORD AS SET ABOVE
|
||||
80 0047 0 0000 48 0006 SRA 6 SHIFT WORD TO 1ST CODE
|
||||
81 0048 0 0310 40 0000 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE
|
||||
82 0049 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
83 0050 8 0202 26 0086 IFL 8 COUNT,02,2 SET COUNT = 2
|
||||
84 0051 8 0409 27 0090 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10)
|
||||
85 0052 8 0000 10 0095 CAD 8 K15 OFFSET TO M(15)
|
||||
86 0053 8 0000 44 0065 *F STP 8 UPW CALL TO UNPACK 3 WORDS
|
||||
87 0054 8 0000 30 0066 BUN 8 UPW+1
|
||||
88 0055 8 0000 30 0060 BUN 8 EXIT ALL DONE
|
||||
89 0056 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
90 0057 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
91 0058 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
92 0059 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
93 0060 8 0000 42 0088 EXIT LDB 8 SAVEB RESTORE B-REG
|
||||
94 0061 8 0000 41 0089 LDR 8 SAVER RESTORE R-REG
|
||||
95 0062 8 0000 10 0000 CAD 8 UNPAK EXTRACT RETURN ADDRESS
|
||||
96 0063 8 0410 40 0064 STA 8 *+1,04 SET RETURN ADDRESS, NEXT
|
||||
97 0064 0 0000 30 0000 BUN *-* RETURN TO CALLER
|
||||
|
||||
UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS
|
||||
A-REG OFFSET IN M() TO 1ST SOURCE WORD
|
||||
COUNT COUNT -1 OF WORDS TO UNPACK
|
||||
ROWA ADDR IN ROW() TO 1ST DESTINATION WORD
|
||||
RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0
|
||||
|
||||
105 0065 0 0000 30 0000 UPW BUN *-* RETURN TO CALLER
|
||||
106 0066 8 0000 42 0090 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR
|
||||
107 0067 8 0000 12 0099 ADD 8 M ADD ADDRESS OF M() TO OFFSET
|
||||
108 0068 8 0410 40 0072 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET
|
||||
109 0069 8 0410 40 0070 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET
|
||||
110 0070 0 0000 41 0000 LDR *-* LOAD FIRST WORD OF RANGE
|
||||
111 0071 8 0401 26 0072 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS
|
||||
112 0072 0 0000 10 0000 *MA CAD *-* LOAD NEXT WORD INTO A
|
||||
113 0073 0 0001 49 0004 SLT 4 ROTATE A+R LEFT TO 1ST CODE
|
||||
114 0074 1 0310 40 0000 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW()
|
||||
115 0075 8 0001 20 0076 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
116 0076 0 0001 49 0003 SLT 3 ROTATE A+R TO 2ND CODE
|
||||
117 0077 1 0310 40 0000 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW()
|
||||
118 0078 8 0001 20 0079 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
119 0079 0 0001 49 0003 SLT 3 ROTATE A+R TO 3RD CODE
|
||||
120 0080 1 0310 40 0000 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW()
|
||||
121 0081 8 0001 20 0082 IBB 8 *+1,1 INCR ROW() ADDR
|
||||
122 0082 8 0201 27 0086 DFL 8 COUNT,02,1 DECREMENT WORD COUNT
|
||||
123 0083 8 0000 32 0071 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED
|
||||
124 0084 8 0000 46 0086 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND
|
||||
125 0085 8 0000 30 0065 BUN 8 UPW EXIT SUBROUTINE
|
||||
|
||||
STORAGE, CONSTANTS, AND PARAMETERS
|
||||
|
||||
129 0086 0 0000 00 0001 COUNT CNST 1 WORD COUNT FOR UNPACKING
|
||||
130 0087 0 0000 01 0000 NOP 0 (NOT USED)
|
||||
131 0088 0 0000 01 0000 SAVEB NOP 0 SAVED B-REG
|
||||
132 0089 0 0000 01 0000 SAVER NOP 0 SAVED R-REG
|
||||
133 0090 0 0000 01 0000 ROWA NOP 0 CURRENT ROW() ADDR
|
||||
134 0091 0 0000 00 0002 K2 HLT 2 CONSTANT 2
|
||||
135 0092 0 0000 00 0007 K7 HLT 7 CONSTANT 7
|
||||
136 0093 0 0000 00 0008 K8 HLT 8 CONSTANT 8
|
||||
137 0094 0 0000 00 0009 K9 HLT 9 CONSTANT 9
|
||||
138 0095 0 0000 00 0015 K15 HLT 15 CONSTANT 15
|
||||
139 0096 0 0000 00 0018 K18 HLT 18 CONSTANT 18
|
||||
140 0097 0 0000 00 0019 K19 HLT 19 CONSTANT 19
|
||||
141 0098 0 0000 00 0001 HLT 1 (NOT USED)
|
||||
142 0099 4 0000 00 0007 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS
|
||||
143 0100 M DEFN PARAM+0 ADDR OF ARRAY M()
|
||||
144 0100 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1)
|
||||
145 0100 SHEET DEFN PARAM+2 SHEET TYPE
|
||||
146 0100 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED)
|
||||
147 0100 EQNR DEFN PARAM+4 EQUATION NUMBER
|
||||
148 0100 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY
|
||||
149 0100 4 0000 99 0000 CNST 40000990000
|
||||
150 0101 FINI
|
||||
|
||||
|
||||
SYMBOL TABLE
|
||||
|
||||
12 *A..1 40 *B..1 35 *C..1 48 *D..1 53 *F..1
|
||||
72 *MA.1 71 *NW.1 8 BMOD 86 COUNT 103 EQNR
|
||||
60 EXIT 95 K15 96 K18 97 K19 91 K2
|
||||
92 K7 93 K8 94 K9 99 M 100 M1STR
|
||||
99 PARAM 1 RLO 104 ROW 90 ROWA 88 SAVEB
|
||||
89 SAVER 101 SHEET 0 UNPAK 65 UPW 102 XRAY
|
||||
|
||||
END PASS 2, ERRORS = 0
|
||||
Reference in New Issue
Block a user