'<PCODE "COMPLX">

<PACKAGE "COMPLX"> 

<ENTRY CPX RCPX PCPX UCPX RUCPX PUCPX CPXCOPY CSET POLAR RECTANGULAR C+ C- C* C/
C** REAL RPRT IMAG IMRT MAGN MGXY PHASE PHXY UVFIX UVFLOAT VFIX VFLOAT FIXIFY XY
RT FX FL **> 

"COMPLEX NUMBERS, IN POLAR OR RECTANGULAR FORMAT

EL1 -- ATOM, POLAR OR RECTANGULAR
EL2 -- FIX/FLOAT, REAL PART IF RECTANGULAR, MAGN, IF POLAR
EL3 -- FIX/FLOAT, IMAG PART IF RECTANGULAR, PHASE, IF POLAR
" 

<NEWTYPE CPX VECTOR '<<PRIMTYPE VECTOR> ATOM [2 <OR FIX FLOAT>]>> 

<NEWTYPE UCPX VECTOR '<<PRIMTYPE VECTOR> ATOM [2 <UVECTOR <OR FIX FLOAT>>]>> 

<SETG RCPX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 0> RCPX #DECL ("VALUE" FORM 
"QUOTE" ANY "QUOTE" ANY) CHTYPE VECTOR RECTANGULAR CPX]>)> 

<SETG PCPX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 35> PCPX #DECL ("VALUE" FORM
"QUOTE" ANY "QUOTE" ANY) CHTYPE VECTOR POLAR CPX]>)> 

"ARRAY OF COMPLEX NUMBERS, COMPACTED

EL1 -- ATOM, POLAR OR RECTANGULAR
EL2 -- REAL ARRAY IF RECTANGULAR, MAGN ARRAY IF POLAR
EL3 -- IMAG ARRAY IF RECTANGULAR, PHASE ARRAY IF POLAR
" 

<SETG RUCPX  %<RSUBR!- '[ %<PCODE!- "COMPLX" 70> RUCPX #DECL ("VALUE" UCPX 
"TUPLE" TUPLE) RECTANGULAR INVALID-ARGS RUCPX %<TYPE-W UCPX VECTOR> POLAR PUCPX 
%<TYPE-C CPX VECTOR> %<TYPE-W CPX VECTOR> %<TYPE-C UCPX VECTOR> #FALSE () UCPX 
UNKNOWN-COMPLEX-TYPE FL UVECTOR UNKNOWN-TYPE-OF-COMPLEX REAL IMAG CPX FLOAT T C+
 C- MAGN PHASE C* C/ ATTEMPT-TO-USE-IMAGINARY-POWER C** FIX XY RT]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,RUCPX PGLUE ![1070596095 -16 0!]>> 

<SETG PUCPX %<RSUBR-ENTRY '[RUCPX PUCPX #DECL ("VALUE" UCPX "TUPLE" TUPLE)] 113>
> 

\ 

<SETG CPXCOPY %<RSUBR-ENTRY '[RUCPX CPXCOPY #DECL ("VALUE" <OR CPX FALSE UCPX> <
OR CPX UCPX>)] 226>> 

<SETG CSET #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7602> CSET #DECL ("VALUE" 
FORM "QUOTE" ANY "QUOTE" ANY) PROG () PUT]>)> 

"C+ -- ADDS COMPLEX QUANTITIES.  ALWAYS RETURNS FIRST QUANTITY
  GIVEN, CHANGED TO CONTAIN THE SUM OF ALL ARGS
  IF FIRST ARG IS UCPX, WILL PERFORM ELEMENT-BY-ELEMENT SUM WITH
  OTHER UCPX'S IN ARG TUPLE, AND ADD VALUES OF ANY SINGLE COMPLEX
  QUANTITIES TO EACH ELEMENT OF FIRST ARG.
  " 

<SETG C+ %<RSUBR-ENTRY '[RUCPX C+ #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 281>> 

\ 

<SETG C- %<RSUBR-ENTRY '[RUCPX C- #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 1174>> 

\ 

<SETG C* %<RSUBR-ENTRY '[RUCPX C* #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 2352>> 

\ 

<SETG C/ %<RSUBR-ENTRY '[RUCPX C/ #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> ATOM
<UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 3477>> 

\ 

<SETG C** %<RSUBR-ENTRY '[RUCPX C** #DECL ("VALUE" <OR CPX <<PRIMTYPE VECTOR> 
ATOM <UVECTOR <OR FIX FLOAT>> <UVECTOR <OR FIX FLOAT>>>> "TUPLE" TUPLE)] 4798>> 

\ 

