$ TADA/LIST=SHSORT SHSORT TeleSoft-Ada compiler -- Version 1.3d March 25, 1983 Copyright (c) 1981,1982,1983 TeleSoft. All rights reserved. Opening shsort.text Symbol table space: 127.5K bytes Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 56 reset(shsort.CODE) rewrite(shsort.CODE) Segment 1, 2 procedures .. end. $ TYPE SHSORT Opening shsort.text 1: package SHSORT is 2: 3: -- create user constrained subtype NAMES 4: subtype NAMES is STRING(1..10) ; 5: -- create user defined type A_NAMES (note: the box <> means 6: -- to be filled in later) 7: type A_NAMES is array( INTEGER range <> ) of NAMES ; 8: -- create user defined type A_BALANCES 9: type A_BALANCES is array( INTEGER range <> ) of FLOAT ; 10: -- declare procedure name and parameter types 11: procedure SHELLI( SIZE : in INTEGER ; 12: ARR1 : in out A_NAMES ; 13: ARR2 : in out A_BALANCES ) ; 14: end SHSORT ; 15: package body SHSORT is 16: 17: procedure SHELLI( SIZE : in INTEGER ; 18: ARR1 : in out A_NAMES ; 19: ARR2 : in out A_BALANCES ) is 20: 21: M,I,J,LIMIT : INTEGER ; 22: TEMP2 : FLOAT ; 23: TEMP1 : NAMES ; 24: 25: begin 26: M := SIZE ; 27: while M > 1 loop -- log base 2 of SIZE times 28: M := M / 2 ; -- through this loop 29: LIMIT := SIZE - M ; 30: for J in 1..LIMIT loop -- at most SIZE times 31: I := J ; -- through this loop 32: 33: while I > 0 loop -- this loop depends on data, 34: -- statistically about 2.5 35: -- times through this loop 36: 37: -- compare on whatever is being sorted 38: if ARR1(I) > ARR1(I+M) then 39: -- interchange, 3 statements for each array 40: -- being sorted 41: TEMP1 := ARR1(I) ; 42: ARR1(I) := ARR1(I+M) ; 43: ARR1(I+M) := TEMP1 ; 44: TEMP2 := ARR2(I) ; 45: ARR2(I) := ARR2(I+M) ; 46: ARR2(I+M) := TEMP2 ; 47: I := I - M ; -- must check previous entry 48: else 49: exit ; -- while I > 0 , previous entries sorted 50: end if ; 51: end loop ; -- on while I > 0 52: end loop ; -- on for J in 1..LIMIT 53: end loop ; -- on while M > 1 54: end SHELLI ; -- return from procedure 55: 56: end SHSORT ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 56 $ TADA/LIST=BANKS BANKS TeleSoft-Ada compiler -- Version 1.3d March 25, 1983 Copyright (c) 1981,1982,1983 TeleSoft. All rights reserved. Opening banks.text Symbol table space: 127.5K bytes Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 128 reset(banks.CODE) rewrite(banks.CODE) Segment 1, 3 procedures ... end. $ TYPE BANKS Opening banks.text 1: -- BANK ACCOUNT PROGRAM: 2: -- Possible full solution 3: -- TRANSACTIONS are OPEN CLOSE DEPOSIT WITHDRAW 4: -- user inputs ACCOUNT_NAME , TRANSACTION , AMOUNT 5: -- 10 characters key word ddd.dd 6: -- limit of 20 open accounts at any one time 7: 8: with TEXT_IO ; use TEXT_IO , FLOAT_IO ; 9: with SHSORT ; use SHSORT ; 10: procedure MAIN is 11: 12: subtype TRANSACTIONS is STRING(1..8) ; 13: TRANSACTION : TRANSACTIONS ; 14: 15: ACCOUNT_NAMES : A_NAMES( 1..20 ) ; 16: ACCOUNT_NAME : NAMES ; 17: 18: BALANCES : A_BALANCES( 1..20 ) ; 19: AMOUNT : FLOAT ; 20: OPEN_ACCOUNTS : INTEGER := 0 ; 21: INDEX : INTEGER ; 22: 23: -- internal function that finds index of account name if 24: -- presently open, else returns zero for no find. 25: function FIND_ACCOUNT( NAME : in NAMES ) return INTEGER is 26: begin 27: if OPEN_ACCOUNTS <= 0 then 28: return 0; 29: else 30: for I in 1..OPEN_ACCOUNTS loop 31: if NAME = ACCOUNT_NAMES(I) then 32: return I ; 33: end if ; 34: end loop ; 35: return 0 ; 36: end if ; 37: end FIND_ACCOUNT ; 38: 39: -- internal procedure with no arguments to print the 40: -- status of accounts still open at end of run. 41: procedure PRINT_ACCOUNTS is 42: begin 43: for I in 1..OPEN_ACCOUNTS loop 44: PUT(ACCOUNT_NAMES(I));PUT(BALANCES(I));PUT_LINE(""); 45: end loop ; 46: end PRINT_ACCOUNTS ; 47: 48: 49: begin 50: loop 51: PUT_LINE(" ENTER TRANSACTION. name,transaction,amount ") ; 52: -- get and put interspursed to catch errors quicker 53: -- this would normally be three GET's then PUT's 54: GET(ACCOUNT_NAME); 55: PUT(" name= "&ACCOUNT_NAME); 56: GET(TRANSACTION); 57: PUT(" transaction ") ; PUT(TRANSACTION) ; 58: GET(AMOUNT); 59: PUT(" amount =") ; PUT(AMOUNT) ; 60: PUT_LINE(""); 61: INDEX := FIND_ACCOUNT(ACCOUNT_NAME) ; -- uses internal 62: -- function above 63: if TRANSACTION = "OPEN " then 64: if INDEX /= 0 then 65: PUT_LINE(" ACCOUNT ALREADY OPEN "); 66: else 67: OPEN_ACCOUNTS := OPEN_ACCOUNTS + 1 ; 68: ACCOUNT_NAMES(OPEN_ACCOUNTS) := ACCOUNT_NAME ; 69: BALANCES(OPEN_ACCOUNTS) := AMOUNT ; 70: PUT(AMOUNT) ; 71: PUT(" in account opened for ") ; 72: PUT(ACCOUNT_NAME) ; 73: NEW_LINE ; 74: end if ; 75: 76: elsif TRANSACTION = "CLOSE " then 77: if INDEX = 0 then 78: PUT_LINE(" ACCOUNT NOT OPEN") ; 79: else 80: PUT(BALANCES(INDEX)) ; 81: PUT(" given to ") ; 82: PUT(ACCOUNT_NAMES(INDEX)) ; 83: PUT_LINE(" when account closed ") ; 84: ACCOUNT_NAMES(INDEX) := ACCOUNT_NAMES(OPEN_ACCOUNTS); 85: BALANCES(INDEX) := BALANCES(OPEN_ACCOUNTS) ; 86: OPEN_ACCOUNTS := OPEN_ACCOUNTS - 1 ; 87: end if ; 88: 89: elsif TRANSACTION = "DEPOSIT " then 90: if INDEX = 0 then 91: PUT_LINE(" ACCOUNT NOT OPEN") ; 92: else 93: BALANCES(INDEX) := BALANCES(INDEX) + AMOUNT ; 94: PUT(AMOUNT) ; 95: PUT(" deposited for ") ; 96: PUT(ACCOUNT_NAMES(INDEX)) ; 97: PUT(" now having balance of ") ; 98: PUT(BALANCES(INDEX)) ; 99: NEW_LINE ; 100: end if ; 101: 102: elsif TRANSACTION = "WITHDRAW" then 103: if INDEX = 0 then 104: PUT_LINE(" ACCOUNT NOT OPEN") ; 105: elsif BALANCES(INDEX) < AMOUNT then 106: PUT_LINE(" NOT SUFFICIENT FUNDS ") ; 107: else 108: BALANCES(INDEX) := BALANCES(INDEX) - AMOUNT ; 109: PUT(AMOUNT) ; 110: PUT(" withdrawn from ") ; 111: PUT(ACCOUNT_NAMES(INDEX)) ; 112: PUT(" now having balance of ") ; 113: PUT(BALANCES(INDEX)) ; 114: NEW_LINE ; 115: end if ; 116: end if ; 117: end loop ; 118: exception 119: when DATA_ERROR => 120: PUT_LINE(" BAD INPUT DATA "); 121: when END_ERROR => 122: PUT_LINE(" END OF INPUT DATA ") ; 123: 124: PRINT_ACCOUNTS ; -- calls internal procedure above to print 125: SHELLI(OPEN_ACCOUNTS,ACCOUNT_NAMES,BALANCES) ; -- do sort 126: PRINT_ACCOUNTS ; -- calls internal procedure above to print 127: PUT_LINE(" BANK IS CLOSED.") ; 128: end MAIN ; Compilation complete Syntax errors: 0 Semantic errors: 0 Lines compiled: 128 $ ASSIGN BANKS.DAT SYS$INPUT $ TRUN BANKS ENTER TRANSACTION. name,transaction,amount name= JOHN DOE transaction OPEN amount = 1.0000000E+01 1.0000000E+01 in account opened for JOHN DOE ENTER TRANSACTION. name,transaction,amount name= JIM JONES transaction OPEN amount = 3.7500000E+01 3.7500000E+01 in account opened for JIM JONES ENTER TRANSACTION. name,transaction,amount name= ART WALL transaction OPEN amount = 1.5000000E+01 1.5000000E+01 in account opened for ART WALL ENTER TRANSACTION. name,transaction,amount name= JOHN DOE transaction DEPOSIT amount = 5.0000000E+00 5.0000000E+00 deposited for JOHN DOE now having balance of 1.5000000E+01 ENTER TRANSACTION. name,transaction,amount name= JIM JONES transaction WITHDRAW amount = 7.5000000E+00 7.5000000E+00 withdrawn from JIM JONES now having balance of 3.0000000E+01 ENTER TRANSACTION. name,transaction,amount name= MARY SMITH transaction OPEN amount = 2.0000000E+01 2.0000000E+01 in account opened for MARY SMITH ENTER TRANSACTION. name,transaction,amount name= JOHN DOE transaction CLOSE amount = 0.0000000E+00 1.5000000E+01 given to JOHN DOE when account closed ENTER TRANSACTION. name,transaction,amount END OF INPUT DATA MARY SMITH 2.0000000E+01 JIM JONES 3.0000000E+01 ART WALL 1.5000000E+01 ART WALL 1.5000000E+01 JIM JONES 3.0000000E+01 MARY SMITH 2.0000000E+01 BANK IS CLOSED. $ DEASSIGN SYS$INPUT $ TYPE BANKS.DAT JOHN DOE OPEN 10.00 JIM JONES OPEN 37.50 ART WALL OPEN 15.00 JOHN DOE DEPOSIT 5.00 JIM JONES WITHDRAW 7.50 MARY SMITHOPEN 20.00 JOHN DOE CLOSE 0.00 $ SET NOVERIFY The command procedure to produce this printout was: $ SET VERIFY $ TADA/LIST=SHSORT SHSORT $ TYPE SHSORT $ TADA/LIST=BANKS BANKS $ TYPE BANKS $ ASSIGN BANKS.DAT SYS$INPUT $ TRUN BANKS $ DEASSIGN SYS$INPUT $ TYPE BANKS.DAT $ SET NOVERIFY