mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-02-28 08:57:42 +00:00
2c72f7fd1d
1. Commit library tape images, directories, and extracted text files. 2. Commit additional utilities under Unisys-Emode-Tools.
341 lines
27 KiB
Plaintext
341 lines
27 KiB
Plaintext
BEGIN 0000
|
|
COMMENT PROGRAM IN ALGOL 6O TO COMPARE LEASE TO PURCHASE; 0010
|
|
INTEGER DEPT,PPTT,RSDT,PRDT,U,G,SERES,EEL,CHECK,SW,MODEL, 0020
|
|
MO,DAY,YEAR,CUMP,K,ROW,COL,A; 0030
|
|
INTEGER ARRAY TABLE[0:7,0:27],PURCH[0:9],LEASE[0:9],NETP[0:9], 0040
|
|
CNPI[0:9],RRV[0:9],DISC[0:27]; 0050
|
|
REAL N,F,J,EXCT,XPN,E,PP,C,I,MP,Z,ZP,B,TEMBV,P,Y, 0060
|
|
SHIFT,STX,TCL,TCP, V,FIRST,TEST,ASSOC,R; 0070
|
|
REAL ARRAY RATE[0:9],S[0:9],M[0:9],L[0:9],D[0:23]; 0080
|
|
0090
|
|
FILE IN DATA(1,10); 0100
|
|
0110
|
|
0120
|
|
0130
|
|
LIST OL2 (MODEL), 0140
|
|
OL3 (MO,DAY,YEAR), 0150
|
|
OL4 (EEL,P); 0160
|
|
0170
|
|
FILE OUT PRINT(1,15); 0180
|
|
0190
|
|
FORMAT OUT FL1 (// X48,"LEASE-PURCHASE ANALYSIS",X49), 0200
|
|
FL2F (/ X57,"F",I5,X57,A2), 0210
|
|
FL2E (/ X57,"E",I5,X57,A2), 0220
|
|
FL2P (/ X57,"P",I5,X57,A2), 0230
|
|
FL2B (/ X57,"B",I5,X57,A2), 0240
|
|
FL2Z (/ X58,I5,X57,A2), 0250
|
|
FL3 (/ X55,I2,"/",I2,"/",I4,X55,A2), 0260
|
|
FL4 (//X9,"ESTIMATED ECONOMIC LIFE",I8,X43, 0270
|
|
"PURCHASE PRICE",F14.2,X9,A2), 0280
|
|
ERROR (X45,"DATA-ERROR--CHECK INPUT CARDS",X46); 0290
|
|
0300
|
|
LABEL START,MTN,EXCSE,ZEROZ,LSECM,ZEROB,BVCOM, 0310
|
|
MINUS,PLUS,NEXT,NOW,BOTOM,W2F,W2E,W2P, 0320
|
|
W2B,W,THREE,STOP1,DISCT,DISCT1,DISCT2,DISCT3, 0330
|
|
DISCT4,DISCT5,XXXX99XXXX,DBLBV,MPTT,SET,VCAL, 0340
|
|
LSE,DIP,PTAX,TRIAL ; 0350
|
|
SWITCH SUBR~DISCT1,DISCT2,DISCT3,DISCT4,DISCT5; 0360
|
|
SWITCH SHAZAM~W2B,W2F,W2E,W2P,W; 0370
|
|
START: 0380
|
|
BEGIN 0390
|
|
FORMAT IN FDAT1 (X1, I3,I5,2I3,I5,I3,I2,F10.1,X45,A2), 0400
|
|
FDAT2 (X1,9F5.2,F6.3,4F5.3,X8,A2), 0410
|
|
FDAT3 (X1,3F5.3,2F6.4,F4.1,4F10.1,X8,A2), 0420
|
|
FDAT4 (X1, 5F10.1,F4.2,X25,A2), 0430
|
|
FDAT5 (X1, 4F10.1,X39,A2), 0440
|
|
FDAT6 (X1, 5F10.1,F4.2,F5.3,F7.5,I2,I3,I2,X6,A2), 0450
|
|
FDAT7 (X1,I3,3F5.3,F4.2,F5.3,I2,I4,X46,A2); 0460
|
|
0470
|
|
LIST LIST1 (SERES,MODEL,MO,DAY,YEAR,EEL,PRDT,P), 0480
|
|
LIST2 (S[1],S[2],S[3],S[4],S[5],S[6],S[7],S[8],S[9],Y, 0490
|
|
D[7],D[5],D[8],D[4]), 0500
|
|
LIST3 (D[12],D[13],D[15],D[10],D[11],D[14],L[1],L[2], 0510
|
|
L[3],L[4]), 0520
|
|
LIST4 (L[5],L[6],L[7],L[8],L[9],D[3]), 0530
|
|
LIST5 (M[1],M[2],M[3],M[4]), 0540
|
|
LIST6 (M[5],M[6],M[7],M[8],M[9],D[2],D[1],D[16], 0550
|
|
DEPT,G,PPTT), 0560
|
|
LIST7 (U,D[6],N,F,D[9],D[17],RSDT,CHECK); 0570
|
|
READ(DATA,FDAT1,LIST1)[XXXX99XXXX]; 0580
|
|
READ(DATA,FDAT2,LIST2); 0590
|
|
READ(DATA,FDAT3,LIST3); 0600
|
|
READ(DATA,FDAT4,LIST4); 0610
|
|
READ(DATA,FDAT5,LIST5); 0620
|
|
READ(DATA,FDAT6,LIST6); 0630
|
|
READ(DATA,FDAT7,LIST7); 0640
|
|
END; 0650
|
|
0660
|
|
0670
|
|
IF CHECK ! -60 THEN GO TO STOP1; 0680
|
|
R ~ EXCT ~ J ~ CUMP ~ 0; 0690
|
|
XPN ~ D[12]+(1-D[12])|D[13] ; 0700
|
|
E ~ P; PP ~ P|(1+D[7]) ; C ~ PP; 0710
|
|
D[18]~(G DIV 2)|2; 0720
|
|
IF D[18] > 8 THEN D[18] ~ 8 ; 0730
|
|
FOR ROW ~ 1 STEP 1 UNTIL 7 DO BEGIN 0740
|
|
FOR COL ~ 1 STEP 1 UNTIL 27 DO 0750
|
|
TABLE[ROW,COL] ~ 0 END; 0760
|
|
FOR K ~ 1 STEP 1 UNTIL 27 DO DISC[K] ~ 0 ; 0770
|
|
FOR K ~ 1 STEP 1 UNTIL 9 DO RATE[K] ~ 0 ; 0780
|
|
TABLE[4,1] ~ P|(1+D[7]+D[8]); 0790
|
|
FOR A ~ 1 STEP 1 UNTIL 9 DO 0800
|
|
BEGIN 0810
|
|
COMMENT INSURANCE ; 0820
|
|
I ~ (1-D[1]|(A-1))|P|D[16] ; 0830
|
|
IF I > 0 THEN TABLE[3,3|A-2] ~ I ; 0840
|
|
COMMENT MAINTENANCE ; 0850
|
|
MP ~ (1+D[2]|(S[A]-1))|M[A] ; 0860
|
|
IF PRDT = 0 THEN 0870
|
|
BEGIN TABLE[1,3|A-1]~MP; GO TO EXCSE END; 0880
|
|
IF PRDT = 1 THEN 0890
|
|
BEGIN IF A=1 THEN GO TO EXCSE; GO TO MTN END; 0900
|
|
IF A=1 THEN 0910
|
|
BEGIN 0920
|
|
TABLE[1,3|A-1] ~ 0.5|MP ; GO TO EXCSE 0930
|
|
END ; 0940
|
|
MTN: TABLE[1,3|A-2] ~ MP ; 0950
|
|
COMMENT LEASE ; 0960
|
|
0970
|
|
EXCSE: IF D[5] = 0 THEN GO TO ZEROZ ; 0980
|
|
Z ~ (1+D[3]|(S[A]-1))|D[5]|L[A] ; 0990
|
|
IF (EXCT+Z { P|D[7]) THEN 1000
|
|
BEGIN 1010
|
|
ZP ~ D[5]; 1020
|
|
EXCT ~ EXCT+Z ; GO TO LSECM 1030
|
|
END ; 1040
|
|
IF EXCT < P|D[7] THEN 1050
|
|
BEGIN 1060
|
|
ZP ~ (P|D[7]-EXCT)/(L[A]|(1+D[3]|(S[A]-1))); 1070
|
|
EXCT ~ EXCT+Z ; GO TO LSECM 1080
|
|
END ; 1090
|
|
ZEROZ: ZP ~ 0 ; 1100
|
|
LSECM: TABLE[6,3|A-1] ~ -(1+D[3]|(S[A]-1))|(1+D[4]+ZP)|L[A]; 1110
|
|
COMMENT DEPRECIATION ; 1120
|
|
IF DEPT = 0 THEN 1130
|
|
BEGIN 1140
|
|
IF A { G THEN 1150
|
|
BEGIN 1160
|
|
B ~ PP/G ; GO TO BVCOM 1170
|
|
END ; 1180
|
|
GO TO ZEROB 1190
|
|
END ; 1200
|
|
IF DEPT = 1 THEN 1210
|
|
BEGIN 1220
|
|
IF A { G THEN 1230
|
|
BEGIN 1240
|
|
B ~ (PP|2|(G+1-A))/(G|(G+1)) ; 1250
|
|
GO TO BVCOM 1260
|
|
END ; 1270
|
|
GO TO ZEROB 1280
|
|
END ; 1290
|
|
IF A < G THEN 1300
|
|
BEGIN 1310
|
|
B ~ (C+C)/G; GO TO BVCOM 1320
|
|
END ; 1330
|
|
IF A = G THEN 1340
|
|
BEGIN 1350
|
|
B ~ C ; GO TO BVCOM 1360
|
|
END ; 1370
|
|
ZEROB: B ~ 0 ; 1380
|
|
BVCOM: C ~ C-B ; 1390
|
|
COMMENT PROPERTY TAX ; 1400
|
|
IF PPTT = 0 THEN 1410
|
|
BEGIN 1420
|
|
E ~ (P|(U-A+0.5))/U ; GO TO MPTT 1430
|
|
END ; 1440
|
|
IF PPTT = 1 THEN 1450
|
|
BEGIN 1460
|
|
IF A{U THEN 1470
|
|
BEGIN 1480
|
|
E~(P|((U-A)|(U-A+1)+U-A+1))/(U|(U+1)) ; 1490
|
|
GO TO MPTT 1500
|
|
END ; 1510
|
|
GO TO SET 1520
|
|
END ; 1530
|
|
IF A < U THEN 1540
|
|
BEGIN 1550
|
|
TEMBV ~ E-0.5|J; J ~ (2|TEMBV)/U ; 1560
|
|
1570
|
|
GO TO DBLBV 1580
|
|
END ; 1590
|
|
IF A = U THEN 1600
|
|
BEGIN 1610
|
|
J ~ E-0.5|J ; TEMBV ~ J ; GO TO DBLBV 1620
|
|
END ; 1630
|
|
GO TO SET ; 1640
|
|
DBLBV: E ~ TEMBV - 0.5|J ; 1650
|
|
MPTT: IF D[6]|P > E THEN 1660
|
|
SET: E ~ D[6]|P; TABLE[2,3|A-1] ~ E|D[15] ; 1670
|
|
COMMENT DISPOSAL EFFECT AND SALES TAX ; 1680
|
|
IF A = 1 THEN 1690
|
|
BEGIN 1700
|
|
SHIFT ~ 0; STX ~ P|D[8] ; 1710
|
|
TCL ~P|(1+D[7])|D[11] ; 1720
|
|
D[19] ~ TCL ; TCP ~ P|(1+D[7])|D[10]; 1730
|
|
D[20] ~ TCP ; 1740
|
|
GO TO VCAL 1750
|
|
END ; 1760
|
|
SHIFT ~ SHIFT + S[A]; STX ~ 0 ; TCL ~ 0 ; TCP ~ 0; 1770
|
|
1780
|
|
VCAL: V~P|(1-N|(1+(S[1]-1)|D[9])-F|((A-1)+(SHIFT-(A-1))|D[9])); 1790
|
|
IF P|D[17] > V THEN V~P|D[17]; 1800
|
|
IF A < 4 THEN 1810
|
|
BEGIN 1820
|
|
D[22] ~ D[20]; D[21] ~ D[19]; GO TO DIP 1830
|
|
END ; 1840
|
|
IF A } D[18] THEN 1850
|
|
BEGIN 1860
|
|
1870
|
|
D[22] ~ 0; GO TO LSE 1880
|
|
END ; 1890
|
|
D[23]~(A DIV 2)|2; 1900
|
|
D[22] ~ ((D[18] - D[23])/(D[18]-2))|D[20]; 1910
|
|
LSE: IF A } D[14] THEN 1920
|
|
BEGIN 1930
|
|
D[21] ~ 0 ; GO TO DIP 1940
|
|
END; 1950
|
|
D[23]~(A DIV 2)|2; 1960
|
|
D[21] ~ ((D[14]-D[23])/(D[14]-2))|D[19] ; 1970
|
|
DIP: IF RSDT = 0 THEN 1980
|
|
BEGIN 1990
|
|
RRV[A] ~ -(V-(V-C-D[22]+D[21])|XPN-D[22]+D[21]); 2000
|
|
GO TO PTAX 2010
|
|
END ; 2020
|
|
RRV[A] ~ -((V-D[21])|XPN-D[22]+D[21]); GO TO PTAX ; 2030
|
|
COMMENT INCOM TAX ; 2040
|
|
PTAX: TABLE [5,3|A] ~ -(TABLE[1,3|A-1]+TABLE[1,3|A-2]+ 2050
|
|
TABLE[2,3|A-1]+TABLE[3,3|A-2]+B+STX)|XPN-TCP; 2060
|
|
TABLE[7,3|A] ~ - TABLE[6,3|A-1] |XPN+TCL ; 2070
|
|
COMMENT TOTALS FOR PRINT ; 2080
|
|
PURCH[A] ~ TABLE[1,3|A-1] + TABLE[1,3|A-2]+TABLE[2,3| 2090
|
|
A-1] + TABLE[3,3|A-2] +TABLE[4,3|A-2]+TABLE[5,3|A]; 2100
|
|
LEASE[A] ~ TABLE[6,3|A-1] + TABLE[7,3|A] ; 2110
|
|
NETP[A] ~ PURCH[A] + LEASE[A] ; 2120
|
|
CUMP ~ CUMP + NETP[A] ; CNPI[A] ~ CUMP+RRV[A] ; 2130
|
|
COMMENT DISCOUNTING ; 2140
|
|
FOR K ~ 3|A-2 STEP 1 UNTIL 3|A DO 2150
|
|
BEGIN 2160
|
|
FOR ROW ~ 1 STEP 1 UNTIL 7 DO 2170
|
|
DISC[K] ~ DISC[K] + TABLE[ROW,K] 2180
|
|
END ; 2190
|
|
IF CNPI[A] > 0 THEN GO TO BOTOM ; 2200
|
|
IF A > 1 THEN RATE[A] ~ RATE[A-1] ; 2210
|
|
SW ~ 1; GO TO DISCT ; 2220
|
|
DISCT1: IF TEST { 0 THEN GO TO TRIAL; 2230
|
|
GO TO BOTOM ; 2240
|
|
TRIAL: FIRST ~ R; ASSOC ~ TEST ; R ~ R+0.04 ; 2250
|
|
SW ~ 2 ; GO TO DISCT ; 2260
|
|
DISCT2: IF TEST{ 0 THEN GO TO TRIAL; 2270
|
|
R ~ FIRST + (0.04|ASSOC)/(ASSOC-TEST) ; 2280
|
|
SW ~ 3; GO TO DISCT ; 2290
|
|
DISCT3: IF TEST { 0 THEN GO TO PLUS ; 2300
|
|
MINUS: FIRST ~ R ; ASSOC ~ TEST ; 2310
|
|
R ~ R-0.001 ; SW ~ 4 ; GO TO DISCT ; 2320
|
|
DISCT4: IF TEST > 0 THEN GO TO MINUS ; 2330
|
|
IF ASSOC } -TEST THEN GO TO NEXT ; GO TO NOW ; 2340
|
|
PLUS: FIRST ~ R ; ASSOC ~ TEST ; 2350
|
|
R ~ R+0.001; SW ~ 5 ; GO TO DISCT ; 2360
|
|
DISCT5: IF TEST < 0 THEN GO TO PLUS ; 2370
|
|
IF TEST } -ASSOC THEN GO TO NOW ; 2380
|
|
NEXT: RATE[A] ~ (1+R)/(1+Y)-0.9995; GO TO BOTOM ; 2390
|
|
DISCT: TEST ~ 0 ; FOR K ~ 1 STEP 1 UNTIL A DO 2400
|
|
TEST ~ TEST + DISC[3|K-2]|(1+R)*(1-K)+ 2410
|
|
DISC[3|K-1]|(1+R)*(.5-K)+DISC[3|K]|(1+R)*(-K) ; 2420
|
|
TEST ~ TEST+RRV[A]|(1+R)*(-A) ; 2430
|
|
GO TO SUBR[SW] ; 2440
|
|
STOP1: WRITE(PRINT[PAGE],ERROR) ; 2450
|
|
GO TO XXXX99XXXX ; 2460
|
|
NOW: RATE[A] ~ (1+FIRST)/(1+Y)-0.9995 ; 2470
|
|
BOTOM: IF RATE[A] < 0 THEN RATE[A] ~ 0 ; 2480
|
|
END; 2490
|
|
WRITE(PRINT,FL1) ; 2500
|
|
GO TO SHAZAM[SERES] ; 2510
|
|
W2F: WRITE(PRINT,FL2F,OL2) ; GO TO THREE; 2520
|
|
W2E: WRITE(PRINT,FL2E,OL2) ; GO TO THREE; 2530
|
|
W2P: WRITE(PRINT,FL2P,OL2) ; GO TO THREE; 2540
|
|
W2B: WRITE(PRINT,FL2B,OL2) ; GO TO THREE; 2550
|
|
W: WRITE(PRINT,FL2Z,OL2) ; 2560
|
|
THREE: 2570
|
|
BEGIN 2580
|
|
LIST OL5 (L[1]), 2590
|
|
OL9 (TABLE[1,2],(TABLE[1,4]+TABLE[1,5]),(TABLE[1,7]+ 2600
|
|
TABLE[1,8]),(TABLE[1,10]+TABLE[1,11]),(TABLE[1,13] 2610
|
|
+TABLE[1,14]),(TABLE[1,16]+TABLE[1,17]),(TABLE[1,19 2620
|
|
]+TABLE[1,20]),(TABLE[1,22]+TABLE[1,23]), 2630
|
|
(TABLE[1,25]+TABLE[1,26])), 2640
|
|
OL10 (TABLE[2,2],TABLE[2,5],TABLE[2,8],TABLE[2,11], 2650
|
|
TABLE[2,14],TABLE[2,17],TABLE[2,20],TABLE[2,23], 2660
|
|
TABLE[2,26]), 2670
|
|
OL11 (TABLE[3,1],TABLE[3,4],TABLE[3,7],TABLE[3,10], 2680
|
|
TABLE[3,13],TABLE[3,16],TABLE[3,19],TABLE[3,22], 2690
|
|
TABLE[3,25]), 2700
|
|
OL12 (TABLE[4,1]), 2710
|
|
OL13 (TABLE[5,3],TABLE[5,6],TABLE[5,9],TABLE[5,12], 2720
|
|
TABLE[5,15],TABLE[5,18],TABLE[5,21],TABLE[5,24], 2730
|
|
TABLE[5,27]), 2740
|
|
OL14 (PURCH[1],PURCH[2],PURCH[3],PURCH[4],PURCH[5], 2750
|
|
PURCH[6],PURCH[7],PURCH[8],PURCH[9]), 2760
|
|
OL16 (TABLE[6,2],TABLE[6,5],TABLE[6,8],TABLE[6,11], 2770
|
|
TABLE[6,14],TABLE[6,17],TABLE[6,20],TABLE[6,23], 2780
|
|
TABLE[6,26]), 2790
|
|
OL17 (TABLE[7,3],TABLE[7,6],TABLE[7,9],TABLE[7,12], 2800
|
|
TABLE[7,15],TABLE[7,18],TABLE[7,21],TABLE[7,24], 2810
|
|
TABLE[7,27]), 2820
|
|
OL18 (LEASE[1],LEASE[2],LEASE[3],LEASE[4],LEASE[5], 2830
|
|
LEASE[6],LEASE[7],LEASE[8],LEASE[9]), 2840
|
|
OL20 (NETP[1],NETP[2],NETP[3],NETP[4],NETP[5],NETP[6], 2850
|
|
NETP[7],NETP[8],NETP[9]), 2860
|
|
OL21 (RRV[1],RRV[2],RRV[3],RRV[4],RRV[5],RRV[6], 2870
|
|
RRV[7],RRV[8],RRV[9]), 2880
|
|
OL22 (CNPI[1],CNPI[2],CNPI[3],CNPI[4],CNPI[5], 2890
|
|
CNPI[6],CNPI[7],CNPI[8],CNPI[9]), 2900
|
|
OL24 (RATE[1],RATE[2],RATE[3],RATE[4],RATE[5],RATE[6], 2910
|
|
RATE[7],RATE[8],RATE[9]); 2920
|
|
FORMAT OUT FL5 (// X83,"LEASE RATE-YEAR 1",F11.2,X9,A2), 2930
|
|
FL6 (//), 2940
|
|
FL7D (// X9,"YEAR",X28,"1",X8,"2",X8,"3",X8,"4", 2950
|
|
X8,"5",X8,"6",X8,"7",X8"8",X8,"9",X6,A2), 2960
|
|
FL8 (// X2,"PURCHASE",X110,A2), 2970
|
|
FL9D (X4,"MAINTENANCE",X21,9I9,A2), 2980
|
|
FL10D (X4,"PROPERTY TAX",X20,9I9,X3,A2), 2990
|
|
FL11D (X4,"INSURANCE",X23,9I9,X3,A2), 3000
|
|
FL12D (X4,"PURCHASE AMOUNT WITH TAXES",X6,I9,X3,A2), 3010
|
|
FL13D (X4"INCOME TAX EFFECT",X15,9I9,X3,A2), 3020
|
|
FL14D (// X6,"COSTS OF PURCHASE",X13,9I9,X3,A2), 3030
|
|
FL15 (// X2,"LEASE",X113,A2), 3040
|
|
FL16D (X4,"LEASE EXPENSE",X19,9I9,X3,A2), 3050
|
|
FL18D (// X6,"EFFECT OF LEASE",X15,9I9,X3,A2), 3060
|
|
FL19 (//), 3070
|
|
FL20D (/ X2,"NET COSTS OF PURCHASE",X13,9I9,X3,A2), 3080
|
|
FL21D (/ X2,"EFFECT OF RESIDUAL VALUE",X10,9I9,X3,A2), 3090
|
|
FL22D (// X2,"CUMULATIVE NET PURCHASE INVESTMENT",9I9, 3100
|
|
X3,A2), 3110
|
|
FL23 (//), 3120
|
|
FL24D (X2,"RATE OF RETURN OF PURCHASE"X8,9F9.3,X3,A2); 3130
|
|
WRITE(PRINT,FL3,OL3) ; 3140
|
|
WRITE(PRINT[NO],FL4,OL4) ; 3150
|
|
WRITE(PRINT,FL5,OL5); 3160
|
|
WRITE(PRINT,FL6) ; 3170
|
|
WRITE(PRINT,FL7D); 3180
|
|
WRITE(PRINT,FL8) ; 3190
|
|
WRITE(PRINT,FL9D,OL9); 3200
|
|
WRITE(PRINT,FL10D,OL10); 3210
|
|
WRITE(PRINT,FL11D,OL11); 3220
|
|
WRITE(PRINT,FL12D,OL12); 3230
|
|
WRITE(PRINT,FL13D,OL13); 3240
|
|
WRITE(PRINT,FL14D,OL14); 3250
|
|
WRITE(PRINT,FL15) ; 3260
|
|
WRITE(PRINT,FL16D,OL16) ; 3270
|
|
WRITE(PRINT,FL13D,OL17) ; 3280
|
|
WRITE(PRINT,FL18D,OL18) ; 3290
|
|
WRITE(PRINT[NO],FL19) ; 3300
|
|
WRITE(PRINT,FL20D,OL20) ; 3310
|
|
WRITE(PRINT,FL21D,OL21) ; 3320
|
|
WRITE(PRINT,FL22D,OL22) ; 3330
|
|
WRITE(PRINT,FL23) ; 3340
|
|
WRITE(PRINT[PAGE],FL24D,OL24) ; 3350
|
|
END ; 3360
|
|
GO TO START; 3365
|
|
XXXX99XXXX: 3370
|
|
END. 3380
|