1 / WPFILS -- FILE I-O ROUTINES 2 / 3 4 / 048 MART 30-APRL-85 ADDED FIELD 7 BLASTR HOOK 5 / 6 / --------- Following edits V2.0 and earlier 7 / 8 / 047 WCE 25-MAY-84 Removed old STATLN definitions 9 / 046 WCE 23-JAN-84 Move RPTEM1 to page where used 10 / 045 WJY 17-NOV-83 Read first header block back into core 11 / after getting all the extensions. 12 / 044 WJY 29-OCT-83 Added logic to check if the correct 13 / header block is already in core before 14 / requesting it to be read from disk. 15 / This request occurs in a RESTORE FILE 16 / POINTERS call and caused problems for 17 / GOTO-RULER. 18 / 043 WCE 31-AUG-83 Add conditionals for status line in the 19 / editor to only get one block when 20 / needed so that block count will go up 21 / by one instead of three so that users 22 / will not complain about counting. 23 / 042 DMB 29-AUG-83 Added function calls for GOTO-RULER 24 / (also useful for GOTO-PAGE) 25 / 041 WCE 19-JUL-83 Modify symbol names for new prefix file 26 / 040 EH 06-JUL-83 Ignore GTP extensions on read only file 27 / 039 WCE 11-MAY-83 Make OPEN for OVERWRITE free up space 28 / 038 EH 18-JAN-83 Clear RPSPLT between each block 29 / 037 EH 16-DEC-82 Clear RPMODE prior to building desc. 30 / word if writing thru ETX buffer 31 / 036 GJP/EH 09-DEC-82 Set hdr ptr to 1 on read-file re-init. 32 / 035 WJD 09-DEC-82 remove 034 attempt at power-lost fixes 33 / code was altogether deleted 34 / 034 WJD 19-NOV-82 1200 baud & power-lost fixes 35 / 033 WJD 19-NOV-82 Writeout alloc. block during close 36 / for SORT bugfix 37 / 032 EH 30-JUL-82 Modify parallel GTP structure 38 / 031 EH 24-JUN-82 Write alloc. blk. after alloc. req. 39 / 030 WJD/EH 30-MAR-82 Process print controls 40 / 029 WJD 23-MAR-82 G-T-P link verification 41 / 028 GDH 18-MAR-82 "SQUISHED TEXT" bug & general cleanup. 42 / 027 EH 16-MAR-82 Fix uppercase bug 43 / 026 EH 22-FEB-82 OH-015 PUT page counters fix. See also 44 / WPEDIT '144'. (DM-387) 45 / 025 WJD 15-FEB-82 DM-316 (GOTO PAGE rel.) 46 / 024 WJD 10-FEB-82 Extn. blks. erroneously deallocated during OPEN 47 / 023 WJD 08-FEB-82 GOTO-PAGE header deallocation 48 / 022 GJP 04-FEB-82 Correct header deallocation problem 49 / 021 EH 27-JAN-82 Correct mode in descriptor word 50 / 020 EH 27-JAN-82 Fix relative paging around end of ext. 51 / 019 WJD 15-JAN-82 OPEN was corrupting descriptor block 52 / 018 WJD 07-JAN-82 STX/ETX buffer page-counters installed for REL GOTO PAGE 53 / 017 EH 31-DEC-81 Save mode when writing through STX 54 / Fixed problem assoc.with backup through 55 / hdr blocks ptrs. 56 / 016 WJD 21-DEC-81 REMOVED GOTO PAGE MATH RECOGNTION 57 / 015 GJP 15-DEC-81 WPFILS BUG DEALOCATING ASSIGNED BLOCKS 58 / 014 WJD 14-DEC-81 GOTO structure support of >2 extensions 59 / 013 EH/WJD 14-DEC-81 Inform editor of new block just read into ETX buffer 60 / 012 EH 11-DEC-81 Save mode of first char. in a block 61 / 0011 GDH/DFB 09-DEC-81 Fix to initialize block pntr(go to page) 62 / 010 JRF 08-DEC-81 Removed temporary CMD 9 equate in 63 / ESCTAB table. 64 / 009 WJD 04-DEC-81 Support offset PAGE positioning 65 / 008 WJD 03-DEC-81 Fix GOTO PAGE extension blocks problem 66 / 007 JRF 23-NOV-81 Modify ESCTAB and SPCTAB tables for 67 / handling of MATH area start and 68 / end characters. 69 / 0006 GDH 12-NOV-81 Bug fix to TBO overwrite 0 length files. 70 / 0004 GDH 2-OCT-81 RPG to ignore GET DENSITY function. 71 / 002 WJD 25-OCT-81 Added V2 GOTO PAGE support routines 72 / 0001 GDH 26-AUG-81 Moved WPFILS to field 7. 73 / X3.5 JLZ 26-JUN-80 MODIFIED PRINTER'S FILE READER TO 74 / SUPPORT ENHANCED HEADERS/FOOTERS 75 / TT 07-JUL-81 Removed superfluous conditionals 76 / III.B MB 1-APR-78 PUT IN SYSTEM OPTIONS 77 / III-1 KEE 2/27/78 ADD WT'S 'TD' COMMAND 78 / 2.7A-1 LDB 1/6/78 MODIFY FOR WT-78 7-BIT 79 / 2.5-1 LDB 11/11/77 MAKE IT HARDER TO CLOSE UNOPENED FILES 80 / 2.4D+ RTL 10/17/77 FILE SIZE BUG IN ALOC 81 / 2.Q-1 RLT 9/24/77 BUG IN R2OPEN FOR WT78 82 / 2.P LDB 9/19/77 PUT IN SIXBIT CALLS FOR MAIN'S VERIFY 83 / 2.N RLT 9/14/77 ADD UDKPRT STUFF 84 / 2.J KEE 8/26/77 ADD 4-FLOPPY SUPPORT 85 / 2.G-1 MSB 8/9/77 GET IT FROM THE 78 PACK 86 / 87 / USE "PAL WPFILS PTR. TO ETX OR STX MODE WORD undefined ^ undefined ^ 020715 3000 597 020716 2312 ISZ GETMOD 598 020717 7501 MQA 599 020720 7540 SMA SZA / ++++ 600 020721 5342 JMP GETMD1 / NORMAL ASCII 601 020722 7450 SNA / ++++ 602 020723 5712 JMP I GETMOD 603 020724 7001 IAC 604 020725 7450 SNA / ++++ 605 ISZ T1 / ADJUST T1 IF SHIFT-UNSHIFT CHANGE undefined ^ undefined ^ 020726 2000 606 020727 1372 TAD (MODTAB) / ++++ 607 DCA T2 / GET PTR undefined ^ undefined ^ 020730 3000 608 TAD I T2 undefined ^ undefined ^ 020731 1400 609 020732 7510 SPA / ++++ 610 020733 5712 JMP I GETMOD / RETURN QUICK IF ERROR 611 020734 7040 CMA 612 AND I T1 undefined ^ undefined ^ 020735 0400 613 020736 7420 SNL / ++++ 614 TAD I T2 undefined ^ undefined ^ 020737 1400 615 DCA I T1 / SET NEW MODE undefined ^ undefined ^ 020740 3400 616 020741 5712 JMP I GETMOD 617 GETMD1, 618 TAD I T1 / ADD MODE FLAGS undefined ^ undefined ^ 020742 1400 619 ISZ T1 /BUMP TO SHIFT MODE undefined ^ undefined ^ 020743 2000 620 020744 7430 SZL / ++++ 621 TAD I T1 / AND UNSHIFT undefined ^ undefined ^ 020745 1400 622 623 /PAGE-MARKERS LEAVING SCROLL BUFFER(GET) GOING INTO THE EDIT BUFFER /A018 624 625 DCA T2 /SAVE THE CURRENT 12-BIT CHAR. /A018 undefined ^ undefined ^ 020746 3000 626 TAD T2 /REFRESH THE AC /A018 undefined ^ undefined ^ 020747 1000 627 628 020750 1113 TAD NWPAGE / IS IT A NEW-PAGE MARKER? /M032 629 020751 7440 SZA / SKIP IF: NEW-PAGE MARKER /M032 630 020752 1103 TAD PAGEMK / IS IT A PAGE-MARKER? /M032 631 020753 7640 SZA CLA / SKIP IF: PAGE-MARKER /A018 632 020754 5361 JMP RPCTEX / JUMP IF: NEITHER /A018 633 634 ISZ T1 / BUMP TO APPRO. PAGE-COUNTER /A018 undefined ^ undefined ^ 020755 2000 635 AC7777 / PAGE-MARKER LEAVING SCROLL BUFFER /A018 undefined ^ 020756 0000 636 TAD I T1 / DECR. PAGE-COUNTER ACCORDINGLY /A018 undefined ^ undefined ^ 020757 1400 637 DCA I T1 / UPDATE THE PAGE-COUNTER /A018 undefined ^ undefined ^ 020760 3400 638 RPCTEX, TAD T2 / RETURN THE CURRENT 12-BIT CHAR. /A018 undefined ^ undefined ^ 020761 1000 639 640 020762 5712 JMP I GETMOD 641 642 020763 7777 -1 / ERROR 643 020764 2000 2000 644 020765 1400 1400 645 020766 1000 1000 646 020767 0400 400 647 020770 0200 200 648 MODTAB=. 649 020771 0040 40 650 /--------------- 651 020772 0771 PAGE 020773 0711 020774 0046 020775 0033 020776 1327 020777 1315 652 653 PUTSTX, XX / PUT 12-BIT TO STX undefined ^ 021000 0000 654 655 /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 656 657 /Save the current 12-bit char. going into either the ETX or /M039 658 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 659 660 021001 3215 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 661 021002 1215 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 662 663 021003 4777 NXTSTX, JMS SAVSTX / SAVE THE CURRENT STX MODE. /A028 664 021004 4234 JMS PUTMOD / ++++ 665 021005 1351 STXMOD 666 021006 4776 JMS XLTCOS 667 021007 3775 DCA STXSV1 /PASS THE CHAR. /A002 668 669 021010 4774 JMS PUTSTC 670 021011 1341 TAD CHRHLD / RESCAN OR DONE (0) 671 021012 7440 SZA / SKIP IF BOTH BYTES DONE 672 021013 5203 JMP NXTSTX /DO LAST BYTE OF WORD /A026 673 021014 5600 JMP I PUTSTX 674 675 021015 0000 CUR12BIT, 0 /CURRENT "12-BIT" CHAR. /A026 676 677 PUTETX, XX / PUT 12-BIT TO ETX undefined ^ 021016 0000 678 679 /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 680 681 /Save the current 12-bit char. going into either the ETX or /M039 682 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 683 684 021017 3215 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 685 021020 1215 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 686 687 /SECONDARY ENTRY FOR NEXT BYTE /A026 688 021021 4773 NXTETX, JMS SAVETX / SAVE CURRENT ETX MODE SETTINGS. /A028 689 021022 4234 JMS PUTMOD / ++++ 690 021023 2561 ETXMOD 691 021024 7020 CML / ++++ 692 021025 4776 JMS XLTCOS 693 021026 3775 DCA STXSV1 /PASS THE CHAR. /A002 694 695 021027 4772 JMS PUTETC 696 021030 1341 TAD CHRHLD / ++++ 697 021031 7440 SZA / ++++ 698 021032 5221 JMP NXTETX /DO LAST BYTE OF WORD /A026 699 021033 5616 JMP I PUTETX 700 701 PUTMOD, XX / CHECK FOR MODE CHANGES undefined ^ 021034 0000 702 021035 7421 MQL / CURRENT 12-BIT CHAR. INTO MQ 703 021036 7501 MQA / BACK INTO AC 704 021037 3341 DCA CHRHLD / SAVE FOR RESCAN 705 021040 1634 TAD I PUTMOD / ADDR. OF CURRENT MODE WORD 706 DCA T1 / T1 = PTR TO MODE WORD undefined ^ undefined ^ 021041 3000 707 021042 2234 ISZ PUTMOD /BUMP TO RETURN ADDR 708 021043 7501 MQA / AC = CURRENT 12 BIT CHAR 709 021044 0371 AND (3600) / ISOLATE MODE BITS 710 021045 7041 CIA / ++++ 711 TAD I T1 / CHECK FOR ANY CHANGES undefined ^ undefined ^ 021046 1400 712 021047 7450 SNA / SKIP IF MODE CHANGE 713 021050 5312 JMP PUTMD1 / IF NONE, CHECK CASE 714 DCA T2 / SAVE DIFFERENCE undefined ^ undefined ^ 021051 3000 715 021052 1370 TAD (MSKTAB-1) / ++++ 716 DCA T3 / GET SEARCH PTR undefined ^ undefined ^ 021053 3000 717 TAD T2 / ++++ undefined ^ undefined ^ 021054 1000 718 021055 7002 BSW / GET DIFFERENCE 719 021056 7012 RTR / ++++ 720 ISZ T3 / ++++ undefined ^ undefined ^ 021057 2000 721 021060 7520 SMA SNL / ++++ 722 021061 5256 JMP .-3 / FIND FIRST CHANGE 723 021062 7320 CLA CLL CML 724 TAD I T1 / ++++ undefined ^ undefined ^ 021063 1400 725 AND I T3 / NEED TO CLEAR MODE? undefined ^ undefined ^ 021064 0400 726 021065 7440 SZA / ++++ 727 021066 5272 JMP PUTMD2 / JUMP IF SO 728 021067 7501 MQA / ++++ 729 AND I T3 / MUST NEED TO SET, THEN undefined ^ undefined ^ 021070 0400 730 021071 7020 CML 731 021072 7421 PUTMD2, MQL / ++++ 732 021073 7501 MQA 733 021074 7040 CMA / ++++ 734 AND I T1 / ++++ undefined ^ undefined ^ 021075 0400 735 021076 7420 SNL / ++++ 736 021077 7501 MQA / SET-CLEAR 737 DCA I T1 / STORE NEW MODE undefined ^ undefined ^ 021100 3400 738 021101 1367 TAD (TAB-1) / ++++ 739 DCA X1 / GET TAB PTR undefined ^ undefined ^ 021102 3000 740 021103 7501 MQA 741 TAD I X1 / ++++ undefined ^ undefined ^ 021104 1400 742 021105 7440 SZA / ++++ 743 021106 5304 JMP .-2 / FIND CHANGE PATTERN 744 TAD X1 / ++++ undefined ^ undefined ^ 021107 1000 745 021110 1366 TAD (-TABND-1) / COMPTE CHANGE NUMBER 746 021111 5634 JMP I PUTMOD 747 748 021112 7501 PUTMD1, MQA / ++++ 749 021113 0102 AND P100 750 021114 7650 SNA CLA / ++++ 751 021115 5335 JMP PUTMD3 / JUMP IF NOT ALPHA 752 ISZ T1 / GET PTR TO UNSHIFT CODE undefined ^ undefined ^ 021116 2000 753 021117 7501 MQA / ++++ 754 021120 0365 AND (40) / GET UNSHIFT BIT 755 021121 7041 CIA / ++++ 756 TAD I T1 / COMPARE WITH STORED VAL undefined ^ undefined ^ 021122 1400 757 021123 7100 CLL 758 021124 7650 SNA CLA / ++++ 759 021125 5336 JMP PUTMD4 / JUMP IF SAME 760 021126 7501 MQA / ++++ 761 021127 0365 AND (40) / GET NEW BIT 762 021130 7440 SZA / ++++ 763 021131 7020 CML / SET LINK ACCORDINGLY 764 DCA I T1 / STORE NEW BIT undefined ^ undefined ^ 021132 3400 765 021133 7040 CMA / RETURN -1 CODE 766 021134 5634 JMP I PUTMOD 767 768 021135 7120 PUTMD3, CLL CML 769 021136 3341 PUTMD4, DCA CHRHLD / ++++ 770 021137 7501 MQA / CLEAR RESCAN, RETURN CHAR 771 021140 5634 JMP I PUTMOD 772 773 021141 0000 CHRHLD, .-. 774 775 021142 6000 TAB, -2000 776 021143 0400 2000-1400 777 021144 0400 1400-1000 778 021145 0400 1000-400 779 021146 0200 400-200 780 TABND=. 781 782 021147 0200 MSKTAB, 200 783 021150 1400 1400 784 021151 2000 2000 785 786 787 RDINI2, XX undefined ^ 021152 0000 788 021153 7002 BSW / ++++ 789 021154 7012 RTR 790 021155 0125 AND T17 / ISOLATE AND SAVE DRIVE NUMBER 791 DCA RDFQBK+RXQDRV undefined ^ 021156 3764 792 021157 1363 TAD (CDFBUF) / get cdf to buffer field. /A028 793 DCA RDFQBK+RXQBFD / AND BUFFER FIELD undefined ^ 021160 3764 794 021161 5752 JMP I RDINI2 795 /--------------- 796 021163 0000 PAGE 021164 0311 021165 0040 021166 6630 021167 1141 021170 1146 021171 3600 021172 1242 021173 0341 021174 1266 021175 1350 021176 1200 021177 0330 797 798 XLTCOS, XX undefined ^ 021200 0000 799 021201 7510 SPA / ++++ 800 021202 5224 JMP XLTCO1 / JUMP IF MODE CHANGE 801 AND P177 undefined ^ undefined ^ 021203 0000 802 021204 1000 TAD M100 / CHECK ALPHA 803 021205 7500 SMA / ++++ 804 021206 5234 JMP XLTCO2 / JUMP IF ALPHA 805 021207 1377 TAD (100-37) / ADJUST FOR COS 806 021210 7540 SZA SMA / ++++ 807 021211 5600 JMP I XLTCOS / RETURN IF OK 808 021212 1376 TAD (37-17) / ++++ 809 021213 7540 SMA SZA / ++++ 810 021214 5222 JMP XLTCO3 / JUMP IF ILLEGAL 811 812 021215 1375 TAD (17-7) / ++++ /D002/A016 813 814 021216 7510 SPA / ++++ 815 021217 5222 JMP XLTCO3 816 021220 1374 TAD (SPCTAB) / ELSE GET XLAT PTR 817 021221 5231 JMP XLTCO4 / AND XLATE 818 XLTCO3, 819 021222 7200 CLA 820 021223 5600 JMP I XLTCOS 821 822 021224 7044 XLTCO1, CMA RAL 823 021225 1373 TAD (-MAXCOS) / ++++ 824 021226 7500 SMA / ++++ 825 021227 7200 CLA 826 021230 1372 TAD (MAXCOS+COSTAB) 827 XLTCO4, DCA T1 / CONVERT TO PTR undefined ^ undefined ^ 021231 3000 828 TAD I T1 undefined ^ undefined ^ 021232 1400 829 021233 5600 JMP I XLTCOS 830 831 021234 0371 XLTCO2, AND (37) / ++++ 832 021235 1370 TAD (-33) 833 021236 7500 SMA / ++++ 834 021237 1367 TAD (7722-133+37) / XLAT RESERVED CHARS 835 021240 1366 TAD (133-37) / ADJUST 836 021241 5600 JMP I XLTCOS 837 838 / make sure that there is room in this block for a 2-char. 839 / ESC seq; it is no longer acceptable to split an ESC seq. 840 / between 2 blocks because of the random access used by V2 841 / GOTO PAGE. 842 / if this is an ESC seq. and there is only 1 byte available in 843 / the text buffer, send a null to fill up the buffer and cause 844 / a write to disk. then put the 2-char. ESC seq. in the next 845 / block. in this way, GOTO PAGE will never access a block con- 846 / taining 1/2 of an ESC seq. 847 848 PUTETC, XX /ENTER W/CHAR. IN STXSV1 undefined ^ 021242 0000 849 021243 1152 TAD SCEPTR /GET THE ETX-BUFFER-CHAR. PTR. /A002 850 021244 7640 SZA CLA /SKIP IF THIS WILL BE THE LAST BYTE /A002 851 021245 5253 JMP RPETCX /ROOM FOR 2-CHAR. ESC SEQ. /A002 852 853 021246 1350 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 854 AND P7700 /GET SET FOR /A002 undefined ^ undefined ^ 021247 0000 855 021250 1102 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 856 021251 7650 SNA CLA /SKIP IF NOT ESC SEQ /M007 857 021252 4765 JMS PUTET1 /GO SEND NULL AS LAST BYTE /A002 858 859 RPETCX, /A002 860 861 021253 4764 JMS SAVETX / SET EXTSAV TO CURRENT MODE SETTINGS. /A028 862 021254 1350 TAD STXSV1 863 AND P77 / ++++ undefined ^ undefined ^ 021255 0000 864 021256 7440 SZA / ++++ 865 021257 4765 JMS PUTET1 866 021260 1350 TAD STXSV1 / ++++ 867 021261 7002 BSW / ++++ 868 AND P77 / ++++ undefined ^ undefined ^ 021262 0000 869 021263 7440 SZA / ++++ 870 021264 4765 JMS PUTET1 871 021265 5642 JMP I PUTETC 872 873 PUTSTC, XX /ENTER W/CHAR. IN STXSV1 undefined ^ 021266 0000 874 021267 1347 TAD STXSAV / ++++ 875 021270 7440 SZA / ++++ 876 021271 4763 JMS PUTST1 877 878 / same 2-char. ESC seq. check done here... 879 880 AC0001 /AC => 1 /A002 undefined ^ 021272 0000 881 021273 1151 TAD SCTPTR /ADVANCE STX BUFFER CHAR. POINTER /A002 882 021274 1362 TAD (-SCHCNT /COMPARE TO MAX. # OF BYTES /A002 883 021275 7640 SZA CLA /SKIP IF THIS CHAR. WILL FILL BUFFER /A002 884 021276 5304 JMP RPSTCX /ROOM FOR A 2-CHAR. ESC SEQ. /A002 885 886 021277 1350 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 887 AND P7700 /GET SET FOR /A002 undefined ^ undefined ^ 021300 0000 888 021301 1102 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 889 021302 7650 SNA CLA /SKIP IF NOT ESC SEQ /M007 890 021303 4763 JMS PUTST1 /GO SEND NULL AS LAST BYTE /A002 891 892 021304 1350 RPSTCX, TAD STXSV1 /A002 893 021305 7002 BSW / ++++ 894 AND P77 / ++++ undefined ^ undefined ^ 021306 0000 895 021307 7440 SZA / ++++ 896 021310 4763 JMS PUTST1 897 021311 1350 TAD STXSV1 / ++++ 898 AND P77 / ++++ undefined ^ undefined ^ 021312 0000 899 021313 3347 DCA STXSAV 900 021314 5666 JMP I PUTSTC 901 902 GETETC, XX undefined ^ 021315 0000 903 021316 4761 JMS GETET1 904 021317 1360 TAD (-77) / ++++ 905 021320 7440 SZA / ++++ 906 021321 5325 JMP GETETA 907 021322 4761 JMS GETET1 908 TAD P7700 undefined ^ undefined ^ 021323 1000 909 021324 7410 SKP 910 GETETA, TAD P77 undefined ^ undefined ^ 021325 1000 911 021326 5715 JMP I GETETC 912 913 GETSTC, XX undefined ^ 021327 0000 914 021330 1347 TAD STXSAV / ++++ 915 021331 7450 SNA / ++++ 916 021332 4757 JMS GETST1 917 021333 3350 DCA STXSV1 918 021334 4757 JMS GETST1 919 021335 1360 TAD (-77) / ++++ 920 021336 7450 SNA / ++++ 921 021337 5343 JMP GETSA1 922 TAD P77 / ++++ undefined ^ undefined ^ 021340 1000 923 021341 3347 DCA STXSAV 924 021342 5345 JMP GETSA2 925 021343 3347 GETSA1, DCA STXSAV 926 TAD P7700 undefined ^ undefined ^ 021344 1000 927 021345 1350 GETSA2, TAD STXSV1 928 021346 5727 JMP I GETSTC 929 930 021347 0000 STXSAV, 0 931 021350 0000 STXSV1, .-. 932 933 021351 0000 STXMOD, 0 / STX MODES 934 021352 0000 0 /SHIFT FLAG 935 021353 0000 0 /STX BUFFER PAGE-COUNTER /A018 936 021354 0000 STXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 937 /OUT THROUGH STX BUFFER /A030 938 /--------------- 939 021357 2200 PAGE 021360 7701 021361 2250 021362 7004 021363 2222 021364 0341 021365 2274 021366 0074 021367 7626 021370 7745 021371 0037 021372 0752 021373 7764 021374 0725 021375 0010 021376 0020 021377 0041 940 941 / SCINI - INIT FOR FILENO IN AC 942 SCHCNT=774 / #CHARS IN DATA BLOCK 943 / 774 = 508 DEC. 944 / DECIMAL: 254 12-BIT CHARS = 508 6-BIT CHARS. 945 946 BOFSET= 2 / OFFSET TO FIRST CHAR. WORD IN BLOCK 947 SCBKOF=52 / OFFSET TO BLOCK PTRS IN 1ST HEADER 948 949 SCINI, XX undefined ^ 021400 0000 950 DCA T1 undefined ^ undefined ^ 021401 3000 951 TAD T1 undefined ^ undefined ^ 021402 1000 952 AND P377 / ISOLATE DOCUMENT NUMBER undefined ^ undefined ^ 021403 0000 953 DCA SCQBLK+RXQFNO / STORE FILE # undefined ^ 021404 3777 954 955 TAD T1 undefined ^ undefined ^ 021405 1000 956 021406 7002 BSW / ++++ 957 021407 7012 RTR / POSITION DRIVE NUMBER 958 021410 0125 AND T17 /(17) GETS DRIVE FLAGS /M025 959 DCA SCQBLK+RXQDRV / SET DRIVE FLAGS undefined ^ 021411 3777 960 021412 4776 JMS SCQRX / GO GET DENSITY TO ESTAB DENSITY OF DRIVE 961 RXEDN+4000 undefined ^ 021413 4000 962 021414 0000 0 963 964 021415 4776 JMS SCQRX 965 RXEGF / ++++ undefined ^ 021416 0000 966 021417 0000 0 967 021420 1775 TAD SCQBLK+RXQBLK / PICK UP BLOCK NUMBER 968 021421 7450 SNA / ++++ 969 021422 5267 JMP SCIER1 / WE DID GET ONE? 970 021423 3774 DCA SCHDRB / SAVE AS HEADER BLOCK NUMBER 971 021424 1374 TAD (SCHDRB) / ++++ 972 021425 3773 DCA SCHDBN / READ FIRST HEADER 973 974 021426 4772 JMS SCGTWR 975 021427 0000 CDFBUF / GET FILE SIZE 976 021430 1771 TAD I (SCHDR+5) 977 021431 3142 DCA SCFILZ 978 979 021432 1142 TAD SCFILZ / ++++ 980 021433 1110 TAD M310 /GREATER THAN 210 PTRS.? /A025 981 021434 7700 SMA CLA / ++++ 982 021435 1770 TAD I (SCHDR+2) 983 021436 0000 CDFMYF 984 021437 3767 DCA SCHDRB+1 985 021440 0000 CDFBUF 986 021441 1766 TAD I (SCHDR+3) 987 021442 0000 CDFMYF 988 021443 3765 DCA SCHDRB+2 989 021444 4764 JMS SCFLZB / GO SET UP TOP AND BOTTOM POINTERS /A003 990 021445 0000 CDFBUF 991 021446 1763 TAD I (SCHDR+1) 992 021447 7421 MQL / ++++ 993 AC2000 / ++++ undefined ^ 021450 0000 994 021451 7501 MQA / OPEN FOR UPDATE 995 021452 3763 DCA I (SCHDR+1) 996 AC0001 undefined ^ 021453 0000 997 021454 1762 TAD I (SCHDR+12) / INCR TIME EDITED 998 021455 7500 SMA / ++++ 999 021456 3762 DCA I (SCHDR+12) / DON'T INCR PAST 2047 1000 021457 7200 CLA 1001 021460 3761 DCA I (SCHDR+SCBKOF+2) / CLEAR "DATA BLK 0" PTR 1002 021461 0000 CDFMYF 1003 AC0001 / ++++ undefined ^ 021462 0000 1004 021463 4772 JMS SCGTWR / WRITE OUT HEADER 1005 021464 4760 JMS GTHDRS / GO GET HEADER EXTENSIONS INTO MEMEORY /A003 1006 021465 3051 SCBFCB / POINT TO THE HDR CONTROL BLOCK /A003 1007 021466 5270 JMP SCINX / TAKE OK RETURN 1008 SCIER1, 1009 021467 7001 IAC 1010 021470 5600 SCINX, JMP I SCINI / DONE 1011 1012 / SCWEB - WRITE END BLOCK 1013 021471 0000 SCWEB, 0 1014 021472 4757 JMS SCTPBT / GO SEE IF BOTTOM = TOP +1 /A003 1015 021473 4756 JMS SCALOC / YES - ALLOCATE A BLOCK BETWEEN THEM 1016 021474 4333 JMS SCBUFI / GO INITIATE BUFFER AREA FOR COS 310 COMPATIBILITY 1017 021475 6400 SCEB / INIT BUF HDR FOR COS 1018 021476 4755 JMS SCBOTP / GO DECREMENT BOTTOM /A003 1019 021477 7777 -1 / BY 1 /A003 1020 021500 4754 JMS SCGETR / GET BLOCK NUMBER SCBOT - 1 POINTS TO 1021 021501 0134 SCBTH / BOTTOM HEADER POINTER /A003 1022 021502 0133 SCBOT / BOTTOM HEADER WORD POINTER /A003 1023 1024 021503 4776 JMS SCQRX / WRITE END BUFFER TO THAT BLOCK 1025 021504 2004 RXEWT+2000 / ++++ 1026 021505 6400 SCEB 1027 021506 7200 CLA / MAKE SURE OF CLEAR AC /A037 1028 021507 3753 DCA RPMODE / CLEAR MODE WORD /A037 1029 021510 4752 JMS TORPDSBD / WRITE GTP TEXT BLK /A032 1030 021511 3153 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 1031 021512 5671 JMP I SCWEB / RETURN 1032 1033 / SCWTB - WRITE TOP BLOCK 1034 021513 0000 SCWTB, 0 1035 021514 4757 JMS SCTPBT / CHECK IF A BLOCK IS 'TWEEN TOP AND BOTTOM/A003 1036 021515 4756 JMS SCALOC / NO - SO ALLOC ONE TO GO THERE 1037 021516 4333 JMS SCBUFI / GO INIT BUFFER AREA FOR COS 310 COMPATIBILITY 1038 021517 7000 SCTB / INIT BUF HDR FOR COS 1039 021520 4751 JMS SCTOPP / GO INCREMENT TOP POINTERS /A003 1040 021521 0001 1 / UP BY 1 /A003 1041 021522 4754 JMS SCGETR / GET THAT BLOCKNO 1042 021523 0135 SCTPH / TOP HEADER POINTER /A003 1043 021524 0132 SCTOP / TOP HEADER WORD POINTER /A003 1044 1045 021525 4776 JMS SCQRX / WRITE TOP BUFFER THERE 1046 021526 2004 RXEWT+2000 / ++++ 1047 021527 7000 SCTB 1048 021530 4752 JMS TORPDSBD / WRITE GTP TEXT BLK /A032 1049 021531 3153 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 1050 021532 5713 JMP I SCWTB / DONE 1051 1052 SCBUFI, XX / INTIALIZE 1ST TWO WORDS IN BUFFER /A003 undefined ^ 021533 0000 1053 AC7777 / MINUS 1 TO AC /A003 undefined ^ 021534 0000 1054 021535 1733 TAD I SCBUFI / GET BUFFER ADDRESS - 1 (FOR INDEXING) /A003 1055 DCA X0 / PUT ADDRESS INTO AUTO INDEXING AREA /A003 undefined ^ undefined ^ 021536 3000 1056 TAD (COSCNT) / GET COS COMPATIBLE CHARACTER /A003 undefined ^ undefined ^ 021537 1350 1057 021540 0000 CDFBUF / CHANGE TO BUFFER FIELD /A003 1058 DCA I X0 / STUFF COS 310 STUFF IN BUFFER /A003 undefined ^ undefined ^ 021541 3400 1059 DCA I X0 / ZERO SECOND BYTE OF BUFFER /A003 undefined ^ undefined ^ 021542 3400 1060 021543 0000 CDFMYF / BACK TO THIS FIELD /A003 1061 021544 2333 ISZ SCBUFI / BUMP UP TO RETURN /A003 1062 021545 5733 JMP I SCBUFI / RETURN /A003 1063 /--------------- 1064 021550 0000 PAGE 021551 3331 021552 1202 021553 1200 021554 2000 021555 3311 021556 1600 021557 3400 021560 2674 021561 6054 021562 6012 021563 6001 021564 3600 021565 3055 021566 6003 021567 3054 021570 6002 021571 6005 021572 3076 021573 3052 021574 3053 021575 2553 021576 2512 021577 2542 1065 1066 /D047 IFNDEF STATLN < /A043 1067 /D047 / SCALOC - ALLOCATE 3 BLOCKS BETWEEN TOP AND BOTTOM 1068 /D047 SCALOC, XX 1069 /D047 AC7775 / GET MINUS THREE FOR LOOP CONTROL 1070 /D047 DCA SCALCT / SET TO ALLOC 3 1071 /D047 > / END IFNDEF STATLN /A043 1072 /D047 IFDEF STATLN < /A043 1073 1074 / SCALOC - ALLOCATE 1 BLOCK BETWEEN TOP AND BOTTOM /A043 1075 1076 SCALOC, XX /A043 undefined ^ 021600 0000 1077 AC7777 / GET MINUS ONE FOR LOOP CONTROL /A043 undefined ^ 021601 0000 1078 021602 3251 DCA SCALCT / SET TO ALLOC 1 /A043 1079 1080 /D047 > / END IFDEF STATLN /A043 1081 1082 021603 1134 TAD SCBTH / GET BOTTOM HEADER POINTER /A003 1083 021604 3245 DCA SCBTHS / SAVE BOTTOM HEADER POINTER /A003 1084 021605 1133 TAD SCBOT / GET BOTTOM /A003 1085 021606 3246 DCA SCBOTS / SAVE BOTTOM HEADER WORD POINTER /A003 1086 021607 3247 DCA SCALC / INIT COUNT /A003 1087 021610 5213 JMP SCALCD / GO INCREMENT AND GET BLOCK NBR /A003 1088 1089 021611 4777 SCALC1, JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1090 021612 0001 1 / BY ONE /A003 1091 1092 021613 2247 SCALCD, ISZ SCALC / INREMENT THE COUNTER /A003 1093 021614 4776 JMS SCGETR / GET BLOCK NUMBER 1094 021615 0134 SCBTH 1095 021616 0133 SCBOT 1096 021617 7640 SZA CLA / IS IT END OF FILE? 1097 021620 5211 JMP SCALC1 / NO - LOOK AT NEXT ONE 1098 1099 021621 1247 TAD SCALC / GET COUNT OF HOW MANY BLOCKS 'TILL END 1100 021622 7041 CIA / MAKE NEGATIVE FOR ISZ LOOP 1101 021623 3247 DCA SCALC / SAVE 1102 1103 1104 /D047 IFDEF STATLN < /A043 1105 1106 AC0001 / SET UP TO BUMP FILE BY ONE BLOCK /A043 undefined ^ 021624 0000 1107 1108 /D047 > / END IFDEF STATLN /A043 1109 /D047 IFNDEF STATLN < /A043 1110 /D047 AC0003 / SET UP TO BUMP FILE BY THREE BLOCKS 1111 /D047 > / END IFNDEF STATLN /A043 1112 1113 021625 1142 TAD SCFILZ / COMPUTE NEW FILE SIZE 1114 021626 3142 DCA SCFILZ 1115 1116 021627 4775 JMS SCALC2 / GO MOVE TAIL END OF FILE 1 BLOCKS OVER/M047 1117 021630 1245 TAD SCBTHS / GET BOTTOM HDR PTR UPON ENTRY /A003 1118 021631 3134 DCA SCBTH / PUT IT BACK INTO BOT HDR PTR /A003 1119 021632 1246 TAD SCBOTS / GET BOTTOM HDR WORD PTR /A003 1120 021633 3133 DCA SCBOT / BACK INTO BOT HDR WORD PTR /A003 1121 1122 021634 4774 SCALC3, JMS RPALLOCATE / SUBROUTINE TO ALOC A BLOCK /A030 1123 021635 4773 JMS SCPUTR / SAVE IN B 1124 021636 0134 SCBTH / BOTOM HDR POINTER /A003 1125 021637 0133 SCBOT / BOTTOM HEADER WORD POINTER /A003 1126 1127 021640 4777 JMS SCBOTP / INCR BOTTOM 1128 021641 0001 1 / BY 1 /A003 1129 021642 2251 ISZ SCALCT / ++++ 1130 021643 5234 JMP SCALC3 / LOOP FOR ALL 1131 021644 5600 JMP I SCALOC / DONE 1132 1133 021645 0000 SCBTHS, 0 / TO SAVE HEADER POINTER /A003 1134 021646 0000 SCBOTS, 0 / TO SAVE HEADER WORD POINTER /A003 1135 021647 0000 SCALC, 0 1136 021650 0000 SCALB, 0 1137 021651 0000 SCALCT, .-. 1138 1139 1140 1141 021652 0000 DSKINI, 0 / DSKINI - TOP LEVEL INIT ROUTINE - FILENO IN AC 1142 021653 3141 DCA SCOPTN 1143 021654 3772 DCA RPMODE /GOTO-PAGE-BUILT TEXT BLOCK MODE /M019 1144 021655 4771 JMS CLPTRS /CLEAR BOTH HDR-BLK-PTR TABLES /A024 1145 021656 7501 MQA 1146 021657 4770 JMS SCINI / DO INIT OF HDR BLOCK 1147 021660 7440 SZA / ++++ 1148 021661 5300 JMP DSKIN1 / JUMP IF ERROR 1149 021662 3151 DCA SCTPTR 1150 021663 1367 TAD (SCHCNT-1) 1151 021664 3152 DCA SCEPTR 1152 021665 4766 JMS SCQRX / GET # FREE BLOCKS 1153 RXESP / ++++ undefined ^ 021666 0000 1154 021667 6000 SCHDR 1155 021670 4302 JMS SCSPC / PUT IN HDR FOR CALLER 1156 021671 3765 DCA STXSAV / INIT LOOK-AHEAD 1157 021672 3764 DCA STXMOD / ++++ 1158 021673 3763 DCA STXMOD+1 1159 021674 3762 DCA ETXMOD / ++++ 1160 021675 3761 DCA ETXMOD+1 / INIT MODES 1161 021676 3760 DCA HLDMOD / INIT AT OPEN /A030 1162 021677 3757 DCA RPPCTLFL / INIT AT OPEN TIME /A030 1163 1164 021700 5652 DSKIN1, JMP I DSKINI / DONE 1165 1166 021701 0000 SCFNO, 0 1167 SCIST=10 1168 1169 1170 / SCSPC MOVED HERE FOR SPACE, EDIT # 045 /A045 1171 1172 021702 0000 SCSPC, 0 / PUT # FREE BLOCKS IN HDR 1173 TAD SCQBLK+RXQSPC / FROM Q BLOCK undefined ^ 021703 1756 1174 021704 3100 DCA SCFSPC 1175 021705 5702 JMP I SCSPC 1176 1177 1178 / SCREB - READ END BLOCK 1179 021706 0000 SCREB, 0 1180 021707 4776 JMS SCGETR / GET BLOCK NUMBER BOTTOM POINTS TO 1181 021710 0134 SCBTH / BOTTOM HEADER POINTER /A003 1182 021711 0133 SCBOT / BOTTOM HEADER WORD POINTER /A003 1183 021712 7450 SNA / IS BLOCK ZERO? 1184 021713 5706 JMP I SCREB / YES - EOF - NON-SKIP RETURN 1185 1186 021714 4766 JMS SCQRX / DO A READ OF IT 1187 RXERD / ++++ undefined ^ 021715 0000 1188 021716 6400 SCEB 1189 021717 4755 JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 1190 021720 4777 JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1191 021721 0001 1 / BY 1 /A003 1192 021722 2306 ISZ SCREB / SKIP RETURN 1193 021723 5706 JMP I SCREB 1194 021724 5725 JMP I SCRTB / NON-SKIP RETURN 1195 / SCRTB - READ TOP BLOCK 1196 1197 021725 0000 SCRTB, 0 1198 021726 3754 DCA GTFLG / ON ENTRY AC = (-) /A030 1199 / SET FLAG TO MINUS TO INDICATE A GETSTX/A030 1200 021727 4776 JMS SCGETR / GET BLOCK NUMBER 1201 021730 0135 SCTPH / TOP HEADER POINTER /A003 1202 021731 0132 SCTOP / TOP HEADER WORD POINTER /A003 1203 021732 7450 SNA / ZERO BLOCK IS EOF 1204 021733 5343 JMP NOBLK / MUST NOW CLEAR GTFLG WHEN NO MORE TOP /A030 1205 / BLK. ELSE A GETETX WOULD TRIGGER A /A030 1206 / SET-UP OF HLDMOD /A030 1207 1208 021734 4766 JMS SCQRX / READ INTO TOP BLOCK BUFFER 1209 RXERD / ++++ undefined ^ 021735 0000 1210 021736 7000 SCTB 1211 021737 4755 JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 1212 021740 4753 JMS SCTOPP / DECR TOP POINTER 1213 021741 7777 -1 / AMOUNT TO DECREMENT BY /A003 1214 021742 2325 ISZ SCRTB / SKIP RETURN 1215 021743 3754 NOBLK, DCA GTFLG / CLEAR FLAG SO GETETX WON'T SET-UP /A030 1216 / AND CORRUPT HLDMOD /A030 1217 021744 5725 JMP I SCRTB 1218 /--------------- 1219 021753 3331 PAGE 021754 1422 021755 1524 021756 2542 021757 1201 021760 0340 021761 2562 021762 2561 021763 1352 021764 1351 021765 1347 021766 2512 021767 0773 021770 1400 021771 3351 021772 1200 021773 2013 021774 0307 021775 3435 021776 2000 021777 3311 1220 1221 / SOME UTILITIES 1222 SCGETR, XX / GET A WORD FROM OUT OF THE HEADERS /A003 undefined ^ 022000 0000 1223 022001 7200 CLA 1224 022002 1200 TAD SCGETR / GET ADDR OF ADDRESS OF HEADER PTRS /A003 1225 022003 4231 JMS SCGETX / GO GET THE WORD OUT OF THE HEADERS /A003 1226 022004 4777 JMS RPGETR / GET WORD OUT OF RPPGDS ALSO /A002 1227 1228 022005 0000 CDFBUF / CHANGE TO THE BUFFER FIELD (WHERE HEADER IS) /A003 1229 022006 1644 TAD I SCGTR1 / GET THE WORD FROM THE HEADER /A003 1230 022007 0000 CDFMYF / BACK TO THIS FIELD /A003 1231 022010 2200 ISZ SCGETR / BUMP PAST THE HDR PTR ADR /A003 1232 022011 2200 ISZ SCGETR / BUMP UP TO THE RETURN ADDR /A003 1233 022012 5600 JMP I SCGETR / GO BACK TO CALLER /A003 1234 1235 SCPUTR, XX / ROUTINE TO PUT A WORD INTO THE HEADERS /A003 undefined ^ 022013 0000 1236 022014 3243 DCA SCPTR1 / SAVE THE WORD TO PUT INTO THE HEADER /A003 1237 022015 1213 TAD SCPUTR / GET ADDR OF THE HDR PTR ADDR'S /A003 1238 022016 4231 JMS SCGETX / GO GET THE HEADER /A003 1239 022017 1243 TAD SCPTR1 / GET THE WORD TO PUT INTO THE HEADER /A003 1240 022020 0000 CDFBUF / CHANGE TO BUF FIELD (WHERE HEADER IS) /A003 1241 022021 3644 DCA I SCGTR1 / PUT THE WORD INTO THE HEADER /A003 1242 022022 0000 CDFMYF / BACK TO THIS FIELD /A003 1243 1244 022023 4776 JMS RPPUTR /PUT WORD INTO RPPGDS ALSO /A002 1245 1246 022024 2213 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 1247 022025 2213 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 1248 AC0001 / SIGNAL THAT HEADER IS MODIFIED /A003 undefined ^ 022026 0000 1249 022027 3775 DCA SCHDMD / PUT SIGNAL INTO HDR CTL BLOCK /A003 1250 022030 5613 JMP I SCPUTR / GO BACK /A003 1251 1252 SCGETX, XX / ROUTINE TO SET UP FOR HEADER READ /A003 undefined ^ 022031 0000 1253 022032 3244 DCA SCGTR1 / SAVE ADDR OF PTR ADDRESSES /A003 1254 022033 1644 TAD I SCGTR1 / GET THE HDR PTR /A003 1255 022034 3245 DCA SCGTR2 / SAVE THE HDR PTR /A003 1256 022035 2244 ISZ SCGTR1 / BUMP UP TO PT TO HDR WORD PTR /A003 1257 022036 1644 TAD I SCGTR1 / GET HDR WORD PTR /A003 1258 022037 3244 DCA SCGTR1 / SAVE IT FOR LATER USE /A003 1259 022040 4774 JMS SCOFST / GO SEE IF HEADER IS IN CORE /A003 1260 022041 3051 SCBFCB / HEADER CONTROL BLOCK /A003 1261 022042 5631 JMP I SCGETX / RETURN /A003 1262 022043 0000 SCPTR1, .-. 1263 022044 0000 SCGTR1, .-. / TO SAVE HDR WORD POINTER /A003 1264 022045 0000 SCGTR2, 0 / TO SAVE HDR POINTER /A003 1265 1266 / DSKCLS - TOP LEVEL CLOSE ROUTINE 1267 022046 0000 DSKCLS, 0 1268 AC0100 / FORCE STXMOD=ETXMOD undefined ^ 022047 0000 1269 022050 1773 TAD ETXMOD+1 / ++++ 1270 022051 1772 TAD ETXMOD / MODES + SHIFT 1271 022052 4771 JMS PUTSTX / ++++ 1272 022053 4770 JMS GETSTX / ++++ 1273 022054 7200 CLA 1274 1275 / THE LOGIC BELOW USED TO MOVE THE ETX BUFFER TO THE STX BUFFER WITH /A028 1276 / OVERFLOW GOING OUT TO THE DISK & THEN NULL OUT THE REMAINDER OF THE /A028 1277 / STX BUFFER & WRITE IT OUT TOO. THIS CODE WORKS FINE BUT WILL NOT /A028 1278 / MAINTAIN THE EXTMOD MODE SETTINGS (SINCE EVERYTHING IS DONE IN 6-BIT /A028 1279 / RATHER THAN 12 BIT MODE COPY). AS A RESULT, THE GOTO PAGE DESCRIPTOR /A028 1280 / WORD WOULD NOT BE CORRECT IF AND SHIFT/ESCAPE CODES MOVED FROM THE /A028 1281 / ETX BUFFER INTO THE STX BUFFER (PROBABILITY OF > 99.9 %). THEREFORE /A028 1282 / THE LOGIC NOW WORKS AS FOLLOWS. IF THERE IS ENOUGH ROOM IN THE STX /A028 1283 / BUFFER TO ACCOMODATE THE TEXT IN THE ETX BUFFER, THE PRIOR LOGIC IS /A028 1284 / INVOKED. IF NOT THEN BOTH BUFFERS AR WRITTEN OUT ESSENCIALLY AS IS /A028 1285 / (THE BUFFER IS NULLED OUT TO THE START/END OF BUFFER AS APPROPRIATE). /A028 1286 1287 022055 1767 TAD STXSAV / SEE IF A "SAVE CHAR" EXISTS. /A028 1288 022056 7640 SZA CLA / SKIP IF NO. /A028 1289 AC0001 / YES. COUNT IT. /A028 undefined ^ 022057 0000 1290 022060 1152 TAD SCEPTR / ADD # OF CHARS IN STX MINUS 1. /A028 1291 022061 1151 TAD SCTPTR / ADD # OF CHARS IN ETX MINUS 1. /A028 1292 022062 1366 TAD (-SCHCNT+1) / COMPARE TO MAX # OF CHARS IN BLOCK PLUS/A028 1293 022063 7700 SMA CLA / BAIS. AC WILL BE <0 IF ALL CHARS FIT /A028 1294 / OR FILL BUFFER UP EXACTLY. /A028 1295 022064 5275 JMP DSKCL2 / CANNOT FIT. WRITE BUFFERS AS IS. /A028 1296 DSKCL1, / MOVE ALL CHARS IN ETX BUF TO STX BUF 1297 022065 1152 TAD SCEPTR / SEE IF ALL DONE 1298 022066 1366 TAD (-SCHCNT+1) 1299 022067 7650 SNA CLA 1300 022070 5275 JMP DSKCL2 / ALL DONE MOVING 1301 022071 4765 JMS GETET1 / GET 1 BYTE 1302 1303 022072 3764 DCA STXSV1 /SUPPLY THE CHAR. /A002 1304 022073 4763 JMS PUTSTC / AND MOVE IT (WITH OVERFLOW TO DISK) 1305 022074 5265 JMP DSKCL1 / TRY ANOTHER CHAR 1306 1307 022075 1767 DSKCL2, TAD STXSAV / FLUSH LOOK-AHEAD, IF ANY 1308 022076 7440 SZA 1309 022077 4762 DSKCL3, JMS PUTST1 / PAD WITH NULLS TO FILL 1310 022100 1151 TAD SCTPTR / IS BUFFER EMPTY (MEANING ALL OUTPUT?) 1311 022101 7640 SZA CLA / ++++ 1312 022102 5277 JMP DSKCL3 / LOOP IF NOT 1313 1314 022103 1152 DSKCL4, TAD SCEPTR / GET ETX COUNT OF CHARS. /A028 1315 022104 1366 TAD (-SCHCNT+1) / WHEN BUFFER TOTALLY FULL WE'RE DONE. /A028 1316 022105 7650 SNA CLA / SKIP IF NOT FULL YET. /A028 1317 022106 5311 JMP DSKCL5 / FULL. DONE. /A028 1318 022107 4761 JMS PUTET1 / NULL BALANCE OF ETX BUFFER. /A028 1319 022110 5303 JMP DSKCL4 / LOOP UNTIL EXT BUFFER "MT"S /A028 1320 1321 022111 4760 DSKCL5, JMS SCCLS / CLOSE AT THE BLOCK LEVEL 1322 / SET MODIFIED DATE-TIME IN HEADER 1323 CDFSYS undefined ^ 022112 0000 1324 TAD I (CLOCK+4) / HOUR undefined ^ undefined ^ 022113 1757 1325 022114 7002 BSW / ++++ 1326 TAD I (CLOCK+3) / MINUTE undefined ^ undefined ^ 022115 1756 1327 022116 0000 CDFBUF 1328 022117 3755 DCA I (SCHDR+14) 1329 1330 CDFSYS undefined ^ 022120 0000 1331 TAD I (PAKDAT) / DAY/MONTH undefined ^ undefined ^ 022121 1754 1332 022122 0000 CDFBUF 1333 022123 3753 DCA I (SCHDR+10) 1334 1335 CDFSYS undefined ^ 022124 0000 1336 TAD I (YEAR) / YEAR undefined ^ undefined ^ 022125 1754 1337 022126 0000 CDFBUF 1338 022127 3752 DCA I (SCHDR+11) 1339 1340 022130 0000 CDFMYF / BACK TO THIS FIELD 1341 AC0001 undefined ^ 022131 0000 1342 022132 4751 JMS SCGTWR / WRITE OUT HEADER 1343 022133 4750 JMS WRITEOUT / WRITE THE ALLOCATION BLOCK /A033 1344 022134 5646 JMP I DSKCLS / ALL DONE - RETURN TO CALLER 1345 1346 DSKCLC, XX / VERY, VERY TOP LEVEL CLOSE ROUTINE undefined ^ 022135 0000 1347 / CHECKS TO MAKE SURE A FILE WAS OPEN BEFORE IT 1348 / CALLS THE REAL CLOSE ROUTINE 1349 022136 7200 CLA 1350 TAD SCQBLK+RXQFNO / SEE IF FILE NO. IS NON-ZERO undefined ^ 022137 1747 1351 022140 7650 SNA CLA / IF ZERO JUST RETURN 1352 022141 5735 JMP I DSKCLC 1353 022142 4246 JMS DSKCLS / CALL REAL CLOSE 1354 DCA SCQBLK+RXQFNO / CLEAR FILE NO. undefined ^ 022143 3747 1355 022144 5735 JMP I DSKCLC / RETURN 1356 /--------------- 1357 022147 2542 PAGE 022150 0513 022151 3076 022152 6011 022153 6010 022154 0000 022155 6014 022156 0003 022157 0004 022160 2400 022161 2274 022162 2222 022163 1266 022164 1350 022165 2250 022166 7005 022167 1347 022170 0612 022171 1000 022172 2561 022173 2562 022174 3000 022175 3075 022176 0711 022177 0677 1358 1359 / START AT BOTTOM OF STX-BUFFER AND WORK TOWARDS TOP 1360 1361 GETST1, XX / GET 1 BYTE FROM STX undefined ^ 022200 0000 1362 AC7777 / ++++ undefined ^ 022201 0000 1363 022202 1151 TAD SCTPTR / BACKUP PTR 1364 022203 7500 SMA / ++++ 1365 022204 5213 JMP GETSX1 / JUMP IF STILL OK 1366 022205 4777 JMS SCRTB / GET A NEW TOP BLOCK 1367 022206 5221 JMP GETSX2 / NO MORE BLOCKS AVAILABLE 1368 1369 022207 1776 TAD RPPTR1 /CURRENT V2 DESC. WORD /A018 1370 022210 0375 AND (37 /SAVE # OF PAGES IN THIS BLK /A018 1371 022211 3774 DCA STXMOD+2 /INIT. STX BUFFER PAGE-COUNTER /A018 1372 1373 022212 1373 TAD (SCHCNT-1) / REINIT PTR 1374 022213 3151 GETSX1, DCA SCTPTR 1375 022214 1151 TAD SCTPTR 1376 022215 4320 JMS GETBYT / ++++ 1377 022216 7002 SCTB+BOFSET 1378 022217 7450 SNA / ++++ 1379 022220 5201 JMP GETST1+1 / IGNORE NULLS 1380 022221 5600 GETSX2, JMP I GETST1 / RETURN 1381 1382 / START AT TOP OF STX BUFFER AND WORK DOWN 1383 1384 PUTST1, XX / PUT 1 BYTE TO STX undefined ^ 022222 0000 1385 022223 7421 PUTST2, MQL 1386 022224 1374 TAD (STXMOD+2 /POINTER TO STX BUFFER PAGE-COUNTER /A018 1387 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 undefined ^ undefined ^ 022225 3000 1388 1389 022226 1151 TAD SCTPTR 1390 022227 4334 JMS PUTBYT / ++++ 1391 022230 7002 SCTB+BOFSET 1392 022231 2151 ISZ SCTPTR / BUMP CHAR PTR 1393 022232 1151 TAD SCTPTR / ++++ 1394 022233 1372 TAD (-SCHCNT) / STILL IN RANGE? 1395 022234 7640 SZA CLA / ++++ 1396 022235 5244 JMP PUTSX1 / JUMP IF SO 1397 022236 4771 JMS SCWTB / ELSE OUTPUT FULL BLOCK 1398 022237 7200 CLA /IO RESULT /A018 1399 022240 1770 TAD STXHLD / SET HLDSTX TO BE THE MODE OF THE 1ST /A028 1400 022241 3767 DCA HLDMOD / CHAR OF NEW (LAST OF OLD) BUFFER. /A028 1401 022242 3151 DCA SCTPTR /CLEAR BUFFER-BYTE POINTER /A018 1402 022243 3774 DCA STXMOD+2 /AND STX PAGE-COUNTER /A018 1403 1404 022244 1153 PUTSX1, TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 1405 022245 7640 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 1406 / RANGE /A032 1407 022246 5223 JMP PUTST2 / PAD REST OF BLK WITH NULLS /A032 1408 022247 5622 JMP I PUTST1 / AND RETURN 1409 1410 / START AT TOP OF ETX BUFFER AND WORK DOWN 1411 1412 GETET1, XX / GET 1 BYTE FROM ETX undefined ^ 022250 0000 1413 022251 7200 CLA / ++++ 1414 022252 1152 TAD SCEPTR 1415 022253 1366 TAD (-SCHCNT+1) / STILL IN RANGE? 1416 022254 7640 SZA CLA / ++++ 1417 022255 5265 JMP GETEX1 / JUMP IF SO 1418 022256 4765 JMS SCREB / ++++ 1419 022257 5273 JMP GETEX2 / ELSE REFILL BUFFER 1420 1421 022260 1776 TAD RPPTR1 /CURRENT DESC. WORD /A018 1422 022261 0375 AND (37 /# OF PAGES ONLY /A018 1423 022262 3764 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 1424 022263 3152 DCA SCEPTR / RESET PTR 1425 022264 7410 SKP / (SKIP ISZ INST) 1426 022265 2152 GETEX1, ISZ SCEPTR / BUMP CHAR PTR 1427 022266 1152 TAD SCEPTR 1428 022267 4320 JMS GETBYT / ++++ 1429 022270 6402 SCEB+BOFSET 1430 022271 7450 SNA / ++++ 1431 022272 5251 JMP GETET1+1 / IGNORE NULLS 1432 022273 5650 GETEX2, JMP I GETET1 / AND RETURN 1433 1434 / START AT BOTTOM OF ETX BUFFER AND WORK BACK 1435 1436 PUTET1, XX / PUT 1 BYTE TO ETX undefined ^ 022274 0000 1437 022275 7421 PUTET2, MQL 1438 022276 1364 TAD (ETXMOD+2 /ADDR. OF ETX BUFFER PAGE-COUNTER /A018 1439 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 undefined ^ undefined ^ 022277 3000 1440 1441 022300 1152 TAD SCEPTR 1442 022301 4334 JMS PUTBYT / ++++ 1443 022302 6402 SCEB+BOFSET 1444 AC7777 / ++++ undefined ^ 022303 0000 1445 022304 1152 TAD SCEPTR / STILL IN RANGE? 1446 022305 7500 SMA / ++++ 1447 022306 5313 JMP PUTEX1 / JUMP IF SO 1448 022307 4763 JMS SCWEB / ELSE OUTPUT FULL BUFFER 1449 1450 022310 7200 CLA / /A018 1451 022311 3764 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 1452 1453 022312 1373 TAD (SCHCNT-1) / AND REINIT PTR 1454 022313 3152 PUTEX1, DCA SCEPTR / UPDATE PTR 1455 022314 1153 TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 1456 022315 7640 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 1457 / RANGE /A032 1458 022316 5275 JMP PUTET2 / PAD REST OF BLK WITH NULLS /A032 1459 022317 5674 JMP I PUTET1 / AND RETURN 1460 1461 GETBYT, XX undefined ^ 022320 0000 1462 022321 7110 CLL RAR 1463 022322 1720 TAD I GETBYT 1464 022323 3334 DCA GETBY1 1465 022324 2320 ISZ GETBYT 1466 022325 0000 CDFBUF 1467 022326 1734 TAD I GETBY1 1468 022327 0000 CDFMYF 1469 022330 7420 SNL / ++++ 1470 022331 7002 BSW 1471 AND P77 undefined ^ undefined ^ 022332 0000 1472 022333 5720 JMP I GETBYT 1473 1474 PUTBYT, XX undefined ^ 022334 0000 1475 022335 7110 CLL RAR 1476 022336 1734 TAD I PUTBYT 1477 022337 3320 DCA PUTBY1 1478 022340 2334 ISZ PUTBYT 1479 022341 0000 CDFBUF 1480 022342 1720 TAD I PUTBY1 1481 022343 7420 SNL / ++++ 1482 022344 7002 BSW 1483 AND P7700 undefined ^ undefined ^ 022345 0000 1484 022346 7501 MQA 1485 022347 7420 SNL / ++++ 1486 022350 7002 BSW 1487 022351 3720 DCA I PUTBY1 1488 022352 0000 CDFMYF 1489 1490 022353 1762 TAD CUR12BIT /CURRENT 12-BIT CHAR. /M026 1491 022354 7450 SNA /SKIP IF 1ST BYTE BEING STORED /A018 1492 022355 5357 JMP RPPUTX /CURRENT 12-BIT CHAR. ALREADY COUNTED /A018 1493 022356 4132 JMS CHKPAG / CHECK FOR PAGE/NEW-PAGE MARKER. /M028 1494 1495 022357 3762 RPPUTX, DCA CUR12BIT /CLEAR FOR 2ND BYTE (IF ONE) /A026 1496 022360 5734 JMP I PUTBYT 1497 1498 GETBY1=PUTBYT 1499 PUTBY1=GETBYT 1500 /--------------- 1501 022362 1015 PAGE 022363 1471 022364 2563 022365 1706 022366 7005 022367 0340 022370 0337 022371 1513 022372 7004 022373 0773 022374 1353 022375 0037 022376 0724 022377 1725 1502 1503 /******************************************************************* /A003 1504 / 1505 / THIS ROUTINE CLOSES THE DOCUMENT AFTER AN EDIT SESSION. /A003 1506 / IT WILL FREE UP ALL UNUSED BLOCKS THAT HAVE BEEN ALLOCATED TO IT/A003 1507 / AND IT WILL "SQUISH" THE DOCUMENT SO THAT ALL ITS BLOCKS ARE /A003 1508 / CONTIGUOUS IN THE "HI ORDER" POSTION OF ITS HEADER BLOCKS /A003 1509 / IT WILL ALSO FREE UP ALL UNUSED HEADER BLOCKS AND UPDATE THE /A003 1510 / HEADER BLOCKS THEMSELVES (THE IN-USE BIT TURNED OFF, THE DATES /A003 1511 / AND TIMES OF THE CLOSE PUT INTO THE HEADERS, ETC) /A003 1512 / /A003 1513 /***********************************************************************/A003 1514 1515 022400 0000 SCCLS, 0 / SCCLS - CLOSE HEADER BLOCK 1516 022401 4777 JMS SCBOTP / DECREMENT BOTTOM-OF-DOCUMENT PTRS /A003 1517 022402 7777 -1 / THIS POINTS TO THE LAST UNUSED BLOCK /A003 1518 022403 1133 TAD SCBOT / NOW WE SAVE THE BOTTOM-OF DOC POINTERS/A003 1519 022404 3311 DCA SCBTSV / SO THAT WE CAN KNOW WHEN TO STOP /A003 1520 022405 1134 TAD SCBTH / FREEING UP BLOCKS /A003 1521 022406 3310 DCA SCBHSV /A003 1522 022407 4777 JMS SCBOTP / REPOSITION BOT-OF-DOC PTRS TO POINT TO/A003 1523 022410 0001 1 / NEXT BLOCK OF DOCUMENT /A003 1524 022411 4273 JMS SCREQ / GO SEE IF THERE ARE ANY BLOCKS TO FREE/A003 1525 022412 7700 SMA CLA / IF YES, GO DO IT /A003 1526 022413 5256 JMP SCCLS7 / IF NONE, NO FREEING, NO SQUISHING /A003 1527 022414 4776 JMS SAVTOP / GO SAVE TOP POINTERS /A003 1528 1529 022415 4775 SCCLS1, JMS SCTOPP / GO INCREMENT TOP-OF-DOC POINTERS /A003 1530 022416 0001 1 / POSITION TO GET BLK TO FREE OR SQUISH /A003 1531 AC7777 / GET A MINUS 1 TO DECREMENT WITH /A003 undefined ^ 022417 0000 1532 022420 1142 TAD SCFILZ / DECREMENT THE FILE SIZE BY ONE /A003 1533 022421 3142 DCA SCFILZ / STORE IT FOR NEXT TIME /A003 1534 022422 4774 JMS SCGETR / GO GET BLOCK NUMBER TO FREE UP /A003 1535 022423 0135 SCTPH /A003 1536 022424 0132 SCTOP /A003 1537 022425 4312 JMS SCQRX / GO FREE THE BLOCK JUST GOTTEN /A003 1538 RXEFR /A003 undefined ^ 022426 0000 1539 022427 0000 0 /A003 1540 022430 4273 JMS SCREQ / GO SEE IF WE'RE DONE FREEING UP BLOCKS/A003 1541 022431 7640 SZA CLA / IF ZERO, WE'RE DONE /A003 1542 022432 5215 JMP SCCLS1 / OF NPOT ZERO, GO FREE UP ANOTHER /A003 1543 022433 4773 JMS GETTOP / GO GET TOP POINTERS PREV SAVED /A003 1544 1545 022434 4775 SCCLS2, JMS SCTOPP / GO INCREMENT TOP PTRS /A003 1546 022435 0001 1 /A003 1547 022436 4774 JMS SCGETR / GO GET A BLOCK TO SQUISH /A003 1548 022437 0134 SCBTH /A003 1549 022440 0133 SCBOT /A003 1550 022441 7450 SNA / CHECK IF DONE /A003 1551 022442 5251 JMP SCCLS6 / 0 BLOCK NUMBER INDICATES EOF /A003 1552 022443 4772 JMS SCPUTR / GO PUT BLK NBR AT TOP-OF-DOC /A003 1553 022444 0135 SCTPH / IN OREDER TO SQUISH THE FILE /A003 1554 022445 0132 SCTOP /A003 1555 022446 4777 JMS SCBOTP / GO INCREMENT BOTTOM-OF-DOCUMENT PTRS /A003 1556 022447 0001 1 /A003 1557 022450 5234 JMP SCCLS2 / GO INCREMENT TOP-OF-DOC PTRS (CONT) /A003 1558 1559 / ALL DONE SQUISHING/FREEING /A003 1560 SCCLS6, AC7777 / END OF RPPGDS DESCRIPTORS /A002 undefined ^ 022451 0000 1561 022452 3771 DCA RPPTR1 / FOR WRITE TO RPPGDS /A002 1562 022453 4772 JMS SCPUTR / GO PUT OUT THE 0-BLOCK NBR INDICATING /A003 1563 022454 0135 SCTPH / END OF FILE /A003 1564 022455 0132 SCTOP /A003 1565 022456 4770 SCCLS7, JMS SCCLSE / GO FREE UP EXCESS HDR BLOCKS /A003 1566 022457 1142 TAD SCFILZ / GET FILE SIZE TO PUT INTO HEADER /A003 1567 022460 4772 JMS SCPUTR / GO PUT THE FILE SIZE INTO HEADER 1 /A003 1568 022461 0120 ONE / INDICATE HEADER ONE /A003 1569 022462 0122 THREE / INDICATE THE 5TH WORD OF HEADER /A003 1570 022463 4774 JMS SCGETR / GO GET THE IN-USE BIT FROM 1ST HEADER /A003 1571 022464 0120 ONE / INDICATE 1ST HEADER /A003 1572 022465 0116 MONE / INDIC 0TH WORD (WHERE IN-USE BIT IS) /A003 1573 022466 0367 AND (1777) / TURN OFF IN-USE BIT /A003 1574 022467 4772 JMS SCPUTR / GO PUT THE IN-USE BIT BACK IN HDR /A003 1575 022470 0120 ONE / INDICATE 1ST HEADER /A003 1576 022471 0116 MONE / INDICATE 0TH WORD (WHERE IN-USE BIT IS)/A003 1577 022472 5600 JMP I SCCLS / DONE 1578 1579 /***********************************************************************/A003 1580 / /A003 1581 / THIS ROUTINE WILL DETERMINE IF THE TOP-OF-DOCUMENT POINTERS /A003 1582 / ARE EQUAL TO BOTTOM-OF-DOCUMENT POINTERS THAT WERE IN EFFECT /A003 1583 / AT THE END OF THE EDIT SESSION. THIS ENABLES THE CLOSE ROUTINES /A003 1584 / TO DETERMINE WHEN TO STOP DEALLOCATING BLOCKS THAT HAVE BEEN /A003 1585 / ALLOCATED TO THE DOCUMENT AND THAT ARE NOT NEEDED. A MINUS 1 /A003 1586 / PASSED IN THE AC INDICATES 'NOT EQUAL' AND A 0 IN THE AC MEANS /A003 1587 / THAT THEY ARE. IF EQUAL, THEN IT MEANS NO MORE BLOCKS SHOULD BE /A003 1588 / DEALLOCATED. /A003 1589 / /A003 1590 /***********************************************************************/A003 1591 1592 SCREQ, XX /A003 undefined ^ 022473 0000 1593 022474 1135 TAD SCTPH / GET TOP HDR WORD PTR /A003 1594 022475 7041 CIA / SET IT UP FOR COMPARE /A003 1595 022476 1310 TAD SCBHSV / GET SAVED BOT HDR PTR /A003 1596 022477 7640 SZA CLA / IF EQUAL, GO CHECK HDR WORD PTRS /A003 1597 022500 5306 JMP SCNEQ / GO INDICATE NOT EQUAL AND RETURN /A003 1598 022501 1132 TAD SCTOP / GET TOP-OF-DOC HDR WORD PTR /A003 1599 022502 7041 CIA / SET IT UP TO COMPARE /A003 1600 022503 1311 TAD SCBTSV / COMP TO SAVED HDR WORD PTR /A003 1601 022504 7650 SNA CLA / IF NOT EQUAL, SO INDIC AND RETURN /A003 1602 022505 5673 JMP I SCREQ / IF EQUAL, AC 0 AND RETURN /A003 1603 1604 SCNEQ, AC7777 / MINUS 1 TO SC=UNEQUAL CONDITION /A003 undefined ^ 022506 0000 1605 022507 5673 JMP I SCREQ / GO BACK /A003 1606 1607 022510 0000 SCBHSV, 0 / AREA TO SAVE BOT HDR PTR /A003 1608 022511 0000 SCBTSV, 0 / AREA TO SAVE BOT HDR WORD PTR /A003 1609 1610 SCHDR=HDRBUF 1611 SCEB=ETXBUF 1612 SCTB=STXBUF 1613 1614 022512 0000 SCQRX, 0 1615 022513 3353 DCA SCQBLK+RXQBLK / SET BLOCK NUMBER 1616 022514 1366 TAD (CDFBUF) / get CDF to buffer field. /A028 1617 DCA SCQBLK+RXQBFD / AND BUFFER FIELD undefined ^ 022515 3342 1618 022516 1712 TAD I SCQRX / ++++ 1619 DCA SCQBLK+RXQFNC / AND FUNCTION undefined ^ 022517 3342 1620 022520 2312 ISZ SCQRX 1621 022521 1712 TAD I SCQRX / ++++ 1622 DCA SCQBLK+RXQBAD / AND BUF PTR undefined ^ 022522 3342 1623 022523 2312 ISZ SCQRX 1624 CIFSYS / ++++ undefined ^ 022524 0000 1625 ENQUE / ++++ undefined ^ 022525 0000 1626 022526 2537 SCQUBL / QUEUE Q-BLOCK 1627 1628 SCQRX1, CIFSYS / ++++ undefined ^ 022527 0000 1629 JWAIT / WAIT FOR EVENT undefined ^ 022530 0000 1630 TAD SCQBLK+RXQCOD / ARE WE DONE? undefined ^ 022531 1342 1631 022532 7450 SNA 1632 022533 5327 JMP SCQRX1 / NO 1633 1634 022534 7500 SMA / ++++ 1635 022535 7200 CLA / RETURN - IF ERROR; 0 OTHERWISE 1636 022536 5712 JMP I SCQRX / YES 1637 1638 SCQUBL, DSKQUE / ++++ undefined ^ 022537 0000 1639 022540 0000 0 / ++++ 1640 022541 0000 0 1641 022542 0000 SCQBLK, 0 / ++++ 1642 022543 0000 0 / ++++ 1643 022544 0000 0 / ++++ 1644 022545 0000 0 / ++++ 1645 022546 0000 0 / ++++ 1646 022547 0000 0 / ++++ 1647 022550 0000 0 / ++++ 1648 022551 0000 0 / ++++ 1649 022552 0000 0 / ++++ 1650 022553 0000 0 / ++++ 1651 022554 0000 0 / ++++ 1652 022555 0000 0 / ++++ 1653 022556 0000 0 / ++++ 1654 022557 0000 0 / ++++ 1655 022560 0000 0 1656 1657 022561 0000 ETXMOD, 0 / ETX MODES 1658 022562 0000 0 /SHIFT FLAG 1659 022563 0000 0 /ETX BUFFER PAGE-COUNTER /A018 1660 022564 0000 ETXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 1661 /THROUGH ETX BUFFER /A030 1662 /--------------- 1663 022566 0000 PAGE 022567 1777 022570 3473 022571 0724 022572 2013 022573 3141 022574 2000 022575 3331 022576 3133 022577 3311 1664 1665 / RDFIL HEADER CONTROL AREA 1666 1667 022600 7400 RDBFCB, PSTBUF / PASTE BUFFER 1668 022601 0000 RDHDBN, 0 / PTR TO BLK # IN PASTE BUFFER 1669 / THIS POINTER POINTS TO ONE OF THE FOLLOWING SEVENTEEN BLOCK NUMBERS 1670 / DEPENDING ON WHICH BLOCK NUMBER IS IN THE PASTE BUFFER 1671 022602 0000 RDHDRB, 0 / FIRST HEADER BLOCK NUMBER 1672 022603 0000 0 / SECOND HEADER BLOCK NUMBER 1673 022604 0000 0 / THIRD HEADER BLOCK NUMBER 1674 022605 0000 0 / FOURTH HEADER BLOCK NUMBER 1675 022606 0000 0 / FIFTH HEADER BLOCK NUMBER 1676 022607 0000 0 / SIXTH HEADER BLOCK NUMBER 1677 022610 0000 0 / SEVENTH HEADER BLOCK NUMBER 1678 022611 0000 0 / EIGHTH HEADER BLOCK NUMBER 1679 022612 0000 0 / NINTH HEADER BLOCK NUMBER 1680 022613 0000 0 / TENTH HEADER BLOCK NUMBER 1681 022614 0000 0 / ELEVENTH HEADER BLOCK NUMBER 1682 022615 0000 0 / TWELFTH HEADER BLOCK NUMBER 1683 022616 0000 0 / THIRTEENTH HEADER BLOCK NUMBER 1684 022617 0000 0 / FOURTEENTH HEADER BLOCK NUMBER 1685 022620 0000 0 / FIFTEENTH HEADER BLOCK NUMBER 1686 022621 0000 0 / SIXTEENTH HEADER BLOCK NUMBER 1687 022622 0000 0 / SEVENTEENTH HEADER BBLOCK NUMBER 1688 022623 0000 0 / HEADER BLOCK #'S, THEN 0 1689 022624 0000 0 / MOD FLAG (ALWAYS 0) 1690 1691 RDGETR, XX undefined ^ 022625 0000 1692 022626 1201 TAD RDHDBN / CHECK TO SEE IF FIRST HEADER IN CORE /A003 1693 022627 7650 SNA CLA / IF ZERO, ITS NOT IN CORE /A003 1694 022630 5250 JMP RDGTHD / GO GET 1ST HEADER INTO CORE /A003 1695 022631 4360 JMS TOGETR / GET ADDR OF PTR TO HDR IN CORE /A030 1696 022632 7041 CIA / SWITCH IT FOR COMPARE /A003 1697 022633 1201 TAD RDHDBN / IS IT THE SAME (IS HDR IN CORE?) /A003 1698 022634 7640 SZA CLA / IF YES, GO GET WORD PTR /A003 1699 022635 5266 JMP RDCKHD / OTHERWISE GO GET HEADER INTO CORE /A003 1700 1701 022636 2225 RDRET, ISZ RDGETR / BUMP UP TO POINT TO HDR WORD PTR /A003 1702 022637 1625 TAD I RDGETR / GET ADDR OF HEADER WORD PTR /A003 1703 022640 3000 DCA RDGET1 / STORE IT FOR INDIRECT USE /A003 1704 022641 1400 TAD I RDGET1 / GET THE HEADER WORD POINTER /A003 1705 022642 1377 TAD (PSTBUF+2) / GET ADDRESS OF BUFFER + 2 /A003 1706 022643 3000 DCA RDGET1 1707 022644 0000 CDFBUF 1708 022645 1400 TAD I RDGET1 1709 022646 0000 CDFMYF 1710 022647 5264 JMP RDEXI2 / NEW EXIT POINT /A030 1711 1712 RDGET1=T1 undefined ^ 1713 1714 / GET NEXT HEADER INTO CORE /A003 1715 022650 4360 RDGTHD, JMS TOGETR / GET HDR POINTER, ADD IN BASE ADDR /A030 1716 022651 3201 DCA RDHDBN / PUT ADDR OF HDR IN CORE /A003 1717 1718 022652 1601 RDGTXR, TAD I RDHDBN / DO IO 1719 022653 7450 SNA / ++++ 1720 022654 5262 JMP RDGTXZ 1721 022655 4776 JMS RDFIO 1722 RXERD+4000 undefined ^ 022656 4000 1723 022657 7700 SMA CLA / ++++ 1724 022660 5236 JMP RDRET / GOT HEADER, GO BACK /A003 1725 022661 3601 DCA I RDHDBN / ELSE CLEAR BLOCK # 1726 022662 3201 RDGTXZ, DCA RDHDBN / AND LOADED FLAG 1727 1728 022663 2225 RDEXIT, ISZ RDGETR / BUMP UP TO RETURN /A003 1729 022664 2225 RDEXI2, ISZ RDGETR / EXIT FROM ABOVE ALSO /A030 1730 022665 5625 JMP I RDGETR / AND RETURN 0 1731 1732 022666 4360 RDCKHD, JMS TOGETR / GET HDR PTR PLUS ADD OF HDR CTL AREA /A030 1733 022667 3000 DCA RDGET1 / STORE ADDR OF HDR BLOCK NBR /A003 1734 022670 1400 TAD I RDGET1 / GET HDR BLOCK NBR /A003 1735 022671 7650 SNA CLA / IS THERE ONE THERE?? /A003 1736 022672 5263 JMP RDEXIT / NO, GO GET OUT /A003 1737 022673 5250 JMP RDGTHD / GO GET HEADER INTO CORE /A003 1738 1739 GTHDRS, XX / ROUTINE TO GET HEADER BLOCK EXTENSIONS undefined ^ 022674 0000 1740 022675 1674 TAD I GTHDRS / GET ADDRESS OF HDR CTL AREA /A003 1741 022676 3356 DCA PTR1 / STORE IT TO INDIRECT THRU /A003 1742 022677 1756 TAD I PTR1 / GET BUFFER ADDRESS /A003 1743 022700 1122 TAD THREE / POINT TO THIRD HDR BLK AREA /A003 1744 022701 3356 DCA PTR1 / STORE ADDR 3RD HDR BLK /A003 1745 022702 0000 CDFBUF /A003 1746 022703 1756 TAD I PTR1 / GET 3RD HDR BLOCK NBR /A003 1747 022704 0000 CDFMYF /A003 1748 022705 7650 SNA CLA / IF NO THIRD HDR, GO BACK /A003 1749 022706 5354 JMP GTGOBK / RETURN /A003 1750 022707 1674 TAD I GTHDRS / GET ADR OF HDR CONTROL AREA 1751 022710 1123 TAD FOUR / BUMP TO THIRD HDR BLK NBR /M014 1752 DCA X0 / PUT ADR FOR AUTOINDEXING undefined ^ undefined ^ 022711 3000 1753 1754 022712 1375 TAD (RPBFCB /TOP OF RPPGDS BLOCK-LIST /A014 1755 022713 1123 TAD FOUR /PTR ABOVE 4TH ENTRY /A104 1756 DCA X1 /SAVE FOR STORE LATER /A104 undefined ^ undefined ^ 022714 3000 1757 1758 022715 1127 TAD T360 / GET WORD WHERE EXTENSIONS ARE 1759 022716 3356 DCA PTR1 / PUT IT IN CALLING SEQUENCE 1760 022717 1112 TAD M16 / GET LOOP CONTROL (NBR OF POSS HDRS) /A003 1761 022720 3357 DCA PTR2 / PUT IT SOMEWHERE FOR ISZ /A003 1762 1763 022721 1674 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /M045 1764 022722 7041 CIA / COPLEMENT FOR COMAPRE /A003 1765 022723 1374 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A003 1766 022724 7650 SNA CLA / IF NOT READ ONLY, DO SCROLL READ /A003 1767 /D045 JMP RDGTHR / GO READ READ ONLY HEADERS /A003 1768 /D045 JMS SCGETR / GO GET HEADER BLOCK NBR 1769 022725 1373 TAD (RDGETR-SCGETR) / GET OFFSET OF READ-ONLY FROM THE SCRL /A045 1770 / READ ROUTINE /A045 1771 022726 1372 TAD (SCGETR) / ADD ADDRESS OF SCRL READ ROUTINE /A045 1772 022727 3000 DCA XGETR / & STORE THE ADDRESS OF THE APPROPRIATE/A045 1773 / SUBROUTINE FOR LATER USE 1774 1775 022730 4400 GETHDR, JMS I XGETR / GO GET HEADER BLOCK NBR /A045 1776 022731 0122 THREE / THIRD HEADER WHERE BLK NBRS ARE 1777 022732 2756 PTR1 / POINTER TO WHERE BLK NBRS ARE 1778 1779 022733 7450 GTHDCK, SNA / IF NON-ZERO, THE BLOCK NBR IS PRESENT /A003 1780 022734 5350 JMP GTRESH / IF ZERO BLK NBR, THEN ALL DONE /M045 1781 / GO GET THE FIRST HDR BACK INTO CORE/A045 1782 DCA I X0 / PUT BLK NBR INTO HDR CTL /A003 undefined ^ undefined ^ 022735 3400 1783 1784 022736 1674 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /A040 1785 022737 7041 CIA / COPLEMENT FOR COMAPRE /A040 1786 022740 1374 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A040 1787 022741 7650 SNA CLA / SKIP IF: SCROLL READ /A040 1788 022742 5345 JMP GTHDC1 / READ ONLY FILE, IGNORE GTP /A040 1789 / 1790 022743 1771 TAD RPPTR1 /RPPGDS WORD READ /A014 1791 DCA I X1 /PUT IN RPPGDS BLOCK-LIST ALSO /A014 undefined ^ undefined ^ 022744 3400 1792 1793 022745 2356 GTHDC1, ISZ PTR1 / POINT TO NEXT HDR BLK NBR /A003 1794 022746 2357 ISZ PTR2 / ARE WE ALL DONE? /A003 1795 022747 5330 JMP GETHDR / NO- GO GET IT IF ITS THERE 1796 1797 GTRESH, / READ THE FIRST HEADER BLOCK BACK INTO /A045 1798 / CORE BEFORE EXITING /A045 1799 022750 4400 JMS I XGETR / /A045 1800 022751 0120 ONE / WE WANT THE 1ST HDR BLOCK /A045 1801 022752 0120 ONE / ANY WORD WILL DO, ONE IS AS GOOD AS ANY/A045 1802 022753 7200 CLA / JUST CLEAR THE RETURN /A045 1803 1804 022754 2274 GTGOBK, ISZ GTHDRS / BUMP TO RETURN ADDR /A003 1805 022755 5674 JMP I GTHDRS / RETURN /A003 1806 1807 / FOLLOWING CODE NO LONGER REQUIRED /A045 1808 /D045 / GET HEADERS FOR READ ONLY FILES /A003 1809 /D045RDGTHR, JMS RDGETR / GO GET THE HEADERS /A003 1810 /D045 THREE / POINT TO THIRD HEADER /A003 1811 /D045 PTR1 / HEADER WORD POINTER /A003 1812 /D045 JMP GTHDCK / GO SEE IF MORE TO DO /A003 1813 1814 022756 0000 PTR1, 0 / PONTER TO WHERE THE HDR BLK NBRS ARE /A003 1815 022757 0000 PTR2, 0 / COUNTER FOR LOOP CONTROL /A003 1816 XGETR=T2 / AREA TO SAVE ADDRESS OF THE APPROP. /A045 undefined ^ 1817 / GET ROUTINE /A045 1818 1819 TOGETR, XX /A030 undefined ^ 022760 0000 1820 022761 1625 TAD I RDGETR / GET ADDR OF THE HDR PTR /A030 1821 022762 3000 DCA RDGET1 / STORE IT FOR INDIRECT USE /A030 1822 022763 1400 TAD I RDGET1 / GET THE HDR POINTER /A030 1823 022764 1370 TAD (RDHDBN) / GET ADDR OF PTR TO HDR IN CORE /A030 1824 022765 5760 JMP I TOGETR / RETURN TO CALLER /A030 1825 1826 /D045SCSPC, 0 / PUT # FREE BLOCKS IN HDR 1827 /D045 TAD SCQBLK+RXQSPC / FROM Q BLOCK 1828 /D045 DCA SCFSPC 1829 /D045 JMP I SCSPC 1830 /--------------- 1831 022770 2601 PAGE 022771 0724 022772 2000 022773 0625 022774 2600 022775 0466 022776 0270 022777 7402 1832 1833 SCOFST, XX / ROUTINE TO SEE IF HEADER IS IN CORE /A003 undefined ^ 023000 0000 1834 023001 1777 TAD SCGTR2 / GET HEADER POINTER /A003 1835 023002 3250 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 1836 023003 1600 TAD I SCOFST / GET HEADER CONTROL BLOCK ADDR /A003 1837 023004 3245 DCA SCOFS1 / SAVE IT /A003 1838 023005 1645 TAD I SCOFS1 / GET BUFFER ADDR /A003 1839 023006 3245 DCA SCOFS1 / SAVE BUFFER ADDR /A003 1840 AC0001 / 1 FOR ADDING /A003 undefined ^ 023007 0000 1841 023010 1600 TAD I SCOFST / POINT TO IN-CORE HEADER BLOCK NUMBER /A003 1842 023011 3246 DCA SCOFS2 / STORE FOR FUTURE USE /A003 1843 023012 1376 TAD (24) / GET DISPL TO MOD FLAG IN HDR CTL BLOCK /A003 1844 023013 1600 TAD I SCOFST / ADD IN ADDR OF HDR CTL BLOCK /A003 1845 023014 3247 DCA SCOFS3 / SAVE FOR FUTURE USE /A003 1846 023015 2200 ISZ SCOFST / BUMP TO RETURN ADDRESS /A003 1847 023016 1646 TAD I SCOFS2 / GET ADDRESS OF IN-CORE HDR BLOCK NBR /A003 1848 023017 7041 CIA / CHANGE FOR COMPARE /A003 1849 023020 1246 TAD SCOFS2 / ADD IN IN-CORE ADDRESS /A003 1850 023021 1650 TAD I SCOFS4 / ADD IN HDR PTR /A003 1851 023022 7640 SZA CLA / IS HEADER IN CORE /A003 1852 023023 5225 JMP SCCHGE / IF NOT, GO READ IN NEW ONE /A003 1853 023024 5237 JMP SCEND / GO ADD IN WORD POINTER AND RETURN /A003 1854 1855 SCCHGE, AC7777 / MINUS 1 TO AC FOR CHECKING MOD FLAG /A003 undefined ^ 023025 0000 1856 023026 1647 TAD I SCOFS3 / ADD IN VALUE OF MOD FLAG (1 MEANS MODIFIED) /A003 1857 023027 7640 SZA CLA / HAS IT BEEN MODIFIED? /A003 1858 023030 5233 JMP SCRDIN / NO, DON'T HAVE TO WRITE IT OUT/GO READ IN /A003 1859 AC0001 / SIGNAL A WRITE OPERATION /A003 undefined ^ 023031 0000 1860 023032 4276 JMS SCGTWR / GO WRITE OUT THE HEADER /A003 1861 1862 023033 1246 SCRDIN, TAD SCOFS2 / GET ADDR OF IN-CORE HDR BLOCK NBR PTR /A003 1863 023034 1650 TAD I SCOFS4 / ADD IN HDR PTR (AC POINTS TO NEW HDR) /A003 1864 023035 3646 DCA I SCOFS2 / PUT THIS ADDR INTO HDR CTL BLOCK /A003 1865 023036 4276 JMS SCGTWR / GO READ IN NEW HEADER INTO BUFFER /A003 1866 1867 023037 1775 SCEND, TAD SCGTR1 / GET ADDR OF THE HDR WORD PTR /A003 1868 023040 3250 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 1869 023041 1650 TAD I SCOFS4 / GET HDR WORD POINTER /A003 1870 023042 1374 TAD (SCHDR+2) / GET BUFFER ADDR +2 PAST COS STUFF /A003 1871 023043 3775 DCA SCGTR1 / PUT ADDR INTO INDIRECT FIELD /A003 1872 023044 5600 JMP I SCOFST / RETURN /A003 1873 1874 023045 0000 SCOFS1, 0 / AREA TO HOLD THE BUFFER ADDRESS /A003 1875 023046 0000 SCOFS2, 0 / AREA TO HOLD THE HDR BLOCK NBR ADDRESS /A003 1876 023047 0000 SCOFS3, 0 / ARE TO HOLD THE MOD FLAG ADDRESS /A003 1877 023050 0000 SCOFS4, 0 / AREA TO HOLD HDR POINTER /A003 1878 1879 / SCROLL HEADER BUFFER CONTROL AREA 1880 023051 6000 SCBFCB, SCHDR / SCROLL HEADER BUFFER ADDRESS 1881 023052 0000 SCHDBN, 0 / POINTS TO HDR BLK NBR THAT'S IN CORE 1882 / THE ABOVE POINTER IS AN ADDR TO ONE OF THE BLK NBRS BELOW 1883 023053 0000 SCHDRB, 0 / FIRST HEADER BLOCK NUMBER 1884 023054 0000 0 / SECOND HEADER BLOCK NUMBER 1885 023055 0000 0 / THIRD HEADER BLOCK NUMBER 1886 023056 0000 0 / FOURTH HEADER BLOCK NUMBER 1887 023057 0000 0 / FIFTH HEADER BLOCK NUMBER 1888 023060 0000 0 / SIXTH HEADER BLOCK NUMBER 1889 023061 0000 0 / SEVENTH HEADER BLOCK NUMBER 1890 023062 0000 0 / EIGHT HEADER BLOCK NUMBER 1891 023063 0000 0 / NINTH HEADER BLOCK NUMBER 1892 023064 0000 0 / TENTH HEADER BLOCK NUMBER 1893 023065 0000 0 / ELEVENTH HEADER BLOCK NUMBER 1894 023066 0000 0 / TWELFTH HEADER BLOCK NUMBER 1895 023067 0000 0 / THIRTEENTH HEADER BLOCK NUMBER 1896 023070 0000 0 / FOURTEENTH HEADER BLOCK NUMBER 1897 023071 0000 0 / FIFTEENTH HEADER BLOCK NUMBER 1898 023072 0000 0 / SIXTEENTH HEADER BLOCK NUMBER 1899 023073 0000 0 / SEVENTEENTH HEADER BLOCK NUMBER 1900 023074 0000 0 / BLK #S, THEN 0 1901 023075 0000 SCHDMD, 0 / MOD FLAG INDICATES HDR IN CORE'S BEEN MODIFIED 1902 1903 SCGTWR, XX / IO ROUTINE FOR SCHDR undefined ^ 023076 0000 1904 023077 7650 SNA CLA / ++++ 1905 023100 5310 JMP SCGTRD / JUMP IF READ 1906 023101 1652 TAD I SCHDBN / GET BLOCK # 1907 023102 4773 JMS SCQRX 1908 023103 2004 RXEWT+2000 / ++++ 1909 023104 6000 SCHDR / DO WRITE 1910 023105 4772 JMS RPWRT / WRITE GTP HDR BLK /A032 1911 023106 3275 DCA SCHDMD / CLEAR MOD FLAG 1912 023107 5676 JMP I SCGTWR / RETURN 1913 023110 1652 SCGTRD, TAD I SCHDBN / GET BLOCK # 1914 023111 7450 SNA / ++++ 1915 023112 5320 JMP SCGTAL / ALLOCATE HEADER IF ZERO 1916 023113 4773 JMS SCQRX 1917 RXERD / ++++ undefined ^ 023114 0000 1918 023115 6000 SCHDR / READ BLOCK 1919 023116 4771 SCGTEX, JMS RPREA1 / READ GTP BLOCK /M034 /A032 1920 023117 5676 JMP I SCGTWR / RETURN 1921 1922 023120 4773 SCGTAL, JMS SCQRX /ALLOC. A BLOCK FOR HDR/EXTN /M014 1923 RXEAL / ++++ undefined ^ 023121 0000 1924 023122 0000 0 / ALLOCATE BLOCK 1925 023123 1770 TAD SCQBLK+RXQBLK 1926 023124 3652 DCA I SCHDBN / STORE BLOCK # 1927 023125 4767 JMS SCBUFI / ++++ 1928 023126 6000 SCHDR / INIT FIRST WORDS 1929 1930 / NOTE: THE ROUTINE 'SCBUFI', WHICH INITIATES BUFFER AREAS FOR /A015 1931 / COS 310 COMPATIBILITY, ALSO SETS UP THE INDEX REGISTER 'X0" /A015 1932 / TO POINT TO THE AREA BEING INITIALIZED. THIS INDEX REGISTER /A015 1933 / IS ALSO USED BY THE SUBSEQUENT ROUTINE 'CLRBUF' TO CLEAR OUT /A015 1934 / THE HEADER BUFFERS. THE ROUTINE 'CLRBUF' DEPENDS ON INDEX /A015 1935 / REGISTER 'X0' BEING THUS INITIALIZED. /A015 1936 1937 023127 1106 TAD M376 / GET NEG OF COUNT OF CHARACTERS IN BUFFER /A015 1938 DCA T1 / PUT IT WHERE 'CLRBUF' CAN GET AT IT /A015 undefined ^ undefined ^ 023130 3000 1939 023131 4352 JMS CLRBUF / GO CLEAR OUT REMAINDER OF HEADER BUFFER AREA /A015 1940 023132 5316 JMP SCGTEX / DO SAME FOR GTP /A034 1941 1942 SAVTOP, XX / ROUTINE TO SAVE TOP POINTERS /A003 undefined ^ 023133 0000 1943 023134 1135 TAD SCTPH / GET TOP HEADER POINTER /A003 1944 023135 3347 DCA SAVTPH / SAVE IT /A003 1945 023136 1132 TAD SCTOP / GET TOP HEADER WORD POINTER /A003 1946 023137 3350 DCA SVTOP / SAVE IT /A003 1947 023140 5733 JMP I SAVTOP / GO BACK /A003 1948 1949 GETTOP, XX / ROUTINE TO GET BACK TOP POINTERS /A003 undefined ^ 023141 0000 1950 023142 1347 TAD SAVTPH / GET SAVED TOP POINTERS /A003 1951 023143 3135 DCA SCTPH / RESTORE IT /A003 1952 023144 1350 TAD SVTOP / GET SAVE HDR WORD PTTR /A003 1953 023145 3132 DCA SCTOP / RESTORE IT /A003 1954 023146 5741 JMP I GETTOP / GO BACK /A003 1955 1956 023147 0000 SAVTPH, 0 /A003 1957 023150 0000 SVTOP, 0 /A003 1958 023151 0000 RPEXTR, 0 /-1 => MUST ALLOC. A BLOCK FOR /A014 1959 / RPPGDS EXTN., AFTER WRITTING OUT THE CURRENT ONE /A014 1960 1961 /************************************************************************* 1962 / 1963 / THIS ROUTINE CLEARS OUT THE BUFFER AREA WHEN WE ARE SETTING A015 1964 / IT UP FOR USE AS A NEW BUFFER AREA. A015 1965 / A015 1966 /************************************************************************** 1967 1968 CLRBUF, /A015 1969 XX /A015 undefined ^ 023152 0000 1970 023153 0000 CDFBUF /A015 1971 1972 CLRBF1, DCA I X0 / X0= ADDRES OF BUFFER AREA, SET UP BY SCBUFI /A015 undefined ^ undefined ^ 023154 3400 1973 / AC= COS COMPATIBLE CHARACTER SET UUP BY SCBUFI/A015 1974 ISZ T1 / T1= COUNT OF CHARCTERS (START -377 OCTAL) /A015 undefined ^ undefined ^ 023155 2000 1975 023156 5354 JMP CLRBF1 / GO CLEAR NEXT WORD OUT TIL END /A015 1976 023157 0000 CDFMYF /A015 1977 023160 5752 JMP I CLRBUF / RETURN, ALL DONE /A015 1978 /--------------- 1979 023167 1533 PAGE 023170 2553 023171 0200 023172 0404 023173 2512 023174 6002 023175 2044 023176 0024 023177 2045 1980 1981 /************************************************************************* 1982 / 1983 / SCAD16 WILL ADD OCTAL 16 TO THE DISPLACEMENT IF THE POINTERS 1984 / PASSED TO IT POINT TO THE HEADER EXTENSION BLOCK POINTERS 1985 / THAT EXIST ON THE THIRD HEADER. THIS ENABLES THE USER TO 1986 / PREVENT THEM FROM BEING USED AS DOCUMENT BLOCK POINTERS. 1987 / 1988 /*************************************************************************** 1989 SCAD16, XX / CHECK TO SEE IF 3RD HEADER undefined ^ 023200 0000 1990 023201 7200 CLA / CLEAR THE AC 1991 023202 1600 TAD I SCAD16 / GET ADDR OF HEADER POINTER 1992 023203 3247 DCA SCAD4 / STORE IT FOR INDIRECT USE 1993 023204 2200 ISZ SCAD16 / BUMP UP TO GET HEADER WORD PTR /A003 1994 023205 1600 TAD I SCAD16 / GET HDR WORD PTR ADDR /A003 1995 023206 3250 DCA SCAD7 / STORE IT FOR INDIRECT USE /A003 1996 023207 2200 ISZ SCAD16 / BUMP UP TO DISPLACEMENT /A003 1997 023210 1647 TAD I SCAD4 / GET HEADER POINTER 1998 023211 1115 TAD M3 / CHECK TO SEE IF IT'S THE 3RD 1999 023212 7500 SMA / IF NOT, GO SEE IF ITS THE 4TH 2000 023213 5215 JMP SCAD5 / GO SEE IF IT'S THE 4TH 2001 023214 5244 JMP SCAD1 / IF LESS, GET OUT IT'S O.K. 2002 023215 7640 SCAD5, SZA CLA / IF ITS THE 3RD, GO SEE IF ADD NEEDED 2003 023216 5231 JMP SCAD6 / GO SEE IF IT'S THE FOURTH 2004 023217 1650 TAD I SCAD7 / GET THE HDR WORD PTR 2005 023220 1600 TAD I SCAD16 / ADD DISPLACEMENT TO HDR WORD PTR 2006 023221 1107 TAD M360 / DOES IT POINT TO A HDR BLK NBR? 2007 023222 7700 SMA CLA / IF MINUS, THEN IT'S O.K. GET OUT 2008 023223 5225 JMP SCAD8 / GO SEE IF IT'S ZERO OR PLUS 2009 023224 5244 JMP SCAD1 / GO GET OUT 2010 SCAD8, / IF GREATER THAN 0 GO ADD OCTAL 16 2011 023225 1600 TAD I SCAD16 / GET DISPLACEMENT 2012 023226 1124 TAD T16 / ADD OCTAL 16 (DECIMAL 14) 2013 023227 3600 DCA I SCAD16 / PUT DISPLACEMENT 2014 023230 5244 JMP SCAD1 / GO GET OUT 2015 023231 1647 SCAD6, TAD I SCAD4 / GET HEADER POINTER 2016 023232 1114 TAD M4 / CHECK IF IT'S THE 4TH 2017 023233 7640 SZA CLA / PROCESS IT IF IT IS 2018 023234 5244 JMP SCAD1 / GO GET OUT 2019 023235 1650 TAD I SCAD7 / GET HDR WORD PTR 2020 023236 1600 TAD I SCAD16 / GET THE DISPLACEMENT 2021 023237 7700 SMA CLA / DID IT GO NEGATIVE? /C017 2022 023240 5244 JMP SCAD1 / GET OUT 2023 023241 1600 TAD I SCAD16 / GET DISPLACEMENT 2024 023242 1112 TAD M16 / TAKE AWAY OCTAL 16 (TO GO OVER HDR BLK NBRS) 2025 023243 3600 DCA I SCAD16 / PUT IT INTO CALL LIST 2026 023244 2200 SCAD1, ISZ SCAD16 / BUMP UP TO RETURN ADDR 2027 023245 7200 CLA / CLEAR AC BEFORE RETURNING /A003 2028 023246 5600 JMP I SCAD16 / GO BACK 2029 023247 0000 SCAD4, 0 / FOR IDIRECTING TO HEADER POINTER /A003 2030 023250 0000 SCAD7, 0 / FOR INDIRECTING TO HDR WORD POINTER /A003 2031 2032 /***************************************************************************** 2033 / 2034 / SCINC WILL INCREASE THE DOCUMENT BLOCK NUMBER POINTER BY AN AMOUNT 2035 / PASSED TO IT. THIS AMOUNT CAN BE ANY INTEGRAL VALUE EITHER NEGATIVE 2036 / OR POSITIVE. THE CALLING SEQUENCE IS: 2037 / JMS SCINC 2038 / PTR1 / HEADER POINTER 2039 / PTR2 / HEADER WORD POINTER 2040 / DISP / DISPLACEMENT (-1, 1, 2 ETC) 2041 / RETURN POINT 2042 / PTR1 IS THE HEADER POINTER. IT POINTS TO A HEADER (FROM 1 TO 17 DEC) 2043 / WHICH THE POINTER CURRENTLY POINTS TO. 2044 / PTR2 IS THE HEADER WORD POINTER WHICH POINTS TO THE PARTICULAR WORD 2045 / WITHIN THE HEADER BLOCK POINTED TO BY PTR1, AT WHICH THIS POINTER 2046 / PAIR CURRENTLY POINTS TO. 2047 / DISP IS AN INTEGER BY WHICH THE USER WISHES TO INCREMENT OR DECREMENT 2048 / THE POINTER PAIRS. 2049 /****************************************************************************** 2050 2051 SCINC, XX / INCREMENT/DECREMENT POINTER undefined ^ 023251 0000 2052 023252 7200 CLA / CLEAR AC 2053 023253 1651 TAD I SCINC / GET ADDR OF HEADER POINTER 2054 023254 3307 DCA SCINC1 / STORE IT FOR INDIRECT USE 2055 023255 2251 ISZ SCINC / BUMP UP TO POINT TO HDRR WORD PTR 2056 023256 1651 TAD I SCINC / GET ADR OF HDR WORD PTR 2057 023257 3310 DCA SCINC2 / STORE IT FOR INDIRECT USE 2058 023260 2251 ISZ SCINC / BUMP UP TO DISPLACEMENT 2059 023261 1710 TAD I SCINC2 / GET HDDR WORD PTR 2060 023262 1651 TAD I SCINC / ADD IN DISPLACEMENT 2061 023263 2251 ISZ SCINC / BUMP UP TO RETURN ADDR 2062 023264 7500 SMA / IF MINUS THEN IT CROSSED HEADERS 2063 023265 5274 JMP SCINCX / GO CHECK FURTHER IF + 2064 023266 1130 TAD T376 / ADD IN LENGTH OF HEADER 2065 023267 3710 DCA I SCINC2 / UPDATE HDR WORD POINTER 2066 AC7777 / -1 TO AC TO DECREMENT HDR NBR undefined ^ 023270 0000 2067 023271 1707 TAD I SCINC1 / DECREMENT HDR POINTER 2068 023272 3707 DCA I SCINC1 / RETURN IT 2069 023273 5651 JMP I SCINC / GO BACK 2070 023274 7450 SCINCX, SNA / IF PLUS, THEN IT MAY HAVE CROSSED HEADERS /A017 2071 023275 5305 JMP SCINCY / GO UPDATE HDR WORD POINTER ONLY IF 0 2072 023276 1106 TAD M376 / SUBTRACT OUT LENGTH OF HEADER 2073 023277 7510 SPA / HAS IT CROSSED THE HEADER? 2074 023300 5304 JMP SCINCZ / NO, GO ADD BACK 376 AND GET OUT 2075 023301 3710 DCA I SCINC2 / YES, THEN UPDATE THE HDR WORD PTR 2076 023302 2707 ISZ I SCINC1 / BUMP UP HDR PTR 2077 023303 5651 JMP I SCINC / RETURN 2078 023304 1130 SCINCZ, TAD T376 / ADD BACK 376 WHEN -/0 2079 023305 3710 SCINCY, DCA I SCINC2 / UPDATE HDR WORD PTR 2080 023306 5651 JMP I SCINC / RETURN 2081 023307 0000 SCINC1, 0 / WORD TO INDIRECT TO HDR POINTER 2082 023310 0000 SCINC2, 0 / WORD TO INDIRECT TO HDR WORD PTR 2083 2084 /*********************************************************************/A003 2085 / 2086 / THIS ROUTINE WILL INCREMENT OR DECREMENT THE POINTER PAIRS /A003 2087 / FOR THE BOTTOM PAIR OF DOCUMENT POINTERS. THESE POINTER PAIRS /A003 2088 / POINT TO DOCUMENT BLOCK NUMBERS THAT RESIDE IN THE HEADER /A003 2089 / BLOCK(S) OF THE DOCUMENT. THE FIRST POINTER OF THE POINTER /A003 2090 / PAIR POINTS TO THE HEADER BLOCK THAT CONTAINS THE BLOCK NUMBER /A003 2091 / POINTED TO BY THE POINTER PAIR. THE SECOND POINTER OF THE /A003 2092 / POINTER PAIR POINTS TO THE WORD WITHIN THE HEADER BLOCK THAT /A003 2093 / THE POINTER PAIR IS POINTING TO. THERE ARE CURRENTLY 17 POSSIBLE/A003 2094 / HEADER BLOCKS THAT CAN BELONG TO A DOCUMENT. THE FIRST THREE /A003 2095 / HEADERS CAN POTENTIALLY HOLD UP TO 701 DOCUMENT BLOCK NUMBERS. /A003 2096 / THE FIRST HEADER BLOCK CAN HOLD UP TO 211 DOCUMENT BLOCK /A003 2097 / NUMBERS. THE SECOND HEADER BLOCK CAN CONTAIN UP TO 254 DOCUMENT /A003 2098 / NUMBERS. THE THIRD HEADER BLOCK CAN CONTAIN UP TO 240 DOCUMENT /A003 2099 / BLOCK NUMBERS. ALL FURTHER HEADER BLOCKS CAN CONTAIN 254 /A003 2100 / DOCUMENT BLOCK NUMBERS. DOCUMENT BLOCK NUMBERS BEGIN AT WORD /A003 2101 / 44 OF THE FIRST HEADER BLOCK, CONTINUE ON THE SECOND HEADER /A003 2102 / BLOCK BEGINNING AT WORD THREE AND PROCEEDING TO THE END OF THE /A003 2103 / BLOCK, THEN CONTINUE ONTO THE THIRD HEADER BLOCK BEGINNING ON /A003 2104 / ITS THIRD WORD AND PROCEEDING TO THE 240TH WORD OF THE BLOCK /A003 2105 / THEN PROCEED TO THE 3RD WORD OF THE FOURTH HEADER BLOCK. /A003 2106 / THE FIRST 43 WORDS OF THE FIRST HEADER BLOCK CONTAIN OTHER /A003 2107 / INFORMATION ABOUT THE DOCUMENT INCLUDING BLOCK POINTERS TO THE /A003 2108 / SECOND AND THIRD HEADER BLOCKS. THE THIRD HEADER BLOCK HAS /A003 2109 / BLOCK POINTERS TO THE 4TH THRU 17TH BLOCKS OF THE DOCUMENT IN /A003 2110 / ITS 241ST THRU ITS 254TH WORD. THE FIRST 2 WORDS OF EACH BLOCK /A003 2111 / ARE INITIALIZED FOR COS 310 COMPATIBILITY. /A003 2112 / 2113 /***********************************************************************/A003 2114 2115 SCBOTP, XX /A003 undefined ^ 023311 0000 2116 023312 7200 CLA / CLEAR OUT AC /A003 2117 023313 1711 TAD I SCBOTP / GET DIPLACEMENT /A003 2118 023314 3320 DCA BDISP / PUT DISPLACEMENT INTO CALL LIST /A003 2119 023315 4200 JMS SCAD16 / GO SEE IF WE MUST ADD 16(OCTAL) /A003 2120 023316 0134 SCBTH / PTR TO HEADER POINTER /A003 2121 023317 0133 SCBOT / PTR TO HDR WORD POINTER /A003 2122 023320 0000 BDISP, 0 / SPOT TO PASS DISPLACEMENT /A003 2123 023321 1320 TAD BDISP / GET NEW DISPLACEMENT /A003 2124 023322 3326 DCA BDISP2 / PUT IT INTO CALL LIST /A003 2125 023323 4251 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 2126 023324 0134 SCBTH / HEADDER POINTER /A003 2127 023325 0133 SCBOT / HEADER WORD POINTER /A003 2128 023326 0000 BDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 2129 023327 2311 ISZ SCBOTP / BUMP TO RETURN ADDR /A003 2130 023330 5711 JMP I SCBOTP / RETURN /A003 2131 2132 2133 SCTOPP, XX / INCREMENT TOP POINTERS /A003 undefined ^ 023331 0000 2134 023332 7200 CLA / CLEAR AC /A003 2135 023333 1731 TAD I SCTOPP / GET DISPLACEMENT /A003 2136 023334 3340 DCA TDISP / PUT IT INTO CALL LIST /A003 2137 023335 4200 JMS SCAD16 / GO ADD 16(OCTAL) IF NEEDED /A003 2138 023336 0135 SCTPH / HEADER POINTER /A003 2139 2140 023337 0132 SCTOP / HEADER WORD POINTER /A003 2141 023340 0000 TDISP, 0 / PLACE FOR DISPLACEMENT /A003 2142 023341 1340 TAD TDISP / GET NEW DISPLACEMENT /A003 2143 023342 3346 DCA TDISP2 / PUT IT INTO CALL LIST /A003 2144 023343 4251 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 2145 023344 0135 SCTPH / HEADER POINTER /A003 2146 023345 0132 SCTOP / HEADER WORD POINTER /A003 2147 023346 0000 TDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 2148 023347 2331 ISZ SCTOPP / BUMP UP TO RETURN ADDR /A003 2149 023350 5731 JMP I SCTOPP / RETURN /A003 2150 2151 / during the OPEN process, clear the header block ptrs. left 2152 / from the previous document, or else hdr. blocks belonging 2153 / to a previous document may be de-allocated during the OPEN 2154 / of the current document.... /A024 2155 2156 023351 0000 CLPTRS, 0 /SAVE CALLER'S RETURN ADDR. /A024 2157 023352 1377 TAD (SCBFCB /ADDR. OF START OF DOC. BLOCK-PTR TABLE /A024 2158 DCA X1 /POINTS AT TABLE ENTRY TO CLEAR /A024 undefined ^ undefined ^ 023353 3000 2159 023354 1376 TAD (RPBFCB /ADDR. OF START OF GOTO PAGE BLOCK-PTR TABLE /A024 2160 DCA X2 /POINTS AT TABLE ENTRY TO CLEAR /A024 undefined ^ undefined ^ 023355 3000 2161 2162 BLKINT, DCA I X1 /CLEAR A HDR-BLK-PTR /A024 undefined ^ undefined ^ 023356 3400 2163 DCA I X2 /SAME WITH PARRELLEL GOTO PAGE STRUCTURE /A024 undefined ^ undefined ^ 023357 3400 2164 023360 1375 TAD (-SCHDMD /ADDR. AT END OF TABLE 2165 TAD X1 /COMPARE TO LOC. JUST CLEARED /A024 undefined ^ undefined ^ 023361 1000 2166 023362 7640 SZA CLA /SKIP IF BOTH TABLES CLEARED /A024 2167 023363 5356 JMP BLKINT /JUMP TO CLEAR ANOTHER ENTRY /A024 2168 023364 5751 JMP I CLPTRS /EXIT WITH BOTH TABLES EMPTY 2169 /--------------- 2170 023375 4703 PAGE 023376 0466 023377 3051 2171 2172 SCTPBT, XX / ROUTINE TO DETERMINE IF BOTTOM = /A003 undefined ^ 023400 0000 2173 AC7777 / GET ONE INTO AC /A003 undefined ^ 023401 0000 2174 023402 3212 DCA SCBT3 / PUT IT INTO CALLING LIST /A003 2175 023403 1133 TAD SCBOT / TOP + 1. GET BOT HDR PTR /A003 2176 023404 3137 DCA SCBOTT / PUT IT IN CALL LIST /A003 2177 023405 1134 TAD SCBTH / GET BOTTOM HDR PTR /A003 2178 023406 3136 DCA SCBTHT / PUT IT INTO CALL LIST /A003 2179 023407 4777 JMS SCAD16 / GO SEE IF NEDDS ADD 16(OCTAL) /A003 2180 023410 0136 SCBT1, SCBTHT / HDR POINTER /A003 2181 023411 0137 SCBT2, SCBOTT / HDR WORD POINTER /A003 2182 023412 0001 SCBT3, 1 / INCREMENT BOTTOM BY 1 /A003 2183 023413 1212 TAD SCBT3 / GET INCREMENTED INCRMENT AMT /A003 2184 023414 3220 DCA SCBT6 / PUT INTO INCREMENT CALL LIST /A003 2185 023415 4776 JMS SCINC / GO INCREMENT IT /A003 2186 023416 0136 SCBT4, SCBTHT / HEADER POINTER /A003 2187 023417 0137 SCBT5, SCBOTT / HEADER WORD POINTER /A003 2188 023420 0000 SCBT6, 0 / INCREMENT AMOUNT /A003 2189 023421 1136 TAD SCBTHT / GET INCR'TED HDR PTR /A003 2190 023422 7041 CIA / COMPLEMENT AND INCREMENT IT /A003 2191 023423 1135 TAD SCTPH / ARE BOTTOM AND TOP EQUAL /A003 2192 023424 7440 SZA / IF YES GO SEE IF WORD PTRS EQUAL /A003 2193 023425 5233 JMP SCTB2 / ELSE, NOT EQUAL, 2 ISZ'S AND RETURN /A003 2194 023426 1137 TAD SCBOTT / GET HDR WORD PTR OF BOTTOM /A003 2195 023427 7041 CIA / COMP AND INC IT FOR SUBTRACT /A003 2196 023430 1132 TAD SCTOP / GET TOP HDR WORD PTR AND ADD IT IN /A003 2197 023431 7450 SNA / IF NOT EQUAL, 2 ISZ'S AND OUT /A003 2198 023432 5234 JMP SCTB1 / IF EQUAL, GO ALLOCATE 1 ISZ AND OUT /A003 2199 023433 2200 SCTB2, ISZ SCTPBT / NORMAL RETURN - NO ALLOCATE /A003 2200 SCTB1, / ALLOCATE RETURN /A003 2201 023434 5600 JMP I SCTPBT / RETURN /A003 2202 2203 / THIS ROUTINE WILL MOVE A FILE OVER BY THREE BLOCK NUMBERS /A003 2204 / SO THAT THE EDIT CAN CONTINUE TO ADD TEXT TO THE FILE /A003 2205 2206 SCALC2, XX / RETURN ADDRESS /A003 undefined ^ 023435 0000 2207 023436 1134 TAD SCBTH / GET HDR POINTER /A003 2208 023437 3136 DCA SCBTHT / PUT HDR PTR TO NEW PTR /A003 2209 023440 1133 TAD SCBOT / GET BOTTOM HDR WORD PTR /A003 2210 023441 3137 DCA SCBOTT / PUT IT INTO NEW HDR WORD PTR /A003 2211 2212 /D047 IFDEF STATLN < /A043 2213 2214 023442 4775 JMS SCBOTP / GO BUMP UP POINTERS BY ONE /A043 2215 023443 0001 1 / NUMBER TO BUMP UP BY /A043 2216 2217 /D047 > / END IFNDEF STATLN /A043 2218 /D047 IFNDEF STATLN < /A043 2219 /D047 JMS SCBOTP / GO BUMP UP POINTERS BY THREE /A003 2220 /D047 3 / NUMBER TO BUMP UP BY /A003 2221 /D047 > / END IFNDEF STATLN /A043 2222 2223 2224 023444 4774 SCALCX, JMS SCGETR / GO GET BLOCK - 1 /M047 2225 023445 0136 SCBTHT / HDR PTR /A003 2226 023446 0137 SCBOTT / HDR WORD PTR /A003 2227 023447 4773 JMS SCPUTR / GO PUT THE BLOCK GOTTEN TO BL +3 /A003 2228 023450 0134 SCBTH / HDR PTR /A003 2229 023451 0133 SCBOT / HDR WORD PTR /A003 2230 023452 4775 JMS SCBOTP / GO DECREMENT POINTERS /A003 2231 023453 7777 -1 / AMOUNT TO DECREMENT BY /A003 2232 AC7777 / MINUS 1 TO AC /A003 undefined ^ 023454 0000 2233 023455 3261 DCA SCALCY / PUT DEC VALUE IN CALL LIST /A003 2234 023456 4777 JMS SCAD16 / GO SEE IF WE NEED TO ADD 16(IN 3RD HDR/A003 2235 023457 0136 SCBTHT / HDR PTR /A003 2236 023460 0137 SCBOTT / HDR WORD PTR /A003 2237 023461 0000 SCALCY, 0 2238 023462 1261 TAD SCALCY / GET DISPLACEMENT /A003 2239 023463 3267 DCA SCALCZ / PUT IT IN CALL LIST /A003 2240 023464 4776 JMS SCINC / GO INCREMENT IT /A003 2241 023465 0136 SCBTHT / HDR PTR /A003 2242 023466 0137 SCBOTT / HDR WORD PTR /A003 2243 023467 0000 SCALCZ, 0 / DISPLACEMENT AMOUNT /A003 2244 023470 2772 ISZ SCALC / ARE WE DONE? /A003 2245 023471 5244 JMP SCALCX / NO GO DO IT AGAIN /A003 2246 023472 5635 JMP I SCALC2 / GO BACK /A003 2247 /SCBTHT, 0 / TO SAVE POINTERS /D022 2248 /SCBOTT, 0 / TO SAVE POINTERS /D022 2249 2250 /*********************************************************************/A003 2251 / /A003 2252 / THIS ROUTINE WILL FREE UP BLOCK NUMBERS THAT HAVE BEEN ASSIGNED /A003 2253 / TO THE DOCUMENT AS HEADER EXTENSIONS. THEN IT WILL UPDATE THE /A003 2254 / HEADERS SO THAT THEY HAVE ONLY HEADERS THAT ARE USED /A003 2255 / /A003 2256 /***********************************************************************/A003 2257 2258 SCCLSE, XX / ROUTINE TO FREE UP UNUSED HEADER BLOCKS /A003 undefined ^ 023473 0000 2259 023474 4771 JMS PSTBOT /GO POSITION TO BOTTON OF DOC. 2260 023475 1770 TAD SCHDBN / GET TO HEADER BLOCK NUMBER POINTER /A003 2261 DCA X1 / PUT IT INTO INDEX 1 /A003 undefined ^ undefined ^ 023476 3000 2262 023477 1770 TAD SCHDBN / GET HEADER BLOCK NMBR PTR (FOR CLEARINGSCBOTT /A003 2263 DCA X2 / PUT CLEARER INTO INDEX 2 /A003 undefined ^ undefined ^ 023500 3000 2264 2265 SCCLSF, TAD I X1 / GET BLOCK NUMBER TO FREE UP /A003 undefined ^ undefined ^ 023501 1400 2266 023502 7450 SNA / IF IT ISN'T 0, THEN FREE IT /A003 2267 023503 5313 JMP SCCLSG / IF ZERO, THEN GO SEE IF DONE /A003 2268 023504 4767 JMS SCQRX / GO FREE UP THE BLOCK NUMBER /A003 2269 RXEFR /A003 undefined ^ 023505 0000 2270 023506 0000 0 /A003 2271 AC7777 / -1 /M032 undefined ^ 023507 0000 2272 023510 3766 DCA RPEXTR / SET TO INDICATE FREE-ING HDR BLK /M032 2273 023511 4060 JMS RPFRBK / GO FREE GTP HDR BLOCK /A032 2274 DCA I X2 / CLEAR OUT HDR CONTROL BLOCK /A003 undefined ^ undefined ^ 023512 3400 2275 SCCLSG, / SET UP TO SEE IF DONE /A003 2276 023513 1365 TAD (SCHDMD-2) / GET ADDR OF LAST ENTRY IN TABLE /A003 2277 023514 7041 CIA / MAKE IT ZERO /A003 2278 TAD X1 / GET ADDR INDEX 1 POINTS TO /A003 undefined ^ undefined ^ 023515 1000 2279 023516 7640 SZA CLA / RESULT ZERO IF DONE /A003 2280 023517 5301 JMP SCCLSF / LOOP AROUND TO NEXT ONE /A003 2281 2282 / NOW WE MUST UPDATE THE HEADERS WITH THE NEW BLOCK NUMBERS /A003 2283 2284 023520 1364 TAD (SCHDRB) / GET ADD OF HEADER BLOCK NBR TABLE /A003 2285 DCA X1 / PUT IT INTO INDEX 1 /A003 undefined ^ undefined ^ 023521 3000 2286 023522 1127 TAD T360 / HEADER WORD POINTER FOR 3RD HDR BLOCK /M014 2287 023523 3136 DCA SCCLSC / PUTIT HERE TO ISZ IT /A003 2288 023524 1112 TAD M16 / NUMBER OF HEDR EXTENSION /M014 2289 023525 3137 DCA SCCLST / PUT IT HERE TO ISZ THRU /A003 2290 2291 023526 1763 TAD RPHDRB+1 /RPPGDS 2ND HDR /A014 2292 023527 3762 DCA RPPTR1 /SUPPLT FOR RPPGDS SCPUTR /A014 2293 2294 TAD I X1 / GET THE BLOCK NUMBER 2ND HDR /A003 undefined ^ undefined ^ 023530 1400 2295 023531 4773 JMS SCPUTR / GO PUT IT INTO HDR 1 /A003 2296 023532 0120 ONE / INDICATE HEADER 1 /A003 2297 023533 0117 ZERO / INDICATE WORD 2 OF THE HEADER /A003 2298 2299 023534 1761 TAD RPHDRB+2 /RPPGDS 3RD HDR /A014 2300 023535 3762 DCA RPPTR1 /SUPPY FOR RPPGDS SCPUTR /A014 2301 2302 TAD I X1 / GET 3RD HDR BLOCK NBR /A003 undefined ^ undefined ^ 023536 1400 2303 023537 4773 JMS SCPUTR / GO PUT IT INTO HEADER /A003 2304 023540 0120 ONE /A003 2305 023541 0120 ONE /A003 2306 023542 1760 TAD SCHDRB+2 / GET THE THIRD HEADER BLOCK NUMBER /A022 2307 023543 7650 SNA CLA / HAS IT BEEN DEALLOCATED? /A022 2308 023544 5673 JMP I SCCLSE / YES, THEN WE'RE ALL DONE /A022 2309 2310 SCCLSH, / LOOP TO DO 3RD HEADER EXTENSION HDR BLOCK NBRS /A003 2311 2312 023545 4043 JMS RPEXTN /GET RPPGDS EXTN. BLK # INTO RPPTR1 /A014 2313 TAD I X1 / GET THE 4TH, 5TH, 6TH, ETC HDDR BLCK NBR /A003 undefined ^ undefined ^ 023546 1400 2314 023547 4773 JMS SCPUTR / GO PUT IT INTO THE 361TH, 362TH, 363RD /A003 2315 023550 0122 THREE / ETC, WORD OF HEADER 3 /A003 2316 023551 0136 SCCLSC / HDDR WORD PTR /A003 2317 023552 2136 ISZ SCCLSC / INCREMENT THE HDR WORD POINTER /A003 2318 023553 2137 ISZ SCCLST / INCREMENT LOOP CONTROL /A003 2319 023554 5345 JMP SCCLSH / GO DO IT AGAIN AND AGAIN 'TIL DONE /A003 2320 023555 5673 SCCEXT, JMP I SCCLSE / ALL DONE, RETURN /A003 2321 SCCLST=SCBOTTS / USED FOR LOOP CONTROL /A003 2322 SCCLSC=SCBTHT / USED AS HDR WORD PTR FOR HDR EXTENS /A003 2323 /--------------- 2324 023560 3055 PAGE 023561 0472 023562 0724 023563 0471 023564 3053 023565 3073 023566 3151 023567 2512 023570 3052 023571 3734 023572 1647 023573 2013 023574 2000 023575 3311 023576 3251 023577 3200 2325 2326 /***********************************************************************/A003 2327 / 2328 / THIS ROUTINE POSITIONS THE HEADER POINTERS IN ORDER TO READ THE /A003 2329 / FILES DURING EDITING. THESE POINTERS ARE INITIALIZED THE WAY /A003 2330 / THE USER WANTS TO EDIT THE FILE. IF HE WANTS TO REPLACE THE /A003 2331 / THE ENTIRE DOCUMENT HE PASSES A MINUS 1 IN SCOPTN. IN THIS CASE /A003 2332 / THE TOP POINTERS WILL POINT TO THE FIRST BLOCK NUMBER OF THE /A003 2333 / FILE AND THE BOTTOM POINTERS WILL POINT TO THE BOTTOM (LAST) /A003 2334 / BLOCK NUMBER OF THE FILE. IF THE USER WISHES TO APPEND TO THE /A003 2335 / EXISTING DOCUMENT, THEN THE TOP POINTERS WILL POINT TO THE LAST /A003 2336 / BLOCK NUMBER OF THE FILE, AND THE BOTTOM POINTERS WILL POINT TO /A003 2337 / THE NEXT BLOCK NUMBER (WHICH IS EMPTY). TO DO THIS, THE USER /A003 2338 / PASSES A PLU 1 IN SCOPTN. IF SCOPTN CONTAINS A ZERO, THEN /A003 2339 / NORMAL PRCESSING IS INDICATED, AND THE TOP POINTERS POINT TO /A003 2340 / THE FIRST BLOCK NUMBER OF THE FILE AND THE BOTTOM POINTER POINTS/A003 2341 / TO THE SECOND BLOCK NUMBER OF THE FILE. /A003 2342 / 2343 /***********************************************************************/A003 2344 2345 SCFLZB, XX / RETURN ADDRESS /A003 undefined ^ 023600 0000 2346 023601 1141 TAD SCOPTN / IS THIS A NORMAL EDIT RUN? /A003 2347 023602 7650 SNA CLA / IF IT IS, GO PROCESS NORMAL /A003 2348 023603 5214 JMP SCFLNR / GO PROCESS NORMAL EDIT SESSION /A003 2349 023604 1142 TAD SCFILZ / GET FILE SIZE /A003 2350 023605 7500 SMA / HOW BIG IS IT? IS IT > 2048? /A003 2351 023606 5225 JMP SCFLZ / IF < 2048, THEN DON'T SPLIT IT UP /A003 2352 TAD P3777 / IF > 2048, TAKE OUT 2047 /A003 undefined ^ undefined ^ 023607 1000 2353 023610 3274 DCA SCFLZ2 / STORE REMAINDER FOR SEC LOOP CTL /A003 2354 TAD P3777 / GET LOOP CONTROL FIRST LOOP /A003 undefined ^ undefined ^ 023611 1000 2355 023612 3273 DCA SCFLZ1 / STORE IT FOR LOOP CTL /A003 2356 023613 5227 JMP SCFLZO / GO FIND END OF DOCUMENT /A003 2357 SCFLNR, / PROCESS NOROMAL EDIT /A003 2358 023614 1377 TAD (SCBKOF) / DIPLACEMNT TO 1ST BLOCK NBR IN 1ST HDR/A003 2359 023615 3132 DCA SCTOP / PUT IT INTO TOP POINTER PAIR /A003 2360 023616 1132 TAD SCTOP / GET SAME FOR BOTTOM POINTER /A003 2361 023617 3133 DCA SCBOT / INITIALIZE BOTTOM POINTER /A003 2362 023620 7001 IAC / GET A ONE INTO AC /A003 2363 023621 3135 DCA SCTPH / TOP HDR PTR TO POINT TO 1ST HEADER /A003 2364 023622 7001 IAC / 1 TO AC /A003 2365 023623 3134 DCA SCBTH / BOT HDR PTR SAM AS TOP /A003 2366 023624 5270 JMP SCFLOT / GO ADD ONE TO BOTTOM, AND GET OUT /A003 2367 2368 023625 3273 SCFLZ, DCA SCFLZ1 / ONLY ONE LOOP FOR SHORT FILES /A003 2369 023626 3274 DCA SCFLZ2 / SECOND LOOP CTL= 0 /A003 2370 023627 1377 SCFLZO, TAD (SCBKOF) / DISP TO 1ST BLK NBR IN 1ST HDR /A003 2371 023630 3132 DCA SCTOP / PUT IT IN TOP POINTER /A003 2372 023631 7001 IAC / GET A 1 /A003 2373 023632 3135 DCA SCTPH / TO HDR POINTER /A003 2374 023633 1273 TAD SCFLZ1 / GET 1ST LOOP CTL /A003 2375 023634 7450 SNA / SKIP IF THERE IS A FILE SIZE. /A006 2376 023635 5255 JMP SCFLX / IF FILE SIZE IS 0 THEN WE ARE DONE!!! /A006 2377 023636 7041 CIA / MAKE IT MINUS /A003 2378 023637 3273 DCA SCFLZ1 / STORE IT AGAIN /A003 2379 2380 023640 4776 SCFLZF, JMS SCTOPP / TOP OF 1ST LOOP, GO ADD 1 TO IT /A003 2381 023641 0001 1 /A003 2382 023642 2273 ISZ SCFLZ1 / 1ST LOOP CONTROL INCREMENT /A003 2383 023643 5240 JMP SCFLZF / GO DO I T AGAIN /A003 2384 023644 1274 TAD SCFLZ2 / GET SECOND LOOP CTL /A003 2385 023645 7450 SNA / BYPASS IF ZERO /A003 2386 023646 5255 JMP SCFLX / IF ZERO, BYPASS 2ND LOOP /A003 2387 023647 7041 CIA / MAKE NEGATIVE FOR ISZ /A003 2388 023650 3274 DCA SCFLZ2 / STORE FOR USE /A003 2389 2390 023651 4776 SCFLZT, JMS SCTOPP / TOP OF 2ND LOOP, GO ADD 1 TO TOP PTRS /A003 2391 023652 0001 1 /A003 2392 023653 2274 ISZ SCFLZ2 / IF ZERO, THEN WE'RE ALL DONE /A003 2393 023654 5251 JMP SCFLZT / GO ADD ANOTHER 1 IF NOT ZERO /A003 2394 2395 023655 1132 SCFLX, TAD SCTOP / GET TOP HDR WORD POINTER /A003 2396 023656 3133 DCA SCBOT / PUT IT INTO BOTTOM PTR /A003 2397 023657 1135 TAD SCTPH / GET TOP HDR PTR /A003 2398 023660 3134 DCA SCBTH / PUT IT INTO BOTTOM HDR PTR /A003 2399 023661 1141 TAD SCOPTN / GET OPTIONS PASSED /A003 2400 023662 7700 SMA CLA / IF NEGATIVE, THE RESET TOP /A003 2401 023663 5270 JMP SCFLOT / IF NOT, GO BUMP UP BOTTOM PTRS /A003 2402 023664 1377 TAD (SCBKOF) / MAKE TOP POINT TO FIRST BLK NBR /A003 2403 023665 3132 DCA SCTOP / TOP HEADER WORD POINTER /A003 2404 023666 7001 IAC / GET A 1 /A003 2405 023667 3135 DCA SCTPH / TOP HEADER POINTER TO POINT TO 1ST /A003 2406 2407 023670 4775 SCFLOT, JMS SCBOTP / GO INCREMENT BOTTOM BY ONE /A003 2408 023671 0001 1 /A003 2409 023672 5600 JMP I SCFLZB / RETURN /A003 2410 2411 023673 0000 SCFLZ1, 0 / SPOT FOR ISZ LOOP CONTROL (1ST) /A003 2412 023674 0000 SCFLZ2, 0 / SPOT FOR ISZ LOOP CONTROL (2ND) /A003 2413 023675 0000 0 2414 2415 / THIS ROUTINE WILL GET ALL THE HEADERS FOR A READ ONLY FILE /A003 2416 2417 RDGTHS, XX /A003 undefined ^ 023676 0000 2418 023677 4774 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 2419 023700 0120 ONE / INDICATE 1ST HEADER /A003 2420 023701 0117 ZERO / INDICATE 1ST HDR EXTENSION /A003 2421 023702 3773 DCA RDHDRB+1 / PUT IT INTO HDR CTL BLOCK /A003 2422 023703 4774 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 2423 023704 0120 ONE / 1ST HDR AGAIN /A003 2424 023705 0120 ONE / INDCATE 2ND HDR EXT /A003 2425 023706 3772 DCA RDHDRB+2 / PUT IT INTO HDR CTL BLOCK /A003 2426 023707 4774 JMS RDGETR / GO GET FILE SIZE /A003 2427 023710 0120 ONE / 1ST HEADER AGAIN /A003 2428 023711 0122 THREE / INDICATE FILE SIZE /A003 2429 023712 3101 DCA RDFSIZ / PUT IT WHERE OTHERS CAN GET IT /A003 2430 023713 4771 JMS GTHDRS / GO GET REMAINING HEADERS /A003 2431 023714 2600 RDBFCB / INDICATE READ-ONLY HDR CTL BLOCK /A003 2432 023715 5676 JMP I RDGTHS / GOBACK /A003 2433 2434 / THIS ROUTINE WILL INCREMENT THE HEADER POINTERS FOR READ-ONLY /A003 2435 2436 RDINC, XX /A003 undefined ^ 023716 0000 2437 AC0001 / INDICATE SIZE OF INCREMNET /A003 undefined ^ 023717 0000 2438 023720 3324 DCA RDINC1 / PUT IT INTO CALL LIST /A003 2439 023721 4770 JMS SCAD16 / GO SEE IF YOU NEED ADD 16 (OCTAL) /A003 2440 023722 0544 RDHDRP / READ-ONLY HDR POINTER /A003 2441 023723 0545 RDPTRS / READ-ONLY HDR WORD PTR /A003 2442 023724 0000 RDINC1, 0 / AMOUNT TO INCREMENT BY /A003 2443 023725 1324 TAD RDINC1 / GET AMOUNT TO INCREMENT BY /A003 2444 023726 3332 DCA RDINC2 / PUT AMOUNT INTO CALL LIST /A003 2445 023727 4767 JMS SCINC / GO INCREMENT THE POINTERS /A003 2446 023730 0544 RDHDRP / READ-ONLY HDR PTR /A003 2447 023731 0545 RDPTRS / READ-ONLY HDR WORD PTR /A003 2448 023732 0000 RDINC2, 0 / AMOUNT TO INCREMENT BY /A003 2449 023733 5716 JMP I RDINC / RETURN /A003 2450 2451 / THIS ROUTINE WILL SEARCH FOR THE BOTTOM OF THE DOCUMENT. 2452 / IT IS USED TO MAKE SURE THAT THE HEADER POINTER IN THE SCROLL 2453 / HEADER CONTROL BLOCK IS POINTING TO THE LAST HEADER BLOCK 2454 / IN THE FILE SO THAT THE DE-ALLOCATION ROUTINE WON'T DE-ALLOCATE 2455 / ANY HEADERS THAT BELONG TO THE FILE... 2456 2457 023734 0000 PSTBOT, 0 /SAVE CALLER'S RETURN ADDR. 2458 AC0001 / /A032 undefined ^ 023735 0000 2459 023736 3134 DCA SCBTH /START WITH 1ST HEADER /A032 2460 023737 1377 TAD (SCBKOF /STARTING HEADER WORD POINTER 2461 023740 3133 DCA SCBOT /INTO 'BOTTOM' POINTER 2462 2463 023741 4775 PSTBO1, JMS SCBOTP /GO INCREMENTT THE POINTERS 2464 023742 0001 1 2465 023743 4766 JMS SCGETR /GO GET A BLOCK NUMBER 2466 023744 0134 SCBTH 2467 023745 0133 SCBOT 2468 023746 7640 SZA CLA /SKIP IF END OF BLOCK-LIST POINTERS 2469 023747 5341 JMP PSTBO1 /LOOP UNTIL EOF FOUND 2470 023750 5734 JMP I PSTBOT /EXIT:AT END OF FILE 2471 /--------------- 2472 023766 2000 PAGE 023767 3251 023770 3200 023771 2674 023772 2604 023773 2603 023774 2625 023775 3311 023776 3331 023777 0052 2473 2474 /***********************************************************************/a048 2475 / WARNING do not move this routine without changing WPf1 to reflect the 2476 / address change 2477 /****************************************************************** /a048 2478 2479 * FBHOOK /4000 /a048 undefined ^ 2480 2481 /******************************************************************** 2482 / BHOOK Hook to panel page blaster 2483 /******************************************************************** /a048 2484 2485 020000 0000 BHOOK, 0 / hook return address /a048 2486 020001 3021 DCA BLACSV / save accumulator /a048 2487 020002 6214 RDF / read the data field /a048 2488 TAD CDF0 / make a cdf instruction /a048 undefined ^ undefined ^ 020003 1000 2489 020004 3016 DCA BHKEXI / save for return /a048 2490 020005 0000 CDFMYF / set to hooks field /a048 2491 020006 1400 TAD I BHOOK / get the table entry /a048 2492 020007 7421 MQL / push into MQ /a048 2493 020010 1021 TAD BLACSV / get the ac /a048 2494 020011 2000 ISZ BHOOK / increment the return address /a048 2495 CIFMNU / blaster is in the menu field /a048 undefined ^ 020012 0000 2496 020013 6002 IOF / turn the interrupts off before.. /a048 2497 020014 4420 JMS I BLASTH / Calling blaster /a048 2498 020015 2000 ISZ BHOOK / skip return exit /a048 2499 020016 0000 BHKEXI, 0 / CDF instruction /a048 2500 020017 5400 JMP I BHOOK / return /a048 2501 BLASTH, BLASTR / blastr address (get from WPF1) /a048 undefined ^ 020020 0000 2502 020021 0000 BLACSV, 0 / ac save /a048 2503 2504 2505 2506 RPPGDS=7400 /V2.0 GOTO PAGE BUFFER AREA IN FIELD 2 2507 2508 / if the block just allocated and initialized was the 2nd /A014 2509 / EXTENSION block, then words 362 to 377 must be set to 0. /A014 2510 / these words are new V2 extension block pointers, not text /A014 2511 / block pointers..... /A014 2512 2513 020022 4775 RPCKV2, JMS RPBFIN /SET ALL BUFFER WORDS TO -1 /M031 2514 /EXCEPT 0 (-255), 1 (70), 2&3 (0) /M031 2515 020023 1774 TAD RPHDBN /PTR. TO BLOCK JUST ALLOCATED /A014 2516 020024 7041 CIA /FOR COMPARE TO /A014 2517 TAD (RPHDRB+2 /2ND EXTENSION BLOCK /A014 page zero ^ page zero ^ 020025 1173 2518 020026 7640 SZA CLA /SKIP IF SPECIAL V2 EXTENSION BLOCK /A014 2519 020027 5042 JMP RPV2EX /IGNORE ALL OTHERS /A014 2520 2521 TAD (RPPGDS+361 /PTR. TO WORD PRIOR TO 1ST /A014 page zero ^ page zero ^ 020030 1172 2522 /V2 EXTN BLOCK PTR WITHIN 3RD HDR. /A014 2523 DCA X3 /INTO AUTO-INDEX REG. /A014 undefined ^ undefined ^ 020031 3000 2524 2525 020032 0000 RPLPV2, CDFRPB /RPPGDS BUFFER FIELD /A014 2526 DCA I X3 /INIT. V2 EXTN. POINTER /A014 undefined ^ undefined ^ 020033 3400 2527 020034 0000 CDFMYF /BACK FROM RPPGDS FIELD /A014 2528 TAD X3 /POINTER TO WORD JUST INIT'D. /A014 undefined ^ undefined ^ 020035 1000 2529 020036 7041 CIA /FOR COMPARE TO /A014 2530 TAD (RPPGDS+377 /END OF RPPGDS BUFFER /A014 page zero ^ page zero ^ 020037 1171 2531 020040 7640 SZA CLA /SKIP IF INITIALIZATION DONE /A014 2532 020041 5032 JMP RPLPV2 /JUMP TO INIT. ANOTHER WORD /A014 2533 2534 / NEW RETURN TO WITHIN RPREAD /A031 2535 020042 5770 RPV2EX, JMP REEDXT /RETURN TO CALLER /A031 2536 2537 020043 0000 RPEXTN, 0 /GET RPPGDS EXTN. BLK #'S 4-16 /A012 2538 TAD (SCHDRB /TOP OF DOC. HDR. BLOCK-LIST /A012 page zero ^ page zero ^ 020044 1167 2539 020045 7041 CIA /FOR COMPARE TO /A012 2540 TAD X1 /PTR. TO NEXT HDR. EXTN. PTR. /A012 undefined ^ undefined ^ 020046 1000 2541 TAD (RPHDRB /FIND PTR TO CORRESPONDING RPPGDS PTR /A012 page zero ^ page zero ^ 020047 1166 2542 DCA X2 /FOR INDIRECT /A012 undefined ^ undefined ^ 020050 3000 2543 TAD I X2 /GET RPPGDS EXTN BLK # /A012 undefined ^ undefined ^ 020051 1400 2544 020052 3765 DCA RPPTR1 /FOR RPPGDS PART OF SCPUTR /A102 2545 020053 5443 JMP I RPEXTN /RETURN FOR SCPUTR OF HDR EXTN /A012 2546 2547 020054 0000 RPALOC, 0 /CALLER'S RETURN ADDR. /A014 2548 020055 1054 TAD RPALOC /CALLER'S RETURN ADDR. /A014 2549 020056 3764 DCA RPREA1 /USING PREVIOUS DESIGN /A032 2550 020057 5763 JMP RPRDEX /USE CURRENT LOGIC /A014 2551 2552 / AC = 0 ON ENTRY /A032 2553 020060 0000 RPFRBK, 0 /CALLERS RETURN ADDRESSS /A022 2554 TAD (SCHDBN /HDR BLK TO BE RELEASED /A022 page zero ^ page zero ^ 020061 1162 2555 020062 7041 CIA /MAK NEG FOR OFFSET /A022 2556 TAD X1 /OFFSET INTO SCHDBN /A022 undefined ^ undefined ^ 020063 1000 2557 TAD (RPHDBN /GET SAME OFFSET INTO RPHDBN /A022 page zero ^ page zero ^ 020064 1174 2558 020065 3072 DCA RPFRB2 /SAVE /A022 2559 020066 1472 TAD I RPFRB2 /SUPPLY BLOCK # TO BE FREED /A022 2560 020067 4761 JMS RPDSFR /AC = BLK # (AC=0 ON RETURN) /A022 2561 020070 3472 DCA I RPFRB2 /CLEAR POINTER FROM TABLE /A022 2562 2563 /LEAVE DEALLOCATE FLAG ON TO SIGNIFY CLOSE-OPERATION WHEN 2564 /READING 1ST GOTO-PAGE HEADER BLOCK /A023 2565 2566 020071 5460 RPFRB1, JMP I RPFRBK /RETURN /A022 2567 2568 020072 0000 RPFRB2, 0 /POINTER TO BLOCK TO BE FREED /A022 2569 2570 / here when writing to ETX buffer and PRINT-CONTROL char. recognized 2571 / on entry, AC = RPMODE word... 2572 2573 020073 7650 CHKETX, SNA CLA /SKIP IF END-CONTROL /A030 2574 020074 5125 JMP DOSTRT /GO PROCESS START-CONTROL /A030 2575 TAD (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 page zero ^ page zero ^ 020075 1160 2576 AND I T3 /IN THE CURRENT DESCRIPTOR /A030 undefined ^ undefined ^ 020076 0400 2577 020077 1102 TAD P100 /NOW SET 'IN CONTROL-AREA'FLAG /A030 2578 DCA I T3 /WITHIN THE CURRENT DESCRIPTOR WORD /A030 undefined ^ undefined ^ 020100 3400 2579 020101 5105 JMP TODSBDEX /GO SET OUR OWN PRINT-CONTROL-FLAG /A030 2580 2581 /This routine is entered when it's determined that a PUT to the STX 2582 / buffer has occurred. more specifically, a print control char is 2583 / being put - 030 2584 2585 CHKSTX, TAD (200 /CHECK TO SEE IF THIS PRINT CONTROL /A030 page zero ^ page zero ^ 020102 1164 2586 020103 0757 AND RPMODE /IS AN END PRINT CONTROL /A030 2587 020104 7650 SNA CLA /SKIP IF: END PRINT CONTROL /A030 2588 2589 TODSBDEX,AC0100 /PRINT CONTROL WAS A START. SET /A030 undefined ^ 020105 0000 2590 /FLAG TO INDICATE WITHIN CONTROL AREA /A030 2591 020106 3756 DCA RPPCTLFL /UPDATE CONTROL AREA FLAG /A030 2592 2593 /Here when writing to STX buffer. check flag, if on: have already 2594 / processed a print control char in the buffer - stop 2595 / if off: process this print control char as it is the first print 2596 / control char in the STX buffer 2597 2598 020107 1140 CHKST1, TAD SOMFLG / CHECK THE STATE OF FLAG /A030 2599 020110 7640 SZA CLA / SKIP IF: NOT ON /A030 2600 020111 5755 JMP DSBDEX / HAVE BEEN THROUGH ONCE, EXIT /A030 2601 2602 CHKST2, TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 undefined ^ undefined ^ 020112 1400 2603 AND (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 page zero ^ page zero ^ 020113 0160 2604 DCA I T3 /UPDATE CURRENT DESCRIPTOR WORD /A030 undefined ^ undefined ^ 020114 3400 2605 2606 /come here if writing print control char to STX buffer (and is the first 2607 / print control char in the buffer). set bit5 in the descriptor to be 2608 / the opposite state as that of the print-control area flag. 2609 2610 020115 1756 CHKST3, TAD RPPCTLFL /PRINT-CONTROL AREA FLAG /A030 2611 020116 7040 CMA /OPPOSITE STATE /A030 2612 020117 0102 AND P100 /SAVE FLAG ONLY /A030 2613 TAD I T3 /MERGE WITH DESC. WORD /A030 undefined ^ undefined ^ 020120 1400 2614 DCA I T3 /UPDATE DESC. WORD /A030 undefined ^ undefined ^ 020121 3400 2615 AC0001 /SET FLAG TO INDICATE THAT /A030 undefined ^ 020122 0000 2616 020123 3140 DCA SOMFLG /A PRINT CONTROL CHAR WAS /A030 2617 /PROCESSED WITHIN THIS BUFFER /A030 2618 020124 5755 JMP DSBDEX /RETURN /A030 2619 2620 /The following routine entered when writing to ETX buffer and a 2621 / start print control char is encountered 2622 2623 DOSTRT, TAD (7677 /MASK OUT BIT 5 IN THE DESCRIPTOR /A030 page zero ^ page zero ^ 020125 1160 2624 AND I T3 /WORD /A030 undefined ^ undefined ^ 020126 0400 2625 DCA I T3 /UPDATE THE DESCRIPTOR WORD /A030 undefined ^ undefined ^ 020127 3400 2626 020130 3756 DCA RPPCTLFL /CLEAR THE PRINT CONTROL AREA FLAG /A030 2627 /TO INDICATE NOT IN A CONTROL AREA /A030 2628 020131 5755 JMP DSBDEX /RETURN /A030 2629 2630 / This subroutine checks to see if the character just PUT was a 2631 / Page Marker of New Page. If so, increment T3, then check to 2632 / make sure that no more than 36 Pages/New Pages are in the 2633 / buffer. Only 5 bits are designated as page counters in the 2634 / GTP descriptor word, if the number of pages overflows 5 bits, 2635 / the entire descriptor word could be ruined 2636 / 2637 CHKPAG, XX / SUBROUTINE TO CHECK FOR PAGE/NEW-PAGE /A028 undefined ^ 020132 0000 2638 020133 1113 TAD NWPAGE /IS IT A NEW PAGE? /A018 2639 020134 7440 SZA /SKIP IF SO /A018 2640 020135 1103 TAD PAGEMK /IS IT A PAGE MARKER? /A018 2641 020136 7650 SNA CLA / SKIP IF: NEITHER /A032 2642 ISZ I T3 / ACCOUNT FOR PAGE IN SCROLL BUFFER /A032 undefined ^ undefined ^ 020137 2400 2643 TAD I T3 / GET # OF PAGES IN SCROLL BUFFER /A032 undefined ^ undefined ^ 020140 1400 2644 TAD (-36 / COMPARE TO MAX. # OF ALLOWABLE PGS. /A032 page zero ^ page zero ^ 020141 1154 2645 020142 7650 SNA CLA / SKIP IF: WITHIN LIMITS /A032 2646 AC0001 / AT MAX. SET FLAG IN ORDER TO PAD BUF /A032 undefined ^ 020143 0000 2647 020144 3153 DCA PAGLIM / 0 = WITHIN RANGE /A032 2648 / 1 = AT MAXIMUM /A032 2649 020145 5532 JMP I CHKPAG / RETURN TO CALLER. /A028 2650 2651 2652 /--------------- 2653 PAGE 2654 2655 / here after WPFILS requested a read io 2656 / get the "scroll" buffer address used for the read io 2657 / 2658 / IF this is not the main document header block, then go read 2659 / the parrellel 'extension' block 2660 / ELSE read the RPPGDS link word in the main document header 2661 / block 2662 / 2663 / IF the link word is empty, then this document never had a RPPGDS 2664 / block allocated to it. Go allocate one and attach it to the 2665 / main document header block 2666 / ELSE verify that the RPPGDS block linked to this document 2667 / is a valid up-to-date reflection of the text block content 2668 / 2669 2670 /******************************************************************* /A039 2671 /******************************************************************* /A039 2672 /******************************************************************* /A039 2673 /**** **** /A039 2674 /**** NOTE **** /A039 2675 /**** **** /A039 2676 /**** THIS ROUTINE COUNTS ON THE FACT THAT THE DISK OPEN **** /A039 2677 /**** COMMAND IS THE FIRST ENTRY IN THE XFLDTB TABLE **** /A039 2678 /**** **** /A039 2679 /******************************************************************* /A039 2680 /******************************************************************* /A039 2681 /******************************************************************* /A039 2682 2683 2684 RPREA1, XX /SAVE CALLERS RETURN ADDRESS /A032 undefined ^ 020200 0000 2685 020201 1223 TAD XFILT3 /GET POINTER TO WPFILS ACTIVE FUNCTION /M039 2686 020202 7041 CIA /NEGATE IT FOR FOLLOWING COMPARE /A039 2687 020203 1225 TAD XFLDTB /COMPARE TO ADDRESS AT 'OPEN' COMMAND /M039 2688 020204 7640 SZA CLA /SKIP IF DOING 'OPEN' /A034 2689 020205 5262 JMP RPRDEX /SKIP VERIFICATION /A034 2690 020206 1777 TAD SCQBLK+RXQBLK /DOC. HDR. BLOCK # JUST READ /M012 2691 020207 7041 CIA /FOR COMPARISION 2692 020210 1776 TAD SCHDRB /BLK# OF DOC. MAIN HEADER /A034 2693 020211 7640 SZA CLA /SKIP IF MAIN HEADER 2694 020212 5262 JMP RPRDEX /GO READ PARALLEL RPPGDS EXTN. BLOCK 2695 2696 / (could be OPENing this document for the first time....) 2697 2698 020213 0000 CDFBUF /CHANGE TO SCROLL BUFFER FIELD 2699 020214 1775 TAD I (SCHDR+1 /2ND WORD OF DOC. HEADER /A029 2700 020215 7110 CLL RAR /TEST STATE OF BIT11 /A029 2701 020216 7530 SZL CLL /SKIP IF NO G-T-P BLOCK /A029 2702 020217 5235 JMP RPRDDS /GO READ THE PARELLEL RPPGDS MAIN BLOCK 2703 2704 020220 7024 CML RAL /GET READY TO /A029 2705 020221 3775 DCA I (SCHDR+1 /SET BIT11 (NOW HAVE A G-T-P BLOCK) /A029 2706 2707 / this document was never used with a V2 WPS, thus, it has no 2708 / RPPGDS block 2709 2710 / allocate a block for the main RPPGDS descriptor block 2711 2712 / account for this allocation in SPCSPF 2713 2714 / link the RPPGDS block to the doc. header block by storing 2715 / the RPPGDS block # in the 43rd (dec.) word of the header block 2716 2717 / update "main RPPGDS" block # storage word with the block # returned 2718 / from the allocation request 2719 / update "current RPPGDS" block pointer with the pointer to the 2720 / "main RPPGDS" block # storage word 2721 2722 020222 4307 JMS RPALLOCATE /GO ALLOCATE A BLOCK FOR G-T-P /M029 2723 020223 0000 CDFBUF /CHANGE TO BUFFER FIELD 2724 020224 3774 DCA I (SCHDR+53 /LINK RPPGDS TO DOC. HEADER 2725 020225 1774 TAD I (SCHDR+53 /GET OUR BLK# BACK 2726 020226 0000 CDFMYF /BACK TO THIS FIELD 2727 020227 3773 DCA RPHDRB /COPY IN RPPGDS BLOCK TABLE 2728 2729 020230 4772 JMS WRITEOUT /WRITE OUT THE ALLOCATION BLK. /A031 2730 2731 020231 1373 RPMAIN, TAD (RPHDRB /ADDR. OF MAIN RPPGDS BLOCK 2732 2733 RPRD2, /ENTER HERE TO SET RPHDBN /M030 2734 020232 3771 DCA RPHDBN /IS NOW THE ACTIVE RPPGDS BLOCK 2735 2736 / a block has been allocated either for the main RPPGDS block, 2737 / or one of its' extensions. 2738 / initialize the RPPGDS scroll buffer (7400) to reflect this new 2739 / block. 2740 / the content of this buffer will be written when the associated 2741 / doc. header block is written. 2742 2743 020233 5022 JMP RPCKV2 /IS THIS 2ND EXTN. BLOCK? /M031 2744 2745 RPRDND, /END OF READ; RPPGDS CONTAINS NEW BLOCK 2746 020234 5600 REEDXT, JMP I RPREA1 /RETURN TO CALLER /M032 2747 2748 / this document has a V2.n RPPGDS linked to it; meaning that it 2749 / it has been OPENed by a V2.n WPS system... 2750 / 2751 / read the RPPGDS block into its scroll buffer (7400) and verify 2752 / that it contains up-to-date text block desciptors. 2753 / 2754 / IF AC = 0 after RPRDIT (verification) RPPGDS descriptors can be use 2755 / ELSE RPPGDS does not contain up-to-date text block descriptors. 2756 / Deallocate any RPPGDS extension blocks and initialize 2757 / the main RPPGDS block. 2758 2759 RPRDDS, /AC = NEW MAIN DESC. BLK. # /M019 2760 020235 7200 CLA /CLEAR AC HERE TO /A029 2761 020236 1774 TAD I (SCHDR+53 /GET G-T-P BLOCK # /A029 2762 020237 4770 JMS RPRDIT /READ/VERIFY IT 2763 2764 020240 7421 MQL /SAVE VERIFY RESULT /A019 2765 020241 1143 TAD NEWBLK /GET THE NEW DESC. BLK. # /A019 2766 020242 3773 DCA RPHDRB /PUT IT IN BLOCK-TABLE /A019 2767 2768 RPEXT, /GOOD BLOCK; MAKE IT THE 'CURRENT' ONE 2769 /WRITE-BEFORE-READ FLAG IS SET 2770 020243 1373 TAD (RPHDRB /ADDR OF MAIN RPPGDS BLK. IN BLOCK TABLE/M011 2771 020244 3771 DCA RPHDBN /MAKE MAIN RPPGDS BLOCK THE CURRENT BLOCK/M011 2772 2773 / OPENING..... 2774 / supply RPPGDS extension block numbers, if any... 2775 2776 020245 0000 CDFRPB /RPPGDS BUFFER FIELD 2777 020246 1767 TAD I (RPPGDS+2 /1ST EXTN. BLOCK # OR 0 2778 020247 0000 CDFMYF /BACK TO THIS FIELD 2779 020250 3766 DCA RPHDRB+1 /INTO OUR CONTROL TABLE 2780 020251 0000 CDFRPB /RPPGDS BUFFER FIELD 2781 020252 1765 TAD I (RPPGDS+3 /2ND EXTN. BLOCK # OR 0 2782 020253 0000 CDFMYF /BACK TO THIS FIELD 2783 020254 3764 DCA RPHDRB+2 /INTO OUR CONTROL TABLE 2784 2785 020255 7501 MQA /REPLACE RESULT OF VERIFY(RPRDIT) /A019/M031 2786 2787 020256 7650 SNA CLA /SKIP IF ITS CORRUPTED /M031 2788 020257 5234 JMP REEDXT /GOOD MAIN-GTP BLK; EXIT /A032 2789 020260 4763 JMS RPDSCR /DE-ALLOC. RPPGDS EXTN, IF ANY /M031 2790 020261 5231 JMP RPMAIN /RE-INIT. MAIN RPPGDS BLOCK/ /M031 2791 2792 / a document header extension block has been read. 2793 / 2794 / identify which extension and determine if the RPPGDS block 2795 / has a parrellel extension available. 2796 / 2797 / if not, allocate a block for an extension and initialize the 2798 / the RPPGDS scroll buffer to reflect the new block. 2799 / link the new extension to the RPPGDS block table and make the 2800 / new extension the "active" block. 2801 / 2802 / if extension already present, read it into the RPPGDS scroll buffer 2803 2804 RPRDEX, /HERE WHEN THE PARALLEL BLOCK IS AN EXTN. 2805 020262 1762 TAD SCHDBN /PTR. INTO DOC. HDR. BUFFER CONTROL AREA 2806 020263 1361 TAD (-SCHDRB /MINUS THE START OF THE CONTROL AREA 2807 020264 1373 TAD (RPHDRB /PLUS THE START OF THE RPPGDS CONTROL AREA 2808 020265 3145 DCA EXTNOF /= PTR. TO PARRELLEL RPPGDS BLOCK # 2809 2810 020266 1545 TAD I EXTNOF /GET THE BLOCK # OF THE PARRELLEL RPPGDS BLOCK 2811 020267 7450 SNA /SKIP IF THERE IS A BLOCK # AVAILABLE 2812 020270 5276 JMP RPALEX /AC => 0; NO BLOCK AVAILABLE 2813 020271 4770 JMS RPRDIT /AC => BLK #; READ THE BLOCK 2814 020272 7650 SNA CLA /SKIP IF RPPGDS BLOCK CORRUPTED 2815 020273 5304 JMP RPXEX /EXIT:PARRELLEL RPPGDS BLOCK IN BUFFER (7400) 2816 020274 1545 TAD I EXTNOF /SUPPLY THE BLOCK # 2817 020275 4760 JMS RPDSFR /DE-ALLOCATED THE CORRUPTED BLOCK 2818 2819 / Here to allocate a block for the RPPGDS. 2820 / Put the block # returned (allocated) into the appropriate 2821 / RPPGDS block table entry and make this block the "current" 2822 / current block. 2823 / Go and initialize our scroll buffer (7400) to reflect a new 2824 / unused block. 2825 2826 020276 4307 RPALEX, JMS RPALLOCATE /GO ALLOCATE AN EXTN. BLOCK /A029 2827 020277 3545 DCA I EXTNOF /PUT IT IN RPPGDS BLK TABLE AT EXTN. ENTRY 2828 2829 / A BLOCK WAS JUST ALLOCATED, SO WRITE-OUT THE ALLOCATION BLOCK /A031 2830 020300 4772 JMS WRITEOUT /WRITE-OUT THE ALLOCATION BLOCK /A031 2831 2832 / supply the link to the 1st and 2nd extension blocks now... 2833 020301 4757 JMS RPWRTH /WRITE OUT CURRENT GTP BLK /A034 2834 2835 020302 1145 RPLNK, TAD EXTNOF /POINTER TO CURRENT TABLE ENTRY /A034 2836 020303 5232 JMP RPRD2 /INIT. RPPGDS EXTN. BLOCK IMAGE 2837 2838 020304 1145 RPXEX, TAD EXTNOF /CONTROL TABLE ENTRY POINTER 2839 020305 3771 DCA RPHDBN /MAKE THIS EXTN. THE CURRENT BLOCK 2840 020306 5234 JMP REEDXT /EXIT:EXTN. IN BUFFER /A032 2841 2842 RPALLOCATE, XX /GET A BLOCK FOR THIS DOC. /A029 undefined ^ 020307 0000 2843 020310 4756 JMS RPQRX /INTERNAL REQ. TO ALLOC. A BLOCK /A029 2844 RXEAL /FC5=ALOOCATE A BLOCK /A029 undefined ^ 020311 0000 2845 020312 0000 0 /NO BUFFER NECESSARY /A029 2846 2847 020313 4755 JMS SCSPC /UPDATE # OF FREE BLOCK ON DISKETTE /A029 2848 /SPCSPF IN PAGE 0 2849 2850 020314 1777 TAD SCQBLK+RXQBLK /GET THE BLK# JUST ALLOC. /A029 2851 020315 5707 JMP I RPALLOCATE /RETURN WITH AC = BLOCK # /A029 2852 /--------------- 2853 020355 1702 PAGE 020356 0600 020357 0400 020360 0651 020361 4725 020362 3052 020363 0657 020364 0472 020365 7403 020366 0471 020367 7402 020370 1000 020371 0467 020372 0513 020373 0470 020374 6053 020375 6001 020376 3053 020377 2553 2854 2855 / here after a block has been written. 2856 / 2857 / IF THE BLOCK JUST WRITTEN WAS THE DOC. HEADER BLOCK (CLOSE), 2858 / WRITE THE MAIN RPPGDS BLOCK AFTER INITIALIZING APPROPRIATE 2859 / IDENTIFICATION WORDS 2860 / 2861 / ASSUMPTION: IF THE DOC. HEADER BLOCK WAS IN THE SCROLL BUFFER 2862 / THEN THE PARALLEL RPPGDS BLOCK WAS CO-RESIDENT 2863 / 2864 RPWRTH, XX /A034 undefined ^ 020400 0000 2865 020401 1200 TAD RPWRTH /GET CALLER'S RETURN ADDR. /A034 2866 020402 3204 DCA RPWRT /USE IT FOR THIS RETURN /A034 2867 020403 5233 JMP RPWRTO /NOW GO WRITE BLOCK /A034 2868 2869 RPWRT, XX /A032 undefined ^ 020404 0000 2870 020405 1777 TAD SCQBLK+RXQBLK /BLK# JUST WRITTEN 2871 020406 7041 CIA /FOR COMPARE TO 2872 020407 1776 TAD I (SCHDRB /DOC. HDR. BLK. # 2873 020410 7640 SZA CLA /SKIP WITH MAIN HDR. BLK. 2874 020411 5233 JMP RPWRTO /GO DO PARALLEL EXTENSION BLK 2875 2876 / before writting the MAIN RPPGDS block, update the identifiaction 2877 / words... 2878 2879 020412 0000 CDFBUF /BUFFER FIELD 2880 020413 1775 TAD I (SCHDR+5 /# OF BLKS. ALLOCATED TO THIS DOC. 2881 020414 0000 CDFRPB /OUR BUFFER FIELD 2882 020415 3774 DCA I (RPPGDS+5 /UPDATE NEW DATA STRUCTURE 2883 020416 0000 CDFBUF 2884 020417 1773 TAD I (SCHDR+10 /DAY-MONTH OF LAST EDIT 2885 020420 0000 CDFRPB /OUR BUFFER FIELD 2886 020421 3772 DCA I (RPPGDS+10 /SAME HERE 2887 020422 0000 CDFBUF 2888 020423 1771 TAD I (SCHDR+11 /LAST 2 DIGITS OF YESR 2889 020424 0000 CDFRPB /OUR BUFFER FIELD 2890 020425 3770 DCA I (RPPGDS+11 /SAME HERE 2891 020426 0000 CDFBUF 2892 020427 1767 TAD I (SCHDR+12 /START TIME OF LAST EDIT 2893 020430 0000 CDFRPB /OUR BUFFER FIELD 2894 020431 3766 DCA I (RPPGDS+12 /SAME HERE 2895 020432 0000 CDFMYF /BACK TO OUR FIELD 2896 2897 / now write out the buffer to update the RPPGDS MAIN block... 2898 2899 / write the "current" block to disk after clearing its' modified bit 2900 2901 RPWRTO, /WRITE THE RPPGDS BLOCK TO DISK 2902 020433 1667 TAD I RPHDBN /GET THE RPPGDS BLOCK # 2903 020434 4765 JMS RPQRX /WRITE OUT A RPPGDS BLOCK 2904 020435 2004 RXEWT+2000 /FC 4 = WRITE/VERIFY 2905 020436 7400 RPPGDS /BLOCK IMAGE FROM THIS BUFFER 2906 020437 5604 JMP I RPWRT /EXIT:PARALLEL RPPGDS BLK WRITTEN /A032 2907 2908 / a descriptor word has been built (RPDSBD) depicting the 2909 / positioning information contained within the text block 2910 / just written to disk... 2911 2912 / if the scroll buffer just used was the STX buffer, then 2913 / use SCTOP for offset into RPPGDS for descriptor word location 2914 / else use SCBOT for offset 2915 2916 RPDSWD, /UPDATE RPPGDS 2917 020440 0000 0 /SAVE CALLERS RETURN ADDR. 2918 TAD SCQBLK+RXQBAD /BUFFER JUST USED FOR IO undefined ^ 020441 1764 2919 020442 1363 TAD (-SCTB /COMPARE TO TOP (STX) 2920 020443 7640 SZA CLA /SKIP IF STX TO USE SCTOP 2921 AC0001 /WANT SCBOT FOR BOTTOM (ETX) undefined ^ 020444 0000 2922 020445 1362 TAD (SCTOP-1 /POINT TO BLOCK OFFSET 2923 DCA X3 /INIT. TO BLOCK OFFSET undefined ^ undefined ^ 020446 3000 2924 020447 4761 JMS RPDSW1 /GET MODE OF CHARACTER /A017 2925 TAD I X3 /GET THE CURRENT BLOCK OFFSET undefined ^ undefined ^ 020450 1400 2926 020451 1106 A1, TAD M376 /MINUS # OF WORDS IN A BLOCK (254) 2927 020452 7500 SMA /SKIP WITH DESCRIPTOR PTR -400 2928 020453 5251 JMP A1 /BIG DOC., REPEAT 2929 020454 1131 TAD T400 /CONVERT TO POSITIVE WORD OFFSET 2930 /AC = OFFSET TO BLOCK JUST WRITTEN 2931 020455 1360 TAD (RPPGDS /PLUS START OF OUR SCROLL BUFFER 2932 020456 3265 DCA DESCOF /DESCOF => PTR TO APPRO. DESCRIPTOR 2933 TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 undefined ^ undefined ^ 020457 1400 2934 020460 0000 CDFRPB /GET TO OUR BUFFER FIELD 2935 020461 3665 DCA I DESCOF /UPDATE DESCRIPTOR WORD IN SCROLL BUFFER 2936 020462 0000 CDFMYF /BACK TO OUR FIELD 2937 DCA I T3 /CLEAR DESC. SAVE AREA FOR NEXT /A030 undefined ^ undefined ^ 020463 3400 2938 020464 5640 JMP I RPDSWD /EXIT: BUFFER UPDATED; WRITE OUT 2939 2940 / OUR BUFFER WHEN PARELLEL DOC. HDR. BLK. GET'S WRITTEN OUT 2941 2942 020465 0000 DESCOF, 0 /RPPGDS BUFFER DESCRIPTOR WORD OFFSET 2943 2944 /RPPGDS SCROLL HEADER BUFFER CONTROL AREA: 2945 2946 020466 7400 RPBFCB, RPPGDS /SCROLL BUFFER ADDRESS IN FIELD 2 2947 020467 0000 RPHDBN, 0 /POINTER TO CURRENT RPPGDS BLOCK IN THE BUFFER : 2948 /THE POINTER IS ADDR. OF ONE OF THE FOLLOWING 2949 2950 020470 0000 RPHDRB, 0 /FIRST HEADER BLOCK NUMBER 2951 020471 0000 0 /SECOND 2952 020472 0000 0 /THIRD 2953 020473 0000 0 /SO ON TO THE 17TH 2954 020474 0000 0 2955 020475 0000 0 2956 020476 0000 0 2957 020477 0000 0 2958 020500 0000 0 2959 020501 0000 0 2960 020502 0000 0 2961 020503 0000 0 2962 020504 0000 0 2963 020505 0000 0 2964 020506 0000 0 2965 020507 0000 0 2966 020510 0000 0 2967 020511 0000 0 2968 020512 0000 RPHMD, 0 /TERMINATOR /M007 2969 2970 WRITEOUT, 2971 XX /SAVE CALLERS RETURN ADDRESS /A031 undefined ^ 020513 0000 2972 020514 4765 JMS RPQRX /WRITE THE ALLOCATION BLOCK /A031 2973 RXERT /FC 0 /A031 undefined ^ 020515 0000 2974 020516 0000 0 /DUMMY BUFFER ADDRESS /A031 2975 020517 5713 JMP I WRITEOUT /RETURN TO CALLER /A031 2976 2977 CKSAME, XX /ROUTINE TO CHECK TO SEE IF THE DOCUMENT/A044 undefined ^ 020520 0000 2978 /HEADER BLOCK TO BE RESTORED DURING A /A044 2979 /RESTORE SYSTEM FILE POINTERS CALL IS /A044 2980 /ALREADY IN CORE /A044 2981 DCA T1 /SAVE THE ONE WE WANT /A044 undefined ^ undefined ^ 020521 3000 2982 TAD T1 /GET IT BACK AND /A044 undefined ^ undefined ^ 020522 1000 2983 020523 7041 CIA /NEGATE IT /A044 2984 020524 1757 TAD SCHDBN /ADD IN THE ONE WE HAVE ALREADY /A044 2985 020525 7650 SNA CLA /SKIP IF THEY ARE DIFFERENT /A044 2986 020526 2320 ISZ CKSAME /ELSE TAKE THE SKIP RETURN TO BYPASS /A044 2987 / ..THE UNNECESSARY READ /A044 2988 TAD T1 /GET THE HDR BLK # WE WANT BACK /A044 undefined ^ undefined ^ 020527 1000 2989 020530 3757 DCA SCHDBN /& PUT IT IN AS THE CURRENT /A044 2990 020531 5720 JMP I CKSAME /RETURN TO CALLER /A044 2991 2992 /--------------- 2993 020557 3052 PAGE 020560 7400 020561 0351 020562 0131 020563 1000 020564 2542 020565 0600 020566 7412 020567 6012 020570 7411 020571 6011 020572 7410 020573 6010 020574 7405 020575 6005 020576 3053 020577 2553 2994 2995 / here to make a request for IO... 2996 / 2997 020600 0000 RPQRX, 0 /INTERNAL CALLER'S RETURN ADDR. 2998 020601 0000 CDFMYF /HERE FOR ROOM /A029 2999 020602 3777 DCA SCQBLK+RXQBLK /BLOCK #, IF THERE IS ONE 3000 020603 1376 TAD (CDFRPB) / GET RPPGDS BUFFER FIELD. /M028 3001 DCA SCQBLK+RXQBFD /SUPPLY FIELD undefined ^ 020604 3775 3002 020605 1600 TAD I RPQRX /GET FUNCTION CODE 3003 DCA SCQBLK+RXQFNC /SUPPLY FUNCTION CODE undefined ^ 020606 3775 3004 020607 2200 ISZ RPQRX /BUMP TO GET BUFFER ADDR. 3005 020610 1600 TAD I RPQRX /GET RPPGDS BUFFER ADDR. 3006 DCA SCQBLK+RXQBAD /SUPPLY BUFFER ADDR. undefined ^ 020611 3775 3007 020612 2200 ISZ RPQRX /BUMP TO RETURN ADDR. 3008 3009 CIFSYS undefined ^ 020613 0000 3010 ENQUE undefined ^ 020614 0000 3011 020615 2537 SCQUBL 3012 3013 RPQRX1, CIFSYS undefined ^ 020616 0000 3014 JWAIT undefined ^ 020617 0000 3015 TAD SCQBLK+RXQCOD undefined ^ 020620 1775 3016 020621 7450 SNA 3017 020622 5216 JMP RPQRX1 3018 020623 7500 SMA 3019 020624 7200 CLA 3020 020625 5600 JMP I RPQRX /EXIT:IO COMPLETED 3021 3022 / here only after a block has been allocated to RPPGDS 3023 / initialize the RPPGDS "scroll" buffer (7400) words to -1 3024 3025 / initialize the first two words to imitate a standard WPS 3026 / "fixed" block. 3027 / word 0 = -255 entries in this block 3028 / word 1 = 0070 (ID code ) 3029 / 3030 / clear the extension block pointers (words 2&3) 3031 3032 020626 0000 RPBFIN, 0 /RETURN ADDR TO CALLER 3033 020627 1374 TAD (RPPGDS-1 /START ADDR. -1 3034 DCA X3 /INIT. AUTO INDEX REG. TO RPPGDS BUFFER undefined ^ undefined ^ 020630 3000 3035 TAD (COSCNT /-255 VALUE FOR 1ST WORD undefined ^ undefined ^ 020631 1376 3036 020632 0000 CDFRPB /GET TO OUR BUFFER FIELD 3037 DCA I X3 /SET 1ST WORD TO -255 undefined ^ undefined ^ 020633 3400 3038 020634 1373 TAD (0070 /OUR UNIQUE ID CODE 3039 DCA I X3 /INTO 2ND WORD undefined ^ undefined ^ 020635 3400 3040 DCA I X3 /AND CLEAR THE EXTENSION BLOCK undefined ^ undefined ^ 020636 3400 3041 DCA I X3 /POINTERS undefined ^ undefined ^ 020637 3400 3042 3043 020640 1372 TAD (7404 /NEG. 252 WORD COUNTER 3044 020641 3250 DCA RPTEM1 /RPTEM1 => NEG. WORD COUNTER 3045 B, AC7777 /AC => -1 undefined ^ 020642 0000 3046 DCA I X3 /ADVANCE PTR. AND THEN SET A WORD TO -1 undefined ^ undefined ^ 020643 3400 3047 020644 2250 ISZ RPTEM1 /SKIP IF ALL RPPGDS BUFFER WORDS INIT'D. 3048 020645 5242 JMP B /NOT DONE, SO LOOP... 3049 3050 020646 0000 CDFMYF /BACK TO THIS FIELD 3051 020647 5626 JMP I RPBFIN /EXIT: RPPGDS SCROLL BUFFER INIT'D TO -1 3052 /EXCEPT WORD 0 (-255) AND WORD 1 (0070) 3053 /AND 2&3 (0) 3054 3055 020650 0000 RPTEM1, 0 /TEMP. MUST BE ON THIS PAGE /M046 3056 3057 / here to free a block pertaining to a corrupted RPPGDS 3058 3059 / ON ENTRY: AC = BLOCK # TO FREE 3060 3061 020651 0000 RPDSFR, 0 /SAVE RETURN TO CALLER 3062 020652 4200 JMS RPQRX /INTERNAL REQ. TO FREE A BLOCK 3063 RXEFR /FC 6 = FREE A BLOCK undefined ^ 020653 0000 3064 020654 0000 0 /DUMMY 3065 020655 7200 CLA /INSURE A CLEARED AC 3066 020656 5651 JMP I RPDSFR /EXIT: BLOCK HAS BEEN FREED 3067 3068 / here to clear all extension blocks associated with a corrupted MAIN 3069 / RPPGDS... 3070 3071 020657 0000 RPDSCR, 0 /RETURN ADDR. 3072 020660 1371 TAD (RPHDRB /START WITH THE 1ST EXTN. BLOCK 3073 DCA X3 /X3 => PTR. TO BLOCK TO BE FREED undefined ^ undefined ^ 020661 3000 3074 TAD X3 / undefined ^ undefined ^ 020662 1000 3075 DCA X4 /X4 => PTR. TO TABLE ENTRY THAT CONTAINED FREED BLK. undefined ^ undefined ^ 020663 3000 3076 3077 RPFRDS, TAD I X3 /GET BLOCK # TO BE FREED undefined ^ undefined ^ 020664 1400 3078 020665 7450 SNA /SKIP IF THERE IS ONE 3079 020666 5271 JMP RPENDS /DO UNTIL PHYSICAL END OF TABLE 3080 020667 4251 JMS RPDSFR /GO FREE A BLOCK 3081 DCA I X4 /TAKE BLOCK OUT OF TABLE undefined ^ undefined ^ 020670 3400 3082 3083 RPENDS, TAD X3 /NEXT ENTRY TO GET BLOCK # FROM undefined ^ undefined ^ 020671 1000 3084 020672 7001 IAC / /A007 3085 020673 1370 TAD (-RPHMD /TEST PHYSICAL END AND NOT NULL 3086 3087 /ENTRY IN CASE ENTIRE TABLE FILLED AND RPHMD 3088 /WORD NOT NULL... 3089 020674 7640 SZA CLA /SKIP IF ALL BLOCKS FREED 3090 020675 5264 JMP RPFRDS /GO DO ANOTHER ENTRY 3091 020676 5657 JMP I RPDSCR /EXIT:RPPGDS AND ALL EXTENSIONS FREED 3092 3093 / during the CLOSE procedure, perform the same housekeeping 3094 / on the RPPGDS blocks that is done to the DOC. HEADER blocks... 3095 3096 020677 0000 RPGETR, 0 /CALLER'S RETURN ADDR. 3097 020700 1767 TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. 3098 AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET undefined ^ undefined ^ 020701 0000 3099 020702 1366 TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. 3100 020703 3323 DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD 3101 3102 020704 0000 CDFRPB /GET THE RPPGDS DATA FIELD 3103 020705 1723 TAD I RPGTR1 /GET OUR PARRELLEL WORD 3104 020706 0000 CDFMYF /BACK TO THIS FIELD 3105 020707 3324 DCA RPPTR1 /AND SAVE IT FOR PUT LATER... 3106 020710 5677 JMP I RPGETR /EXIT:RPPGDS WORD ALSO AVAILABLE 3107 3108 020711 0000 RPPUTR, 0 /CALLER'S RETURN ADDR. 3109 020712 1767 TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. 3110 AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET undefined ^ undefined ^ 020713 0000 3111 020714 1366 TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. 3112 020715 3323 DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD 3113 020716 1324 TAD RPPTR1 /GET RPPGDS WORD SAVED DURING GET 3114 020717 0000 CDFRPB /RPPGDS SCROLL BUFFER FIELD 3115 020720 3723 DCA I RPGTR1 /PUT WORD IN PARRELLEL RPPGDS LOCATION 3116 020721 0000 CDFMYF /BACK TO THIS FIELD 3117 020722 5711 JMP I RPPUTR /EXIT:PARRELLEL RPPGDS WORD UPDATED 3118 3119 020723 0000 RPGTR1, 0 /POINTER TO PARRELLEL RPPGDS WORD 3120 020724 0000 RPPTR1, 0 /PUT RPPGDS CHAR. HERE;GET RPPGDS CHAR. FROM HERE 3121 3122 SPCTAB, /12 BIT SPECIALS TO 6-BIT TRANSLATION TABLE 3123 020725 7727 7727 /LINE MODIFIED (CMD 6) 3124 020726 7707 7707 /ENTER COMPOSITE (CMD &) 3125 020727 7706 7706 /TAB (CMD %) 3126 020730 7713 7713 /END OF LINE (CMD *) 3127 020731 7721 7721 /A016 3128 020732 7714 7714 /END OF PAGE (CMD +) 3129 020733 7710 7710 /EXIT COMPOSITE (CMD ') 3130 020734 7730 7730 /START OF A RULER (CMD 7) 3131 020735 7731 7731 /END OF A RULER (CMD 8) 3132 3133 COSTAB, /12-BIT MODES INTO 6-BIT TRANSLATION TABLE 3134 020736 0074 74 /SHIFT 3135 020737 0076 76 /UNSHIFT 3136 020740 7703 7703 /EXIT BOLD (CMD ") 3137 020741 7702 7702 /ENTER BOLD (CMD !) 3138 020742 7705 7705 /EXIT UNDERLINE (CMD $) 3139 020743 7704 7704 /ENTER UNDERLINE (CMD #) 3140 020744 7716 7716 /EXIT SUPERSCRIPT (CMD -) 3141 020745 7715 7715 /ENTER SUPERSCRIPT (CMD ,) 3142 020746 7720 7720 /EXIT SUBSCRIPT (CMD /) 3143 020747 7717 7717 /ENTER SUBSCRIPT (CMD .) 3144 020750 7712 7712 /EXIT AUX. (CMD )) 3145 020751 7711 7711 /ENTER AUX. (CMD () 3146 3147 MAXCOS=.-COSTAB /# OF MODES 3148 020752 0000 0 /END OF TABLE 3149 3150 3151 / /A042 3152 / WPFILS FUNCTION TO SET SCTOP,SCTPH /A042 3153 / DOES NO DISK I/O /A042 3154 / /A042 3155 RRSCTP, XX /A042 undefined ^ 020753 0000 3156 020754 3132 DCA SCTOP /A042 3157 020755 7501 MQA /A042 3158 020756 3135 DCA SCTPH /A042 3159 020757 5753 JMP I RRSCTP /A042 3160 3161 3162 /--------------- 3163 020766 7400 PAGE 020767 2044 020770 7266 020771 0470 020772 7404 020773 0070 020774 7377 020775 2542 020776 0000 020777 2553 3164 3165 / read the RPPGDS block into our scroll buffer (7400) 3166 / then determine if the descriptor words reflect an up-to-date 3167 / text block content... 3168 / 3169 / ON ENTRY: AC => BLK # OF RPPGDS 3170 / ON EXIT : AC => 0 WHEN RPPGDS OK 3171 / AC => NOT 0 WHEN RPPGDS CORRUPTED 3172 3173 021000 0000 RPRDIT, 0 /CALLER'S RETURN ADDR. 3174 021001 0000 CDFMYF /A032 3175 021002 3143 DCA NEWBLK /SAVE BLOCK # TO BE READ /A019 3176 021003 1777 TAD RPHDBN /GET PTR. TO BLOCK # THAT IS CURRENTLY ACTIVE 3177 021004 7450 SNA / IS IT ZERO? /A011 3178 021005 5221 JMP RPDORD / YES, DON'T WRITE OUT OLD HEADER /A011 3179 021006 3356 DCA TMPPTR /FOR INDIRECT THRU THIS PAGE 3180 021007 1756 TAD I TMPPTR /GET THE BLOCK # 3181 021010 7041 CIA /FOR COMPARE /A007 3182 021011 1143 TAD NEWBLK /ALREADY IN BUFFER? /A007/M019 3183 021012 7650 SNA CLA /SKIP IF NOT /A007 3184 021013 5600 JMP I RPRDIT /RETURN IF SO /A007 3185 021014 1756 TAD I TMPPTR /ACTIVE BLOCK # /A007 3186 3187 021015 4776 JMS RPQRX /GO WRITE IT TO DISK 3188 021016 2004 RXEWT+2000 /WRITE AND VERIFY F.C. 3189 021017 7400 RPPGDS /ADDR. OF BUFFER 3190 021020 7200 CLA 3191 3192 021021 1143 RPDORD, TAD NEWBLK /REPLACE BLOCK # TO BE READ /M019 3193 021022 4776 JMS RPQRX /"INTERNAL" REQUEST TO READ RPPGDS BLOCK 3194 RXERD /FC 3 = READ LOG. BLOCK undefined ^ 021023 0000 3195 021024 7400 RPPGDS /PTR TO OUR SCROLL BUFFER 3196 3197 / BEGIN THE VERIFICATION PROCESS: 3198 / 3199 / if this document was OPENed by a V2.n WPS then the 2nd word 3200 / of this block should contain the unique ID code of 0070 3201 / else this block used for other than RPPGDS descriptor words 3202 3203 021025 1375 TAD (-0070 /NEG. RPPGDS ID CODE 3204 021026 0000 CDFRPB /SCROLL BUFFER DF 3205 021027 1774 TAD I (RPPGDS+1 /COMPARE TO 2ND WORD OF RPPGDS BLOCK 3206 021030 0000 CDFMYF /BACK TO THIS FIELD 3207 021031 7440 SZA /SKIP IF THIS IS THE RPPGDS BLOCK 3208 021032 5600 JMP I RPRDIT /AC => NOT 0 ERROR RETURN 3209 3210 / if the # of blocks allocated to this document is the same for 3211 / both the doc. header block and the RPPGDS block, then this 3212 / RPPGDS block ok 3213 / else this document was used on a system that did not contain 3214 / V2.n GOTO PAGE software. 3215 / The RPPGDS descriptor words are not the most current 3216 / reflection of the text blocks within this document. 3217 3218 021033 1143 TAD NEWBLK /GTP BLK # JUST READ /A034 3219 021034 7041 CIA /FOR COMPARES /A034 3220 021035 1777 TAD RPHDBN /MAIN GTP BLK# OR 0 FOR OPENING DOC. /A034 3221 021036 7440 SZA /SKIP TO VERIFY MAIN GTP BLK /A034 3222 021037 1143 TAD NEWBLK /SEE IF RPHDBN WAS 0 FOR OPENING /A034 3223 021040 7640 SZA CLA /SKIP TO VERIFY MAIN GTP BLK /A034 3224 021041 5600 JMP I RPRDIT /DON'T VERIFY EXTENSIONS 3225 3226 021042 0000 CDFBUF /SCROLL BUFFER DF 3227 021043 1773 TAD I (SCHDR+5 /# OF BLOCK ALLOCATED TO THIS DOC. 3228 021044 7041 CIA /MAKE NEG. FOR COMPARE 3229 021045 0000 CDFRPB /OUR BUFFER FIELD 3230 021046 1772 TAD I (RPPGDS+5 /COMPARE TO ITS RPPGDS COUNTER-PART 3231 021047 0000 CDFMYF /BACK TO THIS FIELD 3232 021050 7440 SZA /SKIP IF # OF BLOCK THE SAME 3233 021051 5600 JMP I RPRDIT /ERROR EXIT: AC NOT = 0 3234 3235 / if the DAY-MONTH-YEAR of both the doc. header block and the 3236 / RPPGDS block match, then this document CLOSED by a V2.n 3237 / system. 3238 / else this document used by a system not containing V2.n 3239 / GOTO PAGE software. 3240 3241 021052 0000 CDFBUF /SCROLL BUFFER FIELD 3242 021053 1771 TAD I (SCHDR+10 /DAY-MONTH 3243 021054 7041 CIA /MAKE NEG. FOR COMPARE 3244 021055 0000 CDFRPB /OUR BUFFER FIELD 3245 021056 1770 TAD I (RPPGDS+10 /GET COUNTERPART 3246 021057 0000 CDFMYF /BACK TO THIS FIELD 3247 021060 7440 SZA /SKIP IF A MATCH 3248 021061 5600 JMP I RPRDIT /ERROR EXIT:AC NOT = 0 3249 021062 0000 CDFBUF /SCROLL BUFFER FIELD 3250 021063 1767 TAD I (SCHDR+11 /LAST 2 DIGITS OF YEAR VALUE 3251 021064 7041 CIA /CONVERT TO NEG. FOR COMPARE 3252 021065 0000 CDFRPB /OUR BUFFER FIELD 3253 021066 1766 TAD I (RPPGDS+11 /GET COUNTERPART 3254 021067 0000 CDFMYF /BACK TO THIS FIELD 3255 021070 7440 SZA /SKIP IF YEAR VALUES AGREE 3256 021071 5600 JMP I RPRDIT /ERROR EXIT: AC NOT = 0 3257 3258 / 4) IF THIS DOC. WAS OPENED BY A V2.0 OR LATER WPS 3259 / THEN THE START TIME OF THE LAST EDIT CYCLE SHOULD BE 3260 / THE SAME IN BOTH BLOCKS... 3261 3262 021072 0000 CDFBUF /SCROLL BUFFER FIELD 3263 021073 1765 TAD I (SCHDR+12 /START TIME OF LAST EDIT 3264 021074 7041 CIA /NEG. VALUE FOR COMPARE 3265 021075 0000 CDFRPB /OUR BUFFER FIELD 3266 021076 1764 TAD I (RPPGDS+12 /GET THE COUNTERPART 3267 021077 0000 CDFMYF /BACK TO THIS FIELD 3268 021100 5600 JMP I RPRDIT /EXIT W/AC CONTAINING RESULT 3269 3270 / here after a TEXT block has been written to diskette. 3271 / locate the scroll buffer used and read its contents, looking 3272 / for repositioning information and mode. 3273 3274 021101 0000 RPSPLT, 0 /NEG. = "SPLIT" ESC SEQ. 3275 / POS. = NORMAL 2 CHAR. SEQ. 3276 /I.E., 1277 1250 7713 3377 1477 3277 021102 0000 RPENDB, 0 /BUFFER CHAR. COUNTER 3278 3279 021103 0000 RPDSBD, 0 /SAVE CALLERS' RETURN ADDR. 3280 AC0001 / /A030 undefined ^ 021104 0000 3281 021105 3356 DCA TMPPTR /FIRST-TIME THRU ETX FLAG /A030 3282 021106 3140 DCA SOMFLG /CLEAR FIRST-TIME THRU STX FLAG /A030 3283 021107 1106 TAD M376 /SET UP A NEG. 254 WORD COUNTER /M021 3284 021110 3302 DCA RPENDB /TO END DESCRIPTOR WORD BUILD 3285 3286 TAD T3 / DESC. BEING USED /A030 undefined ^ undefined ^ 021111 1000 3287 021112 1363 TAD (-ETXDES /IS IT ETX? /A030 3288 021113 7640 SZA CLA /SKIP TO PROCESS ETX BUFFER CHARS. 3289 021114 1131 TAD T400 /BUMP TO PROCESS STX BUFFER CHARS. 3290 021115 1362 TAD (SCEB+BOFSET-1 /INIT. BUFFER WORD POINTER 3291 DCA X3 /TO WORD IMMEDIATELY BEFORE 1ST WORD undefined ^ undefined ^ 021116 3000 3292 3293 021117 1301 DSBDST, TAD RPSPLT /GET "SPLIT" ESC SEQ. FLAG 3294 AND P7700 /GET THE ESC CHAR. undefined ^ undefined ^ 021120 0000 3295 021121 1102 TAD M7700 /COMPARE TO ESC CODE /M021 3296 021122 7640 SZA CLA /SKIP TO PROCESS "SPLIT" ESC 3297 021123 5335 JMP DSBDWD /JUMP TO PROCESS NORMAL WORD 3298 021124 0000 CDFBUF /SCROLL BUFFER FIELD 3299 TAD I X3 /GET THE CURRENT BUFFER WORD undefined ^ undefined ^ 021125 1400 3300 021126 0000 CDFMYF /BACK TO OUR FIELD 3301 021127 7002 BSW /USE BITS 6-11 FOR "SPLIT" FLAG 3302 021130 3301 DCA RPSPLT /UPDATE FLAG AND MAKE A COPY OF CURRENT WORD 3303 021131 1301 TAD RPSPLT /GET THE CURRENT BUFFER WORD 3304 AND P77 /OUR SECOND HALF OF ESC SEQ. undefined ^ undefined ^ 021132 0000 3305 TAD P7700 /SUPPLY THE ESC. CHAR. /M021 undefined ^ undefined ^ 021133 1000 3306 021134 5761 JMP DOESC+1 /GO PROCESS ESC SEQ. IN AC /M021 3307 3308 021135 0000 DSBDWD, CDFBUF /SCROLL BUFFER FIELD 3309 TAD I X3 /GET THE CURRENT BUFFER WORD undefined ^ undefined ^ 021136 1400 3310 021137 0000 CDFMYF /BACK TO THIS FIELD 3311 021140 7421 MQL /SAVE WORD IN MQ /A021 3312 021141 7701 ACL /RESTORE CHAR /A021 3313 AND P7700 /GET THE ESC CHAR /A021 undefined ^ undefined ^ 021142 0000 3314 021143 1102 TAD M7700 /COMPARE TO ESC CODE /A021 3315 021144 7450 SNA /SKIP IF NORMAL /M021 3316 021145 5760 JMP DOESC /GO PROCESS ESC SEQ. IN AC 3317 021146 7701 ACL /RESTORE CHAR /A021 3318 021147 7002 BSW /LOOKING FOR "SPLIT" ESC SEQ. 3319 021150 3301 DCA RPSPLT /IF ESC CHAR., FLAG IS NOW NEG. 3320 3321 021151 2302 DSBDEX, ISZ RPENDB /BUMP BUFFER CHAR. COUNTER 3322 021152 5317 JMP DSBDST /READ ANOTHER BUFFER WORD 3323 021153 4757 JMS RPDSWD /PUT CURRENT DESCRIPTOR WORD IN RPPGDS 3324 021154 3301 DCA RPSPLT /CLEAR SPLIT FLAG FOR EACH BLOCK /A038 3325 021155 5703 JMP I RPDSBD /AND EXIT: THIS TEXT BLOCK HAS A NEW DESCRIPTOR WORD 3326 3327 021156 0000 TMPPTR, 0 /POINTER ON THIS PAGE TO ACCESS BLOCK CONTROL TABLE 3328 /--------------- 3329 021157 0440 PAGE 021160 1210 021161 1211 021162 6401 021163 5214 021164 7412 021165 6012 021166 7411 021167 6011 021170 7410 021171 6010 021172 7405 021173 6005 021174 7401 021175 7710 021176 0600 021177 0467 3330 3331 021200 0000 RPMODE, 0 /BUILD OUR OWN MODE BYTE 3332 021201 0000 RPPCTLFL, 0 /PRINT-CONTROL STATE FLAG /A030 3333 3334 TORPDSBD, XX /INIT. DESC. WORD AND BIT 5 /A030 undefined ^ 021202 0000 3335 ISZ T3 /BUMP TO STX/ETX DESC. WORD /A030 undefined ^ undefined ^ 021203 2000 3336 021204 1201 TAD RPPCTLFL/CONTENTS OF PRINT-CONTROL FLAG /A030 3337 DCA I T3 /INIT. APPROPRIATE DESC WORD /A030 undefined ^ undefined ^ 021205 3400 3338 021206 4777 JMS RPDSBD /IDENTIFY/RECORD PERTINENT ESC /A030 3339 021207 5602 JMP I TORPDSBD/CONTINUE PUT PROCESS /A030 3340 3341 / RPDESC bit assigmnents: /M012 3342 / 3343 / 0 1 2 3 4 5 6 7 8 9 10 11 3344 / R J S U B C U P P P P P 3345 / A S 3346 / 3347 / when bit 'ON': 3348 / R = a RULER starts in this block 3349 / J = Justify 3350 / S = Superscript 3351 / U = Underscore 3352 / B = Bold 3353 / S & U = Subscript 3354 / CA = (Print) Control Area 3355 / US = Unshift 3356 / P = total number of PAGES in this block 3357 / 3358 / determine if this ESC sequence has to be reflected in our text 3359 / block descriptor word. 3360 / 3361 / ON ENTRY: AC contains full 2-char. ESC Sequence... 3362 3363 021210 7701 DOESC, ACL /GET THE CURRENT BUFFER WORD BACK /A021 3364 021211 7041 CIA /MAKE POSITIVE FOR COMPARES 3365 021212 1376 TAD (7730 /COMPARE TO START OF RULER 3366 021213 7450 SNA /SKIP IF NOT START OF RULER 3367 021214 5266 JMP RPSTRL /GO INDICATE THAT THIS BLOCK HAS A RULER 3368 021215 1375 TAD (7720-7730 /EXIT SUBSCRIPT MODE? /A016 3369 021216 7450 SNA /SKIP IF NOT 3370 021217 5311 JMP RPEXSB /GO CLEAR SUBSCRIPT MODE /M030 3371 021220 1374 TAD (7717-7720 /ENTER SUBSCRIPT MODE? 3372 021221 7450 SNA /SKIP IF NOT 3373 021222 5314 JMP RPENSB /GO SET SUBSCRIPT MODE /M030 3374 021223 1374 TAD (7716-7717 /EXIT SUPERSCRIPT MODE? 3375 021224 7450 SNA /SKIP IF NOT 3376 021225 5273 JMP RPEXSU /GO CLEAR SUPERSCRIPT MODE 3377 021226 1374 TAD (7715-7716 /ENTER SUPERSCRIPT MODE? 3378 021227 7450 SNA /SKIP IF NOT 3379 021230 5276 JMP RPENSU /GO SET SUPERSCRIPT MODE 3380 021231 1374 TAD (7714-7715 /COMPARE TO END PAGE SEQUENCE 3381 021232 7450 SNA /SKIP IF NOT 3382 021233 5243 JMP RPPGMK /FLAG PAGE MARK IN DESCRIPTOR 3383 3384 / now check for MODE.... 3385 3386 021234 1373 TAD (7712-7714 /EXIT AUX. MODE? 3387 021235 7450 SNA /SKIP IF NOT 3388 021236 5302 JMP RPEXAU /GO CLEAR AUX. BIT 3389 021237 1374 TAD (7711-7712 /ENTER AUX. MODE? 3390 021240 7650 SNA CLA /SKIP IF NOT 3391 021241 5305 JMP RPENAU /GO SET AUX. BIT 3392 021242 5772 JMP DSBDEX /EXIT: 3393 3394 / ESC. sequence was end of page. This type of sequence with MODE 3395 / equal NONE represents a NEW PAGE MARK, or, this sequence with 3396 / AUX. set represents a PAGE MARKER; any other mode is not applicable. 3397 3398 021243 1371 RPPGMK, TAD (1200 /TEST SUPER/SUB SCRIPT /M030 3399 021244 0200 AND RPMODE /IN CURRENT MODE /M030 3400 021245 7640 SZA CLA /SKIP IF NEITHER (PAGE MARK) /M030 3401 021246 5251 JMP CHCNTL /JUMP IF PRINT CONTROL INFO /M030 3402 ISZ I T3 /REFLECT PAGE MARKER /M030 undefined ^ undefined ^ 021247 2400 3403 021250 5772 JMP DSBDEX /RETURN TO NORMAL PUT PROCESS /M030 3404 3405 021251 1770 CHCNTL, TAD TMPPTR /TEST FIRST-TIME THRU ETX FLAG /A030 3406 021252 7650 SNA CLA /SKIP IF 1ST TIME THRU /A030 3407 021253 5772 JMP DSBDEX /CONTINUE PUT PROCESS /A030 3408 TAD T3 /POINTER TO CURRENT DESC. WORD /A030 undefined ^ undefined ^ 021254 1000 3409 021255 1367 TAD (-ETXDES /COMPARE TO ETX /A030 3410 021256 7640 SZA CLA /SKIP IF ETX BUFFER /A030 3411 021257 5102 JMP CHKSTX / PROCESS STX /A030 3412 021260 3770 DCA TMPPTR /CLEAR FIRST TIME THRU FLAG /A030 3413 AC0001 / /A030 undefined ^ 021261 0000 3414 021262 3140 DCA SOMFLG /FORCE ETX EXIT /A030 3415 021263 1366 TAD (200 /END PRINT-CONTROL MASK /A030 3416 021264 0200 AND RPMODE /TEST CURRENT MODE /A030 3417 021265 5073 JMP CHKETX /CONTINUE TO PROCESS ETX OFF PAGE /A030 3418 3419 RPSTRL, TAD P3777 /MAKE SURE RULER PRESENT BIT OFF undefined ^ undefined ^ 021266 1000 3420 AND I T3 /BEFORE WE SET IT /M030 undefined ^ undefined ^ 021267 0400 3421 021270 1365 TAD (4000 /SET RULER IN THIS BLOCK BIT 3422 DCA I T3 /UPDATE DESCRIPTOR WORD /M030 undefined ^ undefined ^ 021271 3400 3423 021272 5772 JMP DSBDEX /EXIT: RETURN TO NORMAL PUT-PROCESS 3424 3425 / ESC sequence was EXIT SUPER/SUBSCRIPT mode.... /A012 3426 3427 021273 1364 RPEXSU, TAD (6777 /CLEAR SUPER-SCRIPT (1000) /C030 3428 021274 0200 AND RPMODE /SAVE OTHER MODE BITS 3429 021275 5317 JMP MODEXT /GO UPDATE MODE AND EXIT 3430 3431 / ESC sequence was ENTER SUPER/SUBSCRIPT mode.... /A012 3432 3433 021276 1364 RPENSU, TAD (6777 /MAKE SURE SUPER-SCRIPT BIT OFF /C030 3434 021277 0200 AND RPMODE /BEFORE WE SET IT 3435 021300 1363 TAD (1000 /SET SUPER/SUBSCRIPT MODE BIT 3436 021301 5317 JMP MODEXT 3437 3438 / ESC sequence was EXIT AUX. mode... 3439 3440 021302 1362 RPEXAU, TAD (5777 /CLEAR AUX. MODE BIT (2000) 3441 021303 0200 AND RPMODE /SAVE OTHER MODE BITS 3442 021304 5317 JMP MODEXT /GO UPDATE MODE AND EXIT 3443 3444 / ESC sequence was ENTER AUX. mode... 3445 3446 021305 1362 RPENAU, TAD (5777 /MAKE SURE AUX. MODE-ON BIT IS OFF 3447 021306 0200 AND RPMODE /BEFORE WE SET IT 3448 021307 1361 TAD (2000 /SET AUX. MODE BIT 3449 021310 5317 JMP MODEXT /GO UPDATE MODE AND EXIT 3450 3451 / ESC sequence was EXIT BOLD mode... 3452 3453 021311 1360 RPEXSB, TAD (7577 /CLEAR SUB-SCRIPT MODE BIT (0200) /M030 3454 021312 0200 AND RPMODE /SAVE OTHER MODE BITS 3455 021313 5317 JMP MODEXT /GO UPDATE MODE AND EXIT 3456 3457 / ESC sequence was ENTER BOLD mode... 3458 3459 021314 1360 RPENSB, TAD (7577 /MAKE SURE SUB-SCRIPT MODE BIT OFF /M030 3460 021315 0200 AND RPMODE /BEFORE WE SET IT 3461 021316 1366 TAD (200 /SET BOLD MODE 3462 3463 021317 3200 MODEXT, DCA RPMODE /UPDATE OUR MODE WORD 3464 021320 5772 JMP DSBDEX /AND RETURN TO CONTINUE 3465 3466 RPTRS1, XX undefined ^ 021321 0000 3467 021322 3132 DCA SCTOP /BACK FOR EDITOR 3468 021323 1150 TAD EDHDR /PREVIOUS ACTIVE HEADER BLOCK 3469 021324 3135 DCA SCTPH /INTO TOP HEADER POINTER 3470 021325 1333 TAD EDHDR1 /GET ORIGINAL 'BOTTOM' HDR ID 3471 021326 3134 DCA SCBTH /BACK FOR EDITOR 3472 021327 1334 TAD EDSCBK /GET HDR BLK # THAT'S IN CORE 3473 021330 4757 JMS CKSAME /SEE IF WE NEED TO READ (NORMAL RETURN) /A044 3474 /OR DO WE ALREADY HAVE (SKIP) /A044 3475 / ... THE CORRECT DOCUMENT HEADER BLOCK IN CORE /A044 3476 /D044 DCA SCHDBN /BACK FOR EDITOR 3477 /note -- don't save and restore the current rppgds block in the buffer 3478 021331 4756 JMS SCGTWR 3479 021332 5721 JMP I RPTRS1 /RETURN 3480 3481 021333 0000 EDHDR1, 0 /USED TO SAVE/RESTORE SCBTH HDR ID 3482 021334 0000 EDSCBK, 0 /USED TO SAVE/RESTORE HDR BLK # THAT'S IN CORE 3483 3484 3485 / /A042 3486 / /A042 3487 / SUBR RPTPDS -- Rapid Paging get ToP goto-page DeScriptor word /A042 3488 / /A042 3489 / Gets GOTO-PAGE descriptor word of block currently defined by /A042 3490 / top pointers SCTOP,SCTPH. /A042 3491 / Probably reads appropriate GOTO-PAGE header block if it's not /A042 3492 / currently loaded in the RPPGDS buffer. /A042 3493 / /A042 3494 / CALL: /A042 3495 / JMS RPTPDS / GET TOP DESCRIPTOR WORD /A042 3496 / / AC = GOTO-PAGE DESCRIPTOR WORD (?FOR BLK IN STX BUFFER?) /A042 3497 / /A042 3498 / /A042 3499 RPTPDS, XX /A042 undefined ^ 021335 0000 3500 021336 4761 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK 3501 021337 0135 SCTPH 3502 021340 0132 SCTOP 3503 3504 AC0002 /IGNORE DOC. HEADER STUFF undefined ^ 021341 0000 3505 /AC := 2 TO GET PAST COS WORDS 1&2 3506 021342 1355 TAD (RPPGDS /OUR BUFFER STARTS HERE 3507 021343 1132 TAD SCTOP /PLUS THE PARELLEL DOC HEADER OFFSET 3508 DCA T1 /SAVE EXTRA WORD /A007 undefined ^ undefined ^ 021344 3000 3509 3510 021345 0000 CDFRPB /GET OUR BUFFER FIELD 3511 TAD I T1 / /A007 undefined ^ undefined ^ 021346 1400 3512 021347 0000 CDFMYF /BACK TO THIS FIELD 3513 /WITH DESCRIPTOR WORD IN AC.... 3514 021350 5735 JMP I RPTPDS /EXIT /A042 3515 3516 3517 /--------------- 3518 021355 7400 PAGE 021356 3076 021357 0520 021360 7577 021361 2000 021362 5777 021363 1000 021364 6777 021365 4000 021366 0200 021367 5214 021370 1156 021371 1200 021372 1151 021373 7776 021374 7777 021375 7770 021376 7730 021377 1103 3519 3520 / 3521 / This code was developed for the exclusive use of the V2 3522 / GOTO PAGE enhancement; it provides for 7 seperate functions: 3523 / 3524 / 1) when AC = -1: Increment top ptrs; Get top G-T-P descriptor word 3525 / 3526 / permits the reading of successive "descriptor words" 3527 / and passes back the current descriptor word within 3528 / the AC for the caller (EDITOR). The main advantage 3529 / of employing this method is the automatic loading 3530 / of sequential doc. header extension blocks and their 3531 / parallel RPPGDS extension blocks. 3532 / 3533 / 2) when AC = -2: Save SYSTEM FILE POINTERS 3534 / 3535 / Saves FILE SYSTEM POINTERS (current position within 3536 / GOTO-PAGE header structure), then 3537 / sets current position to ---TOP--- for function AC=-1. 3538 / If file position is to restored (function AC=-4), then 3539 / do not attempt to scroll to/from disk until 3540 / after calling function AC=-4. 3541 / 3542 / Value returned to EDITOR: 3543 / 3544 / AC= the current number of pages 3545 / contained within the STX buffer. This count will 3546 / be used to calculate the current page being editted. 3547 / 3548 / 3) when AC = -3: Get original and current top pointers 3549 / 3550 / Value supplied on entry: 3551 / 3552 / MQ= Pointer to 2-word save area for current SCTOP & SCTPH 3553 / 3554 / Values returned to the EDITOR: 3555 / 3556 / AC= the original value of SCTOP (saved by func AC=-2) 3557 / (to be used to calculate the current PAGE being edited) 3558 / MQ= the original HDR. ID # (saved by func AC=-2) 3559 / CDFLP;@entry MQ = current value of SCTPH 3560 / CDFLP;@entry MQ = current value of SCTOP 3561 / 3562 / 4) when AC = -4: Restore SYSTEM FILE POINTERS 3563 / 3564 / the calculation of the total number of PAGES within 3565 / this document has been completed. Before returning 3566 / to resume the edit session, return the FILE SYSTEM POINTERS 3567 / to those values saved at the start of the total PAGE 3568 / calculation. It is possible that the HEADER scroll buffer 3569 / and the RPPGDS scroll buffer got overlaid with 3570 / successive extension blocks necessary to count all 3571 / pages within the document. Furthurmore, SCTOP and SCBOT 3572 / were bumped to read successive descriptor words. 3573 / 3574 / 5) when AC = -5: Get current bottom pointers 3575 / 3576 / Values returned to the EDITOR: 3577 / 3578 / AC= current contents of SCBOT 3579 / (so that a determination can be made as to when the 3580 / current block has been read.) 3581 / MQ= current contents of SCBTH 3582 / 3583 / 6) when AC = -6: Get top G-T-P descriptor word; Increment top ptrs 3584 / 3585 / Value supplied on entry: 3586 / 3587 / AC= signed increment for top pointers 3588 / (+- # of blocks to move; may=0) 3589 / 3590 / Value returned to EDITOR: 3591 / 3592 / AC= value of GOTO-PAGE descriptor word for block 3593 / originally pointed to by top pointers (before 3594 / they were incremented) 3595 / 3596 / 7) when AC = positive #: Random-Access OPEN for scrolling 3597 / 3598 / Values supplied on entry: 3599 / 3600 / AC= new SCBOT (header word pointer (offset into hdr blk)) 3601 / MQ= new SCBTH (header block id number) 3602 / 3603 / Initializes the TOP and BOTTOM pointer pairs 3604 / for random access of text blocks. 3605 / The entry AC&MQ together specify which document block 3606 / to open at. After this function, ADVPTR will get characters 3607 / starting at the beginning of the opened block; 3608 / BAKPTR will get characters starting at the end of the 3609 / previous block. 3610 / (This function is used for several purposes. Example: 3611 / positions the pointer pairs at the block in the 3612 / document containing the desired page to reposition 3613 / to.) 3614 / 3615 3616 021400 0000 RPINIT, 0 /CALLER'S RETURN ADDRESS 3617 021401 7510 SPA /SKIP TO SET UP FOR RANDOM READ 3618 021402 5223 JMP RPDSCP /JUMP TO TEST FURTHUR 3619 / 3620 / RANDOM ACCESS OPEN 3621 / 3622 021403 3133 DCA SCBOT /HDR WORD PTR INTO BOTTOM WORD PTR 3623 021404 7501 MQA /GET THE HEADER # 3624 3625 021405 3134 DCA SCBTH /PUT IN BOTTOM HEADER PTR 3626 3627 / THE BOTTOM POINTERS ARE NOW SET FOR RANDOM READ 3628 3629 021406 1133 TAD SCBOT /BOTTOM HDR WORD POINTER 3630 021407 3132 DCA SCTOP /NOW BECOMES THE TOP POINTER 3631 021410 1134 TAD SCBTH /GET THE BOTTOM HEADER POINTER 3632 021411 3135 DCA SCTPH /INTO TOP HEADER NUMBER 3633 021412 4777 JMS SCTOPP /GO DECR. TOP PTRS BY 1 3634 021413 7777 -1 /DECR. FACTOR 3635 3636 / DEPICT AN EMPTY TEXT BUFFER... 3637 3638 021414 3151 DCA SCTPTR /CLEAR STX BUFFER CHAR. POINTER 3639 021415 1376 TAD (SCHCNT-1 /MAX. # OF BUFFER BYTES 3640 021416 3152 DCA SCEPTR /SET EXT BUFFER CHAR. POINTER AT MAX. 3641 3642 / WHEN THE EDITOR REQUESTS A READ OF A CHAR. (LODCHR) FROM 3643 / AN INITIALIZED EDIT BUFFER, WPFILS WILL BE CALLED TO SUPPLY 3644 / A CHAR. FROM THE ETX BUFFER. THE POINTER SET ABOVE WILL 3645 / RESULT IN READING A BLOCK FROM DISK INTO THE ETX BUFFER. 3646 3647 AC0001 /SET Go To page FLaG TO /A012 undefined ^ 021417 0000 3648 021420 3222 DCA GTFLG /INDICATE A GO-TO-PAGE REQUEST /A012 3649 021421 5307 JMP RPINEX /EXIT:POINTERS ALL SET FOR RANDOM READ 3650 3651 021422 0000 GTFLG, 0 /SET TO INDICATE A GO-TO-PAGE REQUEST /A012 3652 3653 RPDSCP, 3654 021423 1120 TAD ONE /SKIP TO READ DESCRIPTOR /M025 3655 021424 7440 SZA / 3656 021425 5232 JMP RPCNT /JUMP TO TEST FURTHUR 3657 / 3658 / the AC was -1...... 3659 / 3660 021426 4777 JMS SCTOPP /CLEARS AC, THEN INCR. TOP POINTER 3661 021427 0001 1 /BY 1 3662 3663 /D042 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK 3664 /D042 SCTPH 3665 /D042 SCTOP 3666 /D042 3667 /D042 AC0002 /IGNORE DOC. HEADER STUFF 3668 /D042 /AC := 2 TO GET PAST COS WORDS 1&2 3669 /D042 TAD (RPPGDS /OUR BUFFER STARTS HERE 3670 /D042 TAD SCTOP /PLUS THE PARRELLE DOC HEADER OFFSET 3671 /D042 DCA T1 /SAVE EXTRA WORD /A007 3672 /D042 3673 /D042 CDFRPB /GET OUR BUFFER FIELD 3674 /D042 TAD I T1 / /A007 3675 /D042 CDFMYF /BACK TO THIS FIELD 3676 /D042 /WITH DESCRIPTOR WORD IN AC.... 3677 3678 021430 4775 JMS RPTPDS /GET TOP GOTO-PAGE DESCRIPTOR WORD /A042 3679 3680 021431 5307 JMP RPINEX /EXIT 3681 3682 3683 021432 1120 RPCNT, TAD ONE /TEST FOR # OF PAGES IN STX BUFFER /M025 3684 021433 7440 SZA /SKIP TO PASS THE # OF PAGES IN THE STX BUFFER 3685 021434 5257 JMP RPTOP /MAY BE REQUEST FOR ORIGONAL SCTOP & HDR ID# 3686 / 3687 / AC was -2..... 3688 / 3689 021435 1132 TAD SCTOP /SAVE POINTER TO CURRENT TOP BLOCK 3690 021436 3147 DCA EDTOPS /AT START OF TOTAL PAGE CALCULATION /M041 3691 021437 1133 TAD SCBOT /AND CURRENT BOTTOM BLOCK POINTER 3692 021440 3146 DCA EDBOTS /M041 3693 021441 1135 TAD SCTPH /SAVE CURRENT 'TOP' HDR ID /A020 3694 021442 3150 DCA EDHDR /A020 3695 021443 1134 TAD SCBTH /SAVE CURRENT 'BOTTOM' HDR ID /A020 3696 021444 3774 DCA EDHDR1 /A020 3697 021445 1773 TAD SCHDBN /SAVE CURRENT HDR BLK # THAT'S IN CORE /A020 3698 021446 3772 DCA EDSCBK /A020 3699 3700 / set-up to enable read of successive descriptor words, /A009 3701 / starting with the 1st descriptor of the 1st RPPGDS block.. /A009 3702 3703 021447 1371 TAD (52 / /A009 3704 021450 3132 DCA SCTOP /INIT'D VALUE /A009 3705 021451 1370 TAD (53 / /A009 3706 021452 3133 DCA SCBOT /INIT'D VALUE /A009 3707 AC0001 / /A009 undefined ^ 021453 0000 3708 021454 3135 DCA SCTPH /1ST HEADER BLOCK ID # /A009 3709 3710 021455 1767 TAD STXMOD+2 /SUPPLY THE # OF PAGE IN STX BUFFER /A018 3711 021456 5307 JMP RPINEX /EXIT 3712 3713 / THE FOLLOWING BLOCK IS ALL SCRAMBLED, SO I'M JUST DELETING IT /A042 3714 / AND REWRITING IT (RATHER THAN ATTEMPTING TO MODIFY IT IN PLACE) /A042 3715 3716 /D042 / the EDITOR wants to know when a new block has been read; /A013 3717 /D042 / so that it knows it has written the previous block into /A013 3718 /D042 / the edit buffer.... /A013 3719 /D042 / AC was - 5....... 3720 /D042 3721 /D042 RPBOT, TAD SCBOT /AC = CURRENT SCBOT /A013 3722 /D042 JMP RPINEX /RETURN TO CALLER /A013 3723 /D042 3724 /D042 RPPTRS, TAD TWO /TEST FOR SCBOT CONTENTS /A013/M025 3725 /D042 SNA CLA /SKIP IF NOT /A013 3726 /D042 JMP RPBOT /JUMP TO SUPPLY SCBOT /A013 3727 /D042 3728 /D042 /AC was -4....... 3729 /D042 3730 /D042 TAD EDBOTS /GET ORIG. SCBOT /M041 3731 /D042 DCA SCBOT /BACK FOR EDITOR 3732 /D042 TAD EDTOPS /SAVED SCTOP /M041 3733 /D042 JMS RPTRS1 / 3734 /D042 3735 /D042 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER 3736 3737 3738 021457 7001 RPTOP, IAC /INCR. MINUS AC /A042 3739 021460 7440 SZA /SKIP IF EDITOR REQUEST FOR SCTOP /A042 3740 021461 5276 JMP RPPTRS /JUMP IF NOT /A042 3741 /A042 3742 / /A042 3743 / AC was -3....... /A042 3744 / /A042 3745 / ON ENTRY: MQ = pointer to caller's save area to /A042 3746 / pass the current SCTOP and HDR ID # /A042 3747 / /A042 3748 / ON EXIT: MQ = HDR ID # at START of relative page /A042 3749 / request /A042 3750 / /A042 3751 / AC = SCTOP at START of relative page /A042 3752 / request /A042 3753 / /A042 3754 / The CURRENT SCTOP and HDR ID # (SCTPH) /A042 3755 / are in the caller's data field /A042 3756 /A042 3757 /D042 TAD SCTOP /CURRENT TOP POINTER /A042 3758 /D042 SWP /MQ = CURRENT TOP /A042 3759 021462 7701 ACL /AC = POINTER TO CALLERS SAVE AREA /A042 3760 DCA X0 /PTR TO SAVE AREA INTO X0 /A042 undefined ^ undefined ^ 021463 3000 3761 021464 1135 TAD SCTPH /CURRENT HDR ID # /A042 3762 CDFLP /FIELD 5 /A042 undefined ^ 021465 0000 3763 DCA I X0 /SAVE CURRENT HDR ID # /A042 undefined ^ undefined ^ 021466 3400 3764 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A042 3765 RRAER1, IFNZRO SCTOP&7600 < ? > /SCTOP MUST BE ON PAGE 0 /A042 3766 /OTHERWISE A CDFMYF IS NEEDED HERE /A042 3767 021467 1132 TAD SCTOP /RETRIEVE CURRENT TOP POINTER /A042 3768 DCA I X0 /TO SAVE FOR COMPARE /A042 undefined ^ undefined ^ 021470 3400 3769 021471 0000 CDFMYF /FIELD 7 /A042 3770 /A042 3771 021472 1150 TAD EDHDR /ORIG. HEADER ID # /A042 3772 021473 7421 MQL /INTO THE MQ /A042 3773 021474 1147 TAD EDTOPS /ORIG. SCTOP /A042 3774 021475 5307 JMP RPINEX /RETURN TO CALLER /A042 3775 /A042 3776 021476 1121 RPPTRS, TAD TWO /A042 3777 / /A042 3778 / AC=+1 == AC WAS -4 /A042 3779 / AC=0 == AC WAS -5 /A042 3780 / AC=-1 == AC WAS -6 /A042 3781 / /A042 3782 021477 7450 SNA /A042 3783 021500 5310 JMP RPBOT /AC WAS = -5 /A042 3784 021501 7710 SPA CLA /A042 3785 021502 5314 JMP RPDSIN /AC WAS = -6 /A042 3786 / /A042 3787 /AC was -4....... /A042 3788 / /A042 3789 021503 1146 TAD EDBOTS /GET ORIG. SCBOT /A042 3790 021504 3133 DCA SCBOT /BACK FOR EDITOR /A042 3791 021505 1147 TAD EDTOPS /SAVED SCTOP /A042 3792 021506 4766 JMS RPTRS1 / /A042 3793 /A042 3794 021507 5600 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER /A042 3795 /A042 3796 / /A042 3797 / AC was -5 ... /A042 3798 / /A042 3799 / the EDITOR wants to know when a new block has been read; /A042 3800 / so that it knows it has written the previous block into /A042 3801 / the edit buffer.... /A042 3802 / /A042 3803 021510 1134 RPBOT, TAD SCBTH /MQ = CURRENT SCBTH /A042 3804 021511 7421 MQL /A042 3805 021512 1133 TAD SCBOT /AC = CURRENT SCBOT /A042 3806 021513 5307 JMP RPINEX /RETURN TO CALLER /A042 3807 /A042 3808 / /A042 3809 / AC WAS = -6 ... /A042 3810 / /A042 3811 / READ GOTO-PAGE DESCRIPTOR WORD DEFINED BY SCTOP,SCTPH; /A042 3812 / THEN INCREMENT SCTOP,SCTPH BY CONTENTS OF MQ AT ENTRY. /A042 3813 / /A042 3814 021514 7701 RPDSIN, ACL /GET INCREMENT FOR SCTOP,SCTPH /A042 3815 021515 3321 DCA RPTPIN /SAVE POST INCREMENT FOR SCTOP,SCTPH /A042 3816 021516 4775 JMS RPTPDS /GET G-T-P TOP DESCRIPTOR WORD /A042 3817 021517 3775 DCA RPTPDS /SAVE DESCRIPTOR WORD /A042 3818 021520 4777 JMS SCTOPP /INCREMENT TOP POINTERS (SCTOP,SCTPH) /A042 3819 021521 0000 RPTPIN, .-. / AMOUNT TO INCREMENT (-1,0, OR +1) /A042 3820 021522 1775 TAD RPTPDS / GET ORIGINAL G-T-P DESCRIPTOR WORD /A042 3821 021523 5307 JMP RPINEX /EXIT /A042 3822 3823 / if Go To page request FLaG is NOT set 3824 / then 3825 / return to caller 3826 / else 3827 / reset GTFLG 3828 / get pointer to appropriate descriptor 3829 / get the descriptor 3830 / retrieve the mode of the first character in the block 3831 / save in: ETXMOD 3832 / ETXMOD+1 3833 / STXMOD 3834 / STXMOD+1 3835 / 3836 / 3837 RPRD1, XX undefined ^ 021524 0000 3838 021525 1222 TAD GTFLG /GET THE GOTO PAGE REQUEST FLAG 3839 021526 7450 SNA /SKIP IF G-T-P REQUEST /M030 3840 021527 5353 JMP RPRDEN /EXIT 3841 021530 7710 SPA CLA /SKIP IF GETTING ETX /A030 3842 021531 5347 JMP RPCLHLD /JUMP IF GETTING STX /A030 3843 3844 021532 1365 TAD (3600 /MASK TO EXTRACT MODE BITS 3845 021533 0764 AND RPPTR1 /MASK WITH CURRENT DESC WORD /M030 3846 021534 3763 DCA ETXMOD /STORE FOR LATER USE 3847 021535 1763 TAD ETXMOD /RETRIEVE MODE 3848 021536 3762 DCA STXMOD /FOR USE WHEN SCROLLING UP 3849 3850 021537 1126 TAD T40 /MASK TO EXTRACT SHIFT/UNSHIFT BIT 3851 021540 0764 AND RPPTR1 /AC = SHIFT/UNSHIFT /M030 3852 021541 3761 DCA ETXMOD+1 /SAVE 3853 021542 1761 TAD ETXMOD+1 /RETRIEVE 3854 021543 3760 DCA STXMOD+1 /AND SAVE FOR SCROLL UP 3855 3856 AC0100 /MASK FOR ACTIVE-CONTROL AREA /A030 undefined ^ 021544 0000 3857 021545 0764 AND RPPTR1 /TO CURRENT DESC. WORD /A030 3858 021546 3757 DCA RPPCTLFL /UPDATE FLAG ACCORDING TO BLOCK READ /A030 3859 3860 021547 1356 RPCLHLD,TAD (3640 /MASK TO EXTRACT MODE /A030 3861 021550 0764 AND RPPTR1 /FROM CURRENT DESC. /A030 3862 021551 3755 DCA HLDMOD /FOR NEXT STX BLOCK TO BE WRITTEN /A030 3863 021552 3222 DCA GTFLG /CLEAR G-T-P ACTIVE FLAG /A030 3864 021553 5724 RPRDEN, JMP I RPRD1 /RETURN TO CALLER 3865 3866 /D030 RPRD3, .-. /TEMP. 3867 /D030 RPRD4, .-. /TEMP. 3868 3869 / THIS BLOCK IS NEEDLESSLY AND CONFUSINGLY OUT OF SEQUENCE, /A042 3870 / AND IT ALSO WASTES WORDS, SO I'M REWRITING IT AND MOVING IT /A042 3871 / TO WHERE IT LOGICALLY BELONGS (WHY WASN'T IT THERE TO BEGIN WITH??) /A042 3872 3873 /D042 RPTOP, TAD ONE /INCR. MINUS AC /M025 3874 /D042 SZA /SKIP IF EDITOR REQUEST FOR SCTOP 3875 /D042 JMP RPPTRS /JUMP IF NOT 3876 /D042 3877 /D042 / AC was -3....... 3878 /D042 3879 /D042 / ON ENTRY: MQ = pointer to caller's save area to 3880 /D042 / pass the current SCTOP and HDR ID # 3881 /D042 / 3882 /D042 / ON EXIT: MQ = HDR ID # at START of relative page 3883 /D042 / request 3884 /D042 / 3885 /D042 / AC = SCTOP at START of relative page 3886 /D042 / request 3887 /D042 / 3888 /D042 / The CURRENT SCTOP and HDR ID # (SCTPH) 3889 /D042 / are in the caller's data field 3890 /D042 3891 /D042 TAD SCTOP /CURRENT TOP POINTER /A026 3892 /D042 SWP /MQ = CURRENT TOP /A030 3893 /D042 /AC = POINTER TO CALLERS SAVE AREA /A030 3894 /D042 DCA X0 /PTR TO SAVE AREA INTO X0 3895 /D042 TAD SCTPH /CURRENT HDR ID # /A026 3896 /D042 CDFLP /FIELD 5 /A026 3897 /D042 DCA I X0 /SAVE CURRENT HDR ID # /A026 3898 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A026 3899 /D042 DCA I X0 /TO SAVE FOR COMPARE /A026 3900 /D042 CDFMYF /FIELD 7 /A026 3901 /D042 3902 /D042 TAD EDHDR /ORIG. HEADER ID # /A009 3903 /D042 MQL /INTO THE MQ /A009 3904 /D042 TAD EDTOPS /ORIG. SCTOP /M041 3905 /D042 JMP RPINEX /RETURN TO CALLER /A009 3906 3907 3908 /--------------- 3909 021555 0340 PAGE 021556 3640 021557 1201 021560 1352 021561 2562 021562 1351 021563 2561 021564 0724 021565 3600 021566 1321 021567 1353 021570 0053 021571 0052 021572 1334 021573 3052 021574 1333 021575 1335 021576 0773 021577 3331 3910 3911 3912 020154 7742  020155 1151 020156 1201 020157 1200 020160 7677 020161 0651 020162 3052 020163 0262 020164 0200 020165 0724 020166 0470 020167 3053 020170 0234 020171 7777 020172 7761 020173 0472 020174 0467 020175 0626 020176 2013 020177 2000 A1 0451 B 0642 BDISP 3320 BDISP2 3326 BHKEXI 0016 BHOOK 0000 BLACSV 0021 BLASTH 0020 BLKINT 3356 BOFSET 0002 CDFBUF 0000 CDFMNU 0000 CDFMYF 0000 CDFRPB 0000 CHCNTL 1251 CHKETX 0073 CHKPAG 0132 CHKST1 0107 unreferenced CHKST2 0112 unreferenced CHKST3 0115 unreferenced CHKSTX 0102 CHRHLD 1141 CKSAME 0520 CLPTRS 3351 CLRBF1 3154 CLRBUF 3152 COSTAB 0736 CUR12B 1015 DESCOF 0465 DOESC 1210 DOSTRT 0125 DSBDEX 1151 DSBDST 1117 DSBDWD 1135 DSKCL1 2065 DSKCL2 2075 DSKCL3 2077 DSKCL4 2103 DSKCL5 2111 DSKCLC 2135 DSKCLS 2046 DSKIN1 1700 DSKINI 1652 DSKOPN 0246 DSKOPX 0256 EDBOTS 0146 EDHDR 0150 EDHDR1 1333 EDSCBK 1334 EDTOPS 0147 ESCTAB 0657 ETXBUF 6400 ETXDES 2564 ETXMOD 2561 ETXSAV 0350 EXTNOF 0145 FOUR 0123 GETBY1 2334 GETBYT 2320 GETET1 2250 GETETA 1325 GETETC 1315 GETETX 0600 GETEX1 2265 GETEX2 2273 GETHDR 2730 GETMD1 0742 GETMOD 0712 GETSA1 1343 GETSA2 1345 GETST1 2200 GETSTC 1327 GETSTX 0612 GETSX1 2213 GETSX2 2221 GETTOP 3141 GTFLG 1422 GTGOBK 2754 GTHDC1 2745 GTHDCK 2733 unreferenced GTHDRS 2674 GTRESH 2750 HDRBUF 6000 HLDMOD 0340 M100 0000 M16 0112 M3 0115 M310 0110 M360 0107 M376 0106 M377 0105 unreferenced M4 0114 M400 0104 unreferenced M74 0111 M7700 0102 MAXCOS 0014 MAXESC 0032 MODEXT 1317 MODTAB 0771 MONE 0116 MSKTAB 1147 NEWBLK 0143 NOBLK 1743 NWPAGE 0113 NXTETX 1021 NXTSTX 1003 ONE 0120 P100 0102 PAGEMK 0103 PAGLIM 0153 PSTBO1 3741 PSTBOT 3734 PSTBUF 7400 PTR1 2756 PTR2 2757 PUTBY1 2320 PUTBYT 2334 PUTET1 2274 PUTET2 2275 PUTETC 1242 PUTETX 1016 PUTEX1 2313 PUTMD1 1112 PUTMD2 1072 PUTMD3 1135 PUTMD4 1136 PUTMOD 1034 PUTST1 2222 PUTST2 2223 PUTSTC 1266 PUTSTX 1000 PUTSX1 2244 RDBFCB 2600 RDCHNO 0546 RDCKHD 2666 RDEXI2 2664 RDEXIT 2663 RDFIO 0270 RDFIO1 0300 RDFQB 0306 RDFQBK 0311 RDFSIZ 0101 RDGET1 0000 RDGETR 2625 RDGTHD 2650 RDGTHS 3676 RDGTXR 2652 unreferenced RDGTXZ 2662 RDHDBN 2601 RDHDRB 2602 RDHDRP 0544 RDINC 3716 RDINC1 3724 RDINC2 3732 RDINI1 0420 RDINI2 1152 RDINIT 0400 RDLPTR 0550 RDMOD 0551 RDNPTR 0010 RDNXC 0450 RDNXC1 0475 RDNXC2 0516 RDNXC3 0530 RDNXC4 0537 RDNXC5 0541 RDNXC6 0510 RDNXCB 0463 RDNXCH 0436 RDNXCX 0457 RDNXH1 0437 RDPTNO 0547 RDPTRB 0260 RDPTRS 0545 RDRET 2636 REEDXT 0234 RPALEX 0276 RPALLO 0307 RPALOC 0054 RPBFCB 0466 RPBFIN 0626 RPBOT 1510 RPCKV2 0022 RPCLHL 1547 RPCNT 1432 RPCTEX 0761 RPDORD 1021 RPDSBD 1103 RPDSCP 1423 RPDSCR 0657 RPDSFR 0651 RPDSIN 1514 RPDSW1 0351 RPDSW2 0360 RPDSW3 0361 RPDSWD 0440 RPENAU 1305 RPENDB 1102 RPENDS 0671 RPENSB 1314 RPENSU 1276 RPETCX 1253 RPEXAU 1302 RPEXSB 1311 RPEXSU 1273 RPEXT 0243 unreferenced RPEXTN 0043 RPEXTR 3151 RPFRB1 0071 unreferenced RPFRB2 0072 RPFRBK 0060 RPFRDS 0664 RPGETR 0677 RPGTR1 0723 RPHDBN 0467 RPHDRB 0470 RPHMD 0512 RPINEX 1507 RPINIT 1400 RPLNK 0302 unreferenced RPLPV2 0032 RPMAIN 0231 RPMODE 1200 RPPCTL 1201 RPPGDS 7400 RPPGMK 1243 RPPTR1 0724 RPPTRS 1476 RPPUTR 0711 RPPUTX 2357 RPQRX 0600 RPQRX1 0616 RPRD1 1524 RPRD2 0232 RPRDDS 0235 RPRDEN 1553 RPRDEX 0262 RPRDIT 1000 RPRDND 0234 unreferenced RPREA1 0200 RPSPLT 1101 RPSTCX 1304 RPSTRL 1266 RPTEM1 0650 RPTEM2 0144 unreferenced RPTOP 1457 RPTPDS 1335 RPTPIN 1521 RPTRS1 1321 RPV2EX 0042 RPWRT 0404 RPWRTH 0400 RPWRTO 0433 RPXEX 0304 RRAER1 1467 unreferenced RRSCTP 0753 RXEWT 0004 RXQBLK 0011 SAVETX 0341 SAVSTX 0330 SAVTOP 3133 SAVTPH 3147 SCAD1 3244 SCAD16 3200 SCAD4 3247 SCAD5 3215 SCAD6 3231 SCAD7 3250 SCAD8 3225 SCALB 1650 unreferenced SCALC 1647 SCALC1 1611 SCALC2 3435 SCALC3 1634 SCALCD 1613 SCALCT 1651 SCALCX 3444 SCALCY 3461 SCALCZ 3467 SCALOC 1600 SCBFCB 3051 SCBHSV 2510 SCBKOF 0052 SCBOT 0133 SCBOTP 3311 SCBOTS 1646 SCBOTT 0137 SCBT1 3410 unreferenced SCBT2 3411 unreferenced SCBT3 3412 SCBT4 3416 unreferenced SCBT5 3417 unreferenced SCBT6 3420 SCBTH 0134 SCBTHS 1645 SCBTHT 0136 SCBTSV 2511 SCBUFI 1533 SCCEXT 3555 unreferenced SCCHGE 3025 SCCLS 2400 SCCLS1 2415 SCCLS2 2434 SCCLS6 2451 SCCLS7 2456 SCCLSC 0136 SCCLSE 3473 SCCLSF 3501 SCCLSG 3513 SCCLSH 3545 SCCLST 0137 SCEB 6400 SCEND 3037 SCEPTR 0152 SCFILZ 0142 SCFLNR 3614 SCFLOT 3670 SCFLX 3655 SCFLZ 3625 SCFLZ1 3673 SCFLZ2 3674 SCFLZB 3600 SCFLZF 3640 SCFLZO 3627 SCFLZT 3651 SCFNO 1701 unreferenced SCFSPC 0100 SCGETR 2000 SCGETX 2031 SCGPVL 0171 SCGTAL 3120 SCGTEX 3116 SCGTR1 2044 SCGTR2 2045 SCGTRD 3110 SCGTWR 3076 SCHCNT 0774 SCHDBN 3052 SCHDMD 3075 SCHDR 6000 SCHDRB 3053 SCHDRG 0154 SCHDRP 0162 SCIER1 1467 SCINC 3251 SCINC1 3307 SCINC2 3310 SCINCX 3274 SCINCY 3305 SCINCZ 3304 SCINI 1400 SCINX 1470 SCIST 0010 unreferenced SCNEQ 2506 SCOFS1 3045 SCOFS2 3046 SCOFS3 3047 SCOFS4 3050 SCOFST 3000 SCOPTN 0141 SCPTR1 2043 SCPUTR 2013 SCQBLK 2542 SCQRX 2512 SCQRX1 2527 SCQUBL 2537 SCRDIN 3033 SCREB 1706 SCREQ 2473 SCRTB 1725 SCSPC 1702 SCTB 7000 SCTB1 3434 SCTB2 3433 SCTOP 0132 SCTOPP 3331 SCTPBT 3400 SCTPH 0135 SCTPTR 0151 SCWEB 1471 SCWTB 1513 SOMFLG 0140 SPCTAB 0725 STXBUF 7000 STXDES 1354 unreferenced STXHLD 0337 STXMOD 1351 STXSAV 1347 STXSV1 1350 SVTOP 3150 T16 0124 T17 0125 T360 0127 T376 0130 T40 0126 T400 0131 TAB 1142 TABND 1147 TDISP 3340 TDISP2 3346 TEMP1 0341 TEMP2 0330 THREE 0122 TMPPTR 1156 TODSBD 0105 TOGETR 2760 TORPDS 1202 TWO 0121 WRITEO 0513 XFIELX 0200 XFILT1 0222 XFILT2 0220 XFILT3 0223 XFILT4 0224 XFLDTB 0225 XGETR 0000 XLTAS1 0640 XLTAS2 0652 XLTAS3 0655 XLTAS4 0635 XLTASC 0626 XLTCO1 1224 XLTCO2 1234 XLTCO3 1222 XLTCO4 1231 XLTCOS 1200 ZERO 0117