1
0
mirror of synced 2026-01-13 07:19:45 +00:00
2010-04-02 15:46:14 +00:00

4458 lines
63 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/SI VERSION 8.24 (01-JANUARY-75)
/
/
/
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/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 PRO-
/VIDED 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 REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR
/RELIABILITY OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT
/SUPPLIED BY DEC.
/SI PAGE 0
FIELD 0 /SI LOADS ONTO DISK TRACK 0
*0
CLA CLL
C6201, CDF /CHANGE TO FIELD ZERO
JMP I .+1
SI1, COM
SKIP= JMS I .
SKIPS
IX1=10
IX2=11
IX3=12
IX4=13
IX5=12
*10
. /IX1
. /IX2
. /IX3
. /IX4
C4000, 4000
C0200, 200
NOPUNCH
*6622
ENPUNCH
DMAR /FOR BOOT-STRAPPING
JMP . /FOR BOOT-STRAPPING
SIDATA=20 /SYSTEM INTERPRETER DATA
*SIDATA
COMPTR, . /POINTER TO LAST DEVTBL ENTRY SCANNED, INITIALIZE TO DEVTBL-1
CONDVA, CONDBA /DEVTBL POSITION OF OUTPUT SIDE
SITCNT, F1TCNT
COMDSP, . /FIP RETURN DISPATCH
SIFLG, . /COMMAND FLAGS
SICHAR, . /SAVE LAST CHAR FROM COMMAND SCAN
SIREG, . /USER AC, LINK, PC
.
.
TTCHAR, . /TTY CHARACTER
CONSTANTS=SIDATA+12
*CONSTANTS
C0002, 2
C0003, 3
C0004, 4
C0007, 7
C0037, 37
C0100, 100
C1000, 1000
C7770, 7770
C0010, 10
JOBCON=CONSTANTS+11 /JOB CONTROL
*JOBCON
JOBTIM, . /-#TICKS REMAINING TO RUN
JOBTBA, JOBTBL /JOB TABLE ADDRESS
C0006, 6
FRSTOR=JOBCON+3
*FRSTOR
FREE, . /POINTER TO HEAD OF FREE STORAGE
FRECNT, . /# FREE BLOCKS AVAILABLE
TIMDAT=FRSTOR+2 /CLOCK AND DATE
*TIMDAT
/CLOCK
CLK2, .
CLK1, .
SCHDAT=TIMDAT+2
*SCHDAT /SCHEDULING DATA
COMCNT, . /NUMBER OF COMMANDS WAITING EXECUTION
FIPDAT=155 /DATA REFERENCED BY FIP
*FIPDAT+1
C0400, 400
SEGSIZ=C0400 /#WORDS PER SEGMENT
FIBASE, SWDEX+JOBMAX /BASE ADDRESS OF ALLOCATABLE DISC STORAGE
JOB, . /# OF CURRENT JOB
JOBDAT, . /ADDRESS OF CURRENT JOB DATA LIST, MUST RESIDE IN DATA FIELD.
CORTBA, CORTBL-1 /CORE ALLOCATION TABLE
DEVTBA, DEVTBL /DEVICE TABLE
DSUTBA, DSUTBL /USER DISC REQUEST QUEUE
DSBUSY, . /DISC BUSY COUNT
/THE DATE IS KEPT AS A 12 BIT NUMBER IN THE FORMAT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1
DATE, .
FISUBL= 400
BLTA, BLT0 /BLOCK TRANSFER
BLT=JMS I BLTA
CORSRA, CORSRC
CORE=JMS I CORSRA
GETBA, GETB
GETBLK=JMS I GETBA
GETDBA, GETDB0 /GET A DATA BLOCK
GETDDB=JMS I GETDBA
PRINTA, PRINT0 /TYPE OUT A CHARACTER
PRINT=JMS I PRINTA
GETJT0, GETJTB /GET JOB DATA TABLE ADDRESS
GETJTA=JMS I GETJT0
KBDA, KBD00 /INPUT KEYBOARD CHARACTERS
KEY=JMS I KBDA
RETBA, RETB /RETURN BLOCK TO FREE STORAGE
RETBLK=JMS I RETBA
WAITA, WSCHED
WAIT=JMP I WAITA
*SCHDAT+1
SIJOB, 0
CHDFA, 0 /TEMP LOC USED BY MANY ROUTINES
CHDF=6221
COMDB0, 0 /ADDRESS OF COMMAND DDB
COMRDB, 0 /RESPONSE DEVTBL ADDRESS
COMBFA, COMBUF-1
COMTBE, 0 /COMMAND TABLE ENTRY ADDRESS
COMFLG, 0 /COMMAND CONTROL FLAGS
IOTPAR, . /IOT PARAMETER BLOCK
IOTP0, 0
IOTP1, 0
IOTP2, 0
IOTP3, 0
IOTP4, 0
IOTP5, 0
IOTP6, 0
IOTP7, 0
CHAR, 0 /CURRENT SCAN CHARACTER
NUMHO, 0 /HIGH ORDER FOR NUMBIN
0
0
TEXTS=JMS I .
CTEXT /ASCII READ
DECRCA, DECRC0 /DECREMENT COMCNT
NUMBIA, NUMBI0 /NUMBER CONVERT
ASCOUA, ASCOU0 /ASCII OUTPUT
ENDTSA, ENDTS0 /TEST FOR END OF COMMAND
COMGEA, COMGE0 /GET COMMAND STRING CHARACTER
COMERA, COMERR /ERROR RETURN
COMEXA, COMRET /OK RETURN
COMEXP, COMRET /FOR RESETTING COMEXA
ASCSIA, ASCSI0 /ASCII TO SIXBIT
GETFBA, GETFB0 /GET FREE BLOCK
GETBAA, GETTB0 /GET JOB TABLE ADDRESS
RETDBA, RETDB0 /RETURN BLOCK
RETBKA, RETBK0 /RETURN BLOCKS
IOTEND, FIPEND
LNGIOT, FOPEN1 /LONG IOT
SHTIOT, ACSET /SHORT IOT
CALFIA, CALFI0 /FIP OVERLAY
RESPDA, RESPDB /GET RESPONSE DDB
EXITA, COMEXT
EXIT=JMP I EXITA
GETWRA, GETWR0 /GET STATUS WORD
OCTASA, OCTAS0 /OCTAL TO ASCII
BUFDEA, BUFDE0 /BUFFER DELETE
RETPAA, RETPA0 /RETURN PARAMETERS
CORES=JMS I .
CORSER
ASSCOR=JMS I .
ASSCO0
RELCOR=JMS I .
RELCO0
TTYTBA, TTYTBL /START OF TTY TABLE
SIERR=JMS I .
SYSER0
SWBASE, SWDEX /START OF SWAPPING TRACKS
ACCTIN= JMS I .
ACC0
P7777, -1
C7700, 7700
JOBONC, -JOBMAX
SIECNT, F1ECNT /DDB EMPTY COUNT
SIBUF, F1BUF /DDB EMPTY POINTER
COMES1, COMLGM
COMWAA, COMDEL
COMWAT=JMP I COMWAA
/SI PAGE DIRECTORY
SCAN=200
SUBR=SCAN+1400
COMMAN=SUBR+1200
CTABLE=COMMAN+3000
ERPAGE=CTABLE+1000
/COMMAND CONTROL FLAGS
NOLOG=4000 /LOGIN NOT REQUIRED
USERM=2000 /REFERENCES USER MEMORY
USAVE=1000 /SAVE USER REGISTERS
UREST=400 /RESTORE USER REGISTERS
PRBUF=200 /PRINT BUFFER
PRQM=100 /PRINT ?
PRPER=40 /PRINT .
PRCRLF=20 /PRINT CRLF
NOMESS=10 /NO MESSAGE
/BITS 9-11 CONTAIN # FREE BLOCKS REQUIRED
*SCAN
DEVTND, -DEVTBE+1
COMSIC=C0100 /SICOM
COMFND=IOTP7 /COUNT OF SEARCH MATCHES
COMLNK=IOTP5
COMNXT=IOTP6
COMSET, RESTBP
COM, TAD I JOB
AND C0037
DCA SIJOB
TAD SIJOB
SZA CLA /FIP RETURN?
JMP COMFIP /YES
TAD I COMPTR
DCA IX1
TAD IX1
DCA IOTP0
DATFLD
COM1, ISZ IX1 /DON'T BOTHER LOOKING AT THE OUTPUT SIDE
TAD DEVTND
TAD IX1
SZA CLA /END OF TABLE?
JMP COM2 /NO
STA
TAD DEVTBA /YES, RESET TO BEGIN OF TABLE
DCA IX1
COM2, TAD I IX1 /GET TABLE ENTRY
SZA
JMP COM3
COM4, TAD IX1 /SCANNED ENTIRE TABLE?
CIA
TAD IOTP0
SZA CLA
JMP COM1 /NO
CDF
DCA I COMCNT
COMEXT, RELCOR /RELEASE COR
CIF CDF
DCA I COMDSP
WAIT /RESCHEDULE
SIWATA, SIWAIT
SITIMA, TIMSI
COM3, DCA COMDB0
TAD I COMDB0 /COMMAND WAITING?
AND COMSIC
SNA CLA
JMP COM4 /NO
TAD COMDB0 /SET JOB #
IAC
DCA COMTBE
TAD I COMTBE
CDF
AND C0037
DCA SIJOB
TAD IX1
DCA I COMPTR
TAD SIJOB
TAD I JOB
DCA I JOB
TAD SIJOB
DATFLD
SNA
JMP COM31
TAD JOBTBA
DCA CHDFA
TAD I CHDFA
COM31, DCA I JOBDAT
TAD I JOBDAT /DO WE HAVE JOB?
SNA
JMP COM33 /NO
IAC
DCA CHDFA /ADDRESS OF STR0
JMS I COMLRA /CHECK FOR RUBOUT AND LINE-FEED
TAD C7367
AND I CHDFA /CLEAR OUT THE R PRIVILEGE & ERROR REPORT INHIBIT BITS
DCA I CHDFA /SAVE IT
COM33, JMS I COMSET /SETUP BUFFER POINTERS
DCA COMRDB
DCA COMFLG
COM32, DCA CHAR
TAD COMBFA /GET COMMAND NAME
TEXTS
CIA
TAD COMBFA /NULL?
SZA CLA
JMP I COM41A
TAD CHAR
SZA CLA
ENDTST /END OF COMMAND?
JMP I COM64A /YES
JMP COM32 /TRY TO FIND A VALID COMMAND
C7367, -JSPEEK-JSINER-1
COM64A, COM64
COMLRA, COMLRB
COM41A, COM41
COMFIP, TAD I COMDSP
SNA
JMP COMFI2
DCA IOTP0
DCA I COMDSP
TAD I SIFLG /RESTORE CONTROL FLAGS.
DCA COMFLG
TAD I SICHAR
DCA CHAR
TAD I COMPTR
DCA COMDB0
DATFLD
TAD I COMDB0
DCA COMDB0
TAD I JOBDAT
SNA
JMP COMFI1
IAC
DCA CHDFA
TAD C0003
TAD I CHDFA
AND C0007 /WAS THERE A SYSTEM DISK ERROR?
SZA CLA
COMFI1, ISZ IOTP0
CHDF
JMP I IOTP0
COMFI2, CHDF
JMP I .+1
SYSERR
COMDEL, CDF /SI MUST WAIT FOR SOME REASON
TAD I COMCNT /NUMBER OF COMMANDS LEFT TO DO
TAD I SIWATA /PLUS THOSE ALREADY WAITING
DCA I SIWATA
DCA I COMCNT /WE'LL RELOAD THE COUNT WHEN THE TIMER RUNS OUT
STA
DCA I SITIMA /WAIT FOR ONE SECOND
EXIT
PAGE
COMTBA, COMTBL
COM9A, COM9
COM91A, COM91
COM41, DCA COMFND /SEARCH COMMAND TABLE
TAD COMTBA
COM6, DCA COMLNK
TAD I COMLNK
SNA
JMP I COM9A /END OF TABLE
DCA COMNXT
TAD COMLNK
TAD C0003
DCA IX2
TAD COMBFA
DCA IX3
COM5, TAD IX2
CMA
TAD COMNXT
SNA CLA
JMP COM99 /EXACT MATCH
TAD I IX3
SNA
JMP COM8
TAD I IX2
SNA CLA
JMP COM5
JMP COM7
COM8, ISZ COMFND /PARTIAL MATCH
TAD COMLNK
DCA COMTBE
COM7, TAD COMNXT
JMP COM6
COM99, TAD I IX3
SNA CLA
JMP I COM91A /EXACT
JMP COM7
COMECH, DECHO
COMLBT, -SICOM-DECHO-1
COMPST, STRNG0
COMPNT, RESTBP
COMLRB, 0
TAD I COMDB0
AND COMECH
SNA CLA
JMP I COMLRB
JMS I COMPNT
DCA CHAR
DCA COMRDB
DCA COMFLG
JMS I COMPST
ASCOUT
CRLF
NOP
GETWRD
JOBSTS
SPA CLA
JMP COMLRR
ASCOUT
PERIOD
NOP
COMECC, ASCOUT
VERBRK
NOP
DATFLD
TAD COMLBT
AND I COMDB0
DCA I COMDB0
DECRCT
EXIT
COMLRR, ASCOUT
CB
NOP
JMP COMECC
CB, "^
"B
0
SWITCH, TAD JBSWR
RESTRT, TAD JBSRA
DCA .+2
GETTBA
0
JMP BRK0
JBSWR, JOBSWR-JOBSRA
JBSRA, JOBSRA
BREAK, TAD COMDB0 /DDB ADDRESS
TAD C0002
BRK0, DCA IOTP1 /POINTER TO APPROPRIATE REGISTER
ENDTST /ARGUMENT?
SKP /NO; TELL HER WHAT IT IS
JMP BRK1 /YES, NEW VALUE FOR MASK
DATFLD
TAD I IOTP1 /GET BREAK MASK
CHDF
OCTASC /CONVERT TO ASCII
IOTP2 /STORE IN IOTP3,4,5,6,7
ASCOUT /OUTPUT A CRLF
CRLF
NOP
ASCOUT
IOTP3
NOP
JMP I COMEXA
BRK1, NUMBIN
-267
JMP I COMERA /INVALID CHARACTER IN STRING
DATFLD
DCA I IOTP1
JMP I COMEXA
STARS, 215;212;"*;"*;"*;240;0
FM5400, "B;"A;"D;240;"D;"I;"R;"E;"C;"T;"O;"R;"Y;0
/ROUTINE TO SEE IF JOB IS RUNNING WHEN COMMAND REQUIRING FIP IS ISSUED.
/IF SO, WE CAN'T HONOR COMMAND
/THE MESSAGE "TYPE ^BS FIRST" IS GIVEN
/CALL TAD IOT ENTRY FROM COMMAND TABLE
/ JMS FIPCHK
/ RETURN IF OK TO PROCEED [OTHERWISE RETURN IS TO COMEXT]
/ IF NOT RUNNING BUT JOB IS BUSY WITH FIP OR FILE I/O, EXIT VIA COMWAT
FIPCHK, 0
DCA IOTP0 /SAVE THE IOT
GETWRD /IT'S A CALL TO FIP; IS HE RUNNING?
JOBSTS /IF SO HER RUN BIT IS ON
SPA
JMP FIPCH2 /HE'S TURNED ON SO DON'T HONOR COMMAND
AND C0140 /DOES HE STILL HAVE A FIP REQUEST IF HER OWN PENDING?
SZA CLA
COMWAT /YES DON'T CONFUSE THE ISSUE
ISZ IOTP7
DATFLD
TAD I IOTP7 /STR1
RAR
CMA RAL
ISZ IOTP7
ISZ IOTP7
AND I IOTP7 /WAIT MASK 1
AND FILES
CHDF
CLL RAR
SNA SZL CLA /IS HE WAITING FOR A FILE TRANSFER?
JMP I FIPCHK /NO; SO LET HER PROCEED
COMWAT /WAIT FOR THINGS TO COOL OFF
FIPCH2, CLA
TAD IOTP0
SPA
AND C0010 /EITHER FINF, DMAR, OR DMAW
SNA CLA
JMP I FIPCHK /WANTS TO EXAMINE OR DEPOSIT
TAD COMFLG
AND P7377 /DON'T RESTORE REGISTERS SINCE THEY ARE NOT SAVED
DCA COMFLG
TAD FIPTCB
JMP I COMEXA /"TYPE ^BS FIRST"
FIPTCB, TYCRLB
C0140, JSIOT JSIOTC
P7377, 7377
FILES, JSF0 JSF1 JSF2 JSF3 JSWAIT
WAIT1, TAD I DTJOBA
CIA
TAD SIJOB /DOES HE CURRENTLY OWN THE CONTROLLER, OR IS HE JUST WAITING IN THE QUEUE
SNA CLA
JMP I COMEXA /HE OWNS IT - DON'T BOTHER HER
JMP I .+1 /GO DO THE STUFF COMMON WITH THE RK05
DTSIDT
K5, 5
WAIT2, TAD I IOTP7 /GET POINTER TO HER TIMER
TAD K5
DCA CHDFA
STA
DCA I CHDFA /SET HER TIMER=1 SECOND
STA
TAD SIJOB
TAD JOBTBA
CIF DATFLD
JMP I .+1 /FORCE THE TIMER TO RUN - JUST FOR HER JOB
DTSI
DTJOBA, DTJOB
ACCBUF, " ;" ;"[;0;0;0;0;0;"];0
SYSET6, "H /HUNG DEVICE
"U
"N
"G
240
"D
"E
"V
"I
"C
"E
SYRING, 207;207;207
0
*724 /DO NOT MOVE ANYTHING IN THIS AREA
/IT IS VITAL FOR BOOT-STRAPPING
NOPUNCH
*7730 /THIS IS WHERE IT WILL ACTUALLY EXECUTE
ENPUNCH
IFZERO RF08 <
TRBOOT, 2
FLBOOT, 20
GOBOOT, DCMA
CLA
TAD FLBOOT
DIML
TAD TRBOOT
DXAL
>
IFZERO RF08-40 <
NOP;NOP;NOP /FOR SIZE
TRBOOT, 220
GOBOOT, DCMA
CLA
TAD TRBOOT
DEAL
>
STA
DCA CABOOT
DCA WCBOOT
DMAR
DFSC
JMP .-1
CIF CDF 20
JMP 0
WCBOOT, -3 /READ 3 WORDS AFTER OVERLAYING ITSELF
CABOOT, 6621 /OVERLAY OUR CURRENT "JMP ." WE'RE EXECUTING AT 6623
NOPUNCH
*6622
ENPUNCH
GOBOOT
JMP I .-1
*750
GETACC, 0
TAD JOBTBA
CIF
GETJTA
JOBACC
DCA CHDFA
DATFLD
TAD I CHDFA
CHDF
OCTASC
ACCBUF+2
TAD ACCBUF+6
DCA ACCBUF+7
TAD ACCBUF+5
DCA ACCBUF+6
TAD ACOMMA
DCA ACCBUF+5
JMP I GETACC
ACOMMA, ",
SYBELL, ASCOUT
SYRING
NOP
EXIT
CUSERM=CLA CLL CML RTR /AC =2000
COM9, STA
TAD COMFND
SZA CLA
JMP COM99A /NOT UNIQUE OR NOT FOUND
JMP COM91Z
FIPCOM, FIPCHK
COM91, TAD COMLNK
DCA COMTBE
COM91Z, ISZ COMTBE /GET COMMAND FLAGS
TAD I COMTBE
DCA COMFLG
TAD COMFLG /ENOUGH FREE STORE?
AND C0007
CIA
CDF
TAD I FRECNT
CHDF
SPA CLA
COMWAT /NO
CUSERM /AC=2000
AND COMFLG /USER MEMORY REFERENCE?
SNA CLA
JMP COM16 /NO
STL RAR /AC=SWAP
TAD SIJOB /YES, IS USER BEING SWAPPED?
CORES
SZA CLA
COMWAT
COM16, ISZ COMTBE
TAD SIJOB
SZA CLA
TAD I COMTBE /STORE IOT
SZA /NON RESIDENT IOT?
JMS I FIPCOM /YES--IS HE RUNNING A PROGRAM?
TAD IOTPAR
DCA IX1
TAD C7770
DCA CHDFA
TAD I COMTBE /FIX UP IOTP0
DCA I IX1
ISZ CHDFA
JMP .-2
ISZ COMTBE
TAD I COMTBE
DCA COMTBE
TAD COMFLG
SPA CLA /LOGIN REQUIRED?
JMP I COMTBE /NO, DISPATCH
TAD SIJOB
SNA CLA /NULL JOB?
JMP I COM12A
TAD COMFLG /SAVE REGISTERS?
AND C1000
SNA CLA
JMP I COMTBE /NO, DISPATCH
GETTBA
JOBREG
DCA COMREG
CIF
BLT
DATFLD
COMREG, 0
CDF
SIREG
-3
DATFLD /PC=-1
STA
DCA I COMREG
CHDF
JMP I COMTBE
COM12A, COM12
COM99A, TAD SIJOB /IS HE LOGGED IN?
SNA CLA
TAD COMES1 /NO, SO SEND "LOGIN PLEASE"
JMP I COMERA
CALFIP=JMP I CALFIA
CALFI0, STA CLL RAL /SAVE RETURN ADDRESS
TAD COMTBE
CDF
DCA I COMDSP
TAD COMFLG /SAVE FLAGS
DCA I SIFLG
TAD CHAR
DCA I SICHAR
TAD CALFBA
LOADUS, DCA CALFI2
CHDF
TAD CALFI4
TAD DSUTBA
GETFBL
COMWAT
DCA CALFI1
ASSCOR
CIF CDF
TAD SIJOB
TAD C0200
DCA I JOB
CHDF
BLT
CHDF
OFF5, /SOURCE FIELD
CALFI2, 0 /SOURCE ADDR
DATFLD /DESTINATION FLD
CALFI1, 0 /DESTINATION ADDR
-10
CIF CDF
ISZ I DSBUSY
WAIT
JMP I .+1
OVRLA1
DEPEXA, TAD CALFI5
JMP LOADUS
CALFI5, IOTP0
CALFBA, .+1
DMAR
FIPDEX
CALFI4, 10 /MEMORY EXT IN 7-9
-FIPWC
-1
0
OVERLA
0
OFF3A, ACTNM1
OFF4, 7774 /ALLOW ONLY ACCOUNTS 1, 2 & 3 TO LOGIN
OFFJOB, F1OFFJ
OFFLIN, TAD OFF4
ON, DCA OFF5
JMS I OFF3A /CHECK ACCOUNT NUMBER
TAD OFF5 /.. 0 IF ON
DATFLD
DCA I OFFJOB /STORE IT IN FIELD 1
JMP I COMEXA /RETURN
COMFLE, PRQM+PRBUF
COPRBF, PRBUF
COMESF, NOMESS
COMQM, PRQM
COMCRF, PRCRLF
COMELF, PRPER+PRCRLF
CO18A, COM18
COMURE, UREST
COMURM, -UREST-1
MSEMI, -273
MCR, -215
COM12, TAD COMFLG
AND COMURM
DCA COMFLG
TAD COMES1
COMERR, DCA COMESA
TAD COMFLG
AND C7700
TAD COMELF /SET FLAGS FOR ERROR MESSAGE
DCA COMFLG
TAD COMESA
SZA CLA
JMP COMRET+1
TAD COMFLE
TAD COMFLG
SKP
COM64, TAD COMELF
DCA COMFLG
COMRET, DCA COMESA
CHDF
TAD COMFLG /RESTORE REGISTERS
AND COMURE
SNA CLA
JMP COMRE0
GETTBA
JOBREG
DCA .+6
CIF
BLT
CDF
SIREG
DATFLD
0
-3
COMRE0, TAD COMFLG /MESSAGE?
AND COMESF
SZA CLA
JMP COM10 /NO
ASCOUT
CRLF
NOP
TAD COMFLG
AND COPRBF
SNA CLA /PRINT BUFFER?
JMP COMRE3 /NO, DELETE COMMAND
JMS I CORSET /YES, RESTORE BUFFER POINTER
COMRE1, COMGET /GET A CHAR
JMP COMRE3 /NONE
STL RTL
ENDTST /LAST CHARACTER OF COMMAND LINE?
JMP COMRE3 /YES; DON'T ECHO THIS ONE
RESDDB
CIF CDF
DCA I CONDVA
TAD CHAR
DCA I TTCHAR
CHDF
PRINT
JMP COMRE1
JMP COMRE1
COMRE3, SKPCOM /SKIP TO END OF COMMAND
NOP
BUFDEL /DELETE TO CURRENT POINTER
TAD COMESA
SNA CLA
JMP COM11
ASCOUT /OUTPUT MESSAGE
COMESA, 0
JMP COM10 /WON'T FIT
COM11, TAD COMFLG /PRINT ??
AND COMQM
SNA CLA
JMP COM13 /NO
ASCOUT
QQEST
JMP COM10
COM13, TAD COMFLG /PRINT CRLF?
AND COMCRF
SNA CLA
JMP COM10
ASCOUT
CRLF
NOP
COM10, TAD CHAR
TAD MSEMI
SNA CLA
JMP I COM22A
DECRCT /DECREMENT COMCNT
JMP I CO18A /YES
COM22A, COM22
CORSET, RESTBP
LOGIF2, DCA .+4 /SAVE POINTER TO TIME ASCII STRING
TAD COMEXP /RESTORE COMRET
DCA COMEXA
ASCOUT /OUTPUT TIME MESSAGE
0
JMP I COMEXA /NO ROOM, SO DON'T PROCEED
TAD CHAR /ENDED WITH RETURN?
TAD MCR
SNA CLA
TAD VERBRA /YES, SO OUTPUT MESSAGE OF THE DAY
JMP I COMEXA /DONE AT LAST
VERBRA, VERBRK-2
SKPCOA, SKPCO0 /SKIP TO END OF COMMAND
SKPCOM=JMS I SKPCOA
LOGE0, "A;"L;"R;"E;"A;"D;"Y;240;"L;"O;"G;"G;"E;"D;240;"I;"N;0
COMMSI, -SICOM-DECHO-1
COMPF, PRPER
COMCLN, -272
COMKEY, -JSDEL-1
COMKEF= C0100
COM18, DATFLD
TAD COMDB0 /JOB DEFINED?
SNA /HAS HE JUST LOGGED OUT?
JMP COM22
IAC
DCA CHDFA
TAD I COMDB0
AND COMMSI
DCA I COMDB0
TAD I CHDFA
AND C0037
SNA CLA
JMP COM17 /NO
CHDF
GETWRD
JOBSTS
DATFLD
SMA CLA /IS JOB RUNNING?
JMP COM20 /NO
TAD I COMDB0
AND COMSIF
DCA I COMDB0 /SAVE WITH FLAG CLEARED
TAD COMPF
CMA
AND COMFLG
DCA COMFLG
ISZ IOTP7
TAD CHAR
TAD COMCLN
SZA CLA
JMP COM21
TAD I IOTP7
AND COMKEY
TAD COMKEF
DCA I IOTP7
COM21, STL RTL
TAD IOTP7
DCA NUMHO
IAC
TAD NUMHO
DCA NUMHO+1
TAD I NUMHO+1
SNA
TAD I NUMHO
SZA CLA
JMP COM19
ISZ I NUMHO
TAD I IOTP7
RAR
STL RAL
DCA I IOTP7
COM19, TAD CHAR /GET TERMINATING CHARACTER
TAD MCRS
SZA CLA /WAS IT CR
JMP COM22 /NO; LEAVE OUTPUT MODE AS IS
RESDDB /DETERMINE DEVTBL ADDRESSES FOR THIS TERMINAL
STA
TAD COMRDB
DCA QON /SAVE KEYBOARD DEVTBL POINTER
DATFLD
TAD I COMRDB /GET ADDRESS OF OUTPUT DDB
DCA IOTP7
TAD I IOTP7
SMA CLA /^S MODE?
JMP COM22 /NO
TAD CTRLQ /YES; FORCE A ^Q THROUGH THE INPUT ROUTINES
CIF CDF 00
DCA I TTCHAR
CHDF
KEY /PUSH IT THRU
QON, .-. /DEVTBL ADDRESS
CTRLQ, "Q-100 /"KEY" CAN'T FAIL
COM22, CLA
CHDF
TAD COMFLG
AND COMPF
SNA CLA
EXIT
ASCOUT
PERIOD
EXIT
EXIT
COM20, CIF 00
TAD COMDB0
JMS I SICLRA
JMP COM19
COMSIF, -DSI-1
COM17, CIF CDF 00
TAD I COMPTR /DELETE THE INPUT DDB SINCE WE'RE DONE
DCA CHDFA
DATFLD
DCA I CHDFA
TAD COMDB0
JMS I SICLRA
TAD COMDB0
RETDBL
JMP COM22
MCRS, -215
SICLRA, SICLR
/ROUTINE TO GET TEXT STRING FROM USERS INPUT BUFFER TO LAST PAGE
/OF SI, WHERE THEY STORE LOGIN MESSAGE
/CALL JMS STRNG0
/ RETURN
STRNG0, 0
TAD STRBRK /SET UP POINTERS
DCA IOTP0 /POINTS TO START OF BUFFER
TAD IOTP0
DCA IOTP1 /POINTS TO END OF BUFFER
SKIP /SKIP SPACES AND TABS
JMP STREND /END OF INPUT BUFFER REACHED
STRNG1, TAD CHAR /SAVE CHARACTER IN BUFFER
DCA I IOTP1
ISZ IOTP1 /READY FOR NEXT CHARACTER
SKP
JMP I COMERA /HOW COULD HE TYPE SO MUCH?
COMGET /GET ANOTHER CHARACTER
JMP STREND /NONE
JMP STRNG1 /AND LOOK AT IT
STREND, DCA I IOTP1 /END THE STRING
JMP I STRNG0 /RETURN
STRBRK, VERBRK
*SUBR
/GET A TEXT STRING
/CALL TAD ADDRESS OF BUFFER -1
/ TEXTS
/ RETURN WITH POINTER TO LAST CHAR IN AC
CTEXA, -241
CTEXZ, -340
CTEXCN, -272
CTEX6, -6
CTEXBF, 0 /BEGIN OF BUFFER
CTEXNU, 0 /NUMBER OF CHARACTERS
CTEXT, 0
DCA IX1 /INITIALIZE INDEX
TAD IX1
CIA
DCA CTEXBF
DCA CTEXNU
SKIP /SKIP SPACES AND TABS
JMP CTEXT4
CTEXT3, TAD CHAR
TAD CTEXCN
CLL RAR
SNA CLA /COLON OR SEMICOLON?
JMP CTEXT4 /YES
TAD CHAR /NO
TAD CTEXA
SPA CLA
JMP CTEXT4 /NO
TAD CHAR
TAD CTEXZ
SMA CLA
JMP CTEXT4 /NO
TAD CTEXNU /STORE CHARACTER
TAD CTEX6
SMA CLA
JMP .+3
TAD CHAR
DCA I IX1
ISZ CTEXNU
COMGET /GET ANOTHER CHAR
SKP /NONE
JMP CTEXT3
CTEXT4, DCA I IX1 /CLEAR NEXT POSITION
STA
TAD IX1
JMP I CTEXT
/SKIP LEADING SPACES AND TABS
/CALL JMS SKIPS
/ BUFFER EMPTY
/ NORMAL RETURN
SKISPA, -240
SKITAB, -211
SKIPS, 0
JMP .+3
SKIPS1, COMGET
JMP I SKIPS /NONE LEFT
TAD CHAR
SNA
JMP .-4
TAD SKISPA
SNA CLA
JMP SKIPS1
TAD SKITAB
TAD CHAR
SNA CLA
JMP SKIPS1
ISZ SKIPS
JMP I SKIPS
/GET A CHARACTER FROM COMMAND STRING
/CALL COMGET
/ NONE LEFT
/ RETURN WITH CHARACTER IN CHAR
TC7766, 7766
TC7400, 7400
C0377, 377
COMGET=JMS I COMGEA
COMGE0, 0
CLA
DATFLD
TAD I SITCNT
SNA
JMP COMGE3
ISZ COMGE0
CIA
CMA
DCA I SITCNT
ISZ I SIECNT
JMP COMGE1
TAD TC7766
DCA I SIECNT
TAD I SIBUF
DCA COMGT1
TAD I COMGT1
DCA I SIBUF
COMGE1, TAD I SIECNT
TAD C0003
SMA
STL RAL
SPA
STL CIA
TAD I SIBUF
DCA COMGT1
TAD I COMGT1
SZL
JMP COMGE2
AND TC7400
DCA COMGT2
ISZ COMGT1
TAD I COMGT1
AND TC7400
CLL RTR
RTR
TAD COMGT2
RTR
RTR
COMGE2, AND C0377
DCA CHAR
COMGE3, CHDF
JMP I COMGE0
/GET A FREE BLOCK AND RETURN ITS ADDRESS
/CALL TAD FIELD 1 LINK
/ GETFBL
/ NONE AVAILABLE
/ ADDR IN AC
GETFBL=JMS I GETFBA
COMGT1,
GETFB0, 0
DCA CHDFA
TAD CHDFA
CIF
GETBLK
JMP I GETFB0
DATFLD
TAD I CHDFA
CHDF
ISZ GETFB0
JMP I GETFB0
/SEARCH FOR JOB IN CORE
/CALL TAD SEARCH ITEM
/ CORES
/ RETURN WITH CORE ARG IN AC
COMGT2,
CORSER, 0
CIF
CORE
SWAP SI CJOB
CLA
JMP I CORSER
JOBNO, "J;"O;"B;240;0
KSPACE, 240;240;"K;0
/NUMBER INPUT
/CALL NUMBIN
/ -N N=7,9 IN ASCII
/ NOT A NUMBER
/ # IN AC
NUMBIN=JMS I NUMBIA
ASCOT0,
NUMSGN, 0 /SIGN
NUMAGN=NUMHO+1 /MAGNITUDE
ASCOT1,
NUMCNT, 0 /DIGIT COUNT
NUMCOM, 240-254 /" "-","
NUMPLS, -253 /+
NUMINU, -255 /-
NUMZER, -260
NUMM5, -5
NUMB17, 17
NUMDSP, JMP NUMDEC
NUMBI0, 0
TAD I NUMBI0 /SET CONVERSION DISPATCH
AND C0002
SNA CLA
TAD C0010
TAD NUMDSP
DCA NUMDEC-1
DCA NUMSGN /INITIALIZE
DCA NUMAGN
DCA NUMHO
DCA NUMCNT
SKIP /SKIP SPACES AND TABS
JMP NUMBI4 /BUFFER EMPTY
TAD CHAR
TAD NUMPLS /+?
SNA CLA
JMP NUMBI1 /YES
TAD CHAR
TAD NUMINU /-?
SZA CLA
JMP NUMBI2 /NO
ISZ NUMSGN
NUMBI1, COMGET /GET A CHARACTER
JMP NUMBI3
NUMBI2, TAD CHAR
TAD NUMZER
SPA CLA /DIGIT?
JMP NUMBI3 /NO
TAD CHAR
TAD I NUMBI0
SMA SZA CLA
JMP NUMBI3
TAD CHAR
AND NUMB17
DCA CHDFA
ISZ NUMCNT
TAD NUMCNT /MORE THAN 4 DIGITS?
TAD NUMM5
SPA CLA
JMP NUMBI5 /NO
TAD NUMHO /SHIFT HIGH ORDER
CLL RTL
RAL
AND C7770
DCA NUMHO
TAD NUMAGN
CLL RTL
RTL
AND C0007
TAD NUMHO
DCA NUMHO
NUMBI5, TAD NUMAGN
CLL RTL
RAL
AND C7770
.
NUMDEC, CLL
TAD NUMAGN
SZL
ISZ NUMHO
CLL
TAD NUMAGN
SZL
ISZ NUMHO
CLL
TAD CHDFA
SZL
ISZ NUMHO
DCA NUMAGN
JMP NUMBI1
NUMBI3, TAD C7540 /-SPACE
TAD CHAR /WAS TERMINATOR A SPACE?
SNA
JMP NUMBI6 /YES, OK
TAD NUMCOM /NO- IS IT A ","
SNA CLA
JMP NUMBI6 /YES
ENDTST /NO--WAS IT AN ACCEPTABLE END CHAR?
SKP /YES, OK
JMP NUMBI4 /NO, COMPLAIN
NUMBI6, TAD NUMCNT /ANY VALID DIGITS IN STRING?
SNA CLA
JMP NUMBI4 /NOPE
ISZ NUMBI0 /YES, IT WAS A VALID STRING.
TAD NUMSGN
CLL RAR
CLA
TAD NUMAGN
SZL
CIA
NUMBI4, ISZ NUMBI0
JMP I NUMBI0
C7540, -240 /-SPACE
/OUTPUT ASCII MESSAGE
/CALL TAD ADDR OF DEVTBL ENTRY OR 0 IF RESPONSE DDB
/ ASCOUT
/ POINTER TO MESSAGE (TERMINATED BY 0
/ WON'T FIT
/ OK
ASCOUT=JMS I ASCOUA
ASCOU0, 0
SNA
RESDDB
ASCOU3, CDF
DCA I CONDVA
CHDF
TAD I ASCOU0
DCA ASCOT1
ISZ ASCOU0
ASCOU1, TAD I ASCOT1 /GET NEXT CHAR
SNA /END OF STRING
JMP ASCOU2 /YES
CIF CDF /NO, STORE IT IN BUFFER
DCA I TTCHAR
CHDF
PRINT
JMP I ASCOU0 /WON'T FIT
ISZ ASCOT1
JMP ASCOU1
ASCOU2, ISZ ASCOU0
JMP I ASCOU0
*SUBR+400
/GET JOB TABLE ADDRESS
/CALL GETTBA
/ RELATIVE ADDRESS
/ RETURN
GETTBA=JMS I GETBAA
GETTB0, 0
CHDF
TAD I GETTB0
DCA GETTB1
ISZ GETTB0
TAD JOBDAT
CIF
GETJTA
GETTB1, 0
JMP I GETTB0
/GET RESPONSE DEVTBL ADDRESS
/CALL RESDDB
/ ADDR IN AC AND COMRDB
RESDDB=JMS I RESPDA
RESPDB, 0
CDF
IAC
TAD I COMPTR
DCA COMRDB
TAD COMRDB
CHDF
JMP I RESPDB
/DELETE BUFFER TO CURRENT POINTER
/CALL JMS BUFDEL
/ RETURN
BUFDEL=JMS I BUFDEA
BUFDT0, 0
BUFDE0, 0
TAD COMDB0
SNA
JMP I BUFDE0 /NO, NOTHING TO DELETE
TAD C0004
DCA BUFDT0
DATFLD
TAD I BUFDT0
SNA CLA
JMP BUFDE3
TAD COMDB0
TAD C0007
DCA BUFDT0
BUFDE1, TAD I SIBUF
CIA
TAD I BUFDT0
SNA CLA
JMP BUFDE2
TAD I BUFDT0
CHDF
RETDBL
DATFLD
DCA I BUFDT0
JMP BUFDE1
BUFDE2, TAD C0003
TAD COMDB0
DCA IX1
TAD I SITCNT
SNA
JMP BUFDE4
ISZ IX1
DCA I IX1
TAD I SIECNT
DCA I IX1
BUFDE3, CHDF
JMP I BUFDE0
BUFDE4, TAD I BUFDT0
CHDF
RETBKS
DATFLD
DCA I IX1
DCA I IX1
DCA I IX1
DCA I IX1
CHDF
JMP I BUFDE0
/DECREMENT COMCNT
/CALL DECRCT
/ RETURN
DECRCT=JMS I DECRCA
DECRC0, 0
CDF
STA
TAD I COMCNT
SPA
CLA
DCA I COMCNT
CHDF
JMP I DECRC0
ASSIND, "A;"S;"S;"I;"G;"N;"E;"D;0
S3757, 3757
S, GETWRD
JOBSTS
DATFLD
AND S3757 /TURN OFF HER RUN BIT
DCA I IOTP7
CHDF
IFNZRO TC01+RK05+CDR <
GETWRD
JOBWMK+1
DATFLD
AND C0007
TAD .+3
DCA .+1
.-.>
JMP I .+1
SEXIT /NO WAIT 2 CONDITIONS TAKE S EXIT
IFNZRO TC01+RK05+CDR <
IFNZRO TC01 <
WAIT1 /DECTAPE CONTROLLER WAIT
WAIT2> /DECTAPE TIMER WAIT
IFZERO TC01<
SEXIT
SEXIT>
IFNZRO RK05 <
WAIT3> /WAITING FOR THE RK05
IFZERO RK05 <
SEXIT>
IFNZRO CDR <
SEXIT> /NOTHING SPECIAL FOR THE CARD READER AT THIS TIME
IFZERO CDR <
SEXIT>
SEXIT
SEXIT
SEXIT>
SEXIT, JMP I COMEXA
SPACES, " ;" ;" ;" ;0
IFZERO MQREG-1 <
WHERMQ, 240 /SP MQ=
315
321
275
0 >
/RUN USER PROGRAM "LOGOUT" TO DELETE FILES FOR THIS GUY
/"LOGOUT" ISSUES USER LOUT IOT TO MAKE JOB GO AWAY
JMP I LOGRER /SYSTEM ERROR ON OPEN
JMP I LOGR1 /"LOGOUT" SAVE FILE OPENED
LOGOUT, TAD LOGMA /GET POINTER TO "LOGOUT" STRING
JMP I .+1 /USER CODE FROM "SYSTAT" TO FINISH UP
SYSTAT+1
LOGRER, RERR
LOGR1, R1
LOGMA, LOGOMA-1
*SUBR+600
/ASCII TO SIXBIT CONVERT
/CALL ASCSIX
/ SOURCE-1 (TERMINATED BY 0)
/ DESTINATION-1
/ RETURN
ASCSIX=JMS I ASCSIA
ASC240, -240
ASCSI0, 0
TAD I ASCSI0
DCA IX1
ISZ ASCSI0
TAD I ASCSI0
DCA IX2
ISZ ASCSI0
ASCSI1, TAD I IX1
SNA
JMP I ASCSI0 /THAT'S ALL
TAD ASC240 /CONVERT TO SIXBIT
CLL RTL /NO
RTL
RTL
DCA CHDFA
TAD I IX1
SNA
JMP ASCSI2
TAD ASC240
TAD CHDFA
DCA I IX2
JMP ASCSI1
ASCSI2, TAD CHDFA
DCA I IX2
JMP I ASCSI0
/SKIP TO END OF COMMAND
/CALL SKPCOM
/ EMPTY BUFFER
/ NORMAL RETURN
SKPCO0, 0
SKPCO1, ENDTST /END?
JMP SKPCO2 /YES
COMGET /NO, GET NEXT CHAR
JMP I SKPCO0 /NONE
JMP SKPCO1
SKPCO2, ISZ SKPCO0
JMP I SKPCO0
/RETURN BLOCK TO FREE STORAGE
/CALL TAD ADDR OF BLOCK
/ RETDBL
/ RETURN
RETDBL=JMS I RETDBA
RETDB0, 0
CIF
RETBLK
JMP I RETDB0
/RETURN LINKED BLOCKS TO FREE STORAGE
/CALL TAD ADDRESS OF BLOCK
/ RETBKS
/ RETURN
RETBKS=JMS I RETBKA
RETBK0, 0
SNA
JMP I RETBK0
RETDBL
JMP .-3
/OCTAL TO ASCII CONVERT
/CALL TAD OCTAL #
/ OCTASC
/ BUFFER ADDR-1
/ RETURN
OCTASC=JMS I OCTASA
OCTASN=ASSCO0
OCTACT=RELCO0
OCT260, 260
OCTAS0, 0
DCA OCTASN
TAD C0004
CIA
DCA OCTACT
TAD I OCTAS0
DCA IX1
ISZ OCTAS0
TAD OCTASN
CLL RAL
SKP
OCTAS1, TAD OCTASN
RTL
RAL
DCA OCTASN
TAD OCTASN
AND C0007
TAD OCT260
DCA I IX1
ISZ OCTACT
JMP OCTAS1
DCA I IX1
JMP I OCTAS0
/ASSIGN THIS FIELD TO JOB
/CALL ASSCOR
ASSCO0, 0
CDF
TAD I JOB
DCA I SICORE
CHDF
JMP I ASSCO0
/RELEASE THIS FIELD
/CALL RELCOR
SICORE, CORTBL+1
RELCO0, 0
CDF
TAD C0200
DCA I SICORE
CHDF
JMP I RELCO0
ASSIG9, ASCOUT /TELL USER WHAT HE GOT
CRLF
NOP
JMS ASSUNI
ASCOUT
ASSIND /TYPE "ASSIGNED"
C0260, 260
JMP I COMEXA /AND LEAVE
ASSOUT, 0 /TYPE CHARACTER IN AC OUT;
CIA /FOLLOWED BY SPACE
DCA ASSBUF /CALLED WITH - CHAR IN AC
ASCOUT
ASSBUF /TYPE STRING
NOP
JMP I ASSOUT
ASSUNI, 0 /ROUTINE TO TYPE OUT UNIT NAME
GETWRD /FIRST FIGURE OUT WHAT HE WANTED
JOBREG /PC CONTAINS ORIGINAL REQUEST
AND C0037
DCA IOTP0 /DEVICE #
TAD IOTP0 /WHAT KIND OF DEVICE
TAD C7773 /-5
SPA /DEVICE #'S .GE. 5 ARE DTA
JMP ASSG10 /NOT DTA
DCA IOTP0 /UNIT #
TAD IOTP0
AND C7770
SNA CLA
TAD C0007
TAD ASSDK
JMS ASSOUT /TYPE "D SPACE" (or K space)
TAD IOTP0
AND C0007
TAD C0260
CIA
ASSG11, JMS ASSOUT /TYPE "N SPACE"; N=0,1,...,7
JMP I ASSUNI /RETURN
ASSG10, TAD ASSTBZ /END OF ASSIGNMENT TABLE
DCA IOTP0 / +UNIT # -5 = PTR TO ASSTBL
TAD I IOTP0
JMP ASSG11 /TYPE OUT DEVICE ASSIGNED
ASSDK, -"K
C7773, 7773
ASSTBZ, ASSD
ASSBUF, 0
240
0
*SUBR+1000
/SIXBIT TO ASCII CONVERT
/CALL JMS SIXASC
/ SIXBIT ADDR (TERMINATED BY 0 OR SIXTH CHAR)
/ ASCII BUFFER-1
/ RETURN
SIXM6, -3
SIXCNT, 0
SIXADR, 0
SIX240=WHERLK
C0077, 77
SIXASC, 0
SNA
TAD SIXM6 /COUNT
DCA SIXCNT
TAD I SIXASC
DCA SIXADR
ISZ SIXASC
TAD I SIXASC
DCA IX2
ISZ SIXASC
SIXAS2, TAD I SIXADR
AND C7700
SNA
JMP SIXAS1
CLL RTR
RTR
RTR
TAD SIX240
DCA I IX2
TAD I SIXADR
AND C0077
SNA
JMP SIXAS1
TAD SIX240
DCA I IX2
ISZ SIXADR
ISZ SIXCNT
JMP SIXAS2
SIXAS1, DCA I IX2 /CLEAR LAST WORD
JMP I SIXASC
/RETURN PARAMETERS
/CALL RETPAR
/ RETURN
RETPAR=JMS I RETPAA
RETPA0, 0
GETWRD
JOBLNK
IAC
DCA RETPA1
CIF
BLT
DATFLD /SOURCE FLD
RETPA1, 0 /SOURCE ADDR
CHDF /DESTINATION FIELD
IOTP0 /DEST ADDR
-7 /-COUNT
STA /RETURN PARAMETER LBLOCK TO FREE STORAGE
TAD RETPA1
CIF
RETBLK
CLA
JMP I RETPA0
/SAVE/RESTORE BUFFER POINTERS
/CALL JMS RESTBP
/ RETURN
RESTBP, 0
TAD COMDB0
TAD C0004
DCA IX1
DATFLD
TAD I IX1
DCA I SITCNT
TAD I IX1
DCA I SIECNT
TAD I IX1
DCA I SIBUF
CHDF
JMP I RESTBP
SAVNAM, TAD SIJOB /PRGTBL INDEX=3*JOB
TAD SIJOB
TAD SIJOB
TAD PRGTBA /START OF PRGTBL-3 (NO ENTRY FOR JOB 0)
DCA IX1
DATFLD
TAD IOTP3 /TRANSFER 3 WORD BLOCK
DCA I IX1
TAD IOTP4
DCA I IX1
TAD IOTP5
DCA I IX1
CHDF
TAD C0003 /FILE 3
DCA IOTP1
JMP I LNGIOT /GO DO OPEN
PRGTBA, PRGTBL-3-1
HASITM, " ;" ;"H;"A;"S;" ;" ;0
/ROUTINE TO GET USER'S ACCOUNT # IN FORM M,N OR M
/CALL
/ ACCTIN
/ ILLEGAL CHARACTER IN STRING
/ RETURN WITH ACCOUNT # IN AC
ACC0, 0
DCA ACC1 /CLEAR #
ACC3, NUMBIN /GET ONE COMPONENT
-"7
JMP ACC4 /COULDN'T DO IT
TAD ACC1 /ACCUMULATE INTO TOTAL
DCA ACC1
TAD CHAR /TERMINATOR A COMMA
TAD ACCOMA
SNA CLA
JMP ACC2 /YES-- SO SHIFT NUMBER THUS FAR INTO LEFT HALF OF WORD
TAD ACC1 /NO- RETURN WHOLE #
ISZ ACC0 /SKIP TO INDICATE GOODNESS
ACC4, JMP I ACC0
ACC2, TAD ACC1 /SHIFT IT LEFT 6 PLACES
CLL RTL
RTL
RTL
DCA ACC1 /SAVE IT
COMGET /GET PAST THE OFFENDING COMMA
JMP ACC4 /NONE LEFT, BUT WE NEED ONE--ERROR
JMP ACC3 /GET NEXT PART OF NUMBER
ACC1, 0
ACCOMA, -",
WHERLK, 240 /SP L=
314
275
0
*COMMAN
LOGINE, JMS LOGIE0
SIERR
JMP I COMEXA
LOGIE0, 0
TAD COMDB0
SNA
JMP LOGIE1
IAC
DCA IOTP0
DATFLD
TAD I IOTP0
AND C7700
DCA I IOTP0
CHDF
LOGIE1, RESDDB
DATFLD
CLA
TAD I COMRDB
SNA
JMP LOGIE2
IAC
DCA IOTP0
DCA I IOTP0
LOGIE2, CDF
TAD I JOB /SET JOB = 0
AND C7700
DCA I JOB
TAD SIJOB
TAD JOBTBA /SET JOBTBL ENTRY=0
DCA CHDFA
DATFLD
DCA I CHDFA
TAD I JOBDAT /RETURN JOB STATUS BLOCKS
CHDF
RETBKS
DATFLD
DCA I JOBDAT
CHDF
JMP I LOGIE0
LOGUNA, UNACCT
LOGINF, GETWRD
JOBREG+2
SNA CLA
JMP LOGIF1 /HOW DID HE TERMINATE COMMAND
JMS LOGIE0
TAD LOGUNA
JMP I COMEXA
LOGIF1, ASCOUT /FINISH TYPING MESSAGES ON LOGIN
VERSMA, VERSIM /FIRST OUTPUT VERSION #
JMP I COMEXA
TAD SIJOB /NOW OUTPUT JOB#
JMS I LOGJPR /PRINT #JOB, ACCOUNT & CONSOLE#
ASCOUT
SPACES
JMP I COMEXA
TAD LOGFA2 /FUDGE COMRET TO GO TO LOGIF2 ON COMPLETION
DCA COMEXA / OF TIME EVALUATION
TAD SIJOB /PUT "LOGIN" IN PRGTBL FOR THIS JOB
TAD SIJOB
TAD SIJOB /PRGTBL INDEX IS 3*JOB#
TAD LOGPRG /START OF PRGTBL-3-1
DCA IX1
DATFLD
TAD LOGN5A /LO
DCA I IX1
TAD LOGN5B /GI
DCA I IX1
TAD LOGN5C /N
DCA I IX1
JMP I .+1 /NOW GO DO TIME EVALUATION
TIME3
LOGPRG, PRGTBL-3-1
LOGN5A, 5457 /LO
LOGN5B, 4751 /GI
LOGN5C, 5600 /N
VERSIN, TAD VERSMA /TYPE OUT VERSION #
JMP I COMEXA
LOGJPR, USRJPR /PRINT USER #
LOGFA2, LOGIF2
IOTSET, GETTBA
JOBLNK
DCA CHDFA
TAD IOTP0
DATFLD
DCA I CHDFA
CHDF
CALFIP /EXECUTE IOT
LOGME0, LOGE0
LOGME1, LOGE1
LOGME2, ILLREQ
JMP LOGINE /FIP ERROR RETURN
JMP LOGINF /OK RETURN
LOGIN, TAD SIJOB
SZA CLA
JMP LOGIN2
TAD JOBTBA /JOB # AVAILABLE?
DCA IX4
DATFLD
TAD JOBONC
DCA CHDFA
LOGIN1, TAD I IX4
SNA CLA
JMP LOGIN4 /GOT A JOB #
ISZ CHDFA
JMP LOGIN1
LOGIN3, TAD LOGME1 /CAPACITY EXCEEDED
SKP
LOGIN6, TAD LOGME2 /NUMBER REQUIRED
DCA IOTP0
CDF
TAD I JOB
AND C7700
DCA I JOB
TAD IOTP0
JMP I COMERA
LOGIN2, TAD LOGME0 /CONSOLE IN USE
JMP I COMERA
LOGIN4, TAD JOBTBA /SAVE JOB #
CIA
TAD IX4
DCA SIJOB
TAD SIJOB
CDF
TAD I JOB
DCA I JOB
CHDF
ACCTIN /GET ACCT #
JMP LOGIN6 /NOT A NUMBER
DCA IOTP2
DATFLD
TAD IOTP2
AND I OFFMSK
CHDF
SZA CLA
JMP I LOGI3A
TAD COMBFA /GET PASSWORD IN ASCII
TEXTS
CLA
ASCSIX /CONVERT TO SIXBIT
COMBUF-1
IOTP3-1
CDF
TAD I FRECNT
TAD LOGMIN
SPA CLA
JMP I LOGI3A
TAD SIJOB /PUT ENTRY IN TTYTBL
TAD TTYTBA
DCA IOTP7
RESDDB
STA
TAD COMDB0
DCA IX1
TAD DEVTBA
CIA
TAD COMRDB
DATFLD
CLL RAR
DCA I IOTP7
TAD I IOTP7
TAD I COMDB0
DCA I IX1
TAD SIJOB
DCA I IX1
STL RAR
DCA I IX1
TAD I COMRDB
SZA
JMP LOGIN5
TAD COMRDB
CHDF
GETFBL
LOGDDB, 0
LOGIN5, DCA LOGDDB
DATFLD
TAD I IOTP7
DCA I LOGDDB
ISZ LOGDDB
TAD SIJOB
DCA I LOGDDB
CHDF
TAD IX4 /INITIALIZE JOB STATUS
GETFBL
0
DCA IX1
TAD IX1
ISZ IX1
GETFBL
LOGMIN, -STOMIN /MINIMUM FREE STORAGE FOR NEW JOB
GETFBL
OFFMSK, F1OFFJ
STA
TAD IX1
DATFLD
DCA I JOBDAT
IFZERO CPU+EAE-22 < /8E WITH EAE:
CHDF
GETWRD /SC IS BUMPED OVER 2 BITS AND MODE AND GT ARE
JOBEAE+1 /IN BITS 10 AND 11
CLA CLL CML RTL
DATFLD
DCA I IOTP7 > /SET TO MODE A, GT OFF.
DCA IOTP7
CHDF
GETTBA
JOBLNK
GETFBL
NOP
DCA LOGPMA
DATFLD
ISZ I IX1 /SET JSWAIT IN STR1
ISZ IX1
ISZ I IX1 /SET JSWAIT IN WAIT MASK
CHDF
CIF
BLT
CHDF /SOURCE FLD
IOTPAR+1 /SOURCE ADDR
DATFLD /DEST FLD
LOGPMA, 0 /DEST ADDR
-10 /-COUNT
CALFIP
LOGI3A, LOGIN3
EXAMI1, CHDF
ASCOUT
CRLF
JMP I EXAMI5
TAD IOTP3
DCA NUMHO
TAD COMBFA
DCA IX2
DCA IOTP4
EXAMI3, TAD I IX2
OCTASC
IOTPAR
ASCOUT
IOTP0
JMP I EXAMI5
ISZ NUMHO
SKP
JMP I EXAMI5
ASCOUT
SPACE
JMP I EXAMI5
JMP EXAMI3
EXAMI5, DEPOS3
*COMMAN+400
ASSTBL, .
-"R
-"P
-"I
-"L
-"C
ASSD, -"D
ASSK, -"K /****** THIS TABLE MUST BE FOLLOWED BY A POSITIVE NUMBER
ASSCAL, IOTSET
ASSBFA, -COMBUF
SIERR
JMP ASSIGF
ASSIGN, JMS W2BUSY /SEE IF WAIT 2 IS BUSY
TAD COMBFA
TEXTS
DCA CHDFA /POINTER TO LAST CHAR IN AC
TAD ASSBFA /ONE CHARACTER ONLY?
TAD CHDFA
SZA CLA
JMP ASSIG4 /NO
TAD ASSTBL
DCA IOTP2
ASSIG2, ISZ IOTP2
TAD I IOTP2
SMA
JMP ASSIG4-1
TAD I CHDFA
SZA CLA /MATCH?
JMP ASSIG2 /NO
TAD I CHDFA /YES, RK05?
TAD ASSK
SZA
JMP ASSIGD /NO, CHECK FOR DECTAPE?
NUMBIN
-"7
JMP ASSGK2 /WE MUST FIND A DRIVE
ASSGK1, DCA IOTP1
TAD IOTP1
AND C7774
SZA CLA
JMP ASSIG4
TAD C0015
JMP ASSG3K
ASSGK2, TAD ASSRK5
DCA IX2
TAD C7774
JMS ASSSUB
AND C0003
JMP ASSGK1
ASSIGD, TAD C0007 /"K-"D
SZA CLA
JMP ASSIG3 /NO, MUST BE SOME OTHER DEVICE
NUMBIN /YES, GET UNIT #
-"7
JMP ASSIG6 /HE WANTS US TO CHOOSE FOR HER
ASSIG7, DCA IOTP1
TAD IOTP1 /IS UNIT # .LE. 7?
AND C7770
SZA CLA
JMP ASSIG4 /NO...ERROR
ASSIG3, TAD ASSTBL
IAC
CIA
TAD IOTP2
ASSG3K, TAD IOTP1
TAD C4000
ACSET, DCA IOTP1 /SAVE AC IN BOTH USER'S AC AND PC
GETTBA
JOBREG
DCA CHDFA
TAD IOTP1
DATFLD
DCA I CHDFA
ISZ CHDFA
ISZ CHDFA /NOW POINTS TO USERS AC
TAD IOTP1
DCA I CHDFA
CHDF
JMP I ASSCAL
C0015, 15
C7774, 7774
ASSIG6, TAD ASSDTA /POSITION OF DTA IN DRVTBL-1
DCA IX2
TAD C7770 /ONLY EIGHT POSSIBILITIES
JMS ASSSUB
AND C0007
JMP ASSIG7
ASSSUB, 0
DCA IX1
DATFLD
TAD I IX2 /PICK UP DEVTBL ENTRY
SNA CLA /AVAILABLE?
JMP ASSG60 /YES
ISZ IX1 /NO...TRY THE NEXT ONE
JMP .-4
ASSIG8, CLA /NO MORE TO TRY
TAD ASSNON
JMP I COMEXA /"NO SUCH DEVICE"
ASSG60, TAD IX1 /GOT ONE; UNIT # IN BITS 8-11 IF IX1
JMP I ASSSUB
ASSNON, NONSUC /NO SUCH DEVICE
ASSG9A, ASSIG9
ASSDTA, DEVTBE+5-1
ASSRK5, DEVTBE+5+10-1
SIERR
JMP RELF
RELEAS, JMP ASSIGN
RELF, GETWRD
JOBREG+2
SZA CLA
ASSIG4, TAD .+2
JMP I COMEXA
ILLREQ
W2BUSY, 0
GETWRD
JOBWMK+1 /GET JOB WAIT MASK 2
SNA CLA /IS HE WAITING FOR ANYTHING????
JMP I W2BUSY /NO BACK TO WHATEVER
TAD WAITMS /WAIT FOR I/O COMPLETION
JMP I COMEXA
WAITMS, WAITIO
ASSIGF, GETWRD /HOW DID WE FARE IN FIP
JOBREG+2
SNA
JMP I ASSG9A /WE GOT IT TELL THE USER
SPA
JMP ASSIG8 /FAILED
DCA IOTP0
ASCOUT
CRLF
NOP
TAD IOTP0 /OWNER
JMS I ASSUPN
ASCOUT
HASITM
NOP
JMS I ASSUNA
ASCOUT
CRLF
NOP
JMP I COMEXA
ASSUPN, USRJPR
ASSUNA, ASSUNI
SIERR
JMP I IOTEND
FOPEN, NUMBIN /FILE #
-267
JMP I COMERA
AND C0003
DCA IOTP1
JMS NULLNA
ASCSIX
COMBUF-1
IOTP3-1
ENDTST
JMP FOPEN1
ACCTIN /ACCOUNT #
SKP
DCA IOTP2
FOPEN1, GETTBA
JOBLNK
GETFBL
COMWAT /NONE, TRY LATER
DCA FOPEN2
CIF
BLT
CHDF /SOURCE FLD
IOTPAR+1 /SOURCE ADDR
DATFLD /DEST FLD
FOPEN2, 0 /DEST ADDR
-10 /-COUNT
CALFIP
SIERR
JMP I IOTEND
CLOSE, NUMBIN
-267
JMP CLOSE2
AND C0003
CMA
DCA IOTP2
STL
RAR
ISZ IOTP2
JMP .-2
DCA IOTP2
TAD IOTP1
AND IOTP2
SNA CLA
TAD IOTP2
TAD IOTP1
DCA IOTP1
JMP CLOSE
CLOSE2, TAD IOTP1
SNA
TAD C4000
JMP I SHTIOT
SIERR
JMP I IOTEND
CREATE, JMS NULLNA
ASCSIX
COMBUF-1
IOTP1-1
JMP I LNGIOT
NULLNA, 0
TAD COMBFA
TEXTS /READ IN THE NAME
CIA
TAD COMBFA /WAS IT A NULL NAME
SNA CLA
JMP I COMERA /YES
JMP I NULLNA
SIERR
JMP I IOTEND
RENAME, NUMBIN /FILE #
-267
JMP I COMERA
AND C0003
DCA IOTP1
JMS NULLNA
ASCSIX
COMBUF-1
IOTP2-1
JMP I LNGIOT
SIERR
JMP I IOTEND
EXTEND,
REDUCE, NUMBIN /FILE #
-267
JMP I COMERA
AND C0003
DCA IOTP1
NUMBIN
-271
JMP I COMERA
DCA IOTP2
JMP I LNGIOT
C7637, 7637
SIERR
JMP I IOTEND
PROTEC, NUMBIN /FILE #
-267
JMP I COMERA
AND C0003
CLL RTL
RTL
RAL
DCA IOTP1
NUMBIN
-267
JMP I COMERA
AND C7637
TAD IOTP1
JMP I SHTIOT
*COMMAN+1000
ST3770, 3770
ST7377, 7377
STERF, -JSWAIT-JSERR-JSDEL-1
STACHK, W2BUSY
START, JMS I STACHK /CAN'T START IKF I/O IN PROGRESS
ENDTST /END OF COMMAND?
JMP START1 /YES
START0, GETTBA /NO, SET STARTING ADDRESS
JOBREG
DCA IOTP2
ENDTST
JMP START2 /NO STARTING ADDRESS FOR "R" OR "RUN" ASSUME 0
GETWRD
JOBSTS
AND ST7377 /CLEAR "R PRIV. BIT"
DATFLD
DCA I IOTP7
CHDF
NUMBIN
-267
JMP I COMERA /NON-ACTAL ADDRESS
START2, DATFLD
DCA I IOTP2
ISZ IOTP2 /CLEAR LINK & AC
DCA I IOTP2
ISZ IOTP2
DCA I IOTP2
IFZERO CPU+EAE-22 <
CHDF
GETWRD
JOBEAE+1
RTR
STL RAL
CLL RAL
DATFLD
DCA I IOTP7 > /ZERO OUT GT, AND SET MODE A
CHDF
GETTBA /RESET STATUS
JOBSTS
DCA IX1
DATFLD
DCA I IX1
DCA I IX1 /THIS IS CLEARING OUT PART OF JOB STATUS BLOCK 1
DCA I IX1
DCA I IX1
CHDF
START1, GETWRD /JSRUN=1
JOBSTS
AND ST3770 /CLEAR ERROR FLAGS + JSSTOP
TAD C4000
DATFLD
DCA I IOTP7
ISZ IOTP7
TAD I IOTP7
AND STERF
IAC /JSWAIT=1
DCA I IOTP7
ISZ IOTP7
ISZ IOTP7
CLL CLA CMA RAL
AND I IOTP7
IAC
DCA I IOTP7
CHDF
JMP I COMEXA
/
JOBS10=C0010
WHERE, JMS WHEPRT /ANSWER TO WHERE COMMAND
JMP I COMEXA
WHEPRT, 0
TAD WHEVEC /SET POINTER TO WHLST
DCA IX2
TAD JOBS10 /INITIALIZE WHERE3 TO SWITCH REG
DCA WHERE3
WHERE1, TAD I IX2 /GET TEXT ADDRESS
SNA
JMP I WHEPRT /DONE
DCA WHERE2
ASCOUT /PRINT TEXT
WHERE2, 0
NOP
GETWRD /GET JSB WORD
WHERE3, 0
JMP I IX2 /JUMP TO PROCESS JSB WORD
WHEVEC, WHLST-1
WHERE4, OCTASC /PRINT 4 OCTAL DIGITS
COMBUF-1
ASCOUT
COMBUF
NOP
WHERE5, ISZ WHERE3 /GO TO NEXT JSB WORD
JMP WHERE1
WHERE6, SPA CLA
IAC
TAD K0260
DCA I WHACA /SAVE WHERE IT WILL BE PRINTED
JMP WHERE5
IFZERO CPU+EAE-22 < /ON 8E WITH EAE:
WHERE7, RTR /GT FLAG IFF BIT 10=0, 11=0
SMA SNL CLA
IAC
TAD K0260
DCA I GT /SAVE WHERE IT WILL BE PRINTED
CML RAL /LINK HAS EAE MODE, SET FOR MODE A
TAD C0301
DCA I WHSCA /SAVE WHERE IT WILL BE PRINTED
JMP WHERE1
GT, WHERSC+5
WHERE8, RAR CLL /8E WITH EAE: SC IS BUMPED 2 BITS
RAR CLL
JMP WHERE4 >
WHLST, WHERSW
JMP WHERE4
WHERPC
JMP WHERE4
WHERLK
JMP WHERE6
WHACA, WHERAC
JMP WHERE4
IFZERO MQREG-1 <
WHERMQ
JMP WHERE4
IFZERO CPU+EAE-22 <
WHERGT
JMP WHERE7 >
IFNZRO EAE <
WHSCA, WHERSC
IFZERO CPU-2 <JMP WHERE8>
IFNZRO CPU-2 <JMPWHERE4> > >
0
C0301, 301
K0260, 260
*4200
/TEST FOR END OF COMMAND STRING
/CALL ENDTST WITH CHARACTER IN CHAR
/ END RETURN
/ NOT END
ENDTST=JMS I ENDTSA
ENDTS0, 0
TAD ENDTBA
DCA IX5
TAD I IX5
SNA
JMP .+5
TAD CHAR
SZA CLA
JMP .-5
SKP
ISZ ENDTS0
JMP I ENDTS0
ENDTBA, .
-273 /;
-272 /:
-215 /CR
-212 /LF
-213 /VT
-214 /FF
0
/GET USER STATE WORD
/CALL GETWRD
/ RELATIVE ADDRESS
/ RETURN WITH USER WORD IN AC, ADDRESS IN IOTP7
GETWRD=JMS I Z GETWRA
GETWR0, 0
TAD I GETWR0
DCA GETWR1
ISZ GETWR0
GETTBA
GETWR1, 0
DCA IOTP7
DATFLD
SZL
TAD I IOTP7
CHDF
JMP I GETWR0
/ROUTINE TO FORCE A STRING INTO AN INPUT BUFFER
/USER MUST BE LOGGED IN AS ACCOUNT 1 OR 3 TO SUCCEED
FORSE, JMS I ACCNT1 /IS THIS ACCOUNT # 1 OR 3
NUMBIN /GET CONSOLE #
-"7
JMP I COMERA /BAD CONVERSION, QUIT
CLL RAL /*2 FOR DEVTBL INDEX
TAD DEVTBA /+START OF DEVTBL
DCA FORDEV
TAD FORDEV
TAD FOR5
SMA CLA
JMP I COMERA
DATFLD
TAD I FORDEV /DOES HE HAVE A DDB?
CHDF
SZA CLA
JMP FOR0 /YES
TAD FORDEV /NO; GET ONE
CIF
GETDDB
JMP I COMERA /NONE TO GET- NEVER HAPPENS
DATFLD
TAD I FORDEV
DCA BRO8
TAD C1000
DCA I BRO8
CHDF
FOR0, JMS I FORSTG /GET INPUT STRING
FOR7, TAD I IOTP0
TAD FORFOR /CHECK FOR FORM FEED
SNA
JMP I COMEXA /IT IS; SO EXIT
TAD FORARW /NO, MAYBE IT'S A ^?
SZA CLA
JMP FOR2
ISZ IOTP0 /IT IS SO MAKE THE NEXT CHARACTER A CONTROL CHARACTER
TAD C0100
FOR2, CMA
AND I IOTP0 /GET CHARACTER
SNA /END OF STRING?
JMP I COMEXA /YES, FINISH UP
CIF CDF
DCA I TTCHAR /SET UP GIR CALL
CHDF /BACK UP HERE, SO GIR WILL RETURN PROPERLY
KEY /PUSH CHARACTER THRU PROPER CHANNELS
BROAD4,
FORDEV, 0 /DEVTBL ADDRESS
JMP FOR3 /DIDN'T FIT FOR SOME REASON
ISZ IOTP0 /NEXT CHARACTER
JMP FOR7
FOR3, BUFDEL /DELETE FORCE COMMAND
TAD FOR6
DCA COMFLG /PRINT ?? AT END OF FAILED TEXT STRING
TAD IOTP0
JMP I COMERA /EXIT; PRINT THE PORTION OF THE COMMAND THAT DIDN'T FIT
FOR5, -DEVTBE
FOR6, 167
FORFOR, -"L+100 /-FORM FEED
FORARW, "L-100-"^
ACCNT1, ACTNM1
/ROUTINE TO TYPE A MESSAGE ON EVERYBODY'S CONSOLE AT ONCE
/THE USER MUST BE LOGGED IN UNDER ACCOUNT 1 OR 3
BROAD, JMS I ACCNT1 /ONLY ACCOUNT 1 OR 3
JMS I FORSTG /GET STRING INPUT
TAD BROLN /INITIALIZE FOR ALL CONSOLES
DCA IOTP3
TAD DEVTBA /GET POINTER TO FIRST OUTPUT DDB
IAC
DCA IOTP4
DCA BROAD4 /TO REMEMBER WHETEHR WE SUCCEED
BROAD3, JMS BRO8 /PUSH STRING CR-LF STARS THRU
STARS
JMS BRO8 /OUTPUT MESSAGE
VERBRK
JMS BRO8 /CR-LF
CRLF
BROAD2, ISZ IOTP4 /ON TO NEXT CONSOLE
ISZ IOTP4
ISZ IOTP3 /ARE WE DONE?
JMP BROAD3 /NO, CONTINUE
TAD BROAD4
SZA CLA /DID ANY FAIL?
TAD BROBUS /YES
TAD BROOK
JMP I COMEXA
BRO8, 0
TAD I BRO8
DCA .+3
TAD IOTP4
ASCOUT
0
ISZ BROAD4
ISZ BRO8
JMP I BRO8
BROBUS, BUSY-OK
BROOK, OK
BROLN, -NULINE-1
FORSTG, STRNG0
*COMMAN+1400
FSIXAS, SIXASC
FDECOU, DECOUT
SIERR
JMP F2
F, NUMBIN /INTERNAL FILE #
-267
JMP I COMERA
AND C0003
DCA IOTP1
JMP I LNGIOT
F2, RETPAR
ASCOUT
CRLF
NOP
TAD IOTP1 /ACCT #
SNA
JMP I COMEXA /FILE NOT OPEN
OCTASC
COMBUF-1
JMS FOUT
STA
TAD IOTP1
SNA CLA
JMP F4 /DON'T GIVE AWAY A PASSWORD
JMS I FSIXAS /FILE NAME
IOTP2
COMBUF-1
JMS FOUT
TAD IOTP5 /PROTECTION
CLL RTL
F3, RTL
RTL
JMS USRPR
ASCOUT
SPACE
JMP I COMEXA
TAD IOTP5
JMS USRPR
ASCOUT
SPACE
JMP I COMEXA
STA
TAD IOTP1
SNA CLA
JMP I COMEXA /UFD; SIZE NOT RETURNED
TAD COMBFA
DCA IX1
TAD IOTP6 /SIZE
JMS I FDECOU
DCA I IX1
JMS FOUT
JMP I COMEXA
F4, TAD IOTP5 /LOGOUT QUOTA
CLL RAL
RTL
JMP F3 /SHIFT AN EXTRA PLACE
FOUT, 0
ASCOUT
COMBUF
JMP I FOUT
ASCOUT
SPACE
JMP I FOUT
JMP I FOUT
USER, ASCOUT /TELL USER WHERE HE IS
CRLF
JMP I COMEXA /NO ROOM, SO SKIP IT
ENDTST /THIS JOB?
JMP USER1 /YES
NUMBIN /NO; WHAT JOB THEN?
-267 /OCTAL JOB #
USER1, TAD SIJOB /ASSUME THIS JOB
USER2, SPA
CIA
DCA IOTP0 /SAVE JOB #
TAD IOTP0 /VALID JOB #?
TAD USEMAX /-HIGHEST JOB # - 1
SMA CLA
JMP I COMERA /NO SUCH JOB
DATFLD /IS THE JOB LOGGED IN?
TAD IOTP0
TAD JOBTBA
DCA IOTP1 /POINTER TO JOBTBL
TAD I IOTP1 /ADDRESS OF JOB STATUS
SNA CLA
JMP I COMEXA /NOT LOGGED IN; SAY NOTHING
CHDF /BACK UP HERE
TAD IOTP0 /JOB #
JMS USRJPR /PRINT "JOB ACCOUNT & CONSOLE"
JMP I COMEXA
USEMAX, -JOBMAX-1
USRJPR, 0 /PRINT "JOB NN"
DCA IOTP7 /SAVE #
ASCOUT
JOBNO
JMP I USRJPR /NO ROOM
TAD IOTP7 /JOB #
JMS USRPR /PRINT #
TAD IOTP7
JMS I USRACC /FIND HER ACCOUNT NUMBER
ASCOUT
ACCBUFF
JMP I USRJPR
ASCOUT
KSPACE
JMP I USRJPR
DATFLD
TAD IOTP7 /GET HER TTY #
TAD TTYTBA /POINTS TO ENTRY IN TTYTBL
DCA IOTP1
TAD I IOTP1 /GET TTY #
CHDF
JMS USRPR
JMP I USRJPR
USRACC, GETACC
USRPR, 0 /PRINT OCTAL # AS MM
OCTASC
COMBUF-1 /SNEAKY WAY TO SUPPRESS LEADING 00
ASCOUT
COMBUF+2
NOP
JMP I USRPR
*COMMAN+1600
R4A, R4
R6A, R6
R6B, COMEXT
STARTA, START0
RRFILE, RFILE
RLSA, RLS
RUNLOD, LOAD
RUNSAV, SAVE1
SETPRA, SETPRV
JMP RERR
JMP R1
RUN, JMP I RUNLOD
RERR, SIERR
JMP I COMERA
JMP RERR
JMP R1
R, JMS I SETPRA /SET THE R PRIVILEGE BIT
STL RTL /AC=LIBACT
JMP I RUNSAV
R1, GETWRD /RETURN FROM OPEN
JOBREG+2
SZA CLA
JMP I IOTEND
GETTBA
JOBLNK
GETFBL
COMWAT
DCA I R4A
TAD R6A
DCA EXITA
JMP I STARTA
R6, TAD R6B /RESTORE NORMAL EXIT
DCA EXITA
TAD C0003
TAD C4000
DCA IOTP2 /FILE 3
STA
DCA IOTP4 /CORE ADDRESS
TAD RRFILE
DCA IOTP0
IAC /CALL RLS WITH NONZERO AC FOR R AND RUN
JMS I RLSA
TAD SIJOB
CORES
SZA
JMP R8
CORES
SZA
JMP R8
ASSCOR
TAD C0122 /USER MODE, FIELD 2
R7, CIF CDF
DCA I RL2SF /FIELD OF JOB
TAD SIJOB
JMP I .+1
RUNFI
R8, DCA NUMHO /SAVE FIELD INFO
TAD R6B /RESTORE EXIT
DCA EXITA
RELCOR
TAD NUMHO
AND C0007
TAD CORTBA
DCA IOTP0
CDF
TAD SIJOB
DCA I IOTP0
TAD NUMHO
JMP R7
RL2SF, L2SF
C0122, 122
JMP RERR
JMP R1
SYSTAT, TAD SYSMA /SYSTAT COMMAND
DCA IX1 /POINTER TO FILE NAME
JMS I SETPRA /SET THE R PRIVILEGE BIT
TAD I IX1 /PUT "SYSTAT" OR "LOGOUT" IN IOTP3,4,5
DCA IOTP3
TAD I IX1
DCA IOTP4
TAD I IX1
DCA IOTP5
STL RTL /AC=LIBACT
DCA IOTP2
JMP I .+1
SAVNAM /GO SAVE NAME; THEN OPEN FILE
SYSMA, SYSM-1
SWFILE, WFILE
JMP RERR
JMP SAVE2
SAVE, JMP I .+1
SAVE3
SAVE2, GETWRD
JOBF3 /WRITE PROTECTED?
TAD C0002
DCA IOTP0
DATFLD
TAD I IOTP0 /POINTS TO PROTECTION WORD IN FILE CONTROL BLOCK
AND C0004
CHDF
SZA CLA
JMP SAVPRO /WRITE PROTECTED
TAD SWFILE
JMP I .+1
LOAD2
SAVPRO, TAD SFMS
JMP I COMERA
SFMS, FM6000 /"PROTECTION VIOLATION"
IFZERO CPU+EAE-22 <
WHERGT, 240 /SP MODE=
315
317
304
305
275
0
WHERSC, 240 /SP SP GT=X SC=
240
307
324
275
330
240
323
303
275
0 >
IFZERO CPU+EAE-20 <
WHERSC, 240 /SP SC=
323
303
275
0 >
*COMMAN+2003
LOADER, RERR
LRFILE, RFILE
LOADUA, LOADUS
SAVCHK, W2BUSY
JMP I LOADER
JMP LOAD1
LOAD,
SAVE3, ACCTIN
SKP
SAVE1, DCA IOTP2 /ACCOUNT #
ENDTST
JMP I COMERA
JMS I SAVCHK /SEE IF I/O IN PROGRESS
TAD COMBFA
TEXTS
CLA
ASCSIX
COMBUF-1
IOTP3-1 /FILE NAME
JMP I .+1 /SAVE PROGRAM NAME IN PRGTBL
SAVNAM
LOAD1, TAD LRFILE
LOAD2, DCA IOTP0
GETWRD /ERROR?
JOBREG+2
SZA CLA
JMP I IOTEND /YES
GETTBA /NO, SET UP RFILE OR WFILE
JOBLNK
GETFBL
COMWAT
DCA R4
CLL CML RTR /AC=2000
TAD C0003 /FILE #
DCA IOTP2
STA /DEFAULT CORE ADDRESS
DCA IOTP4
ENDTST /ANY PARAMETERS?
JMP LOAD4 /NO
NUMBIN /YES, FILE ADDRESS 02 CAN BE 6 DIGITS!
-267
JMP LOAD4
DCA IOTP5 /LEAST SIGN, 12 BITS
TAD NUMHO
DCA IOTP1 /HIGH ORDER
ENDTST
JMP LOAD4
NUMBIN /STARTING CORE ADDRESS
-267
JMP LOAD4
TAD IOTP4
DCA IOTP4
ENDTST
JMP LOAD4
NUMBIN /LAST CORE ADDRESS
-267
CLA CMA
CIA
TAD IOTP4
DCA IOTP3 /WORD COUNT
LOAD4, TAD SIJOB /SET UP XFER BLOCK TO LOAD USER AREA
TAD LOADM1
TAD SWBASE
CHDF
CLL RTL
DCA LOADEX
TAD LOAD5A
DCA EXITA
JMP I COMEXA
LOAD5, JMS RLS
TAD SIJOB
CORES
SZA
JMP I LOAD6A /JOB IS IN CORE
TAD LOADUB
JMP I LOADUA
LOAD6A, R8
LOAD5A, LOAD5
LOADUB, .+1
DMAR
LOADEX, 0
10
0
LOADM1, -1
0
OVERLA
READFI
RJSF3, JSF3+1
C5600, 5600
RLS, 0
SNA CLA /CALLED FROM RUN?
JMP RLS1 /NO
GETWRD /YES; INITIALIZE JOB STATUS
JOBSTS
AND C5600 /CLEAR ERROR FLAGS
DATFLD
DCA I IOTP7 /POINTS TO STR0
ISZ IOTP7
TAD I IOTP7 /GET STR1
AND C0100 /SAVE DELIMITER BIT IF SET
IAC /TURN ON THE DUMMY WAIT BIT
DCA I IOTP7 /POINTS TO STR1
ISZ IOTP7
DCA I IOTP7 /POINTS TO JOBSTB
RLS1, CHDF
GETWRD /F3 WAIT
JOBWMK
CLA
TAD RJSF3
DATFLD
DCA I IOTP7
ISZ IOTP7 /CLEAR WAIT MASK 2 AS WELL
DCA I IOTP7
TAD SIJOB
CIF CDF
DCA I SIREG
TAD I SIREG
DCA I JOB
CHDF
BLT
6221 /SOURCE FIELD (ALWAYS 2)
IOTP0
DATFLD
R4, 0
-6
JMP I RLS
*COMMAN+2200
C7766, 7766
DEPO3A, DEPOS3
DEPOSI, NUMBIN /STARTING ADDRESS
-267
JMP I COMERA
DCA IOTP5 /LOW ORDER DISC ADDRESS
TAD C7766
DCA IOTP1
TAD COMBFA
DCA IX1
DEPOS2, NUMBIN /CONVERT ARGUMENT LIST
-267
JMP DEPOS1
DCA I IX1
ISZ IOTP1
JMP DEPOS2
DEPOS1, TAD IX1
CIA
TAD COMBFA
SNA
JMP I COMERA /NOTHING TO DEPOSIT
DCA IOTP3 /-WORD COUNT
TAD SIJOB
CORES
SZA
JMP DEPOS4
TAD DEPO3A
EXAMI2, DCA SI1 /RETURN ADDRESS
TAD COMBFA
DCA IOTP4 /CORE ADDRESS-1
CLA CMA /-1 IN AC
TAD SIJOB
TAD SWBASE
CLL RTL
DCA IOTP1 /DISC EXTENSION
TAD C0010
DCA IOTP2
TAD DEPEX2
DCA IOTP6
DCA IOTP7
TAD IOTP3 /ARE WE GOING INTO NEXT JOB'S DISK IMAGE?
CLL CMA /WORD COUNT -1
TAD IOTP5 /WC+ADDRESS>7777?
SNL CLA
JMP I DEPEX /OK TO PROCEED
TAD COMA /RESET DISPATCH ADDRESS
DCA SI1
JMP I COMERA /EVIL ONCE AGAIN AVERTED
DEPEX, DEPEXA
DEPEX2, OVERLA
/RETURN AFTER READING OR WRITING USER AREA
DEPOS3, TAD COMA
DCA SI1
JMP I COMEXA
COMF, CHDF
COMA, COM
C0070, 70
DEPOS4, AND C0070
TAD C6201
DCA DEDEF
TAD IOTP5
DCA DEDEA
TAD COMF
DCA DESRF
TAD BUFFER
DCA DESRA
JMS DEMOVE
JMP I COMEXA
DEMOVE, 0
TAD IOTP3
DCA DECNT
CIF
BLT
DESRF, 0 /FROM FLD
DESRA, 0 /FROM ADDR
DEDEF, 0 /TO FLD
DEDEA, 0 /TO ADDR
DECNT, 0 /-COUNT
JMP I DEMOVE
EXAMIN, NUMBIN /STARTING ADDRESS
-267
JMP I COMERA
DCA IOTP5
NUMBIN
-271
IAC
SNA
IAC
CIA
DCA IOTP3
TAD IOTP3 /IS COUNT WAY OUT OF LINE?
SMA CLA
JMP I COMERA /YES
TAD IOTP3
CIA
TAD C7766
SMA SZA CLA
JMP I COMERA
TAD SIJOB
CORES
SZA
JMP EXAMI4
TAD EXAM1A
JMP EXAMI2
EXAM1A, EXAMI1
BUFFER, COMBUF
EXAMI4, AND C0070
TAD C6201
DCA DESRF
TAD IOTP5
DCA DESRA
TAD COMF
DCA DEDEF
TAD BUFFER
DCA DEDEA
JMS DEMOVE
JMP I EXAM1A
FORJOB, 240
306 /F
317 /O
322 /R
240
312 /J
317 /O
302 /B
240
0
*COMMAN+2400
TICLK2, INCLK2
TICLK1, INCLK1
JOBRSA, JOBRES /RESTORE JOBDAT
TIME, ENDTST /ARGUMENT?
JMP TIME1 /NO, THIS JOB
NUMBIN
-267
JMP TIME1
DCA IOTP0 /LEGAL JOB #?
TAD IOTP0
TAD JOBONC
SMA SZA CLA
JMP I COMERA /NO
TAD IOTP0 /JOB 0?
SNA CLA
JMP TIME3 /YES, TIME OF DAY
DATFLD
TAD IOTP0
TAD JOBTBA
DCA IOTP0
TAD I IOTP0
SNA /LOGGED IN?
JMP TIME5 /NO
DATFLD
DCA I JOBDAT
TIME2, CHDF
GETWRD
JOBRTM
DCA NUMHO+1
GETWRD
JOBRTH /HI ORDER TIME
TIME4, DCA NUMHO
JMS PTIME
JMS I JOBRSA /RESTORE JOBDAT IF ALTERED
TAD COMBFA
IAC
TIME5, CHDF
JMP I COMEXA
TIME1, TAD SIJOB
SZA CLA
JMP TIME2
TIME3, CDF
TAD I CLK1
CLL
TAD TICLK1
DCA NUMHO+1
SZL
IAC
TAD I CLK2
TAD TICLK2
CHDF
JMP TIME4
/ROUTINE TO CONVERT VALUE IN NUMHO AND NUMHO+1 (IN TICKS)
/TO HOURS, MINUTES AND SECONDS.
/THE RESULT IS STORED IN COMBUF AS HH:MM:SS
PTIME, 0 /ENTER WITH AC=0
TAD COMBFA /START OF OUTPUT BUFFER
DCA IX1
TAD PTABX /SET UP TABLE FETCH (LOW)
DCA PTIMX
TAD PTABX1 /SET UP TABLE FETCH (HIGH)
DCA PTIMX1
TAD PTFORM /FORMAT MASK
DCA PTCONT
PTLOOP, TAD PT0260 /INITIALIZE DIGIT COUNTER
DCA PTDIGI
CLL /DIVIDE LOOP
TAD NUMHO+1 /DOUBLE PRECISION ADD
PTIMX, NOP /(TAD PTAB1+N)
DCA NUMHO+2 /SAVE LOW ORDER REMAINDER
RAL /GET OVERFLOW
TAD NUMHO /ADD HIGH ORDER
PTIMX1, NOP /(TAD PTAB+N)
SNL
JMP PTIMA /DIVIDE OVERFLOW
DCA NUMHO /RESTORE REMAINDER
TAD NUMHO+2 /LOW ORDER RESTORE
DCA NUMHO+1
ISZ PTDIGI /COUNT THIS SUBTRACTION
JMP PTIMX-2 /CONTINUE LOOP
PTIMA, ISZ PTIMX /ADVANCE TABLE FETCH
ISZ PTIMX1 /ADVANCE TABLE FETCH
CLA /CLEAR OUT REMAINDER
TAD PTDIGI
DCA I IX1 /STORE ASCII DIGIT
TAD PTCONT
SNA /TEST FOR ALL DONE
JMP I PTIME /EXIT
RAL CLL /TEST FOR COLON PRINT
DCA PTCONT /RESTORE FORMAT
SZL /PRINT COLON?
JMP PTLOOP /CONTINUE LOOP
TAD PTCOLN /ADD COLON TO OUTPUT
DCA I IX1
JMP PTLOOP /CONTINUE LOOP
PTABX, TAD PTAB1 /TABLE FETCH LOW
PTABX1, TAD PTAB /TABLE FETCH HIGH
PTFORM, 5200 /FORMAT FOR OUTPUT
PT0260, 260
PTCOLN, 272 /ASCII COLON
PTDIGI, 0 /ASCII DIGIT BUILT HERE
PTCONT, 0 /LOOP CONTROL
C0005, 5
/SUBROUTINE TO SET R PRIVILEGE BIT
/SET BY R COMMAND, AND IN ADDITION K, LOGOUT, AND SYSTAT COMMANDS
/ALLOWS PRIVILEGED IOT'S; IE LOGOUT, PEEK
SETPRV, 0
GETWRD
JOBSTS
DATFLD
TAD C0400 /PRIVILEGE BIT
DCA I IOTP7 /SAVE IT
TAD C0005
TAD IOTP7
DCA IOTP7
DCA I IOTP7 /CLEAR HER RESTART ADDRESS
CHDF
JMP I SETPRV /AND RETURN
SYSM, 6371 /SY
6364 /ST
4164 /AT
/DOUBLE PRECISION WORDS...HIGH ORDER BITS
PTAB, 7650 /-TICKS PER 10 HRS
7767 /-TICKS PER 1 HR
7776 /-TICKS PER 10 MIN
7777 /-TICKS PER 1 MIN
7777 /-TICKS PER 10 SEC
7777 /-TICKS PER 1 SEC
/DOUBLE PRECISION WORDS...LOW ORDER BITS
PTAB1, 0700 /-TICKS PER 10 HRS
1540 /-TICKS PER 1 HR
4220 /-TICKS PER 10 MIN
6650 /-TICKS PER 1 MIN
7634 /-TICKS PER 10 SEC
7766 /-TICKS PER 1 SEC
*5600
/ROUTINE TO CONVERT CONTENTS OF AC INTO DECIMAL CHARACTER STRING
/STORE STRING USING IX1 AS BUFFER POINTER
/ONLY DECIMAL VALUES <4000 (DECIMAL) ARE VALID
DECOUT, 0
DCA BCDI /SAVE VALUE
TAD BCDC
DCA BCDP /RESET TABLE POINTER
CLL CMA RTL /AC:=-3
DCA NUMHO /SET DIGIT COUNTER
DCA JOBRES /CLEAR OUTPUT FLAG
TAD BCDT
DCA BCDN /SET MAGIC BIT
TAD BCDI /RECALL CURRENT VALUES
CLL
BCDP, TAD BCDTB /SUBTRACT BIT VALUE
SZL /SKIP IF TOO LARGE
DCA BCDI /SAVE NEW VALUE
CLA
TAD BCDN /RECALL CONSTRUCTION WORD
RAL
ISZ BCDP /ADVANCE TABLE POINTER
SNL /SKIP IF CHARACTER ASSEMBLED
JMP BCDP-3 /KEEP AT IT
DCA BCDN /SAVE CURRENT ASSEMBLY WORD
TAD BCDN
AND DEC17 /MASK OUT BCD CHARACTER
SZA /ZERO SUPPRESSION?
JMP .+4 /NON ZERO- PROCEED
TAD JOBRES /PRECEDING OUTPUT?
SNA CLA
JMP .+4 /NO; DON'T TYPE THE 0
TAD DEC260
DCA I IX1 /STORE IN BUFFER
ISZ JOBRES /SET OUTPUT FLAG
ISZ NUMHO /3 DIGITS ASSEMBLED?
JMP BCDP-2 /NO, REPEAT
TAD BCDI /NOW GET LAST DIGIT
TAD DEC260 /CONVERT TO ASCII
DCA I IX1 /STORE IN BUFFER
JMP I DECOUT /RETURN
DEC260, 260
DEC17, 17
BCDC, TAD BCDTB
BCDI, 0
BCDN, 0
BCDT, 2104 /MAGIC BITS
BCDTB, -3720 /-2000 DECIMAL
-1750 /-1000 DECIMAL
-1440 /-800
-0620 /-400
-0310 /-200
-0144 /-100
-0120 /-80
-0050 /-40
-0024 /-20
-0012 /-10
/ROUTINE TO RESTORE JOBDAT IF IT HAS BEEN KLUGED
JOBRES, 0
TAD SIJOB
SNA /IS HE LOGGED IN?
JMP .+7 /NO; JOBDAT IS NOT RELEVANT
DATFLD /YES
TAD JOBTBA /START OF JOBTBL
DCA IOTP7
TAD I IOTP7
DCA I JOBDAT /NOW JOB AND JOBDAT AGREE
CHDF
JMP I JOBRES /RETURN
/ROUTINE TO SEE IF A CONSOLE IS "ACTIVE"
/ACTIVE IS DEFINED AS HAVING A NONZERO
/FILL OR EMPTY POINTER ON INPUT OR OUTPUT SIDES
/CALL TAD DEVTBL POINTER
/ JMS TALK1
/ RETURN IF ACTIVE
/ RETURN IF NOT ACTIVE
/ IF INPUT DDB DOES NOT EXIST, CONSOLE IS INACTIVE
TALK1, 0
DCA IOTP2 /DEVTBL POINTER
DATFLD
TAD I IOTP2 /DDB ADDRESS
SNA /EXISTING?
JMP TALK12 /NOT YET
TAD C0004
DCA IOTP2 /POINTS TO FILL PTR
TAD I IOTP2 /FILL PTR
SZA CLA / =0?
JMP TALK13 /NO - SEE IF HE IS UNDER A PRIVILEGED ACCOUNT
TALK12, ISZ TALK1 /YES; CONSOLE IS THUS INACTIVE
JMP I TALK1 /RETURN
TALK13, CHDF
GETWRD
JOBSTS
AND C0200
SZA CLA
JMP TALK12 /HE IS - LET HER DO THE TALK
JMP I TALK1
ACTNM1, 0
GETWRD /CHECK ACCOUNT #
JOBACC
TAD P7777
CLL RTR /ALLOW EITHER ACCOUNT 1 OR ACCOUNT 3; NOONE ELSE!!!!
SZA CLA
JMP I COMERA /NOT ACCOUNT #; ERROR
JMP I ACTNM1
COMLGM, 314 /L
317 /O
307 /G
311 /I
316 /N
240
320 /P
314 /L
305 /E
301 /A
323 /S
305 /E
0
ILLREQ, 311 /I
314 /L
314 /L
305 /E
307 /G
301 /A
314 /L
240
322 /R
305 /E
321 /Q
325 /U
305 /E
323 /S
324 /T
215
212
0
QQEST, 277 /?
277 /?
0
PERIOD, 256 /.
0
*CTABLE
0
COMBUF, 0
0
0
0
0
0
0
0
0
0
0
0
FIPFLS=PRPER+USAVE+UREST
COMTBL, CL1 /LOGIN O1 S1;
NOLOG+PRPER+PRCRLF /IOTP2:=O1 ACCOUNT #
LIN /IOTP3-4:=S1 PASSWORD
LOGIN /RESP: VERSION # HR:MIN
-314 /.
-317
-307
-311
-316
CL1, CL2 /LOGOUT;
USERM+2 /RESP: .
OPEN /.
LOGOUT
-314
-317
-307
-317
-325
-324
CL2, CL3 /TIME;
NOLOG+PRPER+PRCRLF /RESP: HR:MIN
0 /.
TIME
-324
-311
-315
-305
CL3, CL4 /ASSIGN L1 O1;
FIPFLS+2 /AC0-5:=DEVICE # OF L1
ASD /AC6-11:=O1 UNIT #
ASSIGN /ERROR: AC NOT 0
-301 /RESP:
-323 /.
-323
-311
-307
-316
CL4, CL5 /RELEASE L1 O1;
FIPFLS+2 /SAME AS ASSIGN
REL
RELEAS
-322
-305
-314
-305
-301
-323
-305
CL5, CL7 /TALK C1 S1
NOLOG+PRPER+PRCRLF /C1=CONSOLE TO TALK TO
0 /S1=MESSAGE TO TRANSMIT
TALK /RESP: BUSY IF TARGET TTY IS ACTIVE
-"T / OTHERWISE CRLF
-"A
-"L
-"K
CL7, CL8 /OPEN O1 S1 O2;
FIPFLS+2 /IOTP1:=O1 INTERNAL FILE #
OPEN /IOTP2:=O2 ACCOUNT #
FOPEN /IOTP3-5:=S1 FILE NAME
-317 /ERROR: AC NOT 0
-320 /RESP:
-305 /.
-316
CL8, CL9 /CLOSE S1;
FIPFLS+2 /ACI:=1 I=0,1,2,3
CLOS /ERROR: AC NOT 0
CLOSE /RESP:
-303 /.
-314
-317
-323
-305
CL9, CL10 /CREATE S1;
FIPFLS+2 /IOTP1-3:=S1 FILE NAME
CRF /ERROR: AC NOT 0
CREATE /RESP:
-303 /.
-322
-305
-301
-324
-305
CL10, CL12 /RENAME O1 S1;
FIPFLS+2 /IOTP1:=O1 INTERNAL FILE #
REN /IOTP2-4:=S1 NEW NAME
RENAME /ERROR: AC NOT 0
-322 /RESP;
-305 /.
-316
-301
-315
-305
CL12, CL13 /REDUCE O1 D1;
FIPFLS+2 /IOTP1:=O1 INTERNAL FILE #
RED /IOTP2:=D1 # SEGMENTS TO REMOVE
REDUCE /ERROR: AC NOT 0
-322 /RESP:
-305 /.
-304
-325
-303
-305
CL13, CL14 /EXTEND O1 D1;
FIPFLS+2 /SAME AS REDUCE
EXT
EXTEND
-305
-330
-324
-305
-316
-304
CL14, CL15 /PROTECT O1 O2;
FIPFLS+2 /AC5-6:=O1 INTERNAL FILE #
PROT /AC7-11:=O2 NEW PROTECTION
PROTEC /ERROR: AC NOT 0
-320 /RESP:
-322 /.
-317
-324
-305
-303
-324
CL15, CL17 /F O1;
FIPFLS+3 /IOTP1:=O1 INTERNAL FILE #
FINF /ERROR: AC NOT 0
F /RESP: ACCT # FILE NAME PROT SIZE
-306 /.
CL17, CL18 /SAVE S1 O1 O2 O3;
USAVE+UREST+PRPER+2+USERM
OPEN
SAVE
-323
-301
-326
-305
CL18, CL19 /LOAM0G1 S1 O2 O3 O4
USAVE+UREST+PRPER+USERM+2
OPEN
LOAD
-314
-317
-301
-304
CL19, CL20 /START O1;
0
1 /FORCE IT THROUGH "FIPCHK"
START
-323
-324
-301
-322
-324
CL20, CL21 /S;
PRPER
0
S
-323
CL21, CL22 /WHERE;
PRPER+3
0
WHERE
-327
-310
-305
-322
-305
CL22, CL23 /USER O1;
NOLOG+PRPER+3
0
USER
-325
-323
-305
-322
CL23, CL29 /SWITCH O1;
PRPER
0
SWITCH
-323
-327
-311
-324
-303
-310
CL29, CL32 /DUPLEX;
PRPER+PRCRLF
0
DUPLEX
-304
-325
-320
-314
-305
-330
CL32, CL33 /R S1 O1
USERM+2 /S1=FILE NAME
OPEN /O1=STARTING ADDRESS; 0000 IF OMITTED
R
-322
CL33, CL34 /RUN C1 S1 O1
USERM+2 /C1=ACCOUNT OF FILE OWNER (OPTIONAL)
OPEN /S1=FILE NAME
RUN /O1=STARTING ADDRESS; 0000 IF OMITTED
-322
-325
-316
CL34, CL35 /EXAMINE C1 D1
PRPER+USERM+1 /C1=STARTING ADDRESS
DMAR
EXAMIN /D1=# OF LOCATIONS TO EXAMINE
-305
-330
-301
-315
-311
-316
CL35, CL36 /DEPOSIT C1 C2 C3 ... C13
PRPER+USERM+1 /C1=STARTING ADDRESS
DMAW /C2,...,C13=NEW VALUES
DEPOSI
-304
-305
-320
-317
-323
-311 /no ending T??? PROTECT has one!
CL36, CL37 /VERSION
NOLOG+PRPER+PRCRLF /RESP: TSS8/.C1
0
VERSIN /C1=VERSION #
-326
-305
-322
-323
-311
-317
CL37, CL38 /BREAK O1
PRPER+PRCRLF
0
BREAK
-"B
-"R
-"E
-"A
-"K
CL38, CL39 /RESTART O1
PRPER
0
RESTRT
-"R
-"E
-"S
-"T
-"A
-"R
CL39, CL40 /UNDUPLEX
PRPER+PRCRLF
0
UNDUPL
-"U
-"N
-"D
-"U
-"P
-"L
CL40, CL41 /SYSTAT
USERM+2
OPEN
SYSTAT
-"S
-"Y
-"S
-"T
-"A
-"T
CL41, CL42 /KJOB
USERM+2 /EQUIVALENT TO .R LOGOUT
OPEN
LOGOUT
-"K
-"J
-"O
-"B
CL42, CL43 /BROADCAST S1
PRPER+PRCRLF+7 /SEND MESSAGE TO ALL CONSOLES
0 /MUST BE LOGGED IN AS ACCT 1 OR 3
BROAD
-"B
-"R
-"O
-"A
-"D
-"C
CL43, CL44 /FORCE C1 S1
PRPER+PRCRLF+7 /FORCE STRING S1 INTO INPUT BUFFER OF CONSOLE C1
0 /USER MUST BE LOGGED IN AS ACCT 1 OR 3
FORSE /ANY "LETTER" PRECEEDED BY "^" WILL BECOME A CONTROL CHARACTER
-"F /"^S", "^Q", "^B" OR "^C" ARE THE MOST USEFUL
-"O
-"R
-"C
-"E
CL44, CL45 /ON LINE
PRPER+PRCRLF
0
ON
-"O
-"N
CL45, CL46 /OFFLINE
PRPER+PRCRLF
0
OFFLIN
-"O
-"F
-"F
CL46, 0
UNACCT, 325 /U
316 /N
301 /A
325 /U
324 /T
310 /H
317 /O
322 /R
311 /I
332 /Z
305 /E
304 /D
240
301 /A
303 /C
303 /C
317 /O
325 /U
316 /N
324 /T
240
0
LOGE1, 306 /FULL
325
314
314
0
WHERPC, 240 /SP PC=
320
303
275
0
WHERAC, 240 /SP SP AC=
240
301
303
275
0
WHERSW, 215 /CR LF SW=
212
240
323
327
275
0
TYCRLB, "T;"Y;"P;"E;240;"^;"B;"S;240;"F;"I;"R;"S;"T;215;212;0
NONSUC, "D;"E;"V;"I;"C;"E;240;;"N;"O;"T;240;"A;"V;"A;"I;"L;"A;"B;"L;"E
CRLF, 215
212
0
TALK, ENDTST /END OF COMMAND
JMP I COMERA /YES
NUMBIN /GET CONSOLE #
-267
JMP TALK6 /IGNORE "K"
TALK7, SPA
CIA /MAKE SURE IT'S POSITIVE
DCA IOTP0
TAD IOTP0 /VALIDITY CHECK
TAD TALKMX /-HIGHEST CONSOLE #
SMA CLA
JMP I COMERA
TAD IOTP0
CLL RAL
TAD DEVTBA /POINTER TO DEVTBL
DCA IOTP4
TAD IOTP4
JMS I TALK1A /INPUT SIDE INACTIVE?
JMP TALKNO /NO
ISZ IOTP4 /POINTS TO OUTPUT SIDE
TAD IOTP4
JMS I TALK1A /OUTPUT SIDE INACTIVE?
JMP TALKNO /NO
CDF /GET # OF CALLING CONSOLE
TAD I COMPTR
TAD TALKXX
CLL RAR
CHDF
OCTASC
COMBUF-1 /AND PUT IN COMBUF
JMS TALK5 /"CRLF** K"
TALKM1
JMS TALK5 /"MM"
COMBUF+2
TAD SIJOB
SNA
JMP .+4
JMS I TALKAC
JMS TALK5 /OUTPUT HER ACCOUNT NUMBER
ACCBUF
JMS TALK5 /" ** "
TALKM2
DCA NUMHO /MAKE CHAR,NUMHO TWO WORD VECTOR
TALK2, JMS TALK5 /PUT CHAR IN DESTINATION BUFFER
CHAR
COMGET /GET NEXT CHARACTER
JMP TALK4 /END OF MESSAGE
JMP TALK2
TALK4, JMS TALK5
CRLF
JMP I COMEXA
TALKAC, GETACC
TALKXX, -DEVTBL
TALKNO, TAD TABSYM /"BUSY"
JMP I COMEXA
TALK6, TAD CHAR /WAS IT A K?
TAD TALKMK
SZA CLA
JMP TALK7 /NO, ASSUME OPR
TAD TALKZE /MAKE CHARACTER A "0"
DCA CHAR
JMP TALK+2
TALKMK, -"K
TALK5, 0 /OUTPUT A CHARACTER
TAD I TALK5 /BUFFER ADDRESS
DCA .+3
TAD IOTP4 /DEVTBL ADDRESS
ASCOUT
0
JMP TALKNO /NO ROOM...INDICATE BUSY
ISZ TALK5 /SKIP ARGUMENT
JMP I TALK5
TABSYM, BUSY
TALKZE, "0
TALK1A, TALK1
TALKMX, -NULINE-1
LOGOMA, 5457 /LO
4757 /GO
6564 /UT
TALKM1, 215;212;"*;"*;240;"K;0
BUSY, "B;"U;"S;"Y;0
OK, "O;"K
SPACE, 240
0
*ERPAGE
SYSDSI, DSI
SYSPRT, WHEPRT
SYDING, SYBELL
SY3760, 3760
CONCLR, SICLR
SYSEJN, USRPR
SYSERR, TAD SIJOB
TAD TTYTBA
DCA COMDB0 /POINTER TO TTYTBL
DATFLD
TAD I COMDB0
CLL RAL /UNIT*2= POSITION IN DEVTBL
TAD DEVTBA
DCA COMDB0
TAD COMDB0
CDF
DCA I COMPTR
DCA COMRDB
DATFLD
TAD I COMDB0
DCA COMDB0
TAD SYSDSI
CMA
AND I COMDB0
TAD SYSDSI
DCA I COMDB0
CHDF
JMS SYSER0
TAD IOTP6
AND C0010
SZA CLA
JMP I SYDING
TAD IOTP6
SPA CLA
JMS I SYSPRT
ASCOUT
CRLF
NOP
ASCOUT
PERIOD
NOP
EXIT
SYSER0, 0
GETWRD
JOBSTS
AND C0007
TAD SYSETB
DCA SYSER1
DATFLD
TAD I IOTP7
DCA IOTP6
TAD IOTP6
AND SY3760
TAD C0010
DCA I IOTP7
ISZ IOTP7 /POINTS TO STR1
CLL STA RTL
AND I IOTP7
DCA I IOTP7
CHDF
TAD IOTP6
AND C0010
SZA CLA
JMP I SYSER0
TAD I SYSER1
DCA SYSER1
RESDDB
DATFLD
DCA CHDFA
TAD I CHDFA
CIF
JMS I CONCLR /MAKE ROOM FOR THE ERROR MESSAGE
ASCOUT
CRLF
JMP SYSER2
ASCOUT
SYSER1, 0
NOP
SYSER2, ASCOUT
FORJOB
JMP SYSER4
TAD SIJOB
JMS I SYSEJN
ASCOUT
CRLF
NOP
SYSER4, JMP I SYSER0
SYSETB, .+1
QQEST
SYSET1
SYSET2
SYSET3
QQEST
SYSET5
SYSET6
QQEST
SYSET1, 311 /ILLEGAL IOT
314
314
305
307
301
314
240
311
317
324
0
SYSET2,
SYSET3, 323 /SWAP ERROR
327
301
320
240
305
322
322
317
322
0
SYSET5, 304 /DISK ERROR
311
323
313
240
305
322
322
317
322
0
/RETURN FOR FILE COMMANDS
FIPEND, GETWRD
JOBREG+2
SNA
JMP I COMEXA
CIA
DCA IOTP1
TAD FIPETB
DCA IX1
FIPEN1, TAD I IX1
SNA
JMP FIPEN2 /NOT IN TABLE
TAD IOTP1
SZA CLA
JMP FIPEN1
TAD IX1 /GET MESSAGE ADDRESS
TAD FIPMTB
DCA IOTP1
TAD I IOTP1
JMP I COMERA
FIPEN2, ASCOUT
CRLF
NOP
ASCOUT
FAILBY
NOP
TAD COMBFA
DCA IX1
TAD IOTP1
CIA
JMS I FIPDEC
DCA I IX1
ASCOUT
COMBUF
NOP
ASCOUT
SEGMTA
NOP
JMP I COMEXA
DUPLEX, TAD C0200 /DUPLEX BIT
UNDUPL, DCA IOTP0
DATFLD
TAD I COMDB0 /WORD 1 OF DDB
AND P7577 /CLEAR BIT
TAD IOTP0 /SET BIT
DCA I COMDB0 /SAVE IT
JMP I COMEXA
P7577, 7577
FIPDEC, DECOUT
RKJOBA, RKJOB
WAIT3, TAD I RKJOBA
CIA
TAD SIJOB
SNA CLA /DOES HE OWN THE RK05 CONTROLLER?
JMP I COMEXA /YES - LET HER FINISH
DTSIDT, DCA I IOTP7 /CLEAR OUT WAIT 2 MASK
CLL STA RAL
TAD IOTP7
DCA IOTP7
STA
DCA I IOTP7 /-1 TO DEV. STATUS REG
CHDF
GETWRD
JOBREG+2
DATFLD
DCA I IOTP7 /CLEAR HER AC
JMP I COMEXA
WAITIO, "W;"A;"I;"T;" ;"F;"O;"R;" ;"I;"/;"O;215;212;0
FAILBY, 306 /F
301 /A
311 /I
314 /L
305 /E
304 /D
240
302 /B
331 /Y
240
0
SEGMTA, 240
323 /S
305 /E
307 /G
315 /M
305 /E
316 /N
324 /T
323 /S
0
FIPETB, .
4000 /FILE NOT OPEN
4400 /FILE IN USE
5000 /DIRECTORY FULL
5400 /BAD DIRECTORY
6000 /PROTECTION VIOLATION
6400 /BAD FILE NAME
7000 /FILE NOT FOUND
7400 /DISK FULL
0
FIPMTB, .-FIPETB
FM4000
FM4400
FM5000
FM5400
FM6000
FM6400
FM7000
FM7400
FM6400, "B;"A;"D;240;"F;"I;"L;"E;240;"N;"A;"M;"E;0
FM7000, 306
311
314
305
240
316
317
324
240
306
317
325
316
304
0
FM4400, 306
311
314
305
240
311
316
240
325
323
305
0
FM5000, 304
311
322
305
303
324
317
322
331
240
306
325
314
314
0
FM6000, 320
322
317
324
305
303
324
311
317
316
240
326
311
317
314
301
324
311
317
316
0
FM4000, 306
311
314
305
240
316
317
324
240
317
320
305
316
0
FM7400, 304
311
323
313
240
306
325
314
314
0
TALKM2, 240;"*;"*;215;212;0
VERSIM, 215;212;"T;"S;"S;"/;"8;".;"2;"4;"+;207;240;240;0
*VERBRK-2
215
212
/VERBRK,
ZBLOCK 200 /LOGIN MESSAGE GOES HERE
$$$$$$