Source Code
![]() |
YAYUL: ASSEMBLE REVISION 5 OF PROGRAM BOREALIS BY MSTEWART MAR. 27,2017This is a modern AGC system self-test program, though based on the Apollo-era AURORA 12 program, and was not written by the original AGC developers, but rather by Mike Stewart. All of the original AURORA 12 DAP code added by the DAP Group has been removed, and extensive new system test code has been added in its place. This allows more in-depth testing of CPU behavior, both in AGC software simulations and hardware simulations. |
004341,000002: ## Copyright: Public domain.
004342,000003: ## Filename: SINGLE_PRECISION_SUBROUTINES.agc
004343,000004: ## Purpose: This program is designed to extensively test the Apollo Guidance Computer
004344,000005: ## (specifically the LM instantiation of it). It is built on top of a heavily
004345,000006: ## stripped-down Aurora 12, with all code ostensibly added by the DAP Group
004346,000007: ## removed. Instead Borealis expands upon the tests provided by Aurora,
004347,000008: ## including corrected tests from Retread 44 and tests from Ron Burkey's
004348,000009: ## Validation.
004349,000010: ## Assembler: yaYUL
004350,000011: ## Contact: Mike Stewart <mastewar1@gmail.com>.
004351,000012: ## Website: www.ibiblio.org/apollo/index.html
004352,000013: ## Mod history: 2016-12-20 MAS Created from Aurora 12 (with much DAP stuff removed).
004353,000014:
004354,000015: 4213 SETLOC ENDIBNKF
004355,000016:
004356,000017: # SINGLE PRECISION SINE AND COSINE
004357,000018:
004358,000019: 4213 67642 SPCOS AD HALF # ARGUMENTS SCALED AT PI
004359,000020: 4214 55105 SPSIN TS TEMK
004360,000021: 4215 14217 TCF SPT
004361,000022: 4216 41105 CS TEMK
004362,000023: 4217 60000 SPT DOUBLE
004363,000024: 4220 55105 TS TEMK
004364,000025: 4221 14232 TCF POLLEY
004365,000026: 4222 57105 XCH TEMK
004366,000027: 4223 51105 INDEX TEMK
004367,000028: 4224 67640 AD LIMITS
004368,000029: 4225 40000 COM
004369,000030: 4226 61105 AD TEMK
004370,000031: 4227 55105 TS TEMK
004371,000032: 4230 14232 TCF POLLEY
004372,000033: 4231 14250 TCF ARG90
004373,000034: 4232 00006 POLLEY EXTEND
004374,000035: 4233 71105 MP TEMK
004375,000036: 4234 55106 TS SQ
004376,000037: 4235 00006 EXTEND
004377,000038: 4236 74255 MP C5/2
004378,000039: 4237 64254 AD C3/2
004379,000040: 4240 00006 EXTEND
004380,000041: 4241 71106 MP SQ
004381,000042: 4242 64253 AD C1/2
004382,000043: 4243 00006 EXTEND
004383,000044: 4244 71105 MP TEMK
004384,000045: 4245 20001 DDOUBL
004385,000046: 4246 55105 TS TEMK
004386,000047: 4247 00002 TC Q
004387,000048: 4250 50000 ARG90 INDEX A
004388,000049: 4251 47640 CS LIMITS
004389,000050: 4252 00002 TC Q # RESULT SCALED AT 1
004390,000051: 4253 31103 C1/2 DEC .7853134
004391,000052: 4254 65552 C3/2 DEC -.3216146
004392,000053: 4255 01124 C5/2 DEC .0363551
004393,000054: # ENTER WITH ARGUMENT IN A, EXIT WITH ROOT IN A. IF GIVEN A NEGATIVE ARGUMENT, THE RETURN SKIPS WITH CCS RESULT
004394,000055: # MINUS ZERO RETURNS LIKE PLUS ZERO.
004395,000056: # MAXIMUM ERROR IN ANSWER IS NO GREATER THAN 2 BITS.
004396,000057: # INTERRUPT PROGRAMS USING SPROOT MUST SAVE AND RESTORE SR.
004397,000058:
004398,000059:
004399,000060:
004400,000061: 4256 55107 SPROOT TS SQRARG # ENTER WITH C(A) = Y
004401,000062: 4257 10000 CCS A
004402,000063: 4260 14264 TCF POSARG # IF PNZ, CONTINUE
004403,000064: 4261 00002 TC Q # RETURN WITH 0 FOR +0
004404,000065: 4262 24002 INCR Q
004405,000066: 4263 00002 TC Q # RETURN WITH 0 FOR -0
004406,000067:
004407,000068: 4264 00006 POSARG EXTEND
004408,000069: 4265 23106 QXCH ROOTRET # WILL BE CALLING SPROOT1
004409,000070: 4266 64343 AD 63/64+1 # B(A) = Y - 1
004410,000071: 4267 54000 OVSK
004411,000072: 4270 14332 TCF SPROOT2
004412,000073: 4271 57107 XCH SQRARG # ARG JUGGLING
004413,000074:
004414,000075: 4272 55107 SPROOT3 TS SQRARG
004415,000076: 4273 54021 TS SR # C(A) = Y
004416,000077: 4274 56021 XCH SR # (LOSE 1 BIT)
004417,000078: 4275 55105 TS HALFY # HALFY = Y/2
004418,000079: 4276 64341 AD -1/8 # FORM Y/2 - 1/8
004419,000080: 4277 10000 CCS A # TEST FOR FIRST GUESS
004420,000081: 4300 64342 AD 5/8+1 # Y .G. 1/4, X = Y/2 + 1/2
004421,000082: 4301 04306 TC HIGUESS # +0 IMPOSSIBLE FROM ADDITION
004422,000083: 4302 14303 NOOP # Y .LE. 1/4, X/2 = Y + 1/16
004423,000084: 4303 37645 CAF BIT11 # 1/16
004424,000085: 4304 61107 AD SQRARG # SQRARG = Y
004425,000086: 4305 60000 DOUBLE # X FROM X/2
004426,000087: 4306 04321 HIGUESS TC SPROOT1
004427,000088: 4307 04321 TC SPROOT1 # ITERATE TWICE
004428,000089: 4310 57106 XCH ROOTRET # SAVE ANSWER AND GET Q
004429,000090: 4311 10000 CCS A
004430,000091: 4312 57106 XCH ROOTRET # NO SHIFT NEEDED
004431,000092: 4313 04317 TC ROOTBCK
004432,000093: 4314 57106 XCH ROOTRET # Q NEG, SHIFT RIGHT THREE
004433,000094: 4315 00006 EXTEND
004434,000095: 4316 77644 MP BIT12 # EXP -3
004435,000096: 4317 51106 ROOTBCK INDEX ROOTRET # ROOTRET = Q - 1
004436,000097: 4320 00001 TC 1 # RETURN, C(A) = SQRT(Y)
004437,000098:
004438,000099: 4321 56021 SPROOT1 XCH SR # SR = X/2
004439,000100: 4322 41105 CS HALFY # NEWTON ITER X = X/2 + (Y/2 / X/2) / 2
004440,000101: 4323 22007 ZL
004441,000102: 4324 00006 EXTEND
004442,000103: 4325 10021 DV SR # C(SR) = X/2 DV DOES NOT EDIT
004443,000104: 4326 56021 XCH SR
004444,000105: 4327 00006 EXTEND
004445,000106: 4330 60021 SU SR
004446,000107: 4331 00002 TC Q # C(A) = X (NEXT)
004447,000108:
004448,000109: 4332 41106 SPROOT2 CS ROOTRET # SET RETURN Q NEG, AS FLAG
004449,000110: 4333 55106 TS ROOTRET
004450,000111: 4334 37651 CAF BIT7 # SHIFT FOR SIGNIFCANCE
004451,000112: 4335 00006 EXTEND
004452,000113: 4336 71107 MP SQRARG
004453,000114: 4337 30001 CA L # B(A) = 0
004454,000115: 4340 04272 TC SPROOT3
004455,000116:
004456,000117: 4341 73777 -1/8 OCTAL 73777
004457,000118: 4342 24001 5/8+1 OCTAL 24001
004458,000119: 4343 37401 63/64+1 OCTAL 37401
004459,000120:
004460,000121:
004461,000122:
004462,000123: 4344 ENDSUBSF EQUALS
End of include-file SINGLE_PRECISION_SUBROUTINES.agc. Parent file is MAIN.agc