.MCALL .MODULE .MODULE SP,VERSION=24,COMMENT=,AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL Conditional Assembly Summary ;+ ;COND ; SP$FLG (0) FLAG_PAGE Support ; 0 no flag pages ; 1 flag pages ; ; SP$DEC (0) Ident as DEC ML copy ; 0 RT-11 ... ; 1 DEC ML ... ; SP$DBG = 0 ; Support/No_Support DEBUGGING code ; SP$VEC = 110 ; "vector" ; ; SP$EPS (0) END_PAGE Support (minimal SPECL$ support) ; ; SP$OPF (0) Optimize ENDPAG FF's ; SP$OLF (0) Old-style (no extention on 80-col flagpages) ; SP$JFW (0) Simple Flagpages - no BIG characters ; ; SP$MLS (MMG$T) Multi-stream support ; ; MMG$T std XM conditional ; TIM$IT std conditional (no code effects) ; ERL$G std conditional (no code effects) ;- .SBTTL Edit History ;+ ; Author Greg L Adams (94476) ; With compliments to NWR for the banner fonts. ; ; 20-Jul-88 RHH SP for V5.5 with high mem region in XM ; separate END_PAGE (SP$EPS) support, and ; multiple stream support (SP$MLS) ; ; 16-Dec-88 RHH Allow non-file-structured LOOKUP stream ; ; 06-Jan-89 RHH Restructure flagpages. Add extension to ; NOWIDE, trim trailing blanks, use ...CMV ; to put RT version in flagpage. ; ; 27-Jul-1998 TDS 024 4-digit years for RT-11 5.7. Change name ; of Big Time/Date option from ADAMS to BIGTIM. ; ; 10-Dec-1999 TDS 025 fix error in logic for 4-digit 19xx/20xx years. ;- .ENABLE LC .NLIST BEX, CND .SBTTL Macro References .MCALL .ADDR, .ASSUME, .BR, .DRDEF, .FORK .MCALL .PRINT, .READC, .WAIT, ...CMV .IIF NDF MMG$T MMG$T = 0 .IF EQ MMG$T .MCALL SOB .ENDC; EQ MMG$T .SBTTL Conditional Rules SP$MLS =: MMG$T ; Multi-stream support follows XM .IIF NDF SP$FLG SP$FLG = 0 ; Default is NO_FLAG_PAGE SUPPORT .IF NE SP$FLG SP$FLG = 1 ; If defined non-zero, make it ONE SP$EPS = 1 ; force END_PAGE SUPPORT with flagpage .ENDC; NE SP$FLG .IF NE SP$MLS SP$EPS = 1 ; Force END_PAGE Support with multi- .ENDC; NE SP$MLS ; stream support .IIF NDF SP$EPS SP$EPS = 0 ; Default is NO_END_PAGE SUPPORT .IIF NDF SP$OPF SP$OPF = SP$EPS ; Default is OPTIMIZE FORMFEEDS .IIF NDF SP$DEC SP$DEC = 0 ; Default is NO_DEC_SITE Flagpage .IIF NDF SP$OLF SP$OLF = 0 ; Default is NOT OLD Flagpages .IIF NDF SP$JFW SP$JFW = 0 ; Default is FANCY Flagpages .IIF NE SP$DEC SP$DEC = 1 .NOCROSS SP.Cnt, SPR.Cnt, SPX.Cnt, SP.Did .IF NE SP$EPS .NOCROSS SPR.Did .ENDC; NE SP$EPS .NOCROSS ...V2, .....1 .SBTTL .DRDEF - Handler Definition Macro ; --------------------------------------------------------------------- .IF EQ SP$MLS .DRDEF SP,55,WONLY$!,0,0,SP$VEC,DMA=NO .IFF; EQ SP$MLS .DRDEF SP,55,ABTIO$!HNDLR$!WONLY$!,0,0,SP$VEC,DMA=NO .ENDC; EQ SP$MLS .DREST CLASS=DVC.LP .DRPTR FETCH=LODCOD,LOAD=LODCOD ; --------------------------------------------------------------------- ; Note SP uses location 110, the software communications vector. Hence ; 110 may not be used for any other device or job when SPOOL is running. .SBTTL Local Macros ;+ ; Save for return macro (inline subroutine). ;- ;>>> ARG!!! making a PDP-11 into a PDP-8!!! ; This is used in subroutines that end up "calling" the SPOOL program, ; because in the time between pseudo interrupts, the stack is probably ; completely different. .MACRO SFR MOV (SP)+,(PC)+ .WORD 0 .ENDM ;+ ; Return from non-asynchronous subroutine. ;- .MACRO RFS ROUTINE JMP @ROUTINE+2 .ENDM ;+ ; Do-nothing, end-of-flow delimiter ;- .MACRO ...... .ENDM .SbTtl Relocation function $REL .SbTtl . for non-XM system ; ; "PIC" code: ; ; As a handler, SP must be PIC code. The Set Code and Installation ; code are generally PIC code in the traditional sense (relative ; references (Mov Foo,R3) and "ADDR" macro type constructions (Mov ; #A,R0 becomes Mov PC,R0 / Add .-A,R0)). ; ; The rest of SP uses a macro called $REL to provide relocation ; dynamically. First the operation of $REL in the non-XM version: ; ; For SJ/FB/RTEM $REL generates several relocation lists: ; ; 1) A single list from the $REL references marked SP, SPR, ; and SPX. This list is used to relocate references from ; SP back to itself. It works by building a list of addresses ; to relocate and by placing in the locations to be relocated ; the relocation bias. ; ; 2) A second list from the $REL references marked RMON and RMONX. ; This list is used to relocate references from SP to RMON's ; data area. It works the same as 1) above, using the value ; of the SYSCOM RMON pointer as the base. ; ; +-----------------------+ ; | | ; | | ; | "R M O N" | ; | | ; @$SYPTR:| | ; +-----------------------+ ; ^ ^ ; |RMON |RMONX ; | | ; +-----------------------+ ; | |----+ ; | | |SP ; | |<---+ ; | |----+ ; | "SPDRV" | |SPR ; | |<---+ ; | |----+ ; | | |SPX ; ??????: | |<---+ ; +-----------------------+ ; .SbTtl . for XM system ; For XM $REL generates several relocation lists and performs some ; relocation at assembly time: ; ; 1) A single list from the $REL references marked SP. This list ; works the same way as list 1) under SJ/FB/RTEM above. Note ; that only SP marked $REL entries are in this list under XM. ; ; 2) A second list from the $REL references marked RMON. This list ; works the same way as list 2) above. Note that RMONX is a ; separate list under XM. ; ; 3) All the entries for $REL marked SPX are statically relocated ; at assembly time since the address of SPX is fixed at 20000 ; (the first address in PAR1). There is not list, the locations ; are modified by .Words generated by $REL. ; ; 4) A third list from the $REL references marked RMONX. This list ; works the same as list 2) above, except it is relocated at ; INSTALL time. ; ; 5) A fourth list from the $REL references marked SPR. This list ; works the same as list 1) above, except that an "old bias" ; value OLDBASE is subtracted out as part of the relocation, ; since this relocation is done to the "resident" part and may ; be repeated several times. ; ; +-----------------------+ ; | |----+ ; | | |SPX ; | "S P X" |<---+ ; | |-----------+ ; 20000: | |<---+ | ; +-----------------------+ | | ; | | | ; |RMONX | | ; V | | ; +-----------------------+ | | ; | | | | ; | | | | ; | "R M O N" | |SPX |SPR ; | | | | ; @$SYPTR:| | | | ; +-----------------------+ | | ; ^ | | ; |RMON | | ; | | | ; +-----------------------+ | | ; | |----+ | ; | |<----------+ ; | "SPDRV" |----+ ; | | |SP ; ??????: | |<---+ ; +-----------------------+ ; ;+ ; $REL ; ; Used to mark words to relocate in the handler ; ; $Rel Loc Value Base ; ; Loc -- location of word to relocate ; Value -- value to relocate it to ; Base -- base relocation on (SP, SPR, SPX, RMON, or RMONX) ; ; .If NE MMg$t ; SP marks references to root code (from root code) ; SPR marks references to root code (from hidden code) ; SPX marks references to the hidden code (from root or hidden code) ; RMON marks references to RMON (from root code) (NOT USED IN SP) ; RMONX marks references to RMON (from hidden code) (NOT USED IN SP) .IfF; NE MMg$t ; SP, SPR, and SPX mark references to handler code ; RMON and RMONX mark references to RMON (NOT USED IN SP) .EndC; NE MMg$t ;- .If NE MMg$t .Macro $Rel Loc Value Base .....1 = . . = Loc .If IDN SP.Cnt = SP.Cnt+1 .Irp x <\SP.Cnt> SP.'x: .Word Value-SPBase .EndR . = .....1 .MExit .EndC; IDN ; .If IDN ; RM.Cnt = RM.Cnt+1 ; .Irp x <\RM.Cnt> ; RM.'x: .Word Value ; .EndR ; . = .....1 ; .MExit ; .EndC; IDN .If IDN SPX.Cnt = SPX.Cnt+1 .Irp x <\SPX.Cnt> SX.'x: .Word Value-SPXBase+P1Addr .EndR . = .....1 .MExit .EndC; IDN .If IDN SPR.Cnt = SPR.Cnt+1 .Irp x <\SPR.Cnt> SPR.'x: .Word Value-SPBase .EndR . = .....1 .MExit .EndC; IDN ; .If IDN ; RMX.Cnt = RMX.Cnt+1 ; .Irp x <\RMX.Cnt> ; RMX.'x: .Word Value ; .EndR ; . = .....1 ; .MExit ; .EndC; IDN .Error ; Unknown B A S E "Base"; .EndM $Rel .IfF; NE MMg$t .Macro $Rel Loc Value Base .....1 = . . = Loc .If IDN SP.Cnt = SP.Cnt+1 .Irp x <\SP.Cnt> SP.'x: .Word Value-SPBase .EndR; IDN . = .....1 .MExit .EndC ; .If IDN ; RM.Cnt = RM.Cnt+1 ; .Irp x <\RM.Cnt> ; RM.'x: .Word Value ; .EndR ; . = .....1 ; .MExit ; .EndC; IDN .If IDN SP.Cnt = SP.Cnt+1 .Irp x <\SP.Cnt> SP.'x: .Word Value-SPBase .EndR . = .....1 .MExit .EndC; IDN .If IDN SP.Cnt = SP.Cnt+1 .Irp x <\SP.Cnt> SP.'x: .Word Value-SPBase .EndR . = .....1 .MExit .EndC; IDN ; .If IDN ; RM.Cnt = RM.Cnt+1 ; .Irp x <\RM.Cnt> ; RM.'x: .Word Value ; .EndR ; . = .....1 ; .MExit ; .EndC; IDN .Error ; Unknown B A S E "Base"; .EndM $Rel .EndC; NE MMg$t ;+ ; Push ; ; Place a word on the stack ;- .Macro Push Value .If IDN <#0> Clr -(SP) .Iff; IDN <#0> Mov Value,-(SP) .EndC; IDN <#0> .EndM Push ;+ ; Pop ; ; Remove a word from the stack ;- .Macro Pop Value,Save .If B .If B Tst (SP)+ .IfF; B Bit @SP,(SP)+ .EndC; B .Iff; B Mov (SP)+,Value .EndC; B .EndM Pop .SBTTL Constant and Parameter Definition CLO$SE =: 000001 ; Special function code for .CLOSE LOOK$UP =: 000003 ; Special function code for .LOOKUP ENT$ER =: 000004 ; Special function code for .ENTER PURGE$ =: 6 ; Special function code for .PURGE MASK.J =: 000170 ; Job number mask for Q$JNUM MASK.U =: 177770 ; Mask to remove all but unit number bits. .IF EQ SP$MLS NUNITS =: 1. ; Number of SPOOL units supported .IFF; EQ SP$MLS NUNITS =: 8. ; Number of SPOOL units supported .ENDC; EQ SP$MLS BPTINS =: 000003 ; Break point trap instruction. NOPINS =: 000240 ; Noop instruction. WIDOFF =: 000006 ; Offset in width table to WIDE values. .IF NE SP$EPS CR =: 015 FF =: 014 LF =: 012 A.SPACE =: 040 A.STAR =: 052 A.DASH =: 055 A.DOT =: 056 A.0 =: 060 A.COLON =: 072 A.A =: 101 A.Z =: 132 .ENDC ;NE SP$EPS .SbTtl Equates .SbTtl . Hardware References Block0 =: 0 Blk =: 1000 ; block size for disks KTGran =: 32.*2 ; KT11 granularity (and PLAS too) P1Addr =: 20000 ; first address in PAR1 KISDR1 =: 172302 ; Kernel Instruction PDR1 AP$ACF =: 077406 ; 4KW page with no trap/abort KISAR1 =: 172342 ; Kernel Instruction PAR1 PS =: 177776 ; PSW in machines that have them CMKern =: 140000 ; Current mode kernel .SbTtl . RMON references $SYPTR =: 54 ; Pointor to monitor base. $DATE =: 262 ; offset to the date word. DA.YR =: 000037 ; Year bits. DA.DAY =: 001740 ; Day bits. DA.MON =: 036000 ; Month bits. DA.ERA =: 140000 ; Era bits. ;024 $SYSVE =: 276 ; offset to version byte MinVer =: 5 ; minimum version number supported $SYSGE =: 372 ; SYSGEN options word .SBTTL SPSTAT - SPOOL Status Word Definition $SPSTA =: 414 ; offset to SPOOL status word. SP$NXT =: 000010 ; Move to start of NEXT file SP$OFF =: 000020 ; Set unit to WAIT mode SP$ON =: 000040 ; Set unit to NOWAIT mode SP$KIL =: 000100 ; KILL all output to unit SP$ACT =: 000200 ; SPOOL is ACTIVE (*) SP$0 =: 003400 ; Banner override (for PRINT/FLAG:n) SP$SHO =: 004000 ; Show status SP$SCN =: 010000 ; Print screen (PC 300 only) SP$GTM =: 020000 ; Request time string SP$IEN =: 040000 ; Fake interrupt enable SP$ERR =: 100000 ; SPOOL indicates ERROR (*) ; Special bit combinations in SPSTAT SP$OPR =: SP$ON+SP$OFF+SP$KIL+SP$NXT ; Special operation bits SP$ABT =: SP$ON+SP$OFF ; ABORT code for SPOOL SP$EXI =: SP$ON+SP$OFF+SP$KIL ; EXIT SPOOL UP$OON =: SP$ON+SP$OFF+SP$ERR ; SPOOL is starting up .IF NE MMG$T .SBTTL MEMPTR - XM Memory Table Structure $MEMPT =: 430 ; fixed offset to memory pointers ;@<$MEMPT+$Rmon) ; memory block CorPtr =: 0 ; CorPtX =: 4 ; offset to extended memory block ;@ ; extended memory block $FLstX =: 0 ; beginning of free region list $FSize =: 0 ; size in 32words units $FAddr =: 2 ; address in 32words units ; ; repeated entries (0 size is empty) ; 177777 ; end of entries GR.Siz =: 0 ; offset to size word in global RCB GR.Adr =: 2 ; offset to address word in global RCB GR.Sta =: 4 ; offset to status word in global RCB GR.PRV =: 100000 ; Shared Global Region GR.Nam =: 6 ; offset to rad50 name in global RCB GR.Esz =: 10. ; size of entry in global RCB ; ; repeated entries (0 GR.Siz is empty) ; 177777 ; end of list P1$EXT =: 432 ; offset to externalization routine. XDEALC =: -18. ; Jmp to Region Deallocation Routine XAlloc =: -6 ; Jmp to extended memory alloc routine BlkMov =: -2 ; Br to block move routine ; 0 ; P1Ext routine .ENDC; NE MMG$T .SbTtl . Block0 references H.Gen =: 60 ; sysgen bits byte H.DPtr =: 70 ; pointer to data in handler file Ins.CSR =: 176 ; install CSR value Ins.DK =: 200 ; install EP for non-system device Ins.SY =: 202 ; install EP for system device BitMap =: 360 ; low address of bit map area .SbTtl . Misc. .Read =: 10 ; .READ request code XMMon$ =: 2 BotChn =: 0 ; Boot-time channel number SysChn =: 17 ; Overlay channel number F.BADR =: 2 ; .FORK blk - routine offset RM.Cnt = 0 ; Initialize $REL counters SP.Cnt = 0 SPR.Cnt = 0 RMX.Cnt = 0 SPX.Cnt = 0 .If NE MMg$t .SbTtl PSECT Ordering ;************************************************************************ .Save .PSect SPDvr RW,I,LCL,REL,CON ; Normal driver code psect .PSect SetOvr RW,I,LCL,REL,CON ; Install code overlay psect .PSect SPX RW,I,LCL,REL,CON ; Hidden driver code psect SPXBase: .Restore ;************************************************************************ .EndC; NE MMg$t .Sbttl ************************************* .SbTtl * Install Code * .Sbttl ************************************* .Sbttl .DRINS for NON-XM .Enabl LSB .If EQ MMg$t .DrIns SP ; for NON-XM Ins$DK: Br 10$ ; non-system device ............ .Assume . EQ Ins.SY Ins$SY: Br InsNo ; system device, illegal ............ .IfF; EQ MMg$t .=...V5+2 ; start just after .audit stuff .IfTF; EQ MMg$t InsCk: ; also used as a subr by SET SP SYSGEN 10$: Mov @#$SYPTR,R0 ; get RMon address CmpB $SYSVE(R0),#MinVer ; is a new enough version? **GVAL** .IfT; EQ MMg$t Blo InsNo ; no, then do not allow .IfF; EQ MMg$t Blo InsCkN ; no, then do not allow .IfTF; EQ MMg$t Bit #XMMon$,$SYSGE(R0) ; running under XM? **GVAL** .IfT ;EQ MMG$T Bne InsNo ; No, it is XM, can't support .IfF; EQ MMG$T Beq InsCkN ; No, it is not XM, can't support .IfTF ;EQ MMG$T InsYes: Tst (PC)+ ; clear Carry, skip Sec InsNo: ; installation error .IfT; EQ MMg$t SetEr2: .IfF; EQ MMg$t SetEr1: .IfTF; NE MMg$t SetErr: Sec ; error, do not install Return ...... .IfF; ;EQ MMG$T InsCkN: Com (SP)+ ; set carry Return ; return to caller's caller ...... .Sbttl ************************************* .SbTtl * Install Code * .Sbttl ************************************* .Sbttl .DRINS - Install Entry for XM .Assume . LE Ins.CSR .DrIns SP ; for XM version Ins$DK: Br 20$ ; non-system device ............ .Assume . EQ Ins.SY Ins$SY: Br InsNo ; system device, illegal ............ 20$: Call InsCk ; do the sysgen options match? ; get second block of install code .Wait #SysChn ; is this boot time? Bcc 30$ ; no, then channel 17 is used .Assume BotChn EQ 0 .Wait #0 ; is the boot channel open? Bcs InsNo ; no, then give up .Assume BotChn EQ 0 ClrB ReaChn ; use boot time channel Mov @R3,BlkAdd ; get increment value for block number 30$: Mov #OvrIns/2,R3 ; point to overlay install code Br GetOvr ; go get it ............ .EndC; EQ MMg$t .Dsabl LSB .SbTtl GetOvr -- overlay handler for INSTALL code ;+ ; GETOVR ; ; Get INSTALL overlay and jump to code in it ; ; R3 contains Addr/2 of the place to get control. ; ; R3 is destroyed ; ; Cond codes destroyed ;- .Enabl LSB GetOvr: ; read "Install overlay" SwaB R3 ; get block number to low byte MovB R3,ReaBlk ; set block number to read .If NE MMg$t Add #.-.,ReaBlk ; add in offset (boot time install) BlkAdd =: .-4 .EndC; NE MMg$t Bic #377,R3 ; clear out old block number Bis #SPStrt/Blk,R3 ; use Queue code block for address Jsr R0,20$ ; save R0, point to arg blk **PIC** ReaChn: .Byte SysChn+.-. ; channel ReaCod: .Byte .Read+.-. ; request code ReaBlk: .BlkW 1 ; block number to read ReaBuf: .BlkW 1 ; buffer address to read into .Word Blk/2 ; words to read .Word 0 ; .ReadW 20$: .Addr #SPStrt,R5,PUSH ; == Push R5/ ADDR SPStrt**PIC** Mov R5,ReaBuf ; set address of read buffer Pop R5 ; restore work register .ReadC Code=NOSET ; do the read ; This is really a .READW Pop R0,Save=Carry ;*C* restore saved register Bcs SYWLEr ; overlay read/write failed SwaB R3 ; get address back Asl R3 ; make into byte offset .Addr #Block0,R3,ADD ; make into real address **PIC** Jmp @R3 ; go to it. ............ .Assume . LE 400 .Dsabl LSB .SBTTL **************************** .SBTTL * SET OPTIONS * .SBTTL **************************** .DRSET WAIT, SP$ON, S.WAIT, .DRSET NEXT, SP$NXT, S.BIT .DRSET KILL, SP$KIL, S.BIT .DRSET EXIT, SP$EXI, S.BIT .IF NE SP$FLG .DRSET FLAG,6,S.FLAG, .DRSET WIDE,-1,S.WIDE, .DRSET BIGTIM,-1,S.BTM, ;024 .ENDC; NE SP$FLG .IF NE SP$EPS .DRSET FORM0,-1,S.FRM0, .DRSET ENDPAG,6,S.ENDP, .ENDC; NE SP$EPS .IF NE SP$DBG .DRSET DEBUG,BPTINS,S.DEBUG, .ENDC; NE SP$DBG .SbTtl SY: I/O error SYWLEr: BitB #1,ReaCod ; a read or a write? Beq SetEr2 ; read SYWLOv: ; entry from overlay write Mov @SP,R0 ; get return address Inc R0 ; point to returned opcode CmpB #BR/400,(R0)+ ; is it a BR ... ? Bne SetEr2 ; then no second return point Mov R0,@SP ; else take WRITELOCKED exit .If EQ MMg$t Br SetEr2 ; now .IfF; EQ MMg$t SetEr2: Br SetErr ; now .EndC; EQ MMg$t ...... .SBTTL **************************** .SBTTL * SET CODE * .SBTTL **************************** .SBTTL Set Code for SP Handler .ENABL LSB .IF NE SP$DBG S.DEBUG:MOV R3,R0 ; SET SP DEBUG entry point. BR 10$ ; Branch abound NODEBUG. MOV #NOPINS,R0 ; Set for NODEBUG 10$: MOV R0,DODBG ; Store the BPT flags. RETURN ...... .ENDC; NE SP$DBG ; SET SPn [NO]WAIT, NEXT, KILL, and EXIT S.WAIT: MOV #SP$OFF,R3 ; SET SP WAIT entry, so use OFF bit. S.BIT: MOV @#$SYPTR,R0 ; R0 -> base of RMON. ADD #$SPSTA,R0 ; R0 -> $SPSTA MOV R3,-(SP) ; save the SET bit(s) BISB R1,R3 ; Set the unit number bits. TST R1 ; no unit no. supplied? BPL 20$ ; branch if unit WAS supplied. BIS #SP$SCN,R3 ; if not, set P_SCREEN bit 20$: MOV R1,-(SP) ; save R1, 22$: MOV @R0,R1 ; get contents of $SPSTA BIC #^C,R1 ; isolate special operation bits CMP R1,#SP$ABT ; is an ABORT in progress? BEQ 22$ ; wait here for it to finish. MOV (SP)+,R1 ; Ok. recover R1 BIS R3,@R0 ; Set the appropriate CSR bits. CMP (SP)+,#SP$EXI ; was it SET SP EXIT? BNE 30$ .ASSUME SP$ACT EQ 200 25$: TSTB @R0 ; is SPOOL still active? BMI 25$ ; loop here if so. 30$: .IF NE SP$EPS BR S.OK ...... .IFF; NE SP$EPS .BR S.OK .ENDC; NE SP$EPS .IF NE SP$FLG ; FLAG_PAGE SET options .SBTTL . for FLAGPAGE Option ; SET SPn [NO]WIDE S.WIDE: CLR R3 ; Indicate WIDE. NOP COM R3 ; NOWIDE = 0; WIDE = -1 .ADDR #WCDTAB,R2 ; R2 -> table of unit width codes BR S.EP1 ; Join common code in ENDPAG ...... ; SET SPn [NO]BIGTIM ;024 S.BTM: CLR R3 ; Indicate BIGTIM. ;024 NOP COM R3 ; Indicate NOBIGTIM. ;024 TST R1 ; Unit specified? BPL S.ERR ; that's not allowed here. MOV R3,SP$BTM ; Big-Time flag BR S.OK ; Take ok return. ...... ; SET SPn FLAG=x S.FLAG: .ADDR #FLGCNT,R2 ; R2 -> Flag count table BR S.EP2 ; join common code with ENDPAG ...... .ENDC; NE SP$FLG .IF NE SP$EPS ; END_PAGE SET options ; SET SPn [NO]FORM0 S.FRM0: CLR R3 ; Indicate FORM0. NOP COM R3 ; Enters here for NOFORM0 .ADDR #FRM0ST,R2 ; R2 -> FORM0 control table S.EP1: MOV R3,R0 ; Put the value in R0 BR S.EP3 ; Join common code in ENDPAG ...... ; SET SPn ENDPAG=n S.ENDP: .ADDR #ENDPTB,R2 ; Point to end_page table S.EP2: CMP R0,R3 ; Is the value too large? BHI S.ERR ; Yes, reject it... S.EP3: TST R1 ; unit supplied? .IF NE SP$MLS BPL 60$ ; Yes. Go do it for that unit. MOV #NUNITS,R1 ; No. apply to all units. 50$: MOVB R0,(R2)+ ; wipe value all over the table. SOB R1,50$ BR S.OK ...... .IFF; NE SP$MLS BMI 70$ ; Branch if no unit specified .ENDC; NE SP$MLS 60$: BIC #MASK.U,R1 ; Strip to unit .IF NE SP$MLS CMP R1,#NUNITS ; valid unit? BHIS S.ERR ; br if not ADD R1,R2 ; R2 -> Unit's entry in end page table .IFF; NE SP$MLS BNE S.ERR ; Error if not unit-0 .ENDC; NE SP$MLS 70$: MOVB R0,@R2 ; Set unit's end page (or Flag) count .ENDC; NE SP$EPS S.OK: TST (PC)+ ; Clear the carry. S.ERR: SEC ; Set the carry. RETURN ...... .Assume . LE 1000,MESSAGE=<;Set code exceeds block 0> .DSABL LSB .SBTTL .DRBEG - Driver Entry ; ********** .DRBEG SP ; Setup handler header. ; ********** BR SPGO ; Branch around the data. ...... .IF NE SP$DBG DODBG: NOP ; Default for no break point. .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> RETURN ; Return. .ENDC; NE SP$DBG .IF NE SP$FLG FLGCNT: ; Unit flag page table (default = 2) .REPT NUNITS .BYTE 2 .ENDR .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> WCDTAB: ; Unit width code tbl (default = WIDE) .REPT NUNITS .BYTE 377 .ENDR .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> .ENDC; NE SP$FLG .IF NE SP$EPS FRM0ST: ; Unit FORM0 table (default = NOFORM0) .REPT NUNITS .BYTE 0 .ENDR .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> ENDPTB: ; Unit end page table (default = 1) .REPT NUNITS .BYTE 1 .ENDR .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> .EVEN .ENDC; NE SP$EPS .SBTTL DRBEG entry .ENABL LSB SPGO: .IF NE SP$DBG ; ---------- Initialization point debug check ----------------- CALL DODBG ; Trap or not to trap. .ENDC; NE SP$DBG SPBase: JSR R2,INIT ; Init if first time through ; (gets NOPed by INIT code) MOV #SPINT,R1 ; point to low comm area $REL .-2 SPINT SP ; (for later use) ; Determine if request is a special directory function or an I/O MOV SPCQE,R4 ; Get pointer to queue element. .IF NE SP$EPS .ASSUME Q$BLKN EQ 0 ADD @R4,SP$BNR ; Update the block number register. .IFF; NE SP$EPS .ASSUME Q$BLKN EQ 0 MOV @R4,SP$BNR ; Init the block number register. .ENDC; NE SP$EPS MOVB Q$UNIT(R4),R0 ; R0 = Unit number. BIC #MASK.U,R0 ; Strip away misc. bits. .IF NE SP$MLS MOV Q$CSW(R4),SP$CSA ; Inform SPOOL of CSW address .ENDC; NE SP$MLS MOV Q$FUNC(R4),SP$JAF ; Init the job and function register. MOVB Q$FUNC(R4),R5 ; Isolate the function .ASSUME SP$ACT EQ 200 TSTB @SPCSR ; Is SPOOL running? .IF NE SP$EPS BMI 10$ ; branch if so CMPB R5,#CLO$SE BEQ 8$ CMPB R5,#LOOK$UP BEQ 8$ CMPB R5,#PURGE$ BEQ 8$ JMP SPERR ...... 8$: BR DRFIN1 ; .DRFIN the request ...... .IFF; NE SP$EPS BEQ SPERR ; Reject .WRITE request .ENDC; NE SP$EPS 10$: .IF EQ SP$EPS .BR IOREQ ; Fall to I/O request processing. .IFF; EQ SP$EPS TSTB R5 ; Is it a special directory request? BEQ IOREQ ; No, then go do an I/O request. .DSABL LSB .SBTTL Process .ENTER, .LOOKUP and .CLOSE requests .ENABL LSB ; .ENTER processing CMPB R5,#ENT$ER ; Is it an .ENTER request? BNE 50$ ; No, then carry on. .IF NE SP$FLG MOV R0,-(SP) ; Save unit for a moment. CALL GETFIL ; Yes, then go get the filename. MOV #SP$FNR,R0 $REL .-2 SP$FNR SP TST @R0 ; filename? BNE 10$ ; branch if filename supplied. MOV (PC)+,(R0)+ ; otherwise, substitute NONAME .RAD50 /NON/ MOV (PC)+,(R0)+ .RAD50 /AME/ CLR (R0)+ ; blank extention 10$: MOV @SP,R0 ; retrieve the unit from stack .IFF; NE SP$FLG .IF EQ SP$MLS MOV SP,SP$FNR ; Indicate .ENTER opened channel .ENDC; EQ SP$MLS .IF NE MMG$T CALL NOFUNC ; copy function code to hi mem .ENDC; NE MMG$T .ENDC; NE SP$FLG MOVB FRM0ST(R0),SP$FM0 ; Get FORM0 value for this unit $REL .-4 FRM0ST SP MOVB ENDPTB(R0),SP$EPG ; Get ENDPAG value for this unit $REL .-4 ENDPTB SP .IF NE SP$FLG MOVB WCDTAB(R0),SP$WFL ; Get WIDTH_CODE for this unit $REL .-4 WCDTAB SP MOVB FLGCNT(R0),R5 ; Get FLAG count for this unit $REL .-2 FLGCNT SP MOV @SPCSR,R0 ; R0 = spooler status word. BIT #SP$0,R0 ; Has PRINT/FLAGPAGE:n been used? BEQ 20$ ; No, then continue. COM R0 ; Convert to the compliment. BIC #^C,R0 ; Strip the other control bits. SWAB R0 ; Put count into low byte. MOVB R0,R5 ; slip it into R5 ; Note, monitor will clear the over- ; ride control bits. 20$: MOV (SP)+,R0 ; Restore unit number. MOVB R5,SP$BFG ; Get FLAGPAGE count for this unit .ENDC; NE SP$FLG 30$: MOV #BANNER,R5 ; R5 -> Banner generation routine. $REL .-2 BANNER SP BIS #SP$IEN!SP$GTM,@SPCSR ; request interrupt and time string BR RRI ; Request an interrupt through SPOOL ...... ; .LOOKUP processing 50$: CMPB R5,#LOOK$UP ; Is it a .LOOKUP? BNE 60$ ; Nope, check again... .IF NE SP$MLS CLR SP$FM0 ; No FORM0, CLR SP$EPG ; No ENDPAG, .IF NE SP$FLG CLR SP$BFG ; No FLAGPAGEs, .ENDC; NE SP$FLG .IF NE MMG$T CALL NOFUNC ; copy function code to hi mem .ENDC; NE MMG$T BR 30$ ; otherwise, do like .ENTER does. .IFF; NE SP$MLS CLR SP$FNR ; Indicate .LOOKUP opened channel BR DRFIN1 ; .DRFIN it. Don't bother SPOOL .ENDC; NE SP$MLS ...... ; .CLOSE/.PURGE processing 60$: CMPB R5,#CLO$SE ; Is it a .CLOSE? BEQ 66$ ; Yes. CMPB R5,#PURGE$ ; or .PURGE? BNE DRFIN1 ; ignore anything else CLR SP$EPG ; Ensure no ENDPAG 66$: .IF EQ SP$MLS TST SP$FNR ; Closing LOOKUP or ENTER? BEQ DRFIN1 ; if LOOKUP, close quietly. .ENDC; EQ SP$MLS .IF NE CALL NOFUNC ; xfer SP$xxx to XM region .ENDC; NE MOV #ENDPAG,R5 ; R5 -> Trailing routine $REL .-2 ENDPAG SP BR RRI ; Request an interrupt ...... DRFIN1: BR SPEXIT ; Filename ok, take exit. ...... .ENDC; NE SP$EPS .DSABL LSB .SBTTL Process I/O Requests ; ------ Process I/O requests ------------------------------------------- .ENABL LSB IOREQ: TST Q$WCNT(R4) ; A seek only? BEQ SPEXIT ; Yes, then exit now. BGT SPERR ; .READ request? CLR SP$BSC ; Clear the block segmentation count. .IF NE CALL NOFUNC ; transfer SP$xxx to XM region .ENDC; NE .IF NE SP$EPS MOV #IOINT,R5 ; R5 -> post interrupt I/O entry. $REL .-2 IOINT SP .ENDC; NE SP$EPS RRI: ; Return, requiring interrupt .IF NE SP$EPS ; (R5 points to resumption entry) MOV R5,INTVEC ; Set it into the vector. .ENDC; NE SP$EPS BIS #SP$IEN,@SPCSR ; Set the interrupt enable bit. 10$: RETURN ; Return for later continuation. ...... .DSABL LSB .SBTTL Spool Handler Data FRKBLK: .BLKW 4 ; .FORK block .IF NE MMG$T ; All of this data is copied to SPX, each time a MAPX operation is ; performed. Upon UNMAPXing, it is moved back down here. ; .ENDC; NE MMG$T ; SP$(WFL, BTM, BFG, EPG, and FM0) are altered by SET code, ; so they must be in block 1. SP$FXO = . .IF NE SP$FLG SP$WFL: .WORD 10. ; width of filename on banners SP$BTM: .WORD 0. ; NO big-time (NOBIGTIM) format;024 SP$BFG: .WORD 2. ; banner flag/count .ENDC; NE SP$FLG .IF NE SP$EPS SP$EPG: .WORD 1. ; end page count SP$FM0: .WORD 0 ; form-0 flag .Assume . LE SPSTRT+1000,MESSAGE=<;Set object not in block 1> SP$FFD: .WORD 0 ; file's own formfeed count .ENDC; NE SP$EPS .SBTTL SPOOLER Fixed Offsets ; ----- Spooler fixed offsets - SPOOL counts on exact locations of these: ; ; The (FB) SPOOL program communicates with these variables by finding the ; address of the DRAST (SPINT) entry point. The variables are directly ; below SPINT. In the XM (.SAV) version, the variables are here for ; easy access by SET routines, but are duplicated in the shared SPX region. ; SPOOL.SAV communicates with the high memory copy. SP$BSC: .WORD 0 ; block segmentation count .IF NE SP$MLS SP$ABO: .WORD 0 ; Abort flag and job number .ASSUME SP$ABO EQ SPINT-50 ;024 SP$CSA: .WORD 0 ; Channel Status Address (ID) .ASSUME SP$CSA EQ SPINT-46 ;024 .ENDC; NE SP$MLS .IF NE SP$EPS SP$DAT: .BLKB 12. ; Storage for date (11 used). ;024 .ASSUME SP$DAT EQ SPINT-44 ;024 SP$TIM: .BLKB 8. ; Storage for time string. .ASSUME SP$TIM EQ SPINT-30 SP$FNR: .WORD 0,0,0 ; Storage for current file name. .ASSUME SP$FNR EQ SPINT-20 .ENDC; NE SP$EPS SP$BNR: .WORD 0 ; Storage for block number register. .ASSUME SP$BNR EQ SPINT-12 SP$JAF: .WORD 0 ; job number, unit, and function. .ASSUME SP$JAF EQ SPINT-10 SP$WCR: .WORD 0 ; Storage for word count register. .ASSUME SP$WCR EQ SPINT-6 SP$BPR: .WORD 0 ; Storage for buffer pointer register. .ASSUME SP$BPR EQ SPINT-4 SP$TOP = . COMSIZ =: <+1>/2 ; Size of communication area in words .SBTTL .DRAST - Interrupt entry point .DRAST SP,4,SPABRT ; Let the macro set it up. .SBTTL SPOOL Common Data Offset Definitions SP.FXO =: SP$FXO-SPINT ; Offsets to communication items .IF NE SP$FLG SP.WFL =: SP$WFL-SPINT ; offset to filename width SP.BTM =: SP$BTM-SPINT ; large date format flag SP.BFG =: SP$BFG-SPINT ; banner flag/count .ENDC; NE SP$FLG .IF NE SP$EPS SP.EPG =: SP$EPG-SPINT ; ENDPAG count SP.FM0 =: SP$FM0-SPINT ; FORM0 flag SP.FFD =: SP$FFD-SPINT ; File's own formfeed count .ENDC; NE SP$EPS SP.BSC =: SP$BSC-SPINT ; Block segmentation counter .IF NE SP$MLS SP.CSA =: SP$CSA-SPINT ; CSW address, used for job/chan ID SP.ABO =: SP$ABO-SPINT ; Abort flag and job number .ENDC; NE SP$MLS .IF NE SP$EPS SP.DAT =: SP$DAT-SPINT ; offset to date string SP.TIM =: SP$TIM-SPINT ; offset to time string SP.FNR =: SP$FNR-SPINT ; offset to filename string .ENDC; NE SP$EPS SP.BNR =: SP$BNR-SPINT SP.JAF =: SP$JAF-SPINT SP.WCR =: SP$WCR-SPINT SP.BPR =: SP$BPR-SPINT SP.TOP =: SP$TOP-SPINT ; distance between SPINT and 1st item .IF NE SP$DBG ; ----- Debug check ----------------------------------------------- CALL DODBG ; Debugging requested? .ENDC; NE SP$DBG ; ----- Interrupt processing -------------------------------------- MOV SPCQE,R4 ; Get pointer to the queue element. TST @SPCSR ; Was our request ok? BMI SPERR ; No, take error exit. .FORK FRKBLK ; Save registers, let others interrupt .IF NE SP$EPS MOV #SPINT,R1 ; Set R1 -> comm area $REL .-2 SPINT SP JMP @#.-. ; Go to the action code. INTVEC = .-2 ; Pointer to next action code. ............ .IFF; NE SP$EPS .BR IOINT .ENDC; NE SP$EPS .SBTTL IOINT - Post Interrupt I/O Processing ; ------- Send blocks to the SPOOL job ------------------------- .ENABL LSB .IF EQ MMG$T IOINT: CLR SP$WCR ; Clear the spoolers wordcount. ADD SP$BSC,SP$BNR ; Add count for split-up xfers. 10$: .IF EQ SP$EPS MOV @Q$BUFF(R4),@SP$BPR ; Send a word to SPOOL's buffer. .IFF; EQ SP$EPS MOV @Q$BUFF(R4),R5 ; Get the word MOV R5,@SP$BPR ; Send a word to SPOOL's buffer. .IF NE SP$OPF CALL TSTFFF ; test for formfeed SWAB R5 ; get high byte CALL TSTFFF ; do the same. .ENDC; NE SP$OPF .ENDC; EQ SP$EPS ADD #2,SP$BPR ; Increment the buffer pointers. ADD #2,Q$BUFF(R4) INC SP$WCR ; Count the word for the spooler. INC Q$WCNT(R4) ; All data output? BEQ SPEXIT ; Yes, then go exit. CMP SP$WCR,#256. ; Is spooler buffer full? BNE 10$ ; No, then copy some more data. INC SP$BSC ; Yes, inc the segmentation count. RETURN ; RTI via RT. ...... .IF NE SP$EPS .IF NE SP$OPF TSTFFF: TSTB R5 ; is low byte NULL? BEQ 30$ ; if so, just return CMPB R5,# ; is it a FF? BNE 20$ ; branch if not. INC SP$FFD ; count the formfeed. BR 30$ 20$: CLR SP$FFD ; reset count on any non-NULL, non-FF 30$: RETURN ...... .ENDC; NE SP$OPF .ENDC; NE SP$EPS .IFF; EQ MMG$T IOINT: MOV R4,R2 ; Use R2 to convey QUEUE_ELEM ptr MOV #IOINTX,R4 ; point to high-mem entry $REL .-2 IOINTX SPX BR MAPX ...... .ENDC; EQ MMG$T .DSABL LSB .IF NE SP$MLS .SBTTL SPABRT - ABORT entry point RTSPC1: TST (SP)+ ; Fix SP, RTSPC: RETURN ; return to monitor ...... .ENABL LSB SPABRT::BIT #SP$ACT,@SPCSR ; is SPOOL running? BEQ RTSPC ; if not, return immediately. TST R5 ; .ABTIO? (no CSW adr?) BNE RTSPC ; if so, ignore it. MOV R4,-(SP) ; save job number ASR R4 ; job no. / 2 BIS #,R4 ; combine abort bits with job # BIS R4,@SPCSR ; set bits in $SPSTA for SPOOL MOV SPCQE,R5 ; active queue element? BEQ RTSPC1 ; if not, return now. MOVB Q$JNUM(R5),-(SP) ; get job-number byte BIC #^C,@SP ; mask out all but job bits .REPT 3 ASR @SP ; get job number .ENDR CMP (SP)+,(SP)+ ; Q-elem belongs to this job? BNE RTSPC ; return if not. CLR FRKBLK+F.BADR ; Yes. Cancel .FORK routine BR SPEXIT ; Clear SP$IEN and DRFIN it. ...... .ENDC; NE SP$MLS .SBTTL SPEXIT - Error and normal exits SPERR: BIS #HDERR$,@-(R4) ; Report the user's error. .IF EQ SP$MLS SPABRT: .ENDC; EQ SP$MLS SPEXIT: BIC #,@(PC)+ ; Clear errors, no interrupts SPCSR: .WORD 0 ; Pointer to pseudo spooler CSR. DRFIN: ; ********** .DRFIN SP ; Take output done exit. ; ********** .DSABL LSB .IF NE MMG$T .SBTTL Jump to/from High Memory PSECT .ENABL LSB .IF NE SP$FLG GETFIL: MOV R4,-(SP) ; save it for later MOV R4,R2 ; Use R2 to hold Q-elem address MOV #GETFLX,R4 $REL .-2 GETFLX SPX ; point to high mem code BR MAPX ; map and go there. ............ ; Return here from high memory GETFLR: MOV (SP)+,R4 ; restore q-elem pointer RETURN ; Return to the caller. ............ .ENDC; NE SP$FLG .IF NE SP$EPS BANNER: MOV #BANNEX,R4 ; Point to BANNER code in XM $REL .-2 BANNEX SPX BR MAPX ............ ENDPAG: MOV #ENDPAX,R4 ; Point to ENDPAG code in XM $REL .-2 ENDPAX SPX BR MAPX ............ NOFUNC: MOV R0,-(SP) ; Save R0, MOV #NOFUNX,R4 ; Point to NOP function in XM $REL .-2 NOFUNX SPX BR MAPX ............ RTSPC0: MOV (SP)+,R0 ; Return from NOFUNC RETURN ............ CHRCON: MOV #CHRCOX,R4 ; Point to CHROUT code in XM $REL .-2 CHRCOX SPX .BR MAPX ............ .ENDC; NE SP$EPS .SBTTL MAPX - Map to High Memory ;+ ; Transfer control to a HIGH memory routine, pointed to by R4. ; R0 gets clobbered. ; R1 then points to the SP/SPOOL communication area. ; ; The actual mapping routine is put on the stack and then executed there. ; (P1EXT cannot be used here because it does its own thing with KISAR1.) ; UNMAPX/UNFNMP perform the opposite task of moving UNMAP code to stack ; executing that code, and reclaiming that part of the stack that was ; used to hold code. ;- MAPX: MOV #MAPX2,R0 $REL .-2 MAPX2 SP 4$: MOV -(R0),-(SP) ; Move mapping code to stack CMP R0,#MAPX1 $REL .-2 MAPX1 SP BHI 4$ MOV SP,PC ; start executing stack ............ MAPX1: MOV @#KISAR1,-(SP) ; save old PAR1, MOV @#P1NEW,R3 ; REMAP HERE (remember - this $REL .-2 P1NEW SP ; code is on the stack) MOV R3,@#KISAR1 ; R3 contains new PAR1 MOV (SP)+,@#P1OLD ; save the old PAR1 in XM $REL .-2 P1OLD SPX MOV #,R0 ; Let FINMAP fix stack. JMP @#FINMAP ; go to high mem cleanup $REL .-2 FINMAP SPX MAPX2: ............ ; Resume here after UNMAPXing. Reclaim stack space occupied by UNMAP code. ; Pop the comm copy from stack to its rightful place. Finally, jump to ; the specified destination (R4). ; ; On entry, R0 contains the number of bytes that must be added to SP to ; reclaim stack space used for UNMAP code. R4 contains the address of ; a routine to transfer control to. R1 gets trashed (cleared). UNFNMP: ADD R0,SP ; Fix stack after UNMAPX JMP @R4 ; go to low-mem destination. ............ .IF NE SP$EPS GROUND: MOV #CHRCON,R5 ; Come here after CHROUT $REL .-2 CHRCON SP JMP RRI ............ .ENDC; NE SP$EPS P1NEW: .WORD 0 ; Low-mem copy of XM region's PAR1 .DSABL LSB .Save ; ********************************************************************** .Psect SPX ; Start of XM Region ; Warning: Any change here requires corresponding change in SPINT.MAC SPFBUF: .BLKW 256. ; SPOOL forwarding buffer .BLKW <32.-COMSIZ> ; padding for alignment of SP$HIG .ASSUME COMSIZ LT 32. SP$HIG: .BLKW COMSIZ ; XM copy of communication area SP$HTP =: . ; end of COPYUP/COPYDOWN area SP$HIN =: .-SP.TOP SP$HTM: .BLKB 10. ; High Time String . = SP$HTP+64. ; Padding to top of chunk .SBTTL FINMAP - Finish MAPX operation ;+ ; R0 contains the number of bytes that need to be added to SP so that ; it is correct again ; R2 contains a relocation bias, if we're doing an INIT call ; R3 contains the NEW PAR1 value ; R4 contains the address of a routine to go to. ; R1 is set to point to the high-memory copy of the comm area ;- FINMAP: ADD R0,SP ; Fix stack after MAPX CLR R0 ; indicate copy UP CALL COPYUP ; get a copy of comm area up here MOV #SP$HIN,R1 $REL .-2 SP$HIN SPX JMP @R4 ...... .SBTTL COPYUP - Copy comm area to/from high memory .ENABL LSB COPYUP: MOV R2,-(SP) ; save INIT's rel base MOV R3,-(SP) ; save new PAR1 value MOV R4,-(SP) ; save dest address MOV #200,R1 ; 1st possible PAR1 value MOV @#SP$VEC,R2 ; Get the "vector" contents CMP R2,@#$SYPTR ; Are interrupts being forwarded? BLO 10$ ; Branch if not. MOV 4(R2),R2 ; If so, get true AST address 10$: ADD #SP.FXO,R2 ; Phys address of "Fixed Offsets" ; In order to use BLKMOV, make R2 PAR1 compatible. Adjust the PAR1 ; value accordingly. MOV #20000,R4 ; commonly used value 20$: CMP R2,#37777 ; is value a PAR1 address? BLOS 30$ ; branch if in or below PAR1 SUB R4,R2 ; otherwise, keep trying to put it ADD #200,R1 ; in PAR1 range. Then adjust PAR1. BR 20$ 30$: CMP R2,R4 ; is it BELOW PAR1 space (something BHIS 40$ ; that KEX might do to us) ADD R4,R2 ; Force it UP to PAR1 space SUB #200,R1 ; adjust the PAR1 value. ; (R3 is set by MAPX1 code on stack) 40$: MOV #SP$HIG,R4 ; high comm area's offset $REL .-2 SP$HIG SPX ; If R0 is ZERO, this is a copy UP operation. Otherwise, copy DOWN. ; For copy DOWN, swap R1<->R3 and R2<->R4. TST R0 BEQ 50$ ; It's a COPY_DOWN operation. MOV R1,R3 ; put P1_LOW in destination MOV (PC)+,R1 ; put P1_HIGH in source P1NEWX: .WORD 0 MOV R2,R0 ; swap R2<->R4 MOV R4,R2 MOV R0,R4 BR 60$ 50$: MOV R3,P1NEWX ; save new PAR1 above for COPYDOWN 60$: MOV #COMSIZ,R5 ; no. of words to copy MOV @#$SYPTR,R0 MOV P1$EXT(R0),R0 ; Get address of P1EXT CALL BLKMOV(R0) ; move comm area MOV (SP)+,R4 ; restore registers MOV (SP)+,R3 MOV (SP)+,R2 RETURN ...... .DSABL LSB .SBTTL IOINTX - Block I/O, high memory version .ENABL LSB IOINTX: MOV R2,R4 ; Let R4 hold the Q-elem ptr ADD SP.BSC(R1),SP.BNR(R1) ; Add count for split-up xfers. MOV R1,-(SP) ; save pointer to comm area, MOV R4,-(SP) ; save Q-elem pointer MOV Q$WCNT(R4),R5 ; get word count (negative) NEG R5 ; make it positive MOV #256.,R0 CMP R5,R0 ; still more than 256 words? BLE 10$ ; if LE, use it as is. MOV R0,R5 ; do only 256. words 10$: ADD R5,Q$WCNT(R4) ; adjust q-elem now. MOV R5,SP.WCR(R1) ; and set the spool wordcount MOV R5,-(SP) ; save the wordcount MOV Q$PAR(R4),R1 ; source PAR1 MOV Q$BUFF(R4),R2 ; source offset within PAR1 space MOV P1NEWX,R3 ; destination PAR1 MOV #SPFBUF,R4 ; destination offset within PAR1 $REL .-2 SPFBUF SPX MOV @#$SYPTR,R0 MOV P1$EXT(R0),R0 ; Get address of P1EXT CALL BLKMOV(R0) ; Move one block (or less) ; Zero-fill the end of the block, if it wasn't complete. MOV @SP,R0 ; get no. of words transferred MOV #SPFBUF,R4 ; point to SPOOL forwarding buffer $REL .-2 SPFBUF SPX ADD R0,R4 ADD R0,R4 ; point just beyond words transfered SUB #256.,R0 NEG R0 ; need to zero this many words BLE 30$ ; branch if complete block. 20$: CLR (R4)+ ; zero-fill the end of the block SOB R0,20$ ; Restore the registers and return. 30$: MOV (SP)+,R5 ; restore word count MOV (SP)+,R4 ; restore q-elem pointer, MOV (SP)+,R1 ; restore comm area pointer, ADD #8.,Q$PAR(R4) ; bump by 8 chunks for next time. .IF NE SP$EPS .IF NE SP$OPF ; Look through this block and count the formfeeds that are not followed ; by anything. These will be subtracted from the endpage count. MOV #SPFBUF,R0 ; get address of buffer, $REL .-2 SPFBUF SPX ASL R5 ; convert wordcount to bytecount ADD R0,R5 ; stop just beyond last byte 40$: CMP R0,R5 ; entire block searched? BHIS 60$ ; branch if done. MOVB (R0)+,R2 ; is char a NULL? BEQ 40$ ; if so, keep going. CMPB R2,# ; formfeed? BEQ 50$ ; branch if so. CLR SP.FFD(R1) ; any non-null wipes the FF count. BR 40$ ; look for another one... 50$: INC SP.FFD(R1) ; FF in file -- count it. BR 40$ ...... .ENDC; NE SP$OPF .ENDC; NE SP$EPS ; Ready to leave. 60$: TST Q$WCNT(R4) ; done yet? BNE 70$ ; branch if not. JMP SPEXIX ; otherwise, exit. ...... 70$: INC SP.BSC(R1) ; Yes, inc the segmentation count. MOV #RTSPC,R4 $REL .-2 RTSPC SPR BR 80$ ...... NOFUNX: MOV #RTSPC0,R4 ; Return to caller. $REL .-2 RTSPC0 SPR 80$: JMP UNMAPX ...... .DSABL LSB .ENDC; NE MMG$T .IF NE SP$EPS .SBTTL BANNER - Flagpage Generator ;+ ; The BANNER routine. This code is executed in response to .ENTER ; requests. It is included in versions of SP that contain either ; ENDPAG or FLAGPAGE support (SP$FLG is a subset of SP$EPS). ; ; On entry, R1 should point just past the bottom of the communications ; area at SPINT. ;- .ENABL LSB .IF NE MMG$T BANNEX: ; XM entry from low memory CALL RESET ; Reset buffer pointer and word count .IFF ;NE MMG$T BANNER: ; FB (NON_XM) entry CLR SP.WCR(R1) ; Reset the word count .ENDC; NE MMG$T CLR SP.BNR(R1) ; Clear block counter .IF NE SP$OPF CLR SP.FFD(R1) ; Clear file's formfeed counter .ENDC; NE SP$OPF .ENDC; NE SP$EPS .IF NE SP$FLG ;+ ; Convert the filename from RAD50 to ASCII ;- MOV #6,R0 ; R0 = number of bytes to convert. .IF EQ MMG$T MOV #SP$FNR,R4 ; R4 -> File name register. $REL .-2 SP$FNR SPR .IFF; EQ MMG$T MOV R1,R4 ADD #SP.FNR,R4 ; R4 -> File name register. .ENDC; EQ MMG$T MOV #ASCFIL,R5 ; R5 -> Output field. $REL .-2 ASCFIL SPX CALL R50ASC ; Convert to ASCII. MOV #3,R0 ; R0 = number of bytes in extension. .IF EQ MMG$T MOV #SP$FNR+4,R4 ; R4 -> extension word in FNR. $REL .-2 SPR .IFF; EQ MMG$T MOV R1,R4 ADD #,R4 ; R4 -> extension word in FNR. .ENDC; EQ MMG$T MOV #ASCEXT,R5 ; R5 -> extension ASCII buffer. $REL .-2 ASCEXT SPX CALL R50ASC ; Convert to ASCII. ;+ ; Encode the DATE into ASCII ;- MOV @#$SYPTR,R0 ; R0 -> base of RMON. MOV $DATE(R0),-(SP) ; SP = date in internal format. .IF EQ MMG$T MOV #SP$DAT,R4 ; R4 -> start of date string. $REL .-2 SP$DAT SPR .IFF; EQ MMG$T MOV R1,R4 ADD #SP.DAT,R4 ; R4 -> start of date string. .ENDC; EQ MMG$T MOV @SP,R5 ; R5 = date in internal format. BIC #^C,R5 ; check for valid date BEQ 5$ ; branch if date is not set CMP R5,#<12.*2000> ; month valid? BLE 20$ ; branch if date is good. 5$: MOV #NODATE,R5 ; point to empty date string $REL .-2 NODATE SPX 10$: MOVB (R5)+,(R4)+ ; move it there BNE 10$ TST (SP)+ ; fix stack BR 30$ ; jump around this section 20$: MOV @SP,R5 ; get date word BIC #^C,R5 ; Strip everything but day bits. .REPT 5 ASR R5 ; Shift into low order bits. .ENDR CALL PUTNUM ; Store the day. MOVB #'-,(R4)+ ; Store a dash. MOV @SP,R5 ; R5 = date in internal format. BIC #^C,R5 ; Strip everything but month bits. SWAB R5 ; Put bits into low order. SUB #4,R5 ; Bias from 0, not 1. ADD #MOTAB,R5 ; R5 -> This month. $REL .-2 MOTAB SPX .REPT 3 MOVB (R5)+,(R4)+ ; Put into the table. .ENDR MOVB #'-,(R4)+ ; Store a dash. MOV @SP,R5 ; R5 = date word again. ;024 BIC #^C,R5 ; Strip it to the year bits. ADD #110,R5 ; Add in the 72. bias. BIC #^C,@SP ; Strip off the era bits. ;024 SWAB @SP ; Shift them to the ;024 ASR @SP ; proper place ;024 ADD R5,@SP ; And add in the era*32 ;024 MOV #19.,R5 ; Default century=1900 ;024 CMP @SP,#100. ; Unless year after 2000 ;025 BLO 29$ ; skip if not after 2000 ;024 INC R5 ; we make century=2000 ;024 SUB #100.,@SP ; and adjust the year field ;024 29$: CALL PUTNUM ; Store the century ;024 MOV (SP)+,R5 ; Fetch the year ;024 CALL PUTNUM ; Store the year. CLRB (R4)+ ; Store trailing null. 30$: .ENDC; NE SP$FLG .IF NE SP$EPS MOV #<0>,R0 ; This is crucial (!) CALL CHROUT ; Send an initial NULL Character TSTB SP.FM0(R1) ; Want a form feed on block 0? BEQ 40$ ; Branch if not. CALL FFOUT ; Go output the FORMFEED 40$: .ENDC; NE SP$EPS .IF NE SP$FLG TST SP.BFG(R1) ; want any banner pages? BEQ 100$ ; Nope... MOV #,R0 CALL CHROUT ; Send an initial ; Re-enter here for multiple flag pages. 50$: CALL RT.11 ; Print the header CALL CRLF ; Followed by a .IF EQ SP$JFW ; Create the filename and extension in big text. CLR R0 ; get width of filename CALL ITMWID ; in R0 MOV #ASCFIL,R5 ; R5 -> Filename ASCII buffer. $REL .-2 ASCFIL SPX CALL BIGGY ; Print a line of big characters. ; Do we want big time and date? TST SP.BTM(R1) ; Is this the Jim Metsch format? BNE 80$ ; No, go do LARGE date/time .IF EQ SP$OLF MOV #33.,R0 ; Assume this many blank lines TST SP.WFL(R1) ; Doing WIDE flagpages? BNE 55$ ; branch if so. CALL CRLF MOV #4,R0 ; do 4-char extention MOV #ASCFIL+6,R5 ; R5 -> Extention buffer $REL .-2 SPX CALL BIGGY MOV #16.,R0 ; and then this many blank lines ; Output numerous blank lines and simple text with date and time. 55$: MOV R0,CCOUNT ; Number of lines to print. .IFF; EQ SP$OLF ; Output numerous blank lines and simple text with date and time. MOV #30.,CCOUNT ; Number of blank lines .ENDC; EQ SP$OLF .IFF; EQ SP$JFW MOV #16.,CCOUNT ; Number of blank lines for JFW .ENDC; EQ SP$JFW 60$: CALL CRLFS ; Output multiple (CCOUNT) CRLFs ; Squeeze/store filename in PRINTED ON line .IF NE SP$JFW MOV #13.,R5 ; Assume NOWIDE indent TST SP.WFL(R1) ; doing WIDE? BEQ 62$ MOV #35.,R5 ; Indent for JFW WIDE title 62$: MOV #A.SPACE,R0 CALL CHROUT ; output blanks DEC R5 BGT 62$ ; until indent is done, .ENDC; NE SP$JFW MOV #ASCFIL,R5 ; source string, $REL .-2 ASCFIL SPX MOV #SQFILN,R0 ; destination string... $REL .-2 SQFILN SPX 70$: MOVB (R5)+,@R0 ; move a filename char CMPB @R0,#40 ; blank? BEQ 70$ ; squeeze them out. INC R0 CMP R5,# $REL .-2 SPX BLOS 70$ CLRB -(R0) ; terminate it MOV #INFOLN,R5 ; R5 -> "File FFFFFF.NNN" text. $REL .-2 INFOLN SPX CALL STROUT ; Output the string. MOV #PRION,R5 ; R5 -> PRINTED ON text. $REL .-2 PRION SPX CALL STROUT ; Output the string. .IF EQ MMG$T MOV #SP$DAT,R5 ; R5 -> Date string. $REL .-2 SP$DAT SPR .IFF; EQ MMG$T MOV R1,R5 ADD #SP.DAT,R5 ; R5 -> Date string. .ENDC; EQ MMG$T CLRB 11.(R5) ; Make sure it ends with a null.;024 CALL STROUT MOV #PRIAT,R5 ; Point to the AT... string $REL .-2 PRIAT SPX CALL STROUT ; and print it. .IF EQ MMG$T MOV #SP$TIM,R5 $REL .-2 SP$TIM SPR .IFF; EQ MMG$T MOV #SP$HTM,R5 ; R5 -> High memory time string $REL .-2 SP$HTM SPX .ENDC; EQ MMG$T CLRB 8.(R5) CALL STROUT .IF EQ SP$JFW CALL CRLF CALL CRLF BR 90$ ; Merge below. ; Output the date and time in big text. 80$: CALL CRLF ; Some new lines. MOV #2,R0 ; get width of DATE CALL ITMWID ; in R0 .IF EQ MMG$T MOV #SP$DAT,R5 ; R5 -> date string. $REL .-2 SP$DAT SPR .IFF; EQ MMG$T MOV R1,R5 ADD #SP.DAT,R5 ; R5 -> date string. .ENDC; EQ MMG$T CALL BIGGY ; Output big text. ; Output the time in big text. CALL CRLF MOV #4,R0 ; get width of TIME CALL ITMWID ; in R0 .IF EQ MMG$T MOV #SP$TIM,R5 ; R5 -> time string. $REL .-2 SP$TIM SPR .IFF; EQ MMG$T MOV #SP$HTM,R5 ; R5 -> High memory time string $REL .-2 SP$HTM SPX .ENDC; EQ MMG$T CALL BIGGY ; Output big text. CALL CRLF .IFF; EQ SP$JFW MOV #35.,CCOUNT ; Number of blank lines CALL CRLFS .ENDC; EQ SP$JFW 90$: CALL RT.11 ; print some ** RT-11 ** stripes ; Do end of banner page. Loop if multiple flag pages are requested. CALL FFOUT ; Banner pages end in DEC SP.BFG(R1) ; Any more banner pages to do? BGT 50$ ; Yes... .ENDC; NE SP$FLG .IF NE SP$EPS ; Finish off and return to the monitor. 100$: MOV R2,-(SP) MOV R3,-(SP) MOV SP.WCR(R1),R2 ; block full? BEQ 120$ ; (CHROUT clears SP.WCR on blk dmp) INC SP.WCR(R1) ; if odd, make even for ASR below SUB #512.,R2 NEG R2 ; how many NULLs needed? MOV SP.BPR(R1),R3 ; point to next char 110$: CLRB (R3)+ ; Pad the block with NULLs SOB R2,110$ 120$: MOV (SP)+,R3 MOV (SP)+,R2 130$: ASR SP.WCR(R1) ; Convert to word count. .ENDC; NE SP$EPS .IF NE MMG$T SPEXIX: MOV #SPEXIT,R4 ; indicate EXIT $REL .-2 SPEXIT SPR JMP UNMAPX ; Return to the monitor. .IFF; NE MMG$T .IF NE SP$EPS JMP SPEXIT ; .DRFIN this I/O .ENDC; NE SP$EPS .ENDC; NE MMG$T ............ .IF NE SP$EPS .SBTTL ENDPAG - Do trailing form feeds .IF NE MMG$T ENDPAX: ; XM entry of ENDPAG CALL RESET ; Reset buffer pointer and word count .IFF ;NE MMG$T ENDPAG: CLR SP.WCR(R1) ; Reset the word count, .ENDC; NE MMG$T MOV SP.EPG(R1),CCOUNT ; CCOUNT = Count of 's on CLOSE .IF NE SP$OPF SUB SP.FFD(R1),CCOUNT ; Subtract out those already in file BLE 130$ ; Branch if none needed... .ENDC; NE SP$OPF 140$: CALL FFOUT ; Output a FORMFEED DEC CCOUNT ; More to do? BGT 140$ ; Yep... BR 100$ ; Finish above. ...... .DSABL LSB .SBTTL FFOUT - Output a formfeed FFOUT: SFR MOV #,R0 ; Output a FORMFEED CALL CHROUT RFS FFOUT .DSABL LSB .SBTTL CHROUT - Output a character to the spooler job ;+ ; Output a character to buffer in SPOOL ;- .ENABL LSB CHROUT: SFR MOVB R0,@SP.BPR(R1) ; Send character to SPOOL INC SP.BPR(R1) ; Increment pointer INC SP.WCR(R1) ; Count the character. CMP SP.WCR(R1),#512. ; Is the buffer full? BLO CHEXIT ; No, then just return. ASR SP.WCR(R1) ; Yes, then make it a word count. JSR R0,REGSAV ; Save all registers. REGS: .BLKW 6 ; Register save area. REGSAV: MOV R5,(R0)+ ; Save MOV R4,(R0)+ ; all MOV R3,(R0)+ ; of MOV R2,(R0)+ ; the MOV R1,(R0)+ ; registers. MOV (SP)+,(R0)+ ; Including R0. .ENDC; NE SP$EPS .IF NE MMG$T ; UNMAP from this area in high memory, back down to the low memory ; part of SP. Move code to the stack that will perform the unmap ; operation. This code is put on the stack and executed there, in ; case the handler was fetched into PAR1. .IF NE SP$EPS BAKDWN: MOV #GROUND,R4 ; Hijack and head home. $REL .-2 GROUND SPR .ENDC; NE SP$EPS UNMAPX: MOV SP,R0 ; non-zero indicates COPY_DOWN CALL COPYUP ; (really copy DOWN) MOV #UNMP2,R0 $REL .-2 UNMP2 SPX 4$: MOV -(R0),-(SP) ; move instructions to stack CMP R0,#UNMP1 ; all done? $REL .-2 UNMP1 SPX BHI 4$ ; loop if not. MOV SP,PC ; start executing stack ............ ; ---------- This code gets put on stack for execution ---------- UNMP1: MOV #.-.,@#KISAR1 ; UNMAP here. P1OLD = .-4 MOV #,R0 ; amount to fix stack by MOV #SPINT,R1 $REL .-2 SPINT SPR ; point to low-mem comm area JMP @#UNFNMP ; Jump to low-mem UNMAPX cleanup $REL .-2 UNFNMP SPR UNMP2: ; -------------------------------------------------------------- .ENDC; NE MMG$T .IF NE SP$EPS ; BANNER or ENDPAGE support... .IF EQ MMG$T ; for FB only... MOV #CHRCON,R5 ; Continue at CHRCON on interrupt. $REL .-2 CHRCON SPX ; Save in the post int. vector. JMP RRI ; Request another interrupt. ............ CHRCON: .IFF; EQ MMG$T ; for XM... CHRCOX: .IFTF; EQ MMG$T ; for both FB and XM... MOV #REGS,R0 ; Resume here. $REL .-2 REGS SPX MOV (R0)+,R5 ; Restore MOV (R0)+,R4 ; all MOV (R0)+,R3 ; of MOV (R0)+,R2 ; the MOV (R0)+,R1 ; registers. MOV (R0)+,R0 ; Including R0. INC SP.BNR(R1) ; Increment the block number. .IFT; EQ MMG$T CLR SP.WCR(R1) ; Reset the word count, (FB) .IFF; EQ MMG$T CALL RESET ; Reset buffer pointer and word count .ENDC; EQ MMG$T CHEXIT: RFS CHROUT ; Return to caller. .ENDC; NE SP$EPS .IF NE MMG$T ; for ALL XM handlers, define RESET RESET: CLR SP.WCR(R1) ; Reset the word count, MOV #SPFBUF,SP.BPR(R1) ; and the buffer pointer. $REL .-4 SPFBUF SPX RETURN .ENDC; NE MMG$T CCOUNT: .WORD 0 ; character counter .DSABL LSB .IF NE SP$FLG ; END_PAGE AND FLAG_PAGE Support .SBTTL RT.11 - Print an RT banner page ;+ ; Print the flag page liner. ;- .ENABL LSB RT.11: SFR ; Save return address. MOV #SITEND-26.,R5 ; point at narrow version's beginning $REL .-2 SPX TST SP.WFL(R1) ; printing WIDE forms? BNE 5$ ; Yes. Go store stars instead MOV #6412,(R5)+ ; setup for NOWIDE. CLRB @R5 ; Set CRFL and Null into end. MOV #SITE+22.,R5 ; Start 20 characters into header. $REL .-2 SPX BR 10$ ...... 5$: MOV #"**,(R5)+ ; print trailing stars. MOVB #'*,@R5 MOV #SITE,R5 ; and start at the beginning. $REL .-2 SITE SPX MOVB #'*,22.(R5) 10$: MOV R5,(PC)+ ; Save where we start printing. 20$: .WORD 0 ; Pointer to start of header line. MOVB #40,@R5 ; Always print a leading blank. MOV #3,R4 ; Print 3 lines of text. 30$: MOV 20$,R5 ; R5 -> Facility identifier text. 40$: MOVB (R5)+,R0 ; Get a character. BEQ 50$ ; Null ends the string. CALL CHROUT ; Output the character. BR 40$ ; Continue until output. 50$: SOB R4,30$ ; All lines output? If not loop. RFS RT.11 ; Yes, then return from here. .DSABL LSB .IF EQ SP$JFW .SBTTL BIGGY - PRINT BIG CHARACTERS ;+ ; Print BIG characters. ;- .ENABL LSB BIGGY: SFR ; Save return keeping stack constant. MOV #CHRADR,R2 ; R2 -> Table of font table pointers. $REL .-2 CHRADR SPX MOV R0,(PC)+ ; Save number of characters to print. NUMCHR: .WORD 0 MOV R0,CCOUNT ; (here also) MOV R5,(PC)+ ; Save pointer to actual message. BUFPTR: .WORD 0 10$: MOVB (R5)+,R0 ; R0 = character to be indexed. MOV #A,R4 ; R4 -> Base of A to Z range. $REL .-2 A SPX JSR R5,RANGE ; Is this char in the A to Z range? .WORD A.A, A.Z BCC 20$ ; Yes then go to loop end. MOV #ZERO,R4 ; R4 -> Base of 0 to colon range. $REL .-2 ZERO SPX JSR R5,RANGE ; Is char in 0 to colon range? .WORD A.0, A.COLON BCC 20$ ; Yes then go to loop end. MOV #DASH,R4 ; R4 -> Base of dash to dot range. $REL .-2 DASH SPX JSR R5,RANGE ; Is char in the dash to dot range? .WORD A.DASH, A.DOT BCC 20$ ; Yes then go to loop end. MOV #BLANK,R4 ; R4 -> Base of space in table. $REL .-2 BLANK SPX JSR R5,RANGE ; Is character a space? .WORD A.SPACE,A.SPACE BCC 20$ ; Yes, then go to loop end. CLR (R2)+ ; Clear the index, nothing to print. BR 30$ ; Go to loop end. ...... ;+ ; At this point, R3 contains the character and R4 contains the base address. ; Calculate the font table address and put it in the font pointer table. ;- 20$: SUB R3,R0 ; Remove the ASCII base. ASL R0 ; * 2. ASL R0 ; * 4. MOV R0,-(SP) ; Save the * 4. value. ASL R0 ; * 8. ASL R0 ; * 16. ADD R0,@SP ; *4+*16 = *20 MOV R4,R0 ; R0 -> A in alpha table. ADD (SP)+,R0 ; R0 -> specific character. MOV R0,(R2)+ ; Save the character address. ;+ ; Loop control, continue until all characters are indexed. ;- 30$: DEC CCOUNT ; Count this character. BNE 10$ ; Repeat until all address computed. ;+ ; At this point, addresses are calculated and placed the font pointer table. ; Print the characters. ;- MOV #1,R3 ; R3 = font bit being printed. 40$: CALL CRLF ; Print a carriage return / line feed. MOV #CHRADR,R2 ; R2 -> table of chars to be printed. $REL .-2 CHRADR SPX MOV NUMCHR,CCOUNT ; CCOUNT = number of chars to print MOV BUFPTR,R5 ; R5 -> original message. 50$: .IF NE MMG$T ; Economize on output. If remaining characters are all blanks, don't ; print them. This is NOT included in the FB version, simply to conserve ; handler space. MOV R5,R4 ; save string pointer... MOV CCOUNT,R0 51$: CMPB (R5)+,#40 ; nothing more than blanks remaining? BNE 53$ DEC R0 BGT 51$ BR 95$ ; Nope. Don't print any more. ...... 53$: MOV R4,R5 ; retrieve string pointer .ENDC; NE MMG$T MOV #A.SPACE,R0 ; output two blanks CALL CHROUT ; MOV #A.SPACE,R0 CALL CHROUT 55$: MOV #10.,(PC)+ ; Set for width of each character. 60$: .WORD 10. MOVB (R5)+,R0 ; R0 = character to print. CMP R0,#A.DASH ; Is it a dash? BEQ 65$ ; Yes, then substitute a star. CMPB R0,#A.DOT ; Is it a dot? BEQ 65$ ; Yes, then substitute a star. CMPB R0,#A.COLON ; Is it a colon? BNE 70$ ; Yes, then substitute a star. 65$: MOV #A.STAR,R0 ; Use a star to form the character. 70$: MOV (R2)+,R4 ; R4 -> character rendition. BEQ 90$ ; Ignore invalid characters. 75$: MOV R0,(PC)+ ; Save the actual character. 80$: .WORD 0 ; Character save word. BIT R3,(R4)+ ; Should it be printed. BNE 85$ ; Yes, branch around. MOV #A.SPACE,R0 ; No, then print an asterith. 85$: CALL CHROUT ; Print the character. MOV 80$,R0 ; Restore the actual character. DEC 60$ ; Is a line of this character printed? BNE 75$ ; No, then continue. 90$: DEC CCOUNT ; All characters printed. BNE 50$ ; Continue on the next character. 95$: ASL R3 ; Move the next bit. CMP R3,#40000 ; All lines output. BLO 40$ ; No, then continue. CALL CRLF ; Output a couple of line feeds. CALL CRLF RFS BIGGY ; Return to the caller. ...... .DSABL LSB .SBTTL RANGE - Range check a character ;+ ; Determine if a character lies within a specified range. ; ; R0 contains the character ; R5 points to LOW value of range ; and then to HIGH value of range ; ; R3 is trashed ;- .ENABL LSB RANGE: MOV (R5)+,R3 ; R3 = Bottom character of this range. CMP R0,(R5)+ ; Is character above top of range? BHI 20$ ; Yes, return with carry set. CMP R0,R3 ; Is character below the bottom? BLO 20$ ; Yes, return with carry set. 10$: TST (PC)+ ; Clear the carry. 20$: SEC ; Set the carry. RTS R5 ; Return to the caller. .DSABL LSB .ENDC; EQ SP$JFW .SBTTL GETFIL - Filename subroutine ; Subroutine to get the filename for special function requests ; ; On entry: R4 -> current queue element at Q.BLKN. ; On exit: SP$FNR contains the filename. ; R4 - unchanged ; R5 - random .ENABL LSB .IF EQ MMG$T GETFIL: MOV R4,-(SP) ; Save R4. .IFF; EQ MMG$T GETFLX: MOV R2,R4 ; point to queue element .ENDC; EQ MMG$T MOV R3,-(SP) ; Save R3. MOV Q$BUFF(R4),R5 ; R5 -> Filename in user's program. MOV R1,R3 ADD #SP.FNR,R3 ; point to ASCII filename area .IF EQ MMG$T MOV (R5)+,(R3)+ ; Copy the MOV (R5)+,(R3)+ ; filename to MOV (R5)+,(R3)+ ; the control register. .IFF MOV Q$PAR(R4),20$ ; Setup to map to the user's buffer. MOV R1,-(SP) ; save comm pointer MOV #3,R2 ; Initialize to loop 3 times. MOV @#$SYPTR,R0 MOV P1$EXT(R0),R1 10$: JSR R0,(R1) ; Call P1EXT .WORD 20$-. ; This many words to execute. MOV (R5)+,R4 ; R4 = a word of the filename. 20$: .WORD 0 ; Storage for PAR 1 bias. MOV R4,(R3)+ ; Store in the filename register. SOB R2,10$ ; Repeat until whole file copied. MOV (SP)+,R1 ; Restore comm pointer .ENDC; EQ MMG$T MOV (SP)+,R3 ; Restore R3. .IF EQ MMG$T MOV (SP)+,R4 ; Restore R4. RETURN ; Return to the caller. ...... .IFF; EQ MMG$T MOV #GETFLR,R4 $REL .-2 GETFLR SPR JMP UNMAPX ; return to caller. ...... .ENDC; EQ MMG$T .DSABL LSB .IF EQ SP$JFW .SBTTL ITMWID - Return width of FILENAME, DATE or TIME ;+ ; Return width of FILENAME (code=0), DATE (code=2) or TIME (code=4) ; depending on the current width setting for the unit. ; ; On entry, R0 = code ; R1 = comm area pointer ; ; On return, R0 contains the width of the requested item. ;- .ENABL LSB ITMWID: ADD #WIDTAB,R0 ; point to NOWIDE values $REL .-2 WIDTAB SPX TST SP.WFL(R1) ; wide mode? BEQ 10$ ; branch if so ADD #6,R0 ; point to WIDE values 10$: MOV @R0,R0 ; get width of item RETURN .DSABL LSB .ENDC; EQ SP$JFW .SBTTL CRLF - Output a carriage return and line feed ;+ ; print carriage return and line feed. ;- CRLF: SFR ; Save return address. MOV #,R0 CALL CHROUT ; output CR MOV #,R0 CALL CHROUT ; output LF RFS CRLF ; Return ...... .SBTTL STROUT - Output a string ;+ ; Subroutine to output a string pointed to by R5. ;- .ENABL LSB STROUT: SFR ; Save return address. 10$: MOVB (R5)+,R0 ; Get a character. BEQ 20$ ; Exit on null character. CALL CHROUT ; Output the character. BR 10$ ; Continue. 20$: RFS STROUT ; Return from subroutine. ...... .SBTTL CRLFS - Do Multiple CRLFs ; Do Multiple CRLFs. Specify the number to do in CCOUNT. CRLFS: SFR 30$: CALL CRLF ; Do a CRLF, DEC CCOUNT ; count it, BGT 30$ ; and keep going until CCOUNT=0 RFS CRLFS ...... .DSABL LSB .SBTTL PUTNUM - Store a two-digit ASCII number ;+ ; Convert and store a 2 digit ASCII number. ; ; R5 contains the number to convert ; R4 points to the output buffer ; ; R0 gets trashed ;- .ENABL LSB PUTNUM: MOV #'0,R0 ; R0 = an ASCII zero. MOVB R0,(R4)+ ; Store in some zeroes. MOVB R0,@R4 10$: INCB @R4 ; Count the digit. CMPB @R4,#': ; Did we overflow? BNE 20$ ; No, continue. MOVB R0,@R4 ; Store a zero again. INCB -1(R4) ; And increment the 10s digit. 20$: SOB R5,10$ ; Done? If not continue. INC R4 ; Yes, move to the next location. RETURN ; And return to the caller. ...... .DSABL LSB .SBTTL R50ASC - RADIX 50 to ASCII conversion ;+ ; Input: R0 = Number of bytes to output. ; R4 = Address of input rad50. ; R5 = Address of output string. ; CALL R50ASC ; ; On exit:All registers except R2 and R3 random. ;- .ENABL LSB R50ASC: MOV R3,-(SP) ; save R3 MOV R2,-(SP) MOV R0,CCOUNT ; save no. of chars to do 1$: MOV #DIVTAB,R3 ; R3 -> division table. $REL .-2 DIVTAB SPX MOV (R4)+,R2 ; R2 = current input word. 2$: TST -(R3) ; New word required yet? BEQ 1$ ; Yes. MOV #-1,R0 ; Initialize quotient register. CMP #174777,R2 ; Value too large? BLO 4$ ; Yes - output question marks. 3$: INC R0 ; Divide by appropriate power of 50(8) SUB @R3,R2 BCC 3$ ADD @R3,R2 ; Restore dividend. TST R0 ; Character is a blank? BEQ 5$ ; Yes CMP #33,R0 ; Dollar sign, period, or digit? BLO 6$ ; Period or digit. BEQ 7$ ; Dollar sign. 4$: ADD #40,R0 ; Else alp (a-z) or ? mark (as above). 5$: ADD #16,R0 6$: ADD #11,R0 7$: ADD #11,R0 8$: MOVB R0,(R5)+ ; Store converted character in output. DEC CCOUNT ; Any more chars to produce? BNE 2$ ; Yes MOV (SP)+,R2 MOV (SP)+,R3 RETURN ...... .DSABL LSB .SBTTL RAD50 Table .WORD 0 ; End-of-table flag. .WORD 1 .WORD 50 .WORD 3100 DIVTAB= . ; RAD50 division table. .SBTTL CHARACTER FONTS AND FACILITY IDENTIFIER ; NOWIDE WIDE WIDTAB: .WORD 6.,6.,5., 10.,11.,8. ; Lengths (file, date, time) ;024 ;+ ; Month name table ;- MOTAB: .ASCIZ "JAN" .ASCIZ "FEB" .ASCIZ "MAR" .ASCIZ "APR" .ASCIZ "MAY" .ASCIZ "JUN" .ASCIZ "JUL" .ASCIZ "AUG" .ASCIZ "SEP" .ASCIZ "OCT" .ASCIZ "NOV" .ASCIZ "DEC" NODATE: .ASCIZ /-----------/ ;024 ;+ ; Store the ASCII filename here. ;- ASCFIL: .ASCII "FILENA." ASCEXT: .ASCII "EXT" INFOLN: .ASCII " File " SQFILN: .BLKB 11. PRION: .ASCIZ " printed on " PRIAT: .ASCIZ " at " .EVEN .SBTTL Banner Lines .IF NE SP$DEC SITE:: .ASCII " ***********************" .ASCII " Digital Equipment Corporation," .ASCII " 146 Main Street, Maynard Mass.," .ASCII " U.S.A. " .ASCIZ " ***********************" .EVEN SITEND = . .IFF ...CMV TYPE=V SITE:: .ASCII " *********************" .ASCII "*** RT-11 **** " SIT01: .BYTE ,,'.,, SIT02: ADD$ = <8.-> .IF GT ADD$ .REPT ADD$ .ASCII " " .ENDR .ENDC .ASCII "**** RT-11 **** " .BYTE ,,'.,, .IF GT ADD$ .REPT ADD$ .ASCII " " .ENDR .ENDC .ASCII "**** RT-11 **" .ASCIZ "***********************" SITEND = . LEN$ = .ENDC; NE SP$DEC .EVEN .IF EQ SP$JFW ;+ ; Character font table. ; ; A to Z is first group of characters. ; 0 to : is second group of characters. ; - to . is the third group of characters. ; stands alone. ;- CHRADR: .BLKW 10. ; Pointer to 10 characters to be printed. .RADIX 2 .IFTF .NLIST .IFT A: .WORD 11111111111100 ;1 .WORD 11111111111110 ;2 .WORD 00000110000011 ;3 .WORD 00000110000011 ;4 .WORD 00000110000011 ;5 .WORD 00000110000011 ;6 .WORD 00000110000011 ;7 .WORD 00000110000011 ;8 .WORD 11111111111110 ;9 .WORD 11111111111100 ;10 B: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111111111 ;9 .WORD 01111100111110 ;10 C: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 11000000000011 ;6 .WORD 11000000000011 ;7 .WORD 11000000000011 ;8 .WORD 11110000001111 ;9 .WORD 01110000001110 ;10 D: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 11000000000011 ;6 .WORD 11000000000011 ;7 .WORD 11000000000011 ;8 .WORD 11111111111111 ;9 .WORD 01111111111110 ;10 E: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11000000000011 ;9 .WORD 11000000000011 ;10 F: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000011000011 ;3 .WORD 00000011000011 ;4 .WORD 00000011000011 ;5 .WORD 00000011000011 ;6 .WORD 00000011000011 ;7 .WORD 00000011000011 ;8 .WORD 00000000000011 ;9 .WORD 00000000000011 ;10 G: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111001111 ;9 .WORD 01111110001110 ;10 H: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000011000000 ;3 .WORD 00000011000000 ;4 .WORD 00000011000000 ;5 .WORD 00000011000000 ;6 .WORD 00000011000000 ;7 .WORD 00000011000000 ;8 .WORD 11111111111111 ;9 .WORD 11111111111111 ;10 I: .WORD 00000000000000 ;1 .WORD 11000000000011 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11111111111111 ;5 .WORD 11111111111111 ;6 .WORD 11000000000011 ;7 .WORD 11000000000011 ;8 .WORD 11000000000011 ;9 .WORD 00000000000000 ;10 J: .WORD 00000000000000 ;1 .WORD 00110000000000 ;2 .WORD 01110000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 01111111111111 ;6 .WORD 00111111111111 ;7 .WORD 00000000000011 ;8 .WORD 00000000000011 ;9 .WORD 00000000000000 ;10 K: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000011000000 ;3 .WORD 00000111100000 ;4 .WORD 00001100110000 ;5 .WORD 00011000011000 ;6 .WORD 00110000001100 ;7 .WORD 01100000000110 ;8 .WORD 11000000000011 ;9 .WORD 10000000000001 ;10 L: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11000000000000 ;3 .WORD 11000000000000 ;4 .WORD 11000000000000 ;5 .WORD 11000000000000 ;6 .WORD 11000000000000 ;7 .WORD 11000000000000 ;8 .WORD 11000000000000 ;9 .WORD 11000000000000 ;10 M: .WORD 11111111111111 ;1 .WORD 11111111111110 ;2 .WORD 00000000111100 ;3 .WORD 00000001110000 ;4 .WORD 00000011100000 ;5 .WORD 00000011100000 ;6 .WORD 00000001110000 ;7 .WORD 00000000111100 ;8 .WORD 11111111111110 ;9 .WORD 11111111111111 ;10 N: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000000001110 ;3 .WORD 00000000111100 ;4 .WORD 00000011110000 ;5 .WORD 00001111000000 ;6 .WORD 00111100000000 ;7 .WORD 01110000000000 ;8 .WORD 11111111111111 ;9 .WORD 11111111111111 ;10 O: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 11000000000011 ;6 .WORD 11000000000011 ;7 .WORD 11000000000011 ;8 .WORD 11111111111111 ;9 .WORD 01111111111110 ;10 P: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000110000011 ;3 .WORD 00000110000011 ;4 .WORD 00000110000011 ;5 .WORD 00000110000011 ;6 .WORD 00000110000011 ;7 .WORD 00000110000011 ;8 .WORD 00000111111111 ;9 .WORD 00000011111110 ;10 Q: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 11010000000011 ;6 .WORD 11110000000011 ;7 .WORD 01100000000011 ;8 .WORD 11111111111111 ;9 .WORD 11011111111110 ;10 R: .WORD 11111111111111 ;1 .WORD 11111111111111 ;2 .WORD 00000110000011 ;3 .WORD 00000110000011 ;4 .WORD 00001110000011 ;5 .WORD 00011110000011 ;6 .WORD 00110110000011 ;7 .WORD 01100110000011 ;8 .WORD 11000111111111 ;9 .WORD 10000011111110 ;10 S: .WORD 01110001111110 ;1 .WORD 11110011111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111001111 ;9 .WORD 01111110001110 ;10 T: .WORD 00000000000011 ;1 .WORD 00000000000011 ;2 .WORD 00000000000011 ;3 .WORD 00000000000011 ;4 .WORD 11111111111111 ;5 .WORD 11111111111111 ;6 .WORD 00000000000011 ;7 .WORD 00000000000011 ;8 .WORD 00000000000011 ;9 .WORD 00000000000011 ;10 U: .WORD 01111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11000000000000 ;3 .WORD 11000000000000 ;4 .WORD 11000000000000 ;5 .WORD 11000000000000 ;6 .WORD 11000000000000 ;7 .WORD 11000000000000 ;8 .WORD 11111111111111 ;9 .WORD 01111111111111 ;10 V: .WORD 00000000000111 ;1 .WORD 00000000111111 ;2 .WORD 00000111111000 ;3 .WORD 00111111000000 ;4 .WORD 11111000000000 ;5 .WORD 11111000000000 ;6 .WORD 00111111000000 ;7 .WORD 00000111111000 ;8 .WORD 00000000111111 ;9 .WORD 00000000000111 ;10 W: .WORD 00111111111111 ;1 .WORD 11111111111111 ;2 .WORD 11111100000000 ;3 .WORD 00001110000000 ;4 .WORD 00000011100000 ;5 .WORD 00000011100000 ;6 .WORD 00001110000000 ;7 .WORD 11111100000000 ;8 .WORD 11111111111111 ;9 .WORD 00111111111111 ;10 X: .WORD 11000000000011 ;1 .WORD 11100000001111 ;2 .WORD 00111000011100 ;3 .WORD 00011100110000 ;4 .WORD 00000111100000 ;5 .WORD 00000111100000 ;6 .WORD 00011100110000 ;7 .WORD 00111000011100 ;8 .WORD 11100000001111 ;9 .WORD 11000000000011 ;10 Y: .WORD 00000000000011 ;1 .WORD 00000000001111 ;2 .WORD 00000000111100 ;3 .WORD 00000011110000 ;4 .WORD 11111111000000 ;5 .WORD 11111111000000 ;6 .WORD 00000011110000 ;7 .WORD 00000000111100 ;8 .WORD 00000000001111 ;9 .WORD 00000000000011 ;10 Z: .WORD 10000000000011 ;1 .WORD 11000000000011 ;2 .WORD 11110000000011 ;3 .WORD 11111100000011 ;4 .WORD 11001111000011 ;5 .WORD 11000011110011 ;6 .WORD 11000000111111 ;7 .WORD 11000000001111 ;8 .WORD 11000000000011 ;9 .WORD 11000000000001 ;10 ZERO: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000000000011 ;5 .WORD 11000000000011 ;6 .WORD 11000000000011 ;7 .WORD 11000000000011 ;8 .WORD 11111111111111 ;9 .WORD 01111111111110 ;10 ONE: .WORD 00000000000000 ;1 .WORD 11000000000100 ;2 .WORD 11000000000110 ;3 .WORD 11000000000011 ;4 .WORD 11111111111111 ;5 .WORD 11111111111111 ;6 .WORD 11000000000000 ;7 .WORD 11000000000000 ;8 .WORD 11000000000000 ;9 .WORD 00000000000000 ;10 TWO: .WORD 11110000000110 ;1 .WORD 11111000000111 ;2 .WORD 11001100000011 ;3 .WORD 11000110000011 ;4 .WORD 11000011000011 ;5 .WORD 11000001100011 ;6 .WORD 11000000110011 ;7 .WORD 11000000011011 ;8 .WORD 11000000001111 ;9 .WORD 11000000000110 ;10 THREE: .WORD 01100000000011 ;1 .WORD 11100000000011 ;2 .WORD 11000000000011 ;3 .WORD 11000000000011 ;4 .WORD 11000001100011 ;5 .WORD 11000011110011 ;6 .WORD 11000011011011 ;7 .WORD 11000011001111 ;8 .WORD 11111110000111 ;9 .WORD 01111100000011 ;10 FOUR: .WORD 00000011111111 ;1 .WORD 00000011111111 ;2 .WORD 00000011000000 ;3 .WORD 00000011000000 ;4 .WORD 00000011000000 ;5 .WORD 00000011000000 ;6 .WORD 11111111111111 ;7 .WORD 11111111111111 ;8 .WORD 00000011000000 ;9 .WORD 00000011000000 ;10 FIVE: .WORD 01110011111111 ;1 .WORD 11110011111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111000011 ;9 .WORD 01111110000011 ;10 SIX: .WORD 01111111111110 ;1 .WORD 11111111111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111000111 ;9 .WORD 01111110000110 ;10 SEVEN: .WORD 11111000000111 ;1 .WORD 11111100000111 ;2 .WORD 00000110000011 ;3 .WORD 00000011000011 ;4 .WORD 00000001100011 ;5 .WORD 00000000110011 ;6 .WORD 00000000011011 ;7 .WORD 00000000001111 ;8 .WORD 00000000000111 ;9 .WORD 00000000000011 ;10 EIGHT: .WORD 01111100111110 ;1 .WORD 11111111111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111111111 ;9 .WORD 01111100111110 ;10 NINE: .WORD 01100001111110 ;1 .WORD 11100011111111 ;2 .WORD 11000011000011 ;3 .WORD 11000011000011 ;4 .WORD 11000011000011 ;5 .WORD 11000011000011 ;6 .WORD 11000011000011 ;7 .WORD 11000011000011 ;8 .WORD 11111111111111 ;9 .WORD 01111111111110 ;10 COLON: .WORD 00000000000000 ;1 .WORD 00000000000000 ;2 .WORD 00000000000000 ;3 .WORD 00011100011100 ;4 .WORD 00011100011100 ;5 .WORD 00011100011100 ;6 .WORD 00000000000000 ;7 .WORD 00000000000000 ;8 .WORD 00000000000000 ;9 .WORD 00000000000000 ;10 DASH: .WORD 00000011000000 ;1 .WORD 00000011000000 ;2 .WORD 00000011000000 ;3 .WORD 00000011000000 ;4 .WORD 00000011000000 ;5 .WORD 00000011000000 ;6 .WORD 00000011000000 ;7 .WORD 00000011000000 ;8 .WORD 00000011000000 ;9 .WORD 00000011000000 ;10 PERIOD: .WORD 00000000000000 ;1 .WORD 00000000000000 ;2 .WORD 00000000000000 ;3 .WORD 11100000000000 ;4 .WORD 11100000000000 ;5 .WORD 11100000000000 ;6 .WORD 00000000000000 ;7 .WORD 00000000000000 ;8 .WORD 00000000000000 ;9 .WORD 00000000000000 ;10 BLANK: .WORD 00000000000000 ;1 .WORD 00000000000000 ;2 .WORD 00000000000000 ;3 .WORD 00000000000000 ;4 .WORD 00000000000000 ;5 .WORD 00000000000000 ;6 .WORD 00000000000000 ;7 .WORD 00000000000000 ;8 .WORD 00000000000000 ;9 .WORD 00000000000000 ;10 .RADIX 8. .ENDC; EQ SP$JFW .ENDC; NE SP$FLG .LIST .IF NE MMg$t OldBase:.Word SPBase ; relocation bias save word $Rel .-2 SPBase SPR .Restore ;***************************************************************************** .ENDC; NE MMg$t .SbTtl Initialization, one-time code .Enable LSB ; ; R0 -- work register ; R1 -- work register ; R2 -- SPBASE value ; R3 -- RMON base ; R4 -- reserved ; R5 -- reserved ; Init: ; .Assume SPBase EQ ...1st .Assume NOP EQ 240 Mov #Nop,-(R2) ; replace JSR R2,Init Mov #Nop,-(R2) ; with Nop Nop ; ; R2 now points to SPBase ; ; and the place to return to Mov R2,-(SP) ; save R2 ; --------- Setup pointers to monitor structures -------------- ; ( Determination of P1NEW value was here ) ; ( SP loop was here ) .IF NE MMG$T MOV #INITX,R4 ; Point to INIT code in high mem $REL .-2 INITX SPX JMP MAPX ; map to it, and go there. ............ .SAVE ; ************************* HIGH MEM PSECT ************************* .PSECT SPX INITXF: MOV #GROUIN,R4 ; EXIT: Point to destination $REL .-2 GROUIN SPR ; (This is here because it has ; to be $REL'd before executing.) JMP UNMAPX ; Go unmap, and hopefully land... ; below at "GROUIN" in low mem INITX: ; ENTRY POINT for HIGH MEM INIT .ENDC; NE MMG$T JSR R0,60$ ; Relocate SPR's ; ---------------------------- SPR List ---------------------------- SPR.Did = 1 SPR.Lst: .If NE SPR.Cnt .Rept SPR.Cnt .Irp x <\SPR.Did> .Word SPR.'x $Rel .-2 SPR.'x SPX .EndR SPR.Did = SPR.Did+1 .EndR .EndC ;NE SPR.Cnt .Word 000000 ; end of list ; -------------------- SPR List Processing Loop -------------------- 60$: ; Do SPR's --- .If NE MMg$t Sub @#OldBase,R2 ; remove bias from last $Rel .-2 OldBase SPX ; (if any) relocation of the ; SPR list. ; (Note that OldBase itself is ; an SPR $REL and done LAST) .EndC; NE MMg$t 70$: Mov (R0)+,R1 ; get next reloc list entry Beq 80$ ; done this list Add R2,@R1 ; relocate value in address Br 70$ ; and do next .......... 80$: Pop R0 ; restore R0 from JSR R0, ... .If NE MMg$t BR INITXF ; branch above to satisfy $REL order ............ .restore ; ************************* LOW MEM PSECT ***************************** GROUIN: ; After UNMAPing from HIGH INIT, .EndC; NE MMg$t MOV (SP)+,R2 ; Restore R2 RTS R2 ; start again after initialization .......... InitSz ==: .-Init ; size of one time (low-mem) code InitHi: .SBTTL HANDLER TERMINATION .DREND SP .If NE MMG$T .SbTtl Installation overlay .Enabl LSB ;***************************************************************************** .PSect SetOvr InsBk0: SPXSiz = SPX-SPXBase+KTGran-1/KTGran ; amount to allocate OvrIns: .Wait #SysChn ; are we running at INSTALL time? Bcc 10$ ; Yes, KMON is calling us .Assume BotChn EQ 0 .Wait #0 ; are we running at BOOT time? Bcs InsNoB ; no, then we can't read .Assume BotChn EQ 0 ClrB ORdChn ; use BOOT channel Add BlkAdd+,ORdBlk ; add in offset to SPX file 10$: ;***NOTE: This code is essentially duplicated in INIT:, change it there ; if it changes here! Mov @#$SYPTR,R1 ; point to RMON Mov $MEMPT(R1),R0 ; get offset to memory tables**GVAL** Add R1,R0 ; get real address Mov CorPtX(R0),R5 ; get offset to extended ALLOC**PEEK** Add R1,R5 ; and real address MOV P1$Ext(R1),P1EXTA ; save for possible deallocation 20$: Cmp #-1,(R5)+ ; look for end of free list **PEEK** Bne 20$ ; loop until found ; R5 now points to handler RCBs ; Search for existing region with our name "SP_$__" ; (why should there be such a region?) MOV R5,R0 ; save pointer to 1st entry 24$: CMP #-1,@R0 ; end of list? BEQ 30$ ; If so, go make an entry. TST @R0 ; empty entry? BEQ 26$ ; branch if so. CMP GR.Nam(R0),(PC)+ ; 1st 3 chars = "SPx"? .RModule BNE 26$ ; if not, try next entry. CMP (R0),#<^r$ > ; 2nd 3 chars "$ "? BNE 26$ ; if not, try next entry. MOV R0,RCBP ; point to the RCB MOV R0,-(SP) MOV R5,-(SP) CALL DEALLO ; De-allocate it. MOV (SP)+,R5 MOV (SP)+,R0 26$: ADD #GR.Esz,R0 ; point to next RCB BR 24$ ; continue searching. ; Search RCB table for an empty entry, and attach to it. 30$: ; look for an empty one Cmp #-1,@R5 ; end of list? **PEEK** Beq InsNoB ; yes, failure Tst @R5 ; empty? **PEEK** Beq 40$ ; yes, got one to use Add #GR.Esz,R5 ; point to next ;GLA001 Br 30$ ; keep trying .......... 40$: Mov P1EXTA,R0 ; get address of P1EXT routine**GVAL** MOV R5,RCBP ; save for possible deallocation Mov #SPXSiz,R2 ; area needed Call XAlloc(R0) ; call routine to allocate it Bcs 45$ ; failed .Assume GR.Siz EQ 0 Mov R2,(R5)+ ; build RCB **POKE** .Assume GR.Adr EQ GR.Siz+2 Mov R1,(R5)+ ; **POKE** .Assume GR.Sta EQ GR.Adr+2 Clr (R5)+ ; set status to SHARED **POKE** .Assume GR.Nam EQ GR.Sta+2 Mov (PC)+,(R5)+ ; put name in RCB **POKE .RModule ; our Rad50 name Mov #<^r$ >,@R5 ; second part of name is $ **POKE Mov @#PS,OldPS ; save the PSW **IOPAGE** Bic #CMKern,@#PS ; set current mode to Kernel**IOPAGE** Push @#KISDR1 ; save current mapping **IOPAGE** Push @#KISAR1 ; registers **IOPAGE** Mov R1,@#KISAR1 ; map to extended region ; (where are we?) **IOPAGE** Mov #AP$ACF,@#KISDR1 ; ... **IOPAGE** .Addr #ORead,R0 ; adrs of read rqst block **PIC** INSRED::.ReadC CODE=NOSET ; read into extended memory ; really a .READW Bcs UnMap0 ; failed ... kill install ;NOTE: the following is duplicated in the INIT (in buffer area) for SJ/FB/RTEM ; If you change it here, change it there too! ; (there are currently NO RMON $RELS, so this code is commented out.) ; Mov @#$SYPTR,R0 ; point to RMON ;RMX.Did = 1 ;.Rept RMX.Cnt ; .Irp x <\RMX.Did> ; Add R0,@#RMX.'x ; relocate using $SYPTR as base ;$Rel .-2 RMX.'x SPX ; .EndR ;RMX.Did = RMX.Did+1 ;.EndR Pop @#KISAR1 ; restore mapping **IOPAGE** Pop @#KISDR1 ; **IOPAGE** Mov #.-.,@#PS ; restore psw **IOPAGE** OldPS =: .-4 ClC ; success Return ...... InsNoB: Br InsNo0 ; relay point .............. 45$: TstB ORdChn ; boot time? Beq InsNo0 ; yes, no message .Addr #NoHMem,R0 ; point to message **PIC** .Print Br InsNo0 .............. DEALLO: MOV RCBP,R1 ; Point to our RCB MOV P1EXTA,R0 ; and to monitor $P1EXT MOV GR.Siz(R1),R2 MOV GR.Adr(R1),R1 CALL XDEALC(R0) ; Deallocate our region CLR @RCBP ; Clear the RCB entry RETURN UnMap0: CALL DEALLO ; deallocate the region we created Pop @#KISAR1 ; restore mapping **IOPAGE** Pop @#KISDR1 ; **IOPAGE** Mov OldPS,@#PS ; restore psw **IOPAGE** InsNo0: Sec ; failed Return ...... .Dsabl LSB ORead: ORdChn: .Byte SysChn+.-. ; channel number .Byte .Read ; request subcode ORdBlk: .Word SPXBase/Blk+.-. ; block number .Word P1Addr ; buffer is Par1 area .Word SPX-SPXBase+1/2 ; word count .Word 0 ; wait mode P1EXTA: .WORD 0 ; Address of $P1EXT RCBP: .WORD 0 ; Pointer to our Region Control Block NoHMem: .NLCSI TYPE=I,PART=PREFIX .Ascii "F-Insufficient high memory" .Assume . LE Blk+InsBk0 .Even .EndC; NE MMg$t .SBTTL LODCOD - LOAD/FETCH code ;+ ; This code gets executed when the SP handler is fetched or loaded. ; It relocates the root $RELs, gets/stores the address of $SPSTA, ; and, if XM, gets/stores the P1NEW value in SP's root. ;- .ENABL LSB LODCOD: MOV @#$SYPTR,R4 ; Get address of monitor base. ADD #$SPSTA,R4 ; R4 -> Spooler status word. MOV @R5,R2 ; Get handler's load address ADD #,R2 ; physical address of SPCSR MOV R4,@R2 ; Save $SPSTA address for later. MOV @R5,R2 ; Get handler's load address ADD #,R2 ; physical address of SPBASE ; ------------------------ RELOCATE SP $RELs ----------------------- Jsr R0,40$ ; point to relocation list **PIC** ................... ; never returns, R0 pointed to table ; ---------------------------- SP List ----------------------------- SP.Did = 1 SP.Lst: .If NE SP.Cnt .Rept SP.Cnt .Irp x <\SP.Did> .Word SP.'x-SPBase .EndR SP.Did = SP.Did+1 .EndR .EndC ;NE SP.Cnt .Word 000000 ; end of list ; ----------------------- SP List Processing Loop ---------------------- 40$: 50$: ; Do SP's --- Mov (R0)+,R1 ; get next reloc list entry Beq 55$ ; done this list Add R2,R1 ; real address to locate Add R2,@R1 ; relocate value in address Br 50$ ; and do next .......... 55$: Pop R0 ; restore R0 from JSR R0, ... .If NE MMg$t ; Find RMON's table entry for the SPX region, get the PAR1 value, ; and store it in P1NEW (in the root). Mov @#$SYPTR,R3 ; point to RMON Mov $MEMPT(R3),R0 ; get offset to memory tables **GVAL** Add R3,R0 ; get real address Mov R3,R1 ; copy pointer Add CorPtX(R0),R1 ; get address of ALLOC **PEEK** 70$: Cmp #-1,(R1)+ ; look for end of free list Bne 70$ ; loop until found ; R1 now points to handler RCBs 80$: ; look for an empty one ;>>>??? Cmp #-1,@R1 ; end of list? ;>>>??? Beq InsNo0 ; yes, failure ;>>> What's to do? Cmp GR.Nam(R1),(PC)+ ; is it ours? .RModule ; our name Bne 90$ ; no, try next Cmp GR.Nam+2(R1),#<^r$ > ; second word right? Beq 100$ ; yes, then it is our name 90$: Add #GR.Esz,R1 ; point to next Br 80$ ; keep trying .......... 100$: MOV @R5,R2 ; Get handler's load address ADD #,R2 ; physical address of P1NEW Mov GR.Adr(R1),@R2 ; save the value for mapping PAR1 .EndC; NE MMg$t Return ; from LODCOD to monitor .DSABL LSB .SbTtl Align PSects on block boundaries ;***************************************************************************** .Psect SPDvr ; pad SPDvr up to block bound SPDvr ==: . ; display actual size .PSect SetOvr SetOvr =: . ; display actual size .If NE MMg$t PadIns =: 1*Blk ; first block boundary .IIf LT .+Blk- .Error .+Blk-; Decrease value; .IIf GT .- .Error .-; Increase value; .=:InsBk0+PadIns .EndC; NE MMg$t .PSect SPX ; pad SPX up to block boundary SPX =: . ; display actual size ;***************************************************************************** .IIf NE SP.Cnt-SP.Did+1 .Error SP.Cnt-SP.Did+1; auto relocation error; .IIf NE SPR.Cnt-SPR.Did+1 .Error SPR.Cnt-SPR.Did+1; auto relocation error; .END