<SETG REAL #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7682> REAL #DECL ("VALUE" 
FORM "QUOTE" ANY) COND ==? RECTANGULAR POLAR TYPE? UVECTOR XY ELSE RPRT ERROR 
UNKNOWN-TYPE-OF-COMPLEX REAL]>)> 

<SETG IMAG #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7840> IMAG #DECL ("VALUE" 
FORM "QUOTE" ANY) COND ==? RECTANGULAR POLAR TYPE? UVECTOR XY ELSE IMRT ERROR 
UNKNOWN-TYPE-OF-COMPLEX IMAG]>)> 

<SETG MAGN #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 7998> MAGN #DECL ("VALUE" 
FORM "QUOTE" ANY) COND ==? POLAR RECTANGULAR TYPE? UVECTOR RT ELSE MGXY ERROR 
UNKNOWN-TYPE-OF-COMPLEX MAGN]>)> 

<SETG PHASE #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8156> PHASE #DECL ("VALUE" 
FORM "QUOTE" ANY) COND ==? POLAR RECTANGULAR TYPE? UVECTOR RT ELSE PHXY ERROR 
UNKNOWN-TYPE-OF-COMPLEX PHASE]>)> 

<SETG MGXY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8314> MGXY #DECL ("VALUE" 
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX SQRT + * FLOAT ELSE]>)> 

<SETG PHXY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8443> PHXY #DECL ("VALUE" 
FORM "QUOTE" ANY "QUOTE" ANY) + COND L? ELSE TYPE? FIX 0? * / ABS ATAN FLOAT =?
]>)> 

<SETG RPRT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8666> RPRT #DECL ("VALUE" 
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX * FLOAT COS ELSE]>)> 

<SETG IMRT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8751> IMRT #DECL ("VALUE" 
FORM "QUOTE" ANY "QUOTE" ANY) COND TYPE? FIX * FLOAT SIN ELSE]>)> 

\ 

<SETG UVFIX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8836> UVFIX #DECL ("VALUE" 
FORM "QUOTE" ANY) COND ==? UTYPE FIX ELSE MAPR #FALSE () FUNCTION E #DECL ((E) <
PRIMTYPE UVECTOR>) PUT LVAL + CHTYPE FLOAT CHUTYPE]>)> 

<SETG UVFLOAT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 8971> UVFLOAT #DECL (
"VALUE" FORM "QUOTE" ANY) COND ==? UTYPE FLOAT ELSE MAPR #FALSE () FUNCTION E #
DECL ((E) <PRIMTYPE UVECTOR>) PUT LVAL CHTYPE FIX CHUTYPE]>)> 

<SETG VFLOAT #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9097> VFLOAT #DECL (
"VALUE" FORM "QUOTE" ANY) MAPR #FALSE () FUNCTION E #DECL ((E) <PRIMTYPE VECTOR>
) PUT LVAL FLOAT]>)> 

<SETG VFIX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9171> VFIX #DECL ("VALUE" 
FORM "QUOTE" ANY) MAPR #FALSE () FUNCTION E #DECL ((E) <PRIMTYPE VECTOR>) PUT 
LVAL FIX +]>)> 

\ 

<SETG FIXIFY #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9254> FIXIFY #DECL (
"VALUE" FORM "QUOTE" ANY) FIX +]>)> 

\ 

<SETG XY %<RSUBR-ENTRY '[RUCPX XY #DECL ("VALUE" <OR CPX UCPX> ANY)] 6475>> 

\ 

<SETG RT %<RSUBR-ENTRY '[RUCPX RT #DECL ("VALUE" <OR CPX FALSE UCPX> ANY)] 6979>
> 

