Source Code
![]() |
YAYUL: ASSEMBLE REVISION 6 OF PROGRAM BOREALIS BY MSTEWART JUN. 28,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. |
004425,000002: ## Copyright: Public domain.
004426,000003: ## Filename: SINGLE_PRECISION_SUBROUTINES.agc
004427,000004: ## Purpose: This program is designed to extensively test the Apollo Guidance Computer
004428,000005: ## (specifically the LM instantiation of it). It is built on top of a heavily
004429,000006: ## stripped-down Aurora 12, with all code ostensibly added by the DAP Group
004430,000007: ## removed. Instead Borealis expands upon the tests provided by Aurora,
004431,000008: ## including corrected tests from Retread 44 and tests from Ron Burkey's
004432,000009: ## Validation.
004433,000010: ## Assembler: yaYUL
004434,000011: ## Contact: Mike Stewart <mastewar1@gmail.com>.
004435,000012: ## Website: www.ibiblio.org/apollo/index.html
004436,000013: ## Mod history: 2016-12-20 MAS Created from Aurora 12 (with much DAP stuff removed).
004437,000014:
004438,000015: 4213 SETLOC ENDIBNKF
004439,000016:
004440,000017: # SINGLE PRECISION SINE AND COSINE
004441,000018:
004442,000019: 4213 67654 SPCOS AD HALF # ARGUMENTS SCALED AT PI
004443,000020: 4214 55105 SPSIN TS TEMK
004444,000021: 4215 14217 TCF SPT
004445,000022: 4216 41105 CS TEMK
004446,000023: 4217 60000 SPT DOUBLE
004447,000024: 4220 55105 TS TEMK
004448,000025: 4221 14232 TCF POLLEY
004449,000026: 4222 57105 XCH TEMK
004450,000027: 4223 51105 INDEX TEMK
004451,000028: 4224 67652 AD LIMITS
004452,000029: 4225 40000 COM
004453,000030: 4226 61105 AD TEMK
004454,000031: 4227 55105 TS TEMK
004455,000032: 4230 14232 TCF POLLEY
004456,000033: 4231 14250 TCF ARG90
004457,000034: 4232 00006 POLLEY EXTEND
004458,000035: 4233 71105 MP TEMK
004459,000036: 4234 55106 TS SQ
004460,000037: 4235 00006 EXTEND
004461,000038: 4236 74255 MP C5/2
004462,000039: 4237 64254 AD C3/2
004463,000040: 4240 00006 EXTEND
004464,000041: 4241 71106 MP SQ
004465,000042: 4242 64253 AD C1/2
004466,000043: 4243 00006 EXTEND
004467,000044: 4244 71105 MP TEMK
004468,000045: 4245 20001 DDOUBL
004469,000046: 4246 55105 TS TEMK
004470,000047: 4247 00002 TC Q
004471,000048: 4250 50000 ARG90 INDEX A
004472,000049: 4251 47652 CS LIMITS
004473,000050: 4252 00002 TC Q # RESULT SCALED AT 1
004474,000051: 4253 31103 C1/2 DEC .7853134
004475,000052: 4254 65552 C3/2 DEC -.3216146
004476,000053: 4255 01124 C5/2 DEC .0363551
004477,000054: # ENTER WITH ARGUMENT IN A, EXIT WITH ROOT IN A. IF GIVEN A NEGATIVE ARGUMENT, THE RETURN SKIPS WITH CCS RESULT
004478,000055: # MINUS ZERO RETURNS LIKE PLUS ZERO.
004479,000056: # MAXIMUM ERROR IN ANSWER IS NO GREATER THAN 2 BITS.
004480,000057: # INTERRUPT PROGRAMS USING SPROOT MUST SAVE AND RESTORE SR.
004481,000058:
004482,000059:
004483,000060:
004484,000061: 4256 55107 SPROOT TS SQRARG # ENTER WITH C(A) = Y
004485,000062: 4257 10000 CCS A
004486,000063: 4260 14264 TCF POSARG # IF PNZ, CONTINUE
004487,000064: 4261 00002 TC Q # RETURN WITH 0 FOR +0
004488,000065: 4262 24002 INCR Q
004489,000066: 4263 00002 TC Q # RETURN WITH 0 FOR -0
004490,000067:
004491,000068: 4264 00006 POSARG EXTEND
004492,000069: 4265 23106 QXCH ROOTRET # WILL BE CALLING SPROOT1
004493,000070: 4266 64343 AD 63/64+1 # B(A) = Y - 1
004494,000071: 4267 54000 OVSK
004495,000072: 4270 14332 TCF SPROOT2
004496,000073: 4271 57107 XCH SQRARG # ARG JUGGLING
004497,000074:
004498,000075: 4272 55107 SPROOT3 TS SQRARG
004499,000076: 4273 54021 TS SR # C(A) = Y
004500,000077: 4274 56021 XCH SR # (LOSE 1 BIT)
004501,000078: 4275 55105 TS HALFY # HALFY = Y/2
004502,000079: 4276 64341 AD -1/8 # FORM Y/2 - 1/8
004503,000080: 4277 10000 CCS A # TEST FOR FIRST GUESS
004504,000081: 4300 64342 AD 5/8+1 # Y .G. 1/4, X = Y/2 + 1/2
004505,000082: 4301 04306 TC HIGUESS # +0 IMPOSSIBLE FROM ADDITION
004506,000083: 4302 14303 NOOP # Y .LE. 1/4, X/2 = Y + 1/16
004507,000084: 4303 37657 CAF BIT11 # 1/16
004508,000085: 4304 61107 AD SQRARG # SQRARG = Y
004509,000086: 4305 60000 DOUBLE # X FROM X/2
004510,000087: 4306 04321 HIGUESS TC SPROOT1
004511,000088: 4307 04321 TC SPROOT1 # ITERATE TWICE
004512,000089: 4310 57106 XCH ROOTRET # SAVE ANSWER AND GET Q
004513,000090: 4311 10000 CCS A
004514,000091: 4312 57106 XCH ROOTRET # NO SHIFT NEEDED
004515,000092: 4313 04317 TC ROOTBCK
004516,000093: 4314 57106 XCH ROOTRET # Q NEG, SHIFT RIGHT THREE
004517,000094: 4315 00006 EXTEND
004518,000095: 4316 77656 MP BIT12 # EXP -3
004519,000096: 4317 51106 ROOTBCK INDEX ROOTRET # ROOTRET = Q - 1
004520,000097: 4320 00001 TC 1 # RETURN, C(A) = SQRT(Y)
004521,000098:
004522,000099: 4321 56021 SPROOT1 XCH SR # SR = X/2
004523,000100: 4322 41105 CS HALFY # NEWTON ITER X = X/2 + (Y/2 / X/2) / 2
004524,000101: 4323 22007 ZL
004525,000102: 4324 00006 EXTEND
004526,000103: 4325 10021 DV SR # C(SR) = X/2 DV DOES NOT EDIT
004527,000104: 4326 56021 XCH SR
004528,000105: 4327 00006 EXTEND
004529,000106: 4330 60021 SU SR
004530,000107: 4331 00002 TC Q # C(A) = X (NEXT)
004531,000108:
004532,000109: 4332 41106 SPROOT2 CS ROOTRET # SET RETURN Q NEG, AS FLAG
004533,000110: 4333 55106 TS ROOTRET
004534,000111: 4334 37663 CAF BIT7 # SHIFT FOR SIGNIFCANCE
004535,000112: 4335 00006 EXTEND
004536,000113: 4336 71107 MP SQRARG
004537,000114: 4337 30001 CA L # B(A) = 0
004538,000115: 4340 04272 TC SPROOT3
004539,000116:
004540,000117: 4341 73777 -1/8 OCTAL 73777
004541,000118: 4342 24001 5/8+1 OCTAL 24001
004542,000119: 4343 37401 63/64+1 OCTAL 37401
004543,000120:
004544,000121:
004545,000122:
004546,000123: 4344 ENDSUBSF EQUALS
End of include-file SINGLE_PRECISION_SUBROUTINES.agc. Parent file is MAIN.agc