1
$JOB COMPILE LISP 1.5
$DATE 090161
$EXECUTE IBSFAP
1
* M948-508,FMS,DEBUG,20,40,20000,700 ASSEMBLE LISP 1.5 LISPHERE
* CARDS ROW
* FAP LC000200
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 1
-0 13565 0 10550 ROW OPSYN NULL
PCC
FUL
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * LC003500
*
*
* THIS IS THE 709 SECTION OF THE UPPER VERSION OF RWTML
* SHARE DIST NO. 709 AND 741
* IT LOADS BINARY 704 STYLE CARDS AND OCTAL CORRECTION CARDS
* ON LINE
*
L HED
77721 ORG -47 IO POSITION LOAD AT -42
* 709 BINARY-OCTAL BOOTSTRAP LOADER
77721 0 00025 0 77724 IOCD LOAD,0,21 COMMAND TO LOAD REMAINDER OF LOADER
77722 0060 00 0 00001 TCOA 1 DELAY TILL LOADER IN
77723 0020 00 0 77724 TRA LOAD
77724 0762 00 0 01321 LOAD RCDA INITIATE NEXT CARD
77725 0540 00 0 77747 RCHA LOAD5
77726 0060 00 0 77726 TCOA * DELAY TILL CARD IS IN
77727 0030 00 0 00174 TEFA CONTIN
77730 -0500 00 0 77662 CAL 9L
77731 0100 00 0 77750 TZE LOAD8 ZERO IMPLIES OCTAL CARD
77732 -0734 00 6 00000 PDX ,6 SET WORD COUNT
77733 0630 00 0 77746 STP LOAD4 SET TO CHECK OR IGNORE SUM
77734 0621 00 0 77735 STA LOAD2 SET CARD ORIGIN
77735 -3 00000 4 00000 LOAD2 TXL ****,4,0 OUT IF TRANSFER CARD
77736 0774 00 4 00000 AXT 0,4 SET I4 TO ZERO
77737 0560 00 4 77664 LOAD3 LDQ 9R+1,4 PICK UP WORD
77740 -0600 60 0 77735 STQ* LOAD2 STORE WORD
77741 0361 60 0 77735 ACL* LOAD2 ADD TO CHECK SUM
77742 1 77777 4 77743 TXI *+1,4,-1 ADVANCE FOR NEXT WORD
77743 2 00001 2 77737 TIX LOAD3,2,1 COUNT WORDS TO BE STORED
77744 0322 00 0 77663 ERA 9R COMPARE CHECK SUMS
77745 0100 00 0 77724 TZE LOAD AGREE-LOAD NEXT CARD
77746 0000 00 0 77724 LOAD4 HTR LOAD ERROR-START TO READ NEXT CARD
77747 0 00030 0 77662 LOAD5 IOCD 9L,0,24 COMMAND TO BRING IN BINARY IMAGE
77750 0774 00 5 00016 LOAD8 AXT 14,5 14 TO IR1 AND IR 4
*
ABS RESUME STANDARD PUNCHING
*
77751 0774 00 2 00002 LOAD9 AXT 2,2 SET TO COUNT FIELD PAIRS
77752 -0500 00 4 77704 CAL 9L+18,4 ROW
77753 -0602 00 1 77700 ORS 9L+14,1 ROW UNION
77754 0560 00 1 77700 LDQ 9L+14,1
77755 1 00026 2 77765 TXI LOD11,2,22 SET TO PEEL OFF SIX BITS
77756 3 00002 4 77760 LOD10 TXH *+2,4,2 SKIP STORE TILL AFTER ONE-ROW
77757 0602 00 0 00000 SLW **** STORE OCTAL CORRECTION
77760 2 00001 2 77755 TIX *-3,2,1 ADVANCE TO NEXT PAIR, THIS HALF
77761 2 00002 4 77751 TIX LOAD9,4,2 ADVANCE TO NEXT ROW
77762 -2 00015 5 77725 TNX LOAD+1,5,13 OUT AFTER RIGHT HALF
77763 0762 00 0 01321 RCDA START NEXT CARD
77764 1 00014 5 77751 TXI LOAD9,5,12 ADVANCE TO RIGHT HALF CARD
77765 0760 00 0 00000 LOD11 CLM CLEAR AC
77766 0767 00 0 00002 ALS 2
77767 -0763 00 0 00001 LGL 1 PEEL OFF BITS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 2
77770 2 00004 2 77766 TIX LOD11+1,2,4 COUNT COLUMNS PER FIELD
77771 3 00014 4 77773 TXH *+2,4,12 USE 7-ROW AS FIRST SUM
77772 0361 00 2 77712 ACL 11L+4,2 ADD PREVIOUS SUM
77773 0602 00 2 77712 SLW 11L+4,2 NEW PARTIAL SUM
77774 -2 00002 2 77756 TNX LOD10,2,2 OUT IF SECOND FIELD OF PAIR
77775 0621 00 0 77757 STA LOD10+1 STORE ADDRESS OF CORRECTION
77776 1 00054 2 77765 TXI LOD11,2,44 RETURN TO PEEL OFF 12 BITS
*
77777 0 00133 0 77777 -1,,-STS LEAD WORD FOR ATOM VERITAS-NUMQUAM-PERIT
*
77662 ORG LOAD-34 COMMON STORAGE
77662 COMMON BSS 0
77662 9L BSS 24 INPUT BUFFER
77663 9R SYN 9L+1 CARD CHECK SUM
77706 11L SYN 9L+20 TEMPORARY FOR OCTAL
77724 LOADER SYN LOAD
*
* PROPERTY LISTS FOR THE SPECIAL ATOMS NIL AND VERITAS-NUMQUAM-PERIT THE
* ZERO AND THE BINARY TRUTH ATOMS RESPECTIVELY
*
77640 ORG COMMON-18
77640 0 00137 0 07335 NILSXX $PNAME,,-*-1
77641 0 00000 0 00136 -*-1
77642 -0 00000 0 00135 MZE -*-1
77643 -053143777777 OCT 453143777777 NIL
77644 0 00000 0 00370 NILLOC $ZERO
*
77645 0 00132 0 10742 STS $APVAL,,-*-1
77646 -0 00130 0 00131 MZE -*-1,,-*-2
77647 0 00000 0 00001 1 IS A CONSTANT ,,1 FOR APPLY
77650 0 00127 0 07335 $PNAME,,-*-1
77651 0 00000 0 00126 -*-1
77652 -0 00000 0 00125 MZE -*-1
77653 546351642554 BCI 1,*TRUE*
*
**************************************************
BOOTSTRAP RECORD FOR 709 LISP
00144 ORG 100 BEGIN LISP
HEAD B
*
* BOTTOM THE BOOTSTRAP RECORD FOR LISP ON SYSTEM AND TEMPORARY TAP
*
00144 0 00364 0 00147 BOTTOM IOCD BOTTOM+3,,BSRECL-2 I-O COMMAND TO READ IN BOOTSTRAP REC.
00145 0060 00 0 00001 TCOA 1 WAIT UNTIL RECORD IS READ IN
00146 0020 00 0 00147 TRA BOTTOM+3 START F LISP
00147 0774 00 4 00003 AXT 3,4 NUMBER OF WORDS IN LOWER MEMORY
00150 0500 00 4 00003 CLA 3,4 MOVE THEM TO ORIGINAL POSITION
00151 0601 00 4 00147 STO BOTTOM+3,4
00152 2 00001 4 00150 TIX *-2,4,1
00153 0774 00 4 00366 AXT BSRECL,4 LENGTH OF BOOTSTRAP RECORD
00154 -0754 00 0 00000 PXD ,0, CLEAR THE AC
00155 0361 00 4 00532 ACL CHKSUM,4 COMPUTE THE CHECK SUM FOR RECORD
00156 2 00001 4 00155 TIX *-1,4,1
00157 0322 00 0 00532 ERA CHKSUM COMPARE WITH THE CHECKSUM ON TAPE
00160 0100 00 0 00162 TZE *+2 SKIP IF THEY ARE EQUAL
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 3
00161 0420 00 0 00001 HPR 1 THEY DO NOT, STOP
00162 0500 00 0 00201 CLA STRA STR TRAP
00163 0601 00 0 00002 STO 2 SET STR CELL
00164 0500 00 0 00200 CLA FLTRA FLOATING POINT TRAP
00165 0601 00 0 00010 STO 8 SET TRAP CELL
00166 0500 00 0 00367 CLA SYSTAP TAPE SPECIFICATION FOR SYSTEM TAPE
00167 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
00170 0074 00 4 00202 TSX LRTAPE,4 READ REST OF SYSTEM TAPE
00171 0 77241 0 00537 LOWREG,,-LOWREG REST OF CORE
00172 0522 00 0 00352 XEC $REW REWIND SYSTAP
00173 0020 00 0 77724 TRA $LOAD GO TO READ ANY CORRECTION CARDS
*
00174 0500 00 0 00177 CONTIN CLA ZERO LOADER RETURNS HERE, GO TO OVERLORD
00175 0601 00 0 00000 STO 0 SET ZERO CELL
00176 0020 00 0 10230 TRA OVRLRD GO. TO OVERLORD
*
* NORMAL CONTENTS FOR CELLS 0, 2, 10 (OCTAL) RESPECTIVELY
*
00177 0 00140 0 77777 ZERO -1,,-NILSXX BEGINNING OF ATOM NIL
00200 0021 00 0 01707 FLTRA TTR FLAPTR
00201 0021 00 0 17061 STRA TTR C$LINK
00200 FLAPCX SYN FLTRA
00201 FLAPCY SYN STRA
00177 FLAPCZ SYN ZERO
*
*
* LRTAPE LISP READ TAPE PROGRAM FOR BINARY TAPES
*
00202 0500 00 4 00001 LRTAPE CLA 1,4 PARAMETER WORD
00203 0634 00 4 00533 SXA RTRX,4 SAVE INDEX REGISTERS
00204 -0634 00 2 00533 SXD RTRX,2
00205 0734 00 2 00000 RTTWO PAX 0,2 START ADDRESS
00206 0622 00 0 00207 STD *+1 COUNT
00207 1 00000 2 00210 TXI *+1,2,** END + 1 ADDRESS
00210 0634 00 2 00534 SXA RTADR,2 INITIALIZE ADDRESS
00211 -0734 00 2 00000 PDX 0,2 COUNT IN IR 2
00212 0500 00 0 00205 CLA RTTWO TAG OF 2
00213 0625 00 0 00534 STT RTADR SET TAG
00214 -0634 00 0 00534 SXD RTADR,0 ZERO DECREMENT
00215 0500 00 0 00362 CLA $LCH PICK UP CURRENT LOAD CHANNEL INS.
00216 0601 00 0 00535 STO RTLCH MAKE IMMUNE FROM OVER WRITING
00217 0500 00 0 00346 CLA $(IOU) GET CURRENT I-O UNIT
00220 0601 00 0 00536 STO RTIOU MAKE PREVENT OVERWRITING
00221 -0625 00 0 00357 STL $TCO WAIT FOR CHANNEL
00222 0522 00 0 00357 XEC $TCO TO GO OUT OF OPERATION
00223 0760 00 0 00005 IOT TURN OFF I-O CHECK
00224 0761 00 0 00000 NOP
00225 -0774 00 4 00225 AXC *,4
00226 0522 00 0 00360 XEC $TRC TURN OFF INDICATOR
00227 0522 00 0 00356 XEC $TEF TURN OFF INDICATOR
00230 0522 00 0 00350 RTRD XEC $RDS SELECT TAPE
00231 -0754 00 0 00000 PXD 0,0 CLEAR AC
00232 -0774 00 4 00274 AXC RTIOC,4 POINTER TO I-O COMMAND
00233 0522 00 0 00361 XEC $RCH RESET AND LOAD CHANNEL
00234 0522 00 0 00535 RTLC XEC RTLCH LOAD CHANNEL
00235 0560 00 0 00532 LDQ CHKSUM PICK UP WORD READ IN
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 4
00236 -0600 60 0 00534 STQ* RTADR PUT IT AWAY
00237 0361 60 0 00534 ACL* RTADR ADD TO CHECK SUM
00240 2 00001 2 00234 TIX RTLC,2,1 DO ANOTHER LOAD CHANNEL
00241 -0774 00 4 00275 AXC RTIOD,4 POINTER TO DISCONNECT INSTRUCTION
00242 0522 00 0 00535 XEC RTLCH XEC LCH INS.
00243 0322 00 0 00532 ERA CHKSUM SUBSTRACT CHECK SUMS
00244 0602 00 0 00532 SLW CHKSUM STORE DIFFERECE
00245 0500 00 0 00536 CLA RTIOU PICK UP CURRENT IOU
00246 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
00247 -0625 00 0 00357 STL $TCO WAIT FOR CHANNEL TO GO OUT OF OPERATION
00250 0522 00 0 00357 XEC $TCO
00251 0760 00 0 00005 IOT TEST INDICATOR
00252 0020 00 0 00263 TRA RCK TRY AGAIN
00253 0520 00 0 00532 ZET CHKSUM SKIP IF CHECK SUMS AGREE
00254 0020 00 0 00263 TRA RCK TRY AGAIN
00255 -0774 00 4 00263 AXC RCK,4
00256 0522 00 0 00360 XEC $TRC TEST FOR REDUNDANCY
00257 0522 00 0 00356 XEC $TEF AND EOF
00260 0534 00 4 00533 LXA RTRX,4 RESTORE INDEX REGISTERS
00261 -0534 00 2 00533 LXD RTRX,2
00262 0020 00 4 00002 TRA 2,4 EXIT
*
00263 -0534 00 2 00534 RCK LXD RTADR,2 DID NOT WORK, SEE IF FIRST OR SECOND
00264 -3 00000 2 00266 TXL *+2,2,0
00265 0420 00 0 00002 HPR 2 SECOND TRY FAILED, STOP
00266 -0634 00 4 00534 SXD RTADR,4 MAKE NON-ZERO
00267 0522 00 0 00355 XEC $BSR BACK SPACE AND TRY AGAIN
00270 0534 00 4 00533 LXA RTRX,4 GET CALL WORD IR
00271 0500 00 4 00001 CLA 1,4 CALL PARAMETER
00272 -0734 00 2 00000 PDX 0,2 COUNT TO IR 2
00273 0020 00 0 00230 TRA RTRD
*
00274 -1 00001 0 00532 RTIOC IOCT CHKSUM,,1 BRING IN 1 WORD
00275 0 00000 0 00000 RTIOD IOCD 0,,0 DISCONNECT CHANNEL
*
*
* (IOS) INPUT OUTPUT SUPERVISOR A LA BELL LABS BE SYS 3
*
00276 0340 00 0 00346 (IOS) CAS IOU CHECK TO SEE IF SAME UNIT AS LAST TIME
00277 0020 00 0 00301 TRA *+2 NO
00300 0020 00 4 00001 TRA 1,4 YES EXIT
00301 0634 00 4 00325 SXA IOSX,4 NO, SAVE LINK 1B
00302 0634 00 2 00324 SXA IOSY,2 SAVE INDEX 2
00303 0601 00 0 00346 STO IOU UPDATE IOU
00304 0621 00 0 00350 STA $RDS UPDATE ADDRESSES OF TAPE COMMANDS
00305 0621 00 0 00351 STA $WRS
00306 0621 00 0 00352 STA $REW
00307 0621 00 0 00355 STA $BSR
00310 0621 00 0 00353 STA $WEF
00311 0120 00 0 00313 TPL *+2 TAPE IN NORMAL DENSITH (BIN=HI, BCD=LO)
00312 0322 00 0 00347 ERA IOSBB CHANGE DENSITY BIT
00313 0621 00 0 00354 STA $SDN
00314 0522 00 0 00354 XEC $SDN
00315 0774 00 2 00005 AXT 5,2 NUMBER OF COMMANDS TO BE SET
00316 -0734 00 4 00000 PDX 0,4 CHANNEL NUMBER TO R
00317 1 00014 4 00320 TXI *+1,4,12 TOTAL NUMBER OF COMMANDS - 3
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 5
00320 -0500 00 4 00346 IOSA CAL IOU,4 PICK UP PROPER COMMAND
00321 0602 00 2 00363 SLW COMAND,2 PUT IN PROPER PLACE
00322 -2 00003 4 00324 TNX IOSY,4,3 DECREMENT BY NUMBER OF CHANNEL
00323 2 00001 2 00320 TIX IOSA,2,1 LOOP 5 TIMES
00324 0774 00 2 00000 IOSY AXT **,2 RESTORE INDEX 2
00325 0774 00 4 00000 IOSX AXT **,4 RESTORE LINK IR
00326 0020 00 4 00001 TRA 1,4
*
* TAPE COMMANDS FOLLOW
*
00327 0031 00 4 00000 TEFC 0,4
00330 -0030 00 4 00000 TEFB 0,4
00331 0030 00 4 00000 TEFA 0,4
00332 0062 00 0 00000 TCOC **
00333 0061 00 0 00000 TCOB **
00334 0060 00 0 00000 TCOA **
00335 0024 00 4 00000 TRCC 0,4
00336 -0022 00 4 00000 TRCB 0,4
00337 0022 00 4 00000 TRCA 0,4
00340 0541 00 4 00000 RCHC 0,4
00341 -0540 00 4 00000 RCHB 0,4
00342 0540 00 4 00000 RCHA 0,4
00343 0545 00 4 00000 LCHC 0,4
00344 -0544 00 4 00000 LCHB 0,4
00345 0544 00 4 00000 LCHA 0,4
00346 0 00000 0 00000 IOU PZE LAST UNIT USED
00347 0 00000 0 00020 IOSBB PZE 16 BINARY BIT
HEAD 0
*
* ACTUAL TAPE COMMANDS USED BY PROGRAMS (SHOULD BE UNHEADED)
*
00350 0762 00 0 01220 RDS RTBA **
00351 0766 00 0 01220 WRS WTBA **
00352 0772 00 0 01200 REW REWA **
00353 0770 00 0 01200 WEF WEFA **
00354 0761 00 0 00000 SDN NOP MAKE A SDN INSTRUCTION FOR 7090
00355 0764 00 0 01200 BSR BSRA **
00356 0030 00 4 00000 TEF TEFA 0,4
00357 0060 00 0 00000 TCO TCOA **
00360 0022 00 4 00000 TRC TRCA 0,4
00361 0540 00 4 00000 RCH RCHA 0,4
00362 0544 00 4 00000 LCH LCHA 0,4
00363 COMAND BSS 0
00363 0 00000 0 00000 SYSPPT PZE ADDRESS,,CHANNEL
00364 0 00001 0 01203 SYSPOT 1*512+2*64+3,,1 INITIAL ASSIGNMENT OF A3
00365 0 00000 0 00000 SYSPIT
00366 0 00000 0 00000 SYSTMP
00367 0 00000 0 00000 SYSTAP
00370 TAPASG BSS 0
00276 (IOS) SYN B$(IOS)
77724 LOAD SYN LOADER
00346 (IOU) SYN B$IOU
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 6
EJECT
* CONSTANT POOL
00370 0 00000 0 00000 ZERO PZE
00371 +000000000001 Q1 DEC 1
00372 +000000000002 Q2 DEC 2
00373 +000000000003 Q3 DEC 3
00374 +000000000004 Q4 DEC 4
00375 +000000000005 Q5 DEC 5
00376 +000000000006 Q6 DEC 6
00377 +000000000007 Q7 DEC 7
00400 +000000000010 Q8 DEC 8
00401 +000000000011 Q9 DEC 9
00402 +000000000012 Q10 DEC 10
00403 +000000000014 Q12 DEC 12
00404 0 00000 0 00015 Q13 13
00405 0 00000 0 00016 Q14 14
00406 +000000000021 Q17 DEC 17
00407 +000000000024 Q20 DEC 20
00410 +000000000025 Q21 DEC 21
00411 0 00000 0 00026 Q22 22
00412 +000000000044 Q36 DEC 36
00413 +000000000077 Q63 DEC 63
00414 +000000000100 Q64 DEC 64
00415 +000000000200 Q128 DEC 128
00416 +000000000014 QO14 OCT 14
00417 +000000000017 QO17 OCT 17
00420 +000000000020 QO20 OCT 20
00421 +000000000022 QO22 OCT 22
00410 QO25 SYN Q21
00422 +000000000033 QO33 OCT 33
00423 +000000000040 QO40 OCT 40
00424 +000000000041 QO41 OCT 41
00425 +000000000043 QO43 OCT 43
00426 +000000000050 QO50 OCT 50
00427 +000000000060 QO60 OCT 60
00430 +000000000061 QO61 OCT 61
00413 QO77 SYN $Q63
00415 QO200 SYN Q128
00431 +000000003300 QO33Q2 OCT 3300
00432 +001000000000 QO1Q9 OCT 1000000000
00433 +233000000000 Q233Q9 OCT 233000000000
00434 -377000000000 Q777Q9 OCT 777000000000
00435 +200000000000 QO2Q11 OCT 200000000000
00436 0 00000 1 00000 QT1 ,1
00437 0 00000 2 00000 QT2 ,2
00440 0 00000 4 00000 QT4 ,4
00441 0 00000 5 00000 QT5 0,5
00442 0 00001 0 00000 QD1 PZE ,,1
00443 0 00002 0 00000 QD2 PZE ,,2
00444 0 00005 0 00000 QD5 PZE ,,5
00445 0 00006 0 00000 QD6 PZE ,,6
00446 0 00007 0 00000 QD7 PZE ,,7
00447 0 00024 0 00000 QD20 PZE ,,20
00450 0 00025 0 00000 QD21 PZE ,,21
00451 -1 00000 0 00000 QP5 STR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 7
00452 600000000000 OBLANK BCI 1, 00000
00453 006060606060 ZBLANK BCI 1,0
00454 +201400000000 QF1 DEC 1.0
00455 -0 00000 0 00000 SBIT MZE
00456 +377777777777 MAGMSK OCT 377777777777
00457 0 00000 0 77777 AMASK PZE -1
00460 0 77777 0 00000 DMASK PZE ,,-1
00461 -3 00000 0 00000 PMASK TXL 0,0,0
00462 0 77777 0 77777 ADMASK PZE -1,,-1
00463 0 00000 7 77777 ATMASK PZE -1,7
00464 -3 77777 0 00000 PDMASK SVN ,,-1
00465 -3 77777 7 00000 PDTMSK SVN 0,7,-1
00466 -3 00000 7 77777 PTAMSK SVN -1,7
00467 +000077000000 CNTMSK OCT 000077000000
00470 0 00000 7 00000 TAGMSK PZE ,7
00471 -3 77777 7 77777 SEVENS SVN -1,7,-1
00472 606060606060 BLANKS BCI 1,
00473 BCONAT BSS 0 BEGINNING OF CONSTANT ATOMS
00473 0 00000 0 07335 PNAMEA PZE PNAME
00474 0 10742 0 00000 APVALD PZE ,,APVAL
00475 0 10135 0 00000 BIND PZE ,,BIN
00475 FIXD SYN BIND
00476 0 10120 0 00000 FLOATD ,,$FLOAT
00477 0 10103 0 00000 FSUBRD PZE ,,FSUBR
00500 0 10076 0 00000 FNARGD PZE ,,FUNARG
00501 0 10005 0 00000 LABELD PZE ,,LABEL
00502 0 07775 0 00000 LAMDAD PZE ,,LAMBDA
00503 0 07462 0 00000 OCTD ,,$OCT
00504 0 07335 0 00000 PNAMED PZE ,,PNAME
00505 0 07250 0 00000 QUOTED PZE ,,QUOTE
00506 0 06733 0 00000 SUBRD PZE ,,SUBR
00507 0 07110 0 00000 QSPECD PZE 0,,SPECAL
00510 0 06706 0 00000 QSYMD PZE 0,,SYM
00511 0 07676 0 10211 ERSETO,,PJ36
00512 0 07666 0 07706 PJ37,,PJ38 LOGAND LOGXOR
00513 0 07604 0 07614 -II7,,-II8 MAX MIN
00514 0 06657 0 07355 PLUS,,TIMES
00515 0 06131 0 06130 H01,,H02 PROTECT INTEGER OBJECTS
00516 0 06133 0 06132 H03,,H04
00517 0 06135 0 06134 H05,,H06
00520 0 06137 0 06136 H07,,H10
00521 0 00000 0 06127 H00A PZE H00
00522 0 00000 0 06141 H12A PZE H12
00523 0 00000 0 06221 H72A PZE H72
00524 0 06140 0 00000 H11D PZE ,,H11
00525 0 06143 0 00000 H14D PZE ,,H14
00526 0 06162 0 00000 H33D PZE ,,H33
00527 0 06163 0 00000 H34D PZE ,,H34
00530 0 06167 0 00000 H40D PZE ,,H40
00531 0 06223 0 00000 H74D PZE ,,H74
00531 ECONAT SYN H74D END OF CONSTANT ATOMS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 8
EJECT
00532 CHKSUM BSS 5 THESE CELLS ARE NOT WRITTEN ON TAPE
HEAD B CELLS FOR LRTAPE
00533 RTRX SYN CHKSUM+1 PROTECTED STORAGE
00534 RTADR SYN CHKSUM+2
00535 RTLCH SYN CHKSUM+3
00536 RTIOU SYN CHKSUM+4
00366 BSRECL EQU CHKSUM-BOTTOM LENGTH OF BOOTSTRAP RECORD
00537 LOWREG SYN * LOWEST REGISTER ON LISP RECORD
*
00537 0500 00 4 00001 LWTAPE CLA 1,4 PARAMETER WORD
00540 0621 00 0 00631 STA WTIOC SET UP I-O COMMANDS
00541 0622 00 0 00631 STD WTIOC
00542 0622 00 0 00561 STD WTAD COUNT
00543 0634 00 4 00574 SXA WTX,4 SAVE LINK IR
00544 0600 00 0 00630 STZ WTAG ZERO TEST CELL
00545 0600 00 0 00627 STZ WERC
00546 -0625 00 0 00357 STL $TCO
00547 0522 00 0 00357 XEC $TCO WAIT FOR CHANNEL
00550 0760 00 0 00005 IOT TURN OFF INDICATORS
00551 0761 00 0 00000 NOP
00552 -0774 00 4 00552 AXC *,4
00553 0522 00 0 00360 XEC $TRC
00554 0522 00 0 00356 XEC $TEF
00555 0522 00 0 00351 WTWS XEC $WRS SELECT TAPE
00556 -0774 00 4 00631 AXC WTIOC,4 POINTER TO IO COMMAND
00557 0522 00 0 00361 XEC $RCH RESET AND LOAD CHANNEL
00560 0534 00 4 00631 LXA WTIOC,4 ADDRESS OF BEGINNING OF BLOCK
00561 1 00000 4 00562 WTAD TXI *+1,4,** END + 1 OF BLOCK
00562 0634 00 4 00565 SXA WTACL,4 SET CHECKSUM COMPUTE ADDRESS
00563 -0534 00 4 00631 LXD WTIOC,4 COUNT OF BLOCK
00564 -0754 00 0 00000 PXD 0,0 CLAER AC
00565 0361 00 4 00000 WTACL ACL **,4 COMPUTE CHECKSUM
00566 2 00001 4 00565 TIX *-1,4,1 LOOP
00567 0602 00 0 00532 SLW CHKSUM STOE IN CHECK SUM CELL
00570 -0774 00 4 00632 AXC WTIOD,4 CHECMSUM WRITE COMMAND
00571 0522 00 0 00362 XEC $LCH LOAD CHANNEL
00572 -0774 00 4 00576 AXC WRCK,4 TEST FOR WRITE REDUNDANCY
00573 0522 00 0 00360 XEC $TRC
00574 0774 00 4 00000 WTX AXT **,4 RESTORE LINK IR
00575 0020 00 4 00002 TRA 2,4 EXIT
*
00576 -0520 00 0 00630 WRCK NZT WTAG
00577 0020 00 0 00615 TRA WAGN TRY TO WRITE AGAIN
00600 -0625 00 0 00627 STL WERC CELL SAYS THERE WAS BAD TAPE TROUBLE
00601 -0534 00 4 00366 LXD SYSTMP,4 FORM MESSAGE TO OPERATOR
00602 0754 00 4 00000 PXA 0,4
00603 0400 00 0 00420 ADD $QO20
00604 0767 00 0 00006 ALS 6
00605 0601 00 0 00620 STO WERM
00606 0500 00 0 00366 CLA SYSTMP
00607 -0320 00 0 00417 ANA $QO17
00610 -0602 00 0 00620 ORS WERM
00611 0074 00 4 01222 TSX OUTPUT,4 WRITE CHANGE TAPE MESSAGE
00612 -0 00000 0 00364 MZE BCDOUT
00613 0 00007 0 00620 WERM,,7
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 9
00614 0420 00 0 00003 HPR 3
00615 0522 00 0 00355 WAGN XEC $BSR
00616 -0625 00 0 00630 STL WTAG
00617 0020 00 0 00555 TRA WTWS
*
00620 606060606060 WERM BCI 7, IS BAD, CHANGE IT AND PUSH START.
00621 603162602221
00622 247360233021
00623 452725603163
00624 602145246047
00625 646230606263
00626 215163336060
*
00627 0 00000 0 00000 WERC
00630 0 00000 0 00000 WTAG CELL NON-ZERO ON SECOND TRY
00631 -1 00000 0 00000 WTIOC IOCT **,,** WRITE OUT BLOCK
00632 0 00001 0 00532 WTIOD IOCD CHKSUM,,1 WRITE OUT CHECK SUM
*
* TAPDMP DUMP CODE ON SYSTMP. USED BY OVERLORD
*
00633 0634 00 4 00647 TAPDMP SXA TPDMX,4 SAVE LINK IR
00634 0074 00 4 06311 TSX TEREAD,4 CLEAN UP READ BUFFER
00635 0500 00 0 00366 CLA SYSTMP SPEC. FOR TEMPORARY TAPE
00636 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
00637 0074 00 4 00537 TPRTY TSX LWTAPE,4 WRITE BOOTSTRAP RECORD
00640 0 00366 0 00144 BOTTOM,,BSRECL
00641 0074 00 4 00537 TSX LWTAPE,4 WRITE REST OF CODE
00642 0 77241 0 00537 LOWREG,,-LOWREG
00643 0522 00 0 00353 XEC $WEF WRITE AN EOF MARK
00644 0522 00 0 00352 XEC $REW REWIND SYSTMP
00645 0520 00 0 00627 ZET WERC SEE IF SSYTMP WAS CHANGEDAFTER FIRST
00646 0020 00 0 00637 TRA TPRTY RECORD WAS WRITTE IF SO REWRITE IT
00647 0774 00 4 00000 TPDMX AXT **,4 RESTORE LINK IR
00650 0020 00 4 00001 TRA 1,4 EXIT
*
* OVLT READS A NEW CORE IMAGE IN FROM SYSTMP, USED BY OVERLORD
*
00651 -0754 00 4 00000 OVLTXX PXD 0,4 LINK IR TO AC
00652 -0734 00 2 00000 PDX 0,2 PUT IN IR 2 FOR SAFE KEEPING
00653 0500 00 0 00366 CLA SYSTMP TERMPORARY TAPE SPEC.
00654 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
00655 0074 00 4 00202 TSX LRTAPE,4 READ IN BOOTSTRAP RECORD
00656 0 00366 0 00144 BOTTOM,,BSRECL
00657 0074 00 4 00202 TSX LRTAPE,4 READIN RST OF LISP
00660 0 77241 0 00537 LOWREG,,-LOWREG
00661 0522 00 0 00352 XEC $REW REWIND SYSTMP
00662 0020 00 2 00001 TRA 1,2 EXIT
*
*
00663 0500 00 4 00002 INPUT CLA 2,4
00664 0634 00 4 00675 SXA INX4,4 SAVE LINK IR
00665 0601 00 0 00673 STO CALL
00666 0500 00 0 00365 CLA SYSPIT INPUT TAPE SPEC.
00667 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
00670 0522 00 0 01376 XEC $SWT1 TEST FOR ON-LINE INPUT
00671 0522 00 0 00350 XEC $RDS SELECT INPUT TAPE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 10
00672 0074 00 4 00702 TSX $RTX,4
00673 0 77777 0 00000 CALL **,,-1
00674 0020 00 0 00677 TRA *+3
00675 0774 00 4 00000 INX4 AXT **,4 RESTORE LINK IR
00676 0020 00 4 00005 TRA 5,4
00677 0534 00 4 00675 LXA INX4,4 RESTORE LINK IR
00700 -0120 00 4 00003 TMI 3,4
00701 0020 00 4 00004 TRA 4,4
C HED
*
00702 0634 00 4 00725 RTX SXA RTXX,4 SAVE LINK IR
00703 0500 00 4 00001 CLA 1,4 GET PARAMETER WORD
00704 0522 00 0 01376 XEC $SWT1 TEST FOR ON-LINE INPUT
00705 1 00000 0 00710 TXI H1,,0 IS FROM TAPE
00706 0762 00 0 01321 RCDA
00707 1 00000 0 00741 TXI RDBCD,,0
00710 0621 00 0 01177 H1 STA CMMND SET ADDRESS OF I-O COMMAND
00711 -0774 00 4 00713 AXC *+2,4 LOCATION TO INDEX REGISTER
00712 0522 00 0 00356 XEC $TEF TURN OFFF EOF INDICATOR
00713 -0500 00 0 00727 CAL H2 PIC UP SWITCH
00714 0601 00 0 00727 H3 STO H2 SET TO TXH FIRST TIME THROUGH
00715 -0774 00 4 01177 AXC CMMND,4 LOCATION OF I-O COMMAND
00716 0522 00 0 00361 XEC $RCH RESET AND LOAD CHANNEL
00717 -0625 00 0 00357 STL $TCO SET UP TCO COMMAND
00720 0522 00 0 00357 XEC $TCO WAIT FOR CHANNEL TO GO OUT OF OPERATION
00721 -0774 00 4 00734 AXC RTXBE,4 LOACTION OF BAD EXIT
00722 0522 00 0 00356 XEC $TEF GO IF EOF FOUND
00723 -0774 00 4 00727 AXC H2,4 LOCATION TO TRY AGAIN
00724 0522 00 0 00360 XEC $TRC GO IF REDUNDANCY CHECK FOUND
00725 0774 00 4 00000 RTXX AXT **,4 RESTORE LINK IR
00726 0020 00 4 00003 TRA 3,4 GOOD EXIT
00727 3 00000 0 00734 H2 TXH RTXBE,,0 IS TXL ON SECOND TRY
00730 0522 00 0 00355 XEC $BSR BACKSPACE RECORD
00731 0522 00 0 00350 XEC $RDS SELECT TAPE
00732 0502 00 0 00727 CLS H2 PIC UP SWITCH
00733 -3 00000 0 00714 TXL H3,,0 GO TRY AGAIN
00734 0534 00 4 00725 RTXBE LXA RTXX,4 LINK IR
00735 0020 00 4 00002 TRA 2,4
00736 0762 00 0 01321 RCD RCDA RESTART AFTER ERROR
00737 -0534 00 1 00757 LXD B2,1 X
00740 -0534 00 2 00761 LXD B3,2 X
00741 0030 00 0 00742 RDBCD TEFA *+1 TURN OFF END FILE INDICATOR
00742 0604 00 0 01173 STI B50 SAVE INDICATORS
00743 -0057 00 000003 RIL 3 TURN INDICATORS 1,2 OFF
00744 0540 00 0 01174 RCHA LR READ IN 9 LEFT + RT INTO L,R
00745 0544 00 0 01175 LCHA BLR DELEAY, START 8LEFT + RT INTO 8L,8R
00746 0030 00 4 00002 TEFA 2,4 GO TO END OF FILE RETURN IF EOF ON
00747 0560 00 0 77671 B1 LDQ L X
00750 -0600 00 0 77663 STQ LS SET LEFT SUM
00751 -0634 00 1 00757 SXD B2,1 SAVE INDEX REGISTERS
00752 -0634 00 2 00761 SXD B3,2 X
00753 -0534 00 1 00770 LXD B4,1 SET DIGIT ROW COUNT
00754 0560 00 0 77672 LDQ R
00755 -0600 00 0 77664 STQ RS SET RIGHT SUMP
00756 0074 00 2 01110 TSX C1,2 ENTER CONVERSION LOOP
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 11
TD 00757 -3 00000 0 00762 B2 TXL B5 LEAVE CONVERSION LOOP
00760 0767 00 0 00001 ALS 1
TD 00761 -3 00000 0 01145 B3 TXL C2 INITIALIZE BCD RECORD
00762 0544 00 0 01174 B5 LCHA LR DELAY UNTIL 8 IN, START READING 7
00763 0560 00 0 77665 LDQ 8L USE 8 ROW AS SUM
00764 -0600 00 0 77663 STQ LS X
00765 0560 00 0 77666 LDQ 8R X
00766 -0600 00 0 77664 STQ RS X
00767 0074 00 2 01110 TSX C1,2 ENTER CONVERSION LOOP
00770 -3 00010 0 00773 B4 TXL B6,0,8 LEAVE CONVERSION LOOP
00771 0767 00 0 00003 ALS 3 ADD 8 TIMES 8 ROW
TD 00772 -3 00000 0 01144 TXL C3 X
00773 -0500 00 0 77671 B6 CAL L USE 9 ROW AS SUM
00774 0602 00 0 77663 SLW LS X
00775 -0500 00 0 77672 CAL R X
00776 0602 00 0 77664 SLW RS X
00777 -3 00002 1 01160 B13 TXL B25,1,2 IS IT ZERO OR ONE ROW YES'
01000 0544 00 0 01174 B14 LCHA LR DELAY, READ IN N RT AND LEFT
01001 -0054 00 000001 LFT 1 IS END OF RECORD INDICATOR ON
01002 0020 00 0 01040 TRA B9 YES' END OF RECORD
01003 -0500 00 0 77671 B8 CAL L NO' TEST LEFT ROW FOR
01004 -0320 00 0 77663 ANA LS ILLEGAL DOUBLE PUNCH
01005 -0100 00 0 01163 TNZ B17 X
01006 -0500 00 0 77671 B10 CAL L FORM LOGICAL SUM
01007 -0602 00 0 77663 ORS LS OF LEFT ROWS
01010 -0500 00 0 77672 CAL R TEST FOR ILLEGAL
01011 -0320 00 0 77664 ANA RS DOUBLE PUNCH
01012 -0100 00 0 01163 TNZ B17 X
01013 -0500 00 0 77672 B11 CAL R FORM LOGICAL SUM OF
01014 -0602 00 0 77664 ORS RS RIGHT RWS
01015 -2 00001 1 01154 TNX B12,1,1 TEST FOR ZONE ROWS
01016 0074 00 2 01110 TSX C1,2 ENTER CONVERSION LOOP
TD 01017 -3 00000 0 00777 TXL B13 LEAVE CONVERSION LOOP
TD 01020 -3 00000 0 01144 TXL C3 ADD TO BCD RECORD
01021 -0500 00 0 77665 B7 CAL 8L ADD 8 LEFT ROW TO
01022 -0501 00 0 77663 ORA LS LEFT LOGICAL SUM
01023 0602 00 0 77665 SLW LDS X
01024 0544 00 0 01174 LCHA LR DELAY, START READING X-L,R INTO L,R
01025 -0320 00 0 77667 ANA LZ FORM INDICATOR FOR
01026 0602 00 0 77663 SLW LS BOTH DIGIT AND ZERO
01027 -0500 00 0 77666 CAL 8R ADD 8 RIGHT ROW TO
01030 -0501 00 0 77664 ORA RS RIGHT LOGICAL SUM
01031 0602 00 0 77666 SLW RDS X
01032 -0320 00 0 77670 ANA RZ FORM INDICATOR FOR
01033 0602 00 0 77664 SLW RS BOTH DIGIT AND ZERO
01034 0074 00 2 01110 B40 TSX C1,2 ENTER CONVERSION LOOP
TD 01035 -3 00000 0 01000 TXL B14 LEAVE CONVERSION LOOP
01036 0767 00 0 00004 ALS 4 SHIFT TO ZONE POSITION
TD 01037 -3 00000 0 01144 TXL C3 X
01040 -0500 00 0 77663 B9 CAL LS SAVE LEFT ZONE SUM
01041 0602 00 0 77671 SLW L X
01042 -0500 00 0 77665 CAL LDS FORM INDICATOR FOR
01043 0760 00 0 00006 COM ZERO AND X AND / OR Y
01044 -0320 00 0 77667 ANA LZ IN LEFT ROWS
01045 0320 00 0 77663 ANS LS X
01046 -0500 00 0 77664 CAL RS SAVE RIGHT ZONE SUM
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 12
01047 0602 00 0 77672 SLW R X
01050 -0500 00 0 77666 CAL RDS FORM INDICATOR FOR
01051 0760 00 0 00006 COM ZERO AND X AND/OR Y
01052 -0320 00 0 77670 ANA RZ IN RIGHT ROWS
01053 0320 00 0 77664 ANS RS X
01054 0074 00 2 01110 TSX C1,2 ENTER CONVERSION LOOP
TD 01055 -3 00000 0 01063 TXL B15 LEAVE CONVERSION LOOP
01056 0602 00 0 77662 SLW TP MULTIPLY INDICATOR
01057 0767 00 0 00002 ALS 2 BITS BY TEN
01060 0361 00 0 77662 ACL TP X
01061 0767 00 0 00001 ALS 1 X
TD 01062 -3 00000 0 01144 TXL C3 X
01063 -0500 00 0 77665 B15 CAL LDS FORM INDICATOR FOR
01064 -0501 00 0 77667 ORA LZ BLANK COLUMNS IN
01065 -0501 00 0 77671 ORA L LEFT HALF OF CARD
01066 0760 00 0 00006 COM X
01067 0602 00 0 77663 SLW LS X
01070 -0500 00 0 77666 CAL RDS FORM INDICATOR FOR
01071 -0501 00 0 77670 ORA RZ BLANK COLUMNS IN
01072 -0501 00 0 77672 ORA R RIGHT HALF OF CARD
01073 0760 00 0 00006 COM X
01074 0602 00 0 77664 SLW RS X
01075 0074 00 2 01110 TSX C1,2 ENTER CONVERSION LOOP
TD 01076 -3 00000 0 01104 TXL B16 LEAVE CONVERSION LOOP
01077 0602 00 0 77662 SLW TP MULTIPLY INDICATOR
01100 0767 00 0 00001 ALS 1 BITS BY 3 AND
01101 0361 00 0 77662 ACL TP SHIFT TO ZONE POSITION
01102 0767 00 0 00004 ALS 4 X
TD 01103 -3 00000 0 01144 TXL C3 X
01104 -0534 00 1 00757 B16 LXD B2,1 RESTORE INDEX REGISTERS
01105 -0534 00 2 00761 LXD B3,2 AND RETURN TO MAIN
01106 0441 00 0 01173 LDI B50 RESTORE INDICATORS
01107 0020 00 4 00003 TRA 3,4 PROGRAM
01110 -0634 00 1 01113 C1 SXD C4,1 SAVE ROW COUNT
01111 -0500 00 4 00001 C9 CAL 1,4 INITIALIZE ADDRESSES
01112 0401 00 0 01127 ADM C7 X ADD 6
01113 -3 00000 0 01117 C4 TXL C6,,** TRANSFER IO LEFT ROW
01114 0401 00 0 01127 ADM C7 RIGHT ROW, ADD 6 MORE
01115 0560 00 0 77664 LDQ RS OBTAIN RIGHT SUM AND
TD 01116 1 00000 0 01120 TXI C8 SKIP OVER LEFT SUM
01117 0560 00 0 77663 C6 LDQ LS OBTAIN LEFT SUM
01120 0621 00 0 01145 C8 STA C2 SET BCD RECORD ADDRESS
01121 0621 00 0 01144 STA C3 X
01122 3 00001 1 01126 TXH C5,1,1 SKIP TEST IF DIGIT ROW
01123 -0600 00 0 77662 STQ TP TEST FOR NO SUM
01124 -0500 00 0 77662 CAL TP X
01125 0100 00 0 01150 TZE C11 X
01126 0534 00 1 01127 C5 LXA C7,1 SET WORD COUNT
01127 -0754 00 0 00006 C7 PXD 6,0 CONVERT ROW
01130 -0763 00 0 00001 LGL 1 X
01131 0767 00 0 00005 ALS 5 X
01132 -0763 00 0 00001 LGL 1 X
01133 0767 00 0 00005 ALS 5 X
01134 -0763 00 0 00001 LGL 1 X
01135 0767 00 0 00005 ALS 5 X
01136 -0763 00 0 00001 LGL 1 X
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 13
01137 0767 00 0 00005 ALS 5 X
01140 -0763 00 0 00001 LGL 1 X
01141 0767 00 0 00005 ALS 5 X
01142 -0763 00 0 00001 LGL 1 X
01143 0020 00 2 00002 TRA 2,2 EXIT FROM ROW PROCEDURE
01144 0361 00 1 00000 C3 ACL 0,1 ADD TO BCD RECORD
01145 0602 00 1 00000 C2 SLW 0,1 STORE IN BCD RECORD
01146 2 00001 1 01127 TIX C7,1,1 COUNT WORDS
01147 -0534 00 1 01113 LXD C4,1 RESTORE ROW COUNT
01150 0502 00 0 01113 C11 CLS C4 INVERT ROW SWITCH AND
01151 0601 00 0 01113 STO C4 TEST FOR RIGHT ROW DONE
01152 -0120 00 2 00001 TMI 1,2 TRANSFER IF RIGHT ROW DONE
TD 01153 1 00000 0 01111 C10 TXI C9 GO CONVERT RIGHT ROW
01154 -0051 00 000002 B12 IIL 2 CHANGE INDICATOR BIT 17
01155 -0056 00 000002 LNT 2 IS THIS TWELVE ROW
01156 0020 00 0 01165 TRA B100 CHANGE
01157 0020 00 0 01034 TRA B40 NO
01160 -3 00001 1 01021 B25 TXL B7,1,1 IT IS XERO ROW OR ONE ROW
01161 0544 00 0 01176 LCHA ZLR
01162 0020 00 0 01003 TRA B8
01163 -0760 00 0 00003 B17 SSM SET ERROR SIGN
01164 1 00001 4 01104 TXI B16,4,1 RESTORE INDEX REGISTERS AND MAKE BAD X
01165 0060 00 0 01165 B100 TCOA *
01166 0074 00 2 01110 TSX C1,2
TD 01167 -3 00000 0 01172 TXL B200
01170 0767 00 0 00004 ALS 4
TD 01171 -3 00000 0 01144 TXL C3
01172 0020 00 0 01040 B200 TRA B9
01173 0 00000 0 00000 B50 PZE INDICATOR STORAGE
01174 -3 00002 0 77671 LR MTH L,0,2
01175 -3 00002 0 77665 BLR MTH 8L,0,2
01176 -3 00002 0 77667 ZLR MTH LZ,0,2
01177 -3 77777 0 00000 CMMND MTH **,0,-1
77662 ORG COMMON
77662 TP BSS 1 TEMPORARY
77663 LS BSS 1 LEFT SUM
77664 RS BSS 1 RIGHT SUM
77665 LDS BSS 1 LEFT DIGIT SUM
77666 RDS BSS 1 RIGHT DIGIT SUM
77667 LZ BSS 1 LEFT ZERO ROW
77670 RZ BSS 1 RIGHT ZERO ROW
77671 L BSS 1 LEFT ROW
77672 R BSS 1 RIGHT ROW
77665 8L SYN LDS 8 LEFT ROW
77666 8R SYN RDS 8 RIGHT ROW
01200 ORG CMMND+1
0 HED
00000 BCDIN EQU 0
00702 RTX SYN C$RTX
HEAD D
*
* SPACEX PROVIDES A VARITY OF SPACES ON OFF LINE PRINTER
*
01200 0522 00 0 01402 SPACEX XEC $SWT5 TEST FOR NO OFF-LINE OUTPUT
01201 0020 00 0 01203 TRA *+2
01202 0020 00 4 00002 TRA 2,4 RETURN
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 14
01203 0634 00 4 01206 SXA SPX,4 SAVE LINK IR
01204 0500 00 0 00364 CLA SYSPOT SET UP TAPES
01205 0074 00 4 00276 TSX $(IOS),4
01206 0774 00 4 00000 SPX AXT **,4 RESTORE LINK IR
01207 0500 00 4 00001 CLA 1,4 GET PARAMETER
01210 0737 00 4 00000 PAC 0,4 COMPLEMENT INTO IR 4
01211 0522 00 0 00351 XEC $WRS
01212 0522 00 0 00361 XEC $RCH
01213 0534 00 4 01206 LXA SPX,4
01214 0020 00 4 00002 TRA 2,4 RETURN
01215 2 00001 0 00453 8SPACE IORP ZBLANK,,1 DOUBLE SPACE
01216 2 00001 0 00453 6SPACE IORP ZBLANK,,1 DOUBLE SPACE
01217 2 00001 0 00453 4SPACE IORP ZBLANK,,1 DOUBLE SPACE
01220 2 00001 0 00453 2SPACE IORP ZBLANK,,1 DOUBLE SPACE
01221 0 00000 0 00000 IOCD 0,,0 DISCONNECT CHANNEL
*
* OUTPUT BCD OUTPUT ROUTINE FOR LISP
* SWITCHES...
* 3 PRINT ON-LINE
* 5 DONT WRITE TAPE FOR OFF-LINE PRINTING
*
01222 0634 00 4 01245 OUTPUT SXA WOTX,4 SAVE LINK IR
01223 0500 00 4 00002 CLA 2,4 GET PARAMETER WORD
01224 0622 00 0 01367 STD WOTC SET COUNT OF I-O COMMAND
01225 0400 00 0 00407 ADD $Q20 END OF BLOCK
01226 0621 00 0 01234 STA WOTM SET MOVE LOOP
01227 -0625 00 0 00357 STL $TCO WAIT FOR COMPLETION OF LAST OPERATION
01230 0522 00 0 00357 XEC $TCO
01231 0500 60 4 00001 CLA* 1,4 GET TAPE SPECIFICATION
01232 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
01233 0774 00 4 00024 AXT 20,4 MAXIMIUM THAT MAY BE ON 1 RECORD
01234 0500 00 4 00000 WOTM CLA **,4 MOVE INTO BUFFER
01235 0601 00 4 01367 STO WOTB,4
01236 2 00001 4 01234 TIX WOTM,4,1
01237 0522 00 0 01402 XEC $SWT5 TEST FOR NO TAPE OUTPUT
01240 0020 00 0 01242 TRA *+2 IS OUTPUT ON TAPE
01241 0020 00 0 01245 TRA WOTX TEST FOR ON-LINE OUTPUT
01242 0522 00 0 00351 XEC $WRS SELECT TAPE
01243 -0774 00 4 01367 AXC WOTC,4 POINTER TO I-O COMMAND
01244 0522 00 0 00361 XEC $RCH RESET ANF LOAD CHANNEL
01245 0774 00 4 00000 WOTX AXT **,4 RESTORE LINK IR
01246 0500 00 4 00001 CLA 1,4 TEST FOR ON-LINE
01247 0522 00 0 01400 XEC $SWT3 ON-LINE SENSE SWITCH
01250 0120 00 4 00003 TPL 3,4 EXIT IF DONE
* DM 716A - 48 CARDS - 02-09-59
*BCD ON-LINE PRINT ROUTINE FOR 709
* MODIFED FOR USE IN LISP 1.5
01251 0634 00 4 01334 WOTON SXA WOTU,4 PRINT ON LINE
01252 0634 00 2 01335 SXA WOTV,2 SAVE INDEX REGISTERS
01253 0634 00 1 01336 SXA WOTW,1
01254 0600 00 0 01340 STZ WOTT SET SWITCH
01255 0600 00 0 01341 STZ WOTS SET SWITCH TO SKIP FIRST CHARACTER
01256 -0534 00 6 01367 LXD WOTC,6 COUNT IN INDEX 4 AND 2
01257 1 01343 4 01260 TXI *+1,4,WOTB-20 ADD BEGINNING OF BUFFER
01260 0634 00 4 01271 SXA BC05,4 SET ADDRESS
01261 0766 00 0 01361 BC02 WPDA SELECT PRINTER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 15
01262 0520 00 0 01340 ZET WOTT SKIP ON FIRST 72 CHARACTERS
01263 0760 00 0 01371 SPRA 9 SET UP SECOND HALF OF LINE
01264 0774 00 4 00030 AXT 24,4 CLEAR
01265 0600 00 4 77714 STZ COMMON+26,4 WORKING
01266 2 00001 4 01265 TIX *-1,4,1 STORAGE
01267 -0500 00 0 00455 BC03 CAL BC50 STROBE STARTER
01270 0634 00 2 01274 BC04 SXA BC01,2 WORKING CELL FOR N
01271 0560 00 2 00000 BC05 LDQ 0,2 PICK UP WORD TO CONVERT
01272 0774 00 2 00006 AXT 6,2 X2 COUNTS 6 CHARACTERS
01273 0602 00 0 77714 BC06 SLW COMMON+26 STROBE
01274 -0754 00 0 00000 BC07 PXD **,0
01275 -0763 00 0 00006 LGL 6 LOOK AT
01276 -0520 00 0 01341 NZT WOTS SKIP IF NOT FIRST CHARACTER
01277 0500 00 0 00427 CLA $QO60 GET BCD BLANK FOR LEADNING CHARACTER
01300 0767 00 0 00001 ALS 1 ONE CHARACTER
01301 0734 00 1 00000 PAX ,1
01302 -0500 00 0 77714 CAL COMMON+26 STROBE
01303 -2 00140 1 01305 TNX *+2,1,96 NOT 0
01304 -0602 00 4 77707 ORS COMMON+21,4 0
01305 3 00136 1 01320 TXH BC08,1,94 BLANK
01306 -2 00076 1 01311 TNX *+3,1,62 NOT 11
01307 -0602 00 4 77711 ORS COMMON+23,4 11
01310 -2 00002 1 01320 TNX BC08,1,2
01311 -2 00036 1 01314 TNX *+3,1,30 NOT 12
01312 -0602 00 4 77713 ORS COMMON+25,4 12
01313 -2 00002 1 01320 TNX BC08,1,2
01314 -2 00022 1 01317 TNX *+3,1,18 NOT 8 COMBINATION
01315 1 00002 1 01316 TXI *+1,1,2
01316 -0602 00 4 77667 ORS COMMON+5,4 8 COMBINATION
01317 -0602 00 5 77707 ORS COMMON+21,5 NUMBER
01320 0771 00 0 00001 BC08 ARS 1 MOVE STROBE
01321 -0625 00 0 01341 STL WOTS SET SWITCH
01322 2 00001 2 01273 TIX BC06,2,1 BACK FOR NEXT CHARACTER
01323 0534 00 3 01274 LXA BC01,3 N
01324 -2 00001 2 01330 TNX BC15,2,1 OUT IF N WORDS DONE
01325 -0100 00 0 01270 TNZ BC04 BACK FOR REST OF HALF-CARD
01326 -3 00000 4 01330 TXL BC15,4,0 RIGHT-HALF DONE
01327 1 77777 4 01267 TXI BC03,4,-1 BACK FOR RIGHT HALF
01330 0540 00 0 01342 BC15 RCHA BC49
01331 -0625 00 0 01340 STL WOTT SET SWITCH FOR SECOND HALF LINE
01332 3 00001 1 01261 TXH BC02,1,1 BACK FOR MORE WORDS
01333 0060 00 0 01333 TCOA *
01334 0774 00 4 00000 WOTU AXT **,4 RESTORE INDEX REGISTERS
01335 0774 00 2 00000 WOTV AXT **,2
01336 0774 00 1 00000 WOTW AXT **,1
01337 0020 00 4 00003 TRA 3,4 EXIT
*
01340 0 00000 0 00000 WOTT NON-ZERO ON SECOND HALF LINE
01341 0 00000 0 00000 WOTS ZERO FOR FIRST CHARACTER
01342 0 00030 0 77664 BC49 IOCD COMMON+2,,24
01274 BC01 SYN BC07
00455 BC50 SYN $SBIT
*
01367 WOTB BES 20 OUTPUT BUFFER
01367 2 00000 0 01343 WOTC IORP WOTB-20,,** WRITE RECORD FROM BUFFER
01370 0 00000 0 00000 IOCD 0,,0 DISCONNECT CHANNEL
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 16
00364 BCDOUT SYN SYSPOT
00363 PPTOUT SYN SYSPPT
*
01371 0762 00 0 01321 PSHLDB RCDA
01372 0540 00 0 01375 RCHA *+3
01373 0544 00 0 00000 LCHA 0
01374 0021 00 0 00001 TTR 1
01375 -1 00003 0 00000 IOCT 0,,3
HEAD 0
* $SWTN COMMANDS ALL SWT COMMANDS ARE EXECUTED
* NOTE.... SWT COMMANDS MAY BE SIMULATED BY MAKING DOWN SWITCHES
* ZET $ZERO
* AND UP SWITCHES
* NZT $ZERO
*
01376 0760 00 0 00161 SWT1 SWT 1
01377 0760 00 0 00162 SWT2 SWT 2
01400 0760 00 0 00163 SWT3 SWT 3
01401 0760 00 0 00164 SWT4 SWT 4
01402 0760 00 0 00165 SWT5 SWT 5
01403 0760 00 0 00166 SWT6 SWT 6
*
* SENSE LIGHT AND TEST INSTRUCTIONS TO BE EXECUTED OF DUMMYED
*
01404 0760 00 0 00141 SLN1 SLN 1
01405 0760 00 0 00142 SLN2 SLN 2
01406 0760 00 0 00143 SLN3 SLN 3
01407 0760 00 0 00144 SLN4 SLN 4
01410 0760 00 0 00140 SLF SLF
01411 -0760 00 0 00141 SLT1 SLT 1
01412 -0760 00 0 00142 SLT2 SLT 2
01413 -0760 00 0 00143 SLT3 SLT 3
01414 -0760 00 0 00144 SLT4 SLT 4
HEAD D
* C043 786 R. DALEY ... GETTM ... READ CLOCK ROUTINE FOR 709 ......
* RECODED AND SQUEEZED BY 0. 4. EDWARDS
01415 0762 00 0 01361 GETTM RPRA
01416 0634 00 1 01510 SXA EXA,1
01417 0634 00 2 01511 SXA EXB,2 ..
01420 0634 00 4 01473 SXA EXC,4 ..
01421 0774 00 2 00041 AXT 33,2 SET UP FOR LOOP
01422 0600 00 2 77723 STZ COMMON+33,2 ZERO CARD IMAGE AND WORKING STORAGE
01423 2 00001 2 01422 TIX *-1,2,1 LOOP
01424 0540 00 0 01515 RCHA SKP27 SET PRINTER TO SKIPPING FIRST 27 WORDS
01425 0760 00 0 01367 SPRA 7 SENSE TIME CLOCK
01426 0760 00 0 01371 SPRA 9 SET ECHO ENTRIES
01427 -0140 00 0 01431 TNO *+2 SKIP IF OVERFLOW LIGHT OFF
01430 -0625 00 0 77667 STL COMMON+5 OVERFLOW LIGHT ON, MAKE COMMON+4 =/ 0
01431 0544 00 0 01520 LCHA ONWD 9 RIGHT ECHO
01432 0774 00 4 00011 AXT 9,4 ROW COUNT
01433 0544 00 0 01516 LCHA SKP3 IOCPN ZERO,,3 IOCT COMMON,,1
01434 0560 00 0 77662 LOAD LDQ COMMON
01435 0774 00 2 00002 AXT 2,2 ..
01436 -0754 00 0 00000 CONV PXD ,0
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 17
01437 0774 00 1 00006 AXT 6,1 ..
01440 0767 00 0 00005 ALS 5 ..
01441 -0763 00 0 00001 LGL 1 ..
01442 2 00001 1 01440 TIX *-2,1,1 ..
01443 -0602 00 2 77665 ORS COMMON+3,2 ..
01444 -0500 00 2 77667 CAL COMMON+5,2 ..
01445 0361 00 2 77665 ACL COMMON+3,2 ..
01446 0602 00 2 77667 SLW COMMON+5,2 ..
01447 2 00001 2 01436 TIX CONV,2,1 ..
01450 0544 00 0 01517 LCHA SKP1 IOCPN ZERO,,1 IOCT COMMON,,1
01451 2 00001 4 01434 TIX LOAD,4,1 COUNTS ROWS
01452 0544 00 0 01513 LCHA ZERO IOCD 0,,0 DISCONNECT PRINTER
01453 0560 00 0 77665 LDQ COMMON+3 DATE
01454 -0754 00 0 00000 PXD ,0
01455 -0763 00 0 00006 LGL 6 ..
01456 -0100 00 0 01460 TNZ *+2 ..
01457 -0500 00 0 00427 CAL OCT60 INSERT BLANK
01460 -0763 00 0 00014 LGL 12 ..
01461 -0501 00 0 00430 ORA OCT61 INSERT / BETWEEN MONTH AND DAY
01462 0767 00 0 00022 ALS 18 ..
01463 0602 00 0 77665 SLW COMMON+3 ..
01464 -0754 00 0 00000 PXD ,0
01465 -0763 00 0 00006 LGL 6 ..
01466 -0100 00 0 01470 TNZ *+2 ..
01467 -0500 00 0 00427 CAL OCT60 INSERT BLANK
01470 -0763 00 0 00014 LGL 12 ..
01471 -0501 00 0 00427 ORA OCT60 PROVIDE BLANK AS LAST CHARACTER
01472 -0501 00 0 77665 ORA COMMON+3 ..
01473 0774 00 4 00000 EXC AXT **,4 RESTORE LINK IR
01474 0602 60 4 00001 SLW* 1,4 STORE DATE IN REGISTER SPECIFIED
01475 -0754 00 0 00000 PXD ,0
01476 0560 00 0 77666 LDQ COMMON+4 TIME
01477 -0763 00 0 00006 LGL 6 ..
01500 -0100 00 0 01502 TNZ *+2 ..
01501 -0500 00 0 00427 CAL OCT60 BLANK
01502 -0763 00 0 00036 LGL 30 ..
01503 -0501 00 0 00431 ORA OCT33 PROVIDE DECIMAL POINT
01504 0602 60 4 00002 SLW* 2,4 STORE TIME
01505 0767 00 0 00010 ALS 8 TURN ON OVER FLOW
01506 -0520 00 0 77667 NZT COMMON+5 LEAVE ON IF COMMON+5 IS NON ZERO
01507 0140 00 0 01510 TOV *+1 TURN OFF OVER FLOW LIGHT
01510 0774 00 1 00000 EXA AXT 0,1 RESTORE IRS
01511 0774 00 2 00000 EXB AXT 0,2 ..
01512 0020 00 4 00003 TRA 3,4 EXIT........
01513 0 00000 0 00000 ZERO PZE 0 ..
01514 0 00000 0 00000 PZE
01515 -1 00033 2 77670 SKP27 IOCTN COMMON+6,,27
01516 -0 00002 2 01513 SKP3 IOCPN ZERO,,2 SKIP TWO WORDS
01517 -0 00001 2 01513 SKP1 IOCPN ZERO,,1 SKIP ONE WORD
01520 -1 00001 0 77662 ONWD IOCT COMMON,,1 TRANSMIT ONE WORD TO COMMON
00427 OCT60 SYN $QO60
00430 OCT61 SYN $QO61 BCD /
00431 OCT33 SYN QO33Q2 BCD .0
* TIME PRINTS THE DATE AND TIME .
01521 0634 00 4 01531 TIME SXA TIR,4 SAVE LINK IR
01522 0074 00 4 01415 TSX GETTM,4 GET TIME FROM ON-LINE CLOCK
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 18
01523 0 00000 0 01535 TR+2 STORE DATE
01524 0 00000 0 01536 TR+2+1 STORE TIME
01525 0074 00 4 01222 TSX OUTPUT,4 PRINT OUT DATE AND TIME
01526 0 00000 0 00364 BCDOUT ON BCD OUTPUT TAPE
01527 0 00021 0 01533 TR,,17
01530 -0754 00 0 00000 PXD 0,0
01531 0774 00 4 00000 TIR AXT **,4 RESTORE LINK IR
01532 0020 00 4 00001 TRA 1,4 RETURN
01533 006063302560 TR BCI 1,0 THE
01534 633144256074 BCI 9,TIME ( ) HAS COME, THE WALRUS SAID, TO TALK
01535 606060606060
01536 606060606060
01537 346030216260
01540 234644257360
01541 633025606621
01542 435164626062
01543 213124736063
01544 466063214342
01545 604626604421 BCI 7, OF MANY THINGS ..... -LEWIS CARROLL-
01546 457060633031
01547 452762603333
01550 333333606060
01551 404325663162
01552 602321515146
01553 434340606060
0 HED
01521 TIME SYN D$TIME
01415 GETTM SYN D$GETTM
01554 0420 00 0 00007 PAUSEF HPR 7
01555 0020 00 4 00001 TRA 1,4
*
* ERROR PROCESSES ALL LISP ERRORS. NORMALLY GIVES ERROR NUMBERS,
* ERROR LOCATION, LISP PRINT OF AC AND BACK TRACE OFALL
* FUNCTIONS ENTERED ON PUSH DOWN LIST.
*
01556 0 00000 0 00000 ERAC PLACE TO STORE MACHINE REGISTERS
01557 0 00000 0 00000 ERMQ
01560 0 00000 0 00000 ERIND
01561 0 00000 0 00000 ERX INDEX 1,,INDEX 2
01562 3 00000 0 01563 ERROR TXH *+1,,** INDEX 4
01563 -0520 00 0 11664 NZT ERNULL SEE IF ERROR PROGRAM IS TO BE EXECUTED
01564 0522 00 0 11665 XEC EREXIT NORMAL SETTING GOES TO EVALQUOTE
01565 -0600 00 0 01557 STQ ERMQ SAVE MACHINE REGISTERS
01566 0604 00 0 01560 STI ERIND
01567 0634 00 1 01561 SXA ERX,1
01570 -0634 00 2 01561 SXD ERX,2
01571 0441 00 0 10340 LDI SYSIND PICK UP SYSTEM INDICATORS
01572 0055 00 000010 SIR ERRORI SET ERROR HAS OCURRED INDICATOR
01573 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS CELLS
01574 0601 00 0 01655 STO ERT AC TO BE PRINTED
01575 0500 00 4 00001 CLA 1,4
01576 0601 00 0 01661 STO ERM PUT IN ERROR MESSAGE
01577 -0535 00 4 01562 LDC ERROR,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 19
01600 -0754 00 4 00000 PXD 0,4
01601 0131 00 0 00000 XCA AND CONVERT TO OCTAL
01602 0074 00 4 11021 TSX OCTALP,4
01603 -0501 00 0 00452 ORA OBLANK INSERT LEADING BLANK
01604 0602 00 0 01664 SLW ERN PUT IN ERROR MESSAGE
01605 0074 00 4 01222 TSX OUTPUT,4 WRITE OUT ERROR MESSAGE
01606 0 00000 0 00364 BCDOUT
01607 0 00011 0 01656 ERO,,9
01610 0520 00 0 01654 ZET BACACT SKIP IF BACK TRACE IS NOT ACTIVE
01611 0020 00 0 01650 TRA BACER GO TO SPECIAL ROUTINE
01612 -0625 00 0 01654 STL BACACT MAKE BACK TRACE ROUTINE ACTIVE
01613 0500 00 0 01655 CLA ERT PICK UP AC ON ENTRANCE
01614 0074 00 4 04604 TSX $PRINT,4 PRINT IT IN LISP
01615 0054 00 000200 RFT NOBACT TEST FOR NO BACK TRACE
01616 0020 00 0 01646 TRA BACD GO TO EXIT
01617 0560 00 0 00370 LDQ $ZERO ZERO THE ERROR LIST
01620 -0534 00 4 11670 LXD NUBPDL,4 BEGINNING OF PUSH DOWN LIST
01621 1 77777 4 01622 TXI *+1,4,-1 PUSH UP BY -1
01622 -0634 00 4 01624 SXD BEX,4 SET UP ALL DONE TEST INSTRUCTION
01623 -0534 00 4 02317 LXD $CPPI,4 PICK UP CURRENT PDL COUNTER
01624 3 00000 4 01644 BEX TXH BACTD,4,** GO IF ALL UNSAVED
01625 -0500 00 4 77777 CAL -1,4 EITHER UNSAVE OR UNWND
01626 -0320 00 0 00461 ANA $PMASK DEPENDING ON COMPILED OR
01627 0322 00 0 00451 ERA $QP5 SYSTEM SUBROUTINE PUT IT THERE
01630 0100 00 0 01633 TZE *+3 TEST IS FOR STR OP
01631 0074 00 4 02326 TSX UNSAVE,4 IN LAST WORD OF BLOCK FROM COMPILER
01632 0020 00 0 01634 TRA *+2
01633 0074 00 4 17330 TSX C$UNWND,4
01634 -0534 00 4 02317 LXD $CPPI,4 BEGINNING OF BLOCK JUST UNSAVED
01635 0500 00 4 00000 CLA 0,4 LAST IR 4 WORD
01636 0734 00 4 00000 PAX 0,4 FUNCTION ATOMIC SYMBOL
01637 -0754 00 4 00000 PXD 0,4 PUT IN DECREMENT
01640 0074 00 4 03730 TSX $CONS,4 ADD TO ERROR LIST
01641 0131 00 0 00000 XCA ANSWER TO MQ
01642 -0534 00 4 02317 LXD $CPPI,4 PUSH DOWN INDICATOR
01643 0020 00 0 01624 TRA BEX GO BACK FOR NEXT
01644 0131 00 0 00000 BACTD XCA LIST TO AC
01645 0074 00 4 04604 TSX $PRINT,4 PRINT THE ERROR LIST
01646 0600 00 0 01654 BACD STZ BACACT DE-ACTIVATE THE BACK TRACE ROUTINE
01647 0522 00 0 11665 XEC EREXIT NORMAL SETTING GOES TO EVALQUOTE
*
01650 0074 00 4 01222 BACER TSX OUTPUT,4 WRITE OUT MESSAGE THAT BACK TRACE
01651 0 00000 0 00364 BCDOUT CAUSED ANOTHER ERROR
01652 0 00007 0 01667 BACE,,7
01653 0020 00 0 01646 TRA BACD RESET AND RETURN
000200 NOBACT BOOL 200 NO BACK TRACE INDICATOR
01654 0 00000 0 00000 BACACT NON-ZERO MEANS BACK TRACE ACTIVE
01655 0 00000 0 00000 ERT TEMPORARY STORAGE FOR AC
01656 005454546025 ERO BCI 3,0*** ERROR NUMBER
01657 515146516045
01660 644422255160
01661 0 00000 0 00000 ERM ERROR NUMBER IN BCD GOES HERE
01662 603145242567 BCI 2, INDEX 4 =
01663 600460136060
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 20
01664 0 00000 0 00000 ERN OCATL LOCATION GOES HERE
01665 604623632143 BCI 2, OCTAL. ***
01666 336054545460
01667 005454546021 BACE BCI 7,0*** ABOVE ERROR TERMINATED BACK-TRACE ***
01670 224665256025
01671 515146516063
01672 255144314521
01673 632524602221
01674 234240635121
01675 232560545454
*
* FLAPTR AND OCT GIVE ERROR DIAGNOSTICS FOR FLOATING POINT TRAP AND
* DIVIDE CHECK INCLUDING LOCATION AND CONTENTS OF AC.
* BOTH MY BE IGNORED BY MAKNG CELL FPTGNR NON-ZERO.
01676 0520 00 0 01706 DCT ZET FPTGNR TEST FOR IGNORE ERROR FLAG
01677 0020 00 4 00001 TRA 1,4 RETURN
01700 -0634 00 4 01562 SXD $ERROR,4 SAVE IR 4
01701 -0535 00 4 01562 LDC $ERROR,4 COMPLEMENT LOCATION OF ENTRANCE
01702 0634 00 4 01717 SXA FLXT,4 SET TRAP ADDRESS
01703 -0634 00 0 01717 SXD FLXT,0 ZERO THE DECREMENT
01704 -0625 00 0 01765 STL FPTDV SET DIVIDE CHECK FLAG
01705 0020 00 0 01722 TRA FPTA DO FLOATING POINT TRAP ERROR
*
01706 0 00000 0 00000 FPTGNR TEST CELL IS NON-ZERO TO IGNORE TRAPS
*
01707 0601 00 0 77662 FLAPTR STO COMMON SAVE AC
01710 0500 00 0 00000 CLA 0 GET TRAP LOCATION
01711 0621 00 0 01717 STA FLXT SET EXT CELL
01712 0622 00 0 01717 STD FLXT
01713 0500 00 0 00177 CLA FLAPCZ NORMAL CONTENTS OF ZERO
01714 0601 00 0 00000 STO 0
01715 0500 00 0 77662 CLA COMMON RESTORE AC
01716 0520 00 0 01706 ZET FPTGNR TEST FOR IGNORE TRAP
01717 -3 00000 0 00000 FLXT TXL **,,** IMMEDIATE EXIT INSTRUCTION
01720 0600 00 0 01765 STZ FPTDV INDICATE FLAPPING TRAP
01721 -0634 00 4 01562 SXD $ERROR,4 SAVE LINK IR
01722 0131 00 0 00000 FPTA XCA AC TO MQ
01723 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
01724 0602 00 0 01757 SLW FPTAC STORE OCTAL FOR LEFT HALF OF AC
01725 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
01726 0602 00 0 01760 SLW FPTAD STORE AWAY IN ERROR MESSAGE
01727 0560 00 0 01717 LDQ FLXT GET TRAP CELL CONTENTS
01730 -0773 00 0 00022 RQL 18 POSITION IN LEFT HALF OF MQ
01731 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
01732 -0501 00 0 00452 ORA OBLANK MAKE LAEDING ZERO A BLANK
01733 0602 00 0 01754 SLW FPTLO SAVE OCTAL FOR LOCATION OF ERROR
01734 -0774 00 4 01761 AXC FPTF,4 POINTER TO BEGINNING OF ERROR MESSAGE
01735 0520 00 0 01765 ZET FPTDV TEST FOR DIVIDE CHECK ERROR
01736 -0774 00 4 01763 AXC FPTD,4 DIVIDE CHECK MESSAGE
01737 0500 00 4 00000 CLA 0,4 PICK UP PROPER MESSAGE
01740 0601 00 0 01751 STO FPTTY STORE IN MESSAGE
01741 0500 00 4 00001 CLA 1,4
01742 0601 00 0 01752 STO FPTTY+1
01743 0074 00 4 01222 TSX OUTPUT,4 WRITE ERROR MESSAGE
01744 0 00000 0 00364 BCDOUT
01745 0 00010 0 01751 FPTTY,,8
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 21
01746 -0754 00 0 00000 PXD 0,0 CLAER AC
01747 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR PROGRAM
01750 542760600154 BCI 1,*G 1* FLOATING POINT TRAP OR DCT
01751 606060606060 FPTTY BCI 3, AT....
01752 606060606060
01753 216333333333
01754 0 00000 0 00000 FPTLO LOCATION OF ERROR
01755 606631633060 BCI 2, WITH AC =
01756 212360136060
01757 0 00000 0 00000 FPTAC OCTAL LEFT HALF OF AC
01760 0 00000 0 00000 FPTAD OCTAL RIGHT HALF OF AC
01761 002643214760 FPTF BCI 2,0FLAP TRAP
01762 635121476060
01763 002431653124 FPTD BCI 2,0DIVIDE CHK
01764 256023304260
*
* THIS ROUTINE USES $ERROR,$ERRORP11 AND FPTGNR
01765 0 00000 0 00000 FPTDV DIVIDE CHECK INDICATOR CELL
*
*
* STRPNT A DEBUGGING AID WHICH PRINTS THE DECREMENT OF THE AC AS
* A LIST OR DUMPS AC AND IR 4 IN OCTAL WHICH EVER IS APPROPRIATE.
*
01766 0520 00 0 02051 STRPNT ZET STRT TEST IF ROUNTINE IS ACTIVE.
01767 0020 00 0 02037 TRA STREX IT IS THEREFORE EXIT
01770 0634 00 4 02035 SXA STRX,4 NO, SAVE LINK IR
01771 0601 00 0 02046 STO STRA SAVE AC
01772 -0600 00 0 02047 STQ STRQ SAVE MQ
01773 -0625 00 0 02051 STL STRT SET CELL TO INDAICTE ACTIVE
01774 0560 00 0 00000 LDQ 0 PICK UP TRAP LOCATION
01775 -0600 00 0 02052 STQ STRXT SAVE CONTENTS
01776 -0773 00 0 00022 RQL 18 ADDRESS PORTION TO LEFT HALF OF MQ
01777 0074 00 4 11021 TSX OCTALP,4
02000 -0501 00 0 00452 ORA OBLANK LEADING BLANK
02001 0602 00 0 02055 SLW STRM STORE TRAP ADDRESS IN OCATL
02002 0500 00 0 00177 CLA FLAPCZ RESTORE ORIGNAL CONTENTS OF ZERO
02003 0601 00 0 00000 STO 0
02004 0074 00 4 01222 TSX OUTPUT,4
02005 0 00000 0 00364 BCDOUT OUTPUT BCD MESSAGE
02006 0 00005 0 02053 STRN,,5
02007 0560 00 0 02046 STRO LDQ STRA AC AT TIME OF TRAP
02010 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
02011 0602 00 0 02064 SLW STRAMA STORE LEFT HALF IN OCTAL
02012 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
02013 0602 00 0 02065 SLW STRAMB RIGHT HALF IN OCTAL
02014 0560 00 0 02035 LDQ STRX PICK UP LINK IR
02015 -0773 00 0 00025 RQL 21 SHIFT TO LEFT OF MQ
02016 0074 00 4 11021 TSX OCTALP,4 CONVERT TO OCTAL
02017 0771 00 0 00006 ARS 6 MAKE A HOLE
02020 -0501 00 0 00452 ORA OBLANK MAKE LEADING ZERO A BLANK
02021 0602 00 0 02070 SLW STRMC PUT IN MESSAGE
02022 0074 00 4 01222 TSX OUTPUT,4
02023 0 00000 0 00364 BCDOUT OUTPUT IN BCD
02024 0 00011 0 02060 STRMD,,9
02025 -0500 00 0 02046 CAL STRA PICK UP AC
02026 -0734 00 4 00000 PDX 0,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 22
02027 -0320 00 0 00466 ANA PTAMSK MASK OUT ONLY DECREMENT
02030 -0100 00 0 02035 TNZ STRF GO IF ANY THING LEFT
02031 -3 00000 4 02035 STRTOP TXL STRF,4,** -TFS-1 IF NOT IN LIST STRUCTURE
02032 3 00000 4 02035 STRBTM TXH STRF,4,** -BRK GO TO EXIT IF NOT IN FREE STORAG
02033 -0754 00 4 00000 PXD 0,4 OTHERWISE
02034 0074 00 4 04604 TSX $PRINT,4 PRINT AS LISP LIST
02035 STRF BSS 0
02035 0774 00 4 00000 STRX AXT **,4 DITTO LINK IR
02036 0600 00 0 02051 STZ STRT INDICATE ROUTINE IS INACTIVE
02037 0522 00 0 01403 STREX XEC $SWT6 SHOULD WE GO BACK TO OVERLORD
02040 0020 00 0 02042 TRA *+2
02041 0020 00 0 10230 TRA OVRLRD FIND NEXT OVERLORD DIRECTION CARD
02042 -0754 00 0 00000 PXD 0,0
02043 -0634 00 4 01562 SXD $ERROR,4
02044 0074 00 4 01563 TSX $ERROR+1,4
02045 542660600554 BCI 1,*F 5* STR TRAP ERROR
*
*
02046 0 00000 0 00000 STRA AC STROAGE
02047 0 00000 0 00000 STRQ MQ
02050 -3 00000 0 00000 STRD TXL **,,** MASK FOR PREFIX
02051 0 00000 0 00000 STRT CELL INDICATES ACTIVE IF NON-ZERO
02052 0 00000 0 00000 STRXT STORAGE FOR CONTENTS OF ZERO
02053 006263516063 STRN BCI 2,0STR TRAP AT
02054 512147602163
02055 0 00000 0 00000 STRM PZE TRAP LOCATION IN OCTAL
02056 604623632143 BCI 2, OCTAL.
02057 336060606060
02060 004623632143 STRMD BCI 4,0OCTAL CONTENTS OF AC
02061 602346456325
02062 456362604626
02063 602123606060
02064 0 00000 0 00000 STRAMA
02065 0 00000 0 00000 STRAMB OCTAL CONTENTS OF AC GO HERE
02066 602145246031 BCI 2, AND INDEX 4
02067 452425676004
02070 0 00000 0 00000 STRMC OCATL LINK IR CONTENTS GO HERE
*
* THIS ROUTINE USES $PRINT,OUTPUT,BCDOUT AND OBLANK
*
*
ERROR1 USER BY APPLY HAS ONE ARGUMENT AND PRINTS IT USING
PRINT
02071 -0634 00 4 01562 ERROR1 SXD $ERROR,4
02072 0074 00 4 01563 TSX $ERROR+1,4
02073 542160600154 BCI 1,*A 1* APPLIED FUNCTION CALLED ERROR
*
* SETUP TAKES SIZE PARAMETERS AND SETS UP THE DEPENDENT CELLS
* MAINLY IN THE RECLAIMER (GARBAGGE COLLECTOR) AND STRPNT
*
HEAD E
*
* RESETP ALTERNATE ENTRANCE TO SETUP TO CHANGE COMPOSITION OF
* FREE STRORAGE SLIGHTLY.
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 23
*
02074 -0625 00 0 02256 RESETP STL RST SET RESETUP SWITCH
02075 0634 00 4 02252 SXA SUPX,4 SAVE LINK IR
02076 0020 00 0 02147 TRA RSU CHANGE GARBAGGE COLLECTOR PARAMETERS
*
02077 0634 00 4 02252 SETUP SXA SUPX,4 SAVE LINK IR
02100 0500 00 0 02303 CLA $TPG
02101 0601 00 0 02304 STO $ORG
02102 0400 00 0 02305 ADD LBINPG
02103 0734 00 4 00000 PAX 0,4
02104 1 77777 4 02105 TXI *+1,4,-1
02105 -0634 00 4 16526 SXD C$LBPTP,4 SETUP FOR LAP
02106 0737 00 4 00000 PAC 0,4
02107 -0634 00 4 04016 SXD BLKETP,4 END OF BLOCK RESERVATION
02110 0400 00 0 00371 ADD $Q1
02111 0737 00 4 00000 PAC 0,4
02112 -0634 00 4 02317 SXD $CPPI,4 SET PUSH DOWN CELLS
02113 -0634 00 4 02413 SXD $CSSI,4
02114 -0634 00 4 11670 SXD NUBPDL,4 PRIVATE COPY FOR BACKTRACE
02115 0400 00 0 02306 ADD LPBPDL
02116 0621 00 0 02761 STA ZPDL G C ZEROS THE UNUSED PDL
02117 0402 00 0 00407 SUB $Q20 PROTECTION AGINST COMPILER SAVING
02120 0737 00 4 00000 PAC 0,4 WTH OUT LOOKING
02121 -0634 00 4 02414 SXD ENDPDL,4 OUT OF PDL TEST
02122 0500 00 0 02274 CLA $TFS
02123 0402 00 0 02310 SUB LFREES
02124 0621 00 0 02277 STA $TBT
02125 0400 00 0 00371 ADD $Q1
02126 0621 00 0 02276 STA $BFS
02127 0500 00 0 02307 CLA LFULWS
02130 0771 00 0 00005 ARS 5
02131 0400 00 0 00371 ADD $Q1
02132 0601 00 0 02311 STO $LBT
02133 0500 00 0 02276 CLA $BFS
02134 0402 00 0 02311 SUB $LBT
02135 0601 00 0 02300 STO $BBT
02136 0402 00 0 00371 SUB $Q1
02137 0601 00 0 02301 STO $TFW
02140 0500 00 0 02276 CLA $BFS
02141 0402 00 0 02307 SUB LFULWS
02142 0601 00 0 02302 STO $BFW
02143 0402 00 0 02306 SUB LPBPDL
02144 0402 00 0 02305 SUB LBINPG
02145 0402 00 0 02303 SUB $TPG
02146 -0120 00 0 02257 TMI SETERR OVER LAPPING STORAGE ERROR
* STRPNT SETUP
02147 0535 00 4 02274 RSU LAC $TFS,4
02150 1 77777 4 02151 TXI *+1,4,-1
02151 -0634 00 4 02031 SXD STRTOP,4
02152 0535 00 4 02276 LAC $BFS,4
02153 -0634 00 4 02032 SXD STRBTM,4
* RECLAIMER SETUP
02154 0534 00 4 02311 LXA $LBT,4
02155 0634 00 4 02532 SXA A,4
02156 0534 00 4 02276 LXA $BFS,4
02157 0634 00 4 02533 SXA B,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 24
02160 0534 00 4 02301 LXA $TFW,4
02161 -0634 00 4 02645 SXD C,4
02162 -0634 00 4 02734 SXD I,4
02163 -0634 00 4 03116 SXD MONE,4
02164 0534 00 4 02277 LXA $TBT,4
02165 0634 00 4 02662 SXA MBTTA,4
02166 0634 00 4 02667 SXA D,4
02167 0634 00 4 02677 SXA E,4
02170 0634 00 4 03126 SXA MLTBT,4
02171 0534 00 4 02274 LXA $TFS,4
02172 0634 00 4 02713 SXA F,4
02173 0534 00 4 02276 LXA $BFS,4
02174 0634 00 4 02746 SXA SFWLD,4
02175 0534 00 4 02302 LXA $BFW,4
02176 0634 00 4 02733 SXA H,4
02177 0535 00 4 02302 LAC $BFW,4
02200 -0634 00 4 03066 SXD MRKLST,4
02201 -0634 00 4 03114 SXD MLBDW,4
02202 0535 00 4 02274 LAC $TFS,4
02203 1 77777 4 02204 TXI *+1,4,-1
02204 -0634 00 4 03067 SXD MRKLST+1,4
02205 -0634 00 4 03111 SXD MLIST,4
02206 0535 00 4 02276 LAC $BFS,4
02207 -0634 00 4 02720 SXD G,4
02210 -0634 00 4 03112 SXD MLBFA,4
02211 -0535 00 4 02414 LDC ENDPDL,4
02212 1 00001 4 02213 TXI *+1,4,1
02213 0634 00 4 03100 SXA MLEPD,4
02214 0634 00 4 03107 SXA MLEPE,4
02215 0535 00 4 02300 LAC $BBT,4
02216 -0634 00 4 03113 SXD MLBBJ,4
02217 0520 00 0 02256 ZET RST SKIP IF INITIAL SETIP
02220 0020 00 0 02252 TRA SUPX GO TO EXIT OTERWISE
02221 0535 00 4 02276 LAC $BFS,4 BOTTOM OF FREE STORAGE
02222 1 77777 4 02223 TXI *+1,4,-1 SUBSTRACT 1
02223 -0634 00 4 02232 SXD SUPFS,4 SET DECREMENT
02224 0535 00 4 02275 LAC $MFS,4 LOWERP
02225 -0754 00 4 00000 PXD 0,4 POINTER TO LWERP IN DECREMENT
02226 0601 00 0 03751 STO $FREE SET UP FREE
02227 0400 00 0 00442 ADD $QD1
02230 0601 00 4 00000 STO 0,4 START MAKING FREE STORAGE
02231 1 00001 4 02232 TXI *+1,4,1
02232 -3 00000 4 02227 SUPFS TXL *-3,4,** -BFS
02233 0600 00 4 00000 STZ 0,4
02234 0535 00 4 02302 LAC $BFW,4 BOTTOM FULL WORD SPACR
02235 -0754 00 4 00000 PXD 0,4
02236 0601 00 0 03727 STO FWORDL SET UP FULL WORD LIST
02237 -0737 00 4 00000 PDC 0,4 GET IT RUE IN INDEX
02240 -0634 00 4 02243 SXD SUPFV,4 USE TO CALCULATE LENGTH OF FULL WORD S
02241 0534 00 4 02300 LXA $BBT,4 TFW + 1
02242 0634 00 4 02245 SXA SUPFW,4 SET END + 1 ADDRESSS
02243 2 00000 4 02244 SUPFV TIX *+1,4,** LENGHT OF FULL WORD
02244 0402 00 0 00442 SUB $QD1
02245 0601 00 4 00000 SUPFW STO **,4 MAKE LIST
02246 2 00001 4 02244 TIX *-2,4,1 LOOP
02247 0600 60 0 02245 STZ* SUPFW MAKE LAST ENTRY ZERO
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 25
02250 0500 00 0 66430 CLA $OBLB BEGINNING OF UNSORTED OBJECT LIST
02251 0074 00 4 02420 TSX CNSFWL,4
02252 0774 00 4 00000 SUPX AXT **,4
02253 0600 00 0 02256 STZ RST ZERO RESETUP SWITCH
02254 -0754 00 0 00000 PXD 0,0
02255 0020 00 4 00001 TRA 1,4
02256 0 00000 0 00000 RST RESETUP TEST CELL
02257 0074 00 4 01222 SETERR TSX OUTPUT,4
02260 -0 00000 0 00364 MZE BCDOUT PRINT ON-LINE
02261 0 00011 0 02263 NOSET,,9
02262 0020 00 0 02252 TRA SUPX EXIT
02263 004665255143 NOSET BCI 9,0OVERLAPPING PARAMETERS -SETUP- ERROR NUMBER *O 7*
02264 214747314527
02265 604721512144
02266 256325516260
02267 406225636447
02270 406025515146
02271 516045644422
02272 255160544660
02273 600754606060
*
HEAD 0
*
* STORAGE MAP CELLS FOR LISP
*
02274 0 00000 0 71651 TFS UPERML-1 UPPER LIMIT OF FREE STORAGE
02275 0 00000 0 66230 MFS LOWERP LOW LIMIT OF PERM. LIST STRUCTURE
02276 0 00000 0 00000 BFS BOTTOM OF FREE STORAGE
02277 0 00000 0 00000 TBT TOP OF BIT TABLE
02300 0 00000 0 00000 BBT BOTTOM OF BIT TABLR
02301 0 00000 0 00000 TFW TOP OF FULL WORD SPACE
02302 0 00000 0 00000 BFW BOTTOM OF FULL WORD SPACE PROPER
02303 0 00000 0 17462 TPG TOPROG
02304 0 00000 0 00000 ORG ORIGIN OF BINARY PROGRAM IN DECREMENT
02305 0 00000 0 00000 LBINPG LENGTH OF BINATY PROGRAM
02306 0 00000 0 00000 LPBPDL LENGTH OF PUBLIC PUSH DOWN LIST
02307 0 00000 0 00000 LFULWS LENGTH OF FULL WORD SPACE + BIT TABLE
02310 0 00000 0 00000 LFREES LENGTH OF FREE STORAGE
02311 0 00000 0 00000 LBT LENGTH OF FULL WORD BIT TABLE
* SAVE AND UNSAVE THE CLOSRD SUBROUTINES THAT CONTROL
* THE PUBLIC PUSH DOWN LIST. THE CALLING SEQUENCES ARE ...
*
* TSX $SAVE,4
* TXL $ENDN,,END OF BLOCK TO BE SAVED + 2
* RETURN
* WHERE N IN $ENDN IS THE NUMBER OF ITEMS TO BE SAVED
*
* TSX UNSAVE,4
* RETURN
* THE SAVED ITEMS MUST BE IN A CONTIGOUS BLOCK WITH THE
* THE FIRST ITEM PZE ATOMIC NAME OF SUBR,,IR 4
* THE SAVE PARAMETER WORD IS ADDED AS THE LAST ITEM ON THE
* BLOCK TO BE SAVED BUT IS NOT UNSAVED.
*
02312 0634 00 2 02405 SAVE SXA SAVY,2 SAVE INDEX 2 AND 1
02313 0634 00 1 02404 SXA SAVZ,1
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 26
02314 0601 00 0 02407 STO SAVT SAVE THE AC
02315 0500 60 4 00001 CLA* 1,4 AMMOUNT TO SUBTRACT FROM CPPI IN AC
02316 0734 00 1 00000 PAX 0,1 PUT - NUMBER OF ITEMS TO BE SAVED + 1
02317 1 00000 1 02320 CPPI TXI *+1,1,** IN IR 1 AND INCREMENT BE PUSH DOWN CNT
02320 -3 00000 1 02415 TXL NOPDL,1,** GO TO NOPDL IF NOT ENOUGH PDL
02321 -0634 00 1 02317 SXD $CPPI,1 UP DATE PDL COUNTER LOCATION
02322 0500 00 4 00001 CLA 1,4 PARAMETER WORD
02323 0601 00 1 77777 STO -1,1 PUT ON PUSH DOWN LIST
02324 -0737 00 2 00000 PDC 0,2 LOCATION OF BLOCK TO BE SAVED + 2
02325 0522 00 4 00001 XEC 1,4 JUMP INTO SAVE TABLE
*
02326 0634 00 2 02405 UNSAVE SXA SAVY,2 SAVE INDEX 2 AND 1
02327 0634 00 1 02404 SXA SAVZ,1
02330 0601 00 0 02407 STO SAVT SAVE THE AC
02331 -0534 00 2 02317 LXD $CPPI,2 CURRENT PUSH DOWN COUNTER
02332 0500 00 2 77777 CLA -1,2 LAST SAVE PARAMETER WORD
02333 0621 00 0 02336 STA SAVJ SET FETCH AND TXI INSTRUCTIONS
02334 0621 00 0 02342 STA SAVK
02335 -0634 00 2 02337 SXD SAVI,2 SET UP TO RESTORE PDL COUNTER
02336 0535 00 1 00000 SAVJ LAC **,1 NUMBER TO BE UNSAVED
02337 1 00000 1 02340 SAVI TXI *+1,1,** ADD PUSH DOWN COUNTER
02340 -0634 00 1 02317 SXD $CPPI,1 UPDATE PDL COUNTER CELL
02341 -0737 00 1 00000 PDC 0,1 LOCATION OF END OF BLOCK + 2
02342 1 00001 4 00000 SAVK TXI **,4,1 JUMP TO PUSH DOWN TABLE AND SET IR 4
* PROPER EXIT .
*
* SAVE AND UNSAVE TABLE TO DO THE ACTUAL MOVING TO AND FROM
* THE PUBLIC PUSHD DOWN LIST.
*
02343 0500 00 2 77757 END16 CLA -17,2
02344 0601 00 1 77757 STO -17,1
02345 0500 00 2 77760 END15 CLA -16,2
02346 0601 00 1 77760 STO -16,1
02347 0500 00 2 77761 END14 CLA -15,2
02350 0601 00 1 77761 STO -15,1
02351 0500 00 2 77762 END13 CLA -14,2
02352 0601 00 1 77762 STO -14,1
02353 0500 00 2 77763 END12 CLA -13,2
02354 0601 00 1 77763 STO -13,1
02355 0500 00 2 77764 END11 CLA -12,2
02356 0601 00 1 77764 STO -12,1
02357 0500 00 2 77765 END10 CLA -11,2
02360 0601 00 1 77765 STO -11,1
02361 0500 00 2 77766 END9 CLA -10,2
02362 0601 00 1 77766 STO -10,1
02363 0500 00 2 77767 END8 CLA -9,2
02364 0601 00 1 77767 STO -9,1
02365 0500 00 2 77770 END7 CLA -8,2
02366 0601 00 1 77770 STO -8,1
02367 0500 00 2 77771 END6 CLA -7,2
02370 0601 00 1 77771 STO -7,1
02371 0500 00 2 77772 END5 CLA -6,2
02372 0601 00 1 77772 STO -6,1
02373 0500 00 2 77773 END4 CLA -5,2
02374 0601 00 1 77773 STO -5,1
02375 0500 00 2 77774 END3 CLA -4,2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 27
02376 0601 00 1 77774 STO -4,1
02377 0500 00 2 77775 END2 CLA -3,2
02400 0601 00 1 77775 STO -3,1
02401 0500 00 2 77776 END1 CLA -2,2
02402 0601 00 1 77776 STO -2,1
02403 0500 00 0 02407 END0 CLA SAVT RESTORE THE AC
02404 0774 00 1 00000 SAVZ AXT **,1 AND INDEX 1 + 2
02405 0774 00 2 00000 SAVY AXT **,2
02406 0020 00 4 00002 TRA 2,4 EXIT
*
02407 0 00000 0 00000 SAVT TEMPORARY STORAGE FOR AC
* TIMING INFORMATION .. SAVE AND UNSAVE 34 + 4N CYCLES
* ON THE 709 (SUBTRACT 5 CYCLES FOR SAVE AND 4 FOR UNSAVE
* ON THE 7090)
*
TERPDL
RESETS PUBLIC PUSH DOWN LIST TO ZERO
02410 0500 00 0 02413 TERPDL CLA $CSSI
02411 0622 00 0 02317 STD CPPI
02412 0020 00 4 00001 TRA 1,4
02413 0 00000 0 00000 CSSI
02414 -3 00000 4 02415 ENDPDL TXL *+1,4,** OUT OF PDL TEST INSTRUCTION (IS XEC)
02415 -0634 00 4 01562 NOPDL SXD $ERROR,4
02416 0074 00 4 01563 TSX $ERROR+1,4
02417 542760600254 BCI 1,*G 2* OUT OF PUBLIC PUSH DOWN LIST
*
HEAD E
*
* CNSFWL USED BY SETUP TO MOVE ALL FULL WORDS ON PERMENENT OBJECTS
* TO THE FULL WORD SPACE.
* ALSO BUCKET SORTS THE PERMENENT OBJECTS.
*
02420 0634 00 4 02447 CNSFWL SXA CNFWX,4 SAVE INDEX REGISTERS
02421 0634 00 2 02450 SXA CNFWY,2
02422 -0734 00 4 00000 PDX 0,4 POINTER TO OBJECT LIST
02423 0500 00 4 00000 CNMLP CLA 0,4 NEXT WORD ON LIST
02424 0622 00 0 03310 STD CNXT POINTER TO NEXT WORD
02425 0734 00 2 00000 PAX 0,2 POINTET TO AN ATOM
02426 -0634 00 2 03313 SXD CNAT,2 SAVE THE POINTER TO THE ATOM
02427 0500 00 2 00000 CLA 0,2
02430 -0320 00 0 00470 ANA TAGMSK TEST FOR NUMBER
02431 -0100 00 0 02452 TNZ CNNM MAKE A NUMVER
02432 0500 00 2 00000 CNSLP CLA 0,2 NEXT WORD ON ATOM
02433 0734 00 2 00000 PAX 0,2 CAR OF ATOM, SEARCH FOR FULL WORD
02434 3 06733 2 02436 TXH *+2,2,$SUBR SUCH AS $SUBR
02435 3 06732 2 02461 TXH CMKO,2,$SUBR-1
02436 3 10103 2 02440 TXH *+2,2,$FSUBR
02437 3 10102 2 02461 TXH CMKO,2,$FSUBR-1
02440 3 07335 2 02442 TXH *+2,2,$PNAME
02441 3 07334 2 02476 TXH CMPNT,2,$PNAME-1
02442 -0734 00 2 00000 CNRS PDX 0,2 IS NONE OF THE ABOVE SO CDR TO IR 2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 28
02443 3 00000 2 02432 CNRT TXH CNSLP,2,0 GO BACK IF NOT END OF PROPERTY LIST
02444 -0534 00 4 03310 CNNR LXD CNXT,4 POINTER TO NEXT OBJECT
02445 3 00000 4 02423 TXH CNMLP,4,0 GO BACK IF NOT END
02446 -0754 00 0 00000 PXD 0,0 CLAER AC
02447 0774 00 4 00000 CNFWX AXT **,4 RESTORE INDEX REGISTERS
02450 0774 00 2 00000 CNFWY AXT **,2
02451 0020 00 4 00001 TRA 1,4 EXIT
*
02452 0500 00 2 00000 CNNM CLA 0,2
02453 -0120 00 0 02444 TMI CNNR DONT MOVE NUMBERS WITH MZE PREFIX
02454 -0734 00 4 00000 PDX 0,4
02455 0500 00 4 00000 CLA 0,4
02456 0074 00 4 03710 TSX $CONSW,4
02457 0622 00 2 00000 STD 0,2
02460 0020 00 0 02444 TRA CNNR MAKE UP THE NEW NUMBER
*
02461 -0734 00 2 00000 CMKO PDX 0,2 PUT ONE WORD IN FULL WORD SPACE
02462 0500 00 2 00000 CLA 0,2 GET NEXT WORD ON PROPERTY LIST
02463 0622 00 0 03311 STD CNX POINTER TO REST OF OBJECT
02464 -0120 00 0 02474 TMI CMK SKIP MOVING TO REST OF OBJECT
02465 0734 00 4 00000 PAX 0,4 SENSED, OTHERWISE GET POINTER TO FULL
02466 0500 00 4 00000 CLA 0,4 WORD AND WORD IT SELF IN AC
02467 0074 00 4 03710 TSX $CONSW,4 PUT IT IN FULL WORD SPACE
02470 0771 00 0 00022 ARS 18 MOVE POINTER TO WORD IN FWS TO ADDRESS
02471 0621 00 2 00000 STA 0,2 REPLACE THE ADDRESS
02472 -0534 00 2 03311 LXD CNX,2 POINTRE TO NEXT WORD ON PROPERTY LIST
02473 0020 00 0 02443 TRA CNRT RETURN
*
02474 0602 00 2 00000 CMK SLW 0,2 RESTORE WORD WITH PLUS SIGN
02475 0020 00 0 02442 TRA CNRS GO BACK
*
02476 -0734 00 2 00000 CMPNT PDX 0,2 PUT PRINT NAME IN FULL WORD SPACE
02477 0500 00 2 00000 CLA 0,2 NEXT WORD ON PROPERTY LIST
02500 0622 00 0 03311 STD CNX POINTER TO NEXT WORD ON PROPERTY LIST
02501 0734 00 2 00000 PAX 0,2 POINTET TO PNAME LIST
02502 -0634 00 2 03314 SXD CNVA,2 SAVE IT
02503 0500 00 2 00000 CMPLP CLA 0,2 FIRST FORD ON PNAME LIST
02504 -0120 00 0 02515 TMI CMPS SKIP IF WORD IS FLAGGED
02505 0622 00 0 03312 STD CNFT POINTER TO NEXT WORD ON PNAME LIST
02506 0734 00 4 00000 PAX 0,4 POINTER TO FULL WORD
02507 0500 00 4 00000 CLA 0,4 FULL WORD
02510 0074 00 4 03710 TSX $CONSW,4 PUT IN FULL WORD SPACE
02511 0771 00 0 00022 ARS 18 POINTER TO WORD
02512 0621 00 2 00000 STA 0,2 RPLACE THE ADDRESS
02513 -0534 00 2 03312 LXD CNFT,2 POINTER TO NEXT WORD ON PNAME LIST
02514 3 00000 2 02503 TXH CMPLP,2,0 GO BACK IF NOT END
02515 0500 00 0 03314 CMPS CLA CNVA POINTER TO PNAME LIST
02516 0560 00 0 03313 LDQ CNAT ATOM THAT WE ARE WORKING ON
02517 0074 00 4 06417 TSX BUKSRT,4 PUT ON BUCKET SORTED OBJECT LIST
02520 -0534 00 2 03311 LXD CNX,2 POINTER TO NEXT WORD ON ATOM
02521 0020 00 0 02443 TRA CNRT GO BACK
*
*
*
* RECLAIMER LISP 1.5 STORAGE CONTROL PROGRAM. CODED 1 MARCH 1961
*
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 29
02522 0634 00 4 03043 RECLAM SXA RCX,4 SAVE INDEX REGISTER
02523 0634 00 2 03044 SXA RCY,2
02524 0634 00 1 03045 SXA RCZ,1
02525 0604 00 0 03224 STI RCIND AND MACHINE REGISTETS
02526 0601 00 0 03306 STO RCAC
02527 -0600 00 0 03307 STQ RCMQ
02530 0600 00 0 03225 STZ RCBE INITIALIZE BAD EXIT CELL
02531 0560 00 0 03270 RCA LDQ RCSGNL SIGNAL PHASE 1
02532 0774 00 4 00000 A AXT **,4 BIT TABLE LENGTH
02533 0600 00 4 00000 B STZ **,4 DOTTOM FREE STORAGE
02534 2 00001 4 02533 TIX *-1,4,1 ZERO THE BIT TABLE
02535 -0534 00 4 02414 LXD ENDPDL,4 END OF PDL
02536 -0634 00 4 02540 SXD RCIA,4 SET UP TNX INSTRUCTION
02537 -0534 00 4 02317 LXD $CPPI,4 CURRENT PUSH DOWN LIST LOC.
02540 -2 00000 4 03103 RCIA TNX MLPDE,4,** AMMOUNT OF PUSH DOWN LIST AVAILABLE
02541 -0634 00 4 03102 SXD MLPDC,4 SET CELL IN MRKLST
02542 0634 00 4 02760 SXA ZPDLA,4 LENGTH LEFT BAR FOR ZEROIND PDL
02543 -0774 00 2 66427 AXC OBLIST,2 POINTER TO OBJECT LICT
02544 0441 00 0 10340 LDI SYSIND SYSTEM INDICATORS
02545 0520 00 0 11516 ZET EVQRTS SKIP F DURING READ IN THE EVALQUOTE
02546 0056 00 000004 RNT DEBUGI SKIP MARKING OBLIST IF IN A DEBUG
02547 0074 00 4 03066 TSX MRKLST,4 MARK THE LIST
*
* TEMLIS MARKER
* TEMLIS IS A LIST IN FREE STORAGE AND FULL WORD SPACE
* OF THE FORM (CONS (CONSW BEG,,END) TEMLIS) AND INDICATES
* PLACES WHERE LIST STRUCTURE MAY BE DURING A GARBAGE
* COLLECTION. USED PRINCIPALLY BY THE COMPILER
*
02550 0600 00 0 03273 STZ TMLM SET EXIT SWITCH
02551 -0534 00 4 03304 LXD TEMLIS,4
02552 0500 00 4 00000 TMLJ CLA 0,4 NEXT WORD ON TEMLIS
02553 0622 00 0 03273 STD TMLM SAVE POINTER TO NEXT WORD
02554 0734 00 4 00000 PAX 0,4 POINTER TO FULL WORD
02555 0500 00 4 00000 CLA 0,4 FULL WORD
02556 0734 00 4 00000 PAX 0,4 BEGINNING OF ARRAY
02557 -0634 00 4 02563 SXD TMLD,4
02560 -0734 00 1 00000 PDX 0,1 END OF ARRAY
02561 1 00001 1 02562 TXI *+1,1,1 ADD 1
02562 0634 00 1 02565 TMLK SXA TMLE,1
02563 -2 00000 1 02577 TMLD TNX TMLH,1,** SUBTRACT BEGINNING , GIVES COUNT IN IR
02564 0634 00 1 03216 SXA GCPDLC,1 LAST USE IS MARKING PDL, SAVE LENGTH
02565 0441 00 1 00000 TMLE LDI **,1 PICK UP WORD
02566 0444 00 0 03274 OFT TMPTM SKIP IF NOTAG OR PREFIX
02567 0020 00 0 02576 TRA TMLG NOT A LIST, DO NOT MARK
02570 -0046 00 0 00000 PIA ITEM TO AC
02571 0621 00 0 02574 STA TMLF SAVE ADDRESS
02572 -0734 00 2 00000 PDX 0,2
02573 0074 00 4 03066 TSX MRKLST,4 MARK THE DECREMENT
02574 0774 00 2 00000 TMLF AXT **,2 ADDRESS OF WORD TO IR
02575 0074 00 4 03066 TSX MRKLST,4 MARK IT
02576 2 00001 1 02565 TMLG TIX TMLE,1,1 GET NEXT WORD IN ARRAY
02577 -0534 00 4 03273 TMLH LXD TMLM,4 NEXT TEMLIS ITEM
02600 3 00000 4 02552 TXH TMLJ,4,0 GO IF NOT DONE
02601 0520 00 0 03273 ZET TMLM TEST FOR EXIT
02602 0020 00 0 02611 TRA MPDLF ALL DONE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 30
02603 -0535 00 4 02413 LDC $CSSI,4 BEGINNING OF PDL
02604 -0634 00 4 02563 SXD TMLD,4 SET UP CELL
02605 -0535 00 1 02317 LDC $CPPI,1 FIRST FREE CELL ON PDL
02606 -0625 00 0 03273 STL TMLM INDICATE LAST USE OF LOOP
02607 0600 00 0 03216 STZ GCPDLC PUSH DOWN LENGTH INITIALLY ZERO
02610 0020 00 0 02562 TRA TMLK GO MARK PUSH DOWN LIST
02611 -0534 00 4 03305 MPDLF LXD ARYLIS,4 START TO MARK ACTIVE ARRAYS
02612 -3 00000 4 02707 MARYB TXL RCB,4,0 GO IF NO ARRAYS
02613 0500 00 4 00000 CLA 0,4 NEXT WORD ON ARYLIS
02614 0622 00 0 03226 STD MARYT SAVE POINTER TO NEXT WORD
02615 0734 00 4 00000 PAX 0,4 ARYATOM TO AC
02616 0500 00 4 00000 MARYA CLA 0,4 NEXT WORD ON ATOM
02617 0734 00 4 00000 PAX 0,4
02620 -3 10734 4 02622 TXL *+2,4,$ARRAY-1 SERCH FOR ARRAY SPECIFICATION
02621 -3 10735 4 02626 TXL MRKA,4,$ARRAY GO IF FOUND
02622 -0734 00 4 00000 PDX 0,4 POINTER TO NEXT WORD
02623 3 00000 4 02616 TXH MARYA,4,0 GO IF NOT END OF ATOM
02624 -0534 00 4 03226 MARYC LXD MARYT,4 NEXT WORD ON ARYLIS
02625 0020 00 0 02612 TRA MARYB
*
02626 -0734 00 4 00000 MRKA PDX 0,4 GET ARRAY SPECIFICATIONS
02627 0500 00 4 00000 CLA 0,4
02630 0734 00 4 00000 PAX 0,4
02631 0500 00 4 00000 CLA 0,4
02632 0734 00 4 00000 PAX 0,4
02633 0500 00 4 00000 CLA 0,4 FIRST SPEC. WORD
02634 0734 00 2 00000 PAX 0,2 END OF ARRAY + 1
02635 0621 00 0 02702 STA MRKE END OF ARRAY + 1
02636 0500 00 4 00001 CLA 1,4
02637 0601 00 0 03275 STO MRKP SECOND SPEC. WORD TOTAL L,, LIST L
02640 0734 00 1 00000 PAX 0,1 TOTAL LENGTH
02641 -0634 00 1 02642 SXD MAA,1 UPDATE TNX INSTRUCTION
02642 -2 00000 2 02624 MAA TNX MARYC,2,** LOCATION OF BEGINNING OF ARRAY
02643 0634 00 2 02644 SXA MAB,2 PREPARE TO COMPLEMENT
02644 -0774 00 2 00000 MAB AXC **,2
02645 1 00000 2 02646 C TXI *+1,2,** TOP FULL WORD
02646 0754 00 2 00000 PXA 0,2 CALCULATE BIT TABLE WORD AND BIT
02647 -0765 00 0 00005 LGR 5 BIT NUMBER IN TO MQ
02650 0734 00 2 00000 PAX 0,2 WORD NUMBER IN IR 2
02651 -0754 00 0 00000 PXD 0,0 ZERO AC
02652 -0763 00 0 00005 LGL 5 BIT NUMBER
02653 0734 00 4 00000 PAX 0,4
02654 3 00036 4 02665 TXH MBTT,4,30 GO TO MARK BY 32
02655 -0754 00 0 00000 PXD 0,0 ZERO AC
02656 -0501 00 4 03266 MAC ORA BIT,4
02657 -2 00001 1 02662 TNX MBTTA,1,1 DECREMENT COUNT
02660 2 00001 4 02656 TIX MAC,4,1 RUN BIT COUNT DOWN
02661 -0501 00 0 03266 ORA BIT PUT IN ZERO BIT
02662 -0602 00 2 00000 MBTTA ORS **,2 TOP BIT TABLE, SET BITS
02663 -2 00001 1 02700 TNX MRKF,1,1 GO IF DONE
02664 1 77777 2 02665 TXI *+1,2,-1 DECREMENT BIT WORD BY ONE
02665 -0500 00 0 00471 MBTT CAL MONS ALL ONES TO AC
02666 -2 00040 1 02671 MAE TNX MAD,1,32 DECREMENT COUNT BY 32
02667 -0602 00 2 00000 D ORS **,2 TOP BIT TABLE, SET ALL BITS
02670 1 77777 2 02666 TXI MAE,2,-1 DECREMENT BIT TABLE WORD COUNT
02671 0754 00 1 00000 MAD PXA 0,1 PREPARE TO MARK LAST BITS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 31
02672 0737 00 1 00000 PAC 0,1 COMPLMENT COUNT
02673 -0754 00 0 00000 PXD 0,0 ZERO AC
02674 -0501 00 1 03226 MAF ORA MBITF,1 SET PROPER BIT
02675 1 00001 1 02676 TXI *+1,1,1 INCREMENT COUNT BY ONE
02676 3 00000 1 02674 TXH MAF,1,0 GO UNTIL COUNT REACHES ZERO
02677 -0602 00 2 00000 E ORS **,2 TOP BIT TABLE, SET BITS
02700 -0534 00 1 03275 MRKF LXD MRKP,1 GET LIST LENGTH IF ANY
02701 -3 00000 1 02624 TXL MARYC,1,0 EXIT IF A NON-LIST ARRAY
02702 0500 00 1 00000 MRKE CLA **,1 LIST ITEM
02703 -0734 00 2 00000 PDX 0,2
02704 0074 00 4 03066 TSX MRKLST,4 MARK IT
02705 2 00001 1 02702 TIX MRKE,1,1 GET NEXT ITEM
02706 0020 00 0 02624 TRA MARYC EXIT
*
* ALL MARKING DONE. NOW SWEEP FREE STORAGE.
*
02707 0774 00 2 00000 RCB AXT 0,2 ZERO COUNT IR
02710 0600 00 0 03212 STZ FSC INITIALIZE COUNTER
02711 0560 00 0 03271 LDQ RCSGNM SWEEPING SIGNAL TO MQ
02712 -0774 00 1 03751 AXC $FREE,1 INITIALIZE LAST LOC IR
02713 -0774 00 4 00000 F AXC **,4 TOP FREE STORAGE
02714 0502 00 4 00000 SFSL CLS 0,4 PICK UP WORD
02715 -0120 00 0 02724 TMI SFSC COLLECT IF SIGN NOW MINUS
02716 0601 00 4 00000 STO 0,4 RESTORE WORD WITH + SIGN
02717 1 00001 4 02720 SFSA TXI *+1,4,1 INCREMENT BY ONE
02720 -3 00000 4 02714 G TXL SFSL,4,** LOOP IF LESS THAN BOTTOM FREE STORAGE
02721 0600 00 1 00000 STZ 0,1 ZERO LAST WORD COLLECTED
02722 0634 00 2 03212 SXA FSC,2 SAVE COUNT
02723 0020 00 0 02730 TRA SWPFWS
02724 -0754 00 4 00000 SFSC PXD 0,4 THIS LOCATION
02725 0601 00 1 00000 STO 0,1 STORE POINTER IN LAST WORD COLLECTED
02726 -0734 00 1 00000 PDX 0,1 UP DATE LAST WORD IR
02727 1 00001 2 02717 TXI SFSA,2,1 UPDATE COUNTER
*
* NOW SWEEP FULL WORD SPACE WITH THE BIT TABLE
*
02730 0774 00 4 03727 SWPFWS AXT FWORDL,4 BEGINNING OF FULL WORD LIST
02731 0634 00 4 03057 SXA SFWA,4 INITIALIZE ADDRESS
02732 0600 00 0 03210 STZ FWC ZERO FULL WORD COUNTER
02733 -0774 00 1 00000 H AXC **,1 BOTTOM FULL WORD SPACE
02734 1 00000 1 02735 I TXI *+1,1,** TOP FULL WORD SPACE
02735 0754 00 1 00000 PXA 0,1 GET ADDRESS OF BIT TABLE CORRESPONDING
02736 -0765 00 0 00005 LGR 5 TO THE BOTTOM OF FULL WORD SPACE
02737 0734 00 4 00000 PAX 0,4 BIT TABLE WORD
02740 1 00001 4 02741 TXI *+1,4,1 MAKE INDEXING EASY
02741 -0754 00 0 00000 PXD 0,0 ZERO AC
02742 -0763 00 0 00005 LGL 5 BIT NUMBER
02743 0734 00 2 00000 PAX 0,2 INTO IR 2
02744 1 00001 2 02745 TXI *+1,2,1 MAKE INDEXING EASY
02745 0535 00 1 02733 LAC H,1 SET UP IR 1
02746 0441 00 4 00000 SFWLD LDI **,4 BOTTOM FREE STORAGE, (TBT + 1)
02747 0446 00 0 00471 ONT MONES SKIP IF ALL WORDS TO BE SAVED
02750 0020 00 0 03047 TRA SFWSC SEARCH FOR THE WORDS TO BE COLLECTED
02751 1 77740 1 02752 TXI *+1,1,-32 DECREMENT CURRENT LOC IR
02752 2 00001 4 02746 SFWB TIX SFWLD,4,1 INDEX THROUGH BIT TABLE
02753 0500 00 0 03210 SFWDN CLA FWC ALL DONE, GET FULL WORD COUNTER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 32
02754 0601 60 0 03057 STO* SFWA SET UP LAST CELL COLLECTED
02755 0560 00 0 03272 LDQ RCSGNN PASE 3 SIGNAL
02756 0520 00 0 03220 ZET RCT TEST FOR OUT OF ARRAY SPACE ENTRANCE
02757 0074 00 4 03165 TSX RELOC,4 RELOCATE AND COMPACT FULL WORD SPACE
02760 0774 00 4 00000 ZPDLA AXT **,4 ZERO UNUSED PDL
02761 0600 00 4 00000 ZPDL STZ **,4 ZERO PDL WORD
02762 2 00001 4 02761 TIX *-1,4,1
02763 0560 00 0 00402 LDQ CRITWN CRITACL WORD NUMBER
02764 0600 00 0 03225 STZ RCBE INITIALIZE BAD EXIT TEST CELL
02765 0500 00 0 03210 CLA FWC NUMBER OF FULL WORDS COLLECTED
02766 0040 00 0 02770 TLQ RCEA TRANSFER IF MORE THAN CRITACL COLLECT
02767 -0625 00 0 03225 STL RCBE NOT ENOUGH, SIGNAL BAD EXIT
02770 0400 00 0 03222 RCEA ADD TFWC ADD TOTAL OF FULL WORDS COLLECTED
02771 0601 00 0 03222 STO TFWC UPDATE COUNTER
02772 -0763 00 0 00004 LGL 4 INCREASE TOLERENCE BY 2 TO THE 4 TH
02773 0500 00 0 03212 CLA FSC NUMBER OF FREE STORAGE CELLS PICKED UP
02774 0040 00 0 02776 TLQ RCEB TRA IF GREATER THAN CRITACL NUMBER
02775 -0625 00 0 03225 STL RCBE NO, SIGNAL BAD EXIT
02776 0400 00 0 03223 RCEB ADD TFSC ADD TOTAL OF FREE COLLECTED TO DATE
02777 0601 00 0 03223 STO TFSC UPDATE TOTAL
03000 0500 00 0 03217 CLA RCC NUMBER OF RECLAIMATION CYCLES EXECUTED
03001 0400 00 0 00371 ADD $Q1 INCREMENT BY 1
03002 0601 00 0 03217 STO RCC UPDATE TOTAL
03003 0500 00 0 03221 CLA RLC NUMBER OF TIMES RELOCATION OF FWS
03004 0520 00 0 03220 ZET RCT SKIP IF NO RELOCATION
03005 0400 00 0 00371 ADD $Q1
03006 0601 00 0 03221 STO RLC UPDATE COUNTER
03007 -0520 00 0 03225 NZT RCBE SKIP IF BAD EXIT
03010 0020 00 0 03012 TRA RCED DO GOOD EXIT
03011 0020 00 0 03014 TRA RCEC DO VERBOSE AND BAD EXIT
03012 -0520 00 0 03267 RCED NZT VERBOS SKIP IF TALKATIVE
03013 0020 00 0 03040 TRA RCEXIT DO EXIT
03014 0535 00 4 03043 RCEC LAC RCX,4 GET EXIT IR4
03015 -0754 00 4 00000 PXD 0,4 AND CONVERT FOR PRINTING
03016 0131 00 0 00000 XCA
03017 0074 00 4 11021 TSX OCTALP,4
03020 -0501 00 0 00452 ORA OBLANK
03021 0602 00 0 03201 SLW RCT1
03022 0500 00 0 03210 CLA FWC FULL WORD COUNTER
03023 0074 00 4 04111 TSX $DECON,4 CONVERT TO BCD DECIMAL
03024 0602 00 0 03210 SLW RCT4 PUT IN MESSAGE
03025 0500 00 0 03212 CLA FSC FREE STORAGE COUNTER
03026 0074 00 4 04111 TSX $DECON,4 TO DECIMAL
03027 0602 00 0 03212 SLW RCT5 PUT IN MESSAGE
03030 0500 00 0 03216 CLA GCPDLC NUMBER OF ACTIVE REGISTERS ON PDL
03031 0074 00 4 04111 TSX $DECON,4 TO DECIMAL
03032 0602 00 0 03216 SLW RCT6 IN MESSAGE
03033 0074 00 4 01222 TSX OUTPUT,4 WRITE OUT MESSAGE
03034 0 00000 0 00364 BCDOUT
03035 0 00023 0 03174 RCTM,,19
03036 0520 00 0 03225 ZET RCBE SKIP IF GOOD EXIT
03037 0020 00 0 03152 TRA RCBEX DO BAD EXIT
03040 0500 00 0 03306 RCEXIT CLA RCAC RESTORE MACHINE REGISTERS
03041 0560 00 0 03307 LDQ RCMQ
03042 0441 00 0 03224 LDI RCIND
03043 0774 00 4 00000 RCX AXT **,4 AND INDEX REGISTERS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 33
03044 0774 00 2 00000 RCY AXT **,2
03045 0774 00 1 00000 RCZ AXT **,1
03046 0020 00 4 00001 TRA 1,4 EXIT
03047 0446 00 2 03267 SFWSC ONT MBIT,2 CHECK FOR CURRENT BIT
03050 0020 00 0 03055 TRA SFWC IS OFF, COLLECT WORD
03051 1 77777 1 03052 TXI *+1,1,-1 IS ON, DECREMENT CURRENT LOC IR
03052 2 00001 2 03047 SFWD TIX SFWSC,2,1 INDEX THROUGH THE BITS
03053 0774 00 2 00040 AXT 32,2 SET UP IR WITH NUMBER OF BITS PER WORD
03054 0020 00 0 02752 TRA SFWB EXAMINE NEXT WORD IN BIT TABLE
*
03055 -0754 00 1 00000 SFWC PXD 0,1 COLLECT THIS WORD, POINTER TO THIS WOR
03056 0400 00 0 03210 ADD FWC D PLUS NUMBER OF WORDS COLLECTED IN AC
03057 0601 00 0 00000 SFWA STO ** SET LAST WORD COLLECTED
03060 0400 00 0 00371 ADD $Q1 INCREMENT NUMBER OF FULL WORDS COLLECT
03061 0621 00 0 03210 STA FWC SAVE FULL WORD COUNTER
03062 -0737 00 1 00000 PDC 0,1 COMPLEMENT CURRENT LOCATION
03063 0634 00 1 03057 SXA SFWA,1 TO FORM TRUE ADDRESS FOR UPDATE STORE
03064 -0734 00 1 00000 PDX 0,1 CURRENT LOCATION POINTER
03065 1 77777 1 03052 TXI SFWD,1,-1 DECREMENT CURRENT LOCATION AND RETURN
*
* MRKLST THE RECURSIVE SUBROUTINE THAT DOES ALL LIST MARKING
*
03066 3 00000 2 03132 MRKLST TXH MLEXT,2,** BFW BAR, REJECT POINTERS TO PROGRAM
03067 -3 00000 2 03132 TXL MLEXT,2,** TFS BAR - 1, REJECT POINTERS TO LOADER
03070 0634 00 1 03130 SXA MSRTN,1 SAVE IR 1
03071 0634 00 4 03131 SXA MRKX,4 SAVE LINK IR
03072 0774 00 1 00001 AXT 1,1 PRESET TO ONE FOR FAST PUSH DOWN ACESS
03073 0020 00 0 03111 TRA MLIST DO ACTUAL MARKING
*
03074 0502 00 2 00000 MWIN CLS 0,2 MARK THIS WORD IN FREE STORAGE
03075 0120 00 0 03127 TPL MOUT TRANSFER OUT IF ALREADY MARKED
03076 0601 00 2 00000 STO 0,2 CAR OF LIST
03077 0734 00 2 00000 PAX 0,2 CAR TO IR 2
03100 0622 00 1 00000 MLEPD STD **,1 ENDPDL + 1, SAVE CDR OF LIST ON PDR
03101 1 00001 1 03102 TXI *+1,1,1 INCREMENT PUSH DOWN COUNTER
03102 -3 00000 1 03111 MLPDC TXL MLIST,1,** ENDPDL - C($CPPI) BAR, GO IF NOT NOPDL
03103 0074 00 4 03133 MLPDE TSX RCERR,4 OUT OF PUSH DOWN LIST, FATAL ERROR
03104 004546604724 BCI 3,0NO PDL -MRKLST-
03105 436040445142
03106 436263406060
03107 0500 00 1 00000 MLEPE CLA **,1 ENDPDL + 1, GET CDR OF LIST
03110 -0734 00 2 00000 PDX 0,2 PUT IN IR 2
03111 -3 00000 2 03127 MLIST TXL MOUT,2,** TFS BAR - 1, OUT IF NOT IN LISP STORAG
03112 -3 00000 2 03074 MLBFA TXL MWIN,2,** BOTTOM FREE STORAGE BAR, IN FREE
03113 -3 00000 2 03127 MLBBJ TXL MOUT,2,** BBT BAR OUT IF POINTER TO BIT TABLE
03114 -3 00000 2 03116 MLBDW TXL MONE,2,** BOTTOM FULL WORD BAR, IN FULL WORD
03115 0020 00 0 03127 TRA MOUT EXIT , NOT ANY OF THE ABOVE
*
03116 1 00000 2 03117 MONE TXI *+1,2,** TOP FULL WORD
03117 0754 00 2 00000 PXA 0,2 CALCULATE BIT TABLE WORD AND BIT
03120 -0765 00 0 00005 LGR 5
03121 0734 00 2 00000 PAX 0,2 BIT TABLE WORD
03122 -0754 00 0 00000 PXD 0,0
03123 -0763 00 0 00005 LGL 5 BIT TABLE BIT
03124 0734 00 4 00000 PAX 0,4
03125 -0500 00 4 03266 CAL BIT,4 PICK UP BIT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 34
03126 -0602 00 2 00000 MLTBT ORS **,2 TOP BIT TABLE, PUT IN BIT
03127 2 00001 1 03107 MOUT TIX MLEPE,1,1 GO BACK IF IN RECURSION
03130 0774 00 1 00000 MSRTN AXT **,1 OTHERWISE RESTORE IR 1
03131 0774 00 4 00000 MRKX AXT **,4 AND LINK IR
03132 0020 00 4 00001 MLEXT TRA 1,4 AND EXIT
*
* RCERR RECLAIMER FATAL ERROR DUMP ROUTINE
*
03133 -0634 00 4 01562 RCERR SXD $ERROR,4 SAVE IR 4
03134 0634 00 4 03135 SXA *+1,4 COMPLEMENT IR 4 TO GET ERROR MESSAGE
03135 -0774 00 4 00000 AXC **,4
03136 1 00001 4 03137 TXI *+1,4,1 LOCATION OF ERROR MESSAGE
03137 0634 00 4 03142 SXA RCFEM,4 BUILD OUTPUT CALL
03140 0074 00 4 01222 TSX OUTPUT,4 WRITE ERROR MESSAGE ON TAPE
03141 0 00000 0 00364 BCDOUT
03142 0 00003 0 00000 RCFEM **,,3 WRITE OUT 3 WORDS
03143 0600 00 0 03751 STZ $FREE
03144 0600 00 0 03727 STZ FWORDL ZERO STORAGE LISTS
03145 0441 00 0 10340 LDI SYSIND GET SYSTEM INDICATORS
03146 0055 00 000010 SIR ERRORI SET ERRIR INDICATOR
03147 0604 00 0 10340 STI SYSIND UPDATE REGISTER
03150 0074 00 4 01521 TSX $TIME,4 PRINT THE CURRENT TO TIME
03151 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
*
03152 0441 00 0 03224 RCBEX LDI RCIND RESTORE MACHINE REGISTERS
03153 0500 00 0 03306 CLA RCAC
03154 0560 00 0 03307 LDQ RCMQ
03155 0534 00 4 03043 LXA RCX,4 AND INDEX REGISTERS
03156 0534 00 2 03044 LXA RCY,2
03157 0534 00 1 03045 LXA RCZ,1
03160 -0634 00 4 01562 SXD $ERROR,4 SAVE IR 4
03161 0601 00 0 01556 STO $ERAC SAVE THE CONTENTS OF THE AC
03162 -0754 00 0 00000 PXD 0,0
03163 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
03164 542723600254 BCI 1,*GC 2* NOT ENOUGH WORDS COLLECTED -RECLAIMER-
*
* RELOC RELOCATES ALL ITEMS IN FULL WORDS SPACE INTO A COMPACTED
* BLOCK TO MAKE BLOCKS OF CONTIGOUS STORAGE AVAILABLE FOR
* ARRAYS.
*
03165 0634 00 4 03172 RELOC SXA RELX,4 SAVE LINK IR
03166 0074 00 4 03133 TSX RCERR,4 THIS RPUTINE HAS NOT BEEN CODED YET.
03167 004546605125 BCI 3,0NO RELOCATOR
03170 434623216346
03171 516060606060
03172 0774 00 4 00000 RELX AXT **,4 RESTORE LINK IR
03173 0020 00 4 00001 TRA 1,4 RETURN TO MAIN PROGRAM
*
* MESSAGES AND CONSTANTS PLUS STORAGE GO HERE
*
03174 002721512221 RCTM BCI 5,0GARBAGE COLLECTOR ENTERED AT
03175 272560234643
03176 432523634651
03177 602545632551
03200 252460216360
03201 0 00000 0 00000 RCT1 THE CALL LOCATION IS PUT HERE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 35
03202 604623632143 BCI 4, OCTAL.
03203 336060606060
03204 606060606060
03205 606060606060
03206 606026644343 BCI 2, FULL WORDS
03207 606646512462
03210 0 00000 0 00000 RCT4 NUMBER FULL WORDS COLLECTED
03211 602651252560 BCI 1, FREE
03212 0 00000 0 00000 RCT5 FREE STORAGE WORDS COLLECTED
03213 606047646230 BCI 3, PUSH DOWN DEPTH
03214 602446664560
03215 242547633060
03216 0 00000 0 00000 RCT6 DEPTH ON PUSH DOWN LIST GOES HERE
03210 FWC SYN RCT4
03212 FSC SYN RCT5 STORAGE SAVING SYN S
03216 GCPDLC SYN RCT6
03217 0 00000 0 00000 RCC TOTAL NUMBER OF RECLAMATION CYCLES
03220 0 00000 0 00000 RCT TEST CELL TO SEE IF RELOCATION WAS DON
03220 RCRLOC SYN RCT
03221 0 00000 0 00000 RLC NUMBER OF TIMES RELOCATION WAS DONE
03222 0 00000 0 00000 TFWC TOTAL FULL WORDS COLLECTED
03223 0 00000 0 00000 TFSC TOTAL FREE STORAGE COLLECTED
00471 MONES SYN SEVENS
00471 MONS SYN SEVENS
03224 0 00000 0 00000 RCIND INDICATOR STORAGE
03225 0 00000 0 00000 RCBE TEST CELL FOR BAD EXIT
03226 0 00000 0 00000 MARYT TEMPORAY STORAGE
00402 CRITWN SYN $Q10
*
* BIT TABLES FOR MARKING AND SWEEPING FULL WORD SPACE
*
03227 +000000000020 OCT 20
03230 +000000000040 OCT 40,100,200,400,1000,2000,4000,10000,20000,40000,100000
03231 +000000000100
03232 +000000000200
03233 +000000000400
03234 +000000001000
03235 +000000002000
03236 +000000004000
03237 +000000010000
03240 +000000020000
03241 +000000040000
03242 +000000100000
03243 +000000200000 OCT 200000,400000,1000000,2000000,4000000,10000000,20000000
03244 +000000400000
03245 +000001000000
03246 +000002000000
03247 +000004000000
03250 +000010000000
03251 +000020000000
03252 +000040000000 OCT 40000000,100000000,200000000,400000000,1000000000
03253 +000100000000
03254 +000200000000
03255 +000400000000
03256 +001000000000
03257 +002000000000 OCT 2000000000,4000000000,10000000000,20000000000 PAGE 043
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 36
03260 +004000000000
03261 +010000000000
03262 +020000000000
03263 +040000000000 OCT 40000000000,100000000000,200000000000
03264 +100000000000
03265 +200000000000
03266 -000000000000 BIT OCT 400000000000
03267 MBIT SYN BIT+1
03226 MBITF SYN BIT-32
*
*
03267 -377777777777 VERBOS OCT 777777777777 THIS CELL NON ZERO MAKES THE RECLAIMER
* VERY TALKATIVE
03270 +111111111111 RCSGNL OCT 111111111111
03271 +222222222222 RCSGNM OCT 222222222222
03272 +333333333333 RCSGNN OCT 333333333333 PHASE SIGNAL FOR MQ
03273 0 00000 0 00000 TMLM TEMPORARY STORAGE
03274 -3 00000 7 00000 TMPTM SVN ,7 PREFIX AND TAG MASK
03275 0 00000 0 00000 MRKP TEMPORARY STORAGE
*
03276 0 74500 0 74501 TEMXX -*-1,,-*-2 PERMENANT TEMLIS ITEMS
03277 0 00531 0 00473 BCONAT,,ECONAT
03300 0 74476 0 74477 -*-1,,-*-2
03301 0 16503 0 16477 C$PROBE,,C$PROEN LAP PROTECTED AREA
03302 0 00000 0 74475 -*-1 END OF TEMLIS
03303 0 03707 0 03304 BEGBLK,,ENDBLK-1 FUNCTION STORAGE
*
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 37
EJECT
* STORAGE BLOCK FOR FUNCTIONS ALL OVER THE PACKAGE
*
03304 BEGBLK BSS 0
* RECLAIMER STORAGE TO BE MARKED
03304 0 74502 0 00000 TEMLIS ,,-TEMXX
03305 0 00000 0 00000 ARYLIS LIST OF ACTIVE ARRAYS
03306 0 00000 0 00000 RCAC AC STORAGE
03307 0 00000 0 00000 RCMQ MQ-STORAGE
* CNSFWL STORAGE
03310 0 00000 0 00000 CNXT POINTER TO NEXT WORD ON LINEAR OBJLIST
03311 0 00000 0 00000 CNX POINTER TO NEXT WORD ON PROPERTY LIST
03312 0 00000 0 00000 CNFT POINTER TO NEXT WORD ON PNAME LIST
03313 0 00000 0 03313 CNAT * POINTER TO FIRST WORD OF CURRENT ATOM
03314 0 00000 0 00000 CNVA POINTER TO FIRST WORD OF PNAME LIST
*******************************************************
* THESE CARDS ARE A BLOCK
HEAD A $ALIST AND RET IR4
03315 0 00000 0 00000 CSV
HEAD 0 ARGUMENT REGISTERS
03316 0 00000 0 00000 ALIST REFERED TO BY COMPILED FUNCTIONS
REGISTERS FOR FUNCTION ARGUMENTS. ARG1 ANDARG2 ARE NOT
NORMALLY USED.
03317 0 00000 0 00000 ARG1
03320 0 00000 0 00000 ARG2
03321 0 00000 0 00000 ARG3
03322 0 00000 0 00000 ARG4
03323 0 00000 0 00000 ARG5
03324 0 00000 0 00000 ARG6
03325 0 00000 0 00000 ARG7
03326 0 00000 0 00000 ARG8
03327 0 00000 0 00000 ARG9
03330 0 00000 0 00000 ARG10
03331 0 00000 0 00000 ARG11
03332 0 00000 0 00000 ARG12
03333 0 00000 0 00000 ARG13
03334 0 00000 0 00000 ARG14
03335 0 00000 0 00000 ARG15
03336 0 00000 0 00000 ARG16
03337 0 00000 0 00000 ARG17
03340 0 00000 0 00000 ARG18
03341 0 00000 0 00000 ARG19
03342 0 00000 0 00000 ARG20
*************************************************
HEAD R AND
03343 0 00000 0 10772 EVA1 $AND
03344 0 00000 0 00000 EVA2
03345 0 00000 0 00000 EVA9
HEAD A APPEND
03346 0 00000 0 10762 AS1 $F1
03347 0 00000 0 00000 CWR1
HEAD A APPLY
03350 0 00000 0 00000 ASS1
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 38
03351 0 00000 0 00000 ASSL
03352 0 00000 0 00000 ASSA
03353 0 00000 0 00000 AST1
03354 0 00000 0 00000 AST2
03355 0 00000 0 00000 AST3
03356 0 00000 0 00000 AST4
HEAD R COPY
03357 0 00000 0 10430 CS1 $COPYN
03360 0 00000 0 00000 CS2
HEAD C CP1
03361 0 00000 0 10440 CR1 $F12
03362 0 00000 0 00000 CR2
03363 0 00000 0 00000 CWRL
HEAD A EVCON
03364 0 00000 0 10460 ECS1 $COND
03365 0 00000 0 00000 ECS2
03366 0 00000 0 00000 ECS3
03367 0 00000 0 00000 ECS4
HEAD R EVLIS
03370 0 00000 0 10167 EVLX EVLISL LINK IR
03371 0 00000 0 00000 ELA ALIST
HEAD A EVP26
03372 0 00000 0 00000 EVS1 IR4, BOTTOM OF PROTECTED TEMP. STORAGE
03373 0 00000 0 00000 EVSE
03374 0 00000 0 00000 EVSA
03375 -0 00000 0 00000 EVTRK MZE TRACE SWITCH
03376 0 00000 0 00000 EVCDR ARG LIST FOR SUBR ARGUMENTS
03411 EAG11 BES 10 ARGUMENT BLOCK FOR EVAL
03411 0 00000 0 00000 EVTDE CDR(E)
03412 0 00000 0 00000 EVD2
HEAD R GO SPECIAL FORM
03413 0 00000 0 10037 GOX $GO LINK IR
HEAD R LABP
03414 0 00000 0 00000 BFS4
HEAD R LAMP
03415 0 00000 0 00000 BFS2
03416 0 00000 0 00000 BFS3
*
HEAD C LINK FOR COMPILED FUNCTIONS
03417 0 00000 0 00000 LNKA LINK STORAGE FOR AC
03420 0 00000 0 00000 LNKB LINK STORAGE FOR MQ
HEAD D MAPCAR
03421 0 00000 0 07646 RET $PMAPCA
03422 0 00000 0 00000 L
03423 0 00000 0 00000 F
HEAD R MAPCON
03424 0 00000 0 07636 MCN5 -$)069B
03425 0 00000 0 00000 MCN4
03426 0 00000 0 00000 MCN3
03427 0 00000 0 00000 MCN2
HEAD R MAPLIS
03430 0 00000 0 07626 MS1 -$)069A LINK IR STORAGE
03431 0 00000 0 00000 MS2 ARGUMENT L
03432 0 00000 0 00000 MS3 FUNCTIONAL ARGUMENT
03433 0 00000 0 00000 MS4 FINAL ANSWER
03434 0 00000 0 00000 MS5 INTERMEDIATE ANSWER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 39
HEAD R OR
03435 0 00000 0 07435 EVR1 $OR
03436 0 00000 0 00000 EVR2
03437 0 00000 0 00000 EVR9
HEAD A PAIR
03440 0 00000 0 00000 TEM FIRST ARGUMENT
03441 0 00000 0 00000 LIS SECOND ARGUMENT
HEAD P PRINAR
03442 0 00000 0 00000 PAS3
03443 0 00000 0 00000 PAS4
HEAD R PROGRAM FEATURE
03444 0 00000 0 07300 INTRX $PROG LINK INDEX REGISTER
03445 0 00000 0 00000 INTB CURRENT STATEMENT
03446 0 00000 0 00000 INTGL GO LIS,(LIST OF PROGRAM POINTS) + IR2
03447 0 00000 0 00000 INTPL PAIR LIST
03450 0 00000 0 00000 INTGS GO SWITCH , NON-ZERO IF GO OR RETURN
HEAD I READ1
03451 0 00000 0 07226 RS1 $F13
03452 0 00000 0 00000 RS2
03453 0 00000 0 00000 PRINTL TEMPORARY STORAGE FOR PRINT OR PUNCH
HEAD R SEARCH
03454 0 00000 0 07042 SRS1 $SRCH IR4
03455 0 00000 0 00000 SRS2 L
03456 0 00000 0 00000 SRS3 P
03457 0 00000 0 00000 SRS4 F
03460 0 00000 0 00000 SRS5 U
HEAD R SETQP
03461 0 00000 0 07022 REPS1 $SETQ
03462 0 00000 0 00000 REPV
03463 0 00000 0 00000 REPT1
HEAD B SUBLIS
03464 0 00000 0 06726 X1 $F17 IR4 OF SUBLIS
03465 0 00000 0 00000 X2 CDR(E)
03466 0 00000 0 00000 X3 CAR(E)
03467 0 00000 0 00000 X4 SUBLIS(P,CDR(E))
03470 0 00000 0 00000 X5 CDAR(J)
03471 0 00000 0 00000 P
03472 0 00000 0 00000 E
HEAD R SUBST
03473 0 00000 0 00000 SXT
03474 0 00000 0 00000 SZ
03475 0 00000 0 00000 SX
03476 0 00000 0 00000 SY
03477 0 00000 0 00000 ST
HEAD Q ADD, ETC.
03500 0 00000 0 00000 AMIR IR 4 STRAGE
03501 0 00000 0 00000 AMIND INDICATOR REGISTER STORAHE
03502 0 00000 0 00000 AMLIS LIST STORAGE
03503 0 00000 0 00000 AMQ TYPE STORAGE
* ARRAY MAKE PROGRAM
03504 0 00000 0 00000 AFAT ARRAY ATOM GOES HERE
03505 0 00000 0 00000 ATMP TEMPORARY STORAGE
HEAD S EVALQUOTE STORAGE
03506 0 00000 0 00000 EVQAN
03507 BSS 100 EVALQUOTE BUFFER
03653 -0 00000 0 00000 EVQB MZE TEST CELL FOR READ IN
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 40
HEAD F
* CHARACTER FUNCTIONS
03654 BBPNT BSS 1 POINTER TO REMAINDER OF LIST
03655 PIND BSS 1
* MKNO
03656 0 00000 0 00000 MKT1 TEMP STORAGE TYPE (FIX OR FLD)
03657 BSS 25 ROOM FOR MORE STORAGE
03710 ENDBLK BSS 0
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 41
EJECT
HEAD 0
* CONSW PUTS FILL WORDS IN FULL WORD SPACE
*
03710 0634 00 4 03724 CONSW SXA CSWX,4 SAVE LINK IR
03711 -0534 00 4 03727 FWLOR LXD FWORDL,4 PICK UP FULL WORD LIST
03712 -3 00000 4 04031 TXL FWLOUT,4,0 TEST FOR NO MORE
03713 -0600 00 0 03726 STQ CSWQ SAVE MQ
03714 0560 00 4 00000 LDQ 0,4 PICK UP POINTER TO NEXT WORD ON FWL
03715 -0620 00 0 03727 SLQ FWORDL UP DATE FULL WORD LIST POINTER
03716 0601 00 4 00000 STO 0,4 PUT AC IN FULL WORD AREA
03717 -0754 00 4 00000 PXD 0,4 POINTER TO AC
03720 -0534 00 4 03727 LXD FWORDL,4 POINTER TO NEXT AVAILABLE WORD
03721 3 00000 4 03723 LOWARY TXH CSWO,4,** BOTTOM FULL WORD SPACE, TEST FOR ARY
03722 -0634 00 4 03721 SXD *-1,4 AVAILABLE LOCATION AND UPDATE SAME
03723 0560 00 0 03726 CSWO LDQ CSWQ RESTORE MQ
03724 0774 00 4 00000 CSWX AXT **,4 RESTORE LINK IR
03725 0020 00 4 00001 TRA 1,4 EXIT
03726 0 00000 0 00000 CSWQ TEMPORARY STORAGE FOR MQ
03727 0 00000 0 00000 FWORDL POINTER TO FULL WORD LIST
*
* CONS BASIC LISP FUNCTION PUTS A WORD IN FREE STORAGE
*
03730 0634 00 4 03747 CONS SXA CNSX,4 SAVE LINK IR
03731 -0534 00 4 03751 LXD $FREE,4 GET FREE STORAGE LIST POINTER
03732 3 00000 4 03734 TXH *+2,4,0 SKIP IF NOT OUT OF FREE STORAGE
03733 0074 00 4 04037 TSX FROUT,4 OUT OF FREE STORAGE
03734 0771 00 0 00022 ARS 18 DECREMENT TO ADDRESS
03735 0621 00 4 00000 STA 0,4 PUT ADDRESS AWY
03736 0500 00 4 00000 CLA 0,4 GET POINTER TO NEXT WORD IN FREE
03737 0622 00 0 03751 STD FREE PUT IN FREE
03740 -0620 00 4 00000 SLQ 0,4 PUT DECREMENT AWAY
03741 -0754 00 4 00000 PXD 0,4 POINTER TO WORD
03742 0774 00 4 00000 CNTR1 AXT **,4 LOW ORDER 15 BITS OF CONS COUNTER KEPT
03743 2 00001 4 03746 TIX *+3,4,1 DECREMENT COUNT BY 1
03744 0074 00 4 03752 TSX ARREST,4 COUNT EXHAUSTED, RELOAD OR STOP
03745 0774 00 4 77777 AXT -1,4 RELOAD NUMBER
03746 0634 00 4 03742 SXA CNTR1,4 PUT IN COUNTER
03747 0774 00 4 00000 CNSX AXT **,4 RESTORE LINK IR
03750 0020 00 4 00001 TRA 1,4 EXIT
03751 0 00000 0 00000 FREE POINTER TO FREE STORAGE LIST
*
03752 -0520 00 0 11671 ARREST NZT TCOUNT SKIP IF COUNS COUNTER ON
03753 0020 00 4 00001 TRA 1,4 OTERWISE RETURN
03754 0601 00 0 04107 STO CNTM SAVE AC
03755 0500 00 0 04106 CLA CNTS GET REST OF COUNTER
03756 0100 00 0 03763 TZE AWHOA GO TO ERROR CALL IF EXHAUSTED
03757 0402 00 0 04110 SUB CTG DECREMENT BY 32,768
03760 0601 00 0 04106 STO CNTS UPDATE COUNTER
03761 0500 00 0 04107 CLA CNTM RESTORE AC
03762 0020 00 4 00001 TRA 1,4 E7IT TO RELOAD CETR1
*
03763 0634 00 0 11671 AWHOA SXA TCOUNT,0 DESACTIVATE THE CONS COUNTER
03764 0500 00 0 04100 CLA CNTST PICK UP INITIAL COUNT
03765 0560 00 0 00475 LDQ $FIXD PICK UP $FIX
03766 -0634 00 4 01562 SXD $ERROR,4 SAVE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 42
03767 0774 00 4 00010 AXT 8,4 8 SPARE CONSES FOR $MKNO
03770 0634 00 4 03742 SXA CNTR1,4
03771 0074 00 4 12636 TSX $MKNO,4 MAKE THE COUNT A NUMBER
03772 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROT
03773 542660600154 BCI 1,*F 1* CONS COUNTER TRAP
*
* SPEAK TURNS THE CONTENTS OF THE CONS COUNTER INTO A FIXED POINT
* NUMBER.
*
03774 0500 00 0 00457 SPEAK CLA $AMASK GET ADDRESS MASK
03775 -0320 00 0 03742 ANA CNTR1 PICK UP 15 LOW ORDER BITS
03776 -0501 00 0 04106 ORA CNTS OR IN REST OF COUNT
03777 0601 00 0 04107 STO CNTM SAVE CURRENT VALUE
04000 0500 00 0 04100 CLA CNTST PICK UP INITIAL VALUE
04001 0402 00 0 04107 SUB CNTM SUBSTRACT CURRENT VALUE TO GET NUMBER
04002 0560 00 0 00475 LDQ $FIXD OF CONSES. PUT $FIX IN MQ
04003 0020 00 0 12636 TRA $MKNO MAKE THE RESULT A NUMBER
*
* BLOCKR BLOCK RESERVATION ROUTING USED IN DECLARING ARRAYS.
*
04004 0634 00 4 04026 BLOCKR SXA BLKX,4 SAVE LINK IR
04005 -0625 00 0 04056 STL NROOM SET UP TOO BIG TEST CELL
04006 0621 00 0 04022 STA BLKB BE RESERVED
04007 -0534 00 4 02304 LXD $ORG,4 ADDRESSOF FIRST REGISTER AVAIALABER
04010 0754 00 4 00000 BKOR PXA 0,4 ADDRESS OF FIRST REGISTER FOR ARRAYS
04011 0401 00 0 04022 ADM BLKB ADDRESS OF END OF BLOCK
04012 0621 00 0 04023 STA BLKC INITIALIZE STZ LOOP TO CLEAN OUT BLOCK
04013 0734 00 4 00000 PAX 0,4
04014 0402 00 0 00371 SUB $Q1
04015 0621 00 0 04030 STA BLKBB
04016 -3 00000 4 04044 BLKETP TXL BLKOUT,4,** BOTTOM BIT TABLE AR, GO IF WONT FIT
04017 -0634 00 4 02304 SXD $ORG,4 UPDATE ORG
04020 0500 00 4 77777 CLA -1,4 POINTER TO NEXT WORD ON FULL WORD LIST
04021 0622 00 0 03727 STD FWORDL UPDATE FULL WORD LIST
04022 0774 00 4 00000 BLKB AXT **,4 LENGTH OF BLOCK
04023 0600 00 4 00000 BLKC STZ **,4 ZEROP THE BLOCK
04024 2 00001 4 04023 TIX *-1,4,1
04025 0500 00 0 04030 CLA BLKBB GET ANSWER
04026 0774 00 4 00000 BLKX AXT **,4 RESTORE LINK IR
04027 0020 00 4 00001 TRA 1,4
04030 0 00000 0 00000 BLKBB ANSWER STORED HERE
*
* VAROUIS ENTRANCES TO THE RECLAIMER
*
* FWLOUT - OUT OF FULL WORD LIST
04031 0601 00 0 03726 FWLOUT STO CSWQ SAVE FULL WORD
04032 -0754 00 0 00000 PXD 0,0 ZERO AC
04033 0600 00 0 03220 STZ RCRLOC SIGNAL NO RELOCATION IS NECESSARY
04034 0074 00 4 02522 TSX RECLAM,4 DO THE WORK
04035 0500 00 0 03726 CLA CSWQ RESTORE AC
04036 0020 00 0 03711 TRA FWLOR RETURN TO CONSW
* FROUT - OUT OF REE STORAGE
04037 0634 00 4 04042 FROUT SXA FRX,4 SAVE LINK IR
04040 0600 00 0 03220 STZ RCRLOC SIGNAL NO RELOCATION NECESSARY
04041 0074 00 4 02522 TSX RECLAM,4 DO THE WORK
04042 0774 00 4 00000 FRX AXT **,4 RESTORE LINK OR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 43
04043 0020 00 4 77776 TRA -2,4 NON-STANDARD EXIT
* BLKOUT - OUT OF FULL WORD SPACE FOR ARRAYS
04044 -0625 00 0 03220 BLKOUT STL RCRLOC SIGNAL RELOCATION NECESSARY
04045 -0754 00 0 00000 PXD 0,0 CLEAR AC
04046 -0520 00 0 04056 NZT NROOM FALL THROUGH ON SECOND CONSECUTIVE ENT
04047 0020 00 0 04026 TRA BLKX EXIT FROM BLOCKR ROUTINE
04050 0074 00 4 02522 TSX RECLAM,4 DO THE WORK
04051 0500 00 0 03727 CLA FWORDL PICK UP POINTER TO FIRST AVAILABLE WOR
04052 0622 00 0 03721 STD LOWARY SET UP LOWARY
04053 0737 00 4 00000 PAC 0,4 COMPLEMENT INTO IR 4
04054 0600 00 0 04056 STZ NROOM SET UP TOO BIG TEST CELL
04055 0020 00 0 04010 TRA BKOR DO BLOCK RESERVATION
04056 0 00000 0 00000 NROOM
*
*
* COUNT A FUNCTION OF 1 ARGUMENT ( AFIXED POINT NUMBER) TURNS ON
* THE CONS COUNTRE AND LOADS IT WITH THAT NUMBER
* A LOAD OF NIL SIMPLY LEAVES THE PREVIOUS CONTENTS IN THE
* COUNTER
*
04057 -0625 00 0 11671 COUNT STL TCOUNT ACTIVATE THE CONS COUNTER
04060 -0100 00 0 04064 TNZ CNTA GO IF ARUGMENT S NOT NULL
04061 0500 00 0 04107 CLA CNTM OLD VALUE OF CNTR1
04062 0621 00 0 03742 STA CNTR1 PUT IT THERE
04063 0020 00 0 04076 TRA CNTB CLEAR AC AND EXIT
04064 0634 00 4 04074 CNTA SXA CNTX,4 RELOAD COUNTER WITH FIXED POINT ARG.
04065 0634 00 2 04075 SXA CNTY,2 SAVE IDNEX REGISTERS
04066 -0734 00 2 00000 PDX 0,2 ARGUMENT TO INDEX 2
04067 0074 00 4 13075 TSX FIXVAL,4 EVALUATE AS A FIXED POINT NUMBER
04070 0601 00 0 04100 STO CNTST SET INITIAL VALUE CELL
04071 0621 00 0 03742 STA CNTR1 LOW ORDER 15 BITS TO CNTR1
04072 -0320 00 0 00465 ANA PDTMSK MASK OUT LOW ORDER 15 BITS
04073 0601 00 0 04106 STO CNTS STORE REMAINDER IN HIGH ORDER CELL
04074 0774 00 4 00000 CNTX AXT **,4 RESTORE INDEX REGISTERS
04075 0774 00 2 00000 CNTY AXT **,2
04076 -0754 00 0 00000 CNTB PXD 0,0 GIVE VALUE OF NIL
04077 0020 00 4 00001 TRA 1,4 EXIT
04100 0 00000 0 00000 CNTST INTAL VALUE OF COUNT
*
* UNCONT DEACTIVATE THE CONS COUNTER
*
04101 0634 00 0 11671 UNCONT SXA TCOUNT,0 DEACTIVATE THE CONS COUNTER
04102 0500 00 0 03742 CLA CNTR1 GET CURENT CONTENST OF COUNTER
04103 0621 00 0 04107 STA CNTM SAVE IN TEMP STORAGE
04104 -0754 00 0 00000 PXD 0,0 GIVE VALUE OF NULL
04105 0020 00 4 00001 TRA 1,4 EXIT
*
04106 0 00000 0 00000 CNTS HIGH ORDER BITS OF CONS COUNTER
04107 0 00000 0 00000 CNTM TEMPORARY STORAGE
04110 0 00000 1 00000 CTG ,1 LOW ORDER BIT OF HIGH ORDER 20 BITS
*
*
E HED
* DECON AND NUMNAM
*
* DECON TAKES A DECIMAL NUMBER (+ OR -) AS INPUT IN THE AC AND
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 44
* GIVES AS OUTPUT THE BCD REPRESENTATION OF THAT NUMBER. LO ORDER
* BITS ARE IN AC. HI ORDER BITS IN MQ. LEADING ZEROS ARE
* SUPPRESSED. IF THERE ARE NO HI ORDER BITS, MQ IS ZERO. THE
* P BIT AND SIGN OF AC WILL AGREE.
*
* NUMNAM TAKES AS INPUT A POINTER TO A DECIMAL INTEGER (+ OR 0) AND
* CAUSES THE BCD REPRESENTATION OF THAT NUMBER TO BE PRINTER, WITH
* LEADING ZEROS SUPPRESSED.
04111 0600 00 0 77662 DECON STZ DETS1 SIGNAL FOR DECON EXIT
04112 0600 00 0 77664 STZ DELOD SET LO ORDER DIGITS TO ZERO
04113 0634 00 4 04176 SXA DEIR4,4 SAVE IR4
04114 0020 00 0 04121 TRA DE7
04115 -0625 00 0 77662 NUMNAM STL DETS1 SIGNAL FOR NUMNAM EXIT
04116 0634 00 4 04176 SXA DEIR4,4 SAVE IR4
04117 -0734 00 4 00000 PDX ,4 PLACE INPUT NUMBER IN AC
04120 0500 00 4 00000 CLA 0,4
04121 -0625 00 0 77663 DE7 STL DETS2 SIGNAL FOR NO HI- ORDER DIGITS
04122 0601 00 0 77667 STO DEINP SAVE INPUT FOR SIGN TEST
04123 0760 00 0 00012 DCT SHUT OFF DIVIDE CHECK LIGHT
04124 0761 00 0 00000 NOP
04125 -0130 00 0 00000 XCL NUMBER TO MQ
04126 0774 00 4 00044 AXT 36,4 INDEX FOR SHIFTING
04127 0600 00 0 77665 DE4 STZ DEDIG DEDIG WILL RECIEVE DIGITS
04130 -0754 00 0 00000 DE1 PXD ,0
04131 0221 00 0 00402 DVP $Q10 PUT ANOTHER DIGIT IN DEDIG
04132 0767 00 4 00044 ALS 36,4
04133 -0602 00 0 77665 ORS DEDIG
04134 -0600 00 0 77666 STQ DEMQ IF QUOTIENT ZERO, CONVERSION
04135 -0520 00 0 77666 NZT DEMQ IS DONE
04136 0020 00 0 04144 TRA DE2
04137 2 00006 4 04130 TIX DE1,4,6
04140 0500 00 0 77665 CLA DEDIG STORE LO ORDER DIGITS
04141 0601 00 0 77664 STO DELOD
04142 0600 00 0 77663 STZ DETS2 SIGNAL THAT HI ORDER DIGITS EXIST
04143 1 00036 4 04127 TXI DE4,4,30 RESTORE SHIFT INDEX AND LOOP AGAIN
04144 0560 00 0 77667 DE2 LDQ DEINP SEE IF MINUS SIGN NEEDED
04145 0162 00 0 04157 TQP DEV
04146 2 00006 4 04154 TIX DEQ,4,6
* MINUS SIGN BEGINS A NEW WORD
04147 0500 00 0 77665 CLA DEDIG STORE LO ORDER DIGITS
04150 0601 00 0 77664 STO DELOD
04151 0600 00 0 77663 STZ DETS2 SIGNAL THAT HI ORDER DIGITS EXIST
04152 0600 00 0 77665 STZ DEDIG CLEAR DIGITS REGISTER
04153 0774 00 4 00044 AXT 36,4 RESTORE SHIFT INDEX
04154 0500 00 0 00423 DEQ CLA DEMIN INSERT MINUS SIGN
04155 0767 00 4 00044 ALS 36,4
04156 -0602 00 0 77665 ORS DEDIG
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 45
04157 0760 00 0 00012 DEV DCT
04160 0074 00 4 01676 TSX $DCT,4 MACHINE ERROR
04161 0520 00 0 77662 ZET DETS1 SEE WHICH EXIT TO USE
04162 0020 00 0 04200 TRA DE5
* DECON EXIT
04163 -0500 00 0 77665 CAL DEDIG PICK UP DIGITS
04164 -3 00006 4 04170 TXL DEJ,4,6 TRANSFER IF FULL WORD OF DIGITS
04165 -0765 00 4 00052 LGR 42,4 INSERT LEADING BLANKS
04166 -0500 00 0 00472 CAL BLANKS
04167 -0763 00 4 00052 LGL 42,4
04170 0560 00 0 77664 DEJ LDQ DELOD LO ORDER DIGITS OR ZERO -
04171 -0520 00 0 77663 NZT DETS2 SEE WHICH
04172 -0130 00 0 00000 XCL LO ORDER DIGITS TO AC
04173 -0760 00 0 00001 PBT SIGN AND P BIT MUST AGREE
04174 0020 00 0 04176 TRA *+2
04175 -0760 00 0 00003 SSM
04176 0774 00 4 00000 DEIR4 AXT **,4 RESTORE IR4 AND EXIT
04177 0020 00 4 00001 TRA 1,4
* NUMNAM EXIT
04200 -0500 00 0 77665 DE5 CAL DEDIG INSERT TRAILING SEVENS INTO
04201 0560 00 0 00471 LDQ SEVENS DIGITS WORD
04202 -0765 00 4 00052 LGR 42,4
04203 0131 00 0 00000 XCA
04204 0074 00 4 05110 TSX $PRIN2,4 PRINT WORD OF DIGITS
04205 0520 00 0 77663 ZET DETS2 SEE IF ANOTHER WORD MUST
04206 0020 00 0 04211 TRA DEY BE PRITNER
04207 -0500 00 0 77664 CAL DELOD PRINT LO ORDER DIGITS
04210 0074 00 4 05110 TSX $PRIN2,4
04211 0534 00 4 04176 DEY LXA DEIR4,4 RESTORE IR4, CLEAR AC, AND EXIT
04212 -0754 00 0 00000 PXD ,0
04213 0020 00 4 00001 TRA 1,4
00423 DEMIN SYN $QO40 BCD MINUS SIGN
A 04214 DEORG BSS
77662 ORG COMMON
77662 DETS1 BSS 1 ZERO MEANS DECON EXIT
77663 DETS2 BSS 1 ZERO MEANS HI ORDER DIGITS
77664 DELOD BSS 1 LO ORDER DIGITS
77665 DEDIG BSS 1 CURRENT DIGITS
77666 DEMQ BSS 1 MQ FOR ZERO TEST
77667 DEINP BSS 1 INPUT NUMBER
04214 ORG DEORG
* THIS ROUTINE USES COMMON, SEVENS, $PRIN2, BLANKS, AND $Q10
*
R HED
MAPLIS NEW, FASTER VERSION WITH OPEN SAVE AND CONS
*
04214 0100 00 4 00001 MAPLIS TZE 1,4 NULL(L) = NIL
04215 -0634 00 4 03430 SXD MS1,4 SAVE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 46
04216 -0534 00 4 02317 LXD $CPPI,4 GET PDL POINTER
04217 1 77772 4 04220 TXI *+1,4,-6 SAVE TOTAL OF 6 ITEMS
04220 0522 00 0 02414 XEC $ENDPDL TEST FOR OUT OF PUSH DOWN LIST
04221 -0634 00 4 02317 SXD $CPPI,4 UPDATE PDL POINTER LOCATION
04222 0601 00 0 03317 STO $ARG1 SAVE AC
04223 0500 00 0 03430 CLA MS1 START SAVING LINK IR
04224 0601 00 4 77772 STO -6,4
04225 0500 00 0 03431 CLA MS2 L ARGUMENT
04226 0601 00 4 77773 STO -5,4
04227 0500 00 0 03432 CLA MS3 FUNCTIONAL ARGUMENT
04230 0601 00 4 77774 STO -4,4
04231 0500 00 0 03433 CLA MS4 FINAL ANSWER
04232 0601 00 4 77775 STO -3,4
04233 0500 00 0 03434 CLA MS5 INTERMEDIATE ANSWER
04234 0601 00 4 77776 STO -2,4
04235 0500 00 0 04344 CLA MS6 SAVE MARKER
04236 0601 00 4 77777 STO -1,4
04237 0500 00 0 03317 CLA $ARG1 SAVING ALL DONE, RESTORE AC
04240 0601 00 0 03431 STO MS2 PUT L ARGUMENT AWAY
04241 -0600 00 0 03432 STQ MS3 PUT FUNCTION ARGUMENT AWAY
04242 0162 00 0 04334 TQP CMP IF TRANSFER, F NOT A TXL, SO GO TO COMPAT
04243 0074 00 4 03432 TSX MS3,4 EXECUTE FUNCTIONAL ARGUMENT
04244 -0534 00 4 03751 MAIN LXD $FREE,4 START OPEN CONS
04245 3 00000 4 04247 TXH *+2,4,0 TEST FOR OUT OF FREE STORAGE
04246 0074 00 4 04037 TSX $FROUT,4 GO IF NO MORE FS
04247 0771 00 0 00022 ARS 18 PUT F(L) IN ADDRESS
04250 0560 00 4 00000 LDQ 0,4 GET NEXT REGISTER ON FSL
04251 -0620 00 0 03751 SLQ $FREE UPDATE FREE
04252 0601 00 4 00000 STO 0,4 CONS(F(L),NIL)
04253 -0634 00 4 03433 SXD MS4,4 FINAL ANSWER
04254 -0634 00 4 03434 SXD MS5,4 INT. ANSWER
04255 0534 00 4 03742 LXA $CNTR1,4 PICK UP CONS COUNTER
04256 2 00001 4 04261 TIX *+3,4,1 DECREMENT BY 1
04257 0074 00 4 03752 TSX ARREST,4 GO IF OUT OF COUNTER
04260 0774 00 4 77777 AXT -1,4 RELOAD OF -1 FOR COUNTER
04261 0634 00 4 03742 SXA $CNTR1,4 RESTORE CONS COUNTER
04262 -0534 00 4 03431 MLOP1 LXD MS2,4 MAUN LOOP, GET L
04263 0500 00 4 00000 CLA 0,4 TAKE CDR(L)
04264 -0734 00 4 00000 PDX 0,4
04265 3 00000 4 04306 TXH MPRG1,4,0 IF NOT NULL GO ON TO MAIN PROGRAM
04266 0500 00 0 03433 CLA MS4 ALL DONE, PICK UP FINAL ANSWER
04267 -0534 00 4 02317 LXD $CPPI,4 START OPEN UNSAVE BY GETTING PDL POINTER
04270 0560 00 4 77776 LDQ -2,4
04271 -0600 00 0 03434 STQ MS5
04272 0560 00 4 77775 LDQ -3,4
04273 -0600 00 0 03433 STQ MS4
04274 0560 00 4 77774 LDQ -4,4
04275 -0600 00 0 03432 STQ MS3
04276 0560 00 4 77773 LDQ -5,4
04277 -0600 00 0 03431 STQ MS2
04300 0560 00 4 77772 LDQ -6,4
04301 -0600 00 0 03430 STQ MS1
04302 1 00006 4 04303 TXI *+1,4,6 RESTORE PDL COUNTER
04303 -0634 00 4 02317 SXD $CPPI,4 SET CPPI
04304 -0534 00 4 03430 LXD MS1,4 PICK UP LINK IR
04305 0020 00 4 00001 TRA 1,4 RETURN
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 47
*
04306 -0754 00 4 00000 MPRG1 PXD 0,4 MAIN PROGRAM PUT L IN AC
04307 0601 00 0 03431 STO MS2 SAVE IN L ARGUMENT REGISTER
04310 -0534 00 4 03432 LXD MS3,4 SEE IF FUNCTIONAL ARG IS S EXPRESSION
04311 3 00012 4 04340 TXH CMP1,4,10 GO IF S EXPRESSION
04312 0074 00 4 03432 TSX MS3,4 EXECUTE FUNCTION ARGUMENT (TXL INS.)
04313 -0534 00 4 03751 MAIN1 LXD $FREE,4 START OPEN CONS
04314 3 00000 4 04316 TXH *+2,4,0 TEST FOR OUT OF FREE STORAGE
04315 0074 00 4 04037 TSX $FROUT,4 GO IF OUT
04316 0560 00 4 00000 LDQ 0,4 PICK UP POINTER TO NEXT FREE REGISTER
04317 -0620 00 0 03751 SLQ $FREE UPDATE FREE
04320 0771 00 0 00022 ARS 18 ITEM TO ADDRESS
04321 0601 00 4 00000 STO 0,4 CONS(F(L),NIL)
04322 -0754 00 4 00000 PXD 0,4 ANSWER TO AC
04323 0534 00 4 03742 LXA $CNTR1,4 PICK UP CONS COUNTER
04324 2 00001 4 04327 TIX *+3,4,1 DECREMENT BY 1
04325 0074 00 4 03752 TSX ARREST,4 GO IF OUT OF COUNTER
04326 0774 00 4 77777 AXT -1,4 RELOAD OF -1 FOR COUNTER
04327 0634 00 4 03742 SXA $CNTR1,4 RESTORE CONS COUNTER
04330 -0534 00 4 03434 LXD MS5,4 PICK UP LAST ANSWER
04331 0622 00 4 00000 STD 0,4 CONCATENATE THE ANSWERS BY RPLACD
04332 0601 00 0 03434 STO MS5 UPDATE INT. ANSWER
04333 0020 00 0 04262 TRA MLOP1 GO TO HEAD OF MAIN LOOP
*
04334 -0620 00 0 04336 CMP SLQ *+2 COMPAT CALL FOR S EXPRESSION FUN. ARG.
04335 0074 00 4 12007 TSX COMPAT,4
04336 0 00000 0 00001 1,,** FUNCTION OF 1 ARGUMENT
04337 0020 00 0 04244 TRA MAIN GO BACK TO MAIN PROGRAM
*
04340 -0634 00 4 04342 CMP1 SXD *+2,4 ANOTHER COMPAT CALL
04341 0074 00 4 12007 TSX COMPAT,4
04342 0 00000 0 00001 1,,**
04343 0020 00 0 04313 TRA MAIN1 RETURN TO MAIN PROGRAM
*
04344 -3 03436 0 02371 MS6 TXL $END5,,MS5+2 SAVE 5 ITEMS
FUNCTION COPY
COPY(L)= (L=0 YIELDS 0, CAR(L)=-1 YIELDS L,
OTHERWISE CONS(COPY(CAR(L)),COPY(CDR(L))))
R HED
04345 0100 00 4 00001 COPY TZE 1,4 L=0
04346 -0634 00 4 03357 SXD CS1,4
04347 -0734 00 4 00000 PDX 0,4 L
04350 -0634 00 4 04377 SXD CT1,4 L
04351 0500 00 4 00000 CLA 0,4 CWR(L)
04352 0734 00 4 00000 PAX 0,4 CAR(L)
04353 -3 77776 4 04357 TXL C1,4,-2 CAR(L)=-1
04354 0500 00 0 04377 CLA CT1
04355 -0534 00 4 03357 LXD CS1,4
04356 0020 00 4 00001 TRA 1,4
04357 0074 00 4 02312 C1 TSX $SAVE,4
04360 -3 03362 0 02377 TXL $END2,,CS2+2 SAVE 2 ITEMS
04361 -0534 00 4 04377 LXD CT1,4 L
04362 0500 00 4 00000 CLA 0,4 CWR(L)
04363 0601 00 0 03360 STO CS2
04364 -0320 00 0 00460 ANA DECM CDR(L)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 48
04365 0074 00 4 04345 TSX COPY,4 COPY(CDR(L))
04366 0534 00 4 03360 LXA CS2,4 CAR(L)
04367 0601 00 0 03360 STO CS2 COPY(CDR(L))
04370 -0754 00 4 00000 PXD 0,4
04371 0074 00 4 04345 TSX COPY,4 COPY(CAR(L))
04372 0560 00 0 03360 LDQ CS2
04373 0074 00 4 03730 TSX $CONS,4
04374 0074 00 4 02326 TSX UNSAVE,4
04375 -0534 00 4 03357 LXD CS1,4
04376 0020 00 4 00001 TRA 1,4
04377 0 00000 0 00000 CT1
00460 DECM SYN $DMASK
FUNCTION SEARCH
SEARCH(L,P,F,U)=(L=0 YIELDS U,P(L) YIELDS F(L),
OTHERWISE SEARCH (CDR(L),P,F,U))
R HED
04400 -0634 00 4 03454 SEARCH SXD SRS1,4
04401 0074 00 4 02312 TSX $SAVE,4
04402 -3 03462 0 02371 TXL $END5,,SRS5+2 SAVE 5 ITEMS
04403 -0600 00 0 03456 STQ SRS3 P
04404 0100 00 0 04445 SR3 TZE SR4
04405 0601 00 0 03455 STO SRS2 L
04406 0560 00 0 03321 LDQ $ARG3 F
04407 -0600 00 0 03457 STQ SRS4
04410 0560 00 0 03322 LDQ $ARG4 U
04411 -0600 00 0 03460 STQ SRS5
04412 -0534 00 4 03456 LXD SRS3,4
04413 3 00012 4 04416 TXH *+3,4,10
04414 0074 00 4 03456 TSX SRS3,4
04415 0020 00 0 04421 TRA *+4
04416 -0634 00 4 04420 SXD *+2,4
04417 0074 00 4 12007 TSX COMPAT,4
04420 0 00000 0 00001 1,,**
04421 0100 00 0 04435 TZE SR1 NOT P(L)
04422 0500 00 0 03455 CLA SRS2 L
04423 -0534 00 4 03457 LXD SRS4,4
04424 3 00012 4 04427 TXH *+3,4,10
04425 0074 00 4 03457 TSX SRS4,4
04426 0020 00 0 04432 TRA *+4
04427 -0634 00 4 04431 SXD *+2,4
04430 0074 00 4 12007 TSX COMPAT,4
04431 0 00000 0 00001 1,,**
04432 0074 00 4 02326 TSX UNSAVE,4
04433 -0534 00 4 03454 LXD SRS1,4
04434 0020 00 4 00001 TRA 1,4
04435 0500 00 0 03460 SR1 CLA SRS5 I YIELDS
04436 0601 00 0 03322 STO $ARG4 U
04437 0500 00 0 03457 CLA SRS4
04440 0601 00 0 03321 STO $ARG3 F
04441 -0534 00 4 03455 LXD SRS2,4 L
04442 0500 00 4 00000 CLA 0,4
04443 -0320 00 0 00460 ANA DECM CDR(L)
04444 0020 00 0 04404 TRA SR3
04445 0074 00 4 02326 SR4 TSX UNSAVE,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 49
04446 -0534 00 4 03322 LXD $ARG4,4
04447 3 00012 4 04452 TXH SRCMPT,4,10
04450 -0534 00 4 03454 LXD SRS1,4
04451 0020 00 0 03322 TRA $ARG4
*
04452 0600 00 0 03321 SRCMPT STZ $ARG3
04453 0560 00 0 03321 LDQ $ARG3
04454 0074 00 4 03730 TSX $CONS,4
04455 0131 00 0 00000 XCA
04456 0500 00 0 03322 CLA $ARG4
04457 -0534 00 4 03454 LXD SRS1,4
04460 0020 00 0 14663 TRA $APPLY
FUNCTION EQUAL
EQUAL(L1,L2)=(L1=L2 YIELDS1,L1=OVL2=0 YIELDS 0,
CAR(L1)=-1VCAR(L2)=-1 YIELDS 0, OTHERWISE
EQUAL(CAR(L1,(CARL2))AEQUAL(CDR(L1),CDR(L2)))
L HED
* EQUAL A FUNCTION OF 2 ARGUMENTS DETERMINES WETHER 2 LIST
* STRUCTURES ARE EQUIVELENT. REPROGRAMMED 5 OCTOBER 1960
* TO MAKE USE OF THE NUMBER CONVENTIONS CURRENTLY IN USE.
*
04461 -0634 00 4 04600 EQUAL SXD EQXR,4 SAVE LINK IR
04462 -0600 00 0 04602 STQ EQL2 SAVE ARGUMENT 2
04463 0601 00 0 04601 STO EQL1 SAVE ARGUMENT 1
04464 0402 00 0 04602 EQLP SUB EQL2 EQ TEST
04465 0100 00 0 04516 TZE EQT TWO LIST ARE EQ. EXIT TRUE
04466 -0520 00 0 04601 NZT EQL1 SKIP IF L1 NON NULL
04467 0020 00 0 04521 TRA EQF L1 NULL BUT NOT EQ L2, EXIT FALSE
04470 -0520 00 0 04602 NZT EQL2 NULL TEST L2
04471 0020 00 0 04521 TRA EQF L2 NULL BUT NOT EQ L1, EXIT FALSE
04472 -0534 00 4 04602 LXD EQL2,4 PICK UP LIST 2
04473 0500 00 4 00000 CLA 0,4 GET NEXT ELEMENT
04474 0622 00 0 04602 STD EQL2 SAVE CDR OF LIST 2
04475 0734 00 4 00000 PAX 0,4 CAR OF LIST 2
04476 3 77776 4 04524 TXH EQA,4,-2 GO IF ATOM
04477 -0754 00 4 00000 PXD 0,4 CAR OF LIST TO DECREMENT OF AC
04500 0131 00 0 00000 XCA SWITCH TO MQ
04501 -0534 00 4 04601 LXD EQL1,4 PICK UP LIST 1
04502 0500 00 4 00000 CLA 0,4 GET NEXT ELEMENT
04503 0622 00 0 04601 STD EQL1 SAVE CDR OF LIST 1
04504 0734 00 4 00000 PAX 0,4 CAR OF LIST TO IR 4
04505 3 77776 4 04521 TXH EQF,4,-2 GO TO FALSE EXIT IF THIS IS AN ATOM
04506 -0754 00 4 00000 PXD 0,4 CAR OF LIST TO DECREMENT OF AC
04507 0074 00 4 02312 TSX $SAVE,4 SAVE CALL
04510 -3 04604 0 02375 TXL $END3,,EQL2+2 SAVE 3 ITEMS
04511 0074 00 4 04461 TSX $EQUAL,4 TEST FOR EQUALITY IN CAR DIRECTION
04512 0074 00 4 02326 TSX UNSAVE,4 UNSAVE CALL
04513 0100 00 0 04521 TZE EQF WHOLE LIST IS FALSE IF CAR DIRECTION F
04514 0500 00 0 04601 CLA EQL1 PICK UP REST OF LIST 1
04515 0020 00 0 04464 TRA EQLP TEST EQUALITY IN CDR DIRECTION
*
04516 0500 00 0 00442 EQT CLA $QD1 TRUE EXIT, PICK UP 1 IN DECREMENT
04517 -0534 00 4 04600 LXD EQXR,4 RESTORE LINK IR
04520 0020 00 4 00001 TRA 1,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 50
*
04521 -0754 00 0 00000 EQF PXD 0,0 FALSE EXIT, CLEAR AC
04522 -0534 00 4 04600 LXD EQXR,4 RESTORE LINK IR
04523 0020 00 4 00001 TRA 1,4
*
04524 0560 00 0 04601 EQA LDQ EQL1
04525 -0774 00 4 04527 AXC EQAR,4
04526 0634 00 4 04574 SXA EQPX,4
04527 0020 00 0 04542 EQAR TRA EQPE
04530 0100 00 0 04521 TZE EQF
04531 0020 00 0 04516 TRA EQT
*
* EQP TESTS FOR EQ BETWEEN LISTS AND NUMERICAL EQUALITY BETWEEN
* NUMBERS. USES A TOLERENCE IN TESTIONG FLOATION PT NUMBERS
*
04532 0040 00 0 04537 EQP TLQ EQPF
04533 0131 00 0 00000 XCA
04534 0040 00 0 04537 TLQ EQPF
04535 0500 00 0 00442 EQPTX CLA $QD1
04536 0020 00 4 00001 TRA 1,4
04537 0634 00 4 04574 EQPF SXA EQPX,4
04540 -0734 00 4 00000 PDX 0,4
04541 0500 00 4 00000 CLA 0,4
04542 -0734 00 4 00000 EQPE PDX 0,4
04543 -0320 00 0 00470 ANA TAGMSK
04544 0100 00 0 04573 TZE EQPFX
04545 0601 00 0 04576 STO EQPT
04546 0500 00 4 00000 CLA 0,4
04547 0131 00 0 00000 XCA
04550 -0734 00 4 00000 PDX 0,4
04551 0500 00 4 00000 CLA 0,4
04552 -0734 00 4 00000 PDX 0,4
04553 -0320 00 0 00470 ANA TAGMSK
04554 -0320 00 0 04576 ANA EQPT
04555 0100 00 0 04573 TZE EQPFX
04556 -0320 00 0 00436 ANA $QT1
04557 0601 00 0 04576 STO EQPT
04560 0500 00 4 00000 CLA 0,4
04561 0601 00 0 04577 STO EQPS
04562 0131 00 0 00000 XCA
04563 0402 00 0 04577 SUB EQPS
04564 0534 00 4 04574 LXA EQPX,4
04565 0100 00 0 04535 TZE EQPTX
04566 0520 00 0 04576 ZET EQPT
04567 0020 00 0 04573 TRA EQPFX
04570 0760 00 0 00003 SSP
04571 0402 00 0 14623 SUB FLOTOL
04572 -0120 00 0 04535 TMI EQPTX
04573 -0754 00 0 00000 EQPFX PXD 0,0
04574 0774 00 4 00000 EQPX AXT **,4
04575 0020 00 4 00001 TRA 1,4
04576 0 00000 0 00000 EQPT TEST CELL NON 0 YIELDS FIX
04577 0 00000 0 00000 EQPS STORAGE
04600 0 00000 0 10241 EQXR $F8 INDEX REGISTER STORAGE
04601 0 00000 0 00000 EQL1 LIST 1 STORAGE
04602 0 00000 0 00000 EQL2 LIST 2 STORAGE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 51
04603 0 00000 0 00000 EQTS TEST CELL 0 FIX, NON 0 FLO
*
* EQUAL USES $SAVE,$QD1,UNSAVE,$EQUAL AND FIXFLO
PRINT MAY 14,1959
PRINT(L)=(CAR(L)=-1 YIELDS PRIN1(L),1 YIELDS
(PRIN2(LPAR2),PRINT(CAR(L)),(CDR(L)=0YIELDS
PRIN2(RPAR2),1 YIELDS(PRIN2(COMMA2),PRINT
(CDR(L))))))
THE LIST L IS PRINTED IN THE RESTRICTED NOTATION
PRINT REQUIRES THE SUBROUTINES PRIN1,PRIN2,
TERPRI,MISPH2(OR UASPH2) ALL HEADED BY P
AND SAVE,UNSAVE,ERROR UNHEADED
T HED
PRINT MASTERMINDER
04604 0634 00 4 04614 PRINT SXA PRPS1,4 SAVE LINK IR
04605 -0534 00 4 02317 LXD $CPPI,4 SAVE CURRENT CONTENTS OF CPPI
04606 -0634 00 4 05307 SXD PCPPI,4
04607 0600 00 0 05310 STZ WALLPC ZERO WALL PAPER COUNTER
04610 0601 00 0 03453 STO PRINTL SAVE THE ARGUMENT
04611 0074 00 4 04620 TSX PRIN0,4
04612 0074 00 4 05214 PRTT1 TSX TERPRI,4
04613 0500 00 0 03453 CLA PRINTL RESTORE THE ARGUMENT
04614 0774 00 4 00000 PRPS1 AXT **,4 RESTORE LINK IR
04615 0020 00 4 00001 TRA 1,4
04616 0500 00 0 04673 PRNIL CLA PRBLW PICK UP NIL REPRESENTATION
04617 0020 00 0 05110 TRA $PRIN2 PUT IN PRINT LINE AND EXIT
04620 -0634 00 4 04674 PRIN0 SXD PS1,4
04621 0100 00 0 04616 TZE PRNIL PRINT THE NULL LIST
04622 -0734 00 4 00000 PDX 0,4
04623 -0634 00 4 04702 SXD L1,4
04624 0500 00 4 00000 CLA 0,4
04625 0601 00 0 04701 STO CWRL
04626 0734 00 4 00000 PAX 0,4
04627 -3 77776 4 04633 TXL XA1,4,-2
04630 0500 00 0 04702 CLA L1
04631 -0534 00 4 04674 LXD PS1,4
04632 0020 00 0 04703 TRA $PRIN1
04633 0500 00 0 04677 XA1 CLA LPAR2
04634 0074 00 4 05110 TSX $PRIN2,4
04635 0500 00 0 04701 CLA CWRL
04636 0074 00 4 02312 TSX $SAVE,4
04637 -3 04677 0 02377 TXL $END2,,PS2+2 SAVE 2 ITEMS
04640 0622 00 0 04675 A3 STD PS2 SAVE LIST
04641 0734 00 4 00000 PAX 0,4 CAR TO IR 4
04642 -3 00000 4 04667 TXL PRP2,4,0
04643 -0754 00 4 00000 PXD 0,4
04644 0074 00 4 04620 TSX PRIN0,4
04645 -0534 00 4 04675 A4 LXD PS2,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 52
04646 -3 00000 4 04656 TXL A6,4,0 EXIT IF NULL
04647 0500 00 4 00000 CLA 0,4 TEST FOR ATOM
04650 0734 00 4 00000 PAX 0,4
04651 -3 77776 4 04662 TXL A2,4,-2 GO TO A2 IF NOT AN ATOM
04652 0500 00 0 04672 CLA DOT OTHERWISE PRINT IN DOT NOTATION
04653 0074 00 4 05110 TSX $PRIN2,4 PUT IN PRINT LINE
04654 0500 00 0 04675 CLA PS2 CDR OF LIST
04655 0074 00 4 04703 TSX $PRIN1,4 PRINT AS ATOM
04656 0074 00 4 02326 A6 TSX UNSAVE,4
04657 0500 00 0 04676 CLA RPAR2
04660 -0534 00 4 04674 LXD PS1,4
04661 0020 00 0 05110 TRA $PRIN2
04662 0500 00 0 04700 A2 CLA COMM2
04663 0074 00 4 05110 TSX $PRIN2,4
04664 -0534 00 4 04675 LXD PS2,4
04665 0500 00 4 00000 CLA 0,4
04666 0020 00 0 04640 TRA A3
04667 0500 00 0 04673 PRP2 CLA PRBLW
04670 0074 00 4 05110 TSX $PRIN2,4
04671 0020 00 0 04645 TRA A4
04672 -203360777777 DOT OCT 603360777777 .
04673 -053143777777 PRBLW OCT 453143777777 NIL
04674 0 00000 0 07320 PS1 $F4
04675 0 00000 0 00000 PS2
04676 +347777777777 RPAR2 OCT 347777777777
04677 -347777777777 LPAR2 OCT 747777777777
04700 -207777777777 COMM2 OCT 607777777777 BLANK INSTEAD OF A COMMA
04701 0 00000 0 00000 CWRL
04702 0 00000 0 00000 L1
T HED
SUBROUTINE(PRIN1(L))
/ CAR(L) N=-1 YIELDS ERROR
ST = L
A1 CDR(L) = 0 YIELDS ERROR
L = CDR(L)
CAR(L) = PNAME YIELDS GO(A3)
CAR(L) N= FLOAT YIELDS GO(A1)
L = CAR(CDR(L))
VAL = FLONAM(L)
REPLACD(CONS(PNAME,CONS(VAL,CDR(ST))),ST)
L = CDR(ST)
A3 L= CAR(CDR(L))
A2 PRIN2(CWR(CAR(L))
L = CDR(L)
L=0 YIELDS RETURN
*/ GO(A2)
04703 -0634 00 4 05072 PRIN1 SXD PR1,4
04704 0601 00 0 05071 STO PRSS SAVE OBJECT
04705 -0734 00 4 00000 PDX ,4
04706 0500 00 4 00000 CLA ,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 53
04707 0625 00 0 05103 STT PTTGR
04710 -0320 00 0 00457 ANA ADDM
04711 0402 00 0 00457 SUB ADDM
04712 0100 00 0 04720 TZE PR3 CAR(L) N=-1 YIELDS ERROR
04713 -0634 00 4 01562 PR2 SXD $ERROR,4
04714 0074 00 4 05214 TSX TERPRI,4
04715 -0754 00 0 00000 PXD 0,0
04716 0074 00 4 01563 TSX $ERROR+1,4
04717 544760600154 BCI 1,*P 1* TRIED TO PRINT NON-OBJECT -PRIN1-
00457 ADDM SYN $AMASK
04720 0520 00 0 05103 PR3 ZET PTTGR
04721 0020 00 0 04733 TRA PR3N
04722 0500 00 4 00000 CLA 0,4 FIRST WORD OF ATOM
04723 0020 00 0 04726 TRA *+3
04724 -3 07334 4 04726 PR3P TXL *+2,4,$PNAME-1
04725 -3 07335 4 04750 TXL PA3,4,$PNAME
04726 -0734 00 4 00000 PDX 0,4 CDR
04727 -3 00000 4 05056 TXL PR5,4,0 UNPRINTABLE
04730 0500 00 4 00000 CLA 0,4 NEXT WORD
04731 0734 00 4 00000 PAX 0,4
04732 0020 00 0 04724 TRA PR3P EXAMINE WORD
04733 -0534 00 4 05071 PR3N LXD PRSS,4
04734 0500 00 4 00000 CLA 0,4
04735 -0734 00 4 00000 PDX 0,4
04736 0634 00 4 05102 SXA PTPNT,4
04737 0500 00 0 05103 CLA PTTGR
04740 -0320 00 0 00437 ANA $QT2
04741 -0100 00 0 04764 TNZ PR4F
04742 0500 00 0 05103 CLA PTTGR
04743 -0320 00 0 00440 ANA $QT4
04744 -0100 00 0 04767 TNZ LUCY
04745 -0754 00 4 00000 PXD 0,4
04746 0074 00 4 04115 TSX NUMNAM,4
04747 0020 00 0 04762 TRA PR4E
*
04750 -0734 00 4 00000 PA3 PDX 0,4 FOUND A PNAME
04751 0500 00 4 00000 CLA 0,4
04752 0734 00 4 00000 PAX 0,4 POINTER TO PRINT LIST
04753 0500 00 4 00000 PR4 CLA 0,4 POINTRE TO PRINT LIST
04754 0622 00 0 05073 STD L SAVE REST OF LIST IF ANY
04755 0734 00 4 00000 PAX 0,4 POINTER TO FIRST FULL FULL WORD
04756 0500 00 4 00000 CLA 0,4 FULL WORD
04757 0074 00 4 05110 TSX $PRIN2,4 PRINT IT
04760 -0534 00 4 05073 LXD L,4 PICK UP REST OF LIST
04761 3 00000 4 04753 TXH PR4,4,0 PRINT MORE IF MORE
04762 -0534 00 4 05072 PR4E LXD PR1,4 EXIT BY RESTORING LINK IR
04763 0020 00 4 00001 TRA 1,4 EXIT
04764 -0754 00 4 00000 PR4F PXD 0,4
04765 0074 00 4 05500 TSX FLONAM,4
04766 0020 00 0 04762 TRA PR4E
*
* PRINT THE NUMBER OCTALLY
04767 0534 00 2 05102 LUCY LXA PTPNT,2 GET POINTER TO NUMBER
04770 0560 00 2 00000 LDQ 0,2
04771 0162 00 0 04776 TQP BETTY TEST FOR NEGATIVE NUMBER
04772 0500 00 0 05100 CLA MISGN IF SO, PRINT -
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 54
04773 0074 00 4 05110 TSX $PRIN2,4
04774 0500 00 2 00000 CLA 0,2 REMOVE MINUS SIGN
04775 -0130 00 0 00000 XCL
04776 -0520 00 2 00000 BETTY NZT 0,2 TEST IF NUMBER ALL ZEROS
04777 0020 00 0 05053 TRA MARIE
* LOOK FOR NON-ZERO DIGIT ON LEFT
05000 -0754 00 0 00000 PXD ,0
05001 0774 00 2 00014 AXT 12,2 IR2 COUNTS ZEROS ON RIGHT
05002 -0763 00 0 00003 LGL 3
05003 1 77777 2 05004 TXI *+1,2,-1 COUNT VACATED POSITIONS
05004 0100 00 0 05002 TZE *-2
* A NON-ZERO DIGIT HAS APPEARED ON THE LEFT
05005 -0501 00 0 00414 ORA $Q64 PUT IN OVERFLOW FLIPPER
05006 0140 00 0 05007 TOV *+1 SHUT OFF OVERFLOW LIGHT
05007 -0600 00 0 05074 GRETA STQ TONI TEST IF ALL DIGITS ARE SPREAD
05010 0162 00 0 05012 TQP *+2 TEST FOR NON-ZERO SIGN BIT
05011 1 77777 2 05015 TXI FIFI,2,-1 SOME DIGITS NOT SPREAD, SO CONTINUE
05012 -0520 00 0 05074 NZT TONI
05013 0020 00 0 05032 TRA DEBBY TRA IF ALL NON-ZERO DIGITS SPREAD
05014 1 77777 2 05015 TXI *+1,2,-1
05015 0767 00 0 00003 FIFI ALS 3 SPREAD ONE DIGIT
05016 -0763 00 0 00003 LGL 3
05017 -0140 00 0 05007 TNO GRETA SEE IF FULL WORD OF DIGITS
05020 -0600 00 0 05074 STQ TONI PRIT THE WORD
05021 0074 00 4 05110 TSX $PRIN2,4
05022 0500 00 0 00371 CLA $Q1 PUT IN OVERFLOW FILPPER
05023 0560 00 0 05074 LDQ TONI
05024 0140 00 0 05025 TOV *+1 SHUT OFF OVERFLOW LIGHT
05025 0162 00 0 05027 TQP *+2 TEST FOR NON-ZERO SIGN BIT
05026 1 77777 2 05015 TXI FIFI,2,-1
05027 0520 00 0 05074 ZET TONI SEE IF ALL DIGIS SPREAD
05030 1 77777 2 05015 TXI FIFI,2,-1
05031 0020 00 0 05036 TRA VICKI
* FORM WORD FOR PRINTING
05032 0560 00 0 00471 DEBBY LDQ SEVENS PUT 77S IN RIGHT END OF WORD
05033 -0763 00 0 00006 LGL 6 OVERFLOW SIGNALS LEFT END OF WORD
05034 -0140 00 0 05033 TNO *-1
05035 0074 00 4 05110 TSX $PRIN2,4
* PRINT Q AND SCALE FACTOR IF ANY
05036 3 00000 2 05041 VICKI TXH MICKY,2,0 CONTINUE IF 0 SCALE FACTOR
05037 0500 00 0 05101 CLA BCIQ
05040 0020 00 0 05054 TRA PATSY
05041 -3 00011 2 05046 MICKY TXL SANDY,2,9 TRA IF SCALE FACTOR LESS THAN 10
* OCTAL SCALE FACTOR MORE THAN 10
05042 -0754 00 2 00000 PXD ,2
05043 0400 00 0 05075 ADD BQ10 FORM SCALE FACTOR FOR PRINTING
05044 -0760 00 0 00003 SSM
05045 0020 00 0 05054 TRA PATSY
* OCTAL SCALE FACTOR LESS THAN 10
05046 -0754 00 2 00000 SANDY PXD ,2
05047 0767 00 0 00006 ALS 6
05050 0400 00 0 05076 ADD BQ0
05051 -0760 00 0 00003 SSM
05052 0020 00 0 05054 TRA PATSY
05053 0500 00 0 05077 MARIE CLA BCI0Q PRINT Q0
05054 0074 00 4 05110 PATSY TSX $PRIN2,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 55
05055 0020 00 0 04762 TRA PR4E
GENERATE A PRINT NAME FOR AN OBJECT WITHOUT ONE.
THE PRINT NAME IS OF THE FORM LDDDDD WHERE THE D,S ARE THE
OCTAL DIGITS OF THE 2,S COMPLMENT OF THE FIRST WORD OF
THE PROPERTY LIST OF THE OBJECT.
05056 -0535 00 4 05071 PR5 LDC PRSS,4
05057 -0754 00 4 00000 PXD 0,4
05060 0131 00 0 00000 XCA
05061 0074 00 4 11021 TSX OCTALP,4
05062 -0501 00 0 05070 ORA PRC1
05063 -0760 00 0 00003 SSM FIX SIGN TO AGREE WITH P BIT FOR PRIN2
05064 -0760 00 0 00001 PBT
05065 0760 00 0 00002 CHS
05066 -0534 00 4 05072 LXD PR1,4 RESTORE LINK IR
05067 0020 00 0 05110 TRA $PRIN2 PUT IN PRINT LINE AND EXIT
05070 430000000000 PRC1 BCI 1,L00000 L SYMBOL
05071 0 00000 0 00000 PRSS STORAGE FOR POINTER TO OBJECT
05072 0 00000 0 00000 PR1
05073 0 00000 0 00000 L
05074 TONI BSS 1
05075 +100066777777 BQ10 OCT 100066777777 USED TO FORM BCI Q1N
05076 +100077777777 BQ0 OCT 100077777777 USED TO FORM BCI QN
05077 +005077777777 BCI0Q OCT 005077777777 BCI 0Q
05100 -007777777777 MISGN OCT 407777777777 BCI -
05101 -107777777777 BCIQ OCT 507777777777
05102 PTPNT BSS 1
05103 0 00000 0 00000 PTTGR TEST CELL FOR NUMBER FLAGS
PRIN2 PRINTS UP TO 6 CHARACTERS IN ONE WORD WHEN THE
CHARACTERS ARE JUSTIFIED TO THE LEFT AND FOLLOWED BY THE
ILLEGAL CHARACTER WHOSE OCTAL FORM IS 77
05104 -0634 00 4 05255 PRINT2 SXD PR9,4
05105 -0734 00 4 00000 PDX 0,4 BRING BCD WORD TO AC
05106 0500 00 4 00000 CLA 0,4
05107 0020 00 0 05112 TRA *+3
05110 3 00000 0 05341 PRIN2 TXH $PUN2,,0 SWITCH TO PUNCH OUT ROUTINE
05111 -0634 00 4 05255 SXD PR9,4
05112 -0634 00 2 05254 SXD PR8,2
05113 -0634 00 1 05253 SXD PR7,1
05114 -0534 00 4 05256 LXD WORDS,4 ROOM LEFT IN OUTPUT RECORD
05115 -3 00000 4 05245 TXL INIT,4,0 CAN BE ZERO ONLY IF ROUTINE NOTUSED
05116 0774 00 1 00001 COMB4 AXT 1,1
05117 0601 00 0 05262 STO TEMP
05120 -0500 00 0 05262 CAL TEMP
05121 -0340 00 0 00471 LAS SEVENS WORD OF ALL 77-S CAUSES NO ACTION
05122 0020 00 0 05124 TRA *+2
05123 0020 00 0 05155 TRA NOJOB
05124 -0320 00 0 05260 SHIFL ANA RCHM IS THE RIGHT CHARACTER 77
05125 0402 00 0 05260 SUB RCHM
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 56
05126 -0100 00 0 05133 TNZ JUST NOT 77
05127 -0500 00 0 05262 CAL TEMP
05130 0771 00 0 00006 ARS 6
05131 0602 00 0 05262 SLW TEMP
05132 1 00001 1 05124 TXI SHIFL,1,1
05133 -0500 00 0 05262 JUST CAL TEMP
05134 0020 00 1 05143 TRA LSHIF+1,1
05135 0767 00 0 00006 ALS 6
05136 0767 00 0 00006 ALS 6
05137 0767 00 0 00006 ALS 6
05140 0767 00 0 00006 ALS 6
05141 0767 00 0 00006 ALS 6
05142 0602 00 0 05262 LSHIF SLW TEMP
05143 0560 00 0 05262 LDQ TEMP
05144 -0500 00 0 05261 CAL PART
05145 -0534 00 2 05257 LXD PARTS,2
05146 -0763 00 0 00006 COMB LGL 6
05147 0602 00 0 05261 SLW PART
05150 -2 00001 2 05162 TNX WFULL,2,1
05151 1 00001 1 05152 COMB5 TXI *+1,1,1
05152 -3 00006 1 05146 TXL COMB,1,6
05153 -0634 00 2 05257 COMB1 SXD PARTS,2
05154 -0634 00 4 05256 SXD WORDS,4
05155 -0534 00 1 05253 NOJOB LXD PR7,1
05156 -0534 00 2 05254 LXD PR8,2
05157 -0534 00 4 05255 LXD PR9,4
05160 -0754 00 0 00000 PXD 0,0
05161 0020 00 4 00001 TRA 1,4
05162 0602 00 4 05307 WFULL SLW REC,4
05163 -2 00001 4 05166 TNX RECFL,4,1
05164 0774 00 2 00006 COMB3 AXT 6,2
05165 0020 00 0 05151 TRA COMB5 /
05166 -0600 00 0 05262 RECFL STQ TEMP
05167 0500 00 0 05310 CLA WALLPC GET MAX NUMBER OF LINES PER LIST
05170 0400 00 0 00371 ADD $Q1
05171 0340 00 0 05311 CAS BRKOUT COMPARE WITH MAX NUMBER
05172 0020 00 0 05174 TRA *+2 NO, GO ON
05173 0020 00 0 05207 TRA PRTB = BREAKOUT
05174 0601 00 0 05310 STO WALLPC PUT AWAY
05175 0074 00 4 01222 TSX OUTPUT,4
05176 0 00000 0 00364 PRINTD BCDOUT
05177 0 00024 0 05263 REC-20,,20
05200 0560 00 0 05262 LDQ TEMP
05201 -0534 00 4 00447 LXD QD20,4
05202 -0500 00 0 00472 CAL BLNKA
05203 0602 00 0 05261 SLW PART
05204 -0534 00 4 00447 LXD QD20,4
05205 -0534 00 2 00444 LXD QD5,2
05206 0020 00 0 05151 TRA COMB5
05207 -0534 00 4 05307 PRTB LXD PCPPI,4 PUSH DOWN COUNTER
05210 -0634 00 4 02317 SXD $CPPI,4 RESTORE TO ENTRACE VALUE
05211 -0534 00 1 05253 LXD PR7,1 RESTORE INDEX 1 AND 2
05212 -0534 00 2 05254 LXD PR8,2
05213 0020 00 0 04612 TRA PRTT1 BREAKOUT
05214 -0634 00 2 05254 TERPRI SXD PR8,2
05215 -0634 00 4 05255 SXD PR9,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 57
05216 -0534 00 2 05257 LXD PARTS,2
05217 -0534 00 4 05256 LXD WORDS,4
05220 -0500 00 0 05261 CAL PART
05221 0560 00 0 00472 LDQ BLANK
05222 -0763 00 0 00006 TER1 LGL 6
05223 2 00001 2 05222 TIX TER1,2,1
05224 0602 00 4 05307 TER3 SLW REC,4
05225 -2 00001 4 05230 TNX TER2,4,1
05226 -0500 00 0 00472 CAL BLANK
05227 0020 00 0 05224 TRA TER3
05230 0074 00 4 01222 TER2 TSX OUTPUT,4
05231 0 00000 0 00364 PRINTC BCDOUT
05232 0 00024 0 05263 REC-20,,20
05233 -0534 00 4 00447 LXD QD20,4
05234 -0634 00 4 05256 SXD WORDS,4
05235 -0534 00 2 00444 LXD QD5,2
05236 -0634 00 2 05257 SXD PARTS,2
05237 -0534 00 2 05254 LXD PR8,2
05240 -0534 00 4 05255 LXD PR9,4
05241 0500 00 0 00472 CLA BLNKA
05242 0601 00 0 05261 STO PART
05243 -0754 00 0 00000 PXD 0,0
05244 0020 00 4 00001 TRA 1,4
05245 -0534 00 4 00447 INIT LXD QD20,4
05246 0560 00 0 00472 LDQ BLNKA
05247 -0600 00 0 05261 STQ PART
05250 0774 00 2 00005 AXT 5,2
05251 -0634 00 2 05257 SXD PARTS,2
05252 0020 00 0 05116 TRA COMB4
*
05253 0 00000 0 00000 PR7
05254 0 00000 0 00000 PR8
05255 0 00000 0 00000 PR9
05256 0 00000 0 00000 WORDS
05257 0 00000 0 00000 PARTS ROOM IN PARTIAL WORD
05260 +000000000077 RCHM OCT 77
05261 0 00000 0 00000 PART
05262 0 00000 0 00000 TEMP
05307 REC BES 20
05307 0 00000 0 00000 PCPPI PUSHDOWN COUNTER STORAGE
05310 0 00000 0 00000 WALLPC NUMBER OF LINES IN THIS LIST SO FAR
05311 +000000000031 BRKOUT DEC 25 MAXIMUM NUMBER OF LINES IN ANY LIST
00444 QD5 SYN $QD5
00447 QD20 SYN $QD20
00472 BLANK SYN BLANKS
00472 BLNKA SYN BLANKS
*
* BCDAD1 A CONVERT TABLE FOR ADDING 1 TO A 6 DIGIT BCD NUMBER
* USED BY LOADING BCD NUMBER INTO AC AND DOING
* CVR BCDAD1,,6
*
05312 0 00000 0 05312 ADT PZE ADT 0
05313 0 10000 0 05312 BCDAD1 PZE ADT,,1*4096 1
05314 0 20000 0 05312 PZE ADT,,2*4096
05315 0 30000 0 05312 PZE ADT,,3*4096 3
05316 0 40000 0 05312 PZE ADT,,4*4096 4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 58
05317 0 50000 0 05312 PZE ADT,,5*4096 5
05320 0 60000 0 05312 PZE ADT,,6*4096 6
05321 0 70000 0 05312 PZE ADT,,7*4096 7
05322 1 00000 0 05312 PON ADT 8
05323 1 10000 0 05312 PON ADT,,1*4096 9
05324 0 00000 0 05313 PZE BCDAD1 10
*
* PUNCH WRITES OUT A LIST ON TH SYSTEM PERFIAL PUNCH TAPE
* (SYSPPT) IN A FORM SUTABLE FOR PUNCHING IN BCD.
*
05325 0634 00 4 05337 PUNCH SXA PNCHX,4 SAVE LINK IR
05326 -0625 00 0 05461 STL PUNACT ACTVTE PUNCH ROUTINE
05327 -0734 00 4 00000 PDX 0,4 ARGUMENT TO IR 4
05330 0502 00 0 05110 CLS $PRIN2 SE SWITCH TO
05331 0601 00 0 05110 STO $PRIN2 GO TO PUNCH ROUTINE
05332 -0754 00 4 00000 PXD 0,4 ARGUMENT TO AC
05333 0601 00 0 03453 STO PRINTL SAVE THE ARGUMENT
05334 0074 00 4 04620 TSX $PRIN0,4 USES PRINT ROUTINE
05335 0074 00 4 05421 TSX TERPUN,4 TERMINATE PUNCHING
05336 0500 00 0 03453 CLA PRINTL RESTORE THE ARGUMENT
05337 0774 00 4 00000 PNCHX AXT **,4 RESTORE LINK IR
05340 0020 00 4 00001 TRA 1,4 EXIT
*
* PUN2 PUNCH EQUIVELENT OF PRIN 2
*
05341 0634 00 4 05364 PUN2 SXA PNX,4 SAVE INDEX REGISTERS
05342 0634 00 2 05365 SXA PNY,2
05343 0634 00 1 05366 SXA PNZ,1
05344 0774 00 4 00014 PWRDS AXT 12,4 NUMBER OF WORDS LEFT IN BUFFER
05345 0774 00 2 00006 PPRTS AXT 6,2 CHARACTER POSITION
05346 0774 00 1 00006 AXT 6,1 MAXIMUM NUMBER OF CHARACTERS
05347 0131 00 0 00000 XCA ARGUMENT TO MQ
05350 -0754 00 0 00000 PLP PXD 0,0 CLEAR AC
05351 -0763 00 0 00006 LGL 6 CHARACTER TO MQ
05352 0340 00 0 05457 CAS PSS COMPARE WITH 77
05353 0761 00 0 00000 NOP GREATER, (IMPOSSIBLE)
05354 0020 00 0 05361 TRA POUT = , GO TO EXIT
05355 0522 00 2 05455 XEC PCNT,2 LESS THAN, SHIFT CHARACTER
05356 -0602 00 4 05476 ORS POUP,4 PUT IN OUTPUT LINE
05357 -2 00001 2 05370 TNX PRPLP,2,1 GO IF LAST CHARACTER IN WORD
05360 2 00001 1 05350 PGRA TIX PLP,1,1 GET NEXT CHARACTER
05361 0634 00 2 05345 POUT SXA PPRTS,2 SAVE INDEX 2 N 4
05362 0634 00 4 05344 SXA PWRDS,4
05363 -0754 00 0 00000 PXD 0,0 CLEAR AC
05364 0774 00 4 00000 PNX AXT **,4 RESTORE INDEX REGISTERS
05365 0774 00 2 00000 PNY AXT **,2
05366 0774 00 1 00000 PNZ AXT **,1
05367 0020 00 4 00001 TRA 1,4 EXIT
*
05370 0774 00 2 00006 PRPLP AXT 6,2 RELOAD CHARACTER COUNT
05371 2 00001 4 05360 TIX PGRA,4,1 GO IF WORD COUNT NOT EXAUSTED
05372 0500 00 0 05455 CLA PCNT GET CARD NUMBER IN BCD
05373 0114 06 0 05313 CVR BCDAD1,,6 ADD 1 IN BCD
05374 0601 00 0 05455 STO PCNT
05375 -0600 00 0 05460 STQ PNCQ SAVE CONTENTS OF MQ
05376 0560 00 0 00370 LDQ $ZERO ZERO MQ
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 59
05377 -0765 00 0 00006 LGR 6 SHIFT LOW ORDER DIGITS
05400 0361 00 0 05456 ACL PLIS ADD BCD NAME OF CARD
05401 0602 00 0 05476 SLW POUP PUT IN ID FIELD
05402 -0600 00 0 05477 STQ POUP+1
05403 0074 00 4 01222 TSX OUTPUT,4 GO TO OUTPUT
05404 0 00000 0 00363 PPTOUT PUNCH OUT TAPE
05405 0 00016 0 05462 POUP-12,,14 14 WORDS OUT
05406 -0046 00 0 00000 PIA SAVE INDICATORS IN AC
05407 0441 00 0 10340 LDI SYSIND PICK UP SYSTEM INDICATORS
05410 0055 00 000040 SIR PPTIND SET PUNCH TAPE INDICATOR
05411 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
05412 0044 00 0 00000 PAI RESTORE INDICATORS
05413 0774 00 4 00014 AXT 12,4 NUMBER OF WORDS FROM CC 1 TO 72
05414 0600 00 4 05476 STZ POUP,4 ZERO OUTPUT BUFFER
05415 2 00001 4 05414 TIX *-1,4,1
05416 0774 00 4 00014 AXT 12,4 RELOAD WORD COUNT
05417 0560 00 0 05460 LDQ PNCQ RESTORE CONTENTS OF MQ
05420 0020 00 0 05360 TRA PGRA CONTINUE WORK
*
* TERPUN FILLS OUT BUFFER WITH BLANKS AND PUNCHES OUT LAST CARD
* OPERATES ONLY IF PUNCH ROUTINE IS CURRENTLY ACTIVE
*
05421 -0520 00 0 05461 TERPUN NZT PUNACT SKIP IF PUNCH ROUTINE IS CURRENTLY ACT
05422 0020 00 4 00001 TRA 1,4 IMMEDIATE EXIT
05423 0600 00 0 05461 STZ PUNACT DE ACTIVATE THE PUNCH ROUTINE
05424 0634 00 4 05364 SXA PNX,4 SAVE INDEX REGISTERS
05425 0634 00 2 05365 SXA PNY,2
05426 0634 00 1 05366 SXA PNZ,1
05427 0500 00 0 05110 CLA $PRIN2
05430 0602 00 0 05110 SLW $PRIN2 RESTORE PRIN2 SWITCH
05431 0534 00 4 05344 LXA PWRDS,4 PICK UP WORD COUNT
05432 0534 00 2 05345 LXA PPRTS,2 CHARACTER COUNT
05433 0774 00 1 00001 AXT 1,1 CONSTANT 1
05434 0560 00 0 00472 LDQ BLANKS BLANK MQ
05435 -0754 00 0 00000 TPLP PXD 0,0 CLEAR AC
05436 -0763 00 0 00006 LGL 6 1 INTO AC
05437 0522 00 2 05455 XEC PCNT,2 SHIFT INTO POSITIN
05440 -0602 00 4 05476 ORS POUP,4 PUT IN OUTPUT LINE
05441 2 00001 2 05435 TIX TPLP,2,1 FILL OUT THIS WORD
05442 -2 00001 4 05370 TNX PRPLP,4,1 GO IF LAST WORD IN BUFFER
05443 0500 00 0 00472 CLA BLANKS BLANK AC
05444 0601 00 4 05476 STO POUP,4 BLANK REST OF BUFFER
05445 2 00001 4 05444 TIX *-1,4,1
05446 0020 00 0 05370 TRA PRPLP GO PUNCH IT OUT
* COSTANTS, STORAGE AND SHIFT TABLE
05447 0767 00 0 00036 ALS 30
05450 0767 00 0 00030 ALS 24
05451 0767 00 0 00022 ALS 18
05452 0767 00 0 00014 ALS 12
05453 0767 00 0 00006 ALS 6
05454 0761 00 0 00000 NOP
05455 0 00000 0 00000 PCNT PZE BASE OF SHIFT TABLE AND CARD COUNT
05456 433162470000 PLIS BCI 1,LISP00 CARD ID
05457 +000000000077 PSS OCT 77 CHARACTER THAT TERMINATES A PNAME
05460 0 00000 0 00000 PNCQ
05461 0 00000 0 00000 PUNACT NON-ZERO IF PUNCH ROUTINE ACTIVE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 60
05462 BSS 12
05476 +000000000000 POUP OCT 0,0 OUTPUT BUFFER
05477 +000000000000
FLONAM MAY 14,1559
FORMS THE BCD LIST FOR A FLOATING NUMBER IN THE ACC
T HED
05500 0634 00 4 05666 FLONAM SXA FLNX,4
05501 -0734 00 4 00000 PDX 0,4
05502 0500 00 4 00000 CLA 0,4
05503 -0100 00 0 05512 TNZ FLNA
05504 0534 00 4 05666 LXA FLNX,4
05505 0131 00 0 00000 XCA
05506 0500 00 0 05706 CLA FLZPZ 0.0
05507 0162 00 0 05110 TQP $PRIN2
05510 0402 00 0 05731 SUB C0 -0,0
05511 0020 00 0 05110 TRA $PRIN2
05512 0634 00 2 05667 FLNA SXA FLNY,2
05513 0634 00 1 05670 SXA FLNZ,1
05514 0774 00 1 00001 AXT 1,1 SET UP BUFFER IRS
05515 0774 00 2 00044 AXT 36,2
05516 0600 00 0 05703 STZ FLOPB-3
05517 0600 00 0 05704 STZ FLOPB-2
05520 0600 00 0 05705 STZ FLOPB-1
05521 0601 00 0 77667 STO COMMON+5
05522 0131 00 0 00000 XCA
05523 -0754 00 0 00000 PXD ,0 CLEAR ACC. AND SIGN.
05524 0765 00 0 00000 FL73 LRS 0 SIGN TO MQ
05525 0763 00 0 00010 LLS 8 CHARACTERSITIC.
05526 0402 00 0 00415 SUB A128 128
05527 -0600 00 0 77662 STQ COMMON SAVE MANTISSA.
05530 0131 00 0 00000 XCA MULTIPLY BY
05531 0200 00 0 05720 MPY LOG2 LOG BASE 10 OF 2.
05532 0601 00 0 77664 STO COMMON+2
05533 0120 00 0 05542 TPL FL75
05534 0402 00 0 05717 FL74 SUB A1 1
05535 0601 00 0 77664 STO COMMON+2
05536 0131 00 0 00000 XCA
05537 0760 00 0 00006 COM
05540 0760 00 0 00003 SSP
05541 0131 00 0 00000 XCA
05542 0200 00 0 05721 FL75 MPY LOG10 LOG BASE 2 OF 10/4.
05543 0765 00 0 00041 LRS 33
05544 0621 00 0 05555 STA FL76A
05545 -0600 00 0 77672 STQ COMMON+8
05546 0774 00 4 00007 AXT 7,4
05547 0560 00 0 05722 LDQ C7
05550 0200 00 0 77672 FL76 MPY COMMON+8
05551 0400 00 4 05732 ADD C0+1,4
05552 0131 00 0 00000 XCA
05553 2 00001 4 05550 TIX FL76,4,1
05554 0200 00 0 77662 MPY COMMON MANTISSA.
05555 0774 00 4 00000 FL76A AXT **,4
05556 0765 00 4 00042 LRS 34,4
05557 0100 00 0 05564 TZE FL77
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 61
05560 0221 00 0 05716 DVP A1-1 10.
05561 0500 00 0 77664 CLA COMMON+2
05562 0400 00 0 05717 ADD A1 1.
05563 0601 00 0 77664 STO COMMON+2
05564 0774 00 4 00010 FL77 AXT 8,4
05565 -0200 00 4 05717 FL78 MPR A1,4 10 TO DEC. PLACES.
05566 0340 00 4 05717 CAS A1,4
05567 0761 00 0 00000 NOP GREATER.
05570 0020 00 0 05572 TRA FL79 EQUAL.
05571 0020 00 0 05576 TRA FL80 LESS.
05572 0500 00 0 05717 FL79 CLA A1 ROUDING CAUSED CARRY.
05573 0400 00 0 77664 ADD COMMON+2
05574 0601 00 0 77664 STO COMMON+2 EXP+1.
05575 0500 00 4 05720 CLA A1+1,4 10 TO THE DEC. PL.-1.
05576 0601 00 0 77672 FL80 STO COMMON+8
05577 -0754 00 0 00000 PXD ,0
05600 0560 00 0 77664 LDQ COMMON+2 ENTER DEC EXP.
05601 0221 00 0 05716 DVP A1-1 10
05602 -0600 00 0 77671 STQ COMMON+7
05603 0634 00 4 05621 SXA FL82,4
05604 0074 00 4 05673 TSX INBCD,4
05605 -0754 00 0 00000 PXD ,0
05606 0560 00 0 77671 LDQ COMMON+7
05607 0221 00 0 05716 DVP A1-1
05610 0100 00 0 05612 TZE *+2
05611 0074 00 4 05673 TSX INBCD,4
05612 0500 00 0 77664 CLA COMMON+2
05613 0100 00 0 05617 TZE FL81
05614 0120 00 0 05617 TPL FL81
05615 0500 00 0 00423 CLA ONEMI MINUS SIGN
05616 0074 00 4 05673 TSX INBCD,4
05617 0500 00 0 00410 FL81 CLA ONEE
05620 0074 00 4 05673 TSX INBCD,4
05621 0774 00 4 00000 FL82 AXT **,4
05622 0600 00 0 05702 STZ FLZET
05623 0500 00 0 77672 FL65 CLA COMMON+8
05624 0765 00 0 00043 FL67 LRS 35
05625 0221 00 0 05716 DVP A1-1 10.
05626 -0600 00 0 77672 STQ COMMON+8 FRACTIONAL PART.
05627 -0520 00 0 05702 NZT FLZET
05630 0100 00 0 05635 TZE FL01
05631 -0602 00 0 05702 ORS FLZET
05632 0634 00 4 05634 SXA *+2,4 SAVE IR4.
05633 0074 00 4 05673 TSX INBCD,4 ENTER DIGIT.
05634 0774 00 4 00000 AXT **,4 RESTORE.
05635 2 00001 4 05623 FL01 TIX FL65,4,1
05636 -0754 00 0 00000 PXD 0,0
05637 -0520 00 0 05702 NZT FLZET
05640 0074 00 4 05673 TSX INBCD,4
05641 0500 00 0 00422 CLA A33 DEC. POINT.
05642 0074 00 4 05673 TSX INBCD,4 ENTER.
05643 -0754 00 0 00000 PXD 0,0
05644 0074 00 4 05673 TSX INBCD,4
05645 0560 00 0 77667 LDQ COMMON+5
05646 -0500 00 0 00427 CAL ONEBL BLANK
05647 0162 00 0 05651 TQP FL70 FOR PLUS.
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 62
05650 -0500 00 0 00423 CAL ONEMI NEGATIVE.
05651 0074 00 4 05673 FL70 TSX INBCD,4 INSERT BLANK OR MINUS.
05652 -0754 00 2 00000 PXD 0,2
05653 -0737 00 2 00000 PDC 0,2
05654 0560 00 0 00471 LDQ ONES FILL OUT LAST WORD WITH 77S
05655 -0500 00 1 05706 CAL FLOPB,1
05656 -0763 00 2 00000 LGL 0,2
05657 -0130 00 0 00000 XCL
05660 0131 00 0 00000 XCA
05661 0074 00 4 05110 TSX $PRIN2,4
05662 -2 00001 1 05666 TNX FLNX,1,1
05663 0500 00 1 05706 CLA FLOPB,1
05664 0074 00 4 05110 TSX $PRIN2,4
05665 2 00001 1 05663 TIX *-2,1,1
05666 0774 00 4 00000 FLNX AXT **,4
05667 0774 00 2 00000 FLNY AXT **,2
05670 0774 00 1 00000 FLNZ AXT **,1
05671 -0754 00 0 00000 PXD 0,0
05672 0020 00 4 00001 TRA 1,4
*
05673 -0320 00 0 00413 INBCD ANA A77
05674 0767 00 2 00044 ALS 36,2
05675 -0602 00 1 05706 ORS FLOPB,1
05676 2 00006 2 05701 TIX *+3,2,6
05677 1 00001 1 05700 TXI *+1,1,1
05700 0774 00 2 00044 AXT 36,2
05701 0020 00 4 00001 TRA 1,4
*
05702 0 00000 0 00000 FLZET
05706 FLOPB BES 3
05706 606060600000 FLZPZ VFD H24/ 0.0,012/7777
05707 +000575360400 DEC 100000000
05710 +000046113200 DEC 10000000
05711 +000003641100 DEC 1000000
05712 +000000303240 DEC 100000
05713 +000000023420 DEC 10000
05714 +000000001750 THSND DEC 1000
05715 +000000000144 DEC 100
05716 +000000000012 DEC 10
05717 +000000000001 A1 DEC 1
05720 +115040465025 LOG2 OCT 115040465025 LOG BASE 10 OF 2.
05721 +324464741127 LOG10 OCT 324464741127 LOG BASE 2 OF 10-4.
05722 +000001601225 C7 OCT 1601225
05723 +000007762664 C6 OCT 7762664
05724 +000132240566 C5 OCT 132240566
05725 +001164125106 C4 OCT 1164125106
05726 +007066267024 C3 OCT 7066267024
05727 +036577252307 C2 OCT 36577252307
05730 +130562064437 C1 OCT 130562064437
05731 2 00000 0 00000 C0 TIX 0,0,0
00422 A33 SYN $QO33
00413 A77 SYN $Q63
00415 A128 SYN $Q128
00420 ONEPL SYN $QO20
00410 ONEE SYN $QO25
00423 ONEMI SYN $QO40
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 63
00427 ONEBL SYN $QO60
00471 ONES SYN SEVENS
*
READ
READ = SELECT(RD.,LPAR,READ1.,
LITER,INTERN.,
NUM,INTERN.,
RPAR,ERROR.,
1,ERROR)
READ1
READ1 = SELECT(RD.,RPAR,0.,
LPAR,CONS(READ1,READ1).,
LITER,CONS(INTERN,READ1).,
NUMB,CONS(INTERN,READ1))
I HED
05732 0634 00 4 05734 READ SXA REDS1,4 SAVE LINK IR
05733 0074 00 4 06026 TSX $RD,4 GET FIRST ITEM
05734 0774 00 4 00000 REDS1 AXT **,4 RSTORE LINK IR
05735 0340 00 0 06022 REDIS CAS RLPAR DISPATCH ON TYPE OF ITEM READ
05736 0020 00 0 05740 TRA *+2
05737 0020 00 0 05757 TRA READ1 WAS (
05740 0340 00 0 06023 CAS RRPAR
05741 0020 00 0 05743 TRA *+2
05742 0020 00 0 05747 TRA REDER
05743 0340 00 0 06024 CAS RDOT
05744 0020 00 4 00001 TRA 1,4
05745 0020 00 0 05747 TRA REDER
05746 0020 00 4 00001 TRA 1,4
05747 -0634 00 4 01562 REDER SXD $ERROR,4 MUST BE AN ERROR
05750 0601 00 0 03452 STO RS2 SAVE TYPE
05751 0074 00 4 01222 TSX OUTPUT,4 WRITE OUT INPUT BUFFER
05752 0 00000 0 00364 BCDOUT
05753 0 00016 0 06351 CELL-15,,14
05754 0500 00 0 03452 CLA RS2 GET TYPE
05755 0074 00 4 01563 TSX $ERROR+1,4 GOT O ERROR
05756 545160600154 BCI 1,*R 1* CONTEXT ERROR
*
05757 -0634 00 4 03451 READ1 SXD RS1,4 SAVE LINK IR
05760 0074 00 4 06026 TSX $RD,4 GET NEXT ITEM
05761 0340 00 0 06023 CAS RRPAR
05762 0020 00 0 05764 TRA *+2
05763 0020 00 0 06003 TRA RP1 WAS ) RETURN WITH NIL
05764 0074 00 4 02312 TSX $SAVE,4
05765 -3 03454 0 02377 TXL $END2,,RS2+2 SAVE 2 ITEMS
05766 0340 00 0 06024 CAS RDOT
05767 0020 00 0 05771 TRA *+2
05770 0020 00 0 06006 TRA RP2 WAS .
05771 0340 00 0 06022 CAS RLPAR
05772 0020 00 0 05774 TRA *+2
05773 0074 00 4 05757 TSX READ1,4
05774 0601 00 0 03452 STO RS2 SAVE RESULTS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 64
05775 0074 00 4 05757 TSX READ1,4 GET NEXT ITEM
05776 0131 00 0 00000 XCA PUT IN MQ
05777 0500 00 0 03452 CLA RS2 FIRST ITEM
06000 0074 00 4 02326 TSX UNSAVE,4
06001 -0534 00 4 03451 LXD RS1,4 RESTORE LINK IR
06002 0020 00 0 03730 TRA $CONS CONSTRUCT A LIST
*
06003 -0754 00 0 00000 RP1 PXD 0,0 WAS ) RETURN WITH NIL
06004 -0534 00 4 03451 LXD RS1,4
06005 0020 00 4 00001 TRA 1,4
*
06006 0074 00 4 06026 RP2 TSX $RD,4 WAS . GET NEXT ITEM
06007 0074 00 4 05735 TSX REDIS,4 DISPATCH ON IT
06010 0601 00 0 03452 STO RS2 SAVE RESULTS
06011 0074 00 4 06026 TSX $RD,4 GET NEXT ITEM
06012 0340 00 0 06023 CAS RRPAR SHOULD BE )
06013 0020 00 0 05747 TRA REDER GO TO ERROR IF NOT
06014 0020 00 0 06016 TRA *+2
06015 0020 00 0 05747 TRA REDER
06016 0500 00 0 03452 CLA RS2 GET ITEM READ
06017 0074 00 4 02326 TSX UNSAVE,4
06020 -0534 00 4 03451 LXD RS1,4 RESTORE LINK IR
06021 0020 00 4 00001 TRA 1,4 RETURN WITH IT
*
00505 RLTR SYN QUOTED SYMBOL FLAG
00476 RNUMB SYN FLOATD FLOAT (USED TO SIGNIFY ANY KIND NUMBER
*
I HED
RD(A)
READS BCD LISTS FROM CARDS (SW 1 DOWN) OR TAPE 4 (SW1 UP)
06022 0 00531 0 00000 RLPAR ,,$H74D
06023 0 00527 0 00000 RRPAR ,,$H34D
06024 0 00526 0 00000 RDOT ,,$H33D
06025 RDVAL BSS 0
06025 0 00000 0 00001 LRCIS 1 CARD IMAGE EMPTY TEST CELL
06026 0500 00 0 06415 RD CLA RDLST
06027 0100 00 0 06032 TZE RDAA GO IF NOT
06030 0600 00 0 06415 STZ RDLST OTHERWISE ZERO
06031 0020 00 4 00001 TRA 1,4 AND EXIT
06032 0634 00 4 06063 RDAA SXA RDX,4 SAVE INDEX REGISTERS
06033 0634 00 2 06070 SXA RDY,2
06034 0634 00 1 06067 SXA RDZ,1
06035 0604 00 0 06414 STI RDIND SAVE THE INDICATORS
06036 0441 00 0 00370 LDI $ZERO
06037 0774 00 2 00006 RDPTS AXT 6,2 SET UP IR 2 AND 1
06040 0774 00 1 00014 RDWDS AXT 12,1
06041 0074 00 4 06172 RDGC TSX GET,4 GET THE FIRST CHARACTER
06042 0734 00 4 00000 PAX 0,4 TYPE TO INDEX REGISTER
06043 0020 00 4 06053 TRA RDJT1,4 DISPATCH ON TYPE
06044 0020 00 0 06072 TRA RDDLR $
06045 0020 00 0 06122 TRA RDLT
06046 0020 00 0 06123 TRA RDNM NUMBER
06047 0020 00 0 06041 TRA RDGC ,
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 65
06050 0020 00 0 06062 TRA RDPU (
06051 0020 00 0 06062 TRA RDPU )
06052 0020 00 0 06062 TRA RDPU .
06053 0074 00 4 01222 RDJT1 TSX OUTPUT,4 ILLEGAL CHARACTER
06054 0 00000 0 00364 BCDOUT
06055 0 00017 0 06353 RDPB,,15
06056 -0754 00 0 00000 PXD 0,0 CLEAR AC
06057 -0634 00 4 01562 SXD $ERROR,4 SAVE IR 4
06060 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR ROUTINE
06061 545160600354 BCI 1,*R 3*
06062 0500 00 4 06025 RDPU CLA RDVAL,4
06063 0774 00 4 00000 RDX AXT **,4
06064 0634 00 2 06037 RDFIN SXA RDPTS,2 SAVE INDEX REGISTERS
06065 0634 00 1 06040 SXA RDWDS,1
06066 0441 00 0 06414 LDI RDIND RESTORE INDICATORS
06067 0774 00 1 00000 RDZ AXT **,1 RESTORE INDEX REGISTERS
06070 0774 00 2 00000 RDY AXT **,2
06071 0020 00 4 00001 TRA 1,4 EXIT
*
06072 0055 00 000003 RDDLR SIR 3 SET FIRST CHARCTER AND LITERAL INDICAT
06073 0074 00 4 06172 TSX GET,4 IS NEXT CHARACTER A $
06074 0734 00 4 00000 PAX 0,4 IF SO INDICATES A LITERAL STRING
06075 0500 00 0 06416 CLA GTVAL SET VALUE OF GET
06076 0601 00 0 06413 STO RDDDC
06077 3 00006 4 06110 TXH RDDD,4,6 GO IF A $
06100 0634 00 4 06106 SXA RDT,4 NOT SO DO A REGULAR D
06101 0500 00 0 06412 CLA RDDLS $
06102 0601 00 0 06416 STO GTVAL
06103 0074 00 4 06241 TSX PUT,4 PUT IN OUTPUT BUFFER
06104 0500 00 0 06413 CLA RDDDC LAST VALUE OF GET
06105 0601 00 0 06416 STO GTVAL
06106 0774 00 4 00000 RDT AXT **,4 TYPE OF LAST CHARACTER
06107 0020 00 4 06137 TRA RDJT2,4 DISPATCH ON TYPE
*
06110 0074 00 4 06172 RDDD TSX GET,4 IS A LITERAL STRING
06111 0500 00 0 06416 CLA GTVAL USE THIS ITEM AS A DELIMITER
06112 0601 00 0 06413 STO RDDDC
06113 0074 00 4 06172 RDDDL TSX GET,4 GET NEXT CHARACTER
06114 0500 00 0 06413 CLA RDDDC GET DELIMITER
06115 0340 00 0 06416 CAS GTVAL COMAPRE WITH CHARACTER JUST READ
06116 0020 00 0 06120 TRA *+2 NO
06117 0020 00 0 06142 TRA RDXT YES, EXIT
06120 0074 00 4 06241 TSX PUT,4 NO, PUT AWAY THE CHARACTER
06121 0020 00 0 06113 TRA RDDDL GET NEXT CHARACTER
*
06122 0055 00 000002 RDLT SIR 2 SET LITERAL INDICATOR
06123 0055 00 000001 RDNM SIR 1 SET FIRST CHARACTER INDICATOR
06124 0074 00 4 06241 RDNN TSX PUT,4 PUT THE CHARACTER AWAY
06125 0074 00 4 06172 TSX GET,4 GET NEXT CHARACTER
06126 0734 00 4 00000 PAX 0,4
06127 0020 00 4 06137 TRA RDJT2,4 DISPATCH ON TYPE
06130 0020 00 0 06124 TRA RDNN $
06131 0020 00 0 06124 TRA RDNN LITERAL
06132 0020 00 0 06124 TRA RDNN NUMBER
06133 0020 00 0 06142 TRA RDXT ,
06134 0020 00 0 06140 TRA RDPS (
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 66
06135 0020 00 0 06140 TRA RDPS )
06136 0020 00 0 06164 TRA RDPD .
06137 0020 00 0 06053 RDJT2 TRA RDJT1 ILLEGAL CHARACTER
*
06140 0500 00 4 06025 RDPS CLA RDVAL,4 SETUP RDLST CELL
06141 0601 00 0 06415 STO RDLST
06142 0534 00 4 06246 RDXT LXA PUTMC,4 CHARACTER COUNT
06143 -0754 00 0 00000 PXD 0,0 CLEAR AC
06144 3 00005 4 06162 TXH TPF,4,5 GO IF LAST WORD COMPLETED
06145 0560 00 0 00471 LDQ SEVENS GET 77 S
06146 0522 00 4 06327 XEC PTSFT-1,4 PROPER SHIFT
06147 0774 00 4 00006 AXT 6,4 RESET CHARACTER COUNT
06150 0634 00 4 06246 SXA PUTMC,4
06151 0534 00 4 06254 LXA PUTPC,4 WORD COUNT
06152 -0602 00 4 06335 ORS RDPNB,4 PUT IN PNAME BUFFER
06153 -0754 00 0 00000 PXD 0,0 CLEAR AC
06154 0622 00 4 06343 TPFA STD PUTVL+6,4 CHIP OFF PNMAE SAUSAGE
06155 0500 00 0 06335 CLA PUTVL GET VALUE
06156 -0774 00 4 06062 AXC RDPU,4 SET UP TRASNFER TO EXIT
06157 0056 00 000002 RNT 2 TEST LITERAL INDICATOR
06160 0020 00 0 06543 TRA $NUTRN MAKE IT A NUMBER
06161 0020 00 0 06420 TRA INTRN1 MAKE IT AN OBJECT
*
06162 0534 00 4 06254 TPF LXA PUTPC,4 CORRECT PART COUNT
06163 1 00001 4 06154 TXI TPFA,4,1
*
06164 0054 00 000002 RDPD RFT 2 TEST FOR LITERAL
06165 0020 00 0 06140 TRA RDPS FIRST . TERMONATES A LITERAL
06166 0054 00 000020 RFT 20 TEST FOR FIRST DOT IN A NUMBER
06167 0020 00 0 06140 TRA RDPS SECOND . TERMINATES A NUMBER
06170 0055 00 000020 SIR 20 SET DOT INDICATOR
06171 0020 00 0 06124 TRA RDNN
*
06172 0634 00 4 06220 GET SXA GTX,4 SAVE LINK IR
06173 0520 00 0 06025 ZET LRCIS TEST FOR NEW CARD NEEDED
06174 0020 00 0 06227 TRA GTGCD GET A NEW CAERD
06175 -0754 00 0 00000 GETGO PXD 0,0 CLEAR AC
06176 0560 00 1 06370 LDQ CELL,1 GET NEXT WORD
06177 -0763 00 0 00003 LGL 3 HIGH ORDER BITS
06200 0734 00 4 00000 PAX 0,4
06201 -0763 00 0 00003 LGL 3 CHARACTER
06202 0340 00 0 00416 CAS $QO14 IS IT ILLEGAL MINUS SIGN
06203 0020 00 0 06205 TRA *+2 NO
06204 0500 00 0 00423 CLA $QO40 YES GET LEGAL ONE
06205 0601 00 0 06416 STO GTVAL VALUE OF GET FOR PUT
06206 -0320 00 0 00377 ANA $Q7 MASK OUT HIGH ORDER BIT
06207 0621 00 0 06213 STA GTPT
06210 -0600 00 1 06370 STQ CELL,1 UPDATE WORD
06211 -2 00001 2 06222 TNX GTPC,2,1 UPDATE PART COUNT
06212 0560 00 4 06352 GTMC LDQ GTTBL,4 GET TABLE ENTRY
06213 -0763 00 0 00000 GTPT LGL ** SHIFT PROPER ITEM TO AC
06214 0522 00 0 06213 XEC GTPT
06215 0522 00 0 06213 XEC GTPT
06216 -0754 00 0 00000 PXD 0,0 CLEAR AC
06217 -0763 00 0 00003 LGL 3 TYPE NOW IN AC
06220 0774 00 4 00000 GTX AXT **,4 RESTORE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 67
06221 0020 00 4 00001 TRA 1,4
*
06222 0774 00 2 00006 GTPC AXT 6,2 RELOAD PART COUNT
06223 2 00001 1 06212 TIX GTMC,1,1 GO IF NEW WORD NOT NEEDED
06224 -0625 00 0 06025 STL LRCIS GET NEW CARD
06225 0774 00 1 00014 AXT 12,1 ERELOAD IR 1
06226 0020 00 0 06212 TRA GTMC GO BACJ
*
06227 0074 00 4 00663 GTGCD TSX $INPUT,4
06230 0 00000 0 00000 $BCDIN
06231 0 00034 0 06354 LWPO,,28 GET NEXT BCD CARD
06232 0020 00 0 06234 TRA *+2 IGNORE REDUNDNACY ERROR
06233 0020 00 0 06236 TRA GTEOF EOF RETURN
06234 0600 00 0 06025 STZ LRCIS SET SWITCH THAT CARD IS PRESENT
06235 0020 00 0 06175 TRA GETGO NO GO ON
*
06236 -0754 00 0 00000 GTEOF PXD 0,0 CLEAR AC
06237 0074 00 4 01562 TSX $ERROR,4 GO TO ERROR
06240 545160600454 BCI 1,*R 4* EOF ON READ IN
*
06241 0054 00 000040 PUT RFT 40 TEST TO SEE IF TOOMUCH PNAME
06242 0020 00 0 06270 TRA PTTFA GO TO ERROR COMMENT
06243 0634 00 4 06256 SXA PUTX,4 SAVE LINK IR
06244 0056 00 000010 RNT 10 TEST FOR FIRST TIME THRU
06245 0020 00 0 06276 TRA PUTZB ZERO PNAME BUFFER
06246 0774 00 4 00006 PUTMC AXT 6,4 CHARACTER COUNT
06247 0500 00 0 06416 CLA GTVAL GET CHARACTER
06250 0560 00 0 00370 LDQ $ZERO
06251 0522 00 4 06330 XEC PTSFT,4 PROPER SHIFT TO CHARACTER
06252 -2 00001 4 06260 TNX PTRFP,4,1 DECREMENT CHARACTER COUNT
06253 0634 00 4 06246 SXA PUTMC,4 UPDATE COUNT CELL
06254 0774 00 4 00005 PUTPC AXT 5,4 NUMBER OF WORDS IN PNAME
06255 -0602 00 4 06335 PUTGA ORS RDPNB,4 PUT CHARACTER IN
06256 0774 00 4 00000 PUTX AXT **,4 RESTORE LINK IR
06257 0020 00 4 00001 TRA 1,4 EXIT
06260 0774 00 4 00006 PTRFP AXT 6,4 RELOAD PART COUNT
06261 0634 00 4 06246 SXA PUTMC,4
06262 0534 00 4 06254 LXA PUTPC,4 WORD COUNT
06263 -0602 00 4 06335 ORS RDPNB,4
06264 2 00001 4 06266 TIX *+2,4,1 DECREMENT WORD COUNT
06265 0055 00 000040 SIR 40 INDICATE PNAME BUFFER FULL
06266 0634 00 4 06254 SXA PUTPC,4 UPDATE COUNTER
06267 0020 00 0 06256 TRA PUTX GO ON
*
06270 0074 00 4 01222 PTTFA TSX OUTPUT,4 TOO MANY CHARACTER
06271 0 00000 0 00364 BCDOUT WRITE OUT PNAME SO FAR
06272 0 00006 0 06327 RDPNB-6,,6
06273 -0754 00 0 00000 PXD 0,0 CLEAR AC
06274 0074 00 4 01562 TSX $ERROR,4 GO TO ERROR
06275 545160600554 BCI 1,*R 5*
*
06276 0055 00 000010 PUTZB SIR 10 SET SWITCH
06277 0774 00 4 00005 AXT 5,4 FIX UP BUFFER
06300 0634 00 4 06254 SXA PUTPC,4 AND PART COUNT
06301 0600 00 4 06335 STZ RDPNB,4
06302 2 00001 4 06301 TIX *-1,4,1
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 68
06303 0500 00 0 06335 CLA PUTVL RELINK THE WORDS
06304 0774 00 4 00005 AXT 5,4
06305 0402 00 0 00442 SUB $QD1 SET POINTERS
06306 0622 00 4 06343 STD PUTVL+6,4
06307 2 00001 4 06305 TIX *-2,4,1
06310 0020 00 0 06246 TRA PUTMC
*
06311 -0625 00 0 06025 TEREAD STL LRCIS SET SWITCH TO GET A NEW CARD
06312 0500 00 0 00376 CLA $Q6 SET CELLS
06313 0621 00 0 06037 STA RDPTS
06314 0621 00 0 06246 STA PUTMC
06315 0500 00 0 00403 CLA $Q12
06316 0621 00 0 06040 STA RDWDS
06317 0600 00 0 06415 STZ RDLST
06320 -0754 00 0 00000 PXD 0,0 CLEAR AC
06321 0020 00 4 00001 TRA 1,4 EXIT
*
06322 -0763 00 0 00036 LGL 30
06323 -0763 00 0 00030 LGL 24
06324 -0763 00 0 00022 LGL 18
06325 -0763 00 0 00014 LGL 12
06326 -0763 00 0 00006 LGL 6
06327 0761 00 0 00000 NOP
06330 PTSFT BSS 0
06335 RDPNB BES 5
06335 0 71442 0 00000 PUTVL ,,-*-1 VALUE OF RDA
06336 0 71441 0 71450 -RDPNB+5,,-*-1 FOR INTERN OF NUTRN
06337 0 71440 0 71447 -RDPNB+4,,-*-1
06340 0 71437 0 71446 -RDPNB+3,,-*-1
06341 0 71436 0 71445 -RDPNB+2,,-*-1
06342 0 00000 0 71444 -RDPNB+1
06343 -260430000000 OCT 660430000000,466666660000,660760000000,566666660000
06344 -066666660000
06345 -260760000000
06346 -166666660000
06347 -260120000000 OCT 660120000000,566666660000,550650000000
06350 -166666660000
06351 -150650000000
06352 -155555550000 GTTBL OCT 555555550000
06353 006060606060 RDPB BCI 1,0
06354 0 00000 0 00000 LWPO
06355 0 00000 0 00000 LWCKS
06370 CELL BES 10
06404 LWDPB BES 12
06404 BSS 6 ROOM FOR ID AND LOOK AHEAD BITS
06412 000000000053 RDDLS BCI 1,00000$
06413 0 00000 0 00000 RDDDC
06414 0 00000 0 00000 RDIND INDICATOR STORAGE
06415 0 00000 0 00000 RDLST
06416 0 00000 0 00000 GTVAL
*
INTERN
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 69
I HED
*
* INTERN CHANGED AND MODIFIED TO INCLUDE EXTERNAL ENTRACES AND
* THE BUCKET SORT
*
06417 -0600 00 0 06534 BUKSRT STQ BSRT ATOM TO BE PLACED (CNSFWL ENTRANCE)
06420 0601 00 0 06533 INTRN1 STO $VALUE EXTERNAL ENTRANCE FROM APPLY
06421 0634 00 4 06525 INTERN SXA ITRX,4 ENTRANCE FROM READ
06422 0634 00 2 06526 SXA ITRY,2 SAVE IR 2
06423 -0534 00 4 06533 LXD $VALUE,4 PICK UP POINTER TO PNAME LIST
06424 0500 00 4 00000 CLA 0,4 GET FIRST WORD OF PNAME
06425 0734 00 4 00000 PAX 0,4
06426 -0500 00 4 00000 CAL 0,4 GET FIRST WORD IN LOGICAL AC
06427 0765 00 0 00043 LRS 35 PUT IN MQ AND BIT 35 OF AC
06430 0221 00 0 06535 DVP BUCKNO DIVIDE BY NUMBER OF BUCKETS
06431 0760 00 0 00012 DCT CHECK DIVISION
06432 0074 00 4 01676 TSX $DCT,4 DIVIDE ERROR
06433 0734 00 4 00000 PAX 0,4 REMAIDNER TO IR 4
06434 0500 00 4 66427 CLA BUCKET,4 PICK UP BUCKET
06435 0634 00 4 06522 SXA BUCK,4 SAVE THE REMAINDER
06436 0734 00 4 00000 PAX 0,4
06437 -0634 00 4 06540 SXD O5,4 SET UP WORD
06440 0520 00 0 06534 ZET BSRT TEST FOR CNSFWL ENTRANCE
06441 0020 00 0 06530 TRA INTAD YES, GO
06442 -0634 00 4 06536 SXD O1,4
06443 -0534 00 4 06536 O4 LXD O1,4 NEXT OBJECT
06444 -3 00000 4 06504 TXL OUT,4,0 END OF OBJLIST
06445 0500 00 4 00000 CLA ,4
06446 0622 00 0 06536 STD O1
06447 0734 00 4 00000 PAX ,4 OBJECT M/C NAME
06450 -0634 00 4 06537 SXD O2,4 PRESERVE IT
06451 0500 00 4 00000 CLA ,4
06452 -0734 00 4 00000 O3 PDX ,4 ADDRESS PART IS -1
06453 -3 00000 4 06443 TXL O4,4,0 END OF PROPERTY LIST
06454 0500 00 4 00000 CLA ,4
06455 0734 00 4 00000 PAX ,4
06456 -3 07334 4 06452 TXL O3,4,$PNAME-1 NO
06457 3 07335 4 06452 TXH O3,4,$PNAME NO
06460 -0734 00 4 00000 PDX ,4 YES IT IS
06461 0500 00 4 00000 CLA ,4
06462 0734 00 4 00000 PAX ,4 U
06463 -0534 00 2 06533 LXD $VALUE,2 V
06464 -3 00000 2 06443 O7 TXL O4,2,0
06465 0500 00 4 00000 CLA 0,4
06466 0622 00 0 06542 STD Q4 CDR(U)
06467 0734 00 4 00000 PAX ,4 CAR(U)
06470 0500 00 2 00000 CLA ,2
06471 0622 00 0 06541 STD Q2 CDR(V)
06472 0734 00 2 00000 PAX ,2
06473 0500 00 4 00000 CLA ,4 CWR(CAR(U))
06474 0402 00 2 00000 SUB ,2 -CWR(CAR(V))
06475 -0100 00 0 06443 TNZ O4 NOT THE SAME,NEXT OBJECT
06476 -0534 00 4 06542 LXD Q4,4 CDR(U)
06477 -0534 00 2 06541 LXD Q2,2
06500 3 00000 4 06464 TXH O7,4,0 IF NOT YET END OF NAME
06501 3 00000 2 06443 TXH O4,2,0 IF U,V OF DIFFERENT LENGTH,NEXT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 70
06502 0500 00 0 06537 CLA O2
06503 0020 00 0 06525 TRA ITRX
06504 0500 00 0 06533 OUT CLA $VALUE
06505 0074 00 4 07343 TSX $CP1,4
06506 0560 00 0 00370 LDQ $ZERO
06507 0074 00 4 03730 TSX $CONS,4
06510 0131 00 0 00000 XCA
06511 0500 00 0 00504 CLA OPNA
06512 0074 00 4 03730 TSX $CONS,4
06513 0131 00 0 00000 XCA INTO MQ
06514 0500 00 0 00460 CLA $DMASK ATOM SYMBOL
06515 0074 00 4 03730 TSX $CONS,4 MAKE IT AN ATOM
06516 0560 00 0 06540 INTCN LDQ O5 LIST OF ATOMS IN BUCKET
06517 0622 00 0 06540 STD O5 SAVE ATOM AS ANSWER
06520 0074 00 4 03730 TSX $CONS,4 ATTACH TO BEGINNING OF LIST
06521 0771 00 0 00022 ARS 18 PUT IN ADDRESS
06522 0774 00 4 00000 BUCK AXT **,4 BUCKET NUMBER
06523 0621 00 4 66427 STA BUCKET,4 PUT IN PROPER BUCJET
06524 0500 00 0 06540 CLA O5 ATOM AS ANSWER
06525 0774 00 4 00000 ITRX AXT **,4 RESTORE LINK IR
06526 0774 00 2 00000 ITRY AXT **,2
06527 0020 00 4 00001 TRA 1,4 EXIT
06530 0500 00 0 06534 INTAD CLA BSRT PICK UP ATOM
06531 0600 00 0 06534 STZ BSRT ZERO LOCATION
06532 0020 00 0 06516 TRA INTCN PLACE ATOM IN BICKET
06533 0 00000 0 00000 VALUE POINTER TO PNAME LIST
06534 0 00000 0 00000 BSRT ATOM IN CNSFWL WENTRANCE
06535 0 00000 0 00177 BUCKNO PZE 127 NUMBER OF BUCKETS
*
06536 0 00000 0 00000 O1
06537 0 00000 0 00000 O2
06540 0 00000 0 00000 O5
00504 OPNA SYN PNAMED
06541 0 00000 0 00000 Q2
06542 0 00000 0 00000 Q4
T HED
06543 0634 00 4 06617 NUTRN SXA NX4,4 SAVE IDNEX REGISVERS
06544 0634 00 2 06616 SXA NX2,2
06545 0634 00 1 06615 SXA NX1,1
06546 0774 00 1 00006 AXT 6,1
06547 -0534 00 4 06533 LXD $VALUE,4
06550 0500 00 4 00000 NA1 CLA 0,4
06551 -0734 00 4 00000 PDX 0,4
06552 0734 00 2 00000 PAX 0,2
06553 0500 00 2 00000 CLA 0,2
06554 0601 00 1 07333 STO BUFFER+6,1
06555 -3 00000 4 06566 TXL NA2,4,0
06556 2 00001 1 06550 TIX NA1,1,1
06557 -0634 00 4 01562 NE SXD $ERROR,4
06560 0074 00 4 01222 TSX OUTPUT,4
06561 0 00000 0 00364 BCDOUT
06562 0 00016 0 06351 I$CELL-15,,14
06563 -0754 00 0 00000 PXD 0,0 CLEAR AC
06564 0074 00 4 01563 TSX $ERROR+1,4
06565 545160600654 BCI 1,*R 6* NUMBER TO LARGE IN CONVERSION
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 71
06566 0500 00 0 00472 NA2 CLA BLANKS
06567 0601 00 1 07334 STO BUFFER+7,1
06570 0500 00 0 06621 CLA KBPOS PARAMETER FOR NUMBR
06571 0074 00 4 06622 TSX $NUMBR,4 NUMBER TO MQ
06572 0100 00 0 06557 TZE NE OUT-OF-RANGE ERROR
06573 -0120 00 0 06612 TMI NA7 TRA IF FLOATING NUMBER
06574 -0760 00 0 00001 PBT TEST FOR OCTAL NUMBER
06575 0020 00 0 06601 TRA NA3 TRA IF OCTAL
06576 0500 00 0 00503 CLA $OCTD OCTAL SIGNAL FOR $MKNO
06577 0131 00 0 00000 XCA
06600 0020 00 0 06614 TRA NA8
06601 0131 00 0 00000 NA3 XCA NUMBER TO AC
06602 0560 00 0 00475 LDQ $FIXD FIX TO MQ
06603 -0120 00 0 06614 TMI NA8
06604 0340 00 0 00402 CAS $Q10 TEST FOR 0 THRU 9
06605 0020 00 0 06614 TRA NA8
06606 0020 00 0 06614 TRA NA8
06607 0361 00 0 00521 ACL $H00A FORM PRINT OBJECT
06610 0767 00 0 00022 ALS 18
06611 0020 00 0 06615 TRA NX1
06612 0500 00 0 00476 NA7 CLA FLOATD FLOAT SIGNAL FOR $MKNO
06613 0131 00 0 00000 XCA NUMBER TO AC
06614 0074 00 4 12636 NA8 TSX $MKNO,4 MAKE A NUMBER
06615 0774 00 1 00000 NX1 AXT **,1 RESTORE INDEX REGISTERS
06616 0774 00 2 00000 NX2 AXT **,2
06617 0774 00 4 00000 NX4 AXT **,4
06620 0020 00 4 00001 TRA 1,4
06621 0 00001 0 07325 KBPOS PZE BUFFER,,1
F HED
NUMBR CONVERTS PACKET BCD CHARACTERS TO A NUMBER WHICH
APPEARS IN MQ. DBC CONVERSIONS ARE FOLLOWED. OCTAL
NUMBERS ARE SIGNALLED BY Q AND MAY BE FOLLOWED BY A
SCALE FACTOR.
ROUTINE STOLEN FROM UADBC1
06622 0634 00 1 07155 NUMBR SXA PX1,1 SAVE INDEX REGISTERS
06623 0634 00 2 07156 SXA PX2,2
06624 0634 00 4 07157 SXA PX4,4
06625 0602 00 0 77665 SLW T
06626 0737 00 2 00000 PAC ,2 IR2 HAS WORD COUNT
06627 -0737 00 1 00000 PDC ,1 IR1 WILL GET CHARACTER COUNT
06630 0771 00 0 00021 ARS 17
06631 0601 00 0 77666 STO N
06632 0767 00 0 00001 ALS 1
06633 0400 00 0 77666 ADD N
06634 0737 00 4 00000 PAC ,4
06635 0560 00 2 00000 LDQ 0,2 PUT BCD WORD IN MQ
06636 -0763 00 4 77772 LGL -6,4 SHIFT OUT EXTRA CHARACTERS
06637 -0600 00 0 77662 STQ MQ SAVE FIRST BATCH OF CHARACTERS
06640 1 00007 1 06641 TXI *+1,1,7
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 72
LOOK AT CHARACTERS UNTIL A Q OR NON-OCTAL CHARACTER APPEARS.
06641 -0754 00 0 00000 CY3 PXD ,0
06642 -0763 00 0 00006 LGL 6
06643 0402 00 0 00400 SUB Q8 TEST FOR OCTAL DIGIT
06644 0120 00 0 06651 TPL CY4
06645 2 00001 1 06641 CY2 TIX CY3,1,1 GET NEXT CHARACTER
06646 1 77777 2 06647 TXI *+1,2,-1
06647 0560 00 2 00000 LDQ 0,2
06650 1 00005 1 06641 TXI CY3,1,5
06651 0400 00 0 00400 CY4 ADD Q8
06652 0340 00 0 00426 CAS Q
06653 0020 00 0 06666 TRA DECNO
06654 0020 00 0 07170 TRA OCTNO IF Q, NUMBER IS OCTAL
06655 0340 00 0 00423 CAS MINUS IF CHARACTER IS MINUS, PLUS OR DASH,
06656 0020 00 0 06666 TRA DECNO LOOK AT MORE CHARACTERS,
06657 0020 00 0 06645 TRA CY2 OTHERWISE NUMBER IS DECIMAL
06660 0340 00 0 00420 CAS PLUS
06661 0020 00 0 06666 TRA DECNO
06662 0020 00 0 06645 TRA CY2
06663 0340 00 0 00416 CAS DASH
06664 0020 00 0 06666 TRA DECNO
06665 0020 00 0 06645 TRA CY2
06666 0535 00 2 77665 DECNO LAC T,2 IR2 HAS WORD COUNT
06667 -0535 00 1 77665 LDC T,1 IR1 WILL GET CHARACTER COUNT
06670 0560 00 0 77662 LDQ MQ RESTORE FIRST GRUOP OF CHARACTERS
06671 -0754 00 0 00000 PXD ,0
06672 0602 00 0 77662 BN2 SLW BN REGISTERS
06673 0602 00 0 77663 EX2 SLW EXPN
06674 0602 00 0 77666 INTN SLW N
06675 -0534 00 4 00402 LXD Q10,4 SET DECIMAL COUNT TO ZERO
06676 -0500 00 0 06766 CAL SW1 RESET SWITCHES FOR
06677 0630 00 0 07033 STP CM2 FIXED POINT
06700 0630 00 0 07106 STP CM6 X
06701 0630 00 0 07011 STP EXS EXP
06702 0630 00 0 07035 STP CM3 POINT
06703 0630 00 0 07020 STP CX3 DECIMAL NUMBER
06704 -0500 00 0 06674 CAL INTN INITIALIZE CONVERSION
06705 1 00010 1 06720 TXI BN3,1,8 FIX INITIAL CHARACTER COUNT
06706 0502 00 0 07035 PT1 CLS CM3 INVERT SWITCH TO SIGNAL DECIMAL POINT
06707 0601 00 0 07035 STO CM3
06710 -0500 00 0 06743 CAL CV3
06711 0621 00 0 06760 STA CV5 ROUTINE TO COUNT
06712 0621 00 0 06763 STA CV6 DECIMAL PLACES
06713 1 00001 4 06760 TXI CV5,4,1
06714 1 77777 4 06743 PT3 TXI CV3,4,-1 COUNT DECIMAL PLACES
06715 0502 00 0 07011 EX1 CLS EXS INVERT SWITCH TO SIGNAL EXPONENT
06716 0601 00 0 07011 STO EXS
06717 -0500 00 0 06673 CAL EX2 SET UP EXPONENT CONVERSION
06720 0621 00 0 06751 BN3 STA CV7 STORE CONVERSION
06721 0621 00 0 06753 STA CV8 ADDRESS
06722 0621 00 0 06757 STA CV9
06723 -0500 00 0 06714 CAL PT3 INITIAL CONVERSION
06724 0621 00 0 06760 STA CV5 WITHOUT DECIMAL COUNT
06725 0621 00 0 06763 STA CV6
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 73
06726 -0500 00 0 06753 PL1 CAL CV8
06727 0622 00 0 06755 MN3 STD CV10
06730 0140 00 0 06760 TOV CV5
TD 06731 -3 00000 0 06760 TXL CV5
06732 0500 00 0 07033 BN1 CLA CM2 INVERT SWITCHES TO SIGNAL FIXED POINT
06733 0630 00 0 07033 STP CM2
06734 0630 00 0 07106 STP CM6
06735 -0500 00 0 06672 CAL BN2 SET UP B CONVERSION
TD 06736 -3 00000 0 06720 TXL BN3
06737 0500 00 0 00455 MN1 CLA PBIT START NEGATIVE ACCUMULATION WITH NEG. ZERO
06740 0601 60 0 06751 STO* CV7
06741 -0500 00 0 06742 CAL MN2 OP CODE TO MAKE CVIO A SUB INSTRUCTION
06742 -3 40200 0 06727 MN2 TXL MN3,0,258*64
06743 -0754 00 0 06714 CV3 PXD PT3,0
06744 -0763 00 0 00006 LGL 6
06745 0340 00 0 00402 CAS TEN TEST FOR DIGIT
TD 06746 -3 00000 0 06765 TXL CM
TD 06747 -3 00000 0 07007 TXL CV2
06750 0602 00 0 77664 SLW CH PERFORM CODED
06751 0500 00 0 77666 CV7 CLA N MULTIPLICATION
06752 0767 00 0 00002 ALS 2 BY TEN AND ADD
06753 0400 00 0 77666 CV8 ADD N
06754 0767 00 0 00001 ALS 1
06755 0400 00 0 77664 CV10 ADD CH
06756 0140 00 0 06764 TOV OVF TEST FOR OVERFLOW
06757 0601 00 0 77666 CV9 STO N
06760 2 00001 1 06743 CV5 TIX CV3,1,1 COUNT CHARACTERS
06761 1 77777 2 06762 TXI CV4,2,-1 OBTAIN NEXT BCD
06762 0560 00 2 00000 CV4 LDQ 0,2 WORD AND RESTORE
06763 1 00005 1 06743 CV6 TXI CV3,1,5 CHARACTER COUNT
06764 1 00001 4 06760 OVF TXI CV5,4,1 COUNT DECIMAL OVERFLOWS
06765 0340 00 0 00423 CM CAS MINUS
TD 06766 -3 00000 0 07007 SW1 TXL CV2
TD 06767 -3 00000 0 06737 TXL MN1
06770 0340 00 0 00422 CAS POINT
TD 06771 -3 00000 0 07007 TXL CV2
TD 06772 -3 00000 0 06706 TXL PT1
06773 0340 00 0 00410 CAS E
TD 06774 -3 00000 0 07007 TXL CV2
TD 06775 -3 00000 0 06715 TXL EX1
06776 0340 00 0 00421 CAS B
TD 06777 -3 00000 0 07007 TXL CV2
TD 07000 -3 00000 0 06732 TXL BN1
07001 0340 00 0 00420 CAS PLUS
TD 07002 -3 00000 0 07007 TXL CV2
TD 07003 -3 00000 0 06726 TXL PL1
07004 0340 00 0 00416 CAS DASH DASH TREATED LINK MINUS
07005 0020 00 0 07007 TRA CV2
07006 0020 00 0 06737 TRA MN1
07007 0500 00 0 77666 CV2 CLA N
07010 0100 00 0 07161 TZE STZ SEE IF ZERO FIXED OR FLOATING
TD 07011 -3 00000 0 07020 EXS TXL CX3 SWITCH - TXH INDICATES EXPONENT
07012 -0500 00 0 00455 CAL PBIT PREPARE TRUE
07013 0400 00 0 77663 ADD EXPN DECIMAL EXPONENT
07014 0767 00 0 00022 ALS 18
07015 0622 00 0 07017 STD CM4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 74
07016 0500 00 0 77666 CLA N
07017 1 00000 4 07036 CM4 TXI CM5,4,0
TD 07020 -3 00000 0 07033 CX3 TXL CM2 SWITCH - TXH INDICATE OCTAL
SCALE OCTAL NUMBER
07021 0500 00 0 77662 CLA BN MULTIPLY SCALE FACTOR BY 3
07022 0767 00 0 00001 ALS 1 FOR NUMBER OF SHFITS NEEDED
07023 0400 00 0 77662 ADD BN
07024 0621 00 0 07026 STA CX5
07025 0500 00 0 77666 CLA N
07026 0767 00 0 00000 CX5 ALS **
07027 -0760 00 0 00001 PBT ALLOW FOR P BIT
07030 0020 00 0 07126 TRA ISTOR
07031 -0760 00 0 00003 SSM
07032 0020 00 0 07126 TRA ISTOR
TD 07033 -3 00000 0 07035 CM2 TXL CM3 SWITCH - INVERTED TO TXH INDICATES FIXED POINT
TD 07034 -3 00000 0 07036 TXL CM5
TD 07035 -3 00000 0 07126 CM3 TXL ISTOR SWITCH - TXH INDICATES POINT
07036 0621 00 0 07243 CM5 STA FL1 35 BIT INTEGER
07037 0771 00 0 00017 ARS 15
07040 -0501 00 0 07244 ORA FL2
07041 0300 00 0 07244 FAD FL2
07042 0120 00 0 07045 TPL CMF1
07043 0302 00 0 07243 FSB FL1
TD 07044 -3 00000 0 07046 TXL CMF2
07045 0300 00 0 07243 CMF1 FAD FL1
07046 -0600 00 0 77670 CMF2 STQ RESID
07047 -3 00000 4 07106 TXL CM6,4,0
07050 3 00046 4 07071 SW2 TXH CM7,4,38 TEST FOR NEGATIVE EXP
07051 0634 00 4 07052 SXA *+1,4 COMPUTE ABSOLUTE VALUE OF EXPONENT
07052 -0774 00 4 00000 AXC **,4
07053 0601 00 0 77667 STO DATUM
07054 0560 00 4 07244 LDQ ONE,4 COMPUTE FLOATING
07055 0260 00 0 77667 FMP DATUM BINARY REPRESENTATION
07056 0601 00 0 77665 STO T OF INTEGER TIMES THE
07057 -0600 00 0 77666 STQ T+1 POWER OF TEN GIVEN
07060 0560 00 4 07244 LDQ ONE,4 BY THE TRUE EXPONENT
07061 0260 00 0 77670 FMP RESID
07062 0300 00 0 77666 FAD T+1
07063 0300 00 0 77665 FAD T
07064 0361 00 0 07241 ACL EXC1
07065 -0760 00 0 00001 PBT
TD 07066 -3 00000 0 07106 TXL CM6
07067 -0754 00 0 00000 CM8 PXD ,0
07070 0020 00 0 07155 TRA PX1 NUMBER OUT OF RANGE, EXIT WITH 0 IN AC
07071 -3 77717 4 07067 CM7 TXL CM8,4,-49 TEST FOR ILLEGAL EXP
07072 0161 00 0 07073 CM13 TQO CM13+1
07073 0241 00 4 07244 FDP ONE,4 COMPUTE FLOATING
07074 -0600 00 0 77665 STQ T BINARY EQUIVALENT
07075 0300 00 0 77670 FAD RESID OF INTEGER TIMES
07076 0241 00 4 07244 FDP ONE,4 POWER OF TEN GIVEN
07077 0161 00 0 07067 TQO CM8
07100 -0600 00 0 77666 STQ T+1 BY TRUE EXPONENT
07101 0500 00 0 77666 CLA T+1
07102 0300 00 0 77665 FAD T
07103 0361 00 0 07242 ACL EXC2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 75
07104 -0760 00 0 00001 PBT
TD 07105 -3 00000 0 07067 TXL CM8
TD 07106 -3 00000 0 07131 CM6 TXL FSTOR SWITCH - TXH INDICATES FIXED POINT
07107 0601 00 0 77665 STO T
07110 0767 00 0 00002 ALS 2
07111 -0760 00 0 00003 SSM DETERMINE SHIFT
07112 0771 00 0 00035 ARS 29 NECESSARY TO POSITION
07113 0400 00 0 00415 ADD Q128 NUMBER AS INDICATED
07114 0400 00 0 77662 ADD BN BY B
07115 0120 00 0 07117 TPL SHIFT
07116 -0100 00 0 07067 TNZ CM8
07117 0621 00 0 07125 SHIFT STA CM12
07120 0500 00 0 77665 CLA T REMOVE CHARACTERISTICS
07121 0763 00 0 00010 LLS 8 FROM FLOATING NUMBER
07122 0767 00 0 00002 ALS 2
07123 0771 00 0 00012 ARS 10
07124 0763 00 0 00010 LLS 8
07125 0765 00 0 00000 CM12 LRS **
07126 0131 00 0 00000 ISTOR XCA RESULT TO MQ
07127 -0500 00 0 06766 ISTO1 CAL SW1 SET FIXED POINT INDICATOR SWITCH
07130 0020 00 0 07133 TRA XT3
07131 0131 00 0 00000 FSTOR XCA RESULT TO MQ
07132 0500 00 0 06766 CLA SW1 SET FLOAT INDICATOR SWITCH
07133 0630 00 0 07153 XT3 STP XT1
07134 2 00001 1 07137 TIX XT2,1,1 IF NO SIGNIFICANT CHARACTERS
07135 1 77777 2 07136 TXI *+1,2,-1 LEFT IN WORD, MOVE TO NEXT WORD
07136 0774 00 1 00006 AXT 6,1
07137 -0754 00 1 00000 XT2 PXD ,1 SET POSITION INDICATORS
07140 0402 00 0 00446 SUB QD7
07141 0602 00 0 77665 SLW T
07142 -0500 00 0 07020 CAL CX3 P BIT IN OUTPUT INDICATES OCTAL
07143 -0320 00 0 00455 ANA $SBIT
07144 -0602 00 0 77665 ORS T
07145 0760 00 0 00006 COM
07146 0630 00 0 77665 STP T
07147 0634 00 2 07150 SXA *+1,2
07150 -0774 00 2 00000 AXC **,2
07151 0754 00 2 00000 PXA ,2
07152 0361 00 0 77665 ACL T
TD 07153 -3 00000 0 07155 XT1 TXL *+2 SET SIGN + FOR FIXED.
07154 -0760 00 0 00003 SSM - FOR FLOATING
07155 0774 00 1 00000 PX1 AXT ,1 RESTORE INDEX REGISTERS
07156 0774 00 2 00000 PX2 AXT ,2
07157 0774 00 4 00000 PX4 AXT ,4
07160 0020 00 4 00001 TRA 1,4 EXIT
WE GET HERE IF NUMBER IS ZERO.
WE HERE DECIDE WHETHER WE ARE FACED WITH A FIXED OR FLOATING
ZERO.
07161 0560 00 0 07033 STZ LDQ CM2 TXH (+) IF B
07162 0162 00 0 07126 TQP ISTOR
07163 0560 00 0 07035 LDQ CM3 TXH (+) IF DECIMAL POINT FOUND
07164 0162 00 0 07131 TQP FSTOR
07165 0560 00 0 07011 LDQ EXS TXH (+) IF E FOUND
07166 0162 00 0 07131 TQP FSTOR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 76
07167 0020 00 0 07126 TRA ISTOR
PROCESS OCTAL NUMBER
07170 0535 00 2 77665 OCTNO LAC T,2 IR2 HAS WORD COUNT
07171 -0535 00 1 77665 LDC T,1 IR1 WILL GET CHARACTER COUNT
07172 0560 00 0 77662 LDQ MQ RESTORE FIRST GROUP OF CHARACTERS
07173 -0754 00 0 00000 PXD ,0
07174 0621 00 0 06751 STA CV7 SET SIGNAL FOR OCTAL NUMBER
07175 1 00010 1 07203 TXI OCT9,1,8 FIX CHARACTER COUNT
07176 -0754 00 0 00000 OCT1 PXD ,0
07177 -0763 00 0 00003 LGL 3
07200 -0100 00 0 07211 TNZ OCT8
07201 0500 00 0 77666 CLA N
07202 -0763 00 0 00003 LGL 3
07203 0601 00 0 77666 OCT9 STO N ALLOW FOR BOTH P BIT AND MINUS SIGN
07204 -0602 00 0 77666 ORS N
07205 2 00001 1 07176 OCT6 TIX OCT1,1,1
07206 1 77777 2 07207 TXI OCT2,2,-1
07207 0560 00 2 00000 OCT2 LDQ 0,2 NEW PACKED WORD
07210 1 00005 1 07176 TXI OCT1,1,5
07211 -0763 00 0 00003 OCT8 LGL 3
07212 0340 00 0 00426 CAS Q TEST FOR OCTAL SCALE FACTOR
07213 0020 00 0 07226 TRA OCT3
07214 0020 00 0 07232 TRA OCT10
07215 0340 00 0 00423 CAS MINUS
TD 07216 -3 00000 0 07226 TXL OCT3
TD 07217 -3 00000 0 07230 TXL OCT5
07220 0340 00 0 00420 CAS PLUS
TD 07221 -3 00000 0 07226 TXL OCT3
TD 07222 -3 00000 0 07205 TXL OCT6
07223 0340 00 0 00416 CAS DASH DASH TREATED LINK -
TD 07224 -3 00000 0 07226 TXL OCT3
TD 07225 -3 00000 0 07230 TXL OCT5
07226 0560 00 0 77666 OCT3 LDQ N
TD 07227 1 00000 0 07127 TXI ISTO1
07230 0500 00 0 00455 OCT5 CLA PBIT SET NEGATIVE SIGN
TD 07231 -3 00000 0 07203 TXL OCT9
07232 0500 00 0 07020 OCT10 CLA CX3 SET SWITCH FOR OCTAL SCALE FACTOR
07233 0630 00 0 07020 STP CX3
07234 0600 00 0 77662 STZ BN CLEAR SCALE FACTOR CELL
07235 -0500 00 0 06766 CAL SW1 SET EXPONENT SWITCH TO OFF
07236 0630 00 0 07011 STP EXS
07237 -0500 00 0 06672 CAL BN2 SET UP Q CONVERSION
07240 0020 00 0 06720 TRA BN3
00400 Q8 SYN $Q8
00402 Q10 SYN $Q10
00415 Q128 SYN $Q128
00446 QD7 SYN $QD7
00455 PBIT SYN $SBIT
00427 BLANK SYN $QO60
00423 MINUS SYN $QO40
00422 POINT SYN $QO33
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 77
00410 E SYN $QO25
00421 B SYN $QO22
00426 Q SYN $QO50
00420 PLUS SYN $QO20
00416 DASH SYN $QO14
07241 +043000000000 EXC1 DEC 35B8 CHARACTERISTIC=35
07242 +335000000000 EXC2 DEC 221B8 CHAR.=COMPL. 35
07243 +233000000000 FL1 DEC 155B8
07244 +252000000000 FL2 DEC 170B8
07245 +141500000000 OCT 141500000000,144620000000,147764000000,153470400000
07246 +144620000000
07247 +147764000000
07250 +153470400000
07251 +156606500000 OCT 156606500000,161750220000,165461132000,170575360400
07252 +161750220000
07253 +165461132000
07254 +170575360400
07255 +173734654500 OCT 173734654500,177452013710,202564416672,205721522451
07256 +177452013710
07257 +202564416672
07260 +205721522451
07261 +211443023471 OCT 211443023471,214553630410,217706576512,223434157116
07262 +214553630410
07263 +217706576512
07264 +223434157116
07265 +226543212741 OCT 226543212741,231674055532,235425434430,240532743536
07266 +231674055532
07267 +235425434430
07270 +240532743536
07271 +243661534466 OCT 243661534466,247417031702,252522640262,255647410336
07272 +247417031702
07273 +252522640262
07274 +255647410336
07275 +261410545213 OCT 261410545213,264512676456,267635456171,273402374714
07276 +264512676456
07277 +267635456171
07300 +273402374714
07301 +276503074077 OCT 276503074077,301623713116,304770675742,310473426555
07302 +301623713116
07303 +304770675742
07304 +310473426555
07305 +313612334311 OCT 313612334311,316755023373,322464114135,325601137164
07306 +316755023373
07307 +322464114135
07310 +325601137164
07311 +330741367021 OCT 330741367021,334454732313,337570120775,342726145174
07312 +334454732313
07313 +337570120775
07314 +342726145174
07315 +346445677216 OCT 346445677216,351557257061,354713132676,360436770626
07316 +351557257061
07317 +354713132676
07320 +360436770626
07321 +363546566774 OCT 363546566774,366700324573,372430204755,375536246150
07322 +366700324573
07323 +372430204755
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 78
07324 +375536246150
00402 TEN SYN Q10
07244 ONE SYN FL2
07325 REORG BSS 0
77662 ORG COMMON
77662 BN BSS 1
77662 MQ SYN BN
77663 EXPN BSS 1
77664 CH BSS 1
77665 CHD BSS 1
77665 T SYN CHD
77666 N BSS 1
77667 DATUM BSS 1
77670 RESID BSS 1
07325 ORG REORG RESTORE ORIGIN
07325 BUFFER BSS 14
R HED
FUNCTION CP1
CP1(L)=(L=0 YIELDS 0.
OTHERWISE CONS(CONSW(CWR(CAR(L)))),CP1(CDR(L))))
C HED
07343 0100 00 4 00001 CP1 TZE 1,4
07344 -0634 00 4 03361 SXD CR1,4
07345 -0734 00 4 00000 PDX ,4
07346 0500 00 4 00000 CLA ,4 CWR(L)
07347 0601 00 0 03363 STO CWRL
07350 0734 00 4 00000 PAX ,4 CAR(L)
07351 0500 00 4 00000 CLA ,4 CWR(CAR(L))
07352 0074 00 4 03710 TSX $CONSW,4
07353 0074 00 4 02312 TSX $SAVE,4
07354 -3 03364 0 02377 TXL $END2,,CR2+2 SAVE 2 ITEMS
07355 0601 00 0 03362 STO CR2
07356 -0534 00 4 03363 LXD CWRL,4 CDR(L)
07357 -0754 00 4 00000 PXD ,4 IN DEC
07360 0074 00 4 07343 TSX CP1,4
07361 0601 00 0 03363 STO CWRL
07362 0560 00 0 03363 LDQ CWRL C(MQ)=CP1(CDR(L))
07363 0500 00 0 03362 CLA CR2
07364 0074 00 4 02326 TSX UNSAVE,4
07365 -0534 00 4 03361 LXD CR1,4
07366 0020 00 0 03730 TRA $CONS
SUBST
SUBST(L,V,M) =
(M = 0 YIELDS 0,
EQUAL(M,V) YIELDS COPY(L),
CAR(M)=-1 YIELDS M
1 YIELDS CONS(SUBST(L,V,CAR(M)),SUBSTL,V,CDR(M))))
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 79
R HED
07367 0601 00 0 03475 SUBST STO SX
07370 -0600 00 0 03476 STQ SY
07371 0500 00 0 03321 CLA $ARG3
07372 -0634 00 4 03473 SUB1 SXD SXT,4
07373 0601 00 0 03477 STO ST
07374 0560 00 0 03476 LDQ SY
07375 0074 00 4 04461 TSX $EQUAL,4
07376 -0100 00 0 07443 TNZ SUB4
07377 -0534 00 4 03477 LXD ST,4
07400 0500 00 4 00000 CLA 0,4
07401 0734 00 4 00000 PAX 0,4
07402 0500 00 0 03477 CLA ST
07403 3 77776 4 07441 TXH SUB2,4,-2
07404 0074 00 4 02312 TSX $SAVE,4
07405 -3 03476 0 02377 TXL $END2,,SZ+2
07406 0622 00 0 03474 STD SZ
07407 -0734 00 4 00000 PDX 0,4
07410 0500 00 4 00000 CLA 0,4
07411 -0734 00 4 00000 PDX 0,4
07412 0634 00 4 03474 SXA SZ,4
07413 0734 00 4 00000 PAX 0,4
07414 -0754 00 4 00000 PXD 0,4
07415 0074 00 4 07372 TSX SUB1,4
07416 0534 00 4 03474 LXA SZ,4
07417 0771 00 0 00022 ARS 18
07420 0621 00 0 03474 STA SZ
07421 -0754 00 4 00000 PXD 0,4
07422 0074 00 4 07372 TSX SUB1,4
07423 -0534 00 4 03474 LXD SZ,4
07424 0622 00 0 03474 STD SZ
07425 0500 00 4 00000 CLA 0,4
07426 0402 00 0 03474 SUB SZ
07427 0100 00 0 07437 TZE SUB3
07430 -0534 00 4 03751 LXD $FREE,4
07431 3 00000 4 07433 TXH *+2,4,0
07432 0074 00 4 04037 TSX $FROUT,4
07433 0500 00 4 00000 CLA 0,4
07434 0622 00 0 03751 STD $FREE
07435 0500 00 0 03474 CLA SZ
07436 0601 00 4 00000 STO 0,4
07437 -0754 00 4 00000 SUB3 PXD 0,4
07440 0074 00 4 02326 TSX UNSAVE,4
07441 -0534 00 4 03473 SUB2 LXD SXT,4
07442 0020 00 4 00001 TRA 1,4
07443 0500 00 0 03475 SUB4 CLA SX
07444 0020 00 0 07441 TRA SUB2
B HED
FUNCTION SUBLIS
07445 -0600 00 0 03472 SUBLIS STQ E
07446 -0100 00 0 07451 TNZ SU1
07447 0500 00 0 03472 CLA E P=0
07450 0020 00 4 00001 TRA 1,4
07451 0601 00 0 03471 SU1 STO P
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 80
07452 0500 00 0 03472 CLA E
07453 -0100 00 0 07455 TNZ SU2
07454 0020 00 4 00001 TRA 1,4 E=0
07455 -0634 00 4 03464 SU2 SXD X1,4
07456 0500 00 0 07465 CLA F U
07457 0601 00 0 03322 STO $ARG4 U
07460 0500 00 0 07466 CLA F+1 F
07461 0601 00 0 03321 STO $ARG3 F
07462 0560 00 0 07467 LDQ F+2 P
07463 0500 00 0 03471 CLA P
07464 0020 00 0 04400 TRA SEARCH
07465 -3 00000 0 07470 F TXL NF,,0 U
07466 -3 00000 0 07535 TXL NF1,,0 F
07467 -3 00000 0 07520 TXL NF2,,0 P
07470 -0534 00 4 03472 NF LXD E,4 U
07471 0500 00 4 00000 CLA ,4
07472 0734 00 4 00000 PAX ,4 CAR(E)
07473 -3 77776 4 07477 TXL SU3,4,-2 E IS NOT AN OBJECT
07474 0500 00 0 03472 CLA E
07475 -0534 00 4 03464 LXD X1,4
07476 0020 00 4 00001 TRA 1,4
07477 0074 00 4 02312 SU3 TSX $SAVE,4
07500 -3 03471 0 02373 TXL $END4,,X4+2 SAVE 4 ITEMS
07501 0622 00 0 03465 STD X2
07502 0734 00 4 00000 PAX ,4
07503 -0634 00 4 03466 SXD X3,4 CAR(E)
07504 0560 00 0 03465 LDQ X2
07505 0500 00 0 03471 CLA P
07506 0074 00 4 07445 TSX SUBLIS,4
07507 0601 00 0 03467 STO X4 SUBLIS(P,CDR(E))
07510 0560 00 0 03466 LDQ X3
07511 0500 00 0 03471 CLA P
07512 0074 00 4 07445 TSX SUBLIS,4
07513 0560 00 0 03467 LDQ X4
07514 0074 00 4 03730 TSX $CONS,4
07515 0074 00 4 02326 TSX UNSAVE,4
07516 -0534 00 4 03464 LXD X1,4
07517 0020 00 4 00001 TRA 1,4
07520 -0634 00 4 07537 NF2 SXD N1,4 EQUAL(E,CAAR(J))
07521 -0734 00 4 00000 PDX ,4 J
07522 0500 00 4 00000 CLA ,4
07523 0734 00 4 00000 PAX ,4 CAR(J)
07524 0500 00 4 00000 CLA ,4
07525 0622 00 0 03470 STD X5 CDAR(J)
07526 0734 00 4 00000 PAX ,4
07527 -0634 00 4 07540 SXD N2,4
07530 0560 00 0 07540 LDQ N2 CAAR(J) IN MQ
07531 0500 00 0 03472 CLA E
07532 0074 00 4 04461 TSX $EQUAL,4
07533 -0534 00 4 07537 LXD N1,4
07534 0020 00 4 00001 TRA 1,4
07535 0500 00 0 03470 NF1 CLA X5
07536 0020 00 4 00001 TRA 1,4
07537 0 00000 0 00000 N1 IR4 OF P OF SEARCH
07540 0 00000 0 00000 N2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 81
APPEND(L1,L2)=
(L1=0 YIELDS L2,1 YIELDS CONS(CAR(L1),APPEND(CDR(L1),L2))
A HED
07541 -0100 00 0 07544 APPEND TNZ APNP1
07542 0131 00 0 00000 XCA
07543 0020 00 4 00001 TRA 1,4
07544 -0634 00 4 03346 APNP1 SXD AS1,4
07545 0074 00 4 02312 TSX $SAVE,4
07546 -3 03351 0 02377 TXL $END2,,CWR1+2 SAVE 2 ITEMS
07547 -0734 00 4 00000 PDX 0,4
07550 0500 00 4 00000 CLA 0,4
07551 0601 00 0 03347 STO CWR1
07552 -0320 00 0 00460 ANA DECM
07553 0074 00 4 07541 TSX APPEND,4
07554 0131 00 0 00000 XCA
07555 0534 00 4 03347 LXA CWR1,4
07556 -0754 00 4 00000 PXD 0,4
07557 0074 00 4 02326 TSX UNSAVE,4
07560 -0534 00 4 03346 LXD AS1,4
07561 0020 00 0 03730 TRA $CONS
00460 DECM SYN $DMASK
PAIR
* RECODED TO MAKE LISTS IN DOT NOTATION
A HED
07562 0634 00 4 07570 PAIR SXA PAIRX,4 SAVE LINK IR
07563 -0600 00 0 03441 STQ LIS ARG 2
07564 0560 00 0 07572 LDQ FARG PICK UP FUNCTIONAL ARGUMENT
07565 0074 00 4 04214 TSX MAPLIS,4 LET MAPLIST DO THE CONSING
07566 0520 00 0 03441 ZET LIS TEST FOR ARG 2 GONE TO END
07567 0020 00 0 07612 TRA PERF DID NOT, GO TO ERROR
07570 0774 00 4 00000 PAIRX AXT **,4 RESTORE LINK IR
07571 0020 00 4 00001 TRA 1,4 EXIT
*
07572 -3 00001 0 07573 FARG TXL *+1,,1 PAIR FUNCTIONAL ARGUMENT FOR MAPLIST
07573 0634 00 4 07610 SXA FARGX,4 SAVE LINK IR
07574 0622 00 0 03440 STD TEM SAVE ARGUMENT
07575 -0534 00 4 03441 LXD LIS,4 PICK UP 2ND ARG LIST
07576 -3 00000 4 07615 TXL PERS,4,0 GO IF NO MORE 2ND ARG
07577 0500 00 4 00000 CLA 0,4 NEXT WORD
07600 0734 00 4 00000 PAX 0,4 CAR
07601 0622 00 0 03441 STD LIS SAVE CDR
07602 -0754 00 4 00000 PXD 0,4 CAR INTO DECREMENT
07603 0131 00 0 00000 XCA INTO MQ
07604 -0534 00 4 03440 LXD TEM,4 LIST 1
07605 0500 00 4 00000 CLA 0,4 TAKE CAR OF LIST
07606 0734 00 4 00000 PAX 0,4
07607 -0754 00 4 00000 PXD 0,4
07610 0774 00 4 00000 FARGX AXT **,4 RESTORE LINK IR
07611 0020 00 0 03730 TRA $CONS
* FIRST ARG LIST TOO SHORT ERROR
07612 -0634 00 4 01562 PERF SXD $ERROR,4 SAVE LINK IR
07613 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
07614 542660600254 BCI 1,*F 2* FIRST ARG$ LIST TOO SHORT
* ERROR, SECOND ARG LIST TOO SHORT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 82
07615 -0634 00 4 01562 PERS SXD $ERROR,4 SAVE LINK IR
07616 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
07617 542660600354 BCI 1,*F 3* SECOND ARG. LIST TOO SHORT
*
*
*
MAPCAR(L,F) = (L=0 YIELDS 0,
F(L) YIELDS 0,
1 YIELDS MAPAR(CDR(L),F))
D HED
07620 0100 00 4 00001 MAPCAR TZE 1,4
07621 -0634 00 4 03421 SXD RET,4
07622 0074 00 4 02312 TSX $SAVE,4
07623 -3 03425 0 02375 TXL $END3,,F+2 SAVE 3 ITEMS
07624 -0600 00 0 03423 STQ F
07625 0601 00 0 03422 MCPR STO L
07626 -0534 00 4 03423 LXD F,4
07627 3 00012 4 07632 TXH *+3,4,10
07630 0074 00 4 03423 TSX F,4
07631 0020 00 0 07635 TRA *+4
07632 -0634 00 4 07634 SXD *+2,4
07633 0074 00 4 12007 TSX COMPAT,4
07634 0 00000 0 00001 1,,**
07635 -0534 00 4 03422 LXD L,4
07636 0500 00 4 00000 CLA 0,4
07637 -0734 00 4 00000 PDX ,4
07640 -0754 00 4 00000 PXD ,4
07641 -0100 00 0 07625 TNZ MCPR
07642 0074 00 4 02326 RTRN TSX UNSAVE,4
07643 -0534 00 4 03421 LXD RET,4
07644 0020 00 4 00001 TRA 1,4
MAPCON(L,F)=
(L=0 YIELDS 0,,1 YIELDS NCONC(F(L),MAPCON(CDR(L),F)))
R HED
07645 0100 00 4 00001 MAPCON TZE 1,4
07646 -0634 00 4 03424 SXD MCN5,4
07647 0074 00 4 02312 TSX $SAVE,4
07650 -3 03431 0 02373 TXL $END4,,MCN2+2 SAVE 4 ITEMS
07651 0601 00 0 03426 STO MCN3
07652 -0600 00 0 03425 STQ MCN4
07653 -0534 00 4 03425 LXD MCN4,4
07654 3 00012 4 07657 TXH *+3,4,10
07655 0074 00 4 03425 TSX MCN4,4
07656 0020 00 0 07662 TRA *+4
07657 -0634 00 4 07661 SXD *+2,4
07660 0074 00 4 12007 TSX COMPAT,4
07661 0 00000 0 00001 1,,**
07662 0601 00 0 03427 STO MCN2
07663 -0534 00 4 03426 LXD MCN3,4
07664 0500 00 4 00000 CLA 0,4
07665 -0320 00 0 00460 ANA MCDM
07666 0560 00 0 03425 LDQ MCN4
07667 0074 00 4 07645 TSX MAPCON,4
07670 0131 00 0 00000 XCA
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 83
07671 0500 00 0 03427 CLA MCN2
07672 0074 00 4 02326 TSX UNSAVE,4
07673 -0534 00 4 03424 LXD MCN5,4
07674 0020 00 0 07675 TRA $NCONC
00460 MCDM SYN $DMASK
FUNCTION NCONC
/ L1=0 YIELDS RETURN(L2)
M=L1
A2 CDR(M)=0 YIELDS GO A1
M=CDR(M)
GO A2
A1 CDR(M)=L2
// RETURN(L1)
R HED
07675 -0100 00 0 07700 NCONC TNZ NCI1
07676 0131 00 0 00000 XCA
07677 0020 00 4 00001 TRA 1,4
07700 0634 00 4 07711 NCI1 SXA NCS1,4 SAVE LINK IR
07701 0601 00 0 07713 STO NCS3
07702 -0734 00 4 00000 NCI2 PDX 0,4
07703 0500 00 4 00000 CLA 0,4
07704 -0320 00 0 00460 ANA NCDM
07705 -0100 00 0 07702 TNZ NCI2
07706 0131 00 0 00000 XCA
07707 0622 00 4 00000 STD 0,4
07710 0500 00 0 07713 CLA NCS3
07711 0774 00 4 00000 NCS1 AXT **,4 RESTORE LINK IR
07712 0020 00 4 00001 TRA 1,4
00460 NCDM SYN $DMASK
07713 0 00000 0 00000 NCS3
REMPRP REMOVES THE PROPERTY GIVEN BY THE MQ FROM THE
OBJECT GIVEN BY THE AC
07714 -0634 00 4 07744 REMPRP SXD RMPRX,4
07715 -0600 00 0 03320 STQ $ARG2
07716 -0534 00 4 03320 LXD $ARG2,4
07717 -0634 00 4 07732 SXD RMPRT+1,4
07720 1 77777 4 07721 TXI *+1,4,-1
07721 -0634 00 4 07731 SXD RMPRT,4
07722 -0734 00 4 00000 PDX 0,4
07723 0020 00 0 07726 TRA RMPR2
07724 0500 00 0 03320 RMPR1 CLA $ARG2
07725 0601 00 0 03321 STO $ARG3
07726 -0634 00 4 03320 RMPR2 SXD $ARG2,4
07727 0500 00 4 00000 CLA 0,4
07730 0734 00 4 00000 PAX 0,4
07731 -3 00000 4 07733 RMPRT TXL *+2,4,**
07732 -3 00000 4 07737 TXL RMPRE,4,**
07733 -0734 00 4 00000 PDX 0,4
07734 3 00000 4 07724 TXH RMPR1,4,0
07735 -0534 00 4 07744 RMPRO LXD RMPRX,4
07736 0020 00 4 00001 TRA 1,4
07737 -0734 00 4 00000 RMPRE PDX 0,4
07740 0500 00 4 00000 CLA 0,4
07741 -0534 00 4 03321 LXD $ARG3,4
07742 0622 00 4 00000 STD 0,4
07743 0020 00 0 07726 TRA RMPR2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 84
07744 0 00000 0 00000 RMPRX
PRINAR
USES WOT AND PRINT
CALLING SEQ IS..
TSX PRINAR,4
NOARG
BCDZ NAME OF FUN
(RETURN)
ARGUMENTS NOT ACCEPTABLE TO PRINT WILL CAUSE ERRORS
* HAS BEEN CRIPPLED TO PRINT ONLY FIRST 2 ARGUMENTS
P HED
07745 0634 00 4 07774 PRINAR SXA PAS1,4 SAVE INDEX REGISTERS
07746 0634 00 2 07775 SXA PAS2,2
07747 0601 00 0 03442 STO PAS3
07750 -0600 00 0 03443 STQ PAS4
07751 0500 00 4 00002 CLA 2,4
07752 0601 00 0 10001 STO PAL1
07753 0500 00 4 00003 CLA 3,4
07754 0601 00 0 10002 STO PAL2
07755 0500 00 4 00001 CLA 1,4
07756 0734 00 2 00000 PAX 0,2
07757 0074 00 4 01222 TSX OUTPUT,4
07760 0 00000 0 00364 BCDOUT
07761 0 00011 0 07777 PAL3,,PAL4-PAL3
07762 0500 00 0 03442 CLA PAS3
07763 0074 00 4 04604 TSX $PRINT,4
07764 -2 00001 2 07767 TNX PAP3,2,1
07765 0500 00 0 03443 CLA PAS4
07766 0074 00 4 04604 PAP2 TSX $PRINT,4
07767 0074 00 4 01222 PAP3 TSX OUTPUT,4
07770 0 00000 0 00364 BCDOUT
07771 0 00001 0 10010 PAL5,,1
07772 0500 00 0 03442 CLA PAS3
07773 0560 00 0 03443 LDQ PAS4
07774 0774 00 4 00000 PAS1 AXT **,4 RESTORE INDEX REGISYERS
07775 0774 00 2 00000 PAS2 AXT **,2
07776 0020 00 4 00004 TRA 4,4
07777 006026644523 PAL3 BCD 20 FUNCTION
10000 633146456060
10001 0 00000 0 00000 PAL1
10002 0 00000 0 00000 PAL2
10003 603021626022 BCD 5 HAS BEEN ENTERED, ARGUMENTS..
10004 252545602545
10005 632551252473
10006 602151276444
10007 254563623333
10010 PAL4 BSS 0
10010 606060606060 PAL5 BCD 1
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 85
EJECT
PROP AND SASSOC
SPECIALIZED SEARCH ROUTINES WHICH SHARE STORAGE
R HED
PROP(O,P,U)
= (NULL(O) YIELDS U, CAR(O) = P YIELDS CDR(O),
T YIELDS PROP(CDR(O),P,U))
10011 0634 00 4 10065 PROP SXA SAST1,4 SAVE LINK IR
10012 0131 00 0 00000 XCA PROPERTY TO AC
10013 0622 00 0 10024 STD SASP1 SET TXH
10014 0402 00 0 00442 SUB SASQ1
10015 0622 00 0 10023 STD SASP2 SET TXL
10016 0131 00 0 00000 XCA OBJECT TO AC
10017 -0734 00 4 00000 SASL1 PDX 0,4 L = CDR(L)
INSERT TXH INSTRUCTION HERE IF NILL IS NADE NON-ZERO
10020 -3 00000 4 10030 TXL SASP3,4,0 NULL(L)
10021 0500 00 4 00000 CLA 0,4 CWR(L)
10022 0734 00 4 00000 PAX 0,4 CAR(L)
10023 -3 00000 4 10017 SASP2 TXL SASL1,4,**
10024 3 00000 4 10017 SASP1 TXH SASL1,4,**
10025 -0320 00 0 00460 ANA SASDM
10026 0534 00 4 10065 LXA SAST1,4 RESTORE LINK IR
10027 0020 00 4 00001 TRA 1,4
10030 -0754 00 0 00000 SASP3 PXD 0,0 CLEAR
10031 -0534 00 4 03321 LXD $ARG3,4 INSPECT FUNCTIONAL ARGUMENT
10032 3 00012 4 10035 TXH *+3,4,10 SKIP IF NOT A TXL
10033 0534 00 4 10065 LXA SAST1,4
10034 0020 00 0 03321 TRA $ARG3
10035 0600 00 0 03321 STZ $ARG3
10036 0560 00 0 03321 LDQ $ARG3
10037 -0754 00 4 00000 PXD ,4
10040 0534 00 4 10065 LXA SAST1,4 RESTORE LINK IR
10041 0020 00 0 14663 TRA $APPLY
SASSOC(O,A,U)
= (NULL(A) YIELDS U, CAAR(A) YIELDS CAR(A),
T YIELDS SASSOC(O,CDR(A),U))
10042 0634 00 4 10065 SASSOC SXA SAST1,4 SAVE LINK IR
10043 0634 00 2 10064 SXA SAST2,2 SAVE IR 2
10044 0634 00 1 10062 SXA SAST3,1 SAVE IR 1
10045 0622 00 0 10061 STD SASP7 SET TXH
10046 0402 00 0 00442 SUB SASQ1
10047 0622 00 0 10060 STD SASP6 SET TXH
10050 0131 00 0 00000 XCA PAIR LIST TO AC
10051 -0734 00 4 00000 PDX 0,4 TO INDEX 4
10052 -3 00000 4 10067 SASP5 TXL SASP4,4,0 NULL(A)
INSERT TXH INSTRUCTION HERE IF NILL IS NADE NON-ZERO
10053 0500 00 4 00000 CLA 0,4 CWR(A)
10054 -0734 00 4 00000 PDX ,4 CDR(A)
10055 0734 00 2 00000 PAX ,2 CAR(A)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 86
10056 0500 00 2 00000 CLA ,2
10057 0734 00 1 00000 PAX 0,1 CAAR(A) TO INDX REGISTER
10060 -3 00000 1 10052 SASP6 TXL SASP5,1,** LOOK FOR ITEM
10061 3 00000 1 10052 SASP7 TXH SASP5,1,**
10062 0774 00 1 00000 SAST3 AXT **,1 FOUND ITEM, RESTORE IR 1
10063 -0754 00 2 00000 PXD 0,2 POINTER TO WORD
10064 0774 00 2 00000 SAST2 AXT **,2 RESTORE IR 2
10065 0774 00 4 00000 SAST1 AXT **,4 RESTORE LINK IR
10066 0020 00 4 00001 TRA 1,4
10067 0534 00 2 10064 SASP4 LXA SAST2,2 RESTORE IR 2
10070 0534 00 1 10062 LXA SAST3,1 RESTORE IR 1
10071 0020 00 0 10030 TRA SASP3 EXECUTE SASSOC EXIT
00442 SASQ1 SYN $QD1
00460 SASDM SYN $DMASK
10072 0100 00 4 00001 SPREAD TZE 1,4 EXIT IF AGLIST IS NULL
10073 0634 00 4 10132 SXA SPRX,4 SAVE LINK IR
10074 -0734 00 4 00000 PDX 0,4 POINTER TO ARG LIST
10075 0500 00 4 00000 CLA 0,4 FIRST WORD
10076 0560 00 0 00370 LDQ $ZERO ZERO THE MQ
10077 -0765 00 0 00022 LGR 18 CAR TO CDR OF MQ
10100 0100 00 0 10131 TZE NLY GO IF A SINGLE ARGUMENT
10101 0734 00 4 00000 PAX 0,4 POINTER TO NEXT WORD
10102 0500 00 4 00000 CLA 0,4 NEXT WORD
10103 0734 00 4 00000 PAX 0,4 POINTER TO ARGUMENT
10104 -0320 00 0 00460 ANA $DMASK MASK OUT ALL BUT DECREMENT
10105 0100 00 0 10130 TZE TWA GO IF 2 ARGUMENT
10106 -0634 00 4 03320 SXD $ARG2,4 PUT AWAY
10107 0634 00 2 10126 SXA SPRY,2 SAVE INDEX 1 AND 2
10110 0634 00 1 10125 SXA SPRZ,1
10111 0774 00 1 00022 AXT 18,1 20 IS MAX NO OF ARGS
10112 -0734 00 4 00000 PDX 0,4 REST OF ARG LIST TO IR 4
10113 -3 00000 4 10125 SPP1 TXL SPRZ,4,0 GO IF END OF LIST
10114 0500 00 4 00000 CLA ,4
10115 -0734 00 4 00000 PDX ,4
10116 0734 00 2 00000 PAX ,2
10117 -0754 00 2 00000 PXD ,2
10120 0601 00 1 03343 STO $ARG20+1,1
10121 2 00001 1 10113 TIX SPP1,1,1
10122 -0634 00 4 01562 SPPERR SXD $ERROR,4
10123 0074 00 4 01563 TSX $ERROR+1,4
10124 542160600754 BCI 1,*A 7* TOO MANY ARGUMENTS---SPREAD*()
10125 0774 00 1 00000 SPRZ AXT **,1 RESTORE IR 1
10126 0774 00 2 00000 SPRY AXT **,2 DITTO IR 2
10127 -0534 00 4 03320 LXD $ARG2,4 ARG 2
10130 -0754 00 4 00000 TWA PXD 0,4 PUT IN DECREMENT AC
10131 0131 00 0 00000 NLY XCA ARG 1 AND 2 TO RIGHT REGISTERS
10132 0774 00 4 00000 SPRX AXT **,4 RESTORE LINK IR
10133 0020 00 4 00001 TRA 1,4 EXIT
FUNCTION ATTRIB(O,L)
ATTRIB(O,L)=/ CDR(O)=0 YIELDS (L REPLACES CDR(O))
ELSE ATTRIB(CDR(O),L) /
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 87
R HED
10134 0634 00 4 10146 ATTRIB SXA AT1,4
10135 -0100 00 0 10140 TNZ ATRB GO IF BEGINNING OF LIST
10136 0131 00 0 00000 XCA OTHERWISE EXIT WITH ARG 2
10137 0020 00 4 00001 TRA 1,4
10140 -0734 00 4 00000 ATRB PDX ,4 O
10141 0500 00 4 00000 CLA ,4
10142 -0320 00 0 00460 ANA DMASK CDR(O)
10143 -0100 00 0 10140 TNZ ATRB
10144 0131 00 0 00000 XCA ARG 2 TO AC
10145 0622 00 4 00000 STD ,4
10146 0774 00 4 00000 AT1 AXT **,4
10147 0020 00 4 00001 TRA 1,4
00460 DMASK SYN $DMASK
NOT FUNCTION
R HED
10150 0100 00 0 10153 NOTS TZE *+3
10151 -0754 00 0 00000 PXD ,0
10152 0020 00 4 00001 TRA 1,4
10153 0500 00 0 00442 CLA NOTC1
10154 0020 00 4 00001 TRA 1,4
00442 NOTC1 SYN $QD1
THE RPLACX FUNCTIONS REPLACE THE X PART OF THE FIRST ARG
WITH THE SECOND ARGUMENT
THE VALUE OF REPLACA,REPLACD, AND REPLACW IS ZERO
S HED
10155 0634 00 4 10162 RPLACA SXA REPL,4
10156 -0734 00 4 00000 PDX 0,4
10157 -0763 00 0 00022 LGL 18
10160 0621 00 4 00000 STA 0,4
10161 -0754 00 4 00000 RPLEX PXD 0,4 ARG1 TO AC AS ANSWER
10162 0774 00 4 00000 REPL AXT **,4 RESTORE LINK IR
10163 0020 00 4 00001 TRA 1,4
10164 0634 00 4 10162 RPLACD SXA REPL,4
10165 -0734 00 4 00000 PDX 0,4
10166 -0620 00 4 00000 SLQ 0,4
10167 0020 00 0 10161 TRA RPLEX EXIT
10170 0634 00 4 10162 RPLACW SXA REPL,4
10171 -0734 00 4 00000 PDX 0,4
10172 -0600 00 4 00000 STQ 0,4
10173 0020 00 0 10161 TRA RPLEX EXIT
OBJECT GENERATOR
10174 0634 00 4 10214 GENSYM SXA GENX,4 SAVE LINK IR
10175 0500 00 0 10217 CLA DIGIT GET DIGITS
10176 0114 06 0 05313 CVR BCDAD1,,6 ADD 1 IN BCD
10177 0601 00 0 10217 STO DIGIT
10200 -0501 00 0 10216 ORA LETTR
10201 0074 00 4 03710 TSX $CONSW,4
10202 0560 00 0 00370 LDQ GENZ
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 88
10203 0074 00 4 03730 TSX $CONS,4
10204 0560 00 0 00370 LDQ GENZ
10205 0074 00 4 03730 TSX $CONS,4
10206 0131 00 0 00000 XCA
10207 0500 00 0 00504 CLA GENPN
10210 0074 00 4 03730 TSX $CONS,4
10211 0131 00 0 00000 XCA
10212 0500 00 0 00460 CLA GENC
10213 0074 00 4 03730 TSX $CONS,4
10214 0774 00 4 00000 GENX AXT **,4 RESTORE LINK IR
10215 0020 00 4 00001 TRA 1,4
00370 GENZ SYN $ZERO
00504 GENPN SYN PNAMED
00460 GENC SYN $DMASK
10216 270000000000 LETTR BCI 1,G00000
10217 000000000000 DIGIT BCI 1,000000
*
* OVERLORD THE TAPE HANDLING SECTION OF LISP. RECODED 20 FEBRUARY
* 1961 BY D. J. EDWARDS.
*
* OVERLORD DIRECTION CARDS ARE PUNCHED IN FAP FORMAT WITH THE VARIABLE
* FIELD BEGINNING IN COLUMN 16. DIRECTION CARDS ARE
* ONE (USE NO TAPES FOR THIS RUN)
* SET ( SAVE RESULTS ON SYSTMP IF NO ERROR OCCURS)
* TST (GET NEW CORE IMAGE AFTER OPERATION)
* TEST (SAVE AS ABOVE)
* FIN (ALL DONE, STOP MACHINE OR RETURN TO A HIGHER MONITOR)
* SETSET (AVE RESULTS ON SYSTMP NO MATTER WHAT)
* DEBUG (SAME AS TEST BUT OBJECTLIST IS NOT SAVED AFTER READ IN)
* SIZE N1,N2,N3,N4 (GIVES SIZE OF BINPRG, PPDL, FWS AND FREE)
* TAPE SYSXXX,A7 (ASSIGNS SYSXXX TO UNIT A 7)
* DUMP BEG,END,TYPE (MAKES OCTAL DUMP ON SYSPOT ACCORDING TO
* TYPE, 0 FOR STRAIGHT OCTAL, NON-ZERO FOR
* LISP (COMPLEMENT) DUMP.)
* REMARK (LOG AS DIRECTION CARD AND LOKK FOR NEXT DIRECTION CARD)
* EXCISE I (I IS COMPILER, INTERPRETER OR BOTH. TURNS ITEM INTO
* FREE STORAGE OR FULL WOTD SPACE)
*
*
10220 0604 00 0 10336 OVBGN STI OVSVI BEGIN BY SAVING INDICATORS AND
10221 0634 00 4 10511 SXA OVRLX,4 INDEX REGISTERS
10222 0634 00 2 10512 SXA OVRLY,2
10223 0634 00 1 10513 SXA OVRLZ,1
10224 0441 00 0 10337 LDI OVIND PRESET INDICATORS
10225 0604 00 0 10340 STI SYSIND AND SYSTEM INDICATORS
10226 0500 00 0 00177 CLA FLAPCZ CONTENT OF CELL ZERO
10227 0601 00 0 00000 STO 0 FIX ANY GLOBERRING THAT MAT BE DONE
*
10230 0074 00 4 00663 OVRLRD TSX $INPUT,4 GET OVERLORD DIRECTION CAR
10231 0 00000 0 00000 $BCDIN FROM BCD INPUT TAPE
10232 0 00016 0 10404 OVBUF,,14 PUT IN OVERLORD CARD BUFFER
10233 0020 00 0 10254 TRA OVERR ERROR RETURN
10234 0020 00 0 10260 TRA OVEOF END OF FILE RETURN
10235 0560 00 0 10406 OVGOR LDQ OVBUF+2 PICK UP OVERLORD DIRECTION
10236 -0500 00 0 10405 CAL OVBUF+1
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 89
10237 -0763 00 0 00006 LGL 6 SHIFT DIRECTION IN LOGICAL AC
10240 0774 00 4 00030 AXT 24,4 TWICE NUMBER OF DIRECTION CARDS
10241 -0340 00 4 10336 OVSRC LAS OVTBL,4 LOOK UP DIRECTION
10242 0020 00 0 10244 TRA *+2 NOT THIS ONE
10243 0020 00 0 10264 TRA OVPNT FOUND IT GO PRINT CARD
10244 2 00002 4 10241 TIX OVSRC,4,2 TRY AGAIN
10245 3 00000 0 10230 OVBSW TXH OVRLRD,,0 NOT IN TABLE, PRINT FIRST BAD CARD
10246 0502 00 0 10245 CLS OVBSW AND GET NEXT CARD.
10247 0601 00 0 10245 STO OVBSW FLIP SWITCH
10250 0074 00 4 01222 TSX OUTPUT,4 PRINT CARD OUT
10251 -0 00000 0 00364 MZE BCDOUT ON BCD OUTPUT TAPE, AND ON LINE
10252 0 00017 0 10403 OVBUF-1,,15
10253 0020 00 0 10230 TRA OVRLRD GET NEXT CARD
*
10254 0074 00 4 01222 OVERR TSX OUTPUT,4 WRITE ERROR MESSAGE
10255 0 00000 0 00364 BCDOUT
10256 0 00011 0 10362 OVRDM,,9
10257 0020 00 0 10235 TRA OVGOR RY TO MAKE SENSE OUT OF CARD
*
10260 0074 00 4 01222 OVEOF TSX OUTPUT,4 WRITE EOF REMARK
10261 0 00000 0 00364 BCDOUT
10262 0 00007 0 10373 OVALF,,7
10263 0020 00 0 10472 TRA OVDN GO AS IF A FIN CARD READ
*
10264 0500 00 0 10245 OVPNT CLA OVBSW RESTORE PRINT SWITCH TO TXH
10265 0602 00 0 10245 SLW OVBSW
10266 0500 00 4 10337 CLA OVTBL+1,4 PICK UP TRA ADDRESS AND SAVE IT
10267 0621 00 0 10305 STA OVTRA
10270 0500 00 0 00200 CLA FLAPCX SET CELLS IN LOWER CORE
10271 0601 00 0 00010 STO 8
10272 0500 00 0 00201 CLA FLAPCY
10273 0601 00 0 00002 STO 2
10274 0500 00 0 00177 CLA FLAPCZ
10275 0601 00 0 00000 STO 0
10276 0074 00 4 01222 TSX OUTPUT,4 PRINT DIRECTION CARD
10277 -0 00000 0 00364 MZE BCDOUT ON BCD OUTPUT TAPE, AND ON ILNE
10300 0 00017 0 10403 OVBUF-1,,15
10301 0140 00 0 10302 TOV *+1 TURN OFF AC OVERFLOW LIGHT
10302 0441 00 0 10340 LDI SYSIND PICK UP SYSTEM INDICATORS
10303 0057 00 000014 RIR 14 RESET ERROR AND DEBIG INDICATORS
10304 0604 00 0 10340 STI SYSIND
10305 0020 00 0 00000 OVTRA TRA ** EXECUTE SPECIFIC OVERLORD PROGRAM
000010 ERRORI BOOL 10 ERROR INDICATOR
*
* DIRECTION CARD TABLE
10306 464525606060 BCI 1,ONE ** ASSUMING THIS IS THIS
10307 0020 00 0 10526 TRA OVONE
10310 622563606060 BCI 1,SET
10311 0020 00 0 10451 TRA OVSET
10312 636263606060 BCI 1,TST
10313 0020 00 0 10423 TRA OVTST
10314 632562636060 BCI 1,TEST ** ASSUMING THIS IS THIS
10315 0020 00 0 10423 TRA OVTST ** ASSUMING THIS IS THIS
10316 263145606060 BCI 1,FIN
10317 0020 00 0 10472 TRA OVDN
10320 623171256060 BCI 1,SIZE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 90
10321 0020 00 0 10532 TRA OVSZE
10322 622563622563 BCI 1,SETSET
10323 0020 00 0 10437 TRA OVSST
10324 242522642760 BCI 1,DEBUG
10325 0020 00 0 10422 TRA OVDBG
10326 632147256060 BCI 1,TAPE
10327 0020 00 0 11074 TRA OVTAP
10330 246444476060 BCI 1,DUMP
10331 0020 00 0 10574 TRA OVDMP ** ASSUMING THIS IS THIS
10332 512544215142 BCI 1,REMARK ** ASSUMING THIS IS THIS
10333 0020 00 0 10230 TRA OVRLRD
10334 256723316225 BCI 1,EXCISE
10335 0020 00 0 11307 TRA OVEXS
10336 0 00000 0 00000 OVSVI TEMPORARY STORAGE FOR INDICATORS
10336 OVTBL SYN OVSVI FOR INDEXING DIRECTION CARD TABLE
10337 -1 00000 0 00000 OVIND STR PRESET FOR LISP INDICATORS
10340 0 00000 0 00000 SYSIND SYSTEM INDICATORES GO HERE
10341 002551514651 OVCEM BCI 7,0ERROR IN SIZE CARD -OVERLORD- *0 1*
10342 603145606231
10343 712560232151
10344 246040466525
10345 514346512440
10346 606054006001
10347 546060606060
10350 002163632544 OVNSM BCI 9,0ATTEMPT TO OPERATE BEFORE SIZE CARD READ -OVERLORD-
10351 476360634660
10352 464725512163
10353 256022252646
10354 512560623171
10355 256023215124
10356 605125212460
10357 404665255143
10360 465124406060
10361 605446600354 BCI 1, *O 3*
10362 002551514651 OVRDM BCI 9,0ERROR ON INPUT, BUT GOING ON ANYHOW -OVERLORD- *O 5*
10363 604645603145
10364 476463736022
10365 646360274631
10366 452760464560
10367 214570304666
10370 604046652551
10371 434651244060
10372 544660600554
10373 002545246046 OVALF BCI 7,0END OF FILE ON INPUT -OVERLORD- *O 6*
10374 266026314325
10375 604645603145
10376 476463604046
10377 652551434651
10400 244060544660
10401 600654606060
10402 0 00004 0 10406 OVPOS OVBUF+2,,4 BEGINNING OF VARIABLE FIELD IN DIR
10403 006060606060 BCI 1,0 DOUBLE SPACE PRINT OF DIRECTION CARD
10404 OVBUF BSS 14 OVERLORD DIRECTION CARD BUFFER
*
* DEBUG OVERLORD DIRECTION
10422 0055 00 000004 OVDBG SIR 4 SET DEBUG INDICATOR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 91
* PREFORM OVTST
*
*
* TEST OR TST OVERLORD DIRECTION
10423 0056 00 000020 OVTST RNT 20 TEST FOR SETUP
10424 0020 00 0 10570 TRA OVNSZ ERROR FOR NOO SIZE CARD HAS BEEN READ
10425 0057 00 000100 RIR TAPIND RESET TAPE INDICATOR
10426 0054 00 000002 RFT 2 WRITE TEST
10427 0074 00 4 00633 TSX TAPDMP,4 DUMP ON SYSTMP
10430 0054 00 000001 RFT 1 TEST FOR NEW CORE IMAGE
10431 0074 00 4 00651 TSX OVLT,4 GET ONE
10432 0055 00 000001 SIR 1 SET READ INDICATOR
10433 0057 00 000002 RIR 2 TURN OFF WRITE INDICATORS
10434 0604 00 0 10340 OVTA STI SYSIND UPDATE SYSTEM INDICATORS
10435 0074 00 4 11310 TSX $EVALQ,4 PERFORM THE EVAL QUOTE OPERATOR
10436 0020 00 0 10230 TRA OVRLRD GET NEXT OVERLORD DIRECTION CARD
000004 DEBUGI BOOL 4 DEBUG INDICATOR
*
* SETSET DIRECTION CARD
10437 0056 00 000020 OVSST RNT 20 TEST FOR SIZE
10440 0020 00 0 10570 TRA OVNSZ ERROR, NO SIZE
10441 0057 00 000100 RIR TAPIND RESET TAPE INDICATOR
10442 0054 00 000002 RFT 2 TEST FOR SAVE CORE
10443 0074 00 4 00633 TSX TAPDMP,4 SAVE IT
10444 0054 00 000001 RFT 1 TEST FOR NEW IMAGE
10445 0074 00 4 00651 TSX OVLT,4 GET ONE
10446 0055 00 000002 SIR 2 SET WRITE INDICATOR
10447 0057 00 000001 RIR 1 RESET READ INDICATOR
10450 0020 00 0 10434 TRA OVTA PERFORM EVALQ AND GET NEXT CARD
*
* SET OVERLORD DIRECTION
10451 0056 00 000020 OVSET RNT 20 TEST FOR SIZE
10452 0020 00 0 10570 TRA OVNSZ ERROR, NO SIZE CARD
10453 0057 00 000100 RIR TAPIND RESET TAPE INDICATOR
10454 0054 00 000002 RFT 2 CHECK WRITE INDICATOR
10455 0074 00 4 00633 TSX TAPDMP,4 DUMP ON SYSTMP
10456 0054 00 000001 RFT 1 TEST FOR NEW CORE IMAGE
10457 0074 00 4 00651 TSX OVLT,4 GET ONE FROM SYSTMP
10460 0055 00 000002 SIR 2 SET WRITE INDICATOR
10461 0057 00 000001 RIR 1 RESET READ INDICATOR
10462 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
10463 0074 00 4 11310 TSX $EVALQ,4 EVALUATE SET
10464 0441 00 0 10340 LDI SYSIND GET SYSTEM INDICATORS 101
10465 0056 00 000010 RNT 10 TEST ERROR INDICATOR
10466 0020 00 0 10230 TRA OVRLRD OFF, GET NEXT DIRECTION CARD
10467 0051 00 000003 IIR 3 ON, INVERT READ AND WRITE INDICATORS
10470 0604 00 0 10340 STI SYSIND
10471 0020 00 0 10230 TRA OVRLRD GET NEXT CARD
*
* FIN OVERLORD DIRECTION CARD
*
10472 0054 00 000002 OVDN RFT 2 TEST WRITE INDICATOR
10473 0074 00 4 00633 TSX TAPDMP,4 DUMP CORE ON SYSTMP
10474 0057 00 000002 RIR 2
10475 0057 00 000100 RIR TAPIND RESET TAPE INDICATOR
10476 0056 00 000040 RNT PPTIND SEE IF PUNCH TAPE USED
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 92
10477 0020 00 0 10503 TRA *+4 SKIP IF NOT USED
10500 0500 00 0 00363 CLA SYSPPT TAPE SPEC.
10501 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
10502 0522 00 0 00353 XEC $WEF WRITE EOF ON PPT
10503 0057 00 000040 RIR PPTIND RESET INDICATORS
10504 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
10505 0500 00 0 00364 CLA SYSPOT TAPE SPEC.
10506 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS
10507 0522 00 0 00353 XEC $WEF WRITE EOF ON SYSPOT
10510 0441 00 0 10336 LDI OVSVI RESTORE ORIGINAL INDICATORS AND
10511 0774 00 4 00000 OVRLX AXT **,4 INDEX REGISTERS
10512 0774 00 2 00000 OVRLY AXT **,2
10513 0774 00 1 00000 OVRLZ AXT **,1
10514 0500 00 0 10525 CLA OVTOV PICK UP RESTART INSTRUCTION
10515 0601 00 0 00000 STO 0 STORE IN ZERO
10516 -0754 00 0 00000 PXD 0,0 LIGHT THE PANEL
10517 0760 00 0 00006 COM
10520 -0765 00 0 00045 LGR 37
10521 0760 00 0 00006 COM
10522 -0760 00 0 00003 SSM
10523 0420 00 7 77777 HPR -1,7 STOP
10524 0020 00 0 10523 TRA *-1 PRESS RESET AND START TO RESTART LISP
10525 0020 00 0 10230 OVTOV TRA OVRLRD TRANSFER TO GET NEXT DIRECTION CARD
000040 PPTIND BOOL 40 PUNCH TAPE INDICATOR
*
* ONE OVERLORD DIRECTION
*
10526 0056 00 000020 OVONE RNT 20 TEST FOR SIZE
10527 0020 00 0 10570 TRA OVNSZ ERROR, NO SIZE CARD READ
10530 0057 00 000003 RIR 3 RESET READ AND WRITE INDICATORS
10531 0020 00 0 10434 TRA OVTA SAVE INDICATORS AND DO EVAL Q
*
* SIZE N1,N2,N3,N4 (OVERLORD DIRECTION CARD)
* N1 = LENGTH OF BINARY PROGRAM, N2 = LENGTH OF PUBLICH PUSH DOWN
* LIST, N3 = LENGTH OF FULL WORD SPACE, N4 = LENGTH OF FREE STORAGE
*
10532 0054 00 000002 OVSZE RFT 2 TEST FOR DUMP OF CURRENT CORE IMAGE
10533 0074 00 4 00633 TSX TAPDMP,4 DUMP ON SYSTMP
10534 0500 00 0 10402 CLA OVPOS SET TO TRANSLATE NUMBERS ON SIZE CARD
10535 0074 00 4 06622 TSX $NUMBR,4 LENGTH OF BINARY PROGRAM
10536 0100 00 0 10561 TZE OVCER ERROR IF ZERO
10537 -0600 00 0 02305 STQ LBINPG SAVE NUMBER
10540 0074 00 4 06622 TSX $NUMBR,4 LENGTH OF PUBLIC PUSH DOWN LIST
10541 0100 00 0 10561 TZE OVCER ZERO IS ERROR
10542 -0600 00 0 02306 STQ LPBPDL SAVE NUMBER
10543 0074 00 4 06622 TSX $NUMBR,4 LENGTH OF FULL WORD SPACE
10544 0100 00 0 10561 TZE OVCER ZERO IS ERROR
10545 -0600 00 0 02307 STQ LFULWS SAVE NUMBER
10546 0074 00 4 06622 TSX $NUMBR,4 LENGTH OF FREE STORAGE
10547 0100 00 0 10561 TZE OVCER ZERO IS ERROR
10550 -0600 00 0 02310 STQ LFREES SAVE NUMBER
10551 0074 00 4 02077 TSX $SETUP,4 PERFORM SETUP
10552 0441 00 0 10340 LDI SYSIND SYSTEM INDICATORS
10553 0054 00 000010 RFT 10 TEST FOR ERROR IN SETUP
10554 0020 00 0 10561 TRA OVCER YES, DO ERROR PROCEDURE
10555 0055 00 000022 SIR 22 SET SIZE AND WRITE INDICATORS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 93
10556 0057 00 000001 RIR 1 RESET READ INDICATORS
10557 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
10560 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
*
10561 0441 00 0 10340 OVCER LDI SYSIND GETT SYSTEM INDICATORS
10562 0055 00 000001 SIR 1 CONVERSION ERROR IN SIZE, SET READ IND
10563 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
10564 0074 00 4 01222 TSX OUTPUT,4 WRITE ERROR MESSAGE
10565 -0 00000 0 00364 MZE BCDOUT ON BCD OUTPUT TAPE AND ONLINE
10566 0 00007 0 10341 OVCEM,,7
10567 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
*
10570 0074 00 4 01222 OVNSZ TSX OUTPUT,4 WRITE ERROR MESSAGE
10571 -0 00000 0 00364 MZE BCDOUT ON BCD OUTPT TAPE AND ONLINE
10572 0 00012 0 10350 OVNSM,,10
10573 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
*
* DUMP BEGINNING,END,N (OVERLORD DIRECTION)
* ALSO AVAILABLE TO LISP
* BEGINNNING IS A NUMBER TO START DUMP AT, END A NUMBER
* (MEANING OBVIOUS) AND N IS A NUMBER IF ZERO GIVES A
* STRAIGHT OCTAL DUMP AND IF NON-ZERO GIVES A COMPLEMENT
* (LISP TYPE) DUMP.
*
10574 0634 00 4 10726 OVDMP SXA OVDX,4 SAVE INDEX REGISTERS
10575 0634 00 2 10727 SXA OVDY,2
10576 0634 00 1 10730 SXA OVDZ,1
10577 0600 00 0 11040 STZ OVDEX INDICATE OVERLORD ENTRANCE
10600 0601 00 0 10723 STO OVDC SAVE AC
10601 -0600 00 0 10724 STQ OVDQ SAVE MQ
10602 0604 00 0 10725 STI OVDI SAVE SI
10603 0500 00 0 10402 CLA OVPOS POSITION OF VARIABLE FIELD
10604 0074 00 4 06622 TSX $NUMBR,4 BEGINNING OF DUMP
10605 0100 00 0 10770 TZE ODER ERROR IN CONVERSION
10606 -0120 00 0 11002 TMI OVENK IF FLOATING POINT NUMBER, LOOK AT KEYS
10607 -0600 00 0 11042 STQ OBEG
10610 0074 00 4 06622 TSX $NUMBR,4 NUMBER TO END DUMP AT
10611 -0600 00 0 11043 STQ OEND
10612 0100 00 0 10770 TZE ODER CONVERSION ERROR
10613 0074 00 4 06622 TSX $NUMBR,4 TYPE OF DUMP
10614 -0600 00 0 11046 STQ OLISD
10615 0100 00 0 10770 TZE ODER CONVERSION ERROR
10616 0500 00 0 11043 OVGE CLA OEND END DUMP NUMBER
10617 0400 00 0 00371 ADD $Q1
10620 0621 00 0 10641 STA OLDQ SET ADDRESS
10621 0402 00 0 11042 SUB OBEG GIVES COUNT OF WORDS TO BE DUMPED
10622 -0120 00 0 10770 TMI ODER NEGATIVE NUMBER YIELDS ERROR
10623 0734 00 1 00000 PAX 0,1 COUNT IN INDEX 1
10624 0534 00 4 11042 LXA OBEG,4 GET BEGINNING
10625 1 77772 4 10626 TXI *+1,4,-6 DECREMETN BY 6 (NUMBER OF WORDS / LINE)
10626 -0634 00 4 11042 SXD OBEG,4 PUT IN DECREMENT FOR OCTAL CONVERSION
10627 0020 00 0 10666 TRA OVDSH START THE DUMP
*
10630 -0500 00 0 11036 OAXT1 CAL OVDSF PICK UP STAR FLAG
10631 0602 00 0 11051 OAXT SLW OUP+1 PUT STARS OF BLANKS IN LINE
10632 0774 00 2 00022 AXT 18,2 SET IR 2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 94
10633 0500 00 0 11042 CLA OBEG BEGININNING OF LINE
10634 0400 00 0 00445 ADD $QD6 6 WORDS PER LINE
10635 0622 00 0 11042 STD OBEG UPDATE LINE NUMBER
10636 0131 00 0 00000 XCA NUMBER TO MQ
10637 0074 00 4 11021 TSX OCTLP,4 CONVERT TO OCTAL
10640 0602 00 0 11050 SLW OUP BEGIN OUTPUT LINE
10641 -0500 00 1 00000 OLDQ CAL **,1 PICK UP WORD TO BE DUMPED
10642 0100 00 0 10671 TZE OSTZ EASY IF ALL ZERO
10643 -0625 00 0 11037 STL OVDZS INDICATE SOMETHING NON-ZERO DUMPED
10644 0520 00 0 11046 ZET OLISD SKIP IF STRAIGHT DUMP
10645 0020 00 0 10673 TRA OLID DO LISP DUMP
10646 -0130 00 0 00000 ODXCL XCL NUMBER TO MQ
10647 0074 00 4 11021 TSX OCTLP,4 CONVERT LEFT HALF
10650 0602 00 2 11074 SLW OUP+20,2 PUT IN OUTPUT LINE
10651 0074 00 4 11021 TSX OCTLP,4 CONVERT RIGHT HALF
10652 0560 00 0 00472 OBQ LDQ BLANKS BLANKS TO MQ
10653 -0765 00 0 00006 LGR 6 MAKE A HOLE
10654 -0501 00 0 00452 ORA OBLANK INSERT ONE BLANK
10655 0602 00 2 11075 SLW OUP+21,2 PUT IN OUTPUT LINE
10656 -0600 00 2 11076 STQ OUP+22,2 DITTO
10657 -2 00001 1 10713 TNX OVDFN,1,1 EXIT IF DONE
10660 2 00003 2 10641 TIX OLDQ,2,3 LOOP 6 TIMES
10661 -0520 00 0 11037 NZT OVDZS SKIP IF NOT ALL ZEROS
10662 0020 00 0 10630 TRA OAXT1 GO BACK AND GET STAR FLAG FOR ZEROS
10663 0074 00 4 01222 TSX OUTPUT,4 WRITE LINE OF DUMP
10664 0 00000 0 00364 BCDOUT ON BCDOUT
10665 0 00024 0 11050 OUP,,20
10666 0600 00 0 11037 OVDSH STZ OVDZS SET SWITCH TO TEST FOR LINE OF ZEROS
10667 -0500 00 0 00472 CAL BLANKS BLANK THE FLAG FIELD
10670 0020 00 0 10631 TRA OAXT GET NEXT LINE
*
10671 0600 00 2 11074 OSTZ STZ OUP+20,2 IF ZERO PUT ZERO S IN OUTPUT LINE
10672 0020 00 0 10652 TRA OBQ GO AS IF CONVERTED
*
10673 0602 00 0 11045 OLID SLW ODLT LISP TYPE (COMPLEMENT DUMP)
10674 -0320 00 0 11047 ANA OLDM MASK OUT ALL BUT TAG AND PREFIX
10675 0100 00 0 10700 TZE ODC TRANSFER IF LISP
10676 -0500 00 0 11045 CAL ODLT HAS PREFIX AND/OR TAG, DUMP STRAIGHT
10677 0020 00 0 10646 TRA ODXCL GO TO NORMAL DUMP
10700 -0535 00 4 11045 ODC LDC ODLT,4 COMPLEMENT DECREMENT
10701 -0634 00 4 11045 SXD ODLT,4 STORE
10702 0535 00 4 11045 LAC ODLT,4 COMPLEMENT ADDRESS
10703 0634 00 4 11045 SXA ODLT,4 STORE
10704 0560 00 0 11045 LDQ ODLT PUT IN MQ
10705 0074 00 4 11021 TSX OCTLP,4 CONVERT LEFT HALF
10706 -0501 00 0 11044 ORA ODSAR OR IN A *
10707 0602 00 2 11074 SLW OUP+20,2 PUT IN OUTPUT LINE
10710 0074 00 4 11021 TSX OCTLP,4 CONVERT RIGHT HALF
10711 -0501 00 0 11044 ORA ODSAR PUT IN *
10712 0020 00 0 10652 TRA OBQ PUT AWAY AS USUAL
*
10713 -2 00003 2 10717 OVDFN TNX OVDLL,2,3 SKIP IF LINE FILLED OUT
10714 -0500 00 0 00472 CAL BLANKS GET BLANKS IN AC
10715 0602 00 2 11074 SLW OUP+20,2 BLANK REST OF LINE
10716 2 00001 2 10715 TIX *-1,2,1
10717 0074 00 4 01222 OVDLL TSX OUTPUT,4 WRITE LAST OUTPUT LINE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 95
10720 0 00000 0 00364 BCDOUT
10721 0 00024 0 11050 OUP,,20
10722 0020 00 0 10726 TRA OVDX GO TO EXIT
* FOLLOWING 6 SELLS CONTAIN AC, MQ , SI, AND IR S UPON DUMP ENTRANCE
10723 0 00000 0 00000 OVDC AC CONTENTS
10724 0 00000 0 00000 OVDQ DITTO MQ
10725 0 00000 0 00000 OVDI DITTO SI
10726 0774 00 4 00000 OVDX AXT **,4 RESTORE INDEX REGISTERS
10727 0774 00 2 00000 OVDY AXT **,2
10730 0774 00 1 00000 OVDZ AXT **,1
10731 0520 00 0 11040 ZET OVDEX TEST FOR LISP OR OVERLORD EXIT
10732 0020 00 4 00001 TRA 1,4 LISP EXIT
10733 0520 00 0 11041 ZET OVDEK TEST FOR ENK MODE
10734 0020 00 0 11002 TRA OVENK GO TO KEEYS
10735 0020 00 0 10230 TRA OVRLRD GO BACK FOR NEXT DIRECTION CARD
*
10736 0634 00 4 10726 DUMPXX SXA OVDX,4 LISP ENTRANCE
10737 0634 00 2 10727 SXA OVDY,2 SAVE INDEX REGISTERS
10740 0634 00 1 10730 SXA OVDZ,1
10741 -0625 00 0 11040 STL OVDEX SET FOR LISP EXIT
10742 0622 00 0 11040 STD OVDEX SAVE ARG1
10743 0500 00 0 03322 CLA $ARG4 PICK UP ID FOR DUMP
10744 0074 00 4 04604 TSX $PRINT,4 PRINT IT
10745 -0534 00 2 11040 LXD OVDEX,2 ARG 1
10746 0074 00 4 13075 TSX FIXVAL,4 EVALUATE AS FIXED POINT NUMBER
10747 0601 00 0 11042 STO OBEG STORE IN BEGINNING
10750 0131 00 0 00000 XCA ARG 2
10751 -0734 00 2 00000 PDX 0,2 ARG TO INDEX 2
10752 0074 00 4 13075 TSX FIXVAL,4 EVALUATE AS FIXED POINT NUMBER
10753 0601 00 0 11043 STO OEND
10754 -0534 00 2 03321 LXD $ARG3,2 ARG 3
10755 0074 00 4 13075 TSX FIXVAL,4 EVALUATE AS FIXED POINT NUMBER
10756 0601 00 0 11046 STO OLISD
10757 0020 00 0 10616 TRA OVGE EXECUTE DUMP
*
10760 0634 00 4 10726 DUMPYY SXA OVDX,4
10761 0634 00 2 10727 SXA OVDY,2
10762 0634 00 1 10730 SXA OVDZ,1
10763 -0625 00 0 11040 STL OVDEX
10764 -0600 00 0 11043 STQ OEND
10765 0601 00 0 11042 STO OBEG
10766 0600 00 0 11046 STZ OLISD
10767 0020 00 0 10616 TRA OVGE
*
10770 0074 00 4 01222 ODER TSX OUTPUT,4 WRITE ERROR MESSAGE
10771 -0 00000 0 00364 MZE BCDOUT ON BCD OUTPUT TAPE AND ONLINE
10772 0 00006 0 10774 ODBAD,,6
10773 0020 00 0 10726 TRA OVDX RESTORE AND EXIT
10774 002221246024 ODBAD BCI 6,0BAD DUMP ARGUMENTS -OVERLORD- *O 4*
10775 644447602151
10776 276444254563
10777 626040466525
11000 514346512440
11001 605446600454
*
DI 11002 0420 77 7 77777 OVENK HPR -1,7,63 STOP FOR KEYS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 96
11003 0760 00 0 00004 ENK
11004 -0754 00 0 00000 PXD 0,0 CLEAR AC
11005 -0763 00 0 00001 LGL 1 TYPE OF DUMP IN SIGN BIT
11006 0601 00 0 11046 STO OLISD PUT AWAY
11007 -0754 00 0 00000 PXD 0,0 CLEAR AC
11010 -0763 00 0 00021 LGL 17 BEGINNING
11011 0601 00 0 11042 STO OBEG
11012 -0754 00 0 00000 PXD 0,0 CLEAR AC
11013 -0763 00 0 00022 LGL 18 END
11014 0601 00 0 11043 STO OEND
11015 0601 00 0 11041 STO OVDEK SET SWITCH ON EXIT
11016 0600 00 0 11040 STZ OVDEX SET OVERLORD EXIT
11017 0100 00 0 10726 TZE OVDX EXIT ON ZERO REGUEST
11020 0020 00 0 10616 TRA OVGE PROCESS DUMP
*
11021 -0754 00 0 00000 OCTLP PXD 0,0 CONVERT LEFT HALF OF MQ TO OCTAL
11022 -0763 00 0 00003 LGL 3 CLEAR AC AND DO SHIFT DANCE
11023 0767 00 0 00003 ALS 3
11024 -0763 00 0 00003 LGL 3
11025 0767 00 0 00003 ALS 3
11026 -0763 00 0 00003 LGL 3
11027 0767 00 0 00003 ALS 3
11030 -0763 00 0 00003 LGL 3
11031 0767 00 0 00003 ALS 3
11032 -0763 00 0 00003 LGL 3
11033 0767 00 0 00003 ALS 3
11034 -0763 00 0 00003 LGL 3
11035 0020 00 4 00001 TRA 1,4 EXIT
*
11021 OCTALP SYN OCTLP
00651 OVLT SYN OVLTXX
11036 605454545460 OVDSF BCI 1, **** STAR FLAG AFTER DUMPING ZEROS
11037 0 00000 0 00000 OVDZS SUPPRESSES OUTPUT WHEN DUMPING ZEROS
11040 0 00000 0 00000 OVDEX ZERO FOR OVERLORD EXIT NON-ZERO , LISP
11041 0 00000 0 00000 OVDEK TEST CELL NON-ZERO FOR ENK MODE
11042 0 00000 0 00000 OBEG BEGIN DUMP
11043 0 00000 0 00000 OEND END DUMP
11044 540000000000 ODSAR BCI 1,*00000 A * FOR COMPLEMENT DUMPING
11045 0 00000 0 00000 ODLT TEMPORARY STORAGE
11046 0 00000 0 00000 OLISD NON-ZERO FOR LISP TYPE DUMP
11047 -3 00000 7 00000 OLDM SVN ,4+2+1 MASK FOR TAG AND PREFIX
11050 606060606060 OUP BCI 2, BLANKS FOR BEGINNING OF OUT PUT LINE
11051 606060606060
11052 BSS 18 ROOM FOR REST OF LINE
*
*
* TAPE SYSXXX,A6 (OVERLORD DIRECTION CARD)
* SYSTAP, SYSTMP, SYSPIT AND SYSPOT ARE CURRENTLY
* RECOGINIZED LISP TAPES. UNIT DESIGNATION IS BY CHANNEL
* (A, B, OR C) AND NUMBER (1 THRU 10).
*
11074 0634 00 4 11225 OVTAP SXA OVTPX,4 SAVE INDEX REGISTERS
11075 0634 00 2 11226 SXA OVTPY,2
11076 0634 00 1 11227 SXA OVTPZ,1
11077 0054 00 000100 RFT TAPIND SKIP IF LAST CARD WAS NOT A TAPE CARD
11100 0020 00 0 11107 TRA OVTJJ SKIP READ AND WRITE SECTION
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 97
11101 0054 00 000002 RFT 2 TEST FOR TAPE DUMP ON SYSTMP
11102 0074 00 4 00633 TSX TAPDMP,4 DO IT
11103 0054 00 000001 RFT 1 TEST FOR READ
11104 0074 00 4 00651 TSX OVLT,4 GET NEW IMAGE
11105 0057 00 000001 RIR 1 RESET READ INDICATOR
11106 0055 00 000002 SIR 2 SET WRITE INDICATOR
11107 0055 00 000100 OVTJJ SIR TAPIND SET TAPE DIRECTION INDICATOR
11110 0604 00 0 10340 STI SYSIND UPDATE SYSTEM INDICATORS
11111 0774 00 4 00005 AXT 5,4 NUMBER OF ENTRIES IN TAPE TABLE
11112 -0500 00 0 10406 CAL OVBUF+2
11113 0560 00 0 10407 LDQ OVBUF+3 GET TAPE DESIGNATION IN AC AND MQ
11114 -0763 00 0 00023 LGL 19 SHIFT INTO AC
11115 -0765 00 0 00001 LGR 1 DUMPING Q BIT
11116 -0340 00 4 11243 OVLA LAS OVTTB,4 COMPARE WITH TAPE TABLE
11117 0020 00 0 11121 TRA *+2 NOT THIS ONE
11120 0020 00 0 11143 TRA OVTAA THIS IS IT
11121 2 00001 4 11116 TIX OVLA,4,1 TRY AGAIN
11122 0602 00 0 11131 OVCMP SLW OVTRM NOT FOUND, COMPLAIN
11123 0074 00 4 01222 TSX OUTPUT,4
11124 0 00000 0 00364 BCDOUT
11125 0 00014 0 11127 OVTRN,,12
11126 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
11127 006062465151 OVTRN BCI 2,0 SORRY,
11130 707360606060
11131 0 00000 0 00000 OVTRM
11132 603162604546 BCI 9, IS NOT A VALID LISP TAPE DESIGNATION -OVERLORD- *O 2*
11133 636021606521
11134 433124604331
11135 624760632147
11136 256024256231
11137 274521633146
11140 456040466525
11141 514346512440
11142 605446600254
11143 -0773 00 0 00006 OVTAA RQL 6 DUMP THE COMMA
11144 -0754 00 0 00000 PXD 0,0 CLAER AC
11145 -0763 00 0 00006 LGL 6 CHANELL LETTER IN AC
11146 0044 00 0 00000 PAI IN INDICATORS
11147 0774 00 2 00003 AXT 3,2 TRY CHAN. C
11150 0056 00 000003 RNT 3 SKIP IF C
11151 0774 00 2 00002 AXT 2,2 TRY B
11152 0056 00 000002 RNT 2 SKIP IF B OR C
11153 0774 00 2 00001 AXT 1,2 IF NO SKIP, MUST BE A
11154 -0763 00 0 00006 LGL 6 TAPE NUMBER IN AC
11155 -0320 00 0 00417 ANA $QO17 MASK OUT ALL BUT 4 LOW ORDER BITS
11156 0441 00 0 10410 LDI OVBUF+4 NEXT WORD IN INDICATORS
11157 -0054 00 770000 LFT 770000 KIP IF LEFT MOST CHARACTER IS A0
11160 0020 00 0 11162 TRA *+2
11161 0400 00 0 00401 ADD $Q9 IF LEFT MOST IS 0 ADD 9 TO THE 1
11162 0734 00 1 00000 PAX 0,1 RESULT TO INDEX 1
11163 -3 00000 1 11165 TXL *+2,1,0 ZERO UNIT DOES NOT GO
11164 -3 00012 1 11174 TXL OVTPS,1,10 UNITS OVER TEN DON T GO
11165 0500 00 0 00472 CLA BLANKS
11166 0560 00 0 10407 LDQ OVBUF+3
11167 -0773 00 0 00030 RQL 24 POSITION TABPE DESIG
11170 -0763 00 0 00014 LGL 12
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 98
11171 0560 00 0 10410 LDQ OVBUF+4
11172 -0763 00 0 00006 LGL 6 ALL IN AC
11173 0020 00 0 11122 TRA OVCMP GO COMPLAIN
11174 -0501 00 4 11250 OVTPS ORA OVTCT,4 OR IN BIN OR BCD FOR THAT TAPE
11175 -0501 00 2 11253 ORA OVCHN,2 OR IN PROPER CHANEL DESIGNATION
11176 0602 00 4 00370 SLW TAPASG,4 CHANGE TAPE ASSIGNMENT
11177 0560 00 4 11243 LDQ OVTTB,4 MAKE OUTPUT MESSAGE BY GETTING NAME
11200 -0600 00 0 11234 STQ OVTPO PUT INTO MESSAGE
11201 3 00001 4 11216 TXH OVTXX,4,1 SKIP FOLLOWING IF NOT SYSTAP
11202 0500 00 0 00367 CLA SYSTAP
11203 0074 00 4 00276 TSX $(IOS),4 SET UP I-O COMMANDS FOR SYSTAP
11204 0560 00 0 00357 LDQ $TCO MAKE PROPER SYSTEM CALL CARD
11205 -0620 00 0 00145 SLQ BOTTOM+1
11206 0560 00 0 00350 LDQ $RDS
11207 -0600 00 0 11273 STQ GCRDB
11210 0560 00 0 00361 LDQ $RCH
11211 -0620 00 0 11274 SLQ GCRDC
11212 0560 00 0 00362 LDQ $LCH
11213 -0620 00 0 11276 SLQ GCRDD
11214 0766 00 0 01341 WPUA PUCH OUT THE 2 CARD CALLER
11215 0540 00 0 11302 RCHA GCIOC CHANNEL COMMANDS
11216 0500 00 2 11256 OVTXX CLA OVCLT,2 TELL WHAT YOU HAVE DONE BY MAKING
11217 -0501 00 1 11270 ORA OVCTN,1 A MESSAGE
11220 0621 00 0 11231 STA OVTPP
11221 0625 00 0 11231 STT OVTPP
11222 0074 00 4 01222 TSX OUTPUT,4 PRINT OUT THE NEW ASSIGNMENT
11223 0 00000 0 00364 BCDOUT
11224 0 00005 0 11231 OVTPP,,5
11225 0774 00 4 00000 OVTPX AXT **,4 RESTORE INDEX REGISTERS
11226 0774 00 2 00000 OVTPY AXT **,2
11227 0774 00 1 00000 OVTPZ AXT **,1
11230 0020 00 0 10230 TRA OVRLRD GET NEXT DIRECTION CARD
11231 006060000000 OVTPP BCI 3,0 000IS NOW LISP
11232 316260454666
11233 604331624760
11234 000000000000 OVTPO BCI 2,000000.
11235 336060606060
* TABLES FOR OVTAP
11236 627062474763 BCI 5,SYSPPTSYSPOTSYSPITSYSTMPSYSTAP
11237 627062474663
11240 627062473163
11241 627062634447
11242 627062632147
11243 0 00000 0 00000 OVTTB PZE LOW DENS, BCD PPT
11244 0 00000 0 00000 PZE LOW DENS, BCD PIT
11245 0 00000 0 00000 PZE LOW DENS, BCD POT
11246 0 00000 0 00020 PZE 16 HI DENS, BIN TMP
11247 0 00000 0 00020 PZE 16 HI DENS, BIN TMP
11250 0 00003 0 03200 OVTCT PZE 3*512+2*64,,3 CHANNEL C
11251 0 00002 0 02200 PZE 2*512+2*64,,2 B
11252 0 00001 0 01200 PZE 1*512+2*64,,1 A
11253 000000230000 OVCHN BCI 3,000C00000B00000A00
11254 000000220000
11255 000000210000
11256 000000000100 OVCLT BCI 9,00001000009 00008 00007 00006 00005 00004 00003 00002
11257 000000001160
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 99
11260 000000001060
11261 000000000760
11262 000000000660
11263 000000000560
11264 000000000460
11265 000000000360
11266 000000000260
11267 000000000160 BCI 1,00001
11270 OVCTN BSS 0
*
*
* SYSTEM CALL CARD PERFORMS A LOAD TAPE SEQUENCE ON THE SYSTAP
*
11270 0 00006 0 00011 GCRD IOCD 9,,6
11271 0060 00 0 00001 TCOA 1
11272 0021 00 0 00011 TTR 9
11273 0762 00 0 01221 GCRDB RTBA 1 SELECT THE SYSTEM TAPE
11274 0540 00 0 00016 GCRDC RCHA 14
11275 0600 00 0 00001 STZ 1 STOP IF TAPE DOES NOT LOAD
11276 0544 00 0 00000 GCRDD LCHA 0 LOAD I-O COMMAND FROM TAPE
11277 0021 00 0 00001 TTR 1 TRANSFER TO 1
11300 -1 00003 0 00000 IOCT 0,,3 LOAD FIRST 3 WORDS FROM TAPE
* SECOND CARD OF CALLER
11301 0000 00 0 00174 GCRDE HTR CONTIN BECOMES A TRANSFER CARD
*
11302 2 00011 0 11270 GCIOC IORP GCRD,,9
11303 2 00001 0 11301 IORP GCRDE,,1 TRANSFER CARD
11304 2 00000 0 11306 IORP *+2,,0 2 BLANK CARDS
11305 2 00000 0 11306 IORP *+1,,0
11306 0 00000 0 00000 IOCD 0,,0 DISCONNECT CHANNEL
*
000100 TAPIND BOOL 100
*
* EXCISE DIRECTION CARD TO THROW OUT THE COMPILER AND/OR THE INTER
* PRETER GOES HERE
*
11307 0020 00 0 10230 OVEXS TRA OVRLRD ROUTINE NOT WRITTEN YET. 8 APRIL 1961
*
* EVALQ A SUCCESSOR TO THE APPLY OPERATOR, THE GRAND NEW
* (AS OF 1 MARCH 1961) THE EVALQUOTE OPERATOR.
*
11310 0634 00 4 11416 EVALQ SXA EVLQX,4 SAVE LINK IR
11311 0634 00 2 11417 SXA EVLQY,2 SAVE IR 2
11312 0074 00 4 01521 TSX $TIME,4 PRINT TIME AND DATE
11313 0074 00 4 01222 TSX OUTPUT,4 WRITE OPENING MESSAGE
11314 0 00000 0 00364 BCDOUT
11315 0 00014 0 11520 EVQBM,,12
11316 0600 00 0 11516 STZ EVQRTS INITIALIZE TEST CELLS
11317 0600 00 0 03653 STZ EVQB DITTO
11320 0774 00 2 00144 AXT EVQBL,2 LENGTH OF EVAL QUOTE BUFFER
11321 0634 00 2 11437 EVQRD SXA EVQRX,2 SAVE INDEX 2 INCASE OF READ ERROR
11322 0074 00 4 05732 TSX $READ,4 READ THE INPUT LISTS
11323 0601 00 0 03506 STO EVQAN SAVE THE LIST
11324 0340 00 0 11517 CAS EVQSP COMPARE WITH STOP ATOM
11325 0020 00 0 11327 TRA *+2 IS NOT
11326 1 00001 2 11341 TXI EVQOP,2,1 SET IR 2 TO PROER VALUE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 100
11327 0520 00 0 03653 ZET EVQB SKIP IF FIRST LIST OF DOUBLET
11330 0020 00 0 11334 TRA EVQA IS SECOND LIST
11331 -0625 00 0 03653 STL EVQB FLIP SWITCH
11332 0601 00 2 03653 STO EVQB,2 SAVE FIRST LIST OF DOUBLET IN BUFFER
11333 0020 00 0 11321 TRA EVQRD GET NEXT LIST
11334 -0734 00 4 00000 EVQA PDX 0,4 LIST TO INDEX
11335 0754 00 4 00000 PXA 0,4 MOVE TO ADDRESS
11336 0621 00 2 03653 STA EVQB,2 SAVE SECOND LIST OF DOUBLET IN BUFFER
11337 0600 00 0 03653 STZ EVQB FLIP SWITCH
11340 2 00001 2 11321 TIX EVQRD,2,1 GET NEXT LIST
11341 -0634 00 2 11410 EVQOP SXD EVQTH,2 INDEX VALUE OF LAST LIST READ IN
11342 0074 00 4 01521 TSX $TIME,4 PRINT TIME
11343 -0625 00 0 11516 STL EVQRTS SET ERROR RETURN SWITCH
11344 0774 00 2 00144 AXT EVQBL,2 LENGTH OF BUFFER
11345 0634 00 2 11407 EVQLP SXA EVQER,2 SAVE IDNEX VALUE
11346 0074 00 4 01200 EVQS TSX SPACEX,4 WRITE OUT SOME BLANK LINES
11347 0 00000 0 01216 6SPACE 3 DOUBLE SPACES
11350 0500 00 2 03653 CLA EVQB,2 PICK UP FIRST ITEM IN BUFFER
11351 0600 00 2 03653 STZ EVQB,2 ZERO THE BUFFER ENTRY
11352 0600 00 0 03316 STZ $ALIST RESET ALIST
11353 -0734 00 4 00000 PDX 0,4 MAKE AN ATOM TEST
11354 0560 00 0 00370 LDQ $ZERO
11355 -0765 00 0 00022 LGR 18 SECOND LIST INTO MQ
11356 -0754 00 4 00000 PXD 0,4 FIRST LIST INTO AC
11357 0074 00 4 07745 TSX PRINAR,4 PRINT HEADING
11360 0 00000 0 00002 2
11361 602565214350 BCI 2, EVALQUOTE
11362 644663256060
11363 -0774 00 4 11377 AXC EVQFT,4 SET RETURN INDEX CELL
11364 0634 00 4 11376 SXA EVQD,4
11365 0774 00 4 14663 EVQMP AXT $APPLY,4 SET CELL OF PROGRAM TO BE EXECUTED
11366 0634 00 4 11377 SXA EVQFT,4 INITIALIZE PROGRAM TO BE EXECUTED CELL
11367 0601 00 0 11513 STO EVQAC SAVE AC
11370 -0734 00 4 00000 PDX 0,4 FIRST LIST TO IR 4
11371 0500 00 4 00000 CLA 0,4
11372 0734 00 4 00000 PAX 0,4
11373 3 77776 4 11441 TXH EVQAT,4,-2 TRANSFER IF FIRST LIST IS ATOMIC
11374 0500 00 0 11513 EVQNF CLA EVQAC RESTORE AC
11375 0600 00 0 03321 EVQZ STZ $ARG3 NULL ALIST FOR APPLY
11376 0774 00 4 00000 EVQD AXT **,4 RETURN INDEX REGISTER
11377 0020 00 0 00000 EVQFT TRA ** PROGRAM TO BE EXECUTED
11400 0601 00 0 03506 EVQE STO EVQAN SAVE ANSWER
11401 0074 00 4 01222 TSX OUTPUT,4 PRINT END OF EVALQUOTE MESSAGE
11402 0 00000 0 00364 BCDOUT
11403 0 00005 0 11534 EVQAM,,5
11404 0500 00 0 03506 CLA EVQAN PICK UP ANSWER
11405 0074 00 4 04604 TSX $PRINT,4 PRINT IT
11406 0600 00 0 03506 STZ EVQAN ZERO TEMP STORAGE
11407 0774 00 2 00000 EVQER AXT **,2 ERRORS COME BACK HERE, RESTORE IR 2
11410 -3 00000 2 11412 EVQTH TXL EVQDN,2,** EXIT IF LAST DOUBLET EXECUTED
11411 2 00001 2 11345 TIX EVQLP,2,1 EXECUTE NEXT DOUBLET
11412 0074 00 4 01521 EVQDN TSX $TIME,4 ALL DONE, PRINT THE TIME
11413 0074 00 4 01222 TSX OUTPUT,4 PRINT COLSING MESSAGE
11414 0 00000 0 00364 BCDOUT
11415 0 00005 0 11541 EVQME,,5
11416 0774 00 4 00000 EVLQX AXT **,4 RESTORE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 101
11417 0774 00 2 00000 EVLQY AXT **,2
11420 0020 00 4 00001 TRA 1,4 EXIT
*
* EVALQT LISP ENTRANCE TO EVALQUOTE
*
11421 0634 00 4 11376 EVALQT SXA EVQD,4 SET RETURN INDEX CELL
11422 0020 00 0 11365 TRA EVQMP GO TO MAIN PROGRAM
*
* ERROR RETURNS CONTROL HERE
*
11423 0074 00 4 06311 EVQERR TSX TEREAD,4 CLEAN UP READ BUFFER
11424 0074 00 4 05214 TSX TERPRI,4 CLEAN UP PRINT BUFFER
11425 0074 00 4 05421 TSX TERPUN,4 CLEAN UP PUNCH BUFFER
11426 0074 00 4 02410 TSX TERPDL,4 RESET PUSH DOWN LIST
11427 0520 00 0 11516 ZET EVQRTS SKIP IF IN READ IN SECTION OF EVALQUOT
11430 0020 00 0 11407 TRA EVQER EXECUTE NEXT DOUBLET
11431 -0625 00 0 11516 STL EVQRTS MOVE TO OPREATE SECTION OF EVALQUOTE
11432 0074 00 4 01222 TSX OUTPUT,4 MESSAGE THAT READ WAS ERROR TERMINATED
11433 0 00000 0 00364 BCDOUT
11434 0 00012 0 11546 EVQRE,,10
11435 0500 00 0 03506 CLA EVQAN PICK UP LAST LIST READ IN
11436 0074 00 4 04604 TSX $PRINT,4
11437 0774 00 2 00000 EVQRX AXT **,2 RESTORE IR 2 TO RIGHT VALUE
11440 1 00001 2 11341 TXI EVQOP,2,1 SET IR 2 TO PROER VALUE
*
* CASE FOR ATOMIC FIRST LIST OF DOUBLET
*
11441 -0734 00 4 00000 EVQAT PDX 0,4
11442 -3 00000 4 11374 TXL EVQNF,4,0 EXIT IF END OF ATOM
11443 0500 00 4 00000 CLA 0,4 NEXT WORD
11444 0734 00 4 00000 PAX 0,4 CAR OF ATOM
11445 -0625 00 0 11515 STL EVQST SET SWITCH FOR SUBR OF EXPR
11446 -3 06732 4 11450 TXL *+2,4,$SUBR-1 LOOK FOR $SUBR
11447 -3 06733 4 11501 TXL EVQFS,4,$SUBR TREAT AS FSUBR (ALMOST)
11450 -3 10156 4 11452 TXL *+2,4,$EXPR-1 LOOK FOR $EXPR
11451 -3 10157 4 11457 TXL EVQFX,4,$EXPR TREAT AS FEXPR (ALMOST)
11452 0600 00 0 11515 STZ EVQST SET SWITCH FOR FSUBR OR FEXPR
11453 -3 10102 4 11455 TXL *+2,4,$FSUBR-1 LOOK FOR FSUBR
11454 -3 10103 4 11501 TXL EVQFS,4,$FSUBR
11455 -3 10141 4 11441 TXL EVQAT,4,$FEXPR-1 LOOK FOR FEXPR
11456 3 10142 4 11441 TXH EVQAT,4,$FEXPR
11457 -0734 00 4 00000 EVQFX PDX 0,4 FOUND AN FEXPR
11460 0500 00 4 00000 CLA 0,4
11461 0734 00 4 00000 PAX 0,4 THE EXPRESSION FOR THE FEXPR
11462 -0754 00 4 00000 PXD 0,4 EXPRESSION TO AC
11463 0520 00 0 11515 ZET EVQST SKIP IF FEXPR
11464 0020 00 0 11375 TRA EVQZ GO TO APPLY CALL FOR EXPR
11465 0601 00 0 03506 STO EVQAN SAVE THE EXPRESSION
11466 -0600 00 0 11514 STQ EVQMQ SAVE MQ
11467 -0754 00 0 00000 PXD 0,0 CLEAR
11470 0131 00 0 00000 XCA MQ AND
11471 -0754 00 0 00000 PXD 0,0 AC
11472 0074 00 4 03730 TSX $CONS,4 NULL A LIST
11473 0131 00 0 00000 XCA INTO MQ
11474 0500 00 0 11514 CLA EVQMQ PUT SECOND LIST IN AC
11475 0074 00 4 03730 TSX $CONS,4 CONS(L,A)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 102
11476 0131 00 0 00000 XCA ANSWER TO ARG 2
11477 0500 00 0 03506 CLA EVQAN FEXPR
11500 0020 00 0 11375 TRA EVQZ GO TO APPLY FOR FEXPR
*
11501 -0734 00 4 00000 EVQFS PDX 0,4 FOUND FSUBR, GET TXL INSTRUCTION
11502 0500 00 4 00000 CLA 0,4
11503 0734 00 4 00000 PAX 0,4
11504 0500 00 4 00000 CLA 0,4
11505 0621 00 0 11377 STA EVQFT SAVE ADDRESS
11506 -0754 00 0 00000 PXD 0,0 ZERO
11507 0131 00 0 00000 XCA THE MQ AND PUT LIST IN AC
11510 0520 00 0 11515 ZET EVQST SKIP IF FSUBR
11511 0074 00 4 10072 TSX SPREAD,4 SPREAD THE ARGUMENTS
11512 0020 00 0 11376 TRA EVQD EXECUTE THE SUBR OR FSUBR
*
11513 0 00000 0 00000 EVQAC TEMPORARY STORAGE
11514 0 00000 0 00000 EVQMQ DITTO
11515 0 00000 0 00000 EVQST TEST CELL IS NON-ZERO FOR SUBR OR EXPR
11516 0 00000 0 00000 EVQRTS TEST CELL IS ZERO DURING READ IN
00144 EVQBL EQU 100 LENGTH OF BUFFER
11517 0 06772 0 00000 EVQSP ,,$STOP STOP ATOM
11520 002565214350 EVQBM BCI 7,0EVALQUOTE OPERATOR AS OF 1 MARCH 1961.
11521 644663256046
11522 472551216346
11523 516021626046
11524 266001604421
11525 512330600111
11526 060133606060
11527 603145476463 BCI 5, INPUT LISTS NOW BEING READ.
11530 604331626362
11531 604546666022
11532 253145276051
11533 252124336060
11534 002545246046 EVQAM BCI 5,0END OF EVALQUOTE, VALUE IS ....
11535 266025652143
11536 506446632573
11537 606521436425
11540 603162603333
11541 012545246046 EVQME BCI 5,1END OF EVALQUOTE OPERATOR
11542 266025652143
11543 506446632560
11544 464725512163
11545 465160606060
11546 005125212431 EVQRE BCI 9,0READING TERMINATED BY AN ERROR. LAST LIST READ IN IS
11547 452760632551
11550 443145216325
11551 246022706021
11552 456025515146
11553 513360432162
11554 636043316263
11555 605125212460
11556 314560316260
11557 603333333333 BCI 1, .....
*
H HED
* ERRORSET(E,N,SW)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 103
*
* ERRORSET ATTEMPTS TO EVALUATE ITS FIRST ARGUMENT. IF AN
* ERROR OCCURS DURING THE EVALUATION, OR IF MORE THAN N CONS-S
* OCCUR DURING THE EVALUATION, ERRORSET RETURNS WITH A VALUE OF F
* AFTER RESTORING CONDITIONS TO WHAT THEY WERE BEFORE THE
* ATTEMPTED EVALUATION. IF THE EVLAUATION SUCCEEDS, ERRORSET
* RETURNS LIST OF THE RESULT. IF SW * F, ERROR DIAGNOSTICS ARE
* SUPPRESSED, AND IF SW = T, THEY ARE INCLUDED.
*
11560 -0634 00 4 11662 ERRSET SXD HORN,4
11561 0074 00 4 02312 TSX $SAVE,4
11562 -3 11673 0 02363 TXL $END8,,HORN+9
11563 -0634 00 2 11663 SXD HORN+1,2
11564 0634 00 1 11663 SXA HORN+1,1
11565 0604 00 0 11666 STI HORN+4
11566 -0734 00 1 00000 PDX 0,1 EXPRESSION TO BE EVALUATED
11567 -0534 00 4 03321 LXD $ARG3,4 ERROR BYPASS SWITCH
11570 0634 00 4 11664 SXA ERNULL,4
11571 0131 00 0 00000 XCA
11572 -0734 00 2 00000 PDX 0,2 GET CONS COUNTER LIMIT
11573 0074 00 4 13075 TSX FIXVAL,4
11574 0601 00 0 11670 STO HORN+6
11575 0500 00 0 03742 CLA $CNTR1 GET CURRENT CONS COUNT
11576 -0320 00 0 00457 ANA $AMASK
11577 0400 00 0 04106 ADD $CNTS
11600 0402 00 0 11670 SUB HORN+6 COMPARE WITH THE LIMIT
11601 -0120 00 0 11611 TMI OBOE TRA IF COUNTER NEED NOT BE CHANGED
11602 -0760 00 0 00003 SSM NEG. NUMBER FOR GARBAGE COLLECTOR
11603 0601 00 0 11667 STO HORN+5 SAVE (LIMIT - OLD COUNT)
11604 0500 00 0 11670 CLA HORN+6 SET CONS COUNTER TO LIMIT
11605 0621 00 0 03742 STA $CNTR1
11606 -0320 00 0 00465 ANA PDTMSK
11607 0601 00 0 04106 STO $CNTS
11610 0020 00 0 11612 TRA *+2
11611 0600 00 0 11667 OBOE STZ HORN+5 TAKE LIMIT = OLD COUNT
11612 0560 00 0 00370 LDQ $ZERO NULL P-LIST FOR EVALUATION
11613 0502 00 0 02317 CLS $CPPI SAVE PUSHDOWN POINTER
11614 0601 00 0 11670 STO HORN+6
11615 -0625 00 0 11671 STL TCOUNT TURN ON CONS COUNTER
11616 0774 00 4 11625 AXT BSOON,4 SET UP EXIT IN ERROR
11617 0634 00 4 11665 SXA EREXIT,4
* ATTEMPT TO PERFORM THE EVALUATION
11620 -0754 00 1 00000 PXD 0,1 EXPRESSION TO BE EVALUATED
11621 0074 00 4 15454 TSX $EVAL,4
* WE GET HERE IF THE EVALUATION WORKED
11622 0560 00 0 00370 LDQ $ZERO FORM LIST OF THE RESULT
11623 0074 00 4 03730 TSX $CONS,4
* AN ERROR IN THIS CONS ACTS LIKE AN ERROR IN THE EVALUATION
11624 0020 00 0 11643 TRA SHAWM RESTORE PARAMETERS AND EXIT
* WE GET HERE IN CASE OF ERROR
11625 -0535 00 4 11670 BSOON LDC HORN+6,4 UNSAVE ALL RECURSIVE FUNCTIONS
11626 -0634 00 4 11641 SXD TUBA,4 ENTERED SINCE THE ERROR
11627 0020 00 0 11640 TRA TUBA-1
11630 -0534 00 4 02317 HARP LXD $CPPI,4
11631 -0500 00 4 77777 CAL -1,4
11632 -0320 00 0 00461 ANA $PMASK TEST FOR STR FROM COMPILER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 104
11633 0322 00 0 00451 ERA $QP5
11634 0100 00 0 11637 TZE *+3
11635 0074 00 4 02326 TSX UNSAVE,4
11636 0020 00 0 11640 TRA *+2
11637 0074 00 4 17330 TSX C$UNWND,4
11640 -0535 00 4 02317 LDC $CPPI,4
11641 3 00000 4 11630 TUBA TXH HARP,4,**
11642 -0754 00 0 00000 PXD 0,0 RETURN VALUE OF NIL
* RESTORE PARAMETERS FOR EITHER KIND OF EXIT
11643 0601 00 0 11670 SHAWM STO HORN+6 SAVE EXIT VALUE
11644 0500 00 0 03742 CLA $CNTR1 RESTORE CONS COUNTER
11645 -0320 00 0 00457 ANA $AMASK
11646 0400 00 0 04106 ADD $CNTS
11647 0402 00 0 11667 SUB HORN+5
11650 0621 00 0 03742 STA $CNTR1
11651 -0320 00 0 00465 ANA PDTMSK
11652 0601 00 0 04106 STO $CNTS
11653 0534 00 1 11663 LXA HORN+1,1 RESTORE INDICATORS, IR1, AND IR2
11654 -0534 00 2 11663 LXD HORN+1,2
11655 0441 00 0 11666 LDI HORN+4
11656 0500 00 0 11670 CLA HORN+6 PICK UP EXIT VALUE
11657 0074 00 4 02326 TSX UNSAVE,4 RESTORE HORN BLOCK
11660 -0534 00 4 11662 LXD HORN,4 RESTORE IR4 AND EXIT
11661 0020 00 4 00001 TRA 1,4
* PROTECTED TEMPORARY STORAGE FOR ERRORSET
HEAD H
11662 -0 00000 0 10211 HORN MZE ERSETO (+0) ERRORSET OBJECT IN A, IR4 IN D
11663 -0 00000 0 00000 MZE (+1) IR1 IN A, IR2 IN D
11664 -0 00000 0 11664 ERNULL MZE * (+2) ZERO MEANS SKIP DIAGNOSTICS
TD 11665 -3 00000 0 11423 EREXIT TXL EVQERR (+3) EXIT INSTRUCTION FOR $ERROR
11666 -0 00000 0 00000 MZE (+4) INDICATORS
11667 -0 00000 0 00000 MZE (+5) CONS COUNTER INCREMENT
11670 -0 00000 0 00000 NUBPDL MZE (+6) PDL BACKUP POINT IN D
11671 -0 00000 0 00000 TCOUNT MZE (+7) NON-ZERO ACTIVATES CONS COUNTER
HEAD 0
11665 TERA2 SYN EREXIT
*
HEAD H
*
* EXTENDED CAR S AND CDR S FOR THE INTERPRETER
*
11672 0634 00 4 11703 CAAARX SXA CAX,4 SAVE LINK IR
11673 -0734 00 4 00000 PDX 0,4
11674 0500 00 4 00000 CLA 0,4
11675 0734 00 4 00000 PAX 0,4
11676 0500 00 4 00000 AA CLA 0,4
11677 0734 00 4 00000 PAX 0,4
11700 0500 00 4 00000 A CLA 0,4
11701 0734 00 4 00000 PAX 0,4
11702 -0754 00 4 00000 PXD 0,4
11703 0774 00 4 00000 CAX AXT **,4 RESTORE LINK IR
11704 0020 00 4 00001 TRA 1,4 EXIT
*
11705 0634 00 4 11703 CAADRX SXA CAX,4
11706 -0734 00 4 00000 PDX 0,4
11707 0500 00 4 00000 CLA 0,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 105
11710 -0734 00 4 00000 AAX PDX 0,4
11711 0020 00 0 11676 TRA AA
*
11712 0634 00 4 11703 CADARX SXA CAX,4
11713 -0734 00 4 00000 PDX 0,4
11714 0500 00 4 00000 CLA 0,4
11715 0734 00 4 00000 PAX 0,4
11716 0500 00 4 00000 AD CLA 0,4
11717 -0734 00 4 00000 PDX 0,4
11720 0020 00 0 11700 TRA A
11721 0634 00 4 11703 CADDRX SXA CAX,4
11722 -0734 00 4 00000 PDX 0,4
11723 0500 00 4 00000 CLA 0,4
11724 -0734 00 4 00000 ADX PDX 0,4
11725 0020 00 0 11716 TRA AD
*
11726 0634 00 4 11703 CAARXX SXA CAX,4
11727 0020 00 0 11710 TRA AAX
*
11730 0634 00 4 11703 CADRXX SXA CAX,4
11731 0020 00 0 11724 TRA ADX
*
11732 0634 00 4 11742 CDAARX SXA CDX,4
11733 -0734 00 4 00000 PDX 0,4
11734 0500 00 4 00000 CLA 0,4
11735 0734 00 4 00000 PAX 0,4
11736 0500 00 4 00000 DA CLA 0,4
11737 0734 00 4 00000 PAX 0,4
11740 0500 00 4 00000 D CLA 0,4
11741 -0320 00 0 00460 ANA $DMASK
11742 0774 00 4 00000 CDX AXT **,4
11743 0020 00 4 00001 TRA 1,4
11744 0634 00 4 11742 CDADRX SXA CDX,4
11745 -0734 00 4 00000 PDX 0,4
11746 0500 00 4 00000 CLA 0,4
11747 -0734 00 4 00000 DAX PDX 0,4
11750 0020 00 0 11736 TRA DA
*
11751 0634 00 4 11742 CDDARX SXA CDX,4
11752 -0734 00 4 00000 PDX 0,4
11753 0500 00 4 00000 CLA 0,4
11754 0734 00 4 00000 PAX 0,4
11755 0500 00 4 00000 DD CLA 0,4
11756 -0734 00 4 00000 PDX 0,4
11757 0020 00 0 11740 TRA D
*
11760 0634 00 4 11742 CDDDRX SXA CDX,4
11761 -0734 00 4 00000 PDX 0,4
11762 0500 00 4 00000 CLA 0,4
11763 -0734 00 4 00000 DDX PDX 0,4
11764 0020 00 0 11755 TRA DD
*
11765 0634 00 4 11742 CDARXX SXA CDX,4
11766 0020 00 0 11747 TRA DAX
*
11767 0634 00 4 11742 CDDRXX SXA CDX,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 106
11770 0020 00 0 11763 TRA DDX
*
HEAD C
11771 0634 00 4 12003 GET SXA GETX,4 SAVE LINK IR
11772 0601 00 0 12006 STO GETL
11773 0500 00 0 12005 CLA FCN31
11774 0601 00 0 03321 STO $ARG3
11775 0500 00 0 12006 CLA GETL
11776 0074 00 4 10011 TSX $PROP,4
11777 -0734 00 4 00000 PDX 0,4
12000 0500 00 4 00000 CLA 0,4
12001 0734 00 4 00000 PAX 0,4
12002 -0754 00 4 00000 PXD 0,4
12003 0774 00 4 00000 GETX AXT **,4 RESTORE LINK IR
12004 0020 00 4 00001 TRA 1,4
12005 -3 00000 0 12003 FCN31 TXL GETX,,0
12006 0 00000 0 00000 GETL
*
* COMPAT FUNCTIONAL ARGUMENT LINKAGE PROGRAM BETWEEN COMPILED
* PROGRAMS AND APPLY FOR S-EXPRESSION FUNCTIONAL ARGUMENTS
*
12007 0634 00 4 12026 COMPAT SXA CX,4 SAVE INDEX REGISTERS
12010 0634 00 2 12027 SXA CY,2
12011 0601 00 0 03317 STO $ARG1 SAVE AC
12012 -0600 00 0 03320 STQ $ARG2 DITTO MQ
12013 0560 00 0 00370 LDQ $ZERO END OF ARGUMENT LIST
12014 0500 00 4 00001 CLA 1,4 ARGUMENTS FOR COMPAT
12015 0622 00 0 12031 STD CA S-EXPRESSION FUNCTIONAL ARGUMENT
12016 0737 00 2 00000 PAC 0,2 COMPLEMENT NUMBER OF ARGUMENTS
12017 -3 00000 2 12024 CL TXL CD,2,0 GO WHEN ALL DONE
12020 0500 00 2 03316 CLA $ARG1-1,2 PICK UP ARGUMENT
12021 0074 00 4 03730 TSX $CONS,4 CONS ON TO ARGUMENT LIST
12022 0131 00 0 00000 XCA LIST TO MQ
12023 1 00001 2 12017 TXI CL,2,1 GO BACK FOR NEXT
12024 0500 00 0 12031 CD CLA CA FUNCTIONAL ARGUMENT
12025 0600 00 0 03321 STZ $ARG3 ZERO PAIR LIST
12026 0774 00 4 00000 CX AXT **,4 RESTORE INDEX REGISTERS
12027 0774 00 2 00000 CY AXT **,2
12030 1 77777 4 14663 TXI $APPLY,4,-1 GO TO APPLY AND ADJUST EXIT INDEX
12031 0 00000 0 00000 CA S-EXPRESSION GOES HERE
F HED
* PACK(CHAR)
*
* PACK ADDS ANOTHER CHARACTER TO THE CHARACTER BUFFER BOFFO
*
*
12032 0771 00 0 00022 PACK ARS 18 GET CHARACTER CODE FROM
12033 0402 00 0 00521 SUB HORG LOCATION OF OBJECT
12034 -0765 00 0 00006 LGR 6 PUT NEW CHARACTER INTO PACKED WORD
12035 -0500 00 0 12603 CAL CHARS
12036 0140 00 0 12037 TOV *+1 SHUT OFF OVERFLOW LIGHT
12037 -0763 00 0 00006 LGL 6
12040 0140 00 0 12044 TOV B5 IF WORD FULL, PUT IT IN BUFFER
12041 0602 00 0 12603 SLW CHARS
12042 -0754 00 0 00000 PXD ,0 CLEAR AC FOR EXIT
12043 0020 00 4 00001 TRA 1,4 EXIT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 107
12044 0634 00 4 12053 B5 SXA B1,4 SAVE IR4
12045 0774 00 4 00024 BFLOC AXT 20,4 ADDRESS HAS INDEX FOR BOFFO
12046 0602 00 4 12631 SLW BOFFO,4 STORE FULL WORD OF CHARACTERS
12047 -2 00001 4 12056 TNX B3,4,1 IF BUFFER FULL, TRANSFER
12050 0500 00 0 12417 CLA A1 WHEN 1 SHIFTS PAST P BIT,
12051 0601 00 0 12603 STO CHARS NEW WORD HAS 6 CHARACTERS
12052 0634 00 4 12045 SXA BFLOC,4 SAVE BUFFER INDEX
12053 0774 00 4 00000 B1 AXT ,4 RESTORE IR4
12054 -0754 00 0 00000 PXD ,0 CLEAR AC FOR EXIT
12055 0020 00 4 00001 TRA 1,4 EXIT
12056 -3 00000 4 12061 B3 TXL B4,4,0 IF MORE THAN 120 CHARS, TRANSFER
12057 0634 00 0 12045 SXA BFLOC,0 SET INDEX TO SHOW BUFFER FILLED
12060 0020 00 0 12066 TRA B6
12061 0074 00 4 12147 B4 TSX $MKNAM,4 FORM OBJECT FOR ERROR PRINTOUT
12062 0074 00 4 06420 TSX INTRN1,4
12063 -0634 00 4 01562 SXD $ERROR,4
12064 0074 00 4 01563 TSX $ERROR+1,4
12065 542330600154 BCI 1,*CH 1* TOO MANY CHARACTERS IN PRINT NAME
12066 0500 00 0 00471 B6 CLA SEVENS BIT 1 IN CHARS WILL MAKE
12067 0601 00 0 12603 STO CHARS WORD LOOK FULL
12070 0020 00 0 12053 TRA B1
* PACK USES $ERROR, $EROR1, AND $Q1
SPACE 5
* NUMOB
*
* NUMOB MAKES A NUMERICAL OBJECT CORRESPONDING TO THE BCD
* CHARACTERS IN THE BUFFER BOFFO.
*
* THIS ROUTINE HAS CORSS-REFERENCES TO THE INNARDS OF NUMBR
*
12071 0634 00 4 12134 NUMOB SXA GV1,4 SAVE IR4
12072 0140 00 0 12073 TOV *+1 SHUT OFF OVERFLOW LIGHT
12073 -0500 00 0 12603 CAL CHARS SHIFT SEVENS INTO LAST PACKED WORD
12074 0560 00 0 00471 LDQ SEVENS
12075 -0763 00 0 00006 LGL 6
12076 -0140 00 0 12075 TNO *-1 DONE WHEN 1 PASSES THROUGH P BIT
12077 0534 00 4 12045 LXA BFLOC,4 PUT LAST WORD INTO BOFFO
12100 0602 00 4 12631 SLW BOFFO,4
12101 0500 00 0 12573 CLA PARAM INPUT PARAMETER FOR NUMBR IS
12102 0074 00 4 06622 TSX NUMBR,4 BEGINNING OF BOFFO
12103 0100 00 0 12136 TZE GV3 ERROR IF ZERO IN AC
12104 0120 00 0 12112 TPL GV2 TRANSFER IF FIXED POINT OUTPUT
12105 0131 00 0 00000 XCA GET NUMBER FROM MQ
12106 0560 00 0 00476 LDQ FLOS FLOATING POINT SIGNAL
12107 0074 00 4 12636 TSX $MKNO,4 FORM OBJECT
12110 0534 00 4 12134 LXA GV1,4 RESTORE IR4
12111 0020 00 0 12201 TRA CLEAR RESET BOFFO AND EXIT
12112 -0760 00 0 00001 GV2 PBT OCTAL SIGNAL IN NUMBR OUTPUT
12113 0020 00 0 12121 TRA GV6 TRA IF NOT OCTAL
12114 0131 00 0 00000 XCA
12115 0560 00 0 00503 LDQ $OCTD MAKE OCTAL NUMBER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 108
12116 0074 00 4 12636 TSX $MKNO,4
12117 0534 00 4 12134 LXA GV1,4
12120 0020 00 0 12201 TRA CLEAR RESET BOFFO AND EXIT
12121 0131 00 0 00000 GV6 XCA BRING THE NUMBER TO THE AC
12122 -0120 00 0 12132 TMI GV4 TEST FOR DIGITS 0 THRU 9
12123 0340 00 0 00402 CAS $Q10
12124 0020 00 0 12132 TRA GV4
12125 0020 00 0 12132 TRA GV4
12126 0361 00 0 00521 ACL HORG FORM OBJECT DIRECTLY
12127 0767 00 0 00022 ALS 18
12130 0534 00 4 12134 LXA GV1,4 RESTORE IR4
12131 0020 00 0 12201 TRA CLEAR
12132 0560 00 0 00475 GV4 LDQ FIXS FIXED POINT SIGNAL FOR $MKNO
12133 0074 00 4 12636 TSX $MKNO,4 FORM NUMERICAL OBJECT
12134 0774 00 4 00000 GV1 AXT ,4 RESTORE IR4
12135 0020 00 0 12201 TRA CLEAR RESET BOFFO AND EXIT
12136 0074 00 4 01222 GV3 TSX OUTPUT,4
12137 0 00000 0 00364 BCDOUT
12140 0 00004 0 12143 GVA,,4
* BCI 1,*CH 2* FLOATING POINT NUMBER OUT OF RANGE
12141 -0754 00 0 00000 PXD 0,0
12142 0020 00 0 12134 TRA GV1
12143 602551514651 GVA BCI 4, ERROR NUMBER *CH 2*
12144 604564442225
12145 516060542330
12146 600254606060
*
* THIS ROUTINE USES $CONS, $MKNO,$ZERO,$ERROR, AD $EROR1
SPACE 5
* MKNAM AND CLEARBUFF
*
*
* CLEARBUFF STARTS AT CLEAR AND RESETS THE BUFFER BOFFO TO
* THE BEGINNING
*
* MKNAM() HAS AS OUTPUT A PNAME LIST STRUCTURE CORRESPONDING
* TO THE CHARACTERS IN THE BUFFER BOFFO. THE BEGINNING OF
* BOFFO IS RESET.
*
* THIS ROUTINE HAS CROSS-REFERENCES TO THE INNARDS OF PACK.
*
12147 0634 00 4 12207 MKNAM SXA BB1,4 SAVE IR4
12150 0634 00 2 12177 SXA BBIR2,2 SAVE IR2
12151 -0500 00 0 12603 CAL CHARS IF C(CHARS) = 1, CHARS CONTAINS
12152 -0340 00 0 12417 LAS A1 NO SIGNIFICANT CHARACTERS
12153 0020 00 0 12156 TRA BB5
12154 -0754 00 0 00000 PXD ,0
12155 0020 00 0 12167 TRA BB2 NO SIGNIFICANT CHARACTERS IN CHARS
12156 0140 00 0 12157 BB5 TOV *+1 SHUT OFF OVERFLOW LIGHT
12157 0560 00 0 00471 LDQ SEVNS SHIFT SEVENS INTO LAST WORD
12160 -0763 00 0 00006 LGL 6 OF LIST
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 109
12161 -0140 00 0 12160 TNO *-1
12162 0602 00 0 12574 SLW T1 PUT P BIT INTO SIGN
12163 0500 00 0 12574 CLA T1
12164 0074 00 4 03710 TSX $CONSW,4 FORM POINTER TO LAST WORD OF LIST
12165 0560 00 0 00370 LDQ ZERO
12166 0074 00 4 03730 TSX $CONS,4
12167 0534 00 2 12045 BB2 LXA BFLOC,2 LOC OF LAST SIGNIFICAN BUFFER WORD
12170 3 00023 2 12177 BB4 TXH BBIR2,2,19 TRA IF BUFFER IS EXHAUSTED
12171 0602 00 0 03654 SLW BBPNT SAVE DECREMENT FOR FUTURE USE
12172 0500 00 2 12630 CLA BOFFO-1,2 GET NEXT WORD OF BUFFER
12173 0074 00 4 03710 TSX $CONSW,4
12174 0560 00 0 03654 LDQ BBPNT
12175 0074 00 4 03730 TSX $CONS,4
12176 1 00001 2 12170 TXI BB4,2,1 MOVE TO NEXT WORD OF BUFFER
12177 0774 00 2 00000 BBIR2 AXT **,2 RESTORE IR2
12200 0020 00 0 12202 TRA BB3 RESET POSITION IN BOFFO
12201 0634 00 4 12207 CLEAR SXA BB1,4 ENTRANCE FOR CLEARING BUFFER
12202 0560 00 0 12417 BB3 LDQ A1 RESET CHARS CELL TO 0 CHARACTERS
12203 -0600 00 0 12603 STQ CHARS
12204 0774 00 4 00024 AXT 20,4 SET INDEX IN PACK FOR FIRST
12205 0634 00 4 12045 SXA BFLOC,4 BUFFER WORD
12206 0600 00 0 03654 STZ BBPNT AVOID UNNECESSARY GARBAGE COLL.
12207 0774 00 4 00000 BB1 AXT ,4 RESTORE IR4
12210 0020 00 4 00001 TRA 1,4 EXIT
SPACE 5
* ADVANCE, STARTREAD, AND ENDREAD PROGRAMS
*
* ADVANCE SETS CURCHAR TO THE NEXT CHARACTER
* STARTREAD READS A NEW RECORD
* ENDREAD MOVES TO THE END OF THE CURRENT RECORD AND
* GIVES ERROR OUTPUT, IF ANNY
12211 -0634 00 4 12220 ADVANC SXD PORK,4 SAVE IR
12212 -0534 00 4 12236 LXD CHPOS,4 FIND NO. OF CHARS. LEFT IN PACKED
12213 2 00006 4 12247 TIX CHOPS,4,6 WORD
12214 -0534 00 4 12237 LXD WDNUM,4 FIND NEW PACKED WORD
12215 2 00001 4 12243 TIX LAMB,4,1 IF NEW RECORD NEEDED, CONTINUE
12216 -0520 00 0 12604 NZT EORTS IF NONZERO GIVE EOR AS OUTPUT CHAR-
12217 0020 00 0 12223 TRA VEAL ACTER, OTHERWISE READ NEW RECORD
12220 1 00000 0 12276 PORK TXI STEW,,0 READ A NEW RECORD
12221 -0634 00 4 12220 STREAD SXD PORK,4 SAVE IR4
12222 0020 00 0 12225 TRA *+3
12223 -0520 00 0 12517 VEAL NZT ERSIG
12224 0020 00 0 12233 TRA JOYCE
12225 0600 00 0 12517 STZ ERSIG TURN OFF ERROR SIGNAL
12226 0774 00 4 00014 AXT 12,4 PUT BLANKS IN ERROR BUFFER
12227 -0500 00 0 00472 CAL BLANKS
12230 0602 00 4 12572 RUTH SLW ERBFL,4
12231 0602 00 4 12535 SLW ERBFU,4
12232 2 00001 4 12230 TIX RUTH,4,1
12233 0074 00 4 00663 JOYCE TSX $INPUT,4 READ A NEW RECORD
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 110
12234 0 00000 0 00000 $BCDIN
12235 0 00016 0 12536 BUFF-12,,14
12236 1 00000 0 12316 CHPOS TXI RIBS,,0 ERROR RETURN
12237 1 00000 0 12271 WDNUM TXI RUMP,,0 EOF RETURN
12240 -0625 00 0 12604 STL EORTS SET SIGNAL FOR EOR OUTPUT NEXT TIME
12241 0600 00 0 12635 STZ $CHACT INITIALIZE CHARACTER COUNT
12242 0774 00 4 00014 AXT 12,4 SET INDEX FOR START OF INPUT BUFFER
12243 -0634 00 4 12237 LAMB SXD WDNUM,4
12244 0500 00 4 12552 CLA BUFF,4 PICK UP NEW PACKED WORD FROM
12245 0601 00 0 12572 STO PWORD INPUT BUFFER AND STORE IT
12246 0774 00 4 00044 AXT 36,4 INITIALIZE POSITION IN PACKED WORD
12247 -0634 00 4 12236 CHOPS SXD CHPOS,4
12250 -0754 00 0 00000 PXD ,0 PICK OFF ONE CHARACTER
12251 0560 00 0 12572 LDQ PWORD
12252 -0763 00 0 00006 A6 LGL 6
12253 -0600 00 0 12572 STQ PWORD SAVE SHIFTED PACKED WORD
12254 0734 00 4 00000 PAX 0,4
12255 3 00014 4 12260 TXH SHANK,4,12 CHECK FOR 8-4 MINUS
12256 -3 00013 4 12260 TXL SHANK,4,11
12257 0774 00 4 00040 AXT 32,4 CHANGE 8-4 MINUS TO 11 MINUS
12260 1 06127 4 12261 SHANK TXI *+1,4,$H00 POINTER TO NEW CHARACTER OBJECT
12261 0500 00 0 12635 BACON CLA $CHACT BUMP CHARACTER COUNT
12262 0400 00 0 00371 ADD $Q1
12263 0601 00 0 12635 STO $CHACT
12264 -0754 00 4 00000 PXD ,4 SET CURCHAR TO NEW CHARACTER
12265 0602 00 0 12634 SLW $CURC POINTER IN DECREMENT FOR BIN
12266 0634 00 4 12633 SXA $CURC1,4 POINTER IN ADDRESS FOR APVAL1
12267 -0534 00 4 12220 LXD PORK,4 RESTORE IR4
12270 0020 00 4 00001 TRA 1,4 RETURN
12271 0534 00 4 00522 RUMP LXA EOF,4 END OF FILE CHARACTER
12272 0020 00 0 12314 TRA JEAN
12273 -0634 00 4 12220 ENDRED SXD PORK,4 SAVE IR4 FOR EXIT (ENDREAD ENTRANCE)
12274 -0634 00 0 12236 SXD CHPOS,0 SET CHARACTER POSITION AND WORD
12275 -0634 00 0 12237 SXD WDNUM,0 NUMBER AT END OF RECORD
12276 -0520 00 0 12517 STEW NZT ERSIG TEST IF ERROR PRINTOUT NEEDED
12277 0020 00 0 12313 TRA SUZIE
12300 0074 00 4 05214 TSX TERPRI,4 PRINT BLANK LINE
12301 0074 00 4 01222 TSX OUTPUT,4 PRINT UPPER ERROR BUFFER
12302 0 00000 0 00364 BCDOUT
12303 0 00015 0 12520 ERBFU-13,,13
12304 0074 00 4 01222 TSX OUTPUT,4 PRINT BAD LINE
12305 0 00000 0 00364 BCDOUT
12306 0 00015 0 12535 BUFF-13,,13
12307 0074 00 4 01222 TSX OUTPUT,4 PRINT LOWER ERROR BUFFER
12310 0 00000 0 00364 BCDOUT
12311 0 00015 0 12555 ERBFL-13,,13
12312 0074 00 4 05214 TSX TERPRI,4 PRINT BLANK LINE
12313 0534 00 4 00523 SUZIE LXA EOR,4 LOAD END OF RECORD CHARACTER
12314 0600 00 0 12604 JEAN STZ EORTS
12315 0020 00 0 12261 TRA BACON
12316 -0634 00 4 01562 RIBS SXD $ERROR,4
12317 0074 00 4 01563 TSX $ERROR+1,4
12320 542330600354 BCI 1,*CH 3*
* TAPE READING ERROR -ADVANCE, STARTREAD-
00471 SEVNS SYN SEVENS
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 111
SPACE 5
ALPHABETIC FUNCTIONS
LITER(CHAR)
12321 -0634 00 4 12336 LITER SXD AL1,4
12322 -0737 00 4 00000 PDC 0,4
12323 0500 00 0 12440 CLA A2
12324 0402 00 4 04270 AL3 SUB CHTYP-$H00,4 COMPARE WITH TABLE ENTRY
12325 -0534 00 4 12336 LXD AL1,4
12326 -0100 00 0 12331 TNZ AL6
12327 0500 00 0 00442 CLA $QD1 EXIT WITH T
12330 0020 00 4 00001 TRA 1,4
12331 -0754 00 0 00000 AL6 PXD ,0 EXIT WITH F
12332 0020 00 4 00001 TRA 1,4
OPCHAR(CHAR)
12333 -0634 00 4 12336 OPCHAR SXD AL1,4
12334 -0737 00 4 00000 PDC 0,4
12335 0500 00 0 12437 CLA A3
12336 1 00000 0 12324 AL1 TXI AL3,,0
DIGIT(CHAR)
12337 0340 00 0 00524 DIGIT CAS HOL9
12340 0020 00 0 12344 TRA AL5
12341 0761 00 0 00000 NOP
12342 0500 00 0 00442 CLA $QD1
12343 0020 00 4 00001 TRA 1,4
12344 -0754 00 0 00000 AL5 PXD ,0
12345 0020 00 4 00001 TRA 1,4
SPACE 5
* ERROR1
*
* ER1 CREATES A VISUAL POINTER IN ERBFU AND ERBFL
* TO A READING ERROR
*
12346 -0625 00 0 12517 EROR1 STL ERSIG TURN ON ERROR SIGNAL
12347 0634 00 4 12363 SXA ERIR,4 SAVE IR4
12350 0500 00 0 00375 CLA $Q5 V FOR UPPER BUFFER
12351 0560 00 0 00424 LDQ OCT41 A FOR LOWER BUFFER
12352 -0535 00 4 12236 LDC CHPOS,4 SHIFT BOTH LETTERS INTO POSITION
12353 -0763 00 4 77772 LGL -6,4
12354 -0534 00 4 12237 LXD WDNUM,4
12355 -3 00000 4 12362 TXL ERX,4,0 DO NOTHING IF END OF RECORD
12356 -0602 00 4 12535 ORS ERBFU,4 INSERT V INTO UPPER BUFFER
12357 -0130 00 0 00000 XCL
12360 0322 00 4 12572 ERA ERBFL,4 INSERT A INTO LOWER BUFFER
12361 0602 00 4 12572 SLW ERBFL,4
12362 -0754 00 0 00000 ERX PXD ,0
12363 0774 00 4 00000 ERIR AXT **,4 RESTORE IR4
12364 0020 00 4 00001 TRA 1,4 EXIT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 112
SPACE 5
* UNPACK(NAME)
*
* UNPACK(NAME) GIVES A LIST OF THE CHARACTER OBJECTS
* IN THE CELL -NAME-, UP TO THE FIRST 77.
*
12365 0634 00 4 12414 UNPACK SXA UPI4,4 SAVE IR2 AND IR4
12366 0634 00 2 12415 SXA UPI2,2
12367 -0734 00 4 00000 PDX ,4 PUT ARGUMENT CELL IN MQ
12370 0560 00 4 00000 LDQ 0,4
12371 0774 00 2 00006 AXT 6,2
12372 -0754 00 0 00000 UP2 PXD ,0 LOOK AT A CHARACTER
12373 -0763 00 0 00006 LGL 6
12374 0340 00 0 00413 CAS $Q63
12375 1 00001 2 12401 TXI UP1,2,1 ADJUST IR2 FOR CHARACTER
12376 1 00001 2 12401 TXI UP1,2,1 COUNT
12377 0601 00 2 12602 STO T1+6,2 STORE THE CHARACTER
12400 2 00001 2 12372 TIX UP2,2,1
12401 0600 00 0 03654 UP1 STZ UPLST SET END OF LIST TO NIL
12402 3 00006 2 12412 UP4 TXH UP3,2,6 EXIT IF ALL CHARACTERS LISTED
12403 0500 00 2 12602 CLA T1+6,2 PICK UP NEXT CHARACTER
12404 0400 00 0 00521 ADD HORG AND FORN OBJECT
12405 0767 00 0 00022 ALS 18
12406 0560 00 0 03654 LDQ UPLST
12407 0074 00 4 03730 TSX $CONS,4 PUT CHAR AT HEAD OF LIST
12410 0601 00 0 03654 STO UPLST
12411 1 00001 2 12402 TXI UP4,2,1
12412 0500 00 0 03654 UP3 CLA UPLST RETURN WITH LOCATION OF LIST
12413 0600 00 0 03654 STZ UPLST AVOID UNNECESSARY GARBAGE COLL.
12414 0774 00 4 00000 UPI4 AXT **,4
12415 0774 00 2 00000 UPI2 AXT **,2
12416 0020 00 4 00001 TRA 1,4 EXIT
*
* THIS ROUTINE USES $CONS
SPACE 5
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
STORAGE
00521 HORG SYN $H00A
00522 EOF SYN $H12A
00523 EOR SYN $H72A
00524 HOL9 SYN $H11D
00525 HOL14 SYN $H14D
00530 HOL40 SYN $H40D
TITLE
12417 +000000000001 CHTYP DEC 1,1,1,1,1,1,1,1 0 = ILLEGAL CHARACTER
12427 +000000000001 DEC 1,1,4,3,3,0,0,0 1 = DIGIT
12437 +000000000003 DEC 3,2,2,2,2,2,2,2 2 = LETTER
12447 +000000000002 DEC 2,2,4,4,4,0,0,0 3 = OPERATION CHARACTER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 113
12457 +000000000003 DEC 3,2,2,2,2,2,2,2 4 = OTHER
12467 +000000000002 DEC 2,2,4,4,3,0,0,0
12477 +000000000004 DEC 4,3,2,2,2,2,2,2
12507 +000000000002 DEC 2,2,4,4,4,0,0,0
DETAIL
00370 ZERO SYN $ZERO
12417 A1 SYN CHTYP
12440 A2 SYN CHTYP+17
12437 A3 SYN CHTYP+16
00424 OCT41 SYN $QO41
00412 A36 SYN $Q36
12517 ERSIG BSS 1 ERROR INDICATOR
12520 006060606060 BCI 1,0 DOUBLE SPACE UNDER PROGRAMM CONTROL
12535 ERBFU BES 12 UPPER ERROR BUFFER
12535 606060606060 BCI 1, SINGLE SPACE UNDER PROGRAM CONTROL
12552 BUFF BES 12 BUFFER FOR INPUT RECORD
12555 BES 3 ROOM FOR EXTRA WORDS IN READ-IN
12555 606060606060 BCI 1, SINGLE SPACE UNDER PROGRAM CONTROL
12572 ERBFL BES 12 LOWER ERROR BUFFER
12572 PWORD BSS 1
12573 0 00001 0 12605 PARAM PZE BOFFO-20,,1
00476 FLOS SYN FLOATD
12574 T1 BSS 7
00475 FIXS SYN $FIXD
12603 CHARS BSS 1
12604 EORTS BSS 1 NONZERO INDICATES EOR OUTPUT CHAR
12631 BOFFO BES 20
12631 BSS 1 JUNK WORD FOR BOFFO REMNANTS
03654 UPLST SYN BBPNT CUMULATIVE LIST OF CHARACTERS
12632 BSS 1
12633 0 00000 0 00000 CURC1 PZE POINTER APPEARS IN ADDRESS
12634 0 00000 0 00000 CURC PZE POINTER APPEARS IN DECREMENT
12635 0 00000 0 00000 CHACT PZE CHARACTER COUNT
*
* MKNO A FUNCTION OF TWO ARGUMENTS, THE FIRST IS A NUMBER, THE SECO
* ND IS A TYPE (FLO OR FIX), MKNO FORMS A NON UNIQUE NUMBER
12636 0634 00 4 12660 MKNO SXA MKIR,4 SAVE LINK IR
12637 -0600 00 0 03656 STQ MKT1 TYPE OF NUMBER TO MQ
12640 0074 00 4 03710 TSX $CONSW,4
12641 0131 00 0 00000 XCA
12642 0500 00 0 00460 CLA $DMASK
12643 0074 00 4 03730 TSX $CONS,4
12644 -0534 00 4 03656 LXD MKT1,4 TYPE TO IR 4
12645 0622 00 0 03656 STD MKT1
12646 0500 00 0 00441 CLA $QT5 ASSUME IT IS OCTAL
12647 -3 10134 4 12652 TXL *+3,4,$FIX-1
12650 3 10135 4 12652 TXH *+2,4,$FIX
12651 0500 00 0 00436 CLA $QT1
12652 -3 10117 4 12655 TXL *+3,4,$FLOAT-1
12653 3 10120 4 12655 TXH *+2,4,$FLOAT
12654 0500 00 0 00437 CLA $QT2
12655 -0534 00 4 03656 LXD MKT1,4 LOCATION OF NUMBER
12656 -0602 00 4 00000 ORS 0,4 PUT IN NUMBER FLAG
12657 -0754 00 4 00000 PXD 0,4 ANSWER TO AC
12660 0774 00 4 00000 MKIR AXT **,4 RESTORE LINK IR
12661 0020 00 4 00001 TRA 1,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 114
*
*
H HED
* LOGOR, LOGAND, AND LOGXOR
*
* THESE FUNCTIONS TAKE THE LOGICAL AND, LOGICAL OR, AND LOGICAL
* EXCLUSIVE OR RESPECTIVELY OF THEIR ARGUMENTS, WHICH ARE NUMBER
* OBJECTS. THE RESULT IS AN OCTAL NUMBER OBJECT.
*
12662 0100 00 4 00001 LOGOR TZE 1,4 RETURN 0 IF 0 INPUT
12663 -0634 00 4 12756 SXD T1,4 SAVE IR4
12664 0774 00 4 07706 AXT -$)PJ37,4 LOGOR ATOM
12665 0634 00 4 12756 SXA T1,4 SET FUNCTION ON PDL
12666 0074 00 4 02312 TSX $SAVE,4
12667 -3 12760 0 02401 TXL $END1,,T1+2 SAVE 1 ITEM
12670 0074 00 4 15774 TSX $EVLIS,4 EVALUATE LIST OF ARGUMENTS
12671 0074 00 4 02326 TSX UNSAVE,4
12672 0560 00 0 00370 LDQ $ZERO OR OF NO ARGUMENTS
12673 -0600 00 0 12757 STQ T1+1
12674 0560 00 0 12747 LDQ ORS INSTRUCTION FOR INNER LOOP
12675 0020 00 0 12725 TRA LOG2
*
12676 0100 00 4 00001 LOGAND TZE 1,4 EXIT WITH 0 IF 0 INPUT
12677 -0634 00 4 12756 SXD T1,4 SAVE IR4
12700 0774 00 4 07676 AXT -$)PJ36,4 LOGAND ATOM
12701 0634 00 4 12756 SXA T1,4 SET FUNCTION ON PDL
12702 0074 00 4 02312 TSX $SAVE,4
12703 -3 12760 0 02401 TXL $END1,,T1+2 SAVE 1 ITEM
12704 0074 00 4 15774 TSX $EVLIS,4 EVALUATE LIST OF ARGUMENTS
12705 0074 00 4 02326 TSX UNSAVE,4
12706 0560 00 0 00471 LDQ SEVENS AND OF NO ARGUMENT
12707 -0600 00 0 12757 STQ T1+1
12710 0560 00 0 12750 LDQ ANS INSTRUCTION FOR INNER LOOP
12711 0020 00 0 12725 TRA LOG2
*
12712 0100 00 4 00001 LOGXOR TZE 1,4 EXIT WITH 0 IF 0 INPUT
12713 -0634 00 4 12756 SXD T1,4 SAVE IR4
12714 0774 00 4 07666 AXT -$)PJ38,4 LOGXOR ATOM
12715 0634 00 4 12756 SXA T1,4 SET FUNCTION ON PDL
12716 0074 00 4 02312 TSX $SAVE,4
12717 -3 12760 0 02401 TXL $END1,,T1+2 SAVE 1 ITEM
12720 0074 00 4 15774 TSX $EVLIS,4 EVALUATE LIST OF ARGUMENTS
12721 0074 00 4 02326 TSX UNSAVE,4
12722 0560 00 0 00370 LDQ $ZERO RIGNSUM OF NO ARGUMENTS
12723 -0600 00 0 12757 STQ T1+1
12724 0560 00 0 12751 LDQ ERS TRA TO INSTRUCTIONS FOR INNER LOOP
* COMMON PART OF LOGAND, LOGOR AND LOGXOR
12725 -0600 00 0 12737 LOG2 STQ LOG5
12726 0634 00 2 12745 SXA LOG4,2 SAVE IR2
12727 -0734 00 2 00000 PDX ,2 POINTER TO ARGUMENT LIST
* FORM THE PROPER LOGICAL COMBINATION OF THE ARGUMENTS
12730 0500 00 2 00000 LOG1 CLA 0,2 1
12731 -0734 00 2 00000 PDX 0,2 CDR(L)
12732 0734 00 4 00000 PAX 0,4
12733 -0754 00 4 00000 PXD 0,4 CAR(L)
12734 0074 00 4 14342 TSX NUMVAL,4 GET NUMBER FOR THIS ELEMENT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 115
12735 -0734 00 4 00000 PDX 0,4
12736 -0500 00 4 00000 CAL 0,4
12737 0 00000 0 00000 LOG5 ** INSTRUCTION SET EARLIER
12740 3 00000 2 12730 TXH LOG1,2,0 LOOP AGAIN IF CDR(L) NOT NULL
* RETURN A POINTER TO THE RESULT
12741 -0500 00 0 12757 LOG6 CAL T1+1 PICK UP RESULT
12742 0560 00 0 00503 LDQ $OCTD MAKE AN OBJECT OF IT
12743 0074 00 4 12636 TSX $MKNO,4
12744 -0534 00 4 12756 LXD T1,4 RESTORE IR4 AND IR2
12745 0774 00 2 00000 LOG4 AXT **,2
12746 0020 00 4 00001 TRA 1,4
* INSTRUCTIONS TO BE INSERTED IN INNER LOOP
12747 -0602 00 0 12757 ORS ORS T1+1
12750 0320 00 0 12757 ANS ANS T1+1
12751 0020 00 0 12752 ERS TRA *+1 TRA SINCE ERS TAKES 2 INSTRUCTIONS
12752 0322 00 0 12757 ERA T1+1
12753 0602 00 0 12757 SLW T1+1
12754 3 00000 2 12730 TXH LOG1,2,0
12755 0020 00 0 12741 TRA LOG6
*
12756 -000000000000 T1 OCT -0,-0 STORAGE FOR LOGAND, ETC.
12757 -000000000000
* THIS ROUTINE USES NUMVAL,$MKNO,$ZERO,AND SEVENS
SPACE 5
* LEFTSHIFT(X,N)
*
* IF N IS +, X IS SHIFTED LEFT N PLACES.
* IF N IS -, X IS SHIFTED RIGHT -N PLACES.
* BOTH INPUTS MUST BE NUMERICAL OBJECTS.
*
12760 0634 00 4 13003 LSHIFT SXA LSH1,4 SAVE IR4
12761 0634 00 2 13002 SXA LSH4,2 SAVE IR2
12762 0601 00 0 12756 STO T2 SAVE X
12763 0131 00 0 00000 XCA
12764 -0734 00 2 00000 PDX 0,2 FIND VALUE OF N
12765 0074 00 4 13075 TSX FIXVAL,4
12766 0774 00 4 77100 AXT 7*4096+7*512+1*64,4 SET UP ARS
12767 -0120 00 0 12771 TMI LSH2 IF NEGATIVE, SET UP ARS
12770 0774 00 4 76700 AXT 7*4096+6*512+7*64,4 SET UP ALS
12771 -0634 00 4 12777 LSH2 SXD LSH3,4 PUT OP CODE INTO INSTRUCTION
12772 0621 00 0 12777 STA LSH3
12773 0500 00 0 12756 CLA T2 FIND VLAUE OF X
12774 0074 00 4 14342 TSX NUMVAL,4
12775 -0734 00 4 00000 PDX 0,4
12776 -0500 00 4 00000 CAL 0,4
12777 0767 00 0 00000 LSH3 ALS ** THIS INSTRUCTION WAS SET UP EARLIER
13000 0560 00 0 00503 LDQ $OCTD FORM OCTAL NUMBER
13001 0074 00 4 12636 TSX $MKNO,4
13002 0774 00 2 00000 LSH4 AXT **,2 RESTORE IR2
13003 0774 00 4 00000 LSH1 AXT **,4
13004 0020 00 4 00001 TRA 1,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 116
12756 T2 SYN T1
*
* THIS ROUTINE USES $MKNO,$OCTD,AND NUMVAL
Q HED
*
*
* ARYGET THE FUNCTION THAT GETS AND SETS THE VALUES OF ARRAYS
* USED IN LISP AS FOLLOWS ...
* TO GET A VALUE (NAME,D1,D2,D3)
* TO SET A VLUAE (NAME,SET,VALUE,D1,D2,D3)
*
* THE CALLING SEQUENCE IS AS FOLLOWS
* SXA ARYGTX,4
* TSX ARYGET,4
* PZE LOCATION OF TABLE 1,,NUMBER OF DIMENSIONS
*
13005 0634 00 2 13044 ARYGET SXA ARYY,2 SAVE INDEX REGISTER
13006 0634 00 1 13045 SXA ARYZ,1
13007 0601 00 0 13072 STO AGAO SAVE ARGUMENT 1
13010 0500 00 4 00003 CLA 3,4 TABLE ZERO PARAMETER WORD
13011 0621 00 0 13042 STA AGXEX ADDRESS OF END OF TABLE 1
13012 -0734 00 2 00000 PDX 0,2 NUMBER OF DIMENSIONS
13013 -0600 00 0 13073 STQ AGAT ARG 2
13014 0500 00 0 03321 CLA $ARG3
13015 0601 00 0 13074 STO AGATH ARGUMENT 3
13016 0500 00 0 13070 CLA AX XEC INSTRUCTION
13017 -0534 00 4 13072 LXD AGAO,4 GET ARG 1
13020 -3 07031 4 13032 TXL AGN,4,$SET-1 TEST FOR SET OPERATION
13021 3 07032 4 13032 TXH AGN,4,$SET GO ON IF NOT $SET
13022 -0600 00 0 13071 STQ AGV IS SET SAVE VALUE
13023 0500 00 0 03321 CLA $ARG3
13024 0601 00 0 13072 STO AGAO DIMENSION 1
13025 0500 00 0 03322 CLA $ARG4
13026 0601 00 0 13073 STO AGAT DIMENSION 2
13027 0500 00 0 03323 CLA $ARG5
13030 0601 00 0 13074 STO AGATH DIMENSION 3
13031 0500 00 0 13067 CLA AXS XEC* INSTRUCTION
13032 0622 00 0 13042 AGN STD AGXEX SET UP FETCH OR STORE INSTUCTION
13033 3 00002 2 13047 TXH AGDTH,2,2 GO IF 3 D ARRAY
13034 3 00001 2 13056 TXH AGDT,2,1 GO IF 2 D ARRAY
13035 -0534 00 2 13072 LXD AGAO,2 DIMENSION 1
13036 0074 00 4 13075 TSX FIXVAL,4 EVALUATE THE FIXED POINT NUMBER
13037 0734 00 1 00000 PAX 0,1 INTO PROPER INDEX
13040 0774 00 6 00000 AXT 0,6 ZERO INDEX REGISTERS
13041 0500 00 0 13071 AGXE CLA AGV GET THE VALUE
13042 0522 00 4 00000 AGXEX XEC **,4 FETCH BY XEC OR STORE BY XEC*
13043 0774 00 4 00000 ARYGTX AXT **,4 RESTORE INDEX REGISTERS
13044 0774 00 2 00000 ARYY AXT **,2
13045 0774 00 1 00000 ARYZ AXT **,1
13046 0020 00 4 00001 TRA 1,4
*
13047 -0534 00 2 13074 AGDTH LXD AGATH,2 DIMENSION 3
13050 0074 00 4 13075 TSX FIXVAL,4 EVALUATE AS A FIXED POINT NUMBER
13051 0734 00 1 00000 PAX 0,1 INTO INDEX
13052 -0534 00 2 13072 LXD AGAO,2 DIMENSION 1
13053 0074 00 4 13075 TSX FIXVAL,4 EVALUATE IT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 117
13054 0621 00 0 13065 STA AGR SET UP AXT INSTRUCTION
13055 0020 00 0 13062 TRA AGD GO EVALUATE DIMENSUON 2
*
13056 0634 00 0 13065 AGDT SXA AGR,0 PRESET AXT INSTRUCTION
13057 -0534 00 2 13072 LXD AGAO,2 DIMENSION 1
13060 0074 00 4 13075 TSX FIXVAL,4 FIXED POINT NUMBER EVALUATION
13061 0734 00 1 00000 PAX 0,1 INTO INDEX 1
13062 -0534 00 2 13073 AGD LXD AGAT,2 DIMENSION 2
13063 0074 00 4 13075 TSX FIXVAL,4 FIXED POINT NUMBER EVALUATION
13064 0734 00 2 00000 PAX 0,2 INTO INDEX 2
13065 0774 00 4 00000 AGR AXT **,4 ZERO OR DIMENSION 1
13066 0020 00 0 13041 TRA AGXE GO BACK TO MAIN PROGRAM
*
A 13067 0522 60 0 00000 AXS XEC* THE STORE INSTRUCTION
A 13070 0522 00 0 00000 AX XEC THE FETCH INSTRUCTION
13071 0 00000 0 00000 AGV VALUE TO BE STORED PUT HERE
13072 0 00000 0 00000 AGAO DIMENSION 1
13073 0 00000 0 00000 AGAT DIMENSION 2
13074 0 00000 0 00000 AGATH DIMENSION 3
*
* FIXVAL
*
* FIXVAL HAS AS INPUT A POINTER TO A FIXED POINT NUMBER OBJECT IN
* IR2, AND HANDS BACK THE NUMERICAL VALUE OF THAT OBJECT.
*
13075 0634 00 2 13106 FIXVAL SXA FXVE,2 SAVE IR2 IN CASE OF ERROR
13076 0500 00 2 00000 CLA 0,2
13077 0734 00 2 00000 PAX 0,2
13100 -3 77776 2 13106 TXL FXVE,2,-2 ERROR IF NOT ATOMIC
13101 -0734 00 2 00000 PDX 0,2
13102 -0320 00 0 00436 ANA $QT1
13103 0100 00 0 13106 TZE FXVE
13104 0500 00 2 00000 CLA 0,2 PICK UP VALUE
13105 0020 00 4 00001 TRA 1,4 NORMAL EXIT
13106 0774 00 2 00000 FXVE AXT **,2 IR2 SHOULD LAND IN DECR. OF AC
13107 -0634 00 4 01562 SXD $ERROR,4
13110 -0754 00 2 00000 PXD 0,2 IT DOES INDEED LAND THERE
13111 0074 00 4 01563 TSX $ERROR+1,4
13112 543160600454 BCI 1,*I 4* BAD ARGUMENT -- FIXVAL
*
*
* ARYMAK THE FUNCTION THAT MAKES ARRAYS
* THE ARGUMENT IS A SINGLE LIST WHOSE SUB-LISTS HAVE THE
* FORM (NAME,(DIMENSION1,DIMENSION2,DIMENSION3),TYPE)
* ARRAYS MAY BE 1, 2, OR 3 DIMENSIONAL AND MAY BE OF LIST OR
* NON-LIST TYPE.
*
* ARRAY IS STORED AS FOLLOWS ...
* SXA ARTGTX,4 ADDRESS OF SUBR TXL INSTRUCTION
* TSX ARYGET,4
* PZE END + 1,, N OF DIMENSIONS (ARRAY PROPERTY POINTS HERE)
* PZE TOTAL LENGTH,,LIST OF LENGTH
* PZE TABLE ZERO,, NUMBER OF DIMENSIONS (ARYGET PARAMETER WORD)
* CLA* **,2 TABLE 1
* *************************
* STO **,1 TABLE 2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 118
* *****************************
* ARRAY PROPER GOES HERE
*
13113 0560 00 0 13115 ARYMAK LDQ AMFAG PICK UP FUNCTIONAL ARGUMENT
13114 0020 00 0 04214 TRA MAPLIS LET MALPIST HANDLE ITERATION ALONG LIS
*
13115 -3 00001 0 13116 AMFAG TXL *+1,,1 FUNCTIONAL ARGUMENT
13116 0634 00 4 13320 SXA AFRX,4 SAVE INDEX REGISTERS
13117 0634 00 2 13321 SXA AFRY,2
13120 -0734 00 4 00000 PDX 0,4 POINTER TO LIST
13121 0500 00 4 00000 CLA 0,4
13122 0734 00 4 00000 PAX 0,4 POINTER TO SUBLIST
13123 -0500 00 4 00000 CAL 0,4
13124 0734 00 4 00000 PAX 0,4 NAME
13125 -0634 00 4 03504 SXD AFAT,4 SAVE IT
13126 -0734 00 4 00000 PDX 0,4
13127 0500 00 4 00000 CLA 0,4
13130 0734 00 2 00000 PAX 0,2 POINTER TO DIMENSION LIST
13131 -0734 00 4 00000 PDX 0,4
13132 0500 00 4 00000 CLA 0,4
13133 0734 00 4 00000 PAX 0,4 TYPE
13134 0600 00 0 13336 STZ ATYP
13135 -3 07735 4 13140 TXL ADA,4,$LIST-1 GO IF NOT $ LIST
13136 3 07736 4 13140 TXH ADA,4,$LIST
13137 -0634 00 4 13336 SXD ATYP,4 MAKES ATYPE NON-ZERO FOR LIST ARRAYS
13140 0500 00 2 00000 ADA CLA 0,2 FIRST WORD ON DIMENSION LIST
13141 0734 00 2 00000 PAX 0,2 DIMENSION 1
13142 0622 00 0 03505 STD ATMP POINTER TO REST
13143 0074 00 4 13075 TSX FIXVAL,4 EVALUATE THE FIXED POINT NUMBER
13144 0601 00 0 13340 STO ADO DIMENSION 1
13145 -0534 00 4 03505 LXD ATMP,4 PICK UP POINTER TO REST OF LIST
13146 -3 00000 4 13164 TXL AOD,4,0 GO IF 1 D
13147 0500 00 4 00000 CLA 0,4 NEXT WORD
13150 0622 00 0 03505 STD ATMP SAVE POINTER
13151 0734 00 2 00000 PAX 0,2 DIMENSION 2
13152 0074 00 4 13075 TSX FIXVAL,4 GET NUMBER VALUE
13153 0601 00 0 13341 STO ADT DIMENSION 2
13154 -0534 00 4 03505 LXD ATMP,4 POINTER TO REST OF LIST
13155 -3 00000 4 13173 TXL ATD,4,0 GO IF 2 D ARRAY
13156 0500 00 4 00000 CLA 0,4
13157 0734 00 2 00000 PAX 0,2 DIMENSION 3
13160 0074 00 4 13075 TSX FIXVAL,4 NUMBER VALUE
13161 0601 00 0 13342 STO ADTH DIMENSION 3
13162 0774 00 2 00003 AXT 3,2 NUMBER OF DIMENSIONS
13163 0020 00 0 13177 TRA AGA GO TO NEXT PART OF PROGRAM
13164 0500 00 0 13340 AOD CLA ADO 1D, TREAT AS A 1 X 1 X D1 ARRAY
13165 0601 00 0 13342 STO ADTH
13166 0500 00 0 00371 CLA $Q1
13167 0601 00 0 13341 STO ADT DIMENSION 2
13170 0601 00 0 13340 STO ADO DIMENSION 1
13171 0774 00 2 00001 AXT 1,2 1 D ARRAY
13172 0020 00 0 13177 TRA AGA GO NEXT PART
13173 0500 00 0 13340 ATD CLA ADO 2 D, TREAT AS A 1 X D2 X D1 ARRAY
13174 0500 00 0 00371 CLA $Q1
13175 0601 00 0 13340 STO ADO DIMENSION 1
13176 0774 00 2 00002 AXT 2,2 2 D ARRAY
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 119
13177 0560 00 0 13340 AGA LDQ ADO DIMENSION 1
13200 -0754 00 0 00000 PXD 0,0 ZERO AC
13201 0200 00 0 13341 MPY ADT DIMENSION 2
13202 -0600 00 0 13335 STQ ADOT D1 X D2
13203 0200 00 0 13342 MPY ADTH DIMENSION 3
13204 0520 00 0 13336 ZET ATYP SKIP NEXT IF NON-LIST ARRAY
13205 -0600 00 0 13336 STQ ATYP LIST LENGTH
13206 0131 00 0 00000 XCA D1 X D2 X D3 TO AC
13207 0400 00 0 13335 ADD ADOT ADD INDEX TABLE LENGTHS
13210 0400 00 0 13340 ADD ADO
13211 0400 00 0 00375 ADD $Q5 CONSTANT LENGTH
13212 0621 00 0 13333 STA APWT PARAMETER WORD TWO
13213 0621 00 0 13337 STA ATMQ SAVE LENGTH
13214 0534 00 4 13336 LXA ATYP,4 ZERO OR LIST LENGTH
13215 0634 00 4 13333 SXA APWT,4 PARAMETER WORD 2
13216 0074 00 4 04004 TSX BLOCKR,4 RESERVE A BLOCK OF THIS LENGTH
13217 0100 00 0 13323 TZE ARYTL GO IF ARRAY WILL NOT FIT
13220 0621 00 0 03505 STA ATMP END OF BLOCK ADDRESS
13221 0400 00 0 00371 ADD $Q1 ADD 1
13222 0621 00 0 13332 STA APWO PARAMETER WORD 1
13223 -0634 00 2 13334 SXD ATBZ,2 NUMBER OF DIMENSIONS
13224 -0634 00 2 13332 SXD APWO,2
13225 -0634 00 2 13343 SXD ASBR,2
13226 0402 00 0 13337 SUB ATMQ LENGTH OF BLOCK
13227 0621 00 0 13343 STA ASBR ADDRESS OF BEGINNING OG BLOCK
13230 0737 00 4 00000 PAC 0,4 POINTER IN IR 4
13231 1 77776 4 13232 TXI *+1,4,-2 POINTER TO ARRAY PROPERTY
13232 -0634 00 4 13344 SXD AARY,4 SAVE POINTER
13233 0737 00 4 00000 PAC 0,4 POINTER TO BEGINNING OF ARRAY
13234 0400 00 0 00374 ADD $Q4 LENGTH OF PREFIX - 1
13235 0400 00 0 13340 ADD ADO
13236 0621 00 0 13334 STA ATBZ LAST LOC. IN TAQBLE ONE
13237 0774 00 2 00005 AXT 5,2 LENGTH OF PREFIX TO ARRAY
13240 0500 00 2 13335 ACLA CLA ADOT,2 PICK UP PREFIX
13241 0601 00 4 00000 STO 0,4 AND STORE IN CORE
13242 1 77777 4 13243 TXI *+1,4,-1 UPDTAEC CORE LOCATION
13243 2 00001 2 13240 TIX ACLA,2,1 GET REST OF PREFIX
13244 -0320 00 0 00457 ANA $AMASK TABLE ZERO IN AC
13245 -0501 00 0 13345 ORA ACLAS OR IN CLA* INSTRUCTION
13246 0534 00 2 13340 LXA ADO,2 LENGTH OF TABLE
13247 0400 00 0 13341 AADD ADD ADT INCREMENT BY DIMENSION 2
13250 0601 00 4 00000 STO 0,4 PUT IN CODE
13251 1 77777 4 13252 TXI *+1,4,-1 UP DATE CORE COUNTER
13252 2 00001 2 13247 TIX AADD,2,1 FINISH OFFF
13253 0534 00 2 13335 LXA ADOT,2 LENGTH OF TABLE 2
13254 -0320 00 0 00457 ANA $AMASK CLEAR OUT ALL BUT ADDRESS
13255 -0501 00 0 13346 ORA ARSTO PUT INSTRUCTION
13256 0400 00 0 13342 AAA ADD ADTH ADD DIMENSION 3
13257 0601 00 4 00000 STO 0,4 PUT IN CORE
13260 1 77777 4 13261 TXI *+1,4,-1 UPDATE CORE COUNTER
13261 2 00001 2 13256 TIX AAA,2,1 CONTINUE TO CONSTRUCT TABLE
* TABLE CONSTRUCTION ALL DONE.
* THE FOLLOWING ADDS PROPERTYS TO THE ARYATOM
13262 0500 00 0 13344 CLA AARY PICK UP POINTER TO TO ARRAY PROPERTY
13263 0560 00 0 00370 LDQ $ZERO
13264 0074 00 4 03730 TSX $CONS,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 120
13265 0560 00 0 00370 LDQ $ZERO
13266 0074 00 4 03730 TSX $CONS,4
13267 0131 00 0 00000 XCA
13270 0500 00 0 13347 CLA ARY POINTER TO ATOMIC SYMBOL ARRAY
13271 0074 00 4 03730 TSX $CONS,4 (ARRAY,(POINTER TO ARRAY PROPERTY))
13272 0601 00 0 03505 STO ATMP SAVE IN TEMP STORAGE
13273 0500 00 0 13343 CLA ASBR TXL INSTRUCTIONM
13274 0074 00 4 03710 TSX $CONSW,4 PUT IN FULL WORD SPACE
13275 0560 00 0 03505 LDQ ATMP REST OF PROPERTIES
13276 0074 00 4 03730 TSX $CONS,4
13277 0131 00 0 00000 XCA
13300 0500 00 0 00506 CLA ASB POINTER TO $SUBR ATOMIC SYMBOL
13301 0074 00 4 03730 TSX $CONS,4
13302 0131 00 0 00000 XCA SAVE IN MQ
13303 -0534 00 4 03504 LXD AFAT,4 POINTER TO NAME
13304 0500 00 4 00000 CLA 0,4 FIRST WORD
13305 -0734 00 4 00000 PDX 0,4 SAVE POINTER TO REST
13306 -0754 00 4 00000 PXD 0,4 PUT IN AC
13307 0131 00 0 00000 XCA INTER CHANGE AC AND MQ
13310 0074 00 4 07675 TSX $NCONC,4 SPLICE 2 LISTS TOGETHER
13311 -0534 00 4 03504 LXD AFAT,4 POINTER TO FIRST WORD ON PROPERTY LIST
13312 0622 00 4 00000 STD 0,4 REPLACE DECREMENT OPERATION
13313 -0754 00 4 00000 PXD 0,4 POINTER TO ARRY ATOM
13314 0560 00 0 03305 LDQ ARYLIS PICK UP ARRAY LIST
13315 0074 00 4 03730 TSX $CONS,4 PUT ON AS ACTIVE ARRAY
13316 0622 00 0 03305 STD ARYLIS UPDATE ARRAY LIST
13317 0500 00 0 03504 CLA AFAT FINAL ANSWER
13320 0774 00 4 00000 AFRX AXT **,4 RESTORE INDEX REGISTERS
13321 0774 00 2 00000 AFRY AXT **,2
13322 0020 00 4 00001 TRA 1,4 EXIT
*
13323 -0634 00 4 01562 ARYTL SXD $ERROR,4 SAVE INDEX 4
13324 0534 00 2 13321 LXA AFRY,2 RESTORE INDEX 2
13325 0500 00 0 03504 CLA AFAT ARRAY NAME
13326 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
13327 543160600154 BCI 1,*I 1* NOT ENOUGH ROOM FOR ARRAY
* CONSTANTS AND STORAGE
13330 0634 00 4 13043 SXA ARYGTX,4 5 WORD PREFIX TO ARRAYS
13331 0074 00 4 13005 TSX ARYGET,4
13332 0 00000 0 00000 APWO END+1,,N OF D
13333 0 00000 0 00000 APWT LENGTH,,LIST LENGTH
13334 0 00000 0 00000 ATBZ TABLE ZERO,, N OF D
13335 0 00000 0 00000 ADOT D1 X D2
13336 0 00000 0 00000 ATYP ZERO OR LIST LENGTH
13337 0 00000 0 00000 ATMQ TEMPORARY STORAGE
13340 0 00000 0 00000 ADO D1
13341 0 00000 0 00000 ADT D2
13342 0 00000 0 00000 ADTH D3
D 13343 -3 00000 0 00000 ASBR TXL **,**
13344 0 00000 0 00000 AARY POINTER TO ARRAY PROPERTY
13345 0500 60 2 00000 ACLAS CLA* **,2 FETCH INSTRUCTION
13346 0601 00 1 00000 ARSTO STO **,1 PUT INSTRUCTION
13347 0 10735 0 00000 ARY ,,$ARRAY
00506 ASB SYN $SUBRD
*
*
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 121
* UNUMIX EVALUATES ITS 2 NUMERICAL ARGUMENTS AND FLOATS THE FIXED
* POINT ARGUMENT IF A MIXED EXPRESSION. THE NUMERICAL
* VALUES ARE LEFT IN AC AND MQ WITH TYPE OF NUMBER IN $ARG3
*
13350 0634 00 4 13371 UNUMIX SXA UNUX,4 SAVE LINK IR
13351 -0600 00 0 13416 STQ UNUT SAVE SECOND ARGUMENT
13352 0074 00 4 14342 TSX NUMVAL,4 NUMERICALLY EVALUATE THE FIRST ARG
13353 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
13354 0500 00 4 00000 CLA 0,4 NUMERICAL VALUE
13355 0601 00 0 13415 STO UNUS SAVE IT
13356 -0600 00 0 13417 STQ UNUR SAVE TYPE OF NUMBER
13357 0500 00 0 13416 CLA UNUT PICK UP SECOND ARG
13360 0074 00 4 14342 TSX NUMVAL,4 NUMERICALLY EVALUATE IT
13361 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
13362 0500 00 4 00000 CLA 0,4 NUMERICAL VALUE
13363 0131 00 0 00000 XCA VLUE TO MQ, TYPE TO AC
13364 0402 00 0 13417 SUB UNUR COMPARE WITH TYPE OF FIRST
13365 -0100 00 0 13373 TNZ UNMXA TRA IF NOT SAME
13366 0500 00 0 13417 UNUE CLA UNUR PICK UP NUMBER TYPE
13367 0601 00 0 03321 STO $ARG3
13370 0500 00 0 13415 CLA UNUS PICK UP FIRST NUMERICAL VALUE
13371 0774 00 4 00000 UNUX AXT **,4 RESTORE LINK IR
13372 0020 00 4 00001 TRA 1,4 EXIT
*
13373 -0600 00 0 13416 UNMXA STQ UNUT MIXED TYPES, SAVE SECOND VALUE
13374 0634 00 2 13406 SXA UNUX2,2 SAVE IR 2
13375 -0534 00 2 13417 LXD UNUR,2 PICK UP TYPE OF FIRST NUMBER
13376 0074 00 4 14550 TSX FIXFLO,4 DISPATCH
13377 0761 00 0 00000 NOP IMPOSSIBLE RETURN
13400 0020 00 0 13410 TRA UNMXB FLOAT SECOND NUMBER
13401 0500 00 0 13415 CLA UNUS FIRST NUMBER
13402 0074 00 4 14565 TSX $UNFIX,4 FLOAT IT
13403 0560 00 0 00476 LDQ UNFLT $FLOAT FOR TYPE
13404 -0600 00 0 03321 STQ $ARG3
13405 0560 00 0 13416 LDQ UNUT SECOND NUMBER
13406 0774 00 2 00000 UNUX2 AXT **,2 RESTORE IR 2
13407 0020 00 0 13371 TRA UNUX RESTRE LINK AND EXIT
*
13410 0131 00 0 00000 UNMXB XCA FLOAT SECOND NUMBER
13411 0074 00 4 14565 TSX $UNFIX,4 FLOAT FUNCTION
13412 0131 00 0 00000 XCA BACK TO MQ
13413 0534 00 2 13406 LXA UNUX2,2 RESTORE IR 2
13414 0020 00 0 13366 TRA UNUE GET FIRST NUMBER, RESTORE LINK + EXIT
13415 0 00000 0 00000 UNUS FIRST NUMERICAL VALUE
13416 0 00000 0 00000 UNUT SECOND ARG AND VALUE
13417 0 00000 0 00000 UNUR TYPE OF FIRST ARG
00476 UNFLT SYN FLOATD FLOAT INDICATOR
*
* THIS ROUTINE USES NUMVAL,$UNFIX,FIXFLO, AND $ARG3 + $FLOAT
*
*
* DIVIDE DIVIDES THE FIRST NUMERICAL ARGUMENT BY THE SECOND. THE
* ANSWER IS A LIST OF THE QUOTIENT AND THE REMAINDER.
*
* QUOTEN GIVES THE QUOTIENT WHEN THE FIRST NUMERICAL ARGUMENT IS
* DIVIDED BY THE SECOND.
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 122
*
* REMAIN GIVES THE REMAINDER WHEN THE FIRST NUMERICAL ARGUMENT IS
* DIVIDED BY THE SECOND.
13420 0604 00 0 13510 DIVIDE STI DIVND SAVE INDICATORS
13421 0057 00 000003 RIR 3 DIIDE INDICATE
13422 0020 00 0 13432 TRA DIVOP DO OPERATION
*
13423 0604 00 0 13510 REMAIN STI DIVND SAVE INDICATORS
13424 0057 00 000003 RIR 3 DIVIDE INDICATE
13425 0055 00 000002 SIR 2 SET REMAINDER INDICATOR
13426 0020 00 0 13432 TRA DIVOP DO OPERATION
*
13427 0604 00 0 13510 QUOTEN STI DIVND SAVE INDICATORS
13430 0057 00 000003 RIR 3 DIVIDE INDICATE
13431 0055 00 000001 SIR 1 QUOTIENT INDICATOR
13432 0634 00 4 13501 DIVOP SXA DIVX,4 SAVE LINK IR
13433 0634 00 2 13500 SXA DIVX2,2 SAVE IR 2
13434 0074 00 4 13350 TSX UNUMIX,4 NUMERICALLY EVALUATE THE ARGUMENTS
13435 -0534 00 2 03321 LXD $ARG3,2 PICK UP TYPE
13436 -0600 00 0 13511 STQ DIVT SECOND ARGUMENT
13437 0074 00 4 14550 TSX FIXFLO,4 DISPATCH ON TYPE
13440 0761 00 0 00000 NOP IMPOSSIBLE RETURN
13441 0241 00 0 13511 FDP DIVT FLOATING DIVIDE
13442 0020 00 0 13471 TRA DIVFX DO FIXED POINT DIVIDE
13443 0760 00 0 00012 DIVDC DCT CHECK FOR ILLEGAL DIVISION
13444 0074 00 4 01676 TSX $DCT,4 DIVIDE CHECK ERROR
13445 0054 00 000001 RFT 1 SEE IF REMAINDER IS TO BE SAVED
13446 0020 00 0 13476 TRA DIVA NO, SET UP QUOTIENT
13447 -0600 00 0 13511 STQ DIVT YES, SAVE QUOTEINT
13450 0560 00 0 03321 LDQ $ARG3 PICK UP TYPE
13451 0074 00 4 12636 TSX $MKNO,4 MAKE REMAINDER A NUMBER
13452 0054 00 000002 RFT 2 SEST TO SEE IF QUOTIENT IS WANTED
13453 0020 00 0 13504 TRA DIVEX NO, RESTORE AND EXIT
13454 0560 00 0 00370 LDQ $ZERO NIL IN MQ
13455 0074 00 4 03730 TSX $CONS,4 LIST OF REMAINDER
13456 0131 00 0 00000 XCA SHUTTLE INTO MQ
13457 0500 00 0 13511 CLA DIVT PICK UP QUOTIENT
13460 -0600 00 0 13511 STQ DIVT SAVE LIST OF REMAINDER
13461 0560 00 0 03321 LDQ $ARG3 PICK UP TYPE
13462 0074 00 4 12636 TSX $MKNO,4 MAKE QUOTIENT A NUMBER
13463 0560 00 0 13511 LDQ DIVT LIST(REMAINDER)
13464 0074 00 4 03730 TSX $CONS,4 LIST(QUOTIENT,REMAINDER)
13465 0534 00 4 13501 LXA DIVX,4 RESTORE LINK IR
13466 0534 00 2 13500 LXA DIVX2,2 RESTORE IR 2
13467 0441 00 0 13510 LDI DIVND RESTORE INDICATORS
13470 0020 00 4 00001 TRA 1,4 EXIT
*
13471 0131 00 0 00000 DIVFX XCA FIXED POINT DIVISION. PUT ARG 1 IN MQ
13472 -0754 00 0 00000 PXD 0,0 CLEAR AC
13473 0763 00 0 00000 LLS 0 MQ SIGN TO AC
13474 0221 00 0 13511 DVP DIVT DIVIDE BY ARG 2
13475 0020 00 0 13443 TRA DIVDC PREFORM DIVIDE CHECK AND CARRY ON
13476 0131 00 0 00000 DIVA XCA QUOTIENT TO AC
13477 0560 00 0 03321 LDQ $ARG3 TYPE TO MQ
13500 0774 00 2 00000 DIVX2 AXT **,2 RESTORE IR 2
13501 0774 00 4 00000 DIVX AXT **,4 RESTORE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 123
13502 0441 00 0 13510 LDI DIVND RESTORE INDICATORS
13503 0020 00 0 12636 TRA $MKNO
*
13504 0534 00 2 13500 DIVEX LXA DIVX2,2 EXIT ROUTINE, RESTORE IR 2
13505 0534 00 4 13501 LXA DIVX,4 RESTORE LINK IR
13506 0441 00 0 13510 LDI DIVND RESTORE INDICATORS
13507 0020 00 4 00001 TRA 1,4
*
13510 0 00000 0 00000 DIVND INDICATORS STORAGE
13511 0 00000 0 00000 DIVT LIST AND NON-LIST TEMPORARY STORAGE
*
* THIS ROUTINE USES $MKNO,$DCT,$CONS,$ARG3 AND UNUMIX
*
*
* DIFFER COMPUTES THE DIFFERENCE BETWEEN ITS 2 NUMERICAL ARGUMENTS
*
13512 0634 00 4 13525 DIFFER SXA DIFX,4 SAVE LINK IR
13513 0634 00 2 13524 SXA DIFX2,2 SAVE IR 2
13514 0074 00 4 13350 TSX UNUMIX,4 NUMERICALLY EVALUATE THE ARGUMENTS
13515 -0534 00 2 03321 LXD $ARG3,2 PICK UP TYPE OF NUMBERS
13516 -0600 00 0 13527 STQ DIFT STORE SECOND NUMBER
13517 0074 00 4 14550 TSX FIXFLO,4 DISPATCH ON TYPE
13520 0761 00 0 00000 NOP IMPOSSIBLE RETURN
13521 0302 00 0 13527 FSB DIFT FLOATING POINT
13522 0402 00 0 13527 SUB DIFT FIXED POINT
13523 0560 00 0 03321 LDQ $ARG3 TYPE OF NUMBER
13524 0774 00 2 00000 DIFX2 AXT **,2 RESTORE IR 2
13525 0774 00 4 00000 DIFX AXT **,4 RESTORE LINK IR
13526 0020 00 0 12636 TRA $MKNO MAKE RESULT A NUMBER
*
13527 0 00000 0 00000 DIFT TEMPORARY STORAGE
*
* THIS ROUTINE USES UNUMIX,FIXFLO,$ARG3 AND $MKNO
*
*
* EXPT TAKES 2 FIXED OR FLOATING POINT NUMBERS AS ARGUMENTS AND RAISES
* THE FIRST TO THE POWER INDICATED BY THE SECOND.
*
13530 0634 00 4 13567 EXPT SXA EXPX,4 SAVE LINK IR
13531 0634 00 2 13570 SXA EXPY,2 SAVE IR 2
13532 0074 00 4 13350 TSX UNUMIX,4 EVALUATE THE 2 ARGUMENTS AS NUMBERS
13533 -0534 00 2 03321 LXD $ARG3,2 PICK UP TYPE OF NUMBERS
13534 0074 00 4 14550 TSX FIXFLO,4 DISPATCH ON FIX OR FLOAT
13535 0761 00 0 00000 NOP IMPOSSIBLE RETURN
13536 0020 00 0 13564 TRA EXPA IS FLOATING POINT
13537 0120 00 0 13546 TPL EXPB
13540 0534 00 2 13570 EXPC LXA EXPY,2 RESTORE IR 2
13541 0534 00 4 13567 LXA EXPX,4 RESTORE IR 4
13542 -0634 00 4 01562 SXD $ERROR,4 SAVE IN $ERROR
13543 -0754 00 0 00000 PXD 0,0 CLEAR AC
13544 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
13545 543160600254 BCI 1,*I 2* FIRST ARGUMENT IS NEGATIVE -EXPT-
13546 0131 00 0 00000 EXPB XCA INTERCHANGED FIXED POINT ARGUMENTS.
13547 -0600 00 0 77662 STQ COMMON TEMPORARY STORAGE
13550 0734 00 4 00000 PAX 0,4 EXPONENT
13551 -3 00000 4 13561 TXL OUT,4,0 GO IF ZERO POWER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 124
13552 -2 00001 4 13556 TNX OUT1,4,1 GO IF TO FIRST POWER
13553 -0754 00 0 00000 PXD 0,0 CLEAR AC
13554 0200 00 0 77662 MPY COMMON RAISE TO GIVEN POWER
13555 2 00001 4 13554 TIX *-1,4,1 IN LOOP
13556 0131 00 0 00000 OUT1 XCA ANSWER TO AC
13557 0560 00 0 00475 LDQ $FIXD $FIX TO DECREMENT
13560 0020 00 0 13567 TRA EXPX RESTORE INDEX REGISYERS AND MAKE NUMBR
13561 0500 00 0 00371 OUT CLA $Q1 ANSWER IS 1
13562 0560 00 0 00475 LDQ $FIXD $FIX TO MQ
13563 0020 00 0 13567 TRA EXPX EXIT
13564 -0120 00 0 13540 EXPA TMI EXPC
13565 0074 00 4 13572 TSX $POWR,4 POWER ROUTINE
13566 0560 00 0 00476 LDQ FLOATD $FLOAT TO MQ
13567 0774 00 4 00000 EXPX AXT **,4 RESTORE INDEX REGISTERS
13570 0774 00 2 00000 EXPY AXT **,2
13571 0020 00 0 12636 TRA $MKNO MAKE ANSWER AN NUMBER
POWER
G HED
13572 -0600 00 0 13714 POWR STQ N
13573 -0634 00 1 77662 SXD COMMON,1
13574 -0634 00 2 77663 SXD COMMON+1,2
13575 0534 00 1 00370 P19 LXA ZERO,1
13576 0534 00 2 00370 LXA ZERO,2
13577 0765 00 0 00033 LRS 27
13600 0402 00 0 00415 SUB L200
13601 -0600 00 0 13715 STQ FN
13602 0560 00 0 00370 LDQ ZERO
13603 -0100 00 0 13606 TNZ P01
13604 0601 00 0 13716 STO E
13605 0020 00 0 13620 TRA P02
13606 0765 00 0 00001 P01 LRS 1
13607 1 00001 1 13610 TXI P03,1,1
13610 -0100 00 0 13606 P03 TNZ P01
13611 -0754 00 1 00000 PXD 0,1
13612 0771 00 0 00022 ARS 18
13613 0760 00 0 00003 SSP
13614 0400 00 0 00415 ADD L200
13615 0763 00 0 00033 LLS 27
13616 0601 00 0 13716 STO E
13617 0760 00 0 00000 CLM
13620 0560 00 0 13715 P02 LDQ FN
13621 0763 00 0 00033 LLS 27
13622 0400 00 0 00435 ADD LL200
13623 0300 00 0 13717 FAD RSQ
13624 0601 00 0 13720 STO P04
13625 0302 00 0 13726 FSB SQ
13626 0240 00 0 13720 FDH P04
13627 -0600 00 0 13721 STQ P05
13630 0260 00 0 13721 FMP P05
13631 0601 00 0 13722 STO P06
13632 0560 00 0 13722 P08 LDQ P06
13633 0260 00 2 13733 FMP C7,2
13634 0300 00 2 13732 FAD C5,2
13635 0601 00 2 13732 STO C5,2
13636 1 00001 2 13637 TXI P07,2,1
13637 -3 00002 2 13632 P07 TXL P08,2,2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 125
13640 0560 00 0 13730 LDQ C1
13641 0260 00 0 13721 FMP P05
13642 0302 00 0 13727 FSB R2
13643 0300 00 0 13716 FAD E
13644 0601 00 0 13716 P18 STO E
13645 0560 00 0 13714 LDQ N
13646 0260 00 0 13716 FMP E
13647 0601 00 0 13714 STO N
13650 0020 00 0 14023 TRA P09
13651 0 00000 0 00000 M1
13652 0 00000 0 00000 M2
13653 0 00000 0 00001 M3 1
13654 0 00400 0 00000 M4 0,0,256
13655 0534 00 1 00370 P41 LXA ZERO,1
13656 0560 00 0 13725 P11 LDQ W
13657 0260 00 1 13746 FMP A6,1
13660 0300 00 1 13745 FAD A5,1
13661 0601 00 1 13745 STO A5,1
13662 1 00001 1 13663 TXI P10,1,1
13663 -3 00005 1 13656 P10 TXL P11,1,5
13664 0601 00 0 13725 STO W
13665 0534 00 2 00370 LXA ZERO,2
13666 0500 00 2 13755 P13 CLA AP6,2
13667 0601 00 2 13746 STO A6,2
13670 1 00001 2 13671 TXI P12,2,1
13671 -3 00006 2 13666 P12 TXL P13,2,6
13672 0534 00 1 00370 LXA ZERO,1
13673 0500 00 1 13737 P15 CLA CP7,1
13674 0601 00 1 13733 STO C7,1
13675 1 00001 1 13676 TXI P14,1,1
13676 -3 00003 1 13673 P14 TXL P15,1,3
13677 0560 00 0 13725 LDQ W
13700 0260 00 0 13725 FMP W
13701 0601 00 0 13725 STO W
13702 0560 00 0 13725 LDQ W
13703 0260 00 0 13725 FMP W
13704 0601 00 0 13725 STO W
13705 0020 00 0 13756 TRA P16
13706 0 00000 0 00000 EA
13707 0020 00 0 13763 P171 TRA P17
13710 0 00000 0 00000 P24
13711 0601 00 0 13716 P21 STO E
13712 0 00000 0 00000 S1
13713 0 00000 0 00000 S2
13714 0 00000 0 00000 N
00370 ZERO SYN $ZERO
00415 L200 SYN $QO200
13715 0 00000 0 00000 FN
13716 0 00000 0 00000 E
00435 LL200 SYN QO2Q11
13717 +200552023632 RSQ OCT +200552023632
13720 0 00000 0 00000 P04
13721 0 00000 0 00000 P05
13722 0 00000 0 00000 P06
13723 +200542710300 LOG OCT +200542710300
13724 0 00000 0 00000 S3
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 126
13725 0 00000 0 00000 W
13726 +201552023632 SQ OCT +201552023632
13727 +200400000000 R2 OCT +200400000000
13730 +202561250731 C1 OCT +202561250731
13731 +200754342231 OCT +200754342231
13732 +200447154100 C5 OCT +200447154100
13733 +177674535132 C7 OCT +177674535132
13734 +202561250731 OCT +202561250731
13735 +200754342231 OCT +200754342231
13736 +200447154100 OCT +200447154100
13737 +177674535132 CP7 OCT +177674535132
13740 +201400000000 OCT +201400000000
13741 +176777776476 OCT +176777776476
13742 +174400037635 OCT +174400037635
13743 +170523517764 OCT +170523517764
13744 +164547625227 OCT +164547625227
13745 +157554324201 A5 OCT +157554324201
13746 +154562606535 A6 OCT +154562606535
13747 +201400000000 L1 OCT +201400000000
13750 +176777776476 OCT +176777776476
13751 +174400037635 OCT +174400037635
13752 +170523517764 OCT +170523517764
13753 +164547625227 OCT +164547625227
13754 +157554324201 OCT +157554324201
13755 +154562606535 AP6 OCT +154562606535
13756 0601 00 0 14022 P16 STO EW
13757 0500 00 0 13707 CLA P171
13760 0601 00 0 13644 STO P18
13761 0500 00 0 14022 CLA EW
13762 0020 00 0 13575 TRA P19
13763 0020 00 0 14123 P17 TRA P20
13764 0500 00 0 13711 P42 CLA P21
13765 0601 00 0 13644 STO P18
13766 0534 00 1 00370 LXA ZERO,1
13767 0500 00 1 13737 P23 CLA CP7,1
13770 0601 00 1 13733 STO C7,1
13771 1 00001 1 13772 TXI P22,1,1
13772 -3 00003 1 13767 P22 TXL P23,1,3
13773 0560 00 0 13710 LDQ P24
13774 0260 00 0 13723 FMP LOG
13775 0302 00 0 13724 FSB S3
13776 0140 00 0 14013 TOV P25
13777 0601 00 0 13712 STO S1
14000 0560 00 0 13712 LDQ S1
14001 0260 00 0 13727 FMP R2
14002 0302 00 0 13747 FSB L1
14003 0601 00 0 13713 STO S2
14004 0560 00 0 13712 LDQ S1
14005 0260 00 0 13713 FMP S2
14006 0300 00 0 13747 FAD L1
14007 0601 00 0 13712 STO S1
14010 0560 00 0 14022 LDQ EW
14011 0260 00 0 13712 FMP S1
14012 0601 00 0 14022 STO EW
14013 0560 00 0 13651 P25 LDQ M1
14014 0260 00 0 14022 FMP EW
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 127
14015 0601 00 0 14022 STO EW
14016 0500 00 0 13714 CLA N
14017 0120 00 0 14113 TPL P26
14020 0500 00 0 13747 CLA L1
14021 0020 00 0 14111 TRA P27
14022 0 00000 0 00000 EW
14023 0560 00 0 00370 P09 LDQ ZERO
14024 0760 00 0 00003 SSP
14025 0765 00 0 00033 LRS 27
14026 0402 00 0 00415 SUB L200
14027 0020 00 0 14106 TRA P28
14030 0500 00 0 00370 P40 CLA ZERO
14031 0763 00 0 00000 P39 LLS **
14032 0400 00 0 00415 ADD L200
14033 0400 00 0 13653 ADD M3
14034 0767 00 0 00033 ALS 27
14035 0400 00 0 13654 ADD M4
14036 0601 00 0 13651 STO M1
14037 -0600 00 0 13652 STQ M2
14040 0500 00 0 13652 CLA M2
14041 -0100 00 0 14060 TNZ P29
14042 0500 00 0 13714 CLA N
14043 0120 00 0 14047 TPL P30
14044 0500 00 0 13747 CLA L1
14045 0240 00 0 13651 FDH M1
14046 -0600 00 0 13651 STQ M1
14047 0534 00 1 00370 P30 LXA ZERO,1
14050 0500 00 1 13737 P32 CLA CP7,1
14051 0601 00 1 13733 STO C7,1
14052 1 00001 1 14053 TXI P31,1,1
14053 -3 00003 1 14050 P31 TXL P32,1,3
14054 0500 00 0 13651 CLA M1
14055 -0534 00 1 77662 LXD COMMON,1
14056 -0534 00 2 77663 LXD COMMON+1,2
14057 0020 00 4 00001 TRA 1,4
14060 0760 00 0 00000 P29 CLM
14061 0534 00 2 00370 LXA ZERO,2
14062 0763 00 0 00001 P34 LLS 1
14063 1 00001 2 14064 TXI P33,2,1
14064 0100 00 0 14062 P33 TZE P34
14065 0765 00 0 00001 LRS 1
14066 -0754 00 2 00000 PXD 0,2
14067 0771 00 0 00022 ARS 18
14070 -0760 00 0 00003 SSM
14071 0400 00 0 00415 ADD L200
14072 0400 00 0 13653 ADD M3
14073 0763 00 0 00033 LLS 27
14074 0601 00 0 13652 P36 STO M2
14075 0560 00 0 13723 LDQ LOG
14076 0260 00 0 13652 FMP M2
14077 0601 00 0 13725 STO W
14100 0020 00 0 14121 TRA P35
14101 0500 00 0 13747 P37 CLA L1
14102 0601 00 0 13651 STO M1
14103 0500 00 0 13714 CLA N
14104 0760 00 0 00003 SSP
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 128
14105 0020 00 0 14074 TRA P36
14106 0100 00 0 14101 P28 TZE P37
14107 -0120 00 0 14101 TMI P37
14110 0020 00 0 14117 TRA P38
14111 0240 00 0 14022 P27 FDH EW
14112 -0600 00 0 14022 STQ EW
14113 0500 00 0 14022 P26 CLA EW
14114 -0534 00 1 77662 LXD COMMON,1
14115 -0534 00 2 77663 LXD COMMON+1,2
14116 0020 00 4 00001 TRA 1,4
14117 0621 00 0 14031 P38 STA P39
14120 0020 00 0 14030 TRA P40
14121 0601 00 0 13724 P35 STO S3
14122 0020 00 0 13655 TRA P41
14123 0760 00 0 00003 P20 SSP
14124 0601 00 0 13710 STO P24
14125 0020 00 0 13764 TRA P42
HEAD Q
* ADD ADDS A STRING OF FIXED POINT OR FLOATING POINT NUMBERS
14126 -0634 00 4 03500 ADDP SXD AMIR,4 SAVE LINK IR
14127 0774 00 4 07355 AXT $PLUS,4
14130 0604 00 0 03501 STI AMIND SAVE INDICATORS
14131 0057 00 000177 RIR 177 RESET FIRST 7 INDICATORS
14132 0055 00 000001 SIR 1 SET ADD INDICATOR (1)
14133 0020 00 0 14155 TRA AMMMF GO TO MAIN FUNCTION
*
14134 -0634 00 4 03500 MULT SXD AMIR,4 SAVE LINK IR
14135 0774 00 4 06657 AXT $TIMES,4
14136 0604 00 0 03501 STI AMIND SAVE INDICATORS
14137 0057 00 000177 RIR 177 RESET FIRST 7 INDICATORS
14140 0055 00 000002 SIR 2 SET MULTIPLY INDICATOR (2)
14141 0020 00 0 14155 TRA AMMMF GO TO MAIN FUNCTION
*
14142 -0634 00 4 03500 MIN SXD AMIR,4 SAVE LINK IR
14143 0774 00 4 07604 AXT $MINP,4
14144 0604 00 0 03501 STI AMIND SAVE INDICATORS
14145 0057 00 000177 RIR 177 RESET FIRST 7 INDICATORS
14146 0055 00 000010 SIR 10 SET MINIMUM INDICATOR (10)
14147 0020 00 0 14155 TRA AMMMF GO TO MAIN FUNCTION
*
14150 -0634 00 4 03500 MAX SXD AMIR,4 SAVE LINK IR
14151 0774 00 4 07614 AXT $MAXP,4
14152 0604 00 0 03501 STI AMIND SAVE INDICATORS
14153 0057 00 000177 RIR 177 RESET FIRST 7 INDICATORS
14154 0055 00 000004 SIR 4 SET MAXIMUM INDICATOR (4)
14155 0634 00 4 03500 AMMMF SXA AMIR,4 PUT PROGRAM NAME WITH LINK IR
14156 0074 00 4 02312 TSX $SAVE,4 OTHER 3 FUNCTIONS ENTER AT *-1
14157 -3 03503 0 02377 TXL $END2,,AMIND+2 SAVE 2 ITEMS
14160 0074 00 4 15774 TSX $EVLIS,4 EVALUATE THE LIST OF ARGUMENTS
14161 0074 00 4 02326 TSX UNSAVE,4 RESTORE IR 4 AND INDICATORS
14162 0634 00 2 14336 SXA AMIR2,2 SAVE IR 2
14163 0600 00 0 14341 STZ AMSUM ZERO FINAL ANSWER REGISTER
14164 -0734 00 4 00000 AMLP PDX 0,4 PUT POINTER TO ARG LIST IN IR 4
14165 -3 00000 4 14330 TXL AMEND,4,0 GO TO EXIT IF NULL
14166 0500 00 4 00000 CLA 0,4 GET FIRST WORD
14167 0601 00 0 03502 STO AMLIS SAVE THE WORD
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 129
14170 0734 00 4 00000 PAX 0,4 CAR OF LIST
14171 -0754 00 4 00000 PXD 0,4 TO DECREMENT
14172 0074 00 4 14342 TSX NUMVAL,4 EVALUATE THE ITEM
14173 -0600 00 0 03503 STQ AMQ SAVE CHARACTERISTIC ($FIX OR $FLOAT)
14174 0056 00 000100 RNT 100 TEST FOR FIRST TIME THROUGH
14175 0020 00 0 14220 TRA AMFRS IS FIRST TIME GO TO INITIALIZE AMSUM
14176 0054 00 000002 RFT 2 TEST FOR MULT FUNCTION
14177 0020 00 0 14240 TRA AMLT EXECUTE MULT FUNCTION
14200 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
14201 0500 00 4 00000 CLA 0,4 GET NUMERICAL VALUE
14202 0056 00 000001 RNT 1 SKIP NEXT INSTRUCTION IF ADD FUNCTION
14203 0020 00 0 14300 TRA AMM EXECUTE MAX OR MIN FUNCTION
14204 -0534 00 2 03503 LXD AMQ,2 ADD FUNCTION. PICK UP TYPE OF NUMBER
14205 0074 00 4 14550 TSX FIXFLO,4 TEST FOR FIX OR FLOAT
14206 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14207 0020 00 0 14233 TRA AFLL EXECUTE FAD
14210 0055 00 000020 SIR 20 IS FIXED POINT. SET FIXED POINT IND.
14211 -0774 00 4 14235 AXC AFLR,4 PRESET IR 4
14212 0054 00 000040 RFT 40 SKIP NEXT INSTRUCTION IF NOT MIXED EXP
14213 0020 00 0 14266 TRA UNFX IS MIXED, FLOAT THIS NUMBER
14214 0400 00 0 14341 ADD AMSUM FIXED ADD OF SUM
14215 0601 00 0 14341 AMRT STO AMSUM STORE NEW SUM
14216 0500 00 0 03502 CLA AMLIS PICK UP ARG LIST
14217 0020 00 0 14164 TRA AMLP DO NEXT ITEM
14220 -0734 00 4 00000 AMFRS PDX 0,4 POINTER TO FULL WORD
14221 0500 00 4 00000 CLA 0,4 GET NUMERICAL VALUE
14222 0601 00 0 14341 STO AMSUM STORE NUMERICAL VALUE IN AMSUM
14223 -0534 00 2 03503 LXD AMQ,2 PICK UP TYPE OF NUMBER
14224 0074 00 4 14550 TSX FIXFLO,4 TEST FOR FIX OR FLOAT
14225 0761 00 0 00000 NOP IMPOSSIBLE EXIT
14226 0055 00 000040 SIR 40 SET FLOAT INDICATOR
14227 0055 00 000020 SIR 20 SET FIX INDICATOR
14230 0055 00 000100 SIR 100 SET INDICATOR SO IT WILL NOT GET BACK
14231 0500 00 0 03502 CLA AMLIS PICK UP REST OF ARG LIST
14232 0020 00 0 14164 TRA AMLP DO NEXT ITEM
14233 0055 00 000040 AFLL SIR 40 IS FLOATING POINT, SET PROPER INDICATO
14234 0054 00 000020 RFT 20 SKIP NEXT INSTRUCTION IF NOT MIXED EXP
14235 0074 00 4 14270 AFLR TSX MIXFL,4 UNMIX THE EXPRESSION
14236 0300 00 0 14341 FAD AMSUM FLOATING ADD THE CURRENT SUM
14237 0020 00 0 14215 TRA AMRT STORE AND DO NEXT ITEM ON LIST
14240 -0734 00 4 00000 AMLT PDX 0,4 POINTER TO FULL WORD
14241 0500 00 4 00000 CLA 0,4 GET NUMERICAL VALUE
14242 -0534 00 2 03503 LXD AMQ,2 PICK UP TYPE
14243 0074 00 4 14550 TSX FIXFLO,4 TEST FOR FIX OR FLOAT
14244 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14245 0020 00 0 14260 TRA AFMP DO FMP
14246 0055 00 000020 SIR 20 SET FIXED POINT INDICATOR
14247 -0774 00 4 14262 AXC AFLT,4 PRESET IR 4
14250 0054 00 000040 RFT 40 SKIP NEXT INSTRUCTION IF NOT MIXED EXP
14251 0020 00 0 14266 TRA UNFX IS MIXED, FLOAT THIS NUMBER
14252 0131 00 0 00000 XCA NUMBER TO MQ
14253 0200 00 0 14341 MPY AMSUM MPY BY CURRENT ANSWER
14254 0131 00 0 00000 XCA PUT LEAST SIGNIFICANT DIGITS IN AC
14255 0601 00 0 14341 AMRU STO AMSUM STORE NEW ANSWER
14256 0500 00 0 03502 CLA AMLIS PICK UP ARG LIST
14257 0020 00 0 14164 TRA AMLP DO NEXT ITEM
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 130
14260 0055 00 000040 AFMP SIR 40 SET FLOATING POINT INDICATOR
14261 0054 00 000020 RFT 20 TEST FOR MIXED EXP
14262 0074 00 4 14270 AFLT TSX MIXFL,4 UNMIX THE EXPRESSION
14263 0131 00 0 00000 XCA NUMBER TO MQ
14264 0260 00 0 14341 FMP AMSUM FMP BY CURRENT ANSWER
14265 0020 00 0 14255 TRA AMRU STORE NEW ANSER AND DO NEXT ITEM
14266 0057 00 000020 UNFX RIR 20 RESET FIXED POINT INDICATOR
14267 0020 00 0 14565 TRA $UNFIX FLOAT THE NUMBER IN THE AC
14270 0634 00 4 14276 MIXFL SXA MXIR,4 FIX MIXED EXPRESSION
14271 0601 00 0 14340 STO AMR SAVE AC
14272 0500 00 0 14341 CLA AMSUM PICK UP CURRENT ANSWER
14273 0074 00 4 14266 TSX UNFX,4 FLOAT IT
14274 0601 00 0 14341 STO AMSUM PUT IT AWAY
14275 0500 00 0 14340 CLA AMR RESTORE AC
14276 0774 00 4 00000 MXIR AXT **,4 RESTORE IR 4
14277 0020 00 4 00001 TRA 1,4 RETURN
14300 -0534 00 2 03503 AMM LXD AMQ,2 MAX OR MIN FUNCTION. GET TYPE
14301 0074 00 4 14550 TSX FIXFLO,4 TEST FOR FIX OR FLOAT
14302 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14303 0020 00 0 14316 TRA AFL EXECUTE FLOATING SECTION
14304 0055 00 000020 SIR 20 SET FIXED PONT INDICATOR
14305 0054 00 000040 RFT 40 TEST FOR MIXED EXP
14306 0074 00 4 14266 TSX UNFX,4 FLOAT THE ARGUMENT IF MIXED
14307 0056 00 000004 AMRNT RNT 4 TEST FORMAX FUNCTION
14310 0020 00 0 14322 TRA AMIN EXECUTE MIN FUNCTION
14311 0340 00 0 14341 CAS AMSUM COMPARE WITH CURRENT ANSWER
14312 0601 00 0 14341 STO AMSUM IS GREATER, STORE AS NEW ANSWER
14313 0761 00 0 00000 NOP THEY ARE EQUAL
14314 0500 00 0 03502 CLA AMLIS IS LESS, PICK UP ARGUMENT LIST
14315 0020 00 0 14164 TRA AMLP DO NEXT ITEM
14316 0055 00 000040 AFL SIR 40 SET FLOATING POINT INDICATOR
14317 0054 00 000020 RFT 20 TEST FOR MIXED EXPRESSION
14320 0074 00 4 14270 TSX MIXFL,4 UNMIX THE EXPRESSION
14321 0020 00 0 14307 TRA AMRNT COMPARE AND DO NEXT ITEM
14322 0340 00 0 14341 AMIN CAS AMSUM MIN FUNCTION, COMPARE WITH CURRENT VAL
14323 0020 00 0 14326 TRA *+3 IS GREATER
14324 0020 00 0 14326 TRA *+2 IS EQUAL
14325 0601 00 0 14341 STO AMSUM IS LESS, STORE AS NEW ANSWER
14326 0500 00 0 03502 CLA AMLIS PICK UP NEXT ITEM
14327 0020 00 0 14164 TRA AMLP EXECUTE IT
14330 0500 00 0 14341 AMEND CLA AMSUM ALL DONE. PICKUP CURRENT ANSWER
14331 0560 00 0 00475 LDQ AMFXC PRESET MQ
14332 0054 00 000040 RFT 40 SKIP NEXT IF FIXED POINT
14333 0560 00 0 00476 LDQ AMFLC PICK UPI FIX IN MQ
14334 0441 00 0 03501 LDI AMIND RESTORE INDICATORS
14335 -0534 00 4 03500 LXD AMIR,4 RESTORE IR 4
14336 0774 00 2 00000 AMIR2 AXT **,2 RESTORE IR 2
14337 0020 00 0 12636 TRA $MKNO MAKE THE ANSWER A NUMBER
00476 AMFLC SYN FLOATD FLOAT CONSTANT
00475 AMFXC SYN $FIXD FIX CONSTANT
14340 0 00000 0 00000 AMR TEMP STORAGE
14341 0 00000 0 00000 AMSUM CURRENT ANSWER STORAGE
* NUMVAL NUMERICAL VALUE TAKES ANY LIST AND DECIDES IF IT
* REPRESENTS A FIXED POINT OR FLOATING POINT NUMBER. IF IT DOES NOT
* THE ROUTINE CLEARS THE AC AND MQ DOES AN XEC 1,4 AND THEN GOES
* TO ERROR WITH A BAD ARGUMENT COMPLAINT. IF THE LIST DOES
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 131
* REPRESENT A NUMBER, UPON EXIT THE FOLLOWING THINGS ARE LEFT
* AS INDICATED POINTER TO FULL WORD IN AC
* $FIX OR $FLOAT IN MQ
14342 0634 00 4 14372 NUMVAL SXA NVIR4,4 SAVE LINK IR
14343 0601 00 0 03321 STO $ARG3 SAVE ORIGINAL ARGUMENT
14344 -0734 00 4 00000 PDX 0,4 POINTER TO NUMBER IN IR 4
14345 -3 00000 4 14351 NVLP TXL NVNO,4,0 NULL LIST IS NOT A NUMBER
14346 0500 00 4 00000 CLA 0,4 FIRST ELEMENT
14347 0734 00 4 00000 PAX 0,4 CAR LIST
14350 3 77776 4 14362 TXH NVATM,4,-2 GO IF AN ATOM
*
14351 -0754 00 0 00000 NVNO PXD 0,0 IS NOT NUMBER, CLEAR AC
14352 0131 00 0 00000 XCA PUT IN MQ
14353 -0754 00 0 00000 PXD 0,0 CLEAR AC AGAIN
14354 0534 00 4 14372 LXA NVIR4,4 RESTORE LINK IR
14355 0522 00 4 00001 XEC 1,4 EXECUTE POSSIBLE EXIT INSTRUCTION
14356 0500 00 0 03321 CLA $ARG3 MUST BE AN ERROR, PICK UP ORIGINAL ARGPAGE 142
14357 -0634 00 4 01562 SXD $ERROR,4
14360 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
14361 543160600354 BCI 1,*I 3* BAD ARGUMENT NUMVAL
*
14362 -0734 00 4 00000 NVATM PDX 0,4
14363 -0320 00 0 00470 ANA TAGMSK
14364 0100 00 0 14351 TZE NVNO
14365 0771 00 0 00017 ARS 15
14366 0621 00 0 14370 STA *+2
14367 -0754 00 4 00000 PXD 0,4
14370 -0774 00 4 00000 AXC **,4
14371 0560 00 4 14373 LDQ NVTBL,4
14372 0774 00 4 00000 NVIR4 AXT **,4 RESTORE IR 4
14373 0020 00 4 00001 NVTBL TRA 1,4
14374 0 10135 0 00000 0,,$FIX
14375 0 10120 0 00000 0,,$FLOAT
14376 0 00000 0 00000 0,,0
14377 0 00000 0 00000 0,,0
14400 0 10135 0 00000 0,,$FIX
*
*
* ADD1 ADD 1 ADDS ONE TO ANY FIXED POINT OR FLOATING POINT
* NUMBER AND EXITS WITH THE NUMBER NUMBER
14401 0634 00 1 14417 ADD1 SXA A1IR1,1 SAVE IR 1
14402 0774 00 1 00000 AXT 0,1 ZERO IR 1(INDICATES ADD OP)
14403 0634 00 2 14420 AD1 SXA A1IR2,2 SAVE IR 2
14404 0634 00 4 14421 SXA A1IR4,4 SAVE LINK IR
14405 0074 00 4 14342 TSX NUMVAL,4 EVALUTE NUMERICAL ARGUMENT
14406 -0600 00 0 14423 STQ A1T SAVE $FIX OR $FLOAT
14407 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
14410 0500 00 4 00000 CLA 0,4 GET NUMERICAL VALUE
14411 -0534 00 2 14423 LXD A1T,2 PICK UP $FIX OR $FLOAT
14412 0074 00 4 14550 TSX FIXFLO,4
14413 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14414 0522 00 1 14424 XEC FAD,1 IS FLOAT, DO FLOATING POINT OP
14415 0522 00 1 14426 XEC ADDF,1 DO FIXED POINT OP
14416 0560 00 0 14423 LDQ A1T RESTORE $FLOAT AFTER FAD
14417 0774 00 1 00000 A1IR1 AXT **,1 RESTORE IR 1
14420 0774 00 2 00000 A1IR2 AXT **,2 RESTORE IR 2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 132
14421 0774 00 4 00000 A1IR4 AXT **,4 RESTORE LINK IR
14422 0020 00 0 12636 TRA $MKNO MAKE RESULT A NUMBER
*
14423 0 00000 0 00000 A1T TEMPORARY STORAGE
14424 0300 00 0 00454 FAD FAD $QF1 FLOATING ADD FOR ADD1
14425 0302 00 0 00454 FSB $QF1 FOR SUB1
14426 0400 00 0 00371 ADDF ADD $Q1 FOR ADD1
14427 0402 00 0 00371 SUB $Q1 FOR SUB1
*
* SUB1 SUBTRACT 1 SUBTRACTS ONE FROM A FIXED POINT OR FLOATING
* POINT NUMBER. USES CODING OF ADD1 WITH AN INITIALIZATION.
14430 0634 00 1 14417 SUB1 SXA A1IR1,1 SAVE IR1
14431 0774 00 1 77777 AXT -1,1 SET FOR SUBTRACT OPERATIONS
14432 0020 00 0 14403 TRA AD1 PERFORM ADD1 CODING
* SUB1 USES THE CODING OF ADD1
*
*
14433 0634 00 4 14437 GRTRTP SXA GRTIR,4 SAVE LINK IR
14434 0074 00 4 13350 TSX UNUMIX,4 EVALUATE NUMERICAL ARGUMENTS
14435 0040 00 0 14441 TLQ GRTT PREDICATE TRUE
14436 -0754 00 0 00000 PXD 0,0 FALSE, CLEAR AC
14437 0774 00 4 00000 GRTIR AXT **,4
14440 0020 00 4 00001 TRA 1,4 EXIT
*
14441 0500 00 0 00442 GRTT CLA $QD1 GET TRUE VALUE
14442 0020 00 0 14437 TRA GRTIR RESTORE LINK IR AND EXIT
*
*
* LESSTP LESS THAN PREDICATE. SIMPLE DOES GREATER THAN PREDICATE
* WITH THA ARGUMENT REVERSED.
*
14443 0131 00 0 00000 LESSTP XCA INTERCHANGE ARGUMENTS
14444 0020 00 0 14433 TRA GRTRTP DO GREATER THAN PREDICATE
*
* THE FOLLOWING IS A NUMBER PREDICATE PACKAGE WHICH INCLUDES NUMBER
* PREDICATE, ZERO PREDICATE, MINUS PREDICATE, ONE PREDICATE, FIX
* PREDICATE AND FLOAT PREDICATE. ALL THESE PREDICATES SHARE CERTAIN
* BLOCKS OF CODING AND TEMPORARY STORAGE.
* NUMBRP NUMBER PREDICATE TEST ITS ARGUMENT FOR A NUMBER
14445 0634 00 4 14451 NUMBRP SXA NPIR,4 SAVE LINK IR
14446 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14447 0100 00 0 14451 TZE NPIR IF ZERO NOT A NUMBER
14450 0500 00 0 00442 NPT CLA $QD1 IS A NUMBER, PICK UP TRUTH
14451 0774 00 4 00000 NPIR AXT **,4 RESTORE LINK IR
14452 0020 00 4 00001 TRA 1,4 EXIT
*
* FLOATP FLOATING POINT NUMBER PREDICATE TESTS TO SEE IF ITS
* ARGUMENT IS A FLOATING POINT NUMBER
14453 0634 00 4 14451 FLOATP SXA NPIR,4 SAVE LINK IR
14454 0634 00 2 14525 SXA ZPIR,2 SAVE IR 2
14455 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14456 0131 00 0 00000 XCA GET TYPE IN AC
14457 -0734 00 2 00000 PDX 0,2 TYPE IN IR 2
14460 0074 00 4 14550 TSX FIXFLO,4 TEST FOR $FIX OR $FLOAT
14461 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14462 0020 00 0 14464 TRA FLT IS FLOATING POINT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 133
14463 0020 00 0 14524 TRA ZPF IS NOT FLOATING POINT, EXIT FALSE
14464 0500 00 0 00442 FLT CLA $QD1 GET TRUTH VALUE
14465 0020 00 0 14525 TRA ZPIR RESTORE IR S AND EXIT
*
* FIXP FIXED POINT PREDICATE TESTS FOR FIXED POINT NUMBERS.
14466 0634 00 4 14451 FIXP SXA NPIR,4 SAVE LINK IR
14467 0634 00 2 14525 SXA ZPIR,2 SAVE IR 2
14470 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14471 0131 00 0 00000 XCA GET TYPE IN AC
14472 -0734 00 2 00000 PDX 0,2 TYPE IN IR 2
14473 0074 00 4 14550 TSX FIXFLO,4 TEST FOR $FIX OR $FLOAT
14474 0761 00 0 00000 NOP IMPOSSIBLE EXIT
14475 0020 00 0 14524 TRA ZPF IS FLOAT, EXIT FALSE
14476 0500 00 0 00442 CLA $QD1 IS FIX, GET TRUTH VALUE
14477 0020 00 0 14525 TRA ZPIR RESTORE IR S AND RETURN
*
* MINUSP MINUS PREDICATE TESTS TO SEE IF ITS ARGUMENT IS A
* NEGATIVE NUMBER.
14500 0634 00 4 14451 MINUSP SXA NPIR,4 SAVE LINK IR
14501 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14502 -0734 00 4 00000 PDX 0,4
14503 0500 00 4 00000 CLA 0,4 PICK UP NUMBER
14504 -0120 00 0 14450 TMI NPT EXIT TRUE IF MINUS
14505 -0754 00 0 00000 PXD 0,0 IS NOT, EXIT FALSE
14506 0020 00 0 14451 TRA NPIR RESTORE LINK IR AND EXIT
*
* ZEROP ZERO PREDICATE TESTS ITS ARGUMENT FOR A FIXED POINT
* ZERO OR
* ZERO OR A FLOATING POINT ZERO + OR - A TOLERANCE (FLOTOL).
14507 0634 00 4 14451 ZEROP SXA NPIR,4 SAVE LINK IR
14510 0634 00 2 14525 SXA ZPIR,2 SAVE IR 2
14511 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14512 -0734 00 4 00000 PDX 0,4 GET POINTER TO IR 4
14513 0500 00 4 00000 CLA 0,4 FULL WORD
14514 0760 00 0 00003 ZPG SSP GET MAGNITUDE OF N
14515 0100 00 0 14527 TZE ZPT EXIT TRUE IF ZERO
14516 0131 00 0 00000 XCA PUT NUMBER IN MQ
14517 -0734 00 2 00000 PDX 0,2 PUT TYPE IN IR 2
14520 0500 00 0 14623 CLA FLOTOL PICK UP FLOATING POINT TOLERENCE
14521 0074 00 4 14550 TSX FIXFLO,4 TEST FOR FIX OR FLOAT
14522 0020 00 0 14531 TRA ZPTS NOT FIX OR FLO MEANS FLO FROM ONEP
14523 0020 00 0 14531 TRA ZPTS IS FLOATING POINT, COMPARE WITH FLOTOL
14524 -0754 00 0 00000 ZPF PXD 0,0 IS FIXED POINT, EXIT FALSE
14525 0774 00 2 00000 ZPIR AXT **,2 RESTORE IR 2
14526 0020 00 0 14451 TRA NPIR RESTORE IR 4 AND EXIT
14527 0500 00 0 00442 ZPT CLA $QD1 GET TRUTH VALUE
14530 0020 00 0 14525 TRA ZPIR RESTORE IR S AND EXIT
14531 0040 00 0 14527 ZPTS TLQ ZPT IS FLOATING POINT, EXIT TRUE IF LESS
14532 0020 00 0 14524 TRA ZPF OTHERWISE EXIT FALSE
* ONEP ONE PREDICAT TESTS TO SEE IF ITS ARGUMENT IS ONE
* BY SUBTRACTIGN ONE AND TESTING THE RESULT WITH ZEROP.
14533 0634 00 4 14451 ONEP SXA NPIR,4 SAVE LINK IR
14534 0634 00 2 14525 SXA ZPIR,2 SAVE IR 2
14535 0074 00 4 14342 TSX NUMVAL,4 EVALUATE ARGUMENT
14536 -0734 00 4 00000 PDX 0,4 POINTER TO AC
14537 0500 00 4 00000 CLA 0,4 FULL WORD TO AC
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 134
14540 0131 00 0 00000 XCA TYPE TO AC
14541 -0734 00 2 00000 PDX 0,2 TYPE TO IR 2
14542 0131 00 0 00000 XCA
14543 0074 00 4 14550 TSX FIXFLO,4 DISPATCH ON FIX OR FLOAT
14544 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14545 0302 00 0 00454 FSB $QF1
14546 0402 00 0 00371 SUB $Q1 SUBTRACT 1
14547 0020 00 0 14514 TRA ZPG APPLY ZERO PREDICATE
*
* FIXFLO SUBROUTINE TO DISPATCH ON FIX OR FLO,
* ARGUMENT IN IR 2.
*
14550 -3 10134 2 14552 FIXFLO TXL *+2,2,$FIX-1 TXL - TXL FILTER FOR $FIX
14551 -3 10135 2 14564 TXL FX,2,$FIX GO IF $FIX
14552 -3 10117 2 14554 TXL *+2,2,$FLOAT-1 TXL - TXL FILTER FOR FLOAT
14553 -3 10120 2 14560 TXL FL,2,$FLOAT GO IF $FLOAT
14554 0522 00 4 00001 XEC 1,4 EXECUTE IF NEITHER FIX OR FLOAT
14555 0020 00 4 00004 TRA 4,4 RETURN
14556 0020 00 4 00005 TRA 5,4 SKIP EXIT
14557 0020 00 4 00006 TRA 6,4 SKIP 2 EXIT
14560 0522 00 4 00002 FL XEC 2,4 EXECUTE IF $FLOAT
14561 0020 00 4 00004 TRA 4,4 RETURN
14562 0020 00 4 00005 TRA 5,4 SKIP EXIT
14563 0020 00 4 00006 TRA 6,4 SKIP 2 EXIT
14564 0020 00 4 00003 FX TRA 3,4
* FIXFLO USES $FIX AND $FLAOT
* UNFIX UNFIX MAKES A FIXED POINT ARGUMENT IN THE AC A FLOATING
* POINT NUMBER LEFT IN AC. MQ IS PRESERVED.
14565 0601 00 0 14621 UNFIX STO UFC SAVE ARGUMENT
14566 -0320 00 0 00434 ANA UFMSK MASK OUT ALL BUT CHARACTERISTIC
14567 -0100 00 0 14576 TNZ UFE IF ANY THING LEFT IT MUST BE NORMALIZD
14570 0500 00 0 14621 CLA UFC NOTHING LEFT, RESTORE ARGUMENT
14571 -0501 00 0 00433 ORA UFMC OR IN CHARACTERISTIC
14572 -0600 00 0 14620 STQ UFQ SAVE MQ
14573 0300 00 0 00433 FAD UFMC ESSENTIALLY FAD OR ZERO TO NORMALIZE
14574 0560 00 0 14620 LDQ UFQ RESTORE MQ
14575 0020 00 4 00001 TRA 1,4 EXIT
*
14576 0634 00 4 14616 UFE SXA UFXR,4 NUMBER GREATER THAN 2 TO 27. SAVE IR 4
14577 0774 00 4 00234 AXT 2*64+3*8+4,4 CHARACTERISTIC SO FAR
14600 0600 00 0 14622 STZ UFS INITIALIZE SIGN PORTION
14601 0120 00 0 14604 TPL UFF SKIP IF +
14602 0760 00 0 00003 SSP MAKE IT +
14603 -0625 00 0 14622 STL UFS RECORD FACT BY MAKING UFS NON-ZERO
14604 0771 00 0 00001 UFF ARS 1 DIVIDE NUMBER BY 2
14605 0340 00 0 00432 CAS UFNC SEE IF NORMALIZED YET
14606 1 00001 4 14604 TXI UFF,4,1 ADD 1 TO CHARACTERISTIC AND TRY AGAIN
14607 1 00001 4 14604 TXI UFF,4,1 DITTO
14610 0601 00 0 14621 STO UFC IS NORMALIZED
14611 -0754 00 4 00000 PXD 0,4 CHARACTERISTIC TO AC
14612 0767 00 0 00011 ALS 9 POSITION CHARACTERISTIC
14613 -0501 00 0 14621 ORA UFC OR IN NORMALIZED NUMBER
14614 0520 00 0 14622 ZET UFS TEST FOR SIGN, 0 MEANS +
14615 -0760 00 0 00003 SSM NOT ZERO SO MAKE MINUS
14616 0774 00 4 00000 UFXR AXT **,4 RESTORE IR 4
14617 0020 00 4 00001 TRA 1,4 EXIT
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 135
00434 UFMSK SYN Q777Q9 CHARACTERISTIC MASK
00433 UFMC SYN Q233Q9 GENERAL CHARACTERISTIC
00432 UFNC SYN $QO1Q9
14620 0 00000 0 00000 UFQ MQ
14621 0 00000 0 00000 UFC AC TEMPORARY STORAGE
14622 0 00000 0 00000 UFS SIGN STORAGE
* UNFIX USES NO EXTERNAL CONSTANTS.
* FLOTOL FLOATING POINT TOLERENCE USED IN DESIDING IF FLOATING
* POINT NUMBERS ARE INTEGERS.
14623 +156622516334 FLOTOL DEC 3E-6 FLOATING POINT TOLERENCE VALUE
* MNSPRG MINUS PROGRAM MAKES A LIST OF MINUS AND ITS ARGUMENT
*
* MNSPRG CREATES A NUMBER OF OPPOSITE SIGN OF NUMERAL ARGUMENT
*
14624 0634 00 4 14631 MNSPRG SXA MRXR,4 SAVE LINK IR
14625 0074 00 4 14342 TSX NUMVAL,4 EVALUATE THE NUMERICAL ARGUMENT
14626 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
14627 0500 00 4 00000 CLA 0,4 NUMERICAL VALUE
14630 0760 00 0 00002 CHS MAKE OPPOSITE SIGN
14631 0774 00 4 00000 MRXR AXT **,4 RESTORE LINK IR
14632 0020 00 0 12636 TRA $MKNO MAKE IT A NUMBER
*
* RCPPRG CALCULATES THE RECIPORICAL OF A NUMBER.
14633 0634 00 4 14654 RCPPRG SXA RRXR,4 SAVE LINK IR
14634 0634 00 2 14655 SXA RRXR2,2 SAVE IR 2
14635 0074 00 4 14342 TSX NUMVAL,4 EVALUTE THE NUMERICAL ARGUMENT
14636 -0734 00 4 00000 PDX 0,4 POINTER TO FULL WORD
14637 0500 00 4 00000 CLA 0,4 NUMERICAL VALUE
14640 0601 00 0 14662 STO RCPT SAVE VALUE
14641 0131 00 0 00000 XCA TYPE TO AC
14642 -0734 00 2 00000 PDX 0,2 TYPE TO IR 2
14643 0074 00 4 14550 TSX FIXFLO,4 DISPATCH ON FIX OR FLOAT
14644 0761 00 0 00000 NOP IMPOSSIBLE RETURN
14645 0500 00 0 00454 CLA $QF1 IS FLOAT, PICK UP FLOATING POINT 1
14646 0020 00 0 14657 TRA RCPFX IS FIXED POINT
14647 0241 00 0 14662 FDP RCPT DIVIDE BY ARGUMENT
14650 0760 00 0 00012 DCT CHECK FOR ILLEGAL DIVISION
14651 0074 00 4 01676 TSX $DCT,4 DIVIDE CHECK ERROR
14652 0131 00 0 00000 XCA QUOTENT TO AC
14653 0560 00 0 00476 LDQ RCPS $FLOAT TO MQ
14654 0774 00 4 00000 RRXR AXT **,4 RESTORE LINK IR
14655 0774 00 2 00000 RRXR2 AXT **,2 RESTORE IR 2
14656 0020 00 0 12636 TRA $MKNO MAKE ANSWER A NUMBER
*
14657 0131 00 0 00000 RCPFX XCA FIXED POINT RECIP, ANSWER IS ZERO
14660 -0754 00 0 00000 PXD 0,0 CLEAR AC
14661 0020 00 0 14654 TRA RRXR RESTORE IR S AND MAKE A NUMBER
*
14662 0 00000 0 00000 RCPT TEMPORARY STORAGE
00476 RCPS SYN FLOATD FLOAT INDICATOR
*
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 136
EJECT
APPLY
APPLY(F,L,A) =
SELECT(CAR(L).,
-1,APP2(F,L,A).,
LAMBDA,EVAL(F,APPEND(PAIR(CADR(F),L),A)).,
LABEL,APPLY(CADDR(F),L,APPEND(
PAIR1(CADR(F),CADDR(F))),A).,
APPLY(EVAL(F,A),L,A))
A HED
14663 -0634 00 4 03350 APPLY SXD ASS1,4
14664 0100 00 4 00001 TZE 1,4
14665 0601 00 0 03353 STO AST1 F
14666 -0734 00 4 00000 PDX 0,4
14667 0634 00 4 03350 SXA ASS1,4 SAVE FUNCTION ALONG WITH INDEX REGISTE
14670 0500 00 4 00000 CLA 0,4 CWR(F)
14671 0734 00 4 00000 PAX 0,4 CAR(F)
14672 3 77776 4 14722 TXH ASP1,4,-2 =-1
14673 -0754 00 4 00000 PXD 0,4
14674 0340 00 0 00502 CAS ASLMD = LAMBDA
14675 0020 00 0 14677 TRA *+2
14676 0020 00 0 14725 TRA ASP2
14677 0340 00 0 00500 CAS ASFUN
14700 0020 00 0 14702 TRA *+2
14701 0020 00 0 15000 TRA ASP4
14702 0340 00 0 00501 CAS ASLBL = LABEL
14703 0020 00 0 14705 TRA *+2
14704 0020 00 0 14750 TRA ASP3
14705 0074 00 4 02312 TSX $SAVE,4
14706 -3 03354 0 02375 TXL $END3,,ASSA+2 SAVE 3 ITEMS
14707 -0600 00 0 03351 STQ ASSL
14710 0560 00 0 03321 LDQ $ARG3
14711 -0600 00 0 03352 STQ ASSA
14712 0500 00 0 03353 CLA AST1 F
14713 0074 00 4 15454 TSX $EVAL,4 EVAL(F,A)
14714 0560 00 0 03352 LDQ ASSA
14715 -0600 00 0 03321 STQ $ARG3
14716 0560 00 0 03351 LDQ ASSL
14717 0074 00 4 02326 TSX UNSAVE,4
14720 -0534 00 4 03350 LXD ASS1,4
14721 0020 00 0 14663 TRA APPLY APPLY(EVAL(F,A),L,A)
14722 0500 00 0 03353 ASP1 CLA AST1 F
14723 -0534 00 4 03350 LXD ASS1,4
14724 0020 00 0 15016 TRA $APP2 P APP29F,L,A)
* LAMBDA BRANCH
14725 -0534 00 4 03353 ASP2 LXD AST1,4 F
14726 0500 00 0 03321 CLA $ARG3
14727 0601 00 0 03355 STO AST3
14730 0500 00 4 00000 CLA 0,4 CWR(F)
14731 -0734 00 4 00000 PDX 0,4 CDR(F)
14732 0500 00 4 00000 CLA 0,4 CWDR(F)
14733 0601 00 0 03356 STO AST4
14734 0734 00 4 00000 PAX 0,4 CADR(F)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 137
14735 -0754 00 4 00000 PXD 0,4
14736 0074 00 4 07562 TSX $PAIR,4 PAIR(CADR(F),L)
14737 0560 00 0 03355 LDQ AST3 A
14740 0074 00 4 07675 TSX $NCONC,4
14741 0131 00 0 00000 XCA
14742 -0534 00 4 03356 LXD AST4,4 CDDR(F)
14743 0500 00 4 00000 CLA 0,4
14744 0734 00 4 00000 PAX 0,4
14745 -0754 00 4 00000 PXD 0,4
14746 -0534 00 4 03350 LXD ASS1,4
14747 0020 00 0 15454 TRA $EVAL EVAL(CADDR(F),APPEND(PAIR(CADR(F),L),A))
* LABEL BRANCH
14750 -0534 00 4 03353 ASP3 LXD AST1,4 F
14751 -0600 00 0 03354 STQ AST2 L
14752 0560 00 0 03321 LDQ $ARG3 A
14753 -0600 00 0 03355 STQ AST3
14754 0500 00 4 00000 CLA 0,4 CWR(F)
14755 -0734 00 4 00000 PDX 0,4 CDR(F)
14756 0500 00 4 00000 CLA 0,4
14757 0601 00 0 03356 STO AST4 CWDR(F)
14760 -0734 00 4 00000 PDX 0,4 CDDR(F)
14761 0500 00 4 00000 CLA 0,4
14762 0734 00 4 00000 PAX 0,4 CADDR(F)
14763 -0754 00 4 00000 PXD 0,4
14764 0601 00 0 03353 STO AST1
14765 0131 00 0 00000 XCA
14766 0534 00 4 03356 LXA AST4,4
14767 -0754 00 4 00000 PXD 0,4 CADR(F)
14770 0074 00 4 03730 TSX $CONS,4 CONS(CADR(F),CONS(CADDR(F),0))
14771 0560 00 0 03355 LDQ AST3 A
14772 0074 00 4 03730 TSX $CONS,4 APPEND( ABOVE,A)
14773 0601 00 0 03321 STO $ARG3
14774 0560 00 0 03354 LDQ AST2
14775 0500 00 0 03353 CLA AST1 CADDR(F)
14776 -0534 00 4 03350 LXD ASS1,4
14777 0020 00 0 14663 TRA APPLY APPLY(CADDR(F),L,APPEND(PAIR(CADR(F),CADDR(F)),A))
* FUNARG BRANCH
15000 -0534 00 4 03353 ASP4 LXD AST1,4 F
15001 0500 00 4 00000 CLA ,4
15002 -0734 00 4 00000 PDX ,4 CDR(F)
15003 0500 00 4 00000 CLA ,4
15004 0601 00 0 03353 STO AST1 CWDR(F)
15005 -0734 00 4 00000 PDX ,4 CDDR(F)
15006 0500 00 4 00000 CLA ,4
15007 0734 00 4 00000 PAX ,4 CADDR(F)
15010 -0754 00 4 00000 PXD ,4
15011 0601 00 0 03321 STO $ARG3 A
15012 0534 00 4 03353 LXA AST1,4 CADR(F)
15013 -0754 00 4 00000 PXD ,4 F
15014 -0534 00 4 03350 LXD ASS1,4
15015 0020 00 0 14663 TRA $APPLY
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 138
00501 ASLBL SYN LABELD
00502 ASLMD SYN LAMDAD
00500 ASFUN SYN FNARGD
00370 ASZRO SYN $ZERO
APP2(F,L,A)=SELECT(F.,CAR,CAAR(L).,CDR,
CDAR(L).,CONS,CONS(CAR(L),CADR(L)).,LIST,COPY(L).,SEARCH(F,
LAMBDA(J,CAR(J)=SUBR OR CAR(J)=EXP),
LAMBDA(J,CAR(J)=SUBR YIELDS APP3(CWADR
(J),DISTRIB(L)),1 YIELDS APPLY(CADR(J),L,A)))
ERROR)
A HED
15016 -0634 00 4 15147 APP2 SXD ATS1,4 SAVE LINK IR
15017 -0534 00 4 03321 LXD $ARG3,4 GET ALIST
15020 -0634 00 4 15153 SXD A,4 SAVE IT
15021 -0600 00 0 15152 STQ AL ARGUMENT LIST
15022 0601 00 0 15151 STO F FUNCTION (IS ATOMIC SYMBOL)
15023 0600 00 0 15145 STZ APTRT INITIALIZE TRACE TEST CELL
15024 -0734 00 4 00000 APSES PDX 0,4 ARG TO IR
15025 -3 00000 4 15071 TXL APSAL,4,0 GO IF NO MORE PROPERTY LIST
15026 0500 00 4 00000 CLA 0,4 FIRST WORD
15027 0734 00 4 00000 PAX 0,4 CAR
15030 -3 06646 4 15032 TXL *+2,4,$TRACE-1
15031 -3 06647 4 15121 TXL APTRK,4,$TRACE LOOK FOR TRACE
15032 -3 06732 4 15034 TXL *+2,4,$SUBR-1 LOOK FOR
15033 -3 06733 4 15046 TXL R2,4,$SUBR $SUBR OR
15034 -3 10156 4 15024 TXL APSES,4,$EXPR-1 $EXPR
15035 3 10157 4 15024 TXH APSES,4,$EXPR
* EXPR BRANCH IN APPLY
15036 -0734 00 4 00000 R21 PDX 0,4 POINTER TO NEXT WORD AFTER $EXPR
15037 0500 00 4 00000 CLA 0,4 NEXT WORD
15040 0734 00 4 00000 PAX 0,4 CAR
15041 -0754 00 4 00000 PXD 0,4 IS FUNCTION
15042 0520 00 0 15145 ZET APTRT TEST FOR TRACE MODE
15043 0020 00 0 15111 TRA APTXP TRACE THIS EXPRESSION
15044 -0534 00 4 15147 LXD ATS1,4 RESTORE LINK IR
15045 0020 00 0 14663 TRA $APPLY GO TO APPLY
* RZ THE SUBR BRANCH OF APPLY
15046 -0734 00 4 00000 R2 PDX 0,4 GET THE TXL INSTRUCTION BT TAKING
15047 0500 00 4 00000 CLA 0,4 CWR (CADR L))
15050 0734 00 4 00000 PAX 0,4
15051 0500 00 4 00000 CLA 0,4
15052 0601 00 0 15146 STO CWADR TXL INSTRUCTION
15053 0500 00 0 03350 CLA ASS1
15054 0601 00 0 03315 STO CSV
15055 0500 00 0 15152 CLA AL GET THE ARGUMENT LIST
15056 0074 00 4 10072 TSX SPREAD,4 SPREAD IT INTO AC, MQ, ARG3, ETC.
15057 0520 00 0 15145 ZET APTRT TEST FOR TRACE MODE
15060 0020 00 0 15131 TRA APTSB TRACE THIS SUBROUTINE
15061 0074 00 4 02312 TSX $SAVE,4
15062 -3 03320 0 02377 TXL $END2,,$ALIST+2
15063 -0534 00 4 15153 LXD A,4
15064 -0634 00 4 03316 SXD $ALIST,4
15065 0074 00 4 15146 TSX CWADR,4
15066 0074 00 4 02326 TSX UNSAVE,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 139
15067 -0534 00 4 03315 LXD CSV,4
15070 0020 00 4 00001 TRA 1,4
*
15071 0500 00 0 15150 APSAL CLA FAS WHERE TO GO IF NOT FOUND ON PAIR LIST
15072 0601 00 0 03321 STO $ARG3
15073 0500 00 0 15151 CLA F ATOMIC FUNCTION
15074 0560 00 0 15153 LDQ A
15075 0074 00 4 10042 TSX SASSOC,4 SEARCH PAIR LIST FOR LABEL DEFINITION
15076 -0734 00 4 00000 PDX 0,4 POINTER TO ASSOCIATED ITEM
15077 0500 00 4 00000 CLA 0,4
15100 -0734 00 4 00000 PDX 0,4 POINTER TO ITEM
15101 -0754 00 4 00000 PXD 0,4
15102 0560 00 0 15153 LDQ A RESTORE PAIR LIST
15103 -0600 00 0 03321 STQ $ARG3
15104 0560 00 0 15152 LDQ AL RESTORE ARGUMENT LIST
15105 0520 00 0 15145 ZET APTRT TEST FOR TRACE MODE
15106 0020 00 0 15111 TRA APTXP TRACE THIS EXPRESSION
15107 -0534 00 4 15147 LXD ATS1,4 RESTORE LINK IR
15110 0020 00 0 14663 TRA $APPLY GO TO APPLY WITH ITEM ASSOCIATED WITH
* THE ATOMIC FUNCTION
15111 0074 00 4 02312 APTXP TSX $SAVE,4 TRACE EXPR
15112 -3 03317 0 02401 TXL $END1,,CSV+2
15113 0074 00 4 14663 TSX $APPLY,4
15114 0020 00 0 15136 TRA APEXC FINISH UP
*
15115 -0634 00 4 01562 R33 SXD $ERROR,4
15116 0500 00 0 15151 CLA F PICK UP FUNCTION
15117 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
15120 542160600254 BCI 1,*A 2* FUNCTION OBJECT HAS NO DEFINITION
*
15121 -0625 00 0 15145 APTRK STL APTRT
15122 0601 00 0 15144 STO APA SAVE THE AC
15123 0534 00 4 03350 LXA ASS1,4 ATOM NAME
15124 -0754 00 4 00000 PXD 0,4
15125 0074 00 4 16050 TSX ARGOF,4 PRINT ARGUMETNS OF
15126 0560 00 0 15152 LDQ AL RESTORE MQ AFTER PRINTING
15127 0500 00 0 15144 CLA APA RESTORE AC
15130 0020 00 0 15024 TRA APSES CONTINUE PROPERTY LIST SEARCH
*
15131 0074 00 4 02312 APTSB TSX $SAVE,4 TRACE SUBR
15132 -3 03320 0 02377 TXL $END2,,$ALIST+2
15133 -0534 00 4 15153 LXD A,4
15134 -0634 00 4 03316 SXD $ALIST,4
15135 0074 00 4 15146 TSX CWADR,4
15136 0074 00 4 02326 APEXC TSX UNSAVE,4
15137 0131 00 0 00000 XCA VALUE TO MQ
15140 0534 00 4 03315 LXA CSV,4
15141 -0754 00 4 00000 PXD 0,4 TO AC
15142 -0534 00 4 03315 LXD CSV,4
15143 0020 00 0 16104 TRA VALOF PRINT VALUE OF
*
15144 0 00000 0 00000 APA AC STORAGE
15145 0 00000 0 00000 APTRT TRACE MODE TEST SWITCH
15146 0 00000 0 00000 CWADR TXL INSTRUCTION FOR SUBR
15147 0 00000 0 00000 ATS1 LINK INDEX REGISTER
15150 -3 00000 0 15115 FAS TXL R33,,0 NOT FOUND ON PAIR LIST SO CALL ERROR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 140
15151 0 00000 0 00000 F ATOMIC FUNCTION GOES HERE
15152 0 00000 0 00000 AL ARGUMENT LIST
15153 0 00000 0 00000 A A OR PAIR LIST
*
A HED
15154 0100 00 0 15205 EVCON TZE E3
15155 -0634 00 4 03364 SXD ECS1,4
15156 0074 00 4 02312 TSX $SAVE,4
15157 -3 03371 0 02373 TXL $END4,,ECS4+2 SAVE 4 ITEMS
15160 -0600 00 0 03365 STQ ECS2
15161 -0734 00 4 00000 PDX 0,4
15162 0500 00 4 00000 E1 CLA 0,4
15163 0601 00 0 03366 STO ECS3
15164 0734 00 4 00000 PAX 0,4
15165 0500 00 4 00000 CLA 0,4
15166 0601 00 0 03367 STO ECS4
15167 0734 00 4 00000 PAX 0,4
15170 -0754 00 4 00000 PXD 0,4
15171 0074 00 4 15454 TSX $EVAL,4
15172 0560 00 0 03365 LDQ ECS2
15173 0100 00 0 15203 TZE E2
15174 -0534 00 4 03367 LXD ECS4,4
15175 0500 00 4 00000 CLA 0,4
15176 0734 00 4 00000 PAX 0,4
15177 -0754 00 4 00000 PXD 0,4
15200 0074 00 4 02326 TSX UNSAVE,4
15201 -0534 00 4 03364 LXD ECS1,4
15202 0020 00 0 15454 TRA $EVAL
15203 -0534 00 4 03366 E2 LXD ECS3,4
15204 3 00000 4 15162 TXH E1,4,0
15205 -0634 00 4 01562 E3 SXD $ERROR,4
15206 0534 00 4 03366 LXA ECS3,4
15207 -0754 00 4 00000 PXD 0,4 PRINT LAST CONDITION
15210 0074 00 4 01563 TSX $ERROR+1,4
15211 542160600354 BCI 1,*A 3* CONDITIONAL UNSATISFIED
BASIC LISP FUNCTIONS FOR APPLY
R HED
CAR
15212 0634 00 4 15217 CARP SXA CARX,4
15213 -0734 00 4 00000 PDX ,4
15214 0500 00 4 00000 CLA ,4
15215 0734 00 4 00000 PAX ,4
15216 -0754 00 4 00000 PXD ,4
15217 0774 00 4 00000 CARX AXT **,4
15220 0020 00 4 00001 TRA 1,4
15221 0 00000 0 00000 BFS1
15222 0634 00 4 15226 CDRP SXA CDRX,4
15223 -0734 00 4 00000 PDX ,4
15224 0500 00 4 00000 CLA ,4
15225 -0320 00 0 00460 ANA BFDM
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 141
15226 0774 00 4 00000 CDRX AXT **,4
15227 0020 00 4 00001 TRA 1,4
00460 BFDM SYN $DMASK
15230 0634 00 4 15241 ATOMP SXA ATMX,4
15231 0100 00 0 15236 TZE ATP1
15232 -0734 00 4 00000 PDX ,4
15233 0500 00 4 00000 CLA ,4
15234 0734 00 4 00000 PAX ,4
15235 -3 77776 4 15240 TXL *+3,4,-2
15236 0500 00 0 00442 ATP1 CLA BFQ1
15237 0020 00 0 15241 TRA *+2
15240 -0754 00 0 00000 PXD ,0
15241 0774 00 4 00000 ATMX AXT **,4
15242 0020 00 4 00001 TRA 1,4
00442 BFQ1 SYN $QD1
15243 0100 00 0 15246 NULLP TZE *+3
15244 -0754 00 0 00000 PXD ,0
15245 0020 00 4 00001 TRA 1,4
15246 0500 00 0 00442 CLA BFQ1
15247 0020 00 4 00001 TRA 1,4
LAMBDA FOR FUNCTIONAL ARGUMENTS
15250 -0634 00 4 15221 LAMP SXD BFS1,4
15251 0601 00 0 03415 STO BFS2 L
15252 0131 00 0 00000 XCA
15253 0560 00 0 00370 LDQ BFZRO
15254 0074 00 4 03730 TSX $CONS,4 CONS(A,0)
15255 0131 00 0 00000 XCA
15256 0500 00 0 03415 CLA BFS2
15257 0074 00 4 07541 TSX APPEND,4
15260 0131 00 0 00000 XCA
15261 0500 00 0 00500 CLA BFFAG
15262 -0534 00 4 15221 LXD BFS1,4
15263 0020 00 0 03730 TRA $CONS LIST(FUNARG,L,A)
00500 BFFAG SYN FNARGD
00370 BFZRO SYN $ZERO
LABEL FSUBR
15264 -0634 00 4 15221 LABP SXD BFS1,4
15265 -0600 00 0 03416 STQ BFS3 A
15266 -0734 00 4 00000 PDX ,4 L
15267 0500 00 4 00000 CLA ,4
15270 0601 00 0 03415 STO BFS2 CWR(L)
15271 -0734 00 4 00000 PDX ,4 CDR(L)
15272 0500 00 4 00000 CLA ,4
15273 0734 00 4 00000 PAX ,4 CADR(L)
15274 -0754 00 4 00000 PXD ,4
15275 0601 00 0 03414 STO BFS4
15276 0131 00 0 00000 XCA
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 142
15277 0534 00 4 03415 LXA BFS2,4 CAR(L)
15300 0131 00 0 00000 XCA
15301 -0754 00 4 00000 PXD ,4
15302 0074 00 4 03730 TSX $CONS,4 LIST(CAR(L),CADR(L))
15303 0560 00 0 03416 LDQ BFS3
15304 0074 00 4 03730 TSX $CONS,4 CONS(LIST,A)
15305 0131 00 0 00000 XCA
15306 0500 00 0 03414 CLA BFS4 CADR(L)
15307 -0534 00 4 15221 LXD BFS1,4
15310 0020 00 0 15454 TRA $EVAL
SETQ
15311 -0634 00 4 03461 SETQP SXD REPS1,4
15312 0074 00 4 02312 TSX $SAVE,4
15313 -3 03464 0 02377 TXL $END2,,REPV+2
15314 -0734 00 4 00000 PDX ,4 L
15315 0500 00 4 00000 CLA ,4
15316 0734 00 4 00000 PAX ,4 CAR(L)
15317 -0634 00 4 03462 SXD REPV,4
15320 -0734 00 4 00000 PDX ,4 CDR(L)
15321 0500 00 4 00000 CLA ,4
15322 0734 00 4 00000 PAX ,4 CADR(L)
15323 -0754 00 4 00000 PXD ,4
15324 0074 00 4 15454 TSX $EVAL,4 EVAL(CADR(L),A)
15325 0601 00 0 03463 STO REPT1
15326 0500 00 0 15341 CLA REPP1
15327 0601 00 0 03321 STO $ARG3
15330 0560 00 0 03447 LDQ PRGVAR
15331 0500 00 0 03462 CLA REPV
15332 0074 00 4 10042 TSX SASSOC,4 SASSOC(CAR(L),PV,ERROR)
15333 -0734 00 4 00000 PDX ,4
15334 0500 00 0 03463 CLA REPT1
15335 0622 00 4 00000 STD 0,4 REPLACE DECREMENT
15336 0074 00 4 02326 TSX UNSAVE,4
15337 -0534 00 4 03461 LXD REPS1,4
15340 0020 00 4 00001 TRA 1,4
15341 -3 00000 0 15342 REPP1 TXL *+1,,0
15342 -0634 00 4 01562 SXD $ERROR,4
15343 0500 00 0 03462 CLA REPV
15344 0074 00 4 01563 TSX $ERROR+1,4
15345 542160600454 BCI 1,*A 4* SETQ GIVEN ON NON-EXISTENT VARIABLE
SET
15346 -0634 00 4 15221 SETP SXD BFS1,4
15347 0601 00 0 15367 STO BFS5
15350 -0600 00 0 03415 STQ BFS2
15351 0560 00 0 15362 LDQ SETP1
15352 -0600 00 0 03321 STQ $ARG3
15353 0560 00 0 03447 LDQ PRGVAR
15354 0074 00 4 10042 TSX SASSOC,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 143
15355 -0734 00 4 00000 PDX ,4
15356 0500 00 0 03415 CLA BFS2
15357 0622 00 4 00000 STD 0,4
15360 -0534 00 4 15221 LXD BFS1,4
15361 0020 00 4 00001 TRA 1,4
15362 -3 00000 0 15363 SETP1 TXL *+1,,0
15363 -0634 00 4 01562 SXD $ERROR,4
15364 0500 00 0 15367 CLA BFS5
15365 0074 00 4 01563 TSX $ERROR+1,4
15366 542160600554 BCI 1,*A 5* SET GIVEN ON NON EXISTENT VARIABLE
15367 0 00000 0 00000 BFS5
* AND SPECIAL FORM
15370 -0100 00 0 15373 EVA8 TNZ EVA6
15371 0500 00 0 00442 CLA EVCT
15372 0020 00 4 00001 TRA 1,4
15373 -0634 00 4 03343 EVA6 SXD EVA1,4
15374 0074 00 4 02312 TSX $SAVE,4
15375 -3 03347 0 02375 TXL $END3,,EVA9+2 SAVE 3 ITEMS
15376 -0734 00 4 00000 PDX ,4
15377 0500 00 4 00000 EVA4 CLA ,4
15400 0601 00 0 03344 STO EVA2
15401 0734 00 4 00000 PAX ,4
15402 -0754 00 4 00000 PXD ,4
15403 -0600 00 0 03345 STQ EVA9
15404 0074 00 4 15454 TSX $EVAL,4
15405 0560 00 0 03345 LDQ EVA9
15406 -0100 00 0 15412 TNZ EVA3
15407 0074 00 4 02326 EVA5 TSX UNSAVE,4
15410 -0534 00 4 03343 LXD EVA1,4
15411 0020 00 4 00001 TRA 1,4
15412 -0534 00 4 03344 EVA3 LXD EVA2,4
15413 3 00000 4 15377 TXH EVA4,4,0
15414 0500 00 0 00442 CLA EVCT
15415 0020 00 0 15407 TRA EVA5
* OR SPECIAL FORM
15416 -0100 00 0 15421 EVR8 TNZ EVR6
15417 0500 00 0 00370 CLA EVCF
15420 0020 00 4 00001 TRA 1,4
15421 -0634 00 4 03435 EVR6 SXD EVR1,4
15422 0074 00 4 02312 TSX $SAVE,4
15423 -3 03441 0 02375 TXL $END3,,EVR9+2 SAVE 3 ITEMS
15424 -0734 00 4 00000 PDX ,4
15425 0500 00 4 00000 EVR4 CLA ,4
15426 0601 00 0 03436 STO EVR2
15427 0734 00 4 00000 PAX ,4
15430 -0754 00 4 00000 PXD ,4
15431 -0600 00 0 03437 STQ EVR9
15432 0074 00 4 15454 TSX $EVAL,4
15433 0560 00 0 03437 LDQ EVR9
15434 0100 00 0 15441 TZE EVR3
15435 0500 00 0 00442 CLA EVCT
15436 0074 00 4 02326 EVR5 TSX UNSAVE,4
15437 -0534 00 4 03435 LXD EVR1,4
15440 0020 00 4 00001 TRA 1,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 144
15441 -0534 00 4 03436 EVR3 LXD EVR2,4
15442 3 00000 4 15425 TXH EVR4,4,0
15443 0500 00 0 00370 CLA EVCF
15444 0020 00 0 15436 TRA EVR5
00442 EVCT SYN $QD1
00370 EVCF SYN $ZERO
15445 -0600 00 0 15221 EQP STQ BFS1
15446 0402 00 0 15221 SUB BFS1
15447 -0100 00 0 15452 TNZ *+3
15450 0500 00 0 00442 CLA BFQ1
15451 0020 00 4 00001 TRA 1,4
15452 -0754 00 0 00000 PXD ,0
15453 0020 00 4 00001 TRA 1,4
EVAL(E,A) 5/6/59
A HED
15454 -0634 00 4 03372 EVAL SXD EVS1,4
15455 0100 00 4 00001 TZE 1,4
15456 0601 00 0 16121 STO EVTE E
15457 -0734 00 4 00000 PDX ,4
15460 0500 00 4 00000 CLA ,4
15461 0625 00 0 16126 STT EVLNS SEE IF A NUMBER
15462 0520 00 0 16126 ZET EVLNS SKIP IF NOT A NUMBER
15463 0020 00 0 15542 TRA EV1N IS A NUMBER(CONSTANT)
15464 0734 00 4 00000 PAX ,4 CAR(E)
15465 3 77776 4 15545 TXH EVP1,4,-2 = - 1
15466 -0634 00 4 16122 SXD EVTAE,4 CAR(E)
15467 0634 00 4 03372 SXA EVS1,4 SAVE FUNCTION WITH INDEX REGISTER
15470 0622 00 0 03411 STD EVTDE CDR(E)
15471 0500 00 4 00000 CLA ,4
15472 0625 00 0 16126 STT EVLNS SEE IF A NUMBER
15473 0520 00 0 16126 ZET EVLNS TEST FOR A NUMBER
15474 0020 00 0 16007 TRA EVP26 UNDEFINED FUNCTION IF A NUMBER
15475 0734 00 4 00000 PAX ,4 CAAR(E)
15476 -3 77776 4 15756 TXL EVP27,4,-2 GO IF CAR(E) NOT AN ATOM
*
* CAAR(E) = -1
*
15477 0634 00 0 03375 SXA EVTRK,0 ZERO THE ADDRESS
15500 -0634 00 0 03375 SXD EVTRK,0 ZERO DECREMENT
15501 -0734 00 4 00000 EVP2 PDX ,4 CDAR(E)
15502 -3 00000 4 15642 TXL EVP25,4,0 NULL(J)
15503 0500 00 4 00000 CLA ,4
15504 0734 00 4 00000 PAX ,4 CAR(J)
15505 3 06647 4 15507 TXH *+2,4,$TRACE
15506 3 06646 4 15540 TXH EVTRT,4,$TRACE-1 =TRACE
15507 3 06733 4 15511 TXH *+2,4,$SUBR
15510 3 06732 4 15756 TXH EVP27,4,$SUBR-1 OF IF A SUBR
15511 3 10103 4 15513 TXH *+2,4,$FSUBR
15512 3 10102 4 15613 TXH EVP22,4,$FSUBR-1 =FSUBR
15513 3 10157 4 15515 TXH *+2,4,$EXPR
15514 3 10156 4 15634 TXH EVP23,4,$EXPR-1 =EXPR
15515 3 10142 4 15501 TXH EVP2,4,$FEXPR
15516 -3 10141 4 15501 TXL EVP2,4,$FEXPR-1 /= FEXPR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 145
15517 0622 00 0 03412 STD EVD2 CDR(J)
15520 -0600 00 0 03321 STQ $ARG3 A
15521 0500 00 0 03321 CLA $ARG3
15522 0560 00 0 00370 LDQ EVZRO 0
15523 0074 00 4 03730 TSX $CONS,4 CONS(A,0)
15524 0131 00 0 00000 XCA
15525 0500 00 0 03411 CLA EVTDE
15526 0074 00 4 03730 TSX $CONS,4 LIST(CDR(E),A)
15527 0131 00 0 00000 XCA
15530 -0534 00 4 03412 LXD EVD2,4 CDR(J)
15531 0500 00 4 00000 CLA ,4
15532 0734 00 4 00000 PAX ,4 CADR(J)
15533 -0754 00 4 00000 PXD ,4
15534 0520 00 0 03375 ZET EVTRK TEST FOR TRACE MODE
15535 0020 00 0 16031 TRA EVTXP
15536 -0534 00 4 03372 LXD EVS1,4
15537 0020 00 0 14663 TRA $APPLY APPLY(CADR(J),LIST(CDR(E),A),A)
*
15540 -0625 00 0 03375 EVTRT STL EVTRK SET THE TRACE SWITCH
15541 0020 00 0 15501 TRA EVP2 GO SEARCH MORE
*
*
* CAR(E) = -1
*
15542 0500 00 0 16121 EV1N CLA EVTE GET THE NUMBER
15543 -0534 00 4 03372 LXD EVS1,4 RESTORE LINK INDEX
15544 0020 00 4 00001 TRA 1,4
*
15545 -0734 00 4 00000 EVP1 PDX ,4 J
15546 -3 00000 4 15563 TXL EVP11,4,0 = 0
15547 0500 00 4 00000 CLA ,4
15550 0734 00 4 00000 PAX ,4 CAR(J)
15551 3 10742 4 15545 TXH EVP1,4,$APVAL = APVAL
15552 -3 10741 4 15545 TXL EVP1,4,$APVAL-1
15553 -0734 00 4 00000 EVP13 PDX ,4 CDR(J)
15554 0500 00 4 00000 CLA ,4
15555 0734 00 4 00000 PAX ,4 CADR(J)
15556 0500 00 4 00000 CLA ,4
15557 0734 00 4 00000 PAX ,4 CAADR(J)
15560 -0754 00 4 00000 PXD ,4
15561 -0534 00 4 03372 LXD EVS1,4
15562 0020 00 4 00001 TRA 1,4
*
15563 -0600 00 0 16123 EVP11 STQ EVTA A
15564 0500 00 0 16121 CLA EVTE E
15565 0622 00 0 15600 STD EVI1
15566 0402 00 0 00442 SUB EVQD1
15567 0622 00 0 15601 STD EVI2
15570 -0634 00 2 16125 SXD EVD1,2
15571 -0534 00 4 16123 LXD EVTA,4
15572 -3 00000 4 15607 EVL1 TXL EVP12,4,0 NULL(J)
15573 0500 00 4 00000 CLA ,4
15574 0734 00 2 00000 PAX ,2 CAR(J)
15575 -0734 00 4 00000 PDX ,4 CDR(J)
15576 0500 00 2 00000 CLA ,2
15577 0734 00 2 00000 PAX ,2 CAAR(J)
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 146
15600 3 00000 2 15572 EVI1 TXH EVL1,2,** CAAR(J) = E
15601 -3 00000 2 15572 EVI2 TXL EVL1,2,**
15602 -0734 00 4 00000 PDX ,4 CDAR(J)
15603 -0754 00 4 00000 PXD ,4
15604 -0534 00 2 16125 LXD EVD1,2
15605 -0534 00 4 03372 LXD EVS1,4
15606 0020 00 4 00001 TRA 1,4
*
15607 -0634 00 4 01562 EVP12 SXD $ERROR,4
15610 0500 00 0 16121 CLA EVTE
15611 0074 00 4 01563 TSX $ERROR+1,4
15612 542160601054 BCI 1,*A 8* UNBOUND VARIBLE MENTIONED -EVAL-
*
15613 -0734 00 4 00000 EVP22 PDX ,4 CDR(J) FSUBR
15614 0500 00 4 00000 CLA ,4
15615 0734 00 4 00000 PAX ,4 CADR(J)
15616 0500 00 4 00000 CLA ,4 CWADR(J)
15617 0601 00 0 16124 STO EVT1
15620 0500 00 0 03372 CLA EVS1 ATOM AN DIR4 FOR SAVING $ALIST
15621 0601 00 0 03315 STO CSV
15622 0074 00 4 02312 TSX $SAVE,4
15623 -3 03320 0 02377 TXL $END2,,$ALIST+2
15624 -0600 00 0 03316 STQ $ALIST
15625 0520 00 0 03375 ZET EVTRK TEST WHETERT TO TRACT
15626 0020 00 0 16014 TRA EVTFS YES,TRACE FSUBR
15627 0500 00 0 03411 CLA EVTDE GET BACK ARGUMENTS
15630 0074 00 4 16124 TSX EVT1,4
15631 0074 00 4 02326 TSX UNSAVE,4
15632 -0534 00 4 03315 LXD CSV,4
15633 0020 00 4 00001 TRA 1,4
*
* EVP23 THE EXPR BRANCH FOR EVAL
*
15634 -0734 00 4 00000 EVP23 PDX 0,4 REST OF PROPERTY LIST
15635 0500 00 4 00000 CLA 0,4 GET THE EXPR
15636 0734 00 4 00000 PAX 0,4
15637 -0634 00 4 16122 SXD EVTAE,4 SAVE IN TEMPORARY STORAGE
15640 -0534 00 4 02317 LXD $CPPI,4 PUSH DOWN COUNTER
15641 1 77773 4 15665 TXI EVP28,4,-5 SAVE 5 ITEMS
*
15642 0500 00 0 16122 EVP25 CLA EVTAE CAR(E)
15643 0622 00 0 15657 STD EVI3 TXH
15644 0402 00 0 00442 SUB EVQD1
15645 0622 00 0 15660 STD EVI4 TXL
15646 -0634 00 2 16124 SXD EVT1,2
15647 -0600 00 0 16125 STQ EVD1
15650 -0534 00 4 16125 LXD EVD1,4 A
15651 -3 00000 4 16007 EVL2 TXL EVP26,4,0 NULL(J)
15652 0500 00 4 00000 CLA ,4
15653 -0734 00 4 00000 PDX ,4 CDR(J)
15654 0734 00 2 00000 PAX ,2 CAR(J)
15655 0500 00 2 00000 CLA ,2
15656 0734 00 2 00000 PAX ,2 CAAR(J)
15657 3 00000 2 15651 EVI3 TXH EVL2,2,** /= CAR(E)
15660 -3 00000 2 15651 EVI4 TXL EVL2,2,**
15661 -0534 00 2 16124 LXD EVT1,2
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 147
15662 0622 00 0 16122 STD EVTAE SAVE FUNCTION
15663 -0534 00 4 02317 EV27 LXD $CPPI,4
15664 1 77773 4 15665 TXI *+1,4,-5 SAVE TOTAL OF 4 ITEMS
15665 0522 00 0 02414 EVP28 XEC ENDPDL TEST FOR OUT OF PUSH DOWN LIST
15666 -0634 00 4 02317 SXD $CPPI,4
15667 0500 00 0 03372 CLA EVS1
15670 0601 00 4 77773 STO -5,4
15671 0500 00 0 03373 CLA EVSE
15672 0601 00 4 77774 STO -4,4
15673 0500 00 0 03374 CLA EVSA
15674 0601 00 4 77775 STO -3,4
15675 0500 00 0 03375 CLA EVTRK
15676 0601 00 4 77776 STO -2,4
15677 0500 00 0 16127 CLA EVCM
15700 0601 00 4 77777 STO -1,4
15701 0500 00 0 16122 CLA EVTAE GET THE FUNCTION
15702 0622 00 0 03373 STD EVSE
15703 -0600 00 0 03374 STQ EVSA A
15704 0500 00 0 03411 CLA EVTDE CDR(E)
15705 0560 00 0 15763 LDQ ELP1 FUNCTIONAL ARGUMENT
15706 0074 00 4 04214 TSX MAPLIS,4 MAPLIST(L,EVAL(CAR(L),A))
15707 0601 00 0 16124 STO EVT1
15710 0500 00 0 03374 CLA EVSA
15711 0601 00 0 03321 STO $ARG3
15712 0500 00 0 03373 CLA EVSE
15713 -0534 00 4 02317 LXD $CPPI,4 START OPEN UNSAVE
15714 0560 00 4 77773 LDQ -5,4
15715 -0600 00 0 03372 STQ EVS1
15716 0560 00 4 77774 LDQ -4,4
15717 -0600 00 0 03373 STQ EVSE
15720 0560 00 4 77775 LDQ -3,4
15721 -0600 00 0 03374 STQ EVSA
15722 0560 00 4 77776 LDQ -2,4
15723 -0600 00 0 03375 STQ EVTRK
15724 1 00005 4 15725 TXI *+1,4,5
15725 -0634 00 4 02317 SXD $CPPI,4
15726 0560 00 0 16124 LDQ EVT1
15727 0520 00 0 03375 ZET EVTRK TEST RACE SWITCH
15730 0020 00 0 15733 TRA EVDCO DECODE EVTRAK
15731 -0534 00 4 03372 EVAPG LXD EVS1,4
15732 0020 00 0 14663 TRA $APPLY APPLY(CADAR(J),EVLIS(CDR(E),A),A)
*
* IF CAR E IS A SUBR, THE POINTRE TO THE TXL INSTRUCTION
* IS SAVED IN THE DECREMENT OF VETRK. THE ADDRESS OF
* EVTRK IS THE TRACE SWITCH.
*
15733 -0534 00 4 03375 EVDCO LXD EVTRK,4 LOOK FOR SUBR POINTER
15734 -3 00000 4 16031 TXL EVTXP,4,0 THERE ISNT ANY. SO GO AND TRACE EXPR
15735 0534 00 4 03375 LXA EVTRK,4 SEE IF THE SUBR IS TRACED
15736 3 00000 4 15731 TXH EVAPG,4,0 YES IT IS. LET APPLY HANDLE IT
15737 -0534 00 4 03375 LXD EVTRK,4 GET THE TXL SUBR WORD
15740 0500 00 4 00000 CLA 0,4
15741 0601 00 0 16124 STO EVT1 READY TO EXECUTE
15742 0500 00 0 03372 CLA EVS1 GET RETURN INDEX AND ATOM NAME
15743 0601 00 0 03315 STO CSV AND SAVE THEM ALONG WITH $ALIST
15744 0074 00 4 02312 TSX $SAVE,4
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 148
15745 -3 03320 0 02377 TXL $END2,,$ALIST+2
15746 0500 00 0 03321 CLA $ARG3
15747 0601 00 0 03316 STO $ALIST POST CURRENT ALIST
15750 0131 00 0 00000 XCA ARGUMENT LIST TO AC
15751 0074 00 4 10072 TSX $SPREAD,4 SMEAR IT OUT
15752 0074 00 4 16124 TSX EVT1,4 EXECUTE SUBR
15753 0074 00 4 02326 TSX UNSAVE,4 RESTORE ALIST AND IX
15754 -0534 00 4 03315 LXD CSV,4
15755 0020 00 4 00001 TRA 1,4 AND RETURN
*
15756 -0734 00 4 00000 EVP27 PDX 0,4 SUBR BRANCH
15757 0500 00 4 00000 CLA 0,4
15760 0734 00 4 00000 PAX 0,4 POINTER TO TXL WORD
15761 -0634 00 4 03375 SXD EVTRK,4 TO SAVE POSITION
15762 0020 00 0 15663 TRA EV27 EVALUATE ARGUMENTS
*
15763 -3 00000 0 15764 ELP1 TXL *+1,,0
15764 0634 00 4 15772 SXA ELT1,4 SAVE LINK IR
15765 -0734 00 4 00000 PDX ,4 J
15766 0500 00 4 00000 CLA ,4
15767 0734 00 4 00000 PAX ,4
15770 -0754 00 4 00000 PXD ,4 CAR(J)
15771 0560 00 0 03374 LDQ EVSA GET CURRENT A LIST
15772 0774 00 4 00000 ELT1 AXT **,4 RESTORE LINK IR
15773 0020 00 0 15454 TRA $EVAL
*
* EVLIS
*
15774 -0634 00 4 03372 EVLIS SXD EVS1,4 SAVE LINK IR
15775 0774 00 4 10167 AXT EVLISL,4 ATOM EVLIS
15776 0634 00 4 03372 SXA EVS1,4 FOR BACKTRACE
15777 0074 00 4 02312 TSX $SAVE,4 SAVE EVAL STORAGE
16000 -3 03376 0 02375 TXL $END3,,EVSA+2
16001 -0600 00 0 03374 STQ EVSA
16002 0560 00 0 15763 LDQ ELP1
16003 0074 00 4 04214 TSX MAPLIS,4
16004 0074 00 4 02326 TSX UNSAVE,4
16005 -0534 00 4 03372 LXD EVS1,4
16006 0020 00 4 00001 TRA 1,4
*
16007 -0634 00 4 01562 EVP26 SXD $ERROR,4
16010 -0534 00 2 16124 LXD EVT1,2
16011 0500 00 0 16121 CLA EVTE
16012 0074 00 4 01563 TSX $ERROR+1,4
16013 542160601154 BCI 1,*A 9* FUNCTION OBJECT HAS NO DEFINITION EVAL
*
16014 0734 00 4 00000 EVTFS PAX 0,4 ATOM NAME
16015 -0754 00 4 00000 PXD 0,4 TO PRINT POSITION
16016 0560 00 0 03411 LDQ EVTDE
16017 0074 00 4 16050 TSX ARGOF,4 PRINT ARGUMENT MESSAGE
16020 0560 00 0 03316 LDQ $ALIST RESTORE ALIST AFTER ARGOF
16021 0500 00 0 03411 CLA EVTDE AND ARGUMENT LIST
16022 0074 00 4 16124 TSX EVT1,4 DO THE FSUBR
16023 0074 00 4 02326 TSX UNSAVE,4 RESTORE THE IR
16024 0131 00 0 00000 XCA VALUE TO MQ
16025 0534 00 4 03315 LXA CSV,4 GET ATOM NAME FOR VALUE MESSAGE
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 149
16026 -0754 00 4 00000 PXD 0,4 TO AC
16027 -0534 00 4 03315 LXD CSV,4 AND RETURN IR4
16030 0020 00 0 16104 TRA VALOF PRINT VALUE MESSAGE
*
16031 0622 00 0 03411 EVTXP STD EVTDE SAVE LAMBDA EXPRESSION
16032 0534 00 4 03372 LXA EVS1,4 GET ATOMIC FUNCTION
16033 -0754 00 4 00000 PXD 0,4 TO PRINT POSITION
16034 0074 00 4 16050 TSX ARGOF,4 PRINT ARGUMENT MESSAGE
16035 0074 00 4 02312 TSX $SAVE,4 SAVE THE RETURN IX
16036 -3 03374 0 02401 TXL $END1,,EVS1+2
16037 0560 00 0 16124 LDQ EVT1 RESTORE THE LIST OF ARGUMENTS
16040 0500 00 0 03411 CLA EVTDE AND THE LAMBDA EXPRESSION
16041 0074 00 4 14663 TSX $APPLY,4 APPLY THE FUNCTION TO ITS ARGS
16042 0074 00 4 02326 TSX UNSAVE,4
16043 0131 00 0 00000 XCA PUT VALUE IN AC
16044 0534 00 4 03372 LXA EVS1,4 NAME OF ROUTINE TRACED
16045 -0754 00 4 00000 PXD 0,4 PUT IN AC
16046 -0534 00 4 03372 LXD EVS1,4 LINK IR
16047 0020 00 0 16104 TRA VALOF PRINT VALUE OF STATEMETN
*
* ARGOF PRINTS ARGUMENTS OF NAME FOLLOWED BY THE LIST OF ARGUMEN
*
16050 0634 00 4 16074 ARGOF SXA PRX,4 SAVE INDEX REGISTERS
16051 0634 00 2 16073 SXA PRY,2
16052 0601 00 0 16076 STO AGA SAVE ATOM NAME
16053 -0600 00 0 16077 STQ AGQ SAVE LIST OF ARGUMENTS
16054 0074 00 4 05214 TSX TERPRI,4 PRINT A BLANK LINE
16055 0774 00 2 00003 AXT 3,2 PRINT2 OUT 3 WORDS
16056 0500 00 2 16103 CLA AGM+3,2
16057 0074 00 4 05110 TSX $PRIN2,4
16060 2 00001 2 16056 TIX *-2,2,1 LOOP
16061 0500 00 0 16076 CLA AGA
16062 0074 00 4 04604 TSX $PRINT,4 PRINT OUT THE LINE
16063 -0534 00 2 16077 LXD AGQ,2 START THE PRINLIS
16064 -3 00000 2 16073 PLL TXL PRY,2,0 EXIT IF END OF LIST
16065 0500 00 2 00000 CLA 0,2 NEXT ITEM
16066 -0734 00 2 00000 PDX 0,2 CDR OF LIST
16067 0734 00 4 00000 PAX 0,4 CAR
16070 -0754 00 4 00000 PXD 0,4
16071 0074 00 4 04604 TSX $PRINT,4
16072 0020 00 0 16064 TRA PLL GET NEXT ITEM
16073 0774 00 2 00000 PRY AXT **,2 RESTORE INDEX REGISTERS
16074 0774 00 4 00000 PRX AXT **,4
16075 0020 00 4 00001 TRA 1,4 EXIT
*
16076 0 00000 0 00000 AGA TEMPORARY STORAGE
16077 0 00000 0 00000 AGQ
16100 215127644425 AGM BCI 1,ARGUME
16101 -056362607777 OCT 456362607777 ARGUMENTS
16102 -062660777777 AGO OCT 462660777777 OF
16103 652143642560 VALV BCI 1,VALUE
*
* VALOF PRINTS VALUE OF NAME FOLLOWED BY ONE LIST
* SHARES STORAGE WITH ARGOF ROUTINE
*
16104 0634 00 4 16117 VALOF SXA VAX,4 SAVE LINK IR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 150
16105 0601 00 0 16076 STO AGA ATOM NAME
16106 -0600 00 0 16077 STQ AGQ VALUE OF EXPRESSION
16107 0074 00 4 05214 TSX TERPRI,4 PRINT A BLANK LINE
16110 0500 00 0 16103 CLA VALV WORD VALUE
16111 0074 00 4 05110 TSX $PRIN2,4 PUT IN OUTPUT LINE
16112 0500 00 0 16102 CLA AGO WORD OF
16113 0074 00 4 05110 TSX $PRIN2,4
16114 0500 00 0 16076 CLA AGA ATOM
16115 0074 00 4 04604 TSX $PRINT,4 PRINT OUT THE LINE
16116 0500 00 0 16077 CLA AGQ VALUE
16117 0774 00 4 00000 VAX AXT **,4 RESTORE LINK IR
16120 0020 00 0 04604 TRA $PRINT PRINT OUT VALUE AND RETURN
16121 0 00000 0 00000 EVTE E
16122 0 00000 0 00000 EVTAE CAR(E)
16123 0 00000 0 00000 EVTA A
16124 0 00000 0 00000 EVT1
16125 0 00000 0 00000 EVD1
16126 0 00000 0 00000 EVLNS TST CELL FOR NUMBERS
16127 -3 03377 0 02373 EVCM TXL $END4,,EVTRK+2
00370 EVZRO SYN $ZERO
00442 EVQD1 SYN $QD1
* INTER MULTIPLE LISP STATEMENT PROGRAM FEATURE INTERPRETER
* RECODED TO MAKE THE INTERPRETER AND COMPILER PROGRAM
* FEATURE UNDERSTAND THE SAME LANGUAGE
*
R HED
16130 -0634 00 4 03444 INTER SXD INTRX,4 SAVE LINK IR
16131 0074 00 4 02312 TSX $SAVE,4 SAVE PROTECTED TEMPORARY STORAGE
16132 -3 03452 0 02371 TXL $END5,,INTGS+2 SAVE 5 ITEMS
16133 0634 00 2 03446 SXA INTGL,2 SAVE INDEX REGISTER 2
16134 -0600 00 0 03447 STQ INTPL SAVE PAIR LIST
16135 0600 00 0 03450 STZ INTGS ZERO THE GO SWITCH
16136 -0734 00 4 00000 PDX 0,4 POINTER TO PROGRAM
16137 0500 00 4 00000 CLA 0,4 FIRST WORD
16140 0622 00 0 03445 STD INTB POINTER TO BEGINNING OF PROGRAM
16141 0622 00 0 16271 STD INTE DITTO
16142 0734 00 4 00000 PAX 0,4 POINTER TO LIST OF PROGRAM VARIABLES
16143 -0754 00 4 00000 PXD 0,4 TO DECREMENT
16144 0560 00 0 16242 LDQ INTFB FUNCTIONAL ARGUMENT
16145 0074 00 4 04214 TSX MAPLIS,4 (MAPLIST PV (LAMBDA (L) (CONS (CAR L)
16146 0560 00 0 03447 LDQ INTPL NIL))) PICK UP PAIR LIST
16147 0074 00 4 07675 TSX $NCONC,4 ATTACH PROGARM VARIBLES TO PAIR LIST
16150 0601 00 0 03447 STO INTPL PUT IN PAIR LISDT REGISTER
16151 0560 00 0 00370 LDQ $ZERO ZERO THE MQ
16152 -0534 00 4 16271 INTGM LXD INTE,4 SEARCH PROGRAM FOR GO TO POINTS
16153 -3 00000 4 16166 TXL INTAA,4,0 GO IF END OF PROGRAM
16154 0500 00 4 00000 CLA 0,4 NEXT WORD
16155 0622 00 0 16271 STD INTE SAVE CDR
16156 0734 00 2 00000 PAX 0,2 CAR
16157 0500 00 2 00000 CLA 0,2 MAKE ATOM TEST
16160 0734 00 2 00000 PAX 0,2
16161 -3 77776 2 16152 TXL INTGM,2,-2 GO IF NOT AN ATOM
16162 -0754 00 4 00000 PXD 0,4 IS AN ATOM, PUT POINTER TO CURRENT LOC
16163 0074 00 4 03730 TSX $CONS,4 PUT ON GO LOST
16164 0131 00 0 00000 XCA ANSWER TO MQ
16165 0020 00 0 16152 TRA INTGM NEXT ITEM
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 151
16166 -0620 00 0 03446 INTAA SLQ INTGL ALL DONE, STORE GO LIST
16167 -0534 00 4 03445 INTGA LXD INTB,4,0 NEXT PROGRAM LOCATION
16170 -3 00000 4 16262 TXL INTRN,4,0 RETURN WITH NIL IF RAN OUT OF STATEMEN
16171 0500 00 4 00000 CLA 0,4 NEXT WORD
16172 0622 00 0 03445 STD INTB SAVE CDR
16173 0734 00 4 00000 PAX 0,4 CAR
16174 0500 00 4 00000 CLA 0,4 FIRST WORD
16175 0734 00 2 00000 PAX 0,2 CHECK FOR ATOM OR $COND
16176 3 77776 2 16167 TXH INTGA,2,-2 GO TO NEXT STEP IF ATOM
16177 -3 10457 2 16221 TXL INTEV,2,$COND-1 GO TO EVAL IF NOT $COND
16200 3 10460 2 16221 TXH INTEV,2,$COND
16201 -0734 00 2 00000 PDX 0,2 IS $COND DO AN EVCOND
16202 -3 00000 2 16167 INTEB TXL INTGA,2,0 GO TO NEXT STEP IF COND UNSATISFIED
16203 0500 00 2 00000 CLA 0,2 FIRST COND STATEMENT
16204 -0734 00 2 00000 PDX 0,2 CDR
16205 0734 00 4 00000 PAX 0,4 FIRST SUB COND
16206 0500 00 4 00000 CLA 0,4
16207 -0734 00 4 00000 PDX 0,4 POINTER TO THEN PART
16210 0634 00 4 03445 SXA INTB,4 SAVE IN PROTECTED STORAGE
16211 0734 00 4 00000 PAX 0,4 POINTRE TO IF PART
16212 -0754 00 4 00000 PXD 0,4 PUT IN DECREMENT
16213 0560 00 0 03447 LDQ INTPL PAIR LIST
16214 0074 00 4 15454 TSX $EVAL,4 EVALUATE IT
16215 0100 00 0 16202 TZE INTEB GO IF IF PART IS FALSE
16216 0534 00 4 03445 LXA INTB,4 GET THEN PART
16217 0500 00 4 00000 CLA 0,4
16220 0734 00 4 00000 PAX 0,4 PPRINTER TPO THEN PART
16221 -0754 00 4 00000 INTEV PXD 0,4 LIST TO BE EVALUATED
16222 0560 00 0 03447 LDQ INTPL GET PAIR LIST
16223 0074 00 4 15454 TSX $EVAL,4 EVALUATE IT
16224 -0520 00 0 03450 NZT INTGS SEE IF GO SWITCH SET
16225 0020 00 0 16167 TRA INTGA GO TO NEXT STATEMENT
16226 0534 00 4 03450 LXA INTGS,4 WAS SET, SEE IF GO OR RETURN
16227 3 77776 4 16262 TXH INTRN,4,-2 TRA IF RETURN
16230 -0754 00 4 00000 PXD 0,4 POINTER TO ITEM
16231 0560 00 0 16253 LDQ INTFC GET SASSOC FUNCTIONAL ARGUMENT
16232 -0600 00 0 03321 STQ $ARG3 PUT IN $ARG3
16233 0560 00 0 03446 LDQ INTGL GET GO LIST
16234 0074 00 4 10042 TSX SASSOC,4 SEARCH FOR ATOM
16235 -0734 00 4 00000 PDX 0,4 POINTRE TP PROGRAM POINT
16236 0500 00 4 00000 CLA 0,4 TAKE CDR
16237 0622 00 0 03445 STD INTB SET PROGRAM POINT
16240 0600 00 0 03450 STZ INTGS ZERO THE GO SWITCH
16241 0020 00 0 16167 TRA INTGA GO TO THAT STATEMENT
*
16242 -3 00001 0 16243 INTFB TXL *+1,,1 MAPLIST FUNCTIONAL ARGUMENT
16243 0634 00 4 16251 SXA INTFX,4 (LAMBDA (L) (CONS (CAR L) NIL))
16244 -0734 00 4 00000 PDX 0,4
16245 0500 00 4 00000 CLA 0,4
16246 0734 00 4 00000 PAX 0,4
16247 -0754 00 4 00000 PXD 0,4
16250 0560 00 0 00370 LDQ $ZERO
16251 0774 00 4 00000 INTFX AXT **,4
16252 0020 00 0 03730 TRA $CONS
*
16253 -3 00001 0 16254 INTFC TXL *+1,,1 UNLABELED GO TO POINT ERROR
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 152
16254 -0634 00 4 01562 SXD $ERROR,4 SAVE LINK IR
16255 0534 00 4 03450 LXA INTGS,4 POINTER TO GO POINT LABEL
16256 -0754 00 4 00000 PXD 0,4 PUT IN DECREMENT
16257 0534 00 2 03446 LXA INTGL,2 RESTORE INDEX REGISTER 2
16260 0074 00 4 01563 TSX $ERROR+1,4 GO TO ERROR
16261 542160600654 BCI 1,*A 6* GO TO POINT NOT LABELED
*
16262 -0534 00 4 03450 INTRN LXD INTGS,4 RETURN VALUE
16263 -0754 00 4 00000 PXD 0,4 PUT IN DECREMENT
16264 0600 00 0 03450 STZ INTGS ZERO THE GO SWITCH
16265 0534 00 2 03446 LXA INTGL,2 RESTORE INDEX REGISTER 2
16266 0074 00 4 02326 TSX UNSAVE,4 RESTORE PROTECTED STORAGE
16267 -0534 00 4 03444 LXD INTRX,4 RESTORE LINK IR
16270 0020 00 4 00001 TRA 1,4
* TEMPORARY STORAGE FOR INTERPRETERS
16271 0 00000 0 00000 INTE TEMPORARY STORAGE
03447 PRGVAR SYN INTPL
*
*
* RETURN SPECIAL PROGRAM SETS RETURN SWITCH
* IN PROGRAM INTERPRETER
*
16272 -0501 00 0 00457 RETURN ORA $AMASK SIGNAL THAT IT IS A RETURN
16273 0601 00 0 03450 STO INTGS SET UP GO SWITCH
16274 0500 00 0 00442 CLA $QD1 PICK UP TRUTH VALUE
16275 0020 00 4 00001 TRA 1,4 EXIT
*
* GO SPECIAL FORM FOR PROGRAM INTERPRETER, GIVES GO TO POINT
*
16276 -0634 00 4 03413 GOGOGO SXD GOX,4 SAVE LINK IR
16277 -0734 00 4 00000 PDX 0,4 POINTER TO ARGUMENT LIST
16300 0500 00 4 00000 CLA 0,4
16301 0621 00 0 03450 STA INTGS PUT GAR IN GO SWITCH
16302 0734 00 4 00000 PAX 0,4 CAR TO IR
16303 0500 00 4 00000 CLA 0,4 GET FIRST WORD
16304 0734 00 4 00000 PAX 0,4 SEE IF ATOMIC
16305 3 77776 4 16316 TXH GOT,4,-2 EXIT TRUE IF ATIMIC
16306 0534 00 4 03450 LXA INTGS,4 OTHERWISE GET ARGUMENT
16307 -0754 00 4 00000 PXD 0,4 PUT INDECREMENT
16310 0074 00 4 02312 TSX $SAVE,4 SAVE LINK IR
16311 -3 03415 0 02401 TXL $END1,,GOX+2 SAVE 1 ITEM
16312 0074 00 4 15454 TSX $EVAL,4 EVALUATE THE ARGUMENT
16313 0074 00 4 02326 TSX UNSAVE,4 RSTORE LINK IR
16314 -0734 00 4 00000 PDX 0,4 VALUE
16315 0634 00 4 03450 SXA INTGS,4 PU IN GO SWITCH
16316 0500 00 0 00442 GOT CLA $QD1 TRUTH VALUE
16317 -0534 00 4 03413 LXD GOX,4 RESTORE LINK IR
16320 0020 00 4 00001 TRA 1,4 EXIT
*
* DECK LAP PART ONE
HEAD C THIS IS THE COMPILER AND ASMBLR
*
* LAP IS THE ASSEMBLER. ONE ARG IS LISTING. IT IS LIST OF INSTRUC-
* TIONS, NON-ATOMIC OR NIL. THE ATOMIC SYMBOLS ARE LOCATION SYMBOLS
* SECOND ARG IS START OF SYMBIL TABLE WHICH IS AN A-LIST.
* THE FIRST ITEM IS ORG AS FOLLOWS-
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 153
* NIL= IN BPS
* ATOM= AT SYMBOLIC LOCATION
* NUM= ATHIS NUMBER
* (NAME TYPE NUM) = IN BPS, AND PUT TXL ON PROP LIST OF NAME
* WITH FLAG TYPE AND NUM (B DEC. OF TXL.
* INSTRUCTION FORMAT IS (OP ADDR TAG DEC)
* FIELD FORMAT IS AS FOLLOWS-
* TEMP SYMBOL
* NUMBER
* SYM SUBR OR FSUBR
* (E NAME) FOR IMMEDIATE AS IN TXL FILTER
* (QUOTE NAME) FOR IMTE IN DEC OF WORD ON QTLST
* POINTER TO COMMON WORD.MAKES ONE IF NONE ALREADY
* SUM OF ANY OF ABOVE
* LAP IS IDENTITY FUNCTION
* LAP DOES NOT USE IX1. IX2,4 ARE SCARTCH
* ERRORS IN LAP AS FOLLOWS-
* *L 1* UNABLE TO EVALUATE ORIGIN
* *L 2* OUT OF BPS DISCOVERED AFTER PASS 1
* *L 3* UNDEFINED SYMBOL
* *L 4* FIELD WAS RECURSIVE
*
16321 0634 00 4 16470 LAP SXA LAX,4
16322 0634 00 2 16471 SXA LAX+1,2
16323 0601 00 0 16477 STO LIST THIS IS THE INPUT
16324 -0600 00 0 16501 STQ TAB START OF SYMBOL TABLE
16325 -0734 00 4 00000 PDX 0,4
16326 0500 00 4 00000 CLA 0,4
16327 0622 00 0 16505 STD REST SAVE REST OF LISTING
16330 0734 00 2 00000 PAX 0,2 ORIGIN IN IX2
16331 -3 00000 2 16356 TXL INBP,2,0 NIL MEANS BPS ASSEMBLY
16332 0500 00 2 00000 CLA 0,2
16333 0734 00 4 00000 PAX 0,4 CAR OF ORIGIN
16334 -3 77776 4 16356 TXL INBP,4,-2 NOT ATOM MEANS BPS MODE SO GO
16335 -0625 00 0 16511 STL MODE NOISE = NOT BPS
16336 -0754 00 2 00000 PXD 0,2 MAKE NUMBER TEST
16337 0074 00 4 14445 TSX NUMBRP,4
16340 -0100 00 0 16351 TNZ LSQ IF A NUMBER
16341 -0754 00 2 00000 PXD 0,2 ORIGIN TO AC
16342 0560 00 4 00510 LDQ $QSYMD,4 (QUOTE SYM)
16343 0074 00 4 11771 TSX GET,4
16344 -0100 00 0 16350 TNZ *+4 ORIGINA WAS FIOUND
16345 -0634 00 4 01562 SXD $ERROR,4
16346 -0754 00 2 00000 PXD 0,2 SHOW IT
16347 0074 00 4 01563 TSX $ERROR+1,4 UNDEFINED ORIGIN
16350 544360600154 BCI 1,*L 1*
16351 -0754 00 2 00000 LSQ PXD 0,2
16352 0074 00 4 14342 TSX NUMVAL,4 GET NUMERICAL VALUE
16353 -0734 00 4 00000 LSO PDX 0,4
16354 0500 00 4 00000 CLA 0,4 PUTS SYM IN AC FOR NOT BPS MODE
16355 0020 00 0 16361 TRA *+4
16356 0500 00 0 02304 INBP CLA $ORG PUTS ORG IN AC FOR BPS MODE
16357 0600 00 0 16511 STZ MODE INDICATES BPS MODE
16360 0074 00 4 16535 TSX JUST,4 JUSTIFY AC
16361 0601 00 0 16506 STO STAR UPDATE MARKER
16362 0601 00 0 16507 STO START RESET MARKER
1 FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961 9/01/61 PAGE 154
16363 0600 00 0 16510 STZ PASWD INDICATE PASS 1
16364 0074 00 4 16543 TSX PASS,4
16365 0500 00 0 16501 CLA TAB
16366 0074 00 4 04604 TSX $PRINT,4 PRINT SYMBOL TABLE
16367 0520 00 0 16511 ZET MODE
16370 0020 00 0 16373 TRA *+3 IF NOT IN BPS MODE
16371 0534 00 4 16506