-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathIO.MAC
1472 lines (1328 loc) · 34.5 KB
/
IO.MAC
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
;<134-TENEX>IO.MAC;95 20-AUG-75 13:13:48 EDIT BY TOMLINSON
; MAKE CORRECT CHECK FOR PAGE EXISTANCE AT DMPSE5
;<134-TENEX>IO.MAC;94 14-AUG-75 08:48:42 EDIT BY CALVIN
; Make sure NIN sets LSTERR (for ERSTR)
;<134-TENEX>IO.MAC;93 24-JUN-75 11:44:14 EDIT BY PLUMMER
; SUPPRESS OWNERWHIP CHECK ON PTY'S UNTIL PTYJOB IS IMPLEMENTED.
;<134-TENEX>IO.MAC;92 28-APR-75 15:05:07 EDIT BY CLEMENTS
;<134-TENEX>IO.MAC;91 28-APR-75 12:15:58 EDIT BY CLEMENTS
;<134-TENEX>IO.MAC;90 28-APR-75 11:33:45 EDIT BY CLEMENTS
;<134-TENEX>IO.MAC;89 24-APR-75 14:17:09 EDIT BY CLEMENTS
;<134-TENEX>IO.MAC;88 11-APR-75 18:04:18 EDIT BY ALLEN
; FIX UNBALANCED USE OF UNLOCK -- FILLCK DOES NOT GET LOCKED VIA MACROS
;AS HIQUEUEING IS NOT NECESSARY.
;<134-TENEX>IO.MAC;87 10-APR-75 23:09:07 EDIT BY ALLEN
; DELETE LCKTST ROUTINE WHICH IS NOW THE SAME AS CNTLCK LOCATED
;IN SCHEDULER
;<133-TENEX>IO.MAC;86 19-SEP-74 11:45:12 EDIT BY ALLEN
; CORRECT BUG IN LCKTST
;<133-TENEX>IO.MAC;85 16-SEP-74 19:56:39 EDIT BY ALLEN
; CORRECT LCKTST SO THAT LOCK MAY BE ADDRESSED BY ANY AC EXCEPT P
;<133-TENEX>IO.MAC;84 4-SEP-74 17:17:20 EDIT BY ALLEN
; FIX BUG IN LCKTST WHEN INDEXING INTO TABLE OF LOCKS
;<133-TENEX>IO.MAC;83 4-SEP-74 16:28:51 EDIT BY ALLEN
; CORRECT ERROR IN DISPLACEMENT FROM FRAME BASE IN DEFINITIONS
; OF BYTREM, BYTSIZ AND TRMBYT
;<133-TENEX>IO.MAC;82 11-JUL-74 17:50:29 EDIT BY CLEMENTS
; SIOR FIX FOR BYTE COUNT 0 SIN
;<TENEX-132>IO.MAC;81 19-JUN-74 12:55:01 EDIT BY TOMLINSON
; FIXED FAST SIN BUG WITH 0 AC3 (FAILED TO COUNT FINAL BYTE)
; REMOVED NULL SUPPRESSOR FROM BYTIN
;<TENEX-132>IO.MAC;80 14-MAY-74 09:02:02 EDIT BY TOMLINSON
; INTERNED DOINT FOR FILE INTERRUPTS
;<TENEX-132>IO.MAC;79 17-APR-74 21:42:42 EDIT BY TOMLINSON
; MISSING JRST EDESX1 AFTER PUSHJ P,FIXPTR IN PSOUT
;<TENEX-132>IO.MAC;78 16-APR-74 15:52:48 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;77 16-APR-74 14:19:25 EDIT BY TOMLINSON
; INSTALL CHECKS FOR INDIRECTION/INDEXING OF BYTE POINTERS
;<TENEX-132>IO.MAC;76 15-APR-74 13:11:47 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;75 1-APR-74 20:30:01 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;74 1-APR-74 19:53:25 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;73 1-APR-74 19:21:15 EDIT BY TOMLINSON
; CONVERTED CHKJFN TO RETURN DOUBLE SKIP FOR NIL DESIGNATOR
;<TENEX-132>IO.MAC;72 1-APR-74 19:03:08 EDIT BY TOMLINSON
; ALLOW RADIX UP TO 36 FOR NIN
;<TENEX-132>IO.MAC;71 25-NOV-73 23:23:48 EDIT BY CLEMENTS
; YET ANOTHER FIX TO NO FREE 0 ON END OF -N TYPE SIN
;<TENEX-132>IO.MAC;70 10-NOV-73 20:01:14 EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;69 10-NOV-73 14:34:14 EDIT BY CLEMENTS
; KI CHANGES, SMALL BUG FIXES
;<TENEX-132>IO.MAC;68 13-JUN-73 21:12:19 EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;67 9-APR-73 16:11:23 EDIT BY TOMLINSON
; FIXED NEG WORD COUNT SIN TO NOT APPEND 0 BYTE
;<TENEX-132>IO.MAC;66 3-APR-73 18:04:30 EDIT BY PLUMMER
;<TENEX-132>IO.MAC;65 12-MAR-73 13:16:25 EDIT BY TOMLINSON
; Fix BYTBL1 to leave unused bits 0
;<TENEX-132>IO.MAC;63 6-MAR-73 12:59:49 EDIT BY TOMLINSON
; MISC FIXES TO SIN/SOUT
;<TENEX-132>IO.MAC;62 23-FEB-73 18:03:51 EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;61 22-FEB-73 18:45:00 EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;60 13-FEB-73 19:58:17 EDIT BY CLEMENTS
;<TENEX-132>IO.MAC;57 26-JAN-73 08:45:16 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;56 24-JAN-73 22:42:43 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;55 24-JAN-73 16:07:56 EDIT BY TOMLINSON
;<TENEX-132>IO.MAC;54 24-JAN-73 14:40:10 EDIT BY TOMLINSON
;<TENEX-131>IO.MAC;53 10-JAN-73 11:00:09 EDIT BY TOMLINSON
;<TENEX-131>IO.MAC;52 9-JAN-73 14:36:18 EDIT BY TOMLINSON
; FIXED DUMPI/O LOCKUP BUG
;<TENEX-130>IO.MAC;51 20-NOV-72 13:14:45 EDIT BY TOMLINSON
; ADDED OPNF CHECK IN RIN
;<FILESYSTEM>IO.MAC;50 25-AUG-72 17:38:36 EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;49 25-AUG-72 16:08:17 EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;48 25-AUG-72 15:45:03 EDIT BY TOMLINSON
;<FILESYSTEM>IO.MAC;47 29-JUN-72 9:59:08 EDIT BY TOMLINSON
SEARCH STENEX,PROLOG
TITLE IO
SUBTTL R.S.Tomlinson
EXTERN CPOPJ,SKPRET,SK2RET,SK3RET,ERRSAV,LSTERR,PRIMRY,CAPENB
EXTERN PBYTSZ,PBYTPO
EXTERN EDISMS,ERRD,FKHPTN,FPTA,MJRSTF,MLKPG,MRPT,MULKPG,SKIIF,BHC
EXTERN NILDTB,STRDTB,TTYDTB,SFBNR,STRDEV,PBYTSZ
EXTERN ITRAP,TTFORK,JOBPT,DISGE,MENTR,MRETN,MSTKOV
EXTERN MRPACS,SETMPG
USE SWAPPC
DEFINE FILINT(N,EXTRA)<
PUSHJ P,[EXTRA
MOVEI A,N
JRST DOINT]>
DEFINE FILABT(N,EXTRA)<
JRST [ EXTRA
MOVEI A,N
JRST ABTDO]>
DOINT:: MOVEM JFN,ERRSAV
MOVEM A,LSTERR
TEST(NE,HLTF)
JRST ABTDO ; Halt on these conditions
MOVEI 1,400000
MOVSI 2,(1B11)
IIC
POPJ P,
ABTDO: MOVEM A,LSTERR
PUSHJ P,UNLCKF
JRST ITRAP
; Check tenex source/destination designator
; Call: JFN ; The designator
; PUSHJ P,CHKJFN
; Return
; +1 ; Error, as has error #
; +2 ; Tty
; +3 ; Byte pointer, or other special designator type (e.g. NIL:)
; +4 ; File
; In all cases, the following is set up
; LH(DEV) ; Unit number (tty no dta no etc)
; RH(DEV) ; Loc of device dispatch table
; JFN ; True jfn for files, byte pointer for same
; STS ; File status bits
; The file is locked if it is a file
CHKJFN::SETZB F,F1
TLNE JFN,777777 ; Lh zero?
JRST CHKJF1 ; No, some kind of byte pointer
CAIN JFN,100 ; Primary input designator?
HLRZ JFN,PRIMRY ; Get primary input jfn from psb
CAIN JFN,101 ; Primary output designator?
HRRZ JFN,PRIMRY ; Get primary output jfn from psb
CAMGE JFN,MAXJFN ; Possibly a jfn?
JRST CHKJF3 ; Yes
CAIN JFN,777777 ; Controlling tty
JRST CHKJF4 ; Yes
CAIN JFN,377777 ; Nil designator
JRST CHKJFW ; Yes.
CAIGE JFN,400000+NLINES ; Valid tty designator?
CAIGE JFN,400000
JRST CHKJF7 ; No, garbage designator
HLRZ DEV,TTFORK-400000(JFN) ; Get assignment of tty
CAIE DEV,777777 ; Unattached?
CAMN DEV,JOBNO ; Or assigned to this job?
JRST CHKJF5 ; Yes, ok to use
MOVE A,CAPENB
TRNE A,WHEEL!OPR
JRST CHKJF5
IFN NPTY,< ; PARTIAL CODE FOR PTY'S - NOT YET SUPPORTED
SUBI JFN,400000+PTYLO ;SEE IF DEV DESIG IS A PTY
CAIL JFN,0 ;RANGE CHECK
CAIL JFN,NPTY ; ..
JRST CHKJF0 ;NO. GIVE UP
REPEAT 0,< ;PTY'S NOT OWNED YET. DON'T BOTHER CHECKING.
MOVE DEV,PTYJOB##(JFN) ;YES. SEE IF THIS JOB OWNS IT.
ADDI JFN,400000+PTYLO ;RESTORE JFN TO TTY DESIGNATOR
CAMN DEV,JOBNO
>
JRST CHKJF5 ;JOB MATCHES. ACCEPT THIS DESIGNATOR
>;END COND ON NPTY
CHKJF0: MOVEI A,DESX2 ; Illegal tty designator
POPJ P,
CHKJF4: MOVE A,JOBNO
MOVEI A,JOBPT(A)
SKIPGE DEV,(A)
PUSHJ P,DISGE ; Dismiss until it is greater or equal
SKIPGE DEV,(A)
JRST CHKJF4
HLRZS DEV
MOVEI JFN,400000(DEV)
CHKJF5: MOVEI DEV,TTYDTB ; Set up dev to be tty
HRLI DEV,-400000(JFN) ; And the proper unit
HRLZI STS,READF!WRTF!OPNF
JRST SKPRET ; Skip return
CHKJFW: MOVEI DEV,NILDTB
HRLZI STS,READF!WRTF!OPNF
JRST SK2RET
CHKJF3: LSH JFN,SJFN
MOVEI A,^D60 ; Try 60 times to lock file
CHKJF2: SOJL A,CHKJFB ; Then fail
NOINT
AOSE FILLCK(JFN)
JRST [ OKINT
PUSH P,A
MOVEI A,^D1000
DISMS
POP P,A
JRST CHKJF2]
MOVE STS,FILSTS(JFN)
TEST(NN,NAMEF)
JRST CHKJF8
TEST(NN,FRKF) ; Test for file restricted to one fork
JRST CHKJF9
HLRZ A,FILVER(JFN)
PUSHJ P,SKIIF
JRST CHKJF8 ; Can't access
CHKJF9: MOVE DEV,FILDEV(JFN) ; Set up dev
HRRZ A,DEV
CAIN A,TTYDTB
JRST [ SETOM FILLCK(JFN)
OKINT
JRST .+1]
JRST SK3RET ; Triple skip return
CHKJF8: SETOM FILLCK(JFN)
OKINT
CHKJFB: MOVEI A,DESX3
POPJ P,
CHKJF1: MOVE A,JFN
CALL FIXPTR
JRST CHKJF7 ; BAD DESIGNATOR
MOVEM A,JFN
MOVEI DEV,STRDEV ; Set up to dispatch to string routines
HRLZI STS,READF!WRTF!OPNF
JRST SK2RET ; Double skip return
CHKJF7: MOVEI A,DESX1 ; Garbage designator
POPJ P,
; Unlock file
; Call: JFN ; Job file number
; STS ; New filsts
; PUSHJ P,UNLCKF
UNLCKF::TLNE JFN,777777
UMOVEM JFN,1
CAIL JFN,0
CAIL JFN,RJFN
POPJ P,
HLLM STS,FILSTS(JFN)
PUSH P,A
MOVEI A,(DEV)
CAIN A,TTYDTB
JRST [ POP P,A
POPJ P,]
POP P,A
SETOM FILLCK(JFN)
OKINT
POPJ P,
NOTOPN: FILABT CLSX1
EDESX1: MOVEI A,DESX1
IOERR:: MOVEM A,LSTERR
JRST ITRAP
; Bin from primary io file
; Call: 1 ; Character
; PBIN
.PBIN:: JSYS MENTR
MOVEI JFN,100
PUSHJ P,BYTIN
UMOVEM B,1
JRST MRETN
; Byte input jsys
; Call: 1 ; Tenex source designator
; BIN
; Return
; +1
; B ; A byte
PS(BIOAC0)
.BIN:: NOINT
JUMPL 1,SLBIN
CAML 1,MAXJFN ; Possible a jfn?
JRST SLBIN
LSH 1,SJFN
AOSE FILLCK(1)
JRST SLBIN0
MOVE 2,FILSTS(1)
TLC 2,OPNF!READF
TLCN 2,OPNF!READF
TLNE 2,ERRF!FRKF
JRST SLBIN1
SOSGE FILCNT(1)
JRST SLBIN2
AOS 2,FILBYN(1)
CAMLE 2,FILLEN(1)
JRST SLBIN3
ILDB 2,FILBYT(1)
SETOM FILLCK(1)
LSH 1,-SJFN
OKINT
XCT MJRSTF
SLBIN3: SOS FILBYN(1)
SLBIN2: AOS FILCNT(1)
SLBIN1: SETOM FILLCK(1)
SLBIN0: LSH 1,-SJFN
SLBIN: OKINT
JSYS MENTR ; Become slow etc.
MOVE JFN,1
PUSHJ P,BYTIN ; Read the byte
XCTUU [MOVEM B,2] ; Store in user's ac
JRST MRETN ; Restore user ac's and return
; Random input jsys
; Call: 1 ; Tenex source designator
; 3 ; Byte number
; RIN
; Returns
; +1
; 2 ; The byte
.RIN:: JSYS MENTR
MOVE JFN,1
PUSHJ P,CHKJFN
JRST IOERR
JFCL
FILABT DESX4 ; Tty and byte designators are illegal
JUMPGE STS,NOTOPN
TEST(NN,RNDF)
FILABT IOX3 ; Illegal to change pointer
TEST(NN,READF)
FILABT IOX1 ; Illegal to read
UMOVE A,3
PUSHJ P,SFBNR ; Set up byte pointer
JRST ABTDO
PUSHJ P,BYTINA ; Get the byte
UMOVEM B,2
JRST MRETN
; String input jsys
; Call: 1 ; Tenex source designator
; 2 ; Byte pointer (lh = 777777 will be filled in)
; 3 ; Byte count or zero
; ; If zero, the a zero byte terminates
; ; If positive then transfer the specified number
; ; Of characters, or terminate on reading a byte
; ; Equal to that given in 4
; ; If negative, then transfer the specified number
; ; Of bytes
; 4 ; (optional) if 3 is > 0, 4 has a terminating byte
; SIN
; Return
; +1 ; Always
; 2 ; Updated string pointer
; 3 ; Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.
.SIN:: JSYS MENTR ; Become slow etc.
SIN0: UMOVE JFN,1
CAIN JFN,100
JRST SINOOO ; DO IT THIS WAY TO GET ECHOOS DONE
PUSHJ P,SIOR1 ; CHECK JFN ETC
JRST SINTTY ; TTY
JRST [ CAIE DEV,STRDTB
JRST .+1
JRST SINBYT] ; BYTE POINTER
TEST(NN,READF)
FILABT(IOX1) ; ILLEGAL READ
SKIPG FILCNT(JFN) ; ANY BYTES IN BUFFER?
JRST SINOLD ; NO, DO IT THE SLOW WAY
MOVE A,FILBYT(JFN) ; SOURCE POINTER
UMOVE B,2 ; TARGET
MOVE D,[1B3+1] ; FROM FILE, TO USER.
PUSHJ P,SIOR2 ; SET UP REST OF ARGS AND DO BYTBLT
UMOVEM B,2 ; UPDATE POINTERS
MOVEM A,FILBYT(JFN)
PUSHJ P,UNLCKF ; UNLOCK FILE TO ALLOW INTS
JUMPN D,SIN0 ; DO MORE IF NOT DONE
JUMPN E,MRETN ; IF NON-ZERO COUNT SUPPLIED, NO 0.
JRST SIN2 ; PUT THE ZERO ON THE END.
; DO SIN FROM BYTE POINTER
SINBYT: MOVE A,JFN
UMOVE B,2
MOVE D,[1B2+3] ; BYTE POINTER AND USER TO USER
PUSHJ P,SIOR2
UMOVEM B,2
UMOVEM A,1
JRST SIN3
; DO SLOW SIN FOR ONE BYTE
SINOOO: UMOVE A,2
PUSHJ P,FIXPTR ; FIX UP POINTER
JRST EDESX1
UMOVEM A,2
PUSHJ P,BYTIN
JRST SINOL1
SINTTY:
SINOLD: PUSHJ P,BYTINA ; Read a byte from the source
SINOL1: JUMPE B,[TEST(NN,EOFF)
XCTUU [SKIPN 3]
JRST SIN2
JRST .+1]
IFN KAFLG,<
XCTUU [IDPB B,2]> ; Deposit the byte
IFN KIFLG,< ; ON KI-10, MUST HANDLE WITH
XCTUU [MOVE 3,2] ; THE POINTER IN MONITOR SPACE
TLNE 3,37 ; AND INDIRECTING/INDEXING
FILABT DESX1 ; DOESN'T WORK
XCTUU [IDPB B,3] ; OK. STORE THE BYTE
XCTUU [MOVEM 3,2] ; RETURN UPDATED POINTER
>
JSP A,SIONXT ; Test for end of string
JRST SIN0 ; Not end, continue
SIN3: XCTUU [SKIPE 3] ; NON-ZERO COUNT CASE?
JRST MRETN ;YES. RETURN.
SIN2: SETZ B,
UMOVE A,2
XCTBU [IDPB B,A]
JRST MRETN
; SUBROUTINE TO FIX AC2 AND CHECK JFN
SIOR1: UMOVE A,2
PUSHJ P,FIXPTR
JRST EDESX1
UMOVEM A,2
UMOVE JFN,1
PUSHJ P,CHKJFN
JRST IOERR ; GARBAGE
POPJ P,
JRST [ CAIN DEV,STRDTB
AOS 0(P) ; SINGLE SKIP FOR STRING POINTERS
RET] ; NONE FOR OTHER SPECIAL DESIGNATORS
TEST(NN,OPNF)
FILABT(DESX5)
CAIL JFN,RJFN
POPJ P,
JRST SK2RET
FIXPTR: TLC A,777777 ; IF LH = -1 CONVERT TO 0
TLCN A,777777 ; UNCONVERT WAS IT -1?
HRLI A,440700 ; YES. SET TO LEFT BYTE 7-BIT
TLZN A,37 ; DOES POINTER HAVE INDIRECTION OR INDEXING?
AOS 0(P) ; NO, GIVE SKIP RETURN
POPJ P,
; SUBROUTINE TO SET UP REST OF SIN/SOUT AND DO BYTBLT
SIOR2: UMOVE E,3 ; GET COUNT
MOVM C,E ; MAGNITUDE OF COUNT
SKIPL E ; TERMINATING BYTE?
TLO D,(1B0) ; YES, SET FLAG
SKIPLE E ; SPECIFIC TERMINATOR?
JRST [ UMOVE E,4 ; YES. GET (NOTE 0 IN E IF COUNT=0)
TLO D,(1B1) ; FLAG SPECIFIC TERMINATOR
JRST .+1]
SKIPN C ; NON-ZERO COUNT
HRLOI C,77 ; NO, SET MAX COUNT
TLNE D,(1B2) ; BYTE POINTER IN JFN?
JRST SIOR23 ; YES, IGNORE FILCNT
CAML C,FILCNT(JFN) ; KEEP MIN OF THIS
MOVE C,FILCNT(JFN) ; AND BYTES IN BUFFER
SIOR23: PUSH P,C ; SAVE COUNT
PUSHJ P,BYTBLT ; DO THE TRANSFER
SUB C,0(P) ; GET NEG OF BYTES TRANSFERRED
TLNE D,(1B2) ; BYTE POINTER IN JFN?
JRST SIOR24
TLNE D,(1B4) ; WAS AN EXTRA BYTE READ BUT NOT WRITTEN
TLNN D,(1B3) ; YES. IS THIS A SIN?
SKIPA E,C ; NO. USE STRAIGHT COUNT
HRREI E,-1(C) ; YES. COMPENSATE FOR THE EXTRA BYTE
ADDM E,FILCNT(JFN) ; UPDATE FILCNT
MOVNS E
ADDB E,FILBYN(JFN)
CAML E,FILLEN(JFN)
MOVEM E,FILLEN(JFN)
SIOR24: XCTUU [SKIPGE E,3] ; WHAT KIND OF COUNT
MOVNS C ; MAKE SIGN AGREE
JUMPE E,SIOR21 ; DON'T UPDATE COUNT IF 0
XCTUU [ADDB C,3] ; DO UPDATE
JUMPE C,SIOR22 ; IF COUNT BECOMES 0, THEN DONE
SKIPL C ; NOT DONE IF NEG COUNT SUPPLIED & STILL
SIOR21: TLNE D,(1B0) ; ELSE DONE IF TERMINATOR FOUND
TROA D,-1 ; NOT DONE, SET D NON-0
SIOR22: SETZ D, ; DONE, SET D = 0
SUB P,BHC+1
POPJ P,
; Check for end of string io string
; Call: B ; Character just transfered
; User 3 ; Sin/sout argument
; User 4 ; Sin/sout argument
; JSP A,SIONXT
; Return
; +1 ; Continue
; MRETN ; If no more left to do
; Updates user 3
SIONXT: TLNE JFN,777777 ; If byte pointer,
UMOVEM JFN,1 ; Restore updated jfn
XCTUU [SKIPN C,3]
JRST (A)
SIO1: JUMPG C,SIO2 ; Positive
XCTUU [AOSGE 3]
JRST (A)
JRST MRETN
SIO2: XCTUU [SOSLE 3]
XCTUU [CAMN B,4]
JRST MRETN
JRST (A)
; Define move .xor. umove
MXUM==<<MOVE>&<-1-<UMOVE>>>!<<-1-<MOVE>>&<UMOVE>>
MXUMM==<<MOVEM>&<-1-<UMOVEM>>>!<<-1-<MOVEM>>&<UMOVEM>>
IFN KIFLG,<
PRINTX !THIS SECTION NEEDS RECODING FOR KI-10 - BYTBLT IN IO$:!
>
; Accumulators
; Arguments...returned updated
SRC=1 ; Source byte pointer
TGT=2 ; Target byte pointer
CNT=3 ; Byte count
MOD=4 ; Mode
; Temporaries
T1=5
T2=6
T3=7
; Program space starts here
PRG==T3
P=17
FRM=16
; Local variables
DEFINE BYTREM<4(FRM)>
DEFINE BYTSIZ<5(FRM)>
DEFINE TRMBYT<6(FRM)>
NLCLS==3
; Move bytes
; Call:
; 1/ SOURCE POINTER
; 2/ TARGET POINTER
; 3/ BYTE COUNT
; 4/ MODE BITS AS FOLLOWS:
; B1/ TRANSFER TERMINATOR BYTE
; B0/ TRANSFER UNTIL TERMINATOR
; B34/ FROM USER
; B35/ TO USER
; E/ TERMINATOR IF ANY
BYTBLT::PUSH P,FRM ; Save old frm
MOVE FRM,P ; Set up frame base
PUSH P,T1 ; Save temps
PUSH P,T2
PUSH P,T3
ADD P,BHC+NLCLS ; Cover space for locals
JUMPGE P,MSTKOV
MOVEM E,TRMBYT ; Shuffle args
; Preliminaries out of the way
; Now get to work
BYTB1: TLNE MOD,(1B0) ; Terminator?
JRST CHKTRM ; Yes, look for it
TLNN TGT,7700 ; Zero byte size?
JRST BYTLP ; Well...if you insist
MOVE T1,TGT ; Compare target
XOR T1,SRC ; To source
TLNN T1,7700 ; And if byte size differs
CAIG CNT,20 ; Or short transfer
JRST BYTLP ; Do byte at a time
LDB T2,[POINT 6,TGT,11] ; Get byte size
MOVEM T2,BYTSIZ ; Save it
ROT T2,-6 ; Position in p field
LP1: SOJL CNT,DONE ; Until cnt < 0
XCT LDBTB(MOD) ; Do transfer bytes
XCT DPBTB(MOD)
CAMG T2,TGT ; Until less than 1 byte remains in tgt
JUMPGE T2,LP1 ; Loop unless bytesize >= 32
; (once is always enough)
BYTB2: MOVEI T1,^D36 ; Word size
IDIV T1,BYTSIZ ; Compute bytes/word and remainder
MOVEM T1+1,BYTREM ; Save remainder
MOVE T2,CNT
IDIV T2,T1 ; Compute words to transfer
MOVEM T2+1,CNT ; Remaining bytes
JUMPE T2,BYTLP ; Zero words...do byte at a time
HLLO T1,SRC ; Get source...prevent borrows
SUB T1,TGT ; When getting bit offset
ROT T1,6
ANDI T1,77 ; Retain just the position difference
JUMPN T1,BYTBL1 ; Move word at a time
HRLZ T1,SRC ; Make blt pointer
HRR T1,TGT
ADD T1,BHC+1 ; Adjust 'cause byte pointer behind by 1
ADDM T2,SRC ; Adjust src by word count
ADDB T2,TGT ; And adjust tgt
XCT BLTTB(MOD) ; Blt t1,0(t2)
BYTLP: JUMPLE CNT,DONE ; Do rest a byte at a time
BYTLP1: XCT LDBTB(MOD)
XCT DPBTB(MOD)
SOJG CNT,BYTLP1
DONE: SUB P,BHC+NLCLS ; Flush local storage
POP P,T3 ; Restore temps
POP P,T2
POP P,T1
POP P,FRM ; Restore frm
POPJ P,
; Transfer a word at a time
; T1/ POSITION OFFSET (RIGHT SHIFT AMOUNT)
; T2/ WORD COUNT
; Bytrem/ lsh amount to right justify first word
BYTBL1: ADD P,BHC+LPRG-1 ; Make room to save ac's
JUMPGE P,MSTKOV
MOVSI T3,PRG+1
HRRI T3,2-LPRG(P)
BLT T3,0(P) ; Save ac's
MOVE PRG+LPRG-2,[PROTO,,PRG]
BLT PRG+LPRG-2,PRG+LPRG-2 ; Load up proto program except last word
TRNE MOD,2 ; Is from "user"
JRST [ TLC PRG+0,(MXUM)
TLC PRG+1,(MXUM)
JRST .+1]
TRNE MOD,1 ; Is to "user"?
TLC PRG+5,(MXUMM) ; Change movem to umovem
HRRI PRG+0,0(SRC) ; Address of first move
HRRI PRG+1,1(SRC) ; Address of second move
HRR PRG+4,BYTREM ; Fill in shift amount to left justify
MOVNS BYTREM ; Get right shift amount
HRR PRG+2,BYTREM ; Fill in LSH
MOVNS T1 ; NEGATE OFFSET
ADD T1,BYTREM ; Total right shift = offset + remainder
CAMG T1,[-^D18] ; Less than half a word?
TLCA PRG+4,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>)
; My kingdom for an xor operator
; Change ac of lsh from t1 to t2
TLCA PRG+5,(<Z <<T1&<-1-T2>>!<<-1-T1>&T2>>,0>)
; No, change ac of MOVEM to T1
ADDI T1,^D36 ; Leave movem t1, change shift amount
HRRI PRG+5,1(TGT) ; Address of movem
HRRM T1,PRG+3 ; Fill in lshc amount
ADDM T2,TGT ; Update target
ADDM T2,SRC ; And source
PUSH P,SRC ; Want to use SRC for AOBJN
MOVNS T2 ; Make aobjn
HRLZ SRC,T2 ; word in SRC
MOVE PRG+LPRG-1,PROTO+LPRG-1; Last word of program
JRST PRG ; Do the program, return to done
BYTLPD: POP P,SRC
MOVSI T1,2-LPRG(P) ; Cleanup
HRRI T1,PRG+1
BLT T1,PRG+LPRG-1
SUB P,BHC+LPRG-1
JRST BYTLP ; Finish up any odd bytes
; Transfer til terminator
CHKTRM: JUMPLE CNT,DONE
CHKTR1: XCT LDBTB(MOD)
CAMN T1,TRMBYT
JRST [ TLZ MOD,(1B0) ; TERMINATOR HAS BEEN SEEN
TLNN MOD,(1B1) ; SPECIFIC TERMINATOR (I.E. KEEP IT?)
JRST [ TLO MOD,(1B4)
JRST DONE]
XCT DPBTB(MOD)
SOJA CNT,DONE]
XCT DPBTB(MOD)
SOJG CNT,CHKTR1
JRST DONE
; Instruction tables for different mapping modes
; 00 -- monitor to monitor
; 01 -- monitor to user
; 10 -- user to monitor
; 11 -- user to user
LDBTB: ILDB T1,SRC
ILDB T1,SRC
XCTBU LDBTB
XCTBU LDBTB
DPBTB: IDPB T1,TGT
XCTBU DPBTB
IDPB T1,TGT
XCTBU DPBTB
BLTTB: BLT T1,0(T2)
XCTMU BLTTB
XCTUM BLTTB
XCTUU BLTTB
; Prototype byte blt program
; Note that address designated by .-. are filled in at run time
; also, the LSH and MOVEM instructions at PROTO +4 and +5 have their
; ac fields modified depending on where the LSHC is made to shift right
; or left. Only one of these instructions is modified in either case
; thus the two instruction end up using T1 if shift left and T2 if right
; Furthermore, the MOVE's and MOVEM's may be changed to UMOVE or
; UMOVEM's depending on the address space of SRC and TGT respectively
PROTO: MOVE T1,.-.(SRC) ; Note most rh's are filled at run time
MOVE T2,.-.(SRC) ; Pick up next word
LSH T1,.-. ; Right justify first word
LSHC T1,.-. ; Shift to target position+unused bits
LSH T2,.-. ; Shift back to clear unused bits
MOVEM T1,.-.(SRC) ; Store
AOBJN SRC,PRG ; Loop
JRST BYTLPD ; Done
LPRG==.-PROTO
; Byte input subroutine
; Call: 1 ; Source designator
; PUSHJ P,BYTIN
; Return
; +1 ; Ok
; B ; A byte
; Clobbers most everything
BYTIN:: MOVS B,PRIMRY
CAIN JFN,100 ; If not from primary input
CAMN B,PRIMRY ; Or if primary input = output
JRST BYTINQ ; Not special
PUSHJ P,BYTINQ ; Otherwise, do byte in
JUMPE B,CPOPJ ; Cone if null
EXCH A,B
PBOUT
EXCH A,B
POPJ P,
BYTINQ: PUSHJ P,CHKJFN ; Check the designator
JRST IOERR ; Bad designator
JFCL ; Tty
JFCL ; Byte pointer, or special designator
BYTINA: JUMPGE STS,NOTOPN
TEST(NN,READF)
FILABT IOX1 ; Illegal read
TEST(NE,ERRF)
FILINT(IOX5) ; Generate data error interrupt
TEST(NE,EOFF)
JRST INEOF
PUSHJ P,@BIND(DEV) ; Dispatch to device dependent code
TEST(NE,ERRF)
FILINT(IOX5)
TEST(NE,EOFF)
JRST INEOF
MOVE B,A
JRST UNLCKF
INEOF: MOVEI A,IOX4
MOVEM A,LSTERR
MOVEM JFN,ERRSAV
MOVEI 1,400000
MOVSI 2,(1B10)
IIC ; Initiate interrupt on channel 10
MOVEI B,0
JRST UNLCKF
; Output to primary output file
; Call: 1 BYTE
; PBOUT
.PBOUT::JSYS MENTR
MOVEI JFN,101
UMOVE B,1
PUSHJ P,BYTOUT
JRST MRETN
; Byte output
; Call: 1 ; Tenex destination designator
; 2 ; A byte
; BOUT
.BOUT:: NOINT
JUMPL 1,SLBOU
CAML 1,MAXJFN ; Possibly a jfn?
JRST SLBOU ; Not possible
LSH 1,SJFN ; Convert number to index
AOSE FILLCK(1)
JRST SLBOU0
MOVEM C,BIOAC0
MOVE C,FILSTS(1)
TLC C,OPNF!WRTF
TLCN C,OPNF!WRTF
TLNE C,FRKF!ERRF
JRST SLBOU1
SOSGE FILCNT(1)
JRST SLBOU2
AOS C,FILBYN(1)
CAMLE C,FILLEN(1)
MOVEM C,FILLEN(1)
IDPB 2,FILBYT(1)
MOVE C,BIOAC0
SETOM FILLCK(1)
LSH 1,-SJFN
OKINT
XCT MJRSTF
SLBOU2: AOS FILCNT(1)
SLBOU1: MOVE C,BIOAC0
SETOM FILLCK(1)
SLBOU0: LSH 1,-SJFN
SLBOU: OKINT
JSYS MENTR
MOVE JFN,1
PUSHJ P,BYTOUT ; Output the byte
JRST MRETN
; Random output jsys
; Call: 1 ; Tenex source designator
; 2 ; A byte
; 3 ; Byte number
; ROUT
.ROUT:: JSYS MENTR
MOVE JFN,1
PUSHJ P,CHKJFN
JRST IOERR
JFCL
FILABT DESX4 ; Tty and byte designators are illegal
JUMPGE STS,NOTOPN
TEST(NN,RNDF)
FILABT IOX3 ; Illegal to change pointer
TEST(NN,WRTF)
FILABT IOX2 ; Illegal write
UMOVE A,3
PUSHJ P,SFBNR
JRST ABTDO
UMOVE B,2
PUSHJ P,BYTOUA
JRST MRETN
; String output to primary io file
; Call: 1 ; String pointer, designator, or location of string
; PSOUT
.PSOUT::JSYS MENTR
PSOUT1: TLCE A,777777 ; IS LH = 0?
TLC A,777777 ; NO. UNCOMPLEMENT
PUSHJ P,FIXPTR ; YES. LEAVE IT -1 AND FIX IT UP ANYWAY
JRST EDESX1
PSOUT0: PUSH P,A ; Make a copy of byte pointer
XCTBU [ILDB B,0(P)]
JUMPE B,[XCTMU [POP P,1]
JRST MRETN]
MOVEI JFN,101
PUSHJ P,BYTOUT
POP P,A
UMOVEM A,1
JRST PSOUT0
; PRIMARY ERROR STRING OUTPUT
.ESOUT::JSYS MENTR
MOVEI A,101
DOBE
HRROI A,[ASCIZ /
?/]
PSOUT
MOVEI A,100
CFIBF
UMOVE 1,1
JRST PSOUT1
; String output
; Call: 1 ; Tenex source designator
; 2 ; Byte pointer (lh = 777777 will be filled in)
; 3 ; Byte count or zero
; ; If zero, the a zero byte terminates
; ; If positive then transfer the specified number
; ; Of characters, or terminate on reading a byte
; ; Equal to that given in 4
; ; If negative, then transfer the specified number
; ; Of bytes
; 4 ; (optional) if 3 is > 0, 4 has a terminating byte
; SOUT
; Return
; +1 ; Always
; 2 ; Updated string pointer
; 3 ; Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.
.SOUT:: JSYS MENTR ; Become slow etc
SOUT0: PUSHJ P,SIOR1 ; FIX UP AC2, CHECK JFN
JRST SOUTTY
JRST [ CAIE DEV,STRDEV
JRST .+1
JRST SOUBYT]
TEST(NN,WRTF)
FILABT(IOX2)
SKIPG FILCNT(JFN)
JRST SOUTLD ; DO IT THE OLD WAY
MOVE B,FILBYT(JFN) ; TARGET IS FILE
UMOVE A,2 ; SOURCE IS USER
MOVEI D,2
PUSHJ P,SIOR2
UMOVEM A,2
MOVEM B,FILBYT(JFN)
PUSHJ P,UNLCKF
JUMPN D,SOUT0
JRST MRETN
; SOUT TO STRING POINTER
SOUBYT: MOVE B,JFN
UMOVE A,2
MOVE D,[1B2+3]
PUSHJ P,SIOR2
UMOVEM A,2
UMOVEM B,1
MOVEM B,JFN
PUSHJ P,APPNUL ; APPEND NULL
JRST MRETN
; OLD STYLE SOUT
SOUTTY:
SOUTLD: XCTUM [PUSH P,2]
XCTBU [ILDB B,0(P)]
XCTUU [SKIPN 3]
JUMPE B,[XCTMU [POP P,2]
PUSHJ P,UNLCKF
JRST MRETN] ; Don't write zero bytes if arg3 = 0
PUSH P,B
PUSHJ P,BYTOUA
POP P,B
XCTMU [POP P,2]
PUSHJ P,APPNUL
JSP A,SIONXT
JRST SOUT0
; Byte output subroutine
; Call: 1 ; Source designator
; PUSHJ P,BYTOUT
; Return
; +1 ; Ok
; Clobbers most everything
BYTOUT::PUSHJ P,CHKJFN ; Check the designator
JRST IOERR ; Bad designator
JFCL ; Tty
JFCL ; Byte pointer or special designator
BYTOUA::JUMPGE STS,NOTOPN
TEST(NN,WRTF)
FILABT IOX2 ; Illegal write
TEST(NE,ENDF)
FILABT(IOX6) ; Past abs end of file
TEST(NE,ERRF)
FILINT(IOX5) ; Error interrupt
MOVE A,B
PUSHJ P,@BOUTD(DEV) ; Dispatch to device dependent code
JRST UNLCKF
; Append null to string output designator
APPNUL::PUSH P,JFN
PUSH P,C
MOVEI C,0
TLZ JFN,7700
TLO JFN,700
CAMN JFN,-1(P)
XCTBU [IDPB C,JFN]
POP P,C
POP P,JFN
POPJ P,
; Dump io
; Parameters and variables
NDUMP==10
LS(DMPASW) ; Dump buffer assignment word
LS(DMPCNT) ; Dump buffer free count
LS(DMPLCK) ; Dump buffer assignment lock
NRP(DMPBUF,NDUMP*1000) ; Dump buffers
; Initialize dump io
USE RESPC
DMPINI::MOVEI A,NDUMP
MOVEM A,DMPCNT
SETOM DMPLCK
SETCM A,[-1_<^D36-NDUMP>]
MOVEM A,DMPASW
POPJ P,
USE SWAPPC