├── .DS_Store ├── FORTH sources ├── gllram.forth ├── gllram.short └── gllrom.forth ├── Patches ├── delivered ├── development └── test results ├── README ├── asm1802 ├── dictionary ├── forthcomp.lisp ├── lisp->forth ├── parcil 0.1a ├── ram image ├── ram source.lisp ├── rom image ├── sim1802 └── startup /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rongarret/gll-mag-patch/6809b466f81db55ec53fe3e1a4f97e6389909d40/.DS_Store -------------------------------------------------------------------------------- /FORTH sources/gllram.short: -------------------------------------------------------------------------------- 1 | CODE XFER 0C0 RC, RCA ( Linkage to initialization) HERE FCONSTANT VECTOR 00 R, ( VECTOR contains the address where the link to initialization is to be stored) 4D50 FCONSTANT SDATA-PTR (Address for interrupt ADC data) 0 RC, 4000 R, ( SPIN DELTA CORRECTION FACTOR) HERE 20 + H ! ( Reserve area for command table) ROM-CODE 2 CONSTANT 2 3 CONSTANT 3 ( HIDES FIG-FORTH DEFINITIONS) 4EE5 CONSTANT INT-CNT 4EE4 CONSTANT M91 7FFF CONSTANT 1.0 ( Define new user variables which will show up in SUBCOM) 66 USER DSP-AVER-CONSTANT 68 USER AVER# 8A USER ROM-CKSUM 8C USER RAM-CKSUM 4CC4 CONSTANT CUR-STOR 6 CONSTANT 6 ( 6 is used often, this saves storage) 9C USER ADDR-BUFFER ( user variable for data buffer) DECIMAL --> ( Continue on next screen) Screen 124 contains the source for implementing the SNAPSHOT, and Status Voltage Filters. The SNAPSHOT code consists of two words SNPST and SNAP. SNAP checks for an ON command then stores the current time in 4CF0 and enables the snapshot operation via SNPST. SNPST expects the start address and the current mag data address ( VDATA ) on the stack. Two status voltage filters are provided which both filter and scale the status voltages. The FI.. word filters one of the subcom data and the SF.. words provides the parameters to filter the complete set of data. SCREEN # 124 ( SNAPSHOT AND STATUS VOLTAGE FILTERS ) HEX CODE SNPST S SEX S LDA 8 PHI S LDA 8 PLO S LDA 7 PHI S LDA 7 PLO NEXT : SNAP 55 = IF 4EE0 4CF0 6 MOVE ( IF COMMAND = 55 STORE TIME) 4CEB VDATA @ SNPST THEN ; ( AND START SNAPSHOT) ( STATUS VOLTAGE FILTERS) ( 20 VOLT FILTER) : FI20 RD5 + @ OVER @ 28ED S* - SWAP +! ; ( FILTER 20V VALUES) : SF20 VRAM 1A FI20 V12 10 FI20 V10 12 FI20 V-12 14 FI20 ; ( 5 VOLT SUBCOM VALUE FILTER ROUTINE) : FI5 RD5 + @ OVER @ 2000 S* - SWAP +! ; ( FILTER 5V VALUES) : SF5 GND 1E FI5 1-SPARE 16 FI5 2-SPARE 1C FI5 T-ELEC 18 FI5 ; Screen 125 contains some of the power on initialization codes. TTEXEC checks the current Mag, Gain status and sends the appropriate commands to reset the MAG to its last operating state. Initial power on state is set to INB ON, LOW GAIN. SCREEN # 125 ( MAGNETOMETER POWER ON INITIALIZATION) HEX ( TTEXEC EXPECTS SCALE/GAIN FACTOR, HIGAIN CMND # ON STACK) : TTEXEC OVER 0F AND 05 = IF 93 ELSE 6C THEN OVER EXCMND SWAP F0 AND 50 = IF 55 SWAP 2+ EXCMND ELSE DROP THEN ; : PINIT SGOUT C@ 04 TTEXEC SGINB C@ 03 TTEXEC ; DECIMAL --> ( Continue on next screen) Screen 126 contains the source for the block store, DSPIN store, and OPTIMAL AVERAGE storage routines. The Block store routine will store a given value in successive memory locations and is useful for initialization procedures. The DSPIN storage stores the time, angle, and despun data in the USER area defined for the SUBCOM. The OPTIMAL AVERAGE STORE routine stores the optimal average data when activated. This routine uses AVER# as a mask to determine when to store data. AVER# should be set to 0, 1, 3, 7, etc. to get one value every 1, 2, 4, 8, etc MOD91 counts. SCREEN # 126 ( BLOCK STORE, DSPIN STORE) HEX ( BLOCK STORE VAL ADDR #BYTES B! ) : B! 2* OVER + SWAP DO DUP I ! 2 +LOOP DROP ; ( DSPIN STORAGE ) : TS! 4EE1 OVER 4 MOVE 2+ 2+ 4EF4 @ OVER ! 2+ 4EF2 @ OVER ! 2+ V! ; ( OPTIMAL AVERAGER STORAGE) HEX : OPT-START 4800 CUR-STOR DUP @ 4800 4 MOVE ! 4CF0 TS! ; : OPTST DATA-BUFFER-STATUS C@ 55 = IF 4EE2 @ AVER# @ AND 0= IF CUR-STOR @ DUP 6 + DUP CUR-STOR ! 0 OVER 6 B! 6 MOVE CUR-STOR @ 4CAF > IF AA DATA-BUFFER-STATUS C! THEN THEN THEN ; SCREEN # 127 ( SUBCOM CKSUM, MAT-LOAD ROUTINES ) HEX 82 USER CKSUM-PTR : CKSUM-GEN 80 CKSUM-PTR +! CKSUM-PTR @ DUP 1000 > IF DROP 0 CKSUM-PTR 4 B! ELSE 80 CKSUM CKSUM-PTR 2+ V! THEN ; : MAT-LOAD 4E80 @ A5A5 = IF 4EA6 @ A5A5 = IF 4E82 @ SCF ! 4E84 DSP-AVER-CONSTANT 4 MOVE 4E88 1GAIN 1E MOVE 0 4E80 ! 0 4EA6 ! THEN THEN ; : CKDANGLE SP-DELTA @ 4006 @ S* SP-DELTA ! CKDANGLE ; DECIMAL --> ( Continue on next screen) Screen 128 contains the source for storage of the SUBCOM values during the MOD91 sequence. SCREEN # 128 ( FLIGHT EXECUTIVE SUBCOM ) HEX ( TIME/SECTOR STORAGE ADDRESS ON STACK ) : SDSPIN DUP 15 = IF 1ST-DSPVECTOR TS! THEN DUP 28 = IF ADDR-BUFFER DUP @ 20 + DUP 4CF8 > IF DROP 4800 THEN DUP ROT 2+ 20 MOVE ADDR-BUFFER ! THEN DUP 34 = IF CKSUM-GEN THEN DUP 42 = IF 2ND-DSPVECTOR TS! THEN DUP 5A = IF OPTST MAT-LOAD 4FF0 C@ 20 - 2/ CMDPTR +! THEN ; ( STORE SUBCOM IN S/C BUFFER) : SETSUB M91 C@ DUP 5B = IF DROP 7500 C@ HD-PARITY C! PFLIP C@ 1 > IF PFLIP C@ 1 - PFLIP C! ELSE FLIPPER POWER OFF 0 PFLIP C! THEN CKCOMM CKDANGLE SGOUT ELSE SDSPIN 2* SGOUT + THEN @ BUFFER-ADDRESS ! ; Screen 129 contains the default parameter reset and memory initialization routines. The word PARESET sets the gains to 1.0, offsets to 0 and the rotation matrix to the unity matrix. ?MEMORY checks memory to see if it has been previously initialized. If the memory has not been initialized, then default values are set where needed. SCREEN # 129 ( MATRIX RESET ZERO-USER) HEX : PARESET 4000 1GAIN 3 B! 0 OF1 3 B! RM1 0 OVER 9 B! 1.0 OVER ! 8 + 1.0 OVER ! 8 + 1.0 SWAP ! ; : MAT-RESET 0 SGOUT 5A B! ( ZERO SUBCOM) PARESET 4800 ADDR-BUFFER ! ; : ?MEMORY DEFAULT-SYS @ [' DROP 2+ = NOT IF MAT-RESET 8 FLTIM C! 0 AVER# ! 800 DSP-AVER-CONSTANT ! 1 SCF ! AA5A SGOUT ! AA PFLIP ! THEN ; The words defined in screen 130 perform the rotation, scaling and offset correction of the magnetometer data. In addition two recursive filters are defined which are used to filter the Despun Subcom parameters and vectors. SCREEN # 130 ( DATA ROTATION, SCALING AND OFFSET CORRECTION ) ( EXPECTS ##, SCF ON STACK WHERE SCF=-2TO1.999 ) : SCALE H32 OVER OVER E+ OVER OVER E+ SWAP DROP ; : SC/RT 3GAIN @ SCALE SWAP 2GAIN @ SCALE ROT 1GAIN @ SCALE ; : OR! V! ; ( GENERAL FILTER DIN, CONST, ADDR) : FILT MINUS I @ H32 E+ DUP 0= + R> +! DROP ; ( 0= + INSURES NON ZERO VALUES) ( AOUT = AOUT - CON*AOUT + CONST * DIN ) ( FAST FILT FOR STATE VECTOR TAKES SHORTEST ROUTE TO ANSWER) 0 RC, ( ALIGN FOR BAD MEMORY LOCATION 4494 BIT 0=1 : FILTF +! DROP ; DECIMAL --> ( Continue on next screen) Screen 131 contains the routines to generate the state vector information and the DSPIN data. SCREEN # 131 ( COMBINED STATE-VECTOR,DSPIN ROUTINES) HEX : FIL256 DSP-AVER-CONSTANT @ SWAP FILT ; ( DATA, ADDR ==> 0) : FIL! DSP-AVER-CONSTANT @ SWAP FILTF ; : AV-VEC INT-CNT C@ 1C < IF IBSV V@ OBSV FIL! OBSV 6 + FIL! OBSV 0C + FIL! THEN ; ( CMPCAL CALC AND FILTERS DATA*SIN AND DATA * COS ) : CMPCAL 2+ FIL! ; : STATE-V V1 V@ OBSV 2+ CMPCAL OBSV 8 + CMPCAL OBSV 0E + CMPCAL ; ( Z YDSP XDSP ON STACK) DECIMAL --> ( Continue on next screen) Screen 132 contains the routines for despinning all the data for the spacecraft. If full DSPIN is selected, then the state-vector information is not calculated due to time restrictions. SCREEN # 132 ( FULL DESPINNING ROUTINES ) HEX : DSPN S-CPROD SWAP - ; ( DSP VECTOR 2 FOR SUBCOM USE AND FULL DSPIN) : 2DSP V2 V@ S2PHI @ C2PHI @ DSPN ; : FLTDSPV CUR-STOR @ Z FIL256 ; : DSP12 2DSP DSP-STAT C@ 55 = IF V2 V! V1 V@ S1PHI @ C1PHI @ DSPN V1 V! V2 V@ ELSE STATE-V THEN FLTDSPV ; : DSP3 DSP-STAT C@ 55 = IF V3 V@ S3PHI @ C3PHI @ DSPN V3 V! THEN ; Screen 133 contains special WAIT routines which provide information in locations 4E60-4E68 about the timeing of the routines. WAIT is used to wait for a set number of interrupts, and 9WAIT waits until the S/C MOD10 time word = 9. The MOD10 time word counts from 9 to 29 in the magnetometer. SCREEN # 133 ( TEST WAIT ROUTINES ) HEX : WAIT BEGIN RD4 0< END ; : 9WAIT BEGIN INT-CNT C@ 9 = END 1 M91 C@ + M91 C! ; DECIMAL --> ( Continue on next screen) Screen 134 contains the MAIN executive routine which performs the following tasks: A. Initializes the command table B. Checks and initializes memory if necessary C. Sets up transfer vectors for IDLE, SNAPSHOT, and OPTIMAL-AVER routines D. Performs a checksum on ROM and EXEC-RAM (4000-46FF) E. Initializes the magnetometers ( PINIT) F. Waits for time sychronization ( 9WAIT) G. Starts an endless loop which samples rotates, and scales the data, calculates the SUBCOM values, DSPINS the data and maintains time sychronization. The timing for these routines has been carefully checked and fully utilizes the time available. Changes in these routines must be carefully checked for timing as well as proper functional operation to insure that data is not lost. SCREEN # 134 ( MODIFIED DEFAULT SYSTEM USE) HEX : MAIN LCMNDS ?MEMORY [' CKIDLE 2+ CPU-CTRL ! [' DROP 2+ DEFAULT-SYS ! [' SNAP 2+ SNAPSHOT ! [' OPT-START 2+ OPTIMAL-AVER ! 20 4FF0 C! 0 4E40 ! 0 4E20 ! ENABLE-INT 20 4FF0 C! 0 FFF CKSUM ROM-CKSUM ! 4000 6FF CKSUM RAM-CKSUM ! 0 CMDPTR ! 4CB0 CUR-STOR ! PINIT 9WAIT BEGIN INT-CNT C@ 13 > IF 9WAIT 6 SE4 V1 OR! SF20 SF5 TRGFNS V1 V@ IBSV V! WAIT 6 SE4 V2 OR! DSP12 WAIT V3 OR! DSP3 ELSE 0 V1 9 B! THEN SETSUB AV-VEC 0 END ; Screen 135 contains the 1802 register initialization code and the initial FORTH startup of the MAIN routine. SCREEN # 135 ( FINAL INITIALIZATION CODE ) HEX CODE INIT 0C # LD 01 PHI 79 # LD 01 PLO SDATA-PTR 100 / # LD 5 PHI SDATA-PTR # LD 5 PLO 4E # LD 06 PHI 00 # LD 06 PLO 7 PHI 8 PHI 8 PLO U PLO F PHI 47 # LD U PHI 4D # LD R PHI S PHI F0 # LD R PLO 40 # LD S PLO 'NEXT # LD F PLO 7 PLO ' MAIN RCA DUP 100 / ASSEMBLER # LD I PHI # LD I PLO NEXT RCA LAST @ 2+ VECTOR R! FORTH DECIMAL ;S MAGNETOMETER VOCABULARY MAGFLT3 MARCH 29, 1984 NAME LINK ADDR (SCREEN) COMMENTS APPLE RCA INIT 46C4 (135) Initialization code MAIN 45F7 (134) RAM Exeutive main 9WAIT 45DB (133) Wait for MOD10 = 9 WAIT 45D0 (133) Wait until reg 4 < 0 DSP3 45AE (132) DSPIN Vector 3 DSP12 457B (132) DSPIN Vectors 1,2 FLTDSPV 4561 (132) Average the Despun Vector 2DSP 454F (132) DSPIN vector 2 DSPN 453F (132) Calculate DESPUN vector STATE-V 451F (131) Calculate State Vector Info CMPCAL 4501 (131) Calc. D*SIN D*COS, Filter AV-VEC 44D8 (131) Calc. State Vector Aver. FIL! 44CC (131) Single Prec. Filter, Store FIL256 44C0 (131) Double Prec. Filter, Store FILTF 44A4 (130) Single Prec. fast filter FILT 4480 (130) Double Prec. filter OR! 445E (130) Offset,Rotate, Scale Data SC/RT 4444 (130) Scale Data, Rotate vector SCALE 442E (130) Scale data (-2. to 1.999) ?MEMORY 43ED (129) Check MEMORY for reset? MAT-RESET 43D6 (129) Set rotation matrix to unity PARESET 4399 (129) Set Offsets, Gains to 0, 1.0 SETSUB 433E (128) Store Subcom in USER array SDSPIN 42BE (128) Store DSPIN, CKSUM, MATLOD CKDANGLE 42A8 (127) Check, Scale Delta-angle MAT-LOAD 4256 (127) Load from DML area CKSUM-GEN 420E (127) 128 word CKSUMS for RAM,ROM CKSUM-PTR 420B (127) Pointer for RAM CKSUM OPTST 41BA (126) Check,start OPTIMAL AVERAGE OPT-START 419C (126) INITIATE OPTIMAL AVERAGE TS! 4165 (126) Store Time, Sector, DSPIN V B! 414A (126) Block Storage PINIT 4134 (125) POR initialization TTEXEC 40F7 (125) Mag Command Exec on POR SF5 40D7 (124) SUBCOM FILTER 5 VOLTS FI5 40BD (124) Five Volt Recursive Filter SF20 409D (124) SUBCOM FILTER 20 VOLTS FI20 4083 (124) Twenty Volt Recursive Filter SNAP 4061 (124) Start SNAPSHOT if commanded SNPST 4055 (124) Start SNAPSHOT running ADDR-BUFFER 4052 (123) Data Buffer Address Pointer 6 404E (123) Constant " 6 " CUR-STOR 404A (123) DSPIN pointer RAM-CKSUM 4047 (123) SUBCOM pointer for RAM CKSUM ROM-CKSUM 4044 (123) SUBCOM pointer for ROM CKSUM AVER# 4041 (123) SUBCOM pointer for AVER # DSP-AVER-CONSTANT 403E (123) SUBCOM pointer for DSP AVR K 1.0 403A (123) Constant " 1.0 " M91 4036 (123) Position of MOD91 in time INT-CNT 4032 (123) Position of Int-counter 3 402E (123) Constant " 3 " 2 402A (123) Constant " 2 " SDATA-PTR B2C1 (123) APPLE FORTH CONSTANT ADC VECTOR 5389 (123) APPLE FORTH CONSTANT XFER XFER 4002 (123) XFER TO INITIALIZATION MAIN F8D (384) ROM MAIN ROUTINE DFS F5B (383) DFSYS EF6 (382) WAIT EE7 (382) CKCOMM EA6 (382) DATA-STORE E91 ( ENABLE-INT E8B (382) ZERO-USER E75 (382) SE4 E6D (382) RD4 E64 (382) 2E/ E4B (380) 2/ E3C (380) 3DSP E26 (377) 2DSP E10 (377) 1DSP DFA (377) V3 DEF (377) V2 DE4 (377) V1 DDC (377) DROT DC8 (377) TRGFNS DC0 (376) TRFN D90 (376) TRG-2 D74 (376) CKDANGLE D48 (376) C3PHI D45 (376) S3PHI D42 (376) C2PHI D3F (376) S2PHI D3C (376) C1PHI D39 (376) S1PHI D36 (376) DCOS D33 (376) DSIN D30 (376) DANGLE D2D (376) ANG-CONV D29 (376) ANGLE D25 (376) SP-DELTA D21 (376) CKIDLE D13 (370) IDL CFB (370) IDLE CC8 (370) INTERRUPT-CODE C5F (369) FILTER C33 (367) A/4 C07 (366) XFER3 C02 (251) SNAP-SHOT BDB (365) ?COMND BAA (364) T/S-UPDATE B69 (363) SAMPLE B3E (362) EXCMND B2B (345) LCMNDS AF9 (345) COMMNDS AF5 (345) COMMND-TAB AD3 (345) CMF AC9 (344) CME ABF (344) CMD AB7 (344) CMC AAF (344) CMB AA7 (344) CMA A9F (344) CM9 A8F (344) CM8 A7D (344) CM7 A73 (344) CM6 A5A (344) CM5 A41 (344) CM4 A33 (344) CM3 A25 (344) CM2 A1B (344) CM1 A0F (344) CM0 A05 (344) RD5 9FC (343) SF0 9E2 (343) S0F 9C8 (343) VDATA 9C5 (343) SNAPSHOT 9C2 (343) OPTIMAL-AVER 9BF (343) DEFAULT-SYS 9BC (343) CPU-CTRL 9B9 (343) FLIPC 97B (342) CFST 94F (342) FLP 920 (342) HI/LOW 8F0 (342) ON/OFF 8C0 (342) ERROR 8AC (342) SICOS 859 (333) S-CPROD 833 (333) SICOS-DELTA 807 (333) XFER2 53CB (251) XFER VECTOR FOR POR TRIGE 7F6 (330) TRIG 772 (330) VROT 746 (325) VDOT 6FE (325) V+ 6C4 (325) V- 68A (325) V! 672 (325) V@ 65A (325) Z 652 (325) Y 64C (325) X 648 (325) BUFFER-ADDRESS 632 (324) S* 622 (323) H32 5BB (322) H* 5A6 (321) MEM-PROTECT 59C (316) RIGHT 58F (313) LEFT 587 (313) FLIP 583 (313) FLIPPER 57F (313) CALIBRATE 57B (313) HIGAIN 571 (313) POWER 567 (313) INB 563 (313) OUT 55F (313) OFF 554 (313) ON 549 (313) ALL-OFF 531 (313) HAMP 4F5 (309) PG 4ED (309) PC 4DF (309) CORRECT 4CE (308) IR-RECOV 4C3 (308) PARITY 4AD (308) EOR 4A4 (308) CTAB 49A (308) CKSUM 476 (302) CMDPTR 473 (298) DATA-BUFFER 470 (298) 2ND-DSPVECTOR 46D (298) OBSV 46A (298) IBSV 467 (298) SF-PARITY 464 (298) HD-PARITY 461 (298) 2-SPARE 45E (298) 1-SPARE 45B (298) T-ELEC 458 (298) GND 455 (298) VREF 452 (298) V-12 44F (298) V10 44C (298) V12 449 (298) VRAM 446 (298) DATA-BUFFER-STATUS 443 (298) S/C-CAL 440 (298) 1ST-DSPVECTOR 43D (298) DSP-STAT 43A (298) RM1 437 (298) OF3 434 (298) OF2 431 (298) OF1 42E (298) 3GAIN 42B (298) 2GAIN 428 (298) 1GAIN 425 (298) PCAL 422 (298) PFLIP 41F (298) LINBFL 41C (298) LOUTFL 419 (298) CINBFL 416 (298) COUTF 413 (298) SGINB 410 (298) SGOUT 40D (298) SCF 40A (298) FLTIM 407 (298) XFER1 402 (251) S* 3CF (255) M32 3A3 (255) ABSE 39C (254) MINE 389 (254) E@ 379 (254) E! 369 (254) EXT 355 (254) E+ 33C (254) DZ 338 (254) / 32E (253) * 324 (253) MOD 31C (253) /MOD 30E (253) */ 304 (253) */MOD 2F6 (253) M/MOD 2DA (253) M* 2BE (253) ROT 2B2 (253) MIN 2A1 (253) MAX 290 (253) CZ 28A (252) -DUP 27F (252) 2* 277 (252) ABS 270 (252) MINUS 265 (252) 2+ 25F (252) 1+ 253 (252) NOT 24D (252) = 245 (252) 1 241 (252) > 239 (252) < 231 (252) 0 22D (252) J 21A ( 29) LEAVE 20D ( 29) MEMORY-SWITCH 1FF (314) I 1F3 ( 52) R> 1E8 ( 52) ' 2783 (110) " " " " 'USER' 2787 (110) " " " " 'CONSTANT' 2786 (110) " " " " 'VARIABLE' 278A (110) " " " " C! 98 ( 51) C@ 8C ( 51) END 20A0 (109) PART OF CROSSCOMPILER BEGIN 650C (109) " " " " THEN 650C (109) " " " " WHILE 6622 (109) " " " " ELSE 82FB (109) " " " " IF 82FB (109) " " " " +LOOP 20A0 (109) " " " " LOOP 20A0 (109) " " " " DO 82FB (109) " " " " WHILE 89 ( 51) ELSE 86 ( 51) END 7B ( 51) IF 78 ( 51) LOOP 4B ( 51) +LOOP 48 ( 51) DO 35 ( 51) LIT 2C ( 51) ['] 21 ( 51) EXECUTE 14 ( 51) 'NEXT 45C7 (110) PART OF CROSSCOMPILER ZERO 2785 (110) APPLE CONSTANT 4000 40 2 C0 46 C4 0 40 0 4008 4 2 4 2 4 2 4 2 4010 4 2 4 2 4 2 4 2 4018 4 2 4 2 4 2 4 2 4020 4 2 4 2 4 2 4 2 4028 0 A7 0 2 0 A7 0 3 4030 0 A7 4E E5 0 A7 4E E4 4038 0 A7 7F FF 0 B0 66 0 4040 B0 68 0 B0 8A 0 B0 8C 4048 0 A7 4C C4 0 A7 0 6 4050 0 B0 9C 40 55 EE 4E B8 4058 4E A8 4E B7 4E A7 DF 0 4060 CA 0 2A 55 2 43 0 76 4068 17 0 1F 4E E0 0 1F 4C 4070 F0 40 4C 1 3 0 1F 4C 4078 EB 9 C3 1 95 40 53 0 4080 D5 0 CA 9 FA 0 E9 1 4088 95 1 85 1 95 0 1F 28 4090 ED 6 20 0 F6 1 71 1 4098 AF 0 D5 0 CA 4 44 0 40A0 2A 1A 40 81 4 47 0 2A 40A8 10 40 81 4 4A 0 2A 12 40B0 40 81 4 4D 0 2A 14 40 40B8 81 0 D5 0 CA 9 FA 0 40C0 E9 1 95 1 85 1 95 0 40C8 1F 20 0 6 20 0 F6 1 40D0 71 1 AF 0 D5 0 CA 4 40D8 53 0 2A 1E 40 BB 4 59 40E0 0 2A 16 40 BB 4 5C 0 40E8 2A 1C 40 BB 4 56 0 2A 40F0 18 40 BB 0 D5 0 CA 1 40F8 85 0 2A F 0 DC 0 2A 4100 5 2 43 0 76 7 0 2A 4108 93 0 84 4 0 2A 6C 1 4110 85 B 29 1 71 0 2A F0 4118 0 DC 0 2A 50 2 43 0 4120 76 D 0 2A 55 1 71 2 4128 5D B 29 0 84 3 1 6C 4130 0 D5 0 CA 4 B 0 8A 4138 0 2A 4 40 F5 4 E 0 4140 8A 0 2A 3 40 F5 0 D5 4148 0 CA 2 75 1 85 0 E9 4150 1 71 0 33 1 60 1 F1 4158 1 A3 40 28 0 46 F6 1 4160 6C 0 D5 0 CA 0 1F 4E 4168 E1 1 85 0 2A 4 1 3 4170 2 5D 2 5D 0 1F 4E F4 4178 1 95 1 85 1 A3 2 5D 4180 0 1F 4E F2 1 95 1 85 4188 1 A3 2 5D 1 DB 40 48 4190 1 95 6 58 1 E6 6 70 4198 0 D5 0 CA 0 1F 48 0 41A0 40 48 1 60 1 95 0 1F 41A8 48 0 40 4C 1 3 1 A3 41B0 0 1F 4C F0 41 63 0 D5 41B8 0 CA 4 41 0 8A 0 2A 41C0 55 2 43 0 76 42 0 1F 41C8 4E E2 1 95 40 3F 1 95 41D0 0 DC 1 C0 0 76 31 40 41D8 48 1 95 1 60 40 4C 0 41E0 E9 1 60 40 48 1 A3 2 41E8 2B 1 85 40 4C 41 48 40 41F0 4C 1 3 40 48 1 95 0 41F8 1F 4C AF 2 37 0 76 8 4200 0 2A AA 4 41 0 96 0 4208 D5 0 B0 82 0 CA 0 2A 4210 80 42 9 1 AF 42 9 1 4218 95 1 60 0 1F 10 0 2 4220 37 0 76 F 1 6C 2 2B 4228 42 9 0 2A 4 41 48 0 4230 84 21 1 DB 1 F1 0 1F 4238 40 0 0 E9 1 60 0 2A 4240 80 4 74 1 71 1 E6 0 4248 2A 80 4 74 42 9 2 5D 4250 6 70 0 D5 0 CA 0 1F 4258 4E 80 1 95 0 1F A5 A5 4260 2 43 0 76 40 0 1F 4E 4268 A6 1 95 0 1F A5 A5 2 4270 43 0 76 31 0 1F 4E 82 4278 1 95 4 8 1 A3 0 1F 4280 4E 84 40 3C 0 2A 4 1 4288 3 0 1F 4E 88 4 23 0 4290 2A 1E 1 3 2 2B 0 1F 4298 4E 80 1 A3 2 2B 0 1F 42A0 4E A6 1 A3 0 D5 0 CA 42A8 D 1F 1 95 0 1F 40 6 42B0 1 95 6 20 D 1F 1 A3 42B8 D 46 0 D5 0 CA 1 60 42C0 0 2A 15 2 43 0 76 5 42C8 4 3B 41 63 1 60 0 2A 42D0 28 2 43 0 76 2C 40 50 42D8 1 60 1 95 0 2A 20 0 42E0 E9 1 60 0 1F 4C F8 2 42E8 37 0 76 7 1 6C 0 1F 42F0 48 0 1 60 2 B0 2 5D 42F8 0 2A 20 1 3 40 50 1 4300 A3 1 60 0 2A 34 2 43 4308 0 76 3 42 C 1 60 0 4310 2A 42 2 43 0 76 5 4 4318 6B 41 63 1 60 0 2A 5A 4320 2 43 0 76 16 41 B8 42 4328 54 0 1F 4F F0 0 8A 0 4330 2A 20 0 F6 E 3A 4 71 4338 1 AF 0 D5 0 CA 40 34 4340 0 8A 1 60 0 2A 5B 2 4348 43 0 76 3C 1 6C 0 1F 4350 75 0 0 8A 4 5F 0 96 4358 4 1D 0 8A 2 3F 2 37 4360 0 76 10 4 1D 0 8A 2 4368 3F 0 F6 4 1D 0 96 0 4370 84 D 5 7D 5 65 5 52 4378 2 2B 4 1D 0 96 E A4 4380 42 A6 4 B 0 84 9 42 4388 BC 2 75 4 B 0 E9 1 4390 95 6 30 1 A3 0 D5 0 4398 CA 0 1F 40 0 4 23 40 43A0 2C 41 48 2 2B 4 2C 40 43A8 2C 41 48 4 35 2 2B 1 43B0 85 0 2A 9 41 48 40 38 43B8 1 85 1 A3 0 2A 8 0 43C0 E9 40 38 1 85 1 A3 0 43C8 2A 8 0 E9 40 38 1 71 43D0 1 A3 0 D5 0 CA 2 2B 43D8 4 B 0 2A 5A 41 48 43 43E0 97 0 1F 48 0 40 50 1 43E8 A3 0 D5 0 CA 9 BA 1 43F0 95 0 1F 1 6C 2 5D 2 43F8 43 2 4B 0 76 2D 43 D4 4400 0 2A 8 4 5 0 96 2 4408 2B 40 3F 1 A3 0 1F 8 4410 0 40 3C 1 A3 2 3F 4 4418 8 1 A3 0 1F AA 5A 4 4420 B 1 A3 0 2A AA 4 1D 4428 1 A3 0 D5 0 CA 5 B9 4430 1 85 1 85 3 3A 1 85 4438 1 85 3 3A 1 71 1 6C 4440 0 D5 0 CA 4 29 1 95 4448 44 2C 1 71 4 26 1 95 4450 44 2C 2 B0 4 23 1 95 4458 44 2C 0 D5 0 CA 1 DB 4460 9 C3 1 95 4 2C 6 88 4468 44 42 1 F1 6 70 4 35 4470 1 F1 7 44 1 71 2 B0 4478 1 E6 6 70 0 D5 0 CA 4480 1 DB 1 DB 1 F1 5 B9 4488 1 E6 2 63 1 F1 1 95 4490 5 B9 3 3A 1 60 1 C0 4498 0 E9 1 E6 1 AF 1 6C 44A0 0 D5 0 CA 1 DB 1 71 44A8 1 F1 1 95 0 F6 5 B9 44B0 1 60 1 C0 0 E9 1 E6 44B8 1 AF 1 6C 0 D5 0 CA 44C0 40 3C 1 95 1 71 44 7E 44C8 0 D5 0 CA 40 3C 1 95 44D0 1 71 44 A2 0 D5 0 CA 44D8 40 30 0 8A 0 2A 1C 2 44E0 2F 0 76 1A 4 65 6 58 44E8 4 68 44 CA 4 68 40 4C 44F0 0 E9 44 CA 4 68 0 2A 44F8 C 0 E9 44 CA 0 D5 0 4500 CA 1 DB 1 60 D 34 1 4508 95 6 20 1 F1 44 CA D 4510 37 1 95 6 20 1 E6 2 4518 5D 44 CA 0 D5 0 CA D 4520 DA 6 58 4 68 2 5D 44 4528 FF 4 68 0 2A 8 0 E9 4530 44 FF 4 68 0 2A E 0 4538 E9 44 FF 0 D5 0 CA 8 4540 31 1 71 0 F6 1 DB 0 4548 E9 1 E6 0 D5 0 CA D 4550 E2 6 58 D 3A 1 95 D 4558 3D 1 95 45 3D 0 D5 0 4560 CA 40 48 1 95 1 DB 1 4568 F1 44 BE 1 F1 6 4A 44 4570 BE 1 E6 6 50 44 BE 0 4578 D5 0 CA 45 4D 4 38 0 4580 8A 0 2A 55 2 43 0 76 4588 1E D E2 6 70 D DA 6 4590 58 D 34 1 95 D 37 1 4598 95 45 3D D DA 6 70 D 45A0 E2 6 58 0 84 3 45 1D 45A8 45 5F 0 D5 0 CA 4 38 45B0 0 8A 0 2A 55 2 43 0 45B8 76 13 D ED 6 58 D 40 45C0 1 95 D 43 1 95 45 3D 45C8 D ED 6 70 0 D5 0 CA 45D0 E 62 1 D0 0 79 FA 0 45D8 D5 0 CA 40 30 0 8A 0 45E0 2A 9 2 43 0 79 F5 2 45E8 3F 40 34 0 8A 0 E9 40 45F0 34 0 96 0 D5 0 CA A 45F8 F7 43 EB 0 1F D 11 2 4600 5D 9 B7 1 A3 0 1F 1 4608 6C 2 5D 9 BA 1 A3 0 4610 1F 40 5F 2 5D 9 C0 1 4618 A3 0 1F 41 9A 2 5D 9 4620 BD 1 A3 0 2A 20 0 1F 4628 4F F0 0 96 2 2B 0 1F 4630 4E 40 1 A3 2 2B 0 1F 4638 4E 20 1 A3 E 89 0 2A 4640 20 0 1F 4F F0 0 96 2 4648 2B 0 1F F FF 4 74 40 4650 42 1 A3 0 1F 40 0 0 4658 1F 6 FF 4 74 40 45 1 4660 A3 2 2B 4 71 1 A3 0 4668 1F 4C B0 40 48 1 A3 41 4670 32 45 D9 40 30 0 8A 0 4678 2A 13 2 37 0 76 30 45 4680 D9 40 4C E 6B D DA 44 4688 5C 40 9B 40 D5 D BE D 4690 DA 6 58 4 65 6 70 45 4698 CE 40 4C E 6B D E2 44 46A0 5C 45 79 45 CE D ED 44 46A8 5C 45 AC 0 84 A 2 2B 46B0 D DA 0 2A 9 41 48 43 46B8 3C 44 D6 2 2B 0 79 B4 46C0 0 D5 46 C4 F8 C B1 F8 46C8 79 A1 F8 4D B5 F8 50 A5 46D0 F8 4E B6 F8 0 A6 B7 B8 46D8 A8 AC BF F8 47 BC F8 4D 46E0 B2 BE F8 F0 A2 F8 40 AE 46E8 F8 6 AF A7 F8 45 BD F8 46F0 F7 AD DF 0 0 0 0 0 46F8 0 0 0 0 0 0 0 0 GALILEO MAGNETOMETER DICTIONARY The following dictionary of FORTH defined words is provided in the GALILEO MAGNETOMETER experiment. The operation of these words is indicated using the following abbreviation for stack operations: Stack notation: ( before --> after ) ; top of stack on right b, b1 ... 8-bit byte n, n1 ... 16-bit signed numbers d, d1 ... 32-bit signed numbers u, u1 ... 16-bit unsigned numbers ud, ud1 ... 32-bit unsigned numbers f ... Boolean flag c ... ASCII character value addr ... address Numbers are presented in hexidecimal unless otherwise indicated. This dictionary includes all words defined at this time including the core FORTH definitions, the ROM definitions and the RAM executive definitions. Those words that are associated with the Interrupt Routines are not available for use outside of the interrupt routines. Some words associated with the Despin routines provided in ROM have errors and are redefined in RAM. WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) ! 1A5 ( 52) ( n addr --> ) Stores 16-bit number into the address ;S D7 ( 51) ( --> ) End of FORTH definition, return to next word, transfer set up by ' ; ' in crosscompiler ':' 3BC2 (110) ( --> ) Crosscompiler code for : Creates new entry in vocabulary 'CONSTANT' 2786 (110) ( n --> ) Crosscompiler code creating constant 'DOES>' 2783 (110) ( --> ) Crosscompiler code creating compiling words 'NEXT 2015 (110) ( --> ) Cross compiler location for next 'USER' 2787 (110) ( n --> ) Crosscompiler word gererating USER variable 'VARIABLE' 278A (110) ( n --> ) Crosscompiler word generating variable * 324 (253) ( n n1 --> n-prod ) Unsigned multiply (software 16-bit) */ 304 (253) ( n n1 n2 --> n-result) Multiplies then divides using software (n*n1/n2). Uses 24-bit intermediate results. */MOD 2F6 (253) ( u1 u2 u3 --> u-rem u-result ) Multiplies then divides leaving rem, result uses 24 bit intermediate results + EB ( 51) (n1 n2 --> n-sum) Adds +! 1B1 ( 52) (n1 addr --> ) Adds 16 bit number n1 to contents of the address and stores the result at addr +LOOP 48 ( 51) (n1 --> ) End of loop structure, adds n1 to loop index. +LOOP 20A0 (109) Cross compiler word sets up call +LOOP - F8 ( 51) (n1 n2 --> n-diff) Subtracts -DUP 27F (252) (n1 --> n1 f) Duplicates stack if non zero with true flag leaves false flag if stack=0. / 32E (253) (u1 u2 --> u-quot) Divides (n1/n2) /MOD 30E (253) (u1 u2 --> u-rem u-quot) Divides. Returns remainder and quotient. 0 22D (252) ( --> 00 ) Constant zero 0< 1D2 ( 52) ( n --> f ) Returns true if n is negative. 0= 1C2 ( 52) ( n --> f ) Returns true if n is zero. 1 241 (252) ( --> 01 ) Constant one 1+ 253 (252) ( n --> n+1) Adds one to n. 1-SPARE 45B (298) ( --> addr) User address 1.0 403A (123) ( --> 7fff) Constant 7fff (1.0) 1DSP DFA (377) ERROR IN ROUTINE User address 1GAIN 425 (298) ( --> addr) User address 1ST-DSPVECTOR 43D (298) ( --> addr ) User address 2 402A (123) ( --> 02 ) Constant 2 2* 277 (252) ( n --> 2*n ) Multiplies n by 2. 2+ 25F (252) ( n --> n + 2 ) Adds 2 to number on stack 2-SPARE 45E (298) ( --> addr ) User address 2/ E3C (380) ( n --> n/2 ) Divides n by 2 2DSP E10 (377) ERROR IN ROUTINE Error in code do not use 2DSP 454F (132) ( --> ) Despin second vector (replacement routine) 2E/ E4B (380) Extended precision divide by 2 2GAIN 428 (298) ( --> addr) User variable 2ND-DSPVECTOR 46D (298) ( --> addr ) User variable 3 402E (123) ( --> 03 ) Constant 03 3DSP E26 (377) ERROR IN ROUTINE ERROR DO NOT USE 3GAIN 42B (298) ( --> addr ) User variable 6 404E (123) ( --> 06 ) Constant 06 9WAIT 45DB (133) ( --> ) Wait for Mod10 time = 9 ( start of frame) < 231 (252) ( n1 n2 --> f ) Leave true flag if n1 < n2 ) Pops a value off parameter stack and pushes it on the return stack = 245 (252) ( n1 n2 --> f) Leaves true flag if n1 = n2 > 239 (252) ( n1 n2 --> f) Leaves true flag if n1 > n2 ?COMND BAA (364) ?MEMORY 43ED (129) Check MEMORY for reset? @ 197 ( 51) ( addr --> n1 ) Pushes the contents of addr on the parameter stack. A/4 C07 (366) ( --> ) Interrupt routine not for general use. ABS 270 (252) ( n1 --> Abs n1 ) Absolute value of top of stack ABSE 39C (254) ( d1 --> Abs d1 ) Double precision extended precision ADDR-BUFFER 4052 (123) ( --> Buffer dump addr ) Buffer address for subcom data-buffer dump ALL-OFF 531 (313) Turns OFF all commandable hardware AND DE ( 51) ( n1 n2 --> n1 ) Logical and of n1, n2 ANG-CONV D29 (376) ( --> n ) Constant for ANGLE CONVERSION ( 7168 decimal) ANGLE D25 (376) ( --> addr ) Address for angle AV-VEC 44D8 (131) Calc. State Vector Aver. Calculates state vector AVER# 4041 (123) ( --> addr) User variable B! 414A (126) ( n1 addr nbytes --> ) Stores n1 in block addr to addr+nbytes BEGIN 650C (109) ( --> ) Cross compiler start of indefinite loop BUFFER-ADDRESS 632 (324) ( --> addr) Routine which provides current buffer address depending on S/C time. C! 98 ( 51) ( n addr --> ) Stores low order byte of n at addr C1PHI D39 (376) ( --> addr) User variable contains cos(phi) for v1 C2PHI D3F (376) ( --> addr) User variable contains cos(phi) for v2 C3PHI D45 (376) ( --> addr) User variable contains cos(phi) for v3 C@ 8C ( 51) ( addr --> n) Reads byte at addr into low order of n, high order set = 0 CALIBRATE 57B (313) ( --> addr ) Address for calibrate power control CFST 94F (342) ( f n-cmnd --> ) Depend on f turns on INB or OUT FLIPPER, sets FLTIM CINBFL 416 (298) ( --> addr) User Variable Current Inb Flip Direction CKCOMM EA6 (382) ( --> ) Reads / executes commands from secondary command buffer CKDANGLE 42A8 (127) ( --> ) Checks Spin Delta for change, updates, scales Delta Angles CKIDLE D13 (370) ( n --> ) Checks for idle on command, executes IDL if n = 55 CKSUM 476 (302) ( addr n-bytes --> n-cksm) Performs checksum on memory from addr to addr+n-bytes CKSUM-GEN 420E (127) ( --> ) Generates CKSUMS for 128 byte blocks of RAM and ROM CKSUM-PTR 420B (127) ( --> addr ) User variable ROM address for CKSUM CM0 A05 (344) ( n-cmnd --> ) Execute Mag command 0 ( ERROR ) CM1 A0F (344) ( n-cmnd --> ) Execute Mag command 1 ( CALIBRATE ON/OFF ) CM2 A1B (344) ( n-cmnd --> ) Execute Mag command 2 ( ERROR ) CM3 A25 (344) ( n-cmnd --> ) Execute Mag command 3 ( INB GAIN HIGH/LOW) CM4 A33 (344) ( n-cmnd --> ) Execute Mag command 4 ( OUT GAIN HIGH/LOW) CM5 A41 (344) ( n-cmnd --> ) Execute Mag command 5 ( INB POWER ON/OFF) CM6 A5A (344) ( n-cmnd --> ) Execute Mag command 6 ( OUT POWER ON/OFF) CM7 A73 (344) ( n-cmnd --> ) Execute Mag command 7 ( CPU-CTRL ON/OFF) CM8 A7D (344) ( n-cmnd --> ) Execute Mag command 8 ( SNAPSHOT ON/OFF) CM9 A8F (344) ( n-cmnd --> ) Execute Mag command 9 ( OPTIMAL AVER ON/OFF ) CMA A9F (344) ( n-cmnd --> ) Execute Mag command A ( DSPIN ON/OFF ) CMB AA7 (344) ( n-cmnd --> ) Execute Mag command B ( INB FLIPPER FLIP/FL-RT/FL-LT) CMC AAF (344) ( n-cmnd --> ) Execute Mag command C ( S/C CALCOIL ON/OFF ) CMD AB7 (344) ( n-cmnd --> ) Execute Mag command D ( OUT FLIPPER FLIP/FL-RT/FL-LT) CMDPTR 473 (298) ( --> addr ) User character variable CME ABF (344) ( n-cmnd --> ) Execute Mag command E ( DEFAULT-SYS ON/OFF) CMF AC9 (344) ( n-cmnd --> ) Execute Mag command F ( ERROR ) CMPCAL 4501 (131) ( n addr --> ) Calculates n*sin(phi1) and n*cos(phi1) and stores in addr, addr+2 COMMND-TAB AD3 (345) ( --> addr ) Address of start of ROM command table COMMNDS AF5 (345) ( --> 4008 ) Address of start of RAM command table CORRECT 4CE (308) ( n1 n2 --> n-cor ) Hamming error correction procedure COUTF 413 (298) ( --> addr ) User cvariable Current out flip CPU-CTRL 9B9 (343) ( --> addr ) User variable points to word for CPU-CTRL command WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) CTAB 49A (308) ( --> addr ) Hamming error correction table start address CUR-STOR 404A (123) ( --> 4CC4 ) Address for current DSPIN storage CZ 28A (252) ( --> b=0 ) Push single byte on stack ( =0 ) DANGLE D2D (376) ( --> addr ) User variable with current delta angle DATA-BUFFER 470 (298) ( --> addr ) User address for start of 16 word data buffer DATA-BUFFER-STATUS 443 (298) ( --> addr ) Optimal Aver and Snapshot status DATA-STORE E91 (382) ( n1 --> ) Stores raw data into S/C buffer with offset n1 DCOS D33 (376) ( --> addr ) User variable with Delta Cos DEFAULT-SYS 9BC (343) ( --> addr ) User variable holding start address for default system DFS F5B (383) ( n-cmnd --> ) ROM default system initialization if n-cmnd = $55 DFSYS EF6 (382) ( --> ) ROM default system ( not used now) DO 35 ( 51) ( n-end n-beg --> ) Start of DO ... LOOP structure DO 82FB (109) Cross compiler DO stores current addr and calls above DO DROP 16E ( 51) ( n --> ) Drops top of parameter stack DROT DC8 (377) ERROR IN ROUTINE | ERROR IN ROUTINE DO NOT USE > DSIN D30 (376) ( --> addr ) User variable with delta sin DSP-AVER-CONSTANT 403E (123) ( --> addr ) User variable containing the recursive filter constant for DESPIN routines DSP-STAT 43A (298) ( --> addr ) User cvariable containing DSPIN status DSP12 457B (132) ( --> ) DSPIN vectors 1,2 if DSPIN is on, generate state vector or filter dspn DSP3 45AE (132) ( --> ) DSPIN vector 3 if DSPIN is on DSPN 453F (132) ( v n-sin n-cos --> v-dspn) Performs actual DESPIN calculations DUP 162 ( 51) ( n --> n n ) Duplicate top of stack DZ 338 (254) ( b --> ) Opposite of cz, drops one byte from stack E! 369 (254) ( d addr --> ) Extended precision store E+ 33C (254) ( d1 d2 --> d-sum) Extended precision sum E@ 379 (254) ( addr --> d ) Extended precision read ELSE 86 ( 51) Part of IF ... ELSE ... THEN structure ELSE 82FB (109) Cross compiler setup for ELSE ENABLE-INT E8B (382) ( --> ) Enables interrupts END 7B ( 51) ( f --> ) Part of BEGIN ... END structure Returns to BEGIN if flag = 0 END 20A0 (109) PART OF CROSSCOMPILER Cross compiler END setup EOR 4A4 (308) ( n1 n2 --> n) Exclusive or function ERROR 8AC (342) ( n1 n2 --> n2) Command Error, increments SF parity EXCMND B2B (345) ( n-cmnd n-tabl --> ) Execute command from COMMNDS table in RAM EXECUTE 14 ( 51) ( p-addr --> ) Execute FORTH definitions given its parameter address on stack EXT 355 (254) ( n --> d ) Signed extension from 16-bit to 32-bit words FI20 4083 (124) ( addr n --> ) Twenty volt scale/filter routine uses as inputs RD5+n and (addr) stores result in addr MAGNETOMETER DICTIONARY -34- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) FI5 40BD (124) ( addr n --> ) Five volt scale/filter routine uses as inputs RD5+n and (addr) stores result in addr FIL! 44CC (131) ( n addr --> ) Recursive filter using DSP-AVER-CONST FIL256 44C0 (131) ( n addr --> ) Double precision Recursive filter FILT 4480 (130) ( d-in n-cons addr --> ) Double Precision Recursive Filter FILTER C33 (367) INTERRUPT SERVICE recursive filter FILTF 44A4 (130) ( n-in n-cons addr --> ) Single precision recursive filter FLIP 583 (313) ( --> $74f8 ) Constant used in FLIP command FLIPC 97B (342) ( n1 n2 --> ) Execute Flip Command or Error FLIPPER 57F (313) ( --> 5 ) Constant 5 used in FLIP command FLP 920 (342) ( n --> ) Flip Command (Flips opposite of last command) FLTDSPV 4561 (132) ( --> ) Filter current DSPUN data FLTIM 407 (298) ( --> addr ) User cvariable minute counter for flipper ( currently initialized to 8 ) MAGNETOMETER DICTIONARY -35- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) GND 455 (298) ( --> addr ) User variable for GND measuer H* 5A6 (321) ( n1 n2 --> n ) Hardware 8*8 multiply routine using low byte n1,n2 H32 5BB (322) ( n1 n2 --> d ) Hardware 16*16 signed multiply HAMP 4F5 (309) ( n1 n2 --> n1-c n2-c) Hamming code processor. Corrects n1, n2 if possible else leaves $f0 on stack HD-PARITY 461 (298) ( --> addr ) User address for storage of hardware parity counter HI/LOW 8F0 (342) ( n1 n2 --> ) High/Low command processor HIGAIN 571 (313) ( n-sel --> $74f3 + n-sel) Setup for gain commands I 1F3 ( 52) ( --> n) Index for DO ... LOOP structure IBSV 467 (298) ( --> addr ) User variable point to inboard status vector IDL CFB (370) ( --> ) Idle command initialization IDLE CC8 (370) ( --> ) Idle loop, executes commands but no data IF 78 ( 51) ( f --> ) Begin of IF ... ELSE ... THEN structure MAGNETOMETER DICTIONARY -36- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) IF 82FB (109) Cross compiler setup for IF ... THEN structure INB 563 (313) ( --> ) Selector for INBOARD commands INIT 46C4 (135) Final RAM Executive initialization INT-CNT 4032 (123) ( --> $4EE5 ) Interrupt counter area used in 9WAIT INTERRUPT-CODE C5F (369) Main INTERRUPT service routine IR-RECOV 4C3 (308) ( n1 n2 --> 0f ) Hamming uncorrectable error routine J 21A ( 29) ( --> n ) Outer loop variable in DO ... DO ... LOOP ... LOOP structure. Inner loop uses I LCMNDS AF9 (345) ( --> ) Loads RAM command table using ROM table. LEAVE 20D ( 29) ( --> ) Forces termination of DO ... LOOP before normal completion LEFT 587 (313) ( n-sel --> ) Turns on selected flipper circuit LINBFL 41C (298) ( --> addr ) User cvariable with last INB FLIP LIT 2C ( 51) ( --> n ) Used to push in-line constants on stack MAGNETOMETER DICTIONARY -37- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) LOOP 4B ( 51) ( --> ) End of DO ... LOOP structure LOOP 20A0 (109) Cross compiler support for above LOOP LOUTFL 419 (298) ( --> addr ) User cvariable with last OUT flip position M* 2BE (253) ( u1 u2 --> 24-bit ) Software multiply leaving 24 bit product M/MOD 2DA (253) Software core divide routine M32 3A3 (255) ( u1 u2 --> d ) Software mult leaving 32 bit product M91 4036 (123) ( --> $4ee4 ) Address where S/C Mod91 time is stored MAIN F8D (384) ( --> ) ROM based main program. Not used with RAM EXEC. MAIN 45F7 (134) ( --> ) RAM EXEC main routine MAT-LOAD 4256 (127) ( --> ) RAM routine to load DML data to status matrix MAT-RESET 43D6 (129) ( --> ) Reset status matrix to default ( unity matrix 0 offsets) MAX 290 (253) ( n1 n2 --> n-max) Leaves maximum of n1, n2 MEM-PROTECT 59C (316) ( n-page --> ) Turns on/off memory protect for selected page MAGNETOMETER DICTIONARY -38- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) MEMORY-SWITCH 1FF (314) ( --> ) Memory Switch routine Swaps RAM, ROM MIN 2A1 (253) ( n1 n2 --> n-min ) Leaves minimum on n1,n2 on stack MINE 389 (254) ( d --> -d ) Extended precision minus MINUS 265 (252) ( n --> -n ) Changes sign of n MOD 31C (253) ( n1 n2 --> n-rem) Leaves remainder of n1/n2 MOVE 105 ( 51) ( addr-s addr-d n --> ) Moves n bytes from addr-s to addr-d NOT 24D (252) ( f --> -f) Negates flag OBSV 46A (298) ( --> addr ) User Outboard state vector pointer OF1 42E (298) ( --> addr ) User variable with sensor1 offset OF2 431 (298) ( --> addr ) User variable with sensor2 offset OF3 434 (298) ( --> addr ) User variable with sensor3 offset OFF 554 (313) ( n --> ) Turns selected function n OFF ON 549 (313) ( n --> ) Turns selected function n ON MAGNETOMETER DICTIONARY -39- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) ON/OFF 8C0 (342) ( n1 n2 --> ) Selects ON or OFF depend on n1, n2 is select for ON OFF OPT-START 419C (126) ( --> ) Initiates optimal average processing OPTIMAL-AVER 9BF (343) ( --> addr ) User variable where optimal aver exec code is stored OPTST 41BA (126) ( --> ) Checks and moves current store if optimal average is turned on and aver# AND mod91 = 0 OR! 445E (130) ( addr --> ) Offset/ rotate data to S/C co-ord store vector at addr OUT 55F (313) ( --> 1 ) Select outboard for command execution OVER 187 ( 51) ( n1 n2 --> n1 n2 n1 ) Copies n1 to top of stack PARESET 4399 (129) ( --> ) Resets offsets, scales, and matrix to default PARITY 4AD (308) ( n --> 0,1) Generates parity of low order byte now on stack PC 4DF (309) Part of Hamming Checker PCAL 422 (298) ( --> addr ) User cvariable for calibrate power PFLIP 41F (298) ( --> addr ) User cvariable for flipper power MAGNETOMETER DICTIONARY -40- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) PG 4ED (309) Part of Hamming Checker PINIT 4134 (125) ( --> ) Power on Initialization POWER 567 (313) ( n1 --> n1+$74F1 ) Power select for commands R> 1E8 ( 52) ( --> n1 ) Pulls from return stack and pushes on parameter stack RAM-CKSUM 4047 (123) ( --> addr ) User variable with current pointer for start of 128 byte RAM checksum RD4 E64 (382) ( --> n ) Reads register 4 and puts value on stack RD5 9FC (343) ( --> n ) Reads register 5 and puts value on stack RIGHT 58F (313) ( n-sel --> ) Flip power select/ control RM1 437 (298) ( --> addr ) User address with start of rotation matrix ROM-CKSUM 4044 (123) ( --> addr ) User variable with address for ROM 128 byte checksum ROT 2B2 (253) ( n1 n2 n3 --> n2 n3 n1 ) Rotates n1 to top of stack S* 3CF (255) ( n1 n2 --> n-prod ) Signed 16 bit product ( software ) MAGNETOMETER DICTIONARY -41- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) S* 622 (323) ( n1 n2 --> n-prod ) Signed 16 bit product ( hardware ) S-CPROD 833 (333) (n1 n2 n3 n4-->p1 p2 p3 p4) Sin-cos product p1=n1*n4 p2=n2*n3 p3=n1*n3 p4=n2*n4 S/C-CAL 440 (298) ( --> addr ) User cvariable for S/C Cal flag S0F 9C8 (343) ( n1 n2 --> ) Set Gain flag S1PHI D36 (376) ( --> addr ) User variable containing sin phi for v1 S2PHI D3C (376) ( --> addr ) User variable containing sin phi for v2 S3PHI D42 (376) ( --> addr ) User variable containing sin phi for v3 SAMPLE B3E (362) INTERRUPT routine which controls ADC SC/RT 4444 (130) ( vr --> v-scaled/rotated) Scale and rotate vr data to produce v for storage etc. SCALE 442E (130) ( n1 n2 --> n-prod ) Extended prec scale ( 7FFF = 2.0 ) SCF 40A (298) ( --> addr ) User variable containing the scale Factor for field data set by DML SDATA-PTR B2C1 (123) Sample Data pointer stored in crosscompiler only MAGNETOMETER DICTIONARY -42- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) SDSPIN 42BE (128) ( n1 --> n1 ) Stores DSPIN and other Subcom data depending on n1 = MOD91 SE4 E6D (382) ( n1 --> ) Set reg 4 to n1 SETSUB 433E (128) ( --> ) Sets Subcom into S/C buffer, stores some Subcom SF-PARITY 464 (298) ( --> addr ) User cvariable for storage of Hamming Errors SF0 9E2 (343) ( n1 n2 --> ) Sets power flag for magnetometer SF20 409D (124) ( --> ) Store/filter 20V subcom data SF5 40D7 (124) ( --> ) Store/filter 5V subcom data SGINB 410 (298) ( --> addr ) User cvariable with scale/gain for INB SGOUT 40D (298) ( --> addr ) User cvariable with scale/gain for OUT SICOS 859 (333) ( n1 --> n-cos n-sin ) Generates the SIN and COS of angle n1 SICOS-DELTA 807 (333) ( n1 --> n-cos n-sin ) Generates the SIN and COS of LSB of angle n1 using small angle approximations SNAP 4061 (124) ( n1 --> ) Checks for ON command then starts SNAPSHOT MAGNETOMETER DICTIONARY -43- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) SNAP-SHOT BDB (365) INTERRUPT ROUTINE which implements snapshot SNAPSHOT 9C2 (343) ( --> addr ) User variable for storage of executable snapshot ( SNAP ) SNPST 4055 (124) ( addr d-addr --> ) Start snapshot at address addr using data d-addr SP-DELTA D21 (376) ( --> $4E32 ) Address where spin delta is available STATE-V 451F (131) ( --> v2-dspn) Calculates state vector info leaves dspun v2 on stack SWAP 173 ( 51) ( n1 n2 --> n2 n1 ) Swaps top two stack items T-ELEC 458 (298) ( --> addr ) User variable for storing temp electronics T/S-UPDATE B69 (363) INTERRUPT ROUTINE updates time/ sector THEN 650C (109) Cross compiler THEN support TRFN D90 (376) Part of trig function routines, calculates sin, cos for vectors 1,3 from vector 2 sin, cos and delta sin,cos TRG-2 D74 (376) Calculates sin, cos for vector 2 TRGFNS DC0 (376) Calls TRG-2 and TRFN to calculate all sines, cosines MAGNETOMETER DICTIONARY -44- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) TRIG 772 (330) Address for start of trig table TRIGE 7F6 (330) 90-degree shifted trig table entry TS! 4165 (126) ( addr --> ) Stores time amd sector starting at addr TTEXEC 40F7 (125) ( n1 n2 --> ) Part of power on initialization ( PINIT ) U* 11E ( 51) ( u1 u2 --> u-prod) Unsigned 8-bit multiply giving 16 bit product U/ 13D ( 51) ( u1 u2 --> u-quot u-rem) Unsigned division u1=16 bit, u2 = 7 bit V! 672 (325) ( nz ny nx addr --> ) Vector store V+ 6C4 (325) (addr1 addr2-->nxs nys nzs) Vector sum ( results are rotated ) V- 68A (325) (addr1 addr2-->nxd nyd nzd) Vector difference ( results are rotated ) V-12 44F (298) ( --> addr ) User variable for storage of -12V status V1 DDC (377) ( --> addr ) Bufferdress storage for V1 V10 44C (298) ( --> addr ) User variable for storage of 10V status V12 449 (298) ( --> addr ) User variable for storage of 12V status MAGNETOMETER DICTIONARY -45- MARCH 29, 1984 WORD LINK (DEC-SCREEN#) ( STACK OPERATIONS) V2 DE4 (377) ( --> addr ) Buffer address storage for V2 V3 DEF (377) ( --> addr ) Buffer address storage for V3 V@ 65A (325) ( addr --> v1) Vector read VDATA 9C5 (343) ( --> addr ) User variable containing current active Mag data pointer ( set by power, gain changes) VDOT 6FE (325) ( v1 v2 --> n1 ) Dot product of two vectors stored on stack VECTOR 5389 (123) Cross compiler vector to initialization routine VRAM 446 (298) ( --> addr ) User variable for V-RAM status VREF 452 (298) ( --> addr ) User variable for V-REF status VROT 746 (325) ( v1 addr --> vr) Rotate vector V using matrix starting at addr ( this leaves rotated vector on stack ) WAIT EE7 (382) ( --> ) Wait until Reg 4 < 0 ROM routine WAIT 45D0 (133) ( --> ) RAM wait routine counts loops and stores in $4e60 WHILE 89 ( 51) Part of BEGIN ... WHILE structure WHILE 6622 (109) " " " " Cross compiler support for WHILE X 648 (325) X component selector for vector using @ XFER 4002 (123) XFER TO INITIALIZATION Link to POR initialization XFER1 402 (251) XFER2 53CB (251) APPLE CONSTANT XFER3 C02 (251) Y 64C (325) Y component selector for vector using @ Z 652 (325) Z component selector for vector using @ ZERO 2785 (110) Cross-compiler defined constant ZERO-USER E75 (382) ( --> ) Zeros subcom data in USER area ['] 21 ( 51) Pushes parameter stack of next word on stack GALILEO MAGNETOMETER DEFAULT DML-LOAD OCTOBER 27, 1983 MAG-SELl INBOARD l OUTBOARD l FLP-POSl LEFT l RIGHT l LEFT l RIGHT l GAIN l LOW l HIGH l LOW l HIGH l LOW l HIGH l LOW l HIGHl RANGE l16384 l 512 l16384 l 512 l 512 l 32 l 512 l 32 l --------------------------------------------------------------- ADDRESSl l l l l l l l l 4E80 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5l l l l l l l l l l 4E82 l 0002 l 0040 l 0002 l 0040 l 0040 l 0400 l 0040 l 0400l l l l l l l l l l 4E84 l 1000 l 1000 l 1000 l 1000 l 1000 l 1000 l 1000 l 1000l l l l l l l l l l 4E86 l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E88 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000l l l l l l l l l l 4E8A l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000l l l l l l l l l l 4E8C l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000 l 4000l l l l l l l l l l 4E8E l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E90 l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E92 l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E94 l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E96 l 7FFF l 7FFF l -0- l -0- l 7FFF l 7FFF l -0- l -0- l l l l l l l l l l 4E98 l -0- l -0- l 8000 l 8000 l -0- l -0- l 8000 l 8000l l l l l l l l l l 4E9A l 7FFF l 7FFF l 7FFF l 7FFF l 7FFF l 7FFF l 7FFF l 7FFFl l l l l l l l l l 4E9C l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4E9E l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4EA0 l -0- l -0- l -0- l -0- l -0- l -0- l -0- l -0- l l l l l l l l l l 4EA2 l -0- l -0- l 8000 l 8000 l -0- l -0- l 8000 l 8000l l l l l l l l l l 4EA4 l 8000 l 8000 l -0- l -0- l 8000 l 8000 l -0- l -0- l l l l l l l l l l 4EA6 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5 l A5A5l l l l l l l l l l l l l l l l l l l -------------------------------------------------------------------------------- /FORTH sources/gllrom.forth: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rongarret/gll-mag-patch/6809b466f81db55ec53fe3e1a4f97e6389909d40/FORTH sources/gllrom.forth -------------------------------------------------------------------------------- /Patches/delivered: -------------------------------------------------------------------------------- 1 | ;;; Engineering offset patch: (compile-patch ": FIL! 1234 SWAP FILTF ;") 44C8 00 CA 00 1F 12 34 44D0 01 71 44 A2 00 D5 ;;; Optimal averager sampling period patch. (Uses 2 bytes at 46FE) (compile-patch ": SDSPIN DUP 15 = IF 1ST-DSPVECTOR TS! THEN DUP 28 = IF ADDR-BUFFER DUP @ 20 + DUP 4CF8 > IF DROP 4800 THEN DUP ROT 2+ 20 MOVE ADDR-BUFFER ! THEN 1 46FE +! 46FE @ 0= IF OPTST -7 46FE ! THEN DUP 0= IF MAT-LOAD 4FF0 C@ 20 - 2/ CMDPTR +! THEN ;") 42B8 00 CA 01 60 42C0 00 2A 15 02 43 00 76 05 42C8 04 3B 41 63 01 60 00 2A 42D0 28 02 43 00 76 2C 40 50 42D8 01 60 01 95 00 2A 20 00 42E0 E9 01 60 00 1F 4C F8 02 42E8 37 00 76 07 01 6C 00 1F 42F0 48 00 01 60 02 B0 02 5D 42F8 00 2A 20 01 03 40 50 01 4300 A3 02 3F 00 1F 46 FE 01 4308 AF 00 1F 46 FE 01 95 01 4310 C0 00 76 0D 41 B8 00 1F 4318 FF F9 00 1F 46 FE 01 A3 4320 01 60 01 C0 00 76 14 42 4328 54 00 1F 4F F0 00 8A 00 4330 2A 20 00 F6 0E 3A 04 71 4338 01 AF 00 D5 -------------------------------------------------------------------------------- /Patches/development: -------------------------------------------------------------------------------- 1 | ;;; 3 vectors -> 2 (accelerated snapshot) (build-gll-dictionary) ; Rename 2DSP to despin-vector-1 (setf (forth-word-name (lkup '2dsp)) 'despin-vector-1) ; Rename the ROM version of 2DSP so we don't get confused (setf (forth-word-name (lkup '2dsp)) 'obsolete-rom-2dsp) (compile-patch ": despin-vector-1 V1 V@ S1PHI @ C1PHI @ DSPN ;") ; Get rid of DSP12 and DSP3, and put snapshot-readout in their place (incf (forth-word-size (lkup 'dsp12)) (forth-word-size (lkup 'dsp3))) (length (delete (lkup 'dsp3) (dictionary-entries *the-dictionary*))) (setf (forth-word-name (lkup 'dsp12)) 'snapshot-readout) (compile-patch ": snapshot-readout 46FC @ DUP 4800 > IF V@ -6 46FC +! ELSE 0 0 M91 C@ DUP 5B = IF 4CEB 46FC ! 4745 C@ SNAP THEN V3 V! THEN ;") ; Finally, patch MAIN (compile-patch ": MAIN LCMNDS ?MEMORY [' CKIDLE 2+ CPU-CTRL ! [' DROP 2+ DEFAULT-SYS ! [' SNAP 2+ SNAPSHOT ! [' OPT-START 2+ OPTIMAL-AVER ! 20 4FF0 C! 0 4E40 ! 0 4E20 ! ENABLE-INT 20 4FF0 C! 0 FFF CKSUM ROM-CKSUM ! 4000 6FF CKSUM RAM-CKSUM ! 0 CMDPTR ! 4CB0 CUR-STOR ! PINIT 9WAIT BEGIN INT-CNT C@ 13 > IF 9WAIT 0A SE4 V1 OR! SF20 SF5 TRGFNS V1 V@ IBSV V! WAIT V2 OR! despin-vector-1 STATE-V FLTDSPV snapshot-readout ELSE 0 V1 9 B! THEN SETSUB AV-VEC 0 END ;") -------------------------------------------------------------------------------- /Patches/test results: -------------------------------------------------------------------------------- 1 | Erann, I reviewed the above patch and found that the compiled code matched the patch as provided. I then ran a forth test which indicated that there are still some things that need to be changed. Attached is the test code and results. As you can see, we end up with extra vectors at rim 0, 90 and the optst routine gets called twice at rim 90. While the patch doesn't quite work, it appears that your compilation efforts are working properly. Joe 760 Unit 0 Part 0 Abs 760 0 ( GLL - AI TEST CODE CHECK ) HEX 1 2 : 1ST-DSPVECTOR ." 1ST-DSPVECTOR RIM= " DUP . CR ; : TS! ; 3 VARIABLE ADDR-BUFFER 400 ALLOT ADDR-BUFFER ADDR-BUFFER ! 4 : MAT-LOAD ." MAT-LOAD" CR ; VARIABLE CMDPTR 5 6 : OPTST ." OPTST VECTOR STORE RIM= " DUP . CR ; 7 8 : SDSPIN DUP 15 = IF 1ST-DSPVECTOR TS! THEN DUP 28 = IF 9 ADDR-BUFFER DUP @ 20 + DUP 4CF8 > IF DROP 4800 THEN 10 DUP ROT 2+ 20 MOVE ADDR-BUFFER ! THEN 11 DUP 12 MOD 0 = IF OPTST THEN 12 DUP 5A = IF OPTST MAT-LOAD 4FF0 C@ 20 - 2/ CMDPTR +! THEN ; 13 14 : T1 5B 0 DO I SDSPIN DROP LOOP ; 15 Operation of T1 results in the following: OPTST VECTOR STORE RIM= 0 OPTST VECTOR STORE RIM= 18 1ST-DSPVECTOR RIM= 21 OPTST VECTOR STORE RIM= 36 OPTST VECTOR STORE RIM= 54 OPTST VECTOR STORE RIM= 72 OPTST VECTOR STORE RIM= 90 OPTST VECTOR STORE RIM= 90 MAT-LOAD -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | GLL - A patch for the Galileo magnetometer 3 | 4 | See https://news.ycombinator.com/item?id=12037548 5 | 6 | In 1993 I worked on a project to produce a software patch for the 7 | magnetomer instrument on the Galileo spacecraft, then in orbit around 8 | Jupiter. The magnetometer had developed a bad RAM byte. Unfortunately, 9 | the development system that had been used to program the instrument had 10 | been decommissioned. I wrote a new development system from scratch using 11 | Macintosh Common Lisp (now Clozure Common Lisp) and used it to develop 12 | a patch for the magnetometer code. 13 | 14 | This is a raw dump of my archive from that project. I have not looked 15 | at this code in 25 years and I don't remember much in the way of details 16 | about exactly what needed to be done or why. I'm putting this out there 17 | simply because some people have expressed interest in it. 18 | 19 | This code was written while I was an employee of JPL in 1993. I don't 20 | know what its copyright status is. If you want to do anything more with 21 | it than study it academically you should probably contact the JPL public 22 | information office and get permission. 23 | -------------------------------------------------------------------------------- /asm1802: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) (require 'utilities) ; Mode codes: r=register b=byte w=word 0=no arg (defvar *1802-opcode-table* '((idl 0 #x00) (ldn r #x00) (inc r #x10) (dec r #x20) (br b #x30) (bq b #x31) (bz b #x32) ((bdf bpz bge) b #x33) (b1 b #x34) (b2 b #x35) (b3 b #x36) (b4 b #x37) ((nbr skp) b #x38) (bnq b #x39) (bnz b #x3A) ((bnf bm bl) b #x3B) (bn1 b #x3C) (bn2 b #x3D) (bn3 b #x3E) (bn4 b #x3F) (lda r #x40) (str r #x50) (irx 0 #x60) (out1 0 #x61)(out2 0 #x62)(out3 0 #x63)(out4 0 #x64) (out5 0 #x65)(out6 0 #x66)(out7 0 #x67) (in1 0 #x69) (in2 0 #x6A) (in3 0 #x6B) (in4 0 #x6C) (in5 0 #x6D) (in6 0 #x6E) (in7 0 #x6E) (ret 0 #x70) (dis 0 #x71) (ldxa 0 #x72) (stxd 0 #x73) (adc 0 #x74) (sdb 0 #x75) ((shrc rshr) 0 #x76) (smb 0 #x77) (sav 0 #x78) (mark 0 #x79) (seq 0 #x7A) (req 0 #x7B) (addi b #x7C) (sdbi b #x7D) (shlc 0 #x7E) (smbi b #x7F) (glo r #x80) (ghi r #x90) (plo r #xA0) (phi r #xB0) (lbr w #xC0) (lbq w #xC1) (lbz w #xC2) (lbdf w #xC3) (nop 0 #xC4) (lsnq 0 #xC5) (lsnz 0 #xC6) (lsnf 0 #xC7) ((lskp nlbr) w #xC8) (lbnq w #xC9) (lbnz w #xCA) (lbnf w #xCB) (lsie 0 #xCC) (lsq 0 #xCD) (lsz 0 #xCE) (lsdf 0 #xCF) (sep r #xD0) (sex r #xE0) (ldx 0 #xF0) (or 0 #xF1) (and 0 #xF2) (xor 0 #xF3) (add 0 #xF4) (sd 0 #xF5) (shr 0 #xF6) (sm 0 #xF7) (ldi b #xF8) (ori b #xF9) (andi b #xFA) (xoi b #xFB) (adi b #xFC) (sdi b #xFD) (shl 0 #xFE) (smi b #xFF) )) (defun lookup-mnemonic (m &optional (table *1802-opcode-table*)) (find-if (fn (x) (or (eq (car x) m) (and (consp (car x)) (member m (car x))))) table)) (defun lookup-opcode (c &optional (table *1802-opcode-table*)) (and (<= 0 c 255) (find-if (fn (x) (or (eq (third x) c) (and (eq (second x) 'r) (eq (third x) (logand c #xF0))))) table))) (defun asm-instr (instr &optional (emit-fn #'list)) (let* ( (template (lookup-mnemonic (car instr))) (mode (second template)) (opcode (third template)) ) (if (null template) (asm-error "Unknown opcode: ~S" instr)) (case mode ( (0 nil) (funcall emit-fn opcode) ) ( r (funcall emit-fn (logior opcode (regop (second instr))))) ( b (funcall emit-fn opcode (byteop (second instr))) ) ( w (apply emit-fn opcode (wordop (second instr)))) (otherwise (asm-error "Bogus entry in opcode table: ~S" template))))) (defun asm-error (msg &rest args) (apply #'error msg args)) (defun regop (reg) (if (null reg) (asm-error "Missing register operand.")) (let ( (n (if (fixnump reg) reg (position reg '(r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15)))) ) (if (and (fixnump n) (<= 0 n 15)) n (asm-error "Illegal register: ~S" reg)))) (defun byteop (n) (if (null n) (asm-error "Missing byte operand.")) (if (not (fixnump n)) (asm-error "Illegal byte operand: ~S" n)) (if (<= 0 n 255) n (asm-error "Byte operand out of range: ~S" n))) (defun wordop (n) (if (null n) (asm-error "Missing word operand.")) (if (not (fixnump n)) (asm-error "Illegal word operand: ~S" n)) (if (<= #x-7FFF n #xFFFF) (list (ash (logand n #xFF00) -8) (logand n #xFF)) (asm-error "Word operand out of range: ~S" n))) (defun disasm1 (mem &optional (start 0)) (let* ( (pc start) (opcode (get-byte mem pc)) (template (lookup-opcode opcode)) (mnemonic (if (atom (car template)) (car template) (caar template))) (mode (second template)) ) (format t "~&~4,'0X: ~2,'0X ~A" pc opcode (or mnemonic "ILLEGAL OPCODE")) (cond ( (or (null mode) (eql mode 0)) ) ( (eq mode 'r) (format t " R~S" (logand opcode 15)) ) ( (eq mode 'b) (format t " ~2,'0X" (get-byte mem (1+ pc))) ) ( (eq mode 'w) (format t " ~4,'0X" (+ (ash (get-byte mem (1+ pc)) 8) (get-byte mem (+ pc 2)))) ) (t (asm-error "Bogus entry in opcode table: ~S" template))) (+ pc (ecase mode ((0 nil) 1) (r 1) (b 2) (w 3))))) (defun disasm (mem &key (start 0) (n 1)) (dotimes (i n) (setf start (disasm1 mem start)))) -------------------------------------------------------------------------------- /dictionary: -------------------------------------------------------------------------------- 1 | %free-ram 46F3 (marker) INIT 46C4 (135) Initialization code MAIN 45F7 (134) RAM Exeutive main 9WAIT 45DB (133) Wait for MOD10 = 9 WAIT 45D0 (133) Wait until reg 4 < 0 DSP3 45AE (132) DSPIN Vector 3 DSP12 457B (132) DSPIN Vectors 1,2 FLTDSPV 4561 (132) Average the Despun Vector 2DSP 454F (132) DSPIN vector 2 DSPN 453F (132) Calculate DESPUN vector STATE-V 451F (131) Calculate State Vector Info CMPCAL 4501 (131) Calc. D*SIN D*COS, Filter AV-VEC 44D8 (131) Calc. State Vector Aver. FIL! 44CC (131) Single Prec. Filter, Store FIL256 44C0 (131) Double Prec. Filter, Store FILTF 44A4 (130) Single Prec. fast filter FILT 4480 (130) Double Prec. filter OR! 445E (130) Offset,Rotate, Scale Data SC/RT 4444 (130) Scale Data, Rotate vector SCALE 442E (130) Scale data (-2. to 1.999) ?MEMORY 43ED (129) Check MEMORY for reset? MAT-RESET 43D6 (129) Set rotation matrix to unity PARESET 4399 (129) Set Offsets, Gains to 0, 1.0 SETSUB 433E (128) Store Subcom in USER array SDSPIN 42BE (128) Store DSPIN, CKSUM, MATLOD CKDANGLE 42A8 (127) Check, Scale Delta-angle MAT-LOAD 4256 (127) Load from DML area CKSUM-GEN 420E (127) 128 word CKSUMS for RAM,ROM CKSUM-PTR 420B (127) Pointer for RAM CKSUM OPTST 41BA (126) Check,start OPTIMAL AVERAGE OPT-START 419C (126) INITIATE OPTIMAL AVERAGE TS! 4165 (126) Store Time, Sector, DSPIN V B! 414A (126) Block Storage PINIT 4134 (125) POR initialization TTEXEC 40F7 (125) Mag Command Exec on POR SF5 40D7 (124) SUBCOM FILTER 5 VOLTS FI5 40BD (124) Five Volt Recursive Filter SF20 409D (124) SUBCOM FILTER 20 VOLTS FI20 4083 (124) Twenty Volt Recursive Filter SNAP 4061 (124) Start SNAPSHOT if commanded SNPST 4055 (124) Start SNAPSHOT running ADDR-BUFFER 4052 (123) Data Buffer Address Pointer 6 404E (123) Constant " 6 " CUR-STOR 404A (123) DSPIN pointer RAM-CKSUM 4047 (123) SUBCOM pointer for RAM CKSUM ROM-CKSUM 4044 (123) SUBCOM pointer for ROM CKSUM AVER# 4041 (123) SUBCOM pointer for AVER # DSP-AVER-CONSTANT 403E (123) SUBCOM pointer for DSP AVR K 1.0 403A (123) Constant " 1.0 " M91 4036 (123) Position of MOD91 in time INT-CNT 4032 (123) Position of Int-counter 3 402E (123) Constant " 3 " 2 402A (123) Constant " 2 " XFER 4002 (123) XFER TO INITIALIZATION %end-of-rom 7FF (marker) MAIN F8D (384) ROM MAIN ROUTINE DFS F5B (383) DFSYS EF6 (382) WAIT EE7 (382) CKCOMM EA6 (382) DATA-STORE E91 () ENABLE-INT E8B (382) ZERO-USER E75 (382) SE4 E6D (382) RD4 E64 (382) 2E/ E4B (380) 2/ E3C (380) 3DSP E26 (377) 2DSP E10 (377) 1DSP DFA (377) V3 DEF (377) V2 DE4 (377) V1 DDC (377) DROT DC8 (377) TRGFNS DC0 (376) TRFN D90 (376) TRG-2 D74 (376) CKDANGLE D48 (376) C3PHI D45 (376) S3PHI D42 (376) C2PHI D3F (376) S2PHI D3C (376) C1PHI D39 (376) S1PHI D36 (376) DCOS D33 (376) DSIN D30 (376) DANGLE D2D (376) ANG-CONV D29 (376) ANGLE D25 (376) SP-DELTA D21 (376) CKIDLE D13 (370) IDL CFB (370) IDLE CC8 (370) INTERRUPT-CODE C5F (369) FILTER C33 (367) A/4 C07 (366) XFER3 C02 (251) SNAP-SHOT BDB (365) ?COMND BAA (364) T/S-UPDATE B69 (363) SAMPLE B3E (362) EXCMND B2B (345) LCMNDS AF9 (345) COMMNDS AF5 (345) COMMND-TAB AD3 (345) CMF AC9 (344) CME ABF (344) CMD AB7 (344) CMC AAF (344) CMB AA7 (344) CMA A9F (344) CM9 A8F (344) CM8 A7D (344) CM7 A73 (344) CM6 A5A (344) CM5 A41 (344) CM4 A33 (344) CM3 A25 (344) CM2 A1B (344) CM1 A0F (344) CM0 A05 (344) RD5 9FC (343) SF0 9E2 (343) S0F 9C8 (343) VDATA 9C5 (343) SNAPSHOT 9C2 (343) OPTIMAL-AVER 9BF (343) DEFAULT-SYS 9BC (343) CPU-CTRL 9B9 (343) FLIPC 97B (342) CFST 94F (342) FLP 920 (342) HI/LOW 8F0 (342) ON/OFF 8C0 (342) ERROR 8AC (342) SICOS 859 (333) S-CPROD 833 (333) SICOS-DELTA 807 (333) TRIGE 7F6 (330) TRIG 772 (330) VROT 746 (325) VDOT 6FE (325) V+ 6C4 (325) V- 68A (325) V! 672 (325) V@ 65A (325) Z 652 (325) Y 64C (325) X 648 (325) BUFFER-ADDRESS 632 (324) S* 622 (323) H32 5BB (322) H* 5A6 (321) MEM-PROTECT 59C (316) RIGHT 58F (313) LEFT 587 (313) FLIP 583 (313) FLIPPER 57F (313) CALIBRATE 57B (313) HIGAIN 571 (313) POWER 567 (313) INB 563 (313) OUT 55F (313) OFF 554 (313) ON 549 (313) ALL-OFF 531 (313) HAMP 4F5 (309) PG 4ED (309) PC 4DF (309) CORRECT 4CE (308) IR-RECOV 4C3 (308) PARITY 4AD (308) EOR 4A4 (308) CTAB 49A (308) CKSUM 476 (302) CMDPTR 473 (298) DATA-BUFFER 470 (298) 2ND-DSPVECTOR 46D (298) OBSV 46A (298) IBSV 467 (298) SF-PARITY 464 (298) HD-PARITY 461 (298) 2-SPARE 45E (298) 1-SPARE 45B (298) T-ELEC 458 (298) GND 455 (298) VREF 452 (298) V-12 44F (298) V10 44C (298) V12 449 (298) VRAM 446 (298) DATA-BUFFER-STATUS 443 (298) S/C-CAL 440 (298) 1ST-DSPVECTOR 43D (298) DSP-STAT 43A (298) RM1 437 (298) OF3 434 (298) OF2 431 (298) OF1 42E (298) 3GAIN 42B (298) 2GAIN 428 (298) 1GAIN 425 (298) PCAL 422 (298) PFLIP 41F (298) LINBFL 41C (298) LOUTFL 419 (298) CINBFL 416 (298) COUTF 413 (298) SGINB 410 (298) SGOUT 40D (298) SCF 40A (298) FLTIM 407 (298) XFER1 402 (251) S* 3CF (255) M32 3A3 (255) ABSE 39C (254) MINE 389 (254) E@ 379 (254) E! 369 (254) EXT 355 (254) E+ 33C (254) DZ 338 (254) / 32E (253) * 324 (253) MOD 31C (253) /MOD 30E (253) */ 304 (253) */MOD 2F6 (253) M/MOD 2DA (253) M* 2BE (253) ROT 2B2 (253) MIN 2A1 (253) MAX 290 (253) CZ 28A (252) -DUP 27F (252) 2* 277 (252) ABS 270 (252) MINUS 265 (252) 2+ 25F (252) 1+ 253 (252) NOT 24D (252) = 245 (252) 1 241 (252) > 239 (252) < 231 (252) 0 22D (252) J 21A ( 29) LEAVE 20D ( 29) MEMORY-SWITCH 1FF (314) I 1F3 ( 52) R> 1E8 ( 52) " name) (defun make-dictionary (name &optional (start-addr 0)) (make-instance 'dictionary :name name :next-entry-addr start-addr)) (define-class forth-word name address source bytes size) (define-print-method (forth-word name address size) "#" name (or address :uninstalled) (or size :uncompiled)) (define-method (find-entry-by-name (d dictionary entries) name) (find name entries :key #'forth-word-name)) (define-method (find-entry-by-address (d dictionary entries) addr) (find addr entries :key #'forth-word-address :test #'>=)) (defun make-forth-word (name &key address source bytes size) (if (and size bytes (/= size (length bytes))) (warn "Size and byte specs do not match.")) (if (and bytes (null size)) (setf size (length bytes))) (make-instance 'forth-word :name name :address address :source source :bytes bytes :size size)) (define-method (fcompile (w forth-word source bytes size) d) (setf bytes (compile-forth-words source d)) (setf size (length bytes)) w) (define-method (install (w forth-word name address source bytes size) d) (if (find-entry-by-name d name) (warn "A word named ~S already exists in ~S." name d)) (with-slots (entries next-entry-addr) d (if (null size) (error "~S has not been properly compiled." w)) (if address (if (< address next-entry-addr) (error "Can't overwrite existing code.")) (setf address next-entry-addr)) (push w entries) (setf next-entry-addr address) (incf next-entry-addr size) t)) (define-method (dump (w forth-word name address source bytes size)) (format t "~&Dump of forth word ~S:" name) (format t "~&~%Source code:") (format t "~&~A" source) (format t "~&~%Object code:") (pprint-bytes bytes address) (values)) (define-method (forget (d dictionary entries next-entry-addr) name) (let ( (l (member name entries :key #'forth-word-name)) ) (if (null l) (error "~S not found in ~S." name d)) (setf entries (cdr l)) (setf next-entry-addr (if (null (cdr l)) 0 (+ (forth-word-address (cadr l)) (forth-word-size (cadr l))))))) (defvar *the-dictionary* (make-dictionary :default)) (defun lkup (thing &optional (d *the-dictionary*)) (if (integerp thing) (find-entry-by-address d thing) (find-entry-by-name d thing))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Parsers ;;; (defun read-to-delimiter (&optional (stream t) (delimiters '(#\Space #\Return #\Linefeed))) (peek-char t stream nil) (with-output-to-string (s) (loop (let ( (c (read-char stream nil :eof)) ) (if (or (member c delimiters :test #'eql) (eq c :eof)) (return s) (princ c s)))))) (defun string->forth-word (s &optional (radix 16)) (receive (n cnt) (parse-integer s :radix radix :junk-allowed t) (if (and n (= cnt (length s))) n (intern (string-upcase s))))) (defun read-forth-word (&optional (stream t)) (let ( (w (string->forth-word (read-to-delimiter stream))) ) (if (neq w '\( ) w (if (eq (read-to-delimiter stream '(#\))) ':eof) (error "Unexpected end of file while reading forth comment.") (read-forth-word stream))))) (defun parse-forth (s) (with-input-from-string (s s) (let ( (result nil) ) (loop (let ( (word (read-forth-word s)) ) (if (eq word '||) (return (nreverse result)) (push word result))))))) (defun read-forth-source (filename) (with-open-file (f filename) (let ( (flag nil) (result '()) ) (loop (let ( (w (read-forth-word f)) ) (case w (|| (return (nreverse result))) (\: (push (list '\:) result) (setq flag t)) (\; (if (null flag) (return (nreverse result)) (progn (push w (car result)) (setf (car result) (nreverse (car result))) (setq flag nil)))) (otherwise (if flag (push w (car result)))))))))) (defun read-dictionary (f) (let ( (result nil) ) (loop (push (cons (string->forth-word (read-to-delimiter f)) (let ( (*read-base* 16)) (- (read f) 2))) result) (read-line f nil) (when (eql (peek-char nil f nil #\Newline) #\Newline) (return (sort result #'< :key #'cdr)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FORTH compiler ;;; (define-class compiler-state words bytes branch-stack) (define-method (scan (s compiler-state words)) (pop words)) (define-method (emit (s compiler-state bytes) &rest new-bytes) (dolist (b new-bytes) (push b bytes))) (define-method (emit16 (s compiler-state) &rest words) (dolist (w words) (emit s (logand (ash w -8) #xFF) (logand w #xFF)))) (define-method (mark-branch (s compiler-state bytes branch-stack)) (push bytes branch-stack)) (define-method (resolve-branch (s compiler-state branch-stack) d) (setf (car (pop branch-stack)) d)) (define-method (branch-distance (s compiler-state bytes branch-stack)) (and branch-stack (- (length bytes) (length (car branch-stack))))) (defun compile-forth-words (words &optional (d *the-dictionary*)) (let ( (s (make-compiler-state :words words)) ) (loop (let ( (w (scan s)) ) (if (null w) (return (reverse (compiler-state-bytes s))) (receive (cw type) (lookup-forth-word w d) (ecase type ((:ram :rom) (emit16 s cw)) (:byte (emit s 0 #x2A cw)) (:word (emit s 0 #x1F) (emit16 s cw)) (:system (error "Can't compile system word: ~S" w)) (:special (compile-special w cw s))))))))) (defun compile-special (w cw s) (case w (begin (mark-branch s)) (do (emit16 s cw) (mark-branch s)) ((end loop +loop) (emit16 s cw) (let ( (d (branch-distance s)) ) (cond ( (null d) (error "Unmatched loop end.") ) ( (> d #xFE) (error "Loop body too large") ) (t (emit s (logand #xFF (- d))))))) (if (emit16 s cw) (emit s 'offset) (mark-branch s)) (else (emit16 s cw) (emit s 'offset) (let ( (d (branch-distance s)) ) (if (null d) (error "Unmatched ELSE")) (resolve-branch s (1+ d))) (mark-branch s)) (then (let ( (d (branch-distance s)) ) (if (null d) (error "Unmatched THEN")) (resolve-branch s (1+ d)))) (\: (emit16 s cw) (scan s)))) (defvar *special-forth-words* '(if then else begin end do loop +loop \:)) (defun lookup-forth-word (word dictionary) (let* ( (entry (find-entry-by-name dictionary word)) (addr (and entry (forth-word-address entry))) ) (tcond ( (member word *special-forth-words*) (values addr :special) ) ( addr (values addr (if (>= addr #x4000) :ram :rom) (forth-word-size entry)) ) ( (not (fixnump word)) (error "Can't find definition of ~S" word) ) ( (<= 0 word 255) (values word :byte) ) ( (<= (abs word) #xFFFF) (values (logand word #xFFFF) :word) ) (t (error "Can't compile ~S" word))))) (defun compile-forth (s &optional (d *the-dictionary*)) (if (stringp s) (setq s (parse-forth s))) (if (neq (first s) '\:) (compile-forth-words s) (fcompile (make-forth-word (second s) :source s) d))) ;;;;;;;;;;;;;;;;;; ;;; ;;; GLL specific stuff ;;; (defvar *gll-dictionary*) (require "ram source") (require "ram image") (require "rom image") (defvar *gll-ram-index*) (defvar *gll-rom-index*) (with-open-file (f "gll;dictionary") (setf *gll-ram-index* (read-dictionary f)) (unless (= (length *gll-ram-index*) 54) (warn "Unexpected number of entries in GLL RAM index.")) (setf *gll-rom-index* (read-dictionary f)) (unless (= (length *gll-rom-index*) 229) (warn "Unexpected number of entries in GLL ROM index."))) (defun find-gll-source (word) (find word *gll-source* :key #'second)) (defun build-gll-dictionary () (setq *gll-dictionary* (make-dictionary :gll)) (walkcdr (fn (w) (if (cdr w) (install (make-forth-word (caar w) :address (cdar w) :bytes (subseq *gll-rom-image* (cdar w) (cdadr w)) :size (- (cdadr w) (cdar w))) *gll-dictionary*))) *gll-rom-index*) (walkcdr (fn (w) (if (cdr w) (install (make-forth-word (caar w) :address (cdar w) :source (find-gll-source (caar w)) :bytes (subseq *gll-ram-image* (- (cdar w) #x4000) (- (cdadr w) #x4000)) :size (- (cdadr w) (cdar w))) *gll-dictionary*))) *gll-ram-index*) (setf *the-dictionary* *gll-dictionary*)) (defun compiler-test () (dolist (w (dictionary-entries *gll-dictionary*)) (with-slots (name source address bytes) w (if source (let* ( (test-image (compile-forth-words source)) (diff (first-difference bytes test-image)) ) (when diff (progn (format t "~&~%*** Compiler results for ~S do not match RAM image." name) (format t "~&First difference is at #x~X" (+ address diff)) (pprint-bytes test-image address) (format t "~&Should be:") (pprint-bytes (nthcdr diff bytes) (+ address diff))))))))) (defun first-difference (l1 l2) (iterate loop ( (l1 l1) (l2 l2) (n 0) ) (cond ( (and (null l1) (null l2)) nil ) ( (or (null l1) (null l2) (not (eql (car l1) (car l2)))) n ) (t (loop (cdr l1) (cdr l2) (1+ n)))))) (defun compile-patch (s &optional (d *the-dictionary*)) (let ( (w (compile-forth s d)) ) (with-slots (name size bytes) w (let ( (old-w (find-entry-by-name d name)) ) (when (null old-w) (error "Couldn't find old definition of ~S" name)) (let ( (old-bytes (forth-word-bytes old-w)) (old-size (forth-word-size old-w)) (address (forth-word-address old-w)) ) (setf (forth-word-address w) address) (format t "~&Patch for ~S:" name) (when (> size old-size) (format t "~&***** Patch will overflow original memory slot! ******") (format t "~&Patch is ~S bytes long. ~S bytes available." size old-size)) (let ( (diff (first-difference bytes old-bytes)) ) (if (null diff) (format t "~&Patch is identical to original code.") (pprint-bytes (nthcdr diff bytes) (+ diff address))))))) w)) ;;;;;;;;;;;;;;; ;;; ;;; Utilities ;;; (defun pprint-bytes (bytes &optional (addr 0)) (iterate loop1 () (format t "~&~4,'0X " (logand addr #xFFF8)) (dotimes (i (logand addr 7)) (format t " ")) (iterate loop2 () (when bytes (format t " ~2,'0X" (pop bytes)) (incf addr) (when (not (zerop (logand addr 7))) (loop2)) (when bytes (loop1)))))) #| ;;; SDSPIN patches ;;; uniform sampling, self-modifying hack: (compile-patch ": SDSPIN DUP 15 = IF 1ST-DSPVECTOR TS! THEN DUP 28 = IF ADDR-BUFFER DUP @ 20 + DUP 4CF8 > IF DROP 4800 THEN DUP ROT 2+ 20 MOVE ADDR-BUFFER ! THEN 1 430B +! FFFF 7 = IF OPTST 0 430B ! THEN DUP 0= IF MAT-LOAD 4FF0 C@ 20 - 2/ CMDPTR +! THEN ;") ;;; uniform sampling (compile-patch ": SDSPIN DUP 15 = IF 1ST-DSPVECTOR TS! THEN DUP 28 = IF ADDR-BUFFER DUP @ 20 + DUP 4CF8 > IF DROP 4800 THEN DUP ROT 2+ 20 MOVE ADDR-BUFFER ! THEN 1 46FE +! 46FE @ 0= IF OPTST -7 46FE ! THEN DUP 0= IF MAT-LOAD 4FF0 C@ 20 - 2/ CMDPTR +! THEN ;") ;;; uneven sampling (except for 7 and 13 samples per RIM) (defmacro with-period (period event) (if (<= period 1) event (lisp->forth `(if (= (mod (dup) ,period) ,(1- period)) ,event)))) (defmacro main-event-loop (&body body) `(\: SDSPIN DUP #x15 = IF 1ST-DSPVECTOR TS! THEN DUP #x28 = IF ADDR-BUFFER DUP @ #x20 + DUP #x4CF8 > IF DROP #x4800 THEN DUP ROT 2+ #x20 MOVE ADDR-BUFFER ! THEN ,@(mappend #'macroexpand body) DUP #x5A = IF MAT-LOAD #x4FF0 C@ #x20 - 2/ CMDPTR +! THEN \;)) (compile-patch (macroexpand '(main-event-loop (with-period 7 (optst))))) |# -------------------------------------------------------------------------------- /lisp->forth: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) (require 'utilities) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; LISP->FORTH - by Erann Gat ;;; (defun mappend1 (fn mapped-arg &rest unmapped-args) (apply #'append (apply #'map1 fn mapped-arg unmapped-args))) (defvar *forth-synonyms*) (setq *forth-synonyms* '((print "."))) (defun lisp->forth (expr &optional env) (if (atom expr) (atom->forth expr env) (case (car expr) ( (if) (let ( (condition (lisp->forth (second expr) env)) (true-case (lisp->forth (third expr) env)) (false-case (lisp->forth (fourth expr) env)) ) (if false-case `(,@condition IF ,@true-case ELSE ,@false-case THEN) `(,@condition IF ,@true-case THEN))) ) ( (until) (let ( (condition (lisp->forth (second expr))) (body (mappend1 #'lisp->forth (cddr expr) env)) ) `(BEGIN ,@body ,@condition UNTIL)) ) ( (while) (let ( (condition (lisp->forth (second expr))) (body (mappend1 #'lisp->forth (cddr expr) env)) ) `(BEGIN ,@condition WHILE ,@body REPEAT)) ) ( (dotimes) (let* ( (var (first (second expr))) (cnt (lisp->forth (second (second expr)))) (cnt2 (lisp->forth (third (second expr)))) (body (mappend1 #'lisp->forth (cddr expr) (cons var (cons nil env)))) ) (if cnt2 `(,@cnt2 ,@cnt DO ,@body LOOP) `(,@cnt 0 DO ,@body LOOP))) ) ( (setf) (let ( (place (second expr)) (value (lisp->forth (third expr))) ) (if (not (symbolp place)) (error "Can't set ~S" place) `(,@value ,place !))) ) ( (let) (let* ( (initforms (mappend1 #'(lambda (initform) (append (lisp->forth (second initform) env) (list '>R))) (second expr))) (n (length (second expr))) (body (mappend1 #'lisp->forth (cddr expr) (append (reverse (mapcar #'car (second expr))) env))) ) (append initforms body (list (+ 2 (* n 2)) 'NRDROP))) ) ( (lambda) (append (n-of '>R (length (second expr))) (mappend1 #'lisp->forth (cddr expr) (append (second expr) env)) (list (+ 2 (* (length (second expr)) 2)) 'NRDROP)) ) ( (define) `(":" ,(second expr) ,@(lisp->forth `(lambda ,@(cddr expr))) ";")) (otherwise (iterate loop ( (args (reverse (cdr expr))) (result (or (cdr (assoc (car expr) *forth-synonyms*)) (list (car expr)))) (env env) ) (if args (loop (cdr args) (append (lisp->forth (car args) env) result) env) result)))))) (defun atom->forth (expr env) (cond ( (null expr) nil ) ( (fixnump expr) (list expr) ) ( (numberp expr) (error "Illegal value: ~S" expr) ) (t (let ( (n (position expr env)) ) (if n (list (+ n 2) 'RPICK) (list expr '@)))))) #| (lisp->forth '(define rotate (theta bxsc bysc bzsc) (let ( (sintheta (sin theta)) (costheta (cos theta)) ) (set bxi (- (* bxsc costheta) (* bysc sintheta))) (set byi (+ (* bxsc sintheta) (* bysc costheta))) (set bzi bzsc)))) ; requires infix parser (lisp->forth '(define rotate (theta bxsc bysc bzsc) (let ( (sintheta (sin theta)) (costheta (cos theta)) ) #{ bxi = bxsc*cos(theta) - bysc*sin(theta) } #{ byi = bxsc*sin(theta) + bysc*cos(theta) } #{ bzi = bzsc } ))) (lisp->forth '#{ xprime = x[i]*k + r[i]/k }) |# -------------------------------------------------------------------------------- /parcil 0.1a: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PARCIL - A Parser for C syntax In Lisp ;;; version 0.1a ;;; ;;; copyright (c) 1992 by Erann Gat, all rights reserved ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; ;;; This is a very preliminary release and almost certainly contains bugs. ;;; Please send bug reports and comments to: ;;; Erann Gat ;;; JPL MS 525-3660 ;;; 4800 Oak Grove Drive ;;; Pasadena, CA 91109 ;;; (818) 306-6176 ;;; gat@robotics.jpl.nasa.gov or gat@aig.jpl.nasa.gov ;;; ;;; Revision history: ;;; v0.1a - Initial release ;;; ;;; PARCIL is a parser for a subset of the syntax for the C programming ;;; language. PARCIL is written in Common Lisp, making it potentially ;;; a useful building block for user interfaces for people who do not ;;; like prefix syntax. ;;; ;;; PARCIL is a recursive descent parser optimized to parse C. This makes it ;;; fairly brittle and difficult to modify. However, it does make it fairly ;;; fast, and it also allows the parser to deal with lots of C idiosyncrasies ;;; which are difficult to implement in general-purpose parsers, e.g. operator ;;; precedence, prefix and postfix operators, etc. ;;; ;;; NOTE: While PARCIL is designed to be a component in user interfaces for ;;; people who are not regular LISP users, it is probably not usable for that ;;; purpose as-is. There are two major problems with it. First, it is incomplete. ;;; It currently includes no support for any high-level C construct (i.e. it ;;; implements the syntax described in the original Kernighan and Richie book, ;;; section 18.1). The second problem is that PARCIL is so faithful to C syntax ;;; that it can easily fool the unwary into believing that they are writing C code ;;; when in fact they are writing LISP code, only with a different syntax. You ;;; need a fairly deep understanding of the distinction between syntax and ;;; semantics in order to use PARCIL. The main stumbling block to its use by ;;; beginners is that PARCIL does very little error checking. Thus, many errors ;;; which should be detected by PARCIL are passed on and caught by LISP. The ;;; resulting error messages can be very cryptic if you don't know what's going ;;; on. ;;; ;;; PHILOSOPHICAL RANT: Infix notation is a blight on the intellectual landscape. ;;; It is confusing to read, difficult to parse, and to avoid ambiguity must rely ;;; on precedence rules that are hopelessly obscure. People who prefer infix ;;; notation do so only because they have been indoctrinated to it since ;;; childhood and do not have the intellectual strength to break free. It is ;;; far better to convince people to use prefix notation, with its easy to read ;;; and easy to parse, unambiguous syntax, than to provide them with crutches ;;; such as PARCIL which perpetuate such evils as infix, prefix and postfix unary ;;; operators. (In C, "x++*++****y" is a legal expression, and the first * doesn't ;;; mean the same thing as all the other *'s.) Nevertheless, I acknowledge the ;;; reality that infix and C are here to stay, and that is why I have written ;;; PARCIL. But that doesn't mean I have to like it. ;;; ;;; USER'S GUIDE: ;;; ;;; The top-level function is called PARCIL. Pass a string consisting of a C ;;; expression (not a command!) to PARCIL and it will return a parsed version. ;;; For example: ;;; ;;; (parcil "x=y*sin(pi/2.7)") ==> (SETF X (* Y (SIN (/ PI 2.7)))) ;;; ;;; PARCIL supports all syntax defined in section 18.1 of the original Kernighan ;;; and Ritchie book, plus all C numerical syntax including floats and radix ;;; syntax (i.e. 0xnnn, 0bnnn, and 0onnn). In addition, PARCIL supports multiple ;;; array subscripts. There is also a preliminary version of {} blocks, but it ;;; doesn't quite do the right thing. Parcil also allows strings to be delimited ;;; using single quotes as well as double quotes (but you must use the same type ;;; to close the string as you did to open it). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Program starts here ;;; ;;; Misc. utilities ;;; (defmacro iterate (name args &rest body) `(labels ((,name ,(mapcar #'car args) ,@body)) (,name ,@(mapcar #'cadr args)))) (defmacro while (condition &body body) `(iterate loop () (if ,condition (progn ,@body (loop))))) ;;; Crufty pseudo-text-file interface. Don't let impressionable young minds ;;; see this code. ;;; (defvar *the-string* "") (defvar *the-pointer* 0) (defun parse-init (s) (setq *the-string* s) (setq *the-pointer* 0)) (defun eof? (&optional (offset 0)) (>= (+ *the-pointer* offset) (length *the-string*))) (defun peek (&optional (offset 0)) (if (eof? offset) nil (char *the-string* (+ *the-pointer* offset)))) (defun readc () (prog1 (peek) (incf *the-pointer*))) ;;; The PARCIL tokenizer. (FSA? What's an FSA?) ;;; (defun letter? (c) (and (characterp c) (or (char<= #\a c #\z) (char<= #\A c #\Z)))) (defun digit? (c) (and (characterp c) (char<= #\0 c #\9))) (defun ident? (thing) (and thing (symbolp thing) (letter? (char (symbol-name thing) 0)))) (defvar *binary-ops* '((\. ->) (* / %) (+ -) (<< >>) (< > <= >=) (== !=) (&) (^) (\|) (&&) (\|\|) (= += -= *= /= %= &= ^= \|= >>= <<=))) ;;; Any binary operator in this alist will be renamed in the parsed version. (defvar *binop-alist* '((\. . struct-ref) (= . setf) (% . mod) (<< . ashl) (>> . ashr) (& . logand) (^ . logxor) (\| . logior) (&& . and) (\|\| . or))) (defun binop? (s) (member s *binary-ops* :test #'member)) (defun assignop? (s) (member s (car (last *binary-ops*)))) (defun priority (s) (let ( (p (position s *binary-ops* :test #'member)) ) (and p (- 40 p)))) (defun translate-binop (op) (or (cdr (assoc op *binop-alist*)) op)) (defun eat-spaces () (do () ( (not (eql (peek) #\Space)) ) (readc))) (defun syntax-error () (error "Syntax error near ~S" (subseq *the-string* (max 0 (1- *the-pointer*))))) (defun parse-fixnum (&optional (base 10)) (multiple-value-bind (n cnt) (parse-integer *the-string* :start *the-pointer* :radix base :junk-allowed t) (setq *the-pointer* cnt) (if (not (numberp n)) (syntax-error)) n)) (defun parse-atom () (eat-spaces) (if (eof?) nil (let ( (c (peek)) ) (cond ( (letter? c) (parse-symbol) ) ( (eql c #\0) (if (letter? (peek 1)) (parse-radix-integer) (parse-number)) ) ( (digit? c) (parse-number) ) ( (or (eql c #\") (eql c #\')) (parse-string c) ) (t (parse-operator)))))) (defun parse-symbol () (intern (string-upcase (with-output-to-string (s) (while (let ( (c (peek)) ) (and c (or (letter? c) (digit? c) (eql c #\_)))) (princ (readc) s)) s)))) (defun parse-radix-integer () (readc) (parse-fixnum (ecase (readc) (#\x 16) (#\o 8) (#\b 2)))) (defun parse-number () (let* ( (n1 (parse-fixnum)) (c (peek)) ) (prog ( (d 0.1) ) (if (eql c #\.) (go decimal)) (if (or (eql c #\e) (eql c #\E)) (go expt)) (return n1) decimal (readc) (let ( (c (peek)) ) (when (digit? c) (incf n1 (* d (- (char-code c) (char-code #\0)))) (setf d (/ d 10)) (go decimal)) (if (or (eql c #\e) (eql c #\E)) (go expt)) (return n1)) expt (readc) (let ( (e (parse-fixnum)) ) (return (* n1 (expt 10 e))))))) (defun parse-string (terminator) (readc) (with-output-to-string (s) (iterate loop () (let ( (c (readc)) ) (when (eql c terminator) (return-from loop s)) (princ c s) (loop))))) (defun parse-operator () (let* ( (c (intern (string (readc)))) (s (intern (format nil "~A~A" c (peek)))) ) (cond ( (member s '(<< >>)) (readc) (if (eql (peek) #\=) (intern (format nil "~A~A" s (readc))) s) ) ( (member s '(++ -- << >> -> <= >= != == && += -= *= /= %= &= ^= \|= \|\|)) (readc) s ) (t c)))) ;;; Crufty interface to the tokenizer. ;;; (defvar *next*) (defun scan () (setf *next* (parse-atom))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; The recursive-descent parser. Look Ma, no tables! ;;; (defun parse-expression (&optional (priority -1)) (iterate loop ( (result (parse-term)) ) (let ( (op (translate-binop *next*)) (new-priority (priority *next*)) ) (cond ( (assignop? *next*) (scan) (list op result (loop (parse-term))) ) ( (and (binop? *next*) (> new-priority priority)) (scan) (loop (list op result (parse-expression new-priority))) ) (t result))))) (defun parse-arglist (&optional (terminator '\)) (separator '\,)) (iterate loop () (cond ( (null *next*) (error "Missing ~S" terminator) ) ( (eq *next* terminator) (scan) nil ) (t (let ( (arg1 (parse-expression)) ) (unless (or (eq *next* separator) (eq *next* terminator)) (syntax-error)) (if (eq *next* separator) (scan)) (cons arg1 (loop))))))) ;;; Any prefix unary operator included in this table will be renamed in the parsed ;;; version. (Postfix ++ and -- are handled specially, in PARSE-TERM.) (defvar *unary-op-alist* '((* . deref) (& . address-of) (- . -) (! . not) (~ . lognot) (++ . incf) (-- . decf))) ;;; This function parses what K&R call primary expressions. These include numbers, ;;; variables, structure references, array references, and all unary operators. ;;; Parsing of curly brackets is also stuck in here, though it probably shouldn't be. ;;; The weird precedence rules make this a fairly hariy and brittle piece of code. ;;; (defun parse-term () (iterate loop ( (term (prog1 *next* (scan))) ) (cond ( (numberp term) term ) ( (assoc term *unary-op-alist*) (list (cdr (assoc term *unary-op-alist*)) (parse-term)) ) ( (eq term '\( ) (cons 'progn (parse-arglist)) ) ( (eq term '{) (list* 'let '() (parse-arglist '} '\;)) ) ( (eq *next* '\( ) (scan) (loop (cons term (parse-arglist))) ) ( (eq *next* '\[ ) (scan) (loop `(aref ,term ,@(parse-arglist ']))) ) ( (eq *next* '\.) (loop `(struct-ref ,term ,(prog1 (scan) (scan)))) ) ( (eq *next* '->) (loop `(-> ,term ,(prog1 (scan) (scan)))) ) ( (eq *next* '++) (scan) (loop `(prog1 ,term (incf ,term))) ) ( (eq *next* '--) (scan) (loop `(prog1 ,term (decf ,term))) ) (t (if (and (atom term) (not (ident? term))) (syntax-error)) term)))) ;;;;;;;;;;;;;;;;; ;;; ;;; The top level ;;; (defun parcil (s) (parse-init s) (scan) (prog1 (parse-expression) (if *next* (syntax-error)))) ; If there's stuff left over something went wrong. ;;; Reader hook (optional) ;;; Evaluating the following forms will allow you to type C-like expressions directly ;;; at the lisp reader and have them evaluated, e.g.: ;;; ;;; ? #{ ( x=1,y=2,print(x+y),sin(pi/2) ) } ;;; 3 ;;; 1.0 ;;; ? (defun |#{-reader| (stream char arg) (declare (ignore char arg)) (parcil (with-output-to-string (s) (loop (let ( (c (read-char stream)) ) (if (eql c #\}) (return s) (princ c s))))))) (set-dispatch-macro-character #\# #\{ #'|#{-reader|) -------------------------------------------------------------------------------- /ram image: -------------------------------------------------------------------------------- 1 | (defvar *gll-ram-image*) (setq *read-base* #x10) (length (setq *gll-ram-image* '( 4000 40 2 C0 46 C4 0 40 0 4008 4 2 4 2 4 2 4 2 4010 4 2 4 2 4 2 4 2 4018 4 2 4 2 4 2 4 2 4020 4 2 4 2 4 2 4 2 4028 0 A7 0 2 0 A7 0 3 4030 0 A7 4E E5 0 A7 4E E4 4038 0 A7 7F FF 0 B0 66 0 4040 B0 68 0 B0 8A 0 B0 8C 4048 0 A7 4C C4 0 A7 0 6 4050 0 B0 9C 40 55 EE 4E B8 4058 4E A8 4E B7 4E A7 DF 0 4060 CA 0 2A 55 2 43 0 76 4068 17 0 1F 4E E0 0 1F 4C 4070 F0 40 4C 1 3 0 1F 4C 4078 EB 9 C3 1 95 40 53 0 4080 D5 0 CA 9 FA 0 E9 1 4088 95 1 85 1 95 0 1F 28 4090 ED 6 20 0 F6 1 71 1 4098 AF 0 D5 0 CA 4 44 0 40A0 2A 1A 40 81 4 47 0 2A 40A8 10 40 81 4 4A 0 2A 12 40B0 40 81 4 4D 0 2A 14 40 40B8 81 0 D5 0 CA 9 FA 0 40C0 E9 1 95 1 85 1 95 0 40C8 1F 20 0 6 20 0 F6 1 40D0 71 1 AF 0 D5 0 CA 4 40D8 53 0 2A 1E 40 BB 4 59 40E0 0 2A 16 40 BB 4 5C 0 40E8 2A 1C 40 BB 4 56 0 2A 40F0 18 40 BB 0 D5 0 CA 1 40F8 85 0 2A F 0 DC 0 2A 4100 5 2 43 0 76 7 0 2A 4108 93 0 84 4 0 2A 6C 1 4110 85 B 29 1 71 0 2A F0 4118 0 DC 0 2A 50 2 43 0 4120 76 D 0 2A 55 1 71 2 4128 5D B 29 0 84 3 1 6C 4130 0 D5 0 CA 4 B 0 8A 4138 0 2A 4 40 F5 4 E 0 4140 8A 0 2A 3 40 F5 0 D5 4148 0 CA 2 75 1 85 0 E9 4150 1 71 0 33 1 60 1 F1 4158 1 A3 40 28 0 46 F6 1 4160 6C 0 D5 0 CA 0 1F 4E 4168 E1 1 85 0 2A 4 1 3 4170 2 5D 2 5D 0 1F 4E F4 4178 1 95 1 85 1 A3 2 5D 4180 0 1F 4E F2 1 95 1 85 4188 1 A3 2 5D 1 DB 40 48 4190 1 95 6 58 1 E6 6 70 4198 0 D5 0 CA 0 1F 48 0 41A0 40 48 1 60 1 95 0 1F 41A8 48 0 40 4C 1 3 1 A3 41B0 0 1F 4C F0 41 63 0 D5 41B8 0 CA 4 41 0 8A 0 2A 41C0 55 2 43 0 76 42 0 1F 41C8 4E E2 1 95 40 3F 1 95 41D0 0 DC 1 C0 0 76 31 40 41D8 48 1 95 1 60 40 4C 0 41E0 E9 1 60 40 48 1 A3 2 41E8 2B 1 85 40 4C 41 48 40 41F0 4C 1 3 40 48 1 95 0 41F8 1F 4C AF 2 37 0 76 8 4200 0 2A AA 4 41 0 96 0 4208 D5 0 B0 82 0 CA 0 2A 4210 80 42 9 1 AF 42 9 1 4218 95 1 60 0 1F 10 0 2 4220 37 0 76 F 1 6C 2 2B 4228 42 9 0 2A 4 41 48 0 4230 84 21 1 DB 1 F1 0 1F 4238 40 0 0 E9 1 60 0 2A 4240 80 4 74 1 71 1 E6 0 4248 2A 80 4 74 42 9 2 5D 4250 6 70 0 D5 0 CA 0 1F 4258 4E 80 1 95 0 1F A5 A5 4260 2 43 0 76 40 0 1F 4E 4268 A6 1 95 0 1F A5 A5 2 4270 43 0 76 31 0 1F 4E 82 4278 1 95 4 8 1 A3 0 1F 4280 4E 84 40 3C 0 2A 4 1 4288 3 0 1F 4E 88 4 23 0 4290 2A 1E 1 3 2 2B 0 1F 4298 4E 80 1 A3 2 2B 0 1F 42A0 4E A6 1 A3 0 D5 0 CA 42A8 D 1F 1 95 0 1F 40 6 42B0 1 95 6 20 D 1F 1 A3 42B8 D 46 0 D5 0 CA 1 60 42C0 0 2A 15 2 43 0 76 5 42C8 4 3B 41 63 1 60 0 2A 42D0 28 2 43 0 76 2C 40 50 42D8 1 60 1 95 0 2A 20 0 42E0 E9 1 60 0 1F 4C F8 2 42E8 37 0 76 7 1 6C 0 1F 42F0 48 0 1 60 2 B0 2 5D 42F8 0 2A 20 1 3 40 50 1 4300 A3 1 60 0 2A 34 2 43 4308 0 76 3 42 C 1 60 0 4310 2A 42 2 43 0 76 5 4 4318 6B 41 63 1 60 0 2A 5A 4320 2 43 0 76 16 41 B8 42 4328 54 0 1F 4F F0 0 8A 0 4330 2A 20 0 F6 E 3A 4 71 4338 1 AF 0 D5 0 CA 40 34 4340 0 8A 1 60 0 2A 5B 2 4348 43 0 76 3C 1 6C 0 1F 4350 75 0 0 8A 4 5F 0 96 4358 4 1D 0 8A 2 3F 2 37 4360 0 76 10 4 1D 0 8A 2 4368 3F 0 F6 4 1D 0 96 0 4370 84 D 5 7D 5 65 5 52 4378 2 2B 4 1D 0 96 E A4 4380 42 A6 4 B 0 84 9 42 4388 BC 2 75 4 B 0 E9 1 4390 95 6 30 1 A3 0 D5 0 4398 CA 0 1F 40 0 4 23 40 43A0 2C 41 48 2 2B 4 2C 40 43A8 2C 41 48 4 35 2 2B 1 43B0 85 0 2A 9 41 48 40 38 43B8 1 85 1 A3 0 2A 8 0 43C0 E9 40 38 1 85 1 A3 0 43C8 2A 8 0 E9 40 38 1 71 43D0 1 A3 0 D5 0 CA 2 2B 43D8 4 B 0 2A 5A 41 48 43 43E0 97 0 1F 48 0 40 50 1 43E8 A3 0 D5 0 CA 9 BA 1 43F0 95 0 1F 1 6C 2 5D 2 43F8 43 2 4B 0 76 2D 43 D4 4400 0 2A 8 4 5 0 96 2 4408 2B 40 3F 1 A3 0 1F 8 4410 0 40 3C 1 A3 2 3F 4 4418 8 1 A3 0 1F AA 5A 4 4420 B 1 A3 0 2A AA 4 1D 4428 1 A3 0 D5 0 CA 5 B9 4430 1 85 1 85 3 3A 1 85 4438 1 85 3 3A 1 71 1 6C 4440 0 D5 0 CA 4 29 1 95 4448 44 2C 1 71 4 26 1 95 4450 44 2C 2 B0 4 23 1 95 4458 44 2C 0 D5 0 CA 1 DB 4460 9 C3 1 95 4 2C 6 88 4468 44 42 1 F1 6 70 4 35 4470 1 F1 7 44 1 71 2 B0 4478 1 E6 6 70 0 D5 0 CA 4480 1 DB 1 DB 1 F1 5 B9 4488 1 E6 2 63 1 F1 1 95 4490 5 B9 3 3A 1 60 1 C0 4498 0 E9 1 E6 1 AF 1 6C 44A0 0 D5 0 CA 1 DB 1 71 44A8 1 F1 1 95 0 F6 5 B9 44B0 1 60 1 C0 0 E9 1 E6 44B8 1 AF 1 6C 0 D5 0 CA 44C0 40 3C 1 95 1 71 44 7E 44C8 0 D5 0 CA 40 3C 1 95 44D0 1 71 44 A2 0 D5 0 CA 44D8 40 30 0 8A 0 2A 1C 2 44E0 2F 0 76 1A 4 65 6 58 44E8 4 68 44 CA 4 68 40 4C 44F0 0 E9 44 CA 4 68 0 2A 44F8 C 0 E9 44 CA 0 D5 0 4500 CA 1 DB 1 60 D 34 1 4508 95 6 20 1 F1 44 CA D 4510 37 1 95 6 20 1 E6 2 4518 5D 44 CA 0 D5 0 CA D 4520 DA 6 58 4 68 2 5D 44 4528 FF 4 68 0 2A 8 0 E9 4530 44 FF 4 68 0 2A E 0 4538 E9 44 FF 0 D5 0 CA 8 4540 31 1 71 0 F6 1 DB 0 4548 E9 1 E6 0 D5 0 CA D 4550 E2 6 58 D 3A 1 95 D 4558 3D 1 95 45 3D 0 D5 0 4560 CA 40 48 1 95 1 DB 1 4568 F1 44 BE 1 F1 6 4A 44 4570 BE 1 E6 6 50 44 BE 0 4578 D5 0 CA 45 4D 4 38 0 4580 8A 0 2A 55 2 43 0 76 4588 1E D E2 6 70 D DA 6 4590 58 D 34 1 95 D 37 1 4598 95 45 3D D DA 6 70 D 45A0 E2 6 58 0 84 3 45 1D 45A8 45 5F 0 D5 0 CA 4 38 45B0 0 8A 0 2A 55 2 43 0 45B8 76 13 D ED 6 58 D 40 45C0 1 95 D 43 1 95 45 3D 45C8 D ED 6 70 0 D5 0 CA 45D0 E 62 1 D0 0 79 FA 0 45D8 D5 0 CA 40 30 0 8A 0 45E0 2A 9 2 43 0 79 F5 2 45E8 3F 40 34 0 8A 0 E9 40 45F0 34 0 96 0 D5 0 CA A 45F8 F7 43 EB 0 1F D 11 2 4600 5D 9 B7 1 A3 0 1F 1 4608 6C 2 5D 9 BA 1 A3 0 4610 1F 40 5F 2 5D 9 C0 1 4618 A3 0 1F 41 9A 2 5D 9 4620 BD 1 A3 0 2A 20 0 1F 4628 4F F0 0 96 2 2B 0 1F 4630 4E 40 1 A3 2 2B 0 1F 4638 4E 20 1 A3 E 89 0 2A 4640 20 0 1F 4F F0 0 96 2 4648 2B 0 1F F FF 4 74 40 4650 42 1 A3 0 1F 40 0 0 4658 1F 6 FF 4 74 40 45 1 4660 A3 2 2B 4 71 1 A3 0 4668 1F 4C B0 40 48 1 A3 41 4670 32 45 D9 40 30 0 8A 0 4678 2A 13 2 37 0 76 30 45 4680 D9 40 4C E 6B D DA 44 4688 5C 40 9B 40 D5 D BE D 4690 DA 6 58 4 65 6 70 45 4698 CE 40 4C E 6B D E2 44 46A0 5C 45 79 45 CE D ED 44 46A8 5C 45 AC 0 84 A 2 2B 46B0 D DA 0 2A 9 41 48 43 46B8 3C 44 D6 2 2B 0 79 B4 46C0 0 D5 46 C4 F8 C B1 F8 46C8 79 A1 F8 4D B5 F8 50 A5 46D0 F8 4E B6 F8 0 A6 B7 B8 46D8 A8 AC BF F8 47 BC F8 4D 46E0 B2 BE F8 F0 A2 F8 40 AE 46E8 F8 6 AF A7 F8 45 BD F8 46F0 F7 AD DF 0 0 0 0 0 46F8 0 0 0 0 0 0 0 0))) (setq *read-base* #xA) (length (setq *gll-ram-image* (progn (iterate loop ( (image (cdr *gll-ram-image*)) ) (when image (setf (nthcdr 8 image) (nthcdr 9 image)) (loop (nthcdr 8 image)))) (cdr *gll-ram-image*)))) -------------------------------------------------------------------------------- /ram source.lisp: -------------------------------------------------------------------------------- 1 | (defvar *gll-source* '((\: SNAP 85 = IF 20192 19696 6 MOVE 19691 VDATA @ SNPST THEN \;) (\: FI20 RD5 + @ OVER @ 10477 S* - SWAP +! \;) (\: SF20 VRAM 26 FI20 V12 16 FI20 V10 18 FI20 V-12 20 FI20 \;) (\: FI5 RD5 + @ OVER @ 8192 S* - SWAP +! \;) (\: SF5 GND 30 FI5 1-SPARE 22 FI5 2-SPARE 28 FI5 T-ELEC 24 FI5 \;) (\: TTEXEC OVER 15 AND 5 = IF 147 ELSE 108 THEN OVER EXCMND SWAP 240 AND 80 = IF 85 SWAP 2+ EXCMND ELSE DROP THEN \;) (\: PINIT SGOUT C@ 4 TTEXEC SGINB C@ 3 TTEXEC \;) (\: B! 2* OVER + SWAP DO DUP I ! 2 +LOOP DROP \;) (\: TS! 20193 OVER 4 MOVE 2+ 2+ 20212 @ OVER ! 2+ 20210 @ OVER ! 2+ V! \;) (\: OPT-START 18432 CUR-STOR DUP @ 18432 4 MOVE ! 19696 TS! \;) (\: OPTST DATA-BUFFER-STATUS C@ 85 = IF 20194 @ AVER\# @ AND 0= IF CUR-STOR @ DUP 6 + DUP CUR-STOR ! 0 OVER 6 B! 6 MOVE CUR-STOR @ 19631 > IF 170 DATA-BUFFER-STATUS C! THEN THEN THEN \;) (\: CKSUM-GEN 128 CKSUM-PTR +! CKSUM-PTR @ DUP 4096 > IF DROP 0 CKSUM-PTR 4 B! ELSE 128 CKSUM CKSUM-PTR 2+ V! THEN \;) (\: MAT-LOAD 20096 @ 42405 = IF 20134 @ 42405 = IF 20098 @ SCF ! 20100 DSP-AVER-CONSTANT 4 MOVE 20104 1GAIN 30 MOVE 0 20096 ! 0 20134 ! THEN THEN \;) (\: CKDANGLE SP-DELTA @ 16390 @ S* SP-DELTA ! CKDANGLE \;) (\: SDSPIN DUP 21 = IF 1ST-DSPVECTOR TS! THEN DUP 40 = IF ADDR-BUFFER DUP @ 32 + DUP 19704 > IF DROP 18432 THEN DUP ROT 2+ 32 MOVE ADDR-BUFFER ! THEN DUP 52 = IF CKSUM-GEN THEN DUP 66 = IF 2ND-DSPVECTOR TS! THEN DUP 90 = IF OPTST MAT-LOAD 20464 C@ 32 - 2/ CMDPTR +! THEN \;) (\: SETSUB M91 C@ DUP 91 = IF DROP 29952 C@ HD-PARITY C! PFLIP C@ 1 > IF PFLIP C@ 1 - PFLIP C! ELSE FLIPPER POWER OFF 0 PFLIP C! THEN CKCOMM CKDANGLE SGOUT ELSE SDSPIN 2* SGOUT + THEN @ BUFFER-ADDRESS ! \;) (\: PARESET 16384 1GAIN 3 B! 0 OF1 3 B! RM1 0 OVER 9 B! \1.0 OVER ! 8 + \1.0 OVER ! 8 + \1.0 SWAP ! \;) (\: MAT-RESET 0 SGOUT 90 B! PARESET 18432 ADDR-BUFFER ! \;) (\: ?MEMORY DEFAULT-SYS @ |['| DROP 2+ = NOT IF MAT-RESET 8 FLTIM C! 0 AVER\# ! 2048 DSP-AVER-CONSTANT ! 1 SCF ! 43610 SGOUT ! 170 PFLIP ! THEN \;) (\: SCALE H32 OVER OVER E+ OVER OVER E+ SWAP DROP \;) (\: SC/RT 3GAIN @ SCALE SWAP 2GAIN @ SCALE ROT 1GAIN @ SCALE \;) (\: OR! V! \;) (\: FILT MINUS I @ H32 E+ DUP 0= + R> +! DROP \;) (\: FIL256 DSP-AVER-CONSTANT @ SWAP FILT \;) (\: FIL! DSP-AVER-CONSTANT @ SWAP FILTF \;) (\: AV-VEC INT-CNT C@ 28 < IF IBSV V@ OBSV FIL! OBSV 6 + FIL! OBSV 12 + FIL! THEN \;) (\: CMPCAL 2+ FIL! \;) (\: STATE-V V1 V@ OBSV 2+ CMPCAL OBSV 8 + CMPCAL OBSV 14 + CMPCAL \;) (\: DSPN S-CPROD SWAP - \;) (\: 2DSP V2 V@ S2PHI @ C2PHI @ DSPN \;) (\: FLTDSPV CUR-STOR @ Z FIL256 \;) (\: DSP12 2DSP DSP-STAT C@ 85 = IF V2 V! V1 V@ S1PHI @ C1PHI @ DSPN V1 V! V2 V@ ELSE STATE-V THEN FLTDSPV \;) (\: DSP3 DSP-STAT C@ 85 = IF V3 V@ S3PHI @ C3PHI @ DSPN V3 V! THEN \;) (\: WAIT BEGIN RD4 0< END \;) (\: 9WAIT BEGIN INT-CNT C@ 9 = END 1 M91 C@ + M91 C! \;) (\: MAIN LCMNDS ?MEMORY |['| CKIDLE 2+ CPU-CTRL ! |['| DROP 2+ DEFAULT-SYS ! |['| SNAP 2+ SNAPSHOT ! |['| OPT-START 2+ OPTIMAL-AVER ! 32 20464 C! 0 20032 ! 0 20000 ! ENABLE-INT 32 20464 C! 0 4095 CKSUM ROM-CKSUM ! 16384 1791 CKSUM RAM-CKSUM ! 0 CMDPTR ! 19632 CUR-STOR ! PINIT 9WAIT BEGIN INT-CNT C@ 19 > IF 9WAIT 6 SE4 V1 OR! SF20 SF5 TRGFNS V1 V@ IBSV V! WAIT 6 SE4 V2 OR! DSP12 WAIT V3 OR! DSP3 ELSE 0 V1 9 B! THEN SETSUB AV-VEC 0 END \;) )) -------------------------------------------------------------------------------- /rom image: -------------------------------------------------------------------------------- 1 | (defvar *gll-rom-image*) (setq *read-base* #x10) (length (setq *gll-rom-image* '( 0 71 0 C0 4 2 D3 4D B9 4D A9 49 B3 49 A3 30 5 10 1D 0 0 14 4E B9 4E A9 29 29 1F 1F 1F 1F DF 0 20 21 4D BB 4D 2E 5E 9B 2E 5E DF 0 2C 4D 2E 5E 9F 30 2E 5E DF 0 35 4E BB 4E AB 4E BA 4E E2 22 73 9A 40 73 8B 73 9B 52 DF 0 4E FF 0 50 0 1 FF EE 13 50 E9 72 BB 72 12 E2 F4 AB 73 9B 74 BB 52 12 12 12 60 8B F7 22 9B 77 3B 6B 12 12 1D DF 22 22 ED 8D F4 70 AD 9D E9 74 BD DF 0 7C 0 0 7C FF 4E EE F1 1E 80 32 6D 1D DF 0 6D 0 0 6D FF 0 8C 4E BB E AB 90 B 5E 9F 2E 5E DF 0 98 4E BB 4E AB 1E 4E 5B DF A0 89 2E 5E 99 2E 5E DF 49 BB 49 2E 5E 9B 2E 5E DF B0 8C E9 F4 2E 5E 9C 2E 5E DF 8D 22 52 9D 22 52 49 C0 BD 49 AD 89 2E 5E 99 2E 5E DF 8D 22 52 9D 22 52 D0 99 BD 89 AD DF 0 D7 42 BD 42 AD DF 0 DE 4E BB E0 4E 1E EE F2 73 9B F2 5E DF 0 EB 4E BB 4E 1E EE F0 F4 73 9B 74 5E DF 0 F8 4E BB 4E 1E EE F5 73 9B 100 75 5E DF 1 5 4E BB 4E AB 4E B9 4E A9 4E BA 4E 110 AA 4A 59 19 2B 8B 3A 11 9B 3A 11 DF 1 1E F8 8 120 AA 9F BB 1E 4E F6 AB 1E EE 9B 3B 2D F4 76 BB 8B 130 76 AB 2A 8A 3A 29 8B 73 9B 5E DF 1 3D F8 8 AA 140 1E 4E BA 4E BB E FE AB 9A 5E EE 9B 7E BB F7 3B 150 52 BB 8B 7E AB 2A 8A 3A 4B 8B 73 9F 73 9B 73 DF 160 1 62 4E BB E 2E 2E 5E 9B 2E 5E DF 1 6E 1E 1E 170 DF 1 73 4E BB 4E AB 4E BA E AA 8B EE 73 9B 73 180 8A 73 9A 5E DF 1 87 1E 1E 4E BB E 2E 2E 2E 2E 190 5E 9B 2E 5E DF 1 97 4E BB E AB 4B BA 4B 5E 9A 1A0 2E 5E DF 1 A5 4E BB 4E AB 4E 5B 1B 4E 5B DF 1 1B0 B1 4E BB 4E AB 4E BA 4E 1B EB F4 73 9A 74 5B DF 1C0 1 C2 4E EE F1 32 C9 F8 1 FD 1 5E 9F 2E 5E DF 1D0 1 D2 4E FA 80 32 CB F8 1 30 CB 1 DD 4E BB 4E 1E0 22 52 9B 22 52 DF 1 E8 42 BB 42 2E 5E 9B 2E 5E 1F0 DF 1 F3 42 BB 2 22 2E 5E 9B 2E 5E DF 1 FF F8 200 74 BB F8 F0 AB F8 AB 5B 0 0 DF 2 D 42 BB 42 210 12 52 22 9B 52 22 22 DF 2 1A 12 12 12 12 12 2 220 2E 5E 22 2 22 22 22 22 2E 5E DF 0 A7 0 0 0 230 CA 0 F6 1 D0 0 D5 0 CA 1 71 2 2F 0 D5 0 240 A7 0 1 0 CA 0 F6 1 C0 0 D5 0 CA 1 C0 0 250 D5 2 53 F8 1 1E EE F4 73 9F 74 5E DF 2 5F F8 260 2 30 55 2 65 1E EE 9F F7 73 9F 77 5E DF 2 70 270 E FE 33 65 DF 0 CA 1 60 0 E9 0 D5 0 CA 1 280 60 0 76 3 1 60 0 D5 2 8A 9F 2E 5E DF 0 CA 290 1 85 1 85 2 2F 0 76 3 1 71 1 6C 0 D5 0 2A0 CA 1 85 1 85 2 37 0 76 3 1 71 1 6C 0 D5 2B0 0 CA 1 DB 1 71 1 E6 1 71 0 D5 0 CA 1 DB 2C0 1 60 1 F1 1 1C 1 71 0 1F FF 0 0 DC 2 88 2D0 1 E6 1 1C 0 E9 0 D5 0 CA 1 DB 1 F1 1 3B 2E0 1 71 2 88 1 6C 1 71 1 E6 1 3B 1 DB 0 E9 2F0 1 E6 0 D5 0 CA 1 DB 2 BC 1 E6 2 D8 1 71 300 0 D5 0 CA 2 F4 1 71 1 6C 0 D5 0 CA 1 DB 310 2 88 1 E6 2 D8 1 71 0 D5 0 CA 3 C 1 6C 320 0 D5 0 CA 2 BC 2 88 1 6C 0 D5 0 CA 3 C 330 1 71 1 6C 0 D5 3 38 1E DF 3 3C EE 72 A9 72 340 B9 72 AA 72 1E 1E 1E F4 73 8A 74 73 99 74 73 89 350 74 5E DF 0 CA 1 60 1 D0 0 76 8 0 1F FF FF 360 0 84 3 2 2B 0 D5 0 CA 1 DB 1 F1 1 A3 1 370 E6 2 5D 1 A3 0 D5 0 CA 1 DB 1 F1 2 5D 1 380 95 1 E6 1 95 0 D5 3 89 1E 1E 1E EE 9F F7 73 390 9F 77 73 9F 77 73 9F 77 5E DF 3 9C E FE 33 89 3A0 DF 0 CA 2 88 1 DB 2 88 1 85 1 DB 2 BC 1 3B0 E6 1 F1 1 85 1 DB 1 1C 0 E9 1 E6 0 1F FF 3C0 0 0 DC 2 88 1 E6 1 1C 0 E9 0 D5 0 CA 1 3D0 85 2 6E 1 85 2 6E 3 A1 1 60 0 E9 1 71 1 3E0 D0 0 76 5 2 3F 0 E9 1 DB 1 D0 0 76 3 2 3F0 63 1 E6 1 71 1 D0 0 76 3 2 63 0 D5 0 0 400 4 2 C0 8 2 0 B0 9 0 B0 C0 0 B0 C 0 B0 410 D 0 B0 E 0 B0 F 0 B0 10 0 B0 11 0 B0 12 420 0 B0 13 0 B0 14 0 B0 16 0 B0 18 0 B0 1A 0 430 B0 1C 0 B0 1E 0 B0 20 0 B0 32 0 B0 34 0 B0 440 42 0 B0 44 0 B0 46 0 B0 48 0 B0 4A 0 B0 4C 450 0 B0 4E 0 B0 50 0 B0 52 0 B0 54 0 B0 56 0 460 B0 58 0 B0 59 0 B0 5A 0 B0 6E 0 B0 8E 0 B0 470 9E 0 B0 BE 4 76 4E BB 4E AB 4E B9 E A9 F8 0 480 AA E9 FC 0 8A 74 AA 19 2B 8B 3A 84 9B 3A 84 EE 490 8A 7C 0 73 F8 0 5E DF 0 A0 10 80 40 8 20 4 4A0 2 1 4 A4 1E 4E 1E EE F3 73 DF 4 AD 9F AB 1E 4B0 E 2E 2E FE 3B B7 1B 3A B3 8B FA 1 5E 9F 2E 5E 4C0 DF 0 CA 1 6C 1 6C 0 2A F0 0 D5 0 CA 0 2A 4D0 7 0 DC 4 98 0 E9 0 8A 4 A2 0 D5 0 CA 0 4E0 DC 4 AB 1 71 1 6C 0 E9 0 D5 0 CA 2 75 1 4F0 85 0 D5 0 CA 4 AB 4 EB 0 2A 27 4 DD 4 EB 500 0 2A 4B 4 DD 4 EB 0 2A 8D 4 DD 1 60 1 C0 510 2 4B 0 76 17 1 60 0 2A 8 0 DC 1 C0 0 76 520 6 4 C1 0 84 3 4 CC 0 84 3 1 6C 0 D5 0 530 CA 0 1F 74 F7 0 1F 74 0 0 33 0 2A AA 1 F1 540 0 96 0 49 F7 0 D5 0 CA 0 2A AB 1 71 0 96 550 0 D5 0 CA 0 2A AA 1 71 0 96 0 D5 0 A7 0 560 1 0 A7 0 0 0 CA 0 1F 74 F1 0 E9 0 D5 0 570 CA 0 1F 74 F3 0 E9 0 D5 0 A7 74 F5 0 A7 0 580 5 0 A7 74 F8 0 CA 0 E9 5 47 0 D5 0 CA 0 590 E9 0 2A 2 0 E9 5 47 0 D5 0 CA 0 1F 77 0 5A0 0 E9 0 D5 5 A6 EE F8 72 B9 F8 0 A9 1E 4E 59 5B0 19 1E E 59 49 73 49 5E DF 5 BB EE 4E BA 4E AA 5C0 4E BB E AB F8 72 B9 9F A9 73 73 73 5E 1E 9B FA 5D0 80 32 DA 8A F5 73 9A 75 5E 1E 9A FA 80 32 E6 8B 5E0 F5 73 9B 75 5E 1E 1E 1E 8A 59 19 8B 59 9 49 73 5F0 9 5E 8A 59 19 9B 59 9 49 F4 73 9 74 73 9F 74 600 5E 1E 1E 9A 59 19 8B 59 9 49 F4 73 9 74 73 9F 610 74 5E 1E 9A 59 19 9B 59 9 49 F4 73 9 74 5E DF 620 0 CA 5 B9 1 85 1 85 3 3A 1 71 1 6C 0 D5 630 6 32 EE 2E F8 0 73 F8 4E B9 F8 E3 A9 E9 49 F3 640 FA 1 FB 4F 5E DF 0 CA 0 D5 0 CA 2 5D 0 D5 650 0 CA 2 5D 2 5D 0 D5 0 CA 1 DB 1 F1 2 5D 660 2 5D 1 95 1 F1 2 5D 1 95 1 E6 1 95 0 D5 670 0 CA 1 DB 1 F1 1 A3 1 F1 2 5D 1 A3 1 E6 680 2 5D 2 5D 1 A3 0 D5 0 CA 1 DB 1 60 1 DB 690 1 DB 1 F1 1 95 2 18 1 95 0 F6 1 F1 2 5D 6A0 1 95 2 18 2 5D 1 95 0 F6 1 E6 1 6C 1 E6 6B0 2 5D 2 5D 1 95 1 E6 2 5D 2 5D 1 95 0 F6 6C0 0 D5 0 CA 1 DB 1 60 1 DB 1 DB 1 F1 1 95 6D0 2 18 1 95 0 E9 1 F1 2 5D 1 95 2 18 2 5D 6E0 1 95 0 E9 1 E6 1 6C 1 E6 2 5D 2 5D 1 95 6F0 1 E6 2 5D 2 5D 1 95 0 E9 0 D5 0 CA 1 DB 700 1 60 1 DB 1 DB 1 F1 1 95 2 18 1 95 5 B9 710 1 F1 2 5D 1 95 2 18 2 5D 1 95 5 B9 3 3A 720 1 E6 1 6C 1 E6 2 5D 2 5D 1 95 1 E6 2 5D 730 2 5D 1 95 5 B9 3 3A 1 85 1 85 3 3A 1 71 740 1 6C 0 D5 0 CA 1 DB 1 60 1 DB 1 DB 1 F1 750 2 18 6 FC 1 F1 0 2A 6 0 E9 2 18 6 FC 1 760 E6 1 6C 1 E6 0 2A C 0 E9 1 E6 6 FC 0 D5 770 0 A0 0 0 3 24 6 48 9 6A C 8C F AB 12 C8 780 15 E2 18 F9 1C B 1F 1A 22 23 25 28 28 26 2B 1F 790 2E 11 30 FB 33 DF 36 BA 39 8C 3C 56 3F 17 41 CE 7A0 44 7A 47 1C 49 B4 4C 3F 4E BF 51 33 53 9B 55 F5 7B0 58 42 5A 82 5C B3 5E D7 60 EB 62 F1 64 E8 66 CF 7C0 68 A6 6A 6D 6C 23 6D C9 6F 5E 70 E2 72 54 73 B5 7D0 75 4 76 41 77 6B 78 84 79 89 7A 7C 7B 5C 7C 29 7E0 7C E3 7D 89 7E 1D 7E 9C 7F 9 7F 61 7F A6 7F D8 7F0 7F F5 7F FF 0 A7 7 F2 0 0 0 0 0 0 0 0 800 8 2 C0 C 2 0 CA 1 DB 0 1F 7F FF 2 88 1 810 F1 0 2A A 5 A4 2 88 1 71 1 6C 0 F6 1 E6 820 0 2A 8 5 A4 0 1F 64 80 5 B9 1 71 1 6C 0 830 D5 0 CA 1 DB 1 71 1 DB 1 DB 1 60 1 F1 6 840 20 1 71 2 18 6 20 1 E6 1 F1 6 20 2 B0 1 850 E6 1 E6 6 20 0 D5 0 CA 2 88 1 DB 2 88 8 860 5 1 F1 0 2A 3F 0 DC 1 60 0 E9 7 F4 1 85 870 0 F6 1 95 1 71 7 70 0 E9 1 95 8 31 0 F6 880 1 DB 0 E9 1 E6 1 71 1 F1 0 2A 40 0 DC 0 890 76 5 2 63 1 71 1 E6 0 2A 80 0 DC 0 76 9 8A0 2 63 1 71 2 63 1 71 0 D5 0 CA 1 71 1 6C 8B0 4 62 1 60 0 8A 2 51 1 71 0 96 0 D5 0 CA 8C0 1 71 1 60 0 2A 55 2 43 0 76 B 1 6C 5 47 8D0 0 2A 55 0 84 17 1 60 0 2A AA 2 43 0 76 B 8E0 1 6C 5 52 0 2A AA 0 84 3 8 AA 0 D5 0 CA 8F0 1 71 1 60 0 2A 93 2 43 0 76 B 1 6C 5 47 900 0 2A 55 0 84 17 1 60 0 2A 6C 2 43 0 76 B 910 1 6C 5 52 0 2A AA 0 84 3 8 AA 0 D5 0 CA 920 1 60 1 C0 0 76 6 4 1A 0 84 3 4 17 1 DB 930 1 F1 0 8A 0 2A 1E 2 43 0 76 7 0 2A E1 0 940 84 4 0 2A 1E 1 60 1 E6 0 96 0 D5 0 CA 1 950 85 1 C0 0 76 A 4 14 1 85 4 1A 0 84 7 4 960 11 1 85 4 17 0 96 0 96 5 7D 5 65 5 47 4 970 5 0 8A 4 1D 0 96 0 D5 0 CA 1 71 1 60 0 980 2A 27 2 43 0 76 5 1 6C 9 1E 1 60 0 2A E1 990 2 43 0 76 A 9 4D 5 81 5 8D 0 84 18 1 60 9A0 0 2A 1E 2 43 0 76 A 9 4D 5 81 5 85 0 84 9B0 5 1 6C 8 AA 0 D5 0 B0 C2 0 B0 C4 0 B0 C6 9C0 0 B0 C8 0 B0 CA 0 CA 1 71 0 2A F 0 DC 1 9D0 85 0 8A 0 2A F0 0 DC 0 E9 1 71 0 96 0 D5 9E0 0 CA 1 71 0 2A F0 0 DC 1 85 0 8A 0 2A F 9F0 0 DC 0 E9 1 71 0 96 0 D5 9 FC EE 2E 85 73 A00 95 5E DF 0 CA 1 60 8 AA 1 6C 0 D5 0 CA 5 A10 79 8 BE 4 20 0 96 0 D5 0 CA 1 60 8 AA 1 A20 6C 0 D5 0 CA 5 61 5 6F 8 EE 4 E 9 C6 0 A30 D5 0 CA 5 5D 5 6F 8 EE 4 B 9 C6 0 D5 0 A40 CA 5 61 5 65 8 BE 4 E 9 E0 9 FA 0 2A 22 A50 0 E9 9 C3 1 A3 0 D5 0 CA 5 5D 5 65 8 BE A60 4 B 9 E0 9 FA 0 2A 2A 0 E9 9 C3 1 A3 0 A70 D5 0 CA 9 B7 1 95 0 12 0 D5 0 CA 1 60 4 A80 41 2 51 0 96 9 C0 1 95 0 12 0 D5 0 CA 1 A90 60 4 41 0 96 9 BD 1 95 0 12 0 D5 0 CA 4 AA0 38 0 96 0 D5 0 CA 5 61 9 79 0 D5 0 CA 4 AB0 3E 0 96 0 D5 0 CA 5 5D 9 79 0 D5 0 CA 9 AC0 BA 1 95 0 12 0 D5 0 CA 1 60 8 AA 1 6C 0 AD0 D5 0 A0 A 5 A F A 1B A 25 A 33 A 41 A AE0 5A A 73 A 7D A 8F A 9F A A7 A AF A B7 A AF0 BF A C9 0 A7 40 8 0 CA 0 2A 20 2 2B 0 33 B00 A D1 1 F1 0 E9 1 95 A F3 1 F1 0 E9 1 A3 B10 0 2A 2 0 46 EB A D1 0 2A 1C 0 E9 1 60 2 B20 5D 1 95 1 71 1 A3 0 D5 0 CA 0 2A F 0 DC B30 2 75 A F3 0 E9 1 95 0 12 0 D5 B 3E F8 70 B40 B4 F8 0 A4 54 14 54 84 FC 7 A4 C4 A4 54 44 55 B50 15 4 55 15 24 84 FA 80 32 44 F8 2 A4 44 55 15 B60 4 55 85 FF 21 A5 D1 B 69 F8 4E B4 F8 E0 A4 4 B70 3A 81 F8 20 A4 4 A9 F8 0 54 F8 E0 A4 89 54 30 B80 A7 94 B9 F8 0 BA 54 F8 20 A9 F8 E0 A4 F8 6 AA B90 49 54 14 2A 8A 3A 90 F8 30 A9 F8 F0 A4 F8 6 AA BA0 49 54 14 2A 8A 3A A0 D1 B AA F8 4E B4 F8 40 A4 BB0 4 32 D8 F8 4F B9 F8 F0 A9 9 FC 11 3B C4 F8 20 BC0 59 A9 30 C6 9 A9 44 59 19 4 59 19 89 54 F8 F0 BD0 A9 4 59 F8 0 54 24 54 D1 B DB 97 FF 48 3B F2 BE0 E7 48 73 48 73 48 73 48 73 48 73 8 73 28 28 28 BF0 28 28 D1 0 0 0 0 0 0 0 0 0 0 0 0 0 C00 C 2 C0 F B8 C 7 E9 44 59 19 4 73 9 FE 9 C10 76 59 19 9 76 73 9 FE 9 76 59 19 9 76 59 E4 C20 9 F5 73 29 9 75 54 14 15 5 F4 73 25 5 74 54 C30 D2 C 33 95 B4 85 FC 22 A4 26 26 96 B9 86 A9 F8 C40 8 AA 16 16 F8 C B3 F8 7 A3 D3 14 14 15 15 2A C50 8A 3A 44 F8 8 AA 25 25 2A 8A 3A 56 D1 C 5F E6 C60 16 46 BA 46 AA 46 B9 46 A9 46 B4 46 A4 46 B3 46 C70 A3 46 B2 46 A2 46 7E 46 70 E6 26 78 26 73 76 73 C80 82 73 92 73 83 73 93 73 24 84 73 94 73 89 73 99 C90 73 8A 73 9A 73 F8 B B2 F8 3E A2 D2 34 AC F8 B CA0 B2 F8 69 A2 D2 F8 B B2 F8 AA A2 D2 F8 B B2 F8 CB0 DB A2 D2 F8 C B2 F8 33 A2 D2 F8 4E B2 F8 E5 A2 CC0 2 FC 1 52 30 5F 0 CA 0 1F 4E 40 1 95 1 C0 CD0 2 4B 0 76 1E 0 1F 4E 41 0 8A 0 1F 4E 40 0 CE0 8A 4 F3 0 2A F 0 DC 2 75 A D1 0 E9 1 95 CF0 0 12 2 2B 0 79 D2 0 D5 C FB E3 71 33 F8 4F D00 B2 F8 F0 A2 F8 4F BE F8 D0 AE F8 C BD F8 C8 AD D10 DF 0 CA 0 2A 55 2 43 0 76 3 C F9 0 D5 0 D20 A7 4E 32 0 A7 4E 34 0 A7 1C 0 0 B0 CC 0 B0 D30 CE 0 B0 D0 0 B0 D2 0 B0 D4 0 B0 D6 0 B0 D8 D40 0 B0 DA 0 B0 DC 0 CA D 1F 1 95 D 27 6 20 D50 1 60 D 2B 1 95 2 43 0 76 6 1 6C 0 84 11 D60 1 60 D 2B 1 A3 8 57 D 2E 1 A3 D 31 1 A3 D70 0 D5 0 CA D 23 1 95 D 2B 1 95 0 E9 8 57 D80 1 85 1 85 D 3A 1 A3 D 3D 1 A3 0 D5 0 CA D90 D 31 1 95 D 2E 1 95 8 31 1 85 1 85 0 F6 DA0 D 43 1 A3 0 E9 D 37 1 A3 1 85 1 85 0 E9 DB0 D 40 1 A3 1 71 0 F6 D 34 1 A3 0 D5 0 CA DC0 D 72 D 8E 0 D5 0 CA 1 85 1 85 1 71 8 31 DD0 0 E9 1 DB 0 F6 1 E6 0 D5 0 CA 6 30 2 5D DE0 0 D5 0 CA 6 30 0 2A 8 0 E9 0 D5 0 CA 6 DF0 30 0 2A E 0 E9 0 D5 0 CA D DA 6 58 D 37 E00 1 95 D 34 1 95 D C6 D DA 6 70 0 D5 0 CA E10 D E2 6 58 D 3D 1 95 D 3A 1 95 D C6 D E2 E20 6 70 0 D5 0 CA D ED 6 58 D 43 1 95 D 40 E30 1 95 D C6 D ED 6 70 0 D5 E 3C 1A E FE E E40 76 5E 1E E 76 5E 2E 2A DF E 4B 1A E FE E 76 E50 5E 1E E 76 5E 1E E 76 5E 1E E 76 5E 2E 2E 2E E60 2A DF E 64 EE 2E 84 73 94 5E DF E 6D EE 4E B4 E70 4E A4 DF 0 CA 4 8 4 B 0 33 2 2B 1 F1 1 E80 A3 0 2A 2 0 46 F5 0 D5 E 8B E3 70 33 DF 0 E90 CA 2 5D 6 30 0 E9 9 C3 1 95 1 71 0 2A 6 EA0 1 3 0 D5 0 CA 0 1F 4F F0 0 8A 0 2A 20 2 EB0 37 0 76 30 0 1F 4F F0 0 8A 0 1F 4F 0 0 E9 EC0 0 1F 4F 20 0 33 1 F1 2 51 0 8A 1 F1 0 8A ED0 4 F3 B 29 0 2A 2 0 46 ED 0 2A 20 0 1F 4F EE0 F0 0 96 0 D5 0 CA E 6B E A4 E 62 1 D0 0 EF0 79 F8 0 D5 0 CA 0 2A 20 0 1F 4F F0 0 96 2 F00 2B 0 1F 4E 20 1 A3 E 73 E 89 E A4 0 1F 4E F10 E4 0 8A 1 C0 0 79 F4 2 2B E 8F 0 2A 6 E F20 E5 0 2A 6 E 8F 0 2A 6 E E5 0 2A C E 8F F30 0 1F 4E E4 0 8A 2 75 4 B 0 E9 1 95 6 30 F40 1 A3 E A4 0 1F 4E E5 0 8A 0 2A 9 2 43 0 F50 79 F1 2 2B 0 79 C2 0 D5 F 5B 1E 4E FB 55 3A F60 8A F8 45 B5 F8 47 B6 BC F8 0 A5 A6 AC BF B7 F8 F70 46 B2 F8 E0 A2 F8 46 BE F8 80 AE F8 C B1 F8 79 F80 A1 F8 6 AF F8 E BD F8 F6 AD DF 0 CA 0 1F D F90 13 9 B7 1 A3 0 1F F 5B 9 BA 1 A3 0 2A 8 FA0 4 5 0 96 0 1F D C8 9 C0 1 A3 0 1F D C8 FB0 9 BD 1 A3 C C6 0 D5 F8 40 B3 F8 0 A3 43 FB FC0 40 3A CE 43 FB 2 3A CE 3 FB C0 3A CE D3 F8 46 FD0 B6 F8 0 A6 F8 0 B7 B8 BF F8 4F B2 F8 F0 A2 F8 FE0 4F BE F8 80 AE F8 47 BC F8 0 AC F8 C B1 F8 79 FF0 A1 F8 6 AF A7 F8 F BD F8 8D AD DF 0 0 0 0))) (setq *read-base* #xA) (length (setq *gll-rom-image* (progn (iterate loop ( (image (cdr *gll-rom-image*)) ) (when image (setf (nthcdr 16 image) (nthcdr 17 image)) (loop (nthcdr 16 image)))) (cdr *gll-rom-image*)))) -------------------------------------------------------------------------------- /sim1802: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) ;;;;;;;;;;;;;;; ;;; ;;; 1802 processor objects ;;; (define-class 1802-state r d a i n x p df ie q tr) (define-method (initialize-instance (s 1802-state) &rest args) (declare (ignore args)) (reset s)) (define-method (reset (s 1802-state r d a i n x p df ie q tr)) (declare (ignore args)) (setf r (make-array '(16) :initial-element 0) ; 16-bit general-purpose registers d 0 ; 8-bit accumulator a 0 ; 16-bit address register i 0 ; 4-bit instruction register n 0 ; 4-bit pointer to argument register x 0 ; 4-bit pointer to SP register p 0 ; 4-bit pointer to PC register df 0 ; 1-bit carry flag ie 0 ; 1-bit interrupt enable flag q 0 ; 1-bit user flip-flop tr 0 ; 8-bit temporary register )) (define-method (print-object (s 1802-state r d a i n x p df ie q tr) stream) (format stream "#<1802-state R=~X D=~X A=~X I=~X N=~X X=~X P=~X DF=~X IE=~X Q=~X T=~X>" r d a i n x p df ie q tr)) (define-method (get-pc (s 1802-state r p)) (aref r p)) ;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Memory ;;; (define-class memory start end contents protected?) (define-method (initialize-instance (mem memory start end contents protected?) &key (start-address 0) (size #x10000)) (declare (ignore args)) (setf start start-address) (setf end (+ start-address (1- size))) (setf contents (make-array size :initial-element 0)) (setf protected? nil)) (define-method (get-byte (mem memory start end contents) address) (aref contents (- address start))) (define-method (put-byte (mem memory start end contents protected?) address byte) (if protected? (warn "Attempt to write to read-only memory at #x~X" address) (setf (aref contents (- address start)) (logand byte #xFF)))) (defun find-bank (mems address) (dolist (m mems) (if (<= (memory-start m) address (memory-end m)) (return-from find-bank m))) (error "Attempt to access non-existent memory at #x~X" address)) (define-method (get-byte (mems list) addr) (get-byte (find-bank mems addr) addr)) (define-method (put-byte (mems list) addr val) (put-byte (find-bank mems addr) addr val)) (define-method (protect (mem memory protected?) &optional (protect? t)) (setf protected? protect?)) (defun load-bytes (mem bytes &optional (addr (memory-start mem))) (dolist (byte bytes) (put-byte mem addr byte) (incf addr))) (defun dm (m addr &optional (n0 32)) ; Dump Memory (format t "~&(dm #x~X)" addr) (if (not (zerop (mod addr 16))) (format t "~&~4,'0X:~VT" addr (+ 5 (* (mod addr 16) 3)))) (iterate loop ((addr addr) (n n0)) (if (zerop n) (terpri) (progn (if (zerop (mod addr 16)) (format t "~&~4,'0X:" addr)) (format t " ~2,'0X" (get-byte m addr)) (loop (1+ addr) (1- n)))))) ;;;;;;;;;;;;;;;;;;; ;;; ;;; Utilities ;;; (defmacro addf&mask (location addend mask) `(setf ,location (logand (+ ,location ,addend) ,mask))) (defmacro incf-byte (location) `(addf&mask ,location 1 #xFF)) (defmacro incf-word (location) `(addf&mask ,location 1 #xFFFF)) (defmacro decf-byte (location) `(addf&mask ,location -1 #xFF)) (defmacro decf-word (location) `(addf&mask ,location -1 #xFFFF)) (defun hi-byte (n) (logand (ash n -8) #xFF)) (defun lo-byte (n) (logand n #xFF)) (defmacro put-hi-byte (loc byte) `(setf ,loc (dpb (logand ,byte #xFF) (byte 8 8) ,loc))) (defmacro put-lo-byte (loc byte) `(setf ,loc (dpb (logand ,byte #xFF) (byte 8 0) ,loc))) (defun external-flag (s n) 1) ; Ack! (define-method (execute-instruction (s 1802-state r d a i n x p df ie q tr) mem) (macrolet ( (r (arg) `(aref r ,arg)) (mem (arg) `(get-byte mem ,arg)) (setd&df (expr) `(let ( (v ,expr) ) (setf d (logand v #xFF) df (logand (ash v -8) 1)))) ) (let* ( (instr (mem (r p))) ) (setf i (logand (ash instr -4) 15)) (setf n (logand instr 15)) (incf-word (r p)) (ecase i (0 (cond ( (= instr 0) (format t "~&IDLE") (decf-word (r p)) :idle ) (t (setf d (mem (r n)))))) (1 (incf-word (r n))) (2 (decf-word (r n))) (3 (ecase n (0 (put-lo-byte (r p) (mem (r p)))) (1 (if (= q 1) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) (2 (if (= d 0) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) (3 (if (= df 1) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) ((4 5 6 7) (if (= (external-flag s (- n #xC)) 1) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) (8 (incf-word (r p))) (9 (if (= q 0) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) (#xA (if (/= d 0) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) (#xB (if (= df 0) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))) ((#xC #xD #xE #xF) (if (= (external-flag s (- n #xC)) 0) (put-lo-byte (r p) (mem (r p))) (incf-word (r p)))))) (4 (setf d (mem (r n))) (incf-word (r n))) (5 (put-byte mem (r n) d)) (6 (cond ( (= n 0) (incf-word (r x)) ) ( (= n 68) (error "Illegal instruction: #x68") ) (t (error "I/O instruction not implemented: ~X" instr)))) (7 (ecase n (0 (let ( (v (mem (r x))) ) (incf-word (r x)) (setf x (ash v -4) p (logand v 15) ie 1))) (1 (let ( (v (mem (r x))) ) (incf-word (r x)) (setf x (ash v -4) p (logand v 15) ie 0))) (2 (setf d (mem (r x))) (incf-word (r x))) (3 (put-byte mem (r x) d) (decf-word (r x))) (4 (setd&df (+ d (mem (r x)) df))) (5 (setd&df (- (mem (r x)) d (if (= df 0) 1 0) #x-100))) (6 (setf d (logior d (ash df 8)) df (logand d 1) d (ash d -1))) (7 (setd&df (- d (mem (r x)) (if (= df 0) 1 0) #x-100))) (8 (put-byte mem (r x) tr)) (9 (let ( (v (logior (ash x 4) p)) ) (setf tr v) (put-byte mem (r 2) v) (setf x p) (decf-word (r 2)))) (#xA (setf q 0)) (#xB (setf q 1)) (#xC (setd&df (+ (mem (r p)) d df)) (incf-word (r p))) (#xD (setd&df (- (mem (r p)) d (if (= df 0) 1 0) #x-100)) (incf-word (r p))) (#xE (setd&df (logior (ash d 1) df))) (#xF (setd&df (- d (mem (r p)) (if (= df 0) 1 0) #x-100)) (incf-word (r p))))) (8 (setf d (lo-byte (r n)))) (9 (setf d (hi-byte (r n)))) (#xA (put-lo-byte (r n) d)) (#xB (put-hi-byte (r n) d)) (#xC (macrolet ( (lbr-if (condition) `(if ,condition (setf (r p) (logior (ash (mem (r p)) 8) (mem (1+ (r p))))) (setf (r p) (+ (r p) 2)))) (lskp-if (condition) `(if ,condition (setf (r p) (+ (r p) 2)))) ) (ecase n (0 (lbr-if t)) (2 (lbr-if (= q 1))) (3 (lbr-if (= df 1))) (4 (lskp-if nil)) (5 (lskp-if (= q 0))) (6 (lskp-if (/= d 0))) (7 (lskp-if (= df 0))) (8 (lskp-if t)) (9 (lbr-if (= q 0))) (#xA (lbr-if (/= d 0))) (#xB (lbr-if (= df 0))) (#xC (lskp-if (= ie 1))) (#xD (lskp-if (= q 1))) (#xE (lskp-if (= d 0))) (#xF (lskp-if (= df 1)))))) (#xD (setf p n)) (#xE (setf x n)) (#xF (ecase n (0 (setf d (mem (r x)))) (1 (setf d (logior d (mem (r x))))) (2 (setf d (logand d (mem (r x))))) (3 (setf d (logxor d (mem (r x))))) (4 (setd&df (+ d (mem (r x))))) (5 (setd&df (- (mem (r x)) d #x-100))) (6 (setf df (logand d 1)) (setf d (ash d -1))) (7 (setd&df (- d (mem (r x)) #x-100))) (8 (setf d (mem (r p))) (incf-word (r p))) (9 (setf d (logior d (mem (r p)))) (incf-word (r p))) (#xA (setf d (logand d (mem (r p)))) (incf-word (r p))) (#xB (setf d (logxor d (mem (r p)))) (incf-word (r p))) (#xC (setd&df (+ d (mem (r p)))) (incf-word (r p))) (#xD (setd&df (- (mem (r p)) d #x-100)) (incf-word (r p))) (#xE (setf df (logand (ash d -7) 1)) (setf d (ash d 1))) (#xF (setd&df (- d (mem (r p)) #x-100)) (incf-word (r p))))) )))) (define-method (interrupt (s 1802-state x p ie tr)) (when (= ie 1) (setf tr (logior (ash x 4) p)) (setf p 1) (setf x 2) (setf ie 0))) ;;;;;;;;;;;;;;;;; ;;; ;;; Systems ;;; (define-class 1802-system processor memory time) (define-method (reset (s 1802-system processor time)) (reset processor) (setf time 0)) (defun make-gll-magnetometer () (let ( (ram (make-memory :start-address #x4000 :size #x1000)) (rom (make-memory :start-address 0 :size #x1000)) (io (make-memory :start-address #x7000 :size #x1000)) ) (load-bytes ram *gll-ram-image*) (load-bytes rom *gll-rom-image*) (protect rom) (make-1802-system :processor (make-1802-state) :memory (list rom ram io) :time 0))) (define-method (forth-dump (s 1802-system processor memory time)) (format t "~&") (let* ( (regs (1802-state-r processor)) (w (- (aref regs 9) 2)) (sp (aref regs 14)) (r (aref regs 2)) ) (format t "~&~S " time) (dotimes (i (/ (- #x4DF0 r) 2)) (format t "-")) (format t " ~S~30,5TS:" (car (lkup w))) (dotimes (i (- #x4D40 sp)) (format t " ~2,'0X" (get-byte memory (+ sp i)))))) (define-method (run (s 1802-system processor memory time) &key steps (trace nil)) (if (and (null trace) (null steps)) (loop (dotimes (i 20000) (execute-instruction processor memory)) (print processor) (interrupt processor)) (dotimes (i (or steps MOST-POSITIVE-FIXNUM)) (incf time) (when (and (eq trace :forth) (= (get-pc processor) 6)) (forth-dump s)) (when (or (eq trace t) (and (fixnump trace) (zerop (mod time trace))) (and (compiled-function-p trace) (funcall trace s))) (print processor) (disasm1 memory (get-pc processor)) (format t " (Time=~S)" time)) (when (zerop (mod time 20000)) (format t "~&*** INTERRUPT ***") (interrupt processor)) (if (eq (execute-instruction processor memory) ':idle) (return ':idle))))) #| (defvar *m*) (setq *m* (make-gll-magnetometer)) (reset *m*) (run *m* :steps 1000 :trace :forth) (run *m* :steps 10000) (run *m* :steps 20 :trace t) (run *m* :steps 20 :trace 5) (inspect *m*) |# -------------------------------------------------------------------------------- /startup: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) (require 'utilities) (startup gll forthcomp) ; asm1802 sim1802 lisp->forth) (build-gll-dictionary) --------------------------------------------------------------------------------