-
Notifications
You must be signed in to change notification settings - Fork 4
/
lisp15.asm
11092 lines (11092 loc) · 488 KB
/
lisp15.asm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
PCC PAGE 006
ZST
* M948-508,FMS,DEBUG,20,40,20000,700 ASSEMBLE LISP 1.5 LISPHERE
* FAP
COUNT 13000
ABS
* FIELD TEST ASSEMBLY OF LISP 1.5 SEPTEMBER 1961
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*
* 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
ORG -47 IO POSITION LOAD AT -42
* 709 BINARY-OCTAL BOOTSTRAP LOADER
IOCD LOAD,0,21 COMMAND TO LOAD REMAINDER OF LOADER
TCOA 1 DELAY TILL LOADER IN
TRA LOAD
LOAD RCDA INITIATE NEXT CARD
RCHA LOAD5
TCOA * DELAY TILL CARD IS IN
TEFA CONTIN
CAL 9L
TZE LOAD8 ZERO IMPLIES OCTAL CARD
PDX ,6 SET WORD COUNT
STP LOAD4 SET TO CHECK OR IGNORE SUM
STA LOAD2 SET CARD ORIGIN
LOAD2 TXL ****,4,0 OUT IF TRANSFER CARD
AXT 0,4 SET I4 TO ZERO
LOAD3 LDQ 9R+1,4 PICK UP WORD
STQ* LOAD2 STORE WORD
ACL* LOAD2 ADD TO CHECK SUM
TXI *+1,4,-1 ADVANCE FOR NEXT WORD
TIX LOAD3,2,1 COUNT WORDS TO BE STORED
ERA 9R COMPARE CHECK SUMS
TZE LOAD AGREE-LOAD NEXT CARD
LOAD4 HTR LOAD ERROR-START TO READ NEXT CARD
LOAD5 IOCD 9L,0,24 COMMAND TO BRING IN BINARY IMAGE
LOAD8 AXT 14,5 14 TO IR1 AND IR 4
*
ABS RESUME STANDARD PUNCHING
*
LOAD9 AXT 2,2 SET TO COUNT FIELD PAIRS
CAL 9L+18,4 ROW
ORS 9L+14,1 ROW UNION
LDQ 9L+14,1
TXI LOD11,2,22 SET TO PEEL OFF SIX BITS
LOD10 TXH *+2,4,2 SKIP STORE TILL AFTER ONE-ROW
SLW **** STORE OCTAL CORRECTION
TIX *-3,2,1 ADVANCE TO NEXT PAIR, THIS HALF
TIX LOAD9,4,2 ADVANCE TO NEXT ROW
TNX LOAD+1,5,13 OUT AFTER RIGHT HALF PAGE 007
RCDA START NEXT CARD
TXI LOAD9,5,12 ADVANCE TO RIGHT HALF CARD
LOD11 CLM CLEAR AC
ALS 2
LGL 1 PEEL OFF BITS
TIX LOD11+1,2,4 COUNT COLUMNS PER FIELD
TXH *+2,4,12 USE 7-ROW AS FIRST SUM
ACL 11L+4,2 ADD PREVIOUS SUM
SLW 11L+4,2 NEW PARTIAL SUM
TNX LOD10,2,2 OUT IF SECOND FIELD OF PAIR
STA LOD10+1 STORE ADDRESS OF CORRECTION
TXI LOD11,2,44 RETURN TO PEEL OFF 12 BITS
*
-1,,-STS LEAD WORD FOR ATOM VERITAS-NUMQUAM-PERIT
*
ORG LOAD-34 COMMON STORAGE
COMMON BSS 0
9L BSS 24 INPUT BUFFER
9R SYN 9L+1 CARD CHECK SUM
11L SYN 9L+20 TEMPORARY FOR OCTAL
LOADER SYN LOAD
*
* PROPERTY LISTS FOR THE SPECIAL ATOMS NIL AND VERITAS-NUNQUAM-PERIT THE
* ZERO AND THE BINARY TRUTH ATOMS RESPECTIVELY
*
ORG COMMON-18
NILSXX $PNAME,,-*-1
-*-1
MZE -*-1
OCT 453143777777 NIL
NILLOC $ZERO
*
STS $APVAL,,-*-1
MZE -*-1,,-*-2
1 IS A CONSTANT ,,1 FOR APPLY
$PNAME,,-*-1
-*-1
MZE -*-1
BCI 1,*TRUE*
*
REM **************************************************
REM BOOTSTRAP RECORD FOR 709 LISP
REM
ORG 100 BEGIN LISP
HEAD B
*
* BOTTOM THE BOOTSTRAP RECORD FOR LISP ON SYSTEM AND TEMPORARY TAP
*
BOTTOM IOCD BOTTOM+3,,BSRECL-2 I-O COMMAND TO READ IN BOOTSTRAP REC.
TCOA 1 WAIT UNTIL RECORD IS READ IN
TRA BOTTOM+3 START F LISP
AXT 3,4 NUMBER OF WORDS IN LOWER MEMORY
CLA 3,4 MOVE THEM TO ORIGINAL POSITION
STO BOTTOM+3,4 PAGE 008
TIX *-2,4,1
AXT BSRECL,4 LENGTH OF BOOTSTRAP RECORD
PXD ,0, CLEAR THE AC
ACL CHKSUM,4 COMPUTE THE CHECK SUM FOR RECORD
TIX *-1,4,1
ERA CHKSUM COMPARE WITH THE CHECKSUM ON TAPE
TZE *-2 SKIP IF THEY ARE EQUAL
HPR 1 THEY DO NOT, STOP
CLA STRA STR TRAP
STO 2 SET STR CELL
CLA FLTRA FLOATING POINT TRAP
STO 8 SET TRAP CELL
CLA SYSTAP TAPE SPECIFICATION FOR SYSTEM TAPE
TSX $(IOS),4 SET UP I-O COMMANDS
TSX LRTAPE,4 READ REST OF SYSTEM TAPE
LOWREG,,-LOWREG REST OF CORE
XEC $REW REWIND SYSTAP
TRA $LOAD GO TO READ ANY CORRECTION CARDS
*
CONTIN CLA ZERO LOADER RETURNS HERE, GO TO OVERLORD
STO 0 SET ZERO CELL
TRA OVRLRD GO. TO OVERLORD
*
* NORMAL CONTENTS FOR CELLS 0, 2, 10 (OCTAL) RESPECTIVELY
*
ZERC -1,,-NILSXX BEGINNING OF ATOM NIL
FLTRA TTR FLAPTR
STRA TTR C$LINK
FLAPCX SYN FLTRA
FLAPCY SYN STRA
FLAPCZ SYN ZERC
*
*
* LRTAPE LISP READ TAPE PROGRAM FOR BINARY TAPES
*
LRTAPE CLA 1,4 PARAMETER WORD
SXA RTRX,4 SAVE INDEX REGISTERS
SXD RTRX,2
RTTWO PAX 0,2 START ADDRESS
STO *+1 COUNT
TXI *+1,2,** END + 1 ADDRESS
SXA RTADR,2 INITIALIZE ADDRESS
PDX 0,2 COUNT IN IR 2
CLA RTTWO TAG OF 2
STT RTADR SET TAG
SXD RTADR,0 ZERO DECREMENT
CLA $LCH PICK UP CURRENT LOAD CHANNEL INS.
STO RTLCH MAKE IMMUNE FROM OVER WRITING
CLA $(IOU) GET CURRENT I-O UNIT
STO RTIOU MAKE PREVENT OVERWRITING
STL $TCO WAIT FOR CHANNEL
XEC $TCO TO GO OUT OF OPERATION
IOT TURN OFF I-O CHECK PAGE 009
NOP
AXC *,4
XEC $TRC TURN OFF INDICATOR
XEC $TEF TURN OFF INDICATOR
RTRD XEC $RDS SELECT TAPE
PXD 0,0 CLEAR AC
AXC RTIOC,5 POINTER TO I-O COMMAND
XEC $RCH RESET AND LOAD CHANNEL
RTLC XEC RTLCH LOAD CHANNEL
LDQ CHKSUM PICK UP WORD READ IN
STQ* RTADR PUT IT AWAY
ACL* RTADR ADD TO CHECK SUM
TIX RTLC,2,1 DO ANOTHER LOAD CHANNEL
AXC RTIOD,4 POINTER TO DISCONNECT INSTRUCTION
XEC RTLCH XEC LCH INS.
ERA CHKSUM SUBSTRACT CHECK SUMS
SLW CHKSUM STORE DIFFERECE
CLA RTIOU PICK UP CURRENT IOU
TSX $(IOS),4 SET UP I-O COMMANDS
STL $TCO WAIT FOR CHANNEL TO GO OUT OF OPERATION
XEC $TCO
IOT TEST INDICATOR
TRA RCK TRY AGAIN
ZET CHKSUM SKIP IF CHECK SUMS AGREE
TRA RCK TRY AGAIN
AXC RCK,4
XEC $TRC TEST FOR REDUNDANCY
XEC $TEF AND EOF
LXA RTRX,4 RESTORE INDEX REGISTERS
LXD RTRX,2
TRA 2,4 EXIT
*
RCK LXD RTADR,2 DID NOT WORK, SEE IF FIRST OR SECOND
TXL *+2,2,0
HPR 2 SECOND TRY FAILED, STOP
SXD RTADR,4 MAKE NON-ZERO
XEC $BSR BACK SPACE AND TRY AGAIN
LXA RTRX,4 GET CALL WORD IR
CLA 1,4 CALL PARAMETER
PDX 0,2 COUNT TO IR 2
TRA RTRD
*
RTIOC IOCT CHKSUM,,1 BRING IN 1 WORD
RTIOD IOCD 0,,0 DISCONNECT CHANNEL
*
*
* (IOS) INPUT OUTPUT SUPERVISOR A LA BELL LABS BE SYS 3
*
(IOS) CAS IOU CHECK TO SEE IF SAME UNIT AS LAST TIME
ERA *+2 NO
TRA 1,4 YES EXIT
SXA IOSX,4 NO, SAVE LINK 1B
SXA IOSY,2 SAVE INDEX 2
STO IOU UPDATE IOU
STA $RDS UPDATE ADDRESSES OF TAPE COMMANDS PAGE 010
STA $WRS
STA $REW
STA $BSR
STA $WEF
TPL *+2 TAPE IN NORMAL DENSITH (BIN=HI, BCD=LO
ERA IOSBB CHANGE DENSITY BIT
STA $SDN
XEC $SDN
AXT 5,2 NUMBER OF COMMANDS TO BE SET
PDX 0,4 CHANNEL NUMBER TO R
TXI *+1,4,12 TOTAL NUMBER OF COMMANDS - 3
IOSA CAL IOU,4 PICK UP PROPER COMMAND
SLW COMAND,2 PUT IN PROPER PLACE
TNX IOSY,4,3 DECREMENT BY NUMBER OF CHANNEL
TIX IOSA,2,1 LOOP 5 TIMES
IOSY AXT **,2 RESTORE INDEX 2
IOSX AXT **,4 RESTORE LINK IR
TRA 1,4
*
* TAPE COMMANDS FOLLOW
*
TEFC 0,4
TEFB 0,4
TEFA 0,4
TCOC **
TCOB **
TCOA **
TRCC 0,4
TRCB 0,4
TRCA 0,4
RCHC 0,4
RCHB 0,4
RCHA 0,4
LCHC 0,4
LCHB 0,4
LCHA 0,4
IOU PZE LAST UNIT USED
IOSBB PZE 16 BINARY BIT
HEAD 0
*
* ACTUAL TAPE COMMANDS USED BY PROGRAMS (SHOULD BE UNHEADED)
*
RDS RTBA **
WRS WTBA **
REW REWA **
WEF WEFA **
SDN NOP MAKE A SDN INSTRUCTION FOR 7090
BSR BSRA **
TEF TEFA 0,4
TCO TCOA **
TRC TRCA 0,4
RCH RCHA 0,4
LCH LCHA 0,4
COMAND BSS 0 PAGE 011
SYSPPT PZE ADDRESS,,CHANNEL
SYSPOT 1*512+2*64+3,,1 INITIAL ASSIGNMENT OF A3
SYSPIT
SYSTMP
SYSTAP
TAPASG BSS 0
(IOS) SYN B$(IOS)
LOAD SYN LOADER
(IOU) SYN B$IOU
EJECT
* CONSTANT POOL PAGE 012
REM
ZERO PZE
Q1 DEC 1
Q2 DEC 2
Q3 DEC 3
Q4 DEC 4
Q5 DEC 5
Q6 DEC 6
Q7 DEC 7
Q8 DEC 8
Q9 DEC 9
Q10 DEC 10
Q12 DEC 12
Q13 13
Q14 14
Q17 DEC 17
Q20 DEC 20
Q21 DEC 21
Q22 22
Q36 DEC 36
Q63 DEC 63
Q64 DEC 64
Q128 DEC 128
QO14 OCT 14
QO17 OCT 17
QO20 OCT 20
QO22 OCT 22
QO25 SYN Q21
QO33 OCT 33
QO40 OCT 40
QO41 OCT 41
QO43 OCT 43
QO50 OCT 50
QO60 OCT 60
QO61 OCT 61
QO77 SYN $Q63
QO200 SYN Q128
QO33Q2 OCT 3300
QO1Q9 OCT 1000000000
Q233Q9 OCT 233000000000
Q777Q9 OCT 777000000000
QO2Q11 OCT 200000000000
QT1 ,1
QT2 ,2
QT4 ,4
QT5 0,5
QD1 PZE ,,1
QD2 PZE ,,2
QD5 PZE ,,5
QD6 PZE ,,6
QD7 PZE ,,7
QD20 PZE ,,20
QD21 PZE ,,21 PAGE 013
QP5 STR
OBLANK BCI 1, 00000
ZBLANK BCI 1,0
QF1 DEC 1.0
SBIT MZE
MAGMSK OCT 377777777777
AMASK PZE -1
DMASK PZE ,,-1
PMASK TXL 0,0,0
ADMASK PZE -1,,-1
ATMASK PZE -1,7
PDMASK SVN ,,-1
PDTMSK SVN 0,7,-1
PTAMSK SVN -1,7
CNTMSK OCT 000077000000
TAGMSK PZE ,7
SEVENS SVN -1,7,-1
BLANKS BCI 1,
BCONAT BSS 0 BEGINNING OF CONSTANT ATOMS
PNAMEA PZE PNAME
APVALD PZE ,,APVAL
BIND PZE ,,BIN
FIXD SYN BIND
FLOATD ,,$FLOAT
FSUBRD PZE ,,FSUBR
FNARGD PZE ,,FUNARG
LABELD PZE ,,LABEL
LAMDAD PZE ,,LAMBDA
OCTD ,,$OCT
PNAMED PZE ,,PNAME
QUOTED PZE ,,QUOTE
SUBRD PZE ,,SUBR
QSPECD PZE 0,,SPECAL
QSYMD PZE 0,,SYM
ERSETO,,PJ36
PJ37,,PJ38 LOGAND LOGXOR
-II7,,-II8 MAX MIN
PLUS,,TIMES
H01,,H02 PROTECT INTEGER OBJECTS
H03,,H04
H05,,H06
H07,,H10
H00A PZE H00
H12A PZE H12
H72A PZE H72
H11D PZE ,,H11
H14D PZE ,,H14
H33D PZE ,,H33
H34D PZE ,,H34
H40D PZE ,,H40
H74D PZE ,,H74
ECONAT SYN H740 END OF CONSTANT ATOMS
EJECT
CHKSUM BSS 5 THESE CELLS ARE NOT WRITTEN ON TAPE PAGE 014
HEAD B CELLS FOR LRTAPE
RTRX SYN CHKSUM+1 PROTECTED STORAGE
RTADR SYN CHKSUM+2
RTLCH SYN CHKSUM+3
RTIOU SYN CHKSYM+4
BSRECL EQU CHKSUM-BOTTOM LENGTH OF BOOTSTRAP RECORD
LOWREG SYN * LOWEST REGISTER ON LISP RECORD
*
LWTAPE CLA 1,4 PARAMETER WORD
STA WTIOC SET UP I-O COMMANDS
STD WTIOC
STD WTAD COUNT
SXA WTX,4 SAVE LINK IR
STZ WTAG ZERO TEST CELL
STZ WERC
STL $TCO
XEC $TCO WAIT FOR CHANNEL
IOT TURN OFF INDICATORS
NOP
AXC *,4
XEC $TRC
XEC $TEF
WTWS XEC $WRS SELECT TAPE
AXC WTIOC,4 POINTER TO IO COMMAND
XEC $RCH RESET AND LOAD CHANNEL
LXA WTIOC,4 ADDRESS OF BEGINNING OF BLOCK
WTAD TXI *+1,4,** END + 1 OF BLOCK
SXA WTACL,4 SET CHECKSUM COMPUTE ADDRESS
LXD WTIOC,4 COUNT OF BLOCK
PXD 0,0 CLAER AC
WTACL ACL **,4 COMPUTE CHECKSUM
TIX *-1,4,1 LOOP
SLW CHKSUM STOE IN CHECK SUM CELL
AXC WTIOD,4 CHECMSUM WRITE COMMAND
XEC $LCH LOAD CHANNEL
AXC WRCK,4 TEST FOR WRITE REDUNDANCY
XEC $TRC
WTX AXT **,4 RESTORE LINK IR
TRA 2,2 EXIT
*
WRCK NZT WTAG
TRA WAGN TRY TO WRITE ABAIN
STL WERC CELL SAYS THERE WAS BAD TAPE TROULLE
LXD SYSTMP,4 FORM MESSAGE TO OPERATOR
PXA 0,4
ADD $QO20
ALS 6
STO WERM
CLA SYSTMP
ANA $QO17
ORS WERM
TSX OUTPUT,4 WRITE CHANGE TAPE MESSAGE
MZE BCDOUT PAGE 015
WERM,,7
HPR 3
WAGN XEC $BSR
STL WTAG
TRA WTWS
*
WERM BCI 7, IS BAD, CHANGE IT AND PUSH START.
*
WERC
WTAG CELL NON-ZERO ON SECOND TRY
WTIOC IOCT **,,** WRITE OUT BLOCK
WTIOD IOCD CHKSUM,,1 WRITE OUT CHECK SUM
*
* TAPDMP DUMP CODE ON SYSTMP. USED BY OVERLORD
*
TAPDMP SXA TPDMX,4 SAVE LINK IR
TSX TEREAD,4 CLEAN UP READ BUFFER
CLA SYSTMP SPEC. FOR TEMPORARY TAPE
TSX $(IOS),4 SET UP I-O COMMANDS
TPRTY TSX LWTAPE,4 WRITE BOOTSTRAP RECORD
BOTTOM,,BSRECL
TSX LWTAPE,4 WRITE REST OF CODE
LOWREG,,-LOWREG
XEC $WEF WRITE AN EOF MARK
XEC $REW REWIND SYSTMP
ZET WERC SEE IF SSYTMP WAS CHANGEDAFTER FIRST
TRA TPRTY RECORD WAS WRITTE IF SO REWRITE IT
TPDMX AXT **,4 RESTORE LINK IR
TRA 1,4 EXIT
*
* OVLT READS A NEW CORE IMAGE IN FROM SYSTMP, USED BY OVERLORD
*
OVLTXX PXD 0,4 LINK IR TO AC
PDX 0,2 PUT IN IR 2 FOR SAFE KEEPING
CLA SYSTMP TERMPORARY TAPE SPEC.
TSX $(IOS),4 SET UP I-O COMMANDS
TSX LRTAPE,4 READ IN BOOTSTRAP RECORD
BOTTOM,,BSRECL
TSX LRTAPE,4 READIN RST OF LISP
LOWREG,,-LOWREG
XEC $REW REWIND SYSTMP
TRA 1,2 EXIT
*
*
INPUT CLA 2,4
SXA INX4,4 SAVE LINK IR
STO CALL
CLA SYSPIT INPUT TAPE SPEC. PAGE 016
TSX $(IOS),4 SET UP I-O COMMANDS
XEC $SWT1 TEST FOR ON-LINE INPUT
XEC $RDS SELECT INPUT TAPE
TSX $RTX,4
CALL **,,-1
TRA *+3
INX4 AXT **,4 RESTORE LINK IR
TRA 5,4
LXA INX4,4 RESTORE LINK IR
TMI 3,4
TRA 4,4
REM
C HED
*
RTX SXA RTXX,4 SAVE LINK IR
CLA 1,4 GET PARAMETER WORD
XEC $SWT1 TEST FOR ON-LINE INPUT
TXI H1,,0 IS FROM TAPE
RCDA
TXI RDBCD,,0
H1 STA CMMND SET ADDRESS OF I-O COMMAND
AXC *+2,4 LOCATION TO INDEX REGISTER
XEC $TEF TURN OFFF EOF INDICATOR
CAL H2 PIC UP SWITCH
H3 STO H2 SET TO TXH FIRST TIME THROUGH
AXC CMMND,4 LOCATION OF I-O COMMAND
XEC $RCH RESET AND LOAD CHANNEL
STL $TCO SET UP TCO COMMAND
XEC $TCO WAIT FOR CHANNEL TO GO OUT OF OPERATION
AXC RTXBE,4 LOACTION OF BAD EXIT
XEC $TEF GO IF EOF FOUND
AXC H2,4 LOCATION TO TRY AGAIN
XEC $TRC GO IF REDUNDANCY CHECK FOUND
RTXX AXT **,4 RESTORE LINK IR
TRA 3,4 GOOD EXIT
H2 TXH RTXBE,,0 IS TXL ON SECOND TRY
XEC $BSR BACKSPACE RECORD
XEC $RDS SELECT TAPE
CLS H2 PIC UP SWITCH
TXL H3,,0 GO TRY AGAIN
RTXBE LXA RTXX,4 LINK IR
TRA 2,4
RCD RCDA RESTART AFTER ERROR
LXD B2,1 X
LXD B3,2 X
RDBCD TEFA *+1 TURN OFF END FILE INDICATOR
STI B50 SAVE INDICATORS
RIL 3 TURN INDICATORS 1,2 OFF
RCHA LR READ IN 9 LEFT + RT INTO L,R
LCHA BLR DELEAY, START 8LEFT + RT INTO 8L,8R
TEFA 2,4 GO TO END OF FILE RETURN IF EOF ON
B1 LDQ L X
STQ LS SET LEFT SUM
SXD B2,1 SAVE INDEX REGISTERS PAGE 017
SXD B3,2 X
LXD B4,1 SET DIGIT ROW COUNT
LDQ R
STQ RS SET RIGHT SUMP
TSX C1,2 ENTER CONVERSION LOOP
B2 TXL B5 LEAVE CONVERSION LOOP
ALS 1
B3 TXL C2 INITIALIZE BCD RECORD
B5 LCHA LR DELAY UNTIL 8 IN, START READING 7
LDQ 8L USE 8 ROW AS SUM
STQ LS X
LDQ 8R X
STQ RS X
TSX C1,2 ENTER CONVERSION LOOP
B4 TXL B6,0,8 LEAVE CONVERSION LOOP
ALS 3 ADD 8 TIMES 8 ROW
TXL C3 X
B6 CAL L USE 9 ROW AS SUM
SLW LS X
CAL R X
SLW RS X
B13 TXL B25,1,2 IS IT ZERO OR ONE ROW YES'
B14 LCHA LR DELAY, READ IN N RT AND LEFT
LFT 1 IS END OF RECORD INDICATOR ON
TRA B9 YES' END OF RECORD
B8 CAL L NO' TEST LEFT ROW FOR
ANA LS ILLEGAL DOUBLE PUNCH
TNZ B17 X
B10 CAL L FORM LOGICAL SUM
ORS LS OF LEFT ROWS
CAL R TEST FOR ILLEGAL
ANA RS DOUBLE PUNCH
TNZ B17 X
B11 CAL R FORM LOGICAL SUM OF
ORS RS RIGHT RWS
TNX B12,1,1 TEST FOR ZONE ROWS
TSX C1,2 ENTER CONVERSION LOOP
TXL B13 LEAVE CONVERSION LOOP
TXL C3 ADD TO BCD RECORD
B7 CAL 8L ADD 8 LEFT ROW TO
ORA LS LEFT LOGICAL SUM
SLW LDS X
LCHA LR DELAY, START READING X-L,R INTO L,R
ANA LZ FORM INDICATOR FOR
SLW LS BOTH DIGIT AND ZERO
CAL 8R ADD 8 RIGHT ROW TO
ORA RS RIGHT LOGICAL SUM
SLW RDS X
ANA RZ FORM INDICATOR FOR
SLW RS BOTH DIGIT AND ZERO
B40 TSX C1,2 ENTER CONVERSION LOOP
TXL B14 LEAVE CONVERSION LOOP
ALS 4 SHIFT TO ZONE POSITION
TXL C3 X PAGE 018
B9 CAL LS SAVE LEFT ZONE SUM
SLW L X
CAL LDS FORM INDICATOR FOR
COM ZERO AND X AND / OR Y
ANA LZ IN LEFT ROWS
ANS LS X
CAL RS SAVE RIGHT ZONE SUM
SLW R X
CAL RDS FORM INDICATOR FOR
COM ZERO AND X AND/OR Y
ANA RZ IN RIGHT ROWS
ANS RS X
TSX C1,2 ENTER CONVERSION LOOP
TXL B15 LEAVE CONVERSION LOOP
SLW TP MULTIPLY INDICATOR
ALS 2 BITS BY TEN
ACL TP X
ALS 1 X
TXL C3 X
B15 CAL LDS FORM INDICATOR FOR
ORA LZ BLANK COLUMNS IN
ORA L LEFT HALF OF CARD
COM X
SLW LS X
CAL RDS FORM INDICATOR FOR
ORA RZ BLANK COLUMNS IN
ORA R RIGHT HALF OF CARD
COM X
SLW RS X
TSX C1,2 ENTER CONVERSION LOOP
TXL B16 LEAVE CONVERSION LOOP
SLW TP MULTIPLY INDICATOR
ALS 1 BITS BY 3 AND
ACL TP SHIFT TO ZONE POSITION
ALS 4 X
TXL C3 X
B16 LXD B2,1 RESTORE INDEX REGISTERS
LXD B3,2 AND RETURN TO MAIN
LDI B50 RESTORE INDICATORS
TRA ,34 PROGRAM
C1 SXD C4,1 SAVE ROW COUNT
C9 CAL 1,4 INITIALIZE ADDRESSES
ADM C7 X ADD 6
C4 TXL C6,,** TRANSFER IO LEFT ROW
ADM C7 RIGHT ROW, ADD 6 MORE
LDQ RS OBTAIN RIGHT SUM AND
TXI C8 SKIP OVER LEFT SUM
C6 LDQ LS OBTAIN LEFT SUM
C8 STA C2 SET BCD RECORD ADDRESS
STA C3 X
TXH C5,1,1 SKIP TEST IF DIGIT ROW
STQ TP TEST FOR NO SUM
CAL TP x
TZE C11 X PAGE 019
C5 LXA C7,1 SET WORD COUNT
C7 PXD 6,0 CONVERT ROW
LGL 1 X
ALS 5 X
LGL 1 X
ALS 5 X
LGL 1 X
ALS 5 X
LGL 1 X
ALS 5 X
LGL 1 X
ALS 5 X
LGL 1 X
TRA 2,2 EXIT FROM ROW PROCEDURE
C3 ACL 0,2 ADD TO BCD RECORD
C2 SLW 0,1 STORE IN BCD RECORD
TIX C7,1,1 COUNT WORDS
LXD C4,1 RESTORE ROW COUNT
C11 CLS C4 INVERT ROW SWITCH AND
STO C4 TEST FOR RIGHT ROW DONE
TMI 1,2 TRANSFER IF RIGHT ROW DONE
C10 TXI C9 GO CONVERT RIGHT ROW
B12 IIL 2 CHANGE INDICATOR BIT 17
LNT 2 IS THIS TWELVE ROW
TRA B100 CHANGE
TRA B40 NO
B25 TXL B7,1,1 IT IS XERO ROW OR ONE ROW
LCHA ZLR
TRA B8
B17 SSM SET ERROR SIGN
TXI B16,4,1 RESTORE INDEX REGISTERS AND MAKE BAD X
B100 TCOA *
TSX C1,2
TXL B200
ALS 4
TXL C3
B200 TRA B9
B50 PZE INDICATOR STORAGE
LR MTH L,0,2
BLR MTH 8L,0,2
ZLR MTH LZ,0,2
CMMND MTH **,0,-1
ORG COMMON
TP BSS 1 TEMPORARY
LS BSS 1 LEFT SUM
RS BSS 1 RIGHT SUM
LDS BSS 1 LEFT DIGIT SUM
RDS BSS 1 RIGHT DIGIT SUM
LZ BSS 1 LEFT ZERO ROW
RZ BSS 1 RIGHT ZERO ROW
L BSS 1 LEFT ROW
R BSS 1 RIGHT ROW
8L SYN LDS 8 LEFT ROW
8R SYN RDS 8 RIGHT ROW PAGE 020
ORG CMMND+1
0 HED
BCDIN EQU 0
RTX SYN C$RTX
HEAD D
*
* SPACEX PROVIDES A VARITY OF SPACES ON OFF LINE PRINTER
*
SPACEX XEC $SWT5 TEST FOR NO OFF-LINE OUTPUT
TRA *+2
TRA 2,4 RETURN
SXA SPX,4 SAVE LINK IR
CLA SYSPOT SET UP TAPES
TSX $(IOS),4
SPX AXT **,4 RESTORE LINK IR
CLA 1,4 GET PARAMETER
PAC 0,4 COMPLEMENT INTO IR 4
XEC $WRS
XEC $RCH
LXA SPX,4
TRA 2,4 RETURN
8SPACE IORP ZBLANK,,1 DOUBLE SPACE
6SPACE IORP ZBLANK,,1 DOUBLE SPACE
4SPACE IORP ZBLANK,,1 DOUBLE SPACE
2SPACE IORP ZBLANK,,1 DOUBLE SPACE
IOCD 0,,0 DISCONNECT CHANNEL
*
* OUTPUT BCD OUTPUT ROUTINE FOR LISP
* SWITCHES...
* 3 PRINT ON-LINE
* 5 DONT WRITE TAPE FOR OFF-LINE PRINTING
*
OUTPUT SXA WOTX,4 SAVE LINK IR
CLA 2,4 GET PARAMETER WORD
STD WOTC SET COUNT OF I-O COMMAND
ADD $Q20 END OF BLOCK
STA WOTM SET MOVE LOOP
STL $TCO WAIT FOR COMPLETION OF LAST OPERATION
XEC $TCO
CLA* 1,4 GET TAPE SPECIFICATION
TSX $(IOS),4 SET UP I-O COMMANDS
AXT 20,4 MAXIMIUM THAT MAY BE ON 1 RECORD
WOTM CLA **,4 MOVE INTO BUFFER
STO WOTB,4
TIX WOTM,4,1
XEC $SWT5 TEST FOR NO TAPE OUTPUT
TRA *+2 IS OUTPUT ON TAPE
TRA WOTX TEST FOR ON-LINE OUTPUT
XEC $WRS SELECT TAPE
AXC WOTC,4 POINTER TO I-O COMMAND
XEC $RCH RESET ANF LOAD CHANNEL
WOTX AXT **,4 RESTORE LINK IR
CLA 1,4 TEST FOR ON-LINE
XEC $SWT3 ON-LINE SENSE SWITCH PAGE 021
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
WOTON SXA WOTU,4 PRINT ON LINE
SXA WOTV,2 SAVE INDEX REGISTERS
SXA WOTW,1
STZ WOTT SET SWITCH
STZ WOTS SET SWITCH TO SKIP FIRST CHARACTER
LXD WOTC,6 COUNT IN INDEX 4 AND 2
TXI *+1,4,WOTB-20 ADD BEGINNING OF BUFFER
SXA BC05,4 SET ADDRESS
BC02 WPDA SELECT PRINTER
ZET WOTT SKIP ON FIRST 72 CHARACTERS
SPRA 9 SET UP SECOND HALF OF LINE
AXT 24,4 CLEAR
STZ COMMON+26,4 WORKING
TIX *-1,4,1 STORAGE
BC03 CAL BC50 STROBE STARTER
BC04 SXA BC01,1 WORKING CELL FOR N
BC05 LDQ 0,2 PICK UP WORD TO CONVERT
AXT 6,2 X2 COUNTS 6 CHARACTERS
BC06 SLW COMMON+26 STROBE
BC07 PXD **,0
LGL 6 LOOK AT
NZT WOTS SKIP IF NOT FIRST CHARACTER
CLA $Qo60 GET BCD BLANK FOR LEADNING CHARACTER
ALS 1 ONE CHARACTER
PAX ,1
CAL COMMON+26 STROBE
TNX *+2,1,96 NOT 0
ORS COMMON+21,4 0
TXH BC08,1,94 BLANK
TNX *+3,1,62 NOT 11
ORS COMMON+23,4 11
TNX BC08,1,2
TNX *+3,1,30 NOT 12
ORS COMMON+25,4 12
TNX BC08,1,2
TNX *+3,1,18 NOT 8 COMBINATION
TXI *+1,1,2
ORS COMMON+5,4 8 COMBINATION
ORS COMMON+21,5 NUMBER
BC08 ARS 1 MOVE STROBE
STL WOTS SET SWITCH
TIX BC06,2,1 BACK FOR NEXT CHARACTER
LXA BC01,3 N
TNX BC15,2,1 OUT IF N WORDS DONE
TNZ BC04 BACK FOR REST OF HALF-CARD
TXL BC15,4,0 RIGHT-HALF DONE
TXI BC03,4,-1 BACK FOR RIGHT HALF
BC15 RCHA BC49
STL WOTT SET SWITCH FOR SECOND HALF LINE
TXH BC02,1,1 BACK FOR MORE WORDS PAGE 022
TCOA *
WOTU AXT **,4 RESTORE INDEX REGISTERS
WOTV AXT **,2
WOTW AXT **,1
TRA 3,4 EXIT
*
WOTT NON-ZERO ON SECOND HALF LINE
WOTS ZERO FOR FIRST CHARACTER
BC49 IOCD COMMON+2,,24
BC01 SYN BC07
BC50 SYN $SBIT
*
WOTB BES 20 OUTPUT BUFFER
WOTC IORP WOTB-20,,** WRITE RECORD FROM BUFFER
IOCD 0,,0 DISCONNECT CHANNEL
BCDOUT SYN SYSPOT
PPTOUT SYN SYSPPT
*
REM
PSHLDB RCDA
RCHA *+3
LCHA 0
TTR 1
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
*
SWT1 SWT 1
SWT2 SWT 2
SWT3 SWT 3
SWT4 SWT 4
SWT5 SWT 5
SWT6 SWT 6
*
* SENSE LIGHT AND TEST INSTRUCTIONS TO BE EXECUTED OF DUMMYED
*
SLN1 SLN 1
SLN2 SLN 2
SLN3 SLN 3
SLN4 SLN 4
SLF SLF
SLT1 SLT 1
SLT2 SLT 2
SLT3 SLT 3
SLT4 SLT 4
REM
HEAD O
* C043 786 R. DALEY ... GETTM ... READ CLOCK ROUTINE FOR 709 ......
* RECODED AND SQUEEZED BY 0. 4. EDWARDS
GETTM RPRA PAGE 023
SXA EXA,1
SXA EXB,2 ..
SXA EXC,4 ..
AXT 33,2 SET UP FOR LOOP
STZ COMMON+33,2 ZERO CARD IMAGE AND WORKING STORAGE
TIX *-1,2,1 LOOP
RCHA SKP27 SET PRINTER TO SKIPPING FIRST 27 WORDS
SPRA 7 SENSE TIME CLOCK
SPRA 9 SET ECHO ENTRIES
TNO *+2 SKIP IF OVERFLOW LIGHT OFF
STL COMMON+5 OVERFLOW LIGHT ON, MAKE COMMON+4 =/ 0
LCHA ONWD 9 RIGHT ECHO
AXT 9,4 ROW COUNT
LCHA SKP3 IOCPN ZERO,,3 IOCT COMMON,,1
LOAD LDQ COMMON
AXT 2,2 ..
CONV PXD ,0
AXT 6,1 ..
ALS 5 ..
LGL 1 ..
TIX *-2,1,1 ..
ORS COMMON+3,2 ..
CAL COMMON+5,2 ..
ACL COMMON+3,2 ..
SLW COMMON+5,2 ..
TIX CONV,2,1 ..
LCHA SKP1 IOCPN ZERO,,1 IOCT COMMON,,1
TIX LOAD,4,1 COUNTS ROWS
LCHA ZERO IOCD 0,,0 DISCONNECT PRINTER
LDQ COMMON+3 DATE
PXD ,0
LGL 6 ..
TNZ *+2 ..
CLA OCT60 INSERT BLANK
LGL 12 ..
ORA OCT61 INSERT / BETWEEN MONTH AND DAY
ALS 18 ..
SLW COMMON+3 ..
PXD ,0
LGL 6 ..
TNZ *+2 ..
CAL OCT60 INSERT BLANK
LGL 12 ..
ORA OCT60 PROVIDE BLANK AS LAST CHARACTER
ORA COMMON+3 ..
EXC AXT **,4 RESTORE LINK IR
SLW* 1,4 STORE DATE IN REGISTER SPECIFIED
PXD ,0
LDQ COMMON+4 TIME
LGL 6 ..
TNZ *+2 ..
CAL OCT60 BLANK
LGL 30 ..
ORA OCT33 PROVIDE DECIMAL POINT PAGE 024
SLW* 2,4 STORE TIME
ALS 8 TURN ON OVER FLOW
NZT COMMON+5 LEAVE ON IF COMMON+5 IS NON ZERO
TOV *+1 TURN OFF OVER FLOW LIGHT
EXA AXT 0,1 RESTORE IRS
EXB AXT 0,2 ..
TRA 3,4 EXIT........
ZERO PZE 0 ..
PZE
SKP27 IOCTN COMMON+6,,27
SKP3 IOCPN ZERO,,2 SKIP TWO WORDS
SKP1 IOCPN ZERO,,1 SKIP ONE WORD
ONWD IOCT COMMON,,1 TRANSMIT ONE WORD TO COMMON
OCT60 SYN $QO60
OCT61 SYN $QO61 BCD /
OCT33 SYN QO33Q2 BCD .0
* TIME PRINTS THE DATE AND TIME .
TIME SXA TIR,4 SAVE LINK IR
TSX GETTM,4 GET TIME FROM ON-LINE CLOCK
TR+2 STORE DATE
TR+2+1 STORE TIME
TSX OUTPUT,4 PRINT OUT DATE AND TIME
BCDOUT ON BCD OUTPUT TAPE
TR,,17
PXD 0,0
TIR AXT **,4 RESTORE LINK IR
TRA 1,4 RETURN
TR BCI 1,0 THE
BCI 9,TIME ( ) HAS COME, THE WALRUS SAID, TO TALK
BCI 7, OF MANY THINGS ..... -LEWIS CARROLL-
0 HED
TIME SYN D$TIME
GETTM SYN D$GETTM
REM
PAUSEF HPR 7
TRA 1,4
REM
REM
*
* ERROR PROCESSES ALL LISP ERRORS. NORMALLY GIVES ERROR NUMBERS, PAGE 025
* ERROR LOCATION, LISP PRINT OF AC AND BACK TRACE OFALL
* FUNCTIONS ENTERED ON PUSH DOWN LIST.
*
ERAC PLACE TO STORE MACHINE REGISTERS
ERMQ
ERIND
ERX INDEX 1,,INDEX 2
ERROR TXH *+1,,** INDEX 4
NZT ERNULL SEE IF ERROR PROGRAM IS TO BE EXECUTED
XEC EREXIT NORMAL SETTING GOES TO EVALQUOTE
STQ ERMQ SAVE MACHINE REGISTERS
STI ERIND
SXA ERX,1
SXD ERX,2
LDI SYSIND PICK UP SYSTEM INDICATORS
SIR ERRORI SET ERROR HAS OCURRED INDICATOR
STI SYSIND UPDATE SYSTEM INDICATORS CELLS
STO ERT AC TO BE PRINTED
CLA 1,4
STO ERM PUT IN ERROR MESSAGE
LDC ERROR,4
PXD 0,4
XCA AND CONVERT TO OCATL
TSX OCTALP,4
ORA OBLANK INSERT LEADING BLANK
SLW ERN PUT IN ERROR MESSAGE
TSX OUTPUT,4 WRITE OUT ERROR MESSAGE
BCDOUT
ERO,,9
ZET BACACT SKIP IF BACK TRACE IS NOT ACTIVE
TRA BACER GO TO SPECIAL ROUTINE
STL BACACT MAKE BACK TRACE ROUTINE ACTIVE
CLA ERT PICK UP AC ON ENTRANCE
TSX $PRINT,4 PRINT IT IN LISP
RFT NOBACT TEST FOR NO BACK TRACE
TRA BACD GO TO EXIT
LDQ $ZERO ZERO THE ERROR LIST
LXD NUBPDL,4 BEGINNING OF PUSH DOWN LIST