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