Trailing-Edge
-
PDP-10 Archives
-
BB-T573C-DD_1986
-
10,7/twice.mac
There are 6 other files named twice.mac in the archive. Click here to see a list.
TITLE TWICE - DRIVER FOR USER MODE ONCE ONLY V5(45)
SUBTTL D BLACK/JSL/EVS/TW 26-Aug-85
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1979,1980,1982,1983,1986.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
VTWICE==5 ;VERSION NUMBER
VEDIT==45 ;EDIT NUMBER
VMINOR==0 ;MINOR VERSION NUMBER
VWHO==0 ;EDITED BY DEC
;SEARCH S AND F LIBRARIES
SEARCH F,S
SEARCH MACTEN,UUOSYM
$RELOC ; TWOSEG
JOBVER==137
$ABS
LOC JOBVER
BYTE (3)VWHO(9)VTWICE(6)VMINOR(18)VEDIT
$HIGH ; RELOC 400000
$LOW ; RELOC
SALL
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1986. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
;DECLARE EXTERNS SO CAN SEARCH MONITOR LIBRARY FILE IN LIBRARY SEARCH MODE
EXTERN ONCMOD,REFSTR,FILFND,FILIO,FILUUO
;MISC PARAMETERS
DSK==1 ;CHANNEL FOR DISK IO
LINSIZ==100 ;SIZE OF TTY LINE BUFFER
PDLEN==100 ;LENGTH OF PUSH DOWN LIST
MJOBN==:-^D64 ;MINUS MAX NUMBER OF JOBS (NOT REALLY NEEDED)
SPBACT==:11 ;LENGTH OF CORE FOR A SPOOLING BLOCK (NOT NEEDED)
PAVJSP==:0
PROTM::0
SCDSWP::0
BLKSPK==:3 ;SHIFT FOR BLOCKS PER K
MBKSPK==:-3 ;RIGHT SHIFT FOR BLOCKS PER K
PIOMOD==:0
DSKPIN==:0
DSKPIF==:0
PION==:0
PIOFF==:0
PIPROG==:0
INDPPN==:0
ICPFAC==:0
JOBMSK==:777
AUQ==:5
DAQ==:6
IFNDEF JIFSEC,<JIFSEC==:^D60>
JIFMIN==:JIFSEC*^D60
IFNDEF RETRYN,<RETRYN==^D360 ;NUMBER OF TIMES TO RETRY TO CREATE SCRATCH FILE>
IFNDEF BLKPUN,<BLKPUN==^D50 ;BLOCKS PER UNIT IN SCRATCH FILE>
;DUMMY INTERNS (700)
XP M.SWCT,1 ;NON-ZERO IF NOT IN HDW CONFIG FILE
XP M.XFFA,1 ;... DITTO
;THE FOLLOWING CODE IS HERE ONLY SO THAT ALL MODULES AGREE ON THE VALUE OF
; M.TLTL
IFNDEF M.TTDN,<M.TTDN==:0>
IFNDEF M.XTL,<M.XTL==:0>
XP M.TLTL,M.TLTL+M.TTDN ;REDEFINE FOR RSX-20F LINES
XP M.TLTL,M.TLTL+M.XTL ;REDEFINE FOR XTC LINES
IFN M.KS10,<
XP M.TLTL,M.TLTL+1 ;ADD ONE FOR KLINIK LINE
>
$HIGH ;RELOC ;GO TO HISEG
PJBSTS::POINT JWSIZ,JBTSTS,JWPOS ;JOB WAIT STATE (QUEUE) CODE
PKLNT2::POINT 36,[0],35
DEYISN::
DEYCPS::
DEYCPF::POINT 36,FOO,35
FOO: BLOCK 1
FSTTIM::BLOCK 1 ;NON-ZERO FOR CALL TO REDHOM
REVCCD::CORTAL::CNTPT3::NXDDB::FPDBT1::SCDMM::GIVMM::
ALLKON::HIGHXC::SWPINS::FLTST::CNTFIL::
DONE::THIS::PROT1::.PDACS::TTCCIS::SWPCHK::ERPTMX::
QQRUN1::SWPPIK::TT2CI2::DIAMTA::TYPSCD::TTCCOS::TT2CO1::MPOPJ::
CNFST2::FILMSG::.PDDIA::SWPHNG::.PDDFL::PDYFSP::%SIFDA::TRPSET::DEVSRG::
SENDSP::ESVIDX::DPXREG::FSXREG::PRTDDB::RPXREG::EPKIDX::SWPSCN::
MACTSL::ERPTBK::.IPCFD::.IPCFP::FHXREG::SCNCNT::FNDPDS::
PDVTIM::SETHNG::DECIN1::QMXTAB::QMLTAB::FDAJOB::SNDMDC::MDCJOB::
PIDTAB::RTZER1::PCRLF::MAXACS::.PDEPA::SQREQ::QADTAB::SCDCHK::
.CPDLK::INTODD::DIACSB::INTODS::CPUOFS::STORS7::UPMM::
.CPQUE::SETUF::.CPQPC::.CPQPS::JDAADR::STATES::
DOORBL::.CPAEF::BOOTCP::TKYCPU::INTRDD::INTRDS::PRVBIT::.CPQND::
DEVHNG::%SIOPR::DIEUNI::TTPOPJ::SWPAD::TRPSTU::DLYCOM::
NXTCH::GFWDUD::SEGPTR::CLKNEW::GFWDCD::ZERSWP::
.CPCPN::DIADSB::SPBMAX::CLKMIN::CHKCPI::LOKSPI::.CPSWP::ONCPUN::
SETCPN::K4SWAP::
ONCPUS::UNLSPT::UNLSPI::GGVMM::INTOUU::.CPSOF::.CPFBO::.CPFBI::
DEYPCL::T3POPJ::PSIDVB::.CPSK1::W2PLSH::STEUB::PSIJBI::GVFWDS::
.CPJOB::GTFWDU::GTFWDC::SSEUB::INTRUU::SLEEPF::DD%PHO::DD%ALT::
FNDSDL::JBTLIM::SDLUNI::ZRNGE::DIAGCS::DIANUI::TLPJOB::.PDSTM::M1POPJ::
RPXSTW::OUCHE::RH2ND::STONBF::CHKNB::CSDMP::DEYCPU::.PDOBI::
.CPTAP::.IPCSC::%SIMDA::JBTDAU::.CPSWD::RNXREG::.E0MP::
.PDOSL::FORCE::JBTUPM::IPCULK::ADVSWP::ADVBFI::ADVBFO::
CPUOK::PIERR::SEQTOP::GFWNZ2::GFWNZS::PCLCP0::DWNMC::MKADD::
INTLVL::UPMC::MCUSER::PCLDKY::CPFBIT::
JBTPRG::LOGTXT::
SGANAM::SGAMOD::.PDQSN::.PDLBS::%CNIPS::MONVFF::ONCMAP::RWRTCH::
ENQNDR::DMPFZR::REMMPA::STRMPA::XCHMPA::SCNOWN::NPJSTP::DETJCK::
RPXCFG::RPXALV::MT0DDB::PAGEIT::GETPHP::FNDIPC::IPCPAG::
.CPDRQ::.CPEPT::.CPNBI::.C0CDB::.CPCDB::.CPMAP::.CPSCC::.CPSCD::
ADRERR::DWNMM::MCFREE::MCWAIT::DPXALV::INTRDC::INTODC::
IFN M.RP20,<
RNXCCM==:CYLCM##
RNYDXN::RNVSMR::RNVNMR::RNXCSB::RNPUNB::
RNXRLD::RNXALV::RNXCFG::DX2COM::
>
IFN FTCIDSK,<
RAXINT::RAXCPY::RAXUNL::RAXPOS::MSCGBF::
RAXCFG::RAXERR::RAXCCM::MSCCOM::RAXECC::
RAXALV::RAXLTM::RAXWTF::RAXWTC::RAXWTS::
RAXKON::RAXWRT::RAXRDS::RAXSTP::RAXRDC::
RAXREG::RAXRED::RAXRCL::RAXSEC::RAXRDF::
MSCUON::APRCHK::.CPPCB::LOCSEC::CPUAPP::
RAXUPA::MOVEI T1,1
JRST CPOPJ1
>; END IFN FTCIDSK
QNDRCK==:CPOPJ1
BUFSSN==:CPOPJ1
UUOLVL::FRCCPY::
JRST CPOPJ1
SSLBLD::ASLBLD::SDLBLD::SPCS::WCHFIL::FJCONT::SW2LC::SRFRDA::SRFRAU::CHKCSH::
PAGIPQ::FNDIP0::FLSOPQ::REVFUL::PPDRHD::SAVR::
BLDSSL::BLDASL::BLDSDL::RNXMVR::RNXEDL::RNXSEC::DIESTR::.BTRP2::
SPCGDT::MSCCUS::SPRIPX::
POPJ P,
.CPBIT::1
.C0CPN::1
FPOPJ:: POP P,F
POPJ P,
$LOW ;RELOC ;GO BACK TO LOSEG
WPOPJ1::AOS -1(P)
WPOPJ:: POP P,W
POPJ P,
FFMD1:: 0
RELMD1::0
ONCCOM::0
.CPNPD::IOWD PDLEN,PDLIST
TKBUDB::CNFMTK::TKBKDB:: 0
TWICE: JFCL ;IN CASE OF CCL ENTRY
RESET
MOVE T1,.JBREL## ;CURRENT END OF CONTIGUOUS LOWSEG
AOS T1 ;POINT TO START OF FREE SPACE
MOVEM T1,.JBFF## ;FOR CORE ALLOCATION
SETOM OPTQIK## ;DONT ASK ABOUT OFF-LINE UNITS
MOVE P,.CPNPD ;SET UP STACK
SETZ T1, ;WRITE ENABLE HIGH SEGMENT
SETUWP T1,
JRST [OUTSTR [ASCIZ/? Cannot write enable high segment
/]
EXIT]
MOVE T1,[%CCTYP] ;FIND OUT WHAT WE'RE RUNNING ON
GETTAB T1,
JRST [OUTSTR [ASCIZ/? Cannot tell what kind of processor this is
/]
EXIT]
MOVEI T1,-.CCKLX(T1) ;KL WILL TURN OUT 0
MOVEM T1,KSFLAG ;OTHERS WILL BE NON-0
IFN FTXMON,<
JUMPN T1,NOSEC1 ;IF ON A KS, DON'T MAP SECTION 1
MOVE T1,[.PAGSC,,T2] ;UUO AC
MOVEI T2,1
MOVE T3,[PA.GMS!<0,,1>]
PAGE. T1, ;MAP SECTIONS 0 AND 1 TOGETHER
JRST [OUTSTR [ASCIZ /? CAN'T MAP SECTIONS 0 AND 1 TOGETHER/]
EXIT]
NOSEC1:>
IFN FTAUTC,<
PUSHJ P,SETDAT ;SET UP TWICE DATA BASE TO MATCH RUNNING MONITOR
>; END IFN FTAUTC
MOVE T1,.JBFF## ;FIRST FREE LOCATION
MOVEM T1,ONCEND
DATE T1, ;TODAY'S DATE
MOVEM T1,THSDAT
TIMER T1, ;TIME OF DAY
MOVEM T1,TIME
MOVE T1,[XWD 44,11]
GETTAB T1,
MOVEI T1,^D60
MOVEM T1,TICSEC
IMULI T1,^D60
MOVEM T1,TICMIN
MOVE T1,[%CNDTM]
GETTAB T1,
SETZ T1,
MOVEM T1,DATE
MOVE T1,[DOLBLK] ;SETUP .JBINT TO INTERCEPT DISK OFF LINE
MOVEM T1,.JBINT## ;ALSO INTERCEPT XJRSTs ON THE KS
MOVE T1,[PJRST USRDIO]
MOVEM T1,UUOPWQ## ;PATCH FILIO TO CALL OUR DISK I/O ROUTINE
SETOM .UONCE## ;NOTE USER MODE ONCE ONLY
MOVEI U,DIFUSY## ;PTR TO LIST OF UNITS IN OUR SYSTEM
MOVSI T1,UNPSAF## ;SINGLE ACCESS BIT TO CLEAR FOR EACH UNIT
JRST USTSCF ;CLEAR IMPORTANT FLAGS FOR EACH UNIT
USTSCL: SETZM UNISTS##(U) ;MAKE SURE STATUS WORD CLEAR
SETZM UNILOG##(U) ;MAKE SURE KEEP FLAG CLEAR TOO
ANDCAM T1,UNIDES##(U) ;AND CLEAR WRITABLE FLAG
MOVE T2,UNINAM##(U) ;NAME OF UNIT
MOVEM T2,CHRBUF ;STORE IN DSKCHR BUFFER
MOVE T2,[XWD .DCUID+1,CHRBUF] ;ARG PTR
DSKCHR T2, ;GET UNIT ID
TDZA T2,T2 ;NOT A DISK?
MOVE T2,CHRBUF+.DCUID ;UNIT ID
MOVEM T2,UNIHID##(U) ;PICK UP NOW SO CAN SPECIFY READ/WRITE UNITS
;WITH UNIT ID SO DONT NEED TO KNOW WHICH
;PHYSICAL UNIT THEY'RE MOUNTED ON
USTSCF: HLRZ U,UNISYS##(U) ;NEXT UNIT IN OUR SYSTEM
JUMPN U,USTSCL ;LOOP FOR ALL OUR UNITS
SETZM CURUNI
GETPPN T1, ;GET OUR PPN
JFCL ;IN CASE JACCT ON
MOVEM T1,OURPPN
SETZM DEBUGF ;MAKE SURE NOT IN DEBUG MODE
;HERE TO ASK IF SCRATCH FILE TO BE USED
SETOM FILFLG ;ASSUME SCRATCH FILE
MOVEI T1,[ASCIZ .
Scratch file? (Y or <CR>) .]
PUSHJ P,YESNO ;ASK AND YE SHALL RECEIVE
SETZM FILFLG ;DON'T USE SCRATCH FILE
;HERE TO FIND OUT WHICH UNITS TO USE
NOSCR: MOVEI T1,[ASCIZ .
Read units: .]
PUSHJ P,SVMOUT## ;ASK FOR UNITS TO READ
NXTRED: PUSHJ P,GETUNI## ;GET NEXT UNIT TO READ
JRST NOREAD ;NO MORE UNITS TO READ
JUMPE U,ALLRED ;JUMP IF ALL TYPED
PUSHJ P,KEEPRD ;JUST ONE, KEEP IT
JRST NXTRED ;LOOP FOR NEXT TYPED
ALLRED: MOVEI U,DIFUSY## ;ALL, PTR TO FIRST UNIT
SETOM OFFLOK## ;DON'T TYPE OFF-LINE UNITS
NXARED: HLRZ U,UNISYS##(U) ;NEXT UNIT IN OUR SYS
JUMPE U,LSTRED ;JUMP IF NO MORE
PUSHJ P,KEEPRD ;KEEP THIS UNIT
JRST NXARED ;LOOP FOR NEXT UNIT IN OUR SYSTEM
NOREAD:
LSTRED: MOVEI T1,[ASCIZ .
Write units: .]
PUSHJ P,SVMOUT## ;ASK FOR UNITS TO WRITE ON
NXTWRT: PUSHJ P,GETUNI## ;GET NEXT UNIT TO WRITE
JRST NOWRIT ;NO MORE
JUMPE U,ALLWRT ;JUMP IF ALL TYPED
PUSHJ P,KEEPWT ;KEEP THIS UNIT FOR WRITING
JRST NXTWRT ;LOOP FOR NEXT TYPED
ALLWRT: MOVEI U,DIFUSY## ;ALL, PTR TO FIRST UNIT
NXAWRT: HLRZ U,UNISYS##(U) ;GET NEXT UNIT IN SYSTEM
JUMPE U,LSTWRT ;JUMP IF NO MORE
PUSHJ P,KEEPWT ;KEEP THIS UNIT FOR WRITING
JRST NXAWRT ;LOOP FOR NEXT UNIT IN OUR SYSTEM
;HERE TO REMOVE UNWANTED UNITS FROM OUR LISTS
NOWRIT:
LSTWRT: PUSHJ P,SAVKON ;PATCH OUT SETKON SO STATUS OF OFF LINE
; AND DOWN UNITS IS PRESERVED
MOVEI U,DIFUSY## ;PTR TO FIRST UNIT IN OUR SYSTEM
NXTKEP: HLRZ U,UNISYS##(U) ;NEXT UNIT
JUMPE U,SHORTD ;JUMP IF NO MORE UNITS
SETZM UNIHID##(U) ;CLEAR UNIT ID (WILL GET FROM HOME BLOCK)
SKIPN UNILOG##(U) ;SKIP IF KEEPING THIS UNIT
PUSHJ P,FLGDW ;NO, FLAG IT AS DOWN
MOVSI T1,UNPSAF## ;GET SINGLE ACCESS BIT
MOVSI T2,UNPHWP## ;GET HARDWARE WRITE PROTECT BIT
TDNN T1,UNIDES##(U) ;IS UNIT WRITABLE?
IORM T2,UNIDES##(U) ;NO, MARK AS WRITE LOCKED
SETZM UNILOG##(U) ;CLEAR FLAG
JRST NXTKEP ;LOOP FOR ALL UNITS
;TYPING ESCAPE DURING ONCE WILL BRING YOU BACK HERE TO TRY AGAIN.
SHORTD::
SETZB P1,SHUTUP## ;CLEAR SHORT FLAG
MOVE T1,ONCEND ;GET FIRST FREE LOCATION FOLLOWING TWICE
ADDI T1,1 ;MAKE SYSSIZ START AFTER TWICE
MOVEM T1,SYSSIZ ;(TO MAKE SETDDO WORK PROPERLY)
SKIPGE DEBUGF
JRST QUICK
MOVEI T1,[ASCIZ/
Startup option: /]
PUSHJ P,ASKGET ;ASK QUESTION
JRST ONCHLP ;GIVE SOME HELP
PUSHJ P,CTEXT ;GET FIRST WORD
JUMPN T2,LNG1 ;JUMP IF WORD GIVEN
CAIN T3,"/" ;SEE IF /H
JRST LNGHLP ;YES--LONG HELP
JRST ONCHLP ;NO--SHORT HELP
LNG1: MOVE T1,[-OPTLEN,,OPTTAB]
PUSHJ P,FNDNAM ;LOOKUP NAME
JRST ONCHLP ;GIVE SOME HELP
XCT OPTXCT(T1) ;DO YOUR THING
JRST SHORTD
;DONE BY XCT ABOVE
OPTXCT: PUSHJ P,SHRTPM##
PUSHJ P,SHRTST##
JRST QUICK
PUSHJ P,FILOPT##
JRST PVQCK
PUSHJ P,SHRTRF##
PUSHJ P,SHRTID##
PVQCK::
SETOM OPTQIK##
JRST QUICK
;SHORT HELP
ONCHLP: MOVEI T1,[ASCIZ "
CHANGE,DESTROY,GO,LONG,QUICK,REFRESH,UNITID
/H for help
"]
JRST ONCHL1 ;TYPE THAT OUT
LNGMSG: ASCIZ "
CHANGE - Change disk parameters
DESTROY - Rebuild all disks. Deletes all files, sets all defaults.
GO - Start the system if all is OK.
LONG - Enters long dialogue
QUICK - Same as GO but do not ask about OFF-LINE devices.
REFRESH - Refresh selected structures
UNITID - Change unit ID's
"
LNGHLP: MOVEI T1,LNGMSG
ONCHL1: PUSHJ P,ICONM
PUSHJ P,OPOUT
JRST SHORTD
OPTTAB: SIXBIT /CHANGE/
SIXBIT /DESTRO/
SIXBIT /GO/
SIXBIT /LONG/
SIXBIT /QUICK/
SIXBIT /REFRES/
SIXBIT /UNITID/
OPTLEN==.-OPTTAB
;THE LONG DIALOGUE BEGINNETH HERE.....
LONGD: SETOM (P) ;SET "ALTMOD"-TYPED FLAG
PUSHJ P,FILOPT## ;GO THROUGH THE REFRESH DIALOGUE(S) [LEVEL C]
; TYPE STATE OF WHOLE DISK SYSTEM, THEN
; ACCEPT CHANGES TO UNITS AND STR'S & REFRESH [LEVEL D]
QUICK: PUSHJ P,RESKON ;RESTORE SETKON ROUTINE IN CASE TWICE
; IS RESTARTED
EXIT ;ALL DONE
;SUBROUTINE TO MARK UNIT DOWN WITHOUT REMOVING IT FROM LIST OF UNITS
; USED TO BE USED ONLY WHEN SCRATCH FILE IN USE SO UNITS ALWAYS IN SAME
; PLACE IN FILE, BUT SINCE HIGH AVAILABLITY (602), ALL UNITS REMAIN
; IN UNIT DATA BLOCK CHAIN, SO THIS ROUTINE USED ALL THE TIME.
FLGDW: MOVEI T1,UNVDWN## ;VALUE TO MARK UNIT DOWN
DPB T1,UNYUST## ;STORE IN UNIT STATE
MOVSI T1,UNPOFL## ;UNIT OFF LINE
IORM T1,UNIDES##(U) ;STORE
SETZB T1,UNILOG##(U) ;CLEAR UNILOG
DPB T1,UNYSIC## ;AND SATS IN CORE
SETOM UNISUN##(U) ;NOT IN ACTIVE SWAPPING LIST NOW
POPJ P,
;FNDNAM--ROUTINE TO SEARCH FOR ABBREV. NAME IN TABLE
;CALL MOVE T1,AOBJN POINTER TO LIST OF NAMES
; MOVE T2,SIXBIT ABBREVIATION
; PUSHJ P,FNDNAM
;NON-SKIP IF UNKNOWN (T1=0) OR DUPLICATE (T1 .NE. 0)
;SKIP RETURN IF FOUND WITH T1=INDEX IN TABLE
FNDNAM::PUSHJ P,SAVE3 ;SAVE P1,P2
SETZB P1,T4 ;CLEAR MATCH MASK AND POINTER
MOVSI P2,(77B5) ;START AT LEFT END
FNDNM1: TDNE T2,P2 ;SEE IF SPACE
IOR P1,P2 ;NO--IMPROVE MASK
LSH P2,-6 ;MOVE RIGHT ONE CHAR
JUMPN P2,FNDNM1 ;LOOP FOR SIX CHARS
SETOM P2 ;SET ABBREV COUNTER
MOVE P3,T1 ;SAVE POINTER
FNDNM2: MOVE T3,(T1) ;GET NEXT CANDIDATE
XOR T3,T2 ;COMPARE
JUMPE T3,FNDNMW ;WIN
AND T3,P1 ;MASK IT
JUMPN T3,FNDNM3 ;LOOSE
MOVE T4,T1 ;WIN--SAVE POINTER
AOS P2 ;COUNT SUCCESS
FNDNM3: AOBJN T1,FNDNM2 ;LOOP FOR ALL ENTRIES
MOVE T1,T4 ;RESTORE POSSIBLE WINNER
JUMPN P2,CPOPJ ;JUMP IF UNSUCCESSFUL
FNDNMW: SUB T1,P3 ;COMPUTE INDEX
TLZ T1,-1 ;REMOVE JUNK
JRST CPOPJ1 ;SKIP RETURN
;SUBROUTINE TO SEE IF SHOULD KEEP UNIT FOR READING OR WRITING
;FOR READING MUST BE 1,2 OR SINGLE ACCESS
;FOR WRITING MUST BE SINGLE ACCESS OR 1,2 AND NOT IN A FILE STRUCTURE
KEEPWT: SKIPE FILFLG ;SKIP UNLESS USING SCRATCH FILE
JRST KEEPW1 ;OK TO WRITE
MOVE T1,UNINAM##(U) ;NAME OF UNIT
MOVEM T1,CHRBUF ;STORE IN DSKCHR ARGUMENT BUFFER
MOVE T1,[XWD .DCSNM+1,CHRBUF]
DSKCHR T1, ;FIND OUT ABOUT UNIT
POPJ P, ;NOT A DISK?
TLNN T1,UNPSAF## ;SKIP IF SINGLE ACCESS - OK TO WRITE
SKIPN CHRBUF+.DCSNM ;NO, OK IF NOT IN AN STR
JRST KEEPW1 ;OK TO WRITE ON THIS UNIT
MOVEI T1,[ASCIZ .Can't write.]
PUSHJ P,UEMSG ;TELL USER CAN'T WRITE THAT UNIT
JRST KEEPRD ;BUT KEEP IF FOR READING IF POSSIBLE
KEEPW1: MOVSI T1,UNPSAF## ;OK TO WRITE, BORROW BIT AS WRITABLE FLAG
IORM T1,UNIDES##(U) ;SET WRITABLE FLAG IN OUR UNIT DATA BLOCK
KEEPRD: MOVE T1,(U) ;PHYSICAL UNIT NAME
CALLI T1,64 ;(DEVNAM UUO) IS IT A REAL UNIT?
POPJ P, ;NO, MUST BE 2ND PORT OF DUAL-PORTED DRIVE
SETOM UNILOG##(U) ;SET FLAG TO KEEP UNIT
MOVE T1,OURPPN ;GET OUR PPN
SKIPN FILFLG ;SKIP IF SCRATCH FILE - OK TO READ
CAMN T1,FFAPPN## ;OK IF WE HAVE PRIVILEGES
POPJ P, ;USER HAS PRIVILEGES TO ACCESS UNIT
MOVE T2,UNINAM##(U) ;GET NAME OF UNIT
MOVEI T1,T2 ;PTR TO DSKCHR ARGS
DSKCHR T1, ;GET CHARACTERISTICS
POPJ P, ;NOT A DISK?
TLNE T1,UNPSAF## ;SKIP IF NOT SINGLE ACCESS - CANT READ
POPJ P, ;OK, SINGLE ACCESS MEANS USER CAN READ THIS UNIT
MOVEI T1,[ASCIZ .Can't read.]
;FALL INTO UEMSG TO TELL USER CAN'T READ THAT UNIT
UEMSG: PUSH P,T1 ;SAVE TEXT POINTER
PUSHJ P,SVOSET## ;SET UP TO TYPE
POP P,T1 ;RESTORE TEXT POINTER
PUSHJ P,SCONMS## ;TYPE MESSAGE
MOVEI T3," " ;NEED A SPACE AFTER THE MESSAGE
PUSHJ P,ONCTYO ;...
PUSHJ P,SPUNAM## ;TYPE UNIT NAME
PJRST SCRLFO## ;TYPE CRLF, OUTPUT MESSAGE, AND RETURN
SUBTTL SET UP TWICE DATA BASE
;THIS ROUTINE BUILDS THE DATA STRUCTURES NEEDED BY THE ONCE CODE BASED
;ON THE CONFIGURATION OF THE RUNNING MONITOR. THIS CODE DEPENDS ON
;TWICE BEING ASSEMBLED WITH THE SUPPLIED CONFIGURATION FILE AND ALSO
;ON FTAUTC BEING TRUE.
IFN FTAUTC,<
SETDAT: HRRZS SYSKON## ;ZERO LINK TO FIRST KONTROLLER IN SYSTEM
HRRZS SYSUNI## ;ZERO LINK TO FIRST UNIT IN SYSTEM
SETZ P2, ;START WITH FIRST UNIT
SETDT1: SYSPHY P2, ;ASK FOR NEXT PHYSICAL UNIT
SETZ P2, ;ASSUME DONE IF ERROR
JUMPE P2,CPOPJ ;RETURN IF WE'VE HIT THE END
MOVEM P2,CHRBUF ;SAVE THE UNIT NAME
MOVE T1,[.DCMAX,,CHRBUF] ;POINT AT THE UNIT NAME
DSKCHR T1, ;ASK MONITOR ABOUT IT
JRST SETDT1 ;DUH?
MOVEM T1,CHRBTS ;SAVE CHARACTERISTICS BITS FOR LATER
PUSHJ P,BLDUDB ;BUILD A UDB (AND CHN/KDB) FOR THIS UNIT
JRST SETDT1 ;LOOP FOR OTHER UNITS
> ;END IFN FTAUTC
;ROUTINE TO BUILD A UDB (AND A CHN/KDB IF NEEDED) FOR A UNIT.
;CALL:
; P2/ SIXBIT UNIT NAME
; PUSHJ P,BLDUDB
;RETURN:
; CPOPJ ALWAYS
BLDUDB: HLLZ T1,P2 ;GET SIXBIT KONTROLLER NAME
PUSHJ P,FNDKDB ;FIND THE KONTROLLER DATA BLOCK
SKIPA ;NONE, MUST BUILD ONE
JRST BLDUD1 ;FOUND IT, GO BUILD UDB
PUSHJ P,BLDKDB ;BUILD THE KONTROLLER DATA BLOCK AND CHANNEL
; DATA BLOCK
POPJ P, ;CAN'T, CAN'T USE THIS UNIT
BLDUD1: MOVEI T2,RPULEN## ;GET LENGTH OF A UDB (ALL THE SAME LENGTH)
PUSHJ P,GETCOR ;GET THE CORE
POPJ P, ;CAN'T
MOVE U,T1 ;SAVE UDB ADDRESS
MOVEM P2,(U) ;SAVE UNIT NAME
LDB T4,[POINTR CHRBTS,DC.UNN] ;GET PHYSICAL UNIT NUMBER
DPB T4,UNYPUN## ;SAVE IN UDB
ADD T4,KONTBP##(J) ;POINT AT RIGHT KONTAB SLOT
MOVEM U,(T4) ;POINT KDB AT THIS UDB
HRRZ T1,J ;GO SEARCH FOR FIRST AND LAST UDBS IN SYSTEM
PUSHJ P,FSTLST ; ON THIS KDB
MOVEM J,UNIKON##(U) ;SET UP RH(UNIKON)
HRLM U,UNIKON##(T4) ;POINT PREVIOUS LAST AT THIS UDB
SKIPE T1 ;IF ANY UNITS ON THE KDB
HRRM T4,LASUNI## ;LINK UNISYS AT END OF CURRENT KDB'S UNITS
HLLM T4,UNIKON##(U) ;POINT THIS UDB AT FIRST
HRRO T1,P1 ;SEARCH FOR FIRST AND LAST UDBS IN SYSTEM
PUSHJ P,FSTLST ; ON THIS CHN
MOVEM P1,UNICHN##(U) ;SET UP RH(UNICHN)
HRLM U,UNICHN##(T4) ;POINT PREVIOUS LAST AT THIS UDB
HLLM T4,UNICHN##(U) ;POINT THIS UDB AT LAST
SKIPE T1,LASUNI## ;GET FORMER LAST UNIT
SKIPE UNI2ND##(T1) ;(2ND PORT ISN'T ON CHAIN)
MOVEI T1,SYSUNI##-UNISYS## ;GET OFFSET
MOVE T2,UNISYS##(T1) ;GET ITS LINK
HRLM U,UNISYS##(T1) ;POINT AT US
HLLM T2,UNISYS##(U) ;LINK US TO FORMER NEXT
MOVEM U,LASUNI## ;SAVE LAST UDB CREATED
MOVSI T1,777 ;SET UP RANDOM UDB LOCS
MOVEM T1,UNICCT##(U) ;...
MOVE T1,[LBNHOM##,,LB2HOM##] ;...
MOVEM T1,UNIHOM##(U) ;...
SETOM UNICYL##(U) ;...
HRRZ T1,CHRBTS ;GET THE DSKCHR UUO BITS
MOVEM T1,UNIDES##(U) ;SET UP AS RH OF UNIDES
SETOM UNIAJB##(U) ;...
POPJ P, ;RETURN
;ROUTINE TO FIND A KDB GIVEN A KONTROLLER NAME.
;CALL:
; T1/ SIXBIT NAME
; PUSHJ P,FNDKDB
;RETURN:
; CPOPJ IF NO MATCH
; CPOJ1 IF FOUND WITH:
; J/ KDB ADDRESS
; P1/ CHN ADDRESS
FNDKDB: MOVEI J,SYSKON##-KONNXT## ;GET DIFFERENCE
FNDKD1: HLRZ J,KONNXT##(J) ;GET NEXT KDB ADDRESS
JUMPE J,CPOPJ ;RETURN IF NO MORE (DIDN'T MATCH)
CAME T1,-1(J) ;DOES NAME MATCH VALUE WE STUFFED IN KDB?
JRST FNDKD1 ;NO, KEEP LOOKING
HRRZ P1,KONCHN##(J) ;YES, LOAD UP CHN ADDRESS
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO CREATE A KDB AND CHN.
;CALL:
; T1/ SIXBIT NAME
; PUSHJ P,BLDKDB
;RETURN:
; CPOPJ IF COULDN'T BUILD
; CPOPJ1 IF BUILT WITH:
; J/ KDB ADDRESS
; P1/ CHN ADDRESS
BLDKDB: PUSHJ P,BLDCHN ;BUILD THE CHANNEL DATA BLOCK
POPJ P, ;NO CORE
LDB T1,[POINTR CHRBTS,DC.UNT] ;GET UNIT TYPE
LDB T2,[POINTR CHRBTS,DC.CNT] ;GET KONTROLLER TYPE
HRL T1,T2 ;COMBINE
MOVSI P4,-TYPTBL ;-VE LENGTH OF TYPE TABLE
CAME T1,TYPTAB(P4) ;LOOK FOR A MATCH
AOBJN P4,.-1 ;KEEP LOOKING
JUMPGE P4,CPOPJ ;RETURN IF NO MATCH
HLRZ T2,KDBTAB(P4) ;GET LENGTH OF KDB
PUSHJ P,GETCOR ;GET THE SPACE
POPJ P, ;NOT AVAILABLE
MOVE J,T1 ;COPY KDB ADDRESS
HRL T1,KDBTAB(P4) ;GET PROTOTYPE ADDRESS
BLT T1,-1(T2) ;COPY THE PROTOTYPE
ADDI J,-KONINT## ;SKIP THE INTERRUPT INSTRUCTIONS
HLLZM P2,-1(J) ;SAVE KONTROLLER NAME IN KDB
MOVEI T1,SYSKON##-KONNXT## ;GET DIFFERENCE
BLDKD1: HLRZ T2,KONNXT##(T1) ;LINK THIS KDB ON END OF SYSKON CHAIN
JUMPE T2,BLDKD2 ;
MOVE T1,T2 ;COPY ADDRESS
JRST BLDKD1 ;LOOK FOR END
BLDKD2: HRLM J,KONNXT##(T1) ;SET THE LINK
HRRM P1,KONCHN##(J) ;POINT KDB AT CHN
HRRZ T1,J ;GET KDB ADDRESS
ADDB T1,KONTBP##(J) ;INCLUDE KDB ADDRESS IN KONTBP
HRRM T1,KONPTR##(J) ;SET UP KONPTR
JRST CPOPJ1 ;ALL DONE
;ROUTINE TO BUILD A CHANNEL DATA BLOCK.
;CALL:
; PUSHJ P,BLDCHN
;RETURN:
; CPOPJ IF NO MEMORY AVAILABLE
; CPOPJ1 IF SUCCESS WITH:
; P1/ CHN ADDRESS
BLDCHN: MOVEI T2,LENCCB## ;LENGTH OF A CHANNEL DATA BLOCK
PUSHJ P,GETCOR ;GET THE SPACE
POPJ P, ;NONE AVAILABLE. CAN'T DO ANYTHING
MOVE P1,T1 ;P1 = CHAN ADDRESS
MOVEI T1,SYSCHN-.CHSYS##
CDB1: SKIPN T2,.CHSYS##(T1) ;LINK THIS CDB ONTO THE SYSCHN CHAIN (AT END)
JRST CDB2
HLRZ T1,T2
JRST CDB1
CDB2: HRLM P1,.CHSYS##(T1) ;SAVE CHAN ADDR
SETOM CHNBSY##(P1) ;INDICATE IDLE
AOS T1,CNFCHN ;ONE MORE CHANNEL
SUBI T1,1 ;MAKE ZERO-BASED
DPB T1,CHYSCN## ;STORE IN CHN
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO FIND FIRST AND LAST UDBS OF A CERTAIN TYPE IN SYSTEM
;CALL T1=0,,KDB OR T1=-1,,CDB
;RETURNS T4=1ST,,LAST (COULD BE THE SAME. IF NONE YET RETURNS T4=UDB,,UDB)
;RETURNS T1=0 IF FIRST SUCH UDB
FSTLST: PUSHJ P,SAVE1
MOVE P1,T1 ;SAVE ARGUMENT
PUSHJ P,FSTMAT ;FIND A MATCH
JRST FSTLS2 ;FOUND IT
FSTLS1: MOVE T4,U ;NO MATCH. 1ST=LAST=US
HRL T4,U
POPJ P,
FSTLS2: HRL T4,T3 ;SAVE 1ST FOUND IN LH(T4)
FSTLS3: HRR T4,T3 ;SAVE THIS AS LAST
PUSHJ P,FSTMA3 ;NEXT UDB A MATCH?
JRST FSTLS3 ;YES, SAVE UDB ADDR
POPJ P, ;NO MORE MATCHES. DONE
;ROUTINE TO SEE IF WE HAVE A MATCH
;RETURNS CPOPJ IF YES, CPOPJ1 IF NO
FSTMAT: HLRZ T1,SYSKON## ;START AT FIRST KDB IN SYSTEM
FSTMA1: MOVE F,T1 ;SAVE LOC OF KDB
MOVE T1,KONTBP##(T1) ;AOBJN POINTER TO UNITS ON KDB
FSTMA2: SKIPN T3,(T1) ;UDB THERE?
FSTMA3: AOBJN T1,.-1 ;NO, TRY NEXT
JUMPE T3,FSTMA4 ;FIND A UDB? NOT IF 0
JUMPL P1,[HRRZ T2,UNICHN##(T3)
JRST .+2] ;LOOKING FOR UNICHN IF NEGATIVE
HRRZ T2,UNIKON##(T3) ;POSITIVE - LOOKING FOR UNIKON
CAIN T2,(P1) ;MATCH?
POPJ P, ;YES, RETURN
JUMPN T2,FSTMA4 ;NO. FOUND THIS UNIT?
AOBJN T1,FSTMA2 ;YES. KEEP GOING IF NOT UNIT 7
FSTMA4: HLRZ T1,KONNXT##(F) ;STEP TO NEXT KDB
JUMPN T1,FSTMA1 ;LOOK FOR UNIT MATCH IF IT EXISTS
JRST CPOPJ1 ;NO MATCH. SKIP
;ROUTINE TO OBTAIN CORE FOR A CHN/KDB/UDB.
;CALL:
; T2/ NUMBER OF WORDS DESIRED
; PUSHJ P,GETCOR
;RETURN:
; CPOPJ IF NOT AVAILABLE
; CPOPJ1 WITH:
; T1/ ADDRESS OF CORE OBTAINED
GETCOR: MOVE T1,.JBFF## ;GET CURRENT FIRST FREE
ADDB T2,.JBFF## ;ADVANCE ALLOCATION
SUBI T2,1 ;BACK OFF BY ONE
CAMGE T2,.JBREL## ;NEED TO EXPAND?
JRST CPOPJ1 ;NO, RETURN
CORE T2, ;ASK FOR IT
POPJ P, ;ERROR
MOVE T2,.JBFF## ;GET NEW END ADDRESS
JRST CPOPJ1 ;SUCCESS
;TABLE OF KONTROLLER,,UNIT TYPES RETURNED BY DSKCHR UUO.
;USED AS AN INDEX INTO KDBTAB.
TYPTAB::XWD .DCCRP, .DCUR4 ;RP04
XWD .DCCRP, .DCUR6 ;RP06
XWD .DCCRP, .DCUR3 ;RM03
XWD .DCCRP, .DCUR7 ;RP07
XWD .DCCRN, .DCUN0 ;RP20
IFN FTCIDSK,<
XWD .DCCRA, .DCU80 ;RA80
XWD .DCCRA, .DCU81 ;RA81
XWD .DCCRA, .DCU60 ;RA60
>; END IFN FTCIDSK
;TABLE OF PROTOTYPE KDB LENGTH,,ADDRESS INDEXED BY TYPTAB INDEX.
KDBTAB: RPKLEN##,, RPXKDB## ;RP04
RPKLEN##,, RPXKDB## ;RP06
RPKLEN##,, RPXKDB## ;RM03
RPKLEN##,, RPXKDB## ;RP07
RNKLEN##,, RNXKDB## ;RP20
IFN FTCIDSK,<
RAKLEN##,, RAXKDB## ;RA80
RAKLEN##,, RAXKDB## ;RA81
RAKLEN##,, RAXKDB## ;RA60
>; END IFN FTCIDSK
TYPTBL==.-TYPTAB ;LENGTH OF TABLE
SUBTTL TTY INPUT SUBROUTINES
YESNO:: PUSHJ P,ASKGET ;ASK QUESTION, GET ANSWER
POPJ P,0 ;JUST C-R
PUSHJ P,ONCTYI ;GET NEXT CHAR
TRZ T3,40 ;FIRST CHAR OF RESPONSE (U.C.)
CAIN T3,"Y" ;WAS IT A Y ?
AOS 0(P) ;YES. SKIP
POPJ P, ;NO, MAYBE IT WAS "N". SO DON'T SKIP
ASKGET: PUSHJ P,ICONM ;OUTPUT THE QUESTION
PUSHJ P,OPOUT
PJRST GETLIN ;GET ANSWER
;SUBROUTINE TO READ A LINE
; CALL: PUSHJ P,GETLIN
; JUST A CR TYPED IN
; NORMAL RETURN (NOT A BLANK LINE)
GETLIN::MOVE T1,LINEP ;BYTE POINTER TO LINE
MOVEM T1,ONCTIP
SETZ J,
GET1: INCHWL T3 ;READ NEXT CHAR
CAIN T3,177 ;SKIP IF NOT RUBOUT
JRST GET1 ;IGNORE RUBOUTS
CAIE T3,33 ;SKIP IF ALTMODE
CAIL T3,175 ;SKIP IF NOT ALTMODE
JRST GETLN1 ;JUMP IF ALTMODE
CAIL T3,140 ;SKIP IF NOT LOWER CASE
TRZ T3,40 ;CONVERT TO UPPER CASE
IDPB T3,T1 ;STORE IN LINE BUFFER
CAIE T3,15 ;SKIP IF CARRIAGE RETURN
AOJA J,GET1 ;NO, COUNT CHARS
INCHWL T3 ;READ LINE FEED FOLLOWING
GET2: IDPB T3,T1 ;STORE LINE FEED
SETZ T3, ;NULL FOR END OF LINE
IDPB T3,T1 ;STORE THE NULL
JUMPN J,CPOPJ1 ;JUMP IF NON-BLANK LINE
POPJ P, ;NO, EMPTY LINE
GETLN1: HRROS J ;NOTE PRESENCE OF ALTMODE
MOVEI T3,15 ;STORE CRLF
IDPB T3,T1 ;STORE CR
MOVEI T3,12 ;LF
JRST GET2 ;STORE THAT AND EXIT
; SUBROUTINE TO INPUT A [P,PN]
PPNERR: MOVEI T1,[ASCIZ \Bad [P,PN] typed try again: \]
GTPPN:: PUSHJ P,ASKGET ;ASK QUESTION, GET ANSWER
POPJ P,
PUSHJ P,ALTM## ;DID HE TYPE ESC
PUSHJ P,SKIPS ;EAT LEADING SPACES
JRST PPNERR ;ERROR
CAIE T3,"[" ;BEGINNING OF PPN
JRST PPNERR ;NO, TRY AGAIN
PUSHJ P,GETOCT ;GET THE FIRST OCTAL NUMBER
JUMPE T2,PPNERR ;NULL PROJECT NUMBER IS BAD
TLNN T2,777777 ;TOO BIG?
CAIE T3,"," ;OR A BAD P,PN SEPARATER
JRST PPNERR ;YEP
PUSH P,T2 ;SAVE IT
PUSHJ P,GETOCT ;GET THE PROGRAMMER NUMBER
POP P,T1 ;GET PROJECT NUMBER BACK
JUMPE T2,PPNERR ;NULL PROGRAMMER NUMBER IS BAD
CAIE T3,"]" ;CHECK FOR LEGAL TERMINATER
CAIN T3,0 ;CRLF IS OK TOO
TLNE T2,777777 ;TOO BIG?
JRST PPNERR ;YEP
HRL T1,T2 ;GET PROGRAMMER NUMBER
MOVSS T1 ;SET IT UP AS [PROJ,PROG]
AOS (P) ;GIVE A SKIP
POPJ P, ;AND RETURN
GETOCT: MOVEI T2,777777 ;ASSUME WILD
PUSHJ P,COMTYS ;GET FIRST CHARACTER
CAIE T3,"*" ;WILD?
TDZA T2,T2 ;NO - CLEAR RESULT
GETOC1: PUSHJ P,COMTYS ;NEXT CHAR
CAIL T3,"0" ;IN RANGE?
CAILE T3,"7"
POPJ P,
LSH T2,3 ;CLEAR NULL DIGIT
SUBI T3,"0" ;CONVERT TO BINARY
ADDI T2,(T3) ;ADD TO TOTAL
JRST GETOC1 ;LOOP UNTIL DONE
;ROUTINE TO INPUT DISK SET NUMBER(S)
IFN FTSETS,<
GETSE0: MOVEI T1,[ASCIZ |Bad response, try again
|]
GETSET::PUSHJ P,ASKGET ;ASK QUESTION, GET RESPONSE
POPJ P, ;<CR> TYPED
PUSHJ P,ALTM## ;ALLOW ALTMODE COP-OUT
MOVE P1,ONCTIP ;GET CURRENT BYTE POINTER
PUSHJ P,DECIN ;TRY TO READ A NUMBER
JRST GETSE1 ;BAD RESPONSE, MAYBE "ALL"
JRST GETSE1 ;DITTO
CAIL T2,^D1 ;IN LEGAL RANGE?
CAILE T2,^D36 ;...
JRST GETSE0 ;NO, COMPLAIN AND ASK AGAIN
MOVE T1,T2 ;GET RESPONSE IN T1
JRST CPOPJ1 ;SKIP RETURN
GETSE1: MOVEM P1,ONCTIP ;RESTORE PREVIOUS BYTE POINTER
PUSHJ P,CTEXT ;GET RESPONSE
MOVSS T2 ;SWAP HALVES
CAIE T2,'ALL' ;VALID RESPONSE?
JRST GETSE0 ;NO, COMPLAIN AND ASK AGAIN
SETZ T1, ;GET A ZERO
JRST CPOPJ1 ;SKIP RETURN
>; END IFN FTSETS
;ROUTINE TO RETURN NEXT ALPHANUMERIC STRING
; IN COMMAND LINE (SIXBIT)
;CALL: PUSHJ P, CTEXT
; SIXBIT STRING RETURN LEFT JUSTIFIED IN AC T2
CTEXT:: PUSHJ P,SKIPS ;CALL HERE IF AT START OF LINE
POPJ P, ;NOTHING THERE.
CTEXT1::PUSHJ P,SKIPS1 ;SKIP LEAD SPACES,TABS,NULLS AND CLEAR T2
POPJ P, ;NOTHING THERE.
SKIPA W,[POINT 6,T2]
CTEX0: PUSHJ P,COMTYS ;ROUTINE IN SCNSER TO PICK UP CHAR.
CTEX1: PUSHJ P, CTEX ;IS IT ALPHANUMERIC
POPJ P,0 ;NO
TRC T3,40 ;CONVERT TO SIXBIT
TLNE W,770000 ;SIX CHARS YET?
IDPB T3,W ;NO. BUILD WORD
JRST CTEX0 ;LOOP FOR MORE
;SCAN FOR ALPHANUMERIC CHAR IN T3
CTEX: CAILE T3,"Z"+40 ;GREATER THAN LC Z?
POPJ P,0 ;YES. NOT SIXBIT.
CAIL T3,"A"+40 ;LOWER CASE LETTER?
TRZ T3,40 ;YES. MAKE UPPER CASE.
CAIL T3, "0"
CAILE T3, "Z" ;LETTERS ARE LARGER THAN NOS.
POPJ P,0 ;NEITHER
CAILE T3, "9"
CAIL T3, "A"
JRST CPOPJ1 ;LETTER OR NUMBER RETURN
POPJ P,0 ;NOT-LETTER/NUMBER RETURN
CTXDEV::PUSHJ P,CTEXT1 ;GET A WORD
CAIN T3,":" ;AND IF TERM IS A COLON,
PUSHJ P,COMTYS ;DISCARD IT
POPJ P,0 ;RETURN FROM CTXDEV
;SUBROUTINE TO READ A DECIMAL NUMBER
;VALUES T2=DECIMAL NUMBER
DECIN:: PUSHJ P,SKIPS ;SKIP TO FIRST NON-BLANK CHAR
POPJ P,
MOVEI P4,12 ;DECIMAL RADIX
JRST ANYRIN
;SUBROUTINE TO READ AN OCTAL NUMBER
;VALUES T2=OCTAL NUMBER
OCTIN:: PUSHJ P,SKIPS
POPJ P,
PUSHJ P,ANYR1
POPJ P,
JRST .+2
POPJ P,
MOVEI P4,10
ANYRIN: PUSHJ P,SKIPS1
POPJ P,
OCT0: CAIL T3,"0" ;SKIP IF NOT A LEGAL DIGIT
CAIL T3,"0"(P4) ;SKIP IF LEGAL DIGIT
JRST ANYR1
IMUL T2,P4 ;BUILD NUMBER
ADDI T2,-"0"(T3)
PUSHJ P,ONCTYI ;READ NEXT CHAR
JRST OCT0 ;AND LOOP TILL ILLEGAL CHAR
ANYR1: CAILE T3,40 ;SKIP IF BREAK CHAR
CAIN T3,","
JRST CPOPJ2
CAIE T3,"["
CAIN T3,"]"
JRST CPOPJ2
CAIN T3,"-"
JRST CPOPJ2
JRST CPOPJ1
;SUBROUTINE TO GET THE NEXT NON-BLANK CHAR
;CALL: PUSHJ P,SKIPS
; NON-SKIP RETURN IF BREAK CHAR
; SKIP RETURN IF NOT BREAK CHAR
SKIPS:: PUSHJ P,ONCTYI ;GET NEXT CHAR
SKIPS1::SETZ T2,
MOVE T3,TTCMCH ;GET THIS CHAR
CAIE T3," " ;SKIP IF A TAB
CAIN T3," " ;NO SKIP IF SPACE
JRST SKIPS ;SKIP THIS CHAR
CAIL T3,40 ;SKIP IF A BREAK CHAR
CPOPJ1::AOS (P) ;SKIP RETURN IF NOT A BREAK CHAR
CPOPJ:: POPJ P,
CPOPJ2::AOS (P)
JRST CPOPJ1
CAMCPU::SETZ T4,
POPJ P,
;SUBROUTINE TO GET NEXT CHAR BUT CONVERT ; TO LF
;VALUES T3=NEXT CHAR
COMTYS: PUSHJ P,ONCTYI
CAIN T3,";" ;SKIP IF NOT ;
MOVEI T3,12
MOVEM T3,TTCMCH
POPJ P,
;SUBROUTINE TO GET NEXT CHAR FROM TTY LINE BUFFER
;VALUES T3=ASCII CHAR
COMTYI::! ;MAKE ONCE/TWICE WORK THE SAME FOR CHARACTER I/O
ONCTYI: ILDB T3,ONCTIP
MOVEM T3,TTCMCH ;SAVE CHAR FOR LATER
POPJ P,
TPOPJ1::AOS -1(P)
TPOPJ:: POP P,T1
POPJ P,
UPOPJ1::AOS -1(P) ;GIVE SKIP RETURN
LPOPJ::
UPOPJ:: POP P,U ;RESTORE U
POPJ P, ;RETURN
T2POPJ::POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
JPOPJ1::AOS -1(P)
JPOPJ:: POP P,J
POPJ P,
SUBTTL TTY OUTPUT ROUTINES
;SUBROUTINE TO OUTPUT CARRIAGE RETURN LINE FEED
CRLF:: MOVEI T1,[ASCIZ /
/]
PJRST CONMES ;OUTPUT CARRIAGE RETURN LINE FEED
;SUBROUTINE TO INITIALIZE OUTPUT BUFFER AND TYPE AN ASCII LINE
;ARGS T1=ADDR OF ASCII LINE
ICONM:: PUSHJ P,OTSET ;INITIALIZE BUFFER
;SUBROUTINE TO TYPE AN ASCII LINE
;ARGS T1=ADDR OF ASCII LINE
CONMES::HRLI T1,(POINT 7,) ;MAKE T1 A BYTE POINTER
CON0: ILDB T3,T1 ;NEXT CHAR
JUMPE T3,CPOPJ ;EXIT AT NULL
PUSHJ P,ONCTYO ;TYPE CHAR
JRST CON0 ;LOOP TILL NULL
;SUBROUTINE TO INITIALIZE OUTPUT BUFFER
OTSET:: MOVEI T3,ONCTSZ ;SIZE OF BUFFER
MOVEM T3,ONCCNT ;SO CANT OVERFLOW
MOVE T3,LINEP ;BYTE POINTER
MOVEM T3,ONCTOP
POPJ P,
;SUBROUTINE TO ACTUALLY OUTPUT THE OUTPUT BUFFER
OPOUT:: SKPINL ;CLEAR CONTROL O FLAG
JFCL ;DONT CARE ABOUT INPUT
OPOUTX: MOVEI T3,0
IDPB T3,ONCTOP ;MAKE SURE NULL AT END
OUTSTR LINBUF ;OUTPUT BUFFER
POPJ P,
;SUBROUTINE TO TYPE SIXBIT STRING IN T2
;ARGS T2=SIXBIT STRING
PRNAME::SETZ T1,
LSHC T1,6 ;T1=NEXT CHAR
JUMPE T1,CPOPJ ;EXIT AT END OF STRING
MOVEI T3," "-' '(T1) ;CONVERT TO ASCII
PUSHJ P,ONCTYO ;STORE IN BUFFER
JRST PRNAME ;LOOP
;SUBROUTINE TO TYPE A DECIMAL OR OCTAL NUMBER
;ARGS T1=NUMBER TO TYPE
RADX10::SKIPA T3,[12]
PRTDI8::MOVEI T3,10
PRTRDX: IDIV T1,T3
HRLM T2,(P)
JUMPE T1,.+2
PUSHJ P,PRTRDX
HLRZ T1,(P)
MOVEI T3,"0"(T1)
PJRST ONCTYO
;SUBROUTINE TO TYPE A QUESTION MARK
PRQM:: MOVEI T3,"?"
PJRST ONCTYO ;TYPE QUESTION MARK
;SUBROUTINE TO STORE A CHAR IN TTY OUTPUT BUFFER
;ARGS T3=CHAR
COMTYO::
ONCTYO: SOSLE ONCCNT ;SKIP IF BUFFER FULL
IDPB T3,ONCTOP ;STORE CHAR IN BUFFER
POPJ P,
SUBTTL DISK I/O ROUTINES
;SUBROUTINE TO HANDLE USER MODE DISK I/O
;ARGS F=ADDR OF DDB
; S=STATUS BITS (IO=0 FOR READ, =1 FOR WRITE)
;VALUES S=STATUS FROM GETSTS
USRDIO::SKIPN FILFLG ;SKIP IF USING SCRATCH FILE
JRST USRDI1 ;NO, REGULAR WAY
SKIPG FILFLG ;SKIP IF FILE OPEN
PUSHJ P,OPNFIL ;NO, OPEN IT
PUSHJ P,FNDUNI ;FIND 1ST BLOCK FOR THIS UNIT
STOPCD .,HALT,NM1, ;NO SUCH UNIT?
IMULI T1,BLKPUN ;TIMES BLOCKS=BEGINNING OF THIS UNIT
MOVE T2,DEVBLK##(F) ;BLOCK ON UNIT
CAILE T2,BLKPUN-1 ;SKIP IF IN RANGE
MOVEI T2,BLKPUN-1 ;DONT OVERFLOW TO FOLLOWING UNITS
ADD T1,T2 ;ADD IN BLOCK ON UNIT, = BLOCK FOR IO
SETZ T2, ;CLEAR END OF IOWD LIST
TLNE S,IO ;SKIP IF READ, NOT IF WRITE
JRST USRDI0 ;DO WRITE
USETI DSK,1(T1) ;FIRST BLOCK OF FILE IS BLOCK 1, NOT 0
MOVE T1,DEVDMP##(F) ;GET IOWD
INPUT DSK,T1 ;READ BLOCK
JRST USRDFN ;FINISH UP
USRDI0: USETO DSK,1(T1) ;1ST BLOCK OF FILE IS BLOCK 1, NOT 0
MOVE T1,DEVDMP##(F) ;GET IOWD
OUTPUT DSK,T1 ;WRITE BLOCK
JRST USRDFN ;FINISH UP
USRDI1: CAME U,CURUNI ;SKIP IF UNIT OPEN
PUSHJ P,OPNUNI ;NO, OPEN UNIT
SKIPA T1,DEVDMP##(F) ;GET IOWD
POPJ P, ;CANT WRITE UNIT
TLNE S,IO ;SKIP IF READ
JRST USRDO ;NO, WRITE
MOVE T2,DEVBLK##(F) ;SET TO READ THE BLOCK
TXO T2,INSVL.(DSK,SU.SCH) ;SET CHANNEL NUMBER
SUSET. T2, ;POSITION
JRST USRDOE ;ERROR
SETZ T2, ;TERMINATE I/O LIST
INPUT DSK,T1 ;AND READ IT
JRST USRDFN ;FINISH UP
USRDO: MOVSI T2,UNPSAF##
TDZN T2,UNIDES##(U) ;SKIP IF MAY WRITE THIS UNIT
JRST USRDOE ;NO, ERROR
MOVE T2,DEVBLK##(F) ;SET TO WRITE THE BLOCK
TXO T2,INSVL.(DSK,SU.SCH) ;SET CHANNEL NUMBER
SUSET. T2, ;POSITION
JRST USRDOE ;ERROR
SETZ T2, ;TERMINATE I/O LIST
OUTPUT DSK,T1 ;OUTPUT IT
USRDFN: GETSTS DSK,T1 ;GET STATUS
HRR S,T1 ;SAVE IN S
TRZE T1,740000 ;CLEAR ERROR BITS AND SKIP IF NO ERRORS
SETSTS DSK,(T1) ;CLEAR ERRORS IN STATUS FOR FUTURE I/O
USRDX: POPJ P, ;RETURN
USRDOE: TRO S,740000
JRST USRDX
OPNUNI: PUSHJ P,SAVE3
MOVEI P1,17
MOVE P2,UNINAM##(U)
SETZ P3,
OPEN DSK,P1
JRST OPNUNN ;CANT DO I/O IF CANT OPEN
MOVEM U,CURUNI ;REMEMBER OPEN UNIT
POPJ P,
OPNUNN: SETZM CURUNI ;DONT REMEMBER UNIT NAME
JRST CPOPJ1 ;AND NOTE CANT WRITE
;SUBROUTINE TO OPEN SCRATCH FILE
OPNFIL: INIT DSK,17 ;START BY OPENING DSK
SIXBIT .DSK.
0
STOPCD .,HALT,NM2,
MOVE T1,[SIXBIT .TWICE.] ;FILE NAME
MOVEM T1,TWCFIL ;STORE FILE NAME
MOVSI T1,'BIN' ;EXT
MOVEM T1,TWCFIL+1 ;STORE EXT
SETZM TWCFIL+2 ;CLEAR ATTRIBUTES
MOVEI T1,RETRYN ;NUMBER OF TIMES TO RETRY FOR FBM
MOVEM T1,RETRYC ;SET RETRY COUNTER
OPNFL1: SETZM TWCFIL+3 ;CLEAR DIRECTORY
LOOKUP DSK,TWCFIL ;SEE IF FILE ALREADY EXISTS
JRST OPNFL2 ;NO, MUST CREATE IT
SETZM TWCFIL+3 ;CLEAR DIRECTORY AGAIN
ENTER DSK,TWCFIL ;SET FOR UPDATE
JRST OPNFL3 ;CANT UPDATE?
PUSH P,U ;SAVE U
SETZ U, ;LOOK FOR END OF LIST
PUSHJ P,FNDUNI ;TO GET NUMBER OF UNITS IN OUR "SYS"
;*** NORMALLY WOULD BE A SKIP RETURN POSSIBLE, BUT CAN NEVER FIND UNIT
;0 BECAUSE 0 IS END OF LIST
IMULI T1,BLKPUN ;TIMES BLOCKS FOR EACH UNIT
USETO DSK,1(T1) ;ALLOCATE THAT MANY BLOCKS AND CLEAR
HRRZS FILFLG ;NOTE FILE READY TO WRITE
JRST UPOPJ ;RESTORE U AND RETURN
OPNFL2: HRRZ T1,TWCFIL+1 ;GET ERROR CODE
JUMPN T1,OPNFL4 ;CANT GO ON
SETZM TWCFIL+3 ;CLEAR DIRECTORY
ENTER DSK,TWCFIL ;TRY TO CREATE FILE
JRST OPNFL3 ;CANT
CLOSE DSK, ;FILE NOW EXISTS
JRST OPNFL1 ;TRY TO UPDATE AGAIN
OPNFL3: HRRZ T1,TWCFIL+1 ;GET ERROR CODE
CAIE T1,14 ;SKIP IF NO ROOM
CAIN T1,3 ;SKIP IF NOT FILE BEING MODIFIED
SOSG T1,RETRYC ;DECREMENT RETRY COUNTER
OPNFL4: STOPCD .,HALT,NM3, ;DONT RETRY OR TOO MANY RETRIES
CAIN T1,RETRYN-^D10 ;SKIP UNLESS 10 SECONDS LATER
OUTSTR [ASCIZ .% Wait please.]
MOVEI T1,1 ;1 SECOND FOR SLEEP
SLEEP T1, ;WAIT A WHILE
JRST OPNFL1 ;TRY AGAIN
;SUBROUTINE TO FIND POSITION OF UNIT IN LIST OF UNITS
;ARGS U=ADDR OF UNIT DATA BLOCK
;VALUES T1=POSITION OF UNIT IN LIST OF UNITS (0=1ST, ETC)
;NONSKIP IF UNIT NOT FOUND, T1=NUMBER OF UNITS
;SKIP IF UNIT FOUND, T1 SET UP
FNDUNI: SETZ T1, ;CLEAR T1 IN CASE NO UNITS
HLRZ T2,SYSUNI## ;ADDR OF 1ST UNIT IN SYS
FNDUN1: JUMPE T2,CPOPJ ;JUMP IF THAT WAS LAST UNIT
CAMN T2,U ;SKIP IF NOT DESIRED UNIT
JRST CPOPJ1 ;FOUND UNIT, GOOD RETURN
HLRZ T2,UNISYS##(T2) ;MOVE TO NEXT UNIT IN SYS
AOJA T1,FNDUN1 ;COUNT UNITS
STRTAD==200000
RELABP==40000
;SUBROUTINE TO FIND N CONSECUTIVE 0'S IN A TABLE
;ENTER WITH P1 = AOBJN WORD TO THE TABLE
;P2 = PREVIOUS BEST SO FAR
;RH(P3)= HOW MANY, BIT STRTAD =1 IF START LOC SPECIFIED
;LH(P3) HAS BITS 0,1,2 USED BY FILSER
;EXIT CPOPJ1 IF FOUND, WITH P4 = WHERE THE HOLE IS, P1=UPDATED POINTER
;EXIT CPOPJ IF UNSUCCESSFUL, P2 = LARGEST HOLE FOUND
;P2,P4 CHANGED
;NOTE--SHOULD NOT CONTAIN A METER POINT SINCE IS CALLED
; BY ENDSTS ON 407 START BEFORE METINI IS CALLED
GETZ:: PUSHJ P,SETR ;ZERO R IF OLD STYLE CALL
GETZ0: TLNE P3,STRTAD ;START LOC SPECIFIED? (NOTE THAT ENTRY TO ROUTINE
; IS AT GETZR IF START LOC SPECIFIED)
POPJ P, ;YES, ERROR RETURN
HRRM P1,-2(P) ;STORE ABOJN POINTER IN INDIRECT WORD
SETCM T1,@-2(P) ;WORD TO INVESTIGATE
JRST GETZA ;SKIP CALL TO SETR
GETZX:: PUSHJ P,SETR ;SETUP INDIRECT POINTER
GETZA: MOVEI T4,^D36 ;NO. SET UP COUNT
JUMPE T1,GETZ4 ;FULL IF 0
JUMPG T1,GETZ3 ;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1: SETCA T1, ;SET TO REAL CONTENTS
JFFO T1,.+2 ;COUNT THE NUMBER OF 0'S
MOVEI T2,^D36 ;36 OF THEM
JRST GETZB ;SKIP CALL TO SETR
GETZR:: PUSHJ P,SETR ;SETUP INDIRECT POINTER TO THE BIT TABLE
GETZB: MOVE T3,T2 ;SHIFT COUNT (T3 CAN BE .GT. 36 AT GETZ2)
MOVEM P1,P4 ;SAVE POSITION IN P4
HRLM T4,P4 ;LOC OF HOLE
GETZ2: CAIL T3,(P3) ;FOUND ENOUGH?
JRST CPOPJ1 ;YES. GOOD RETURN
CAILE T3,(P2) ;NO. BEST SO FAR?
HRRI P2,(T3) ;YES. SAVE IT
SUBI T4,(T2) ;DECREASE POSITION COUNTER
JUMPLE T4,GETZ5 ;0'S ON END
TLNE P3,STRTAD ;THIS HOLE NOT GOOD ENOUGH
POPJ P, ;ERROR RETURN IF START ADDRESS GIVEN
SETCA T1, ;NOW WE WANT TO COUNT 1'S
LSH T1,1(T2) ;REMOVE BITS WE ALREADY LOOKED AT
JUMPE T1,GETZ4 ;GO IF THE REST OF THE WORD IS ALL ONES
GETZ3: JFFO T1,.+1 ;NUMBER OF (REAL) 1'S
LSH T1,(T2) ;GET RID OF THEM
CAIN T4,^D36 ;1ST POSITION IN WORD?
ADDI T4,1 ;YES, SUBTRACT REAL JFFO COUNT
SUBI T4,1(T2) ;DECREASE POSITION COUNT
JUMPG T4,GETZ1 ;TRY NEXT 0 - HOLE
GETZ4: AOBJN P1,GETZ0 ;1'S ON END - START FRESH AT NEXT WORD
;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT THE WORD HAD 0'S ON THE END
GETZ5: AOBJP P1,CPOPJ ;THROUGH IF END OF SAT
HRRM P1,-2(P) ;STORE UPDATED AOBJN POINTER
SKIPGE T1,@-2(P) ;NEXT WORD POSITIVE?
JRST GETZ0 ;NO. THIS HOLE NOT GOOD ENOUGH
JFFO T1,.+2 ;YES. COUNT THE 0'S
MOVEI T2,^D36 ;36 0'S
ADDI T3,(T2) ;ADD TO PREVIOUS ZERO-COUNT
MOVEI T4,^D36 ;RESET T4
JRST GETZ2 ;AND TEST THIS HOLE
;SUBROUTINE TO SET UP A BIT MASK FOR IORM OR ANDCAM INTO A TABLE
;ENTER WITH T1=POSITION (36=BIT0, 1=BIT35)
; AND T3=HOW MANY
;AFTER THE FIRST CALL USE BITMS2, T3=COUNT RETURNS T1=MASK,
;T3=REMAINING COUNT ROUTINE HAS RETURNED FINAL MASK IF
;T3 .LE. 0 ASSUMES T4=ADR IN TABLE, BITMS2 INCREMENTS T4
BITMSK::PUSH P,T1 ;SAVE POSITION
MOVN T1,T3 ;- COUNT
CAILE T3,^D36 ;MORE THAN 1 WORD?
MOVNI T1,^D36 ;YES, SETTLE FOR A WORD (OR LESS)
MOVSI T2,400000 ;SET TO PROPOGATE A MASK
ASH T2,1(T1) ;GET THE RIGHT NUMBER OF BITS
SETZ T1,
LSHC T1,@0(P) ;POSITION THE BITS IN T1 (=MASK)
SUB T3,0(P) ;REDUCE THE COUNT TO THE NEW VALUE
PJRST T2POPJ ;AND RETURN
;HERE AFTER FIRST CALL, MASK STARTS AT BIT 0
BITMS2::SETO T1, ;MASK STARTS AT BIT 0
MOVNI T2,-^D36(T3) ;SET UP SHIFT
CAIGE T3,^D36 ;DONT SHIFT IS .GE. 36
LSH T1,(T2) ;POSTION THE MASK
SUBI T3,^D36 ;REDUCE THE COUNT
AOJA T4,CPOPJ ;UPDATE THE POSITION AND RETURN
;SUBROUTINE TO MARK BITS AS TAKEN IN A TABLE
;USES ACS AS RETURNED BY GETZ - P3=HOW MANY
; LH(P4)=POSITION, RH(P4)=WHERE (POSITION=36 IF BIT0, 1 IF BIT35)
;RETURNS CPOPJ IF BIT IS ALREADY SET, CPOPJ1 NORMALLY, RESPECTS T1
SETOS:: PUSHJ P,SETR ;SETUP INDIRECT POINTER TO THE BIT TABLE
PUSH P,T1 ;SAVE T1
MOVE T4,P4 ;WHERE
HRRZ T3,P3 ;COUNT
HLRZ T1,P4 ;POSITION IN WORD
PUSHJ P,BITMSK ;SET UP A MASK
SETOS1: HRRM T4,-3(P) ;FOR INDIRECT
TDNE T1,@-3(P) ;BIT ALREADY ON?
JRST SETOS2 ;YES
IORM T1,@-3(P) ;NO, NOW IT IS
JUMPLE T3,TPOPJ1 ;DONE IF COUNT .LE. 0
PUSHJ P,BITMS2 ;NOT DONE, GET MASK FOR NEXT WORD
JRST SETOS1 ;AND GO SET THE BITS IN THAT WORD
;HERE IF BIT ALREADY ON
SETOS2: PUSH P,T3 ;SAVE CURRENT COUNT
HLRZ T1,P4 ;RESTORE ORIGINAL VALUES
HRRZ T3,P3
MOVE T4,P4
PUSHJ P,BITMSK ;AND GENERATE A MASK
SETOS3: HRRM T4,-4(P) ;SET FOR INDIRECT
CAMN T3,(P) ;IS THE COUNT FOR MASK=COUNT WHEN SET?
JRST SETOS4 ;YES, DONE
ANDCAM T1,@-4(P) ;NO, CLEAR THOSE BITS
PUSHJ P,BITMS2 ;GENERATE NEXT MASK
JRST SETOS3 ;AND CONTINUE
SETOS4: POP P,(P) ;CLEARED ALL THE RIGHT BITS - FIX PD LIST
JRST TPOPJ ;AND NON-SKIP RETURN
;SUBROUTINE TO OBTAIN FREE BITS, MARK THEM AS TAKEN IN THE TABLE
;ENTER WITH T1=HOW MANY,
;T2=XWD ADR OF 1ST WORD OF TABLE, ADR OF TABLE AOBJN WORD (OR 0, LOC OF AOBJN)
;RETURNS CPOPJ IF NOT ENOUGH AVAILABLE, T1=SIZE OF LARGEST HOLE
;RETURNS CPOPJ1 IF GOTTEN, T1= RELATIVE ADDRESS OF BLOCK OBTAINED
;T3 IS UPDATED AOBJN POINTER
GETBIT::PUSHJ P,SAVE4 ;SAVE P1-P4
TLNN T2,-1 ;STARTING AT AN OFFSET?
HRL T2,(T2) ;NO, START AT FIRST WORD
PUSH P,T2 ;SAVE ADR OF AOBJN WORD FOR TABLE
GETBI1: HRRZ P1,0(P) ;GET AOBJN WORD
MOVE P1,(P1)
SETZ P2, ;NO BEST SO FAR
MOVE P3,T1 ;NUMBER OF BITS TO GET
PUSHJ P,GETZ ;GET THE BITS
JRST GETBI2 ;NOT ENOUGH AVAILABLE
HRRZ T1,P4 ;GOT THEM - FIRST WORD WITH ZEROES
HLRZ T2,(P) ;LOC OF FIRST WORD OF TABLE
SUBI T1,(T2) ;COMPUTE RELATIVE ADDRESS OF START
IMULI T1,^D36 ;36 BITS PER WORD
HLRZ T2,P4 ;BIT POSITION OF 1ST 0 IN THE WORD
MOVNS T2
ADDI T1,^D36(T2) ;T1= RELATIVE LOC WITHIN THE TABLE
PUSHJ P,SETOS ;MARK THE BITS AS TAKEN
SKIPA T1,P3 ;SOME FINK SNUCK IN ON US!
AOSA -1(P) ;GOT THEM - WIN RETURN
JRST GETBI1 ;TRY AGAIN TO GET SOME BITS
MOVE T3,P1 ;UPDATED POINTER
JRST T2POPJ ;RETURN
;HERE IF NOT ENOUGH ARE AVAILABLE
GETBI2: MOVE T1,P2 ;T1=LARGEST HOLE FOUND
PJRST T2POPJ ;NON-SKIP RETURN
;INTERFACE ROUTINE TO GETZ/SETOS WHICH ALLOWS THEM TO BE CALLED WITH AN
; EXTENDED ADDRESS AND A AOBJN POINTER RELATIVE TO A BIT TABLE
;CALLING SEQUENCE:
; MOVE R,ADDRESS OF THE BIT TABLE
; MOVE P1,AOBJN POINTER RELATIVE TO THE TABLE
; TLO P3,RELABP ;INDICATE THIS FORM OF CALL
; PUSHJ P,SETR ;MUST BE IN A NON-ZERO SECTION IF RELABP IS ON
;ALWAYS RETURN CPOPJ, -2(P) IS AN INSTRUCTION FORMAT INDIRECT WORD TO BIT TABLE
SETR: PUSH P,R ;SAVE R, SOME CALLERS MAY WANT IT RETURNED
MOVSI R,400000+R ;LOCAL INSTRUCTION FORMAT INDIRECT WORD
EXCH R,-1(P) ;SAVE IT ON THE STACK, GET RETURN ADDRESS
MOVEM R,1(P) ;TO CALL THE CALLER
IFN FTXMON,<
TLNN P3,RELABP ;RELATIVE AOBJN POINTER SPECIFIED?
JRST SETR1 ;NO, OLD CALL
SKIPE KSFLAG ;DON'T CHECK SECTION ON KS
JRST SETR0
TLNN R,(SECMSK) ;MUST BE IN A NON-ZERO SECTION IF RELABP IS ON
STOPCD SETR2,DEBUG,NNS,;++NOT IN A NON-ZERO SECTION
>
SETR0: TLNN P3,RELABP ;NEW CALL?
SETR1: TDZA R,R ;NO, NO RELOCATION
MOVE R,(P) ;YES, GET RELOCATION
PUSHJ P,@1(P) ;CALL CALLER AS A COROUTINE
CAIA ;NON-SKIP RETURN
AOS -2(P) ;PROPAGATE SKIP
SETR2: POP P,R ;RESTORE R
POP P,(P) ;POP OFF JUNK
POPJ P, ;AND RETURN
DOHALT::HALT .
DIE:: PUSHJ P,OTSET ;INITIALIZE BUFFERS AND POINTERS
MOVEI T1,[ASCIZ .?STOPCD .]
PUSHJ P,CONMES
MOVE T1,(P) ;GET PC+1 OF CALLER
MOVE T1,-1(T1) ;GET XCT INSTRUCTION
MOVE T2,1(T1) ;GET STOPCODE NAME
PUSHJ P,PRNAME
PUSHJ P,CRLF
PUSHJ P,OPOUT
EXIT
ILLINP::STOPCD .,HALT,INP
; CO-ROUTINE TO ENTER SECTION ZERO
SSEC0:: EXCH T1,(P) ;GET PC WE WERE CALLED AT
TLZN T1,37 ;MAKE SURE IT IS AN EXTENDED PC
JRST [EXCH T1,(P) ;RESTORE T1
POPJ P,] ;AND RETURN IN SECTION 0 (ROUTINE IS A NOOP).
PUSH P,T1 ;SAVE AS A SECTION 0 PC.
HRRZI T1,SSEC0E ;NOTE SECTION 0 PC.
EXCH T1,-1(P) ;RESTORE T1, LEAVE A RETURN PATH TO US.
POPJ P, ;"RETURN" TO CALLER.
SSEC0E: SKIPA ;RETURNED NON-SKIP, LEAVE EVERYTHING ALONE
AOS (P) ;SKIP RETURN, BUMP CALLERS PC
EXCH T1,(P) ;GET RETURN PC TO HIGHER LEVEL ROUTINE.
TLZ T1,777740 ;WIPE FLAGS IN CASE SECTION 0 PC
MOVEM T1,1(P) ;SAVE AS PC PART OF XJRSTF DUO-WORD
POP P,T1 ;RESTORE T1
XJRST 2(P) ;RETURN IN PROPER SECTION
; CO-ROUTINE TO ENTER SECTION ONE
SSEC1:: PUSH P,T1 ;SAVE A TEMP
XMOVEI T1,. ;CURRENT SECTION
TLNE T1,-1 ;ARE WE ALREADY EXTENDED?
JRST TPOPJ ;YES, GO HOME
HRRZS -2(P) ;MAKE CALLER RETURN TO SECTION 0
MOVSI T1,1 ;A SECTION 1
HLLM T1,-1(P) ;FOR OUR POPJ
XJRST [MCSEC1+TPOPJ] ;ENTER SECTION 1 AND RETURN
;SUBROUTINES TO SAVE AND RESTORE PRESERVED ACS
;SAVEN IS CALLED AT THE BEGINNING OF A SUBROUTINE
;FOR CONVENIENCE NO MATCHING SUB IS NEEDED TO BE CALLED
;TO RESTORE THIS ACS.
;INSTEAD AN EXTRA RETURN IS PUT ON STACK
;5 CHAR NAME INDICATES IT VIOLATES
;SUBROUTINE CALLING CONVENTIONS
;CALL: PUSHJ P,SAVEN
; RETURN HERE IMMEDIATELY WITH EXTRA RETURN ON STACK
; RESPECTS ALL ACS
;NOTE: THIS CODE USES 1 LOC BEYOND END OF STACK BUT THEN PUSHES ON TOP OF IT
;SO GET OVERFLOW INTERUPT IF TOO FULL. OK TO DO 1(P) SINCE THIS WORD WRITTEN ON OVERFLOW
SAVE1:: EXCH P1,(P) ;SAVE P1, GET CALLER PC
MOVEM P1,1(P) ;SAVE CALLER PC ONE BEYOND END
MOVE P1,(P) ;RESTORE P1
PUSHJ P,@1(P) ;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
JRST RES1
AOS -1(P)
JRST RES1
SAVE2:: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2
MOVEM P1,1(P) ;SAVE CALLER PC ONE BEYOND END
MOVE P1,-1(P) ;RESTORE P1
PUSHJ P,@1(P) ;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
JRST RES2
AOS -2(P)
JRST RES2
SAVE3:: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2
PUSH P,P3
MOVEM P1,1(P) ;SAVE CALLER PC ONE BEYOND END
MOVE P1,-2(P) ;RESTORE P1
PUSHJ P,@1(P) ;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
JRST RES3
AOS -3(P)
JRST RES3
SAVE4:: EXCH P1,(P) ;SAVE P1, GET CALLER PC
PUSH P,P2
PUSH P,P3
PUSH P,P4
MOVEM P1,1(P) ;SAVE CALLER PC ONE BEYOND END
MOVE P1,-3(P) ;RESTORE P1
PUSHJ P,@1(P) ;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
JRST RES4
AOS -4(P)
RES4: POP P,P4
RES3: POP P,P3
RES2: POP P,P2
RES1: POP P,P1
POPJ P,
;SUBROUTINE TO SAVE AND RESTORE TEMP ACS
;CALLED BY PUSHJ P,SAVT RETURN EITHER CPOPJ OR CPOPJ1 WHEN THROUGH
SAVT:: EXCH T4,(P) ;SAVE T4, GET RETURN ADR.
PUSH P,T3 ;SAVE T3
PUSH P,T2 ;AND T2
PUSH P,T1 ;AND T1
MOVEM T4,1(P) ;STORE PC
MOVE T4,-3(P) ;RESTORE T4
PUSHJ P,@1(P) ;RETURN TO CALLER
SKIPA ;POPJ RETURN
AOS -4(P) ;CPOPJ1 - SET SKIP RETURN
POP P,T1 ;RESTORE T1
POP P,T2 ;RESTORE T3 ACS
POP P,T3
POP P,T4
POPJ P, ;AND RETURN
SUBTTL DISK OFF LINE INTERCEPTION
;WHEN A FILE STRUCTURE IS REMOVED VIA STRUUO, AND THE OPERATOR
; REMOVES THE PACK(S), THE RP10 HARDWARE DOES NOT INTERRUPT
; AS THE UNIT GOES OFF LINE, NOR IS THERE ANY WAY TO PASSIVELY CHECK
; TO SEE IF THE UNIT IS OFF LINE. THEREFORE, TWICE MUST INTERCEPT
; THE DISK OFF LINE MESSAGE.
;
;ON THE KS, AN XJRST IS AN ILLEGAL INSTRUCTION. INTERCEPT IT HERE
;AND SIMULATE IT BY DOING THE APPROPRIATE JRST.
;
DOLBLK: XWD 4,DOLINT ;INTERRUPT TO DOLINT
EXP ER.MSG!ER.OFL!ER.EIJ ;INHIBIT MESSAGE, TRAP ON DISK OFF LINE
;AND "ERROR IN JOB" (XJRST)
DOLPC: 0 ;STARTS OUT ZERO
0 ;EXTRA STUFF
DOLINT: MOVEM T1,DOLSAV ;SAVE T1
MOVSI T1,ER.EIJ ;SEE WHAT KIND OF ERROR WE GOT
TDZN T1,DOLPC+1 ;WAS IT "ERROR IN JOB"?
JRST DOLIN1 ;NO, MUST BE DISK OFFLINE
SOS T1,DOLPC ;BACK UP THE PC, AND FETCH IT
MOVE T1,(T1) ;GET FAILING INSTRUCTION
TLCE T1,(XJRST) ;IS IT AN XJRST?
TLNE T1,777740 ; IN THE INSTRUCTION PART OF THE WORD?
JRST @DOLPC ;NO, RE-DO THE INSTRUCTION TO GET REAL ERROR
EXCH T1,DOLSAV ;RESTORE OLD T1, STORE "E" PART OF INSTRUCTION
MOVEM T1,DOLSAV+1 ;SAVE T1 IN ANOTHER PLACE TOO
HRRZ T1,@DOLSAV ;USE ONLY 18-BIT ADDRESS NOW
EXCH T1,DOLSAV+1 ;RESTORE T1 AND SAVE TARGET ADDRESS
SETZM DOLPC ;ALLOW MORE INTERRUPTS
JRST @DOLSAV+1 ;FINALLY, DO THE JRST
DOLIN1: SETZ T1, ;CLEAR DOLPC SO WE CAN INTERRUPT AGAIN
EXCH T1,DOLPC ;
EXCH T1,DOLSAV ;GET PC INTO DOLSAV, RESTORE T1
OUTSTR [ASCIZ/% Unexpected disk off line condition
/]
JRST @DOLSAV ;RETURN
DOLSAV: BLOCK 2
;ROUTINES TO SAVE AND RESTORE SETKON ROUTINE SO THAT TWICE CAN CONTROL
; WHEN UNIT STATUS' ARE CLEARED.
; CALL ONCE BEFORE ENTERING ACTUAL ONCE CODE, AND BEFORE EXITING.
SAVKON: PUSHJ P,SETKON## ;CALL SAVKON NOW TO CLEAR OUT STATUS'
MOVE T1,CPOPJ ;GET A POPJ
EXCH T1,SETKON##+1 ;GET INSTRUCTION TO BE REPLACED, MAKE IT POPJ
MOVEM T1,KONSAV ;SAVE THE INSTRUCTION
POPJ P, ;RETURN
RESKON: MOVE T1,KONSAV ;GET OLD INSTRUCTION
MOVEM T1,SETKON##+1 ;RESTORE OLD INSTRUCTION
POPJ P, ;RETURN
KONSAV: BLOCK 1 ;PLACE TO SAVE INSTRUCTION
SUBTTL ROUTINES TO SATISFY KONTROLLER REQUESTS IN ONCMOD
;COMMOD.MAC WILL CONDITIONALLY DEFINE CERTAIN SYMBOLS BASED ON
;THE VALUES OF M.RC10 AND M.RP10. THESE DUMMY DEFINITIONS ARE
;DONE TO SATISFY GLOBAL REQUESTS AT LINK TIME. IF COMMOD HAS
;ALREADY DEFINED THEM, THEN TWICE SHOULD NOT, AND VISA-VERSA.
;THEREFORE, THE CONDITIONALS HERE ARE SIMPLY REVERSED FROM THOSE
;IN COMMOD.MAC
XP RD10N,M.RC10
XP RP10N,M.RP10
USRCPY::MOVE T1,UNINAM##(U) ;NAME OF UNIT
MOVEM T1,CHRBUF ;STORE FOR DSKCHR
MOVE T1,[XWD .DCMAX,CHRBUF]
DSKCHR T1, ;FIND OUT ABOUT UNIT
JRST USRCP1 ;NO SUCH UNIT
MOVE T2,CHRBUF+.DCBUM ;BLOCKS/UNIT PLUS MAINTENANCE BLOCKS
MOVE T3,CHRBUF+.DCBUC ;BLOCKS/UNIT IN COMPATIBILITY MODE
LDB T4,[POINTR T1,DC.UNT] ;GET UNIT TYPE
LDB W,[POINTR CHRBUF+.DCUCH,DC.UCT] ;BLOCKS/TRACK
HRLZS W ;IN LEFT HALF
HRR W,CHRBUF+.DCUCH ;BLOCKS/CYLINDER
TLNE T1,(DC.OFL) ;SKIP UNLESS UNIT OFF LINE
TLOA T4,KOPUHE## ;FLAG THAT ONCMOD EXPECTS
AOS (P) ;ON LINE, SKIP RETURN
MOVE T1,CHRBUF+.DCUSZ ;CAPACITY OF UNIT
POPJ P,
USRCP1: MOVSI T4,KOPUHE## ;SET FLAG FOR ONCMOD
TLO T4,KOPNSU## ;NOTE ALSO NO SUCH UNIT
POPJ P, ;RETURN
FHXUPA::
FSXUPA::
RPXUPA::
RNXUPA::
DPXUPA::MOVEI T1,1 ;RETURN WRITE HEADER LOCKOUT SWITCH OFF
JRST CPOPJ1 ;ALWAYS RETURN KONTROLLER ON LINE
UVACKS::SKIPA T2,T1
DODTI4::
IFN RP10N,< ;IF RP10 CONTROLLERS:
DPXSTS:: ;THEN DEFINE SINCE COMMOD DID NOT
>
MOVEI T2,0 ;DUMMY READ STATUS ROUTINE
POPJ P, ;ALWAYS CALLED BY ONCMOD
;RETURN 0 STATUS(NOT WRTIE LOCKED)
DEFINE CHNCB(N),<
CHN'N'CB==:0
>
CHNCB (\M.CHN)
DEFINE KONKON(TYPE),<
IRP TYPE,<
..XX==0
REPEAT 4,<
..YY==0
REPEAT ^D8,<
KONSAV(TYPE,\<..XX*10+..YY>)
..YY==..YY+1
>
..XX==..XX+1
>
TYPE'XERR::
TYPE'XWRT::
TYPE'XWTC::
TYPE'XWTF::
TYPE'XWTS::
TYPE'XINT::
TYPE'XECC::
TYPE'XUNL::
TYPE'XPOS::
TYPE'XLTM::
TYPE'XRCL::
TYPE'XRED::
TYPE'XSTP::
TYPE'XRDF::
TYPE'XRDC::
TYPE'XRDS::
TYPE'XKON::
TYPE'XCPY::
>>
DEFINE KONSAV(TYPE,CHN),<
TYPE'CHN'SAV::
TYPE'CHN'SV::
>
KONKON (<FH,FS,DP,RP,RN>)
SUBTTL ROUTINES TO SATISFY UNNEEDED GLOBAL REQUESTS
;MACRO TO SATISFY GLOBAL REQUESTS FOR ERROR RETURN LABELS
DEFINE ERCALC(A),<ECOD'A::>
;GENERATE THE LABELS
.N==0
REPEAT ECDMAX,<
ERCALC(\.N)
.N==.N+1
>
;GENERATE SKPCPU MACRO LABELS
DEFINE SKPXXX(A),<
IRP A,<$SCP'A::>
>
;GENERATE THE LABELS
SKPXXX(<A,I,L,AI,AL,IA,IL,LI,LA>)
.PDJSE::.PDJSL::COMERA::CPUJOB::CTLJBD::DAEEIM::FNDQSR::GETWRD::MEMSIZ::
QSRSPL::SETLGL::SLEEP::TTYFNU::TTYTAB::%SIQSR::
DODELE::FNDPDB::GCH4WD::JBTST2::T2POJ1::VIRTAL::
TDVKDB::TDVUDB::TKBCDB::TTMCIC::TTMCIS::TTMCOC::TTXCIS::TTXCOS::
MCUALT::MCUATP::TUYKTP::
GTWST2::PUTWDU::PUTWD1::JBTPRV::IPOPJ::IPOPJ1::PUUOAC::IADRCK::
STOTC1::DVCNSG::RTM1::RTZER::SYSINI::DSKINI::REMSEG::STOP1::WAIT1::SERIAL::JOB::
SAVDDL::DEVLG::IOIERR::ADVBFE::SETACT::CLRACT::CLOSE1::CLOCK::REGSIZ::STDIOD::
SWPINT::OUT::JBTPPN::JBTNAM::JBTLOC::JBTSPL::USRJDA::USRHCU::UUOERR::
WSYNC::DEVLST::STOTAC::STOIOS::ADVBFF::USCHED::CVTSBT::OPRLDB::MQREQ::
MQAVAL::CBAVAL::CBREQ::PJOBN::FREPTR::GET4WD::GIV4WD::GETWDS::GIVWDS::UADCK1::
LOCOCW::DAAVAL::AUAVAL::AUREQ::COMCHK::INLMES::GETJOB::HIGHJB::GETWDU::
GETWD1::PROT::PROT0::REFLOG::CDVSBT::PDVCNT::HNGSTP::TTYSTR::TTYFUW::
LGLPRC::ILLOUT::CHNNXM::
DAUSER::NU0DAC::SVEUF::CLRBTS::CHNMPE::CHNDPE::DAEERR::SVEUB::MAPIO::SETINT::RTNIOW::
AUUSER::GIVRES::WRDCNT::CBUSER::HOLD0::WSCHED::
MP3::MPDPRA::
MTXCHB::CNIMTS::CNIMTC::CNFMTA::MTXCDB::FLG256::.C0JOB::SETDVL::PUTWRD::
UADRCK::TSETBI::ILLINS::CNOCLR::RTM2::
ATTMPA::DETMPA::SAVJW::SNDMDN::
DLYCM::UADERR::ARNGE::
TTYFND::STOPCD .,HALT,NM4,
IFN RP10N,<
;SATISFY GLOBALS IN DPXCPY AND DPXUPA WHICH WILL NEVER BE CALLED BUT DO GET LOADED IF NO RP10'S
;THIS ASSEMBLES IF THE ONE IN COMMOD DOES NOT.
XP DPDONE,0
XP DPCLR,0
XP DPATTN,0
>
IFN RD10N,<
;SATISFY GLOBALS IN FHXCPY AND FHXUPA WHICH WILL NEVER BE CALLED BUT ARE LOADED IF NO RD10'S
;THIS ASSEMBLES IF THE ONE IN COMMOD DOES NOT.
XP FHALCL,0
> ;END CONDITIONAL ON RD10N
BITTBL::
SALL
ZZ==1B0
REPEAT ^D36,<
EXP ZZ
ZZ==ZZ_<-1>
>
XALL
DAFREE::AUFREE::CBFREE::MQFREE::MQWAIT::CBWAIT::DAWAIT::AUWAIT::
PRVJ::
RSPWT1::POPJ P,
T4POPJ::POP P,T4
POPJ P,
JBTSTS::BLOCK 1
FORCEF::BLOCK 1
SWPLST::BLOCK 1
SW2LST::BLOCK 1
SW3LST::BLOCK 1
BMSLST::BLOCK 1
REFLAG::BLOCK 1
DDSTAR::BLOCK 1
SYSSIZ::BLOCK 1 ;WRITABLE FOR FILMAN
SYSCHN::BLOCK 1
CNFCHN::BLOCK 1
DAREQ:: BLOCK 1
LOCORE::BLOCK 1
ONCEND::BLOCK 1
SYSINA::SYSDSP::SYSINI
THSDAT::BLOCK 1
TIME:: BLOCK 1
TICMIN::EXP ^D60*^D60
TICSEC::EXP ^D60
DEBUGF::BLOCK 1
FINISH::BLOCK 1
SKPCPI::JFCL
DATE:: BLOCK 1
.C0ASN::
.CPASN::BLOCK 1
.C0OK::
.CPOK:: BLOCK 1
.CPLOG::BLOCK 1
.CPRUN::BLOCK 1
.C0AEF::BLOCK 1
JBTADR::BLOCK 1
PAGINC::EXP 0
PAGSNC::EXP 0
FILFLG::BLOCK 1 ;SCRATCH FILE FLAG
TWCFIL::BLOCK 4 ;LOOKUP/ENTER BLOCK FOR SCRATCH FILE
RETRYC::BLOCK 1 ;RETRY COUNTER FOR CREATING SCRATCH FILE
CHRBTS: BLOCK 1 ;DSKCHR UUO BITS
PREASL::BLOCK 1
PRESSL::BLOCK 1
PRESDL::BLOCK 1
K2PLSH==:1
PAGSIZ==:1000
PG.BDY==:PAGSIZ-1
P2KLSH==:-K2PLSH
JOBMAX=:M.JOB
SKPCPA==:0
MSK22B==:0
SUBTTL DATA AND STORAGE
LINEP: POINT 7,LINBUF
CHRBUF: BLOCK .DCMAX
CURUNI: BLOCK 1
LINBUF: BLOCK LINSIZ
ONCTSZ==LINSIZ*5-1
ONCTIP: BLOCK 1
ONCTOP: BLOCK 1
ONCCNT: BLOCK 1
TTCMCH: BLOCK 1
OURPPN: BLOCK 1
KSFLAG: BLOCK 1 ;0=KL10 / 1=KS10
ONCPDL::
PDLIST: BLOCK PDLEN
PATCH:: BLOCK 100
END TWICE