Source Code
|
These source-code files were transcribed from a printout in Don Eyles's personal
collection, scanned by archive.org, and financially sponsored by Peter McDermott.
A team of volunteers performed the transcription and proof-reading. The scanned
page images are available at
the Virtual AGC Project website, as well as higher-quality (but much larger)
images at
the Virtual AGC Project's collection in the Internet Archive. Report any problems by creating
"issues" at
the Virtual AGC Project's GitHub Repository. Notations on the program listing read, in part:
YUL SYSTEM FOR AGC: NEW PROGRAM SHEPATIN BY EYLES
DEC 13, 1966
THIS PROGRAM WAS ASSEMBLED AS A VERSION OF REVISION 37
OF PROGRAM SUNBURST BY LEM GROUP
Note that the date is the date of the printout, not the date of the program revision.
|
043833,000002: ## Copyright: Public domain.
043834,000003: ## Filename: SINGLE_PRECISION_SUBROUTINES.agc
043835,000004: ## Purpose: A section of Sunburst revision 37, or Shepatin revision 0.
043836,000005: ## It is part of an early development version of the software
043837,000006: ## for Apollo Guidance Computer (AGC) on the unmanned Lunar
043838,000007: ## Module (LM) flight Apollo 5. Sunburst 37 was the program
043839,000008: ## upon which Don Eyles's offline development program Shepatin
043840,000009: ## was based; the listing herein transcribed was actually for
043841,000010: ## the equivalent revision 0 of Shepatin.
043842,000011: ## This file is intended to be a faithful transcription, except
043843,000012: ## that the code format has been changed to conform to the
043844,000013: ## requirements of the yaYUL assembler rather than the
043845,000014: ## original YUL assembler.
043846,000015: ## Reference: pp. 985-987
043847,000016: ## Assembler: yaYUL
043848,000017: ## Contact: Ron Burkey <info@sandroid.org>.
043849,000018: ## Website: www.ibiblio.org/apollo/index.html
043850,000019: ## Mod history: 2017-05-24 MAS Created from Sunburst 120.
043851,000020: ## 2017-06-17 NV Updated for Sunburst 37
043852,000021: ## 2017-06-23 RSB Proofed comment text with
043853,000022: ## octopus/ProoferComments.
043854,000023:
|
|
Page 985 |
043856,000025: 5372 BLOCK 02
043857,000026: # SINGLE PRECISION SINE AND COSINE
043858,000027:
043859,000028: 5372 67740 SPCOS AD HALF # ARGUMENTS SCALED AT PI
043860,000029: 5373 55127 SPSIN TS TEMK
043861,000030: 5374 15376 TCF SPT
043862,000031: 5375 41127 CS TEMK
043863,000032: 5376 60000 SPT DOUBLE
043864,000033: 5377 55127 TS TEMK
043865,000034: 5400 15411 TCF POLLEY
043866,000035: 5401 57127 XCH TEMK
043867,000036: 5402 51127 INDEX TEMK
043868,000037: 5403 67736 AD LIMITS
043869,000038: 5404 40000 COM
043870,000039: 5405 61127 AD TEMK
043871,000040: 5406 55127 TS TEMK
043872,000041: 5407 15411 TCF POLLEY
043873,000042: 5410 15427 TCF ARG90
043874,000043: 5411 00006 POLLEY EXTEND
043875,000044: 5412 71127 MP TEMK
043876,000045: 5413 55130 TS SQ
043877,000046: 5414 00006 EXTEND
043878,000047: 5415 75434 MP C5/2
043879,000048: 5416 65433 AD C3/2
043880,000049: 5417 00006 EXTEND
043881,000050: 5420 71130 MP SQ
043882,000051: 5421 65432 AD C1/2
043883,000052: 5422 00006 EXTEND
043884,000053: 5423 71127 MP TEMK
043885,000054: 5424 20001 DDOUBL
043886,000055: 5425 55127 TS TEMK
043887,000056: 5426 00002 TC Q
043888,000057: 5427 50000 ARG90 INDEX A
043889,000058: 5430 47736 CS LIMITS
043890,000059: 5431 00002 TC Q # RESULT SCALED AT 1
043891,000060: 5432 31103 C1/2 DEC .7853134
043892,000061: 5433 65552 C3/2 DEC -.3216146
043893,000062: 5434 01124 C5/2 DEC .0363551
|
|
Page 986 |
043895,000064: # ENTER WITH ARGUMENT IN A, EXIT WITH ROOT IN A. IF GIVEN A NEGATIVE ARGUMENT, THE RETURN SKIPS WITH CCS RESULT.
043896,000065: # MINUS ZERO RETURNS LIKE PLUS ZERO.
043897,000066: # MAXIMUM ERROR IN ANSWER IS NO GREATER THAN 2 BITS.
043898,000067: # INTERRUPT PROGRAMS USING SPROOT MUST SAVE AND RESTORE SR.
043899,000068:
043900,000069:
043901,000070:
043902,000071: 5435 55131 SPROOT TS SQRARG # ENTER WITH C(A) = Y
043903,000072: 5436 10000 CCS A
043904,000073: 5437 15443 TCF POSARG # IF PNZ, CONTINUE
043905,000074: 5440 00002 TC Q # RETURN WITH 0 FOR +0
043906,000075: 5441 24002 INCR Q
043907,000076: 5442 00002 TC Q # RETURN WITH 0 FOR -0
043908,000077:
043909,000078: 5443 00006 POSARG EXTEND
043910,000079: 5444 23130 QXCH ROOTRET # WILL BE CALLING SPROOT1
043911,000080: 5445 65522 AD 63/64+1 # B(A) = Y - 1
043912,000081: 5446 54000 OVSK
043913,000082: 5447 15511 TCF SPROOT2
043914,000083: 5450 57131 XCH SQRARG # ARG JUGGLING
043915,000084:
043916,000085: 5451 55131 SPROOT3 TS SQRARG
043917,000086: 5452 54021 TS SR # C(A) = Y
043918,000087: 5453 56021 XCH SR # (LOSE 1 BIT)
043919,000088: 5454 55127 TS HALFY # HALFY = Y/2
043920,000089: 5455 65520 AD -1/8 # FORM Y/2 - 1/8
043921,000090: 5456 10000 CCS A # TEST FOR FIRST GUESS
043922,000091: 5457 65521 AD 5/8+1 # Y .G. 1/4, X = Y/2 + 1/2
043923,000092: 5460 05465 TC HIGUESS # +0 IMPOSSIBLE FROM ADDITION
043924,000093: 5461 15462 NOOP # Y .LE. 1/4, X/2 = Y + 1/16
043925,000094: 5462 37743 CAF BIT11 # 1/16
043926,000095: 5463 61131 AD SQRARG # SQRARG = Y
043927,000096: 5464 60000 DOUBLE # X FROM X/2
043928,000097: 5465 05500 HIGUESS TC SPROOT1
043929,000098: 5466 05500 TC SPROOT1 # ITERATE TWICE
043930,000099: 5467 57130 XCH ROOTRET # SAVE ANSWER AND GET Q
043931,000100: 5470 10000 CCS A
043932,000101: 5471 57130 XCH ROOTRET # NO SHIFT NEEDED
043933,000102: 5472 05476 TC ROOTBCK
043934,000103: 5473 57130 XCH ROOTRET # Q NEG, SHIFT RIGHT THREE
043935,000104: 5474 00006 EXTEND
043936,000105: 5475 77742 MP BIT12 # EXP -3
043937,000106: 5476 51130 ROOTBCK INDEX ROOTRET # ROOTRET = Q - 1
043938,000107: 5477 00001 TC 1 # RETURN, C(A) = SQRT(Y)
043939,000108:
043940,000109: 5500 56021 SPROOT1 XCH SR # SR = X/2
043941,000110: 5501 41127 CS HALFY # NEWTON ITER X = X/2 + (Y/2 / X/2) / 2
043942,000111: 5502 22007 ZL
043943,000112: 5503 00006 EXTEND
043944,000113: 5504 10021 DV SR # C(SR) = X/2 DV DOES NOT EDIT
|
|
Page 987 |
043946,000115: 5505 56021 XCH SR
043947,000116: 5506 00006 EXTEND
043948,000117: 5507 60021 SU SR
043949,000118: 5510 00002 TC Q # C(A) = X (NEXT)
043950,000119:
043951,000120: 5511 41130 SPROOT2 CS ROOTRET # SET RETURN Q NEG, AS FLAG
043952,000121: 5512 55130 TS ROOTRET
043953,000122: 5513 37747 CAF BIT7 # SHIFT FOR SIGNIFCANCE
043954,000123: 5514 00006 EXTEND
043955,000124: 5515 71131 MP SQRARG
043956,000125: 5516 30001 CA L # B(A) = 0
043957,000126: 5517 05451 TC SPROOT3
043958,000127:
043959,000128: 5520 73777 -1/8 OCTAL 73777
043960,000129: 5521 24001 5/8+1 OCTAL 24001
043961,000130: 5522 37401 63/64+1 OCTAL 37401
043962,000131:
End of include-file SINGLE_PRECISION_SUBROUTINES.agc. Parent file is MAIN.agc