Source Code
![]() |
These source code files have been transcribed or otherwise adapted from
digitized images of a hardcopy from the private collection of
Don Eyles. The digitization was performed by archive.org, and
transcription was performed by a team of volunteers.
Note that the page images
presented online are of reduced quality, and that the original
high-quality images are available at archive.org.
Report any conversion errors or legibility problems in page images to info@sandroid.org.
Notations on the program listing read, in part:473423A YUL SYSTEM FOR BLK2: REVISION 12 of PROGRAM AURORA BY DAP GROUP NOV 10, 1966Note that the date is the date of the printout, not the date of the program revision. |
004592,000002: ## Copyright: Public domain.
004593,000003: ## Filename: SINGLE_PRECISION_SUBROUTINES.agc
004594,000004: ## Purpose: Part of the source code for Aurora (revision 12).
004595,000005: ## Assembler: yaYUL
004596,000006: ## Contact: Ron Burkey <info@sandroid.org>.
004597,000007: ## Website: https://www.ibiblio.org/apollo.
004598,000008: ## Pages: 123-125
004599,000009: ## Mod history: 2016-09-20 JL Created.
004600,000010: ## 2016-12-08 RSB Proofed comments with octopus/ProoferComments
004601,000011: ## but no errors found.
004602,000012:
004603,000013: ## This source code has been transcribed or otherwise adapted from
004604,000014: ## digitized images of a hardcopy from the private collection of
004605,000015: ## Don Eyles. The digitization was performed by archive.org.
004606,000016:
004607,000017: ## Notations on the hardcopy document read, in part:
004608,000018:
004609,000019: ## 473423A YUL SYSTEM FOR BLK2: REVISION 12 of PROGRAM AURORA BY DAP GROUP
004610,000020: ## NOV 10, 1966
004611,000021:
004612,000022: ## [Note that this is the date the hardcopy was made, not the
004613,000023: ## date of the program revision or the assembly.]
004614,000024:
004615,000025: ## The scan images (with suitable reduction in storage size and consequent
004616,000026: ## reduction in image quality) are available online at
004617,000027: ## https://www.ibiblio.org/apollo.
004618,000028: ## The original high-quality digital images are available at archive.org:
004619,000029: ## https://archive.org/details/aurora00dapg
004620,000030:
![]() |
Page 123 |
004622,000032: 4232 SETLOC ENDIBNKF
004623,000033:
004624,000034: # SINGLE PRECISION SINE AND COSINE
004625,000035:
004626,000036: 4232 67642 SPCOS AD HALF # ARGUMENTS SCALED AT PI
004627,000037: 4233 55105 SPSIN TS TEMK
004628,000038: 4234 14236 TCF SPT
004629,000039: 4235 41105 CS TEMK
004630,000040: 4236 60000 SPT DOUBLE
004631,000041: 4237 55105 TS TEMK
004632,000042: 4240 14251 TCF POLLEY
004633,000043: 4241 57105 XCH TEMK
004634,000044: 4242 51105 INDEX TEMK
004635,000045: 4243 67640 AD LIMITS
004636,000046: 4244 40000 COM
004637,000047: 4245 61105 AD TEMK
004638,000048: 4246 55105 TS TEMK
004639,000049: 4247 14251 TCF POLLEY
004640,000050: 4250 14267 TCF ARG90
004641,000051: 4251 00006 POLLEY EXTEND
004642,000052: 4252 71105 MP TEMK
004643,000053: 4253 55106 TS SQ
004644,000054: 4254 00006 EXTEND
004645,000055: 4255 74274 MP C5/2
004646,000056: 4256 64273 AD C3/2
004647,000057: 4257 00006 EXTEND
004648,000058: 4260 71106 MP SQ
004649,000059: 4261 64272 AD C1/2
004650,000060: 4262 00006 EXTEND
004651,000061: 4263 71105 MP TEMK
004652,000062: 4264 20001 DDOUBL
004653,000063: 4265 55105 TS TEMK
004654,000064: 4266 00002 TC Q
004655,000065: 4267 50000 ARG90 INDEX A
004656,000066: 4270 47640 CS LIMITS
004657,000067: 4271 00002 TC Q # RESULT SCALED AT 1
004658,000068: 4272 31103 C1/2 DEC .7853134
004659,000069: 4273 65552 C3/2 DEC -.3216146
004660,000070: 4274 01124 C5/2 DEC .0363551
![]() |
Page 124 |
004662,000072: # ENTER WITH ARGUMENT IN A, EXIT WITH ROOT IN A. IF GIVEN A NEGATIVE ARGUMENT, THE RETURN SKIPS WITH CCS RESULT.
004663,000073: # MINUS ZERO RETURNS LIKE PLUS ZERO.
004664,000074: # MAXIMUM ERROR IN ANSWER IS NO GREATER THAN 2 BITS.
004665,000075: # INTERRUPT PROGRAMS USING SPROOT MUST SAVE AND RESTORE SR.
004666,000076:
004667,000077:
004668,000078:
004669,000079: 4275 55107 SPROOT TS SQRARG # ENTER WITH C(A) = Y
004670,000080: 4276 10000 CCS A
004671,000081: 4277 14303 TCF POSARG # IF PNZ, CONTINUE
004672,000082: 4300 00002 TC Q # RETURN WITH 0 FOR +0
004673,000083: 4301 24002 INCR Q
004674,000084: 4302 00002 TC Q # RETURN WITH 0 FOR -0
004675,000085:
004676,000086: 4303 00006 POSARG EXTEND
004677,000087: 4304 23106 QXCH ROOTRET # WILL BE CALLING SPROOT1
004678,000088: 4305 64362 AD 63/64+1 # B(A) = Y - 1
004679,000089: 4306 54000 OVSK
004680,000090: 4307 14351 TCF SPROOT2
004681,000091: 4310 57107 XCH SQRARG # ARG JUGGLING
004682,000092:
004683,000093: 4311 55107 SPROOT3 TS SQRARG
004684,000094: 4312 54021 TS SR # C(A) = Y
004685,000095: 4313 56021 XCH SR # (LOSE 1 BIT)
004686,000096: 4314 55105 TS HALFY # HALFY = Y/2
004687,000097: 4315 64360 AD -1/8 # FORM Y/2 - 1/8
004688,000098: 4316 10000 CCS A # TEST FOR FIRST GUESS
004689,000099: 4317 64361 AD 5/8+1 # Y .G. 1/4, X = Y/2 + 1/2
004690,000100: 4320 04325 TC HIGUESS # +0 IMPOSSIBLE FROM ADDITION
004691,000101: 4321 14322 NOOP # Y .LE. 1/4, X/2 = Y + 1/16
004692,000102: 4322 37645 CAF BIT11 # 1/16
004693,000103: 4323 61107 AD SQRARG # SQRARG = Y
004694,000104: 4324 60000 DOUBLE # X FROM X/2
004695,000105: 4325 04340 HIGUESS TC SPROOT1
004696,000106: 4326 04340 TC SPROOT1 # ITERATE TWICE
004697,000107: 4327 57106 XCH ROOTRET # SAVE ANSWER AND GET Q
004698,000108: 4330 10000 CCS A
004699,000109: 4331 57106 XCH ROOTRET # NO SHIFT NEEDED
004700,000110: 4332 04336 TC ROOTBCK
004701,000111: 4333 57106 XCH ROOTRET # Q NEG, SHIFT RIGHT THREE
004702,000112: 4334 00006 EXTEND
004703,000113: 4335 77644 MP BIT12 # EXP -3
004704,000114: 4336 51106 ROOTBCK INDEX ROOTRET # ROOTRET = Q - 1
004705,000115: 4337 00001 TC 1 # RETURN, C(A) = SQRT(Y)
004706,000116:
004707,000117: 4340 56021 SPROOT1 XCH SR # SR = X/2
004708,000118: 4341 41105 CS HALFY # NEWTON ITER X = X/2 + (Y/2 / X/2) / 2
004709,000119: 4342 22007 ZL
004710,000120: 4343 00006 EXTEND
004711,000121: 4344 10021 DV SR # C(SR) = X/2 DV DOES NOT EDIT
![]() |
Page 125 |
004713,000123: 4345 56021 XCH SR
004714,000124: 4346 00006 EXTEND
004715,000125: 4347 60021 SU SR
004716,000126: 4350 00002 TC Q # C(A) = X (NEXT)
004717,000127:
004718,000128: 4351 41106 SPROOT2 CS ROOTRET # SET RETURN Q NEG, AS FLAG
004719,000129: 4352 55106 TS ROOTRET
004720,000130: 4353 37651 CAF BIT7 # SHIFT FOR SIGNIFCANCE
004721,000131: 4354 00006 EXTEND
004722,000132: 4355 71107 MP SQRARG
004723,000133: 4356 30001 CA L # B(A) = 0
004724,000134: 4357 04311 TC SPROOT3
004725,000135:
004726,000136: 4360 73777 -1/8 OCTAL 73777
004727,000137: 4361 24001 5/8+1 OCTAL 24001
004728,000138: 4362 37401 63/64+1 OCTAL 37401
004729,000139:
004730,000140:
004731,000141:
004732,000142: 4363 ENDSUBSF EQUALS
End of include-file SINGLE_PRECISION_SUBROUTINES.agc. Parent file is MAIN.agc