[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/19/99 01:24:51 SPOOL - LS-DOS 6.2 Page 00001
00001 ;LBSPOOL/ASM - Spool command
00003 ;
0000 00004 *GET LBSPOOLA:3
00005 ;LBSPOOLA/ASM - SPOOL setup
00006 ;
002C 00007 PAR_ERR EQU 44 ;Parameter Error
0003 00008 ETX EQU 3
000D 00009 CR EQU 13
0028 00010 RST28 EQU 28H
2300 00011 LOWBUF$ EQU 2300H ;Low memory disk I/O buff
001F 00012 KITSK@ EQU 31 ;FLGTAB+31
00013 ;
0000 00014 *GET SVCMAC:3 ;SVC Macro equivalents
00015 ;SVCMAC/ASM - LS-DOS Version VI
00016 *LIST OFF
00408 *LIST ON
00410 *LIST OFF ;Get LDOS60/EQU
00548 *LIST ON
00549 ;
2400 00550 ORG 2400H
00551 ;
00552 ; Save stack & call Spool routine
00553 ;
2400 ED730B24 00554 SPOOL LD (SAVESP+1),SP ;Save SP
2404 CD5924 00555 CALL SPOOL1 ;Call SPOOL Code
2407 210000 00556 EXIT LD HL,0 ;Successful exit
00557 ;
00558 ; P/u stack & clear any pending
00559 ;
240A 310000 00560 SAVESP LD SP,$-$ ;P/u original stack
240D 00561 @@CKBRKC ;Clear any
240D+3E6A 00562 LD A,106
240F+EF 00563 RST 40
2410 C9 00564 RET ;Ret to DOS
00565 ;
00566 ; Informative Message Exit
00567 ;
2411 217D29 00568 CLEARD LD HL,CLEARD$
2414 DD 00569 DB 0DDH
2415 21A829 00570 RESUMD LD HL,RESUMD$
2418 DD 00571 DB 0DDH
2419 219229 00572 PAUSED LD HL,PAUSED$
241C DD 00573 DB 0DDH
241D 213A2A 00574 SPLACT LD HL,SPLACT$
2420 DD 00575 DB 0DDH
2421 21D529 00576 SPLONM LD HL,SPLONM$
2424 DD 00577 DB 0DDH
2425 21BF29 00578 SPLOFM LD HL,SPLOFM$
2428 DD 00579 DB 0DDH
2429 21EF29 00580 SPLOPM LD HL,SPLOPM$
242C DD 00581 DB 0DDH
242D 21112A 00582 PRMBGM LD HL,PRMBGM$
2430 00583 @@LOGOT
00584 IFEQ 00H,1
00585 LD HL,
00586 ENDIF
2430+3E0C 00587 LD A,12
2432+EF 00588 RST 40
2433 18D2 00589 JR EXIT
00590 ;
00591 ; I/O Error Processor
00592 ;
2435 3E2C 00593 PRMERR LD A,PAR_ERR ;Parameter Error
2437 6F 00594 IOERR LD L,A ;Set HL = Error #
2438 2600 00595 LD H,0
243A F6C0 00596 OR 0C0H ;Set short, return
243C 4F 00597 LD C,A ;Error code to C
243D 00598 @@ERROR ;Dsply error
243D+3E1A 00599 LD A,26
243F+EF 00600 RST 40
2440 18C8 00601 JR SAVESP ;Exit
00602 ;
00603 ; Internal Error Message Handler
00604 ;
2442 21C72A 00605 BADDCB LD HL,BADDCB$
2445 DD 00606 DB 0DDH
2446 216029 00607 NOFIND LD HL,NOFIND$
2449 DD 00608 DB 0DDH
244A 21972A 00609 INUSE LD HL,INUSE$
244D DD 00610 DB 0DDH
244E 21AD2A 00611 CANT LD HL,CANT$
2451 00612 @@LOGOT
00613 IFEQ 00H,1
00614 LD HL,
00615 ENDIF
2451+3E0C 00616 LD A,12
2453+EF 00617 RST 40
2454 21FFFF 00618 ERREXIT LD HL,-1 ;Set abort code
2457 18B1 00619 JR SAVESP ;Exit
00620 ;
00621 ; SPOOL1 - Set up system to Spool Output
00622 ;
00623 SPOOL1
2459 E5 00624 PUSH HL ;Save INBUF$ pointer
245A 00625 @@FLAGS ;Get flag table pointer
245A+3E65 00626 LD A,101
245C+EF 00627 RST 40
245D DD211D2D 00628 LD IX,PRMSAV ;Point to parm save area
2461 11142D 00629 LD DE,SPOOL$ ;If already resident,
2464 00630 @@GTMOD ; don't need to check
2464+3E53 00631 LD A,83
2466+EF 00632 RST 40
2467 2032 00633 JR NZ,SPL1 ; if memory available
2469 ED53A428 00634 LD (SVDCB),DE ;Save DCB pointer
246D 22B228 00635 LD (SVBGN),HL ;Save module begin
2470 210400 00636 LD HL,4 ;Get parm save pointer
2473 19 00637 ADD HL,DE
2474 22DD28 00638 LD (HIPARM),HL ;Save for use by clear
2477 DDE5 00639 PUSH IX ;Also put address in DE
2479 D1 00640 POP DE ;Shift saved parms into
247A 010B00 00641 LD BC,11 ; spool driver front end
247D EDB0 00642 LDIR
247F DD5E04 00643 LD E,(IX+4) ;P/u previous MPARM
2482 DD5605 00644 LD D,(IX+5)
2485 ED538D26 00645 LD (MPARM+1),DE ;Stuff as new default
2489 DD5E06 00646 LD E,(IX+6) ;P/u previous DPARM
248C DD5607 00647 LD D,(IX+7)
248F ED531B26 00648 LD (DPARM+1),DE ;Stuff as new default
2493 DD7E0A 00649 LD A,(IX+10) ;P/u old bank #
2496 E67F 00650 AND 07FH ;Strip hi bit
2498 32B625 00651 LD (BPARM+1),A ; & save as default
249B E1 00652 SPL1 POP HL ;Get INBUF$ pointer
00653 ;
00654 ; Fetch device spec to spool
00655 ;
249C 11E22A 00656 SPL2 LD DE,SPLDCB ;Fetch device spec
249F 00657 @@FSPEC ; to spool
249F+3E4E 00658 LD A,78
24A1+EF 00659 RST 40
24A2 E5 00660 PUSH HL ;Save inbuf$ ptr
24A3 201E 00661 JR NZ,USEPR ;Use *PR if no entry
24A5 1A 00662 LD A,(DE) ;If a device spec not
24A6 FE2A 00663 CP '*' ; found, maybe it was
24A8 2824 00664 JR Z,SPL2A ; the spool file spec
00665 ;
00666 ; File spec fetched - Move to spool FCB
00667 ;
24AA EB 00668 EX DE,HL ;DCB to HL
24AB 11332F 00669 LD DE,SPLFCB ;Point to spool FCB
24AE D5 00670 PUSH DE
24AF 012000 00671 LD BC,32
24B2 EDB0 00672 LDIR ;Move it in
24B4 21092B 00673 LD HL,PR$ ;Move in default spec
24B7 11E22A 00674 LD DE,SPLDCB ; for spool device
24BA 010400 00675 LD BC,4
24BD EDB0 00676 LDIR
24BF AF 00677 XOR A
24C0 D1 00678 POP DE ;Point to SPLFCB
24C1 181B 00679 JR SPL2B ;Go - we have spec
24C3 21092B 00680 USEPR LD HL,PR$ ;Move in default spec
24C6 11E22A 00681 LD DE,SPLDCB
24C9 010400 00682 LD BC,4
24CC EDB0 00683 LDIR
00684 ;
00685 ; Fetch file spec to use as disk spool buffer
00686 ;
24CE E1 00687 SPL2A POP HL ;Get inbuf$ ptr
24CF ED5BE32A 00688 LD DE,(SPLDCB+1) ;Stuff device name for
24D3 ED53022B 00689 LD (DSKSPC),DE ; default spool file name
24D7 11332F 00690 LD DE,SPLFCB ;Fetch spool filespec
24DA 00691 @@FSPEC
24DA+3E4E 00692 LD A,78
24DC+EF 00693 RST 40
24DD E5 00694 PUSH HL ;Save separator char
24DE F5 00695 SPL2B PUSH AF ; & line pointer
24DF 21022B 00696 LD HL,DSKSPC ;Default to XX/SPL
24E2 2803 00697 JR Z,SPL2C
24E4 00698 @@FSPEC ; if user entered none
24E4+3E4E 00699 LD A,78
24E6+EF 00700 RST 40
24E7 21052B 00701 SPL2C LD HL,SPLEXT ;Default ext to SPL
24EA 00702 @@FEXT
24EA+3E4F 00703 LD A,79
24EC+EF 00704 RST 40
24ED F1 00705 POP AF ;Rcvr line pointer
24EE E1 00706 POP HL
24EF FE3A 00707 CP ':' ;Drive entered?
24F1 201C 00708 JR NZ,GETPRM
24F3 1A 00709 SPL3 LD A,(DE) ;Wait for ETX or EOL
24F4 FE0D 00710 CP CR
24F6 2807 00711 JR Z,SPL4
24F8 FE03 00712 CP 3
24FA 2803 00713 JR Z,SPL4
24FC 13 00714 INC DE
24FD 18F4 00715 JR SPL3
24FF 3E3A 00716 SPL4 LD A,':' ;Stuff colon for drive
2501 12 00717 LD (DE),A
2502 13 00718 INC DE
2503 7E 00719 LD A,(HL) ;P/u possible drive #
2504 FE0D 00720 CP CR
2506 CA3524 00721 JP Z,PRMERR ;Parm error if EOL
2509 23 00722 INC HL
250A 12 00723 LD (DE),A ;Stuff drive #
250B 13 00724 INC DE
250C 3E03 00725 LD A,3
250E 12 00726 LD (DE),A ;Stuff ETX
00727 ;
00728 ; Get parameter entries
00729 ;
250F 110D2B 00730 GETPRM LD DE,PRMTBL$ ;Get parms
2512 00731 @@PARAM
2512+3E11 00732 LD A,17
2514+EF 00733 RST 40
2515 C23524 00734 JP NZ,PRMERR ;Jump on parm error
00735 ;
00736 ; Check on OFF
00737 ;
2518 110000 00738 OPARM LD DE,0 ;P/u off parm
251B 1C 00739 INC E ;On or off?
251C CA3128 00740 JP Z,SPLOFF ;Jump if OFF
00741 ;
00742 ; Check on RESUME despooling
00743 ;
251F 110000 00744 RPARM LD DE,0 ;P/u Resume parm
2522 1C 00745 INC E ;Was it used?
2523 CA1C28 00746 JP Z,RESUME ;Go if so
00747 ;
00748 ; Check on PAUSE
00749 ;
2526 110000 00750 PPARM LD DE,0 ;P/u Pause parm
2529 1C 00751 INC E ;Was it used?
252A CA0728 00752 JP Z,PAUSE ;Go if so
00753 ;
00754 ; Check on CLEAR
00755 ;
252D 110000 00756 CPARM LD DE,0 ;P/u Clear parm
2530 1C 00757 INC E ;Was is used?
2531 CAD428 00758 JP Z,CLEAR ;Go if so
00759 ;
00760 ; Assume request to be to install
00761 ;
2534 FDCB0246 00762 BIT 0,(IY+'C'-'A') ;Can't insert spool if
2538 C24E24 00763 JP NZ,CANT ; memory frozen
253B FDCB0346 00764 BIT 0,(IY+'D'-'A') ;Is spooler already on?
253F C22124 00765 JP NZ,SPLONM ;Quit if so
00766 ;
00767 ; If module resident, ck parm sizes
00768 ;
2542 11142D 00769 LD DE,SPOOL$
2545 00770 @@GTMOD
2545+3E53 00771 LD A,83
2547+EF 00772 RST 40
2548 202B 00773 JR NZ,FNDDCB ;Go if no area in mem
254A DD6E04 00774 LD L,(IX+4) ;Prev. MPARM
254D DD6605 00775 LD H,(IX+5)
2550 ED5B8D26 00776 LD DE,(MPARM+1)
2554 B7 00777 OR A
2555 ED52 00778 SBC HL,DE ;Old must = new
2557 C22D24 00779 JP NZ,PRMBGM ;Abort if bad
255A DD6E06 00780 LD L,(IX+6) ;D parm
255D DD6607 00781 LD H,(IX+7)
2560 ED5B1B26 00782 LD DE,(DPARM+1)
2564 ED52 00783 SBC HL,DE
2566 C22D24 00784 JP NZ,PRMBGM ;Abort if not same as old
2569 DD7E0A 00785 LD A,(IX+10) ;Bank #
256C E67F 00786 AND 07FH ;Strip hi bit
256E 2AB625 00787 LD HL,(BPARM+1)
2571 BD 00788 CP L
2572 C22D24 00789 JP NZ,PRMBGM ;Abort if not same as old
00790 ;
00791 ; Find device to spool
00792 ;
2575 ED5BE32A 00793 FNDDCB LD DE,(SPLDCB+1) ;P/u device name
2579 00794 @@GTDCB ;Find in device tables
2579+3E52 00795 LD A,82
257B+EF 00796 RST 40
257C C23724 00797 JP NZ,IOERR ;Jump on not found
257F CB66 00798 CKRTE BIT 4,(HL) ;Routed device?
2581 2807 00799 JR Z,CKLNK ;Bypass if not
2583 2C 00800 CKRTE1 INC L ;Pt to vector
2584 7E 00801 LD A,(HL) ;P/u vector DCB address
2585 2C 00802 INC L ; & test it
2586 66 00803 LD H,(HL)
2587 6F 00804 LD L,A
2588 18F5 00805 JR CKRTE
258A CB6E 00806 CKLNK BIT 5,(HL) ;If linked, get DCB
258C 20F5 00807 JR NZ,CKRTE1
258E CB76 00808 BIT 6,(HL) ;If filtered, trace to
2590 281B 00809 JR Z,SETDVR ; its DCB in header
2592 54 00810 LD D,H ;Save to ck inactive
2593 5D 00811 LD E,L
2594 2C 00812 INC L
2595 7E 00813 LD A,(HL) ;Get vector to module
2596 2C 00814 INC L
2597 66 00815 LD H,(HL)
2598 6F 00816 LD L,A
2599 010400 00817 LD BC,4 ;HL now points to the
259C 09 00818 ADD HL,BC ; entry point. Get its
259D 4E 00819 LD C,(HL) ; DCB address by peeking
259E 0C 00820 INC C ; past the name field
259F 09 00821 ADD HL,BC
25A0 7E 00822 LD A,(HL) ;Get low-order
25A1 23 00823 INC HL
25A2 66 00824 LD H,(HL) ;Get hi-order
25A3 6F 00825 LD L,A
25A4 E5 00826 PUSH HL ;If DCB is itself, then
25A5 ED52 00827 SBC HL,DE ; it's some error
25A7 E1 00828 POP HL ; else continue to
25A8 20D5 00829 JR NZ,CKRTE ; search the chain
25AA C34224 00830 JP BADDCB
00831 ;
00832 ; Found the device
00833 ;
25AD CB4E 00834 SETDVR BIT 1,(HL) ;Device handle @PUT?
25AF CA4224 00835 JP Z,BADDCB ;Can't do if not
25B2 22252D 00836 LD (MODDVR),HL ;Stuff DCB table address
00837 ;
00838 ; Check BANK spec for availability
00839 ;
25B5 010000 00840 BPARM LD BC,0 ;Pick up the bank #
25B8 79 00841 LD A,C ;If bank=0, no need
25B9 B0 00842 OR B ; to test for
25BA 281B 00843 JR Z,LOCDCB ; availability
00844 IF @BLD631
25BC FE1F 00845 CP 31 ;<631>This version does banks 0-31
00846 ELSE
00847 CP 8 ;This version supports banks 0-7
00848 ENDIF
25BE D23524 00849 JP NC,PRMERR ;Out of range
25C1 CBFF 00850 SET 7,A ;Set for transfer
25C3 32612D 00851 LD (BANKX1),A ;Stuff for module A
25C6 32832D 00852 LD (BANKX2),A
25C9 32902D 00853 LD (BANKX3),A
25CC 32272D 00854 LD (SPLBNK),A
25CF 0602 00855 LD B,2 ;Test if bank 1-x
25D1 00856 @@BANK ; is available
25D1+3E66 00857 LD A,102
25D3+EF 00858 RST 40
25D4 C24A24 00859 JP NZ,INUSE ;Quit if not available
00860 ;
00861 ; Locate a spare DCB for the spool module
00862 ;
25D7 110000 00863 LOCDCB LD DE,0
25DA 00864 @@GTDCB
25DA+3E52 00865 LD A,82
25DC+EF 00866 RST 40
25DD 3E21 00867 LD A,33 ;Init "No device space...
25DF C23724 00868 JP NZ,IOERR ;Go if no spare DCBs
25E2 22192D 00869 LD (S0DCB),HL ;Save pointer
25E5 22B62D 00870 LD (S0DCB1),HL
25E8 E5 00871 PUSH HL ;Save DCB field pointer
25E9 11532F 00872 LD DE,'/S' ;Let's find a link name
25EC 14 00873 NAMLP INC D ;Bump "2nd" character
25ED 00874 @@GTDCB ;If we find this name
25ED+3E52 00875 LD A,82
25EF+EF 00876 RST 40
25F0 28FA 00877 JR Z,NAMLP ; look for another
25F2 E1 00878 POP HL ;Get DCB pointer
25F3 CBDE 00879 SET 3,(HL) ;NIL in case of error
25F5 010600 00880 LD BC,6
25F8 09 00881 ADD HL,BC ;Point to name field
25F9 73 00882 LD (HL),E ; & stuff in the
25FA 2C 00883 INC L ; selected spool name
25FB 72 00884 LD (HL),D
00885 ;
00886 ; Create a disk file for spooling
00887 ;
25FC ED5B1B26 00888 LD DE,(DPARM+1) ;P/u disk size
2600 DD7306 00889 LD (IX+6),E ;Save DPARM for next time
2603 DD7207 00890 LD (IX+7),D ; SPOOL is entered
2606 7A 00891 LD A,D
2607 B3 00892 OR E
2608 284E 00893 JR Z,PUHIGH ;No file if DISK=0
260A 11332F 00894 LD DE,SPLFCB ;Init the spool file
260D 21002C 00895 LD HL,BUFFER
2610 FDCB12C6 00896 SET 0,(IY+'S'-'A') ;Init file open bit
2614 00897 @@INIT
2614+3E3A 00898 LD A,58
2616+EF 00899 RST 40
2617 C23724 00900 JP NZ,IOERR ;Jump on init error
261A 010400 00901 DPARM LD BC,4 ;D parm (default=4K)
261D 78 00902 LD A,B ;Parm error if > 4095K
261E E6F0 00903 AND 0F0H
2620 C23524 00904 PRMERRA JP NZ,PRMERR ;Go if too big a file
2623 CB21 00905 SLA C ;Multiply K by 4
2625 CB10 00906 RL B ; to calculate sectors
2627 CB21 00907 SLA C
2629 CB10 00908 RL B
262B ED43FF26 00909 LD (IPLDSK1+1),BC ;Stuff disk K
262F 0B 00910 DEC BC ;Adjust for 0 offset
2630 00911 @@POSN ;Position to end
2630+3E42 00912 LD A,66
2632+EF 00913 RST 40
2633 00914 @@WRITE ;Write a junk sector
2633+3E4B 00915 LD A,75
2635+EF 00916 RST 40
2636 C23724 00917 JP NZ,IOERR ;Jump on write error
2639 00918 @@REW ;Restore file to 0
2639+3E44 00919 LD A,68
263B+EF 00920 RST 40
263C 00921 @@WEOF ;End of file mark
263C+3E4A 00922 LD A,74
263E+EF 00923 RST 40
263F ED4B392F 00924 LD BC,(SPLFCB+6) ;P/u DEC & drive
2643 00925 @@DIRRD ;Read its dir record
2643+3E57 00926 LD A,87
2645+EF 00927 RST 40
2646 C23724 00928 JP NZ,IOERR ;Quit on read error
2649 23 00929 INC HL ;Point to DIR+1
264A CBFE 00930 SET 7,(HL) ;Turn on CREATE bit
264C 00931 @@DIRWR ;Write dir back
264C+3E58 00932 LD A,88
264E+EF 00933 RST 40
264F C23724 00934 JP NZ,IOERR ;Jump on error
2652 210023 00935 LD HL,LOWBUF$ ;Revise I/O buffer
2655 22362F 00936 LD (SPLFCB+3),HL ; in file's FCB
00937 ;
00938 ; Get current HIGH$
00939 ;
2658 210000 00940 PUHIGH LD HL,0 ;Set HLB to zero to
265B 45 00941 LD B,L ; fetch HIGH$
265C 00942 @@HIGH$
265C+3E64 00943 LD A,100
265E+EF 00944 RST 40
265F 22BC26 00945 LD (GBUF1+1),HL ;Save for later
2662 22BD27 00946 LD (OLDHI+1),HL
00947 ;
00948 ; If bank RAM, recalculate MPARM
00949 ;
2665 3AB625 00950 LD A,(BPARM+1) ;Alternate banks requested?
2668 B7 00951 OR A
2669 2821 00952 JR Z,MPARM ;Go if not
00953 ;
00954 ; Recalculate MEM parameter to use the
00955 ; Maximum space in bank RAM. Formula is
00956 ; [((32768 - 512 for module) - ((DPARM+1)*16)]
00957 ; Divided by 260. The 260 is derived from
00958 ; 256-byte page plus 4-bytes for pointers.
00959 ; Then revise to K from pages.
00960 ;
266B 2A1B26 00961 LD HL,(DPARM+1)
266E 23 00962 INC HL ;Bump by 1
266F 29 00963 ADD HL,HL ;Times 16
2670 29 00964 ADD HL,HL
2671 29 00965 ADD HL,HL
2672 29 00966 ADD HL,HL
2673 4D 00967 LD C,L ;Xfer to BC for subtract
2674 44 00968 LD B,H
2675 21007E 00969 LD HL,32768-512 ;RAM space - module space
2678 AF 00970 XOR A ;The remainder is for
2679 ED42 00971 SBC HL,BC ; MEM pages and ptrs
267B CB3C 00972 SRL H ;A divide by 260 is
267D CB1D 00973 RR L ; accomplished by
267F 0E82 00974 LD C,260/2 ; div 2 and div 130
2681 00975 @@DIV16
2681+3E5E 00976 LD A,94
2683+EF 00977 RST 40
2684 4D 00978 LD C,L
2685 44 00979 LD B,H
2686 CB39 00980 SRL C ;Calculate
2688 CB39 00981 SRL C ; K = pages / 4
268A 1815 00982 JR CALCPTR
00983 ;
00984 ; Calculate memory buffer space requested
00985 ;
268C 010100 00986 MPARM LD BC,1 ;MEM parm - default 1K
268F 78 00987 LD A,B ;Test entry - must be
2690 B7 00988 OR A ;< 33K
2691 208D 00989 JR NZ,PRMERRA ;Hi-order must = 0
2693 B9 00990 CP C ;MEM = 0 ?
2694 CA3524 00991 JP Z,PRMERR ;Yes - Parameter Error
2697 7C 00992 LD A,H ;Get hi-order HIGH$
2698 D681 00993 SUB 81H ;Can't go below 8000H
269A 1F 00994 RRA ;Divide by 2
269B CB3F 00995 SRL A ; & again to calc K
269D 91 00996 SUB C ;Reduce by K of req
269E DA3524 00997 JP C,PRMERR ;Error if goes < 8000H
26A1 DD7104 00998 CALCPTR LD (IX+4),C ;Stuff MEM parm into
26A4 DD7005 00999 LD (IX+5),B ; save area
01000 ;
01001 ; Add memory buffer space to disk space
01002 ;
26A7 2A1B26 01003 LD HL,(DPARM+1) ;P/u disk K
26AA 09 01004 ADD HL,BC ;Calculate pointer
26AB 29 01005 ADD HL,HL ; buffer space required
26AC 29 01006 ADD HL,HL ; (D+M)*16 + 4 extra
26AD 23 01007 INC HL ; used to detect the end
26AE 29 01008 ADD HL,HL
26AF 29 01009 ADD HL,HL
01010 ;
01011 ; Retrieve high memory space for buffers
01012 ;
26B0 E5 01013 PUSH HL
26B1 DD6E00 01014 LD L,(IX+0) ;P/u saved HIGH$ entry
26B4 DD6601 01015 LD H,(IX+1)
26B7 7D 01016 LD A,L ;If <> 0, then SPOOL
26B8 B4 01017 OR H ; is resident
26B9 2009 01018 JR NZ,GBUF2
26BB 210000 01019 GBUF1 LD HL,$-$ ;P/u current high
26BE DD7500 01020 LD (IX+0),L ;Save the value
26C1 DD7401 01021 LD (IX+1),H
26C4 223629 01022 GBUF2 LD (SVEND+1),HL ;Stuff highest byte used
01023 ;
01024 ; If bank RAM used, reset to X'FFFF'
01025 ;
26C7 23 01026 INC HL ;Pt to lower 256
26C8 2E00 01027 LD L,0 ; byte block boundary
26CA 3AB625 01028 LD A,(BPARM+1) ;Bank specified?
26CD B7 01029 OR A
26CE 2801 01030 JR Z,$+3 ;Jump if not
26D0 65 01031 LD H,L ;Set to FFFF+1 = 0
26D1 4F 01032 LD C,A ;Reside bank for
26D2 0600 01033 LD B,0 ; module B
26D4 01034 @@BANK
26D4+3E66 01035 LD A,102
26D6+EF 01036 RST 40
26D7 C23724 01037 JP NZ,IOERR ;Quit on bank error
26DA DD7E04 01038 LD A,(IX+4) ;P/u MEM parm
26DD 07 01039 RLCA ;MEM * 4 = # of
26DE 07 01040 RLCA ; 256-byte blocks
26DF 47 01041 LD B,A ;Go back that number
26E0 ED44 01042 NEG ; of blocks needed
26E2 84 01043 ADD A,H ;HL now reserves buffer
26E3 67 01044 LD H,A ; blocks for MEM
26E4 22532F 01045 LD (PUTNXT$),HL ;Stuff pointers to begin
26E7 22552F 01046 LD (GETNXT$),HL ; of memory blocks
26EA 4C 01047 LD C,H
26EB D1 01048 POP DE ;Get (D+M)*16+4
26EC AF 01049 XOR A ;Backup the # of D+M
26ED ED52 01050 SBC HL,DE ; sectors
01051 ;
01052 ; Initialize the memory pointers
01053 ;
26EF E5 01054 PUSH HL ;Save pointer
26F0 3600 01055 IPLMEM LD (HL),0 ;Init the 4-byte fields
26F2 23 01056 INC HL ; for each of the disk &
26F3 3600 01057 LD (HL),0 ; memory block pointers
26F5 23 01058 INC HL
26F6 71 01059 LD (HL),C ;Stuff memory hi-order
26F7 23 01060 INC HL
26F8 3600 01061 LD (HL),0
26FA 23 01062 INC HL
26FB 0C 01063 INC C ;Bump memory hi-order
26FC 10F2 01064 DJNZ IPLMEM
01065 ;
01066 ; Initialize the disk pointers
01067 ;
26FE 110000 01068 IPLDSK1 LD DE,0 ;P/u # of disk sectors
2701 7A 01069 LD A,D
2702 B3 01070 OR E
2703 2815 01071 JR Z,IPLDSK3 ;Bypass if none
2705 010000 01072 LD BC,0 ;Set up a disk pointer
2708 3600 01073 IPLDSK2 LD (HL),0 ; for each disk block
270A 23 01074 INC HL
270B 3600 01075 LD (HL),0
270D 23 01076 INC HL
270E 71 01077 LD (HL),C ;Stuff block number
270F 23 01078 INC HL
2710 70 01079 LD (HL),B
2711 CBFE 01080 SET 7,(HL) ;Set bit 7 to indicate
2713 23 01081 INC HL ; this pntr is for disk
2714 03 01082 INC BC ;Inc block number
2715 1B 01083 DEC DE
2716 7A 01084 LD A,D ;Test if finished
2717 B3 01085 OR E
2718 20EE 01086 JR NZ,IPLDSK2 ;Loop if not
271A 3600 01087 IPLDSK3 LD (HL),0 ;One more used to
271C 23 01088 INC HL ; indicate the end
271D 3600 01089 LD (HL),0 ; of the pointer fields
271F 23 01090 INC HL
2720 36FF 01091 LD (HL),0FFH
2722 23 01092 INC HL
2723 36FF 01093 LD (HL),0FFH
2725 E1 01094 POP HL ;Rcvr start of pointers
2726 E5 01095 PUSH HL
2727 22572F 01096 LD (MAPPTR$),HL ; & stuff for later use
272A 22592F 01097 LD (PUTBLK$),HL
272D 225B2F 01098 LD (GETBLK$),HL
2730 7C 01099 LD A,H ;Stuff 1st MEM block ptr
2731 75 01100 LD (HL),L ; with table addr
2732 23 01101 INC HL
2733 77 01102 LD (HL),A
01103 ;
01104 ; Modify driver for spooling device vector address
01105 ;
2734 FD7E1F 01106 LD A,(IY+KITSK@) ;Transfer device hook
2737 FD6E20 01107 LD L,(IY+KITSK@+1)
273A FD6621 01108 LD H,(IY+KITSK@+2)
273D 32982D 01109 LD (GETBLK0),A
2740 22992D 01110 LD (GETBLK0+1),HL
2743 FDE5 01111 PUSH IY ;Set up address
2745 D1 01112 POP DE ; in despooler
2746 210F00 01113 LD HL,'P'-'A' ;PFLAG use to
2749 19 01114 ADD HL,DE ; determine if spooler
274A 226D2D 01115 LD (DFLAG),HL ; is Paused
274D 226F2E 01116 LD (DFLAG1),HL
2750 C1 01117 POP BC ;Start of MEM block tbl
2751 0B 01118 DEC BC ;Get last byte to use
2752 C5 01119 PUSH BC
2753 115E2F 01120 LD DE,DVRBEND ;Point to module B
2756 215F2F 01121 LD HL,RELTABB ;Point to table
2759 CD3029 01122 CALL RELO ;Relocate absolute refs
01123 ;
01124 ; If bank 0, then wipe out module A
01125 ;
275C 3AB625 01126 LD A,(BPARM+1) ;Alternate bank used?
275F B7 01127 OR A
2760 2019 01128 JR NZ,MOVMODB ;Skip next if so
2762 21002D 01129 LD HL,FIX1 ;Shift in JPs for the
2765 115C2D 01130 LD DE,PUTCHAR ; bank transfer
2768 010500 01131 LD BC,5 ; linkage
276B EDB0 01132 LDIR
276D 117F2D 01133 LD DE,FIX2UP
2770 0E05 01134 LD C,5
2772 EDB0 01135 LDIR
2774 118C2D 01136 LD DE,GETBLK
2777 0E05 01137 LD C,5
2779 EDB0 01138 LDIR
277B D1 01139 MOVMODB POP DE ;Get last byte to use
277C 215E2F 01140 LD HL,DVRBEND ;Last byte of module
277F 01A901 01141 LD BC,DVRBEND-DVRBBGN+1
2782 EDB8 01142 LDDR
2784 D5 01143 PUSH DE ;New last byte
01144 ;
01145 ; Switch to bank 0 always
01146 ;
2785 010000 01147 LD BC,0 ;Set function 0, bank 0
2788 01148 @@BANK
2788+3E66 01149 LD A,102
278A+EF 01150 RST 40
278B C23724 01151 JP NZ,IOERR ;Quit on bank error
278E C1 01152 POP BC
01153 ;
01154 ; If module B is in bank x, switch HIGH for A
01155 ;
278F 3AB625 01156 LD A,(BPARM+1) ;P/u alternate bank resp.
2792 B7 01157 OR A
2793 280D 01158 JR Z,STORHI ;Go if none used
2795 4F 01159 LD C,A ;Reserve the bank
2796 0603 01160 LD B,3 ;Set function # 3
2798 01161 @@BANK
2798+3E66 01162 LD A,102
279A+EF 01163 RST 40
279B C23724 01164 JP NZ,IOERR ;Quit on bank error
279E ED4B3629 01165 LD BC,(SVEND+1) ;P/u bank-A HIGH$
27A2 C5 01166 STORHI PUSH BC
01167 ;
01168 ; Relocate absolute addresses in module A
01169 ;
27A3 119A2D 01170 LD DE,DVRAEND ;Point to last used in A
27A6 219B2D 01171 LD HL,RELTABA ;Point to relo table
27A9 CD3029 01172 CALL RELO ;Relocate absolute refs
27AC D1 01173 POP DE ;Get last byte to use
27AD 219A2D 01174 LD HL,DVRAEND ;Last byte of module
27B0 018C00 01175 LD BC,DVRAEND-DVRABGN+1
27B3 EDB8 01176 LDDR
27B5 211100 01177 LD HL,PRMSAV+2-DVRABGN+1
27B8 19 01178 ADD HL,DE ;Data area in himem
27B9 73 01179 LD (HL),E
27BA 23 01180 INC HL
27BB 72 01181 LD (HL),D ;Save high$ there
01182 ;
01183 ; Stuff new HIGH$
01184 ;
27BC 210000 01185 OLDHI LD HL,$-$ ;P/u old HIGH$
27BF ED52 01186 SBC HL,DE ;Check if old HIGH$ is
27C1 3805 01187 JR C,NOSET ; already lower
27C3 EB 01188 EX DE,HL ;New HIGH$ to HL
27C4 01189 @@HIGH$ ;Stuff new HIGH$
27C4+3E64 01190 LD A,100
27C6+EF 01191 RST 40
27C7 EB 01192 EX DE,HL
27C8 13 01193 NOSET INC DE ;Point to module start
27C9 2A192D 01194 LD HL,(S0DCB) ;P/u module DCB pointer
27CC 3646 01195 LD (HL),46H ; & set to filter
27CE 23 01196 INC HL ;Pt to DCB vector pos
27CF 73 01197 LD (HL),E ;Put entry point of
27D0 23 01198 INC HL ; module into DCB
27D1 72 01199 LD (HL),D
27D2 116A2D 01200 LD DE,DSPLTCB ;Calculate entry point
27D3 01201 RX05 EQU $-2
27D5 0E09 01202 LD C,9 ;This will be task 9
27D7 01203 @@ADTSK
27D7+3E1D 01204 LD A,29
27D9+EF 01205 RST 40
27DA 218C2D 01206 LD HL,GETBLK ;Now update device hook
27DB 01207 RX06 EQU $-2
01208 ;
01209 ; Interface to KITSK - No need to DI/EI
01210 ; As KITSK not used by interrupts
01211 ;
27DD FD7421 01212 LD (IY+KITSK@+2),H ;Move in device
27E0 FD7520 01213 LD (IY+KITSK@+1),L ; vector and a
27E3 3EC3 01214 LD A,0C3H ; JP opcode
27E5 FD771F 01215 LD (IY+KITSK@),A
27E8 FDCB03C6 01216 SET 0,(IY+'D'-'A') ;Turn on device flag bit
27EC FDCB0FFE 01217 SET 7,(IY+'P'-'A') ;Show not paused
01218 ;
01219 ; Filter the specified device driver
01220 ;
27F0 2A252D 01221 LD HL,(MODDVR) ;Ptr to device DCB
27F3 ED5B192D 01222 LD DE,(S0DCB) ;Ptr to spooler DCB
27F7 0603 01223 LD B,3
27F9 F3 01224 DI ;Interrupts off during swap
27FA 4E 01225 SWAP LD C,(HL) ;Swap first 3 bytes
27FB 1A 01226 LD A,(DE)
27FC 77 01227 LD (HL),A ; of the DCBs
27FD 79 01228 LD A,C
27FE 12 01229 LD (DE),A
27FF 2C 01230 INC L ;Bump DCB pointers
2800 1C 01231 INC E
2801 10F7 01232 DJNZ SWAP ;Loop 3 times
2803 FB 01233 EI
2804 C31D24 01234 JP SPLACT ;Set complete
01235 ;
01236 ; Routine to PAUSE despooling
01237 ;
2807 FDCB0346 01238 PAUSE BIT 0,(IY+'D'-'A') ;Spool resident?
280B CA2524 01239 JP Z,SPLOFM ;Quit if not
280E FDCB0F7E 01240 BIT 7,(IY+'P'-'A') ;Ck first if active
2812 FDCB0FBE 01241 RES 7,(IY+'P'-'A') ; then turn off
01242 IF @BLD631F
2816 212924 01243 LD HL,SPLOPM ;<631F>Patch
01244 ELSE
01245 JP Z,SPLOPM ;Quit if already paused
01246 ENDIF
2819 C31924 01247 JP PAUSED
01248 ;
01249 ; Routine to RESUME despooling
01250 ;
281C FDCB0346 01251 RESUME BIT 0,(IY+'D'-'A') ;Ck first if resident
2820 CA2524 01252 JP Z,SPLOFM ;Quit if not
2823 FDCB0F7E 01253 BIT 7,(IY+'P'-'A') ;See if despooling now
2827 FDCB0FFE 01254 SET 7,(IY+'P'-'A')
282B C22124 01255 JP NZ,SPLONM ;Can't resume if so
282E C31524 01256 JP RESUMD
01257 ;
01258 ; Routine to turn off the spooler
01259 ;
2831 FDCB0346 01260 SPLOFF BIT 0,(IY+'D'-'A') ;Test if off already
2835 CA2524 01261 JP Z,SPLOFM ;Go if off now
2838 11142D 01262 LD DE,SPOOL$ ;Find out where spooler
283B 01263 @@GTMOD
283B+3E53 01264 LD A,83
283D+EF 01265 RST 40
283E C24624 01266 JP NZ,NOFIND ;Quit if not there
2841 FDCB0386 01267 RES 0,(IY+'D'-'A') ; else turn off
2845 FDCB0FBE 01268 RES 7,(IY+'P'-'A') ;Show paused also
2849 018900 01269 LD BC,GETBLK0-DVRABGN
284C 09 01270 ADD HL,BC ;Point to KITSK@ swap
284D 7E 01271 LD A,(HL)
284E FD771F 01272 LD (IY+KITSK@),A ;Restuff KIHOOK
2851 23 01273 INC HL
2852 7E 01274 LD A,(HL)
2853 FD7520 01275 LD (IY+KITSK@+1),L
2856 23 01276 INC HL
2857 7E 01277 LD A,(HL)
2858 FD7721 01278 LD (IY+KITSK@+2),A
285B 0E09 01279 LD C,9 ;Remove task 9 from
285D 01280 @@RMTSK ; the task processor
285D+3E1E 01281 LD A,30
285F+EF 01282 RST 40
01283 ;
01284 ; Attempt to reclaim memory space
01285 ;
2860 210000 01286 LD HL,0 ;Get current HIGH$
2863 45 01287 LD B,L
2864 01288 @@HIGH$
2864+3E64 01289 LD A,100
2866+EF 01290 RST 40
2867 DD5E02 01291 LD E,(IX+2) ;Get HIGH$ after spool
286A DD5603 01292 LD D,(IX+3) ; was installed
286D AF 01293 XOR A
286E ED52 01294 SBC HL,DE ;Is it the same now?
2870 DD5E00 01295 LD E,(IX+0) ;Get HIGH before res
2873 DD7700 01296 LD (IX+0),A ; & clear data
2876 DD5601 01297 LD D,(IX+1)
2879 DD7701 01298 LD (IX+1),A
287C 21552A 01299 LD HL,NOMEM$ ;Init "Can't reclaim...
287F 2007 01300 JR NZ,LOGMEM ;Go if HIGH$ different
2881 EB 01301 EX DE,HL ; else release memory
2882 01302 @@HIGH$ ; by resetting HIGH$
2882+3E64 01303 LD A,100
2884+EF 01304 RST 40
2885 21702A 01305 LD HL,GOTMEM$ ;"Memory released
2888 01306 LOGMEM @@LOGOT
01307 IFEQ 00H,1
01308 LD HL,
01309 ENDIF
2888+3E0C 01310 LD A,12
288A+EF 01311 RST 40
01312 ;
01313 ; De-use any RAM bank
01314 ;
288B DD7E0A 01315 LD A,(IX+10) ;P/u bank used
01316 IF @BLD631F
288E E61F 01317 AND 1FH ;<631F>Strip up to 30
01318 ELSE
01319 AND 7 ;Strip 3-7
01320 ENDIF
2890 2811 01321 JR Z,RESDCB ;Jump if only bank 0
2892 4F 01322 LD C,A ;Save bank in C
2893 F630 01323 OR '0' ;Convert to ASCII for dsply
01324 IF @BLD631F
2895 CDEF29 01325 CALL P631F1 ;<631F>Patch
01326 ELSE
01327 LD (FREBNK$+5),A ;Stuff in message
01328 ENDIF
2898 0601 01329 LD B,1 ;Function to reset BUR$
289A 01330 @@BANK ;Free the bank
289A+3E66 01331 LD A,102
289C+EF 01332 RST 40
289D 21872A 01333 LD HL,FREBNK$ ;Init"Bank released
28A0 01334 @@LOGOT
01335 IFEQ 00H,1
01336 LD HL,
01337 ENDIF
28A0+3E0C 01338 LD A,12
28A2+EF 01339 RST 40
01340 ;
01341 ; RESET the device
01342 ;
28A3 210000 01343 RESDCB LD HL,$-$
28A4 01344 SVDCB EQU $-2 ;Point to SPOOL DCB ptr
28A6 5E 01345 LD E,(HL) ; & get the DCB ptr
28A7 23 01346 INC HL ; into reg DE
28A8 56 01347 LD D,(HL)
01348 ;
01349 ; Check if DCB is inactive [user RESET *PR]
01350 ;
28A9 D5 01351 PUSH DE ;Save DCB pointer
28AA 1C 01352 INC E
28AB 1A 01353 LD A,(DE) ;Get DCB vector contents
28AC 4F 01354 LD C,A ; into reg BC
28AD 1C 01355 INC E
28AE 1A 01356 LD A,(DE)
28AF 47 01357 LD B,A
28B0 D1 01358 POP DE ;Recover DCB pointer
28B1 210000 01359 LD HL,$-$ ;P/u start of module
28B2 01360 SVBGN EQU $-2
28B4 AF 01361 XOR A ;If vector points to
28B5 ED42 01362 SBC HL,BC ; start of module,
28B7 C8 01363 RET Z ; we are finished
28B8 DD6E08 01364 LD L,(IX+8) ;P/u DCB being spooled
28BB DD6609 01365 LD H,(IX+9)
28BE EB 01366 EX DE,HL ;SPOOL to HL,
28BF 0603 01367 LD B,3 ; device to DE
28C1 F3 01368 DI
28C2 7E 01369 SWAP1 LD A,(HL) ;Undo the SPOOLer
28C3 3600 01370 LD (HL),0 ; by swapping back the
28C5 12 01371 LD (DE),A ; original vector and
28C6 2C 01372 INC L ; zeroing the spool DCB
28C7 1C 01373 INC E
28C8 10F8 01374 DJNZ SWAP1
28CA 2C 01375 INC L ;Point to name field
28CB 2C 01376 INC L ; & wipe it out
28CC 2C 01377 INC L
28CD 3600 01378 LD (HL),0
28CF 2C 01379 INC L
28D0 3600 01380 LD (HL),0
28D2 FB 01381 EI
28D3 C9 01382 RET ;Done - return
01383 ;
01384 ; Routine to CLEAR the SPOOL buffer
01385 ;
28D4 FDCB0346 01386 CLEAR BIT 0,(IY+'D'-'A') ;Spool active?
28D8 CA2524 01387 JP Z,SPLOFM ;Go if not active
28DB DD210000 01388 LD IX,$-$ ;Parms in himem
28DD 01389 HIPARM EQU $-2
28DF DD6E0B 01390 LD L,(IX+11) ;P/u SPLFCB pointer
28E2 DD660C 01391 LD H,(IX+12)
28E5 DD4E0A 01392 LD C,(IX+10) ;P/u RAM bank used
28E8 CBB9 01393 RES 7,C ;Set on xfer to bank
28EA 0600 01394 LD B,0 ;Function to load bank
28EC F3 01395 DI ;Interrupts off now
28ED 01396 @@BANK
28ED+3E66 01397 LD A,102
28EF+EF 01398 RST 40
28F0 C5 01399 PUSH BC ;Save old bank
28F1 E5 01400 PUSH HL ;Xfer FCB pointer
28F2 DDE1 01401 POP IX ; to IX
28F4 DD6E24 01402 LD L,(IX+24H) ;Get LINK map pointer
28F7 DD6625 01403 LD H,(IX+25H)
28FA E5 01404 PUSH HL
28FB 3600 01405 CLEAR1 LD (HL),0 ;Reset every link
28FD 23 01406 INC HL
28FE 3600 01407 LD (HL),0
2900 23 01408 INC HL ;Bypass page pointer
2901 23 01409 INC HL
2902 7E 01410 LD A,(HL) ;Ck for TABEND
2903 23 01411 INC HL
2904 3C 01412 INC A ;End if it was X'FF'
2905 20F4 01413 JR NZ,CLEAR1
2907 E1 01414 POP HL ;Point to LINK start
2908 DD7526 01415 LD (IX+26H),L ;Reset PUTBLK$
290B DD7427 01416 LD (IX+27H),H
290E DD7528 01417 LD (IX+28H),L ;Reset GETBLK$
2911 DD7429 01418 LD (IX+29H),H
2914 7C 01419 LD A,H ;Show 1st LINK position
2915 75 01420 LD (HL),L ; is the "last" one by
2916 23 01421 INC HL ; loading it to point
2917 77 01422 LD (HL),A ; to itself
2918 23 01423 INC HL ;P/u the page pointer
2919 46 01424 LD B,(HL)
291A DD7021 01425 LD (IX+21H),B ;Stuff PUTNXT$
291D DD362000 01426 LD (IX+20H),0
2921 DD7023 01427 LD (IX+23H),B ;Stuff GETNXT$
2924 DD362200 01428 LD (IX+22H),0
2928 C1 01429 POP BC ;Reload previous bank
2929 01430 @@BANK
2929+3E66 01431 LD A,102
292B+EF 01432 RST 40
292C FB 01433 EI
292D C31124 01434 JP CLEARD
01435 ;
01436 ; Relocate internal references in driver
01437 ; HL = relocation table
01438 ; DE = pointer to last byte of module
01439 ; BC = pointer to last RAM byte to use
01440 ;
2930 DDE5 01441 RELO PUSH IX ;Save index reg
2932 E5 01442 PUSH HL ;Xfer rel tab pointer
2933 DDE1 01443 POP IX
2935 210000 01444 SVEND LD HL,$-$ ;P/u last byte used
2938 22112D 01445 LD (DVRABGN+2),HL ; & stuff into module
293B 60 01446 LD H,B ;Xfer last byte to
293C 69 01447 LD L,C ; use to HL
293D AF 01448 XOR A ;Clear carry flag
293E ED52 01449 SBC HL,DE
2940 44 01450 LD B,H ;Move to BC
2941 4D 01451 LD C,L
2942 DD7E00 01452 LD A,(IX) ;Get table length
2945 DD23 01453 INC IX
2947 DD6E00 01454 RLOOP LD L,(IX) ;Get address to change
294A DD6601 01455 LD H,(IX+1)
294D 5E 01456 LD E,(HL) ;P/U address
294E 23 01457 INC HL
294F 56 01458 LD D,(HL)
2950 EB 01459 EX DE,HL ;Offset it
2951 09 01460 ADD HL,BC
2952 EB 01461 EX DE,HL
2953 72 01462 LD (HL),D ;And put back
2954 2B 01463 DEC HL
2955 73 01464 LD (HL),E
2956 DD23 01465 INC IX
2958 DD23 01466 INC IX
295A 3D 01467 DEC A
295B 20EA 01468 JR NZ,RLOOP ;Loop till done
295D DDE1 01469 POP IX
295F C9 01470 RET
01471 ;
2960 43 01472 NOFIND$ DB 'Can''t locate SPOOL in memory',CR
61 6E 27 74 20 6C 6F 63
61 74 65 20 53 50 4F 4F
4C 20 69 6E 20 6D 65 6D
6F 72 79 0D
297D 53 01473 CLEARD$ DB 'SPOOL buffer cleared',CR
50 4F 4F 4C 20 62 75 66
66 65 72 20 63 6C 65 61
72 65 64 0D
2992 44 01474 PAUSED$ DB 'Despooling now paused',CR
65 73 70 6F 6F 6C 69 6E
67 20 6E 6F 77 20 70 61
75 73 65 64 0D
29A8 44 01475 RESUMD$ DB 'Despooling now resumed',CR
65 73 70 6F 6F 6C 69 6E
67 20 6E 6F 77 20 72 65
73 75 6D 65 64 0D
29BF 53 01476 SPLOFM$ DB 'Spooler is not active',CR
70 6F 6F 6C 65 72 20 69
73 20 6E 6F 74 20 61 63
74 69 76 65 0D
29D5 53 01477 SPLONM$ DB 'Spooler is already active',CR
70 6F 6F 6C 65 72 20 69
73 20 61 6C 72 65 61 64
79 20 61 63 74 69 76 65
0D
01478 IF @BLD631F
01479 SPLOPM$ ;<631F>
29EF 69 01480 P631F1 LD L,C ;<631F>
29F0 2600 01481 LD H,0 ;<631F>
29F2 118C2A 01482 LD DE,2A8CH ;<631F>
29F5 C5 01483 PUSH BC ;<631F>
29F6 0602 01484 LD B,2 ;<631F>
29F8 3E5F 01485 LD A,5FH ;<631F>@@HEXD
29FA EF 01486 RST 28H ;<631F>
29FB C1 01487 POP BC ;<631F>
29FC C9 01488 RET ;<631F>
29FD 79 01489 DB 'y ' ;<631F>
20
29FF 61 01490 DB 'active but paused',CR ;<631F>
63 74 69 76 65 20 62 75
74 20 70 61 75 73 65 64
0D
01491 ELSE
01492 SPLOPM$ DB 'Spooler already active but paused',CR
01493 ENDIF
2A11 43 01494 PRMBGM$ DB 'Cannot reinstall with altered parameters',CR
61 6E 6E 6F 74 20 72 65
69 6E 73 74 61 6C 6C 20
77 69 74 68 20 61 6C 74
65 72 65 64 20 70 61 72
61 6D 65 74 65 72 73 0D
2A3A 53 01495 SPLACT$ DB 'Spooler is now operational',CR
70 6F 6F 6C 65 72 20 69
73 20 6E 6F 77 20 6F 70
65 72 61 74 69 6F 6E 61
6C 0D
2A55 43 01496 NOMEM$ DB 'Can''t reclaim memory space',CR
61 6E 27 74 20 72 65 63
6C 61 69 6D 20 6D 65 6D
6F 72 79 20 73 70 61 63
65 0D
2A70 4D 01497 GOTMEM$ DB 'Memory space reclaimed',CR
65 6D 6F 72 79 20 73 70
61 63 65 20 72 65 63 6C
61 69 6D 65 64 0D
01498 IF @BLD631F
2A87 42 01499 FREBNK$ DB 'Bank xx freed ',CR ;<631F>
61 6E 6B 20 78 78 20 66
72 65 65 64 20 20 0D
01500 ELSE
01501 FREBNK$ DB 'Bank x released',CR
01502 ENDIF
2A97 52 01503 INUSE$ DB 'Requested bank in use',CR
65 71 75 65 73 74 65 64
20 62 61 6E 6B 20 69 6E
20 75 73 65 0D
2AAD 4E 01504 CANT$ DB 'No memory space available',CR
6F 20 6D 65 6D 6F 72 79
20 73 70 61 63 65 20 61
76 61 69 6C 61 62 6C 65
0D
2AC7 44 01505 BADDCB$ DB 'Device driver incompatible',CR
65 76 69 63 65 20 64 72
69 76 65 72 20 69 6E 63
6F 6D 70 61 74 69 62 6C
65 0D
2AE2 01506 SPLDCB DS 32
2B02 58 01507 DSKSPC DB 'XX/'
58 2F
2B05 53 01508 SPLEXT DB 'SPL',3
50 4C 03
2B09 2A 01509 PR$ DB '*PR',ETX
50 52 03
01510 ;
2B0D D2 01511 PRMTBL$ DB 'R'!80H ;6.x table format
0080 01512 VAL EQU 80H
0040 01513 SW EQU 40H
0020 01514 STR EQU 20H
0010 01515 SGL EQU 10H
2B0E 93 01516 DB VAL!SGL!3,'MEM',0
4D 45 4D 00
2B13 8D26 01517 DW MPARM+1
2B15 94 01518 DB VAL!SGL!4,'DISK',0
44 49 53 4B 00
2B1B 1B26 01519 DW DPARM+1
2B1D 43 01520 DB SW!3,'OFF',0
4F 46 46 00
2B22 1925 01521 DW OPARM+1
2B24 41 01522 DB SW!1,'N',0
4E 00
2B27 1925 01523 DW OPARM+1
2B29 94 01524 DB VAL!SGL!4,'BANK',0
42 41 4E 4B 00
2B2F B625 01525 DW BPARM+1
2B31 55 01526 DB SW!SGL!5,'PAUSE',0
50 41 55 53 45 00
2B38 2725 01527 DW PPARM+1
2B3A 56 01528 DB SW!SGL!6,'RESUME',0
52 45 53 55 4D 45 00
2B42 2025 01529 DW RPARM+1
2B44 55 01530 DB SW!SGL!5,'CLEAR',0
43 4C 45 41 52 00
2B4B 2E25 01531 DW CPARM+1
2B4D 00 01532 NOP
01533 ;
2C00 01534 ORG $<-8+1<8
2C00 01535 BUFFER DS 256
01537 ;
2D00 01538 *GET LBSPOOLB:3
01539 ;LBSPOOLB/ASM - Actual spool driver
01540 ;
01541 ;
01542 ; This is the spool/despool driver - bank 0
01543 ;
2D00 CDC32D 01544 FIX1 CALL SPLR2 ;Code mods to module-A
2D01 01545 RX16 EQU $-2 ; if strictly bank-0
2D03 AF 01546 XOR A
2D04 C9 01547 RET
2D05 CD732E 01548 CALL DSPLR1
2D06 01549 RX17 EQU $-2
2D08 AF 01550 XOR A
2D09 C9 01551 RET
2D0A CDBA2E 01552 CALL GETBLK2
2D0B 01553 RX18 EQU $-2
2D0D AF 01554 XOR A
2D0E C9 01555 RET
01556 ;
2D0F 01557 DVRABGN EQU $
2D0F 1819 01558 JR DVREPT ;Branch around linkage
2D11 0000 01559 DW $-$ ;Last byte used
2D13 05 01560 DB 5
2D14 53 01561 SPOOL$ DB 'SPOOL'
50 4F 4F 4C
2D19 0000 01562 S0DCB DW 0,0 ;Space for DCB pointers
0000
2D1D 0000 01563 PRMSAV DW 0 ;HIGH$ before space alloc
2D1F 0E2D 01564 DW DVRABGN-1 ;HIGH$ after space alloc
2D21 0000 01565 DW 0 ;Previous MPARM
2D23 0000 01566 DW 0 ;Previous DPARM
2D25 0000 01567 MODDVR DW 0 ;DCB address of device
2D27 00 01568 SPLBNK DB 0 ;Bank of RAM
2D28 332F 01569 DW SPLFCB ;FCB pointer
2D28 01570 RX8 EQU $-2
01571 ;
2D2A 2830 01572 DVREPT JR Z,PUTCHAR ;Go on @PUT
2D2C 3003 01573 JR NC,CKCTL ;Go on @CTL
2D2E 3E00 01574 LD A,0 ;Show nothing on @GET
2D30 C9 01575 RET
2D31 AF 01576 CKCTL XOR A
2D32 C9 01577 RET ;Show available on CTL-0
01578 ;
01579 ; Move stack low if needed
01580 ;
2D33 E5 01581 STKCTL PUSH HL
2D34 210580 01582 LD HL,8005H
2D37 39 01583 ADD HL,SP ;Stack in what bank?
2D38 E1 01584 POP HL
2D39 D0 01585 RET NC ;Ok if stack low
2D3A F3 01586 DI
2D3B 225A2D 01587 LD (SVHL),HL
2D3C 01588 RX19 EQU $-2
2D3E E1 01589 POP HL ;Return address
2D3F ED73582D 01590 LD (SAVSTK),SP ;Save the current stack
2D41 01591 RX20 EQU $-2
01592 IF @BLD631
2D43 314003 01593 LD SP,STACK$-40H ;<631>Force it low
01594 ELSE
01595 LD SP,STACK$-20H ;Force it low
01596 ENDIF
2D46 E5 01597 PUSH HL ;User ret back on
2D47 21512D 01598 LD HL,SPOLRET
2D48 01599 RX21 EQU $-2
2D4A E3 01600 EX (SP),HL ;Now, ultimate ret 1st,
2D4B E5 01601 PUSH HL ; and local ret 2nd
2D4C 2A5A2D 01602 LD HL,(SVHL) ;Restore HL
2D4D 01603 RX23 EQU $-2
2D4F FB 01604 EI
2D50 C9 01605 RET
01606 ;
01607 SPOLRET
2D51 F3 01608 DI ;Just in case
2D52 ED7B582D 01609 LD SP,(SAVSTK) ;Get the old stack
2D54 01610 RX22 EQU $-2
2D56 FB 01611 EI
2D57 C9 01612 RET
2D58 0000 01613 SAVSTK DW 0
2D5A 0000 01614 SVHL DW 0
01615 ;
01616 ; Character to PUT - Get bank activated
01617 ;
2D5C 21B82D 01618 PUTCHAR LD HL,SPLR1A ;Point to transfer addr
2D5D 01619 RX01 EQU $-2
2D5F 59 01620 LD E,C ;Xfer char to PUT
2D60 018000 01621 LD BC,0<8!0!80H ;P/u function & bank req
2D61 01622 BANKX1 EQU $-2
2D63 CD332D 01623 CALL STKCTL ;Move stack low?
2D64 01624 RX24 EQU $-2
2D66 01625 @@BANK ; & invoke bank transfer
2D66+3E66 01626 LD A,102
2D68+EF 01627 RST 40
2D69 C9 01628 RET
01629 ;
01630 ; Task processor despooling routine
01631 ;
2D6A 6C2D 01632 DSPLTCB DW DSPLR ;Despool task control blk
2D6A 01633 RX02 EQU $-2
2D6C 3A0000 01634 DSPLR LD A,($-$) ;P/u PFLAG$ & ck if
2D6D 01635 DFLAG EQU $-2 ; despooling is active
2D6F 07 01636 RLCA
2D70 D0 01637 RET NC ;Back if not
2D71 2A192D 01638 LD HL,(S0DCB) ;If spooler is inactive
2D72 01639 RX08 EQU $-2 ; then don't try to
2D74 2C 01640 INC L ; do any despooling
2D75 4E 01641 LD C,(HL) ;Get DCB vector
2D76 2C 01642 INC L
2D77 46 01643 LD B,(HL) ; into BC
2D78 210F2D 01644 LD HL,DVRABGN ;P/u spooler start
2D79 01645 RX09 EQU $-2
2D7B AF 01646 XOR A
2D7C ED42 01647 SBC HL,BC ;If the same, then
2D7E C8 01648 RET Z ; module is not active
2D7F 21642E 01649 FIX2UP LD HL,DSPLR0 ;Point to transfer addr
2D80 01650 RX03 EQU $-2
2D82 018000 01651 LD BC,0<8!0!80H ;P/u function & bank req
2D83 01652 BANKX2 EQU $-2
2D85 CD332D 01653 CALL STKCTL ;Move stack low?
2D86 01654 RX25 EQU $-2
2D88 01655 @@BANK ; & invoke bank transfer
2D88+3E66 01656 LD A,102
2D8A+EF 01657 RST 40
2D8B C9 01658 RET
01659 ;
01660 ; KI task routine to get a disk block
01661 ;
2D8C 21B02E 01662 GETBLK LD HL,GETBLK1 ;Point to transfer addr
2D8D 01663 RX04 EQU $-2
2D8F 018000 01664 LD BC,0<8!0!80H ;P/u function & bank req
2D90 01665 BANKX3 EQU $-2
2D92 CD332D 01666 CALL STKCTL ;Move stack low?
2D93 01667 RX26 EQU $-2
2D95 01668 @@BANK ; & invoke bank transfer
2D95+3E66 01669 LD A,102
2D97+EF 01670 RST 40
2D98 00 01671 GETBLK0 DB 0,0,0 ;Orig @KITSK
00 00
2D9A 01672 DVRAEND EQU $-1
2D9B 0D 01673 RELTABA DB TABALEN
2D9C 6A2D 01674 DW RX02,RX05,RX06,RX08,RX09
D327 DB27 722D 792D
2DA6 3C2D 01675 DW RX19,RX20,RX21,RX22,RX23
412D 482D 542D 4D2D
2DB0 642D 01676 DW RX24,RX25,RX26
862D 932D
000D 01677 TABALEN EQU $-RELTABA/2
01678 ;
01679 ;
2DB6 01680 DVRBBGN EQU $
01681 ;
01682 ; Spool/despool module in bank x
01683 ;
2DB6 0000 01684 S0DCB1 DW 0
01685 ;
01686 ; Spool a character
01687 ;
2DB8 E5 01688 SPLR1A PUSH HL ;Save new transfer addr
2DB9 C5 01689 PUSH BC ;Save invocation
2DBA 4B 01690 LD C,E ;Get char to PUT
2DBB CDC32D 01691 CALL SPLR2 ;Spool a char
2DBC 01692 RX1 EQU $-2
2DBE C1 01693 POP BC
2DBF E1 01694 POP HL
2DC0 01695 @@BANK ;Transfer back
2DC0+3E66 01696 LD A,102
2DC2+EF 01697 RST 40
2DC3 DD21332F 01698 SPLR2 LD IX,SPLFCB
2DC5 01699 RX2 EQU $-2
2DC7 DD6E20 01700 LD L,(IX+20H) ;P/u next buffer position
2DCA DD6621 01701 LD H,(IX+21H)
2DCD 71 01702 LD (HL),C ;Stuff char received
2DCE F3 01703 DI
2DCF DD3420 01704 SPLR3 INC (IX+20H) ;Inc lo order
2DD2 2807 01705 JR Z,SPLR5 ;Jump if block full
2DD4 CD6E2E 01706 CALL DSPLR1X ;Output to *PR if avail
2DD5 01707 RX3 EQU $-2
2DD7 FB 01708 EI
2DD8 C3BA2E 01709 JP GETBLK2
2DD9 01710 RX4 EQU $-2
2DDB DD6E24 01711 SPLR5 LD L,(IX+24H) ;P/u pointer to table
2DDE DD6625 01712 LD H,(IX+25H)
2DE1 7E 01713 SPLR6 LD A,(HL) ;Find spare pointer field
2DE2 23 01714 INC HL
2DE3 B6 01715 OR (HL)
2DE4 2805 01716 JR Z,SPLR7 ;Jump if spare
2DE6 23 01717 INC HL ; else index to next
2DE7 23 01718 INC HL
2DE8 23 01719 INC HL
2DE9 18F6 01720 JR SPLR6
2DEB 2B 01721 SPLR7 DEC HL
2DEC E5 01722 PUSH HL ;Save pointer
2DED 23 01723 INC HL
2DEE 23 01724 INC HL
2DEF 46 01725 LD B,(HL) ;P/u memory segment byte
2DF0 23 01726 INC HL ; or lo-order recno
2DF1 7E 01727 LD A,(HL) ;End of table?
2DF2 FEFF 01728 CP 0FFH
2DF4 200B 01729 JR NZ,SPLR10 ;Jump if still space
2DF6 E1 01730 POP HL
2DF7 CD6E2E 01731 SPLR8 CALL DSPLR1X ;Output to *PR if avail
2DF8 01732 RX5 EQU $-2
2DFA FB 01733 EI
2DFB CDBA2E 01734 SPLR9 CALL GETBLK2 ;Disk rec to bring back?
2DFC 01735 RX6 EQU $-2
2DFE F3 01736 DI
2DFF 18DA 01737 JR SPLR5
2E01 CB7F 01738 SPLR10 BIT 7,A ;Test mem or disk block
2E03 2021 01739 JR NZ,SPLR12 ;Jump if disk pointer
01740 ;
01741 ; Found a spare memory pointer
01742 ;
2E05 E1 01743 POP HL ;Rcvr ptr to start
2E06 E5 01744 PUSH HL ; of spare table field
2E07 75 01745 LD (HL),L ;Place address of table
2E08 7C 01746 LD A,H ; position into table
2E09 23 01747 INC HL
2E0A 77 01748 LD (HL),A
2E0B DD7021 01749 LD (IX+21H),B ;Stuff hi-order free mem
2E0E DD6E26 01750 LD L,(IX+26H) ;P/u current table ptr
2E11 DD6627 01751 LD H,(IX+27H)
2E14 DD752A 01752 LD (IX+2AH),L ;Stuff last block pointer
2E17 DD742B 01753 LD (IX+2BH),H
2E1A C1 01754 POP BC ;Rcvr ptr to field start
2E1B 71 01755 LD (HL),C ;Set up a link to this
2E1C 23 01756 INC HL ; block in last block
2E1D 70 01757 LD (HL),B
2E1E DD7126 01758 LD (IX+26H),C ;Reset current block ptr
2E21 DD7027 01759 LD (IX+27H),B
2E24 FB 01760 EI
2E25 C9 01761 RET
01762 ;
2E26 01763 SPLR12 EQU $
2E26 FB 01764 EI
2E27 48 01765 LD C,B ;Lo order recno
2E28 E60F 01766 AND 0FH ;Hi-order recno
2E2A 47 01767 LD B,A
2E2B DDE5 01768 PUSH IX ;Position file to recno
2E2D D1 01769 POP DE ;FCB to DE
2E2E 01770 @@POSN ;Posn to desired record
2E2E+3E42 01771 LD A,66
2E30+EF 01772 RST 40
2E31 00 01773 DB 0,0,0 ;Reserved
00 00
2E34 DD4E26 01774 LD C,(IX+26H) ;P/u current table ptr
2E37 DD4627 01775 LD B,(IX+27H)
2E3A E1 01776 POP HL ;P/u ptr to this disk
2E3B E5 01777 PUSH HL ;Block table field
2E3C 71 01778 LD (HL),C ;Tell this disk block
2E3D 23 01779 INC HL ; field which memory
2E3E 70 01780 LD (HL),B ; block it is storing
2E3F C1 01781 POP BC ;Exchange link in last
2E40 DD6E2A 01782 LD L,(IX+2AH) ; block pointer with new
2E43 DD662B 01783 LD H,(IX+2BH) ; link since this memory
2E46 71 01784 LD (HL),C ; block is now on disk
2E47 23 01785 INC HL
2E48 70 01786 LD (HL),B
2E49 DD712A 01787 LD (IX+2AH),C
2E4C DD702B 01788 LD (IX+2BH),B
2E4F 010001 01789 LD BC,256 ;Block move the page
2E52 69 01790 LD L,C ; into the low memory
2E53 DD6621 01791 LD H,(IX+21H) ; buuffer fo disk I/O
2E56 D5 01792 PUSH DE ;Save fcb pointer
2E57 110023 01793 LD DE,LOWBUF$
2E5A EDB0 01794 LDIR
2E5C D1 01795 POP DE
2E5D 01796 @@WRITE ;Write out the block
2E5D+3E4B 01797 LD A,75
2E5F+EF 01798 RST 40
2E60 00 01799 DB 0,0,0 ;Reserved
00 00
2E63 C9 01800 RET
01801 ;
2E64 E5 01802 DSPLR0 PUSH HL ;Save new transfer addr
2E65 C5 01803 PUSH BC ;Save invocation
2E66 CD732E 01804 CALL DSPLR1 ;Send device a char
2E67 01805 RX7 EQU $-2
2E69 C1 01806 POP BC
2E6A E1 01807 POP HL
2E6B 01808 @@BANK ;Transfer back
2E6B+3E66 01809 LD A,102
2E6D+EF 01810 RST 40
01811 ;
01812 ; Routine will output a char to PR if available
01813 ;
2E6E 3A0000 01814 DSPLR1X LD A,($-$) ;P/u PFLAG$ & ck if
2E6F 01815 DFLAG1 EQU $-2 ; despooling is active
2E71 07 01816 RLCA
2E72 D0 01817 RET NC ;Back if not active
2E73 010004 01818 DSPLR1 LD BC,4<8!0 ;Init to CTL-0
2E76 DDE5 01819 PUSH IX ;Save current DCB vector
2E78 DD2AB62D 01820 PUDCB LD IX,(S0DCB1) ;Point to printer
2E7A 01821 RX9 EQU $-2
2E7C 01822 @@CHNIO ;Ck *PR status
2E7C+3E14 01823 LD A,20
2E7E+EF 01824 RST 40
2E7F DDE1 01825 POP IX
2E81 C0 01826 RET NZ ;Ret if not avail
2E82 DD21332F 01827 PUFCB LD IX,SPLFCB
2E84 01828 RX10 EQU $-2
2E86 DD7E23 01829 LD A,(IX+23H) ;See if char in buffer
2E89 B7 01830 OR A ; to send to the printer
2E8A C8 01831 RET Z ;Ret if none
2E8B 67 01832 LD H,A ;None also if GET pointer
2E8C DDBE21 01833 CP (IX+21H) ; is same as PUT pointer
2E8F DD7E22 01834 LD A,(IX+22H)
2E92 2004 01835 JR NZ,DSPLR2
2E94 DDBE20 01836 CP (IX+20H)
2E97 C8 01837 RET Z ;In & out the same
2E98 6F 01838 DSPLR2 LD L,A ;P/u the character
2E99 4E 01839 LD C,(HL) ;Xfer to output reg
2E9A DDE5 01840 PUSH IX ;Save this dcb vector
2E9C 0602 01841 LD B,2 ;Set chain for PUT
2E9E DD2AB62D 01842 PUDCB1 LD IX,(S0DCB1) ;Pt to spooled DCB
2EA0 01843 RX11 EQU $-2
2EA2 01844 @@CHNIO ;Output the char
2EA2+3E14 01845 LD A,20
2EA4+EF 01846 RST 40
2EA5 DDE1 01847 POP IX ;Rcvr dcb
2EA7 DD3422 01848 INC (IX+22H) ;Bump PUT (out) ptr
2EAA C0 01849 RET NZ ;Ret if still more in buf
2EAB DD362300 01850 LD (IX+23H),0 ;Block empty, turn off
2EAF C9 01851 RET ; hi-order & exit
01852 ;
01853 ; Routine to see if we can grab a block back from
01854 ; the disk file & insert into a spare memory block
01855 ;
2EB0 E5 01856 GETBLK1 PUSH HL ;Save new transfer addr
2EB1 C5 01857 PUSH BC ;Save invocation
2EB2 CDBA2E 01858 CALL GETBLK2 ;Spool a char
2EB3 01859 RX12 EQU $-2
2EB5 C1 01860 POP BC
2EB6 E1 01861 POP HL
2EB7 01862 @@BANK ;Transfer back
2EB7+3E66 01863 LD A,102
2EB9+EF 01864 RST 40
2EBA F5 01865 GETBLK2 PUSH AF
2EBB DDE5 01866 PUSH IX ;Save in case DSPLR1
2EBD 3A562F 01867 GETBLK3 LD A,(SPLFCB+23H) ;Jump if block being
2EBE 01868 RX13 EQU $-2
2EC0 B7 01869 OR A ; printed is not empty
2EC1 202D 01870 JR NZ,GETBLK6
01871 ;
01872 ; The block's been despooled. Get 1 from D,M?
01873 ;
2EC3 E5 01874 PUSH HL
2EC4 D5 01875 PUSH DE
2EC5 C5 01876 PUSH BC
2EC6 DD21332F 01877 GETBLK4 LD IX,SPLFCB
2EC8 01878 RX14 EQU $-2
2ECA DD6E28 01879 LD L,(IX+28H) ;P/u pointer of block
2ECD DD6629 01880 LD H,(IX+29H) ; being printed
2ED0 E5 01881 PUSH HL
2ED1 4E 01882 LD C,(HL) ;Point to POSN or hi-mem
2ED2 23 01883 INC HL ; byte of field this
2ED3 46 01884 LD B,(HL) ; field points to
2ED4 210200 01885 LD HL,2 ;P/u the POSN or hi-order
2ED7 09 01886 ADD HL,BC
2ED8 7E 01887 LD A,(HL)
2ED9 23 01888 INC HL
2EDA CB7E 01889 BIT 7,(HL) ;Jump if it is pointing
2EDC 201B 01890 JR NZ,GETBLK7 ; to a disk block
2EDE DD7723 01891 LD (IX+23H),A ;Reset hi order of where
2EE1 E1 01892 POP HL ; next block coming from
2EE2 3600 01893 LD (HL),0 ;Show that this block
2EE4 23 01894 INC HL ; is spare
2EE5 3600 01895 LD (HL),0
2EE7 DD7128 01896 LD (IX+28H),C ;Set the next block
2EEA DD7029 01897 LD (IX+29H),B ; to be printed
2EED C1 01898 GETBLK5 POP BC
2EEE D1 01899 POP DE
2EEF E1 01900 POP HL
2EF0 01901 GETBLK6 EQU $
2EF0 F3 01902 DI
2EF1 CD6E2E 01903 CALL DSPLR1X ;Check if we can despool
2EF2 01904 RX15 EQU $-2 ; a character while
2EF4 FB 01905 EI ; we are in here
2EF5 DDE1 01906 POP IX
2EF7 F1 01907 POP AF
2EF8 C9 01908 RET
01909 ;
01910 ; Next block to print is on disk, get it
01911 ;
2EF9 4F 01912 GETBLK7 LD C,A ;Set up position
2EFA 7E 01913 LD A,(HL)
2EFB E60F 01914 AND 0FH
2EFD 47 01915 LD B,A
2EFE DDE5 01916 PUSH IX ;Set FCB & position
2F00 D1 01917 POP DE ; the spool file
2F01 01918 @@POSN
2F01+3E42 01919 LD A,66
2F03+EF 01920 RST 40
2F04 00 01921 DB 0,0,0 ;Reserved
00 00
2F07 E1 01922 POP HL ;Rcvr table ptr of
2F08 E5 01923 PUSH HL ; block just finished
2F09 23 01924 INC HL
2F0A 23 01925 INC HL ;P/u its buffer location
2F0B 01926 @@READ ;Read block from file
2F0B+3E43 01927 LD A,67
2F0D+EF 01928 RST 40
2F0E 00 01929 DB 0,0,0 ;Reserved
00 00
2F11 010001 01930 LD BC,256 ;Block move from the
2F14 56 01931 LD D,(HL) ; low memory buffer
2F15 59 01932 LD E,C ; to RAM page
2F16 210023 01933 LD HL,LOWBUF$
2F19 EDB0 01934 LDIR
2F1B E1 01935 POP HL ;Tbl ptr of block fin'd
2F1C E5 01936 PUSH HL
2F1D 7E 01937 LD A,(HL) ;P/u field addrress of
2F1E 23 01938 INC HL ; the next table field
2F1F 66 01939 LD H,(HL) ; that gets printed
2F20 6F 01940 LD L,A
2F21 4E 01941 LD C,(HL) ;P/u field address of the
2F22 3600 01942 LD (HL),0 ; block after that to
2F24 23 01943 INC HL ; print & show this one
2F25 46 01944 LD B,(HL) ; as empty (this was the
2F26 3600 01945 LD (HL),0 ; disk one just vacated)
2F28 E1 01946 POP HL
2F29 71 01947 LD (HL),C ;Reset current printing
2F2A 23 01948 INC HL ; block & point to
2F2B 70 01949 LD (HL),B ; new next block
2F2C 23 01950 INC HL
2F2D 46 01951 LD B,(HL)
2F2E DD7023 01952 LD (IX+23H),B ;Show where new printing
2F31 18BA 01953 JR GETBLK5 ; block is & exit
01954 ;
01955 ; File control block area for spool file
01956 ;
2F33 01957 SPLFCB DS 32
01958 ;
01959 ; Pointer to the memory location where the next
01960 ; character received from *XX can be put
01961 ;
2F53 01962 PUTNXT$ DS 2
01963 ;
01964 ; Pointer to where the next character to print
01965 ; is going to come from
01966 ;
2F55 01967 GETNXT$ DS 2
01968 ;
01969 ; Pointer to start of block map table
01970 ; table configuration is:
01971 ; TAB+0/1 -> store the TAB address if the field
01972 ; is currently in use for receiving. If a
01973 ; block is not current, it stores the
01974 ; address of the next TAB to print. If
01975 ; a disk field, then stores the TAB address
01976 ; of the previous block (link back)
01977 ;
01978 ; TAB+2 -> for a memory block, stores the hi-order
01979 ; byte of where the memory block starts. If
01980 ; a disk byte, stores the lo-order POSN #.
01981 ;
01982 ; TAB+3 -> s/b 0 for a memory block or if a disk
01983 ; block, it contains the hi-order POSN
01984 ; vector with bit 7 set.
01985 ;
2F57 01986 MAPPTR$ DS 2
01987 ;
01988 ; Pointer to the beginning of the memory table
01989 ; block pointer for the block that is receiving
01990 ; characters from *PR calls (the current block)
01991 ;
2F59 01992 PUTBLK$ DS 2
01993 ;
01994 ; Pointer to the memory table field for the block
01995 ; that is printing characters
01996 ;
2F5B 01997 GETBLK$ DS 2
01998 ;
01999 ; Points to the table position of the previous
02000 ; block. This is used to reset the previous link
02001 ;
2F5D 0000 02002 DW 0
2F5E 02003 DVRBEND EQU $-1
2F5F 15 02004 RELTABB DB TABBLEN
2F60 5D2D 02005 DW RX01,RX03,RX04
802D 8D2D
2F66 BC2D 02006 DW RX1,RX2,RX3,RX4,RX5,RX6,RX7,RX8
C52D D52D D92D F82D FC2D 672E 282D
2F76 7A2E 02007 DW RX9,RX10,RX11,RX12,RX13,RX14,RX15
842E A02E B32E BE2E C82E F22E
2F84 012D 02008 DW RX16,RX17,RX18
062D 0B2D
0015 02009 TABBLEN EQU $-RELTABB/2
02010 ;
02012 ;
2400 02014 END SPOOL
2400 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]