-
Notifications
You must be signed in to change notification settings - Fork 0
/
e8file.pa
1273 lines (1079 loc) · 20 KB
/
e8file.pa
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
/ E8FILE
PAGE /-------------------------- 2200
/ RENDER MODE LINES
RMODE, 0
JMS I [RNDINI / BASE MODE LINE
TAD (MLBASE
JMS I [WR6
WRRND
JMS I [RNDFIN
TAD CHANGD / INDICATE BUFFER CHANGED
SNA CLA
JMP RMODEB
TAD (RNDBUF+1
DCA RNDP
TAD (CHGMSG
JMS I [WR6
WRRND
RMODEB, TAD (RNDBUF+5 / FILE NAME
DCA RNDP
TAD FILENM+3 / SAVE EXTENSION
DCA RMODET
DCA FILENM+3
TAD (FILENM
JMS I [WR6
WRRND
TAD (DOT
JMS I [WRRND
TAD RMODET
DCA FILENM+3
TAD (FILENM+3
JMS I [WR6
WRRND
JMS BUFSIZ / BUFFER SIZE IN AC24
TAD (RNDBUF+23 / POINTER TO LSD OF DECIMAL SIZE
DCA RNDP
RMODEA, TAD (12 / WRITE DECIMAL TO RENDER BUFFER
JMS I [DIVIDE / IN REVERSE. WORKS FOR SIZE < 100000
TAD AC24+1
TAD (ZERO
SCRFLD
DCA I RNDP
CODFLD
STA
TAD RNDP
DCA RNDP
DCA AC24+1
TAD AC24
SZA CLA
JMP RMODEA
JMP I RMODE
RMODET, 0
MLBASE, TEXT /---- /
CHGMSG, TEXT /**/
/ 24-BIT ARITHMETIC. ALL BINARY OPS USE AC24 AND TWO-WORD VALUE
/ POINTED T0 BY WORD FOLLOWING JMS. 24-BIT DOUBLEWORDS ARE
/ LITTLE-ENDIAN, OF COURSE.
P24, 0
/ CLEAR 24-BIT ACCUMULATOR
CLR24, 0
DCA AC24
DCA AC24+1
JMP I CLR24
/ LOAD 24-BIT ACCUMULATOR
LD24, 0
DCA P24
TAD I P24
DCA AC24
ISZ P24
TAD I P24
DCA AC24+1
JMP I LD24
/STORE 24-BIT ACCUMULATOR
ST24, 0
DCA P24
TAD AC24
DCA I P24
ISZ P24
TAD AC24+1
DCA I P24
JMP I ST24
/ ADD A 15-BIT POINTER TO AC24, WHICH HOLDS THE RESULT OF
/ A SUB15 OPERATION, TO YIELD A 15-BIT POINTER
ADD15, 0
DCA P24
CLL
TAD AC24
TAD I P24
DCA AC24
ISZ P24
RTL; RTL
TAD AC24+1
TAD I P24
DCA AC24+1
JMP I ADD15
/ SUBTRACT TWO 15-BIT POINTERS TO YIELD A DIFFERENCE THAT CAN
/ BE ADDED TO A 15-BIT POINTER, OR FIX24 TO GET A PROPER
/ 15-BIT INTEGER.
SUB15, 0
DCA P24
TAD I P24
CLL CIA
TAD AC24
DCA AC24
ISZ P24
TAD I P24
CMA
SNL
TAD [-10
IAC
TAD AC24+1
DCA AC24+1
JMP I SUB15
PAGE /-------------------------- 2400
/ FIX AC24 FOR 15-BIT POINTER SUBTRACTIONS THAT YIELD NON-NEGATIVE
/ RESULTS
FIX24, 0
TAD AC24+1
CLL RTR; RAR
DCA AC24+1
JMP I FIX24
/ WRITE CHAR IN AC TO RENDER BUFFER IF IT FITS
WRRND, 0
SCRFLD
DCA I RNDP
CODFLD
TAD RNDP
TAD (-RNDEND+1
SZA CLA
ISZ RNDP
JMP I WRRND
/#EC# SCREEN AND MODE LINE TEXT FUNCTIONS
HALFHT=TXTHT%2
/ SET TOP OF SCREEN. SEARCH BACK LINES FROM POINT UNTIL
/ * FIND LINE CURRENTLY AT TOS. DONE, NO CHANGE
/ * REACH BEGINNING OF BUFFER. SET TOS THERE.
/ * MOVED SCRHT LINES, TOS NOT ON SCREEN, SET TOS
/ TO HALF OF SCRHT LINES BEFORE POINT
SETTOS, 0
TAD BUF / DEFAULT TOS IS BEGINNING OF BUFFER
DCA NEWTOS
TAD BUF+1
DCA NEWTOS+1
JMS I [SREVGP
DCA TOSN / ZERO LINE COUNT
TOSA, TAD [NL / SEARCH BACK FOR NL
JMS I [SREV
JMP TOSD
TAD [SRCHP / IF WE FOUND THE TOS, WE'RE DONE
JMS I [INC15
TAD [SRCHP
JMS I [SNE15; TOS
JMP I SETTOS
ISZ TOSN / UPDATE LINE COUNT
TAD TOSN / SAVE A GOOD TOS IF WE NEED IT
TAD (-HALFHT
SZA CLA
JMP TOSB
TAD SRCHP
DCA NEWTOS
TAD SRCHP+1
DCA NEWTOS+1
TOSB, TAD TOSN / GONE BACK SCRHT LINES?
TAD (-TXTHT
SNA CLA
JMP TOSC
TAD [SRCHP / NO, UNDO THE INC15 AND KEEP LOOKING
JMS I [DEC15
JMP TOSA
TOSD, TAD (TOS / COULDN'T FIND ANY NL, TOS ALREADY
JMS I [SNE15; BUF
JMP I SETTOS / YES, DONE
TOSC, TAD NEWTOS / SET NEW TOS
DCA TOS
TAD NEWTOS+1
DCA TOS+1
JMP I SETTOS
TOSN, 0
NEWTOS, 0; 0
/ FORWARD ONE SCREEN.
FWDSCR, 0
TAD CURROW / COMPUTE NUMBER OF LINES TO MOVE
TAD (-TXTHT-HALFHT+1
DCA TOSN
JMS I [SFWDPT
FWSCA, TAD [NL / NEXT LINE
JMS I [SFWD
JMP FWSCB
TAD [SRCHP / SKIP OVER NL
JMS I [INC15
ISZ TOSN / MOVED FAR ENOUGH?
JMP FWSCA
JMS I [GOFWD / YES, GO THERE
FWSCC, ISZ FWDSCR
JMP I FWDSCR
FWSCB, TAD TOSN / NO NL, IF CURRENT LINE IS NOT
TAD (HALFHT-1 / ON SCREEN, MOVE TO END
SPA CLA
JMP I FWDSCR
JMS I [GOEND
FAIL
JMP FWSCC
/ REVERSE ONE SCREEN
REVSCR, 0
TAD CURROW / COMPUTE NUMBER OF LINES TO MOVE
CIA
TAD (-HALFHT-1
DCA TOSN
JMS I [SREVGP
RVSCA, TAD [NL / PREVIONS LINE
JMS I [SREV
JMP RVSCB
ISZ TOSN / MOVED FAR ENOUGH?
JMP RVSCA
TAD [SRCHP / YES, SKIP OVER NL
JMS I [INC15
JMS I [GOREV / GO THERE
RVSCC, ISZ REVSCR
JMP I REVSCR
RVSCB, TAD (TOS / CAN'T FIND NL, TOS == BUF?
JMS I [SNE15; BUF
JMP I REVSCR
JMS I [GOBEG / YES, GO TO BEGINNING
FAIL
JMP RVSCC
PAGE /-------------------------- 2600
/ SKIP IF AC IS ALPHANUMERIC
SKIPAN, 0
JMS I [UPPER
DCA SKANCH
TAD SKANCH
TAD (-60 / NUMERIC?
SPA CLA
JMP SKNAB
TAD SKANCH
TAD (-72
SPA CLA
JMP SKANA
SKNAB, TAD SKANCH / NO, ALPHA?
TAD (-101
SPA CLA
JMP I SKIPAN
TAD SKANCH
TAD (-133
SPA CLA
SKANA, ISZ SKIPAN
JMP I SKIPAN
SKANCH, 0
/ CONVERT 6-BIT ASCII TO 8-BIT
CV68, 0
TAD [SP
AND [77
TAD [SP
JMP I CV68
/ WRITE 6-BIT STRING TO SUBROUTINE
WR6, 0
DCA WR6P
TAD I WR6
ISZ WR6
DCA WR6SUB
WR6A, TAD I WR6P / FIRST CHAR
RTR; RTR; RTR
AND [77
SNA
JMP I WR6
JMS CV68
JMS I WR6SUB
TAD I WR6P / SECOND CHAR
AND [77
SNA
JMP I WR6
JMS CV68
JMS I WR6SUB
ISZ WR6P
JMP WR6A
WR6P, 0
WR6SUB, 0
/ ERASE SCREEN, SET TOS SO THAT CURSOR IS IN MIDDLE OF SCREEN
REDRAW, 0
JMS I [SCINIT / ERASE
TAD (HALFHT / MOVE TOS
JMS MOVTOS
ISZ REDRAW
JMP I REDRAW
MOVTOS, 0
CMA
DCA MVTSN
JMS I [SREVGP
MVTSA, TAD [NL / BACK HALF-SCREEN OF LINES
JMS I [SREV
JMP MVTSB
ISZ MVTSN
JMP MVTSA
TAD [SRCHP / SKIP OVER NL
JMS I [INC15
TAD SRCHP / SET TOS
DCA TOS
TAD SRCHP+1
DCA TOS+1
JMP I MOVTOS
MVTSB, TAD BUF / NL NOT FOUND, TOS = BUF
DCA TOS
TAD BUF+1
DCA TOS+1
JMP I MOVTOS
MVTSN, 0
/ DELETE CHARS FROM POINT TO END OF LINE. IF NONE, DELETE
/ NL. FAILS IF NOTHING WAS DELETED (AT END OF BUFFER)
KEOL, 0
JMS I [SFWDPT / FIND EOL
TAD [NL
JMS I [SFWD
JMP KEOLA
TAD [POINT / IF AT EOL, DELETE THE NL
JMS I [SNE15; SRCHP
SKP
JMP KEOLC
TAD [SRCHP
JMS I [INC15
KEOLC, TAD SRCHP / DO THE DELETE
DCA POINT
TAD SRCHP+1
DCA POINT+1
KEOLB, ISZ KEOL / NORMAL RETURN, SET CHANGED
STA
DCA CHANGD
JMP I KEOL
KEOLA, TAD [POINT / LAST LINE, ANYTHING TO DELETE?
JMS I [SNE15; BUFEND
JMP I KEOL
TAD BUFEND / YES, DO IT
DCA POINT
TAD BUFEND+1
DCA POINT+1
JMP KEOLB
PAGE /-------------------------- 3000
/ MODE LINE TEXT
MLTP, 0
/ CLEAR MLT
CLRMLT, 0
TAD (MLTBUF
DCA MLTP
DCA I MLTP
JMP I CLRMLT
/ WRITE CHARACTER TO MLT, IGNORE IF BUFFER FULL
WRMLT, 0
DCA I MLTP
TAD MLTP
TAD (-MLTEND+1
SZA CLA
ISZ MLTP
DCA I MLTP
JMP I WRMLT
/ ERASE CHARACTER FROM MLT, IGNORE IF BUFFER EMPTY
ERMLT, 0
TAD MLTP
TAD (-MLTBUF
SNA CLA
JMP I ERMLT
STA
TAD MLTP
DCA MLTP
DCA I MLTP
JMP I ERMLT
/ RENDER MLT. MUST FIT, OVERFLOW NOT CHECKED
RNDMLT, 0
JMS I [RNDINI
TAD (MLTBUF
DCA MLTP
RMLTA, TAD I MLTP / RENDER EACH CHAR
SNA
JMP RMLTB
TAD [-SP / CONTROL CHAR?
SMA CLA
JMP RMLTC
TAD (136
JMS I [WRRND
TAD (100
RMLTC, TAD I MLTP
JMS I [WRRND
ISZ MLTP
JMP RMLTA
RMLTB, JMS I [RNDFIN
JMP I RNDMLT
/#ED# FILE INPUT
/ OS/8 USER SERVICE ROUTINE DEFS
USR=7700
FETCH=1
LOOKUP=2
ENTER=3
CLOSE=4
RESET=13
/ FIND FILE
FFILE, 0
JMS I [GETFIL / GET FILENAME
JMP I FFILE
JMS CLRBUF / GOT ONE, CLEAR BUFFER
JMP I FFILE / USER ABORTED SAVE OFFER
JMS I [SETFN / ACTIVE FILENAME = ENTERED NAME
TAD (FILEEN / LOOKUP FILE
JMS I [LUFILE
JMP FFNEW
JMS I [INSFIL / EXISTS, INSERT
JMP FFERR
FFILEA, DCA CHANGD / SET BUFFER NOT CHANGED
JMS I [GOBEG / BEGINNING OF FILE
FAIL
ISZ FFILE
JMP I FFILE
FFNEW, JMS I [CLRMLT / FILE NOT FOUND, NEW ONE
TAD (NEWMSG
JMS I [WR6
WRMLT
ISZ MLHOLD
JMP FFILEA
FFERR, JMS I [CLRFN / ERROR (BUFFER FULL) DON'T LET
JMP I FFILE / USER ACCIDENTALLY WRITE PARTIAL FILE
/ INSERT FILE AT POINT
INFILE, 0
JMS I [GETFIL / GET FILENAME
JMP I INFILE
TAD (FILEEN / LOOK FOR IT
JMS I [LUFILE
JMP INFLN
JMS I [INSFIL / INSERT
SKP
ISZ INFILE
JMP I INFILE
INFLN, TAD (NFMSG / FILE MUST BE FOUND
JMS I [WR6
WRMLT
ISZ MLHOLD
JMP I INFILE
/ CLEAR BUFFER, SKIP IF NOT QUIT
CLRBUF, 0
JMS I [OFFER
JMP I CLRBUF
ISZ CLRBUF
TAD BUF
DCA GAP
TAD BUF+1
DCA GAP+1
TAD BUFEND
DCA POINT
TAD BUFEND+1
DCA POINT+1
JMP I CLRBUF
/ CONVERT CHAR IN AC TO UPPER CASE, A LITTLE TOO AGRESSIVELY SINCE
/ THE SYMBOLS >= 140 ARE ALSO AFFECTED
UPPER, 0
TAD (-140
SPA
TAD [SP
TAD (100
JMP I UPPER
PAGE /-------------------------- 3200
/ INSERT ONE CHAR, SKIP IF NOT ^Z AND THE CHAR FITS. IGNORE LF
INSF1, 0
TAD (-32 / ^Z?
SNA
JMP I INSF1
TAD (32-LF / LF?
SNA
JMP INSF1A
TAD (LF
JMS I [INSERT / OK TO INSERT
JMP INSF1B
INSF1A, ISZ INSF1
JMP I INSF1
INSF1B, ISZ MOREOK
JMP I INSF1
MOREOK, 0 / BUFFER FULL, MORE TO READ
/ CLEAR ACTIVE FILENAME
CLRFN, 0
DCA FILENM
DCA FILENM+3
JMP I CLRFN
/ SKIP IF THERE IS AN ACTIVE FILENAME
HAVEFN, 0
TAD FILENM
SZA CLA
ISZ HAVEFN
JMP I HAVEFN
/ INSERT PREVIOUSLY LOOKED UP FILE AT POINT, SKIP IF OK
INSFIL, 0
TAD FILLOC
DCA FILBLK
DCA MOREOK
INSFA, JMS I DSKEP / NEXT BLOCK
200
FILBUF, IOBUF
FILBLK, 0
JMP INSFER
ISZ FILBLK / UPDATE BLOCK NUMBER
TAD (-200 / PROCESS CHARACTERS
DCA INSFN
TAD FILBUF
DCA INSFP
INSFC, TAD I INSFP / CHAR 1
AND (177
JMS INSF1
JMP INSFB
TAD I INSFP / SAVE HIGH NIBBLE OF CHAR 3
AND (3400
CLL RTR; RTR
DCA INSFT
ISZ INSFP / CHAR 2
TAD I INSFP
AND (177
JMS INSF1
JMP INSFB
TAD I INSFP / CHAR 3
RTL; RTL; RAL
AND (17
TAD INSFT
JMS INSF1
JMP INSFB
ISZ INSFP
ISZ INSFN
JMP INSFC
ISZ FILSIZ
JMP INSFA
INSFB, TAD [POINT / DISTINGUISH EOF FROM BUFFER FULL
JMS I [SNE15; GAP / EOF SKIPS, BUFFER FULL DOESN'T
SKP
ISZ INSFIL
JMP I INSFIL
INSFER, SMA CLA / I/O ERROR, SHOW MESSAGE
TAD (INSE2-INSE1 / SHOUDN'T GET NON-FATAL
TAD (INSE1
JMS I [WR6
WRMLT
ISZ MLHOLD
JMP I INSFIL
INSFP, 0
INSFN, 0
INSFT, 0
/ LOOKUP FILE, AC->NAME, SKIP IF FOUND
LUFILE, 0
DCA FILLOC
TAD DEVNUM
CIF 10
JMS I [USR
LOOKUP
FILLOC, 0
FILSIZ, 0
SKP
ISZ LUFILE
JMP I LUFILE
/ INITIALIZE FILE I/O, SKIP IF OK
IOINIT, 0
CIF 10 / TELL OS/8 NO DEVICE HANDLERS IN CORE
JMS I [USR
RESET
0
CIF 10 / FETCH DISK HANDLER
JMS I [USR
FETCH
DEVNUM=.+1
DEVICE DSK
DEVEP, 7201
JMP I IOINIT
TAD DEVEP
DCA DSKEP
ISZ IOINIT
JMP I IOINIT
PAGE /-------------------------- 3400
/ GET FILE NAME, SKIP IF NOT QUIT
GETFIL, 0
GETFR, JMS I [CLRMLT / PROMPT IN MODE LINE TEXT (MLT)
TAD (GFMSG
JMS I [WR6
WRMLT
JMS I [UPDATE
DCA FILEEN / CLEAR NAME TO BE ENTERED
DCA FILEEN+1
DCA FILEEN+2
DCA FILEEN+3
TAD (FILEEN
DCA FILEP / SEE COMMENTS BELOW
DCA FILEX
DCA FILEH
GETFA, JMS I [RDTTY / READ NEXT CHAR
DCA GETFCH
TAD GETFCH / QUIT?
TAD (-BELL
SNA CLA
JMP I GETFIL
GETFE, TAD GETFCH
TAD (-CR / END OF ENTRY?
SNA CLA
JMP GETFB
TAD GETFCH / ERASE?
TAD [-10
SNA CLA
JMP GETFR
TAD GETFCH / DOT?
TAD (-56
SZA CLA
JMP GETFD
TAD FILEX / YES DOT, IN EXTENSION MODE?
SZA CLA
JMP GETFER
TAD FILEEN / NO, ANY NAME CHARACTERS?
SNA CLA
JMP GETFER
ISZ FILEX / YES, OK TO SWITCH TO EXTENSION MODE
TAD (FILEEN+3
DCA FILEP
DCA FILEH
JMP GETFC
GETFD, TAD FILEX / NOT DOT, TOO MANY CHARACTERS?
SZA CLA
JMP .+3
TAD FILEEN+2
SKP
TAD FILEEN+3
AND [77
SZA CLA
JMP GETFER
TAD GETFCH / CONVERT TO UPPERCASE
JMS I [UPPER
DCA GETFCH
TAD GETFCH / ALPHANUMERIC?
JMS I [SKIPAN
JMP GETFER
TAD FILEH / CHAR OK, INSERT IN FILENAME
SZA CLA
JMP GETFG
TAD GETFCH / LEFT HALF
AND [77
CLL RTL; RTL; RTL
DCA I FILEP
ISZ FILEH
JMP GETFC
GETFG, TAD GETFCH / RIGHT HALF
AND [77
TAD I FILEP
DCA I FILEP
DCA FILEH
ISZ FILEP
GETFC, TAD GETFCH
JMS I [WRMLT
JMS I [UPDATE
JMP GETFA
GETFER, TAD [BELL / ERROR, IGNORE CHARACTER
JMS I [WRTTY
JMP GETFA
GETFB, TAD FILEEN / GOT CR, ANY NAME ENTERED?
SNA CLA
JMP GETFER
ISZ GETFIL
JMP I GETFIL
/ MAKE ENTERED FILENAME CURRENT
SETFN, 0
TAD FILEEN
DCA FILENM
TAD FILEEN+1
DCA FILENM+1
TAD FILEEN+2
DCA FILENM+2
TAD FILEEN+3
DCA FILENM+3
JMP I SETFN
GETFCH, 0 / CHARACTER BEING ENTERED
FILEP, 0 / POINTER INTO FILEEN
FILEX, 0 / NON-ZERO IF WORKING ON FILE EXTENSION
FILEH, 0 / NON-ZERO IF INSERTING INTO RIGHT HALF
FILEEN, ZBLOCK 4 / ENTER NEW NAME HERE
FILENM, ZBLOCK 5 / FILE OF CURRENT BUFFER, DISPLAYED IN MODE LINE
/ ONE EXTRA FOR RMODE
PAGE /-------------------------- 3600
/ DIVIDE AC24 BY AC, QUOTIENT TO AC24, REMAINDER TO AC24+1
/ ASSUME NO OVERFLOW
DIVIDE, 0
CIA / NEGATE DIVISOR FOR SHIFT/SUBTRACT
DCA DIVSR
TAD (-15 / LOOP COUNT
DCA DIVCNT
CLL
JMP DIVB
DIVA, TAD AC24+1
RAL
DCA AC24+1
TAD AC24+1
TAD DIVSR
SZL
DCA AC24+1
CLA
DIVB, TAD AC24
RAL
DCA AC24
ISZ DIVCNT
JMP DIVA
JMP I DIVIDE
DIVSR, 0
DIVCNT, 0
/#EE# FILE OUTPUT
/ COUNT NL CHARS FROM POINT TO WREND ADD RESULT TO WRFSIZ
NLFWD, 0
JMS I [SFWDPT
NLFWDA, TAD [NL / NEXT NL
JMS I [SFWD
JMP I NLFWD
TAD [SRCHP / SRCHP < WREND?
JMS I [LD24
TAD WREND
JMS I [SUB15
TAD AC24+1
SMA CLA
JMP I NLFWD
ISZ WRFSIZ / YES, ADD 1
SKP
ISZ WRFSIZ+1
TAD [SRCHP / SKIP OVER NL
JMS I [INC15
JMP NLFWDA
/ COUNT NL CHARS FROM GAP TO WRBEG ADD RESULT TO WRFSIZ
NLREV, 0
JMS I [SREVGP
NLREVA, TAD [NL / NEXT NL
JMS I [SREV
JMP I NLREV
TAD [SRCHP / SRCHP >= WRBEG?
JMS I [LD24
TAD WRBEG
JMS I [SUB15
TAD AC24+1
SPA CLA
JMP I NLREV
ISZ WRFSIZ / YES, ADD 1
SKP
ISZ WRFSIZ+1
JMP NLREVA
/ COMPUTE SIZE OF ZONE IN OS/8 BLOCKS (256 WORDS)
WRFBLK, 0
TAD [GAP / NUM CHARS IN ZONE
JMS I [LD24
TAD WRBEG
JMS I [SUB15
TAD WREND
JMS I [ADD15
TAD [POINT
JMS I [SUB15
JMS I [FIX24
TAD (WRFSIZ
JMS I [ST24
JMS NLFWD / ADD EXTRA FOR NL CHARS
JMS NLREV
TAD (WRFSIZ / ROUND UP TO NUMBER OF BLOCKS
JMS I [LD24
TAD (600
JMS I [DIVIDE
TAD AC24
IAC
DCA WRSIZE
JMP I WRFBLK
WRFSIZ, 0; 0 / SIZE OF ZONE INCLUDING EXTRA NL CHARS AND ^Z AT END
/ ENTER TENTATIVE OUTPUT FILE, SKIP IF OK. AC CONTAINS
/ NUMBER OF 256-WORD BLOCKS TO BE WRITTEN. INITIALIZE
/ SOME CLFILE AND PACK VARIABLES
ENFILE, 0
TAD WRNAME
DCA ENLOC
TAD WRSIZE
IAC / ONE MORE TO BE SAFE
CLL RTL; RTL
TAD DEVNUM
CIF 10
JMS I [USR
ENTER
ENLOC, 0
ENSIZ, 0
JMP I ENFILE
TAD ENLOC
DCA PACKBL
DCA CLSIZ
ISZ ENFILE
JMP I ENFILE
PAGE /-------------------------- 4000
/ CLOSE OUTPUT FILE AND MAKE PERMANENT, SKIP IF OK.
CLFILE, 0
TAD WRNAME
DCA CLNAME
TAD DEVNUM
CIF 10
JMS I [USR
CLOSE
CLNAME, 0
CLSIZ, 0
SKP
ISZ CLFILE
JMP I CLFILE
/ PACK CHARACTERS INTO IOBUF. IF FULL, WRITE IT OUT. SKIP IF OK.
/ THREE CHARS IN TWO WORDS, OS/8 ASCII FILE FORMAT
PACK, 0
DCA PACKCH
TAD PACKX
SZA
JMP PACKA
TAD PACKCH / CHAR 0
DCA PACK0
ISZ PACKX
JMP PACKC
PACKA, SPA CLA
JMP PACKB
TAD PACKCH / CHAR 1
DCA PACK1
STA
DCA PACKX
JMP PACKC
PACKB, TAD PACKCH / CHAR 2
AND (360
CLL RTL; RTL
TAD PACK0
DCA I PACKP
ISZ PACKP
TAD PACKCH
AND (17
CLL RTR; RTR; RAR
TAD PACK1
DCA I PACKP
ISZ PACKP
DCA PACKX
TAD PACKP / END OF IOBUF?
TAD (-IOBUFE
SZA CLA
JMP PACKC
ISZ ENSIZ / OVERWRITE BUG?
SKP
JMP I PACK
JMS I DSKEP / YES, WRITE BLOCK
4200 / WRITE 1 BLOCK
PACKIO, IOBUF
PACKBL, 0
JMP I PACK
ISZ PACKBL / UPDATE BLOCK NUMBER
ISZ CLSIZ / UPDATE FILE SIZE
TAD PACKIO / RESET POINTER
DCA PACKP
PACKC, ISZ PACK
JMP I PACK
PACKCH, 0 / CHAR TO PACK
PACKX, 0 / TRISTATE: 0 CHAR 1, 1 CHAR 2, -1 CHAR 3
PACK0, 0 / PACKED WORD 0
PACK1, 0 / PACKED WORD 1
PACKP, 0 / -> PLACE IN IOBUF
/ SAVE FILE COMMAND.
SVFILE, 0
TAD [BUF / WRBEG = BUF
DCA WRBEG
TAD [BUFEND / WREND = BUFEND