888 lines
17 KiB
Plaintext
888 lines
17 KiB
Plaintext
/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, DISKCHK /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 [S]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 [S]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.
|
||
|
||
|
||
*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 - [S]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?!!
|
||
$ $ $ $ $!!!!!!!!!!
|
||
|