1
0
mirror of synced 2026-01-26 04:01:42 +00:00
Files
lisper.cpus-pdp8/tss8.2/init.pal
2010-04-02 15:46:14 +00:00

4460 lines
55 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.
/INIT 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.
/RIM AUTO-LOADER FOR TSS/8 INIT
RIM1= 7757
RIM2= 7760
*7400
FIX, DCA RD1 /SAVE SKIP IOT
*7401
TAD K5
*7402
TAD RD1
*7403
DCA RD2 /SAVE READ IOT
*7404
RIF /CURRENT FIELD
*7405
CMA
*7406
AND KCDF /CREATE CDF FOR FIELD 0 OR 2
*7407
DCA KCDF
*7410
KCDF, CDF 20
*7411
JMS FRM /READ NEXT FRAME; SKIP ON RETURN
*7412
LOOP, DCA SUM /SAVE NEW CHECKSUM
*7413
TAD CHAR0
*7414
DCA CHAR1 /SAVE LEFT BYTE
*7415
JMS READ
*7416
DCA CHAR2 /SAVE RIGHT BYTE
*7417
JMS FRM /LOOK AHEAD
*7420
JMP CHKSUM /WE HAVE THE CHECKSUM
*7421
JMS ASSMBL /ASSEMBLE BOTH BYTES
*7422
SNL /DATA OR ORIGIN?
*7423
JMP OSAVE /DATA
*7424
DCA ORG /SAVE NEW ORIGIN
*7425
ADD, TAD CHAR1
*7426
TAD CHAR2 /SUM BOTH BYTES
*7427
TAD SUM /WITH THE OLD SUM
*7430
JMP LOOP
*7431
OSAVE, DCA I ORG /SAVE DATA
*7432
ISZ ORG /INCREMENT ADDRESS
*7433
RM200, 7600 /COVER SKIP WITH CONSTANT
*7434
JMP ADD
*7435
CHKSUM, JMS ASSMBL /ASSEMBLE CHECKSUM BYTES
*7436
CIA
*7437
TAD SUM /SUBTRACT CALCULATED SUM
*7440
SZA /OK?
*7441
HLT /NO; ERROR
*7442
STL RTL /AC=2
*7443
TAD KCDF /PLUS CDF TO "INIT'S" FIELD
*7444
DCA K5 /SAVE
*7445
K5, 5 /CIF CDF TO FIELD 0 OR 2
*7446
JMP 0 /JUMP INTO INIT
*7447
READ, 0
*7450
RD1, HLT /SKIP IOT
*7451
JMP .-1
*7452
RD2, HLT /READ IOT
*7453
DCA CHAR0
*7454
TAD CHAR0
*7455
JMP I READ
*7456
FRM, 0
*7457
JMS READ /READ A FRAME
*7460
TAD RM200
*7461
SPA /IS IT DATA/ORIGIN?
*7462
ISZ FRM /YES; SKIP ON RETURN
*7463
SPA SNA CLA /FIELD SETTING?
*7464
JMP I FRM /NO
*7465
JMP FRM+1 /YES; IGNORE IT
*7466
ASSMBL, 0
*7467
TAD CHAR1 /LEFT BYTE
*7470
CLL RTL
*7471
RTL
*7472
RTL /SHIFTED INTO POSITION
*7473
TAD CHAR2 /PLUS RIGHT BYTE
*7474
JMP I ASSMBL
*7475
ORG, 0
*7476
CHAR0, 24 /CHECKSUM CORRECTION; RIGHT BYTE
*7477
CHAR1, 0
*7500
CHAR2, 0
*7501
SUM, 6000 /CHECKSUM CORRECTION; LEFT BYTE
*7601
RIMJMP, TAD RIMFIX
*7602
DCA RIM2 /RESTORE RIM LOADER
*7603
TAD RIM1 /GET SKIP IOT
*7604
JMP I FIXA
*7605
RIMFIX, JMP RIM1
*7606
FIXA, FIX
*RIM2
JMP RIMJMP /EXIT FROM RIM
/PAGE 0
FIELD 2 /INIT LOADS ONTO DISK TRACK 2
*0
JMP I SUPERA /JUST IN CASE!!
SUPERA, SUPER
*10
AXS1, .
AXS2, .
SIDATA= 20 /SYSTEM INTERPRETER DATA
CONSTANTS=SIDATA+12
*CONSTANTS
C0002, 2
C0003, 3
C0004, 4
C0007, 7
C0037, 37
C0100, 100
C1000, 1000
C7770, 7770
C7600, 7600
C7763, 7763
DM32,
C7740, 7740
JOBCON= CONSTANTS+11 /JOB CONTROL
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
DATEND= 60 /END OF FIELD 0 PAGE 0 DATA
FIPDAT= 155 /DATA REFERENCED BY FIP
*FIPDAT+1
C0400, 400
SEGSIZ= C0400 /# WORDS PER SEGMENT
CORTBA, CORTBL-1 /CORE ALLOCATION TABLE
DSUTBA, DSUTBL /USER DISC REQUEST QUEUE
/THE DATE IS KEPT AS A 12 BIT NUMBER IN THE FORMAT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1
*DATE
DATE, .
CORSRA, CORSRC
WAITA, WSCHED
WAIT= JMP I WAITA
/SUBROUTINE DISPATCHES
SUBDSP= DATEND
*SUBDSP
CHDFA, 0
INIF, HLT
JMP I CHDFA
CHDF= JMS CHDFA
CJOBMX, -JOBMAX
INBUF, INBUFA
NUMBIA, NUMBI0
CHAR, 0
NUMHO, 0
0
0
CORCNT, 0
C0010, 10
C6201, 6201
C0200, 0200
C0177, 0177
COMGEA, COMGE0
DISCA, DISC0
DISCHA, DISCH0
YESNO= JMS I .
YESNO0
MESSAG= JMS I .
MESSA0
OCTIN= JMS I .
OCTIN0
GETIN= JMS I .
GETIN0
OUTTLS= JMS I .
OUTA, OUT
INKRB= JMS I .
IN
ZERO1= JMS I .
ZERO
CHEKCC= JMS I .
CCCHEK
SWBASE, SWDEX /SWAP TRACK FOR JOB 1
C7777, -1
MC0377, -377
OSF, OSTRAP
OST, 7607
OSC, -16
OSA, 7607
OSTAB, .
RBOOT
7746
-7
7746
KBOOT
26
-4
26
KBOOT, DLCA
DLDC
DLAG
JMP 31
OSTRAP,
NOPUNCH
*7607
ENPUNCH
TAD KA
DCA 7754
TAD KA
DCA 7755
DTLB
TAD KB
DTLA
DTSF
JMP .-1
TAD KC
JMP .-4
KA, 7577
KB, 600
KC, 220
/PAGE ASSIGNMENTS
INIP= 1000
/PROGRAM TO OPEN AND MODIFY SINGLE DISC REGISTERS
*0200
DISCLK, TAD KCR /PUT OUT A CR, LF
OUTTLS
TAD KLF
OUTTLS
/ NOW GET AN ADDRESS FROM THE KEYBOARD
JMS OTIN
JMP DISCLK /: IS ONLY VALID TERMINATOR
JMP DISCLK / " "
/DISC ADDRESS FOLLOWED BY ":" HAS BEEN ENTERED
DISPLA, JMS SPACE /PROVIDE ELEGANT FORMAT
JMS I POPEN /GET REG FROM DISC
TAD OPNREG /GET THIS VALUE
JMS I PHACK /DISPLAY IT
JMS SPACE /CONTINUE POLICY OF ELEGANT FORMATING
JMS I PSAVE /SAVE VALUE, VALUE1
/REGISTER IS OPEN ---- WAIT FOR A MODIFY
JMS OTIN
JMP SHUT /TERMINATOR WAS CR
JMP CLSOPN /TERMINATOR WAS LF
/: WAS TYPED ---- MUST BE NEW DISC ADDRESS
JMP DISPLAY
/CARRIAGE RETURN MEANS CLOSE REGISTER
/FIRST, SEE IF IT WAS MODIFIED
SHUT, TAD INPUT
SPA CLA
JMP DISCLK /NO MODIFY
/OPEN REGISTER WAS MODIFIED, SO CHANGE ON THE DISC
TAD VALUE1
DCA OPNREG
JMS I PCLOSE /WRITE VALUE OUT
/NOW SEND OUT LF AND START AGAIN
JMP DISCLK
/LINE FEED MEANS CLOSE REGISTER AND OPEN THE NEXT ONE
CLSOPN, TAD INPUT
SPA CLA
JMP .+4 /NO MODIFY
/VALUE WAS MODIFIED, SO WRITE OUT NEW ONE
TAD VALUE1
DCA OPNREG
JMS I PCLOSE
/RESPOND TO LF WITH CR
TAD KCR
OUTTLS
TAD KCR
OUTTLS /FOR TIMING (??)
/NOW RESTORE ADDR WORD TO VALUE1
JMS I PRESTOR
/NOW INCREMENT ADDRESS IN VALUE, VALUE1
JMS I PNEXTAD
/NOW TYPE OUT THIS NEW ADDRESS
TAD VALUE
JMS I PHACK
TAD VALUE1
JMS I PHACK
TAD KCOLON
OUTTLS
JMP DISPLAY
/TYPE TWO SPACES
SPACE, 0
TAD KSPACE
OUTTLS
TAD KSPACE
OUTTLS
JMP I SPACE
KSPACE, 0240
KCOLON, 0272
KCR, 0215
KLF, 0212
POPEN, XOPEN
PCLOSE, CLOSE
PNEXTAD, NEXTAD
PSAVE, SAVE
PRESTOR, RESTOR
PHACK, HACK
/ROUTINE TO INPUT AN OCTAL NUMBER
/ECHOES INPUT IF IT WAS VALID
/CALL: JMS OTIN
/ CR TERMINATOR
/ LF TERMINATOR
/ : TERMINATOR
/
/RETURNS WITH "DOUBLE PRECISION" INPUT IN
/VALUE AND VALUE1
/INPUT=0 IF THERE WAS ANY, ELSE -1
OTIN, 0
CLA CMA
DCA INPUT /NO INPUT YET
DCA VALUE /SUBTOTAL
DCA VALUE1
SKP
OUTTLS
LISTEN, INKRB
DCA YCHAR
/IS THE INPUT A VALID TERMINATOR?
TAD YCHAR
TAD KMCOLON /COLON?
SNA
JMP COEXIT /YES
TAD KMLF /LF?
SNA
JMP LFEXIT /YES
TAD KMCR /CR?
SNA
JMP CREXIT /YES
/NOT A VALID TERMINATOR --- IS IT A VALID OCTAL DIGIT?
TAD KMEIGHT
STL
TAD C0010
SZL /IS IT A VALID OCTAL DIGIT?
JMP NOTOK /NO
/COMES HERE WITH A VALID OCTAL DIGIT
ISZ INPUT /REMEMBER THAT THERE IS INPUT
NOP
/NOW ADD THIS DIGIT TO THE DOUBLE PRECISION TOTAL
DCA XCHAR
/FIRST, SHIFT HIGH-ORDER WORD LEFT ONE PLACE
TAD VALUE
CLL RAL
CLL RAL
CLL RAL
DCA VALUE
/NOW GET LEFT-MOST LOW-ORDER DIGIT
TAD VALUE1
RTL
RTL
AND C0007
/MOVE THIS DIGIT INTO THE HIGH ORDER WORD
TAD VALUE
DCA VALUE
/NOW ADD NEW INPUT DIGIT
TAD VALUE1
CLL RAL
CLL RAL
CLL RAL
TAD XCHAR
DCA VALUE1
TAD YCHAR
JMP LISTEN-1 /NOW GO ECHO INPUT
COEXIT, ISZ OTIN
LFEXIT, ISZ OTIN
CREXIT, TAD YCHAR
OUTTLS /ECHO TERMINATOR
JMP I OTIN
NOTOK, CLA
MESSAG
NOTOK1
JMP OTIN+1
NOTOK1, TEXT " ?_"
VALUE, 0
VALUE1, 0
OPNREG, 0
YCHAR, 0
XCHAR, 0
INPUT, -1
KMCOLON, -0272
KMLF, -0212+":
KMCR, -0215+212
KMEIGHT, -0270+215
*0400
XOPEN, 0
JMS CONVERT /MAKE A DISC ADDRESS OUT OF VALUE, VALUE1
TAD READCOM /WE ARE READING
JMS DISK
JMP I XOPEN
READCOM, 6603 /DMAR
/ROUTINE TO CLOSE A DISC REGISTER
CLOSE, 0
TAD WRITECOM
JMS DISK
JMP I CLOSE
WRITECOM, 6605 /DMAW
/DISC TRANSFER ROUTINE
DISK, 0
DCA DISCIOT /READ IOT OR WRITE IOT
/NOW HAVE TO SET UP 7750,7751 IN FIELD 0
/REMEMBER WHAT FIELD WE'RE IN NOW
/SO WE CAN RESTORE
RIF
TAD .+2
DCA XFIELD
CDF /NOW GO TO DATA FIELD 0
CLA CMA
DCA I P7750 /LOOKING FOR ONE WORD
TAD POPNREG
DCA I P7751 /READ INTO OPNREG
/7750, 7751 ARE SET --- RESTORE DATA FIELD
/ALSO, SET DISC TO TRANSFER INTO THIS FIELD
XFIELD, 0
RIF
IFZERO RF08-40 <TAD I PDISCHI>
6615 /DIML; FIELD , NO INTERRUPTS
IFZERO RF08 <TAD I PDISCHI /PICK UP HIGH ADDRESS
6643 /DXAL>
CLA /DEAL DOESN'T CLEAR AC
TAD I PDISCLO /PICK UP LOW ADDRESS
DISCIOT, 0 /DMAR OR DMAW
6621 /DFSE -- ANY ERRORS?
IFZERO RF08 <SKP CLA /NO
HLT /YES
6622 /DFSC --- DONE?
JMP .-4 /NO>
IFZERO RF08-40 <HLT
6622
JMP .-3>
DCMA /DON'T LEAVE DISK FLAG UP
JMP I DISK /YES
P7750, 7750
P7751, 7751
PDISCHI, DISCHI
PDISCLO, DISCLO
POPNREG, OPNREG-1
/ROUTINE TO CONVERT THE DOUBLE PRECISION NUMBER
/IN VALUE, VALUE1 INTO AN RF08 DISC ADDRESS
/PUT IT IN DISCHI, DISCLO
CONVERT, 0
CLA
TAD I PVALUE
IFZERO RF08-40 <ANDN C0177
CLL RTL
RTL
RTL>
DCA I PDISCHI
TAD I PVALU1
DCA I PDISCLO
JMP I CONVERT
PVALUE, VALUE
PVALU1, VALUE1
/ROUTINE TO TYPE THE 4 OCTAL DIGITS IN THE AC
/ON THE TELEPRINTER
HACK, 0
CLL RAL
DCA XHACK
TAD KM4
DCA XCNT /4 DIGITS
YHACK, TAD XHACK
RTL
RAL
DCA XHACK
TAD XHACK
AND C0007
TAD K260
OUTTLS
ISZ XCNT
JMP YHACK
JMP I HACK
XCNT, 0
DISCHI, 0
DISCLO, 0
XHACK, 0
KM4, -4
K260, 260
/ROUTINE TO GET A CHAR FROM THE KEYBOARD
IN, 0
KSF
JMP .-1
JMS CCCHEK /IS IT A CONTROL-C?
KRB
AND C0177
TAD C0200 /IN CASE OF PARITY TERMINALS
JMP I IN /RETURN
CCCHEK, 0
KSF
JMP I CCCHEK
KRS /WHAT'S THE CHARACTER?
AND C0177 /PARITY TERMINAL?
TAD KCRC
SMA
CML
SNA CLA
JMP I SUPERA /HE WANTS TO RESTART - ^C
JMP I CCCHEK /NO ^C
KCRC, -3 /- ^C, STRIPPED OF PARITY BIT
/ROUTINE TO TELEPRINT A CHAR
OUT, 0
NOP /CHANGE TO "KSF" IF DESIRED TO TERMINATE PRINT-OUT UPON TYPE-AHEAD
SKP /NO
JMP OUT0 /YES; DON'T WASTE TIME WITH FURTHER PRINTING
TLS
TSF
JMP .-1
OUT0, CLA
CHEKCC
JMP I OUT
/ROUTINE TO INCREMENT THE DOUBLE-PRECISION VALUE
/IN VALUE, VALUE1
NEXTAD, 0
CLA
ISZ I PVALU1
JMP I NEXTAD
ISZ I PVALUE
JMP I NEXTAD
/ROUTINE TO SAVE VALUE, VALUE1
SAVE, 0
TAD I PVALUE
DCA SAVE1
TAD I PVALU1
DCA SAVE2
JMP I SAVE
/ROUTINE TO RESTORE VALUE, VALUE1
RESTOR, 0
TAD SAVE1
DCA I PVALUE
TAD SAVE2
DCA I PVALU1
JMP I RESTOR
SAVE1, 0
SAVE2, 0
*600
LOGMES, 0 /PUT MESSAGE OF THE DAY IN SI
YESNO
LOGM1 /"PROMO?"
JMP I LOGMES /NO
DISC /YES, READ SI INTO FIELD 1
6603
SIDEX+1
DISCHK /CHECK FOR DISK OK
LOG2LG, MESSAG /MESSAGE TOO LONG
LOGM2 /"END WITH ALTMODE"
STA
TAD LOGST /VERBRK
DCA AXS1
TAD LOGST
DCA NUMHO /FOR GETCH
IAC
DCA NUMHO+1
DATFLD /LOGIN MESSAGE TO FIELD 1
LOGNEX, JMS I GETCHA /GET A CHARACTER INTO BUFFER
JMP LOG2LG /MESSAGE TOO LONG
TAD MC0377 /IS IT AN ESCAPE OR ALTMODE?
IAC /TEST FOR MODEL 35 ALTMODE
SZA
IAC /TEST FOR ALTMODE
SZA
TAD LOGESC /TEST FOR ESCAPE
SZA CLA
JMP LOGNEX /NOT ESCAPE OR ALTMODE, GET ANOTHER CHAR
TAD AXS1
DCA CHAR
DCA I CHAR /A 0 ENDS THE MESSAGE IN SI
CHDF
MESSAG /ECHO $CR-LF
LOGM3
DISC /WRITE OUT SI
6605
SIDEX+1
DISCHK /CHECK FOR DISK OK
JMP I LOGMES
LOGST, VERBRK /START OF INSTALLATION MESSAGE OF THE DAY
GETCHA, GETCH
LOGESC, 375-233 /ALT MODE MINUS ESCAPE
OCI260, -260
OCTINT, 0
OCTIN0, 0
DCA OCTINT
STA
TAD INBUF
DCA AXS1
OCTIN1, TAD I AXS1
DCA AXS2
TAD AXS2
TAD OCI260
SPA
JMP OCTIN2
TAD C7770
SMA
JMP OCTIN2
TAD C0010
DCA AXS2
TAD OCTINT
CLL RTL
RAL
TAD AXS2
DCA OCTINT
JMP OCTIN1
OCTIN2, CLL CLA
TAD OCTINT
JMP I OCTIN0
/AFTER LOAD OR DUMP, BOOT BACK TO WHATEVER OPERATING SYSTEM IS ON THE RF08.
/THIS WAY, INIT CAN BE USED TO LOAD/DUMP OS/8.
RBOOT, 6641 /DCXA /CLEAR RF08 EXTENDED DISK ADDRESS
DCEA /AND EVERYTHING ELSE
-200 /CLA
DMAR
DFSC
5352 /JMP .
5752 /JMP I .-1
CRLF= LOGM2+10
LOGM2, TEXT "END WITH ALTMODE_"
LOGM3, TEXT "$_"
SYSTEM, TEXT "SYSTEM"
LIBARY, TEXT "LIBRARY"
OPRAT, TEXT "OPERATOR"
PASWRD, TEXT " PASSWORD? "
TAB, -01
-11
-21
-41
-51 /THE NEXT WORD MUST BE POSITIVE
MSG, TEXT "_SI"
TEXT "_FIP"
TEXT "_INIT"
TEXT "_TS8"
TEXT "_PUTR"
UPAROW, TEXT " ^ "
*INIP
/ZERO OUT FIRST 6 TRACKS IN PREPARATION FOR BUILDING NEW SYSTEM
SBUILD, YESNO
REALLY
JMP I SUPERA /LUCKILY WE CAUGHT HIM/HER
ZERO1 /ZERO FIELD 1
TAD C0051 /START AT TRACK 5, FIELD 1
SB2, DCA SB3
DISC
DMAW /WRITE A FIELD OF ZEROES TO DISK
SB3, .-.
DISCHK /MAKE SURE DISK IS OK
TAD SB3
TAD C7770 /GO TO PREVIOUS TRACK
SMA /ARE WE THROUGH?
JMP SB2 /NO
TAD MSGA /INITIALIZE ADDRESS OF MESSAGES
DCA MSGB
TAD TABA /INITIALIZE TABLE POINTER
DCA TABB
BUILD1, MESSAG /ASK FOR A TAPE
MSGB, .-.
TAD I PATXAD
DCA SB3
MESSAG
UPAROW /" ^ "
SB4,
IFNZRO CPU&7776 <6030> /ON 8E, CLEAR FLAG, BUT NO READER RUN
IFZERO CPU&7776 <KCC > /CLEAR FLAG
INKRB /WAIT FOR A KEY TO BE PRESSED
TAD C7600 /LEADER?
SZA
TAD C7763 /CARRIAGE RETURN?
SZA CLA
JMP SB4 /NO
STA
DCA FLAG
/ROUTINE TO PATCH THE DISK. A BINARY TAPE IS READ, AND THE CORRESPONDING
/WORDS ON A DISK TRACK ARE PATCHED. THE FIELD SETTING ON THE TAPE
/DETERMINES WHICH TRACK WILL BE PATCHED. A TAPE WITHOUT A FIELD SETTING
/WILL PATCH TRACK 5. A TAPE WITHOUT AN ORIGIN WILL LOAD STARTING AT 0
/HENCE A SAVE FORMAT TAPE WILL LOAD PROPERLY INTO THE SWAP TRACK FOR
/JOB NUMBER 1.
PATCH, DISC
DMAR /READ TRACK 5 INTO CORE
C0051, 0051 /TO PATCH IT IF NO FIELD SETTING
DISCHK /MAKE SURE THE DISK IS OK
TAD .-2 /NOW REMEMBER WHAT IS IN FIELD 1
DCA PATW /SO IT WILL BE PROPERLY RE-WRITTEN
TAD PATW
DCA PATR
CDF 10 /USE FIELD 1 AS BUFFER
JMS I BINTA /READ THE BINARY TAPE
JMP PATFLD /A FIELD SETTING HAS BEEN ENCOUNTERED
SNA /END OF TAPE - WAS THERE A CHECKSUM ERROR?
JMS PATRW /NO, SO WRITE OUT FIELD 1
ISZ FLAG /WHERE DID WE COME FROM?
JMP I SUPERA /BACK TO SUPERVISOR
CHDF
SZA CLA /CONTINUE BUILDING - WAS THERE ERROR?
JMP BHUH /YES - TRY AGAIN
TAD I TABB /NO - WAS RIGHT TAPE LOADED?
TAD PATR
SZA CLA
JMP BHUH /NO - TRY AGAIN
IAC
TAD SB3 /ADDRESS OF LAST CHARACTER TYPED + 1
DCA MSGB /SET UP FOR NEXT MESSAGE
ISZ TABB
TAD I TABB /ARE WE THROUGH?
SPA CLA
JMP BUILD1 /NO
JMP I .+1 /YES
SUPREF
BHUH, MESSAG
HUH2
JMP BUILD1
PATXAD, BUFPTR
MSGA, MSG+7 /AC IS -7 WHEN THIS IS TADDED
TABA, TAB
FLAG, 0
TABB, 0
PATFLD, IAC /TRACK IS IN BITS 6-8, MAKE IT FIELD 1
DCA PATR /AND SAVE IT
JMS PATRW /WRITE PREVIOUS TRACK; READ NEW ONE
JMP I BINT3A /AND CONTINUE
BINT3A, BINT3
BINTA, BINTAP
PATRW, 0
DISC
DMAW /WRITE THE PREVIOUS TRACK
PATW, .-. /TRACK FOR PREVIOUS PATCHING
DISCHK /MAKE SURE THE DISK IS OK
DISC
DMAR /READ IN NEW TRACK
PATR, 1 /TRACK FOR UPCOMING PATCHING
DISCHK /MAKE SURE THE DISK IS OK
TAD PATR
DCA PATW /REMEMBER WHICH TRACK WE'RE WORKING ON
JMP I PATRW /AND RETURN
/SYSTEM INITIALIZATION
SYSINI, DISC /READ INIT INTO FIELD 2
DMAR
0022
DISCHK /MAKE SURE DISK IS OK
CIF CDF 20 /NOW GO THERE
JMP .+1
TAD .-2
DCA INIF /SET UP CHDF
JMS I SYSPER /INITIALIZE FIP
DISC /LOAD FIELD 0
6603
TS8DEX
DISCHK /CHECK FOR DISK OK
TAD DVTBA
DCA INIT0
SYSI1, TAD I INIT0
DCA CHDFA
JMS I CHDFA
ISZ INIT0
JMP SYSI1
SYSPER, PERSET
INIT0, 0 /VARIABLE DVTB POINTER
DVTBA, DVTB /ADDRESS OF DVTB
XTELL, TEXT "_EXEC DDT LOADED_"
DVTB, CLEAR /READ MONITOR II INTO DATFLD
CORINI
DSKINI
DATEIN
TIMEIN
START
*INIP+200
/NUMBER INPUT
/CALL NUMBIN
/ NOT A NUMBER
/ # IN AC
NUMBIN= JMS I NUMBIA
NUMBI0, 0
DCA NUMAGN /NUMBER MAGNITUDE
CLL STA RTL /MAXIMUM OF TWO DIGITS IN NUMBER
DCA NUMCNT
JMS I NUMSKP /SKIP LEADING TABS AND SPACES
JMP I NUMBI0 /NOTHING THERE
NUMBI1, TAD CHAR
TAD NUMM9
SMA SZA
JMP NUMBI3 /NOT A NUMBER
TAD NUMP9
SPA
JMP NUMBI3 /NOT A NUMBER
DCA CHAR
ISZ NUMCNT
SKP
JMP I NUMBI0 /TOO MANY DIGITS
TAD NUMAGN / * 1
CLL RTL / * 4
TAD NUMAGN / * 5
RAL / * 10
TAD CHAR
DCA NUMAGN
COMGET
JMP NUMBI3 /NO MORE CHARACTERS
JMP NUMBI1
NUMBI3, CLA
TAD C0003 /HAVE ANY DIGITS BEEN FOUND?
TAD NUMCNT
SNA CLA
JMP I NUMBI0 /NO
ISZ NUMBI0
TAD NUMAGN
JMP I NUMBI0
NUMAGN= NUMHO+1
NUMCNT, 0
NUMSKP, SKIPS
NUMM9, -"9
NUMP9, 11
START, 0
DTCA
PCF
IFZERO D689-4 <
EDF /TURN ON DATA PHONES
DFCRF
CCF >
TSF /WAIT FOR CONSOLE FLAG FROM DIALOG
JMP .-1
TCF
RRB
KCC
CIF CDF
IFNZRO DC08A <
T1ON >
IFZERO DC08A <
IFZERO CPU-1 <
CLL CMA /LOAD CLOCK BUFFER
CCF CLB >
>
IFZERO DC08A <
IFNZRO CPU-4 <CECI>
IFZERO CPU-4 <IAC
CLLE
CLA>
>
IFZERO LPT-1 <LCP> /CLEAR INTERRUPT FOR LPT
ION
WAIT
REALLY, TEXT "BUILD? "
/ASK WHETHER TO READ OR WRITE
RW, 0
CLA CLL
RIF
TAD C6201
DCA INIF /INITIALIZE CHDF
CHDF
TAD I RW
DCA .+2
RW1, MESSAG
.-. /CRLF OR "TAPE "
MESSAG
RDORWT /READ OR WRITE?
GETIN
TAD I INBUF /FIRST CHARACTER
TAD RWMR /R?
CLL
SZA /YES
TAD RWMW /W? SET LINK
SZA CLA
JMP RW1 /NOT R OR W
RTL /0 FOR R, 2 FOR W
ISZ RW
JMP I RW
RWMR, -"R
RWMW, "R-"W
KEBOOT, IAC
CLL RTL
RFBOOT, TAD OSTAB
DCA AXS1
TAD I AXS1
DCA OSF
TAD I AXS1
DCA OST
TAD I AXS1
DCA OSC
TAD I AXS1
DCA OSA
/BOOTWTRAP FOR DEVICE OF YOUR CHOICE -- SET FOR DECTAPE HERE
OSB, CHDF
TAD I OSF
CDF
DCA I OST
ISZ OSF
ISZ OST
ISZ OSC
JMP OSB
DTRA DTXA /MAKE LAST TAPE FLAP (LOAD/DUMP)
CDF CIF
JMP I OSA
*INIP+400
FREND, -FIPBLK /END OF FREE CORE
LODDTA, LODDT /LOAD XDDT INTO FIELD 1
XDDFLG, -1
CORFLD, 0
CORLNK, 0
CORJMS, 0 /ISZ I CONDBA IF ^S/^Q FEATURE DISABLED
CORCSQ, KBDSQ /LOCATION OF JMS FOR ^S FEATURE
CORINI, 0
ISZ XDDFLG /DID HE WANT EXEC DDT?
JMS I LODDTA /YES
TAD CORJMS
CDF
SZA
DCA I CORCSQ /NO!
TAD CORFLD /HOW MANY USER FIELDS DID HE SAY
SNA /NO RESPONSE
IAC /ASSUME 1 USER FIELD
DCA CORCNT
TAD CORCNT
CMA /INIT CORE SEARCH ROUTINE
DCA AXS1
CLL CMA RTL
TAD CORSRA
DCA AXS2
IAC
TAD AXS1
DCA I AXS2
TAD CORTBA
CMA
TAD AXS1
DCA I AXS2
TAD CORTBA
DCA AXS2
CLL CML RTR /ASSIGN AND LOCK DATFLD
DCA I AXS2 /NOW UNLOCK ALL USER FIELDS
ISZ AXS1
JMP .-2
STL RTL
TAD CORCNT
CLL RTL
DCA CORCNT
TAD CORCNT
TAD DSUTBA
TAD C0010 /MUST START IN MULTIPLE OF 8
AND C7770
DCA I FREE
TAD I FREE
DATFLD
DCA CORLNK
TAD CORGEA
DCA CORF1
CORIN1, TAD CORLNK
TAD C0010
DCA AXS2
CORIN4, TAD AXS2
TAD FREND
SNA CLA
JMP CORIN2 /DONE
TAD AXS2
DCA I CORLNK
TAD AXS2
DCA CORLNK
ISZ AXS1
JMP CORIN1
HLT /OOPS!!!
CORIN2, TAD I CORF1 /ANY EXTRA FREE CORE TO BE GENERATED?
SNA
JMP CORIN3
DCA AXS2
ISZ CORF1
TAD I CORF1
CIA
DCA FREND
ISZ CORF1
JMP CORIN4
CORIN3, DCA I CORLNK /LAST LINK IS ZERO
TAD AXS1
IAC
CDF
DCA I FRECNT
CHDF
JMP I CORINI
CORF1, 0
CORGEA, RINGIN
FRETEL, 0
MESSAG
CY50
IFNZRO CPU-2 <IAC>
IFZERO CPU-2 <STL RTL>
JMP I FRETEL
LOGM1, TEXT "_NEW LOGIN MESSAGE? "
FREQUE, TEXT "60 HERTZ POWER? "
CY50, TEXT "50 HERTZ ASSUMED_"
*INIP+600
/SKIP LEADING SPACES AND TABS
/CALL JMS SKIPS
/ BUFFER EMPTY
/ NORMAL RETURN
SKISPA, -240
SKITAB, 240-211
SKIPS, 0
SKIPS1, COMGET
JMP I SKIPS /NONE LEFT
TAD SKISPA
TAD CHAR
SZA
TAD SKITAB
SNA CLA
JMP SKIPS1
ISZ SKIPS
JMP I SKIPS
MESSA0, 0
RDF
TAD C6201
DCA MESSA2
CHDF
TAD I MESSA0
DCA BUFPTR
ISZ MESSA0
MESSA1, TAD I BUFPTR /PICK UP NEXT WORD
SNA /DONE?
JMP MESSA2 /YES
RTR /GET LEFT HALF OF WORD
RTR
RTR
JMS PRINTI /PRINT IT
TAD I BUFPTR
AND K0077
SNA /DONE?
JMP MESSA2 /YES
JMS PRINTI /PRINT IT
ISZ BUFPTR /NEXT WORD
JMP MESSA1
MESSA2, .-. /CDF TO RESTORE DATA FIELD
JMP I MESSA0 /RETURN
PRINTI, 0
AND K0077
TAD K7741
SNA /BACKARROW?
JMP PRCRLF /YUP - TIME FOR CARRIAGE RETURN, LINE FEED
SPA
TAD C0100 /RESTORE BIT 5
TAD C0037
PRINT2, OUTTLS /PRINT THE CHARACTER
JMP I PRINTI /RETURN
PRCRLF, TAD CM215 /GET A CARRIAGE RETURN
CIA
OUTTLS
TAD C0212 /AND NOW LINE FEED
JMP PRINT2
BUFPTR, 0
K0077, 0077
K7741, 7741
GETIN0, 0
GETIN1, STA
TAD INBUF
DCA AXS1 /FOR GETCH
TAD INBUF
DCA NUMHO
TAD GETIN3 /MINUS THE LAST LOCATION IN THE BUFFER
DCA NUMHO+1
GETIN2, JMS GETCH /GET A CHARACTER INTO THE BUFFER
JMP GETIN1 /BUFFER FULL; TRY AGAIN
TAD CM212 /HAS HE TYPED A CR (OR LINE FEED)?
SNA CLA
JMP I GETIN0 /YES, WE'RE ALL THROUGH HERE
JMP GETIN2 /NO, GET ANOTHER CHARACTER
GETIN3, -INBUFA-20
CM212, -212
CM215, -215
C0212, 212
/SUBROUTINE TO GET A CHARACTER, AND PUT IT IN THE BUFFER.
/RETURN CALL PLUS 1 IF TOO MANY CHARACTERS WERE TYPED.
/RETURN CALL PLUS 2 WITH CHARACTER IN AC IS THE NORMAL RETURN.
/UPON RUBOUT, ECHOES RUBBED CHARACTERS, BUT NOT PAST BEGINNING OF BUFFER.
GETCH, 0
GETESC, 377-233
GETCH1, INKRB
GETCH2, DCA CHAR
TAD CHAR
TAD MC0377
SNA /IS IT A RUBOUT?
JMP GETCH3 /YES, GO WORRY ABOUT IT
TAD GETESC /IS IT ESCAPE?
SZA CLA /YES; DON'T ECHO
TAD CHAR
OUTTLS /ECHO CHARACTER
TAD AXS1
TAD NUMHO+1 /THIS SHOULD BE MINUS THE LAST ADDRESS IN THE BUFFER
SMA CLA /HAVE WE OVERRUN THE END OF THE BUFFER?
JMP GETCH5 /YES
TAD CHAR
DCA I AXS1 /ALL OK, NOW SAVE THE CHAR IN THE BUFFER
TAD CHAR
TAD CM215
SZA CLA /WAS THAT A CARRIAGE RETURN?
JMP GETCH4 /NO
TAD C0212 /GET LINE FEED AND ECHO, STORE IT
JMP GETCH2
GETCH3, TAD AXS1 /HE TYPED A RUBOUT
DCA CHAR /SAVE BUFFER POINTER
TAD AXS1
CIA
TAD NUMHO /THIS SHOULD BE THE INITIAL VALUE OF AXS1
SMA SZA CLA /IS HE BACKING UP TOO FAR?
JMP GETCH1 /YES, JUST IGNORE THE RUBOUT
TAD I CHAR /GOT GET THE RUBBED-OUT CHARACTER
OUTTLS /AND ECHO IT
STA
TAD AXS1 /NOW BACK UP AXS1
DCA AXS1
JMP GETCH1
GETCH4, TAD CHAR /PUT CHAR IN AC FOR RETURN
ISZ GETCH //SKIP ON RETURN
JMP I GETCH /AND RETURN
GETCH5, MESSAG /THE DUMMY IS TOO PROLIFIC WITH THE TYPING!!
HUH
JMP I GETCH
*INIP+1000
/INIT BOOTSTRAP - LOAD TRACK 2 INTO FIELD 0
INBOOT, DCA DATEIN /SAVE AC
DISC
DMAR /READ TRACK 2 TO FIELD 0
0020
TAD DATEIN /RESTORE AC
DFSC
JMP .-1
CIF CDF /AWAY TO FIELD 0, IF WE AREN'T THERE ALREADY
DCA CHDFA /AC SAYS WHERE TO JUMP
TAD C6201
DCA I INIFA
JMP I CHDFA /SO JUMP THERE
SUPREF, TAD SUPFUG /REFRESH
SUPST, TAD SYSINA /START
JMP INBOOT /BOOT IN FRESH COPY OF INIT
INIFA, INIF
SYSINA, SYSINI
SUPFUG, REFCO0-SYSINI
/DATE INPUT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1
DATMUL, DMUL
CMCR, -215
C0012, 14
C0031, 37
DECIMAL
DM13, -13
D11, 11
D31, 31
DM74, -74
OCTAL
DATMON, 0
DATDAY, 0
DATEIN, 0
CLA CLL
MESSAG /MONTH-DAY-YEAR:
DATMES
GETIN
STA
TAD INBUF
DCA AXS1
NUMBIN /MONTH
JMP DATEIN+1
TAD DM13
STL IAC
TAD D11
SZL /0<MONTH<13?
JMP DATEIN+1 /NO
DCA DATMON
NUMBIN /DAY
JMP DATEIN+1
TAD DM32
STL
TAD D31
SZL /0<DAY<32?
JMP DATEIN+1 /NO
DCA DATDAY
NUMBIN
JMP DATEIN+1
TAD DM74
SPA /WAY OUT OF LINE?
JMP DATEIN+1 /YES
DCA NUMHO+1
TAD C0012
JMS I DATMUL
TAD DATMON
TAD NUMHO+2
DCA NUMHO+1
DCA NUMHO
TAD C0031
JMS I DATMUL
TAD NUMHO+1
SZA /IS DATE OVERFLOWED?
JMP DATEIN+1 /YES
TAD DATDAY
TAD NUMHO+2
CDF
DCA I DATE
CHDF
JMP I DATEIN
DATMES, TEXT "MONTH-DAY-YEAR: "
DSKINI, 0 /CLEAR USER DISK REQUEST QUEUE
DATFLD
TAD CORCNT
TAD DSUTBA
DCA CORCNT
STA
DCA I CORCNT /MARK END OF TABLE
DCMA
CHDF
JMP I DSKINI
COMGET= JMS I COMGEA
COMGE0, 0
TAD I AXS1
DCA CHAR
TAD CHAR
TAD CMCR
SNA CLA /IS IT A CARRIAGE RETURN?
JMP .+3 /YES - RESET AXS1 SO NEXT CALL FINDS CR
ISZ COMGE0 /NO
JMP I COMGE0
STA
TAD AXS1
DCA AXS1 /BACK UP POINTER
JMP I COMGE0
YESNO0, 0
TAD I YESNO0
ISZ YESNO0
DCA .+2
YESNO1, MESSAG
0
GETIN
TAD I INBUF
TAD YESNON
SNA
JMP YESNO2
TAD YESNOY
SZA CLA
JMP YESNO3 /HE DIDN'T ANSWER Y OR N
ISZ YESNO0
YESNO2, JMP I YESNO0 /RETURN, SKIPPING IF YES
YESNO3, MESSAG
YN
JMP YESNO1 /ASK HIM/HER AGAIN
YESNON, -"N
YESNOY, "N-"Y
*INIP+1200
/ROUTINE TO DUMP SELECTED FIELD
CD0, JMS ASKFLD
DCA .+2
JMS ASKSTA /INITIALIZE STARTING ADDRESS
.-.
JMS SP
CD1, TAD NUMHO /PRINT ADDRESS OF DATA TO BE PRINTED
JMS I HACKA
TAD C7770
DCA NUMHO+1 /8 DATA WORDS PER LINE
CD2, JMS I SPACEA /PUT IN SOME SPACE
TAD I NUMHO /GET DATA WORD
JMS I HACKA /PRINT IT
ISZ NUMHO /ARE WE THROUGH?
JMP CD3 /NO
MESSAG
CRLF
JMP I SUPERA
CD3, ISZ NUMHO+1
JMP CD2
MESSAG
CRLF
CHEKCC
JMP CD1
/ROUTINE TO COMPARE A SELECTED FIELD TO FIELD 1 AND PRINT
/OUT ANY DIFFERENCES THERE MIGHT BE. SR0=1 CAUSES A 0 IN THE FIRST
/SELECTED FIELD TO BE IGNORED; ASSUMED TO BE JMS ENTRY POINTS, ETC.
MF0, JMS ASKFLD /GET FIRST FIELD
DCA MF1
TAD MF1
DCA MF3
JMS ASKFLD /GET SECOND FIELD
DCA MF5
TAD MF5
DCA MF6
JMS ASKSTA /INITIALIZE STARTING ADDRESS
JMS SP
MF1, .-.
TAD I NUMHO
MF5, .-.
CIA
TAD I NUMHO
SZA CLA
JMP MF3
MF2, CHEKCC
ISZ NUMHO
JMP MF1
JMP I SUPERA
MF3, .-.
TAD I NUMHO
SZA CLA
JMP MF4
LAS
SPA CLA
JMP MF2
MF4, TAD NUMHO
JMS I HACKA
JMS I SPACEA
TAD I NUMHO
JMS I HACKA
JMS I SPACEA
MF6, .-.
TAD I NUMHO
JMS I HACKA
MESSAG
CRLF
JMP MF2
/ROUTINE TO INITIALIZE OUTPUT TO EITHER LPT OR TO TTY. SENDS OUT A
/CHARACTER TO BOTH, TO SEE WHICH GETS BACK FIRST WITH A FLAG.
SP, 0
STA
LPC /INVALID CHARACTER TO MAKE SURE IT COMES BACK FAST
TAD K0213
TLS /VALID CHARACTER IN CASE OF PARALLEL LA30 OR SUCH
CLA
SP1, LSF
JMP SP2
TAD OUT2
DCA OUTA
JMP SP3
SP2, TSF
JMP SP1
SP3, MESSAG
CRLF
JMP I SP
OUT2, OUTLP
K0213, 0213
ASKFLD, 0
MESSAG
FIELD1
GETIN
OCTIN
TAD C7770
STL
TAD C0010
SZL
JMP I SUPHA
RTL
RAL
TAD C6201
JMP I ASKFLD
SUPHA, SUPHUH
ASKSTA, 0
MESSAG
START1
GETIN
OCTIN
DCA NUMHO
JMP I ASKSTA
START1, TEXT "START AT - "
OUTLP, 0
LPC
LSF
JMP .-1
CLA
JMP I OUTLP
HACKA, HACK
SPACEA, SPACE
LDXRS, TEXT "_LOAD, DUMP, START, ETC? "
/TIME INPUT
FREQ, IFNZRO DC08A <
-67 > /55 TICKS PER SYSTEM TICK IF DC08A; INITIALIZED AT REFRESH TIME
IFZERO DC08A <-12> /IN CASE OF PDP-8/A
CLKINA, CLKINI
TIMCK2, -INCLK2-1
TIMCK1, -INCLK1
C660, TICMIN /TICKS PER MINUTE
DECIMAL
DM24, -24
D24, 24
DM60, -60
D60, 60
OCTAL
TIMEIN, 0
CLA CLL
MESSAG
TIMESS /TIME:
GETIN
STA
TAD INBUF
DCA AXS1
DCA CHAR
NUMBIN
JMP TIMEIN+1
TAD DM24
STL
TAD D24
SZL /HOURS BETWEEN 0 AND 23?
JMP TIMEIN+1 /NO
DCA NUMHO+1
DCA NUMHO
TAD D60
JMS DMUL
DCA CHAR
NUMBIN
JMP TIMEIN+1
TAD DM60
STL
TAD D60
SZL /MINUTES BETWEEN 0 AND 59?
JMP TIMEIN+1 /NO
TAD NUMHO+2
DCA NUMHO+1
DCA NUMHO
TAD C660
JMS DMUL
CLL
CDF
TAD NUMHO+2
TAD TIMCK1
DCA I CLK1
RAL
TAD NUMHO+1
TAD TIMCK2
DCA I CLK2
TAD FREQ
DCA I CLKINA
CHDF
JMP I TIMEIN
DMUL, 0
DCA MP2 /MULTIPLIER
TAD NUMHO+1 /LOW ORDER MULTIPLICAND
JMS MP4
DCA NUMHO+2 /LOW ORDER
TAD MP5
DCA NUMHO+1 /HIGH ORDER
TAD NUMHO /HIGH ORDER MULTIPLICAND
SNA
JMP I DMUL
JMS MP4
TAD NUMHO+1
DCA NUMHO+1
RAL /GET CARRY
TAD MP5
DCA NUMHO
JMP I DMUL
MP4, 0
DCA MP1
DCA MP5
TAD M12
DCA MP3
CLL
TAD MP1
RAR
DCA MP1
TAD MP5
SNL
JMP .+3
CLL
TAD MP2
RAR
DCA MP5
ISZ MP3
JMP MP4+6
TAD MP1
RAR
CLL
JMP I MP4
MP1, 0
MP2, 0
MP3, 0
MP5= CHDFA
M12, -14
CORMES, TEXT "# USER FIELDS - "
INBUFA= .
ZBLOCK 20 /INPUT BUFFER FOR INIT INPUT
*INIP+1600
/DECTAPE - READ OR WRITE ONE FIELD
/JMS TO DTRORW WITH DESIRED FIELD IN DTFLD, BEGINNING BLOCK MINUS
/ONE IN DTBLOK, DESIRED DRIVE IN CONTROLLER, AND DTFUNC
/0050 FOR A WRITE OR 0030 FOR A READ.
DTRORW, 0
STA
DCA DTCAS /START CA AT -1
TAD C7740
DCA DTBLCT /40 BLOCKS PER FIELD
DTRA
AND C0200 /IS TAPE MOVING??
SNA CLA
TAD C0600 /NO - START IT THE OTHER WAY
DTXA
DTSR1, TAD C7773
DCA DTRY /TRY 5 TIMES UPON ERROR
DTSR2, DTLB /BLOCK NUMBERS TO THIS FIELD
DCA I C7755 /AT LOCATION 0
TAD C0010 /START SEARCHING
DTSR3, DTXA
JMS DTWAIT /WAIT
DTRA
RTL
RTL /DIRECTION BIT TO LINK
CLA
TAD DTBLOK /DESIRED BLOCK - 1
CMA /-DESIRED BLOCK
SZL /FUDGE IF GOING IN REVERSE
TAD C0003
TAD 0 /REAL BLOCK - DESIRED BLOCK (+3?)
SNA CLA /WHAT DO WE DO NOW?
SNL
JMP DTSR7 /KEEP GOING, MAYBE REVERSE DIRECTION
TAD C7600 /WE'RE THERE, MAKE WC=-200
DCA I C7754
TAD DTCAS
DCA I C7755 /SET UP CA
TAD DTFLD
DTLB /SET UP FIELD FOR TRANSFER
TAD DTFUNC
DTXA /SET UP FOR READ OR WRITE
JMS DTWAIT /WAIT
TAD I C7755 /SAVE NEW CURRENT ADDRESS
DCA DTCAS
DTRA /REMOVE ANY FUNCTION FROM CONTROLLER
AND C0077
DTXA
ISZ DTBLOK /TIME FOR NEXT BLOCK
ISZ DTBLCT /ARE WE THROUGH?
JMP DTSR1 /NO
TAD DTBLOK /YES -
TAD CM2677 /END OF TAPE??
SPA CLA
JMP I DTRORW /NO
TAD C0400 /YES
DTXA /REWIND TAPE
DTRA
TAD C1000 /GO TO NEXT DRIVE
AND C7000
DCA DTBLOK
CHEKCC /STALL
DTRA DTXA
CHEKCC /STALL
TAD DTBLOK
DTXA /REMEMBER IT IN THE CONTROLLER
DCA DTBLOK /START AT BLOCK 1
CHEKCC /STALL
JMP I DTRORW /RETURN
DTSR7, SNL /REVERSE DIRECTION?
JMP DTSR3 /NO
TAD C0400
ISZ DTRY /COUNT AN ERROR
JMP DTSR3 /AND GO REVERSE DIRECTION
TAD C7600 /AC=200
DTXA /STOP THE TAPE
MESSAG
TAPMIS
JMP I SUPERA
TAPMIS, TEXT "_DECTAPE ERROR"
DTRY, 0
DTBLCT, 0 /COUNT OF BLOCKS TO R/W FOR ONE FIELD
DTBLOK, 0 /CURRENT DESIRED BLOCK MINUS ONE
DTFLD, 0 /DECTAPE FIELD IN BITS 6-8
DTFUNC, 0 /DECTAPE FUNCTION, 30 FOR READ, 50 FOR WRITE
DTLA= 6766 /SHOULDN'T BE HERE, BUT PUT IT IN WHILE I REMEMBER
DTCAS, 0
C7773, 7773
C7754, 7754
C7755, 7755
CM2677, -2677
C0077, 0077
C7000, 7000
STATB, 0 /FOR DIAGNOSTIC PURPOSES
/MOST RECENT DECTAPE STATUS B ON ERROR
/DTWAIT - SUBROUTINE TO WAIT FOR DECTAPE COMPLETION FLAG
DTWAIT, 0
DTSF
JMP .-1 /WAIT FOR FLAG
CHEKCC
DTRB
SMA CLA /ANY ERROR?
JMP I DTWAIT /NO
DTRB
DCA STATB /FOR DIAGNOSTIC PURPOSES
TAD STATB
AND C0400 /SELECT ERROR?
SZA CLA
JMP DTWSEL /YES
DTWGOR, DTRA
AND C0377 /REMOVE FUNCTION FROM CONTROLLER
DTXA
TAD C0600 /GO IN REVERSE
DTXA
JMP DTSR2
DTWSEL, DCA 0
DTXA /SELECT ERROR!
C0600, 0600 /WASTE TIME - SELECT ERROR RETURNS AFTER
C0377, 0377 /WASTE TIME - 5 MICROSECONDS AFTER DTXA
CHEKCC
DTRB /IS IT STILL THERE?
SPA CLA
JMP DTWSEL /YES, TRY AGAIN
ISZ 0 /NO, WAIT A WHILE
JMP DTWSEL+1
JMP DTWGOR /OK, IT SEEMS TO BE GONE
*INIP+2000
/4K DISK READ OR WRITE
LOAD, JMS I RWB /GO TO INITIALIZE CHDF, PRINT MESSAGE,
CRLF /AND DETERMINE READ OR WRITE
TAD C6603 /MAKE A DMAW OR A DMAR
DCA RORW
MESSAG
FIELD1
GETIN
TAD I INBUF
AND C0007
DCA FLDNUM
MESSAG
TRACK
GETIN
OCTIN
CLL RTL
RAL
TAD FLDNUM
DCA FLDNUM
DISC
RORW, 0
FLDNUM, 0
DISCHK /CHECK FOR DISK OK
JMP LOAD
C6603, 6603
RWB, RW
ASCI7,
CLEAR, 0
CLA
DISC /READ MONITOR II INTO FIELD 1
6603
TS8DEX+11
DISCHK /CHECK FOR OK DISK COMPLETION
TAD CLR1
JMS ZERO /ZERO OUT FREE CORE
JMP I CLEAR
CLR1, JOBTBL
ASCI6,
ZERO, 0 /CLEAR FIELD 1 FROM C(AC) TO 7777
DCA CLR2 /BEGINNING ADDRESS
DATFLD
DCA I CLR2
ISZ CLR2
JMP .-2
CHDF
JMP I ZERO
ASCNT,
CLR2, 0
/ROUTINE TO MOVE XDDT INTO DATFLD
LODDT, 0
TAD KM4400
DCA I FRENDA /MAKE FRECORE STOP AT 4400
STA
TAD K4400
DCA AXS1 /POINTS TO ORIGINAL
TAD AXS1
DCA AXS2 /POINTS TO COPY
LODDT1, CHDF
TAD I AXS1
DATFLD
DCA I AXS2
ISZ DDTSIZ /ARE WE DONE YET?
JMP LODDT1
DCA I XOPA /CHANGE ^C TO JUMP TO FIELD 0
CHDF
MESSAG
XTELL
JMP I LODDT /YES
XOPA, XOP
K4400, 4400
KM4400, -4400
FRENDA, FREND
DDTSIZ, 4400-7577 /THIS GETS DESTROYED, BUT WHAT THE HECK
DDTMES, TEXT "LOAD EXEC DDT AT START-UP? "
/ROUTINE TO CONVERT ASCII TO TSS/8 SIXBIT
ASCSIX, 0
CLL STA RAL /SET AC=-2
DCA ASCNT
TAD INBUF
DCA ASCI6 /INPUT BUFFER
TAD I ASCSIX
DCA ASCI7 /POINTER TO OUTPUT VECTOR
ISZ ASCSIX
ASCI1, JMS ASCGET /GET ONE CHARACTER
CLL RTL
RTL
RTL /SHIFT TO HIGH ORDER
DCA I ASCI7 /SAVE THE CHARACTER
CHDF
JMS ASCGET /GO GET ANOTHER CHARACTER
TAD I ASCI7 /PACK IT IN WITH THE LAST ONE
DCA I ASCI7 /AND SAVE IT
ISZ ASCI7
CHDF
ISZ ASCNT /DONE?
JMP ASCI1 /NO
JMP I ASCSIX /YES, EXIT
ASC240, -240
ASCGET, 0 /GET A PASSWORD CHARACTER, EXIT UPON CARRIAGE RETURN
TAD I ASCI6 /GET NEXT CHARACTER
TAD ASCCR
SNA CLA /IS IT CR?
JMP I ASCSIX /YES, RETURN
TAD I ASCI6
ISZ ASCI6
TAD ASC240 /PASSWORDS ARE STORED IN EXCESS 240 CODE
DATFLD
JMP I ASCGET
ASCCR, -215
CSQ, TEXT "ENABLE ^S FEATURE? "
*INIP+2200
/USES INIT'S BINARY LOADER TO LOAD INTO FIELD 1
ZERO1 /ZERO FIELD 1
DATFLD
Y1, JMS I BINLD /GO LOAD BINARY TAPE
SKP /FIELD SETTING ENCOUNTERED
JMP I SUPERA /END OF TAPE
DCA DISC0 /SAVE IT
RDF
CIA
TAD DISC0 /IS IT THE CURRENT FIELD ANYWAY?
SNA CLA
JMP I BINT3B /YES - SO IT'S OK
TAD DISC0 /NO - LET HIM/HER KNOW ABOUT IT
HLT
CLA /IGNORE FIELD SETTING
JMP I BINT3B
BINLD, BINTAP
BINT3B, BINT3
Y, JMS I STFLDA
JMP Y1
STFLDA, STFLD
RDORWT, TEXT "READ OR WRITE - "
FIELD1, TEXT "FIELD NUMBER - "
TRACK, TEXT "TRACK NUMBER - "
TAPMES, TEXT "_TAPE "
TIMESS, TEXT "HR:MIN - "
NUMBLK, TEXT "# - "
YN, TEXT "YES OR NO... "
/DISK READ OR WRITE
/CALL DISC
/ FUNCTION
/ DEAL ARGUMENTS (DISC EXTENSION IN BITS 1-8; MEMORY FIELD IN BITS 9-11)
/ DISCHK
/ RETURN HERE WHEN OK
DISC= JMS I DISCA
DISCHK= JMS I DISCHA
DISC0, 0
RDF
TAD C6201
DCA DISC2
CHDF
TAD I DISC0
DCA DISROW
ISZ DISC0
TAD I DISC0
DCA DEALSV /SAVE THE DEAL ARGUMENTS
TAD DEALSV
IFZERO RF08-40 < ISZ DISC0
CLL RTL
RAL
DEAL
CLA CLL>
IFZERO RF08 < RTL
RAL
AND C0070
DIML
TAD I DISC0
CLL RTR
ISZ DISC0
RAR
DXAL>
CDF
DCA I C7750
STA
DCA I C7751
DISROW, 0
JMP I DISC0
C0070, 70
C7750, 7750
C7751, 7751
/SUBROUTINE TO WAIT FOR DISK COMPLETION, CHECK FOR ERRORS, AND
/IF THERE ARE ANY ERRORS, RETRY THE OPERATION.
DISCH0, 0
CLL STA RTL
DCA RFTRY /TRY 3 TIMES
IFZERO RF08 <DFSE DFSC>
IFNZRO RF08 <DFSC>
JMP .-1 /WAIT FOR THE DISK TO FINISH
DFSE /ERROR?
IFZERO RF08-40 <SKP> /DF32 SKIPS BACKWARDS
JMP DISC2 /NO
DIMA
AND DSKFLG /CHECK WLS, DRL, PER
CDF
SNA
TAD I C7750 /MAYBE NXD - IS WC=0?
DISC2, .-. /CDF -- RESTORE DATA FIELD
SNA /OK?
JMP I DISCH0 /I GUESS SO
ISZ RFTRY /3 TRIES YET?
CLA SKP
JMP DISERR /DISK WRITE LOCKED, PARITY ERROR, OR DRL
TAD DISROW /GET OLD DMAR OR DMAW
DCA .+2
DISC
0
DEALSV, 0 /DEAL ARGUMENTS SAVED BY LAST DISC CALL
JMP DISCH0+3
DSKFLG, IFZERO RF08 <1005>
IFZERO RF08-40 <0007>
RFTRY, 0 /RETRY COUNT FOR DISK ERRORS
DISERR, MESSAG
DISKER
JMP I SUPERA
DISKER, TEXT "_DISK ERROR"
*INIP+2400
/DISC DUMP ON DTA1
/DECTAPE BLOCK 40N+1=DISC TRACK N
DSKDMP, JMS I RWA /GO TO INITIALIZE CHDF, PRINT MESSAGE,
TAPMES /AND DETERMINE READ OR WRITE
DCA DTA
MESSAG
NUMBLK
GETIN
OCTIN
CIA
SNA
DSKSUP, TAD DSKSZ
DCA LDFCNT /SAVE DISK TRACK COUNT
DCA RFFUNC /WELL, FOLKS, THE FOLLOWING ROUTINE
CHDF /ONLY WORKS IN FIELD 0, SO HERE
TAD I RFFUNC /WE GO, MOVING EVERYTHING DOWN TO
CDF /FIELD 0 SO THAT IT WILL BE HAPPY
DCA I RFFUNC
ISZ RFFUNC
JMP .-5
CIF CDF /AND DOWN TO FIELD 0!
JMP .+1
TAD .-2
DCA INIF /SET UP CHDF FOR FIELD 0
TAD DTA /IS IT LOAD OR DUMP??
CLL
SNA CLA
STL
SNL /SKIP IF READ
TAD C0020
TAD C0030
DCA I DTFUNA /SAVE FUNCTION FOR DECTAPE
TAD RFDMAR
SZL /SKIP IF DISK READ
TAD C0002 /MAKE IT DMAW
DCA RFFUNC /SAVE DMAR OR DMAW
TAD LDFCNT
RAL
DCA LDFCNT /FUDGE LDFCNT SO THAT IT ISZES TO 0 AT THE RIGHT TIME
DCA I DTBLKA /START AT DECTAPE BLOCK 1
TAD C1000
DTLA /START WITH DECTAPE DRIVE 1
IAC
DCA RFTRAK /START WITH RF08/DF32 TRACK 0 FIELD 1
TAD C0010
DCA I DTFLDA /START WITH DECTAPE FIELD 1
TAD DTA
SZA CLA /LOAD OR DUMP?
JMP DMPINI /MUST BE DUMP
JMS I DTRWA /READ FIRST TRACK FROM DECTAPE
DISC /READ OR WRITE - START OPERATION ONLY
RFFUNC, 0 /DMAR OR DMAW
RFTRAK, 0 /BITS 1-8=TRACK, 9-11=FIELD
ISZ LDFCNT /DONE LOADING?
JMP LD2 /NO
DISCHK /YES - LAST WRITE OK??
JMP LDSTOP
LD2, TAD RFTRAK /WHAT FIELD DOES DECTAPE GO TO NOW?
RTR
SPA CLA
TAD C0010
TAD C0010
DCA I DTFLDA
JMS I DTRWA /READ/WRITE DECTAPE
ISZ LDFCNT /DONE DUMPING???
JMP DMPJMP /NO
DCMA /MAKE SURE THE DISK IS STOPPED
LDSTOP, TAD C0400 /YES - REWIND LAST DECTAPE
DTXA
JMP I .+1
RFBOOT /NOW GO BOOT WHATEVER IS ON RF08/DF32
DMPJMP, DISCHK /DISK OK??
TAD RFTRAK
RAR
SZL CLA
TAD C0002
TAD C0007
TAD RFTRAK
DCA RFTRAK
JMP RFFUNC-1
DMPINI, DISC
RFDMAR, DMAR
1
JMP DMPJMP
SUPDMP, STA
SUPLOD, DCA DTA /SET DTA NON-0 FOR LOAD, 0 FOR DUMP
JMP DSKSUP /AND GO LOAD OR DUMP
DTA, 0
DSKSZ, -DSKSIZ
LDFCNT, 0
DTFUNA, DTFUNC
DTBLKA, DTBLOK
DTFLDA, DTFLD
DTRWA, DTRORW
C0020, 0020
C0030, 0030
RWA, RW
TAPERR, TEXT "_TAPE READ ERROR"
HUH, TEXT "_WHAT?_PLEASE TRY AGAIN_"
HUH2= HUH+3
/FILE PHANTOM AND DISK REFRESHER
/WRITE NEW MFD ON DISC DIRECTLY ABOVE THE SWAPPING AREA
PAGE
FIPR4, 0
FIPASC, ASCSIX
MFD1, MFDT-1
FIPREF, ZERO1 /ZERO FIELD 1
MESSAG /"SYSTEM"
SYSTEM
MESSAG /"PASSWORD"
PASWRD
GETIN
JMS I FIPASC /CONVERT PASSWORD TO SIXBIT
0011 /GOOES AT WORD 11, 12 OF MFD
MESSAG /"LIBRARY"
LIBARY
MESSAG /"PASSWORD"
PASWRD
GETIN
JMS I FIPASC /CONVERT PASSWORD TO SIXBIT
0041 /AND PUT IT AT WORDS 41,42 OF MFD
MESSAG /"OPERATOR"
OPRAT
MESSAG /"PASSWORD"
PASWRD
GETIN
JMS I FIPASC /CONVERT PASSWORD TO SIXBIT
0061 /AND PUT IT AT WORDS 61,62 OF MFD
TAD MFD1 /INITIALIZE POINTER
DCA AXS1
FIPR2, TAD I AXS1 /GET ADDRESS OF DATA TO BE STORED IN MFD
SNA /ARE WE THROUGH?
JMP FIPR3 /YES
DCA FIPR4 /SAVE IT
TAD I AXS1 /GET DATA TO STORE
DATFLD
DCA I FIPR4 /STORE IT IN THE MFD
CHDF
JMP FIPR2 /GO FOR MORE
FIPR3, TAD SWBASE
TAD JBMXP /"JOBMAX"
CLL RTL
STL RAL /MAKE IT FIELD 1
DCA .+3
DISC
DMAW /WRITE OUT THE MFD
.-.
DISCHK
/INITIALIZE STORAGE ALLOCATION TABLE "SAT"
/THE SAT TABLE RESIDES IN FIP AT 7777 AND EXTENDS
/DOWN THROUGH 7777-(SATSIZ-1). EACH BIT POSITION REPRESENTS 1 SEGMENT
/OF FILE STORAGE.
/SEGMENT 0 IS BIT 0 OF 7252,
/SEGMENT 1 IS BIT 1 OF 7252, ETC. 7252=7777-(SATSIZ+2).
/LOCATION SATCNT=7777-(SATSIZ-1)+1 CONTAINS THE COUNT OF AVAILABLE
/SEGMENTS. A SEGMENT IS AVAILABLE IF ITS SAT BIT HAS THE
/VALUE 0.
JMS I FIPRFD /FIP TO FIELD 1
TAD CJTABL
ZERO1 /CLEAR ALL FIP TABLES AND RETRIEVAL INFORMATION
TAD SWDEXP
TAD CJOBMX
TAD DSKSZP /"DSKSIZ"
CLL RTL
RTL
TAD C7777 /CAN'T USE LAST SEGMENT ON DF32
DCA STORE0 /NUMBER OF DISK SEGMENTS
CLA CMA
DATFLD
DCA I SATBOT /"-255"
CLL STA RTL /SUBTRACT THREE SEGMENTS (FOR 1,2,3 UFD'S)
TAD STORE0 /SET SATCNT TO # DISC SEGMENTS-2
DCA I SATCNT /"-254"
TAD K7000 /MARK SEGMENTS 1,2,3 FOR MFD, UFD USAGE
DCA I SATTBL
TAD STORE0 /MORE THAN 4000 SEGMENTS.
SMA
JMP .+6 /NO OK
TAD CM4004 /SUBTRACT 4004
DCA STORE0
TAD C0253 /253 WORDS=4004 SEGS
DCA COUNT
TAD STORE0
TAD C7764 /-14
ISZ COUNT /COUNT # ZERO WORDS IN SAT
SMA
JMP .-3
DCA STORE0
STA
TAD COUNT
TAD SATTBL
DCA COUNT
STL RAL
ISZ STORE0
JMP .-2
DCA I COUNT /MARK END OF FILE STORAGE AS ALLOCATED
JMP FIPRF5
FIPRF4, CLA CMA
DCA I COUNT
FIPRF5, ISZ COUNT
JMP FIPRF4
DISC
DMAW
0011 /FIP IS TRACK 1, FIELD 1
DISCHK /MAKE SURE THE DISK IS OK
JMP I SUPERA
SATTBL, -SATSIZ+2
K7000, 7000
COUNT, 0
SWDEXP, -SWDEX
JBMXP, JOBMAX
C7764, -14
DSKSZP, DSKSIZ
STORE0, 0
FIPRFD, FIPRD
CJTABL, JTABLE
SATBOT, -SATSIZ
SATCNT, -SATSIZ+1
C0253, 253
CM4004, -4004
FIPREM, TEXT "_WRITE ZERO SYSTEM DIRECTORY? "
*INIP+3000
JMP I .+1
INBOOT
/MFD SEGMENT #S TO INBUF
FRD0, 0
TAD SWBASE
TAD JBMAX
CLL RTL
STL RAL
DCA FRD1
DISC
DMAR
FRD1, 0
DISCHK /MAKE SURE THE DISK IS OK
TAD K0020
DCA AXS1
TAD INBUF
DCA AXS2
TAD K7771
DCA Z1
FRD2, DATFLD
TAD I AXS1
CHDF
DCA I AXS2
ISZ Z1
JMP FRD2
DATFLD
TAD I FGRACE /FETCH SIZE OF "GRACE SPACE"
CHDF
DCA I AXS2
JMP I FRD0
JBMAX, JOBMAX
FGRACE, 0014
K0020, 0020
Z1,
FIPRD, 0
DISC
DMAR
0011 /FIP IS TRACK 1, READ INTO FIELD 1
DISCHK /MAKE SURE THE DISK IS OK
JMP I FIPRD
Z0, JMS I STFLDB /SET DATA FIELD TYPED
DCA Z1
DCA I Z1 /ZERO OUT A FIELD
ISZ Z1
JMP .-2
JMP I SUPERA
STFLDB, STFLD
/TABLE USED TO CONSTRUCT VIRGIN MFD
/INCLUDES ENTRIES FOR ACCOUNTS 1, 2, 3
/EACH PAIR OF NUMBERS INCLUDES FIRST THE MFD ADDRESS, THEN ITS CONTENTS
MFDT, 3;10 /DUMMY POINTER
10;1 /ACCOUNT NUMBER 1
13;40 /NEXT ACCOUNT STARTS AT 40; LINK TO IT
14;12 /DEFAULT "GRACE SPACE" OF 10 SEGMENTS PAST QUOTA
17;20 /SEGMENT LIST IS AT 20
21;1 /MFD STARTS WITH SEGMENT 1 ONLY
30 /AN EXTRA BLOCK IS USED HERE. THE REASON IS SO THAT THE
7777 /LAST ACCOUNT IN A SEGMENT WON'T HAVE ITS RETRIEVAL
/BLOCK IN THE NEXT SEGMENT.
40;2 /ACCOUNT 2
43;60 /LINK TO NEXT ACCOUNT AT 60
44;7777 /NO LIMIT ON DISK SEGMENTS
47;50 /SEGMENT LIST IS AT 50
51;2 /ACCOUNT 2 UFD STARTS WITH ONLY SEGMENT 2
60;3 /ACCOUNT 3
64;7777 /NO LIMIT ON DISK SEGMENTS
67;70 /SEGMENT LIST IS AT 70
71;3 /ACC. 3 UFD OWNS SEGMENT 3 ONLY, INITIALLY
0 /TABLE TERMINATOR
CRTABL, RTABLE-1 /MFD SEGMENT #S
CUTABL, UTABLE
SATCON, SATSIZ+1
CJOBTB, JTABLE-1 /START OF AREA TO CLEAR IN FIP
PERSET, 0
JMS FRD0 /MFD SEGMENT #S TO INBUF
JMS FIPRD /FIP TO FIELD 1
TAD CJOBTB /CLEAR FIP TABLES
DCA AXS1
DATFLD
DCA I AXS1
TAD AXS1 /HAVE WE REACHED BOTTOM OF SAT?
TAD SATCON
SZA CLA
JMP .-4 /NO
TAD CRTABL /MOVE MFD SEGMENT #S TO RTABLE
DCA AXS1
TAD INBUF
DCA AXS2
TAD K7771
DCA Z1
PERSE3, CHDF
TAD I AXS2
DATFLD
DCA I AXS1
ISZ Z1
JMP PERSE3
CLL CLA CML RAL
DCA I CUTABL /UTABLE=1
CMA
ISZ CUTABL
DCA I CUTABL /UTABLE+1=-1
ISZ CUTABL
CHDF
TAD I AXS2
DATFLD
CIA
DCA I CUTABL /UTABLE+2=-"GRACE SPACE"
CHDF
DISC
DMAW
0011 /WRITE FIP FROM FIELD 1, TO TRACK 1
DISCHK /MAKE SURE THE DISK IS OK
JMP I PERSET
K7771, 7771
/THERE'S ALWAYS SOMEONE WHO WILL TRY TO LOAD INIT INTO THE SAME FIELD AS
/THE BINARY LOADER. GIVE HIM/HER A MESSAGE IF HE DOES!!
*4200
CLA
RIF
TAD C6201
DCA INIF
MESSAG
OOPS
HLT
JMP .-4
OOPS, TEXT "_PLEASE DON'T TRY TO LOAD INIT WITH THE BINARY LOADER "
*.-1
TEXT "LOCATED IN FIELD 2!"
*7632
JMP I SUPERA /THIS INSTRUCTION SHOULD INTERCEPT ANY BINARY
/LOADER IN PROGRESS IN THIS FIELD.
/INIT SUPERVISOR
/OVERLAYS XDDT PERMANENT SYMBOL TABLE
*4200
SUPER, CLA /SET DATA FIELD
RIF
TAD C6201
DCA INIF
CHDF
DTRA
AND C0200
DTXA /STOP ANY DECTAPE WHICH MAY BE MOVING AFTER AN ERROR
TAD OUT1
DCA OUTA /RESTORE TTY OUTPUT
IFZERO CPU-2 <6030> /DO HIM/HER A FAVOR IF IT'S AN 8/E
IFNZRO CPU-2 <6032> /NOT QUITE AS HELPFUL, BUT NECESSARY
MESSAG
LDXRS /LOAD, DUMP, START AND OTHER THINGS IN THE LIST OF COMMANDS??
GETIN /WAIT FOR REPLY
TAD SUPTBA /ADDRESS OF TABLE OF LETTERS
DCA AXS1 /SAVE IT AUTO-INDEX
SUPER2, TAD I AXS1 /GET A LETTER FROM TABLE
SNA /END OF TABLE?
JMP SUPHUH /YES - LET HIM/HER TRY AGAIN
TAD I INBUF /ADD ON FIRST CHARACTER TYPED
SNA CLA /THIS ONE?
JMP SUPER3 /YES - DISPATCH
ISZ AXS1 /NO - PASS UP DISPATCH ADDRESS
JMP SUPER2 /NEXT
SUPER3, TAD I AXS1 /GET DISPATCH ADDRESS
DCA CHDFA
JMP I CHDFA /AND DISPATCH
SUPHUH, CLA
MESSAG
HUH
JMP SUPER
SUPTBA, SUPTBL-1
OUT1, OUT
STFLD, 0
CHDF
TAD I STFAD /WHAT WAS THE SECOND CHARACTER TYPED?
TAD STFM8
CLL
TAD C0010
SNL
JMP SUPHUH
CLL RTL
RAL
TAD C6201
DCA .+1
.-.
JMP I STFLD
STFAD, INBUFA+1
STFM8, -"8
/REFRESHER CONTROL
LOGSMA, LOGMES
REFFLD, CORFLD
REFDDT, XDDFLG
NOCSQ, ISZ CONDBA
REFCSQ, CORJMS
IFZERO DC08A <
REFREQ, FREQ
CYC50, FRETEL
CYC60,
IFNZRO CPU-2 <-6>
IFZERO CPU-2 <-14> >
REFCO0, JMS I LOGSMA /CHECK FOR NEW SI LOGIN MESSAGE
DISC /READ INIT INTO FIELD 1
DMAR
21
DISCHK /IS IT OK?
YESNO /LAOD XDDT?
DDTMES
STA
DATFLD
DCA I REFDDT /INITIALIZE XDDT LOAD FLAG
REFCO1, CHDF
MESSAG /# USER FIELDS -
CORMES
GETIN
OCTIN
DATFLD
DCA I REFFLD /INITIALIZE NUMBER OF USER FIELDS
TAD I REFFLD
CLL IAC
TAD C7770
SZL CLA /IS HIS/HER ANSWER REASONABLE?
JMP REFCO1 /NO
CHDF
YESNO
CSQ /DOES HE WANT ^S FEATURE?
TAD NOCSQ /NO
DATFLD
DCA I REFCSQ
IFZERO DC08A < IFNZRO CPU-4 <
CHDF
YESNO
FREQUE /60 HERTZ?
JMS I CYC50
TAD CYC60
DATFLD
DCA I REFREQ > >
CHDF
DISC /WRITE OUT INIT
DMAW
21
DISCHK /MAKE SURE IT'S OK
YESNO /DO YOU WANT TO REFRESH?
FIPREM
JMP I SUPERA /NO
JMP I .+1
FIPREF /GO REFRESH
SUPTBL, -"L
SUPLOD /LOAD
-"D
SUPDMP /DUMP
-"I
SUPREF /INITIALIZE
-"S
SUPST /START
-"X
7000 /XDDT
-"B
SBUILD /BUILD
-"P
DISCLK /PATCH
-"T
DSKDMP /LOAD OR DUMP; YOU CHOOSE HOW MANY TRACKS
-"O
PATCH /LOAD AN OVERLAY TAPE
-"C
LOAD /READ OR WRITE 4K TO "C" OR
-"Y
Y /READ BINARY TAPE TO A SELECTED FIELD
-"Z
Z0 /ZERO A SELECTED FIELD
-"M
MF0 /MATCH A SELECT FIELD WITH FIELD 1
-"W
CD0 /DUMP A SELECTED FIELD
-"E
OSB /EXIT TO SOME OPERATING SYSTEM
-"R
RFBOOT /BOOT TO OPERATING SYSTEM ON RF08/DF32
-"K
KEBOOT /ROOT TO RK8E
0 /TABLE TERMINATOR
/FOLLOWING THIS COMMENT, YOU WILL FIND XDDT. ONLY IT MIGHT BE A
/LITTLE HARD TO SEE, SINCE IT'S XLISTED.
/XLIST
*4434 / VRS: Reconstructed from working binary.
1117 / VRS: Need to disassemble this!
2400
0000
6000
1720
2200
0000
7000
7000
6202
0000
7001
1350
7001
1351
3346
7630
5264
1746
3754
4755
1754
4756
5757
4760
1754
3746
5757
1347
4761
3762
5757
0000
7000
6041
5276
6046
7200
5674
1246
7640
5313
7630
5321
4755
4763
5757
1764
7640
7001
3765
7420
5757
1352
5253
1244
3766
1767
0353
7640
5335
1770
3766
1244
3770
1771
3772
6224
1245
3773
1774
7510
5775
5776
0000
0070
0144
5554
5551
4400
7143
6360
7333
5222
4645
5116
5553
5711
6553
5552
5532
5350
5544
5227
5563
5407
5557
5503
5464
PAGE
0000
2342
1762
7650
5234
1347
3352
1357
4271
5216
1346
3343
2341
5600
1346
7640
5763
7040
1764
3352
1764
7041
1765
7112
7041
4271
5763
3345
1345
7000
1344
3344
5600
7040
0344
1345
5237
0000
4200
7300
3766
1341
7650
5266
2766
1344
1257
7600
1344
0360
1343
7430
1361
7410
1344
3767
5645
0000
3351
2352
7146
3353
7146
3354
1350
3355
1752
2352
7041
1755
2355
7640
5316
2353
5316
1752
2271
5671
2354
5302
2351
5273
5671
2770
0000
5771
0000
7430
5773
1774
3764
5772
1356
1340
3775
5772
7640
0000
0000
0000
0000
0000
0000
5773
6561
0000
0000
0000
0000
0000
7750
7772
0177
0200
6564
5635
6400
6552
7352
7143
7141
7343
5222
7465
6401
6665
PAGE
7020
4743
7100
5744
0000
0000
0000
0000
0000
0000
5613
7777
7420
5747
4750
1751
3752
2753
5754
0000
3755
1756
3757
1756
7041
1760
7112
7041
3761
4762
5240
5623
1755
7006
7700
1335
1336
4763
1341
4764
1755
0342
4765
5623
3755
1766
3757
1766
7041
1756
7112
7041
3761
4762
5270
5767
1755
4765
5767
1770
1340
7650
5771
1772
4316
3745
6224
7041
1745
7650
5311
1337
5313
7040
1773
3774
3775
5776
0000
3334
4750
1751
7104
7104
7104
7161
1334
7430
5747
7041
1334
5716
0000
7774
4440
7577
0007
0240
0777
7105
7010
6367
6317
5635
4645
7143
6553
4446
5605
6773
6402
6775
6552
6776
6600
7220
4474
7333
6401
6736
7537
5723
5400
6400
5722
5721
5222
PAGE
6002
7600
6046
4754
1755
7650
5220
3756
3757
3760
3755
4227
5217
1351
3750
4754
1337
3761
4754
5762
1226
5221
5301
0000
1763
3350
1764
7500
4765
7700
2227
5627
4766
1767
4770
1771
3350
1772
7510
5773
4765
1750
5254
1351
4754
3350
1350
0353
3227
1350
7004
7430
7500
5270
7010
5774
7004
7006
7700
5300
1771
0201
1227
3227
7420
5315
1772
4765
1227
0311
1311
7650
2627
7770
1627
3227
4754
1350
0337
1352
3775
7130
1350
0337
7640
5776
1771
3341
1772
4765
1341
7001
3627
4754
2227
7000
5777
0000
4227
5346
1750
3351
4754
5741
0000
0000
0763
0177
6324
5407
5551
5552
5554
4475
5600
5560
5557
6317
4645
7143
5672
5562
5561
5635
7324
5544
4523
7323
0000
2355
5250
5253
6324
5702
6317
0000
3351
7204
3352
6214
3353
1360
3362
1357
3361
3355
7001
3354
2356
5603
6201
1773
3342
1774
3343
1372
3344
1364
3207
1365
3774
7201
2330
5250
2344
5250
7200
6046
6041
5242
3354
1342
3773
1343
3774
4604
1361
7112
7010
5605
4606
1365
3760
1200
3330
1330
4606
1207
3766
1367
3770
1330
1314
7500
5270
7201
1226
1361
3342
1361
4606
7130
3361
2362
7770
1354
7650
1371
3330
1355
7640
0000
1347
3343
1352
7110
0000
1351
0000
5336
2362
7000
3351
1353
4606
1351
0000
0000
0000
5762
2362
0000
5762
0000
0000
0000
0000
0000
0000
4000
0000
4000
0000
0000
5201
5006
0006
5407
0007
6042
0000
0000
0001
PAGE
7240
3734
3735
4736
3737
1326
4224
1325
3740
7240
1327
3741
1327
4224
3742
1330
3743
3744
3745
5746
0000
3271
1331
3242
3671
2271
2242
5230
5624
7200
1332
4747
4750
5205
0000
1322
7160
1321
7420
5235
3270
1321
5642
4751
1752
3271
4242
3242
1753
4754
1271
3642
2242
2270
5262
5755
0000
0000
0000
7450
7001
7041
3756
6041
5277
5672
4757
1760
4761
1333
4762
4311
5763
0000
1764
4757
1765
4766
1765
3752
5711
0000
4177
1752
5767
7000
4741
6561
7771
7774
0277
5140
6553
4446
6311
7144
4635
7540
4745
7537
7536
4746
6030
4474
6360
4645
7143
6367
6317
5222
5556
6135
5562
6672
7235
5212
5552
5551
7333
7450
0000
0000
0000
0000
0116
0400
PAGE
2401
0400
0000
1000
1123
3200
0000
2000
0403
0100
0000
3000
1215
2300
0000
4000
1215
2000
0000
5000
0000
7200
1360
4764
1765
4766
6031
5232
4767
4770
6036
7450
5230
0357
3224
1224
7450
0000
1354
7450
5304
1356
7450
5306
1353
7450
5772
1350
7500
5310
7200
1224
1345
3343
1743
3344
1344
7650
5225
1343
1346
7500
5326
7200
1224
4764
4773
5744
4773
5774
4773
5775
1352
7500
5317
7200
1347
3344
5300
1355
7510
5262
1351
7450
5776
5225
1352
7700
5300
1224
1363
4777
5302
0000
1361
4764
1362
4764
5735
0000
0000
6177
1600
7400
7735
7741
7746
7757
7766
7773
7775
0177
0207
0260
0273
3600
4474
6367
6317
6324
5341
5007
5224
6300
7065
7062
5635
7235
6453
0000
5004
7200
4734
0000
0000
6543
4451
7740
4727
4450
0077
6454
7346
6452
0000
4735
7347
4452
4447
0000
0000
0000
0000
5653
0000
0000
0000
0000
6530
7457
5240
6337
5073
7006
7003
7005
7306
5000
7446
7433
7456
6445
7455
7400
7012
7401
7401
7401
7401
7401
7401
7401
7401
7400
7400
7014
5014
7120
7002
7121
5640
4503
0000
7340
1771
7200
5700
0212
0215
0240
0340
0000
1306
4772
1305
4772
5711
0000
1365
3322
6201
5717
0000
3366
6224
4317
1366
5724
7010
7013
7011
6547
7004
7030
1367
3773
4774
1775
3776
5777
0000
0214
7450
5746
1211
7500
1370
1310
4772
5746
0000
7200
1307
4772
5760
6201
0000
0000
7700
4742
4474
5557
4645
7143
5560
5222
0000
0000
0000
0000
1360
7041
1200
7500
5603
3357
1200
3354
1354
1366
3355
1754
3755
2354
2357
5214
5603
0000
1360
1366
3356
1361
3756
2356
1362
3756
2356
1363
3756
2356
1353
3756
5625
1767
3353
2770
4256
5771
7001
7001
4256
5772
0000
3365
1770
7640
1364
7650
5773
1365
1310
3270
0000
3360
4203
4225
7040
1365
7450
5305
7710
5310
1202
1366
3202
1201
1366
3201
1200
1366
3200
6224
7041
1774
7640
5656
1775
7160
1200
7420
7200
1775
3775
5656
6031
5330
6034
7650
5332
6032
6031
5336
6032
1346
3776
7040
1200
5777
7000
7260
5751
7066
4444
0000
0000
0000
0000
0000
0000
0000
0000
0000
0000
0000
7774
7142
4446
5640
5222
5635
6367
5722
4475
4457
0000
7240
1375
3375
3374
3670
1376
7700
5242
1375
1337
3375
1775
7141
1373
7620
5232
1374
7141
1775
7620
5232
1775
3374
1375
3377
2376
5211
1374
7450
5600
7041
1373
7640
5600
7146
1377
4671
2200
5600
3373
1745
3375
1745
7041
1746
7112
7041
3376
4200
5264
5672
1374
7640
5274
5303
7352
7220
0000
5250
7346
1377
4671
1341
4747
1374
7041
1373
4750
5672
0343
7006
7006
7006
1344
4671
1751
7006
7006
7630
1340
4752
4753
4754
5331
3373
1342
4752
1373
4272
2670
5757
0000
5755
5734
0004
0052
0253
3240
7000
5774
6400
6401
4474
7333
7143
7235
6360
7243
5054
5023
0000
7200
1751
3373
7132
1373
7200
1751
7420
5306
4756
5757
PAGE
5601
5200
1345
1346
1347
1350
1352
5755
1345
1346
1347
1350
1352
3337
1254
3257
1756
7420
5226
7200
4757
1760
7100
7640
7120
1343
7430
4761
7000
3341
1344
7640
5247
1341
3342
1337
3340
1340
3337
1762
4763
1741
4764
3343
4765
1343
4737
4765
2344
5766
7020
4305
5767
7221
3765
1254
3257
4305
1765
1342
3342
4770
1342
4752
1340
4771
1342
3341
5245
0000
1344
7670
5705
4757
1762
4763
1343
3741
4764
5705
1354
1227
3772
7420
5773
4757
1343
0774
7041
3344
1351
3257
4775
3341
5776
0000
6757
0000
0000
0000
0000
0076
0256
0023
0042
5777
6672
7333
0010
7507
7352
4645
4741
7243
6367
6317
6324
6360
5605
5222
6311
6346
7526
5635
6553
5642
7516
4723
7630
5631
1632
7012
7010
5633
0000
3353
1753
7012
7012
7012
4634
1753
4634
5606
0000
4206
2353
1353
4206
2353
1353
4206
5620
4470
5553
4457
6346
0000
3220
3352
1354
4206
5635
0000
7301
1361
0726
7440
7320
1726
0361
7430
5257
2243
5643
3353
1727
0363
1353
5643
0000
1353
7006
7004
3353
1353
0360
2206
7440
5277
5664
1362
4730
1206
7650
5733
4264
5277
7420
5731
4732
1726
3764
1765
3766
1765
3632
3767
7130
3770
4771
1356
3772
5773
7143
7141
4474
5635
4645
0000
7104
3353
3352
1357
3206
4264
5341
2774
5775
5776
7001
1355
3777
5776
0000
0000
7220
4752
5763
7774
0007
0177
0260
7600
5227
6367
5561
5555
5350
5672
5544
4523
5670
7516
5222
7077
2745
2337
5204
5746
7130
1336
3336
1747
0343
7430
5217
7106
7006
7006
2340
1740
3740
1747
0342
3335
1750
7104
7104
7104
1335
3750
5253
1337
1342
7640
5241
1751
5250
1344
3752
2745
4753
5251
3745
1754
3750
7040
3337
2755
5756
1332
1333
1334
3337
7430
4753
1337
5757
4753
1760
7161
1761
7200
1745
7670
5746
1760
1341
3340
1341
3762
2340
3740
2762
5302
5763
3340
7430
4764
4762
1765
4740
5766
1767
3335
1770
4771
1735
4772
0773
1774
7402
5775
1767
5776
0041
1537
5241
0000
0000
0000
0000
7774
0007
0077
0400
6564
5635
6024
4745
7142
4746
4600
6561
4742
6030
5610
4752
6401
6360
5222
4645
7143
5640
7141
6367
6317
6324
6553
7144
4723
7074
/XLIST
/ VRS: End of XDDT reconstruction
*5400
70 /PATCH FIELD SELECT FOR XDDT
*6400
4434
4434
4434
*4724
6031 /PATCH TO FIX XDDT BUGS ON 8E
*4726
5376
*4776
6032
5772
*5004 /^C CODE
TSF
JMP .-1 /WAIT FOR FLAG FROM ^C
XOP, SKP /NOP IF XDDT IS EXEC DDT
CIF CDF 0
JMP I .+1
4200
*5523
1222
*5547
7000
*5572
7760 /GIVE THE TTY FLAG MORE TIME
*6045
5225 /DON'T GO TO BINARY LOADER
/BINARY LOADER SUBROUTINE
/CALLING SEQUENCE: CDF TO FIELD TO LOAD TAPE INTO
/ JMS BINTAP
/ JMP ? /RETURN WITH FIELD SETTING IN AC6-8
/ /JMP BINT3 WHEN DESIRED ACTION HAS BEEN TAKEN
/ ? /RETURN WITH CHECKSUM IN THE AC
*7600
BINTAP, 0
KCC /BRING UP FLAG ON LS READER, AC=0
RFC /BRING UP FLAG ON HS READER
TAD M200
DCA TEMP /INITIALIZE DELAY TIME
BLORI,
BINF, KSF /LS READER FLAG YET?
JMP .+3 /NO
TAD BLORI /YES ---
JMP .+4
RSF /HS READER FLAG YET?
JMP BINIL /NO
TAD BHIRI /YES
DCA BINRD+1 /SAVE HI/LO SWITCH
JMS BFR /READ TAPE-LEADER?
JMP .+2 /YES - GO FIND END OF LEADER
JMP .-2 /NO - FIND LEADER BEFORE ANYTHING
JMS BFR /READ TAPE - LEADER?
JMP .-1 /YES - KEEP LOOKING
DCA ORIGIN /INITIALIZE ORIGIN FOR SAVE TAPES
GO, DCA BINCHK /CLEAR OUT OR UPDATE CHECKSUM
BINT2, TAD FRAME /WHAT WAS IT?
TAD C7500
SMA
JMP BINFLD /MUST HAVE BEEN A FIELD SETTING
TAD MASK /NOW GET THE FRAME BACK
DCA WORD1
JMS BINRD /GET NEXT FRAME
DCA WORD2
JMS BFR /NOW LOOK AHEAD FOR LEADER/TRAILER
JMP BINC /TRAILER! GO DO CHECKSUM
JMS ASSEMB /ASSEMBLE WORD
SZL /ORIGIN?
JMP BINORG /ORIGIN
DCA I ORIGIN /STORE AWAY DATA
ISZ ORIGIN /PREPARE FOR NEXT
M200, CLA 400
BINT4, TAD WORD1 /NOW UPDATE THE CHECKSUM
TAD WORD2
TAD BINCHK /ADD IN OLD CHECKSUM
JMP GO /AND GO SAVE IT AND CONTINUE
BINC, JMS ASSEMB /ASSEMBLE THE CHECKSUM
CIA
TAD BINCHK /COMPUTE FINAL CHECKSUM
BINC2, ISZ BINTAP /SKIP ON RETURN
SNA /CHECKSUM OK?
JMP I BINTAP /YES
DCA BINCHK /SAVE IT
MESSAG /TELL HIM/HER ABOUT BAD CHECKSUM
TAPERR
TAD BINCHK /GET CHECKSUM
JMP I BINTAP /AND RETURN; CHECKSUM IN AC
BINFLD, AND K0070 /GET FIELD BITS
JMP I BINTAP /AND GO PROCESS THEM
SWITCH,
ASSEMB, 0
TAD WORD1
CLL RTL
RTL
RTL
TAD WORD2
JMP I ASSEMB
BINIL, JMS DELAY
JMP BINF
/HERE IS THE REAL BINARY LOADER!
JMS BINTAP /GO AND BINARY LOAD
JMP .+3 /FOUND A FIELD SETTING
M376, HLT /FINISHED - CHECKSUM IN AC
BEGIN, JMP .-3 /CONTINUE - HE WANTS ANOTHER TAPE READ
TAD K6201 /MAKE A CDF
DCA .+1 /SAVE IT
TEMP, .-.
JMP BINT3 /AND CONTINUE
/MORE BINARY LOAD JUNK
/BFR - READ TAPE, IGNORING FRAMES BRACKETED BY RUBOUTS
/SKIP ON RETURN IF LEADER NOT FOUND
BFR, 0
DCA SWITCH /SET THE SWITCH (OR RESET IT)
TAD M200
DCA TEMP
JMS BINRD /GET A CHARACTER
TAD M376 /TEST FOR 377; RUBOUT
SPA SNA CLA
JMP .+4 /NOT RUBOUT
ISZ SWITCH /YES; COMPLEMENT SWITCH
CMA
JMP BFR+1
TAD SWITCH
SZA CLA /IS THE SWITCH SET?
JMP BFR+2 /YES; IGNORE THE DATA
TAD FRAME /WHAT WAS THE CHARACTER AGAIN?
AND MASK
TAD M200
SZA CLA /WAS IT LEADER?
ISZ BFR /NO, SKIP ON RETURN
JMP I BFR /AND RETURN
BINT3, JMS BFR /GET NEXT FRAME
JMP BINC /HUH? LEADER/TRAILER FOLLOWING FIELD SETTING OR ORIGIN!!
JMP BINT2 /AND PROCESS IT
BINRD, 0
HLT /KSF OR ELSE JMP HIR
JMP BINDL
KRB
DCA FRAME
TAD FRAME
JMP I BINRD
BHIR, RSF
JMP BINDL
RRB RFC
JMP .-6
*7750 /WC & CA; INIT WILL READ INTO FIELD 0 OK
.+1;.
BINDL, JMS DELAY
JMP BINRD+1
WORD1, .-. /DECTAPE WC & CA
WORD2, .-.
/MORE BINARY LOAD JUNK
BINORG, DCA ORIGIN /SAVE ORIGIN
JMP BINT4
DELAY, 0
ISZ FRAME
JMP I DELAY
ISZ TEMP
JMP I DELAY
STA /TIME OUT - GIVE HIM/HER ERROR MESSAGE
JMP BINC2
BHIRI, JMP BHIR
BINCHK, 0 /CHECKSUM ACCUMULATION
ORIGIN, 0 /CURRNET ADDRESS
FRAME, 0
C7500, 7500
MASK, 0300
K0070, 0070
K6201, 6201
*7777
JMP BEGIN /BINARY LOADER?!!
$ $ $ $ $!!!!!!!!!!