<AND <ASSIGNED? GLUE> .GLUE <PUT ,RUCPX GLUE ![4378918912 1078444032 4580179972 
18254660612 17467113472 34293678092 4276288 1053168 4472832 286262273 285493184 
33489920 805307393 -12817572364 67108928 54526996 1075134465 4571127568 
335544580 5594581 -268420096 21474849796 14033437760 272629760 1073741951 
-4294967244 1128559940 17180934144 4194304 34342961173 20401095517 1574269965 
8334082368 1048580 17269001503 3221307392 268436544 22850503620 5243969 
-12666522553 22619881729 1024 33488909 1128559940 17180921856 4194305 -267452416
21480079360 357945567 1132208112 4026531841 17200845825 17197699089 1073759248 
67388416 71319552 67112960 17891328 4564451328 4295229440 1073742081 4295229440 
4312798549 22825385984 0 17105152 22817031233 -10875568048 4259841 22942154688 
462848 1073749056 17826048 67109136 4456448 4456452 0 133955584 1851392 
4294996224 71304192 268436544 17825792 17825808 0 535822396 17180196864 
13963052149 18320724032 16384 134152192 54543172 31478513680 17179869248 524032 
22331392 902847957 31152271552 335544336 4457808 3522215937 17179873280 
1141199359 1010827344 1142754564 14033437760 269484032 1073742335 13648708 
31478513680 4294967360 2093071 327760 5461 -12651052164 8573218816 1311040 
5370020112 4312809472 18270389252 18253612096 17179870208 4294967569 69648 65540
16384 269549572 65808 5726621823 -17179869184 261 268783616 18322651076 83886145
1398645 34292633344 5368712449 3508359440 16640 17448304896 127 -4294967244 
1128559936 22549693504 17424 1024 4563402753 127 -4294961844 220421 -9303749345 
3221307392 268436544 22817873676 20971521 278613 8573404160 1342456272 
-12814366892 18253611024 17196908545 7 -1073528563 4786754816 18271436800 
285474816 16778304 16384 33489136 5244160 87389 3741595585 -267452416 20976641 
17200845057 285474820 17448321092 17179869188 17448322064 262145 16777216 
1095761988 17465147408 263233 256 1141112896 1052672 17179869200 263232 
268435520 18259203412 8573157376 0 68420609 22548648199 25217204544 17039365 
23049142016 13976277461 4563402756 4299227136 17179869185 -268382141 18376557888
4567859200 71368704 4194576 4096 8372284 17180196864 13963052149 18320719873 
1074806784 1073741824 536608768 218172689 -11541348284 4563402753 4362076160 
4295245824 4194304 536608768 22867345421 31163110864 14088863749 16384 
4564795444 33336329472 4194321 357039119 4295049233 1949569233 7869628416 
68158480 4194304 33488909 1128559936 22549693504 17424 1024 4563402753 2044 
1006633280 5368709125 22938876944 -8849997764 1280 21480080640 18257822736 
17842177 286261248 17842177 4362076176 4195328 66880 286278660 67108880 
4567597056 1073811472 268435520 17180917760 67108880 4563419136 269549909 
22901423104 0 4176 4300537860 18284510272 1342178320 22378327 -1072888780 
19147276288 17039620 1048576 8372227 17462009168 5637423376 4356 256 1140850688 
17179869695 252706836 13635793 7868600324 17465081856 4567597056 268452864 
262144 33538079 -4223332144 4514239761 1040 1090519056 7 -268156096 18056959044 
4160 4362076224 31 -1073724364 1128559940 17179869444 272629764 1 -67108864 
3408948 19147276288 17039620 262144 131008 5570560 13110613877 24967937072 
83886084 1114452 880553984 21474837504 285299839 -16927162348 285688641 
3508359440 16640 17448305664 8176 218379335 22554083600 18253611012 17448304640 
17180983296 16777216 34292875264 5370019840 1142178885 4294967296 1431782268 
4528832448 16106127365 83906565 71319620 4295036992 269553664 69696 285474816 
4294983684 261 17180987460 1074003968 4312809472 4194576 4296015872 17246982144 
1041 268715077 4296015872 1140854784 67387477 22905224960 0 16 285688700 
17185112068 4295054352 -8841587712 272629845 201618752 3143 22548578307 
15028197187 17400007680 5368709376 71324928 -12364021740 65536 18259181837 
880553984 21474837504 285299715 19263389776 262145 4317310976 1342504960 1168640
4194321 -11542724544 5724233712 8573157632 16 285688700 17185112068 4295054352 
-8841587712 272629845 201618752 197952 4786749696 21474839607 -1072202483 
880553984 21474837504 285299716 -12785267712 5368709376 71324932 4513286083 
5242880 17179938837 17234903808 1342177344 17831247 327760 285 21474902016 
5637436736 1075052549 22753558769 0 4294967295 262374 268623 269127!]>> 

\ 

<SETG FX #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9284> FX #DECL ("VALUE" FORM 
"QUOTE" ANY) COND TYPE? CPX VFIX REST UCPX UVFIX ELSE ERROR UNKNOWN-COMPLEX-TYPE
 FX]>)> 

<SETG FL #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9395> FL #DECL ("VALUE" FORM 
"QUOTE" ANY) COND TYPE? CPX VFLOAT REST UCPX UVFLOAT ELSE ERROR 
UNKNOWN-COMPLEX-TYPE FL]>)> 

<SETG ** #MACRO ( %<RSUBR!- '[ %<PCODE!- "COMPLX" 9506> ** #DECL ("VALUE" FORM 
"QUOTE" ANY "QUOTE" ANY) COND 0? 1? ELSE EXP * LOG]>)> 

<ENDPACKAGE>