Trailing-Edge
-
PDP-10 Archives
-
de-10-omona-v-mc9
-
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 V4A(25)
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978 BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
SUBTTL D BLACK/JSL/EVS/TW 27 AUG 78
VTWICE==4 ;VERSION NUMBER
VEDIT==25 ;EDIT NUMBER
VMINOR==1 ;MINOR VERSION NUMBER
VWHO==0 ;EDITED BY DEC
JOBVER==137
LOC JOBVER
BYTE (3)VWHO(9)VTWICE(6)VMINOR(18)VEDIT
RELOC
;SEARCH S AND F LIBRARIES
SEARCH F,S
;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
.UPOFL==1B1 ;BIT IN DSKCHR AC RETURN=1 IF UNIT OFF LINE
.STNAM==4 ;NAME OF FILE STRUCTURE
.UNCHR==5 ;WORD IN DSKCHR BLOCK RETURN=CHARACTERISTICS OF UNIT
.UNBPU==6 ;WORD IN DSKCHR BLOCK RETURN=CAPACITY OF UNIT
.UNHID==16 ;UNIT ID
.UNMAX==17 ;LARGEST SIZE DSKCHR BUFFER NEEDED
LINSIZ==100 ;SIZE OF TTY LINE BUFFER
PDLEN==100 ;LENGTH OF PUSH DOWN LIST
MJOBN==-^D64 ;MINUS MAX NUMBER OF JOBS (NOT REALLY NEEDED)
SPBCOR==3 ;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
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 (603)
DONE::M.SWCT::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::
.C0ASN::MACTSL::ERPTBK::.IPCFD::.IPCFP::FHXREG::SCNCNT::FNDPDS::
PDVTIM::SETHNG::DECIN1::QMXTAB::QMLTAB::FDAJOB::SNDMDC::MDCJOB::
PIDTAB::RTZER1::PCRLF::MAXACS::.PDEPA::SQREQ::QADTAB::
POPJ P,
WPOPJ1::AOS -1(P)
WPOPJ:: POP P,W
POPJ P,
TKBUDB::CNFMTK::M.XFFA::TKBKDB:: 0
INTERN BLKSPK,MBKSPK,DSKPIN,DSKPIF,PION,PIOFF,ICPFAC,JIFSEC,JIFMIN
INTERN PIPROG,INDPPN,PIOMOD,MJOBN,SPBCOR,PAVJSP,PROTM,SCDSWP
EXTERN DEVBLK,DEVDMP,FILOPT,UNINAM,.JBFF,UUOPWQ,.UONCE,DIFUSY,UNISYS,UNISTS
EXTERN UNIDES,UNILOG,UNIHID,GETUNI,SVMOUT
TWICE: JFCL ;IN CASE OF CCL ENTRY
RESET
SETOM OPTQIK## ;DONT ASK ABOUT OFF-LINE UNITS
MOVE P,[IOWD PDLEN,PDLIST]
SETZ T1, ;WRITE ENABLE HIGH SEGMENT
SETUWP T1,
JRST [OUTSTR [ASCIZ/? CANNOT WRITE ENABLE HIGH SEGMENT
/]
EXIT]
MOVE T1,.JBFF ;FIRST FREE LOCATION
MOVEM T1,ONCEND
CALLI T1,14 ;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,[53,,11]
GETTAB T1,
SETZ T1,
MOVEM T1,DATE
MOVE T1,[XWD 14,16] ;GET NUMBER OF MONITOR BUFFERS
GETTAB T1,
CAIA ;USE WHAT WAS THERE ALREADY IF ERROR
MOVEM T1,MBFNUM## ;ITS THERE, USE THAT INSTEAD.
MOVE T1,[DOLBLK] ;SETUP .JBINT TO INTERCEPT DISK OFF LINE
MOVEM T1,.JBINT##
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 .UNHID+1,CHRBUF] ;ARG PTR
DSKCHR T2, ;GET UNIT ID
TDZA T2,T2 ;NOT A DISK?
MOVE T2,CHRBUF+.UNHID ;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
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
SKIPN UNILOG(U) ;SKIP IF KEEPING THIS UNIT
PUSHJ P,FLGDW ;NO, FLAG IT AS DOWN
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
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
INTERNAL FTDISK
IFN FTDISK, <
EXTERNAL FILOPT
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
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
EXTERN UNPSAF
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 .STNAM+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+.STNAM ;NO, OK IF NOT IN AN STR
JRST KEEPW1 ;OK TO WRITE ON THIS UNIT
MOVEI T1,[ASCIZ .CANT WRITE.]
PUSHJ P,SVMOUT ;TELL USER CANT 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: 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,FSFPPN ;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 .CANT READ.]
PJRST SVMOUT ;TELL USER CANT READ THIS UNIT
SUBTTL TTY INPUT SUBROUTINES
INTERN YESNO
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)
INTERN GETLIN
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
;ROUTINE TO RETURN NEXT ALPHANUMERIC STRING
; IN COMMAND LINE (SIXBIT)
;CALL: PUSHJ P, CTEXT
; SIXBIT STRING RETURN LEFT JUSTIFIED IN AC T2
INTERNAL CTEXT,CTEXT1
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
INTERN DECIN,OCTIN
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
INTERN SKIPS,SKIPS1,TPOPJ1,TPOPJ,CPOPJ2,CPOPJ1,CPOPJ,UPOPJ,UPOPJ1,T2POPJ
INTERN LPOPJ,JPOPJ,JPOPJ1
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
;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
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
INTERN CRLF
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
INTERN ICONM
ICONM: PUSHJ P,OTSET ;INITIALIZE BUFFER
;SUBROUTINE TO TYPE AN ASCII LINE
;ARGS T1=ADDR OF ASCII LINE
INTERN CONMES
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
INTERN OTSET
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
INTERN OPOUT
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
INTERN PRNAME
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 NUMBER
;ARGS T1=NUMBER TO TYPE
INTERN RADX10
RADX10: IDIVI T1,12
HRLM T2,(P)
JUMPE T1,.+2
PUSHJ P,RADX10
HLRZ T1,(P)
MOVEI T3,"0"(T1)
PJRST ONCTYO
;SUBROUTINE TO TYPE A QUESTION MARK
INTERN PRQM
PRQM: MOVEI T3,"?"
PJRST ONCTYO ;TYPE QUESTION MARK
;SUBROUTINE TO STORE A CHAR IN TTY OUTPUT BUFFER
;ARGS T3=CHAR
ONCTYO: SOSLE ONCCNT ;SKIP IF BUFFER FULL
IDPB T3,ONCTOP ;STORE CHAR IN BUFFER
POPJ P,
INTERN COMTYI
COMTYI: INCHWL T3
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
INTERN USRDIO
EXTERN UNPSAF,FSFPPN
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
SETZ T2,
TLNE S,IO ;SKIP IF READ
JRST USRDO ;NO, WRITE
USETI DSK,DEVBLK(F) ;SET TO READ THE BLOCK
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
USETO DSK,DEVBLK(F) ;SET TO WRITE THE BLOCK
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: JRST CPOPJ1 ;ALWAYS SKIP OVER UNWANTED ROUTINES IN FILIO
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, ;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
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
;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
;EXIT CPOPJ1 IF FOUND, WITH P4 = WHERE THE HOLE IS
;EXIT CPOPJ IF UNSUCCESSFUL, P2 = LARGEST HOLE FOUND
;P1,P2,P4 CHANGED
INTERN GETZ,GETZR,SETOS
GETZ: TLNE P3,STRTAD ;START LOC SPECIFIED? (NOTE THAT ENTRY TO ROUTINE
; IS AT GETZR IF START LOC SPECIFIED)
POPJ P, ;YES, ERROR RETURN
MOVEI T4,^D36 ;NO. SET UP COUNT
SETCM T1,(P1) ;WORD TO INVESTIGATE
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
GETZR: MOVE T3,T2 ;SHIFT COUNT (T3 CAN BE >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
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,GETZ ;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
SKIPGE T1,(P1) ;NEXT WORD POSITIVE?
JRST GETZ ;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 MARK BITS AS TAKEN IN TABLE
;USES ACS AS RETURNED FROM GETZ
;CHANGES P4, RESPECTS T1
INTERN SETOS
SETOS: MOVEI T3,(P3) ;NUMBER OF CLUSTERS TO MARK
MOVEI T2,1 ;SET A BIT
HLRZ T4,P4 ;LOC OF FIRST BIT TO MARK
LSH T2,-1(T4) ;POSITION IT
SETO1: TDNE T2,(P4) ;BIT ALREADY =1?
JRST SETO2 ;YES. CLEAR 0NE-BITS AND NON-SKIP RETURN
ORM T2,(P4) ;MARK A BIT
ROT T2,-1 ;STEP TO NEXT BIT
SKIPG T2 ;NEXT WORD?
AOS P4 ;YES
SOJG T3,SETO1 ;GO MARK NEXT
JRST CPOPJ1 ;AND RETURN
;HERE IF ONE OF THE BITS WE ARE TRYING TO SET IS ALREADY A 1
;THIS CAN HAPPEN BY INTERRUPTING OUT OF GET4WD, AND TAKING BLOCKS
;FOR AN EXTENDED PUSH DOWN LIST
SETO2: SUBI T3,(P3) ;T3=-# OF BITS ALREADY SET
SETO3: JUMPGE T3,CPOPJ ;RETURN IF ALL SET BITS CLEARED
SKIPG T2 ;BIT IN PREVIOUS WORD?
SOS P4 ;YES
ROT T2,1 ;STEP TO PREVIOUS BIT
ANDCAM T2,(P4) ;CLEAR IT
AOJA T3,SETO3 ;AND TEST NEXT BIT
;SUBROUTINE TO SET ZEROS IN A TABLE
;ARG T1=HOW MANY BITS TO CLEAR
; T2=AOBJN POINTER FOR TABLE
; T3=POSITION IN WORD OF FIRST BIT TO CLEAR
; (0=BIT 0, 1=BIT 1, ETC.)
INTERN SETZRS
SETZRS: MOVSI T4,400000 ;SET A BIT
MOVNS T3
LSH T4,(T3) ;POSITION TO 1ST BIT TO RETURN
GIVCR2: ANDCAM T4,(T2) ;CLEAR A BIT
SOJLE T1,CPOPJ ;THROUGH IF T1=0
ROT T4,-1 ;POSITION TO NEXT BIT
JUMPG T4,GIVCR2 ;GO CLEAR IT IF IN SAME WORD
AOBJN T2,GIVCR2 ;STEP TO NEXT WORD
STOPCD CPOPJ,HALT,SZR, ;PAST TOP OF TABLE - ERROR
INTERN DIE
DIE: PUSHJ P,OTSET ;INITIALIZE BUFFERS AND POINTERS
MOVEI T1,[ASCIZ .?STOPCD .]
PUSHJ P,CONMES
HRLZ T2,@(P)
PUSHJ P,PRNAME
PUSHJ P,CRLF
PUSHJ P,OPOUT
EXIT
INTERN ILLINP
ILLINP: STOPCD .,HALT,INP
;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
INTERN SAVE1,SAVE2,SAVE3,SAVE4
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,
SAVT:: EXCH T4,(P)
PUSH P,T3
PUSH P,T2
PUSHJ P,(T4)
SKIPA
AOS -3(P)
POP P,T2
POP P,T3
POP P,T4
POPJ P,
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.
DOLBLK: XWD 4,DOLINT ;INTERRUPT TO DOLINT
EXP 1B0+1B33 ;INHIBIT MESSAGE, TRAP ON DISK OFF LINE
DOLPC: 0 ;STARTS OUT ZERO
0 ;EXTRA STUFF
DOLINT: MOVEM T1,DOLSAV ;SAVE T1
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 1
;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
INTERN FHXUPA,DPXUPA,DPXSTS,USRCPY
INTERN FHXRCL,DPXRCL,FHXSTP,DPXSTP,FHXRED,DPXRED,FHXWRT,DPXWRT
INTERN DPXINT,FHXINT,FHXWTS,DPXWTS,FHXRDS,DPXRDS,FHXINT,DPXINT
INTERN FHXLTM,DPXLTM,FH0SAV,FH1SAV,DP0SAV,DP1SAV,DP2SAV
INTERN DPXPOS,FHXPOS,DPXKON,FHXKON
INTERN FSXUPA,FSXRCL,FSXSTP,FSXRED,FSXWRT,FSXINT,FSXWTS
INTERN FSXKON,FSXRDS,FSXWTF,FSXLTM,FS0SAV,FS1SAV,FSXPOS
USRCPY: MOVE T1,UNINAM(U) ;NAME OF UNIT
MOVEM T1,CHRBUF ;STORE FOR DSKCHR
MOVE T1,[XWD .UNBPU+1,CHRBUF]
DSKCHR T1, ;FIND OUT ABOUT UNIT
JRST USRCP1 ;NO SUCH UNIT
HRRZ T2,CHRBUF+.UNCHR ;BLOCKS PER CYLINDER
LDB T3,[POINT 9,CHRBUF+.UNCHR,17]
LDB T4,[POINT 3,T1,32] ;UNIT TYPE
TLNE T1,(.UPOFL) ;SKIP UNLESS UNIT OFF LINE
TLOA T4,KOPUHE## ;FLAG THAT ONCMOD EXPECTS
AOS (P) ;ON LINE, SKIP RETURN
MOVE T1,CHRBUF+.UNBPU ;CAPACITY OF UNIT
POPJ P,
USRCP1: MOVSI T4,KOPUHE## ;SET FLAG FOR ONCMOD
TLO T4,KOPNSU## ;NOTE ALSO NO SUCH UNIT
POPJ P, ;RETURN
RPXUPA::
FSXUPA:
FHXUPA:
DPXUPA: MOVEI T1,1 ;RETURN WRITE HEADER LOCKOUT SWITCH OFF
JRST CPOPJ1 ;ALWAYS RETURN KONTROLLER ON LINE
UVACKS::SKIPA T2,T1
DODTI4::
DPXSTS: MOVEI T2,0
POPJ P,
DEFINE CHNCB(N),<
INTERN CHN'N'CB
CHN'N'CB==0
>
CHNCB (\M.CHN)
FHXRCL:
DPXRCL:
FSXRCL:
FHXSTP:
DPXSTP:
FSXSTP:
FHXRED:
DPXRED:
FSXRED:
FHXWRT:
DPXWRT:
FSXWRT:
FHXINT:
DPXINT:
FSXINT:
FHXWTS:
DPXWTS:
FSXWTS:
FHXRDS:
DPXRDS:
FSXRDS:
FHXKON:
DPXKON:
FSXKON:
FHXLTM:
DPXLTM:
FSXLTM:
FH0SAV:FH1SAV:
DP0SAV:DP1SAV:DP2SAV:
FS0SAV:FS1SAV:
FSXWTF:
FHXPOS:
DPXPOS:
FSXPOS:
RPXPOS::DPXRDF::DPXRDC::RPXSTP::DPXERR::FSXWTC::FHXERR::RPXECC::FSXUNL::
FSXECC::FHXECC::RPXERR::FSXERR::RPXKON::FSXRDF::FSXRDC::
FHXUNL::DPXWTC::RPXRED::RPXRDF::RPXRDC::RPXRDS::RPXRCL::FHXRDF::FHXRDC::
RPXLTM::RPXWTF::RPXWTC::RPXWTS::RPXINT::DPXECC::RPXWRT::DPXUNL::rp0sav::RP1SAV::
RP2SAV::FHXWTC::RPXUNL::
SUBTTL ROUTINES TO SATISFY UNNEEDED GLOBAL REQUESTS
INTERN REFLOG,CDVSBT,PDVCNT,HNGSTP,TTYSTR,TTYFUW,TTYFND,PJOBN,SYSSIZ
INTERN PROT,PROT0,GETWD1,GETWDU,HIGHJB,GETJOB,INLMES,COMCHK,LOCOCW,UADCK1
INTERN USRJDA,USRHCU,MQWAIT,MQREQ,MQAVAL,CBAVAL,DAAVAL,CBREQ,DAWAIT
INTERN UUOERR,WSYNC,DEVLST,STOTAC,STOIOS,AUREQ,CBWAIT,AUWAIT,AUAVAL,CVTSBT,OPRLDB
INTERN JBTPPN,JBTADR,JBTNAM,JBTLOC,JBTSTS,JBTSPL,STDIOD,SWPINT,OUT,PUUOAC
INTERN REGSIZ,SETACT,CLRACT,CLOSE1,CLOCK,FREPTR,GET4WD,GIV4WD,GETWDS,GIVWDS
INTERN DEVLG,ADVBFE,IOIERR,JOB,SAVDDL,ADRERR,ADVBFF,SERIAL,WAIT1,USCHED
INTERN STOP1,REMSEG,DSKINI,IADRCK,DVCNSG,RTM1,RTZER,SYSINI,IPOPJ,IPOPJ1
INTERN DPDONE,FHALCL,JBTPRV,SYSINA,STOTC1,GTWST2,PUTWDU,PUTWD1
INTERN TICMIN,TICSEC,LGLPRC,DPXWTF,FHXWTF,ILLOUT
INTERN CHNMPE,CHNDPE,DAEERR,SVEUB,MAPIO,SETINT,RTNIOW,DAFREE,DAUSER,NU0DAC,SVEUF
INTERN CLRBTS,AUFREE,CBFREE,AUUSER,GIVRES,WRDCNT,CBUSER,CHNNXM,HOLD0,WSCHED
INTERN MP3,MPDPRA,MTXCHB,CNIMTS,CNIMTC,CNFMTA,MTXCDB,FLG256
INTERN .C0JOB,SETDVL,PUTWRD,UADRCK,TSETBI,ILLINS,CNOCLR
;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::TYPTAB::TUYKTP::
RPXCPY::DPXCPY::FSXCPY::FHXCPY::
GTWST2:PUTWDU:PUTWD1:DPDONE:FHALCL:JBTPRV:IPOPJ:IPOPJ1:PUUOAC:IADRCK:
STOTC1:DVCNSG:RTM1:RTZER:SYSINI:DSKINI:REMSEG:STOP1:WAIT1:SERIAL:JOB:
SAVDDL:DEVLG:IOIERR:ADVBFE:SYSSIZ:SETACT:CLRACT:CLOSE1:CLOCK:REGSIZ:STDIOD:
SWPINT:OUT:JBTPPN:JBTADR:JBTNAM:JBTLOC:JBTSTS:JBTSPL:USRJDA:USRHCU:UUOERR:
WSYNC:DEVLST:STOTAC:STOIOS:ADRERR: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:DPXWTF:FHXWTF: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::
TTYFND: STOPCD .,HALT,NM4,
INTERN REFLAG,DDSTAR,DAREQ,LOCORE,THSDAT,TIME,ONCEND,RSPWT1,SYSDSP
INTERN DEBUGF,FINISH,SKPCPI,DATE,.C0AEF,MQFREE,T4POPJ
DAFREE:AUFREE:CBFREE:MQFREE:MQWAIT:CBWAIT:DAWAIT:AUWAIT:
PRVJ::
RSPWT1: POPJ P,
T4POPJ: POP P,T4
POPJ P,
REFLAG: BLOCK 1
DDSTAR: 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
.C0AEF: BLOCK 1
FILFLG: BLOCK 1 ;SCRATCH FILE FLAG
TWCFIL: BLOCK 4 ;LOOKUP/ENTER BLOCK FOR SCRATCH FILE
RETRYC: BLOCK 1 ;RETRY COUNTER FOR CREATING SCRATCH FILE
INTERN JOBMAX,K2PLSH
INTERN SKPCPA,MSK22B
IFN M.KA10,<K2PLSH==0
PAGSIZ==:2000>
IFN M.KI10!M.KL10,<K2PLSH==1
PAGSIZ==:1000>
JOBMAX=M.JOB
SKPCPA==0
MSK22B==0
SUBTTL DATA AND STORAGE
LINEP: POINT 7,LINBUF
CHRBUF: BLOCK .UNMAX
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
INTERN ONCPDL
ONCPDL:
PDLIST: BLOCK PDLEN
INTERN PATCH
PATCH: BLOCK 100
END TWICE