1184 lines
19 KiB
Plaintext
1184 lines
19 KiB
Plaintext
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 [S]HE WANT EXEC DDT?
|
||
JMS I LODDTA /YES
|
||
TAD CORJMS
|
||
CDF
|
||
SZA
|
||
DCA I CORCSQ /NO!
|
||
TAD CORFLD /HOW MANY USER FIELDS DID [S]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 [S]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 /[S]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 [S]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 /[S]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? "
|
||
|