Index: bin/os8-cp
==================================================================
--- bin/os8-cp
+++ bin/os8-cp
@@ -56,15 +56,10 @@
progmsg = True
DEBUG = False
VERBOSE = False
QUIET = False
-# Default RK05 system image to attach if no sys specified.
-_default_sys_image = "os8v3d-patched.rk05"
-_default_sys_path = dirs.os8mo + _default_sys_image
-_default_att_spec = ["rk", "0", _default_sys_path]
-
# Regex for parsing an argument string into a sys device
_dev_arg_regex_str = "-(rk|td|dt|rx)(\d?)(s)?"
_dev_arg_re = re.compile(_dev_arg_regex_str)
# Regex for parsing an action file att string into a sys device. Note
@@ -368,21 +363,17 @@
If you give only one file name argument, the program always errors
out: it requires at least one source and one destination.
The -a, -b, -i, -y, and -z flags correspond to the OS/8 PIP options:
-
/A ASCII format. OS/8 and POSIX newlines are translated.
Such transfers are lossless if line endings are well-formed.
/B Binary OS/8 ABSLDR format with leader/trailer and other
specific formatting that is detected and enforced by PIP.
/I Image mode. Files are copied byte for byte verbatim.
/Z ZERO directory of destination OS/8 device.
/Y Yank system area from source to destination.
-
- If no format flag is set, the default transfer format is /I.
-
(This priogram currently uses PIP as its primary handler for the
OS/8 side of the work.) They must be followed by at least one source
file name, and they affect all subsequent source file names until
another such option is found. For example:
@@ -463,11 +454,11 @@
idx = 1
numargs = len(sys.argv)
filespec_seen = 0
- mode_opt = "i" # start of with default of binary.
+ mode_opt = "b" # start of with default of binary.
first_mode = mode_opt
source = ""
destination = ""
# Keep file_list and mode_list in sync.
file_and_mode_list = []
@@ -616,11 +607,10 @@
# s.set_logfile (os.fdopen (sys.stdout.fileno (), 'w', 0))
s.set_logfile (open ("logfile.txt", 'w'))
# Perform sys attach
att_spec = action_plan["sys"]
- if att_spec == None: att_spec = _default_att_spec
simh_boot_dev = att_spec[0] + att_spec[1] # Compose simh dev from name and unit.
imagename = att_spec[2]
if not os.path.exists (imagename):
abort_prog ("Requested boot image file: " + imagename + " not found.")
if VERBOSE or DEBUG:
Index: lib/simh.py
==================================================================
--- lib/simh.py
+++ lib/simh.py
@@ -161,11 +161,12 @@
def __init__ (self, basedir, ignore_gpio_lock = False):
# Start the simulator instance
self._child = pexpect.spawn(basedir + '/bin/pidp8i-sim')
self._valid_pip_options = ["/A", "/B", "/I"]
- self._os8_file_re = re.compile("(\S+):(\S+)?")
+ self._os8_file_regex_str = "(\S+):(\S+)?"
+ self._os8_file_re = re.compile(self._os8_file_regex_str)
self._os8_error_match_strings = []
self._os8_fatal_check = []
# Parse our OS/8 Errors table into actionable chunks
for error_spec in self._os8_errors:
Index: libexec/mkos8
==================================================================
--- libexec/mkos8
+++ libexec/mkos8
@@ -58,11 +58,10 @@
# Name of the RK05 disk image files we create
_bin_rk05 = "os8v3d-bin.rk05"
_src_rk05 = "os8v3d-src.rk05"
_patched_rk05 = "os8v3d-patched.rk05"
-_v3f_build_rk05 = "os8-v3f-build.rk05"
# Parser regexps used in patcher
_com_os8_parse_str = "^\.([a-zA-Z]+)\s?(.*)$"
_com_os8_parse = re.compile(_com_os8_parse_str)
_com_split_str = "^([a-zA-Z]+)\s?(.*)$"
@@ -70,25 +69,14 @@
_odt_parse_str = "^([0-7]+)\s?/\s?(\S+)\s+([0-7;]+)"
_odt_parse = re.compile(_odt_parse_str)
#### mkos8_abort ######################################################
# Fatal error. Abort mkos8
-# Assumes we are in SIMH context. Quit SIMH
def mkos8_abort (s):
print "Fatal Error. Cannot proceed."
s.quit ()
- exit (-1)
-
-#### mkos8_abort_os8 ##################################################
-# Fatal error. Abort mkos8
-# Assumes we are in os8 context. Exit to SIMH, then quit SIMH.
-
-def mkos8_abort_os8 (s):
- print "Fatal Error. Cannot proceed."
- s.back_to_cmd("\\.")
- s.quit ()
exit (-1)
#### check_exists ######################################################
# Check existence of all files needed
@@ -797,111 +785,17 @@
s.os8_squish ("SYS")
s.os8_squish ("DSK")
s.back_to_cmd("\\.")
s.send_cmd ("detach rk0")
-#### make_system_tape ##################################################
-# Make and install new OS/8 System Head.
-# ISSUE: Doing this will probably break the LC/UC batch scripts.
-
-#### call_pal8 #########################################################
-# Generic call out to PAL8 with error recovery.
-# We rely on the caller to have good specifications for source,
-# binary and optional listing files.
-
-def call_pal8 (s, source, binary):
- pal8_replies = ["ERRORS DETECTED: ", "BE\s+\S+", "CF\s+\S+", "DE\s+\S+", "DF", "IC\s+\S+", "ID\s+\S+",
- "IE\s+\S+", "II\s+\S+", "IP\s+\S+", "IZ\s+\S+", "LD\s+\S+", "LG\s+\S+", "PE\s+\S+",
- "PH\s+\S+", "RD\s+\S+", "SE\s+\S+", "UO\s+\S+", "US\s+\S+", "ZE\s+\S+", "\S+ NOT FOUND"]
-
- # Build OS/8 System head by using PAL-8 to assemble OS8.PA and CD.PA
- if progmsg: print "Assembling " + source
- com_line = binary + "<" + source
- s.os8_send_cmd ("\\.", "R PAL8")
- s.os8_send_cmd ("\\*", com_line)
- err_count = 0
- reply = s._child.expect (pal8_replies)
- executed_line = s._child.before.strip()
- reply_str = s._child.after.strip()
- if reply == 0:
- s._child.expect("\d+")
- err_count = int(s._child.after.strip())
- reply_str += " " + s._child.after.strip()
- if reply > 0 or err_count > 0:
- print "PAL8 Error: "
- print "\t*" + executed_line
- print "\t" + reply_str
- s.os8_send_ctrl ('c') # exit PAL8 Just in case.
- # We could do something better than just dying, I expect.
- mkos8_abort_os8(s)
- # s.os8_send_ctrl ('[') # exit PAL8
-
-
-#### make_v3f ##########################################################
-# Create an RK05 image containing the OS/8 v3f sources on partition A.
-# Build binaries for them into partition B.
-
-def make_v3f (s, args):
- sys_path = dirs.os8mo + _patched_rk05
- build_path = dirs.os8mo + _v3f_build_rk05
-
- if not os.path.isfile(sys_path):
- print "System pack: " + sys_path + " not found."
- mkos8_abort(s)
- if not os.path.isfile(build_path):
- print "OS/8 V3F build image: " + build_path + " not found."
- mkos8_abort(s)
-
- s.send_cmd ("attach rk0 " + sys_path)
- s.send_cmd ("attach rk1 " + build_path)
- s.send_cmd ("boot rk0") # We're running OS/8. Let's build!
-
- # Build BUILD
- if progmsg: print "Building BUILD."
- call_pal8(s, "RKA1:BUILD.PA","RKB1:BUILD.BN")
- if progmsg: print "Loading and savinging BUILD.SV to RKB1:"
- s.os8_send_cmd ("\\.", "R ABSLDR")
- s.os8_send_cmd ("\*", "RKB1:BUILD.BN")
- s.os8_send_ctrl ('[')
- s.os8_send_cmd ("\\.", "SAVE RKB1:BUILD.SV")
-
- call_pal8(s, "RKA1:OS8.PA", "RKB1:OS8.BN")
- call_pal8(s, "RKA1:CD.PA", "RKB1:CD.BN")
-
- # Build RESORC and CCL
- if progmsg: print "Preparing to build CCL and RESORC with BATCH scripts."
-
- s.os8_send_cmd ("\\.", "ASSIGN RKA1 IN")
- s.os8_send_cmd ("\\.", "ASSIGN RKB1 OUT")
-
- # BATCH scripts must be on the SYSTEM device. DSK: will work.
- s.os8_send_cmd ("\\.", "COPY DSK:<RKA1:RESORC.BI")
- s.os8_send_cmd ("\\.", "COPY DSK:<RKA1:CCL.BI")
-
- # The CCL.BI script chains to RESORC.BI
- s.os8_send_cmd("\\.", "SUBMIT CCL.BI")
- # What kind of error trapping can we do here?
-
- # Delete the batch scripts we copied in.
- s.os8_send_cmd ("\\.", "DEL DSK:<RKA1:RESORC.BI")
- s.os8_send_cmd ("\\.", "DEL DSK:<RKA1:CCL.BI")
- if progmsg: print "RESORC.SV and CCL.SV should be in RKB1:"
-
- # Finish up
- if progmsg: print "Cleaning up..."
- if progmsg: print "Squish RKB1:"
- s.os8_squish ("RKB1:")
- s.back_to_cmd("\\.")
- s.send_cmd ("detach rk0")
- s.send_cmd ("detach rk1")
#### main ##############################################################
# Program entry point. Parses the command line and drives the above.
def main ():
# Parse the command line
- allowed_acts = ["all", "bin", "src", "patch", "head", "v3f"]
+ allowed_acts = ["all", "bin", "src", "patch"]
do_all_acts = ["bin", "src"] # Just do bin and src if act is "all".
ap = argparser.ArgParser (allowed_acts)
global progmsg
progmsg = not ap.args.verbose
@@ -933,13 +827,12 @@
if progmsg else os.fdopen (sys.stdout.fileno (), 'w', 0))
if acts["bin"]: make_bin (s, ap.args)
if acts["src"]: make_src (s, ap.args)
if acts["patch"]: make_patch (s, ap.args)
- if acts["v3f"]: make_v3f (s, ap.args)
s.quit ()
if progmsg: print "Done!"
if __name__ == "__main__":
main()
DELETED src/os8-v3f/BLOAD.PA
Index: src/os8-v3f/BLOAD.PA
==================================================================
--- src/os8-v3f/BLOAD.PA
+++ /dev/null
@@ -1,1555 +0,0 @@
-/1 OS8 BASIC LOADER, V5B
-/
-/
-/
-/
-/
-/
-//
-/
-/
-/
-/
-/COPYRIGHT (C) 1972, 1973, 1974, 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 INCLU-
-/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
-/COPIES THEREOF, MAY NOT BR PROVIDED 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 AT ALL TIMES REMAIN IN DEC.
-/
-/
-/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
-/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
-/EQUIPMRNT COROPATION.
-/
-/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
-/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
-/
-/
-/
-/
-/
-/
- /DEC-S8-LBASA-B-LA
-/
-/COPYRIGHT C 1972, 1973, 1974
-/
-/DIGITAL EQUIPMENT CORPORATION
-/MAYNARD,MASSACHUSETTS 01754
-/
-/AUGUST 19, 1972
-/
-/HANK MAURER, 1972
-/SHAWN SPILMAN, 1973
-/
-/
-/
-/
-/ASSEMBLE AND LOAD AS FOLLOWS:
-/
-/ .R PAL8
-/ *BLOAD,BLOAD<BLOAD.03
-/ .R ABSLDR
-/ *BLOAD$
-/ .SA SYS BLOAD;7605
-/
-/NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
-/THE SOURCE AFTER TAG "IMAGE" AND THEN:
-/
-/ .R SRCCOM
-/ *LPT:<BLOAD.01,BLOAD.03
-/ *
-/
-/ALL CODE FOLLOWING TAG "IMAGE" IS NEW FOR VERSION 3
-/
- VERSON= 5 /VERSION WORD LOCATED AT TAG "VERLOC"
- /LEFT HALF CONTAINS 60+VERSON
- /RIGHT HALF CONTAINS PATCH LEVEL (A=01)
-
-/
-/CORRECTIONS MADE FOR V4 J.K 1975
-/ .MADE SWAP ROUTINE A REAL SWAP
-/ ./V FOR VERSION NUMBER
-/ ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES
-/ .ADJUST JSW FOR /K
-/ .CORRECTED CCB FOR /K
-/ .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8
-/ .TEST FOR BATCH RUNNIG
-/ .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE
-/ CAN BE DONE FROM A .SV FILE WITH A
-/ FILE STATEMENT
-/
-
-/JR 30-APR-77 UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT
-/ RUNNING
-/JR 9-MAY-78 ADD CODE TO HANDLE 2 PAGE SYSTEM HANDLERS (RL01)
- /OS8 BASIC COMPILER POST PROCESSOR
-
- /AUTO INDEX REGISTERS
-
- X10=10
- X11=11
- X13=13
- STACK=15
-
- /DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS
-
- NOPUNCH
-
- /BRTS COMMUNICATIONS REGION
-
- *20
-STCDF, 0
-NSTADR, 0
-NASTAD, 0
-SSTADR, 0
-SASTAD, 0
-CODCDF, 0
-CODBGN, 0
-DATTOP, 0
-DATPTR, 0
-SWPINF, 0
-
- /BCOMP COMMON REGION
-
- *40
-VARCNT, 0
-SVCNT, 0
-ACNT, 0
-SACNT, 0
-LOCTRH, 0
-LOCTRL, 0
-BLOCK, 0
-HIFLD, 0
-BRTS, 0
-DLSIZE, 0
-ABORTX, 0
-
- /PAGE 0 LOCATIONS USED BY LOADER
-
-FREEHI, 0
-FREELO, 0
-TEMP, 0
-TEMP2, 0
-TEMP3, 0
-WORD1, 0
-WORD2, 0
-WORD3, 0
-NCHARS, 0
-SUBHI, 0
-SUBLO, 0
-CODSZ1, 0
-CODSZ2, 0
-LOCHI, 0
-LOCLO, 0
-CODB, 0
-CODF, 0
-ICOUNT, 0
-OCOUNT, 0
-AC1, 0
-AC2, 0
-AC3, 0
-SC, 0
-LINEH, 0
-LINEL, 0
-XLABEL, 0
-CLRFLD, 0
-CLREND, 0
-RESADR, 0
-
- /MORE COMPILER DEFINITIONS
-
- SVARST= 1036
- ARAYST= 2132
- SARYST= 2332
- STEMPS= 2560
- LITRL= STEMPS+2
- SLITRL= LITRL+2
- DATLST= SLITRL+2
-
- /MISC DEFINES
-
- STACKA= 7120 /MAIN STACK OF COMPILER
- EDTBGN= 3212 /START OF EDITOR
- EDTSIZ= 2100 /SIZE OF EDITOR
- BRTBGN= 200 /START OF BRTS
- BRTSIZ= 3400 /SIZE OF BRTS
- DCB= 7760
- JSW= 7746 /OS/8 JOB STATUS WORD
- BIPCCL= 7777 /OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD
- FSTOP1= 7 /ADDR OF BRTS EXIT ROUTINE
-
- ENPUNCH /END OF DUMMY SECTIONS
- AC7775= CLL STA RTL
- AC7776= CLL STA RAL
-
- /LOADER PROPER
-
- *400
-LOADER, JMS I (IMAGE /CORE IMAGE FILE PATCH
- TAD (7577 /EXECUTION RESUMES HERE
- DCA FREELO
- CIA IAC
- DCA SWPINF /SET SWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1
- DCA LINEH /CLEAR LINE NUMBER
- DCA LINEL
- TAD STACK /ANY UNCLOSED FOR'S ?
- CIA
- TAD (STACKA-1
- SNA CLA
- JMP .+3 /NO
- JMS I (ERMSG /YES
- 2506
- CLA CMA
- TAD HIFLD /NO CDF'S IF ONLY 8K
- SZA CLA
- JMP NOPATCH /NO PATCHES
- TAD (PATLST-1
- DCA X10
-PATLUP, TAD I X10
- SNA
- JMP I (STSTUF
- DCA TEMP
- TAD (SKP /ALWAYS TWO WORDS
- DCA I TEMP
- JMP PATLUP
-NOPATCH,AC7775 /TEST MAGIC LOCATION FOR A 3
- TAD I (7612
- SZA CLA /SKP IF 2 PAGE SYSTEM HANDLER
-GOTTD, JMP NOTD8E /NO TD/8E OR ROM TD/8E
- /PREV INSTR NOP'D OUT TO FORCE TD8E (IMAGE)
- TAD (7377 /TD8E SYS WASTES 400 WORDS
- DCA FREELO
- STL RAR /SET SWAP INFO (17600 OUT NOW)
-NOTD8E, DCA SWPINF
- JMS I (FREEF /GET CDF TO HIGHEST FIELD
- DCA SWPF1 /INTO 2 PLACES
- TAD SWPF1
- DCA SWPF2
- TAD SWPF2 /PASS NEW HANDLER FIELD BITS TO SWAPPER (2 PAGE HNDLR)
- JMS SWAP /MOVE OS8 OUT
- JMP I (STSTUF /DO SYMBOL TABLE STUFF
- SWAP, 0 /SWAP OS8 RESIDENT
- AND (70 /ISOLATE NEW FIELD BITS IN AC
- DCA AC2 /SAVE THEM
- CLL CML RAR /4000
- AND SWPINF /IS IT A TD8E SYS ?
- SZA CLA
- JMP TD8ESYS /YES
- JMS SWPSUB /SWAP 17600 TO/FROM N7600
- CDF 10
- 7600
- JMP I SWAP
-TD8ESYS,JMS SWPSUB /SWAP 17600 TO/FROM N7400
- CDF 10
- 7400
- JMS SWPSUB /SWAP 27600 TO/FROM N7600
-L6221, CDF 20
-L7600, 7600
-TDLIE, AC7775 /TEST FOR GENUINE 2 PAGE HANDLER
- TAD I (7612
- SZA CLA
- JMP I SWAP /RETURN IF NO
- TAD (7635 /SET POINTER INTO HANDLER
- DCA AC1
-PATLP, TAD I AC1 /RANGE CHECK WORD FOR CDF 20-70
- TAD (-6300
- CLL
- TAD (70
- SNL CLA /SKP IF CDF N0
- JMP NOPAT /ELSE SKP ADJUSTMENT
- TAD I AC1 /GET INSTRUCTION
- AND (7707 /CLEAR FIELD BITS
- TAD AC2 /INSERT NEW ONES
- DCA I AC1 /STORE BACK
-NOPAT, ISZ AC1 /BUMP PTR
- JMP PATLP /LOOP
- JMP I SWAP
-
-SWPSUB, 0 /SWAPPER
- TAD I SWPSUB /GET FIELD
- DCA SWP1 /TWICE
- TAD SWP1
- DCA SWP2 /ONCE FOR EACH DIRECTION
- ISZ SWPSUB
- TAD I SWPSUB /GET HI FIELD ADDR
- DCA TEMP
- ISZ SWPSUB
- TAD L7600 /GET COUNT/POITER
- DCA TEMP2
-SWP1, HLT
- TAD I TEMP2 /GET PART OF RESIDENT
- DCA TEMP3
-SWPF1, JMP SWPRET /RETURN IF 8K ONLY
- TAD I TEMP
-SWP2, HLT
- DCA I TEMP2
- TAD TEMP3
-SWPF2, HLT
- DCA I TEMP /INTO HI FIELD
- ISZ TEMP /BUMP POINTER
- NOP /JR PROTECT AGAINST WRAP AROUND
- ISZ TEMP2 /AND PTR/CTR
- JMP SWP1 /LOOP
-SWPRET, CDF
- JMP I SWPSUB
-
- PAGE
- MAXSIZ= 120 /DEFINE MAXIMUM SIZE STRING
-
-NODATA, CDF
- JMS I (FREEF /SAVE FIELD
- CIA
- DCA CLRFLD /FOR ARRAY CLEARING
- TAD FREELO /SAVE THIS ADDR
- CIA
- DCA CLREND /FOR END OF ARRAY CLEAR
- ISZ FREELO /MAKE IT NEXT FREE + 1
- TAD (SVARST-1
- DCA X10 /ALLOCATE STRING VARS
- TAD (-436
- DCA TEMP
-ASVLUP, CDF 10
- TAD I X10 /LOOK FOR DEFINED STRING VAR
- DCA TEMP2 /SAVE SYMBOL NUMBER
- TAD I X10 /GET SIZE
- SPA
- TAD (4010 /IF UNDEF USE 16 CHARS
- DCA TEMP3
- TAD TEMP2 /IS IT DEFINED ?
- CDF
- SMA CLA
- JMS SVSTOR /YES, CREATE ENTRY
- ISZ TEMP /BUMP COUNT
- JMP ASVLUP /LOOP
- CDF 10 /ALLOCATE STRING TEMPS
-P6, TAD I (STEMPS+1
- DCA STEMPF /INIT FIELD
- TAD I (STEMPS /AND POINTER
- SKP
-STMLUP, TAD TEMP /LOOK AT NEXT ENTRY
- SNA
- JMP I (ALLOCA /DONE GO ALLOCATE ARRAYS
- TAD (-1
- DCA X10 /GET POINTER
-STEMPF, CDF 10
- TAD I X10 /GET ADDR OF NEXT ENTRY
- DCA TEMP /SAVE IT
-P7, TAD I X10 /AND ITS FIELD
- DCA STEMPF
- ISZ X10 /SKIP TEMP NUMBER
- TAD I X10 /GET SYM NUMBER
- DCA TEMP2
- CDF
- TAD (MAXSIZ /GIVE IT MAX SIZE
- DCA TEMP3
- JMS SVSTOR /ALOOCATE IT
- JMP STMLUP /LOOP
-SVSTOR, 0 /MAKE ST ENTRY FOR STRING VAR
- TAD TEMP2 /FIND ST ADDR
- CLL RAL
- TAD TEMP2
- TAD SSTADR
- DCA X11
- TAD TEMP3 /NUMBER OF CHARS
- TAD (3
- CLL RAR
- DCA SUBLO /NUMBER OF WORDS
- DCA SUBHI
- JMS SUB /FREEHI,LO=FREEHI,LO-SUBHI,LO
- TAD FREELO /SAVE ADDR
- DCA I X11
- JMS I (FREEF /AND FIELD
- DCA I X11
- TAD TEMP3 /PUT IN MAX LENGTH
- CIA /(NEGATIVE)
- DCA I X11
- JMP I SVSTOR
-PSN, 0 /PRINT 3 DIGITS DECIMAL
- DCA WORD2
- CLL CMA RTL /-3
- DCA XLABEL
-PRNTSN, TAD WORD2 /GET NEXT DIGIT
- CLL RTL /INTO THE LOW ORDER
- RTL /THREE BITS AND THE LINK
- DCA WORD2 /SAVE SHIFTED NUMBER
- TAD WORD2 /NOW DO LAST SHIFT
- RAL
- AND (17 /ONLY FOUR BITS
-SPACE, SZA
- JMP NOZERO /NOT A ZERO
- TAD I (TTY /ANY DIGITS YET ?
- SNA CLA
- JMP LEAD0 /NO, ITS A LEADING ZERO
-NOZERO, TAD (60 /MAKE IT ASCII
- JMS I (TTY /PRINT DIGIT
-LEAD0, ISZ XLABEL /BUMP COUNT
- JMP PRNTSN /MORE DIGIT(S)
- JMP I PSN
-SUB, 0 /DOUBLE SUBTRACT
- TAD SUBLO /SUBTRACT LOWER
- CLL CML CIA
- TAD FREELO
- DCA FREELO
- RAL /GET BORROW
- TAD SUBHI
- CIA
- TAD FREEHI /SUBTRACT UPPER
- DCA FREEHI /SAVE NEW UPPER
- TAD FREEHI /DID IT FIT ?
- SMA SZA CLA
- JMP I SUB /YUP
-TOOBIG, DCA LINEH /CLEAR LINE NUMBER
- DCA LINEL
- JMS I (ERMSG /WRITE MESSAGE
- 2402 /TOO BIG
- JMP I (ABORTL /ABORT RUN
-
-TTX, 0 /PRINT CHAR ON TTY
- TSF /WAIT FOR PREVIOUS CHAR
- JMP .-1
- TLS /PRINT THIS ONE
- CLA
- JMP I TTX
-
- PAGE
- / CAUTION !!!
-/ THIS PAGE AND THE NEXT ONE ARE
-/ OVERLAYED BY THE INPUT BUFFER
-/ AS SOON AS THE ROUTINE "INWORD"
-/ IS CALLED. THIS FIRST HAPPENS
-/ AFTER THE TAG "RELCIT" .
-
-STSTUF, TAD FREELO /SAVE START OF RESIDENT -1
- CIA /NEGATED
- DCA RESADR /USED TO COMPUTE AMOUNT OF MOVE
- TAD VARCNT /GET NUMBER OF
- TAD (401 /VARIABLES
- CIA
- DCA VARCNT
- TAD SVCNT /STRING VARIABLES
- TAD (401
- CIA
- DCA SVCNT
- TAD ACNT /ARRAYS
- TAD (41
- CIA
- DCA ACNT
- TAD SACNT /AND STRING ARRAYS
- TAD (41
- CIA
- DCA SACNT
- JMS I (FREEF /SAVE HIGH FIELD
- DCA STCDF
- TAD VARCNT /SUBTRACT SPACE FOR
- CLL RAL /SCALAR TABLE (3 WORDS A PIECE)
- TAD VARCNT
- TAD FREELO /DON'T BOTHER WITH A
- DCA FREELO /DOUBLE PREC. SUBTRACTION
- TAD FREELO /SAVE START OF SCALAR TABLE
- IAC /FOR INTERPRETER
- DCA NSTADR
- TAD FREELO /CLEAR ALL VARIABLES
- DCA X10 /IN THE
- DCA I X10 /SCALAR TABLE
- DCA I X10
- DCA I X10
- ISZ VARCNT
- JMP .-4 /JUST TO BE NICE
- CDF 10 /PREPARE TO MOVE
-P1, TAD I (LITRL+1/THE NUMERIC LITERALS
- DCA LFLD /INTO THE SCALAR TABLE
- TAD I (LITRL
- CDF
- SKP
-NLLOOP, TAD TEMP /ADDR OF NEXT LITERAL
- SNA
- JMP NONL /NO MORE NUMERIC LITERALS
- TAD (-1
- DCA X10
-LFLD, CDF 10
- TAD I X10 /GET ADDR OF NEXT LITERAL
- DCA TEMP
-P2, TAD I X10 /ALSO ITS FIELD
- DCA LFLD
- TAD I X10 /NOW ITS VALUE
- DCA WORD1
- TAD I X10
- DCA WORD2
- TAD I X10
- DCA WORD3
- TAD I X10 /NOW THE SYMBOL NUMBER
- DCA TEMP2
- TAD TEMP2 /TIMES THREE
- CLL RAL
- TAD TEMP2
- TAD FREELO /PLUS START
- DCA X11 /GIVES STORE ADDR
- CDF
- TAD WORD1 /NOW PUT LITERAL INTO TABLE
- DCA I X11
- TAD WORD2
- DCA I X11
- TAD WORD3
- DCA I X11
- JMP NLLOOP /DO NEXT LITERAL
-NONL, TAD ACNT /ALLOCATE ARRAY TABLE
- CLL RAL
- CLL RAL /FOUR WORDS PER
- TAD FREELO /SUBTRACT FROM LOWER END
- DCA FREELO
- TAD FREELO /SAVE THIS
- DCA NASTAD /START OF ARRAY TABLE
- TAD SVCNT /ALLOCATE
- CLL RAL /STRING VAR TABLE
- TAD SVCNT
- TAD FREELO /3 WORDS EACH
- DCA FREELO
- TAD FREELO /AND SAVE IT FOR THE INT
- DCA SSTADR
- TAD SACNT /NOW SPACE FOR STRING
- CLL RAL /ARRAY
- CLL RAL
- TAD FREELO /TABLE
- DCA FREELO
- TAD FREELO /SAVE FOR INT
- DCA SASTAD
- CDF 10 /PREPARE TO MOVE
-P3, TAD I (SLITRL+1
- DCA SLFLD /STRING LITERALS
- TAD I (SLITRL
- CDF
- SKP
-SLLOOP, TAD TEMP /IS NEXT LIT THERE ?
- SNA
- JMP I (NOSL /NO, END OF THE LINE
- TAD (-1
- DCA X10
- JMS SFLD /SET THE FIELD
- TAD I X10 /GET ADDR OF NEXT
- DCA TEMP
-P4, TAD I X10 /ALSO FIELD
- DCA TEMP2
- TAD I X10 /THEN CHAR COUNT
- DCA NCHARS
- JMP I (SLIT2 /DO REST OF STRING LIT
-SFLD, 0
-SLFLD, CDF 10
- JMP I SFLD
-
- PAGE
- SLIT2, TAD NCHARS /COMPUTE WORD COUNT
- TAD (3
- CLL RAR
- TAD X10 /TO GET ADDR OF SYMBOL NUMBER
- DCA TEMP3
- TAD I TEMP3
- CLL RAL /SYM NUMBER TIMES 3
- TAD I TEMP3
- TAD SSTADR /PLUS BASE
- DCA X11 /GIVES ST ADDR
- TAD NCHARS /ALLOCATE SPACE FOR IT
- IAC
- CLL CML CMA RAR
- DCA TEMP3 /(SAVE NUMBER OF WORDS)
- TAD TEMP3
- CLL
- TAD FREELO
- DCA FREELO /BELOW THE SYMBOL TABLES
- SNL
- JMP TMSLIT /TOO MUCH STRING LITERALS
- TAD FREELO
- TAD (-END-10
- SZL CLA
- JMP TMSLIT /DITTO
- TAD FREELO /STICK THE ADDR
- IAC
- CDF
- DCA I X11 /INTO THE ST ENTRY
- JMS I (FREEF /ALSO THE FIELD
- DCA I X11
- TAD NCHARS /ALSO THE SIZE
- CIA
- DCA I X11
- TAD FREELO /THIS IS WHERE IT GOES
- DCA X11
- TAD NCHARS /PUT IN THE LENGTH TOO
- CIA /(NEGATIVE)
- JMP .+4
-MOVSL, JMS I (SFLD
- TAD I X10
- CDF
- DCA I X11 /MOVE THE LITERAL TEXT
- ISZ TEMP3
- JMP MOVSL
-P5, TAD TEMP2 /PUT THE FIELD OF THE NEXT
- DCA I (SLFLD /ENTRY WHERE IT DOES THE MOST GOOD
- JMP I (SLLOOP /DO THE NEXT LITERAL
-NOSL, TAD FREELO /SAVE TOP OF DATA LIST
- DCA DATTOP
- TAD DATTOP /IF EMPTY MAKE TOP=BOTTOM
- DCA DATPTR
- TAD DLSIZE
- SNA /IS ANY DATA ?
- JMP I (NODATA /NO
- CLL
- TAD FREELO /GET START OF DATA
- DCA FREELO
- SNL
- JMP TMDATA /TOO MUCH DATA
- TAD FREELO
- TAD (-END-10
- SZL CLA
- JMP TMDATA /DITTO
- TAD FREELO /SAVE IT
- DCA DATPTR
- TAD FREELO /USE X13 TO FILL LIST
- DCA X13
- TAD (DATLST-1
- DCA X10
- CDF 10
-DATLUP, TAD I X10 /ANY MORE DATA ELEMENTS ?
- SNA
- JMP I (NODATA
- DCA TEMP /SAVE ADDR
-P8, TAD I X10 /GET NEW FIELD
- DCA DATAF1
-P9, TAD DATAF1 /TWICE
- DCA DATAF2
- TAD TEMP /START WITH NEW ELEMENT
- DCA X10
-DATAF1, CDF 10
- TAD I TEMP /GET COUNT
- DCA TEMP
-DATMOV, TAD I X10 /GET NEXT WORD
- CDF
- DCA I X13 /MOVE INTO DATA AREA
-DATAF2, CDF 10
- ISZ TEMP
- JMP DATMOV
- JMP DATLUP /DO NEXT ELEMENT
-TMDATA, DCA LINEL /ZERO LINE NUMBER
- DCA LINEH
- JMS I (ERMSG /PRINT ERROR MESSAGE
- 2404
- JMP I (ABORTL
-TMSLIT, DCA LINEH /CLEAR THE LINE NUMBER
- DCA LINEL
- JMS I (ERMSG /PRINT MESSAGE
- 2423
- JMP I (ABORTL
-
-PATLST, P1;P2;P3;P4;P5;P6;P7;P8;P9;0
-
- PAGE
- ALLOCA, TAD ACNT /ANY ARRAYS ?
- SNA CLA
- JMP ALLOCS /NO
- TAD (ARAYST /ALLOCATE ARRAYS
- DCA X10
- TAD NASTAD
- DCA X11
-DOARAY, CDF 10
- TAD I X10 /GET NEXT ARRAY
- DCA TEMP
- TAD I X10 /GET FIRST DIM
- SNA
- TAD (12 /USE 10 IF NONE
- IAC /ALLOCATE 0TH ELEMENT
- DCA TEMP2
- TAD I X10 /GET SECOND DIM
- SNA
- TAD (12
- IAC
- DCA TEMP3
- TAD TEMP3 /GET READY TO SUBTRACT
- DCA SUBLO
- DCA SUBHI
- CDF
- CLL CML RTR
- AND TEMP /HOW MANY DIMS ?
- SNA CLA
- JMP ONLY1 /ONE
- TAD TEMP2 /PRODUCT OF DIMS
- JMS I (MUL12
- JMP TIMES3 /MULT BY 3
-ONLY1, DCA TEMP3 /ZERO SECOND DIMENSION
- TAD TEMP2
- DCA SUBLO
-TIMES3, TAD (3 /MULT SIZE BY 3
- JMS I (MUL12
- JMS I (SUB /SUBTRACT FROM FREE
- TAD FREELO
- DCA I X11 /SAVE ADDR IN S.T.
- JMS I (FREEF
- DCA I X11
- TAD TEMP2 /ALSO DIMS
- DCA I X11
- TAD TEMP3
- DCA I X11
- ISZ X10 /SKIP SYMBOL NUMBER
- ISZ ACNT
- JMP DOARAY
-ALLOCS, TAD SACNT /ANY STRING ARRAYS
- SNA CLA
- JMP I (RELCIT /NO
- TAD (SARYST+1
- DCA X10 /ALLOCATE STRING ARRAYS
- TAD SASTAD
- DCA X11
-DOSARY, CDF 10
- TAD I X10
- SNA
- TAD (12 /USE 10 FOR DIM
- IAC
- DCA TEMP3
- TAD I X10 /GET DIM
- SNA
- TAD (10 /USE 16 IF NO SIZE SPEC
- DCA TEMP2
- TAD TEMP3
- DCA SUBLO /PREPARE FOR MULT
- DCA SUBHI
- CDF
- TAD TEMP2 /GET NUM WORDS PER STRING
- TAD (3
- CLL RAR
- JMS I (MUL12 /GET ARRAY SIZE
- JMS I (SUB /DO SUBTRACTION
- TAD FREELO /SAVE ADDR
- DCA I X11
- JMS I (FREEF
- DCA I X11
- TAD TEMP2 /AND STRING SIZE
- CIA /(SIZES ARE NEG)
- DCA I X11
- TAD TEMP3 /AND NUMBER OF STRINGS
- DCA I X11
- ISZ X10 /SKIP NEXT NAME
- ISZ X10 /AND NEXT SYM NUMBER
- ISZ SACNT
- JMP DOSARY
- JMP I (RELCIT
-INWORD, 0 /READ FROM CODE FILE
- ISZ ICOUNT /ANYTHING IN BUFFER
- JMP NOREAD /YASSUH!
- JMS I (7607 /READ NEXT BLOCK
- 200
- 1000 /NOTE: THIS OVERLAYS USED CODE
-INBLOK, 0
- JMP I (IOERR
- ISZ INBLOK /BUMP BLOCK COUNTER
- TAD INBLOK-1/RESET BUFFER POINTER
- DCA INPTR
- TAD (-400 /AND COUNTER
- DCA ICOUNT
-NOREAD, TAD I INPTR /GET WORD
- ISZ INPTR /BUMP POINTER
- JMP I INWORD
-INPTR, 0
-
-CIPAT, 0 /PATCH TO MAKECI
- TAD (1000
- DCA I (JSW /CHANGE JSW
-COPT, DCA I (CISTRT+1 /& TAKE CARE OF /C
- JMP I CIPAT
-
- PAGE
- RELCIT, TAD LOCTRL /FIND START OF CODE
- CLL IAC
- DCA SUBLO /BY SUBTRACTING
- RAL
- TAD LOCTRH /AMOUNT FROM FREE
- DCA SUBHI
- JMS I (SUB
- TAD FREELO /THIS IS THE START OF THE CODE
- DCA CODBGN /MINUS ONE
- TAD FREEHI /THIS IS THE FIELD NUMBER
- DCA CODCDF
- TAD LOCTRL /SET UP PROG SIZE COUNT
- CLL CML CIA
- DCA CODSZ1 /LOWER COUNT
- RAL
- TAD LOCTRH
- CIA
- DCA CODSZ2 /UPPER COUNT
- TAD BLOCK /SET UP FOR READ AND WRITE
- DCA I (OUBLOK
- TAD BLOCK
- DCA I (INBLOK
- TAD (-401
- DCA OCOUNT
- CLA CMA
- DCA ICOUNT
-RELOOP, JMS I (INWORD /GET A WORD OF CODE
- DCA TEMP
- TAD (3000
- TAD TEMP /CHECK FOR OPCODE 5000 (GOTO)
- AND (7000
- SZA CLA
- JMP NORELC /NO JUMP
- TAD TEMP /REMOVE FIELD BITS
- AND (340
- CLL RTR
- TAD CDF0
- DCA LBLFLD /FIELD OF LABEL ENTRY
- TAD TEMP /ZERO FIELD BITS
- AND (7437
- DCA TEMP
- JMS I (INWORD /GET REST OF ADDR
- DCA TEMP2
- JMS I (CHKLBL /CHECK FOR UNDEFINED LABEL
-LBLFLD, HLT
- TAD I TEMP2
- AND (7 /GET ADDR TO BE RELOCATED
- DCA LOCHI
- ISZ TEMP2
- TAD I TEMP2
- CLL
- TAD CODBGN /ADD BASE ADDR
-CDF0, CDF
- DCA LOCLO /SAVE LOW PART OF JUMP
- RAL
- TAD CODCDF /GET HIGH PART
- TAD LOCHI
- CLL RTL /PUT IT INTO CORRECT PLACE
- RTL
- RAL
- TAD TEMP /PLUS INSTRUCTION
- JMS I (OUTWRD
- ISZ CODSZ1 /BUMP COUNTER
- SKP
- ISZ CODSZ2 /CAN'T BE LAST WORD
- TAD LOCLO /OUTPUT LOW ORDER ADDR
- SKP
-NORELC, TAD TEMP /JUST OUTPUT IT
-RELOUT, JMS I (OUTWRD
- ISZ CODSZ1 /DOUBLE WORD ISZ BUMP
- JMP RELOOP
- ISZ CODSZ2
- JMP RELOOP
- JMP I (LOADIT /DONE RELOCATING, GO LOAD
-
- /PRINT ERROR MESSAGE
-
-ERMSG, 0 /PRINT ERROR MESSAGE
- CDF
- TAD I ERMSG /GET CODE
- CLL RTR /PRINT FIRST CHAR
- RTR
- RTR
- JMS TTY
- TAD I ERMSG /PRINT SECOND CHAR
- JMS TTY
- ISZ ERMSG /FIX RETURN ADDR
- TAD (240 /PRINT SPACE
- JMS TTY
- DCA TTY /USE TTY AS A SWITCH
- TAD LINEH /PRINT HIGH ORDER
- JMS I (PSN
- TAD LINEL /THEN LOW ORDER
- JMS I (PSN /(LINE NUMBER NATCH !)
- TAD (215 /PRINT CARRIAGE RETURN
- JMS I (TTX
- TAD (212 /PRINT LINE FEED
- JMS I (TTX
- JMP I ERMSG /RETURN
-
-TTY, 0 /CONVERT TO ASCII AND PRINT
- TAD (240
- AND (77
- TAD (240
- JMS I (TTX /PRINT CHAR
- JMP I TTY /RETURN
-
- PAGE
- LOADIT, JMS I (OUDUMP /DUMP LAST BLOCK
- TAD LOCTRL /SET UP COUNTER
- CIA CLL CML
- DCA CODSZ1
- RAL
- TAD LOCTRH
- CIA
- DCA CODSZ2
- TAD CODBGN
- DCA TEMP /CODE BEGIN -1
- TAD BLOCK /SET UP BLOCK NUMBER
- DCA I (INBLOK
- CLA CMA
- DCA ICOUNT
- TAD CODCDF /SET UP CODE CDF
- CLL RTL
- RAL
- TAD (6201
- DCA CODCDF
- TAD CODCDF
- DCA CF
-LODLUP, ISZ TEMP /BUMP POINTER
- JMP NOFJMP /FIELD IS OK
- TAD CF /BUMP THE FIELD
- TAD (10
- DCA CF
-NOFJMP, JMS I (INWORD /GET NEXT WORD
-CF, HLT
- DCA I TEMP /SAVE THE WORD
-CDFZER, CDF
- ISZ CODSZ1 /MORE CODE ?
- JMP LODLUP /YES
- ISZ CODSZ2
- JMP LODLUP /YES
- TAD CF /GET THE FIELD
- DCA CLEARF /AND SAVE IT
-CLRLUP, TAD CLREND /IS THIS THE END OF CLEAR ?
- TAD TEMP
- SZA CLA
- JMP MORCLR /NO, KEEP GOING
- TAD CLRFLD /DO FIELDS MATCH ?
- TAD CLEARF
- SNA CLA
- JMP DONCLR /YES, ARRAYS ARE CLEARED
-MORCLR, ISZ TEMP /BUMP POINTER
- JMP CLEARF /DON'T BUMP FIELD
- TAD CLEARF /DO BUMP FIELD
- TAD (10
- DCA CLEARF
-CLEARF, HLT
- DCA I TEMP /CLEAR THE WORD
- JMP CLRLUP /DO MORE
-DONCLR, TAD CLEARF /COPY THE FIELD
- DCA STFLDM
- TAD TEMP /GET THE COUNT
- TAD RESADR /OF HOW MUCH SYMBOL TABLE
- DCA TEMP2 /TO MOVE
- TAD TEMP /PUT IT INTO AUTO XR'S
- DCA X13
- TAD X13
- DCA X11
-MOVSTL, CDF
- TAD I X11 /GET NEXT WORD OF ST
-STFLDM, HLT
- DCA I X13 /STORE IT
- ISZ TEMP2
- JMP MOVSTL
- JMS MOVFIN /MOVE FINI PAGE INTO 7000-7177
- JMP I (7000 /GO READ BRTS.SV
- CHKLBL, 0 /CHECK LABEL FOR UNDEF
- TAD I CHKLBL /GET FIELD
- DCA .+1
- HLT
- TAD I TEMP2 /GET FIRST WORD OF LABEL
- SPA CLA
- JMP I CHKLBL /SIGN BIT IS DEFINED
- CLL CMA RAL /GET ADDR OF LINE NUM
- TAD TEMP2
- DCA XLABEL
- TAD I XLABEL /GET HIGH ORDER LINE
- DCA LINEH
- ISZ XLABEL
- TAD I XLABEL /GET LOW ORDER
- DCA LINEL
- CDF
- JMS I (ERMSG /PRINT MESSAGE
- 2523
- JMP I CHKLBL /RETURN
-
-FREEF, 0 /MAKE A CDF FROM FREEHI
- TAD FREEHI
- CLL RTL
- RAL
- TAD CDFZER
- JMP I FREEF
-
-ABORTL, JMS MOVFIN /PUT FINI PAGE INTO 7000-7177
- /AND ABORT THE RUN
- JMP I (ABORT-FINI+7000
-
-MOVFIN, 0 /FINI PAGE MOVER
- CDF
- TAD (FINI-1 /MOVE INT READING CODE
- DCA X10
- TAD (6777 /INTO 7000
- DCA X11
- TAD (-200
- DCA TEMP /PUT CORRECT COUNT HERE
- TAD I X10
- DCA I X11 /MOVE CODE
- ISZ TEMP
- JMP .-3
- JMP I MOVFIN
-
- PAGE
- FINI, TAD I XERMSG /ANY ERRORS ?
- SZA CLA
- JMP ABORT /YES, DON'T RUN IT
- TAD XINT /MOVE INT STUFF
- DCA FTEMP
- TAD M12 /10 KEY LOCATIONS
- DCA FCNT
- TAD XSAVE /INTO A SAFE PLACE
- DCA FTEMP2
- TAD I FTEMP
- ISZ FTEMP
- DCA I FTEMP2
- ISZ FTEMP2
- ISZ FCNT
- JMP .-5 /MOVE LOOP
- TAD BRTS /READ IN BRTS
- DCA BRTSB
- JMS I X7607
- BRTSIZ
- 0
-BRTSB, 0
- JMP IOERR
- TAD XSAVE
- DCA FTEMP
- TAD XINT /MOVE STUFF BACK
- DCA FTEMP2
- TAD I FTEMP
- ISZ FTEMP
- DCA I FTEMP2
- ISZ FTEMP2
- ISZ M12
- JMP .-5
- TAD (JMP I FSTOP1 /PATCH ^C LOCATIONS
- DCA I (7600
- TAD (JMP I FSTOP1
- DCA I (7605
- JMP I (BRTBGN /GO START BRTS
-
-M12, -12
-XINT, 20
-XERMSG, ERMSG
-X7607, 7607
-XSAVE, 7001+XSAVE-FINI
-
-MUL12, 0 /MULTIPLY 12BITS AND 24 BITS
- DCA AC3 /SAVE 12 BIT THING
- DCA AC2 /CLEAR REST OF AC
- DCA AC1
- TAD (-15 /ONLY TEST 12 BITS
- DCA SC
- JMP MULBGN
-MULLUP, SNL /WAS BIT ON ?
- JMP NOADD /NO, DON'T ADD
- TAD SUBLO /ADD TO HIGH ORDER 2/3'S OF AC
- TAD AC2
- DCA AC2
- CML RAL
- TAD SUBHI
-NOADD, TAD AC1 /SHIFT AC RIGHT
- CLL RAR
- DCA AC1
- TAD AC2
- RAR
- DCA AC2
-MULBGN, TAD AC3
-FTEMP, RAR
-FTEMP2, DCA AC3
-FCNT, ISZ SC /BUMP SHIFT COUNTER
- JMP MULLUP
- TAD AC2 /ANSWER IS LOWER 2/3'S OF AC
- DCA SUBHI
- TAD AC3
- DCA SUBLO
- JMP I MUL12
-
-IOERR, DCA LINEL /ZERO LINE NUMBER
- JMS I XERMSG /PRINT MESSAGE
- 1117
-ABORT, TAD (20 /PASS NORMAL FIELD BITS TO RESTORE ANY 2 PAGE SYS:
- JMS I (SWAP /SWAP OS8 BACK
- JMS I (200 /CHECK OUT W/ CI BUILDER
- TAD (4207 /RESTORE ^C LOCATIONS
- DCA I (7600
- TAD (6213
- DCA I (7605
- TAD ABORTX /CALLED VIA CHAIN ?(FROM EDIT)
- SNA
- JMP I (7600 /NO, RETURN TO OS8
- DCA EDTBLK /YES, SAVE EDITOR START
- JMS I X7607 /READ IN EDITOR
- EDTSIZ /THIS MUCH
- 0
-OWTEMP,
-EDTBLK, 0
- JMP I (7605 /ERROR
- JMP I (EDTBGN /GO START EDITOR
-
-OUTWRD, 0 /OUTPUT WORD TO TEMP FILE
- ISZ OCOUNT /ANY ROOM ?
- JMP NOWRIT /YES
- DCA OWTEMP /SAVE WORD
- JMS OUDUMP /WRITE BLOCK
- ISZ OUBLOK /BUMP BLOCK NUMBER
- TAD OUBLOK-1/RESET BUFFET POINTER
- DCA OUPTR
- TAD (-400
- DCA OCOUNT /AND COUNT
- TAD OWTEMP /RESTORE AC
-NOWRIT, CDF 10
- DCA I OUPTR /INTO BUFFER
- CDF
- ISZ OUPTR
- JMP I OUTWRD
-OUPTR, 0
-OUDUMP, 0 /WRITE BLOCK
- JMS I X7607 /WRITE BLOCK
- 4210
- 0
-OUBLOK, 0
- JMP IOERR
- JMP I OUDUMP
-
- END=FINI+200
-
- PAGE
- BLDCI=200 /PAGE INTO WHICH MAKECI GETS MOVED
- LOADBL=357 /LOC WHERE BCOMP LEAVES BLOAD BLOCK #
-
-IMAGE, 0
- TAD I (LOADBL /COME HERE TO CREATE CORE IMAGE
- TAD (6 /ALREADY HAVE THIS MUCH
- DCA I (LDRBLK /INIT BLOAD OVRLY READER
- CDF 10
- TAD I (7644 /TEST FOR /V
- CDF
- AND (4
- SZA CLA
- JMS I (VERNUM
- CDF 10
- TAD I (7643 /GET OPTION BITS
- CDF
- DCA TEMP
- TAD TEMP
- RTR
- SNL CLA /HAVE K OPTION?
- JMP LSTART /NO: START LOADER
- TAD TEMP
- RTL
- SZL CLA /HAVE B OPTION?
- DCA I (FLGRTS /YES: FLAG IT
- TAD TEMP /TEST FOR /C
- RTL
- SPA CLA
- JMP .+3
- TAD (NOP
- DCA I (COPT
- CDF 10
- TAD I (7646 /GET =N
- CDF
- AND (7 /WIPE ALT MODE
- SNA
- CLL CML RTL /DEFAULT=12K FOR NOW
- DCA TEMP
- CLL CMA
- TAD TEMP /MUST BE >1 HERE
- SNA CLA
- ISZ TEMP
- TAD TEMP
- CLL CMA
- TAD HIFLD
- SNL CLA /WHICH HAS MORE CORE?
- JMP .+3 /TARGET MACHINE: TOUGH
- TAD TEMP /HOST MACHINE
- DCA HIFLD /FAKE OUT LOADER
- TAD HIFLD
- CIA
- DCA I (FLDCNT /INIT CI BUILDER
- TAD I (FLDCNT
- DCA I (MYCORE /AND CI STARTER
- CDF 10
- DCA I (7646 /CLEAR =N BITS
- DCA I (7643 /AND EARLY OPTIONS
- TAD I (7644 /GET OPTION BITS
- CDF
- RTL
- SZL CLA /HAVE N SWITCH?
- JMP NOTDSY /NEVER SEES TD8E SYSTEM
- TAD HIFLD
- CLL RAR
- SNA CLA /HAVE OVER 8K CORE?
- JMP NOTDSY
- TAD (NOP
- DCA I (GOTTD /YES: FORCE SYS=TD8E
- CLA IAC
-NOTDSY, DCA I (TDFLAG /NOT 0 MEANS HAVE TD8E
- CMA
- DCA I (ERMSG /FORCE LOAD ABORT
-LSTART, TAD (BLDCI-1 /MOVE CI BUILDER
- DCA X10 /INTO LOW CORE
- TAD (MAKECI-1
- DCA X11
- TAD I X11
- DCA I X10
- ISZ ICTR
- JMP .-3
- TAD HIFLD /START OF BLOAD V1
- DCA FREEHI
- JMP I IMAGE /RETURN TO LOADER
-
-ICTR, -200
-CCLIST, 0 /1ST 4 WORDS OF CCB
- 6203
- CISTRT
- 1000 /JOB STATUS WORD
-
- PAGE
- CCB=1000 /LOC TO START BUILDING CCB
-
-MAKECI, 0 /THIS PAGE GETS MOVED!
- TSF
- JMP .-1 /SEE TAG "ABORT" IN BLOAD V1
- ISZ I (ERMSG /WHY ARE WE HERE?
- JMP BOSFIX /GENUINE ABORTION
- TAD (CCB-1
- DCA X10
- TAD (CCLIST-1
- DCA X11
- TAD I X11 /1ST FOUR WORDS OF CCB
- DCA I X10
- ISZ MKCCNT
- JMP .-3
-CCSEGS, TAD FLDCNT
- CLL CIA RAL
- RTL /THIS FIELD
- DCA TEMP
- TAD (70
- AND CODCDF /LOWEST FIELD USED
- CLL CIA
- TAD TEMP
- SNL /THIS FIELD USED?
- JMP NOCODE /NO: BYPASS IT
- SZA CLA /IS IT FULL?
- JMP ALLCODE /YES
- TAD CODBGN /PROBABLY NOT
- AND (7400
- DCA TEMP2
- TAD TEMP2
- CIA
- CLL RAR
- TAD TEMP
- DCA TEMP
- TAD TEMP2
-ALLCODE,DCA I X10
- TAD FLDCNT
- IAC
- TAD TDFLAG
- SMA CLA /NEED TOP PAGE?
- TAD (3700 /NO: 37 PAGES
- TAD TEMP /YES: 40 PAGES
- AND K3777
- DCA I X10
- ISZ I (CCB
-NOCODE, CLA CLL
- ISZ FLDCNT /NEXT FIELD ZERO?
- JMP CCSEGS /NO: LOOP
- TAD FLGRTS
- SZA CLA /NEED BRTS?
- TAD (CISTRT
- DCA I X10
- TAD FLGRTS
- SZA CLA
- TAD (300-3700
- TAD (3700
- DCA I X10
- TAD I (CCB
- CMA
- DCA I (CCB /NEGATE SEG COUNT
- JMS I (7607 /READ CI STARTER
- 300 /FROM END OF BLOAD.SV
- CISTRT /INTO HI CORE
-LDRBLK, 0 /INIT BY "IMAGE"
-BOSPT1, 7600 /CAN'T GET THIS ERROR
- JMS I JCIP
- TAD TDFLAG /PASS TD8E FLAG
- DCA I (FLAGTD
- TAD FLGRTS
- DCA I (RTSFLG /AND BRTS FLAG
- TAD MYCORE
- DCA I (NOCORE /AND CORE LIMIT
- TAD (17 /SAVE 10 KEY LOCATIONS
- DCA X10
- TAD (KEYLOC-1
- DCA X11
- TAD I X10
- DCA I X11
- ISZ MCICNT
- JMP .-3
- JMS I (7607 /CALL SYS HANDLER
- 4200 /TO WRITE CCB
- CCB-200 /(AND PRECEDING PG)
- 37 /INTO SCRATCH BLOCK
-K3777, 3777 /CAN'T GET THIS ERROR
- JMP I (EXEUIT
-
-MKCCNT, -4
-MCICNT, -12
-FLDCNT, -7
-TDFLAG, 1 /0 MEANS TD8E IS DEATH AT RT
-FLGRTS, -1 /0 MEANS INCL BRTS IN CI
-
-BOSFIX, TAD I (BIPCCL
- RAL
- SMA CLA
- JMP I MAKECI /BATCH NOT RUNNING
- TAD I (7777
- AND (70
- TAD CDFZRO
- DCA BOSCDF /CDF TO BATCH FIELD
-BOSLUP, CDF 10
- TAD I BOSPT1 /GET BATCH WRDS
-BOSCDF, CDF 10
- DCA I BOSPT2 /BACK INTO POSITION
-CDFZRO, CDF
- ISZ BOSPT1
- ISZ BOSPT2
- JMP BOSLUP
- JMP I MAKECI
-
-BOSPT2, 7774
-MYCORE, 0
-JCIP, CIPAT
-
- PAGE
- VERNUM, 0
- TAD (VTEXT
- DCA TEMP
-MOREV, TAD I TEMP
- SNA
- JMP VOUT
- CLL RTR
- RTR
- RTR
- JMS I (TTY
- TAD I TEMP
- JMS I (TTY
- ISZ TEMP
- JMP MOREV
-VOUT, TAD (215
- JMS I (TTX
- TAD (212
- JMS I (TTX
- JMP I VERNUM
-
-VTEXT, TEXT /BLOAD V/
- *.-1
-VERLOC, 100^VERSON+6001
- 0
-
- PAGE
- *7000
- BSTART=200 /START ADDR FOR BRTS
-CISTRT, SKP /RUNNED
- JMP CHAIN /CHAINED
- TAD (7603
- DCA X10
- TAD (NAMLST-1
- DCA X11
- CDF 10
- DCA I X10 /ZERO EDITOR
- DCA I X10 /COMPILER
- DCA I X10 /AND LOADER BLOCK #S
- CDF
- CIF 10
- JMS I (7700
- 10 /USRIN
-FINDSV, TAD I X11 /LOOKUP SOME SAVE FILES
- SNA
- JMP LUBUF /GO LOOK FOR BASIC.UF
- DCA XXXXSV /SAVE POINTER TO NAME
- CLA IAC /THEY'RE ON SYS
- CIF 10
- JMS I (200
- 2
-XXXXSV, 0
- 0
- JMS I (ERRORX /ERROR
- TAD XXXXSV /GET STARTING BLOCK
- IAC /PLUS 1
- CDF 10
- DCA I X10 /INTO INFO AREA
- CDF
- JMP FINDSV /LOOP
-LUBUF, CLA IAC
- CIF 10
- JMS I (200 /LOOKUP BASIC.UF
- 2
- BUFN /(USER DEFINED FUNCTIONS)
- 0
- JMP .+3 /OK IF NOT THERE
- TAD .-3 /GET STARTING BLOCK +1
- IAC
- CDF 10
- DCA I X10 /INTO INFO BLOCK
- CDF 0
- CIF 10
- JMS I (200
- 11 /USR OUT
-CHAIN, CDF 10
- TAD I (7607 /GET BRTS STARTING BLK
- CDF
- DCA I (BRTSST /INTO RTS READER
- JMP I (BINIT
-
-NAMLST, BRTSN
- BAFN
- BSFN
- BFFN
- 0
-BRTSN, FILENAME BRTS.SV
-BAFN, FILENAME BASIC.AF
-BSFN, FILENAME BASIC.SF
-BFFN, FILENAME BASIC.FF
-BUFN, FILENAME BASIC.UF
- CORE, 0
- TAD I (BIPCCL
- AND COR70
- CLL RAR
- RTR
- SZA /IS THERE A SYSTEM VALUE?
- JMP I CORE /YES: USE IT
-COR0, CDF
- TAD CORSIZ
- RTL
- RAL
- AND COR70
- TAD COREX
- DCA .+1
-COR1, CDF
- TAD I CORLOC
-COR2, NOP
- DCA COR1
- TAD COR2
- DCA I CORLOC
-COR70, 70
- TAD I CORLOC
-CORX, 7400
- TAD CORX
- TAD CORV
- SZA CLA
- JMP COREX
- TAD COR1
- DCA I CORLOC
- ISZ CORSIZ
- JMP COR0
-COREX, CDF
- CLA CMA /HI FIELD IS #FIELDS-1
- TAD CORSIZ
- JMP I CORE
-CORLOC, CORX
-CORV, 1400
-CORSIZ, 1
-
- PAGE
- GETRTS, 0 /READ BRTS INTO 0-6777
- TAD BRTS
- DCA BRTSBB
- JMS I (7607
- BRTSIZ
- 0
-BRTSBB, 0
-NOCORE, -1 /CAN'T GET THIS ERROR
- JMP I GETRTS
-BINIT, ISZ RTSFLG /NEED BRTS?
- JMP BRTSIN /GOT IT: START IT
- JMS I (7607
- BRTSIZ
- 0
-BRTSST, 0
-SR2, 20 /CAN'T GET THIS ERROR
-BRTSIN, AC7775 /TEST IF GENUINE 2 PAGE SYSTEM HANDLER
- TAD I (7612
- SZA CLA /SKP IF YES
- JMP PSADJ /ELSE SKIP CDF ADJUSTMENT
- TAD FLAGTD
- SNA CLA /IMAGE OK ON TD8E?
- JMS ERRORX /NO: DONT RUN IT
- TAD KEYLOC /GET NEW FIELD BITS
- AND (70
- DCA CDFTOP
-PTCHLP, TAD I PTCHPT /RANGE CHECK A WORD
- TAD (-6300
- CLL
- TAD (70
- SNL CLA /SKP IF CDF N0
- JMP NOPTCH
- TAD I PTCHPT /ISOLATE CDF INSTR
- AND (7707
- TAD CDFTOP
- DCA I PTCHPT /STORE IT BACK
-NOPTCH, ISZ PTCHPT
- JMP PTCHLP
- TAD KEYLOC
- DCA CDFTOP
-SWPLOOP,CDF 20
- TAD I TDCTR
- DCA GETRTS
-CDFTOP, CDF 70
- TAD I TDCTR
- DCA ERRORX
- TAD GETRTS
- DCA I TDCTR
- CDF 20
- TAD ERRORX
- DCA I TDCTR
- ISZ TDCTR
- JMP SWPLOOP
- CDF
-CCHEK, ISZ EKOUNT
- JMS I (CORE /HOW MUCH CORE DO WE HAVE?
- TAD NOCORE /HOW MUCH DO WE NEED?
- SPA CLA
- JMS ERRORX /INSUFFICIENT CORE
- TAD I SR1 /RESTORE KEY LOCATIONS
- DCA I SR2
- ISZ SR1
- ISZ SR2
- ISZ SR3
- JMP .-5
- TAD (JMP I FSTOP1 /PATCH CTRL/C LOCS
- DCA I (7600
- TAD (JMP I FSTOP1
- DCA I (7605
- TAD SWPINF /TELL BRTS OS/8 PG 17600 OUT NOW
- RAR
- STL RAL
- DCA SWPINF
- JMP I (BSTART /START BRTS
-PTCHPT, 7635
-
-ERRORX, 0
- CIF 10
- JMS I (7700
- 7
-EKOUNT, 1
- JMP I (7605
-
-EXEUIT, TAD RTSFLG
- SNA CLA /NEED BRTS?
- JMS GETRTS /YES: READ IT
- TAD (4207 /RESTORE ^C HOOKS
- DCA I (7600
- TAD (6213
- DCA I (7605
- JMP I (7600 /BACK TO OS8
-KEYLOC, ZBLOCK 12
-SR1, KEYLOC
-SR3, -12
-RTSFLG, -1 /0 MEANS BRTS IS IN CORE
-FLAGTD, 1 /1 IF TD8E IS OK AT RUNTIME
-PSADJ, TAD (4001
- AND KEYLOC+11
- TAD (2000
- DCA KEYLOC+11
- JMP CCHEK
-TDCTR, 7600
-
- PAGE
- $$$$$
-
DELETED src/os8-v3f/BOOT.PA
Index: src/os8-v3f/BOOT.PA
==================================================================
--- src/os8-v3f/BOOT.PA
+++ /dev/null
@@ -1,847 +0,0 @@
-/BOOT.PA 17
-/OS/8 V3D WITH RL01,RX02 AND VXA0 DEVICES
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /SR
-
-/FIXES MADE FOR MAINTENANCE RELEASE:
-
-/1. ADDED RX01 (FLOPPY BOOTSTRAP)
-/2. LEFT PATCH SPACE IN NAME TABLE
-
-/ 26-DEC-77
-
-/1. ADDED RL BOOTSTRAP (S.R.)
-
-
- *1
- HLT
- JMP I (7600
- *100
-
-INNER, 0
-OUTR, -20
-CODE, 0
-LENGTH, 0
- *200
-
-START, CLA /ALLOW BEING CHAINED TO
- TAD I (7600
- SPA CLA
- JMP OS8IN
- ISZ INNER
- JMP .-1
- ISZ OUTR
- JMP .-3
- JMS I (TESTRK
-COSIN, TAD I (7776
-COMN, CIA
- DCA CODE
- TAD (TABLE
- DCA PTR
-LOOP, TAD I PTR
- SNA
- JMP I (OS8
- TAD CODE
- SZA CLA
- JMP NXT
- IOF
- ISZ PTR
- TAD I PTR
- DCA OLDLOC
- ISZ PTR
- TAD I PTR
- DCA NEWLOC
- ISZ PTR
- TAD I PTR
- CIA
- DCA LENGTH
-XXLUP, TAD I OLDLOC
- DCA I NEWLOC
- ISZ OLDLOC
- ISZ NEWLOC
- ISZ LENGTH
- JMP XXLUP
- ISZ PTR
- TAD I PTR
- DCA TEMP
- TAD HLTSWT
- SNA CLA
- HLT
- CLL
- JMP I TEMP
-HLTSWT, 1
-
-NXT, TAD PTR
- TAD (5
- DCA PTR
- JMP LOOP
-
-OLDLOC, 0
-NEWLOC, 0
-PTR, 0
-SCAN, 0
-OS8IN, TAD I (7600
- TAD (-4207
- SZA CLA
- JMP I (RETRY
- TAD I (1000
- TAD (777
- SNA CLA
- TAD (600
- TAD (1000-1
- DCA SCAN
-SKAN, ISZ SCAN
- TAD I SCAN
- SNA
- JMP I (RETRY
- AND (177
- TAD (-"/!7600
- SZA CLA
- JMP SKAN
- ISZ SCAN
- TAD I SCAN
- AND (77
- CLL RTL
- RTL
- RTL
- DCA TEMP
- ISZ SCAN
- TAD I SCAN
- AND (77
- TAD TEMP
- DCA TEMP
- ISZ SCAN
- TAD I SCAN
- AND (177
- TAD (-".!7600
- DCA HLTSWT
- TAD TEMP
- JMP COMN
-
-TEMP, 0
- PAGE
-TABLE, 2403 /TC
- DECTAP
- 7554
- 25
- 7554
-
- 2213 /RK
-RKADR, RK8
- 21
- 11
- 21
-
- 2404 /TD
- TD8E
- 7277
- 34
- 7277
-
- 1424 /LT
- LINCTP
- 4400
- 7
- 4400
-
- 2206 /RF
- RF08
- 7746
- 7
- 7746
-
- 2024 /PT
- BINLDR
- 7626
- 152
- 7700
-
- 3205 /ZE
- ZERO
- 4
- 6
- 4
-
- 2431 /TY
- TYPSET
- 7730
- 42
- 7730
-
- 0414 /DL
- DIAL
- 4012
- 6
- 4012
-
- 0301 /CA
- CAS
- 4000
- 40
- 4000
-
- 0415 /DM
- DSKMON
- 171
- 16
- 174
-
- 2605 /VE
- VERS
- VERS
- 1
- VERS
-
- 0424 /DT
- TAPE
- TAPE
- 1
- TAPE
-
- 0413 /DK
- DISK
- DISK
- 1
- DISK
-
- 2205 /RE
- RK8E
- 21
- 11
- 21
-
- 2523 /US
- 1
- 1
- 1
- RETRY
-
- 2230 /RX
- RX01
- RX8E
- 42
- RXSTRT
-
- 2214 /RL
- RL01
- 1
- 35
- 1
-
- 2630 /VX
- VXA0
- 0
- 7
- 0
- ZBLOCK 3^5 /PATCH SPACE
-
- 0
-
-/FORMAT:
-
-/SIXBIT OF 2-CHARACTER NAME
-/ADDRESS OF BOOTSTRAP CODE IN BOOT
-/ADDRESS WHERE BOOTSTRAP CODE IS TO BE MOVED TO
-/LENGTH OF BOOTSTRAP IN WORDS
-/STARTING ADDRESS OF BOOTSTRAP
-DECTAP, 7600
- 6774
- 1374
- 6766
- 6771
- 5360
- 7240
- 1354
- 3773
- 1354
- 3772
- 1375
- 6766
- 5376
- 7754
- 7755
- 0600
- 0220
- 6771
- 5376
- RK8, 6732
- 6751
- 6745
- 5023
- 6742
- 6753
- 6755
- 6733
- 5031
-
-RK8E, 7000
- 7000
- 7000
- 7000
- 7201
- 6742
- 6742
- 6743
- 5031
-TD8E, 6007
- 1312
- 4312
- 4312
- 6773
- 5303
- 6777
- 3726
- 2326
- 5303
- 5732
- 2000
- 1300
- 6774
- 6771
- 5315
- 6776
- 0331
- 1327
- 7640
- 5315
- 2321
- 5712
- 7354
- 7756
- 7747
- 0077
- 7400
-LINCTP, 6141
- 1020
- 0020
- 0004
- 0700
- 0000
- 6020
-RF08, 6643
- 6615
- 7600
- 6603
- 6622
- 5352
- 5752
-/ 1000 IS OS/8 LINE BUUFFER
-/ 1600 IS PS/8 LINE BUFFERE
-
- *2000
-
-BINLDR, 0000
- 3212
- 4260
- 1300
- 7750
- 5237
- 2212
- 7040
- 5227
- 1212
- 7640
- 5230
- 1214
- 0274
- 1341
- 7510
- 2226
- 7750
- 5626
- 1214
- 0256
- 1257
- 3213
- 5230
- 0070
- 6201
- 0000
- 0000
- 6031
- 5262
- 6036
- 3214
- 1214
- 5660
- 6011
- 5270
- 6016
- 5265
- 0300
- 4343
- 7041
- 1215
- 7402
- 6032
- 6014
- 6214
- 1257
- 3213
- 7604
- 7700
- 1353
- 1352
- 3261
- 4226
- 5313
- 3215
- 1213
- 3336
- 1214
- 3376
- 4260
- 3355
- 4226
- 5275
- 4343
- 7420
- 5336
- 3216
- 1376
- 1355
- 1215
- 5315
- 0000
- 3616
- 2216
- 7600
- 5332
- 0000
- 1376
- 7106
- 7006
- 7006
- 1355
- 5743
- 5262
- 0006
- 0000
- 0000
- 6014
- 6011
- 5357
- 6016
- 7106
- 7006
- 7510
- 5374
- 7006
- 6011
- 5367
- 6016
- 7420
- 3776
- 3376
- 5357
- 0000
- 5301
-ZERO, 1005
- 3410
- 5004
- 5404
- 0011
- 2010
-DIAL, 6141
- 1020
- 0020
- 0004
- 0701
- 7300
-/ 7300
-/ 6002
-/ 6042
-/ 6022
-/ 6012
-/ 6032
-/ 6601
-/ 6764
-/ 1221
-/ 3010
-/ 1622
-/ 2222
-/ 7450
-/ 5620
-/ 3410
-/ 5212
-/ 7730
-/ 7727
-/ 0223
-TYPSET, 6774
- 1347
- 4341
- 7240
- 1353
- 3355
- 1352
- 4341
- 5753
- 7777
- 6766
- 3354
- 6771
- 5344
- 5741
- 4600
- 7777
- 7777
- 4220
- 7400
- 7777
- 7777
- 7777
- 6014
- 6011
- 5360
- 7106
- 6012
- 7420
- 5357
- 5756
- 4356
- 3373
- 4356
-VXA0, 7200
-1206
- 6200
- 6207
- 5605
- 0000
- 7000
-PTCLEV, "A
-L3, "5
-LV, "V
-VERS, TAD LV
- JMS I (PUT
- TAD L3
- JMS I (PUT
- TAD PTCLEV
- JMS I (PUT
- JMP I PRETRY
-PRETRY, RETRY
- DSKMON, 7577
- 7750
- 7751
- 1171
- 3572
- 1172
- 3573
- 6643
- 6615
- 6603
- 6602
- 5203
- 5606
- 7600
-CAS, 1237
- 1206
- 6704
- 6706
- 6703
- 5204
- 7264
- 6702
- 7610
- 3211
- 3636
- 1205
- 6704
- 6706
- 6701
- 5216
- 7002
- 7430
- 1636
- 7022
- 3636
- 7420
- 2236
- 2235
- 5215
- 7346
- 7002
- 3235
- 5201
- 7737
- 3557
- 7730
- LCD=6751
- SDN=6755
- SER=6754
- STR=6753
- XDR=6752
-
-RX01, RELOC 20
-RX8E,
-/ DEVICE IOT SYMBOLIC EQUATES
-/
-LCD=6751 /LOAD COMMAND
-XDR=6752 /TRANSFER DATA
-STR=6753 /SKIP IF READY TO TRANSFER
-SER=6754 /SKIP ON ERROR
-SDN=6755 /SKIP ON DONE
-/
-/
-/
-/
-READ, TAD UNIT /TRY NEXT COMBINATION OF DENSITY AND UNIT
- TAD CON360 /ADDING IN 360
- AND CON420 /KEEPING ONLY 420 BITS
- DCA UNIT /CYCLES 400,420,0,20,400,,,,,,,,
- CLL CLA CML IAC RTL /COMMAND TO READ DISK - MUST BE ON OMNIBUS!
- TAD UNIT /UNIT AND DENSITY
- LCD /COMMAND TO CONTROLLER
- CLL CLA IAC /TO SET SECTOR AND TRACK TO 1
- JMS LOAD /SECTOR TO CONTROLLER, LEAVES AC ALONE
- JMS LOAD /AND TRACK
-LITRAL, 7004 /LEAVING A 2 IN AC; SERVES AS LITERAL
-/
-/ FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
-/
-RXSTRT,
-XSTRT, SDN /HAS DONE COME UP; CODE STARTS HERE!
- JMP LOAD+1 /NO, GO CHECK FOR READY TO TRANSFER
-/
-/ NOW, DONE OR ERROR
-/
- SER /SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
- SNA /NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
- JMP READ /START-UP, GO SET UP UNIT, THEN READ TO SILO
- TAD UNIT /AC ALREADY 2, PUT IN UNIT, DENSITY
- LCD /TO EMPTY THE SILO
- TAD UNIT /SET UP LOC 60 FOR OLD SECONDARY BOOT
- AND CON360 /KEEPING UNLY DENSITY BIT
- TAD LITRAL /ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
- DCA RX1SAV /OLD SECONDARY BOOT MOVES IT TO HANDLER
-CON360, 360 /LITERAL; EXECUTES IN LINE AS A NO-OP
-/ /FALLS THRU TO NEXT PAGE OF LISTING
-/
-/
-/ FOLLOWING CODE SAME AS OLD PRIMARY BOOT
-/
- JMS LOAD /GRAB NEXT ITEM FROM SILO
- DCA 2 /TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
- ISZ 50 /INCREMENT LOAD ADDRESS
- JMP 47 /GO BACK FOR ANOTHER
-/
-/ SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
-/ THEN CONTROL PASSES TO SECONDARY BOOT
-/
-LOAD, 0 /SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
- STR /IS HE READY TO TALK TO US?
- JMP XSTRT /NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
- XDR /YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
- JMP I LOAD /NO MAGIC, JUST EXIT FROM SUBROUTINE
-/
-/ 60 GOES TO OLD SECONDARY BOOT
-/ 61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
-/
-/
-CON420, /USE IT TO HOLD 420 LITERAL TO START OUT
-RX1SAV, 420 /UNIT^20+7004 TO GO TO SYS HANDLER
-UNIT, 20 /<DENSITY^400>+<UNIT^20> THAT BOOTED OK
-/
-
- RELOC
- PAGE
-L2213, 2213
- DIML=6615
-DISK, CLA IAC
- DIML
- SNA CLA
- JMP GOTRF
- TAD (70
- 6732
- SNA CLA
- JMP GOTRK8
- CLA IAC
- 6744
- SZA CLA
- JMP I PRETR
- STA /RE
-GOTRF, TAD L2206 /RF
- JMP I PCOMN
-L2206, 2206
-GOTRK8, TAD L2213 /RK
- JMP I PCOMN
-PRETR, RETRY
-TAPE, 6141 /LINC
- 17 /COMPL AC
- 2 /PDP
- IAC
- SNA CLA
- JMP GOTLTA
- TAD (70
- 6774
- CLA
- 6772
- NOP
- TAD M70
- SNA CLA
- JMP GOTTC
- STL CLA RAR
- 6774
- CLA
- 6776
- SMA CLA
- JMP I PRETR
-GOTTD, CLA IAC
-GOTTC, TAD L2403 /TC
- JMP I PCOMN
-GOTLTA, TAD L1424 /LT
- JMP I PCOMN
-L1424, 1424
-L2403, 2403
-PCOMN, COMN
-M70, -70
-/ 0000
-CRLF, 0
- TAD L215
- JMS PUT
- TAD L212
- JMS PUT
- JMP I CRLF
-
-L215, 215
-L212, 212
-
-PUT, 0
- TLS
- TSF
- JMP .-1
- CLA
- JMP I PUT
-
-GET, 0
- KSF
- JMP .-1
- KRB
- AND (177
- TLS
- TSF
- JMP .-1
- TAD (-003
- SNA
- JMP I (7605
- TAD (003-177
- SNA
- JMP I (RETRY
- TAD (177-015
- SNA
- ISZ GET
- TAD (015
- AND (77
- JMP I GET
-
-TESTRK, 0
- TAD (70
- 6732
- SNA CLA
- JMP I TESTRK
-RK05, TAD (RK8E
- DCA I (RKADR
- JMP I TESTRK
- PAGE
-OS8, TAD ("N
- JMS I (PUT
- TAD ("O
- JMS I (PUT
- CLA IAC
- DCA I (HLTSWT
-RETRY, JMS I (CRLF
- TAD ("/
- JMS I (PUT
- JMS I (GET
- SKP
- JMP RETRY
- CLL RTL
- RTL
- RTL
- DCA I (TEMP
- JMS I (GET
- SKP
- JMP RETRY
- TAD I (TEMP
- DCA I (TEMP
- JMS I (GET
- JMP .-1
- CLA
- JMS I (CRLF
- TAD I (TEMP
- JMP I (COMN
-RL01, 6600
- 7201
- 4027
- 1004
- 4027
- 6615
- 7002
- 7012
- 6615
- 0025
- 7004
- 6603
- 7325
- 4027
- 7332
- 6605
- 1026
- 6607
- 7327
- 4027
- 0377
- 7600
- 0000
- 6604
- 6601
- 5031
- 6617
- 5427
- 5001
- PAGE
- FIELD 0
- *200
- $
-
DELETED src/os8-v3f/BPAT.PA
Index: src/os8-v3f/BPAT.PA
==================================================================
--- src/os8-v3f/BPAT.PA
+++ /dev/null
@@ -1,35 +0,0 @@
-/1 RL01 PATCH FOR BRTS
-
- *1345
-HFIX, 0
- CLL STA RTL /AC7775
- TAD I H7612
- SZA CLA /SKP IF 2 PAGE HANDLER
- JMP I HFIX /ELSE EXIT NOW
-FIXLUP, TAD I FIXPTR /GET A WORD FROM HANDLER
- TAD M6300
- CLL /RANGE CHECK FOR CIF/CDF N0
- TAD H70
- SNL CLA /SKP IF CDF OR CIF
- JMP NOFIX /ELSE DON'T FIX IT
- TAD I FIXPTR /GET INSTRUCTION
- AND H7707 /ZERO FIELD BITS
- TAD H20 /PUT BACK FIELD 2
- DCA I FIXPTR /STORE INSTRUCTION BACK
-NOFIX, ISZ FIXPTR
- JMP FIXLUP
- JMP I HFIX /--RETURN--
-FIXPTR, 7635
-H20, 20
-H70, 70
-H7612, 7612
-H7707, 7707
-M6300, -6300
-
- FIELD 1
- *4526
-PSWP2P, 0
- *4543
- JMS I PHFIX
- JMP I PSWP2P
-PHFIX, HFIX
DELETED src/os8-v3f/BUILD.PA
Index: src/os8-v3f/BUILD.PA
==================================================================
--- src/os8-v3f/BUILD.PA
+++ /dev/null
@@ -1,3751 +0,0 @@
-/33 OS/8 V3D BUILD
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /ABSTRACT--
-/BUILD IS THE SYSTEM CONFIGURATOR FOR THE OS/8 PROGRAMMING
-/SYSTEM. WITH BUILD, THE DEVICES WITHIN A PARTICULAR
-/SYSTEM CAN BE RAPIDLY AND EASILY CHANGED. BUILD ALSO
-/PROVIDES THE FACILITY FOR CREATING AN INITIAL OS/8 SYSTEM
-/FROM BINARY PAPER TAPES OR CASSETTES.
-
-/V3 CHANGES
-
-/0. MADE BUILD SUPPORTABLE
-/1. ADDED VE COMMAND (CURRENT VERSION # IS 3X WHERE X IS PATCH LEVEL)
-/2. FIXED PROBLEM WITH Z'S AND 9'S IN FILENAMES
-/3. CHANGED LENGTH OF DF32
-/4. FIXED PROBLEM WITH RK8 BOOTSTRAP RECORD.
-/5. ON LOAD, NULL EXTENSION FIRST SEARCHES FOR .BN
-/6. CR TO $ DOESN'T GIVE ERROR
-/7. FIXED BUG WITH BUILDING ROM SYS
-/8. RUBOUTS TO BOL GIVE $
-/9. ^U RETYPES $
-/10. ASSUME DSK: IF NO DEV GIVEN WITH LOAD
-/11. NO DOT IS PRINTED IF NO EXTENSION
-/12. ^O STUFF NEW
-/13. ALLOW PARITY ^C
-/14. ADDED EXAMINE COMMAND
-/15. FIXED BUG RE ACCESSING USR TABLE VIA POINTER
-/16. CLEANED UP MOVE ROUTINE
-/17. CLEANED UP NUMBER TOO BIG CHECKER
-/18. OVERFLOW ERROR MESSAGE CHANGED TO 'BAD ORIGIN'
-/19. DON'T ALLOW NAMES OVER 6 CHARS TO SPILL INTO EXTENSION;
-/ DON'T ALLOW MULTIPLE EXTENSIONS
-/20. INCREASED NUMBER OF ALLOWABLE ENTRY PTS/HANDLER TO 16 (DEC)
-/21. CLEANED UP SYMBOL PRINT ROUTINE
-/22. GOT NAMES IN TABLE TO LINE UP.
-/23. INSERT GRPNAME <CR> INSERTS FIRST HANDLER
-/24. INSERT GRP,DEV1,DEV2,DEV3,...
-/25. INSERT GRP,DEV1-5,...
-/26. SAME FOR DELETE AND REPLACE
-/27. COUNT DEVICES AND SLOTS ONLY ON BOOT
-/28. FIXED BUG RE SYS RF08=4023
-/29. GENERAL SUPPORT OF 2-PAGE SYS HANDLERS
-/30. ADDED QL COMMAND
-/31. SETS SA=00200, JSW=0
-/32. UNLOAD UNLOADS AND DELETES
-/33. ADDED DSK COMMAND
-/34. BUILD COMMAND
-/35. PRINT TELLS YOU ABOUT DSK
-/36. TOOK OUT LOC DEPENDENT CHECK FOR SYSTEM HANDLERS
-/37. INSERT ALLOWS SETTING # OF PLATTERS
-/38. HANDLER HEADER LOADS DIRECTLY INTO DESCRIPTOR TABLE
-/39. USES EXTRA CORE IF AVAILABLE (ALSO CHECKS SOFTWARE CORE SIZE)
-/40. STOPS ECHOING ON INPUT LINE OVERFLOW
-/41. *'S SYSTEM DEVICE
-/42. REMEMBERS SYS ACROSS A BOOT
-/43. 'Y' INSTEAD OF 'YE'
-/44. BO CHECKS DCB IN CORE TO SEE IF NEED REWRITE MONITOR
-/45. ALLOW UNLOADING ENTRY POINT NAMES
-/46. CTL COMMAND
-/47. EACH COMMAND HAS ITS OWN MAXIMUM INPUT LINE SIZE
-/48. ADDED CORE COMMAND
-/49. FIXED ^U TO WRITE ZERO DIRECT MSG BUG
-/50. HIT CONTINUE AFTER 'SYS ERR' TO RETRY
-/51. PRESERVED DATE ACROSS BOOT
-/52. MULTIPLE LOADS AND UNLOADS
-/53. LOAD FROM SCRATCH USES INTERNAL ACTIVE HANDLERS
-/54. CASSETTE SUPPORT
-/55. SETS CORE CONTROL BLOCK
-
-/CHANGES SINCE FIELD RELEASE
-
-/A 'NO ROOM' DOESN'T PRINT 'BAD LOAD'
-/B NO. OF ENTRY POINTS NOW CORRECTLY CHECKED FOR
-/C FIXED BUG RE BUILDING TD8E FROM TD8E
-/D BOOT CMD DISABLES BUILD CMD
-/E JSW SET TO 1 BEFORE CHAINING TO ABSLDR
-/F P CMD BUG FIXED
-/G ALTER BUG FIXED
-/H LENGTH OF INPUT LINE SYMBOLIC
-/I SOFCOR STUFF OPTIMIZED
-/J QL DOESN'T PRINT SPACE BETWEEN SYS'S GRP:NAME
-/K FIXED BUG IN 32K
-/L PAPER TAPE PUTS HLT IN 7600
-
-/THINGS TO DO:
-
-/? DIES IF DATA OCCURS BEFORE *0
-/? BOOT.ZE, .NZ CMD?
-/? GET 2-PAGE BIT OF CURRENT SYSTEM
-
-/CHANGES FOR MAINTENANCE RELEASE V3C:
-
-/ 7-AUG-75
-
-/1. CHANGED VERSION NUMBER TO V5
-/2. INCORPORATED PATCH SEQ #1 (DSN APRIL 1975)
-/ ZERO LOCATION SOFSET WHILE BUILDING
-/3. INCORPORATED PATCH SEQ #2 (DSN NOV. 1974)
-/ DISMISS USR AFTER ?NAME ERROR
-/4. INCORPORATED PATCH SEQ #3 (DSN MARCH 1975)
-/ DECREASE SYSTEM SIZE BY 5 (FOR ABSLDR) WHEN BUILDING FROM PAPER TAPE
-/5. INCORPORATED PATCH SEQ #4 (DSN APRIL 1975)
-/ ADDED 'SIZE' COMMAND TO BUILD
-/6. FIXED BUG WHICH CAUSES SYSXY.RS NOT FOUND TO BE PRINTED
-/ ON BOOTXY.RS COMMAND
-
-/CHANGES FOR V3D:
-
-/ 1-MAY-77
-
-/1. FIXED PROBLEM WITH CASSETTE BUILD (JSW WAS SET WRONG)
-/2. ALLOWED SAVING OF HIGH-ORDER DATE BITS
- /BUILD PAGE 0
- *1
- HLT /SAFETY HALT AND PATCH SPACE
-SAV1, 0
-SAV2, 0 /SAVES GROUP NAME
- /POINTER TO BATCH ROUTINE (GROSS BUT NEEDED THE ROOM)
-BATT, BATTST /AGAIN GROSS BUT WHAT CAN I SAY?
- *10 /AUTO INDEX REGISTERS
-XR1, 0 /GENERAL PURPOSE REGISTERS
-XR2, 0
-XR3, 0
-XR4, 0 /USED TO BUILD IMAGE TABLES
-XR5, 0
-LXR, 0
-GNMXR, 0
-L600, 600
-
- *20
-COUNT, 0 /GENERAL COUNTER LOCATION
-CHAR, 0 /CHARACTER BUFFER
-TEMP, 0 /TEMPORARIES
-TMP1, 0
-
-
- BUFFER=5400
- BINARY=6000
- DEVBUF=0400 /FIRST HANDLER AT 10400
- /FOR REASONS TOO LONG TO GO INTO HERE,
- /BUT WHICH HAVE TO DO WITH CURIOUS
- /PROPERTIES OF THE NUMBER 0,
- /HANDLERS CAN'T START AT 0.
- /THEY COULD HAVE STARTED AT 200.
- SOFSET=7747 /SYSTEM OFFSET. (CURRENTLY =0)
- PG7600=BUFFER /RECORD 0 (IMAGES OF BOTH 7600'S)
-
- LDRCTL=4113 /CHECK OS/8 ASSEMBLY
-NAME1, 0 /NAME1-4 HOLDS FILE AND DEVICE NAMES
-NAME2, 0
-NAME3, 0
-NAME4, 0
-TABLMT, DSCTAB /HIGH CORE END OF DESCRIPTORS
- /FIRST FREE LOCATION
-SIZE, 0
-HNDPTR, DEVBUF /POINTS TO FIRST FREE LOCATION IN HANDLER TABLE
-
- BLDSAV=76 /**** WILL DESTROY PREVIOUS FILES
- /START OF 40 BLOCK TO SAVE BUILD IN
- HDRSIZ=10 /NUMBER OF ITEMS IN A DESCRIPTOR
-DSCPTR, DSCTAB /ALWAYS POINTS TO BEGIN OF CURRENT DESCRIPTOR
- SLOT, 0
-DSKG1, 0 /NAME OF 'DSK'
-DSKG2, 0
-DSKP1, 0
-DSKP2, 0
-NEWPAG, 0
-OLDPAG, 0
-NEWCOR, 0 /NEW CORE MAX
-SAVDAT, 0 /REMEMBERS DATE ACROSS A BOOT
- DATEWD=7666
-FLAG2, 1 /0 IF PREVIOUS SYSTEM HAD A 2-PAGE HANDLER
-/SAMSYS, 1 /0 IF DIDN'T SPECIFY NEW SYS
- BLOK66=0
-SYSDCB, 0
- SA=7744
- JSW=7746
-/BOOTDV, 0 /HANDLER ADDRESS OF DEVICE WE'RE BOOTSTRAPPING TO
-SAVHID, 0 /HIGH-ORDER DATE (BITS 3-4)
- /BEGLIN: 72 CHAR LINE BUFFER
-
-/NEW BUILD CORE ALLOCATION:
-
-/0000-5177 BUILD (ABSLD MUST BE ABOVE 4177)
-/5400-5777 DEVICE HANDLER FOR LOAD
-/5200-5377 PAPER TAPE/INIT/LINE BUFFER
-/6000-6377 INPUT BUFFER FOR LOAD (TEMP LOC OF USR)
-/6400-7577 DESCRIPTOR TABLE (DSCTAB)
-
-/BINARY MUST FOLLOW BUFFER
-/FIELD 1: HANDLERS (0400-7577)
-/10000-10377 BLOK66 BUFFER
- *200
-
- SKP CLA /ENTRY FROM 'R BUILD'
- HLT /CHAIN ENTRY ADDRESS
- TAD I [7600 /SEE IF SYSTEM ALREADY EXISTS
- CIA
- TAD [4207
- SZA CLA /IF NOT, BUILD SYSTEM FROM PAPER TAPE
- CLA IAC /NOTE FACT THAT OS/8 AINT AROUND
- DCA I [RETSW
- JMS I (CORE
- DCA I (AMTCOR /FIGURE OUT HOW MUCH CORE WE HAVE
- JMS I (GOOD /DO SOME INITIALIZATION; IT'LL DO YA GOOD
- TAD (BATLS-1 /SET POINTER FOR BATCH OVERLAY
- JMS I (BATTST /GO CHECK FOR CALL FROM BATCH
-CONFIG, CDF 0
- DCA I (ECHOFLG /ALLOW TYPING
- JMS I [CRLF
-DOLR, TAD ["$ /OUTPUT A $ BECAUSE I'M JEWISH
- JMS I [TTYOUT
- DCA I [SWAPER /USE CURRENT HANDLER, NO SWAP ON ^C.
- TAD [-LNLNGT
- JMS I [GTEXT /READ TTY LINE
- JMP DOLR
- JMS I [GNAME /INTERPRET THE COMMAND
- TAD NAME1
- SNA
- JMP CONFIG
- DCA CHAR /ENABLE TEST TO WORK
- JMS I [TEST /LOOK FOR THE COMMAND IN LIST
- -1417;LOAD /LOAD DEVICE HANDLER BINARY
- -2205;REPLACE /REPLACE IN SYSTEM
- -1601;NAME /ALTER PERMANENT NAME
- -0114;ALTER /CHANGE DEVICE HANDLER LOCATION
- -2022;PRINT /SYSTEM STATUS
- -2331;SYSTEM /SPECIFY SYSTEM DEVICE
- -0217;BOOT /BOOTSTRAP THE NEW SYSTEM
- -2516;UNLOAD /DELETE INACTIVE HANDLER
- -0405;DELETE /DELETE ACTIVE HANDLER
- -1116;INSERT /INSERT HANDLER IN SYSTEM
- -2605;VERS /TYPE VERSION #
- -0530;EXAMINE /EXAMINE LOCATION
- -2114;QLIST /QUICK LIST
- -0423;DSK /DSK
- -0317;KORE /CORE
- -0403;DCBCM /DCB
- -0324;CTLCM /CTL
- -2311;SIZCM /SIZE
- -0516;END /END COMMAND FOR BATCH
-BD, -0225;BUILD /BUILD
- 0 /MUST TERMINATE LIST WITH 0
- JMP I [WHAT /DIDN'T FIND COMMAND
-
-/NEW HEADER BLOCK:
-
-/ DEVICE GROUPNAME
-/ DEVICE PERMANENT NAME
-/ DCB (R/W,TYPE,MAX # OF PLATTERS)
-/ 1/2 PAGE, SYSTEM BIT, CORES BIT, REL ENTRY PT
-/ MUST BE 0
-/ SIZE OF 1 PLATTER
- CORSIZ,
-GETCHA, 0
- TAD DSCPTR
- TAD I GETCHA
- ISZ GETCHA
- DCA GETEM
- TAD I GETEM
- JMP I GETCHA
-
-/GOTCHA SUBROUTINE MOVED FOR ROOM
-
- PUT=JMS I [GOTCHA
- GET=JMS I [GETCHA
-
-
-BATTST, 0 /SUBROUTINE TO SEE IF CALLED FROM BATCH
- DCA XR1 /POINTER TO OVERLAY CODE IN FIELD 2
- TAD I [7777 /GET THE BATCH SWITCH (JMP BATBK IF IN BATCH)
- RAL /BIT 1
- SMA CLA /IF NO BATCH MAY NOT HAVE FIELD 2
- JMP I BATTST /NOT CALLED FROM BATCH
-BATBK, CIF 20 /NOW TO FIELD 2
- JMS I (BATSET /GO DO SOME OVERLAYS
- JMP I BATTST /RETURN TO CALLER
- GETEM, /POINTS INTO DSCTAB
-RELCOR, 0
- CLA IAC
- DCA CORSIZ /MAKE RE-USABLE
- TAD [7400
- DCA CORX /MAKE ROUTINE REUSABLE ON 32K MACHINE
-COR0, CDF 0
- TAD CORSIZ
- RTL
- RAL
- AND COR70
- TAD COREX
- DCA .+1
-COR1, CDF /N
- TAD I CORLOC
-COR2, NOP
- DCA COR1
- TAD COR2
- DCA I CORLOC
-COR70, 70
- TAD I CORLOC
-CORX, 7400
- TAD CORX
- TAD CORV
- SZA CLA
- JMP COREX
- TAD COR1
- DCA I CORLOC
- ISZ CORSIZ
- JMP COR0
-COREX, CDF 0
- STA
- TAD CORSIZ
- JMP I RELCOR /LEAVE WITH HIGHEST EXISTENT BANK
-
-CORLOC, CORX
-CORV, 1400
- PAGE
- /GET GETS DESCRIPTOR ITEM FROM CURRENT DESCRIPTOR
-/OP
-
-/PUT PUTS DESCRIPTOR ITEM IN AC BACK IN SPECIFIED ITEM
-/OP IN CURRENT DESCRIPTOR
-
-/ITEMS:
-
-/ACTIVE BIT 0=1 MEANS ENTRY POINT HAS BEEN INSERTED (IS ACTIVE)
-/PERM1 PERMANENT NAME (FIRST 2 CHARS)
-/PERM2 2ND 2 CHARS
-/TWOPAG BIT 0=1 MEANS 2-PAGE HANDLER, BIT 4 IGNORED, BITS 5-11 RELATIVE ENTRY POINT
-/PAGRES BITS 7-11 GIVE PAGE OF START OF HANDLER WHEN ROTATED 6 RT
-/GRPNM1 GROUP NAME (DEVICE NAME) FIRST 2 CHARS
-/GRPNM2 2ND 2 CHARS
-/DEVSIZ GIVES SIZE OF 1 PLATTER
-/PLATNUM # OF PLATTERS IN BITS 2-4
-/DSKBIT BIT 1 IS FLAG FOR 'DSK' (USED TEMPORARILY BY BUILD)
-/MAXPLT MAXIMUM NUMBER OF PLATTERS ALLOWED (IN BITS 9-11)
-/DCB D.C.B. BIT 0: FILESTRUCTURED, BITS 3-8 DEVICE TYPE
-/ BITS 9-11 MAX NO. OF PLATTERS
-/CORES BIT 2 MEANS ENTRY PT IS CORESIDENT WITH SYS HANDLER
-/SYSBIT BIT 1 IS A 1 IF THE DEVICE HAS NAME 'SYS' AND IS A SYS DEVICE
-
-/IF FIRST ENTRY OF A DESCRIPTOR IS GE 7600, THEN THIS
-/ENTRY IS A BOOTSTRAP ENTRY.
-/IT STARTS WITH THE NEGATIVE OF THE NUMBER OF WORDS IN THE
-/BOOTSTRAP (FOR THE PRECEDING DEVICE), FOLLOWED BY THAT MANY WORDS
- GRPNM1=0
- GRPNM2=1
- PRMNM1=2
- PRMNM2=3
- DCB=4
- MAXPLT=4
- DVTYPE=4
- TWOPAG=5 /BIT 0
- SYSBIT=5 /BIT 1
- ACTIVE=6
- ENTPT=5
- PAGRES=6
- PLATNUM=6
- DEVSIZ=7
- DSKBIT=6 /BIT 1
- CORES=5 /BIT 2
- /READ A LINE OF TEXT RETURN 1 IS ^U RETURN
-GTEXT, 0 /ROUTINE TO COLLECT TTY INPUT
- TAD (-BEGLIN /AC IS NON-ZERO
- DCA ENDLIN
- DCA I (RUBFLG /INITIALIZE RUBOUT TO \
- TAD (BEGLIN-1
-RDTX, DCA LXR /BUFFER ADD. TO INDEX
-RDTXT, JMS I [TTYIN /READ BLOODY TELETYPE
- TAD CHAR
- DCA NAME1 /SETUP FOR TEST AGAIN
- JMS I [TEST
- -377;RBOUT /RUBOUT
-LFMOD, -212;LFEED /LINE FEED..ECHO CURRENT COMMAND
- -215;CARRET /LINE TERMINATOR
- -233;ALTMOD /ALT MODE IN SEVERAL FLAVORS
- -375;ALTMOD
- -376;ALTMOD
- -200;RDTXT /IGNORE BLANKS
- -217;RDTXT /AS WELL AS ^O
- -203;CTRLC /BACK TO CURRENT SYSTEM
- -225;CTRLU /CTRLU
- 0 /IF NOT ONE OF THESE, PUT IN BUFFER
- TAD LXR
- TAD ENDLIN
- SNA CLA
- JMP RDTXT /LINE OVERFLOW, STOP ECHOING
- JMS I [PRNT /PRINT THE CHARACTER
- TAD CHAR
- DCA I LXR /AND PUT IN LINE BUFFER
- JMP RDTXT /NO PROBLEMS YET
- RBOUT, TAD LXR /IS THERE TEXT TO RUB OUT?
- TAD [1-BEGLIN
- SNA CLA
- JMP RBCR /NO..SO DON'T DO ANYTHING
- TAD ["\ /YES..ECHO BACKSLASH?
- ISZ I (RUBFLG /IF = -1, NO
- JMS I [TTYOUT
- CLA CMA /IGNORE CONSECUTIVE RUBOUTS
- DCA I (RUBFLG
- TAD LXR
- DCA TMP1
- TAD I TMP1
- JMS I [TTYOUT /ECHO LAST CHAR
-XRBACK, CLA CMA
- TAD LXR /MOVE INDEX BACK ONE
- JMP RDTX
-CARRET, JMS I [CRLF /GENERATE 215,212
-CAR1, DCA I LXR
- DCA I LXR /GUARD AGAINS CMD <CR>
- TAD [BEGLIN-1
- DCA GNMXR /SETUP FOR GNAME ROUTINE
- ISZ GTEXT /TAKE NORMAL RETURN
- JMP I GTEXT
-
-LFEED, DCA I LXR /A 0 TO MARK END
- TAD [BEGLIN-1
- DCA LXR
- JMS I [CRLF
- TAD ["$
- JMS I [TTYOUT
-ECHO, TAD I LXR
- SNA /DONE ECHOING?
- JMP XRBACK /YES..REPOSITION LXR
- JMS I [TTYOUT
- JMP ECHO
-
-ALTMOD, TAD ["$ /ALT MODE ECHOES AS $
- JMS I [TTYOUT
- JMP CAR1
-
-CTRLU, TAD ["^
- JMS I [TTYOUT /GENERATE ^U
- TAD NAME1
- TAD [100
- JMS I [TTYOUT
-RBCR, JMS I [CRLF
- JMP I GTEXT /TAKE ERROR RETURN
- GETCHR=JMS I [GETC
- BAKCHR=JMS I [BAKC
-
-ENDLIN,
-GETNUM, 0 /PICKS UP NUMBER FROM LINE BUFF
- /DELIM CHAR PUT IN 'CHAR'
- /PRINTS ERROR MESSAGE IF GT 4095
- /IF NO NUMBER, TAKES RETURN 1
- /IF NUMBER, TAKES RET 2 WITH # IN 'SIZE'
- DCA SIZE
- DCA GOTSW /HAVEN'T FOUND ANY DIGITS YET
- JMP NCHAR
-ROT, DCA TMP1
- ISZ GOTSW /FOUND A DIGIT
- TAD SIZE
- AND [7000
- SZA CLA
- JMP I [BADARG /NUMBER .GT. 4095
- TAD SIZE
- CLL RTL
- RAL /BUILD UP THE DIGIT
- TAD TMP1
- DCA SIZE
-NCHAR, GETCHR
- SNA /0 ENDS THE LINE
- JMP NUMOUT
- TAD [-240 /IGNORE SPACES
- SNA
- JMP NCHAR
- TAD (-30 /TEST LIMITS
- CLL
- TAD [10 /MUST BE BETWEEN 0 AND 7
- SZL
- JMP ROT
- TAD (260 /RESTORE CHAR
-NUMOUT, DCA CHAR /SAVE AWAY THIS DELIMETER
- TAD GOTSW /DID WE GET ANY DIGITS?
- SZA CLA /?
- ISZ GETNUM /YES
- JMP I GETNUM /NO, RETURN
- GETC, 0 /GET THE NEXT CHARACTER, ADVANCE SCAN PAST IT
- TAD I GNMXR
- JMP I GETC
-
-GOTSW, /1 MEANS GOT A DIGIT
-BAKC, 0 /BACK UP SCAN TO THE CHARACTER JUST LOOKED AT
- STA
- TAD GNMXR
- DCA GNMXR
- JMP I BAKC
- PAGE
- INIT=JMS I [INI
- ADVDSC=JMS I [DSCADV
- ADVBOT=JMS I [BOTADV
-
-/ JMS PRMNAM /SEARCH TABLE FOR A PERMANENT NAME
- /GIVEN IN NAME1-NAME2
- /POINT TO DESCRIPTOR FOR THIS NAME
-/ JMS ACTNAM /SAME BUT PERMANENT NAME MUST BE ACTIVE
-/ JMS BIGNAM /SEARCHES FOR PERM & GRP NAME (GRP NAME IN SAV1,SAV2)
-/ JMS GRPNAM /SAME BUT SEARCH FOR GROUP NAME
-
-CHKNAM, 0
- INIT
-CHKLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
- ADVBOT /ADVANCE OVER ANY BOOTSTRAP
- JMP NFOUND /NO MORE- ERROR
- GET
-NM1, GRPNM1 /GET GROUP OR PERMANENT NAME
- CIA
- TAD NAME1
- SZA CLA /DO FIRST WORDS MATCH?
- JMP CHKLUP /NO, TRY AGAIN
- GET
-NM2, GRPNM2 /GET 2ND WORD
- CIA
- TAD NAME2
- SZA CLA /2ND WORD MATCH?
- JMP CHKLUP /NO
- TAD BIGFLG
- SNA CLA /WANT BOTH GROUP AND PERM NAME?
- JMP NOBIG /NO
- GET /YES
- GRPNM1
- CIA
- TAD SAV1
- SZA CLA
- JMP CHKLUP
- GET
- GRPNM2
- CIA
- TAD SAV2
- SZA CLA
- JMP CHKLUP
-NOBIG, TAD ACTSW /FOUND MATCH
- SNA CLA /MUST HANDLER BE ACTIVE?
- JMP I CHKNAM /NO, RETURN
- GET /YES
- ACTIVE
- SMA CLA /IS IT ACTIVE?
- JMP CHKLUP /NO, TRY AGAIN
- JMP I CHKNAM /YES, RETURN
- GRPNAM, 0
- TAD (GRPNM1 /WANT TO SEARCH FOR GROUP NAME
- DCA NM1
- TAD (GRPNM2
- DCA NM2
- DCA ACTSW /NEED NOT BE ACTIVE
- DCA BIGFLG
- JMS CHKNAM /GO SEARCH
- JMP I GRPNAM
-
-ACTSW, 0 /1 MEANS HANDLER MUST BE ACTIVE
-
-PRMNAM, 0
- DCA ACTSW /AC MAY BE NON ZERO (TO MEAN ACTIVE ONLY)
- TAD (PRMNM1 /WANT TO SEARCH FOR PERMANENT NAME
- DCA NM1
- TAD (PRMNM2
- DCA NM2
- DCA BIGFLG
- JMS CHKNAM /GO SEARCH
- JMP I PRMNAM
-
-BADLOD, JMS I [CRLF
- JMS I [PRWD
- TEXT /?BAD LOAD/
- DCA I TABLMT /RESTORE SENTINEL 0
- JMP I [CONFIG
-
-BIGNAM, 0
- DCA ACTSW
- TAD (PRMNM1
- DCA NM1
- TAD (PRMNM2
- DCA NM2
- CLA IAC
- DCA BIGFLG
- JMS CHKNAM
- JMP I BIGNAM
-
-/SOMETIMES CHKNAM CAME FROM DSKASK INSTEAD OF GETSYS ****
-
-BIGFLG, 0 /SET TO 1 TO CHECK GROUP & PERMANENT NAME
- NFOUND, JMS I [PRNAME
- JMS I [PRWD
- TEXT / NOT FOUND/
- JMP I [CONFIG
-
-NOROOM, JMS I [PRWD
- TEXT /?NO ROOM/
- DCA I TABLMT /RESTORE SENTINEL 0
- JMP I [CONFIG
-
-VERS, JMS I [PRWD
- TEXT /BUILD V6A/
- JMP I [CONFIG
-
-/BUILD CORE CONTROL BLOCK
-/ ***** CAUTION IF BUILD GROWS FROM FIELD 2
-
-BLDCCB, -3 /3 SEGMENTS
- 6203 /FIELD 0
- 0200 /200 IS S.A.
- 0000 /JSW
- 0000
- 1020 /20000-21777
- 0000 /10000-17577
- 3710
- 0000 /00000-07577
- 3700
-/GOES INTO WORDS 200-377 OF BLOCK 37
- PAGE
- /LOAD A 1- OR 2-PAGE HANDLER INTO BUFFER
-/USE IT TO ABSLD
-
-SETUP, 0
- TAD [NAME1
- DCA FILPTR /POINT TO FILENAME AREA
- TAD (BUFFER+1 /LOAD 2 PAGE HANDLER INTO 'BUFFER'
- DCA DRIVER /SET UP ASSIGN DEVICE HANDLER
- JMS I [GNAME /GET DEVICE NAME
- TAD NAME1
- SNA CLA
- JMP I SETUP /NO ARG
- ISZ SETUP
- TAD I (RETSW
- SZA CLA
- JMP I (BLDLOD /WHEN LOADING STANDALONE, USE INTERNAL HANDLERS
- TAD CHAR
- TAD [-":
- SZA CLA
- JMP I (SETDSK /USE 'DSK ' IF NO DEVICE GIVEN
- TAD NAME1
- DCA DVNM1
- TAD NAME2
- DCA DVNM1+1 /LOOKUP DEVICE NAME
-GETU, JMS I (GETUSR
- CIF 10
- JMS I [200 /FETCH HANDLER
- 1
-SUBLUP,
-DVNM1, 0
-LODTMP,
-DVNUM, 0 /NAME GOES IN HERE
-DRIVER, 0
- JMP I (KICKM /NO DEVICE. RELEASE MONITOR
- TAD CHAR
- SZA CLA
- JMS I [GNAME /PICK UP FILE NAME
- TAD DVNM1+1 /DEVICE NUMBER
- JMS I (DTYPE /SEE IF FILE STRUCTURED
- TAD NAME1 /IF FILE STRUCTURED WITH NO NAME
- SNA CLA /IT IS AN ERROR
- JMP I (NMER /V3C
- TAD NAME4 /SAVE ORIGINAL EXTENSION
- DCA TEMP
- TAD NAME4
- SNA /IF NULL
- TAD (0216 /TRY .BN FIRST
-TRYAGN, DCA NAME4
- TAD DVNUM /GET DEVICE NUMBER
- CIF 10
- JMS I [200 /DO LOOKUP OF FILENAME
- 2
-FILPTR, NAME1
- 0
- JMP LDEXT /DIDN'T FIND FILE. DO SOMETHING
- CIF 10
- JMS I [200 /KICK OUT MONITOR
- 11
- TAD DRIVER
-LOADIN, DCA I [DVICE /ENTRY POINT OF HANDLER
- JMS I (IOPEN /IF HERE, IT WILL FIT
- JMP I SETUP
- LOAD, JMS SETUP /SET UP FOR INPUT
- JMP I [NODEV /NO LOAD DEVICE
- STA CLL RAL /-2 DO A HANDLER LOAD
- CIF CDF 20 /OFF TO FIELD 2
- JMS I (LDABS
- JMP I [BADLOD /BAD
- TAD I TABLMT /SEE IF HEADER INFORMATION IS OK
- SMA
- JMP I [BADLOD
- TAD (20 /ALLOW 16 HANDLERS/BINARY
- SPA CLA
- JMP I [BADINP /TOO MANY
- TAD I TABLMT
- DCA LODTMP /# OF LOOPS TO EXECUTE
- TAD TABLMT
- TAD [PAGRES+1 /POINT TO FIRST 'PAGRES' WORD
- DCA HDPTR /GO THERE FOR DESCRIPTORS
- TAD HNDPTR
- JMS I [ROTL
- DCA TEMP /PAGE OF RESIDENCE
-PGLUP, TAD TEMP
- DCA I HDPTR /INSERT PAGE OF RESIDENCE
- TAD HDPTR
- TAD [HDRSIZ
- DCA HDPTR
- ISZ LODTMP
- JMP PGLUP
- TAD [2-HDRSIZ
- TAD HDPTR
- DCA HDPTR /POINT TO AFTER DESCRIPTORS
- TAD HDPTR
- CIA
- TAD I (NEWLIM
- SNA CLA /AT END?
- JMP I (OK /YES
- TAD I HDPTR /NO, MAYBE A BOOTSTRAP RECORD
- CLL
- TAD [200
- SNL CLA
- JMP I [BADLOD /NO
- TAD I HDPTR /MAYBE
- CIA
- IAC /OVER COUNT
- TAD HDPTR
- CIA
- TAD I (NEWLIM
- SZA CLA
- JMP I [BADLOD /NO
- JMP I (OK
- HDPTR, 0 /POINTS INTO NEW HEADER
-
-/DESCRIPTOR TABLE DESCRIPTION:
-
-/'TABLMT' ALWAYS POINTS TO FIRST FREE LOCATION
-/'DSCPTR' ALWAYS POINTS TO BEGIN OF CURRENT HEADER BLOCK
-/ITEMS ARE OF 3 FORMS:
-/(A) GROUP COUNT: IN RANGE -1 TO -20 (IGNORED AND HAS NO MEANING)
-/ IT IS THERE FOR COMPATIBILITY WITH OLD BUILD
-/(B) HEADER BLOCK STARTS WITH NUMBER IN RANGE 0-7577
-/ CONSISTS OF 'HDRSIZ' CONSECUTIVE WORDS
-/ DESCRIBED ELSEWHERE
-/(C) BOOTSTRAP BLOCK: STARTS WITH NUMBER IN RANGE 7600-7757
-/ THIS IS THE NEGATIVE OF THE NUMBER OF WORDS TO FOLLOW
- /NON-SYSTEM HEADER INFO:
-
-/ - NUMBER OF ENTRY POINTS
-
-/FOR EACH ENTRY POINT:
-
-/0,1 GROUP NAME
-/2,3 ENTRY POINT NAME (PERMANENT NAME)
-/4 R/W FILE-STR, DEVICE TYPE, MAX # OF PLATTERS
-/5 1/2 PAGE, REL ENTRY PT, SYSBIT, CORES
-/6* PAGE OF HANDLER, ACTIVE BIT, # OF PLATS, DSKBIT
-/7 SIZE OF DEVICE
-
-/* SUPPLIED BY BUILD
-
-LDEXT, TAD TEMP /DIDN'T FIND FILE
- SZA CLA
- JMP I (KICKM /NO RESORT
- ISZ TEMP
- JMP TRYAGN /TRY NULL EXTENSION
-
- PAGE
- REPLACE,JMS I (DEL /DELETE PERMANENT NAME SPECIFIED NEXT
- TAD CHAR
- TAD MEQ
- SZA CLA /AFTER ALL DELETIONS, MUST FIND A "="
- JMP I [SYNTAX /IF NOT, WARN THE GUY
- JMS INS /IF FOUND IT, NOW PERFORM INSERTIONS
- JMP I [CONFIG /THE GUY HAS BEEN HUMORED
-
-INSERT, JMS INS
-TSTEOL, TAD CHAR /THERE SHOULDN'T BE ANYTHING AFTER EOC
- SNA CLA
- JMP I [CONFIG /THERE WASN'T
- JMP I [SYNTAX /WARN BLOKE ABOUT EXTRA STUFF
-
-DELETE, JMS I (DEL /DELETE PERMANENT NAMES SPECIFIED
- JMP TSTEOL
-
-SYSTEM, JMS INS /SYS IS SAME AS INSERT
- GET
- SYSBIT
- RTL
- SPA SZL CLA /BUT SYSBIT OR CORES SHOULD BE ON
- JMP TSTEOL /JUST TO HUMOR IT'S NAME
-TWOSYS, JMS I [PRWD /AND FOR COMPATIBILITY REASONS
- TEXT /?SYS/
- JMP I [CONFIG
- INS, 0
- TAD (STL RAR
- DCA I (ACTION /SET 'ACTION' FOR INSERTIONS
- JMS I [TSTNAM /LOOK FOR A NAME
- JMS I [GRPNAM /GET GROUP NAME
- JMS SAVNAM
- JMS I [TEST
-MEQ, -"=;ACT
- -",;INSNAM
- -":;INSNAM
- 4000;ACT
- 0
-INSNAM, JMS I [TSTNAM /GRAB A NAME
-INSGN, JMS I [BIGNAM /GET PERMANENT NAME WITH SPECIFIED GROUP NAME
- GET
- GRPNM1
- CIA
- TAD SAV1
- SZA CLA
- JMP I [NFOUND /MAKE SURE PERMANENT NAME FOUND
- GET /HAS GROUP NAME PREVIOUSLY SPECIFIED
- GRPNM2
- CIA
- TAD SAV2
- SZA CLA
- JMP I [NFOUND
-ACT, JMS I (SETACT /SET ACTIVE BIT
-COM, JMS I [TEST
- -"-;HYPH
- -",;INSNAM
- -"=;INPLAT
- 0
- JMP I INS
- INPLAT, JMS I [GETNUM /AN "="
- JMP I [SYNTAX
- TAD SIZE
- SNA CLA
- JMP I [BADARG /=0 ILLEGAL
- GET
- MAXPLT
- AND [7 /GET MAXIMUM # OF PLATTERS ALLOWED
- SNA
- IAC /0 MEANT 1
- CMA CLL
- TAD SIZE /COMPARE WITH USER'S REQUEST
- SZL CLA /IS HIS REQUEST OKAY?
- JMP BADPLT /REQUEST-SHMEST. TOO MANY PLATTERS
- TAD SIZE
- JMS I [ROTR
- DCA SIZE
- GET
- PLATNUM
- AND (6177
- TAD SIZE /STORE AWAY HIS STATED NUMBER OF PLATTERS
- PUT /FOR FUTURE USE BY 'BOOT'
- PLATNUM
- JMP COM /REJOIN PROCESSING
-
-BADPLT, JMS I [PRWD
- TEXT /?PLAT/
- JMP I [CONFIG
- SAVNAM, 0
- TAD NAME1
- DCA SAV1 /SAVE GROUP NAME
- TAD NAME2
- DCA SAV2
- JMP I SAVNAM
-
-HYPH, TAD NAME2
- AND [77
- CIA
- DCA DETEM
- GETCHR
- AND [77
- TAD DETEM /GET CHAR AFTER HYPEN
- SNA CLA /REACHED IT YET?
- JMP IGET /YES, WELL TRY FOR MORE STUFF
- BAKCHR /NO, PUT IT BACK FOR FUTURE USE
- ISZ NAME2 /FORM NEXT SEQUENTIAL NAME
- JMP INSGN /GO INSERT IT
-/DO WE REALLY HAVE TO START SEARCH AT CURRENT DESCR?
-
-DETEM, 0
-
-IGET, GETCHR
- DCA CHAR
- JMP COM
-
-NODEV, JMS I [PRWD
- TEXT /?DEVICE/
- JMP I [CONFIG
- PAGE
- INTEM,
-SETACT, 0
- GET
- ACTIVE /GET ACTIVATION BIT
- RAL
-ACTION, STL RAR /ACTIVATE IT (SET TO 'CLL RAR' TO DEACT)
- PUT
- ACTIVE /RESTORE
- JMP I SETACT
-
-DEL, 0
- TAD (CLL RAR
- DCA ACTION
-DELNAM, JMS I [TSTNAM /PARSE OFF A NAME
-DELGN, JMS I [ACTNAM /FIND IT AS AN ACTIVE PERMANENT NAME
- JMS SETACT /DEACTIVATE IT
- GET
- PLATNUM
- AND [6177 /SET # OF PLATTERS TO 0
- PUT
- PLATNUM
-DCOM, JMS I [TEST
- -"-;DHYPH
- -",;DELNAM
- 0
- JMP I DEL
-
-DHYPH, TAD NAME2
- AND [77
- CIA
- DCA INTEM
- GETCHR
- AND [77
- TAD INTEM
- SNA CLA /REACHED FINAL NAME?
- JMP DGET /YES
- BAKCHR /NO, PUT FINAL LETTER BACK
- ISZ NAME2 /YES, BUMP TO NEXT NAME
-L0423, 423
- JMP DELGN /DELETE NEXT ONE IN SUCCESSION
- DGET, GETCHR
- DCA CHAR
- JMP DCOM
-
-TTYIN, 0 /TTY INPUT ROUTINE
- KSF
- JMP .-1
- KRB
- SNA /LOW LEVEL BLANK IGNORE
- JMP TTYIN+1
- AND [177 /HANDLE PARITY
- TAD [200
- DCA CHAR
- JMP I TTYIN
- /DSK=ACTIVE PERMANENT NAME
-/DSK=GROUPNAME:PERMANENT NAME
-/DSK=<CR> MEANS NO DSK SPECIFIED, USE 'SYS'
-
-/JUST REMEMBERS NAME (NOTHING ELSE)
-
-DSK, JMS I [GNAME /GET A NAME
- TAD NAME1
- SNA CLA
- JMP NODSK
- TAD CHAR
- SNA
- JMP NOCOL
- TAD [-":
- SZA CLA /IS IT FOLLOWED BY A ":"?
- JMP I [SYNTAX /NO, ASSUME HE'S GIVING AN ACTIVE PERMANENT NAME
- /THIS IS FOR COMPATIBILITY WITH OLD BUILD
-/ JMS I [GRPNAM /YES, ITS A GROUP NAME
- TAD NAME1 /SAVE IT
- DCA DSKG1
- TAD NAME2
- DCA DSKG2
- JMS I [TSTNAM /GET PERMANENT NAME
-PN, TAD NAME1
- DCA DSKP1 /DON'T WORRY NOW IF IT'S AROUND
- TAD NAME2
- DCA DSKP2
- TAD CHAR
- SZA CLA
- JMP I [SYNTAX
- JMP I [CONFIG
-
-NODSK, DCA DSKG1 /FIRST WORD 0 MEANS NONE SPECIFIED
- JMP I [CONFIG
-
-NOCOL, JMS I [ACTNAM /IT MUST BE AN ACTIVE HANDLER
- GET
- GRPNM1
- DCA DSKG1
- GET
- GRPNM2
- DCA DSKG2
- JMP PN
- SETDSK, TAD L0423 /DS
- DCA I (DVNM1
- TAD (1300 /K
- DCA I (DVNM1+1
- JMP I (GETU
-
-KICKM, CIF 10 /RELEASE MONITOR AND RELOAD
- JMS I [200 /OUR DEVICES
- 11
- JMP I [NFOUND
-
-GETUSR, 0
- CIF 10
- JMS I [7700 /LOCK IN MONITOR
- 10
- CIF 10 /RESET RESIDENT HANDLER TABLE
- JMS I [200
- 13
- JMP I GETUSR
- / CODE FOR USING INTERNAL HANDLERS ON STANDALONE LOAD:
-
-BLDLOD, DCA I (FILPTR /LOAD DEV
- JMS I [ACTNAM /MUST BE ACTIVE
- JMS I [GETPG
- DCA HNDLOK /LOCATION OF HANDLER
- TAD [-400
- JMS I [MOVE
- CDF 10
-HNDLOK, HLT
- CDF 0
-PBUFFER,BUFFER
- GET
- DCB
- DCA BLDCB
- GET
- ENTPT
- AND [177
- TAD PBUFFER /GET ENTRY POINT OF HANDLER
- JMP I (LOADIN
-
-BLDCB, 0 /CONTAINS DCB OF CURRENT LOAD HANDLER
- PAGE
- GETPG, 0
- GET
- PAGRES
- JMS I [ROTR
- AND [7600
- JMP I GETPG
-
-/FORMAT: NAME OLDNAME=NEWNAME
-
-NAME, JMS TSTNAM /SEE IF ARGUMENT SUPPLIED
- /SEARCH PERMANENT TABLES
- JMS I [ACTNAM /GET ACTIVE PERMANENT NAME DESCRIPTOR
- TAD CHAR
- TAD MEQL /CHECK FOR =
- SZA CLA
- JMP I [BADARG
- JMS TSTNAM /GET NEW DEVICE NAME
- TAD NAME1 /REPLACE THE NAME
- PUT
- PRMNM1
- TAD NAME2
- PUT
- PRMNM2
- JMP I [CONFIG
- EXAMINE,CLA IAC
-ALTER, DCA XSWTCH
- JMS I [TSTNAM /ALTER ALLOWS MODS TO A PARTICULAR
- JMS I [GRPNAM /HANDLER'S ACTUAL CODE.
- /LOOK AT DEVICE TYPE ENTRY
- JMS GETPG /GET PAGE OF RESIDENCE
- DCA PAGAD /SAVE IT.
- JMS I [GETNUM /GET RELATIVE LOC TO ALTER
- JMP I [SYNTAX /NO NUMBER
- GET
-P2PAG, TWOPAG /IS THIS A 2-PAGE HANDLER?
- SPA CLA
- TAD [7600
- TAD [7600 /ALLOW 200 OR 400 MAXIMUM
- CLL
- TAD SIZE /IS THE # TO ALTER TOO LARGE?
- SZL CLA
- JMP I [BADARG /I GUESS IT IS
- TAD SIZE
- TAD PAGAD /GET ABSOLUTE LOCATION
- DCA PAGAD
- TAD XSWTCH
- SZA CLA /EXAMINE OR ALTER?
- JMP EXAM /EXAMINE
- TAD CHAR /ALTER
- SZA CLA /CR?
- JMP GETVAL /NO
- JMS EXAMSB /YES, GIVE GUY OLD VALUE FIRST
-ODTL, TAD ["/ /ODT LIKE
- JMS I [TTYOUT
- TAD [-100
- JMS I [GTEXT
- JMP ODTL
-GETVAL, JMS I [GETNUM /GET NEW CONTENTS
- JMP I (TSTEOL /NO NUMBER
- TAD SIZE
- CDF 10
- DCA I PAGAD /REPLACE THAT LOC.
- JMP I [CONFIG /AND GET OUT
-PAGAD, 0
-
-/ALTER GROUPNAME,LOC=NEWVALUE
-/ALTER GROUPNAME,LOC
-/EXAMINE GROUPNAME,LOC
- /SIZE ACTNAM
-/SIZE ACTNAM=VALUE
-/DCB ACTNAM
-/DCB ACTNAM=VALUE
-/CTL ACTNAM
-/CTL ACTNAM=VALUE
-
-SIZCM, TAD (3 /SIZE COMMAND V3C
-DCBCM, TAD [-1 /EXAMINE DCB WORD
-CTLCM, TAD P2PAG /EXAMINE CONTROL WORD
- DCA PUTAT
- TAD PUTAT
- DCA LOOKAT
- JMS I [TSTNAM /GET A NAME
- JMS I [ACTNAM /IT MUST BE ACTIVE
- JMS I [TEST
-MEQL, -"=;INPDCB
- 4000;EXAMDCB
- 0
- JMP I [SYNTAX
-INPDCB, JMS I [GETNUM
- JMP I [CONFIG /IGNORE = NOTHING
- TAD SIZE
- PUT
-XSWTCH, /0 MEANS ALTER, 1 MEANS EXAMINE
-PUTAT, DCB
- JMP I [CONFIG /THE USER LIVES DANGEROUSLY
-
-EXAMDCB,GET
-LOOKAT, DCB
- JMS PUTNUM
- TAD ["/
- JMS I [TTYOUT
- TAD [-100
- JMS I [GTEXT
- JMP EXAMDCB
- JMP INPDCB /NOW PARSE OFF THE REPLY
- EXAM, JMS EXAMSB
- JMP I [CONFIG
-
-EXAMSB, 0
- CDF 10
- TAD I PAGAD /GET CURRENT CONTENTS
- CDF 0
- JMS PUTNUM /PRINT IT
- JMP I EXAMSB
-
-PUTNUM, 0 /PRINT AN OCTAL NUMBER
- DCA PTM
- TAD [-4 /4 DIGITS
- DCA PKNT
-PLOOP, TAD PTM
- RTL
- RTL
- AND [7
- TAD (60
- JMS I [TTYOUT
- TAD PTM
- RTL
- RAL
- DCA PTM
- ISZ PKNT
- JMP PLOOP
- JMP I PUTNUM
-PTM, 0
-
-PKNT,
-TSTNAM, 0
- JMS I [GNAME /COLLECT NAME
- TAD NAME1 /IF NO NAME FOUND, GIVE ERROR
- SZA CLA
- JMP I TSTNAM
-NAMERR, JMS I [PRWD
- TEXT /?NAME/
- JMP I [CONFIG
- PAGE
- /PRINT FUNCTION TYPES OUT THE STATUS OF BUILD ON COMMAND
-/AN * BESIDE A DEVICE INDICATES THAT IT IS CURRENTLY MARKED
-/FOR INSERTION IN THE SYSTEM BEING BUILT.
-
-TTY240,
-PRINT, STA
- DCA OLDPAG /SET ILLEGAL OLD PAGE
- INIT
- ISZ I (LINEUP /MAKE THINGS LINE UP
-PRLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
- ADVBOT /ADVANCE PAST A BOOTSTRAP (IF ANY)
- JMP DONE /ALL DONE
- JMS I [GETPG /GET PAGE OF NEW HANDLER
- DCA NEWPAG
- TAD NEWPAG
- CIA
- TAD OLDPAG /COMPARE WITH LAST HANDLER'S PAGE
- SNA CLA /SAME?
- JMP PRTPER /YES
- JMS I [CRLF /NO, GO TO NEXT LINE
- TAD NEWPAG
- DCA OLDPAG
- JMS PGNAME
- TAD TTY240
- JMS I [TTYOUT
-PRTPER, GET /GET ACTIVE BIT
- ACTIVE
- SPA CLA /IS IT ACTIVE?
- TAD ("*-STA /YES, PRINT *
- TAD TTY240 /NO, PRINT SPACE
- JMS I [TTYOUT
- JMS PNAME /PRINT PERMANENT NAME
- JMP PRLUP
-
-PGNAME, 0
- GET
- GRPNM1
- JMS I (PRINTE /PRINT GROUP NAME
- GET
- GRPNM2
- JMS I (PRINTE
- TAD (":
- JMS I [TTYOUT
- JMP I PGNAME
- DONE, DCA I (LINEUP /NO MORE LINE-UP
- TAD DSKG1
- SNA CLA
- JMP TELCOR
- JMS I [CRLF /TELL GUY ABOUT 'DSK'
- JMS I [CRLF
- JMS I [PRWD
- TEXT /DSK=/
- TAD DSKG1
- JMS I (PRINTE
- TAD DSKG2
- JMS I (PRINTE
- TAD (":
- JMS I [TTYOUT
- TAD DSKP1
- JMS I (PRINTE
- TAD DSKP2
- JMS I (PRINTE
-TELCOR, TAD NEWCOR
- SNA
- JMP I [CONFIG /NO SPECIFIED CORE LIMIT
- JMS I [ROTL
- TAD (6000
- DCA CORMSG+3
- JMS I [CRLF
- JMS I [PRWD
-CORMSG, TEXT /CORE= /
- JMP I [CONFIG
- /QUICK PRINT
-
-QLIST, INIT
-QLUP, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
- ADVBOT /ADVANCE OVER ANY BOOTSTRAP IF NECESSARY
- JMP DONE /GO AWAY WHEN NO MORE
- GET
- ACTIVE /GET ACTIVE BIT
- SMA CLA /IS IT ACTIVE?
- JMP QLUP /NO, IGNORE IT
- GET /YES
- SYSBIT
- RAL
- SPA CLA /IS IT 'SYS'?
- JMS PGNAME /YES, PRINT GROUP NAME TOO
- JMS PNAME /NO, PRINT PERMANENT NAME ONLY
- JMP QLUP
-
-DT,
-PNAME, 0
- GET
- PRMNM1
- JMS I (PRINTE
- GET
- PRMNM2
- JMS I (PRINTE
- TAD TTY240
- JMS I [TTYOUT
- JMP I PNAME
- DCBTBL=7760
-
-WHAT, JMS I [PRNAME
- JMS I [PRWD
- TEXT /?/ /FOR WHEN A COMMAND ERROR OCCURS
- JMP I [CONFIG
-
-
-DTYPE, 0 /RETURNS TYPE OF OUTPUT
- TAD (DCBTBL-1
- DCA DT /ENTRY AC HAD DEVICE #
- CDF 10
- TAD I DT /IF FILE DEVICE, LINK=0
- CDF 0
- CMA RAL /ALSO, IF FILE AC=0 ON EXIT
- CLA RAL
- JMP I DTYPE
- WRITCC, 0
- TAD [-6 /PUT IN DATA BREAK FILLERS
- JMS I [MOVE
- CDF 0
- K7750
- CDF 0
- PG7600+200+150
- TAD (4200
- JMS I [SYS /WRITE NEW CCB
- BLDCCB-200
- 37
- JMP I WRITCC
- PAGE
- TOOMANY,JMS I [PRWD
- TEXT /?HANDLERS/
- JMP I [CONFIG
-
-GOTCHA, 0
- DCA I (GOTEM
- TAD I GOTCHA
- TAD DSCPTR
- ISZ GOTCHA
- DCA GETEMP
- TAD I (GOTEM
- DCA I GETEMP
- JMP I GOTCHA
-
-GETEMP, 0 /TEMP FOR GOTCHA
- TEST, 0 /TEST CHAR AGAINST ARGUMENTS
- TAD I TEST /PICK UP ARGUMENT FROM LIST
- SNA /0 TERMINATES
- JMP I TEST
- TAD CHAR /SEE IF THEY COMPARE =
- AND (3777 /COMPARE ONLY LOW ORDER, THUS ALLOWING '4000' TO MEAN '0'
- SNA CLA
- JMP TSTOVR /THEY DO..DISPATCH TO TABLE
- ISZ TEST
- ISZ TEST
- JMP TEST+1 /THEY DON'T. KEEP GOING
-TSTOVR, ISZ TEST
- TAD I TEST
- DCA TEMP
- JMP I TEMP
-
-K7750, 7750 /DATA BREAK FILLERS
- 7751
- 7752
- 7753
- 7754
- 7755
-
-SYS, 0 /SAVES A FEW WORDS IN SYSTEM CALLS
- DCA SYCTL /SAVE FUNCTION WORD
- TAD I SYS
- DCA SYBUF /BUFFER BEING USED
- ISZ SYS
- TAD I SYS
- DCA SYREC /RECORD #
- ISZ SYS /THERE IS NO ERROR RETURN
-/IF SWAPER SET AND BOOTDV SET, USE SPECIAL BOOT HANDLER HERE
-GO, JMS I SYSENT
-SYCTL, 0
-SYBUF, 0
-SYREC, 0
- SKP CLA
- JMP I SYS
- JMS I [PRWD
- TEXT /SYS ERR/
- HLT /IF USER IS DARING, HIT CONTINUE TO RETRY
- JMP GO
-
-SYSENT, 7607
- /*****************
-/
-/ SYS HANDLER IS 2-PAGES LONG IF LOCATION 7612 IS A 3
-/
-/******************
-
-CLRTBL, 0
- TAD [BEGLIN
- DCA XR1
- TAD [-200 /ZERO OUT 5200-5377
- DCA TMP1
- DCA I XR1
- ISZ TMP1
- JMP .-2
- JMP I CLRTBL
-
-/FOR HANDLER ONLY
-ORGLIM, 0 /THIS ROUTINE MAKES CERTAIN THAT
- DCA CLRTBL /THE ORIGIN FOR LDABS IS WITHIN
- TAD CLRTBL /THE BOUNDS SPECIFIED BY SIZE
- TAD [7600 /AND THE CONTENTS OF HNDPTR
- SPA
- JMP BADORG /ORIGIN BELOW 200
- CIA
- TAD [400 /IS ORIGIN WITHIN UPPER BOUND?
- SPA CLA
- JMP BADORG
- TAD CLRTBL
- TAD [7600 /NOW GIVE BACK RELATIVE BUFFER
- TAD HNDPTR /ADDRESS IN FIELD 1
- DCA CLRTBL
- TAD CLRTBL
- AND [7600
- TAD [200
- SNA CLA
- JMP I (NOROOM /CAN'T 'ORIGIN' INTO PAGE 7600
- TAD CLRTBL
- CIF CDF 20 /CALLED FROM FIELD 2
- JMP I ORGLIM
-
-BADORG, JMS I [PRWD
- TEXT /?ORIGIN/
- JMP I (OVROUT
-
-/SOMEWHERE TEST IF HE GAVE US A 2-PAGE BUT REQ A 1-PAGE
- / PG7600_0
-/ BLOK66_66
-/ IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
-
-RECZRO, 0 /READS FIELD 1 CODE, EVEN FOR 12K TD8E
- TAD [200
- JMS I [SYS /READ RECORD 0
- PG7600
- 0 /THAT NORMALLY CONTAINS FIELD 1
- TAD (210
- JMS I [SYS /READ RECORD 66
- BLOK66
- 66
- TAD FLAG2 /DID PREVIOUS SYSTEM HAVE A 2-PAGE HANDLER?
- SZA CLA
- TAD [-200 /NO
- JMS I [MOVE /YES
- CDF 0
- PG7600
- CDF 10
- BLOK66
- JMP I RECZRO
-
-NOTNUF, JMS I [PRWD
- TEXT /?CORE/
- JMP I [CONFIG
- PAGE
- UNLOAD, JMS I [TSTNAM /PULL OFF A NAME
- JMS I [GRPNAM /IT HAD BETTER BE A GROUP NAME
- JMS I [TEST
- -":;UNLPRM
- 4000;UNLGRP
- 0
- JMP I [SYNTAX
-
-UNLPRM, JMS I (SAVNAM /UNLOAD PARTICULAR HANDLER
-UNLNAM, JMS I [TSTNAM
- JMS I [BIGNAM
- TAD DSCPTR /DELETE A SINGLE DESCRIPTOR
- DCA SAVPTR /DON(T DELETE HANDLER
- TAD DSCPTR /OR BOOTSTRAP
- TAD [HDRSIZ /NO RELOCATION NECESSARY
- DCA LSTPTR
- TAD TABLMT
- JMP NOMOR
- UNLGRP, JMS I [GETPG /GET PAGE OF RESIDENCE
- DCA TOMOV /START OF HANDLER
- GET
- TWOPAG /IS IT A 1- OR 2- PAGE HANDLER?
- SPA CLA
- TAD [200 /2 PAGE
- TAD [200 /1 PAGE
- DCA UNSIZE
- TAD TOMOV /DELETE HANDLER AND MOVE ALL FOLLOWING DOWN
- TAD UNSIZE
- DCA FROMOV /GET FIRST LOCATION AFTER HANDLER
- TAD HNDPTR /GET NEXT FREE LOCATION FOR HANDLER
- CIA
- TAD FROMOV /GET NUMBER OF LOCS TO MOVE
- JMS I [MOVE
- CDF 10
-FROMOV, 0
- CDF 10
-TOMOV, 0 /UPDATE POINTERS; SEARCH DESCRIPTORS
- TAD UNSIZE /FOR REFS TO MOVED HANDLERS AND DECREASE
- CIA /THOSE REFS BY -UNSIZE
- TAD HNDPTR
- DCA HNDPTR /FREES SOME BUFFER SPACE
- TAD TABLMT
- DCA OLDTOP /REMEMBER ORIGINAL TOP OF STACK
- STA /BACK UP OVER GROUP COUNT
- TAD DSCPTR
- DCA SAVPTR /REMEMBER THIS LOCATION
- TAD UNSIZE
- JMS I [ROTL
- CIA
- DCA UNSIZE
- TAD DSCPTR
- TAD [HDRSIZ
- DCA LSTPTR /'LSTPTR' POINTS TO FIRST DESCRIPTOR BEING MOVED
- /COMPRESS THE DESCRIPTORS ABOVE THIS ONE
-
-ADV, ADVDSC /ADVANCE TO NEXT DESCRIPTOR
- JMP BADV /ENCOUNTERED A BOOTSTRAP RECORD
- JMP NOMORE /NO MORE, THROUGH
-GT, JMS I [GETPG /GET PAGE OF THIS DESCRIPTOR
- CLL CIA
- TAD TOMOV /COMPARE WITH PAGE OF DELETED HANDLER
- SNA CLA
- JMP SAMPAG /THEY'RE THE SAME
- SZL /THEY'RE NOT THE SAME. WHICH IS HIGHER?
- JMP ADV /IT WAS BELOW HANDLER. NO SWEAT.
- GET /IT WAS ABOVE HANDLER, HAVE TO ACCOUNT FOR THIS
- PAGRES /POINT TO NEW HANDLER LOCATION
- TAD UNSIZE
- PUT
- PAGRES
- JMP ADV /CONTINUE
-SAMPAG, TAD [HDRSIZ
- TAD DSCPTR
- DCA LSTPTR /NOTE LOCATION OF NEXT DESCRIPTOR
- JMP ADV
-/ADVANCE PAST BOOTSTRAP OR DELETE IT AS NECESSARY
-BADV, TAD DSCPTR
- CIA
- TAD LSTPTR
- SZA CLA /IS THIS BOOT PART OF GROUP BEING UNLOADED?
- JMP BDV /NO
- TAD I DSCPTR /YES
- CIA
- IAC
- TAD DSCPTR
- DCA LSTPTR /SET 'LSTPTR' TO BEGIN OF NEXT DESCRIPTOR
-BDV, ADVBOT /ADVANCE OVER BOOTSTRAP
- JMP NOMORE /DONE
- JMP GT /GO ON TO NEXT DESCRIPTOR
- /ALL DESCRIPTORS FOR THE SAME HANDLER ARE CONSECUTIVE
-/MOVE DOWN DESCRIPTORS
-
-NOMORE, TAD OLDTOP
-NOMOR, CIA
- TAD LSTPTR /MINUS # OF WORDS TO MOVE
- JMS I [MOVE
- CDF 0
-LSTPTR, 0 /FIRST DESCRIPTOR NOT CONSIDERED
- CDF 0
-SAVPTR, 0 /POINTS TO INITIAL DESCRIPTOR BEING DELETED
- TAD LSTPTR
- CIA
- TAD SAVPTR /GET NUMBER OF WORDS DELETED
- TAD TABLMT
- DCA TABLMT /UPDATE TABLMT
- DCA I TABLMT /MUST HAVE 0 AT TABLE END SO DON'T THINK IT'S A BOOTSTRAP
- JMS I [COMMA
- JMP UNLNAM
-
-OLDTOP, /ORIGINAL TOP OF DESCRIPTORS
-INI, 0
- TAD (DSCTAB-HDRSIZ
- DCA DSCPTR
- JMP I INI
-
- INIT=JMS I [INI
-
-/RETURN TO CONFIG IF EOL, OR BACK IN-LINE IF COMMA
-
-UNSIZE,
-COMMA, 0
- TAD CHAR
- SNA
- JMP I [CONFIG
- TAD (-",
- SNA CLA
- JMP I COMMA
- JMP I [SYNTAX
- BOOTQ, SZA CLA /MAY BE OVERLAID
- JMP SAMEE
- DCA I (DRECT /DON'T TOUCH DIRECTORY IF DIDN'T COPY SYS
-SAMF, JMS I [SYSWP
- JMP I (BOOT4
-SAMEE, JMS I (SYSCPY /OR IF OLD DEV=NEW DEV
- JMP SAMF
- PAGE
- LOCSYS, 0
- TAD (2331 /"SY"
- DCA NAME1
- TAD (2300 /"S "
- DCA NAME2
- DCA NAME3 /V3C
- DCA NAME4
- JMS I [ACTNAM /LOOK UP 'SYS'
- JMP I LOCSYS
-
-NOSLOT, JMS I [PRWD
- TEXT /?SLOTS/
- JMP I [CONFIG
-
-GOOD, 0
- TAD [4207 /RESTORE 7600 TO NORMAL
- DCA I [7600
- TAD [5000
- DCA I [7601
- TAD (CDF CIF
- DCA I [SA /SET SA=00200
- TAD [200
- DCA I (SA+1
- DCA I (JSW /SET JOB STATUS WORD=0
- STA
- DCA I (DRECT
- CLL STA RTL /-3
- TAD I [7612 /FUDGE FOR 12K TD8E
- DCA FLAG2 /SET FLAG2=0 IF PREV SYSTEM WAS 2 PAGE
- JMP I GOOD
- PACK, ISZ PROTECT /OK TO PACK IT?
- JMP PACKOK /YES
- STA
- DCA PROTECT /INHIBIT OTHER PACKS ALSO
- JMP GNAME2
-PACKOK, ISZ SWIT /PACK LEFT OR RIGHT
- JMP RIGHT
- TAD CHAR
- AND [77
- JMS I [ROTL /ROTATE 6 LEFT
- DCA I TEMP /STORE THE CHARACTER
- JMP GNAME2
-RIGHT, CLA CMA /RESET FLIP FLOP
- DCA SWIT
- TAD CHAR
- AND [77
- TAD I TEMP
- DCA I TEMP
- ISZ TEMP /POINT TO NEXT WORD
- JMP GNAME2
-PROTECT,0 /-1 MEANS DON'T ACCEPT CHAR, IGNORE IT
-SWIT, 0
-
-
-ACTNAM, 0 /THEY MUST BE ACTIVE
- CLA IAC
- JMS I (PRMNAM
- JMP I ACTNAM
- DOT, CLA CMA
- DCA SWIT
- TAD (-3 /NOW ALLOW ONLY A 2-CHAR EXTENSION
- DCA PROTECT
- TAD (NAME4
- DCA TEMP
- ISZ DOTCNT /HAD WE SEEN A DOT BEFORE?
- JMP SYNTAX /YES
- JMP GNAME2 /NO
-
-DOTCNT, -1 /-1 MEANS HAVEN'T SEEN A DOT
-
-EOL, DCA CHAR
- JMP I GNAME
-
-GNAME, 0 /COLLECT A WORD IN NAME1-NAME4
- /LEAVE DELIMITING CHAR IN 'CHAR'
- CDF 0
- TAD [-7 /MAX 6 CHARACTERS
- DCA PROTECT
- DCA NAME1 /FIRST CLEAR OUT COLLECTION AREA
- DCA NAME2
- DCA NAME3
- DCA NAME4
- CLA CMA
- DCA SWIT /L-R PACKING SWITCH
- STA
- DCA DOTCNT /ALLOW ONLY ONE DOT PER NAME
- TAD (NAME1
- DCA TEMP
-GNAME2, GETCHR
- SNA /A 0 ENDS THE SEARCH
- JMP EOL
- DCA CHAR
- TAD CHAR
- TAD (-"A /GET ONLY A-Z OR 0-9
- CLL
- TAD ("A-"Z-1
- SNL CLA /IS IT A-Z?
- JMP PACK /YES..PACK IT AWAY
- TAD CHAR
- TAD (-"0
- CLL
- TAD ("0-"9-1
- SNL CLA
- JMP PACK /FOUND 0-9
- JMS I [TEST /TEST FOR DELIMITING CHARS
- -".;DOT /ADVANCE POINTERS
- 0
- JMP I GNAME
- SYNTAX, JMS I [PRWD
- TEXT /?SYNTAX/
- JMP I [CONFIG
-
-DSKBAD, JMS I [PRWD
- TEXT /?DSK/
- JMP I [CONFIG
- SRES=BEGLIN+60 /RESIDENCY TABLE
- SDCB=BEGLIN+100 /DCB
- SHND=BEGLIN+120 /SLOT ASSSIGNED?
- SNAME=BEGLIN+140/NAME
- SBUFF=BEGLIN+160/ADDRESS OF HANDLER
-
-
-/ SYSTEM TABLES:
-
-/THOSE IN USR:
-
-/PDNT PERMANENT DEVICE NAME TABLE (SNAME)
-/ POINTED TO BY LOCATION 10036 IN USR
-/ CONTAIN HASH CODE OF DEVICE NAME
-/ ADD TWO WORDS OF NAME TOGETHER AND TURN ON BIT 0
-/ IF SECOND WORD WAS NON-ZERO
-/ AN ENTRY OF 0 MEANS THERE IS NO DEVICE FOR THAT ENTRY
-
-/DHIT DEVICE HANDLER INFORMATION TABLE (SHND)
-/ POINTED TO BY LOCATION 10037 IN USR
-/ BIT 0 =1 IF THIS IS A TWO-PAGE HANDLER
-/ BITS 1-4 RELATIVE BLOCK LOCATION OF HANDLER ON SYSTEM DEVICE
-/ (BLOCK SLOT). ADD 15 TO GET ACTUAL BLOCK #.
-/ BITS 5-11 RELATIVE ENTRY POINT OF HANDLER
-
-
-/DHRT DEVICE HANDLER RESIDENCY TABLE (SRES)
-/ IN LOCATIONS 17647-17665
-/ ACTUAL ENTRY POINT OF HANDLER
-/ WE ONLY CARE ABOUT IT IF THE HANDLER IS RESIDENT.
-/ OTHERWISE IT'S ZERO.
-/ THE SYSTEM HANDLER AND ALL HANDLERS CORESIDENT WITH
-/ IT ARE ALWAYS RESIDENT IN CORE AND HAVE THIS ENTRY NON-0.
-
-
-/DCWT DEVICE CONTROL WORD TABLE (SDCB)
-/ RESIDES IN LOCATIONS 17760-17776
-/ BIT 0 1 IF DEVICE IS FILE STRUCTURED
-/ BIT 1 1 IF THE DEVICE IS READ ONLY
-/ BIT 2 1 IF THE DEVICE IS WRITE-ONLY
-/ BITS 3-8 PHYSICAL DEVICE TYPE
-/ BITS 9-11 DIRECTORY BLOCK # (WE SET TO 0)
- /PRE-ASSIGNED DEVICE TYPES
-
-/0 TELETYPE
-/1 HIGH SPEED PAPER TAPE READER
-/2 HIGH SPEED PAPER TAPE PUNCH
-/3 CARD READER
-/4 LINE PRINTER (ANY TYPE)
-/5 RK8 DISK
-/6 RF08 (1 PLATTER)
-/7 RF08 (2 PLATTERS)
-/10 RF08 (3 PLATTERS)
-/11 RF08 (4 PLATTERS)
-/12 DF32 (1 PLATTER)
-/13 DF32 (2 PLATTERS)
-/14 DF32 (3 PLATTERS)
-/15 DF32 (4 PLATTERS)
-/16 TC08 DECTAPE
-/17 LINCTAPE
-/20 TM8E MAGTAPE
-/21 TD8E DECTAPE (12K OR ROM)
-/22 BAT:
-/23 RK8E DISK
-/27 TU60 CASSETTES
-/30 VR12 (PDP-12 SCOPE)
- PAGE
- BOOT2A, TAD (15
- DCA SLOT /START ASSIGNING AT BLOCK SLOT 16 (16-25)
- TAD (-17 /ALLOW 16 ACTIVE HANDLERS NOT COUNTING DSK
- DCA COUNT
- JMS I (CLRTBL /CLEAR OUT IN-CORE TABLES
- TAD (SHND+1 /ASSIGN SLOTS, COUNT ACTIVE HANDLERS
- DCA XR1 /XR1 POINTS TO SLOT TABLE (DHIT)
- TAD (SDCB+1
- DCA XR2 /XR2 POINTS TO DCB TABLE
- TAD (SNAME+1
- DCA XR3 /XR3 POINTS TO PERMANENT DEVICE NAME TABLE
- TAD (SBUFF+1
- DCA XR4 /XR4 POINTS TO HANDLER BUFFER ADDRESSES
- TAD (SRES+1
- DCA XR5 /XR5 POINTS TO RESIDENCY TABLE
- CLA IAC /??
- DCA OLDPAG /SET 'OLDPAG' TO A RIDICULOUS VALUE
- INIT
-SLTLUP, ADVDSC /GO TO NEXT DESCRIPTOR
- ADVBOT /ADVANCING OVER ANY BOOTSTRAPS
- JMP BOOT2X /ALL DONE CREATING INTERNAL COPIES OF TABLES
- GET
- ACTIVE
- SMA CLA /IS IT ACTIVE?
- JMP INACT /NO
- ISZ COUNT /YES, UPDATE COUNT
- JMP ACTIV
- JMP I (TOOMANY /TOO MANY ACTIVE HANDLERS
-
-BOOT2X,/ TAD I (SNAME /SEE IF SYS WAS SPECIFIED
-/ DCA SAMSYS /0 IF DIDN'T SPECIFY NEW SYS
-/ TAD SAMSYS
-/ SZA CLA
-/ JMP CHKDSK
-/ CDF 10
-/ TAD I (7760 /DIDN'T SPECIFY SYS SO USE CURRENT SYS
-/ CDF 0
-/ DCA I (SDCB
-/ TAD (7607
-/ DCA I (SRES
-/CHKDSK, TAD DSKG1 /WAS DSK SPECIFIED?
-/ SZA CLA
-/ JMP I (BOOT3 /YES, ALREADY SET UP
-/ TAD I (SDCB
-/ DCA I (SDCB+1
-/ TAD (7607
-/ DCA I (SRES+1
-/ DCA I (SBUFF+1
- JMP I (BOOT3
- CHKRES, 0
- JMS I [GETPG /GET PAGE OF RESIDENCE
- DCA NEWPAG
- TAD NEWPAG
- TAD OLDPAG
- SNA CLA /SAME OR PREVIOUS PAGE?
- JMP I CHKRES /YES, SAME PAGE
- ISZ CHKRES
- GET /NO, A NEW PAGE, NEEDS NEW SLOT, ETC.
- CORES
- RTL /GET CORES BIT
- SPA CLA /IS THIS ALLOWED TO START A NEW GROUP?
- JMP I (TWOSYS /NO, IT MAY ONLY BE CORESIDENT WITH SOMETHING EARLIER
- TAD NEWPAG /YES
- CIA
- DCA OLDPAG /GOT NEW 'OLDPAG'
- JMP I CHKRES
- ACTIV, JMS CHKRES
- JMP SAMPG
- GET
- SYSBIT
- RAL
- SPA CLA /IS IT A 'SYS' HANDLER?
- JMP I (SETSY /YES
- JMS I (GETSLOT /NO
- JMS I (SETSLT /SET BLOCK SLOT
- DCA I XR1
- TAD NEWPAG
-HNDLOC, DCA I XR4 /STORE AWAY ADDRESS OF HANDLER (OR 0 IF PREVIOUSLY USED)
- JMS I (GETDCB
- DCA I XR2 /SET DCB
- GET /HASH CODE NAME
- PRMNM2
- DCA TEMP /SAVE 2ND WORD
- GET
- PRMNM1
- TAD TEMP /ADD 2 WORDS
- DCA TMP1 /SAVE SUM
- TAD TEMP
- SNA CLA /WAS 2ND WORD 0?
- JMP NO4C /YES
- TAD TMP1 /NO, FORCE BIT 0 ON
- RAL
- STL RAR
- DCA TMP1
-NO4C, TAD TMP1 /TAKE CODED NAME
- DCA I XR3 /SET PERMANENT NAME TABLE
- GET
- CORES
- RTL /GET CORESIDENT BIT
- SMA CLA /IS IT RESIDENT?
- JMP NORE /NO
- GET /YES
- ENTPT /GET RELATIVE ENTRY POINT
- AND [177
- TAD [7600 /CORESIDENT ENTRY POINTS TO SYS MUST BE ON PAGE 7600
-NORE, DCA I XR5 /SET RESIDENCY TABLE
-INACT, GET /BUT MAYBE IT'S 'DSK'
- DSKBIT
- RTL
- SNL CLA /IS IT DSK?
- JMP SLTLUP /NO, IT'S TO BE IGNORED
- JMS I (SLOTDSK /YES ASSIGN 'DSK''S LOCATION SLOT
- GET /GET RID OF DSK BIT
- DSKBIT
- RTL
- CLL RTR
- PUT
- DSKBIT
- JMP SLTLUP /REITERATE
- SAMPG, TAD SLOT /ALREADY HAVE SLOT
- JMS I (SETSLT
- DCA I XR1
- JMP HNDLOC
-
-GOTEM,
-CORE, 0
- TAD I [7777
- AND [70
- CLL RTR
- RAR
- SNA
- JMS I (RELCOR
- JMP I CORE
- PAGE
- / STEPS IN BOOTSTRAPPING:
-
-/1. ASSIGN DSK, IF SPECIFIED, MAKE SURE NFS [BOOT2]
-/2. ASSIGN SLOTS [BOOT2A]
-/3. GIVE ERROR IF TOO MANY ACTIVE OR TOO MANY SLOTS [BOOT2A]
-/4. BUILD INTERNAL COPIES OF DCB, SLOT, NAME, RES [BOOT2A]
-/5. ALSO BUILD HANDLER ADDRESS TABLE, CONTAINS [BOOT2A]
-/ HANDLER ADDRESS IF NOT PREVIOUSLY WRITTEN OUT
-/6. COMPARE DCB'S OF NEW AND OLD SYSTEM, IF DIFF, [BOOT3]
-/ COPY SYSTEM OVER. LEAVE NEW SYSTEM HANDLER
-/ IN CORE
-/7. ASK GUY ABOUT NEW DIRECTORY [BOOT4]
-/8. READ IN USR, UPDATE ITS TABLES, WRITE OUT USR [BOOTC]
-/ NAME TABLE, DHIT (SLOT, 2-PAGE,ENTPT)
-/9. READ IN CURRENT PAGE 7600 IMAGES [BOOT5]
-/ SET UP AS FOLLOWS:
-/ PG7600/L: BOOT
-/ PG7600/H: 07600 IMAGE
-/ BLOK66/L: 17600 IMAGE
-/ BLOK66/U: 27600 IMAGE
-/ THIS IS ACCOMPLISHED VIA:
-/ PG7600_0
-/ BLOK66_66
-/ IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
-/10. MOVE DCB AND RESIDENCY TABLES INTO 17600 IMAGE [BOOT6]
-/11. MOVE BOOTSTRAP INTO PAGE 7600 IMAGES (2 PLACES) [BOOT7]
-/12. WRITE OUT HANDLERS [BOOT8]
-/13. ZERO DIRECTORY IF REQUESTED [BOOTD]
-/14. PUT SYS, DATA BREAK, CORE LIM IN 07600 IMAGE [BOOTE]
-/15. WRITE 7600 IMAGES BACK OUT ONTO TAPE [BOOTF]
-/ IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
-/ 0_PG7600
-/ 66_BLOK66
-/16. READ BACK PAGE 7600 IMAGES. MOVE IN FIELD 1 STUFF
-/ EXCEPT FOR CD AREA, RESTORE TODAY'S DATE,
-/ BRANCH TO 7600
- GETSLOT,0
- ISZ SLOT /USE NEXT SLOT
- TAD SLOT
- TAD (-26
- SNA CLA
- JMP I (NOSLOT
- TAD SLOT
- JMP I GETSLOT
-
-BOOT, ISZ I (RETSW /***?
- CLA IAC
- DCA I (BD /DISABLE 'BUILD' CMD
-/SEE IF ARGUMENT WAS GIVEN; TREAT IT AS BOOT DEVICE,
-/SAVE HANDLER ADDRESS (MUST BE AN ACTIVE HANDLER)
- JMS I (LOCSYS /IN CASE DSK=SYS
-/ JMS I [GETNUM
-/ NOP
-/ TAD SIZE
-/ DCA BOOTDV /CHECK THAT # IS GT 7600
-BOOT2, TAD DSKG1 /FIND OUT ABOUT 'DSK'
- SNA
- JMP GOTD /DSK=SYS
- DCA SAV1
- TAD DSKG2
- DCA SAV2
- TAD DSKP1
- DCA NAME1
- TAD DSKP2
- DCA NAME2
- JMS I [BIGNAM /FIND IT IN TABLES
-GOTD, GET
- DCB
- SMA CLA /IS IT FILE-STRUCTURED?
- JMP I (DSKBAD /NO
- GET /YES
- DSKBIT
- RTL
- STL RTR /TURN ON BIT 1
- PUT
- DSKBIT
- JMP I (BOOT2A
- GETDCB, 0
- GET
- PLATNUM
- JMS I [ROTL
- AND [7 /GET # OF PLATTERS
- SNA
- IAC /0 MEANS 1
- TAD [-1 /SUBTRACT 1
- CLL RTL
- RAL /TIMES 10
- DCA TMP1
- GET
- DCB
- AND [7770 /MASK OFF USEFUL INFO
- TAD TMP1
- JMP I GETDCB
- SLOTDSK,0
- JMS I (CHKRES
- JMP SMPG
- TAD NEWPAG
- DCA I (SBUFF+1
- JMS GETSLOT
- JMS SETSLT
-B, DCA I (SHND+1
- JMS GETDCB
- DCA I (SDCB+1
- TAD (5723 /'DSK' HASHED
- DCA I (SNAME+1
- GET
- SYSBIT
- RTL /SYSBIT TO L, CORES BIT TO AC0
- SNL SMA CLA /IS IT EITHER SYS OR CORESIDENT WITH SYS?
- JMP NORE2 /NO, SO IT'S NOT CORE-RESIDENT
- GET /YES, RESIDENT AT ALL TIMES IN 07600
- ENTPT
- AND [177
- TAD [7600
-NORE2, DCA I (SRES+1
- JMP I SLOTDSK
-
-SETSY, TAD NEWPAG
- DCA I (SBUFF
-/ JMS SETSLT /NO BLOCK SLOT
- DCA I (SHND
- JMS GETDCB
- DCA I (SDCB /SET DCB
- TAD I (SNAME
- SZA CLA
- JMP I (TWOSYS
- TAD (4631 /HASH CODING FOR 'SYS'
- DCA I (SNAME
-/CHECK THAT NAME IS 'SYS'
- TAD [7607
- DCA I (SRES
-/CHECK REL ENTRY PT IS 7
- JMP I (INACT
-
-SMPG, TAD SLOT
- JMS SETSLT
- JMP B
- SETSLT, 0
- SNA
- JMP .+3
- TAD [-15
- JMS I [ROTR
- DCA TMP1
- GET /
- CORES /
- RTL /
- SPA SZL CLA /
- JMP I SETSLT /SYS &CORES HANDLERS GET 0 ENTRY (UNFORTUNATELY)
- GET
- ENTPT
- AND (4177
- TAD TMP1
- JMP I SETSLT
-
-
- PAGE
- USRBLK=13 /BLOCK OF USR ON SYSTEM DEVICE
- USRNPT=36 /POINTS TO USR PTR TO PERMANENT DEVICE NAME TABLE
- USRHPT=37 /POINTS TO USR PTR TO DEVICE HANDLER INFORMATION TABLE
-
-BOOTC, TAD [200 /READ FIRST BLOCK OF USR
- JMS I [SYS
- BUFFER /INTO BUFFER
- USRBLK
- TAD I [BUFFER+USRNPT /GET POINTER TO NAME TABLE
- TAD [BUFFER-400 /ADD IN OFFSET FOR RELOCATION
- DCA T1AD /ASSUME BOTH TABLES OCCUR IN THE SECOND
- TAD I [BUFFER+USRHPT /BLOCK OF THE USR
- TAD [BUFFER-400
- DCA T2AD /GET POINTER TO DHIT
- TAD [400 /READ BLOCKS 2 AND 3 OF USR
- JMS I [SYS /INTO BUFFER,BINARY
- BUFFER
- USRBLK+1
- TAD [-17
- JMS I [MOVE /MOVE IN PERMANENT DEVICE NAME TABLE
- CDF 0
- SNAME
- CDF 0
-T1AD, HLT
-/ TAD SAMSYS /WAS SYS SPECIFIED?
-/ SZA CLA
-/ JMP CHKD2 /YES
-/ TAD I T2AD /NO, USE CURRENT SYS INFO
-/ DCA I (SHND
-/CHKD2, TAD DSKG1
-/ SZA CLA /WAS DSK SPECIFIED?
-/ JMP MVSHND /YES
-/ TAD I T2AD /MAKE SAME AS SYS
-/ DCA I (SHND+1
-MVSHND, TAD [-17 /NOW PUT IN SLOT WORDS (DHIT)
- JMS I [MOVE
- CDF 0
- SHND
- CDF 0
-TMP2,
-T2AD, HLT
- TAD [4400 /RE-WRITE USR
- JMS I [SYS
-L5400, BUFFER
- USRBLK+1
- JMP I [BOOT5
- IFNZRO BUFFER-5400 <ERRRR,XX>
- BOOTD, TAD DRECT /WANT NEW DIRECTORY?
-SNACLA, SNA CLA
- JMP BOOTE
- TAD L5400 /YEP. WRITE ONE
- JMS I [SYS
- DPROPR
- 1
-BOOTE, TAD NEWCOR
- CLL RAL
- RTL
- TAD SAVHID /V3D SET NEW H.O. DATE WORD
- DCA I [7777 /SET UP NEW CORE LIMIT
- TAD SYSLOC /MOVE IN FRESH COPY OF SYS HANDLER
- TAD [7
- DCA SYSL2
- TAD [7607-7743-1
- JMS I [MOVE
- CDF 10
-SYSL2, HLT
- CDF 0
- 7607
- TAD [-200 /PUT SYS HANDLER INTO REC 0 BUFF. ???
- JMS I [MOVE
- CDF 0
- 7600
- CDF 0
- PG7600+200 /RESIDENT F0 CODE
- JMS I (WRITCC /WRITE CCB AND DATA BREAK FILLERS
- TAD [200
- TAD SYSLOC /MOVE IN COPY OF 27600 AGAIN
- DCA SYSL3
- TAD [-200
- JMS I [MOVE
- CDF 10
-SYSL3, HLT
- CDF 10
- BLOK66+200
- JMP I (BOOTF
-
-DRECT, -1 /1 MEANS WRITE A ZERO DIRECTORY
- /0 MEANS DON'T TOUCH DIRECTORY
- /-1 MEANS ASK GUY FOR OPTION
- /SEE IF NEW SYSTEM HAS SAME DCB AS CURRENT SYSTEM
-/THIS MAY WELL CAUSE EXTRA I/O WHEN GOING FROM RF08=K TO RF08=M
-
-BOOT3, CDF 10
- TAD I (DATEWD
- DCA SAVDAT /SAVE TODAY'S DATE FOR FUTURE REFERENCE
- TAD I (DCBTBL /GET DCB OF CURRENT SYSTEM
- CDF 0
- AND [7770
- DCA TMP2
- JMS I (PATCH /V3D
- TAD SAVLOC /DON'T COPY IF DID 'BUILD'
- SNA CLA /WAS THE 'BU' COMMAND USED?
- TAD [-10 /NO, USE 'SZA CLA'
- TAD SNACLA /YES, USE 'SNA CLA'
- DCA I (BOOTQ
- JMS SETUPSYS
- TAD SYSDCB
- CIA
- TAD TMP2
- JMP I (BOOTQ
-
-/NOTE: THIS PROCEDURE DOESN'T COPY BOOTSTRAP IF NEW DEV=OLD DEV.
-/ THEREFORE YOU CAN'T CHANGE BOOTSTRAPS
-/ CHECK ON AFFECT FOR TD8E/ROM INTERACTION
- SETUPSYS,0
- DCA SAVLOC
- TAD SAVLOC
- DCA I (SAVLC
- JMS I (LOCSYS
- JMS I [GETPG /GET PAGE OF SYS HANDLER
- DCA SYSLOC /PAGE OF START OF NEW SYSTEM HANDLER
- JMS I (GETDCB
- DCA SYSDCB
- JMS I (GETLEN
- GET
- TWOPAG
- DCA I (SYSSIZ
- TAD I (SYSSIZ
- SMA CLA /IS IT 1- OR 2-PAGES?
- JMP ONEPG /GUESS WHAT THIS MEANS [HINT LOOK AT LABEL]
- STA
- TAD I (AMTCOR
- SNA CLA
- JMP I (NOTNUF /WE CAN'T RUN IN 8 K
-ONEPG, TAD [-400
- JMS I [MOVE
- CDF 10
-SYSLOC, HLT /MOVE SYSTEM HANDLER
- CDF 10
-SAVLOC, 0 /TO 10000-10377
- JMP I SETUPSYS
- PAGE
- FIRST, 0 /SUBROUTINE FOR LDABS IN FIELD 2
- TAD KLUD
- DCA NEWLIM
- CIF CDF 20
- JMP I FIRST
-
-/0: LOADING OS/8
-/-2: LOADING HEADER OF HANDLER
-/-1: LOADING HANDLER
-
-HND, CDF 20 /DATA FIELD 2
- TAD I (ORIGIN
- DCA KLUD
- TAD TABLMT
- CIF CDF 20 /BACK TO FIELD 2
- JMP I (ORI
-
-KLUD, 0
-NEWLIM, 0 /NEW END OF DESCRIPTORS
-
-
-OK, STA /NOW USE ORIGIN TO TELL US HOW BIG A
- CDF 20
- TAD I (ORIGIN /HANDLER WAS LOADED
- CDF 00 /BACK TO OUR FIELD
- AND [7600
- TAD [200 /REMEMBER THAT ORIGIN IS ONE GREATER
- DCA HNDPTR /THAN ACTUAL LAST LOCATION.
- /BETTER TO USE 2-PAGE BIT
- TAD NEWLIM
- DCA TABLMT /SET NEW TABLE TOP
- DCA I TABLMT /NEED 0 AT END
- JMS I [COMMA
- JMP I (LOAD
-
-
-
-NMER, CIF 10 /V3C
- JMS I [200 /DISMISS USR FROM CORE
- 11
- JMP I (NAMERR
-
- IOPEN, 0 /PREPARE TO READ INPUT
- CLA CMA
- DCA I (CHCNT
- TAD I (JMPX /RESTORE SWITCH
- DCA I (JMPGET
- TAD I (FILPTR /RESULTS OF LOOKUP
- DCA I (RECNO
- DCA I (REOF
- TAD (CDF 0
- CDF 20 /OFF TO FIELD 2
- DCA I (XFIELD /SETUP LDABS FOR FIELD 0
- CDF 00 /BACK TO FIELD 0
- JMP I IOPEN
- PAGE
-
-/BLOCK 0 OF DEVICE CONTAINS INITIAL IMAGE
-/OF 17600 FOLLOWED BY 07600
-
-/17600-17646 CD AREA INITIALLY CONTAINS BOOTSTRAP
-/17647-17665 RESIDENCY TABLE
-/17666 DATE
-/17667-17677 PART OF OS/8 KBM
-/17700-17740 PART OF OS/8 USR
-/17741-17757 USER DEVICE NAME TABLE/ODT
-/17760-17776 CONTROL WORD TABLE (DCB)
-/17777 UNUSED
-
-/07600-07606 PART OF OS/8 CODE
-/07607-07743 SYSTEM HANDLER
-/07744-07745 STARTING ADDRESS
-/07746 JOB STATUS WORD (JSW)
-/07747 MUST BE 0 (SOFSET)
-/07750-07755 DATA BREAK LOCATIONS RESERVED FOR HARDWARE
-/07756-07775 KBM AND ODT
-/07776 MUST BE 0 (SBLOCK)
-/07777 SOFTWARE CORE SIZE, BATCH FLAGS
-
-/IF SYSTEM HANDLER IS TWO PAGES LONG, THEN WE HAVE INSTEAD:
-
-/BLOCK 66 (LOWER) CONTAINS 17600 IMAGE
-/BLOCK 66 (UPPER) CONTAINS 27600 IMAGE (MUST END WITH 4 ZERO'S)
-/BLOCK 0 (LOWER) CONTAINS BOOTSTRAP
-/BLOCK 0 (UPPER) CONTAINS 07600 IMAGE
- *4000
-DSCADV, 0 /ADVANCE TO NEXT DESCRIPTOR
- /RETURN 2 MEANS NO MORE
- /RETURN 1 MEANS NOW AT BOOTSTRAP BLOCK
- /RETURN 3 OTHERWISE
- TAD DSCPTR
- TAD [HDRSIZ
- DCA DSCPTR
- JMS I (SKPCRD /SKIP A POSSIBLE GROUP COUNT
- TAD I DSCPTR
- CLL
- TAD [200
- SZL CLA
- JMP I DSCADV /TAKE RETURN1 UPON REACHING BOOTSTRAP RECORD
- ISZ DSCADV
- TAD I DSCPTR
- SZA CLA
- ISZ DSCADV /TAKE RETURN 2 IF ADVANCED TO END
- JMP I DSCADV
-
-/RETURN 1 MEANS NO MORE DESCRIPTORS
-BOTADV, 0
- TAD I DSCPTR
- CIA
- IAC /COUNT IS ONE MORE
- TAD DSCPTR
- DCA DSCPTR /POINT TO BEGIN OF NEXT DESCRIPTOR
- JMS I (SKPCRD
- TAD I DSCPTR
- CLL
- TAD [200
- SZL CLA
- JMP BOTADV+1 /WIERD CASE OF CONSECUTIVE BOOTSTRAPS
- TAD I DSCPTR
- SZA CLA
- ISZ BOTADV /TAKE RETURN1 IF ADVANCED TO END
- JMP I BOTADV
-
-/WIERD CASES CAN OCCUR IF GUY DELETES ALL ENTRY POINTS IN A GROUP SEPARATELY
-
-/DESCRIPTOR ENTRIES:
-
-/FIRST WORD:
-/ 0 MEANS END OF TABLE
-/ -1 TO -20 MEANS GROUP COUNT (NOT NECESSARILY ACCURATE)
-/ -21 TO -400 APPROX MEANS BOOTSTRAP RECORD COUNT
-/ OTHER MEANS DESCRIPTOR
- SYSCPY, 0 /COPY OS/8 SYSTEM
- STA
- TAD I (AMTCOR
- SZA CLA
- TAD [10 /GT 8K
- DCA CORBIT
- TAD CORBIT
- SZA CLA
- JMP COP2
- JMS I [SYSWP /SWAP IN NEW SYS HANDLER
- TAD (7410
- JMS I [SYS /SAVE PART OF BUILD TO MAKE A BIG BUFFER
- 400 /SAVE 400-
- 27 /SAVE IN BLOCK 27
- JMS I [SYSWP /GET BACK ORIGINAL HANDLER
-COP2, TAD [4210
- JMS COPY /COPY BLOCK 0
- 0
- TAD (5610
- JMS COPY /COPY 7-15
- 7
- TAD [4210
- JMS COPY /COPY 26
- 26
- TAD (7410
- JMS COPY /COPY 51-66
- 51
- TAD [4210
- JMS COPY /COPY 67
- 67
- TAD CORBIT
- SZA CLA
- JMP COP3
- JMS I [SYSWP /GET BACK NEW HANDLER FOR A MOMENT
- TAD (3410 /RESTORE CORE WE SAVED
- JMS I [SYS
- 400
- 27
- JMS I [SYSWP /RESTORE ORIGINAL SYS HANDLER
-COP3, JMP I SYSCPY
- COPY, 0
- TAD CORBIT
- DCA TMP1
- TAD I COPY
- DCA COPREC /ARG 1 CONTAINS FIRST BLOCK TO COPY
- TAD COPREC
- DCA CPREC2 /MAKE TWO COPIES
- STL RAR /CONVERT 'WRITE' TO READ
- TAD TMP1
- JMS I [SYS /READ FROM ORIGINAL DEVICE
- 400
-COPREC, HLT
- JMS I [SYSWP
- TAD TMP1
- JMS I [SYS /WRITE ON NEW DEVICE
- 400
-CPREC2, HLT
- JMS I [SYSWP /LEAVE WITH ORIGINAL SYSTEM HANDLER STILL IN SYSTEM
- JMP I COPY /FALL THROUGH RECORD NUMBER
- CORBIT,
-GETLEN, 0
- GET /GET LENGTH OF DEVICE
- PLATNUM
- JMS I [ROTL /GET NUMBER OF PLATTERS
- AND [7
- SNA
- IAC /0 MEANS 1
- CIA
- DCA COUNT
- GET
- DEVSIZ
- DCA TMP1
-SIZLUP, TAD TMP1
- SNA
- STA /4096 BECOMES 4095
- ISZ COUNT
- JMP SIZLUP
- CIA
- TAD [70 /LEAVE ROOM FOR OS/8
- DCA DLENGTH
- JMP I GETLEN
-
-DPROPR, -1 /INITIAL EMPTY DIRECTORY
- MFREE
- 0
- 0
- -1
- 0 /1 EMPTY FILE
-DLENGT, 0
-
-
-BADARG, JMS I [PRWD
- TEXT /?ARG/
- JMP I [CONFIG
- PAGE
- /WANT TO COPY
-
-/SYS 0
-/KBM 7-12
-/USR 13-15
-/ENTER 26
-/CD 51-53
-/SAVE,DATE 54-55
-/ERR 56
-/CHAIN 57
-/ODT 60-63
-/CCL 64,65,67
-/SYS 66
-
-/EXTRA (DON'T WANT TO COPY):
-
-/HANDLERS 16-25
-/SCRATCH 27-50
-
-/NEW ALGORITHM:
-
-/SET FIELD 2 IF 12K OR MORE AND SKIP *'ED ITEMS
-
-/1. MOVE NEW SYS HANDLER TO 0,200
-/2.* SAVE 34 PAGES STARTING AT 10400 IN BLOCK 27 OF NEW DEVICE
-/3. COPY BLOCKS 7-15
-/4. COPY BLOCK 26
-/5. COPY BLOCKS 51-66
-/6. COPY BLOCK 67
-/7.* RESTORE 34 PAGES
- /THE FOLLOWING ROUTINES AND VARIABLES MUST BE ABOVE THE LOCATIONS
-/IN WHICH OS/8 AND CD LOAD INTO, BECAUSE THEY ARE CALLED BY LDABS.
-/FURTHERMORE, NONE OF THESE ROUTINES MAY USE PAGE 0 LITERALS
-/OR MAY USE ANY PAGE 0 TEMPORARIES, EXCEPT THAT SOME MAY USE
-/PAGE ZERO TEMPORARIES IF THE STORE INTO THEM FIRST
-/(EXCEPT THOSE COMMENTED OTHERWISE, WHICH MUST PRESERVE
-/THE NEW PAGE 0 AT ALL COSTS, UNTIL IT IS WRITTEN OUT
-
-/LDABS
-/ICHAR
-/BADINP
-/OVER
-/ASSEMB
-/CTCTST
-/PRWD
-/CTRLC
-/OVROUT
-/ROTL
-/PRINTE
-/TTYOUT
-/ROTR
-/PWORD
-/ECHOFL
-/LINEUP
-/CRLF
-/PRNT
-/RUBFLG
-/MOVE
-/SYSWP
-/AMTCOR
- SYDCB=7760 /LOCATION OF SYS,DSK DCB WORDS
-
-BOOT5, JMS I (RECZRO
-BOOT6, TAD [-17
- JMS I [MOVE /PUT RESIDENT FIELD 1 TABLES INTO
- CDF 0
- SDCB /FIXED SPOTS
- CDF 10
- BLOK66+160
- TAD [-17
- JMS I [MOVE
- CDF 0
- SRES
- CDF 10
- BLOK66+47 /COULD SET USER DEVICE NAMES HERE IF DESIRED
-BOOT7, JMS I (LOCSYS
-/ TAD SAMSYS
-/ SZA CLA /SAME SYSTEM?
-/ JMP BOOT8 /YES
-BLOOK, ADVDSC /SEARCH FOR BOOTSTRAP
- JMP FNDBOT /FOUND BOOTSTRAP RECORD AMONGST DESCRIPTORS
- HLT /IT WASN'T THERE!
- JMP BLOOK /KEEP LOOKING
-
-FNDBOT, TAD DSCPTR
- IAC /POINT TO BOOTSTRAP
- DCA FROMBO
- TAD I DSCPTR /LENGTH OF BOOTSTRAP
-/CHECK THAT'S IT'S LE 47 LOCS IF 1-PAGE SYSTEM
- JMS I [MOVE
- CDF 0
-FROMBO, HLT
- CDF 0
- PG7600
- TAD [-47 /MOVE FIRST 47 LOCS INTO CD AREA IN 17600 IMAGE
- JMS I [MOVE
- CDF 0
- PG7600
- CDF 10
- BLOK66
-BOOT8, TAD (-16
- DCA COUNT
- TAD (SBUFF
- DCA XR1
- TAD (SHND
- DCA XR2
-DVLOOP, TAD I XR1
- SNA
- JMP NOHN
- DCA DVBUF /LOCATION OF HANDLER
- TAD I XR2
- JMS I [ROTL
- AND [17
- SNA
- JMP CN /NO BLOCK SLOT
- TAD L15 /CONVERT TO ACTUAL BLOCK #
- DCA DVREC
- TAD [4210
- JMS I [SYS
-DVBUF, HLT
-DVREC, HLT
-CN, ISZ COUNT
- JMP DVLOOP
- JMP I (BOOTD
-NOHN, ISZ XR2
- JMP CN
-
-SYSSIZ, 0 /MINUS MEANS 2-PAGE SYS HANDLER
- CTRLC, KCC /CLEAR ^C FLAG
- TAD I (SWAPER /DO WE HAVE TO SWITCH?
- SZA CLA
- JMS I (SYSWP /YES. INSERT OLD HANDLER
- JMP END /GO CHECK BATCH BEFORE RETURNING
-
-KORE, JMS I [GETNUM
-L15, 15 /NOTHING MEANS 0
- TAD SIZE
- AND [7770
- SZA CLA
- JMP I [BADARG /MUST BE BETWEEN 0 AND 7
- JMS I (RELCOR /FIND REAL AMOUNT OF CORE
- CMA
- TAD SIZE
- SMA CLA
- JMP I (NOTNUF /MUST BE .LE. REAL AMT OF CORE
- TAD CHAR
- SZA CLA
- JMP I [SYNTAX
- TAD SIZE
- DCA NEWCOR
- JMP I [CONFIG
- / IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
-/ 0_PG7600
-/ 66_BLOK66
-
-BOOTF, TAD SYSSIZ
- SMA CLA /IS NEW SYS TWO PAGES?
- TAD [-200 /NO
- JMS I [MOVE /YES, NULL MOVE
- CDF 10
- BLOK66
- CDF 0
- PG7600
- TAD [4200
- JMS I [SYS
- PG7600
- 0
- TAD [4210
- JMS I [SYS
- BLOK66
- 66
-BOOTG, NOP
-/ JMS I (RECZRO /SIMULATE BOOTSTRAP
- TAD [-131 /MOVE UP FIELD 1 CODE
- JMS I [MOVE
- CDF 10
- BLOK66+47
- CDF 10
- 7600+47
- TAD SAVDAT
- CDF 10
- DCA I (DATEWD
- CDF 0
- JMS I [PRWD
- TEXT /SYS BUILT/
-
-
-
-/MUST DO SOME CLEAN UP IF BATCH IS RUNNING
-/ALL OVERLAYED CODE MUST BE RESET IN CASE USER WANTS
-/TO REUSE THIS COPY OF BUILD.
-
-END, JMS I BATT /JUMP TO BATCH TEST ROUTINE FOR CLEAN UP
- JMP I [7600 /OTHERWISE GO HOME WITH NEW SYSTEM
- /THIS IS FROM BATCH
- PAGE
-
-
-/MOVE MOVES CORE AROUND (CALLABLE FROM ANY FIELD)
-
-/ TAD (-# OF LOCS TO MOVE
-/ JMS MOVE
-/ CDF FROM FIELD
-/ FROM BUFFER LOCATION START
-/ CDF 'TO' FILED
-/ TO BUFFER
-
-/MUSTN'T DESTROY OS/8 LOCS, NO PAGE 0 TEMPS!
-
-MOVE, 0
- DCA MVCT
- RDF
- TAD (CIF CDF
- DCA MOVRET
- TAD I MOVE /GET CDF FROM-FLD
- DCA MVCDF2
- ISZ MOVE /POINT TO FROM-BUF
- TAD I MOVE /GET LOC TO MOVE
- DCA MVTM1
- ISZ MOVE /POINT TO TO-CDF
- TAD I MOVE
- DCA MVDF /GET CDF TO FIELD OF DESTINATION
- ISZ MOVE /POINT TO TARGET AREA
- TAD I MOVE
- DCA MVTM2
- ISZ MOVE /POINT TO RETURN
- TAD MVCT
- SNA CLA
- JMP MOVRET /NOTHING TO MOVE
-MVCDF2, CDF 0 /GETS ALTERED TO PICK UP F1
- TAD I MVTM1
-MVDF, HLT
- DCA I MVTM2
- ISZ MVTM1 /BUMP POINTERS TO AREAS
- ISZ MVTM2
-MV20, 20
- ISZ MVCT
- JMP MVCDF2
-MOVRET, HLT /RETURN TO CALLING FIELD
- JMP I MOVE
-
-CTCTST, 0
- TAD MV7600 /ALLOW FOR PARITY
- KRS
- TAD (-7603
- SNA CLA
- KSF
- JMP I CTCTST
- JMP I (CTRLC
- MVCT, 0
-
-
-ASSEMB, 0 /ASSEMBLE TWO 6 BIT WORDS
- CDF 20
- TAD I LWD1
- JMS I PROTL
- TAD I LWD2
- CDF 00
- JMP I ASSEMB
-
-LWD1, WD1
-LWD2, WD2
-PROTL, ROTL
-
- BOOT4, TAD I (DRECT
- SMA CLA
- JMP I (BOOTC /HE'S SPECIFIED ABOUT DIRECTORY ZERO
- JMS I [PRWD /YES, NO NEED TO COPY SYSTEM
- TEXT /WRITE ZERO DIRECT?/
- TAD [-10 /DON'T WANT TO DESTROY PRECIOUS TABLES
- JMS I [GTEXT /GET REPLY
- JMP BOOT4
- JMS I [GNAME
- TAD NAME1
- AND [7700
- TAD (-3100
- SNA CLA
- CLA IAC /Y
- DCA I (DRECT /NO; COULD HAVE SAVED LOCATION BUT I FEEL SAFER THIS WAY
- JMP I (BOOTC
-
-MVTM1,
-ROTL, 0
- CLL RTL
- RTL
- RTL
- JMP I ROTL
-
-MVTM2,
-ROTR, 0
- CLL RTR
- RTR
- RTR
- JMP I ROTR
- TTYOUT, 0 /YOU GUESSED IT
- DCA TM
- TAD ECHOFL
- SZA CLA /ARE WE ECHOING?
- JMP I TTYOUT /NO
- TAD TM /YES
- TLS
- TSF
- JMP .-1
-MV7600, 7600 /CLA
- JMS I (CTCTST /TEST FOR ^C.
- JMP I TTYOUT
-
-TM,
-SKPCRD, 0
- TAD I DSCPTR
- CLL
- TAD MV20 /A GROUP COUNT MUST BE IN THE RANGE -1 TO -20
- SNL CLA
- JMP I SKPCRD
- ISZ DSCPTR /IT'S A DARN GROUP COUNT, GO PAST IT
- JMP SKPCRD+1 /WIERD CASE OF CONSECUTIVE GROUP COUNTS
-
-ECHOFL, 0 /1 MEANS NOT ECHOING, SAW ^O
- PATCH, 0
- TAD I [7777 /V3D
- AND L600
- DCA SAVHID /SAVE HIGH ORDER DATE BITS
- JMP I PATCH
- PAGE
- PRNAME, 0 /ROUTINE TO PRINT NAME1-NAME4
- TAD (NAME1
- DCA TEMP
- CLL STA RTL /-3
- DCA COUNT
-PRNM2, TAD I TEMP
- JMS PRINTE /TYPE OUT CHARS
- ISZ TEMP
- ISZ COUNT /EXHAUSTED ALL?
- JMP PRNM2
- TAD I TEMP
- SNA CLA
- JMP I PRNAME /NO . IF NO EXTENSION
- TAD (". /PRINT '.'
- JMS I (TTYOUT
- TAD I TEMP
- JMS PRINTE
- JMP I PRNAME
-
-PRINTE, 0
- DCA CHTMP2
- TAD CHTMP2 /EXTRACT LEFT HAND SIDE
- JMS I (ROTR
- JMS PWORD
- TAD CHTMP2
- JMS PWORD
- JMP I PRINTE
- PWORD, 0
- AND (77
- SNA /IF NULL, GET OUT
- JMP NULL
- DCA PRTM
- TAD (200
- KRS
- TAD (-217 /^O
- SNA CLA /STOP ECHOING?
- KSF /MAYBE
- SKP /NO
- JMP CTO /YES
- TAD PRTM
- TAD (240
- AND (77
-PRSPAC, TAD (240
- JMS I (TTYOUT
- JMP I PWORD
-NULL, TAD LINEUP
- SNA CLA /PRINT SPACE?
- JMP I PRINTE /NO
- JMP PRSPAC /YES
-
-PRWD, 0
- CLA
-PRWD2, TAD I PRWD
- JMS PRINTE
- TAD I PRWD
- ISZ PRWD
- AND (77
- SZA CLA
- JMP PRWD2
- JMP I PRWD /LEAVE IF LAST WORD ENDED WITH 00
-
-CHTMP2, 0
-
-CTO, KCC
- TAD ("^
- JMS I (TTYOUT
- TAD ("O
- JMS I (TTYOUT
- JMS CRLF
- CLA IAC
- DCA I (ECHOFL
- JMP I PWORD
-
-LINEUP, 0 /NON-ZERO MEANS PRINT NULLS AS SPACES
- OVER, JMS I (ASSEMB /EXTENSION OF LDABS.
- CIA
- CDF 20 /OFF TO FIELD 2
- TAD I LCKSUM /CHECKSUM OK?
- CDF 00 /BACK TO OUR FIELD
- SZA CLA
- JMP BADINP /SOORY ABOUT THAT
- CLA IAC
- JMP OVROUT /SKIP ERROR EXIT
-BADINP, JMS PRWD
- TEXT /?BAD INPUT/
- JMS CRLF
-OVROUT, CDF 20
- TAD I (LDABS
- CDF 00
- DCA OTEMP
- JMP I OTEMP
-OTEMP, 0
-
-
-LCKSUM, CKSUM
-PRTM, 0
- CRLF, 0
- TAD (215
- DCA NAME1
- JMS PRNT
- TAD (212
- JMS I (TTYOUT
- JMP I CRLF
-
-PRNT, 0 /CHARACTER PRINT ROUTINE
- TAD ("\ /IF NOT RUBOUT, AND IF RUBOUT WAS
- ISZ RUBFLG /LAST, ECHO \.
- SKP CLA
- JMS I (TTYOUT
- TAD NAME1
- JMS I (TTYOUT
- JMP I PRNT
-RUBFLG, 0 /RUBOUT FLAG
- PAGE
- /ASSUMES NEW PROPOSED SYSTEM HANDLER IS IN 10000-10377
-
-/CAN'T DESTROY OS/8, IE. CAN'T USE PG 0 TEMPS
-
-SYSWP, 0 /ROUTINE TO MOVE SYS HANDLER AROUND
- ISZ SWAPER /DIDDLE SWAP INDICATOR
- CLA CMA /-1 MEANS NEW HANDLER IS IN
- DCA SWAPER
- STA
- TAD AMTCOR
- SNA CLA /DO WE HAVE 8K?
- JMP SWAPLW /YES, DON'T SWAP WITH FIELD 2
- TAD L7600 /NO, CAN'T HURT TO SWAP FIELD 2
- DCA OUT
- TAD SAVLC
- TAD P200
- DCA IN
- TAD (4-200
- DCA STEMP /SWAP ENTIRE PAGE (EXCEPT LAST 4 LOCATIONS)
-SWAP3, CDF 10 /SWAP 27600 & 2ND PAGE OF HANDLER
- TAD I IN
- DCA SYSQ
- CDF 20
- TAD I OUT
- CDF 10
- DCA I IN
- TAD SYSQ
- CDF 20
- DCA I OUT
- ISZ IN
-L7400, 7400 /NOP
- ISZ OUT
-L7600, 7600
- ISZ STEMP
- JMP SWAP3
-SWAPLW, CDF 0
- TAD (7607
- DCA OUT /7607 ALWAYS TARGET DESTINATION
- TAD SAVLC
- TAD (7
- DCA IN
- TAD (7607-7743-1/ONLY 7607-7743 GETS MOVED
- DCA STEMP
-SWAP2, CDF 10
- TAD I IN
- DCA SYSQ /TEMP STORE
- CDF 0
- TAD I OUT
- CDF 10
- DCA I IN
- TAD SYSQ
- CDF 0
- DCA I OUT
- ISZ IN
- ISZ OUT
- ISZ STEMP
- JMP SWAP2
- DCA I (SOFSET /V3C
- JMP I SYSWP
-
-AMTCOR, 1 /HIGHEST CORE BANK
-SAVLC, 0 /MUST BE ABOVE 3577
-CHTMP,
-IN, 0 /POINTS TO HANDLER AREA AT ONE NAMED SYS
-OUT, 0 /POINTS TO 7607 HANDLER
-SWAPER, 0 /-1 MEANS NEW HANDLER IN
-
-/MUST BE ABOVE OS/8, NO PAGE 0 LITERALS
-
-STEMP,
-ICHAR, 0
- JMS I (CTCTST
- ISZ JMPGET /POINT TO CORRECT CHAR
- ISZ CHCNT /NEED WE READ?
-JMPX, JMP JMPGET /NOT YET
- TAD REOF /YES. DID LAST YIELD EOF?
- SZA CLA
- JMP I (BADINP /SOMETHING IS WRONG.
-RDIN, JMS I DVICE
-P200, 0200 /READ INTO FIELD 0
-BINBUF, BINARY
-RECNO, 0
- JMP RERROR /READ ERROR
-RECNO2, ISZ RECNO /POINT TO NEXT RECORD
- TAD (-601
- DCA CHCNT /NEW CHARACTER COUNT
- TAD BINBUF
- DCA CHPTR
- TAD JMPX
- DCA JMPGET /RESET JUMP SWITCH
- JMP ICHAR+1
-SYSQ,
-JMPGET, JMP . /IF WE GET CAUGHT HERE, WE KNOW IT
- JMP CHAR1 /ASSEMBLE FIRST CHAR
- JMP CHAR2 /SECOND CHAR
- TAD JMPX /THIRD CHAR HERE
- DCA JMPGET /RESET SWITCH
- TAD I CHPTR
- AND L7400
- CLL RTR
- RTR
- TAD CHTMP /ADD IN THE LAST TEMP STORE
- RTR
- RTR
- ISZ CHPTR /TO NEXT CHAR
- JMP GCHCOM
-CHAR2, TAD I CHPTR
- AND L7400
- DCA CHTMP /SAVE FOR THIRD CHAR
- ISZ CHPTR
-CHAR1, TAD I CHPTR
-GCHCOM, AND (377
- ISZ ICHAR /PASS UP ERROR RET
- JMP TO20 /RETURN
-RERROR, SPA CLA /FATAL, OR EOF?
- JMP IOERR /FATAL
- ISZ REOF /END OF FILE
- JMP RECNO2 /BACK TO MAINSTREAM
-IOERR, JMS I (PRWD
- TEXT \?I/O\
-TO20, CIF CDF 20 /BACK TO FIELD 2
- JMP I ICHAR
-
-
-REOF, 0
-CHCNT, 0
-CHPTR, 0
-DVICE, 0
-RETSW, 0 /0 MEANS RAN FROM 0S/8, 1 MEANS RNA STANDALONE
- PAGE
- LNLNGT=103
-BEGLIN, ZBLOCK LNLNGT
-
- SBLOCK=7776 /??
-/CTCFAK, .+1 /^C MUST NOT RETURN TO ANY SYSTEM.
-/ JMP I CTCFAK /CTCFAK MARKS OUR PLACE DURING
-/ /SYSGEN, AND ^C WILL RETURN TO THAT PLACE.
-/*** THIS STUFF GOES AWAY ON A BOOT
-
-BUILD, CDF 10
- TAD I [7200 /HAS SPECIAL CODE BEEN OVERLAID BY HANDLERS?
- CDF 0
- TAD [-1234
- SZA CLA
- JMP I (NOROOM /YES, TOO BAD
-/ TAD (5601
-/ DCA I [7600
-/ TAD (CTCFAK+1
-/ DCA I (7601
- TAD [6600 /SAVE OLD SYSTEM HANDLER IN 16600
- JMS I (SETUPSYS
-/ JMS CTCFAK
-RDOS8, JMS I [PRWD
- TEXT \LOAD OS/8: \
- JMS RD
- JMP RDOS8
- CIF CDF 10
- JMS I (WROS8
- JMS I (SYSWP
-/ JMS CTCFAK
-RDCD, JMS I [CRLF
- JMS I [PRWD
- TEXT /LOAD CD: /
- DCA DVER
- JMS RD
- JMP RDCD
- CIF CDF 10
- JMS I (WRCD
- TAD I (RETSW
- SNA CLA /NOT IF FROM SCRATCH
- JMS I (SYSWP /GET OLD HANDLER IF ANY BACK IN
- JMP I [CONFIG
- RD, 0
- TAD [-40
- JMS I [GTEXT
- JMP I RD
- JMS I (SETUP
-DVER, JMP I (NODEV
- JMS I (SYSWP /PUT IN NEW HANDLER
- CIF CDF 10
- JMS I (SAVE
- JMS I (SYSWP
- CIF CDF 20 /OFF TO PAGE 2
- JMS I [LDABS /PAST HERE PAGE 0 IS GONE
- JMP I RD
- JMS I (SYSWP
- ISZ RD
- JMP I RD
- PAGE
- *6400
-
-DSCTAB, ZBLOCK 1200
- /RELIC:
-
- *7600
- 0 /ONLY LOADED FROM PAPER TAPE.
-
- *7777
- 0 /SET SOFTWARE CORE SIZE TO 'UNKNOWN'
- FIELD 1
- *0
- 0 /FORCE ABSLDR TO LOAD THIS PAGE
- *400
-/ ZBLOCK 5400
- 0
- *6600
-
- RELOC BINARY
-
-BINPUN, CDF 10
- CLA
- TAD (-400
- CIF 0
- JMS I (MOVE
- CDF 10
- 6600
- CDF 0
- BINARY /MOVE ONESELF DOWN
- CIF CDF 0
- JMP I (LDR /EXECUTE IN FIELD 0
-LDR, JMS LEDER /PUNCH 72 FRAMES OF 200
- DCA CHECK /0 CHECKSUM
- TAD (102
- JMS CKSUMM
- JMS PNCH
-STARTB, JMS I (CRLF
- TAD ("*
- JMS I (TTYOUT
- TAD (-100
- JMS I (GTEXT
- JMP STARTB
- JMS I (GETNUM
- JMP I (OVERB
- TAD SIZE
- AND (7770
- SZA CLA
- JMP STARTB
- TAD SIZE
- CLL RTL
- RAL
- DCA FLD
- JMS I (GETNUM /GET LOWER LIMIT
- JMP STARTB
- TAD SIZE
- DCA LIM1
- JMS I (GETNUM /GET UPPER LIMIT
- JMP STARTB
- TAD SIZE
- DCA LIM2
- TAD LIM2
- CMA
- TAD LIM1
- DCA COUNT2
- TAD FLD
- TAD (300
- JMS PNCH
- TAD FLD
- TAD (CDF 0
- DCA BUFLD
- TAD LIM1
- JMS I (ROTR
- AND (77
- TAD (100
- JMS CKSUMM
- TAD LIM1
- AND (77
- JMS CKSUMM
-BUFLD, HLT
- TAD I LIM1
- JMS I (ROTR
- AND (77
- JMS CKSUMM
- TAD I LIM1
- AND (77
- JMS CKSUMM
- ISZ LIM1
- ISZ COUNT2
- JMP BUFLD
- CIF CDF 0
- JMP STARTB
- LEDER, 0 /PUNCH LEADER/TRAILER
- TAD (-200
- DCA COUNT2
- TAD (200
- JMS PNCH
- ISZ COUNT2
- JMP .-3
- JMP I LEDER
-
-PNCH, 0
- PLS
- PSF
- JMP .-1
- CLA
- JMP I PNCH
-
-FLD, 0
-LIM1, 0
-LIM2, 0
-COUNT2, 0
-CHECK, 0
-
-CKSUMM, 0
- DCA CK1
- TAD CK1
- TAD CHECK
- DCA CHECK
- TAD CK1
- JMS PNCH
- JMP I CKSUMM
-
-CK1, 0
- PAGE
- OVERB, TAD Q300
- JMS I QPNCH /FIELD 0
- TAD Q176
- JMS I QCKSUM
- JMS I QCKSUM /*7600
- TAD Q74
- JMS I QCKSUM
- STL CLA RTL
- JMS I QCKSUM /HALT
- TAD Q177
- TAD Q77
- JMS I QCKSUM /*7777
- JMS I QCKSUM
- JMS I QCKSUM /*0000
- TAD Q102
- JMS I QCKSUM
- JMS I QCKSUM
- TAD I QCHECK
- JMS I QROTR
- AND Q77
- JMS I QPNCH
- TAD I QCHECK
- AND Q77
- JMS I QPNCH
- JMS I QLEDER
- HLT
- JMP .-1 /ALL DONE
-Q300, 300
-QPNCH, PNCH
-Q176, 176
-QCKSUM, CKSUMM
-Q74, 74
-Q177, 177
-Q77, 77
-Q102, 102
-QCHECK, CHECK
-QROTR, ROTR
-QLEDER, LEDER
- PAGE
-
- RELOC
- DIRLOC=1400 /FROM OS/8 ASSEMBLY
-
- READ=JMS I (7607
- WRITE=READ
- MFREE=70
- ERR=JMS I (WRERR
-
- *7200
-
-
- 1234 /MAGIC NUMBER WHICH IF NOT HERE, MEANS HANDLERS OVERLAID
-
-WROS8, 0
- CIF 0
- TAD Z7600
- JMS I (MOVE /SAVE CURRENT 7600
- CDF 0
- 7600
- CDF 0
- 7000 /IN 07000
- TAD (-7 /MOVE 6600 TO 7600
- CIF 0
- JMS I (MOVE
- CDF 0
- 6600
- CDF 0
- 7600
- TAD (-34 /FINISH MOVING FIELD 0
- CIF 0
- JMS I (MOVE
- CDF 0
- 6744
- CDF 0
- 7744
- CDF 0
- TAD (6 /V3D DEV EXT LENGTH OF ABSLDR
- TAD I (DLENGTH /FILL IN INITIAL LENGTH
- CDF 10
- DCA I (DIRLOC+14 /OS8 HAS INITIAL DIRECTORY
- CIF 0;WRITE;4200;7400;0;ERR /INITIAL REC.0
- CIF 0;WRITE;4200;7400;66;ERR /ALSO WRITE RECORD 66
- CIF 0;WRITE;4210;DIRLOC;1;ERR /INITIAL DIRECTORY
- CIF 0;WRITE;5000;0;7;ERR /KBM
- CIF 0;WRITE;4610;0;13;ERR /USR
- CIF CDF 20 /OFF IN FIELD 2
- JMP I (BAK
-WHER, CDF 0 /RETURN FROM RELOCATED ROUTINES.
- TAD I (RETSW
- CDF 10
- SNA CLA /SCRATCH BUILD?
- JMP I (RES76 /NO
- TAD Z7600 /YES /MOVE 17600 UP THERE
- CIF 0
- JMS I (MOVE
- CDF 0
- 7400
- CDF 10
-Z7600, 7600
- JMS I (RESTORE
- CIF CDF 0
- JMP I WROS8
-
-/RELATIONSHIP BEWTWEEN OS/8 CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
-
-/ITEM CORE LOC BLOCKS
-
-/KBM 0000-1777 7-12
-/OVERLAYS 2000-3577 54-57
-/INIT DIR DIRLOC- 1
-/ABSLDR CCB LDRCTL- 70
-/INIT BLOCK 0 7400-7777 0
-/USR 10000-11377 13-15
-/ABSLDR 12000-14377 71-75
-/ENTER 13400-13577 26
-/EXT MEM SAVE & ODT 64
-/SYS 06600-06606 PART OF 07600
-/SYS 06744-06777 "
-WRCD, 0
- CIF 0;WRITE;4600;0;51;ERR /CD
- CIF 0;WRITE;5011;0;60;ERR /ODT
-
-/THE NEXT ROUTINE IS TO FINISH LOADING BLOCK 64 OF THE
-/SYSTEM DEVICE THAT HAD BEEN RESERVED. THE FIRST PART
-/WAS WRITTEN WITH OS8 AND NOW THE OTHER PART MUST BE
-/WRITTEN ON THAT SAME BLOCK FROM CD.
-
- CIF 0;READ;210;0;64;ERR /GET PART OF ODT WRITTEN
- /MOVE LOCATIONS 11600-11663 TO 10000-10063
- CIF 0
- TAD (-64
- JMS I (MOVE
- CDF 10
- 1600
- CDF 10
- 0000
- CIF 0;WRITE;4210;0;64;ERR
-
-/END OF ROUTINE TO LOAD BLOCK 64
-
- JMS I (RESTORE
- JMS I (CASIT
- CIF CDF 0
- JMP I WRCD
- PAGE
- READ=JMS I (7607
- ERR=JMS WRERR
-
-/SPECIAL CODE TO CHAIN TO ABSLDR, TO READ IN MCPIP
-
- JMS I (7700
- 10 /LOCK USR IN CORE
- TAD R7600 /ZERO CD AREA
- DCA CDPTR
- TAD (-47
- DCA CDKNT
- DCA I CDPTR
- ISZ CDPTR
- ISZ CDKNT
- JMP .-3
- STL CLA RAR /ALTMODE
- DCA I (7642
- JMS I (200
- 12 /INQUIRE
- 4503 /ENCODE CSA0
-CDN, 0
- 0
- HLT
- TAD CDN /TAKE DEVICE NUMBER
- DCA I (7617 /STORE DEVICE NUMBER OF CASSETTE
- ISZ I (7620 /V3C FORCE BLOCK 1
- CLA IAC
- CDF 0 /V3D
- DCA I (7746 /SET JSW SO CHAIN DOESN'T DO USROUT
- CDF 10
- JMS I (200 /CHAIN TO ABSLDR
- 6
- 70
- RESTORE,0
- CIF 0;READ;3701;0;BLDSAV;ERR
- CIF 0;READ;3510;0;BLDSAV+20;ERR /RESTORE BUILD
- JMP I RESTORE
- WRITE=JMS I (7607
- ERR=JMS WRERR
-
-SAVE, 0
- CDF 0
- DCA I (SOFSET
- DCA I (SBLOCK
- DCA I (DRECT /HAVE TO KEEP DIRECTORY LATER
- CDF 10
- CIF 0;WRITE;7701;0;BLDSAV;ERR
- CIF 0;WRITE;7510;0;BLDSAV+20;ERR
- JMS CASIT
- CIF CDF 0
- JMP I SAVE
-
-RES76, TAD I (Z7600
- CIF 0
- JMS I (MOVE
- CDF 0
- 7000 /RESTORE OLD PAGE 7600
- CDF 0
- 7600
- JMP I (Z7600
- WRERR, 0 /WRITE ERROR
- HLT CLA /HIT CONTINUE TO RETRY
- TAD WRERR
- TAD (-6
- DCA WRERR /POINT BACK TO CIF OF CALL
- JMP I WRERR /RETRY
-
-/RELATIONSHIP BETWEEN CD CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
-
-/ITEM CORE LOC BLOCKS
-/CD 00000-01377 51-63
-/ODT 10000-11777 60-63
-
-CSA, 0 /CASSETTE HANDLER ENTRY PT
-CDPTR, 0
-
-CDKNT,
-CASIT, 0
- CDF 0
- TAD I (RECNO
- SNA
- CLA IAC /IF BLOCK 0, CHANGE TO 1
- DCA I (RECNO
- TAD I PRETSW
- SNA CLA /BUILDING FROM SCRATCH?
- JMP I CASIT /NO
- TAD I (BLDCB /YES, GET DCB OF LOAD HANDLER
- AND L770
- TAD M270 /CASSETTE DEVICE CODE=27
- SZA CLA
- JMP I CASIT /NOT A CASSETTE
- TAD I (DVICE
- DCA CSA /GET HANDLER ENTRY POINT
- CDF 10
- CIF 0
- JMS I CSA
- 3 /SKIP TO NEXT FILE
-L770, 770
-M270, -270
-R7600, 7600 /IGNORE ERRORS
- CIF 0
- JMS I CSA
- 100 /DUMMY READ A PAGE
- BINARY /TO SKIP HEADER
-PRETSW, RETSW
- SKP CLA /WANT AN ERROR
- HLT /A GOOD READ IS BAD!
- JMP I CASIT
-
-
-/INITIALIZATION CODE FOR BATCH OPERATION
-
-
-
- FIELD 2
-
-*10
-BATXR1, 0 /INDEX REG. 1 FOR BATCH
-BATXR2, 0 /INDEX REG. 2 FOR BATCH
-
-
-*200
-
-BATSET, 0
- TAD I (XR1 /GET THE OVERLAY POINTER
- SZA /IF ZERO USE OLD VALUE
- /THIS SAVES ME SOME FIELD 0 SPACE
- DCA BATXR1 /SAVE THE POINTER
- TAD I [7777 /NOW GET THE BATCH FIELD
- CDF 20 /TO FIELD 2
- AND (0070 /NOW GET THE FIELD BITS
- TAD (CIF /MAKE A CIF FOR OVERLAY
- DCA CBATI /SAVE IN INPUT ROUTINE
- TAD CBATI /ALSO OUTPUT
- DCA CBATO /OVERLAY
-
-BATMOV, TAD I BATXR1 /GET NEXT STORAGE ADDRESS
- SNA /IF ZERO ALL DONE (SECOND TIME THRU)
- JMP BATDON /RETURN TO CALLER
- DCA BATXR2 /OTHERWISE SAVE POINTER TO TARGET CODE
-BATLUP, TAD I BATXR1 /GET A PATCH WORD
- SNA /ZERO MEANS END OF THIS PATCH
- JMP BATMOV /GO GET ANOTHER POINTER OR MAYBE ALL DONE
- CDF 0 /BACK TO FIELD ZERO
- DCA I BATXR2 /NOW CODE IS BATCHABLE
- CDF 20 /BACK TO FIELD 2
- JMP BATLUP /DO IT ALL AGAIN
-
-BATDON, CIF CDF 0 /RETURN TO CALLER
- JMP I BATSET /BYE
-
-
-BATLS, TTYIN /POINTER TO MOVE DATA
- CBATI=. /SET CIF BATCH
- RELOC TTYIN+1 /RELOCATABLE CODE
- CIF
- JMS I BATINI /JUMP TO GET INPUT FROM BATCH
- HLT /BAD ERROR
- SKP /SKIP OVER POINTER
-BATINI, 5400 /POINTER TO BATCH INPUT ROUTINE
- 0 /TERMINATOR
-
- TTYOUT+5 /NOW FOR OUTPUT
- RELOC
- CBATO=. /SET FOR CIF BATCH
- RELOC TTYOUT+6 /POINTER TO MOVE DATA
- CIF /CIF BATCH
- JMS I .+1 /GO SEND DATA TO BATCH
- 7400 /POINTER TO BATCH OUTPUT PROCESSOR
- 0 /TERMINATOR
-
-
- LFMOD /POINTER TO LINE FEED MOD
- RELOC LFMOD+1 /RLOCATE THE CODE
- RDTXT /IGNORE LINE FEEDS
- 0 /TERMINATOR
-
- BATTST+1 /POINTER TO MODIFY BATCH TEST
- RELOC BATTST+2 /RELOCATE THE CODE
- JMP BATBK /JUMP AROUND THE BATCH SWITCH TEST
- /WITH A NEW SYSTEM THE TEST IS ILLOGICAL
- /WHICH IS THE CASE IF A BOOT IS REQUESTED
- 0 /TERMINATOR
- RELOC
-
- 0 /FINAL OVERLAY TERMINATOR
-
-
-
-/NOW COMES THE RESET CODE TO PUT THINGS BACK
-/ THE WAY THEY WERE TO BEGIN WITH.
-
- TTYIN /POINTER TO MOVE DATA
- RELOC TTYIN+1 /RELOCATABLE CODE
- KSF /SKIP ON FLAG
- JMP .-1
- KRB /READ A CHAR
- SNA /LOW LEVEL BLANK IGNORE
- JMP TTYIN+1 /GO GET ANOTHER
- 0 /OVERLAY TERMINATOR
-
- TTYOUT+5 /NOW FOR OUTPUT
- RELOC TTYOUT+6 /RELOCATE AGAIN
- TLS /PRINT THE CHAR
- TSF /DONE?
- JMP .-1 /NO.
- 0 /OVERLAY TERMINATOR
-
- LFMOD /POINTER TO LINE FEED MOD
- RELOC LFMOD+1 /RELOCATE ONE MORE TIME
- LFEED /LINE FEED..ECHO CURRENT COMMAND
- 0 /TERMINATOR
-
- BATTST+1 /POINTER TO BATCH TEST
- RELOC BATTST+2 /RELOCATE THE CODE
- TAD I [7777 /RESET THE CODE TO ORIGINAL STATE
- 0 /OVERLAY TERMINATOR
-
- RELOC
- 0 /FINAL OVERLAY TERMINATOR
- PAGE
-
-
-/LDABS DOES A REAL LIVE ABSLOAD IF AC=0
-/IF AC=-2 THEN IT IS LOADING A HANDLER, THIS IS DONE AS FOLLOWS:
-/SEARCH FOR *0
-/THEN LOAD CONSEC WORDS INTO DESCRIPTOR TABLE
-/AT NEXT ORIGIN, LOAD WORDS INTO HANDLER AREA (ALLOW ORIGINS)
-
-/CAN'T USE PAGE 0 LITERALS IN CASE LOADING OS/8
-
-LDABS, 0
- DCA LODTST /-2 IF HANDLER, 0 IF OS8
-LDABS2, TAD JMPNXT
- DCA TSTO0
- DCA CKSUM /CLEAR CHECKSUM
- JMS I (ICHA /GET A BUFFER CHAR
- JMP LDAB /NO INPUT FOUND
- SNA
- JMP .-3 /IGNORE BLANKS
- TAD (-200
- SZA CLA /IS IT LEADER?
- JMP BADIN /WASN'T 200..PROBABLY NOT BINARY
-LEADER, JMS I (ICHA
- JMP LDAB /STRANGE....ALL LEADER!!!
- SNA
- JMP LDABS2 /START OVER.BLANKS AFTER LEADER
- TAD (-200 /IS IT STILL LEADER?
- SNA
- JMP LEADER /YES
-NEWWD, SMA /IS IT < 200?
- JMP FIELDW /NO.TEST FOR FIELD SEETING
- TAD (200 /RESTORE CHARACTER
- DCA WD1
- JMS I (ICHA
- JMP BADIN /EOF BETWEEN WORDS. HOW NICE!
- DCA WD2
- JMS I (ICHA
- JMP BADIN
- TAD (-200 /200 FINISHES US UP
- SNA
- JMP OVE
- DCA WD
- JMS I (ASSEM /ASSEMBLE LAST WORD READ
- SZL /IS IT AN ORIGIN?
- JMP ORGTST /YES
-XFIELD, HLT /GETS CDF N
- DCA I ORIGIN /STORE THIS WORD
-CDF20, CDF 20
- ISZ ORIGIN /SHOULD NEVER SKIP, BUT...
-LD7, 7
- TAD ORIGIN
- TAD (200 /GIVE ERROR IF ORIGIN ADVANCES TO 7600
- SZA CLA
- JMP .+3 /SKIP AROUND ERROR
- CIF CDF 0 /ERROR IN FIELD 0
- JMP I (NOROOM
-NEXT, TAD WD1
- TAD WD2 /MAKE UP CHECKSUM
- TAD CKSUM
- DCA CKSUM
- TAD WD
- JMP NEWWD
-
- ORGTST, DCA ORGX /TEST FOR ORIGIN
- TAD LODTST /GET POINTER TO PROPER ORIGIN
- SNA CLA
- JMP .+3
- CIF CDF 0 /JUMP TO HANDLER TEST
- JMP I (HND
- TAD ORGX /OS/8 - USE REAL ORIGIN
-ORI, DCA ORIGIN /BUFFER AREA
- TAD LODTST /HANDLER LOAD?
- SNA CLA
- JMP NEXT /NOPE
- TAD ORGX /DON'T START LOAD UNTIL *0 IS FOUND
- SZA CLA
-TSTO0, JMP NEXT
- DCA .-1 /FOUND *0..DO THE LOAD
- ISZ LODTST /YES. BUMP LODTST TO LOAD HANDLER NEXT
- JMP NEXT
- TAD XFIELD
- TAD (-CDF 0
- SZA CLA
- JMP .+3 /JUMP AROUND IF NOT FIRST TIME
- CIF CDF 0 /SUBROUTINE IN FIELD 0
- JMS I [FIRST /FIRST TIME THROUGH
-
-
-/DO THIS BETTER; ALSO MAKE SURE HANDLER DOESN(T HAVE A FILED PSEUDO
- TAD (CDF 10
- DCA XFIELD /AT THIS POINT, WE START
- CLA CMA /LOADING THE HANDLER INTO THE
- DCA LODTST /AREA SPECIFIED BY HNDORG+1
-/CHECK 'ORIGIN' TO SEE IF HEADER WAS RIGHT SIZE
-/ALSO ELSEWHERE, CAN CHECK ORIGIN WHEN BUMPING TO SEE
-/IF WE HIT ANY MAGIC LOCATIONS
- TAD ORGX /SEE IF LEGAL RE ORIGIN
- CIF CDF 0 /OFF ON FIELD 0
- JMS I (ORGLIM
- DCA ORIGIN /ACTUAL FIELD 1 ORIGIN
-/ TAD SNACLA /LOADING FIELD 1..TEST ORIGINS
-/ DCA JMPRE
-JMPNXT, JMP NEXT
-FIELDW, TAD (-100 /LESS THAN 300 FAILS
- SPA
- JMP BADIN
- DCA WD1
- TAD WD1
- AND LD7
- SZA CLA
- JMP BADIN /DISECT WORD TO CATCH GARBAGE
- TAD LODTST /IF LOADING HANDLER, IGNORE FIELD
- SZA CLA
- JMP FIELD2
- TAD WD1
- AND (70 /EXTRACT FIELD SETTING
- TAD [CDF 0
- DCA XFIELD
-FIELD2, JMS I (ICHA
- JMP BADIN
- TAD (7600
- SZA
- JMP NEWWD
-OVE, CIF CDF 0 /ROUTINE IN FIELD 0
- JMP I [OVER
- LDAB, CIF CDF 0 /BACK TO FIELD 0
- JMP I LDABS /RETURN FROM SUBROUTINE
-
-BADIN, CIF CDF 0 /BACK TO FIELD 0
- JMP I [BADINP /BAD INPUT
-
-
-ORGX, 0
-ORIGIN, 0
-WD1, 0
-WD2, 0
-WD, 0
-CKSUM, 0
-LODTST, 0
- PAGE
- ICHA, 0 /ICHAR CALL ROUTINE FOR FIELD 0
- CIF CDF 0 /OFF TO FIELD 0
- JMS I (ICHAR /JUMP TO ICHAR
- JMP I ICHA /ERROR RETURN
- ISZ ICHA /GOOD RETURN
- JMP I ICHA /RETURN TO CALLER
-
-
-
-ASSEM, 0 /ASSEMBLE A WORD
- /THIS CODE APPEARS IN FIELD 0 ALSO
- TAD I (WD1 /GET WORD 1
- CLL RTL /NOW DO THE ROTATE
- RTL;RTL
- TAD I (WD2 /NOW FOR THE SECOND PART
- JMP I ASSEM /BACK TO CALLER
- PAGE
- WRITEX=JMS I (7607 /OFF TO WRITE TO DEV.
- ERROR=JMS ERRX /ERROR SUBROUTINE
-BAK,
- CIF 0;WRITEX;4111;3400;26;ERROR /ENTER OVERLAY
- CIF 0;WRITEX;4701;2000;54;ERROR /SAVE, DATE, MON ERROR, CHAIN OVERLAYS
- TAD Q200
- CDF 0
- TAD I QLD
- DCA I QLD
- CDF 20
- CIF 0;WRITEX;4101;LDRCTL;70;ERROR /ABSLDR CORE CONTROL BLOCK
- TAD (-114
- CIF 0
- JMS I (MOVE
- CDF 0
- 4264
- CDF 0
- 3464
- CIF 0;WRITEX;4200;3400;64;ERROR
- CIF 0;WRITEX;5210;2000;71;ERROR /ABSLDR
- CIF CDF 10 /BACK TO FIELD 1
- JMP I (WHER
-QLD, LDRCTL+5
-Q200, 200
-
-
-ERRX, 0 /WRITE ERROR
- HLT CLA /HIT CONTINUE TO RETRY
- TAD ERRX
- TAD (-6 /BACK TO TRY AGAIN
- DCA ERRX /AGAIN
- JMP I ERRX /RETRY
-
-
-
- FIELD 0
- *200
- $
-
DELETED src/os8-v3f/CCL.BI
Index: src/os8-v3f/CCL.BI
==================================================================
--- src/os8-v3f/CCL.BI
+++ /dev/null
@@ -1,45 +0,0 @@
-$JOB ASSEMBLE AND LINK CCL.MA
-.MAC OUT:CCLPS<IN:CCLPS.MA
-.MAC OUT:CCLTBL<IN:CCLTBL.MA
-.MAC OUT:CCLCDX<IN:CCLCDX.MA
-.MAC OUT:CCLSIZ<IN:CCLSIZ.MA
-.MAC OUT:CCLCOR<IN:CCLCOR.MA
-.MAC OUT:CCLCD<IN:CCLCD.MA
-.MAC OUT:CCLTAB<IN:CCLTAB.MA
-.MAC OUT:CCLDRV<IN:CCLDRV.MA
-.MAC OUT:CCLAT<IN:CCLAT.MA
-.MAC OUT:CCLSEM<IN:CCLSEM.MA
-.MAC OUT:CCLDAT<IN:CCLDAT.MA
-.MAC OUT:CCLSB2<IN:CCLSB2.MA
-.MAC OUT:CCLREM<IN:CCLREM.MA
-.MAC OUT:CCLMSG<IN:CCLMSG.MA
-.MAC OUT:CCLRUN<IN:CCLRUN.MA
-.MAC OUT:CCLSUB<IN:CCLSUB.MA
-.MAC OUT:CCL<IN:CCL.MA
-.LINK OUT:CCL<OUT:CCL,OUT:CCLTBL,OUT:CCLAT,OUT:CCLMSG$
-*OUT:CCLTAB,OUT:CCLDRV,OUT:CCLPS,OUT:CCLSIZ/F
-/*OUT:CCLSEM
-*=0/N/9
-*=1000/N
-*=1400/N
-*=2000/N
-*=2400/N
-*=3000/N
-*=3400/N
-*=4000/N
-*=4400/N/O
-*OUT:CCLDAT,OUT:CCLCOR/C
-*OUT:CCLSUB/C
-*OUT:CCLSB2/C
-*OUT:CCLCDX
-*/O
-*OUT:CCLCD/C
-*OUT:CCLRUN,OUT:CCLREM
-*$
-.DEL OUT:CCL???.RB
-.COPY OUT:CCL.SV<DSK:CCL.SV
-.DEL CCL.SV
-/CHAIN TO RESORC COMPILE AND LINK
-.SUB RESORC.BI
-$END
-
DELETED src/os8-v3f/CCL.MA
Index: src/os8-v3f/CCL.MA
==================================================================
--- src/os8-v3f/CCL.MA
+++ /dev/null
@@ -1,785 +0,0 @@
-/5 MACREL VERSION OF CCL FOR OS/8 V3D
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,1975,1976,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- MIFILE=7617
- .GLOBAL OUTLIM,OUTSW,COLSET,FNAME1
- .GLOBAL LPTDEV,TTYDEV,DMPDEV,NULDEV,PTPDEV,TVDEV
- .GLOBAL EXSUB,BLK,IOERR
- .GLOBAL LOOK
- .GLOBAL SETLPT,SETPTP,SETTTY,YFORT,YF4,YLOAD,YLOADER
- .GLOBAL DEFILE
- .GLOBAL YAT,ZOW,BATCH,FLAG,RDMON,REGO,REMD,CHAIN
- .GLOBAL DECODE,SCAN,LBEGIN
- .GLOBAL DEFALT,MOVE,TWAIT,NAMPTR
- BEGLN==1000
- XFERV==70 /LOCATION INSIDE USR WHICH IS FREE
- .EXTERNAL SWAPER
-/ .EXTERNAL SEMI
- .EXTERNAL MONFIX
- .EXTERNAL TABLES
- .EXTERNAL AT,CCLBLC,PTBL,SAVL,LEAVE,VERTN,NOCCL
- .EXTERNAL SETDEV,RECALL
- .EXTERNAL CD,CCER1,REMEM,ARLOC
- .EXTERNAL PRMESG,PRINT,CCSUB
- .GLOBAL YCCL
-
- XR2=15
- XR=16
- AMFLAG=17
- T=20
- DELIM=32
- DEFALT=33 /POINTS TO DEFAULT EXTENSION LIST
- PTR=36
- BATSPL=7200 /JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC
- SOFSET=7747
-
-/CCL STARTING ADDRESS: 12000
-/STARTING ADDRESS: 12001
-/CHAIN STARTING ADDRESS:12002
-
-/ JOB STATUS WORD = 2003
-
-/**************************************************
-/
-/ SAVING CCL
-/
-/ .LOAD CCL
-/ .SAVE SYS CCL;12001=2103
-/ .R CCL
-/
-/**************************************************
-
- OV=1375
- MSOVL2=55
- CCLTAB="H /MUST BE UPDATED IF TABLES CHANGE
- CCLNUM="3
- CCLVER="A /CCL VERSION #
-
-/*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY.
-/USE OF SEMICOLONS WITH CCL VERSION I OR LATER
-/REQUIRES BATCH VERSION 7 OR LATER.
-/USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER
-
-/MEMORY ALLOCATION:
-
-/0 0000-0777 KBM
-/0 1000-1777 COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK]
-/0 2000-2777 LINE BUFFER EXTENSION
-/0 3000-3177 PRE-EXTENSION @ BUFFER
-/0 3200-3577 @ BUFFER
-/0 4000-4377 REM-LINES
-/0 4400-4777 INPUT HANDLER FOR CD
-/ ALSO, SEMICOLON BUFFER
-/0 5000-5777 LONGWORD TABLE
-/0 6000-7277 MORE TABLES
-/0 7300-7577 SWITCH POINTER TABLE
- / CHANGES SINCE FIELD RELEASE VERSION:
-
-/1. RECURSIVE 'U' BUG FIXED
-/2. INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED
-/3. BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED
-/4. .SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE
-/5. COMPARE PASSES ALTMODE
-/6. TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP
-/7. BUG RE PASSING DEFAULT * FIXED
-/8. .LS FORM OF .CREF COMMAND REMOVED
-/9. BUG CONCERNING PROCESSOR SWITCHES FIXED
-/10. CCL SWITCH ALLOWED AFTER =N OPTION
-/11. BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED
-/12. EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT
-/13. 'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY
-/14. 'BAD CCL SWITCH' MESSAGE ADDED
-/15. CCL EDIT # CHANGED TO CCL VERSION #
-/16. .EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES
-/17. MUNG PTR: NOW WORKS
-/18. FIXED BUG RE MUNG <CR>
-/19. FIXED BUG RE CD FOR FILE > 2047 BLKS
-/20. FIXED BUG RE MAKE PTR:
-
-/VERSION B FIXES:
-
-/21. ALLOWED 'EDIT' TO COPY FILE EXTENSION
-/22. FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE
-/23. FIXED DATE PROBLEM
-/24. ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED
-
-/VERSION C FIXES:
-
-/25. FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT
-/26. ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE
-/ AS IN DEVICE (IF NONE SPECIFIED)
-/27. ADDED MORE SYNTAX CHECKING TO ZERO COMMAND
-
-/VERSION D CHANGES:
-
-/28. ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' .
-
-/VERSION E CHANGES: (IN-HOUSE ONLY VERSION)
-
-/29. WARNING MSG IF SQUISH SYS: UNDER BATCH
-/30. ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS <
-/31. ADDED HOOKS FOR ; TO BE READY FOR V4
-/32. FIX BUG RE CMD STARTING WITH SPACES
-
-/CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C):
-
-/33. FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC
-/34. INCORPORATED ALL PREVIOUS EDITS
-/35. ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED)
-/36. FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1:
-/37. CORRECTED SPELLING OF SUPERSEDING
-/38. ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS]
-
-/VERSION G CHANGES:
-
-/39. FIXED BUG WITH HELP COMMAND
-/40. FIXED BUG CONCERNING EDIT DEV:_FILE
-
-/VERSION H CHANGES:
-
-/41. ADDED MAC AND LINK COMMANDS
-/42. ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS
-/43. ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS
-/44. ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING
-/45. ALLOWED @ AT BEGINNING OF LINE
-/46. MOVED MOST OF 'DETCOR' TO FIELD 0
-/47. WAIT ROUTINE NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC
-/48. ALLOWED EXEC .BI TO USE BATCH
-/49. TENTATIVELY ADDED SEMICOLON STUFF
-/50. PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH
- /VERSION I CHANGES:
-
-/51. FIRMED UP SEMICOLON STUFF
-
-/VERSION J CHANGES:
-
-/52. DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS:
-/53. -L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME
-
-/VERSION K CHANGES:
-
-/54. DATE NOW HANDLES DATE/78 ALGORITHM
-/55. TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG
-
-/VERSION 1A CHANGES:
-
-/56. FIXED BUG RE NULL INDIRECT CMD FILE
-/57. FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM
-/58. PRINT "OS78" FOR VERSION NAME IF APPLICABLE
-/59. ADDED -N AND -D AND REWROTE LOGIC A BIT
-/60. HELP COMMAND NOW USES HELP.SV
-/61. SET COMMAND NOW USES SET.SV
-/62. 'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD
-/63. ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH)
-/64. ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE)
-/65. ADDED DUPLICATE COMMAND (USES RXCOPY)
-
-/V1B CHANGES:
-
-/66. MODIFIED FORMAT OF MAIN TABLE
-/67. GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT
-/ FILE (EVEN IF NON-FS)
-/68. PRINT KBM VERSION #
-/69. ADDED TERMINATE COMMAND
-
-/V1F CHANGE:
-
-/70. DUPL CALLS RXCOPY IN SPECIAL MODE
-
-/V1G CHANGES:
-
-/71. SOURCE CODE IS NOW MACREL
-/72 LINKER OVERLAYS ADDED
-/73. = ALLOWED IN ADDITION TO _ AND < (IF NOT FOLLOWED BY A DIGIT)
-/74. /C:NNNN ALLOWED FOR NUMERIC ARGUMENT IN ADDITION TO =
-/75. HOOKS FOR MULTIPLE CHARACTER SWITCHES ADDED
-/76. SWITCHES MAY NO LONGER BE EMBEDDED IN A FILENAME
-/77. KNOWN BUG IF SAY MAKE #
-/78 A+B IS IDENTICAL TO A-NB,B
-/79. KNOWN BUG THAT /A-L USES A
-/80. TEMPORARILY REMOVED SEMICOLON STUFF
- / FORMAT OF CCL TABLE
-
-/ENTRY PURPOSE
-
-/ TABLE WIDTH=7 (BUT VARIES)
-
-/0 FLAG WORD
-
- /BIT MEANING IF ON
-
- /0 PERFORM CD (IF 0, OMIT ENTRIES 1-6)
- /1 DON'T PERMIT SPOOLING
- /2 ALLOW .LS, .NB, .MP SWITCHES
- /3 ADD _ TO END OF COMMAND STRING
- /4 SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON)
- /6-8 SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1)
- / 0 MEANS NONE. 7 RESERVED FOR SPECIAL USE.
- /10 CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME
- /11 WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1)
-
-/1 PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES.
-/ IF PTS TO 0, NONE. IF PTS TO 5200, USE SPECIAL MODE.
-
-/2-4 DEFAULT SWITCHES TO BE OR'ED INTO THOSE
-/ EXPLICITLY GIVEN.
-
-/5 ADDRESS OF SUBROUTINE TO BE CALLED
-/ AFTER C.D. HAS BEEN DONE. 0 IF NONE.
-
-/6 PTR TO FILENAME OF PROGRAM
-/ TO BE CHAINED TO. 0 IF NONE.
-
-/ FIELD 0
-
-/1000-1777 LINE BUFFER
-/2000-2777 LINE BUFFER EXTENSION
-/4000-4377 REM-LINES
-/4400-4777 HANDLER
-/5000-5577 BUFFER
-/6000-7577 MORE CCL (7 PAGES)
-
- REST=5000
- .ASECT CCL
- *2000
- .JSW 2103
- .VERSION CCLNUM&77^100+<CCLVER&77>
-
- FIELD 1
-
- FAKBM=404 /PLACE TO FAKE OUT KBM
-
-START, JMP .+3 /START FROM MONITOR
- JMP MONF /START FROM .RUN COMMAND
- JMP MONCHN /START WHEN CHAINED TO
- CLA
- CDF 0 /READ IN REST OF CCL
- TAD I (CCLBLC /GET BLOCK OF START
- DCA I (SOFSET /ALLOW LINKER OVERLAY DRIVER TO WORK
- TAD (7607
- DCA I (7756
- TAD I (SOFSET
- CDF 10
- TAD CCLREM
- DCA CCLREM /GET BLOCK OF REST
- CIF 0
- JMS I (7607
- 1300 /READ 11 MORE PAGES
- REST
-WFL,
-CCLREM, 1+5+1 /SKIP CCB AND *400 STUFF
- JMP I (ERR2
- JMS FIXX
- JMS TWAIT
- CDF 0
- TAD I LVNO
- CDF 10
- TAD (-CCLTAB /DO VERSION #'S AGREE?
- SZA CLA
- JMP I (BADVNO
- JMS I (AT
- TAD (BEGLN-1
- DCA XR
-L$: CDF 0
- TAD I XR
- CDF 10
- SNA
- JMP 2$
- TAD (-";
- SZA CLA
- JMP L$
-/ JMS I (SEMI
- NOP
-2$: STA
- DCA I (REMD /ALLOW RECURSIVE U'S
- CDF 0
- TAD I KENTRY /GET ENTRY #
- CIF CDF 10
- TAD (PTBL /GET ADDRESS OF PTR TO START OF ENTRY
- DCA PTR
- CDF TABLES
- TAD I PTR /GET PTR TO START OF ENTRY
- CDF 10
- DCA PTR
- TAD PTR
-BASPTR, DCA BASPTR
- JMP I (GO
-
-FIXX, 0
- DCA I (XFERV /SET UP STUFF FOR OVERLAY DRIVER
- TAD (SWAPER
- DCA I (XFERV+1
- JMP I FIXX
-
-MONF, JMS FIXX
- JMP I (MONFIX
- MONCHN,
- CIF 0
- JMS I (7607 /READ IN KBM
- 1000 /4 BLOCKS
- 0 /0-1777
- 7 /BLOCK 7 ON SYS:
- HLT /NO WAY TO RECOVER (EVEN 7605 DOES THIS)
- TAD (-44
- JMS I (MOVE /ASSUME COMMAND LINE IS IN
- CDF 10 /17600-17643
- 7600
- CDF 0
- 1000 /MOVE TO OS/8 LINE BUFFER
- CIF CDF 0
-YAT, JMP I KFAKBM /@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO')
- TAD I (SAVL /'YAT' IS JMS'ED TO
- SNA CLA /BY INITIAL @ COMMAND
- JMP I (LEAVE /DO NOTHING IF NO @ GOT EXPANDED (NULL LINE)
-REGO, CIF 0
- JMS I (7607
- 200 /READ ONE BLOCK
- 400 /400-777
- 10 /RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY
- HLT
- JMP I (FAKE
-
-/REGO, TAD KCIDF
-/ CDF 0
-/ DCA I (RETCIF /ALLOW 'FINDIT' TO RETURN TO FIELD 1
-/ CIF CDF 0
-/ STA
-/ DCA I (HALF
-/ DCA I (ENTRY
-/ TAD (KEYWRD
-/ DCA I (KPTR
-/ JMS I (FINDIT /LOOK UP KEYWORD
-/ SMA CLA
-/ JMP PREGO /FOUND IT
-/CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD
-/ ERRCMD
-
- .START START+1,1
- TWAIT, 0
- DCA WFL
- JMS I (BATCH
- JMP TW /BATCH NOT RUNNING
- CLA /WE'RE RUNNING UNDER BATCH
- JMP I TWAIT
-TW, TSF
- SKP /WAIT FOR THINGS TO QUIET DOWN
- JMP I TWAIT
-LVNO, AND I 0 /WASTE SOME TIME
-KFAKBM, AND I 4
-KENTRY, 600
- ISZ WFL
- JMP TW
- JMP I TWAIT /CAN'T WAIT TOO LONG
-FILDMY, FILENAME DUMMY.SV
- 0 /EXTRA EXTENSION WORD
- PAGE
- BADVNO, JMS I (PRINT
- BADVMS
- JMS I (VERTN
- JMP I (LEAVE /GO AWAY
- /THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT
-/IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0
-/IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1
-/IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC.
-DECODE, 0
- TAD (-"9-1 /MIGHT BE CALLED WITH ANY DF
- CLL
- TAD ("9+1-"0
- SZL
- JMP YES$
- TAD ("0-"Z-1
- CLL CML
- TAD ("Z-"A+1
- SNL
-YES$: ISZ DECODE
- JMP I DECODE
- LBEGIN, 0 /PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT
-
-SCAN, 0
- TAD (BEGLN
- DCA T
- CDF 0
- JMS BLSCAN /IGNORE INITIAL SPACES
- JMP 2$
-1$: CLA
- ISZ T
- TAD I T
-2$: SNA
- JMP 3$
- JMS I (DECODE
- SKP CLA
- JMP 1$
- JMS BLSCAN
-3$: DCA DELIM
- STA
- TAD T
- CDF 10
- DCA I (LBEGIN
- JMP I SCAN
-
-BLSCAN, 0
- TAD I T
- TAD (-240
- SZA
- JMP 1$
- ISZ T
- JMP BLSCAN+1
-1$: TAD (240
- JMP I BLSCAN /LEAVE CHAR IN AC
- SETLPT, 0 /COULD BE ONCE ONLY
- TAD (LPTDEV
- JMS I (SETDEV
- JMP I SETLPT
-
-SETTTY, 0
- TAD (TTYDEV
- JMS I (SETDEV
- JMP I SETTTY
-
-SETPTP, 0
- TAD (PTPDEV
- JMS I (SETDEV
- JMP I SETPTP
-
-FAKE, CIF CDF 0
- TAD (MSOVL2
- DCA I (OV /RESTORE LOC SO DATE CMD W ARGS WILL WORK
- JMP I (FAKBM
- SYSER, TEXT \#I/O ERROR ON SYS:\
- GO, JMS I (SCAN /ADVANCE SCAN UNTIL AFTER SPACES
-GO2, CDF TABLES
- TAD I PTR /GET FLAG
- CDF 10
- DCA FLAG /SAVE IT
- TAD DELIM
- SNA CLA /IS TYPED LINE EMPTY AFTER KEYWORD?
- TAD FLAG /AND IS SPECIAL REMEMBERING BITS ON?
- CLL RTR
- RAR /AND HAS GOD WILLED US TO REMEMBER?
- AND (7 /AND ARE THE ZODIAK SIGNS FAVORABLE?
- SNA
- JMP I (NORM /NO
- TAD REMD /YES, GET REM-LINE (SUBTRACT 1)
- DCA REMD
- CDF 0
- TAD I (BEGLN
- CDF 10
- DCA I (NMPTR
- JMS I (RECALL /RECALL LINE
-REMD, -1 /-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE
- DCA DEPN /SAVE DEPENDENT INFO
- TAD I (NMPTR
- SZA CLA /EG COMMAND?
- JMP I (NORM /NO
- ISZ DELIM /YES
- TAD DEPN
- DCA PTR /RESET PTR FROM CMD DEPENDENT WORD
- JMP GO2
-
-DEPN, 0 /REM LINE DEPENDENT INFORMATION
- PAGE
- COLWRD /NEEDED FOR SET TTY COL
-NORM, TAD FLAG
-L7700, SMA CLA
- JMP CHAINN /SKIP ENTRIES IF NO CD
- ISZ PTR /POINT TO DEFAULT INPUT EXTENSION
- CDF TABLES
- TAD I PTR /GET DEFAULT INPUT EXTENSION PTR
- CDF 10
- DCA DEFALT /SAVE IT
- TAD (7641
- DCA XR
- TAD FLAG
- CDF 0
- TAD I PAMFLAG /COMBINE ALTMODE BITS
- CDF 10
- RAR /IN POSITION 11
- CLA RAR /PUT NEW ALTMODE BIT ALONE IN BIT 0
- DCA I XR /STORE AWAY IN C.D. OPTION TABLE
- DCA I XR /V3D ZERO OPTION WORDS
- DCA I XR
- DCA I XR
- DCA I XR /ZERO L.O. =
-L$: ISZ PTR
- CDF TABLES
- TAD I PTR
- SNA
- JMP 2$
- DCA NTEMP
- ISZ PTR
- TAD I PTR /GET VALUE
- CDF 10
- TAD I NTEMP
- DCA I NTEMP /STORE IN SPECIFIED LOCATION
- JMP L$
-2$: CDF 10
- TAD FLAG
- AND (400
- SZA CLA
- JMS I (INSARR /INSERT BACK ARROW IF FLAG BIT SET
- JMS I (CD /PERFORM COMMAND DECODE IF FLAG BIT
- /0 SET
- TAD FLAG
- RAL
- SMA CLA /IS SPOOLING PROHIBITED?
- JMS I (SPOOLIT /NO
-CHAINN, ISZ PTR /POINT TO AFTER CD SUBR
- CDF TABLES
- TAD I PTR /GET SUBR ADDRESS
- CDF 10
- JMS I (JMSUB
- TAD I (DEFILE
- SZA /IS THERE A FILENAME SET TO CHAIN TO?
- JMP ZOW /YES
- ISZ PTR /NO, POINT TO FILENAME
- CDF TABLES
- TAD I PTR
- CDF 10
- SNA
- JMP I (LEAVE /NO FILE TO CHAIN TO
-ZOW, DCA NMPTR
- JMS LOOK /LOOKUP FILE
-NMPTR, 0
- JMP I (CCER1 /NOT FOUND
-CHAIN, JMS I (200 /CHAIN TO IT
- 6 /CHAIN
-
-BLK, 0
-/ -----
-PAMFLAG,AMFLAG
- /LOOK, LOOKS UP FILE ON DEVICE . POINTER IS IN ARG1
-/ ARG2 IS ERROR RETURN IF NOT FOUND
-/DEVICE NUMBER IS IN AC. IF 0, USE SYS:
-
-LOOK, 0
- SNA
- IAC
- DCA DEV
- TAD I LOOK /GET PTR TO FILE NAME IN FIELD 0
- DCA HISFIL
- TAD HISFIL
- AND L7700
- SNA CLA
- JMP FLD1 /PTR LT 100 MEANS IN FIELD 1
- TAD (-3
- JMS I (MOVE /MOVE IT UP
- CDF 0
-BWORD,
-HISFIL, 0
- CDF 10
-PFILDMY,FILDMY
- TAD PFILDMY
-SETN, DCA NAMPTR /STORE AWAY PTR TO FILENAME
- ISZ LOOK /POINT TO ERROR RETURN
- TAD DEV /GET DEVICE NUMBER
- JMS I (200
- 2 /LOOKUP
-NTEMP,
-NAMPTR, 0
- 0
- JMP I LOOK /TAKE ERROR RETURN IF NOT FOUND
- TAD NAMPTR /STORE STARTING BLOCK # IN 'BLK'
- DCA BLK
- ISZ LOOK /POINT TO NORMAL RETURN
- JMP I LOOK /RETURN
- FLAG, 0
-DEV, 0
-
-FLD1, TAD HISFIL
- JMP SETN
-
-/SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC
-
-BATCH, 0
- CDF 0
- TAD I (7777
- CDF 10
- DCA BWORD
- TAD BWORD
- RTL
- SNL CLA /IS BATCH RUNNING?
- JMP I BATCH /NO
- TAD BWORD /YES
- AND (70 /ISOLATE FIELD OF BATCH
- TAD (CIF /FORM CIF TO THE HIGHEST FIELD
- ISZ BATCH /AND TAKE SKIP RETURN WITH IT IN AC
- JMP I BATCH
- PAGE
- DEFILE, 0 /PTR TO FILENAME TO CHAIN TO
-
-TEMP,
-RDMON, 0
- CDF 10
- CIF 0
- CLA
- JMS I (7607
- 0400 /READ 2 RECORD
- 2000 /LOCATION 2000 FIELD 0
- 7 /BLOCK 7,10
- JMP IOERR
- JMP I RDMON
-
-ERR2, CIF CDF 0
- JMP I (NOCCL
- EXSUB, 0
- TAD BASPTR /PUSH PTR BACK TO BEGIN OF ENTRIES
- JMS I (REMEM /REMEMBER THIS IN DEPENDENT WORD
- 2
- JMP I EXSUB
-
-JMSUB, 0
- SNA
- JMP I JMSUB
- DCA TEMP
- JMS I (CCSUB /LOAD OVERLAY
- JMS I TEMP
- JMP I JMSUB
-
-SPOOLIT,0
- JMS I (BATCH /IS BATCH RUNNING?
- JMP I SPOOLIT /NO
- DCA CB /YES
- CDF 0
- TAD I DEFALT
- TAD (-5200
- SNA CLA
- TAD I DEFALT /LEAVE 5200 IN AC IF SPECIAL MODE
- CDF 10
-CB, HLT /CIF TO FIELD OF BATCH
- JMS I (BATSPL /ALLOW BATCH TO SPOOL STUFF
- JMP I SPOOLIT
- INSARR, 0
- TAD (BEGLN
- DCA XR
- CDF 0
- TAD I XR
- SZA CLA
- JMP .-2
- STA
- TAD XR
- DCA XR
- TAD ("<
- DCA I XR
- DCA I XR
- CDF 10
- STA
- TAD XR
- DCA I (ARLOC /REMEMBER WHERE WE INSERTED A "_"
- JMP I INSARR
- / TAD (-# OF LOCS TO MOVE
-/ JMS MOVE
-/ FROM CDF
-/ FROM LOC
-/ TO CDF
-/ TO LOC
-
-MOVE, 0
- DCA T
- TAD I MOVE /GET FROM CDF
- DCA FRCDF
- ISZ MOVE
- STA
- TAD I MOVE /GET FROM LOC-1
- DCA XR
- ISZ MOVE
- TAD I MOVE /GET TO CDF
- DCA TOCDF
- ISZ MOVE
- STA
- TAD I MOVE /GET TO LOC-1
- DCA XR2
- ISZ MOVE /POINT TO RETURN
- TAD T
- SNA CLA
- JMP I MOVE /V1A IGNORE 0 MOVE
-FRCDF, HLT
- TAD I XR
-TOCDF, HLT
- DCA I XR2
- ISZ T
- JMP FRCDF
- CDF 10
- JMP I MOVE
- OUTSW, -1 /-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE
-
-OUTLIM, 1-MIFILE
- IOERR, JMS I (PRMESG
- SYSER
-BADVMS, TEXT /#CCL 3X OVERLAY AND CCL INCOMPATIBLE/
- AAAA=.
- *BADVMS+3
- CCLTAB&77^100+40
- *AAAA
-COLWRD, 1
-
-COLSET, 0
-/ JMS I (CCSUB
- JMS I (SETTTY
- TAD I (7646
- SNA
- TAD COLWRD
- DCA I (7646
- JMP I COLSET
- PAGE
- .ASECT CCLMOR
- FIELD 0
- *6740
-YCCL, FILENAME CCL.SV
- *.-1
-YFORT, FILENAME FORT.SV
- *.-1
-YF4, FILENAME F4.SV
- *.-1
-YLOADER,FILENAME LOADER.SV
- *.-1
-YLOAD, FILENAME LOAD.SV
- *.-1
-LPTDEV, DEVICE LPT
-TVDEV, DEVICE TV
-TTYDEV, DEVICE TTY
-PTPDEV, DEVICE PTP
-DMPDEV, DEVICE DUMP
-NULDEV, DEVICE NULL
-FNAME1, ZBLOCK 5
-
DELETED src/os8-v3f/CCLAT.MA
Index: src/os8-v3f/CCLAT.MA
==================================================================
--- src/os8-v3f/CCLAT.MA
+++ /dev/null
@@ -1,212 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /2 CCL INDIRECT COMMAND FILE PROCESSOR
-
- .GLOBAL AT,FUDG,DONB
-
- .EXTERNAL BEGLN,GETSPC,ASSIGN,SETEXT,EXTCM
- .GLOBAL SAVL
- .EXTERNAL DEFALT,LOOKUP,ASADR,LNAME
- .EXTERNAL PRMESG,MOVE
- .EXTERNAL OUTSW,OUTLIM
-
- XR=16
- CLXR=35
- T=20
- LXR=34
- BFR=3000
-
- .RSECT AT1
- FIELD 1
-
-AT, 0
-ATMORE, TAD (BEGLN-1
- DCA LXR
-ATLOOP, JMS I (GLXR
- SNA
- JMP I AT
- TAD (-300
- SZA CLA
- JMP ATLOOP
- TAD LXR
- DCA I (SAVL
- JMS FUDG
- JMS I (GETSPC
- JMS I (ASSIGN
- DCA I (SETEXT
- TAD (EXTCM
- DCA I (DEFALT
- JMS I (LOOKUP
- SZA CLA /V3C
- TAD I (ASADR
- SNA
- JMP I (ATERR /IF NO FILESPEC AFTER @, ERROR
- DCA T
- TAD I (LNAME /GET BLOCK NUMBER
- DCA BLN
- CIF 0
- JMS I T
- 200 /READ 2 PAGES
-NWB, BFR+200 /INTO BUFFER
-COUNT,
-BLN, 0 /FROM THIS BLOCK
- JMP I (ATERR / I/O ERROR
- TAD (-200
- DCA COUNT
- TAD (BFR-1
- DCA XR
- TAD NWB
- DCA T
- CDF 0
-L$: TAD I T
- JMS I (P
- CLL RTR
- RTR
- DCA TEMP$
- ISZ T
- TAD I T
- JMS I (P
- CLL RTL
- RTL
- RAL
- TAD TEMP$
- JMS I (P
- CLA
- ISZ T
- ISZ COUNT
- JMP L$
- JMP I (ATOVER
-
-TEMP$: 0
-
-/ATFIN, TAD LXR
-/ TAD (-BEGLN
-/ SZA CLA
-/ JMP I AT /LEAVE
-/ JMP I (LEAVE /LEAVE BECAUSE LINE NOW EMPTY
- FUDG, 0
- DCA I (OUTSW /LOAD HANDLER
- TAD I (OUTLIM
- CIA
- DCA CLXR
- JMP I FUDG
-
-GLXR, 0
- CDF 0
- ISZ LXR
- TAD I LXR
- CDF 10
- JMP I GLXR
-
-DONB, 0 /USED AS A FLAG
- JMP I DONB
- PAGE
- P, 0
- AND (177
- SNA
- JMP CTZ /END AT 0 OR ^Z
- TAD (-32
- SNA
- JMP CTZ
- TAD (32-16 /IGNORE CR,LF,FF,VT
- CLL
- TAD (16-12
- SZL
- JMP 1$
- TAD (212 /FORCE 8-BIT
- DCA I XR
-1$: CLA
- TAD I T
- AND (7400
- JMP I P
- CTZ, CDF 10
- TAD LXR
- DCA ATEND
- STA
- TAD LXR
- DCA LXR /INCASE @ GOES TO EOL
- JMS I (GLXR /SEARCH FOR EOL
- SZA CLA
- JMP .-2
- TAD LXR
- CMA
- TAD ATEND
- DCA ENDLEN
- TAD XR
- CMA
- TAD (BFR /GET LENGTH OF INSERTED STUFF
- DCA NEWLEN
- CDF 0
- TAD I ATEND /GET NEXT CHAR AFTER FILESPEC
- CDF 10 /V3C
- TAD (-"'
- SZA CLA /IS IT AN APOSTROPHE?
- JMP .+3 /NO
- ISZ ENDLEN /YES
- ISZ ATEND /MAKE IT GO AWAY
- TAD ENDLEN
- JMS I (MOVE /MOVE REST OF LINE UP
- CDF 0
-ATEND, 0 /FIRST CHAR POSITION AFTER @ SPEC
- CDF 0
- BEGLN+1000
- TAD NEWLEN /IF 0, 'MOVE' WILL IGNORE IT
- JMS I (MOVE /MOVE IN NEW STUFF
- CDF 0
- BFR
- CDF 0
-SAVL, 0 /POINTS TO @
- TAD NEWLEN
- CIA
- TAD SAVL
- DCA NEWEND
- CLL
- TAD NEWEND
- TAD MB
- SZL CLA
- JMP ATOVER
- TAD ENDLEN
- JMS I (MOVE /MOVE BACK END
- CDF 0
- BEGLN+1000
- CDF 0
-NEWEND, 0 /FIRST POSITION AFTER NEW STUFF
- JMP I (ATMORE /LOOK FOR MORE
-
-MB, -BEGLN-1000
- ATOVER, JMS I (PRMESG
- OVFLOW
-ENDLEN, 0 /- NO. OF CHARS AT END INCLUDING 0
-NEWLEN, 0 /- NO. OF CHARS BEING INSERTED
-
-ATERR, CDF 10
- CLA
- JMS I (PRMESG
- ATIO
- ATIO, TEXT /#BAD FILENAME OR ERROR READING INDIRECT FILE/
-OVFLOW, TEXT /#COMMAND LINE OVERFLOW/
- PAGE
DELETED src/os8-v3f/CCLCD.MA
Index: src/os8-v3f/CCLCD.MA
==================================================================
--- src/os8-v3f/CCLCD.MA
+++ /dev/null
@@ -1,1009 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /4 CCL'S COMMAND DECODER
- .EXTERNAL TABLES,FNAME1
- .EXTERNAL SWTCHS
- .ENTRY GETSPC
-/THE FOLLOWING DON'T HAVE TO BE ENTRY'S BECAUSE THEY ARE LINKED TO
-/FROM THE EXTENSION MODULE (CCLCDX) THAT KNOWS CCLCD IS IN MEMORY
- .GLOBAL LV
- .EXTERNAL EQLPRM,POUND,DNUMB
- MULTI=1 /SET TO 0 TO GET RID OF MULTIPLE CHARACTER SWITCHES
- PTR=36
- .GLOBAL BADEV,CDER2,DVICE /******
- .GLOBAL ASADR,LNAME /*****
- .ENTRY CCER1
- .RSECT CCLCD
- .GLOBAL UNKN
- .EXTERNAL FLAG,MOVE,PRMESG
- .EXTERNAL PRNAME,PRWD
- .EXTERNAL LBEGIN,DECODE
- .EXTERNAL ARLOC
- .EXTERNAL DEFILE
- .ENTRY CD,ASSIGN,LOOKUP,ZEROCD,GLXR
- .EXTERNAL OUTSW,OUTLIM
- .ENTRY GCH,SETDEV,SETEXT
- .ENTRY NMOVE
- .EXTERNAL DONB
- .EXTERNAL NAMPTR
- FIELD 1
- MOFILE=7600
- MIFILE=7617
- MPARAM=7643
-
- XR2=15
- XR=16
- T=20
- TT=21
- DEF=22
- NAME1=23
- NAME2=24
- NAME3=25
- NAME4=26
- NAME5=27
- NMBASE=37
- DEV1=30
- DEV2=31
- DELIM=32
- DEFALT=33 /POINTS TO DEFAULT EXTENSION LIST
- LXR=34
- CLXR=35
- BEGLN=1000
- HNDLR=4400
- CD, 0
- JMS I (CDINIT
-BEGGRP, TAD I (OUTSW
- SNA CLA
- TAD I (BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS
- TAD (MOFILE-1
- DCA CLXR
- JMS I (GETSPC /FAKE-OUT TO GETSPC CAN CAUSE EFFECTIVE BRANCH HERE
- JMS I (ASSIGN
- TAD I (OUTSW
- SNA CLA
- TAD I (LIMDIF /DIFF BETWEEN END OF OUTPUT & INPUT AREAS
- TAD I (OUTLIM /END OF OUTPUT AREA
- TAD CLXR
- SMA CLA
- JMP I (CDER1
- TAD I (OUTSW
- SNA CLA
-LKUPSW, JMP IN$ /ZEROED IF IN "SPECIAL DECODE" MODE
- TAD I (DVICE
- JMS PCLXR
- TAD NAME1
- JMS PCLXR
- TAD NAME2
- JMS PCLXR
- TAD NAME3
- JMS PCLXR
- TAD NAME4
- JMP 2$
-IN$: JMS I (LOOKUP
- JMS PCLXR /STORE LENGTH AND DEV NUMBER
- TAD I (LNAME /GET BLOCK
-2$: JMS PCLXR
- JMS I (CCLSWT
- TAD I (OUTSW
- SNA CLA
- TAD I (FLAG
- CLL RTL
- SPA CLA /FEATURE ENABLED?
- TAD LKUPSW
- SNA CLA
- JMP DLOOK /IN SPECIAL MODE OR ON OUTPUT SIDE
- TAD DELIM
- TAD (-"+
- SNA CLA
- JMP NBS
- TAD DONB
- SZA CLA
- JMP NBS
- TAD (7600 /V1A NOW TAKES ARG IN AC
- JMS I (NMOVE /MOVE NAME TO OUTPUT FILE NAMES
- JMP DLOOK
- NBS, JMS I (ZERR
-DLOOK, STA
- DCA I (DVFLAG
- TAD DELIM
- SNA
- JMP I CD
- TAD (-"[
- SNA
- JMP I (OLENGT
- TAD ("[-"+
- SZA
- TAD ("+-",
- SNA
- JMP I (FILLP /**** JUMPING INTO ROUTINE (IS THIS A BUG?)
- TAD (",-"<
- SZA
- TAD ("<-"_
- SNA
- JMP 5$ /BACK-ARROW (UNDERSCORE) MEANS SAME AS "<"
- TAD ("_-"=
- SZA CLA /SKIP ON AN EQUAL SIGN (=)
- JMP I (CDER2 /BAD CHAR
- JMS I (GLXR
- JMS I (DECODE
- CLL
- STA /LINK=0 MEANS LETTER
- TAD LXR /NOW LINK=1 MEANS LETTER
- DCA LXR
- SZL
- JMP 5$ /= MEANS "<"
- JMS I (EQLPRM /= MEANS = (NUMERIC PARAMETER)
-DL2: JMS I (CCLSWT
- JMP DLOOK
-5$: ISZ I (OUTSW /FOUND BACK-ARROW (<)
- JMP I (CDER2 /TWO BACK-ARROWS
- TAD LXR /GET PTR TO ARROW
- DCA I (ARLOC /SAVE IT ('EDIT' MIGHT NEED IT)
- JMP BEGGRP
-
-PCLXR, 0
- ISZ CLXR
- DCA I CLXR
- JMP I PCLXR
- PAGE
- ZERR, 0
- DCA I (DONB /ZERO 1ST OUTPUT FILE
- TAD (7577
- DCA XR2
- DCA I XR2
- DCA I XR2
- DCA I XR2
- DCA I XR2
- DCA I XR2
- JMP I ZERR
- ASSIGN, 0
- TAD CLXR
- AND I (DVFLAG
- TAD I (OUTLIM
- SMA SZA CLA /CHECK FOR OUTPUT OR FIRST INPUT
- JMP ASNORM /IF DEVICE WAS SPECIFIC,
- /OR IF WE ARE ON THE INPUT SIDE,
- /PROCEED NORMALLY
- TAD NAME1
- SNA CLA
- JMP ASGNST
- TAD DFLTNM+1
- DCA DEV2
- TAD DFLTNM
- DCA DEV1
-ASNORM, TAD DEV1
- DCA AS+1
- TAD DEV2
- DCA AS+2
- TAD I (OUTSW
- SNA CLA /DON'T LOAD HANDLER
- /IF WE ARE ON OUTPUT SIDE OF "_"
- TAD NAME1
-SPKLG1, SNA CLA /OR THERE IS NO FILE NAME TO LOOK UP
- TAD GETHND /GETHND=11 NORMALLY,
- /0 IF IN "SPECIAL DECODE" MODE
- IAC
- DCA AS
- TAD (HNDLR+1 /ALLOW TWO PAGE HANDLERS
- DCA ASADR
- CIF 10
- JMS I (200
-AS, 0
- 0
- 0
-ASADR, HNDLR+1
- JMP I (CDER0
- TAD AS+2
-ASGNST, DCA I (DVICE
- JMP I ASSIGN
- DFLTNM, DEVICE DSK
-GETHND, 11 /1+11=12 (1=FETCH, 12=INQUIRE)
- GETL, 0
- JMS I (GCH
- DCA DELIM
- TAD DELIM
- JMS I (DECODE
- JMP I GETL /NON-ALPHANUM IN CCL SWITCH
- CLA
- TAD DELIM
- AND (77
- ISZ GETL
- JMP I GETL
- CCLSWT, 0
- TAD DELIM
- TAD (-"/
- SNA
- JMP I (SLASH
- TAD ("/-"-
- SZA CLA
- JMP I CCLSWT
- TAD I (OUTSW
- SZA CLA
- JMP I (CDER4 /CCL EXT ON OUTPUT FILE
- TAD (SWTCHS
- DCA DEF
- JMS GETL
- JMP I (CDER44 /NON-ALPHANUMERIC CCL SWITCH
- JMS I (ROTL
- DCA TN$
- JMS GETL
- JMP 1$ /ONE CHAR CCL SWITCH
- TAD TN$
- DCA TN$
- JMS GETL
-1$: SKP CLA /2 CHAR CCL SWITCH
- JMP I (CDER44 /3 CHAR CCL-SWITCH
- TAD TN$
- JMS I (EXTLUK
- CLA
- ISZ DEF
- CDF 0
- TAD I DEF
- DCA G$ /GET PTR TO ARGUMENT PAIR
- TAD I G$ /GET SUBROUTINE
- DCA H$
- ISZ G$
- TAD I G$ /GET ARGUMENT
- CDF 10
- JMS I H$ /CALL SUBR, ARG IN AC
- JMP CCLSWT+1
-G$: 0
-H$: 0
-TN$: 0
- PAGE
- /GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
-/RETURNS WITH DELIMETER IN AC
-/GIVES ERROR MESSAGE IF NAME IS BAD
-
-GNAME, 0
- DCA NAME1
- DCA NAME2
- DCA NAME3
- DCA NAME4
- DCA NAME5
- TAD (NAME1
- DCA NMBASE
- CLA CMA
- DCA PERDSW
- DCA NAMECT
- JMS I (GCH
- TAD (-"#
- SNA
- JMS I (NUMC /BUG IF MAKE COMMAND USES A # (OVERLAYS LOOP)
- TAD ("#
- SKP
-GTNMLP, JMS I (GCH
-P2, DCA DELIM
- TAD DELIM
- TAD (-"%
- SNA
- JMP PER
- TAD ("%-"?
- SZA
- TAD ("?-"*
- SNA
-STARSW, JMP I (CDER6 /"JMP STARNM"
- /IF "SPECIAL DECODE" MODE
- TAD ("*-".
- SNA CLA
- JMP PERIOD
- TAD DELIM
- JMS I (DECODE
- JMP LV
-STARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY
- TAD DELIM
- AND (77
- DCA DELIM
- TAD NAMECT
- TAD (-6
- SMA CLA
- JMP GTNMLP
- TAD NAMECT
- CLL RAR
- TAD NMBASE
- DCA TT
- TAD DELIM
- SNL
- JMS I (ROTL
- TAD I TT
- DCA I TT
- ISZ NAMECT
- JMP GTNMLP
-PERIOD, TAD NAME1
- SZA CLA
- ISZ PERDSW
- JMP I (CDER7 /NULL NAME OR DOUBLE EXTENSION
- ISZ NMBASE
- ISZ NMBASE
- STL CLA RTL /2 (ALLOW 4 CHARACTER EXTENSION)
- DCA NAMECT
- JMP GTNMLP
-LV, CLA
- TAD DELIM
- JMP I GNAME
-
-PER, TAD ("?
- JMP P2
- PERDSW, 0
-NAMECT, 0
- SOFSET=7747
-
-CDER6, CDF 0
- TAD I (7777
- CDF 10
- RAL
- SPA CLA
- JMP CD6E /ERROR IF BATCH IS RUNNING
- TAD I (FLAG
- RTL
- SMA CLA
- JMP CD6E /ONLY IF -LS WORKS
- TAD (-12
- JMS I (MOVE
- CDF 10
- MUNGC
- CDF 10
- 7600
- TAD (-34
- JMS I (MOVE
- CDF 0
- 1000
- CDF 10
- 7612
- DCA I (7646 /SAFETY
- CDF 0
- TAD I (SOFSET
- CDF 10
- DCA BLK
- JMS I (200
- 6 /CHAIN TO CCL.SV
-BLK, 0
-
-
-CD6E, JMS I (PRMESG
- BADSTR
-
- PAGE
- LOOKUP, 0
- DCA LNAME
- TAD NAME1
- SNA CLA
- JMP LKUPST
- TAD I (PERDSW
- TAD NAME4
- SNA CLA
- CLA IAC /FORCE NAMERM NON-0 IF . AND NO EXT
- TAD NAME4
- DCA NAMERM /REMEMBER TYPED EXTENSION
- TAD DEFALT
- DCA DEF
- TAD I (SETEXT
- SNA /HAS AN EXTENSION BEEN SET?
- TAD NAMERM /NO
- SNA /DOES FILE HAVE EXTENSION?
- JMP EXT2 /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
- JMS EXTLUK /LOOK FOR EXTENSION
- SNA CLA /DID WE FIND IT?
- JMP EXT3 /NO, FORCE NULL EXTENSION TO MATCH
-EXT2, CDF 0
- TAD I DEF
- IAC
- SNA CLA
- JMP NEXTEXT /IGNORE -1'S
- TAD NAMERM
- SZA CLA
- JMP EXT3
- TAD I DEF
- DCA NAME4 /SET NEW EXTENSION
-EXT3, CDF 10
- TAD (NAME1
- DCA LNAME
- TAD I (AS+2
- JMS I (200
- 2
-LNAME, 0 /NAME1
-LENGTH, 0
- JMP LFAILD
- TAD NAME4
- DCA I (SETEXT
- ISZ DEF /POINT TO ASSOCIATED CUSP NAME
- CDF 0
- TAD I DEF
- CDF 10
- DCA I (DEFILE /SAVE IT AWAY
- TAD LENGTH
- CLL
- TAD (400
- SNL
-CLACON, 7600 /CLA
- CLL RTL
- RTL
- AND (7760
-LKUPST, TAD DVICE
- JMP I LOOKUP
- LFAILD, TAD NAMERM
- CDF 0
- SNA CLA /WAS THERE AN EXPLICIT EXTENSION?
- TAD I DEF /NO - WAS THERE A DEFAULT EXTENSION?
- SNA CLA
- JMP XYZ
-NEXTEXT,CDF 10
- ISZ DEF /NO EXPLICIT EXT AND YES DEFAULT EXT
- ISZ DEF /POINT TO NEXT POSSIBLE DEFAULT EXTENSION
- JMP EXT2 /AND TRY FOR IT
-
-NAMERM, 0
-DVICE, 0
-
-EXTLUK, 0
- CIA
- DCA T
-1$: CDF 0
- TAD I DEF
- CDF 10
- SNA /AT NULL?
- JMP I EXTLUK /YES
- TAD T /NO
- SNA CLA /MATCH?
- JMP 2$ /YES
- ISZ DEF /NO
- ISZ DEF /POINT TO NEXT ENTRY
- JMP 1$ /TRY AGAIN
-2$: TAD T /RETURN WITH IT IN AC
- CIA
- JMP I EXTLUK
-XYZ, CDF 10
- JMP I (CDER3 /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
- BADSYN, TEXT /#ILLEGAL SYNTAX/
-TOOMAN, TEXT /#TOO MANY FILES/
-/AMBIGY, TEXT /#AMBIGUOUS SWITCH/
-CDER1, JMS I (PRMESG
- TOOMAN
- NFOU, TAD NAME1
- AND (77
- SNA CLA
- JMP I (ONE /ONE-CHARACTER SWITCH
- JMS I (PRNAME
- JMS I (PRMESG
- SWNF
- PAGE
- /TAKES A LETTER OR A DIGIT IN AC
-/AND TURNS ON APPROPRIATE BIT IN OPTION TABLE
-
-SLSHCH, 0
- DCA DELIM
- TAD (MPARAM-1
- DCA T
- TAD DELIM
- JMS I (DECODE
- JMP CDER8
- SZL
- TAD (32
- CMA STL /THE FOLLOWING TURNS
- /ON THE CORRECT OPTION BIT
- DCA TT
-L$: SZL
- ISZ T
- RAR
- SNL
- ISZ TT
- JMP L$
- DCA TT
- TAD TT
- CMA
- AND I T
- TAD TT
- DCA I T
- JMP I SLSHCH
-
-CDER8, CLA
- JMS I (PRMESG
- BADOPT
- ZEROCD, 0
- TAD (-42 /AC MAY BE NON-0
- DCA T
- TAD (MOFILE-1
- DCA XR
- DCA I XR /ZERO THE COMMAND DECODER OUTPUT AREA
- ISZ T
- JMP .-2
- JMP I ZEROCD
-
-GCH, 0
- JMS GLXR
- TAD (-240
- SNA
- JMP GCH+1 /IGNORE SPACES
- TAD (240-"(
- SNA
- JMP OPENP$
- TAD ("(
- JMP I GCH
- JMP GCH+1
-OPENP$: JMS GLXR
- TAD (-")
- SNA
- JMP GCH+1
- TAD (")
- JMS SLSHCH
- JMP OPENP$
-
-GLXR, 0
- CDF 0
- ISZ LXR
- TAD I LXR
- CDF 10
- JMP I GLXR
-
- IFZERO MULTI <
-SLASH, JMS GLXR
- JMS SLSHCH
- JMS GLXR
- DCA DELIM
- JMP I (CCLSWT+1
- >
-
- IFNZRO MULTI <
-SLASH, CDF TABLES /POINT TO SWITCH TABLE POINTER
- TAD I PTR /GET PTR TO SWITCH TABLE
- CDF 10
- JMS I (TRANSL
- JMP I (CCLSWT+1
- >
- OLENGT, TAD I (OUTSW
- AND NAME1 /[N] IS ONLY LEGAL
- /ON THE OUTPUT SIDE OF THE "_"
- SNA CLA /AND ONLY AFTER A FILE NAME
- JMP I (CDER2
- TAD (-4
- TAD CLXR
- DCA NMBASE
- JMS I (DNUMB
- CLL RTL
- RTL
- AND (7760
- TAD I NMBASE
- DCA I NMBASE
- CDF 0
- TAD DELIM
- TAD (-"] /IS THERE A CLOSING BRACKET?
- SNA /IF NOT,
- /"DLOOK" ROUTINE WILL DETECT IT
- JMS GCH
- DCA DELIM
- JMP I (DL2
- SETDSK, 0
- TAD DSKDEV
- SZA
- JMP I SETDSK
- JMS I (200
- 12 /INQUIRE
- 5723 /PACKED ENCODING FOR 'DSK:'
-DSKDEV, 0 /SET TO DEVICE NUMBER
- 0
- HLT /NO 'DSK' !
- TAD DSKDEV
- JMP I SETDSK
- .ENABLE ASCII
- .DISABLE FILL
-MUNGC, TEXT /MUNG WILD,/
- .ENABLE SIXBIT
- .ENABLE FILL
- PAGE
- CCER1, TAD I (NAMPTR
- DCA X$
- TAD (-5
- JMS I (MOVE
- CDF 10
-X$: 0
- CDF 10
- NAME1
-CDER3, TAD (4300
- JMS I (PRWD /#
- JMS I (PRNAME
- JMS I (PRMESG
- NF
-
-CCER2, TAD I (DVNM1
- DCA DEV1
- TAD I (DVNM2
- DCA DEV2
-CDER0, TAD DEV1
- SNA CLA
- JMP I (CDER2 /B DOES NOT EXIST
- TAD (4300 /#
- JMS I (PRWD
- TAD DEV1
- JMS I (PRWD
- TAD DEV2
- JMS I (PRWD
- JMS I (PRMESG
- DNE
- NF, TEXT / NOT FOUND/
-DNE, TEXT / DOES NOT EXIST/
-BADSW, TEXT /#SWITCH NOT ALLOWED HERE/
-BADSW2, TEXT /#BAD CCL SWITCH/
-CONTRA, TEXT /#CONTRADICTORY SWITCHES/
- BKA, 0
- TAD I (LBEGIN
- DCA CLXR
-1$: CDF 0
- ISZ CLXR
- TAD I CLXR
- CDF 10
- SNA
- JMP NOBKR$
- TAD (-"<
- SNA
- JMP I BKA
- TAD ("<-"_
- SNA
- JMP I BKA
- TAD ("_-"=
- SZA CLA
- JMP 1$
- ISZ CLXR /= MEANS _ IF NOT FOLLOWED BY A DIGIT
- CDF 0
- TAD I CLXR
- CDF 10
- JMS I (DECODE
- SKP CLA /NOT A DIGIT
- SNL CLA /MAYBE A DIGIT
- JMP I BKA /= FOLLOWED BY A NON-DIGIT MEANS _
- JMP 1$ /IT'S AN =NNNN
-
-NOBKR$: ISZ BKA
- JMP I BKA
-BADEV, TEXT /#BAD DEVICE/
- PAGE
- CDINIT, 0
- ISZ PTR /POINT TO SWITCH TABLE
- JMS I (200
- 13 /RESET ALL HANDLERS
- CDF 0
- TAD I DEFALT
- CDF 10
- TAD (-5200
- SZA CLA /IS THIS A REQUEST FOR A
- /"SPECIAL DECODE"?
- JMP CDCONT /NO
- TAD ALTLIM
- DCA I (OUTLIM /YES, SET UP THE PROPER LOCATIONS
- TAD ALTDF1
- DCA LIMDIF /TO GET 1 OUTPUT AND 5 INPUT FILES
- TAD ALTDF2
- DCA BEGDIF /ALL OF WHICH ARE
- /5-WORD <DEVICE,NAME> ENTRIES
- DCA I PLKUPS
- TAD STARJM
- DCA I PSTARS /AND ALLOW *
- /AS A FILE OR EXTENSION NAME
- TAD L7600 /STOPS FETCHES IN SPECIAL MODE
- DCA I PSPKG1 /NO HANDLER FETCHES NECESSARY EITHER
- /SINCE NO LOOKUPS
-CDCONT, JMS I (BKA /SCAN AHEAD FOR <
- STA /SKIP RETURN IF NOT FOUND
- DCA I (OUTSW
- JMS I (ZEROCD
- TAD I (LBEGIN
- DCA LXR
- JMP I CDINIT
-/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
-ALTLIM, 1-MOFILE-5
-ALTDF1, MOFILE+5-MPARAM+5
-ALTDF2, 5
-PLKUPS, LKUPSW
-PSTARS, STARSW
-PSPKG1, SPKLG1
-
-BEGDIF, MIFILE-MOFILE
-LIMDIF, MIFILE-MPARAM+2
- /STARJM, RELOC STARNM /DUMP LITERALS AT LAST POSSIBLE MOMENT
-/ JMP STARNM
-/ RELOC
-STARJM, 5200+<STARNM&177>
- SETDEV, 0 /V1A ARG NOW IN AC
- DCA 1$
- CLL STA RAL /-2
- JMS I (MOVE
- CDF 0
-1$: 0 /PTS TO DEVICE NAME
- CDF 10
- DVNM1
- JMS I (SETOUT
- JMP I SETDEV
-
-UNKN, 0
- TAD SETEXT
- SZA
- TAD T /NEG OF SWITCH REQUEST
- SZA CLA
- JMP CCERA /CAN'T HAVE 2ND DEFAULT EXTENSION
- TAD T
- CIA
- DCA SETEXT /SET DEFAULT EXTENSION
- TAD DEFALT /SEE IF IT'S IN COMMAND'S SEARCH LIST
- DCA DEF
- TAD SETEXT
- JMS I (EXTLUK
- SNA CLA /DID WE FIND IT?
- JMP CDER4 /NO
- ISZ DEF /YES
-/ TAD I (JMSUB /ALLOW RECURSIVE CALL
-/ DCA HOLD
- CDF 0
- TAD I DEF
- CDF 10
- JMS I (JMSUB /CALL ITS SUBR
-/ TAD HOLD
-/V1A RECURSIVE CALL NO LONGER THREATENS
-/ DCA I (JMSUB
- JMP I UNKN
-
-SETEXT, 0 /EXT WHICH HAS BEEN SET BY A CCL SWITCH
- CCERA, JMS I (PRMESG
- CONTRA
-CDER2, JMS PRMESG
- BADSYN
-
-L7600,
-CCERB,
-CDER4, 7600 /CLA
- JMS I (PRMESG
- BADSW
-CDER44, CLA
- JMS I (PRMESG
- BADSW2
-CDER7, JMS I (PRMESG
- BADX
- BADSTR, TEXT /#ILLEGAL * OR ?/
-SWNF, TEXT / OPTION UNKNOWN/
-BADOPT, TEXT /#BAD SWITCH OPTION/
- PAGE
- BADX, TEXT /#BAD EXTENSION/
-
-/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
-/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
-/IT GIVES A FATAL ERROR MESSAGE IF BAD.
-GETSPC, 0
- STA
- DCA DVFLAG
- DCA DEV1
-FILLP1, DCA DEV2
-FILLP, JMS I (GNAME
- TAD (-": /AC CONTAINED DELIM
- SNA CLA
- JMP 3$ /IT'S A DEVICE NAME
- DCA NUMC
- TAD (-4
- JMS I (MOVE
- CDF 10
- NAME1
- CDF 0
- FNAME1 /SAVE AWAY FILE NAME
- JMP I GETSPC
-3$: CLA IAC /PARSE FILENAME AFTER DEV:
- TAD I (PERDSW
- TAD NUMC
- SZA CLA
- JMP CDERA /. OR # IN DEVICE NAME
- TAD NAME1
- DCA DEV1
- ISZ DVFLAG
- JMP CDERA /CATCHES A:B:
- TAD NAME2
- JMP FILLP1
-
-DVFLAG, 0
-CDERA, JMS I (PRMESG
- BADEV
-
-NUMC, 0 /USED AS FLAG INDICATING SAW #
- JMS I (POUND
- JMP I NUMC
- NMOVE, 0
- DCA 2$ /V1A ARG IN AC
- TAD I (FLAG
- RTL
- SMA CLA /FEATURE ENABLED?
- JMP I (CCERB /NO
- TAD I (OUTSW
- SZA CLA
- JMP I (CCERB /ON OUTPUT SIDE
- TAD I (MOFILE /V3C
- SNA CLA /DON'T CHANGE OUT DEV IF SPECIFIED
- TAD I (FLAG /LOOK AT 'COPY EXT' BIT
- AND (200
- SNA CLA
- JMP 1$ /IT WASN'T SET
- TAD I (MIFILE /GET FIRST INPUT DEVICE
- AND (17 /ISOLATE DEVICE BITS
- DCA I (MOFILE /FORCE THIS TO BE FIRST OUTPUT DEVICE
-1$: TAD I 2$
- SNA
- JMS I (SETDSK /CHANGE TO 'IAC' TO ALWAYS USE SYS:
- DCA I 2$ /SET DEVICE TO SYS IF NONE
- ISZ 2$
- TAD I 2$ /WAS THERE A SPECIFICATION THERE?
- SZA CLA
- JMP I NMOVE /YES, DO NOTHING
- TAD I (FLAG
- AND (200 /GET 'COPY EXTENSION' BIT
- SMA SZA CLA /'SMA' IS UNNECESSARY
- STA /COPY 4 WORDS IF BIT 4 WAS ON
- TAD (-3 /OTHERWISE ONLY COPY 3 WORDS
- JMS I (MOVE
- CDF 0
- FNAME1
- CDF 10
-2$: 0
- JMP I NMOVE
- ROTL, 0
- CLL RTL
- RTL
- RTL
- JMP I ROTL
-
-JMSUB, 0
- SNA
- JMP I JMSUB
- DCA T$
- JMS I T$
- JMP I JMSUB
-T$: 0
- AMBIG, TAD NAME1
- AND (77
- SNA CLA
- JMP I (ONE
- JMS I (PRNAME
- JMS I (PRMESG
- AMBIGY
-AMBIGY, TEXT / OPTION AMBIGUOUS/
- PAGE
- SETOUT, 0
- TAD I (FLAG
- RTR
- SZL CLA
- TAD (5
- TAD (7600
- DCA OLOC
- TAD I OLOC
- SZA CLA
- JMP I SETOUT /HE'S SPECIFIED SOMETHING
- JMS I (200
- 12 /INQUIRE
-DVNM1, 0
-DVNM2, 0
- 0
- JMP I (CCER2 /NO SUCH DEVICE
- TAD DVNM2
- DCA I OLOC
- TAD OLOC
- AND (5
- SNA CLA /USING 2ND OUT DEV?
- JMP I SETOUT /NO
- ISZ OLOC /YES
- TAD (-4
- JMS I (MOVE
- CDF 0
- FNAME1
- CDF 10
-OLOC, 7600 /INITIALLY 7600 OR 7605
- JMP I SETOUT
- / TAD (PTR TO SWITCH TABLE ENTRY (IN FIELD 0)
-/ JMS TRANSL
-/ IT PARSES SWITCH, SETS BIT
-/ PARSES :VALUE, SETS = OPTION
-/ LEAVES DELIMETER IN DELIM
-
-TRANSL, 0
- DCA SPTR /POINT INTO A SWITCH TABLE
- JMS I (GNAME /GET A NAME
- DCA DEL
-/ TAD NAME4
-/ SZA CLA
-/ HLT /EXTENSION ON A SWITCH
- JMS SRCH
- JMP I (NFOU /SWITCH NOT FOUND
- STA
- TAD SRPTR
- DCA SSPTR /SAVE PTR INTO LONG NAME
- JMS SRCH /SEARCH SOME MORE
- SKP /SHOULDN'T FIND ANYTHING
- JMP I (AMBIG /AMBIGUOUS SWITCH
- CDF 0
-L$: TAD I SSPTR /SCAN PAST END OF LONG NAME
- ISZ SSPTR
- AND (77
-X240: SZA CLA
- JMP L$
- TAD I SSPTR
- CDF 10
-SL, AND (377 /ISOLATE CORRESPONDING ONE-CHARACTER SWITCH
- SZA
- JMS I (SLSHCH /SET APPROPRIATE BIT
- TAD DEL
- DCA DELIM
- TAD DELIM
- TAD (-":
- SNA CLA
- JMS I (EQLPRM
- JMP I TRANSL
-
-ONE, TAD NAME1
- CLL RTR
- RTR
- RTR
- TAD X240
- AND (77
- TAD X240
- JMP SL
-
-SPTR, 0
-SSPTR, 0
-DEL, 0
- /RETURN 1 IF NAME NOT FOUND
-/RETURN 2 IF NAME FOUND
-
-SRCH, 0
-1$: TAD (NAME1
- DCA NPTR
- CLL STA RTL /-3
- DCA NCNT
- CDF 0
- TAD I SPTR
- CDF 10
- ISZ SPTR
- SNA
- JMP I SRCH /NOT FOUND
- DCA SRPTR
-2$: TAD I NPTR
- SNA
- JMP 3$
- AND (77
- SZA CLA
- TAD (77 /MUST MATCH BOTH BYTES
- TAD (7700 /NEED ONLY MATCH LEFT BYTE
- CDF 0
- AND I SRPTR
- CDF 10
- CIA
- TAD I NPTR
- SZA CLA
- JMP 1$ /THIS SWITCH AIN'T IT
- ISZ SRPTR
- ISZ NPTR
- ISZ NCNT
- JMP 2$
-3$: ISZ SRCH
- JMP I SRCH
-
-SRPTR, 0 /POINTS INTO LONG NAME TABLE
-NCNT, 0
-NPTR, 0 /POINTS INTO NAME1-3
- PAGE
-
DELETED src/os8-v3f/CCLCDX.MA
Index: src/os8-v3f/CCLCDX.MA
==================================================================
--- src/os8-v3f/CCLCDX.MA
+++ /dev/null
@@ -1,134 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL CD EXTENSION
- .ENTRY POUND,NUMBER,EQLPRM,DNUMB
- .EXTERNAL GCH
- .EXTERNAL LV
- MPARAM=7643
- T=20
- DELIM=32
- NAME1=23
- NAME2=24
- NAME3=25
- NAME4=26
- LXR=34
- .EXTERNAL PRMESG
- .RSECT CCLCDX
- FIELD 1
-
-BADNUM, TEXT /#BAD NUMBER/
-
-EQLPRM, 0
- DCA NUMFUJ
- JMS NUMBER
- DCA I (MPARAM+3
- CLA CLL CML RAR
- AND I (MPARAM-1 /PRESERVE ALTMODE
- TAD HIORD
- DCA I (MPARAM-1
- JMP I EQLPRM
- NUMBER, 0
- SZA CLA
- TAD (<TAD NUM>-SKP
- TAD (SKP
- DCA NUMADD /SET NUMADD TO EITHER "SKP" OR "TAD NUM"
- DCA HIORD
-NUMLP, DCA NUM
- JMS I (GCH
- ISZ NUMKNT
- SKP
- JMP EONUM2
- CMA
- TAD NUMFUJ
- TAD ("8 /TEST INPUT CHARACTER FOR RANGE
- CLL CMA /0-7 IF NUMFUJ=0
- TAD (10 /0-9 IF NUMFUJ=2
- TAD NUMFUJ
- SNL
- JMP EONUM
- DCA T
- CLA CLL CMA RTL
- DCA DELIM
- TAD NUM
-ROTLP, CLL RAL
- DCA NUMX
- TAD HIORD
- RAL
-NUMSKP, SPA /MODIFIED BY #
- JMP CDER5
- DCA HIORD
- TAD NUMX
- ISZ DELIM
- JMP ROTLP
-NUMADD, TAD NUM /SKP IF OCTAL
- TAD NUM
- TAD T
- JMP NUMLP
-EONUM, TAD ("0
-EONUM2, DCA DELIM
- TAD NUMKNT
- SPA CLA
- JMP CDER5 /FEWER THAN CORRECT NUMBER OF DIGITS
- TAD NUM
- JMP I NUMBER
-
-NUM, 0
-NUMFUJ, 0
-NUMKNT, 0 /SET TO -N-1 TO FORCE N DIGITS
-HIORD, 0
-NUMX, 0
- DNUMB, 0
- CLA CLL CML RTL
- DCA NUMFUJ /SET "NUMBER" TO ACCEPT
- /DIGITS 8 AND 9
- STA /ALLOW DECIMAL
- JMS NUMBER
- JMP I DNUMB
- CDER5, JMS I (PRMESG
- BADNUM
-POUND, 0 /USED AS FLAG INDICATING SAW #
- TAD (SKP
- DCA NUMSKP
- TAD (-11
- DCA NUMKNT
- JMS NUMBER
- DCA NAME2
- TAD HIORD
- DCA NAME1
- STA
- TAD LXR
- DCA LXR
- TAD (-11
- DCA NUMKNT
- JMS NUMBER
- DCA NAME4
- TAD HIORD
- DCA NAME3
- TAD (SPA
- DCA NUMSKP
- JMP I (LV
- PAGE
DELETED src/os8-v3f/CCLCOR.MA
Index: src/os8-v3f/CCLCOR.MA
==================================================================
--- src/os8-v3f/CCLCOR.MA
+++ /dev/null
@@ -1,184 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL CORE (MEMORY) ROUTINES
-
- .ENTRY DETCOR,OTOD
- .EXTERNAL CORE,CORSIZ
- .EXTERNAL PRINT,LBEGIN,PRWD,CMDERR
- BATCCL=7777
-
- .RSECT CORF1
- FIELD 1
-HISIZ, 0 /HIGHEST MEMORY BANK
-NEWCOR, 0 /PROPOSED NEW MEMORY BANK
-
-DETCOR, 0
- CIF 0
- JMS I (CORE
- SNA
- JMS K8
- TAD (-30
- SMA
- JMS I (K32
- TAD (40
- JMS I (OTOD
- DCA CORMES+1
- TAD I (LBEGIN
- DCA XRL
- CDF 0
- STA
- TAD I (CORSIZ
- DCA HISIZ
- ISZ XRL
- TAD I XRL /GET NEXT CHAR
- SNA
- JMP COREQ /NOT SETTING CORE SIZE
- TAD (-260
- DCA NEWCOR
- TAD NEWCOR
- AND (7770
- SZA CLA
- JMP DETER /TRIED TO SET CORE SIZE GT 7
- ISZ XRL /SHOULD ONLY BE ONE FIELD NUMBER
- TAD I XRL /IF MORE, THEN ERROR RETURN
- SZA CLA
- JMP DETER
- TAD NEWCOR
- CIA
- TAD HISIZ
- SPA CLA
- JMP BADCOR /TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE
- TAD I (BATCCL
- RTL /BATCH BIT TO LINK
- SZL CLA
- JMP WRSCOR /CAN'T CHANGE CORE SIZE UNDER BATCH
- TAD NEWCOR
- CLL RTL
- RAL
- DCA NEWCOR
- TAD I (BATCCL
- AND (7707
- TAD NEWCOR
- DCA I (BATCCL
-COREQ, CDF 0
- TAD I (BATCCL
- AND (70
- SNA
- JMP ABSCOR
- TAD (10
- CLL RAR
- JMS I (OTOD
- CDF 10
- DCA SCRMES
- TAD SCRMES
- CIA
- TAD CORMES+1
- SNA CLA
- JMP ABSCOR /DON'T PRINT SOFT IF = REAL
- JMP I (SCRM
-
-DETER, CDF 10
- JMP I (CMDERR
- JMP I DETCOR
-
-XRL, 0
-
-BADCOR, CDF 10
- JMS I (PRINT
- NOCORE
- JMP COREQ
-
-ABSCOR, CDF 10
- JMS I (PRINT
- CORMES
- JMP I DETCOR
-
-WRSCOR, CDF 10
- JMS I (PRINT
- BATCOR
- JMP COREQ
-
-
-K8, 0
- TAD (1716
- JMS I (PRWD
- TAD (1431
- JMS I (PRWD
- CIF CDF 0
- JMP I K8
- SCRMES, TEXT \00K OF\
- *.-1
-CORMES, TEXT / 00K MEMORY/
-
-K32, 0
- DCA TMP
- TAD (4100
- DCA I (CORMES+6
- TAD TMP
- JMP I K32
-TMP, 0
- PAGE
- OTOD, 0
- DCA 2$
- DCA 1$
- TAD 2$
- TAD (-12
- ISZ 1$
- SMA
- JMP .-3
- TAD (72
- DCA 3$
- TAD 1$ /IS THE 'TENS' DIGIT > 9?
- TAD (-13
- SPA CLA /IF IT IS 9 OR LESS
- JMP .+4 /JMP OVER ADJUSTMENT
- TAD (4061 /OTHERWISE SET 'HUNDREDS' INDICATOR BIT
- DCA I (CORMES
- TAD (-12 /ADJUST 'TENS' BIT
- TAD (-1
-
- TAD 1$
- SNA
- TAD (40-60
- TAD (60
- CLL RTL
- RTL
- RTL
- TAD 3$
- JMP I OTOD
-
-1$: 0
-2$: 0
-3$: 0
- SCRM, CDF 10
- JMS I (PRINT
- SCRMES
- JMP I (DETER+2
-NOCORE, TEXT /# NOT ENOUGH MEMORY/
-BATCOR, TEXT /#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/
- PAGE
-
DELETED src/os8-v3f/CCLDAT.MA
Index: src/os8-v3f/CCLDAT.MA
==================================================================
--- src/os8-v3f/CCLDAT.MA
+++ /dev/null
@@ -1,187 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /3 CCL DATE COMMAND
-
- .ENTRY DATE
- .EXTERNAL PRINT,OTOD,PRWD,PRMESG
- .EXTERNAL CRLF,LOOK,CHAIN
- .EXTERNAL YDATE
-
- DATWD=7666
- BATCCL=7777
-
- .RSECT CCLDAT
- FIELD 1
-
-DATE, 0
- TAD I (DATWD
- SNA
- JMP NODATE
- DCA DATEM
- TAD DATEM
- CLL RTL
- RTL
- RAL
- AND (17
- DCA TM1
- TAD TM1
- TAD (MONLST-1
- DCA TM2
- TAD I TM2
- DCA 4$
- TAD DATEM
- AND (7
- DCA T$
- CDF 0
- TAD I (BATCCL
- CDF 10
- CLL RTR
- RTR
- AND (30
- TAD T$
- DCA TM2
- TAD TM2
- TAD (70.
- JMS I (OTOD
- DCA YEAR
- TAD DATEM
- CLL RTR
- RAR
- AND (37
- DCA DATEM
- TAD DATEM
- JMS I (OTOD
- DCA DAY
- STL CLA RTL /2
- TAD TM2
- CLL RTR
- SNL SMA
- JMP 1$
- ISZ I (JAN
- ISZ I (FEB
-1$: AND (37
- TAD TM2
- TAD (3
- TAD DATEM
- DCA DATEM
- TAD TM1
- TAD (JAN-1
- DCA TM1
- TAD I TM1
- TAD DATEM
-2$: CLL
- TAD (-7
- SZL
- JMP 2$
- TAD (7
- TAD (WEEKLST
- DCA TM2
- TAD I TM2
- DCA 3$
- STA /DON'T CRLF AND PRINT IN LOWER CASE
- JMS I (PRINT
-3$: 0
- STA
- JMS I (PRINT
- DAYDAY
- CLA IAC
- JMS I (PRINT
-4$: 0
- STL CLA RAR
- JMS I (PRWD /SPACE
- TAD DAY
- JMS I (PRWD
- CLA IAC
- JMS I (PRINT
- COM19
- TAD YEAR
- JMS I (PRWD
- JMS I (CRLF
- JMS I (LOOK /LOOKUP SYS:DATE.SV
- YDATE
- JMP I DATE /DO NOTHING IF IT'S NOT THERE
- JMP I (CHAIN /CHAIN TO IT, IF IT'S THERE
-T$: 0
- NODATE, JMS I (PRMESG
- NONE
-TM1, 0
-TM2, 0
-DATEM, 0
-DAY, 0
-YEAR, 0
-
-NONE, TEXT /NONE/
- PAGE
- MONLST, MON1
- MON2
- MON3
- MON4
- MON5
- MON6
- MON7
- MON8
- MON9
- MON10
- MON11
- MON12
- MON1, TEXT /JANUARY/
-MON2, TEXT /FEBRUARY/
-MON3, TEXT /MARCH/
-MON4, TEXT /APRIL/
-MON5, TEXT /MAY/
-MON6, TEXT /JUNE/
-MON7, TEXT /JULY/
-MON8, TEXT /AUGUST/
-MON9, TEXT /SEPTEMBER/
-MON10, TEXT /OCTOBER/
-MON11, TEXT /NOVEMBER/
-MON12, TEXT /DECEMBER/
- COM19, TEXT /, 19/
-
-WEEKLST,DAY1
- DAY2
- DAY3
- DAY4
- DAY5
- DAY6
- DAY7
-
- .ENABLE ASCII
-DAY1, TEXT /Satur/
-DAY2, TEXT /Sun/
-DAY3, TEXT /Mon/
-DAY4, TEXT /Tues/
-DAY5, TEXT /Wednes/
-DAY6, TEXT /Thurs/
-DAY7, TEXT /Fri/
-DAYDAY, TEXT /day /
- .ENABLE SIXBIT
-
-JAN, 0
-FEB, 3
- 4;0;2;5;0;3;6;1;4;6
-
DELETED src/os8-v3f/CCLDRV.MA
Index: src/os8-v3f/CCLDRV.MA
==================================================================
--- src/os8-v3f/CCLDRV.MA
+++ /dev/null
@@ -1,267 +0,0 @@
-/OVRDRV - OVERLAY DRIVER FOR CCL
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977,1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-
-/OVERLAY DRIVER
-/FOR LINKER PROGRAM MODULES
-/VERSION=V3A
-
-
-/THIS SECT IS TWO LOCATIONS AND CONTAINS THE TRANSFER VECTOR TO SWAPER
-/AND A FLAG THAT INDICATES WHETHER A JMP (1) OR JMS (0) WAS PERFORMED
-/TO THE TRANSFER VECTOR
-
-/ .SECT XFERV,Z
-/ 0 /FLAG, 1=JMP, 0=JMS
-/ SWAPER /TRANSFER VECTOR TO SWAP ROUTINE
-
-/THIS IS THE MAIN DRIVER SECTION
-
- .SECT SWAPER,R
- .GLOBAL SWPTAB,TRANVC
-
- .ZTERNAL XFERV
- FIELD 1
-
-SWAP, 6102 /VERSION NUMBER
- DCA AC /SAVE CALLING AC
- RAL
- DCA LINK /AND LINK
- RDF /GET CALLING DF
- TAD (CDF /FORM CDF
-SWAP0, JMP ONCE /DO ONCE ONLY CODE - REPLACED BY DCA EXIT
- CDF . /CHANGE TO THIS DATA FIELD
- TAD I SWAP /GET OVERLAY,LEVEL,FIELD
- DCA BINDAT /SAVE
- ISZ SWAP /BUMP POINTER
- TAD I SWAP /GET SUBROUTINE ADDRESS
- DCA XITLOC /SAVE
- TAD BINDAT /FORM CDF TO CALLED SUBROUTINE
- AND (7
- RAL CLL
- RTL
- TAD (CDF
- DCA SWAP1A /SAVE
- TAD SWAP1A /FORM CIF TO CALLED SUBROUTINE
- IAC
- DCA EXIT+1 /SAVE FOR EXIT
- /LOAD OVERLAY OF CALLED SUBROUTINE
-
-LOAD, TAD BINDAT
- AND (1600 /EXTRACT LEVEL OF CALLED SUBROUTINE
- RTR CLL /5 RIGHT
- RTR
- RAR
- DCA PNTR /SAVE
- TAD PNTR
- TAD (SWPTAB /COMPUTE ENTRY INTO SWAP TABLE
- DCA FLD /POINTS TO FIELD OF OVERLAY
- TAD PNTR /COMPUTE ENTRY INTO CURRENT OVERLAY TABLE
- RTR CLL
- TAD (CURTAB
- DCA PNTR
- TAD BINDAT /EXTRACT DESIRED OVERLAY NUMBER
- AND (170
- RTR CLL /RIGHT 3
- RAR
- CIA /NEGATE
- DCA TEMP
- TAD TEMP
- TAD I PNTR /COMPARE WITH CURRENT OVERLAY NUMBER FOR LEVEL
- SNA CLA /SAME?
- JMP SWAP1 /YES, NO READING NEEDED
-LOAD1, TAD TEMP /NO, SET TO NEW
- CIA
- DCA I PNTR /OVERLAY NUMBER
- TAD FLD /SET UP POINTERS TO
- IAC
- DCA ADDRES /ADDRESS
- TAD ADDRES
- IAC
- DCA RELBLK /RELATIVE BLOCK NUMBER
- TAD RELBLK
- IAC
- DCA LENGTH /LENGTH OF OVERLAY
- TAD TEMP /TEST OVERLAY NUMBER
- SNA CLA /0?
- JMP LOAD2 /YES, NO MULTIPLICATION NEEDED
- TAD I LENGTH /BLOCK NUMBER = (LENGTH OF OVERLAY)
- JMP I .+1 /TIMES (THE NUMBER OF THE OVERLAY)
- PATCH
-LOAD2, TAD I RELBLK /PLUS (RELATIVE BLOCK OF LEVEL)
- TAD STRBLK /PLUS (STARTING BLOCK OF PROGRAM)
- DCA REDBLK /SAVE IN CALL LOCATION
- TAD I ADDRES /GET ADDRESS TO LOAD
- DCA REDADD /SAVE IN CALL LOCATION
- TAD I FLD /GET FIELD
- AND (7 /MASK
- RTR CLL
- RAR /POSITION
- TAD I LENGTH /GET LENGTH
- RTL
- RTL
- RTL
- DCA REDCNT /FORM CONTROL WORD
- CIF 0
- JMS I (7607 /CALL SYSTEM HANDLER TO READ IN OVERLAY
-REDCNT, 7756 /FUNCTION CONTROL WORD (POINTS TO MREAD-1 FOR "ONCE"
-REDADD, -7607 /BUFFER ADDRESS (CONTAINS SYS: ENTRY POINT FOR "ONCE"
-REDBLK, 0 /STARTING BLOCK NUMBER
- HLT /ERROR RETURN ADDRESS
-
-SWAP1, TAD XFERV /GET JMP-JMS FLAG
- SZA CLA /SET?
- JMP SWAP2 /YES, EXECUTE A JMP
- CLA CLL CMA RTL /-3
- TAD SWAP /BACK UP TO CALLER'S PC
- DCA SWAP
- TAD I SWAP
-SWAP1A, 0 /CDF TO CALLED SUBROUTINE
- DCA I XITLOC /SAVE IN CALLED SUBROUTINE
- ISZ XITLOC /BUMP TRANSFER ADDRESS
- CDF .
- TAD (ISZ XFERV
- DCA I SWAP /SET BACK UP ENTRY IN XFER VECTOR TABLE
-SWAP2, DCA XFERV /CLEAR FLAG
- TAD LINK /RESTORE LINK AND AC
- RAR CLL
- TAD AC
-EXIT, 0 /SET DF TO CALLING FIELD
- 0 /SET IF TO CALLED FIELD
- JMP I XITLOC /GO TO CALLED SUBROUTINE
-
- /VARIABLE LOCATIONS
-/SOME OF THE FOLLOWING LOCATIONS CONTAIN
-/ONCE ONLY CODE TO SET UP STARTING BLOCK
-/AND CHECK THAT FILE CAME FROM SYS:
-CURTAB=. /CURRENT OVERLAY IN LEVEL TABLE (8 ENTRIES)
-STRBLK=. /ENTRY 0 IS USED TO HOLD STARTING BLOCK OF FILE
-ONCE, DCA EXIT /SAVE CALLING FIELD
- /ALSO ENTRY 0
- TAD .-1 /SET UP SO WON'T BE EXECUTED AGAIN
- /ALSO ENTRY 1
- DCA SWAP0
- /ALSO ENTRY 2
- CDF 0
- /ALSO ENTRY 3
- TAD I FLD /GET STARTING BLOCK FROM "SOFSET"
- /ALSO ENTRY 4
- SNA
- /ALSO ENTRY 5
- HLT /ERROR, K.M. PATCHES NOT IN
- /ALSO ENTRY 6
- DCA STRBLK /SAVE
- /ALSO ENTRY 7
- TAD I REDCNT /CHECK FILE CAME FROM SYS:
- TAD REDADD
-
-BINDAT, /CONTAINS OVERLAY,LEVEL,FIELD OF DESIRED SUBROUTINE
- SNA CLA /FROM SYS: ?
-XITLOC, /CONTAINS LOCATION TO GO TO IN DESIRED SUBROUTINE
- JMP SWAP0+1 /YES, OK
-PNTR, /POINTS INTO CURTAB
- HLT /NO, ERROR
-TEMP, /TEMP STORAGE
- JMP .-1 /DON'T ALLOW CONTINUE
-FLD, /POINTS TO FIELD WORD IN SWPTAB
- 7747 /POINTER TO "SOFSET"
-
-ADDRES=REDADD /POINTS TO ADDRESS WORD IN SWPTAB
-RELBLK=REDBLK /POINTS TO RELATIVE BLOCK WORD IN SWPTAB
-LENGTH=REDCNT /POINTS TO LENGTH WORD IN SWPTAB
-
-AC, 0 /SAVED AC
-LINK, 0 /SAVED LINK
-
- PAGE
-
-/PATCH TO FIX BLOCK POSITION CALCULATION
-PATCH, IAC /CONVERT PAGES TO BLOCKS
- CLL RAR
- DCA PTEMP
- TAD PTEMP /MULTIPLY BLOCK LENGTH
- ISZ I PPNT /BY OVERLAY NUMBER
- JMP .-2
- JMP I .+1
- LOAD2
-PPNT, TEMP
-PTEMP, 0
-
-
-
-/THIS AREA CONTAINS OVERLAY DATA FOR MAIN AND THE 7 LEVELS
-/THE FORMAT OF EACH ENTRY IS:
-/WORD1: FIELD OF LEVEL
-/WORD2: ADDRESS OF LEVEL
-/WORD3: RELATIVE BLOCK OF 1ST OVERLAY IN LEVEL
-/WORD4: LENGTH OF THE LEVEL (ANY AND ALL OVERLAYS-EACH)
-/ (ALL OVERLAYS IN A LEVEL ARE THE SAME LENGTH)
-
-SWPTAB,
-
- *.+40
-
-/THIS AREA CONTAINS THE TRANSFER VECTORS FOR EACH ENTRY POINT
-/IN ALL THE OVERLAYS IN ALL THE LEVELS
-/ITS SIZE SHOULD BE MODIFIED BY THE USER
-/TO FIT THE MAXIMUM NUMBER OF TRANSFER VECTORS NEEDED
-/EACH TRANSFER VECTOR OCCUPIES 4 LOCATIONS
-/THE TABLE IS INITIALLY SET UP FOR 24(DEC) (30(OCT)) VECTORS
-/THE MAXIMUM SIZE THIS TABLE CAN BE IS 3774 (OCT) LOCATIONS FOR
-/511 (DEC) (777 (OCT)) VECTORS
-/THE FORMAT OF EACH VECTOR ENTRY IS:
-/WORD1: ISZ XFERV
-/WORD2: JMS I XFERV+1
-/WORD3: LEVEL/OVERLAY/FIELD
-/WORD4: ADDRESS
-
-TRANVC,
-
- SIZE=53. /MODIFY THIS LINE TO CHANGE THE SIZE OF THE TABLE
- /SET FOR 24(DEC)
-
- *SIZE^4+.
-
-
-
DELETED src/os8-v3f/CCLMSG.MA
Index: src/os8-v3f/CCLMSG.MA
==================================================================
--- src/os8-v3f/CCLMSG.MA
+++ /dev/null
@@ -1,170 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /2 CCL MESSAGE PRINTER
- .EXTERNAL TWAIT,BATCH
-
- T=20
- BATOUT=7400 /JMS HERE TO PRINT ON BATCH LOG
- BATERR=7000 /JMP HERE TO ABORT BATCH
- NAME1=23
- NAME2=24
- NAME3=25
- NAME4=26
- NAME5=27
-
- .GLOBAL PRMESG,PRWD,PRNAME,PRINT,CRLF
- .GLOBAL LEAVE
- .RSECT CCLMSG
-
- FIELD 1
-
-PRMESG, 0
- CLA
- TAD I PRMESG
- DCA TE2
- JMS PRINT
-TE2, HLT
-LEAVE, JMS I (TWAIT
-/V3D TCF
- CIF CDF 0
- TAD FATALFLG
- SNA CLA
- JMP I (7605
-FATALFLG,0 /CIF CDF BATCH FIELD IF WANT TO ABORT
- JMP I (BATERR
-
-PRWD, 0
- DCA T
- TAD T
-TTY212, RTR
- RTR
- RTR
- JMS PCHAR
- TAD T
- JMS PCHAR
- JMP I PRWD
-
-PCHAR, 0
- AND (77
-TNOP, SNA
- JMP I PCHAR /IGNORE NULLS
- TAD (240
- AND (77
- TAD (240 /CAN'T USE 'TTY240'
- JMS TYPE
- JMP I PCHAR
- TE,
-PRNAME, 0
- TAD NAME1
- JMS PRWD
- TAD NAME2
- JMS PRWD
- TAD NAME3
- JMS PRWD
- TAD NAME4
- SNA CLA
- JMP I PRNAME
- TAD (256
- JMS PCHAR
- TAD NAME4
- JMS PRWD
-/ TAD NAME5
-/ SZA
-/ JMS PRWD
- JMP I PRNAME
- TYPE, 0
-/ SNA
-/ JMP I TYPE /CAN REMOVE IF NEED ROOM
- DCA TE2
- JMS I (BATCH
- JMP TTYOUT
- DCA CIFB
-CIFB, HLT /REPLACED BY CIF BATCH FIELD
- TAD TE2
- JMS I (BATOUT
- TAD TE2
- TAD (-"#
- SZA CLA
- JMP I TYPE
- TAD CIFB
- IAC /CONVERT CIF TO CIF CDF
- DCA FATALFLG
- JMP I TYPE
-
-TTYOUT, TAD TE2
- TAD (-"# /DON'T TYPE #'S
- SNA CLA
- JMP I TYPE
- TAD T7600
- KRS
- TAD (-7603
- SNA
- JMP LEAVE
- TAD (203-217
- SNA CLA
- JMP I TYPE
- TAD TE2
-TJUMP, JMP .+3
- TSF
- JMP .-1
- TLS
-T7600, 7600
- TAD TNOP
- DCA TJUMP
- JMP I TYPE
- PRINT, 0
- DCA CRLF /AC NON-0 MEANS DON'T CRLF
- TAD I PRINT
- ISZ PRINT
- DCA TE
- TAD CRLF
- SPA CLA
- TAD (TYPE-PRWD
- TAD (PRWD
- DCA PROUT
-1$: TAD I TE
- JMS I PROUT
- TAD I TE
- ISZ TE
- AND (77
- SZA CLA
- JMP 1$
- CLA IAC
- AND CRLF
- SNA CLA
- JMS CRLF
- JMP I PRINT
-
-PROUT, PRWD
- CRLF, 0
- TAD (215
- JMS TYPE
- TAD TTY212
- JMS TYPE
- JMP I CRLF
- PAGE
-
DELETED src/os8-v3f/CCLPS.MA
Index: src/os8-v3f/CCLPS.MA
==================================================================
--- src/os8-v3f/CCLPS.MA
+++ /dev/null
@@ -1,63 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1
- .ASECT MORTBL
- FIELD 0
- *7130
- .EXTERNAL NMOVE,DONB,UNKN
- .EXTERNAL SETDEV,LPTDEV,TTYDEV,TVDEV,PTPDEV,DMPDEV,NULDEV
- .GLOBAL SWTCHS
-SWTCHS, 1423; P1 /LS
- 1602; P2 /NB
- 1520; P3 /MP
- 1400; P4 /L
- 2400; P5 /T
- 2300; P6 /S
- 2000; P7 /P
- 0400; P8 /D
- 1600; P9 /N
- 0000; P10 /UNKNOWN
- P1, NMOVE
- 7605
-P2, DONB
- 0
-P3, NMOVE
- 7612
-P4, SETDEV
- LPTDEV
-P5, SETDEV
- TTYDEV
-P6, SETDEV
- TVDEV
-P7, SETDEV
- PTPDEV
-P8, SETDEV
- DMPDEV
-P9, SETDEV
- NULDEV
-P10, UNKN
- 0
DELETED src/os8-v3f/CCLREM.MA
Index: src/os8-v3f/CCLREM.MA
==================================================================
--- src/os8-v3f/CCLREM.MA
+++ /dev/null
@@ -1,270 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL RECOLLECTION ROUTINES
-
- .EXTERNAL REMD,SCAN,LBEGIN,BEGLN,PRMESG,PRINT
-
- DATWD=7666
- CLXR=35
- XR=16
-
- .ENTRY REMEM,FOREVER,RECALL
- .RSECT CCLREM
- FIELD 1
-
-/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL
-/SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE.
-/THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT:
-
-/4000-4037 REM-LINE 0
-/4040-4177 REM-LINE 1
-/4100-4137 REM-LINE 2
-/4140-4177 REM-LINE 3
-/4200-4237 REM-LINE 4
-/4240-4277 REM-LINE 5
-/4300-4337 REM-LINE 6
-/4340-4377 REM-LINE 7
-
-/EACH REM-LINE HAS THE FOLLOWING FORMAT:
-
-/WORD 0: IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE
-/WORD 1: DATE LINE WAS REMEMBERED
-/WORD 2: COMMAND DEPENDENT INFORMATION
-/WORD 3: RESERVED FOR FUTURE EXPANSION
-/WORDS 4-37 COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES
-/ PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0.
-
-/ROUTINES:
-
-/ TAD (DEP
-/ JMS REMEM
-/ N
-
-/REMEMBERS CURRENT LINE IN REM-LINE N. AC IS LINE DEPENDENT INFORMATION.
-/IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK.
-
-/ JMS RECALL
-/ N
-
-/RECALLS REM-LINE N INTO BUFFER
-/IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8.
-/UPON RETURN, LINE-DEPENDENT INFO IS IN AC.
-/IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1
-
-/0 USED BY TECO, MAKE COMMANDS
-/1 USED BY EDIT, CREATE COMMANDS
-/2 USED BY COMPILE, EXECUTE COMMANDS & PAL.
-/ DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE
-
-/3 USED BY 'UA' COMMAND
-/4 USED BY UB
-/5 USED BY UC
-
-/ JMS FOREVER
-
-/CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
- REMSPACE=4000
- REMBLOCK=65
-
-REMEM, 0
- DCA DEP
- TAD I (REMD
- SMA CLA
- JMP I REMEM /DON'T REMEMBER IF JUST RECALLED
- JMS I (RDREM
- JMP I (MEMBIG
- TAD I REMEM
- ISZ REMEM
- CLL RTL
- RTL
- RAL /MULTIPLY BY 40
- TAD (REMSPACE
- DCA LPTR
- TAD (1234
- CDF 0
- DCA I LPTR
- CDF 10
- ISZ LPTR
-FORVR, TAD I (DATWD /REPLACED BY CMA IF WANT NO DATE
- JMS LPUT /STORE DATE
- TAD DEP
- JMS LPUT /STORE DEPENDENT INFO
- JMS LPUT /RESERVED
- JMS I (SCAN /GO PAST KEYWORD AND BLANKS
- TAD I (LBEGIN
- DCA XR
-L$: JMS I (GETF
- JMP 3$
- JMS I (ROTL
- DCA TML
- JMS I (GETF
- JMP 2$
- TAD TML
- JMS LPUT
- JMP L$
-2$: TAD TML
-3$: JMS LPUT
- JMS I (WRREM
- JMP I (MEMBIG
-REMGO, JMP I REMEM
- DEP, 0
-LPTR, 0 /PTS TO REM-LINE
-TML, 0 /TEMP
-
-/PUT INTO REM-LINE
-
-LPUT, 0
- DCA TML
- TAD LPTR
- AND (37
- SNA CLA
- JMP I (MEMBIG
- TAD TML
- CDF 0
- DCA I LPTR
- CDF 10
- ISZ LPTR
- JMP I LPUT
-
-FOREVER,0
- TAD LCMA
- DCA FORVR
- JMP I FOREVER /NON-ZERO MEANS SET DATE TO -1
- RECALL, 0
- JMS I (RDREM
- JMP I (REMERR
- TAD I RECALL
- ISZ RECALL
- JMS I (ROTL
- RAR
- TAD (REMSPACE
- DCA LPTR
- JMS LGET
- TAD (-1234
- SZA CLA
- JMP I (REMER2
- JMS LGET
- SNA
- JMP I (REMER2
-LCMA, CMA
- SNA
- JMP 1$
- IAC
- TAD I (DATWD /SAME DAY?
- SZA CLA
- JMP I (REMER2
-1$: JMS LGET
- DCA DEP
- JMS LGET /IGNORE RESERVED WORD
- CLA
- TAD (BEGLN-1
- DCA XR
- TAD (BEGLN-1
- DCA I (LBEGIN
-L$: JMS LGET
- DCA TML
- TAD TML
- JMS I (ROTL
- RAL
- JMS I (PUTF
- JMP LV$
- TAD TML
- JMS I (PUTF
- JMP LV$
- JMP L$
-
-LV$: TAD DEP
- JMP I RECALL
- LGET, 0
- CDF 0
- TAD I LPTR
- CDF 10
- ISZ LPTR
- JMP I LGET
- PAGE
- PUTF, 0
- AND (77
- SNA
- JMP PUTZ
- ISZ PUTF
- TAD (240
- AND (77
- TAD (240
-PUTZ, CDF 0
- DCA I XR
- CDF 10
- JMP I PUTF
-
-REMERR, JMS I (PRMESG
- REMBAD
-REMER2, JMS I (PRMESG
- BADREM
- MEMBIG, CLA
- JMS I (PRINT
- MEMWARN
- JMP I (REMGO
-
-RDREM, 0
- CIF 0
- JMS I (7607
- 200 /READ 2 PAGES INTO FIELD 0
- 4000 /LOCATION 4000
- REMBLOCK
- SKP CLA
- ISZ RDREM
- JMP I RDREM
-
-WRREM, 0
- CIF 0
- JMS I (7607
- 4200 /WRITE 2 PAGES FROM FIELD 0
- 4000 /LOCATION 4000
- REMBLOCK
- SKP CLA
- ISZ WRREM
- JMP I WRREM
- /GET FROM INPUT LINE VIA XR
-
-GETF, 0
- CDF 0
- TAD I XR
- CDF 10
- SZA
- ISZ GETF
- AND (77
- JMP I GETF
- ROTL, 0
- CLL RTL
- RTL
- RTL
- JMP I ROTL
-
-MEMWARN,TEXT /%CAN'T REMEMBER/
-REMBAD, TEXT \#I/O ERROR TRYING TO RECALL\
-BADREM, TEXT /#BAD RECOLLECTION/
- PAGE
-
DELETED src/os8-v3f/CCLRUN.MA
Index: src/os8-v3f/CCLRUN.MA
==================================================================
--- src/os8-v3f/CCLRUN.MA
+++ /dev/null
@@ -1,150 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL RUN COMMAND
-
- .RSECT CCLRUN
- FIELD 1
-
- .ENTRY MONFIX,MONRES
- .EXTERNAL RDMON,PRMESG
- .EXTERNAL F1,F2,LO1,LO2
- .EXTERNAL YLOAD,YLOADER,YF4,YFORT
- .EXTERNAL LOOK
- .EXTERNAL BLK,IOERR
- PRQMRK==1357
- CCLBLK=67
- DEASADR=427
- CCLSW=435
- GETCCL=1362
- .EXTERNAL YCCL
- OS78BIT=7771
-
-MONFIX, JMS I (RDMON
- CDF 0
- TAD I ZERO
- TAD (-7607
- SNA CLA
- JMP I (CCER3 /ALWAYS WRITE OUT CCL BLOCK
- CDF 10
- CIF 0
- JMS I L7607
- 4200 /WRITE 1 RECORD FROM FIELD 0
- 400 /LOCATIONS 400-777
- CCLBLK /INTO THE SYSTEM'S CCL BLOCK
- JMP I (IOERR
- CDF 0
- TAD I (2000+CCLSW
- TAD XXX
- SNA
- JMP OK$
- TAD XXX2
- SZA CLA
- JMP I (CCER3
-/ CIF CDF 0
-/ JMP I L7605
-OK$: TAD (GETCCL
- DCA I (2000+CCLSW
- STA
- DCA I (2000+DEASADR /DELETE DEASSIGN
- JMS WRMON
- IFZERO 1 <
- JMS I (LOOK
- YFORT /LOOK FOR FORT.SV
- TAD XXX3 /NOT FOUND, USE F4
- TAD (YFORT /FOUND USE IT
- DCA I (F1
- TAD I (F1
- DCA I (F2
- TAD I (F1
- TAD MYFORT
- SZA CLA
- TAD XXX4
- TAD (YLOADER
- DCA I (LO1
- TAD I (LO1
- DCA I (LO2
- JMS I (LOOK
- YCCL
- JMP I (IOERR /CCL.SV NOT FOUND
- TAD I (BLK
- TAD (4 /*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB
- DCA B$
- CDF 10
- CIF 0
- JMS I (7607
- 4210 /WRITE 1 RECORD FROM FIELD 1
- 3400 /LOCS 3400-3777
-B$: 0
- JMP I (IOERR
- >
- CIF CDF 0
- JMP I (7605
-
-XXX, -PRQMRK
-XXX2, PRQMRK-GETCCL
- IFZERO 1 <
-MYFORT, -YFORT
-XXX3, YF4-YFORT
-XXX4, YLOAD-YLOADER
- >
- WRMON, 0
- CDF 10
- CIF 0
- JMS I L7607
- 4200
- 2400
- 10
- JMP I (IOERR
- JMP I WRMON
-
-ZERO, 0
-L7607, 7607
- MONRES, 0
- CDF 0
- TAD I (OS78BIT
- CDF 10
- AND (200
- SZA CLA
- JMP ERR
- JMS I (RDMON
- CDF 0
- TAD (PRQMRK
- DCA I (2000+CCLSW
- TAD (-405
- DCA I (2000+DEASADR
- JMS WRMON
- JMP I MONRES
-
-ERR, JMS I (PRMESG
- .+1
- TEXT "#CCL IS THE CONCISE COMMAND LANGUAGE FOR OS/78"
- CCER3, CDF 10
- JMS I (PRMESG
- BADMON
-BADMON, TEXT /#BAD MONITOR/
- PAGE
-
DELETED src/os8-v3f/CCLSB2.MA
Index: src/os8-v3f/CCLSB2.MA
==================================================================
--- src/os8-v3f/CCLSB2.MA
+++ /dev/null
@@ -1,155 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /2 CCL SUBROUTINES PART 2
- .ENTRY TRMSUB,REQSUB,CANSUB
- OS78BIT=7771
- .EXTERNAL PRMESG,LOOK,CHAIN,YTERMIN,PRINT,LEAVE
-
- .RSECT CCLSB2
- FIELD 1
- .SBTTL TERMINATE COMMAND
-
-TRMSUB, 0
- CDF 0
- TAD I (OS78BIT
- CDF 10
- AND (200
- SNA CLA
- JMP I TRMSUB /BACKSPACE, NOT TERMINATE
- JMS I (LOOK /LOOKUP TERMIN.SV
- YTERMIN
- SKP CLA
- JMP I (CHAIN
- 6073
- 6002
- CLA STL RAR /JUST IN CASE WE'RE NOT ON A VT-78
- JMS I (PRINT
- BADEV
- JMP I (LEAVE
- CANSUB, 0
- TAD I (7726
- AND (4
- SNA CLA
- JMP FOO4
- TAD I (7726
- AND (7773
- DCA I (7726 /TURN OFF SYMBIONT BIT
- CDF 0
- TAD I (7777
- RTL
- SZL CLA
- JMP 3$
- TAD I (7777
- AND (7707
- DCA I (7777
-3$: CDF 10
- STL CLA RAR
- JMS I (PRINT
- OFFMSG
- STL CLA RAR
- JMS I (PRINT
- ME2MSG
- CIF CDF 30
- JMP I (3 /GO TO MAGIC SPOT IN SYMBIONT LAND
-
-FOO3, STL CLA RAR
- JMS I (PRINT
- ALRACT
- JMP I (LEAVE
-FOO4, STL CLA RAR
- JMS I (PRINT
- NOTACT
- JMP I (LEAVE
- PAGE
- .SBTTL REQUEST COMMAND
-
-REQSUB, 0
- TAD I (7617
- AND (17
- TAD (7647-1
- DCA T
- TAD I T
- TAD (-7607
- SZA CLA
- JMP FOO /*** FILE NOT ON SYS:
- TAD I (7620
- DCA BLK
- CDF 0
- TAD I (7777
- AND (70
- TAD (-20
- SNA CLA
- JMP 1$
- RTL
- SZL CLA
- JMP FOO2
- TAD I (7777
- AND (7707
- TAD (20
- DCA I (7777
-1$: CDF 10
- TAD I (7726
- AND (4
- SZA CLA
- JMP FOO3
- TAD I (7726
- AND (7773
- TAD (4
- DCA I (7726
- STL CLA RAR
- JMS I (PRINT
- ONMSG
- STL CLA RAR
- JMS I (PRINT
- MEMMSG
- JMS I (200 /CHAIN TO IT
- 6
-BLK, 0
-
-T, 0
- FOO, STL CLA RAR
- JMS I (PRINT
- SYSMSG
- JMP I (LEAVE
-
-FOO2, CDF 10
- STL CLA RAR
- JMS I (PRINT
- BATMSG
- JMP I (LEAVE
- PAGE
- .ENABLE ASCII
-SYSMSG, TEXT "#Symbiont must be on SYS:"
-BATMSG, TEXT "#Cannot start symbiont from BATCH"
-ONMSG, TEXT "[Starting symbiont]"
-BADEV, TEXT "#Illegal OS/8 command"
-OFFMSG, TEXT "[Shutting down symbiont]"
-NOTACT, TEXT "%No symbiont is active"
-ALRACT, TEXT "#Request denied - symbiont already running"
-MEMMSG, TEXT "[12K Memory]"
-ME2MSG, TEXT "[16K Memory]
- .ENABLE SIXBIT
DELETED src/os8-v3f/CCLSEM.MA
Index: src/os8-v3f/CCLSEM.MA
==================================================================
--- src/os8-v3f/CCLSEM.MA
+++ /dev/null
@@ -1,199 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL SEMICOLON CODE
-
- .ENTRY SEMI
-
- .EXTERNAL PRMESG,YBATCH,ZOW,BEGLN
- MOFILE=7600
- XR=16
-
- .RSECT SEM1
- FIELD 1
-
-ENGOA, TAD (-5
- JMS I (ZEROCD
- TAD I (BLKNO
- DCA I (7620
- CLA IAC
- DCA I (7617 /'CCBTCH' IS ON SYS:
- TAD (20 / /T OPTION
- DCA I (7644
- TAD (20 / ALSO /H (HUSH) OPTION
- DCA I (7643
- TAD (YBATCH
- JMP I (ZOW /CHAIN TO BATCH
-
-ZEROCD, 0
- TAD (-42 /AC MAY BE NON-0
- DCA T$
- TAD (MOFILE-1
- DCA XR
- DCA I XR /ZERO THE COMMAND DECODER OUTPUT AREA
- ISZ T$
- JMP .-2
- JMP I ZEROCD
-T$: 0
- SEMSG1, TEXT /? ENTER ERROR/
-SEMSG2, TEXT \?I/O ERROR\
-SEMSG3, TEXT /?DEVICE FULL/
-SEMSG4, TEXT /?CLOSE ERROR/
- PAGE
- BATBUF=4400 /LOCATION OF ONE BLOCK BATCH TEMP BUFFER
- USR=200
- GLINE=1200 /LOCATION FROM KBM
- CTRLCK=1241 /LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C
-BATPTR, BATBUF-1
-LCHAR, 0
-
-SEMGO, CIF CDF 10
- JMP I SEMI
-
-SEMI, 0
- CLA IAC /SYS
- JMS I (USR
- 3 /ENTER
-BLKNO, TEMNAM
-BLKLEN, 0 /NEG OF LENGTH
- JMP SEMER1 /ENTER ERROR
- TAD BLKNO
- DCA BATBLK
- TAD (BEGLN-1
- DCA XR
- TAD (7600
- DCA I (CTRLCK /FORCE ^C TO GLINE TO GO TO 7600
- JMS BATLST
- BATHED
-S2, CDF 0
- TAD I XR
- CDF 10
- SNA
- JMP LINEND
- DCA LCHAR /SAVE CHAR
- TAD LCHAR
- TAD (-";
- SNA CLA
- JMP GOTSEM
- TAD LCHAR
-S3, JMS BATPUT
- JMP S2
- LINEND, TAD LCHAR
- TAD (-"; /LOOK AT LAST CHAR
- SZA CLA /WAS IT SEMICOLON?
- JMP BATEND /NO, END OF TEMP BATCH STREAM
- CIF CDF 0
- JMS I (GLIN /YES, READ NEW LINE FROM KEYBOARD
-/**** WHAT IF WE'RE RUNNING UNDER BATCH ****
- TAD (BEGLN-1
- DCA XR
- JMP S2
-
-GOTSEM, JMS KRLF
- TAD (".
- JMP S3
-
-KRLF, 0
- TAD (215
- JMS BATPUT
- TAD (212
- JMS BATPUT
- JMP I KRLF
-
-BATPUT, 0
- ISZ BATPTR
- CDF BATBUF
- DCA I BATPTR
- CDF 10
- TAD BATPTR
- TAD (-BATBUF-377
- SNA CLA
- JMS BATWRIT /WRITE OUT BUFFER IF FULL
- JMP I BATPUT
- BATWRIT,0
- CIF 0
- JMS I (7607
- 4200 /WRITE 1 BLOCK
- BATBUF
-BATBLK, 0
- JMP SEMER2 / I/O ERROR
- ISZ BATBLK /POINT TO NEXT BLOCK
- ISZ BATLEN /BUMP LENGTH
- ISZ BLKLEN
- SKP
- JMP SEMER3 /DEVICE FULL
- TAD (BATBUF-1
- DCA BATPTR
- JMP I BATWRIT
-
-BATEND, JMS KRLF
- JMS BATLST
- BATAIL
- JMS BATWRIT
- CLA IAC /SYS
- JMS I (USR
- 4 /CLOSE
- TEMNAM
-BATLEN, 0 /LENGTH OF TEMPORARY FILE
- JMP SEMER4 /CLOSE ERROR
- JMP I (ENGOA
- BATLST, 0
- TAD I BATLST
- DCA T$
- ISZ BATLST
-L$: TAD I T$
- SNA
- JMP I BATLST
- JMS BATPUT
- ISZ T$
- JMP L$
-
-T$: 0
-
-SEMER1, JMS I (PRMESG
- SEMSG1
-SEMER2, JMS I (PRMESG
- SEMSG2
-SEMER3, JMS I (PRMESG
- SEMSG3
-SEMER4, JMS I (PRMESG
- SEMSG4
- PAGE
- .FSECT GLYN
- FIELD 0
-
-GLIN, 0
- JMS I PGLINE
- CIF CDF 10
- JMP I GLIN
-PGLINE, GLINE
- .ASECT SEMSGS
- .ENABLE ASCII
- FIELD 0
- *7400
-BATHED, TEXT "$JOB"<215><212>"."
-BATAIL, TEXT ".R FOTP"<215><212>"*SYS:CCBTCH.TM/D$"<215><212>"$END"<215><212><32>
-TEMNAM, FILENAME CCBTCH.TM
DELETED src/os8-v3f/CCLSIZ.MA
Index: src/os8-v3f/CCLSIZ.MA
==================================================================
--- src/os8-v3f/CCLSIZ.MA
+++ /dev/null
@@ -1,78 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1
- .GLOBAL CORE,CORSIZ
- .ASECT CORF0
- LXM=6200
- FIELD 0
- *7200
-CORLOC, CORX
-CORV, 1400
-CORSIZ, 1
-
-CORE, 0
- TAD T7000 /SETS KT8A IF PRESENT
- LXM /LXM INSTRUCTION
- CLA /LXM ACTS AS NOP IF NO KT8A
-CORE2, CDF 0
- TAD CORSIZ /ADJUST FIELDS FOR CDF
- CLL RTR
- RTR
- BSW
- SZL
- TAD T4
- AND COR174
- TAD COREX
- DCA .+1
-COR1, CDF
- TAD I CORLOC
-COR2, NOP
- DCA COR1
- TAD COR2
- DCA I CORLOC
-COR174, 174
- TAD I CORLOC
-CORX, 7400
- TAD CORX
- TAD CORV
- SZA CLA
- JMP COREX
- TAD COR1
- DCA I CORLOC
- ISZ CORSIZ
- JMP CORE2
-COREX, CDF 0
- LXM /NEUTRALIZES KT8A
- TAD CORSIZ
- CLL RTL
- TAD M10
- CIF CDF 10
- JMP I CORE /RETURN
-M10, -10
-T4, 4
-T7000, 7000
-
DELETED src/os8-v3f/CCLSUB.MA
Index: src/os8-v3f/CCLSUB.MA
==================================================================
--- src/os8-v3f/CCLSUB.MA
+++ /dev/null
@@ -1,454 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /3 CCL SIMPLE COMMAND SUBROUTINES
-
- .EXTERNAL REMD,REGO,FLAG,FOREVER,REMEM,PRMESG
- .EXTERNAL RDMON,BATCH
- .GLOBAL USRSUB,BASUB,DEASSIGN
- .EXTERNAL ASSIGN,FUDG,DVICE,LOOK,PRINT
- .ENTRY VERTN /CALLED INDEPENDENTLY BY CCL
- .GLOBAL CRSUB,EDSUB,ZERSUB
- .GLOBAL TECSUB,MAKSUB,MNGSUB
- .GLOBAL SQSUB,KILRT,RENRT,MOVRT
- .EXTERNAL CDER2,GETSPC,GCH,ZEROCD,LBEGIN
- .ENTRY CMDERR
- .ENTRY CCSUB
- .GLOBAL ARLOC /****
- MOFILE=7600
- MPARAM=7643
-
- XR2=15
- XR=16
- NAME1=23
- NAME2=24
- NAME3=25
- NAME4=26
- DELIM=32
- LXR=34
- OS78BIT=7771
- CCLNUM="3
- CCLVER="A
- .SBTTL UA,UB,UC COMMANDS
- .RSECT CCLSUB
- FIELD 1
-
-/TEST END OF TABLE
-
-USRSUB, 0
- TAD I (REMD
- SMA CLA
- JMP I (REGO /REMEMBERED A NEW LINE
- TAD I (FLAG /WANT TO
- AND (70
- CLL RTR
- RAR
- TAD (-1 /IN THIS REM-LINE
- DCA U$
- JMS I (FOREVER /NO DATE
- JMS I (REMEM
-U$: 0
- JMP I USRSUB
- .SBTTL BASIC COMMAND
-
-BASUB, 0
- TAD (200 /SET /Q SWITCH
- DCA I (MPARAM+1
- JMP I BASUB
- .SBTTL VERSION COMMAND
-
-VERTN, 0
- JMS I (RDMON /READ MONITOR
- CDF 0
- TAD I (2031 /GET PATCH LEVEL
- SNA
- TAD ("!
- AND (77
- DCA TEM$
- TAD I (2000 /GET VERSION #
- CDF 10
- SPA
-KK7600: 7600 /"0" MEANS OLD
- TAD (60
- CLL RTL
- RTL
- RTL
- TAD TEM$
- DCA I (VLOC
- CDF 0
- TAD I (OS78BIT
- AND (200 / 78
- SZA CLA / OR
- TAD (1000 / /8
- TAD (5770
- CDF 10
- DCA I (LOC78
- JMS I (PRMESG
- VMES
-TEM$: 0
- .SBTTL DEASSIGN COMMAND
-
-/ALLOW DEASSIGN FOO ?
-
-DEASSIGN,0
- TAD (7740
- DCA XR
- TAD (-17
- DCA T$
- DCA I XR
- ISZ T$
- JMP .-2
- CDF 0
- TAD I (7746
- AND (6777
- TAD (1000
- DCA I (7746
- CDF 10
- JMP I DEASSIGN
-
-T$: 0
- CHKSUP, 0
- JMS I (FUDG
- JMS I (ASSIGN
- TAD NAME1
- SNA CLA
- JMP I CHKSUP /CAN'T SUP IF NO FILENAME
- TAD I (DVICE
- JMS I (LOOK /LOOK UP FILE
- NAME1
- JMP I CHKSUP /NOT FOUND (GOOD)
- JMS I (PRINT
- SUP
- JMP I CHKSUP
- .SBTTL ZERO COMMAND
-ZERSUB, 0
- TAD I (7601
- SNA CLA /WAS FILENAME SPECIFIED ON ZERO CMD?
- TAD I KK7600 /OR WAS NO OUT DEVICE SPECIFIED?
- SNA CLA
- JMP I (CDER2 /YES... ERROR
- JMP I ZERSUB /NO, OKAY.
-
-CMDERR, JMS I (PRMESG /NOT A LEGAL KEYWORD
- ERRCMD
-
-RENMES, TEXT /FILES RENAMED:/
- PAGE
- .SBTTL PUT MACRO
- .NOLIST ME
-
- .MACRO PUT TXT
- JMS TECPUT
-
- .IF IDN TXT[1],$<
- .ENABLE ASCII
- ;TEXT <ALTMODE>"TXT[2:0]"
- .ENABLE SIXBIT
- >
-
- .IF DIF TXT[1],$<
- .ENABLE ASCII
- ;TEXT /TXT/
- .ENABLE SIXBIT
- >
-
- .ENDM
- .SBTTL MAKE COMMAND
-
- ALTMODE=233
-
-SETPA, 0
- JMS I (SETX
- "P;"A /KEEP HERE TO MAKE EASY TO PATCH
- JMP I SETPA
-
-MAKSUB, 0
- TAD DELIM
- SNA CLA
- JMP I (CMDERR /DON'T ALLOW MAKE <CR>
- JMS SETLXR
- JMS I (GETSPC
- JMS I (LOVE
- PUT "EW"
- JMS TECMOV
- JMS SETPA
- PUT "$"
- JMS I (CHKSUP
- JMS I (REMEM
- 0
- JMP I MAKSUB
-
-SETLXR, 0
- TAD I (LBEGIN
- DCA LXR
- TAD (MOFILE-1
- DCA I (TYR
- TAD (-5 /ZERO OPTION TABLE TOO
- JMS I (ZEROCD
- TAD LXR
- DCA SAVLXR
- JMP I SETLXR
-
-/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR
-
-TECPUT, 0
-/ TAD NAME1
-/ SNA CLA
-/ JMP I (CDER2
- TAD I TECPUT
- ISZ TECPUT
- SNA
- JMP I TECPUT
- JMS I (TPUT
- JMP TECPUT+1
- /MOVE CHARS FROM FIELD 0 LINE BUFFER
-/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
-/INTO TECO LINE BUFFER AT 17600
-
-TECMOV, 0
- TAD SAVLXR
- DCA XR2
- TAD SAVLXR
- CMA
- TAD LXR
- SNA CLA
- JMP I (CDER2 /NO FILE SPEC
-L$: CDF 0
- TAD I XR2
- CDF 10
- JMS I (TPUT
- TAD XR2
- CMA
- TAD LXR
- SNA CLA
- JMP I TECMOV
- JMP L$
- .SBTTL TECO COMMAND
-
-TECSUB, 0
- JMS SETLXR
- JMS I (GETSPC
- TAD DELIM
- SNA
- JMP TECNORM
- TAD (-"< /ALLOW "_" AS WELL AS "<"
- SZA
- TAD ("<-"=
- SZA
- TAD ("=-"_
- SZA CLA
- JMP I (CDER2
-1$: CDF 0
- DCA I LXR /CHANGE < TO 0
- CDF 10
- PUT "EW"
- JMS TECMOV
- JMS SETPA
- TAD LXR
- DCA SAVLXR
- JMS I (CHKSUP
- JMS I (GETSPC
- PUT "$ER"
- JMS TECMOV
- JMS SETPA
- PUT "$Y"
- JMP TECLV
- TECNORM,PUT "EB"
- JMS TECMOV
- JMS SETPA
- PUT "$Y"
-TECLV, JMS I (REMEM
- 0
- JMP I TECSUB
-SAVLXR, 0
- PAGE
- .SBTTL MUNG COMMAND
-
-TPUT, 0
- AND (177 /TECO LIKES 7-BIT
- ISZ TYR
- DCA I TYR
- TAD TYR
- TAD (-7646 /CHECK FOR OVERFLOW OF CD AREA
- SZA CLA
- JMP I TPUT
- JMS I (PRMESG
- TOOLNG
-
-MNGSUB, 0
- JMS I (SETLXR
- JMS I (GETSPC
- PUT "ER"
- JMS I (TECMOV
- JMS SETX
- "T;"E
- PUT "$YHXYHKI"
- TAD DELIM
- SNA
- JMP F$
- TAD (-",
- SZA CLA
- JMP I (CDER2
-L$: STL CLA RAR /PREVENT 'GCH' FROM HANDLING SPACE AND /
- JMS I (GCH
- AND (177 /GET RID OF HIGH ORDER BIT
- SNA
- JMP F$
- JMS TPUT
- JMP L$
-F$: PUT "$MY" /MACRO GETS CALLED WITH POINTER PAST CHARS
- JMP I MNGSUB
-TYR, 0
- /SET DEFAULT EXTENSION
-
-SETX, 0
- TAD I SETX
- DCA 1$
- ISZ SETX
- TAD I SETX
- DCA 2$ /FALL THRU 2ND EXT
- TAD NAME4
- SNA CLA
- TAD NAME1
- SNA CLA
- JMP I SETX
- TAD I TYR /GET LAST CHAR (NO EXT)
- TAD (-56 /WAS IT A DOT?
- SNA CLA
- JMP I SETX /YES
- JMS I (TECPUT /NO, USE DEFAULT EXTENSION
- ".
-1$: 0
-2$: 0
- 0
- TAD 1$
- AND (77
- CLL RTL
- RTL
- RTL
- DCA 1$
- TAD 2$
- AND (77
- TAD 1$
- DCA NAME4
- JMP I SETX
- LOVE, 0
- TAD NAME1
- TAD (-'LO
- SZA CLA
- JMP I LOVE
- TAD NAME2
- TAD (-'VE
- SZA CLA
- JMP I LOVE
- TAD NAME3
- TAD NAME4
- SZA CLA
- JMP I LOVE
- JMS I (PRINT
- LOVMES
- JMP I LOVE
-
-TOOLNG, TEXT /#COMMAND TOO LONG/
- CCSUB, 0 /USED TO FORCE THIS OVERLAY IN
- JMP I CCSUB
- PAGE
- .SBTTL CREATE COMMAND
-
-CRSUB, 0
- TAD I (7617
- SNA CLA /BETTER BE NO INPUT
- TAD I K7600 /ANYTHING THERE?
- SNA CLA
- JMP I (CDER2 /NO OUTPUT OR YES INPUT
- JMS EDSUB /REMOVE BACK-ARROW AND REMEMBER CREATE LINE
- JMP I CRSUB
- .SBTTL EDIT COMMAND
-
-EDSUB, 0
- CDF 0
- DCA I ARLOC /REPLACE ARROW BY NULL
- CDF 10
- JMS I (REMEM /REMEMBER NEW COMMAND LINE
- 1
- JMP I EDSUB
-
-ARLOC, . /LOCATION OF BACK-ARROW IN COMMAND LINE
- /'.' IS HARMLESS POINTER IN CASE NO ARROW
- .SBTTL SQUISH COMMAND
-
-SQSUB, 0
- TAD I K7600
- SZA CLA
- JMP I SQSUB
- TAD I (7617
- DCA I K7600
- JMS I (BATCH /IS BATCH RUNNING?
- JMP I SQSUB /NO
-K7600, 7600 /YES (CLEAR AC)
- TAD I K7600
- TAD (7647-1 /POINT INTO DEVICE HANDLER RESIDENCY TABLE
- DCA T$
- TAD I T$ /GET HANDLER STARTING ADDRESS
- TAD (-7607
- SZA CLA /IS SQUISHED DEVICE SYS:?
- JMP I SQSUB /NO
- JMS I (PRINT
- SQWARN /YES, WARN USER
- JMP I SQSUB
-T$: 0
- .SBTTL COPY, MOVE, AND DELETE COMMANDS
-
-KILRT, 0
- STL CLA RAR /4000 MEANS NOT PACKED
- JMS I (PRINT
- KILMES
- JMP I KILRT
-
-RENRT, 0
- JMS I (PRINT
- RENMES
- JMP I RENRT
-
-MOVRT, 0
- JMS I (PRINT
- MOVMES
- JMP I MOVRT
- VMES, TEXT \OS/8 - KBM V3A - CCL V1A\
- LOC78=VMES+1
- VLOC=VMES+6
- *.-2
- CCLNUM&77^100+<CCLVER&77>
- *.+2
-LOVMES, TEXT /NOT WAR?/
-SUP, TEXT /%SUPERSEDING/
-ERRCMD, TEXT /#ERROR IN COMMAND/
-SQWARN, TEXT /%BATCH SQUISHING SYS:!/
-MOVMES, TEXT /FILES COPIED:/
- .ENABLE ASCII
-KILMES, TEXT /Files deleted:/
- .ENABLE SIXBIT
- PAGE
DELETED src/os8-v3f/CCLTAB.MA
Index: src/os8-v3f/CCLTAB.MA
==================================================================
--- src/os8-v3f/CCLTAB.MA
+++ /dev/null
@@ -1,350 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /1 CCL OVERLAY TABLE
-
- .EXTERNAL BEGLN,PRQMRK
- .GLOBAL CCLBLC,NOCCL
- CCLTAB="H
-
-/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD
-/CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT.
-/FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE
-/OS/8 CORE-IMAGE FORMAT.
-/FOR VERSION OF THE MONITOR BEFORE LEVEL A,
-/THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS
-/OR IT READS OVER 7600.
-/BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF
-/INTO FIELD 0. 400-777 IS IGNORED BY SKIPPING A BLOCK,
-/THEN THER REST OF CCL (7 PAGES) IS READ IN.
-
- .ASECT TABLE0
- FIELD 0
-
- *400
-
-/IT LOADS OVER THE SAVE, DATE OVERLAY
-/AND STARTS AT LOCATION 600
-
-/KEYWORD TABLE IN 400-
-
-/CONSISTS OF COMMANDS 2 CHARS PER LOCATION
-/IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL)
-/SEPARATED FROM EACH OTHER BY 6-BIT 00'S.
-/EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU
-/NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX
-/BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED
-/BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
- VNO, CCLTAB
-KEYWRD,
-0530 /EX ECUT
-4543
-6564
-0002 /BA CKSP OR TER MIN
-0143
-5363
-6000
-0201 /BAS IC
-2351
-4300
-0425 /DU PLICATE
-6054
-5143
-4164
-4500
-0217 /BO OT
-5764
-0003 /CCL
-0314
-0003 /COMPA R
-1715
-2001
-6200
-0317 /COM PIL
-1560
-5154
-0003 /COP Y
-1720
-7100
-1505 /MEM ORY
-1557
-6271
-0003 /CREA TE
-2205
-0164
-4500
-0322 /CREF
-0506
-0004 /DA TE
-0164
-4500
-0405 /DEL ETE
-1445
-6445
-0004 /DE A
-0541
-0004 /DIR ECT
-1122
-4543
-6400
-0504 /ED IT
-5164
-/0005 /EO F
-/1746
-0010 /HE LP
-0554
-6000
-1411 /LIN K
-1653
-0015 /MAC R
-0103
-6200
-1411 /LI ST
-6364
-0014 /LO AD
-1741
-4400
-1501 /MAK E
-1345
-0015 /MAP
-0120
-0015 /MUNG
-2516
-0700
-2001 /PAL
-1400
-2022 /PRI NT
-1156
-6400
-2025 /PU NCH
-5643
-5000
-2205 /REN AME
-1641
-5545
-0022 /RES
-0523
-/0022 /REW IND
-/0527
-/5156
-/4400
-0003 /CA NCEL
-0156
-4345
-5400
-2305 /SET
-2400
-2313 /SK IP
-5160
-0023 /SQ UISH
-2165
-5163
-5000
-2325 /SU BMIT
-4255
-5164
-0024 /TE CO
-0543
-5700
-2431 /TY PE
-6045
-/0025 /UN LOAD
-/1654
-/5741
-/4400
-0022 /REQ U
-0521
-6500
-2165 /Q UEUE
-4565
-4500
-2501 /UA
-0025 /UB
-0200
-2503 /UC
-0026 /VE R
-0562
-0032 /ZERO
-0522
-1700
-4000 /@
- ZBLOCK 600-.
- IFDEF XYZMCR <
-
-THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE:
-
-
-HKGYJ2SR0,.KHXAHKMA
-TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM
-OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL.
-** NO EDITING **
-HKHXYHXN0UO0UB0UN
-!CHLP!^TULQL-32"EOBLANK'QL-13"EOCR'QL-26"EOEND'
-!CHLP0!QL&63+QBUT QT/8UXQX+48IQT-(8*QX)+48I
-QL"NZJ.UZGNQLIQZJXNK%N'
-%O&1"NOCHLP' QN-3"LZUH'I
-OCHLP
-!BLANK! 32UBZJ.UZGNQLIQZJXNK%NOCHLP
-!CR!
-QHJ /GNZJXN0UN0UB0ULOCHLP0
-!END!I00
-
-
-
- >
- *600
-
- JSBITS=7746
- SYSTEM=22
- PRMES=330
- ERRET=33 /THESE ARE LOCATIONS FROM OS/8 MONITOR
-
-/RUNS IN FIELD 0 ONLY.
-
-ENTRY, 0 /INITIALLY 0 MEANS 'EX' COMMAND
-LINPTR, JMP ENTREE /OS/8 JUMPS HERE (ACTUALLY TO 600)
-TEMM,
-TEKLDG, ISZ CCLNHR /TECO 'EG' JUMPS HERE
- DCA I (BEGLN /ZERO COMMAND LINE
- JMP TEGO /FIRST WE DISABLE CALLS TO MONITOR
-ENTREE, TAD (7605
- DCA ERRET
- TAD SYSTEM
- DCA MYSYS
- JMS FINDIT
- SPA CLA /WAS IT A LEGAL COMMAND?
- JMP I (PRQMRK /NO
-TEGO, TAD (6003 /YES
- DCA I (JSBITS
- CIF 10
- JMS I MYSYS /CALL USR AND LOCK IN CORE
- 10
- CLA IAC
- CIF 10
- JMS I (200
- 2
-CCLBLC, CCLSV
-CCLEN, 0
-CCLNHR, JMP NOCCL /ISZ'ED IF KBM NOT IN MEMORY
- CLA IAC
- TAD CCLBLC
- DCA CCLRDB
- JMS I (7607
-CCLCCW, 2711 /READ 27 PAGES OF CCL.SV
-CCLSTR, 2000
-MYSYS,
-CCLRDB, 7700 /INITIALLY POINTS TO USR
- JMP NOCCL
- CIF CDF 10
- JMP I CCLSTR
- CCLSV, FILENAME CCL.SV
-
-NOCCL, CLA SKP
- JMP I (7605 /GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND
- JMS I (PRMES /PRINT ERROR MESSAGE OTHERWISE
- TEXT /NO CCL!/
- 0
- /FINDS IF INPUT LINE STARTS WITH A COMMAND
-/LEAVES ENTRY # IN AC, -1 IF NOT FOUND
-/ENTRIES START AT ENTRY 0.
-/CALLABLE FROM ANY FIELD
-
-FINDIT, 0
-MORE, TAD (BEGLN-1
- DCA LINPTR
- ISZ LINPTR
- TAD I LINPTR
- TAD (-240
- SNA CLA
- JMP .-4
- JMS GETKAR
- JMP ENDOFT /NO MATCH
- JMP INTO
-FNLUP, TAD I LINPTR
- TAD (-301
- STL
- TAD (-32
- SNL CLA
- JMP NOLET /NOT A LETTER
- JMS GETKAR
- JMP MATCH
-INTO, CIA
- TAD I LINPTR
- AND (37 /5-BIT ASCII
- ISZ LINPTR
- SNA CLA /DO THEY MATCH?
- JMP FNLUP /YES
-NOMT, JMS GETKAR
- SKP
- JMP .-2 /SCAN TO NEXT ENTRY
- ISZ ENTRY
- JMP MORE
-
-NOLET, JMS GETKAR
- JMP MATCH
- CLA
- ISZ SIGNIF
- JMP NOMT
-MATCH, TAD ENTRY
- SKP
-ENDOFT, STA
-RETCIF, CDF 0 /RETURN TO CALLING FIELD (MAY BE OVERLAID)
- JMP I FINDIT
-KPTR, KEYWRD
- HALF, -1 /0 MEANS LEFT HALF
-SIGNIF, 0 /1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT
-
-/GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC
-/SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT
-/TAKES RETURN 1 IF CHAR IS 0
-/TAKES RETURN 2 OTHERWISE
-
-GETKAR, 0
- ISZ HALF
- JMP RTHALF
- TAD I KPTR
- RTR
- RTR
- RTR
- JMP INSIDE
-RTHALF, STA
- DCA HALF
- TAD I KPTR
- ISZ KPTR
-INSIDE, AND (77
- DCA TEMM
- TAD TEMM
- AND X40
-X40, SZA CLA
- STA
- DCA SIGNIF
- TAD TEMM
- SZA
- ISZ GETKAR
- AND (37
- JMP I GETKAR
- PAGE
-
DELETED src/os8-v3f/CCLTBL.MA
Index: src/os8-v3f/CCLTBL.MA
==================================================================
--- src/os8-v3f/CCLTBL.MA
+++ /dev/null
@@ -1,571 +0,0 @@
-/
-/
-/
-/COPYRIGHT (C) 1979 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-
-
-/VERSION=V3A (D.H.)
- /10 CCL INTERNAL TABLES FOR OS/78
-
- .NOLIST ME
- .GLOBAL EXTCM
- .GLOBAL YBATCH,YDATE,YTERMIN
- .GLOBAL F1,F2,LO1,LO2
- .EXTERNAL SETLPT,SETTTY,SETPTP,COLSET
- .EXTERNAL TECSUB,MAKSUB,MNGSUB
- .EXTERNAL YF4,YLOAD
- .EXTERNAL USRSUB,REQSUB,CANSUB
- .EXTERNAL MOVRT,KILRT,RENRT
- .EXTERNAL EXSUB
- .EXTERNAL TRMSUB,BASUB,MONRES,DETCOR,DATE,DEASSIGN,SQSUB,VERTN,ZERSUB
- .EXTERNAL YAT
- .EXTERNAL CRSUB,EDSUB
- .DSECT PTBL
- FIELD 0
- .ASECT SWS
- *7300
- .ASECT LONGS
- *5000
-
- .MACRO .BOX COM,SPACES,STARS
- LEN=.NCHARS COM
- .PUSH .LISTWD
- L1=LEN+4
- L2=LEN+2
- ;.LIST ME
-
-/ STARS[1:L1]
-/ *SPACES[1:L2]*
-/ * COM *
-/ *SPACES[1:L2]*
-/ STARS[1:L1]
- .POP .LISTWD
- EJECT CCL COMMANDS
- .ENDM .BOX
-
- .MACRO .EXT
- .ENDM
- .MACRO .CMD COMAND,ABBREV,CODE,EXTEN,SWITCH,SUBR,PROGRM,LABEL
- .BOX COMAND," ","****************"
- .SBTTL COMAND
- ..=.
- .DSECT PTBL
- ;..
- .SECT *
-X'ABBREV, CODE
- IFNZRO CODE&4000 <
- ;EXTEN
- .IF NBL SWITCH[1]<
- XX="SWITCH[1]&77;YY=<XX-1>%12.;7643+YY;ZZ=XX-<YY^12.>
- QQ=1
- .REPT 12.-ZZ&17
- QQ=QQ^2
- .ENDR
- ;QQ>
- .IF NBL SWITCH[2]<
- XX="SWITCH[2]&77;YY=<XX-1>%12.;7643+YY;ZZ=XX-<YY^12.>
- QQ=1
- .REPT 12.-ZZ&17
- QQ=QQ^2
- .ENDR
- ;QQ>
- ;0
- .ASECT SWS
- ..=.
- .SECT *
- .IF BL LABEL <;.. > /REMOVE IF DON'T WANT MULTIPLE CHARACTER SWITCHES
- .IF NB LABEL <;LABEL>
- ;SUBR
- .IF NB PROGRM<
- ;Y'PROGRM>
- .IF BL PROGRM<
- ;0>
- >
- IFZERO CODE&4000 <
- ;EXTEN
- .IF NB SWITCH<
- ;Y'SWITCH>
- .IF BL SWITCH<
- ;0>
- >
- .ENDM
- .MACRO .QUAL LONG,SHORT,NAME
- .ASECT LONGS
- ..=.
- ;TEXT "LONG[1:6]";"SHORT
- .SECT *
- .ASECT SWS
- .IF NB NAME <NAME=.>
- ;..
- .SECT *
- .ENDM
- .MACRO .ENDQ
- .ASECT SWS
- ;0
- .SECT *
- EJECT CCL COMMANDS
- .ENDM
- .ASECT TABLES
- FIELD 0
- *6200
- .CMD EXECUTE,EX,5033, EXTEXE, G, EXSUB, PAL8 /MUST BE FIRST FOR TECO EG
- .ENDQ
- .CMD BACKSPACE,BA,0, TRMSUB, CAMP
- .ENDQ
- .CMD BASIC,BAS,0, BASUB, BASIC
- .ENDQ
- .CMD DUPLIC,DU,4001, STAR, , 0, RXCOP
- .QUAL NOCOPY,M
- .QUAL NOMATCH,N
- .QUAL PAUSE,P
- .QUAL READONLY,R
- .QUAL VERSION,V
- .ENDQ
- .CMD BOOT,BO,0, 0, BOOT
- .ENDQ
- .CMD CCL,CCL,0, MONRES,
- .ENDQ
- .CMD COMPARE,COMPA,4001, EXTNUL, , SETTTY, SRCCOM
- .QUAL NOCOMMENTS,C
- .QUAL NOSPACES,S
- .QUAL TABS,T
- .QUAL BLANKS,B
- .QUAL NOPRINTCOMMENTS,X
- .ENDQ
- .CMD COM,COM,5033, EXTCOM, , EXSUB, PAL8
- .QUAL NOISN,N
- .QUAL OPTIMIZE,Q
- .QUAL GO,G
- .ENDQ
- .CMD COPY,COP,4001, STAR, L, MOVRT, FOTP
- .QUAL NOCOPY,D
- .QUAL NOPREDELETE,N
- .QUAL RENAME,R
- .QUAL FAILSAFE,F
- .QUAL CURRENT,C,LSTOPT
- .QUAL LOG,L
- .QUAL OTHER,O
- .QUAL QUERY,Q
- .QUAL INQUIRE,Q
- .QUAL INSPECT,Q
- .QUAL TODAY,T
- .QUAL UGLY,U
- .QUAL INDEPENDENTLY,U
- .QUAL INVERT,V
- .QUAL EXCEPT,V
- .QUAL VERSION,W
- .QUAL V,V
- .ENDQ
- .CMD MEMORY,MEM,0, DETCOR,
- .ENDQ
- .CMD CREATE,CREA,4400, EXTNUL, , CRSUB, EDIT
- .QUAL SPACES,B
- .ENDQ
- .CMD CREF,CREF,4002, EXTCF, C, 0, PAL8
- .QUAL NOLIST,P
- .QUAL NOSYMTAB,U
- .QUAL RALF,R
- .QUAL SABR,S
- .QUAL NOLITERALS,X
- .QUAL KEEP,E
- .QUAL MAMMOTH,M
- .QUAL MOBY,M
- .ENDQ
- .CMD DATE,DA,0, DATE,
- .ENDQ
- .CMD DELETE,DEL,4001, STAR, LD, KILRT, FOTP,LSTOPT
- .CMD DEASSIGN,DE,0, DEASSIG,
- .ENDQ
- .CMD DIRECT,DIR,4001, STAR, ,COLSET, DIRECT
- .QUAL BLOCKS,B
- .QUAL CURRENT,C
- .QUAL EXTENDED,E
- .QUAL FAST,F
- .QUAL BRIEF,F
- .QUAL ADDITIONAL,I
- .QUAL EMPTIES,M
- .QUAL FREE,M
-/ .QUAL INDEPENDENTLY,U
- .QUAL OTHER,O
- .QUAL REMAINDER,R
- .QUAL UGLY,U
- .QUAL INVERT,V
- .QUAL EXCEPT,V
- .QUAL VERSION,W
- .QUAL V,V
- .QUAL COLUMNS,Z /DUMMY
- .ENDQ
- .CMD EDIT,ED,5220, EXTNUL, , EDSUB, EDIT
- .QUAL SPACES,B
- .QUAL PREDELETE,D
- .QUAL DELETE,D
- .ENDQ
- / .CMD EOF,EO,0, 0, CAMP
-/ .ENDQ
- .CMD HELP,HE,4001, STAR, T, SETTTY, HELP
- .ENDQ
- .CMD LINK,LIN,5033, EXTLI, , EXSUB, LINK
- .QUAL GO,G
- .QUAL HALTS,H
- .QUAL JUMPS,J
- .QUAL JMPS,J
- .QUAL CORE,K
- .QUAL MEMORY,K
- .QUAL VERSION,V
- .QUAL START,S
- .QUAL JSW,W
- .QUAL M,M
- .ENDQ
- .CMD MAC,MAC,5033, EXTMA, , EXSUB, MACREL
- .QUAL BLOCK,B
- .QUAL HEADING,B
- .QUAL HDR,B
- .QUAL CREF,C
- .QUAL KREF,C
- .QUAL GO,G
- .QUAL NOCONDITIONALS,J
- .QUAL LINK,L
- .QUAL PERM,M
- .QUAL NOLIST,N
- .QUAL OMIT,O
- .QUAL NOMACROS,O
- .QUAL RESET,P
- .QUAL EAE,Q
- .QUAL REMOVE,R
- .QUAL REDUNDANT,R
- .QUAL DESTROY,Z
- .QUAL NOBATCH,Z
- .QUAL EXTENDED,X
- .QUAL K,K
- .QUAL P,P
- .ENDQ
- .CMD LIST,LI,4001, STAR, U, SETLPT, FOTP,LSTOPT
- .CMD LOAD,LO,5031, EXTLO, , EXSUB, ABSLDR
- .QUAL IMAGE,I
- .QUAL MULTIPLE,S
- .QUAL SLURP,S
- .QUAL GO,G
-/ /8 /9 /START:N /FIELD:F /P
- .ENDQ
- .CMD MAKE,MAK,0, MAKSUB, TECO
- .ENDQ
- .CMD MAP,MAP,4001, EXTBN, , SETTTY, BITMAP
- .QUAL MULTIPLE,S
- .QUAL SLURP,S
- .QUAL INVERT,T
-/ FIELD:N
- .ENDQ
- .CMD MUNG,MUNG,0, MNGSUB, TECO
- .ENDQ
- .CMD PAL,PAL,5033, EXTPA, , EXSUB, PAL8
- .QUAL SHIFT,B
- .QUAL CREF,C
- .QUAL DDT,D
- .QUAL NOLINKS,E
- .QUAL NOFILL,F
- .QUAL GO,G
- .QUAL NONPAGINATED,H
- .QUAL NOCONDITIONALS,J
- .QUAL LOAD,L
- .QUAL NOLIST,N
- .QUAL NOORIG,O
- .QUAL NOSYMTAB,S
- .QUAL NOREMEMBERLITERALS,W
- .QUAL WIDE,7
- .QUAL W,W
- .ENDQ
-/ /K /T
- .CMD PRINT,PRI,4000, STAR, , SETLPT, LPTSPL
- .ENDQ
- .CMD PUNCH,PU,4001, EXTNUL, , SETPTP, PIP
-/ .QUAL ASCII,A
-/ .QUAL BINARY,B
-/ .QUAL ELIMINATE,C
-/ .QUAL PREDELETE,D
-/ .QUAL DELETE,D
-/ .QUAL IGNORE,G
-/ .QUAL IMAGE,I
-/ .QUAL TABS,T
-/ .QUAL VERSION,V
-/ .QUAL V,V
- .ENDQ
- .CMD RENAME,REN,4001, STAR, LR,RENRT,FOTP,LSTOPT
- .CMD RESOURCES,RES,4001, EXTSY, , SETTTY, RESORC
- .QUAL DETAILED,E
- .QUAL EXTENDED,E
- .QUAL BRIEF,F
- .QUAL FAST,F
- .ENDQ
-/ .CMD REWIND,REW,0, 0, CAMP
-/ .ENDQ
- .CMD CANCEL,CA,0,CANSUB,
- .ENDQ
- .CMD SET,SET,0, 0, SET
- .ENDQ
- .CMD SKIP,SK,0, 0, CAMP
- .ENDQ
- .CMD SQUISH,SQ,4001, EXTNUL, S, SQSUB, PIP
- .QUAL OK,O
- .QUAL NOCONFIRM,O
- .ENDQ
- .CMD SUBMIT,SU,4000, EXTBI, , 0, BATCH
- .QUAL CARDS,C
- .QUAL NONFATAL,E
- .QUAL PAPERTAPE,P
- .QUAL QUIET,Q
- .QUAL HUSH,H
- .QUAL TERMINAL,T
- .QUAL TTY,T
- .QUAL UNATTENDED,U
- .QUAL VERSION,V
- .QUAL 026,6
- .ENDQ
- .CMD TECO,TE,10, TECSUB, TECO
- .ENDQ
- .CMD TYPE,TY,4001, STAR, U, SETTTY, FOTP,LSTOPT
-/ .CMD UNLOAD,UN,0, 0, CAMP
-/ .ENDQ
- .CMD REQUEST,REQ,4000,EXTSV,,REQSUB,
- .ENDQ
- .CMD QUEUE,Q,4000,STAR,,0,QUEUE
- .QUAL LIST,L
- .QUAL KILL,K
- .QUAL STOP,S
- .QUAL GO,G
- .QUAL START,G
- .QUAL NOH,H
- .QUAL DELETE,D
- .QUAL COPIES,C
- .ENDQ
- .CMD UA,UA,40, USRSUB,
- .ENDQ
- .CMD UB,UB,50, USRSUB,
- .ENDQ
- .CMD UC,UC,60, USRSUB,
- .ENDQ
- .CMD VERSION,VE,0, VERTN,
- .ENDQ
- .CMD ZERO,ZERO,4401, EXTNUL, Z, ZERSUB, PIP
- .ENDQ
-/ .CMD @,@,0, YAT,
-/ .ENDQ
- ..=.
- 0;YAT;0
- .DSECT PTBL
- ..
- 0;0
- /PTBL, XEXE
-/ XBAC
-/ XBAS
-/ XDUPL
-/ XBOO
-/ XCCL
-/ XCOMPA
-/ XCOMPI
-/ XCOP
-/ XCOR
-/ XCREA
-/ XCREF
-/ XDAT
-/ XDEL
-/ XDEA
-/ XDIR
-/ XEDI
-/ XEOF
-/ XHEL
-/ XLINK
-/ XMAC
-/ XLIS
-/ XLOA
-/ XMAK
-/ XMAP
-/ XMUN
-/ XPAL
-/ XPRI
-/ XPUN
-/ XREN
-/ XRES
-/ XREW
-/ XSET
-/ XSKI
-/ XSQU
-/ XSUB
-/ XTEC
-/ XTYP
-/ XUNL
-/ XUA
-/ XUB
-/ XUC
-/ XVER
-/ XZER
-/ XAT
- .EXT ALG=AL
- .EXT BAK=BK
- .EXT BAS=BA
- .EXT BIN=BN
- .EXT BUG=BG
- .EXT CMD=CM
- .EXT COM=CM
- .EXT CRF=CF
- .EXT CTL=CM
- .EXT DAT=DA
- .EXT DIR=DI
- .EXT DOC=DC
- .EXT HLP=HL
- .EXT INI=IN
- .EXT LOG=LG
- .EXT LPT=LP
- .EXT LST=LS
- .EXT MAC=MA
- .EXT MAN=MN
- .EXT MAP=MP
- .EXT MEM=ME
- .EXT OLD=OL
- .EXT PAL=PA
- .EXT REL=RL
- .EXT RIM=RM
- .EXT RNO=RO
- .EXT SAV=SV
- .EXT EXE=SV
- .EXT SNO=SN
- .EXT SRC=SR
- .EXT SYS=SY
- .EXT TEC=TE
- .EXT TEM=TM
- .EXT TMP=TM
- .EXT TXT=TX
- .EXT BAT=BI
- .EXT FOR=FT
- .EXT RLF=RA
- .EXT OBJ=RB
- .EXT SBR=SB
- .EXT FTN=FT
- .ASECT EXTNS
- FIELD 0
- *6600
-STAR, 5200; 0
- 0; 0
-
-
-EXTSY, 'SY; 0
- 0; 0
-EXTBI, 'BI; 0
- 0; 0
-EXTCF, 'PA; YPAL8
- 0; YPAL8
-EXTMA, 'MA; YMACREL
- 0; YMACREL
-EXTPA, 'PA; YPAL8
- 0; YPAL8
-EXTBN, 'BN; 0
- 0; YABSLDR
-EXTNUL, 0; 0
-EXTLO, 'BN; YABSLDR
- 'RL; LO1,YLOAD /****
-EXTLI, 'RB; YLINK
- 0; 0
-EXTCM, 'CM; 0
- 0; 0
-EXTSV, 'SM; 0
- 'SV; 0
- 0; 0
- EXTEXE, 'PA; YPAL8
- 'FT; F1,YF4 /****
- 'BA; YBCOMP
- 'MA; YMACREL
- 'BN; YABSLDR
- 'RL; LO2,YLOAD /****
- 'RA; YRALF
- 'SB; YSABR
- 'RB; YLINK
- 'LD; YFRTS
- 'BI; YBATCH
- 0; 0
- ZBLOCK 4
-EXTCOM, 'PA; YPAL8
- 'FT; F2,YF4 /****
- 'MA; YMACREL
- 'BA; YBCOMP
- 'RA; YRALF
- 'SB; YSABR
- 0; 0
- ZBLOCK 4
- .ASECT FNAMES
- FIELD 0
- *7000
-YEDIT, FILENAME EDIT.SV
- *.-1
-YBOOT, FILENAME BOOT.SV
- *.-1
-YBITMAP,FILENAME BITMAP.SV
- *.-1
-YSRCCOM,FILENAME SRCCOM.SV
- *.-1
-YBCOMP, FILENAME BCOMP.SV
- *.-1
-YPAL8, FILENAME PAL8.SV
- *.-1
-YFOTP, FILENAME FOTP.SV
- *.-1
-YDIRECT,FILENAME DIRECT.SV
- *.-1
- YPIP, FILENAME PIP.SV
- *.-1
-YABSLDR,FILENAME ABSLDR.SV
- *.-1
-YTECO, FILENAME TECO.SV
- *.-1
-YLPTSPL,FILENAME LPTSPL.SV
- *.-1
-YCAMP, FILENAME CAMP.SV
- *.-1
-YSET, FILENAME SET.SV
- *.-1
-YBASIC, FILENAME BASIC.SV
- *.-1
-YRXCOP, FILENAME RXCOPY.SV
- *.-1
-YRESORC,FILENAME RESORC.SV
- *.-1
-YBATCH, FILENAME BATCH.SV
- *.-1
-YRALF, FILENAME RALF.SV
- *.-1
-YSABR, FILENAME SABR.SV
- *.-1
-YFRTS, FILENAME FRTS.SV
- *.-1
-YHELP, FILENAME HELP.SV
- *.-1
-YMACREL,FILENAME MACREL.SV
- *.-1
-YLINK, FILENAME LINK.SV
- *.-1
-YDATE, FILENAME DATE.SV
- *.-1
-YTERMIN,FILENAME TERMIN.SV
- *.-1
-YQUEUE, FILENAME QUEUE.SV
- *.-1
-YCANCEL,FILENAME CANCEL.SV
- *.-1
-
DELETED src/os8-v3f/CD.PA
Index: src/os8-v3f/CD.PA
==================================================================
--- src/os8-v3f/CD.PA
+++ /dev/null
@@ -1,1688 +0,0 @@
- XLIST
-/8 COMMAND DECODER FOR OS/8 MONITOR
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974, 1975, 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /APRIL 1977 RL/EF/HJ/SR
-
-/ABSTRACT--
-/COMMAND DECODER (CD) ACCEPTS TTY INPUT AND INTERPRETS
-/THAT INPUT AS A LIST OF OPTIONS AND FILE SPECIFICATIONS
-/FOR OS/8 CUSPS. TABLES ARE SETUP INDICATING THE SPECIFIED
-/FILES AND OPTIONS.
-/THIS VERSION OF CD IS CAPABLE OF RUNNING OS/8 BATCH.
-/MODIFICATIONS TO INITIALIZATION CODE HAVE BEEN MADE TO
-/ALLOW THIS.
-
-
- DCB=7760
- SHNDLR=7607
- USERFG=40 /LOCATION IN MAIN OS/8 ASSEMBLY - VOLATILE
- T1=41 /DITTO
- MCDREC=51 /ALSO PRETTY VOLATILE
- MOFILE=7600
- MIFILE=7617
- MPARAM=7643
- FIELD 0 /JUSTINCASE
-
- CDVERSION=6501 /5A
- ODTVERSION=6601 /6A
- /V3 CHANGES TO CD:
-
-/1. FIXED LOTS OF BUGS
-/ A:B:C IS ILLEGAL
-/ 15-BIT = OPTION DOESN'T DESTROY ALTMODE BIT
-/2. ADDED ? SUPPORT IN SPECIAL MODE
-/3. ALLOWED SPECIAL MODE UNDER BATCH
-/4. REMOVED DCC CODE
-/5. ^U, RO TO BOL, AND LF ALL REPRINT *
-/6. VERSION # AT LOC ZERO
-/7. DON'T LOAD HANDLERS FOR OUTPUT DEVICE
-/8. CHANGED _ TO < STANDARD
-
-/V3 CHANGES TO ODT
-
-/1. REMOVED DCC CODE
-/2. FIXED CORE SIZE ROUTINE
-/3. ALLOWED SOFTWARE CORE SIZE
-/4. MODIFIED 'GO' COMMAND SO THAT IT DOESN'T RESTORE TRAP
-/ LOCATION TO UNMODIFIED VALUE
-/5. FIXED BUG RE: JMS'S OUT OF FIELD WITH MAGIC LOCATION SET
-/6. TURN OFF INTERRUPTS ON BREAKPOINT
-
-/CHANGES AFTER FIELD TEST RELEASE:
-
-/1. FIXED BUG RE FILE LENGTHS GT 2047 BLOCKS
-
-/MAINTENANCE RELEASE:
-
-/ NO CHANGES
-
-/V3D CHANGES:
-
-/CHANGED FORMAT OF VERSION NUMBERS
- *200
-CD, JMP I NUMBER /EXECUTED IN SYSGEN
-NUM, JMP I T
-ANALYZ, TAD [BEGLN-1
- DCA XR
- TAD I XR
- SNA
- JMP NOBKAR
- TAD [-"<
- SZA CLA
- JMP .-5
- CLA CMA
-NOBKAR, DCA OUTSW
- TAD [BEGLN-1
- DCA LXR
-BEGGRP, TAD OUTSW
- SNA CLA
- TAD BEGDIF /DIFF BETWEEN INPUT & OUTPUT AREAS
- TAD [MOFILE-1
- DCA CLXR
- STA
- DCA DVFLAG
- DCA DEV1
-FILLP1, DCA DEV2
-FILLP, JMS I [GNAME
- TAD ["A-": /AC CONTAINED DELIM - "A
- SNA CLA
- JMP DEVNAM
- JMS I [ASSIGN
- TAD OUTSW
- SNA CLA
- TAD LIMDIF /DIFF BETWWEN END OF OUTPUT & INPUT AREAS
- TAD OUTLIM /END OF OUTPUT AREA
- TAD CLXR
- SMA CLA
- JMP CDER1
- TAD OUTSW
- SNA CLA
-LKUPSW, JMP INFILE /ZEROED IF IN "SPECIAL DECODE" MODE
- CDF 10
- TAD DVICE
- DCA I CLXR
- TAD NAME1
- DCA I CLXR
- TAD NAME2
- DCA I CLXR
- TAD NAME3
- DCA I CLXR
- TAD NAME4
-CDSKP, SKP
-INFILE, JMS I [LOOKUP
- DCA I CLXR
-DLOOK, CDF 0
- STA
- DCA DVFLAG
- TAD DELIM
- SNA
- JMP CDOVER
- TAD [-"[
- SNA
- JMP I [OLENGT
- TAD ["[-",
- SNA
- JMP FILLP
- TAD [",-"<
- SNA
- JMP BKAROW
- TAD ["<-"=
- SZA CLA
- JMP I [CDER2
-EQUAL, DCA NUMFUJ
- JMS NUMBER
- DCA I [MPARAM+3
- CLA CLL CML RAR
- AND I [MPARAM-1 /PRESERVE ALTMODE
- TAD HIORD
- DCA I [MPARAM-1
- JMP DLOOK
- BKAROW, ISZ OUTSW
- JMP I [CDER2
- JMP BEGGRP
-DEVNAM, TAD NAME1
- DCA DEV1
- ISZ DVFLAG
- JMP I [CDER2 /CATCHES A:B:
- TAD NAME2
- JMP FILLP1
-CDOVER, TSF
- JMP .-1 /LET PRINTER QUIET DOWN
- TCF /AND CLEAR FLAG
- CDF CIF 10
- TAD TMONIT
- DCA I [200 /RESTORE "MONITO"
- TAD TUSRFG
- DCA I [USERFG /RESTORE "USER FLAG"
- TAD TFPUTX /LOAD "USER CALLING FIELD" INTO AC
- JMP I CD /RETURN - MONITOR RESTORES CORE IF NECESSARY
-NUMBER, 4000 /USED BY SYSGEN
- TAD CDSKP
- DCA NUMADD /SET NUMADD TO EITHER "SKP" OR "TAD NUM"
- DCA HIORD
-NUMLP, DCA NUM
- JMS NUMTST /INTO PAGE 0 FOR RANGE TEST
- SNL
- JMP EONUM
- DCA T
- CLA CLL CMA RTL
- DCA DELIM
- TAD NUM
-ROTLP, CLL RAL
- DCA NUMX
- TAD HIORD
- RAL
- SPA
- JMP I [CDER2
- DCA HIORD
- TAD NUMX
- ISZ DELIM
- JMP ROTLP
-NUMADD, TAD NUM /SKP IF OCTAL
- TAD NUM
- TAD T
- JMP NUMLP
-EONUM, TAD ["0
- DCA DELIM
- TAD NUM
- CDF 10
- JMP I NUMBER
- CDER1, JMS I [PRMESG
- TEXT /TOO MANY FILES/
- IFZERO .&400 <*400>
-ASSIGN, 0
- TAD CLXR
- AND DVFLAG
- TAD OUTLIM
- SMA SZA CLA /CHECK FOR OUTPUT OR FIRST INPUT
- JMP ASNORM /IF DEVICE WAS SPECIFIC, OR IF WE ARE ON THE INPUT SIDE,
- /PROCEED NORMALLY
- TAD NAME1
- SNA CLA
- JMP ASGNST
- TAD DFLTNM+1
- DCA DEV2
- TAD DFLTNM
- DCA DEV1
-ASNORM, TAD DEV1
- DCA AS+1
- TAD DEV2
- DCA AS+2
- TAD OUTSW
- SNA CLA /DON'T LOAD HANDLER IF WE ARE ON OUTPUT SIDE OF "_"
- TAD NAME1
-SPKLG1, SNA CLA /OR IF THERE IS NO FILE NAME TO LOOK UP
- TAD GETHND /GETHND=11 NORMALLY, 0 IF IN "SPECIAL DECODE" MODE
- IAC
- DCA AS
- TAD [1401 /ALLOW TWO PAGE HANDLERS
- DCA ASADR
- CIF 10
- JMS I [200
-AS, 0
- 0
- 0
-ASADR, 1401
- JMP I [CDER0
- TAD AS+2
-ASGNST, DCA DVICE
- JMP I ASSIGN
-GNAME, 0
- DCA NAME1
- DCA NAME2
- DCA NAME3
- DCA NAME4
- TAD [NAME1
- DCA NMBASE
- CLA CMA
- DCA PERDSW
- DCA NAMECT
-GTNMLP, JMS I [GCH
- DCA DELIM
- TAD DELIM
- TAD [-"?
- SZA
- TAD ["?-"*
- SNA
-STARSW, JMP I [CDER2 /"JMP STARNM" IF "SPECIAL DECODE" MODE
- TAD ["*-".
- SNA CLA
- JMP PERIOD
- JMS I [DECODE
- JMP I GNAME
- STARNM, CLA /THIS CODE HANDLES *'S AND ?'S CORRECTLY
- TAD DELIM
- AND [77
- DCA DELIM
- TAD NAMECT
- TAD [-6
- SMA CLA
- JMP GTNMLP
- TAD NAMECT
- CLL RAR
- TAD NMBASE
- DCA TT
- TAD DELIM
- SZL
- JMP .+4
- RTL
- RTL
- RTL
- TAD I TT
- DCA I TT
- ISZ NAMECT
- JMP GTNMLP
-PERIOD, TAD NAME1
- SZA CLA
- ISZ PERDSW
- JMP I [CDER2
- ISZ NMBASE
- TAD [4
- JMP GTNMLP-1
-LOOKUP, 0
- DCA LNAME
- TAD NAME1
- SNA CLA
- JMP LKUPST
- JMP EXT1
-LKUPLP, DCA LNAME
- TAD AS+2
- CIF 10
- JMS I [200
- 2
-LNAME, 0 /NAME1
-LENGTH, 0
- JMP LFAILD
- TAD LENGTH
- CLL
- TAD [400
- SNL
- CLA
- CLL RTL
- RTL
- AND [7760
-LKUPST, CDF 10
- TAD DVICE
- DCA I CLXR
- TAD LNAME
- JMP I LOOKUP
- LFAILD, TAD NAMECT
- SNA CLA /WAS THERE AN EXPLICIT EXTENSION?
- TAD DEFALT /NO - WAS THERE A DEFAULT EXTENSION?
- SNA CLA
- JMP I [CDER3 /YES OR NO - FILE NOT FOUND
- ISZ NAMECT /NO AND YES - SET FLAG TO FAIL NEXT TIME
- JMP EXT2 /ZERO OUT THE EXTENSION AND TRY AGAIN
-CDER3, JMS I [PRNAME
- JMS I [PRMESG
- TEXT / NOT FOUND/
- IFZERO .+200&1000 <*600>
- 0 /V3 [FREE LOC]
-SLSHCH, 0
-/V3 SNA
-/V3 JMP I [CDER2
- DCA DELIM
- TAD [MPARAM-1
- DCA T
- JMS I [DECODE
- JMP I [CDER2
- SZL
- TAD [32
- CMA STL /THE FOLLOWING TURNS ON THE CORRECT OPTION BIT
- DCA TT
-SLSHLP, SZL
- ISZ T
- RAR
- SNL
- ISZ TT
- JMP SLSHLP
- DCA TT
- CDF 10
- TAD TT
- CMA
- AND I T
- TAD TT
- DCA I T
- CDF 0
- JMP I SLSHCH
-DECODE, 0
- TAD DELIM
- TAD [-"9-1
- CLL
- TAD ["9+1-"0
- SZL
- JMP DCDYES
- TAD ["0-"Z-1
- CLL CML
- TAD ["Z-"A+1
- SNL
-DCDYES, ISZ DECODE
- JMP I DECODE
-CDER0, TAD DEV1
- JMS I [PRWD
- TAD DEV2
- JMS I [PRWD
- JMS I [PRMESG
- TEXT / DOES NOT EXIST/
-
-RESTRT, JMS I [CRLF
- CDF 10
- TAD [MOFILE-1
- DCA XR
- TAD [-47
- DCA T
- DCA I XR /ZERO OUT THE COMMAND DECODER OUTPUT AREA
- ISZ T
- JMP .-2
- CDF 0
- JMP I [GLINE
-GCH, 0
- TAD I LXR
- TAD [-240
- SNA
- JMP GCH+1
- TAD [240-"/
- SNA
- JMP SLASH
- TAD ["/-"(
- SNA
- JMP OPENP
- TAD ["(
- JMP I GCH
-SLASH, TAD I LXR
- JMS I [SLSHCH
- JMP GCH+1
-OPENP, TAD I LXR
- TAD [-")
- SNA
- JMP GCH+1
- TAD [")
- JMS I [SLSHCH
- JMP OPENP
-OLENGT, TAD OUTSW
- AND NAME1 /[N] IS ONLY LEGAL ON THE OUTPUT SIDE OF THE "_"
- SNA CLA /AND ONLY AFTER A FILE NAME
- JMP I [CDER2
- TAD [-4
- TAD CLXR
- DCA NMBASE
- CLA CLL CML RTL
- DCA NUMFUJ /SET "NUMBER" TO ACCEPT DIGITS 8 AND 9
- TAD OLFUDJ /LOAD FUDGE SO THAT "NUMBER" WILL BE DECIMAL
- JMS I [NUMBER
- CLL RTL
- RTL
- AND [7760
- TAD I NMBASE
- DCA I NMBASE
- CDF 0
- TAD DELIM
- TAD [-"] /IS THERE A CLOSING BRACKET?
- SNA /IF NOT, "DLOOK" ROUTINE WILL DETECT IT
- JMS I [GCH
- DCA DELIM
- JMP I [DLOOK
-OLFUDJ, NUM&177+1570
-
-CDER2, CLA
- JMS I [PRMESG
- TEXT /ILLEGAL SYNTAX/
- IFZERO .&1000 <*1000>
- /TELETYPE INPUT ROUTINE FOR COMMAND DECODER
-GLINE, TAD (252 /SETS 1177=252 FOR * IN MESSAGE
- JMS I PRINT
- DCA RBFLAG
- TAD [BEGLN-1
- DCA LXR
-CHLOOP, 6031 /KSF
- JMP CHLOOP
- TAD [200
- 6034 /KRS
- DCA NAME1
- 6032 /KCC
- TAD [SPADR-1
- DCA XR
-DSPCHL, TAD I XR
- SZA
- TAD NAME1
- SNA CLA
- JMP I XR
- JMP DSPCHL
-SPADR, -225;JMP CTRLU
- -215;JMP CARRET
- -377;JMP RUBOUT
- -375;JMP ALTMOD /V3D MODIFIED BY SET
- -376;JMP ALTMOD /V3D MODIFIED BY SET
- -233;JMP ALTMOD
- -200;JMP CHLOOP
- -217;JMP CHLOOP /^O
- -"_;JMP LESSTN
- -212;JMP LFEED
- -203;JMP CTRLC /MUST BE LAST - SEE CLRLIN CODE
- 0
- JMS PRNT
-CINSRT, TAD NAME1
- DCA I LXR
- TAD LXR
- TAD [-EOBUFR+2
- SPA CLA
- JMP CHLOOP
- JMS CRLF
- JMP I [CDER2
- CARRET, JMS CRLF
-CLFINI, DCA I LXR
- JMP I [ANALYZ
-LESSTN, JMS PRNT
- TAD ["<
- JMP CINSRT+1
-CTRLC,
-CTRLU, TAD [336
- JMS I PRINT
- TAD NAME1
- TAD [100
-CLRLIN, JMS I PRINT
- JMS CRLF
- TAD I XR
- SZA CLA
- JMP GLINE
- CDF 10
- CLA CMA
- DCA I [7700
- TSF
- JMP .-1
- JMP I [7605 /7605=CDF CIF 10
-CRLF, 0
- TAD [215
- DCA NAME1
- JMS PRNT
- TAD [212
- JMS I PRINT
- JMP I CRLF
-ALTMOD, TAD [244
- DCA NAME1
- CLA CLL CML RAR
- CDF 10
- DCA I [MPARAM-1
- CDF 0
- JMS PRNT
- JMP CLFINI
- /*** LOCATIONS ON THIS PAGE ARE MODIFIED BY SET
-/SEE SET FOR DETAILS. DO NOT CHANGE.
-
-RUBOUT, TAD LXR
- TAD [1-BEGLN
- SNA CLA
- JMP RBSPCL
- TAD [334
- ISZ RBFLAG
- JMS I PRINT
- CLA CMA
- DCA RBFLAG
- TAD LXR
- DCA T
- TAD I T
- JMS I PRINT
-LBCKUP, CLA CMA
- TAD LXR
- JMP CHLOOP-1
-RBSPCL, ISZ RBFLAG
- JMP CLRLIN+1
- TAD [334
- JMP CLRLIN
-PRNT, 0
- ISZ RBFLAG
- JMP .+3
- TAD [334
- JMS I PRINT
- DCA RBFLAG
- TAD NAME1
- JMS I PRINT
- JMP I PRNT
-LFEED, JMS CRLF
- DCA I LXR
- TAD [BEGLN-2
- DCA XR
- TAD I XR
- SNA
- JMP LBCKUP
- JMS I PRINT
- JMP .-4
-
- IFNZRO RUBOUT-1131 <_ERROR_>
- *1200 /INITIALIZATION - STORED OVER BY LINE BUFFER
- BEGLN=. /LINE BUFFER
-CDINIT, DCA TFPUTX
- CDF 10
- CLA IAC
- TAD I [200
- DCA TMONIT /SAVE AWAY MONITOR CALL ADDRESS SINCE WE CALL
- TAD I [USERFG /THE MONITOR RECURSIVELY, LIKEWISE SAVE
- DCA TUSRFG /THE "USER FLAG" AND THE FIELD WE WERE CALLED FROM
- TAD I [T1 /FETCH THE USERS ARGUMENT
- DCA DEFALT /STORE IN THE DEFAULT EXTENSION WORD
- DCA I [7 /ZERO "DIRECTORY SEGMENT IN CORE" KEY
- CDF 0
- CIF 10
- JMS I [200
- 13 /RESET ALL HANDLERS
- 0 /BUT NOT OUTPUT FILES
- TAD DEFALT
- TAD M5200
- SZA CLA /IS THIS A REQUEST FOR A "SPECIAL DECODE"?
- JMP CDCONT /NO
- TAD ALTLIM
- DCA OUTLIM /YES - SET UP ALL THE PROPER LOCATIONS
- TAD ALTDF1
- DCA LIMDIF /TO YIELD 1 OUTPUT FILE AND 5 INPUT FILES
- TAD ALTDF2
- DCA BEGDIF /ALL OF WHICH ARE 5-WORD <DEVICE,NAME> ENTRIES
- DCA I PLKUPS
- TAD STARJM
- DCA I PSTARS /AND ALLOW * AS A FILE OR EXTENSION NAME
- DCA DEFALT /NO DEFAULT EXTENSION IN "SPECIAL" MODE
- TAD CCLA /STOPS FETCHES IN SPECIAL MODE
- DCA I PSPKG1 /NO HANDLER FETCHES NECESSARY EITHER SINCE NO LOOKUPS
-CDCONT, TAD I PRWD /SEE IF BATCH FLAG IS UP
- RAL
- SPA CLA /IF YES, GO TO PAGE0 CODE
- JMP TT /TT ETC. IS ONCE-ONLY CODE
- JMP I CDRST
- CDRST, RESTRT+1
- /CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
-M5200, -5200
-ALTLIM, 1-MOFILE-5
-ALTDF1, MOFILE+5-MPARAM+5
-ALTDF2, 5
-PLKUPS, LKUPSW
-STARJM, STARNM&177+5200 /"JMP STARNM"
-PSTARS, STARSW
-CCLA, CLA
-PSPKG1, SPKLG1
- *1314
- EOBUFR=.
-PRMESG, 0
- TAD I PRMESG
- JMS PRWD
- TAD I PRMESG
- ISZ PRMESG
- AND [77
- SZA CLA
- JMP PRMESG+1
- JMP I [RESTRT
-PRWD, 7777
- DCA T
- TAD T
- RTR
- RTR
- RTR
- JMS PCHAR
- TAD T
- JMS PCHAR
- JMP I PRWD
-PCHAR, 0
- AND [77
- SNA
- JMP I PCHAR /IGNORE NULLS
- TAD [240
- AND [77
- TAD [240
- JMS TYPE
- JMP I PCHAR
-PRNAME, 0
- TAD NAME1
-/ SNA /WOULD LIKE TO FIND ROOM FOR THESE 2 LOCS
-/ JMP I [CDER2
- JMS PRWD
- TAD NAME2
- JMS PRWD
- TAD NAME3
- JMS PRWD
- TAD NAME4
- SNA CLA
- JMP I PRNAME
- TAD [256
- JMS PCHAR
- TAD NAME4
- JMS PRWD
- JMP I PRNAME
-TYPE, 0
- JMP .+3
- TSF
- JMP .-1
- TLS
- CLA
- TAD [7000
- DCA TYPE+1
-TYPRET, JMP I TYPE
- IFNZRO TYPRET-1377 <BATCHX,ZQWE>
- *4001 /PROG TO WRITE CD AND ODT ONTO NEW SYSTEM DEVICE
- /4000=JMS SYSSWP TO SWAP PGS 6600 AND 7600
- TAD I (7777 /SET TO PROPER RECORD FOR FIELD 1 STUFF
- DCA F1STUF
- JMS I SYSHND
- 4600
- 0
- MCDREC
- JMP CERR
- JMS I SYSHND
- 5011
- 0
- ODTREC
- JMP CERR
- JMS I SYSHND
- 0110 /READ IN UPPER PG 7600
- 7600
-F1STUF, 0
- JMP CERR
- JMP I .+1
- 7605 /START HER UP
-CERR, TAD .+3
- DCA 4001
- JMP 4000 /RESWAP AND HALT
- HLT
-SYSHND, 7607
- PAGE
- *0
- CDVERSION
- HLT /POWER FAIL RESTART PROTECTION
-NUMTST, 7777
- JMS I [GCH
- CMA
- TAD NUMFUJ
- TAD ["8 /TEST INPUT CHARACTER FOR RANGE
- CLL CMA /0-7 IF NUMFUJ=0
- TAD [10 /0-9 IF NUMFUJ=2
- TAD NUMFUJ
- JMP I NUMTST
- *15
-LXR, 0
-XR, 0
-CLXR, 0
-T, CDINIT
-TT, CDF 0 /***GETS SET TO CDF BATCH
-HIORD, TAD I DVICE /CHECK TO SEE IF BOS IS REALLY THERE
-NUMX, TAD OUTSW /IF NOT, SIGNAL ERROR
-RBFLAG, SNA CLA
-NAME1, JMP NAMECT /IT'S O.K.....PROBABLY!
-NAME2, CDF 0 /BAD. SIGNAL ERROR TO MONITOR
-NAME3, ISZ I NUMTST
-NAME4, JMP I [7605 /AND RESTART BATCH MONITOR
-NAMECT, CIF CDF 0 /*****GETS ALTERED******
-NMBASE, JMP I .+1 /START UP IN CD AREA OF BATCH
-DEV1, RESTRT+1 /***GETS ADDRESS OF CD AREA
-DEV2, 0
-PERDSW, 0
-NUMFUJ, 0
-DVFLAG, 0
-DELIM, 0
-OUTSW, 0
-DEFALT, 0
-DVICE, 0
-DFLTNM, 0423;1300 /DSK
-BEGDIF, MIFILE-MOFILE
-LIMDIF, MIFILE-MPARAM+2
-OUTLIM, 1-MIFILE
-GETHND, 11
-TMONIT, 0
-TUSRFG, 0
-TFPUTX, 0
-EXT1, TAD NAME4
- DCA NAMECT /REMEMBER TYPED EXTENSION
- TAD NAMECT
- SNA
- TAD DEFALT /SUBSTITUTE DEFAULT IF ZERO
-EXT2, DCA NAME4
- TAD [NAME1
- JMP I .+1
- LKUPLP
-PRINT, TYPE
- FIELD 1
- XLIST
- EJECT INVISIBLE ODT
- /INVISIBLE ODT FOR OS/8 MONITOR
- /LOADS INTO FIELD 1 NOW, BUT LOADS & EXECUTES IN FIELD 0
- /DEFINITIONS OF MONITOR SYMBOLS - VOLATILE!
- ODTREC=60
- UDNAME=7741
- MREAD=7757
- MGET=7667
- KMREC=7
- MTEMP=27
- MARG1=7740
- JSBITS=7746
- LXM=6200 /EXTENDED MEMORY REGISTER LOAD
- RXM=6230 /EXTENDED MEMORY REGISTER READ
- RACA=6175 /EXTENDED MEMORY BIT MANIPULATION
- RACB=6176 /" "
- RACC=6177 /" "
- *200
-READ, JMS I [OCRLF
-READ5, DCA WORD
- DCA WORD+1
- TAD [-7 / SET CHARACTER LIMIT
- DCA TOTE
-REA, KSF /CHARACTER INPUT
- JMP .-1
- JMS I [CTCTST /CONTROL 'C' TEST
- JMP CTRC
- TAD (203
- DCA TEMP /STORE CHARACTERS
- KCC
- TAD TEMP
- JMS I [TYPN /ECHO INPUT CHARACTERS
- TAD TABL1A /SET UP COMMAND TABLE SEARCH
- DCA 10
-CHFLP, TAD I 10 /CHARACTER I.D.
- SPA
- JMP SEX /NO COMMAND -NUMERIC INPUT
- CIA
- TAD TEMP
- SZA CLA
- JMP CHFLP /NOT THIS ONE-TRY NEXT ONE
- TAD 10 /THIS IS THE COMMAND
- TAD TABL2A /SET UP JUMP TO COMMAND SUBROUTINE
- DCA TEMP
- TAD I TEMP
- DCA TEMP
- TAD WORD
- JMS I [XLODE /BANK AND FIELD ADJUSTMENT
- DCA WORD
- JMP FLDTST /SEE IF FIELD SETTING IS LEGAL
-CTRC, JMS I [DUMP /CONTROL 'C'
- LXM /DISABLE KT8A
- JMP I [7605
- TABL1=. /COMMAND TABLE
- 240 /SPACE
- 212 /LINE FEED
- 215 /CR
- 257 /SLASH
- 302 /B
- 307 /G
- 273 /;
- 303 /C
- 327 /W
- 336 /^
- 315 /M
- 301 /A
- 314 /L
- 304 /D
- 337 /<-ARROW
- 306 /F
- 377 /RUBOUT
- 253 /+
- 255 /-
- -270 /USED - SEE "SEX"
- EXAM, JMS TOTTST /SLASH SUBROUTINE-LOCATION EXAMINATION
- JMP EX2
- TAD WORD /FIELD
- DCA CAD
- TAD WORD+1 /ADDRESS
- DCA CAD+1
-EX2, JMS LOAD /GET LOCATION CONTENTS
- CAD
- JMS I [PNUM /ECHO CONTENTS
- DCA SHUT
- JMP READ5
-SEX, TAD TEMP /ADDRESS & FIELD ADJUSTMENT
- CLL
- TAD [10 /TEST FOR NUMBER
- SNL
- JMP NO
- DCA TEMP
- CLA CLL CMA RTL
- DCA CRL
-SROT, TAD WORD+1 /FIELD & ADDRESS PROCESSING
- CLL RAL
- DCA WORD+1
- TAD WORD
- RAL
- DCA WORD /FIELD AND BANK STORAGE
- ISZ CRL
- JMP SROT
- TAD WORD+1
- TAD TEMP
- DCA WORD+1 /ADDRESS STORAGE
- ISZ TOTE /TEST FOR TOO MANY CHARACTERS
- JMP REA
-NO, CLA /UNACCEPTABLE INPUT ECHOS ?
- TAD [277
- JMS I [TYPN
- JMP READ
- CRL, 0
- JMS TOTTST
- JMP I CRL
- TAD WORD+1
- ISZ SHUT
- JMS I [STORE
- CAD
- CLA
- JMP I CRL
-CRL1, JMS CRL /CARRAIGE RETURN
- JMP READ
-CRL2, TAD [215 /LINE FEED
- JMS I [TYPN
- JMS CRL
- JMS I [TYPN
- ISZ CAD+1
-TABL1A, TABL1-1
-UPAR3, JMS I [TYPD
- CAD
- TAD [257
- JMS I [TYPN
- JMP EX2
-OPIN, JMS CRL /BKARROW/UNDERLINE
- JMS LOAD
- CAD
- DCA CAD+1
- TAD INDFLD
- JMS I [XLODE
- DCA CAD
-UPAR2, JMS I [OCRLF
- JMP UPAR3
-SEMI, JMS CRL /SEMI COLON
- ISZ CAD+1
-TABL2A, TABL2-TABL1
- JMP READ5
- *400
-/NOTE THAT LOCATIONS BURP,BURP+1 GET ALTERED AFTER BRKTST
-/IS EXECUTED. THEY BECOME: CDF 10; TAD I [MARG1
-BURP, JMP I .+1 /RETURN FROM BREAKPOINT -GO REDETERMINE CORE SIZE
- BRKTST /TO MAKE ILLEGAL FIELD GIVE ?
- DCA SAC
- /IOF /COMMENTED OUT FOR HIGH GROUND SUPPORT
- TAD I [MTRAD /RESTABLISH ADDRESS,FIELD,ETC.
- DCA TRAD
- TAD I [MTRAD1 /THESE ARE ALL
- DCA TRAD+1
- TAD I [MKEEP /BREAKPOINT PARAMETERS
- DCA KEEP
- TAD I [MPUNN /
- DCA PUNN
- CLA IAC
- AND I (7700
- DCA LINK
- TAD I (7700
- CDF 0
- JMS I [T174 /BANK AND FIELD MANIPULATION
- TAD DATFLD
- DCA INDFLD
- TAD [KMREC
- CDF 10
- DCA I (MGET+4
- CLA CLL CMA RAL
- AND I [MGET+2
- DCA I [MGET+2 /REMOVE LOW-ORDER BIT FROM CONTROL WORD
- CDF 0
- TAD KEEP
- JMS I [STORE
- TRAD
- TAD TRAD+1
- IAC
- DCA GAME+1 /ESTABLISH CONTINUE PARAMETERS
- TAD TRAD
- DCA GAME
- TAD KEEP
- DCA INST
- JMS IOTTST
- SKP
- JMP JMPLIP
- TAD TRAD
- DCA CAD /ESTABLISH EXAM PARAMETERS
- TAD TRAD+1
- DCA CAD+1
- JMS I [EFFADR
- TAD CAD
- DCA FROG
- TAD CAD+1
- DCA FROG+1
-JMPLIP, JMS I [CTCTST
- JMP I [7605
- CLA
- JMP I (LIP
- CTCTST, 0 /CONTROL 'C' TEST
- TAD [200
- KSF
- STA
- KRS
- TAD (-203
- SZA
- ISZ CTCTST
- JMP I CTCTST
-
-OCRLF, 0 /CARRAIGE RETURN-LINE FEED
- TAD [215
- JMS I [TYPN
- TAD [212
- JMS I [TYPN
- CLA CMA
- DCA SHUT
- JMP I OCRLF
-TRAP, JMS TOTTST /ESTABLISHES BREAKPOINT
- TAD [SHNDLR
- TAD WORD+1
- DCA TRAD+1 /ADDRESS
- TAD WORD
- DCA TRAD /FIELD
- TAD [7000
- DCA I [SHNDLR
- TAD [4
- DCA WORD+1
- TAD [UDNAME-MPUNN-1
- DCA TEMP
- TAD [BRKCOD-1 /MOVE UP RETURN CODE
- DCA 10
- TAD [UDNAME-1
- DCA 11
- TAD I 10
- CDF 10
- DCA I 11
- CDF 0
- ISZ TEMP
- JMP .-5
- TAD I [JSBITS
- RTR
- SZL CLA
- TAD [5
- CDF 10
- TAD I [J7600
- DCA I [J7600 /CHANGE JMP 7600 TO JMP 7605 IF ODT AREA NOT USED
- CDF 0
- TAD I [JSBITS
- DCA JSTEMP /SAVE JSBITS BEFORE SETTING BRKPT
- TAD [CIF 10
- JMS I [STORE
- WORD
- ISZ WORD+1
- TAD [JMP I 6 /STORE RETURN JMP
- JMS I [STORE
- WORD
- ISZ WORD+1
- TAD DNAME
- JMS I [STORE
- WORD
- TAD JSTEMP
- DCA I [JSBITS /RESTORE JSBITS
- JMP I [READ
-SUBT, CML
-ADD, TAD WORD+1 /MODIFY CURRENT LOCATION POINTER
- SNA
- IAC /1 IS DEFAULT VALUE
- SZL /+ OR -?
- CIA /-
- TAD CAD+1
- DCA CAD+1
- JMP I [UPAR2 /AND DISPLAY LOC AND CONTENTS
- *600 /MONITOR ENTERS ODT HERE
-LIP, HLT /ERROR. AT INIT, THE CODE AT 600
- JMP I .+1 /IS CHANGED TO: ISZ PUNN;
-TTYTST, INIT /JMP XCONT; TSF
- JMP TTYOFF
-LIPTYP, JMS I [TYPD
- TRAD
- TAD P250
- JMS I [TYPN
- TAD LINK
- TAD [260
- JMS I [TYPN
- TAD [273
- JMS I [TYPN
- TAD SAC
- JMS I [PNUM
- JMP I [READ
-JUMP, JMS TOTTST /TEST FOR 'G' WITH NO ADDRESS
- JMP I PNO
- TAD WORD
- DCA GAME
- TAD WORD+1
- DCA GAME+1
- TAD WORD
- JMS I [T174 /FIELD ADJUSTMENT -STORED IN DATFLD
- TAD [7000
- DCA INST
- DCA SAC
- DCA LINK
- JMP CONTX
-CONTIN,
-
- TAD WORD+1 / 'C'-CONTINUE COMMAND
- CIA
- SNA
-CONTX, CMA
- DCA PUNN
- DCA I [7607 /IN CASE THERE WAS NO BREAKPOINT
- JMS LOAD /V3
- TRAD /V3
- DCA KEEP /V3
- JMS I [OCRLF
-XCONT, TAD [JMP 4
- JMS I [STORE
- TRAD
- CDF 10
- TAD TRAD
- DCA I [MTRAD
- TAD TRAD+1
- DCA I [MTRAD1
- TAD KEEP
- DCA I [MKEEP
- TAD PUNN
- DCA I [MPUNN
- CDF 0
- TAD EXTEMP
- LXM
- JMS I [SIM /SIMULATE THE BRKPOINTED INST HERE
- TAD LINK /SAVE LINK
- DCA I [MLINK /ESTABLISH RETURN CODE---MXXXX'S
- TAD SAC /SAVE AC
- DCA I [MAC
- TAD GAME /ESTABLISH START CDF
- TAD [CIF 0
- DCA I [MSTCDF
- TAD DATFLD /ESTABLISH 'B' CDF
- JMS I [XLODE
- TAD [CDF 0
- DCA I [MCDF
- TAD GAME+1 /ESTABLISH START ADDRESS
- DCA I [MSTADR
- JMS I [DUMP
- TAD I [JSBITS
- RTR
- SZL CLA
- JMP I [MSWITC
- JMP I [MREAD /EXECUTION TIME
- UPAR1, JMS I [CRL /UP-ARROW COMMAND- CLOSE LOCATION
- JMS I [EFFADR
- JMP I [UPAR2 /PRINT REFERENCED LOCATION CONTENTS
-EFFADR, 0 /USE CONTENTS AS MRI
- JMS LOAD
- CAD
- AND [177 /ISOLATE LOCATION REFERENCED
- DCA TEMP
- JMS LOAD
- CAD
- AND [200 /IS IT 'THIS PAGE'?
-P250, SNA CLA
- JMP .+3
- TAD CAD+1
- AND [7600
- TAD TEMP
- DCA TEMP
- JMS LOAD
- CAD
- AND T400 /IS IT INDIRECT-TEST '400' BIT
- SNA CLA
- JMP NOIND
- TAD TEMP
- DCA CAD+1
- JMS LOAD
- CAD
- DCA TEMP
- TAD CAD+1
- AND P7770 /IS IT AUTO-INDEXED?
- TAD P7770
- SZA CLA
- JMP NOAUTO
- ISZ TEMP
-P7770, 7770 /COVERS ISZ....
- TAD TEMP
- JMS I [STORE
- CAD
-NOAUTO, TAD INDFLD /NO INDEXING
- JMS I [XLODE
- DCA CAD
-NOIND, TAD TEMP /NOT INDIRECT
- DCA CAD+1
- JMP I EFFADR
-TTYOFF, /WASTE SOME TIME
- JMS IOTTST
-T400, AND I 0
- ISZ NOUGHT
- JMP TTYTST
- JMP LIPTYP /IF THE TTY FLAG ISN'T UP NOW, IT'LL NEVER GO UP
- TABL2=. /COMMAND TABLE SUBROUTINE INFO
- REA /IGNORE BLANKS
- CRL2
- CRL1
- EXAM
- TRAP
- JUMP
- SEMI
- CONTIN
- WSER
- UPAR1
- MASKX
- ACX
- LINKX
- DATF
- OPIN
- INDF
- RBOUT
- ADD
- SUBT
- IFZERO 1000&. <*1000>
-PNUM, 0 /PRINTS CONTENTS OF ADDRESS LOCATION
- DCA PUNN /OR ADDRESS...ITSELF
- TAD [-4
- DCA TEMP
-PN2, TAD PUNN
- RTL
- RAL
- DCA PUNN
- TAD PUNN
- RAL
- AND [7
- TAD [260
- JMS I [TYPN
- ISZ TEMP
- JMP PN2
- TAD [240
- JMS I [TYPN
- JMP I PNUM
-TYPD, 0 /PRINTS BANK AND FIELD OF ACCESSED LOC.
- TAD I TYPD
- DCA TEMP
- TAD I TEMP
- JMS I TYPDXX
- JMS I [TYPN /TYPE BANK
- TAD NWD
- JMS I [TYPN /TYPE FIELD
- TAD I TEMP
- JMS I [PNUM /PRINT ADDRESS
- ISZ TYPD
- JMP I TYPD
-TYPDXX, TYPDX
-TYPN, 0 /PRINTS CHARACTERS PREPARED BY TYPD;PNUM,ETC.
- TLS
- TSF
- JMP .-1
- CLA
- JMS I [CTCTST
- JMP I [CTRC
- TAD [-14 /^O?
- SZA CLA
- JMP I TYPN /NO
- KCC /YES
- JMP I [READ
-WSER, JMS I [OCRLF / 'W'---WORD SEARCH
- TAD LIMLO
- DCA CKT+1 /ESTABLISH LOWER LIMIT
- TAD INDFLD
- JMS I [XLODE /ADJUST WORD SEARCH BANK AND FIELD
- DCA CKT
-WSER1, JMS LOAD
- CKT
- AND MASK /SEARCH MASK
- CIA
- TAD WORD+1
- SZA CLA
- JMP WSER2
- JMS I [TYPD /WORD FOUND GO TYPE IT
- CKT
- TAD [257
- JMS I [TYPN
- JMS LOAD
- CKT
- JMS I [PNUM
- JMS I [OCRLF
-WSER2, TAD CKT+1 /TEST NEXT LOCATION
- CIA
- TAD LIMHI /IF IT ISN'T ABOVE THE LIMIT
- SNA CLA
- JMP I [READ /OVER LIMIT GO GET NEXT COMMAND
- ISZ CKT+1
- JMP WSER1 /SEARCH NEXT LOCATION
-
-ACX, TAD [SAC-LINK / 'A' COMMAND
-LINKX, TAD [LINK-MASK / 'L' COMMAND
-MASKX, TAD [MASK-INDFLD / 'M' COMMAND
-INDF, TAD [INDFLD-DATFLD /'F' COMMAND
-DATF, TAD [DATFLD / 'D' COMMAND
- DCA WORD+1
- CLA CMA
- DCA WORD
- DCA TOTE
- TAD [257
- JMS I [TYPN
- JMP I [EXAM
- BRKCOD=. /RETURN CODE --- FROM 'G','C' COMMANDS
- NOPUNC
- *UDNAME /STORED IN UPPER FIELD ZERO
- ENPUNC
-
- DCA MARG1
- RAL
- RDF
- DCA 7700
- TAD PODT
- DCA MGET+4
- ISZ MGET+2 /DON'T REVERSE TAPE MOTION TO PICK UP ODT
- CDF CIF 0
-J7600, JMP 7600
-PODT, ODTREC
-P7603, 7603
-MTRAD, 0
-MTRAD1, 0
-MKEEP, 0
-MPUNN, 0
-
- NOPUNC
- *BRKCOD+MPUNN-UDNAME+1
- ENPUNC
-
-DUMP, 0 /SUBROUTINE TO STORE ADJUSTED CODE
- TAD STOFLG /LT
- SNA CLA
- JMP I DUMP
- JMS I [SHNDLR
- 4200
- 1400
-GREC, 0 /SET BY GETADR
- HLT
- DCA STOFLG
- JMP I DUMP
-
-RBOUT, TAD [277 /RUBOUT COMMAND
- JMS I [TYPN
- TAD [240
- JMS I [TYPN
- JMP I REDE5
- IFNZRO .-1200&4000 <*1200>
-SIM, 0 /SIMULATES BREAKPOINTED INST
- JMS IOTTST
- JMS LOAD
- FROG
- DCA TEMP
- JMS I [DUMP
- DCA I [GREC
- JMS I [SHNDLR /DUE TO 128K CODE -SIM IS LOADED INTO 1600
- 0100
-SIMXT, 1600
- 64
- HLT
- JMS I SIMXT
- JMS I [STORE
- FROG
- JMP I SIM
-XLODE, 0 /TRANSFORMS 'ABCDE' TO 'ACDEB0' FOR CDF
- DCA NWD
- TAD TEMP /TEST FOR GO COMMAND
- CIA /A 'GO' ABOVE 32K REQUIRES SETTING EXTEMP
- TAD TJUMP /FOR LXM ENABLE
- SNA CLA
- TAD (30
- AND NWD
- SNA CLA
- JMP LT32K
- TAD [7000
- DCA EXTEMP
-LT32K, TAD NWD /TRANFORMATION IS HERE
- AND (17
- TAD (7770
- SPA
- TAD (17
- TAD [7771
- TAD NWD
- CLL RTL
- JMP I XLODE
-
- T174, 0 /TRANSFORMS 174 TO 37
- CLL RTR
- RAR
- AND (17
- TAD [10
- AND [7767 /... 0027 ARE THE RELEVANT BITS IN 7767
- SZL
- TAD [10
- DCA DATFLD
- JMP I T174
-TYPDX, 0 /PROCESSES BANK & FIELD FOR PRINTING
- SPA /ADJUSTMENT FOR LINE FEED AFTER
- CLA /REFERENCE TO M,D,F,ETC. COMMANDS
- CLL RTR
- RAR
- DCA T174
- TAD T174
- AND [7
- TAD [260
- DCA NWD
- TAD T174
- AND [10
- SZL
- TAD [4
- CLL RTR
- TAD [260
- ISZ TEMP
- JMP I TYPDX
-
-
-STORE, 0 /SUBROUTINE TO ADJUST CODE
- DCA LOAD
- TAD I STORE
- JMS I [GETADR
- ISZ STOFLG /INDICATE THAT WE'RE CHANGING THIS RECORD
- TAD LOAD
- DCA I ADR
- CDF 0
- ISZ STORE
- JMP I STORE
- GETADR, 0 /GETS ADDRESS....
- DCA ADR
- TAD I ADR
- DCA FADR
- ISZ ADR
- TAD I ADR
- DCA ADR
- TAD FADR
- SNA /ONLY NEED TO FOOL WITH ADDRESS IF IT'S IN FIELD 0
- JMP CKADR
- SPA
- CLA
- TAD [CDF 0
- DCA .+1
-FADR, 0
- ISZ GETADR
- JMP I GETADR
-CKADR, TAD ADR /MANIPULATES FIELD 0 OF ODT'D PROGRAM
- RAL /ACCESSES IT IN LOCS 1400-1777
- SZL SPA CLA /
- JMP FADR+1
- CLA CLL CMA RTL
- AND I [JSBITS
- DCA I [JSBITS /MODIFY THE JSW TO INDICATE ODT AREA VIOLATION
- TAD ADR
- CLL RTL
- RTL
- RAL
- AND [7 /CALCULATE BLOCK OF STORAGE
- TAD [MTEMP+4
- DCA GIREC
- TAD I [GREC /MAYBE IT'S ALREADY IN CORE
- CIA
- TAD GIREC
- SNA CLA
- JMP NOREAD /IT IS!!
- JMS I [DUMP /MAYBE... ...IT ISN'T
- JMS I [SHNDLR /LOADS RELEVANT PROGRAM CODE
- 0200
-G1400, 1400
-GIREC, 0
- HLT
- TAD GIREC
- DCA I [GREC
-NOREAD, TAD ADR /ADJUST THE ADDRESS FOR PROPER ACCESS
- AND (377
- TAD G1400
- DCA ADR
- JMP I GETADR
-
-
- *1400
- /INITIALIZATION CODE TO SET UP THE "MREAD" AREA IN FIELD 0
- /WITH THE ODT CODE TO START UP A PROGRAM
-
-INIT, TAD I 10
- DCA I 11
- ISZ TEMP
- JMP .-3
- JMS CORE /DETERMINE CORE FIELD SIZE
- TSF
- JMP .-1
- JMP I [READ
-
-BRKTST, JMS CORE /GET CORE SIZE NOW THAT WE WERE
- TAD KLIP
- DCA I PLIP /SETUP LOCATIONS AT 600
- TAD KLIP+1
- DCA I PLIP+1
- TAD KLIP+2
- DCA I PLIP+2
- TAD KCDF10 /JUST BREAKPOINTED IN. THEN RESTORE
- DCA I BURPO /LOCS AT BURP SO WE NEVER COME BACK
- TAD KCDF10+1 /HERE AGAIN UNTIL WE'RE SWAPPED
- DCA I BURP2
- JMP I BURPO
-KCDF10, CDF 10
- TAD I [MARG1 /SIMULATE LOCS AT BURP
-BURPO, BURP
-BURP2, BURP+1
- RSTCOD=. /RESTORES ODT AFTER 'C','G' COMMANDS
- NOPUNC
- *MREAD-1
- ENPUNC
-
- SHNDLR
- JMS I .-1
- 1000
- 0
- MTEMP+4
- HLT
-MSWITC, TAD MLINK
- CLL RAR
- TAD MAC
-MCDF, CDF 0 /CDF OF PREVIOUS BRKPOINTED INST
- JMP MSTCDF
-MAC, 0 /SAVED AC
-MLINK, 0 /LIKEWISE LINK
-MSTCDF, CIF 0 /START CDF
- JMP I .+1
-MSTADR, 0 /START ADDRESS
-
- NOPUNC
- *RSTCOD+MSTADR-MREAD+2
- ENPUNC
- CORE, 0 /DETERMINES AVAILABLE CORE
- RXM /READ AND STORE EXT MEM INFO
- DCA EXTEMP
- TAD [7000
- LXM /SETS LXM FOR ODT PURPOSES
- CLA
- CDF 0
- TAD I M1 /FIELD INFO STORED IN 7777(IF AVAILABLE)
- AND COR70
- CLL RTR
- RAR
- SZA /HAS CORE SIZE BEEN SET?
- JMP USERCR /VERILY
-COR0, CDF 0
- TAD CORSIZ /GET FIELD TO TEST
- JMS I [XLODE /EXTENDED MEMORY BANK&FIELD ADJUSTMENT
- TAD COREX
- DCA .+1 /SET UP CDF TO FIELD
-COR1, CDF
- TAD I CORLOC /SAVE CURRENT CONTENTS
-COR2, NOP
- DCA COR1
- TAD COR2
- DCA I CORLOC
-COR70, 70 /ACTS AS NOP
- TAD I CORLOC /TRY TO READ BACK 7000
-CORX, 7400
- TAD CORX
- TAD CORV
- SZA CLA
- JMP COREX /NON-EXISTENT FIELD EXIT
- TAD COR1 /RESTORES CONTENTS DESTROYED
- DCA I CORLOC
- ISZ CORSIZ /TRY NEXT HIGHER FIELD
- JMP COR0
-
-COREX, CDF 0 /STORE AWAY LAST REAL FIELD IN 'ZERO'
- TAD CORSIZ
- TAD M1
-USERCR, CIA
- DCA ZERO
- JMP I CORE
-CORLOC, CORX
-CORV, 1400
-M1, -1
- CORSIZ, 1
-KLIP, ISZ PUNN
- XCONT&177+5200
- TSF
-PLIP, LIP
- LIP+1
- LIP+2
-
- *1600
-SIMX, 0 /SIMULATES BREAKPOINTED INST
- TAD TEMP
- DCA 0
- JMS IOTTST /IS IT AN IOT?
- TAD T777
- CMA
- AND INST
- RAL
- CML
- SNL SMA /IS IT A JMS OR A JMP?
- JMP JMSJMP
- CML RAR
- DCA SOPR /STORE INST IN SOPR
- TAD DATFLD /PREPARE CDF
- JMS I [XLODE
- TAD [CDF 0
- DCA .+1
- HLT
- TAD LINK /AND LINK
- CLL RAR
- TAD SAC /AND AC
-SOPR, HLT /EXECUTE INSTRUCTION
- SKP
- ISZ GAME+1
- DCA SAC /RESAVE AC,LINK,DATFLD
- RAL
- DCA LINK
- RDF
- JMS I [T174
- CDF CIF 0
-EOSIM, TAD 0 /PREPARE TO RETURN
- CIA /HAS LOC 0 BEEN CHANGED?BY A TAD...DCA...ISZ...
- TAD TEMP
-EOTST, SNA CLA /IF SO,THEN...
- JMP .+3
- TAD 0 /...DO A STORE(ON RETURN TO SIM)
- JMP I SIMX
- ISZ SIMX
- JMP I SIMX
-JMSJMP, RTL /PROCESS JMP,JMS
- SZL CLA
- JMP JMPX
- TAD TRAD
- DCA FROG
- TAD GAME+1
- DCA 0
- CLA IAC CLL
-JMPX, TAD FROG+1
- DCA GAME+1
- CML RAL /PUT -LINK IN AC (0 IF JMP, 1 IF JMS)
- JMP EOTST
-T777, 777
-
- *0
-ZERO, ODTVERSION
- /HLT /IN CASE BKPT WITH INTER ON
- CIF 30 /SYMBIONT CODE
- JMP .-1
-PUNN, 0
- *4 /PAGE 0 LITERALS AND CELLS
- CIF 10 /PROTOTYPE BREAKPOINT
- JMP I 6 /USED BY PROGRAMS WITH JSBITS(10)=1
-DNAME, UDNAME /WHEN ODT IS RELOADED ON A BREAKPOINT
-
- *7
-EXTEMP, 0
- RSTCOD-1
- MREAD-2
- *12
-TOTE, 0
-KEEP, 0
-INST, 0
-SHUT, -1
-TRAD, 0;SHNDLR
-WORD, 0;0
-LINK, 0
-SAC, 0
-CAD, 0;0
-CKT, 0;0
-GAME, 0;0
-FROG, 0;0
-TEMP, MREAD-MSTADR-2
-JSTEMP, 0
-DATFLD, 0
-INDFLD, 0
-MASK, 7777
-LIMLO, 0
-LIMHI, 7577
-ADR, 0
-FLDTST, TAD ZERO /LOC. 0 HAS LAST REAL CORE FIELD
- TAD NWD /IF USER TRIES TO ADDRESS NON-
- SMA SZA CLA /EXISTENT CORE, A ? RETURNS
- JMP I PNO
- JMP I TEMP /HE'S OK.
-PNO, NO
-TOTTST, 0 /TEST FOR COMMAND WITHOUT ADDRESS
- TAD TOTE
- TAD [7
- SZA CLA
- ISZ TOTTST
- JMP I TOTTST
-STOFLG, 0
-NWD, 0
-TJUMP, JUMP
-NOUGHT, 0
-LOAD, 0 /SUBROUTINE TO LOAD PROGRAM CODE
- TAD I LOAD
- JMS I [GETADR
-REDE5, READ5
- TAD I ADR /RETURNS ADDRESS CONTENTS IN AC
- CDF 0
- ISZ LOAD
- JMP I LOAD
-IOTTST, 0 /TEST FOR ISOLATING I/O
- CLA CLL CML RTR
- TAD INST
- SZL CLA
- ISZ IOTTST
- JMP I IOTTST
- $
-
DELETED src/os8-v3f/FPAT.PA
Index: src/os8-v3f/FPAT.PA
==================================================================
--- src/os8-v3f/FPAT.PA
+++ /dev/null
@@ -1,53 +0,0 @@
-/FRTS PATCH
-/TO FIX LIMITATION INVOLVING 2-PAGE SYSTEM HANDLERS
-
-/16-JAN-78 SR/DS
-
- TEM=7507
- L7=7541
-
- FIELD 1
-
- *2675
-
- 342 / = "AND (7770)"
-
- *2742
-
- 7770
-
- *7526
-
-TDSET, 0 /SUBROUTINE TO RELOCATE ALL CIF/CDF'S
- /TO FIELDS 1-7 IN SYSTEM HANDLER 1ST
- /PAGE 07635 AND ABOVE.
- DCA TEM
- TAD L7635
- DCA P1
- JMP LOOP
-L7635, 7635
-L1570, 1570
-L7710, 7710
-
- *7546
-
-LOOP, TAD I P1
- TAD L1570
- CLL
- TAD L7710
- SZL CLA
- JMP NOFIX /NOT A CIF/CDF TO FIELD>0
- TAD I P1 /OK: RELOCATE FIELD
- AND L7
- TAD TEM /EITHER UP INITIALLY, OR BACK
- /DOWN FINALLY
- DCA I P1
-NOFIX, ISZ P1 /ON TO NEXT LOCATION
- JMP LOOP
- JMP I TDSET /DONE
-P1, 0 /POINTER TO SYS HANDLER
-
- *7576
-
- 6220
-$
DELETED src/os8-v3f/FUTIL.LS
Index: src/os8-v3f/FUTIL.LS
==================================================================
--- src/os8-v3f/FUTIL.LS
+++ /dev/null
@@ -1,7926 +0,0 @@
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 1
-
- /FUTIL - FILE UTILITY - V08A
-
- DECIMAL
- 0010 VERSION=08
- OCTAL
- 0001 PATCH="A&77
-
- / OS/8 FILE UTILITY PROGRAM. ALLOWS EXAMINATION AND
- / MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
- / SOLE. DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
- / TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
- / UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
- / OS/8 PACKED ASCII. LISTING AND DUMPING CAN ALSO BE DONE
- / IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
- / SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
- / FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
- / WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.
-
- /BY: JIM CRAPUCHETTES
- / MENLO COMPUTER ASSOCIATES, INC.
- / (FORMERLY: FRELAN ASSOCIATES)
- / P.O. BOX 298
- / MENLO PARK, CALIF. 94025
- /
- /
- /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
- / LAST REVISION--APRIL 1970.
- /
- /VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
- / "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
- / & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
- / IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
- / ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
- /VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
- / "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
- / WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
- / SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
- / "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
- / RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
- / "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
- / EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
- / XS240 FORMATS
- /VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
- /VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
- / (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
- /VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
- /VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
- / IF/END COMMANDS, ALPHA DATE.
- /
- /PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
- / DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
- / VERSION 7 PATCHES:
- / 1.CTRL/U CRASH & OVERLAY MAPPING IN SAVE MODE(7A TO 7B)
- / 2.FIXED SHOW CCB PROBLEM(7B TO 7C)
- / 3.ODT MAPPING ON LD. MODULES(7C TO 7D)
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 1-1
-
- / 4.ADDED SHOW CCB SUPPORT FOR KT8A SAVE IMAGES(7D TO 7E)
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 2
-
- / SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
- / DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
- / THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
- / ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
- / EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
- / TION.
- / THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
- / MODIFIED VERSION OF DECUS 8-115A.
-
-
- / ASSEMBLY INFORMATION:
- /
- / .R PAL8 [VERSION 9]
- / *FUTIL<FUTIL/L/K/P=6400$
- / .SA ... FUTIL
- /
- / THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
- / ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
- / 960 BLOCKS. CREFING REQUIRES EITHER "/M" OR "/X" FOR
- / CREF V3.
-
-
- /MEMORY ALLOCATION:
- /
- /00000-06310 PROGRAM PROPER
- /06310-06577 ARGUMENT STRING BUFFER
- /06400-06777 --- ONCE ONLY CODE FOR CHAIN ---
- /06600-07177 DDEV HANDLER AREA, 2 PAGES
- /07200-07577 DEVICE HANDLER AREA, 2 PAGES
- /
- /10000-11777 USR AREA & ERROR MESSAGES (SWAPPED)
- /12000-12377 CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
- /12600-15700 TEXT STRINGS, LISTS
- /15700-16377 STRING MASK, COMMAND BUFFERS, PDL
- /16400-16577 CCB BUFFER, 1 PAGE
- /16600-17177 DDEV BUFFER, 2 PAGES
- /17200-17577 I/O BUFFER, 2 PAGES
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 3
-
- /PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES
-
-
- 0000 *0
-
-00000 0000 OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES
-
-00001 0000 DPSGN, 0
-00002 0000 LASTOP, 0
-00003 0000 THISOP, 0
-
-00004 0000 ZBLOCK 3 /USED BY ODT
-
- /VARIABLES & SWITCHES
-00007 0000 PDLPT, 0 /P.D.L. POINTER
-00010 4030 DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION)
-00011 6627 SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
-00012 6656 SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
-00013 0000 SCANX2, 0 /USED BY 'XSTRIN'
-00014 0000 GETPNT, 0 /USED BY 'GET' & 'BKLOC'
-00015 0000 COMIR, 0 /USED FOR USER LINE INPUT
-00016 5712 COMOUT, COMB-1 /USED FOR USER LINE SCAN
-00017 0000 TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT)
-00020 0000 ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG)
-
-00021 0000 TEMP, 0
-00022 0000 TEMP1, 0
-00023 0000 TEMP2, 0
-00024 0000 TEMP3, 0
-00025 0000 ACC1, 0 /24 BIT ACCUMULATORS
-00026 0000 ACC2, 0
-00027 0000 ACCX1, 0
-00030 0000 ACCX2, 0
-
- 0025 NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER:
- 0026 NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A
- 0027 NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE)
- 0030 NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION.
-
-00031 0000 OPER1, 0
-00032 0000 OPER2, 0
-
-00033 0000 TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR
-00034 0000 TEMPV2, 0 / "SET TEMP ..." & "EVAL T"
-
-00035 0000 CHAR, 0
-00036 0000 CNT, 0
-00037 0000 CNTR, 0
-00040 0000 CNTRA, 0
-00041 0000 NCNT, 0 /LINE POSITION COUNTER
-00042 0000 FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII)
-00043 3621 OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE
-00044 0000 MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
-00045 0000 CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH
-00046 0000 CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 3-1
-
-00047 0000 SHUT, 0 /= -1 IF SOMETHING OPEN
-00050 0000 MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED
-00051 0000 ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
-00052 0000 DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
-00053 0000 DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000
-
-00054 0000 CBLK, 0 /= CURRENT BLOCK
-00055 0000 0 /DUMMY FOR "SHOW ABS"
-00056 0000 CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF
-00057 0000 BLK, 0 /= "BLOCK"
-00060 0000 LOCH, 0
-00061 0000 LOCL, 0 /= "LOCATION" (DISPLACEMENT)
-00062 0000 UBLK, 0 /UPPER LIMIT FOR SEARCHES
-00063 0001 ULOCH, 1
-00064 7577 ULOCL, 7577
-00065 0000 LBLK, 0 /LOWER LIMIT FOR SEARCHES
-00066 0000 LLOCH, 0
-00067 0200 LLOCL, 200
-00070 0000 SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES
-00071 0000 SLOCH, 0
-00072 0000 SLOCL, 0
-
-00073 0000 OFFSET, 0 /OFFSET
-00074 0000 FILLER, 0 /FILLER CONSTANT FOR "MODIFY"
-00075 7777 MASK, -1 /MASK FOR WORD SEARCH
-00076 7777 SMASKL, -1 /= -(LENGTH OF SMASK)
-00077 0000 RBLK1, 0 /START BLOCK OF FILE
-00100 7607 DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS")
-00101 0001 DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS")
-00102 7700 USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT
- /7700=MSGS IN; 0=NONE IN; 200=USR IN
-
- /CONSTANTS
-00103 7400 M400, -400
-00104 7540 M240, -240
-00105 7563 M215, -215
-00106 7600 M200, -200
-00107 7700 M100, -100
-00110 7760 M20, -20
-00111 7770 M10, -10
-00112 7777 M1, -1
-00113 0007 N7, 7
-00114 0015 N15, 15
-00115 0020 N20, 20
-00116 0077 N77, 77
-00117 0177 N177, 177
-00120 0200 N200, 200
-00121 0377 N377, 377
-00122 7000 N7000, 7000
- 0103 N7400= M400
-
- /ADDRESSES
- 4523 READLN= JMS I . /GET NEXT INPUT LINE, WITH
-00123 4000 READ / SPECIAL TERMINATORS
-00124 3605 TYPSTI, TYPSTR
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 3-2
-
-00125 3600 TYPSI, TYPES
-00126 5054 TYPECI, TYPEC
-00127 1761 TWOCI, TWOCS
-00130 5044 CRLFI, CRLF
- 4531 DIGIT= JMS I . /OUTPUT AN ASCII DIGIT
-00131 4161 DODIG
- 4532 SPACE1= JMS I . /OUTPUT 1 SPACE OR ...
-00132 2561 DO1SP
- 4533 SPACE2= JMS I . /OUTPUT 2 SPACES
-00133 2565 DO2SP
-00134 5125 CTRLI, CTRL
-00135 3621 TWOT, PACOUT
-00136 5061 TYPEI, TYPE
-00137 3436 DECI, DPRT
-00140 3400 OCTI, OPRT
-00141 3445 DEC2I, DEC2
-00142 5000 PDATEI, PDATE
-00143 3762 RTL6I, RTL6
-00144 3767 RTR6I, RTR6
-00145 5261 SOCTI, OCTSET
-00146 3105 BKLOCI, BKLOC
-00147 5400 EVALI, EVAL
-
- 4550 PUSH= JMS I . /PUSH AC ON P.D.L.
-00150 5600 PUSHX
- 4551 POP= JMS I . /POP P.D.L. INTO AC
-00151 5606 POPX
- 4552 CALUSR= JMS I . /DO USR FUNCTION
-00152 0520 USEUSR
- 4553 TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1
-00153 2156 TIDPNT
- 4554 TADICAD= JMS I . /"TAD I CAD" IN FIELD 1
-00154 6170 TICAD
- 4555 DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1
-00155 6163 DICAD
-
-00156 3122 GWORDI, GWORD
-00157 5272 GARGI, GARGS
-00160 5713 ARGI, ARG
-00161 3000 GETI, GET
-00162 3073 ODGETI, ODGET
-00163 5362 GETNI, GETN
-00164 3502 SSKIPI, SSKIP
-00165 2752 LIMITI, LIMITS
-00166 3557 INCI, INC
-00167 3643 SORTI, SORTJ
-00170 4141 ENDCI, ENDC
-00171 0203 RECRLF, MAIN1-1
-00172 0204 RESTAR, MAIN1
-
- 4573 ERROR= JMS I .
-00173 0454 XERROR
-
-00174 5712 COMST, COMB-1
-00175 6305 TEMPST, TEMPL-1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 3-3
-
-00176 5610 MASKBS, SMASKB-1
-
-
- 0200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 4
-
- /PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS
- /INTO COMMAND BUFFER UNTIL END IS REACHED.
-
-00200 3102 DCA USRAD /CLEAR ON RESTART (NOTHING IN)!
-00201 6046 TLS /RAISE TELETYPE FLAG
-00202 3047 DCA SHUT /NOTHING IS OPEN
-00203 4530 JMS I CRLFI /OUTPUT CR-LF.
-00204 4545 MAIN1, JMS I SOCTI /SET INPUT TO OCTAL; EXEC 'COMMENT'
-00205 3052 DCA DSWIT /RESET DUMP OUTPUT SWITCH
-00206 1174 TAD COMST /INIT COMMAND BUFFER.
-00207 3015 DCA COMIR
-00210 1377 TAD (PDLB+1 /INIT PUSH-DOWN-LIST
-00211 3007 DCA PDLPT
-00212 4523 MAIN2, READLN /GET A LINE FROM INPUT.
-00213 4472 CCHARL-1 /CR LF ; ! / ALT-
-00214 0050 COPSL-CCHARL / MODES ETC...
-00215 5204 JMP MAIN1 /BUFFER WAS EMPTIED.
-
-
- /ROUTINE TO HANDLE CARRIAGE RETURN.
-00216 4570 CRCR, JMS I ENDCI /PUT A CR IN BUFFER
-00217 5235 JMP CRCRC /ONLY A CR IN BUFFER
-00220 4556 JMS I GWORDI /GET COMMAND WORD
-00221 5234 JMP CRCRN /BUFFER BEGINS WITH A #
-00222 2046 ISZ CRSWT /WORD ENDED BY A CR?
-00223 5230 JMP CRCR1 /YES, ONLY A FEW ARE OK
-00224 4567 JMS I SORTI /NO, LOOK UP COMMAND
-00225 4602 CWORDL-1
-00226 0031 WOPSL-CWORDL
-00227 4573 ERCB, ERROR /NOT A LEGAL COMMAND
- /
-00230 4567 CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT"
-00231 4663 CWORL2-1
-00232 0010 WOPSLL-CWORL2
-00233 4573 ERCA, ERROR /SOMETHING NOT LEGAL
- /
-00234 4361 CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN
-00235 3047 CRCRC, DCA SHUT / MARK LOCATION CLOSED
-00236 5204 JMP MAIN1
-
- /ROUTINE TO HANDLE SLASH
-00237 4570 SLASH, JMS I ENDCI /END BUFFER WITH A CR
-00240 5244 JMP SLA1 /OPEN LAST, CR ONLY
-00241 4776' JMS WCHEK /DOES LINE START W. A WORD?
-00242 4565 JMS I LIMITI /NO, GET ARG--
-00243 0070 SBLK / & SLOCH & SLOCL
-00244 4532 SLA1, SPACE1 /OUTPUT SPACE
-00245 4775' SLO1, JMS ODTOUT /GET THE WORD & OUTPUT
-00246 4532 SLO2, SPACE1 /FOLLOWED BY 2 SPACES
-00247 4532 SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND
-00250 4562 JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE)
-00251 7240 STA
-00252 5235 JMP CRCRC /GO MARK LOCATION OPEN
-
- /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 4-1
-
-00253 1043 ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY
-00254 5261 JMP ALTM1 / 'FORMAT' OPTION.
-
- /ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
- / SPECIFIED FORMAT AND THEN RE-OPEN. THE ROUTINE HANDLES:
- / # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
- / : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
- / > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
- / ] (PACKED ASCII) AND ? (DIRECTORY).
- /
-00255 1012 OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST
-00256 1374 TAD (OTABLE-1-CCHARL
-00257 3010 DCA DPNT /POINT INTO ADDR TABLE,
-00260 4553 TADIDP / GET OUTPUT ROUTINE ADDR,
-00261 3270 ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE.
-00262 4353 JMS ECLOSE /CLOSE THIS LOCATION
-00263 4532 SPACE1 /OUTPUT SPACE
-00264 3045 DCA CHARSW /RESET UNPACK SWITCH
-00265 4562 JMS I ODGETI /GET WORD
-00266 4670 JMS I OMODPT /OUTPUT IN DESIRED FORMAT
-00267 5246 JMP SLO2 /AND GO REOPEN.
-00270 0000 OMODPT, 0
-
- /ROUTINE TO HANDLE BACKARROW.
-00271 4353 BACKAR, JMS ECLOSE /CLOSE THIS LOCATION
-00272 4554 TADICAD /GET THE CONTENTS,
-00273 5306 JMP UPARR1 /AND USE THEM AS THE ADDR
-
- /ROUTINE TO HANDLE UPARROW.
-00274 4353 UPARR, JMS ECLOSE /CLOSE THIS LOCATION
-00275 4554 TADICAD /IS THIS A 'PAGE 0' REF.?
-00276 0120 AND N200
-00277 7640 SZA CLA
-00300 1072 TAD SLOCL /YES, USE PAGE BITS
-00301 0106 AND M200 / MASK PAGE OR 0 TO PAGE #
-00302 3072 DCA SLOCL / & SAVE IT
-00303 4554 TADICAD /GET THE CONTENTS,
-00304 0117 AND N177 /AND USE THE ADDRESS BITS.
-00305 1072 TAD SLOCL / ALONG WITH PAGE BITS
-00306 3072 UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR
-00307 5336 JMP EXCL2 /NOW GO FINISH
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 5
-
- /ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
-
-00310 3536 SEMIC, DCA I TYPEI /SET NO-OUTPUT SWITCH-V7B
-00311 7240 LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT
-00312 3270 EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
-00313 4353 JMS ECLOSE /CLOSE THIS LOCATION
-00314 7001 IAC
-00315 3025 DCA ACC1 /SET UP D.P. INCREMENT
-00316 3026 DCA ACC2
-00317 3001 EXCL1, DCA DPSGN /(FOR SAFETY)
-00320 2270 ISZ OMODPT /INCREMENT OR DECREMENT?
-00321 4773' JMS DPNEG / DECREMENT, NEGATE VALUE
-00322 7100 CLL
-00323 1025 TAD ACC1
-00324 1072 TAD SLOCL /UPDATE LOCATION TO 15 BITS
-00325 3072 DCA SLOCL
-00326 7004 RAL
-00327 1026 TAD ACC2
-00330 1071 TAD SLOCH
-00331 0113 AND N7 / (BUT ONLY 15 BITS)
-00332 3071 DCA SLOCH
-00333 1536 TAD I TYPEI / ANY OUTPUT?-V7B
-00334 7650 SNA CLA
-00335 5247 JMP SLO2+1 / NO, WAS ";" DO ONE SPACE
-00336 4530 EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE
-00337 4546 JMS I BKLOCI /OUTPUT ADDRESS
-00340 0067 SBLK-1
-00341 4527 JMS I TWOCI /OUTPUT "\ "
-00342 3440 3440
-00343 5245 JMP SLO1 /NOW GO OPEN NEXT LOCATION
-
- /ROUTINE TO HANDLE PLUS & MINUS.
-00344 7240 PLUS, STA /"+", SET SWITCH
-00345 3270 MINUS, DCA OMODPT /"-", CLEAR SWITCH
-00346 4570 JMS I ENDCI /END BUFFER, TEST
-00347 5336 JMP EXCL2 /NO ARG, DO SAME AGAIN
-00350 4776' JMS WCHEK /LINE START WITH A COMMAND?
-00351 4560 JMS I ARGI /NO, GET AN ARG
-00352 5317 JMP EXCL1 /UPDATE LOC & GO OPEN
-
-
-00353 0000 ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG.
-00354 4570 JMS I ENDCI /END BUFFER WITH A CR.
-00355 5753 JMP I ECLOSE /ONLY A CR IN BUFFER, DONE
-00356 4776' JMS WCHEK /DOES LINE START W. A WORD?
-00357 4361 JMS CLOSE /ARG IN BUFFER, USE IT
-00360 5753 JMP I ECLOSE /DONE
-
-00361 0000 CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION
-00362 4560 JMS I ARGI /GET ONE ARG
-00363 2047 ISZ SHUT /ANYTHING OPEN?
-00364 5761 JMP I CLOSE /NO, RETURN
-00365 4562 JMS I ODGETI /YES, SET UP THINGS RIGHT
-00366 7240 STA
-00367 3050 DCA MODIF /SET MODIFY FLAG
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 5-1
-
-00370 1025 TAD ACC1 /USE "LOC" AS DATA
-00371 4555 DCAICAD /STORE IT
-00372 5761 JMP I CLOSE
-
-
-00373 6141
-00374 0032
-00375 4200
-00376 6200
-00377 6130
- 0400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 6
-
- /ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
- / EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
- / DECIMAL.
-00400 4547 XVAL, JMS I EVALI /GO EVALUATE
-00401 7410 SKP /TERMINATED BY A CR
-00402 4573 ERCC, ERROR / SORRY!--TOO MANY ")"S
-00403 4527 JMS I TWOCI /"= "
-00404 7540 7540
-00405 1026 TAD ACC2
-00406 4540 JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL
-00407 1025 TAD ACC1
-00410 4540 JMS I OCTI /OUTPUT LOW ORDER IN OCTAL
-00411 1027 TAD ACCX1 /SAVE REMAINDER FOR LATER
-00412 3015 DCA COMIR
-00413 1030 TAD ACCX2
-00414 3016 DCA COMOUT
-00415 1377 TAD (-7
-00416 3254 DCA XERROR /MUST DEVELOP 7 DIGITS
-00417 4527 JMS I TWOCI /OUTPUT " ("
-00420 4050 4050
-00421 1026 TAD ACC2 /IS DPAC NEG?
-00422 7700 SMA CLA
-00423 5226 JMP DLOOP1-1 /NO, OUTPUT " "
-00424 4776' JMS DPNEG /YES, MAKE IT POSITIVE
-00425 1114 TAD N15 / AND OUTPUT "-".
-00426 4532 SPACE1
-00427 1375 DLOOP1, TAD (12 /RESET DIVISOR TO 10(10)
-00430 3031 DCA OPER1
-00431 3032 DCA OPER2
-00432 4774' JMS DDIV /GO DIVIDE DPAC BY 10(10)
-00433 1027 TAD ACCX1 / GET REMAINDER
-00434 4550 PUSH /PUT IT ON PUSH-DOWN-LIST
-00435 2254 ISZ XERROR /DONE YET?
-00436 5227 JMP DLOOP1
-00437 1016 TAD COMOUT /YES, RESTORE REMAINDER
-00440 3030 DCA ACCX2
-00441 1015 TAD COMIR
-00442 3027 DCA ACCX1
-00443 1377 TAD (-7
-00444 3254 DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS
-00445 4551 DLOOP2, POP / IN REVERSE ORDER!
-00446 4531 DIGIT /MAKE REMAIN A DIGIT
-00447 2254 ISZ XERROR /DONE?
-00450 5245 JMP DLOOP2
-00451 4526 JMS I TYPECI /YES, OUTPUT ")"
-00452 0251 ")
-00453 5571 JMP I RECRLF / AND CR/LF
-
-
- /ERROR ROUTINE
-00454 0000 XERROR, 0
-00455 7200 CLA /CLEAR POSSIBLE JUNK FROM AC
-00456 3052 DCA DSWIT /RESET IN CASE DUMP MODE
-00457 6201 CDF 0
-00460 4526 JMS I TYPECI /OUTPUT "?"
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 6-1
-
-00461 0277 "?
-00462 1373 TAD (ERLIST-1 /INIT LIST POINTER
-00463 3010 DCA DPNT
-00464 3021 DCA TEMP /SET CODE TO 0
-00465 2021 XERR1, ISZ TEMP /BUMP ERROR CODE
-00466 4553 TADIDP /GET AN ADDRESS
-00467 7450 SNA
-00470 5275 JMP XERR2 /(FOR DEBUGGING)
-00471 7040 CMA /= -(ADDR+1)
-00472 1254 TAD XERROR /DOES IT MATCH THE CALL?
-00473 7640 SZA CLA
-00474 5265 JMP XERR1 /NO
-00475 1021 XERR2, TAD TEMP /YES, OUTPUT ERROR CODE
-00476 4541 JMS I DEC2I / AS 2 DECIMAL DIGITS
-00477 4525 JMS I TYPSI /NOW OUTPUT " AT "
-00500 4310 MS17
-00501 1372 TAD (-COMB+1 /CALCULATE POSITION IN
-00502 1016 TAD COMOUT / COMMAND BUFFER,
-00503 4541 JMS I DEC2I / & OUTPUT AS 2 DIGITS.
-00504 1020 TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS ->
-00505 7640 XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!]
-00506 5315 JMP XERR4 /SHORT, GO DO CR/LF
-00507 4344 JMS USROUT /LONG, BE SURE MESSAGES ARE IN
-00510 4533 SPACE2 /OUTPUT 2 SPACES
-00511 1021 TAD TEMP /CODE = ADDRESS-1 OF ADDRESS
-00512 3010 DCA DPNT / OF MESSAGE
-00513 4553 TADIDP /GET MESSAGE ADDR
-00514 4524 JMS I TYPSTI / OUTPUT MESSAGE
-00515 4530 XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR
-00516 5717 JMP I .+1 /*** CIF BAT /BATCH OPER.
-00517 0204 MAIN1 /*** JMP I N7000 /'BATABT'!
-
-
-00520 0000 USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
-00521 3344 DCA USRSAV /SAVE CONTENTS OF AC
-00522 6214 RDF
-00523 1325 TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL)
-00524 3341 DCA USRCDF
-00525 6201 UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL
-00526 1102 TAD USRAD /IS USR IN OR OUT?
-00527 7740 SMA SZA CLA
-00530 5336 JMP USRIN /IN, GO TO IT
-00531 6212 CIF 10
-00532 4507 JMS I M100 /OUT, DO "USRIN" FUNCTION
-00533 0010 10
-00534 1120 TAD N200
-00535 3102 DCA USRAD / & SO INDICATE
-00536 6213 USRIN, CDF CIF 10
-00537 1320 TAD USEUSR /MOVE RETURN ADDRESS TO THE
-00540 3520 DCA I N200 / USR ENTRY POINT
-00541 6201 USRCDF, CDF /SET UP D.F. FOR RETURN
-00542 1344 TAD USRSAV /RESTORE AC CONTENTS
-00543 5771 JMP I (201 / & FAKE A CALL TO IT
- USRSAV,
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 6-2
-
-00544 0000 USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING
-00545 1102 ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH
-00546 7710 SPA CLA / BLOCKS ON SYS.
-00547 5744 JMP I USROUT /JUST EXIT IF PRESENT...
-00550 1107 TAD M100
-00551 3102 DCA USRAD /SET USR TO "OUT"
-00552 4770 JMS I (7607 /READ IN THE MESSAGES
-00553 0610 610 / 6 PAGES TO FIELD 1
-00554 0000 0 / STARTING AT LOC 10000
-00555 0027 27 / FROM SCRATCH BLKS
-00556 7610 SKP CLA /!!! ERROR !!!
-00557 5744 JMP I USROUT /OK, JUST EXIT
-00560 1106 TAD M200
-00561 3305 DCA XERR3 /NO MORE MESSAGES ON ERROR!
-00562 1364 TAD ERC16
-00563 3345 DCA ERC15 /AND NO MORE "SHOW ERROR"!
-00564 4573 ERC16, ERROR /TELL THE HORRIBLE STORY!
-
-
-00570 7607
-00571 0201
-00572 2066
-00573 5530
-00574 6040
-00575 0012
-00576 6141
-00577 7771
- 0600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 7
-
- /ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
-00600 4557 XSCAN, JMS I GARGI /GET ARGS CONVERTED
-00601 1377 TAD (SCANER / & SET UP FOR SCANNING
-00602 5210 JMP XDUM0
-
- /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
-00603 1044 XDUMP, TAD MODSW /MAPPED MODE?
-00604 7740 SMA SZA CLA
-00605 4573 ERC14, ERROR /YES, DUMP IS MEANINGLESS!
-00606 4247 JMS XDLCOM /DO COMMON STUFF
-00607 1376 TAD (LLIST / & SET UP FOR DUMPING
-00610 3327 XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN
-00611 2010 XDUM1, ISZ DPNT /SKIP FIRST WORD
-00612 2010 ISZ DPNT /SKIP A WORD
-00613 1410 TAD I DPNT /GET NEXT START BLOCK.
-00614 4775' JMS BLKTST
-00615 1410 TAD I DPNT /GET NEXT -(# BLOCKS)
-00616 3022 DCA TEMP1
-00617 4534 XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE
-00620 3061 DCA LOCL /SET LOC TO 0
-00621 3060 DCA LOCH
-00622 1103 TAD M400 /SET TO -400(8) [1 BLOCK]
-00623 4727 JMS I XGFORM /DUMP OR SCAN A BLOCK
-00624 2057 ISZ BLK /INCREMENT BLOCK NUMBER
-00625 2022 ISZ TEMP1 /DONE?
-00626 5217 JMP XDUM2 /NO, DO NEXT BLOCK
-00627 2021 ISZ TEMP /YES, ARE ALL ARGS DONE?
-00630 5211 JMP XDUM1 /NO, DO NEXT
-00631 5245 JMP XLIS2 /YES, DONE--RESET SWITCH
-
- /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
-00632 4247 XLIST0, JMS XDLCOM /DO COMMON STUFF
-00633 1410 XLIS1, TAD I DPNT /GET BLOCK #
-00634 4775' JMS BLKTST /TEST & SET BLK
-00635 1410 TAD I DPNT /GET & SET LOCATION
-00636 3060 DCA LOCH
-00637 1410 TAD I DPNT
-00640 3061 DCA LOCL
-00641 1410 TAD I DPNT /GET -(# WORDS)
-00642 4261 JMS LLIST /NOW GO DO IT
-00643 2021 ISZ TEMP /ARE ALL ARGS USED?
-00644 5233 JMP XLIS1 /NO, CONTINUE
-00645 3052 XLIS2, DCA DSWIT /RESET DUMP SWITCH
-00646 5571 JMP I RECRLF / DO CR/LF & CONTINUE
-
- /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
-00647 0000 XDLCOM, 0
-00650 1043 TAD OUTPNT /INITIALIZE DEFAULTS
-00651 3325 DCA LISTPT
-00652 1365 TAD OUTSW
-00653 3326 DCA LOUTSW
-00654 4327 JMS XGFORM /GET FORMAT, IF ANY
-00655 7000 NOP /RETURN FOR NO FORMAT
-00656 4557 JMS I GARGI /GET ARGS
-00657 2052 ISZ DSWIT /SET DUMP SWITCH
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 7-1
-
-00660 5647 JMP I XDLCOM
-
- /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
- /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
-00661 0000 LLIST, 0
-00662 3040 DCA CNTRA /SET UP -# WORDS TO LIST
-00663 3045 DCA CHARSW /RESET UNPACK SWITCH
-00664 4530 LLIS1, JMS I CRLFI
-00665 1061 TAD LOCL
-00666 0113 AND N7 /SET UP # ON THIS LINE
-00667 3037 DCA CNTR
-00670 1326 TAD LOUTSW /IF CHARACTER OUTPUT,
-00671 7650 SNA CLA
-00672 1111 TAD M10 / DOUBLE # WORDS/LINE
-00673 1037 TAD CNTR
-00674 1111 TAD M10
-00675 3037 DCA CNTR
-00676 4546 JMS I BKLOCI /OUTPUT LOCATION
-00677 0056 BLK-1
-00700 4525 JMS I TYPSI /OUTPUT ": "
-00701 4264 MS13
-00702 4561 LLIS2, JMS I GETI /GET A WORD
-00703 5312 JMP LLIS3 /FILE MODE, NO SUCH ADDR..
-00704 4725 JMS I LISTPT /OUTPUT IT
-00705 1326 TAD LOUTSW /TEST MODE SWITCH
-00706 7510 SPA
-00707 5322 JMP LLIS5 /"SYMBOLIC", CR/LF NOW
-00710 7640 SZA CLA /CHARACTERS, NO SPACES
-00711 4533 SPACE2 /NUMBERS, TWO SPACES
-00712 4566 LLIS3, JMS I INCI /INCREMENT LOC
-00713 2040 ISZ CNTRA /ALL WORDS DONE?
-00714 5317 JMP LLIS4 /NO
-00715 4530 JMS I CRLFI
-00716 5661 JMP I LLIST /YES, RETURN
- /
-00717 2037 LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE?
-00720 5302 JMP LLIS2 /NOT YET
-00721 5264 JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE
- /
-00722 7240 LLIS5, STA
-00723 3037 DCA CNTR /FORCE A CR/LF
-00724 5312 JMP LLIS3
-00725 0000 LISTPT, 0
-00726 0000 LOUTSW, 0
-
-
- /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
-00727 0000 XGFORM, 0
-00730 4556 JMS I GWORDI /GET A WORD
-00731 5727 JMP I XGFORM /NOT FOLLOWED BY A WORD
-00732 4567 JMS I SORTI /LOOK UP WORD
-00733 4702 FORML-1
-00734 0031 FOPSL-FORML
-00735 4573 ERCD, ERROR /WORD NOT RECOGNIZED
- /
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 7-2
-
-00736 7130 XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG
-00737 7001 XFNUM, IAC /NUMERIC; SWITCH POS
-00740 3326 XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0
-00741 1012 TAD SCANX1 /'SORTJ' POINTER TO CHAR
-00742 1374 TAD (-FORML /CALCULATE FORMAT #
-00743 7110 CLL RAR /(DIVIDE BY 2)
-00744 3022 DCA TEMP1 / & SAVE IT.
-00745 1022 TAD TEMP1
-00746 1373 TAD (FTABLE-1
-00747 3010 DCA DPNT
-00750 4553 TADIDP
-00751 3325 DCA LISTPT /SET UP OUTPUT POINTER
-00752 2327 ISZ XGFORM /BUMP RETURN ADDRESS
-00753 5727 JMP I XGFORM
-
- /ROUTINE TO 'SET' THE 'FORMAT' OPTION
-00754 4327 XFORM, JMS XGFORM /GET FORMAT WORD
-00755 4573 ERCE, ERROR /NUMBER?! SORRY ABOUT THAT!
-00756 1326 TAD LOUTSW /OK, SET UP DEFAULTS:
-00757 3365 DCA OUTSW / SWITCH,
-00760 1325 TAD LISTPT
-00761 3043 DCA OUTPNT / ROUTINE POINTER,
-00762 1022 TAD TEMP1
-00763 3042 DCA FCNT / & FORMAT #
-00764 5772' JMP XSETN
-00765 0000 OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF
-
-
-00772 1600
-00773 4763
-00774 3075
-00775 6154
-00776 0661
-00777 5744
- 1000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 8
-
- /ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
-01000 7240 XOPEN, STA /"." LEGAL IN FILE NAME
-01001 4777' JMS GNAME /GET FILE NAME FOR OUTPUT
-01002 6212 CIF 10
-01003 5776' JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE
-
-
- /ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
-01004 6213 XCLOSE, CDF CIF 10
-01005 5775' JMP XCLOS1 /ALL CODE IS IN FIELD 1
-
-
- /ROUTINE TO EXECUTE THE 'FILE' COMMAND.
-01006 1022 XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS
-01007 7700 SMA CLA / AT EXTENSION RETRIES?
-01010 5216 JMP XFIOUT / YES, ALL TRIES DONE!
-01011 2001 ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL
-01012 2022 ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL
-01013 1374 TAD (1404 / 2ND TRY--USE "LD" EXTEN
-01014 3030 DCA NAM4 / 3RD TRY--USE NULL EXTEN
-01015 5230 JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE
- /
-01016 4773' XFIOUT, JMS PNAME /OUTPUT FILE NAME &
-01017 4525 JMS I TYPSI /"LOOKUP FAILED"
-01020 4277 MS15
- /
-01021 4530 XFILEN, JMS I CRLFI /OUTPUT CR/LF
-01022 2046 ISZ CRSWT /WAS LAST ENDED BY A CR?
-01023 5572 JMP I RESTAR /YES, DONE
-01024 7240 XFILE, STA /"." LEGAL IN FILE NAME
-01025 4777' JMS GNAME /GET NEXT FILE NAME
-01026 7240 XFICHN, STA
-01027 3001 DCA DPSGN /SET TRY AGAIN SWITCH
-01030 1372 TAD (NAM1 /INIT POINTER TO NAME
-01031 3235 DCA FSTBLK
-01032 1101 TAD DEVNO /GET DEVICE #
-01033 4552 CALUSR
-01034 0002 2 /LOOKUP
-01035 0000 FSTBLK, 0 /NAME PNTR, BECOMES ST BLK
-01036 0000 FBKLEN, 0 / BECOMES -(FILE LENGTH)
-01037 5206 JMP XFIERR /LOOKUP FAILED
-01040 1235 TAD FSTBLK
-01041 3077 DCA RBLK1 /SET UP PAGE 0 ST BLK
-01042 6211 CDF 10
-01043 3771 DCA I (CCBB / & RESET CCBB
-01044 1774 TAD I (1404 /GET # ADD'L INFO WORDS
-01045 3354 DCA GDEV2 / (NEGATIVE) & SAVE IT
-01046 1354 TAD GDEV2
-01047 1770 TAD I (17 /POINT TO FIRST OF THEM
-01050 3355 DCA GDEV3 / (THE DATE, IF PRESENT)
-01051 1513 TAD I N7 /GET THE NUMBER OF THE
-01052 0113 AND N7 / DIRECTORY SEGMENT IN
-01053 3037 DCA CNTR / CORE & SAVE IT.
-01054 1354 TAD GDEV2 /WAS # OF ADD'L WRDS = 0?
-01055 7640 SZA CLA
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 8-1
-
-01056 1755 TAD I GDEV3 / NO, GET THE DATE WORD
-01057 6201 CDF 0
-01060 3353 DCA GDEV1 /STORE DATE OR 0 (NO DATE)
-01061 4773' JMS PNAME /OUTPUT FILE NAME
-01062 1235 TAD FSTBLK
-01063 4540 JMS I OCTI /OUTPUT ST. BLK. IN OCTAL
-01064 4526 JMS I TYPECI
-01065 0255 "-
-01066 1236 TAD FBKLEN /CALCULATE LAST BLK #
-01067 7040 CMA
-01070 1235 TAD FSTBLK
-01071 4540 JMS I OCTI / & OUTPUT IN OCTAL
-01072 4533 SPACE2 /OUTPUT 2 SPACES
-01073 1236 TAD FBKLEN
-01074 7041 CIA
-01075 4540 JMS I OCTI /OUTPUT LENGTH IN OCTAL
-01076 4527 JMS I TWOCI /" ("
-01077 4050 4050
-01100 1236 TAD FBKLEN
-01101 7041 CIA
-01102 4537 JMS I DECI / & AGAIN IN DECIMAL
-01103 4525 JMS I TYPSI /") "
-01104 4403 MS33
-01105 1037 TAD CNTR /GET SEGMENT #
-01106 4543 JMS I RTL6I / & PUT IN BITS 3-5
-01107 4527 JMS I TWOCI / TO OUTPUT IT & "."
-01110 6056 6056
-01111 1355 TAD GDEV3 /GET ADDR OF 1ST ADD'L WRD
-01112 1367 TAD (-1400-4 / FOR OFFSET OF NAME START
-01113 4766' JMS OCT3 /OUTPUT LOCATION IN SEG
-01114 4533 SPACE2 / & TWO SPACES
-01115 1353 TAD GDEV1 /GET DATE WORD
-01116 7440 SZA /IS IT = 0?
-01117 4542 JMS I PDATEI /NO, OUTPUT DATE
-01120 5221 JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE
-
-
- /ROUTINE TO 'SET' THE 'DEVICE' OPTION
-01121 4340 XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
-01122 7201 DEVHAN+1 / (2 PAGE HANDLER IS OK)
-01123 3100 DCA DEVAD /SET UP HANDLER ADDRESS
-01124 1354 TAD GDEV2 /SAVE DEVICE #
-01125 3101 DCA DEVNO
-01126 3077 DCA RBLK1 / & NO FILE KNOWN
-01127 3047 DCA SHUT / & NOTHING OPENED
-01130 3050 DCA MODIF / & NOTHING MODIFIED
-01131 1025 TAD NAM1
-01132 6212 CIF 10
-01133 5765' JMP XDEVM /GO FINISH SETUP IN FIELD 1
-
-
- /ROUTINE TO 'SET' THE 'DDEV' OPTION
-01134 4340 XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
-01135 6601 DMPHAN+1 / (2 PAGE HANDLER IS OK)
-01136 6212 CIF 10
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 8-2
-
-01137 5764' JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP
-
-01140 0000 GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
-01141 4777' JMS GNAME /GET DEV NAME ("." ILLEGAL)
-01142 1025 TAD NAM1 /MOVE NAME TO CALL
-01143 3353 DCA GDEV1
-01144 1026 TAD NAM2
-01145 3354 DCA GDEV2
-01146 1740 TAD I GDEVICE /GET HANDLER SPACE ADDRESS
-01147 2340 ISZ GDEVICE
-01150 3355 DCA GDEV3
-01151 4552 CALUSR
-01152 0001 1 /FETCH HANDLER
-01153 0000 GDEV1, 0
-01154 0000 GDEV2, 0
-01155 0000 GDEV3, 0
-01156 4573 ERCY, ERROR /NO SUCH HANDLER
-01157 1355 TAD GDEV3 /RETURN HANDLER ADDRESS
-01160 5740 JMP I GDEVICE
-
-
-01164 2200
-01165 2467
-01166 3407
-01167 6374
-01170 0017
-01171 6400
-01172 0025
-01173 2731
-01174 1404
-01175 2272
-01176 2222
-01177 3676
- 1200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 9
-
- /ROUTINE TO EXECUTE THE 'SHOW' COMMAND
-01200 4525 XSHBLK, JMS I TYPSI /"BLOCK = "
-01201 4376 MS32
-01202 1077 TAD RBLK1 /OUTPUT BLOCK IN OCTAL
-01203 4540 XSTYPE, JMS I OCTI
-01204 4530 XSHCR, JMS I CRLFI /GIVE A CR & LF
-01205 3052 DCA DSWIT /BE SURE SWITCH IS RESET
-01206 2046 ISZ CRSWT /LAST WORD ENDED BY CR?
-01207 5572 JMP I RESTAR /YES, DONE
-01210 4556 XSHOW, JMS I GWORDI /GET A WORD
-01211 5215 JMP ERCG /NUMBERS NOT RECOGNIZED
-01212 4567 JMS I SORTI /LOOK IT UP
-01213 5073 SHOWL-1
-01214 0037 SHOWOP-SHOWL
-01215 4573 ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD
-
-01216 4525 XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>"
-01217 2512 MSVER
-01220 5204 JMP XSHCR
-
-01221 4525 XSHMSK, JMS I TYPSI /"MASK = "
-01222 4204 MS02
-01223 1075 TAD MASK
-01224 5203 JMP XSTYPE
-
-01225 4525 XSHOFF, JMS I TYPSI /"OFFSET = "
-01226 4242 MS09
-01227 1073 TAD OFFSET
-01230 7041 CIA
-01231 5203 JMP XSTYPE
-
-01232 4525 XSHFIL, JMS I TYPSI /"FILLER = "
-01233 4415 MS37
-01234 1074 TAD FILLER
-01235 5203 JMP XSTYPE
-
-01236 4525 XSHODL, JMS I TYPSI /"ODT LOC = "
-01237 4256 MS12
-01240 4546 JMS I BKLOCI /OUTPUT IT
-01241 0067 SBLK-1
-01242 5257 JMP XSHBKS
-
-01243 4525 XSHREL, JMS I TYPSI /"REL. LOC = "
-01244 4324 MS20
-01245 4546 JMS I BKLOCI / & OUTPUT IT
-01246 0056 BLK-1
-01247 5257 JMP XSHBKS
-
-01250 4525 XSHABS, JMS I TYPSI /"ABS. LOC = "
-01251 4210 MS03
-01252 1056 TAD CAD /OUTPUT LOCATION IN BLOCK
-01253 1377 TAD (-IOBUF
-01254 3056 DCA CAD
-01255 4546 JMS I BKLOCI
-01256 0053 CBLK-1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 9-1
-
-01257 1050 XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED?
-01260 7700 SMA CLA
-01261 5204 JMP XSHCR / NO, SAY NOTHING!
-01262 4525 JMS I TYPSI / YES, SAY " MOD"
-01263 2142 MSMOD
-01264 5204 JMP XSHCR
-
-01265 4525 XSHUPP, JMS I TYPSI /"UPPER = "
-01266 4216 MS04
-01267 4546 JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM
-01270 0061 UBLK-1
-01271 5204 JMP XSHCR
-
-01272 4525 XSHLOW, JMS I TYPSI /"LOWER = "
-01273 4223 MS05
-01274 4546 JMS I BKLOCI
-01275 0064 LBLK-1
-01276 5204 JMP XSHCR
-
-01277 4525 XSHFMT, JMS I TYPSI /"FORMAT = "
-01300 4230 MS06
-01301 1042 TAD FCNT
-01302 1376 TAD (FMTLS-1 /SET UP FOR CORRECT TITLE
-01303 3010 XSHFM, DCA DPNT
-01304 4553 TADIDP /GET MESSAGE ADDRESS
-01305 4524 JMS I TYPSTI /OUTPUT DESCRIPTOR
-01306 5204 JMP XSHCR
-
-01307 4525 XSHMOD, JMS I TYPSI /"MODE = "
-01310 4247 MS10
-01311 1044 TAD MODSW /GET CORRECT MESSAGE
-01312 1375 TAD (MODELS-1 /(OFFSET INTO TABLE)
-01313 5303 JMP XSHFM /GET ADDRESS & OUTPUT
-
-01314 4525 XSHOUT, JMS I TYPSI /"OUTPUT = "
-01315 4367 MS30
-01316 1017 TAD TYPSW /SET UP MESSAGE ADDRESS
-01317 1374 TAD (OUTLS-1 /(OFFSET INTO TABLE)
-01320 5303 JMP XSHFM
-
-01321 4525 XSHSMS, JMS I TYPSI /"SMASK = "
-01322 4203 MS07
-01323 1076 TAD SMASKL
-01324 3021 DCA TEMP /-# TO OUTPUT
-01325 1176 TAD MASKBS
-01326 3010 DCA DPNT /SET UP TO OUTPUT
-01327 1111 TAD M10 /SET LINE LENGTH
-01330 3022 DCA TEMP1
-01331 5342 JMP XSHSM2
-01332 4527 XSHSM1, JMS I TWOCI /OUTPUT ", "
-01333 5440 5440
-01334 2022 ISZ TEMP1 /ENOUGH ON THIS LINE?
-01335 5342 JMP XSHSM2 /NO, OK
-01336 4530 JMS I CRLFI /YES, OUTPUT CR-LF
-01337 4533 SPACE2 / & 2 SPACES
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 9-2
-
-01340 7240 STA /MAKE LINE 1 LONGER
-01341 5327 JMP XSHSM1-3 /AND RESET LENGTH
- /
-01342 4553 XSHSM2, TADIDP /GET NEXT VALUE
-01343 4540 JMS I OCTI / & OUTPUT IT
-01344 2021 ISZ TEMP /ENOUGH?
-01345 5332 JMP XSHSM1
-01346 5204 JMP XSHCR /OK, GET NEXT WORD
-
-01347 4525 XSHDEV, JMS I TYPSI /"DEVICE = XXXX"
-01350 2457 MSDEV
-01351 4527 JMS I TWOCI /NOW OUTPUT " ("
-01352 4050 4050
-01353 1101 TAD DEVNO /GET THE DEVICE #
-01354 4541 JMS I DEC2I / & OUTPUT AS 2 DIGITS
-01355 4526 JMS I TYPECI /FINALLY OUTPUT ")"
-01356 0251 ")
-01357 5204 JMP XSHCR
-
-01360 4525 XSHDDEV,JMS I TYPSI /"DDEV = XXXX"
-01361 2450 MSDDEV
-01362 5204 JMP XSHCR
-
-
-01363 0000 FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8
-01364 4773 JMS I (FPRNTX /FIRST PRINT BANK BITS
-01365 7012 RTR /MOVE TO BITS 9-11
-01366 7010 RAR
-01367 0113 AND N7 /MASK TO 1 DIGIT
-01370 4531 DIGIT / & OUTPUT IN ASCII
-01371 5763 JMP I FPRNT
-
-
-01373 7011
-01374 5274
-01375 5270
-01376 4777
-01377 0600
- 1400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 10
-
- /CONTINUATION OF 'SHOW' COMMAND
-
- /SHOW 'CCB' HANDLER
-01400 6213 XSHCCB, CDF CIF 10
-01401 4777' JMS GCCB /SET UP CCB FOR FILE
-01402 3001 DCA DPSGN / & SET UP SEGMENTS
-01403 4525 JMS I TYPSI /"CCB:"
-01404 4253 MS11
-01405 4353 JMS CCHDST /DO SETUP, OUTPUT START
-01406 4525 JMS I TYPSI /", JSW = "
-01407 4317 MS19
-01410 4776' JMS NXTOCT /OUTPUT J.S.W. IN OCTAL
-01411 4530 JMS I CRLFI
-01412 4525 JMS I TYPSI /" CORE SEGS: "
-01413 4267 MS14
-01414 1375 XSHCC1, TAD (-4
-01415 3037 DCA CNTR /-#/LINE
-01416 4553 XSHCC2, TADIDP /GET ORIGIN WORD
-01417 3022 DCA TEMP1
-01420 4553 TADIDP / & COUNT WORD
-01421 3023 DCA TEMP2
- / TAD TEMP2 /GO OUTPUT START FIELD
- / JMS FPRNT
-01422 4774 JMS I (ADFLD /ADJUST BANK AND FIELD FOR 128K
-01423 1022 TAD TEMP1 / & START ADDR
-01424 4540 JMS I OCTI
-01425 4526 JMS I TYPECI / & A "-"
-01426 0255 "-
- / TAD TEMP2 /OUTPUT FIELD AGAIN
- / JMS FPRNT
-01427 4774 JMS I (ADFLD /ADJUST BANK AND FIELD (128K)
-01430 1023 TAD TEMP2 / PAGE COUNT -> PAGES
-01431 7104 CLL RAL
-01432 0106 AND M200 /MASK OFF FIELD DATA
-01433 1022 TAD TEMP1 /ADD ORIGIN ADDR
-01434 1112 TAD M1 / & SUBTRACT 1 FOR END
-01435 4540 JMS I OCTI /OUTPUT END ADDR IN OCTAL
-01436 2001 ISZ DPSGN /DONE?
-01437 5245 JMP XSHCC4 /NO
-01440 1000 TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
-01441 7450 SNA
-01442 5773' JMP XSHCR / NO, DONE
-01443 3010 DCA DPNT / YES, RESET POINTER
-01444 5277 JMP XSHHD1 / & CONTINUE
- /
-01445 4527 XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR
-01446 5440 5440
-01447 2037 ISZ CNTR /DONE ON THIS LINE?
-01450 5216 JMP XSHCC2 /NO
-01451 4530 JMS I CRLFI /YES
-01452 4533 SPACE2 /ADD 2 SPACES
-01453 7240 STA /AND 1 MORE ITEM PER LINE
-01454 5214 JMP XSHCC1
-
- /SHOW 'HEADER' HANDLER
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 10-1
-
-01455 6213 XSHHDR, CDF CIF 10
-01456 4772' JMS GHDR /SET UP HEADER FOR MODULE
-01457 4525 JMS I TYPSI /"HEADER:"
-01460 4422 MS38
-01461 4353 JMS CCHDST /DO SETUP, OUTPUT START
-01462 4525 JMS I TYPSI /", NEXT WORD = "
-01463 4426 MS39
-01464 4553 TADIDP /GET FIELD DIGIT
-01465 4531 DIGIT / & OUTPUT
-01466 4776' JMS NXTOCT /FOLLOWED BY ADDRESS
-01467 4525 JMS I TYPSI /", LOAD VER = "
-01470 4436 MS40
-01471 4776' JMS NXTOCT / & OUTPUT VERSION
-01472 4553 TADIDP /GET E.P. FLAG
-01473 7650 SNA CLA
-01474 5277 JMP XSHHD1 / NO E.P.
-01475 4525 JMS I TYPSI /", EP REQ'D"
-01476 4443 MS41
-01477 4530 XSHHD1, JMS I CRLFI /TO THE NEXT LINE
-01500 4525 JMS I TYPSI /" OVLYS START...
-01501 4452 MS42
-01502 4553 XSHHD2, TADIDP /GET NUMBER OF OVERLAYS
-01503 7450 SNA / FOR THIS LEVEL
-01504 5773' JMP XSHCR / 0 = END, DONE
-01505 3022 DCA TEMP1 /SAVE IT
-01506 4530 JMS I CRLFI /OUTPUT A CR/LF
-01507 4533 SPACE2 / AND 4 SPACES
-01510 4533 SPACE2
-01511 1022 TAD TEMP1
-01512 4541 JMS I DEC2I /# OVLYS IN DECIMAL
-01513 4533 SPACE2
-01514 4553 TADIDP /GET MEMORY START WORD
-01515 3023 DCA TEMP2
-01516 1023 TAD TEMP2
-01517 4771' JMS FPRNT /OUTPUT START FIELD
-01520 1023 TAD TEMP2
-01521 0103 AND M400 / & DOUBLE-PAGE
-01522 4540 JMS I OCTI
-01523 4533 SPACE2
-01524 4776' JMS NXTOCT /OUTPUT RELATIVE BLOCK
-01525 4533 SPACE2
-01526 4776' JMS NXTOCT /OUTPUT OVERLAY LENGTH
-01527 5302 JMP XSHHD2 /AND DO ANOTHER ROUND!
-
- /SHOW 'ERRORS' HANDLER
-01530 4770' XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN
-01531 2052 ISZ DSWIT /SET DUMP SWITCH
-01532 4525 JMS I TYPSI /"ERRORS: FUTIL VERSION ..."
-01533 2500 MSERR
-01534 4530 JMS I CRLFI
-01535 7201 CLA IAC
-01536 3010 DCA DPNT /SET POINTER & CODE
-01537 4530 XSHER1, JMS I CRLFI /DO ANOTHER CR/LF
-01540 1010 TAD DPNT /TEST FOR LAST REAL MESSAGE
-01541 1367 TAD (-EMSEND /(NOT DEBUG MESSAGE!)
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 10-2
-
-01542 7650 SNA CLA
-01543 5773' JMP XSHCR
-01544 1010 TAD DPNT /OUTPUT ERROR CODE
-01545 4541 JMS I DEC2I / AS 2 DIGITS
-01546 4525 JMS I TYPSI /THEN " = "
-01547 4200 MS01
-01550 4553 TADIDP /GET ADDR OF MESSAGE AND
-01551 4524 JMS I TYPSTI / OUTPUT IT
-01552 5337 JMP XSHER1
-
-
-01553 0000 CCHDST, 0
-01554 4530 JMS I CRLFI
-01555 4525 JMS I TYPSI /" SA = "
-01556 4313 MS18
-01557 1366 TAD (CCBB
-01560 3010 DCA DPNT /SET UP POINTER TO DATA
-01561 4553 TADIDP /GET 2ND WORD FROM CCB/HDR
-01562 4771' JMS FPRNT /IT HAS START FIELD SO OUTPUT
-01563 4776' JMS NXTOCT / FOLLOWED BY START ADDR
-01564 5753 JMP I CCHDST
-
-
-01566 6400
-01567 7720
-01570 0544
-01571 1363
-01572 2050
-01573 1204
-01574 7000
-01575 7774
-01576 1766
-01577 2000
- 1600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 11
-
- /ROUTINE TO EXECUTE THE 'SET' COMMAND
-01600 2046 XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR?
-01601 5572 JMP I RESTAR /YES, DONE
-01602 4556 XSET, JMS I GWORDI /GET OPTION WORD
-01603 5211 JMP XSET1 /NO NUMBERS PLEASE!
-01604 2046 ISZ CRSWT /WAS WORD ENDED BY A CR?
-01605 4573 ERCK, ERROR /YES, ILLEGAL HERE
-01606 4567 JMS I SORTI /LOOK UP WORD
-01607 5110 SETLST-1
-01610 0060 SETJMP-SETLST
-01611 4573 XSET1, ERROR /WHAT???
-
-
- /ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
-01612 4556 XDMODE, JMS I GWORDI /GET A WORD
-01613 5217 JMP ERC11 /NO NUMBERS HERE!
-01614 4567 JMS I SORTI /LOOK IT UP
-01615 5260 XDMLST-1
-01616 0004 XDMOPS-XDMLST
-01617 4573 ERC11, ERROR /NO LIKEE!!
- /
-01620 7350 CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE)
-01621 7001 XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC)
-01622 3053 DCA DMODE / 0: 'NONE' (TTY ONLY)
-01623 5200 JMP XSETN
-
-
- /ROUTINE TO 'SET' THE 'OUTPUT' OPTION
-01624 4556 XOUTS, JMS I GWORDI /GET OPTION WORD
-01625 5231 JMP ERCL / # IN THE BUFFER
-01626 4567 JMS I SORTI /LOOK IT UP
-01627 5222 XOLST-1
-01630 0007 XOOPS-XOLST
-01631 4573 ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD
- /
-01632 7344 CLL STA RAL /-1: 'FPP' (SYMBOLIC)
-01633 7001 XOUTS1, IAC /+1: 'PDP' (SYMBOLIC)
-01634 3017 DCA TYPSW / 0: 'OCTAL'
-01635 5200 JMP XSETN
-
-
- /ROUTINE TO 'SET' THE 'MASK' OPTION
-01636 4560 XMASK, JMS I ARGI /GET ONE ARG
-01637 1025 TAD ACC1 /GET 'LOC'
-01640 3075 DCA MASK / & SET MASK
-01641 5200 JMP XSETN
-
-
- /ROUTINE TO 'SET' THE 'OFFSET' OPTION
-01642 4560 XOFFS, JMS I ARGI /GET ONE ARG
-01643 1025 TAD ACC1 /GET #
-01644 7041 CIA
-01645 3073 DCA OFFSET /SET IT
-01646 5200 JMP XSETN
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 11-1
-
-
- /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
-01647 4556 XEMODE, JMS I GWORDI /GET WORD
-01650 5254 JMP ERCZ /NO NUMBERS ALLOWED!!!
-01651 4567 JMS I SORTI /LOOK IT UP
-01652 5211 XELST-1
-01653 0005 XEOPS-XELST
-01654 4573 ERCZ, ERROR /ILLEGAL SOMETHING
- /
-01655 7001 XEMOD1, IAC /'SHORT'
-01656 3020 DCA ERMODE /'LONG'
-01657 5200 JMP XSETN
-
-
- /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
-01660 4565 XUPP, JMS I LIMITI /UPPER, GET ARGS
-01661 0062 UBLK
-01662 5200 JMP XSETN
-
- /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
-01663 4565 XLOW, JMS I LIMITI /LOWER, GET ARGS
-01664 0065 LBLK
-01665 5200 JMP XSETN
-
- /ROUTINE TO 'SET' THE 'MODE' OPTION
-01666 4556 XMODE, JMS I GWORDI /GET OPTION WORD
-01667 5273 JMP ERCJ /NUMBER IN BUFFER, BAIL OUT
-01670 4567 JMS I SORTI /LOOK IT UP
-01671 5237 MODLST-1
-01672 0011 MODOPS-MODLST
-01673 4573 ERCJ, ERROR /NOT RECOGNIZED
- /
-01674 7346 CLL STA RTL /-1: OFFSET
-01675 7001 XMODS, IAC /+2: LOAD (MODULE)
-01676 7001 IAC /+1: SAVE (FILE)
-01677 3044 DCA MODSW / 0: NORMAL
-01700 5200 JMP XSETN
-
- /ROUTINE TO 'SET' THE 'FILLER' OPTION
-01701 4560 XFILL, JMS I ARGI /GET ONE ARG
-01702 1025 TAD ACC1
-01703 3074 DCA FILLER / & SET AS FILLER
-01704 5200 JMP XSETN
-
- /ROUTINE TO 'SET' THE 'TEMP' STORAGE
-01705 4560 XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!)
-01706 1025 TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER
-01707 3033 DCA TEMPV1
-01710 1026 TAD ACC2 /GET IT BACK WITH "EVAL T"
-01711 3034 DCA TEMPV2 / (OR IN AN EXPRESSION)
-01712 5200 JMP XSETN
-
-
- /ROUTINE TO EXECUTE THE 'IF' COMMAND
-01713 4547 XIF, JMS I EVALI /EVALUATE THE EXPRESSION
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 11-2
-
-01714 7410 SKP / TERMIN = CR, OK
-01715 5777' JMP ERCC / TOO MANY PARENS
-01716 1025 TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO
-01717 7450 SNA
-01720 1026 TAD ACC2
-01721 7650 SNA CLA
-01722 5572 JMP I RESTAR /OK, JUST CONTINUE
-01723 1174 XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR
-01724 3015 DCA COMIR / LINE STARTING WITH "END"
-01725 4523 READLN /GET A LINE FROM THE INPUT
-01726 4522 TYPEM-1 / WITH THESE TERMINATORS
-01727 0342 IFSKPO-TYPEM
-01730 5323 JMP XIFSKP /BUFFER EMPTIED
- /
-01731 4570 XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP
-01732 5323 JMP XIFSKP / CR ONLY
-01733 4556 JMS I GWORDI /GET 1ST WORD ON LINE
-01734 5323 JMP XIFSKP / NO WORD
-01735 1376 TAD (-0516 /IS THE WORD "EN..."?
-01736 7640 SZA CLA
-01737 5323 JMP XIFSKP / NO, KEEP LOOKING!
-01740 5572 JMP I RESTAR /YES! BEGIN EXECUTION AGAIN!
-
-
- /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
- /OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT
- /AS RELATIVE LOCATION.
-01741 0000 ABKLOC, 0
-01742 1051 TAD ABSSW /IS IT 0?
-01743 7640 SZA CLA
-01744 5353 JMP ABK2 /NO, OUTPUT AS ABSOLUTE
-01745 4546 JMS I BKLOCI /OUTPUT LOCATION
-01746 0056 BLK-1
-01747 4527 ABK1, JMS I TWOCI /OUTPUT ": "
-01750 7240 7240
-01751 4535 JMS I TWOT
-01752 5741 JMP I ABKLOC
- /
-01753 1061 ABK2, TAD LOCL /MAKE ABSOLUTE
-01754 0121 AND N377
-01755 3056 DCA CAD
-01756 4546 JMS I BKLOCI /NOW OUTPUT IT
-01757 0053 CBLK-1
-01760 5347 JMP ABK1
-
-01761 0000 TWOCS, 0 /OUTPUT 2-CHARACTER ARG
-01762 1761 TAD I TWOCS /GET ARG
-01763 2361 ISZ TWOCS /SKIP IT
-01764 4535 JMS I TWOT /OUTPUT IT
-01765 5761 JMP I TWOCS
-
-01766 0000 NXTOCT, 0
-01767 4553 TADIDP /GET NEXT WORD FROM BLOCK
-01770 4540 JMS I OCTI / & OUTPUT IN OCTAL
-01771 5766 JMP I NXTOCT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 11-3
-
-
-
-01776 7262
-01777 0402
- 2000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 12
-
- /ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
-02000 4247 XWORD, JMS SSET /INITIALIZE SEARCH
-02001 1236 TAD CNOP /SET UP FOR NORMAL,
-02002 3237 DCA CNOP+1
-02003 1111 TAD M10 / EQUAL SEARCH
-02004 1377 XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH
-02005 3233 DCA XWORC
-02006 4556 XWOR1, JMS I GWORDI /GET POSSIBLE WORD
-02007 5221 JMP XWOR3 /NUMBERS IN BUFFER
-02010 2046 ISZ CRSWT /WAS IT ENDED BY A CR?
-02011 4573 ERCI, ERROR /YES, VELLY SOLLY!
-02012 4567 JMS I SORTI /LOOK UP COMMAND: UN, ME,
-02013 5276 XWORCL-1 / AB, FR, TO
-02014 0014 XWOROP-XWORCL
-02015 4573 ERCH, ERROR /COMMAND NOT RECOGNIZED
- /
-02016 1230 XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY-
-02017 3237 DCA CNOP+1 / REFERENCE OP-CODES CAN
-02020 5206 JMP XWOR1 / EVER BE OUTPUT.
- /
-02021 4560 XWOR3, JMS I ARGI /GET AN ARG
-02022 1025 TAD ACC1 /GET THE VALUE
-02023 0075 AND MASK
-02024 7041 CIA
-02025 3036 DCA CNT /LOOK FOR THIS WORD
-02026 4307 JMS LSETUP /SET UP COUNT OF WORDS TO DO
-02027 4561 XWOR4, JMS I GETI /GET A WORD
-02030 5245 JMP XWOR5 /FILE MODE, NO SUCH ADDRESS
-02031 0075 AND MASK
-02032 1036 TAD CNT
-02033 7402 XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA"
-02034 5245 JMP XWOR5 /DID NOT MATCH
-02035 4776' JMS OPRTST /TEST FOR OP-CODES 6 & 7
-02036 7000 CNOP, NOP / 7--OPR
-02037 7000 NOP / 6--IOT;"NOP" OR "JMP XWOR5"
-02040 4775' JMS ABKLOC /DID MATCH, OUTPUT LOC
-02041 4561 JMS I GETI /GET THAT WORD
-02042 5774' JMP ERCP / OH I HOPE NOT!!!
-02043 4540 JMS I OCTI /AND OUTPUT IT IN OCTAL
-02044 4530 JMS I CRLFI
-02045 4347 XWOR5, JMS LCHEK /DONE YET?
-02046 5227 JMP XWOR4 /NO
-
- /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
-02047 0000 SSET, 0
-02050 3051 DCA ABSSW /RESET ABSOLUTE SWITCH
-02051 1065 TAD LBLK /SET UP START BLK & LOC
-02052 3057 DCA BLK
-02053 1066 TAD LLOCH
-02054 3060 DCA LOCH
-02055 1067 TAD LLOCL
-02056 3061 DCA LOCL
-02057 1062 TAD UBLK /SET UP END BLK & LOC
-02060 3304 DCA EBLK
-02061 1063 TAD ULOCH
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 12-1
-
-02062 3305 DCA ELOCH
-02063 1064 TAD ULOCL
-02064 3306 DCA ELOCL
-02065 5647 JMP I SSET
-
- /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES
-
-02066 7240 XWSABS, STA
-02067 3051 DCA ABSSW /'ABSOLUTE'--SET SWITCH
-02070 5300 JMP XWSRET
- /
-02071 4565 XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS
-02072 0057 BLK
-02073 5300 JMP XWSRET
- /
-02074 1062 XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED
-02075 3304 DCA EBLK
-02076 4565 JMS I LIMITI / & GET UPPER LIMITS
-02077 2104 EBLK
-02100 7344 XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS
-02101 1556 TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW
-02102 3347 DCA LCHEK / THESE TO BE COMMON TO BOTH
-02103 5747 JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES.
-02104 0000 EBLK, 0
-02105 0000 ELOCH, 0
-02106 0000 ELOCL, 0
-
-
-02107 0000 LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
-02110 3025 DCA ACC1 /INITIALIZE THESE TO 0
-02111 3026 DCA ACC2
-02112 1044 TAD MODSW /IN A MAPPED MODE?
-02113 7740 SMA SZA CLA
-02114 5327 JMP LSETL / YES, IGNORE BLOCK PARTS
-02115 1057 TAD BLK / NO, SET UP FOR 24 BIT
-02116 3025 DCA ACC1
-02117 1304 TAD EBLK / BLK-EBLK
-02120 3031 DCA OPER1
-02121 3032 DCA OPER2
-02122 4773' JMS DSUB /DO THE SUBTRACTION
-02123 1372 TAD (400 /NOW SET UP MULTIPLY BY 400
-02124 3031 DCA OPER1
-02125 3032 DCA OPER2
-02126 4771' JMS DMUL /GIVES: (BLK-EBLK)*400
-02127 7101 LSETL, CLL IAC
-02130 1306 TAD ELOCL
-02131 3031 DCA OPER1 /NOW SET UP ELOC+1
-02132 7004 RAL
-02133 1305 TAD ELOCH
-02134 3032 DCA OPER2
-02135 4773' JMS DSUB /AND SUBTRACT IT
-02136 1061 TAD LOCL /NOW ADD LOC TO GIVE:
-02137 3031 DCA OPER1 / (BLK-EBLK)*400+(LOC-ELOC-1)
-02140 1060 TAD LOCH / WHICH IS 24-BIT COUNT OF
-02141 3032 DCA OPER2 / WORDS TO SEARCH.
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 12-2
-
-02142 4770' JMS DADD
-02143 1026 TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO
-02144 7700 SMA CLA
-02145 5571 JMP I RECRLF / FAR, SO JUST QUIT NOW!
-02146 5707 JMP I LSETUP
-
- /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****
-
-02147 0000 LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED
-02150 4566 JMS I INCI /INCREMENT LOC
-02151 2025 ISZ ACC1 /COUNT WORDS TO DO
-02152 5747 JMP I LCHEK
-02153 2026 ISZ ACC2 / (24-BIT)
-02154 5747 JMP I LCHEK
-02155 5571 JMP I RECRLF /DO CR/LF & STOP!
-
-
-02156 0000 TIDPNT, 0 /"TAD I DPNT" IN FIELD 1
-02157 6211 CDF 10
-02160 1410 TAD I DPNT
-02161 6201 CDF 0
-02162 5756 JMP I TIDPNT
-
-
-02163 0000 ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE
-02164 0117 AND N177 /MAKE CHARS INTO "STANDARD"
-02165 1120 TAD N200 / FORM: 7 BITS + PARITY ON
-02166 4536 JMS I TYPEI / TO CAUSE CORRECT PRINTING
-02167 5763 JMP I ASCII
-
-
-02170 5650
-02171 6000
-02172 0400
-02173 5662
-02174 2473
-02175 1741
-02176 4547
-02177 7650
- 2200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 13
-
- /ROUTINE TO 'REWIND' THE DEVICE
-02200 6211 XREWIN, CDF 10
-02201 1102 TAD USRAD /RESET DIRECTORY SEGMENT KEY
-02202 7700 SMA CLA
-02203 3513 DCA I N7 / IN USR IF IT IS IN MEMORY.
-02204 6201 CDF 0
-02205 4500 JMS I DEVAD /CALL HANDLER
-02206 0110 0110 /READ, 1 PAGE, FIELD 1
-02207 6127 PDLB /DUMMY BUFFER (ZAP P.D.L.)
-02210 0001 1 /BLK 1
-02211 5213 JMP RERROR /READ ERROR!
-02212 5572 JMP I RESTAR
-
- /READ ERROR--TEST TYPE & OUTPUT MESSAGE
-
-02213 7710 RERROR, SPA CLA /BIT 0 = 1 IF FATAL
-02214 4573 ERC00, ERROR /FATAL
-02215 4573 ERC01, ERROR /NON-FATAL
-
-
- /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
-02216 4777' XSTRIN, JMS SSET /INITIALIZE
-02217 1376 TAD (STJMP-STCDF /RESET MASKING SWITCH
-02220 1200 XSTR0, TAD XREWIN / OR SET MASKING SWITCH
-02221 3360 DCA SMSKSW
-02222 4556 JMS I GWORDI /GET POSSIBLE WORD
-02223 5232 JMP XSTR1 /NUMBERS ONLY
-02224 2046 ISZ CRSWT /FOLLOWED BY A CR?
-02225 5775' JMP ERCI / YES, KICK OUT*****
-02226 4567 JMS I SORTI /LOOK UP OPTION: MA,
-02227 5300 STRLST-1 / AB, FR, TO
-02230 0025 STROPS-STRLST
-02231 5774' JMP ERCH /NO LIKEE!
- /
-02232 4557 XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER
-02233 1021 TAD TEMP / MASKING THEM IF SPECIFIED
-02234 3037 DCA CNTR /SET UP LENGTH
-02235 1175 TAD TEMPST
-02236 3013 DCA SCANX2 /STORING DONE IN NEG. FORM
-02237 5242 JMP XSTR2+2 /GO SET UP MASK
- /
-02240 2024 XSTR2, ISZ TEMP3 /MASK END?
-02241 5246 JMP XSTR3
-02242 1176 TAD MASKBS /YES, RESET MASK
-02243 3011 DCA SPNT
-02244 1076 TAD SMASKL /SET UP LENGTH
-02245 3024 DCA TEMP3
-02246 2010 XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS
-02247 2010 ISZ DPNT
-02250 1410 TAD I DPNT /GET A WORD
-02251 4357 JMS STRMSK /TEST & MASK
-02252 7041 CIA /NEGATE
-02253 3413 DCA I SCANX2 /STORE
-02254 2010 ISZ DPNT /BUMP POINTER
-02255 2037 ISZ CNTR /DONE?
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 13-1
-
-02256 5240 JMP XSTR2
-02257 4773' JMS LSETUP /YES, SET UP COUNT OF WORDS
-02260 1175 XSTR4, TAD TEMPST /SET UP FOR SEARCH:
-02261 3010 DCA DPNT / STRING,
-02262 1021 TAD TEMP
-02263 3037 DCA CNTR / & STRING LENGTH.
-02264 1061 TAD LOCL
-02265 3366 DCA XLOCL /SAVE CURRENT LOCATION
-02266 1060 TAD LOCH
-02267 3365 DCA XLOCH
-02270 1057 TAD BLK
-02271 3364 DCA XBLK
-02272 1025 TAD ACC1 / & COUNT FOR RESET
-02273 3031 DCA OPER1
-02274 1026 TAD ACC2
-02275 3032 DCA OPER2
-02276 5302 JMP XSTR6 /NOW SET UP MASK
- /
-02277 4772' XSTR5, JMS LCHEK /DONE?
-02300 2024 ISZ TEMP3 /NO, AT MASK END?
-02301 5306 JMP XSTR7
-02302 1176 XSTR6, TAD MASKBS / YES, RESET MASK
-02303 3011 DCA SPNT
-02304 1076 TAD SMASKL
-02305 3024 DCA TEMP3
-02306 4561 XSTR7, JMS I GETI /GET NEXT WORD
-02307 5333 JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS
-02310 4357 JMS STRMSK /TEST & MASK
-02311 1410 TAD I DPNT /COMPARE?
-02312 7640 SZA CLA
-02313 5333 JMP XSTR10 /NO, GO RESET & CONTINUE
-02314 2037 ISZ CNTR /MATCHED ENOUGH?
-02315 5277 JMP XSTR5 /NOT YET
-02316 4343 JMS XRSET /YES, RESET LOCATION & COUNT
-02317 1021 TAD TEMP /AND LENGTH
-02320 3037 DCA CNTR
-02321 1111 XSTR8, TAD M10
-02322 3027 DCA ACCX1 / -(#/LINE)
-02323 4771' JMS ABKLOC /OUTPUT THIS LOCATION
-02324 4561 XSTR9, JMS I GETI /GET A WORD
-02325 5770' JMP ERCP /BAD,BAD,BAD!!!
-02326 4540 JMS I OCTI /AND OUTPUT IN OCTAL
-02327 4566 JMS I INCI /INCREMENT LOC
-02330 2037 ISZ CNTR /DONE?
-02331 5336 JMP XSTR11 /NO, CONTINUE
-02332 4530 JMS I CRLFI /YES, OUTPUT CR/LF
-02333 4343 XSTR10, JMS XRSET /RESET LOCATION & COUNT
-02334 4772' JMS LCHEK /DONE?
-02335 5260 JMP XSTR4 /NO, LOC INC'D, TRY NEXT
- /
-02336 4533 XSTR11, SPACE2 /OUTPUT " "
-02337 2027 ISZ ACCX1 /DONE ON THIS LINE?
-02340 5324 JMP XSTR9 /NO, NOT YET
-02341 4530 JMS I CRLFI /YES
-02342 5321 JMP XSTR8
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 13-2
-
-
-02343 0000 XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC
-02344 1366 TAD XLOCL /LOC
-02345 3061 DCA LOCL
-02346 1365 TAD XLOCH
-02347 3060 DCA LOCH
-02350 1364 TAD XBLK /BLK
-02351 3057 DCA BLK
-02352 1031 TAD OPER1 /WORDS LEFT TO SEARCH
-02353 3025 DCA ACC1
-02354 1032 TAD OPER2
-02355 3026 DCA ACC2
-02356 5743 JMP I XRSET
-
-02357 0000 STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED ***
-02360 6211 SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK"
-02361 0411 AND I SPNT /OK, MASK IN FIELD 1
-02362 6201 CDF 0
-02363 5757 JMP I STRMSK
- 5757 STJMP= JMP I STRMSK
- 6211 STCDF= CDF 10
-
-02364 0000 XBLK, 0
-02365 0000 XLOCH, 0
-02366 0000 XLOCL, 0
-
-
-02370 2473
-02371 1741
-02372 2147
-02373 2107
-02374 2015
-02375 2011
-02376 7546
-02377 2047
- 2400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 14
-
- /ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
-02400 4560 XWRARG, JMS I ARGI /GET ONE ARG
-02401 1025 TAD ACC1 /USE IT AS THE BLOCK
-02402 7410 SKP
-02403 1777' XWRITE, TAD WBLK /SET BLOCK
-02404 3210 DCA XWBLK
-02405 4500 JMS I DEVAD /CALL HANDLER
-02406 4210 4210 /WRITE, 2 PAGES, FIELD 1
-02407 7200 IOBUF
-02410 0000 XWBLK, 0 /[** COUNTER FOR MODIFY **]
-02411 5214 JMP WERROR /WRITE ERROR
-02412 3050 DCA MODIF /CLEAR SOMETHING-CHANGED FLAG
-02413 5572 JMP I RESTAR
-
- /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE
-
-02414 7710 WERROR, SPA CLA /BIT 0 = 1 IF FATAL
-02415 4573 ERC02, ERROR /FATAL
-02416 4573 ERC03, ERROR /NON-FATAL
-
-
- /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
-02417 4556 XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE
-02420 5231 JMP XMODEF /NONE, GET DEFAULT
-02421 3277 DCA MODTMP /SAVE FOR LATER
-02422 2046 ISZ CRSWT /TERMINATED BY A CR?
-02423 5230 JMP ERCO / YES, SAVE USER FROM HIMSELF!
-02424 1277 TAD MODTMP /TEST FORMAT FOR RECOGNITION
-02425 4567 JMS I SORTI
-02426 5013 MODIFL-1
-02427 0021 MODADS-MODIFL
-02430 4573 ERCO, ERROR / I THEENK YOU USE BAD WORD!
- /
- /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
-02431 1042 XMODEF, TAD FCNT /USE CURRENT FORMAT,
-02432 1376 TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE
-02433 3010 DCA DPNT
-02434 4553 TADIDP /GET THE ONE TO USE
-02435 3277 DCA MODTMP / AND SAVE IT
- /
-02436 4557 XMOD0, JMS I GARGI /OK, NOW GET ARGS
-02437 1021 TAD TEMP /MOVE COUNT TO A SAFE PLACE
-02440 3210 DCA XWBLK
-02441 1410 XMOD1, TAD I DPNT /GET BLOCK #
-02442 4775' JMS BLKTST /TEST & SET BLK
-02443 1410 TAD I DPNT /GET LOC
-02444 3060 DCA LOCH
-02445 1410 TAD I DPNT
-02446 3061 DCA LOCL
-02447 1410 TAD I DPNT /GET -(# LOCS)
-02450 3037 DCA CNTR
-02451 1174 XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS
-02452 3015 DCA COMIR
-02453 3045 DCA CHARSW /RESET HALF SWITCH
-02454 4545 JMS I SOCTI /INITIALIZE INPUT TO OCTAL
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 14-1
-
-02455 4546 JMS I BKLOCI /OUTPUT START LOC
-02456 0056 BLK-1
-02457 4527 JMS I TWOCI /AND ": "
-02460 7240 7240
-02461 4523 READLN /GET A LINE (TEST: RUBOUT, ^U & ^R)
-02462 4522 TYPEM-1 /IGNORE LF'S
-02463 0340 MCHARO-TYPEM
-02464 5251 JMP XMOD2 /BUFFER EMPTIED!
-
-
- /CR TYPED, END
-02465 4570 XMODCR, JMS I ENDCI /END BUFFER WITH A CR.
-02466 5251 JMP XMOD2 /ONLY A CR IN BUFFER-RETRY!
-02467 1277 TAD MODTMP /NOW LOOK UP FORMAT
-02470 4567 JMS I SORTI
-02471 5013 MODIFL-1
-02472 0011 MODIFO-MODIFL
-02473 4573 ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE)
-
-02474 2210 XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE?
-02475 5241 JMP XMOD1 /NO
-02476 5572 JMP I RESTAR /YES
-02477 0000 MODTMP, 0
-
-02500 0000 XGET, 0 /SUB. TO SET CURRENT LOC & FLAG
-02501 4561 JMS I GETI /SET LOCATION
-02502 4573 ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS
-02503 7240 STA
-02504 3050 DCA MODIF /SET FLAG
-02505 5700 JMP I XGET
-
- /NUMERIC FORMATS HERE
-02506 4567 XNUM0, JMS I SORTI /TEST TERMINATOR
-02507 5443 GETLST-1-1 /SPACE, COMMA, CR
-02510 7423 NUMOPS-GETLST+1
-02511 5774' JMP ERCQ /ILLEGAL TERMIN
- /
-02512 4563 XNUM1, JMS I GETNI /COMMA, SKIP IT
-02513 4564 JMS I SSKIPI / SPACE, IGNORE IT
-02514 4773' XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION
-02515 4300 JMS XGET /SET UP LOCATION
-02516 1025 TAD ACC1
-02517 4555 DCAICAD / & STORE VALUE
-02520 4566 JMS I INCI /INCREMENT LOCATION
-02521 2037 ISZ CNTR /ALL MODS DONE?
-02522 5306 JMP XNUM0 /NO, TEST TERMIN
-02523 5274 JMP XMODDN /YES, TEST NEXT SET
- /
-02524 1037 XNUM3, TAD CNTR /DONE?
-02525 7650 SNA CLA
-02526 5274 JMP XMODDN /YES
-02527 4300 JMS XGET /NO, SET UP LOC
-02530 1074 TAD FILLER
-02531 4555 DCAICAD /AND FILL WITH 'FILLER'
-02532 4566 JMS I INCI /INCREMENT LOC
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 14-2
-
-02533 2037 ISZ CNTR /DONE?
-02534 5324 JMP XNUM3 /NO
-02535 5274 JMP XMODDN /YES
-
- /ASCII FORMAT HERE
-02536 4346 JMS CGET /GET A CHAR & CHECK FOR CR
-02537 4300 XASC1, JMS XGET /SET UP LOC & SET FLAG
-02540 1035 TAD CHAR
-02541 4555 DCAICAD /STORE THIS CHAR
-02542 4566 JMS I INCI /INCREMENT LOC
-02543 2037 ISZ CNTR /MODS DONE?
-02544 5336 JMP XASC1-1 /NO
-02545 5274 JMP XMODDN /YES
-
-02546 0000 CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE
-02547 4352 JMS CGTEST /GET & TEST NEXT
-02550 5324 JMP XNUM3 /CR, FILL REST WITH 'FILLER'
-02551 5746 JMP I CGET
-
-02552 0000 CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR
-02553 4563 JMS I GETNI /GET NEXT CHARACTER
-02554 1035 TAD CHAR /IS IT A CR?
-02555 1105 TAD M215
-02556 7640 SZA CLA
-02557 2352 ISZ CGTEST /RETURN TO CALL+2 IF NOT
-02560 5752 JMP I CGTEST
-
-
-02561 0000 DO1SP, 0 /OUTPUT " " + AC
-02562 4526 JMS I TYPECI
-02563 0240 "
-02564 5761 JMP I DO1SP /ANOTHER TUFFIE
-
-02565 0000 DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII)
-02566 4527 JMS I TWOCI
-02567 4040 4040
-02570 5765 JMP I DO2SP /FAST & SWEET!
-
-
-02573 5727
-02574 5722
-02575 6154
-02576 5045
-02577 3042
- 2600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 15
-
- /ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
-02600 4557 XSMASK, JMS I GARGI /GET ARGS
-02601 1021 TAD TEMP
-02602 3076 DCA SMASKL /SAVE -(MASK LENGTH)
-02603 1176 TAD MASKBS /SET UP TO STORE WORDS
-02604 3011 DCA SPNT
-02605 2010 XSMAS1, ISZ DPNT /SKIP 2 WORDS
-02606 2010 ISZ DPNT
-02607 1410 TAD I DPNT /GET & STORE ONE
-02610 6211 CDF 10
-02611 3411 DCA I SPNT
-02612 6201 CDF 0
-02613 2010 ISZ DPNT /SKIP 1 MORE
-02614 2021 ISZ TEMP /DONE ?
-02615 5205 JMP XSMAS1 /NO
-02616 5572 JMP I RESTAR
-
-
- /XS240 PACKED ASCII FORMAT HERE
-02617 1104 XXS20, TAD M240 /SET OFFSET
- /PACKED ASCII FORMAT HERE
-02620 3331 XPAC0, DCA PNAME /CLEAR OFFSET
-02621 1104 XPAC1, TAD M240 /IS CHAR < 240?
-02622 1035 TAD CHAR
-02623 7700 SMA CLA
-02624 5227 JMP XPAC2 /NO, JUST PACK CHAR
-02625 7040 CMA
-02626 4304 JMS PACK /YES, PACK A FLAG (77) FIRST
-02627 1035 XPAC2, TAD CHAR /NOW GO PACK CHAR
-02630 1331 TAD PNAME /(WITH DESIRED OFFSET)
-02631 4304 JMS PACK
-02632 4777' JMS CGET /NOW GET & TEST NEXT
-02633 5221 JMP XPAC1 / OK, CONTINUE
-
- /OS/8 ASCII HERE
-02634 1061 XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN
-02635 7010 RAR /(LOW BIT TO LINK &
-02636 7200 CLA / CLEAR AC)
-02637 1037 TAD CNTR
-02640 7010 RAR /(LOW TO LINK, LINK TO AC0)
-02641 7730 SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK
-02642 4573 ERC04, ERROR /START OR COUNT NOT EVEN
-02643 1045 XOPS2, TAD CHARSW /GET SWITCH
-02644 2045 ISZ CHARSW / & BUMP IT
-02645 7110 CLL RAR /ROTATE AC 11 INTO LINK
-02646 7670 SZL SNA CLA /CHARACTER 3?
-02647 5275 JMP XOPS5 /NO, CHAR 1 OR CHAR 2
-02650 7240 STA
-02651 1056 TAD CAD /YES, BACK UP POINTER
-02652 3056 DCA CAD
-02653 7344 STA CLL RAL / & SET LOOP COUNT TO -2
-02654 3045 DCA CHARSW
-02655 1035 XOPS3, TAD CHAR /GET REST OF CHAR
-02656 7106 CLL RTL /4 BITS LEFT
-02657 7006 RTL
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 15-1
-
-02660 3035 DCA CHAR /SAVE IT
-02661 1035 TAD CHAR /NOW MERGE 4 BITS WITH
-02662 0103 AND N7400 / A PREVIOUS CHAR
-02663 4554 TADICAD
-02664 4555 DCAICAD /4 BITS OF 3RD + 1ST OR 2ND
-02665 2056 ISZ CAD /BUMP POINTER
-02666 2045 ISZ CHARSW /DONE?
-02667 5255 JMP XOPS3
-02670 1037 TAD CNTR /YES, DONE ALL MODS?
-02671 7650 SNA CLA
-02672 5776' JMP XMODDN /YES, TEST FOR DONE
-02673 4777' XOPS4, JMS CGET /GET & TEST NEXT CHAR
-02674 5243 JMP XOPS2 /OK, DO NEXT
- /
-02675 4775' XOPS5, JMS XGET /SET UP CURRENT LOC
-02676 1035 TAD CHAR
-02677 4555 DCAICAD /AND STORE CHARACTER
-02700 4566 JMS I INCI /INCREMENT LOC
-02701 2037 ISZ CNTR /BUMP COUNTER FOR LATER
-02702 5273 JMP XOPS4 / SO IGNORE SKIP NOW
-02703 5273 JMP XOPS4
-
-02704 0000 PACK, 0 /SUB. TO PACK CHARACTERS
-02705 0116 AND N77 /USE ONLY 6 BITS
-02706 2045 ISZ CHARSW /CHECK HALF
-02707 5316 JMP PACK1
-02710 4554 TADICAD /RIGHT HALF, ADD TO LEFT
-02711 4555 DCAICAD
-02712 1037 TAD CNTR /ALL MODS DONE?
-02713 7640 SZA CLA
-02714 5704 JMP I PACK /NO
-02715 5776' JMP XMODDN /YES
- /
-02716 4543 PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT
-02717 3045 DCA CHARSW /SAVE IT
-02720 4775' JMS XGET /SET UP CURRENT LOC
-02721 1045 TAD CHARSW
-02722 4555 DCAICAD /STORE WORD
-02723 4566 JMS I INCI /INCREMENT LOC
-02724 2037 ISZ CNTR /BUMP COUNTER FOR LATER
-02725 7000 NOP / SO DON'T SKIP NOW
-02726 7240 STA
-02727 3045 DCA CHARSW /RESET SWITCH
-02730 5704 JMP I PACK
-
-
-02731 0000 PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES
-02732 1025 TAD NAM1
-02733 4535 JMS I TWOT / OUTPUT UP TO
-02734 1026 TAD NAM2
-02735 4535 JMS I TWOT / 6 CHARACTERS
-02736 1027 TAD NAM3
-02737 4535 JMS I TWOT / OF FILE NAME,
-02740 4526 JMS I TYPECI / A "."
-02741 0256 ".
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 15-2
-
-02742 1030 TAD NAM4 / & UP TO 2 CHARS
-02743 4535 JMS I TWOT / OF EXTENSION.
-02744 4532 PNAME1, SPACE1 /OUTPUT A " "
-02745 1041 TAD NCNT /11(10) CHARS ON LINE YET?
-02746 1374 TAD (-13
-02747 7710 SPA CLA
-02750 5344 JMP PNAME1 /NO, OUTPUT ANOTHER SPACE
-02751 5731 JMP I PNAME
-
-
- /SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
- / COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
- / POINTED TO BY CALL+1. THE FIRST WORD (BLOCK
- / NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
- / GIVEN IN THE COMMAND.
-
-02752 0000 LIMITS, 0
-02753 1752 TAD I LIMITS /GET ADDRESS OF 3 WORDS
-02754 2352 ISZ LIMITS
-02755 3331 DCA PNAME / & SAVE IT
-02756 4560 JMS I ARGI /GET COMMAND DATA
-02757 1022 TAD TEMP1 /GET BLOCK NUMBER PART
-02760 2022 ISZ TEMP1 /WAS A BLOCK PART SPEC'D?
-02761 3731 DCA I PNAME / YES, STORE IT
-02762 7200 CLA /(CLEAR IN CASE NOT!)
-02763 2331 ISZ PNAME /BUMP POINTER
-02764 1026 TAD ACC2
-02765 0113 AND N7
-02766 3731 DCA I PNAME /STORE HIGH 3 BITS
-02767 2331 ISZ PNAME
-02770 1025 TAD ACC1
-02771 3731 DCA I PNAME / & LOW 12 BITS OF ADDR.
-02772 5752 JMP I LIMITS
-
-
-02774 7765
-02775 2500
-02776 2474
-02777 2546
- 3000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 16
-
- /SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
- /
- / THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
- / IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
- /
- / MODE ACTION
- /
- / 0 = NORMAL THE HIGH 7 BITS OF THE 15 BIT ADDRESS
- / ARE ADDED TO THE SPECIFIED BLOCK #
- / TO GET THE ACTUAL BLOCK & THE LOW 8
- / BITS OF THE 15 BIT ADDR ARE USED TO
- / SPECIFY THE WORD WITHIN THE BLOCK.
- /
- / -1 = OFFSET THE 12 BIT "OFFSET" (WHICH IS NEGATED)
- / IS ADDED TO THE LOW 12 BITS OF THE
- / ADDRESS, AND THEN THE NEW ADDRESS IS
- / HANDLED AS ABOVE.
- / THIS MODE IS USED PRIMARILY WHEN
- / WORKING WITH THE OPERATING SYSTEM
- / WITH OVERLAYS WHOSE REAL START BLOCK
- / AND LOCATION WITHIN A FIELD ARE KNOWN.
- / BY SETTING THE "OFFSET" TO THE START
- / ADDRESS OF THE OVERLAY, ITS REAL
- / ADDRESSES CAN BE USED AND THE PROPER
- / LOCATIONS WILL BE ACCESSED.
- /
- / +1 = SAVE THIS MODE IS USED WITH CORE IMAGE
- / "SAVE" FILES ONLY. THE FILE'S CCB
- / (CORE CONTROL BLOCK) IS USED TO
- / DETERMINE THE REAL LOCATION ON THE
- / DEVICE OF THE SPECIFIED 15 BIT ADDR-
- / ESS. THE START BLOCK OF THE FILE
- / IS USED, AND ANY SPECIFIED "BLOCK"
- / PART IS USED TO SPECIFY THE OVERLAY
- / WANTED AT THAT ADDRESS. FOR FILES
- / WITHOUT OVERLAYS (GENERATED BY THE
- / MONITOR "SAVE" COMMAND), THIS PART
- / MUST BE ZERO (0) OR NO MATCH WILL
- / OCCUR. FOR FILES WITH OVERLAYS
- / (GENERATED BY THE PROGRAM "LINK"),
- / A LEGAL OVERLAY AT THE SPECIFIED
- / ADDRESS MUST BE SPECIFIED FOR A
- / MATCH TO OCCUR. THIS MODE CAN ONLY
- / BE USED AFTER A "FILE" COMMAND.
- /
- / +2 = LOAD THIS MODE IS USED WITH OS/8 FORTRAN
- / IV LOAD MODULES. THE FILE'S HEADER
- / BLOCK IS USED TO DETERMINE THE REAL
- / LOCATION ON THE DEVICE OF THE SPECI-
- / FIED 15 BIT ADDRESS AND THE "BLOCK"
- / PART IS USED TO SPECIFY THE OVERLAY
- / WANTED AT THAT ADDRESS. THIS MODE CAN
- / ONLY BE USED AFTER A "FILE" COMMAND.
-
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 16-1
-
- /CALLING SEQUENCE:
- /
- / JMS I GETI
- / RETURN1 /MODE=MAPPED, NO SUCH ADDRESS
- / NORMAL RETURN /'CAD' SET, DATA IN AC
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 17
-
- /SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT
-
-03000 0000 GET, 0
-03001 4534 JMS I CTRLI /GO TEST FOR CONTROL-CHARS
-03002 1044 TAD MODSW /OK, TEST MODE
-03003 7450 SNA
-03004 5210 JMP GET0 /NORMAL MODE, NO CHANGES
-03005 7700 SMA CLA
-03006 5777' JMP GET4 /SAVE MODE, DO MAPPING
-03007 1073 TAD OFFSET /OFFSET MODE, ADD IT
-03010 4263 GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES'
-03011 1057 TAD BLK / OF LOC TO BLK TO SET
-03012 3054 DCA CBLK /'CURRENT BLOCK'
-03013 4227 GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT
-03014 5776' JMP RERROR / READ ERROR, GO TELL ABOUT IT
-03015 1044 TAD MODSW /TEST AGAIN FOR OFFSET
-03016 7710 SPA CLA
-03017 1073 TAD OFFSET /YES, ADD IT AGAIN
-03020 1061 TAD LOCL /USE 8 ADDRESS BITS FROM LOC
-03021 0121 AND N377
-03022 1241 TAD BUFST /INTO BUFFER, TO SET
-03023 3056 DCA CAD /'CURRENT ADDRESS'
-03024 4554 TADICAD /NOW GET THE WORD
-03025 2200 ISZ GET /RETURN TO CALL+2 WITH IT
-03026 5600 GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL]
-
-03027 0000 GETIO, 0 /DO I/O FOR 'GET' & 'SCANER'
-03030 1054 TAD CBLK /IS THIS SAME BLOCK AS IS IN
-03031 7041 CIA /CORE CURRENTLY?
-03032 1257 TAD RBLK
-03033 7650 SNA CLA
-03034 5261 JMP GETIO2 /YES, USE IT.
-03035 2050 ISZ MODIF /NO, ANY CHANGES IN THIS BLK?
-03036 5244 JMP GETIO1 /NO, DEVICE OK AS IS
-03037 4500 JMS I DEVAD /CALL DEVICE HANDLER
-03040 4210 4210 /WRITE, 2 PAGES, FIELD 1
-03041 7200 BUFST, IOBUF
-03042 0000 WBLK, 0
-03043 5775' JMP WERROR /WRITE ERROR
-03044 1054 GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK
-03045 3242 DCA WBLK
-03046 1054 TAD CBLK / AND INPUT BLOCK #
-03047 3257 DCA RBLK
-03050 3050 DCA MODIF / AND RESET SWITCH
-03051 1054 TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS
-03052 7421 MQL / (IF THERE ARE ANY!)
-03053 7200 CLA
-03054 4500 JMS I DEVAD /CALL DEVICE HANDLER
-03055 0210 0210 /READ, 2 PAGES, FIELD 1
-03056 7200 IOBUF
-03057 7777 RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #)
-03060 5627 JMP I GETIO /READ ERROR
-03061 2227 GETIO2, ISZ GETIO /OK, DO NORMAL RETURN
-03062 5627 JMP I GETIO
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 17-1
-
-
-03063 0000 DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES
-03064 1061 TAD LOCL
-03065 0103 AND M400 /HIGH 4 BITS HERE
-03066 7104 CLL RAL /BECOME LOW 4 BITS
-03067 1060 TAD LOCH /FOR A 7 BIT VALUE
-03070 7006 RTL
-03071 7006 RTL
-03072 5663 JMP I DBLPGS
-
-
- /GET WORD ROUTINE FOR "ODT" COMMANDS
-
-03073 0000 ODGET, 0
-03074 1070 TAD SBLK /SET UP BLOCK
-03075 3057 DCA BLK
-03076 1071 TAD SLOCH
-03077 3060 DCA LOCH
-03100 1072 TAD SLOCL
-03101 3061 DCA LOCL /SET UP LOCATION
-03102 4561 JMS I GETI /NOW GET WORD
-03103 4573 ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS
-03104 5673 JMP I ODGET / & RETURN WITH IT
-
-
- /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL
-
-03105 0000 BKLOC, 0
-03106 1705 TAD I BKLOC /GET ARGUMENT (ADDR-1)
-03107 2305 ISZ BKLOC
-03110 3014 DCA GETPNT / & SET UP A-XR
-03111 1414 TAD I GETPNT /GET BLOCK PART
-03112 4540 JMS I OCTI / & OUTPUT IT
-03113 1414 TAD I GETPNT /GET FIELD
-03114 0113 AND N7
-03115 4527 JMS I TWOCI / & OUTPUT "." & IT
-03116 5660 5660 / (".0")
-03117 1414 TAD I GETPNT /GET ADDRESS
-03120 4540 JMS I OCTI / & OUTPUT IT
-03121 5705 JMP I BKLOC
-
-
- /SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
- /FROM THE COMMAND BUFFER. IF THE BUFFER CONTAINS
- /ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
- /IS SPACE OR CR
-03122 0000 GWORD, 0
-03123 4564 JMS I SSKIPI /GET NEXT NON-SPACE
-03124 1035 TAD CHAR
-03125 0116 AND N77 /USE THIS CHAR AS LEFT
-03126 4543 JMS I RTL6I / 6 BITS.
-03127 3045 DCA CHARSW /SAVE IT
-03130 4567 JMS I SORTI /CHECK FOR ^K, ^D, (, ", ',
-03131 5350 GWLST1-1 / DIGITS, SPACE & CR
-03132 0022 GWOPS1-GWLST1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 17-2
-
-03133 4563 JMS I GETNI /NONE, IS NEXT A SPACE
-03134 4567 JMS I SORTI / OR A C.R.?
-03135 5367 GWLST2-1
-03136 0022 GWOPS2-GWLST2
-03137 1035 TAD CHAR /NONE, USE AS LOWER 6 BITS
-03140 0116 AND N77
-03141 1045 TAD CHARSW
-03142 3045 DCA CHARSW /SAVE IT
-03143 4563 GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R.
-03144 4567 JMS I SORTI
-03145 5367 GWLST2-1
-03146 0022 GWOPS2-GWLST2
-03147 5343 JMP GWD1 /NEITHER, KEEP LOOKING
- /
-03150 7240 GWD2, STA /SPACE FOUND, SET SWITCH
-03151 3046 GWD3, DCA CRSWT /CR FOUND, RESET SWITCH
-03152 1045 TAD CHARSW /RETURN WITH WORD
-03153 2322 ISZ GWORD / TO CALL+2
-03154 5722 GWD4, JMP I GWORD
- /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
- / ^K, ^D, (, ", ', DIGITS
-
-
- /"DIRECTORY" FORMAT OUTPUT ROUTINE
-03155 0000 DIRDMP, 0
-03156 4540 JMS I OCTI /OUTPUT IN OCTAL FIRST
-03157 4533 SPACE2
-03160 4554 TADICAD
-03161 4363 JMS DIROUT / THEN 3 OTHERS
-03162 5755 JMP I DIRDMP
-
- /"?" ODT OUTPUT ROUTINE
-03163 0000 DIROUT, 0
-03164 7041 CIA /ASSUME WAS NEGATIVE
-03165 4537 JMS I DECI / & OUTPUT IN DECIMAL
-03166 4533 SPACE2
-03167 4554 TADICAD
-03170 4542 JMS I PDATEI /OUTPUT AGAIN AS DATE
-03171 4533 SPACE2
-03172 4554 TADICAD
-03173 4535 JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII
-03174 5763 JMP I DIROUT
-
-
-03175 2414
-03176 2213
-03177 3200
- 3200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 18
-
- /CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
- / MODES DONE HERE.
-
-03200 4777' GET4, JMS DBLPGS /GET # DOUBLE-PAGES
-03201 3056 DCA CAD / & SAVE IT
-03202 7240 STA
-03203 1044 TAD MODSW /TEST FOR SAVE OR LOAD MODE
-03204 7640 SZA CLA
-03205 5300 JMP GETL1 / LOAD MODE
-03206 6213 CDF CIF 10
-03207 4776' JMS GCCB /SAVE MODE, GET CCB
-03210 3361 DCA SEGCNT / & SET UP # SEGMENTS
-03211 1077 TAD RBLK1 /SET UP ACTUAL FIRST BLOCK
-03212 7001 IAC
-03213 3054 DCA CBLK / FOR MAPPING.
-03214 6211 GETS1, CDF 10
-03215 1414 TAD I GETPNT /GET AN ORIGIN WORD
-03216 3357 DCA GETORG
-03217 1414 TAD I GETPNT / & A CONTROL WORD.
-03220 6201 CDF 0
-03221 3360 DCA GETCW
-03222 1360 TAD GETCW /TEST FOR FIELD MATCH
-03223 7112 CLL RTR
-03224 7010 RAR
-03225 0113 AND N7 /(MASK OFF COUNT)
-03226 7041 CIA
-03227 1060 TAD LOCH /SAME?
-03230 7640 SZA CLA
-03231 5261 JMP GETS2 /NO, TRY NEXT SEGMENT
-03232 1061 TAD LOCL /YES, NOW TEST ADDRESSES
-03233 0106 AND M200 /(MASK TO PAGE)
-03234 7161 STL CIA
-03235 1357 TAD GETORG /[ORIG PAGE]-[ADDR PAGE]
-03236 7460 SZA SNL /ABOVE THE ORIGIN?
-03237 5261 JMP GETS2 /NO, TRY NEXT
-03240 7010 RAR /OK, DIVIDE BY 2 (WITH SIGN)
-03241 3357 DCA GETORG / & SAVE IT.
-03242 1360 TAD GETCW /BEYOND TOP OF SEGMENT?
-03243 0107 AND M100 /(MASK OFF FIELD AND MAKE)
-03244 7450 SNA
-03245 7130 STL RAR / 0 => 40, THEN SUBTRACT
-03246 1107 TAD M100 / ONE PAGE)
-03247 1357 TAD GETORG
-03250 7710 SPA CLA
-03251 5261 JMP GETS2 /NO, TRY NEXT
-03252 1357 TAD GETORG /YES, UPDATE CBLK TO RIGHT
-03253 7041 CIA
-03254 4362 JMS UPCBLK / ACTUAL BLOCK
-03255 1057 TAD BLK /MUST BE IN "LVL 0" OR
-03256 7640 SZA CLA
-03257 5775' JMP GETX / RETURN AS BAD
-03260 5774' JMP GET1 /NOW GO GET THE DATA
- /
-03261 7200 GETS2, CLA
-03262 1360 TAD GETCW /UPDATE CBLK
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 18-1
-
-03263 0107 AND M100
-03264 7450 SNA
-03265 7130 STL RAR /(MAKING 0 => 40)
-03266 1373 TAD (100 /(ROUND UP PAGE COUNT)
-03267 4362 JMS UPCBLK
-03270 2361 ISZ SEGCNT /ALL SEGMENTS DONE?
-03271 5214 JMP GETS1 /NO, TRY NEXT
-03272 1000 TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
-03273 7450 SNA
-03274 5775' JMP GETX / NO, RETURN TO CALL+1
-03275 1372 TAD (4 / YES, RESET POINTER
-03276 3014 DCA GETPNT / TO SKIP OVER LVL 0
-03277 5302 JMP GETL2 / & CONTINUE
- /
-03300 6213 GETL1, CDF CIF 10
-03301 4771' JMS GHDR /GET & TEST HEADER
-03302 6211 GETL2, CDF 10
-03303 1414 TAD I GETPNT /GET NUMBER OF OVERLAYS
-03304 3361 DCA SEGCNT
-03305 1414 TAD I GETPNT /GET PAGE & FIELD
-03306 3360 DCA GETCW
-03307 1414 TAD I GETPNT /GET REL BLK NUMBER
-03310 1077 TAD RBLK1 / + START BLOCK
-03311 3054 DCA CBLK / = ABS START BLK, THIS LEVEL
-03312 1414 TAD I GETPNT /GET LENGTH, THESE OVERLAYS
-03313 6201 CDF 0
-03314 3357 DCA GETORG
-03315 1360 TAD GETCW /GET DBL-PAGE & FIELD
-03316 7450 SNA
-03317 5775' JMP GETX / 0 = THE END!!!
-03320 0103 AND M400 /CONVERT TO DBL-PAGE #
-03321 7106 CLL RTL
-03322 7006 RTL
-03323 1360 TAD GETCW / IN BITS 5-11
-03324 7004 RAL
-03325 0117 AND N177
-03326 7041 CIA /-(DBL-PG # OF OVLY START)
-03327 1056 TAD CAD /+(DBL-PG # OF DESIRED)
-03330 7510 SPA
-03331 5345 JMP GETL3 / GONE TOO FAR, MISSED IT!
-03332 3360 DCA GETCW /= RELATIVE BLOCK NUMBER
-03333 1360 TAD GETCW /IS THIS WITHIN THIS OVLY?
-03334 7041 CIA
-03335 1357 TAD GETORG
-03336 7750 SPA SNA CLA
-03337 5302 JMP GETL2 / NO, TRY NEXT OVERLAY
-03340 1057 TAD BLK /OK, SET UP -(#LVL +1)
-03341 7040 CMA
-03342 3362 DCA UPCBLK /V7B
-03343 1362 TAD UPCBLK /V7B-ADDR IS OK, IS THERE A
-03344 1361 TAD SEGCNT / LEVEL WANTED?
-03345 7710 GETL3, SPA CLA
-03346 5775' JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT
-03347 1360 TAD GETCW /ALL OK! ADD RELATIVE BLK
-03350 7410 SKP
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 18-2
-
-03351 1357 GETL4, TAD GETORG / TO (LVLS-1)*LENGTH-V7B
-03352 1054 TAD CBLK
-03353 3054 DCA CBLK / TO OVERLAY START BLOCK
-03354 2362 ISZ UPCBLK /[MULTIPLY BY ADDING]-V7B
-03355 5351 JMP GETL4
-03356 5774' JMP GET1
-03357 0000 GETORG, 0
-03360 0000 GETCW, 0
-03361 0000 SEGCNT, 0
-
-03362 0000 UPCBLK, 0
-03363 4544 JMS I RTR6I /MOVE COUNT TO BITS 6-11
-03364 7110 CLL RAR /DIVIDE FOR DOUBLE PAGES
-03365 1054 TAD CBLK /UPDATE
-03366 3054 DCA CBLK
-03367 5762 JMP I UPCBLK
-
-
-
-03371 2050
-03372 0004
-03373 0100
-03374 3013
-03375 3026
-03376 2000
-03377 3063
- 3400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 19
-
- /NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
-
-03400 0000 OPRT, 0 /4-DIGIT OCTAL
-03401 4253 JMS NUMOUT
-03402 7000 -1000
-03403 7700 -100
-03404 7770 -10
-03405 0000 0
-03406 5600 JMP I OPRT
-
-03407 0000 OCT3, 0 /3-DIGIT OCTAL
-03410 4253 JMS NUMOUT
-03411 7700 -100
-03412 7770 -10
-03413 0000 0
-03414 5607 JMP I OCT3
-
-03415 0000 BPRT, 0 /3-DIGIT BCD
-03416 4253 JMS NUMOUT
-03417 7400 -400
-03420 7760 -20
-03421 0000 0
-03422 5615 JMP I BPRT
-
-
-03423 0000 SGNDP, 0 /4-DIGIT DECIMAL, SIGNED
-03424 3300 DCA NUMB
-03425 1300 TAD NUMB
-03426 7710 SPA CLA
-03427 1114 TAD N15
-03430 4532 SPACE1 /OUTPUT "-" OR " "
-03431 1300 TAD NUMB /NOW OUTPUT IN DECIMAL
-03432 7510 SPA
-03433 7041 CIA
-03434 4236 JMS DPRT
-03435 5623 JMP I SGNDP
-
- DECIMAL
-
-03436 0000 DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED
-03437 4253 JMS NUMOUT
-03440 6030 -1000
-03441 7634 -100
-03442 7766 -10
-03443 0000 0
-03444 5636 JMP I DPRT
-
-03445 0000 DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED
-03446 0117 AND N177 /MASK IT FIRST
-03447 4253 JMS NUMOUT
-03450 7766 -10
-03451 0000 0
-03452 5645 JMP I DEC2
-
- OCTAL
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 19-1
-
-
-03453 0000 NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE
-03454 3300 DCA NUMB /SAVE THE NUMBER
-03455 3301 NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0
-03456 7300 CLA CLL
-03457 1300 TAD NUMB /GET CURRENT VALUE
-03460 1653 TAD I NUMOUT /SUBTRACT DIGIT BASE
-03461 7420 SNL /DID IT OVERFLOW?
-03462 5266 JMP NUMO2 /NO, TOO FAR!
-03463 2301 ISZ NUMDGT /YES, BUMP DIGIT
-03464 3300 DCA NUMB / & UPDATE VALUE
-03465 5256 JMP NUMO1+1
- /
-03466 7300 NUMO2, CLA CLL
-03467 1301 TAD NUMDGT /OUTPUT THE "DIGIT"
-03470 4531 DIGIT
-03471 2253 ISZ NUMOUT /BUMP TO NEXT ARG
-03472 1653 TAD I NUMOUT /DONE ENOUGH?
-03473 7640 SZA CLA
-03474 5255 JMP NUMO1
-03475 1300 TAD NUMB /YES, SO OUTPUT THE LAST
-03476 4531 DIGIT / ONE.
-03477 5653 JMP I NUMOUT /AND RETURN
-03500 0000 NUMB, 0
-03501 0000 NUMDGT, 0
-
-03502 0000 SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER.
-03503 1035 TAD CHAR
-03504 1104 TAD M240 /IS THIS A SPACE?
-03505 7640 SZA CLA
-03506 5702 JMP I SSKIP /NO, DONE
-03507 4563 JMS I GETNI /YES, GET NEXT CHAR
-03510 5303 JMP SSKIP+1 / & GO TRY IT
-
-
- /OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR
- / FOR EVEN WORD & 2 CHARS FOR ODD WORD.
-
-03511 0000 OSTYPE, 0
-03512 4327 JMS OSSET /DO SETUP FOR UNPACKING
-03513 4777 JMS I (ASCII /OUTPUT CHARS TO "STANDARD"
-03514 2045 ISZ CHARSW /UNPACK 2ND CHARACTER?
-03515 5340 JMP OSUNPK / YES, & RETURN TO OSSET CALL!
-03516 5711 JMP I OSTYPE /DONE, RETURN TO CALLER
-
-
- /OS/8 "BYTE" OUTPUT SUBROUTINE. OUTPUT ONE
- / 8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
- / BIT OCTAL NUMBERS FOR ODD WORD. USED FOR
- / DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.
-
-03517 0000 BYTEO, 0
-03520 4327 JMS OSSET /DO SETUP FOR UNPACKING
-03521 4207 JMS OCT3 /3 DIGIT OCTAL OUTPUT
-03522 2045 ISZ CHARSW /UNPACK 2ND "CHAR"?
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 19-2
-
-03523 7410 SKP
-03524 5717 JMP I BYTEO / DONE, RETURN
-03525 4533 SPACE2 /YES, BUT OUTPUT 2 SPACES
-03526 5340 JMP OSUNPK / BEFORE DOING UNPACKING
-
-
- /OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
- / 'BYTEO'. THE SUBROUTINE SETS UP THE COUNTER
- / FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
- / THE AC. THE ROUTINE WILL BE CALLED ONLY IF 2
- / OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
- / 2ND "CHARACTER", RETURNING TO THE CALLER OF THE
- / SUBROUTINE!
-
-03527 0000 OSSET, 0 /ENTER HERE TO INITIALIZE
-03530 3357 DCA INC /SAVE AC
-03531 7001 IAC
-03532 0061 AND LOCL /AC = 0 OR 1
-03533 7040 CMA /AC = -1 OR -2 (-# TO DO)
-03534 3045 DCA CHARSW /SET UP UNPACK COUNT
-03535 1357 OSRETN, TAD INC /GET VALUE TO AC
-03536 0121 AND N377 /MASK TO 8 BITS
-03537 5727 JMP I OSSET
- /
-03540 7240 OSUNPK, STA /JUMP HERE IF 2ND CHAR TO GET
-03541 1056 TAD CAD
-03542 3223 DCA SGNDP /POINT TO HIGH WORD
-03543 6211 CDF 10
-03544 1456 TAD I CAD /GET LOW BITS OF "CHAR"
-03545 0103 AND N7400 / MASK TO 4 BITS AND
-03546 4544 JMS I RTR6I / MOVE TO BITS 8-11
-03547 7012 RTR
-03550 3357 DCA INC /SAVING IT HERE FOR LATER!
-03551 1623 TAD I SGNDP /NOW GET HIGH BITS OF "CHAR"
-03552 0103 AND N7400 / MASK TO 4 BITS AND
-03553 6201 CDF 0
-03554 7112 CLL RTR / MOVE TO BITS 4-7
-03555 7012 RTR
-03556 5335 JMP OSRETN /GET OTHER BITS & RETURN!
-
-
- /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"
-
-03557 0000 INC, 0
-03560 2061 ISZ LOCL /INCREMENT LOW 12 ADDR BITS
-03561 5757 JMP I INC /OK AS IS
-03562 7100 CLL
-03563 1060 TAD LOCH /LOW OVERFLOW, INCR. HIGH
-03564 1376 TAD (7771 / 3 ADDRESS BITS (& TEST)
-03565 0113 AND N7
-03566 3060 DCA LOCH
-03567 7430 SZL /DID HIGH OVERFLOW ALSO?
-03570 1120 TAD N200 / YES, THEN BUMP BLK ALSO
-03571 1057 TAD BLK
-03572 3057 DCA BLK
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 19-3
-
-03573 5757 JMP I INC
-
-
-03576 7771
-03577 2163
- 3600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 20
-
- /OUTPUT PACKED STRING, ADDRESS IN CALL+1,
- / TERMINATOR IS XX00.
-03600 0000 TYPES, 0
-03601 1600 TAD I TYPES
-03602 2200 ISZ TYPES
-03603 4205 JMS TYPSTR
-03604 5600 JMP I TYPES
-
- /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
-03605 0000 TYPSTR, 0
-03606 3341 DCA GETNT
-03607 6211 TTAGN, CDF 10
-03610 1741 TAD I GETNT
-03611 6201 CDF 0
-03612 2341 ISZ GETNT
-03613 4221 JMS PACOUT
-03614 1276 TAD GNAME
-03615 0116 AND N77
-03616 7650 SNA CLA
-03617 5605 JMP I TYPSTR
-03620 5207 JMP TTAGN
-
- /PACKED ASCII OUTPUT ROUTINE
-03621 0000 PACOUT, 0
-03622 3276 DCA GNAME
-03623 1276 TAD GNAME /USE LEFT 6 BITS
-03624 4544 JMS I RTR6I
-03625 4231 JMS ONECHR
-03626 1276 TAD GNAME /USE RIGHT 6 BITS
-03627 4231 JMS ONECHR
-03630 5621 JMP I PACOUT
-
- /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
-03631 0000 ONECHR, 0 /NO CODE FOR CR/LF
-03632 0116 AND N77
-03633 7450 SNA
-03634 5631 JMP I ONECHR /IGNORE "@"
-03635 1377 TAD (-40
-03636 7500 SMA
-03637 1107 TAD M100
-03640 4526 JMS I TYPECI
-03641 0340 340
-03642 5631 JMP I ONECHR
-
-
- /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
- /THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN
- /FIELD 1.
-
-03643 0000 SORTJ, 0
-03644 7450 SNA
-03645 1035 TAD CHAR /USE CHAR IF AC = 0
-03646 3275 DCA SORTEM /ITEM TO LOOK UP
-03647 1643 TAD I SORTJ
-03650 2243 ISZ SORTJ /GET LIST1 ADDRESS
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 20-1
-
-03651 3012 DCA SCANX1
-03652 6211 SORT1, CDF 10
-03653 1412 TAD I SCANX1 /COMPARE WITH SORTEM
-03654 6201 CDF 0
-03655 7450 SNA /0 ?
-03656 5273 JMP SORT2 /END OF LIST
-03657 7161 CIA STL
-03660 1275 TAD SORTEM
-03661 7640 SZA CLA /DOES IT MATCH?
-03662 5252 JMP SORT1 /NO, TRY NEXT
-03663 1012 TAD SCANX1 /YES, GET ADDRESS...
-03664 1643 TAD I SORTJ
-03665 3243 DCA SORTJ /...OF JUMP ADDRESS
-03666 6211 CDF 10
-03667 1643 TAD I SORTJ
-03670 3243 DCA SORTJ
-03671 6201 CDF 0
-03672 5643 JMP I SORTJ /GO TO ROUTINE
-03673 2243 SORT2, ISZ SORTJ /MATCH NOT FOUND,
-03674 5643 JMP I SORTJ /EXIT TO CALL+3
-03675 0000 SORTEM, 0
-
-
- /SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
-
-03676 0000 GNAME, 0 /GET A FILE OR DEVICE NAME
-03677 3022 DCA TEMP1 /SET UP "." SWITCH AND
-03700 1022 TAD TEMP1 / FILE/DEVICE SWITCH
-03701 3023 DCA TEMP2
-03702 3025 DCA NAM1
-03703 3026 DCA NAM2 /CLEAR NAME AREA
-03704 3027 DCA NAM3
-03705 1376 TAD (2326 / & INIT EXTENSION TO "SV"
-03706 3030 DCA NAM4
-03707 1375 TAD (NAM1 / & INIT POINTER FOR NAME
-03710 3021 DCA TEMP
-03711 4564 JMS I SSKIPI /SKIP LEADING SPACES
-03712 7240 STA
-03713 1016 TAD COMOUT /BACK UP THE POINTER
-03714 3016 DCA COMOUT
-03715 4351 JMS GPAIR /1ST & 2ND CHAR
-03716 4351 JMS GPAIR /3RD & 4TH
-03717 4351 GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT.
-03720 4341 JMS GETNT /SCAN FOR TERMINATOR
-03721 7200 CLA
-03722 5320 JMP .-2
- /
-03723 1023 GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME?
-03724 7640 SZA CLA
-03725 5346 JMP GETNTC / FILE, JUST USE THE ":"
-03726 2023 ISZ TEMP2 / DEVICE, FLAG ":" SEEN
-03727 5320 JMP GETSCN+1 / AND SCAN TO TERMIN.
- /
-03730 2022 GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE?
-03731 4573 ERCM, ERROR /NO, THE END...
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 20-2
-
-03732 3030 DCA NAM4 /YES, RESET EXT,
-03733 1374 TAD (NAM4 / SET POINTER
-03734 3021 DCA TEMP
-03735 5317 JMP GETSCN / & GO GET IT
- /
-03736 7240 GETEND, STA /TERM = SPACE, SET SWITCH
-03737 3046 DCA CRSWT /TERM = CR, RESET SWITCH
-03740 5676 JMP I GNAME /..DONE....
-
-03741 0000 GETNT, 0 /GET & TEST A CHAR
-03742 4563 JMS I GETNI /GET NEXT CHAR
-03743 4567 JMS I SORTI /TEST IT
-03744 5444 GETLST-1
-03745 0005 GETOPS-GETLST
-03746 1035 GETNTC, TAD CHAR /OK, USE CHAR
-03747 0116 AND N77 /MASK TO 6 BITS
-03750 5741 JMP I GETNT / & EXIT WITH IT
-
-03751 0000 GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS
-03752 4341 JMS GETNT
-03753 4543 JMS I RTL6I /TO LEFT HALF
-03754 3421 DCA I TEMP / & STORE IT
-03755 4341 JMS GETNT
-03756 1421 TAD I TEMP /MERGE WITH LAST LEFT
-03757 3421 DCA I TEMP
-03760 2021 ISZ TEMP /BUMP POINTER
-03761 5751 JMP I GPAIR
-
-03762 0000 RTL6, 0 /ROTATE AC 6 LEFT
-03763 7106 CLL RTL
-03764 7006 RTL
-03765 7006 RTL
-03766 5762 JMP I RTL6
-
-03767 0000 RTR6, 0 /ROTATE AC 6 RIGHT
-03770 7112 CLL RTR
-03771 7012 RTR
-03772 7012 RTR
-03773 5767 JMP I RTR6
-
-
-03774 0030
-03775 0025
-03776 2326
-03777 7740
- 4000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 21
-
- /SUBROUTINE TO READ A "LINE" FROM THE USER. IT CHECKS FOR
- / RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
- / TERMINATORS PASSED BY THE CALLER. AS WITH OS/8, RUBOUT
- / DELETES CHARACTES AND ^U DELETES THE CURRENT LINE. ^R
- / (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
- / MANNER AS LINE-FEED DOES FOR OS/8. IF THE CHARACTER IS A
- / TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
- / CALLER ROUTINE (OUT OF THIS ROUTINE). INPUT CHARACTERS
- / ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE. EXIT
- / IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
- / RUBOUT OR ^U.
-
-04000 0000 READ, 0 /READ AND ECHO INPUT CHARACTER
-04001 1600 TAD I READ /GET TWO LIST ADDRESS PARAMETERS
-04002 2200 ISZ READ
-04003 3220 DCA RETERM / FROM CALLER AND SET UP IN
-04004 1600 TAD I READ / SORT ROUTINE CALL
-04005 2200 ISZ READ
-04006 3221 DCA RETERM+1
-04007 4312 RENEXT, JMS RKEY /GET A CHAR
-04010 5231 JMP RUBO /RUBOUT, GO BEGIN DELETIONS
-04011 3035 REKEY, DCA CHAR
-04012 4567 JMS I SORTI /CHECK FOR CTRL-R & CTRL-U
-04013 5523 REACTL-1
-04014 0003 REACTS-REACTL
-04015 1035 TAD CHAR
-04016 4536 JMS I TYPEI
-04017 4567 JMS I SORTI /CHECK FOR CALLER TERMINATORS
-04020 0000 RETERM, 0 / PARAMETERS HERE
-04021 0000 0
-04022 1035 TAD CHAR /NONE, JUST STORE IN BUFFER
-04023 7410 SKP
-04024 1377 RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE!
-04025 6211 CDF 10
-04026 3415 DCA I COMIR /COMMAND (LINE) INPUT BUFFER
-04027 6201 CDF 0
-04030 5207 JMP RENEXT
- /
- /+++ FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
- /+++ SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
- /+++ PREVIOUS CHARACTER FROM THE SCREEN. IF "SCOPE
- /+++ MODE" IS SET, RUBO IS OVERLAID ON STARTUP.
-
- /*** FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
- /*** AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
- /*** FEED THAT FOLLOWS A CARRIAGE-RETURN.
- /
-04031 4303 RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY
-04032 5261 JMP RUBOF / INPUT BUFFER EMPTY!
-04033 4526 JMS I TYPECI /OK, OUTPUT 1ST "\"
-04034 0334 "\
-04035 4303 RUBO1, JMS BTEST /NOW EMPTY?
-04036 5257 JMP RUBOE / YES, LINE END
-04037 1015 TAD COMIR /ECHO LAST CHAR IN BUFFER
-04040 3341 DCA ENDC
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 21-1
-
-04041 6211 CDF 10
-04042 1741 TAD I ENDC
-04043 6201 CDF 0
-04044 4536 JMS I TYPEI
-04045 7240 STA
-04046 1015 TAD COMIR /NOW BACK UP POINTER
-04047 3015 DCA COMIR
-04050 4312 JMS RKEY /GET A CHAR
-04051 5235 JMP RUBO1 /ANOTHER RUBOUT, GO HANDLE
-04052 3303 DCA BTEST /SAVE THE CHAR
-04053 4526 JMS I TYPECI / DO CLOSING "\"
-04054 0334 "\
-04055 1303 TAD BTEST
-04056 5211 JMP REKEY /& GO USE NEW CHAR
- /
-04057 4526 RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED,
-04060 0334 "\ /OUTPUT CLOSING "\"
-04061 4530 RUBOF, JMS I CRLFI / & A CR/LF
-04062 5600 JMP I READ
- /
-04063 4526 RECHO, JMS I TYPECI /ECHO "^R" & THEN
-04064 0222 "R-100
-04065 4530 JMS I CRLFI /ECHO CURRENT LINE
-04066 1174 TAD COMST /INIT AUTO-XR
-04067 3016 DCA COMOUT
-04070 1016 RECHO1, TAD COMOUT /DONE?
-04071 7041 CIA
-04072 1015 TAD COMIR
-04073 7650 SNA CLA
-04074 5207 JMP RENEXT /YES, MORE INPUT
-04075 4563 JMS I GETNI /NO, GET NEXT CHAR
-04076 4536 JMS I TYPEI / & OUTPUT IT
-04077 5270 JMP RECHO1 / & CONTINUE
- /
-04100 4526 RERASE, JMS I TYPECI /OUTPUT "^U"
-04101 0225 "U-100
-04102 5261 JMP RUBOF /GO OUTPUT CR/LF & EXIT
-
-04103 0000 BTEST, 0 /TEST FOR COMM. BUFFER EMPTY
-04104 1015 TAD COMIR
-04105 7041 CIA
-04106 1174 TAD COMST
-04107 7640 SZA CLA /EMPTY?
-04110 2303 ISZ BTEST /NO, STILL OK, TO CALL+2
-04111 5703 JMP I BTEST / OTHERWISE TO CALL+1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 22
-
-04112 0000 RKEY, 0 /GET A NON-NULL CHAR, TEST & TRANSLATE
-04113 6031 KSF /*** JMS I CTRLI /CHECK KEYBOARD
-04114 5313 JMP .-1 /*** CIF BAT /BATCH OPER.
-04115 4534 JMS I CTRLI /*** JMS I BATINI
-04116 6031 KSF /*** ERROR /EOF!!
-04117 5313 JMP RKEY+1 /*** NOP /MUST USE SPECIAL CARE
-04120 6036 KRB /*** NOP / TO HANDLE CTRL-Q!
-04121 0117 AND N177 /MASK OFF PARITY
-04122 7450 SNA
-04123 5313 JMP RKEY+1 /NULL CHAR
-04124 1376 TAD (-177 /IS IT A RUBOUT?
-04125 7450 SNA
-04126 5712 RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH
-04127 2312 ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER.
-04130 1375 TAD (2 /TEST FOR ALT-MODES
-04131 7500 SMA
-04132 5337 JMP RKEY1 / 375 OR 376
-04133 1374 TAD (35 /IS IT LOWER CASE?
-04134 7500 SMA
-04135 1373 TAD (-40 /YES, MAKE UPPER CASE
-04136 1372 TAD (-35
-04137 1371 RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY
-04140 5712 JMP I RKEY / & EXIT WITH IT
-
-
- /SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
- /RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
- /SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
-04141 0000 ENDC, 0
-04142 1370 TAD (215 /PUT A CR IN BUFFER
-04143 6211 CDF 10
-04144 3415 DCA I COMIR
-04145 6201 CDF 0
-04146 1174 TAD COMST /INIT'L BUFFER UNLOAD
-04147 3016 DCA COMOUT
-04150 1035 TAD CHAR /SAVE CHAR FOR POSSIBLE
-04151 3021 DCA TEMP / USE BY 'WCHEK'
-04152 4563 JMS I GETNI /GET FIRST CHARACTER
-04153 4564 JMS I SSKIPI /SKIP LEADING SPACES
-04154 1035 TAD CHAR /GET 1ST NON-SPACE
-04155 1105 TAD M215 /IS IT A CR?
-04156 7640 SZA CLA /YES, NOTHING IN BUFFER
-04157 2341 ISZ ENDC /OTHERWISE RETURN TO CALL+2
-04160 5741 JMP I ENDC
-
-
-04161 0000 DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT
-04162 4526 JMS I TYPECI
-04163 0260 "0
-04164 5761 JMP I DODIG
-
-
-04170 0215
-04171 0375
-04172 7743
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 22-1
-
-04173 7740
-04174 0035
-04175 0002
-04176 7601
-04177 0240
- 4200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 23
-
- /'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
-04200 0000 ODTOUT, 0
-04201 1017 TAD TYPSW /-1, 0, +1
-04202 1377 TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED
-04203 3204 DCA ODTOPT / OUTPUT ROUTINE
-04204 7402 ODTOPT, HLT /[USED TWICE!]
-04205 3204 DCA ODTOPT
-04206 4562 JMS I ODGETI /GET SPECIFIED WORD
-04207 4604 JMS I ODTOPT / & OUTPUT IT
-04210 5600 JMP I ODTOUT
-
-04211 4400 FPPDMP /-1 = OCTAL + FPP
-04212 3400 ODTOL, OPRT / 0 = OCTAL
-04213 4214 PDPDMP /+1 = OCTAL + PDP
-
-
- /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
-04214 0000 PDPDMP, 0
-04215 4540 JMS I OCTI /FIRST OUTPUT IN OCTAL
-04216 4533 SPACE2 /FOLLOWED BY 2 SPACES,
-04217 4221 JMS PDPOUT / & THEN AS 'PDP'
-04220 5614 JMP I PDPDMP
-
-
- /'PDP' (SYMBOLIC) INSTRUCTION DECODING
-04221 0000 PDPOUT, 0
-04222 7200 CLA
-04223 4776' JMS OPRTST /TEST FOR OPR & IOT
-04224 5262 JMP OPRS / OPR
-04225 4775' JMS IOPRNT / IOT
-04226 4774' SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11
-04227 7004 RAL / * 2
-04230 4773' JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE
-04231 2600 INSLST /(TABLE FOR INDEXING)
-04232 7776 -2 /(- # WORDS)
-04233 4776' JMS OPRTST /TEST FOR OPR & IOT
-04234 5256 JMP SYMEND / OPR, DONE
-04235 5257 JMP IOTS / IOT
-04236 4554 TADICAD /MEMORY REF., INDIRECT?
-04237 0372 AND (400
-04240 7650 SNA CLA
-04241 5244 JMP REFS1 /NO
-04242 4527 JMS I TWOCI /YES, OUTPUT "I "
-04243 1140 1140
-04244 4554 REFS1, TADICAD /SET UP ADDR BITS
-04245 0117 AND N177
-04246 3771' DCA BITVAL /SAVE THEM
-04247 4554 TADICAD /IS THIS A 'PAGE 0 REF'?
-04250 0120 AND N200
-04251 7640 SZA CLA
-04252 1061 TAD LOCL /NO, USE PAGE BITS
-04253 0106 AND M200
-04254 1771' TAD BITVAL /OK, NOW ADD ADDR BITS
-04255 4540 REFS2, JMS I OCTI /OUTPUT IN OCTAL
-04256 5621 SYMEND, JMP I PDPOUT /DONE, RETURN
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 23-1
-
-
- /
-04257 4554 IOTS, TADICAD /USE ONLY LAST 9 BITS
-04260 0370 AND (777
-04261 5255 JMP REFS2 /AND OUTPUT IN OCTAL
- /
-04262 4554 OPRS, TADICAD /IS THIS A NOP?
-04263 0370 AND (777
-04264 7450 SNA
-04265 5226 JMP SYMS /YES, OUTPUT "NOP "
-04266 0120 AND N200 /IS THERE A CLA IN IT?
-04267 7650 SNA CLA
-04270 5275 JMP OPRS1 /NO, CONTINUE
-04271 4773' JMS SYMTYP /YES, OUTPUT "CLA "
-04272 2726 CLANAM
-04273 7776 -2
-04274 7001 IAC
-04275 3036 OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH
-04276 4554 TADICAD /SET UP WORD FOR DECODE
-04277 4543 JMS I RTL6I
-04300 7010 RAR
-04301 3771' DCA BITVAL /SAVE IT
-04302 4554 TADICAD /CHECK FOR OPR1, OPR2 OR EAE
-04303 7110 CLL RAR
-04304 0120 AND N200
-04305 7450 SNA
-04306 5333 JMP OPR1A /OPR1 MICRO-INSTRUCTION
-04307 7620 SNL CLA
-04310 5767' JMP OPR2A /OPR2 MICRO-INSTRUCTION
- /
- /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
-04311 1366 EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER
-04312 3765' DCA BITPNT
-04313 4764' JMS BITS /SHIFT & CHECK BIT 5
-04314 4763' JMS OPRTYP /IF = 1, "MQA "
-04315 1771' TAD BITVAL /CHECK BIT 6
-04316 7104 CLL RAL /("SCA" IN "A" MODE OF 8/E
-04317 3771' DCA BITVAL / 'MODE BIT' IN "B" MODE)
-04320 7430 SZL
-04321 1115 TAD N20 /IF ON, USE OTHER WORDS
-04322 3332 DCA EAETMP
-04323 4764' JMS BITS /CHECK BIT 7
-04324 4763' JMS OPRTYP / "MQL "
-04325 4554 TADICAD
-04326 0362 AND (16
-04327 1332 TAD EAETMP /(ADD SWITCH WORD)
-04330 4761' JMS SYMLIM /CHECK FOR & OUTPUT LAST INST.
-04331 7742 -36 /UPPER LIMIT
-04332 0000 EAETMP, 0
- /
- /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
-04333 1360 OPR1A, TAD (OP1LST-2 /SET OPR1 LIST
-04334 3765' DCA BITPNT
-04335 4764' JMS BITS /SHIFT & CHECK BIT 5
-04336 4763' JMS OPRTYP /IF = 1, OUTPUT "CLL "
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 23-2
-
-04337 4764' JMS BITS /CHECK BIT 6
-04340 4763' JMS OPRTYP / "CMA "
-04341 4764' JMS BITS /CHECK BIT 7
-04342 4763' JMS OPRTYP / "CML "
-04343 2765' ISZ BITPNT /BUMP POINTER
-04344 2765' ISZ BITPNT
-04345 4554 TADICAD /LOOK FOR IAC
-04346 7010 RAR
-04347 7630 SZL CLA
-04350 4763' JMS OPRTYP /OUTPUT "IAC "
-04351 4554 TADICAD /SET UP TO CHECK FOR ROTATES
-04352 0362 AND (16
-04353 4761' JMS SYMLIM /CHECK & OUTPUT
-04354 7766 -12 /UPPER LIMIT
-
-
-04360 2616
-04361 4433
-04362 0016
-04363 4467
-04364 4456
-04365 4471
-04366 2662
-04367 4405
-04370 0777
-04371 4522
-04372 0400
-04373 4475
-04374 6243
-04375 4523
-04376 4547
-04377 1212
- 4400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 24
-
- /OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
-04400 0000 FPPDMP, 0
-04401 4540 JMS I OCTI /FIRST OUTPUT IN OCTAL
-04402 4533 SPACE2 / THEN 2 SPACES
-04403 4777' JMS FPPOUT / & THEN AS FPP
-04404 5600 JMP I FPPDMP
-
- /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'
-
- /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
-04405 1376 OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER
-04406 3271 DCA BITPNT
-04407 4256 JMS BITS /SHIFT & CHECK BIT 5
-04410 4315 JMS OPR2T /IF 1, OUTPUT "SMA " OR "SPA "
-04411 4256 JMS BITS /CHECK BIT 6
-04412 4315 JMS OPR2T / "SZA " OR "SNA "
-04413 4256 JMS BITS /CHECK BIT 7
-04414 4315 JMS OPR2T / "SNL " OR "SZL "
-04415 4256 JMS BITS /CHECK BIT 8
-04416 7410 SKP
-04417 5224 JMP OPR2B /IT WAS 0
-04420 4554 TADICAD /MUST CHECK FOR "SKP "
-04421 0375 AND (160
-04422 7650 SNA CLA /ARE ALL SKIP SENSES = 0?
-04423 4267 JMS OPRTYP /YES, SO OUTPUT "SKP "
-04424 1374 OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT
-04425 3271 DCA BITPNT
-04426 4256 JMS BITS /CHECK BIT 9
-04427 4267 JMS OPRTYP / "OSR "
-04430 4256 JMS BITS /CHECK BIT 10
-04431 4267 JMS OPRTYP / "HLT "
-04432 5246 JMP OPEND /CHECK FOR ANY DONE
-
-04433 0000 SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT
-04434 3035 DCA CHAR /SAVE AC
-04435 1035 TAD CHAR
-04436 7550 SPA SNA /IS IT > 0?
-04437 5246 JMP OPEND /NO, TEST IF ANY OUTPUT DONE
-04440 1633 TAD I SYMLIM /IT IS > UPPER LIMIT?
-04441 7740 SMA SZA CLA
-04442 5246 JMP OPEND /NO, GO CHECK AGAIN
-04443 1035 TAD CHAR /CALCULATE ADDRESS
-04444 4267 JMS OPRTYP / & OUTPUT LAST
-04445 5773' JMP SYMEND /...DONE
- /
-04446 7200 OPEND, CLA
-04447 1036 TAD CNT /ANYTHING OUTPUT?
-04450 7640 SZA CLA
-04451 5773' JMP SYMEND /YES, DONE WITH OUTPUT
-04452 4275 JMS SYMTYP /NO, OUTPUT "OPR "
-04453 2730 OPRMES
-04454 7776 -2
-04455 5772' JMP IOTS /NOW GO OUTPUT LAST 9 BITS
-
-04456 0000 BITS, 0 /DECODE A WORD ONE BIT AT A TIME
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 24-1
-
-04457 1322 TAD BITVAL /SHIFT A BIT INTO LINK
-04460 7104 CLL RAL
-04461 3322 DCA BITVAL /SAVE FOR LATER
-04462 2271 ISZ BITPNT /BUMP SYMBOL POINTER
-04463 2271 ISZ BITPNT
-04464 7420 SNL
-04465 2256 ISZ BITS /TO CALL+2 IF L = 0
-04466 5656 JMP I BITS
-
-04467 0000 OPRTYP, 0 /OUTPUT AN OPR SYMBOL
-04470 4275 JMS SYMTYP /OUTPUT THE SYMBOL
-04471 0000 BITPNT, 0 /ADDRESS
-04472 7776 -2
-04473 2036 ISZ CNT /SET SWITCH
-04474 5667 JMP I OPRTYP
-
-04475 0000 SYMTYP, 0 /OUTPUT A SYMBOL
-04476 1675 TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX
-04477 2275 ISZ SYMTYP
-04500 3314 DCA SYMPNT /SAVE POINTER
-04501 1675 TAD I SYMTYP /GET COUNT OF WORDS
-04502 2275 ISZ SYMTYP
-04503 3256 DCA BITS / & SAVE IT
-04504 6211 SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1
-04505 1714 TAD I SYMPNT
-04506 6201 CDF 0
-04507 4535 JMS I TWOT /OUTPUT A PAIR OF LETTERS
-04510 2314 ISZ SYMPNT
-04511 2256 ISZ BITS /DONE?
-04512 5304 JMP SYMNXT
-04513 5675 JMP I SYMTYP
-04514 0000 SYMPNT, 0
-
-04515 0000 OPR2T, 0 /OUTPUT AN OPR2 SYMBOL
-04516 4554 TADICAD
-04517 0371 AND (10 /IF BIT IS ON, REVERSE THE
-04520 4267 JMS OPRTYP /SENSE OF THE SKIP
-04521 5715 JMP I OPR2T
-
-04522 0000 BITVAL, 0
-
-
-04523 0000 IOPRNT, 0 /OUTPUT I/O NAMES
-04524 1370 TAD (IOTTAB /SET UP POINTER
-04525 3344 IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER
-04526 6211 CDF 10
-04527 1744 TAD I IOPNT /GET NEXT IOT
-04530 6201 CDF 0
-04531 7450 SNA /AT END OF TABLE?
-04532 5723 JMP I IOPRNT /YES, CODE NOT FOUND
-04533 7041 CIA
-04534 4554 TADICAD /NO, DO THEY MATCH?
-04535 7650 SNA CLA
-04536 5342 JMP IOPRN2 /YES, OUTPUT NAME
-04537 1367 TAD (4 /NO, UPDATE POINTER
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 24-2
-
-04540 1344 TAD IOPNT
-04541 5325 JMP IOPRN1 / & TRY AGAIN
- /
-04542 7001 IOPRN2, IAC /WORD FOLLOWS CODE
-04543 4275 JMS SYMTYP /OUTPUT THE MNEMONIC
-04544 0000 IOPNT, 0
-04545 7775 -3
-04546 5773' JMP SYMEND / & RETURN
-
-
-04547 0000 OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT
-04550 4554 TADICAD /GET WORD
-04551 0122 AND N7000 /MASK OFF OP CODE
-04552 1366 TAD (1000 /IS IT AN OPR?
-04553 7450 SNA
-04554 5747 JMP I OPRTST /YES, EXIT TO CALL+1
-04555 2347 ISZ OPRTST
-04556 1366 TAD (1000 /IS IT AN IOT?
-04557 7640 SZA CLA
-04560 2347 ISZ OPRTST /NO, EXIT TO CALL+3
-04561 5747 JMP I OPRTST / YES, TO CALL+2
-
-
-04566 1000
-04567 0004
-04570 2732
-04571 0010
-04572 4257
-04573 4256
-04574 2656
-04575 0160
-04576 2640
-04577 4600
- 4600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 25
-
- /'FPP' (SYMBOLIC) INSTRUCTION DECODING
-04600 0000 FPPOUT, 0
-04601 7200 CLA /HARD TO TELL WHAT MIGHT COME!
-04602 4554 TADICAD /GET THE WORD
-04603 0377 AND (600 /MASK OFF MODE BITS
-04604 7450 SNA
-04605 5254 JMP SPECIAL / NON-ARITHMETIC
-04606 1103 TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR.
-04607 3023 DCA TEMP2
-04610 4776' JMS GETOP /GET OP-CODE TO BITS 9-11
-04611 4775' FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT)
-04612 4774' JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL
-04613 3757 FPPINS /(INCLUDING "LEA")
-04614 7775 -3
-04615 1023 TAD TEMP2 /NOW HANDLE MODE
-04616 7450 SNA
-04617 5240 JMP LONG / LONG INDEXED
-04620 7700 SMA CLA
-04621 5231 JMP INDIR / INDIRECT INDEXED
-04622 4525 BASE, JMS I TYPSI / BASE - OUTPUT " B+"
-04623 3743 MSBASE
-04624 4554 TADICAD /GET WORD AGAIN
-04625 0117 AND N177 / MASK OFF OFFSET
-04626 4775' JMS MULT3 / MULTIPLY IT BY 3
-04627 4773' JMS OCT3 / & OUTPUT IN OCTAL
-04630 5600 JMP I FPPOUT
- /
-04631 4525 INDIR, JMS I TYPSI /OUTPUT "% B+"
-04632 3746 MSINDI
-04633 4554 TADICAD /GET WORD AGAIN
-04634 0113 AND N7 / MASK OFF OFFSET
-04635 4775' JMS MULT3 / MULTIPLY IT BY 3
-04636 4773' JMS OCT3 / & OUTPUT IT IN OCTAL
-04637 5243 JMP XRPLUS /FINALLY DO XR OUTPUT
- /
-04640 4527 LONG, JMS I TWOCI /OUTPUT "# "
-04641 4340 4340
-04642 4772' JMS FLDOUT /AND FIELD AND "*"
-04643 4771' XRPLUS, JMS GET678 /GET XR FIELD
-04644 4527 JMS I TWOCI / & OUTPUT ",X" WHERE
-04645 5460 5460 / "X" IS A DIGIT
-04646 4554 TADICAD /GET WORD THE LAST TIME
-04647 0370 AND (100 / AND CHECK "+" BIT
-04650 7640 SZA CLA
-04651 4526 JMS I TYPECI /OUTPUT "+" OR SKIP
-04652 0253 "+ /[A NOP]
-04653 5600 JMP I FPPOUT
- /
-04654 4776' SPECIAL,JMS GETOP /GET OP-CODE
-04655 4567 JMS I SORTI / & BRANCH ON IT
-04656 4121 FPPMO0-1
-04657 0010 FPPMOJ-FPPMO0
-04660 4554 SPCOP0, TADICAD /FALLS THRU ON 0, GET
-04661 0367 AND (170 / SUB-OP-CODE
-04662 4567 JMS I SORTI / & BRANCH ON IT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 25-1
-
-04663 4140 FPPOP0-1
-04664 0020 FPPOPJ-FPPOP0
-04665 4554 SPOP00, TADICAD /FALLS THRU ON 0, USE AS
-04666 0113 AND N7 / INDEX INTO LAST LIST
-04667 7001 IAC
-04670 4775' SPOP04, JMS MULT3 /THREE WORDS/SYMBOL
-04671 4774' JMS SYMTYP /OUTPUT ONE OF SEVERAL
-04672 4015 FPOP00 / SYMBOLS IN THIS LIST
-04673 7775 -3
-04674 5600 JMP I FPPOUT
- /
-04675 7340 SPOP05, CLL STA /= -1
-04676 5270 JMP SPOP04 /OUTPUT "STARTE"
- /
-04677 7344 SPNUSE, CLL STA RAL /= -2
-04700 5270 JMP SPOP04 /OUTPUT "UNUSED"
- /
-04701 4771' SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X"
-04702 7104 CLL RAL /(2 WORDS PER)
-04703 4774' JMS SYMTYP /OUTPUT SYMBOL
-04704 4046 FPXR1S-2
-04705 7776 -2
-04706 5313 JMP XROUT / & XR VALUE
- /
-04707 1366 SPOP10, TAD (4 /"LDX *,X"
-04710 4774' SPOP11, JMS SYMTYP /"ADDX *,X"
-04711 4057 FPXR2S
-04712 7774 -4
-04713 4554 XROUT, TADICAD /GET XR FIELD
-04714 0113 AND N7
-04715 4531 DIGIT / & OUTPUT AS DIGIT
-04716 5600 JMP I FPPOUT
- /
-04717 4554 SPCOP1, TADICAD /GROUP 0 OR 1?
-04720 0370 AND (100
-04721 7650 SNA CLA
-04722 5337 JMP SPOP1J / 1 = CONDITIONAL JUMPS
-04723 4771' JMS GET678 / 0 = SETS, ETC.
-04724 1365 TAD (-4 /SUB-OP-CODES 0 THRU 3?
-04725 7700 SMA CLA
-04726 5277 JMP SPNUSE / NO, 4 THRU 7 = UN-USED
-04727 4771' JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR
-04730 7001 IAC / +1+1 => 2 THRU 5
-04731 7001 SPCOP3, IAC / 1: TRAP3
-04732 4775' SPCOP4, JMS MULT3 / 0: TRAP4
-04733 4774' JMS SYMTYP /GO DO ONE OF THESE
-04734 4067 FOP134
-04735 7775 -3
-04736 5342 JMP DOFLD /FINISH WITH FIELD
- /
-04737 4764' SPOP1J, JMS CONDIT /CONDITIONAL JUMPS
-04740 1200 1200 / "J--"
-04741 4533 SPACE2
-04742 4772' DOFLD, JMS FLDOUT /OUTPUT FIELD & "*"
-04743 5600 JMP I FPPOUT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 25-2
-
- /
-04744 4525 SPCOP2, JMS I TYPSI /OUTPUT "JNX "
-04745 3751 MSJNX
-04746 5242 JMP XRPLUS-1 / & HANDLE ADDRESS
- /
- / SPCOP3 & SPCOP4
- /
-04747 4554 SPCOP5, TADICAD /GET WORD AGAIN
-04750 0370 AND (100
-04751 7640 SZA CLA
-04752 5277 JMP SPNUSE /BIT 5 ON IS UNUSED OP
-04753 4764' JMS CONDIT /LOAD TRUTH
-04754 1424 1424 / "LT--"
-04755 5600 JMP I FPPOUT
- /
-04756 7001 SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH
-04757 3023 SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH
-04760 7340 CLL STA
-04761 5211 JMP FPLEA / & GO DO OUTPUT
-
-
-04764 6265
-04765 7774
-04766 0004
-04767 0170
-04770 0100
-04771 6251
-04772 6277
-04773 3407
-04774 4475
-04775 6257
-04776 6243
-04777 0600
- 5000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 26
-
-05000 0000 PDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
-05001 3244 DCA CRLF /SAVE IT
-05002 1244 TAD CRLF /GET WORD & MASK
-05003 0121 AND N377
-05004 7112 CLL RTR /DAY (4-8) TO 7-11
-05005 7010 RAR
-05006 4541 JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED)
-05007 4526 JMS I TYPECI / AND A SEPARATOR
-05010 0255 "-
-05011 1244 TAD CRLF /GET WORD A SECOND TIME
-05012 4544 JMS I RTR6I /MONTH (0-3) TO 7-10
-05013 7010 RAR / FOR MONTH*2
-05014 0377 AND (36 / MASK IT AND USE AS AN INDEX
-05015 4525 JMS I TYPSI / TO OUTPUT MONTH IN ALPHA
-05016 2521 MONTHS / FORM (WITH SAFETY...)
-05017 4526 JMS I TYPECI /FOLLOWED BY "-"
-05020 0255 "-
-05021 1244 TAD CRLF /GET LAST TIME
-05022 0113 AND N7 / MASK OFF YEAR
-05023 1231 TAD YRTEST / TEST IF .GT. THIS YEAR
-05024 7540 SMA SZA
-05025 1376 TAD (-10 / YES, SUBTRACT 8
-05026 1232 TAD YRBASE / ADD TO BASE YEAR
-05027 4541 JMS I DEC2I / & OUTPUT IT
-05030 5600 JMP I PDATE
-05031 0000 YRTEST, 0 /-(THIS YEAR) FOR TESTING
-05032 0000 YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR
-
-
-05033 0000 TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC
-05034 1633 TAD I TYPEA /GET ARG, IF ANY
-05035 2233 ISZ TYPEA
-05036 3543 DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1
-05037 4534 JMS I CTRLI
-05040 6212 CIF 10
-05041 5775' JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT
- /
-05042 2041 TYPEX, ISZ NCNT /BUMP LINE POSITION
-05043 5633 JMP I TYPEA / & EXIT
-
-05044 0000 CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED
-05045 7200 CLA
-05046 4233 JMS TYPEA
-05047 0215 215
-05050 4233 JMS TYPEA
-05051 0212 212
-05052 3041 DCA NCNT /RESET LINE POSITION
-05053 5644 JMP I CRLF
-
-
-05054 0000 TYPEC, 0 /OUTPUT A SINGLE CHAR ARG
-05055 1654 TAD I TYPEC /GET IT
-05056 2254 ISZ TYPEC
-05057 4261 JMS TYPE /OUTPUT IT
-05060 5654 JMP I TYPEC
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 26-1
-
-
-
-05061 0000 TYPE, 0 /CHARACTER OUTPUT ROUTINE
-05062 0121 AND N377 /BE SURE ONLY 8 BITS
-05063 7450 SNA
-05064 1035 TAD CHAR /USE CHAR IF AC = 0
-05065 3277 DCA TCHAR /CHAR TO OUTPUT
-05066 1277 TAD TCHAR
-05067 4567 JMS I SORTI /CHECK FOR SPECIALS
-05070 4516 TYPEL-1
-05071 0056 TYPEOP-TYPEL
-05072 1277 TAD TCHAR /IS TCHAR < 240?
-05073 1104 TAD M240
-05074 7710 SPA CLA
-05075 5320 JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR
-05076 4233 TYPC, JMS TYPEA /NOW OUTPUT CHAR
-05077 0000 TCHAR, 0
-05100 5661 JMP I TYPE
- /
-05101 4233 TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES
-05102 0244 "$
-05103 5661 JMP I TYPE
- /
-05104 4244 TYPCR, JMS CRLF /C.R. TO OUTPUT
-05105 5661 JMP I TYPE
- /
-05106 4233 TYPTAB, JMS TYPEA /SPACE OVER FOR TAB
-05107 0240 "
-05110 1041 TAD NCNT /TAB TO OUTPUT
-05111 1111 TAD M10
-05112 7450 SNA
-05113 5661 JMP I TYPE
-05114 7500 SMA
-05115 5311 JMP TYPTAB+3 /REDUCE BY TAB SIZE
-05116 7200 CLA
-05117 5306 JMP TYPTAB
- /
-05120 4233 TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS
-05121 0336 "^
-05122 1324 TAD C100 / "^","CHAR+100"
-05123 5276 JMP TYPC
-05124 0100 C100, 100
-
-
-05125 0000 CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
-05126 3367 DCA CTRLQS /CLEAR HANG FLAG
-05127 6031 CTRL0, KSF /HAS A KEY BEEN HIT?
-05130 5363 JMP CTRLX /NO, TEST IF HANGING
-05131 6034 KRS
-05132 0117 AND N177 /YES, MASK OFF PARITY BIT
-05133 1374 TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)?
-05134 7450 SNA
-05135 5360 BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT ==
-05136 1110 TAD M20 /IS IT A CTRL-S (STOP OUTPUT)?
-05137 7440 SZA
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 26-2
-
-05140 5343 JMP CTRL1
-05141 2367 ISZ CTRLQS / YES, SET HANG FLAG
-05142 6032 KCC / & CLEAR HARDWARE FLAG
-05143 1373 CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)?
-05144 7440 SZA
-05145 5350 JMP CTRL2
-05146 6032 KCC / YES, CLEAR THE HARDWARE
-05147 5725 JMP I CTRL / & JUST EXIT
- /
-05150 7001 CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)?
-05151 7640 SZA CLA
-05152 5363 JMP CTRLX /NO, TEST IF HANGING
-05153 6032 KCC
-05154 3052 DCA DSWIT /YES, RESET DUMP SWITCH
-05155 4526 JMS I TYPECI /OUTPUT "^P"
-05156 0220 "P-100
-05157 5571 JMP I RECRLF / THEN CR/LF & RESTART
- /
- /ROUTINE TO EXECUTE THE 'EXIT' COMMAND
- /
- XEXIT,
-05160 3052 CTRLC, DCA DSWIT /RESET DUMP SWITCH
-05161 5506 JMP I M200 / & GO TO SYSTEM
-05162 0516 CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! ***
- /
-05163 1367 CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S?
-05164 7640 SZA CLA
-05165 5327 JMP CTRL0 / YES, BACK FOR ANOTHER ROUND
-05166 5725 JMP I CTRL / NO, OUT WE GO!
-
-05167 0000 CTRLQS, 0 /CTRL-S, CTRL-Q FLAG
-
-
-05173 0002
-05174 7775
-05175 2400
-05176 7770
-05177 0036
- 5200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 27
-
- /INPUT AN UNSIGNED 24 BIT NUMBER
-05200 0000 ACCEPT, 0
-05201 3025 DCA ACC1 /CLEAR LO
-05202 3026 DCA ACC2 / & HI WORDS
-05203 3777' DCA DADD / & LEGAL INPUT SWITCH
-05204 4564 JMS I SSKIPI /GET FIRST NON-SPACE
-05205 7410 SKP
-05206 4563 ACCPT1, JMS I GETNI /DON'T IGNORE SPACES
-05207 4567 JMS I SORTI /CHECK FOR ^D, ^K, (, ", ',
-05210 5350 GWLST1-1 / DIGITS, SPACE
-05211 0043 ACOPS-GWLST1
-05212 5236 JMP ACCPT3 /NONE OF THE ABOVE
- /
-05213 1035 ACCNUM, TAD CHAR
-05214 1376 TAD (-"0 /MAKE A DIGIT
-05215 3261 DCA OCTSET
-05216 1261 TAD OCTSET /IS DIGIT LEGAL?
-05217 7041 CIA
-05220 1242 TAD ACBASE
-05221 7750 SPA SNA CLA
-05222 4573 ERC09, ERROR / NO, ILLEGAL DIGIT!
-05223 1242 ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS
-05224 3031 DCA OPER1 / BY BASE
-05225 3032 DCA OPER2
-05226 4775' JMS DMUL / DO MULTIPLY
-05227 1261 TAD OCTSET /SET UP ADD OF NEXT "DIGIT"
-05230 3031 DCA OPER1
-05231 3032 DCA OPER2
-05232 4777' JMS DADD /OK, DO THE ADD (& SET SWITCH)
-05233 5206 JMP ACCPT1
- /
-05234 7240 STA / SPACE HERE
-05235 3046 DCA CRSWT /SET SWITCH: CR HERE
-05236 1777' ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED
-05237 7650 SNA CLA /CHECK FOR LEGAL INPUT
-05240 4573 ERCR, ERROR /YOU CAN'T OUT-SMART ME!
-05241 5600 JMP I ACCEPT
-05242 0010 ACBASE, 10
- /
- /
-05243 4265 DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR
-05244 3261 DCA OCTSET / SAVE VALUE
-05245 5223 JMP ACCMUL / & USE IT AS A "DIGIT"
- /
-05246 4265 SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST
-05247 0116 AND N77 /MASK TO 6 BITS
-05250 4543 JMS I RTL6I /MOVE TO LEFT HALF
-05251 3261 DCA OCTSET / & SAVE IT
-05252 4265 JMS QUOTEC /GET 2ND CHAR
-05253 0116 AND N77 /MASK
-05254 1261 TAD OCTSET /MERGE
-05255 5244 JMP DQUOTE+1 / & USE THIS AS A "DIGIT"
- /
-05256 1374 CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL
-05257 4261 CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 27-1
-
-05260 5206 JMP ACCPT1
-
-
- /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM
- / COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
-05261 0000 OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT
-05262 1373 TAD (10 /ENTER WITH AC= 2 FOR DECIMAL
-05263 3242 DCA ACBASE
-05264 5661 JMP I OCTSET
-
-05265 0000 QUOTEC, 0 /GET A QUOTED CHARACTER
-05266 4772' JMS CGTEST /GET & TEST FOR A CR
-05267 4573 ERC13, ERROR / ILLEGAL USE OF " OR '
-05270 1035 TAD CHAR /OK, RETURN WITH IT
-05271 5665 JMP I QUOTEC
-
-
- /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
- /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
-05272 0000 GARGS, 0
-05273 1175 TAD TEMPST /GET BUFFER ADDRESS
-05274 3010 DCA DPNT
-05275 3021 DCA TEMP /ZERO THE NUMBER OF ARGS
-05276 7240 GAR1, STA
-05277 3022 DCA TEMP1 /SET BLK TO -1
-05300 7240 STA
-05301 3036 DCA CNT /RESET SWITCH
-05302 4771' GAR2, JMS EXPRIN /GET NEXT ARG
-05303 4564 JMS I SSKIPI /IGNORE TRAILING SPACES
-05304 4567 JMS I SORTI /BRANCH ON TERMINATOR
-05305 5442 GARLST-1
-05306 7772 GAROPS-GARLST
-05307 4573 ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT
- /
-05310 4326 GAR3, JMS GPUT /CR FOUND, END
-05311 1175 TAD TEMPST /SET UP POINTER FOR
-05312 3010 DCA DPNT / GETTING RESULTS
-05313 5672 JMP I GARGS
- /
-05314 4563 GAR4, JMS I GETNI /SKIP OVER "."
-05315 1025 TAD ACC1 /.= TERMIN (BLOCK PART)
-05316 5277 JMP GAR1+1 /SET BLOCK & GET NEXT
- /
-05317 1025 GAR5, TAD ACC1 /-= TERMIN (LOC PART)
-05320 3023 DCA TEMP2
-05321 4563 JMS I GETNI /SKIP OVER "-"
-05322 5301 JMP GAR2-1 /GO SET SWITCH
- /
-05323 4326 GAR6, JMS GPUT /,= TERMIN
-05324 4563 JMS I GETNI /SKIP OVER ","
-05325 5276 JMP GAR1
-
-
- /SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
- /BUFFER. ALL ARGUMENTS ARE STORED IN 4 WORDS IN
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 27-2
-
- /THE BUFFER, AS SPECIFIED BY:
- / BLOCK.LOC1-LOC2 (TERMINATED BY , OR C.R.)
- /AS:
- /I-------I-------I-------I-------I-----
- /I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
- /I-------I-------I-------I-------I-----
- /WHERE:
- / WORD1= BLOCK (OR -1 IF NONE SPECIFIED)
- / WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
- / WORD3= LOC1 (LOW)
- / WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT
- / SPECIFIED) [ONLY 12 LOW BITS USED]
-05326 0000 GPUT, 0
-05327 1022 TAD TEMP1
-05330 3410 DCA I DPNT /SET BLOCK
-05331 2036 ISZ CNT /WAS A LOC2 SPECIFIED?
-05332 5335 JMP GPUT1 /YES, OK
-05333 1025 TAD ACC1
-05334 3023 DCA TEMP2 /NO, MAKE ARGS SAME
-05335 1026 GPUT1, TAD ACC2 /STORE HIGH ADDR
-05336 0113 AND N7 /MASKED TO 3 BITS
-05337 3410 DCA I DPNT
-05340 1023 TAD TEMP2 /USE 1ST ARG
-05341 3410 DCA I DPNT
-05342 1025 TAD ACC1
-05343 7040 CMA
-05344 1023 TAD TEMP2
-05345 3410 DCA I DPNT /DIFF= (TEMP2-ACC1-1)
-05346 7240 STA
-05347 1021 TAD TEMP /ANOTHER ENTRY
-05350 3021 DCA TEMP
-05351 5726 JMP I GPUT
-
-
-05352 0000 XS240O, 0 /XS240 FORMAT PACKED ASCII
-05353 4544 JMS I RTR6I /HIGH 6 BITS
-05354 0116 AND N77
-05355 4532 SPACE1 / PLUS A SPACE
-05356 4554 TADICAD /THEN LOW 6 BITS,
-05357 0116 AND N77
-05360 4532 SPACE1 / PLUS A SPACE
-05361 5752 JMP I XS240O
-
-
-05362 0000 GETN, 0 /GET NEXT CHAR FROM COMM. BUFF.
-05363 6211 CDF 10
-05364 1416 TAD I COMOUT
-05365 6201 CDF 0
-05366 3035 DCA CHAR
-05367 5762 JMP I GETN
-
-
-05371 5727
-05372 2552
-05373 0010
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 27-3
-
-05374 0002
-05375 6000
-05376 7520
-05377 5650
- 5400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 28
-
- /ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
- /OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
- /IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
- /IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
- /OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
- /
- /OPERATIONS (IN ORDER OF PRECIDENCE):
- / OR AND ADD SUB DIV MPY
- / ! & + - / *
-
- /ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
- /INTEGER. OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
- /IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.
-
-
-05400 0000 EVAL, 0
-05401 3032 DCA OPER2 /0 => D.P. TEMP (NEW NUMBER
-05402 3031 DCA OPER1 / OR LAST RESULT).
-05403 3002 DCA LASTOP /0 => LASTOP
-05404 4765 JMS I TERMTI /GET NEXT & TEST FOR TERM.
-05405 5207 JMP EVAL1 /TERM, CHECK IT
-05406 5272 JMP ENUM / IT MUST BE A NUMBER
-
-05407 4567 EVAL1, JMS I SORTI /CHECK LEGAL TERMS
-05410 5476 EVLST1-1 /"+","-" & "("
-05411 7775 EVOPS1-EVLST1
-05412 4573 ERCT, ERROR /SORRY ABOUT THAT
-
-05413 4764 EVAL2, JMS I LPARI /IS CHAR "("?
-05414 4573 ERCU, ERROR /YES,ILLEGAL (NO OP FIRST)
-05415 1040 EVMIN, TAD CNTRA /SEQN # OF TERMINATOR
-05416 3003 DCA THISOP /SET UP THISOP
-05417 1040 TAD CNTRA /IS IT ")" OR "CR"?
-05420 1111 TAD M10
-05421 7700 SMA CLA
-05422 3003 DCA THISOP /YES, 0 => THISOP
-05423 1003 EVAL3, TAD THISOP /CHECK PRIORITIES
-05424 7041 CIA
-05425 1002 TAD LASTOP /IS LASTOP < THISOP?
-05426 7710 SPA CLA
-05427 5256 JMP EVPAR /YES, CONTINUE SCAN
-05430 1003 TAD THISOP / IS THISOP+LASTOP=0?
-05431 1002 TAD LASTOP
-05432 7650 SNA CLA
-05433 5357 JMP EVALX /YES, DONE
-05434 1002 TAD LASTOP /NO, DO THIS OP NOW
-05435 1366 TAD EVTAB
-05436 3246 DCA EVOP /SET UP OPERATION
-05437 1002 TAD LASTOP /IS THIS =0?
-05440 7650 SNA CLA
-05441 5246 JMP EVOP /YES, DO OP
-05442 4551 POP /NO, POP LAST OFF LIST
-05443 3026 DCA ACC2 / INTO D.P.AC.
-05444 4551 POP
-05445 3025 DCA ACC1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 28-1
-
-05446 7402 EVOP, HLT /JMS TO OPERATION ROUTINE
-05447 1026 TAD ACC2
-05450 3032 DCA OPER2 /DUPLICATE D.P.AC. INTO
-05451 1025 TAD ACC1
-05452 3031 DCA OPER1 / D.P. TEMP
-05453 4551 POP
-05454 3002 DCA LASTOP /POP UP ANOTHER OLD OPERATOR
-05455 5223 JMP EVAL3 /AND GO DO IT
-
-05456 4764 EVPAR, JMS I LPARI /IS CHAR A "("?
-05457 5337 JMP EVLPAR /YES, GO DO A SUB-EXPRESSION
-05460 1002 TAD LASTOP /NO, PUSH DOWN OLD OP
-05461 4550 PUSH
-05462 1031 TAD OPER1 / & D.P. TEMP (LAST
-05463 4550 PUSH
-05464 1032 TAD OPER2 / RESULT OR NEW NUMBER).
-05465 4550 PUSH
-05466 1003 TAD THISOP /UPDATE LASTOP
-05467 3002 DCA LASTOP
-05470 4765 EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM.
-05471 5337 JMP EVLPAR /TERM, MUST BE A "("
-05472 4567 ENUM, JMS I SORTI /CHECK FOR "C","B", ETC...
-05473 5502 EVLST2-1
-05474 0011 EVOPS2-EVLST2
-05475 4777' JMS ACCEPT /GET A # OR BOMB OUT!
-05476 7240 STA
-05477 1016 TAD COMOUT /BACK UP POINTER
-05500 3016 DCA COMOUT
-05501 1025 ENUMX, TAD ACC1
-05502 3031 DCA OPER1 /LO ORDER PART
-05503 1026 TAD ACC2
-05504 3032 DCA OPER2 /HI ORDER PART
-05505 5354 JMP EVOPN /GO CHECK TERMINATOR
- /
-05506 6211 EVDATE, CDF 10 /"D" -- USE DATE WORD
-05507 1776 TAD I (7666 /GET DATE WORD
-05510 6201 CDF 0
-05511 5334 JMP EVBLK+1
-05512 1027 EVREM, TAD ACCX1 /"R" -- USE REMAINDER
-05513 3025 DCA ACC1
-05514 1030 TAD ACCX2 / AS NEXT "INPUT".
-05515 5335 JMP EVBLK+2
-05516 1033 EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE
-05517 3025 DCA ACC1
-05520 1034 TAD TEMPV2
-05521 5335 JMP EVBLK+2
-05522 7614 EVSR, LAS SKP /"S" -- USE SWITCHES
-05523 4554 TADICAD /"C" -- USE CONTENTS
-05524 5334 JMP EVBLK+1
-05525 1074 EVFIL, TAD FILLER /"F" -- USE FILLER
-05526 5334 JMP EVBLK+1
-05527 1061 EVLOC, TAD LOCL /"L" -- USE LOCATION
-05530 3025 DCA ACC1
-05531 1060 TAD LOCH
-05532 5335 JMP EVBLK+2
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 28-2
-
-05533 1057 EVBLK, TAD BLK /"B" -- USE BLOCK
-05534 3025 DCA ACC1 /INTO LO ORDER PART
-05535 3026 DCA ACC2 /0 HIGH ORDER PART
-05536 5301 JMP ENUMX /CHECK NEXT CHARACTER
-
-05537 4764 EVLPAR, JMS I LPARI /IS CHAR "("?
-05540 7410 SKP
-05541 4573 ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR)
-05542 1002 EVPAR2, TAD LASTOP /PUSH DOWN LASTOP
-05543 4550 PUSH
-05544 1200 TAD EVAL /PREPARE TO RE-CALL
-05545 4550 PUSH
-05546 4200 JMS EVAL /RECURSIVE CALL
-05547 4573 ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS
-05550 4551 POP
-05551 3200 DCA EVAL /RESTORE RETURN ADDR
-05552 4551 POP
-05553 3002 DCA LASTOP /RESTORE LASTOP
-05554 4765 EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM.
-05555 5213 JMP EVAL2 /OK
-05556 5341 JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR
-
-05557 1040 EVALX, TAD CNTRA /WAS CHAR CR OR ")"?
-05560 1111 TAD M10
-05561 7650 SNA CLA
-05562 2200 ISZ EVAL / ")", RETURN TO CALL+2
-05563 5600 JMP I EVAL / CR, RETURN TO CALL+1
-
-05564 5616 LPARI, LPAR
-05565 5624 TERMTI, TERMT
-
-05566 4766 EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS
-
-05567 5677 DIOR /INCLUSIVE OR
-05570 5667 DAND /AND
-05571 5650 DADD /ADD
-05572 5662 DSUB /SUBTRACT
-05573 6040 DDIV /DIVIDE
-05574 6000 DMUL /MULTIPLY
-
-
-05576 7666
-05577 5200
- 5600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 29
-
-05600 0000 PUSHX, 0 /PUSH AC ONTO LIST
-05601 6211 CDF 10
-05602 3407 DCA I PDLPT
-05603 6201 CDF 0
-05604 2007 ISZ PDLPT /BUMP POINTER
-05605 5600 JMP I PUSHX
-
-05606 0000 POPX, 0 /POP LIST INTO AC
-05607 7360 STA STL /SET LINK SO IT WILL BE 0
-05610 1007 TAD PDLPT /BACK UP POINTER
-05611 3007 DCA PDLPT
-05612 6211 CDF 10
-05613 1407 TAD I PDLPT
-05614 6201 CDF 0
-05615 5606 JMP I POPX
-
-
-05616 0000 LPAR, 0 /CHECK IF CHAR = "("
-05617 1035 TAD CHAR
-05620 1377 TAD (-"(
-05621 7640 SZA CLA
-05622 2216 ISZ LPAR /IF IT IS NOT, TO CALL+2
-05623 5616 JMP I LPAR / ELSE TO CALL+1
-
- /COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT
- /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
-05624 0000 TERMT, 0
-05625 7300 CLA CLL
-05626 4563 JMS I GETNI /GET NEXT CHARACTER
-05627 4564 JMS I SSKIPI /IGNORE SPACES
-05630 1376 TAD (TERMS-1 /SET UP POINTER
-05631 3011 DCA SPNT
-05632 3040 DCA CNTRA /SET CNTRA TO 0
-05633 6211 TERMT1, CDF 10
-05634 1411 TAD I SPNT /GET AN ITEM
-05635 6201 CDF 0
-05636 2040 ISZ CNTRA /ADD 1 TO ITEM #
-05637 7450 SNA
-05640 5246 JMP TERMTE /WAS 0, END
-05641 7041 CIA
-05642 1035 TAD CHAR /SAME AS THIS?
-05643 7650 SNA CLA
-05644 5624 JMP I TERMT /YES, TO CALL+1
-05645 5233 JMP TERMT1
-05646 2224 TERMTE, ISZ TERMT /DIDN'T FIND IT, TO
-05647 5624 JMP I TERMT / CALL+2
-
- /DOUBLE-PRECISION ROUTINES
-
-05650 0000 DADD, 0 /D.P. ADD
-05651 7100 CLL
-05652 1031 TAD OPER1
-05653 1025 TAD ACC1 /ADD LOW ORDER PARTS
-05654 3025 DCA ACC1
-05655 7004 RAL /GET CARRY TO AC11
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 29-1
-
-05656 1032 TAD OPER2 /ADD HIGH ORDER PARTS
-05657 1026 TAD ACC2
-05660 3026 DCA ACC2 /STORE HIGH ORDER PART
-05661 5650 JMP I DADD
-
-05662 0000 DSUB, 0 /D.P. SUBTRACT
-05663 3001 DCA DPSGN /ZERO IT FOR SAFETY
-05664 4775' JMS MULNEG /NEGATE OPERAND
-05665 4250 JMS DADD / & ADD
-05666 5662 JMP I DSUB
-
-05667 0000 DAND, 0 /D.P. LOGICAL AND
-05670 1026 TAD ACC2 /AND HIGH ORDER PARTS
-05671 0032 AND OPER2
-05672 3026 DCA ACC2
-05673 1025 TAD ACC1 /AND LOW ORDER PARTS
-05674 0031 AND OPER1
-05675 3025 DCA ACC1
-05676 5667 JMP I DAND /RETURN
-
-05677 0000 DIOR, 0 /D.P. LOGICAL INCLUSIVE OR
-05700 1026 TAD ACC2 /IOR HIGH ORDER PARTS
-05701 7040 CMA
-05702 0032 AND OPER2
-05703 1026 TAD ACC2
-05704 3026 DCA ACC2
-05705 1025 TAD ACC1 /IOR LOW ORDER PARTS
-05706 7040 CMA
-05707 0031 AND OPER1
-05710 1025 TAD ACC1
-05711 3025 DCA ACC1
-05712 5677 JMP I DIOR
-
-
- /SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
- /BUFFER. MUST BE IN 'BLOK.LOC' FORM. ONLY ".",
- /SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
-05713 0000 ARG, 0
-05714 7240 STA
-05715 3022 ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1]
-05716 4327 JMS EXPRIN / GET AN ARG
-05717 4567 JMS I SORTI /LOOK UP TERMINATOR
-05720 5445 ARGLST-1
-05721 0010 ARGOPS-ARGLST
-05722 4573 ERCQ, ERROR /ILLEGAL TERMINATOR
- /
-05723 4563 ARG2, JMS I GETNI /SKIP OVER "."
-05724 1025 TAD ACC1 /TERM = ".", SET 'BLOK'
-05725 5315 JMP ARG1
- /
-05726 5713 ARG3, JMP I ARG /TERM = " " OR CR
-
-
- /GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS
- / A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 29-2
-
- / 'ACCEPT'.
-05727 0000 EXPRIN, 0
-05730 4564 JMS I SSKIPI /IGNORE SPACES
-05731 4216 JMS LPAR /IS CHAR A "("?
-05732 5335 JMP EXPRI1
-05733 4774' JMS ACCEPT /NO, MUST BE A NUMBER
-05734 5727 JMP I EXPRIN
- /
-05735 4547 EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION
-05736 4573 ERC08, ERROR /CR = ILLEGAL TERMINATOR
-05737 4773' JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR
-05740 7410 SKP
-05741 7240 STA /NO, SET SWITCH
-05742 3046 DCA CRSWT /YES, RESET IT
-05743 5727 JMP I EXPRIN / & LEAVE...
-
-
-05744 0000 SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
-05745 7200 CLA
-05746 1057 TAD BLK /SET UP DESIRED BLOCK
-05747 3054 DCA CBLK
-05750 4772' JMS GETIO /DO NECESSARY I/O
-05751 7610 SKP CLA / READ ERROR!
-05752 5744 JMP I SCANER /THIS BLOCK IS OK!
-05753 1057 TAD BLK
-05754 4540 JMS I OCTI /OUTPUT BLOCK NUMBER
-05755 4525 JMS I TYPSI / & TELL IT'S BAD
-05756 2145 MSBAD
-05757 4530 JMS I CRLFI / TO ANOTHER LINE
-05760 5744 JMP I SCANER
-
-
-05772 3027
-05773 2552
-05774 5200
-05775 6126
-05776 5336
-05777 7530
- 6000 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 30
-
- /SIGNED MULTIPLY AND DIVIDE ROUTINES
-
-06000 0000 DMUL, 0
-06001 4312 JMS MDCOM /MAKE DPAC POS, INITIALIZE
-06002 7710 SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE
-06003 4326 JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN
-06004 1026 DMUL1, TAD ACC2 /SHIFT RIGHT & OUT
-06005 7010 RAR
-06006 3026 DCA ACC2 /THRU HI OF LO
-06007 1025 TAD ACC1
-06010 7010 RAR
-06011 3025 DCA ACC1 /THRU LO OF LO INTO LINK
-06012 2341 ISZ DPNEG /DONE YET?
-06013 5221 JMP DMUL2 /NO, CONTINUE
-06014 1001 DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT
-06015 7010 RAR
-06016 7630 SZL CLA /SKIP IF SIGN OK
-06017 4341 JMS DPNEG /NOT OK, NEGATE
-06020 5600 JMP I DMUL
- /
-06021 7420 DMUL2, SNL /ADD IN THIS TIME?
-06022 5231 JMP DMUL3 /NO, BIT OUT WAS 0
-06023 7300 CLA CLL /YES, BIT WAS 1
-06024 1031 TAD OPER1 /START WITH LOW
-06025 1027 TAD ACCX1
-06026 3027 DCA ACCX1
-06027 7204 CLA RAL /GET CARRY
-06030 1032 TAD OPER2 /ADD HIGH PARTS
-06031 1030 DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT
-06032 7010 RAR
-06033 3030 DCA ACCX2
-06034 1027 TAD ACCX1
-06035 7010 RAR
-06036 3027 DCA ACCX1
-06037 5204 JMP DMUL1
-
-06040 0000 DDIV, 0
-06041 1240 TAD DDIV /MOVE RETURN ADDRESS
-06042 3200 DCA DMUL
-06043 4312 JMS MDCOM /MAKE DPAC POS, INITIALIZE
-06044 7700 SMA CLA /IS DIVISOR NEGATIVE?
-06045 4326 JMS MULNEG / NO, NEGATE IT & SET SIGN
-06046 7430 SZL / IS IT 0? (CARRY OUT ON NEGATE)
-06047 4573 ERCX, ERROR / YES, YOU LOST
-06050 2001 ISZ DPSGN /CORRECT FOR SIGN DIF IN * & /
-06051 1027 DDIV1, TAD ACCX1 /SUBTRACT LO OF LO
-06052 1031 TAD OPER1
-06053 3027 DCA ACCX1
-06054 7204 CLA RAL /CARRY TO AC
-06055 1030 TAD ACCX2 /SUBTRACT HI OF LO
-06056 1032 TAD OPER2
-06057 7510 SPA /TOO FAR?
-06060 5264 JMP DDIV2 /YES
-06061 7120 CLL CML /NO, SET LINK
-06062 3030 DCA ACCX2
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 30-1
-
-06063 5272 JMP DDIV3
-06064 7200 DDIV2, CLA
-06065 1031 TAD OPER1 /RESET LO ORDER PART
-06066 7041 CIA
-06067 1027 TAD ACCX1
-06070 3027 DCA ACCX1
-06071 7100 CLL /RESET LINK
-06072 1025 DDIV3, TAD ACC1 /BEGIN SHIFTING
-06073 7004 RAL
-06074 3025 DCA ACC1
-06075 1026 TAD ACC2
-06076 7004 RAL
-06077 3026 DCA ACC2
-06100 2341 ISZ DPNEG /DONE YET?
-06101 7410 SKP
-06102 5214 JMP DMUL4 /YES, CHECK SIGN & RETURN
-06103 1027 TAD ACCX1 /NO, KEEP SHIFTING
-06104 7004 RAL
-06105 3027 DCA ACCX1
-06106 1030 TAD ACCX2
-06107 7004 RAL
-06110 3030 DCA ACCX2
-06111 5251 JMP DDIV1
-
-06112 0000 MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE
-06113 3001 DCA DPSGN /RESET SIGN
-06114 1026 TAD ACC2 /IS DPAC POS?
-06115 7710 SPA CLA
-06116 4341 JMS DPNEG /NO, NEGATE
-06117 3030 DCA ACCX2 / 0 => DPACX
-06120 3027 DCA ACCX1
-06121 1377 TAD (-31 /INITIALIZE COUNTER
-06122 3341 DCA DPNEG
-06123 7100 CLL
-06124 1032 TAD OPER2 /RETURN W. HIGH OPERAND
-06125 5712 JMP I MDCOM
-
-06126 0000 MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR
-06127 1031 TAD OPER1 /DO LO-ORDER PART
-06130 7141 CLL CIA
-06131 3031 DCA OPER1
-06132 1032 TAD OPER2 /DO HI-ORDER PART
-06133 7040 CMA
-06134 7430 SZL /CARRY?
-06135 7101 CLL IAC /YES, ADD IT IN
-06136 3032 DCA OPER2
-06137 2001 ISZ DPSGN /SIGN CHANGE MADE
-06140 5726 JMP I MULNEG
-
-06141 0000 DPNEG, 0 /NEGATE THE D.P.AC.
-06142 1025 TAD ACC1 /DO LO-ORDER PART
-06143 7141 CLL CIA
-06144 3025 DCA ACC1
-06145 1026 TAD ACC2 /DO HI-ORDER PART
-06146 7040 CMA
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 30-2
-
-06147 7430 SZL /CARRY?
-06150 7101 CLL IAC /YES, ADD IT IN
-06151 3026 DCA ACC2
-06152 2001 ISZ DPSGN /SIGN CHANGE MADE
-06153 5741 JMP I DPNEG
-
-
-06154 0000 BLKTST, 0 /TEST & SET BLK
-06155 3341 DCA DPNEG /SAVE DATA
-06156 1341 TAD DPNEG /GET IT BACK AGAIN
-06157 2341 ISZ DPNEG /LEGAL BLOCK NUMBER?
-06160 3057 DCA BLK / YES IF NOT 7777 (-1)
-06161 7200 CLA / IF NOT, CLEAR JUNK
-06162 5754 JMP I BLKTST
-
-
-06163 0000 DICAD, 0 /"DCA I CAD" IN FIELD 1
-06164 6211 CDF 10
-06165 3456 DCA I CAD
-06166 6201 CDF 0
-06167 5763 JMP I DICAD
-
-06170 0000 TICAD, 0 /"TAD I CAD" IN FIELD 1
-06171 6211 CDF 10
-06172 1456 TAD I CAD
-06173 6201 CDF 0
-06174 5770 JMP I TICAD
-
-
-06177 7747
- 6200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 31
-
- /CHECK IF THE COMMAND BUFFER STARTS WITH A WORD. IF
- /IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
- /ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
- /IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
- /TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
- /TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
- /QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
- /LITERALS, NOT COMMANDS]. IF THE PARENS MATCH AND
- /THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
- /CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
- /COMMAND TO BE EXECUTED SO RETURN TO CALL+1. OTHER-
- /WISE RETURN TO 'MAIN3' AS ABOVE.
-
-06200 0000 WCHEK, 0
-06201 4556 JMS I GWORDI /COM BUF BEGIN WITH A WORD?
-06202 5211 JMP WCHEK2 /NO, TEST FOR PARENS, ETC.
-06203 7240 WCHEK1, STA
-06204 1015 TAD COMIR /YES, BACK UP COMIR
-06205 3015 DCA COMIR
-06206 1021 TAD TEMP /AND USE THE SPECIAL CHAR AS
-06207 5610 JMP I .+1 / PART OF THE COMMAND STRING
-06210 4025 RESPC+1
- /
-06211 7240 WCHEK2, STA
-06212 1016 TAD COMOUT /SET UP ANOTHER A-XR
-06213 3010 DCA DPNT
-06214 3036 DCA CNT /RESET (OR SET) PAREN COUNT
-06215 4553 WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF.
-06216 4567 JMS I SORTI / & GO TEST IT
-06217 5460 WCKLST-1
-06220 0006 WCKOPS-WCKLST
-06221 5215 JMP WCHEK3 /NONE, CONTINUE SCAN
- /
-06222 1036 WCHEK4, TAD CNT /CR, DO PARENS MATCH?
-06223 7640 SZA CLA
-06224 5203 JMP WCHEK1 /NO, CONTINUE COMMAND INPUT
-06225 5600 JMP I WCHEK /YES, INPUT IS DONE
- /
-06226 7344 WCHEK5, STA CLL RAL /SET TO -2
-06227 7001 IAC /AC = +1 OR -1
-06230 1036 TAD CNT / UPDATE PAREN COUNT
-06231 5214 JMP WCHEK3-1 / & CONTINUE SCAN
- /
-06232 4235 WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS
-06233 4235 JMS WCHONE / " -- 1 CHARACTER
-06234 5215 JMP WCHEK3 /OK, CONTINUE SCAN
-
-06235 0000 WCHONE, 0
-06236 4553 TADIDP /GET NEXT CHAR
-06237 1105 TAD M215 /IS IT A CR?
-06240 7650 SNA CLA
-06241 5203 JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL
-06242 5635 JMP I WCHONE /NO, OK
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 32
-
- /FPP INSTRUCTION DECODING SUPPORT SUBROUTINES
-
-06243 0000 GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11
-06244 4554 TADICAD
-06245 0122 AND N7000
-06246 7106 CLL RTL
-06247 7006 RTL
-06250 5643 JMP I GETOP
-
-06251 0000 GET678, 0 /GET BITS 678 TO BITS 9-11
-06252 4554 TADICAD
-06253 7112 CLL RTR
-06254 7010 RAR
-06255 0113 AND N7
-06256 5651 JMP I GET678
-
-06257 0000 MULT3, 0 /MULTIPLY AC BY THREE
-06260 3243 DCA GETOP
-06261 1243 TAD GETOP
-06262 7104 CLL RAL
-06263 1243 TAD GETOP /WORKS FOR POS OR NEG!
-06264 5657 JMP I MULT3
-
-06265 0000 CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION
-06266 1665 TAD I CONDIT /GET LEADING 1 OR 2 CHARS
-06267 2265 ISZ CONDIT
-06270 4535 JMS I TWOT / & OUTPUT THEM
-06271 4251 JMS GET678 /GET CONDITION CODE
-06272 4676 JMS I SYMTYI / AS INDEX TO TABLE
-06273 4111 FPCOND
-06274 7777 -1
-06275 5665 JMP I CONDIT
-06276 4475 SYMTYI, SYMTYP
-
-06277 0000 FLDOUT, 0 /OUTPUT FIELD DIGIT & "*"
-06300 4554 TADICAD
-06301 0113 AND N7 /GET FIELD
-06302 4543 JMS I RTL6I / TO BITS 3-5
-06303 4527 JMS I TWOCI / & OUTPUT "F*"
-06304 6052 6052 / WHERE "F" IS DIGIT
-06305 5677 JMP I FLDOUT
-
-
-
- DECIMAL /SET RADIX TO DECIMAL
-
- 6306 TEMPL= . /ARGUMENT BUFFER
- /L(TEMPL)=180(10)
- 6572 F0END= TEMPL+180
-06306 0006 DMPHAN-F0END /(SHOW SPACE LEFT)
-
- OCTAL
-
- 6400 PAGE /****** MUST BE NO LITERALS! ******
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 32-1
-
- 6600 DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES
-
- 7200 DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS
-
-
- IFNZRO DMPHAN-F0END&4000 <BADERR,__CAN'T RUN>
-
- /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
- / RUNNING THE DUMP DEVICE HANDLER.
-
-
- 6306 *TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID
-
-06306 0000 INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
-06307 6211 CDF 10
-06310 1777 TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE"
-06311 6201 CDF 0
-06312 0120 AND N200 / (BIT 4 OF 17726)
-06313 7650 SNA CLA
-06314 5322 JMP INIDAT / NOT SET, GO SET UP DATE
-06315 1411 INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO
-06316 7450 SNA
-06317 5322 JMP INIDAT / ERASE CHARACTERS FROM SCREEN
-06320 3410 DCA I DPNT / AND FROM BUFFER (MUCH EASIER
-06321 5315 JMP INISCO / THAN ON HARD COPY!)
- /
-06322 6211 INIDAT, CDF 10 /NOW INIT EXTENDED DATE
-06323 1776 TAD I (7666 /GET SYSTEM DATE WORD
-06324 6201 CDF 0
-06325 0113 AND N7 /PICK OFF THIS YEAR PART
-06326 7041 CIA
-06327 3775' DCA YRTEST / AND SET TEST YEAR (NEG)
-06330 1512 TAD I M1 /NOW GET EXTENDED YEAR BITS
-06331 0374 AND (600 / FROM "B.I.P." WORD AND
-06332 7112 CLL RTR / MOVE TO BITS 7,8 (*8)
-06333 7012 RTR
-06334 1373 TAD (106 /ADD TO A STARTING BASE OF 70[10]
-06335 7041 CIA
-06336 1775' TAD YRTEST /AND ADD THIS YEAR ALSO
-06337 7041 CIA
-06340 3772' DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR
-06341 1771 TAD I (7746 /GET JSW
-06342 0370 AND (6777 /CLEAR BIT 2 (CAN RESTART!)
-06343 7110 CLL RAR
-06344 7124 STL RAL /SET BIT 11 (DON'T SAVE FIELD 1)
-06345 3771 DCA I (7746 /& PUT IT BACK
-06346 4767 JMS I (7607 /WRITE ERROR MESSAGES
-06347 4610 4610 / 6 PAGES, FIELD 1
-06350 0000 0 / FROM LOC 10000
-06351 0027 27 / NORMAL SAVE AREA!
-06352 7610 SKP CLA
-06353 5706 JMP I INIMSG /OK, JUST EXIT
-06354 1106 TAD M200
-06355 3766' DCA XERR3 /FAILED, ASSUME WRITE LOCKED
-06356 1365 TAD (ERROR / SO NO ERROR MESSAGES ON
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 32-2
-
-06357 3764' DCA ERC15 / ERROR OR "SHOW ERRORS"
-06360 5706 JMP I INIMSG
-
-
-06364 0545
-06365 4573
-06366 0505
-06367 7607
-06370 6777
-06371 7746
-06372 5032
-06373 0106
-06374 0600
-06375 5031
-06376 7666
-06377 7726
- 6400 PAGE /LITERALS HERE ARE OK!
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 33
-
- /INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
- / OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS.
-
-06400 7610 START, CLA SKP /NORMAL
-06401 7240 STA /CHAINED (FROM CCL!)
-06402 3021 DCA TEMP
-06403 6211 CDF 10
-06404 3777 DCA I (CCBB /ZAP CCB SWITCH
-06405 6201 CDF 0
-06406 1120 TAD N200
-06407 3776 DCA I (7745 /RESET START ADDRESS
-06410 4775' JMS INIMSG /INIT SCOPE, DATE & ERROR MESSAGES
-06411 4774' JMS BATSET /TEST & SET UP FOR BATCH
-06412 2021 ISZ TEMP /CHAINED?
-06413 5773 JMP I (201 / NO, START IT UP!
-06414 6211 CDF 10
-06415 1506 TAD I M200 /YES, 1ST OUTPUT DEVICE?
-06416 6201 CDF 0
-06417 0372 AND (17 /(IGNORE LENGTH SPEC)
-06420 7450 SNA
-06421 5271 JMP STSWIT / NO, LEAVE AS SYS
-06422 3101 DCA DEVNO /YES, SET DEVICE NUMBER
-06423 1101 TAD DEVNO
-06424 4552 CALUSR /NOW DO HANDLER FETCH BY
-06425 0001 1 / NUMBER (PAINTING?)
-06426 7201 STDEV, DEVHAN+1 /--2 PAGES--
-06427 5351 JMP STERR /ARGGGG! FAILED!!!
-06430 1226 TAD STDEV
-06431 3100 DCA DEVAD /SET UP HANDLER ENTRY
-06432 1106 TAD M200
-06433 3010 DCA DPNT /SET UP FIELD 1 POINTER
-06434 4553 TADIDP /GET NAME OF FILE
-06435 3025 DCA NAM1
-06436 4553 TADIDP
-06437 3026 DCA NAM2
-06440 4553 TADIDP
-06441 3027 DCA NAM3
-06442 4553 TADIDP /GET EXTENSION
-06443 3030 DCA NAM4
-06444 1025 TAD NAM1 /WAS THERE REALLY A NAME?
-06445 7640 SZA CLA
-06446 7240 STA / YES, SET NAME SWITCH
-06447 3021 DCA TEMP / NO, RESET
-06450 6211 CDF 10
-06451 3771 DCA I (XDNAM /CLEAR DEVICE NAME WORDS
-06452 3770 DCA I (XDNAM+1
-06453 1410 TAD I DPNT /GET NEXT WORD & TEST FOR ZERO
-06454 7640 SZA CLA
-06455 5271 JMP STSWIT / SOMETHING NOT RIGHT!
-06456 1410 TAD I DPNT /OK, ASSUME CCL CHAIN & SET
-06457 3771 DCA I (XDNAM / UP DEVICE NAME
-06460 1410 TAD I DPNT
-06461 3770 DCA I (XDNAM+1
-06462 1771 TAD I (XDNAM /EMPTY?
-06463 7640 SZA CLA
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 33-1
-
-06464 5271 JMP STSWIT
-06465 1367 TAD (0423 /YES, MUST BE DEFAULT NAME--
-06466 3771 DCA I (XDNAM / "DSK"
-06467 1366 TAD (1300
-06470 3770 DCA I (XDNAM+1
-06471 6211 STSWIT, CDF 10
-06472 1765 TAD I (7643 /TEST SWITCHES
-06473 0120 AND N200 / "/E"?
-06474 3020 DCA ERMODE / 0= LONG, NON-0= SHORT
-06475 7001 IAC
-06476 0765 AND I (7643 / "/L"? [LOAD]
-06477 7650 SNA CLA
-06500 5307 JMP STSWO /NO, CHECK NEXT
-06501 1030 TAD NAM4 /YES, SET DEFAULT EXTENSION
-06502 7450 SNA
-06503 1364 TAD (1404 / TO ".LD"
-06504 3030 DCA NAM4
-06505 7001 IAC
-06506 5330 JMP STSWEX-2 / & GO SET MODE
- /
-06507 1763 STSWO, TAD I (7644
-06510 0362 AND (1000 / "/O"? [OFFSET]
-06511 7650 SNA CLA
-06512 5320 JMP STSWS /NO, GO CHECK LAST
-06513 1761 TAD I (7646 /YES, GET LOW 12 BITS OF
-06514 7041 CIA / "=NNNN" AS OFFSET AND
-06515 3073 DCA OFFSET / IT UP
-06516 7240 STA
-06517 5331 JMP STSWEX-1 / & GO SET MODE
- /
-06520 1763 STSWS, TAD I (7644 / "/S"? [SAVE]
-06521 0360 AND (40
-06522 7650 SNA CLA
-06523 5332 JMP STSWEX /NO, WAS NOT ANY THAT COUNT
-06524 1030 TAD NAM4 /YES, SET DEFAULT EXTENSION
-06525 7450 SNA
-06526 1357 TAD (2326 / TO ".SV"
-06527 3030 DCA NAM4
-06530 7001 IAC / & SET MODE
-06531 3044 DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD
-06532 6201 STSWEX, CDF 0
-06533 2021 ISZ TEMP /FILE NAME SPECIFIED?
-06534 5773 JMP I (201 / NO, JUST START
-06535 3046 DCA CRSWT /YES, SET SWITCH TO CR,
-06536 6046 STTLS, TLS / START TTY *** BATCH OPER.
-06537 4530 JMS I CRLFI / & DO CR/LF
-06540 1030 TAD NAM4 /ANY EXTENSION SPECIFIED?
-06541 7650 SNA CLA
-06542 7240 STA / NO--ALLOW 3 TRIES: SV, LD, NULL
-06543 3022 DCA TEMP1 / ELSE ALLOW ONLY 1 TRY
-06544 1030 TAD NAM4 /IF NO EXTENSION SET YET,
-06545 7450 SNA
-06546 1357 TAD (2326 / SET TO START DEFAULTS WITH SV
-06547 3030 DCA NAM4
-06550 5756' JMP XFICHN /NOW GO DO FILE LOOKUP
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 33-2
-
- /
-06551 6046 STERR, TLS /START UP OUTPUT *** BATCH OPER.
-06552 5755' JMP ERCY / & GIVE ERROR!
-
-
-06555 1156
-06556 1026
-06557 2326
-06560 0040
-06561 7646
-06562 1000
-06563 7644
-06564 1404
-06565 7643
-06566 1300
-06567 0423
-06570 2465
-06571 2464
-06572 0017
-06573 0201
-06574 6600
-06575 6306
-06576 7745
-06577 6400
- 6600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 34
-
- /INITIALIZATION CODE FOR BATCH OPERATION
-
-06600 0000 BATSET, 0
-06601 1512 TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP"
-06602 7004 RAL / (BATCH-IN-PROGRESS)
-06603 7700 SMA CLA
-06604 5600 JMP I BATSET / NO, INTERACTIVE MODE
-06605 1512 TAD I M1 / YES, GET FIELD BITS OF BATCH
-06606 0377 AND (70 / TO GENERATE A "CIF BAT"
-06607 1376 TAD (CIF / AND SET UP 3 CALLS:
-06610 3307 DCA CBATI / INPUT,
-06611 1307 TAD CBATI
-06612 3346 DCA CBATO / OUTPUT AND
-06613 1307 TAD CBATI
-06614 3336 DCA CBATE / ERROR.
-06615 1412 BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS
-06616 7450 SNA
-06617 5600 JMP I BATSET / 0 = ALL DONE!
-06620 3010 DCA DPNT /SET UP POINTER
-06621 1412 BATLUP, TAD I SCANX1 /GET A PATCH WORD
-06622 7450 SNA
-06623 5215 JMP BATMOV / 0 = GROUP END
-06624 6201 BATPAT, CDF 0 /CHANGED FOR "TYPEB"!!
-06625 3410 DCA I DPNT /PATCH THE WORD
-06626 6201 CDF 0
-06627 5221 JMP BATLUP /DO IT AGAIN!
-
-
- /"SCOPE MODE" PATCHES FOR RUBOUT HANDLER. INITIAL-
- / IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
- / BATCH. THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
- / SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
- / BATCH. THIS SEQUENCE IS REQUIRED!
-
-06776 6202
-06777 0070
- 4031 SCOPLS, RELOC RUBO
-04031* 4303 JMS BTEST /BUFFER NOW EMPTY?
-04032* 5207 JMP RENEXT / YES, JUST IGNORE RUBOUT
-04033* 7240 STA
-04034* 1015 TAD COMIR /NO, BACK UP POINTER
-04035* 3015 DCA COMIR
-04036* 1015 TAD COMIR /SET UP POINTER FOR TESTING, ALSO
-04037* 3016 DCA COMOUT
-04040* 4247 JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE
-04041* 4563 JMS I GETNI /GET RUBBED OUT CHAR AND TEST
-04042* 1035 TAD CHAR
-04043* 1104 TAD M240 / FOR A CONTROL CHAR
-04044* 7710 SPA CLA
-04045* 4247 JMS RUBO2 /YES, ERASE "^" ALSO!
-04046* 5207 JMP RENEXT /TRY FOR ANOTHER CHAR
-
-04047* 7402 RUBO2, HLT /MUST BE NON-ZERO!!!
-04050* 4656 JMS I TYPEAI /OUTPUT A BACKSPACE,
-04051* 0210 "H-100 /(CTRL-H)
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 34-1
-
-04052* 4532 SPACE1 / SPACE,
-04053* 4656 JMS I TYPEAI / BACKSPACE SEQUENCE TO
-04054* 0210 "H-100 / CLEAR OFF SCREEN CHAR
-04055* 5647 JMP I RUBO2
-04056* 5033 TYPEAI, TYPEA
-04057* 0000 0
-
- 6657 RELOC
-
-
- BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.
-
-06657 4030 RUBO-1 /==== INPUT PATCHES ====
- 4031 RELOC RUBO
-04031* 3035 DCA CHAR /SAVE NEW CHAR INPUT
-04032* 1035 TAD CHAR /IS THIS A FORM-FEED?
-04033* 1252 TAD RM214
-04034* 7450 SNA
-04035* 5313 JMP RKEY+1 / YES, JUST IGNORE IT!
-04036* 1253 TAD R2 /NO, THEN IS IT A LINE-FEED?
-04037* 7650 SNA CLA
-04040* 1254 TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN?
-04041* 1105 TAD M215
-04042* 7640 SZA CLA
-04043* 1035 TAD CHAR /NO TO ONE OR OTHER, USE CHAR.
-04044* 3254 DCA RLAST / YES TO BOTH, SET TO 0!
-04045* 1254 TAD RLAST /OK, WAS IT A CR-LF PAIR?
-04046* 7650 SNA CLA
-04047* 5313 JMP RKEY+1 / YES, JUST IGNORE LF!
-04050* 5212 JMP REKEY+1 / NO, GO USE THIS CHAR
-
-04051* 5400 BATINI, 5400 /IN THE BATCH FIELD
-04052* 7564 RM214, -214
-04053* 0002 R2, 2
-04054* 0215 RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !!
-04055* 0000 0
-
-04056* 4112 RKEY+1-1
- 6706 RELOC /TO PUT 'CBATI' ON THIS PAGE
- 6707 CBATI= .+1 /REALLY ON "CIF BAT"
- 4113 RELOC RKEY+1
-04113* 4534 JMS I CTRLI /CHECK FOR CONTROL KEYS
-04114* 6202 CIF /*** CIF BAT
-04115* 4651 JMS I BATINI /GET A BATCH CHARACTER
-04116* 4573 ERC17, ERROR /!!! EOF ON INPUT !!!
-04117* 7000 NOP /FILLER FOR INTERACTIVE CTRL-Q
-04120* 7000 NOP
-04121* 0000 0
-
-04122* 4125 RKEY0-1
- 4126 RELOC RKEY0
-04126* 5313 JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH
-04127* 7000 NOP / & RETURN TO CALL+1!
-04130* 0000 0
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 34-2
-
-04131* 5134 BCTRLC-1
- 5135 RELOC BCTRLC
-05135* 5762 JMP I CTRLCI /CTRL-C, ABORT JOB STREAM!
-05136* 0000 0
-
- 6724 RELOC /==== OUTPUT PATCHES ====
-06724 0200 201-1
-06725 7000 NOP
-06726 0000 0
-
-06727 6535 STTLS-1
-06730 7000 NOP /ZAP 3 "TLS"S USED FOR STARTUP
-06731 0000 0
-
-06732 6550 STERR-1
-06733 7000 NOP
-06734 0000 0
-
- 6735 RELOC /==== ERROR PATCH ====
-
-06735 0514 XERR4-1
- 6736 CBATE= . /REALLY ON "CIF BAT"
- 0515 RELOC XERR4
-00515* 6202 CIF /*** CIF BAT
-00516* 5522 JMP I N7000 /ABORT TO BATCH FIELD!
-00517* 0000 0
-
- 6741 RELOC
-
-06741 6623 BATPAT-1
-06742 6211 CDF 10 /*** NEXT CODE IN FIELD 1 ***
-06743 0000 0
-
-06744 2404 TYPEB-1
- 6745 RELOC
- 6746 CBATO= .+1 /REALLY ON "CIF BAT"
- IFDEF TYPEB </NO PASS1 ERROR!
- 2405 RELOC TYPEB /*** REALLY IN FIELD 1 ***
- >
-02405* 6211 CDF 10 /*** SET UP RETURN D.F.
-02406* 6202 CIF /*** CIF BAT
-02407* 4610 JMS I .+1 /OUTPUT A CHARACTER TO LOG
-02410* 7400 7400 /BATOUT, IN THE BATCH FIELD
-02411* 6201 CDF 0 /*** RESET D.F.
-02412* 0000 0
-
- 6753 RELOC
-
-06753 0000 0
- 7000 PAGE
-
-
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 35
-
-
- 7000 *7000
- /NEW CODE TO HANDLE 128K SUPPORT
-07000 0000 ADFLD, 0 /ADJUSTS BANK AND FIELD FOR CCB PRINTING
-07001 1023 TAD TEMP2
-07002 0377 AND (76
-07003 7112 CLL RTR
-07004 7430 SZL
-07005 1376 TAD (20
-07006 7106 CLL RTL
-07007 4775 JMS I (FPRNT
-07010 5600 JMP I ADFLD
-07011 0000 FPRNTX, 0 /ROUTINE TO PRINT BANK BITS
-07012 0374 AND (174 /ISOLATE BANK AND FIELD BITS
-07013 3226 DCA FLD
-07014 1226 TAD FLD
-07015 0373 AND (104 /ISOLATE BANK BITS
-07016 7112 CLL RTR /SSWITCH THEM AROUND
-07017 7010 RAR
-07020 7430 SZL
-07021 1372 TAD (4
-07022 7112 CLL RTR
-07023 4531 DIGIT /PRINT BANK BITS
-07024 1226 TAD FLD
-07025 5611 JMP I FPRNTX
-07026 0000 FLD, 0
-
-07172 0004
-07173 0104
-07174 0174
-07175 1363
-07176 0020
-07177 0076
- 0001 FIELD 1 /THE END OF FIELD 0!
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36
-
- 0000 *10000 /PUT A POINTER HERE!
-
-10000 3542 NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE
-
-
- /ERROR MESSAGES AND ADDRESS LIST. THESE ITEMS RESIDE
- / UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
- / WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
- / USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
- / OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN. IT IS
- / TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
- / FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
- / MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
- / OR "SET DEVICE ...DDEV..." COMMANDS.
-
- 0002 *10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)
-
- /LIST OF ADDRESSES OF ERROR MESSAGES
-
-10002 0062 ERMSA
-10003 0100 ERMSB
-10004 0116 ERMSC
-10005 1104 ERMS14
-10006 0125 ERMSD
-10007 0137 ERMSE
-10010 0227 ERMSG
-10011 0242 ERMSH
-10012 0256 ERMSI
-10013 0276 ERMSK
-10014 0267 ERMSJ
-10015 0322 ERMSXO
-10016 0341 ERMSL
-10017 0651 ERMSZ
-10020 0404 ERMSO
-10021 1051 ERMS11
-10022 0717 ERMS04
-10023 0417 ERMSP
-10024 0435 ERMSQ
-10025 0456 ERMSR
-10026 1030 ERMS09
-10027 1003 ERMS08
-10030 1071 ERMS13
-10031 0501 ERMSS
-10032 0523 ERMST
-10033 0543 ERMSU
-10034 0564 ERMSV
-10035 0604 ERMSW
-10036 0622 ERMSX
-10037 0636 ERMSY
-10040 0361 ERMSM
-10041 0673 ERMS00
-10042 0671 ERMS01
-10043 0706 ERMS02
-10044 0704 ERMS03
-10045 1037 ERMS10
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-1
-
-10046 0150 ERMSF
-10047 0171 ERMSGC
-10050 0207 ERMSHD
-10051 0742 ERMS05
-10052 0764 ERMS07
-10053 1163 ERMS18
-10054 1172 ERMS19
-10055 1201 ERMS20
-10056 1124 ERMS15
-10057 1135 ERMS16
-10060 1151 EMSEND, ERMS17
-10061 1212 ERMS99
-
-
- /ERROR MESSAGES:
-
-10062 1114 ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND&
-10063 1405
-10064 0701
-10065 1440
-10066 2311
-10067 1607
-10070 1405
-10071 5527
-10072 1722
-10073 0440
-10074 0317
-10075 1515
-10076 0116
-10077 0400
-
-10100 1114 ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND&
-10101 1405
-10102 0701
-10103 1440
-10104 1525
-10105 1424
-10106 1155
-10107 2717
-10110 2204
-10111 4003
-10112 1715
-10113 1501
-10114 1604
-10115 0000
-
-10116 2417 ERMSC, TEXT &TOO MANY ")"S&
-10117 1740
-10120 1501
-10121 1631
-10122 4042
-10123 5142
-10124 2300
-
-10125 1114 ERMSD, TEXT &ILLEGAL FORMAT WORD&
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-2
-
-10126 1405
-10127 0701
-10130 1440
-10131 0617
-10132 2215
-10133 0124
-10134 4027
-10135 1722
-10136 0400
-
-10137 0201 ERMSE, TEXT &BAD FORMAT SYNTAX&
-10140 0440
-10141 0617
-10142 2215
-10143 0124
-10144 4023
-10145 3116
-10146 2401
-10147 3000
-
-10150 1617 ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
-10151 4006
-10152 1114
-10153 0540
-10154 0617
-10155 2240
-10156 0356
-10157 0356
-10160 0256
-10161 5710
-10162 0501
-10163 0405
-10164 2240
-10165 2205
-10166 2125
-10167 0523
-10170 2400
-
-10171 0201 ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
-10172 0440
-10173 0356
-10174 0356
-10175 0240
-10176 5016
-10177 1724
-10200 4001
-10201 4023
-10202 0126
-10203 0540
-10204 0611
-10205 1405
-10206 5100
-
-10207 0201 ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
-10210 0440
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-3
-
-10211 1005
-10212 0104
-10213 0522
-10214 4050
-10215 1617
-10216 2440
-10217 0140
-10220 1417
-10221 0104
-10222 4015
-10223 1704
-10224 2514
-10225 0551
-10226 0000
-
-10227 1114 ERMSG, TEXT &ILLEGAL ITEM TO SHOW&
-10230 1405
-10231 0701
-10232 1440
-10233 1124
-10234 0515
-10235 4024
-10236 1740
-10237 2310
-10240 1727
-10241 0000
-
-10242 1114 ERMSH, TEXT &ILLEGAL SEARCH MODIFIER&
-10243 1405
-10244 0701
-10245 1440
-10246 2305
-10247 0122
-10250 0310
-10251 4015
-10252 1704
-10253 1106
-10254 1105
-10255 2200
-
-10256 0201 ERMSI, TEXT &BAD SEARCH SYNTAX&
-10257 0440
-10260 2305
-10261 0122
-10262 0310
-10263 4023
-10264 3116
-10265 2401
-10266 3000
-
-10267 1114 ERMSJ, TEXT &ILLEGAL MODE&
-10270 1405
-10271 0701
-10272 1440
-10273 1517
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-4
-
-10274 0405
-10275 0000
-
-10276 2305 ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
-10277 2440
-10300 1720
-10301 2411
-10302 1716
-10303 4006
-10304 1714
-10305 1417
-10306 2705
-10307 0440
-10310 0231
-10311 4001
-10312 4003
-10313 2254
-10314 4002
-10315 0104
-10316 4023
-10317 3116
-10320 2401
-10321 3000
-
-10322 1625 ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
-10323 1502
-10324 0522
-10325 4017
-10326 2240
-10327 1114
-10330 1405
-10331 0701
-10332 1440
-10333 2305
-10334 2440
-10335 1720
-10336 2411
-10337 1716
-10340 0000
-
-10341 1625 ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
-10342 1502
-10343 0522
-10344 4017
-10345 2240
-10346 1114
-10347 1405
-10350 0701
-10351 1440
-10352 1725
-10353 2420
-10354 2524
-10355 4017
-10356 2024
-10357 1117
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-5
-
-10360 1600
-
-10361 1114 ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
-10362 1405
-10363 0701
-10364 1440
-10365 4256
-10366 4240
-10367 1116
-10370 4016
-10371 0115
-10372 0540
-10373 5006
-10374 1114
-10375 0540
-10376 1722
-10377 4004
-10400 0526
-10401 1103
-10402 0551
-10403 0000
-
-10404 1114 ERMSO, TEXT &ILLEGAL MODIFY FORMAT&
-10405 1405
-10406 0701
-10407 1440
-10410 1517
-10411 0411
-10412 0631
-10413 4006
-10414 1722
-10415 1501
-10416 2400
-
-10417 2022 ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM&
-10420 1707
-10421 2201
-10422 1540
-10423 1722
-10424 4010
-10425 0122
-10426 0427
-10427 0122
-10430 0540
-10431 2022
-10432 1702
-10433 1405
-10434 1500
-
-10435 0201 ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
-10436 0440
-10437 2405
-10440 2215
-10441 1116
-10442 0124
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-6
-
-10443 1722
-10444 4011
-10445 1640
-10446 2311
-10447 1607
-10450 1405
-10451 4001
-10452 2207
-10453 2515
-10454 0516
-10455 2400
-
-10456 2405 ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
-10457 2215
-10460 1116
-10461 0124
-10462 1722
-10463 4002
-10464 0506
-10465 1722
-10466 0540
-10467 1405
-10470 0701
-10471 1440
-10472 1625
-10473 1502
-10474 0522
-10475 4011
-10476 1620
-10477 2524
-10500 0000
-
-10501 0201 ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
-10502 0440
-10503 2405
-10504 2215
-10505 1116
-10506 0124
-10507 1722
-10510 4011
-10511 1640
-10512 1525
-10513 1424
-10514 1120
-10515 1405
-10516 4001
-10517 2207
-10520 2515
-10521 0516
-10522 2400
-
-10523 1114 ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION&
-10524 1405
-10525 0701
-10526 1440
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-7
-
-10527 0310
-10530 0122
-10531 0103
-10532 2405
-10533 2240
-10534 1116
-10535 4005
-10536 3020
-10537 2205
-10540 2323
-10541 1117
-10542 1600
-
-10543 1114 ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
-10544 1405
-10545 0701
-10546 1440
-10547 2523
-10550 0540
-10551 1706
-10552 4042
-10553 5042
-10554 4011
-10555 1640
-10556 0530
-10557 2022
-10560 0523
-10561 2311
-10562 1716
-10563 0000
-
-10564 1114 ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION&
-10565 1405
-10566 0701
-10567 1440
-10570 1720
-10571 0522
-10572 0124
-10573 1722
-10574 4011
-10575 1640
-10576 0530
-10577 2022
-10600 0523
-10601 2311
-10602 1716
-10603 0000
-
-10604 2417 ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION&
-10605 1740
-10606 0605
-10607 2740
-10610 4251
-10611 4223
-10612 4011
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-8
-
-10613 1640
-10614 0530
-10615 2022
-10616 0523
-10617 2311
-10620 1716
-10621 0000
-
-10622 0411 ERMSX, TEXT &DIVISION BY 0 ATTEMPTED&
-10623 2611
-10624 2311
-10625 1716
-10626 4002
-10627 3140
-10630 6040
-10631 0124
-10632 2405
-10633 1520
-10634 2405
-10635 0400
-
-10636 2516 ERMSY, TEXT &UNKNOWN HANDLER NAME&
-10637 1316
-10640 1727
-10641 1640
-10642 1001
-10643 1604
-10644 1405
-10645 2240
-10646 1601
-10647 1505
-10650 0000
-
-10651 1625 ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION&
-10652 1502
-10653 0522
-10654 4017
-10655 2240
-10656 1114
-10657 1405
-10660 0701
-10661 1440
-10662 0522
-10663 2217
-10664 2240
-10665 1720
-10666 2411
-10667 1716
-10670 0000
-
-10671 1617 ERMS01, TEXT &NON-&
-10672 1655
-10673 0000
- 0673 *.-1
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-9
-
-10673 0601 ERMS00, TEXT &FATAL READ ERROR&
-10674 2401
-10675 1440
-10676 2205
-10677 0104
-10700 4005
-10701 2222
-10702 1722
-10703 0000
-
-10704 1617 ERMS03, TEXT &NON-&
-10705 1655
-10706 0000
- 0706 *.-1
-
-10706 0601 ERMS02, TEXT &FATAL WRITE ERROR&
-10707 2401
-10710 1440
-10711 2722
-10712 1124
-10713 0540
-10714 0522
-10715 2217
-10716 2200
-
-10717 1704 ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
-10720 0440
-10721 2324
-10722 0122
-10723 2440
-10724 1417
-10725 0340
-10726 1722
-10727 4003
-10730 1725
-10731 1624
-10732 4011
-10733 1640
-10734 1723
-10735 5770
-10736 4015
-10737 1704
-10740 1106
-10741 3100
-
-10742 0201 ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
-10743 0440
-10744 0104
-10745 0422
-10746 0523
-10747 2357
-10750 1726
-10751 0522
-10752 1401
-10753 3140
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-10
-
-10754 5017
-10755 0424
-10756 4003
-10757 1715
-10760 1501
-10761 1604
-10762 2351
-10763 0000
-
- /ERMS06,
-
-10764 0201 ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
-10765 0440
-10766 0104
-10767 0422
-10770 0523
-10771 2357
-10772 1726
-10773 0522
-10774 1401
-10775 3140
-10776 5015
-10777 1704
-11000 1106
-11001 3151
-11002 0000
-
-11003 0122 ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
-11004 0725
-11005 1505
-11006 1624
-11007 4005
-11010 3020
-11011 2205
-11012 2323
-11013 1117
-11014 1640
-11015 1617
-11016 2440
-11017 2405
-11020 2215
-11021 1116
-11022 0124
-11023 0504
-11024 4002
-11025 3140
-11026 4251
-11027 4200
-
-11030 1114 ERMS09, TEXT &ILLEGAL DIGIT&
-11031 1405
-11032 0701
-11033 1440
-11034 0411
-11035 0711
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-11
-
-11036 2400
-
-11037 0425 ERMS10, TEXT &DUMP HANDLER ERROR&
-11040 1520
-11041 4010
-11042 0116
-11043 0414
-11044 0522
-11045 4005
-11046 2222
-11047 1722
-11050 0000
-
-11051 1625 ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
-11052 1502
-11053 0522
-11054 4017
-11055 2240
-11056 1114
-11057 1405
-11060 0701
-11061 1440
-11062 0415
-11063 1704
-11064 0540
-11065 1720
-11066 2411
-11067 1716
-11070 0000
-
- /ERMS12,
-
-11071 1114 ERMS13, TEXT &ILLEGAL USE OF ' OR "&
-11072 1405
-11073 0701
-11074 1440
-11075 2523
-11076 0540
-11077 1706
-11100 4047
-11101 4017
-11102 2240
-11103 4200
-
-11104 1501 ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
-11105 2020
-11106 0504
-11107 4015
-11110 1704
-11111 0555
-11112 5525
-11113 2305
-11114 4014
-11115 1123
-11116 2454
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-12
-
-11117 4016
-11120 1724
-11121 4004
-11122 2515
-11123 2000
-
-11124 1617 ERMS15, TEXT &NO ERROR MESSAGES&
-11125 4005
-11126 2222
-11127 1722
-11130 4015
-11131 0523
-11132 2301
-11133 0705
-11134 2300
-
-11135 1116 ERMS16, TEXT &INPUT ERROR ON MESSAGES&
-11136 2025
-11137 2440
-11140 0522
-11141 2217
-11142 2240
-11143 1716
-11144 4015
-11145 0523
-11146 2301
-11147 0705
-11150 2300
-
-11151 0517 ERMS17, TEXT &EOF ON BATCH INPUT&
-11152 0640
-11153 1716
-11154 4002
-11155 0124
-11156 0310
-11157 4011
-11160 1620
-11161 2524
-11162 0000
-
-11163 0516 ERMS18, TEXT &ENTER FAILED&
-11164 2405
-11165 2240
-11166 0601
-11167 1114
-11170 0504
-11171 0000
-
-11172 0314 ERMS19, TEXT &CLOSE FAILED&
-11173 1723
-11174 0540
-11175 0601
-11176 1114
-11177 0504
-11200 0000
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 36-13
-
-
-11201 0425 ERMS20, TEXT &DUMP FILE OVERRUN&
-11202 1520
-11203 4006
-11204 1114
-11205 0540
-11206 1726
-11207 0522
-11210 2225
-11211 1600
-
-11212 0405 ERMS99, TEXT &DEBUG&
-11213 0225
-11214 0700
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 37
-
- 2000 *12000 /BEGIN ABOVE THE USR AREA
-
- /GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
- / LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
- / ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
- / FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
- / CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
- / BE USED FOR THE APPROPRIATE PURPOSE.
-
-12000 0000 GCCB, 0 /GET CORE-CONTROL-BLOCK
-12001 4306 JMS CCBHDR /DO COMMON TEST & READ-IN
-12002 7104 CLL RAL /ADJUSTS FOR 128K INDICATOR BIT
-12003 7130 STL RAR
-12004 7700 SMA CLA /1ST WORD (-# SEGS) NEG?
-12005 5222 JMP GCCERR / NO, CAN'T BE CCB
-12006 1777 TAD I (CCBB+3 /GET JOB STATUS WORD
-12007 0376 AND (200 /OVERLAY BIT SET (LINK)?
-12010 7640 SZA CLA / 0 = NO
-12011 1375 TAD (CCBB+140-1 / 1 = YES, START ADDR-1
-12012 6201 CDF 0
-12013 3774 DCA I (OVLFLG /NO = 0; YES = ADDR-1
-12014 6211 CDF 10
-12015 1773 TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"?
-12016 0372 AND (7603
-12017 7041 CIA
-12020 1246 TAD GCCCDF
-12021 7640 SZA CLA
-12022 4771' GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW!
-12023 2341 ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ?
-12024 5242 JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN
-12025 1370 TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
-12026 3250 GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS
-12027 1250 TAD GHDR /GET A WORD - PAGES-V7C
-12030 1367 TAD (-6603 /V7C
-12031 7650 SNA CLA /V7C
-12032 5242 JMP GCCB2 / 0 = DONE
-12033 1650 TAD I GHDR /V7C
-12034 7001 IAC /ROUND DOWN IN 2 STEPS FOR PDP-8
-12035 7110 CLL RAR
-12036 3650 DCA I GHDR /STORE A WORD - BLOCKS
-12037 1250 TAD GHDR /UPDATE POINTER TO NEXT
-12040 1366 TAD (4
-12041 5226 JMP GCCB1
- /
-12042 3341 GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
-12043 1727 TAD I SEGNI /GET -# SEGMENTS
-12044 7104 CLL RAL
-12045 7130 STL RAR /ADJUSTS FOR 128K INDICATOR BIT
-12046 6203 GCCCDF, CDF CIF 0
-12047 5600 JMP I GCCB /OK, RETURN VALUE
-
-12050 0000 GHDR, 0 /GET HEADER BLOCK (FORTRAN IV)
-12051 1365 TAD (3 /TO SET UP CCBB+6
-12052 4306 JMS CCBHDR /DO COMMON TEST & READ-IN
-12053 1364 TAD (-2 /1ST WORD MUST BE EXACTLY 2
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 37-1
-
-12054 7640 SZA CLA
-12055 5301 JMP HDRERR / NO, CAN'T BE A HEADER
-12056 2341 ISZ GETSWX /1ST TIME THRU SINCE READ?
-12057 5302 JMP GHDR1 / NO, DON'T CHANGE ANYTHING
-12060 3763 DCA I (CCBB+47 /YES, BE SURE THESE WORDS
-12061 3762 DCA I (CCBB+50 / ARE 0 FOR USERS
-12062 1773 TAD I (CCBB+1 /GET START FIELD WORD
-12063 7450 SNA
-12064 5301 JMP HDRERR / SHOULD BE 1 THRU 7
-12065 7106 CLL RTL /LOOKS OK, MOVE FIELD TO BITS
-12066 7004 RAL / 6-8 TO HELP "SHOW HEAD"
-12067 3773 DCA I (CCBB+1
-12070 1773 TAD I (CCBB+1 /ARE THESE ONLY BITS SET?
-12071 0361 AND (7707
-12072 7640 SZA CLA
-12073 5301 JMP HDRERR / NO, SOMETHING MUST BE BAD
-12074 1777 TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE
-12075 7450 SNA
-12076 5301 JMP HDRERR / SHOULD BE 1 THRU 7
-12077 0360 AND (7770
-12100 7640 SZA CLA
-12101 4771' HDRERR, JMS ERROR1
-12102 3341 GHDR1, DCA GETSWX /MAKE SURE THIS IS 0
-12103 7000 NOP /AC NON-ZERO FOR OK-V7C
-12104 6203 CDF CIF 0
-12105 5650 JMP I GHDR /OK, BACK TO USER
-
-12106 0000 CCBHDR, 0
-12107 1377 TAD (CCBB+3 /CCBB+6 FOR GHDR
-12110 6201 CDF 0
-12111 3757 DCA I (GETPNT /SET UP POINTER FOR 'GET'
-12112 1756 TAD I (DEVAD /GET ADDR OF DEVICE
-12113 3340 DCA DEVADX / HANDLER & SAVE HERE
-12114 1755 TAD I (RBLK1 /GET START BLOCK NUMBER
-12115 7450 SNA
-12116 4771' ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR
-12117 6211 CDF 10
-12120 3330 DCA GCCBLK /OK, SET UP 1ST BLOCK
-12121 1727 TAD I SEGNI /IS SOMETHING IN MEMORY?
-12122 7440 SZA
-12123 5706 JMP I CCBHDR / YES, RETURN 1ST WORD
-12124 6202 CIF 0
-12125 4740 JMS I DEVADX /NO, READ 1ST BLOCK OF FILE
-12126 0110 0110 /READ; 1 PAGE; FIELD 1
-12127 6400 SEGNI, CCBB /BUFFER IS HERE
-12130 0000 GCCBLK, 0 /BLOCK NUMBER
-12131 5336 JMP RDERX /...BAD NEWS...
-12132 7240 STA
-12133 3341 DCA GETSWX /OK, SET "JUST READ" SWITCH
-12134 1727 TAD I SEGNI /AND GET 1ST WORD
-12135 5706 JMP I CCBHDR
- /
-12136 6203 RDERX, CDF CIF 0 /RETURN TO FIELD 0
-12137 5754 JMP I (RERROR / FOR READ ERROR
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 37-2
-
-12140 0000 DEVADX, 0
-12141 0000 GETSWX, 0
-
-
-12142 4040 MSMOD, TEXT " MOD"
-12143 1517
-12144 0400
-
-12145 4002 MSBAD, TEXT " BAD BLOCK"
-12146 0104
-12147 4002
-12150 1417
-12151 0313
-12152 0000
-
-
-12154 2213
-12155 0077
-12156 0100
-12157 0014
-12160 7770
-12161 7707
-12162 6450
-12163 6447
-12164 7776
-12165 0003
-12166 0004
-12167 1175
-12170 6543
-12171 2433
-12172 7603
-12173 6401
-12174 0000
-12175 6537
-12176 0200
-12177 6403
- 2200 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 38
-
- /CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
-
- /CONTINUATION OF 'SET' 'DDEV' HANDLER
-
-12200 3263 XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS
-12201 1777 TAD I (GDEV2
-12202 3264 DCA DDEVNO / AND DEVICE NUMBER
-12203 6211 CDF 10
-12204 1264 TAD DDEVNO /LOOK AT DCW FOR SPECIFIED
-12205 1376 TAD (7760-1 / DEVICE TO SEE IF FILE
-12206 3265 DCA DDCWPT / STRUCTURED.
-12207 1665 TAD I DDCWPT /BIT 0 = 1 FOR FILES
-12210 7700 SMA CLA
-12211 1375 TAD (212 / NO, LINE-AT-A-TIME
-12212 3774' DCA DDEVS / YES, BLOCK-AT-A-TIME
-12213 1340 TAD DMPADR /OK, INITIALIZE OUTPUT POINTER
-12214 3353 DCA DMPPTR
-12215 3253 DCA XOSIZ / AND ZERO BLOCK COUNTER
-12216 3266 DCA DNAM / AND CLEAR ANY FILE NAME
-12217 7001 IAC
-12220 3341 DCA DMPBLK / AND SET BLOCK NUMBER TO 1
-12221 5773' JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT
-
-
- /CONTINUATION OF EXECUTION OF 'OPEN' COMMAND
-
-12222 1372 XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE
-12223 3010 DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!)
-12224 1410 TAD I DPNT /MOVE THE FILE NAME UP HERE
-12225 3266 DCA DNAM
-12226 1410 TAD I DPNT
-12227 3267 DCA DNAM+1
-12230 1410 TAD I DPNT
-12231 3270 DCA DNAM+2
-12232 1410 TAD I DPNT /GET THE EXTENSION PART
-12233 2771 ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED?
-12234 5237 JMP XOPEN2
-12235 7200 CLA
-12236 1370 TAD (0425 / NO, DEFAULT TO ".DU"
-12237 3271 XOPEN2, DCA DNAM+3
-12240 1310 TAD XCLNAM /SET UP POINTER TO NAME FOR USR
-12241 3252 DCA XOBLK
-12242 6211 CDF 10 /SET UP RETURN FIELD
-12243 1665 TAD I DDCWPT /CLEAR ANY OPEN FILE ON
-12244 0367 AND (7770 / THIS DEVICE SO "OPEN"
-12245 3665 DCA I DDCWPT / CAN BE DONE WHENEVER!
-12246 6202 CIF 0 /SET UP SUBROUTINE FIELD
-12247 1264 TAD DDEVNO /GET DUMP DEVICE NUMBER
-12250 4766' JMS USEUSR / AND GO GET USR & CALL IT.
-12251 0003 3 /ENTER
-12252 0000 XOBLK, 0 /NAME POINTER, BECOMES START BLK
-12253 0000 XOSIZ, 0 / BECOMES -# BLOCKS CAN USE
-12254 4765' ERC18, JMS ERROR1 /THE ENTER FAILED!
-12255 1252 TAD XOBLK /OK! SET UP FILE START BLOCK
-12256 3341 DCA DMPBLK
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 38-1
-
-12257 1340 TAD DMPADR /INITIALIZE POINTER
-12260 3353 DCA DMPPTR
-12261 6203 XOCEX, CDF CIF 0
-12262 5764' JMP MAIN1 /TRY NEXT COMMAND
-
-12263 7607 DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE)
-12264 0001 DDEVNO, 1 /INIT THIS TO "SYS:" ALSO.
-12265 7760 DDCWPT, 7760 / THIS ALSO
-
-12266 0000 DNAM, 0 /DUMP FILE NAME, INIT TO NULL
-12267 0000 0
-12270 0000 0
-12271 0000 0 /(EXTENSION HERE)
-
-
- /CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND
-
-12272 1266 XCLOS1, TAD DNAM /IS ANY FILE OPEN?
-12273 7650 SNA CLA
-12274 5261 JMP XOCEX / NO, IGNORE COMMAND
-12275 1277 TAD XCTLZ / YES, OUTPUT A CTRL-Z
-12276 4315 JMS DMPOUT / AND FILL TO END
-12277 0232 XCTLZ, "Z-100
-12300 1252 TAD XOBLK /OK, CALCULATE FILE SIZE
-12301 7041 CIA
-12302 1341 TAD DMPBLK /= NEXT - START
-12303 3311 DCA XCLSIZ /= FILE SIZE IN BLOCKS
-12304 1264 TAD DDEVNO /GET DUMP DEVICE NUMBER
-12305 6202 CIF 0
-12306 4766' JMS USEUSR /GET USR AND CALL IT
-12307 0004 4 /CLOSE
-12310 2266 XCLNAM, DNAM /POINTER TO FILE NAME
-12311 0000 XCLSIZ, 0 /SIZE OF NEW FILE
-12312 4765' ERC19, JMS ERROR1 /OH NO! CLOSE FAILED!
-12313 3266 DCA DNAM /OK, ZAP KNOWLEDGE OF FILE
-12314 5261 JMP XOCEX
-
-
-12315 0000 DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE
-12316 3352 DCA DMPCHR /SAVE THE CHARACTER
-12317 1352 TAD DMPCHR /PUT IT INTO FILE BUFFER
-12320 6211 CDF 10 /(MUST BE SURE!)
-12321 3753 DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR
-12322 2353 ISZ DMPPTR
-12323 1353 TAD DMPPTR /NOW AT END OF BUFFER?
-12324 1363 TAD (-DMPBUF-400
-12325 7650 SNA CLA
-12326 5335 JMP DMPIT / YES, DUMP BUFFER NOW
-12327 1352 TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR?
-12330 7041 CIA
-12331 1715 TAD I DMPOUT /(THE TEST CHAR @ CALL+1)
-12332 7650 SNA CLA
-12333 5321 JMP DMPNUL / YES, FILL WITH NULLS!
-12334 5715 JMP I DMPOUT / NO, EXECUTE FILL CHAR
- /
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 38-2
-
-12335 6202 DMPIT, CIF 0
-12336 4663 JMS I DDEVAD /CALL DUMP FILE HANDLER
-12337 4210 4210 /WRITE, 2 PAGES, FIELD 1
-12340 6600 DMPADR, DMPBUF
-12341 0001 DMPBLK, 1 /BLOCK NUMBER
-12342 4765' ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE!
-12343 1340 TAD DMPADR /NOW RESET OUTPUT POINTER
-12344 3353 DCA DMPPTR
-12345 2341 ISZ DMPBLK /INCREMENT BLOCK NUMBER
-12346 2253 ISZ XOSIZ /ANY MORE SPACE LEFT?
-12347 5715 JMP I DMPOUT / YES, EXIT NOW
-12350 3266 DCA DNAM / NO! ZAP DUMP FILE
-12351 4765' ERC20, JMS ERROR1 / AND DIE!
-12352 0000 DMPCHR, 0
-12353 0000 DMPPTR, 0 /CHARACTER OUTPUT POINTER
-
-
-12363 0600
-12364 0204
-12365 2433
-12366 0520
-12367 7770
-12370 0425
-12371 0022
-12372 0024
-12373 2441
-12374 2430
-12375 0212
-12376 7757
-12377 1154
- 2400 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 39
-
- /CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
-
-12400 1777 TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL
-12401 0776 AND I (DSWIT / SO TEST FOR PART&DSWIT
-12402 7640 SZA CLA
-12403 5212 JMP TYPE2 /NO OUTPUT TO TTY
-12404 1775 TAD I (RTL6 /GET CHARACTER TO OUTPUT
-12405 7000 TYPEB, NOP /*** CDF 10 /*** BATCH
-12406 6041 TSF /*** CIF BAT /*** CHANGES
-12407 5206 JMP .-1 /*** JMS I .+1 /*** LOG
-12410 6046 TLS /*** 7400 /*** OUTPUT
-12411 7200 CLA /*** CDF 0
-12412 7330 TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST)
-12413 1776 TAD I (DSWIT /=4000 OR 4001 (DSWIT=1)
-12414 0777 AND I (DMODE /FILE= PART&DSWIT OR ALL
-12415 7650 SNA CLA
-12416 5231 JMP TYPE3 / OUTPUT TO TTY ONLY
-12417 1230 TAD DDEVS /FILE STRUCTURED OUTPUT?
-12420 6211 CDF 10
-12421 7450 SNA
-12422 1774 TAD I (DNAM / YES, FILE OPEN?
-12423 6201 CDF 0
-12424 7650 SNA CLA
-12425 5231 JMP TYPE3 / NO TO EITHER
-12426 1775 TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT
-12427 4773' JMS DMPOUT /OUTPUT IT & TEST FOR END
-12430 0000 DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE
-12431 6203 TYPE3, CDF CIF 0
-12432 5772' JMP TYPEX /BACK AND OUT
-
-
-12433 0000 ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD
-12434 7200 CLA /CLEAR POSSIBLE JUNK IN AC
-12435 1233 TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0
-12436 6203 CDF CIF 0
-12437 3771 DCA I (XERROR
-12440 5770 JMP I (XERROR+1
-
-
-12441 6201 XDDEV2, CDF 0 /NAME IS OVER THERE
-12442 1767 TAD I (NAM1 /MOVE DEVICE NAME INTO STRING
-12443 3254 DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV"
-12444 1766 TAD I (NAM2
-12445 3255 DCA XDDNAM+1
-12446 6203 CDF CIF 0
-12447 5765' JMP XSETN /BACK TO 'SET'
-
-12450 0004 MSDDEV, TEXT "@DDEV = SYS@"
-12451 0405
-12452 2640
-12453 7540
-12454 2331
-12455 2300
-12456 0000
- 2454 XDDNAM= .-3
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 39-1
-
-
-12457 0004 MSDEV, TEXT "@DEVICE = SYS@"
-12460 0526
-12461 1103
-12462 0540
-12463 7540
-12464 2331
-12465 2300
-12466 0000
-
- 2464 XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME
-
- /CONTINUATION OF CODE FROM FIELD 0
-
-12467 3264 XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN
-12470 1766 TAD I (NAM2 / OUTPUT MESSAGE
-12471 3265 DCA XDNAM+1
-12472 6211 CDF 10
-12473 3764 DCA I (CCBB /NO C.C.B. OR HEADER PRESENT
-12474 6203 CDF CIF 0
-12475 7240 STA
-12476 3763 DCA I (RBLK /RESET BLOCK NUMBER
-12477 5765' JMP XSETN /GO DO NEXT OPTION
-
-
-12500 4005 MSERR, TEXT " ERROR CODES: FUTIL "
-12501 2222
-12502 1722
-12503 4003
-12504 1704
-12505 0523
-12506 7240
-12507 0625
-12510 2411
-12511 1440
-12512 0000
- 2512 *.-1
-
- /VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
- / VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
- / THE SOURCE INTO THE VERSION MESSAGE.
-
-12512 2605 MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1
-12513 2223
-12514 1117
-12515 1640
-12516 7540
-12517 7777
-12520 7700
- 2517 *.-2
- 0000 VERTEN= VERSION%12 /TENS DIGIT
- 0010 VERONE= -VERTEN^12+VERSION /ONES DIGIT
-12517 6070 VERTEN^100+VERONE+6060 /INSERT TWO DIGITS
-12520 0100 PATCH^100 /INSERT PATCH + NULL TERM
-
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 39-2
-
- /ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE
-
-12521 4060 MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
-12522 6000
-12523 1201
-12524 1600
-12525 0605
-12526 0200
-12527 1501
-12530 2200
-12531 0120
-12532 2200
-12533 1501
-12534 3100
-12535 1225
-12536 1600
-12537 1225
-12540 1400
-12541 0125 TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
-12542 0700
-12543 2305
-12544 2000
-12545 1703
-12546 2400
-12547 1617
-12550 2600
-12551 0405
-12552 0300
-12553 4061
-12554 6300
-12555 4061
-12556 6400
-12557 4061
-12560 6500
-
-
-12563 3057
-12564 6400
-12565 1600
-12566 0026
-12567 0025
-12570 0455
-12571 0454
-12572 5042
-12573 2315
-12574 2266
-12575 3762
-12576 0052
-12577 0053
- 2600 PAGE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 40
-
- /SYMBOLICS FOR PDP-8 INSTRUCTIONS:
-12600 0116 INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP "
-12601 0440
-12602 2401
-12603 0440
-12604 1123
-12605 3240
-12606 0403
-12607 0140
-12610 1215
-12611 2340
-12612 1215
-12613 2040
-12614 1117
-12615 2440
-12616 1617
-12617 2040
-12620 0000
- 2620 *.-1
-
- / GROUP 1 MICRO-INSTS.:
-12620 0314 OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR "
-12621 1440
-12622 0315
-12623 0140
-12624 0315
-12625 1440
-12626 1101
-12627 0340
-12630 0223
-12631 2740
-12632 2201
-12633 1440
-12634 2224
-12635 1440
-12636 2201
-12637 2240
-12640 2224
-12641 2240
-12642 0000
- 2642 *.-1
-
-
- / GROUP 2 MICRO-INST'S:
-12642 2315 OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
-12643 0140
-12644 2332
-12645 0140
-12646 2316
-12647 1440
-12650 2313
-12651 2040
-12652 2320
-12653 0140
-12654 2316
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 40-1
-
-12655 0140
-12656 2332
-12657 1440
-12660 1723
-12661 2240
-12662 1014
-12663 2440
-12664 0000
- 2664 *.-1
-
- / EAE MICRO-INST'S:
-12664 1521 EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
-12665 0140
-12666 1521
-12667 1440
-12670 2303
-12671 1440
-12672 1525
-12673 3140
-12674 0426
-12675 1140
-12676 1615
-12677 1140
-12700 2310
-12701 1440
-12702 0123
-12703 2240
-12704 1423
-12705 2240
-12706 2303
-12707 0140
-12710 0000
- 2710 *.-1
-12710 0401 TEXT "DAD DST SWBADPSZDPICDCM SAM "
-12711 0440
-12712 0423
-12713 2440
-12714 2327
-12715 0201
-12716 0420
-12717 2332
-12720 0420
-12721 1103
-12722 0403
-12723 1540
-12724 2301
-12725 1540
-12726 0000
- 2726 *.-1
-
-12726 0314 CLANAM, 0314 /"CLA "
-12727 0140 0140
-
-12730 1720 OPRMES, 1720 /"OPR "
-12731 2240 2240
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41
-
- / IOT INSTRUCTIONS:
-
-12732 6000 IOTTAB, 6000
-12733 2313 TEXT "SKON"
-12734 1716
-12735 0000
-12736 6001 6001
-12737 1117 TEXT "ION@"
-12740 1600
-12741 0000
-12742 6002 6002
-12743 1117 TEXT "IOF@"
-12744 0600
-12745 0000
-12746 6003 6003
-12747 2322 TEXT "SRQ@"
-12750 2100
-12751 0000
-12752 6004 6004
-12753 0724 TEXT "GTF@"
-12754 0600
-12755 0000
-12756 6005 6005
-12757 2224 TEXT "RTF@"
-12760 0600
-12761 0000
-12762 6006 6006
-12763 2307 TEXT "SGT@"
-12764 2400
-12765 0000
-12766 6007 6007
-12767 0301 TEXT "CAF@"
-12770 0600
-12771 0000
-12772 6010 6010
-12773 2220 TEXT "RPE@"
-12774 0500
-12775 0000
-12776 6011 6011
-12777 2223 TEXT "RSF@"
-13000 0600
-13001 0000
-13002 6012 6012
-13003 2222 TEXT "RRB@"
-13004 0200
-13005 0000
-13006 6014 6014
-13007 2203 TEXT "RCF@"
-13010 0600
-13011 0000
-13012 6016 6016
-13013 2203 TEXT "RCC@"
-13014 0300
-13015 0000
-13016 6020 6020
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-1
-
-13017 2003 TEXT "PCE@"
-13020 0500
-13021 0000
-13022 6021 6021
-13023 2023 TEXT "PSF@"
-13024 0600
-13025 0000
-13026 6022 6022
-13027 2003 TEXT "PCF@"
-13030 0600
-13031 0000
-13032 6024 6024
-13033 2020 TEXT "PPC@"
-13034 0300
-13035 0000
-13036 6026 6026
-13037 2014 TEXT "PLS@"
-13040 2300
-13041 0000
-13042 6030 6030
-13043 1303 TEXT "KCF@"
-13044 0600
-13045 0000
-13046 6031 6031
-13047 1323 TEXT "KSF@"
-13050 0600
-13051 0000
-13052 6032 6032
-13053 1303 TEXT "KCC@"
-13054 0300
-13055 0000
-13056 6034 6034
-13057 1322 TEXT "KRS@"
-13060 2300
-13061 0000
-13062 6035 6035
-13063 1311 TEXT "KIE@"
-13064 0500
-13065 0000
-13066 6036 6036
-13067 1322 TEXT "KRB@"
-13070 0200
-13071 0000
-13072 6040 6040
-13073 2406 TEXT "TFL@"
-13074 1400
-13075 0000
-13076 6041 6041
-13077 2423 TEXT "TSF@"
-13100 0600
-13101 0000
-13102 6042 6042
-13103 2403 TEXT "TCF@"
-13104 0600
-13105 0000
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-2
-
-13106 6044 6044
-13107 2420 TEXT "TPC@"
-13110 0300
-13111 0000
-13112 6045 6045
-13113 2423 TEXT "TSK@"
-13114 1300
-13115 0000
-13116 6046 6046
-13117 2414 TEXT "TLS@"
-13120 2300
-13121 0000
-13122 6100 6100
-13123 0420 TEXT "DPI@"
-13124 1100
-13125 0000
-13126 6101 6101
-13127 2315 TEXT "SMP@"
-13130 2000
-13131 0000
-13132 6102 6102
-13133 2320 TEXT "SPL@"
-13134 1400
-13135 0000
-13136 6103 6103
-13137 0520 TEXT "EPI@"
-13140 1100
-13141 0000
-13142 6104 6104
-13143 0315 TEXT "CMP@"
-13144 2000
-13145 0000
-13146 6105 6105
-13147 2354 TEXT "S,CMP"
-13150 0315
-13151 2000
-13152 6106 6106
-13153 0305 TEXT "CEP@"
-13154 2000
-13155 0000
-13156 6107 6107
-13157 2320 TEXT "SPO@"
-13160 1700
-13161 0000
-13162 6110 6110
-13163 2203 TEXT "RCTV"
-13164 2426
-13165 0000
-13166 6111 6111
-13167 2203 TEXT "RCRL"
-13170 2214
-13171 0000
-13172 6112 6112
-13173 2203 TEXT "RCRH"
-13174 2210
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-3
-
-13175 0000
-13176 6113 6113
-13177 2203 TEXT "RCCV"
-13200 0326
-13201 0000
-13202 6114 6114
-13203 2203 TEXT "RCGB"
-13204 0702
-13205 0000
-13206 6115 6115
-13207 2203 TEXT "RCLC"
-13210 1403
-13211 0000
-13212 6116 6116
-13213 2203 TEXT "RCCB"
-13214 0302
-13215 0000
-13216 6130 6130
-13217 0314 TEXT "CLZE"
-13220 3205
-13221 0000
-13222 6131 6131
-13223 0314 TEXT "CLSK"
-13224 2313
-13225 0000
-13226 6132 6132
-13227 0314 TEXT "CLOE"
-13230 1705
-13231 0000
-13232 6133 6133
-13233 0314 TEXT "CLAB"
-13234 0102
-13235 0000
-13236 6134 6134
-13237 0314 TEXT "CLEN"
-13240 0516
-13241 0000
-13242 6135 6135
-13243 0314 TEXT "CLSA"
-13244 2301
-13245 0000
-13246 6136 6136
-13247 0314 TEXT "CLBA"
-13250 0201
-13251 0000
-13252 6137 6137
-13253 0314 TEXT "CLCA"
-13254 0301
-13255 0000
-13256 6201 6201
-13257 0304 TEXT "CDF 00"
-13260 0640
-13261 6060
-13262 0000
- 3262 *.-1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-4
-
-13262 6211 6211
-13263 0304 TEXT "CDF 10"
-13264 0640
-13265 6160
-13266 0000
- 3266 *.-1
-13266 6221 6221
-13267 0304 TEXT "CDF 20"
-13270 0640
-13271 6260
-13272 0000
- 3272 *.-1
-13272 6231 6231
-13273 0304 TEXT "CDF 30"
-13274 0640
-13275 6360
-13276 0000
- 3276 *.-1
-13276 6241 6241
-13277 0304 TEXT "CDF 40"
-13300 0640
-13301 6460
-13302 0000
- 3302 *.-1
-13302 6251 6251
-13303 0304 TEXT "CDF 50"
-13304 0640
-13305 6560
-13306 0000
- 3306 *.-1
-13306 6261 6261
-13307 0304 TEXT "CDF 60"
-13310 0640
-13311 6660
-13312 0000
- 3312 *.-1
-13312 6271 6271
-13313 0304 TEXT "CDF 70"
-13314 0640
-13315 6760
-13316 0000
- 3316 *.-1
-13316 6202 6202
-13317 0311 TEXT "CIF 00"
-13320 0640
-13321 6060
-13322 0000
- 3322 *.-1
-13322 6212 6212
-13323 0311 TEXT "CIF 10"
-13324 0640
-13325 6160
-13326 0000
- 3326 *.-1
-13326 6222 6222
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-5
-
-13327 0311 TEXT "CIF 20"
-13330 0640
-13331 6260
-13332 0000
- 3332 *.-1
-13332 6232 6232
-13333 0311 TEXT "CIF 30"
-13334 0640
-13335 6360
-13336 0000
- 3336 *.-1
-13336 6242 6242
-13337 0311 TEXT "CIF 40"
-13340 0640
-13341 6460
-13342 0000
- 3342 *.-1
-13342 6252 6252
-13343 0311 TEXT "CIF 50"
-13344 0640
-13345 6560
-13346 0000
- 3346 *.-1
-13346 6262 6262
-13347 0311 TEXT "CIF 60"
-13350 0640
-13351 6660
-13352 0000
- 3352 *.-1
-13352 6272 6272
-13353 0311 TEXT "CIF 70"
-13354 0640
-13355 6760
-13356 0000
- 3356 *.-1
-13356 6203 6203
-13357 0304 TEXT "CDIF00"
-13360 1106
-13361 6060
-13362 0000
- 3362 *.-1
-13362 6213 6213
-13363 0304 TEXT "CDIF10"
-13364 1106
-13365 6160
-13366 0000
- 3366 *.-1
-13366 6223 6223
-13367 0304 TEXT "CDIF20"
-13370 1106
-13371 6260
-13372 0000
- 3372 *.-1
-13372 6233 6233
-13373 0304 TEXT "CDIF30"
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-6
-
-13374 1106
-13375 6360
-13376 0000
- 3376 *.-1
-13376 6243 6243
-13377 0304 TEXT "CDIF40"
-13400 1106
-13401 6460
-13402 0000
- 3402 *.-1
-13402 6253 6253
-13403 0304 TEXT "CDIF50"
-13404 1106
-13405 6560
-13406 0000
- 3406 *.-1
-13406 6263 6263
-13407 0304 TEXT "CDIF60"
-13410 1106
-13411 6660
-13412 0000
- 3412 *.-1
-13412 6273 6273
-13413 0304 TEXT "CDIF70"
-13414 1106
-13415 6760
-13416 0000
- 3416 *.-1
-13416 6204 6204
-13417 0311 TEXT "CINT"
-13420 1624
-13421 0000
-13422 6214 6214
-13423 2204 TEXT "RDF@"
-13424 0600
-13425 0000
-13426 6224 6224
-13427 2211 TEXT "RIF@"
-13430 0600
-13431 0000
-13432 6234 6234
-13433 2211 TEXT "RIB@"
-13434 0200
-13435 0000
-13436 6244 6244
-13437 2215 TEXT "RMF@"
-13440 0600
-13441 0000
-13442 6254 6254
-13443 2311 TEXT "SINT"
-13444 1624
-13445 0000
-13446 6264 6264
-13447 0325 TEXT "CUF@"
-13450 0600
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-7
-
-13451 0000
-13452 6274 6274
-13453 2325 TEXT "SUF@"
-13454 0600
-13455 0000
-13456 6550 6550
-13457 0606 TEXT "FFST"
-13460 2324
-13461 0000
-13462 6551 6551
-13463 0620 TEXT "FPINT"
-13464 1116
-13465 2400
-13466 6552 6552
-13467 0620 TEXT "FPICL"
-13470 1103
-13471 1400
-13472 6553 6553
-13473 0620 TEXT "FPCOM"
-13474 0317
-13475 1500
-13476 6554 6554
-13477 0620 TEXT "FPHLT"
-13500 1014
-13501 2400
-13502 6555 6555
-13503 0620 TEXT "FPST"
-13504 2324
-13505 0000
-13506 6556 6556
-13507 0620 TEXT "FPRST"
-13510 2223
-13511 2400
-13512 6557 6557
-13513 0620 TEXT "FPIST"
-13514 1123
-13515 2400
-13516 6561 6561
-13517 0615 TEXT "FMODE"
-13520 1704
-13521 0500
-13522 6563 6563
-13523 0615 TEXT "FMRB"
-13524 2202
-13525 0000
-13526 6564 6564
-13527 0615 TEXT "FMRP"
-13530 2220
-13531 0000
-13532 6565 6565
-13533 0615 TEXT "FMDO"
-13534 0417
-13535 0000
-13536 6567 6567
-13537 0620 TEXT "FPEP"
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 41-8
-
-13540 0520
-13541 0000
-
-
-13542 0000 NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION
-
-13742 0000 0 /TABLE TERMINATOR
-
-
- /CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
- / "ZBLOCK 200". SINCE EACH ENTRY REQUIRES 4 WORDS (THE
- / ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
- / CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
- / ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
- / AND THEIR NAMES. THESE CAN BE PATCHED IN DIRECTLY
- / USING THE PROGRAM ITSELF. **** NOTE THAT THE CONTENTS
- / OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 42
-
- /SYMBOLICS FOR FPP-12/8A INSTRUCTIONS
-
-13743 4040 MSBASE, TEXT " B+"
-13744 0253
-13745 0000
-
-13746 4540 MSINDI, TEXT "% B+"
-13747 0253
-13750 0000
-
-13751 1216 MSJNX, TEXT "JNX "
-13752 3040
-13753 4000
-
- /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
- / PLACES TO FORCE WORD ALIGNMENT AS NEEDED.
-
-13754 1405 TEXT "LEA@" /+1 WORD 0000
-13755 0100
-13756 0000
-13757 0614 FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
-13760 0401
-13761 0000
-13762 0601
-13763 0404
-13764 0000
-13765 0623
-13766 2502
-13767 0000
-13770 0604
-13771 1126
-13772 0000
-13773 0615 TEXT "FMUL@@FADDM@FSTA@@FMULM"
-13774 2514
-13775 0000
-13776 0601
-13777 0404
-14000 1500
-14001 0623
-14002 2401
-14003 0000
-14004 0615
-14005 2514
-14006 1500
-
-14007 2516 TEXT "UNUSEDSTARTE"
-14010 2523
-14011 0504
-14012 2324
-14013 0122
-14014 2405
-14015 0000
- 4015 *.-1
-14015 0616 FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
-14016 1720
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 42-1
-
-14017 0000
-14020 0605
-14021 3011
-14022 2400
-14023 0620
-14024 0125
-14025 2305
-14026 0603
-14027 1401
-14030 0000
-14031 0616
-14032 0507
-14033 0000
-14034 0616 TEXT "FNORM@STARTFSTARTDJAC@@"
-14035 1722
-14036 1500
-14037 2324
-14040 0122
-14041 2406
-14042 2324
-14043 0122
-14044 2404
-14045 1201
-14046 0300
-14047 0000
-
-14050 0114 FPXR1S, TEXT "ALN ATX XTA "
-14051 1640
-14052 0124
-14053 3040
-14054 3024
-14055 0140
-14056 0000
-
-14057 0104 FPXR2S, TEXT "ADDX *,@LDX *,@"
-14060 0430
-14061 4052
-14062 5400
-14063 1404
-14064 3040
-14065 5254
-14066 0000
-
-14067 2422 FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR "
-14070 0120
-14071 6440
-14072 2422
-14073 0120
-14074 6340
-14075 2305
-14076 2430
-14077 4040
-14100 2305
-14101 2402
-14102 4040
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 42-2
-
-14103 1223
-14104 0140
-14105 4000
-14106 1223
-14107 2240
-14110 4000
-
-14111 0521 FPCOND, TEXT "EQGELEA@NELTGTAL"
-14112 0705
-14113 1405
-14114 0100
-14115 1605
-14116 1424
-14117 0724
-14120 0114
-14121 0000
-
-
- /CONTROL TABLES FOR FPP INSTRUCTION DECODING
-
-14122 0007 FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS
-14123 0006 6
-14124 0005 5
-14125 0004 4
-14126 0003 3
-14127 0002 2
-14130 0001 1
-14131 0000 0 /END & FALL-OUT POINT
-
-14132 4756 FPPMOJ, SPCOP7
-14133 4757 SPCOP6
-14134 4747 SPCOP5
-14135 4732 SPCOP4
-14136 4731 SPCOP3
-14137 4744 SPCOP2
-14140 4717 SPCOP1
-
-14141 0170 FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE
-14142 0160 160 / 0 SPECIALS
-14143 0150 150
-14144 0140 140
-14145 0130 130
-14146 0120 120
-14147 0110 110
-14150 0100 100
-14151 0070 70
-14152 0060 60
-14153 0050 50
-14154 0040 40
-14155 0030 30
-14156 0020 20
-14157 0010 10
-14160 0000 00
-
-14161 4677 FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 42-3
-
-14162 4677 SPNUSE
-14163 4677 SPNUSE
-14164 4677 SPNUSE
-14165 4677 SPNUSE
-14166 4677 SPNUSE
-14167 4710 SPOP11
-14170 4707 SPOP10
-14171 4677 SPNUSE
-14172 4677 SPNUSE
-14173 4675 SPOP05
-14174 4670 SPOP04
-14175 4701 SPO123
-14176 4701 SPO123
-14177 4701 SPO123
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 43
-
- /MESSAGES:
-
-14200 4075 MS01, TEXT " = "
-14201 4040
-14202 0000
-
-14203 0023 MS07, 0023 /"SMASK = "
-14204 1501 MS02, TEXT "MASK = "
-14205 2313
-14206 4075
-14207 4000
-
-14210 0102 MS03, TEXT "ABS. LOC = "
-14211 2356
-14212 4014
-14213 1703
-14214 4075
-14215 4000
-
-14216 2520 MS04, TEXT "UPPER = "
-14217 2005
-14220 2240
-14221 7540
-14222 0000
-
-14223 1417 MS05, TEXT "LOWER = "
-14224 2705
-14225 2240
-14226 7540
-14227 0000
-
-14230 0617 MS06, TEXT "FORMAT = "
-14231 2215
-14232 0124
-14233 4075
-14234 4000
-
-14235 0411 MS08, TEXT "DIRECTORY"
-14236 2205
-14237 0324
-14240 1722
-14241 3100
-
-14242 1706 MS09, TEXT "OFFSET = "
-14243 0623
-14244 0524
-14245 4075
-14246 4000
-
-14247 1517 MS10, TEXT "MODE = "
-14250 0405
-14251 4075
-14252 4000
-
-14253 0303 MS11, TEXT "CCB:"
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 43-1
-
-14254 0272
-14255 0000
-
-14256 1704 MS12, TEXT "ODT LOC = "
-14257 2440
-14260 4014
-14261 1703
-14262 4075
-14263 4000
-
-14264 7240 MS13, TEXT ": "
-14265 4040
-14266 0000
-
-14267 4040 MS14, TEXT " CORE SEGS: "
-14270 0317
-14271 2205
-14272 4023
-14273 0507
-14274 2372
-14275 4040
-14276 4000
-
-14277 1417 MS15, TEXT "LOOKUP FAILED"
-14300 1713
-14301 2520
-14302 4006
-14303 0111
-14304 1405
-14305 0400
-
-14306 0620 MS16, TEXT "FPP"
-14307 2000
-
-14310 4001 MS17, TEXT " AT "
-14311 2440
-14312 0000
-
-14313 4040 MS18, TEXT " SA = "
-14314 2301
-14315 4075
-14316 4000
-
-14317 5440 MS19, TEXT ", JSW = "
-14320 4012
-14321 2327
-14322 4075
-14323 4000
-
-14324 2205 MS20, TEXT "REL. LOC = "
-14325 1456
-14326 4014
-14327 1703
-14330 4075
-14331 4000
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 43-2
-
-
-14332 2001 MS21, TEXT "PACKED"
-14333 0313
-14334 0504
-14335 0000
-
-14336 0123 MS22, TEXT "ASCII"
-14337 0311
-14340 1100
-
-14341 1723 MS23, TEXT "OS/8"
-14342 5770
-14343 0000
-
-14344 2516 MS24, 2516 /"UNSIGNED"
-
-14345 2311 MS25, TEXT "SIGNED"
-14346 0716
-14347 0504
-14350 0000
-
-14351 1703 MS26, TEXT "OCTAL"
-14352 2401
-14353 1400
-
-14354 1706 MS27, TEXT "OFFSET"
-14355 0623
-14356 0524
-14357 0000
-
-14360 2301 MS28, TEXT "SAVE"
-14361 2605
-14362 0000
-
-14363 1617 MS29, TEXT "NORMAL"
-14364 2215
-14365 0114
-14366 0000
-
-14367 1725 MS30, TEXT "OUTPUT = "
-14370 2420
-14371 2524
-14372 4075
-14373 4000
-
-14374 2004 MS31, TEXT "PDP"
-14375 2000
-
-14376 0214 MS32, TEXT "BLOCK = "
-14377 1703
-14400 1340
-14401 7540
-14402 0000
-
-14403 5140 MS33, TEXT ") "
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 43-3
-
-14404 4000
-
-14405 1417 MS34, TEXT "LOAD"
-14406 0104
-14407 0000
-
-14410 0203 MS35, TEXT "BCD"
-14411 0400
-
-14412 0231 MS36, TEXT "BYTE"
-14413 2405
-14414 0000
-
-14415 0611 MS37, TEXT "FILLER = "
-14416 1414
-14417 0522
-14420 4075
-14421 4000
-
-14422 1005 MS38, TEXT "HEADER:"
-14423 0104
-14424 0522
-14425 7200
-
-14426 5440 MS39, TEXT ", NEXT WORD = "
-14427 1605
-14430 3024
-14431 4027
-14432 1722
-14433 0440
-14434 7540
-14435 0000
-
-14436 5440 MS40, TEXT ", LOAD V "
-14437 1417
-14440 0104
-14441 4026
-14442 4000
-
-14443 5440 MS41, TEXT ", E.P. REQ'D"
-14444 0556
-14445 2056
-14446 4022
-14447 0521
-14450 4704
-14451 0000
-
-14452 4040 MS42, TEXT " OVLYS START BLOCK LENGTH"
-14453 1726
-14454 1431
-14455 2340
-14456 2324
-14457 0122
-14460 2440
-14461 0214
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 43-4
-
-14462 1703
-14463 1340
-14464 1405
-14465 1607
-14466 2410
-14467 0000
-
-14470 3023 MS43, TEXT "XS240"
-14471 6264
-14472 6000
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 44
-
- /MAIN LOOP CHARACTER LIST
-14473 0243 CCHARL, "#
-14474 0244 "$
-14475 0245 "%
-14476 0246 "&
-14477 0272 ":
-14500 0274 "<
-14501 0275 "=
-14502 0276 ">
-14503 0277 "?
-14504 0300 "@
-14505 0333 "[
-14506 0334 "\
-14507 0335 "]
-14510 0257 "/
-14511 0241 "!
-14512 0253 "+
-14513 0255 "-
-14514 0273 ";
-14515 0336 "^
-14516 0337 "_
- /'TYPE' COMMAND LIST
-14517 0211 TYPEL, 211 /TAB
-14520 0233 233 /ALT MODES
-14521 0375 375
-14522 0376 376
- /'XMODIF' CHECK LIST
-14523 0215 TYPEM, 215 /CR
-14524 0212 212 /LF
-14525 0000 0
-
- /ADDRESSES FOR 'OMODES'
-14526 3415 OTABLE, BPRT /#
-14527 3511 OSTYPE /$
-14530 3517 BYTEO /%
-14531 5352 XS240O /&
-14532 3423 SGNDP /:
-14533 3400 OPRT /<
-14534 3436 DPRT /=
-14535 4221 PDPOUT />
-14536 3163 DIROUT /?
-14537 5000 PDATE /@
-14540 2163 ASCII /[
-14541 4600 FPPOUT /\
-14542 3621 PACOUT /]
-
- /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
-14543 0255 COPSL, OMODES
-14544 0255 OMODES
-14545 0255 OMODES
-14546 0255 OMODES
-14547 0255 OMODES
-14550 0255 OMODES
-14551 0255 OMODES /SEE ABOVE LIST
-14552 0255 OMODES
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 44-1
-
-14553 0255 OMODES
-14554 0255 OMODES
-14555 0255 OMODES
-14556 0255 OMODES
-14557 0255 OMODES
-14560 0237 SLASH
-14561 0312 EXCL
-14562 0344 PLUS
-14563 0345 MINUS
-14564 0310 SEMIC
-14565 0274 UPARR
-14566 0271 BACKAR
-14567 4024 RESPC
-14570 0253 ALTMOD
-14571 0253 ALTMOD
-14572 0253 ALTMOD
-14573 0216 CRCR
-14574 0311 LFLF
-
- /'TYPE' JUMP LIST
-14575 5106 TYPEOP, TYPTAB
-14576 5101 TYPALT
-14577 5101 TYPALT
-14600 5101 TYPALT
-14601 5104 TYPCR
-14602 5105 TYPCR+1
-
- /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
-14603 0526 CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
-14604 0500
-14605 0425
-14606 0400
-14607 1411
-14610 1400
-14611 0611
-14612 0600
-14613 1720
-14614 2303
-14615 2324
-14616 2315
-14617 2717
-14620 2700
-14621 1517
-14622 1500
-14623 2310
-14624 2305
-14625 2300
-14626 2722
-14627 1106
-14630 0530
-14631 0317
-14632 0300
-14633 0000
-
- /MAIN LOOP JUMP LIST - EXECUTE A COMMAND
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 44-2
-
-14634 0400 WOPSL, XVAL
-14635 0400 XVAL
-14636 0603 XDUMP
-14637 0603 XDUMP
-14640 0632 XLIST0
-14641 0632 XLIST0
-14642 1024 XFILE
-14643 1024 XFILE
-14644 1000 XOPEN
-14645 0600 XSCAN
-14646 2216 XSTRIN
-14647 2600 XSMASK
-14650 2000 XWORD
-14651 2000 XWORD
-14652 2417 XMODIF
-14653 2417 XMODIF
-14654 1210 XSHOW
-14655 1602 XSET
-14656 1602 XSET
-14657 2400 XWRARG
-14660 1713 XIF
-14661 5160 XEXIT
-14662 0204 MAIN1 /COMMENT
-14663 0204 MAIN1
-
- /LISTS FOR COMMANDS FOLLOWED BY A CR.
-14664 2205 CWORL2, TEXT "REWRENEXCLCOC@"
-14665 2722
-14666 0516
-14667 0530
-14670 0314
-14671 0317
-14672 0300
-14673 0000
-
-14674 2200 WOPSLL, XREWIN /REWIND
-14675 2403 XWRITE /WRITE
-14676 0204 MAIN1 /END
-14677 5160 XEXIT /EXIT
-14700 1004 XCLOSE /CLOSE
-14701 0204 MAIN1 /COMMENT
-14702 0204 MAIN1
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 45
-
- /'XFORM' LISTS ----ORDER IS CRITICAL----
-14703 2001 FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
-14704 2000
-14705 0123
-14706 0100
-14707 1723
-14710 1723
-14711 3023
-14712 3000
-14713 2516
-14714 2500
-14715 2311
-14716 2300
-14717 1703
-14720 1700
-14721 0203
-14722 0200
-14723 0231
-14724 0231
-14725 2004
-14726 2004
-14727 0620
-14730 0600
-14731 0411
-14732 0400
-14733 0000
-
-14734 0740 FOPSL, XFCHR /PACKED (ASCII)
-14735 0740 XFCHR
-14736 0740 XFCHR /ASCII
-14737 0740 XFCHR
-14740 0740 XFCHR /OS/8 (ASCII, PACKED)
-14741 0740 XFCHR
-14742 0740 XFCHR /XS240 (ASCII, PACKED)
-14743 0740 XFCHR
-14744 0737 XFNUM /UNSIGNED (DECIMAL)
-14745 0737 XFNUM
-14746 0737 XFNUM /SIGNED (DECIMAL)
-14747 0737 XFNUM
-14750 0737 XFNUM /OCTAL
-14751 0737 XFNUM
-14752 0737 XFNUM /BCD
-14753 0737 XFNUM
-14754 0737 XFNUM /BYTE (OCTAL)
-14755 0737 XFNUM
-14756 0736 XFSYM /PDP (SYMBOLIC)
-14757 0736 XFSYM
-14760 0736 XFSYM /FPP (SYMBOLIC)
-14761 0736 XFSYM
-14762 0736 XFSYM /DIRECTORY
-14763 0736 XFSYM
-
- / ROUTINE ADDRESS LIST
-
-14764 3621 FTABLE, PACOUT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 45-1
-
-14765 2163 ASCII
-14766 3511 OSTYPE
-14767 5352 XS240O
-14770 3436 DPRT
-14771 3423 SGNDP
-14772 3400 OPRT
-14773 3415 BPRT
-14774 3517 BYTEO
-14775 4214 PDPDMP
-14776 4400 FPPDMP
-14777 3155 DIRDMP
-
- /'XSHFMT' DESCRIPTOR ADDRESS LIST
-15000 4332 FMTLS, MS21 /PACKED ASCII
-15001 4336 MS22 /ASCII
-15002 4341 MS23 /OS/8 ASCII
-15003 4470 MS43 /XS240 ASCII
-15004 4344 MS24 /UNSIGNED DECIMAL
-15005 4345 MS25 /SIGNED DECIMAL
-15006 4351 MS26 /OCTAL
-15007 4410 MS35 /BCD
-15010 4412 MS36 /BYTE
-15011 4374 MS31 /PDP SYMBOLIC
-15012 4306 MS16 /FPP SYMBOLIC
-15013 4235 MS08 /DIRECTORY
-
-
- /'XMODIF' COMMAND LIST
-15014 2001 MODIFL, TEXT "PAP@ASA@OSXSNUN@"
-15015 2000
-15016 0123
-15017 0100
-15020 1723
-15021 3023
-15022 1625
-15023 1600
-15024 0000
-
- /'XMODIF' JUMP LIST
-15025 2620 MODIFO, XPAC0 /PACKED
-15026 2620 XPAC0
-15027 2537 XASC1 /ASCII
-15030 2537 XASC1
-15031 2634 XOPS1 /OS/8
-15032 2617 XXS20 /XS240
-15033 2514 XNUM2 /NUMERIC
-15034 2514 XNUM2
-
-15035 2436 MODADS, XMOD0 /MODIFL TEST LIST
-15036 2436 XMOD0
-15037 2436 XMOD0
-15040 2436 XMOD0
-15041 2436 XMOD0
-15042 2436 XMOD0
-15043 2436 XMOD0
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 45-2
-
-15044 2436 XMOD0
-15045 2436 XMOD0
-
-15046 2001 MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
-15047 0123
-15050 1723
-15051 3023
-15052 1625
-15053 1625
-15054 1625
-15055 1625
-15056 1625
-15057 1625
-15060 1625
-15061 1625
-15062 0000
-
- /'XMODIF' CHARACTER JUMP LIST
-15063 2465 MCHARO, XMODCR /CR, END
-15064 4007 RENEXT /LF, IGNORE
-
- /'XIF' CHARACTER JUMP LIST
-15065 1731 IFSKPO, XIFCR /CR, END OF LINE
-15066 4007 RENEXT /LF, IGNORE
-
- /XNUM JUMP LIST
-15067 2512 NUMOPS, XNUM1 /,
-15070 5722 ERCQ /:
-15071 5722 ERCQ /.
-15072 2513 XNUM1+1 /SPACE
-15073 2524 XNUM3 /CR
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 46
-
- /'XSHOW' COMMAND LIST
-15074 0214 SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
-15075 0200
-15076 1704
-15077 0303
-15100 0300
-15101 1005
-15102 1000
-15103 0102
-15104 0100
-15105 2205
-15106 2200
-15107 2315
-15110 2605
-15111 0000
- 5111 *.-1
- /'XSET' COMMAND LIST
-15111 0404 SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
-15112 0617
-15113 0600
-15114 1725
-15115 1700
-15116 0522
-15117 0500
-15120 1706
-15121 2520
-15122 1417
-15123 2405
-15124 0405
-15125 0415
-15126 1517
-15127 0611
-15130 1501
-15131 1500
-15132 0000
-
- /'XSHOW' JUMP LIST
-15133 1200 SHOWOP, XSHBLK /BLOCK
-15134 1200 XSHBLK
-15135 1236 XSHODL /ODT LOC
-15136 1400 XSHCCB /CCB (CORE CONTROL BLOCK)
-15137 1400 XSHCCB
-15140 1455 XSHHDR /HEADER (F4 LOAD MODULE)
-15141 1455 XSHHDR
-15142 1250 XSHABS /ABS. LOC
-15143 1250 XSHABS
-15144 1243 XSHREL /REL. LOC
-15145 1243 XSHREL
-15146 1321 XSHSMS /SMASK
-15147 1216 XSHVER /VERSION
-15150 1360 XSHDDEV /DDEV
-15151 1277 XSHFMT /FORMAT
-15152 1277 XSHFMT
-15153 1314 XSHOUT /OUTPUT
-15154 1314 XSHOUT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 46-1
-
-15155 1530 XSHERR /ERRORS
-15156 1530 XSHERR
-15157 1225 XSHOFF /OFFSET
-15160 1265 XSHUPP /UPPER
-15161 1272 XSHLOW /LOWER
-15162 1215 ERCG /TEMP--NOT ALLOWED FOR SHOW
-15163 1347 XSHDEV /DEVICE
-15164 1215 ERCG /DMODE--NOT ALLOWED FOR SHOW
-15165 1307 XSHMOD /MODE
-15166 1232 XSHFIL /FILLER
-15167 1221 XSHMSK /MASK
-15170 1221 XSHMSK
-
- /'XSET' JUMP LIST
-15171 1134 SETJMP, XDDEV /DDEV (DUMP DEVICE)
-15172 0754 XFORM /FORMAT
-15173 0754 XFORM
-15174 1624 XOUTS /OUTPUT
-15175 1624 XOUTS
-15176 1647 XEMODE /ERROR (MODE)
-15177 1647 XEMODE
-15200 1642 XOFFS /OFFSET
-15201 1660 XUPP /UPPER
-15202 1663 XLOW /LOWER
-15203 1705 XTEMP /TEMP
-15204 1121 XDEV /DEVICE
-15205 1612 XDMODE /DMODE (DUMP MODE)
-15206 1666 XMODE /MODE
-15207 1701 XFILL /FILLER
-15210 1636 XMASK /MASK
-15211 1636 XMASK
-
- /'XEMODE' COMMAND LIST
-15212 2310 XELST, TEXT "SHS@LOL@"
-15213 2300
-15214 1417
-15215 1400
-15216 0000
-
- /'XEMODE' BRANCH LIST
-15217 1655 XEOPS, XEMOD1 /SHORT
-15220 1655 XEMOD1
-15221 1656 XEMOD1+1 /LONG
-15222 1656 XEMOD1+1
-
- /'XOUTS' LISTS
-15223 0620 XOLST, TEXT "FPF@PDP@OCO@"
-15224 0600
-15225 2004
-15226 2000
-15227 1703
-15230 1700
-15231 0000
-
-15232 1632 XOOPS, XOUTS1-1 /FPP SYMBOLIC
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 46-2
-
-15233 1632 XOUTS1-1
-15234 1633 XOUTS1 /PDP SYMBOLIC
-15235 1633 XOUTS1
-15236 1634 XOUTS1+1 /OCTAL
-15237 1634 XOUTS1+1
-
- /'XMODE' COMMAND LIST
-15240 1706 MODLST, TEXT "OFO@SAS@LOL@NON@"
-15241 1700
-15242 2301
-15243 2300
-15244 1417
-15245 1400
-15246 1617
-15247 1600
-15250 0000
-
- /'XMODE' JUMP LIST
-15251 1674 MODOPS, XMODS-1 /OFFSET
-15252 1674 XMODS-1
-15253 1676 XMODS+1 /SAVE FILE
-15254 1676 XMODS+1
-15255 1675 XMODS /LOAD MODULE
-15256 1675 XMODS
-15257 1677 XMODS+2 /NORMAL
-15260 1677 XMODS+2
-
- /'XDMODE' LISTS
-15261 0114 XDMLST, TEXT "ALPANO"
-15262 2001
-15263 1617
-15264 0000
-
-15265 1620 XDMOPS, XDMODS-1 /ALL
-15266 1621 XDMODS /PART
-15267 1622 XDMODS+1 /NONE
-
-
- /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"
-
-15270 4354 MS27 /-1 = "OFFSET"
-15271 4363 MODELS, MS29 / 0 = "NORMAL"
-15272 4360 MS28 /+1 = "SAVE"
-15273 4405 MS34 /+2 = "LOAD"
-
-
- /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"
-
-15274 4306 MS16 /-1 = "FPP (SYMBOLIC)"
-15275 4351 OUTLS, MS26 / 0 = "OCTAL"
-15276 4374 MS31 /+1 = "PDP (SYMBOLIC)"
-
-
- /'XWORD' COMMAND LIST
-15277 2516 XWORCL, TEXT "UNU@"
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 46-3
-
-15300 2500
-15301 0000
- 5301 *.-1
- /'XSTRIN' COMMAND LIST
-15301 0622 STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
-15302 0600
-15303 2417
-15304 2400
-15305 0102
-15306 0100
-15307 1501
-15310 1500
-15311 1505
-15312 0000
-
-
- /'XWORD' JUMP LIST
-15313 2004 XWOROP, XWOR2 /UNEQUAL
-15314 2004 XWOR2
-15315 2071 XWSFRM /FROM
-15316 2071 XWSFRM
-15317 2074 XWSTO /TO
-15320 2074 XWSTO
-15321 2066 XWSABS /ABSOLUTE
-15322 2066 XWSABS
-15323 2015 ERCH /MASKED--NO!
-15324 2016 XWOR7 /MEMREF
-15325 2016 XWOR7
-
- /'XSTRIN' JUMP LIST
-15326 2071 STROPS, XWSFRM /FROM
-15327 2071 XWSFRM
-15330 2074 XWSTO /TO
-15331 2074 XWSTO
-15332 2066 XWSABS /ABSOLUTE
-15333 2066 XWSABS
-15334 2220 XSTR0 /MASKED
-15335 2220 XSTR0
-15336 2015 ERCH /MEMREF--NO!
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 47
-
- /LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
-15337 0241 TERMS, "! /1
-15340 0246 "& /2
-15341 0253 "+ /3
-15342 0255 "- /4
-15343 0257 "/ /5
-15344 0252 "* /6
-15345 0250 "( /7
-15346 0251 ") /10
-15347 0215 215 /CR: 11
-15350 0000 0
-
- /'GWORD' & 'ACCEPT' COMMAND LISTS
-15351 0271 GWLST1, "9
-15352 0270 "8
-15353 0267 "7
-15354 0266 "6
-15355 0265 "5
-15356 0264 "4
-15357 0263 "3
-15360 0262 "2
-15361 0261 "1
-15362 0260 "0
-15363 0204 204 /^D
-15364 0213 213 /^K
-15365 0242 ""
-15366 0247 "'
-15367 0250 "(
-15370 0240 GWLST2, 240 /SPACE
-15371 0215 215 /CR
-15372 0000 0
-
- /'GWORD' JUMP LISTS
-15373 3154 GWOPS1, GWD4 / 9 - A NUMBER
-15374 3154 GWD4 / 8 - A NUMBER
-15375 3154 GWD4 / 7 - A NUMBER
-15376 3154 GWD4 / 6 - A NUMBER
-15377 3154 GWD4 / 5 - A NUMBER
-15400 3154 GWD4 / 4 - A NUMBER
-15401 3154 GWD4 / 3 - A NUMBER
-15402 3154 GWD4 / 2 - A NUMBER
-15403 3154 GWD4 / 1 - A NUMBER
-15404 3154 GWD4 / 0 - A NUMBER
-15405 3154 GWD4 /^D - A NUMBER
-15406 3154 GWD4 /^K - A NUMBER
-15407 3154 GWD4 / " - A NUMBER
-15410 3154 GWD4 / ' - A NUMBER
-15411 3154 GWD4 / ( - A NUMBER
-15412 3150 GWOPS2, GWD2 /SPACE - TERMINATOR
-15413 3151 GWD3 / CR - "
-
- /'ACCEPT' JUMP LIST
-15414 5213 ACOPS, ACCNUM / 9 - A DIGIT
-15415 5213 ACCNUM / 8 - A DIGIT
-15416 5213 ACCNUM / 7 - A DIGIT
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 47-1
-
-15417 5213 ACCNUM / 6 - A DIGIT
-15420 5213 ACCNUM / 5 - A DIGIT
-15421 5213 ACCNUM / 4 - A DIGIT
-15422 5213 ACCNUM / 3 - A DIGIT
-15423 5213 ACCNUM / 2 - A DIGIT
-15424 5213 ACCNUM / 1 - A DIGIT
-15425 5213 ACCNUM / 0 - A DIGIT
-15426 5256 CTRLD / ^D SWITCH
-15427 5257 CTRLK / ^K SWITCH
-15430 5243 DQUOTE / " - SINGLE ASCII
-15431 5246 SQUOTE / ' - PACKED ASCII
-15432 5240 ERCR / ( - ILLEGAL HERE
-15433 5234 ACCPT3-2 /SPACE - END
-15434 5235 ACCPT3-1 /CR - END
-
- /'GARGS' JUMP LIST - TERMINATORS
-15435 5317 GAROPS, GAR5 /-
-15436 5323 GAR6 /,
-15437 5307 ERCS /:, SHOULDN'T SEE, WILL DO ERROR
-15440 5314 GAR4 /.
-15441 5307 ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
-15442 5310 GAR3 /CR
-
- /'GARGS' & 'ARG' COMMAND LISTS
-15443 0255 GARLST, "-
-15444 0254 ",
-15445 0272 GETLST, ":
-15446 0256 ARGLST, ".
-15447 0240 240 /SPACE
-15450 0215 215 /CR
-15451 0000 0
-
- /'GETNT' LISTS
-15452 3723 GETOPS, GETCOL
-15453 3730 GETPER
-15454 3736 GETEND
-15455 3737 GETEND+1
-
- /'ARG' JUMP LIST
-15456 5723 ARGOPS, ARG2
-15457 5726 ARG3
-15460 5726 ARG3
-
- /'WCHEK' LISTS
-15461 0250 WCKLST, "(
-15462 0251 ")
-15463 0242 ""
-15464 0247 "'
-15465 0215 215
-15466 0000 0
-
-15467 6227 WCKOPS, WCHEK5+1
-15470 6226 WCHEK5
-15471 6233 WCHEK6+1
-15472 6232 WCHEK6
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 47-2
-
-15473 6222 WCHEK4
-
- /'EVAL' JUMP LIST 1
-15474 5470 EVOPS1, EVNEXT /+
-15475 5415 EVMIN /-
-15476 5537 EVLPAR /(
-
- /'EVAL' COMMAND LISTS
-15477 0253 EVLST1, "+
-15500 0255 "-
-15501 0250 "(
-15502 0000 0
-
-15503 0314 EVLST2, "L
-15504 0302 "B
-15505 0323 "S
-15506 0303 "C
-15507 0306 "F
-15510 0322 "R
-15511 0324 "T
-15512 0304 "D
-15513 0000 0
-
- /'EVAL' JUMP LIST 2
-15514 5527 EVOPS2, EVLOC /L (LOC)
-15515 5533 EVBLK /B (BLK)
-15516 5522 EVSR /S (S.R.)
-15517 5523 EVSR+1 /C (CONTENTS)
-15520 5525 EVFIL /F (FILLER)
-15521 5512 EVREM /R (REMAINDER)
-15522 5516 EVTEMP /T (TEMP)
-15523 5506 EVDATE /D (DATE)
-
- /ACTION CHARS FOR "READLN" SUBROUTINE
-15524 0222 REACTL, "R-100 /CTRL-R = RE-ECHO
-15525 0225 "U-100 /CTRL-U = ERASE LINE
-15526 0000 0
-
-15527 4063 REACTS, RECHO
-15530 4100 RERASE
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 48
-
- /ERROR ROUTINE ADDRESS LIST:
-
-15531 0233 ERLIST, ERCA
-15532 0227 ERCB
-15533 0402 ERCC
-15534 0605 ERC14
-15535 0735 ERCD
-15536 0755 ERCE
-15537 1215 ERCG
-15540 2015 ERCH
-15541 2011 ERCI
-15542 1605 ERCK
-15543 1673 ERCJ
-15544 1611 XSET1
-15545 1631 ERCL
-15546 1654 ERCZ
-15547 2430 ERCO
-15550 1617 ERC11
-15551 2642 ERC04
-15552 2473 ERCP
-15553 5722 ERCQ
-15554 5240 ERCR
-15555 5222 ERC09
-15556 5736 ERC08
-15557 5267 ERC13
-15560 5307 ERCS
-15561 5412 ERCT
-15562 5414 ERCU
-15563 5541 ERCV
-15564 5547 ERCW
-15565 6047 ERCX
-15566 1156 ERCY
-15567 3731 ERCM
-15570 2214 ERC00
-15571 2215 ERC01
-15572 2415 ERC02
-15573 2416 ERC03
-15574 2342 ERC10
-15575 2116 ERCF
-15576 2022 GCCERR
-15577 2101 HDRERR
-15600 3103 ERC05
-15601 2502 ERC07
-15602 2254 ERC18
-15603 2312 ERC19
-15604 2351 ERC20
-15605 0545 ERC15
-15606 0564 ERC16
-15607 4116 ERC17
-15610 0000 0
-
-
- DECIMAL
-
-15611 7777 SMASKB, -1 /STRING SEARCH MASK BUFFER
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 48-1
-
- /L(SMASKB)=66(10)
- 5713 COMB= SMASKB+66 /COMMAND INPUT BUFFER
- /L(COMB)= 140(10)
- 6127 PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER
- /**** ALSO REWIND BUFFER! ****
-15612 0251 CCBB-PDLB /SHOW PDL SPACE
-
- OCTAL
-
-
- 6400 CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER
- / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
-
- 6600 DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
-
- 7200 IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1
-
-
- $$$$
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 49
-
-ABKLOC 1741 CCHDST 1553 DEVHAN 7200 ERCH 2015
-ABK1 1747 CGET 2546 DEVNO 0101 ERCI 2011
-ABK2 1753 CGTEST 2552 DICAD 6163 ERCJ 1673
-ABSSW 0051 CHAR 0035 DIGIT 4531 ERCK 1605
-ACBASE 5242 CHARSW 0045 DIOR 5677 ERCL 1631
-ACCEPT 5200 CLANAM 2726 DIRDMP 3155 ERCM 3731
-ACCMUL 5223 CLOSE 0361 DIROUT 3163 ERCO 2430
-ACCNUM 5213 CNOP 2036 DLOOP1 0427 ERCP 2473
-ACCPT1 5206 CNT 0036 DLOOP2 0445 ERCQ 5722
-ACCPT3 5236 CNTR 0037 DMODE 0053 ERCR 5240
-ACCX1 0027 CNTRA 0040 DMPADR 2340 ERCS 5307
-ACCX2 0030 COMB 5713 DMPBLK 2341 ERCT 5412
-ACC1 0025 COMIR 0015 DMPBUF 6600 ERCU 5414
-ACC2 0026 COMOUT 0016 DMPCHR 2352 ERCV 5541
-ACOPS 5414 COMST 0174 DMPHAN 6600 ERCW 5547
-ADFLD 7000 CONDIT 6265 DMPIT 2335 ERCX 6047
-ALTMOD 0253 COPSL 4543 DMPNUL 2321 ERCY 1156
-ALTM1 0261 CRCR 0216 DMPOUT 2315 ERCZ 1654
-ARG 5713 CRCRC 0235 DMPPTR 2353 ERC00 2214
-ARGI 0160 CRCRN 0234 DMUL 6000 ERC01 2215
-ARGLST 5446 CRCR1 0230 DMUL1 6004 ERC02 2415
-ARGOPS 5456 CRLF 5044 DMUL2 6021 ERC03 2416
-ARG1 5715 CRLFI 0130 DMUL3 6031 ERC04 2642
-ARG2 5723 CRSWT 0046 DMUL4 6014 ERC05 3103
-ARG3 5726 CTRL 5125 DNAM 2266 ERC07 2502
-ASCII 2163 CTRLC 5160 DODIG 4161 ERC08 5736
-BACKAR 0271 CTRLCI 5162 DOFLD 4742 ERC09 5222
-BASE 4622 CTRLD 5256 DO1SP 2561 ERC10 2342
-BATINI 4051 CTRLI 0134 DO2SP 2565 ERC11 1617
-BATLS 6657 CTRLK 5257 DPNEG 6141 ERC13 5267
-BATLUP 6621 CTRLQS 5167 DPNT 0010 ERC14 0605
-BATMOV 6615 CTRLX 5163 DPRT 3436 ERC15 0545
-BATPAT 6624 CTRL0 5127 DPSGN 0001 ERC16 0564
-BATSET 6600 CTRL1 5143 DQUOTE 5243 ERC17 4116
-BCTRLC 5135 CTRL2 5150 DSUB 5662 ERC18 2254
-BITPNT 4471 CWORDL 4603 DSWIT 0052 ERC19 2312
-BITS 4456 CWORL2 4664 EAE 4311 ERC20 2351
-BITVAL 4522 C100 5124 EAELST 2664 ERLIST 5531
-BKLOC 3105 DADD 5650 EAETMP 4332 ERMODE 0020
-BKLOCI 0146 DAND 5667 EBLK 2104 ERMSA 0062
-BLK 0057 DBLPGS 3063 ECLOSE 0353 ERMSB 0100
-BLKTST 6154 DCAICA 4555 ELOCH 2105 ERMSC 0116
-BPRT 3415 DDCWPT 2265 ELOCL 2106 ERMSD 0125
-BTEST 4103 DDEVAD 2263 EMSEND 0060 ERMSE 0137
-BUFST 3041 DDEVNO 2264 ENDC 4141 ERMSF 0150
-BYTEO 3517 DDEVS 2430 ENDCI 0170 ERMSG 0227
-CAD 0056 DDIV 6040 ENUM 5472 ERMSGC 0171
-CALUSR 4552 DDIV1 6051 ENUMX 5501 ERMSH 0242
-CBATE 6736 DDIV2 6064 ERCA 0233 ERMSHD 0207
-CBATI 6707 DDIV3 6072 ERCB 0227 ERMSI 0256
-CBATO 6746 DECI 0137 ERCC 0402 ERMSJ 0267
-CBLK 0054 DEC2 3445 ERCD 0735 ERMSK 0276
-CCBB 6400 DEC2I 0141 ERCE 0755 ERMSL 0341
-CCBHDR 2106 DEVAD 0100 ERCF 2116 ERMSM 0361
-CCHARL 4473 DEVADX 2140 ERCG 1215 ERMSO 0404
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 49-1
-
-ERMSP 0417 EVREM 5512 GET 3000 INSLST 2600
-ERMSQ 0435 EVSR 5522 GETCOL 3723 IOBUF 7200
-ERMSR 0456 EVTAB 5566 GETCW 3360 IOPNT 4544
-ERMSS 0501 EVTEMP 5516 GETEND 3736 IOPRNT 4523
-ERMST 0523 EXCL 0312 GETI 0161 IOPRN1 4525
-ERMSU 0543 EXCL1 0317 GETIO 3027 IOPRN2 4542
-ERMSV 0564 EXCL2 0336 GETIO1 3044 IOTS 4257
-ERMSW 0604 EXPRIN 5727 GETIO2 3061 IOTTAB 2732
-ERMSX 0622 EXPRI1 5735 GETLST 5445 LASTOP 0002
-ERMSXO 0322 FBKLEN 1036 GETL1 3300 LBLK 0065
-ERMSY 0636 FCNT 0042 GETL2 3302 LCHEK 2147
-ERMSZ 0651 FILLER 0074 GETL3 3345 LFLF 0311
-ERMS00 0673 FLD 7026 GETL4 3351 LIMITI 0165
-ERMS01 0671 FLDOUT 6277 GETN 5362 LIMITS 2752
-ERMS02 0706 FMTLS 5000 GETNI 0163 LISTPT 0725
-ERMS03 0704 FOPSL 4734 GETNT 3741 LLIST 0661
-ERMS04 0717 FOP134 4067 GETNTC 3746 LLIS1 0664
-ERMS05 0742 FORML 4703 GETOP 6243 LLIS2 0702
-ERMS07 0764 FPCOND 4111 GETOPS 5452 LLIS3 0712
-ERMS08 1003 FPLEA 4611 GETORG 3357 LLIS4 0717
-ERMS09 1030 FPOP00 4015 GETPER 3730 LLIS5 0722
-ERMS10 1037 FPPDMP 4400 GETPNT 0014 LLOCH 0066
-ERMS11 1051 FPPINS 3757 GETSCN 3717 LLOCL 0067
-ERMS13 1071 FPPMOJ 4132 GETSWX 2141 LOCH 0060
-ERMS14 1104 FPPMO0 4122 GETS1 3214 LOCL 0061
-ERMS15 1124 FPPOPJ 4161 GETS2 3261 LONG 4640
-ERMS16 1135 FPPOP0 4141 GETX 3026 LOUTSW 0726
-ERMS17 1151 FPPOUT 4600 GET0 3010 LPAR 5616
-ERMS18 1163 FPRNT 1363 GET1 3013 LPARI 5564
-ERMS19 1172 FPRNTX 7011 GET4 3200 LSETL 2127
-ERMS20 1201 FPXR1S 4050 GET678 6251 LSETUP 2107
-ERMS99 1212 FPXR2S 4057 GHDR 2050 MAIN1 0204
-ERROR 4573 FSTBLK 1035 GHDR1 2102 MAIN2 0212
-ERROR1 2433 FTABLE 4764 GNAME 3676 MASK 0075
-EVAL 5400 F0END 6572 GPAIR 3751 MASKBS 0176
-EVALI 0147 GARGI 0157 GPUT 5326 MCHARO 5063
-EVALX 5557 GARGS 5272 GPUT1 5335 MDCOM 6112
-EVAL1 5407 GARLST 5443 GWD1 3143 MINUS 0345
-EVAL2 5413 GAROPS 5435 GWD2 3150 MODADS 5035
-EVAL3 5423 GAR1 5276 GWD3 3151 MODDLS 5046
-EVBLK 5533 GAR2 5302 GWD4 3154 MODELS 5271
-EVDATE 5506 GAR3 5310 GWLST1 5351 MODIF 0050
-EVFIL 5525 GAR4 5314 GWLST2 5370 MODIFL 5014
-EVLOC 5527 GAR5 5317 GWOPS1 5373 MODIFO 5025
-EVLPAR 5537 GAR6 5323 GWOPS2 5412 MODLST 5240
-EVLST1 5477 GCCB 2000 GWORD 3122 MODOPS 5251
-EVLST2 5503 GCCBLK 2130 GWORDI 0156 MODSW 0044
-EVMIN 5415 GCCB1 2026 HDRERR 2101 MODTMP 2477
-EVNEXT 5470 GCCB2 2042 IFSKPO 5065 MONTHS 2521
-EVOP 5446 GCCCDF 2046 INC 3557 MSBAD 2145
-EVOPN 5554 GCCERR 2022 INCI 0166 MSBASE 3743
-EVOPS1 5474 GDEVIC 1140 INDIR 4631 MSDDEV 2450
-EVOPS2 5514 GDEV1 1153 INIDAT 6322 MSDEV 2457
-EVPAR 5456 GDEV2 1154 INIMSG 6306 MSERR 2500
-EVPAR2 5542 GDEV3 1155 INISCO 6315 MSINDI 3746
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 49-2
-
-MSJNX 3751 M400 0103 OUTLS 5275 R2 4053
-MSMOD 2142 NAM1 0025 OUTPNT 0043 SBLK 0070
-MSVER 2512 NAM2 0026 OUTSW 0765 SCANER 5744
-MS01 4200 NAM3 0027 OVLFLG 0000 SCANX1 0012
-MS02 4204 NAM4 0030 PACK 2704 SCANX2 0013
-MS03 4210 NCNT 0041 PACK1 2716 SCOPLS 6630
-MS04 4216 NUMB 3500 PACOUT 3621 SEGCNT 3361
-MS05 4223 NUMDGT 3501 PATCH 0001 SEGNI 2127
-MS06 4230 NUMOPS 5067 PDATE 5000 SEMIC 0310
-MS07 4203 NUMOUT 3453 PDATEI 0142 SETJMP 5171
-MS08 4235 NUMO1 3455 PDLB 6127 SETLST 5111
-MS09 4242 NUMO2 3466 PDLPT 0007 SGNDP 3423
-MS10 4247 NXTIOT 3542 PDPDMP 4214 SHOWL 5074
-MS11 4253 NXTOCT 1766 PDPOUT 4221 SHOWOP 5133
-MS12 4256 N15 0114 PLUS 0344 SHUT 0047
-MS13 4264 N177 0117 PNAME 2731 SLASH 0237
-MS14 4267 N20 0115 PNAME1 2744 SLA1 0244
-MS15 4277 N200 0120 POP 4551 SLOCH 0071
-MS16 4306 N377 0121 POPX 5606 SLOCL 0072
-MS17 4310 N7 0113 PUSH 4550 SLO1 0245
-MS18 4313 N7000 0122 PUSHX 5600 SLO2 0246
-MS19 4317 N7400 0103 QUOTEC 5265 SMASKB 5611
-MS20 4324 N77 0116 RBLK 3057 SMASKL 0076
-MS21 4332 OCTI 0140 RBLK1 0077 SMSKSW 2360
-MS22 4336 OCTSET 5261 RDERX 2136 SOCTI 0145
-MS23 4341 OCT3 3407 REACTL 5524 SORTEM 3675
-MS24 4344 ODGET 3073 REACTS 5527 SORTI 0167
-MS25 4345 ODGETI 0162 READ 4000 SORTJ 3643
-MS26 4351 ODTOL 4212 READLN 4523 SORT1 3652
-MS27 4354 ODTOPT 4204 RECHO 4063 SORT2 3673
-MS28 4360 ODTOUT 4200 RECHO1 4070 SPACE1 4532
-MS29 4363 OFFSET 0073 RECRLF 0171 SPACE2 4533
-MS30 4367 OMODES 0255 REFS1 4244 SPCOP0 4660
-MS31 4374 OMODPT 0270 REFS2 4255 SPCOP1 4717
-MS32 4376 ONECHR 3631 REKEY 4011 SPCOP2 4744
-MS33 4403 OPEND 4446 RENEXT 4007 SPCOP3 4731
-MS34 4405 OPER1 0031 RERASE 4100 SPCOP4 4732
-MS35 4410 OPER2 0032 RERROR 2213 SPCOP5 4747
-MS36 4412 OPRMES 2730 RESPC 4024 SPCOP6 4757
-MS37 4415 OPRS 4262 RESTAR 0172 SPCOP7 4756
-MS38 4422 OPRS1 4275 RETERM 4020 SPECIA 4654
-MS39 4426 OPRT 3400 RKEY 4112 SPNT 0011
-MS40 4436 OPRTST 4547 RKEY0 4126 SPNUSE 4677
-MS41 4443 OPRTYP 4467 RKEY1 4137 SPOP00 4665
-MS42 4452 OPR1A 4333 RLAST 4054 SPOP04 4670
-MS43 4470 OPR2A 4405 RM214 4052 SPOP05 4675
-MULNEG 6126 OPR2B 4424 RTL6 3762 SPOP1J 4737
-MULT3 6257 OPR2T 4515 RTL6I 0143 SPOP10 4707
-M1 0112 OP1LST 2620 RTR6 3767 SPOP11 4710
-M10 0111 OP2LST 2642 RTR6I 0144 SPO123 4701
-M100 0107 OSRETN 3535 RUBO 4031 SQUOTE 5246
-M20 0110 OSSET 3527 RUBOE 4057 SSET 2047
-M200 0106 OSTYPE 3511 RUBOF 4061 SSKIP 3502
-M215 0105 OSUNPK 3540 RUBO1 4035 SSKIPI 0164
-M240 0104 OTABLE 4526 RUBO2 4047 START 6400
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 49-3
-
-STCDF 6211 TYPEOP 4575 XDMLST 5261 XOCEX 2261
-STDEV 6426 TYPES 3600 XDMODE 1612 XOFFS 1642
-STERR 6551 TYPEX 5042 XDMODS 1621 XOLST 5223
-STJMP 5757 TYPE1 2400 XDMOPS 5265 XOOPS 5232
-STRLST 5301 TYPE2 2412 XDNAM 2464 XOPEN 1000
-STRMSK 2357 TYPE3 2431 XDUMP 0603 XOPEN1 2222
-STROPS 5326 TYPSI 0125 XDUM0 0610 XOPEN2 2237
-STSWEX 6532 TYPSTI 0124 XDUM1 0611 XOPS1 2634
-STSWIT 6471 TYPSTR 3605 XDUM2 0617 XOPS2 2643
-STSWO 6507 TYPSW 0017 XELST 5212 XOPS3 2655
-STSWS 6520 TYPTAB 5106 XEMODE 1647 XOPS4 2673
-STTLS 6536 UBLK 0062 XEMOD1 1655 XOPS5 2675
-SYMEND 4256 UCDF0 0525 XEOPS 5217 XOSIZ 2253
-SYMLIM 4433 ULOCH 0063 XERROR 0454 XOUTS 1624
-SYMNXT 4504 ULOCL 0064 XERR1 0465 XOUTS1 1633
-SYMPNT 4514 UPARR 0274 XERR2 0475 XPAC0 2620
-SYMS 4226 UPARR1 0306 XERR3 0505 XPAC1 2621
-SYMTYI 6276 UPCBLK 3362 XERR4 0515 XPAC2 2627
-SYMTYP 4475 USEUSR 0520 XEXIT 5160 XREWIN 2200
-TADICA 4554 USRAD 0102 XFCHR 0740 XROUT 4713
-TADIDP 4553 USRCDF 0541 XFICHN 1026 XRPLUS 4643
-TCHAR 5077 USRIN 0536 XFIERR 1006 XRSET 2343
-TEMP 0021 USROUT 0544 XFILE 1024 XSCAN 0600
-TEMPL 6306 USRSAV 0544 XFILEN 1021 XSET 1602
-TEMPST 0175 VERONE 0010 XFILL 1701 XSETN 1600
-TEMPV1 0033 VERSIO 0010 XFIOUT 1016 XSET1 1611
-TEMPV2 0034 VERTEN 0000 XFNUM 0737 XSHABS 1250
-TEMP1 0022 WBLK 3042 XFORM 0754 XSHBKS 1257
-TEMP2 0023 WCHEK 6200 XFSYM 0736 XSHBLK 1200
-TEMP3 0024 WCHEK1 6203 XGET 2500 XSHCCB 1400
-TERMS 5337 WCHEK2 6211 XGFORM 0727 XSHCC1 1414
-TERMT 5624 WCHEK3 6215 XIF 1713 XSHCC2 1416
-TERMTE 5646 WCHEK4 6222 XIFCR 1731 XSHCC4 1445
-TERMTI 5565 WCHEK5 6226 XIFSKP 1723 XSHCR 1204
-TERMT1 5633 WCHEK6 6232 XLIST0 0632 XSHDDE 1360
-THISOP 0003 WCHONE 6235 XLIS1 0633 XSHDEV 1347
-TICAD 6170 WCKLST 5461 XLIS2 0645 XSHERR 1530
-TIDPNT 2156 WCKOPS 5467 XLOCH 2365 XSHER1 1537
-TTAGN 3607 WERROR 2414 XLOCL 2366 XSHFIL 1232
-TWOCI 0127 WOPSL 4634 XLOW 1663 XSHFM 1303
-TWOCS 1761 WOPSLL 4674 XMASK 1636 XSHFMT 1277
-TWOT 0135 XASC1 2537 XMODCR 2465 XSHHDR 1455
-TYPALT 5101 XBLK 2364 XMODDN 2474 XSHHD1 1477
-TYPC 5076 XCLNAM 2310 XMODE 1666 XSHHD2 1502
-TYPCR 5104 XCLOSE 1004 XMODEF 2431 XSHLOW 1272
-TYPCTL 5120 XCLOS1 2272 XMODIF 2417 XSHMOD 1307
-TYPE 5061 XCLSIZ 2311 XMODS 1675 XSHMSK 1221
-TYPEA 5033 XCTLZ 2277 XMOD0 2436 XSHODL 1236
-TYPEAI 4056 XDDEV 1134 XMOD1 2441 XSHOFF 1225
-TYPEB 2405 XDDEV1 2200 XMOD2 2451 XSHOUT 1314
-TYPEC 5054 XDDEV2 2441 XNUM0 2506 XSHOW 1210
-TYPECI 0126 XDDNAM 2454 XNUM1 2512 XSHREL 1243
-TYPEI 0136 XDEV 1121 XNUM2 2514 XSHSMS 1321
-TYPEL 4517 XDEVM 2467 XNUM3 2524 XSHSM1 1332
-TYPEM 4523 XDLCOM 0647 XOBLK 2252 XSHSM2 1342
- /FUTIL - FILE UTILITY - V08A PAL8-V10D NO DATE PAGE 49-4
-
-XSHUPP 1265
-XSHVER 1216
-XSMASK 2600
-XSMAS1 2605
-XSTRIN 2216
-XSTR0 2220
-XSTR1 2232
-XSTR10 2333
-XSTR11 2336
-XSTR2 2240
-XSTR3 2246
-XSTR4 2260
-XSTR5 2277
-XSTR6 2302
-XSTR7 2306
-XSTR8 2321
-XSTR9 2324
-XSTYPE 1203
-XS240O 5352
-XTEMP 1705
-XUPP 1660
-XVAL 0400
-XWBLK 2410
-XWORC 2033
-XWORCL 5277
-XWORD 2000
-XWOROP 5313
-XWOR1 2006
-XWOR2 2004
-XWOR3 2021
-XWOR4 2027
-XWOR5 2045
-XWOR7 2016
-XWRARG 2400
-XWRITE 2403
-XWSABS 2066
-XWSFRM 2071
-XWSRET 2100
-XWSTO 2074
-XXS20 2617
-YRBASE 5032
-YRTEST 5031
-
-
-ERRORS DETECTED: 0
-LINKS GENERATED: 165
-
-
DELETED src/os8-v3f/FUTIL.PA
Index: src/os8-v3f/FUTIL.PA
==================================================================
--- src/os8-v3f/FUTIL.PA
+++ /dev/null
@@ -1,5789 +0,0 @@
-/FUTIL - FILE UTILITY - V08A
-
-DECIMAL
-VERSION=08
-OCTAL
-PATCH="A&77
-
-/ OS/8 FILE UTILITY PROGRAM. ALLOWS EXAMINATION AND
-/ MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
-/ SOLE. DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
-/ TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
-/ UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
-/ OS/8 PACKED ASCII. LISTING AND DUMPING CAN ALSO BE DONE
-/ IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
-/ SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
-/ FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
-/ WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.
-
-/BY: JIM CRAPUCHETTES
-/ MENLO COMPUTER ASSOCIATES, INC.
-/ (FORMERLY: FRELAN ASSOCIATES)
-/ P.O. BOX 298
-/ MENLO PARK, CALIF. 94025
-/
-/
-/VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
-/ LAST REVISION--APRIL 1970.
-/
-/VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
-/ "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
-/ & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
-/ IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
-/ ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
-/VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
-/ "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
-/ WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
-/ SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
-/ "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
-/ RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
-/ "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
-/ EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
-/ XS240 FORMATS
-/VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
-/VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
-/ (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
-/VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
-/VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
-/ IF/END COMMANDS, ALPHA DATE.
-/
-/PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
-/ DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
-/ VERSION 7 PATCHES:
-/ 1.CTRL/U CRASH & OVERLAY MAPPING IN SAVE MODE(7A TO 7B)
-/ 2.FIXED SHOW CCB PROBLEM(7B TO 7C)
-/ 3.ODT MAPPING ON LD. MODULES(7C TO 7D)
-/ 4.ADDED SHOW CCB SUPPORT FOR KT8A SAVE IMAGES(7D TO 7E)
- / SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
-/ DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
-/ THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
-/ ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
-/ EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
-/ TION.
-/ THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
-/ MODIFIED VERSION OF DECUS 8-115A.
-
-
-/ ASSEMBLY INFORMATION:
-/
-/ .R PAL8 [VERSION 9]
-/ *FUTIL<FUTIL/L/K/P=6400$
-/ .SA ... FUTIL
-/
-/ THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
-/ ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
-/ 960 BLOCKS. CREFING REQUIRES EITHER "/M" OR "/X" FOR
-/ CREF V3.
-
-
-/MEMORY ALLOCATION:
-/
-/00000-06310 PROGRAM PROPER
-/06310-06577 ARGUMENT STRING BUFFER
-/06400-06777 --- ONCE ONLY CODE FOR CHAIN ---
-/06600-07177 DDEV HANDLER AREA, 2 PAGES
-/07200-07577 DEVICE HANDLER AREA, 2 PAGES
-/
-/10000-11777 USR AREA & ERROR MESSAGES (SWAPPED)
-/12000-12377 CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
-/12600-15700 TEXT STRINGS, LISTS
-/15700-16377 STRING MASK, COMMAND BUFFERS, PDL
-/16400-16577 CCB BUFFER, 1 PAGE
-/16600-17177 DDEV BUFFER, 2 PAGES
-/17200-17577 I/O BUFFER, 2 PAGES
- /PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES
-
-
-*0
-
-OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES
-
-DPSGN, 0
-LASTOP, 0
-THISOP, 0
-
-ZBLOCK 3 /USED BY ODT
-
-/VARIABLES & SWITCHES
-PDLPT, 0 /P.D.L. POINTER
-DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION)
-SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
-SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
-SCANX2, 0 /USED BY 'XSTRIN'
-GETPNT, 0 /USED BY 'GET' & 'BKLOC'
-COMIR, 0 /USED FOR USER LINE INPUT
-COMOUT, COMB-1 /USED FOR USER LINE SCAN
-TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT)
-ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG)
-
-TEMP, 0
-TEMP1, 0
-TEMP2, 0
-TEMP3, 0
-ACC1, 0 /24 BIT ACCUMULATORS
-ACC2, 0
-ACCX1, 0
-ACCX2, 0
-
-NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER:
-NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A
-NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE)
-NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION.
-
-OPER1, 0
-OPER2, 0
-
-TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR
-TEMPV2, 0 / "SET TEMP ..." & "EVAL T"
-
-CHAR, 0
-CNT, 0
-CNTR, 0
-CNTRA, 0
-NCNT, 0 /LINE POSITION COUNTER
-FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII)
-OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE
-MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
-CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH
-CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE
-SHUT, 0 /= -1 IF SOMETHING OPEN
-MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED
-ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
-DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
-DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000
-
-CBLK, 0 /= CURRENT BLOCK
- 0 /DUMMY FOR "SHOW ABS"
-CAD, 0 /= CURRENT ADDRESS (0 -> 377)+IOBUF
-BLK, 0 /= "BLOCK"
-LOCH, 0
-LOCL, 0 /= "LOCATION" (DISPLACEMENT)
-UBLK, 0 /UPPER LIMIT FOR SEARCHES
-ULOCH, 1
-ULOCL, 7577
-LBLK, 0 /LOWER LIMIT FOR SEARCHES
-LLOCH, 0
-LLOCL, 200
-SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES
-SLOCH, 0
-SLOCL, 0
-
-OFFSET, 0 /OFFSET
-FILLER, 0 /FILLER CONSTANT FOR "MODIFY"
-MASK, -1 /MASK FOR WORD SEARCH
-SMASKL, -1 /= -(LENGTH OF SMASK)
-RBLK1, 0 /START BLOCK OF FILE
-DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS")
-DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS")
-USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT
- /7700=MSGS IN; 0=NONE IN; 200=USR IN
-
-/CONSTANTS
-M400, -400
-M240, -240
-M215, -215
-M200, -200
-M100, -100
-M20, -20
-M10, -10
-M1, -1
-N7, 7
-N15, 15
-N20, 20
-N77, 77
-N177, 177
-N200, 200
-N377, 377
-N7000, 7000
-N7400= M400
-
-/ADDRESSES
-READLN= JMS I . /GET NEXT INPUT LINE, WITH
- READ / SPECIAL TERMINATORS
-TYPSTI, TYPSTR
-TYPSI, TYPES
-TYPECI, TYPEC
-TWOCI, TWOCS
-CRLFI, CRLF
-DIGIT= JMS I . /OUTPUT AN ASCII DIGIT
- DODIG
-SPACE1= JMS I . /OUTPUT 1 SPACE OR ...
- DO1SP
-SPACE2= JMS I . /OUTPUT 2 SPACES
- DO2SP
-CTRLI, CTRL
-TWOT, PACOUT
-TYPEI, TYPE
-DECI, DPRT
-OCTI, OPRT
-DEC2I, DEC2
-PDATEI, PDATE
-RTL6I, RTL6
-RTR6I, RTR6
-SOCTI, OCTSET
-BKLOCI, BKLOC
-EVALI, EVAL
-
-PUSH= JMS I . /PUSH AC ON P.D.L.
- PUSHX
-POP= JMS I . /POP P.D.L. INTO AC
- POPX
-CALUSR= JMS I . /DO USR FUNCTION
- USEUSR
-TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1
- TIDPNT
-TADICAD= JMS I . /"TAD I CAD" IN FIELD 1
- TICAD
-DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1
- DICAD
-
-GWORDI, GWORD
-GARGI, GARGS
-ARGI, ARG
-GETI, GET
-ODGETI, ODGET
-GETNI, GETN
-SSKIPI, SSKIP
-LIMITI, LIMITS
-INCI, INC
-SORTI, SORTJ
-ENDCI, ENDC
-RECRLF, MAIN1-1
-RESTAR, MAIN1
-
-ERROR= JMS I .
- XERROR
-
-COMST, COMB-1
-TEMPST, TEMPL-1
-MASKBS, SMASKB-1
-
-
-PAGE
- /PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS
-/INTO COMMAND BUFFER UNTIL END IS REACHED.
-
- DCA USRAD /CLEAR ON RESTART (NOTHING IN)!
- TLS /RAISE TELETYPE FLAG
- DCA SHUT /NOTHING IS OPEN
- JMS I CRLFI /OUTPUT CR-LF.
-MAIN1, JMS I SOCTI /SET INPUT TO OCTAL; EXEC 'COMMENT'
- DCA DSWIT /RESET DUMP OUTPUT SWITCH
- TAD COMST /INIT COMMAND BUFFER.
- DCA COMIR
- TAD (PDLB+1 /INIT PUSH-DOWN-LIST
- DCA PDLPT
-MAIN2, READLN /GET A LINE FROM INPUT.
- CCHARL-1 /CR LF ; ! / ALT-
- COPSL-CCHARL / MODES ETC...
- JMP MAIN1 /BUFFER WAS EMPTIED.
-
-
-/ROUTINE TO HANDLE CARRIAGE RETURN.
-CRCR, JMS I ENDCI /PUT A CR IN BUFFER
- JMP CRCRC /ONLY A CR IN BUFFER
- JMS I GWORDI /GET COMMAND WORD
- JMP CRCRN /BUFFER BEGINS WITH A #
- ISZ CRSWT /WORD ENDED BY A CR?
- JMP CRCR1 /YES, ONLY A FEW ARE OK
- JMS I SORTI /NO, LOOK UP COMMAND
- CWORDL-1
- WOPSL-CWORDL
-ERCB, ERROR /NOT A LEGAL COMMAND
-/
-CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT"
- CWORL2-1
- WOPSLL-CWORL2
-ERCA, ERROR /SOMETHING NOT LEGAL
-/
-CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN
-CRCRC, DCA SHUT / MARK LOCATION CLOSED
- JMP MAIN1
-
-/ROUTINE TO HANDLE SLASH
-SLASH, JMS I ENDCI /END BUFFER WITH A CR
- JMP SLA1 /OPEN LAST, CR ONLY
- JMS WCHEK /DOES LINE START W. A WORD?
- JMS I LIMITI /NO, GET ARG--
- SBLK / & SLOCH & SLOCL
-SLA1, SPACE1 /OUTPUT SPACE
-SLO1, JMS ODTOUT /GET THE WORD & OUTPUT
-SLO2, SPACE1 /FOLLOWED BY 2 SPACES
- SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND
- JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE)
- STA
- JMP CRCRC /GO MARK LOCATION OPEN
-
-/ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
-ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY
- JMP ALTM1 / 'FORMAT' OPTION.
-
-/ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
-/ SPECIFIED FORMAT AND THEN RE-OPEN. THE ROUTINE HANDLES:
-/ # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
-/ : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
-/ > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
-/ ] (PACKED ASCII) AND ? (DIRECTORY).
-/
-OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST
- TAD (OTABLE-1-CCHARL
- DCA DPNT /POINT INTO ADDR TABLE,
- TADIDP / GET OUTPUT ROUTINE ADDR,
-ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE.
- JMS ECLOSE /CLOSE THIS LOCATION
- SPACE1 /OUTPUT SPACE
- DCA CHARSW /RESET UNPACK SWITCH
- JMS I ODGETI /GET WORD
- JMS I OMODPT /OUTPUT IN DESIRED FORMAT
- JMP SLO2 /AND GO REOPEN.
-OMODPT, 0
-
-/ROUTINE TO HANDLE BACKARROW.
-BACKAR, JMS ECLOSE /CLOSE THIS LOCATION
- TADICAD /GET THE CONTENTS,
- JMP UPARR1 /AND USE THEM AS THE ADDR
-
-/ROUTINE TO HANDLE UPARROW.
-UPARR, JMS ECLOSE /CLOSE THIS LOCATION
- TADICAD /IS THIS A 'PAGE 0' REF.?
- AND N200
- SZA CLA
- TAD SLOCL /YES, USE PAGE BITS
- AND M200 / MASK PAGE OR 0 TO PAGE #
- DCA SLOCL / & SAVE IT
- TADICAD /GET THE CONTENTS,
- AND N177 /AND USE THE ADDRESS BITS.
- TAD SLOCL / ALONG WITH PAGE BITS
-UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR
- JMP EXCL2 /NOW GO FINISH
- /ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.
-
-SEMIC, DCA I TYPEI /SET NO-OUTPUT SWITCH-V7B
-LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT
-EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
- JMS ECLOSE /CLOSE THIS LOCATION
- IAC
- DCA ACC1 /SET UP D.P. INCREMENT
- DCA ACC2
-EXCL1, DCA DPSGN /(FOR SAFETY)
- ISZ OMODPT /INCREMENT OR DECREMENT?
- JMS DPNEG / DECREMENT, NEGATE VALUE
- CLL
- TAD ACC1
- TAD SLOCL /UPDATE LOCATION TO 15 BITS
- DCA SLOCL
- RAL
- TAD ACC2
- TAD SLOCH
- AND N7 / (BUT ONLY 15 BITS)
- DCA SLOCH
- TAD I TYPEI / ANY OUTPUT?-V7B
- SNA CLA
- JMP SLO2+1 / NO, WAS ";" DO ONE SPACE
-EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE
- JMS I BKLOCI /OUTPUT ADDRESS
- SBLK-1
- JMS I TWOCI /OUTPUT "\ "
- 3440
- JMP SLO1 /NOW GO OPEN NEXT LOCATION
-
-/ROUTINE TO HANDLE PLUS & MINUS.
-PLUS, STA /"+", SET SWITCH
-MINUS, DCA OMODPT /"-", CLEAR SWITCH
- JMS I ENDCI /END BUFFER, TEST
- JMP EXCL2 /NO ARG, DO SAME AGAIN
- JMS WCHEK /LINE START WITH A COMMAND?
- JMS I ARGI /NO, GET AN ARG
- JMP EXCL1 /UPDATE LOC & GO OPEN
-
-
-ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG.
- JMS I ENDCI /END BUFFER WITH A CR.
- JMP I ECLOSE /ONLY A CR IN BUFFER, DONE
- JMS WCHEK /DOES LINE START W. A WORD?
- JMS CLOSE /ARG IN BUFFER, USE IT
- JMP I ECLOSE /DONE
-
-CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION
- JMS I ARGI /GET ONE ARG
- ISZ SHUT /ANYTHING OPEN?
- JMP I CLOSE /NO, RETURN
- JMS I ODGETI /YES, SET UP THINGS RIGHT
- STA
- DCA MODIF /SET MODIFY FLAG
- TAD ACC1 /USE "LOC" AS DATA
- DCAICAD /STORE IT
- JMP I CLOSE
-
-
-PAGE
- /ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
-/ EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
-/ DECIMAL.
-XVAL, JMS I EVALI /GO EVALUATE
- SKP /TERMINATED BY A CR
-ERCC, ERROR / SORRY!--TOO MANY ")"S
- JMS I TWOCI /"= "
- 7540
- TAD ACC2
- JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL
- TAD ACC1
- JMS I OCTI /OUTPUT LOW ORDER IN OCTAL
- TAD ACCX1 /SAVE REMAINDER FOR LATER
- DCA COMIR
- TAD ACCX2
- DCA COMOUT
- TAD (-7
- DCA XERROR /MUST DEVELOP 7 DIGITS
- JMS I TWOCI /OUTPUT " ("
- 4050
- TAD ACC2 /IS DPAC NEG?
- SMA CLA
- JMP DLOOP1-1 /NO, OUTPUT " "
- JMS DPNEG /YES, MAKE IT POSITIVE
- TAD N15 / AND OUTPUT "-".
- SPACE1
-DLOOP1, TAD (12 /RESET DIVISOR TO 10(10)
- DCA OPER1
- DCA OPER2
- JMS DDIV /GO DIVIDE DPAC BY 10(10)
- TAD ACCX1 / GET REMAINDER
- PUSH /PUT IT ON PUSH-DOWN-LIST
- ISZ XERROR /DONE YET?
- JMP DLOOP1
- TAD COMOUT /YES, RESTORE REMAINDER
- DCA ACCX2
- TAD COMIR
- DCA ACCX1
- TAD (-7
- DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS
-DLOOP2, POP / IN REVERSE ORDER!
- DIGIT /MAKE REMAIN A DIGIT
- ISZ XERROR /DONE?
- JMP DLOOP2
- JMS I TYPECI /YES, OUTPUT ")"
- ")
- JMP I RECRLF / AND CR/LF
-
-
-/ERROR ROUTINE
-XERROR, 0
- CLA /CLEAR POSSIBLE JUNK FROM AC
- DCA DSWIT /RESET IN CASE DUMP MODE
- CDF 0
- JMS I TYPECI /OUTPUT "?"
- "?
- TAD (ERLIST-1 /INIT LIST POINTER
- DCA DPNT
- DCA TEMP /SET CODE TO 0
-XERR1, ISZ TEMP /BUMP ERROR CODE
- TADIDP /GET AN ADDRESS
- SNA
- JMP XERR2 /(FOR DEBUGGING)
- CMA /= -(ADDR+1)
- TAD XERROR /DOES IT MATCH THE CALL?
- SZA CLA
- JMP XERR1 /NO
-XERR2, TAD TEMP /YES, OUTPUT ERROR CODE
- JMS I DEC2I / AS 2 DECIMAL DIGITS
- JMS I TYPSI /NOW OUTPUT " AT "
- MS17
- TAD (-COMB+1 /CALCULATE POSITION IN
- TAD COMOUT / COMMAND BUFFER,
- JMS I DEC2I / & OUTPUT AS 2 DIGITS.
- TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS ->
-XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!]
- JMP XERR4 /SHORT, GO DO CR/LF
- JMS USROUT /LONG, BE SURE MESSAGES ARE IN
- SPACE2 /OUTPUT 2 SPACES
- TAD TEMP /CODE = ADDRESS-1 OF ADDRESS
- DCA DPNT / OF MESSAGE
- TADIDP /GET MESSAGE ADDR
- JMS I TYPSTI / OUTPUT MESSAGE
-XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR
- JMP I .+1 /*** CIF BAT /BATCH OPER.
- MAIN1 /*** JMP I N7000 /'BATABT'!
-
-
-USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
- DCA USRSAV /SAVE CONTENTS OF AC
- RDF
- TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL)
- DCA USRCDF
-UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL
- TAD USRAD /IS USR IN OR OUT?
- SMA SZA CLA
- JMP USRIN /IN, GO TO IT
- CIF 10
- JMS I M100 /OUT, DO "USRIN" FUNCTION
- 10
- TAD N200
- DCA USRAD / & SO INDICATE
-USRIN, CDF CIF 10
- TAD USEUSR /MOVE RETURN ADDRESS TO THE
- DCA I N200 / USR ENTRY POINT
-USRCDF, CDF /SET UP D.F. FOR RETURN
- TAD USRSAV /RESTORE AC CONTENTS
- JMP I (201 / & FAKE A CALL TO IT
-USRSAV,
-
-USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING
-ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH
- SPA CLA / BLOCKS ON SYS.
- JMP I USROUT /JUST EXIT IF PRESENT...
- TAD M100
- DCA USRAD /SET USR TO "OUT"
- JMS I (7607 /READ IN THE MESSAGES
- 610 / 6 PAGES TO FIELD 1
- 0 / STARTING AT LOC 10000
- 27 / FROM SCRATCH BLKS
- SKP CLA /!!! ERROR !!!
- JMP I USROUT /OK, JUST EXIT
- TAD M200
- DCA XERR3 /NO MORE MESSAGES ON ERROR!
- TAD ERC16
- DCA ERC15 /AND NO MORE "SHOW ERROR"!
-ERC16, ERROR /TELL THE HORRIBLE STORY!
-
-
-PAGE
- /ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
-XSCAN, JMS I GARGI /GET ARGS CONVERTED
- TAD (SCANER / & SET UP FOR SCANNING
- JMP XDUM0
-
-/ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
-XDUMP, TAD MODSW /MAPPED MODE?
- SMA SZA CLA
-ERC14, ERROR /YES, DUMP IS MEANINGLESS!
- JMS XDLCOM /DO COMMON STUFF
- TAD (LLIST / & SET UP FOR DUMPING
-XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN
-XDUM1, ISZ DPNT /SKIP FIRST WORD
- ISZ DPNT /SKIP A WORD
- TAD I DPNT /GET NEXT START BLOCK.
- JMS BLKTST
- TAD I DPNT /GET NEXT -(# BLOCKS)
- DCA TEMP1
-XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE
- DCA LOCL /SET LOC TO 0
- DCA LOCH
- TAD M400 /SET TO -400(8) [1 BLOCK]
- JMS I XGFORM /DUMP OR SCAN A BLOCK
- ISZ BLK /INCREMENT BLOCK NUMBER
- ISZ TEMP1 /DONE?
- JMP XDUM2 /NO, DO NEXT BLOCK
- ISZ TEMP /YES, ARE ALL ARGS DONE?
- JMP XDUM1 /NO, DO NEXT
- JMP XLIS2 /YES, DONE--RESET SWITCH
-
-/ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
-XLIST0, JMS XDLCOM /DO COMMON STUFF
-XLIS1, TAD I DPNT /GET BLOCK #
- JMS BLKTST /TEST & SET BLK
- TAD I DPNT /GET & SET LOCATION
- DCA LOCH
- TAD I DPNT
- DCA LOCL
- TAD I DPNT /GET -(# WORDS)
- JMS LLIST /NOW GO DO IT
- ISZ TEMP /ARE ALL ARGS USED?
- JMP XLIS1 /NO, CONTINUE
-XLIS2, DCA DSWIT /RESET DUMP SWITCH
- JMP I RECRLF / DO CR/LF & CONTINUE
-
-/COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
-XDLCOM, 0
- TAD OUTPNT /INITIALIZE DEFAULTS
- DCA LISTPT
- TAD OUTSW
- DCA LOUTSW
- JMS XGFORM /GET FORMAT, IF ANY
- NOP /RETURN FOR NO FORMAT
- JMS I GARGI /GET ARGS
- ISZ DSWIT /SET DUMP SWITCH
- JMP I XDLCOM
-
-/SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
-/BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
-LLIST, 0
- DCA CNTRA /SET UP -# WORDS TO LIST
- DCA CHARSW /RESET UNPACK SWITCH
-LLIS1, JMS I CRLFI
- TAD LOCL
- AND N7 /SET UP # ON THIS LINE
- DCA CNTR
- TAD LOUTSW /IF CHARACTER OUTPUT,
- SNA CLA
- TAD M10 / DOUBLE # WORDS/LINE
- TAD CNTR
- TAD M10
- DCA CNTR
- JMS I BKLOCI /OUTPUT LOCATION
- BLK-1
- JMS I TYPSI /OUTPUT ": "
- MS13
-LLIS2, JMS I GETI /GET A WORD
- JMP LLIS3 /FILE MODE, NO SUCH ADDR..
- JMS I LISTPT /OUTPUT IT
- TAD LOUTSW /TEST MODE SWITCH
- SPA
- JMP LLIS5 /"SYMBOLIC", CR/LF NOW
- SZA CLA /CHARACTERS, NO SPACES
- SPACE2 /NUMBERS, TWO SPACES
-LLIS3, JMS I INCI /INCREMENT LOC
- ISZ CNTRA /ALL WORDS DONE?
- JMP LLIS4 /NO
- JMS I CRLFI
- JMP I LLIST /YES, RETURN
-/
-LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE?
- JMP LLIS2 /NOT YET
- JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE
-/
-LLIS5, STA
- DCA CNTR /FORCE A CR/LF
- JMP LLIS3
-LISTPT, 0
-LOUTSW, 0
-
-
-/SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
-XGFORM, 0
- JMS I GWORDI /GET A WORD
- JMP I XGFORM /NOT FOLLOWED BY A WORD
- JMS I SORTI /LOOK UP WORD
- FORML-1
- FOPSL-FORML
-ERCD, ERROR /WORD NOT RECOGNIZED
-/
-XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG
-XFNUM, IAC /NUMERIC; SWITCH POS
-XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0
- TAD SCANX1 /'SORTJ' POINTER TO CHAR
- TAD (-FORML /CALCULATE FORMAT #
- CLL RAR /(DIVIDE BY 2)
- DCA TEMP1 / & SAVE IT.
- TAD TEMP1
- TAD (FTABLE-1
- DCA DPNT
- TADIDP
- DCA LISTPT /SET UP OUTPUT POINTER
- ISZ XGFORM /BUMP RETURN ADDRESS
- JMP I XGFORM
-
-/ROUTINE TO 'SET' THE 'FORMAT' OPTION
-XFORM, JMS XGFORM /GET FORMAT WORD
-ERCE, ERROR /NUMBER?! SORRY ABOUT THAT!
- TAD LOUTSW /OK, SET UP DEFAULTS:
- DCA OUTSW / SWITCH,
- TAD LISTPT
- DCA OUTPNT / ROUTINE POINTER,
- TAD TEMP1
- DCA FCNT / & FORMAT #
- JMP XSETN
-OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF
-
-
-PAGE
- /ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
-XOPEN, STA /"." LEGAL IN FILE NAME
- JMS GNAME /GET FILE NAME FOR OUTPUT
- CIF 10
- JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE
-
-
-/ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
-XCLOSE, CDF CIF 10
- JMP XCLOS1 /ALL CODE IS IN FIELD 1
-
-
-/ROUTINE TO EXECUTE THE 'FILE' COMMAND.
-XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS
- SMA CLA / AT EXTENSION RETRIES?
- JMP XFIOUT / YES, ALL TRIES DONE!
- ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL
- ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL
- TAD (1404 / 2ND TRY--USE "LD" EXTEN
- DCA NAM4 / 3RD TRY--USE NULL EXTEN
- JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE
-/
-XFIOUT, JMS PNAME /OUTPUT FILE NAME &
- JMS I TYPSI /"LOOKUP FAILED"
- MS15
-/
-XFILEN, JMS I CRLFI /OUTPUT CR/LF
- ISZ CRSWT /WAS LAST ENDED BY A CR?
- JMP I RESTAR /YES, DONE
-XFILE, STA /"." LEGAL IN FILE NAME
- JMS GNAME /GET NEXT FILE NAME
-XFICHN, STA
- DCA DPSGN /SET TRY AGAIN SWITCH
- TAD (NAM1 /INIT POINTER TO NAME
- DCA FSTBLK
- TAD DEVNO /GET DEVICE #
- CALUSR
- 2 /LOOKUP
-FSTBLK, 0 /NAME PNTR, BECOMES ST BLK
-FBKLEN, 0 / BECOMES -(FILE LENGTH)
- JMP XFIERR /LOOKUP FAILED
- TAD FSTBLK
- DCA RBLK1 /SET UP PAGE 0 ST BLK
- CDF 10
- DCA I (CCBB / & RESET CCBB
- TAD I (1404 /GET # ADD'L INFO WORDS
- DCA GDEV2 / (NEGATIVE) & SAVE IT
- TAD GDEV2
- TAD I (17 /POINT TO FIRST OF THEM
- DCA GDEV3 / (THE DATE, IF PRESENT)
- TAD I N7 /GET THE NUMBER OF THE
- AND N7 / DIRECTORY SEGMENT IN
- DCA CNTR / CORE & SAVE IT.
- TAD GDEV2 /WAS # OF ADD'L WRDS = 0?
- SZA CLA
- TAD I GDEV3 / NO, GET THE DATE WORD
- CDF 0
- DCA GDEV1 /STORE DATE OR 0 (NO DATE)
- JMS PNAME /OUTPUT FILE NAME
- TAD FSTBLK
- JMS I OCTI /OUTPUT ST. BLK. IN OCTAL
- JMS I TYPECI
- "-
- TAD FBKLEN /CALCULATE LAST BLK #
- CMA
- TAD FSTBLK
- JMS I OCTI / & OUTPUT IN OCTAL
- SPACE2 /OUTPUT 2 SPACES
- TAD FBKLEN
- CIA
- JMS I OCTI /OUTPUT LENGTH IN OCTAL
- JMS I TWOCI /" ("
- 4050
- TAD FBKLEN
- CIA
- JMS I DECI / & AGAIN IN DECIMAL
- JMS I TYPSI /") "
- MS33
- TAD CNTR /GET SEGMENT #
- JMS I RTL6I / & PUT IN BITS 3-5
- JMS I TWOCI / TO OUTPUT IT & "."
- 6056
- TAD GDEV3 /GET ADDR OF 1ST ADD'L WRD
- TAD (-1400-4 / FOR OFFSET OF NAME START
- JMS OCT3 /OUTPUT LOCATION IN SEG
- SPACE2 / & TWO SPACES
- TAD GDEV1 /GET DATE WORD
- SZA /IS IT = 0?
- JMS I PDATEI /NO, OUTPUT DATE
- JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE
-
-
-/ROUTINE TO 'SET' THE 'DEVICE' OPTION
-XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
- DEVHAN+1 / (2 PAGE HANDLER IS OK)
- DCA DEVAD /SET UP HANDLER ADDRESS
- TAD GDEV2 /SAVE DEVICE #
- DCA DEVNO
- DCA RBLK1 / & NO FILE KNOWN
- DCA SHUT / & NOTHING OPENED
- DCA MODIF / & NOTHING MODIFIED
- TAD NAM1
- CIF 10
- JMP XDEVM /GO FINISH SETUP IN FIELD 1
-
-
-/ROUTINE TO 'SET' THE 'DDEV' OPTION
-XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER
- DMPHAN+1 / (2 PAGE HANDLER IS OK)
- CIF 10
- JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP
-
-GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
- JMS GNAME /GET DEV NAME ("." ILLEGAL)
- TAD NAM1 /MOVE NAME TO CALL
- DCA GDEV1
- TAD NAM2
- DCA GDEV2
- TAD I GDEVICE /GET HANDLER SPACE ADDRESS
- ISZ GDEVICE
- DCA GDEV3
- CALUSR
- 1 /FETCH HANDLER
-GDEV1, 0
-GDEV2, 0
-GDEV3, 0
-ERCY, ERROR /NO SUCH HANDLER
- TAD GDEV3 /RETURN HANDLER ADDRESS
- JMP I GDEVICE
-
-
-PAGE
- /ROUTINE TO EXECUTE THE 'SHOW' COMMAND
-XSHBLK, JMS I TYPSI /"BLOCK = "
- MS32
- TAD RBLK1 /OUTPUT BLOCK IN OCTAL
-XSTYPE, JMS I OCTI
-XSHCR, JMS I CRLFI /GIVE A CR & LF
- DCA DSWIT /BE SURE SWITCH IS RESET
- ISZ CRSWT /LAST WORD ENDED BY CR?
- JMP I RESTAR /YES, DONE
-XSHOW, JMS I GWORDI /GET A WORD
- JMP ERCG /NUMBERS NOT RECOGNIZED
- JMS I SORTI /LOOK IT UP
- SHOWL-1
- SHOWOP-SHOWL
-ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD
-
-XSHVER, JMS I TYPSI /"VERSION = <VERSION><PATCH>"
- MSVER
- JMP XSHCR
-
-XSHMSK, JMS I TYPSI /"MASK = "
- MS02
- TAD MASK
- JMP XSTYPE
-
-XSHOFF, JMS I TYPSI /"OFFSET = "
- MS09
- TAD OFFSET
- CIA
- JMP XSTYPE
-
-XSHFIL, JMS I TYPSI /"FILLER = "
- MS37
- TAD FILLER
- JMP XSTYPE
-
-XSHODL, JMS I TYPSI /"ODT LOC = "
- MS12
- JMS I BKLOCI /OUTPUT IT
- SBLK-1
- JMP XSHBKS
-
-XSHREL, JMS I TYPSI /"REL. LOC = "
- MS20
- JMS I BKLOCI / & OUTPUT IT
- BLK-1
- JMP XSHBKS
-
-XSHABS, JMS I TYPSI /"ABS. LOC = "
- MS03
- TAD CAD /OUTPUT LOCATION IN BLOCK
- TAD (-IOBUF
- DCA CAD
- JMS I BKLOCI
- CBLK-1
-XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED?
- SMA CLA
- JMP XSHCR / NO, SAY NOTHING!
- JMS I TYPSI / YES, SAY " MOD"
- MSMOD
- JMP XSHCR
-
-XSHUPP, JMS I TYPSI /"UPPER = "
- MS04
- JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM
- UBLK-1
- JMP XSHCR
-
-XSHLOW, JMS I TYPSI /"LOWER = "
- MS05
- JMS I BKLOCI
- LBLK-1
- JMP XSHCR
-
-XSHFMT, JMS I TYPSI /"FORMAT = "
- MS06
- TAD FCNT
- TAD (FMTLS-1 /SET UP FOR CORRECT TITLE
-XSHFM, DCA DPNT
- TADIDP /GET MESSAGE ADDRESS
- JMS I TYPSTI /OUTPUT DESCRIPTOR
- JMP XSHCR
-
-XSHMOD, JMS I TYPSI /"MODE = "
- MS10
- TAD MODSW /GET CORRECT MESSAGE
- TAD (MODELS-1 /(OFFSET INTO TABLE)
- JMP XSHFM /GET ADDRESS & OUTPUT
-
-XSHOUT, JMS I TYPSI /"OUTPUT = "
- MS30
- TAD TYPSW /SET UP MESSAGE ADDRESS
- TAD (OUTLS-1 /(OFFSET INTO TABLE)
- JMP XSHFM
-
-XSHSMS, JMS I TYPSI /"SMASK = "
- MS07
- TAD SMASKL
- DCA TEMP /-# TO OUTPUT
- TAD MASKBS
- DCA DPNT /SET UP TO OUTPUT
- TAD M10 /SET LINE LENGTH
- DCA TEMP1
- JMP XSHSM2
-XSHSM1, JMS I TWOCI /OUTPUT ", "
- 5440
- ISZ TEMP1 /ENOUGH ON THIS LINE?
- JMP XSHSM2 /NO, OK
- JMS I CRLFI /YES, OUTPUT CR-LF
- SPACE2 / & 2 SPACES
- STA /MAKE LINE 1 LONGER
- JMP XSHSM1-3 /AND RESET LENGTH
-/
-XSHSM2, TADIDP /GET NEXT VALUE
- JMS I OCTI / & OUTPUT IT
- ISZ TEMP /ENOUGH?
- JMP XSHSM1
- JMP XSHCR /OK, GET NEXT WORD
-
-XSHDEV, JMS I TYPSI /"DEVICE = XXXX"
- MSDEV
- JMS I TWOCI /NOW OUTPUT " ("
- 4050
- TAD DEVNO /GET THE DEVICE #
- JMS I DEC2I / & OUTPUT AS 2 DIGITS
- JMS I TYPECI /FINALLY OUTPUT ")"
- ")
- JMP XSHCR
-
-XSHDDEV,JMS I TYPSI /"DDEV = XXXX"
- MSDDEV
- JMP XSHCR
-
-
-FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8
- JMS I (FPRNTX /FIRST PRINT BANK BITS
- RTR /MOVE TO BITS 9-11
- RAR
- AND N7 /MASK TO 1 DIGIT
- DIGIT / & OUTPUT IN ASCII
- JMP I FPRNT
-
-
-PAGE
- /CONTINUATION OF 'SHOW' COMMAND
-
-/SHOW 'CCB' HANDLER
-XSHCCB, CDF CIF 10
- JMS GCCB /SET UP CCB FOR FILE
- DCA DPSGN / & SET UP SEGMENTS
- JMS I TYPSI /"CCB:"
- MS11
- JMS CCHDST /DO SETUP, OUTPUT START
- JMS I TYPSI /", JSW = "
- MS19
- JMS NXTOCT /OUTPUT J.S.W. IN OCTAL
- JMS I CRLFI
- JMS I TYPSI /" CORE SEGS: "
- MS14
-XSHCC1, TAD (-4
- DCA CNTR /-#/LINE
-XSHCC2, TADIDP /GET ORIGIN WORD
- DCA TEMP1
- TADIDP / & COUNT WORD
- DCA TEMP2
-/ TAD TEMP2 /GO OUTPUT START FIELD
-/ JMS FPRNT
- JMS I (ADFLD /ADJUST BANK AND FIELD FOR 128K
- TAD TEMP1 / & START ADDR
- JMS I OCTI
- JMS I TYPECI / & A "-"
- "-
-/ TAD TEMP2 /OUTPUT FIELD AGAIN
-/ JMS FPRNT
- JMS I (ADFLD /ADJUST BANK AND FIELD (128K)
- TAD TEMP2 / PAGE COUNT -> PAGES
- CLL RAL
- AND M200 /MASK OFF FIELD DATA
- TAD TEMP1 /ADD ORIGIN ADDR
- TAD M1 / & SUBTRACT 1 FOR END
- JMS I OCTI /OUTPUT END ADDR IN OCTAL
- ISZ DPSGN /DONE?
- JMP XSHCC4 /NO
- TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
- SNA
- JMP XSHCR / NO, DONE
- DCA DPNT / YES, RESET POINTER
- JMP XSHHD1 / & CONTINUE
-/
-XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR
- 5440
- ISZ CNTR /DONE ON THIS LINE?
- JMP XSHCC2 /NO
- JMS I CRLFI /YES
- SPACE2 /ADD 2 SPACES
- STA /AND 1 MORE ITEM PER LINE
- JMP XSHCC1
-
-/SHOW 'HEADER' HANDLER
-XSHHDR, CDF CIF 10
- JMS GHDR /SET UP HEADER FOR MODULE
- JMS I TYPSI /"HEADER:"
- MS38
- JMS CCHDST /DO SETUP, OUTPUT START
- JMS I TYPSI /", NEXT WORD = "
- MS39
- TADIDP /GET FIELD DIGIT
- DIGIT / & OUTPUT
- JMS NXTOCT /FOLLOWED BY ADDRESS
- JMS I TYPSI /", LOAD VER = "
- MS40
- JMS NXTOCT / & OUTPUT VERSION
- TADIDP /GET E.P. FLAG
- SNA CLA
- JMP XSHHD1 / NO E.P.
- JMS I TYPSI /", EP REQ'D"
- MS41
-XSHHD1, JMS I CRLFI /TO THE NEXT LINE
- JMS I TYPSI /" OVLYS START...
- MS42
-XSHHD2, TADIDP /GET NUMBER OF OVERLAYS
- SNA / FOR THIS LEVEL
- JMP XSHCR / 0 = END, DONE
- DCA TEMP1 /SAVE IT
- JMS I CRLFI /OUTPUT A CR/LF
- SPACE2 / AND 4 SPACES
- SPACE2
- TAD TEMP1
- JMS I DEC2I /# OVLYS IN DECIMAL
- SPACE2
- TADIDP /GET MEMORY START WORD
- DCA TEMP2
- TAD TEMP2
- JMS FPRNT /OUTPUT START FIELD
- TAD TEMP2
- AND M400 / & DOUBLE-PAGE
- JMS I OCTI
- SPACE2
- JMS NXTOCT /OUTPUT RELATIVE BLOCK
- SPACE2
- JMS NXTOCT /OUTPUT OVERLAY LENGTH
- JMP XSHHD2 /AND DO ANOTHER ROUND!
-
-/SHOW 'ERRORS' HANDLER
-XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN
- ISZ DSWIT /SET DUMP SWITCH
- JMS I TYPSI /"ERRORS: FUTIL VERSION ..."
- MSERR
- JMS I CRLFI
- CLA IAC
- DCA DPNT /SET POINTER & CODE
-XSHER1, JMS I CRLFI /DO ANOTHER CR/LF
- TAD DPNT /TEST FOR LAST REAL MESSAGE
- TAD (-EMSEND /(NOT DEBUG MESSAGE!)
- SNA CLA
- JMP XSHCR
- TAD DPNT /OUTPUT ERROR CODE
- JMS I DEC2I / AS 2 DIGITS
- JMS I TYPSI /THEN " = "
- MS01
- TADIDP /GET ADDR OF MESSAGE AND
- JMS I TYPSTI / OUTPUT IT
- JMP XSHER1
-
-
-CCHDST, 0
- JMS I CRLFI
- JMS I TYPSI /" SA = "
- MS18
- TAD (CCBB
- DCA DPNT /SET UP POINTER TO DATA
- TADIDP /GET 2ND WORD FROM CCB/HDR
- JMS FPRNT /IT HAS START FIELD SO OUTPUT
- JMS NXTOCT / FOLLOWED BY START ADDR
- JMP I CCHDST
-
-
-PAGE
- /ROUTINE TO EXECUTE THE 'SET' COMMAND
-XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR?
- JMP I RESTAR /YES, DONE
-XSET, JMS I GWORDI /GET OPTION WORD
- JMP XSET1 /NO NUMBERS PLEASE!
- ISZ CRSWT /WAS WORD ENDED BY A CR?
-ERCK, ERROR /YES, ILLEGAL HERE
- JMS I SORTI /LOOK UP WORD
- SETLST-1
- SETJMP-SETLST
-XSET1, ERROR /WHAT???
-
-
-/ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
-XDMODE, JMS I GWORDI /GET A WORD
- JMP ERC11 /NO NUMBERS HERE!
- JMS I SORTI /LOOK IT UP
- XDMLST-1
- XDMOPS-XDMLST
-ERC11, ERROR /NO LIKEE!!
-/
- CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE)
-XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC)
- DCA DMODE / 0: 'NONE' (TTY ONLY)
- JMP XSETN
-
-
-/ROUTINE TO 'SET' THE 'OUTPUT' OPTION
-XOUTS, JMS I GWORDI /GET OPTION WORD
- JMP ERCL / # IN THE BUFFER
- JMS I SORTI /LOOK IT UP
- XOLST-1
- XOOPS-XOLST
-ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD
-/
- CLL STA RAL /-1: 'FPP' (SYMBOLIC)
-XOUTS1, IAC /+1: 'PDP' (SYMBOLIC)
- DCA TYPSW / 0: 'OCTAL'
- JMP XSETN
-
-
-/ROUTINE TO 'SET' THE 'MASK' OPTION
-XMASK, JMS I ARGI /GET ONE ARG
- TAD ACC1 /GET 'LOC'
- DCA MASK / & SET MASK
- JMP XSETN
-
-
-/ROUTINE TO 'SET' THE 'OFFSET' OPTION
-XOFFS, JMS I ARGI /GET ONE ARG
- TAD ACC1 /GET #
- CIA
- DCA OFFSET /SET IT
- JMP XSETN
-
-
-/ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
-XEMODE, JMS I GWORDI /GET WORD
- JMP ERCZ /NO NUMBERS ALLOWED!!!
- JMS I SORTI /LOOK IT UP
- XELST-1
- XEOPS-XELST
-ERCZ, ERROR /ILLEGAL SOMETHING
-/
-XEMOD1, IAC /'SHORT'
- DCA ERMODE /'LONG'
- JMP XSETN
-
-
-/ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
-XUPP, JMS I LIMITI /UPPER, GET ARGS
- UBLK
- JMP XSETN
-
-/ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
-XLOW, JMS I LIMITI /LOWER, GET ARGS
- LBLK
- JMP XSETN
-
-/ROUTINE TO 'SET' THE 'MODE' OPTION
-XMODE, JMS I GWORDI /GET OPTION WORD
- JMP ERCJ /NUMBER IN BUFFER, BAIL OUT
- JMS I SORTI /LOOK IT UP
- MODLST-1
- MODOPS-MODLST
-ERCJ, ERROR /NOT RECOGNIZED
-/
- CLL STA RTL /-1: OFFSET
-XMODS, IAC /+2: LOAD (MODULE)
- IAC /+1: SAVE (FILE)
- DCA MODSW / 0: NORMAL
- JMP XSETN
-
-/ROUTINE TO 'SET' THE 'FILLER' OPTION
-XFILL, JMS I ARGI /GET ONE ARG
- TAD ACC1
- DCA FILLER / & SET AS FILLER
- JMP XSETN
-
-/ROUTINE TO 'SET' THE 'TEMP' STORAGE
-XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!)
- TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER
- DCA TEMPV1
- TAD ACC2 /GET IT BACK WITH "EVAL T"
- DCA TEMPV2 / (OR IN AN EXPRESSION)
- JMP XSETN
-
-
-/ROUTINE TO EXECUTE THE 'IF' COMMAND
-XIF, JMS I EVALI /EVALUATE THE EXPRESSION
- SKP / TERMIN = CR, OK
- JMP ERCC / TOO MANY PARENS
- TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO
- SNA
- TAD ACC2
- SNA CLA
- JMP I RESTAR /OK, JUST CONTINUE
-XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR
- DCA COMIR / LINE STARTING WITH "END"
- READLN /GET A LINE FROM THE INPUT
- TYPEM-1 / WITH THESE TERMINATORS
- IFSKPO-TYPEM
- JMP XIFSKP /BUFFER EMPTIED
-/
-XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP
- JMP XIFSKP / CR ONLY
- JMS I GWORDI /GET 1ST WORD ON LINE
- JMP XIFSKP / NO WORD
- TAD (-0516 /IS THE WORD "EN..."?
- SZA CLA
- JMP XIFSKP / NO, KEEP LOOKING!
- JMP I RESTAR /YES! BEGIN EXECUTION AGAIN!
-
-
-/ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
-/OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT
-/AS RELATIVE LOCATION.
-ABKLOC, 0
- TAD ABSSW /IS IT 0?
- SZA CLA
- JMP ABK2 /NO, OUTPUT AS ABSOLUTE
- JMS I BKLOCI /OUTPUT LOCATION
- BLK-1
-ABK1, JMS I TWOCI /OUTPUT ": "
- 7240
- JMS I TWOT
- JMP I ABKLOC
-/
-ABK2, TAD LOCL /MAKE ABSOLUTE
- AND N377
- DCA CAD
- JMS I BKLOCI /NOW OUTPUT IT
- CBLK-1
- JMP ABK1
-
-TWOCS, 0 /OUTPUT 2-CHARACTER ARG
- TAD I TWOCS /GET ARG
- ISZ TWOCS /SKIP IT
- JMS I TWOT /OUTPUT IT
- JMP I TWOCS
-
-NXTOCT, 0
- TADIDP /GET NEXT WORD FROM BLOCK
- JMS I OCTI / & OUTPUT IN OCTAL
- JMP I NXTOCT
-
-
-PAGE
- /ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
-XWORD, JMS SSET /INITIALIZE SEARCH
- TAD CNOP /SET UP FOR NORMAL,
- DCA CNOP+1
- TAD M10 / EQUAL SEARCH
-XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH
- DCA XWORC
-XWOR1, JMS I GWORDI /GET POSSIBLE WORD
- JMP XWOR3 /NUMBERS IN BUFFER
- ISZ CRSWT /WAS IT ENDED BY A CR?
-ERCI, ERROR /YES, VELLY SOLLY!
- JMS I SORTI /LOOK UP COMMAND: UN, ME,
- XWORCL-1 / AB, FR, TO
- XWOROP-XWORCL
-ERCH, ERROR /COMMAND NOT RECOGNIZED
-/
-XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY-
- DCA CNOP+1 / REFERENCE OP-CODES CAN
- JMP XWOR1 / EVER BE OUTPUT.
-/
-XWOR3, JMS I ARGI /GET AN ARG
- TAD ACC1 /GET THE VALUE
- AND MASK
- CIA
- DCA CNT /LOOK FOR THIS WORD
- JMS LSETUP /SET UP COUNT OF WORDS TO DO
-XWOR4, JMS I GETI /GET A WORD
- JMP XWOR5 /FILE MODE, NO SUCH ADDRESS
- AND MASK
- TAD CNT
-XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA"
- JMP XWOR5 /DID NOT MATCH
- JMS OPRTST /TEST FOR OP-CODES 6 & 7
-CNOP, NOP / 7--OPR
- NOP / 6--IOT;"NOP" OR "JMP XWOR5"
- JMS ABKLOC /DID MATCH, OUTPUT LOC
- JMS I GETI /GET THAT WORD
- JMP ERCP / OH I HOPE NOT!!!
- JMS I OCTI /AND OUTPUT IT IN OCTAL
- JMS I CRLFI
-XWOR5, JMS LCHEK /DONE YET?
- JMP XWOR4 /NO
-
-/SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
-SSET, 0
- DCA ABSSW /RESET ABSOLUTE SWITCH
- TAD LBLK /SET UP START BLK & LOC
- DCA BLK
- TAD LLOCH
- DCA LOCH
- TAD LLOCL
- DCA LOCL
- TAD UBLK /SET UP END BLK & LOC
- DCA EBLK
- TAD ULOCH
- DCA ELOCH
- TAD ULOCL
- DCA ELOCL
- JMP I SSET
-
-/COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES
-
-XWSABS, STA
- DCA ABSSW /'ABSOLUTE'--SET SWITCH
- JMP XWSRET
-/
-XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS
- BLK
- JMP XWSRET
-/
-XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED
- DCA EBLK
- JMS I LIMITI / & GET UPPER LIMITS
- EBLK
-XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS
- TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW
- DCA LCHEK / THESE TO BE COMMON TO BOTH
- JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES.
-EBLK, 0
-ELOCH, 0
-ELOCL, 0
-
-
-LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
- DCA ACC1 /INITIALIZE THESE TO 0
- DCA ACC2
- TAD MODSW /IN A MAPPED MODE?
- SMA SZA CLA
- JMP LSETL / YES, IGNORE BLOCK PARTS
- TAD BLK / NO, SET UP FOR 24 BIT
- DCA ACC1
- TAD EBLK / BLK-EBLK
- DCA OPER1
- DCA OPER2
- JMS DSUB /DO THE SUBTRACTION
- TAD (400 /NOW SET UP MULTIPLY BY 400
- DCA OPER1
- DCA OPER2
- JMS DMUL /GIVES: (BLK-EBLK)*400
-LSETL, CLL IAC
- TAD ELOCL
- DCA OPER1 /NOW SET UP ELOC+1
- RAL
- TAD ELOCH
- DCA OPER2
- JMS DSUB /AND SUBTRACT IT
- TAD LOCL /NOW ADD LOC TO GIVE:
- DCA OPER1 / (BLK-EBLK)*400+(LOC-ELOC-1)
- TAD LOCH / WHICH IS 24-BIT COUNT OF
- DCA OPER2 / WORDS TO SEARCH.
- JMS DADD
- TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO
- SMA CLA
- JMP I RECRLF / FAR, SO JUST QUIT NOW!
- JMP I LSETUP
-
-/**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****
-
-LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED
- JMS I INCI /INCREMENT LOC
- ISZ ACC1 /COUNT WORDS TO DO
- JMP I LCHEK
- ISZ ACC2 / (24-BIT)
- JMP I LCHEK
- JMP I RECRLF /DO CR/LF & STOP!
-
-
-TIDPNT, 0 /"TAD I DPNT" IN FIELD 1
- CDF 10
- TAD I DPNT
- CDF 0
- JMP I TIDPNT
-
-
-ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE
- AND N177 /MAKE CHARS INTO "STANDARD"
- TAD N200 / FORM: 7 BITS + PARITY ON
- JMS I TYPEI / TO CAUSE CORRECT PRINTING
- JMP I ASCII
-
-
-PAGE
- /ROUTINE TO 'REWIND' THE DEVICE
-XREWIN, CDF 10
- TAD USRAD /RESET DIRECTORY SEGMENT KEY
- SMA CLA
- DCA I N7 / IN USR IF IT IS IN MEMORY.
- CDF 0
- JMS I DEVAD /CALL HANDLER
- 0110 /READ, 1 PAGE, FIELD 1
- PDLB /DUMMY BUFFER (ZAP P.D.L.)
- 1 /BLK 1
- JMP RERROR /READ ERROR!
- JMP I RESTAR
-
-/READ ERROR--TEST TYPE & OUTPUT MESSAGE
-
-RERROR, SPA CLA /BIT 0 = 1 IF FATAL
-ERC00, ERROR /FATAL
-ERC01, ERROR /NON-FATAL
-
-
-/ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
-XSTRIN, JMS SSET /INITIALIZE
- TAD (STJMP-STCDF /RESET MASKING SWITCH
-XSTR0, TAD XREWIN / OR SET MASKING SWITCH
- DCA SMSKSW
- JMS I GWORDI /GET POSSIBLE WORD
- JMP XSTR1 /NUMBERS ONLY
- ISZ CRSWT /FOLLOWED BY A CR?
- JMP ERCI / YES, KICK OUT*****
- JMS I SORTI /LOOK UP OPTION: MA,
- STRLST-1 / AB, FR, TO
- STROPS-STRLST
- JMP ERCH /NO LIKEE!
-/
-XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER
- TAD TEMP / MASKING THEM IF SPECIFIED
- DCA CNTR /SET UP LENGTH
- TAD TEMPST
- DCA SCANX2 /STORING DONE IN NEG. FORM
- JMP XSTR2+2 /GO SET UP MASK
-/
-XSTR2, ISZ TEMP3 /MASK END?
- JMP XSTR3
- TAD MASKBS /YES, RESET MASK
- DCA SPNT
- TAD SMASKL /SET UP LENGTH
- DCA TEMP3
-XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS
- ISZ DPNT
- TAD I DPNT /GET A WORD
- JMS STRMSK /TEST & MASK
- CIA /NEGATE
- DCA I SCANX2 /STORE
- ISZ DPNT /BUMP POINTER
- ISZ CNTR /DONE?
- JMP XSTR2
- JMS LSETUP /YES, SET UP COUNT OF WORDS
-XSTR4, TAD TEMPST /SET UP FOR SEARCH:
- DCA DPNT / STRING,
- TAD TEMP
- DCA CNTR / & STRING LENGTH.
- TAD LOCL
- DCA XLOCL /SAVE CURRENT LOCATION
- TAD LOCH
- DCA XLOCH
- TAD BLK
- DCA XBLK
- TAD ACC1 / & COUNT FOR RESET
- DCA OPER1
- TAD ACC2
- DCA OPER2
- JMP XSTR6 /NOW SET UP MASK
-/
-XSTR5, JMS LCHEK /DONE?
- ISZ TEMP3 /NO, AT MASK END?
- JMP XSTR7
-XSTR6, TAD MASKBS / YES, RESET MASK
- DCA SPNT
- TAD SMASKL
- DCA TEMP3
-XSTR7, JMS I GETI /GET NEXT WORD
- JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS
- JMS STRMSK /TEST & MASK
- TAD I DPNT /COMPARE?
- SZA CLA
- JMP XSTR10 /NO, GO RESET & CONTINUE
- ISZ CNTR /MATCHED ENOUGH?
- JMP XSTR5 /NOT YET
- JMS XRSET /YES, RESET LOCATION & COUNT
- TAD TEMP /AND LENGTH
- DCA CNTR
-XSTR8, TAD M10
- DCA ACCX1 / -(#/LINE)
- JMS ABKLOC /OUTPUT THIS LOCATION
-XSTR9, JMS I GETI /GET A WORD
- JMP ERCP /BAD,BAD,BAD!!!
- JMS I OCTI /AND OUTPUT IN OCTAL
- JMS I INCI /INCREMENT LOC
- ISZ CNTR /DONE?
- JMP XSTR11 /NO, CONTINUE
- JMS I CRLFI /YES, OUTPUT CR/LF
-XSTR10, JMS XRSET /RESET LOCATION & COUNT
- JMS LCHEK /DONE?
- JMP XSTR4 /NO, LOC INC'D, TRY NEXT
-/
-XSTR11, SPACE2 /OUTPUT " "
- ISZ ACCX1 /DONE ON THIS LINE?
- JMP XSTR9 /NO, NOT YET
- JMS I CRLFI /YES
- JMP XSTR8
-
-XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC
- TAD XLOCL /LOC
- DCA LOCL
- TAD XLOCH
- DCA LOCH
- TAD XBLK /BLK
- DCA BLK
- TAD OPER1 /WORDS LEFT TO SEARCH
- DCA ACC1
- TAD OPER2
- DCA ACC2
- JMP I XRSET
-
-STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED ***
-SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK"
- AND I SPNT /OK, MASK IN FIELD 1
- CDF 0
- JMP I STRMSK
-STJMP= JMP I STRMSK
-STCDF= CDF 10
-
-XBLK, 0
-XLOCH, 0
-XLOCL, 0
-
-
-PAGE
- /ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
-XWRARG, JMS I ARGI /GET ONE ARG
- TAD ACC1 /USE IT AS THE BLOCK
- SKP
-XWRITE, TAD WBLK /SET BLOCK
- DCA XWBLK
- JMS I DEVAD /CALL HANDLER
- 4210 /WRITE, 2 PAGES, FIELD 1
- IOBUF
-XWBLK, 0 /[** COUNTER FOR MODIFY **]
- JMP WERROR /WRITE ERROR
- DCA MODIF /CLEAR SOMETHING-CHANGED FLAG
- JMP I RESTAR
-
-/WRITE ERROR--TEST TYPE & OUTPUT MESSAGE
-
-WERROR, SPA CLA /BIT 0 = 1 IF FATAL
-ERC02, ERROR /FATAL
-ERC03, ERROR /NON-FATAL
-
-
-/ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
-XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE
- JMP XMODEF /NONE, GET DEFAULT
- DCA MODTMP /SAVE FOR LATER
- ISZ CRSWT /TERMINATED BY A CR?
- JMP ERCO / YES, SAVE USER FROM HIMSELF!
- TAD MODTMP /TEST FORMAT FOR RECOGNITION
- JMS I SORTI
- MODIFL-1
- MODADS-MODIFL
-ERCO, ERROR / I THEENK YOU USE BAD WORD!
-/
-/NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
-XMODEF, TAD FCNT /USE CURRENT FORMAT,
- TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE
- DCA DPNT
- TADIDP /GET THE ONE TO USE
- DCA MODTMP / AND SAVE IT
-/
-XMOD0, JMS I GARGI /OK, NOW GET ARGS
- TAD TEMP /MOVE COUNT TO A SAFE PLACE
- DCA XWBLK
-XMOD1, TAD I DPNT /GET BLOCK #
- JMS BLKTST /TEST & SET BLK
- TAD I DPNT /GET LOC
- DCA LOCH
- TAD I DPNT
- DCA LOCL
- TAD I DPNT /GET -(# LOCS)
- DCA CNTR
-XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS
- DCA COMIR
- DCA CHARSW /RESET HALF SWITCH
- JMS I SOCTI /INITIALIZE INPUT TO OCTAL
- JMS I BKLOCI /OUTPUT START LOC
- BLK-1
- JMS I TWOCI /AND ": "
- 7240
- READLN /GET A LINE (TEST: RUBOUT, ^U & ^R)
- TYPEM-1 /IGNORE LF'S
- MCHARO-TYPEM
- JMP XMOD2 /BUFFER EMPTIED!
-
-
-/CR TYPED, END
-XMODCR, JMS I ENDCI /END BUFFER WITH A CR.
- JMP XMOD2 /ONLY A CR IN BUFFER-RETRY!
- TAD MODTMP /NOW LOOK UP FORMAT
- JMS I SORTI
- MODIFL-1
- MODIFO-MODIFL
-ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE)
-
-XMODDN, ISZ XWBLK /RETURN HERE, ALL ARGS DONE?
- JMP XMOD1 /NO
- JMP I RESTAR /YES
-MODTMP, 0
-
-XGET, 0 /SUB. TO SET CURRENT LOC & FLAG
- JMS I GETI /SET LOCATION
-ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS
- STA
- DCA MODIF /SET FLAG
- JMP I XGET
-
-/NUMERIC FORMATS HERE
-XNUM0, JMS I SORTI /TEST TERMINATOR
- GETLST-1-1 /SPACE, COMMA, CR
- NUMOPS-GETLST+1
- JMP ERCQ /ILLEGAL TERMIN
-/
-XNUM1, JMS I GETNI /COMMA, SKIP IT
- JMS I SSKIPI / SPACE, IGNORE IT
-XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION
- JMS XGET /SET UP LOCATION
- TAD ACC1
- DCAICAD / & STORE VALUE
- JMS I INCI /INCREMENT LOCATION
- ISZ CNTR /ALL MODS DONE?
- JMP XNUM0 /NO, TEST TERMIN
- JMP XMODDN /YES, TEST NEXT SET
-/
-XNUM3, TAD CNTR /DONE?
- SNA CLA
- JMP XMODDN /YES
- JMS XGET /NO, SET UP LOC
- TAD FILLER
- DCAICAD /AND FILL WITH 'FILLER'
- JMS I INCI /INCREMENT LOC
- ISZ CNTR /DONE?
- JMP XNUM3 /NO
- JMP XMODDN /YES
-
-/ASCII FORMAT HERE
- JMS CGET /GET A CHAR & CHECK FOR CR
-XASC1, JMS XGET /SET UP LOC & SET FLAG
- TAD CHAR
- DCAICAD /STORE THIS CHAR
- JMS I INCI /INCREMENT LOC
- ISZ CNTR /MODS DONE?
- JMP XASC1-1 /NO
- JMP XMODDN /YES
-
-CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE
- JMS CGTEST /GET & TEST NEXT
- JMP XNUM3 /CR, FILL REST WITH 'FILLER'
- JMP I CGET
-
-CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR
- JMS I GETNI /GET NEXT CHARACTER
- TAD CHAR /IS IT A CR?
- TAD M215
- SZA CLA
- ISZ CGTEST /RETURN TO CALL+2 IF NOT
- JMP I CGTEST
-
-
-DO1SP, 0 /OUTPUT " " + AC
- JMS I TYPECI
- "
- JMP I DO1SP /ANOTHER TUFFIE
-
-DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII)
- JMS I TWOCI
- 4040
- JMP I DO2SP /FAST & SWEET!
-
-
-PAGE
- /ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
-XSMASK, JMS I GARGI /GET ARGS
- TAD TEMP
- DCA SMASKL /SAVE -(MASK LENGTH)
- TAD MASKBS /SET UP TO STORE WORDS
- DCA SPNT
-XSMAS1, ISZ DPNT /SKIP 2 WORDS
- ISZ DPNT
- TAD I DPNT /GET & STORE ONE
- CDF 10
- DCA I SPNT
- CDF 0
- ISZ DPNT /SKIP 1 MORE
- ISZ TEMP /DONE ?
- JMP XSMAS1 /NO
- JMP I RESTAR
-
-
-/XS240 PACKED ASCII FORMAT HERE
-XXS20, TAD M240 /SET OFFSET
-/PACKED ASCII FORMAT HERE
-XPAC0, DCA PNAME /CLEAR OFFSET
-XPAC1, TAD M240 /IS CHAR < 240?
- TAD CHAR
- SMA CLA
- JMP XPAC2 /NO, JUST PACK CHAR
- CMA
- JMS PACK /YES, PACK A FLAG (77) FIRST
-XPAC2, TAD CHAR /NOW GO PACK CHAR
- TAD PNAME /(WITH DESIRED OFFSET)
- JMS PACK
- JMS CGET /NOW GET & TEST NEXT
- JMP XPAC1 / OK, CONTINUE
-
-/OS/8 ASCII HERE
-XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN
- RAR /(LOW BIT TO LINK &
- CLA / CLEAR AC)
- TAD CNTR
- RAR /(LOW TO LINK, LINK TO AC0)
- SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK
-ERC04, ERROR /START OR COUNT NOT EVEN
-XOPS2, TAD CHARSW /GET SWITCH
- ISZ CHARSW / & BUMP IT
- CLL RAR /ROTATE AC 11 INTO LINK
- SZL SNA CLA /CHARACTER 3?
- JMP XOPS5 /NO, CHAR 1 OR CHAR 2
- STA
- TAD CAD /YES, BACK UP POINTER
- DCA CAD
- STA CLL RAL / & SET LOOP COUNT TO -2
- DCA CHARSW
-XOPS3, TAD CHAR /GET REST OF CHAR
- CLL RTL /4 BITS LEFT
- RTL
- DCA CHAR /SAVE IT
- TAD CHAR /NOW MERGE 4 BITS WITH
- AND N7400 / A PREVIOUS CHAR
- TADICAD
- DCAICAD /4 BITS OF 3RD + 1ST OR 2ND
- ISZ CAD /BUMP POINTER
- ISZ CHARSW /DONE?
- JMP XOPS3
- TAD CNTR /YES, DONE ALL MODS?
- SNA CLA
- JMP XMODDN /YES, TEST FOR DONE
-XOPS4, JMS CGET /GET & TEST NEXT CHAR
- JMP XOPS2 /OK, DO NEXT
-/
-XOPS5, JMS XGET /SET UP CURRENT LOC
- TAD CHAR
- DCAICAD /AND STORE CHARACTER
- JMS I INCI /INCREMENT LOC
- ISZ CNTR /BUMP COUNTER FOR LATER
- JMP XOPS4 / SO IGNORE SKIP NOW
- JMP XOPS4
-
-PACK, 0 /SUB. TO PACK CHARACTERS
- AND N77 /USE ONLY 6 BITS
- ISZ CHARSW /CHECK HALF
- JMP PACK1
- TADICAD /RIGHT HALF, ADD TO LEFT
- DCAICAD
- TAD CNTR /ALL MODS DONE?
- SZA CLA
- JMP I PACK /NO
- JMP XMODDN /YES
-/
-PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT
- DCA CHARSW /SAVE IT
- JMS XGET /SET UP CURRENT LOC
- TAD CHARSW
- DCAICAD /STORE WORD
- JMS I INCI /INCREMENT LOC
- ISZ CNTR /BUMP COUNTER FOR LATER
- NOP / SO DON'T SKIP NOW
- STA
- DCA CHARSW /RESET SWITCH
- JMP I PACK
-
-
-PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES
- TAD NAM1
- JMS I TWOT / OUTPUT UP TO
- TAD NAM2
- JMS I TWOT / 6 CHARACTERS
- TAD NAM3
- JMS I TWOT / OF FILE NAME,
- JMS I TYPECI / A "."
- ".
- TAD NAM4 / & UP TO 2 CHARS
- JMS I TWOT / OF EXTENSION.
-PNAME1, SPACE1 /OUTPUT A " "
- TAD NCNT /11(10) CHARS ON LINE YET?
- TAD (-13
- SPA CLA
- JMP PNAME1 /NO, OUTPUT ANOTHER SPACE
- JMP I PNAME
-
-
-/SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
-/ COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
-/ POINTED TO BY CALL+1. THE FIRST WORD (BLOCK
-/ NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
-/ GIVEN IN THE COMMAND.
-
-LIMITS, 0
- TAD I LIMITS /GET ADDRESS OF 3 WORDS
- ISZ LIMITS
- DCA PNAME / & SAVE IT
- JMS I ARGI /GET COMMAND DATA
- TAD TEMP1 /GET BLOCK NUMBER PART
- ISZ TEMP1 /WAS A BLOCK PART SPEC'D?
- DCA I PNAME / YES, STORE IT
- CLA /(CLEAR IN CASE NOT!)
- ISZ PNAME /BUMP POINTER
- TAD ACC2
- AND N7
- DCA I PNAME /STORE HIGH 3 BITS
- ISZ PNAME
- TAD ACC1
- DCA I PNAME / & LOW 12 BITS OF ADDR.
- JMP I LIMITS
-
-
-PAGE
- /SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
-/
-/ THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
-/ IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
-/
-/ MODE ACTION
-/
-/ 0 = NORMAL THE HIGH 7 BITS OF THE 15 BIT ADDRESS
-/ ARE ADDED TO THE SPECIFIED BLOCK #
-/ TO GET THE ACTUAL BLOCK & THE LOW 8
-/ BITS OF THE 15 BIT ADDR ARE USED TO
-/ SPECIFY THE WORD WITHIN THE BLOCK.
-/
-/ -1 = OFFSET THE 12 BIT "OFFSET" (WHICH IS NEGATED)
-/ IS ADDED TO THE LOW 12 BITS OF THE
-/ ADDRESS, AND THEN THE NEW ADDRESS IS
-/ HANDLED AS ABOVE.
-/ THIS MODE IS USED PRIMARILY WHEN
-/ WORKING WITH THE OPERATING SYSTEM
-/ WITH OVERLAYS WHOSE REAL START BLOCK
-/ AND LOCATION WITHIN A FIELD ARE KNOWN.
-/ BY SETTING THE "OFFSET" TO THE START
-/ ADDRESS OF THE OVERLAY, ITS REAL
-/ ADDRESSES CAN BE USED AND THE PROPER
-/ LOCATIONS WILL BE ACCESSED.
-/
-/ +1 = SAVE THIS MODE IS USED WITH CORE IMAGE
-/ "SAVE" FILES ONLY. THE FILE'S CCB
-/ (CORE CONTROL BLOCK) IS USED TO
-/ DETERMINE THE REAL LOCATION ON THE
-/ DEVICE OF THE SPECIFIED 15 BIT ADDR-
-/ ESS. THE START BLOCK OF THE FILE
-/ IS USED, AND ANY SPECIFIED "BLOCK"
-/ PART IS USED TO SPECIFY THE OVERLAY
-/ WANTED AT THAT ADDRESS. FOR FILES
-/ WITHOUT OVERLAYS (GENERATED BY THE
-/ MONITOR "SAVE" COMMAND), THIS PART
-/ MUST BE ZERO (0) OR NO MATCH WILL
-/ OCCUR. FOR FILES WITH OVERLAYS
-/ (GENERATED BY THE PROGRAM "LINK"),
-/ A LEGAL OVERLAY AT THE SPECIFIED
-/ ADDRESS MUST BE SPECIFIED FOR A
-/ MATCH TO OCCUR. THIS MODE CAN ONLY
-/ BE USED AFTER A "FILE" COMMAND.
-/
-/ +2 = LOAD THIS MODE IS USED WITH OS/8 FORTRAN
-/ IV LOAD MODULES. THE FILE'S HEADER
-/ BLOCK IS USED TO DETERMINE THE REAL
-/ LOCATION ON THE DEVICE OF THE SPECI-
-/ FIED 15 BIT ADDRESS AND THE "BLOCK"
-/ PART IS USED TO SPECIFY THE OVERLAY
-/ WANTED AT THAT ADDRESS. THIS MODE CAN
-/ ONLY BE USED AFTER A "FILE" COMMAND.
-
-
-/CALLING SEQUENCE:
-/
-/ JMS I GETI
-/ RETURN1 /MODE=MAPPED, NO SUCH ADDRESS
-/ NORMAL RETURN /'CAD' SET, DATA IN AC
- /SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT
-
-GET, 0
- JMS I CTRLI /GO TEST FOR CONTROL-CHARS
- TAD MODSW /OK, TEST MODE
- SNA
- JMP GET0 /NORMAL MODE, NO CHANGES
- SMA CLA
- JMP GET4 /SAVE MODE, DO MAPPING
- TAD OFFSET /OFFSET MODE, ADD IT
-GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES'
- TAD BLK / OF LOC TO BLK TO SET
- DCA CBLK /'CURRENT BLOCK'
-GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT
- JMP RERROR / READ ERROR, GO TELL ABOUT IT
- TAD MODSW /TEST AGAIN FOR OFFSET
- SPA CLA
- TAD OFFSET /YES, ADD IT AGAIN
- TAD LOCL /USE 8 ADDRESS BITS FROM LOC
- AND N377
- TAD BUFST /INTO BUFFER, TO SET
- DCA CAD /'CURRENT ADDRESS'
- TADICAD /NOW GET THE WORD
- ISZ GET /RETURN TO CALL+2 WITH IT
-GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL]
-
-GETIO, 0 /DO I/O FOR 'GET' & 'SCANER'
- TAD CBLK /IS THIS SAME BLOCK AS IS IN
- CIA /CORE CURRENTLY?
- TAD RBLK
- SNA CLA
- JMP GETIO2 /YES, USE IT.
- ISZ MODIF /NO, ANY CHANGES IN THIS BLK?
- JMP GETIO1 /NO, DEVICE OK AS IS
- JMS I DEVAD /CALL DEVICE HANDLER
- 4210 /WRITE, 2 PAGES, FIELD 1
-BUFST, IOBUF
-WBLK, 0
- JMP WERROR /WRITE ERROR
-GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK
- DCA WBLK
- TAD CBLK / AND INPUT BLOCK #
- DCA RBLK
- DCA MODIF / AND RESET SWITCH
- TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS
- MQL / (IF THERE ARE ANY!)
- CLA
- JMS I DEVAD /CALL DEVICE HANDLER
- 0210 /READ, 2 PAGES, FIELD 1
- IOBUF
-RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #)
- JMP I GETIO /READ ERROR
-GETIO2, ISZ GETIO /OK, DO NORMAL RETURN
- JMP I GETIO
-
-
-DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES
- TAD LOCL
- AND M400 /HIGH 4 BITS HERE
- CLL RAL /BECOME LOW 4 BITS
- TAD LOCH /FOR A 7 BIT VALUE
- RTL
- RTL
- JMP I DBLPGS
-
-
-/GET WORD ROUTINE FOR "ODT" COMMANDS
-
-ODGET, 0
- TAD SBLK /SET UP BLOCK
- DCA BLK
- TAD SLOCH
- DCA LOCH
- TAD SLOCL
- DCA LOCL /SET UP LOCATION
- JMS I GETI /NOW GET WORD
-ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS
- JMP I ODGET / & RETURN WITH IT
-
-
-/OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL
-
-BKLOC, 0
- TAD I BKLOC /GET ARGUMENT (ADDR-1)
- ISZ BKLOC
- DCA GETPNT / & SET UP A-XR
- TAD I GETPNT /GET BLOCK PART
- JMS I OCTI / & OUTPUT IT
- TAD I GETPNT /GET FIELD
- AND N7
- JMS I TWOCI / & OUTPUT "." & IT
- 5660 / (".0")
- TAD I GETPNT /GET ADDRESS
- JMS I OCTI / & OUTPUT IT
- JMP I BKLOC
-
-
-/SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
-/FROM THE COMMAND BUFFER. IF THE BUFFER CONTAINS
-/ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
-/IS SPACE OR CR
-GWORD, 0
- JMS I SSKIPI /GET NEXT NON-SPACE
- TAD CHAR
- AND N77 /USE THIS CHAR AS LEFT
- JMS I RTL6I / 6 BITS.
- DCA CHARSW /SAVE IT
- JMS I SORTI /CHECK FOR ^K, ^D, (, ", ',
- GWLST1-1 / DIGITS, SPACE & CR
- GWOPS1-GWLST1
- JMS I GETNI /NONE, IS NEXT A SPACE
- JMS I SORTI / OR A C.R.?
- GWLST2-1
- GWOPS2-GWLST2
- TAD CHAR /NONE, USE AS LOWER 6 BITS
- AND N77
- TAD CHARSW
- DCA CHARSW /SAVE IT
-GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R.
- JMS I SORTI
- GWLST2-1
- GWOPS2-GWLST2
- JMP GWD1 /NEITHER, KEEP LOOKING
-/
-GWD2, STA /SPACE FOUND, SET SWITCH
-GWD3, DCA CRSWT /CR FOUND, RESET SWITCH
- TAD CHARSW /RETURN WITH WORD
- ISZ GWORD / TO CALL+2
-GWD4, JMP I GWORD
-/EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
-/ ^K, ^D, (, ", ', DIGITS
-
-
-/"DIRECTORY" FORMAT OUTPUT ROUTINE
-DIRDMP, 0
- JMS I OCTI /OUTPUT IN OCTAL FIRST
- SPACE2
- TADICAD
- JMS DIROUT / THEN 3 OTHERS
- JMP I DIRDMP
-
-/"?" ODT OUTPUT ROUTINE
-DIROUT, 0
- CIA /ASSUME WAS NEGATIVE
- JMS I DECI / & OUTPUT IN DECIMAL
- SPACE2
- TADICAD
- JMS I PDATEI /OUTPUT AGAIN AS DATE
- SPACE2
- TADICAD
- JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII
- JMP I DIROUT
-
-
-PAGE
- /CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
-/ MODES DONE HERE.
-
-GET4, JMS DBLPGS /GET # DOUBLE-PAGES
- DCA CAD / & SAVE IT
- STA
- TAD MODSW /TEST FOR SAVE OR LOAD MODE
- SZA CLA
- JMP GETL1 / LOAD MODE
- CDF CIF 10
- JMS GCCB /SAVE MODE, GET CCB
- DCA SEGCNT / & SET UP # SEGMENTS
- TAD RBLK1 /SET UP ACTUAL FIRST BLOCK
- IAC
- DCA CBLK / FOR MAPPING.
-GETS1, CDF 10
- TAD I GETPNT /GET AN ORIGIN WORD
- DCA GETORG
- TAD I GETPNT / & A CONTROL WORD.
- CDF 0
- DCA GETCW
- TAD GETCW /TEST FOR FIELD MATCH
- CLL RTR
- RAR
- AND N7 /(MASK OFF COUNT)
- CIA
- TAD LOCH /SAME?
- SZA CLA
- JMP GETS2 /NO, TRY NEXT SEGMENT
- TAD LOCL /YES, NOW TEST ADDRESSES
- AND M200 /(MASK TO PAGE)
- STL CIA
- TAD GETORG /[ORIG PAGE]-[ADDR PAGE]
- SZA SNL /ABOVE THE ORIGIN?
- JMP GETS2 /NO, TRY NEXT
- RAR /OK, DIVIDE BY 2 (WITH SIGN)
- DCA GETORG / & SAVE IT.
- TAD GETCW /BEYOND TOP OF SEGMENT?
- AND M100 /(MASK OFF FIELD AND MAKE)
- SNA
- STL RAR / 0 => 40, THEN SUBTRACT
- TAD M100 / ONE PAGE)
- TAD GETORG
- SPA CLA
- JMP GETS2 /NO, TRY NEXT
- TAD GETORG /YES, UPDATE CBLK TO RIGHT
- CIA
- JMS UPCBLK / ACTUAL BLOCK
- TAD BLK /MUST BE IN "LVL 0" OR
- SZA CLA
- JMP GETX / RETURN AS BAD
- JMP GET1 /NOW GO GET THE DATA
-/
-GETS2, CLA
- TAD GETCW /UPDATE CBLK
- AND M100
- SNA
- STL RAR /(MAKING 0 => 40)
- TAD (100 /(ROUND UP PAGE COUNT)
- JMS UPCBLK
- ISZ SEGCNT /ALL SEGMENTS DONE?
- JMP GETS1 /NO, TRY NEXT
- TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT)
- SNA
- JMP GETX / NO, RETURN TO CALL+1
- TAD (4 / YES, RESET POINTER
- DCA GETPNT / TO SKIP OVER LVL 0
- JMP GETL2 / & CONTINUE
-/
-GETL1, CDF CIF 10
- JMS GHDR /GET & TEST HEADER
-GETL2, CDF 10
- TAD I GETPNT /GET NUMBER OF OVERLAYS
- DCA SEGCNT
- TAD I GETPNT /GET PAGE & FIELD
- DCA GETCW
- TAD I GETPNT /GET REL BLK NUMBER
- TAD RBLK1 / + START BLOCK
- DCA CBLK / = ABS START BLK, THIS LEVEL
- TAD I GETPNT /GET LENGTH, THESE OVERLAYS
- CDF 0
- DCA GETORG
- TAD GETCW /GET DBL-PAGE & FIELD
- SNA
- JMP GETX / 0 = THE END!!!
- AND M400 /CONVERT TO DBL-PAGE #
- CLL RTL
- RTL
- TAD GETCW / IN BITS 5-11
- RAL
- AND N177
- CIA /-(DBL-PG # OF OVLY START)
- TAD CAD /+(DBL-PG # OF DESIRED)
- SPA
- JMP GETL3 / GONE TOO FAR, MISSED IT!
- DCA GETCW /= RELATIVE BLOCK NUMBER
- TAD GETCW /IS THIS WITHIN THIS OVLY?
- CIA
- TAD GETORG
- SPA SNA CLA
- JMP GETL2 / NO, TRY NEXT OVERLAY
- TAD BLK /OK, SET UP -(#LVL +1)
- CMA
- DCA UPCBLK /V7B
- TAD UPCBLK /V7B-ADDR IS OK, IS THERE A
- TAD SEGCNT / LEVEL WANTED?
-GETL3, SPA CLA
- JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT
- TAD GETCW /ALL OK! ADD RELATIVE BLK
- SKP
-GETL4, TAD GETORG / TO (LVLS-1)*LENGTH-V7B
- TAD CBLK
- DCA CBLK / TO OVERLAY START BLOCK
- ISZ UPCBLK /[MULTIPLY BY ADDING]-V7B
- JMP GETL4
- JMP GET1
-GETORG, 0
-GETCW, 0
-SEGCNT, 0
-
-UPCBLK, 0
- JMS I RTR6I /MOVE COUNT TO BITS 6-11
- CLL RAR /DIVIDE FOR DOUBLE PAGES
- TAD CBLK /UPDATE
- DCA CBLK
- JMP I UPCBLK
-
-
-
-PAGE
- /NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:
-
-OPRT, 0 /4-DIGIT OCTAL
- JMS NUMOUT
- -1000
- -100
- -10
- 0
- JMP I OPRT
-
-OCT3, 0 /3-DIGIT OCTAL
- JMS NUMOUT
- -100
- -10
- 0
- JMP I OCT3
-
-BPRT, 0 /3-DIGIT BCD
- JMS NUMOUT
- -400
- -20
- 0
- JMP I BPRT
-
-
-SGNDP, 0 /4-DIGIT DECIMAL, SIGNED
- DCA NUMB
- TAD NUMB
- SPA CLA
- TAD N15
- SPACE1 /OUTPUT "-" OR " "
- TAD NUMB /NOW OUTPUT IN DECIMAL
- SPA
- CIA
- JMS DPRT
- JMP I SGNDP
-
-DECIMAL
-
-DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED
- JMS NUMOUT
- -1000
- -100
- -10
- 0
- JMP I DPRT
-
-DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED
- AND N177 /MASK IT FIRST
- JMS NUMOUT
- -10
- 0
- JMP I DEC2
-
-OCTAL
-
-NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE
- DCA NUMB /SAVE THE NUMBER
-NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0
- CLA CLL
- TAD NUMB /GET CURRENT VALUE
- TAD I NUMOUT /SUBTRACT DIGIT BASE
- SNL /DID IT OVERFLOW?
- JMP NUMO2 /NO, TOO FAR!
- ISZ NUMDGT /YES, BUMP DIGIT
- DCA NUMB / & UPDATE VALUE
- JMP NUMO1+1
-/
-NUMO2, CLA CLL
- TAD NUMDGT /OUTPUT THE "DIGIT"
- DIGIT
- ISZ NUMOUT /BUMP TO NEXT ARG
- TAD I NUMOUT /DONE ENOUGH?
- SZA CLA
- JMP NUMO1
- TAD NUMB /YES, SO OUTPUT THE LAST
- DIGIT / ONE.
- JMP I NUMOUT /AND RETURN
-NUMB, 0
-NUMDGT, 0
-
-SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER.
- TAD CHAR
- TAD M240 /IS THIS A SPACE?
- SZA CLA
- JMP I SSKIP /NO, DONE
- JMS I GETNI /YES, GET NEXT CHAR
- JMP SSKIP+1 / & GO TRY IT
-
-
-/OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR
-/ FOR EVEN WORD & 2 CHARS FOR ODD WORD.
-
-OSTYPE, 0
- JMS OSSET /DO SETUP FOR UNPACKING
- JMS I (ASCII /OUTPUT CHARS TO "STANDARD"
- ISZ CHARSW /UNPACK 2ND CHARACTER?
- JMP OSUNPK / YES, & RETURN TO OSSET CALL!
- JMP I OSTYPE /DONE, RETURN TO CALLER
-
-
-/OS/8 "BYTE" OUTPUT SUBROUTINE. OUTPUT ONE
-/ 8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
-/ BIT OCTAL NUMBERS FOR ODD WORD. USED FOR
-/ DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.
-
-BYTEO, 0
- JMS OSSET /DO SETUP FOR UNPACKING
- JMS OCT3 /3 DIGIT OCTAL OUTPUT
- ISZ CHARSW /UNPACK 2ND "CHAR"?
- SKP
- JMP I BYTEO / DONE, RETURN
- SPACE2 /YES, BUT OUTPUT 2 SPACES
- JMP OSUNPK / BEFORE DOING UNPACKING
-
-
-/OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
-/ 'BYTEO'. THE SUBROUTINE SETS UP THE COUNTER
-/ FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
-/ THE AC. THE ROUTINE WILL BE CALLED ONLY IF 2
-/ OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
-/ 2ND "CHARACTER", RETURNING TO THE CALLER OF THE
-/ SUBROUTINE!
-
-OSSET, 0 /ENTER HERE TO INITIALIZE
- DCA INC /SAVE AC
- IAC
- AND LOCL /AC = 0 OR 1
- CMA /AC = -1 OR -2 (-# TO DO)
- DCA CHARSW /SET UP UNPACK COUNT
-OSRETN, TAD INC /GET VALUE TO AC
- AND N377 /MASK TO 8 BITS
- JMP I OSSET
-/
-OSUNPK, STA /JUMP HERE IF 2ND CHAR TO GET
- TAD CAD
- DCA SGNDP /POINT TO HIGH WORD
- CDF 10
- TAD I CAD /GET LOW BITS OF "CHAR"
- AND N7400 / MASK TO 4 BITS AND
- JMS I RTR6I / MOVE TO BITS 8-11
- RTR
- DCA INC /SAVING IT HERE FOR LATER!
- TAD I SGNDP /NOW GET HIGH BITS OF "CHAR"
- AND N7400 / MASK TO 4 BITS AND
- CDF 0
- CLL RTR / MOVE TO BITS 4-7
- RTR
- JMP OSRETN /GET OTHER BITS & RETURN!
-
-
-/SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"
-
-INC, 0
- ISZ LOCL /INCREMENT LOW 12 ADDR BITS
- JMP I INC /OK AS IS
- CLL
- TAD LOCH /LOW OVERFLOW, INCR. HIGH
- TAD (7771 / 3 ADDRESS BITS (& TEST)
- AND N7
- DCA LOCH
- SZL /DID HIGH OVERFLOW ALSO?
- TAD N200 / YES, THEN BUMP BLK ALSO
- TAD BLK
- DCA BLK
- JMP I INC
-
-
-PAGE
- /OUTPUT PACKED STRING, ADDRESS IN CALL+1,
-/ TERMINATOR IS XX00.
-TYPES, 0
- TAD I TYPES
- ISZ TYPES
- JMS TYPSTR
- JMP I TYPES
-
-/OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
-TYPSTR, 0
- DCA GETNT
-TTAGN, CDF 10
- TAD I GETNT
- CDF 0
- ISZ GETNT
- JMS PACOUT
- TAD GNAME
- AND N77
- SNA CLA
- JMP I TYPSTR
- JMP TTAGN
-
-/PACKED ASCII OUTPUT ROUTINE
-PACOUT, 0
- DCA GNAME
- TAD GNAME /USE LEFT 6 BITS
- JMS I RTR6I
- JMS ONECHR
- TAD GNAME /USE RIGHT 6 BITS
- JMS ONECHR
- JMP I PACOUT
-
-/OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
-ONECHR, 0 /NO CODE FOR CR/LF
- AND N77
- SNA
- JMP I ONECHR /IGNORE "@"
- TAD (-40
- SMA
- TAD M100
- JMS I TYPECI
- 340
- JMP I ONECHR
-
-
-/SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
-/THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN
-/FIELD 1.
-
-SORTJ, 0
- SNA
- TAD CHAR /USE CHAR IF AC = 0
- DCA SORTEM /ITEM TO LOOK UP
- TAD I SORTJ
- ISZ SORTJ /GET LIST1 ADDRESS
- DCA SCANX1
-SORT1, CDF 10
- TAD I SCANX1 /COMPARE WITH SORTEM
- CDF 0
- SNA /0 ?
- JMP SORT2 /END OF LIST
- CIA STL
- TAD SORTEM
- SZA CLA /DOES IT MATCH?
- JMP SORT1 /NO, TRY NEXT
- TAD SCANX1 /YES, GET ADDRESS...
- TAD I SORTJ
- DCA SORTJ /...OF JUMP ADDRESS
- CDF 10
- TAD I SORTJ
- DCA SORTJ
- CDF 0
- JMP I SORTJ /GO TO ROUTINE
-SORT2, ISZ SORTJ /MATCH NOT FOUND,
- JMP I SORTJ /EXIT TO CALL+3
-SORTEM, 0
-
-
-/SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'
-
-GNAME, 0 /GET A FILE OR DEVICE NAME
- DCA TEMP1 /SET UP "." SWITCH AND
- TAD TEMP1 / FILE/DEVICE SWITCH
- DCA TEMP2
- DCA NAM1
- DCA NAM2 /CLEAR NAME AREA
- DCA NAM3
- TAD (2326 / & INIT EXTENSION TO "SV"
- DCA NAM4
- TAD (NAM1 / & INIT POINTER FOR NAME
- DCA TEMP
- JMS I SSKIPI /SKIP LEADING SPACES
- STA
- TAD COMOUT /BACK UP THE POINTER
- DCA COMOUT
- JMS GPAIR /1ST & 2ND CHAR
- JMS GPAIR /3RD & 4TH
-GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT.
- JMS GETNT /SCAN FOR TERMINATOR
- CLA
- JMP .-2
-/
-GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME?
- SZA CLA
- JMP GETNTC / FILE, JUST USE THE ":"
- ISZ TEMP2 / DEVICE, FLAG ":" SEEN
- JMP GETSCN+1 / AND SCAN TO TERMIN.
-/
-GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE?
-ERCM, ERROR /NO, THE END...
- DCA NAM4 /YES, RESET EXT,
- TAD (NAM4 / SET POINTER
- DCA TEMP
- JMP GETSCN / & GO GET IT
-/
-GETEND, STA /TERM = SPACE, SET SWITCH
- DCA CRSWT /TERM = CR, RESET SWITCH
- JMP I GNAME /..DONE....
-
-GETNT, 0 /GET & TEST A CHAR
- JMS I GETNI /GET NEXT CHAR
- JMS I SORTI /TEST IT
- GETLST-1
- GETOPS-GETLST
-GETNTC, TAD CHAR /OK, USE CHAR
- AND N77 /MASK TO 6 BITS
- JMP I GETNT / & EXIT WITH IT
-
-GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS
- JMS GETNT
- JMS I RTL6I /TO LEFT HALF
- DCA I TEMP / & STORE IT
- JMS GETNT
- TAD I TEMP /MERGE WITH LAST LEFT
- DCA I TEMP
- ISZ TEMP /BUMP POINTER
- JMP I GPAIR
-
-RTL6, 0 /ROTATE AC 6 LEFT
- CLL RTL
- RTL
- RTL
- JMP I RTL6
-
-RTR6, 0 /ROTATE AC 6 RIGHT
- CLL RTR
- RTR
- RTR
- JMP I RTR6
-
-
-PAGE
- /SUBROUTINE TO READ A "LINE" FROM THE USER. IT CHECKS FOR
-/ RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
-/ TERMINATORS PASSED BY THE CALLER. AS WITH OS/8, RUBOUT
-/ DELETES CHARACTES AND ^U DELETES THE CURRENT LINE. ^R
-/ (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
-/ MANNER AS LINE-FEED DOES FOR OS/8. IF THE CHARACTER IS A
-/ TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
-/ CALLER ROUTINE (OUT OF THIS ROUTINE). INPUT CHARACTERS
-/ ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE. EXIT
-/ IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
-/ RUBOUT OR ^U.
-
-READ, 0 /READ AND ECHO INPUT CHARACTER
- TAD I READ /GET TWO LIST ADDRESS PARAMETERS
- ISZ READ
- DCA RETERM / FROM CALLER AND SET UP IN
- TAD I READ / SORT ROUTINE CALL
- ISZ READ
- DCA RETERM+1
-RENEXT, JMS RKEY /GET A CHAR
- JMP RUBO /RUBOUT, GO BEGIN DELETIONS
-REKEY, DCA CHAR
- JMS I SORTI /CHECK FOR CTRL-R & CTRL-U
- REACTL-1
- REACTS-REACTL
- TAD CHAR
- JMS I TYPEI
- JMS I SORTI /CHECK FOR CALLER TERMINATORS
-RETERM, 0 / PARAMETERS HERE
- 0
- TAD CHAR /NONE, JUST STORE IN BUFFER
- SKP
-RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE!
- CDF 10
- DCA I COMIR /COMMAND (LINE) INPUT BUFFER
- CDF 0
- JMP RENEXT
-/
-/+++ FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
-/+++ SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
-/+++ PREVIOUS CHARACTER FROM THE SCREEN. IF "SCOPE
-/+++ MODE" IS SET, RUBO IS OVERLAID ON STARTUP.
-
-/*** FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
-/*** AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
-/*** FEED THAT FOLLOWS A CARRIAGE-RETURN.
-/
-RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY
- JMP RUBOF / INPUT BUFFER EMPTY!
- JMS I TYPECI /OK, OUTPUT 1ST "\"
- "\
-RUBO1, JMS BTEST /NOW EMPTY?
- JMP RUBOE / YES, LINE END
- TAD COMIR /ECHO LAST CHAR IN BUFFER
- DCA ENDC
- CDF 10
- TAD I ENDC
- CDF 0
- JMS I TYPEI
- STA
- TAD COMIR /NOW BACK UP POINTER
- DCA COMIR
- JMS RKEY /GET A CHAR
- JMP RUBO1 /ANOTHER RUBOUT, GO HANDLE
- DCA BTEST /SAVE THE CHAR
- JMS I TYPECI / DO CLOSING "\"
- "\
- TAD BTEST
- JMP REKEY /& GO USE NEW CHAR
-/
-RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED,
- "\ /OUTPUT CLOSING "\"
-RUBOF, JMS I CRLFI / & A CR/LF
- JMP I READ
-/
-RECHO, JMS I TYPECI /ECHO "^R" & THEN
- "R-100
- JMS I CRLFI /ECHO CURRENT LINE
- TAD COMST /INIT AUTO-XR
- DCA COMOUT
-RECHO1, TAD COMOUT /DONE?
- CIA
- TAD COMIR
- SNA CLA
- JMP RENEXT /YES, MORE INPUT
- JMS I GETNI /NO, GET NEXT CHAR
- JMS I TYPEI / & OUTPUT IT
- JMP RECHO1 / & CONTINUE
-/
-RERASE, JMS I TYPECI /OUTPUT "^U"
- "U-100
- JMP RUBOF /GO OUTPUT CR/LF & EXIT
-
-BTEST, 0 /TEST FOR COMM. BUFFER EMPTY
- TAD COMIR
- CIA
- TAD COMST
- SZA CLA /EMPTY?
- ISZ BTEST /NO, STILL OK, TO CALL+2
- JMP I BTEST / OTHERWISE TO CALL+1
- RKEY, 0 /GET A NON-NULL CHAR, TEST & TRANSLATE
- KSF /*** JMS I CTRLI /CHECK KEYBOARD
- JMP .-1 /*** CIF BAT /BATCH OPER.
- JMS I CTRLI /*** JMS I BATINI
- KSF /*** ERROR /EOF!!
- JMP RKEY+1 /*** NOP /MUST USE SPECIAL CARE
- KRB /*** NOP / TO HANDLE CTRL-Q!
- AND N177 /MASK OFF PARITY
- SNA
- JMP RKEY+1 /NULL CHAR
- TAD (-177 /IS IT A RUBOUT?
- SNA
-RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH
- ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER.
- TAD (2 /TEST FOR ALT-MODES
- SMA
- JMP RKEY1 / 375 OR 376
- TAD (35 /IS IT LOWER CASE?
- SMA
- TAD (-40 /YES, MAKE UPPER CASE
- TAD (-35
-RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY
- JMP I RKEY / & EXIT WITH IT
-
-
-/SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
-/RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
-/SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
-ENDC, 0
- TAD (215 /PUT A CR IN BUFFER
- CDF 10
- DCA I COMIR
- CDF 0
- TAD COMST /INIT'L BUFFER UNLOAD
- DCA COMOUT
- TAD CHAR /SAVE CHAR FOR POSSIBLE
- DCA TEMP / USE BY 'WCHEK'
- JMS I GETNI /GET FIRST CHARACTER
- JMS I SSKIPI /SKIP LEADING SPACES
- TAD CHAR /GET 1ST NON-SPACE
- TAD M215 /IS IT A CR?
- SZA CLA /YES, NOTHING IN BUFFER
- ISZ ENDC /OTHERWISE RETURN TO CALL+2
- JMP I ENDC
-
-
-DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT
- JMS I TYPECI
- "0
- JMP I DODIG
-
-
-PAGE
- /'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
-ODTOUT, 0
- TAD TYPSW /-1, 0, +1
- TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED
- DCA ODTOPT / OUTPUT ROUTINE
-ODTOPT, HLT /[USED TWICE!]
- DCA ODTOPT
- JMS I ODGETI /GET SPECIFIED WORD
- JMS I ODTOPT / & OUTPUT IT
- JMP I ODTOUT
-
- FPPDMP /-1 = OCTAL + FPP
-ODTOL, OPRT / 0 = OCTAL
- PDPDMP /+1 = OCTAL + PDP
-
-
-/OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
-PDPDMP, 0
- JMS I OCTI /FIRST OUTPUT IN OCTAL
- SPACE2 /FOLLOWED BY 2 SPACES,
- JMS PDPOUT / & THEN AS 'PDP'
- JMP I PDPDMP
-
-
-/'PDP' (SYMBOLIC) INSTRUCTION DECODING
-PDPOUT, 0
- CLA
- JMS OPRTST /TEST FOR OPR & IOT
- JMP OPRS / OPR
- JMS IOPRNT / IOT
-SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11
- RAL / * 2
- JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE
- INSLST /(TABLE FOR INDEXING)
- -2 /(- # WORDS)
- JMS OPRTST /TEST FOR OPR & IOT
- JMP SYMEND / OPR, DONE
- JMP IOTS / IOT
- TADICAD /MEMORY REF., INDIRECT?
- AND (400
- SNA CLA
- JMP REFS1 /NO
- JMS I TWOCI /YES, OUTPUT "I "
- 1140
-REFS1, TADICAD /SET UP ADDR BITS
- AND N177
- DCA BITVAL /SAVE THEM
- TADICAD /IS THIS A 'PAGE 0 REF'?
- AND N200
- SZA CLA
- TAD LOCL /NO, USE PAGE BITS
- AND M200
- TAD BITVAL /OK, NOW ADD ADDR BITS
-REFS2, JMS I OCTI /OUTPUT IN OCTAL
-SYMEND, JMP I PDPOUT /DONE, RETURN
-
-/
-IOTS, TADICAD /USE ONLY LAST 9 BITS
- AND (777
- JMP REFS2 /AND OUTPUT IN OCTAL
-/
-OPRS, TADICAD /IS THIS A NOP?
- AND (777
- SNA
- JMP SYMS /YES, OUTPUT "NOP "
- AND N200 /IS THERE A CLA IN IT?
- SNA CLA
- JMP OPRS1 /NO, CONTINUE
- JMS SYMTYP /YES, OUTPUT "CLA "
- CLANAM
- -2
- IAC
-OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH
- TADICAD /SET UP WORD FOR DECODE
- JMS I RTL6I
- RAR
- DCA BITVAL /SAVE IT
- TADICAD /CHECK FOR OPR1, OPR2 OR EAE
- CLL RAR
- AND N200
- SNA
- JMP OPR1A /OPR1 MICRO-INSTRUCTION
- SNL CLA
- JMP OPR2A /OPR2 MICRO-INSTRUCTION
-/
-/DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
-EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER
- DCA BITPNT
- JMS BITS /SHIFT & CHECK BIT 5
- JMS OPRTYP /IF = 1, "MQA "
- TAD BITVAL /CHECK BIT 6
- CLL RAL /("SCA" IN "A" MODE OF 8/E
- DCA BITVAL / 'MODE BIT' IN "B" MODE)
- SZL
- TAD N20 /IF ON, USE OTHER WORDS
- DCA EAETMP
- JMS BITS /CHECK BIT 7
- JMS OPRTYP / "MQL "
- TADICAD
- AND (16
- TAD EAETMP /(ADD SWITCH WORD)
- JMS SYMLIM /CHECK FOR & OUTPUT LAST INST.
- -36 /UPPER LIMIT
-EAETMP, 0
-/
-/DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
-OPR1A, TAD (OP1LST-2 /SET OPR1 LIST
- DCA BITPNT
- JMS BITS /SHIFT & CHECK BIT 5
- JMS OPRTYP /IF = 1, OUTPUT "CLL "
- JMS BITS /CHECK BIT 6
- JMS OPRTYP / "CMA "
- JMS BITS /CHECK BIT 7
- JMS OPRTYP / "CML "
- ISZ BITPNT /BUMP POINTER
- ISZ BITPNT
- TADICAD /LOOK FOR IAC
- RAR
- SZL CLA
- JMS OPRTYP /OUTPUT "IAC "
- TADICAD /SET UP TO CHECK FOR ROTATES
- AND (16
- JMS SYMLIM /CHECK & OUTPUT
- -12 /UPPER LIMIT
-
-
-PAGE
- /OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
-FPPDMP, 0
- JMS I OCTI /FIRST OUTPUT IN OCTAL
- SPACE2 / THEN 2 SPACES
- JMS FPPOUT / & THEN AS FPP
- JMP I FPPDMP
-
-/THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'
-
-/DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
-OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER
- DCA BITPNT
- JMS BITS /SHIFT & CHECK BIT 5
- JMS OPR2T /IF 1, OUTPUT "SMA " OR "SPA "
- JMS BITS /CHECK BIT 6
- JMS OPR2T / "SZA " OR "SNA "
- JMS BITS /CHECK BIT 7
- JMS OPR2T / "SNL " OR "SZL "
- JMS BITS /CHECK BIT 8
- SKP
- JMP OPR2B /IT WAS 0
- TADICAD /MUST CHECK FOR "SKP "
- AND (160
- SNA CLA /ARE ALL SKIP SENSES = 0?
- JMS OPRTYP /YES, SO OUTPUT "SKP "
-OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT
- DCA BITPNT
- JMS BITS /CHECK BIT 9
- JMS OPRTYP / "OSR "
- JMS BITS /CHECK BIT 10
- JMS OPRTYP / "HLT "
- JMP OPEND /CHECK FOR ANY DONE
-
-SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT
- DCA CHAR /SAVE AC
- TAD CHAR
- SPA SNA /IS IT > 0?
- JMP OPEND /NO, TEST IF ANY OUTPUT DONE
- TAD I SYMLIM /IT IS > UPPER LIMIT?
- SMA SZA CLA
- JMP OPEND /NO, GO CHECK AGAIN
- TAD CHAR /CALCULATE ADDRESS
- JMS OPRTYP / & OUTPUT LAST
- JMP SYMEND /...DONE
-/
-OPEND, CLA
- TAD CNT /ANYTHING OUTPUT?
- SZA CLA
- JMP SYMEND /YES, DONE WITH OUTPUT
- JMS SYMTYP /NO, OUTPUT "OPR "
- OPRMES
- -2
- JMP IOTS /NOW GO OUTPUT LAST 9 BITS
-
-BITS, 0 /DECODE A WORD ONE BIT AT A TIME
- TAD BITVAL /SHIFT A BIT INTO LINK
- CLL RAL
- DCA BITVAL /SAVE FOR LATER
- ISZ BITPNT /BUMP SYMBOL POINTER
- ISZ BITPNT
- SNL
- ISZ BITS /TO CALL+2 IF L = 0
- JMP I BITS
-
-OPRTYP, 0 /OUTPUT AN OPR SYMBOL
- JMS SYMTYP /OUTPUT THE SYMBOL
-BITPNT, 0 /ADDRESS
- -2
- ISZ CNT /SET SWITCH
- JMP I OPRTYP
-
-SYMTYP, 0 /OUTPUT A SYMBOL
- TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX
- ISZ SYMTYP
- DCA SYMPNT /SAVE POINTER
- TAD I SYMTYP /GET COUNT OF WORDS
- ISZ SYMTYP
- DCA BITS / & SAVE IT
-SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1
- TAD I SYMPNT
- CDF 0
- JMS I TWOT /OUTPUT A PAIR OF LETTERS
- ISZ SYMPNT
- ISZ BITS /DONE?
- JMP SYMNXT
- JMP I SYMTYP
-SYMPNT, 0
-
-OPR2T, 0 /OUTPUT AN OPR2 SYMBOL
- TADICAD
- AND (10 /IF BIT IS ON, REVERSE THE
- JMS OPRTYP /SENSE OF THE SKIP
- JMP I OPR2T
-
-BITVAL, 0
-
-
-IOPRNT, 0 /OUTPUT I/O NAMES
- TAD (IOTTAB /SET UP POINTER
-IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER
- CDF 10
- TAD I IOPNT /GET NEXT IOT
- CDF 0
- SNA /AT END OF TABLE?
- JMP I IOPRNT /YES, CODE NOT FOUND
- CIA
- TADICAD /NO, DO THEY MATCH?
- SNA CLA
- JMP IOPRN2 /YES, OUTPUT NAME
- TAD (4 /NO, UPDATE POINTER
- TAD IOPNT
- JMP IOPRN1 / & TRY AGAIN
-/
-IOPRN2, IAC /WORD FOLLOWS CODE
- JMS SYMTYP /OUTPUT THE MNEMONIC
-IOPNT, 0
- -3
- JMP SYMEND / & RETURN
-
-
-OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT
- TADICAD /GET WORD
- AND N7000 /MASK OFF OP CODE
- TAD (1000 /IS IT AN OPR?
- SNA
- JMP I OPRTST /YES, EXIT TO CALL+1
- ISZ OPRTST
- TAD (1000 /IS IT AN IOT?
- SZA CLA
- ISZ OPRTST /NO, EXIT TO CALL+3
- JMP I OPRTST / YES, TO CALL+2
-
-
-PAGE
- /'FPP' (SYMBOLIC) INSTRUCTION DECODING
-FPPOUT, 0
- CLA /HARD TO TELL WHAT MIGHT COME!
- TADICAD /GET THE WORD
- AND (600 /MASK OFF MODE BITS
- SNA
- JMP SPECIAL / NON-ARITHMETIC
- TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR.
- DCA TEMP2
- JMS GETOP /GET OP-CODE TO BITS 9-11
-FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT)
- JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL
- FPPINS /(INCLUDING "LEA")
- -3
- TAD TEMP2 /NOW HANDLE MODE
- SNA
- JMP LONG / LONG INDEXED
- SMA CLA
- JMP INDIR / INDIRECT INDEXED
-BASE, JMS I TYPSI / BASE - OUTPUT " B+"
- MSBASE
- TADICAD /GET WORD AGAIN
- AND N177 / MASK OFF OFFSET
- JMS MULT3 / MULTIPLY IT BY 3
- JMS OCT3 / & OUTPUT IN OCTAL
- JMP I FPPOUT
-/
-INDIR, JMS I TYPSI /OUTPUT "% B+"
- MSINDI
- TADICAD /GET WORD AGAIN
- AND N7 / MASK OFF OFFSET
- JMS MULT3 / MULTIPLY IT BY 3
- JMS OCT3 / & OUTPUT IT IN OCTAL
- JMP XRPLUS /FINALLY DO XR OUTPUT
-/
-LONG, JMS I TWOCI /OUTPUT "# "
- 4340
- JMS FLDOUT /AND FIELD AND "*"
-XRPLUS, JMS GET678 /GET XR FIELD
- JMS I TWOCI / & OUTPUT ",X" WHERE
- 5460 / "X" IS A DIGIT
- TADICAD /GET WORD THE LAST TIME
- AND (100 / AND CHECK "+" BIT
- SZA CLA
- JMS I TYPECI /OUTPUT "+" OR SKIP
- "+ /[A NOP]
- JMP I FPPOUT
-/
-SPECIAL,JMS GETOP /GET OP-CODE
- JMS I SORTI / & BRANCH ON IT
- FPPMO0-1
- FPPMOJ-FPPMO0
-SPCOP0, TADICAD /FALLS THRU ON 0, GET
- AND (170 / SUB-OP-CODE
- JMS I SORTI / & BRANCH ON IT
- FPPOP0-1
- FPPOPJ-FPPOP0
-SPOP00, TADICAD /FALLS THRU ON 0, USE AS
- AND N7 / INDEX INTO LAST LIST
- IAC
-SPOP04, JMS MULT3 /THREE WORDS/SYMBOL
- JMS SYMTYP /OUTPUT ONE OF SEVERAL
- FPOP00 / SYMBOLS IN THIS LIST
- -3
- JMP I FPPOUT
-/
-SPOP05, CLL STA /= -1
- JMP SPOP04 /OUTPUT "STARTE"
-/
-SPNUSE, CLL STA RAL /= -2
- JMP SPOP04 /OUTPUT "UNUSED"
-/
-SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X"
- CLL RAL /(2 WORDS PER)
- JMS SYMTYP /OUTPUT SYMBOL
- FPXR1S-2
- -2
- JMP XROUT / & XR VALUE
-/
-SPOP10, TAD (4 /"LDX *,X"
-SPOP11, JMS SYMTYP /"ADDX *,X"
- FPXR2S
- -4
-XROUT, TADICAD /GET XR FIELD
- AND N7
- DIGIT / & OUTPUT AS DIGIT
- JMP I FPPOUT
-/
-SPCOP1, TADICAD /GROUP 0 OR 1?
- AND (100
- SNA CLA
- JMP SPOP1J / 1 = CONDITIONAL JUMPS
- JMS GET678 / 0 = SETS, ETC.
- TAD (-4 /SUB-OP-CODES 0 THRU 3?
- SMA CLA
- JMP SPNUSE / NO, 4 THRU 7 = UN-USED
- JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR
- IAC / +1+1 => 2 THRU 5
-SPCOP3, IAC / 1: TRAP3
-SPCOP4, JMS MULT3 / 0: TRAP4
- JMS SYMTYP /GO DO ONE OF THESE
- FOP134
- -3
- JMP DOFLD /FINISH WITH FIELD
-/
-SPOP1J, JMS CONDIT /CONDITIONAL JUMPS
- 1200 / "J--"
- SPACE2
-DOFLD, JMS FLDOUT /OUTPUT FIELD & "*"
- JMP I FPPOUT
-/
-SPCOP2, JMS I TYPSI /OUTPUT "JNX "
- MSJNX
- JMP XRPLUS-1 / & HANDLE ADDRESS
-/
-/ SPCOP3 & SPCOP4
-/
-SPCOP5, TADICAD /GET WORD AGAIN
- AND (100
- SZA CLA
- JMP SPNUSE /BIT 5 ON IS UNUSED OP
- JMS CONDIT /LOAD TRUTH
- 1424 / "LT--"
- JMP I FPPOUT
-/
-SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH
-SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH
- CLL STA
- JMP FPLEA / & GO DO OUTPUT
-
-
-PAGE
- PDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
- DCA CRLF /SAVE IT
- TAD CRLF /GET WORD & MASK
- AND N377
- CLL RTR /DAY (4-8) TO 7-11
- RAR
- JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED)
- JMS I TYPECI / AND A SEPARATOR
- "-
- TAD CRLF /GET WORD A SECOND TIME
- JMS I RTR6I /MONTH (0-3) TO 7-10
- RAR / FOR MONTH*2
- AND (36 / MASK IT AND USE AS AN INDEX
- JMS I TYPSI / TO OUTPUT MONTH IN ALPHA
- MONTHS / FORM (WITH SAFETY...)
- JMS I TYPECI /FOLLOWED BY "-"
- "-
- TAD CRLF /GET LAST TIME
- AND N7 / MASK OFF YEAR
- TAD YRTEST / TEST IF .GT. THIS YEAR
- SMA SZA
- TAD (-10 / YES, SUBTRACT 8
- TAD YRBASE / ADD TO BASE YEAR
- JMS I DEC2I / & OUTPUT IT
- JMP I PDATE
-YRTEST, 0 /-(THIS YEAR) FOR TESTING
-YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR
-
-
-TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC
- TAD I TYPEA /GET ARG, IF ANY
- ISZ TYPEA
- DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1
- JMS I CTRLI
- CIF 10
- JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT
-/
-TYPEX, ISZ NCNT /BUMP LINE POSITION
- JMP I TYPEA / & EXIT
-
-CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED
- CLA
- JMS TYPEA
- 215
- JMS TYPEA
- 212
- DCA NCNT /RESET LINE POSITION
- JMP I CRLF
-
-
-TYPEC, 0 /OUTPUT A SINGLE CHAR ARG
- TAD I TYPEC /GET IT
- ISZ TYPEC
- JMS TYPE /OUTPUT IT
- JMP I TYPEC
-
-
-TYPE, 0 /CHARACTER OUTPUT ROUTINE
- AND N377 /BE SURE ONLY 8 BITS
- SNA
- TAD CHAR /USE CHAR IF AC = 0
- DCA TCHAR /CHAR TO OUTPUT
- TAD TCHAR
- JMS I SORTI /CHECK FOR SPECIALS
- TYPEL-1
- TYPEOP-TYPEL
- TAD TCHAR /IS TCHAR < 240?
- TAD M240
- SPA CLA
- JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR
-TYPC, JMS TYPEA /NOW OUTPUT CHAR
-TCHAR, 0
- JMP I TYPE
-/
-TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES
- "$
- JMP I TYPE
-/
-TYPCR, JMS CRLF /C.R. TO OUTPUT
- JMP I TYPE
-/
-TYPTAB, JMS TYPEA /SPACE OVER FOR TAB
- "
- TAD NCNT /TAB TO OUTPUT
- TAD M10
- SNA
- JMP I TYPE
- SMA
- JMP TYPTAB+3 /REDUCE BY TAB SIZE
- CLA
- JMP TYPTAB
-/
-TYPCTL, JMS TYPEA /CONTROL-CHAR, OUTPUT AS
- "^
- TAD C100 / "^","CHAR+100"
- JMP TYPC
-C100, 100
-
-
-CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
- DCA CTRLQS /CLEAR HANG FLAG
-CTRL0, KSF /HAS A KEY BEEN HIT?
- JMP CTRLX /NO, TEST IF HANGING
- KRS
- AND N177 /YES, MASK OFF PARITY BIT
- TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)?
- SNA
-BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT ==
- TAD M20 /IS IT A CTRL-S (STOP OUTPUT)?
- SZA
- JMP CTRL1
- ISZ CTRLQS / YES, SET HANG FLAG
- KCC / & CLEAR HARDWARE FLAG
-CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)?
- SZA
- JMP CTRL2
- KCC / YES, CLEAR THE HARDWARE
- JMP I CTRL / & JUST EXIT
-/
-CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)?
- SZA CLA
- JMP CTRLX /NO, TEST IF HANGING
- KCC
- DCA DSWIT /YES, RESET DUMP SWITCH
- JMS I TYPECI /OUTPUT "^P"
- "P-100
- JMP I RECRLF / THEN CR/LF & RESTART
-/
-/ROUTINE TO EXECUTE THE 'EXIT' COMMAND
-/
-XEXIT,
-CTRLC, DCA DSWIT /RESET DUMP SWITCH
- JMP I M200 / & GO TO SYSTEM
-CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! ***
-/
-CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S?
- SZA CLA
- JMP CTRL0 / YES, BACK FOR ANOTHER ROUND
- JMP I CTRL / NO, OUT WE GO!
-
-CTRLQS, 0 /CTRL-S, CTRL-Q FLAG
-
-
-PAGE
- /INPUT AN UNSIGNED 24 BIT NUMBER
-ACCEPT, 0
- DCA ACC1 /CLEAR LO
- DCA ACC2 / & HI WORDS
- DCA DADD / & LEGAL INPUT SWITCH
- JMS I SSKIPI /GET FIRST NON-SPACE
- SKP
-ACCPT1, JMS I GETNI /DON'T IGNORE SPACES
- JMS I SORTI /CHECK FOR ^D, ^K, (, ", ',
- GWLST1-1 / DIGITS, SPACE
- ACOPS-GWLST1
- JMP ACCPT3 /NONE OF THE ABOVE
-/
-ACCNUM, TAD CHAR
- TAD (-"0 /MAKE A DIGIT
- DCA OCTSET
- TAD OCTSET /IS DIGIT LEGAL?
- CIA
- TAD ACBASE
- SPA SNA CLA
-ERC09, ERROR / NO, ILLEGAL DIGIT!
-ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS
- DCA OPER1 / BY BASE
- DCA OPER2
- JMS DMUL / DO MULTIPLY
- TAD OCTSET /SET UP ADD OF NEXT "DIGIT"
- DCA OPER1
- DCA OPER2
- JMS DADD /OK, DO THE ADD (& SET SWITCH)
- JMP ACCPT1
-/
- STA / SPACE HERE
- DCA CRSWT /SET SWITCH: CR HERE
-ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED
- SNA CLA /CHECK FOR LEGAL INPUT
-ERCR, ERROR /YOU CAN'T OUT-SMART ME!
- JMP I ACCEPT
-ACBASE, 10
-/
-/
-DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR
- DCA OCTSET / SAVE VALUE
- JMP ACCMUL / & USE IT AS A "DIGIT"
-/
-SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST
- AND N77 /MASK TO 6 BITS
- JMS I RTL6I /MOVE TO LEFT HALF
- DCA OCTSET / & SAVE IT
- JMS QUOTEC /GET 2ND CHAR
- AND N77 /MASK
- TAD OCTSET /MERGE
- JMP DQUOTE+1 / & USE THIS AS A "DIGIT"
-/
-CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL
-CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL
- JMP ACCPT1
-
-
-/SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM
-/ COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
-OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT
- TAD (10 /ENTER WITH AC= 2 FOR DECIMAL
- DCA ACBASE
- JMP I OCTSET
-
-QUOTEC, 0 /GET A QUOTED CHARACTER
- JMS CGTEST /GET & TEST FOR A CR
-ERC13, ERROR / ILLEGAL USE OF " OR '
- TAD CHAR /OK, RETURN WITH IT
- JMP I QUOTEC
-
-
-/SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
-/BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
-GARGS, 0
- TAD TEMPST /GET BUFFER ADDRESS
- DCA DPNT
- DCA TEMP /ZERO THE NUMBER OF ARGS
-GAR1, STA
- DCA TEMP1 /SET BLK TO -1
- STA
- DCA CNT /RESET SWITCH
-GAR2, JMS EXPRIN /GET NEXT ARG
- JMS I SSKIPI /IGNORE TRAILING SPACES
- JMS I SORTI /BRANCH ON TERMINATOR
- GARLST-1
- GAROPS-GARLST
-ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT
-/
-GAR3, JMS GPUT /CR FOUND, END
- TAD TEMPST /SET UP POINTER FOR
- DCA DPNT / GETTING RESULTS
- JMP I GARGS
-/
-GAR4, JMS I GETNI /SKIP OVER "."
- TAD ACC1 /.= TERMIN (BLOCK PART)
- JMP GAR1+1 /SET BLOCK & GET NEXT
-/
-GAR5, TAD ACC1 /-= TERMIN (LOC PART)
- DCA TEMP2
- JMS I GETNI /SKIP OVER "-"
- JMP GAR2-1 /GO SET SWITCH
-/
-GAR6, JMS GPUT /,= TERMIN
- JMS I GETNI /SKIP OVER ","
- JMP GAR1
-
-
-/SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
-/BUFFER. ALL ARGUMENTS ARE STORED IN 4 WORDS IN
-/THE BUFFER, AS SPECIFIED BY:
-/ BLOCK.LOC1-LOC2 (TERMINATED BY , OR C.R.)
-/AS:
-/I-------I-------I-------I-------I-----
-/I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
-/I-------I-------I-------I-------I-----
-/WHERE:
-/ WORD1= BLOCK (OR -1 IF NONE SPECIFIED)
-/ WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
-/ WORD3= LOC1 (LOW)
-/ WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT
-/ SPECIFIED) [ONLY 12 LOW BITS USED]
-GPUT, 0
- TAD TEMP1
- DCA I DPNT /SET BLOCK
- ISZ CNT /WAS A LOC2 SPECIFIED?
- JMP GPUT1 /YES, OK
- TAD ACC1
- DCA TEMP2 /NO, MAKE ARGS SAME
-GPUT1, TAD ACC2 /STORE HIGH ADDR
- AND N7 /MASKED TO 3 BITS
- DCA I DPNT
- TAD TEMP2 /USE 1ST ARG
- DCA I DPNT
- TAD ACC1
- CMA
- TAD TEMP2
- DCA I DPNT /DIFF= (TEMP2-ACC1-1)
- STA
- TAD TEMP /ANOTHER ENTRY
- DCA TEMP
- JMP I GPUT
-
-
-XS240O, 0 /XS240 FORMAT PACKED ASCII
- JMS I RTR6I /HIGH 6 BITS
- AND N77
- SPACE1 / PLUS A SPACE
- TADICAD /THEN LOW 6 BITS,
- AND N77
- SPACE1 / PLUS A SPACE
- JMP I XS240O
-
-
-GETN, 0 /GET NEXT CHAR FROM COMM. BUFF.
- CDF 10
- TAD I COMOUT
- CDF 0
- DCA CHAR
- JMP I GETN
-
-
-PAGE
- /ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
-/OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
-/IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
-/IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
-/OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
-/
-/OPERATIONS (IN ORDER OF PRECIDENCE):
-/ OR AND ADD SUB DIV MPY
-/ ! & + - / *
-
-/ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
-/INTEGER. OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
-/IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.
-
-
-EVAL, 0
- DCA OPER2 /0 => D.P. TEMP (NEW NUMBER
- DCA OPER1 / OR LAST RESULT).
- DCA LASTOP /0 => LASTOP
- JMS I TERMTI /GET NEXT & TEST FOR TERM.
- JMP EVAL1 /TERM, CHECK IT
- JMP ENUM / IT MUST BE A NUMBER
-
-EVAL1, JMS I SORTI /CHECK LEGAL TERMS
- EVLST1-1 /"+","-" & "("
- EVOPS1-EVLST1
-ERCT, ERROR /SORRY ABOUT THAT
-
-EVAL2, JMS I LPARI /IS CHAR "("?
-ERCU, ERROR /YES,ILLEGAL (NO OP FIRST)
-EVMIN, TAD CNTRA /SEQN # OF TERMINATOR
- DCA THISOP /SET UP THISOP
- TAD CNTRA /IS IT ")" OR "CR"?
- TAD M10
- SMA CLA
- DCA THISOP /YES, 0 => THISOP
-EVAL3, TAD THISOP /CHECK PRIORITIES
- CIA
- TAD LASTOP /IS LASTOP < THISOP?
- SPA CLA
- JMP EVPAR /YES, CONTINUE SCAN
- TAD THISOP / IS THISOP+LASTOP=0?
- TAD LASTOP
- SNA CLA
- JMP EVALX /YES, DONE
- TAD LASTOP /NO, DO THIS OP NOW
- TAD EVTAB
- DCA EVOP /SET UP OPERATION
- TAD LASTOP /IS THIS =0?
- SNA CLA
- JMP EVOP /YES, DO OP
- POP /NO, POP LAST OFF LIST
- DCA ACC2 / INTO D.P.AC.
- POP
- DCA ACC1
-EVOP, HLT /JMS TO OPERATION ROUTINE
- TAD ACC2
- DCA OPER2 /DUPLICATE D.P.AC. INTO
- TAD ACC1
- DCA OPER1 / D.P. TEMP
- POP
- DCA LASTOP /POP UP ANOTHER OLD OPERATOR
- JMP EVAL3 /AND GO DO IT
-
-EVPAR, JMS I LPARI /IS CHAR A "("?
- JMP EVLPAR /YES, GO DO A SUB-EXPRESSION
- TAD LASTOP /NO, PUSH DOWN OLD OP
- PUSH
- TAD OPER1 / & D.P. TEMP (LAST
- PUSH
- TAD OPER2 / RESULT OR NEW NUMBER).
- PUSH
- TAD THISOP /UPDATE LASTOP
- DCA LASTOP
-EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM.
- JMP EVLPAR /TERM, MUST BE A "("
-ENUM, JMS I SORTI /CHECK FOR "C","B", ETC...
- EVLST2-1
- EVOPS2-EVLST2
- JMS ACCEPT /GET A # OR BOMB OUT!
- STA
- TAD COMOUT /BACK UP POINTER
- DCA COMOUT
-ENUMX, TAD ACC1
- DCA OPER1 /LO ORDER PART
- TAD ACC2
- DCA OPER2 /HI ORDER PART
- JMP EVOPN /GO CHECK TERMINATOR
-/
-EVDATE, CDF 10 /"D" -- USE DATE WORD
- TAD I (7666 /GET DATE WORD
- CDF 0
- JMP EVBLK+1
-EVREM, TAD ACCX1 /"R" -- USE REMAINDER
- DCA ACC1
- TAD ACCX2 / AS NEXT "INPUT".
- JMP EVBLK+2
-EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE
- DCA ACC1
- TAD TEMPV2
- JMP EVBLK+2
-EVSR, LAS SKP /"S" -- USE SWITCHES
- TADICAD /"C" -- USE CONTENTS
- JMP EVBLK+1
-EVFIL, TAD FILLER /"F" -- USE FILLER
- JMP EVBLK+1
-EVLOC, TAD LOCL /"L" -- USE LOCATION
- DCA ACC1
- TAD LOCH
- JMP EVBLK+2
-EVBLK, TAD BLK /"B" -- USE BLOCK
- DCA ACC1 /INTO LO ORDER PART
- DCA ACC2 /0 HIGH ORDER PART
- JMP ENUMX /CHECK NEXT CHARACTER
-
-EVLPAR, JMS I LPARI /IS CHAR "("?
- SKP
-ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR)
-EVPAR2, TAD LASTOP /PUSH DOWN LASTOP
- PUSH
- TAD EVAL /PREPARE TO RE-CALL
- PUSH
- JMS EVAL /RECURSIVE CALL
-ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS
- POP
- DCA EVAL /RESTORE RETURN ADDR
- POP
- DCA LASTOP /RESTORE LASTOP
-EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM.
- JMP EVAL2 /OK
- JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR
-
-EVALX, TAD CNTRA /WAS CHAR CR OR ")"?
- TAD M10
- SNA CLA
- ISZ EVAL / ")", RETURN TO CALL+2
- JMP I EVAL / CR, RETURN TO CALL+1
-
-LPARI, LPAR
-TERMTI, TERMT
-
-EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS
-
- DIOR /INCLUSIVE OR
- DAND /AND
- DADD /ADD
- DSUB /SUBTRACT
- DDIV /DIVIDE
- DMUL /MULTIPLY
-
-
-PAGE
- PUSHX, 0 /PUSH AC ONTO LIST
- CDF 10
- DCA I PDLPT
- CDF 0
- ISZ PDLPT /BUMP POINTER
- JMP I PUSHX
-
-POPX, 0 /POP LIST INTO AC
- STA STL /SET LINK SO IT WILL BE 0
- TAD PDLPT /BACK UP POINTER
- DCA PDLPT
- CDF 10
- TAD I PDLPT
- CDF 0
- JMP I POPX
-
-
-LPAR, 0 /CHECK IF CHAR = "("
- TAD CHAR
- TAD (-"(
- SZA CLA
- ISZ LPAR /IF IT IS NOT, TO CALL+2
- JMP I LPAR / ELSE TO CALL+1
-
-/COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT
-/IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
-TERMT, 0
- CLA CLL
- JMS I GETNI /GET NEXT CHARACTER
- JMS I SSKIPI /IGNORE SPACES
- TAD (TERMS-1 /SET UP POINTER
- DCA SPNT
- DCA CNTRA /SET CNTRA TO 0
-TERMT1, CDF 10
- TAD I SPNT /GET AN ITEM
- CDF 0
- ISZ CNTRA /ADD 1 TO ITEM #
- SNA
- JMP TERMTE /WAS 0, END
- CIA
- TAD CHAR /SAME AS THIS?
- SNA CLA
- JMP I TERMT /YES, TO CALL+1
- JMP TERMT1
-TERMTE, ISZ TERMT /DIDN'T FIND IT, TO
- JMP I TERMT / CALL+2
-
-/DOUBLE-PRECISION ROUTINES
-
-DADD, 0 /D.P. ADD
- CLL
- TAD OPER1
- TAD ACC1 /ADD LOW ORDER PARTS
- DCA ACC1
- RAL /GET CARRY TO AC11
- TAD OPER2 /ADD HIGH ORDER PARTS
- TAD ACC2
- DCA ACC2 /STORE HIGH ORDER PART
- JMP I DADD
-
-DSUB, 0 /D.P. SUBTRACT
- DCA DPSGN /ZERO IT FOR SAFETY
- JMS MULNEG /NEGATE OPERAND
- JMS DADD / & ADD
- JMP I DSUB
-
-DAND, 0 /D.P. LOGICAL AND
- TAD ACC2 /AND HIGH ORDER PARTS
- AND OPER2
- DCA ACC2
- TAD ACC1 /AND LOW ORDER PARTS
- AND OPER1
- DCA ACC1
- JMP I DAND /RETURN
-
-DIOR, 0 /D.P. LOGICAL INCLUSIVE OR
- TAD ACC2 /IOR HIGH ORDER PARTS
- CMA
- AND OPER2
- TAD ACC2
- DCA ACC2
- TAD ACC1 /IOR LOW ORDER PARTS
- CMA
- AND OPER1
- TAD ACC1
- DCA ACC1
- JMP I DIOR
-
-
-/SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
-/BUFFER. MUST BE IN 'BLOK.LOC' FORM. ONLY ".",
-/SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
-ARG, 0
- STA
-ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1]
- JMS EXPRIN / GET AN ARG
- JMS I SORTI /LOOK UP TERMINATOR
- ARGLST-1
- ARGOPS-ARGLST
-ERCQ, ERROR /ILLEGAL TERMINATOR
-/
-ARG2, JMS I GETNI /SKIP OVER "."
- TAD ACC1 /TERM = ".", SET 'BLOK'
- JMP ARG1
-/
-ARG3, JMP I ARG /TERM = " " OR CR
-
-
-/GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS
-/ A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
-/ 'ACCEPT'.
-EXPRIN, 0
- JMS I SSKIPI /IGNORE SPACES
- JMS LPAR /IS CHAR A "("?
- JMP EXPRI1
- JMS ACCEPT /NO, MUST BE A NUMBER
- JMP I EXPRIN
-/
-EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION
-ERC08, ERROR /CR = ILLEGAL TERMINATOR
- JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR
- SKP
- STA /NO, SET SWITCH
- DCA CRSWT /YES, RESET IT
- JMP I EXPRIN / & LEAVE...
-
-
-SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
- CLA
- TAD BLK /SET UP DESIRED BLOCK
- DCA CBLK
- JMS GETIO /DO NECESSARY I/O
- SKP CLA / READ ERROR!
- JMP I SCANER /THIS BLOCK IS OK!
- TAD BLK
- JMS I OCTI /OUTPUT BLOCK NUMBER
- JMS I TYPSI / & TELL IT'S BAD
- MSBAD
- JMS I CRLFI / TO ANOTHER LINE
- JMP I SCANER
-
-
-PAGE
- /SIGNED MULTIPLY AND DIVIDE ROUTINES
-
-DMUL, 0
- JMS MDCOM /MAKE DPAC POS, INITIALIZE
- SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE
- JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN
-DMUL1, TAD ACC2 /SHIFT RIGHT & OUT
- RAR
- DCA ACC2 /THRU HI OF LO
- TAD ACC1
- RAR
- DCA ACC1 /THRU LO OF LO INTO LINK
- ISZ DPNEG /DONE YET?
- JMP DMUL2 /NO, CONTINUE
-DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT
- RAR
- SZL CLA /SKIP IF SIGN OK
- JMS DPNEG /NOT OK, NEGATE
- JMP I DMUL
-/
-DMUL2, SNL /ADD IN THIS TIME?
- JMP DMUL3 /NO, BIT OUT WAS 0
- CLA CLL /YES, BIT WAS 1
- TAD OPER1 /START WITH LOW
- TAD ACCX1
- DCA ACCX1
- CLA RAL /GET CARRY
- TAD OPER2 /ADD HIGH PARTS
-DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT
- RAR
- DCA ACCX2
- TAD ACCX1
- RAR
- DCA ACCX1
- JMP DMUL1
-
-DDIV, 0
- TAD DDIV /MOVE RETURN ADDRESS
- DCA DMUL
- JMS MDCOM /MAKE DPAC POS, INITIALIZE
- SMA CLA /IS DIVISOR NEGATIVE?
- JMS MULNEG / NO, NEGATE IT & SET SIGN
- SZL / IS IT 0? (CARRY OUT ON NEGATE)
-ERCX, ERROR / YES, YOU LOST
- ISZ DPSGN /CORRECT FOR SIGN DIF IN * & /
-DDIV1, TAD ACCX1 /SUBTRACT LO OF LO
- TAD OPER1
- DCA ACCX1
- CLA RAL /CARRY TO AC
- TAD ACCX2 /SUBTRACT HI OF LO
- TAD OPER2
- SPA /TOO FAR?
- JMP DDIV2 /YES
- CLL CML /NO, SET LINK
- DCA ACCX2
- JMP DDIV3
-DDIV2, CLA
- TAD OPER1 /RESET LO ORDER PART
- CIA
- TAD ACCX1
- DCA ACCX1
- CLL /RESET LINK
-DDIV3, TAD ACC1 /BEGIN SHIFTING
- RAL
- DCA ACC1
- TAD ACC2
- RAL
- DCA ACC2
- ISZ DPNEG /DONE YET?
- SKP
- JMP DMUL4 /YES, CHECK SIGN & RETURN
- TAD ACCX1 /NO, KEEP SHIFTING
- RAL
- DCA ACCX1
- TAD ACCX2
- RAL
- DCA ACCX2
- JMP DDIV1
-
-MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE
- DCA DPSGN /RESET SIGN
- TAD ACC2 /IS DPAC POS?
- SPA CLA
- JMS DPNEG /NO, NEGATE
- DCA ACCX2 / 0 => DPACX
- DCA ACCX1
- TAD (-31 /INITIALIZE COUNTER
- DCA DPNEG
- CLL
- TAD OPER2 /RETURN W. HIGH OPERAND
- JMP I MDCOM
-
-MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR
- TAD OPER1 /DO LO-ORDER PART
- CLL CIA
- DCA OPER1
- TAD OPER2 /DO HI-ORDER PART
- CMA
- SZL /CARRY?
- CLL IAC /YES, ADD IT IN
- DCA OPER2
- ISZ DPSGN /SIGN CHANGE MADE
- JMP I MULNEG
-
-DPNEG, 0 /NEGATE THE D.P.AC.
- TAD ACC1 /DO LO-ORDER PART
- CLL CIA
- DCA ACC1
- TAD ACC2 /DO HI-ORDER PART
- CMA
- SZL /CARRY?
- CLL IAC /YES, ADD IT IN
- DCA ACC2
- ISZ DPSGN /SIGN CHANGE MADE
- JMP I DPNEG
-
-
-BLKTST, 0 /TEST & SET BLK
- DCA DPNEG /SAVE DATA
- TAD DPNEG /GET IT BACK AGAIN
- ISZ DPNEG /LEGAL BLOCK NUMBER?
- DCA BLK / YES IF NOT 7777 (-1)
- CLA / IF NOT, CLEAR JUNK
- JMP I BLKTST
-
-
-DICAD, 0 /"DCA I CAD" IN FIELD 1
- CDF 10
- DCA I CAD
- CDF 0
- JMP I DICAD
-
-TICAD, 0 /"TAD I CAD" IN FIELD 1
- CDF 10
- TAD I CAD
- CDF 0
- JMP I TICAD
-
-
-PAGE
- /CHECK IF THE COMMAND BUFFER STARTS WITH A WORD. IF
-/IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
-/ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
-/IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
-/TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
-/TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
-/QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
-/LITERALS, NOT COMMANDS]. IF THE PARENS MATCH AND
-/THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
-/CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
-/COMMAND TO BE EXECUTED SO RETURN TO CALL+1. OTHER-
-/WISE RETURN TO 'MAIN3' AS ABOVE.
-
-WCHEK, 0
- JMS I GWORDI /COM BUF BEGIN WITH A WORD?
- JMP WCHEK2 /NO, TEST FOR PARENS, ETC.
-WCHEK1, STA
- TAD COMIR /YES, BACK UP COMIR
- DCA COMIR
- TAD TEMP /AND USE THE SPECIAL CHAR AS
- JMP I .+1 / PART OF THE COMMAND STRING
- RESPC+1
-/
-WCHEK2, STA
- TAD COMOUT /SET UP ANOTHER A-XR
- DCA DPNT
- DCA CNT /RESET (OR SET) PAREN COUNT
-WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF.
- JMS I SORTI / & GO TEST IT
- WCKLST-1
- WCKOPS-WCKLST
- JMP WCHEK3 /NONE, CONTINUE SCAN
-/
-WCHEK4, TAD CNT /CR, DO PARENS MATCH?
- SZA CLA
- JMP WCHEK1 /NO, CONTINUE COMMAND INPUT
- JMP I WCHEK /YES, INPUT IS DONE
-/
-WCHEK5, STA CLL RAL /SET TO -2
- IAC /AC = +1 OR -1
- TAD CNT / UPDATE PAREN COUNT
- JMP WCHEK3-1 / & CONTINUE SCAN
-/
-WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS
- JMS WCHONE / " -- 1 CHARACTER
- JMP WCHEK3 /OK, CONTINUE SCAN
-
-WCHONE, 0
- TADIDP /GET NEXT CHAR
- TAD M215 /IS IT A CR?
- SNA CLA
- JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL
- JMP I WCHONE /NO, OK
- /FPP INSTRUCTION DECODING SUPPORT SUBROUTINES
-
-GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11
- TADICAD
- AND N7000
- CLL RTL
- RTL
- JMP I GETOP
-
-GET678, 0 /GET BITS 678 TO BITS 9-11
- TADICAD
- CLL RTR
- RAR
- AND N7
- JMP I GET678
-
-MULT3, 0 /MULTIPLY AC BY THREE
- DCA GETOP
- TAD GETOP
- CLL RAL
- TAD GETOP /WORKS FOR POS OR NEG!
- JMP I MULT3
-
-CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION
- TAD I CONDIT /GET LEADING 1 OR 2 CHARS
- ISZ CONDIT
- JMS I TWOT / & OUTPUT THEM
- JMS GET678 /GET CONDITION CODE
- JMS I SYMTYI / AS INDEX TO TABLE
- FPCOND
- -1
- JMP I CONDIT
-SYMTYI, SYMTYP
-
-FLDOUT, 0 /OUTPUT FIELD DIGIT & "*"
- TADICAD
- AND N7 /GET FIELD
- JMS I RTL6I / TO BITS 3-5
- JMS I TWOCI / & OUTPUT "F*"
- 6052 / WHERE "F" IS DIGIT
- JMP I FLDOUT
-
-
-
- DECIMAL /SET RADIX TO DECIMAL
-
-TEMPL= . /ARGUMENT BUFFER
- /L(TEMPL)=180(10)
-F0END= TEMPL+180
- DMPHAN-F0END /(SHOW SPACE LEFT)
-
- OCTAL
-
-PAGE /****** MUST BE NO LITERALS! ******
-
-DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES
-
-DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS
-
-
-IFNZRO DMPHAN-F0END&4000 <BADERR,__CAN'T RUN>
-
-/IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
-/ RUNNING THE DUMP DEVICE HANDLER.
-
-
-*TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID
-
-INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
- CDF 10
- TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE"
- CDF 0
- AND N200 / (BIT 4 OF 17726)
- SNA CLA
- JMP INIDAT / NOT SET, GO SET UP DATE
-INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO
- SNA
- JMP INIDAT / ERASE CHARACTERS FROM SCREEN
- DCA I DPNT / AND FROM BUFFER (MUCH EASIER
- JMP INISCO / THAN ON HARD COPY!)
-/
-INIDAT, CDF 10 /NOW INIT EXTENDED DATE
- TAD I (7666 /GET SYSTEM DATE WORD
- CDF 0
- AND N7 /PICK OFF THIS YEAR PART
- CIA
- DCA YRTEST / AND SET TEST YEAR (NEG)
- TAD I M1 /NOW GET EXTENDED YEAR BITS
- AND (600 / FROM "B.I.P." WORD AND
- CLL RTR / MOVE TO BITS 7,8 (*8)
- RTR
- TAD (106 /ADD TO A STARTING BASE OF 70[10]
- CIA
- TAD YRTEST /AND ADD THIS YEAR ALSO
- CIA
- DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR
- TAD I (7746 /GET JSW
- AND (6777 /CLEAR BIT 2 (CAN RESTART!)
- CLL RAR
- STL RAL /SET BIT 11 (DON'T SAVE FIELD 1)
- DCA I (7746 /& PUT IT BACK
- JMS I (7607 /WRITE ERROR MESSAGES
- 4610 / 6 PAGES, FIELD 1
- 0 / FROM LOC 10000
- 27 / NORMAL SAVE AREA!
- SKP CLA
- JMP I INIMSG /OK, JUST EXIT
- TAD M200
- DCA XERR3 /FAILED, ASSUME WRITE LOCKED
- TAD (ERROR / SO NO ERROR MESSAGES ON
- DCA ERC15 / ERROR OR "SHOW ERRORS"
- JMP I INIMSG
-
-
-PAGE /LITERALS HERE ARE OK!
- /INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
-/ OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS.
-
-START, CLA SKP /NORMAL
- STA /CHAINED (FROM CCL!)
- DCA TEMP
- CDF 10
- DCA I (CCBB /ZAP CCB SWITCH
- CDF 0
- TAD N200
- DCA I (7745 /RESET START ADDRESS
- JMS INIMSG /INIT SCOPE, DATE & ERROR MESSAGES
- JMS BATSET /TEST & SET UP FOR BATCH
- ISZ TEMP /CHAINED?
- JMP I (201 / NO, START IT UP!
- CDF 10
- TAD I M200 /YES, 1ST OUTPUT DEVICE?
- CDF 0
- AND (17 /(IGNORE LENGTH SPEC)
- SNA
- JMP STSWIT / NO, LEAVE AS SYS
- DCA DEVNO /YES, SET DEVICE NUMBER
- TAD DEVNO
- CALUSR /NOW DO HANDLER FETCH BY
- 1 / NUMBER (PAINTING?)
-STDEV, DEVHAN+1 /--2 PAGES--
- JMP STERR /ARGGGG! FAILED!!!
- TAD STDEV
- DCA DEVAD /SET UP HANDLER ENTRY
- TAD M200
- DCA DPNT /SET UP FIELD 1 POINTER
- TADIDP /GET NAME OF FILE
- DCA NAM1
- TADIDP
- DCA NAM2
- TADIDP
- DCA NAM3
- TADIDP /GET EXTENSION
- DCA NAM4
- TAD NAM1 /WAS THERE REALLY A NAME?
- SZA CLA
- STA / YES, SET NAME SWITCH
- DCA TEMP / NO, RESET
- CDF 10
- DCA I (XDNAM /CLEAR DEVICE NAME WORDS
- DCA I (XDNAM+1
- TAD I DPNT /GET NEXT WORD & TEST FOR ZERO
- SZA CLA
- JMP STSWIT / SOMETHING NOT RIGHT!
- TAD I DPNT /OK, ASSUME CCL CHAIN & SET
- DCA I (XDNAM / UP DEVICE NAME
- TAD I DPNT
- DCA I (XDNAM+1
- TAD I (XDNAM /EMPTY?
- SZA CLA
- JMP STSWIT
- TAD (0423 /YES, MUST BE DEFAULT NAME--
- DCA I (XDNAM / "DSK"
- TAD (1300
- DCA I (XDNAM+1
-STSWIT, CDF 10
- TAD I (7643 /TEST SWITCHES
- AND N200 / "/E"?
- DCA ERMODE / 0= LONG, NON-0= SHORT
- IAC
- AND I (7643 / "/L"? [LOAD]
- SNA CLA
- JMP STSWO /NO, CHECK NEXT
- TAD NAM4 /YES, SET DEFAULT EXTENSION
- SNA
- TAD (1404 / TO ".LD"
- DCA NAM4
- IAC
- JMP STSWEX-2 / & GO SET MODE
-/
-STSWO, TAD I (7644
- AND (1000 / "/O"? [OFFSET]
- SNA CLA
- JMP STSWS /NO, GO CHECK LAST
- TAD I (7646 /YES, GET LOW 12 BITS OF
- CIA / "=NNNN" AS OFFSET AND
- DCA OFFSET / IT UP
- STA
- JMP STSWEX-1 / & GO SET MODE
-/
-STSWS, TAD I (7644 / "/S"? [SAVE]
- AND (40
- SNA CLA
- JMP STSWEX /NO, WAS NOT ANY THAT COUNT
- TAD NAM4 /YES, SET DEFAULT EXTENSION
- SNA
- TAD (2326 / TO ".SV"
- DCA NAM4
- IAC / & SET MODE
- DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD
-STSWEX, CDF 0
- ISZ TEMP /FILE NAME SPECIFIED?
- JMP I (201 / NO, JUST START
- DCA CRSWT /YES, SET SWITCH TO CR,
-STTLS, TLS / START TTY *** BATCH OPER.
- JMS I CRLFI / & DO CR/LF
- TAD NAM4 /ANY EXTENSION SPECIFIED?
- SNA CLA
- STA / NO--ALLOW 3 TRIES: SV, LD, NULL
- DCA TEMP1 / ELSE ALLOW ONLY 1 TRY
- TAD NAM4 /IF NO EXTENSION SET YET,
- SNA
- TAD (2326 / SET TO START DEFAULTS WITH SV
- DCA NAM4
- JMP XFICHN /NOW GO DO FILE LOOKUP
-/
-STERR, TLS /START UP OUTPUT *** BATCH OPER.
- JMP ERCY / & GIVE ERROR!
-
-
-PAGE
- /INITIALIZATION CODE FOR BATCH OPERATION
-
-BATSET, 0
- TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP"
- RAL / (BATCH-IN-PROGRESS)
- SMA CLA
- JMP I BATSET / NO, INTERACTIVE MODE
- TAD I M1 / YES, GET FIELD BITS OF BATCH
- AND (70 / TO GENERATE A "CIF BAT"
- TAD (CIF / AND SET UP 3 CALLS:
- DCA CBATI / INPUT,
- TAD CBATI
- DCA CBATO / OUTPUT AND
- TAD CBATI
- DCA CBATE / ERROR.
-BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS
- SNA
- JMP I BATSET / 0 = ALL DONE!
- DCA DPNT /SET UP POINTER
-BATLUP, TAD I SCANX1 /GET A PATCH WORD
- SNA
- JMP BATMOV / 0 = GROUP END
-BATPAT, CDF 0 /CHANGED FOR "TYPEB"!!
- DCA I DPNT /PATCH THE WORD
- CDF 0
- JMP BATLUP /DO IT AGAIN!
-
-
-/"SCOPE MODE" PATCHES FOR RUBOUT HANDLER. INITIAL-
-/ IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
-/ BATCH. THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
-/ SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
-/ BATCH. THIS SEQUENCE IS REQUIRED!
-
-SCOPLS, RELOC RUBO
- JMS BTEST /BUFFER NOW EMPTY?
- JMP RENEXT / YES, JUST IGNORE RUBOUT
- STA
- TAD COMIR /NO, BACK UP POINTER
- DCA COMIR
- TAD COMIR /SET UP POINTER FOR TESTING, ALSO
- DCA COMOUT
- JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE
- JMS I GETNI /GET RUBBED OUT CHAR AND TEST
- TAD CHAR
- TAD M240 / FOR A CONTROL CHAR
- SPA CLA
- JMS RUBO2 /YES, ERASE "^" ALSO!
- JMP RENEXT /TRY FOR ANOTHER CHAR
-
-RUBO2, HLT /MUST BE NON-ZERO!!!
- JMS I TYPEAI /OUTPUT A BACKSPACE,
- "H-100 /(CTRL-H)
- SPACE1 / SPACE,
- JMS I TYPEAI / BACKSPACE SEQUENCE TO
- "H-100 / CLEAR OFF SCREEN CHAR
- JMP I RUBO2
-TYPEAI, TYPEA
- 0
-
- RELOC
-
-
-BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.
-
- RUBO-1 /==== INPUT PATCHES ====
- RELOC RUBO
- DCA CHAR /SAVE NEW CHAR INPUT
- TAD CHAR /IS THIS A FORM-FEED?
- TAD RM214
- SNA
- JMP RKEY+1 / YES, JUST IGNORE IT!
- TAD R2 /NO, THEN IS IT A LINE-FEED?
- SNA CLA
- TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN?
- TAD M215
- SZA CLA
- TAD CHAR /NO TO ONE OR OTHER, USE CHAR.
- DCA RLAST / YES TO BOTH, SET TO 0!
- TAD RLAST /OK, WAS IT A CR-LF PAIR?
- SNA CLA
- JMP RKEY+1 / YES, JUST IGNORE LF!
- JMP REKEY+1 / NO, GO USE THIS CHAR
-
-BATINI, 5400 /IN THE BATCH FIELD
-RM214, -214
-R2, 2
-RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !!
- 0
-
- RKEY+1-1
- RELOC /TO PUT 'CBATI' ON THIS PAGE
-CBATI= .+1 /REALLY ON "CIF BAT"
- RELOC RKEY+1
- JMS I CTRLI /CHECK FOR CONTROL KEYS
- CIF /*** CIF BAT
- JMS I BATINI /GET A BATCH CHARACTER
-ERC17, ERROR /!!! EOF ON INPUT !!!
- NOP /FILLER FOR INTERACTIVE CTRL-Q
- NOP
- 0
-
- RKEY0-1
- RELOC RKEY0
- JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH
- NOP / & RETURN TO CALL+1!
- 0
-
- BCTRLC-1
- RELOC BCTRLC
- JMP I CTRLCI /CTRL-C, ABORT JOB STREAM!
- 0
-
- RELOC /==== OUTPUT PATCHES ====
- 201-1
- NOP
- 0
-
- STTLS-1
- NOP /ZAP 3 "TLS"S USED FOR STARTUP
- 0
-
- STERR-1
- NOP
- 0
-
- RELOC /==== ERROR PATCH ====
-
- XERR4-1
-CBATE= . /REALLY ON "CIF BAT"
- RELOC XERR4
- CIF /*** CIF BAT
- JMP I N7000 /ABORT TO BATCH FIELD!
- 0
-
- RELOC
-
- BATPAT-1
- CDF 10 /*** NEXT CODE IN FIELD 1 ***
- 0
-
- TYPEB-1
- RELOC
-CBATO= .+1 /REALLY ON "CIF BAT"
- IFDEF TYPEB </NO PASS1 ERROR!
- RELOC TYPEB /*** REALLY IN FIELD 1 ***
- >
- CDF 10 /*** SET UP RETURN D.F.
- CIF /*** CIF BAT
- JMS I .+1 /OUTPUT A CHARACTER TO LOG
- 7400 /BATOUT, IN THE BATCH FIELD
- CDF 0 /*** RESET D.F.
- 0
-
- RELOC
-
- 0
- PAGE
-
-
-
-
- *7000
- /NEW CODE TO HANDLE 128K SUPPORT
-ADFLD, 0 /ADJUSTS BANK AND FIELD FOR CCB PRINTING
- TAD TEMP2
- AND (76
- CLL RTR
- SZL
- TAD (20
- CLL RTL
- JMS I (FPRNT
- JMP I ADFLD
-FPRNTX, 0 /ROUTINE TO PRINT BANK BITS
- AND (174 /ISOLATE BANK AND FIELD BITS
- DCA FLD
- TAD FLD
- AND (104 /ISOLATE BANK BITS
- CLL RTR /SSWITCH THEM AROUND
- RAR
- SZL
- TAD (4
- CLL RTR
- DIGIT /PRINT BANK BITS
- TAD FLD
- JMP I FPRNTX
-FLD, 0
-
-FIELD 1 /THE END OF FIELD 0!
- *10000 /PUT A POINTER HERE!
-
- NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE
-
-
-/ERROR MESSAGES AND ADDRESS LIST. THESE ITEMS RESIDE
-/ UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
-/ WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
-/ USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
-/ OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN. IT IS
-/ TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
-/ FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
-/ MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
-/ OR "SET DEVICE ...DDEV..." COMMANDS.
-
-*10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)
-
-/LIST OF ADDRESSES OF ERROR MESSAGES
-
- ERMSA
- ERMSB
- ERMSC
- ERMS14
- ERMSD
- ERMSE
- ERMSG
- ERMSH
- ERMSI
- ERMSK
- ERMSJ
- ERMSXO
- ERMSL
- ERMSZ
- ERMSO
- ERMS11
- ERMS04
- ERMSP
- ERMSQ
- ERMSR
- ERMS09
- ERMS08
- ERMS13
- ERMSS
- ERMST
- ERMSU
- ERMSV
- ERMSW
- ERMSX
- ERMSY
- ERMSM
- ERMS00
- ERMS01
- ERMS02
- ERMS03
- ERMS10
- ERMSF
- ERMSGC
- ERMSHD
- ERMS05
- ERMS07
- ERMS18
- ERMS19
- ERMS20
- ERMS15
- ERMS16
-EMSEND, ERMS17
- ERMS99
-
-
-/ERROR MESSAGES:
-
-ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND&
-
-ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND&
-
-ERMSC, TEXT &TOO MANY ")"S&
-
-ERMSD, TEXT &ILLEGAL FORMAT WORD&
-
-ERMSE, TEXT &BAD FORMAT SYNTAX&
-
-ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
-
-ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
-
-ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
-
-ERMSG, TEXT &ILLEGAL ITEM TO SHOW&
-
-ERMSH, TEXT &ILLEGAL SEARCH MODIFIER&
-
-ERMSI, TEXT &BAD SEARCH SYNTAX&
-
-ERMSJ, TEXT &ILLEGAL MODE&
-
-ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
-
-ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
-
-ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
-
-ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
-
-ERMSO, TEXT &ILLEGAL MODIFY FORMAT&
-
-ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM&
-
-ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
-
-ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
-
-ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
-
-ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION&
-
-ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
-
-ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION&
-
-ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION&
-
-ERMSX, TEXT &DIVISION BY 0 ATTEMPTED&
-
-ERMSY, TEXT &UNKNOWN HANDLER NAME&
-
-ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION&
-
-ERMS01, TEXT &NON-&
- *.-1
-
-ERMS00, TEXT &FATAL READ ERROR&
-
-ERMS03, TEXT &NON-&
- *.-1
-
-ERMS02, TEXT &FATAL WRITE ERROR&
-
-ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
-
-ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
-
-/ERMS06,
-
-ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
-
-ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
-
-ERMS09, TEXT &ILLEGAL DIGIT&
-
-ERMS10, TEXT &DUMP HANDLER ERROR&
-
-ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
-
-/ERMS12,
-
-ERMS13, TEXT &ILLEGAL USE OF ' OR "&
-
-ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
-
-ERMS15, TEXT &NO ERROR MESSAGES&
-
-ERMS16, TEXT &INPUT ERROR ON MESSAGES&
-
-ERMS17, TEXT &EOF ON BATCH INPUT&
-
-ERMS18, TEXT &ENTER FAILED&
-
-ERMS19, TEXT &CLOSE FAILED&
-
-ERMS20, TEXT &DUMP FILE OVERRUN&
-
-ERMS99, TEXT &DEBUG&
- *12000 /BEGIN ABOVE THE USR AREA
-
-/GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
-/ LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
-/ ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
-/ FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
-/ CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
-/ BE USED FOR THE APPROPRIATE PURPOSE.
-
-GCCB, 0 /GET CORE-CONTROL-BLOCK
- JMS CCBHDR /DO COMMON TEST & READ-IN
- CLL RAL /ADJUSTS FOR 128K INDICATOR BIT
- STL RAR
- SMA CLA /1ST WORD (-# SEGS) NEG?
- JMP GCCERR / NO, CAN'T BE CCB
- TAD I (CCBB+3 /GET JOB STATUS WORD
- AND (200 /OVERLAY BIT SET (LINK)?
- SZA CLA / 0 = NO
- TAD (CCBB+140-1 / 1 = YES, START ADDR-1
- CDF 0
- DCA I (OVLFLG /NO = 0; YES = ADDR-1
- CDF 10
- TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"?
- AND (7603
-CIA
- TAD GCCCDF
- SZA CLA
-GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW!
- ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ?
- JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN
- TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
-GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS
- TAD GHDR /GET A WORD - PAGES-V7C
- TAD (-6603 /V7C
- SNA CLA /V7C
- JMP GCCB2 / 0 = DONE
- TAD I GHDR /V7C
- IAC /ROUND DOWN IN 2 STEPS FOR PDP-8
- CLL RAR
- DCA I GHDR /STORE A WORD - BLOCKS
- TAD GHDR /UPDATE POINTER TO NEXT
- TAD (4
- JMP GCCB1
-/
-GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR
- TAD I SEGNI /GET -# SEGMENTS
- CLL RAL
- STL RAR /ADJUSTS FOR 128K INDICATOR BIT
-GCCCDF, CDF CIF 0
- JMP I GCCB /OK, RETURN VALUE
-
-GHDR, 0 /GET HEADER BLOCK (FORTRAN IV)
- TAD (3 /TO SET UP CCBB+6
- JMS CCBHDR /DO COMMON TEST & READ-IN
- TAD (-2 /1ST WORD MUST BE EXACTLY 2
- SZA CLA
- JMP HDRERR / NO, CAN'T BE A HEADER
- ISZ GETSWX /1ST TIME THRU SINCE READ?
- JMP GHDR1 / NO, DON'T CHANGE ANYTHING
- DCA I (CCBB+47 /YES, BE SURE THESE WORDS
- DCA I (CCBB+50 / ARE 0 FOR USERS
- TAD I (CCBB+1 /GET START FIELD WORD
- SNA
- JMP HDRERR / SHOULD BE 1 THRU 7
- CLL RTL /LOOKS OK, MOVE FIELD TO BITS
- RAL / 6-8 TO HELP "SHOW HEAD"
- DCA I (CCBB+1
- TAD I (CCBB+1 /ARE THESE ONLY BITS SET?
- AND (7707
- SZA CLA
- JMP HDRERR / NO, SOMETHING MUST BE BAD
- TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE
- SNA
- JMP HDRERR / SHOULD BE 1 THRU 7
- AND (7770
- SZA CLA
-HDRERR, JMS ERROR1
-GHDR1, DCA GETSWX /MAKE SURE THIS IS 0
- NOP /AC NON-ZERO FOR OK-V7C
- CDF CIF 0
- JMP I GHDR /OK, BACK TO USER
-
-CCBHDR, 0
- TAD (CCBB+3 /CCBB+6 FOR GHDR
- CDF 0
- DCA I (GETPNT /SET UP POINTER FOR 'GET'
- TAD I (DEVAD /GET ADDR OF DEVICE
- DCA DEVADX / HANDLER & SAVE HERE
- TAD I (RBLK1 /GET START BLOCK NUMBER
- SNA
-ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR
- CDF 10
- DCA GCCBLK /OK, SET UP 1ST BLOCK
- TAD I SEGNI /IS SOMETHING IN MEMORY?
- SZA
- JMP I CCBHDR / YES, RETURN 1ST WORD
- CIF 0
- JMS I DEVADX /NO, READ 1ST BLOCK OF FILE
- 0110 /READ; 1 PAGE; FIELD 1
-SEGNI, CCBB /BUFFER IS HERE
-GCCBLK, 0 /BLOCK NUMBER
- JMP RDERX /...BAD NEWS...
- STA
- DCA GETSWX /OK, SET "JUST READ" SWITCH
- TAD I SEGNI /AND GET 1ST WORD
- JMP I CCBHDR
-/
-RDERX, CDF CIF 0 /RETURN TO FIELD 0
- JMP I (RERROR / FOR READ ERROR
-
-DEVADX, 0
-GETSWX, 0
-
-
-MSMOD, TEXT " MOD"
-
-MSBAD, TEXT " BAD BLOCK"
-
-
-PAGE
- /CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0
-
-/CONTINUATION OF 'SET' 'DDEV' HANDLER
-
-XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS
- TAD I (GDEV2
- DCA DDEVNO / AND DEVICE NUMBER
- CDF 10
- TAD DDEVNO /LOOK AT DCW FOR SPECIFIED
- TAD (7760-1 / DEVICE TO SEE IF FILE
- DCA DDCWPT / STRUCTURED.
- TAD I DDCWPT /BIT 0 = 1 FOR FILES
- SMA CLA
- TAD (212 / NO, LINE-AT-A-TIME
- DCA DDEVS / YES, BLOCK-AT-A-TIME
- TAD DMPADR /OK, INITIALIZE OUTPUT POINTER
- DCA DMPPTR
- DCA XOSIZ / AND ZERO BLOCK COUNTER
- DCA DNAM / AND CLEAR ANY FILE NAME
- IAC
- DCA DMPBLK / AND SET BLOCK NUMBER TO 1
- JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT
-
-
-/CONTINUATION OF EXECUTION OF 'OPEN' COMMAND
-
-XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE
- DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!)
- TAD I DPNT /MOVE THE FILE NAME UP HERE
- DCA DNAM
- TAD I DPNT
- DCA DNAM+1
- TAD I DPNT
- DCA DNAM+2
- TAD I DPNT /GET THE EXTENSION PART
- ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED?
- JMP XOPEN2
- CLA
- TAD (0425 / NO, DEFAULT TO ".DU"
-XOPEN2, DCA DNAM+3
- TAD XCLNAM /SET UP POINTER TO NAME FOR USR
- DCA XOBLK
- CDF 10 /SET UP RETURN FIELD
- TAD I DDCWPT /CLEAR ANY OPEN FILE ON
- AND (7770 / THIS DEVICE SO "OPEN"
- DCA I DDCWPT / CAN BE DONE WHENEVER!
- CIF 0 /SET UP SUBROUTINE FIELD
- TAD DDEVNO /GET DUMP DEVICE NUMBER
- JMS USEUSR / AND GO GET USR & CALL IT.
- 3 /ENTER
-XOBLK, 0 /NAME POINTER, BECOMES START BLK
-XOSIZ, 0 / BECOMES -# BLOCKS CAN USE
-ERC18, JMS ERROR1 /THE ENTER FAILED!
- TAD XOBLK /OK! SET UP FILE START BLOCK
- DCA DMPBLK
- TAD DMPADR /INITIALIZE POINTER
- DCA DMPPTR
-XOCEX, CDF CIF 0
- JMP MAIN1 /TRY NEXT COMMAND
-
-DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE)
-DDEVNO, 1 /INIT THIS TO "SYS:" ALSO.
-DDCWPT, 7760 / THIS ALSO
-
-DNAM, 0 /DUMP FILE NAME, INIT TO NULL
- 0
- 0
- 0 /(EXTENSION HERE)
-
-
-/CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND
-
-XCLOS1, TAD DNAM /IS ANY FILE OPEN?
- SNA CLA
- JMP XOCEX / NO, IGNORE COMMAND
- TAD XCTLZ / YES, OUTPUT A CTRL-Z
- JMS DMPOUT / AND FILL TO END
-XCTLZ, "Z-100
- TAD XOBLK /OK, CALCULATE FILE SIZE
- CIA
- TAD DMPBLK /= NEXT - START
- DCA XCLSIZ /= FILE SIZE IN BLOCKS
- TAD DDEVNO /GET DUMP DEVICE NUMBER
- CIF 0
- JMS USEUSR /GET USR AND CALL IT
- 4 /CLOSE
-XCLNAM, DNAM /POINTER TO FILE NAME
-XCLSIZ, 0 /SIZE OF NEW FILE
-ERC19, JMS ERROR1 /OH NO! CLOSE FAILED!
- DCA DNAM /OK, ZAP KNOWLEDGE OF FILE
- JMP XOCEX
-
-
-DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE
- DCA DMPCHR /SAVE THE CHARACTER
- TAD DMPCHR /PUT IT INTO FILE BUFFER
- CDF 10 /(MUST BE SURE!)
-DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR
- ISZ DMPPTR
- TAD DMPPTR /NOW AT END OF BUFFER?
- TAD (-DMPBUF-400
- SNA CLA
- JMP DMPIT / YES, DUMP BUFFER NOW
- TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR?
- CIA
- TAD I DMPOUT /(THE TEST CHAR @ CALL+1)
- SNA CLA
- JMP DMPNUL / YES, FILL WITH NULLS!
- JMP I DMPOUT / NO, EXECUTE FILL CHAR
-/
-DMPIT, CIF 0
- JMS I DDEVAD /CALL DUMP FILE HANDLER
- 4210 /WRITE, 2 PAGES, FIELD 1
-DMPADR, DMPBUF
-DMPBLK, 1 /BLOCK NUMBER
-ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE!
- TAD DMPADR /NOW RESET OUTPUT POINTER
- DCA DMPPTR
- ISZ DMPBLK /INCREMENT BLOCK NUMBER
- ISZ XOSIZ /ANY MORE SPACE LEFT?
- JMP I DMPOUT / YES, EXIT NOW
- DCA DNAM / NO! ZAP DUMP FILE
-ERC20, JMS ERROR1 / AND DIE!
-DMPCHR, 0
-DMPPTR, 0 /CHARACTER OUTPUT POINTER
-
-
-PAGE
- /CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE
-
-TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL
- AND I (DSWIT / SO TEST FOR PART&DSWIT
- SZA CLA
- JMP TYPE2 /NO OUTPUT TO TTY
- TAD I (RTL6 /GET CHARACTER TO OUTPUT
-TYPEB, NOP /*** CDF 10 /*** BATCH
- TSF /*** CIF BAT /*** CHANGES
- JMP .-1 /*** JMS I .+1 /*** LOG
- TLS /*** 7400 /*** OUTPUT
- CLA /*** CDF 0
-TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST)
- TAD I (DSWIT /=4000 OR 4001 (DSWIT=1)
- AND I (DMODE /FILE= PART&DSWIT OR ALL
- SNA CLA
- JMP TYPE3 / OUTPUT TO TTY ONLY
- TAD DDEVS /FILE STRUCTURED OUTPUT?
- CDF 10
- SNA
- TAD I (DNAM / YES, FILE OPEN?
- CDF 0
- SNA CLA
- JMP TYPE3 / NO TO EITHER
- TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT
- JMS DMPOUT /OUTPUT IT & TEST FOR END
-DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE
-TYPE3, CDF CIF 0
- JMP TYPEX /BACK AND OUT
-
-
-ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD
- CLA /CLEAR POSSIBLE JUNK IN AC
- TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0
- CDF CIF 0
- DCA I (XERROR
- JMP I (XERROR+1
-
-
-XDDEV2, CDF 0 /NAME IS OVER THERE
- TAD I (NAM1 /MOVE DEVICE NAME INTO STRING
- DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV"
- TAD I (NAM2
- DCA XDDNAM+1
- CDF CIF 0
- JMP XSETN /BACK TO 'SET'
-
-MSDDEV, TEXT "@DDEV = SYS@"
-XDDNAM= .-3
-
-MSDEV, TEXT "@DEVICE = SYS@"
-
-XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME
-
-/CONTINUATION OF CODE FROM FIELD 0
-
-XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN
- TAD I (NAM2 / OUTPUT MESSAGE
- DCA XDNAM+1
- CDF 10
- DCA I (CCBB /NO C.C.B. OR HEADER PRESENT
- CDF CIF 0
- STA
- DCA I (RBLK /RESET BLOCK NUMBER
- JMP XSETN /GO DO NEXT OPTION
-
-
-MSERR, TEXT " ERROR CODES: FUTIL "
- *.-1
-
-/VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
-/ VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
-/ THE SOURCE INTO THE VERSION MESSAGE.
-
-MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1
- *.-2
-VERTEN= VERSION%12 /TENS DIGIT
-VERONE= -VERTEN^12+VERSION /ONES DIGIT
- VERTEN^100+VERONE+6060 /INSERT TWO DIGITS
- PATCH^100 /INSERT PATCH + NULL TERM
-
-/ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE
-
-MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
- TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
-
-
-PAGE
- /SYMBOLICS FOR PDP-8 INSTRUCTIONS:
-INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP "
- *.-1
-
-/ GROUP 1 MICRO-INSTS.:
-OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR "
- *.-1
-
-
-/ GROUP 2 MICRO-INST'S:
-OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
- *.-1
-
-/ EAE MICRO-INST'S:
-EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
- *.-1
- TEXT "DAD DST SWBADPSZDPICDCM SAM "
- *.-1
-
-CLANAM, 0314 /"CLA "
- 0140
-
-OPRMES, 1720 /"OPR "
- 2240
- / IOT INSTRUCTIONS:
-
-IOTTAB, 6000
- TEXT "SKON"
- 6001
- TEXT "ION@"
- 6002
- TEXT "IOF@"
- 6003
- TEXT "SRQ@"
- 6004
- TEXT "GTF@"
- 6005
- TEXT "RTF@"
- 6006
- TEXT "SGT@"
- 6007
- TEXT "CAF@"
- 6010
- TEXT "RPE@"
- 6011
- TEXT "RSF@"
- 6012
- TEXT "RRB@"
- 6014
- TEXT "RCF@"
- 6016
- TEXT "RCC@"
- 6020
- TEXT "PCE@"
- 6021
- TEXT "PSF@"
- 6022
- TEXT "PCF@"
- 6024
- TEXT "PPC@"
- 6026
- TEXT "PLS@"
- 6030
- TEXT "KCF@"
- 6031
- TEXT "KSF@"
- 6032
- TEXT "KCC@"
- 6034
- TEXT "KRS@"
- 6035
- TEXT "KIE@"
- 6036
- TEXT "KRB@"
- 6040
- TEXT "TFL@"
- 6041
- TEXT "TSF@"
- 6042
- TEXT "TCF@"
- 6044
- TEXT "TPC@"
- 6045
- TEXT "TSK@"
- 6046
- TEXT "TLS@"
- 6100
- TEXT "DPI@"
- 6101
- TEXT "SMP@"
- 6102
- TEXT "SPL@"
- 6103
- TEXT "EPI@"
- 6104
- TEXT "CMP@"
- 6105
- TEXT "S,CMP"
- 6106
- TEXT "CEP@"
- 6107
- TEXT "SPO@"
- 6110
- TEXT "RCTV"
- 6111
- TEXT "RCRL"
- 6112
- TEXT "RCRH"
- 6113
- TEXT "RCCV"
- 6114
- TEXT "RCGB"
- 6115
- TEXT "RCLC"
- 6116
- TEXT "RCCB"
- 6130
- TEXT "CLZE"
- 6131
- TEXT "CLSK"
- 6132
- TEXT "CLOE"
- 6133
- TEXT "CLAB"
- 6134
- TEXT "CLEN"
- 6135
- TEXT "CLSA"
- 6136
- TEXT "CLBA"
- 6137
- TEXT "CLCA"
- 6201
- TEXT "CDF 00"
- *.-1
- 6211
- TEXT "CDF 10"
- *.-1
- 6221
- TEXT "CDF 20"
- *.-1
- 6231
- TEXT "CDF 30"
- *.-1
- 6241
- TEXT "CDF 40"
- *.-1
- 6251
- TEXT "CDF 50"
- *.-1
- 6261
- TEXT "CDF 60"
- *.-1
- 6271
- TEXT "CDF 70"
- *.-1
- 6202
- TEXT "CIF 00"
- *.-1
- 6212
- TEXT "CIF 10"
- *.-1
- 6222
- TEXT "CIF 20"
- *.-1
- 6232
- TEXT "CIF 30"
- *.-1
- 6242
- TEXT "CIF 40"
- *.-1
- 6252
- TEXT "CIF 50"
- *.-1
- 6262
- TEXT "CIF 60"
- *.-1
- 6272
- TEXT "CIF 70"
- *.-1
- 6203
- TEXT "CDIF00"
- *.-1
- 6213
- TEXT "CDIF10"
- *.-1
- 6223
- TEXT "CDIF20"
- *.-1
- 6233
- TEXT "CDIF30"
- *.-1
- 6243
- TEXT "CDIF40"
- *.-1
- 6253
- TEXT "CDIF50"
- *.-1
- 6263
- TEXT "CDIF60"
- *.-1
- 6273
- TEXT "CDIF70"
- *.-1
- 6204
- TEXT "CINT"
- 6214
- TEXT "RDF@"
- 6224
- TEXT "RIF@"
- 6234
- TEXT "RIB@"
- 6244
- TEXT "RMF@"
- 6254
- TEXT "SINT"
- 6264
- TEXT "CUF@"
- 6274
- TEXT "SUF@"
- 6550
- TEXT "FFST"
- 6551
- TEXT "FPINT"
- 6552
- TEXT "FPICL"
- 6553
- TEXT "FPCOM"
- 6554
- TEXT "FPHLT"
- 6555
- TEXT "FPST"
- 6556
- TEXT "FPRST"
- 6557
- TEXT "FPIST"
- 6561
- TEXT "FMODE"
- 6563
- TEXT "FMRB"
- 6564
- TEXT "FMRP"
- 6565
- TEXT "FMDO"
- 6567
- TEXT "FPEP"
-
-
-NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION
-
- 0 /TABLE TERMINATOR
-
-
-/CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
-/ "ZBLOCK 200". SINCE EACH ENTRY REQUIRES 4 WORDS (THE
-/ ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
-/ CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
-/ ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
-/ AND THEIR NAMES. THESE CAN BE PATCHED IN DIRECTLY
-/ USING THE PROGRAM ITSELF. **** NOTE THAT THE CONTENTS
-/ OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
- /SYMBOLICS FOR FPP-12/8A INSTRUCTIONS
-
-MSBASE, TEXT " B+"
-
-MSINDI, TEXT "% B+"
-
-MSJNX, TEXT "JNX "
-
-/THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
-/ PLACES TO FORCE WORD ALIGNMENT AS NEEDED.
-
- TEXT "LEA@" /+1 WORD 0000
-FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
- TEXT "FMUL@@FADDM@FSTA@@FMULM"
-
- TEXT "UNUSEDSTARTE"
- *.-1
-FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
- TEXT "FNORM@STARTFSTARTDJAC@@"
-
-FPXR1S, TEXT "ALN ATX XTA "
-
-FPXR2S, TEXT "ADDX *,@LDX *,@"
-
-FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR "
-
-FPCOND, TEXT "EQGELEA@NELTGTAL"
-
-
-/CONTROL TABLES FOR FPP INSTRUCTION DECODING
-
-FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS
- 6
- 5
- 4
- 3
- 2
- 1
- 0 /END & FALL-OUT POINT
-
-FPPMOJ, SPCOP7
- SPCOP6
- SPCOP5
- SPCOP4
- SPCOP3
- SPCOP2
- SPCOP1
-
-FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE
- 160 / 0 SPECIALS
- 150
- 140
- 130
- 120
- 110
- 100
- 70
- 60
- 50
- 40
- 30
- 20
- 10
- 00
-
-FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES
- SPNUSE
- SPNUSE
- SPNUSE
- SPNUSE
- SPNUSE
- SPOP11
- SPOP10
- SPNUSE
- SPNUSE
- SPOP05
- SPOP04
- SPO123
- SPO123
- SPO123
- /MESSAGES:
-
-MS01, TEXT " = "
-
-MS07, 0023 /"SMASK = "
-MS02, TEXT "MASK = "
-
-MS03, TEXT "ABS. LOC = "
-
-MS04, TEXT "UPPER = "
-
-MS05, TEXT "LOWER = "
-
-MS06, TEXT "FORMAT = "
-
-MS08, TEXT "DIRECTORY"
-
-MS09, TEXT "OFFSET = "
-
-MS10, TEXT "MODE = "
-
-MS11, TEXT "CCB:"
-
-MS12, TEXT "ODT LOC = "
-
-MS13, TEXT ": "
-
-MS14, TEXT " CORE SEGS: "
-
-MS15, TEXT "LOOKUP FAILED"
-
-MS16, TEXT "FPP"
-
-MS17, TEXT " AT "
-
-MS18, TEXT " SA = "
-
-MS19, TEXT ", JSW = "
-
-MS20, TEXT "REL. LOC = "
-
-MS21, TEXT "PACKED"
-
-MS22, TEXT "ASCII"
-
-MS23, TEXT "OS/8"
-
-MS24, 2516 /"UNSIGNED"
-
-MS25, TEXT "SIGNED"
-
-MS26, TEXT "OCTAL"
-
-MS27, TEXT "OFFSET"
-
-MS28, TEXT "SAVE"
-
-MS29, TEXT "NORMAL"
-
-MS30, TEXT "OUTPUT = "
-
-MS31, TEXT "PDP"
-
-MS32, TEXT "BLOCK = "
-
-MS33, TEXT ") "
-
-MS34, TEXT "LOAD"
-
-MS35, TEXT "BCD"
-
-MS36, TEXT "BYTE"
-
-MS37, TEXT "FILLER = "
-
-MS38, TEXT "HEADER:"
-
-MS39, TEXT ", NEXT WORD = "
-
-MS40, TEXT ", LOAD V "
-
-MS41, TEXT ", E.P. REQ'D"
-
-MS42, TEXT " OVLYS START BLOCK LENGTH"
-
-MS43, TEXT "XS240"
- /MAIN LOOP CHARACTER LIST
-CCHARL, "#
- "$
- "%
- "&
- ":
- "<
- "=
- ">
- "?
- "@
- "[
- "\
- "]
- "/
- "!
- "+
- "-
- ";
- "^
- "_
-/'TYPE' COMMAND LIST
-TYPEL, 211 /TAB
- 233 /ALT MODES
- 375
- 376
-/'XMODIF' CHECK LIST
-TYPEM, 215 /CR
- 212 /LF
- 0
-
-/ADDRESSES FOR 'OMODES'
-OTABLE, BPRT /#
- OSTYPE /$
- BYTEO /%
- XS240O /&
- SGNDP /:
- OPRT /<
- DPRT /=
- PDPOUT />
- DIROUT /?
- PDATE /@
- ASCII /[
- FPPOUT /\
- PACOUT /]
-
-/MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
-COPSL, OMODES
- OMODES
- OMODES
- OMODES
- OMODES
- OMODES
- OMODES /SEE ABOVE LIST
- OMODES
- OMODES
- OMODES
- OMODES
- OMODES
- OMODES
- SLASH
- EXCL
- PLUS
- MINUS
- SEMIC
- UPARR
- BACKAR
- RESPC
- ALTMOD
- ALTMOD
- ALTMOD
- CRCR
- LFLF
-
-/'TYPE' JUMP LIST
-TYPEOP, TYPTAB
- TYPALT
- TYPALT
- TYPALT
- TYPCR
- TYPCR+1
-
-/COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
-CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
-
-/MAIN LOOP JUMP LIST - EXECUTE A COMMAND
-WOPSL, XVAL
- XVAL
- XDUMP
- XDUMP
- XLIST0
- XLIST0
- XFILE
- XFILE
- XOPEN
- XSCAN
- XSTRIN
- XSMASK
- XWORD
- XWORD
- XMODIF
- XMODIF
- XSHOW
- XSET
- XSET
- XWRARG
- XIF
- XEXIT
- MAIN1 /COMMENT
- MAIN1
-
-/LISTS FOR COMMANDS FOLLOWED BY A CR.
-CWORL2, TEXT "REWRENEXCLCOC@"
-
-WOPSLL, XREWIN /REWIND
- XWRITE /WRITE
- MAIN1 /END
- XEXIT /EXIT
- XCLOSE /CLOSE
- MAIN1 /COMMENT
- MAIN1
- /'XFORM' LISTS ----ORDER IS CRITICAL----
-FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
-
-FOPSL, XFCHR /PACKED (ASCII)
- XFCHR
- XFCHR /ASCII
- XFCHR
- XFCHR /OS/8 (ASCII, PACKED)
- XFCHR
- XFCHR /XS240 (ASCII, PACKED)
- XFCHR
- XFNUM /UNSIGNED (DECIMAL)
- XFNUM
- XFNUM /SIGNED (DECIMAL)
- XFNUM
- XFNUM /OCTAL
- XFNUM
- XFNUM /BCD
- XFNUM
- XFNUM /BYTE (OCTAL)
- XFNUM
- XFSYM /PDP (SYMBOLIC)
- XFSYM
- XFSYM /FPP (SYMBOLIC)
- XFSYM
- XFSYM /DIRECTORY
- XFSYM
-
-/ ROUTINE ADDRESS LIST
-
-FTABLE, PACOUT
- ASCII
- OSTYPE
- XS240O
- DPRT
- SGNDP
- OPRT
- BPRT
- BYTEO
- PDPDMP
- FPPDMP
- DIRDMP
-
-/'XSHFMT' DESCRIPTOR ADDRESS LIST
-FMTLS, MS21 /PACKED ASCII
- MS22 /ASCII
- MS23 /OS/8 ASCII
- MS43 /XS240 ASCII
- MS24 /UNSIGNED DECIMAL
- MS25 /SIGNED DECIMAL
- MS26 /OCTAL
- MS35 /BCD
- MS36 /BYTE
- MS31 /PDP SYMBOLIC
- MS16 /FPP SYMBOLIC
- MS08 /DIRECTORY
-
-
-/'XMODIF' COMMAND LIST
-MODIFL, TEXT "PAP@ASA@OSXSNUN@"
-
-/'XMODIF' JUMP LIST
-MODIFO, XPAC0 /PACKED
- XPAC0
- XASC1 /ASCII
- XASC1
- XOPS1 /OS/8
- XXS20 /XS240
- XNUM2 /NUMERIC
- XNUM2
-
-MODADS, XMOD0 /MODIFL TEST LIST
- XMOD0
- XMOD0
- XMOD0
- XMOD0
- XMOD0
- XMOD0
- XMOD0
- XMOD0
-
-MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
-
-/'XMODIF' CHARACTER JUMP LIST
-MCHARO, XMODCR /CR, END
- RENEXT /LF, IGNORE
-
-/'XIF' CHARACTER JUMP LIST
-IFSKPO, XIFCR /CR, END OF LINE
- RENEXT /LF, IGNORE
-
-/XNUM JUMP LIST
-NUMOPS, XNUM1 /,
- ERCQ /:
- ERCQ /.
- XNUM1+1 /SPACE
- XNUM3 /CR
- /'XSHOW' COMMAND LIST
-SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
- *.-1
-/'XSET' COMMAND LIST
-SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
-
-/'XSHOW' JUMP LIST
-SHOWOP, XSHBLK /BLOCK
- XSHBLK
- XSHODL /ODT LOC
- XSHCCB /CCB (CORE CONTROL BLOCK)
- XSHCCB
- XSHHDR /HEADER (F4 LOAD MODULE)
- XSHHDR
- XSHABS /ABS. LOC
- XSHABS
- XSHREL /REL. LOC
- XSHREL
- XSHSMS /SMASK
- XSHVER /VERSION
- XSHDDEV /DDEV
- XSHFMT /FORMAT
- XSHFMT
- XSHOUT /OUTPUT
- XSHOUT
- XSHERR /ERRORS
- XSHERR
- XSHOFF /OFFSET
- XSHUPP /UPPER
- XSHLOW /LOWER
- ERCG /TEMP--NOT ALLOWED FOR SHOW
- XSHDEV /DEVICE
- ERCG /DMODE--NOT ALLOWED FOR SHOW
- XSHMOD /MODE
- XSHFIL /FILLER
- XSHMSK /MASK
- XSHMSK
-
-/'XSET' JUMP LIST
-SETJMP, XDDEV /DDEV (DUMP DEVICE)
- XFORM /FORMAT
- XFORM
- XOUTS /OUTPUT
- XOUTS
- XEMODE /ERROR (MODE)
- XEMODE
- XOFFS /OFFSET
- XUPP /UPPER
- XLOW /LOWER
- XTEMP /TEMP
- XDEV /DEVICE
- XDMODE /DMODE (DUMP MODE)
- XMODE /MODE
- XFILL /FILLER
- XMASK /MASK
- XMASK
-
-/'XEMODE' COMMAND LIST
-XELST, TEXT "SHS@LOL@"
-
-/'XEMODE' BRANCH LIST
-XEOPS, XEMOD1 /SHORT
- XEMOD1
- XEMOD1+1 /LONG
- XEMOD1+1
-
-/'XOUTS' LISTS
-XOLST, TEXT "FPF@PDP@OCO@"
-
-XOOPS, XOUTS1-1 /FPP SYMBOLIC
- XOUTS1-1
- XOUTS1 /PDP SYMBOLIC
- XOUTS1
- XOUTS1+1 /OCTAL
- XOUTS1+1
-
-/'XMODE' COMMAND LIST
-MODLST, TEXT "OFO@SAS@LOL@NON@"
-
-/'XMODE' JUMP LIST
-MODOPS, XMODS-1 /OFFSET
- XMODS-1
- XMODS+1 /SAVE FILE
- XMODS+1
- XMODS /LOAD MODULE
- XMODS
- XMODS+2 /NORMAL
- XMODS+2
-
-/'XDMODE' LISTS
-XDMLST, TEXT "ALPANO"
-
-XDMOPS, XDMODS-1 /ALL
- XDMODS /PART
- XDMODS+1 /NONE
-
-
-/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"
-
- MS27 /-1 = "OFFSET"
-MODELS, MS29 / 0 = "NORMAL"
- MS28 /+1 = "SAVE"
- MS34 /+2 = "LOAD"
-
-
-/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"
-
- MS16 /-1 = "FPP (SYMBOLIC)"
-OUTLS, MS26 / 0 = "OCTAL"
- MS31 /+1 = "PDP (SYMBOLIC)"
-
-
-/'XWORD' COMMAND LIST
-XWORCL, TEXT "UNU@"
- *.-1
-/'XSTRIN' COMMAND LIST
-STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
-
-
-/'XWORD' JUMP LIST
-XWOROP, XWOR2 /UNEQUAL
- XWOR2
- XWSFRM /FROM
- XWSFRM
- XWSTO /TO
- XWSTO
- XWSABS /ABSOLUTE
- XWSABS
- ERCH /MASKED--NO!
- XWOR7 /MEMREF
- XWOR7
-
-/'XSTRIN' JUMP LIST
-STROPS, XWSFRM /FROM
- XWSFRM
- XWSTO /TO
- XWSTO
- XWSABS /ABSOLUTE
- XWSABS
- XSTR0 /MASKED
- XSTR0
- ERCH /MEMREF--NO!
- /LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
-TERMS, "! /1
- "& /2
- "+ /3
- "- /4
- "/ /5
- "* /6
- "( /7
- ") /10
- 215 /CR: 11
- 0
-
-/'GWORD' & 'ACCEPT' COMMAND LISTS
-GWLST1, "9
- "8
- "7
- "6
- "5
- "4
- "3
- "2
- "1
- "0
- 204 /^D
- 213 /^K
- ""
- "'
- "(
-GWLST2, 240 /SPACE
- 215 /CR
- 0
-
-/'GWORD' JUMP LISTS
-GWOPS1, GWD4 / 9 - A NUMBER
- GWD4 / 8 - A NUMBER
- GWD4 / 7 - A NUMBER
- GWD4 / 6 - A NUMBER
- GWD4 / 5 - A NUMBER
- GWD4 / 4 - A NUMBER
- GWD4 / 3 - A NUMBER
- GWD4 / 2 - A NUMBER
- GWD4 / 1 - A NUMBER
- GWD4 / 0 - A NUMBER
- GWD4 /^D - A NUMBER
- GWD4 /^K - A NUMBER
- GWD4 / " - A NUMBER
- GWD4 / ' - A NUMBER
- GWD4 / ( - A NUMBER
-GWOPS2, GWD2 /SPACE - TERMINATOR
- GWD3 / CR - "
-
-/'ACCEPT' JUMP LIST
-ACOPS, ACCNUM / 9 - A DIGIT
- ACCNUM / 8 - A DIGIT
- ACCNUM / 7 - A DIGIT
- ACCNUM / 6 - A DIGIT
- ACCNUM / 5 - A DIGIT
- ACCNUM / 4 - A DIGIT
- ACCNUM / 3 - A DIGIT
- ACCNUM / 2 - A DIGIT
- ACCNUM / 1 - A DIGIT
- ACCNUM / 0 - A DIGIT
- CTRLD / ^D SWITCH
- CTRLK / ^K SWITCH
- DQUOTE / " - SINGLE ASCII
- SQUOTE / ' - PACKED ASCII
- ERCR / ( - ILLEGAL HERE
- ACCPT3-2 /SPACE - END
- ACCPT3-1 /CR - END
-
-/'GARGS' JUMP LIST - TERMINATORS
-GAROPS, GAR5 /-
- GAR6 /,
- ERCS /:, SHOULDN'T SEE, WILL DO ERROR
- GAR4 /.
- ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
- GAR3 /CR
-
-/'GARGS' & 'ARG' COMMAND LISTS
-GARLST, "-
- ",
-GETLST, ":
-ARGLST, ".
- 240 /SPACE
- 215 /CR
- 0
-
-/'GETNT' LISTS
-GETOPS, GETCOL
- GETPER
- GETEND
- GETEND+1
-
-/'ARG' JUMP LIST
-ARGOPS, ARG2
- ARG3
- ARG3
-
-/'WCHEK' LISTS
-WCKLST, "(
- ")
- ""
- "'
- 215
- 0
-
-WCKOPS, WCHEK5+1
- WCHEK5
- WCHEK6+1
- WCHEK6
- WCHEK4
-
-/'EVAL' JUMP LIST 1
-EVOPS1, EVNEXT /+
- EVMIN /-
- EVLPAR /(
-
-/'EVAL' COMMAND LISTS
-EVLST1, "+
- "-
- "(
- 0
-
-EVLST2, "L
- "B
- "S
- "C
- "F
- "R
- "T
- "D
- 0
-
-/'EVAL' JUMP LIST 2
-EVOPS2, EVLOC /L (LOC)
- EVBLK /B (BLK)
- EVSR /S (S.R.)
- EVSR+1 /C (CONTENTS)
- EVFIL /F (FILLER)
- EVREM /R (REMAINDER)
- EVTEMP /T (TEMP)
- EVDATE /D (DATE)
-
-/ACTION CHARS FOR "READLN" SUBROUTINE
-REACTL, "R-100 /CTRL-R = RE-ECHO
- "U-100 /CTRL-U = ERASE LINE
- 0
-
-REACTS, RECHO
- RERASE
- /ERROR ROUTINE ADDRESS LIST:
-
-ERLIST, ERCA
- ERCB
- ERCC
- ERC14
- ERCD
- ERCE
- ERCG
- ERCH
- ERCI
- ERCK
- ERCJ
- XSET1
- ERCL
- ERCZ
- ERCO
- ERC11
- ERC04
- ERCP
- ERCQ
- ERCR
- ERC09
- ERC08
- ERC13
- ERCS
- ERCT
- ERCU
- ERCV
- ERCW
- ERCX
- ERCY
- ERCM
- ERC00
- ERC01
- ERC02
- ERC03
- ERC10
- ERCF
- GCCERR
- HDRERR
- ERC05
- ERC07
- ERC18
- ERC19
- ERC20
- ERC15
- ERC16
- ERC17
- 0
-
-
- DECIMAL
-
-SMASKB, -1 /STRING SEARCH MASK BUFFER
- /L(SMASKB)=66(10)
-COMB= SMASKB+66 /COMMAND INPUT BUFFER
- /L(COMB)= 140(10)
-PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER
- /**** ALSO REWIND BUFFER! ****
- CCBB-PDLB /SHOW PDL SPACE
-
- OCTAL
-
-
-CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER
- / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1
-
-DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1
-
-IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1
-
-
-$$$$
-
DELETED src/os8-v3f/KL8E.PA
Index: src/os8-v3f/KL8E.PA
==================================================================
--- src/os8-v3f/KL8E.PA
+++ /dev/null
@@ -1,805 +0,0 @@
-/19 SUPER TTY HANDLER FOR OS/8
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,1975,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-
-/S.W.,S.R.,H.J.,R.L.,S.R.
-
- *0
-
- -1
- IFNDEF SLU <SLU=0>
- IFZERO SLU <DEVICE KL8E;DEVICE TTY;0;TTY&177+4000;ZBLOCK 2>
- IFZERO SLU-2 <DEVICE SLU2;DEVICE SLU2;0;TTY&177+4000;ZBLOCK 2>
- IFZERO SLU-3 <DEVICE SLU3;DEVICE SLU3;0;TTY&177+4000;ZBLOCK 2>
-
-/TWO-PAGE TELETYPE HANDLER FOR OS/8 V3.
-/ON INPUT, RECOGNIZES ^Z, ^C, ^U, RUBOUT
-/^Z MEANS END OF INPUT, INSERT ^Z IN BUFFER,
-/ PAD WITH ZEROES, AND ECHO "^Z"
-/^C MEANS ABORT JOB, RETURN TO OS/8 VIA LOC 7600 TO SAVE CORE AND PRINT "^C"
-/^U MEANS DELETE THE LAST LINE, ALLOW OPERATOR TO RETYPE
-/ (LINE STARTS AT BEGIN OF BUFFER AND IS TERMINATED BY A CR)
-/ A CR GETS ENTERED INTO BUFFER, CAUSES A LF TO ALSO ECHO
-/ AND GET ENTERED INTO BUFFER, BUFFER IS THEN PADDED WITH NULLS.
-/ CONVERTS LC TO UC
-
-/ON OUTPUT RECOGNIZES ^C, ^O, ^S, ^Q FROM KEYBOARD
-/^C CAUSES JOB TO ABORT, RETURN TO OS/8 VIA LOCATION 7600
-/ TO SAVE CORE AND PRINT "^C"
-/^O CAUSES ECHOING BY THE HANDLER TO CEASE
-/ TYPING ANY OTHER CHARACTER RESUMES ECHOING.
-/^S CAUSES THE HANDLER TO STOP SENDING TO TERMINAL
-/^Q RESUMES HANDLER SENDING
-/ ^S AND ^Q ARE IGNORED IN OTHER CASES
-
-/WHENEVER PRINTING CHARACTERS (EITHER ON OUTPUT OR WHEN ECHOING),
-/ IGNORES NULLS
-/ FLAGS LC WITH AN APOSTROPHE
-/ HANDLES TABS CORRECTLY (SEVERAL WAYS)
-/ PRINTS ESCAPE AS $
-/ DELAYS 16 MS AFTER LINEFEEDS
-/ PRINTS CONTROL CHARACTERS AS "^K"
-
-/DOES AUTOMATIC CR/LF AT END OF LINE WIDTH.
-
-/MAINTENANCE RELEASE CHANGES:
-
-/1. ADDED KCC FOR NON-CONSOLE TELETYPES
-
-/V3D CHANGES: (VERSION E)
-
-/1. ADDED DELAY OPTION FOR VT78
-/2. ADDED SCOPE RUBOUTS
-/3. CHANGED VT78 DEFAULTS
-/4. REARRANGED CODE FOR SET TTY ESC AND ARROW
-
-/CHANGES FOR OS/78 V2
-
-/1. CHANGED KSF TO KKSF, ETC.
-/ (DID NOT BUMP VERSION LETTER)
-/2. MADE CONDITIONALS FOR SLU2
- IFNDEF INDVC <INDVC=03>
- IFNDEF OUTDVC <OUTDVC=INDVC+1>
-
- KKSF=10^INDVC+6001
- KKCC=10^INDVC+6002
- KKRS=10^INDVC+6004
- KKRB=KKCC KKRS
- TTSF=10^OUTDVC+6001
- TTCF=10^OUTDVC+6002
- TTPC=10^OUTDVC+6004
- TTLS=TTCF TTPC
-
- TTYVERSION="E&77
- /BUILD YOUR OWN TELETYPE HANDLER:
-
-/THIS SOURCE HAS MUMBLE LOCATIONS LEFT.
-
-/THE FOLLOWING CONDITIONALS ALLOW YOU TO INCLUDE OPTIONAL FEATURES.
-/YOU MAY INCLUDE AS MANY OR AS FEW AS YOU DESIRE PROVIDED THERE
-/IS ROOM LEFT.
-
-/CONDITIONAL LOCATIONS LOCATIONS INCLUDED
-/VARIABLE PAGE 1 PAGE 2 FEATURES
-
-/ DELAY 0 7 DELAY AFTER GIVEN CHAR
-/ CTRL 0 3 PRINT CONTROL CHARS AS ^K
-/ RUB 0 0 PRINT CHAR RUBBED OUT ON RUBOUTS
-/ SIMTAB 0 10 SIMULATE TABS AS SPACES
-/ SLOTAB 0 6 PUT OUT 2 RUBOUTS AFTER A TAB
-/ ESC 0 10 PRINT ESCAPE AS $
-/ FLAGLC 0 12 FLAG LOWER CASE CHARS ON OUTPUT
-/ CNVLC 0 7 CONVERT LOWER CASE ON INPUT TO UPPER CASE
-/ ALTMOD 0 11 CONVERT ALTMODES (175,176) TO ESCAPE (33)
-/ PAUS 0 20 PAUSE BETWEEN PAGES
-/ FREE LOCS: 2 33
-
- VT78=1 /SET TO 0 TO ALLOW OTHER PARAMETERS
- /SET TO 1 TO FORCE OTHER PARAMETERS TO VT78 COMPATIBLE
-
- DELAY=0 /SET NON-ZERO TO ALLOW DELAY AFTER ANY CHAR (12=CR)
- /TYPICALLY AFTER LF FOR HIGH SPEED VT05
- /SET VALUE OF DELAY = 7-BIT CHAR TO DELAY AFTER
-
- CTRL=1 /SET TO 1 TO ECHO CONTROL CHARS AS ^K
- /SET TO 0 TO ACCEPT CONTROL CHARACTERS AND PUT
- /IN BUFFER, BUT NOT ECHO THEM (EXCEPT THE USUAL)
- RUB=1 /SET TO 0 TO ECHO EACH RUBOUT BY TYPING A BACK SLASH
- /SET TO 1 TO ECHO CHARS RUBBED OUT UPON RUB-OUT
- /SET TO 4000 TO PERFORM SCOPE TYPE RUBOUTS
- SIMTAB=1 /SET TO 1 TO SIMULATE TABS AS THE CORRECT NUMBER OF SPACES
- /SET TO 0 TO TYPE TABS AS TABS
- SLOTAB=0 /SET TO 1 TO TYPE 2 RUBOUTS AFTER A TAB
- /ONLY IS APPLICABLE IF SIMTAB=0
- ALTMOD=0 /SET TO 1 TO CONVERT 175,176 TO 33
- /(UPPER CASE TERMINALS ONLY)
- ESC=1 /SET TO 1 TO ECHO ESCAPE AS $
- /SET TO 0 TO ECHO ESCAPE AS A CONTROL CHAR (^[)
- FLAGLC=1 /SET TO 1 TO FLAG LOWER CASE CHARS ON OUTPUT
- /THIS IS FOR PEOPLE NOT PRIVELIDGED ENOUGH TO
- /OWN A LOWER CASE TERMINAL
- /SET TO 0 TO PRINT LOWER CASE CHARS AS IS
- CNVLC=0 /SET TO 1 TO CONVERT LOWER CASE CHARS ON INPUT TO UPPER CASE
- /SET TO 0 TO ACCEPT INPUTTED LOWER CASE CHARS AS IS
- /THIS IS FOR PEOPLE WHO ARE HANDICAPPED BY A LOWER CASE
- /TERMINAL AND ONLY WANT UPPER CASE
- PAUS=200 /NON-0 PAUSES BETWEEN SCOPE PAGES
- HEIGHT=30 /NUMBER OF LINES PER SCREEN
-
-/SOME OF THE ABOVE OPTIONS SHOULD ACTUALLY BE IMPLEMENTED
-/IN SUCH A MANNER THAT THE USER CAN CHANGE THEM VIA AN ALTER
-/RATHER THAN HAVE TO REASSEMBLE.
-
- IFNZRO VT78 <
- DELAY=0
- CTRL=1
- RUB=4000
- SIMTAB=0
- SLOTAB=0
- ALTMOD=0
- ESC=1
- FLAGLC=0
- CNVLC=0
- IFNZRO INDVC-3 <CTRL=0>
- >
- /CROSS PAGE LINKAGE:
-
-/THIS CODE MUST BE ABLE TO LOAD INTO ANY TWO PAGES OF CORE
-/THE ENTRY POINT IS AT THE NEXT LOCATION TO THE END OF THE FIRST PAGE
-/AT THE END OF THE FIRST PAGE WE JMS TO PLINK,
-/THIS LEAVES THE ADDRESS OF THE FIRST LOCATION OF THE NEXT PAGE
-/IN LOCATION 'PLINK' . THIS JUST HAPPENS TO BE THE ADDRESS
-/OF BOTH TTYPCH AND TTYGCH.
-
-/TTYPCH AND TTYGCH SHARE THE SAME ENTRY POINT.
-/IF IT IS CALLED WITH A 0 AC, IT IS A CALL TO TTYGCH,
-/IF IT IS CALLED WITH A NON-ZERO AC, IT IS A CALL TO TTYPCH.
-
-/RETURN 1 MEANS GOT RUBOUT
-/TTYGCH TAKES RETURN 2 IF IT GOT A ^Z.
-/OTHERWISE IT TAKES RETURN 3 WITH CHARACTER GOTTEN IN AC.
-
-/TTYPCH TAKES RETURN 1 IF IT WANTS THE HANDLER TO GO AWAY,
-/I.E IF IT SAW A ^Z.
-/AC IS NORMALLY NON-ZERO UPON RETURN
-/AC IS POSITIVE MEANS DO A CRLF
-
-/WHEN ECHOING WE WANT TO CALL TTYPRT
-/BUT OTHERWISE WE WANT TO CALL TTYPCH (WHICH DOES ADDITIONAL
-/STUFF LIKE CHECK ^O, ^Q, ETC.
-/WE TELL BY WHETHER OR NOT TTYGCH HAD BEEN PREVIOUSLY CALLED.
- *200
-
-PLINK, 0 /GETS ADDRESS OF TTYPCH AND TTYGCH (START OF NEXT PAGE)
- STL CLA RAR /4000
- TAD I TTY /RETRIEVE FUNCTION WORD, BUT PUT R/W BIT IN LINK
- AND L3700 /EXTRACT NUMBER OF DOUBLE-WORDS TO TRANSFER
- CMA /GET COUNT+1
- DCA BUFSIZ /STORE AWAY
- RDF /FIND OUT THE USER'S DATA FIELD
- TAD CIFCDF /FORM OUR EXIT CIF CDF
- DCA TTYXIT /STORE AWAY FOR EXIT ROUTINE
- TAD TTY70 /GET FUNCTION WORD
-L776, AND I TTY /ISOLATE FIELD OF BUFFER
- TAD TTYCDF /FORM CDF TO FIELD OF BUFFER
- DCA TTCDBF /STORE WHERE IT WILL BE USEFUL
- /AT SAME TIME, INITIALIZE TTYEOF
- ISZ TTY /POINT TO BUFFER ADDRESS
- TAD I TTY /AND GET IT
- DCA BUFSTRT /AND SAVE IT
- ISZ TTY /POINT TO BLOCK #
-TTY376, ISZ TTY /POINT TO ERROR RETURN
-SHIFT, /OUTPUT SHIFT REGISTER
-TTYEOF, /0 IF SAW CR OR ^Z AND WISH TO PAD BUFFER WITH 0'S
-TTCDBF, HLT /CDF BUFFER FIELD
- JMP TTYKLG
-TTYLP, SNL CLA /LINK=1 MEANS OUTPUT
- JMP TTYGET /INPUT IS FROM TTY:
- /LINK MUST BE SET FIRST TIME THROUGH HERE.
-/IT ACTS AS A GUARD BIT IN THE SHIFT REGISTER
-ROTL, RTL
- RTL
- SPA /DO WE HAVE 8 BITS SHIFTED IN?
- JMP TELP
- DCA SHIFT /SAVE SHIFT REGISTER
- TAD I BUFSTRT
- SZA
- JMS PUNCH /PRINT A CHARACTER
- TAD I BUFSTRT
- ISZ BUFSTRT /BUMP INPUT POINTER
-TT7400, 7400 /PROTECT ISZ
- AND TT7400
- CLL RAL
- TAD SHIFT /SHIFT HIGH ORDER 4 BITS INTO
- JMP ROTL /SHIFT REGISTER
-TELP, JMS PUNCH /PRINT 3RD CHARACTER OF DOUBLE-WORD
- STL /***KLUDGE
-TTYKLG, ISZ BUFSIZ /DONE?
- JMP TTYLP /NOT YET
-TTYX, TAD TTYEOF /IF INPUT AND WE WERE PADDING WITH 0'S
- SZA CLA /TAKE SOFT ERROR EXIT
-TTYRTN, ISZ TTY /POINT TO NORMAL RETURN
- /CAN'T GET ERROR OR END-OF-FILE ON OUTPUT
-TTYXIT, HLT /RETURN TO USER'S FIELD
- JMP I TTY /RETURN TO USER
-TTYCA, 0
-TTYWC, 0
-BUFSIZ, 0
-BUFSTRT,0
-TTY70, 70
-
-PUNCH, 0 /NEVER CALL TTYPCH WITH ZERO AC
- JMS I PLINK /CALL TTYPCH
- JMP TTYRTN /GO AWAY, WE SAW A ^Z
-L7700, SMA CLA /DID WE REACH END OF TTY LINE?
- JMS CRLF /YES, PERFORM CR/LF
- JMP I PUNCH /RETURN
-
-TMP,
-CRLF, 0
- TAD L215
- JMS I PLINK /CALL TTYPCH TO PRINT CR
-L215, 215 /CAN'T RETURN HERE
- CLA /****
- TAD L212
- JMS I PLINK /CALL TTYPCH TO PRINT LF
-L212, 212 /CAN'T RETURN HERE
- CLA /****
- JMP I CRLF /RETURN
- CTRLU, JMS CRLF /PERFORM A CR/LF
-TTYGET, TAD BUFSTRT
- DCA TTYCA /POINT TO START OF BUFFER
- TAD BUFSIZ
- CLL RAL /CONVERT DOUBLE-WORDS TO WORDS
-DCAWC, DCA TTYWC /SET SIZE OF BUFFER
-TSTEND, TAD TTYEOF
- SNA CLA
- JMP ZERO
- JMS I PLINK /CALL TTYGCH TO GET A CHARACTER
- JMP RUBOUT /RETURN 1 MEANS SAW RUBOUT
-ZERO, DCA I TTYCA /RETURN 2 MEANS GOT CHARACTER
- /STORE AWAY TEMPORARILY
- /USING USER'S BUFFER AS A TEMP LOCATION
- TAD I TTYCA /GET BACK CHARACTER
- IFNZRO .-320 <_ERROR>
- SZA
- JMS PUNCH /ECHO IT
- TAD I TTYCA /GET IT AGAIN
- TAD M32 /-^Z
- SNA
- JMP CTRLZ
- TAD L5 /^Z-^U
- SNA /IS IT ^U?
- JMP CTRLU /YES
- TAD L7
-GRUDGE, DCA TMP
- ISZ TTYCA /NO
-L7, 7
- ISZ TTYWC /IS BUFFER FULL?
-TT10, SKP
- JMP TTYX
- ISZ TMP /WAS LAST CHAR A CR?
- JMP TSTEND /NO
- DCA TTYEOF /YES, SET "PAD WITH 0'S" FLAG
- ISZ TTY /POINT TO NORMAL RETURN
- /CR IS NOT AN ERROR OR END-OF-FILE
- TAD L212 /IF LAST CHAR INPUT WAS CR, NOW PRETEND LF WAS INPUT
- JMP ZERO /REJOIN PROCESSING
-
-CTRLZ, DCA TTYEOF
- JMS CRLF
- JMP GRUDGE
-
-M32, -32
-L5, 5
-L3700, 3700
-CIFCDF, CIF CDF 0
-TTYCDF, CDF 0
-
-/TTYEOF IS ZERO MEANS PAD BUFFER WITH ZEROES
- /DON'T DO YET:
-/RUBOUT, AND TTYWC /177 IN AC
-/ SNA CLA
-/ JMP CTRLU
-
-RUBOUT, KKCC /TTYGCH DOESN'T CLEAR RO FROM BUFFER
- TAD TTYCA
- CIA
- TAD BUFSTRT
- SNA CLA /ARE WE AT BEGIN OF BUFFER?
- JMP CTRLU /YES
- STA
- TAD TTYCA
- DCA TTYCA
- IFZERO RUB <
-LSLASH, "\
- TAD LSLASH /PRINT A BACK SLASH FOR EACH RUBBED OUT CHAR
- >
- IFNZRO RUB&4000+RUB <TAD I TTYCA> /PRINT CHAR JUST DELETED
- IFNZRO RUB&4000 <TAD TT10> /BACKSPACE-SPACE-BACKSPACE
- JMS PUNCH
- STA
- TAD TTYWC
- JMP DCAWC /BUMP BACK WC AND GET ANOTHER CHAR
-
- ZBLOCK 376-.
-TTY, TTYVERSION /ENTRY POINT TO HANDLER
- JMS PLINK /SET UP CROSS PAGE LINKAGE
- IFNZRO TTY-376 <ENTERR,QQQQ>
- PAGE
- /INTERLUDE:
-
-/USA STANDARD CODE FOR INFORMATION INTERCHANGE:
-
-/ 000 001 010 011 100 101 110 111
-/
-/ 0000 NUL DLE SP 0 @ P ' 'P
-/
-/ 0001 SOH DC1 ! 1 A Q 'A 'Q
-/
-/ 0010 STX DC2 " 2 B R 'B 'R
-/
-/ 0011 ETX DC3 # 3 C S 'C 'S
-/
-/ 0100 EOT DC4 $ 4 D T 'D 'T
-/
-/ 0101 ENQ NAK % 5 E U 'E 'U
-/
-/ 0110 ACK SYN & 6 F V 'F 'V
-/
-/ 0111 BEL ETB ' 7 G W 'G 'W
-/
-/ 1000 BS CAN ( 8 H X 'H 'X
-/
-/ 1001 HT EM ) 9 I Y 'I 'Y
-/
-/ 1010 LF SUB * : J Z 'J 'Z
-/
-/ 1011 VT ESC + ; K [ 'K '[
-/
-/ 1100 FF FS , < L \ 'L '\
-/
-/ 1101 CR GS - = M ] 'M ']
-/
-/ 1110 SO RS . > N ^ 'N '^
-/
-/ 1111 SI US / ? O _ 'O '_
-/
- /TTYGCH: GETS A CHAR FROM KBD
-/ IF GOT ^Z, IT SETS TTYEOF FLAG
-/ LEAVES IT IN AC IN 7-BIT
-
-/TTYPRT: PRINTS CHAR IN AC ON TTY
-/ IGNORES NULLS
-/ PRINTS ^X ON CONTROL CHARS (EXCEPT CR, LF, FF, VT, TAB)
-/ PRINTS 'X ON LOWER CASE
-
-/HANDLES TABS CORRECTLY
-/ AND AUTOMATICALLY PRINTS CR/LF AT EOL
-/ PRINTS ESCAPE AS $
-
-/TTYTLS: USED TO ACTUALLY PRINT CHAR
-/ IT HANDLES TABS AUTOMATICALLY
-/ AND CR/LF'S AT END OF LINE
-
-/TTYPCH: IT USES TTYPRT TO PRINT CHAR BUT ALSO RESPONDS TO
-/ ^C, ^O, ^S, ^Q.
-/ IF ^Z IS BEING PRINTED, IT THEN STOPS FURTHER PRINTING
- /MUST BE AT TOP OF PAGE
-TTYPCH, /ENTRY POINT TO TTY PUNCH ROUTINE
- /OR TTY PRINT ROUTINE
-TTYGCH, 0 /ENTRY POINT TO TTY GET CHAR ROUTINE
- SNA
- JMS TGCH /ZERO AC-MEANT CALL TO TTYGCH
-PCH, AND (177 /FORCE TO 7-BIT
- DCA TCHAR
- TAD TGCH
-M140, SZA CLA /ARE WE ECHOING?
- JMP ECHO /YES, IGNORE ^S AND STUFF
-K5, 5 /MUST BE AT REL 10
- TAD TCHAR
- TAD (-32
- IFZERO PAUS <
- SNA CLA
- JMP I TTYPCH
- >
- IFNZRO PAUS <
- SNA
- JMP I TTYPCH
- TAD L15 /32-15
- SNA CLA /LOOK FOR CR
- ISZ LINCNT /AT END OF PAGE?
- JMP NOPAUS /NOT AT CR, OR AT CR BUT NOT AT END OF PAGE
-L15, 15 /MUST BE HERE FOR SET
- TAD PAUSN
- DCA TTYTLS /SET COUNT FOR OUTER LOOP
- ISZ LINCNT
- JMP .-1
- ISZ TTYTLS
- JMP .-3
- TAD LINSYZ
- DCA LINCNT
- >
-NOPAUS, JMS TTYTST
- TAD (203-217 /NO
- SNA /^O?
- DCA TCHAR /YES, SET TO NULL SO IT WILL BE IGNORED
- TAD (217-223 /NO
- SZA CLA /^S?
- JMP ECHO /NO, IGNORE CHAR
-TTCTLQ, JMS TTYTST
- TAD (203-221 /NO, NOTHING ELSE MATTERS UNTIL ^Q
- SZA CLA /^Q?
- JMP TTCTLQ /NO, SUSPEND OUTPUTTING
-TTY32, KKCC /YES, REMOVE ^Q FROM BUFFER
-/HAD NO ROOM FOR:
-/ TAD LINSYZ
-/ DCA LINCNT
-ECHO, DCA TGCH
- ISZ TTYPCH
- IFNZRO ESC <
- TAD TCHAR
- TAD (-33
- SZA CLA
- JMP .+3
- TAD L44
- DCA TCHAR
-L44, 44
- >
- TAD TCHAR
- SNA
- JMP TTYCTO /IGNORE NULLS
- IFNZRO RUB&4000 <
- TAD (-10
- SNA
- JMP RUBO
- TAD (10-16
- >
- IFZERO RUB&4000 <
- TAD (-16
- >
-TTY100, CLL
-TTY10, TAD K5
-TTY240, SZA /TAB?
- JMP NOTAB
- IFNZRO SIMTAB <
-TTYTAB, TAD TTY240
- JMS TTYTLS
-TTY7, 7 /HERE FOR NO SPECIAL REASON
- TAD TABCTR
- AND TTY7
- SZA CLA
- JMP TTYTAB
- JMP TTYCTO
- >
- IFNZRO SLOTAB <
- TAD TCHAR
- JMS TTYTLS
- TAD (177
- JMS TTYTLS
- TAD (177
- JMP PRIN+1
- >
- IFZERO SIMTAB+SLOTAB <JMP PRIN>
-
-/BUG: IF HARDWARE TABS, DON'T COUNT COLUMNS CORRECTLY
-
- IFNZRO RUB&4000 <
-RUBO, TAD TTY10 /OUTPUT BACKSPACE-RUBOUT-BACKSPACE
- JMS TTYTLS
- TAD TTY240
- JMS TTYTLS
- TAD (-4
- TAD TABCTR
- JMP PREPRN
- >
- NOTAB, SZL CLA
- JMP SPCHR /DON'T UPARROW CHARS LF,CR,TAB,VT,FF
- IFNZRO FLAGLC <
- TAD TCHAR
- AND TTY140
- TAD M140
- SZA CLA /IS IT LC?
- JMP NOLC /NO
-TTYQUO, "'
- TAD TTYQUO /YES
- JMS TTYTLS /PRINT QUOTE
- TAD M40
- JMP PRIN /PRINT UPPER CASE OF CHAR
- >
-NOLC, TAD TCHAR /NO, GET BACK CHAR
- AND TTY140 /HIGH ORDER BITS IRRELEVANT
- IFNZRO CTRL <
-M40, SMA SZA CLA /CAN'T BE NEGATIVE
- JMP PRIN /NOT A CONTROL CHARACTER
- TAD TTYUPA /ECHO 201-237 AS ^X (EXCEPT 211-215)
- JMS TTYTLS
- TAD TTY100 /ADD X100 TO ^K TO GET K
- >
- IFZERO CTRL <
- SNA CLA /IS CHAR A CONTROL CHAR?
- JMP TTYCTO /YES, DON'T ECHO CONTROL CHARACTERS EXCEPT FOR 211-215
- >
-PRIN, TAD TCHAR
- JMS TTYTLS
-TTYCTO, TAD TABCTR /RETURN TABCNT IN AC
- JMP I TTYPCH
-
- IFZERO CTRL <
-M40, -40
- >
-
-TTY140,
-SPCHR, STA CLL
- TAD LINSIZ
-PREPRN, DCA TABCTR /THESE CHARS RESET COLUMN COUNTER
- JMP PRIN
- TGCH, 0 /NON-ZERO MEANS TTYGCH WAS CALLED
- KKSF
- JMP .-1 /WAIT FOR CHAR TO BE TYPED
- JMS TTYTST
-/WILD: (DON'T PUT IN) SZA CLA /FALL THRU AND RETURN R.O.
-/ ISZ TTYGCH
- TAD (203-377
- SNA CLA /TAKE RETURN 1 ON RUB OUT
- JMP I TTYGCH /"CLUMSY" - R.L. (9/18/73)
- ISZ TTYGCH
- KKRB /GET CHARACTER
-TTYAND, AND (177 /MUST RETURN CHAR IN 7-BIT
- IFNZRO CNVLC <
- DCA TCHAR
- TAD TCHAR
- AND TTY140
- TAD M140
- SNA CLA /IS IT LC?
- TAD M40 /YES
- TAD TCHAR /NO
- >
- IFNZRO ALTMOD <
- TAD (-175 /IS IT 175 OR 176?
- SMA
- JMP CONV /YES, CONVERT ALTMODE TO ESCAPE
- TAD (175 /NO, RESTORE CHAR
- >
- JMP I TTYGCH /TAKE RETURN 3
-
-/SHOULDN'T TABCTR BE INITIALIZED TO C(LINSIZ) UPON ENTRY?
-
-TABCTR, -110
-
-TTYTLS, 0
- TTLS
- IFNZRO DELAY <
- TAD (-DELAY
- SZA CLA
- STA
- >
-TTYTSF, TTSF
- JMP .-1
- IFNZRO DELAY <
- IAC
- SZA /19.66 MS IS G.T. 1/60 SEC
- JMP TTYTSF
- >
- ISZ TABCTR
-TTYUPA, "^
-TT7600, 7600
- JMP I TTYTLS
-LINSIZ, -110
-
- IFNZRO PAUS <
-LINSYZ, -HEIGHT
-LINCNT, -HEIGHT
-PAUSN, -PAUS
- >
-
- IFNZRO ALTMOD <
- IFNZRO KKCC-6032 <
-CONV, CLA
- TAD (33
- JMP I TTYGCH
- >
- IFZERO KKCC-6032 <
-CONV, CLA IAC
- TAD TTY32 /DEVICE DEPENDENT
- JMP TTYAND
- >
- >
- TCHAR, 0
-
-/TTYTST: READS KEYBOARD STATICALLY AND RESPONDS TO ^C
-/ OTHERWISE RETURNS CHAR (8-BIT) MINUS 203 IN AC.
-/ IF FLAG IS NOT UP, IT RETURNS A 1.
-
-TTYTST, 0
- TAD TT7600 /OR CHAR IN
- KKRS
- TAD (-7603 /-7603=175
- KKSF
- CLA IAC /STUFF IN BUFFER IS UNRELIABLE IF FLAG ISN'T UP
- SZA
- JMP I TTYTST
- IFNZRO INDVC-3 <KKCC>
- CIF CDF 0 /BRANCH TO OS/8 MONITOR AT 07600
- JMP I TT7600 /IT WILL PRINT "^C" FOR CHAR IN BUFFER
- PAGE
- / DYNAMICALLY MODIFYING THE KL8E HANDLER
-
-/ *** I M P O R T A N T ***
-
-/ THIS HANDLER CAN BE DYNAMICALLY CHANGED VIA SET COMMANDS.
-/ CONSEQUENTLY, IT IS EXTREMELY IMPORTANT THAT PEOPLE
-/ WHO MODIFY THIS SOURCE DO NOT AFFECT THE ALGORITHMS
-/ NECESSARY TO PERFORM SUCH MODIFICATIONS.
-
-/ THIS ALGORITHM IS EXPLAINED BELOW.
-
-/ SET TTY WIDTH=N
-
-/ SEARCH LOCATIONS 200-377 FOR A 7600. CALL ITS ADDRESS X.
-/ LET Y BE THE INSTRUCTION AT LOCATION X+1.
-/ FORM THE (RELATIVE) ADDRESS T=Y&177+200-1.
-/ THEN LOCATIONS T AND X+2 CONTAIN MINUS THE TTY WIDTH.
-/ THE WIDTH MUST BE A MULTIPLE OF 10 AND MUST NOT BE 200.
-/ (BECAUSE -200 IS THE MAGIC 7600)
-
-/ SET TTY CODE XX
-
-/ SEARCH ENTIRE HANDLER FOR INSTRUCTIONS OF THE FORM 6XXY
-/ WHERE XX IS NOT 20 OR 21,
-/ AND FURTHERMORE DON'T INCLUDE A 6031 IF 2 LOCATIONS
-/ FOLLOWING IS A 7650
-/ AND DON'T INCLUDE A 6034 IF 4 LOCATIONS FOLLOWING IS A 7650.
-
-
-/ SET TTY [NO] ECHO
-
-/ THE WORD INVOLVED IS AT (RELATIVE) LOCATION 120.
-/ SET TO 7440 TO ECHO.
-/ SET TO 7610 TO SUPPRESS ECHOING.
-
-
-/ SET TTY LC
-
-/ SEARCH LOCATIONS 200-377 FOR A 377. CALL ITS ADDRESS X.
-/ LOOK AT LOCATION X+5.
-/ IF THIS LOCATION IS NOT A 7650, THEN LC TO UC CONVERSION
-/ WAS NOT ENABLED AT ASSEMBLY TIME.
-/ IF THE FEATURE IS ENABLED, CHANGE LOCATION X+5 TO A 7610
-/ TO PREVENT THE CONVERSION. TO ALLOW CONVERSION, SET
-/ LOCATION X+5 BACK TO 7650.
-
-/ SET TTY PAGE
-
-/ SEARCH LOCATIONS 215-300 FOR A 7450. CALL ITS ADDRESS X.
-/ SET X+3 TO 7640 TO ENABLE ^S, ^Q.
-/ SET X+3 TO 7200 TO DISABLE ^S, ^Q.
- / SET TTY TAB
-
-/ SEARCH LOCATIONS 200-300 FOR A 7.
-/ IF NOT FOUND, SIMULATED TABS WAS NOT ENABLED AT ASSEMBLY TIME.
-/ IF FOUND, CALL ITS ADDRESS X.
-/ TO PATCH OUT SIMULATED TABS:
-/ MOVE C(X-12) TO LOCATION X-2
-/ CHANGE LOCATION X+3 TO A 7610
-/ TO RESTORE SIMULATED TABS:
-/ SET LOCATION X-2 TO X-4&77+1200
-/ CHANGE LOCATION X+3 TO A 7640
-
-/ SET TTY FILL
-
-/ THE LITERAL 177 MUST REMAIN AT THE END OF PAGE 2
-/ SEARCH LOCATIONS 200-300 FOR A 1377.
-/ IF NOT FOUND, THEN FILL CHARACTERS WERE NOT ENABLED AT ASSEMBLY
-/ TIME. IF FOUND, CALL ITS ADDRESS X.
-/ TO PATCH OUT FILL CHARACTERS, MOVE C(X+3) TO LOCATION X-1.
-/ TO RESTORE FILL CHARACTERS, MOVE C(X+1) TO LOCATION X-1.
-
-/ SET TTY FLAGLC
-
-/ SEARCH LOCATIONS 200-377 FOR A 247.
-/ IF NOT FOUND, LOWER CASE FLAGGING WAS NOT ENABLED AT ASSEMBLY TIME.
-/ IF FOUND, CALL ITS ADDRESS X.
-/ TO DISABLE FLAGGING, SET LOCATION X-2 TO A 7200.
-/ TO RE-ENABLE FLAGGING, SET LOCATION X-2 TO A 7640.
-
-/ SET TTY PAUSE [N]
-
-/ SEARCH LOCATIONS 200-300 FOR A 15.
-/ IF NOT FOUND, PAUSING WAS NOT ENABLED AT ASSEMBLY TIME.
-/ IF FOUND, CALL ITS ADDRESS X.
-/ TO DISABLE PAUSING AFTER A FULL SCREEN,
-/ SET LOCATION X-3 TO A 7610.
-/ TO RE-ENABLE PAUSING, SET LOCATION X-3 TO A 7650.
-/ TO SET PAUSE DURATION, SEARCH LOCATIONS 300-377 FOR A 7600,
-/ CALLING ITS ADDRESS X. THEN (MINUS THE) PAUSE DURATION IS AT
-/ LOCATION X+5.
-
-/ SET TTY HEIGHT
-
-/ THIS IS ONLY APPLICABLE IF SET TTY PAUSE HAS BEEN ASSEMBLED IN
-/ (A 15 CAN BE FOUND ON SECOND PAGE).
-/ NEGATIVE OF HEIGHT MUST BE SET IN BOTH LOCATIONS X+3 AND X+4
-/ WHERE X IS THE ADDRESS OF A 7600 AS IN ABOVE.
- / SET TTY ESCAPE
-
-/ SEARCH LOCATIONS 200-377 FOR A 44.
-/ IF NOT FOUND, THEN $ WAS NOT ASSEMBLED INTO TTY HANDLER.
-/ IF FOUND, CALL ITS ADDRESS X.
-/ TO DISABLE PRINTING ESCAPE AS $, SET LOCATION X-4 TO A 'CLA'.
-/ TO CAUSE ESCAPE TO PRINT AS AN ESCAPE, SET LOCATION X-4 TO SZA CLA.
-
-/ SET TTY ARROW
-
-/ SEARCH LOCATIONS 200-377 FOR 7740.
-
-/ IF NOT FOUND, USING OLD HANDLER.
-/ CALL ITS ADDRESS X.
-/ IF LOCATION X+1 IS MORE THAN 7000,
-/ THEN UPARROW MODE WAS NOT ASSEMBLED INTO KL8E.
-/ OTHERWISE, TO ALLOW ARROWS, SET LOCATION X+3 TO THE
-/ CONTENTS OF LOCATION X+6.
-/ TO CAUSE CONTROL CHARACTERS TO ECHO AS IS, SET
-/ LOCATION X+3 TO 'SKP CLA'.
-/ NOTE THAT THIS IS A DIFFERENT OPTION THAN ASSEMBLING CTRL=0.
- IFDEF TEST <
- *600
-
-/TEST ROUTINE FOR KL8E HANDLER
-
-GO, JMS I (TTY /CALL HANDLER
- 0600 /READ SIX PAGES
- 1000 /BUFFER AT 01000
- 0001 /BLOCK 1
- HLT /ERROR RETURN
- JMS I (TTY /CALL HANDLER AGAIN
- 4600 /OUTPUT SIX PAGES
- 1000
- 0001
- HLT
- CLA
- JMP GO
- >
- $
-
DELETED src/os8-v3f/OS78.BI
Index: src/os8-v3f/OS78.BI
==================================================================
--- src/os8-v3f/OS78.BI
+++ /dev/null
@@ -1,40 +0,0 @@
-$JOB UPDATE OS/78 V2 TO RX02 FLOPPIES
-.R PIP
-*FUTIL.SV,RESORC.SV,BUILD.SV</D
-*BPAT.BN,FPAT.BN,BOOT.SV</D
-*RLFRMT.SV,VXNS.BN,VXSY.BN</D
-*RXNS.BN,RXSY1.BN,RXSY2.BN</D
-*RLSY.BN,RL0.BN,RL1.BN</D
-*RL2.BN,RL3.BN,RLC.BN</D
-*RX78C.BN,KL8E.PA</D
-*CCL.MA,CCLPS.MA,CCLTBL.MA</D
-*CCLCDX.MA,CCLCD.MA,CCLCOR.MA</D
-*CCLSIZ.MA,CCLTAB.MA,CCLDRV.MA</D
-*CCLAT.MA,CCLSB2.MA,CCLDAT.MA</D
-*CCLSEM.MA,CCLREM.MA,CCLMSG.MA</D
-*CCLRUN.MA,CCLSUB.MA</D
-/
-.RUN RXA1:FOTP
-*SYS:<RXA1:BITMAP.SV,HELP.HL,HELP.SV,RESEQ.BA,SPOOLR.SM
-*SYS:<RXA1:QUEUE.SV,SRCCOM.SV,CREF.SV,BASIC.OV,BASIC.WS
-*SYS:<RXA1:BRTS.SV,BASIC.SV,DIRECT.SV,FOTP.SV,EDIT.SV
-*SYS:<RXA1:BLOAD.SV,DEMO.BI,DEMOG.BA,DEMON3.TX,DEMONP.SV
-*SYS:<RXA1:DEMOCH.SV,DEMO1.SV,DEMON1.TX,DEMOIN.BA,DEMOM4.TX
-*SYS:<RXA1:DEMOM2.TX,DEMO1.V2,DEMOCH.PA,DEMOM6.TX,DEMO1.PA
-*SYS:<RXA1:DEMONP.PA,DEMOM7.TX,DEMOM5.TX,DEMOMX.TX,BCOMP.SV
-*SYS:<RXA1:DEMOM3.TX,DEMOM1.TX
-$MSG ENTER CR AFTER PUTTING IN DISK #2
-.R FOTP
-*SYS:<RXA1:F4.SV,PASS3.SV,FRTS.SV,PASS20.SV,LOAD.SV
-*SYS:<RXA1:PASS2.SV,RALF.SV,FORLIB.RL
-.SET SYS OS78
-.SET TTY WIDTH 80
-.SET TTY COL 2
-.SET SYS INIT HELP
-.SET TTY SCOPE
-.SET TTY PAUSE 3
-$MSG INSERT A BLANK FLOPPY IN RXA1 AND ENTER A CR
-.DUPLIC RXA1:<RXA0:
-$MSG YOU MAY DELETE FILE OS78.BI AFTER DOING A CR
-$END
-
DELETED src/os8-v3f/OS8.PA
Index: src/os8-v3f/OS8.PA
==================================================================
--- src/os8-v3f/OS8.PA
+++ /dev/null
@@ -1,4143 +0,0 @@
-/12 OS8 MONITOR SYSTEM OS8 VERS. 3F
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /13-APRIL-1977 RL/EF/HJ/SR
-
-
- /THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM
- /AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM
- /IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8
- /USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE
- /QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH.
- /THIS VERSION IS COMPATIBLE WITH CCL.
-
-/ SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:
-
- MEOVLY=26 /DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
- MCDREC=51 /COMMAND DECODER
- MSOVLY=54 /"SAVE W. ARGS" OVERLAY
- MSOVL2=55 /SECOND PART OF SAVE W. ARGS
- MERRTN=56 /MONITOR ERROR ROUTINE
- MRUNRC=57 /"CHAIN" OVERLAY
- ODTREC=60 /SYSTEM ODT
- MFREE=70 /BEGINNING OF FILE STORAGE
- CCB=7400
- CSOVLY=400
- RSOVL1=1400
- RSOVL2=2000
-
- EXOVLY=64 /EXTENDED MEMORY OVERLAY
- LXM=6200 /EXTENDED MEMORY LOAD INSTRUCTION
- VERSNO=3
- PATCHLEV="S
-
-/V3 CHANGES:
-
-/1. CCL SUPPORT
-/2. FIXED KILLER CLOSE BUG
-/3. ADDED VERSION NUMBER
-/4. ^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN
-/5. CALL TO USR WITH CODE OF 0 GIVES ERROR
-/6. MONITOR ERROR MESSAGES NOW GIVE EXPLANATION
-/7. ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT
-/8. DIRECTORY VERIFICATION HAS IMPROVED
-
-/V3 FIXES TO ABSLDR:
-
-/1. ALLOWED PARITY ^C
-/2. PUT IN SELF-STARTING STUFF
-/3. FIXED CCB BUG FOR 17600
-
-/FIXES TO FIELD RELEASE
-
-/1. ABSLDR CHECKS PAGE 0 LITERALS
-/2. FIXED BUG RE MONITOR ERROR MESSAGES
-/3. ADDITIONAL INFO FIX
-/4. BATCH FIX
-
-/FIXES FOR MAINTENANCE RELEASE:
-
-/1. CHANGED VERSION NUMBER OF MONITOR TO V3M
-/2. INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
-/ [SEQ #1, DSN APRIL 1975]
-/3. ALLOW CHAIN TO WORK ON FULL FIELD SAVES
-/ [SEQ #2, DSN JUNE 1975]
-/4. ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
-/ [SEQ #1, DSN OCTOBER 1975]
-/5. ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
-/ MAINT. RELEASE VERSION # IS V4
-/6. SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975
-
-/V3D AND OS/78 CHANGES:
-
-/1. ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
-/2. CHANGED VERSION NUMBER TO V3Q
-/3. ADDED DATE/78 CHANGES
-/4. FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
-/5. ADDED STUFF FOR LINKER [USES SOFSET]
-/6. CHANGED ABSLDR DATE TO 1-JUNE-77
-/7. DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
-/8. ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
-/9. ALLOW @ IN KBM COMMAND
-/10. COULD RUN INIT.CM ON SYSTEM START-UP
-/11. CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
-/12. CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
-/V3F CHANGES:
-
-/1. ADDED MONITOR SUPPORT FOR KT8A
-/ A. R,RUN, GET COMMANDS NOW LOAD 128K
-/ B. SAVE COMMAND CAN SAVE UP TO 128K
-/2. ADDED HIGROUND SUPPORT
-/3. ABSLDR ALSO UPDATED TO SUPPORT 128K
- /KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT
-
- FIELD 0
- MTHREE=CLA CLL CMA RTL
- *200
-PRINT, JMP I HNDL /MUST BE AT 200 FOR BATCH
- JMP .+3 /****GETS CIF CDF N FOR BATCH*****
- TSF /****GETS JMP I .+1******
- JMP .-1 /*GETS BOSPRT*****
- TLS
- CLA
- TAD [7000
- DCA PRINT+1
- JMP I PRINT
-GETNAM, 0 /ROUTINE TO ACESS TTY INPUT
- DCA NM1 /FIRST OFF,INITIALIZE
- DCA NM2 /SET UP SYMBOLS FOR STORING NAME
- DCA NM3
- DCA NM4
- TAD TNM1
- DCA PN
- CLA CMA
- DCA PRDSW
-GTNMX, DCA NMCT
- TAD I LXR /LOCATE FIRST CHARACTER
- TAD M240 /IS IT A SPACE?
- SNA /IF SO TEST NEXT CHARACTER
- JMP .-3
- TAD [240 /WE'VE GOT FIRST CHARACTER
- SKP
-GTNMLP, TAD I LXR /GET ANOTHER CHARACTER
- DCA TMP
- TAD TMP
- TAD M256 /IS IT A PERIOD?
- SNA
- JMP PERIOD /IF SO, PROCESS IT
- TAD [-2
- CLL
- TAD M12
- SNL CLA /IS IT GT ASCII CHARACTER (#9)?
- JMP NINSRT /IF NO, INSERT IN NAME
- TAD M301
- TAD TMP
- CLL CML
- TAD [-32
- SNL CLA /IS IT GT ASCII(Z),IF SO
- JMP EONAME /END OF NAME
-NINSRT, TAD NMCT /CHECK FOR MAXIMUM CHARS
- TAD [-6
- SMA CLA
- JMP GTNMLP /IF MAXIMUM SAVE NO MORE
- TAD NMCT /SET UP POINTER TO STORE CHARACTER
- CLL RAR
- TAD PN
- DCA TEMP1 /HERE IS POINTER TO NM1,NM2,ETC.
- TAD TMP
- AND [77 /ISOLATE SIX BITS FOR STORAGE
- SZL
- JMP .+4 /NO MORE ROOM
- RTL
- RTL
- RTL
- TAD I TEMP1 /OR IT IN AND STORE
- DCA I TEMP1
- ISZ NMCT
- JMP GTNMLP
-PERIOD, ISZ PRDSW
- JMP EONAME
- ISZ PN
- TAD N4
- JMP GTNMX
-EONAME, TAD NMCT
- SZA CLA
- ISZ GETNAM
- JMP I GETNAM
-
-HNDL, 4000 /ROUTINE TO RELOAD NON-SYS HANDLER FOR SAVE ROUTINE
- JMS I [SHNDLR
- 0200 /READ TWO PAGES
- 1000 /INTO 1000
-LDBLK, 0 /SET UP BY SAVE ROUTINE
- JMP KMONER
- JMP I HNDL
-
-PRINTQ, JMS PRMESG
- TEXT /?/
- 0
-KMER3, JMS I [PRMESG
- TEXT /NO/
-TNM1, NM1
-M240, -240
-
- *325
-PRINLP, JMS PRWD
- ISZ PRMESG
- SKP
- IFNZRO .-330 <CCLTRB,ERRR>
-PRMESG, 0 /ERROR MESSAGE PRINTING ROUTINE
- CLA
- TAD I PRMESG
- SZA
- JMP PRINLP
- TSF
- JMP .-1
- JMP I ERRET /RETURN TO MONITOR
-PRWD, 0
- DCA TMP
- TAD TMP
- RTR
- RTR
- RTR
- JMS PCHAR
- TAD TMP
- JMS PCHAR
- JMP I PRWD
-PCHAR, 0
- AND [77
- SNA
- JMP I PCHAR
- TAD [240
- AND [77
- TAD [240
- JMS I PCH
- JMP I PCHAR
- M12, -12
-M256, -256
-M301, -301
-
-N4, 4
-
- *367
-SAVE12, JMS I [SHNDLR /RELOAD AND RETURN TO MONITOR FROM SAVE
- 0610
- 0
- MONTOR
- JMP KMONER
- CLA CMA
- CDF 10
- DCA I [7700
- JMP I [7605
- *400
-KMNTRY, JMP I GDEVNO /V3
- 0 /FREE LOCATION !
-PCRLF, JMS I [CRLF
- IFNZRO .-403 <BTCHER,XXXX>
-
-KEYMON, JMS I GLINE
- TAD [BEGLN-1 /ADDRESS REFERENCED BY INIT
- DCA LXR
- JMS I GNAME
-/V3D JMP I [PRINTQ
- XXX=[PRINTQ /NEED LITERAL IN SAME PLACE
- NOP /V3D ALLOW @ IN NAME
- JMS I [SRCH
- -123; ASSIGN
- -2301; SAVE
- -2225; RUN
- -705; GET
- -2200; R
- -2324; START
- -1704; ODT
- -0405; DEAS
- IFNZRO .-431 <SEECCL,ZZZ>
- -0401; DATE
- 0
- JMP I .+1
-CCLSW, PRQMRK /MODIFIED FOR CCL TO 'GETCCL'
- IFNZRO CCLSW-435 <SEECCL,ZZ>
-
-ASSIGN, TAD [12
- JMS GDEVNO
- TAD [UDNAME-1
- DCA TM1
- JMS I GNAME
- JMP ASGN2+1 /NO USER DEV. DO A DEASSIGN
- TAD NM2 /SEE IF WE HASH IT
- SNA
- JMP ASGN2 /DON'T HASH..ONLY 1 OR 2 CHARS
- TAD NM1
- RAL /LINK BECOMES 4000 IF NECESSARY
- CLA CML RAR
- TAD NM2
-ASGN2, TAD NM1
- JMP I [ASDONE
- R, DCA I [GETSW
- TAD P6203
- JMS I [RESET
- ISZ RUNSW
- TAD [SHNDLR
- DCA HANDAD
- CLA IAC
- JMP RGETPG
-
-GDEVNO, KMINIT
- DCA ASNM1-1
- JMS I [MINCOR
- JMS I GNAME
- JMP I [KMER4
- TAD NM1
- DCA ASNM1
- TAD NM2
- DCA ASNM1+1
- TAD HNDLAD
- DCA HANDAD
- CIF 10
- JMS I SYSTEM
- 1
-ASNM1, 0;0
-HANDAD, KMINIT
- JMP I [KMER1
- TAD ASNM1+1
- JMP I GDEVNO
- GET, TAD [SKP
-RUN, DCA I [GETSW
- TAD P6203
- JMS I [RESET
- DCA RUNSW
- CLA IAC
- JMS GDEVNO
-RGETPG, JMS RSCOMN
- JMS I [MINCOR
- TAD SENTER
- CIF 10
- JMS I SYSTEM
- 2
-PGNAME, NM1
- MOVBUF /USED AS POINTER TO FIELD 1 SR
- JMP I [KMER2
- JMP I [RLOADR
-RSCOMN, 0
- DCA SENTER
- TAD HANDAD
- DCA DEVHND
- JMS I GNAME
- JMP I [KMER4
- TAD NM4
- SNA
- TAD [2326
- DCA NM4
- JMP I RSCOMN
-SAVE, TAD [SAVE12 /CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE
- DCA ERRET
- TAD I [JSBITS
- JMS I [RESET
- CIF 10 /MOVE THE LINE BUFFER TO 1600 DURING
- JMS I PGNAME+1 /A SAVE, AS HANDLER WIPES IT OUT
- TAD LXR /LET'S MOVE THE REGISTER AROUND
- TAD [SVLNBF-BEGLN
- DCA LXR
- TAD [1001
- DCA HNDLAD
- CLA IAC
- JMS GDEVNO
- JMS RSCOMN
- JMP I [SAVE2
-HNDLAD, /REPLACED WITH 1001 BY SAVE
-
-WRCTLB, 7001 /WRITE OVERLAY AND CCB
- JMS I [SHNDLR
- 4600
- 6200
- MTEMP+6
- JMP KMONER
- JMP I WRCTLB
- *573 /LOADS SYSTEM ODT OVER THE MONITOR
-ODT, JMS I PGTOUT
- JMS I [SHNDLR
- 1001
- 0
- ODTREC
- /LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
- *600
-START, DCA TEMP1
- DCA TEMP2
- TAD I LXR /V3
- SZA /V3
- JMP I [STRTX /V3
- TAD I [JFIELD
- DCA I [MSTCDF
- TAD I [JSBITS
- AND [1000
- SZA CLA
- JMP I [KMER3
- TAD I [JSBITS
- JMS I [RESET /RESET ONLY IF NO START ADR SPECIFIED
- TAD I [JSTART
-STCOMN, DCA I [MSTADR
- TSF
- JMP .-1 /WAIT FOR PRINTER TO FINISH
- JMS I PGTOUT
- TAD I [JSBITS
- SPA CLA
- JMP I [MSTCDF
- TAD [SHNDLR
- DCA I [MREAD-1
- TAD [1000
- DCA I [MREAD+1
- DCA I [MREAD+2
- TAD [MTEMP+4
- DCA I [MREAD+3
- TAD FUDJMP
- DCA I [MSWITC
- JMP I [MREAD
- MINCOR, 0
- CIF 10
- JMS I SYSTEM
- 10
- CDF 10
- DCA I [OLDT9 /ZERO OUT "DIRECTORY IN CORE" KEY
- CDF 0
- TAD [200
- DCA SYSTEM
- JMP I MINCOR
-RLOADR,
-RUN1, TAD I [PGNAME
- DCA FILE
- JMS I DEVHND
- 0101
- CCB
-FILE, 0 /READ IN THE HEADER BLOCK
- JMP KMONER /ERROR WHILE READING HEADER BLOCK
- TAD I [CCB
- JMS I [CCBTST /TEST FOR VALID CORE CONTROL
- TAD I [CCB+3 /V3D
- RAL /V3D
- JMS I KRCHK /V3D CAN'T RUN SYSTEM CUSP UNDER OS78
- TAD I [CCB+1
- DCA I [MSTCDF
- TAD I [CCB+2
- DCA I [MSTADR /MOVE THE STARTING ADDRESS INTO UPPER CORE
- TAD I [CCB+1
- DCA I [JFIELD
- TAD I [CCB+2
- DCA I [JSTART
- TAD I [CCB+3 /SET UP THE JOB INFORMATION AREA
- JMS I [RESET /AND CLEAR INFORMATION ABOUT "RUN" HANDLER
- TAD FUDJMP
- DCA I [MSWITC /SET MSWITC TO INHIBIT LOADING 7400
-GETSW, SKP /SKP FOR GET, NOP FOR RUN
- JMP RUN2
- TAD P6203
- DCA I [MSTCDF
- TAD [7600
- DCA I [MSTADR /IF A GET, SET STARTING ADDRESS TO RETURN
- /TO MONITOR
- RUN2, TAD EXTMP
- CLL CMA RAL /POINT TO LAST DOUBLEWORD IN CCB
- TAD TCCB4 /CCB4=CCB+4
- DCA TM1 /TM1 POINTS TO SEG. ADDRESS
- TAD I TM1 /STORE ADDRES TO READ POSSIBLE OVERLAY
- DCA I [MREAD+2
- ISZ TM1 /POINT TO SEGMENT CONTROL WORD
- TAD DEVHND /IF THE HANDLER IS IN 7600, OR
- TAD [200 /IF THE SEGMENT DOES NOT LOAD OVER
- CLA RAL /7000, NO OVERLAY IS NEEDED. ALSO IF
- TAD I TM1 /THE SEGMENT IS IN FIELDS 1-7.
- AND [77
-RUN5A, SZA CLA
- JMP I RUNVI /NO PROBLEMS.. READ STUFF IN
- TAD I [MREAD+2 /SEE IF WE OVERLAY 7000
- CLL CML RAR
- TAD I TM1 /ADD IN CONTROL WORD
- TAD [300
- SPA /IF NEGATIVE, 7000 IS NOT OVERLAYED
- JMP RUN5A
- TAD [7600 /GETS 0, 100, 200, OR 300
- SMA /IF POSITIVE READ 3 PAGE OVERLAY
- ISZ I [PGNAME+1 /POINT TO NEXT TO LAST RECORD
- TAD [300
-
- DCA RDCNT
- TAD I [PGNAME+1
- CMA /GET RECORD TO READ OVERLAY FROM
- TAD FILE
- DCA R7000
- JMS I DEVHND /READ OVERLAY FROM THE FILE INTO PAGES
-RDCNT, 0 /BEFORE CCB
- 6200 /THEN WRITE THE WHOLE MESS OUT
-R7000, 0
- JMP KMER1 /NOT AVAILABLE
- JMS I [WRCTLB /WRITE OUT THE OVERLAY+CCB
- DCA .-1 /BUT ONLY ONCE!!
- ISZ RUNSW
- DCA I [MSWITC /ENABLE READ OF OVERLAY
- TAD RDCNT /SEE IF THIS SEG IS EXHAUSTED
- CIA
- TAD I TM1
- SPA SNA
- ISZ EXTMP /ARE WE DONE ALL SEGMENTS?
- SKP /NOT YET. LOOP UNTIL DONE
- JMP I [MSWITC
-RUN5, DCA I TM1 /SAVE ALTERED CONTROL WORD
- JMP RUN2
- /ASDONE, CDF 10
-/ DCA I TM1 /THIS COULD BE OPTIMIZED
-/ CDF 0
-/ JMP I [KEYMON
-
-KMER1, JMS I [PRNAME /DEVICE NOT AVAILABLE
- JMS I [PRMESG
- TEXT / NOT AVAIL/
-TCCB4, 7404 /CCB+4
-RUNVI, RUN6
- *1000
-/MUST BE AT 1000 FOR BATCH
-BEGLN, 0 /LINE BUFFER COULD BECOME "@
- "I
- "N
- "I
- "T
-KMINIT, CDF 10 /INITIALIZATION - DESTROYED BY LINE BUFFER
- ISZ I [7700 /LOC 17700=7777 IF I/O MONITOR IS KNOWN
- JMP .+3 /TO BE IN CORE, SO SET UP
- TAD [200 /THE INITIAL POINTER FOR CALLS TO THE MONITOR
- DCA SYSTEM /ACCORDINGLY
- CDF 0
- TAD I LXR
- DCA I X1
- ISZ TEMP2
- JMP .-3
- CDF 10
- TAD MVFROM
- DCA I PDBUF
- ISZ .-2
- ISZ PDBUF
- ISZ MVCNT
- JMP .-5
- CDF 0
- TAD I PDBUF+1 /SEE IF BATCH IS SET
- RAL /IF YES, GO TO PAGE 0 TO CONTINUE
- SMA CLA /IF IT ISN'T, CONTINUE NORMALLY
- JMP INTGO /NORMAL KEYBOARD SYSTEM
- DCA I RTWTPT /DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING
- TAD I [JSBITS /IS BOS IN PLACE?
- AND DCBF
- SNA CLA
- JMP BATCH /NO. GO READ IT IN.
- JMP BCHGO /YES. START IT UP.
-INTGO, TAD [200
- KRS
- TAD M203
- SNA CLA /IS THERE A ^C IN THE READER BUFFER
- KSF /WITH THE FLAG ON?
- JMP I ERRET /NO - PRINT CRLF AND PERIOD
- JMP CLR /V3D
-/CCLADR, GETCCL /V3D DIDN'T SEEM TO BE USED
-RTWTPT, RUNTWT
-DCBF, 400
-/START
-PMSRST, SHNDLR&177+4200 /JMS SHNDLR
- 0300
- 7000
- MTEMP+6
- HLT /CONTAINS SECOND COPY OF OS/78 BIT
- CDF CIF 0
- TCF
-/END
-MVCNT, MOVBUF-MVT3-1
-PDBUF, MOVBUF
- MVFROM, NOPUNCH
- *7626
- ENPUNCH
-MOVBUF, 7777 /USED IN BATCH SETUP
- TAD I MVT1 /MOVE THE LINE BUFFER FROM 1000
- DCA I MVT2 /TO 1655
- ISZ MVT1
- ISZ MVT2
- ISZ MVT3
- JMP .-5
- CIF CDF 0
- JMP I MOVBUF
-
-MVT1, BEGLN
-MVT2, SVLNBF
-MVT3, -111
-
-
- *1077 /V3D
-INIT, CDF 10 /V3D (INITIALIZATION)
- TAD DCBF
- DCA I ROT /RESTORE LOC 7677 TO '400'
- CDF 0
- DCA KMINIT /END LINE WITH 0
- TLS
- JMP I CRLF /FAKE OUT KBM AS IF USER TYPED @INIT
-
-
-CLR, KCC
- JMP I .+1
- CTRLC
-TX212, 212
- *1112
- ENPUNCH
-
-DIGTLP, TAD I LXR
-STRTX, TAD (-270
- CLL
- TAD [10
- DCA TMP1 /V3
- SNL
- JMP EONUM
-/V3 ISZ DIGFLG
- JMS ROT
- JMS ROT
- JMS ROT
- TAD TEMP2
- TAD TMP1
- DCA TEMP2
- JMP DIGTLP
-EONUM, TAD TEMP1
- AND [7
- CLL RTL
- RAL
- TAD KM6203
- DCA I [MSTCDF
- TAD TEMP2
- JMP I .+1
- STCOMN
-
-ROT, 7677 /V3D NEEDED FOR INIT
- TAD TEMP2
- CLL RAL
- DCA TEMP2
- TAD TEMP1
- RAL
- DCA TEMP1
- JMP I ROT
- DEAS, TAD [UDNAME-1
- DCA X1
- TAD [-17
- DCA TM1
- CDF 10
- DCA I X1
- ISZ TM1
- JMP .-2
-KM6203, CDF CIF 0
- JMP I [KEYMON
-
-ASDONE, CDF 10 /V3
- DCA I TM1 /V3
- JMP KM6203 /V3
-
-
-CRLF, KEYMON+1 /V3D NEEDED FOR INIT
- TAD [215
- DCA NM1
- JMS I (PRNT
- TAD TX212
- JMS I PCH
- JMP I CRLF
-
-M203, -203
- PAGE
- /NOTE: XR=AMFLAG !
-
- *1200
- /TELETYPE INPUT ROUTINE
-XGLINE, KEYMON+1 /MUST BE AT 1200 FOR BATCH & CCL
- TAD [".
- JMS I PCH
- DCA RBFLAG
- TAD [BEGLN-1
-CHLM1, DCA LXR
- DCA AMFLAG /ZERO ALTMODE FLAG
-CHLOOP, KSF
- JMP CHLOOP
- TAD [200
- KRS
- DCA NM1
- KCC
- JMS SRCH
- -225;CTRLU
- -215;CARRET
- -377;RUBOUT
- -375;ALTMOD /THIS AREA GETS MODIFIED BY SET
- -376;ALTMOD
- -233;ALTMOD
- -212;LFEED
- -200;CHLOOP
- -217;CHLOOP /IGNORE ^O
- -203;CTRLC /MUST BE JUST BEFORE 0
- /MUST BE HERE FOR CCL
- 0
- JMS PRNT
-CINSRT, TAD NM1
- DCA I LXR
- TAD LXR
- TAD [-BEGLN-110
- SPA CLA
- JMP CHLOOP
-CARRET, JMS I [CRLF
- TAD LXR
- TAD [1-BEGLN
- SNA CLA
- JMP XGLINE+1
- DCA I LXR
- DCA I LXR
- JMP I XGLINE
- /THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
-/**** BEWARE! ***
-
-PRNT, 0
- ISZ RBFLAG
- JMP .+3
- TAD ["\
- JMS I PCH
- DCA RBFLAG
- TAD NM1
- JMS I PCH
- JMP I PRNT
-CTRLC,
-CTRLU, TAD ["^
- JMS I PCH
- TAD NM1
- TAD [100
-CLRLIN, JMS I PCH
-RBSPCL, JMS I [CRLF
- JMP XGLINE+1
-
-ALTMOD, TAD ["$
- DCA NM1
- JMS PRNT
- ISZ AMFLAG /NOTE ALTMODE
- JMP CARRET+1
-RUBOUT, TAD LXR
- TAD [1-BEGLN
- SNA CLA
- JMP RBSPCL
- TAD ["\ /MUST BE HERE
- ISZ RBFLAG
- JMS I PCH
- CLA CMA
- DCA RBFLAG
- TAD LXR
- DCA TEMP1
- TAD I TEMP1
- JMS I PCH
-LBCKUP, CLA CMA
- TAD LXR
- JMP CHLM1
- SRCH, 0
- TAD I SRCH
- ISZ SRCH
- SNA
- JMP I SRCH
- TAD NM1
- SNA CLA
- JMP SFND
- ISZ SRCH
- JMP SRCH+1
-SFND, TAD I SRCH
- DCA TEMP1
- JMP I TEMP1
-LFEED, JMS I [CRLF
- DCA I LXR
- TAD [".
- JMS I PCH
- TAD [BEGLN-1
- DCA XR
- TAD I XR
- SNA
- JMP LBCKUP
- JMS I PCH
- JMP .-4
-
-PRQMRK, JMS I [PRNAME
- JMP I [PRINTQ
- IFNZRO PRQMRK-1357 <SEECCL,ZZXX>
- ZBLOCK 1 /A FREE LOCATION!
-
- IFNZRO .-1362 <FIXCCL,ERRRR>
-
-GETCCL, TAD [6003
- JMS I [RESET
- TAD [67 /CCL OVERLAY BLOCK IS BLOCK 67 ***
- DCA OV
- JMP DATE2
-DATE, TAD TMP
- SNA CLA
- JMP I [CCLSW-1 /USED TO BE JMP GETCCL
-DATE2, JMS I [SHNDLR /READ IN DATE OVERLAY
- 0201
- 0400
-OV, MSOVL2
- JMP KMONER
- JMP I [600
- PAGE
- *1400
-SAVE2, TAD I LXR
- SNA /ARE THERE ANY ARGS?
- JMP SAVE2A /NO ... USE CCB
- JMS I [SHNDLR /READ IN ARG OVERLAY
- 0201
- CSOVLY
- MSOVLY
- JMP KMONER
- JMP I CCBTST /GO TO IT
-SAVE2A, JMS I [SHNDLR
- 0201
- 400
- MTEMP+10
- JMP KMONER
-SAVE3, TAD [603
- DCA XR
- DCA LXR /INITIALIZE FOR GT32K I.D.
- TAD I [600
- JMS I [CCBTST
- JMS I [SHNDLR
- 0101
- 400
- MSOVL2
- JMP KMONER
- JMP I GETOUT
-SAV2X, JMS I PGTOUT
- TAD I [600 /UPDATE THE SEGMENT COUNT BY
- CLL RAL /FIRST,MAKING SURE 4000 BIT IS SET
- STL RAR
- CIA
- TAD MERTST /SUBTRACT # OF GT32K SEGS THIS ALLOW US TO BYPASS...
- DCA EXTMP /SAVE COUNT FOR GT32K
- TAD EXTMP
- CLL RAL /WE WANT TO BUMP COUNTER TWICE FOR EVERY SEG
- TAD [603 /ADD POINTER TO INITIAL SEGMENT
- DCA XR
- TAD EXTMP
- CIA
- DCA EXTMP
- JMP I RCHK
-KMER4, JMS I [PRMESG
- TEXT /TOO FEW ARGS/
-
-
-CCBTST, SAVE1A&177+400 /EXAMINE COUNT WORD OF CCB FOR VALIDITY
- /ASCII AND BINARY FILES USUALLY FAIL THIS TEST
- CLL RAL /INSURES 4000 BIT IS SET--128K INDICATOR
- STL RAR
- DCA EXTMP
- LXM /INITIALIZE EXTENDED MEMORY
- TAD EXTMP
- CMA
- AND [7740
- SNA CLA
- JMP I CCBTST /IT WAS VALID
-CIERR, TAD [7605
- DCA ERRET /RELOAD MONITOR ON THIS ERROR
- JMS I [PRMESG /IT WASN'T - TELL THE USER
- TEXT /CORE IMAGE ERR/
-GETOUT, SAVE3A&177+400 /SUBROUTINE TO KICK MONITOR OUT IF NECESSARY
- TAD I [JSBITS
- RAR
- CLA
- TAD SYSTEM
- SZL SPA CLA /IS THE SYSTEM IN CORE AND SHOULD IT BE?
- JMP I GETOUT
- CIF 10 /YES AND NO - KICK IT OUT
- JMS I SYSTEM
- 11 /BYE BYE
- TAD [7700
- DCA SYSTEM
- JMP I GETOUT
-KMER2, JMS PRNAME
- JMS I [PRMESG
- TEXT / NOT FOUND/
-PRNAME, 4000
- TAD NM1
- JMS I [PRWD
- TAD NM2
- JMS I [PRWD
- TAD NM3
- JMS I [PRWD
- TAD NM4
- SNA CLA
- JMP I PRNAME
- TAD [256
- JMS I [PCHAR
- TAD NM4
- JMS I [PRWD
- JMP I PRNAME
-
-
-RESET, 0
- DCA I [JSBITS /MARK AREAS FOR I/O OPTOMIZATION
- JMS I [MINCOR
- CIF 10
- JMS I SYSTEM
- 13 /RESET DEVICE HANDLERS AND OUTPUT FILES
- JMP I RESET
-
-RCHK, XLOD&177+400
- AND I XTADR /V3D
- AND [200 /CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
- SZA CLA
- JMP CIERR /V3D CAN'T FALL INTO KMER3
- /BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
- TAD EXTMP
- DCA I RR7400 /SET UP SEGMENT COUNT FOR RUN LOAD
- JMP I RCHK
-RR7400, R7400
-SVXER, JMS I [PRMESG
- TEXT /SAVE ERR/
-XTADR, OS78
- PAGE
-
- *1600
-
-RUN6, TAD I TM1 /STORE CONTROL WORD FOR LAST SEG.
- DCA I [MREAD+1
- TAD RUNSW /IS THIS R OR RUN?
- SNA CLA
- JMS I [WRCTLB /RUN
- TAD I RFILE /V3D FOR LINKER
- DCA I RCTL /V3D SAVE BLOCK NUMBER IN 'SOFSET'
- TAD I RFILE
-RUN7, IAC
- DCA RUNFIL /STORE STARTING BLOCK NUMBER
-RUN7A, TAD DEVHND
- DCA I [MREAD-1
- TAD DEVHND
- DCA RUNHND /STORE DEVICE HANDLER ENTRY IN THIS PAGE
- TAD I ADR1
- DCA I ADR2
- ISZ ADCNT
- JMP .-3
- JMP I .+1
- RUN8&177+7400
-
-ADCNT, RUN8&177+7600
-RFILE, FILE
-CHK32, 0 /PROTECTS MONITOR FROM GREATER THAN 32K FIELD 0 LOAD
- TAD I RCTL1
- AND T76A /ISOLATE CDEB BITS FOR FUTURE USE
- DCA CDE
- TAD I RCTL1
- AND [7700 /LOAD EVERY FIELD INTO FIELD 1
- TAD [10 /WE'LL BUMP IT UP FROM THERE---LATER
- DCA I RCTL1
- JMP I CHK32
-T76A, 76
-RCTL1, RCTL&177+7400
-MOVUP, 0 /SUBROUTINE TO MOVE UP PROGRAM CODE
- AND T3700 /CALCULATE THE NUMBER OF LOCS
- RAL
- TAD T177
- CIA
- DCA COUNT /STORE IT HERE
- TAD CDE /PREPARE FOR CDF TO PROPER BANK & FIELD
- CLL RTR
- SZL
-
-SVLNBF,
- /
-/NEXT 111 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE
-/
- TAD TX20
- CLL RTL
- TAD T6201 /STORE IT IN EXTEND
- DCA EXTEND
- TAD I RADR1 /INITIALIZE THE INDEX REGS
- TAD SPTST
- DCA ADR1
- TAD ADR1
- DCA ADR2
- TAD [7000 /SET EXTENDED MEMORY0
- LXM
-BACK, CDF 10 /MAKE THE MOVE
- TAD I ADR1
-EXTEND, 0
- DCA I ADR2
- ISZ COUNT
- JMP BACK
- CDF 0
- TAD SPTST
- DCA I HF2
- TAD I RCTL1
- JMP I MOVUP
-T177, 177
-T3700, 3700
-T6201, 6201
-CDE, 0
-TX20, 20
-HF2, HF3&177+7400
-
-COUNT, 0
-RADR1, RADR&177+7400
- PAGE
-
- *1710
-RUN8, ISZ R7400 /IS THIS THE LAST PARAMETER PAIR?
- JMP RUN9 /NO - KEEP LOADING
- TAD RUNFIL
- DCA I RMRD3 /MOVE THE RECORD NUMBER INTO THE FINAL READ
- TSF
-RUNTWT, JMP .-1 /WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!)
- JMP I .+1
- MREAD /READ THE LAST SEGMENT AND START UP
-RUN9, TAD I RUNADR
- DCA RADR /SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT
- ISZ RUNADR
- TAD I RUNADR
- DCA RCTL /AND THE READ CONTROL WORD
- TAD RCTL
- AND TS7 /TEST FOR GREATER THAN 32K
- SNA
- DCA HF3
- SZA CLA
- JMS I CH32
- JMS I RUNHND
-RCTL, SOFSET /V3D THESE ARE STORED INTO ONLY AFTER MOVING
-RADR, OS78 /V3D
-RUNFIL, 0
- JMP RERR /INPUT ERROR READING THE PROGRAM
- TAD RCTL
- ISZ HF3 /IF GREATER THAN 32K
- JMP .+2
- JMS I MOVUPT /LOAD HIGHER FIELDS
- JMS ROTAT /GET THE BLOCK LENGTH OF THIS SEGMENT
- TAD RUNFIL
- DCA RUNFIL /UPDATE THE BLOCK NUMBER FROM IT
- ISZ RUNADR
- JMP RUN8 /BACK FOR ANOTHER ONE
-HF3, -1
-CH32, CHK32
-MOVUPT, MOVUP
-
-RERR, CIF 10
- JMS I RU7700
-TS7, 7
- 0 /TOTALLY MEANINGLESS
-RUNADR, CCB+4
-R7400, 7400
-RMRD3, MREAD+3
-RU7700, 7700
-RUNHND, 0
- IFNZRO ROTAT-SVLNBF-111&4000 <ERROR>
- *1765 /MUST BE AT TOP OF PAGE
-ROTAT, 0
- CLL RTR
- RTR
- RTR
- AND RU37
- SNA
- TAD RU37
- IAC
- CLL RAR
- JMP I ROTAT
-RU37, 37
- PAGE
-
- /OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
- *2000 /GOES INTO 400
-SAVE1A, TAD [1603
- DCA X1
- DCA TM1
- CDF 10
- DCA I [OLDT9
-S6203, CIF CDF 0
- TAD (SGETOUT-RSOVL2 /POINTER TO NEW GETOUT
-
- DCA PGTOUT /LIKEWISE "GETOUT"
- JMS I [SHNDLR
- 0210
- 1400
- MTEMP+10 /READ IN CONTROL BLOCK
- JMP KMONER
- JMS I (LXRBAK-RSOVL1 /RESET LXR TO LOOK AT FIRST CHAR
- JMS I (LXRBAK-RSOVL1
- DCA DASHFG
-SNUMLP, JMS SGTNUM
- JMP SDLOOK /NO NUMBER - GET DELIMETER
- TAD I LXR
- TAD (-"-
- SNA CLA
- JMP SVDASH
- JMS I (LXRBAK-RSOVL1
- TAD DASHFG
- SNA CLA /WAS THERE A LOWER LIMIT?
- JMS DASHSB /NO - SET LOWER LIMIT TO UPPER LIMIT
- TAD TEMP1
- CIA CLL CML
- TAD OLD1
- SZA CLA /ARE THE FIELDS THE SAME?
- JMP KMER5 /NO - ERROR
- TAD TEMP2
- AND [7600
- TAD [200
- DCA TEMP2
- TAD TEMP2
- CIA
- TAD OLD2
- SZL CLA /IS UPPER LIMIT > LOWER LIMIT?
- JMP KMER5 /NO - ERROR
- CDF 10
- TAD OLD1
- DCA I X1
- TAD OLD2
- DCA I X1
- TAD TEMP2
- DCA I X1 /CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT)
- /IN THE TABLE IN FIELD 1
- ISZ TM1 /BUMP ENTRY COUNT
- SDLOOK, CDF 0
- TAD I LXR
- SNA
- JMP I (SVEND-RSOVL1
- TAD (-",
- SNA
- JMP SNUMLP-1
- TAD [",-";
- SNA
- JMP SSTADR
- TAD [";-"=
- SNA CLA
- JMP I (SSBITS-RSOVL1
-KMER5, JMS I [PRMESG
- TEXT /BAD ARGS/
-SVDASH, TAD DASHFG
- SZA CLA
- JMP KMER5
- ISZ DASHFG
- JMS DASHSB
- JMP SNUMLP
-SSTADR, JMS SGTNUM
- JMP KMER5 /NULL STARTING ADR - ERROR
- TAD TEMP1 /TRANSFORM FOR CDF --"37" TO "174"-128K
- AND [7757 /ISOLATE '17' BITS
- TAD (-10
- SMA
- TAD [-17
- TAD (10
- TAD TEMP1
- CLL RTL
- TAD S6203
- CDF 10
- DCA I (1601 /STORE AWAY STARTING FIELD
- TAD TEMP2
- DCA I (1602 /AND STARTING ADDRESS
- JMP SDLOOK
-DASHSB, 0
- TAD TEMP1
- AND (37 /ISOLATE FIELD( & BANK)
- DCA OLD1
- TAD TEMP2
- AND [7600
- DCA OLD2
- JMP I DASHSB
-DASHFG, 0
-OLD1, 0
-OLD2, 0
-
- SGTNUM, 0 /GET A NUMBER ROUTINE
- DCA DIGFLG /CLEAR DIGIT COLLECTED FLAG
- DCA TEMP1
- DCA TEMP2
- JMS I (STARTX-RSOVL1
- JMP .+4
- TAD (20
- SNA CLA
- JMP .-4
- JMS I (LXRBAK-RSOVL1 /SHOVE INDEX BACK
- TAD DIGFLG /IS DIGIT PRESENT?
- SZA CLA
- ISZ SGTNUM
- JMP I SGTNUM
- PAGE
- *2200 /LOADS INTO 600
-SSBITS, JMS I (SGTNUM-RSOVL1
- JMP I (KMER5-RSOVL1
- TAD TEMP2
- CDF 10
- DCA I [1603
- JMP I (SDLOOK-RSOVL1
-SVEND, JMS I [SHNDLR
- 0101
- 0400
- MSOVL2 /READ IN SECOND PART OF OVERLAY
- JMP KMONER
- TAD TM1
- SNA
- JMP I (MOVECB-RSOVL2
- CIA
- CDF 10
- DCA I [1600
- /NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON
- /DECREASING FIELD AND INCREASING ADDRESS
- /WITHIN THE FIELD.
- TAD [1603
- DCA P1
- CLA IAC
- TAD I [1600
- SNA
- JMP SORTED /RIDICULOUS TO SORT ONE ITEM
- DCA TEMP1
-OUTRLP, TAD (3
- TAD P1
- DCA P2
- TAD TEMP1
- DCA TEMP2
-INERLP, TAD P1
- DCA LXR
- TAD P2
- DCA X1
- TAD I LXR
- CIA CLL
- TAD I X1
- SNA CLA
- JMP TIE /FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD
- SZL
- JMP SWITCH /WRONG ORDER - SWITCH 'EM
-TIENTY, TAD P2
- TAD (3
- DCA P2 /INDEX TO NEXT ENTRY
-SWNTRY, ISZ TEMP2
- JMP INERLP
- TAD P1
- TAD (3
- DCA P1 /ELEMENT IS IN PLACE - GO TO NEXT POSITION
- ISZ TEMP1
- JMP OUTRLP
- JMP SORTED /SORT COMPLETE - CHECK FOR CONSISTENCY
- TIE, TAD I LXR
- CIA CLL
- TAD I X1
- SZL CLA /TEST FOR ADRESSES IN ASCENDING ORDER
- JMP TIENTY /YES - DONT HAVE TO SWAP
-SWITCH, JMS SWSUBR
- JMS SWSUBR
- JMS SWSUBR
- CLA CLL CMA RTL
- TAD P1
- DCA P1 /RESET FIRST POINTER
- JMP SWNTRY /AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT
-SWSUBR, 0
- ISZ P1
- ISZ P2
- TAD I P1
- DCA TM1
- TAD I P2
- DCA I P1
- TAD TM1
- DCA I P2
- JMP I SWSUBR
-P1, 0
-P2, 0
-
- STARTX, 0
- TAD I LXR /ANYTHING LEFT?
- SNA
- JMP I STARTX /NO.. TAKE EMPTY RETURN
- SKP
-ADGTLP, TAD I LXR
- TAD (-270
- CLL /SEE IF THIS IS A DIGIT
- TAD [10
- SNL
- JMP AONUM /NO.. GET OUT
- DCA TMP1
- ISZ DIGFLG
- JMS ROT2
- JMS ROT2
- JMS ROT2
- TAD TEMP2
- TAD TMP1
- DCA TEMP2
- JMP ADGTLP /KEEP LOOKING
-AONUM, ISZ STARTX
- JMP I STARTX
-
-ROT2, 0
- TAD TEMP2
- CLL RAL /WE NEED THIS BECAUSE THE HANDLER
- DCA TEMP2 /WIPED THE FIRST COPY (MAYBE!!!)
- TAD TEMP1
- RAL
- DCA TEMP1
- JMP I ROT2
-LXRBAK, 0
- CLA CMA
- TAD LXR
- DCA LXR
- JMP I LXRBAK
-SORTED, TAD I [1600
- IAC
- SNA
- JMP I (MERGED-RSOVL2
- DCA TEMP1
- TAD [1603
- DCA X1
- TAD (1606
- DCA LXR
- JMP I [MRGLP-RSOVL2
- PAGE
- *2400 /LOADS INTO 400 ON TOP OF SAVE1A
- /NOW CHECK THE SORTED FILE FOR CONSISTENCY
- /OVERLAPPING SEGMENTS ARE ERRORS,
- /ABUTTING SEGMENTS ARE TO BE CONDENSED IN
- /THE INTERESTS OF SPEED
-MRGLP, TAD I LXR
- CIA
- TAD I X1
- SZA CLA
- JMP NOCMPR /DIFFERENT FIELDS - INCOMPARABLE
- ISZ X1
- TAD I X1
- CIA
- CLL
- TAD I LXR
- SNA CLA
- JMP BUTTNG /UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
- SZL CLA
- JMP NXTONE /UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE
- CDF 0 /UPPER LIM(2) > LOWER LIM(1) - ERROR
- JMS I [PRMESG
- TEXT /BAD ARGS/
-BUTTNG, CLA CMA
- TAD X1
- DCA X1
- TAD I LXR
- DCA I X1 /SET UPPER LIM(2) = UPPER LIM(1)
- TAD X1
- TAD (-1777
- SZA CLA
- JMP .-5 /AND COMPRESS OUT THE LOWER ENTRY
- ISZ I [1600 /DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW)
- JMP I (SORTED-RSOVL1 /START OVER FROM BEGINNING
-
-NOCMPR, ISZ X1
- ISZ X1
- ISZ LXR
-NXTONE, ISZ LXR
- ISZ TEMP1
- JMP MRGLP /NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS
- /INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E.
- /DEVICE-HANDLER ARGUMENTS
- MERGED, CDF 0 /LOAD IN MERGED OVERLAY
- JMS I [SHNDLR
- 0100
- 0600
- 64
- JMP KMONER
- JMP I (MERGEX
-MOVECB, TAD (-1777
- DCA MERTST
- JMP MERGED
-CBMOVE, CDF 10 /FINAL CODE TO MOVE NEW CONTROL BLOCK
- TAD I LXR /INTO PAGE 600 OF FIELD 0
- CDF 0
- DCA I X1
- ISZ TEMP1
- JMP CBMOVE
- JMP I (SAVE3 /EXIT TO SAVE PROCESSOR
-SAVE3A, ISZ XR
- TAD I XR /GET THE I/O CONTROL WORD OF THIS SEGMENT
- DCA ADR2 /CAUTION AUTO-INDEX TEST FOR GREATER THAN 32K
- TAD ADR2
- AND [7 /ARE THERE ANY BANK BITS?
- SZA CLA
- JMP XTAT /NO- PROCEED AS NORMAL
- TAD SPTST /ONLY WANT TO ISOLATE FIRST FIELD
- SNA CLA /BELOW 32K
- JMP XTAT
- TAD CLENGT /SET UP FIRST FIELD I.D.
- DCA LXR /CAUTION AUTO-INDEX-SAVE BLOCK OFFSET
- TAD EXTMP /SAVE NUMBER OF SEGS LEFT
- DCA MERTST /... NEGATIVE OF # LEFT
- DCA SPTST /SET I.D. "SET" FLAG
-XTAT, TAD ADR2
- JMS I PROTAT /EXTRACT THE LENGTH FROM IT
- TAD CLENGT
- DCA CLENGT /UPDATE THE LENGTH OF THE FILE
- ISZ EXTMP
- JMP SAVE3A /LOOP FOR ALL SEGMENTS OF THE FILE
- TAD CLENGT /USE THIS LENGTH WHEN ENTERING THE FILE
- CLL RTL
- RTL
- TAD SENTER
- CIF 10
- JMS I SYSTEM
- 3 /ENTER
-SFILE, NM1
- 0 /LENGHT UNIMPORTANT
- JMP I (SVXER /SAVERR CODE REPEATED
- CIF CDF 10
- TAD I [DVHREC
- CDF 0
- DCA I [LDBLK
- TAD SENTER
- JMS I SYSTEM
- 4 /CLOSE
- NM1 /NAME FOR "CLOSE"
-CLENGT, 1 /CLOSING LENGTH
- JMP I (SVXER
- JMP I (SAV2X
-XLOD, JMS I [SHNDLR
- 0201
- 1200
- 64
- JMP KMONER
- JMP I (SAVXX /JMP T0 1400
-
- SGETOUT,0 /REPLACES "GETOUT" WHICH WE'VE STORED OVER
- TAD I [JSBITS
- RAL /ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS
- SPA CLA
- JMP I SGETOUT
- CIF 10
- JMS I SYSTEM
- 11
-DECIMB, JMP I SGETOUT /DECIMB ONLY CALLED BY NEXT PAGE
- /PART OF NEXT PAGE'S ROUTINE:
- TAD NM2 /ALL NEW FOR V3D
- TAD NM4 /ONLY ALLOW 2 CHARS FOR MM
- SNA CLA
- ISZ DECIMB
- TAD NM1
- RTR
- RTR
- JMP I DECIMB
-PROTAT, ROTAT
- *2600 /DATE PROCESSOR - LOADS IN 400, RUNS IN 600
-DATEXX, JMS DECIM
-NUM2, DCA NUM2
- TAD NUM2
- TAD M40
- SMA CLA
- JMP BADNUM /DAY > 31
- JMS I GNAME
-L30, 30 /NOTHING FOUND WILL GIVE ERROR LATER
-/ DCA NUM1 /NUM1 IS INITIALLY 0
-NEWLUP, ISZ MONPTR
- ISZ NUM1
- TAD I MONPTR
- ISZ MONPTR
- SMA
- JMP BADNUM /SYMBOLIC MONTH NOT FOUND
- TAD NM1
- SNA CLA /SKIP IF FIRST 2 LETTERS DON'T MATCH
- TAD NM2
- TAD I MONPTR
- SZA CLA
- JMP NEWLUP /SECOND 2 LETTERS DON'T MATCH
-/*** TEST DELIMETER HERE
- TAD NUM1
- CLL RTL
- RTL
- RAL
- TAD NUM2
- RTL
- RAL
- DCA NUM2
- DCA DDELIM /MAKE END-OF-LINE THE DELIMITER
- JMS DECIM
- TAD (-106 /SCALE DOWN TO RANGE 1970-1999
- SPA
- JMP BADNUM /DIDN'T MAKE THE RANGE
- DCA NUM1
- TAD NUM1
- AND L30 /ISOLATE EXTENSION DATE BITS
- CLL RTL
- RTL
- DCA TM1
- TAD I (BIPCCL
- AND L7177 /STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
- TAD TM1
-TSLUP, DCA I (BIPCCL
- TAD NUM1
- AND [7
- TAD NUM2 /COMBINE WITH MONTH AND DAY
- CDF 10
- DCA I (MDATE /STORE IN SYSTEM DATE CELL
- TSF /7605 SETS THE DF
- JMS L7177 /TIME OUT A BIT
- JMP I [7605 /IN CASE RUNNING UNDER BATCH
-L7177, 7177 /JMS IS LONGER THAN JMP
- ISZ DDELIM /DDELIM IS 0 AT END
- JMS TSLUP /WAIT FOR TELETYPE TO DIE DOWN (RF08)
- JMP I [7605 /RETURN TO MONITOR
- DDELIM, -"-
-
-/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE
-
-CNV, 0
- AND [77
- SNA
- JMP NUL
- TAD (-60
- SPA
- JMP BADNUM
- JMP I CNV
-NUL, TAD TM1
- JMP GODE
-
-DECIM, 0
- JMS I GNAME
-M40, -40 /NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
- TAD TMP
- TAD DDELIM /COMPARE AGAINST DESIRED DELIMETER
- SNA CLA /DASH OR NULL
- JMS I (DECIMB-2400+400
- JMP BADNUM /DELIMETER BAD
- RTR
- JMS CNV
- DCA TM1
- TAD TM1
- CLL RTL
- TAD TM1
- RAL
- DCA TEMP2
- TAD NM1
- JMS CNV
- TAD TEMP2
-GODE, SZA
- JMP I DECIM
-BADNUM, CLA /CRAP IN AC
- TAD [7605
- DCA ERRET
- JMS I [PRMESG
- TEXT /BAD DATE/
-NUM1, 0 /MONTH NUMBER (MUST BE 0 INITIALLY)
- MONS, -1201 /JAN
- -1600
- -0605 /FEB
- -0200
- -1501 /MAR
- -2200
- -0120 /APR
- -2200
- -1501 /MAY
- -3100
- -1225 /JUN
- -1600
- -1225 /JUL
- -1400
- -0125 /AUG
- -0700
- -2305 /SEP
- -2000
- -1703 /OCT
- -2400
- -1617 /NOV
- -2600
- -0405 /DEC
- -0300
-MONPTR, MONS-2600+600-1 /RELOCATES TO PAGE 600
- /MUST BE POSITIVE
-
- PAGE
- *3000 /MONITOR ERROR PROCESSOR - LOADS INTO 11400
-DLYLPX, AND I 0
-D7600, 7600
- TAD MERRNO
- CLL RAL
- ISZ I (ZERO-1400
- ISZ I (ZERO-1400 /V3C
- ISZ I (ZERO-1400
- JMP DLYLPX /WAIT FOR TELEPRINTER (WITHOUT CDF'S)
- SNA
- JMP USRERR
- CLL RAL
- RTL
- RTL
- TAD (6040
- DCA I (MERTYP-1400
-MERCMN, TAD (MERRXR-1400
- JMS EPRINT
- TAD I (FPUTX
- RTR
- RAR
- AND (7
- TAD (60
- JMS MERPCH
- CLA CLL CMA RAL
- TAD I (MONITO
- RAL
- DCA T1
- TAD (-4
- DCA T2
-MEROLP, TAD T1
- RTL
- RAL
- DCA T1
- TAD T1
- AND (7
- TAD (60
- JMS MERPCH
- ISZ T2
- JMP MEROLP
- TAD MERRNO
- CLL RAL
- SNA
- JMP NOEXPL /NO EXPLANATION FOR USER ERRORS
- CLL RAR
- TAD (EXPLTBL-1401 /PRINT EXPLANATION
- DCA T1 /GET ADDRESS INTO MESSAGE TABLE
- TAD (240
- JMS MERPCH
- TAD ("(
- JMS MERPCH
- TAD I T1 /GET ADDRESS OF MESSAGE
- JMS EPRINT
- TAD (")
- JMS MERPCH
- TAD MERRNO
-NOEXPL, TAD (3773
- SPA CLA
- CLA CMA
- DCA I (7700
- DCA OLDT9
- CLA CLL CML RAR
- DCA MERRNO
- CDF 0
- TAD I (JSBITS
- AND (6777
- TAD (1000
- DCA I (JSBITS /SET THE CURRENT JOB UNSTARTABLE
- CDF CIF 0
- JMP I D7600
-USRERR, CLA CLL
- JMS I (FGET
- TAD (4060
- DCA I (UERTYP-1400
- TAD (UERRXR-MERRXR
- JMP MERCMN
-MERPCH, 0
- TLS
- TSF
- JMP .-1
- CLA
- JMP I MERPCH
-ZERO, 0
- EPRINT, 0
- DCA T2
-EPRLUP, TAD I T2
- RTR
- RTR
- RTR
- JMS EPR
- TAD I T2
- JMS EPR
- ISZ T2
- JMP EPRLUP
-
-EPR, 0
- AND (77
- SNA
- JMP I EPRINT
- TAD (240
- AND (77
- TAD (240
- JMS MERPCH
- JMP I EPR
- PAGE
- *3200 /LOADS INTO 1600
-
-MERRXR, TEXT \MONITOR ERROR 0 AT \
- MERTYP=MERRXR+7
-
-UERRXR, TEXT \USER ERROR 0 AT \
- UERTYP=UERRXR+5
-
-EXPLTBL,MON1-1400
- MON2-1400
- MON3-1400
- MON4-1400
- MON5-1400
- MON6-1400
- MON7-1400
-
-MON1, TEXT \CLOSE ERROR\
-MON2, TEXT \DIRECTORY I/O ERROR\
- MON3, TEXT \DEVICE HANDLER NOT IN CORE\
-MON4, TEXT \ILLEGAL USR CALL\
-MON5, TEXT \I/O ERROR ON SYS:\
-MON6, TEXT \DIRECTORY OVERFLOW\
-MON7, TEXT \RESERVED\
- /EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
- *3400 /EXECUTES IN FIELD 0 IN PAGE 7400
-MCHNX, DCA MCHREC /STORE STARTING RECORD #
- TAD MCHREC
- DCA I (SOFSET /V3D SAVE STARTING ADDRESS
- CIF 10
- JMS I (200
- 13 /RESET ALL DEVICE ASSIGNMENTS
- 0 /BUT DON'T CLEAR OUTPUT FILES
- CIF 10
- JMS I (200
- 11 /KICK MONITOR OUT AND RESTORE CORE IF NECESSARY
- JMS MCHRD /PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200
- TAD I (7200 /TEST FOR SAVE FILE!
- CMA /TEST FOR VALID CCB
- AND (7740
- SZA CLA
- JMP CHERR
- TAD I (7201
- DCA I (MSTCDF /TRANSFER INFORMATION FROM CONTROL BLOCK
- CLA IAC
- TAD I (7202
- DCA I (MSTADR /TO PAGE 7600
- TAD I (7203
- TAD (1000
- DCA I (JSBITS
- TAD (7204
- DCA MCHT1
- TAD MCHFJM
- DCA I (MSWITC
- TAD (TCF
- DCA I (MSTCDF+1
-MCHN1, ISZ I (7200
- JMP MCHN2
- TAD I MCHT1
- DCA I (MREAD+2
- ISZ MCHT1
- TAD I MCHT1
- DCA I (MREAD+1
- TAD MCHREC
- DCA I (MREAD+3
- TAD (SHNDLR
- DCA I (MREAD-1
- JMP I (MREAD
-MCHN2, TAD I MCHT1
- DCA MCHADR /SET UP COMMAND TO READ NEXT SEGMENT
- ISZ MCHT1
- TAD I MCHT1
- DCA MCHCTL
- JMS MCHRD /READ IT
- ISZ MCHT1
- JMP MCHN1 /LOOP ON NUMBER OF SEGMENTS
- MCHRD, 0
- JMS I (SHNDLR
-MCHCTL, 0101 /1 RECORD INTO FIELD 0 STARTING FORWARDS
-MCHADR, 7200
-MCHREC, 0
- JMP CHERR /CHAIN ERROR
- TAD MCHCTL
-MCHBMP, CLL RTR
- RTR
- RTR
- AND (37
- SNA /V3C
- TAD (40 /0 MEANS FULL 4K READ
- IAC
- CLL RAR
- TAD MCHREC
- DCA MCHREC
- JMP I MCHRD
-MCHT1, 0
-MCHFJM, MSTCDF&177+5200 /"JMP MSTCDF"
-
-CHERR, ISZ CHERR1
- JMP CHERR /LET TTY DIE DOWN
- ISZ CHERR2
- JMP CHERR
-CHTADC, TAD CHARS
- SNA
- JMP I (7600 /DONE..BACK TO MONITOR
- TLS
- TSF
- JMP .-1
- CLA
- ISZ CHTADC /NEXT LETTER
- JMP CHTADC
- CHERR1, 0
-CHERR2, -6
-CHARS, "C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
- PAGE
- *3600
- RELOC 1400
-SAVXX, TAD I SXFLE /STORES SFILE
- DCA SWFILE
- JMS I PHNDL /LOAD IN NON SYS HANDLER
- JMS SWRITE /WRITE OUT CCB
- TAD MERTST /MINUS THE # OF SEGS OF LT32K CODE
- DCA I [600
- TAD LXR /# OF BLOCKS OF GT 32K SEGS
- SNA /LXR IS ZERO IF ALL SEGS ARE ABOVE 32K
- JMP OVR32
- TAD I SXFLE /LXR--- COMPENSATES FOR CCB
- DCA SWFILE
-SAVE4, TAD I XR
- DCA SADR
- CLA CLL CML RAR
- TAD I XR
- DCA SCTL
-SAVE5, TAD SADR
- RAL
- SZL SPA CLA /DOES THIS SEGMENT START BELOW 2000?
- JMP SAVE8 /NO - NOTHING TO WORRY ABOUT
- TAD SCTL
- AND T76
- SZA CLA /FIELD 0?
- JMP SAVE8 /NO - SAVE AS IS
-SAVE6, JMS LOADF0 /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR
-SAVE7, CLA CMA
- TAD SCTL
- CLL RAL
- TAD SADR
- RAL
- SZL SPA CLA /CHECK WHETHER UPPER LIMIT IS ABOVE 2000
- JMP SAVE7A /IT IS - MUST MAKE 2 WRITES
- TAD SCTL /TOTALLY CONTAINED IN 0-1777
- TAD [10 /CHANGE FIELD 0 TO FIELD 1 AND CONTINUE
- JMP SAVE8A
-SAVE7A, TAD SCTL /WRITE IN 2 PARTS -
- DCA TM1
- TAD SADR
- CIA /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000
- TAD [2020
- CLL CML RAR
- DCA SCTL
- JMS SWRITE
- CLA CLL CML RTR
- DCA SADR
- TAD SCTL /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000
- AND [3700
- CIA
- TAD TM1
- SMA /FULL FIELD SAVE IN F0 MAKES THIS +
- TAD [4000 /COMPENSATE FOR THAT CASE
-SAVE8A, DCA SCTL
-SAVE8, JMS SWRITE
- ISZ I [600
- JMP SAVE4
- STA /LXR BECOMES ONE BECAUSE OF CCB
-
- TAD LXR /NUMBER OF BLOCKS OF GT32K SEGS
- SNA CLA
- JMP I [SAVE12
-OVR32, TAD I SXFLE /RESET FILE TO INITIAL BLOCK
- IAC /COMPENSATE FOR CCB
- DCA SWFILE
- TAD [603 /RESET CCB POINTER
- DCA ADR1
- TAD [7000
- LXM
-SAVE4B, TAD I ADR1 /IDENTICAL TO SAVE4 CODE
- DCA SADR
- CLA CLL CML RAR
- TAD I ADR1
- DCA SCTL
- DCA ADR2 /SET UP TO MOVE GREATER THAN 32K CODE DOWN
- DCA X1 /DITTO
- DCA SXFLE /INTIALIZE FOR COUNTER
- TAD SCTL /SET UP CDF FOR MOVE
- AND T76 /ISOLATE BANK AND FIELD
- CLL RTR /ADJUST MENT
- SZL
- TAD T20
- CLL RTL
- TAD FDC0
- DCA .+1
-XFSP, 0 /START OF MOVE LOOP
- TAD I ADR2
- CDF 70 /PUT THEM IN FIELD SEVEN
- DCA I X1 /IT SEEMS LIKE A GOOD FIELD
- ISZ SXFLE
- JMP .-5
-FDC0, CDF 0 /LOOP IS OFFICIALLY OVER
- TAD SCTL /ADJUST SWRITE CONTROL WORD
- AND [7700
- TAD [70 /TO FIELD SEVEN
- DCA SCTL
- JMS SWRITE
- ISZ EXTMP /IS THAT ALL THE SEGMENTS??
- JMP SAVE4B /NO ---CONTINUE
- JMP I [SAVE12 /TIME TO EXIT
-LOADF0, 0
- /ISZ F0OVLY /HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE?
- /JMP I LOADF0 /EVIDENTLY
- JMS I [SHNDLR
- 1010
-F0OVLY, 0 /WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE
- MTEMP+4
- JMP KMONER
- JMP I LOADF0
-
-SWRITE, 0
- JMS I DEVHND
-SCTL, 4101
-SADR, 600
-SWFILE, 0
- JMP KMONER
- TAD SCTL
- CLL RTR
- RTR
- RTR
- AND RO37
- SNA
- TAD RO37
- IAC
- CLL RAR
- TAD SWFILE
- DCA SWFILE /BUMP RECORD NUMBER
- JMP I SWRITE
-RO37, 37
-T76, 76
-T20, 20
-PHNDL, HNDL
-SXFLE, SFILE&177+400
- RELOC
- PAGE
-
- *4000 /SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
- WRITE=JMS I SYSHND
- JMS SYSSWP /SWAP SYSTEM DEVICE HANDLER INTO 7600
-
- WRITE; 4200; 7400; 0; JMP BERR /BOOTSTRAP
- TAD RBFLAG
- SZA CLA
- JMP .+6
- WRITE; 4210; DCOUNT; 01; JMP BERR /DIRECTORY
- WRITE; 5001; 0000; 07; JMP BERR /KEYBOARD MONITOR
- WRITE; 4610; 0000; MONTOR; JMP BERR /USR
- WRITE; 4111; 3400; MEOVLY; JMP BERR /"ENTER" OVERLAY
- WRITE; 4701; 2000; MSOVLY; JMP BERR /SAVE OVERLAY,
- /ERROR ROUTINE AND "CHAIN"
- TAD RBFLAG
- SZA CLA
- JMP .+13
- WRITE; 4101; LDRCTL; MFREE; JMP BERR /ABSLDR CONTROL BLOCK
- WRITE; 5010; 2000;MFREE+1; JMP BERR /ABSLDR
- JMS I (4200 /OUTPUT THE DEVICE HANDLERS
- JMP BERR
- JMS SYSSWP /SWAP BACK PAGE 7600
- CLA CMA
- HLT
- CLA
- JMP I .+1
-BERR, 7600
- JMS SYSSWP
- HLT
- JMP .-1
-W6600, 6600
-W7600, 7600
-SYSSWP, 0
- TAD W6600
- DCA SYTM1
- TAD W7600
- DCA SYTM2
-SWAPLP, TAD I SYTM1
- DCA TMSY
- TAD I SYTM2
- DCA I SYTM1
- TAD TMSY
- DCA I SYTM2
- ISZ SYTM1
- ISZ SYTM2
- JMP SWAPLP
- JMP I SYSSWP
-
- /CONTROL BLOCK FOR ABSOLUTE LOADER
-LDRCTL, 7777 /ONE CONTIGUOUS LOAD
- 6213 /STARTING ADDRESS IN FIELD 1
- 2000 /STARTING LOCATION=12000
- 6003 /DOES NOT LOAD OVER EITHER MONITOR AREA
- /ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE
- /ONLY FOR FIRST CALL TO COMMAND DECODER
- 2000 /FIRST(AND ONLY) SEGMENT STARTS AT 2000
- 1210 /IN FIELD 1 AND IS 10 PAGES LONG
-
- IFNZRO LDRCTL-4113 <BLDER,XQX>
-
-SYTM1, 0
-SYTM2, 0
-TMSY, 0
-SYSHND, 7607
- PAGE
-
- *4264
- RELOC 664
-
-MERGEX, CDF 10
- TAD MERTST
- SZA CLA
- JMP MOVEC
- TAD [1603 /LOADS INTO 600--MERGED--CODE
- DCA LXR
- TAD [1603
- DCA X1
- TAD I [1603
- AND T1777
- TAD T6000
- DCA I [1603 /INITIALIZE STATUS BITS TO NO OVERLOADS
- TAD I [1600
- DCA TEMP1
-MERGLP, TAD I LXR
- AND TX37
- CLL RTR /TRANSFORM 'ABCDE' TO 'CDEBA0'
- RTR
- SZL /TEST FOR 'B' BANK
- TAD [400
- CLL RAR
- SZL /TEST FOR 'A' BANK
- TAD [100
- CLL RTR
- RTR
- RAR
- DCA TEMP2
- TAD I LXR
- AND [7400
- DCA TMP1
- TAD TMP1
- DCA I X1 /STORE ADDRESS
- TAD TMP1
- CIA
- TAD I LXR /FORM UPPER LIM - LOWER LIM
- CLL RAR
- TAD TEMP2 /ADD IN FIELD
- DCA I X1
- TAD TMP1
- CLL RAL
- SZL SPA CLA /IS THE LOWER LIMIT < 2000?
- JMP NXTSEG /NO
- TAD TEMP2
- RAR
- SZA CLA /YES- IS THE FIELD 0 OR 1?
- JMP NXTSEG /NO
- SNL
- IAC
- CMA CML RTR
- AND I [1603 /AND OUT THE PROPER OVERLOAD BIT
- DCA I [1603
-NXTSEG, ISZ TEMP1
- JMP MERGLP
- TAD I T1605 /TEST FIRST SEGMENT FOR GREATER THAN 32K
- AND [7
- SNA CLA /IF GREATER THAN 32K SET
- JMP MOVEC
- TAD I [1600 /THE 4000 BIT OF THE FIRST WORD OF THE CCB TO ZERO
- RAL
- CLL RAR
- DCA I [1600
- /REMOVED LXM PUT IT IN MOVE UP CODE
-MOVEC, TAD T1577
- DCA LXR
- TAD T577
- DCA X1
- TAD [7600
- DCA TEMP1
- DCA MERTST /SET MOVE I.D. TO ZERO
- JMP I MVECB /RETURN TIME
-MVECB, CBMOVE&177+400
-T1605, 1605
-T1777, 1777
-T6000, 6000
-T1577, 1577
-T577, 577
-TX37, 37
- RELOC
- PAGE
-
- *7400
- NOPUNCH
- *7600
- ENPUNCH
- /UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES
- /LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION
-
-MOFILE, ZBLOCK 17 /OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX)
- /5 WORDS PER ENTRY - DEVICE # AND FILE NAME
-MIFILE, ZBLOCK 24 /INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX)
- /2 WORDS PER ENTRY - DEVICE # AND RECORD #
-
- /LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR
- /(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER
- /PART OF NUMERICAL ARGUMENT
-
-MPARAM, ZBLOCK 4 /PARAMETER TABLE - 7643-7646
- /FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9).
- /FOURTH WORD - CONTAINS THE LOW ORDER BITS OF
- /THE NUMERICAL ARGUMENT
-
-
-
- /TABLE OF DEVICE HANDLERS PRESENTLY IN CORE
-DVHNDL, 7607;7607;0;0;0;0;0
- 0;0;0;0;0;0;0;0
-MDATE, 0 /HOLDS THE CURRENT DATE- 4 BIT MONTH,
- /5 BIT DAY, 3 BIT YEAR FROM 1970
-MGET, CIF 0
- JMS SHNDLR /INST FIELD IS 0
- 1000 /READ 4 RECORDS INTO FIELD 0
- 0 /LOCATIONS 0-1777
- 7 /KEYBOARD MONITOR FOLLOWS DIRECTORY
-PJSBTS, JSBITS /SERVES AS A HALT (WATCH IT!)
-SCDCIF, CDF CIF 0
- JMP I .+1
- KMNTRY /V3D GETS CHANGED TO INIT
- MCALL1, 0
- DCA MARG1 /SAVE AC AS IT MAY CONTAIN AN ARGUMENT
- RDF /GET CALLING FIELD
- TAD SCDCIF
- DCA SMCIF
- CDF 0
- TAD I PJSBTS
- RAR
- CDF 10
- SZL CLA /DOES JOB USE LOCS 10000-11777?
- JMP MONRD /NO - DONT SAVE THEM
- CIF 0
- JMS SHNDLR
- 5010
- 0
- MTEMP
- HLT
-MONRD, CIF 0
- JMS SHNDLR
- 610
- 0
- MONTOR
-SCOPE, HLT /BIT 4 IS A 1 IF CONSOLE IS A SCOPE
- JMP MSTART /START THE MONITOR UP IN PAGE 0
-MRETRN, CIF 0
- JMS SHNDLR
- 1010 /READ 10 RECS INTO FIELD 1
- 0
- MTEMP /TEMP REGION ON SYS
- HLT /SYS HAS PROBLEMS
-SMCIF, 0
- JMP I MCALL1
- MARG1, 0
- /TABLE OF USER DEVICE NAMES
- /ALSO USED BY SYSTEM ODT
-
-UDNAME, 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
- DCB, ZBLOCK 17 /DEVICE CONTROL BLOCK - SET IN "CONFIG"
-
-
-
-
-
-
-
-
-
- /********************************************************
- / MAP OF SYSTEM DEVICE AS OF 2/21/73
- /********************************************************
- / * 256 WORD RECORDS *
- /********************************************************
-
- / RECORDS CONTENTS
- / ------- --------
-
- / 0 MONITOR BOOTSTRAP
- / 1- 6 SYSTEM DIRECTORIES
- / 7-12 KEYBOARD MONITOR
- / 13-15 I/O MONITOR(CALLABLE MONITOR)
- / 16-25 DEVICE HANDLER RECORDS
- / 26 MONITOR "ENTER" OVERLAY
- / 27-50 MONITOR SCRATCH AREA FOR SAVING CORE
- / 51-53 COMMAND DECODER
- / 54-55 "SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
- / 56 MONITOR ERROR ROUTINE
- / 57 "CHAIN" PROCESSOR
- / 60-63 SYSTEM ODT
- / 64 RESERVED FOR EXPANSION
- /65 CCL REMINISCENSES
- / 66 USED BY TWO-PAGE SYS HANDLER
- / 67 USED BY CCL (CCL OVERLAY)
- / 70-END FILE STORAGE
- SHNDLR=7607 /ENTRY POINT TO SYSTEMS HANDLER
-
- *6600
- NOPUNCH
- *7600
- ENPUNCH
-
- /SYSTEM HANDLER AND FIELD 0 UPPER PAGE
- /INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE
- DVHORG=16 /DEVICE HANDLER RECORDS
- MTEMP=27
- MONTOR=13
- JMS SHNDLR
- 5000 /SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0
- 0 /(LOCATIONS 0-1777)
- MTEMP+4
- 7602 /TROUBLE WITH SYSTEM DEVICE
- CDF CIF 10
- JMP MGET /NOW GO READ IN THE KEYBOARD MONITOR
- *6744 /INFORMATION ABOUT CURRENT JOB
- NOPUNCH
- *7744
- ENPUNCH
-JFIELD, 6203 /A CDF CIF N INSTRUCTION TO START THE JOB
-JSTART, 7600 /THE STARTING ADDRESS
-JSBITS, 1000 /VARIOUS STATUS BITS - USED FOR OPTIMIZATION
- /BIT 4000 - JOB DID NOT LOAD INTO 00000-01777
- /BIT 2000 - JOB DID NOT LOAD INTO 10000-11777
- /BIT 1000 - JOB IS NOT RESTARTABLE
- /BIT 400 - DOESN'T DESTROY BATCH MONITOR
- /BIT 2 - JOB DOES NOT USE LOCS 00000-01777
- /BIT 1 - JOB DOES NOT USE LOCS 10000-11777
-SOFSET, 0 /FOR FUTURE(AND MAYBE PRESENT) USE
-
- /DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP
- 7750
- 7751
- 7752
- 7753
- 7754
- 7755
- /MONITOR PATCH TO HELP BLEEP LOADER
- 0 /ADDRESS OF HANDLER FOR DEVICE USED
-MREAD, HLT
- 0
- 0
- 0
- HLT
-MSWITC, JMP .+6 /ZEROED IF PG 7000 (HANDLER) MUST BE READ OVER
- JMS SHNDLR
- 0300
- 7000 /THIS AREA MODIFIED BY ODT
- MTEMP+6
-OS78, HLT /BIT 4 IS A 1 IF OS/78 IS RUNNING
-MSTCDF, CDF CIF 0
- TCF /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
- JMP I .+1
-MSTADR, 0
-SBLOCK, 0
-BIPCCL, 0 /MORE STATUS BITS.
- /BIT 1: 1=> BATCH IS IN PROGRESS
- /BITS 6-8: FIELD OF BATCH MONITOR
- /HIGHEST CORE FIELD USED BY OS/8
- /OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
- *0
- VERSNO /OS/8 VERSION NUMBER
- CIF 30
- JMP .-1 /HIGROUND SUPPORT
-KMONER, CLA
- TAD [7605
- DCA ERRET
- JMS I [PRMESG
- TEXT /?ERROR/
-
-/THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER
-/THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD!
-
-LXR, PMSRST-1
-X1, MSWITC /THESE TWO ARE USED AT INITIALIZATION.
-ADR1, RUN8-1
-ADR2, RUN8&177+7377 /USED DURING R, AND RUN COMMANDS
-XR,
-AMFLAG, 0 /1 MEANS SAW ALTMODE
- /MUST NOT MOVE FOR CCL AND BATCH
-
- *20
-RBFLAG, 0 /MUST BE AT LOCATION 20
-TEMP2, -7
-SYSTEM, 7700
-PCH, PRINT
-GLINE, XGLINE
-GNAME, GETNAM
-DEVHND, 7607
-FUDJMP, MSTCDF&177+5200
-P6203, 6203
-TMP, PATCHLEV /MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL
-PGTOUT, GETOUT
-ERRET, PCRLF /MUST BE AT 33 FOR CCL
-
-/THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW
-/VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS
-/READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ.
-
-NM1, 203 /THIS MUST BE A 203!
-BATCH, /ENTRY TO READ NEW BATCH MONITOR
-NM2, JMS I [7607 /THE BATCH INITIALIZER ALTERS SOME VALUES
-NM3, 610 /IN THIS LIST...THIS ONE**********
-NM4, 0 /THIS ONE*****GETS ADDRESS OF BOS.
-TEMP1, 13 /******GETS RECORD OF BOS*****
-TM1, SKP CLA /ERROR. DON'T RUN BATCH
-TMP1, JMP BCHGO
-NMCT, DCA I KM1 /CLEAR BATCH FLAG.
-PN, JMP KMONER
-PRDSW,
-KM1, 7777
-BCHGO,
-RUNSW, CIF CDF 0
-DIGFLG, JMP I .+1
-SENTER, KMINIT /GETS ENTRY POINT (BOS)
-KRCHK, RCHK
-EXTMP, 0
-MERTST, 0
-SPTST, -1 /-1 USED IN RUN CODE
- FIELD 1
- /FIELD 1
- /OS/8 MONITOR - MONITOR ROUTINES
- /THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1
- /IT REPLACES CORE FROM 200-1777
- /AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION
- /MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC.
- MAXCMD=13
- *200
-MONITO, 0 /MONITOR SUBROUTINE
- DCA MACARG /STORE AC ARG
- DCA USERFG /SET FLAG TO INDICATE WE WERE CALLED DIRECTLY
- RDF /GET CALLING FIELD
- TAD [CDF CIF 0
- DCA FGETX
-MRENTR, TAD FGETX
- DCA FPUTX /FOR LOADING AND STORING CALLING SEQUENCE
- JMS FGET /GET FIRST ARGUMENT[AND SET DATA FIELD 1)
- ISZ MONITO
- CLL
- TAD [-MAXCMD-1
- SZL
- JMP MERROR
- TAD JMPMAX
- DCA .+1 /BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
-FGET, 0 /MUST PRESERVE LINK
- TAD MONITO
- JMS FGETW
- JMP I FGET
-/MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT'
- MERROR
- MASSIGN
- MLOOKUP
- MENTER
- MCLOSE
- MCD
- MCHAIN
- MERR
- MESCAP
- MESCPR
- MASGN
-MRSETP, MRESET
-FPUT, 0 /MUST FOLLOW LAST ADDRESS IN JUMP TABLE
-FPUTX, 0
- DCA I MONITO
- CDF CIF 10
-JMPMAX, JMP I FPUT
-MEOERR, ISZ MERRNO
-MIOERR, ISZ MERRNO
-MERROR, ISZ MERRNO
- ISZ MERRNO
- ISZ MERRNO
- ISZ MERRNO
-MERR, CLA
- CIF 0
- JMS I [SHNDLR
- 0210
- 1400
- MERRTN
- HLT
- JMP I .-3
-
-
-MCD, CLA CLL CML RAR
- JMS CDSWAP /SWAP OUT CORE IF NECESSARY
- JMS FGET
- DCA T1
- CIF 0
- JMS I [SHNDLR
- 0601
- 0
- MCDREC
- JMP MIOERR
- TAD FPUTX
- CDF CIF 0
- JMS I [200
- DCA FPUTX
- TAD FPUTX
- DCA FGETX
- JMS CDSWAP /RESTORE THE SWAPPED CORE IF NECESSARY
- STL /LINK MUST BE ON AT MRESET
- JMP I MRSETP /AFTER CD, RESET DEVICE AREA
-MCHAIN, JMS FGET
- DCA T1 /BUFFER THE ARGUMENT
- CIF 0
- JMS I [SHNDLR
- 0101
- 7400
- MRUNRC
- JMP MIOERR
- TAD T1 /LOAD THE BUFFERED ARGUMENT
- CDF CIF 0
- JMP I .-5
-MLNOTF, CLA
- ISZ MONITO
-MNEXT, TAD USERFG
-MESCAP, CLL RAR
- TAD MONITO
- DCA I [7700
- TAD FPUTX
- DCA I [SMCIF
- CLA IAC CML
- CDF 0
- AND I [JSBITS
- CDF 10
- RAR
- SZL SPA CLA /RESTORE CORE IF USERFG=1 AND JSW[11]=0
- JMP I [SMCIF
- JMP I [MRETRN
-MESCPR, CLL CML
- JMP MESCAP+1
-FGETW, 0
- DCA FPUT
-FGETX, HLT
- TAD I FPUT
- CDF CIF 10
- JMP I FGETW
- CDSWAP, 0
- TAD ME1000 /FORM READ OR WRITE OPERATION
- DCA MCDCTL
- CDF 0
- TAD I [JSBITS
- CDF 10
- RTR
- SZL CLA /IS IT NECESSARY TO SAVE CORE?
- JMP I CDSWAP /NO
- CIF 0
- JMS I [SHNDLR
-MCDCTL, 0
- 0
- MTEMP+4
- JMP MIOERR
- JMP I CDSWAP
-
-EOVFLO, CIF 0
- JMS I [SHNDLR
- 0111
-ME1000, 1000 /ENTER OVERLAY LOADS OVER ENTER (NATCH)
- MEOVLY
- JMP MIOERR
- JMP I ME1000
-
-
- *400
- /ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER
- /(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY)
- /AND ADJUST TABLES(IF NECESSARY). IS THIS REALLY NECESSARY?
-MASGN, CLA IAC
-MASSIGN, DCA ASFLAG
- TAD MACARG
- SZA /IS DEVICE NUMERIC OR SYMBOLIC?
- JMP DFOUND /NUMERIC
- JMS I [FGET /GET HIGH ORDER 2 CHARS OF NAME
- ISZ I [MONITO
- SNA
- JMP I [MRTRN+1 /FIRST WORD OF NAME MUST BE NON-ZERO
- DCA NAME
- JMS I [FGET
- SNA /IS NAME >2 CHARACTERS LONG?
- JMP NOHASH /NO - DON'T HASH
- TAD NAME
- RAL
- CLL CML RAR /FORCE SIGN BIT OF HASH NAME ON
- DCA NAME
-NOHASH, TAD [UDNAME-1 /SEARCH USER NAME TABLE FIRST
-DSRCH, DCA XR
- TAD [-17
- DCA T2
-DSRCLP, TAD I XR
- CIA
- TAD NAME
- SNA CLA
- JMP DSFND
- ISZ T2
- JMP DSRCLP
- TAD XR
- SMA CLA /WHICH TABLE DID WE JUST SEARCH?
- JMP I [MRTRN+1 /SYSTEM TABLE - ERROR
- TAD [SDNAME-1
- JMP DSRCH /GO SEARCH SYSTEM TABLE
-DSFND, TAD T2
- TAD [20
- JMS I [FPUT /PUT NUMBER INTO CALLING SEQUENCE
- JMS I [FGET /GET IT BACK IN AC, BUMPING POINTER
- ISZ I [MONITO
-DFOUND, JMS I [MCKDEV /DETERMINE ITS VALIDITY (NON-ZERONESS)
- /AND FORM POINTERS
- SNA /IS THE DEVICE HANDLER IN CORE?
- TAD I T2
- SNA /DOES A HANDLER EXIST FOR THE DEVICE?
- JMP I [MLNOTF /NO - SAME AS THE DEVICE NOT EXISTING
- CMA RAL /GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK
- SNL CLA /TWO PAGE HANDLER?(IF HANDLER IS IN CORE,
- /THIS TEST IS RANDOM BUT WE DON'T CARE)
- TAD [100 /YES - FORCE A TWO-PAGE READ
- TAD [100
- DCA DVHCTL
- TAD T1
- DCA T7 /SAVE T1 AS WE WILL DESTROY IT LATER
- TAD I T1
- TAD ASFLAG
- SZA CLA /DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING?
- JMP AFINIS /NO - HE MUST HAVE TASTE.
- JMS I [FGET /FETCH PAGE IN WHICH HANDLER IS TO BE LOADED
- RAR /GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE
- /PUT THE "TWO PAGE HANDLER" FLAG INTO IT
- SNL SMA /IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE?
- JMP I [MLNOTF /NO - GIVE AN ERROR RETURN
- RAL /YES - ROTATE BACK
- AND [7600 /MAKE IT LEGAL
- DCA DVHLOC
- JMS GETREC
- DCA DVHREC
- CIF 0
- JMS I [SHNDLR
-DVHCTL, 0 /READ ONE OR TWO PAGES INTO FIELD 0
-DVHLOC, 0
-DVHREC, 0
- JMP I [MIOERR /SYSTEM DEVICE ERROR
- /NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS
- TAD [-17 /AND MARK OFF THOSE WHICH ARE NOW IN CORE
- DCA T4
-DVHCLP, TAD T4
- JMS I [MCKDEV /LOW ORDER BITS OF T4 GO THROUGH 1-17
- CMA
- TAD DVHLOC
- CLL CML RAR
- TAD DVHCTL /IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE
- SMA CLA /LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER)
- DCA I T1 /MARK IT AS WIPED
- JMS GETREC
- CIA
- TAD DVHREC
- SZA CLA
- JMP NOTINC
- TAD I T2
- AND [177
- TAD DVHLOC
- DCA I T1
-NOTINC, ISZ T4
- JMP DVHCLP
-AFINIS, TAD I T7
- JMP I [MRTRN /STORE HANDLER ADDRESS AND EXIT
- GETREC, 0
- TAD I T2 /GET RECORD OF DEVICE HANDLER
- CLL RTL
- RTL
- RTL /EXTRACT THE RECORD NUMBER
- AND [17
- TAD [DVHORG-1 /ADD THE BASE OF DEVICE HANDLER STORAGE
- JMP I GETREC
-
-MCKDEV, 0 /MUST PRESERVE LINK
- AND [17
- SNA
- JMP I [MERROR /DEVICE 0 IS ILLEGAL
- DCA NAME
- TAD NAME
- TAD [SDVHND-1 /FORM POINTER INTO HANDLER IMAGE TABLE
- DCA T2
- TAD NAME
- TAD [DVHNDL-1
- DCA T1
- TAD NAME
- TAD [DCB-1
- DCA T8 /FORM POINTER TO DCB ENTRY FOR DEVICE
- TAD I T1
- JMP I MCKDEV
-
- IFNZRO .-564 <REASSEMBLE CONFIG>
-SDNAME, ZBLOCK 17 /SYSTEM DNAME TABLE - SET UP BY "CONFIG"
-
-
- IFZERO .+200&1000 <*600>
- /LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE
- /ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE
- /IS NOT FILE ORIENTED
-MLOOKUP,CLL /SET RDCAT MODE TO INPUT
- JMS MRDCAT
- JMP ERETRN /NON-FILE STRUCTURED DEVICE
- JMS MDSRCH /SEARCH THE DIRECTORY FOR THE FILE
- JMP MRTRN+1 /NOT FOUND - TAKE ERROR RETURN
-LRETRN, TAD T5
- CIA
- TAD I [DORG /CONVERT T5 TO A RECORD NUMBER
-ERETRN, JMS I [FPUT
- ISZ I [MONITO
- TAD T6
- CIA /STORE FILE LENGTH AS A NEGATIVE NUMBER
-MRTRN, JMS I [FPUT /THIS CODE IS JUMPED TO BY SEVERAL ROUTINES
-MRTRN2, ISZ I [MONITO
- JMP I [MLNOTF
-
-MRDCAT, 0
- SZA
- JMP MRDREN /NOT THE FIRST SEGMENT - DON'T SET UP POINTERS
- DCA T5 /ZERO STARTING BLOCK NUMBER
- DCA T6 /ZERO FILE LENGTH
- TAD MACARG /GET DEVICE NUMBER FROM AC
- JMS I [MCKDEV /CHECK LEGALITY AND FORM POINTERS
- SNA
- JMP I [MERROR+1 /DEVICE HANDLER IS NOT IN CORE - ERROR
- DCA T9 /ADDRESS OF DEVICE HANDLER
- JMS I [FGET
- DCA T4 /STORE THE POINTER TO THE FILE NAME IN T4
- SNL
- CML RAR
- RTR /FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK
- AND I T8
- SZA CLA /TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0)
- JMP MRTRN+1 /FAILED THE TEST - ERROR RETURN
- TAD I T8
- SMA CLA
- JMP I MRDCAT /DEVICE IS NOT FILE-ORIENTED
- ISZ MRDCAT
- CLA IAC
-MRDREN, DCA MCATRC /STORE SEGMENT NUMBER
- TAD T9 /USE LOW ORDER BITS
- AND [177 /OF DEVICE HANDLER ENTRY POINT
- CLL RTL /AND THE REQUESTED SEGMENT NUMBER
- RAL /TO FORM A "UNIQUE" KEY
- TAD MCATRC /FOR THIS SEGMENT OF THIS DIRECTORY
- /(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT
- /STARTING OFFSET IN ITS PAGE)
- CIA
- TAD OLDT9 /COMPARE KEY AGAINST KEY OF CURRENT SEGMENT
- SNA /ARE THEY THE SAME?
- JMP INLRDY /YES - DON'T READ SEGMENT, ITS IN CORE
- CIA
- TAD OLDT9
- DCA OLDT9 /STORE THE KEY OF THE NEW IN-CORE SEGMENT
- CLA CLL CML RAR /CHANGE WRITE TO READ
- JMS MWRCAT
-INLRDY, TAD I [DCOUNT
- CML CMA RAL
- SZL SPA
- JMP JMPME2
- CMA CML RAR /NEW V3 DIRECTORY VERIFYER
- DCA NFILES /FIRST WORD IN CATALOG = -# OF FILES IN CATALOG
- TAD [DPROPR-1
- DCA XR /SET XR TO POINT TO FIRST FILE ENTRY
- JMP I MRDCAT /RETURN TO BUMPED ADDRESS
-MDSRCH, 0
-FSRCLP, TAD I XR
- SNA CLA /EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY
- JMP SKPMTF /SO SKIP THE 4 WORD COMPARE ON THEM
- CLA CMA
- TAD XR
- DCA XR
- TAD [-4
- DCA T6
- TAD T4
- DCA T7
-SRCWDL, TAD T7
- JMS I [FGETW
- CIA
- TAD I XR
- SZA CLA /COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS)
- JMP NXTFIL
- ISZ T7
- ISZ T6
- JMP SRCWDL
- JMS BUMPXR /SKIP GARBAGE WORDS
- TAD I XR
- SNA
- JMP SKPMTF+1 /UNCLOSED OUTPUT FILES DONT COUNT
- CIA
- DCA T6 /STORE FILE LENGTH
- ISZ MDSRCH
- JMP I MDSRCH
-NXTFIL, TAD T6
- IAC
- JMS BUMPXR /SKIP REST OF NAME AND GARBAGE WORDS
-SKPMTF, TAD I XR /GET LENGTH OF THIS ENTRY
- TAD T5
- DCA T5 /ADD TO BLOCK STARTING ADDRESS
- ISZ NFILES
- JMP FSRCLP
- DCA T5 /RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT
- TAD I [DLINK /DIRECTORY EXHAUSTED - ANY MORE?
- SZA
- JMP MRDREN
- JMP I MDSRCH
-
-BUMPXR, 0 /ROUTINE TO SKIP (DWASTE+AC) WORDS
-
- TAD I [DWASTE
- CIA /DWASTE IS NEGATIVE AND SO IS AC
- TAD XR
- DCA XR
- JMP I BUMPXR
-
-MWRCAT, 0
- TAD [4210
- DCA CATCTL
- CIF 0
- JMS I T9
-CATCTL, 4210 /WRITE 2 RECORDS FROM FIELD 1
- 1400
-MCATRC, 1
-JMPME2, JMP I [MERROR+2 /CANNOT REWRITE CATALOG
- JMP I MWRCAT
-
- IFNZRO .-772 <REASSEMBLE CONFIG> /USED TO BE 766
-SDVHND, ZBLOCK 17 /DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
-
-
- IFZERO 1000&. <*1000>
- /ENTER PROCESSOR FOR MONITOR
- /FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE
- /AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE
- /"CLOSE" PROCESSOR.
-MENTER, DCA EPASS /SET UP FOR PASS 1
- JMS I [MRDCAT /READ CATALOG AND SET UP NFILES AND XR
- JMP I [ERETRN /NON-FILE-STRUCTURED DEVICE
- JMS I [CONSOL
- DCA T2 /INTIIALIZE STARTING BLOCK NUMBER COUNTER
- TAD [DPROPR-1
- DCA XR /RESTORE XR (CONSOLIDATOR DESTROYED IT)
- TAD MACARG
- CLL RTR
- RTR
- AND [377 /GET REQUESTED LENGTH FROM AC BITS 0-7
- CIA
- DCA T3 /T3=REQUESTED LENGTH. IF T3=0, MEANS RETURN
- /LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN
- /SMALLEST BLOCK OF LENGTH =>T3.
- TAD I T8 /GET FCB ENTRY
- AND [7
- SZA CLA /ANY ACTIVE TENTATIVE FILES ON THIS DEVICE?
- JMP I [MRTRN+1 /YES - TAKE ERROR RETURN
-MELOOP, TAD I XR
- SNA CLA
- JMP MEMPTY /EMPTY SPACE - LOOK AT LENGTH
- MTHREE /OCCUPIED - IGNORE
- JMS I [BUMPXR
- TAD I XR
-MELEND, TAD T2
- DCA T2 /UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY
- ISZ NFILES
- JMP MELOOP /GO TO NEXT ENTRY
-
- /DIRECTORY BLOCK EXHAUSTED
- TAD EPASS
- SZA CLA /WHAT PASS ARE WE IN?
- JMP EFINUP /SECOND PASS - THIS IS FOR KEEPS
- TAD I [DLINK /FIRST PASS
- SZA /ANY MORE SEGMENTS?
- JMP I [MRDREN /YES - CONTINUE
-
-
- /DONE - SEE IF OUR BEST IS GOOD ENOUGH.
- TAD T4
- JMS I [FGETW
- SZA CLA /CHECK THAT FIRST WORD OF NAME IS NON-ZERO
- TAD T6
- SNA CLA /AND THAT WE FOUND WHAT WE WANTED
- JMP I [MRTRN2 /OTHERWISE GIVE ERROR RETURN
- TAD ASFLAG /GET NUMBER OF BEST SEGMENT
- ISZ EPASS /AND RESTART THE ALGORITHM IN PASS 2
- JMP I [MRDREN /(TAKES LESS SPACE THAN SAVING XR AND NAME)
-
- /EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION
-
-EFINUP, TAD XR
- DCA T1
- TAD [-4
- JMS I [BUMPXR
- TAD I [DWASTE
- CIA
- TAD XR /CATALOG MUST HAVE ROOM FOR ONE MORE FILE
- TAD [-1772 /AFTER THIS FILE IS ENTERED
- SMA CLA /WILL NEW ADDITION OVERFLOW CATALOG?
- JMP I [EOVFLO /YUP - CALL OVERLAY TO EXTEND DIRECTORY
-MELP2, TAD I T1 /MOVE REST OF CATALOG UP
- DCA I XR /TO CREATE SPACE FOR NEW ENTRY
- CLA CMA
- TAD T1
- DCA T1
- CLA CMA CLL RAL
- TAD XR
- DCA XR
- TAD T1
- CIA CLL CML
- TAD NAME
- SZA CLA /HAVE WE PUSHED UP EVERYTHING?
- JMP MELP2 /NO, KEEP PUSHING
- TAD [-4
- DCA T1 /NOW MOVE THE USERS FILE NAME
- TAD NAME
- DCA XR
- TAD T4
- JMS I [FGETW /[IN THE USERS FIELD, OF COURSE)
- DCA I XR
- ISZ T4
- ISZ T1 /INTO THE EMPTY SPACE JUST CREATED
- JMP .-5
- TAD I [MDATE /PUT DATE OF CREATION INTO FILE NAME
- DCA I XR /THIS WILL BE DESTROYED IF DWASTE=0
- IAC /ADJUST XR BUMP BECAUSE OF DATE STORE
- JMS I [BUMPXR
- DCA I XR /GIVE THE NEWLY ENTERED FILE A LENGTH OF 0
- TAD XR /PUT A POINTER TO THE LENGTH WORD OF THE
- DCA I [DFLAG /NEW ENTRY INTO THE DIRECTORY HEADER
- CLA CMA
- TAD I [DCOUNT
- DCA I [DCOUNT /INCREASE THE FILE COUNT BY 1
- TAD I T8
- TAD ASFLAG
- DCA I T8 /SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
- JMS I [MWRCAT /WRITE THE ALTERED CATALOG BACK OUT
- JMP I [LRETRN /STORE ARGS BACK JUST LIKE "LOOKUP"
- MEMPTY, TAD I XR
- CIA CLL
- DCA T1 /SAVE LENGTH OF CURRENT ENTRY
- TAD T3
- TAD T6
- CLA /LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH
- TAD T3
- SNA
- CML /IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM
- TAD T1
- CLA CML /LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN
- /BEST LENGTH AND CURRENT LENGTH
- TAD T1
- CIA
- TAD T6
- SZL SNA CLA /TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS,
- /DEPENDING ON WHETHER LINK IS ON OR OFF
- JMP MNOCHG /MIN(MAX)=BEST - NOTHING TO DO
- TAD T1
- DCA T6 /MAKE CURRENT ENTRY NEW "BEST"
- CLA CLL CMA RAL
- TAD XR
- DCA NAME /REMEMBER CATALOG LOCATION
- TAD I [MCATRC
- DCA ASFLAG /ALSO DIRECTORY SEGMENT NUMBER
- TAD T2
- DCA T5 /AND STARTING BLOCK NUMBER
-MNOCHG, TAD T1
- CIA
- JMP MELEND /GO UPDATE THE BLOCK NUMBER
-
-
- /CLOSE PROCESSOR - CLOSES AN OUTPUT FILE WHICH WAS OPENED
- /BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE
- /CLOSING LENGTH OF THE FILE. PERFORMS A DIRECTORY CLEANUP AFTER
- /CLOSING THE FILE. IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S
- /NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND
- /ONLY IF NO OUTPUT FILE WAS ENTERED). AN ERROR RETURN IS
- /GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER
- /AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE.
-
-MCLOSE, JMS I [MRDCAT /GET THE CATALOG
- JMP CRETRN /NON-FILE STRUCTURED DEVICE - RETURN NORMALLY
- CLA IAC /GET THE NEXT WORD IN THE CALLING SEQUENCE
- JMS I [FGET
- DCA T1 /GET CLOSING LENGTH AND STORE IT AWAY
- JMS I [MDSRCH /SEARCH FOR THE OLD COPY
- JMP NODLET /NO OLD COPY
- MTHREE
- TAD I [DWASTE
- JMS SQUISH /SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY
- DCA I XR2 /AND MAKE THE OTHER TWO INTO AN EMPTY
- TAD T6 /FILE ENTRY WITH THE SAME LENGTH
- CIA
- DCA I XR2 /AS THE OLD COPY
- TAD I T8
- AND [7
- SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE
- JMP EOCLOS /NO - FINISH UP AND GET OUT
- CIA /GET THE SEGMENT NUMBER WE WANT
- TAD I [MCATRC
- SNA CLA
- JMP .+3
- JMS CONSOL
- JMS I [MWRCAT /NO - WRITE OUT THE ONE WE SQUISHED
- TAD I [DFLAG /GET LOCATION OF TENTATIVE FILE
- CIA CLL
- TAD XR2
- SZL CLA /IS THE ENTRY TO BE CLOSED ABOVE THE ONE
- JMP .+3 /WE JUST DELETED?
- MTHREE /YES - MOVE THE POINTER DOWN
- TAD I [DWASTE /TO COMPENSATE FOR THE SQUISHING
- TAD I [DFLAG /THE POINTER WILL NOW POINT
- DCA I [DFLAG /TO THE LENGTH WORD.
- /(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE)
-
-NODLET, TAD I T8
- AND [7
- SNA /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE?
- JMP I [MRTRN+1 /WHAT DID HE CALL US FOR? - ERROR
- JMS I [MRDCAT /YES - READ IN THE CORRECT SEGMENT
- TAD I [DFLAG
- DCA T4 /T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY
- TAD T1
- CIA /IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY
- DCA I T4 /DURING CONSOLIDATION
- ISZ T4
- ISZ T4
- CLL CML
- TAD T1
- TAD I T4 /SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY
- SNL SZA
- JMP I [MERROR+3 /THIS CREEP HAS GONE AND DESTROYED HIS TAPE
- DCA I T4
-EOCLOS, JMS CONSOL /CONSOLIDATE THE DIRECTORY
- TAD [7770
- AND I T8
- DCA I T8
- SKP
-CRETRN, TAD [7600 /DO A WRITE OF 0 PAGES. (MAGTAPE)
- JMS I [MWRCAT
- ISZ I [MONITO
- JMP I [MRTRN2
- /CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM.
- /ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM.
-CONSOL, 0
- TAD [DPROPR-1
- DCA XR
- TAD I [DCOUNT
- DCA T7 /T7 = FILE COUNT
-CONLP, TAD I XR
- SNA CLA /EMPTY FILE?
- JMP CONMTF /YES - GO CHECK FOR NULL AND 2 IN A ROW
- MTHREE
- JMS I [BUMPXR /GET PAST THE GARBAGE WORDS
- TAD I XR /GET COUNT
- SZA CLA /WOULD THIS HAPPEN TO BE A NULL FILE?
- JMP CONLPT /NAH, GO TO NEXT ONE
- TAD [-5 /YEAH, REMOVE IT ENTIRELY
- TAD I [DWASTE /INCLUDING THE WASTE WORDS
-SQCOMN, JMS SQUISH
- ISZ I [DCOUNT /BUMP DOWN FILE COUNT IN DIRECTORY
- ISZ NFILES /AS WELL AS THE TEMPORARY ONE IN PAGE 0
- NOP /V3 RL INSISTS
- JMP CONSOL+1 /REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
- /HAVE BROUGHT TWO FREE ENTRIES TOGEHER
-/ THE ABOVE NOP FIXES THE KILLER CLOSE BUG
-CONLPT, ISZ T7
- JMP CONLP /MORE FILES - KEEP PLUGGING
- JMP I CONSOL /RETURN FROM CONSOLIDATOR
-CONMTF, TAD I XR /IS THIS FREE ENTRY NULL?
- SNA
- JMP SQTRIV /YES - SQUASHITLIKEABUG
- DCA T2 /NO - SAVE LENGTH
- TAD XR
- DCA SQUISH /SAVE POSITION OF LENGTH WORD
- ISZ T7 /WAS IT THE LAST FILE?
- SKP /NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!)
- JMP I CONSOL /YES - RETURN FROM CONSOLIDATOR
- TAD I XR
- SZA CLA /TWO EMPTIES IN A ROW?
- JMP CONLP+3 /NO - SLIP BACK INTO LOOP
- TAD I XR
- TAD T2 /YES - COMBINE LENGTHS
- DCA I SQUISH /STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
-SQTRIV, CLA CMA CLL RAL
- JMP SQCOMN /SQUISH OUT 2 WORDS
-
-
-MRESET, TAD [-17
- DCA T3
-MRSETL, TAD T3
- JMS I [MCKDEV
-/LINK MUST BE ON AT THIS POINT
- TAD [200
- SZL CLA /ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
- DCA I T1
- JMS I [FGET
- SZA CLA
- TAD [7
- CMA STL
- AND I T8
- DCA I T8 /DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
- ISZ T3
- JMP MRSETL
- JMP I [MNEXT
-
-/SUBR TO COLLAPSE DIRECTORY AFTER A POINT
-SQUISH, 0
- TAD XR
- DCA XR1
- CLA CLL CMA RAL
- TAD XR1
- DCA XR2 /SET UP XR2 FOR CHANGING SQUISHED ENTRY
-SQLOOP, TAD I XR
- DCA I XR1 /MOVE DOWN ONE WORD
- TAD XR
- TAD [-1777
- SZA CLA /AT END YET?
- JMP SQLOOP /NO, KEEP GOING
- JMP I SQUISH
- *1400
- /INITIAL DIRECTORY FOR MONITOR
- /DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)
-
-DCOUNT, -2 /TWO ENTRIES
-DORG, MFREE /FILE STORAGE STARTS AT BLOCK "MFREE"
-DLINK, 0 /THIS IS THE ONLY DIRECTORY RECORD
-DFLAG, 0 /THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE
-DWASTE, -1 /# OF WASTED WORDS PER ENTRY
-DPROPR, 0102 /AB
- 2314 /SL
- 0422 /DR
- 2326 /.SV
- 3017 /V3D ENCODING FOR 1-JUN-77
- -6 /SIX BLOCKS LONG( 1 BLOCK = 256 WORDS)
- 0 /EMPTY SPACE
- -1 /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
-
- IFNZRO .-1415 <CNFER,QQQ>
-
-
- *3400 /"ENTER" OVERLAY TO USR - RUNS IN 11000
- JMP .+3
-MSEGLM, -7 /# DIRECT. SEGS
-NEWLEN, -10
-MEOVLP, TAD I [DLINK
- SNA CLA
- JMP MELAST /LAST SEGMENT - MUST CREATE A NEW ONE
- ISZ I [DCOUNT /BUMP ENTRY COUNT DOWN
- JMS I [MWRCAT /WRITE OUT THIS SEGMENT
- JMS MSKIPF /FIND END OF SHORTENED DIRECTORY
- DCA MEFCNT /PREPARE TO TRANSFER LAST ENTRY
- TAD (MEOVLS-1
- DCA XR1 /INTO NEXT DIRECTORY SEGMENT
- TAD I XR
- DCA I XR1
- ISZ MEFCNT /THROUGH A BUFFER AT LOC 11200
- TAD XR
- CIA
- TAD T1 /T1 WAS SET UP BY "ENTER"
- SZA CLA
- JMP .-7
- TAD I T1 /GET LENGTH OF MOVED ENTRY
- DCA MEOCNT
- TAD I [DLINK
- JMS I [MRDCAT /READ NEXT SEGMENT
- JMS I [CONSOL /MAKE SURE IT IS AT ITS SMALLEST
- TAD I [DORG
- TAD MEOCNT
- DCA I [DORG /BUMP FILE ORIGIN DOWN
- JMS MSKIPF /FIND LAST LOC IN NEW SEGMENT
-MELP3, TAD XR
- DCA METMP1
- TAD XR
- TAD MEFCNT
- DCA METMP2 /PREPARE TO PUSH ALL ENTRIES UP
- TAD I METMP1
- DCA I METMP2 /DO THE PUSHING
- STA
- TAD XR
- DCA XR
- TAD XR
- TAD (-DWASTE
- SZA CLA /ARE WE THROUGH?
- JMP MELP3 /NO
- TAD (MEOVLS-1
- DCA XR /PREPARE TO MOVE THE SAVED ENTRY INTO THE
- CLA CMA /NEW SEGMENT
- TAD I [DCOUNT
- DCA I [DCOUNT /INCREASE ENTRY COUNT OF NEW SEGMENT
- TAD MEFCNT
- CIA
-MECOMN, DCA MEFCNT /STORE NUMBER OF WORDS TO MOVE
- TAD [DWASTE
- DCA XR1
- TAD I XR
- DCA I XR1
- ISZ MEFCNT
- JMP .-3 /MOVE THE ENTRY IN
- JMS MSKIPF
- TAD XR
- DCA T1 /T1=LAST LOC IN SEGMENT
- TAD I [DWASTE
- CIA
- TAD XR
- TAD [-1772
- SMA CLA /HAVE WE MADE THIS SEGMENT TOO BIG?
- JMP MEOVLP /YES - LOOP UNTIL WE GET IT RIGHT
- JMS I [MWRCAT /WRITE OUT NEW SEGMENT
- JMP MEOXIT /READ IN ENTER AND CONTINUE
- MWRONG, IAC
-MELAST, TAD NEWLEN
- DCA METMP1 /LENGTH OF NEW SEGMENT
- TAD METMP1
- CIA
- TAD I [DCOUNT
- SMA /WERE THERE "NEWLEN+1"
- JMP MWRONG /NO - SET OUR SIGHTS LOWER
- DCA I [DCOUNT /ADJUST LENGTH OF OLD SEGMENT
- JMS MSKIPF /FIND BOUNDARY LOC BETWEEN SEGMENTS
- TAD I [MCATRC
- IAC
- DCA I [DLINK /LINK THE OLD LAST SEGMENT TO
- TAD I [DLINK /THE NEWLY CREATED ONE
- TAD MSEGLM
- SMA CLA
- JMP I (MEOERR /PROVIDED THAT THERE IS ROOM FOR ANOTHER
- JMS I [MWRCAT /WRITE OUT THE NEXT-TO-LAST SEGMENT
- ISZ I [MCATRC /BUMP RECORD NUMBER FOR NEXT WRITE
- ISZ OLDT9 /LIKEWISE BUMP DIRECTORY KEY
- TAD METMP1
- DCA I [DCOUNT
- TAD MEOCNT
- CIA
- TAD I [DORG
- DCA I [DORG /SET UP PARAMETERS OF THE NEW SEGMENT
- DCA I [DLINK /MARK IT AS THE NEW LAST SEGMENT
- TAD XR
- TAD [-1777 /SET UP COUNT OF WORDS TO SLIDE DOWN
- JMP MECOMN /USE COMMON CODE TO SLIDE WORDS AND EXIT
-
-MSKIPF, 0 /SUBR TO FIND LAST LOC USED IN A SEGMENT
- /ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT
- TAD I [DCOUNT
- DCA MNOFIL
- TAD [DWASTE
- DCA XR
- DCA MEOCNT /INITIALIZE POINTER(XR) AND COUNT(MEOCNT)
-MSKPLP, TAD I XR
- SNA CLA
- JMP MEOMTY
- MTHREE
- TAD I [DWASTE /BUMP POINTER TO LENGTH WORD OF FILE ENTRY
- CIA
- TAD XR
- DCA XR
-MEOMTY, TAD I XR
- TAD MEOCNT
- DCA MEOCNT
- ISZ MNOFIL
- JMP MSKPLP
- JMP I MSKIPF
-
-
-MEOCNT, 0
-MEFCNT, 0
-METMP1, 0
-METMP2, 0
-MNOFIL, 0
- MEOVLS=1200 /DESTROYS PART OF "CLOSE" OP FOR BUFFER
- PAGE
- EJECT ABSLDR
- /ABSOLUTE LOADER FOR OS/8 - VERSION 4A
- *2000
- CTLBLK=3400
- BUFFER=CTLBLK
- RXM=6230 /KT8A INSTRUCTION
- LXM=6200 /KT8A INSTRUCTION
- XVALU=70 /XCODE
- XFIELD=20
- ORIGIN=21
- B1=22
- B2=23
- B3=24
- C1=25
- C2=26
- C3=27
- WD=30
- WD1=31
- WD2=32
- FILPTR=33
- PG7400=34
- LSTFLD=35
- LOADXR=11
-ABSLDR, JMS I (CTINIT
- JMS I (CTINIT
- JMP CALLCD
- JMP NOCD
-NEXTCD, JMS I (NEXFIL
-CALLCD, JMS I [200
- 5 /COMMAND DECODE
- 0216 /ASSUMED EXTENSION IS .BN
-NOCD, TAD [6001
- CDF 0
- DCA I [JSBITS /SET JSBITS TO SAVE CD AREA NEXT TIME
- CDF 10
- TAD I [MPARAM+1
- AND [100
- SZA CLA /IS /R SWITCH ON?
- JMS I (CTINIT /YES - RE-INITIALIZE LOADER TABLES
-LD7400, 7400
- TAD (MIFILE
- DCA FILPTR
- JMS I (SETADR /GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE
-NEWFIL, TAD (7001
- DCA HANDLR
- TAD I FILPTR
- AND [7760
- SZA /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
- TAD [17
- CLL CML RTR
- RTR
- DCA RCDCNT
- TAD I FILPTR
- ISZ FILPTR
- SNA
- JMP NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES
- JMS I [200
- 1 /ASSIGN
-HANDLR, 7001 /LOAD INTO 7000 IF NOT ALREADY LOADED
- JMP I (IOERR
- TAD I FILPTR
- DCA RECNO
- ISZ FILPTR
- CLA CMA
- DCA CHCNT
- DCA REOF
- TAD I [MPARAM /TEST FOR /I
- AND (10
- SNA CLA
- JMP I (LOADER /I IS NOT ON
- ISZ OFLG /IS /I ALLOWED?
- JMP I (OERR /NO!
- JMP I (SLASHO
- GETCH, 0 /GET-NEXT-INPUT-CHARACTER ROUTINE
- TAD [200
- KRS
- TAD (-203
- SNA CLA
- KSF
- SKP
- JMP I (MGET
- ISZ JMPGET
- ISZ CHCNT
-JMPX, JMP JMPGET
- TAD REOF
- SZA CLA
- JMP I GETCH /EOF REACHED BEFORE LOGICAL END - ERROR
- CIF 0
- JMS I HANDLR
- 0210 /READ 2 RECORDS INTO FIELD 1
-PBUFFR, BUFFER
-RECNO, 0
- JMP RERROR
- ISZ RECNO
- ISZ RCDCNT
- SKP
- ISZ REOF
- TAD (-601
- DCA CHCNT
- TAD PBUFFR
- DCA CHPTR
- TAD JMPX
- DCA JMPGET
- JMP GETCH+1
- JMPGET, JMP .
- JMP CHAR1
- JMP CHAR2
-CHAR3, TAD JMPX
- DCA JMPGET
- TAD I CHPTR
- AND LD7400
- CLL RTR
- RTR
- TAD CHTMP
- RTR
- RTR
- ISZ CHPTR
- JMP GCHCOM
-CHAR2, TAD I CHPTR
- AND LD7400
- DCA CHTMP
- ISZ CHPTR
-CHAR1, TAD I CHPTR
-GCHCOM, AND (377
- ISZ GETCH
- JMP I GETCH
-RERROR, SPA CLA
- JMP I (IOERR /AN ACTUAL READ ERROR - AMAZING!
- ISZ REOF
- JMP RECNO+2
-REOF, 0
-CHCNT, 0
-CHPTR, 0
-CHTMP, 0
-RCDCNT, 0
-OFLG, -1 /SWITCH FOR /O OPTION
- PAGE
- *2200
-PUTWD, 6601 /ABSLDR VERSION NUMBER
- CMA
- AND I B2 /AND OUT THE PAGE SLOT IN THE PAGE TABLE
- DCA I B2
- TAD ORIGIN
- DCA ORGX
- TAD XVALU
- CLL RAR
- SZA CLA /TEST FOR FIELDS 0 OR 1
- JMP PUTIT /NEITHER - STORE AS IS
- SNL
- JMP FLD0
- TAD ORIGIN
- SPA
- TAD [-400
- SPA CLA
- JMP FLD1
- CLA CLL CML RTR
- TAD ORIGIN
- SMA CLA
- JMP .+3
- ISZ I (OVLYFG /SET FLAG THAT LOADER IS BEING OVERLAYED
- TAD (2400 /LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14
-LCOMPR, TAD ORIGIN
- RTL
- RTL
- RAL
- AND [17
- TAD (MTEMP
-RLCOMN, DCA PGTMP
- TAD BUFREC
- CIA
- TAD PGTMP
- SNA CLA
- JMP DONTWR
- JMS WRBUF
-WRIBUF, CLA /MODIFIED..IF NOT /O GETS SZA CLA
- JMP DONTWR
- CIF 0
- JMS I [SHNDLR
- 0210
- 1400 /USE CATALOG SPACE
-PGTMP, 0
- JMP I (LIOERR
-DONTWR, DCA OLDT9 /MARK THE CATALOG DESTROYED
- TAD PGTMP
- DCA BUFREC
- TAD ORIGIN
- AND [377
- TAD PTRBFR
- DCA ORGX
- CDF 10
- JMP PUTIT2
- FLD1, CLL
- TAD ORIGIN /IGNORE LOCATIONS ABOVE 17600
- TAD [200
- SZL CLA
- JMP I PUTWD
-PUTIT, TAD XFIELD
- TAD (6201
- DCA .+1
-M7, -7
-PUTIT2, TAD C3
- DCA I ORGX
-CDF10, CDF 10
- JMP I PUTWD
-FLD0, TAD ORIGIN /CHECK FOR STUFF IN PAGE 7000
- TAD (1000
- SNL CLA /IF NON ZERO,OVERLAY
- JMP PUTIT
- ISZ PG7400 /SET OVERLAY FLAG
- JMP LCOMPR /FORM RECORD NO.
-WRBUF, CALONC
- TAD BUFREC
- SNA
- JMP I WRBUF
- CIF 0
- JMS I [SHNDLR
- 4210
-PTRBFR, 1400
-BUFREC, 0
- JMP I (LIOERR
- DCA BUFREC
- /BAD I/O ON SYSTEM DEVICE
- JMP I WRBUF
- ORGX,
-NEXFIL, ERTRN
- JMS WRBUF /WRITE WHATEVER
- TAD I [MPARAM-1
- SPA CLA
- JMP I (BUILD
- TAD I [MPARAM
- AND (40
- SZA CLA
- JMP I (BUILD
- JMP I NEXFIL
-
-CORTB, ZBLOCK 30 /ONCE-ONLY CODE INSERTED HERE KATER
- ZBLOCK 2 /EXTRA NEEDED BY ONCE-ONLY CODE
- /NOT USED BY CORE TABLE
- PAGE
- *2400
-ITSOVR, JMS ASSEMB /END OF FILE
- CIA
- TAD LCKSUM
-SZAIN, SZA CLA /TEST CHECKSUM
- JMP I (BADCKS
- TAD I [MPARAM+1 /TEST FOR S OPTION
- AND L40
- SNA CLA
- JMP I (NEWFIL /TIME FOR ANOTHER FILE
-LOADER, DCA LCKSUM /
- DCA I (OFLG /CANCEL FURTHER /I'S
- TAD SZAIN
- DCA I (WRIBUF
- JMS GETFLD /FIELD SETTING
- /DCA XFIELD
- TAD [200
- DCA ORIGIN /ORIGIN SETTING
- JMS I (GETCH
- JMP I (NEWFIL
- SNA /IGNORE ZEROES
- JMP .-3
- TAD [-200 /LOOKING FOR LEADER CODE
- SZA CLA
- JMP LOADER+1
-LEADER, JMS I (GETCH
- JMP I (NEWFIL
- SNA
- JMP LOADER+1
- TAD [-200
- SNA /IS IT LEADER CODE?
- JMP LEADER
-NEWWD, SMA /IS IT POSSIBLY AFIELD PSEUDO-OP?
- JMP FIELDW
- TAD [200 /IF NOT STORE FOR ASSEMBLING
- DCA WD1
-NEWD1, DCA I (HT
- JMS I (GETCH
- JMP I (BADINP
- DCA WD2 /STORE SECOND WORD FOR ASSEMBLING
- JMS I (GETCH
- JMP I (BADINP
- TAD [-200
- SNA /TEST FOR TRAILER CODE
- JMP ITSOVR
- DCA WD /STORE THIRD WORD
- JMS ASSEMB
- SNL
- JMP DATAWD
- DCA ORIGIN
- DCA I (LOADWD /ZERO 'DATA LOADED' FLAG V3
- JMP GETNXT
- DATAWD, JMS I (LOADWD
- ISZ ORIGIN
-L40, 40
-GETNXT, TAD WD1
- TAD WD2
- TAD LCKSUM
- DCA LCKSUM
- TAD WD
- JMP NEWWD
- ASSEMB, 0 /ASSEMBLING WORDS...
- TAD WD1
- CLL RTL
- RTL
- RTL
- TAD WD2
- JMP I ASSEMB
-FIELDW, TAD (-32 /TESTING TO ISOLATE FIELD PSEUDO-OP
- SNA /IS IT A CONTROL/Z?
- JMP CTLZ
- TAD (-46
- SPA /IS IT GREATER THAN 300?
- JMP NOTXP
- DCA WD1
- TAD WD1
- AND [7
- SZA CLA
- JMP NOTXP
- TAD WD1
- AND (70
- ISZ I (HT /I.D. DISTINGUISHES BETWEEN GETFLD & FIELDW CALL
- JMS I (XTEND /GO SEARCH FOR GREATER THAN 32K FIELD SETTING
- /DCA XFIELD
- JMS I (GETCH
- JMP I (BADINP
- TAD [-200
- SZA
- JMP NEWWD
-NOTXP, CLA
- TAD LCKSUM
- SNA CLA
- JMP LOADER
- JMP I (BADINP
-LCKSUM, 0
-CTLZ, TAD LCKSUM
- SZA CLA
- JMP I (BADINP
- JMP I (NEWFIL
- GETFLD, 0 /TEST FOR SPECIFIED FIELD SETTING
- DCA C1
- DCA XVALU /INITIALIZE XVALU
- TAD I (MPARAM+2 /COMMAND DECODER INPUT
- AND (1774
- SNA /WAS FIELD SPECIFIED?
- JMP I GETFLD
- RTL /IF SO, WHAT WAS IT?
- RAL
- ISZ C1
- SNL
- JMP .-3
- CLA CMA
- TAD C1 /FIELD...IS HERE
- JMS I (XTEND /MAKE NECESSARY ADJUSTMENTS(KT8A)
- JMP I GETFLD
- PAGE
- *2600
- /BUILD CORE CONTROL BLOCK
- /FIELDS AND PAGES TO BE SAVED HAVE BEEN ISOLATED
- /BY LOADWD.SEE CORTAB FOR MORE INFO ON TABLE.
-
-
-BUILD, TAD (CORTAB+135 /ROUTINE TO SEARCH SAVE TABLE
- DCA B1
- TAD I (CORTAB+3
- CLL CMA
- AND [7760
- SNA CLA
- CML
- TAD I (CORTAB
- CMA
- AND [7760
- SNA CLA
- IAC
- RTR
- DCA I (CTLBLK+3
- TAD (CTLBLK+3
- DCA LOADXR
- TAD [-40
- DCA C1
- TAD [70
- CLA
- TAD (37
- DCA FIELDB
- DCA I (CTLBLK
-FLDLP, TAD FIELDB
- TAD (-2
- SMA CLA /IGNORE 07600 AND 17600 IN CCB /V3
- CMA /IN THE CORE MAP
- TAD [-37
- DCA C2
- DCA LOWERA
-MTLOOP, JMS I (SHFT
- SNL CLA
- JMP INUSE
- TAD LOWERA
-MTRSME, TAD [200
- DCA LOWERA
- ISZ C2
- JMP MTLOOP
- JMP FLDOVR
-INUSE, TAD LOWERA
- TAD [200
- DCA UPPERA
- ISZ C2
- SKP
- JMP ENDRGN-2
- JMS I (SHFT
- SZL CLA
- JMP ENDRGN
- TAD UPPERA
- JMP INUSE+1
- CLA CMA
- DCA C2
-ENDRGN, TAD LOWERA
- AND [7400
- DCA I LOADXR
- ISZ I (CTLBLK
- TAD LOWERA
- AND [7400
- CIA
- TAD UPPERA
- CLL RAR
- TAD XFB
- DCA I LOADXR
- TAD UPPERA
- JMP MTRSME
-XFB, 0
- FLDOVR, JMS I (EXTST
- TAD I [MPARAM+1 /CLOBBER BATCH?
- AND [400
- TAD I (MPARAM+2 /AH ED, BUG IF YOU SPEC /P/1 TO LOADER
- AND (403
- TAD I (CTLBLK+3
- DCA I (CTLBLK+3
- TAD LSTFLD
- AND (37
- JMS I (BANKSW /ADJUST FOR CDF
- TAD [CDF CIF 0
- DCA I (CTLBLK+1
- SKP
-ORG200, TAD [200
- TAD LSTADR
- SZA /V3
- JMP NOORG /V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT
- TAD I (LOADWD /V3 NO EXPLICIT START ADDR
- CLA /REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF
-/* SZA CLA /V3 IS IT SELF STARTING BIN FORMAT?
- JMP ORG200 /V3 NO
- TAD XFIELD /V3 YES
- TAD [CIF CDF 0 /V3
- DCA I (CTLBLK+1 /V3
- TAD I (ORIGIN /V3
-NOORG, DCA I (CTLBLK+2
- JMP I (LGTOUT /WRITE CONTROL BLOCK AND EXIT
-FIELDB, 0
- UPPERA,
-SETADR, 0
- TAD I (MPARAM+3
- SNA /IS THERE A STARTING ADDRESS SPECIFIED?
- JMP I SETADR /NO
- DCA LSTADR
- TAD I [MPARAM-1
- DCA LSTFLD
- JMP I SETADR
-
-LOWERA, 0
-LSTADR, 0
- PAGE
- *3000
-ZOFILE, MOFILE
-ZOUCNT, -47
-LGTOUT, TAD PG7400
- SNA CLA
- JMP .+7
- CIF 0
- JMS I [SHNDLR
- 0300
- 7000
- MTEMP+16
- JMP I (LIOERR
- CIF 0
- JMS I [SHNDLR
- 4210
- CTLBLK-200
- MTEMP+10
- JMP I (LIOERR
- TAD I (CTLBLK+2
- DCA CTL2 /MOVE THINGS INTO THIS PAGE
- TAD I (CTLBLK+3
- DCA CTL3 /SO WE CAN REFERENCE THEM WITH DF=0
- TAD I [MPARAM
- AND (40
- SNA CLA
- JMP LNOGO
- TAD CTL3
- RAL
- SPA CLA /ARE WE OVERLAYING THE I/O MONITOR?
- JMP LKICKM /NO
- CDF 0
- DCA I [JSBITS /YES - SET JSBITS TO FORCE A READ
- CDF 10
- JMS I [200
- 13 /RESET I/O DEVICES AND FILES
-LKICKM, JMS I [200
- 11 /KICK MONITOR OUT
- /********************************************
- /NO PAGE ZERO REFERENCES AFTER THIS POINT
- /PAGE ZERO MAY CONTAIN USER CODE
- /********************************************
- DCA I ZOFILE /ZERO OUT COMMAND DECODER AREA
- ISZ ZOFILE
- ISZ ZOUCNT
- JMP .-3
- TAD I (CTLBLK+1
- CDF 0
- DCA I (MSTCDF
- TAD CTL2
- DCA I (MSTADR /SET UP STARTING ADDRESS IN FIELD 0
- JMP LMOVRD
- LNOGO, TAD CTL3 /ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES
- SPA CLA /ARE WE OVERLAYING THE KEYBOARD MONITOR?
- TAD (5 /NO - RETURN TO NON-SAVING ENTRY
- TAD [7600
- CDF 0
- DCA I (MSTADR
- TAD ZCDIF0
- DCA I (MSTCDF
- CLA CMA
-LMOVRD, CDF 10
- DCA I (7700 /SET 7700 TO -1 IF NO GO
- TAD I (CTLBLK+1
- CDF 0
- DCA I (JFIELD /SET UP PARAMETERS IN FIELD 0
- TAD CTL2
- DCA I (JSTART
- TAD CTL3
- DCA I (JSBITS
-LMOVLP, TAD COMBO
- DCA I COMBPT
- ISZ LMOVLP
- ISZ COMBPT
- ISZ COMBCT
- JMP LMOVLP /MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0
-ZCDIF0, CDF CIF 0
- TAD OVLYFG
- SZA CLA
- JMP I (MREAD /LOADER OVERLAYED - GO READ OVERLAY
- JMP I (MSTCDF /LOADER NOT OVERLAYED - WHY READ?
-COMBPT, MREAD-1
-COMBCT, -7
-COMBO, 7607
- MREAD-1&177+4600 /JMS I .-1
- 1210
- 2000
- MTEMP+11 /LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
- HLT
- MSTCDF&177+5200 /JMP MSTCDF
-CTL2, 0
-CTL3, 0
-OVLYFG, 0
- /LOADWD CALCULATES AN INDEX INTO CORTAB
- /IT SETS APPROPRIATE BITS FOR IDENTIFYING MEMORY AREA
- /TO BE SAVED BY CCB.SEE CORTAB FOR MORE INFO
-LOADWD, 0 /ROUTINE TO IDENTIFY FIELDS AND PAGES
- DCA C3 /TO BE SAVED.
- TAD XVALU /FIELD VALUE-INDEX INTO CORTAB(SEE CORTAB)
- CLL RAL
- TAD XVALU
- TAD (CORTAB-1
- DCA B2
- TAD ORIGIN
- AND [7600
- CLL RTL
- RTL
- RTL
- ISZ B2
- TAD (-14
- SMA
- JMP .-3
- DCA CTL2
- CLL CML
- RAL
- ISZ CTL2
- JMP .-2
- JMS I (PUTWD
- JMP I LOADWD
- PAGE
- *3200
-ERPCH, 0
- AND (77 /GET LOW ORDER 6 BITS
- SZA
- JMP NZCHAR
- JMS ERR
-FILMSG, TEXT /, FILE 0/
-NZCHAR, TAD (240
- AND (77
- TAD (240 /CONVERT TO ASCII
- JMS LDRPCH /PRINT
- JMP I ERPCH /AND RETURN
-LDRPCH, 0
- TLS
- TSF
- JMP .-1
- CLA
- JMP I LDRPCH
-SHFT, 0
- CLA CLL CMA RTL
- DCA C3
- CLA CLL CML RTL
- TAD B1
-SHFTLP, DCA B3
- TAD I B3
- RAL
- DCA I B3
- CLA CMA CML
- TAD B3
- ISZ C3
- JMP SHFTLP
- JMP I SHFT /NOTE: SHFT LEAVES AC NON-ZERO
- ERR, ONCE /CAN'T USE PAGE 0 LITERALS
- CLA
- CDF 10
- TAD I (FILPTR /ZERO CHAR GETS REPLACED BY "FILE #"
- TAD (322 /MAGIC NUMBER
- CLL CML RAR /AC NOW CONTAINS " #"
- DCA FILMSG+3
-ERRLUP, TAD I ERR
- SNA
- JMP EOMESG /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
- RTR
- RTR
- RTR
- JMS ERPCH
- TAD I ERR
- JMS ERPCH
- ISZ ERR
- JMP ERRLUP
-EOMESG, TAD (215 /TERMINATE MESSAGE WITH CR-LF
- JMS LDRPCH
- TAD T212
- JMS LDRPCH
-ERTRN, JMP I (ABSLDR /RETURN TO LOADER STARTING ADDRESS
-IOERR, JMS ERR
- TEXT %I/O ERROR%
-BADINP, JMS ERR
- TEXT /BAD INPUT/
-BADCKS, JMS ERR
- TEXT / BAD CHECKSUM/
-NULERR, JMS CTINIT
-T212, 212
- JMS ERR
- TEXT /NO INPUT/
- LIOERR, JMS ERR
- TEXT /SYSTEM I-O ERROR/
-OERR, JMS ERR
- TEXT %NO /I!%
-
-CTINIT, 0
-CALONC, JMS I ERR /CALL ONCE-ONLY CODE
- TAD (-140
- DCA C1
- DCA XFIELD /INITIALIZE XFIELD
- TAD (CORTAB-1
- DCA LOADXR
- CLA CMA
- DCA I LOADXR
- ISZ C1
- JMP .-3
- DCA LSTFLD
- DCA I (LSTADR /V3 SET INITIAL STARTING ADDRESS TO 0
- DCA I (OVLYFG
- DCA PG7400
- ISZ CTINIT
- JMP I CTINIT
- PAGE
-
-*CTLBLK+200
-
-/CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT
-/USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED,
-/AS IT IS USED FOR A BUFFER
-
-SLASHO, CLA CMA
- DCA I (OFLG /RE ENABLE /I
- TAD I (HANDLR
- DCA GLONK /ENTRY POINT TO HANDLER
- TAD I (RECNO
- DCA CCBLOK
- CIF 0
- JMS I GLONK /READ IN CORE CONTROL BLOCK
- 0110
-CCBPTR, CTLBLK
-CCBLOK, 0
- JMP I (OERR /DATA FAILURE
- TAD I CCBPTR /NO. SEGMENTS
- CMA /TEST FOR BAD CORE IMAGE
- AND L7740
- SZA CLA
- JMP I (BADINP /NOT CORE IMAGE
- TAD I CCBPTR
- DCA SEGCNT
- TAD I SGSTAD /THIS CODE IS NEW FOR V3D
-/ AND [70 /GET FIELD
- CLL RTR
- RAR
- DCA I (LSTFLD
- ISZ SGSTAD
- TAD I SGSTAD
- DCA I (LSTADR
- ISZ SGSTAD
- TAD I SGSTAD /GET JSW FROM SAVE FILE
- AND [400
- DCA TEMP /PRESERVE /P
- TAD I [MPARAM+1
- AND (7377
- TAD TEMP
- DCA I [MPARAM+1
- TAD I SGSTAD
- AND (3 /PRESERVE LAST 2 BITS
- DCA TEMP
- TAD I (MPARAM+2
- AND [7774
- TAD TEMP
- DCA I (MPARAM+2
- ISZ SGSTAD
-NEWSEG, TAD I SGSTAD /SEGMENT START ADDRESS
- DCA ORIGIN
- TAD I SGFDLT /FIELD AND LENGTH
- AND L77
- DCA XFIELD
- TAD I SGFDLT
- AND [7700
- SNA /V3C
- STL CLA RAR /AC4000
- DCA SEGLTH
- TAD SEGLTH
-TWOPG, TAD [7600
- SMA CLA /NO.. IS TWO PAGE SEGMENT LEFT?
- TAD [7600 /YES..-400 TO WORD COUNT
- TAD [7600 /NO.. -200 TO WORD COUNT
- DCA WDCT
- TAD SEGLTH
- TAD [7600 /BUMP DOWN LENGTH LEFT
- DCA SEGLTH
-
- ISZ CCBLOK /POINT TO NEXT DATA RECORD
- TAD CCBLOK
- DCA DATRC
- DCA OLDT9 /MARK DIRECTORY DESTROYED
- CIF 0
- JMS I GLONK /READ THE DATA RECORD IN
- 0210
- 1400 /INTO 11400
-TEMP,
-DATRC, 0
- JMP I (IOERR /DATA FAILURE
- CLA CMA
- TAD ORIGIN
- AND [177
- TAD (1200 /SET UP INPUT POINTER
- CHARPT=10
- DCA CHARPT
-LOOPI, TAD I CHARPT
- JMS I (LOADWD /MOST OF THE WORK
- ISZ ORIGIN
-L7400, 7400 /NOP
- ISZ WDCT /FINISHED THIS BLOCK?
- JMP LOOPI
- JMS I (WRBUF /YES.. WRITE THE STUFF OUT
- DCA I (BUFREC /SO THAT WRBUF DOESN'T SCREW US UP
- TAD SEGLTH /V3C (REARRANGED)
- SMA SZA /ALL PAGES DONE?
- JMP TWOPG /NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
- ISZ SEGCNT /YES, ANY MORE SEGMENTS
- SKP
- JMP RENEW /RESET CCB POINTER FOR NEXT /I
- CLA CLL CML RTL
- TAD SGSTAD
- DCA SGSTAD
- CLA CLL CML RTL
- TAD SGFDLT
- DCA SGFDLT /POINT TO NEXT CCB ENTRIES
- JMP NEWSEG
-
-GLONK, 0 /HANDLER ENTRY POINT HERE
-WDCT, 0
-SEGCNT, 0
-SEGLTH, 0
-CTLBLK=3400
-
-SGFDLT, CTLBLK+5 /FIELD AND LENGTH WORD
-SGSTAD, CTLBLK+1 /SEGMENT START ADDRESS
-
-L7740,
-RENEW, 7740 /USED TO CLEAR AC
-L77, 77 /MIGHT OR MIGHT NOT SKIP
- TAD (CTLBLK+1
- DCA SGSTAD
- TAD (CTLBLK+5
- DCA SGFDLT
- JMP I (NEWFIL
- PAGE
- *4000
-XTEND, 0 /CODE TO HANDLE EXTENDED MEMORY BANK MANIPULATIONS
- DCA XVALU /STORE INFO TO BE PROCESSED
- TAD HT /IS IT A GETFLD OR A FIELDW CALL?
- SZA CLA /IF GETFLD CALL ALL WE WANT TO DO IS TRANSFORM
- JMP XFLDT
-XNDT, TAD XVALU / TRANSFORM FROM ABCDE TO ACDEB00
- JMS BANKSW
- DCA XFIELD
- JMP I XTEND
-XFLDT, JMS I (GETCH /FIELDW CODE TEST FOR SECOND FIELD WORD
- JMP I (BADINP
- TAD [-200
- SNA
- JMP I (NOTXP
- SMA
- JMP XTD
- TAD [200 /REPEATED NEWWD CODE
- DCA WD1 /REPEATED NEWWD CODE
- TAD XVALU /IF NO SECOND FIELD WORD WE PROCEED AS NORMALLY
- DCA XFIELD
- TAD XVALU
- CLL RTR
- RAR
- DCA XVALU
- JMP I (NEWD1 /BY PASS NEWWD CODE -- ALREADY RAN IT
-XTD, TAD (-32 /REPITITION OF FIELDW CODE
- SNA /IS IT CONTROL/Z?
- JMP I (CTLZ
- TAD (-46
- SPA /IS IT ABOVE 300?
- JMP I (NOTXP
- CLL RTR
- RAR
- AND [7
- TAD WD1
- DCA XVALU
- TAD (7000
- LXM
- JMP XNDT
-HT, 0
-EXTST, 0 /BUILD CCB CODE TO HANDLE EXTENDED MEMORY
- TAD I (FIELDB /PREVIOUSLY KNOWN AS FLDOVR CODE
- TAD (-1 /TRANSFORM THE BITS FROM
- DCA I (FIELDB /ABCDE FORM TO CDEBA FORM
- TAD I (FIELDB
- CLL RTR
- RTR
- SZL
- TAD (400
- CLL RAR
- SZL
- TAD (100
- CLL RTR
- RTR
- RAR
- DCA I (XFB
- CLA CLL CMA RTL
- TAD I (B1
- DCA I (B1
- ISZ I (C1
- JMP I (FLDLP
- TAD I (CTLBLK
- SNA
- JMP I (NULERR
- CIA
- DCA I (CTLBLK
- RXM
- SNA CLA
- JMP I EXTST
- TAD I (CTLBLK
- RAL
- CLL RAR
- DCA I (CTLBLK
- JMP I EXTST
-BANKSW, 0
- CLL RTR /ISOLATE BANK AND FIELD BITS
- RTR
- SZL /ADJUST FOR PROPER CDF CIF
- TAD [400 /WAS THERE AN "A" BIT?
- CLL RAR
- SZL /WAS THERE A "B" BIT?
- TAD (4000
- CLL RTR
- RTR
- RAR
- JMP I BANKSW
- PAGE
-
- *4200
- /CORTAB IS A TABLE FOR STORING SAVE INFO
- /FOR EACH OF THE 0-37 FIELDS, THERE ARE THREE
- /IDENTIFYING WORDS...THE BITS IN THESE WORDS
- /CORRESPOND TO PAGES IN THE RESPECTIVE FIELD
- /E.G. CORTAB+130 REFERS TO 130%3=35TH FIELD
- /--- FIRST WORD,I.E. PAGES 0-14...
- /LOADWD BUILDS THE TABLE...
- /BUILD REFERENCES IT FOR CONSTRUCTING THE CCB
-CORTAB, ZBLOCK 140
- PAGE
-
- *CORTB /ONCE-ONLY CODE
-
-ONCE, 0 /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
- DCA I WRBUF /DON'T CALL AGAIN
- TAD [400
- TAD K7400
- SZA CLA
- JMP OLDMON
- TAD [7
- TAD M7
- SNA CLA
- JMP I ONCE /THEY AGREE
-OLDMON, TAD KERR
- DCA I NEXFIL
- JMS I PERR /THEY DON'T
- TEXT /INCOMPATIBLE/ /MUST BE AN EVEN # OF CHARS LONG
- CIF CDF 0
- JMP I K7605
-K7400, 7400
-PERR, ERR
-K7605, 7605
-KERR, ERR&177+5600
- /PAGE 0 - TEMPORARIES AND LITERALS.
- /LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS
- /IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS)
-
- /LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS
-
- *7
-OLDT9, 0 /POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE
-
- *15
-XR1, 0
-XR2, 0
-XR, 0
- *20 /ENTRY TO MONITOR FROM A CALL TO 17700 -
- /CAN BE DESTROYED AFTER IT IS EXECUTED
-MSTART, TAD I T1
- DCA MACARG
- TAD I [7700
- DCA I [MONITO
- TAD I [SMCIF
- DCA I T2 /FAKE A CALL TO "MONITO"
- TAD I [MONITO
- RAL
- SNL SMA CLA
- TAD I [SMCIF
- TAD T3
- SNA CLA /CHECK FOR A CALL FROM 10000-11777
- JMP I [MERROR /YES - GIVE ERROR IMMEDIATELY
- JMP I T4 /NO - SLIDE INTO MONITOR CODE
-
- *36 /POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD"
- SDNAME /SYSTEM DEVICE NAME TABLE
- SDVHND /DEVICE HANDLER ENTRY TABLE
- *40 /LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE
-USERFG, 1 /MUST BE IN 40 - SEE CD LISTING
-T1, MARG1 /MUST BE AT 41
-T2, FGETX
-T3, -6213
-T4, MRENTR
-T5, 0
-T6, 0
-T7, 0
-T8, 0
-T9, 0
-NAME, 0
-NFILES, 0
-ASFLAG, 0
-MACARG, 0
-EPASS, 0
-MERRNO, 4000
-MEOXIT, CIF 0 /RETURN FROM ENTER OVERLAY
- JMS I [SHNDLR
- 0210
- 1000
- MONTOR+2 /RESTORE LOCS 1000-1377 OF USR
- HLT /HELP!
- JMP I .+1
- MENTER /RESTART ENTER OPERATION COMPLETELY
- $
-
DELETED src/os8-v3f/PAL8.PA
Index: src/os8-v3f/PAL8.PA
==================================================================
--- src/os8-v3f/PAL8.PA
+++ /dev/null
@@ -1,5398 +0,0 @@
-/2 PAL8 ASSEMBLER FOR OS/8 MONITOR VERSION 13
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /1-OCT-75 MB/MB/SM/MB/RL/JR/SR
-
-DECIMAL
-
-VERSION= 13
-SUBVERSION= "A
-
-OCTAL
-
-/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED
-/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
-
-/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
-/THE SYMBOL TABLE.
-
-/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
-/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.
-
-/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
-/LISTING.
-
-/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
-/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.
-
- IFNDEF HASH<HASH=1> /DEFINE FOR HASH SYMBOL TABLE
-/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE
-
-/MAINTENANCE RELEASE CHANGES:
-
-/1. INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
-/2. ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
-/3. PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
-/4. FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
-/5. ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
-/6. FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
-/7. FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
-/8. FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
-/9. CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
-/10. ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
-/11. CORE ALLOCATION:
-/ WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
-/ WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
-/ UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
-/12. /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
-/13. 14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE
-
-/JR 14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
- /COMMAND DECODER RULES:
-
-/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS
-
-/OPTIONS:
-/B BYTE SHIFT - ! IS 6 BIT SHIFT (!=^100+)
-/C CREF AFTER - "CREFLS.TM" CREATED IF NO CREF
-/D DDT TYPE SYMBOL - ONLY IF LISTING
-/E 'LG' ERROR - LINKS ARE ERRORS
-/F NO TEXT FILL - NO EXTRA 0 FILL IN 'TEXT'
-/G LOAD+GO AFTER - SAME AS /L, BUT /G PASSED TO ABSLDR
-/H NO PAGING - ONLY IF LISTING
-/J JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE
-/K CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
-/L LOAD AFTER - "PAL8BN.TM" CREATED IF NO BINARY
-/N NO LISTING - ONLY IF LISTING
-/O NO 200 ORG - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
-/S NO SYMBOL TABLE - ONLY IF LISTING
-/T CR-LF NOT FF - ONLY IF LISTING
-/W WIPE LITERALS - INHIBITS REMEMBERING OF LITERAL BOUNDS
-
-/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
-/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
-/TO REVERSE THE POLARITY OF THE "T" SWITCH.
-
-/PSEUDO-OPS:
-/DECIMAL RADIX TO BASE 10
-/DEVICE 2 WORD DEVICE CODE
-/DTORG TYPESETTING TAPE ORIGIN
-/EJECT SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
-/ THAT TEXT BECOMES THE NEW HEADER LINE
-/ENPUNCH ENABLE PUNCHING
-/EXPUNGE REMOVE ALL SYMBOLS
-/FIELD SET FIELD
-/FILENAME 4 WORD FILE CODE
-/FIXMRI DEFINE MEMORY REFERENCE INSTRUCTION
-/FIXTAB MAKE ALL SYMBOLS PERMANENT
-/IFDEF CONDITIONAL ON DEFINITION
-/IFNDEF CONDITIONAL ON UNDEFINED
-/IFNZRO CONDITIONAL ON NON-ZERO
-/IFZERO CONDITIONAL ON ZERO
-/NOPUNCH DISABLE PUNCHING
-/OCTAL RADIX TO BASE 8
-/PAGE RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
-/PAUSE ALTERNATE END-OF-FILE
-/RELOC ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
-/TEXT 6 BIT TEXT
-/XLIST LISTING INHIBIT UNLESS THE XLIST IS
-/ FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
-/ IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
-/ZBLOCK RESERVE BLOCK OF ZEROS
- /SYMBOL LAYOUT:
-
-/ WORD 1 BIT 0=1 PERMANENT SYMBOL
-/ BIT 1=1 "I" OR "Z"
-/ BITS 3-11 CHARS 1 AND 2
-/
-/ WORD 2 BIT 0=1 MEMORY REFERENCE INSTRUCTION
-/ BITS 2-11 CHARS 3 AND 4
-/
-/ WORD 3 BIT 0=1 PSEUDO-OP
-/ BITS 2-11 CHARS 5 AND 6
-/
-/ WORD 4 BITS 0-11 OCTAL VALUE
-/CHARS ARE STORED AS:
-/ A TO Z ARE 01 TO 32
-/ 0 TO 9 ARE 33 TO 44
-/
-/ CHAR1^45+CHAR2
-
-/OPERATORS:
-/+ TWO'S COMPLEMENT ADD
-/- TWO'S COMPLEMENT SUBTRACT
-/& BOOLEAN AND
-/! BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
-/ (SPACE) DELIMITER OR INCLUSIVE OR
-/^ MULTIPLY (REPEATED ADDITION)
-/% DIVIDE (REPEATED SUBTRACTION)
- /DEFINITIONS
-
-ASWAP= 40 /WATCH THIS SWAP AREA!!
-MDATE= 7666 /MONITOR DATE
-BIPCCL= 7777 /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
-MPARAM= 7643 /COMMAND DECODER OPTION LIST
-DCB= 7760 /DEVICE CONTROL BLOCK
-JSBITS= 7746 /JOB STATUS WORD
-BATOUT= 7400 /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
-LNPRPG= 70 /56 LINES PER PAGE
-HEDLEN= 50 /40 CHARACTERS IN PAGE TITLE
- /(MUST BE A MULTIPLE OF 8)
-
-AC7776= STA CLL RAL
-AC7775= STA CLL RTL
-AC4000= STL CLA RAR
-AC3777= STA CLL RAR
-AC2000= STL CLA RTR
-AC0002= STL CLA RTL
-
-
-/TABLE OF ERROR MESSAGE DEFINITIONS
-
-
-IZ= "I-240^100+"Z-240 /ILLEGAL PAGE ZERO REFERENCE
-CF= "C-240^100+"F-240 /CREF.SV NOT FOUND
-US= "U-240^100+"S-240 /UNDEFINED SYMBOL
-IP= "I-240^100+"P-240 /ILLEGAL PSEUDO-OP USAGE
-SE= "S-240^100+"E-240 /SYMBOL TABLE EXCEEDED
-ZE= "Z-240^100+"E-240 /PAGE ZERO EXCEEDED
-PE= "P-240^100+"E-240 /CURRENT PAGE EXCEEDED
-IC= "I-240^100+"C-240 /ILLEGAL CHARACTER
-ID= "I-240^100+"D-240 /ILLEGAL DEFINITION
-BE= "B-240^100+"E-240 /PUSH-DOWN OVERFLOW
-DE= "D-240^100+"E-240 /DEVICE ERROR
-DF= "D-240^100+"F-240 /DEVICE FULL
-LD= "L-240^100+"D-240 /ABSLDR.SV NOT FOUND
-IE= "I-240^100+"E-240 /ILLEGAL EQUATE
-PH= "P-240^100+"H-240 /PHASE ERROR
-II= "I-240^100+"I-240 /ILLEGAL INDIRECT
-RD= "R-240^100+"D-240 /REDEFINITION
-UO= "U-240^100+"O-240 /UNDEFINED ORIGIN
-LG= "L-240^100+"G-240 /LINK GENERATED
-
-
-
-/ABBREVIATIONS
-/CR/LF CARRIAGE RETURN/LINE FEED (215,212)
-/F/F FORM FEED (214)
- /PAGE ZERO
-
-*0
-INT, 15
- CIF 30 /SYMBIONT CODE
- JMP .-1
-PTR, 0 /V3C USED BY
-KNTR, 0 /INPUT ROUTINE
-OCTPR1, 0
-OCTPR3, 0
-FORMF6, 0
-
-/AUTOINDEX REGISTERS
-/PRESET FOR ONCE ONLY CODE
-
-*10
-PDLXR, PDLST /PUSH-DOWN AUTO INDEX REGISTER
-TAGXR, SWAP1-1 /TAG AUTO INDEX REGISTER
-XREG1, DSWIT1-1 /GENERAL AUTO INDEX REGISTER
-XREG2, DSWIT2-1 /GENERAL AUTO INDEX REGISTER
-
-/NOT USED AS AUTO INDEX REGISTERS
-/EXCEPT DURING ONCE ONLY CODE
-
-LAST1, DATE-1 /LAST DEFINED SYMBOL
-LAST2, SWAP2-1
-LAST3, IFZERO HASH <SYMPRT+4-1>
- IFNZRO HASH <SYMNWP-1>
-LAST4, IFZERO HASH <SYMPR9-2-1>
- IFNZRO HASH <SYMDDT-1>
-
-*20
-TAG1, 0 /TAG STORAGE
-TAG2, 0
-TAG3, 0
-
-LITPTR, 200 /LITERAL POINTER
-
-RADIX, 0 /7777 IF DECIMAL MODE
-PUNCHX, 0 /NON-ZERO IF NO PUNCHING
-XLISTX, 0 /NON-ZERO IF NO LISTING
-/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
-/AND IN THIS ORDER
-
-LOC, 200 /CURRENT LOCATION
-OFFSET, 0 /LOCATION COUNTER OFFSET FROM "LOC"
-OFSBUF, 0 /LOCATION COUNTER OFFSET BUFFER
-STARSW, 0 /-1 IF NEXT ORIGIN SHOULD BE INHIBITED
-
-OP, 0 /LAST OPERATOR CODE (0-6)
-VALUE, 0 /EXPRESSION VALUE
-VALUE2, 0 /EXPRESSION OPERAND
-
-TXTSWT, 0 /SPACE SWITCH
-TXTPTR, LINBUF+120 /TEXT POINTER
-CHAR, 0 /CURRENT CHARACTER
-
-THISPG, 0 /OVERFLOW PAGE
-EDITPG, 0 /EDITOR PAGE
- TEMP, 0 /TEMPORARY REGISTERS
-TEMP1, 0
-TEMP2, 0
-TEMP3, 0
-
-OCHAR, OUTPUT /OUTPUT ROUTINE
-OERROR, OTYPEO /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
-PASS, -2 /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
-IOMON, 200 /USER SERVICE ROUTINES
-CONDSW, 0 /NUMBER OF NESTED CONDITIONALS
-EXPIND, 0 /0 IF MRI OK HERE
- /NOT 0 IF MRI NOT OK HERE
-CHKSUM, 0 /BINARY CHECK SUM
-IZIND, 0 /"I" AND "Z" INDICATOR
- /IF I, LEFT 6 BITS ARE NON-ZERO
- /IF Z, RIGHT 6 BITS ARE NON-ZERO
-THISTG, 0 /ASSIGNED NUMBER OF CURRENT TAG
-HIGHTG, SYME-SYMS%4-1 /ASSIGNED NUMBER OF LAST TAG
-LINCNT, 0 /LINE COUNT
-ALPHAI, 0 /UNDEFINED TAG INDICATOR
- /-1 IF UNDEFINED
-GETCI, 0 /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
- /OTHERWISE /,;, OR CARRIAGE RETURN ENDS
-LSTCNT, 0 /TAB COUNTER
-UNDFSW, 0 /UNDEFINED SWITCH
-INCTL, 601 /CONTROL WORD - FOR OS/8 I/O
-LINKSW, 0 /OFF-PAGE LINK SWITCH
- /0 IF NO LINK GENERATED, 0700 IF LINK
-LININD, 0 /BACK-UP FOR LINKSW
-PERROR, PERRO1 /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
- /MESSAGES DURING PASS 1
-FLDIND, "0 /CURRENT FIELD IN ASCII DIGIT FORM
-VALUEX, 0 /XCODE
-ERROR5, 0 /USED BY PACKED ASCII PRINT ROUTINE
-BINSRT, 0 /BINARY OR LISTING STARTING
-ERCNT, 0 /ERROR COUNTER
-LINK, 0 /LINK COUNTER
- IFNZRO HASH<
-TAGMAX, 0 /SET TO PRIME # EQ TO MAX # SYMS
- >
- PAGE
- /STARTING ADDRESS OF PAL8 (0200)
-/CHAINING ADDRESS (0201)
-
-NAME1, JMP I NAME3 /NAME1-NAME3 USED LATER
-NAME2, JMP I GETTA2 /TO STORE TAGS AS THEY ARE BUILT
-NAME3, BEGIN /V3C
-GETTA2, NOCD /BUILDING SWITCH AND OVERFLOW PROTECT
-
-
-/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS
-
-NOPUNX, CLA IAC /NON-ZERO FOR NO PUNCHING
-ENPUNX, DCA PUNCHX /ZERO FOR PUNCHING
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-
-/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS
-
-DECIMX, STA /7777 FOR DECIMAL RADIX
-OCTALX, DCA RADIX /ZERO FOR OCTAL RADIX
- JMP I [LOOKEX /--EXIT TO MAIN--
- /GET A TAG ROUTINE
-/PICKS UP A TAG AND SEARCHES FOR IT
-/"THISTG" HAS NUMBER OF TAG
-/"VALUE2" HAS VALUE
-/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND
-
-GETTAG, 0
- DCA NAME1 /CLEAR BUILD AREA
- DCA NAME2
- DCA NAME3
- TAD [NAME1
- DCA GETTA4 /SET POINTER FOR BUILDING
- DCA GETTA2 /ZERO SWITCH
-GETTG1, TAD CHAR /GET THE CHARACTER
- AND [77 /MAKE IT 01-32 OR 60-71
- TAD (-32 /WAS IT A TO Z?
- SMA SZA
- TAD (-25 /NO - MAKE 60-71 INTO 33-44
- TAD (32 /YES - IT IS NOW 01-32 OR 33-44
- ISZ GETTA2 /LEFT SIDE?
- JMP GETTA3 /YES
- TAD I GETTA4 /NO - RIGHT SIDE
- DCA I GETTA4 /BUILD THE WORD
- ISZ GETTA4 /BUMP TO NEXT WORD
-GETTA1, JMS I [GETC /GET NEXT CHARACTER
- JMS I (TSTALN /IS IT ALPHANUMERIC?
- JMP GETTG1 /YES - KEEP BUILDING
- IFZERO HASH<
- TAD HIGHTG /NO - GET NUMBER OF HIGHEST TAG
- CLL RAR /DIVIDE BY 2
- DCA TEMP2 /SAVE DIFFERENCE
- DCA THISTG /START AT TAG ZERO
- CLL CML /LINK MUST BE ON INITIALLY
- DCA TEMP1
-
-
-/GETTA4 IS POINTER TO NAME1-NAME3
-/FOR DEPOSITING TAG AS IT IS BUILT
-
-/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
-/DURING BINARY SEARCHING
- GETTG2, SZL /IS THISTG HIGHER THAN TAG?
- JMP GETTG3 /NO-LOWER
-GETTG4, DCA TEMP1 /CLEAR LAST TIME SWITCH
- SNL
- ISZ TEMP1 /SET LAST TIME SWITCH TO 1
- TAD TEMP2 /GET # OF TAGS TO SKIP
- SNL
- CIA
- TAD THISTG /INCREASE OR DECREASE TAG NUMBER
- DCA THISTG
- TAD TEMP2 /GET NUMBER
- CLL RAR /DIVIDE BY 2
- SNA /IS RESULT 0?
- ISZ TEMP1 /YES-BUMP LAST TIME SWITCH
- SNA
- IAC /IF RESULT WAS 1, MAKE IT 2
- DCA TEMP2 /SAVE IT FOR NEXT TIME
- JMS I [FINDTG /GET THE TAG
- TAD [1777 /MASK
- AND TAG1 /GET WORD 1
- CLL CIA
- TAD NAME1 /DOES IT MATCH?
- SZA CLA
- JMP GETTG2 /NO - TRY NEXT TAG
- AC3777
- AND TAG2 /YES - GET WORD 2
- CLL CIA
- TAD NAME2 /DOES IT MATCH?
- SZA CLA
- JMP GETTG2 /NO - TRY NEXT TAG
- AC3777
- AND TAG3 /YES - DOES IT MATCH?
- CLL CIA
- TAD NAME3
- SZA CLA
- JMP GETTG2 /NO - TRY NEXT TAG
- JMP I GETTAG /YES--RETURN--
- GETTG3, AC7776
- TAD TEMP1 /LAST TIME SWITCH = 2?
- SZA CLA
- JMP GETTG4 /NO-KEEP TRYING
- ISZ THISTG /YES-QUIT SEARCHING
- DCA VALUE2
- DCA TAG1
- DCA TAG2
- DCA TAG3 /TAG NOT FOUND
- STA /AC=7777 MEANS NOT FOUND
- JMP I GETTAG /--RETURN--
- >
- IFNZRO HASH<
- PRIME=TAGMAX
-
-GETTGH,/JMS I [TLYREF /HACK ONLY
- TAD NAME1 /HASH OUR NAME
- CLL RTL
- TAD NAME2
- RTL
- TAD NAME3
- RTL
- TAD NAME1
- JMS PROBE /NOW PROBE THE TABLE
- TAD NAME1 /RE HASH THE NAME FOR A STEPSIZE
- CLL RAL
- RTL
- TAD NAME2
- CLL /CALC MODULO PRIME INLINE
- TAD MPRIME
- SZL
- JMP .-3
- TAD PRIME
- SNA
- IAC /STEPSIZE MUST BE NON ZERO!
- DCA CRPDEL
-PRBLUP, CLL
- TAD THISTG /BUMP THE POINTER RANDOMLY
- TAD CRPDEL
- SZL /PROTECT AGAINST WRAP AROUND
- TAD MPRIME /PROBABLY UNOPTIMAL SOLUTION
- JMS PROBE
- JMP PRBLUP
-
-PROBE, 0
- CLL
- TAD MPRIME
- SZL
- JMP .-3
- TAD PRIME
- DCA THISTG /THISTG MODULO PRIME
-/ JMS I [TLYPRB /HACK ONLY
- JMS I [FINDTG /GO GET IT
- TAD [1777 /MASK THE TYPE BITS OUT
- AND TAG1 /IS THERE ONE?
- SNA
- JMP NOTFND /NO EXIT POINTING AT IT
- CIA /YES, DO A COMPARE
- TAD NAME1
- SZA CLA
- JMP I PROBE
- AC3777
- AND TAG2
- CIA
- TAD NAME2
- SZA CLA
- JMP I PROBE
- AC3777
- AND TAG3
- CIA
- TAD NAME3
- SZA CLA
- JMP I PROBE /FOUND EXIT WITH AC CLEAR
- JMP I GETTAG
-NOTFND, STA /NOT FOUND EXIT WITH AC SET
- JMP I GETTAG
-
-CRPDEL, 0
-MPRIME, 0 /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
- >
-
-
-GETTA3, DCA GETTA2 /SAVE CHAR
- TAD GETTA2
- CLL RTL /*4
- RAL /*10
- TAD GETTA2 /*11
- RTL /*44
- TAD GETTA2 /*45
- DCA I GETTA4 /SET LEFT SIDE
- TAD GETTA4
- TAD (-GETTA2
- SZA CLA /IS THIS AN OVERFLOW (>6) CHAR?
- STA /NO - SET SWITCH TO RIGHT HALF
- DCA GETTA2 /YES - LEAVE SWITCH AT LEFT HALF
- JMP GETTA1
-
-GETTA4, NAME1
- /IGNORE SPACES ROUTINE
-
-SPNOR, 0
- TAD CHAR /GET THE CHARACTER
- TAD [-240 /IS IT A SPACE?
- SZA CLA
- JMP I SPNOR /NO --RETURN--
- JMS I [GETC /YES - GET NEXT CHARACTER
- JMP SPNOR+1 /LOOP
-
-
-/HANDLER FOR PAUSE PSEUDO-OP
-/END-OF-TAPE OR END-OF-FILE
-
-PAUSEX, AC4000
- DCA CHAR /SET END-OF-LINE CHARACTER
- TAD [LINBUF+120 /REINITIALIZE TEXT POINTER
- DCA TXTPTR
- CLA CMA
- DCA I (INCHCT /INDICATE EMPTY BUFFER
- ISZ I (INEOF /SET END-OF-FILE
- JMP I [LOOKEX /--EXIT TO MAIN--
- PAGE
- /OUTPUT 2 CHARACTER ERROR CODE
-
-ERROR1, 0
- DCA ERROR5
- TAD ERROR5
- JMS I [RTL6
- RAL
- AND [77
- TAD [240 /CONVERT SIXBIT TO ASCII
- JMS I OERROR /OUTPUT FIRST CHAR
- TAD ERROR5
- AND [77
- TAD [240
- JMS I OERROR /OUTPUT SECOND CHAR
- JMP I ERROR1 /--RETURN--
-
-/HANDLER FOR FIELD PSEUDO-OP
-
-FIELDX,JMS I [SPNOR /IGNORE SPACES
- JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
- JMS I [DUMPZ /DUMP PAGE ZERO LITERALS
- JMS I [EXP /GET EXPRESSION
- TAD VALUE /TRIM TO RIGHT 3 BITS
- AND [7
- DCA FLDIND /STORE FOR LISTING
- TAD VALUE
- AND [30
- DCA VALUEX
- TAD PASS /IS THIS PASS 2?
- SZA CLA
- JMP FIELDY /NO - PREPARE TO EXIT
- JMS I [XCHANG /XCODE
- TAD FLDIND /YES - GET FIELD NUMBER
- CLL RTL
- RAL /AND CHANNELS 7 AND 8
- TAD [7700
- JMS I OCHAR /OUTPUT FIELD SETTING
-FIELDY, JMS I [CLEAN /CLEAN UP THINGS
- TAD [200 /RESET ORIGIN TO 200
- JMP STAR1
-
-/CHANGE LAST 2 LOCATIONS TO:
-/ CLA
-/ JMP STAR1+1
-/FOR INDAC GROUP TO OMIT RE-ORIGIN
-/HANDLER FOR PAGE PSEUDO-OP
-
-PAGEX, JMS I [DUMPS /DUMP SAME PAGE LITERALS
- JMS I (XLISTZ /ANY EXPRESSION?
- JMP PAGEY /NO
- JMS I [EXP /YES - GET EXPRESSION
- TAD VALUE
- JMS I [RTL6
- RAL /GET PAGE NUMBER
- JMP STAR3-1
-
-PAGEY, TAD LOC /NO ARGUMENT - FIND NEXT PAGE
- TAD [177
- AND [7600
-STAR3, DCA VALUE
- TAD VALUE /GET START OF PAGE
-STAR1, JMS I [PUNORG /PUNCH ORIGIN
- JMS I [FINDSP
- TAD [LITBUF /RESET POINTERS
- DCA TEMP
- TAD I TEMP
- DCA LITPTR /INITIALIZE LITERAL POINTER FOR NEW PAGE
- DCA LAST1
- DCA LININD
- JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
-
-/HANDLER FOR FIXMRI PSEUDO-OP
-
-FIXMRX, JMS I [SPNOR /IGNORE SPACES
- JMS I [TSTALP /IS CHARACTER ALPHABETIC?
- JMP FIXMR1 /YES-CONTINUE
- JMS I [ICMESG /NO - GENERATE IC MESSAGE, GET NEXT CHAR
- JMP FIXMRX+1 /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
-FIXMR1, JMS I [GETTAG /PICK UP TAG
- DCA ALPHAI /STORE UNDEFINED SWITCH
- SKP
-FIXMR2, JMS I [ICMESG
- JMS I [SPNOR /IGNORE SPACES
- TAD CHAR /WAS CHARACTER = ?
- TAD (-"=
- SZA CLA
- JMP FIXMR2 /NO - PRINT IC MESSAGE AND KEEP LOOKING
- /FALL INTO EQUALS PROCESSOR
- /HANDLER FOR =
-
- AC4000 /FALL INTO HERE FROM FIXMRI
-EQUAL, JMS I [PUSHA /PUSH FIXMRI FLAG
- JMS I [GETC /GET NEXT CHARACTER
- TAD I [NAME1 /STORE THE SYMBOL NAME
- JMS I [PUSHA /ON THE PUSH DOWN LIST
- TAD I (NAME2
- JMS I [PUSHA
- TAD I (NAME3
- JMS I [PUSHA
- TAD THISTG /AND ITS PRESENT (OR FUTURE)
- JMS I [PUSHA /POSITION IN THE SYMTAB
- TAD ALPHAI
- JMS I [PUSHA /STORE UNDEFINED INDICATOR
- JMS I [SPNOR /IGNORE SPACES
- JMS I [EXP /GET EXPRESSION TO RIGHT OF =
- TAD I PDLXR
- DCA ALPHAI /RESTORE UNDEFINED INDICATOR
- TAD I PDLXR
- DCA THISTG /RESTORE SYMBOL TABLE POSITION
- TAD I PDLXR /RESTORE TAG NAME
- DCA I (NAME3
- TAD I PDLXR
- DCA I (NAME2
- TAD I PDLXR
- DCA I [NAME1
- ISZ UNDFSW /WAS ANY PART OF DEFINITION UNDEFINED?
- JMP EQUAL3 /NO
- JMS I PERROR /YES - GENERATE IE ERROR MESSAGE
- IE
- ISZ PDLXR /CLEAR EXTRA WORD FROM PDL
- JMP I [PUNVAL /FORGET ABOUT DEFINING TAG
- /MORE = PROCESSING
-
-EQUAL3, ISZ ALPHAI /WAS TAG DEFINED BEFORE?
- JMP .+3 /YES - CHECK FOR ILLEGAL REDEFINITION
- JMS I [INSRTG /NO - INSERT TAG INTO SYMBOL TABLE
- JMP EQUAL2 /AND BYPASS ILLEGAL REDEF CHECK
- JMS I [FINDTG /PUT TAG IN TAG1-TAGE AND VALUE2
- TAD VALUE
- CIA
- TAD VALUE2
- SZA CLA /WERE DEFINITIONS THE SAME?
- TAD TAG1 /NO - IS IT A PERMANENT SYMBOL?
- SMA CLA
- JMP EQUAL2 /NO - OK TO REDEFINE
- JMS I [ERROR /YES - GENERATE RD ERROR MESSAGE FIRST
- RD
-EQUAL2, TAD VALUE /DEFINE OR REDEFINE
- DCA VALUE2
- AC3777
- AND TAG2 /CLEAR OLD FIXMRI BIT
- TAD I PDLXR /INSERT NEW ONE
- DCA TAG2
- JMS I [PUTTAG /STORE TAG
- JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
- PAGE
- /ROTATE AC 6 LEFT
-
-RTL6, 0
- CLL RTL
- RTL
- RTL
- JMP I RTL6 /--RETURN--
-
-
-/GET NEXT CHARACTER ROUTINE
-/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
-/TO THE PROGRAM
-/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED
-
-GETC, 0
- ISZ TXTPTR /POINT TO NEXT CHARACTER
-GETC7, TAD I TXTPTR /GET NEXT CHARACTER
- SZA /IS IT 0?
- JMP GETC8 /NO - MORE ARE IN THIS LINE
- TAD PASS /IS THIS PASS 3?
- SPA SNA CLA
- JMP GETC1 /NO
- TAD [LINBUF /YES
- DCA TXTPTR /RESET POINTER TO BEGINNING
- TAD I TXTPTR /GET 1ST CHARACTER
- SNA /IS IT 0?
- JMP GETC1 /YES - LINE HAS BEEN PRINTED
- TAD [-215 /IS IT 215?
- SNA CLA
- JMP GETC2 /YES - DO NOT PRINT THE SPACES
- TAD [211 /NO-OUTPUT 2 TABS
- JMS I OERROR
- TAD [211
- JMS I OERROR
-GETC2, JMS LINPRT /NOW PRINT THE LINE
-GETC1, TAD (-121
- DCA TXTSWT
- TAD (LINBUF-1
- DCA TXTPTR /RESET POINTER
- ISZ TXTPTR
-GETC6, JMS I (INPUT /GET NEXT CHARACTER
- JMP GETC4 /215
- DCA I TXTPTR /STORE THE CHARACTER
- ISZ TXTSWT /TOO MANY?
- JMP GETC6-1 /NO
- CLA CMA /YES
- DCA TXTSWT
- JMP GETC6
- GETC4, DCA I TXTPTR /SET END
- ISZ TXTPTR
- DCA I TXTPTR /SET END OF LINE
- TAD [LINBUF
- DCA TXTPTR /RESET POINTER
- CLA CMA
- DCA TXTSWT /RESET SWITCH
- JMP GETC7 /GET THAT CHARACTER
-
-GETC8, TAD [-215 /IS IT A CARRIAGE RETURN?
- SNA
- JMP GETC12 /YES-END OF LINE
- TAD GETCI /NO-
- TAD (215-"/ /IS IT A /?
- SNA /YES-
- JMP GETC13 /"/" IS END
- TAD ("/-"; /IS IT A ;?
- SNA /YES-
- JMP GETC12 /";" IS END
- TAD (";-211 /IS IT A TAB?
- SZA
- TAD (211-240 /OR A SPACE?
- SZA CLA
- JMP GETC9 /NO-NOT ANYTHING SPECIAL
- ISZ TXTSWT /YES-2ND OCCURANCE?
- JMP GETC+1 /YES - IGNORE
- TAD [240
- DCA CHAR /NO - GIVE A SPACE
- JMP I GETC /--RETURN--
-
-GETC16, ISZ CONDSW /DECREMENT CONDITIONAL COUNTER
- JMP GETC15
-GETC17, TAD [LINBUF+120
- DCA TXTPTR
-GETC12, AC4000
-GETC9, TAD I TXTPTR
- DCA CHAR /STORE CHARACTER
- CLA CMA
- DCA TXTSWT /SET THE SWITCH
- JMP I GETC /--RETURN--
- GETC13, TAD CONDSW /CURRENTLY IN CONDITIONALS?
- SNA
- JMP GETC17 /NO
- DCA CONDSW /STORE UPDATED CONDITIONAL LEVEL
-GETC15, ISZ TXTPTR /YES-SCAN LINE FOR < AND >
- TAD I TXTPTR
- TAD [-215 /IS CHARACTER A CARRIAGE RETURN?
- SNA
- JMP GETC17 /YES
- TAD (215-"> /NO IS IT A >?
- SNA
- JMP GETC16 /YES
- TAD (">-"< /NO-IS IT <?
- SNA CLA
- STA /YES - INCREMENT CONDITIONAL COUNTER
- JMP GETC13 /NO - KEEP LOOKING
-
-
-/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
-/ CARRIAGE RETURN
-/ /
-/ ;
-
-/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
-/ CARRIAGE RETURN
- /PRINT A LINE OF SOURCE CODE
-
-LINPRT, 0
- TAD (LINBUF-1
- DCA XREG1 /SET POINTER TO LINE
-LINPR1, TAD I XREG1 /GET CHARACTER
- SNA /IS IT END OF LINE?
- JMP I LINPRT /YES - END LINE
- JMS I OERROR /NO - OUTPUT CHARACTER
- DCA I [LINBUF /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
- JMP LINPR1
-
-/HANDLE PHASE ERROR
-/AND ALL ERROR EXITS TO MONITOR
-
-SYMOFL, CLA
- TAD (SE /SYMBOL TABLE EXCEEDED MESSAGE
-MONERR, DCA MONER1 /ERROR IS SERIOUS ENOUGH TO
-PHASE, TAD (OTYPEO / CAUSE IMMEDIATE RETURN TO
- DCA OERROR / MONITOR
- JMS I [ERROR
-MONER1, PH /STORE ERROR TYPE HERE
- JMP I [7600 /***EXIT TO MONITOR***
-
-
-/FIND CURRENT PAGE NUMBER
-/EXIT WITH NUMBER IN AC
-
-FINDSP, 0
- TAD LOC
- AND [7600
- JMS I [RTL6
- JMP I FINDSP /--RETURN--
- PAGE
- /**********************************************************
-/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
-/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **
-
-SWAP1=.
-
-/PASS 3 LISTING OUTPUT
-
-LISOUT, 0
- DCA LISOU2
- TAD XLISTX /IS THIS COVERED BY XLIST?
- SZA CLA
- JMP I LISOUT /YES--RETURN--
- ISZ LISCNT /NO-WAS PREVIOUS CHARACTER A 215?
- JMP LISOU1 /NO
- ISZ LINCNT /WAS IT END OF PAGE?
- JMP LISOU1 /NO
- ISZ THISPG /YES-START OVERFLOW PAGE
-BEGIAB, JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
-HSWIT1, JMS I [FORMFD /0 IF /H SWITCH OPTION TO SUPRESS PAGING
- ISZ LINCNT
-LISOU1, TAD LISOU2 /IS CHARACTER A CARRIAGE RETURN?
- TAD [-215
- SNA
- JMP LISOU3 /YES - OUTPUT CR/LF
- TAD [215 /NO - RESTORE CHARACTER
- JMS I OCHAR /OUTPUT CHARACTER
- JMP I LISOUT /--RETURN--
-
-LISOU3, CLA CMA
- DCA LISCNT /REMEMBER THE 215 FOR NEXT TIME
- JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
- JMP I LISOUT /--RETURN--
-
-LISCNT, -1
-LISOU2, 0
- /FORM FEED OUTPUT ROUTINES
-
-FORMFD, 0
- TAD LINCNT /GET LINE COUNTER
- TAD FORMLN
- SNA CLA /ARE WE AT TOP OF PAGE?
- JMP I FORMFD /YES - NO NEED FOR FORM FEED
- TAD XLISTX /IS THIS COVERED BY XLIST?
- SZA CLA
- JMP I FORMFD /YES--RETURN--
-HSWITC, JMP FORMF1 /0 IF /T OR TTY:; JMP FORMF3 IF /H
- /OUTPUT IF TTY:OR /T OPTION
- TAD LINCNT
- TAD [-4
- DCA LINCNT
- JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
- ISZ LINCNT
- JMP CRLF1 /OUTPUT LINE FEED
- /CRLF1 WILL RETURN TO
- /JMP-1 UNTIL LINCNT HAS
- /BEEN BUMPED SUFFICIENTLY
- TAD FORMM6
- DCA LINCNT
- TAD MINUS /OUTPUT ------
- JMS I OCHAR
- ISZ LINCNT /* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
-FORMF1, JMP .-3 /* STA
- TAD [-4 /* DCA LINCNT /GENERATE ONE FORM FEED
- DCA LINCNT /* STA /TURN CR INTO FF
- JMS CRLF /OUTPUT CR/LF OR FF/LF
- ISZ LINCNT
- JMP CRLF1 /OUTPUT LINE FEED
- TAD FORMLN
- CIA
- DCA LINCNT
-FORM22, TAD [HEADER-1 /OUTPUT HEADER
- DCA XREG2
- DCA LSTCNT
-FORM30, TAD I XREG2 /GET NEXT CHARACTER OF HEADING
- SNA /IS IT LAST + 1
- JMP FORM20 /YES
- JMS I OCHAR /NO-OUTPUT IT
- TAD LSTCNT
- TAD [-HEDLEN /DONE "HEDLEN" CHARACTERS YET?
- SZA CLA
- JMP FORM30 /NO-CONTINUE
- TAD FORMHD /YES-START SYSTEM HEADER
- JMP FORM22 /WHICH STARTS AT HEADER+HEDLEN
-
-FORMLN, LNPRPG
-FORMHD, HEDLEN
-MINUS, "-
- /TTY: OR /T OUTPUTS FORM FEED AS
-/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
-/------
-/CARRIAGE RETURN, 5 LINE FEEDS
-/HEADER
-/NO OPTIONS TREATS F/F AS
-/F/F, LF, CR/LF
-/HEADER
-
-/ /H OPTION TREATS F/F AS 2 CR/LF
-
-/USER HEADER IS "HEDLEN" CHARACTERS WIDE
-/ASSEMBLER HEADER ENDS WITH 0
-
-
-/OUTPUT PAGE NUMBERS
-
-FORM20, TAD EDITPG /OUTPUT EDITOR PAGE NUMBER
- JMS FORMF4
- TAD THISPG /IS THERE PAGE OVERFLOW?
- SNA CLA
-FORM21, JMP FORMF3 /NO
- TAD MINUS /YES
- JMS I OCHAR /OUTPUT -
- TAD THISPG /OUTPUT NUMBER OF OVERFLOW PAGE
- JMS FORMF4
- /OUTPUT IF /H OPTION
-FORMF3, JMS CRLF /OUTPUT 2 CR/LF
- JMS CRLF
- JMP I FORMFD /--RETURN--
- /DECIMAL PRINT ROUTINE
-
-FORMF4, 0
- DCA FORMF6 /SAVE NUMBER
- TAD FORM8F
- DCA CRLF /POINT TO DIVISION LIST
-FORM12, DCA FORMF7 /START WITH 0
- JMP .+3
-FORMF5, DCA FORMF6
- ISZ FORMF7 /ADD 1 TO DIGIT
- TAD I CRLF /SUBTRACT 1000, 100, OR 10
- SNA
- JMP FORM11 /0 IS END OF TABLE - NO MORE DIGITS
- TAD FORMF6
- SMA /OVERFLOW
- JMP FORMF5 /NO-KEEP SUBTRACTING
- CLA /YES-DIGIT DONE
- ISZ CRLF /BUMP LIST POINTER
- TAD FORMF7 /WAS DIGIT A 0?
- SNA
- JMP FORM12 /YES
- TAD ["0 /NO-MAKE IT ASCII
- JMS I OCHAR /OUTPUT DIGIT
- AC4000
- JMP FORM12 /4000 IN AC FORCES SIGNIFICANCE
-
-FORM11, TAD FORMF6 /GET LAST DIGIT (UNITS PLACE)
- TAD ["0
- JMS I OCHAR /OUTPUT DIGIT
- JMP I FORMF4 /--RETURN--
-
-FORMM6, -6
-FORM8F, FORMF8
- /OUTPUT CARRIAGE RETURN/LINE FEED
-/ENTER WITH AC=-1 TO GENERATE F/F LF
-
-HEDCL2,
-CRLF, 0
- TAD [215
- JMS I OCHAR
-CRLF1, TAD [212 /RE-ENTRY FOR MULTIPLE LINE FEEDS
- JMS I OCHAR
- JMP I CRLF /--RETURN--
-
-/CLEAR PAGE HEADING BUFFER
-
-FORMF7,
-HEDCLR, 0
- TAD [-HEDLEN /SET HEADING BUFFER
- DCA HEDCL2 /TO TABS
- TAD [HEADER-1
- DCA XREG2
- TAD [211
- DCA I XREG2
- ISZ HEDCL2
- JMP .-3
- JMP I HEDCLR /--RETURN--
- PAGE
- /SYMBOL TABLE OUTPUT (COLUMNAR)
- /*CODE TO GENERATE DDT COMPATIBLE*
- /**SYMBOL TABLE--SUBSTITUTED WITH*
- /**ONCE ONLY CODE IF NEEDED*******
- IFZERO HASH<
-
-SYMPRT, 0
- ISZ EDITPG /NEW PAGE
- DCA THISPG
- JMS I [FORMFD
- TAD SMIN67 /DCA I SYMPR6-1
- DCA SYMPR7 /JMS SYMPR9+6
-SYMPR8, DCA SYMPR2 /TAD [377 //RUBOUT
- CLA CMA /JMS I OERROR
- DCA THISTG /CLA CMA
- TAD SYMPR2 /DCA THISTG
- CMA /TAD [215 //CARRIAGE RETURN
- DCA SYMPR3 /JMS I OERROR
-SYMPR5, ISZ SYMPR3 /JMS SYMPPP
- JMP SYMPR4 /JMP SYMPR9-1
- TAD [-4 /JMP SYMPR6+2
- DCA SYMPR3 /HSWIT1
-SYMPR6, JMS SYMPPP /204 //EOT
- JMP SYMPRB
-SYMPR1, TAD [1777
- AND TAG1 /OUTPUT TAG
- JMS I SDIV45
- TAD TAG2
- JMS I SDIV45
- TAD TAG3
- JMS I SDIV45
- TAD [240
- JMS I OERROR /OUTPUT SPACE
- TAD VALUE2
- JMS OCTPRT /OUTPUT OCTAL VALUE
- ISZ SYMPR3 /JMP SYMPR5-2
- JMP SYMPR0 /TAD SYMPR6
-SYMPR9, TAD [215 /JMS I OERROR /CARRIAGE RETURN
- JMS I OERROR /TAD [377 //RUBOUT
-SYMPRB, ISZ SYMPR7 /JMS I OERROR
- JMP SYMPRA /JMS SYMPR9+6
-HSWIT2, JMS I [FORMFD /DCA LINCNT /0 IF NOT /H
- TAD SMIN67 /JMP I SYMPRT //--RETURN--
- DCA SYMPR7 /0
- TAD SYMOFS /TAD [-200
-SYMPRA, IAC /DCA SYMPR2
- TAD SYMPR2 /TAD [200 //LEADER-TRAILER
- JMP SYMPR8 /JMS I OERROR
-
-SYMPR4, JMS SYMPPP /ISZ SYMPR2
- JMP I SYMPRT /JMP SYMPR4-2 /--RETURN--
- JMP SYMPR5 /JMP I SYMPR9+6
-
-SDIV45, DIV45
-SMIN67, 1-LNPRPG
- SYMPR0, TAD SMIN67
- DCA SYMPPB
- JMS SYMPPP /SKIP 67(8) SYMBOLS
- JMP SYMPR9
- ISZ SYMPPB
- JMP .-3
- JMS I [ERROR1
- JMS I [ERROR1
- JMS I [ERROR1
- JMP SYMPR1 /GO PRINT THE 67TH(8) SYMBOL
-
-SYMPR2= LINKSW
-SYMPR3= UNDFSW
-SYMPR7= ALPHAI
-SYMPPB= CHKSUM
-
-SYMPPP, 0
- ISZ THISTG
-SYMOFS, 245
- TAD THISTG
- CLL CIA
- TAD HIGHTG
- SNL CLA
- JMP I SYMPPP /--RETURN--
- JMS I [FINDTG
- AC4000
- AND TAG1
- TAD TAG3
- SPA SZL CLA
- JMP SYMPPP+1
- ISZ SYMPPP
- JMP I SYMPPP /--RETURN--
-/SYMNCL, -4 /DEFAULT IN LIU OF =N OPTION
-/SYMOFS, 245 /OFFSET TO FIRST SYM ON NEXT PAGE
-
- >
- IFNZRO HASH<
-
-SYMPRT, 0
- ISZ EDITPG
- DCA THISPG
- JMS I [FORMFD /OUTPUT A HEADING
- JMS I SYMHND /NOW READ THE SYMBOL TABLE SORT OVERLAY
- 0200 /2 PAGES
-SYMSRT, OUDEVH+400 /TO HERE
- ASWAP+1 /FROM HERE
- JMP I SYMERR /UGH
- JMS I SYMSRT /SORT THEM AND SET LINK
-SYMNWP, DCA SYMTAG /POINT TO SYMBOL
- SZL /LINK OFF IF ANY SYMBOLS TO LIST
- JMP I SYMPRT /NONE --RETURN--
- TAD SMIN67 /SET LINE/PAGE COUNT
- DCA SYMLCT
-SYMPAG, TAD HIGHTG
- CLL CIA
- TAD SYMTAG
- SZL CLA
- JMP I SYMPRT /NO MORE IF AT HIGHTAG NOW
- TAD SYMTAG
- DCA THISTG /PREPARE TO PRINT LEFTMOST SYMBOL
- TAD SYMNCL /4 PER LINE (DEFAULT)
- DCA SYMCCT /TO COLLUMS/LINE CNTR
- JMP SYMGO
-SYMLIN, JMS I [ERROR1
- JMS I [ERROR1
- JMS I [ERROR1
- TAD HIGHTG
- CLL CIA
- TAD THISTG
- SZL CLA
- JMP SYMNXL /SKIP TO NEXT LINE IF OFF TABLE
- SYMGO, JMS I [FINDTG /OK, GET IT
- TAD TAG1
- JMS I SDIV45
- TAD TAG2
- JMS I SDIV45
- TAD TAG3
- JMS I SDIV45
- TAD [240
- JMS I OERROR
- TAD VALUE2 /PRINT VALUE NOW
- JMS OCTPRT
-SYMDDT, TAD SMIN67
- CLL CIA
- TAD THISTG
- DCA THISTG
- SZL
- JMP SYMNXL /SKIP IF WRAP AROUND
- ISZ SYMCCT /ELSE DO NEXT COLUMN
- JMP SYMLIN
-SYMNXL, TAD [215
- JMS I OERROR /CR/LF
- ISZ SYMTAG /POINT TO NEXT SYMBOL
- ISZ SYMLCT
- JMP SYMPAG
-HSWIT2, JMS I [FORMFD
- TAD SYMTAG
- CLL
- TAD SYMOFS /OFFSET TO NEXT SYMBOL
- JMP SYMNWP /DO THE NEXT PAGE
-
-SDIV45, DIV45
-SMIN67, -67
-SYMERR, SYSERR
-SYMHND, 7607
-SYMOFS, 245 /DEFAULT
-SYMNCL, -4
- SYMTAG= LINKSW
- SYMLCT= UNDFSW
- SYMCCT= ALPHAI
- ZBLOCK 4 /WASTE SOME SPACE
- >
-
-
-/END OF AREA WHICH MAY BE SWAPPED OUT
-/DURING PASSES 1 AND 2
-/**********************************************************************
-
- ENDOVL= .
- /OCTAL PRINT ROUTINE
-/ENTER WITH # TO BE OUTPUT IN AC
-/** DO NOT USE TEMPS BELOW THIS LOC!
-
-OCTPRT, 0
- DCA OCTPR1
- TAD [-4
- DCA OCTPR3
-OCTPR2, TAD OCTPR1 /GET EACH DIGIT SEPARATELY
- CLL RTL
- RAL
- DCA OCTPR1
- TAD OCTPR1
- RAL
- AND [7
- TAD ["0 /MAKE IT INTO AN ASCII CHARACTER
- JMS I OERROR /OUTPUT IT
- ISZ OCTPR3
- JMP OCTPR2
- JMP I OCTPRT /--RETURN--
-
- /OUTPUT ONE REGISTER
-
-PUNONE, 0
- TAD PASS /WHICH PASS IS THIS?
- SNA
- JMP PUNON2 /PASS 2--OUTPUT BINARY
- SPA CLA
- JMP PUNON3 /PASS 1--EXIT
- TAD VALUEX /THE BANK BIT IS
- CLL RTR /ADJUSTED TO ASCII
- RAR
- TAD ["0
- JMS I OERROR /THEN PRINTED
- TAD FLDIND /GET FIELD NUMBER
- TAD ["0 /CONVERT TO ASCII
- JMS I OERROR /PRINT IT
- TAD LOC /GET LOW ORDER 4 DIGITS (LOC CTR)
- JMS OCTPRT /PRINT IT TOO
- TAD OFFSET /IF THIS CODE IS IN A RELOC SECTION,
- SZA CLA /
- TAD [1200 /FLAG THE LOCATION COUNTER WITH A *
-DTORG1, JMS I [ERROR1 /OUTPUT 2 SPACES
- TAD VALUE
- JMS OCTPRT /OUTPUT CONTENTS
- TAD I [LINBUF /IS THERE SOURCE CODE TO DUMP?
- SNA CLA
- JMP PUNON1 /NO-OUTPUT CARRIAGE RETURN
- TAD LINKSW /YES-DUMP LINK SWITCH (' ) OR ( )
- JMS I [ERROR1
- JMS I [LINPRT /DUMP SOURCE CODE
- JMP PUNON3 /AND EXIT
-
-PUNON1, TAD LINKSW /NO LINE - OUTPUT LINK SWITCH ANYWAY
- SZA /IF THERE IS ONE
- JMS I [ERROR1
- TAD [215 /OUTPUT CARRIAGE RETURN
- JMS I OERROR
-PUNON3, DCA LINKSW /CLEAR LINK SWITCH
- JMP I PUNONE /--RETURN--
-
-/PASS 2-OUTPUT ONE REGISTER
-
-PUNON2, TAD VALUE /GET CONTENTS
- CLL
- JMS I [PUNOUT /OUTPUT AS 2 FRAMES
- JMP PUNON3 /AND EXIT
- PAGE
- /**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
-/***WHEN OVERLAYED BY PUSHDOWN LIST**
-
-/ARRANGE TO OUTPUT ONE REGISTER
-
-PUNBIN, 0
- DCA VALUE
- JMS I [FINDSP /FIND CURRENT PAGE NUMBER
- TAD [LITBUF
- DCA TEMP2 /POINT TO NUMBER OR LITERALS
- TAD LOC
- AND [177
- DCA TEMP
- TAD I TEMP2 /IS PAGE FULL?
- CIA
- TAD TEMP
- ISZ TEMP
- SPA CLA
- JMP ONEOK /NO-OK TO ADD ONE MORE REGISTER
- TAD TEMP /YES-
- DCA I TEMP2
- JMS I [FINDSP /FIND CURRENT PAGE NUMBER
- JMS I PPEZE /GENERATE PE OR ZE ERROR
-ONEOK, JMS I [FINDSP /FIND CURRENT PAGE NUMBER
- TAD [TPINST
- DCA TEMP2
- TAD TEMP /IS THIS ADDRESS HIGHER THAN PREVIOUS
- CIA /HIGH INSTRUCTION PAGE?
- TAD I TEMP2
- SMA CLA
- JMP PUNMOD /NO
- TAD TEMP /YES-THIS IS NEW HIGH INSTRUCTION
- DCA I TEMP2
-
-PUNMOD, JMS I [PUNONE /OUTPUT THIS REGISTER
- ISZ LOC /GET NEXT LOCATION
- TAD LOC /IF THE "ISZ" SKIPS IT IS O.K. (A 0)
- AND [177 /IS THIS FIRST INSTRUCTION ON NEXT PAGE?
- SZA CLA
- JMP I PUNBIN /NO--RETURN--
- JMS I [FINDSP /YES-FIND CURRENT PAGE NUMBER
- TAD [LITBUF /RESET POINTERS
- DCA TEMP2
- TAD I TEMP2
- DCA LITPTR
- JMP I PUNBIN /--RETURN--
-
-PPEZE, PEZE
- HEADER, "S;"Y;"M;"B;"O;"L;"S
- 211;211;211;211;211 /FOR /N HEADER
-
-/************************************************************
-/CODE OVERLAYED ON PASS 3
-/BY USER HEADER BUFFER
-
-/CONTINUATION OF EXPUNGE HANDLER
-/ENTER ON PASS 1 ONLY
-
-EXPUNW, IFZERO HASH<
- DCA TEMP1
- DCA EXPUN2 /CLEAR NEW HIGH TAG COUNTER
- TAD HIGHTG
- CMA
- DCA TEMP3 /SAVE NUMBER OF SYM TBL ENTRIES
-EXPUNY, TAD TEMP1
- DCA THISTG
- JMS I [FINDTG /GET A SYMBOL
- TAD TAG1 /ONLY SAVE THE SYMBOL IF
- RTL
- CLA /IT WAS A PSEUDO-OP, OR
- TAD TAG3 /THE SYMBOLS I OR Z
- SNL SMA CLA
- JMP EXPUA4 /NO-FORGET TAG
- TAD EXPUN2 /YES-RETURN TAG TO SYMBOL TABLE
- DCA THISTG
- JMS I [PUTTAG
- ISZ EXPUN2
-EXPUA4, ISZ TEMP1
- ISZ TEMP3 /DONE YET?
- JMP EXPUNY /NO- TRY NEXT TAG
- CLA CMA /YES
- TAD EXPUN2 /RESET HIGH TAG
- DCA HIGHTG
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-EXPUN2, 0
- >
- IFNZRO HASH<
- /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
- /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)
-
- DCA THISTG /POINT TO FIRST ENTRY
- TAD TAGMAX /SET THE COUNT
- CIA
- DCA TEMP1
-EXPUNL, JMS I [FINDTG /GO GET ONE
- TAD TAG1
- RTL
- CLA
- TAD TAG3
- SPA SZL CLA /PSEUDO OP?
- JMP EXPUNS /YES, SKIP DELETION
- DCA TAG1 /NO, WIPE IT
- DCA TAG2
- DCA TAG3
- JMS I [PUTTAG /AND PUT IT BACK
- STA
- TAD HIGHTG
- DCA HIGHTG /DECREMENT SYMBOL COUNT
-EXPUNS, ISZ THISTG /POINT TO NEXT ENTRY
- ISZ TEMP1 /TALLY COUNT
- JMP EXPUNL /GET ANOTHER
- JMP I [LOOKEX /DONE --RETURN--
- >
-
-/***************************************************************
- /ASSEMBLER HEADER BUFFER
-
- ZBLOCK HEADER+HEDLEN-.
-
- " ;" ;"P;"A;"L;"8;"-
- "V;"1;VERSION-12+"0;SUBVERSION
- "
-DATE, "N;"O;" ;"D;"A;"T;"E;" /GETS SET TO DD-MMM-YY IF DATE PRESENT
- " ;" ;"P;"A;"G;"E;" ;0
- /PUSHDOWN LIST
-/OCCUPIES NEXT 43(8) LOCATIONS
-PDLND=.
-
-
-
-/*********************************************************
-/ONCE ONLY CODE FOR /D OPTION
-/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
-/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST
-
-DSWIT1, IFZERO HASH<
- RELOC SYMPRT+4
-
- DCA I SYMPRF
- JMS SYMPRC
- TAD [377
- JMS I OERROR
- CLA CMA
- DCA THISTG
-SYMPRE, TAD [215
- JMS I OERROR
- JMS SYMPPP
- JMP SYMPRD
- JMP SYMPR1
-SYMPRF, HSWIT1
-SYM204, 204
- RELOC
-
- >
- IFNZRO HASH<
- RELOC SYMNWP
- DCA THISTG
- DCA I SYMHSW
- JMS DDTLDR
- TAD [377
- JMS I OERROR
-SYMLUP, TAD [215
- JMS I OERROR
- TAD HIGHTG
- CLL CIA
- TAD THISTG
- SZL CLA
- JMP SYMXIT
- JMP SYMGO
-SYMHSW, HSWIT1
- RELOC
- >
-DSWITA= .
-
-/**********************************************************
- PAGE
- /*************************************************************
-
-/PAL8 TABLES - LOAD OVER INITIALIZATION CODE
-
-PDLST= PDLND+42 /PUSHDOWN LIST 43(8) LOCS LONG
-
-
-LINBUF= PDLST+1 /LINE BUFFER OCCUPIES 122(8) LOCATIONS
-
-LITBUF= LINBUF+122 /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
- / SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS
-
-TPINST= LITBUF+40 /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
- / SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS
-
-LITBF2= TPINST+40-17 /LITERAL BUFFER 2 CONTAINS UP TO 160(8)
- /PAGE 0 LITERALS, SUBSCRIPTS 20-177
-
-LITBF1= LITBF2+200-100 /LITERAL BUFFER 1 CONTAINS UP TO 100(8)
- /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177
-
-/*************************************************************
- /ONCE ONLY CODE FOR ASSEMBLER START UP
-/OVERLAYED BY BUFFERS
-
-/HANDLES SWITCH OPTIONS
-
-BEGIN, CIF 10
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 5 /*COMMAND DECODER*
- 2001 /DEFAULT INPUT EXTENSION IS .PA
-NOCD, CDF 10 /RETURN
- TAD I (7604 /IS THERE A BINARY FILE EXTENSION?
- SNA
- TAD (216 /NO - DEFAULT EXTENSION IS .BN
- DCA I (7604 /YES
- TAD I (7611 /IS THERE A LISTING FILE EXTENSION?
- SNA
- TAD (1423 /NO - DEFAULT EXTENSION IS .LS
- DCA I (7611
- TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED?
- CDF
- AND (20
-ZT7640, SNA CLA
- JMP BEGINA /NO
-BEGIAA, DCA I (HSWITC /YES - GENERATE CR/LF IN PLACE OF F/F
- JMP BEGIN2
-
-BEGINA, TAD [7605 /WAS TTY THE PASS 3 DEVICE?
- JMS I (OTYPE
- AND (770
- SNA CLA
- JMP BEGIAA /YES - GENERATE CR/LF IN PLACE OF F/F
- DCA I (BEGIAB /NOT /T OR TTY:
-
-BEGIN2, CDF 10
- TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED?
- CDF
- AND (40
- SZA CLA
- DCA I (SSWITC /YES -OMIT SYMBOL TABLE
- CDF 10
- AC2000
- AND I (MPARAM+1
- CDF
- SNA CLA /WAS THE /N OPTION SELECTED?
- JMP BEGIN4 /NO
- TAD BEGSKP /SET SWITCH
- DCA I (NSWITC /YES -SYMBOL TABLE BUT NO LISTING
- BEGIN4, CDF 10
- TAD I (MPARAM /WAS THE /H OPTION SELECTED?
- CDF
- AND (20
-ZH7640, SNA CLA
- JMP BEGINB /NO
-BEGHSW, TAD I (FORM21 /YES -SUPPRESS LISTING PAGE FORMAT
- DCA I (HSWITC
- DCA I (HSWIT1
-BEGSKP, CLA SKP
-BEGINB, DCA I (HSWIT2
- CDF 10
- TAD I (MPARAM /WAS THE /D OPTION SELECTED?
- CDF
- AND [400
-ZD7640, SNA CLA
- JMP BEGIN1 /NO
- TAD I XREG1 /YES -DDT COMPATIBLE SYMBOL TABLE
- DCA I LAST3 /SUBSTITUTE ALTERNATE CODE
- ISZ DSWIT3 /INTO SYMBOL TABLE OUTPUT ROUTINE
- JMP .-3
- TAD I XREG2
- DCA I LAST4
- ISZ DSWIT4
- JMP .-3
-
-BEGIN1, TAD I (JSBITS /RESET JOB STATUS WORD TO
- AND (6777 /INDICATE PAL8 NOT RESTARTABLE
- TAD (1000
- DCA I (JSBITS
- CIF CDF 10
- JMS I (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE
- JMP I (BEGINZ /CONTINUE ON
-
-DSWIT3, DSWIT1-DSWITA
-DSWIT4, DSWIT2-DSWITB
- PAGE
- /ONCE ONLY CODE CONTINUED
-/ASSEMBLER INITIALIZATION PROCEDURES
-
-
-BEGINZ, TAD [7600 /WHAT DEVICE FOR BINARY OUTPUT?
- JMS I (OTYPE
- SMA CLA
- TAD (-70 /STAND-ALONE
- TAD (-10 /DIRECTORY
- DCA I (SWAPR2+LEADER /SET AMOUNT OF LEADER TRAILER
- DCA LAST1 /NO DEFINED TAG
-BEGIN5, IFZERO HASH<
- CDF
- TAD I BLK1 /MOVE SYMBOL TABLE TO FIELD 1
- CDF 10
- DCA I BLK2
- ISZ BLK1
- ISZ BLK2
- ISZ BLK3
- JMP BEGIN5
- >
- CDF
- DCA I [LINBUF+120 /SET BUFFER POINTERS
- DCA I (LINBUF+121
- TAD [7600 /IS PTP BINARY OUTPUT DEVICE?
- JMS I (OTYPE
- DCA BLK1
- TAD BLK1
- AND (770
- TAD (-20
- SNA CLA
- DCA I (PTPSW /YES - SET PTP SWITCH
- TAD BLK1 /NO - IS IT A DIRECTORY DEVICE?
- SPA CLA
- JMP .+3 /NO
- TAD (TAD [77 /YES - SET DIRECTORY SWITCH
- DCA I (DIRSW
- TAD [7605 /IS PTP GETTING LISTING OUTPUT?
- JMS I (OTYPE
- AND (770
- TAD (-20
- SNA CLA
- DCA I (SWAPR2+PTPSW1 /YES - SET PASS 3 PTP SWITCH
- TAD [7605 /NO - IS DIRECTORY DEVICE GETTING
- JMS I (OTYPE /LISTING OUTPUT?
- SPA CLA
- JMP .+3 /NO
- TAD (TAD [77 /YES - SET PASS 3 DIRECTORY SWITCH
- DCA I (SWAPR2+DIRSW1
- JMP I (BEGINF
- MONLST, TEXT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
- *.-1
-
-/CONTINUED CHECK OF COMMAND DECODER OPTIONS
-
-BEGINH, CDF 10
- TAD I (MPARAM /WAS THE /G OR /L OPTION CHOSEN?
- CDF
- AND (41
- SNA CLA
- JMP I (BEGISW /NO
- CDF 10 /YES
- TAD I [7600
- SZA CLA /WAS THERE A BINARY OUTPUT FILE?
- JMP YESBIN /YES
-BINLOP, TAD PALBIN /NO - CREATE FILE PAL8BN.TM
- DCA I PALBIX /ON SYSTEM DEVICE
- ISZ BINLOP
- ISZ PALBIX
- ISZ BINCNT
- JMP BINLOP
- CDF
- TAD (-10 /SET AMOUNT OF LEADER TRAILER
- DCA I (SWAPR2+LEADER
- /SET UP FOR LOAD OR LOAD AND GO
-
-YESBIN, CDF
- CIF 10
- CLA IAC
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 2 /* LOOKUP PERMANENT FILE *
-LOAD, PLOAD /FILENAME ABSLDR.SV
-BINCNT, -5 /FILE LENGTH
- JMP NOLOAD /ABSLDR.SV NOT FOUND
- TAD LOAD /NORMAL RETURN
- DCA I (CHAIN /SET STARTING BLOCK NUMBER
- DCA I (LSWITC /FOR CHAIN CALL
- JMP I (BEGISW
-
-NOLOAD, JMS I [ERROR /GENERATE LD ERROR MESSAGE
- LD
- JMP I (BEGISW /ASSEMBLE BUT DO NOT CHAIN TO LOADER
-
-BLK1, SYMS
-BLK2, 7600+SYMS-SYME
-BLK3, SYMS-SYME
-
-PALBIX, 7600
-PALBIN, 1
- FILENAME PAL8BN.TM
- PAGE
- CCC, TAD I CC231 /FINAL PIECE OF STARTUP ONCE-ONLY CODE
- SNA
- TAD CC23
- DCA I CC231 /"HSWITC"=JMP FORMF1 IF WAS 0
-BEGISW, CDF 10
- TAD I CCJWD
- CDF 0
- AND CCJBIT
-ZJ7640, SNA CLA /WAS /J OPTION SPECIFIED?
- DCA I CCJLOC /NO - PRINT UNASSEMBLED CONDITIONAL CODE
- CDF 10
- TAD I CCWWD
- CDF 0
- AND CCWBIT
-ZW7640, SNA CLA /WAS /W OPTION SPECIFIED?
- JMP D4 /V3C
-D5, TAD I CC231
- CIA
- TAD CC23
- SZA CLA /ARE WE OUTPUTTING FF'S IN LISTING?
- JMP BEGIS3 /NO
- TAD CC24 /YES - SUBSTITUTE SOME CODE
- DCA I CC25
- TAD CC26
- DCA I CC27
- TAD CC24
- DCA I CC28
-BEGIS3, JMS I OVLL7 /CALL SYSTEM DEVICE
- 4200 /WRITE 2 PAGES
- SWAP1 /FORM SWAP1
- ASWAP /INTO TEMP AREA
- JMP I OVLL8 /ERROR?!
- TAD I LAST2 /MOVE PASS 1&2 ONLY CODE
- DCA I TAGXR /OVER PASS3 SWAPPED OUT CODE
- ISZ CC29
- JMP .-3
- IFNZRO HASH<
- JMS I CCHSH /FINALLY HASH OUT THE TABLE
- >
-
- JMP I .+1
- START2-1 /OK - NOW GO DO SOME ASSEMBLING!
-D4, DCA I CCWLOC /NO - DON'T WIPE LITERALS AS YOU DUMP THEM
- DCA I (D3
- JMP D5 /V3C
- OVLL7, 7607
-OVLL8, SYSER3
-
-CC231, HSWITC
-CC23, FORMF1&177+5200
-CC24, STA
-CC25, FORMF1
-CC26, DCA LINCNT
-CC27, FORMF1+1
-CC28, FORMF1+2
-CC29, SWAPB2-SWAPE2
-
- IFNZRO HASH<
-CCHSH, HSHSMS
- >
-CCJWD, MPARAM
-CCJBIT, 4
-CCJLOC, IFTST4
-CCWWD, MPARAM+1
-CCWBIT, 2
-CCWLOC, LITHAK
-PLOAD, FILENAME ABSLDR.SV
-
-CKBAT, TAD I CC7777 /GET BATCH FLAG WORD
- CLL RTL
- SNL CLA /BATCH RUNNING?
- JMP I CCOPTM /NO, GO WITH LINK OFF
- TAD I CC7777
- AND CC0070 /GET BATCH FIELD
- TAD CCCIF0 /FORM CIF TO BATCH FIELD
- DCA OTYPB1 /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
- TAD CCJMSB /LOG INSTEAD
- DCA OTYPB2
- TAD OTYPTD
- DCA OTYPB3
- JMP I CCOPTM /RETURN TO CORE DETERMINER, LINK SET
-
-CC7777, 7777
-CCOPTM, OPTIM4
-CC0070, 70
-CCCIF0, CIF 0
-CCJMSB, JMS I [BATOUT
- /THIS CODE SITS AFTER THE END OF THE LITERAL TABLE
-
- IFNZRO .-LITBF1-200&4000 <*LITBF1+200>
-
-OTYPEO, 0 /TYPE A CHARACTER, CHECKING FOR ^O AND ^C
- DCA OTYPEC /SAVE CHAR
- JMS CTCCHK /CHECK FOR ^C - RETURN CHAR-203 IN AC
- TAD (-14
- SNA CLA /^O?
- JMP I OTYPEO /YES
-OTYPTD, TAD OTYPEC
-OTYPB1, TLS
-OTYPB2, TSF
-OTYPB3, JMP .-1 /WAIT FOR TTY
- TAD [-215
-OTYPCR, SZA CLA /SET TO CLA DURING "ERRORS DETECTED" STUFF
- JMP I OTYPEO
- TAD [212 /IF CHAR WAS CR, TYPE LF
- JMP OTYPEO+1
-OTYPEC, 0
-
-CTCCHK, 0 /CHECK FOR ^C
- TAD [200
- KRS /OR IN KEYBOARD CHAR
- TAD (-203
- SNA
- KSF /3B BUT WAS CHAR REALLY THERE?
- JMP I CTCCHK /NO ^C - RETURN
- JMP I [7600 /RETURN TO OS/8
-
-TTLMSG, "E-240^100+"R-240 /ERRORS DETECTED:
- "R-240^100+"O-240
- "R-240^100+"S-240
- "D-240
- "E-240^100+"T-240
- "E-240^100+"C-240
- "T-240^100+"E-240
- "D-240^100+":-240
- 0
-
- "L-240^100+"I-240 /LINKS GENERATED:
- "N-240^100+"K-240
- "S-240^100
- "G-240^100+"E-240
- "N-240^100+"E-240
- "R-240^100+"A-240
- "T-240^100+"E-240
- "D-240^100+":-240
- 0
- PAGE
- /OUTPUT A CHARACTER TO OUTPUT DEVICE
-/CALLED BY JMS I OCHAR
-/WITH CHARACTER IN 8-BIT ASCII IN AC
-
-OUTPT1, PUNCHX /PASS 2=PUNCHX; 3=XLISTX
-
-OUTPUT, 0
- AND [377 /MASK OUT LEFT 4 BITS
- DCA OUTPT2 /STORE
- TAD I OUTPT1 /IS THIS PASS 3 AND
- SNA
- TAD OUTINH /IS THIS COVERED BY XLIST?
- SZA CLA
- JMP I OUTPUT /YES--RETURN--
- TAD OUTPT2 /NO - GET CHARACTER
- AND [200
- SNA CLA
- TAD OUTPT2 /IF LESS THAN 200, THEN
- TAD CHKSUM /ADD IT TO CHECKSUM
- DCA CHKSUM
- TAD OUTPT2 /GET CHARACTER
- TAD (-211 /IS IT A TAB?
- SNA CLA
- JMP OUTPT3 /YES - OUTPUT SPACES
- JMS OUTPUX /NO - OUTPUT CHARACTER
- TAD OUTPT2 /IS IT LINE FEED?
- TAD (-212
- SZA CLA
- JMP I OUTPUT /NO--RETURN--
- TAD [7773 /YES - RESET LSTCNT
- DCA LSTCNT
- JMP I OUTPUT /--RETURN--
-
- /OUTPUT SPACES INSTEAD OF TAB
-
-OUTPT3, TAD [240
- DCA OUTPT2
- JMS OUTPUX /OUTPUT SPACE
- TAD LSTCNT /TAB STOPS ARE EVERY 8 SPACES
- AND [7
- SZA CLA
- JMP .-4
- JMP I OUTPUT /--RETURN--
-
-/OUTPUT THE CHARACTER
-/PACKS CHARACTERS IN STANDARD OS/8 FORMAT
-
-OUTPUX, 0
- ISZ OUJMP /BUMP 3-WAY SWITCH
-OUJMP, HLT /WILL BE CHANGED - SHOULD NEVER HALT
- JMP OCHAR1 /CHARACTER #1
- JMP OCHAR2 /CHARACTER #2
-OCHAR3, TAD OUTPT2 /CHARACTER #3
- CLL RTL
- RTL
- AND [7400
- TAD I OUPOLD /ADD 4 BITS TO WORD 1
- DCA I OUPOLD
- TAD OUTPT2
- CLL RTR
- RTR
- RAR
- AND [7400
- TAD I OUPTR /ADD 4 BITS TO WORD 2
- DCA I OUPTR
- TAD OUJMPE
- DCA OUJMP /RESET SWITCH
- ISZ OUPTR
- ISZ OUDWCT /BUFFER FULL?
- JMP OUCHLV /NO
- TAD [200 /YES
- JMS I (OUTDMP /DUMP BUFFER
- JMS OUSETP /RESET POINTERS
- JMP OUCHLV
-
- OCHAR2, TAD OUPTR /SAVE POINTER
- DCA OUPOLD
- ISZ OUPTR
-OCHAR1, TAD OUTPT2
- DCA I OUPTR /SET 8 BIT WORD
-OUCHLV, TAD OUTPT2
-/ TAD [40
-/ AND [100 /CHECK FOR PRINTABLE CHAR
-/ SZA CLA /IF IT IS,
- TAD [-240
- SMA CLA
- ISZ LSTCNT /BUMP TAB COUNT
-OUTINH, 0 /ALWAYS 0 OR 1!
- JMP I OUTPUX /--RETURN--
-
-OUPOLD, 0
-OUPTR, 0
-OUJMPE, JMP OUJMP
-OUDWCT, 0
-OUTPT2, 0
-
-OUSETP, 0
- TAD [7600 /SET OUTPUT WORD COUNT
- DCA OUDWCT /TO 200
- TAD (OUBUF
- DCA OUPTR /RESET POINTER
- TAD OUJMPE
- DCA OUJMP /RESET SWITCH
- CLL /MUST CLEAR LINK!!
- JMP I OUSETP /--RETURN--
- /HANDLER FOR DEVICE PSEUDO-OP
-
-DEVICX, JMS I [SPNOR /IGNORE TRAILING SPACES
- TAD [-5
- JMP DEVIC1 /PACK 4 CHARACTERS
-
-
-/HANDLER FOR FILENAME PSEUDO-OP
-
-FILENX, JMS I [SPNOR /IGNORE TRAILING SPACES
- TAD (-7
- JMS FILE1 /PACK 6 CHARACTERS
- TAD CHAR
- TAD [-". /WAS CHARACTER . ?
- SNA CLA
- JMS I [GETC /YES-SKIP TO EXTENSION
- AC7775
-DEVIC1, JMS FILE1 /PACK 2 CHARACTERS
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-/PACK CHARACTERS
-/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY
-
-FILE1, 0
- DCA FILE6 /SAVE # OF CHARACTERS TO PACK
- DCA I (TEXT6 /RESET PACK SWITCH
-FILE4, JMS I (TSTALN /IS CHARACTER IN CHAR ALPHANUMERIC?
- SKP
- JMP FILE5 /NO-DONE PACKING
- ISZ FILE6 /YES-TOO MANY CHARACTERS?
- JMP FILE3 /NO-O.K.
- CLA CMA /YES
- DCA FILE6 /RESET # OF CHARACTERS AND IGNORE
- JMP FILE2
-
-FILE3, TAD CHAR
- JMS I (TEXT2 /PACK A CHARACTER
-FILE2, JMS I [GETC /GET A CHARACTER
- JMP FILE4 /TEST IT
-
- JMS I (TEXT2 /PACK A ZERO CHAR
-FILE5, ISZ FILE6 /ARE WE DONE?
- JMP .-2 /NO - PAD WITH ZEROES
- JMP I FILE1 /YES--RETURN--
-FILE6, 0
- PAGE
- /HANDLER FOR TEXT PSEUDO-OP
-/SPACES ARE IGNORED TO DELIMITER
-/DELIMITER IS FIRST PRINTING CHARACTER
-/OTHER THAN SPACE
-/NON-PRINTING CHARACTERS ARE ILLEGAL
-/A PRINTING CHARACTER HAS EITHER BIT 5
-/OR BIT 6 SET, BUT NOT BOTH
-
-TEXT8, JMS I [GETC /GET NEXT CHARACTER
-TEXTX, CLL CLA CML RAR /AC=4000
- DCA GETCI /; AND / ARE NOT END OF LINE
- JMS TEXT1A /CHECK FOR PRINTING CHARACTER
- JMP TEXT8 /NON PRINTING - IGNORE
- TAD [-240 /IGNORE SPACES UNTIL DELIMITER
- SNA /HAS BEEN FOUND
- JMP TEXT8
- TAD [240 /RESTORE CHARACTER
- CIA
- DCA VALUE2 /STORE NEGATIVE DELIMITER
- DCA TEXT6 /SET PACKING SWITCH
-TEXT3, JMS I [GETC /GET NEXT CHARACTER
- JMS TEXT1A /IS IT A PRINTING CHARACTER?
- JMP TEXT9 /NO - IC
- TAD VALUE2 /YES - IS IT DELIMITER?
- SNA CLA
- JMP TEXT4 /YES - TERMINATE
- TAD CHAR /NO - PACK AND OUTPUT
- JMS TEXT2 /PACK IT
- JMP TEXT3
-
-TEXT4, DCA GETCI /RESET GETCI TO CALL ; AND / END OF LINE
- JMS I [GETC /SKIP DELIMITER
-TEXT4X, JMS TEXT2 /OUTPUT 0 TO FILE
- JMS TEXT2
-/CHANGE TEXT4X TO:
-/ NOP
-/FOR NO EXTRA WORD OF ZEROS
- DCA GETCI /RESET GETCI IN CASE WE HIT CR
- JMP I [LOOKEX /--EXIT TO MAIN--
- TEXT9, JMS I [ERROR /GENERATE IC ERROR MESSAGE
- IC
- JMP TEXT3
-
-/SKIP ON PRINTING CHARACTER
-
-TEXT1A, 0
- TAD CHAR
- SPA SNA CLA /IS CHARACTER -
- JMP TEXT4X /YES
- TAD CHAR
- TAD [40
- AND [100
- SZA CLA /IS THE CHAR PRINTING?
- ISZ TEXT1A /YES - INCREMENT RETURN
- TAD CHAR /WITH CHARACTER IN AC
- JMP I TEXT1A /--RETURN--
-
-/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
-/ENTER WITH CHARACTERS IN AC
-
-TEXT2, 0
- AND [77 /GET RIGHT 6 BITS
- ISZ TEXT6 /WHICH HALF OF WORD?
- JMP TEXT5 /LEFT
- TAD TEXT7 /RIGHT--ADD IN LEFT HALF
- JMS I [PUNBIN /OUTPUT IT
- JMP I TEXT2 /--RETURN--
-
-TEXT5, JMS I [RTL6 /GET LEFT HALF OF WORD
- DCA TEXT7 /SAVE IT
- CLA CMA /SET SWITCH FOR RIGHT HALF
- DCA TEXT6
- JMP I TEXT2 /--RETURN--
-
-TEXT6, 0
-TEXT7, 0
- /HANDLER FOR EXPUNGE PSEUDO-OP
-
-EXPUNX, TAD PASS /IS THIS PASS 1
- SMA CLA
- JMP I [LOOKEX /NO--EXIT TO MAIN--
- JMP I (EXPUNW /YES-CONTINUE AT EXPUNW
-
-
-
-/CLOSE OUTPUT FILE
-
-OCLOSE, 0
- TAD I (OUTINH /OUTPUT INHIBITED?
- SZA CLA
- JMP I OCLOSE /YES--RETURN--
-PTPSW, TAD [232 /NO-0 IF PTP: - OUTPUT ^Z
- JMS I OCHAR
- JMS I OCHAR /AND ZEROS
-FILLLP, JMS I OCHAR
-DIRSW, TAD [177 /TAD [77 IF NOT DIRECTORY
- AND I (OUDWCT /FILL OUT BUFFER OR HALF BUFFER
- SZA CLA /WITH ZEROS
- JMP FILLLP
- TAD I (OUDWCT /IS THERE OUTPUT TO BE DUMPED?
- TAD [200
- SZA
- JMS OUTDMP /YES - DUMP IT
- TAD OUFILE /GET DEVICE NUMBER IN AC
- CIF 10
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 4 /*CLOSE OUTPUT FILE*
-OUCNAM, 0 /POINTER TO FILENAME TO BE DELETED
-OUCCNT, 0 /LENGTH OF NEW PERMANENT FILE
- JMP SYSER3 /DE**FATAL ERROR**
- JMP I OCLOSE /--RETURN--
-
-OUFILE, ZBLOCK 5
- /OUTPUT DUMP
-/AC CONTAINS CONTROL WORD FOR DUMP
-
-OUTDMP, 0
- TAD [4000 /BE SURE CONTROL WORD IS
- DCA OUCTLW /A WRITE OPERATION
- TAD OUBLK /GET STARTING BLOCK NUMBER
- TAD OUCCNT /ADD IN COUNT
- DCA OUREC /SET THIS BLOCK NUMBER
- TAD OUCTLW
- TAD [100 /ROUND HALF-BLOCK, IF ANY
- CLL RTL
- RTL
- RTL
- AND [17 /GET THIS COUNT
- TAD OUCCNT
- DCA OUCCNT /ADD TO TOTAL COUNT
- TAD OUCCNT /IS OUTPUT DEVICE FULL?
- CLL CML
- TAD OUELEN /CHECK AGAINST MAXIMUM LENGTH
- SNL SZA CLA
- JMP SYSER2 /DF**FATAL ERROR**
- JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER
-OUCTLW, 0 /CONTROL WORD
- OUBUF /BEGINNING OF OUTPUT BUFFER
-OUREC, 0 /STARTING BLOCK NUMBER
-SYSER3, CLA SKP /ERROR RETURN
- JMP I OUTDMP /--RETURN--
-SYSERR, TAD (DE /DE **FATAL ERROR**
- JMP I [MONERR
-
-OUHNDL, 0
-OUBLK, 0
-OUELEN, 0
-
-SYSER2, TAD (DF /GENERATE DF ERROR MESSAGE
- JMP I [MONERR /**FATAL ERROR**
- PAGE
- /MAINLINE CODE
-
-LOOKE2, 0 /WAS THIS END OF LINE
- TAD CHAR / OR END OF CONDITIONAL?
- TAD [-">
- SNA
- JMP CONEND /END OF CONDITIONAL
- TAD (">
- SMA CLA
- JMP I LOOKE2 /NOT END OF LINE--RETURN--
-LOOKE1, JMS I [GETC /GET A CHARACTER
-MAIN, JMS I (CTCCHK /CHECK FOR ^C
- CLA /** CTCCHK RETURNS AC NON-ZERO!
- JMS I [SPNOR /IGNORE SPACES
- TAD CHAR
- TAD (-"$ /WAS IT $ ?
- SNA /YES--
- JMP I (ENDPAS /NO-END THIS PASS
- TAD ("$-"*
- SNA CLA /WAS IT * ?
- JMP STAR /YES-HANDLE *
- JMS I [TSTALP /NO-WAS IT ALPHABETIC?
- JMP ALPHA /YES
- JMS LOOKE2 /NO
-TOEXP, JMS I [EXP /GET REST OF EXPRESSION
- TAD LININD
- DCA LINKSW /STORE LINK SWITCH
- TAD VALUE
- JMS I [PUNBIN /OUTPUT THE REGISTER
-LOOKEX, JMS I [SPNOR /IGNORE TRAILING SPACES
- JMS LOOKE2 /IS LINE ENDED?
-ILCHAR, JMS I [ERROR /NO-GENERATE IC ERROR MESSAGE
- IC
- JMP CONEN1
-
-CONEND, TAD CONDSW /ARE WE INTO CONDITIONALS?
- SNA
- JMP ILCHAR /NO - > IS ILLEGAL
- IAC /ONE LESS CONDITIONAL
- DCA CONDSW
-CONEN1, JMS I [GETC /GET NEXT CHARACTER
- JMP LOOKEX /AND TRY FOR END AGAIN
- /HANDLER FOR *
-
-STAR, JMS I [GETC /GET NEXT CHARACTER AFTER *
- JMS I [SPNOR /IGNORE SPACES
- JMS I [EXP /GET REST OF EXPRESSION
-STAR0, DCA STARSW /ENTER HERE FROM RELOC WITH AC = -1
- ISZ UNDFSW /WAS ANYTHING UNDEFINED?
- JMP .+3
- JMS I [ERROR /YES-GENERATE UO ERROR MESSAGE
- UO
- TAD VALUE /NO
- DCA OP
- TAD LOC /IS THIS THE SAME PAGE AS
- AND [7600 /THE PREVIOUS CODE?
- CIA
- TAD OP
- AND [7600
- SNA CLA
- JMP STAR2 /YES-PUNCH ORIGIN
- JMS I [DUMPS /NO-DUMP LITERALS
- TAD OFSBUF /SET OFFSET TO NEW VALUE
- DCA OFFSET /AFTER LITERALS ARE DUMPED.
- TAD OP /PUNCH NEW ORIGIN, SET "VALUE"
- JMP I (STAR3 /FOR LISTING, AND SET UP IN NEW PAGE
-
-STAR2, TAD OFSBUF /SET OFFSET TO NEW VALUE
- DCA OFFSET /
- TAD OP
- JMS I [PUNORG /PUNCH ORIGIN
- DCA LAST1 /CLEAR LAST DEFINED SYMBOL
- JMP I [PUNVAL
-
-ALPHA, JMS I [GETTAG /PICK UP TAG-IS IT IN TABLE?
- DCA ALPHAI /STORE UNDEFINED TAG SWITCH
- TAD TAG3 /IS IT A PSEUDO-OP?
- SPA CLA
- JMP I VALUE2 /YES-GO TO ITS HANDLER
- TAD CHAR /NO
- TAD (-", /WAS IT TERMINATED BY , ?
- SNA
- JMP COMMA /YES-DEFINE THE SYMBOL
- TAD (",-"= /NO-WAS IT TERMINATED BY = ?
- SNA CLA
- JMP I (EQUAL /YES-EQUATE THE SYMBOL
- AC4000 /NO
- JMP TOEXP /TREAT AS AN EXPRESSION
- /HANDLER FOR ,
-
-COMMA, JMS I [GETC /GET NEXT CHARACTER
- ISZ ALPHAI /WAS TAG DEFINED PREVIOUSLY?
- JMP COMMA2 /YES
- TAD LOC /NO-STORE CURRENT ADDRESS FOR DEFINITION
- DCA VALUE2
- JMS I [INSRTG /PUT TAG IN SYMBOL TABLE
-COMMA1, TAD TAG1 /STORE FOR ERROR MESSAGE OUTPUT
- DCA LAST1
- TAD TAG2
- DCA LAST2
- TAD TAG3
- DCA LAST3
- TAD VALUE2
- DCA LAST4
- JMP MAIN /--EXIT TO MAIN--
-
-COMMA2, TAD LOC /DO NEW AND OLD DEFINITIONS AGREE?
- CIA
- TAD VALUE2
- SNA CLA
- JMP COMMA1 /YES-ALLOW REDEFINITION
- JMS I [ERROR /NO-GENERATE ID ERROR MESSAGE
- ID
- JMP MAIN /--EXIT TO MAIN--
- OPTABL, OP0 /+
- OP1 /-
- OP6 /%
- OP2 /&
- OP5 /(SPACE)
-OPEXPL, OP5 /! - CHANGED TO OP3 IF /B ON
- OP4 /^
-XCHANG, 0
- TAD VALUE
- AND [30
- SNA
- JMP .+3
- TAD [7700
- JMS I OCHAR
- JMP I XCHANG
- PAGE
- /EXPRESSION PROCESSOR
-/POSSIBLE RECURSIVE ENTRY
-/ENTER WITH CHARACTER IN CHAR
-
-EXP, 0
- DCA EXPIND /SET INDICATOR (NOT 0 IF NO MRI FOUND)
- DCA LININD /CLEAR LINK GENERATED SWITCH (' )
- DCA VALUE /START WITH "VALUE" = 0
- DCA UNDFSW /CLEAR UNDIFINED SWITCH
- TAD EXP
- JMS I [PUSHA /SAVE RETURN ADDRESS
- DCA OP /OP=0; ADD
- TAD EXPIND
- SPA CLA
- JMP I (EXPINT
- TAD CHAR /IS CHARACTER A + ?
- TAD (-"+
- CLL RTR /PUT THE 2 BIT IN THE LINK
- SZA CLA /WAS CHAR 53(+) OR 55(-)?
- JMP EXP1A /NO
- RAL /YES - OP IS 0 OR 1, DEPENDING
-EXP1, DCA OP
- JMS I [GETC /GET NEXT CHARACTER
- ISZ EXPIND /MRI NO LONGER LEGAL ON THIS LINE
-EXP1A, TAD CHAR /IS CHARACTER A . ?
- TAD [-".
- SNA
- JMP PERIOD /YES-GO TO . HANDLER
- TAD (".-"" /NO-IS IT " ?
- SNA
- JMP QUOTE /YES-GO TO " HANDLER
- TAD (""-"[ /NO-IS IT [ ?
- CLL
- SZA
- TAD ("[-"( /OR (?
- SNA CLA
- JMP I (LIT /YES - LITERAL - LINK HOLDS WHICH KIND
- JMS I [TSTALP /NO-IS IT ALPHABETIC?
- JMP I (ALPHA1 /YES-HANDLE SYMBOL
- JMS I [TSTNUM /NO-IS IT NUMERIC?
- JMP NUMBER /YES-HANDLE NUMBER
-
-EXP2, JMS ENDCHK /NO-CHECK FOR END
- JMP EXP1A /NOGO - TRY AGAIN
- TAD OP
- TAD [-4 /IS OP SPACE (4)
- SNA CLA
- JMP I (EXPXIT /YES-EXIT
- JMS I [ERROR
- IC /GIVE IC MESSAGE ON ILLEGAL OPERATOR
- JMP I (EXPINT /EXIT ANYWAY
- /END OF EXPRESSION CHECK
-/SKIP IF OK
-
-ENDCHK, 0
- TAD CHAR
- TAD (-"] /IS CHARACTER A ] ?
- SZA /YES-SKIP A EXIT
- TAD ("]-") /IS CHARACTER A ) ?
- SZA /YES-SKIP A EXIT
- TAD (")-"> /IS CHARACTER A > ?
- SZA /YES-SKIP AND EXIT
- TAD (">-"< /IS CHARACTER A < ?
- SNA
- JMP ENDCH1 /YES-SKIP AND EXIT
- TAD ("<
- SPA CLA /IS IT END-OF-LINE?
- JMP ENDCH1 /YES-SKIP AND EXIT
- JMS I [ICMESG /NO - GENERATE IC MESSAGE AND GET NEXT CHAR
- JMP I ENDCHK /--RETURN--
-
-ENDCH1, ISZ ENDCHK /INCREMENT RETURN ADDRESS
- JMP I ENDCHK /--RETURN--
-
-NUMBER, DCA TEMP
-NUMBE2, TAD RADIX /IS THE CURRENT RADIX OCTAL?
- SNA CLA
- TAD CHAR /YES-IS THE DIGIT GREATER THAN 7?
- TAD (-"8
- SMA CLA
- JMP NUMBE3 /YES-ILLEGAL CHARACTER
- TAD TEMP /NO-ADD IT TO THE PREVIOUS
- CLL RAL /ACCUMULATED VALUE
- CLL RAL
- DCA TEMP2
- TAD RADIX /IS RADIX OCTAL?
- AND TEMP /NO
- TAD TEMP2 /YES
- CLL RAL
- TAD CHAR
- TAD (-"0
- DCA TEMP
- JMS I [GETC /GET NEXT CHARACTER
-NUMBE4, JMS I [TSTNUM /IS IT NUMERIC?
- JMP NUMBE2 /YES-CONTINUE ACCUMULATING NUMBER
- TAD TEMP /NO-STORE NUMBER
-NUMBE1, DCA VALUE2
-NUMBE5, TAD OP /GO COMBINE IT VIA LAST OPERATION
- TAD (OPTABL
- DCA TEMP /FIND THE OPERATOR HANDLER
- TAD I TEMP
- DCA TEMP
- JMP I TEMP /GO TO THE HANDLER
- /8 OR 9 FOUND DURING OCTAL RADIX
-
-NUMBE3, JMS I [ICMESG /GENERATE IC ERROR MESSAGE AND
- JMP NUMBE4 /IGNORE CHARACTER
-
-
-/HANDLER FOR .
-
-PERIOD, JMS I [GETC /GET NEXT CHARACTER
- TAD LOC /MAKE CURRENT LOCATION
- JMP NUMBE1 /INTO VALUE OF NUMBER
-
-/HANDLER FOR "
-
-QUOTE, ISZ TXTPTR
- TAD I TXTPTR /GET CHARACTER FROM TEXT BUFFER
- TAD [-215 /WAS IT CARRIAGE RETURN?
- SNA CLA
- JMP QUOTE1 /YES-IT IS IC-IGNORE "
- TAD I TXTPTR /NO-PUT ASCII CODE INTO
- DCA VALUE2 /VALUE WORD
- JMS I [GETC /GET NEXT CHARACTER
- JMP NUMBE5 /RETURN TO EXPRESSION PROCESSOR
-
-/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT
-
-QUOTE1, JMS I [ERROR /GENERATE IC ERROR MESSAGE
- IC
- CLA CMA
- DCA CHAR
- JMP I (EXPXIT
- PAGE
- /COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER
-
-ALPHA1, JMS I [GETTAG /PICK UP TAG
- DCA ALPHAI /STORE UNDEFINED INDICATOR
-ALPHA3, TAD TAG3 /IS IT A PSEUDO-OP?
- SMA CLA
- JMP .+3
- JMS I [ERROR /YES-GENERATE IP ERROR MESSAGE
- IP
- ISZ ALPHAI /NO-WAS IT UNDEFINED?
- JMP ALPHA0
- ISZ UNDFSW /YES-SET UNDEFINED SWITCH
- TAD PASS /IS THIS PASS 1?
- SPA CLA
- JMP ALPHA0 /YES-SUPPRESS ERROR MAESSAGE
- JMS I [ERROR /NO-GENERATE US ERROR MESSAGE
- US
-ALPHA0, TAD TAG2 /NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
- SPA CLA
- TAD CHAR /YES-GET TERMINATING CHARACTER
- TAD [-240 /WAS IT SPACE?
- SZA CLA
- JMP I (NUMBE5 /NOT MEMREF FOLLOWED BY SPACE
- JMS I [SPNOR /YES-IGNORE SPACES
- TAD CHAR
- SPA CLA
- JMP I (NUMBE5
- TAD EXPIND /IS MEMORY REFERENCE INSTRUCTION OK?
- SZA CLA
- JMP I (NUMBE5 /NO-
- DCA IZIND /YES-CLEAR I AND Z INDICATOR
- TAD VALUE2 /STORE MRI ON PUSHDOWN LIST
- JMS I [PUSHA
- ALPHA6, TAD IZIND
- JMS I [PUSHA /PUSH THE I AND Z INDICATOR
- JMS I [TSTALP /WAS TERMINATING CHARACTER ALPHABETIC?
- SKP
- JMP ALPHA4 /NO-
- JMS I [GETTAG /YES-PICK UP TAG
- DCA ALPHAI /STORE UNDEFINED INDICATOR
- AC2000
- AND TAG1 /WAS IT AN I OR Z?
- SNA CLA
- JMP ALPHA5 /NO
- TAD VALUE2 /YES-WAS IT I?
- SNA
- IAC /NO - SET LOW ORDER
- TAD I PDLXR /GET OLD IZIND FROM PDL
- DCA IZIND /SET NEW IZIND
- JMS I [SPNOR /IGNORE SPACES
- JMP ALPHA6
-
-EXPINT, TAD EXPIND
- TAD [4000
- DCA EXPIND
- JMP ALPHA3
-
-ALPHA5, AC4000
-ALPHA4, IAC
- JMS I [EXP /GET REST OF EXPRESSION
- TAD I PDLXR /RETRIEVE MRI
- DCA IZIND
- TAD I PDLXR
- DCA VALUE2
- /FALL INTO NEXT PAGE
- /COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION
-
- TAD VALUE /GET ADDRESS
- AND [7600
- SNA /IS IT PAGE 0?
- JMP FIX4 /YES
- CIA /NO-IS IT ON CURRENT PAGE?
- TAD LOC
- AND [7600
- SNA CLA
- JMP FIX2 /YES
- TAD VALUE /NO-SET UP LINK
- JMS I (FINDS
- DCA VALUE
- TAD FIXMD0 /SET ' IN LISTING
- DCA LININD
- ISZ LINK /BUMP NUMBER OF LINKS GENERATED
-FIXMD0, 0700 /PROTECTION FOR ISZ
-LGERR, SKP /JMS I PERROR IF /E SPECIFIED
- LG
- JMS ADDIND /SET INDIRECT BIT IN INSTRUCTION
-FIX2, TAD [200 /SET CURRENT PAGE BIT
- TAD VALUE2
- DCA VALUE2
- TAD IZIND
- AND [77 /WAS Z SPECIFIED?
- SNA CLA
- JMP FIX4 /NO
- JMS I [ERROR /YES - ILLEGAL REFERENCE
- IZ /TO PAGE 0
-FIX4, TAD IZIND /WAS THERE AN I?
- AND [7700
- SZA CLA
- JMS ADDIND /YES - ADD INDIRECT BIT TO INSTRUCTION
- TAD VALUE /GET ADDRESS
- AND [177
- TAD VALUE2 /GET OP CODE
- DCA VALUE /STORE
-POPJ, TAD I PDLXR
- DCA TEMP /POP A WORD OFF THE STACK
- JMP I TEMP /JUMP THROUGH IT.
- ADDIND, 0 /ROUTINE TO ADD INDIRECT BIT TO AN INSTR
- TAD VALUE2
- CMA
- AND [400
- SZA /WAS THERE ONE ALREADY?
- JMP .+3 /NO
- JMS I [ERROR /YES - ILLEGAL INDIRECT
- II
- TAD VALUE2
- DCA VALUE2
- JMP I ADDIND
-
-/ ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB
-
-PTCH, 0 /RUNS IN DF 10
- TAD (7647 /POINT TO DEVICE
- DCA PTR /HANDLER RESIDENCY TABLE
- TAD [-17 /IT HAS 15 ENTRIES
- DCA KNTR /V3C
-KLOOP, TAD I PTR /GET HANDLER ENTRY POINT
- AND [7600 /LOOK AT PAGE IT'S ON
- TAD [-INDEVH /IS IT ON THE PAGE WE PUT BUFFER OVER?
- SNA CLA /WELL?
- DCA I PTR /YES IT IS, WIPE IT FROM RESIDENCY
- ISZ PTR /LOOK AT NEXT ENTRY
- ISZ KNTR /ANY MORE ENTRIES?
- JMP KLOOP /YES, MIGHT HAVE TO WIPE SEVERAL GUYS
- TAD [200 /INCREASE INPUT BUFFER SIZE
- JMP I PTCH /V3C
- PAGE
- /COMBINE CURRENT VALUE WITH PREVIOUS VALUE
-/ACCORDING TO LAST OPERATOR
-
-OP0, TAD VALUE2 /HANDLER FOR +
- TAD VALUE /** OP0+1 AND OP0+2 JUMPED TO **
- DCA VALUE
-EXP3, TAD CHAR /GET LAST OPERATOR
- TAD (-"+ /WAS IT A + OR - ?
- CLL RTR
- SNA
- JMP PLSMIN /YES - LINK=0 FOR +, 1 FOR -
- RTL
- TAD ("+-"%
- CLL RAR
- SNA /IS THE CHAR % OR &?
- JMP DIVAND /YES - LINK=0 FOR %, 1 FOR &
- RAL
- TAD ("%-240
- CLL RAR
- SNA /IS THE CHAR SPACE OR !?
- JMP BLKEXP /YES - LINK=0 FOR SPACE, 1 FOR !
- RAL
- TAD (240-"^
- SNA CLA /IS THE CHAR ^?
- JMP MUL /YES - LINK IRRELEVANT
- JMS I (ENDCHK /NO-SEE IF END OF LINE FOUND
- JMP EXP3 /NO-TRY AGAIN
-EXPXIT, TAD UNDFSW /EXIT FROM EXP
- SNA CLA /RESTORE EXIT POINT
- JMP I (POPJ /--EXIT VIA POPJ--
- CLA CMA
- DCA UNDFSW /SET UNDEFINED SWITCH
- DCA VALUE /RESULT IS 0
- JMP I (POPJ /--EXIT VIA POPJ--
- MUL, CLL IAC /LINK DOESN'T COUNT FOR ^
-BLKEXP, IAC /** BLANK ASSUMED TO BE 4 ELSEWHERE **
-DIVAND, IAC
-PLSMIN, RAL
- JMP I (EXP1 /GET REST OF EXPRESSION
-
-/HANDLER FOR &
-
-OP2, TAD VALUE
- AND VALUE2
- JMP OP0+2
-
-
-/HANDLER FOR ^
-/MULTIPLY BY REPEATED ADDITION
-
-OP4, TAD VALUE
- CIA
- DCA TEMP
- TAD VALUE2
- ISZ TEMP
- JMP .-2
- JMP OP0+2
-
-OP1, TAD VALUE2 /- OPERATOR
- CIA
- JMP I (OP0+1 /JUMP INTO ADD OPERATOR
-
-/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:
-
-OP3, TAD VALUE
- JMS I [RTL6
- AND [7700 /ISOLATE 6 BITS AND FALL INTO "OR"
- DCA VALUE /V3C
-
-/HANDLER FOR ! AND SPACE AS INCLUSIVE OR
-
-OP5, TAD VALUE
- CMA
- AND VALUE2
- JMP I (OP0+1
- /CHARACTER INPUT CHECK
-/ENTER WITH CHARACTER IN AC
-
-LSTCH9, SZA /IGNORE NULL (0)
- TAD (-177
- SZA /IGNORE RUBOUT (377)
- TAD (177-13
- SZA /IGNORE VERTICAL TAB (213)
- IAC
- SNA
- JMP I (INPUT+1 /IGNORE LINE FEED (212)
- TAD [12-32 /WAS IT ^Z (END-OF-FILE=232)?
- SNA
- JMP I (ENDCHR /YES - GET NEXT FILE
- TAD (32-15 /NO - WAS IT CARRIAGE RETURN?
- SNA
- JMP LSTCHR /YES - LAST CHARACTER OF LINE
- IAC /NO
- SNA /WAS IT FORM FEED (214)?
- JMP FORCHR /YES - HANDLER FORM FEED
- ISZ I (INPUT
- TAD (14+200
- DCA LSTCH5 /STORE CHARACTER
- TAD PASS /IS THIS PASS 3?
- SPA SNA CLA
- JMP LSTCH4 /NO -
- ISZ LSTCH6 /YES - FILLING HEADER AREA?
- JMP LSTCH3 /YES
- CLA CMA /NO - RESET SWITCH
- DCA LSTCH6
-LSTCH4, TAD I (INPUT
- DCA TEMP
- TAD LSTCH5 /GET CHARACTER IN AC
- JMP I TEMP /-EXIT FROM INPUT-
-
-LSTCH3, ISZ LSTCH7 /FILLING HEADER
- TAD LSTCH5 /STORE CHARACTER IN HEADER AREA
- DCA I LSTCH7
- JMP LSTCH4
-
-LSTCH5, 0
-LSTCH6, -HEDLEN
-LSTCH7, HEADER-1
- LSTCHR, TAD FORMSW /CARRIAGE RETURN WAS FOUND
- SNA CLA /HAS THERE BEEN A FORM FEED?
- JMP LSTCH1 /NO -
- DCA FORMSW /YES - CLEAR FORM FEED SWITCH
- ISZ EDITPG /GO TO NEXT EDITOR PAGE
- DCA THISPG /CLEAR OVERFLOW PAGE
- TAD PASS /IS THIS PASS 3?
- SMA SZA CLA
- JMS I [FORMFD /YES - GENERATE FORM FEED
-LSTCH1, TAD [215 /NO - CARRIAGE RETURN IS CHARACTER
- DCA LSTCH5
- JMP LSTCH4-2 /EXIT
-
-FORCHR, ISZ FORMSW /SET FORM FEED SWITCH
- JMP I (INPUT+1 /GET ANOTHER CHARACTER
-
-FORMSW, 1
- PAGE
- /ERROR MESSAGE OUTPUT
-
-DUMPS1,
-ERROR, 0
- CLA
- ISZ ERCNT /COUNT THE ERRORS
-ERPLUS, "+ /PROTECTION
- TAD I ERROR /GET ERROR MESSAGE
- ISZ ERROR /INCREMENT RETURN ADDRESS
- JMS I [ERROR1 /OUTPUT 2 CHARACTER ERROR MESSAGE
- TAD (JMP I [7600 /PUT EXIT TO MONITOR
-CSWIT1, DCA I (LSWITC /IN SWITCH - "CLA" IF /C
- TAD PASS /IS THIS PASS 3?
- SMA SZA CLA
- JMP ERROR4 /YES - CARRIAGE RETURN/LINE FEED
- JMS I [ERROR1 /NO - OUTPUT 2 SPACES
- TAD [1777 /IS THERE A TAG SAVED?
- AND LAST1
- SNA
- JMP ERROR3 /NO
- JMS I (DIV45 /YES - OUTPUT FIRST 2 CHARACTERS
- TAD LAST2 /OUTPUT SECOND 2 CHARACTERS
- JMS I (DIV45
- TAD LAST3
- JMS I (DIV45 /OUTPUT THIRD 2 CHARACTERS
- TAD LAST4 /IS ERROR LOCATION SAME AS LAST TAG?
- CIA
- TAD LOC
- SNA CLA
- JMP ERROR4 /YES - CARRIAGE RETURN
- TAD ERPLUS
- JMS I OERROR
- TAD LAST4
- CIA
-ERROR3, TAD LOC /OUTPUT 4 DIGIT ADDRESS OR INCREMENT
- JMS I (OCTPRT
-ERROR4, TAD [215 /OUTPUT CARRIAGE RETURN/LINE FEED
- JMS I OERROR
- JMP I ERROR /--RETURN--
- /RESET LITERAL TABLES AND POINTERS
-
-DUMPS5,
-CLEAN, 0
- TAD (LITBUF-1
- DCA XREG1 /SET LITERAL TABLE POINTER
- TAD (TPINST-1
- DCA XREG2 /SET TOP INST. TABLE POINTER
- TAD (-40
- DCA TEMP
- TAD [200
- DCA I XREG1 /SET LITERAL TABLE ENTRIES TO 200
- DCA I XREG2 /SET TOP INST. TABLE ENTRIES TO 0
- ISZ TEMP
- JMP .-4
- DCA LAST1 /CLEAR LAST DEFINED TAG
- JMP I CLEAN /--RETURN--
-
-/DUMP CURRENT PAGE LITERALS
-
-DUMPS, 0
- JMS I [FINDSP
- SNA /IF THIS IS PAGE 0,
- JMP I DUMPS /--RETURN--
- TAD [LITBUF
- DCA DUMPS1
- TAD LITPTR
- CIA CLL
- TAD I DUMPS1
- DCA DUMPS2 /STORE NUMBER OF LITERALS ON THIS PAGE
- SZL /ARE THERE ANY?
- JMP D2 /V3C
- DCA STARSW /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
- TAD LOC
- AND [7600
- TAD I DUMPS1
- JMS I [PUNORG /OUTPUT ORIGIN
- TAD I DUMPS1
- TAD (LITBF1
-DUMPS3, DCA DUMPS5
- TAD I [LINBUF /SAVE LINBUF
- JMS I [PUSHA
- DCA I [LINBUF
-DUMPS6, TAD I DUMPS5
- DCA VALUE
-JMSPUN, JMS I [PUNONE /OUTPUT ONE REGISTER
- ISZ LOC
- ISZ DUMPS5
-LITHAK, ISZ I DUMPS1 /DESTROY RECORD OF CURRENT PAGE LITERALS -
- /ZEROED IF NO /W OPTION SPECIFIED
- ISZ DUMPS2
- JMP DUMPS6
- TAD I PDLXR
- DCA I [LINBUF /RESTORE LINBUF
-D2, TAD DUMPS1 /WIPE REMEMBRANCE OF TOP OF PAGE (JR)
- TAD (40 /V3C
- DCA DUMPS5
-D3, DCA I DUMPS5
- JMP I DUMPS /--RETURN--
- /HANDLER FOR ZBLOCK PSEUDO-OP
-/RESERVES AS MANY WORDS OF ZERO
-/AS VALUE OF EXPRESSION
-
-ZBLOCX, JMS I [SPNOR /IGNORE SPACES
- JMS I [EXP /GET THE EXPRESSION
- TAD VALUE
- CMA /PROTECT AGAINST ZERO CASE
- DCA TEMP3 /STORE NEGATIVE AS COUNTER
- JMP ZBLOCZ /JUMP INTO LOOP
-ZBLOCY, JMS I [PUNBIN /OUTPUT ONE WORD OF ZERO
- TAD PASS /IS THIS PASS 3?
- SMA SZA CLA
- DCA I (PUNMOD /YES - PREVENT OUTPUT
-ZBLOCZ, ISZ TEMP3 /NO - DONE YET?
- JMP ZBLOCY /NO - CONTINUE
- TAD JMSPUN /YES - RESTORE PUNMOD
- DCA I (PUNMOD
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-/DUMP PAGE 0 LITERALS
-
-DUMPS2,
-DUMPZ, 0
- TAD DUMPZ /RESET EXIT FROM DUMPS
- DCA DUMPS
- TAD [200
- CIA CLL
- TAD I [LITBUF /STORE THE NUMBER OF LITERALS ON PAGE 0
- DCA DUMPS2
- SZL /ARE THERE ANY?
- JMP I DUMPS /NO - ** DUMPZ IS DESTROYED **
- TAD I [LITBUF
- JMS I [PUNORG /OUTPUT ORIGIN
- TAD I [LITBUF /SET VALUES FOR DUMPS
- TAD (LITBF2
- JMP DUMPS3
- PAGE
- /ENTER A TAG INTO SYMBOL TABLE
-
- IFZERO HASH<
-INSRTG, 0
- TAD VALUE2 /SAVE VALUE 2
- JMS I [PUSHA
- ISZ HIGHTG /COUNT IN THIS TAG
- TAD TAGMAX
- CLL CIA /GET LIMIT OF SYMBOL STORAGE
- TAD HIGHTG /IS THERE ROOM FOR ONE MORE?
- SZL
- JMP I (SYMOFL /NO - SE**FATAL ERROR**
- TAD TAGMAX /YES - IS USR IN CORE?
- TAD (-1340
- SZL CLA
- JMP GETTG5 /YES
- TAD [7700 /NO - RESET ADDRESS TO
- DCA IOMON /USR NON-RESIDENT
- AC7776
- AND I (JSBITS /RESET JOB STATUS WORD TO
- DCA I (JSBITS /SAVE CORE WHEN USR CALLED
-GETTG5, TAD THISTG /SEARCH SYMBOL TABLE
- DCA TEMP2
- TAD HIGHTG
- IAC
- DCA THISTG
-GETTG8, AC7776
- TAD THISTG
- DCA THISTG
- JMS I [FINDTG /GET NEXT TAG FROM SYMBOL TABLE
- ISZ THISTG
- TAD THISTG
- CIA
- TAD TEMP2 /DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
- SNA CLA
- JMP GETTG9 /YES-PUT IT THERE AND EXIT
- JMS I [PUTTAG /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
- JMP GETTG8
-
-/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
-/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE
-
-GETTG9, TAD I (NAME1 /GET CURRENT TAG
- DCA TAG1 /PUT IT IN TAG1-TAG3
- TAD I (NAME2
- DCA TAG2
- TAD I (NAME3
- DCA TAG3
- TAD I PDLXR /RESTORE VALUE 2
- DCA VALUE2
- JMS I [PUTTAG /PUT TAG1 - TAG3 INTO SYMBOL TABLE
- JMP I INSRTG /--RETURN--
-
-TAGMAX, 1740 /12K=3740, ...
- >
-
-/ IFNZRO HASH< /***HACK ONLY***
-/TLYREF, 0 /TALLY REFS TO SYMBOL TABLE
-/ ISZ NREFL
-/ JMP I TLYREF
-/ ISZ NREFH
-/ JMP I TLYREF
-/ JMP I TLYREF
-/TLYPRB, 0 /TALLY PROBES INTO TABLE
-/ JMS I [FINDTG /FUDGE, OUT OF ROOM
-/ ISZ NPROBL
-/ JMP I TLYPRB
-/ ISZ NPROBH
-/ JMP I TLYPRB
-/ JMP I TLYPRB
-/NREFH, 0
-/NREFL, 0
-/NPROBH, 0
-/NPROBL, 0
-/ > /***HACK ONLY***
- IFNZRO HASH<
-
- /INSERT A TAG INTO THE HASH TABLE
-
-INSRTG, 0
- ISZ HIGHTG /BUMP SYM NUM (SKIPS ON 0)
- TAD HIGHTG
- STL CMA
- TAD TAGMAX
- SNA SZL CLA /STILL ROOM FOR AT LEAST 2 MORE?
- JMP I (SYMOFL /NO SE** FATAL ERROR**
- TAD I (NAME1
- DCA TAG1
- TAD I (NAME2
- DCA TAG2
- TAD I (NAME3
- DCA TAG3
- JMS I [PUTTAG /NOW ACTUALLY INSERT IT
- JMP I INSRTG
- >
- /OUTPUT 2 CHARACTER WORD
-/FROM SYMBOL TABLE FORMAT
-/DIVIDE BY 45(8)
-
-DIV45, 0
- RAL
- CLL RAR /CLEAR SIGN BIT
-DIV45A, ISZ DIV45C
- TAD (-45
- SMA
- JMP DIV45A
- TAD (45
- JMS DIV45E
- DCA DIV45B
- STA
- TAD DIV45C
- JMS DIV45E
- JMS I [RTL6
- TAD DIV45B
- JMS I [ERROR1 /OUTPUT 2 CHARACTERS
- DCA DIV45C /CLEAR DIV45C FOR NEXT GO-ROUND
- JMP I DIV45 /--RETURN--
-
-DIV45B, 0
-DIV45C, 0 /** MUST BE 0 WHEN DIV45 IS ENTERED **
-
-DIV45E, 0
- SNA
- JMP I DIV45E
- TAD (-33
- SMA
- TAD (20-40-33
- TAD (33+40
- JMP I DIV45E /--RETURN--
- /HANDLER FOR FIXTAB PSEUDO-OP
-
-FIXTBX, TAD PASS /IS THIS PASS 1?
- SMA CLA
- JMP I [LOOKEX /NO--EXIT TO MAIN--
- JMP I (FIXTAY /YES--DO FIXTAB
-
-/SET FIELD
-
-SETFLD, 0
- CLA CLL /SETFLD CALLED WITH AC RANDOM
- DCA SETFL1 /INITIALIZE FIELD
- IFNZRO HASH<
- TAD USROFS /FUDGE FOR KEEPING USR AROUND
- >
- TAD THISTG
-SETFLP, ISZ SETFL1
- CML
- TAD (-1740 /PUT 1740 SYMBOLS IN EACH FIELD
- SNL /IS THE DIVIDE THROUGH?
- JMP SETFLP /NO - CONTINUE
- IFZERO HASH<
- CLL CMA RTL /AC CONTAINED REM-1740; THIS MAKES IT INTO
- TAD (-1 /7573-4*REM WHICH IS THE ADDRESS WE WANT
- >
- IFNZRO HASH<
- CLL RTL /AC GETS 0201 TO 7775
- TAD (-202 /AC GETS 7777 TO 7573 FOR TAGXR
- >
- DCA TAGXR /TO STICK INTO AN AUTO-XR
- TAD SETFL1
- CLL RTL
- RAL
- TAD SETFL2
- DCA SETFL1
-SETFL1, HLT
- JMP I SETFLD /--RETURN--
- IFNZRO HASH<
-USROFS, 0 /GETS 400 IF KEEPING USR
- >
- /FIND TAG
-/GET TAG FROM SYMBOL TABLE
-/PUT IT INTO TAG1-TAG3
-/WITH ITS VALUE IN VALUE2
-
-FINDTG, 0
- TAD THISTG
- JMS SETFLD
- TAD I TAGXR
- DCA TAG1
- TAD I TAGXR
- DCA TAG2
- TAD I TAGXR
- DCA TAG3
- TAD I TAGXR
- DCA VALUE2
-SETFL2, CDF
- JMP I FINDTG /--RETURN--
-
-/OPTIMIZATION MAY CHANGE SETFLD TO
-/REMOVE CLA ON ENTRY
- PAGE
- /BEGINNING OF PASS CODE
-
- JMS I (IOPEN /SET INPUT ROUTINE TO OPEN FILE
-START2, ISZ PASS /SET UP COUNTERS AND POINTERS
- DCA XLISTX /CLEAR XLIST SWITCH
- DCA FLDIND /SET FIELD TO 0
- DCA VALUEX /SET BANK TO ZERO(128K)
- DCA CONDSW
- DCA EDITPG
- DCA LINK
- DCA RADIX
- DCA ERCNT
- DCA GETCI
- DCA PUNCHX
- DCA I [LINBUF
- TAD (PDLST
- DCA PDLXR
- JMS I [CLEAN
- TAD [200
- DCA LITPTR
- TAD [200
- JMS I [PUNORG
- JMP I (LOOKE1 /--EXIT TO MAIN--
-
-/HANDLER FOR $
-
-ENDPAS, JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
- DCA OFSBUF /CLEAR OFFSET FOR NEXT PASS
- TAD PASS /WHAT PASS IS ENDING?
- SNA
- JMP I (ENDPA2 /PASS 2
- SPA CLA
- JMP I (START1 /PASS 1
- TAD I [LINBUF /PASS 3
- SNA CLA /ANYTHING TO PRINT?
- JMP ENDPA1-1 /NO
- TAD [211 /YES - TAB OVER TWICE
- JMS I OERROR
- TAD [211
- JMS I OERROR
- JMS I [LINPRT /PRINT LINE
- JMS I [DUMPZ /DUMP PAGE 0 LITERALS
-ENDPA1, DCA XLISTX
-/OUTPUT SYMBOL TABLE
-SSWITC, JMS I (SYMPRT /(0 IF /S)
- TAD I (FORM21
- DCA I (FORM22
- JMS I [FORMFD /OUTPUT FORM FEED
-ERMSGS, TAD ERCNT
- JMS OUTTTL /PRINT "ERRORS DETECTED: N"
- TAD LINK
- JMS OUTTTL /PRINT "LINKS GENERATED: N"
-FINLFF, JMS I [FORMFD /PRINT FINAL FF (ZEROED IF NO PASS 3)
- JMS I (OCLOSE /AND CLOSE THE OUTPUT FILE
- /CREF AND LOAD-AND-GO OPTIONS
-/****FINAL EXIT TO MONITOR****
-LSWITC, JMP I [7605 /0 IF /L OR /G OR /C
- TAD (7616
- DCA XREG1
- CDF 10
-CSWITC, TAD I [7600 /"TAD I [7605" IF /C
- AND [17
- DCA I XREG1 /SET BINARY DEVICE
- TAD BINSRT
-
-/EXIT FROM PAL8 BY CHAINING
-/TO NEXT PROGRAM
-/SHOULD BE ABSLDR OR CREF
-
- DCA I XREG1 /SET STARTING BLOCK
- DCA I XREG1 /SET 0 TERMINATOR
- CDF
- TAD I (JSBITS /SET BIT 11 OF JOB STATUS WORD
- RAR /SO 10000-11777 IS NOT SAVED
- CLL CML RAL
- DCA I (JSBITS
- CIF 10
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 6 /*CHAIN TO NEXT PROGRAM*
-CHAIN, 0 /STARTING BLOCK OF NEXT PROGRAM
-
-OUTTTL, 0
- DCA LAST1 /SAVE NUMBER TO BE PRINTED
-OUTTLL, TAD I TTLPTR /GET A WORD OF MESSAGE
- ISZ TTLPTR
- SNA /END?
- JMP PRTTTL /YES
- JMS I [ERROR1 /NO - PRINT IT
- JMP OUTTLL /AND LOOP
-PRTTTL, TAD [240 /PRINT A SPACE
- JMS I OCHAR
- TAD LAST1
- JMS I (FORMF4 /PRINT NUMBER IN DECIMAL
- JMS I (CRLF /PRINT CR AND 2 LF'S (1 IF PASS 3)
- JMP I OUTTTL /AND RETURN
-
-TTLPTR, TTLMSG
- /COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2
-
-LOADOV, JMS I (7607 /CALL SYSTEM DEVICE HANDLER
- 0200 /SWAP IN CODE UNIQUE TO PASS 3
- SWAP1 /BUFFER ADDRESS
- ASWAP /STARTING BLOCK NUMBER
- JMP I (SYSER3 /DE**FATAL ERROR**
-NSWITC, JMP START2 /(0 IF NO LIST FILE, SKP IF /N) START PASS3
- JMP ERMSG1
- JMP ENDPA1
-
-ERMSG1, TAD (OTYPEO /COME HERE IF NO PASS 3 OUTPUT FILE
- DCA OCHAR
- TAD (OTYPEO
- DCA OERROR
- TAD [7600
- DCA I (OTYPCR /INHIBIT AUTO-LF ON CARRIAGE RETURN
- DCA FINLFF /KILL LAST FORM FEED
- JMP ERMSGS
-
-/ADD BITS TO PUNCH ORIGIN
-
-PUNORG, 0
- DCA LOC
- TAD PASS /IS THIS PASS 2?
- SZA CLA
- JMP I PUNORG /NO--RETURN--
- TAD LOC /YES - OUTPUT ORIGIN SETTING
- TAD OFFSET /"LOC" MAY BE FICTITIOUS - MAKE IT REAL
- CLL CML
- ISZ STARSW /INHIBIT PUNCHING ORIGIN IF NECESSARY
- JMS I [PUNOUT
- CLA
- DCA STARSW /RESET SWITCH
- JMP I PUNORG /--RETURN--
- PAGE
- /EVALUATE LITERAL
-
-LIT, STA RAL /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
- DCA FINDS1 /SAVE FLAG
- JMS I [GETC /GET NEXT CHARACTER
- JMS I [SPNOR /IGNORE SPACES
- TAD EXPIND /STORE IMPORTANT VALUES PRIOR TO
- JMS I [PUSHA /ENTRANCE INTO EXP
- TAD OP
- JMS I [PUSHA
- TAD VALUE
- JMS I [PUSHA
- TAD FINDS1
- JMS I [PUSHA
- JMS I [EXP /GET EXPRESSION
- TAD VALUE /FIND LITERAL IN TABLE
- ISZ I PDLXR /PAGE 0?
- JMP .+3
- JMS FINDS /NO
- SKP
- JMS FIND0 /YES
- DCA VALUE2 /STORE ADDRESS
- TAD I PDLXR
- DCA VALUE
- TAD I PDLXR /RESTORE SAVED VALUES
- DCA OP
- TAD I PDLXR
- DCA EXPIND
- TAD CHAR /IGNORE ) OR ]
- TAD (-")
- SZA
- TAD (")-"]
- SNA CLA
- JMS I [GETC /GET NEXT CHARACTER
- JMP I (NUMBE5 /RETURN TO EXPRESSION PROCESSOR
-
-
-PEZE, 0 /SUBR TO ISSUE PE OR ZE MESSAGE
- SNA CLA /WHICH ONE?
- JMP .+4 /PAGE 0
- JMS I PERROR
- PE
- JMP I PEZE
- JMS I PERROR
- ZE
- JMP I PEZE
- /FIND LITERAL ON CURRENT PAGE
-
-FINDS, 0
- DCA FINDS1
- TAD LOC
- AND [7600
- SNA /IS THIS PAGE 0?
- JMP FIND01 /YES
- DCA FINDS2 /NO - SAVE PAGE NUMBER
- TAD (LITBF1
- DCA FIND0
- TAD [7700 /ALLOW 100(8) CURRENT PAGE LITERALS
- DCA FORMF6
- TAD LITPTR /GET PG ADDR OF 1ST LITERAL IN BUFFER
-FIND02, DCA FINDS3
- TAD FINDS2
- JMS I [RTL6
- TAD [LITBUF
- DCA TEMP
- TAD FIND0 /COMPUTE ACTUAL CORE ADDRESS OF LITERAL
- TAD I TEMP
- DCA TEMP2
- TAD FINDS3 /COMPUTE THE NUMBER OF ENTRIES
- CIA
- TAD I TEMP /IN THE LITERAL BUFFER
- SNA
- JMP FINDS6 /NONE
- DCA FINDS3
-FINDS4, TAD I TEMP2 /GET LITERAL FROM TABLE
- CIA
- TAD FINDS1 /AND CURRENT LITERAL
- SNA CLA /DO THEY MATCH?
- JMP FINDS5 /YES
- ISZ TEMP2 /NO - BUMP COUNTERS
- ISZ FINDS3
- JMP FINDS4 /TRY AGAIN
-FINDS6, TAD FINDS2
- JMS I [RTL6
- TAD [TPINST
- DCA FINDS3
- TAD I TEMP /DOES THIS OVERFLOW PAGE?
- CIA
- TAD I FINDS3
- SPA CLA
- JMP FINDS7 /NO
-
- FIND03, TAD FINDS2 /PAGE FULL - WHICH PAGE?
- JMS PEZE /GENERATE PE OR ZE MESSAGE
- CLA CMA
- JMP FINDS9
-FINDS7, CLA CMA
- TAD I TEMP /IS PAGE FULL?
- AND FORMF6
- SNA CLA
- JMP FIND03 /YES - OUTPUT ERROR MESSAGE
- CLA CMA
- TAD I TEMP /NO
- DCA I TEMP
-FINDS9, TAD I TEMP
- TAD FIND0
- DCA TEMP2
- TAD FINDS1
- DCA I TEMP2
-FINDS5, TAD FIND0 /GET ADDRESS OF LITERAL
- CIA
- TAD TEMP2
- TAD FINDS2
- JMP I FINDS /--RETURN--
-
-
-/FIND LITERAL ON PAGE 0
-
-FIND0, 0
- DCA FINDS1
- TAD FIND0 /RESET EXIT FROM FINDS
- DCA FINDS
-FIND01, DCA FINDS2 /SET POINTERS
- TAD (LITBF2
- DCA FIND0
- TAD [7760 /ALLOW 160(8) PAGE 0 LITERALS
- DCA FORMF6
- TAD [200
- JMP FIND02
-
-FINDS1, 0
-FINDS2, 0
-FINDS3, 0
- PAGE
- /HANDLER FOR IFZERO PSEUDO-OP
-
-IF0, TAD (10 /IFTST1, SNA CLA
-
-/HANDLER FOR IFNZERO PSEUDO-OP
-
-IFN0, TAD IFSZA /IFTST1, SZA CLA
- DCA IFTST1
- JMS I [SPNOR /IGNORE SPACES
- JMS I [EXP /GET EXPRESSION
-IFTST3, TAD CHAR /GET LAST CHARACTER
- TAD (-"<
- SNA CLA /IS IT <?
- JMP IFTST2 /YES
- JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
-IFTST9, JMS I [SPNOR /IGNORE SPACES
- JMP IFTST3 /TRY AGAIN
-
-IFTST2, JMS I [GETC /GET NEXT CHARACTER
- TAD CONDSW
- CIA
- DCA CONDTM /SET NUMBER OF NESTED CONDITIONALS
- CLA CMA /DECREMENT NUMBER OF NESTED CONDITIONALS
- TAD CONDSW
- DCA CONDSW
- TAD VALUE
-IFTST1, HLT /SZA CLA OR SNA CLA
- JMP I (MAIN /--EXIT TO MAIN--
-IFTST5, TAD CONDSW /DONE WITH ALL CONDITIONALS IN NEST?
- TAD CONDTM
- SMA CLA
- JMP I (MAIN /YES --EXIT TO MAIN--
- TAD CHAR
- TAD (-"< /NO - GET NEXT CHARACTER
- SNA /IS IT <?
- JMP IFTST6 /YES - HANDLE NEXT CONDITIONAL
- TAD ("<-"> /NO - IS IT >?
-IFSZA, SZA CLA
- JMP IFTST4 /NO - FINISH THIS CONDITIONAL
- AC7776
-IFTST6, CMA
- TAD CONDSW
- DCA CONDSW
-IFTST4, DCA I [LINBUF /INHIBIT LISTING OF UNASSEMBLED CODE -
- /ZEROED IF /J OPTION NOT SPECIFIED
- JMS I [GETC /GET NEXT CHARACTER
- JMP IFTST5
- /HANDLER FOR IFDEF PSEUDO-OP
-
-IFD, TAD (10 /IFTST1, SNA CLA
-
-/HANDLER FOR IFNDEF PSEUDO-OP
-
-IFND, TAD IFSZA /IFTST1, SZA CLA
- DCA IFTST1
-IFTST7, JMS I [SPNOR /IGNORE SPACES
- JMS I [TSTALP /IS NEXT CHARACTER ALPHABETIC
- JMP IFTST8 /YES
- JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
- JMP IFTST7 /KEEP TRYING
-
-IFTST8, JMS I [GETTAG /PICK UP TAG
- DCA VALUE /STORE UNDEFINED INDICATOR
- TAD TAG3 /WAS IT A PSEUDO-OP?
- SMA CLA
- JMP IFTST9 /NO
- JMS I [ERROR /YES - GENERATE IP ERROR MESSAGE
- IP
- JMP IFTST9
-
-ICMESG, 0
- JMS I [ERROR
- IC /IC COMES OUT ON ALL PASSES
- TAD CHAR
- SPA CLA
- JMP I [LOOKEX /END OF LINE - GO AWAY
- JMS I [GETC /GET NEXT CHAR
- JMP I ICMESG
- CONDTM,
-
-/PUT TAG IN SYMBOL TABLE
-
-PUTTAG, 0
- TAD THISTG
- JMS I (SETFLD /SET FIELD
- TAD TAG1
- DCA I TAGXR
- TAD TAG2
- DCA I TAGXR
- TAD TAG3
- DCA I TAGXR
- TAD VALUE2
- DCA I TAGXR
- CDF
- JMP I PUTTAG /--RETURN--
-
-
-/PUSHDOWN ROUTINE
-/PUT NEW ENTRY ON PUSHDOWN STACK
-
-PUSHA, 0
- DCA TEMP
- CLA CMA
- TAD PDLXR
- DCA PDLXR
- TAD PDLXR
- TAD (-PDLND
- SPA CLA /IS LIST TOO FULL?
- JMP PUSHA1 /BE**FATAL ERROR**
- TAD TEMP /NO - MAKE ENTRY
- DCA I PDLXR
- CLA CMA
- TAD PDLXR
- DCA PDLXR
- JMP I PUSHA /--RETURN--
-
-PUSHA1, TAD (BE
- JMP I [MONERR /PUSHDOWN OVERFLOW IS FATAL ERROR
- /TEST NUMERIC ROUTINE
-/CALL WITH CHARACTER TO TEST IN "CHAR"
-/SKIPS IF THE CHARACTER IS NOT NUMERIC
-
-TSTNUM, 0
- TAD CHAR /GET THE CHARACTER
- TAD (-"9-1
- CLL
- TAD ("9-"0+1
- SNL CLA /CHECK FOR RANGE 0-9
- ISZ TSTNUM /OUT OF RANGE
- JMP I TSTNUM /--RETURN--
-
-/TEST ALPHANUMERIC ROUTINE
-/CALL WITH CHARACTER IN "CHAR"
-/SKIPS IF CHARACTER IS NOT ALPHANUMERIC
-
-TSTALN, 0
- JMS I [TSTNUM /IS IT NUMERIC
- JMP I TSTALN /YES--RETURN--
- JMS I [TSTALP /IS IT ALPHABETIC
- JMP I TSTALN /YES--RETURN--
- ISZ TSTALN /NEITHER
- JMP I TSTALN /--RETURN--
-
-/TEST ALPHABETIC ROUTINE
-/CALL WITH CHARACTER IN "CHAR"
-/SKIPS IF NOT ALPHABETIC
-
-TSTALP, 0
- TAD CHAR
- TAD (-"Z-1
- CLL
- TAD ("Z-"A+1
- SNL CLA /CHECK FOR RANGE A-Z
- ISZ TSTALP /OUT OF RANGE
- JMP I TSTALP /--RETURN--
- PAGE
- /INPUT ROUTINE
-/UNPACKS CHARACTERS FROM BUFFER
-
-INPUT, 0
- ISZ INCHCT /ARE THERE CHARACTERS LEFT IN BUFFER?
- JMP I CHARLV /YES - FETCH ONE
- TAD INEOF /NO - WAS OLD FILE ENDED?
- SZA CLA
- JMP ENDCHR /YES - START NEW FILE
-INGBUF, TAD INCTLA /NO
- AND [7600
- JMS I [RTL6
- TAD INCTR
- SNL
- DCA INCTR
- SZL
- ISZ INEOF
- CLL CML CMA RTR /SET CONTROL WORD
- RTR
- RTR
- TAD INCTLA
- DCA INCTLW
- JMS I INHNDL /CALL INPUT DEVICE HANDLER
-INCTLW, 0 /CONTROL WORD
-INBUFP, INBUF /INPUT BUFFER ADDRESS
-INREC, 0 /STARTING BLOCK NUMBER
- JMP INERRX /ERROR RETURN
-INBREC, TAD INCTLA /NORMAL RETURN
- AND [7600
- JMS I [RTL6
- TAD INREC
- DCA INREC /RESET STARTING BLOCK NUMBER
- TAD INCTLW
- AND [7600
- CLL RAL
- TAD INCTLW
- AND [7600
- CIA
- DCA INCHCT /SET CHARACTER COUNT
- TAD INBUFP
- DCA INPTR /SET BUFFER POINTER
- /CHARACTERS ARE FOUND IN BUFFER
-/IN STANDARD OS/8 PACKING
-/WORD 1: AAA A11 111 111
-/WORD 2: BBB B22 222 222
-/WHICH REPRESENTS 3 CHARACTERS
-/CHARACTER 1: 11 111 111
-/CHARACTER 2: 22 222 222
-/CHARACTER 3: AA AAB BBB
-
-
-ICHAR1, TAD I INPTR /PICK UP CHARACTER WORD 1
- JMS CHARLV /CHECK RIGHT 8 BITS
-ICHAR2, TAD I INPTR /PICK UP WORD 1
- ISZ INPTR /(INCREMENT POINTER TO WORD 2)
- AND [7400 /WITH WORD 1 IN AC
- DCA INCTLW /RETRIEVE LEFT 4 BITS AND SAVE
- TAD I INPTR /PICK UP WORD 2
- JMS CHARLV /CHECK RIGHT 8 BITS
-ICHAR3, TAD I INPTR /PICK UP WORD 2
- ISZ INPTR /(POINT TO NEXT WORD 1)
- AND [7400 /WITH WORD 2 IN AC
- CLL RTR /RETRIEVE LEFT 4 BITS
- RTR
- TAD INCTLW /PUT BOTH SETS OF 4 BITS TOGETHER
- RTR
- RTR
- JMS CHARLV /CHECK CHARACTER
- JMP ICHAR1 /TRY NEXT SET OF 2 WORDS
-
-INERRX, ISZ INEOF
- SMA CLA /EOF OR FATAL ERROR?
- JMP INBREC /EOF - UNPACK THIS BUFFER
- JMP I (SYSERR /FATAL - GENERATE DE ERROR MESSAGE
-
-INCHCT, -1
-INEOF, 1
-INPTR, 0
-INCTR, 0
-INCTLA, 0
-INFPTR, 7617
- /START NEW FILE
-
-ENDCHR, ISZ I (FORMSW /^Z OR EOF SIMULATES FORM FEED
- TAD PASS /IS THIS PASS 3?
- SPA SNA CLA
- JMP NXTFLE /NO
- JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
- TAD [-HEDLEN
- DCA I (LSTCH6
- TAD [HEADER-1
- DCA I (LSTCH7
- DCA LSTCNT
-NXTFLE, TAD (INDEVH+1 /SET ADDRESS OF DEVICE HANDLER
- DCA INHNDL
- CDF 10
- TAD I INFPTR
- CDF
- SNA
- JMP FAKDLR /END OF FILE - FAKE A $
- CIF 10
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 1 /*FETCH HANDLER*
-INHNDL, 0 /LOADING ADDRESS OF HANDLER
- HLT /ERROR RETURN
- CDF 10 /V3C
- TAD INHNDL /NORMAL RETURN - HANDLER IN CORE
- AND [7600
- TAD [-INDEVH /SEE IF INPUT HANDLER IS IN 7200
- SZA CLA
- JMS I (PTCH /IT IS - INCREASE SIZE OF BUFFER
- /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
- TAD INCTL
- DCA INCTLA /DF=10
- TAD I INFPTR
- AND [7760
- SZA
- TAD [17
- CLL CML RTR
- RTR
- DCA INCTR
- ISZ INFPTR
- TAD I INFPTR
- DCA INREC /RESET STARTING BLOCK NUMBER
- ISZ INFPTR
- DCA INEOF
- CDF
- JMP INGBUF
- FAKDLR, TAD (244
- JMS CHARLV /CALL THE COROUTINE
- TAD [215 /WITH $ AND CR
- JMS CHARLV /TO END THE ASSEMBLY.
- JMP I (PHASE /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL
-
-CHARLV, 0 /CHARACTER IN AC
- AND [177 /AND OFF LEFT 5 BITS
- JMP I (LSTCH9 /RETURN TO LSTCH9
- PAGE
- /HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
-/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
-/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
-/ADDED TO CHECKSUM
-
-DTORGX, JMS I [SPNOR /IGNORE SPACES
- JMS I [EXP /GET EXPRESSION
- TAD PASS /IS THIS PASS 2?
- SNA
- JMP DTORG2 /YES
-PUNVA1, SPA SNA CLA /NO - IS THIS PASS 3?
- JMP I [LOOKEX /NO--EXIT TO MAIN--
- TAD LININD /GET LINK SWITCH FROM "EXP"
- DCA LINKSW /YES
- TAD [LOOKEX /FIX PUNONE TO EXIT TO MAIN
- DCA I (PUNONE
- TAD [211 /OUTPUT TAB
- JMS I OERROR
- JMP I (DTORG1
-
-DTORG2, TAD VALUE /PASS 2 - GET BLOCK NUMBER
- JMS I [RTL6
- RAL
- AND [77
- TAD (300 /PICK UP CHANNELS 7 AND 8
- DCA TEMP
- TAD TEMP
- TAD CHKSUM /ADD VALUE TO CHECKSUM
- DCA CHKSUM
- TAD TEMP
- JMS I OCHAR /OUTPUT BLOCK NUMBER - FIRST FRAME
- TAD VALUE
- AND [77
- JMS I OCHAR /OUTPUT SECOND FRAME
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-/HANDLER FOR %
-/DIVIDE BY REPEATED SUBTRACTION
-
-OP6, DCA TEMP
- TAD VALUE2
- CIA
- DCA VALUE2
- TAD VALUE
-OP6A, CLL
- TAD VALUE2 /SUBTRACT DIVISOR FROM DIVIDEND
- SNL /DONE YET?
- JMP OP6B /YES - EXIT
- ISZ TEMP /NO - COUNT ONE MORE SUBTRACTION
- JMP OP6A /SUBTRACT AGAIN
-OP6B, CLA
- TAD TEMP /RESULT IS # OF SUBTRACTIONS
- JMP I (OP0+2
- /HANDLER FOR XLIST PSEUDO-OP
-
-XLISTY, JMS XLISTZ /ANY EXPRESSION?
- JMP XLIST1 /NO
- JMS I [EXP /GET EXPRESSION
- TAD VALUE /USE THE VALUE
-XLIST2, DCA XLISTX /SET SWITCH
- DCA I [LINBUF /XLIST NEVER LISTS!
- JMP I [LOOKEX /--EXIT TO MAIN--
-
-XLIST1, TAD XLISTX
- SNA CLA
- IAC /FLIP IT
- JMP XLIST2
-
-RELOCY, JMS XLISTZ /RELOCATE PSEUDO-OP - EXPRESSION?
- JMP RELOC1 /NO
- JMS I [EXP /GET IT
- TAD VALUE
- CIA /COMPUTE OFFSET OF REL LOC CTR
- TAD LOC /FROM FAKE LOC CTR
- TAD OFFSET /OFFSET IS CUMULATIVE!
-RELOC2, DCA OFSBUF /SET NEW OFFSET - THIS TAKES EFFECT AFTER
- STA /THE LITERALS (IF ANY) ARE DUMPED.
- JMP I (STAR0 /FAKE ORIGIN TO NEW LOC,
- /ACTUALLY A NO-OP BECAUSE OF OFFSET
-RELOC1, TAD OFFSET /SET OFSBUF=0, LOC=LOC+OFFSET -
- TAD LOC /THIS CANCELS ALL RELOCATION STUFF.
- DCA VALUE
- DCA UNDFSW /JUST IN CASE - "STAR0" CHECKS THIS
- JMP RELOC2 /STILL MUST OUTPUT *. TO GET IN SYNCH
- /HANDLER FOR EJECT PSEUDO-OP
-
-EJECTX, ISZ THISPG
- TAD PASS /IS THIS PASS 3?
- SMA SZA CLA
- JMP EJECT2 /YES
-EJECT1, TAD CHAR /NO - LOOK FOR NEXT NEGATIVE CHARACTER
- SPA CLA
- JMP I [LOOKEX /--EXIT TO MAIN--
- JMS I [GETC /GET NEXT CHARACTER
- JMP EJECT1
-
-EJECT2, JMS XLISTZ /PASS 3 - IS THERE AN EXPRESSION?
- JMP EJECT3 /NO - EXIT
- JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
- TAD [-HEDLEN
- DCA EJECT7 /SET UP FOR 40 NEW CHARACTERS
- TAD [HEADER-1
- DCA XREG1 /SET HEADER BUFFER POINTER
- JMP EJECT4
-
-EJECT6, ISZ EJECT7 /FILLED 40 CHARACTERS YET?
- JMP EJECT4 /NO - KEEP FILLING
- CLA CMA /YES - SKIP CHARACTERS TO
- DCA EJECT7 /END OF LINE
- JMP EJECT5
-
-EJECT4, TAD CHAR /FILL HEADING BUFFER
- DCA I XREG1
-EJECT5, CLA CMA
- DCA TXTSWT
- JMS I [GETC /GET NEXT CHARACTER
- TAD CHAR /END OF LINE?
- SMA CLA
- JMP EJECT6 /NO - KEEP FILLING
-EJECT3, JMS I [FORMFD /GENERATE FORM FEED
- JMP I [LOOKEX /--EXIT TO MAIN--
- PUNVAL, TAD PASS /IS THIS PASS 3?
- JMP PUNVA1 /IF SO, LIST STUFF
-
-
-/SEE IF EXPRESSION FOLLOWS XLIST
-/SKIP ON EXPRESSION
-
-EJECT7,
-XLISTZ, 0
- JMS I [SPNOR /IGNORE TRAILING SPACES
- TAD CHAR
- TAD [-"> /IS THERE AN EXPRESSION?
- SNA CLA
- JMP I XLISTZ /NO--RETURN--
- TAD CHAR
- SMA CLA
- ISZ XLISTZ /YES - INCREMENT RETURN ADDRESS
- JMP I XLISTZ /--RETURN--
-
-
-/DUMMY ERROR ROUTINE
-/TO SUPPRESS CERTAIN ERROR MESSAGES
-/ON PASS 1
-
-PERRO1, 0
- ISZ PERRO1 /SKIP ERROR MESSAGE POINTER
- JMP I PERRO1 /--RETURN--
-
-
-/CONSTANTS FOR DECIMAL PRINT
-
- DECIMAL
-FORMF8, -1000
- -100
- -10
- 0
- OCTAL
- PAGE
- /*********************************************************************
-
-INBUF=. /INPUT BUFFER
-
-OUBUF=. /OUTPUT BUFFER
-
-OUDEVH=.+400 /OUTPUT DEVICE HANDLER
-
-INDEVH=7200 /INPUT DEVICE HANDLER
-
-/**********************************************************************
-
-/ EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM
-
-/PASS1:
-
-/ THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
-/ THE INPUT HANDLER GOES IN 7200-7600.
-/ THERE IS NO OUTPUT HANDLER.
-/ HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
-/ LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
-/ SO THAT THE INPUT BUFFER IS 5600-7600
-
-/PASS2 AND PASS3:
-
-/ THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
-/ AT 5600-6200.
-/ THE OUTPUT HANDLER RESIDES IN 6200-6600.
-/ THE INPUT HANDLER RESIDES IN 7200-7600.
-/ THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
-/ BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
-/ THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
-/ DON'T EXIST.
-
-/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
-/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
-/WERE ANY HANDLERS THERE. IF ANY HANDLERS WERE THERE IN THE PAST,
-/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
- /MORE ONCE ONLY CODE
-
-OTYPE, 0
- DCA TEMP
- CDF 10
- TAD I TEMP
- AND [17 /GET DEVICE NUMBER
- TAD (DCB-1
- DCA TEMP
- TAD I TEMP /GET DCB ENTRY
- CDF
- JMP I OTYPE /--RETURN--
-
-/CHECK TO SEE HOW MUCH CORE EXISTS
-/AND STORE SYMBOL TABLE ACCORDINGLY
-
- IFZERO HASH<
-BEGINF, CDF 10 /WAS THE /K OPTION SELECTED TO
- TAD I (MPARAM /CHECK FOR MORE THAN 8K?
- CDF 0
- RTR
-ZK7630, SNL CLA /YES
- JMP I (CKBAT /NO - CHECK FOR BATCH, USE 8K ONLY
- CDF 50
- JMS FLD2 /WHAT IS HIGHEST FIELD?
- JMP FLD1-1 /5
- CDF 40
- JMS FLD2
- JMP FLD1 /4
- CDF 30
- JMS FLD2
- JMP FLD1+1 /3
- CDF 20
- JMS FLD2
- JMP FLD1+2 /2
- JMP OPTIM4 /1
- TAD [177 /IF FIELD 5, ALLOW 4095 SYMBOLS
-FLD1, TAD (1740 /OTHERWISE ALLOW 1740*(NR OF FIELDS)
- TAD (1740
- TAD (1740
-OPTIM0, TAD (1740
- DCA I (TAGMAX /SET HIGHEST ADDRESS FOR TAGS
- JMP I (BEGING
-
-OPTIM4, TAD I OPTIM1 /OPTIMIZE SEARCH PATTERN
- ISZ OPTIM1 /BY SUBSTITUTING CODE IN SEARCH
- DCA I OPTIM2 /ROUTINE
- ISZ OPTIM2
- ISZ OPTIM3
- JMP OPTIM4
-OPTIM8, TAD I OPTIM5
- ISZ OPTIM5
- DCA I OPTIM6
- ISZ OPTIM6
- ISZ OPTIM7
- JMP OPTIM8
- JMP OPTIM0
- >
-
- IFNZRO HASH<
- /SIZE CHECK OUR MACHINE
-
-BEGINF, CDF 10
- TAD I (MPARAM
- CDF
- RTR /K TO LINK
-ZK7630, SNL CLA /ALTER FOR COMPLEMENT OF K
- TAD [400 /TAD TO KEEP USR
- DCA I (USROFS
- CDF 50
- JMS FLD2
- ISZ HIFLD
- CDF 40
- JMS FLD2
- ISZ HIFLD
- CDF 30
- JMS FLD2
- ISZ HIFLD
- CDF 20
- JMS FLD2
- ISZ HIFLD
- TAD I (7777 /CHECK SOFT CORE SIZE
- AND (70
- SNA
- JMP CKSEV /NOT THERE
- CLL RTR
- RAR
- DCA HIFLD /THERE, SET HIFLD WITH IT
- TAD HIFLD /TAKE MIN(HIFLD,5)
- TAD (7772
- SMA CLA /SMA TO USE HIFLD
- TAD (5 /ELSE USE 5
- SZA
- DCA HIFLD /STORE 5 IF NECESSARY
-CKSEV, CDF 10
- TAD I (MPARAM+2 /LOOK AT /7
- CDF
- AND (4
- SNA CLA /SNA IF THERE
- JMP I (CKBAT /ELSE CHECK FOR BATCH
- TAD (-7 /SET TO PRINT 7 COLUMNS OF STAB
- DCA I (SYMNCL
- TAD (67^6 /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
- DCA I (SYMOFS
- JMP I (CKBAT /OK, CHECK FOR BATCH NOW
-OPTIM4, SNL /SNL IF BATCH RUNNING
- JMP I (BEGING /ELSE TAKE DEFAULT TABLE SIZE
- TAD (BPRIME/SET ALTERNATE TABLE SIZE
- DCA I (PRIMES /INTO THE ONCE ONLY CODE
- JMP I (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD
-HIFLD, 1 /8K MINIMUM
- >
-
-/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
-FLD2, 0
- TAD (FLD3
- DCA I FLD4
-FLD3, CLA
- TAD I FLD4
- NOP
- CDF
- TAD (-FLD3
- SZA CLA
- JMP FLD5
- TAD IOMON
- TAD [-200
- SNA CLA /IS FIELD THERE?
- JMP I FLD2 /YES--RETURN--
- TAD [200
- DCA IOMON
-FLD5, ISZ FLD2 /NO-INCREMENT RETURN ADDRESS
- JMP I FLD2 /--RETURN--
-
-FLD4, IOMON
- /OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
-/IN 8K
- IFZERO HASH<
-
-OPTIM1, OPTIMA
-OPTIM2, SETFLD+1
-OPTIM3, -7
-
-OPTIM5, OPTIMB
-OPTIM6, GETTG5
-OPTIM7, -21
-
-OPTIMA, RELOC SETFLD+1
-
- CLL CMA RTL
- TAD STM202
- DCA TAGXR
- CDF 10
- JMP I SETFLD
-STM202, -202
-SETFL4, 4
- RELOC
-
-OPTIMB, RELOC GETTG5
-
- TAD HIGHTG
- JMS SETFLD
- TAD TAGXR
- DCA XREG1
- TAD XREG1
- TAD SETFL4
- DCA XREG2
- TAD THISTG
- JMS SETFLD
-OPTIML, TAD I XREG2
- DCA I XREG1
- TAD XREG1
- CIA
- TAD TAGXR
- SZA CLA
- JMP OPTIML
- CDF
- RELOC
- >
- /OVERLAY CODE FOR DDT SYMBOL TABLE PRINT
-
-DSWIT2, IFZERO HASH<
- RELOC SYMPR9-2
- JMP SYMPRE
-SYMPRD, TAD SYM204
- JMS I OERROR
- TAD [377
- JMS I OERROR
- JMS SYMPRC
- DCA LINCNT
- JMP I SYMPRT
-SYMPRC, 0
- TAD [-200
- DCA SYMPR2
- TAD [200
- JMS I OERROR
- ISZ SYMPR2
- JMP .-3
- JMP I SYMPRC
- RELOC
- >
- IFNZRO HASH<
- RELOC SYMDDT
- ISZ THISTG
- JMP SYMLUP
-SYMXIT, TAD SYM204
- JMS I OERROR
- TAD [377
- JMS I OERROR
- JMS DDTLDR
- DCA LINCNT
- JMP I SYMPRT
-DDTLDR, 0
- TAD [7600
- DCA SYMCCT
- TAD [200
- JMS I OERROR
- ISZ SYMCCT
- JMP .-3
- JMP I DDTLDR
-SYM204, 204
- RELOC
- >
-DSWITB= .
- PAGE
- BEGING, CIF 10
- JMS I IOMON /CALL THE USR
- 12 /TO FIND OUT DSK:
-BEGINJ, TEXT /DSK/
- 7201 /DUMMY
- HLT /NEVER!
-/V3C TAD BEGINJ+1 /GET DEVICE NUMBER OF DSK:
-/V3C DCA CC7 /AND SET IT
- TAD BEGINJ+1
- DCA I BEGINL /AND SET IT INTO "PALBIN"
- CDF 10
- TAD I CC1 /GET PARAMETER WORD 1
- CDF
- CLL RTL /OPTION /B INTO LINK
- AND [400 /IS IT /F?
-ZF7650, SZA CLA
- DCA I CCX1 /YES: /F => NO 0 FILL
-ZB7430, SNL /IS IT /B?
- JMP .+3
- TAD CCX2
- DCA I CCX3 /YES: /B => ! IS SHIFT
- CDF 10
- TAD I CC1 /GET WORD 1 AGAIN
- CDF
- AND [200 /IS IT /E?
-ZE7640, SNA CLA
- JMP .+3
- TAD CCX8
- DCA I CCX4 /YES: /E => SET 'LG' ERROR
- CDF 10
- TAD I CCX5 /GET WORD 2 THIS TIME
- CDF
- RTL
-ZO7710, SMA CLA /IS IT /O?
- JMP .+3
- DCA I CCX6 /YES: /O => NO 200 ORG
- ISZ I CCX7
- CDF 10
- TAD I CC1 /GET WORD 1 AGAIN
- AND CC2 /IS IT /C?
- SNA CLA
- JMP I CC3 /NO: TRY FOR /L OR /G
- TAD I CC4 /CREF FILE SPECIFIED?
- SZA CLA
- JMP CC5 /YES
-CC6, TAD CC7 /NO: GIVE "CREFLS.TM"
- DCA I CC4
- ISZ CC6
- ISZ CC4
- ISZ CC8
- JMP CC6
- CC5, CDF
- CIF 10
- CLA IAC
- JMS I IOMON /LOOKUP "CREF.SV"
- 2
-CC13, CC9 /POINT TO NAME - BACK WITH START
-CC8, -5 /LENGTH GOES HERE
- JMP CC16 /NOT FOUND!
- TAD CC30
- JMS I CC31 /CHECK TYPE FILE
- SMA CLA
- JMP CC16 /NOT DIRECTORY IS ERROR
- TAD CC12
- DCA I CC121 /CSWITC=TAD I [7605
- TAD CC11
- DCA I CC111 /CSWIT1=CLA
- TAD CC10
- DCA I CC101 /CSWIT2=DCA BINSRT
- DCA I CC171 /CMOVE=0
- TAD CC13
- DCA I CC131 /CHAIN="CREF.SV"
- DCA I CC141 /LSWITC=0
- TAD CC30
- DCA I CC301 /NOPA22=7612
- DCA I CC20 /"BEGIAB"=0
- TAD CC21
- DCA I CC211 /"DIRSW1"=TAD [177
- TAD CC22
- DCA I CC221 /"PTPSW1"=TAD [232
- JMP I .+1
- CCC /KEEP GOING (SIGH)
-
-CC16, JMS I [ERROR
- CF /OPTION /C ERROR
- JMP I CC3 /TRY FOR /L OR /G
- CC171, SWAPR2+CMOVE
-CC141, LSWITC
-CC131, CHAIN
-CC121, CSWITC
-CC12, TAD I [7605
-CC111, CSWIT1
-CC11, CLA
-CC101, SWAPR2+CSWIT2
-CC10, DCA BINSRT
-CC301, SWAPR2+NOPA22
-CC30, 7612
-CC31, OTYPE
-CC1, MPARAM
-CC2, 1000
-CC3, BEGINH
-CC4, 7612
-
-CCX1, TEXT4X /V3C
-CCX2, OP3
-CCX3, OPEXPL
-CCX4, LGERR
-CCX5, MPARAM+1
-CCX6, FIELDY+1
-CCX7, FIELDY+2
-CCX8, JMS I PERROR
-
-CC7, 1
- FILENAME CREFLS.TM
-CC9, FILENAME CREF.SV
-
-CC20, BEGIAB
-CC21, TAD [177
-CC211, SWAPR2+DIRSW1
-CC22, TAD [232
-CC221, SWAPR2+PTPSW1
-
-BEGINL, PALBIN
- PAGE
- /***********************************************************************
-/SYMBOL TABLE
-/MOVED BY ASSEMBLER TO FIELD 1
-/MUST REMAIN IN ALPHABETICAL ORDER
-/***********************************************************************
-
-SYMS, 5777 /TERMINATOR
- 3777 /IMPOSSIBLE (LIMITING) SYMBOL
- 5777
- 0000
- IFNZRO HASH< /PSEUDO OPS MUST GO FIRST FOR EXPUNGE
- "I-300^45+4000+2000 /I
- 0
- 0
- 0400
-
- "P-300^45+"A-300+4000 /PAUSE
- "U-300^45+"S-300
- "E-300^45+4000
- PAUSEX
-
- "P-300^45+"A-300+4000 /PAGE
- "G-300^45+"E-300
- 4000
- PAGEX
-
- "T-300^45+"E-300+4000 /TEXT
- "X-300^45+"T-300
- 4000
- TEXTX
-
- "R-300^45+"E-300+4000 /RELOC
- "L-300^45+"O-300
- "C-300^45+4000
- RELOCY
-
- "O-300^45+"C-300+4000 /OCTAL
- "T-300^45+"A-300
- "L-300^45+4000
- OCTALX
-
- "N-300^45+"O-300+4000 /NOPUNCH
- "P-300^45+"U-300
- "N-300^45+"C-300+4000
- NOPUNX
-
-
- "I-300^45+"F-300+4000 /IFZERO
- "Z-300^45+"E-300
- "R-300^45+"O-300+4000
- IF0
- "I-300^45+"F-300+4000 /IFNZRO
- "N-300^45+"Z-300
- "R-300^45+"O-300+4000
- IFN0
-
- "I-300^45+"F-300+4000 /IFNDEF
- "N-300^45+"D-300
- "E-300^45+"F-300+4000
- IFND
-
- "I-300^45+"F-300+4000 /IFDEF
- "D-300^45+"E-300
- "F-300^45+4000
- IFD
-
- "F-300^45+"I-300+4000 /FIXTAB
- "X-300^45+"T-300
- "A-300^45+"B-300+4000
- FIXTBX
-
- "F-300^45+"I-300+4000 /FIXMRI
- "X-300^45+"M-300
- "R-300^45+"I-300+4000
- FIXMRX
-
- "F-300^45+"I-300+4000 /FILENAME
- "L-300^45+"E-300
- "N-300^45+"A-300+4000
- FILENX
-
- "F-300^45+"I-300+4000 /FIELD
- "E-300^45+"L-300
- "D-300^45+4000
- FIELDX
-
- "E-300^45+"X-300+4000 /EXPUNGE
- "P-300^45+"U-300
- "N-300^45+"G-300+4000
- EXPUNX
-
- "E-300^45+"N-300+4000 /ENPUNCH
- "P-300^45+"U-300
- "N-300^45+"C-300+4000
- ENPUNX
-
- "E-300^45+"J-300+4000 /EJECT
- "E-300^45+"C-300
- "T-300^45+4000
- EJECTX
- "D-300^45+"T-300+4000 /DTORG
- "O-300^45+"R-300
- "G-300^45+4000
- DTORGX
-
- "D-300^45+"E-300+4000 /DEVICE
- "V-300^45+"I-300
- "C-300^45+"E-300+4000
- DEVICX
-
- "D-300^45+"E-300+4000 /DECIMAL
- "C-300^45+"I-300
- "M-300^45+"A-300+4000
- DECIMX
- >
- "Z-300^45+"B-300+4000 /ZBLOCK
- "L-300^45+"O-300
- "C-300^45+"K-300+4000
- ZBLOCX
-
- "Z-300^45+4000+2000 /Z
- 0
- 0
- 0000
-
- "X-300^45+"L-300+4000 /XLIST
- "I-300^45+"S-300
- "T-300^45+4000
- XLISTY
-
- "T-300^45+"S-300+4000 /TSK
- "K-300^45
- 0
- 6045
-
- "T-300^45+"S-300+4000 /TSF
- "F-300^45
- 0
- TSF
-
- "T-300^45+"P-300+4000 /TPC
- "C-300^45
- 0
- TPC
-
- "T-300^45+"L-300+4000 /TLS
- "S-300^45
- 0
- TLS
-
- "T-300^45+"F-300+4000 /TFL
- "L-300^45
- 0
- 6040
- IFZERO HASH<
- "T-300^45+"E-300+4000 /TEXT
- "X-300^45+"T-300
- 4000
- TEXTX
- >
- "T-300^45+"C-300+4000 /TCF
- "F-300^45
- 0
- TCF
-
- "T-300^45+"A-300+4000 /TAD
- "D-300^45+4000
- 0
- TAD 0
-
- "S-300^45+"Z-300+4000 /SZL
- "L-300^45
- 0
- SZL
-
- "S-300^45+"Z-300+4000 /SZA
- "A-300^45
- 0
- SZA
-
- "S-300^45+"W-300+4000 /SWP
- "P-300^45
- 0
- 7521
-
- "S-300^45+"T-300+4000 /STL
- "L-300^45
- 0
- STL
-
- "S-300^45+"T-300+4000 /STA
- "A-300^45
- 0
- STA
-
- "S-300^45+"R-300+4000 /SRQ
- "Q-300^45
- 0
- 6003
-
- "S-300^45+"P-300+4000 /SPA
- "A-300^45
- 0
- SPA
- "S-300^45+"N-300+4000 /SNL
- "L-300^45
- 0
- SNL
-
- "S-300^45+"N-300+4000 /SNA
- "A-300^45
- 0
- SNA
-
- "S-300^45+"M-300+4000 /SMA
- "A-300^45
- 0
- SMA
-
- "S-300^45+"K-300+4000 /SKP
- "P-300^45
- 0
- SKP
-
- "S-300^45+"K-300+4000 /SKON
- "O-300^45+"N-300
- 0
- 6000
-
- "S-300^45+"G-300+4000 /SGT
- "T-300^45
- 0
- 6006
-
- "R-300^45+"T-300+4000 /RTR
- "R-300^45
- 0
- RTR
-
- "R-300^45+"T-300+4000 /RTL
- "L-300^45
- 0
- RTL
-
- "R-300^45+"T-300+4000 /RTF
- "F-300^45
- 0
- 6005
-
- "R-300^45+"S-300+4000 /RSF
- "F-300^45
- 0
- RSF
- "R-300^45+"R-300+4000 /RRB
- "B-300^45
- 0
- RRB
-
- "R-300^45+"P-300+4000 /RPE
- "E-300^45
- 0
- 6010
-
- "R-300^45+"M-300+4000 /RMF
- "F-300^45
- 0
- RMF
-
- "R-300^45+"I-300+4000 /RIF
- "F-300^45
- 0
- RIF
-
- "R-300^45+"I-300+4000 /RIB
- "B-300^45
- 0
- RIB
-
- "R-300^45+"F-300+4000 /RFC
- "C-300^45
- 0
- RFC
- IFZERO HASH<
- "R-300^45+"E-300+4000 /RELOC
- "L-300^45+"O-300
- "C-300^45+4000
- RELOCY
- >
- "R-300^45+"D-300+4000 /RDF
- "F-300^45
- 0
- RDF
-
- "R-300^45+"A-300+4000 /RAR
- "R-300^45
- 0
- RAR
-
- "R-300^45+"A-300+4000 /RAL
- "L-300^45
- 0
- RAL
- "P-300^45+"S-300+4000 /PSF
- "F-300^45
- 0
- PSF
-
- "P-300^45+"P-300+4000 /PPC
- "C-300^45
- 0
- PPC
-
- "P-300^45+"L-300+4000 /PLS
- "S-300^45
- 0
- PLS
-
- "P-300^45+"C-300+4000 /PCF
- "F-300^45
- 0
- PCF
-
- "P-300^45+"C-300+4000 /PCE
- "E-300^45
- 0
- 6020
- IFZERO HASH<
- "P-300^45+"A-300+4000 /PAUSE
- "U-300^45+"S-300
- "E-300^45+4000
- PAUSEX
-
- "P-300^45+"A-300+4000 /PAGE
- "G-300^45+"E-300
- 4000
- PAGEX
- >
- "O-300^45+"S-300+4000 /OSR
- "R-300^45
- 0
- OSR
-
- "O-300^45+"P-300+4000 /OPR
- "R-300^45
- 0
- OPR
- IFZERO HASH<
- "O-300^45+"C-300+4000 /OCTAL
- "T-300^45+"A-300
- "L-300^45+4000
- OCTALX
- >
- IFZERO HASH<
- "N-300^45+"O-300+4000 /NOPUNCH
- "P-300^45+"U-300
- "N-300^45+"C-300+4000
- NOPUNX
- >
- "N-300^45+"O-300+4000 /NOP
- "P-300^45
- 0
- NOP
-
- "M-300^45+"Q-300+4000 /MQL
- "L-300^45
- 0
- 7421
-
- "M-300^45+"Q-300+4000 /MQA
- "A-300^45
- 0
- 7501
-
- "L-300^45+"A-300+4000 /LAS
- "S-300^45
- 0
- LAS
-
- "K-300^45+"S-300+4000 /KSF
- "F-300^45
- 0
- KSF
-
- "K-300^45+"R-300+4000 /KRS
- "S-300^45
- 0
- KRS
-
- "K-300^45+"R-300+4000 /KRB
- "B-300^45
- 0
- KRB
-
- "K-300^45+"I-300+4000 /KIE
- "E-300^45
- 0
- 6035
-
- "K-300^45+"C-300+4000 /KCF
- "F-300^45
- 0
- 6030
- "K-300^45+"C-300+4000 /KCC
- "C-300^45
- 0
- KCC
-
- "J-300^45+"M-300+4000 /JMS
- "S-300^45+4000
- 0
- JMS 0
-
- "J-300^45+"M-300+4000 /JMP
- "P-300^45+4000
- 0
- JMP 0
-
- "I-300^45+"S-300+4000 /ISZ
- "Z-300^45+4000
- 0
- ISZ 0
-
- "I-300^45+"O-300+4000 /IOT
- "T-300^45
- 0
- IOT
-
- "I-300^45+"O-300+4000 /ION
- "N-300^45
- 0
- ION
-
- "I-300^45+"O-300+4000 /IOF
- "F-300^45
- 0
- IOF
- IFZERO HASH<
- "I-300^45+"F-300+4000 /IFZERO
- "Z-300^45+"E-300
- "R-300^45+"O-300+4000
- IF0
-
- "I-300^45+"F-300+4000 /IFNZRO
- "N-300^45+"Z-300
- "R-300^45+"O-300+4000
- IFN0
-
- "I-300^45+"F-300+4000 /IFNDEF
- "N-300^45+"D-300
- "E-300^45+"F-300+4000
- IFND
- >
- IFZERO HASH<
- "I-300^45+"F-300+4000 /IFDEF
- "D-300^45+"E-300
- "F-300^45+4000
- IFD
- >
- "I-300^45+"A-300+4000 /IAC
- "C-300^45
- 0
- IAC
- IFZERO HASH<
- "I-300^45+4000+2000 /I
- 0
- 0
- 0400
- >
- "H-300^45+"L-300+4000 /HLT
- "T-300^45
- 0
- HLT
-
- "G-300^45+"T-300+4000 /GTF
- "F-300^45
- 0
- 6004
-
- "G-300^45+"L-300+4000 /GLK
- "K-300^45
- 0
- GLK
- IFZERO HASH<
- "F-300^45+"I-300+4000 /FIXTAB
- "X-300^45+"T-300
- "A-300^45+"B-300+4000
- FIXTBX
-
- "F-300^45+"I-300+4000 /FIXMRI
- "X-300^45+"M-300
- "R-300^45+"I-300+4000
- FIXMRX
-
- "F-300^45+"I-300+4000 /FILENAME
- "L-300^45+"E-300
- "N-300^45+"A-300+4000
- FILENX
-
- "F-300^45+"I-300+4000 /FIELD
- "E-300^45+"L-300
- "D-300^45+4000
- FIELDX
- >
- IFZERO HASH<
- "E-300^45+"X-300+4000 /EXPUNGE
- "P-300^45+"U-300
- "N-300^45+"G-300+4000
- EXPUNX
-
- "E-300^45+"N-300+4000 /ENPUNCH
- "P-300^45+"U-300
- "N-300^45+"C-300+4000
- ENPUNX
-
- "E-300^45+"J-300+4000 /EJECT
- "E-300^45+"C-300
- "T-300^45+4000
- EJECTX
-
- "D-300^45+"T-300+4000 /DTORG
- "O-300^45+"R-300
- "G-300^45+4000
- DTORGX
-
- "D-300^45+"E-300+4000 /DEVICE
- "V-300^45+"I-300
- "C-300^45+"E-300+4000
- DEVICX
-
- "D-300^45+"E-300+4000 /DECIMAL
- "C-300^45+"I-300
- "M-300^45+"A-300+4000
- DECIMX
- >
- "D-300^45+"C-300+4000 /DCA
- "A-300^45+4000
- 0
- DCA 0
-
- "C-300^45+"M-300+4000 /CML
- "L-300^45
- 0
- CML
-
- "C-300^45+"M-300+4000 /CMA
- "A-300^45
- 0
- CMA
-
- "C-300^45+"L-300+4000 /CLL
- "L-300^45
- 0
- CLL
- "C-300^45+"L-300+4000 /CLA
- "A-300^45
- 0
- CLA
-
- "C-300^45+"I-300+4000 /CIF
- "F-300^45
- 0
- CIF
-
- "C-300^45+"I-300+4000 /CIA
- "A-300^45
- 0
- CIA
-
- "C-300^45+"D-300+4000 /CDF
- "F-300^45
- 0
- CDF
-
- "C-300^45+"A-300+4000 /CAF
- "F-300^45
- 0
- 6007
-
- "B-300^45+"S-300+4000 /BSW
- "W-300^45
- 0
- 7002
-
- "A-300^45+"N-300+4000 /AND
- "D-300^45+4000
- 0
- AND 0
-
- 4001 /TERMINATOR
- 0000 /IMPOSSIBLE (LIMITING) SYMBOL
- 4000
- 0000
-
-SYME=.
-
-/**********************************************************************
-/TOP OF SYMBOL TABLE
-/**********************************************************************
- SWAP2=.
-
-/**********************************************************************
-/CODE UNIQUE TO PASSES 1 AND 2
-/SWAPPED IN FOR PASSES 1 AND 2
-/OVERLAYED DURING PASS 3 *** NO LITERALS ***
-
- RELOC 1000 /ASSEMBLED INTO 1000-1247
-
- SWAPB2= .
- SWAPR2= SWAP2-SWAPB2 /RELOCATION FACTOR FOR THIS CODE
-
-OOPEN, 0
- TAD OPEN01 /OPEN BINARY AND LISTING FILES
- DCA XOUHND /SET ADDRESS OF DEVICE HANDLER
- TAD OPEN02
- DCA XOUBLK
- TAD [-5
- DCA XOUELE /SET NEW OUTPUT FILE LENGTH
- CDF 10
- TAD I OUFPTR
- CDF
- DCA I XOUBLK
- ISZ XOUBLK
- ISZ OUFPTR
- ISZ XOUELE /INCREMENT OUTPUT FILE LENGTH
- JMP .-7
- TAD OPEN02
- IAC
- DCA XOUBLK /SET POINTER TO NEW FILENAME
- TAD XOUBLK
- DCA I OPEN04
- CIF 10
- JMS I IOMON /CALL USER SERVICE ROUTINES
- 13 /*RESET SYSTEM TABLES*
- DCA I OPEN05 /DELETE UNCLOSED FILES AND
- TAD I OPEN02 /DELETE HANDLERS
- AND [17 /GET NEW DEVICE HANDLER #
- SNA /OUTPUT INHIBIT?
- JMP ONOFIL /YES
- CIF 10 /NO
- JMS I IOMON /CALL USER SERVICE ROUTINE
- 1 /*FETCH DEVICE HANDLER*
-XOUHND, 0 /LOADING ADDRESS
- HLT /HANDLER NOT AVAILABLE
-OUENTR, TAD I OPEN02 /NORMAL RETURN - GET OUTPUT
- CIF 10 /DEVICE NUMBER AND FILE LENGTH
- JMS I IOMON /CALL NEW SERVICE ROUTINES
- 3 /*ENTER OUTUT FILE
-XOUBLK, 0 /POINTER TO FILENAME
-XOUELE, 0 /FILE LENGTH
- JMP OEFAIL /ERROR RETURN
- DCA I OPEN06 /NORMAL RETURN
- JMS I OPEN07
- TAD XOUHND
- TAD [200 /LINK IS CLEAR!!
- SNL CLA
- TAD [400
- TAD OUFDEV
- DCA I OUFINP
- TAD I OUFINP
- CLL RAR
- CIA
- TAD OU3501
- DCA INCTL
- ISZ OOPEN
- TAD XOUHND
- DCA I OPEN09
- TAD XOUBLK
- DCA I OPEN10
- TAD XOUELE
- DCA I OPEN11
- JMP I OOPEN /--RETURN--
-
-OEFAIL, TAD I OPEN02
- AND [7760
- SNA CLA
- JMP I OPEN12 /DE**FATAL ERROR**
- TAD I OPEN02
- AND [17
- DCA I OPEN02
- JMP OUENTR
-
-ONOFIL, ISZ I OPEN05 /SET OUTPUT INHIBIT SWITCH
- JMP I OOPEN /--RETURN--
-
-OUFPTR, 7600
-
-OPEN01, OUDEVH+1
-OPEN02, OUFILE
-OPEN04, OUCNAM
-OPEN05, OUTINH
-OPEN06, OUCCNT
-OPEN07, OUSETP
-OPEN09, OUHNDL
-OPEN10, OUBLK
-OPEN11, OUELEN
-OPEN12, SYSERR
-OU3501, 3501
-OUFDEV, OUDEVH
-OUFINP, INBUFP
- /CONTINUATION OF FIXTAB HANDLER
-
-FIXTAY, IFZERO HASH<
- TAD HIGHTG /SET POINTERS TO TABLE
- CMA
- >
- IFNZRO HASH<
- TAD TAGMAX
- CIA
- >
- DCA TEMP3
- DCA THISTG
-FIXTAX, JMS I [FINDTG /GET A TAG
- AC3777
- AND TAG1
- IFNZRO HASH<
- SZA
- >
- TAD [4000 /SET BIT 0 OF FIRST WORD TO 1
- DCA TAG1 /RETURN IT TO TABLE
- JMS I [PUTTAG
- ISZ THISTG
- ISZ TEMP3 /DONE WITH TABLE YET?
- JMP FIXTAX /NO
- JMP I [LOOKEX /YES--EXIT TO MAIN--
-
-/OUTPUT ONE REGISTER - BINARY
-/ENTER WITH CONTENTS IN AC
-
-PUNOUT, 0
- DCA PUNOU1
- TAD PUNOU1
- RTR
- RTR
- RTR
- AND [177
- JMS I OCHAR /OUTPUT FIRST FRAME
- TAD PUNOU1
- AND [77
- JMS I OCHAR /OUTPUT SECOND FRAME
- JMP I PUNOUT /--RETURN--
-
-PUNOU1,
-IOPEN, 0 /SET UP INPUT ROUTINE
- CLA CMA /TO OPEN FILE
- DCA I IOPEN1
- ISZ I IOPEN2
- TAD IOPEN3
- DCA I IOPEN4
- ISZ I IOPEN5
- TAD [LINBUF+120
- DCA TXTPTR
- JMP I IOPEN /--RETURN--
-
-IOPEN1, INCHCT
-IOPEN2, INEOF
-IOPEN3, 7617
-IOPEN4, INFPTR
-IOPEN5, FORMSW
- PAGE
- /START PASS 2 *** NO LITERALS HERE EITHER ***
-
-START1, TAD [ERROR
- DCA PERROR /RESET PREUDO-ERROR ROUTINE
- JMS I ST1OPN /OPEN PASS 2 OUTPUT FILE
- JMP NOPA21 /NO PASS 2 IF PASS 3
-NOPA23, TAD I ST1OBL
- DCA BINSRT
- DCA PUNCHX /CLEAR PUNCH INHIBIT
- JMS START3
- JMP I .+1
- START2-1
-
-NOPA21, CDF 10
- TAD I NOPA22 /IS THERE A PASS 3?
- CDF
- SNA CLA
- JMP NOPA23 /NO - DO PASS 2
- ISZ PASS /SKIP PASS 2
- NOP
- JMP NOPAS2 /CONTINUE TO PASS 3
-
-NOPA22, 7605
-
-START3, 0 /GENERATE LEADER/TRAILER
- TAD LEADER
- DCA TXTPTR
- TAD [200
- JMS I OCHAR
- ISZ TXTPTR
- JMP .-3
- JMP I START3 /--RETURN--
-
-LEADER, -10
- /END PASS 2
-
-ENDPA2, JMS I [DUMPZ /DUMP PAGE 0 LITERALS
- DCA PUNCHX
- CLL /V3C
- TAD CHKSUM /OUTPUT CHECKSUM
- JMS I [PUNOUT /PUNCH THE CHECKSUM
- JMS START3 /GENERATE LEADER/TRAILER
- JMS I EN2CLS /CLOSE PASS 2 OUTPUT FILE
-NOPAS2, TAD EN2LSO
- DCA OERROR /SET NEW OUTPUT TO BE LISTING
- ISZ I EN2OU1
-CMOVE, JMP CMOVA /ZEROED IF /C
- CDF 10 /MOVE CODE FOR /C OPTION
-CMOVB, TAD I CMOV1
- DCA I CMOV2 /MOVE OUTPUT FILE STORAGE
- ISZ CMOV1
- ISZ CMOV2
- ISZ CMOV3
- JMP CMOVB /LOOP
-CMOVA, CDF
- JMS I ST1OPN /OPEN 3RD PASS FILE
- DCA I CMOV4 /NO 3RD PASS
- TAD I ST1OBL /GET FILE START
-CSWIT2, CLA /"DCA BINSRT" IF /C
- TAD PTPSW1
- DCA I EN2PTP /RESET PAPERTAPE SWITCH
- TAD DIRSW1
- DCA I EN2DIR /RESET DIRECTORY SWITCH
- JMS I PIOPEN
- JMP I .+1
- LOADOV /OVERLAY THIS AREA WITH PASS3 CODE
-
-PIOPEN, IOPEN
-DIRSW1, TAD [177
-PTPSW1, TAD [232
-
-CMOV1, 7605
-CMOV2, 7600
-CMOV3, -12
-CMOV4, NSWITC
-EN2CLS, OCLOSE
-EN2LSO, LISOUT
-EN2OU1, OUTPT1
-EN2PTP, PTPSW
-EN2DIR, DIRSW
-ST1OPN, OOPEN
-ST1OBL, OUBLK
-SWAPE2, RELOC
- IFNZRO ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
- PAGE
- IFNZRO HASH<
-
- /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS
-
-HSHSMS, 0
- JMS I (7607 /WRITE THE SYMBOL TABLE SORT OVERLAY
- 4210 /2 PAGES FROM FIELD 1
- OUDEVH+400 /FROM HERE
- ASWAP+1 /TO HERE
- JMP I (SYSERR/WONDERFUL.
- TAD I (USROFS
- SZA CLA /SZA IF KICKING OUT USR
- TAD (12 /ELSE FUDGE POINTER
- TAD I (HIFLD /FIRST SET HASH TABLE SIZE
- TAD PRIMES /ACCORDING TO CORE SIZE
- DCA PRIME
- TAD I PRIME
- DCA PRIME
- TAD PRIME
- CIA
- DCA I (MPRIME
- TAD I (USROFS
- SZA CLA
- JMP KPUSR /JMP IF KEEPING USR
- CDF 10 /SERVE NOTICE WE'RE OCCUPYING FIELD 1
- AC7776
- AND I (JSBITS
- DCA I (JSBITS
- TAD [7700
- DCA IOMON /AND POINT AT PROPER MONITOR E.P.
-KPUSR, CDF
- TAD I (MPRIME /HOW MANY SLOTS TO WIPE
- DCA LAST3 /TO COUNTER
- TAD I (USROFS
- CLL RTL
- TAD (7777 /FUDGE THE INITIAL AUTO XR
- JMP CLRGO /INTO THE LOOP NOW
-CLRLUP, TAD LAST1
- TAD (-7577
- SZA CLA /SZA IF NEED TO DO NEXT FIELD
- JMP CLCDF0+1/ELSE CLEAR ANOTHER
- TAD (10
- TAD CLCDF0
- DCA CLCDF0 /CDF INSTR GETS BUMPED
- STA
-CLRGO, DCA LAST1 /XRGETS SET
-CLCDF0, CDF 10 /INITIALLY CDF 10
- DCA I LAST1
- DCA I LAST1
- DCA I LAST1
- DCA I LAST1
- ISZ LAST3 /SKP IF NO MORE
- JMP CLRLUP /ELSE DO ANOTHER
- CDF /THE TABLE IS CLEAN
- TAD (HSHRTN
- DCA I [GETTAG
- STA
- DCA HIGHTG /HIGHTG=CURRENT SYMBOL INDEX
- TAD (SYMS+3 /USE THESE AUTO XR'S NOW
- DCA LAST1
- TAD LAST1
- DCA LAST2
-HSHLP, TAD I LAST1
- AND [1777 /FIRST, STRIP THE TYPE BITS
- DCA I (NAME1
- AC3777
- AND I LAST1
- DCA I (NAME2
- AC3777
- AND I LAST1
- DCA I (NAME3
- ISZ LAST1 /SKIP THE VALUE
- JMP I (GETTGH /GO FIND IT'S PLACE
-HSHRTN, CLA CLL
- TAD I LAST2
- DCA I (NAME1
- TAD I LAST2
- DCA I (NAME2
- TAD I LAST2
- DCA I (NAME3
- TAD I LAST2
- DCA VALUE2
- JMS I (INSRTG /AND STORE IT
- TAD LAST1
- TAD (1-SYME+4
- SZA CLA
- JMP HSHLP /LOOP IF MORE TO GO
- JMP I HSHSMS /--RETURN--
-
-PRIMES, .
- 1737 /1 FIELD
- 3673 /2 FIELDS
- 5633 /3 FIELDS
- 7577 /4 FIELDS
- 7775 /5 FIELDS (THE LAST MOSTELY WASTE)
- BPRIMES=.-1 /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
- 1737 /1 FIELD (MEANS NO BATCH)
- 3133 /2 FIELDS
- 5075 /3 FIELDS
- 7035 /4 FIELDS
- 7775 /5 FIELDS (SOME OF WASTE FOR BATCH)
-
- 1335 /STILL ANOTHER ALTERNATE SET IF KEEPING USR
- 3273
- 5237
- 7175
- 7775
-
- 0
- 2535
- 4465
- 6437
- 7775
-
- PAGE
- >
- /**************************************************************
-/PAGE 0 LITERALS
-/**************************************************************
- IFNZRO HASH<
-
- /SYMBOL TABLE SORT OVERLAY
- /ONLY SWAPPED IF TABLE WILL BE LISTED
-
- /FIRST, SOME EQUATES
-
- PPUTTAG= [PUTTAG
- PFINDTG= [FINDTG
- O1777= [1777
- O7774= [7774
-
- SXR= XREG1
- TXR= XREG2
- SXR2= LAST1
- TXR2= LAST2
- UXR= LAST3
- DXR= LAST4
-
- BEG= LOC
- END= OFFSET
- LO= OFSBUF
- HI= STARSW
- MED= OP
-
- FIELD 1 /SET THE FIELD NOW
- *OUDEVH+400 /IT GOES HERE
-
-SORTAB, 0 /FIRST LOC IN PAGE
- TAD TAGMAX
- CIA
- DCA TEMP /TEMP=#CELLS TO SCAN
-
- /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
- /OUT WITH EMPTIES AND PERMANENTS
-
- DCA HIGHTG /TARGET POINTER
- DCA TEMP2 /SOURCE POINTER
-DEFLP, TAD TEMP2
- DCA THISTG
- JMS I PFINDTG /GET THE NEXT STAB CELL
- TAD TAG1
- CLL RAL
- SNA SZL CLA /AND THERE BUT NOT FIXED?
- JMP DEFNUL /NO, DON'T STORE IT
- TAD O1777 /YES,DISCARD THE TYPE BITS NOW
- AND TAG1
- DCA TAG1
- AC3777
- AND TAG2
- DCA TAG2
- AC3777
- AND TAG3
- DCA TAG3
- TAD HIGHTG
- DCA THISTG
- JMS I PPUTTAG
- ISZ HIGHTG
-DEFNUL, ISZ TEMP2
- ISZ TEMP /TRY AGAIN
- JMP DEFLP
- JMS I (SORT /NOW SORT THEM
- JMP I SORTAB /EXIT TO PRTSTAB
- /MOVE A SYMBOL THRU THE TABLE
-
-SMOV, 0
- TAD SXR2 /GET SOURCE DF+XREG
- JMS GETFLD
- DCA SMVCD1
- TAD TXR
- DCA SXR
- TAD TXR2
- JMS GETFLD
- DCA SMVCD2
- TAD O7774
- DCA SSWT
-SMVCD1, 0
- TAD I SXR
-SMVCD2, 0
- DCA I TXR
- ISZ SSWT
- JMP SMVCD1
-SMVCD0, CDF
- JMP I SMOV
-
- /AUXILLIARY FIELD+XREG SETTER
-
-GETFLD, 0
- CLL
- TAD I (USROFS /IF KEEPING USR
- DCA TXR /AC=SYM NUM
- DCA SMVCD2
- TAD TXR
- ISZ SMVCD2
- CML
- TAD (-1740
- SNL
- JMP .-4
- CLL RTL
- TAD (-202 /SETS AS IN SETFLD...
- DCA TXR /TENTATIVELY SET TXR
- TAD SMVCD2
- CLL RTL
- RAL
- TAD SMVCD0
- JMP I GETFLD /EXIT WITH AC SET TO CDF INSTR
- /ROUTINE TO EXCHANGE SYMBOLS LO AND HI
-
-SSWT, 0
- TAD HI
- JMS GETFLD
- DCA SWCDF1
- TAD SWCDF1
- DCA SWCDF3
- TAD TXR
- DCA SXR
- TAD SXR
- DCA SXR2 /SXR'S FOR HIGH SYMBOL
- TAD LO
- JMS GETFLD
- DCA SWCDF2
- TAD TXR
- DCA TXR2 /TXR'S FOR LOW SYMBOL
- TAD O7774
- DCA SMOV /COUNTER
-
-SWCDF1, 0
- TAD I SXR /GET HI SYM WORD
- DCA GETFLD /HOLD IT
-SWCDF2, 0
- TAD I TXR /GET LO
- DCA SCOM /HOLD IT
- TAD GETFLD
- DCA I TXR2 /STORE HI IN LOW
-SWCDF3, 0
- TAD SCOM /NOW STORE LO
- DCA I SXR2 /IN HI
- ISZ SMOV
- JMP SWCDF1+1
- CDF
- JMP I SSWT
- /COMPARE SYMBOLS + SET LINK THEREBY
-
-SCOM, 0
- DCA THISTG /AC=TAG #
- JMS I (SETFLD
- TAD I TAGXR
- CLL CIA
- TAD TAG1
- SZA CLA
- JMP SCOMRT
- TAD I TAGXR
- CLL CIA
- TAD TAG2
- SZA CLA
- JMP SCOMRT
- TAD I TAGXR
- CLL CIA
- TAD TAG3
- SNA CLA
- HLT /NEVER
-SCOMRT, CDF
- JMP I SCOM
-
- PAGE
-
-
-
-
-
-
-
-
- /SORT ROUTINE HERE
-
-SORT, 0
- DCA BEG /INITIALIZE PARTITION BOUNDS
- STA STL
- TAD HIGHTG
- DCA END /ARE THERE ANY SYMBOLS?
- SZL
- JMP I SORT /NO EXIT WITH LINK SET
- TAD (LITBF1-1+26 /OK, SET STACK NOW
- DCA DXR
- TAD DXR
- DCA UXR
-
-SLOOP, STA
- TAD LEVEL
- DCA LEVEL
-SLOOP2, TAD BEG
- STL CIA
- TAD END
- SNA SZL
- JMP OKCOOL /END.LOS.BEG
- CLL RAR
- TAD BEG
- DCA MED /MED=BEG+(END-BEG)/2
- TAD MED
- DCA THISTG
- JMS I PFINDTG /T=A(MED)
- TAD BEG
- DCA LO /LO=BEG
- TAD END
- DCA HI /HI=END
- TAD MED
- CIA
- TAD BEG
- SNA CLA
- JMP JUSTWO /BEG.EQ.MED
- TAD LO
- DCA SXR2
- TAD MED
- DCA TXR2
- JMS I (SMOV /A(MED)=A(LO)
-BEGLP, ISZ LO
- TAD LO
- CLL CIA
- TAD HI
- SNL CLA
- JMP DONE /HI.LOS.LO
- TAD LO
- JMS I (SCOM /T.GT.A(LO) TO LINK
- SZL CLA
- JMP BEGLP /T.GT.A(LO)
- JMP ENDGO /T.LT.A(LO)
-ENDLP, TAD LO
- CLL CIA
- TAD HI
- SNL CLA
- JMP DONE /IF HI.LO.LO
-ENDGO, TAD HI
- JMS I (SCOM
- SZL CLA
- JMP SWITCH
- STA
- TAD HI
- DCA HI
- JMP ENDLP
-SWITCH, JMS I (SSWT
- STA
- TAD HI
- DCA HI
- JMP BEGLP
- DONE, TAD HI
- DCA SXR2
- TAD BEG
- DCA TXR2
- JMS I (SMOV /A(BEG)=A(HI)
- TAD HI
- DCA THISTG
- JMS I PPUTTAG /A(HI)=T
- AC7776
- TAD UXR
- DCA UXR
- TAD UXR
- DCA DXR
- TAD HI
- CLL CIA
- TAD MED
- SZL CLA
- JMP HIBIGR /DEFER HIGH FOR LATER
- TAD BEG
- DCA I DXR /DEFER LO FOR LATER
- STA
- TAD HI
- DCA I DXR
- TAD HI
- IAC
- DCA BEG
- JMP SLOOP
-HIBIGR, TAD HI
- IAC
- DCA I DXR
- TAD END
- DCA I DXR
- STA
- TAD LEVEL /CLUMSY
- DCA LEVEL
- CLL STA
- TAD HI
- DCA END
- SNL /PROTECT AGAINST WRAP AROUND
- JMP OKCOOL
- JMP SLOOP2
-
-JUSTWO, TAD HI
- JMS I (SCOM
- SZL CLA
- JMS I (SSWT /SWITCH IF T.GT.A(HI)
-OKCOOL, CLA CLL /NOW CONSIDER PREV PARTITIONS
- TAD I UXR
- DCA BEG
- TAD I UXR
- DCA END
- ISZ LEVEL
- JMP SLOOP2 /REITERATE
- JMP I SORT /DONE, RETURN WITH A CLEAR LINK
-LEVEL, 0
- PAGE
- >
- /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
- /IN THE HEADING
-
- IFZERO HASH <
- FIELD 1
- *OUDEVH+400
- >
-
-FMTDAT, 0
- TAD I (MDATE /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
- CDF /RUN WITH DF = 0
- SNA
- JMP NODATE /EXIT IF NO DATE
- DCA DATWD /ELSE STORE DATE WORD
- TAD ("0-1
- DCA I DATPTR /SET FIRST DIGIT OF DAY
- TAD DATWD /NOW GET DAY BITS
- CLL RTR
- RAR
- AND (37
- JMS DIV10 /DO DAY DIGITS NOW
- TAD ("-
- DCA I DATPTR /STORE DASH
- ISZ DATPTR
- TAD DATWD /NOW GET MONTH BITS
- TAD (7400 /REDUCE TO ORIGIN 0
- AND (7400
- CLL RTL
- RTL
- RAL
- DCA DIV10
- TAD DIV10
- CLL RAR /GENERATE 1.5*MONTH INDEX
- TAD DIV10
- TAD (MONLST /INDEX MONTH LIST (SIXBIT)
- DCA MONPTR
- TAD (-3
- DCA DIV10 /SET 3 TIMES THRU LOOP
- SZL
- JMP MONGO /IF EVEN START AT RIGHT HALF
-MONLP, TAD I MONPTR
- CLL RTR
- RTR
- RTR
- JMS MONPUT /PUT LEFT CHAR
-MONGO, TAD I MONPTR
- JMS MONPUT /PUT RIGHT CHAR
- ISZ MONPTR
- JMP MONLP /LOOP FOR MORE
-MONPUT, 0
- TAD (40
- AND (77
- TAD (40 /CONVERT TO 7BIT
- DCA I DATPTR
- ISZ DATPTR
- ISZ DIV10
- JMP I MONPUT /RETURN TO UNPACK LOOP
- TAD ("-
- DCA I DATPTR /PUT ANOTHER DASH
- ISZ DATPTR
- TAD ("6
- DCA I DATPTR /SETUP YEAR TENS DIGIT FOR DIVIDE
- TAD I (BIPCCL
- AND (600 /GET YEAR EXTENSION FROM 600 BITS
- CLL RTR
- RTR
- DCA DIV10
- TAD DATWD /NOW GET YEAR
- AND (7 /ISOLATE IT
- TAD DIV10 /ADD EXTENSION
- JMS DIV10 /UNPACK IT
-NODATE, CIF CDF /NOW RETURN
- JMP I FMTDAT
-
-DIV10, 0
- ISZ I DATPTR
- TAD (-12
- SMA
- JMP .-3 /REDUCE MON 10.
- TAD (12+"0
- ISZ DATPTR
- DCA I DATPTR /STORE LOW DIGIT
- ISZ DATPTR
- JMP I DIV10 /--RETURN--
-
-DATPTR, DATE
-DATWD, 0
-MONPTR, 0
-
- PAGE
-
- $$$$$
DELETED src/os8-v3f/PIP.PA
Index: src/os8-v3f/PIP.PA
==================================================================
--- src/os8-v3f/PIP.PA
+++ /dev/null
@@ -1,2265 +0,0 @@
-/3 PIP FOR OS/8 MONITOR
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975,1977
-/BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- / 4-MAY-1977 FILE: PIP.PA OS/8 VERSION 14A
-/RL/EF/ET.AL./S.R./E.S.
-
-
-
-/ABSTRACT----
-/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
-/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
-/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
-/CONFIGURATION.
-
-
-/VERSION 3 MODS:
-
-/FIXED PROBLEM WITH ONE-PAGE WRITE
-/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
-/ WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
-/DATES STILL DON'T LINE UP
-/'0 FREE BLOCKS'
-/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
-/ALLOW 7-BIT ^C
-/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
-/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
-/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
-/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
-/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE
-
-
-/MAINTENANCE RELEASE CHANGES:
-
-/1. FIXED LENGTH OF ALL VARIETIES OF RF08
-/2. ADDED RX01 TO INTERNAL LENGTH TABLES
-/3. CHANGED VERSION NUMBER TO V10
-/4. ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER
-
-/E.S. DISABLED /E,/F,/L
-/E.S. FIXED /Y OPTION PER SPR
-
-/ DEVICE UPGRADE KIT CHANGES(V12C):
-/ 1.ADDED RX02 SUPPORT
-/ 2.ADDED /Y OPTION CHANGES TO SUPPORT NEW MONITOR
-
- /DETAILS OF PIP:
-
-/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
-/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
-/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
-/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.
-
-/CORE USED:
-/FIELD 0
-
-/00000-02777- OUTPUT BUFFER
-/03000-06377- INPUT BUFFER
-/06400-06577- USED FOR /Y COMMAND ONLY
-/06600-07177- INPUT HANDLER
-/07200-07577- OUTPUT HANDLER
-
-/FIELD 1
-
-/10000-11777- OS/8 I/O MONITOR
-/12000-16577- EXECUTABLE CODE
-/16600-17177- HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
-/17200-17577- HOLDS OLD DIRECTORY SEGMENT IN /S OPTION
-
-
-/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
-/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
-/NOT AS THEY ARE LOGICALLY CONNECTED.
-
-/ICHAR- GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
-/ DEVICE HANDLERS AS NEEDED.
-
-/OOPEN- ENTERS A FILE ON A SPECIFIED DEVICE.
-
-/OUTDMP- WRITES OUTPUT BUFFER TO OUTPUT DEVICE.
-
-/OCLOSE- CLOSES FILE CREATED BY OOPEN
-
-/OCHAR- CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
-/ TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.
-
-/OTYPE- USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
-/ INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
-/ GIVES A CODE FOR THE TYPE OF DEVICE.
-
-/SLASHG- HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
-/ ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
-/ SPECIAL RETURN IS TAKEN.
-
-/IMAGE- IMAGE MODE PROCESSOR FOR PIP.
-
-/SQTRA- MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.
-
-/PIP, PIP+1- MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
-/ INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
-/ ROUTINES.
-
-/ASCII- THE DEFAULT TRANSFER MODE IN PIP IS ASCII.
-
-/DELETE- DELETES FILES ON OUTPUT SIDE OF CD LIST.
-
-/DZERO- ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.
-
-/PIPERR- ERROR ROUTINR FOR PIP.
-
-/DIRPRE- DIRECTORY PRINTING ROUTINE.
-
-/BINARY- BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
-/ RELOCATABLE BINARY FILES.
-
-/ERPRNT- ERROR PRINTOUT.
-
-/SQUISH- FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
-/ IN DIRECTORY OF INPUT DEVICE.
-
-/SYSCOP- SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
-/ OS/8 SYSTEM AREA.
- /OPTIONS AVAILABLE IN PIP:
-
-/A- ASCII TRANSFER; DEFAULT MODE
-/B- BINARY MODE TANSFER
-/C- DELETE TRAILING BLANKS. (ASCII MODE)
-/D- DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
-/E- LIST INPUT DIRECTORY INCLUDING EMPTY FILES
-/F- LIST INPUT DIRECTORY; ONLY FILE NAMES
-/G- IGNORE ERRORS WHILE TRANSFERING
-/I- IMAGE MODE TRANSFER
-/L- LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
-/O- OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
-/S- COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
-/ 'HOLES' ON INPUT DEVICE.
-/T- PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
-/Y- COPY OS/8 SYSTEM AREA
-/Z- ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
-/=N- LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
-/ ONLY WITH /S OR /Z.
-/=N- WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
-/V PRINTS VERSION # (FIRST TIME ONLY)
-
-/COMMENTS ON THE PROGRAM:
-
- /SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
- /CAN BE USED. THE LOCATIONS CURRENTLY USED IN
- /FIELD 1 ON PAGE ZERO ARE:
-
- OUTXR=10
- INXR=11
- TEMP1=12
- IHNDLR=24 /HOLDS INPUT HANDLER ADDRESS
- OHNDLR=25 /OUTPUT HANDLER ADDRESS
- SQFLAG=26 /'SQUISH INDICATOR
- OUWAST=27 /# WASTE WORDS ON OUTPUT
- OUTBLK=30
- OUDLEN=31
- SAME=32
- INBLK=33
- RECCNT=34
-
-/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:
-
- FLENGT=24
- BLOKNO=25
- DTYPE=27
- DCOUNT=30
- DLINK=31
- WASTE=32
- DDATE=33
- ECOUNT=35
- /PIP FOR OS/8 MONITOR
- /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES
-
- OUBUF=0 /MUST BE LOWER THAN INBUF
- OUCTL=5400 /OUTPUT BUFFER OF 3000 WORDS
- OUDEVH=7200 /PROVIDE ROOM FOR TWO-PAGE HANDLERS
- INBUF=3000
- INCTL=1600 /INPUT BUFFER OF 3400 WORDS
- INRECS=7
- INDEVH=6600
-
- /PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND
-
- /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
- DCB=7760
- MPARAM=7643 /CD PARAMETER AREA
- OLDDIR=7 /POINTER TO MONITOR VARIABLE "OLDT9"
- MTEMP=27 /MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
- PTP=20 /INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
- XR=10
- TEMP=20
- CHAR=21
- INFPTR=22
- INEOF=23
-
- ABUF=6601 /LINE BUFFER - 150 CHARACTERS LONG
- SQBUF1=6600 /DIRECTORY BUFFER FOR "SQUISH" OPTION
- SQBUF2=7200 /""
-
- FIELD 1
-
-/TO ENABLE /E,/F,/L SET
-/OS78=0
-
-/TO DISABLE /E,/F,/L
-IFNDEF OS78 <OS78=1>
-
- /GENERAL CHARACTER I/O ROUTINES FOR BLEEP
- /CALLED AS FOLLOWS:
-
- /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE
-
- /JMS I (ICHAR READS A CHARACTER
- /ERROR RETURN /AC>0 IF END OF FILE, AC<0 IF READ ERROR
-
- /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE
- /ERROR RETURN AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
-
- /JMS I (OCHAR OUTPUTS A CHARACTER
- /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT
-
- /JMS I (OCLOSE CLOSES THE OUTPUT FILE
- /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
-
- /JMS I (OTYPE RETURNS DCB WORD OF OUTPUT DEVICE IN AC
-
-
-
- /PARAMETERS NEEDED:
-
- /INBUF= ADDRESS OF INPUT BUFFER
- /INCTL= INPUT BUFFER CONTROL WORD
- /OUBUF= ADDRESS OF OUTPUT BUFFER
- /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
- /INRECS= [INCTL/256]
- /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER
- /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER
-
- /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
- /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
- INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
- OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
-
- *2000
-
-IN7400, 7400
-IOPEN, 0
- CLA CMA
- DCA INCHCT /SET INCHCT TO FORCE A READ
- ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE
- TAD (7617
- DCA INFPTR /RESET FILE POINTER
- RDF
- TAD INCDIF
- DCA .+1
-INPTR, HLT /RESTORE CALLING FIELDS
- JMP I IOPEN
-
-ICHAR, 0
-IN7600, 7600
- RDF
- TAD INCDIF
- DCA INRTRN /SAVE CALLING FIELDS
-INCHAR, CDF INFLD
- ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
- ISZ INCHCT
-INJMPP, JMP INJMP
- TAD INEOF
- SNA CLA /DID LAST READ YIELD END-OF-FILE?
- JMP INGBUF /NO - DO ANOTHER
-GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
- JMP EOFERR /NO FILE TO OPEN
-INGBUF, TAD INCTR
- CLL
- TAD (INRECS
- SNL
- DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED
- SZL /IS THIS THE LAST READ?
- ISZ INEOF /YES - SET END-OF-FILE FLAG
- /NOT END-OF-FILE IF INPUT DEVICE
- /IS NON-FILE STRUCTURED!
- CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ
- RTR /FROM THE AMOUNT OF THE OVERFLOW
- RTR /(IF ANY) AND THE STANDARD CONTROL WORD
- TAD (INCTL+1
- DCA INCTLW
-INCDIF, CDF CIF 0
- CDF 10
- JMS I INHNDL /CALL THE DEVICE HANDLER
-INCTLW, 0
-INBUFP, INBUF
-INREC, 0
- JMS I (SLASHG /A HANDLER ERROR - SHOULD WE IGNORE?
- INERRX-. /ADDRESS IF NOT
-INBREC, TAD INREC
- TAD (INRECS
- DCA INREC /UPDATE THE RECORD NUMBER
- TAD INCTLW
- AND IN7600
- CLL RAL
- TAD INCTLW
- AND IN7600
- CMA
- DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
- TAD INJMPP
- DCA INJMP /RESET THE CHARACTER SWITCH
- TAD INBUFP
- DCA INPTR /AND THE WORD POINTER
- JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
-INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
- SMA CLA /WHICH TYPE WAS IT?
- JMP INBREC /END OF FILE - RESUME THY PROCESSING
-INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
-EOFERR, JMP INRTRN
-INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH
- JMP ICHAR1
- JMP ICHAR2
-ICHAR3, TAD INJMPP
- DCA INJMP
- TAD I INPTR
-IN200, AND IN7400
- CLL RTR
- RTR /COMBINE THE HIGH-ORDER FOUR BITS OF
- TAD INCTLW
- RTR /THE TWO WORD TO FORM THE THIRD CHARACTER
- RTR
- ISZ INPTR
- JMP INCOMN
-ICHAR2, TAD I INPTR
- AND IN7400
- DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
- ISZ INPTR /BUMP THE WORD POINTER
-ICHAR1, TAD I INPTR
-INCOMN, AND (377
- TAD (-232
-INCTZF, SNA /IS THE CHARACTER A ^Z?
- JMP GETNEW /YES - GET A NEW FILE
- TAD (232 /RESTORE THE CHARACTER
- ISZ ICHAR /BUMP RETURN TO NORMAL RETURN
-INRTRN, 0 /RESTORE CALLING FIELDS
- JMP I ICHAR /AND RETURN
- /IOPEN IS UNNECESSARY.
- INNEWF, -1 /ROUTINE TO OPEN NEW INPUT FILE
- INCHCT=INNEWF
- CDF 10
- TAD (INDEVH+1
- DCA INHNDL /INITIALIZE HANDLER ADDRESS
- TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
- SNA /ANY MORE?
- JMP I INNEWF /NO - OUT OF INPUT
- JMS I IN200
- 1 /ASSIGN, FETCH HANDLER
-INHNDL, 0
- HLT /HUH?
- TAD I INFPTR
- AND (7760 /GET LENGTH PART OF WORD
- SZA /LENGTH OF 0 MEANS LENGTH >=256
- TAD (17 /ADD HIGH-ORDER BITS
- CLL CML RTR
- RTR
- DCA INCTR /STORE LENGTH OF FILE
- ISZ INFPTR
- TAD I INFPTR
- DCA INREC /STORE STARTING RECORD NUMBER OF FILE
- ISZ INFPTR
- DCA INEOF /ZERO END-OF-FILE FLAG
- ISZ INNEWF
- JMP I INNEWF
- INCTR=IOPEN
- PAGE
- OOPEN, 0 /OPEN OUTPUT FILE
-OU7600, 7600
-/ RDF
-/ TAD OUCDIF
-/ DCA OORETN
- TAD OU7601
- DCA OUBLK
- TAD (OUDEVH+1
- DCA OUHNDL
- CDF 10
- TAD I OU7600 /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
- AND (17 /STRIP OFF ANY LENGTH INFO
- SNA /IS THERE AN OUTPUT DEVICE?
- JMP ONOFIL /NO - INHIBIT OUTPUT
- JMS I (200
- 1 /ASSIGN, FETCH HANDLER
-OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
- HLT /HUH?
-OUENTR, TAD I OU7600
- JMS I (200
- 3 /ENTER OUTPUT FILE
-OUBLK, 7601 /REPLACED WITH STARTING BLOCK
-OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
- JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH
- DCA OUCCNT
- DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
- JMS I (OUSETP
- ISZ OOPEN
-OORETN, CDF CIF 10 /RESTORE CALLING FIELDS
- JMP I OOPEN
-OEFAIL, TAD I OU7600
- AND (7760 /GET REQUESTED LENGTH
- SNA CLA /WAS IT AN INDEFINITE REQUEST
- JMP ONTERR /YES - CANNOT ENTER THE FILE
- TAD I OU7600
- AND (17 /MAKE THE REQUESTED LENGTH ZERO
- DCA I OU7600
- JMP OUENTR /TRY, TRY AGAIN
-ONTERR, CLA CLL CML RAR
- JMP OORETN /TAKE THE ERROR RETURN WITH AC<0
-ONOFIL, ISZ I (OUTINH
- JMP OORETN /TAKE THE ERROR RETURN WITH AC=0
- OUTDMP, 0
- DCA OUCTLW /STORE THE CONTROL WORD
- CDF 10
- TAD I (OUTINH
- SZA CLA
- JMP OUNOWR
- TAD OUCCNT
- SNA
- ISZ OUCTLW
- TAD OUBLK
- DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
- TAD OUCTLW
- CLL RTL
- RTL
- RTL
- AND (17 /COMPUTE THE NUMBER OF RECORDS
- TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE
- DCA OUCCNT
- TAD OUCCNT
- CLL CML
- TAD OUELEN
- SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH?
- JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR
-OUCDIF, CDF CIF 0
- CDF 10
- JMS I OUHNDL
-OUCTLW, 0
- OUBUF
-OUREC, 0
- JMS I (SLASHG
- .+2-.
-OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN
- JMP I OUTDMP
- OCLOSE, 0
- CDF 10
- TAD I (OUTINH
- SZA CLA /IS OUTPUT INHIBITED?
- JMP OCISZ /YES - CLOSE IS A NOP
- JMS I (OTYPE
- AND (770
- TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
- SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
- TAD (232 /OUTPUT A ^Z
- JMS I (OCHAR
- JMP OCRET
- JMS I (OCHAR
- JMP OCRET
-FILLLP, JMS I (OCHAR
- JMP OCRET
- JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
- SPA CLA
- TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD
- TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD
- AND I (OUDWCT
- SZA CLA /UP TO THE BOUNDARY YET?
- JMP FILLLP /NO - FILL WITH ZEROS
- TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
- TAD (OUCTL&3700
- SNA /A FULL WRITE LEFT?
- JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT
- TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT
- JMS OUTDMP
- JMP OCRET /AN ERROR OCCURRED WHILE DUMPING THE BUFFER
-NODUMP, TAD I OU7600 /GET THE DEVICE NUMBER
- JMS I (200
- 4 /CLOSE THE OUTPUT FILE
-OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME
-OUCCNT, 0
- SKP /ERROR WHILE CLOSING THE FILE - BAD!
-OCISZ, ISZ OCLOSE
-OCRET, CDF CIF 10 /RESTORE CALLING FIELDS
- JMP I OCLOSE
- PAGE
- OUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS
- TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
- CIA /PAL10 IS DEFINITELY NOT NICE
- DCA OUDWCT
-/ TAD (OUBUF
- IFNZRO OUBUF <ERROR!> /V3
- DCA OUPTR /INITIALIZE WORD POINTER
- TAD OUJMPE
- DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH
- JMP I OUSETP
-
-OCHAR, 0
- AND (377
- DCA OUTEMP
- RDF
- TAD (CDF CIF 0
- DCA OUCRET
- TAD OUTINH
- SZA CLA /IS THERE AN OUTPUT FILE?
- JMP OUCOMN /NO - EXIT
-OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
- ISZ OUJMP /BUMP THE CHARACTER SWITCH
-OUJMP, HLT /THREE WAY CHARACTER SWITCH
- JMP OCHAR1
- JMP OCHAR2
-OCHAR3, TAD OUTEMP
- CLL RTL
- RTL
- AND (7400
- TAD I OUPOLD
- DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
- /ORDER 4 BITS OF THIRD CHAR
- TAD OUTEMP
- CLL RTR
- RTR
- RAR
- AND (7400
- TAD I OUPTR
- DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS
- TAD OUJMPE
- DCA OUJMP /RESET SWITCH
- ISZ OUPTR
- ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
- JMP OUCOMN
- TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
- JMS I (OUTDMP /DUMP THE BUFFER
- JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN
- JMS OUSETP /RE-INITIALIZE THE POINTERS
- JMP OUCOMN
-OCHAR2, TAD OUPTR
- DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
- ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
-OCHAR1, TAD OUTEMP
- DCA I OUPTR
-OUCOMN, ISZ OCHAR
-OUCRET, HLT /RESTORE CALLING FIELDS
- JMP I OCHAR
-OUTEMP, 0
-OUPOLD, 0
-OUPTR, 0
-OUJMPE, JMP OUJMP
-OUDWCT, 0
-OUTINH, 0
- OTYPE, 0
- RDF
- TAD (CDF CIF 0
- DCA OTRTN
- CDF 10
- TAD I (7600
- AND (17
- TAD (DCB-1
- DCA OUTEMP
- TAD I OUTEMP
-OTRTN, HLT
- JMP I OTYPE
-CTCTST, 0
- TAD (200 /V3
- KRS
- TAD (-203
- SNA CLA /IS THE TELETYPE BUFFER A ^C
- KSF /WITH THE TELETYPE FLAG ON?
- JMP I CTCTST /NO
-LEAVE, CDF CIF 0 /YES - GO TO MONITOR
- JMP I (7600 /THROUGH THE "SAVE CORE" RETURN
-
-SLASHG, 0
- DCA CTCTST
- TAD SQFLAG
- SZA CLA /ARE WE SQUISHING?
- JMP I (SQIOER /YES
- TAD CTCTST
- SPA CLA /ONLY IGNORE HARD ERRORS
- TAD I (MPARAM
- AND (40
- SZA CLA / "G" SWITCH
-SLGRET, JMP I SLASHG /IGNORED!
- TAD I SLASHG
- TAD SLASHG
- DCA SLASHG /SET UP NON-IGNORE ADDRESS
- TAD CTCTST
- JMP I SLASHG /RETURN WITH AC RESTORED
-
-
- IFZERO OS78 <
-DIR, DCA DTYPE /SAVE TYPE OF REQUEST
- TAD I (7600
- SZA CLA /IS THERE AN OUTPUT FILE?
- JMP I (DIRPRE /YES
- DCA TTYDEV+1
- JMS I (200
- 12 /ASSIGN WITHOUT FETCH
-TTYDEV, 5524 /COMPRESSED CODE FOR "TTY"
- 0
- 0
- JMP I (PIP /V3 WHAT - NO TELETYPE!
- TAD TTYDEV+1
- DCA I (7600
- JMP I (DIRPRE
- >
-
- IFNZRO OS78 <
-DIR, JMS I (PIPERR /TYPE OUT MESSAGE
- 14
-DIRMSG, TEXT "USE DIRECT"
- >
-
- PAGE
- /PIP PROPER BEGINS HERE
- /**********************
-
- /IMAGE MODE PROCESSOR FOR PIP
-
-IMAGE, JMS I (FIXLEN
- JMS I (OUTOPN
- JMS IMTRA
-IMCLOS, TAD I (OUTINH
- SZA CLA /WAS THERE AN OUTPUT FILE?
- JMP I (PIPCLR /NO - DON'T CLOSE IT
- JMS I (OUK /GET THE LENGTH OF THE OUTPUT FILE
- DCA IMCCNT
- TAD I IM7600
- JMS I (200
- 4 /CLOSE
- 7601 /FILE NAME
-IMCCNT, 0
- JMP I (AOUERR
- JMP I (PIPCLR
-
-ENDFUJ, 0 /PART OF DIRECTORY PRINTING ROUTINE
- JMS I (PRNUM
- TAD (-6
- JMS I (PRWD /PRINT SIX WORDS
- 0006 / F
- 2205 /RE
- 0500 /E
- 0214 /BL
- 1703 /OC
- 1323 /KS
- JMS I (PCRLF
- JMS I (PCRLF /LEAVE A SPACE BETWEEN DIRECTORIES
- ISZ INEOF /SIMULATE "END OF FILE" FOR INPUT ROUTINE
- CLA CMA
- DCA I (INCHCT /AS WELL AS "END OF BUFFER"
- JMP I ENDFUJ
- IMHNDL, /V3
-SQTRA, 0
- TAD SQTRA
- DCA IMTRA /FAKE A CALL TO "IMTRA"
- TAD RECCNT /SETTING UP THE ARGS TO DO THE SQUISHING FOR US
- DCA I (INCTR
- TAD IHNDLR
- DCA IMHNDL
- TAD INBLK
- DCA IMREC
- TAD OUTBLK
- DCA I (OUCCNT
- DCA INEOF
- JMP IMRCLP
-
-IMTRA, 0
- JMS I (IOPEN /INITIALIZE INPUT ROUTINE
-AGAIN, TAD INEOF /IOPEN ALWAYS SETS INEOF
- SNA CLA /KEEP READING?
- JMP IMRCLP /YES
- /NO, OPEN NEXT FILE
-IMFILP, JMS I (INNEWF /SET UP PARAMS FOR NEXT FILE
- JMP I IMTRA /NO NEXT FILE
- TAD I (INHNDL
- DCA IMHNDL /GET DEVICE HANDLER ENTRY
- TAD I (INREC
- DCA IMREC /AND STARTING BLOCK NUMBER
-IMRCLP, TAD I (INCTR
- CLL
- TAD (15
- SNL /IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
- DCA I (INCTR
- SZL
- ISZ INEOF
- CLL CML CMA RTR
- RTR
- RTR
- TAD (3201 /FORM A FULL OR PARTIAL READ CONTROL WORD
- DCA IMCTLW
- JMS I (CTCTST /CHECK FOR ^C
- CIF 0
- JMS I IMHNDL
-IMCTLW, 0
- OUBUF
-IMREC, 0
- JMS I (SLASHG
- IMERRX-.
- TAD IMREC
- TAD (15
- DCA IMREC /UPDATE BLOCK NUMBER
- CLA CLL CML RAR
- TAD IMCTLW
-IMOUT, JMS I (OUTDMP /WRITE OUT WHAT WE JUST READ IN
- JMP I (AOUERR /WRITE ERROR - BAD!
- JMP AGAIN /V3
- IMERRX, ISZ INEOF /SIGNAL EOF OR WORSE
- SPA CLA /WHICH ONE IS IT?
- JMP IM7600
- TAD (6377 /MARCH DOWN THROUGH CORE
-IMEFLP, DCA CHAR /LOOKING FOR THE FIRST NON-ZERO WORD
- CDF 0
- TAD I CHAR
- SZA CLA
- JMP IMNZRO
- CLA CMA CLL
- TAD CHAR
- SZL /IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
- JMP IMEFLP
-IM7600, 7600
- JMS I (PIPERR /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
- 4 /A ^Z AT LEAST)
-IMNZRO, CDF 10
- TAD CHAR
- CLL CML RAR
- AND IM7600
- TAD (200 /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
- JMP IMOUT /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
- PAGE
- /** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **
-
-PIPSA, JMP PIPCD /NORMAL ENTRY/RE-ENTRY - CALL CD
- JMP NOPCD /ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
- /PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE
-
-LFEED, TAD CHAR
- DCA I XR /PUT THE LINE FEED IN THE LINE BUFFER
-EOL, DCA I XR /MARK THE END OF USEFUL INFO
- JMS I (CTCTST
- TAD (ABUF-1
- DCA XR /RESET BUFFER POINTER
-EOLLP, TAD I XR /GET A CHARACTER FROM THE LINE BUFFER
-PIPSNA, SNA /ZERO MEANS NO MORE CHARS
- JMP EOFTST
- JMS I (OCHAR /OUTPUT THE CHARACTER
- JMP I (AOUERR
- JMP EOLLP
-EOFTST, TAD AEOFFG
- SNA CLA /END OF INPUT ENCOUNTERED?
- JMP I (ASCIGO /NO - GET NEXT LINE
-ACLOSE, JMS I (OCLOSE /YES - CLOSE THE OUTPUT FILE
- JMP I (AOUERR /ERROR ON CLOSE
-PIP, TAD I (MPARAM-1 /V3
- SMA CLA /ALTMODE TERMINATE LAST COMMAND STRING?
- JMP PIPCD /NO
- CDF CIF 0 /YES
- JMP I (7605 /EXIT TO OS/8 WITHOUT SAVING CORE
-PIPCD, JMS I (200 /OF COURSE THE MONITOR IS IN CORE!
- 5 /COMMAND DECODE
- 0 /NO ASSUMED EXTENSIONS ON INPUT
-L20, /V3
-NOPCD, JMS I (ONCE /REPLACED BY '20' BY ONCE-ONLY CODE
- JMS I (SRSTOR /CLEAR /S OR /Y;READ MONITOR
- DCA SQFLAG /CLEAR /S INDICATOR
- TAD PIPSNA
- DCA I (INCTZF /RESET INPUT SWITCH TO DETECT "^Z"'S
- TAD I (MPARAM+1
- AND (40 /"S" SWITCH
- SZA CLA
- JMP I (SQUISH /IT WAS ON - COMPRESS THE INDICATED DEVICES
- TAD I (MPARAM+2
- RTL
- SZL CLA /"Z" SWITCH IN THE LINK
- JMS I (DZERO /ZERO DIRECTORY BEFORE PROCEEDING
- TAD I (MPARAM
- AND (400 /"D" SWITCH
- SZA CLA
- JMS I (DELETE /DELETE OUTPUT FILE
- TAD I (MPARAM+2 /IS /Y ON?
- SPA CLA
- JMP I (SYSCOP /YEP..TRANSFER SYSTEM HEAD
- TAD I (MPARAM
- AND (301 /"E","F" AND "L" SWITCHES
- SZA /ANY ONE OF THEM ON?
- JMP I (DIR /YES - LIST A DIRECTORY
- TAD I (MPARAM
- RTL
- AND (40 /"I" SWITCH ROTATED TWO LEFT
- SZA CLA
- JMP I (IMAGE /IMAGE MODE TRANSFER
- TAD I (7617 /MUST PRESERVE THE LINK
- SNA CLA /V3 IMAGE MODE ALLOWS NO INPUT FILE
- JMP PIP /TERMINATE HERE IF NO INPUT SIDE
- SZL CLA /"B" SWITCH IN LINK
- JMP I (BINARY /BINARY MODE TRANSFER
-
- /DEFAULT MODE OF TRANSFER IS ASCII
-
-ASCII, TAD I (MPARAM+1
- AND L20
- DCA COPTSW
- TAD COPTSW
- JMS I (ASCI2 /TEST FOR OUTPUT DEVICE
- JMS I (OUTOPN
- JMS I (IOPEN /OPEN THE INPUT FILES
- DCA AEOFFG /ZERO THE END-OF-FILE FLAG
- JMS I (LEADER
- JMP I (ASCIGO
-
- /ENTRY ON END OF INPUT
-ASCEOF, SPA CLA /WAS IT END OF INPUT OR AN INPUT ERROR?
-PER4, JMS I (PIPERR
- 4
- ISZ AEOFFG /SET END-OF-INPUT FLAG
- JMP EOL /PROCESS LAST LINE (IF ANY)
-AEOFFG, 0
- /SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
-RUBOUT, 0 /UNLESS OUTPUT IS TO A DIRECTORY DEVICE
- DCA TEMP /STORE COUNT
- JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
- SPA CLA
- JMP I RUBOUT /DIRECTORY DEVICE - DON'T BOTHER
-RBTLP, TAD CHAR
- TAD (-214
- SNA CLA /IS THE FORM CONTROL CHAR A FORM-FEED?
- IAC /YES - OUTPUT BLANK TAPE INSTEAD
- TAD (377
- DCA I XR /PUT IN BUFFER
- ISZ TEMP
- JMP RBTLP /LOOP FOR THE REQUISITE COUNT
- JMP I RUBOUT
-COPTSW, 0
-
-DEND, SPA CLA
- JMP PER4
- JMP ACLOSE
- PAGE
- *3200
- /ASCII PROCESSOR CONTINUED
-
-ASCIGO, TAD (ABUF-2
- DCA XR
- DCA I XR /PROTECT AGAINST NULL LINE WITH "T" OPTION
- DCA COLCT /ZERO COLUMN COUNTER FOR TAB CONVERSION
-ACHLP, JMS I (ICHAR /GET A CHARACTER
- JMP I (ASCEOF /END OF INPUT OR WORSE
- AND (177 /MASK OUT PARITY BIT
- SZA /IGNORE BLANK TAPE AND LEADER/TRAILER
- TAD (-177
- SNA
- JMP ACHLP /DITTO RUBOUTS
- TAD (177-32 /V3C
- SNA
- JMP I (ASCPTCH /7-BIT ^Z CHECK
- TAD (232 /FORCE COLUMN 8 ON
- DCA CHAR
- TAD CHAR
- TAD (-216
- CLL
- TAD ASCI5
- SNL /IS THE CHARACTER A FORM CONTROL CHARACTER?
- JMP CINSRT /NO
- TAD ASCJMP /YES - GO TO APPROPRIATE ROUTINE
- DCA .+1
- HLT
-ASCJMP, JMP I .+1
- TAB
- LFEED
- VTAB
- FFEED
- CARRET
-CINSRT, 7600 /GRP 2 CLA
- TAD CHAR
-ADCAXR, DCA I XR /STORE THE CHARACTER IN THE LINE BUFFER
- ISZ COLCT /ALWAYS BUMP THE COLUMN POINTER
-TESTXR, TAD XR
- TAD (-ABUF-226
- SPA CLA /HAS THE BUFFER OVERFLOWED?
- JMP ACHLP /NO - GET NEXT CHARACTER
- JMS I (PIPERR
- 1
- TAB, TAD I (COPTSW
- SNA CLA /DO WE WANT TO CONVERT?
- JMP TABRBT /NO
-TABLP, TAD (240
- DCA I XR /OUTPUT A SPACE
- ISZ COLCT
- TAD COLCT
- AND (7
- SZA CLA /IS THE COLUMN COUNTER A MULTIPLE OF 8?
- JMP TABLP /NOT YET
- JMP TESTXR /YES - CHECK BUFFER OVERFLOW
-TABRBT, TAD CHAR
- DCA I XR
- CLA CMA
- JMS I (RUBOUT /TWO RUBOUTS FOLLOW A TAB
- JMP TESTXR /CHECK FOR BUFFER OVERFLOW
-VTAB, TAD I (COPTSW
- SZA CLA /SHOULD WE CONVERT?
- JMP VTLF /YES
- TAD CHAR
- DCA I XR
- TAD (-4
- JMS I (RUBOUT /FOUR RUBOUTS AFTER A VERTICAL TAB
- JMP I (EOL
-FFLF, TAD (-4 /NINE LINE FEED SIMULATE A FORM FEED
-VTLF, TAD (-5 /FIVE LINE FEEDS SIMULATE A VERTICAL TAB
- DCA TEMP
- TAD (212
- DCA I XR
- ISZ TEMP
- JMP .-3
- JMP I (EOL /FORM FEED AND VERTICAL TAB ARE LINE ENDERS
- FFEED, TAD I (COPTSW
- SZA CLA /SHOULD WE CONVERT?
- JMP FFLF /YES
- TAD CHAR
- DCA I XR
- TAD (-11 /NINE RUBOUTS AFTER A FORM FEED
- JMS I (RUBOUT
- JMP I (EOL
-CARRET, TAD I (MPARAM
- RTL
- SMA CLA /"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
- JMP NOTOPT /IT WASN'T ON
-TOPT, TAD XR
- DCA TEMP
- TAD I TEMP
- TAD (-240
- SZA CLA /WAS THE LAST CHAR ON THE LINE A SPACE?
- JMP NOTOPT /NO
- CLA CMA
- TAD XR /YES - BACK UP THE LINE POINTER
- DCA XR
- JMP TOPT
-NOTOPT, TAD CHAR
- DCA I XR /STORE THE CARRIAGE RETURN IN THE BUFFER
- JMP TESTXR /CARRIAGE RETURN IS NOT A LINE TERMINATOR
-COLCT, 0
-
-OUTOPN, 0
- JMS I (OOPEN
- SMA CLA
- JMP I OUTOPN
- JMS I (PIPERR
-ASCI5, 5
- PAGE
- /SUBROUTINES CALLED BY THE REST OF PIP
-
-K770, 770 /** DON'T MOVE THIS CONSTANT
-DELETE, 0
- TAD P7600
- DCA DPFILE
- CLA CLL CMA RTL
- DCA CHAR /MAXIMUM OF THREE OUTPUT FILES
-DELOOP, TAD (7201
- DCA DLHNDL
- TAD I DPFILE
- SNA /DOES THIS FILE EXIST?
- JMP I DELETE /THAT'S ALL
- JMS I C200
- 1 /ASSIGN HANDLER FOR THE DELETION
-DLHNDL, 0
- HLT
- TAD I DPFILE /RELOAD DEVICE NUMBER FOR DELETE
- ISZ DPFILE /BUMP DPFILE TO POINT TO THE FILE NAME
- JMS I C200 /DEVICE NUMBER IN AC
-DP4, 4 /CLOSE - USED AS DELETE IN THIS CASE
-DPFILE, 0 /POINTER TO FILE NAME
- 0 /ZERO LENGTH FOR DELETE
- JMS I (PIPERR /FILE WASN'T THERE TO BE DELETED
- 3
- TAD DPFILE
- TAD DP4
- DCA DPFILE
- ISZ CHAR
- JMP DELOOP /DELETE AS MANY FILES AS HE LISTED(UP TO 3)
- JMP I DELETE
- DZERO, 0 /SUBROUTINE TO ZERO THE DIRECTORY OF THE
- /FIRST OUTPUT DEVICE
- JMS I (OTYPE
- CLL RTL
- SZL /IS DEVICE READ-ONLY?
- JMP OZERR /YES - ERROR
- RTR
- SMA /FILE-STRUCTURED DEVICES WILL HAVE 4000 BIT SET
- JMP NONDIR /NON-DIRECTORY DEVICE
- AND K770 /MASK OUT DEVICE TYPE
- CLL RTR
- RAR
- TAD (DEVLEN /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
- DCA PIPERR
- TAD (OUDEVH+1
- DCA OZHNDL
- TAD I P7600
- JMS I C200
- 1 /ASSIGN DEVICE, FETCH HANDLER
-OZHNDL, 0
- HLT
- TAD I PIPERR
- SNA /IS THE LENGTH ZERO?
- JMS I (DVREDE /IF SO, GO "READ LENGTH"
- DCA PIPERR /STORE LENGTH
- TAD I (MPARAM+2 /IF /Y ON, DO SYSTEM ZERO
- SPA CLA
- JMP ZRO70
- TAD OZHNDL /BUT IF NOT, CHECK FOR SYSTEM ZERO
- TAD (-7607
- SZA CLA
- JMP ZRO70+1 /NOT SYSTEM FILES BEGIN AT 7
- JMS I (CONFRM /ASK IF HE'S SURE
- SYSZRO /V3
-ZRO70, TAD (61
- TAD (7
- DCA I (DFORG
- DCA I (SQFLAG /AND CLEAR OUT SQUISHES
- TAD PIPERR
- TAD I (DFORG
- DCA I (DLENGT
- JMS I (GETEQ
- DCA I (DWASTE /DEFINE # OF WASTE WORDS
- DCA I (MPARAM+3 /KILL = OPTION FOR FUTURE /I TRANSFERS
- CIF 0
- JMS I OZHNDL
- 5410 /V3 OUTPUT 6 BLOCKS FROM FIELD 1
- DIRECT
- 1 /ALL DIRECTORIES ARE IN RECORD 1
-OZERR, JMS I (PIPERR /ERROR WHILE ZEROING DIRECTORY
- 2
- DCA OLDDIR /ZERO DIRECTORY POINTER TO FORCE A NEW READ
-NONDIR, CLA /NON DIRECTORY RETURN
- JMP I DZERO
- PIPERR, 0
-P7600, 7600 /V3 CLA
- JMS I (SRSTOR /RESET 07600!
- CDF 10 /JUST IN CASE
- TAD I PIPERR /GET ARG
- TAD (ERRTBL
- DCA TEMP
- TAD I TEMP
- JMS I (ERPRNT
- JMP I (PIP /RESTART PIP
-
-LEADER, 0
- JMS I (OTYPE
-C200, AND K770 /GET THE TYPE OF THE OUTPUT DEVICE
- TAD (-PTP /IS IT A PAPER TAPE PUNCH?
- SZA CLA
- JMP I LEADER /NO
- TAD P7600
- DCA TEMP
- JMS I (OCHAR /PUT OUT SOME LEADER
- JMP I (AOUERR
- ISZ TEMP
- JMP .-3
- JMP I LEADER
- PAGE
- /TABLE OF DEVICE LENGTHS FOR /Z OPTION
-
-DEVLEN, 0;0;0;0;0;1520 /RK08 (1520= - DECIMAL 3248)
- 6001;4001;2001;0001 /RF08 IN VARIOUS SIZES
- /(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
- 7601;7401;7201;7001 /DF32 IN VARIOUS SIZES
- /(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
- 6437;6437 /DECTAPE AND LINCTAPE
- ZBLOCK 1 /20 MAGTAPE
- 6437 /21 TD8E
- 0
- 1520 / 1/2 OF AN RK8E IS 23
- 0 /24
- 7022 /25 RX01 FLOPPY DISK
- 17 /26 RL DEVICE
- 0
- 0
- 4027 /31 RL DEVICE
- 0 /32 NEW RX MUST BE ZERO TO EXAMINE MEDIA
- 7600 /33 VX EXT MEM - DF32 PSEUDO DEVICE
- 7400;7200 /2ND AND 3RD PLATTERS
- ZBLOCK 42 /ALL THE REST
-
-
-FIXLEN, 0 /ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
- TAD I (7600
- AND (7760
- SZA CLA /DID THE USER PROVIDE AN ESTIMATE?
- JMP I FIXLEN /YES - USE IT
- DCA CHAR
- TAD (7617
- DCA TEMP
-FIXLP, TAD I TEMP /GET NEXT INPUT FILE
- SNA
- JMP FIXOVR /NO MORE INPUT FILES
- AND (7760
- CIA CLL /GET LENGTH AS A POSITIVE NUMBER
- /(LENGTH OF ZERO TURNS LINK ON)
- TAD CHAR
- DCA CHAR /UPDATE CUMULATIVE LENGTH
- SZL CLA /DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
- JMP I FIXLEN /YES - CAN'T ESTIMATE IT
- ISZ TEMP
- ISZ TEMP
- JMP FIXLP
-FIXOVR, TAD CHAR
- TAD I (7600
- DCA I (7600 /STICK LENGTH IN OUTPUT FILE DESCRIPTOR
- JMP I FIXLEN
- NOYES, TEXT /NO/
- TEXT /YES/
-
-CONFRM, 0
- TAD I (MPARAM+1
- RTL /'O' BIT TO SIGN
- SPA CLA
- JMP GOTCON /V3 'O' MEANS OK, ASSUME 'YES'
- TAD I CONFRM /V3
- JMS I (ERPRNT
- KSF
- JMP .-1
- JMS I (CTCTST
- KRB /LOOK AT HIS REPLY
- AND (177 /IGNORE PARITY TTY
- TAD (-"Y!7600 /V3
- SNA CLA /IS IT YES?
- ISZ SQFLAG /SET SQFLAG TO 1 (NEEDED 1 LATER)
- TAD SQFLAG /USE SQFLAG AS INDEX FOR MESSAGE
- CLL RAL
- TAD (NOYES
- JMS I (ERPRNT
- TAD SQFLAG
- SNA CLA
- JMP I (PIP
-CNFMXT, ISZ CONFRM
- JMP I CONFRM
-
-GOTCON, ISZ SQFLAG /SET SQFLAG
- JMP CNFMXT /AND TAKE SKIP EXIT
- PAGE
- /DIRECTORY PRINTER FOR PIP
- MDATE=7666
-
-DIRPRE, JMS I (OUTOPN /OPEN THE OUTPUT FILE
- TAD (ABUF
- DCA CHAR /ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
- TAD (7617
- DCA TEMP
- TAD I (7617
- SNA
- JMS I (DSKNUM
- DCA I (7617 /DEFAULT DIRECTORY IS DSK:
-DFUJLP, TAD I TEMP
- SNA /ARE WE THROUGH WITH THE INPUT DEVICES?
- JMP GETDIR /YES
- AND (17
- DCA I TEMP /ONLY THE DEVICE NUMBER IS IMPORTANT
- TAD I TEMP
- TAD (DCB-1
- DCA PRWD
- CLA CLL CML RTL
- TAD TEMP
- DCA INFPTR /THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
- TAD I PRWD
- SMA CLA /IS THE DEVICE A DIRECTORY DEVICE?
- JMS I (PIPERR /NO
- 6
- ISZ TEMP
- TAD I TEMP
- DCA I CHAR /SAVE THE STARTING BLOCK NUMBER
- CLA IAC
- DCA I TEMP /READ FROM THE DIRECTORY
- ISZ TEMP
- ISZ CHAR
- JMP DFUJLP
-GETDIR, TAD (ABUF
- DCA CHAR
- JMS PCRLF
- TAD I (MDATE
- JMS I (PDATE
- JMS PCRLF
- JMS I (IOPEN /RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
- /ROUTINES
- JMP I (NXTDIR
- PRWD, 0 /ROUTINE TO PRINT SIXBIT TEXT
- SNA /IS COUNT ZERO?
- CMA /MAKE IT ONE
- DCA PRCT /STORE COUNT
-PRWDLP, TAD I PRWD
-PR212, RTR
- RTR
- RTR
- JMS PR6BIT
- TAD I PRWD
- JMS PR6BIT
- ISZ PRWD
- ISZ PRCT
- JMP PRWDLP
- JMP I PRWD
-PRCT, 0
-PR6BIT, 0
- AND (77
- SZA
- TAD (240 /V3
- AND (77 /V3
- TAD (240 /V3
- JMS I (OCHAR
- JMP I (AOUERR
- JMP I PR6BIT
- PRNUM, 0
- DCA PRWD
- DCA TEMP
- TAD (PWRTEN
- DCA PCRLF
-PRNMLP, DCA PR6BIT
- TAD I PCRLF
- SNA
- JMP PRLAST /V3
- CLL
- TAD PRWD
- SNL
- JMP .+4
- DCA PRWD
- ISZ PR6BIT
- JMP PRNMLP+1
- CLA
- TAD PR6BIT
- TAD TEMP
- SNA
-PBLJMP, JMP PRBLNK /INCREMENTED BY PDATE TO KILL LEADING BLANKS
- TAD (260
- JMS PR6BIT
- CLA CLL CML RAR
- DCA TEMP
- ISZ PCRLF
- JMP PRNMLP
-PRBLNK, JMS PR6BIT
- JMP .-3
-PRLAST, TAD PRWD /V3
- TAD (260 /V3
- JMS PR6BIT /V3
- JMP I PRNUM /V3
- PCRLF, 0
- TAD (215
- JMS I (OCHAR
- JMP I (AOUERR
- TAD PR212
- JMS I (OCHAR
- JMP I (AOUERR
- JMP I PCRLF
-
-PWRTEN, -1750;-144;-12;0 /V3
- PAGE
- /MAIN DIRECTORY PRINTING LOOP
-
-NXTDIR, JMS I (ICHAR /FAKE, FAKE
- JMP I (DEND
- CLA /WE DON'T WANT THE CHARACTER
- DCA ECOUNT
- TAD (INBUF-1 /WE WANT THE BUFFER!
-NEWSEG, DCA XR
- CDF 0
- TAD I XR
- DCA DCOUNT /NUMBER OF ENTRIES
- TAD DCOUNT
- CLL
- TAD (100
- SNL CLA
- JMS I (PIPERR
- 11
- TAD I XR
- DCA BLOKNO /FIRST BLOCK OF FILE STORAGE
- TAD I XR
- DCA DLINK /LINK TO NEXT SEGMENT
- ISZ XR /BUMP XR PAST FLAG WORD
- TAD I XR
- DCA WASTE
-NAMELP, CDF 0
- TAD I XR
- SNA /WHAT TYPE OF ENTRY IS IT?
- JMP DEMPTY /A FREE FILE
- DCA NAME1 /A PERMENANT OR TENTATIVE FILE
- TAD I XR
- DCA NAME2
- TAD I XR
- DCA NAME3
- TAD I XR
- DCA NAME4
- TAD I XR
- DCA DDATE
- TAD WASTE /COMPENSATE FOR THE DATE INCREMENT
- CMA /AND THE WASTE WORDS
- TAD XR
- DCA XR
- TAD I XR
- SNA /IS IT A TENTATIVE FILE?
- JMP ADDLEN+1 /YES - TENTATIVE FILES ARE ALWAYS IGNORED
- CIA
- DCA FLENGT /NO - STORE THE LENGTH
- CDF 10
- TAD I CHAR /GET THE STARTING FILE FOR THIS LISTING
- CIA CLL
- TAD BLOKNO
- SNL CLA /ARE WE THERE YET?
- JMP ADDLEN /NO - KEEP GOING
- CLA CLL CMA RTL
- JMS I (PRWD /PRINT THREE WORDS
-NAME1, 0
-NAME2, 0
-NAME3, 0
- TAD NAME4
- SNA CLA /IS THERE AN EXTENSION?
- TAD (-16 /NO - PRINT A BLANK
- TAD (56 /YES - PRINT A PERIOD
- JMS I (PR6BIT
- JMS I (PRWD
-NAME4, 0 /ZERO PRINTS AS TWO MORE BLANKS
-PRLNGT, TAD DTYPE
- AND (100
- SZA CLA /WAS THE LISTING SWITCH /F?
- JMP PRTCRL /YES - DON'T PRINT LENGTH
- TAD FLENGT
- JMS I (PRNUM
- TAD WASTE
- SZA CLA
- TAD DDATE
- JMS I (PDATE /PRINT THE CREATION DATE OF THE FILE
-PRTCRL, JMS I (PCRLF
-ADDLEN, TAD FLENGT
- TAD BLOKNO
- DCA BLOKNO /UPDATE BLOCK NUMBER
- ISZ DCOUNT
- JMP NAMELP /LOOP UNTIL ALL FILES ARE PROCESSED
- TAD DLINK
- SNA CLA /MULTI-SEGMENT DIRECTORY?
- JMP ENDDIR /NO - FINISH UP
- TAD XR
- AND (7400
- TAD (377 /BUMP XR TO NEXT BLOCK
- JMP NEWSEG /PROCESS NEXT LINK
- DEMPTY, TAD I XR
- CIA
- DCA FLENGT /STORE LENGTH OF FREE ENTRY
- CDF 10
- TAD FLENGT
- TAD ECOUNT
- DCA ECOUNT /BUMP COUNT OF FREE BLOCKS
- TAD DTYPE
- AND (200
- SNA CLA /IS THE /E SWITCH ON?
- JMP ADDLEN /NO - DON'T LIST FREE FILES
- TAD (-4
- JMS I (PRWD
- TEXT /<EMPTY>/
- JMS I (PR6BIT
- TAD FLENGT
- JMS I (PRNUM
- JMP PRTCRL
-ENDDIR, ISZ CHAR /BUMP TEMP ARRAY TO NEXT ENTRY
- TAD ECOUNT
- JMS I (ENDFUJ
- JMP NXTDIR
- PAGE
- /BINARY MODE PROCESSOR FOR PIP
-
-BIN360, 360
-BINARY, JMS I (FIXLEN
- JMS I (OUTOPN
- JMS I (IOPEN
- JMS I (LEADER /PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
- JMS LTCODE
-NEWTAP, JMS I (ICHAR
- JMP BEOF /END OF FILE ON INPUT
- SNA
- JMP NEWTAP /BLANK TAPE - KEEP GOING
- TAD BN7600
- SZA CLA
- JMP NEWTAP
- JMS I (ICHAR
- JMP BEOF
- TAD BN7600
- SNA
- JMP .-4
- TAD BIN200
- DCA CHAR
- TAD CHAR
-BIN200, AND BIN360
- TAD (-240 /CHECK TYPE OF TAPE
- SNA /IS IT RELOCATABLE?
- JMP RELBIN /YES
- TAD (-40 /IF A FIELD SETTING, IT'S ABSOLUTE
- AND (7700
- SNA
- JMP ABSLUT
- TAD BIN200 /CHECK FOR ORIGIN ALSO
- SZA CLA
- JMP NEWTAP /NOTHING..NEXT FRAME
-ABSLUT, CLA CMA
- JMS LTCODE
-ABSBIN, JMS RCOPY1 /COPY THIS FRAME AND READ NEXT
- TAD BN7600
-BNM140, SZA CLA /IS IT TRAILER?
- JMP ABSBIN /NO - KEEP GOING
-BEOT, CLA CMA /END OF TAPE
- JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
- JMP NEWTAP /GET NEXT TAPE
- LTCODE, 0 /SUBROUTINE TO PUNCH 200 CODE
- SMA /SHORT LEADER/TRAILER?
- JMS I (OTYPE
- SPA CLA /DIRECTORY DEVICE?
- TAD (70 /YES
- TAD (-100
- DCA TEMP
-LTLOOP, TAD BIN200
- JMS I (OCHAR /OUTPUT 64 OR 8 FRAMES OF L/T CODE
- JMP I (AOUERR
- ISZ TEMP
- JMP LTLOOP
- JMP I LTCODE
-
-RELBIN, TAD (SKP
- DCA I (INCTZF /DISABLE CONTROL-Z CHECKING ON INPUT
- CLA CMA
- JMS LTCODE /PUT OUT SHORT LEADER/TRAILER
-RELLP, TAD CHAR
- RTR
- RTR
- AND (17
- TAD (RELTBL
- DCA TEMP
- TAD I TEMP /GET DATA WORD FOR THIS FRAME
- SMA SZA /POSITIVE MEANS SPECIAL OR ERROR
- JMP RELERR
-RELSNA, SNA
- JMP RELEND /ZERO MEANS CHECKSUM FRAME
- DCA TEMP /NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
- JMS RCOPY1
-BN7600, 7600
- ISZ TEMP
- JMP .-3 /COPY THIS FRAME AND ALL SLAVE FRAMES
- JMP RELLP /GET NEXT CONTROL FRAME
-RELEND, JMS RCOPY1 /COPY THE FIRST FRAME OF THE CHECKSUM
- JMS I (OCHAR
- JMP I (AOUERR /OUTPUT THE SECOND FRAME
- JMP BEOT /END TAPE - START NEXT ONE
-BEOF, JMS LTCODE
- JMS I (OCLOSE
- JMP I (AOUERR
- JMP I (PIP
- RCOPY1, 0 /ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
- TAD CHAR
- JMS I (OCHAR
- JMP I (AOUERR
- JMS I (ICHAR
- JMP INEFER
- DCA CHAR
- TAD CHAR
- JMP I RCOPY1
-INEFER, SMA CLA /DETECT FATALITIES
- JMS I (PIPERR
- 7
- JMS I (PIPERR /A REAL BAD READ
- 4
-
-RELERR, CLL RAR
- SZA CLA /CODE OF 1 MEANS SPECIAL
- JMS I (PIPERR /ILLEGAL RELOCATABLE INPUT
- 10
- JMS RCOPY1
- CLL CML CMA RTL /MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
- TAD CHAR
- CLL CML RAL /(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
- JMP RELSNA
- PAGE
- ERPRNT, 0 /ERROR MESSAGE PRINTOUT ROUTINE
- DCA TEMP
-ERLP, TAD I TEMP
- RTR
- RTR
- RTR
- JMS ERPCH /PRINT HIGH-ORDER CHARACTER
- TAD I TEMP
- JMS ERPCH /PRINT LOW-ORDER CHARACTER
- ISZ TEMP
- JMP ERLP
-
-ERPCH, 0
- AND (77
- SNA
- JMP ERCRLF /0 CHARACTER TERMINATES
- JMS CHPRNT
- JMP I ERPCH
-FILENR, TAD ("#
- JMS I (TTYOUT
- TAD INFPTR /GET PTR TO CURRENT INPUT FILE
- TAD (321 /MAGIC NUMBER
- CLL RAR
- JMP FILENR-2
-
-CHPRNT, 0
- TAD (-37 /IS IT A _?
- SNA
- JMP FILENR /YES..PRINT FILE NUMBER
- IAC
- SNA /MAYBE ^?
- JMP I (SQFILE /YEP..PRINT FILE NAME
- SPA
- TAD (100
- TAD (236
- JMS I (TTYOUT
- JMP I CHPRNT
-
-ERCRLF, TAD (215
- JMS I (TTYOUT
- TAD (212
- JMS I (TTYOUT
- JMP I ERPRNT
- PDATE, 0 /PRINTS THE DATE
- SNA
- JMP I PDATE /NO DATE TO PRINT
- DCA ERPRNT
- ISZ I (PBLJMP
- JMS I (PR6BIT
- TAD ERPRNT
- CLL RTL
- RTL
- RAL
- AND (17
- JMS I (PRNUM
- TAD (57
- JMS I (PR6BIT
- TAD ERPRNT
- RTR
- RAR
- AND (37
- JMS I (PRNUM
- TAD (57
- JMS I (PR6BIT
- TAD ERPRNT
- AND (7
- TAD (106
- JMS I (PRNUM
- CLA CMA
- TAD I (PBLJMP
- DCA I (PBLJMP /RESET PRNUM TO PRINT LEADING SPACES
- JMP I PDATE
-
-DSKNUM, 0
- DCA DSKNAM+1
- JMS I (200
- 12
-DSKNAM, 5723
- 0
- 0
- HLT
- TAD DSKNAM+1
- JMP I DSKNUM
- RELTBL, -2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1
-
-ERRTBL, ERR0
- ERR1
- ERR2
- ERR3
- ERR4
- ERR5
- ERR6
- ERR7
- ERR8
- ERR9
- ERR10
- ERR11
- IFNZRO OS78 <DIRMSG>
-
- PAGE
- /ERROR MESSAGE TEXT GOES HERE
-
-
-ERR0, TEXT /NO ROOM FOR OUTPUT FILE/
-ERR1, TEXT /LINE TOO LONG IN FILE_/
-ERR3, TEXT /ERROR DELETING FILE/
-ERR4, TEXT /INPUT ERROR, FILE_/
-ERR5, TEXT /CAN'T OPEN OUTPUT FILE/
-ERR6, TEXT /DEVICE_ NOT A DIRECTORY DEVICE/
-ERR7, TEXT /PREMATURE END OF FILE, FILE_/
-ERR8, TEXT /ILLEGAL BINARY INPUT, FILE_/
-ERR9, TEXT /BAD DIRECTORY ON DEVICE_/
-ERR10, TEXT /DIRECTORY ERROR/
-
-
-TTYOUT, 0
- TLS
- TSF
- JMP .-1
- CLA
- JMP I TTYOUT
- PAGE
- /SQUISH PROCESSOR
-
-SQUISH, JMS I (CONFRM
- SURE /V3
-SQUISX, DCA I (OUELEN /INITIALIZE PARAMS TO FAKE OUT "IMTRA"
- DCA I (OUBLK
- DCA I (7621 /ZERO SECOND FILE FOR "INNEWF"
- DCA I (CTCFLG
- JMS I (IOPEN
- JMS I (INNEWF
- JMP I (PIP /NO INPUT
- TAD (OUDEVH+1
- DCA SOHND
- TAD I SQ7600
- SNA
- JMP I (PIP /NO OUTPUTEE, NO SQUISHEE
- JMS I (200
- 1
-SOHND, 0
- HLT
- JMS INTEST
- JMS I (OTYPE
- CLL RTR
- RAR
- AND (77
- TAD (DEVLEN
- DCA TEMP
- TAD SOHND /SET UP OZHNDL
- DCA I (OZHNDL /IN CASE OF JMP TO DVREDE
- TAD I TEMP /GET ENTRY FROM DEVICE LENGTH TABLE
- SNA /IS THE DEVICE LENGTH ZERO ?
- JMS I (DVREDE /IF SO, READ THE LENGTH
- DCA OUDLEN /SAVE OUTPUT DEVICE LENGTH
- JMS I (GETEQ
- DCA OUWAST
- TAD SOHND
- DCA OHNDLR
- TAD OHNDLR
- DCA I (OUHNDL
- TAD I (INHNDL
- DCA IHNDLR
- JMS SETCTC
- JMS I (CTCFLG
- CIF 0
- JMS I IHNDLR
- 1400
- 0
- 1
- JMP I (SQIDER+1
- CIF 0
- JMS I (7607
- 5400
- 0
- MTEMP /MOVE THE INPUT DIRECTORY TO SYS:
- JMP I (SQIDER+1
- CLA IAC
- DCA I (SQBUF2+2
- DCA I (CTCFLG
- TAD SOHND /SETUP DIRECTORY START
- JMS I (SQDTST
- JMS I (SETSAM /IF IHNDLR=OHNDLR, SAME=1
- CLA CMA
- DCA I (SQBUF2
- DCA I (OUTSEG
- JMP I (NEWOUT
-
-INTEST, 0 /TEST IF INPUT IS DIRECTORY
- TAD I (7617
- AND (17
- TAD (DCB-1
- DCA TEMP
- TAD I TEMP
- SMA CLA
- JMS I (PIPERR
- 6
- JMP I INTEST
-
-SETCTC, 0 /MODIFY 07600 TO RETURN TO SQCTLC
- TAD CDIF10
- CDF 0
- DCA I SQ7600
- TAD (5602 /JMP I .+1
- DCA I (7601
- TAD (SQCTLC
- DCA I (7602
-CDIF10, CIF CDF 10
- JMP I SETCTC
- OUK, 0 /V3 ON IMAGE MODE TRANSFER
- /CLOSE OUT FILE WITH = OPTION
- /IF NOT TOO SMALL
- TAD I (OUCCNT
- CLL CIA
- TAD I (MPARAM+3
- SNL /IS = OPTION LARGER?
-SQ7600, 7600 /RETURN OUCCNT IF IT'S LARGER
- TAD I (OUCCNT /RETURN LOW ORDER = OPTION IF IT'S LARGER
- JMP I OUK
- PAGE
- NEWIN, TAD (MTEMP-1
- DCA INSEG
- JMS I (CTCFLG
- CIF 0
- JMS I (7607
- 0210
-S7200, SQBUF2
-INSEG, 0
- JMP I (SQIDER
- DCA I (CTCFLG
- TAD I (SQBUF2+1
- DCA INBLK
- TAD (SQBUF2+4
- DCA INXR
-SGETIN, TAD I INXR
- SNA
- JMP SEMPTY
- DCA I OUTXR
- TAD OUTXR
- DCA OUSAVE
- JMS I (CYWAST /COPY WASTE WORDS
- TAD I INXR
- DCA RECCNT
- TAD RECCNT
- SNA
- JMP SNULL
- CMA CLL /V3
- TAD OUTBLK
- TAD OUDLEN
- SZL CLA
- JMP SNULER
- TAD RECCNT
- DCA I OUTXR
- CLA CMA
- TAD I (SQBUF1
- DCA I (SQBUF1
- TAD INBLK
- CIA
- TAD OUTBLK
- SNA CLA
- TAD SAME
- SNA CLA
-MOVFIL, JMS I (SQTRA /MOVE THE FILE DOWN
- TAD RECCNT
- CIA
- TAD OUTBLK
- DCA OUTBLK
- TAD RECCNT
-DMTX, CIA
- TAD INBLK
- DCA INBLK
- TAD OUTXR
- CIA
- TAD OUWAST
- TAD OUWAST
- TAD (SQBUF1+365
- SMA CLA /DO WE HAVE ROOM FOR TWO MORE ENTRIES?
- JMP NEXTIN
-
- /DIRECTORY SEGMENT OVERFLOW ON OUTPUT...
-
- ISZ I (OUTSEG
- TAD I (OUTSEG
- IAC
- DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT
- TAD I (SQBUF1+2
- TAD (-7
- SMA CLA
- JMP I (SQIDER-1 /TOO MANY SEGMENTS
- JMS I (OUTDIR /OUTPUT THIS SEGMENT
-NEWOUT, TAD (SQBUF1-1
- DCA OUTXR /INITIALIZE XR FOR NEXT OUTPUT SEGMENT
- DCA I (OUTINH /ZAP ANY OLD OUTPUT INHIBIT FLAG
- DCA I OUTXR
- TAD OUTBLK
- DCA I OUTXR
- DCA I OUTXR
- DCA I OUTXR
- TAD OUWAST
- DCA I OUTXR
-NEXTIN, ISZ I S7200
- JMP SGETIN
- TAD I (SQBUF2+2
- SNA /ANY MORE INPUT SEGMENTS?
- JMP I (SQOVER
- JMP NEWIN
-SNULER, TAD (NOROOM
- JMS I (ERPRNT
-SNULL, CLA CMA
- TAD OUSAVE
- DCA OUTXR
- JMP DMTX-1
-SEMPTY, TAD I INXR
- JMP DMTX
-OUSAVE, 0
- SURE, TEXT /ARE YOU SURE?/
-
-SETSAM, 0
- TAD IHNDLR
- CIA
- TAD OHNDLR
- SNA CLA
- IAC
- DCA SAME
- JMP I SETSAM
- PAGE
- SQOVER, DCA I OUTXR
- TAD OUDLEN
- TAD OUTBLK
- SNA
- JMP CKZERO
- DCA I OUTXR
- CLA CMA
- TAD I (SQBUF1
- DCA I (SQBUF1
-CKZERO, TAD I (SQBUF1
- SZA CLA
- JMP ZEROK
- CLA CLL CML RAR
- JMS OUTDIR /READ IN LAST DIRECTORY
- DCA I (SQBUF1+2 /ZERO OUT LINK WORD
- SKP
-ZEROK, ISZ OUTSEG
- JMS OUTDIR
-ZEROKS, JMS SRSTOR
- JMP I (PIP
-
- DCA I (SQBUF1+2
-SQIDER, JMS OUTDIR
- JMS SRSTOR
- JMS I (PIPERR
- 12
-OUTDIR, 0
- TAD (4210
- DCA .+4
- JMS CTCFLG
- CIF 0
- JMS I OHNDLR
- 0
- SQBUF1
-OUTSEG, 0
- JMP SQIDER+1
- DCA CTCFLG
- JMP I OUTDIR
-
-SQIOER, TAD (IOMSG
- JMS I (ERPRNT
- JMP I (SLGRET
- SQCTLC, KCC /JUMPED TO BY CODE AT 07600
- JMS I (TSTSAM /TEST IF OPERATION IS TO ITSELF
- TAD (CTCMSG
- JMS I (ERPRNT
- TAD CTCFLG
- SZA CLA
- JMP I CTCFLG
- TAD I (MPARAM+1 /IS IT /S?
- AND (40
- SNA CLA
- JMP I (SYSCPY /NO../Y
- JMP I (MOVFIL
-
-SRSTOR, 0
- JMS I (7700 /MAKE SURE MONITOR IS IN CORE
- 10
- DCA .-2 /AND WIPE THE CALL AWAY
- TAD (4207
- CDF 0
- DCA I (7600
- TAD (5000
- DCA I (7601
- DCA I (7602
- CDF 10
- JMP I SRSTOR
-
-CTCFLG, 0
- JMP I CTCFLG
- CTCMSG, TEXT /SORRY - NO INTERRUPTIONS/
-IOMSG, TEXT /I-O ERROR IN ^ - CONTINUING/
-NOROOM, TEXT /NO ROOM IN ^ - CONTINUING/
- PAGE
- K7760, 7760
-SYSCOP, TAD K7622 /SET INFPTR IN CASE OF /Y ERROR
- DCA INFPTR /WILL FILE #1
- JMS I (SETCTC /KLUDGE UP 07600
-SYSCPY, TAD (INDEVH+1
- DCA YIHAND /SET TO ASSIGN INPUT HANDLER
- TAD (OUDEVH+1
- DCA YOHAND
- TAD (2000
- DCA K2000 /THIS MAY GET CLOBBERED READING IN DIRECT.
- IAC /V12B
- DCA OFSET
- TAD I K7617
- SNA CLA /IS THERE AN INPUT DEVICE?
- ISZ I K7617 /MAKE INPUT =SYS
- JMS I (INTEST /SEE IF OPERATIONS ARE TO SAME DEVICE
- TAD I K7617
- JMS I K200 /ASSIGN HANDLER
- 1
-YIHAND, 0
-K7622, 7622 /THINLY DISGUISED HALT
- TAD I K7617
-K200, AND K7760 /CHECK INPUT FILE LENGTH
- SNA /IF BLANK,INPUT SYSTEM HEAD
- JMP YSOUT
- TAD (-6340 /CHECK FOR PROPER LENGTH
- SZA CLA
- JMP PER13 /ERROR..NOT SYSTEM HEAD
- TAD I (7601 /IS THERE OUTPUT DEVICE?
- SZA CLA /IF YES..WE CAN DO IMAGE XFER
- JMP I (IMGTST
- TAD I (7620
-YOUSYS, DCA YINREC /PICK UP STARTING RECORD
- CIF 0
- JMS I YIHAND /READ IN FIRST INPUT RECORDS
-K2000, 2000 /(0-15 IF SYSTEM HEAD,0-7 IF FILE)
- OUBUF
-YINREC, 0
- JMP I (PER4 /INPUT ERROR
- TAD I (7620 /IF INPUT FROM A FILE, OPEN
- SNA CLA /TEST LOC 605
- TAD (3000 /IF FROM HEAD, TEST 3605
- TAD (605
- DCA I (HDTST
- JMS I (TSTHED /TEST FOR VALID SYSTEM HEAD
- TAD YINREC
- TAD OFSET /BUMP TO NEXT RECORD
- DCA NXTRD
- TAD I (7600 /IF NO OUTPUT, FORGET IT
- SNA
- JMP PIPCLR /RESET AND GO TO PIP
- JMS I K200
- 1
-YOHAND, 0
- HLT /V3
- JMS I (FAKE
- JMS I (SETSAM
- JMS I (TSTIO /TEST OUTPUT. SEE IF DIRECT. DEV.
- CIF 0
- JMS I YOHAND /READ OUTPUT DIRECTORY INTO PLACE
- 1400
- 400
- 1
- JMP I (PER4
- CDF 0
- TAD I (401 /NOW TEST FOR VALID OUTPUT DEVICE
- CDF 10
- TAD (-10 /IF LESS THAN 10, DON'T XFER
- SPA CLA
- JMS I (PIPERR
- 11
- TAD (-10 /V12B
- DCA YINREC /XFER COUNTER
-
- JMP YDUMP
-YLOOP, CIF 0
- JMS I YIHAND /READ NEXT
-K3400, 1600 /V12B 7 BLOCKS
- OUBUF
-NXTRD, 0
- JMP I (PER4
- TAD NXTRD
- TAD (7 /V12B
- DCA NXTRD
-YDUMP, TAD (5600 /V12B
- JMS I (OUTDMP /WRITE BUFFER
- JMP I (AOUERR
- ISZ YINREC /DONE YET?
- JMP YLOOP /NOT YET..LOOP
-PIPCLR, JMS I (SRSTOR /CLEAR OUT 07600
- JMP I (PIP
- YSOUT, TAD I (7601 /HERE IF INPUT FROM SYSTEM HEAD
- SZA CLA /IS THERE AN OUTPUT FILE?
- JMP I (YTSOUT /YES, SET UP FOR IMAGE MODE
-YNOOUT,
- TAD (7 /AND RESTART READ AT RECORD 16
- DCA OFSET
- JMP YOUSYS
-OFSET, 0
-
-PER13, JMS I (PIPERR
- 13
-K7617, 7617 /V3
- PAGE
- DIRECT, -1
-DFORG, 0 /FILE STORAGE
- 0
- 0
-DWASTE, 0 /#WASTE WORDS
- 0
-DLENGT, 0
-
-MOVE, 0
-IMGTST, DCA SAME /V12B
- TAD I (YIHAND /V12B
- DCA IHNDLR /V12B
- JMP I (IMAGE /V12B
- TAD (6777
-MOVE1, DCA TSTSAM
- CDF 0
- TAD I MWAST
- DCA I TSTSAM
- CMA
- TAD MWAST
- DCA MWAST
- CMA
- TAD TSTSAM
- ISZ TEMP
- JMP MOVE1
- CLA
- CDF 10
- JMP I MOVE
-
-ERR11, TEXT /BAD SYSTEM HEAD/
-
-YTSOUT, TAD I (7617 /O.K. SETUP CD AREA FOR IMAGE XFER
- TAD (7760 /FROM SYSTEM AREA OF INPUT DEVICE
- DCA I (7617
- TAD I (7617
- AND (17
- TAD (6360
- DCA I (7621
- TAD K7
- DCA I (7622
- DCA SAME /ALLOW ^C IF TO OUTPUT FILE
- TAD I (YIHAND /TEST FOT VALID SYSTEM
- DCA IHNDLR
- CIF 0
- JMS I IHNDLR
- 0200
- 3400
-K7, 7
- JMP I (PER4
- JMS I (TSTHED
- JMP I (IMAGE
- TSTSAM, 0
- TAD SAME /IF /Y IS TO SAME DEVICE AS INPUT (SYS)
- SNA CLA /^C GIVES MESSAGE AND RETRIES OPERATION
- JMP I (ZEROKS
- JMP I TSTSAM
-
-ERR2, TEXT /OUTPUT ERROR/
-
-SQFILE, DCA MWAST
- TAD I (OUSAVE
- DCA TSTSAM /IF ERROR DURING /S
- DCA DWASTE
- CLA CLL CMA RTL
- DCA MOVE /-3 FOR FILE NAME
-SQFIL3, TAD I TSTSAM /FIRST 2 CHARS. IN NAME
- CLL RTR
- RTR
- RTR
-SQFIL5, AND (77
- SZA /IF ZERO, DON'T BOTHER
- JMS I (CHPRNT
- ISZ DWASTE /RIGHT HALF OR NEW WORD?
- JMP SQFIL4 /RIGHT HALF
- ISZ TSTSAM
- ISZ MOVE /EXHAUSTED ALL?
- JMP SQFIL3 /NOPE
- TAD MWAST /DONE WITH IT YET?
- SZA CLA
- JMP I (FILENR-1 /YES
- TAD I TSTSAM /IS THERE AN EXTENSION?
- SNA CLA
- JMP I (FILENR-1 /NO..CONTINUE ORIGINAL MSG
- TAD (256
- JMS I (TTYOUT
- ISZ MWAST /SIGNAL END
- CLA CMA
- JMP SQFIL3-1
-SQFIL4, CLA CMA
- DCA DWASTE
- TAD I TSTSAM /GET RIGHT HALF
- JMP SQFIL5
- MWAST, 0
- DCA TEMP
- TAD I INXR
- DCA I OUTXR /ROUTINE TO COPY WASTE WORDS
- ISZ TEMP
- JMP .-3
- JMP I MWAST
- PAGE
- FAKE, 0
- TAD I (YIHAND
- DCA IHNDLR
- TAD I (YOHAND
- DCA OHNDLR
- DCA I (OUCCNT
- DCA I (OUBLK
- DCA I (OUELEN
- TAD I (YOHAND
- DCA I (OUHNDL
- JMP I FAKE
-
-CYWAST, 0 /ROUTINE TO COPY WASTE WORDS
- CLA CLL CMA RTL /THREE MORE FOR FILE NAME
- JMS I (MWAST /COPY THEM
- TAD I (SQBUF2+4 /NOW ADJUST I/O WASTE WORDS
- CIA
- TAD OUWAST /DIFF. BETWEEN OUT AND IN WORDS
- SMA /IF <0, MORE OUT THAN IN
- JMP CGEWST /POS. MORE IN THAN OUT (OR SAME)
- DCA TEMP1
- TAD I (SQBUF2+4
- SZA
- JMS I (MWAST /COPY ALL INPUT WORDS
- DCA I OUTXR /AND 0 ALL EXTRA OUTPUT WORDS
- ISZ TEMP1
- JMP .-2
- JMP I CYWAST
-CGEWST, DCA TEMP1
- TAD OUWAST /XFER ONLY ENOUGH OUTPUT WDS.
- SZA
- JMS I (MWAST
- TAD INXR
- TAD TEMP1 /POINT INPUT TO NEXT FILE
- DCA INXR
- JMP I CYWAST
-
-TSTHED, 0 /TESTS FOR KEYBOARD MONITOR
- CDF 0
- TAD I HDTST /V12C
- CDF 10
- TAD (-7200
- SZA CLA
- JMP I (PER13 /IF NOT CLA, NOT VALID
- JMP I TSTHED
-HDTST, 3605
- TSTIO, 0 /SEE IF OUTPUT IS DIRECTORY DEVICE
- JMS I (OTYPE /GET DCB WORD FOR OUTPUT
- SMA CLA /IF NOT NEG., NOT DIRECT DEVICE
- JMS I (PIPERR
- 5
- TAD OHNDLR /IF OUTPUT=SYS, SET NO INTERRUPT
- TAD (171
- SNA CLA
- ISZ SAME
- JMP I TSTIO
-
-ASCI2, 0 /SEE IF VALID ASCII OUTPUT
- DCA TSTIO
- TAD I (7600
- SNA CLA
- JMP I (PIP /NO..BACK TO PIP
- TAD TSTIO /SEE IF /C IS ON
- SNA CLA
- JMS I (FIXLEN /NO..TRY TO ESTIMATE OUTPUT
- JMP I ASCI2
-
-SQDTST, 0 /ROUTINE TO CHECK /S DIRECTORIES
- DCA NOHND /PRESERVE POSSIBLE SYS ON OUTPUT
- TAD (7 /DEFAULT TO BLOCK 7
- DCA OUTBLK /INITIAL GUESS
- CDF 10 /NOW TRY TO READ DIRECTORY OF OUTPUT
- JMS I (OTYPE /IF NON-FILE, DON'T READ IT
- SMA CLA
- JMP P1A
- CIF 0 /COULD BE NON-FILE, HOWEVER.
- JMS I NOHND
- 0210
- 1400
-P1, 1
- JMP I (SQIDER+1 /ERROR IN READ
-P1A, DCA OLDDIR /WIPES ANY DIRECT. SEGMENT
- TAD I (1401
- TAD (-70 /IS OUTPUT A SYS DEVICE?
- SNA CLA
- JMP SYSDIR /YES.
- TAD NOHND /IS OUTPUT THE SYSTEM DEVICE?
- TAD (171
- SZA CLA
- JMP .+3
-SYSDIR, TAD (70
- DCA OUTBLK
- JMP I SQDTST
-
-NOHND=FAKE
-
-SYSZRO, TEXT /ZERO SYS?/
- AOUERR, SMA CLA /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
- JMP BOUERR /OUT OF SPACE
-PER2, JMS I (PIPERR
- 2
-BOUERR, JMS I (PIPERR
- 0
-
-ASCPTCH,TAD (ACHLP+1 /V3C FAKE OUT ICHAR
- DCA I (ICHAR /SIMULATE CALL TO ICHAR FROM 'ACHLP'
- JMP I (GETNEW /V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
- PAGE
- /THIS IS ONCE-ONLY CODE
-
-ONCE, 0
- STA
- TAD ONCE
- DCA ONCENF
- TAD (20
- DCA I ONCENF /RESTORE L20, DON'T ALLOW REENTRY
- TAD I (MPARAM+1
- AND (7
- SNA CLA /IS /V SET?
- JMP I ONCE /NO, RETURN
- TAD (VER /YES
- JMS I (ERPRNT /PRINT VERSION NUMBER
- JMP I ONCE /RETURN
-
-VER, TEXT \OS/8 PIP V14A\
-ONCENF, 0
-GETEQ, 0 /V3
- TAD I (MPARAM+3
- SNA
- IAC
- AND (77 /CONVERT 0 TO 1 AND 100 TO 0
- CIA
- JMP I GETEQ
-
-DVREDE, 0 /READ DEVICE WITH BAD BLOCK REFERENCED
- TAD I (OZHNDL /GET DEVICE ENTRY POINT
- DCA NEWHL
- CIF 0
- JMS I NEWHL /DO THE READ
- 0011
- 0
- -111 /NEGATIVE BLOCK - RETURNS MINUS LENGTH
- CIF 10
- JMP I DVREDE /ERROR RETURN FOR READ YIELDS DESIRED RESULTS
-NEWHL, 0
- PAGE
- $
-
DELETED src/os8-v3f/README.V3F
Index: src/os8-v3f/README.V3F
==================================================================
--- src/os8-v3f/README.V3F
+++ /dev/null
@@ -1,88 +0,0 @@
-OS/8 Version 3F 27-Jul-1995
-
-
-
-This archive directory contains the source files for the OS/8
-operating system version 3F that have been identified todate.
-This is not the complete release and may have been released
-as a maintenance update. The files listed below have been
-updated from the base V3D release and are useful in tracking
-the development of OS/8.
-
- The comments in OS8.PA denote this file as version 3F,
-but this file is NOT the same as the OS/78 V2 source. OS/8 V3F
-and OS/78 V2 seem to be parallel developments, since neither
-refers to the other. It is not known just when these files
-were released. The primary change to OS8 is adding access to
-memory above 32K.
-
- Contained here is the last known release of RESORC,
-which has been converted from the PAL to the MACREL
-assembler. Also here are new handlers (not in V3D) for the
-RL disks, RX02 floppies in several flavors, and VX virtual
-memory.
-
- The OS8V3F.EXE file is a self extracting ZIP file of
-the V3F sources included here. Simply run OS8V3F.EXE on a PC
-to extract the V3F source files.
-
-
-
-BLOAD.PA
-BOOT.PA
-BPAT.PA
-BUILD.PA
-CCL.BI
-CCL.MA
-CCLAT.MA
-CCLCD.MA
-CCLCDX.MA
-CCLCOR.MA
-CCLDAT.MA
-CCLDRV.MA
-CCLMSG.MA
-CCLPS.MA
-CCLREM.MA
-CCLRUN.MA
-CCLSB2.MA
-CCLSEM.MA
-CCLSIZ.MA
-CCLSUB.MA
-CCLTAB.MA
-CCLTBL.MA
-CD.PA
-FPAT.PA
-FUTIL.PA
-KL8E.PA
-OS78.BI
-OS8.PA
-PAL8.PA
-PIP.PA
-README.V3F
-RESORC.BI
-RESORC.MA
-RESOV0.MA
-RESOV1.MA
-RESOV2.MA
-RESOVD.MA
-RKA0.DI
-RKB0.DI
-RL0.PA
-RL1.PA
-RL2.PA
-RL3.PA
-RLC.PA
-RLFRMT.PA
-RLSY.PA
-RTL.PA
-RTS.PA
-RX78C.PA
-RXCOPY.PA
-RXNS.PA
-RXSY1.PA
-RXSY2.PA
-SAVECB.PA
-TECO.PA
-VXNS.PA
-VXSY.PA
-
DELETED src/os8-v3f/README.md
Index: src/os8-v3f/README.md
==================================================================
--- src/os8-v3f/README.md
+++ /dev/null
@@ -1,160 +0,0 @@
-# OS/8 V3F
-
-This directory contains source files in `PAL-8` and `MACREL` labeled as OS/8 v3F.
-It appears to be a nearly complete source distribution for the OS/8 V3D
-Device Extensions Kit.
-
-See also: [our documentation on theOS/8 V3D Device Extensions][extensions-doc].
-
-## Recent updates:
-
-### Cleanup newlines
-
-There were a couple places where, either in data transmission erorrs, or odd
-formatting, an OS/8 newline was followed by an extra linefeed character. Because
-we are going to be actively using these sources, copying them into and out of
-OS/8, these files have been edited into canonical form.
-
-Files affected: `BUILD.PA`, `CCLTAB.MA`, `OS8.PA.`
-This does subtly affect a `TECO` macro in `CCLTAB.MA`, but the change is
-in a print message getting a `\r` changed to `\r\n`. It should be totally
-benign.
-
-### Improved build batch files
-
-`CCL.BI` and `RESORC.BI` have been modified to name different devices
-for input and output files. You still need to do the device assignments:
-
- ASSIGN RKA1 IN
- ASSIGN RKB1 OUT
-
-`RESORC.BI` chained to a script, `MOVE.BI` that is supposed to move the
-output from `LINK` from `DSK:` to `OUT:` but that script is not present.
-So `COPY` and `DEL` commands to do that were added to the `RESORC.BI` and
-`CCL.BI`.
-
-## Utilization:
-
-The file `actions.txt` is to be submitted to our os8-cp utility as follows:
-
- ../../bin/os8-cp --action-file actions.txt
-
-This will create the rk05 image file `os8-v3f-build.rk05` with the sources in
-partition A. We expect a builder script to be written, which may live in
-mkos8 will then build the components as they are validated.
-
-## History
-
-These sources were nearly lost.
-
-ibiblio.org has a file, `readme.v3f` describing a self extracting archive,
-`OS8V3F.EXE` that contains the sources. But that file is not present.
-However a [mirror site of Johnny Billquist's arcihve][rtk-mirror] had both readme and
-the .exe.
-
-I believe the designation, "fromnichols" means that the collection was from
-Lee Nichols, a steering committee member of the 12-Bit SIG special interest group
-for 12 bit computers.
-
-The `readme.v3f` appears in this directory as `README.V3F`. We copy it into
-the build RK05 image as `README.TX`.
-
-[rtk-mirror]:http://rtk.mirrors.pdp-11.ru/ftp.update.uu.se/pdp8/pdp-8/fromnichols/
-[extensions-doc]:https://tangentsoft.com/pidp8i/doc/trunk/doc/os8-v3d-device-extensions.md
-
-<code>
-## Contents of readme.v3f
-
-OS/8 Version 3F 27-Jul-1995
-
-
-
-This archive directory contains the source files for the OS/8
-operating system version 3F that have been identified todate.
-This is not the complete release and may have been released
-as a maintenance update. The files listed below have been
-updated from the base V3D release and are useful in tracking
-the development of OS/8.
-
- The comments in `OS8.PA` denote this file as version 3F,
-but this file is NOT the same as the OS/78 V2 source. OS/8 V3F
-and OS/78 V2 seem to be parallel developments, since neither
-refers to the other. It is not known just when these files
-were released. The primary change to OS8 is adding access to
-memory above 32K.
-
- Contained here is the last known release of `RESORC`,
-which has been converted from the `PAL` to the `MACREL`
-assembler. Also here are new handlers (not in V3D) for the
-RL disks, RX02 floppies in several flavors, and VX virtual
-memory.
-
- The `OS8V3F.EXE` file is a self extracting ZIP file of
-the V3F sources included here. Simply run `OS8V3F.EXE` on a PC
-to extract the V3F source files.
-
-
-
-`BLOAD.PA`
-`BOOT.PA`
-`BPAT.PA`
-`BUILD.PA`
-`CCL.BI`
-`CCL.MA`
-`CCLAT.MA`
-`CCLCD.MA`
-`CCLCDX.MA`
-`CCLCOR.MA`
-`CCLDAT.MA`
-`CCLDRV.MA`
-`CCLMSG.MA`
-`CCLPS.MA`
-`CCLREM.MA`
-`CCLRUN.MA`
-`CCLSB2.MA`
-`CCLSEM.MA`
-`CCLSIZ.MA`
-`CCLSUB.MA`
-`CCLTAB.MA`
-`CCLTBL.MA`
-`CD.PA`
-`FPAT.PA`
-`FUTIL.PA`
-`KL8E.PA`
-`OS78.BI`
-`OS8.PA`
-`PAL8.PA`
-`PIP.PA`
-`README.V3F`
-`RESORC.BI`
-`RESORC.MA`
-`RESOV0.MA`
-`RESOV1.MA`
-`RESOV2.MA`
-`RESOVD.MA`
-`RKA0.DI`
-`RKB0.DI`
-`RL0.PA`
-`RL1.PA`
-`RL2.PA`
-`RL3.PA`
-`RLC.PA`
-`RLFRMT.PA`
-`RLSY.PA`
-`RTL.PA`
-`RTS.PA`
-`RX78C.PA`
-`RXCOPY.PA`
-`RXNS.PA`
-`RXSY1.PA`
-`RXSY2.PA`
-`SAVECB.PA`
-`TECO.PA`
-`VXNS.PA`
-`VXSY.PA`
-</code>
-
-### <a id="license"></a>License
-
-Copyright © 2018 by Bill Cattey. Licensed under the terms of
-[the SIMH license][sl].
DELETED src/os8-v3f/RESORC.BI
Index: src/os8-v3f/RESORC.BI
==================================================================
--- src/os8-v3f/RESORC.BI
+++ /dev/null
@@ -1,12 +0,0 @@
-$JOB ASSEMBLE AND LINK RESORC.MA
-.MAC OUT:RESORC<IN:RESORC.MA
-.MAC OUT:RESOV0<IN:RESOV0.MA
-.MAC OUT:RESOV1<IN:RESOV1.MA
-.MAC OUT:RESOV2<IN:RESOV2.MA
-.MAC OUT:RESOVD<IN:RESOVD.MA
-.LINK OUT:RESORC,RESOV0,RESOV1,RESOV2,RESOVD/9/S=12000
-.DEL OUT:RESO??.RB
-.COPY OUT:RESORC.SV<DSK:RESORC.SV
-.DEL DSK:RESORC.SV
-$END
-
DELETED src/os8-v3f/RESORC.MA
Index: src/os8-v3f/RESORC.MA
==================================================================
--- src/os8-v3f/RESORC.MA
+++ /dev/null
@@ -1,1149 +0,0 @@
-/15 OS/8 RESOURCES PROGRAM
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,1975,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-
-
-/ J.M.
-
-/SAVE INFO:
-
-/INSTRUCTIONS FOR CREATING RESORC.SV V5A
-
-/ .MAC RESORC
-/ .MAC RESOV0
-/ .MAC RESOV1
-/ .MAC RESOV2
-/ .MAC RESOVD
-/ .LINK RESORC,RESOV0,RESOV1,RESOV2,RESOVD/9/S=12000
-
-
-
-/CORE MAP:
-
-/0000-1777 C.D.
-/2000-2377 DEVICE NAME AND LENGTH TABLE
-/2400-2777 OUTPUT BUFFER (DOESN'T OVERLAP BETA REGISTER)
-/3000-3377 INPUT HANDLER
-/3400-3777 OUTPUT HANDLER
-/4000-7377 INPUT DIRECTORY
-/4000-7577 INPUT HANDLERS (LOSE 2ND HALF OF LAST ONE)
-
-/FIELD 1
-
-/10000-11777 USR
-/11400-11777 INPUT KBM
-/12000-15577 PROGRAM
-/15600-16177 INPUT BLOCK 0
-/16200-17577 INPUT USR
-
- INPBL0=5600
- INPKBM=1400
- INPUSR=6200
- INPHND=4000
-
- FAST=20
- DIG=21
- EXTEN=22
-
- DEVNUM=23 /DEVICE NUMBER OF HANDLER
- CNT=24
- PDNT=25 /PTS TO DEVICE NAME TABLE
- TEMP=26
- PUDNT=27 /PTS TO USER DEVICE NAME TABLE
- PDHIT=30 /PTS TO DEVICE HANDLER INFO TABLE
- PDCWT=31 /PTS TO DEVICE CONTROL WORD TABLE
- PTYP=32
- LFT=33
- RT=LFT+1
- DVNO=35
- BLOC=36
- PDHRT=37 /POINTS TO DEVICE HANDLER RESIDENCY TABLE
- UN=6
- X0=10
- XR1=11
-
- RESVERSION="A
-
-/FIXES SINCE FIELD TEST RELEASE:
-
-/1. 'INPUT ERROR' MESSAGE NO LONGER GARBLED
-/2. '%NON SYSTEM DEVICE' NEVER PRINTS HANDLERS
-
-/FIXES FOR MAINTENANCE RELEASE (V3C):
-
-/3. INCORPORATED PATCH SEQ NO 1 ALLOWS DISTINGUISHING BETWEEN
-/ HIGH AND LOW SPEED PTR'S AND ADDITIONAL CASSETTES
-/ [DSN FEB 1975]
-
-/4. FIXED LENGTHS OF DF32'S AND RF08'S [SUPERSEDES PATCH SEQ #2
-/ DSN APR 1975]
-
-/5. CHANGED VERSION NUMBER TO V3, UPDATED COPYRIGHT
-/6. ADDED DUMP, LST, AND RX-- TO INTERNAL NAME TABLES
-
-/7. ADDED DETAILS ABOUT DUMP AND FLOPPIES TO TABLES
-
-/V3D CHANGES:
-
-/8. ADDED NAMES SLU AND LQP TO TABLES
-/9. CAN DISTINGUISH LQP KIND OF LPTR
-/10. FIXED BUG ABOUT DUMPING BUFFER FULL OF NULLS
-/11. REMOVED LITTLE-USED 'OUT', 'DEV' FROM NAME TABLES
-
-/VERSION 5
-
-/12. ADDED RL01 SUPPORT
-/13. CONVERTED TO MACREL
-/14. ADDED LINKER OVERLAYS
-/15. ADDED RX02 SUPPORT
-/16. ADDED VXA0 SUPPORT
- .EXTERNAL VERSN,SIZE,BLOCK,MODE, ENTRY /IN OV3
- .EXTERNAL DIRT,KIND,CNTSLT,ZEROSL
- .EXTERNAL TYPTBL
- .GLOBAL GETTYP,PUTNAM,PUTO,PUTSP,CRLF,DPRINT
- .GLOBAL FREEDV,OPRINT,READI,SLOTAB,PRINT
- FIELD 1
-
- *2000
-
-START, SKP
- JMP NOCD /CHAIN ENTRY POINT
-/ JMS I (7700 /WE ASSUME THE USR IS IN CORE
-/ 10 /DON'T HAVE TO LOCK USR IN CORE IF JSW SET RIGHT
-CD, JMS I (200
- 5 /COMMAND DECODE
- 2331 /DEFAULT INPUT EXTENSION = 'SY'
-NOCD, DCA CTRLO
- JMS OPENO /OPEN OUTPUT FILE
- DCA FILENO
- TAD (7617
- DCA INPTR /POINT TO FIRST INPUT FILE
- TAD I (7644
- AND (4 / V OPTION?
- SZA CLA
- JMS TYPEV /OUTPUT VERSION #
- JMS SETSW
- DCA FLAG
- TAD I (7617
- SNA CLA
- JMS SPCASE /NO FIRST ARG MEANS USE SYS: IN SPECIAL SENSE
- JMP INL2
-INLOOP, TAD I INPTR /GET INPUT FILE # AND LENGTH
- SNA CLA
- JMP FINI /NO MORE INPUT
- JMS PRDASH
-INL2, TAD I INPTR
- AND (17
- DCA DVNO /GET 4-BIT DEVICE #
- ISZ FILENO
- TAD I INPTR
- AND (7760 /GET NEGATIVE OF FILE LENGTH
- DCA FILEN
- ISZ INPTR
- TAD I INPTR /GET STARTING BLOCK OF FILE
- DCA SBLOCK
- ISZ INPTR
- TAD DVNO
- JMS GETDCW
- SMA CLA
- JMP NOFLST /DEVICE IS NOT FILE STRUCTURED
- JMS OPENI /GET INPUT HANDLER
- JMS DIRECT /ASCERTAIN DIRECTORY INFO
- JMS HNDLRS /ASCERTAIN HANDLERS
- TAD EXTEN
- SZA CLA
- JMS I (CNTSLT
- JMS MONVER /ASCERTAIN MONITOR VERSION #
-NEXT, JMS CRLF
- DCA FLAG
- JMP INLOOP
- NOFLST, JMS PRINT
- TEXT /%DEV IS NOT FILE STRUCTURED/
- JMP NEXT
-
-FINI, JMS CLOSEO /CLOSE OUTPUT FILE
-FINIS, TAD I (7642
- SMA CLA
- JMP CD /COMMAND LINE ENDED WITH CR
- CIF CDF 0 /COMMAND LINE ENDED WITH ALTMODE
- JMP I (7605 /GO BACK TO MONITOR
-
-/CURRENT PIP /Y FILES ARE 50 (DEC) = 62 (OCTAL) BLOCKS LONG
-
-GETDCW, 0
- AND (17
- TAD (7757 /GET PTR INTO DEVICE CONTROL WORD TABLE
- DCA DCW
- TAD I DCW /GET D.C.W.
- DCA DCW /SAVE (WHY?)
- TAD DCW
- JMP I GETDCW
-
-SETSW, 0
- DCA FAST
- DCA EXTEN
- CLA IAC
- AND I (7643
- SNA CLA
- JMP NOTF
- ISZ FAST
- JMP I SETSW
-NOTF, TAD I (7643
- AND (200
- SNA CLA
- JMP I SETSW
- ISZ EXTEN
- ISZ FAST
- JMP I SETSW
-
-/FAST GT 0 IF /L OR /E SWITCH SET
-/EXTEN=1 IF /E SWITCH SET AND /L NOT SET
- INPTR, 0 /POINTS TO INPUT FILE LIST
-FILEN, 0 /INPUT FILE LENGTH (NEG IN BITS 0-7)
-DCW, 0 /INPUT DEVICE CONTROL WORD
-FILENO, 0 /INPUT FILE NUMBER IN INPUT LIST
-SBLOCK, 0 /STARTING BLOCK # OF INPUT FILE
-FLAG, 0 /NON-ZERO MEANS SPECIAL CASE OF NO FIRST ARG
-
-SPCASE, 0
- ISZ FLAG /NOTE SPECIAL CASE
- CLA IAC
- DCA I (7617 /FORCE FIRST INPUT TO BE SYS:
- JMP I SPCASE
- PAGE
- PRINT, 0
- TAD I PRINT
- DCA PRT
- ISZ PRINT
- TAD PRT
- JMS RTR6
- JMS PR
- JMP I PRINT
- TAD PRT
- JMS PR
- JMP I PRINT
- JMP PRINT+1
-PRT, 0
-RTR6, 0
-TTY212, RTR
- RTR
- RTR
- JMP I RTR6
-
-PR, 0
- AND (77
- SNA
- JMP I PR
- TAD (240
- AND (77
- TAD (240
- JMS PUTO
- ISZ PR
- JMP I PR
-
-TPRINT, 0 /PRINT TO TELETYPE
- CLA
- TAD I TPRINT
- DCA PRT
- ISZ TPRINT
- TAD PRT
- JMS RTR6
- JMS TPUT
- TAD PRT
- JMS TPUT
- JMP TPRINT+1
-
-TPUT, 0
- AND (77
- SNA
- JMP PUTCR
- TAD (240
- AND (77
- TAD (240
- JMS TYPE
- JMP I TPUT
-
-PUTCR, JMS TCRLF
- JMP I TPRINT
- TYPE, 0
- DCA TYTEM
- TAD CTRLO
- SZA CLA
- JMP I TYPE /DON'T TYPE IF CONTROL/O FLAG SET
- KSF
- SKP
- JMS LOOKC
- TAD TYTEM
-A, JMS TYPE2
- JMP I TYPE
-
-TYTEM, 0
-CTRLO, 0 /NON-ZERO MEANS CTRLO/O WAS STRUCK
-
-TYPE2, 0
- TLS
- TSF
- JMP .-1
- CLA
- JMP I TYPE2
-
-LOOKC, 0
- KRB
- AND (177
- TAD (-17
- SNA /IS IT ^O?
- JMP CTROLO /YES
- TAD (17-3 /NO
- SZA CLA /IS IT ^C?
- JMP I LOOKC /NO
- CIF CDF 0 /YES
- JMP I (7605
-CTROLO, TAD ("^
- JMS TYPE2
- TAD ("O
- JMS TYPE2
- ISZ CTRLO
- TAD (215
- JMS TYPE2
- TAD TTY212
- JMP A
-
-/*** NEEDS CTRL/S CTRL/Q SUPPORT
- TYPEV, 0
- JMS PRINT
- TEXT /RESORC V5 /
- *.-2
- RESVERSION&77+6500 /THIS OVERLAYS ABOVE VERSION NO
- /AND THE 6500 INCREASES TO 6600
- /FOR THE NEXT RELEASE
- *.+1
- JMS CRLF
- JMP I TYPEV
-
-CRLF, 0
- TAD (215
- JMS PUTO
- TAD TTY212
- JMS PUTO
- JMP I CRLF
-
-TCRLF, 0
- TAD (215
- JMS TYPE
- TAD TTY212
- JMS TYPE
- JMP I TCRLF
-
-DLST, -1750 /1000
- -144 /100
- -12 /10
- -1 /1
- 0 /END
- PAGE
- CLOSEO, 0 /CLOSE OUTPUT FILE
- TAD (232 /PUT ^Z IN BUFFER
- JMS PUTO
- TAD (-577 /V3D
- DCA KNT /SEND 577 NULLS TO OUTPUT BUFFER
- JMS PUTO /THIS GUARANTEES TO PURGE IT
- ISZ KNT
- JMP .-2
- TAD I (7600
- JMS I (200
- 4 /CLOSE
-L7601, 7601 /POINTER TO OUTPUT FILE NAME
-OUTLEN, 0 /LENGTH OF OUTPUT FILE
- HLT /SYSTEM ERROR, CANNOT OCCUR
- JMP I CLOSEO
-OPENO, 0
- JMS OINIT
- DCA OUTLEN
- TAD (3401
- DCA OENTRY
- TAD I (7600
- SNA CLA
- JMP DEFALT
- TAD I (7600
- JMS GETDCW
- RAL
- SPA CLA
- JMP NOWR /READ ONLY
- TAD I (7600
- JMS I (200
- 1 /FETCH DEVICE HANDLER (POSSIBLY 2-PAGE)
-OENTRY, 3401 /INTO PAGE 3400
- HLT /SYSTEM ERROR CANNOT OCCUR
-O2, TAD L7601
- DCA SBLKO
- TAD I L7601
- SNA
- TAD (2205 /RE
- DCA I L7601 /DEFAULT OUTPUT NAME IS RE
- DCA OLEN
- TAD I (7604
- SNA
- TAD (1423 /LS
- DCA I (7604 / .LS IS DEFAULT OUTPUT EXTENSION
- TAD I (7600
- JMS I (200
- 3 /ENTER OUTPUT FILE
-SBLKO, 7601 /POINTS TO OUTPUT FILE NAME
-OLEN, 0 /COMPLEMENT OF ACTUAL OUTPUT FILE LENGTH
- JMP DEVFUL /OUTPUT DEVICE FULL
- TAD SBLKO
- DCA OBLOCK
- TAD OLEN
- SZA
- TAD (-1
- DCA OLEN
- JMP I OPENO
-
-KNT, 0
- DEFALT, TAD (3100 /SET TTY: AS DEFAULT OUTPUT DEVICE
- DCA DVN
- TAD (3401
- DCA OENT
- JMS I (200
- 1 /FETCH HANDLER BY NAME
- 2424 /TT
-DVN, 3100 /DEVICE TTY:
-OENT, 3401 /INTO 3400
- JMP NOTTY /NO TTY: ON SYS:
- TAD OENT
- DCA OENTRY
- TAD DVN
- DCA I (7600
- JMP O2
-
-OUTERR, JMS TPRINT
- TEXT /?OUTPUT ERROR/
- JMS CRLF
- JMP FINIS
- TRY09, 0
- TAD (60
- CIA
- TAD NAM
- DCA DIG
- TAD DIG
- CLL
- TAD (-10 /TRY DIGITS 0-7
- SZL CLA
- JMP I TRY09
- TAD DIG
- TAD (60
- TAD RT
- DCA RT
- JMP GOTIT
-
-PUTSP, 0
- TAD (40
- JMS PUTO
- JMP I PUTSP
- PAGE
- PUTO, 0
- AND (377
- CDF 0
- JMP I PUTJMP
-PUTJMP, X1
-X1, DCA I PUTPT1
- TAD (X2
- DCA PUTJMP
-PUTLV, CDF 10
- JMP I PUTO /RETURN
-
-X2, DCA I PUTPT2
- TAD (X3
- DCA PUTJMP
- JMP PUTLV
-
-X3, DCA TMP
- TAD TMP
- CLL RTL
- RTL
- AND (7400
- TAD I PUTPT1
- DCA I PUTPT1
- TAD TMP
- CLL RTR
- RTR
- RAR
- AND (7400
- TAD I PUTPT2
- DCA I PUTPT2
- ISZ PUTPT1
- ISZ PUTPT1
- ISZ PUTPT2
- ISZ PUTPT2
- TAD (X1
- DCA PUTJMP
- ISZ PUTKNT
- JMP PUTLV
- CDF 10 /BUFFER FILLED
- ISZ OLEN
- SKP
- JMP DEVFUL /CAN'T WRITE ANYMORE
- CIF 0
- TAD OENTRY
- DCA OENTR /GET ON SAME PAGE
- JMS I OENTR
- 4200 /WRITE 1 BLOCK
- 2400 /FIELD 0, LOC 2400
-OBLOCK, 0 /OUTPUT BLOCK #
- JMP OUTERR
- ISZ OUTLEN
- ISZ OBLOCK /POINT TO NEXT BLOCK
- JMS OINIT
- JMP I PUTO /RETURN
-OENTR, 0
- PUTPT1, 0
-PUTPT2, 0
-PUTKNT, 0
-
-TMP, 0
- DIRECT, 0
- TAD SBLOCK
- SZA CLA
- JMP I DIRECT /NO DIRECTORY INFO FOR FILES
- JMS I (DIRT
- JMP I DIRECT
-
-SLOTAB, ZBLOCK 10 /KEEPS TRACK OF USED SLOTS
-
-GETTYP, 0
- CDF 0
- TAD I PTYP
- CDF 10
- JMP I GETTYP
- PUTNAM, 0
- DCA PUTNMT
- TAD I PUTNMT
- JMS PUTPAK
- ISZ PUTNMT
- TAD I PUTNMT
- JMS PUTPAK
- JMP I PUTNAM
-PUTNMT, 0
-/THIS PRINTS A 4 CHAR NAME, ARG IN AC.
-
-COMB, 0 /TEMP
- TAD LFT
- TAD RT
- SMA
- TAD (4000
- JMP I COMB
- PAGE
- NAME, 0
- DCA NAM
- TAD FAST
- SZA CLA
- JMP TRY1
- STA
- TAD DEVNUM
- SNA CLA
- JMP TRY1
- TAD (",
- JMS PUTO
-TRY1, TAD (LIST1
- DCA NM1
-LP1, TAD I NM1
- SNA
- JMP TRY2
- DCA LFT
- ISZ NM1 /TRY A-B
- TAD (-2 /CHANGE TO -4 TO TRY A-D
- DCA TEMP
- DCA RT
-LP1X, TAD RT
- TAD (100
- DCA RT
- JMS COMB
- JMS TRY09
- ISZ TEMP
- JMP LP1X
- JMP LP1
-
-NAM, 0 /SPECIFIED NAME
-NM1, 0
-
-TRY2, TAD (LIST2
- DCA NM1
-LP2, TAD I NM1
- SNA
- JMP TRY3
- DCA LFT
- ISZ NM1
- TAD I NM1
- ISZ NM1
- DCA RT
- JMS COMB
- DCA TEMP
- TAD TEMP
- CIA
- TAD NAM
- SNA CLA
- JMP GOTIT
- TAD TEMP
- JMS TRY09
- JMP LP2
- /TRY0 SHOULD BE SPECIAL CASE TESTS
-
-TRY3, TAD NAM
- JMS RTR6
- AND (37
- SNA
- JMP TRY4
- JMS SETIFA
- CLL RAR
- JMS RTR6
- DCA LFT
- TAD NAM
- AND (77
- JMS SETIFA
- TAD LFT
- DCA LFT
- DCA RT
- JMP GOTIT
-
-SETIFA, 0
- SNA
- JMP I SETIFA
- TAD (-33
- SPA
- JMP LETR
- TAD (33-60
- CLL
- TAD (-12
- SZL
- JMP NODI
- TAD (12+60-33
-LETR, TAD (33
- JMP I SETIFA
-NODI, CLA
-TRY4, TAD NAM
- JMS NNAME
-NAMLV, JMP I NAME
- CMFLG, 0
-
-/COMB, 0
-/ TAD RT
-/ SZA CLA
-/ STA
-/ DCA CMFLG
-/ TAD LFT
-/ TAD RT
-/ ISZ CMFLG
-/ JMP I COMB
-/ CLL RAL
-/ STL RAR
-/ JMP I COMB /TURN ON BIT 0 OF 1 WORD NAME
-
-LIST1, TEXT /DTMTLTTDCSRKRFRXVX/
-
-PRDASH, 0
- JMS PRINT
- TEXT /----/
- JMS CRLF
- JMS CRLF
- JMP I PRDASH
- RTL6, 0
- RTL
- RTL
- RTL
- JMP I RTL6
- PAGE
- DEVFUL, JMS TPRINT
- TEXT /?OUTPUT DEV FULL/
- JMP FINIS
-
-NOWR, JMS TPRINT
- TEXT /?OUTPUT DEV IS READ-ONLY/
- JMP FINIS
-NOTTY, JMS TPRINT
- TEXT /?TTY DOES NOT EXIST/
- JMP FINIS
- OINIT, 0
- TAD (-200
- DCA PUTKNT
- TAD (2400
- DCA PUTPT1
- TAD (2401
- DCA PUTPT2
- TAD (X1
- DCA PUTJMP
- JMP I OINIT
- READI, 0
- TAD I READI
- DCA ARG1
- ISZ READI
- TAD I READI
- DCA ARG2
- ISZ READI
- TAD I READI
- DCA ARG3
- ISZ READI
- CIF 0
- JMS I IENTRY
-ARG1, 0
-ARG2, 0
-ARG3, 0
- JMP INERR
- JMP I READI /REURN
-
-INERR, JMS TPRINT
- TEXT /?INPUT ERROR/
- JMP FINIS
-
-OPENI, 0 /FECTH INPUT HANDLER
- TAD (3001 /INTO PAGES 3000, 3200
- DCA IENTRY
- TAD DVNO
- JMS I (200
- 1 /FETCH HANDLER
-IENTRY, 3001
- HLT /SYSTEM ERROR, CAN'T OCCUR
- JMP I OPENI
- PAGE
- /DECIMAL PRINT
-/LINK OFF MEANS PRINT LEADING SPACES
-/LINK ON MEANS DON'T PRINT LEADING SPACES OR ZEROS
-
-DPRINT, 0
- DCA DTM
- RAR
- DCA LNK
- DCA ZFLG
- TAD (DLST
- DCA PLST
-DPL2, DCA DYG
-DPLUP, TAD I PLST
- SNA
- JMP I DPRINT
- CLL
- TAD DTM
- SNL
- JMP NEGG
- ISZ DYG
- DCA DTM
- JMP DPLUP
-
-NEGG, CLA
- TAD DYG
- TAD ZFLG
- SNA
- JMP PRBLNK
- TAD (60
- JMS PUTO
- STL CLA RAR /4000
- DCA ZFLG
-ISZZ, ISZ PLST
- JMP DPL2
-
-PRBLNK, TAD LNK
- CLL RAL
- TAD L40
- SNL
- JMS PUTO
- CLA
- JMP ISZZ
-DYG, 0
-PLST, 0
-ZFLG, 0 /4000 MEANS PASSED LEADING ZEROES
-LNK, 0
- /PRINTS A 2-DIGIT OCTAL NUMBER WITH LEADING 0'S
-
-OPRINT, 0
- DCA OTEM
- TAD OTEM
- RTR
- RAR
- JMS OPRI
- TAD OTEM
- JMS OPRI
- JMP I OPRINT
-
-OPRI, 0
- AND (7
- TAD (260
- JMS PUTO
- JMP I OPRI
-
-PRINT4, 0
- DCA DTM
- TAD DTM
- JMS RTR6
- JMS OPRINT
- TAD DTM
- JMS OPRINT
- JMP I PRINT4
-
-DTM, 0
-
-PUTPAK, 0
- DCA DTM
- TAD DTM
- JMS RTR6
- JMS PR
- JMS BLNKIT
- TAD DTM
- JMS PR
- JMS BLNKIT
- JMP I PUTPAK
-
-BLNKIT, 0
- TAD FAST
- SZA CLA
- TAD L40
- JMS PR
-L40, 40 /CAN'T HURT TO CALL PR WITH A 0
- JMP I BLNKIT
-OTEM, 0
- /DIR DID NOT GET IN CORE ON /F?
-
-DEV, DCA BLCK0
- TAD (66
- DCA BLCK66
- TAD (7
- DCA KBM
- TAD (13
- DCA USRBLK
- CDF 0
- TAD I (4001 /GET STARTING BLOCK # OF FILES
- CDF 10
- TAD (-7
- SNA CLA
- JMP NONSYS /FILES START AT BLOCK 7 OF DEVICE
- TAD (16
-/CHECK TO SEE THAT DEVICE HAS SYSTEM ON IT
- JMP RD
-
-NONSYS, JMS PRINT
- TEXT /%NON SYSTEM DEVICE/
- JMP NEXT
- PAGE
- MONVER, 0
- TAD FAST
- SNA CLA
- JMP I MONVER
- TAD I (1400
- TAD (-7607
- SNA
- JMP NOTV3
- TAD (7607+60
- DCA TEMPX
- TAD I (1400+31
- DCA TMPTWO
-OS8, TAD ("O
- JMS PUTO
-MONV2, JMS PRINT
- TEXT \S/8 V\
- TAD TEMPX
- JMS PUTO
- TAD TMPTWO
- JMS PUTO
- JMS CRLF
- JMP I MONVER
-
-TMPTWO, 0
-TEMPX, 0
-
-NOTV3, TAD (40
- DCA TMPTWO
-/CHECK FOR PS/8 AND COS
- JMP OS8
- LIST2, DEVICE LPT
- DEVICE TTY
- DEVICE PTR
- DEVICE PTP
- DEVICE CDR
- DEVICE SYS
- DEVICE DSK
- DEVICE CDP
-/ DEVICE DEV
-/ DEVICE OUT
-/ DEVICE INP
- DEVICE BAT
- DEVICE NULL /SHOULD BE IN NEXT TABLE
- DEVICE LST /V3C
- DEVICE DUMP
- DEVICE SLU
- DEVICE LQP
- DEVICE RL0A
- DEVICE RL0B
- DEVICE RL0C
- DEVICE RL1A
- DEVICE RL1B
- DEVICE RL1C
- DEVICE RL2A
- DEVICE RL2B
- DEVICE RL2C
- DEVICE RL3A
- DEVICE RL3B
- DEVICE RL3C
- DEVICE VXA0
- 0
-
-/LIST3, DEVICE NULL
-/ DEVICE TEST
-/ DEVICE LIST
-/ DEVICE DUMP /V3C
-/ ZBLOCK 2 /PATCH SPACE
-/ 0
-
-/INTERESTING NOTE: 'BAT', 'FOO2' AND 'RKC6' ALL HASH OUT TO 6601
-/** WANT TO CHANGE AIW PRINTER TO SAY 'NO' ADDITIONAL INFO WORDS
-/IF THERE ARE NONE.
- /DTN
-/DKN
-GOTIT, TAD FAST
- SZA CLA
- JMS PUTSP
- TAD (LFT
- JMS PUTNAM
- TAD FAST
- SZA CLA
- JMS PUTSP
- JMP NAMLV
- BADFIL, JMS PRINT
- TEXT /%NOT A SYSTEM HEAD/
- JMP NEXT
- PAGE
- /FORMAT OF SYSTEM HEAD FILE
-
-/REL BLK CONTENTS ABS BLK ON DEV
-
-/0 BOOTSTRAP & PAGE 0'S 0
-/1-4 KEYBOARD MONITOR 7-12
-/5-7 USR 13-15
-/10-17 DEVICE HANDLERS 16-25
-/20 ENTER 26
-/21-42 SCRATCH BLOCKS 27-50
-/43-45 COMMAND DECODER 51-53
-/46-47 SAVE,DATE 54-55
-/50 ERROR OVERLAY 56
-/51 CHAIN OVERLAY 57
-/52-55 ODT 60-63
-/56 RESERVED FOR EXPN 64
-/57 CCL SCRATCH 65
-/60 12K TD8E HANDLER 66
-/61 CCL OVERLAY 67
- HNDLRS, 0
- TAD SBLOCK
- SNA /IS IT A FILE?
- JMP DEV /NO
- DCA BLCK0 /YES
- TAD BLCK0
- TAD (60
- DCA BLCK66
- TAD FILEN
- TAD (-6340
- SZA CLA
- JMP BADFIL /FILE DOESN'T HAVE LENGTH 50 (DECIMAL)
- TAD BLCK0
- IAC
- DCA KBM
- TAD BLCK0
- TAD (5
- DCA USRBLK
- TAD BLCK0
- TAD (10
-RD, DCA HNDBLK
- JMS READI /READ IN BLOCK 0
- 210 /2 PAGES
- INPBL0
-FREEDV, /# OF FREE DEVICE NUMBERS
-BLCK0, 0
- TAD I (INPBL0+212 /** DEPENDS ON TD8E HANDLER
- TAD (-3
- SZA CLA /IS IT 12K TD8E?
- JMP NOTD8E /NO
- JMS READI /YES
- 110 /1 PAGE
- INPBL0
-BLCK66, 66
-NOTD8E, TAD I (INPBL0+200
- TAD (-4207
- SZA CLA
- JMP BADMON /BAD MONITOR ON DEVICE
- DCA 7 /DELETE CURRENT USR DIRECTORY SEGMENT
- /SINCE KBM READS OVER IT
- JMS READI /READ IN KEYBOARD MONITOR
- 211 /ONLY FIRST 2 PAGES
- INPKBM
-KBM, 7
- JMS READI /READ IN USR
- 611 /6 PAGES
- INPUSR
-USRBLK, 13
- JMS READI /READ IN ALL HANDLERS (EXCEPT 2ND PAGE OF LAST ONE)
- 1700 /17 PAGES
- INPHND
-HNDBLK, 16
- TAD (-17
- DCA CNT
- DCA FREEDV
- JMS ZEROSL
- DCA DEVNUM
- JMS SETPTS
- JMS HEADING
-LOOP, ISZ DEVNUM /PT TO NEXT HANDLER
- TAD I PDNT /LOOK AT DEVICE NAME
- SNA CLA
- JMP NOXXT
- TAD EXTEN
- SNA CLA
- JMP NONUM
- TAD DEVNUM
- JMS OPRINT
-NONUM, TAD I PDNT
- JMS NAME /PRINT NAME
- TAD FAST
- SNA CLA
- JMP NEXXT
- JMS TIPE /PRINT TYPE
- TAD EXTEN
- SNA CLA
- JMP PUSER
- JMS MODE /PRINT MODE
- JMS SIZE /PRINT SIZE
- JMS BLOCK /PRINT BLOCK # OF LOC OF HANDLER
- STA
- DCA UN
- JMS KIND /PRINT KIND
- JMS VERSN /PRINT HANDLER VERSION #
- JMS ENTRY
-PUSER, TAD I PUDNT
- SNA CLA
- JMP EOL
- TAD I PUDNT
- JMS NAME /PRINT USER NAME
-EOL, JMS CRLF
-NEXXT, ISZ PDNT
- ISZ PUDNT
- ISZ PDHIT
- ISZ PDCWT
- ISZ PDHRT
- ISZ CNT
- JMP LOOP
- JMS CRLF
- JMP I HNDLRS
-
-NOXXT, ISZ FREEDV
- JMP NEXXT
- PAGE
- HEADING,0
- TAD FAST
- SNA CLA
- JMP I HEADING
- TAD EXTEN
- SNA CLA
- JMP REGLR
- JMS PRINT
- TEXT /# NAME TYPE MODE SIZ BLK KIND U V ENT USER/
- JMP HDLV
-REGLR, JMS PRINT
- TEXT / NAME TYPE USER/
-HDLV, JMS CRLF
- JMP I HEADING
- SETPTS, 0
- TAD I (INPUSR+36
- TAD (INPUSR
- DCA PDNT
- TAD FLAG
- SZA CLA
- TAD (7741-141-INPBL0
- TAD (INPBL0+141
- DCA PUDNT
-/CHANGE FOR FLAG?
- TAD I (INPUSR+37
- TAD (INPUSR
- DCA PDHIT
-/FLAG?
- TAD (INPBL0+160
- DCA PDCWT
- TAD (INPBL0+47
- DCA PDHRT /DEVICE HANDLER RESIDENCY TABLE
- JMP I SETPTS
- CODE, 0 /DEVICE CODE
-
-NNAME, 0
- DCA TIPE
- TAD ("(
- JMS PUTO
- TAD TIPE
- JMS PRINT4
- TAD (")
- JMS PUTO
- JMP I NNAME
-
-TIPE, 0
- TAD I PDCWT
- RTR
- RAR
- AND (77
- DCA CODE
- TAD CODE
- CLL RTL
- TAD (TYPTBL
- DCA PTYP
- JMS GETTYP
- ISZ PTYP
- SNA
- JMP UNKN
- JMS PUTPAK
- JMS GETTYP
- JMS PUTPAK
- ISZ PTYP /POINT TO SIZE
- JMP I TIPE
-UNKN, JMS PUTSP
- TAD CODE
- JMS OPRINT
- JMS PUTSP
- ISZ PTYP
- JMP I TIPE
- BADMON, JMS PRINT
- TEXT /%BAD MONITOR/
- JMP NEXT
- PAGE
- PAGE
-
DELETED src/os8-v3f/RESOV0.MA
Index: src/os8-v3f/RESOV0.MA
==================================================================
--- src/os8-v3f/RESOV0.MA
+++ /dev/null
@@ -1,165 +0,0 @@
-/1 OV0 FOR RESORC
-
- .ENTRY VERSN,SIZE,BLOCK,ENTRY,MODE
- .EXTERNAL GETTYP,DPRINT,OPRINT,PUTSP,PUTO
- .EXTERNAL SLOTAB,PRINT
- PDHRT=37
- PDCWT=31
- PTYP=32
- INPBL0=5600
- PDHIT=30
- INPHND=4000
- BLOC=36
-
- .RSECT OV3,LEVEL=1,OVERLAY=0
- FIELD 1
-
-VERSN, 0
- JMS PUTSP
- TAD BLOC
- SNA CLA
- JMP SYSV /TEMP (ENTRY PT IS IN FIELD 1 7600
- TAD I PDHIT
- AND (177
- TAD BLOC
-GOVR, DCA DTM
- JMS GETV
- CLL IAC
- TAD (-34
- SZL CLA
- JMP NOOOP
- JMS GETV
-PUTVR, SZA
- TAD (40
- TAD (40
- JMS PUTO
- JMP I VERSN
-
-OTEM,
-GETV, 0
- CDF 0
- TAD I DTM
- CDF 10
- JMP I GETV
-
-NOOOP, STA
- TAD DTM /SCAN BACKWARDS FOR HANDLER VERSION # (LT 33)
- JMP GOVR
-
-SYSV, TAD I PDHRT
- AND (177
- TAD (INPBL0+200
- DCA DTM
- TAD I DTM
- CLL
- TAD (-34
- SNL CLA
- TAD I DTM /PRINT BAD VERSION # AS SPACE
- JMP PUTVR
-DTM, 0
- SIZE, 0
- JMS GETTYP
- CIA
- CLL
- JMS DPRINT
- JMS PUTSP
- ISZ PTYP /POINT TO KIND SUBROUTINE
- JMP I SIZE
- MODE, 0
- JMS PUTSP
- TAD (-4
- DCA MKNT
- TAD I PDCWT
- RTL
- RAL
- JMS MSET
- "R
- TAD I PDCWT
- RTL
- JMS MSET
- "W
- TAD I PDCWT
- RAL
- CML
- JMS MSET
- "F
- JMS PUTSP
- ISZ MKNT
- JMP .-3
- JMP I MODE
-
-MSET, 0
- CLA
- TAD I MSET
- DCA MCHAR
- ISZ MSET
- SZL
- JMP I MSET
- ISZ MKNT
- TAD MCHAR
- JMS PUTO
- JMP I MSET
-
-MKNT, 0
- PAGE
- ET,
-BLOCK, 0
- TAD I PDHIT
- RTL
- RTL
- RTL
- AND (17
- SNA
- JMP SYS
- DCA SLTM
- STA
- TAD SLTM
- CLL RTR
- RTR
- RAR
- TAD (INPHND
- DCA BLOC
- TAD SLTM
- TAD (15
- JMS OPRINT
- TAD I PDHIT
- SMA CLA
- TAD (40-"+
- TAD ("+
- JMS PUTO /"+" MEANS 2 PAGE HANDLER
- TAD SLTM
- TAD (SLOTAB-1
- DCA SLTM
- ISZ I SLTM
- JMP I BLOCK
-SYS, JMS PRINT
- TEXT /SYS/
- DCA BLOC /0 MEANS RESIDENT WITH SYS:
- JMP I BLOCK
-
-MCHAR,
-ENTRY, 0
- JMS PUTSP
- TAD BLOC
- SNA CLA
- JMP SYSENT
- TAD I PDHIT
-EN2, DCA ET
- TAD ET
- RTR
- RTR
- RTR
- AND (1
- SZA
- TAD (20
- TAD (40
- JMS PUTO
- TAD ET
- JMS OPRINT
- JMP I ENTRY
-
-SYSENT, TAD I PDHRT
- JMP EN2
-
-SLTM, 0
- PAGE
DELETED src/os8-v3f/RESOV1.MA
Index: src/os8-v3f/RESOV1.MA
==================================================================
--- src/os8-v3f/RESOV1.MA
+++ /dev/null
@@ -1,333 +0,0 @@
-/1
- .EXTERNAL PUTNAM,PUTSP,GETTYP,PUTO
- .ENTRY KIND
- .GLOBAL TYPTBL
- PDHRT=37
- XR1=11
- TEMP=26
- PDHIT=30
- BLOC=36
- UN=6
-
- .RSECT OV,LEVEL=1,OVERLAY=1
- FIELD 1
-
-GETD77, 0
- TAD (7707
- DCA MASK
- TAD (-6704 /V3C
- JMS SRCH
- RTR
- RAR
- AND (7
- JMP I GETD77
-
-QTTY, TAD I PDHIT
- SMA CLA /1 OR 2 PAGE?
- JMP I ($ASR /1 PAGE
- JMP I ($KL8E /2 PAGE
-
-QRK8E, TAD I PDHIT
- AND (7
- CLL RAR
- DCA UN
- JMP I ($RK8E
-
-TSTUN, 0
- TAD I PDHIT
- AND (7
- DCA UN
- JMP I TSTUN
-
-
-QRK8, JMS TSTUN
- JMP I ($RK8
-QTC08,
-QLINC, JMS TSTUN
- JMP I (NOKIND
-/HNDGET GETS VALUE IN HANDLER FROM REL LOC IN AC
-
-HNDGET, 0
- TAD BLOC
- DCA TEMP
- CDF 0
- TAD I TEMP
- CDF 10
- JMP I HNDGET
- /SRCH SEARCHES THE HANDLER FOR THE NEGATIVE
-/OF THE NON-ZERO VALUE IN THE AC.
-/MASKED BY MASK.
-/IF FOUND, RETURN IS MADE WITH VALUE(WITHOUT MASK) IN AC
-/IF NOT FOUND, AC IS 0 UPON RETURN
-
-SRCH, 0
- DCA LOOK4
- STA
- TAD BLOC
- DCA XR1
- TAD (-230 /V3C MUST SEARCH 2 PAGES; TROUBLE IF TA8E IS IN LAST SLOT
- DCA SRCHCNT
-SRCHLP, CDF 0
- TAD I XR1
- CDF 10
- DCA TEMP
- TAD TEMP
- AND MASK
- TAD LOOK4
- SNA CLA
- JMP SRCHGOT
- ISZ SRCHCNT
- JMP SRCHLP
- JMP I SRCH
-
-SRCHGOT,TAD TEMP
- JMP I SRCH
-
-SRCHCNT,-400
-LOOK4, 0
-/ **** NOTE: ALL HANDLERS SHOULD BE PADDED OUT TO FILL PAGE
-/ WITH ZEROES
-/BUILD SHOULD WRITE ZEROES IN 2ND PAGE OF ONE PAGE HANDLER
- /SPECIAL PURPOSE ROUTINES
-
-QPTP,
-QPTR, STA
- DCA MASK
- TAD (-6021
- JMS SRCH
- SZA CLA
- JMP I ($PT8E
- JMP I ($LSPT
-
-/FOR TYPE PTR
-/ IF HANDLER CONTAINS A 6021 IT IS A PT8E
-/ OTHERWISE IT IS A LSPT
-
-QCR8E, TAD (104
- JMS HNDGET
- TAD (-3203
- SNA
- JMP I ($C029
- TAD (3203-7735
- SNA CLA
- JMP I ($C026
- JMP I (NOKIND
- /FOR TYPE CR8E
-/ IF REL LOC 104 IS A 3203 IT IN 029 KIND
-/ IF REL LOC 104 IS A 7735 IT IS AN 026 KIND
-/ OTHERWISE IT IS AN UNKNOWN KIND
-
-QLPTR, TAD I PDHIT
- SPA CLA /1 OR 2 PAGE?
- JMP I ($LQP /2 PG
- STA /1 PG
- DCA MASK
- TAD (-6652 /SEARCH FOR A 6652
- JMS SRCH
- SZA CLA
- JMP I ($L645 /FOUND IT
- CLA IAC /LOOK AT REL LOC 1
- JMS HNDGET
- TAD (-4
- SNA
- JMP I ($LV8E
- TAD (4-14
- SNA CLA
- JMP I ($LPSV
- JMP I (NOKIND
-
-/IF HANDLER CONTAINS A 6652 IT'S AN L645
-/OTHERWISE, DEPENDS ON REL LOC 1
-/ IF REL LOC 1 IS A 14, IT'S A LPSV
-/ IF REL LOC 1 IS A 4, IT'S A LV8E
-/ OTHERWISE IT'S UNKNOWN (POSSIBLY OLD LP08 OR LS8E KIND)
-
-MASK, 0
- PAGE
- QTD8E, JMS I (GETD77
- CIA
- TAD (10
- DCA TEMP
- TAD I ($TD8+1
- AND (7700
- TAD TEMP
- DCA I ($TD8+1
- TAD I PDHIT
- RTR
- RAR
- STA
- TAD TEMP
- CML RAL /TIMES 2 + LINK
- DCA UN
- JMP I ($TD8
-
-/FIGURE OUT KIND OF TD8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
-/ N TYPE
-/ 7 TD8A
-/ 6 TD8B
-/..
-/ 1 TD8G
-/ 0 TD8H
-
-QTA8E, JMS I (GETD77
- IAC
- DCA TEMP
- TAD I ($TA8+1
- AND (7700
- TAD TEMP
- DCA I ($TA8+1
- STA
- TAD I PDHIT
- AND (177
- SNA CLA
- CLA IAC
- DCA UN
- STA
- TAD TEMP
- CLL RAL
- TAD UN
- DCA UN
- JMP I ($TA8
- /FIGURE OUT KIND OF TA8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
-
-/ N KIND
-/ 0 TA8A
-/ 1 TA8B
-/...
-/ 6 TA8G
-/ 7 TA8H
- RLSPC, TAD I PDHIT
- TAD (-50
- RTR
- SKP
-RLSP, TAD I PDHIT
- AND (3
- DCA UN
- JMP I (NOKIND
- PAGE
- $LQP, IAC /23
-PLAT4, IAC /22
-PLAT3, IAC /21
-PLAT2, IAC /20
-PLAT1, IAC /17
-$XTRA, IAC /16
-$KL8E, IAC /15
-$RK8E, IAC /14
-$RK8, IAC /13
-$ASR, IAC /12
-$TA8, IAC /11
-$TD8, IAC /10
-$L645, IAC /7
-$LPSV, IAC /6
-$LV8E, IAC /5
-$C026, IAC /4
-$C029, IAC /3
-$LSPT, IAC /2
-$PT8E, IAC /1
-NOKIND, CLL RAL
-/PRINTS NAME FROM TABLE, ENTER WITH ENTRY # IN AC
-PRNAM, TAD (TABASE
- JMS PUTNAM
- JMS UNIT
- JMP KINDRET
- KIND, 0
- JMS PUTSP
- TAD BLOC
- SNA CLA
- JMP NOKIND
- JMS GETTYP
- SNA
- JMP NOKIND
- DCA TEMP
- JMP I TEMP /BRANCH TO APPROPRIATE SUBROUTINE
-KINDRET,JMP I KIND
-
-/KIND SUBROUTINES
-/ENTER WITH BLOC POINTING TO HANDLER BLOCK IN CORE
-
- TABASE, 4040;4040 /0
- DEVICE PT8E /1
- DEVICE KS33 /2
- DEVICE 029 /3
- DEVICE 026 /4
- DEVICE LV8E /5
- DEVICE LPSV /6
- DEVICE L645 /7
-KTD8, DEVICE TD8 /10
-KTA8, DEVICE TA8 /11
- DEVICE AS33 /12
- DEVICE RK01 /13
- DEVICE RK05 /14
- DEVICE KL8E /15
- DEVICE XTRA /16
- TEXT / =1/ /17
- TEXT / =2/ /20
- TEXT / =3/ /21
- TEXT / =4/ /22
- DEVICE LQP /23
- UNIT, 0
- JMS PUTSP
- TAD BLOC
- SNA CLA
- JMP TSTSUN
- TAD UN
- SPA
- TAD (40+1-60
-ZOUN, TAD (60
- JMS PUTO
- JMP I UNIT
-
-TSTSUN, TAD I PDHRT
- TAD (-7607
- SZA CLA
- CLA IAC /ASSUME CORESIDENT HANDLERS ARE UNIT 1
- JMP ZOUN /ELSE, NO UNIT
- PAGE
- .ASECT TYPTAB,LEVEL=0
- FIELD 0
-
- *2000
-
-/ DEVICE LENGTH TABLE
-
-/FORMAT OF THIS TABLE:
-
-/1,2 DEVICE GENERALIZED NAME (CORR TO TYPE)
-/3 NEG OF LENGTH
-/4 ADDRESS OF SUBR IN FIELD 1 FOR SPECIALIZATION
-
-TYPTBL, DEVICE TTY ;0000;QTTY /0
- DEVICE PTR ;0000;QPTR /1
- DEVICE PTP ;0000;QPTP /2
- DEVICE CR8E;0000;QCR8E /3
- DEVICE LPTR;0000;QLPTR /4 V3D
- DEVICE RK8 ;1520;QRK8 /5
- DEVICE RF08;6001;PLAT1 /6 V3C
- DEVICE RF08;4002;PLAT2 /7
- DEVICE RF08;2003;PLAT3 /10
- DEVICE RF08;0004;PLAT4 /11 RF'S NOW ONLY HAVE LOGICALLY 1777 BLOCKS
- DEVICE DF32;7601;PLAT1 /12
- DEVICE DF32;7402;PLAT2 /13 V3C
- DEVICE DF32;7203;PLAT3 /14
- DEVICE DF32;7004;PLAT4 /15 DF'S HAVE 177 BLOCKS
- DEVICE TC08;6437;QTC08 /16
- DEVICE LINC;6437;QLINC /17
- DEVICE TM8E;0000;0 /20
- DEVICE TD8E;6437;QTD8E /21
- DEVICE BAT ;0000;0 /22
- DEVICE RK8E;1520;QRK8E /23
- DEVICE NULL;0000;0 /24
- DEVICE RX8E;7022;0 /25
- DEVICE RL01;-7761;RLSP /26
- DEVICE TA8E;0000;QTA8E /27
- DEVICE VR12;0000;0 /30
- DEVICE RL01;-3751;RLSPC /31
- DEVICE RX02;6044;0 /32
- DEVICE VXA0;7200;PLAT3 /33
- ZBLOCK 4 /34
- ZBLOCK 4 /35
- DEVICE DUMP;0000;0 /36
- ZBLOCK 4 /37
- ZBLOCK TYPTBL+400-.
- PAGE
-
DELETED src/os8-v3f/RESOV2.MA
Index: src/os8-v3f/RESOV2.MA
==================================================================
--- src/os8-v3f/RESOV2.MA
+++ /dev/null
@@ -1,236 +0,0 @@
-/1
- .EXTERNAL PRINT,FREEDV,READI,CRLF,OPRINT,DPRINT
- .EXTERNAL SLOTAB
- .ENTRY DIRT,ZEROSL,CNTSLT
-
- FAST=20
- EXTEN=22
-
- X0=10
-
- .MACRO .PRINT ARG
- JMS I (PRINT
- TEXT "ARG"
- .ENDM
- .RSECT OV2,LEVEL=1,OVERLAY=2
- FIELD 1
-
- .NOLIST ME,MEB
-
-DIRT, 0
- JMS I (READI
- 1400 /READ 6 BLOCKS
- 4000 /INTO 04000
- 1 /FROM BLOCK 1
- JMS I (DVALID /CHECK IF VALID DIRECTORY
- TAD FAST
- SNA CLA
- JMP I DIRT /NO DIRECT IN FAST MODE
- JMS I (CRLF
- DCA USED
- DCA UNUSED
- DCA NFILES
- DCA NMTS
- DCA NSEGS
- STL CLA RAR /4000
-LUP$: DCA DIRPTR
- ISZ NSEGS
- JMS GETDIR
- DCA NENTRY /- NO. OF ENTRIES IN SEGMENT
- JMS GETDIR
- DCA STBLK /STARTING BLOCK # OF FIRST FILE IN SEGMENT
- JMS GETDIR
- DCA LINK /LINK TO NEXT SEGMENT
- JMS GETDIR
- CLA /IGNORE FLAG WORD TO TENTATIVE FILE
- JMS GETDIR
- DCA AIW /# OF ADDITIONAL INFO WORDS
- TAD NENTRY
- DCA DKNT
-L$: JMS GETDIR
- SNA CLA
- JMP MT$ /AN EMPTY ENTRY
- TAD AIW
- CIA
- TAD (3
- TAD DIRPTR
- DCA DIRPTR /POINT TO FILE LENGTH
- JMS GETDIR /GET NEG OF NUMBER OF BLOCKS IN FILE
- SNA
- JMP 2$ /A TENTATIVE FILE, IGNORE
- CIA
- TAD USED
- DCA USED
- ISZ NFILES
- JMP 2$
-MT$: JMS GETDIR
- CIA
- TAD UNUSED
- DCA UNUSED
- ISZ NMTS
-2$: ISZ DKNT /ANY MORE ENTRIES IN THIS SEGMENT?
- JMP L$ /YES
- TAD LINK
- SNA CLA
- JMP 3$
- TAD NSEGS
- CMA
- TAD LINK /ASSUME LINKS ARE IN ORDER
- SZA CLA
- JMP I (BADDIR
- STA /GO TO NEXT SEGMENT
- TAD DIRPTR
- AND (7400
- TAD (400
- JMP LUP$
-
-3$: JMS I (PRINFO
-LVDIR, JMS I (CRLF
- JMS I (CRLF
- JMP I DIRT
- DKNT, 0
-USED, 0 /NO. OF BLOCKS USED
-UNUSED, 0 /# OF UNUSED BLOCKS ON DEVICE
-NFILES, 0 /# OF FILES
-NMTS, 0 /# OF EMPTIES
-NSEGS, 0 /# OF DIRECTORY SEGMENTS USED
-
-NENTRY, 0 /- # OF ENTRIES IN SEGMENT
-STBLK, 0 /STARTING BLOCK # OF FIRST FILE IN SEGMENT
-LINK, 0 /LINK TO NEXT SEGMENT
-AIW, 0 /# OF ADDITIOANAL INFORMATION WORDS
-
-GETDIR, 0
- CDF 0
- TAD I DIRPTR
- CDF 10
- ISZ DIRPTR
- JMP I GETDIR
-
-DIRPTR, 0
- PAGE
- PRINFO, 0
- TAD EXTEN
- SNA CLA
- JMP 2$ /JUST # OF FREE BLOCKS UNLESS /E
- TAD I (NFILES
- SNA
- JMP 2$
- STL
- JMS I (DPRINT
- .PRINT " FILES IN "
- TAD I (USED
- STL
- JMS I (DPRINT
- .PRINT " BLOCKS"
- STA
- TAD I (NSEGS
- SNA CLA
- JMP 1$
- .PRINT " USING "
- TAD I (NSEGS
- STL
- JMS I (DPRINT
- .PRINT " SEGMENTS"
-1$: JMS I (CRLF
-2$: TAD I (UNUSED
- STL
- JMS I (DPRINT
- .PRINT " FREE BLOCKS"
- TAD EXTEN
- SNA CLA
- JMP I PRINFO
- TAD I (NMTS
- CLL RAR
- SNA CLA
- JMP 3$
- .PRINT " ("
- TAD I (NMTS
- STL
- JMS I (DPRINT
- .PRINT " EMPTIES)"
-3$: CLA IAC
- TAD I (AIW
- SZA CLA
- JMS PRAIW
- JMP I PRINFO
-
-PRAIW, 0
- JMS I (CRLF
- TAD I (AIW
- CIA
- STL
- JMS I (DPRINT
- .PRINT " EXTRA INFO WDS"
- JMP I PRAIW
- PAGE
- DVALID, 0
- STL CLA RAR /4000
- DCA I (DIRPTR
- JMS I (GETDIR
- CLL
- TAD (200
- SNL CLA
- JMP BADDIR
- JMS I (GETDIR
- SNA
- JMP BADDIR
- TAD (-400 /REMEMBER COS
- SMA CLA
- JMP BADDIR
- JMS I (GETDIR
- CLA /LINKS THOROUGHLY CHECKED ELSEWHERE
- JMS I (GETDIR
- SNA
- JMP OKDIR
- TAD (-1400
- CLL
- TAD (-1000
- SZL CLA
- JMP BADDIR
-OKDIR, JMS I (GETDIR
- SPA SNA CLA
- JMP I DVALID
-BADDIR, .PRINT "?BAD DIRECTORY"
- JMP I (LVDIR
- SLTM, 0
-
-SLKNT,
-ZEROSL, 0
- TAD (-10
- DCA SLTM
- TAD (SLOTAB-1
- DCA X0
- DCA I X0
- ISZ SLTM
- JMP .-2
- JMP I ZEROSL
-
-CNTSLT, 0
- TAD (-10
- DCA SLTM
- DCA SLKNT
- TAD (SLOTAB-1
- DCA X0
-L$: TAD I X0
- SNA CLA
- ISZ SLKNT
- ISZ SLTM
- JMP L$
- .PRINT "FREE DEVICE SLOTS: "
- TAD I (FREEDV
- JMS XPRINT
- .PRINT ", FREE BLOCK SLOTS: "
- TAD SLKNT
- JMS XPRINT
- JMS I (CRLF
- JMP I CNTSLT
- XPRINT, 0
- SNA
- JMP 1$
- JMS I (OPRINT
- JMP I XPRINT
-
-1$: .PRINT "NONE"
- JMP I XPRINT
- PAGE
DELETED src/os8-v3f/RESOVD.MA
Index: src/os8-v3f/RESOVD.MA
==================================================================
--- src/os8-v3f/RESOVD.MA
+++ /dev/null
@@ -1,267 +0,0 @@
-/OVRDRV - OVERLAY DRIVER FOR RESORC
-/ASSUMES EVERYTHING IS IN FIELD 1
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977,1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-
-/OVERLAY DRIVER
-/FOR LINKER PROGRAM MODULES
-/V1B
-
-
-/THIS SECT IS TWO LOCATIONS AND CONTAINS THE TRANSFER VECTOR TO SWAPER
-/AND A FLAG THAT INDICATES WHETHER A JMP (1) OR JMS (0) WAS PERFORMED
-/TO THE TRANSFER VECTOR
-
- .GLOBAL XFERV
-
-/THIS IS THE MAIN DRIVER SECTION
-
- .SECT SWAPER,R
- .GLOBAL SWPTAB
-
- FIELD 1
-
-SWAP, 6102 /VERSION NUMBER
- DCA AC /SAVE CALLING AC
- RAL
- DCA LINK /AND LINK
- RDF /GET CALLING DF
- TAD (CDF /FORM CDF
-SWAP0, JMP ONCE /DO ONCE ONLY CODE - REPLACED BY DCA EXIT
- CDF . /CHANGE TO THIS DATA FIELD
- TAD I SWAP /GET OVERLAY,LEVEL,FIELD
- DCA BINDAT /SAVE
- ISZ SWAP /BUMP POINTER
- TAD I SWAP /GET SUBROUTINE ADDRESS
- DCA XITLOC /SAVE
- TAD BINDAT /FORM CDF TO CALLED SUBROUTINE
- AND (7
- RAL CLL
- RTL
- TAD (CDF
- DCA SWAP1A /SAVE
- TAD SWAP1A /FORM CIF TO CALLED SUBROUTINE
- IAC
- DCA EXIT+1 /SAVE FOR EXIT
- /LOAD OVERLAY OF CALLED SUBROUTINE
-
-LOAD, TAD BINDAT
- AND (1600 /EXTRACT LEVEL OF CALLED SUBROUTINE
- RTR CLL /5 RIGHT
- RTR
- RAR
- DCA PNTR /SAVE
- TAD PNTR
- TAD (SWPTAB /COMPUTE ENTRY INTO SWAP TABLE
- DCA FLD /POINTS TO FIELD OF OVERLAY
- TAD PNTR /COMPUTE ENTRY INTO CURRENT OVERLAY TABLE
- RTR CLL
- TAD (CURTAB
- DCA PNTR
- TAD BINDAT /EXTRACT DESIRED OVERLAY NUMBER
- AND (170
- RTR CLL /RIGHT 3
- RAR
- CIA /NEGATE
- DCA TEMP
- TAD TEMP
- TAD I PNTR /COMPARE WITH CURRENT OVERLAY NUMBER FOR LEVEL
- SNA CLA /SAME?
- JMP SWAP1 /YES, NO READING NEEDED
-LOAD1, TAD TEMP /NO, SET TO NEW
- CIA
- DCA I PNTR /OVERLAY NUMBER
- TAD FLD /SET UP POINTERS TO
- IAC
- DCA ADDRES /ADDRESS
- TAD ADDRES
- IAC
- DCA RELBLK /RELATIVE BLOCK NUMBER
- TAD RELBLK
- IAC
- DCA LENGTH /LENGTH OF OVERLAY
- TAD TEMP /TEST OVERLAY NUMBER
- SNA CLA /0?
- JMP LOAD2 /YES, NO MULTIPLICATION NEEDED
- TAD I LENGTH /BLOCK NUMBER = (LENGTH OF OVERLAY)
- JMP I .+1 /TIMES (THE NUMBER OF THE OVERLAY)
- PATCH
-LOAD2, TAD I RELBLK /PLUS (RELATIVE BLOCK OF LEVEL)
- TAD STRBLK /PLUS (STARTING BLOCK OF PROGRAM)
- DCA REDBLK /SAVE IN CALL LOCATION
- TAD I ADDRES /GET ADDRESS TO LOAD
- DCA REDADD /SAVE IN CALL LOCATION
- TAD I FLD /GET FIELD
- AND (7 /MASK
- RTR CLL
- RAR /POSITION
- TAD I LENGTH /GET LENGTH
- RTL
- RTL
- RTL
- DCA REDCNT /FORM CONTROL WORD
- CIF 0
- JMS I (7607 /CALL SYSTEM HANDLER TO READ IN OVERLAY
-REDCNT, 7756 /FUNCTION CONTROL WORD (POINTS TO MREAD-1 FOR "ONCE"
-REDADD, -7607 /BUFFER ADDRESS (CONTAINS SYS: ENTRY POINT FOR "ONCE"
-REDBLK, 0 /STARTING BLOCK NUMBER
- HLT /ERROR RETURN ADDRESS
-
-SWAP1, TAD XFERV /GET JMP-JMS FLAG
- SZA CLA /SET?
- JMP SWAP2 /YES, EXECUTE A JMP
- CLA CLL CMA RTL /-3
- TAD SWAP /BACK UP TO CALLER'S PC
- DCA SWAP
- TAD I SWAP
-SWAP1A, 0 /CDF TO CALLED SUBROUTINE
- DCA I XITLOC /SAVE IN CALLED SUBROUTINE
- ISZ XITLOC /BUMP TRANSFER ADDRESS
-/** CDF .
- TAD (ISZ XFERV
- DCA I SWAP /SET BACK UP ENTRY IN XFER VECTOR TABLE
-SWAP2, DCA XFERV /CLEAR FLAG
- TAD LINK /RESTORE LINK AND AC
- RAR CLL
- TAD AC
-EXIT, 0 /SET DF TO CALLING FIELD
- 0 /SET IF TO CALLED FIELD
- JMP I XITLOC /GO TO CALLED SUBROUTINE
-
- /VARIABLE LOCATIONS
-/SOME OF THE FOLLOWING LOCATIONS CONTAIN
-/ONCE ONLY CODE TO SET UP STARTING BLOCK
-/AND CHECK THAT FILE CAME FROM SYS:
-CURTAB=. /CURRENT OVERLAY IN LEVEL TABLE (8 ENTRIES)
-STRBLK=. /ENTRY 0 IS USED TO HOLD STARTING BLOCK OF FILE
-ONCE, DCA EXIT /SAVE CALLING FIELD
- /ALSO ENTRY 0
- TAD .-1 /SET UP SO WON'T BE EXECUTED AGAIN
- /ALSO ENTRY 1
- DCA SWAP0
- /ALSO ENTRY 2
- CDF 0
- /ALSO ENTRY 3
- TAD I FLD /GET STARTING BLOCK FROM "SOFSET"
- /ALSO ENTRY 4
- SNA
- /ALSO ENTRY 5
- HLT /ERROR, K.M. PATCHES NOT IN
- /ALSO ENTRY 6
- DCA STRBLK /SAVE
- /ALSO ENTRY 7
- TAD I REDCNT /CHECK FILE CAME FROM SYS:
- TAD REDADD
-
-BINDAT, /CONTAINS OVERLAY,LEVEL,FIELD OF DESIRED SUBROUTINE
- SNA CLA /FROM SYS: ?
-XITLOC, /CONTAINS LOCATION TO GO TO IN DESIRED SUBROUTINE
- JMP SWAP0+1 /YES, OK
-PNTR, /POINTS INTO CURTAB
- HLT /NO, ERROR
-TEMP, /TEMP STORAGE
- JMP .-1 /DON'T ALLOW CONTINUE
-FLD, /POINTS TO FIELD WORD IN SWPTAB
- 7747 /POINTER TO "SOFSET"
-
-ADDRES=REDADD /POINTS TO ADDRESS WORD IN SWPTAB
-RELBLK=REDBLK /POINTS TO RELATIVE BLOCK WORD IN SWPTAB
-LENGTH=REDCNT /POINTS TO LENGTH WORD IN SWPTAB
-
-AC, 0 /SAVED AC
-LINK, 0 /SAVED LINK
-
- PAGE
-
-/PATCH TO FIX BLOCK POSITION CALCULATION
-PATCH, IAC /CONVERT PAGES TO BLOCKS
- CLL RAR
- DCA PTEMP
- TAD PTEMP /MULTIPLY BLOCK LENGTH
- ISZ I PPNT /BY OVERLAY NUMBER
- JMP .-2
- JMP I .+1
- LOAD2
-PPNT, TEMP
-PTEMP, 0
-
-
-
-/THIS AREA CONTAINS OVERLAY DATA FOR MAIN AND THE 7 LEVELS
-/THE FORMAT OF EACH ENTRY IS:
-/WORD1: FIELD OF LEVEL
-/WORD2: ADDRESS OF LEVEL
-/WORD3: RELATIVE BLOCK OF 1ST OVERLAY IN LEVEL
-/WORD4: LENGTH OF THE LEVEL (ANY AND ALL OVERLAYS-EACH)
-/ (ALL OVERLAYS IN A LEVEL ARE THE SAME LENGTH)
-
-SWPTAB,
-
- *.+40
-
-/THIS AREA CONTAINS THE TRANSFER VECTORS FOR EACH ENTRY POINT
-/IN ALL THE OVERLAYS IN ALL THE LEVELS
-/ITS SIZE SHOULD BE MODIFIED BY THE USER
-/TO FIT THE MAXIMUM NUMBER OF TRANSFER VECTORS NEEDED
-/EACH TRANSFER VECTOR OCCUPIES 4 LOCATIONS
-/THE TABLE IS INITIALLY SET UP FOR 24(DEC) (30(OCT)) VECTORS
-/THE MAXIMUM SIZE THIS TABLE CAN BE IS 3774 (OCT) LOCATIONS FOR
-/511 (DEC) (777 (OCT)) VECTORS
-/THE FORMAT OF EACH VECTOR ENTRY IS:
-/WORD1: ISZ XFERV
-/WORD2: JMS I XFERV+1
-/WORD3: LEVEL/OVERLAY/FIELD
-/WORD4: ADDRESS
-
- .FSECT TRANVC
- FIELD SWAPER
-
- SIZE=14 /MODIFY THIS LINE TO CHANGE THE SIZE OF THE TABLE
-
- *SIZE^4
-
-XFERV, 0
- SWAPER
-
-
DELETED src/os8-v3f/RL0.PA
Index: src/os8-v3f/RL0.PA
==================================================================
--- src/os8-v3f/RL0.PA
+++ /dev/null
@@ -1,460 +0,0 @@
-/RL0: RL01 DRIVE 0 NON-SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DRIVE 0 NON-SYSTEM HANDLER
-
- VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/13-OCT-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
-
-/BAD BLOCK LIST FORMAT:
-/WORD CONTENTS
-/0 ID (IDENTIFICATION CODE)
-/1 BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
-/... ...
-/20 0 (TERMINATOR FOR LIST A)
-/21 BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
-/... ...
-/40 0 (TERMINATOR FOR LIST B)
-
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -2 /- NR DEVICES PER HANDLER
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/0 GROUP NAME (4 CHAR)
-/2 DEVICE NAME (4 CHAR)
-/4 DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
-/5 OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
-/6 0 (UNUSED WORD)
-/7 0 TO REPRESENT NON-SYSTEM DEVICE
-
- DRIVE=0
-
-DEVICE RL0;DEVICE RL0A;4260;RLA&177+4000;0;0
-DEVICE RL0;DEVICE RL0B;4260;RLB&177+4000;0;0
- /HANDLER CODE
- *200 /FIRST PAGE
-
-/DATA
-
-A17, 17
-A47, 47
-A175, 175
-A200, 200
-A377, 377
-A7751, 7751
-BASE, TAD BBL+1
-ABLOCK, BLOCK-MAIN
-AMA, MA-MAIN /RELATIVE ADDR OF MA
-ASECT, SECTOR-MAIN
-ATRACK, TRACK-MAIN
-AERROR, ERROR-MAIN
-
-/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
-SET, TAD OFFSET /INITIALIZE MAPPING (BELOW)
- BSW
- CLL RTL /(0 OR 20: DEVICE A OR B)
- TAD BASE
- DCA MAP
- TAD RLB /ADDR OF ARGS
- JMS I GO /SETUP (AC NON-ZERO)
-/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
-MAP, TAD /INITIALIZED ABOVE
- SNA /0 TERMINATES LIST
- JMP MAPPED
- STL CIA /13-BIT NEGATE
- TAD I ABLOCK /COMPARE WITH BLOCK
- SZL CLA
- JMP MAPPED /BAD BLOCK IS ABOVE CURRENT BLOCK
- ISZ MAP /TRY NEXT BAD BLOCK ALSO
-NEXT, ISZ I ABLOCK /INCREMENT CURRENT BLOCK NUMBER,
- /EITHER DURING
- /BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
- /OF TWO SECTORS (PAGES) WITH MORE TO GO
- JMP MAP /CONTINUE MAPPING
- JMP I AERROR /ERROR ON BLOCK OVERFLOW
- ZBLOCK 240+DRIVE-. /UNUSED
-
-/ENTRY POINT FOR DEVICE B
-
-RLB, VERSION
- AC0004 /TRACK OFFSET WILL BE 400
- JMP START /SKIP AROUND RLA ENTRY POINT
-OFFSET, 0 /TRACK OFFSET FOR DEVICE (0 OR 400)
-
-/ENTRY POINT FOR DEVICE A
-
-RLA, VERSION
-A7600, 7600 /=CLA
- TAD RLA /TRANSFER CALLING ADDR
- DCA RLB
-START, BSW /SET OFFSET TO 0 IF DEV A, 400 IF DEV B
- DCA OFFSET
- TAD A7600 /RETURN TO KEYBOARD MONITOR
- KRS /IF CTRL,C TYPED
- TAD A175 /-CTRL,C
- SNA CLA
- KSF
-ONCE, JMP ONLY /THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
- /THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
- /IS DONE AND THE BAD BLOCK LIST IS READ IN.
-ACDIF, CIF CDF 00
- JMP I A7600 /CALL KB MONITOR
-/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
-GO, 0 /ADDR OF MAIN
-/-----BOUNDARY OF BAD BLOCK LIST-----
-BBL,
-/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
-/READ IN BAD BLOCK LIST (BBL)
-/SAVE CALLING DATA FIELD
- RDF
- TAD OOCDF
- DCA BACK
-OOCDF, CDF 00 /SET TO CURRENT FIELD
-/REPLACE ONCE-ONLY JUMP INSTRUCTION
- TAD JMPSET
- DCA ONCE
-LOOP, TAD LIST /RELOCATE CROSS-PAGE REFERENCES;
- /SCAN "LIST" FOR RELATIVE LOCATIONS
- /OF VALUES TO BE RELOCATED
- SNA /0 ACTS AS TERMINATOR
- JMP OUT
- TAD GO /RELOCATE RELATIVE ADDRESS
- DCA ONLY /"ONLY" IS NOW TEMP STORAGE
- ISZ LOOP /NEXT VALUE
- TAD GO
- TAD I ONLY /RELOCATE THE CONTENTS
- DCA I ONLY
- JMP LOOP /CONTINUE UNTIL DONE
-
-/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES
-
-LIST, BARG-MAIN
- ABLOCK-MAIN
- BBBL-MAIN
- AMA-MAIN
- ASECT-MAIN
- ATRACK-MAIN
- MA-MAIN
- AERROR-MAIN
- 0 /TERMINATOR
-
- ZBLOCK BBL+40-. /UNUSED (IN BBL BUFFER)
-
-/ONCE-ONLY CODE CONTINUES
-OUT, JMS I GO /READ BAD BLOCK LIST
-/-----BOUNDARY OF BAD BLOCK LIST-----
-OK, CLA /ERROR RETURN (IGNORE)
-BACK, CDF /RESTORE CALLING FIELD
-JMPSET, JMP SET /SETUP FOR TRANSFER
-
-/END OF ONCE-ONLY CODE
- /SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
-/CALCULATE TRACK AND SECTOR FROM BLOCK
-MAPPED, TAD I ABLOCK
- RTR
- RTR
- AND A377
- TAD OFFSET /DEVICE OFFSET (0 OR 400)
- DCA I ATRACK
- TAD I ABLOCK /CALCULATE SECTOR FROM BLOCK
- AND A17 /SECTOR CODE
- CLL RTL
- TAD A7751
- SPA
- TAD A47
- BSW
- DCA I ASECT
-/TRANSFER 1ST PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/INCREMENT SECTOR
- TAD A200
- TAD I ASECT
- DCA I ASECT
-/TRANSFER 2ND PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/CONTINUE WITH NEXT BLOCK
- JMP NEXT
-
-/ONCE-ONLY CODE AT END OF PAGE
- ZBLOCK 377-. /UNUSED
-ONLY, JMS GO /EXECUTED ONCE ONLY; STORES ADDR OF
- /2ND PAGE IN LOC "GO"
- *400
-/2ND PAGE OF HANDLER
-
-/SUBROUTINE TO SETUP AND TRANSFER
-/AC=0 FOR TRANSFER ELSE SETUP
-MAIN, 0
- SNA
- JMP TRANS
-/GET HANDLER ARGUMENTS
-SETUP, DCA BARG /ADDR OF HANDLER ARGS
- AC2000 /SET "OLDTRK" TO INVALID TRACK
- DCA OLDTRK /TO FORCE READING NEXT HEADER.
- TAD B7600 /SET FOR FULL PAGE TRANSFERS
- DCA WC /(WAS SMALLER FOR BBL READ)
- TAD I BARG /NOW GET HANDLER ARGUMENTS
- /FUNCTION WORD
-/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
-B377, AND B4070 /CONVERT TO RLCB FORMAT
- SPA
- TAD B3777
- TAD BRLRD
- DCA FNC
- TAD I BARG /FUNCTION WORD
- RAL /CONVERT TO PAGE COUNT IN BITS [7600]
- AND B7600
- DCA PAGES
- ISZ BARG
- TAD I BARG /MA
- DCA MA
- ISZ BARG
- TAD I BARG /BLOCK
- DCA BLOCK
- ISZ BARG
-/SAVE CALLING FIELD FOR RETURN
- RDF
- TAD BCDIF
- DCA BRTN
-/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
-BCDIF, CIF CDF 00
-/GET DEVICE OFFSET FROM 1ST PAGE
- TAD I BBBL /CHECK FOR BBL VALIDITY -
- TAD CHECK /1ST LOC OF BBL CONTAINS AN
- SZA CLA /IDENTIFICATION CODE ("ID")
- JMP ERROR /TAKE ERROR RETURN FROM HANDLER
- /IF BBL IS INVALID.
- JMP I MAIN
- /TRANSFER ONE OR MORE PAGES TO/FROM DISK
-/GET INTERPAGE ARGUMENTS
-/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
-TRANS, AC7775 /AC=-3
- DCA ERRCNT
-/CALCULATE CYLINDER AND SURFACE FROM TRACK
- TAD TRACK
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/RESET DRIVE (FUNCTION=1)
-RETRY, RLDC /CLEAR CONTROLLER, AC
-/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
-SEEK, IAC /AC=(1 OR 3)
- JMS IO /RESET DRIVE OR SEEK
-/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
- TAD HEADER
- JMS IO /READ NEXT HEADER
- RRSI /GET HEADER BYTE #1
- BSW
- AND B3
- DCA OLDTRK /SAVE 2 LSB
- RRSI /GET HEADER BYTE #2
- AND B377 /HARDWARE SHOULD DO THIS
- CLL RTL
- TAD OLDTRK /ADD IN MSB
- DCA OLDTRK
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
- SPA /IF POSITIVE, LINK WILL BE SET
- CLL CIA /IF NEGATIVE, CLEAR LINK
- RAR /DELETE SURFACE, INCLUDE DIRECTION
- TAD SURF /ADD SURFACE
- RLCA /LOAD DIFFERENCE WORD
- AC0002 /PREPARE FOR SEEK
-/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
-/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
-/SEEK UNRELIABILITY
- JMP SEEK
- /SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
-/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
-/REQUESTED-OLD, AND LINK=1
-TRKCMP, 0
- TAD OLDTRK /CALCULATE DIFFERENCE
- CIA
- TAD TRACK
- STL /LINK MUST BE SET WHEN
- /DIFFERENCE IS POSITIVE.
- SZA
- JMP I TRKCMP /DIFFERENT; RETURN
-/ON TRACK: DO TRANSFER
-/LOAD ALL REGISTERS
- TAD SECTOR
- RLSA
- TAD WC
- RLWC
- TAD SURF
- TAD CYL
- RLCA
- TAD MA
- RLMA
-/DO THE READ OR WRITE
- TAD FNC
- JMS IO
-/COUNT REQUESTED NUMBER OF PAGES
- TAD B7600
- TAD PAGES
- SNA
- JMP DONE
- DCA PAGES
- JMP I MAIN /RETURN FOR MORE
- /SUBROUTINE TO DO THE ACTUAL I/O
-IO, 0 /AC=MODE,FIELD,FUNCTION
- TAD BDRIVE
- RLCB /DO THE OPERATION
- RLSD /WAIT UNTIL DONE
- JMP .-1
- RLSE /TEST FOR I/O ERROR(S)
- JMP I IO /NONE; RETURN
-/IF ERROR, RETRY TWICE
- ISZ ERRCNT /MORE RETRIES LEFT?
- JMP RETRY /YES
-/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
-/WITH AC=4000
-ERROR, AC4000
- SKP
-/NORMAL RETURN FROM HANDLER
-DONE, ISZ BARG /SKIP ERROR RETURN
-BRTN, CIF CDF 00 /RETURN TO CALLING FIELD
- /BBL READ: NOP (FIELD 0)
- JMP I BARG /RETURN TO CALLING PROGRAM
- /DATA
-BLOCK, 0
-TRACK, 0 /BBL READ: TRACK 0
-WC, -41 /BBL READ: -BBL LENGTH
-SECTOR, 1400 /BBL READ: SECTOR 14
-CYL, 0
-SURF, 0
-ERRCNT, 0 /COUNT OF RETRIES
-OLDTRK, 2000 /FORCE INITIAL SEEK
-PAGES, 200 /BBL READ: ONE PAGE
-FNC, RLRD /BBL READ: READ FUNCTION
-
-/RELOCATED RELATIVE ADDRESSES
-BARG, OK-MAIN /BBL READ: RETURN FROM READ
- /ADDRESS OF HANDLER ARGUMENTS
-MA, BBL-MAIN /BBL READ: ADDR OF BBL
-BBBL, BBL-MAIN
-
-B3, 3
-B3777, 3777
-B7600, 7600
-BRLRD, RLRD
-HEADER, BYTE RLRH
-BDRIVE, DRIVE^100 /DRIVE BITS FOR RLCB
-CHECK, -ID
-
-/THIS CONSTANT MUST BE AT END OF PAGE
- ZBLOCK 577-.
-B4070, 4070
-$
DELETED src/os8-v3f/RL1.PA
Index: src/os8-v3f/RL1.PA
==================================================================
--- src/os8-v3f/RL1.PA
+++ /dev/null
@@ -1,460 +0,0 @@
-/RL1: RL01 DRIVE 1 NON-SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DRIVE 1 NON-SYSTEM HANDLER
-
- VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/13-OCT-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
-
-/BAD BLOCK LIST FORMAT:
-/WORD CONTENTS
-/0 ID (IDENTIFICATION CODE)
-/1 BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
-/... ...
-/20 0 (TERMINATOR FOR LIST A)
-/21 BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
-/... ...
-/40 0 (TERMINATOR FOR LIST B)
-
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -2 /- NR DEVICES PER HANDLER
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/0 GROUP NAME (4 CHAR)
-/2 DEVICE NAME (4 CHAR)
-/4 DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
-/5 OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
-/6 0 (UNUSED WORD)
-/7 0 TO REPRESENT NON-SYSTEM DEVICE
-
- DRIVE=1
-
-DEVICE RL1;DEVICE RL1A;4260;RLA&177+4000;0;0
-DEVICE RL1;DEVICE RL1B;4260;RLB&177+4000;0;0
- /HANDLER CODE
- *200 /FIRST PAGE
-
-/DATA
-
-A17, 17
-A47, 47
-A175, 175
-A200, 200
-A377, 377
-A7751, 7751
-BASE, TAD BBL+1
-ABLOCK, BLOCK-MAIN
-AMA, MA-MAIN /RELATIVE ADDR OF MA
-ASECT, SECTOR-MAIN
-ATRACK, TRACK-MAIN
-AERROR, ERROR-MAIN
-
-/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
-SET, TAD OFFSET /INITIALIZE MAPPING (BELOW)
- BSW
- CLL RTL /(0 OR 20: DEVICE A OR B)
- TAD BASE
- DCA MAP
- TAD RLB /ADDR OF ARGS
- JMS I GO /SETUP (AC NON-ZERO)
-/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
-MAP, TAD /INITIALIZED ABOVE
- SNA /0 TERMINATES LIST
- JMP MAPPED
- STL CIA /13-BIT NEGATE
- TAD I ABLOCK /COMPARE WITH BLOCK
- SZL CLA
- JMP MAPPED /BAD BLOCK IS ABOVE CURRENT BLOCK
- ISZ MAP /TRY NEXT BAD BLOCK ALSO
-NEXT, ISZ I ABLOCK /INCREMENT CURRENT BLOCK NUMBER,
- /EITHER DURING
- /BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
- /OF TWO SECTORS (PAGES) WITH MORE TO GO
- JMP MAP /CONTINUE MAPPING
- JMP I AERROR /ERROR ON BLOCK OVERFLOW
- ZBLOCK 240+DRIVE-. /UNUSED
-
-/ENTRY POINT FOR DEVICE B
-
-RLB, VERSION
- AC0004 /TRACK OFFSET WILL BE 400
- JMP START /SKIP AROUND RLA ENTRY POINT
-OFFSET, 0 /TRACK OFFSET FOR DEVICE (0 OR 400)
-
-/ENTRY POINT FOR DEVICE A
-
-RLA, VERSION
-A7600, 7600 /=CLA
- TAD RLA /TRANSFER CALLING ADDR
- DCA RLB
-START, BSW /SET OFFSET TO 0 IF DEV A, 400 IF DEV B
- DCA OFFSET
- TAD A7600 /RETURN TO KEYBOARD MONITOR
- KRS /IF CTRL,C TYPED
- TAD A175 /-CTRL,C
- SNA CLA
- KSF
-ONCE, JMP ONLY /THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
- /THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
- /IS DONE AND THE BAD BLOCK LIST IS READ IN.
-ACDIF, CIF CDF 00
- JMP I A7600 /CALL KB MONITOR
-/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
-GO, 0 /ADDR OF MAIN
-/-----BOUNDARY OF BAD BLOCK LIST-----
-BBL,
-/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
-/READ IN BAD BLOCK LIST (BBL)
-/SAVE CALLING DATA FIELD
- RDF
- TAD OOCDF
- DCA BACK
-OOCDF, CDF 00 /SET TO CURRENT FIELD
-/REPLACE ONCE-ONLY JUMP INSTRUCTION
- TAD JMPSET
- DCA ONCE
-LOOP, TAD LIST /RELOCATE CROSS-PAGE REFERENCES;
- /SCAN "LIST" FOR RELATIVE LOCATIONS
- /OF VALUES TO BE RELOCATED
- SNA /0 ACTS AS TERMINATOR
- JMP OUT
- TAD GO /RELOCATE RELATIVE ADDRESS
- DCA ONLY /"ONLY" IS NOW TEMP STORAGE
- ISZ LOOP /NEXT VALUE
- TAD GO
- TAD I ONLY /RELOCATE THE CONTENTS
- DCA I ONLY
- JMP LOOP /CONTINUE UNTIL DONE
-
-/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES
-
-LIST, BARG-MAIN
- ABLOCK-MAIN
- BBBL-MAIN
- AMA-MAIN
- ASECT-MAIN
- ATRACK-MAIN
- MA-MAIN
- AERROR-MAIN
- 0 /TERMINATOR
-
- ZBLOCK BBL+40-. /UNUSED (IN BBL BUFFER)
-
-/ONCE-ONLY CODE CONTINUES
-OUT, JMS I GO /READ BAD BLOCK LIST
-/-----BOUNDARY OF BAD BLOCK LIST-----
-OK, CLA /ERROR RETURN (IGNORE)
-BACK, CDF /RESTORE CALLING FIELD
-JMPSET, JMP SET /SETUP FOR TRANSFER
-
-/END OF ONCE-ONLY CODE
- /SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
-/CALCULATE TRACK AND SECTOR FROM BLOCK
-MAPPED, TAD I ABLOCK
- RTR
- RTR
- AND A377
- TAD OFFSET /DEVICE OFFSET (0 OR 400)
- DCA I ATRACK
- TAD I ABLOCK /CALCULATE SECTOR FROM BLOCK
- AND A17 /SECTOR CODE
- CLL RTL
- TAD A7751
- SPA
- TAD A47
- BSW
- DCA I ASECT
-/TRANSFER 1ST PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/INCREMENT SECTOR
- TAD A200
- TAD I ASECT
- DCA I ASECT
-/TRANSFER 2ND PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/CONTINUE WITH NEXT BLOCK
- JMP NEXT
-
-/ONCE-ONLY CODE AT END OF PAGE
- ZBLOCK 377-. /UNUSED
-ONLY, JMS GO /EXECUTED ONCE ONLY; STORES ADDR OF
- /2ND PAGE IN LOC "GO"
- *400
-/2ND PAGE OF HANDLER
-
-/SUBROUTINE TO SETUP AND TRANSFER
-/AC=0 FOR TRANSFER ELSE SETUP
-MAIN, 0
- SNA
- JMP TRANS
-/GET HANDLER ARGUMENTS
-SETUP, DCA BARG /ADDR OF HANDLER ARGS
- AC2000 /SET "OLDTRK" TO INVALID TRACK
- DCA OLDTRK /TO FORCE READING NEXT HEADER.
- TAD B7600 /SET FOR FULL PAGE TRANSFERS
- DCA WC /(WAS SMALLER FOR BBL READ)
- TAD I BARG /NOW GET HANDLER ARGUMENTS
- /FUNCTION WORD
-/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
-B377, AND B4070 /CONVERT TO RLCB FORMAT
- SPA
- TAD B3777
- TAD BRLRD
- DCA FNC
- TAD I BARG /FUNCTION WORD
- RAL /CONVERT TO PAGE COUNT IN BITS [7600]
- AND B7600
- DCA PAGES
- ISZ BARG
- TAD I BARG /MA
- DCA MA
- ISZ BARG
- TAD I BARG /BLOCK
- DCA BLOCK
- ISZ BARG
-/SAVE CALLING FIELD FOR RETURN
- RDF
- TAD BCDIF
- DCA BRTN
-/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
-BCDIF, CIF CDF 00
-/GET DEVICE OFFSET FROM 1ST PAGE
- TAD I BBBL /CHECK FOR BBL VALIDITY -
- TAD CHECK /1ST LOC OF BBL CONTAINS AN
- SZA CLA /IDENTIFICATION CODE ("ID")
- JMP ERROR /TAKE ERROR RETURN FROM HANDLER
- /IF BBL IS INVALID.
- JMP I MAIN
- /TRANSFER ONE OR MORE PAGES TO/FROM DISK
-/GET INTERPAGE ARGUMENTS
-/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
-TRANS, AC7775 /AC=-3
- DCA ERRCNT
-/CALCULATE CYLINDER AND SURFACE FROM TRACK
- TAD TRACK
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/RESET DRIVE (FUNCTION=1)
-RETRY, RLDC /CLEAR CONTROLLER, AC
-/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
-SEEK, IAC /AC=(1 OR 3)
- JMS IO /RESET DRIVE OR SEEK
-/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
- TAD HEADER
- JMS IO /READ NEXT HEADER
- RRSI /GET HEADER BYTE #1
- BSW
- AND B3
- DCA OLDTRK /SAVE 2 LSB
- RRSI /GET HEADER BYTE #2
- AND B377 /HARDWARE SHOULD DO THIS
- CLL RTL
- TAD OLDTRK /ADD IN MSB
- DCA OLDTRK
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
- SPA /IF POSITIVE, LINK WILL BE SET
- CLL CIA /IF NEGATIVE, CLEAR LINK
- RAR /DELETE SURFACE, INCLUDE DIRECTION
- TAD SURF /ADD SURFACE
- RLCA /LOAD DIFFERENCE WORD
- AC0002 /PREPARE FOR SEEK
-/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
-/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
-/SEEK UNRELIABILITY
- JMP SEEK
- /SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
-/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
-/REQUESTED-OLD, AND LINK=1
-TRKCMP, 0
- TAD OLDTRK /CALCULATE DIFFERENCE
- CIA
- TAD TRACK
- STL /LINK MUST BE SET WHEN
- /DIFFERENCE IS POSITIVE.
- SZA
- JMP I TRKCMP /DIFFERENT; RETURN
-/ON TRACK: DO TRANSFER
-/LOAD ALL REGISTERS
- TAD SECTOR
- RLSA
- TAD WC
- RLWC
- TAD SURF
- TAD CYL
- RLCA
- TAD MA
- RLMA
-/DO THE READ OR WRITE
- TAD FNC
- JMS IO
-/COUNT REQUESTED NUMBER OF PAGES
- TAD B7600
- TAD PAGES
- SNA
- JMP DONE
- DCA PAGES
- JMP I MAIN /RETURN FOR MORE
- /SUBROUTINE TO DO THE ACTUAL I/O
-IO, 0 /AC=MODE,FIELD,FUNCTION
- TAD BDRIVE
- RLCB /DO THE OPERATION
- RLSD /WAIT UNTIL DONE
- JMP .-1
- RLSE /TEST FOR I/O ERROR(S)
- JMP I IO /NONE; RETURN
-/IF ERROR, RETRY TWICE
- ISZ ERRCNT /MORE RETRIES LEFT?
- JMP RETRY /YES
-/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
-/WITH AC=4000
-ERROR, AC4000
- SKP
-/NORMAL RETURN FROM HANDLER
-DONE, ISZ BARG /SKIP ERROR RETURN
-BRTN, CIF CDF 00 /RETURN TO CALLING FIELD
- /BBL READ: NOP (FIELD 0)
- JMP I BARG /RETURN TO CALLING PROGRAM
- /DATA
-BLOCK, 0
-TRACK, 0 /BBL READ: TRACK 0
-WC, -41 /BBL READ: -BBL LENGTH
-SECTOR, 1400 /BBL READ: SECTOR 14
-CYL, 0
-SURF, 0
-ERRCNT, 0 /COUNT OF RETRIES
-OLDTRK, 2000 /FORCE INITIAL SEEK
-PAGES, 200 /BBL READ: ONE PAGE
-FNC, RLRD /BBL READ: READ FUNCTION
-/RELOCATED RELATIVE ADDRESSES
-
-BARG, OK-MAIN /BBL READ: RETURN FROM READ
- /ADDRESS OF HANDLER ARGUMENTS
-MA, BBL-MAIN /BBL READ: ADDR OF BBL
-BBBL, BBL-MAIN
-
-B3, 3
-B3777, 3777
-B7600, 7600
-BRLRD, RLRD
-HEADER, BYTE RLRH
-BDRIVE, DRIVE^100 /DRIVE BITS FOR RLCB
-CHECK, -ID
-
-/THIS CONSTANT MUST BE AT END OF PAGE
- ZBLOCK 577-.
-B4070, 4070
-$
DELETED src/os8-v3f/RL2.PA
Index: src/os8-v3f/RL2.PA
==================================================================
--- src/os8-v3f/RL2.PA
+++ /dev/null
@@ -1,460 +0,0 @@
-/RL2: RL01 DRIVE 2 NON-SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DRIVE 2 NON-SYSTEM HANDLER
-
- VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/13-OCT-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
-
-/BAD BLOCK LIST FORMAT:
-/WORD CONTENTS
-/0 ID (IDENTIFICATION CODE)
-/1 BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
-/... ...
-/20 0 (TERMINATOR FOR LIST A)
-/21 BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
-/... ...
-/40 0 (TERMINATOR FOR LIST B)
-
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -2 /- NR DEVICES PER HANDLER
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/0 GROUP NAME (4 CHAR)
-/2 DEVICE NAME (4 CHAR)
-/4 DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
-/5 OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
-/6 0 (UNUSED WORD)
-/7 0 TO REPRESENT NON-SYSTEM DEVICE
-
- DRIVE=2
-
-DEVICE RL2;DEVICE RL2A;4260;RLA&177+4000;0;0
-DEVICE RL2;DEVICE RL2B;4260;RLB&177+4000;0;0
- /HANDLER CODE
- *200 /FIRST PAGE
-
-/DATA
-
-A17, 17
-A47, 47
-A175, 175
-A200, 200
-A377, 377
-A7751, 7751
-BASE, TAD BBL+1
-ABLOCK, BLOCK-MAIN
-AMA, MA-MAIN /RELATIVE ADDR OF MA
-ASECT, SECTOR-MAIN
-ATRACK, TRACK-MAIN
-AERROR, ERROR-MAIN
-
-/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
-SET, TAD OFFSET /INITIALIZE MAPPING (BELOW)
- BSW
- CLL RTL /(0 OR 20: DEVICE A OR B)
- TAD BASE
- DCA MAP
- TAD RLB /ADDR OF ARGS
- JMS I GO /SETUP (AC NON-ZERO)
-/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
-MAP, TAD /INITIALIZED ABOVE
- SNA /0 TERMINATES LIST
- JMP MAPPED
- STL CIA /13-BIT NEGATE
- TAD I ABLOCK /COMPARE WITH BLOCK
- SZL CLA
- JMP MAPPED /BAD BLOCK IS ABOVE CURRENT BLOCK
- ISZ MAP /TRY NEXT BAD BLOCK ALSO
-NEXT, ISZ I ABLOCK /INCREMENT CURRENT BLOCK NUMBER,
- /EITHER DURING
- /BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
- /OF TWO SECTORS (PAGES) WITH MORE TO GO
- JMP MAP /CONTINUE MAPPING
- JMP I AERROR /ERROR ON BLOCK OVERFLOW
- ZBLOCK 240+DRIVE-. /UNUSED
-
-/ENTRY POINT FOR DEVICE B
-
-RLB, VERSION
- AC0004 /TRACK OFFSET WILL BE 400
- JMP START /SKIP AROUND RLA ENTRY POINT
-OFFSET, 0 /TRACK OFFSET FOR DEVICE (0 OR 400)
-
-/ENTRY POINT FOR DEVICE A
-
-RLA, VERSION
-A7600, 7600 /=CLA
- TAD RLA /TRANSFER CALLING ADDR
- DCA RLB
-START, BSW /SET OFFSET TO 0 IF DEV A, 400 IF DEV B
- DCA OFFSET
- TAD A7600 /RETURN TO KEYBOARD MONITOR
- KRS /IF CTRL,C TYPED
- TAD A175 /-CTRL,C
- SNA CLA
- KSF
-ONCE, JMP ONLY /THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
- /THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
- /IS DONE AND THE BAD BLOCK LIST IS READ IN.
-ACDIF, CIF CDF 00
- JMP I A7600 /CALL KB MONITOR
-/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
-GO, 0 /ADDR OF MAIN
-/-----BOUNDARY OF BAD BLOCK LIST-----
-BBL,
-/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
-/READ IN BAD BLOCK LIST (BBL)
-/SAVE CALLING DATA FIELD
- RDF
- TAD OOCDF
- DCA BACK
-OOCDF, CDF 00 /SET TO CURRENT FIELD
-/REPLACE ONCE-ONLY JUMP INSTRUCTION
- TAD JMPSET
- DCA ONCE
-LOOP, TAD LIST /RELOCATE CROSS-PAGE REFERENCES;
- /SCAN "LIST" FOR RELATIVE LOCATIONS
- /OF VALUES TO BE RELOCATED
- SNA /0 ACTS AS TERMINATOR
- JMP OUT
- TAD GO /RELOCATE RELATIVE ADDRESS
- DCA ONLY /"ONLY" IS NOW TEMP STORAGE
- ISZ LOOP /NEXT VALUE
- TAD GO
- TAD I ONLY /RELOCATE THE CONTENTS
- DCA I ONLY
- JMP LOOP /CONTINUE UNTIL DONE
-
-/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES
-
-LIST, BARG-MAIN
- ABLOCK-MAIN
- BBBL-MAIN
- AMA-MAIN
- ASECT-MAIN
- ATRACK-MAIN
- MA-MAIN
- AERROR-MAIN
- 0 /TERMINATOR
-
- ZBLOCK BBL+40-. /UNUSED (IN BBL BUFFER)
-
-/ONCE-ONLY CODE CONTINUES
-OUT, JMS I GO /READ BAD BLOCK LIST
-/-----BOUNDARY OF BAD BLOCK LIST-----
-OK, CLA /ERROR RETURN (IGNORE)
-BACK, CDF /RESTORE CALLING FIELD
-JMPSET, JMP SET /SETUP FOR TRANSFER
-
-/END OF ONCE-ONLY CODE
- /SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
-/CALCULATE TRACK AND SECTOR FROM BLOCK
-MAPPED, TAD I ABLOCK
- RTR
- RTR
- AND A377
- TAD OFFSET /DEVICE OFFSET (0 OR 400)
- DCA I ATRACK
- TAD I ABLOCK /CALCULATE SECTOR FROM BLOCK
- AND A17 /SECTOR CODE
- CLL RTL
- TAD A7751
- SPA
- TAD A47
- BSW
- DCA I ASECT
-/TRANSFER 1ST PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/INCREMENT SECTOR
- TAD A200
- TAD I ASECT
- DCA I ASECT
-/TRANSFER 2ND PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/CONTINUE WITH NEXT BLOCK
- JMP NEXT
-
-/ONCE-ONLY CODE AT END OF PAGE
- ZBLOCK 377-. /UNUSED
-ONLY, JMS GO /EXECUTED ONCE ONLY; STORES ADDR OF
- /2ND PAGE IN LOC "GO"
- *400
-/2ND PAGE OF HANDLER
-
-/SUBROUTINE TO SETUP AND TRANSFER
-/AC=0 FOR TRANSFER ELSE SETUP
-MAIN, 0
- SNA
- JMP TRANS
-/GET HANDLER ARGUMENTS
-SETUP, DCA BARG /ADDR OF HANDLER ARGS
- AC2000 /SET "OLDTRK" TO INVALID TRACK
- DCA OLDTRK /TO FORCE READING NEXT HEADER.
- TAD B7600 /SET FOR FULL PAGE TRANSFERS
- DCA WC /(WAS SMALLER FOR BBL READ)
- TAD I BARG /NOW GET HANDLER ARGUMENTS
- /FUNCTION WORD
-/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
-B377, AND B4070 /CONVERT TO RLCB FORMAT
- SPA
- TAD B3777
- TAD BRLRD
- DCA FNC
- TAD I BARG /FUNCTION WORD
- RAL /CONVERT TO PAGE COUNT IN BITS [7600]
- AND B7600
- DCA PAGES
- ISZ BARG
- TAD I BARG /MA
- DCA MA
- ISZ BARG
- TAD I BARG /BLOCK
- DCA BLOCK
- ISZ BARG
-/SAVE CALLING FIELD FOR RETURN
- RDF
- TAD BCDIF
- DCA BRTN
-/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
-BCDIF, CIF CDF 00
-/GET DEVICE OFFSET FROM 1ST PAGE
- TAD I BBBL /CHECK FOR BBL VALIDITY -
- TAD CHECK /1ST LOC OF BBL CONTAINS AN
- SZA CLA /IDENTIFICATION CODE ("ID")
- JMP ERROR /TAKE ERROR RETURN FROM HANDLER
- /IF BBL IS INVALID.
- JMP I MAIN
- /TRANSFER ONE OR MORE PAGES TO/FROM DISK
-/GET INTERPAGE ARGUMENTS
-/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
-TRANS, AC7775 /AC=-3
- DCA ERRCNT
-/CALCULATE CYLINDER AND SURFACE FROM TRACK
- TAD TRACK
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/RESET DRIVE (FUNCTION=1)
-RETRY, RLDC /CLEAR CONTROLLER, AC
-/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
-SEEK, IAC /AC=(1 OR 3)
- JMS IO /RESET DRIVE OR SEEK
-/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
- TAD HEADER
- JMS IO /READ NEXT HEADER
- RRSI /GET HEADER BYTE #1
- BSW
- AND B3
- DCA OLDTRK /SAVE 2 LSB
- RRSI /GET HEADER BYTE #2
- AND B377 /HARDWARE SHOULD DO THIS
- CLL RTL
- TAD OLDTRK /ADD IN MSB
- DCA OLDTRK
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
- SPA /IF POSITIVE, LINK WILL BE SET
- CLL CIA /IF NEGATIVE, CLEAR LINK
- RAR /DELETE SURFACE, INCLUDE DIRECTION
- TAD SURF /ADD SURFACE
- RLCA /LOAD DIFFERENCE WORD
- AC0002 /PREPARE FOR SEEK
-/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
-/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
-/SEEK UNRELIABILITY
- JMP SEEK
- /SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
-/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
-/REQUESTED-OLD, AND LINK=1
-TRKCMP, 0
- TAD OLDTRK /CALCULATE DIFFERENCE
- CIA
- TAD TRACK
- STL /LINK MUST BE SET WHEN
- /DIFFERENCE IS POSITIVE.
- SZA
- JMP I TRKCMP /DIFFERENT; RETURN
-/ON TRACK: DO TRANSFER
-/LOAD ALL REGISTERS
- TAD SECTOR
- RLSA
- TAD WC
- RLWC
- TAD SURF
- TAD CYL
- RLCA
- TAD MA
- RLMA
-/DO THE READ OR WRITE
- TAD FNC
- JMS IO
-/COUNT REQUESTED NUMBER OF PAGES
- TAD B7600
- TAD PAGES
- SNA
- JMP DONE
- DCA PAGES
- JMP I MAIN /RETURN FOR MORE
- /SUBROUTINE TO DO THE ACTUAL I/O
-IO, 0 /AC=MODE,FIELD,FUNCTION
- TAD BDRIVE
- RLCB /DO THE OPERATION
- RLSD /WAIT UNTIL DONE
- JMP .-1
- RLSE /TEST FOR I/O ERROR(S)
- JMP I IO /NONE; RETURN
-/IF ERROR, RETRY TWICE
- ISZ ERRCNT /MORE RETRIES LEFT?
- JMP RETRY /YES
-/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
-/WITH AC=4000
-ERROR, AC4000
- SKP
-/NORMAL RETURN FROM HANDLER
-DONE, ISZ BARG /SKIP ERROR RETURN
-BRTN, CIF CDF 00 /RETURN TO CALLING FIELD
- /BBL READ: NOP (FIELD 0)
- JMP I BARG /RETURN TO CALLING PROGRAM
- /DATA
-BLOCK, 0
-TRACK, 0 /BBL READ: TRACK 0
-WC, -41 /BBL READ: -BBL LENGTH
-SECTOR, 1400 /BBL READ: SECTOR 14
-CYL, 0
-SURF, 0
-ERRCNT, 0 /COUNT OF RETRIES
-OLDTRK, 2000 /FORCE INITIAL SEEK
-PAGES, 200 /BBL READ: ONE PAGE
-FNC, RLRD /BBL READ: READ FUNCTION
-/RELOCATED RELATIVE ADDRESSES
-
-BARG, OK-MAIN /BBL READ: RETURN FROM READ
- /ADDRESS OF HANDLER ARGUMENTS
-MA, BBL-MAIN /BBL READ: ADDR OF BBL
-BBBL, BBL-MAIN
-
-B3, 3
-B3777, 3777
-B7600, 7600
-BRLRD, RLRD
-HEADER, BYTE RLRH
-BDRIVE, DRIVE^100 /DRIVE BITS FOR RLCB
-CHECK, -ID
-
-/THIS CONSTANT MUST BE AT END OF PAGE
- ZBLOCK 577-.
-B4070, 4070
-$
DELETED src/os8-v3f/RL3.PA
Index: src/os8-v3f/RL3.PA
==================================================================
--- src/os8-v3f/RL3.PA
+++ /dev/null
@@ -1,460 +0,0 @@
-/RL3: RL01 DRIVE 3 NON-SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DRIVE 3 NON-SYSTEM HANDLER
-
- VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/13-OCT-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
-
-/BAD BLOCK LIST FORMAT:
-/WORD CONTENTS
-/0 ID (IDENTIFICATION CODE)
-/1 BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
-/... ...
-/20 0 (TERMINATOR FOR LIST A)
-/21 BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
-/... ...
-/40 0 (TERMINATOR FOR LIST B)
-
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -2 /- NR DEVICES PER HANDLER
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/0 GROUP NAME (4 CHAR)
-/2 DEVICE NAME (4 CHAR)
-/4 DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
-/5 OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
-/6 0 (UNUSED WORD)
-/7 0 TO REPRESENT NON-SYSTEM DEVICE
-
- DRIVE=3
-
-DEVICE RL3;DEVICE RL3A;4260;RLA&177+4000;0;0
-DEVICE RL3;DEVICE RL3B;4260;RLB&177+4000;0;0
- /HANDLER CODE
- *200 /FIRST PAGE
-
-/DATA
-
-A17, 17
-A47, 47
-A175, 175
-A200, 200
-A377, 377
-A7751, 7751
-BASE, TAD BBL+1
-ABLOCK, BLOCK-MAIN
-AMA, MA-MAIN /RELATIVE ADDR OF MA
-ASECT, SECTOR-MAIN
-ATRACK, TRACK-MAIN
-AERROR, ERROR-MAIN
-
-/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
-SET, TAD OFFSET /INITIALIZE MAPPING (BELOW)
- BSW
- CLL RTL /(0 OR 20: DEVICE A OR B)
- TAD BASE
- DCA MAP
- TAD RLB /ADDR OF ARGS
- JMS I GO /SETUP (AC NON-ZERO)
-/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
-MAP, TAD /INITIALIZED ABOVE
- SNA /0 TERMINATES LIST
- JMP MAPPED
- STL CIA /13-BIT NEGATE
- TAD I ABLOCK /COMPARE WITH BLOCK
- SZL CLA
- JMP MAPPED /BAD BLOCK IS ABOVE CURRENT BLOCK
- ISZ MAP /TRY NEXT BAD BLOCK ALSO
-NEXT, ISZ I ABLOCK /INCREMENT CURRENT BLOCK NUMBER,
- /EITHER DURING
- /BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
- /OF TWO SECTORS (PAGES) WITH MORE TO GO
- JMP MAP /CONTINUE MAPPING
- JMP I AERROR /ERROR ON BLOCK OVERFLOW
- ZBLOCK 240+DRIVE-. /UNUSED
-
-/ENTRY POINT FOR DEVICE B
-
-RLB, VERSION
- AC0004 /TRACK OFFSET WILL BE 400
- JMP START /SKIP AROUND RLA ENTRY POINT
-OFFSET, 0 /TRACK OFFSET FOR DEVICE (0 OR 400)
-
-/ENTRY POINT FOR DEVICE A
-
-RLA, VERSION
-A7600, 7600 /=CLA
- TAD RLA /TRANSFER CALLING ADDR
- DCA RLB
-START, BSW /SET OFFSET TO 0 IF DEV A, 400 IF DEV B
- DCA OFFSET
- TAD A7600 /RETURN TO KEYBOARD MONITOR
- KRS /IF CTRL,C TYPED
- TAD A175 /-CTRL,C
- SNA CLA
- KSF
-ONCE, JMP ONLY /THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
- /THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
- /IS DONE AND THE BAD BLOCK LIST IS READ IN.
-ACDIF, CIF CDF 00
- JMP I A7600 /CALL KB MONITOR
-/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
-GO, 0 /ADDR OF MAIN
-/-----BOUNDARY OF BAD BLOCK LIST-----
-BBL,
-/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
-/READ IN BAD BLOCK LIST (BBL)
-/SAVE CALLING DATA FIELD
- RDF
- TAD OOCDF
- DCA BACK
-OOCDF, CDF 00 /SET TO CURRENT FIELD
-/REPLACE ONCE-ONLY JUMP INSTRUCTION
- TAD JMPSET
- DCA ONCE
-LOOP, TAD LIST /RELOCATE CROSS-PAGE REFERENCES;
- /SCAN "LIST" FOR RELATIVE LOCATIONS
- /OF VALUES TO BE RELOCATED
- SNA /0 ACTS AS TERMINATOR
- JMP OUT
- TAD GO /RELOCATE RELATIVE ADDRESS
- DCA ONLY /"ONLY" IS NOW TEMP STORAGE
- ISZ LOOP /NEXT VALUE
- TAD GO
- TAD I ONLY /RELOCATE THE CONTENTS
- DCA I ONLY
- JMP LOOP /CONTINUE UNTIL DONE
-
-/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES
-
-LIST, BARG-MAIN
- ABLOCK-MAIN
- BBBL-MAIN
- AMA-MAIN
- ASECT-MAIN
- ATRACK-MAIN
- MA-MAIN
- AERROR-MAIN
- 0 /TERMINATOR
-
- ZBLOCK BBL+40-. /UNUSED (IN BBL BUFFER)
-
-/ONCE-ONLY CODE CONTINUES
-OUT, JMS I GO /READ BAD BLOCK LIST
-/-----BOUNDARY OF BAD BLOCK LIST-----
-OK, CLA /ERROR RETURN (IGNORE)
-BACK, CDF /RESTORE CALLING FIELD
-JMPSET, JMP SET /SETUP FOR TRANSFER
-
-/END OF ONCE-ONLY CODE
- /SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
-/CALCULATE TRACK AND SECTOR FROM BLOCK
-MAPPED, TAD I ABLOCK
- RTR
- RTR
- AND A377
- TAD OFFSET /DEVICE OFFSET (0 OR 400)
- DCA I ATRACK
- TAD I ABLOCK /CALCULATE SECTOR FROM BLOCK
- AND A17 /SECTOR CODE
- CLL RTL
- TAD A7751
- SPA
- TAD A47
- BSW
- DCA I ASECT
-/TRANSFER 1ST PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/INCREMENT SECTOR
- TAD A200
- TAD I ASECT
- DCA I ASECT
-/TRANSFER 2ND PAGE OF BLOCK
- JMS I GO
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
-/CONTINUE WITH NEXT BLOCK
- JMP NEXT
-
-/ONCE-ONLY CODE AT END OF PAGE
- ZBLOCK 377-. /UNUSED
-ONLY, JMS GO /EXECUTED ONCE ONLY; STORES ADDR OF
- /2ND PAGE IN LOC "GO"
- *400
-/2ND PAGE OF HANDLER
-
-/SUBROUTINE TO SETUP AND TRANSFER
-/AC=0 FOR TRANSFER ELSE SETUP
-MAIN, 0
- SNA
- JMP TRANS
-/GET HANDLER ARGUMENTS
-SETUP, DCA BARG /ADDR OF HANDLER ARGS
- AC2000 /SET "OLDTRK" TO INVALID TRACK
- DCA OLDTRK /TO FORCE READING NEXT HEADER.
- TAD B7600 /SET FOR FULL PAGE TRANSFERS
- DCA WC /(WAS SMALLER FOR BBL READ)
- TAD I BARG /NOW GET HANDLER ARGUMENTS
- /FUNCTION WORD
-/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
-B377, AND B4070 /CONVERT TO RLCB FORMAT
- SPA
- TAD B3777
- TAD BRLRD
- DCA FNC
- TAD I BARG /FUNCTION WORD
- RAL /CONVERT TO PAGE COUNT IN BITS [7600]
- AND B7600
- DCA PAGES
- ISZ BARG
- TAD I BARG /MA
- DCA MA
- ISZ BARG
- TAD I BARG /BLOCK
- DCA BLOCK
- ISZ BARG
-/SAVE CALLING FIELD FOR RETURN
- RDF
- TAD BCDIF
- DCA BRTN
-/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
-BCDIF, CIF CDF 00
-/GET DEVICE OFFSET FROM 1ST PAGE
- TAD I BBBL /CHECK FOR BBL VALIDITY -
- TAD CHECK /1ST LOC OF BBL CONTAINS AN
- SZA CLA /IDENTIFICATION CODE ("ID")
- JMP ERROR /TAKE ERROR RETURN FROM HANDLER
- /IF BBL IS INVALID.
- JMP I MAIN
- /TRANSFER ONE OR MORE PAGES TO/FROM DISK
-/GET INTERPAGE ARGUMENTS
-/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
-TRANS, AC7775 /AC=-3
- DCA ERRCNT
-/CALCULATE CYLINDER AND SURFACE FROM TRACK
- TAD TRACK
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/RESET DRIVE (FUNCTION=1)
-RETRY, RLDC /CLEAR CONTROLLER, AC
-/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
-SEEK, IAC /AC=(1 OR 3)
- JMS IO /RESET DRIVE OR SEEK
-/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
- TAD HEADER
- JMS IO /READ NEXT HEADER
- RRSI /GET HEADER BYTE #1
- BSW
- AND B3
- DCA OLDTRK /SAVE 2 LSB
- RRSI /GET HEADER BYTE #2
- AND B377 /HARDWARE SHOULD DO THIS
- CLL RTL
- TAD OLDTRK /ADD IN MSB
- DCA OLDTRK
-/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
- JMS TRKCMP
-/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
-/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
- SPA /IF POSITIVE, LINK WILL BE SET
- CLL CIA /IF NEGATIVE, CLEAR LINK
- RAR /DELETE SURFACE, INCLUDE DIRECTION
- TAD SURF /ADD SURFACE
- RLCA /LOAD DIFFERENCE WORD
- AC0002 /PREPARE FOR SEEK
-/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
-/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
-/SEEK UNRELIABILITY
- JMP SEEK
- /SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
-/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
-/REQUESTED-OLD, AND LINK=1
-TRKCMP, 0
- TAD OLDTRK /CALCULATE DIFFERENCE
- CIA
- TAD TRACK
- STL /LINK MUST BE SET WHEN
- /DIFFERENCE IS POSITIVE.
- SZA
- JMP I TRKCMP /DIFFERENT; RETURN
-/ON TRACK: DO TRANSFER
-/LOAD ALL REGISTERS
- TAD SECTOR
- RLSA
- TAD WC
- RLWC
- TAD SURF
- TAD CYL
- RLCA
- TAD MA
- RLMA
-/DO THE READ OR WRITE
- TAD FNC
- JMS IO
-/COUNT REQUESTED NUMBER OF PAGES
- TAD B7600
- TAD PAGES
- SNA
- JMP DONE
- DCA PAGES
- JMP I MAIN /RETURN FOR MORE
- /SUBROUTINE TO DO THE ACTUAL I/O
-IO, 0 /AC=MODE,FIELD,FUNCTION
- TAD BDRIVE
- RLCB /DO THE OPERATION
- RLSD /WAIT UNTIL DONE
- JMP .-1
- RLSE /TEST FOR I/O ERROR(S)
- JMP I IO /NONE; RETURN
-/IF ERROR, RETRY TWICE
- ISZ ERRCNT /MORE RETRIES LEFT?
- JMP RETRY /YES
-/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
-/WITH AC=4000
-ERROR, AC4000
- SKP
-/NORMAL RETURN FROM HANDLER
-DONE, ISZ BARG /SKIP ERROR RETURN
-BRTN, CIF CDF 00 /RETURN TO CALLING FIELD
- /BBL READ: NOP (FIELD 0)
- JMP I BARG /RETURN TO CALLING PROGRAM
- /DATA
-BLOCK, 0
-TRACK, 0 /BBL READ: TRACK 0
-WC, -41 /BBL READ: -BBL LENGTH
-SECTOR, 1400 /BBL READ: SECTOR 14
-CYL, 0
-SURF, 0
-ERRCNT, 0 /COUNT OF RETRIES
-OLDTRK, 2000 /FORCE INITIAL SEEK
-PAGES, 200 /BBL READ: ONE PAGE
-FNC, RLRD /BBL READ: READ FUNCTION
-/RELOCATED RELATIVE ADDRESSES
-
-BARG, OK-MAIN /BBL READ: RETURN FROM READ
- /ADDRESS OF HANDLER ARGUMENTS
-MA, BBL-MAIN /BBL READ: ADDR OF BBL
-BBBL, BBL-MAIN
-
-B3, 3
-B3777, 3777
-B7600, 7600
-BRLRD, RLRD
-HEADER, BYTE RLRH
-BDRIVE, DRIVE^100 /DRIVE BITS FOR RLCB
-CHECK, -ID
-
-/THIS CONSTANT MUST BE AT END OF PAGE
- ZBLOCK 577-.
-B4070, 4070
-$
DELETED src/os8-v3f/RLC.PA
Index: src/os8-v3f/RLC.PA
==================================================================
--- src/os8-v3f/RLC.PA
+++ /dev/null
@@ -1,441 +0,0 @@
-/RLC: RL01 DEVICE C NON-SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DEVICE C NON-SYSTEM HANDLER
-
-
VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/9-NOV-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
-
-/BAD BLOCK LIST FORMAT:
-/(TRACK 0 SECTOR 16)
-/WORD CONTENTS
-/0 ID (IDENTIFICATION CODE)
-/1 BAD BLOCK NUMBERS (ASCENDING ORDER)
-/... ...
-/20 0 (LIST TERMINATOR)
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -4 /- NR DEVICES PER HANDLER
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/0 GROUP NAME (4 CHAR)
-/2 DEVICE NAME (4 CHAR)
-/4 DCB WORD FOR AN RL01(C), DIRECTORY DEVICE
-/5 OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
-/6 0 (UNUSED WORD)
-/7 0 TO REPRESENT NON-SYSTEM DEVICE
-
-DEVICE RLC;DEVICE RL0C;4310;RL0C&177+4000;0;0
-DEVICE RLC;DEVICE RL1C;4310;RL1C&177+4000;0;0
-DEVICE RLC;DEVICE RL2C;4310;RL2C&177+4000;0;0
-DEVICE RLC;DEVICE RL3C;4310;RL3C&177+4000;0;0
- /HANDLER CODE
-
- *200 /FIRST PAGE
-
-START, DCA DRIVE /SAVE DRIVE NUMBER.
- TAD DRIVE /FIND ENTRY ADDR IN
- CLL RTL /ORDER TO TRANSFER
- TAD TADX /CALLING ADDR TO "ARG".
- DCA .+1
- TAD
- DCA ARG
- TAD I ARG /GET ARGUMENTS
- /FUNCTION WORD
- AND A4070 /READ-WRITE, FIELD
- SPA
- TAD A3777 /IF WRITE, -1
- TAD ARLRD /CONVERT FUNCTION TO RL01
- /FUNCTION WORD.
- DCA FNC
- TAD I ARG /FUNCTION WORD
- RAL
- AND A7600 /PAGES IN BITS [7600];
- /0 MEANS 40.
- DCA PAGES
- ISZ ARG
- TAD I ARG /MA
- DCA MA
- ISZ ARG
- TAD I ARG /BLOCK
- DCA BLOCK
- ISZ ARG
- RDF /SAVE CALLING FIELD
- TAD ACIDF /FOR RETURN.
- DCA RTN
-ACIDF, CIF CDF 00 /CHANGE TO CURRENT FIELD.
- TAD A7600 /RETURN TO MONITOR IF USER
- KRS /TYPES CTRL,C.
- TAD A175
- SNA CLA
- KSF
-ONCE, JMP ONLY /ELSE START ONCE-ONLY CODE
- /AT "ONLY". "ONCE" GETS CHANGED
- /TO "JMP BEGIN" BY ONCE-ONLY CODE.
- JMP I A7600 /CALL MONITOR UPON CTRL,C.
-
-/CONSTANTS
-
-ATRANS, TRANS-MAIN
-ACURTK, CURTRK-MAIN
-CHECK, -ID
-A200, 200
-A4070, 4070
- /ENTRY POINTS
-
- IFNZRO 250-. <ENTRY POINTS START AT OFFSET OF 50>
-
-ARG, /ADDR OF ARG LIST
-RL0C, VERSION /DRIVE 0 ENTRY POINT
- CLA
- JMP START
-TADX, TAD ARG /A CONSTANT
-RL1C, VERSION /DRIVE 1 ENTRY POINT
- AC0001
- JMP START
-A175, 175
-RL2C, VERSION /DRIVE 2 ENTRY POINT
- AC0002
- JMP START
-A3777, 3777
-RL3C, VERSION /DRIVE 3 ENTRY POINT
- AC0003
- JMP START
- GO, 0 /ONCE-ONLY CODE.
- /ADDRESS OF 2ND PAGE STORED HERE.
-BBL, TAD JMPX /NEXT 21 OCTAL LOCATIONS ARE
- /REPLACED BY THE BAD BLOCK LIST
- /WHEN IT IS READ IN
- /FROM REQUESTED DRIVE.
- /ONCE-ONLY CODE: PREVENT EXE-
- /CUTION MORE THAN ONCE.
- DCA ONCE
-LOOP, TAD LIST /RELOCATE LOCATIONS CONTAINING
- SNA /RELATIVE ADDRESSES TO MAKE THEM
-JMPX, JMP BEGIN /ABSOLUTE. LOCATION LIST IS TERM-
- /INATED BY ZERO.
- TAD GO /RELOCATE VALUE IN LIST.
- DCA ONLY /"ONLY" IS NOW TEMP STORAGE.
- ISZ LOOP
- TAD GO /RELOCATE ADDRESS(VALUE).
- TAD I ONLY
- DCA I ONLY
- JMP LOOP /CONTINUE UNTIL DONE.
-LIST, ABBL-MAIN /LIST OF RELATIVE ADDRESSES OF
- /RELOCATABLE ADDRESSES.
- ATRANS-MAIN
- ACURTK-MAIN
- BBLOCK-MAIN
- BSECT-MAIN
- BTRACK-MAIN
- BHALF-MAIN
- BDRIVE-MAIN
- BASE-MAIN
- BERROR-MAIN
- 0 /TERMINATOR.
- /PERFORM TRANSFER, READING IN BBL IF NECESSARY
-
-BEGIN, AC2000
- DCA I ACURTK /FORCE IGNORANCE OF CURRENT
- /TRACK IN CASE OPERATION IS
- /TO A DIFFERENT DRIVE.
- /(2000 IS AN ILLEGAL TRACK)
- TAD DRIVE /HAS DRIVE CHANGED FROM LAST CALL?
- CIA
- TAD CURDRV
- SNA CLA
- JMP I ATRANS /NO, DO TRANSFER.
- TAD DRIVE /YES, REMEMBER CHANGE AND
- DCA CURDRV /READ IN BAD BLOCK LIST.
- JMS I GO /CALL TRANSFER SUBROUTINE
- 0 /TRACK=0
- 16 /SECTOR=16
- -21 /WC=-LIST LENGTH
-ABBL, BBL-MAIN /MA="BBL"
-ARLRD, RLRD /FUNCTION=READ INTO FIELD 0
- TAD I ABBL /IS BBL VALID?
- TAD CHECK /-ID.
- SNA CLA
- JMP I ATRANS /YES, DO TRANSFER.
-ERROR, AC4000 /HANDLER ERROR RETURN.
- SKP
-DONE, ISZ ARG /NORMAL HANDLER RETURN.
-RTN, CIF CDF /RETURN TO CALLING FIELD.
- JMP I ARG
- /SECTOR TRANSFER SUBROUTINE
-
-HALF, 0 /TRANSFER ONE PAGE.
- JMS I GO /CALL TRANSFER SUBROUTINE
-TRACK, 0 /TRACK
-SECTOR, 0 /SECTOR
-A7600, 7600 /-WORD COUNT
-MA, 0 /MEMORY ADDRESS
-FNC, 0 /FUNCTION WORD
- TAD A200 /INCREMENT MEMORY ADDRESS.
- TAD MA
- DCA MA
- ISZ SECTOR /INCREMENT SECTOR ADDRESS.
- ISZ SECTOR /(2:1 INTERLEAVE)
- TAD A7600 /DECREMENT PAGE COUNT.
- TAD PAGES
- SNA
- JMP DONE /TAKE NORMAL HANDLER RETURN
- /WHEN PAGE COUNT REACHES ZERO.
- DCA PAGES /ELSE CONTINUE TRANSFER.
- JMP I HALF
-
-/VARIABLES
-
-DRIVE, 0
-PAGES, 0
-BLOCK, 0
-
- ZBLOCK 377-. /UNUSED: "ONLY" MUST BE AT 377!
-
-CURDRV, /CURRENT DRIVE (INITIALLY INVALID
- /TO FORCE READ-IN OF BAD BLOCK LIST).
-ONLY, JMS GO /ONCE-ONLY CODE TO PUT ADDRESS
- /OF "MAIN" INTO "GO".
- /REUSED AS CURRENT DRIVE.
- *400 /SECOND PAGE
-
-MAIN, 0 /TRANSFER UP TO ONE PAGE.
- AC7775 /INITIALIZE FOR 3 TRIES.
- DCA ERRCNT
- TAD MAIN /SAVE ADDRESS OF ARGS.
- DCA MAINSV
- TAD I MAIN /CALCULATE CYLINDER AND
- /SURFACE FROM TRACK.
- /1ST ARG=TRACK.
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
- JMS TRKCMP /IF ON TRACK, DO TRANSFER.
-RETRY, TAD MAINSV /OFF TRACK: SEEK TO TRACK.
- DCA MAIN /RESTORE ADDRESS OF ARGS.
- RLDC /CLEAR CONTROLLER REGISTERS.
-SEEK, IAC /AC=CLEAR DRIVE REGISTERS
- /FUNCTION (AC=SEEK FUNCTION
- /WHEN CALLED FROM BELOW).
- JMS IO /DO RL01 FUNCTION.
- TAD HEADER
- JMS IO /READ NEXT HEADER FROM DISK.
- RRSI /GET HEADER BYTE #1.
- BSW
-B377, AND B3 /THIS INSTRUCTION IS ALSO USED
- /AS A CONSTANT.
- DCA CURTRK /BITS [3] OF CURRENT TRACK.
- RRSI /GET HEADER BYTE #2.
- AND B377 /THIS SHOULD BE DONE BY HARDWARE!
- CLL RTL /BITS [774] OF CURRENT TRACK.
- TAD CURTRK
- DCA CURTRK
- JMS TRKCMP /IF ON TRACK, DO TRANSFER.
- TAD CURTRK /OFF TRACK: CONSTRUCT DIFFERENCE
- CLL RAR /WORD FOR SEEK.
- CIA
- TAD CYL
- SMA
- JMP AROUND
- CIA
- SKP
-AROUND, TAD B4000 /SET DIRECTION BIT IF TO HIGHER
- /CYLINDER ADDRESS.
- TAD SURF
- RLCA /LOAD DIFFERENCE WORD.
- AC0002 /PREPARE AC FOR SEEK FUNCTION.
- JMP SEEK /SEEK.
- TRKCMP, 0 /IF ON TRACK, DO TRANSFER.
- TAD CURTRK /COMPARE CURRENT TRACK AND
- CIA /DESIRED TRACK.
- TAD I MAIN /1ST ARG=TRACK.
- SZA CLA
- JMP I TRKCMP /DIFFERENT: SEEK.
- ISZ MAIN /ON TRACK: DO TRANSFER.
- TAD CYL
- TAD SURF
- RLCA /LOAD DISK ADDRESS OF TRACK.
- TAD I MAIN /2ND ARG=SECTOR.
- BSW
- RLSA /LOAD SECTOR ADDRESS.
- ISZ MAIN
- TAD I MAIN /3RD ARG=WORD COUNT.
- RLWC /LOAD WORD COUNT.
- ISZ MAIN
- TAD I MAIN /4TH ARG=MA.
- RLMA /LOAD MA.
- ISZ MAIN
- TAD I MAIN /5TH ARG=FUNCTION.
- JMS IO /DO RL01 FUNCTION.
- ISZ MAIN
- JMP I MAIN /RETURN FROM TRANSFER SUBROUTINE.
- TRANS, TAD BASE /DO TRANSFER.
- /INITIALIZE BAD BLOCK MAPPING.
- DCA MAPPER
-MAP, TAD I MAPPER /DO BAD BLOCK MAPPING.
- /GET BAD BLOCK IF ANY.
- SNA /DONE? (0 TERMINATES)
- JMP MAPPED /YES.
- STL CIA /NO, 13-BIT NEGATE.
- TAD I BBLOCK /SUBTRACT FROM CURRENT BLOCK.
- SZL CLA /IS BAD BLOCK GREATER (UNSIGNED)?
- JMP MAPPED /YES, MAPPING IS DONE.
- ISZ MAPPER /NO, MAP AROUND THIS BAD BLOCK
- /AND TRY NEXT.
-NEXT, ISZ I BBLOCK /WILL NEVER SKIP.
- JMP MAP /CONTINUE MAPPING UNTIL DONE.
- MAPPED, TAD I BBLOCK /CALCULATE SECTOR FROM BLOCK.
- AND B3
- CLL RTL
- DCA I BSECT
- TAD I BBLOCK /TEST BLOCK FOR LEGALITY: LEGAL
- TAD B4010 /BLOCKS ARE 0-3767.
- SZL CLA
- JMP I BERROR
- TAD I BBLOCK /CALCULATE TRACK FROM BLOCK.
- RTR
- AND B777
- IAC
- DCA I BTRACK
- JMS I BHALF /TRANSFER 1ST HALF OF BLOCK.
- JMS I BHALF /TRANSFER 2ND HALF OF BLOCK.
- JMP NEXT /CONTINUE WITH NEXT BLOCK.
- IO, 0 /DO RL01 FUNCTION.
- BSW
- TAD I BDRIVE
- BSW /PUT DRIVE INTO BITS [300].
- RLCB /DO RL01 COMMAND.
- RLSD /WAIT UNTIL DONE.
- JMP .-1
- RLSE /ANY ERRORS?
- JMP I IO /NO, RETURN.
- ISZ ERRCNT /YES, TRY AGAIN?
- JMP RETRY /YES.
- JMP I BERROR /TAKE ERROR RETURN WHEN 3
- /TRIES HAVE BEEN DONE.
-
-/DATA
-BBLOCK, BLOCK-MAIN
-BSECT, SECTOR-MAIN
-BTRACK, TRACK-MAIN
-BHALF, HALF-MAIN
-BDRIVE, DRIVE-MAIN
-BERROR, ERROR-MAIN
-BASE, BBL+1-MAIN /START OF BBL FOR MAPPING.
-MAPPER, 0
-MAINSV, 0 /SAVED "MAIN" VALUE.
-CURTRK, 0
-HEADER, BYTE RLRH
-SURF, 0
-CYL, 0
-ERRCNT, 0
-B777, 777
-B4000, 4000
-B4010, 4010
-
- ZBLOCK 577-. /UNUSED.
-
-B3, 3 /THIS CONSTANT MUST BE AT
- /LAST LOC OF 2ND PAGE.
-
-$
DELETED src/os8-v3f/RLFRMT.PA
Index: src/os8-v3f/RLFRMT.PA
==================================================================
--- src/os8-v3f/RLFRMT.PA
+++ /dev/null
@@ -1,1226 +0,0 @@
-/RLFRMT: RL01 DISK PACK FORMATTER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 DISK PACK FORMATTING PROGRAM
-
-VERSION=1
-PATCH="A&77
-
-/NOTE:
-/THIS SOFTWARE WILL RUN ONLY ON PDP-8A,E,F,M!
-
-/EDIT HISTORY:
-/2-NOV-77 DAVID SPECTOR: CREATION
-
-/RLFRMT WRITES OS/8 BAD BLOCK LISTS
-/ON RL01 DISK PACKS
-
-/BAD BLOCK LIST FORMATS:
-/1. FACTORY-DETECTED BAD BLOCKS
-/ CYLINDER 377 SURFACE 1 EVEN SECTORS 0-16
-/ BYTE CONTENTS COMMENTS
-/ 0 22111000 SERIAL NUMBER:
-/ 1 ?4443332 9876543210 (OCTAL)
-/ 2 77666555
-/ 3 ?9998887
-/ 4 ? UNUSED
-/ 5 ?
-/ 6 ?
-/ 7 ?
-/ 10 CYLINDER BAD SECTOR ENTRY
-/ 11 ???????D DOUBLE-DENSITY EXTENSION
-/ 12 ??SECTOR
-/ 13 ???????S SURFACE BIT
-/ ... ... MORE BAD SECTOR ENTRIES
-/ ??? ALL 1'S TERMINATOR ENTRY
-
-/ NOTE: "?" REPRESENTS UNUSED ITEMS (0)
- /2. OS/8 BAD BLOCK LISTS
-
-/2A. DEVICES A AND B
-/ CYLINDER 0 SURFACE 0 SECTOR 14
-/WORD CONTENTS
-/ 0 IDENTIFICATION CODE (ID)
-/ 1 BAD BLOCKS FOR DEVICE A IN ASCENDING ORDER
-/... ...
-/20 0 (TERMINATOR FOR LIST)
-/21 BAD BLOCKS FOR DEVICE B IN ASCENDING ORDER
-/... ...
-/40 0 (TERMINATOR FOR LIST)
-
-/2B. DEVICE C
-/ CYLINDER 0 SURFACE 0 SECTOR 16
-/WORD CONTENTS
-/ 0 IDENTIFICATION CODE (ID)
-/ 1 BAD BLOCKS FOR DEVICE C IN ASCENDING ORDER
-/... ...
-/20 0 (TERMINATOR FOR LIST)
-/100-177 ID CODE
-
-/3. INTERNAL TRACK-SECTOR FORMAT:
-/WORD 0: TRACK
-/WORD 1: SECTOR
-/TERMINATOR: NEGATIVE TRACK WORD
-
-/4. INTERNAL OS/8 FORMAT:
-/WORD 0: DEVICE (0=A, 1=B, 2=C)
-/WORD 1: BLOCK NUMBER
-/TERMINATOR: NEGATIVE DEVICE WORD
-
-/ +-------------------------------+
-/ ! !
-/ ! NOTE !
-/ ! !
-/ ! REFER TO THE DOCUMENT "RL01 !
-/ ! SUPPORT UNDER OS/8" FOR !
-/ ! FURTHER INFORMATION. !
-/ ! !
-/ ! !
-/ +-------------------------------+
- /INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8A,E,F,M
-
-
-/PAGE 0 VARIABLES
- AUTO1=10
- AUTO2=11
- AUTO3=12
- AUTO4=13
- TEMP=20
- KEY=21
- INT=22 /RESERVED
- TMP1=23
- TMP2=24
- TMP3=25
- TMP4=26
- TMP5=27
- TMP6=30
- TMP7=31
- DIGIT=32 /DRIVE NUMBER
- DRIVE=DIGIT /DRIVE VALUE
- FMT=33 /7777 IF FORMATTED DISK
- FAC=34 /7777 IF FACTORY LIST OK
-
-/LOCATIONS WITHIN OS/8
- MON=7605 /FAST MONITOR RETURN FROM RLFRMT
-
-/IDENTIFICATION CODE FOR BAD BLOCK LISTS
- ID=123
- /BUFFERS
- FACTRY=4000 /2 PAGES: FACTORY LIST
- AANDB=FACTRY+400 /1 PAGE: OS/8 A&B LISTS
- C=AANDB+200 /1 PAGE: OS/8 C LIST
- X=C+200 /1 PAGE: "DON'T CARE" PAGE
- /(FOR READ-CHECKING)
- OLD=X /1 PAGE: OLD OS/8 A,B,C
- NEW=X+200 /1 PAGE: NEWLY-FOUND BAD BLOCKS
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- *200 /STARTING ADDRESS
-
- TAD (IDMSG) /START HERE
- JMS TYPE /IDENTIFY SELF
-RE, TAD (MSG) /RESTART HERE.
- JMS TYPE /ASK FOR DRIVE NUMBER
-RE1, JMS GETKEY /WAIT FOR KEY
- TAD (-60) /CONVERT TO DIGIT
- DCA DIGIT
- TAD DIGIT
- AND (7774) /ALLOW ONLY DRIVES 0-3
- SNA CLA
- JMP FA1
-BUIN, TAD (BDMSG) /BAD USER INPUT: ADVISE USER.
- JMS TYPE
- JMP RE
-FA1, JMS GETKEY /WAIT FOR RETURN KEY
- TAD (-15)
- SZA CLA
- JMP BUIN
- TAD DIGIT /GOOD USER INPUT;
- BSW /CHANGE DIGIT TO DRIVE NR.
- DCA DIGIT
- JMS CRLF
- AC2000 /SET CURRENT TRACK TO ILLEGAL
- DCA CURTRK /VALUE IN ORDER TO FORCE A 'READ
- /HEADER' OPERATION THE FIRST
- /TIME "RL01" IS CALLED, SO WE
- /CAN FIND OUT WHERE THE HEAD IS.
- JMS RL01 /READ OS/8 BAD BLOCK LIST
- /(BBL) FOR DEVICES A&B
- RLRD /FUNCTION
- AANDB /MA
- 0 /TRACK
- 14 /SECTOR
- JMP FATAL /ERROR RETURN
- JMS RL01 /NORMAL RETURN: READ OS/8
- /BBL FOR DEVICE C
- RLRD /FUNCTION
- C /MA
- 0 /TRACK
- 16 /SECTOR
- JMP FATAL /ERROR RETURN
- DCA RCTRK /PERFORM READ-CHECK OF ENTIRE
- /DISK
- TAD (-1000) /NUMBER OF TRACKS
- DCA TMP2
- TAD (NEW-1)
- DCA AUTO3 /STORAGE FOR BAD ONES FOUND
- TAD (-100)
- DCA BADCNT /IN CASE ALL ARE "BAD"
-RCNEXT, JMS RCSUB /READ NEXT TRACK
- /EVEN SECTORS
- CLA IAC
- JMS RCSUB /ODD SECTORS
- ISZ RCTRK
- ISZ TMP2
- JMP RCNEXT
- STA /TERMINATE NEW BAD LIST
- DCA I AUTO3
- STA /READ BAD BLOCK LISTS FROM DISK
- /START WITH FACTORY-DETECTED
- /BAD BLOCK LIST
- /TRY ALL BAD BLOCK LISTS ON LAST
- /TRACK - SET "FAC" TO -1 IF LIST
- /IS READ IN OK, ELSE 0.
- /INITIALLY ASSUME OK.
- DCA FAC
- TAD (-10) /SET FOR 8 TRIES.
- DCA TMP1
- DCA FACSEC /EVEN SECTORS, STARTING WITH 0.
-FACRD, JMS RL01 /CALL RL01 TRANSFER SUBROUTINE
- /TO TRY READING FACTORY BAD
- /BLOCK LIST.
- BYTE RLRD /FUNCTION WORD
- FACTRY /MA
- 777 /TRACK
-FACSEC, 0 /SECTOR
- JMP FACBAD /ERROR RETURN
- TAD (FACCTL-1) /NORMAL RETURN: TEST LIST JUST
- /READ FOR VALIDITY (4 ZEROS IN
- /FACTRY+4, 4 377'S IN FACTRY+374).
- DCA AUTO1
-FAC1, TAD I AUTO1 /LOC FOR VALIDITY TEST.
- SNA /0 TERMINATES CONTROL LIST.
- JMP FACOK /MUST BE VALID; CONTINUE.
- DCA AUTO2 /LOC FOR VALIDITY TEST.
- TAD I AUTO1 /VALUE FOR VALIDITY TEST.
- DCA TMP2
- TAD (-4) /BYTES TO CHECK.
- DCA TMP3
-FAC2, TAD I AUTO2 /CHECK NEXT BYTE.
- AND (377) /HARDWARE SHOULD DO THIS!
- CIA
- TAD TMP2
- SZA CLA /VALUE CHECKS OK?
- JMP FACBAD /NO.
- ISZ TMP3 /YES, DONE?
- JMP FAC2 /NO, CHECK NEXT BYTE.
- JMP FAC1 /YES, DO NEXT TEST IF ANY.
-
-FACBAD, ISZ FACSEC /BAD LIST OR I/O ERROR: TRY
- /READING NEXT COPY OF LIST.
- ISZ FACSEC /INCREMENT SECTOR BY 2.
- ISZ TMP1 /DONE 8 TRIES?
- JMP FACRD /NO, TRY NEXT LIST.
- DCA FAC /YES, DECLARE LIST BAD.
-FACOK, JMP CC1 /CONTINUE ON NEXT PAGE
-
- PAGE
- /CONTINUE FROM PREVIOUS PAGE
-CC1, TAD (-100) /FIND OUT IF DISK IS ALREADY
- DCA TMP1 /FORMATTED: SET FMT=0 IF NO,
- TAD (C+77) /FMT=7777 IF YES. LAST 100 OCTAL
- DCA AUTO1 /WORDS OF "C" LIST ARE EQUAL TO
- /ID CODE.
- STA /ASSUME IT IS FORMATTED
- DCA FMT
-PFCLP, TAD I AUTO1 /SCAN ID CODE LIST
- TAD (-ID)
- SZA CLA
- DCA FMT /FMT=0 IF UNFORMATTED
- ISZ TMP1 /DONE SCAN?
- JMP PFCLP /NOT YET
- TAD FMT /YES - TYPE SERIAL NR
- SZA CLA /AND WHETHER DISK IS ALREADY
- TAD (FRMMSG-UNFMSG) /FORMATTED
- TAD (UNFMSG) /OR NOT.
- JMS TYPE
- TAD FAC /IF FACTORY LISTS ARE BAD,
- SZA CLA /TYPE A SPECIAL MESSAGE.
- JMP EE1
- TAD (BDFMSG) /"FACTORY LIST DESTROYED"
- JMS TYPE
- JMP EE2 /AND SKIP AROUND FACTORY BBL
- /PROCESSING.
-EE1, TAD (SERMSG) /IF FACTORY LISTS ARE GOOD,
- /PRINT PACK SERIAL NUMBER
- JMS TYPE
- TAD (FACTRY+3) /ADDR OF MSB
- DCA TMP1
- JMS DPSNH /DIGITS 9-5
- JMS DPSNH /DIGITS 4-0
- JMS CRLF
- TAD (FACTRY+7) /CONVERT FACTORY-DETECTED
- DCA AUTO1 /BAD BLOCK LIST FROM FACTORY
- TAD (FACTRY+7) /FORMAT (DEC STANDARD 144) TO
- DCA AUTO2 /TRACK/SECTOR FORMAT.
- JMS CONV1
- TAD (FACTRY+7) /CONVERT FACTORY-DETECTED BAD
- DCA AUTO1 /BLOCK LIST FROM TRACK/SECTOR
- TAD (FACTRY+7) /FORMAT TO 2-WD OS/8 FORMAT.
- DCA AUTO2
- JMS CONV2
- TAD (FACTRY+10) /PUT FACTORY-DETECTED BAD BLOCK
- JMS ORDER /LIST INTO ASCENDING ORDER AND
- /DELETE ANY DUPLICATE BLOCKS
- /CAUSED BY BOTH SECTORS BEING
- /BAD.
- JMS REPORT /TYPE BAD BLOCK LIST
- FACMSG /OF FACTORY-DETECTED
- FACTRY+10 /BAD BLOCKS.
-EE2, TAD FMT /IS DISK FORMATTED?
- SNA CLA
- JMP AA /NO - THERE ARE NO OLD OS/8 LISTS
- TAD (OLD-1) /YES - TRANSFER OLD OS/8 BAD
- DCA AUTO3 /BLOCK LISTS TO "OLD" LIST AND
- TAD (BBCTL-1) /CONVERT TO 2-WD OS/8 FORMAT.
- DCA AUTO2
-BBTRAN, TAD I AUTO2 /TRANSFER NEXT LIST (A,B,C)
- SNA
- JMP AB /DONE
- DCA AUTO1 /LIST ADDRESS
- TAD I AUTO2 /DEVICE CODE
- DCA TMP1
-BBTRNA, TAD I AUTO1 /TRANSFER NEXT ENTRY
- SNA /(0 IS OS/8 TERMINATOR)
- JMP BBTRAN /TRY NEXT LIST
- DCA TMP2
- TAD TMP1
- DCA I AUTO3 /STORE DEVICE CODE IN "OLD"
- TAD TMP2
- DCA I AUTO3 /STORE BLOCK IN "OLD"
- JMP BBTRNA /TRY NEXT ENTRY
-AB, STA /TERMINATE "OLD" LIST
- DCA I AUTO3
- TAD (OLD) /ORDER "OLD" LIST
- JMS ORDER
- JMS REPORT /TYPE BAD BLOCK LIST
- OLDMSG /OF OLD OS/8 BLOCKS
- OLD
-AA, TAD (NEW-1) /CONVERT NEWLY-FOUND BAD
- DCA AUTO1 /BLOCK LIST FROM TRACK/SECTOR
- TAD (NEW-1) /FORMAT TO 2-WD OS/8 FORMAT.
- DCA AUTO2
- JMS CONV2
- TAD (NEW) /ORDER "NEW" LIST
- JMS ORDER
- JMS REPORT /TYPE BAD BLOCK LIST
- NEWMSG /OF NEWLY-FOUND
- NEW /BAD BLOCKS.
- TAD FMT /FORMATTED DISK?
- SNA CLA
- JMP AA1 /NO
- TAD (NEW-1) /YES: FIND OUT IF THERE ARE
- DCA AUTO1 /ANY NEW BAD BLOCKS NOT LISTED
- /IN THE OLD LIST
- JMP AA2 /CONTINUE ON NEXT PAGE
-
- PAGE
- /CONTINUE FROM PREVIOUS PAGE
-AA2, TAD (OLD-1) /EXAMINE NEXT ENTRY IN "NEW"
- DCA AUTO2
- TAD I AUTO1
- SPA
- JMP AA1 /NO MORE ENTRIES IN "NEW"
- DCA TMP1 /DEVICE CODE
- TAD I AUTO1
- DCA TMP2 /BLOCK
- SKP
-AA3, ISZ AUTO2 /SKIP REST OF "OLD" ENTRY
-AA4, TAD I AUTO2 /SCAN "OLD" ENTRIES
- /IS THERE ANOTHER ENTRY?
- SPA
- JMP NEWFND /NO - A NEW ENTRY WAS FOUND
- /WHICH HAD NO CORRESPONDING OLD
- /ENTRY - TYPE WARNING MESSAGE.
- CIA /YES - DOES IT EQUAL THE NEW
- TAD TMP1 /ENTRY?
- SZA CLA
- JMP AA3 /NO, CONTINUE SCAN
- TAD I AUTO2 /TEST 2ND WORD OF ENTRY
- CIA
- TAD TMP2
- SZA CLA
- JMP AA4 /NO, CONTINUE SCAN
- JMP AA2 /YES - NEW BLOCK APPEARS IN
- /OLD LIST; TRY NEXT NEW ENTRY.
-
-NEWFND, CLA /A REALLY NEW BAD BLOCK
- TAD (ADDMSG) /HAS BEEN FOUND
- JMS TYPE
-AA1, CLA
- TAD FMT /IS DISK UNFORMATTED AND ALSO
- /WITHOUT A VALID FACTORY BBL?
- TAD FAC
- SNA CLA
- JMP EE3 /YES TO BOTH - SKIP MERGE PRO-
- /CEDURE SO THAT "NEW" WILL CON-
- /SIST ONLY OF NEWLY-FOUND BAD
- /BLOCKS.
- TAD FMT /IS DISK FORMATTED?
- SNA CLA
- TAD (FACTRY+7-OLD+1) /NO: MERGE FACTORY-
- /DETECTED BAD BLOCK LIST
- /INTO NEWLY-FOUND BAD BLOCK
- /LIST
- TAD (OLD-1) /YES: MERGE OLD OS/8 BAD
- /BLOCKS INTO NEW LIST
- DCA AUTO1
- TAD (NEW-1)
- DCA AUTO2
-AB1, TAD I AUTO2 /FIND END OF "NEW" LIST
- SPA CLA
- JMP AB2 /FOUND END
- ISZ AUTO2 /NOT YET
- JMP AB1
-AB2, STA /FOUND END; BACKUP POINTER
- TAD AUTO2 /TO POINT TO JUST BEFORE
- DCA AUTO2 /END OF "NEW" LIST
-AB4, TAD I AUTO1 /GET NEXT INPUT ENTRY
- SPA
- JMP AB3 /NO MORE ENTRIES TO MERGE
- DCA I AUTO2 /TACK INPUT ONTO END OF
- TAD I AUTO1 /"NEW" LIST
- DCA I AUTO2
- JMP AB4 /TRANSFER NEXT ENTRY
-AB3, DCA I AUTO2 /DONE MERGE; TERMINATE "NEW"
-EE3, TAD (NEW) /ORDER "NEW" AND DELETE
- JMS ORDER /DUPLICATE ENTRIES IF ANY.
- JMS REPORT /TYPE BAD BLOCK LIST
- FINMSG /OF OS/8 BAD BLOCKS ABOUT
- NEW /TO BE WRITTEN OUT.
- TAD (AANDB-1) /NEW LIST IS NOW COMPLETE.
- /PREPARE OS/8 LISTS FOR
- /WRITING ONTO DISK.
- /ZERO EACH LIST
- JMS ZERO
- TAD (C-1)
- JMS ZERO
- TAD (ID) /STORE ID CODES IN PROPER
- DCA AANDB /PLACES.
- TAD (ID)
- DCA C
- TAD (C+77)
- DCA AUTO1
- TAD (-100)
- DCA TMP1
- TAD (ID)
- DCA I AUTO1
- ISZ TMP1
- JMP .-3
- TAD (NEW) /TRANSFER NEW LIST TO PROPER
- DCA TMP3 /OS/8 LISTS PRIOR TO WRITING.
- TAD (BBCTL-1)
- DCA AUTO2
- JMP AD1A /TRANSFER FIRST LIST (A)
-AD1, CLA /TRANSFER NEXT LIST (B,C)
- DCA I AUTO3 /TERMINATE LAST LIST (A,B,C)
-AD1A, TAD I AUTO2
- SNA
- JMP ASK /DONE TRANSFER
- DCA AUTO3 /OS/8 LIST ADDRESS
- TAD I AUTO2
- DCA TMP1 /DEVICE CODE
- TAD (-20)
- DCA TMP2 /COUNTER - ONLY 15 BAD BLOCKS
- /ARE ALLOWED PER DEVICE.
- SKP /TRANSFER EACH ENTRY, THIS DEV.
-AD2, ISZ TMP3 /LOCATE TO NEXT ENTRY IN "NEW".
- TAD I TMP3 /GET DEV CODE - IS NEW ENTRY
- /SAME DEVICE AS
- /CURRENT OS/8 LIST BEING FILLED?
- SPA
- JMP AD1 /NO MORE ENTRIES IN "NEW"
- CIA /COMPARE DEVICES
- TAD TMP1
- SZA CLA
- JMP AD1 /DIFFERENT DEVICE; TRANSFER TO
- /NEXT OS/8 LIST.
- JMP AD4 /SAME DEVICE.
- /CONTINUE ON NEXT PAGE
-
- PAGE
- /CONTINUE FROM PREVIOUS PAGE
-AD4, ISZ TMP3 /LOCATE TO BLOCK NR.
- TAD TMP1 /CHECK TO SEE IF BAD BLOCK IS
- /IN THE RANGE 0-66 OCTAL ON
- SZA CLA /DEVICE A; IF SO, WARN USER NOT
- JMP AD3 /TO USE AS SYSTEM DEVICE.
- TAD I TMP3
- STL CIA /13-BIT NEGATE
- TAD (66) /13-BIT COMPARE
- SZL CLA /IS BLOCK LE 66?
- JMP AD3 /NO, IT'S OK
- TAD (ZERMSG) /YES, WARN USER
- JMS TYPE
-AD3, TAD I TMP3 /IGNORE ANY BLOCK ZERO (BLOCK
- /ZERO CANNOT BE REPRESENTED IN
- /OS/8 BAD BLOCK LISTS.)
- SNA
- JMP AD2 /IGNORE ZERO BLOCK
- DCA I AUTO3 /STORE IN OS/8 LIST A,B, OR C
- /(NON-ZERO BLOCK NR)
- ISZ TMP2 /16 BAD BLOCKS, THIS DEVICE?
- JMP AD2 /NO, TRANSFER NEXT ENTRY
- TAD (OVFMSG) /YES, WARN USER AND QUIT
- JMP ERROR
-ASK, TAD (FMTMSG) /WAIT FOR USER TO VERIFY
- /GOING AHEAD AND WRITING
- /OUT OS/8 BAD BLOCK LISTS.
- /"FORMAT DISK PACK?"
- JMS TYPE
- JMS GETKEY /WAIT FOR KEY
- DCA TMP1
- JMS GETKEY /WAIT FOR RETURN
- TAD (-15)
- SZA CLA
- JMP ASK
- JMS CRLF
- TAD TMP1
- ZZ="Y&177
- TAD (-ZZ) /TEST FOR "Y" (YES)
- SZA CLA
- JMP RE
- RLDC /GO-AHEAD RECEIVED: CHECK FOR WRITE-LOCK.
- /CLEAR CONTROLLER.
- TAD (BYTE RLST)
- JMS IO /DO "GET STATUS" COMMAND.
- JMP FATAL /ERROR: CANNOT HAPPEN.
- RRSI /IGNORE BYTE #1.
- RRSI /GET BYTE #2.
- BSW /BIT [40] IS WRITE-LOCK BIT.
- SPA CLA /IS WRITE-LOCK ENABLED?
- JMS REMOVE /YES: ASK USER TO DISABLE.
- JMS RL01 /NO: DO ACTUAL FORMATTING.
- /ACTUAL FORMATTING: WRITE
- /OUT ALL OS/8 BAD BLOCK
- /LISTS. CALL INTERNAL HANDLER
- /FOR EACH LIST WRITTEN.
- RLWR /FUNCTION=WRITE
- AANDB /A AND B LISTS
- 0 /TRACK=0
- 14 /SECTOR=14
- JMP FATAL /ERROR RETURN
- JMS RL01
- RLWR /FUNCTION=WRITE
- C /C LIST
- 0 /TRACK=0
- 16 /SECTOR=16
- JMP FATAL /ERROR RETURN
- TAD (DNMSG) /TYPE "DONE"
- JMS TYPE
- JMP RE /AND ASK FOR NEXT PACK.
-
-
-
-/SUBROUTINE TO ASK USER TO DISABLE WRITE-LOCK
-REMOVE, 0
-REMOV1, TAD (WRMSG)
- JMS TYPE
- JMS GETKEY
- TAD (-15) /WAIT FOR RETURN.
- SZA CLA
- JMP REMOV1 /IGNORE ANY OTHER KEY.
- JMP I REMOVE
- /CONVERSION SUBROUTINES
-
-/SUBROUTINE TO CONVERT FROM FACTORY FORMAT (DEC STANDARD 144)
-/TO TRACK/SECTOR FORMAT
-/INPUT: AUTO1=INPUT LIST-1
-/ AUTO2=OUTPUT LIST-1
-CONV1, 0
-CONV1A, TAD I AUTO1 /CYLINDER BYTE
- AND (377) /HARDWARE SHOULD DO THIS!
- DCA TMP1
- TAD I AUTO1 /DOUBLE DENSITY BIT
- AND (377) /HARDWARE SHOULD DO THIS!
- CLA /IGNORE
- TAD I AUTO1 /SECTOR BYTE
- AND (377) /HARDWARE SHOULD DO THIS!
- DCA TMP2
- TAD I AUTO1 /SURFACE BIT
- AND (377) /HARDWARE SHOULD DO THIS!
- CLL RAR
- SZA CLA /TEST FOR END OF LIST
- JMP CONV1B /DONE
- TAD TMP1 /CONSTRUCT TRACK
- RAL
- DCA I AUTO2 /STORE TRACK
- TAD TMP2
- AND (77)
- DCA I AUTO2 /STORE SECTOR
- JMP CONV1
-CONV1B, STA /TERMINATE OUTPUT LIST
- DCA I AUTO2
- JMP I CONV1
-
- PAGE
- /SUBROUTINE TO CONVERT FROM TRACK/SECTOR FORMAT
-/TO 2-WD OS/8 FORMAT
-/INPUT: AUTO1=INPUT LIST-1
-/ AUTO2=OUTPUT LIST-1
-CONV2, 0
-CONV2C, TAD I AUTO1
- DCA TMP1 /TRACK
- TAD I AUTO1
- DCA TMP2 /SECTOR
- TAD TMP1 /TEST FOR END OF LIST
- SPA CLA
- JMP CONV2D /DONE
- TAD TMP2 /TEST FOR DEVICE C
- CLL RAR
- SZL
- JMP CONV2A /MUST BE A OR B
- TAD (-10)
- SMA CLA
- JMP CONV2A /MUST BE A OR B
- TAD TMP1 /MUST BE C; TEST FOR ILLEGAL
- /BAD BLOCKS.
- SNA CLA
- JMP CONV2C /ILLEGAL: TRACK 0; IGNORE
- TAD (-777)
- SNA CLA
- JMP CONV2C /ILLEGAL: TRACK 777; IGNORE
- TAD TMP2 /CONVERT DEVICE C BLOCK
- CLL RTR
- DCA TMP2 /BITS [3] SO FAR
- TAD TMP1
- AC0002
- DCA I AUTO2 /STORE DEVICE CODE FOR C
- STA
- TAD TMP1
- CLL RTL /BITS [3774]
- TAD TMP2 /BITS [3777]
-CONV2B, DCA I AUTO2 /STORE BLOCK NUMBER
- JMP CONV2C /CONVERT NEXT ENTRY
-CONV2A, CLA /PROCESS DEVICES A AND B
- TAD TMP2 /CONVERT BLOCK NR
- CLL RAR
- SZL
- TAD (24)
- TAD (-10)
- CLL RAR
- DCA TMP2 /BITS [17] SO FAR
- TAD TMP1
- CLL RTL
- RTL /LINK=DEVICE NR (A=0, B=1)
- /BITS [7760]
- TAD TMP2 /BITS [7777]
- DCA TMP1
- RAL /GET DEVICE CODE
- DCA I AUTO2 /STORE DEVICE CODE FOR A OR B
- TAD TMP1
- JMP CONV2B /STORE BLOCK NR
-
-CONV2D, STA /TERMINATE OUTPUT LIST
- DCA I AUTO2
- JMP I CONV2
-
-/SUBROUTINE TO ZERO A PAGE CONTAINING AN OS/8 BAD
-/BLOCK LIST
-/INPUT: AC=ADDRESS OF LIST-1
-ZERO, 0
- DCA AUTO1
- TAD (-200)
- DCA TMP1
- DCA I AUTO1
- ISZ TMP1
- JMP .-2
- JMP I ZERO
-
-/SUBROUTINE TO ORDER A 2-WD OS/8 BAD BLOCK LIST AND
-/DELETE DUPLICATE ENTRIES IF ANY
-/INPUT: AC=ADDRESS OF LIST
-ORDER, 0
- DCA TMP1
- AC7776
- TAD TMP1
- DCA TMP2 /FOR EACH TMP2, ALL TMP3 WILL
- /BE COMPARED TO DETERMINE
- /MINIMUM VALUE
-ORDERA, AC0002 /FIND MINIMUM OF REMAINING
- /ENTRIES IN LIST
- TAD TMP2
- DCA TMP2
- TAD I TMP2
- SPA CLA
- JMP DD /DONE; DELETE DUPLICATES
- TAD TMP2 /START WITH CURRENT ENTRY
- DCA TMP3 /AND COMPARE WITH REST
-ORDERB, AC0002 /COMPARE WITH NEXT ENTRY
- TAD TMP3
- DCA TMP3
- TAD I TMP3
- SPA CLA
- JMP ORDERA /NO MORE REMAINING ENTRIES;
- /ORDER NEXT ENTRY
- TAD I TMP3 /COMPARE DEVICE CODES
- CIA /12-BIT COMPARE
- TAD I TMP2
- SPA SNA
- JMP ORDERD /COMPARE 2ND WORD
-ORDERC, CLA /DISORDERED; INTERCHANGE ENTRIES
- TAD TMP2
- DCA TMP4
- TAD TMP3
- DCA TMP5
- JMS EXCH
- ISZ TMP4
- ISZ TMP5
- JMS EXCH
- JMP ORDERB /CONTINUE COMPARING TO FIND
- /MINIMUM ENTRY
-
-/RETURN FROM "ORDER"
-DD2, DCA I TMP2 /STORE TERMINATOR
- JMP I ORDER /AND RETURN
-
-/SUBROUTINE TO INTERCHANGE TWO ENTRIES
-EXCH, 0
- TAD I TMP4
- DCA TMP6
- TAD I TMP5
- DCA I TMP4
- TAD TMP6
- DCA I TMP5
- JMP I EXCH
-
- PAGE
- /CONTINUATION OF ORDERING SUBROUTINE
-ORDERD, SZA CLA /COMPARE DEVICE CODES
- JMP ORDERB /ALREADY ORDERED OK
- TAD TMP2 /PREPARE TO COMPARE 2ND WORD
- DCA AUTO2 /(BLOCK NR)
- TAD TMP3
- DCA AUTO3
- TAD I AUTO3
- STL CIA /13-BIT NEGATE
- TAD I AUTO2 /13-BIT COMPARE
- SNL SZA
- JMP ORDERC /DISORDERED; INTERCHANGE
- SZA CLA
- JMP ORDERB /ALREADY ORDERED OK
- AC2000 /DEVICE CODE AND BLOCK NR
- /BOTH EQUAL: A DUPLICATE ENTRY!
- /SET EARLIER COPY TO SPECIAL
- /VALUE (2000); LATER IT WILL
- /BE DELETED FROM LIST.
- DCA I TMP2
- JMP ORDERA /CONSIDER IT ORDERED AND
- /ORDER NEXT ENTRY.
-DD, TAD TMP1 /LIST IS NOW ORDERED. SCAN
- /LIST, COMPRESSING OUT ANY
- /"2000" VALUES (DUPLICATE
- /ENTRIES).
- /INITIAL OUTPUT IS INPUT
- DCA TMP2
-DD1, TAD I TMP1 /SCAN NEXT ENTRY
- SPA
- JMP DD2 /DONE
- TAD (-2000) /TEST FOR DUPLICATE
- SZA CLA
- JMP DD3 /NO - COPY OVER
- ISZ TMP1 /YES - IGNORE IT
- ISZ TMP1
- JMP DD1
-DD3, TAD I TMP1 /COPY OVER INPUT TO OUTPUT
- DCA I TMP2 /TO COMPRESS LIST.
- ISZ TMP1
- ISZ TMP2
- TAD I TMP1
- DCA I TMP2
- ISZ TMP1
- ISZ TMP2
- JMP DD1 /SCAN NEXT ENTRY
- /SUBROUTINE TO REPORT (TYPE) A BAD BLOCK LIST
-REPORT, 0
- TAD (-4-1) /MAX ENTRIES ON FIRST LINE
- DCA TMP2
- TAD I REPORT /ADDR OF HEADING MESSAGE
- JMS TYPE
- TAD (BBMSG) /"BAD BLOCKS:"
- JMS TYPE
- ISZ REPORT
- TAD I REPORT /ADDRESS OF LIST
- DCA TMP1
- ISZ REPORT
- TAD I TMP1 /IS LIST NULL?
- SMA CLA
- JMP REP2 /NO
- TAD (NNMSG) /YES - TYPE "NONE"
- JMS TYPE
-REP3, JMS CRLF /DONE
- JMP I REPORT
-REP2, TAD I TMP1 /TYPE NEXT ENTRY
- SPA CLA
- JMP REP3 /NONE - DONE
- ISZ TMP2 /IS OUTPUT LINE FILLED?
- JMP REP4 /NO
- TAD (-10) /YES, PRINT CRLF
- /MAX ENTRIES ON SUCCEEDING LINES
- DCA TMP2
- JMS CRLF
-REP4, TAD I TMP1 /VALID ENTRY: TYPE IT
- TAD ("A) /CONVERT DEVICE CODE TO
- /DEVICE LETTER AND TYPE IT.
- JMS PRINT /"A","B","C"
- JMS PRINTB /SPACE
- ISZ TMP1
- TAD I TMP1 /BLOCK NR
- JMS PRINTN /PRINT AS OCTAL NR
- JMS PRINTB /2 SPACES
- JMS PRINTB
- ISZ TMP1 /NEXT ENTRY
- JMP REP2 /TYPE NEXT ENTRY
- /SUBROUTINE TO PRINT 5 DIGITS OF SERIAL NUMBER
-DPSNH, 0
- TAD I TMP1
- RAR
- JMS DPSNT /DIGITS 9-8, 4-3
- TAD I TMP1
- RAR /LINK=MSB OF DIGIT 7 OR 2
- STA CML /BACKUP BYTE POINTER AND
- /CORRECT LINK FOR OVERFLOW.
- TAD TMP1
- DCA TMP1
- RTL /LINK TO BIT [4].
- RAL
- DCA TMP2
- TAD I TMP1
- BSW
- AND (3) /BITS [3].
- TAD TMP2 /BITS [7].
- JMS DPSND /DIGIT 7, 2
- TAD I TMP1
- JMS DPSNT /DIGITS 6-5, 1-0
- STA
- TAD TMP1
- DCA TMP1
- JMP I DPSNH
-
-/SUBROUTINE TO PRINT 2 DIGITS OF SERIAL NUMBER
-DPSNT, 0
- DCA TMP2
- TAD TMP2
- RTR
- RAR
- JMS DPSND /2ND SIG. DIGIT
- TAD TMP2
- JMS DPSND /1ST SIG. DIGIT
- JMP I DPSNT
-
-/SUBROUTINE TO PRINT OCTAL DIGIT
-DPSND, 0
- AND (7)
- TAD ("0)
- JMS PRINT
- JMP I DPSND
-
- PAGE
- /FATAL I/O ERROR ROUTINE
-FATAL, TAD (FAMSG)
- JMP ERROR /"FATAL I/O ERROR" AND QUIT.
-
-/SUBROUTINE TO READ-CHECK EVEN OR ODD SECTORS
-/ON ONE TRACK
-RCSUB, 0
- DCA RCSECT
- TAD (-24) /NUMBER OF SECTORS
- DCA TMP1
-RCLOOP, JMS RL01 /PERFORM READ
- RLRD
- X /MA (DON'T CARE)
-RCTRK, 0 /TRACK
-RCSECT, 0 /SECTOR
- JMS RCBAD /ERROR RETURN: ADD BLOCK
- /TO "NEW" BAD BLOCK LIST
- ISZ RCSECT /NORMAL RETURN: INCREMENT
- ISZ RCSECT /SECTOR
- ISZ TMP1
- JMP RCLOOP
- JMP I RCSUB /DONE
-
-/SAVE TRACK/SECTOR OF NEWLY-FOUND BAD BLOCK
-RCBAD, 0
- TAD RCTRK
- DCA I AUTO3
- TAD RCSECT
- DCA I AUTO3
- ISZ BADCNT /ONLY ALLOW 64
- JMP I RCBAD
- TAD (TOOMSG) /OVER 63 BAD BLOCKS
-ERROR, JMS TYPE /SEVERE ERROR ENTRY POINT
- TAD (ERRMSG) /"CANNOT FORMAT DISK"
- JMS TYPE
- JMP RE /RESTART ("DRIVE?")
-BADCNT, 0
- /TERMINAL SUPPORT SUBROUTINES
-
-/FUNCTIONS:
-/TYPE TYPE A STRING WHOSE ADDR IS IN AC (UNDERLINE
-/ MEANS CRLF, 00 TERMINATES).
-/GETKEY WAIT FOR A KEY, GET AND ECHO THE 7-BIT ASCII VALUE.
-/PRINT PRINT ASCII CHAR.
-/PRINTN PRINT OCTAL CONTENTS OF AC.
-/CRLF PRINT RETURN/LINE FEED COMBINATION.
-/PRINTB PRINT A BLANK CHAR.
-
-/INTERESTING LOCATIONS:
-/TEMP TEMP STORAGE
-/KEY LAST KEY TYPED
-
-TYPE, 0
- DCA TEMP
- CLL
-TY1, TAD I TEMP
- SNL
- BSW
- AND (77)
- SNA
- JMP I TYPE
- TAD (-37) /TEST FOR UNDERLINE CHAR
- SZA
- JMP TY2
- JMS CRLF
- JMP TY3
-TY2, TAD (277)
- AND (277)
- TAD (240)
- JMS PRINT
-TY3, SNL CLA
- ISZ TEMP
- JMP TY1
-
-GETKEY, 0
- KSF
- JMP .-1
- JMS LOOK
- JMS PRINT
- TAD KEY
- JMP I GETKEY
-
-LOOK, 0
- KRB
- AND (177)
- DCA KEY
- TAD KEY
- TAD (-3)
- SNA CLA
- JMP I (7605)
- TAD KEY
- JMP I LOOK
-
-PRINTN, 0
- DCA 0
- TAD (-4)
- DCA TEMP
-PR1, TAD 0
- RTL; RAL
- DCA 0
- TAD 0
- RAL
- AND (7)
- TAD (260)
- JMS PRINT
- ISZ TEMP
- JMP PR1
- JMP I PRINTN
-
-PRINT, 0
- TLS
- TSF
- JMP .-1
- CLA
- KSF
- JMP I PRINT
- JMS LOOK
- CLA
- JMP I PRINT
-
-CRLF, 0
- TAD (215)
- JMS PRINT
- TAD (212)
- JMS PRINT
- JMP I CRLF
-
-PRINTB, 0
- TAD (240)
- JMS PRINT
- JMP I PRINTB
-
-/LITERALS
- PAGE
- /SUBROUTINE TO TRANSFER DATA TO/FROM RL01 DISK
-/NOTE: ONLY ONE TRY IS ATTEMPTED!
-RL01, 0
- TAD I RL01 /GET ARGUMENTS: FUNCTION
- DCA FNC
- ISZ RL01
- TAD I RL01 /MA
- DCA MA
- ISZ RL01
- TAD I RL01 /TRACK
- DCA TRACK
- ISZ RL01
- TAD I RL01 /SECTOR
- BSW /CONVERT TO RL8A FORMAT
- DCA SECTOR
- ISZ RL01
- TAD TRACK /CALCULATE CYLINDER AND
- CLL RAR /SURFACE FROM TRACK
- DCA CYL
- RTR
- DCA SURF
- JMS TRKCMP /COMPARE WITH CURRENT
- /TRACK; IF SAME, DO THE
- /TRANSFER
-RETRY, RLDC /IF DIFFERENT, SEEK TO
- /REQUESTED TRACK
- /CLEAR CONTROLLER, AC
-SEEK, IAC /SEEK WHEN CALLED FROM
- /BELOW, ELSE RESET DRIVE
- /REGISTERS (AC=1 TO RESET,
- /AC=3 TO SEEK)
- JMS IO /RESET DRIVE OR SEEK
- JMP RETRY /ERROR RETURN
- TAD (BYTE RLRH) /NORMAL RETURN:
- /READ NEXT HEADER TO FIND
- /CURRENT TRACK
- JMS IO
- JMP RETRY /ERROR RETURN
- RRSI /NORMAL RETURN:
- /GET HEADER BYTE #1
- BSW
- AND (3)
- DCA CURTRK /SAVE 2 LSB
- RRSI /GET HEADER BYTE #2
- AND (377) /HARDWARE SHOULD DO THIS
- CLL RTL
- TAD CURTRK /ADD IN MSB
- DCA CURTRK
- JMS TRKCMP /COMPARE WITH CURRENT
- /TRACK; IF SAME, DO THE
- /TRANSFER
- TAD CURTRK /OFF TRACK: SEEK TO TRACK.
- CLL RAR /CONSTRUCT DIFFERENCE WORD FOR SEEK.
- CIA
- TAD CYL
- SMA
- JMP AROUND
- CIA
- SKP
-AROUND, TAD (4000) /SET DIRECTION BIT IF TO HIGHER
- /CYLINDER ADDRESS.
- TAD SURF /ADD SURFACE BIT
- RLCA /LOAD DIFFERENCE WORD
- AC0002 /PREPARE FOR SEEK
- JMP SEEK /LOOP BACK AND SEEK; THIS
- /ENSURES THAT THE TRACK REACHED
- /IS THE CORRECT ONE IN SPITE
- /OF POSSIBLE RL01 SEEK
- /UNRELIABILITY
- /SUBROUTINE TO COMPARE REQUESTED TRACK WITH CURRENT
-/(REMEMBERED) TRACK; IF SAME, DO TRANSFER. IF DIFFERENT,
-/RETURN WITH AC=REQUESTED-CURRENT, LINK=1
-TRKCMP, 0
- TAD CURTRK
- CIA
- TAD TRACK
- SZA CLA
- JMP I TRKCMP /DIFFERENT; RETURN
- TAD SECTOR /SAME: DO TRANSFER
- /LOAD ALL REGISTERS
- RLSA
- TAD FNC /WC IS DOUBLED FOR BYTE MODE
- AND (BYTE)
- SZA CLA
- TAD (-200) /2 PAGES
- TAD (-200) /1 PAGE
- RLWC
- TAD SURF /HARDWARE SHOULD DO THIS
- TAD CYL
- RLCA
- TAD MA
- RLMA
- TAD FNC
- JMS IO /READ OR WRITE ONE SECTOR
- JMP I RL01 /ERROR: TAKE ERROR RETURN
- ISZ RL01 /TAKE NORMAL EXIT
- JMP I RL01
- /SUBROUTINE TO DO RL01 I/O
-IO, 0
- TAD DRIVE
- RLCB /DO I/O OPERATION
-WAIT, CLA /IN CASE NO RL01 PRESENT
- KSF /WAIT UNTIL DONE
- /RETURN TO MONITOR IF
- /USER TYPES CTRL,C
- JMP WAIT2
- TAD (7600)
- KRS
- TAD (-7603)
- SNA CLA
- JMP I (MON)
-WAIT2, RLSD
- JMP WAIT
- RLSE
- ISZ IO /NORMAL RETURN
- JMP I IO /ERROR RETURN
- /DATA
-TRACK, 0 /REQUESTED TRACK
-CURTRK, 2000 /CURRENT TRACK (INITIALLY
- /ILLEGAL TO FORCE HEADER
- /READ AND SEEK IF NECESSARY)
-SECTOR, 0
-CYL, 0
-SURF, 0
-FNC, 0
-MA, 0
-
- PAGE
- /TEXT STRINGS
-
-IDMSG, TEXT "RLFRMT V??_"
- *.-2
- VERSION+60^100+PATCH
- *.+2
-MSG, TEXT "_DRIVE ? "
-BDMSG, TEXT "_PLEASE SPECIFY DRIVE NUMBER (0-3) ON WHICH_"
- *.-1
- TEXT "PACK TO BE FORMATTED IS MOUNTED._"
-FAMSG, TEXT "_FATAL I/O ERROR"
-SERMSG, TEXT " DISK PACK SERIAL NUMBER "
-TOOMSG, TEXT "_OVER 63 NEWLY-FOUND BAD BLOCKS"
-ERRMSG, TEXT "_CANNOT FORMAT DISK_"
-ADDMSG, TEXT "_WARNING: AN ADDITIONAL BAD BLOCK FOUND."
- *.-1
- TEXT "_ZERO DISK BEFORE USE!_"
-OVFMSG, TEXT "_OVER 15 BAD BLOCKS ON ONE DEVICE"
-ZERMSG, TEXT "_WARNING: BAD BLOCK IN SYSTEM AREA._DO NOT USE AS SYSTEM DISK!_"
-UNFMSG, TEXT "_UNFORMATTED (NEW)"
-FRMMSG, TEXT "_OS/8 (OLD)"
-BDFMSG, TEXT " DISK._WARNING: ALL FACTORY-WRITTEN LISTS DESTROYED._"
-FACMSG, TEXT "_FACTORY-DETECTED"
-OLDMSG, TEXT "_PREVIOUS OS/8"
-NEWMSG, TEXT "_NEWLY-FOUND"
-FINMSG, TEXT "_NEW OS/8"
-BBMSG, TEXT " BAD BLOCKS: "
-NNMSG, TEXT "NONE"
-FMTMSG, TEXT "_FORMAT PACK WITH THIS NEW LIST? "
-DNMSG, TEXT "_DONE_"
-WRMSG, TEXT "_PLEASE WRITE-ENABLE DRIVE, THEN HIT 'RETURN'._"
-
-/OTHER DATA
-BBCTL, AANDB /OS/8 BAD BLOCK CONTROL LIST
- /LIST ADDRESS
- 0 /DEVICE CODE
- AANDB+20 /LIST ADDRESS
- 1 /DEVICE CODE
- C /LIST ADDRESS
- 2 /DEVICE CODE
- 0 /TERMINATOR
-
-FACCTL, FACTRY+3 /CONTROL LIST TO CHECK VALIDITY
- /OF FACTORY-WRITTEN BBLS.
- /POINTER BEFORE 4 BYTES TO TEST.
- 0 /VALUE TO TEST FOR.
- FACTRY+373 /POINTER.
- 377 /VALUE.
- 0 /TERMINATOR.
-
-$
DELETED src/os8-v3f/RLSY.PA
Index: src/os8-v3f/RLSY.PA
==================================================================
--- src/os8-v3f/RLSY.PA
+++ /dev/null
@@ -1,523 +0,0 @@
-/RLSY: RL01 SYSTEM HANDLER
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /RL01 SYSTEM HANDLER
-
- VERSION="A&77
-
-/NOTES:
-/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.
-
-/EDIT HISTORY:
-/21-OCT-77 DAVID SPECTOR: CREATION
-
-/INSTRUCTIONS THAT GENERATE CONSTANTS
-
-AC0001=CLA IAC
-AC0002=CLA CLL CML RTL
-AC0003=CLA CLL CML IAC RAL /*
-AC0004=CLA CLL IAC RTL /*
-AC0006=CLA CLL CML IAC RTL /*
-AC0100=CLA IAC BSW /*
-AC2000=CLA CLL CML RTR
-AC3777=CLA CLL CMA RAR
-AC4000=CLA CLL CML RAR
-AC5777=CLA CLL CMA RTR
-AC6000=CLA CLL CML IAC RTR /*
-AC7775=CLA CLL CMA RTL
-AC7776=CLA CLL CMA RAL
-
-/* USE ONLY ON VT-78 AND PDP-8E,F,M,A
-
-/ID CODE AT START OF BAD BLOCK LIST (BBL)
- ID=123
- /RL01 DEFINITIONS
-
-RLIOT=6600
-RLDC=RLIOT 0 /CLEAR DEVICE
-RLSD=RLIOT 1 /SKIP IF DONE
-RLMA=RLIOT 2 /LOAD MEM ADDR
-RLCA=RLIOT 3 /LOAD REGISTER "A"
-RLCB=RLIOT 4 /LOAD REG "B" AND EXECUTE
-RLSA=RLIOT 5 /LOAD SECTOR ADDR
- /RLIOT 6 UNUSED
-RLWC=RLIOT 7 /LOAD WORD COUNT
-RRER=RLIOT 10 /READ ERROR REG
-RRWC=RLIOT 11 /READ WORD COUNT
-RRCA=RLIOT 12 /READ REG "A"
-RRCB=RLIOT 13 /READ REG "B"
-RRSA=RLIOT 14 /READ SECTOR ADDR
-RRSI=RLIOT 15 /READ SILO BYTE
- /RLIOT 16 UNUSED
-RLSE=RLIOT 17 /SKIP IF ERROR
-/RLCB FUNCTION BITS:
- RLMT=0 /MAINTENANCE MODE
- RLRE=1 /RESET DRIVE ERRORS
- RLST=2 /READ STATUS REGS INTO SILO
- RLSK=3 /SEEK
- RLRH=4 /READ HEADER
- RLWR=5 /WRITE
- RLRD=6 /READ
- RLRN=7 /READ WITH NO HEADER CHECK
-/BIT DEFINITIONS IN REGISTERS:
-BYTE=1000 /BYTE TRANSFER MODE
- /HEADER BLOCK FOR USE BY "BUILD"
-
- *0
- -2 /- NR. OF ENTRY POINTS
-
-/FORMAT OF ENTRIES IN HEADER BLOCK:
-/WORD DESCRIPTION
-/1 GROUP NAME (4 CHAR)
-/3 DEVICE NAME (4 CHAR)
-/5 DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE,
-/ NO MULTIPLE PLATTERS
-/6 2-PAGE/SYS/CORESIDENT INDICATOR, OFFSET
-/7 0 (UNUSED WORD)
-/10 NUMBER OF BLOCKS IN DEVICE
-
-DEVICE RLSY;DEVICE SYS;4260;SYS&177+6000;0;7761
-DEVICE RLSY;DEVICE RL0A;4260;SYS&177+5000;0;7761
-/DEVICE RLSY;DEVICE RL0B;4260;RL0B&177+5000;0;7761
- /RL01 SECONDARY BOOTSTRAP
-
-/SYSTEM MAP:
-/BLOCK CYL. SURF. SECTOR CONTENTS
-/0 0 0 20 SECONDARY BOOTSTRAP
-/0 0 0 22 FIELD 0 RESIDENT
-/66 1 1 1 FIELD 1 RESIDENT
-/66 1 1 3 FIELD 2 RESIDENT
-
-/RESIDENT MONITOR CODE OCCUPIES LAST PAGE OF FIELD
-/FIELD 0 PAGE IS MONITOR CODE AND SYSTEM HANDLER
-/FIELD 1 PAGE IS MONITOR TABLES
-/FIELD 2 PAGE IS SYSTEM HANDLER
-
- BOOTA-BOOTB /-LENGTH FOR "BUILD"
-
- RELOC 0 /WILL RUN AT 00000
-
-BOOTA, /START OF BOOTSTRAP CODE
-
-/DATA
-C16, 16
-C26, 26
-C300, 300
-C2001, 2001
-C6001, 6001
-C7600, 7600
-C7605, 7605
-SECT, 2200 /INITIAL BLOCK 0 VALUE
-SURCYL, 0 /INITIAL BLOCK 0 VALUE
-
- ZBLOCK 31-2-. /LOCATE "IOSUB" (SEE BELOW)
-
-FUNC, /TEMPORARY STORAGE FOR RL01
- /FUNCTION WORD
-IOSUB, BOOT /SUBROUTINE TO DO I/O; MATCHES
- /SIMILAR SUBR IN PRIMARY BOOTSTRAP
- /INITIAL VALUE WILL START SEC-
- /ONDARY BOOTSTRAP WHEN IT HAS BEEN
- /COMPLETELY READ IN.
- RLCB /EXECUTE RL01 FUNCTION
- RLSD /WAIT UNTIL DONE. NOTE: THIS WORD
- /AND THE NEXT ONE MUST BE IN THE
- /SAME LOCATIONS AS THEIR COUNTER-
- /PARTS IN THE PRIMARY BOOTSTRAP.
- JMP .-1
- RLSE
- JMP I IOSUB /NO ERRORS: RETURN
- JMP . /ERROR OCCURRED: LOOP IN PLACE AS
- /A CLEAR INDICATION THAT BOOTSTRAP
- /OPERATION FAILED.
-
-/START OF SECONDARY BOOTSTRAP OPERATIONS
-BOOT, AC0006 /AC=READ FUNCTION
- JMS READ /READ FIELD 0 RESIDENT
- RLDC /CLEAR CONTROLLER REGISTERS IN
- /PREPARATION FOR SEEK
- TAD C6001 /DIFFERENCE WORD FOR CYL 1 SURF 1
- RLCA /LOAD "A"
- AC0003 /AC=SEEK FUNCTION
- JMS IOSUB /SEEK
- AC0100 /AC=SECTOR 1
- DCA SECT
- TAD C2001 /AC=CYL 1 SURF 1
- DCA SURCYL
- TAD C16 /AC=READ FUNCTION
- JMS READ /READ FIELD 1 RESIDENT
- TAD C300 /AC=SECTOR 3
- DCA SECT
- TAD C26 /AC=READ FUNCTION
- JMS READ /READ FIELD 2 RESIDENT
- CDF 00 /JUST IN CASE
- JMP I C7605 /START KEYBOARD MONITOR
-
-/SUBROUTINE TO READ ONE SECTOR INTO ONE PAGE
-READ, 0
- DCA FUNC /SAVE FUNCTION WORD
- TAD SECT
- RLSA /LOAD SECTOR ADDRESS
- TAD C7600
- RLWC /LOAD WORD COUNT
- TAD SURCYL
- RLCA /LOAD REGISTER "A"
- TAD C7600
- RLMA /LOAD MA (ALL READS ARE INTO
- /LAST PAGE OF FIELDS)
- TAD FUNC /RETRIEVE FUNCTION WORD
- JMS IOSUB /DO THE READ
- JMP I READ /NO ERROR: RETURN
-
-BOOTB, /END OF BOOTSTRAP CODE
-
- RELOC
- /RL01 SYSTEM HANDLER CODE
-
- *200
- RELOC 7600
-
- ZBLOCK 7 /REQUIRED BY BUILD
-
-/ENTRY POINT FOR SYS
-SYS, VERSION
- CLA
-SWITCH, JMP START /CHANGED TO "JMP SET"
- /BY ONCE-ONLY CODE AT "START"
- 3 /THIS IS A FLAG TO OS/8 THAT
- /THIS IS A 2-PAGE HANDLER.
-
-/----- BAD BLOCK LIST (BBL) STARTS HERE
-/ AND CONTINUES FOR 21 OCTAL LOCATIONS
-
-BBL,
-
-/ONCE-ONLY DATA
-JMPSET, JMP SET
-COUNT, -10
-ADDR, BARG
-ABRTN, BRTN
-ACDIF, CIF CDF 00
-
-/ONCE-ONLY PARAMETERS FOR 2ND PAGE TO READ IN
-/THE BAD BLOCK LIST (BBL) FOR DEVICE RL0A
-LIST, ARTN /BARG: RETURN TO SELF
- 1400 /SECTOR: SECTOR 14
- 0 /TRACK: 0
- BBL /MA: MA
- 200 /PAGES: 1 PAGE COUNT
- RLRD /FNC: READ FUNCTION
- -21 /WC: LENGTH OF READ
- 2000 /CURTRK: FORCE HEADER READ
- /ONCE-ONLY CODE TO READ IN BAD BLOCK LIST (BBL)
-
-START, RDF /ONCE-ONLY CODE. DESTROYED WHEN
- /BBL IS READ IN ON TOP OF IT.
- /FIRST, SAVE CALLING FIELD OVER
- /THE READ-IN OF THE BBL.
- TAD BACK /(INITIALLY CONTAINS A CDF)
- DCA BACK
- TAD JMPSET /NEXT, RESET "SWITCH" TO SKIP
- /AROUND ONCE-ONLY CODE FROM
- /NOW ON.
- DCA SWITCH
- CDF 20
-LOOP, TAD LIST /RESET ONCE-ONLY DATA IN 2ND PAGE
- DCA I ADDR /(THIS IS REQUIRED BECAUSE "BUILD"
- ISZ LOOP /DOESN'T ALLOW ONCE-ONLY CODE IN
- ISZ ADDR /2ND PAGE OF 2-PAGE SYSTEM HANDLERS)
- IFNZRO .-7642 <KLUDGE:>
- CDF 20 /******** MUST BE AT LOCATION 7642
- /******** FOR FRTS.SV!
- ISZ COUNT
- JMP LOOP
- TAD ACDIF /ANOTHER ONCE-ONLY RESET
- DCA I ABRTN
- JMS GO /READ IN BBL
-BACK, CDF /RESTORE CALLING FIELD
-
-/----- ONCE-ONLY CODE ENDS HERE
-
-/FALL THROUGH TO SET UP AND DO THE TRANSFER
- /SET UP AND DO THE TRANSFER
-SET, TAD BASE /INITIALIZE BAD BLOCK
- /MAPPING
- DCA MAP
- TAD SYS /ADDR OF ARG LIST
- JMS GO /CALL 2ND PAGE SETUP SUBROUTINE
- /DATA FIELD IS 2 ON RETURN
-MAP, TAD /MAP AROUND BAD BLOCKS, IF
- /ANY. LOOK AT NEXT BAD BLOCK.
- SNA /IF 0, TERMINATOR
- JMP MAPPED
- STL CIA /IF NOT, 13-BIT NEGATE
- TAD I ABLOCK /SUBTRACT FROM CURRENT BLOCK
- SZL CLA /SKIP IF BLOCK IS GREATER THAN
- /OR EQUAL TO BAD BLOCK
- JMP MAPPED /ELSE NO MAPPING TO DO
- ISZ MAP
-NEXT, ISZ I ABLOCK /INCREMENT CURRENT BLOCK,
- /EITHER DURING TRANSFER OR
- /TO MAP AROUND BAD BLOCK
- JMP MAP /CONTINUE MAPPING UNTIL DONE
- CIF 20 /IF BLOCK EVER OVERFLOWS TO 0,
- JMP ERROR /TAKE ERROR RETURN.
-
-MAPPED, TAD I ABLOCK /CALCULATE TRACK AND SECTOR
- /FROM BLOCK
- RTR
- RTR
- AND A377
- DCA I ATRACK
- TAD I ABLOCK
- AND A17
- CLL RTL
- TAD A7751
- SPA
- TAD A47
- BSW
- DCA I ASECT
- JMS GO /TRANSFER 1ST PAGE OF BLOCK
- TAD A200 /INCREMENT MA AND SECTOR
- TAD I AMA
- DCA I AMA
- TAD A200
- TAD I ASECT
- DCA I ASECT
- JMS GO /TRANSFER 2ND PAGE OF BLOCK
- TAD A200 /INCREMENT MA
- TAD I AMA
- DCA I AMA
- JMP NEXT /CONTINUE WITH NEXT BLOCK,
- /IF ANY
- /SUBROUTINE TO CALL 2ND PAGE SUBR TO DO TRANSFER
-GO, 0
- CIF 20
- JMS MAIN
-ARTN, /ON BBL READ, RETURN HERE
- /IF IO ERROR.
- /(ERROR WILL BE DETECTED
- /DURING 2ND PAGE VALIDITY
- /CHECK.)
- CDF 20 /DATA FIELD=2ND PAGE
- JMP I GO
- /DATA
-ASECT, SECTOR
-ATRACK, TRACK
-ABLOCK, BLOCK
-BASE, TAD BBL+1 /SKIP ID CODE WORD
-AMA, MA
-A17, 17
-A47, 47
-A200, 200
-A377, 377
-A7751, 7751
-
- ZBLOCK 7744-. /UNUSED
- /SECOND PAGE
-
- RELOC
- *400
- RELOC 7600
-
-/SUBROUTINE TO SETUP OR TRANSFER
-MAIN, 0
- SNA /AC TELLS WHICH
- JMP TRANS /NON-ZERO: TRANSFER
-SETUP, DCA BARG /SAVE ADDRESS OF ARGUMENTS
- AC2000 /SET FOR INITIAL HEADER READ
- DCA CURTRK /(2000 IS AN ILLEGAL TRACK)
- TAD B7600 /SET FOR FULL PAGE TRANSFERS
- DCA WC
- TAD I BARG /GET HANDLER FUNCTION WORD
- AND B4070 /CONVERT TO RL01 FUNCTION
- SPA
- TAD B3777
- TAD BRLRD
- DCA FNC
- TAD I BARG
- RAL /CONVERT TO PAGE COUNT
- AND B7600
- DCA PAGES
- ISZ BARG
- TAD I BARG /GET MA
- DCA MA
- ISZ BARG
- TAD I BARG /GET BLOCK
- DCA BLOCK
- ISZ BARG
- RDF /SAVE CALLING FIELD
- TAD BCDIF /FOR RETURN FROM HANDLER
- DCA BRTN
- CDF 00 /CHECK BBL FOR VALIDITY -
- TAD I BBBL /A VALID BBL HAS AN ID
- TAD CHECK /CODE IN ITS FIRST LOCATION
- SZA CLA
- JMP ERROR /INVALID BBL: TAKE ERROR
- /RETURN FROM HANDLER
-GOBACK, /RETURN TO 1ST PAGE
-BCDIF, CIF CDF 00
- JMP I MAIN
- /TRANSFER (READ OR WRITE)
-TRANS, AC7775 /SET FOR 3 TRIES
- DCA ERRCNT
- TAD TRACK /CALCULATE CYLINDER AND
- /SURFACE FROM TRACK
- CLL RAR
- DCA CYL
- RTR
- DCA SURF
- JMS TRKCMP /COMPARE TRACK WITH LAST
- /ONE TRANSFERRED; IF THE
- /SAME, DO TRANSFER.
-RETRY, RLDC /IF DIFFERENT, OR IF RE-
- /TRYING, SEEK TO TRACK;
- /CLEAR CONTROLLER REGISTERS
- /FOR SEEK
-SEEK, IAC /AC=1 FOR RESETTING DRIVE
- /REGISTERS (ERRORS), AC=3
- /FOR DOING SEEK
- JMS IO /DO A RESET OR A SEEK
- TAD HEADER /AC=READ HEADER FUNCTION
- JMS IO /READ NEXT HEADER
- RRSI /GET HEADER BYTE #1
- BSW /CALCULATE TRACK
- AND B3
- DCA CURTRK
- RRSI /GET HEADER BYTE #2
- AND B377
- CLL RTL
- TAD CURTRK
- DCA CURTRK
- JMS TRKCMP /COMPARE CURRENT AND REQUESTED
- /TRACK; IF SAME, DO TRANSFER
- SPA /IF DIFFERENT, SEEK: CALCULATE
- CLL CIA /DIFFERENCE WORD
- RAR
- TAD SURF
- RLCA /LOAD REGISTER "A"
- AC0002 /PREPARE FOR SEEK
- JMP SEEK /LOOP BACK TO ENSURE THAT TRACK
- /REACHED IS REALLY THE DESIRED
- /TRACK, IN CASE OF RL01 SEEK
- /UNRELIABILITY.
- /SUBROUTINE TO COMPARE CURRENT TRACK WITH REQUESTED
-/TRACK AND DO TRANSFER IF THE SAME
-TRKCMP, 0
- TAD CURTRK
- CIA
- TAD TRACK
- STL /SET DIRECTION BIT IN
- /DIFFERENCE WORD IF DIFF-
- /ERENCE IS POSITIVE.
- SZA /SAME?
- JMP I TRKCMP /NO
- TAD SECTOR /YES; LOAD DRIVE REGISTERS
- RLSA
- TAD WC
- RLWC
- TAD SURF
- TAD CYL
- RLCA
- TAD MA
- RLMA
- TAD FNC
- JMS IO /READ OR WRITE
- TAD B7600 /COUNT PAGES TRANSFERRED
- TAD PAGES
- SNA
- JMP DONE /NO MORE TO GO
- DCA PAGES
- JMP GOBACK /MORE TO GO; RETURN TO
- /1ST PAGE
-
-/SUBROUTINE TO DO RL01 I/O
-IO, 0
- RLCB /EXECUTE FUNCTION (DRIVE 0)
- RLSD /WAIT UNTIL DONE
- JMP .-1
- RLSE /ANY ERRORS?
- JMP I IO /NO; RETURN
- ISZ ERRCNT /YES; MORE RETRIES LEFT?
- JMP RETRY /YES, RETRY IT.
-ERROR, AC4000 /NO, TAKE HANDLER ERROR
- SKP /RETURN.
-DONE, ISZ BARG /NORMAL HANDLER RETURN
-BRTN, CIF CDF 00 /RESTORE CALLING FIELD;
- JMP I BARG /INITIALLY, RETURN TO 1ST PAGE
- /AFTER BBL READ-IN.
- /DATA
-B3, 3
-B377, 377
-B3777, 3777
-B4070, 4070
-B7600, 7600
-HEADER, BYTE RLRH
-BRLRD, RLRD
-CHECK, -ID
-BBBL, BBL
-ERRCNT, 0
-BLOCK, 0
-SURF, 0
-CYL, 0
-
-/VARIABLES INITIALIZED TO PERFORM INITIAL BBL READ-IN
-BARG, ARTN /INITIALLY, RETURN TO 1ST PAGE
- /AFTER BBL READ-IN.
-SECTOR, 1400 /BBL: SECTOR 14 (TRACK 0)
-TRACK, 0
-MA, BBL /INITIAL BBL READ
-PAGES, 200 /INITIAL BBL READ
-FNC, RLRD /INITIAL BBL READ
-WC, -21 /INITIAL BBL READ
-CURTRK, 2000 /INITIAL HEADER READ AND
- /SEEK IF REQUIRED.
-
- ZBLOCK 7774-. /UNUSED
-
- ZBLOCK 4 /RESERVED FOR USE BY BATCH
- /IN 12K SYSTEMS.
-
- RELOC
-$
DELETED src/os8-v3f/RTL.PA
Index: src/os8-v3f/RTL.PA
==================================================================
--- src/os8-v3f/RTL.PA
+++ /dev/null
@@ -1,1753 +0,0 @@
-/FORTRN 4 RTS LOADER
-/
-/ VERSION 5A PT 16-MAY-77
-/
-/
-/
-/
-/
-//
-/
-/
-/
-/
-/COPYRIGHT (C) 1974, 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 INCLU-
-/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
-/COPIES THEREOF, MAY NOT BR PROVIDED 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 AT ALL TIMES REMAIN IN DEC.
-/
-/
-/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
-/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
-/EQUIPMRNT COROPATION.
-/
-/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
-/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
-/
-/
-/
-/
-/
-/
- /FORTRAN 4 RTS LOADER - RL
-/WITH DOUBLE PRECSION - MKH
-/AND RTS-8 SUPPORT - R. LARY
-
-/LAST EDITED 5/21/74
-/
-/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77
-/ .FIXED THE D AND B FORMAT (FPP) BUG
-/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED)
-/
-
-/PAGE 0 LOCATIONS FOR RTS LOADER
-
-X0= 10
-X1= 11
-X2= 12
-X3= 13
-
-HADR= 20
-UNIT= 21
-HCWORD= 22
-MXFLD= 23
-HLDADR= 24
-HGHFLD= 25
-HGHADR= 26
-RLTMP= 27
-HDIFF= 30
-CFLAG= 31
-
-/DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS
-/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED
-/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS.
-
-/*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN
-/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA.
-
-F0HBEG= 0
-F0HEND= 3000
-F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
- /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG
- /RTS LOADER TABLES
-
- *2000
-
-IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY
-HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE)
-TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE
-DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA
-
- *IONTBL+5 /RK8 / RK8E
- 1
- *IONTBL+16 /DTA
- 1
- *IONTBL+6 /RF08 IN 4 FLAVORS
- 1;1;1;1
- *IONTBL+0 /TTY
- 2 /FORMS CONTROL ON TTY
- *IONTBL+4 /LPT
- 2 /FORMS CONTROL ON LPT
- *IONTBL+23
- 1
- *IONTBL+25
- 1
- PAGE
- /RTS LOADER
-
-RTSLDR, JMS I (RTINIT
- JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT
- JMP NOCD
-LICD, JMS I (200
- 5
- 1404 /.LD DEFAULT EXTENSION
-NOCD, JMS I (TSTSWS /TEST /E,/P,/V AND /H SWITCHES
- TAD I (7617
- SNA
- JMP LICD
- AND (17
- JMS I (GETHAN /GET HANDLER TO LOAD WITH
- 0 /DON'T PUT IT ANYWHERE
- TAD I (7620
- DCA LIBLK
- JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION
- CIF 0
- JMS I HLDADR
- 0100
-LHDR, QLHDR
-LIBLK, 0
- JMP LDIOER
- JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
- CDF 0
- TAD HADR
- DCA I (OVHND
- TAD HCWORD
- DCA I (OVHCDW
- TAD (QUSRLV-1
- DCA X0
- AC7776
- TAD I LHDR
- SZA CLA /VERIFY LOADER IMAGE INPUT
- JMP NOTLI /GOOD THING WE CHECKED!
- TAD DPFPP
- TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION
- SMA CLA
- JMP .+3
- JMS I (RLERR /YES - PRINT WARNING MESSAGE
- NODPMS /BUT LET THE FOOL GO ON
- /SET UP RTS TABLES FROM LOADER IMAGE
-
- CDF 0
- TAD (OVLYTB-1
- DCA X1
- TAD (-10
- DCA RLTMP
-OVRELP, TAD I X0
- DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE,
- TAD I X0
- DCA I X1
- TAD I X0
- TAD LIBLK /RELOCATING THE BLOCK NUMBERS
- DCA I X1
- TAD I X0
- DCA I X1
- ISZ RLTMP
- JMP OVRELP
- TAD I (QRTSWP
- AND (7770 /TURN THE LOADER INITIAL SWAP WORD
- DCA I (STSWAP+2
- TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD
- AND (7 /SO THAT WE CAN HALT BETWEEN
- TAD (JA /LOADING AND STARTING USERS PROGRAM.
- DCA I (STJUMP
- TAD I (QRTSWP+1
- DCA I (STJUMP+1
- TAD I (QHGHAD
- DCA HGHFLD
- CLA IAC
- TAD HGHFLD
- CMA
- DCA I (FCNT
- TAD I (QHGHAD+1
- DCA HGHADR
- JMS I (GETFIL /GET USER I/O FILES IF ANY
- TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD
- DCA I (VDATE-F0HBEG+F0TO
- STL CLA
- 6141 /TEST IF WE ARE ON A PDP-12
- 0261 /ROL I 1 - PUTS LINK IN AC11
- 0002 /PDP
- DCA I (V8OR12+1-F0HBEG+F0TO
- JMS I (MOVE
- CDF 10
- SPSTRT-1 /MOVE SPECIAL /P START CODE TO LOC 200
- CDF 10
- 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS)
- -3
- JMP I (MOVCOR
-
-DPFPP, 3777 /0 IF D.P. FPP AVAILABLE
- NOTLI, JMS I (RLERR
- NOLI
- JMP LICD
-
-LDIOER, JMS I (RLERR
- LIOEMS
- CDF CIF 0
- JMP I (7605
- PAGE
- /FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600
-
-MOVCOR, TAD I (HTOP
- TAD HDIFF /GET BOTTOM OF HANDLER AREA
- CIA
- CLL /LENGTH OF HANDLER AREA IN AC
- TAD HGHADR
- SZL /TRICKY CODE - IF (L,AC)=0, AC GETS -1
- STA /IF (L,AC) =0XXXX, AC GETS 0
- SNA CLA /IF (L,AC) =1XXXX, AC GETS 1
- STL STA /THERE OUGHTA BE A SHORTER WAY -
- RAL /I'D APPRECIATE HEARING ONE.
- TAD HGHFLD /USE MAGIC NUMBER TO ADJUST HGHFLD
- CIA /BEFORE WE COMPARE IT TO TOP-OF-CORE
- TAD MXFLD
- SPA CLA
- JMP TOOBIG /ALL THAT WORK FOR NOTHING!
- TAD MXFLD
- CLL RTL
- RAL
- TAD (CDF
- DCA HCDF /PREPARE TO TRANSFER THE HANDLERS
- JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE
- CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE
- TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM.
- CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE
- 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE.
- -45
- CIF 0
- JMS I (7607
- 4210
- 7400
- 37 /SUITABLE SCRATCH BLOCK
- JMP SYSERR
- TAD HDIFF
- TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET
- DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS.
- /SHUFFLE CORE AROUND AND START UP RTS
-
-HLOOP, STA
- TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED
- DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING
- CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND
- STA /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS.
- TAD HPTR1
- DCA HPTR1
- STA
- TAD HPTR2
- DCA HPTR2
- TAD I HPTR1
-HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0
- DCA I HDIFF /TO FIELD N
- CDF 10
- TAD I HPTR2 /MEANWHILE RESTORE FIELD 0
- CDF 0
- DCA I HPTR1 /FROM FIELD 1
- ISZ HMCT
- JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT
- CDF CIF 0
- TAD (5606
- DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS
- TAD (PDPXIT
- DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL.
- FPICL /RE-INITIALIZE FPP (IF ANY)
- FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP)
- CLA IAC
- 6654 /LOAD PRINTER BUFFER ON ANALEX PRINTER
- SZA CLA /IS ANALEX PRESENT?
- JMP I (FPSTRT /NO - START UP
- DCA I (LPTEST /IF ANALEX TAKE OUT LPT INTERNAL HANDLER
-LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS
- DCA I (LPTSNA
- 6662 /CLEAR BUFFER ON ANALEX
- TAD (6651
- DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX
- TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF.
- DCA I (LPTERR+2
- JMP I (FPSTRT
-
-TOOBIG, JMS I (RLERR
- TOOMCH
-OS8RTN, CDF CIF 0
- JMP I (7605
-
-SYSERR, JMS I (RLERR
- SYSMSG
- JMP OS8RTN
-
-HPTR1, F0HEND
-HPTR2, F0TO+F0HEND-F0HBEG
-HMCT, F0HBEG-F0HEND
- /MOVE ROUTINE
-
-MOVE, 0 /GENERAL MOVE SUBROUTINE
- CDF 10
- CLA
- TAD MOVE
- DCA X2
- TAD I MOVE
- DCA FRMFLD
- TAD I X2
- DCA X3
- TAD I X2
- DCA TOFLD
- TAD I X2
- DCA X1
- TAD I X2
- DCA MVC
-FRMFLD, HLT
- TAD I X3
-TOFLD, HLT
- DCA I X1
- ISZ MVC
- JMP FRMFLD
- CDF 10
- JMP I X2
-MVC, 0
-
-HNDERR, JMS I (RLERR
- TOMNYH
- JMP OS8RTN
- PAGE
- /INITIALIZATION
-
-RTINIT, 0
- ISZ RTINIT /SKIP RETURN
- JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8
- CIF 0
- JMS I (CORE
- DCA MXFLD
- CLA IAC
- JMS I (GETION /GET ION BIT FOR SYS HANDLER
- DCA I (HCWTBL+13 /SAVE IT
- SWAB /SET EAE MODE TO B (IF 8/E)
- CLA IAC
-EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE
- CLA IAC /LOW ORDER BITS 01
- TAD (-2
- SNA CLA /TEST FOR 8/E EAE
- JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES
- TAD (APT
- FPST /START FPP ON "STARTE;FEXIT"
- JMP NOFPP /DIDN'T START
- JMS I (MOVE
- CDF 10
- FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE
- CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE
- FPPINT-1 /FPP INTERPRETER IN FIELD 0.
- -1000 /COUNT FOR DBL PREC SPACE
- FPRST /FPP HAD BETTER BE DONE BY NOW!!
- AND (4 /GET D.P. STATUS BIT
- SNA CLA
- JMP NOFPP /NO DOUBLE PRECISION
- DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE
- CDF 0
- TAD (DFMT
- DCA I (DF /ENABLE D FORMAT
- TAD (BFMT
- DCA I (BF /AND B FORMAT
- CDF 10
- NOFPP, JMS I (MOVE
-RICDF0, CDF 0
- F0HBEG-1
- CDF 10
- F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING
- F0HBEG-F0HEND
- CDF 0
- TAD I (OSJSWD /GET OS/8 STATUS WORD
- AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB
- TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR
- DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF
- TAD I (7612
- TAD (-3 /CHECK FOR IN-CORE TD8E'S
- SZA CLA
- JMP NOTDSY
- TAD MXFLD
- CLL RTL
- RAL
- TAD RICDF0
- DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF
- TAD I (7642
- AND (70
- TAD RICDF0 /GET THE FIELD WE'RE COMING FROM
- DCA TD8EFL
- TAD TD8EFG
- IAC
- JMS I (TDSET /REDO THE CDF'S IN F0
- JMS I (MOVE
-TD8EFL, CDF 20
- 7577
-TD8EFG, 0
- 7577
- -174 /SPARE BATCH PARAMETERS IN TOP FIELD
- TAD MXFLD /SET FLAG IN CLEANUP ROUTINE
- DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2
-NOTDSY, CDF 10
- TAD MXFLD
- TAD (-7
- SNA /32K?
- JMP TAKCAR /YES - UNIQUE PROBLEMS
- TAD (6
- SNA CLA /8K?
- JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP
- JMS I (GBFLG /GET BATCH FLAG
- TAD TD8EFG
- SNA CLA /IF NO BATCH OR TD8E'S,
-ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD.
-STOHDF, TAD (-F0HEND-200
- DCA HDIFF /OTHERWISE USE ONLY UP TO 7600
- JMP I RTINIT
- TAKCAR, JMS I (GBFLG /GET BATCH FLAG
- SNA CLA
- JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM)
- TAD (6 /BATCH - USE UP TO 67600
- DCA MXFLD
- JMP STOHDF
-NO32KB, TAD TD8EFG
- SNA CLA /IF IN-CORE TD8E'S
- TAD (7600 /LIMIT IS 77600 ELSE 77400
- JMP STOHDF
- PAGE
- GETHAN, 0 /GET HANDLER SUBROUTINE
- AND (17
- DCA UNIT
- DCA H1
- TAD UNIT
- JMS I (200
- 12 /INQUIRE
-H1, 0
- NOP /ERROR RETURN ALWAYS SKIPPED
- TAD H1
- SNA
- JMP NOTLDD /NOT IN CORE - MUST LOAD
- JMS HCWTBA /IN CORE
-GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE
- DCA HCWORD
- TAD HLDADR
- DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT
- TAD (-4
- AND HCWORD
- SNA CLA /WERE WE RASH?
- JMP RESHAN /NO
- TAD HADR
- AND (177
- TAD (HPLACE /YES - I APOLOGIZE
- DCA HADR
-RESHAN, TAD I GETHAN /GET DSRN NUMBER
- SNA
- JMP I GETHAN /NO DSRN NUMBER
- CLL RTL
- RAL
- TAD I GETHAN
- TAD (DSRN-12
- DCA X0 /XR POINTS TO DSRN ENTRY
- CDF 0
- TAD HADR
- DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT
- TAD HCWORD
- TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE
- AND (7773 /KILL ANY OVERFLOW
- DCA I X0
- TAD HGHFLD
- CLL RTL
- RAL
- TAD HGHADR
- DCA I X0 /SAVE BUFFER ADDRESS, FIELD
- TAD HGHADR
- DCA I X0 /INITIALIZE WORD POINTER
- TAD HGHADR
- TAD (400
- SNA
- ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS
- DCA HGHADR
- AC7775
- DCA I X0 /INITIALIZE CHAR CTR
- CDF 10
- JMP I GETHAN /RETURN
- /LOAD A NON-RESIDENT HANDLER
-
-NOTLDD, JMS GH
- CLA IAC
- JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN
- HLT /ARRRGHHHH!!!
-
-GH, 0
- DCA TPFLG
- TAD HTOP
- TAD (7600 /BUMP HANDLER CEILING DOWN
- SNA
- JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0
- DCA HTOP
- TAD TPFLG
- TAD HTOP
- DCA GHADR
- TAD UNIT
- JMS I (200
- 1 /FETCH HANDLER
-GHADR, 0
- JMP I GH /FAILED!
- TAD GHADR /SAVE ACTUAL LOAD ADDRESS
- JMS HCWTBA /INDEX INTO HCW TABLE
- TAD GHADR
- AND (7600
- TAD HDIFF
- DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS
- TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8
- CLL RTL
- RAL
- TAD GHADR
- DCA GHADR
- TAD UNIT
- JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10
- TAD GHADR
- DCA I HCWPTR /STORE POINTER FOR THIS PAGE
- JMP GHEXIT
- HCWTBA, 0
- DCA HLDADR
- TAD HLDADR
- AND (7600
- CLL RTL
- RTL
- RTL /GET PAGE NUMBER
- TAD (HCWTBL-24
- DCA HCWPTR /SAVE POINTER INTO TABLE
- JMP I HCWTBA
-
-HTOP, F0HEND
-HCWPTR, 0
-TPFLG, 0
-
-SPSTRT, RELOC 200 / /P STARTUP CODE
- SWAB /MAKE SURE EAE IS IN MODE B
- JMP I .+1 /EXECUTES AT 200
- FPSTRT /START UP IN FLAG CLEARING CODE
- RELOC
- PAGE
- /ROUTINE TO ACCEPT FILE SPECIFICATIONS
-
-GETFIL, 0
- CDF 10
- TAD I (OS8SWS-1
- SPA CLA /ALTMODE MEANS NO MORE SPECS
- JMP I GETFIL
-GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE
- TAD I (7600
- STL CIA
- SNA /OUTPUT FILE?
- TAD I (7605
- SNA /IN OR OUT FILE?
- TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER?
- SNA CLA
- JMP GETFIL+1 /NONE OF THE ABOVE
- RAR /LINK MAGICALLY TELLS DIRECTION
- DCA DIR
- DCA DSRNUM
- TAD I (OS8SWS+2
- AND (777 /SWITCHES 1-9
- SNA
- JMP NONUM
- CLL RTL
-DNUMLP, ISZ DSRNUM
- RAL
- SMA
- JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER
- TAD DIR /** AC IS NEGATIVE **
- SPA CLA
- TAD (5
- TAD (7600
- DCA FPTR /POINT TO FILE UNIT
- TAD I FPTR
- SNA
- JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST
- JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN
-DSRNUM, 0 /DSRN ENTRY NUMBER
- TAD DIR
- STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER)
- DCA LKPNTR
- TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER)
- ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME
- DCA FUNIT /SAVE UNIT NUMBER A SEC
- TAD I FPTR /WATCH OUT FOR NULL FILE NAMES
- SNA CLA /AS THEY WILL FAIL ON LOOKUPS
- JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES
- JMS I (SVHND /SAVE HANDLER
- TAD FUNIT
- JMS I (200
-LKPNTR, 0 /LOOKUP OR ENTER
-FPTR, 0 /FILE NAME
-FUNIT, 0 /GETS LENGTH
- JMP FILERR /SOMETHING NOT KOSHER
- JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER
- STDSRN, TAD FPTR
- CDF 0
- DCA I X0 /SAVE STARTING BLOCK
- DCA I X0 /RELATIVE BLOCK
- TAD FUNIT
- SNA
- IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE
- CIA /TURN NEGATIVE COUNT TO POSITIVE
- DCA I X0 /LENGTH
- TAD X0
- DCA FPTR /SAVE PTR TO LENGTH WORD
- CDF 10
- TAD DIR
- SMA CLA /TENTATIVE FILE?
- JMP GETFIL+1
- TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN
- DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY
- JMS I (MOVE
- CDF 10
- 7600-1
- CDF 10
-TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN
- -5 /TENTATIVE FILE TABLE
- TAD TFPTR
- TAD (6
- DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY
- JMP GETFIL+1
- NONUM, JMS I (RLERR
- NONMSG
- JMP GETFCD
-FILERR, JMS I (RLERR
- FILMSG
- JMP GETFCD
-
-DIR, 0
-
-NONAME, DCA FPTR
- DCA FUNIT /ZERO BLOCK # AND LENGTH
- JMP STDSRN /USE ENTIRE DEVICE AS FILE
-
-INTHND, STA
- TAD I (OS8SWS+3
- AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER
- TAD (IHTBL
- DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS
- TAD DSRNUM
- CLL RTL
- RAL
- TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9
- TAD (DSRN-11 /ADD TABLE BASE
- DCA DSRNUM
- TAD I HADR
- CDF 0
- DCA I DSRNUM
- ISZ DSRNUM
- AC7776
- TAD CFLAG /DEPENDING ON THE C FLAG,
- CIA
- DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL
- JMP GETFIL+1
- PAGE
- TSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H
- TAD I (OS8SWS
- AND (20
- CDF 0
- SNA CLA /TEST FOR /H SWITCH
- JMP .+3
- TAD (HLT
- DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM
- CDF 10
- TAD I (OS8SWS+1
- AND (4
- SNA CLA /TEST FOR /V SWITCH
- JMP .+3 /NO
- JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE
- XVERMS
- TAD I (OS8SWS
- AND (200
- CDF 0
- SZA CLA /TEST FOR /E SWITCH
- ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL
- CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC)
- TAD I (OS8SWS+1
- AND (400
- CDF 0
- SNA CLA /TEST FOR /P SWITCH
- JMP .+3 /NO, PRAISE BE!
- TAD (SKP /GIVE THE DUMMY WHAT HE WANTS
- DCA I (HLTNOP
- CDF 10
- TAD I (OS8SWS
- RTL
- SMA CLA
- AC0002
- DCA CFLAG /SAVE C FLAG IN PAGE0
- JMP I TSTSWS
-
-MOVEAE, 0
- TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE
- CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE
- DCA I (NORMX /NORMALIZE ROUTINE
- JMS I (MOVE
- CDF 10
- FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1
- CDF 0
- FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0
- -600
- JMS I (MOVE
- CDF 0 /SUBSTITUTE FAST FIX AND FLOAT
- EFXFLT-1
- CDF 0
- EAEFIX-1
- -FXFLTC
- JMP I MOVEAE
- SPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE
- JMS I (MOVE
- CDF 10
- OS8DVT-1
- CDF 10
- DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE
- -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT
- TAD I (HTOP /GET LOWEST HANDLER LOADED
- RAL
- SZL SPA CLA /DID WE LOAD ANY BELOW 02000?
- JMP .+4 /NO
- CDF 0
- ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE
- ISZ I (OSJSWD
- CDF 10
- JMS I (200
- 5 /COMMAND DECODE
- 5200 /SPECIAL MODE - WROUGHT WITH PERIL
- 0 /DON'T CLEAR TENTATIVE FILES
- JMS I (MOVE
- CDF 10
- DVTEMP-1
- CDF 10
- OS8DVT-1
- -17 /MOVE DEVICE HANDLER TABLE BACK
- JMS TSTSWS /CHECK FOR /E, /H, /P
- JMP I SPMDCD
-
-IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE
- PAGE
- GETION, 0
- TAD (OS8DCB-1
- DCA GMADR
- TAD I GMADR /GET DCB WORD
- CLL RTR
- RAR
- AND (77 /INDEX INTO TABLE
- TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE
- DCA GMADR /WITH INTERRUPTS ON
- TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10
- JMP I GETION
-
-GBFLG, 0
- CDF 0
- TAD I (7777 /SPECIAL FLAGS LOC
- CDF 10
- RTL
- CLA RAL
- JMP I GBFLG
-
-SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1
- JMS GMADR /GET MOVE FROM ADDRESS
- JMP I SVHND /NO HANDLER TO MOVE
- DCA SVMOVE
- JMS I (MOVE
- CDF 0
-SVMOVE, 0
- CDF 10
- F0HSAV-1
- -400
- JMP I SVHND
-
-RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1
- JMS GMADR
- JMP I RSTHND /HANDLER IS SYS:
- DCA RSTMOV
- JMS I (MOVE
- CDF 10
- F0HSAV-1
- CDF 0
-RSTMOV, 0
- -400
- JMP I RSTHND
-
-GMADR, 0
- TAD HLDADR
- SPA /CHECK THAT WE'RE NOT TRYING
- JMP RESHND /TO SAVE A RESIDENT HANDLER -
- AND RESHND /THAT COULD BE TRICKY
- TAD (-1 /ECCH
- ISZ GMADR
- JMP I GMADR
-RESHND, 7600
- JMP I GMADR
- /RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES
-
-RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0
- CLA
- CDF 10
- TAD I RLERR
- CDF 0
- DCA RLTMP
-RELP, TAD I RLTMP
- RTR
- RTR
- RTR
- AND (77
- JMS LTTY
- TAD I RLTMP
- AND (77
- JMS LTTY
- ISZ RLTMP
- JMP RELP
-EOMSG, TAD (7515
- JMS LTTY
- TAD (7512
- JMS LTTY
- ISZ RLERR
- CDF 10
- JMP I RLERR /SOME MESSAGES ARE NOT FATAL
-
-LTTY, 0
- SNA
- JMP EOMSG
- TAD (240
- SMA
- AND (77 /CONVERT SIXBIT TO EIGHTBIT
- TAD (240
- TLS
- CLA
- TSF
- JMP .-1
- JMP I LTTY
- /ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE
-/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE.
-/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED
-
-BAKTST, 0
- FPICL /FIRST INITIALIZE FPP (IF ANY)
- FPCOM /INCLUDING CLEARING EXTENDED APT POINTER
- TCF /TEST FOR RTS-8 BACKGROUND BY CLEARING THE
- TSF /TTY FLAG AND THEN TESTING IT - IF IT IS
- JMP I BAKTST /STILL SET, WE ARE RUNNING UNDER SRT-8.
- CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0
-BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED
- SNA
- JMP BAKRTN /ZERO - WE'RE DONE
- DCA X0 /STORE IN AUTO-XR
- ISZ BKRPTR
-BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE
- ISZ BKRPTR
- SNA
- JMP BAKLP /ZERO MEANS END OF GROUP
- DCA I X0
- JMP BAKWLP
-BAKRTN, CDF 10 /RESET DATA FIELD TO 10
- DCA I (EAEKIL /EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT
- JMP I BAKTST /AND RETURN
-
-BKRPTR, BKRLST
- PAGE
-
-F0TO= .
- /FLOATING POINT PROCESSOR HANDLER
- *FPPINT
-
-RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE
-
-FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE
- CDF 0
- DCA STEFLG
- TAD PC
- DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL
- TAD APT
- DCA SAVAPT /OF RE-ENTRANTNESS
- TAD I FPGO
- DCA PC
- TAD APT
- AND (7770
- DCA APT /SET UP ADDRESS IN APT
-FPREST, TAD (400 /ENABLE FPP INTERRUPTS
- FPCOM /LOAD AND STORE ENTIRE APT
- CLA /NECESSARY?
- TAD STEFLG /0 OR 4000?(STARTF OR STARTE)
- SZA
- 6567 /A MNEMONIC?
- CLA
- TAD (APT
- IOF
- FPST /START UP FPP
- JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START
- CLA /NECESSARY?
- JMS I (HANG /EXECUTE BACKGROUND
- FPUHNG
- FPRST /READ FPP STATUS
- FPICL /RESET FPP
- ION
- RTL
- SZL /TEST TRAP BIT
- JMP TRAP /YUP - GO EXECUTE IT
- AND (7400
- SZA /ANY ERRORS?
- JMP FPPER
- TAD FSAVPC
- DCA PC /RESTORE OLD PC
- TAD SAVAPT
- DCA APT
- ISZ FPGO
- JMP I FPGO
- /FLOATING POINT TRAP PROCESSOR
-
-TRAP, AC7775
- TAD PC
- DCA PC /BACK UP PC TO BEFORE THE TRAP
- SZL
- STA
- TAD APT /INCLUDING THE FIELD BITS
- DCA APT
- TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS
- JMS I MCDF
- DCA I (PCCDF
- JMS I (FETPC
- DCA T
- TAD T /GET TRAP WORD
- JMS I MCDF
- IAC /MAKE A "CDF CIF N"
- IAC
- DCA TRPCIF
- JMS I (FETPC
- DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS
- TAD T
-TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS
- SMA CLA /TRAP3 OR TRAP4?
- JMP I ADR /TRAP3 - GO TO ADR
- JMS I ADR /TRAP4 - CALL ADR
-FPPRTN, DCA STEFLG
- ISZ PC /RESTORE PC FROM BEFORE TRAP
- SKP
- ISZ APT /INCLUDING FIELD
- CDF 0
- JMP FPREST /RESTART FPP
-
-FPPER, SPA
- JMP I (FPPERR /FPHALT - FATAL ERROR
- RTL
- ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL
- SZL
- JMP FPDVER
-FPOVER, JMS I ERR
- SKP
-FPDVER, JMS I ERR
- TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE!
- DCA ACX
- AC2000
- DCA ACH
- JMP FPREST
-
-FSAVPC, 0
-SAVAPT, 0
-STEFLG, 0
- /RANDOM FPP CODE FOR D.P. I/O
-DFSTM2, FSTA+LONG
- DFTMP2
- FEXIT
-
- PAGE
- /THIS IS DOUBLE PRECISION FORMATTED OUTPUT.
-/ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF
-/AND, OH JOY!, NO PAGE 0 LITERALS.
-DNXT, TAD RWFLAG /READ OR WRITE?
- SMA CLA
- AC4000 /ITS INPUT SO LEAVE IN STARTE MODE
- JMS I (GETLMN
- JMP .+3
-DFMT, STA
-BFMT, DCA EFLG
- TAD D
- DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT
- TAD PFACT
- DCA PFACTX
- DCA SCALE
- JMS I (SKPOUT /DONE?
- JMP I (DPIN /ITS INPUT
- STA /ITS OUTPUT
- DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG
- TAD EFLG
- CLL RAL
- CLL RAL
- TAD W /GIVE ROOM FOR EXP FIELD (IF ANY)
- CLL /NECESSARY?
- DCA I (OW
- TAD ACH
- SNA
- JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS
- SMA CLA
- JMP DSCLUP
- JMS I (DFNEG /AC<0-NEGATE IT
- DCA I (FFNEG / 0 <> 7777
-DSCLUP, DCA SCALE
- TAD ACX
- SMA SZA CLA /AC<1.0?
- JMP DGT1 /NO
- AC4000 /STARTE
- JMS I (FPGO /Y-MULT BY 10.
- FMUL10
- STA
- TAD SCALE /BUMP POWER OF TEN
- JMP DSCLUP
-DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1)
- AC4000
- JMS I (FPGO /SAVE IT
- FSTTMP
- TAD (22
- JMS I (OSCALE
- AC4000
- JMS I (FPGO
- FADTMP
- JMS I (DSCLDN
- SKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE
- /INCLUDED IN THE SINGLE PREC ROUTINE
- /MAKE NOTG ROUTINE A SUBROUTINE
- SMA /EQUIV TO OUTNUM IN SINGLE PREC
- JMP DASTRS
- JMS I (OBLNKS
- AC7775
- ISZ I (FFNEG /IF SIGN IS NEG,
- JMS I (DIGIT /PRINT A MINUS
- CLA
- TAD ACX
- SNA /ALIGN FAC MANTISSA INTO A
- JMS I (DAL1 /FRACTION (.1,1)
- IAC
- SPA
- JMS I (DACSR
- CLA
- TAD EAC3
- DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM
- TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD
- DCA EAC3
- TAD EAC1
- DCA EAC2
- TAD ACL
- DCA EAC1
- TAD ACH
- DCA ACL
- TAD SCALE
- SPA SNA /ANY DIGITS TO LEFT OF DEC PT?
- JMP I (DPRZRO /N-PRINT A 0
-/JUST AS CHEAP TO DUPLICATE CODE
- JMS I (DBLDIG /Y- PRINT THEM
- DRDCPT, AC7776
- JMS I (DIGIT /PRINT A DEC PT
- TAD SCALE
- SMA CLA /NEED LEADING ZEROS?
- JMP DNOLZR /NO
- TAD SCALE
- DCA T
-DLZERO, STA CLL
- TAD OD /DECREASE D VALUE
- SNL
- JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE
- DCA OD
- JMS I (DIGIT /PRINT A 0
- ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT
- JMP DLZERO
-DNOLZR, TAD OD
- SZA
- JMS I (DBLDIG /PRINT REMAINING DIGITS
-DNOMAC, CLA
- TAD EFLG
- SZA /IF EFLG IS NOT ZERO IT IS -1,
- JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E
- JMP I (DNXT
-
-DASTRS, CLA
- TAD W
- JMS I (ASTRSK
- JMP I (DNXT
- PAGE
- DBLDIG, 0 /OUTPUT DIGITS
- CIA
- DCA T
-DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO
- TAD AC1
- DCA AC2 /START TO COPY THE FAC.THIS IS
- TAD ACL /EAC3 SHIFTED DOWN 1 WORD
- DCA OPL
- TAD EAC1
- DCA L1 /ACL
- TAD EAC2
- DCA DACSR /EAC1
- TAD EAC3
- DCA DSCLDN /EAC2
- JMS DAL1
- JMS DAL1
- CLL
- TAD AC2
- TAD AC1
- DCA AC1 /THIS IS FAC*5 COMING UP
- RAL
- TAD DSCLDN
- TAD EAC3
- DCA EAC3
- RAL
- TAD DACSR
- TAD EAC2
- DCA EAC2
- RAL
- TAD L1
- TAD EAC1
- DCA EAC1
- RAL
- TAD OPL
- TAD ACL
- DCA ACL
- RAL
- TAD ACH
- DCA ACH
- JMS DAL1
- TAD ACH
- JMS I (DIGIT
- ISZ T
- JMP DBDLOP
- JMP I DBLDIG
- DSCLDN, 0 /USED AS A TEMP TOO
- TAD ACX
- SPA SNA CLA
- JMP I DSCLDN /DONE IF FAC<1.
- AC4000
- JMS I (FPGO
- FDIV10
- ISZ SCALE
- 0 /A FREE LOCN!
- JMP DSCLDN+1
-
-DPRZRO, CLA
- JMS I (DIGIT
- JMP I (DRDCPT
-/6 WORD FAC LEFT SHIFT
-DAL1, 0
- TAD AC1 /GET OVERFLO BIT
- CLL RAL /SHIFT LEFT
- DCA AC1
- TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA
- RAL
- DCA EAC3
- TAD EAC2
- RAL
- DCA EAC2
- TAD EAC1
- RAL
- DCA EAC1
- TAD ACL
- RAL
- DCA ACL
- TAD ACH
- RAL
- DCA ACH
- JMP I DAL1
-
-DFLTM2, FLDA+LONG
- DFTMP2
- FEXIT
-DFTMP2, 0;0;0;0;0;0
- /6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC
-/
-DACSR, 0 /USED AS A TEMP BY DBDLOP
- DCA AC0 /STORE COUNT
-DLOP1, TAD ACH
- CLL
- SPA /PROPOGATE SIGN
- CML
- RAR
- DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN
- TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA
- RAR
- DCA ACL
- TAD EAC1
- RAR
- DCA EAC1
- TAD EAC2
- RAR
- DCA EAC2
- TAD EAC3
- RAR
- DCA EAC3
- ISZ ACX /INCREMENT EXPONENT
- NOP
- ISZ AC0 /DONE?
- JMP DLOP1 /NOPE
- RAR /YUP
- DCA AC1 /SAVE 1 BIT OF OVERFLOW
- JMP I DACSR
-L1, 0
- PAGE
- /THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY)
-/IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES
-/ITS OWN FPP ROUTINES.
-DPIN, STA
- DCA DDPSW /INITIALIZE DEC. PT. SWITCH
- STA
- DCA DINESW /AND EXPONENT SWITCH
- TAD W
- CMA
- DCA FMTNUM /CHAR COUNT
-DINESM, DCA ACX /CLEAR FLOATING AC
- DCA ACH
- DCA ACL
- DCA EAC1
- DCA EAC2
- DCA EAC3
- STA
-DINMIN, DCA DFNEG
-DINLOP, ISZ FMTNUM
- JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED
-DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE?
- JMS I (DFNEG /YES-NEGATE
- ISZ DINESW /SEEN A D YET?
- JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER
- TAD PFACTX /NO D- SCALE WITH P FACTOR
-DSCLIN, TAD OD /GET SCALING FACTOR
- STL
- SNA
- JMP I (DNXT /NO SCALING NEEDED
- SMA
- CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN
- DCA OD
- RTL
- RAL
- TAD (FDIV10
- DCA DIGFOP
- AC4000
- JMS I (FPGO /MULT OR DIVIDE BY 10
-DIGFOP, 0
- ISZ OD
- JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES
- JMP I (DNXT /GET MORE
-DIND, ISZ DINESW /IS THERE A 2ND D?
- JMP DINER /Y-A NO-NO
- ISZ DDPSW /FORCE DEC. PT. SWITCH ON
- TAD OD /USE SCALE FACTOR IF SEEN DEC. PT
- DCA SCALE /SAVE SCALE FACTOR
- ISZ DFNEG
- JMS DFNEG /GET SIGN OF NUMBER
- AC4000
- JMS I (FPGO /SAVE IT TEMPORARILY
- DFSTM2
- JMP DINESM /GO COLLECT EXP
- DFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC???
- TAD ACI
- CIA
- TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR
- DCA OD
- AC4000
- JMS I (FPGO
- DFLTM2 /GET NUMBER BACK IN FAC
- JMP DSCLIN
-DINGCH, JMS I (FMTIN /GET A CHAR
- JMS I (CHTYPE /CLASSIFY IT
- 1234; DDIGIT
- -56; DIDCPT /.
- -53; DINLOP /+
- -55; DINMIN /-
- -4; DIND /D
- -5; DIND /E - BE FORGIVING
- -40; DINLOP /BLANK
- -54; DINENM /,
- 0
-DINER, JMP I (INER
-
-DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT
- ISZ DDPSW /TEST + SET DEC PT SWITCH
- JMP DINER /2 DEC. PT. IS NO GOOD
- JMP DINLOP
-DDIGIT, TAD CHCH
- DCA I (DGT+1 /SAVE DIGIT
- AC4000
- JMS I (FPGO
- ACMDGT
- TAD DDPSW
- SNA CLA
- ISZ OD /BUMP DIGIT IF DEC PT SEEN
- JMP DINLOP
-DDPSW, 0
- /6 WORD FLOATING NEGATE
-
-DFNEG, 0
- TAD EAC3
- CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA
- DCA EAC3 /STORE IT BACK
- CML RAL /ADJUST OVERFLOW+CARRY
- TAD EAC2 /CONTINUE WITH REST OF MANTISSA
- CMA IAC
- DCA EAC2
- CML RAL
- TAD EAC1
- CMA IAC
- DCA EAC1
- CML RAL
- TAD ACL
- CMA IAC
- DCA ACL
- CML RAL
- TAD ACH
- CLL CMA IAC
- DCA ACH
- JMP I DFNEG
-DINESW, 0
- PAGE
- *FPPKG /EAE PKG LOADS OVER REGULAR PKG
-
-LPBUF2, ZBLOCK 16
- LPBUF5
-
-AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION
- STA
- TAD ACX
- DCA ACX
- JMS I (AL1
- JMP I AL1BMP
-
-/EAE FLOATING POINT INTERPRETER
-/FOR PDP8/E WITH KE8-E EAE
-
-/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
-
-/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
-/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
-/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
-/(IN THE LOW ORDER, NATCHERLY)
-
-DDMPY, JMS I (DARGET
- SKP
-FFMPY, JMS I (ARGET
- JMS EMDSET /SET UP FOR MULT
- CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ
- OPH /THIS IS PRODUCT OF LOW ORDERS
- MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT
- TAD ACH /GET LOW ORDER(!) OF FAC
- SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY
- OPL /TO AC-WILL BE ADDED TO RESLT-THIS
- DST /IS PRODUCT-LOW ORD FAC,HI ORD OP
- AC0 /STORE RESULT
- CLA
- TAD ACL /HIGH ORDER FAC TO MQ
- MQL
- TAD OPX /GET OPERAND EXPONENT
- TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS.
- DCA ACX /STORE RESULT
- MUY /MUL. HIGH ORDER FAC BY LOW ORD OP.
- OPH /HIGH ORDER FAC WAS IN MQ
- DAD /ADD IN RESULT OF SECOND MULTIPLY
- AC0
- DCA ACH /STORE HIGH ORDER RESULT
- TAD ACL /GET HIGH ORDER FAC
- SWP /SEND IT TO MQ AND LOW ORD. RESULT
- DCA AC0 /OF ADD TO AC-STORE IT
- RAL /ROTATE CARRY TO AC
- DCA ACL /STORE AWAY
- MUY /NOW DO PRODUCT OF HIGH ORDERS
- OPL /FAC HIGH IN MQ, OP HIGH IN OPL
- DAD /ADD IN THE ACCUMULATED #
- ACH
- /MULTIPLIES DONE - MASSAGE RESULT
-
- SNA /ZERO?
- JMP RTZRO /YES-GO ZERO EXPONENT
- NMI /NO-NORMALIZE (1 SHIFT AT MOST!)
- DCA ACH /STORE HIGH ORDER RESULT
- CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT?
- SNA CLA
- JMP SNCK /NO-JUST CHECK SIGN
- TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY!
- RAL
- DCA AC0
- SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON,
- DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI)
- CLA CMA /MUST DECREASE EXP. BY 1
- TAD ACX
-RTZRO, DCA ACX /STORE BACK
-SNCK, TAD AC0
- SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1?
- DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ
- TAD ACH
- SMA
- JMP EMDONE /WE DIDN'T OVERROUND - GOODY
- LSR
- 1 /BUT OVERROUNDING IS EASILY CORRECTED!
- ISZ ACX / (OVERCORRECTED??)
- NOP
-
-/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE
-
-EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS?
- SKP /NO
- DCM /YES-DO IT
- SNA
- DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0
- DCA ACH /STORE IT BACK
- SWP
- DCA ACL
- TAD DFLG
- SMA SZA CLA
- TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0,
- SNA /GO TO UNNORMALIZE RESULT
- JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN.
- CMA
- JMS I (ACSR
- JMP I FPNXT
-EMSIGN, 0
- /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
-
-EMDSET, 0
- CLA CLL CMA RAL /MAKE A MINUS TWO
- DCA EMSIGN /AND STORE IN EMSIGN.
- DLD /GET HIGH ORDER MANTISSA OF OP.
- OPH
- SWP
- SMA /NEGATIVE?
- JMP .+3 /NO
- DCM /YES-NEGATE IT
- ISZ EMSIGN /BUMP SIGN COUNTER
- SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO
- 1
- DST /STORE BACK-OPH CONTAINS LOW ORDER
- OPH / OPL CONTAINS HIGH ORDER
- DLD
- ACH
- SWP
- SMA /FAC LESS THAN 0?
- JMP .+4 /NO
- DCM
- ISZ EMSIGN
- NOP /EMSIGN MAY BUMP TO 0
- DST /STORE BACK - ACH CONTAINS LOW ORDER
- ACH / ACL CONTAINS HIGH ORDER
- JMP I EMDSET
- PAGE
- /FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE
-
-DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
- JMS I ERR
- TAD DBAD
- DCA ACX /SET AC TO A LARGE POSITIVE NUMBER
- AC2000
- JMP I (EMDONE
-
-/FLOATING DIVIDE
-
-DDDIV, JMS I (DARGET
- SKP
-FFDIV, JMS I (ARGET
- JMS I (EMDSET /GET ARG. AND SET UP SIGNS
- DVI /DIVIDE-ACH AND ACL IN AC,MQ
- OPL /THIS IS HI (!) ORDER DIVISOR
- DST /QUOT TO AC0,REM TO AC1
- AC0
- SZL CLA /DIVIDE ERROR?
- JMP DBAD /YES - HANDLE IT
- TAD OPX /DO EXPONENT CALCULATION
- CMA IAC /EXP. OF FAC - EXP. OF OP
- TAD ACX
- DCA ACX
- DPSZ /IS QUOT = 0?
- SKP /NO-GO ON
- DCA ACX /YES-ZERO EXPONENT
-DVLP, MUY /NO-THIS IS Q*OPL*2**-12
- OPH
- DCM /NEGATE IT
- TAD AC1 /SEE IF GREATER THAN REMAINDER
- SNL
- JMP EDVOPS /YES-ADJUST FIRST DIVIDE
- DVI /NO-DO Q*OPL*2**-12/OPH
- OPL
- SZL CLA /DIV ERROR?
- JMP DBAD /YES
-EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV.
- SMA /NEGATIVE?
- JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
- LSR /YES-MUST SHIFT IT RIGHT 1
- 1
- ISZ ACX /ADJUST EXPONENT
- NOP
- SGT /TEST SHIFTED OUT BIT
- JMP I (EMDONE /ZERO - NO ROUND
- DPIC /BUMP AC FRACTION
- JMP EDVLP1+1 /MAYBE SHIFT AGAIN
- /CONTINUATION OF DIVIDE ROUTINE
-/WE ARE ADJUSTING THE RESULT OF THE
-/FIRST DIVIDE.
-
-EDVOPS, CMA IAC
- DCA AC1 /ADJUST REMAINDER
- TAD OPL /WATCH FOR OVERFLOW
- CLL CMA IAC
- TAD AC1
- SNL
- JMP EDVOP1 /DON'T ADJUST QUOT.
- DCA AC1
- CMA
- TAD AC0
- DCA AC0 /REDUCE QUOT BY 1
-EDVOP1, CLA CLL
- TAD AC1 /GET REMAINDER
- SNA /ZERO?
- CAM /YES-ZERO EVERYTHING
- DVI /NO
- OPL
- SZL CLA /DIV. OVERFLOW?
- JMP DBAD /YES
- DCM /NO-ADJUST HI QUOT (MAYBE)
- JMP EDVLP1 /GO BACK
-
-/ROUTINE TO NORMALIZE THE FAC
-
-EFFNOR, 0
- CDF 0
- DLD /PICK UP MANTISSA
- ACH
- SWP /PUT IT IN CORRECT ORDER
- NMI /NORMALIZE IT
- SNA /IS THE # ZERO?
- DCA ACX /YES-INSURE ZERO EXPONENT
- DCA ACH /STORE HIGH ORDER BACK
- SWP /STORE LOW ORDER BACK
- DCA ACL
- CLA SCA /STEP COUNTER TO AC
- CMA IAC /NEGATE IT
- TAD ACX /AND ADJUST EXPONENT
- DCA ACX
- JMP I EFFNOR /RETURN
-
-ADDRS, OPH
- ACH
-
-LPBUF5, ZBLOCK 50
- LPBUF7
- PAGE
- /"OPNEG" MUST BE AT 0 IN PAGE
-
-OPNEG, 0 /ROUTINE TO NEGATE OPERAND
- DLD
- OPH
- SWP
- DCM
- DCA OPH
- MQA
- DCA OPL
- JMP I OPNEG
-
-/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS,
-/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-
-/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS.
-
-FFSUB, JMS I (ARGET
- JMS OPNEG /NEGATE OPERAND
- SKP
-FFADD, JMS I (ARGET /PICK UP ARGUMENTS
- TAD OPH
- SNA CLA /IF OPERAND IS 0,
- JMP I FPNXT /RESULT IS ALREADY IN AC.
- TAD ACH
- SZA CLA /CHECK FOR AC=0
- JMP BOTHN0 /NO
- DLD
- OPH /YES - ANSWER IS OPERAND
- SWP
- DCA ACH
- JMP FADND /JUMP INTO CLEANUP CODE
-BOTHN0, TAD OPX /PICK UP EXPONENT OF OPERAND
- MQL /SEND IT TO MQ FOR SUBTRACT
- TAD ACX /GET EXPONENT OF FAC
- SAM /SUBTRACT-RESULT IN AC
- SPA /NEGATIVE RESULT?
- CMA IAC /YES-MAKE IT POSITIVE
- DCA CNT /STORE IT AS A SHIFT COUNT
- TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED)
- TAD (-27
- SPA SNA CLA
- CMA /NO-OK
- DCA AC0 /YES-MAKE IT A LOAD OF LARGEST #
- DLD /GET ADDRESSES TO SEE WHO'S SHIFTED
- ADDRS
- SGT /WHICH EXP GREATER(GT FLG SET
- /BY SUBTR. OF EXPS.)
- SWP /OPERAND'S-SHIFT THE FAC
- DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED
- SWP /GET ADDRESS OF OTHER (0 TO MQ)
- DCA DADR /THIS ONE JUST GETS ADDED
- TAD ACX /GET FAC EXP.INTO AC
- SGT /WHICH EXPONENT WAS GREATER?
- DCA OPX /FAC'S-STORE FINAL EXP. IN OPX
- DLD /GET THE LARGER # TO AC,MQ
-DADR, 0
- SWP /PUT IN THE RIGHT ORDER
- ISZ AC0 /COULD EXPONENTS BE ALIGNED?
- JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ
- DST /YES-STORE THIS TEMPORARILY
- AC0 /(IF ONLY FAC STORAGE WAS REVERSED)
- DLD /GET THE SMALLER #
-SHFBG, 0
- SWP /PUT IT IN RIGHT ORDER
- ASR /DO THE ALIGNMENT SHIFT
-CNT, 0
- DAD /ADD THE LARGER #
- AC0
- DST /STORE RESULT
- AC0
- SZL /OVERFLOW?(L NOT = SIGN BIT)
- CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
- SMA CLA
- JMP NOOV /NOPE
- CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
- AND ACH
- TAD OPH
- SMA CLA /SIGNS ALIKE?
- JMP OVRFLO /YES-OVERFLOW
-NOOV, AC4000 /NO-GET HIGH ORDER RESULT BACK
- TAD AC1 /CHECK FOR 4000 0000 MANTISSA
- DPSZ /IT WILL BE SET TO 0 BY NMI
- JMP .+3 /OK-RESTORE NUMBER
- AC2000 /GOT A 4000 0000-SET TO 6000 0000
- JMP DOIT /AND INCREMENT EXPONENT
- TAD (4000 /RESTORE NUMBER
-LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ)
- DCA ACH /STORE FINAL RESULT
- SCA /GET SHIFT COUNTER(# OF NMI SHIFTS)
- CMA /NEGATE IT
-ADON, IAC
-FADND, TAD OPX /AND ADJUST FINAL EXPONENT
- DCA ACX
- SWP /GET AND STORE LOW ORDER
- DCA ACL
- JMP I FPNXT /RETURN
-OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK
- ASR /SHIFT IT RIGHT 1
- 1
-DOIT, TAD (4000 /REVERSE SIGN BIT
- DCA ACH /AND STORE
- JMP ADON /DONE
-
-LPBUF7, ZBLOCK 34
- LPBUFE
- PAGE
- *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600
-
-CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR
-TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT"
- TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD
- CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION
- RAL
- TAD (CDF
- DCA TDGTDF
-TDGTDF, HLT
- TAD I TDPTR /MOVE THE TD8E ROUTINE
- CDF 20
- DCA I TDPTR /DOWN TO FIELD 2
- ISZ TDPTR
- JMP TDGTDF
- CDF 0
- TAD (CIF 20
- JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2
-CTMP, CDF 0
- TAD (6213
- DCA I (7605
- TAD (5267
- DCA I (7606 /RESTORE PAGE 7600
- AC7776
- AND I (OSJSWD
- IAC
- DCA I (OSJSWD /MARK 10000-11777 AS USELESS
- AND I 0
- AND I 0 /DELAY A WHILE IN CASE ITS AN LA30
- AND I 0
- AND I 0
- AND I 0
- TSF
- SKP
- JMP WTOVR
- ISZ ZERO
- TAD I (TOCHR /IF TTY IS NOT IDLE,
- SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE.
- JMP CTMP
-WTOVR, TAD I (7777
- CLL RAL
- SMA CLA /IS BATCH EXECUTING?
- JMP NOBTCH /NO - RELAX
- TAD (212 /TO PREVENT OVERPRINTING, POP UP A LINE
- TLS /ON THE TELETYPE
- LLS /AND ON THE LINE PRINTER
- TSF
- JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE)
- CLA
- NOBTCH, CDF 10
-CLOSLP, TAD I CFPTR
- SNA /ANY MORE ENTRIES IN THE TENTATIVE
- JMP GOAWAY /FILE TABLE?
- DCA CTMP /YES - SAVE FILE LENGTH PTR
- CDF 0
- TAD I CTMP
- CDF 10
- SNA
- JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED
- DCA FLEN
- JMS I USR
- 10 /BRING USR IN
- TAD (200
- DCA USR /KEEP IT IN
- TAD (HPLACE+1
- DCA CHAND
- JMS I USR
- 13 /RESET DEVICE HANDLER TABLE
- 0 /BUT NOT TENTATIVE FILES!
- ISZ CFPTR
- TAD I CFPTR /GET UNIT NUMBER
- JMS I USR
- 1
-CHAND, 0 /FETCH HANDLER
- JMP CLSERR
- TAD I CFPTR /GET UNIT AGAIN
- ISZ CFPTR /BUMP PTR TO NAME
- JMS I USR
-C4, 4
-CFPTR, 7600 /CLOSE THE FILE
-FLEN, 0
- JMP CLSERR
- SKP
-IGNORC, AC0002
- TAD CFPTR
- TAD C4
- DCA CFPTR
- JMP CLOSLP /LOOK FOR MORE
-
-TDSET, 0
- DCA I (7721
- TAD I (7721
- DCA I (7727
- TAD I (7721
- IAC
- DCA I (7642
- JMP I TDSET
- GOAWAY, CDF CIF 0
- JMP I (7605 /RETURN TO OS/8 AQAP
-CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"
- 7
- 2 /IT'S BETTER THAN HALTING
-
-TDPTR, 7600
-ZERO, 0
-USR, 7700
- $$$-$$$-$$$
-
DELETED src/os8-v3f/RTS.PA
Index: src/os8-v3f/RTS.PA
==================================================================
--- src/os8-v3f/RTS.PA
+++ /dev/null
@@ -1,3789 +0,0 @@
-/FORTRAN IV RUNTIME SYSTEM, V5A
-/
-/
-/
-/
-/
-/
-/
-//
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,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 INCLU-
-/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
-/COPIES THEREOF, MAY NOT BR PROVIDED 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 AT ALL TIMES REMAIN IN DEC.
-/
-/
-/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
-/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
-/EQUIPMRNT COROPATION.
-/
-/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
-/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
-/
-/
-/
-/
-/
-/
- /FORTRAN 4 RUNTIME SYSTEM - R.LARY
-/AND NOW WITH DOUBLE PRECISION! - MKH
-/RTS-8 SUPPORT ADDED 5/20/74 - RL
-/LAST EDITED 5/19/74
-
-XVERSN=5 /UPDATE WITH EVERY RELEASE!
-XPATCH="A /PATCH LEVEL A
-
-/NOTES TO MAINTAINERS:
-
-/THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE
-/CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL
-/BY "TAILORING" ITSELF AT INITIALIZATION TIME
-/BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES
-/THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER
-/KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS
-/LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE
-/MAKING EVEN "TRIVIAL" CHANGES.
-
-/ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE
-/HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE.
-
-/ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF
-/A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS
-/IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE
-/CAN BE FOUND IN THE TABLE "BKRLST".
-
-/ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER
-/SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY
-/A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN
-/PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES.
-
-/CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD
-/IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE
-/COMMENT SHOULD INDICATE WHAT IS GOING ON.
-/
-/
-/ FIXES FOR V4 J.K. 1975
-/
-/ .SCALE FACTOR PRINTED BY P FORMAT OPERATOR
-/ .FRTS /P
-/ .RK8E HANDLER TO RUN WITH INTERRUPTS ON
-/ .SLASH AT END OF FORMAT STATEMENT
-/
-/
-/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
-/ .CHANGED THE VERSION NUMBER TO 5A
-/ .FIXED THE FIELD OVERFLOW PROBLEM
-/ .FIXED THE "K=K+1" PROBLEM
- /DEFINITIONS:
-
-AC7775= STA CLL RTL
-AC7776= STA CLL RAL
-AC4000= CLA STL RAR
-AC3777= STA CLL RAR
-AC2000= CLA STL RTR
-AC0002= CLA STL RTL
-
-/DEFINITIONS OF KE-8/E INSTRUCTIONS
-
-MQL= 7421
-MQA= 7501
-CAM= CLA MQL
-SWP= MQA MQL
-SWAB= 7431
-SCA= 7441
-MUY= 7405
-DVI= 7407
-NMI= 7411
-SHL= 7413
-ASR= 7415
-LSR= 7417
-ACS= 7403
-SAM= 7457
-DAD= 7443
-DLD= 7663
-DST= 7445
-DPIC= 7573
-DCM= 7575
-DPSZ= 7451
-SGT= 6006
-
-/DEFINITIONS OF FPP IOT'S
-
-FPINT= 6551
-FPICL= 6552
-FPCOM= 6553
-FPHLT= 6554
-FPST= 6555
-FPRST= 6556
- /FPP OPCODES:
-
-FLDA= 0000
-FADD= 1000
-FSUB= 2000
-FDIV= 3000
-FMUL= 4000
-FADDM= 5000
-FSTA= 6000
-FMULM= 7000
- LONG= 400 /TWO-WORD ADDRESSING
- BASE= 200 /BASEPAGE ADDRESSING
- IND= 600 /INDIRECT ADDRESSING
-
-FEXIT= 0000
-FNORM= 0004
-STARTF= 0005
-STARTD= 0006
-JAC= 0007
-XTA= 0030
-STARTE= 0050
-LDX= 0100
-
-JA= 1030
-JNE= 1040
-TRAP3= 3000
-
-/OS8 EQUIVALENCES:
-
-OS8SWS= 7643
-OSJSWD= 7746
-OS8DVT= 7647
-OS8DCB= 7760
-OS8DAT= 7666
-
-/VARIOUS OTHER IOT'S:
-
-LSF= 6661
-LCF= 6662
-LSE= 6663
-LIE= 6665
-LLS= 6666
-LIF= 6667
- /PAGE ZERO FOR FORTRAN IV RTS
-
- *0 /INTERRUPT STUFF
- 0
- JMP I .+1
- INTRPT
-LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER
-TOCHR, 0 /TELETYPE STATUS WORD
-KBDCHR, 0 /KEYBOARD INPUT CHARACTER
-POCHR, 0 /P.T. PUNCH COMPLETION FLAG
-RDRCHR, 0 /P.T. READER STATUS
-FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY
-INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE
-XR, 0
-XR1, 0
-
-*16
-VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS
- 0 /*K* MUST BE IN AUTO - XR
-T, 0 /TEMPORARY
-DFLG, 0 /0 = F.P., 1 = D.P.
-INST, 0 /CURRENT INSTRUCTION WORD
-
-/IOH PAGE ZERO LOCATIONS
-
-RWFLAG, 0 /READ/WRITE FLAG
-FMTTYP, 0 /TYPE OF CONVERSION BEING DONE
-EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT
-N, 0 /REPEAT FACTOR
-W, 0 /FIELD WIDTH
-D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT
-
-DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD
-DATAF, 0 /CONTAINS VARIOUS CDF'S
- JMP I DATCDF /RETURN
-
-ERR, ERROR /POINTER TO ERROR ROUTINE
-FATAL, 0 /FATAL ERROR FLAG - 0=FATAL
-MCDF, MAKCDF
-
-/FPP PARAMETER TABLE LOCATIONS:
-
-APT, 0 /VARIOUS FIELD BITS FOR FPP
-PC, DPTEST /FPP PROGRAM COUNTER
-XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS
-BASADR, 0 /FPP BASE PAGE ADDRESS
-ADR, 0 /ADDRESS TEMPORARY
-ACX, 0
-ACH, 0 /*** FLOATING ACCUMULATOR ***
-ACL, 0
-EAC1, 0
-EAC2, 0 /** FOR EXTENDED PRECISION OPTION **
-EAC3, 0
- /FLOATING POINT PACKAGE LOCATIONS
-
-AC0, 0
-AC1, 0 /FLOATING AC OVERFLOW WORD
-AC2, 0 /OPERAND OVFLOW WORD
-OPX, 0
-OPH, 0 /*** FLOATING OPERAND REGISTER ***
-OPL, 0
-
-/RTS I/O CONVERSION SYSTEM LOCATIONS
-
-FMTBYT, 0 /FORMAT BYTE POINTER
-IFLG, 0 /I FOEMAT FLAG
-GFLG, 0 /G FORMAT FLAG
-EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT
-OD, 0
-SCALE, 0
-PFACT, 0 /P-SCALE FACTOR
-PFACTX, 0 /TEMP FOR PFACT
-ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR
-CHCH, 0
-FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE
-CTCINH, 0 /^C INHIBIT FLAG
-LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE!
-PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN
- 0 / SO FORMS CONTROL WILL WORK ON UNIT 0
-FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP
-
-/DSRN IMAGE
-
-HAND, 0 /HANDLER ENTRY POINT
-HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG
-BADFLD, 0 /BUFFER ADDRESS AND FIELD
-CHRPTR, 0 /ACTUALLY A WORD POINTER
-CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1
-STBLK, 0 /STARTING BLOCK OF FILE
-RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER
-TOTBLK, 0 /LENGTH OF FILE
-FFLAGS, 0 /FILE FLAGS:
- /BIT 0 - "HAS BEEN WRITTEN" FLAG
- /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS
- /BIT 11 - "END-FILED" FLAG
-
-BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD
-BUFCDF, HLT
- JMP I BUFFLD
-
-FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC
- ONE /AND FALL INTO STORE CODE
-FGPBF, 0 /THESE THREE WORDS ARE USED
-BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS
- FEXIT /FROM RANDOM MEMORY
- PAGE
- /STARTUP CODE
-
-FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY
- CDF CIF 10
- JMP I .+1
-VDATE, RTSLDR /USED TO STORE OS/8 DATE
-
-/RTS ENTRY POINTS - "VERSION INDEPENDENT"
-
-VUERR, JMP I (USRERR /USER ERROR
- /** LOADER MUST DEFINE #ARGER AS VARGER-1 **
-VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR
-VRENDO, ISZ RWFLAG /END OF I/O LIST
-VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN
-VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE
-VENDF, JMP I (ENDFL /"END FILE" ROUTINE
-VREW, JMP I (RWIND /"REWIND" ROUTINE
-VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE
-VWUO, AC4000 /UNFORMATTED WRITE
-VRUO, JMP I (RWUNF /UNFORMATTED READ
-VWDAO, AC4000 /DIRECT ACCESS WRITE
-VRDAO, JMP I (RWDACC /DIRECT ACCESS READ
-VWRITO, AC4000 /FORMATTED (ASCII) WRITE
-VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ
-VSWAP, JMP I (SWAP /OVERLAY PROCESSOR
-VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE
-V8OR12, 0;0 /0;1 IF CPU IS A PDP-12
-VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER
- 0
- CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY
- JMS I .-2
- JMP VBACKG
-
-/IOH GET VARIABLE ROUTINE.
-/THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S
-/PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER
-/ IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER
-/IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE.
-
-GETLMN, 0
-VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO?
- /INTERRUPT DRIVEN I/O HANDLERS
-
-LPT, 0 /RING-BUFFERED - LP08 OR LS8E
- AND [377 /JUST IN CASE
-LPTSNA, SNA
- JMP I (IOERR /CANNOT BE USED FOR INPUT
-YLPT, IOF
- DCA I LPPUT
- TAD LPGET
- CIA
- TAD LPPUT
- SZA CLA /IS LPT QUIET?
- JMP .+3 /NO
- TAD I LPPUT
- LLS /YES - START 'ER UP
- CLA IAC
- LIE /ENABLE LPT INTERRUPTS
- TAD LPPUT /1 IN AC, REMEMBER?
- DCA LPPUT
- TAD I LPPUT
- SPA
- JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS
- SZA CLA /ANY ROOM LEFT IN BUFFER?
- JMS I (HANG
- LPUHNG /WAIT FOR LINE PRINTER
- ION /TURN INTERRUPTS BACK ON
- JMP I LPT /RETURN
-
-LPPUT, LPBUFR
-
-PTP, 0 /PAPER TAPE PUNCH HANDLER
-YPTP, SNA
- JMP I (IOERR /INPUT IS ERROR
- DCA LPT /SAVE CHAR
- IOF
- TAD POCHR /IF PUNCH IS NOT IDLE,
- SZA CLA /WE DISMISS JOB
- JMS I (HANG
- PPUHNG /WAIT FOR PUNCH INTERRUPT
- TAD LPT
- PLS /OUTPUT CHAR
- DCA POCHR /SET FLAG NON-ZERO
- ION
- JMP I PTP
-
-/*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL
-
- IFNZRO PPUHNG&7000 <__ERROR__>
- IFNZRO TTUHNG&7000 <__ERROR__>
- IFNZRO KBUHNG&7000 <__ERROR__>
- IFNZRO RDUHNG&7000 <__ERROR__>
- IFNZRO LPUHNG&7000 <__ERROR__>
- /INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER
-
-PTR, 0 /CRUDE READER HANDLER
-YPTR, SZA CLA
- JMP I (IOERR /OUTPUT ILLEGAL TO PTR
- IOF
- RFC /START READER
- JMS I (HANG
- RDUHNG /HANG UNTIL COMPLETE
- TAD RDRCHR /GET CHARACTER
- ION
- JMP I PTR /RETURN
-
-TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT
-YTTY, IOF /DELICATE CODE AHEAD
- SNA /INPUT OR OUTPUT?
- JMP KBD /INPUT
- DCA LPT /OUTPUT - SAVE CHAR
- TAD TOCHR /GET TTY STATUS
- SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP
- JMS I (HANG
- TTUHNG /WAIT FOR LOG JAM TO CLEAR
- TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY
- CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF!
- CLA CML RAR /COMPLEMENT OF BUSY IN SIGN
- TAD LPT /GET CHAR
- SPA /IF TTY NOT BUSY,
- TLS /OUTPUT CHAR
- DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY
-TTYRET, ION /TURN INTERRUPTS BACK ON
- JMP I TTY /AND LEAVE
- KBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT?
- SNA CLA
- JMS I (HANG
- KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS
- TAD KBDCHR /GET CHARACTER
- DCA LPT
- DCA KBDCHR /CHEAR CHARACTER BUFFER
- TAD LPT
- JMP TTYRET /RETURN WITH INTERRUPTS ON
-
-KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT
- ISZ .-1
- JMP .-1 /WAIT FOR IT TO STOP
- FPICL /CLEAN UP MESS HALT HAS MADE IN FPP
-BEEORC, SZL /^C OR ^B?
- JMP I (7600 /^C - HIYO SILVER, AWAY!
- KCC /CLEAR KBD FLAG ON ^B
-CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! **
- PAGE
- /INTERRUPT SERVICE ROUTINES
-
-INTRPT, DCA INTAC
- RAR
- DCA INTLNK
-VINT, JMP .+4 /** MUST BE AT 403 **
- IFNZRO VINT-403 <___ CHANGE LOADER!!!>
- 0
- CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE
- JMS I .-2
-
- FPINT /CHECK FOR FPP DONE
- JMP LPTEST
-FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT
-
-VDISMS, JMP DISMIS /FOR USE BY USERS
- JMP DISMIS
- JMP DISMIS
-
-LPTEST, LSF
- JMP NOTLPT
-LPTLCF, LCF /CLEAR FLAG
- TAD I LPGET
- SNA CLA /CHECK FOR SPURIOUS INTERRUPT
-JMPDIS, JMP DISMIS /GO AWAY IF SO
- DCA I LPGET /ZERO CHAR JUST OUTPUT
- ISZ LPGET
- TAD I LPGET
- SPA
- DCA LPGET /TAKE CARE OF BUFFER LINKS
- SNA
- TAD I LPGET /MAKE SURE CHAR IS IN AC
- SZA /IS THERE A CHARACTER?
- LLS /YES - PRINT IT
- CLA
- LSF /CHECK FOR IMMEDIATE FLAG
-LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM
- JMP LPTLCF /YES - LOOP
-
-NOTLPT, TSF /CHECK TTY
- JMP NOTTTY
- TCF /CLEAR FLAG
- TAD TOCHR /GET TTY STATUS
- SMA SZA /IF THERE IS A CHARACTER WAITING,
- TLS /OUTPUT IT.
- SMA SZA CLA /CHANGE "WAITING" TO "BUSY",
- STL RAR /"BUSY" TO "IDLE".
- DCA TOCHR
-TTUHNG, JMP DISMIS
- /KBD AND PTP INTERRUPTS
-
-NOTTTY, KSF
- JMP NOTKBD
- TAD [200
- KRS /USE KRS TO FORCE PARITY BIT
- DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8
- TAD KBDCHR
- TAD (-202 /CHECK FOR ^C OR ^B
- CLL RAR
- SNA CLA
- JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION
- KCC /DATA CHARACTER - CLEAR FLAG
-KBUHNG, JMP DISMIS
-
-CTCCTB, TAD CTCINH
- SNA CLA /ARE WE IN A HANDLER?
- JMP NOTINH /NO
- TAD INTLNK
- CLL RAL /YES - RETURN WITH INTERRUPTS OFF
- TAD INTAC /TRUST IN GOD AND RTS
- RMF
- JMP I 0
-
-NOTKBD, PSF
- JMP NOTPTP
- PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG
- DCA POCHR /CLEAR SOFTWARE FLAG
-PPUHNG, JMP DISMIS
-
-NOTPTP, RSF
- JMP LPTERR
- TAD [200
- RRB /GET RDR CHAR
- DCA RDRCHR
-RDUHNG, JMP DISMIS
-
-LPTERR, LSE /TEST FOR LP08 ERROR FLAG
- SKP
- LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON
-DISMIS, TAD INTLNK
- CLL RAL
- TAD INTAC /RESTORE AC AND LINK
- RMF
- ION
- JMP I 0 /RETURN FROM THE INTERRUPT
-
-INTAC, 0
-INTLNK, 0
- /BACKGROUND INITIATE/TERMINATE ROUTINE
-
-HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF!
- TAD I HANG /GET POINTER TO UNHANGING LOCATION
- DCA UNHANG
- RDF /GET FIELD CALLED FROM
- TAD HCIDF0
- DCA HNGCDF /SAVE FOR RETURN
-HCIDF0, CDF CIF 0
- TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC
- DCA I UNHANG /TO A "JMP RESTRT"
- TAD BACKLK
- CLL RAL
- TAD BACKAC /SET UP BACKGROUND AC AND LINK
-BAKCIF, CIF 0
-BAKCDF, CDF 0
- ION
- JMP I BACKPC /INITIATE BACKGROUND
-
-/ COME HERE WHEN THE HANG CONDITION HAS GONE AWAY
-
-RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION
- DCA I UNHANG
- TAD INTAC /SUSPEND THE BACKGROUND
- DCA BACKAC
- TAD INTLNK
- DCA BACKLK
- TAD 0
- DCA BACKPC
- RIB
- AND [70
- TAD HCIDF0
- DCA BAKCIF
- RIB
- JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF
- DCA BAKCDF
- ISZ HANG
-HNGCDF, HLT
- JMP I HANG /INTERRUPTS ARE OFF - RETURN
-
-NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT
- DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE!
- JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR
-
-UNHANG, 0
-BACKAC, 0
-BACKLK, 0
-BACKPC, VBACKG
-VHANG= HANG
- IFNZRO VHANG-0524 <__ CHANGE LOADER!>
- PAGE
- /I-O CONVERSION ROUTINES - STARTUP CODE
-
-RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)"
- 2000 /"FORMATTED" BIT
- JMS I [FETPC /GET ADDRESS OF FORMAT STMT
- DCA FMTDF
- JMS I [FETPC
- DCA FMTADR
- DCA FMTTYP
- DCA PFACT /CLEAR SCALE FACTOR
- JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE
-
- TAD (FMTPDL-1
-FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER
- TAD I FMTPXR
- DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0)
- /MAIN FORMAT DECODING LOOP
-
-FMTFLP, TAD FMTBYT
- DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK
-FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER
-FMTCLP, JMS FMTGCH /GET A CHARACTER
- ISZ FMTBYT /BUMP BYTE POINTER
- JMS I [CHTYPE /CLASSIFY CHAR
- 1234; FMTDIG /DIGIT
- -42; DBLQOT /"
- -44; ABORTO /$
- -55; FMINUS /-
- -56; FMTPER /.
- -57; SLASH //
- -54; COMMA /,
- -50; LPAREN /(
- -51; RPAREN /)
- -47; KWOTE /'
- -40; FMTCLP /SPACE
- 0 /ANYTHING ELSE
-
- TAD FMTTYP
- SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING
- JMP I (FMTERR /IF WE DO - ERROR
- TAD CHCH /GET FIELD CHARACTER
- DCA FMTTYP
- TAD FMTNUM
- SNA /IF REPEAT COUNT WAS MISSING OR ZERO
- IAC /MAKE IT ONE
- CMA
- DCA N /STORE -(REPEAT COUNT +1)
- DCA W /CLEAR WIDTH INITIALLY
- ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS
- TAD FMTTYP
- AND [7 /IS THE CHARACTER P, X, OR H?
- SNA CLA /IF SO, DON'T WAIT
-COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION
- JMP FMTFLP /BACK FOR MORE
-
-FMTADR, 0 /ADDRESS OF FORMAT
- FMTGCH, 0 /GET CHARACTER FROM FORMAT
- JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH
- CDF 0
- JMS I (FMTGLR /EXTRACT CHARACTER
- JMP I FMTGCH
-
-FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET
- TAD FMTBYT /GET OFFSET
- CLL RAR
- CLL
- TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2]
- DCA D
- RAL
- TAD FMTDF
- JMS I MCDF /SET UP PROPER DATA FIELD
- DCA .+1
- HLT
- TAD FMTBYT
- RAR
- CLA /LEAVE L/R SWITCH IN LINK
- TAD I D
- JMP I FMTGAD /RETURN WITH WORD IN AC
-
-FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11
-
-FMTDIG, TAD FMTNUM /DIGIT PROCESSOR
- CLL RTL
- TAD FMTNUM
- CLL RAL /MULTIPLY FMTNUM BY 10
- TAD CHCH /ADD IN THE DIGIT
- JMP FMTDLP /STORE IT BACK AND CONTINUE
- /PARENTHESIS AND DIGIT ROUTINES
-
-LPAREN, TAD FMTPXR
- TAD (2-FMTPDL
- SZA /ARE WE AT PARENTHESIS LEVEL 1?
- JMP .+3 /NO
- TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE
- DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN
- /AS THE LOOP POINTER FOR LEVEL 1
- TAD [7
- SPA CLA /PUSHDOWN OVERFLOW?
-FPOERR, JMS I ERR /YES
- AC7775
- TAD FMTPXR
- DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER
- TAD FMTBYT
- DCA I FMTPXR /SAVE BYTE POINTER
- TAD FMTNUM
- SNA
- IAC /NO GROUP COUNT MEANS COUNT = 1
- CIA
- DCA I FMTPXR /SAVE LOOP COUNT
- DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE!
-RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO
- TAD FMTPXR /BACK UP FORMAT PDL POINTER
- JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST
-
-FMPBYT, 0
-
-RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY
- TAD FMTPXR
- TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN?
- SNA CLA
- JMS I [ENDREC /YES - CHECK FOR END OF FORMAT
- ISZ I FMTPXR /BUMP COUNT
- JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER (
- ISZ FMTPXR /POP UP PARENTHESES STACK
- JMP FMTFLP /CONTINUE PAST RIGHT PAREN
- PAGE
- /QUOTE AND HOLLERITH FORMAT PROCESSORS
-
-KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR
-DBLQOT, TAD (-42 /QUOTE PROCESSOR
- DCA KWODEL /SAVE TERMINATOR
- JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY
- SKP
-KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER
- JMS I [FMTGCH /GET THE NEXT FORMAT CHAR
- TAD KWODEL
- SZA CLA /IS IT THE TERMINATOR?
- JMP KWOTLP /NO - PROCESS IT AND CONTINUE
- ISZ FMTBYT /BUMP OVER TERMINATOR
- JMS I [FMTGCH
- TAD KWODEL
- SNA CLA /IS THIS ANOTHER TERMINATOR?
- JMP KWOTLP /TWO TERMINATORS PRINT AS ONE
- JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP
-
-HFMT, JMS MORE /MORE CHARACTERS?
- JMS FMTHCV /YES - PROCESS ONE
- JMP HFMT /AND LOOP
-
-FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS
- TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT
-H7700, SMA CLA /IN OR OUT?
- JMP FMTHIN /IN
- JMS I [FMTGCH /OUT - GET THE CHAR
- JMS I [FMTOUT /PRINT IT
- JMP FMTHCR /RETURN
-FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE
- DCA W /SAVE IT
- JMS I (FMTGAD
- SZL /WHICH SIDE?
- JMP FHRGHT /RIGHT SIDE
- AND [77 /LEFT - KEEP RIGHT CHAR
- DCA MORE
- TAD W
- CLL RTL
- RTL
- RTL
- TAD MORE /ADD NEW CHAR IN ON THE LEFT
- JMP .+3
-FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT
- TAD W /ADD NEW CHAR IN ON THE RIGHT
- DCA I D /RESTORE ALTERED WORD
- CDF 0
-FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER
- JMP I FMTHCV
-
-KWODEL, 0 /MUST BE UNIQUE!
- MORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO
- ISZ N
- JMP I MORE
-DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED
- JMP I DOFMT /RETURN FROM "DOFMT"
-
-DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION
- TAD FMTNUM /GET THE CURRENT NUMBER
- DCA D /STORE IT AS DECIMAL POINT SPEC
- DCA IFLG
- DCA EFLG
- DCA GFLG /ZERO CONVERSION FLAGS
- TAD FMTTYP
- SNA CLA /ANY SPECIFICATION WAITING?
- JMP I DOFMT /NO - JUST RETURN
- TAD W
- TAD D /IF THERE WAS NO W OR D SPECIFICATION,
- SNA CLA
- JMP FMTERR /ITS AN ERROR
- TAD FMTTYP
- JMS I [CHTYPE /YES - WHICH ONE?
- -30; XFMT /X
- -24; TFMT /T
- -20; PFMT /P
- -14; LFMT /L
- -11; IFMT /I
- -10; HFMT /H
- -7; GFMT /G
- -6; FFMT /F
-MINUS5, -5; EFMT /E
- -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP
- -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP
- -1; AFMT /A
- 0 /NONE OF THE ABOVE - ERROR
-FMTERR, JMS I ERR
- ENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O
- JMS I [EOLINE
- CLA IAC
- AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG
- SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST
- JMP I ENDREC
- JMP I [ENDIO /NOW FINISH UP AND LEAVE
-
-SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY
- JMS I [EOLINE /TERMINATE CURRENT LINE
- JMP I (FMTFLP
-
-PFMT, CLA CMA
- TAD FMTNUM
- ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE
- CIA
- DCA PFACT
- STA /FALL INTO CODE TO CLEAR MINFLG
- DCA MINFLG /SET FLAG ON MINUS
- JMP DOFRTN
-
-FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC
- DCA MINFLG /CLEAR MINUS FLAG
- JMP I (FMTFLP
-
-MINFLG, -1
-
-FMTPER, TAD FMTNUM /PERIOD PROCESSOR
- DCA W /STORE WIDTH
- JMP I (FMTFLP
-
-ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS
- DCA EOLSW /FAKE BEGINNING OF LINE
- DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT
- JMP I [ENDIO /GO AWAY
- PAGE
- CHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS
- DCA CHCH /SAVE CHAR
- JMP CHLOOP+1
-CDIGIT, TAD CHCH /CHECK FOR DIGIT
- TAD (-72
- CLL
- TAD [12
- SZL /IS CHAR A DIGIT?
- JMP JMPOUT /YES
-CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS
- CLA
- TAD I CHTYPE
- ISZ CHTYPE
- SMA /END OF LIST?
- JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC
- TAD CHCH
- SZA CLA /DOES CHAR MATCH CHAR ON LIST?
- JMP CHLOOP /NO - KEEP LOOKING
-JMPOUT, DCA CHCH /ZERO CHAR
- TAD I CHTYPE
- DCA CHTYPE /SET UP TO RETURN INDIRECTLY
-JMPOTX, SZA CLA /IS THIS THE END?
- JMP CDIGIT /NO - GO CHECK FOR DIGIT
- JMP I CHTYPE /GO TO SPECIFIED ADDRESS
-
-
-SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS
- JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED
- TAD RWFLAG
- CLL RAR
- SZA CLA /IF OUTPUT,
- ISZ SKPOUT /SKIP RETURN
- SZL CLA /IF END OF I/O LIST,
- JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY
- JMP I SKPOUT
- /A FORMAT PROCESSOR
-
-AINPUT, TAD (4040
- DCA ACH
- TAD (4040
- DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS
-AINPTL, JMS GADR
- SZL /LEFT OR RIGHT?
- JMP AINPTR /RIGHT
- JMS I [FMTIN
- STL RTL /INPUT CHAR GOES IN HIGH-ORDER
- RTL /WITH BLANK IN LOW-ORDER
- RTL
- JMP AINPTC
-AINPTR, JMS I [FMTIN
- TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF
- TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE
-AINPTC, DCA I FMTGLR /STORE WORD
- ISZ W
- JMP AINPTL /LOOP AROUND WIDTH
-ANXT, JMS I [GETLMN /GET NEXT ELEMENT
-AFMT, TAD D
- CIA
- DCA W /SAVE FIELD WODTH AS A COUNT
- JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR
- JMP AINPUT
-AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE
- TAD I FMTGLR
- JMS FMTGLR /GET BYTE
- JMS I [FMTOUT /PRINT IT
- ISZ W
- JMP AOTPUT /LOOP ON WIDTH
- JMP ANXT
-
-FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD
- SZL
- JMP .+4 /RIGHT HALF
- RTR
- RTR
- RTR /LEFT HALF - ROTATE INTO RIGHT HALF
- AND [77
- JMP I FMTGLR
-
-GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR
- TAD D
- TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1
- CLL RAR
- TAD (ACX
- DCA FMTGLR
- JMP I GADR /LEAVE WITH L/R FLAG IN LINK
- /"STOP" ROUTINE - TERMINATES JOB
-
-CALXIT, TAD EXDVNO
- CIA
- DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS.
- DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE
- JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED
- SNA CLA /AND HAS NOT BEEN ENDFILED,
- JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT
- CLA IAC /IS A FORMATTED OUTPUT FILE) AND
- AND FFLAGS /END-FILE IT
- SNA CLA
- JMS I (ENDFL
-XITISZ, ISZ EXDVNO
- JMP CALXIT
-LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO
- TAD TOCHR /GO QUIET.
- SZA CLA
- JMP LPTTWT
- ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES
-PDPXIT, IOF /ENTER HERE FROM 7605
- CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S
- JMS I (7607
- 0210
- 7400 /READ IN CLEANUP ROUTINE
- 37 /AND OS/8 PAGE 17600
- JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO!
- CDF CIF 10
- JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT
-CLNADR, CLNUP
-EXDVNO, -11
-
-ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG
- JMS I [FETPC
- AND [7 /THROW AWAY OPCODE (JA)
- TAD FLDTM2
- DCA FGPBF
- JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION
- DCA BIOPTR
- JMS I [FPGO
- FGPBF
- JMP I ARGLD
-
-FLDTM2, FLDA+LONG
- FTEMP2
- FEXIT
- PAGE
- /SUBROUTINE TO OPEN A UNIT FOR I/O
-
-RWINIT, 0
- DCA RWFLAG /DIRECTION IN AC ON ENTRY
- AC7776
- AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE
- SZA CLA /UNIT NUMBER IS IN FAC
- JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER
- JMS I [FFIX
- TAD ACI
- CLL CMA
- TAD [12
- SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9
- JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0
- SNA CLA /IS UNIT INITIALIZED?
-UNTERR, JMS I ERR /NO - ERROR
- TAD RWFLAG
- SPA /IF WE ARE WRITEING FOR THE FIRST TIME
- TAD FFLAGS /ON A UNIT WHICH WAS BEING READ,
- CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN
- SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE
- JMS I (RD2WR /BETWEEN READ AND WRITE
- TAD I RWINIT
- TAD RWFLAG /OR THE I/O TYPE AND
- CMA
- AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD
- TAD I RWINIT
- TAD RWFLAG
- DCA FFLAGS
- TAD FFLAGS
- CMA RTL
- SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN
- JMP UNTERR /FORMATTED AND UNFORMATTED MODES
- ISZ RWINIT
- TAD ACI
- CLL RAL
- TAD ACI
- TAD (DATABL-4
- DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE
- JMP I RWINIT
- /REWIND AND END FILE
-
-RWIND, JMS RWINIT /GET THE DSRN ENTRY
- 0 /DON'T PLAY WITH MODES
- AC2000
- TAD FFLAGS
- SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D
- JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR
-ATLDMK, CLA IAC
- AND FFLAGS /KILL ALL FLAG BITS
- DCA FFLAGS /EXCEPT "END-FILED" BIT
- TAD BADFLD
- AND [7400
- DCA CHRPTR
- AC7775
- DCA CHRCTR /INITIALIZE BUFFER POINTERS
- DCA RELBLK /AND RELATIVE BLOCK #
- JMP I [ENDIO /RESTORE DSRN AND EXIT
-
-ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT
- 1 /GET DSRN, SET "END FILE" FLAG
- TAD FFLAGS /IF THE FILE IS UNFORMATTED,
- CMA RAL /OR WAS NOT OUTPUT ONTO,
- SNL SMA CLA /THEN ENDFILE DOES NOTHING.
- JMS DMPBUF /ELSE DUMP THE FINAL BUFFER
- AC3777
- AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY
-SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE
- TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE,
- DCA TOTBLK /AND SO WE WON'T READ PAST EOF.
-ENDIO, JMS INITMV /SET UP DSRN POINTERS
- TAD I XR1
- DCA I XR /STORE BACK THE DSRN ENTRY
- ISZ T /FOR THIS LOGICAL UNIT
- JMP .-3
- DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ
-ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM
- JMP I ENDFL /*K* OR RETURN TO CALXIT
-
-INITMV, 0 /ROUTINE TO SET UP STUFF
-ICDF0, CDF 0
- TAD LOGUNT
- DCA XR
- TAD (HAND-1
- DCA XR1
- TAD (-11
- DCA T
- JMP I INITMV
- /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END
-
-DMPBUF, 0
- ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF
- TAD (7712 /OUTPUT A LINE FEED
- JMS I [FMTOUT
- TAD HAND /IF THE FILE IS BEING OUTPUT VIA
- SMA CLA /AN OS/8 HANDLER,
- JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY.
- TAD (32
-CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES.
- JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS
- TAD CHRPTR
- AND [377
- TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO
- IAC /A BLOCK BOUNDARY AND CHRCTR = -3
-Z7700, SMA CLA /WE ARE THEN AT BUFFER-END
- JMP CTZLP
-CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE
- JMP I DMPBUF /RETURN
-
-/ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0
-
-LDDSRN, 0
- TAD ACI / READ/WRITE INIT SINGS THIS SONG,
- CLL RTL / (DOO DAH, DOO DAH,)
- RAL / DSRN ENTRIES 9 WORDS LONG
- TAD ACI / (OH, DEE DOO DAH DAY).
-
- SNA /DEVICE NUMBER 0 IS SPECIAL -
- TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE
- TAD (DSRN-12
- DCA LOGUNT
- JMS INITMV /SET UP FOR MOVE
- TAD I XR
- DCA I XR1 /PUT DSRN ENTRY IN PAGE 0
- ISZ T
- JMP .-3
- TAD BADFLD
- AND [70
- TAD ICDF0
- DCA BUFCDF /SAVE BUFFER FIELD AS A CDF
- TAD HAND
- JMP I LDDSRN
- PAGE
- /BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES
-
-BKSPC, JMS I [RWINIT
- 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE
- TAD HAND
- SMA CLA
- JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED
- AC2000
- AND FFLAGS
- SZA CLA /IS FILE FORMATTED?
- JMP BKASCI /YES - PAIN IN NECK
- JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK
- TAD CHRPTR
- TAD [377
- DCA T
- JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER
- TAD I T /LOOK AT LAST WORD IN BUFFER
- CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD
- TAD RELBLK
- DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC
- JMP I [ENDIO
-
-BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ
- CMA CLL /AC MAY NOT BE 0 ON ENTRY
- TAD RELBLK
- DCA RELBLK /BUMP BLOCK BACK
- SNL
- JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS
- DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO
- JMS I [MASSIO /READ A BLOCK
- JMP I BMPBLK
-
-/**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE ****
-
-NULLJB, TAD N2525
-NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN"
- JMP NULLLP /IN THE AC LIGHTS
- ISZ NUMISZ
- JMP NULLLP
- CML CMA RAR
- DCA N2525
- TAD [-4
- DCA NUMISZ
- JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO?
-N2525, 2525
-NUMISZ, -4
- /BACKSPACE FOR FORMATTED FILES
-
-BKLORD, TAD I CHRPTR
- ISZ CHRPTR
- NOP
- AND [177 /GET 7 BITS
- TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED
- SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS
- JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!)
-BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE
- SKP /CHARACTER POINTER BACK TWO PLACES
- JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE
- TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD
- AND [7400 /BE A CARRIAGE RETURN).
- CIA
- TAD CHRPTR
- CLL RAR
- SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER
- JMP BKNORD /NO
- TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD
- DCA GETCH3
- DCA CHRPTR
- AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE,
- TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE
- SPA /CURRENT BUFFER BY WRITING IT OUT.
- JMP .+4
- DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE
- AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT)
- JMS I [MASSIO
- CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN,
- JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE
- TAD GETCH3 /BEFORE THAT.
- DCA CHRCTR
- TAD CHRCTR
- TAD (401
- SKP /COMPUTE WORD POINTER FROM CHAR POINTER
-BKNORD, STA
- TAD CHRPTR
- DCA CHRPTR /BUMP WD PTR BACK 1
-BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT
- JMP BKLORD /LIKE THE INPUT ROUTINE
- JMS GETCH3
- JMP BKLORD+1
- GETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT
- TAD I CHRPTR
- AND [7400
- DCA BMPBLK /HANDY TEMPORARY
- ISZ CHRPTR
- TAD I CHRPTR
- AND [7400
- CLL RTR
- RTR /COMBINE TWO 4-BIT QUANTITIES
- TAD BMPBLK /INTO A CHARACTER
- CLL RTR
- RTR
- JMP I GETCH3
-
-DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE
- PAGE
- /I,E,F,AND G FORMAT CONVERSIONS
-
-IFMT, TAD D
- DCA W /SET WIDTH PROPERLY
- DCA D /FOR SCALING PURPOSES
- STA
- DCA IFLG
- JMP FFMT
-
-GFMT, STA
- DCA GFLG /SET G AND E FLAGS
-
-EFMT, STA
- DCA EFLG /SET E FLAG
- JMP FFMT
-
-IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME
-FFMT, TAD D
- DCA OD /SAVE COUNT OF POST-D.P. DIGITS
- TAD IFLG
- SNA CLA /APPLY THE P-SCALE FACTOR
- TAD PFACT /ONLY IF THE FORMAT IS NOT I
- DCA PFACTX
- DCA SCALE /DON'T LOOK FOR TROUBLE
- JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION
- JMP I (IGEFIN /INPUT
- STA
- DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG
- TAD EFLG
- CLL RAL
- CLL RAL /0 IF NOT E, -4 IF E
- TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT)
- DCA OW /OR THE 4 TRAILING SPACES (IF G FMT)
- TAD ACH
- SNA
- JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT
- SPA CLA
- JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER)
-SCALUP, DCA SCALE
- TAD ACX
- SMA SZA CLA /AC<1.0?
- JMP GT1 /NO
- JMS I [FPGO /YES - MULTIPLY BY 10.0
- FMUL10
- STA
- TAD SCALE /BUMP POWER OF TEN
- JMP SCALUP
- /I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0
-
-GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1)
- JMS I [FPGO /SAVE IT AWAY
- FSTTMP
- TAD [7
- JMS OSCALE
- JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT
- FADTMP
- JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000...
-SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0
- SNA CLA
- JMP NOTG /NOT G FORMAT
- TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE
- TAD PFACTX
- CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE))
- TAD OD
- SNL
- JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET)
- DCA OD /REDUCE D VALUE BY SCALE FACTOR
- DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS
-USEE, CLA
- JMP NOTG
-
-/SET UP TO PRINT DIGITS
-
-
-DIGCNT, 0
- TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT
- CIA
- TAD SCALE
- DCA FMTNUM
- TAD EFLG
- SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P.
- TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT
- TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G
- DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P.
- TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1
- SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON
- ISZ OW /THIS LOCATION BEING BELOW 4000.
- TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #)
- SPA SNA
- CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1
- TAD OD /REDUCE THE WIDTH BY THIS NUMBER
- CMA
- TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT
- CIA
- TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT)
- JMP I DIGCNT
-OW, 0
- /I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR
-
-OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES
- DCA NPLCS /MAX IN AC ON ENTRY
- DCA ACX
- AC2000 /FORM A FLOATING 0.5 IN ORDER
- DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING.
- DCA ACL
- TAD EFLG /FIGURE OUT HOW TO SCALE IT -
- SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED
- TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT
- DCA T /PRINTING DIGITS. THIS CAN BE
- TAD SCALE /EXPRESSED AS:
- CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F))
- TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE).
- SZL CLA /THE SCALE FACTOR IS < 0 FOR
- TAD GFLG /NUMBERS < .1, WHICH REDUCES
- SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS.
- TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS
- TAD T /IT DOESN'T MATTER WHAT WE DO
- TAD OD /SINCE THE NUMBER WILL PRINT AS
- SMA /0.00000 ANYWAY.
- CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS
- TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE
- SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD
- DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL
- CIA /FOR NUMBERS OF UP TO NPLCS+2
- TAD NPLCS /SIGNIFICANT DIGITS.
- CIA
- DCA T
- JMP .+3
-FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES
- FDIV10
- ISZ T
- JMP FDIVLP
- JMP I OSCALE
-NPLCS, 0
-ONE, 1;2000;0
- PAGE
- /I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION
-
-OUTNUM, SMA /CHECK FOR FIELD OVERFLOW
- JMP ASTSK1 /YES - PRINT *******
- JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0!
- /***IMPORTANT - OBLNKS CLEARS AC1 ***
- AC7775
- ISZ I [FFNEG /IF SIGN IS NEGATIVE,
- JMS DIGIT /OUTPUT A MINUS SIGN
- CLA /OTHERWISE OUTPUT NOTHING
- TAD ACX
- SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD
- JMS I [AL1 /FRACTION IN THE RANGE [.1,1)
- IAC /THIS INVOLVES SHIFTING THE MANTISSA
- CMA /RIGHT BY (-ACX-1) PLACES
- SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT.
- JMS I [ACSR
- CLA
- TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT
- DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS
- TAD ACH /IN THE HIGH-ORDER WORD
- DCA ACL
- TAD SCALE
- SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.?
- JMP PRZERO /NO - PRINT A ZERO THERE
- JMS DIGITS /YES - PRINT THEM
-PRDCPT, TAD IFLG
- SZA CLA
- JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW
- AC7776
- JMS DIGIT /OTHERWISE PRINT DECIMAL POINT
- TAD SCALE
- SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS
- JMP NOLZRO /NO
- TAD SCALE
- DCA T
-LZLOOP, STA CLL
- TAD OD /BUMP D VALUE DOWN BY ONE
- SNL /IF IT GOES NEGATIVE,
- JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH
- DCA OD
- JMS DIGIT /PRINT A ZERO
- ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT
- JMP LZLOOP
-NOLZRO, TAD OD
- SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED,
- JMS DIGITS /PRINT THEM
- /I,G,E,F OUTPUT CONVERSION - FINISH UP
-
-NOMOAC, CLA
- TAD EFLG
- SNA CLA /E FORMAT?
- JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F
- JMS EXPFLD
- JMP I (IGEF
-EXPFLD, 0
- TAD (5
- JMS I [FMTOUT /OUTPUT "E"
- TAD FMTNUM /GET EXPONENT
- CLL
- SPA
- CML CIA /SEPARATE INTO MAGNITUDE AND SIGN
- DCA FMTNUM /SAVE MAGNITUDE
- RTL
- TAD (-5 /PRINT + OR -
- JMS DIGIT
- DCA T /INITIALIZE QUOTIENT OF DIVISION
-DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT
- TAD [-12
- SPA /DID IT GO NEGATIVE?
- JMP PRNTXP /YES - DONE
- DCA FMTNUM /NO - STORE IT BACK
- ISZ T /BUMP QUOTIENT
- JMP DVELP /LOOP
-PRNTXP, CLA
- TAD T
- TAD [-12
- SMA CLA
- JMP ASTSK3
- TAD T
- JMS DIGIT
- TAD FMTNUM
- JMS DIGIT /PRINT TWO DIGITS OF EXPONENT
- JMP I EXPFLD
-
-CHKG, TAD GFLG
- SNA /WAS IT G FORMAT?
- JMP I (IGEF /NO - F OR I - DONE
- DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE
- TAD (-5
- JMS OBLNKS /OUTPUT 4 BLANKS
- JMP I (IGEF /DONE WITH G FORMAT OUTPUT
-
-PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P.
- JMS DIGIT /PRINT A ZERO
- JMP PRDCPT /CONTINUE
-
-ASTSK3, AC0002
- JMP .+3
-ASTSK1, CLA /CLEAR THE AC
- TAD W /GET THE FIELD WIDTH
- JMS I [ASTRSK
- JMP I (IGEF
- /I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES
-
-OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS
- DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT
- JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON
- TAD [40
- JMS I [FMTOUT /OUTPUT A BLANK
- ISZ AC1
- JMP .-3 /LOOP
- JMP I OBLNKS /RETURN
-
-DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS
- CIA
- DCA T
-DGLOOP, TAD AC1
- DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON
- TAD ACL
- DCA OPL
- DCA ACH /CLEAR "OVERFLOW WORD"
- JMS I [AL1
- JMS I [AL1 /FAC=FAC*4
- DCA OPH
- JMS I [OADD
- JMS I [AL1 /FAC=ORIGINAL FAC*10
- TAD ACH /GET OVERFLOW
- JMS DIGIT /PRINT IT
- ISZ T /LOOP FOR SPECIFIED NUMBER
- JMP DGLOOP
- JMP I DIGITS /RETURN
-
-DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT
- TAD [60
- JMS I [FMTOUT /TRIVIAL, ISN'T IT?
- JMP I DIGIT
- PAGE
- /I,G,E,F INPUT CONVERSION
-
-IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT
- DCA DPSW /INITIALIZE D.P. SW
- STA
- DCA INESW /DITTO EXPONENT SWITCH
- TAD W
- CMA
- DCA FMTNUM /GET CHAR COUNT
-INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E"
- DCA ACH /CLEAR FLOATING AC
- DCA ACL
- STA
- JMP INMINS /SET SIGN PLUS
-
-INGCH, JMS I [FMTIN /GET A CHAR
- JMS I [CHTYPE /CLASSIFY IT
- 1234; IDIGIT /DIGIT
- -56; INDCPT /.
- -53; INLOOP /+
- -55; INMINS /-
- -5; INE /E
- -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD
- -54; INEONM /,
- 0 /OTHER - ERROR
-INER, JMS I ERR
-
-INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P.
- ISZ DPSW /TEST AND SET D.P. SWITCH
- JMP INER /WHOOPS - TWO D.P.S IN A NUMBER
- JMP INLOOP /KEEP GOING
-
-IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER
- SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING
- JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION.
-
-IDIGIT, TAD CHCH
- DCA DGT+1 /SAVE THE DIGIT
- JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC
- ACMDGT
- TAD DPSW
- SNA CLA
- ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN
- JMP INLOOP
- INMINS, DCA I [FFNEG /SET SIGN NEGATIVE
-
-INLOOP, ISZ FMTNUM
- JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED
-INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE
- JMS I [FFNEG /YES - NEGATE
- ISZ INESW /SEE IF "E" SEEN
- JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER
- TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR
-
-SCALIN, TAD OD /GET SCALING FACTOR
- STL
- SNA
- JMP I (IGEF /NO SCALING NECESSARY
- SMA
- CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN
- DCA OD
- RTL
- RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY
- TAD (FDIV10
- DCA IGEFOP
- JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0
-IGEFOP, 0
- ISZ OD
- JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES
- JMP I (IGEF /RETURN FOR MORE
-
-INE, ISZ INESW /SEE IF THIS IS THE SECOND "E"
- JMP INER /YES - ERROR
- ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E)
- TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN
- DCA SCALE /SAVE SCALE FACTOR
- ISZ I [FFNEG
- JMS I [FFNEG /GET SIGN OF NUMBER CORRECT
- JMS I [FPGO /SAVE IT TEMPORARILY
- FSTTM2
- JMP INERSM /GO COLLECT EXPONENT
-
-FIXUPE, JMS I [FFIX
- TAD ACI /GET EXPONENT
- CIA
- TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR
- DCA OD
- JMS I [FPGO /GET NUMBER BACK IN FAC
- FLDTM2
- JMP SCALIN
-
-DPSW, 0
-DGT, 13;0;0;0;0;0
-NOTG, JMS I (DIGCNT
- DCA SCALDN
- TAD IFLG
- SNA CLA
- JMP NOTI
- TAD SCALE
- TAD (-7
- SPA CLA
-NOTI, TAD SCALDN
- JMP I (OUTNUM
- SCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0
- TAD ACX
- SPA SNA CLA /IS THE FAC => 1.0?
- JMP I SCALDN /NO - WE'RE DONE
- JMS I [FPGO /DIVIDE BY TEN
- FDIV10
- ISZ SCALE /BUMP POWER OF TEN
- 0 /BACKUP FOR WIDTH
- JMP SCALDN+1 /LOOP
-
-ASTRSK, 0
- CIA
- DCA T
- TAD (52
- JMS I [FMTOUT
- ISZ T
- JMP .-3
- JMP I ASTRSK /GET NEXT ELEMENT
-
-INESW, 0 /"E SEEN" SWITCH ON INPUT
- PAGE
- /L AND X FORMATS , T FORMAT INPUT
-
-TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
- CLA /BY FETCHING AND WASTING A CHARACTER
- TAD (INBUFR
- DCA INXR
- DCA EOLSW /SET TO BEGINNING OF LINE
- JMP XFMT
-XFMTIN, JMS I [FMTIN
-H7600, 7600 /WASTE AN INPUT CHAR
-XFMT, JMS I [MORE /ANY MORE CHARS?
- TAD RWFLAG /YES - IN OR OUT?
- SMA CLA
- JMP XFMTIN /IN
-TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT
- JMS I [FMTOUT /OUT
- JMP XFMT
-
-LINGCH, JMS I [FMTIN
- JMS I [CHTYPE /GET AND CLASSIFY CHARACTER
- -40; LINLP /BLANK
- -24; LINTRU /T
- -6; LINFLS /F
- 0 /OTHER - ERROR
- JMP I (INER
-
-LINTRU, TAD (4001
-LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC
- DCA ACH
- DCA ACL
- RAL
- DCA ACX
-LINLP, ISZ W
- JMP LINGCH /LOOP ON FIELD WIDTH
-
-LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O
-LFMT, TAD D
- CMA
- DCA W /SAVE WIDTH AS A COUNT
- JMS I [SKPOUT /IN OR OUT?
- JMP LINFLS /IN
- CLA IAC
- TAD W
- JMS I (OBLNKS /OUTPUT W-1 BLANKS
- TAD ACH
- SZA CLA
- TAD (16
- TAD (6 /NON-ZERO IS TRUE, ZERO FALSE
- JMS I [FMTOUT /OUTPUT T OR F
- JMP LNXT /NEXT VICTIM
- /T FORMAT OUTPUT AND RANDOM SUBROUTINES
-
-TFMT, TAD D
- CIA
- DCA N /USE N TO FAKE OUT "X" FMT ROUTINE
- TAD RWFLAG
- SMA CLA
- JMP TFMTIN /INPUT
- TAD N
- TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE
- SPA
- JMP TPBLNK /AFTER - SPACE TO IT
- JMS EOLINE /OUTPUT CR AND ZERO EOLSW
- JMS I [MORE /KLUDGE FOR "T1" FORMAT
- TAD (13 /FAKE X FORMAT INTO PRINTING
- JMP TPPLBL /A + AND (N-1) SPACES
-TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS
- JMP XFMT /GO SPACE OUT
-
-EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE
- TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0
- SPA CLA /INPUT OR OUTPUT?
- JMP EOOUTL /OUTPUT
- JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY
- CLA
- TAD (INBUFR-1
- DCA INXR /SET XR TO NEGATIVE WORD AT THE
- JMP .+3 /BEGINNING OF THE INPUT BUFFER
-EOOUTL, TAD (7715
- JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN
- DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT
- JMP I EOLINE
- /ROUTINE TO MOVE A HANDLER INTO FIELD 0
-
-GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY
- DCA HCW /SAVE HANDLER CODE WORD
- TAD [7774
- AND HCW /KNOCK OUT ION AND FORMS CTL BITS
- CIA
- SZA /IF HANDLER IS NOT RESIDENT,
- TAD HKEY /SEE IF THE HANDLER IS ALREADY
- SNA CLA /IN THE HANDLER AREA IN FIELD 0
- JMP HINF0 /YES
- TAD HCW /NO - PUT IT THERE
- AND [70
- TAD HCDF0
- DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES
- TAD HCW
- AND H7600
- TAD (-1 /GET POINTER TO HANDLER ADDRESS
- DCA XR1 /IN THAT FIELD
- TAD (HPLACE-1
- DCA XR /ALSO TO HANDLER AREA IN FIELD 0
- TAD [7400 /SET UP COUNT OF 7400
- DCA HKEY /INDEPENDENT OF HANDLER SIZE
-HNDCDF, HLT
- TAD I XR1
-HCDF0, CDF 0
- DCA I XR /MOVE HANDLER INTO HANDLER AREA
- ISZ HKEY
- JMP HNDCDF
- TAD [7774
- AND HCW
- DCA HKEY /SET NEW KEY CODE WORD
-HINF0, CLA IAC
- AND HCW
- SNA CLA /INTERRUPTS ALLOWED?
-YHIOF, IOF /NO - TOO BAD
- ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL
- JMP I GETHND
-HKEY, 0
-HCW, 0
- PAGE
- /CHARACTER INPUT ROUTINE - LINE AT A TIME
-
-FMTIN, 0
- TAD EOLSW
- SNA /END OF LINE ALREADY FOUND?
- TAD I INXR /NO - GET CHAR FROM LINE BUFFER
- SPA /TIME TO READ A NEW LINE?
- JMP READLN /YES
- SNA /END OF LINE?
- JMP INEOL /YES - SET INDICATOR
- AND [77 /CONVERT TO SIXBIT
- JMP I FMTIN /RETURN WITH IT
-INEOL, TAD [40
-UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK
- JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN
-READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0
- TAD HAND
- TAD (-TTY
- SNA CLA /IS IT TELETYPE INPUT?
- STA /YES - SET TTY FLAG
- DCA TTYFLG
- JMS ECHO
-TTYLF, 12 /ECHO LF IF TTY INPUT
- TAD [12 /TTYLF IS ZEROED BY ABORTO
- DCA TTYLF
-
-READLP, CLA
- TAD HAND
- SPA CLA /CHARACTER ORIENTED DEVICE?
- JMP MASSIN /NO - UNPACK CHAR FROM BUFFER
- JMS I HAND /GET A CHARACTER
-GOTCHR, AND [177 /STRIP OFF PARITY
- JMS I [CHTYPE /CLASSIFY IT
- -15; INCRET /CARRIAGE RETURN
- -177; RUBOUT /RUBOUT
- -11; INTAB /TAB
- -25; CTRLU /^U
- -32; INEOF /^Z
- 0 /ANYTHING ELSE
- TAD CHCH
- TAD [-40
- SMA /IF CHARACTER IS >37,
- JMS INPUTC /STORE IT AND ECHO IT IF TTY
- JMP READLP
- /CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS
-
-INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS
- TAD INXR
- AND [7
- SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED
- JMP INTAB
- JMP READLP
-
-RUBOUT, TAD EOLSW
- CIA
- TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY
- AND TTYFLG
- SNA CLA
- JMP READLP /OR IF NON-TTY INPUT
- JMS ECHO
- 134 /ECHO A BACKSLASH
-IBAKUP, STA
- TAD INXR
- DCA INXR /BACK UP LINE POINTER
- STA
- TAD EOLSW
- DCA EOLSW /AND CHAR COUNTER
- JMP READLP
-
-INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE
- SNA /WAS HE EXPECTING AN EOF?
-EOFERR, JMS I ERR /NO
- JMS I MCDF
- DCA .+1
- HLT /CDF TO FIELD OF INDICATOR VARIABLE
- AC2000
- DCA I VEOFSW+1 /SET VARIABLE TO .5
- CDF 0 /FALL INTO CARRIAGE RETURN CODE
-
-INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE
- SKP
-CTRLU, STA /SNEAKY, SNEAKY!
- TAD (INBUFR
- DCA INXR /RESET XR TO FETCH LINE CHARS
- JMS ECHO
- 15 /ECHO THE C.R.
- JMP UNPKLN /BACK TO FETCH FIRST CHAR
-
-INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR
- TAD [40
- DCA INTMP
- JMS ECHO
-INTMP, 0 /ECHO CHAR IF TTY INPUT
- TAD INTMP
- DCA I INXR /STORE CHAR IN LINE BUFFER
- ISZ EOLSW
- JMP I INPUTC /RETURN IF NO OVERFLOW
- JMP IBAKUP /IGNORE CHAR IF OVERFLOW
- ECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT
- TAD I ECHO /GET CHAR
- AND TTYFLG
- SZA /SHOULD WE ECHO?
- JMS I HAND /YES
- JMP I ECHO /RETURN TO CHARACTER - ITS SMALL
-TTYFLG, 0
-
-/CHARACTER INPUT ROUTINE - MASS STORAGE SECTION
-
-MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER
- JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD
- JMS I (GETCH3 /USE COMMON SUBROUTINE
- JMP MASICM /GO TO COMMON CODE
-
-INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD
- JMS BUFFLD /SET FIELD OF BUFFER
- TAD I CHRPTR
-MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR
- NOP /WATCH END OF FIELD FUNNYBUSINESS!
- CDF 0 /RESET DATA FIELD
- JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER
-
-MASBMP, 0
- JMS BUFFLD /SET TO BUFFER'S DATA FIELD
- ISZ CHRCTR /BUMP CHAR COUNTER
- JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT
- AC7775
- DCA CHRCTR /CHAR 3 - RESET CHAR CTR
- AC7776
- TAD CHRPTR /BUMP BACK CHAR PTR
- DCA CHRPTR
- ISZ MASBMP
- JMP I MASBMP /SKIP RETURN
- PAGE
- /CHARACTER OUTPUT ROUTINE
-
-FMTOUT, 0
- TAD [40 /FIRST CONVERT SIXBIT TO ASCII
- SMA /CTL CHARS COME IN NEGATIVE
- AND [77
- TAD (240
- DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT)
- TAD EOLSW
- SZA CLA
- JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL
- AC0002 /CHECK TO SEE IF THIS UNIT
- AND HCODEW /SHOULD RECEIVE FORMS CONTROL
- SZA CLA
- JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR
- TAD OCHAR
- JMS I [CHTYPE /CLASSIFY CONTROL CHAR
- -261; OUTFFX /1 - TOP OF FORM
- -260; OUT2LF /0 - DOUBLE SPACE
- -253; NOLF /+ - OVERPRINT
- 0 /ANYTHING ELSE - SINGLE SPACE
- JMP OUTLF
-
-OUTFFX, TAD HAND
- TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS
- SZA CLA /INSTEAD OF A FORM FEED
- JMP OUTFF
-OUT2LF, TAD [12
- DCA OCHAR /SET 2ND CHAR TO LINE FEED
-LFPLCH, STA
- DCA EOLSW /SET SWITCH FOR 2ND CHAR
- TAD OCHAR
- DCA CHCH /SAVE CHARACTER AWAY
-OUTLF, AC7776
-OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL
- DCA OCHAR /FOR THE CHARACTER
-NOT1ST, TAD HAND
- SPA CLA /CHARACTER ORIENTED DEVICE?
- JMP MASOUT /NO - PACK CHAR INTO BUFFER
- TAD OCHAR
- JMS I HAND /OUTPUT CHAR
-NOLF, ISZ EOLSW /BUMP CHAR CTR
- JMP I FMTOUT /NO - RETURN
- TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT
- JMP OUTFF+1 /GO TO IT
- /CHARACTER OUTPUT - MASS STORAGE OUTPUT
-
-MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER
- JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD
- JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE
- JMS OSUBR /PACK SECOND HALFBYTE
- AC4000
- JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER
-MASOCM, CDF 0
- JMP NOLF /GO RETURN OR REENTER
-
-OULORD, TAD OCHAR
- DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS
- ISZ CHRPTR /BUMP CHAR PTR
-F214, 214 /GUARD AGAINST OVFLO
- JMP MASOCM /RETURN
-
-OSUBR, 0 /ROUTINE TO PACK A HALFBYTE
- TAD OCHAR
- CLL RTL
- RTL /SHIFT CHAR 4 LEFT
- DCA OCHAR
- TAD I CHRPTR /CLEAR OUT ANY RESIDUE
- AND [377 /FROM HIGH-ORDER OF BUFFER WORD
- DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE.
- TAD OCHAR
- AND [7400 /GET 4 BITS
- TAD I CHRPTR
- DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD
- ISZ CHRPTR /BUMP POINTER
- 200 /OVERFLOW!
- JMP I OSUBR
-
-MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY
- CDF 0
- TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC
- TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON
- DCA IOCTL /STORE I/O CONTROL WORD
- TAD CHRPTR
- AND [377
- SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY
- JMP I MASSIO /YES - RETURN DOING NOTHING
- TAD RELBLK
- TAD STBLK /STORE BLOCK # IN HANDLER CALL
- DCA BLOCK
- TAD BADFLD
- AND [7400
- DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL
- /CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED
-
- TAD TOTBLK
- CIA CLL
- TAD RELBLK
- SZL CLA /CHECK FOR FILE OVERFLOW
-IOVFLO, JMS I ERR /YES - ERROR
- TAD HCODEW
- JMS I (GETHND /GET HANDLER INTO FIELD 0
- JMS I HAND /CALL HANDLER
-IOCTL, 0
-BUFFER, 0
-BLOCK, 0
- SMA CLA /HANDLER ERROR - ABORT
- SKP /IF NOT EOF
-IOERR, JMS I ERR
- JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER
- ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER
- TAD BUFFER
- DCA CHRPTR /RESET CHAR PTR
- JMP I MASSIO /RETURN
-/FPP CODE FOR I/O CONVERSION
-
-FDIV10, FDIV+LONG
- TEN
- FEXIT
-OCHAR, 0 /*** NEEDED FOR PADDING ***
-FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4
- TEN
- FEXIT
-
-FWTOBL, FSUB+LONG
- ONE
- FDIV+LONG
- FLTG85
- FEXIT
- PAGE
- /UNFORMATTED (BINARY) INPUT-OUTPUT
-
-RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)"
- 1000 /"UNFORMATTED" BIT
- TAD SZLCLA /ENABLE SEQUENCE CHECKING
-UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA"
- DCA RECCTR /ENTER HERE FROM DIRECT ACCESS
- TAD HAND
- SMA CLA /CHECK FOR MASS-STORAGE HANDLER
- JMP I [UNTERR /NO - ERROR
- JMS I [GETLMN /GET FIRST VARIABLE
- TAD RWFLAG
- SPA CLA
-RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE,
- CMA /-1 FOR READ
- DCA CHRCTR
- TAD BADFLD
- AND [7400
- DCA BIOPTR /INITIALIZE BUFFER POINTER
- TAD BADFLD
- AND [70
- IAC
- CLL RTR /AC BIT 0 NOW ON
- TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG
- CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD
- TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD
- DCA FGPBF
- JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE
-BFINCR, JMS I [FPGO
- FGPBF /LOAD OR STORE A BUFFER ENTRY
- ISZ BIOPTR
- ISZ BIOPTR /INCREASE BUFFER POINTER
- ISZ BIOPTR
- JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM
-UIOVLP, TAD RWFLAG
- CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG
- SZL CLA
- JMP ENDUIO /NO MORE VARIABLES - TERMINATE
- ISZ CHRCTR /BUMP COUNTER
- JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE
- JMS UDOIO /GET A NEW BUFFER
- JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS
-
-ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED
- SPA CLA /WRITE?
- JMS UDOIO /YES - WRITE OUT THE LAST BUFFER
- JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT
-
-RECCTR, 0
- /DIRECT-ACCESS I/O
-
-RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)"
- 1000 /DIRECT ACCESS IS UNFORMATTED I/O
- TAD I XR
- DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE
- JMS I [ARGLD /GET RECORD NUMBER
- JMS I [FFIX /CONVERT TO INTEGER
- TAD T
- TAD ACI
- ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD
- JMP .-2 /TO GET RELATIVE BLOCK NUMBER
- DCA RELBLK
- TAD I XR
- SNA /THIS LOC SHOULD NOT BE ZERO!
-DAERR, JMS I ERR
- DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD
- TAD I XR /IN WHICH THE CONTROL VARIABLE IS
- DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS
- JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD
- FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR
- TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE
- JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE
-
-UDOIO, 0
- ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED
- TAD BADFLD
- AND [7400
- TAD [377 /FORM POINTER TO LAST WORD IN BUFFER
- DCA BIOPTR
- TAD RECCTR
- JMS BUFFLD
- DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD
-UDOIOL, DCA CHRPTR
- AC4000
- AND RWFLAG
- JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O)
- JMS BUFFLD
- TAD RECCTR
- CMA STL /FOR READ, CHECK THE INPUT
- TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS
- CDF 0 /NO LARGER THAN THE ONE WE EXPECT.
-SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE
- JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST
- JMP UDOIOL /RECORD AND SO WE READ AGAIN.
- /DEFINE FILE PROCESSOR
-
-DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE
- 1000 /DIRECT ACCESS I/O IS UNFORMATTED
- JMS I [ARGLD /GET NUMBER OF RECORDS
- JMS I [FFIX
- TAD ACI
- CIA
-DUMPIT, DCA T /SAVE IT FOR MULTIPLY
- JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD
- JMS I [FPGO /CONVERT WORDS TO BLOCKS
- FWTOBL
- JMS I [FFIX /CONVERT TO INTEGER
- ISZ ACI
- TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD
- ISZ T /BY THE NUMBER OF RECORDS
- JMP .-2
- DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS
- TAD ACI
- CIA
- DCA I XR /STORE NUMBER OF BLOCKS/RECORD
- JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE
- TAD FGPBF
- TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE
- DCA I XR /SAVE "FSTA CONTROL-VARIABLE"
- TAD BIOPTR
- DCA I XR
- TAD TOTBLK
- CMA CLL
- TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE
-SZLCLA, SZL CLA
-DFERR, JMS I ERR /WE DON'T
- AC7776
- AND FFLAGS
- IAC /FORCE "END-FILED" BIT FOR CLOSE
- JMP I (SETTOT /SET LENGTH AND EXIT
- PAGE
- /SWAPPER AND ERROR ROUTINE
-
-SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE:
- DCA T / TRAP3 SWAP
- TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR
- AND [7
- TAD (JA
- DCA STRTUP /STORE JA TO ENTRY POINT
- JMS I [FETPC
- DCA STRTUP+1
- TAD T
- AND [70
- CLL RAR /FORM 4*LVL
- TAD (OVLYTB /INDEX INTO LEVEL TABLE
- DCA ADR
- TAD T
- AND [7400
- DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3
- CDF 0 /WATCH D.F.!
- TAD I ADR
- TAD T /SEE IF THIS OVERLAY IS IN CORE
- SNA CLA
- JMP ITSIN /YES - DON'T LOAD
- TAD T
- CIA
- DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST)
- ISZ ADR
- TAD I ADR
- AND [7400
- DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS
- TAD I ADR
- AND [70
- DCA OVIOW /AND FIELD
- ISZ ADR
- TAD I ADR /GET STARTING BLOCK OF THIS LEVEL
- DCA OVBLK
- ISZ ADR
- TAD I ADR
- DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS
-OVADLP, TAD T /LEVEL STARTING BLOCK +
- SNA /(OVERLAY #) * (OVERLAY LENGTH)
- JMP LOADOV /= OVERLAY STARTING BLOCK
- TAD [7400
- DCA T
- TAD OVBLK
- TAD OVLEN
- DCA OVBLK
- JMP OVADLP
- /SWAPPER - CONTINUED
-
-LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH
- TAD OVIOW /GET LAST READ CONTROL WORD
- RAL
- AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT
- TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0)
- DCA OVADR
- RTL
- RTL /USE THE CARRY
- TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY
- AND [70
- DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW
-
-LOADOV, TAD OVADR
- CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS
- SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME
- TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES
- CLL RTL
- RTL /SO WE MUST BREAK UP THE OVERLAY READ
- CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH.
- TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY:
- CMA /MINIMUM(B,L,15)
- SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD
- CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY
- TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ
- DCA T / ANSWER IN T
- TAD T
- CLL RTR
- RTR
- RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT
- TAD OVIOW
- DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD
- TAD OVHCDW /GET OVERLAY HANDLER CODE WORD
- JMS I (GETHND /LOAD HANDLER INTO FIELD 0
- JMS I OVHND
-OVIOW, 0
-OVADR, 0
-OVBLK, 0
-OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR
- JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER
- TAD T
- TAD OVBLK
- DCA OVBLK /UPDATE BLOCK NUMBER
- TAD T
- CIA
- TAD OVLEN /BUMP DOWN RECORD COUNT
- SZA /SEE IF WE ARE DONE
- JMP LOADLP /NO - PREPARE FOR NEXT READ
- /OVERLAY IN CORE - EXECUTE IT
-
-ITSIN, JMS I [FPGO /START UP FPP
- STRTUP /AND JA TO ENTRY POINT
-
-TRAP5I,
-TRAP6I,
-TRAP7I,
-FPAUSE,
-FPPERR, JMS I ERR /SHOULD NEVER GET HERE
-
-STRTUP, 0;0 /JA ENTRY
-OVLEN, 0
-OVHND, 0 /SET BY LOADER
-OVHCDW, 0 /SET BY LOADER
-
-RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS
- DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS.
-YRCOVR, NOP
- NOP
- NOP
- NOP /RIGHT NOW I DON'T KNOW OF ANY.
- NOP
- NOP
- NOP
- NOP
- ION
- JMP I RECOVR
-
-FSTTMP, FSTA+LONG
- FTEMP
- FEXIT
-
-TEN, 4;2400;0;0;0;0 /10.0D0
-FLTG85, 7;2520;0 /85.0
- PAGE
- /INPUT BUFFER - CONTAINS STARTUP CODE
-
-INBUFR, -206 /LENGTH
- 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING,
-
-/RTS EXECUTION INITIALIZATION - IN INPUT BUFFER
-
-FPSTRT, 6601 /CLEAR DF32 FLAG
- PCF /HSP FLAG
- RRB /HSR FLAG
-PP7600, 7600 /CLEAR READER CHAR
- 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS
- CLA
- 6132 /STOP KW12 CLOCKS
- 6134 /DISABLE KW12 INTERRUPTS
- 6530 /CLEAR AD8-EA FLAGS
- 6050 /CLEAR VC8/E FLAG
- 6500 /DISABLE XY8/E INTERRUPTS
- STA
- 6130 /DISABLE DK8-EP INTERRUPTS
- CLA /LEAVE SPACE FOR ADDITIONAL CLEARS
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- NOP
- DCA EOLSW
-LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP
- STSWAP
-HLTNOP, NOP /SET TO HLT IF /H SPECIFIED,
- JMP PRTCR /SKP IF /P SPECIFIED
- TAD .-1
- DCA LDPROG /BYPASS LOADING ON STARTUP
- TAD PCHWD /HLT
- DCA I (PDPXIT+1
- /ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED)
-
-PPTR, TAD P11
-PCKSUM, DCA ACI
- JMS I (LDDSRN
- SMA CLA
- JMP I [UNTERR
- JMP LDRTLR
-FLDLP, DCA PPTR
- DCA PCKSUM
- TAD (100
- JMS SIXOUT
- JMS SIXOUT
- TAD FLD
- AND [70
-JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3
- TAD (100
- JMS SIXOUT
- JMS SIXOUT
-FLD, CDF 0
- TAD I PPTR
- CDF 0
- JMS PCHWD
- ISZ PPTR
-P11, 11
- ISZ PCTR
- JMP FLD
- TAD PCKSUM
- JMS PCHWD
- TAD FLD
- TAD (10
- DCA FLD
-LDRTLR, TAD PP7600
- DCA ACH
- TAD [200
- JMS SIXOUT
- ISZ ACH
- JMP .-3
- ISZ FCNT
- JMP FLDLP
- TAD (6000
- DCA FFLAGS
- DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT
- JMS I (ENDFL
- DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8
- JMP I (PDPXIT-1
- PCHWD, HLT
- DCA ACH
- TAD ACH
- RTR
- RTR
- RTR
- AND [77
- JMS SIXOUT
- TAD ACH
- AND [77
- JMS SIXOUT
- JMP I PCHWD
-
-SIXOUT, 0
- DCA T
- CLA IAC
- DCA EOLSW
- TAD PCKSUM
- TAD T
- DCA PCKSUM
- TAD T
- TAD (-300
- JMS I [FMTOUT
- JMP I SIXOUT
-
-PCTR, 200 /DON'T PUNCH 07600!
-FCNT, 0
- PRTCR, TAD (215
- JMS I PTTY /PRINT CARRIAGE RETURN
- TAD JFMOUT
- DCA I (ERRENB /ENABLE ERROR TRACEBACK
- JMS I [FPGO
- STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE
-STSWAP, TRAP3 /TRAP3
- SWAP
- 0
- .+1
- TRAP3
- HLTNOP
- PAGE
-STJUMP, 0
- 0
- ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER
- /OVERLAY AND DSRN TABLES
-
- *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM
-
-OVLYTB, ZBLOCK 40 /OVERLAY TABLE
-
-DSRN, PTR; ZBLOCK 10
- PTP; ZBLOCK 10
- LPT; ZBLOCK 10
- TTY; 0;0
- 1234 /*K* PREVENT PROBLEM IN
- ZBLOCK 5 /RWINIT INVOLVING WRITE
- /AFTER READ ON TELETYPE
- ZBLOCK 55
-
- ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST
-FMTPDL, 0 /GUARD WORD
- PAGE
- /SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED
-/EVEN IF FLOATING HARDWARE IS PRESENT
-
-/** MUST NOT DESTROY FAC! **
-
-FFIX, 0 /ROUTINE TO FIX FAC
- STA /ANSWER IS RETURNED IN ACI
-TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048
- CLL /DETERMINE IF FAC EXPONENT IS
- TAD (-13 /BETWEEN 1 AND 14
- SNA
- JMP FIXBIG /14 IS A SPECIAL CASE
-EAEFIX, DCA ACI
- SZL
- JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0
- TAD ACH
- JMP FIXISZ
-FIXLP, CLL /0 IN LINK
- SPA /IS IT LESS THAN 0?
- CML /YES-PUT A 1 IN LINK
- RAR /SCALE RIGHT
-FIXISZ, ISZ ACI /DONE YET?
- JMP FIXLP /NO
-FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI
- JMP I FFIX /RETURN
-
-FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION
- RAL /LEFT ONE PLACE TO INTEGERIZE IT.
- CLA
- TAD ACH
- RAL
- JMP FIXDNE /STORE ANSWER AND RETURN
-
-SETB, TAD DATAF
- DCA I (BASCDF /SET BASE PAGE LOCATION
- TAD ADR
- DCA BASADR
- JMP I FPNXT
- /
-/SHIFT FAC LEFT 1 BIT
-/
-AL1, 0
- TAD AC1 /GET OVERFLOW BIT
- CLL RAL /SHIFT LEFT
- DCA AC1 /STORE BACK
- TAD ACL /GET LOW ORDER MANTISSA
- RAL /SHIFT LEFT
- DCA ACL /STORE BACK
- TAD ACH /GET HI ORDER
- RAL
- DCA ACH /STORE BACK
- JMP I AL1 /RETN.
-/
-/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
-/
-ACSR, 0
- CMA /AC CONTAINS COUNT-1
- DCA AC0 /STORE COUNT
-LOP1, TAD ACH /GET HIGH ORDER MANTISSA
- CLL
- SPA /PROPAGATE SIGN
- CML
- RAR /SHIFT RIGHT 1, PROPAGATING SIGN
- DCA ACH /STORE BACK
- TAD ACL /GET LOW ORDER
- RAR /SHIFT IT
- DCA ACL /STORE BACK
- ISZ ACX /INCREMENT EXPONENT
- NOP
- ISZ AC0 /DONE?
- JMP LOP1 /NO-LOOP
- RAR
- DCA AC1 /SAVE 1 BIT OF OVERFLOW
- JMP I ACSR /YES-RETN-AC=L=0
-/
-/FLOATING NEGATE
-/
-FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE)
- TAD ACL /GET LOW ORDER FAC
- CLL CMA IAC /NEGATE IT
- DCA ACL /STORE BACK
- CML RAL /ADJUST OVERFLOW BIT AND
- TAD ACH /PROPAGATE CARRY-GET HI ORD
- CLL CMA IAC /NEGATE IT
- DCA ACH /STORE BACK
- JMP I FFNEG
- OADD, 0 /ADD OPERAND TO FAC
- CLL
- TAD AC2 /ADD OVERFLOW WORDS
- TAD AC1
- DCA AC1
- RAL /ROTATE CARRY
- TAD OPL /ADD LOW ORDER MANTISSAS
- TAD ACL
- DCA ACL
- RAL
- TAD OPH /ADD HI ORDER MANTISSAS
- TAD ACH
- DCA ACH
- JMP I OADD /RETN.
-
-FETPC, 0
- ISZ PC
- JMP PCCDF /NO FIELD BUMP
- ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS)
-FPC10, 10 /PROTECTION FOR ISZ
- TAD PCCDF
- TAD FPC10
- DCA PCCDF
-PCCDF, HLT
- TAD I PC
- JMP I FETPC
-
-EEPUT, STL /EXTENDED PRECISION STORE
-EEGET, DCA ADR /EXTENDED PRCISION FETCH
- TAD [-6
- DCA DATCDF
- SNL
- AC2000 /SET UP "TAD ACX" OR "DCA ACX"
- TAD TADACX
- DCA EEINST
-EELOOP, SNL /LINK=1 MEANS STORE
- TAD I ADR
-EEINST, HLT
- SZL
- DCA I ADR
- ISZ ADR
- SKP
- JMS I (DFBUMP
- ISZ EEINST
- ISZ DATCDF
- JMP EELOOP
- JMP I FPNXT
-
-FSTTM2, FSTA+LONG
- FTEMP2
- FEXIT
-/
-FTEMP, ZBLOCK 6
-/
- PAGE
- /RUN-TIME SYSTEM ERROR LIST
-
-ERRLST, VARGER; ARGMSG
- UERR; UMSG
- FPOERR; FPOMSG
- FMTERR; FMTMSG
- UNTERR; UNTMSG
- CTLBER; CTLBMS
- INER; INMSG
- IOVFLO; IOVMSG
- IOERR; IOMSG
- DAERR; DAMSG
- FPPERR; FPPMSG
- OVERR; OVMSG
- EOFERR; INEMSG
- FPOVER; OFLMSG
- DFERR; DFMSG
- -1; DV0MSG /BY ELIMINATION
- /RTS ERROR MESSAGES
-
-ARGMSG, TEXT /BAD ARG/
-UMSG, TEXT /USER ERROR/
-FPOMSG, TEXT /PARENS TOO DEEP/
-FMTMSG, TEXT /FORMAT ERROR/
-UNTMSG, TEXT /UNIT ERROR/
-INMSG, TEXT /INPUT ERROR/
-OVMSG, TEXT /OVERLAY /
- *.-1
-IOMSG, TEXT %I/O ERROR%
-DAMSG, TEXT /NO DEFINE FILE/
-FPPMSG, TEXT /FPP ERROR/
-INEMSG, TEXT /EOF ERROR/
-DV0MSG, TEXT /DIVIDE BY 0/
-DFMSG, TEXT /D.F. TOO BIG/
-IOVMSG, TEXT /FILE /
- *.-1
-OFLMSG, TEXT /OVERFLOW/
-CTLBMS, TEXT /^B/
-
-USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL
- DCA FATAL
-UERR, JMS I ERR /PRINT MESSAGE
- JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING
-ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED
-
-TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES
- PRTNAM /BY THE ERROR TRACEBACK ROUTINE
- PAGE
- MAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11
- RTL
- RAL
- AND [70
- TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT?
- JMP I MAKCDF
-
-RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING
- STA /FROM READ TO WRITE. (CALLED ONLY ONCE!)
- TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #"
- DCA RELBLK /TO "THIS BUFFER'S BLOCK #".
- TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A
- IAC /BUFFER, WRITE ROUTINE EXPECTS US TO
- SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER,
- JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS
- JMP I RD2WR
-
-/RUN-TIME-SYSTEM ERROR ROUTINE
-
-ERROR, 0
-ERCDF, CDF 0
- CLA
- TAD (ERRLST-2
- DCA XR
-ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS
- TAD I XR /ERROR LIST CONTAINS
- CMA
- SZA /CALLING ADDRESSES AND
- TAD ERROR /CORRESPONDING MESSAGES
- SZA CLA
- JMP ERRLP
- TAD I XR
- DCA I (FMTADR
- DCA I (FMTDF
- TAD PTTY
- DCA HAND /QUICK FUDGE FOR TTY OUTPUT
- DCA HCODEW /TO SET CARRIAGE CONTROL
- AC4000
- DCA RWFLAG
- JMS I [EOLINE /TYPE CARRET AND SET EOLSW
- DCA FMTBYT /INITIALIZE MESSAGE PTR
-ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME
- JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES
- ISZ FMTBYT
- SZA
- JMP ERPTLP /LOOP UNTIL 0 CHAR
- /PRINT ROUTINE NAME AND LINE NUMBER
-
-PRTNAM, TAD [40
-ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS
-/ PREVIOUS LINE REPLACED WITH:
-/ JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES)
- JMS I [FPGO /START UP FPP
- GTNMPT /GET POINTER TO NAME IN FAC
- TAD ACH
- DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE
- TAD ACL /TO GET CHARACTERS OF ROUTINE NAME
- DCA I (FMTADR
- DCA FMTBYT
- TAD [-6
- DCA ISN /6 CHARACTER NAME
-PRTNML, JMS I [FMTGCH
- SNA
- TAD [40 /AVOID PRINTING RANDOM @S
- JMS I [FMTOUT /GET AND PRINT A CHARACTER
- ISZ FMTBYT
- ISZ ISN
- JMP PRTNML
- TAD [40
- JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE
- TAD [-4 /FROM THE LINE NUMBER.
- DCA ISN
-PTLNLP, TAD ISN+1
- CLL RTL
- RAL
- DCA ISN+1 /PRINT LINE NUMBER IN OCTAL
- TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS
- RAL /IN THE FORTRAN PROGRAM LISTING
- AND [7
- JMS I (DIGIT
- ISZ ISN
- JMP PTLNLP
-
- JMS I [EOLINE /OUTPUT FINAL CR
- TAD FATAL
- SNA CLA /FATAL ERROR?
- JMP TRCBAK /YES - GIVE FULL TRACEBACK
- DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME
- JMP I ERROR
-TRCBAK, JMS I [FPGO /START UP FPP
- UP1LEV /MOVE UP TO CALLING ROUTINE
- /FPP CODE DOES A "TRAP3 PRTNAM"
-ISN, 0;0
- /FPP CODE FOR ERROR ROUTINE
-
-GTNMPT, STARTD
- XTA 0 /LOAD LINE NUMBER FROM XR 0
- FSTA+LONG
- ISN /STORE AWAY
- FLDA+BASE 10 /LOAD POINTER TO PROLOGUE
- FSUB+LONG
- THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE
- STARTF /FOR NON-FPP VERSION
-THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0
-
-UP1LEV, STARTD
- FLDA+BASE 11 /GET THE UPWARD POINTER
- JNE
- NOTMN /ZERO MEANS MAIN PROGRAM
- TRAP3
-E7605, 7605 /GO AWAY IF MAIN PROGRAM
-NOTMN, FSTA+BASE 0
- LDX 1
- 2 /WE WILL STORE A "TRAP3 PRTNAM"
- FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE,
- TRPPRT
- FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB.
- FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN
- JAC /JUMP TO IT.
-
-ACMDGT, FMUL+LONG
- TEN
- FSTA+LONG
- FTEMP
- FLDA+LONG
- DGT /GET UNNORMALIZED DIGIT INTO AC
- FNORM /NORMALIZE IT
-FADTMP, FADD+LONG
- FTEMP
- FEXIT
-LPBUFR, ZBLOCK 4
- LPBUF2
- PAGE
- HPLACE, /ZBLOCK 400 /HANDLER SWAP AREA
-
-/VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA
-
-QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE
-QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN
-QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED
-QVERNO, 0 /LOADER VERSION #
-QDPFLG, 0 /"PROGRAM USES D.P." FLAG
-QUSRLV, ZBLOCK 40 /USER OVERLAY INFO
-
-/EAE OVERLAY TO FIX AND FLOAT
-
-EFXFLT, RELOC EAEFIX
-
-FIXEAE, CMA
- DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12
- SZL
- JMP FIX0 /NOT INTEGERIZABLE
- TAD ACH
- ASR
-FIXSH, 0
-FIX0, DCA ACI
- JMP I FFIX
-
-FXFLTC= .-FIXEAE
- RELOC
- /SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
-/BANKS IN AC.
-/MUST RUN IN FIELD 0.
-
-CORE, 0
- TAD C6203
- RDF
- DCA CORRET
-CORELP, CDF 0 /NEEDED FOR PDP-8L
- TAD I C7777
- AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO,
- CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE
- RAR /WHICH WE SHOULD USE.
- SZA
- JMP CORRET /SO RETURN THAT AMOUNT
- TAD TRYFLD /GET FLD TO TST
- CLL RTL
- RAL
- AND COR70 /MASK USEFUL BITS
- TAD CORELP
- DCA COR706 /SET UP CDF TO FLD
-COR706, 0
- TAD I CORLOC /SAV CURRENT CONTENTS
- NOP /HACK FOR PDP-8
- DCA .-3
- TAD .-2 /7000 IS A GOOD PATTERN
- DCA I CORLOC
-COR70, 70 /HACK FOR PDP-8.,NO-OP
- TAD I CORLOC /TRY TO READ BK 7000
-CO7400, 7400 /HACK FOR PDP-8,.NO-OP
- TAD CO7400 /GUARD AGAINST WRAP AROUND
- TAD CORLOC+1 /TAD 1400
- SZA CLA
- JMP .+5 /NON EXISTENT FLD EXIT
- TAD COR706 /RESTORE CONTENS DESTROYED
- DCA I CORLOC
- ISZ TRYFLD /TRY NXT HIGHER FLD
- JMP CORELP
- STA
- TAD TRYFLD
-CORRET, 0
- JMP I CORE
-CORLOC, CO7400 /ADR TO TST IN EACH FLD
- 1400 /7000+7400+1400=0
-TRYFLD, 1 /CURRENT FLD TO TST
-C6203, 6203
-C7777, 7777
-
-DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION
- FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED
- /TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION
-/UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1
-/ (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES).
-
-BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE
- RELOC YLPT
- LLS
- CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR.
- JMS CTCBCK /CHECK FOR ^C OR ^B
- JMP I LPT
-FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS
- JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER
- RELOC
- 0
-
- YPTP-1 /PAPER-TAPE PUNCH ROUTINE
- CLA /ALL PAPER-TAPE I/O ILLEGAL
- 0
- YPTR-1 /PAPER TAPE READER ROUTINE
- CLA /ALL PAPER-TAPE I/O ILLEGAL
- 0
-
- YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE
- RELOC YTTY
- SNA
- JMP KBDRTS /AC=0 MEANS INPUT
- TSF
- JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL
- TLS
- CLA
- JMS CTCBCK /CHECK FOR ^C OR ^B TYPED
- JMP I TTY
-KBDRTS, KSF
- JMP .-1 /HANG UNTIL CHAR RECEIVED
- JMS CTCBCK /CHECK FOR ^C OR ^B
- KRB
- AND KB177 /STRIP PARITY
- TAD KB177
- IAC /NOW FORCE PARITY BIT ON (177+1=200)
- JMP I TTY
-
-CTCBCK, . /*K* CAN'T BE 0!
- KRS /PEEK AT NEXT CHAR IN BUFFER
- AND KB177
- TAD KBM2
- CLL RAR
- SNA CLA /IS IT ^C OR ^B?
- KSF /AND IS IT REALLY PENDING?
- JMP I CTCBCK /NO - JUST RETURN WITH AC=0
- JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG
-KB177, 177
-KBM2, -2
- RELOC
- 0
- /CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS
-
- YHIOF-1 /"GET OS/8 HANDLER" ROUTINE
- NOP /ELIMINATE "IOF" INSTRUCTION
- 0
-
- YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE
- RELOC YRCOVR
- JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES
- RELOC /AN "ION"
- 0
-
- YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION
- FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE
- 0 /RETURNING TO THE INTERPRETER
-
- 0 /** LIST TERMINATOR **
- /ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER
-/*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER!
-
- IFNZRO .-HPLACE-200&4000 <__ERROR__>
-
-NOLI, TEXT /NOT A LOADER IMAGE/
-NONMSG, TEXT /NO NUMERIC SWITCH/
-FILMSG, TEXT /FILE ERROR/
-SYSMSG, TEXT /SYSTEM DEVICE ERROR/
-TOOMCH, TEXT /MORE CORE REQUIRED/
-TOMNYH, TEXT /TOO MANY HANDLERS/
-LIOEMS, TEXT /CAN'T READ IT!/
-NODPMS, TEXT /CAUTION - NO DP/
-XVERMS, TEXT /FRTS V/
- *.-1
- XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT
- XPATCH&77^100+40 /PATCH LEVEL
- TEXT / /
- PAGE
- /FPP INTERPRETER STARTUP ROUTINE
-
-FPPINT= . /FOR FPP OVERLAY
-RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT
-
-FPGO, 0
-FPGCDF, CDF 0 /NECESSARY?
- CLA
- TAD PC
- DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS
- TAD I (PCCDF
- DCA SPCCDF
- STA
- TAD I FPGO
- DCA PC
- ISZ FPGO
- TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY
- DCA I (PCCDF
- JMP I FPNXT
-
-EXIT, TAD SAVPC
- DCA PC
- TAD SPCCDF
- DCA I (PCCDF /RESTORE OLD PC
- JMP I FPGO /RETURN TO PDP-8 CODE
-SAVPC, 0
-SPCCDF, 0
-
-FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE
- DCA ACX
- JMS DATCDF
- TAD I ADR
-CLFAC, DCA ACL
- TAD ACL
- SPA CLA /SIGN-EXTEND 12-BIT WORD
- STA /INTO FAC FRACTION
- DCA ACH
-NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD
- TAD DFLG
- SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE,
- JMS I NORMX /NORMALIZE THE FAC
- JMP I FPNXT
- /MISCELLANEOUS JUMP CLASS INSTRUCTIONS
-
-JSA, TAD ADR
- DCA PUTM
- TAD DATAF
- DCA JSCDF /SET UP LOC TO SAVE PC IN
- AC0002
- TAD ADR
- DCA ADR /BUMP ADDRESS BY 2
- RTL
- RTL
- TAD DATAF
- DCA DATAF /INCLUDING DATA FIELD
-JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE
- CLL RTR
- RAR
- ISZ PC /BUMP PC BEFORE STORING
- SKP
- IAC /INCLUDING FIELD BITS
- TAD (JA-2620 /FORM "JA" INSTRUCTION
-JSCDF, HLT
- DCA I PUTM
- ISZ PUTM
- SKP
- JMS I (DFBUMP /BUMP TARGET ADDRESS
- TAD PC
- DCA I PUTM
- JMP I (DOJMP /NOW JUMP TO DESTINATION
-
-JSR, CLA CLL IAC
- TAD BASADR
- DCA PUTM
- RTL
- RTL
- TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1
- DCA JSCDF
- JMP JSAR
-
-FPJAC, TAD ACL
- DCA ADR
- TAD ACH
- JMS I MCDF
- DCA DATAF
- JMP I (DOJMP
-
-SPCATX, TAD ACL
- SKP
-FPLDX, JMS I [FETPC
- JMS DATCDF
- DCA I ADR /SET XR TO NEXT INST WD
- JMP I FPNXT
- /MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS
-
-ADDX, JMS I [FETPC
- JMS DATCDF
- TAD I ADR /ADD NEXT INST WD TO XR
- JMP FPLDX+1
-
-ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE
- SMA SZA CLA
- JMP SPCATX
- JMS I NORMX /FAC MAY NOT BE NORMALIZED
- JMS I [FFIX
- TAD ACI
- JMP FPLDX+1
-
-OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER
- TAD AD1
- DCA AD2
- RDF
- CLL RTR
- RAR
- TAD KLUDGM /FORM FSTA X INSTRUCTION
- DCA PUTM
- AC2000
- AND INST /TURN OP 5 TO OP 1,
- SZA CLA
- TAD [3000 / OP 7 TO OP 4.
- TAD [3000
- TAD PUTM /STICK IN FIELD BITS
- DCA OPM
- JMS I [FPGO
- KLUDGM
- JMP I FPNXT
-
-KLUDGM, FSTA+LONG
- FTEMP /SAVE AC
-OPM, 0
-AD1, 0 /PERFORM OP
-PUTM, 0
-AD2, 0 /STORE RESULT
- FLDA+LONG
- FTEMP /RESTORE AC
- FEXIT
-
-NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE
- PAGE
- /MAIN INTERPRETER LOOP
-
-NEGFAC, JMS I [FFNEG
-
-ICYCLE, CLA
- JMS I [FETPC /GET INST
- DCA INST
- TAD INST
- CLL RTL
- RTL
- SMA /SKIP IF BASEPAGE ADDRESSING
- JMP LONGI
- AND [7
- TAD BASJMP
- DCA OPJMP /SAVE OPCODE CALL ADDRESS
- TAD INST /DATA FIELD IS STILL SET UP
- SZL /SO IS LINK (WITH INSTRUCTION BIT 3)
- JMP BPAGEI /INDIRECT ADDRESSING
- CLL RAL
- TAD INST /MULTIPLY BASE OFFSET BY 3
- TAD [200 /ELIMINATE ANY
- AND (777 /HIGH ORDER BITS
-IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE
- TAD BASADR /ADD IN BASE PAGE ORIGIN
-BASCDF, HLT /CDF TO BASE PAGE FIELD
- SZL
- JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED
-OPJCLL, CLL
-OPJMP, HLT /JMP I EXECUTIONROUTINE
-
-BPAGEI, AND [7
- DCA ADR
- TAD ADR
- CLL CML RAL
- TAD ADR /FORM 3*OFFSET+1
- TAD BASADR
- DCA ADR
- RTL
- RTL
- TAD BASCDF /FORM PROPER CDF
- DCA ADDRLO
-ADDRLO, HLT /EXECUTE IT
- TAD I ADR /GET FIELD BITS OF REAL ADDRESS
- DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC
- ISZ ADR
- SKP
- JMS DFBUMP /WATCH FOR FIELD OVERFLOW
- TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD
- JMP INDEX /NOW GO DO INDEXING (IF ANY)
- /COME HERE IF BIT 4 OF INSTRUCTION IS OFF
-
-LONGI, AND [7
- SNL /TEST BIT 3 OF INSTRUCTION
- JMP I (SPECAL /SPECIAL INSTRUCTION
- TAD BASJMP
- DCA OPJMP
- TAD INST
- DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD
- JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
-INDEX, DCA ADDRLO
- TAD INST
- AND [70
- SNA /IS XR NUMBER 0?
- JMP NOINDX /YES - NO INDEXING
- JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED)
- AC7775
- TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE
- DCA DCDIDX
- TAD ADDRLO
-XRADLP, CLL
- TAD I T
- SZL
- ISZ ADDRHI
- ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES
- JMP XRADLP
- DCA ADDRLO
-NOINDX, TAD ADDRHI
- JMS I MCDF
- DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF
-ADDRHI, HLT /AND EXECUTE IT
- TAD ADDRLO
- JMP OPJCLL /GO EXECUTE THE INSTRUCTION
-
-DFBUMP, 0 /BUMP DATA FIELD
- DCA DFTMP /SAVE AC
- RDF
- TAD (CDF 10
- DCA .+1
- HLT
- TAD DFTMP /RESTORE AC
- JMP I DFBUMP
-DFTMP, 0
- DCDIDX, 0
- CLL RTR
- RAR
- TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY
-XRCDF, HLT /CDF TO XR ARRAY FIELD
- SZL
- JMS DFBUMP /OR MAYBE NEXT FIELD
- DCA T /SAVE POINTER TO XR
- TAD INST
- AND DCD100
- SZA CLA /INCREMENT BIT ON?
- ISZ I T /YES - BUMP XR
-DCD100, 100 /** PROTECTION
- JMP I DCDIDX
-
-BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE
-
-JMPTB1, FFGET / F MODE (FLOATING POINT)
- FFADD
- FFSUB
- FFDIV
- FFMPY
- OPMEM /FADDM
- FFPUT
- OPMEM /FMULM
-
- DDGET / D MODE ( DOUBLE PRECISION INTEGER)
- DDADD
- DDSUB
- DDDIV
- DDMPY
- OPMEM /DADDM
- DDPUT
- OPMEM /DMULM
-
- EEGET / E MODE ( 6 WD FLOATING POINT)
- FFADD
- FFSUB
- FFDIV
- FFMPY
- OPMEM
- EEPUT
- OPMEM
- PAGE
- /MORE I CYCLE
-
-SPECAL, SNA
- JMP XRINST /OPCODE 0 HAS MANY MANSIONS
- TAD SPECOP
- DCA SPCJMP /GET OPCODE JUMP ADDRESS
- JMS I [FETPC
- DCA ADR
- TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS
- JMS I MCDF /SO FORM THE ADDRESS NOW
- DCA DATAF
- CDF 0
- TAD INST
-SPCJMP, HLT
-
-XRINST, TAD INST
- AND (7770
- CDF 0
- SNA CLA /IF SUB-OPCODE IS ZERO,
- JMP OPERAT /DECODE SUB-SUB-OPCODE
- TAD INST
- AND [7
- CLL
- TAD XRBASE
- DCA ADR /COMPUTE INDEX REGISTER ADDRESS
- RTL
- RTL
- TAD I (XRCDF
- DCA DATAF
-XJCOMN, TAD INST
- CLL RTR
- RAR
- AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0
-OXCOMN, TAD (JMP I SP2
- DCA .+1 /EXECUTE APPROPRIATE JUMP
- HLT
-
-OPERAT, TAD INST
- CIA
- JMP OXCOMN
-
-SETX, TAD DATAF /SET XR0 LOC
- DCA I (XRCDF
- TAD ADR
- DCA XRBASE
- JMP I FPNXT
- /JUMP DECODER
-
-JUMPS, AND (100 /INSTRUCTION IN AC
- CLL RTR /20 IN AC IF NOT COND. JUMP
- SZA /IF NOT COND. JUMP, DECODE FURTHER
- JMP XJCOMN
- TAD INST
- AND [70
- CLL RTR
- RAR
- TAD (CNDSKT
- DCA T /INDEX INTO CONDITIONAL SKIP TABLE
- TAD I T
- DCA CNDSKP
- TAD ACH
- SZA
- JMP CNDSKP
- TAD ACL
- SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED.
- IAC /USE LOW ORDER ON 0/NOT 0 BASIS
-CNDSKP, HLT /TEST AC
- JMP I FPNXT /FAILED - DON'T JUMP
-
-DOJMP, STA CLL
- TAD ADR
- DCA PC
- SNL
- TAD (-10
- TAD DATAF
- CDF 0
- DCA I (PCCDF /ADDRESS-1 TO PC
- JMP I .+1
-YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8
-
-JXN, AND [70 /GET XR FIELD
- JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING
- TAD I T
- SNA CLA /ZERO?
- JMP I FPNXT /YES
- JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT?
-
-CNDSKT, SZA CLA /JEQ
- SPA CLA /JGE
- SMA SZA CLA /JLE
- SKP CLA /JA
- SNA CLA /JNE
- SMA CLA /JLT
- SPA SNA CLA /JGT
- JMP TSTALN /JAL
-
-TSTALN, CLA
- TAD ACX
- TAD (-27
- SPA SNA CLA
- JMP I FPNXT
- JMP DOJMP
- /OPCODE TABLES
-
-SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE
- JUMPS
- JXN
- TRAP3I
- TRAP4I
- TRAP5I
- TRAP6I
- TRAP7I
-
- FPJAC
- STRTD
- STRTF
- NRMFAC
- NEGFAC
- CLFAC
- FPAUSE
-SP2, EXIT
- ALN
- ATX
- FPXTA
- ICYCLE /NOP
- STRTE
- ICYCLE /UNDEF OP
- ICYCLE /"
- FPLDX
- ADDX
- SETX
- SETB
- JSA
- JSR
- PAGE
- /MISCELLANEOUS OPCODE ROUTINES
-
-TRAP3I,
-TRAP4I, AC0002
- TAD DATAF
- DCA .+1 /FORM CDF CIF N
- HLT /EXECUTE IT
- TAD INST
- SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS,
- JMP I ADR /TRAP3 JMP'S TO IT
- JMS I ADR
- JMP I FPNXT
-
-ALN, TAD ACX /ALIGN SIMULATOR
- DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE
- TAD DFLG
- SMA SZA CLA
- DCA ACX /ZERO EXP IF D.I. MODE
- JMS DATCDF /SET TO XR FIELD
- TAD INST
- AND [7
- TAD DFLG /IF WE'RE IN FLOATING POINT MODE,
- SNA CLA /AND DOING AN "ALN 0",
- TAD [27 /ALIGN UNTIL EXPONENT = 23
- SNA
- TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
- CDF 0
- CIA
- TAD ACX
- CMA /FORM DIFFERENCE - 1
- SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT,
- JMP ALNSHL /SHIFT LEFT
- JMS I [ACSR /OTHERWISE SHIFT RIGHT
-ALNXIT, TAD DFLG
- SPA SNA CLA /IF DOUBLE INTEGER MODE,
- JMP I FPNXT
- TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED
- DCA ACX
- JMP I FPNXT
-ALNSHL, DCA T /STORE SHIFT COUNT
- SKP /SHIFT LEFT ONE LESS THAN COUNT
- JMS I [AL1BMP
- ISZ T
- JMP .-2
- JMP ALNXIT /GO TO COMMON CODE
- /ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS
-
-DARGET, 0
- DCA ADR
- TAD DARGET
- DCA ARGET
- DCA ACX
- JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE
-
-ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC.
- DCA ADR /STORE ADDRESS OF OPERAND
- TAD I ADR /PICK UP EXPONENT
- ISZ ADR /MOVE POINTER TO HI MANTISSA WD
- SKP
- JMS I (DFBUMP
-ARGET2, DCA OPX
- TAD I ADR /PICK IT UP
- DCA OPH /STORE
- ISZ ADR /MOVE PTR. TO LO MANTISSA WD.
- SKP
- JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS!
- TAD I ADR /PICK IT UP
- DCA OPL /STORE IT
- CDF 0
- JMP I ARGET /RETURN
-
-STRTE, TAD DFLG /START EXTENDED PRECISION MODE
- SPA CLA
- JMP .+4 /CLEAR EXTENDED FAC
- DCA EAC1 /IF NOT ALREADY IN E MODE
- DCA EAC2
- DCA EAC3
- AC7775
- DCA DFLG
- JMP DFECMN
-
-STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE
-STRTF, DCA DFLG /START FLOATING POINT MODE
- TAD DFLG
-DFECMN, TAD (CLL
- DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC"
- TAD DFLG
- SPA
- CMA /CHANGE -3 FOR E MODE TO +2
- CLL RTL
- RAL
- TAD (JMPTB1&177+5600
- DCA I (BASJMP
- JMP I FPNXT
- /DOUBLE PRECISION INTEGER OPERATORS
-
-DDSUB, JMS DARGET
- JMS I (OPNEG
- SKP
-DDADD, JMS DARGET
- DCA AC1 /CLEAR OVERFLOW JUSTINCASE
- JMS I [OADD
- JMP I FPNXT
-
-FFGET, DCA ADR /GET A FLOATING POINT NUMBER
- TAD I ADR
- DCA ACX /SAVE EXPONENT
- ISZ ADR
- JMP .+3 /NO FIELD OVERFLOW
- JMS I (DFBUMP /BUMP DATA FIELD
-DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET
- TAD I ADR
- DCA ACH
- ISZ ADR
- SKP
- JMS I (DFBUMP
- TAD I ADR
- DCA ACL
- JMP I FPNXT
-
-FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER
- TAD ACX /GET FAC AND STORE IT
- DCA I ADR /AT SPECIFIED ADDRESS
- ISZ ADR
- JMP .+3
- JMS I (DFBUMP
-DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT
- TAD ACH
- DCA I ADR
- ISZ ADR
- SKP
- JMS I (DFBUMP
- TAD ACL
- DCA I ADR
- JMP I FPNXT
- PAGE
- FPPKG= . /FOR EAE OVERLAY
-
-/23-BIT FLOATING PT INTERPRETER
-/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN
-
-LPBUF2, ZBLOCK 16
- LPBUF3
-
-AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER
- STA
- TAD ACX
- DCA ACX
- JMS I [AL1
- JMP I AL1BMP
-
-/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
-DDMPY, JMS I (DARGET
- SKP
-FFMPY, JMS I (ARGET /GET OPERAND
- JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN.
- TAD ACX /DO EXPONENT ADDITION
- DCA ACX /STORE FINAL EXPONENT
- DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE
- DCA AC2
- TAD ACH /IS FAC=0?
- SNA CLA
- DCA ACX /YES-ZERO EXPONENT
- JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR.
- TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
- DCA OPL
- JMS MP24
- TAD AC2 /STORE RESULT BACK IN FAC
- DCA ACL /LOW ORDER
- TAD MDSET /HIGH ORDER
- DCA ACH
- TAD ACH /DO WE NEED TO NORMALIZE?
- RAL
- SMA CLA
- JMS AL1BMP /YES-DO IT FAST
- TAD AC1
- SPA CLA /CHECK OVERFLOW WORD
- ISZ ACL /HIGH BIT ON - ROUND RESULT
- JMP MDONE
- ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER
- TAD ACH
- SPA /CHECK FOR OVERFLOW TO 4000 0000
- JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE
- CLA
- MDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???)
- ISZ MSIGN /SHOULD RESULT BE NEGATIVE?
- SKP /NO
- JMS I [FFNEG /YES-NEGATE IT
- TAD ACH
- SNA CLA /A ZERO AC MEANS A ZERO EXPONENT
- DCA ACX
- TAD DFLG
- SMA SZA CLA /D.P. INTEGER MODE?
- TAD ACX /WITH ACX LESS THAN 0?
- SNA
- JMP I FPNXT /NO - RETURN
- CMA
- JMS I [ACSR /UN-NORMALIZE RESULT
- JMP I FPNXT /RETURN
- /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
-/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
-/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
-/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
-/DATA FIELD SET PROPERLY FOR OPERAND.
-
-MDSET, 0
- CLA CLL CMA RAL /SET SIGN CHECK TO -2
- DCA MSIGN
- TAD OPH /IS OPERAND NEGATIVE?
- SMA CLA
- JMP .+3 /NO
- JMS I (OPNEG /YES-NEGATE IT
- ISZ MSIGN /BUMP SIGN CHECK
- TAD OPL /AND SHIFT OPERAND LEFT ONE BIT
- CLL RAL
- DCA OPL
- TAD OPH
- RAL
- DCA OPH
- DCA AC1 /CLR. OVERFLOW WORF OF FAC
- TAD ACH /IS FAC NEGATIVE
- SMA CLA
- JMP LEV /NO-GO ON
- JMS I [FFNEG /YES-NEGATE IT
- ISZ MSIGN /BUMP SIGN CHECK
- NOP /MAY SKIP
-LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC
- JMP I MDSET
-MSIGN, 0
- /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL
-/MULTIPLICAND IS IN ACH AND ACL
-/RESULT LEFT IN MDSET,AC2, AND AC1
-
-MP24, 0
- TAD (-14 /SET UP 12 BIT COUNTER
- DCA OPX
- TAD OPL /IS MULTIPLIER=0?
- SZA
- JMP MPLP1 /NO-GO ON
- DCA AC1 /YES-INSURE RESULT=0
- JMP I MP24 /RETURN
-MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER
-MPLP1, RAR /OF MULTIPLIER AND INTO LINK
- DCA OPL
- SNL /WAS IT A 1?
- JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT
- TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
- TAD ACL /LOW ORDER
- DCA AC2
- CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK!
- TAD ACH /HI ORDER
-MPLP2, TAD MDSET
- RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
- DCA MDSET
- TAD AC2
- RAR
- DCA AC2
- TAD AC1
- RAR /OVERFLOW TO AC1
- DCA AC1
- ISZ OPX /DONE ALL 12 MULTIPLIER BITS?
- JMP MPLP /NO-GO ON
- JMP I MP24 /YES-RETURN
- PAGE
- /DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE
-
-DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL
- JMS I ERR /GIVE ERROR MSG
- TAD DBAD
- DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER
- AC2000
- JMP FD
-
-/FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD
-
-DDDIV, JMS I (DARGET
- SKP
-FFDIV, JMS I (ARGET /GET OPERAND
- JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
- CMA IAC /NEGATE EXP. OF OPERAND
- TAD ACX /ADD EXP OF FAC
- DCA ACX /STORE AS FINAL EXPONENT
- TAD OPH /NEGATE HI ORDER OP. FOR USE
- CLL CMA IAC /AS DIVISOR
- DCA OPH
- JMS DV24 /CALL DIV.--(ACH+ACL)/OPH
- TAD ACL /SAVE QUOT. FOR LATER
- DCA AC1
- TAD OPL
- SNA CLA
- JMP DVL2 /AVOID MULTIPLYING BY 0
- TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY
- DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY
- JMP DVLP1 /LOW ORDER OF OPERAND (OPL)
-
-/DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0)
-
-DV24, 0
- TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND
- TAD OPH /DIVISOR IN OPH (NEGATIVE)
- SZL CLA /IS IT?
- JMP DBAD /NO-DIVIDE OVERFLOW
- TAD (-15 /YES-SET UP 12 BIT LOOP
- DCA AC2
- JMP DV1 /GO BEGIN DIVIDE
-DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT
- RAL
- DCA ACH /RESTORE HI ORDER
- TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER
- TAD OPH /DIVIDEND
- SZL /GOOD SUBTRACT?
- DCA ACH /YES-RESTORE HI DIVIDEND
- CLA /NO-DON'T RESTORE--OPH.GT.ACH
-DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT
- RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL
- DCA ACL
- ISZ AC2 /DONE 12 BITS OF QUOT?
- JMP DV2 /NO-GO ON
- JMP I DV24 /YES-RETN W/AC2=0
- /DIVIDE ROUTINE CONTINUED
-
-MP12L, DCA OPL /STORE BACK MULTIPLIET
- TAD AC2 /GET PRODUCT SO FAR
- SNL /WAS MULTIPLIER BIT A 1?
- JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT
- CLL /YES-CLEAR LINK AND ADD MULTIPLICAND
- TAD ACL /TO PARTIAL PRODUCT
- RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
- DCA AC2 /RESULT-STORE BACK
-DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER
- RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
- ISZ DV24 /DONE ALL BITS?
- JMP MP12L /NO-LOOP BACK
- CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
- DCA ACL /NEGATE AND STORE
- CML RAL /PROPAGATE CARRY
- TAD AC2 /NEGATE HI ORDER PRODUCT
- STL CIA
- TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV.
- SZL /WELL?
- JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
- DCA ACH /OK - DO (REM - (Q*OPL)) / OPH
-DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND)
-DVL1, TAD AC1 /GET QUOT. OF FIRST DIV.
- SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
- JMP FD /NO-ITS NORMALIZED-DONE
-SHR1, CLL
- ISZ ACL /ROUND AND SHIFT RIGHT ONE
- SKP
- IAC /DOUBLE PRECISION INCREMENT
- RAR
- DCA ACH /STORE IN FAC
- TAD ACL /SHIFT LOW ORDER RIGHT
- RAR
- DCA ACL /STORE BACK
- ISZ ACX /BUMP EXPONENT
- NOP
- TAD ACH
- JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN
-FD, DCA ACH /STORE HIGH ORDER RESULT
- JMP I (MDONE /GO LEAVE DIVIDE
-
-DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0
- JMP DVL3 /SAVE SOME TIME
- /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
-/REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL
-
-DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER
- DCA ACH
- CLL
- TAD OPH
- TAD ACH /WATCH FOR OVERFLOW
- SNL
- JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
- DCA ACH /NO OVERFLOW-STORE NEW REM.
- CMA /SUBTRACT 1 FROM QUOT OF
- TAD AC1 /FIRST DIVIDE
- DCA AC1
-DVOP1, CLA CLL
- TAD ACH /GET HI ORD OF REMAINDER
- SNA /IS IT ZERO?
-DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO
- DCA ACH
- JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR
- TAD ACL /NEGATE THE RESULT
- CLL CMA IAC
- DCA ACL
- SNL /IF QUOT. IS NON-ZERO, SUBTRACT
- CMA /ONE FROM HIGH ORDER QUOT.
- JMP DVL1 /GO TO IT
-
-LPBUF3, ZBLOCK 12
- LPBUF4
- PAGE
- /"OPNEG" MUST BE AT 0 ON PAGE
-
-OPNEG, 0 /ROUTINE TO NEGATE OPERAND
- TAD OPL /GET LOW ORDER
- CLL CIA /NEGATE AND STORE BACK
- DCA OPL
- CML RAL /PROPAGATE CARRY
- TAD OPH /GET HI ORDER
- CLL CIA /NEGATE AND STORE BACK
- DCA OPH
- JMP I OPNEG
-/
-/FLOATING SUBTRACT AND ADD
-/
-FFSUB, JMS I (ARGET /PICK UO THE OP.
- JMS OPNEG /NEGATE OPERAND
- SKP
-FFADD, JMS I (ARGET /PICK UP OPERAND
- TAD OPH /IS OPERAND = 0
- SNA CLA
- JMP I FPNXT /YES-DONE
- TAD ACH /NO-IS FAC=0?
- SNA CLA
- JMP CLROFL /CLEAR OUT THE OVERFLOW BITS
- TAD ACX /NO-DO EXPONENT CALCULATION
- CLL CIA
- TAD OPX
- SMA SZA /WHICH EXP. GREATER?
- JMP FACR /OPERANDS-SHIFT FAC
- CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1
- TAD (-30
- SMA /TEST FOR INSIGNIFICANCE
- JMP OPINSG /YES - ANSWER IS FAC
- TAD (30
- JMS OPSR
- JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT
-DOADD, TAD OPX /SET EXPONENT OF RESULT
- DCA ACX
- JMS I [OADD /DO THE ADDITION
- JMS FFNOR /NORMALIZE RESULT
- JMP I FPNXT /RETURN
-FACR, TAD (-30
- SMA /TEST FOR INSIGNIFICANCE
- JMP ACINSG /YES - ANSWER IS OPR
- TAD (30
- JMS I [ACSR /SHIFT FAC = DIFF.+1
- JMS OPSR /SHIFT OPR. 1 PLACE
- JMP DOADD /DO ADDITION
-
-OPINSG, CLA
- JMP I FPNXT
- /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC
-
-OPSR, 0
- CMA /- (COUNT+1) TO SHIFT COUNTER
- DCA AC0
-LOP2, TAD OPH /GET SIGN BIT
- CLL /TO LINK
- SPA
- CML /WITH HI MANTISSA IN AC
- RAR /SHIFT IT RIGHT, PROPAGATING SIGN
- DCA OPH /STORE BACK
- TAD OPL
- RAR
- DCA OPL /STORE LO ORDER BACK
- ISZ OPX /INCREMENT EXPONENT
- NOP
- ISZ AC0 /DONE ALL SHIFTS?
- JMP LOP2 /NO-LOOP
- RAR /SAVE 1 BIT OF OVERFLOW
- DCA AC2 /IN AC2
- JMP I OPSR /YES-RETN.
-
-FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC
- TAD ACH /GET THE HI ORDER MANTISSA
- SNA /ZERO?
- TAD ACL /YES-HOW ABOUT LOW?
- SNA
- TAD AC1 /LOW=0, IS OVRFLO BIT ON?
- SNA CLA
- JMP ZEXP /#=0-ZERO EXPONENT
-NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC
- TAD ACH /ADD HI ORDER MANTISSA
- SZA /HI ORDER = 6000
- JMP .+3 /NO-CHECK LEFT MOST DIGIT
- TAD ACL /YES-6000 OK IF LOW=0
- SZA CLA
- SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS.
- JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7)
- JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN
- JMP NORMLP /GO BACK AND SEE IF NORMALIZED
-ZEXP, DCA ACX
-FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1
- JMP I FFNOR /RETURN
-
-ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION
- DCA ACH
- DCA ACL
- JMP DOADD-1 /FAKE AN ADD WITH OPR=0
-
-LPBUF4, ZBLOCK 40
- LPBUFE
-CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD
- DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD
- JMP DOADD /FAC=0; DO THE ADD
- PAGE
- /PAGE 7400 UNUSED RIGHT NOW
-
-LPBUFE, ZBLOCK 177
- LPBUFR
- FIELD 1
-
DELETED src/os8-v3f/RX78C.PA
Index: src/os8-v3f/RX78C.PA
==================================================================
--- src/os8-v3f/RX78C.PA
+++ /dev/null
@@ -1,455 +0,0 @@
-/RX NON-SYSTEM HANDLER, GENERAL CONTROLLER TYPE
-/FLOPPY DISK HANDLER FOR OS/8
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /
-/ THIS HANDLER IS SPECIFICALLY FOR A SECOND PAIR OF DRIVES ON A VT78!!
-/
-/DEFINITIONS OF RX8/E IOT'S
-
-RXVER= "N&77
-
-DEVCOD= 750 /DEVICECODE
-
-LCD= 6001+DEVCOD /LOAD COMMAND REGISTER
-XDR= 6002+DEVCOD /TRANSFER DATA REGISTER
-STR= 6003+DEVCOD /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
-SER= 6004+DEVCOD /SKIP ON ERROR FLAG, CLEAR FLAG
-SDN= 6005+DEVCOD /SKIP ON DONE FLAG, CLEAR FLAG
-INTR= 6006+DEVCOD /INTERRUPT ENABLE/DISABLE
-INIT= 6007+DEVCOD /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
-
-
-/NOTES ON THIS HANDLER:
-
-/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
-/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
-/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
-
-/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES RX01 DATA
-/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
-/ARE WRITTEN IN THE SEQUENCE:
-/ 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
-
-/DOUBLE DENSITY MEDIA ARE WRITTEN IN A THREE WAY INTERLEAVE
-/ 1,4,7,10,13,16,19,22,25,2,5,8,11,14,17,20,23,26,3,6,9,12,15,18,21,24
-
-/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO
-
-AC4000=CLL CLA CML RAR /SET AC TO 4000
-AC7776=CLL CLA CMA RAL /SET AC TO 7776
-AC0002=CLL CLA CML RTL /SET AC TO 0002
-AC7775=CLL CLA CMA RTL /SET AC TO 7775
- /
-/BUILD DATA
- *0
-/
- -2 /TWO ENTRY POINTS
- DEVICE RX0B /DEVICE GROUP NAME
- DEVICE RXA2 /ENTRY POINT NAME
- 4320 /CODE FOR MULTI-RX
- RXA2&177+4000 /ENTRY POINT OFFSET
- 0
- 0
- DEVICE RX0B /DEVICE GROUP NAME
- DEVICE RXA3 /ENTRY POINT NAME
- 4320 /THIS WAS CHANGED FROM 4270 - ASSIGNED TO CASSETTE
- RXA3&177+4000 /ENTRY POINT OFFSET
- 0
- 0
- *200
-/
-/
-/ INIT CODE
-/
-POINT, HLT /ADDR OF SECOND PAGE AT INIT TIME
-UNIT, JMS I POINT /GO TO SECOND PAGE TO INIT
-/
-/ LIST OF VECTORS TO SECOND PAGE
-/
-LQUO, QUO-. /LQUO MUST LEAD OFF LIST
-LRETRY, RETRY-.
-LREC, REC-.
-LSIZE, SIZE-.
-LREMD, REMD-.
-LFN, FN-.
-LDENSW, DENSW-.
-LSELCT, SELECT-.
-LENTRY, ENTRY-.
-VCOUNT=LQUO-. /FALLS THRU TO WHICH, HERE IS VECTOR COUNT
-/
-/ COME HERE FROM ZOO
-/
-/ PROCESS ENTRY POINT, DEVICE TYPE
-/
-WHICH, CLA IAC /SELECT SECOND PAIR IF DRIVES
- JMS I LSELCT
- AC7775 /SET RETRY COUNTER
- DCA I LRETRY
- TAD I ZOO /GET UNIT NUMBER*20+402
- DCA UNIT /HOLD FOR LATER
- ISZ ZOO /MOVE TO TYPE CODE
- TAD I ZOO /HAS THIS DRIVE BEED INIT'ED
-L7700, SMA CLA /SKIP IF NO
- JMP NORMAL /GO TO NORMAL PATH
-RSTART, TAD UNIT /PICK UP UNIT BIT, DOUBLE DENSITY +2
- TAD L10 /MAKE A READ STATUS CODE
- SDN
- JMP .-1
- LCD
- JMP BOUNCE /HOP OVER ENTRY POINTS
-/
- /
-/
- IFZERO .&177-34&4000 <_ERROR_>
-/
-/ ENTRY POINTS ARE AT 33, 37
-/
- *.&7600+33
-/
-RXA2, 0
- JMS ZOO /COMMON ENTRY ROUTINE
- 402 /UNIT 0, 402 FOR CONVENIENCE
- -1 /MINUS SAYS STILL HAVE TO INIT IT;
-/ /SINGLE=0, DOUBLE=20, QUAD=22
-RXA3, 0
- JMS ZOO
-L422, 422 /20 SAYS UNIT 1, 402 FOR CONVENIENCE
-DOOR, JMP WHICH /INIT TIME LITERAL (MUST BE MINUS)
-/ /GETS SAME TYPE CODE AS OTHER ENTRY POINT
-/
-/ REST OF SET UP CODE
-/
-BOUNCE, SDN
- JMP .-1
- XDR /GET STATUS WORD
- AND L32 /KEEP DENSITY ERROR; DOUBLE; QUAD
- TAD L10 /SINGLE=10;SING/DOUB=40;DOUB=20;QUAD=22
- AND L422 /SINGLE=0;SING/DOUB=0;DOUB=20;QUAD=22
- DCA I ZOO /PLACE TYPE CODE, THREE LOC.'S AFTER ENTRY POINT
- SER /CLEAR ERROR FLAG
-L10, 10 /MAY SKIP
- TAD L416 /SET DONE FLAG AGAIN
- LCD
-NORMAL, TAD I ZOO /FETCH BACK TYPE CODE
- SZA CLA /SKIP IF A SINGLE DENSITY
- TAD L7700 /DOUBLE
- TAD L7700 /SINGLE=7700, DOUBLE=7600
- DCA I LDENSW /PLACE FOR LOOP CONTROL
- TAD I ZOO
- CLL RTR /PUT QUAD BIT TO LINK
- SNA CLA /SKIP IF DOUBLE OR QUAD
- TAD L1734 /SINGLE
- TAD L4110 /D&Q=4110, S=6044
- SNL /SKIP ON QUAD, IT'S OK RIGHT NOW
- CLL CML RAR /SINGLE AND DOUBLE DIVIDE BY 2
- DCA I LSIZE /S=7022, D=6044, Q=4110
- TAD I LDENSW /7700 IF SINGLE, 7600 IF DOUBLE
- CLL CMA RTL /375 IF SINGLE, 775 IF DOUBLE
- AND UNIT /VOILA, 400*DOUBLE + 20*UNIT
- DCA I LFN /PLACE INTO FUNCTION CONTROL WORD
- AC7775 /BACK UP ZOO TO FETCH CALLING ADDR
- TAD ZOO
- DCA T1 /HOLD TEMPORARY
- TAD I T1 /HERE IS CALLING ADDR
-CLLFLD, HLT /PUT CDF TO CALLING FIELD HERE
- JMS I LENTRY /GO TO SECOND PAGE, LEAVING POINTER TO DIVSUB
-/
-/ DIVSUB SUBROUTINE !!MUST!! FOLLOW IMMEDIATELY
-/
- /
-/ DIVSUB
-/
-/ CALL TO SET UP TRACK, SECTOR, FROM OVERALL SECTOR #
-/ ALSO, SET UNIT WITH HEAD COMMAND IF WE ARE ON TO SECOND SIDE
-/
-/ CALL WITH AC <0 IF IT IS REALLY AN ERROR RETRY
-/ CALL WITH AC >=0 IF CALL TO DIVSUB
-/
-DIVSUB, 0
- CDF 0 /AND DATA FIELD MUST BE TO HERE
- SPA CLA /SKIP IF REALLY A DIVIDE REQUEST
- JMP RSTART /NO, IT WAS AN ERROR RETRY!!
- DCA I LQUO /CLEAR DIVIDE QUOTIENT
- TAD I ZOO /IS IT A TWO HEADER
- RTR /PUT QUAD BIT TO LINK
- SNL CLA /SKIP IF YES
- JMP SHUNT /NO, GO DO DIVIDE
- TAD I LREC /WHICH RECORD ARE WE WORKING ON
- TAD LM3670 /NUMBER OF SECTORS ON FIRST SIDE
- SZL CLA /SKIP IF SECOND SIDED IT
- JMP SHUNT /NO, JUST REGULAR
- TAD I LFN /FORCE HEAD BIT ON
- AND L422 /KEEP DOUBLE, UNIT, READ-WRITE
- TAD L1000 /ADD IN SECOND SIDE
- DCA I LFN
- TAD LM3670 /BUT DECREASE RECORD NUMBER
-SHUNT, TAD I LREC /THIS FOR TRACK-SECTOR
-DIVLOO, ISZ I LQUO /MAIN DIIVIDIE LOOP
- TAD LM32 /DIVIDE BY 26 TO GET TRACK
- SMA /SKIP IF DONE
- JMP DIVLOO
- TAD L32 /REMAINDER 0-25
- DCA T1 /HOLD IT IN TEMPORARY
- TAD I ZOO /SINGLE DENSITY
- SZA CLA /SKIP IF YES
- TAD T1 /MULTIPLY BY THREE FOR DOUBLE
- TAD T1 /AND BY TWO FOR SINGLE
- TAD T1
- CLL IAC /LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
- TAD LM32 /DIVIDE BY 26 TO GET SECTOR
- SMA SZA /SKIP IF DONE
- JMP .-2
- TAD L32 /RESTORE POSITIVE VALUE TO BE SECTOR
- DCA I LREMD /WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
- RAL /IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
- TAD I ZOO /BUT WE HAVE 1,3,5,7,9,11,13,15... SO WE MUST INCREMENT!
- SNA CLA /SKIP IF SOME OTHER CASE
- ISZ I LREMD /NOW HAVE IT 2,4,6,8,10,12,14,16...
- JMP I DIVSUB /OUT
- /
-/
-L416, 416 /SOME LITERALS
-L32, 32
-L1000, 1000
-LM32, -32
-L1734, 1734
-L4110,
-LM3670, -3670
-/
-/
-/
- *.&7600+167 /FORCE TO END OF PAGE
-/ ZOO SUBROUTINE
-/
-/ TO SET UP ENTRY POINT PROCESSING, AND INIT CODE
-/
-ZOO, 0 /ADDR OF 'HIT' ENTRY POINT +2 COMES HERE
- CLA /FOR SAFETY
- RDF /SAVE CALLERS FIELD SETTING
- TAD LCDF0 /ADD IN CDF 0
- DCA CLLFLD /RESET WHEN GOING TO I/O SUB
-LCDF0, CDF 0 /DATA FIELD HERE FOR INDIRECTS
-CLOSE, TAD DOOR /CLOSE DOOR TO ONCE ONLY CODE (JMP WHICH
-T1, DCA CLOSE /USE ONCE-ONLY FOR TEMPORARY LOCATION
- JMS POINT /LEAVE ADDR OF SECOND PAGE
- /
-/
-/ VARIABLES, ALSO INIT CODE LIVES HERE
-/
-/
-BUF, 0 /POINTER TO CALLER'S BUFFER
-RETRY, 0 /RETRY COUNT
-SIZE, 0 /SIZE OF DEVICE
-SYS, 0 /POINTER TO CALL
-QUO, 0 /DIVIDE QUOTIENT, WHICH IS TRACK NUMBER
-REC, 0 /SECTOR NUMBER OF FLOPPY
-BC, 0 /CONTROL COUNT, WORDS TO TRANSFER
-FN, 0 /0 FOR WRITE; 2 FOR READ; HEAD, DENSITY, UNIT
-DENSW, 0 /7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
-ENTRY, 0 /ENTRY POINT, LEAVE ADDR OF DIVSUB HERE
-/
- IFNZRO .&177-10&4000 <_ERROR> /ENOUGH ROOM FOR INIT?
-/
- *.&7600
-/
-/ INIT TIME: FILL VECTOR TABLE
-/
-THERE, 0 /FILLED BY JMS, POINTS TO VECTOR
-ILOOP, TAD THERE /POINTER IS ALSO OFFSET!
- TAD I THERE /MAKING VECTOR
- DCA I THERE
- ISZ THERE /MOVE TO NEXT VECTOR
- ISZ LDCMD /CONTROL COUNT ON THIS PAGE
- JMP ILOOP
- JMP I THERE /BACK TO FIRST PAGE
- /
-/ IO SUBROUTINE
-/
-/ ENTRY POINT AT END OF LAST LISTING PAGE
-/
-/
- *ENTRY+1 /RESUME RUNTIME CODE
-/
- DCA SYS /POINTER TO ARG'S, EXIT
- RDF /DATA FIELD OF USER CALL
- TAD (CDF CIF 0 /MAKE CDF CIF TO CALLER'S FIELD
- DCA EXFLD /SET UP FOR CALL
- AC4000 /SET LINK=0, AC=4000
- TAD I SYS /CARRY READ-WRITE BIT TO LINK
- AND L70 /KEEP FIELD FOR BUFFER
- TAD LLCDF0 /MAKE CDF TO BUFFER FIELD
- DCA BUFCDF /PLACE INTO I/O LOOP
- CML RTL /MAKE FUNCTION CODE, 0=WRITE, 2=READ
- TAD FN /START-UP CODE HAS SET HEAD, DENSITY, UNIT ETC.
- DCA FN
- TAD I SYS /MAKE LOOP CONTROL COUNT
- RAL
- AND L7600
- CIA /0 FOR WHOLE FIELD
- DCA BC /MINUS TOTAL NUMBER OF WORDS
- ISZ SYS /NEXT
- TAD I SYS /IS BUFFER ADDRESS
- DCA BUF
- ISZ SYS /NEXT
- TAD L175 /CARRY WITH DENSW IF SINGLE DENSITY
- TAD DENSW /BLOCK # TO SECTOR #
- SMA CLA /SKIP IF DOUBLE, MULTIPLY BY 2
- TAD I SYS /SINGLE, MULTIPLY BY FOUR
- SMA /SKIP ON ILLEGAL NEGATIVE BLOCK #, FORCE LINK ON LATER
- TAD I SYS
- ISZ SYS /MOVE POINTER TO ERROR EXIT
- CLL RAL
- DCA REC /SAVE SECTOR NUMBER
- SZL /SKIP IF LEGAL BLOCK #
- JMP ERREX /FORCE SIZING OF DISK TO RETURN SIZE IN AC
- JMS I ENTRY /CALL DIVISION SUBROUTINE OTHER PAGE
- TAD FN /SPLIT READ AND WRITE
- RTR /READ-WRITE BIT TO LINK
- SZL CLA /WRITE SKIPS
- JMP STREAD /READ GOES TO START IN MIDDLE OF LOOP
-/ /WRITE FALLS THRU TO NEXT LISTING PAGE
- /WRITE FALLS THRU TO THIS LOOP
-/
-/ TOP OF MAIN LOOP
-/
-TOP, TAD FN /SET SILO TO LOAD-UNLOAD
- JMS LDCMD /COMMAND TO CONTROLLER
- TAD DENSW /MAKE SILO LOOP COUNT, S=7700, D=7600
- DCA FLPWC /LDCMD ENTRY SAFE TEMPORARY
-BUFCDF, HLT /CDF TO BUFFER FIELD PLACED HERE
-TRLOOP, TAD I BUF /IN CASE WRITE, FETCH A WORD
- STR /SKIP IF READY TO PASS DATA
- JMP .-1 /NO
- XDR /TO OR FROM AC
- DCA I BUF /PLACE WORD FOR READ, WRITE REPLACES SAME
- ISZ BUF /MOVE BUFFER POINTER, (MAY SKIP)
-REMD, 0 /DIVIDE REMAINDER, WHICH IS SECTOR NUMBER
- ISZ FLPWC /DONE YET
- JMP TRLOOP
- TAD DENSW /ADDING 77 (SINGLE) 177 (DOUBLE)
- CMA /ONCE WE CMA, THAT IS
- TAD BC /LOOP CONTROL TO FINISH READ
- SNA
- JMP OKEX /OK, DONE
- DCA BC /REPLACE AND KEEP GOING
-/
-/ MIDDLE OF MAIN LOOP
-/
-STREAD, CLA CLL IAC RTL /KNOWN TO BE A 78, SO THIS WORKS! FOR LITERAL 4
- TAD FN /TURNING SILO COMMAND INTO READ-WRITE COMMAND
- JMS LDCMD /I/O COMMAND TO CONTROLLER
- TAD REMD /PRECOMPUTED SECTOR #
- STR
- JMP .-1
- XDR
-L7600, 7600 /CLEAR AC, AND IS LITERAL
- TAD QUO /TRACK #
- STR
- JMP .-1
- XDR /TRACK # IS ALWAYS NON0 !!
- ISZ REC /MOVE TO NEXT RECORD NUMBER
- JMS I ENTRY /DO TRACK SECTOR FOR NEXT OPERATION
- TAD LL16 /WAIT FOR OPERATION TO COMPLETE
- JMS LDCMD
- ISZ BC /CHECK FOR WRITE EXIT
- JMP TOP /STILL MORE
-OKEX, ISZ SYS /KICK TO OK EXIT
-SELBAK, DCA REC /TEMPORARY TO HOLD AC
- JMS SELECT /AC NOW 0 TO FORCE SELECT OF FIRST PAIR
- TAD REC /RETURN WITH (POSSIBLE) AC VALUE
-EXFLD, HLT /CDF CIF TO CALLER
- JMP I SYS /OUT
- /
-/
-/ LDCMD SUBROUTINE
-/
-/ CHECK FOR CONTROL C, LOAD A COMMAND
-/
-FLPWC=. /ENTRY POINT A TEMPORARY
-LDCMD, VCOUNT /INIT COUNTER
- DCA TRANS /SAVE COMMAND
-LLCDF0, CDF 0 /DATA FIELD HERE IN CASE CONTROL C TO MONITOR
-TSTTT, KSF /SKIP IF A TTY CHARACTER HAS HAPPENED
- JMP TSTSD /NOPE, GO CHECK RX CONTROLLER READY
- TAD L7600 /FORCE TOP BITS TO BE 1 TO ELIMINATE 3,203
- KRS /AMBIGUITY ON TEST
- TAD L175 /IS IT A CONTROL C
- SNA CLA /SKIP IF NOT
- JMP MONEX /GO EXIT TO MONITOR
-TSTSD, SDN /IS RX CONTROLLER READY
- JMP TSTTT /NOPE, GO CHECK TTY
- TAD TRANS /GET BACK COMMAND
- LCD /TO CONTROLLER
- SER /SKIP IF AN ERROR
- JMP I LDCMD
- AC4000 /ERROR CODE FOR HARD ERROR
- SKP /SKIP OVER SIZING ENTRY
-ERREX, TAD SIZE /PUT NEGATIVE SIZE IN AC
- ISZ RETRY /TRY THREE TIMES?
- JMS I ENTRY /NO, AC NEGATIVE SAYS RETRY NOT DIVIDE!!
- JMP SELBAK /SELECT BACK TO FIRST PAIR
-/
-MONEX, JMS SELECT /AC=0, SELECT FIRST PAIR
- JMP I L7600 /BACK
-/
-/
-/
-/ SELECT ROUTINE
-/
-TRANS, /TEMPORARY FOR LDCMD TO SAVE COMMAND
-SELECT, 0
- 6750 /CONTENTS OF AC11 SAYS WHICH PAIR
- SER /CLEAR POSSIBLE ERRANT FLAGS
-L70, 70 /SAFE NO-OP
- SDN
-L175, 175
- STR
-LL16, 16
- CLA /PERHAPS NOT NECESSARY
- TAD LL16 /SET DONE FLAG AGAIN
- LCD
- JMP I SELECT
-/
- PAGE
-/
DELETED src/os8-v3f/RXCOPY.PA
Index: src/os8-v3f/RXCOPY.PA
==================================================================
--- src/os8-v3f/RXCOPY.PA
+++ /dev/null
@@ -1,1444 +0,0 @@
-/ RXCOPY FOR OS/8 V3D AND OS/78 V1A
-/
-/ 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 SOPYRIGHT NOTICE. THIS SOFTWARE, OR ANY THEREOF,
-/ MAY NOT BE PROVIDED 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 AT ALL TIMES REMAIN IN DEC.
-/
-/ THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
-/ NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
-/ EQUIPMENT CORPORATION.
-/
-/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
-/ SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
-/
-
-/
-/ VERSION V4A M.H. MAY 20, 1977
-/ S.R. MAY 20, 1977
-/ VERSION V4B S.R. AUG 24, 1978
-/
-/ START ADDRESS 16000; JSW 7003
-/
-/ THIS PROGRAM PERFORMS COPY, READ, AND COMPARE OPERATIONS ON
-/ RX FLOPPY DISKS ON A TRACK BY TRACK BASIS.
-/
-/ THE COMMAND OPTIONS ARE:
-/
-/P PAUSE BEFORE AND AFTER ACCESSING DISK
-/M MATCH WITH NO IMPLIED COPY
-/N COPY WITH NO IMPLIED MATCH
-/R READ OUTPUT DEVICE WITH NO IMPLIED MATCH OR COPY
-/V PRINT VERSION NUMBER
-/C (NOT DOCUMENTED) COPY
-/S FORMAT (ONLY) OUTPUT DEVICE TO SINGLE DENSITY
-/D FORMAT (ONLY) OUTPUT DEVICE TO DOUBLE DENSITY
-/ IF NO OPTIONS ARE EXPLICITLY DECLARED, COPY AND MATCH ARE ASSUMED.
-/
-/ THERE ARE TWO COMMAND FORMATS:
-/
-/ DEV:<DEV:/OPTION WHERE OPTIONS ARE C, P, N, M, OR V.
-/ DEV:/R DEV:</R <DEV:/R THREE FORMATS FOR R, S, D, OR V.
-/
-/
-/ WARNING!!
-/
-/ THIS PROGRAM HAS TWO PATHOGENIC CONNECTIONS WITH THE STANDARD
-/ RX HANDLERS
-/
-/ IT IS ASSUMED THAT THE RX SYSTEM HANDLER HAS AT LOCATION 7623
-/ A WORD THAT CONTAINS THE 20 BIT IF BOOTED TO UNIT #1
-/
-/ IT IS ASSUMED THAT THE RX NON-SYSTEM HANDLER HAS ENTRY POINTS
-/ CORRESPONDING TO UNIT NUMBERS AS FOLLOWS:
-/
-/ UNIT LAST DIGIT OF ENTRY POINT
-/
-/ 0 0
-/ 1 4
-/ 2 1
-/ 3 5
-/
-/ WHERE UNITS 2 AND 3 ARE A SECOND PAIR OF FLOPPIES ON A VT78 ONLY!
-/
-/
-
-MAGIC=7623 /WORD IN RX SYSTEM HANDLER HAS 20 IF BOOTED ONTO
-/ /UNIT #1 (RIGHT-HAND ONE)
-OPT1=7643 /1ST COMMAND DECODER OPTION WORD
-OPT2=7644 /2ND COMMAND DECODER OPTION WORD
-OPT3=7645 /3RD COMMAND DECODER OPTION WORD
-BUFF=2000 /INPUT BUFFER FOR TTY MSGS
-TYP1=25 /DEVICE CODE FOR RX01
-TYP2=32 /DEVICE CODE FOR MULTI-RX HANDLER WAS 27 (TAKEN BY TA8E)
-BSIZE=6400 /BUFFER SIZE IN OCTAL WORDS
-BSTART=20 /BUFFER START
-BHALF=BSIZE%2 /HALF OF BSIZE
-USR=200 /ENTRY POINT OF USR
-NOMAT=2000 /NO MATCH OPTION MASK
-COPY=1000 /COPY OPTION MASK
-MATCH=4000 /MATCH OPTION MASK; NOTE SOME CODE !KNOWS! THIS IS 4000
-READ=0100 /READ OPTION MASK
-VERSION=0004 /VERSION OPTION MASK
-PAUS=0400 /PAUSE OPTION MASK
-SINGLE=40 /SINGLE DENSITY FORMAT ONLY
-DOUBLE=200 /DOUBLE DENSITY FORMAT ONLY
-OLDOUB=400 /ORIGINAL POSITION OF DOUBLE BIT
-CHANGE=1 /IN OPTION WORD, 1 MEANS MUST FORMAT OUTPUT MEDIA
- /
-/ CORE LAYOUT
-/
-/ FIELD 0
-/
-/ RX BUFFER 0020-6417
-/ ERROR MSGS 6420-7177
-/ TTY HANDLER 7200-7577
-/ SYSTEM 7600-7777
-/
-/ FIELD 1
-/
-/ RX BUFFER 0020-6417
-/ INIT CODE 5000-6417
-/ PROGRAM 6420-7577
-/ SYSTEM 7600-7777
-/
-/ FIELD 2&3 (OPTIONAL)
-/
-/ RX BUFFER 0020-6417
-/
-/ EXECUTION ORDER
-/
-/ INIT CODE STARTS AT 6000, THEN TO 5000, 5200, 5400, 7110
-/
-/ MAIN LOOP IS AT 6420
-/ SERVICE SUBROUINES OCCUPY MOST OF REST OF THE FIELD
-/
-/
-/ FLOPPY IOT'S
-/
-SDN=6755
-LCD=6751
-STR=6753
-XDR=6752
-SER=6754
-FLINIT=6757
-/
-AC7776=CLL CLA CMA RAL /SET AC TO -2
-AC7775=CLL CLA CMA RTL /SET AC TO -3
-AC0002=CLL CLA CML RTL /SET AC TO 2
-AC4000=CLL CLA CML RAR /SET AC TO 4000
-/
-/
-/ THE OPTION WORDS FROM THE COMMAND DECODER ARE COMBINED INTO ONE WORD
-/ HERE CALLED 'OPTION'. THE BITS IN OPTION ARE M,N,C,P,D,R,S,0,0,V,0,0.
-/ NOTE THAT ONLY THE 'D' BIT HAS BEEN REPOSITIONED.
-/
-/ WARNING! THE MEANING OF THE M AND C BITS ON INPUT IS DIFFERENT THAN THAT
-/ WHILE THE PROGRAM IS ACTUALLY RUNNING. ON INPUT C IS COPY AND MATCH.
-/ ON INPUT M IS MATCH WITHOUT COPY. WHILE THE PROGRAM IS RUNNING, M
-/ IS MATCH (INDEPENDENT OF COPY), AND C IS COPY (INDEPENDENT OF MATCH).
-/
-/ SUMMARY OF CONFIGURATION DEPENDENT VARIABLES
-/
-/ ISVT78 1 IF A VT78, 0 IF NOT
-/ ISBIG 1 IF GREATER THAN 12K, 0 IF NOT
-/ ISDOUB 0 IF SINGLE DENSITY TRANSFER, 1 IF DOUBLE
-/
-/
-/ SUMMARY OF DERIVED VARIABLES (DO NOT APPEAR AS SUCH IN PROGRAM)
-/
-/ HLFTRK (NOT ISBIG).AND.ISDOUB=1.AND.MATCH OPTION
-/ SHORT ISDOUB=0.IOR.HLFTRK
-/ SLOW ISVT78.AND.ISDOUB=1
-/
-/ I/O CONTROLL INFORMATION IS PLACED IN THE VARIABLES RIFN, ROFN
-/
-/ RIFN 4000 IF RX02 OR RX03 HARDWARE
-/ 0400 IF A DOUBLE DENSITY TRANSFER IS TAKING PLACE
-/ 0020 IF UNITS 1 OR 3
-/ 0002 ALWAYS SET, INDICATES READ FUNCTION
-/ 0001 IF UNITS 2 OR 3, SECOND PAIR ON VT78
-/
-/ ROFN WHICH IS THE SAME WORD FOR OUTPUT, GETS BITS IN
-/ THE SAME FORMAT
-/
-/ THE ABOVE VARIABLES RESULT IN THE SETTING OF THE FOLLOWING COUNTS
-/ WHICH ARE PLACED HERE AND THERE IN CONVENIENT PAGES
-/
-/ COUNT1 -20 IF ISDOUB=1, -10 IF NOT
-/ COUNT2 -100 IF ISDOUB=1, -40 IF NOT
-/ COUNT3 -400 IF ISDOUB=1, -200 IF NOT
-/ COUNT4 -2 IF DOUBLE HEADED, -1 IF NOT
-/ COUNT5 -2 IF HLFTRK, -1 IF NOT;
-/ COUNT6 10 IF SHORT, 20 IF NOT
-/ COUNT7 -1 IF SHORT, -2 IF NOT
-/ COUNT8 3 IF SLOW, 2 IF NOT
-/ COUNT9 SKP IF SLOW, IAC IF NOT
-/
- /
- FIELD 1
- *5000
-/
-/ ADDITIONAL ONCE-ONLY CODE
-/
-/
-/
-/ PRINT VERSION NUMBER EVEN IF SOME ERRORS
-/
-LOC3, TAD OPT2 /PRINT VERSION FIRST EVEN IF AN ERROR
- AND (VERSION
- SNA CLA /SKIP IF PRINTOUT NEEDED
- JMP VALID /NO, CONTINUE CHECKING
- TAD (VERBUF /ADDRESS OF MESSAGE IN FIELD 0
- JMS TYPE
-/
-/
-/
-/ VARIOUS CHECKING FOR ILLEGAL SWITCHES
-/
-VALID, TAD (-COPY-OLDOUB-1 /IS SWITCH OTHER THAN COPY OR DOUBLE?
- AND OPT1 /IN THE FIRST COMMAND DECODER OPTION WORD
- SZA CLA /SKIP IF OK
- JMP ERR17
- TAD (-MATCH-NOMAT-PAUS-READ-SINGLE-VERSIO-1
- AND OPT2 /CHECKING FOR OTHER THAN M,N,P,R,S,V
- SZA CLA
- JMP ERR17
- TAD OPT3 /THIS WORD SHOULD BE 0, I.E. NO SWITCHES AT ALL
- SZA CLA /SKIP IF OK
- JMP ERR17
- TAD OPT1 /DOUBLE, IF PRESENT, MUST CHANGE POSITION
- AND (OLDOUB /CHECK IT IN OLD POSITION
- SZA CLA /SKIP IF NOT THERE
- TAD (DOUBLE-OLDOUB /MOVE TO NEW POSITION
-NOFORM, TAD OPT1 /JOIN ALL SWITCHES INTO ONE WORD
- TAD OPT2 /COMBINING WORDS
- DCA OPTION /HOLD ALL TOGETHER FOR SIMPPLICITY
- TAD (BITTAB /LOAD UP TO TEST COMBINATIONS
- DCA TMP5
- TAD OPTION
- DCA TMP6
-VALLOO, TAD TMP6
- CLL RAL /NEXT OPTION BIIT TO LINK
- DCA TMP6
- TAD I TMP5 /NEXT MASK
- SNA /SKIP IF MORE TO DO
- JMP CROSS /CROSS TALK CHECKED OUT
- ISZ TMP5 /BUMP POINTER
- AND TMP6 /CHECK ILLEGAL POSSIBILITIES
- SNL /SKIP ONLY IF MASTER BIT IS ON
- CLA /GO OUT VIA JMP VALLOO
- SNA CLA /SKIP IF MASTER AND SOME OTHER MATCH, ILLEGAL
- JMP VALLOO
-ERR17, TAD (MSG17-MSG6 /SWITCHES ERROR MSG
-ERR6, TAD (MSG6-MSG5
-ERR5, TAD (MSG5-MSG3
-ERR3, TAD (MSG3
- JMP PERR /GO PRINT ERROR
-/
-CROSS, TAD (SINGLE+DOUBLE+MATCH+READ /ANY SPECIFIED FUNCTION
- AND OPTION
- SZA CLA /SKIP IF NO
- JMP CROSS1 /A FUNCTION THERE, DON'T SET C
- TAD OPTION
- AND (-COPY-1
- TAD (COPY
- DCA OPTION
-CROSS1, TAD (SINGLE+DOUBLE+NOMAT+READ
- AND OPTION /SET M IF REQUIRED
- SZA CLA /SKIP IF NECESSARY
- JMP CROSS3 /NO
- TAD OPTION
- RAL /KNOW! THAT MATCH=4000
- CLL CML RAR
- DCA OPTION
-/
-/ NOW OUTPUT DEVICE
-/
-CROSS3, TAD OUTDEV
- SNA
- JMP ERR6 /DEVICE NOT THERE AT ALL!
- JMS CHCKRX /IS IT REALLY AN RX? RETURN UNIT NUMBER;+2 FOR READ
- DCA ROFN /BUILD REST OF IT IN LATER
-/
-/ NOW INPUT DEVICE (IF ANY)
-/
-CROSS2, TAD (READ+SINGLE+DOUBLE
- AND OPTION /AN INPUT DEVICE NEEDED
- SZA CLA /SKIP IF NECESSARY
- JMP REAFOR /READ OR FORMAT
- TAD INDEV
- SNA
- JMP ERR5 /DEVICE NOT PRESENT AT ALL, ERROR
- JMS CHCKRX /IS IT REALLY AN RX? RETURN READ CODE +UNIT #
- DCA RIFN
- TAD RIFN /CHECK IF UNIT NUMBERS THE SAME
- CIA /WHICH IS AN ERROR
- TAD ROFN
- SNA CLA /SKIP IF DIFFERENT
- JMP ERR2
- JMP IICNT
-/
-REAFOR, TAD INDEV /FOR READ AND FORMAT INPUT DEVICE IS ILLEGAL
- SZA CLA /SKIP IF NOT PRESENT
- JMP ERR2 /SPECIFICATION ERROR ON EXTRA DEVICE
- JMP IICNT /OK, CONTINUE INITIALIZATION
-/
-/
-TMP5, 0 /WORK LOCATIONS
-TMP6, 0
-/
- PAGE
-/
- /
-/ ESTABLISH FUNDAMENTAL CONFIGURATION VARIABLES
-/
-IICNT, JMS I (USR /UNLOCK USR
- 11
- TAD OPTION /IF SLASH-P, MUST GET CORRECT FLOPPY ON!
- AND (PAUS
- SNA CLA /SKIP IF SLASH-P
- JMP IICNT2 /NO, JUST KEEP GOING
-SYSOFF, JMS QUEST /ASK REMOUNT QUESTION
- MSG12 /ADDR OF MESSAGE
- JMP SYSOFF /"N" ASK AGAIN
-/ /"Y" CONTINUE TO INITIALIZE
-IICNT2, CDF 70 /TEST FOR A VT78
- RDF
- CDF 10 /BACK TO US
- TAD (7750 /VT78 RETURNS 30 FROM 70 !
- SNA CLA
- IAC
- DCA ISVT78 /
- CDF 0 /FETCH CORE SIZE WORD
- TAD I (7777
- CDF 10 /INDIRECTS HERE
- AND (70
- TAD (7750 /MAKING + IF 16 OR MORE K OF CORE
- SMA CLA /SKIP IF NOT 16K
- IAC /16K
- DCA ISBIG /SAVE THAT INFO
- TAD ROFN /GET DEVICE STATUS TYPE FOR OUTPUT DEVICE
- JMS DEVSTT /RETURN CODE IN .+1, UPDATED ROFN WORD IN AC
-MEDOU, -1 /RETURN 0-3;SINGLE;SINGLE ON DOUB;DOUB;QUAD
- DCA ROFN
- TAD MEDOU /DEFAULT FOR MEDIN, IF NO INPUT MEDIA AT ALL
- DCA MEDIN
- TAD INDEV /IS AN INPUT DEVICE?
- SNA CLA /SKIP IF YES
- JMP ONLY1 /SPECIAL PROCESSING FOR ONE DEVICE CASES
- TAD RIFN /GETTING UNIT NUMBER
- JMS DEVSTT /CHECK FOR READY, RETURN TYPE CODE
-MEDIN, -1 /RETURN 0-3, SAME AS MEDOU
- DCA RIFN /FULL I/O SKELETON
- TAD MEDIN /CONVENIENCE, MAKE INPUT OUTER LEVEL INDEX
- RTL
- TAD MEDOU /INNER LEVEL INDEX
- TAD (ACTAB /TABLE FOR WHICH ACTION TO TAKE
- DCA TMP7
- TAD I TMP7 /AN EXTRA INDIRECT NEEDED
- DCA TMP7
- JMP I TMP7 /GO TO CORRECT ACTION
- /
-/ DEVSTT
-/
-/ CALL WITH 2 (READ CODE) + UNIT NUMBER IN AC: PARTIAL RIFN/ROFN WORD
-/
-/ IF DRIVE NOT READY, ERROR OUT DIRECTLY
-/
-/ RETURN WITH DEVICE TYPE IN CALL +1
-/
-/ 0 RX01 DRIVE
-/ 1 RX02 DRIVE WITH RX01 FLOPPY
-/ 2 DOUBLE DENSITY DRIVE AND MEDIA; EITHER BOTH NOT
-/ BOTH MAY BE DOUBLE SIDED, BUT THAT IS IGNORED!!
-/ 3 RX03 DRIVE AND RX03 FLOPPY
-/
-/ RETURN WITH FULL RIFN/ROFN CODE IN AC
-/
-DEVSTT, 0
- DCA TMP7 /SAVE CALLING CODE
- TAD TMP7 /BUT CHECK OUT WHICH DRIVE PAIR
- JMS SELECT /SELECT PAIR, IF NECESSARY; AC HAS BEEN ANDED WITH 7776
- TAD (410 /DO DOUBLE DENSITY 12 BIT READ STATUS
- SDN /WAITING ON DONE
- JMP .-1
- LCD
- SDN /WAIT AGAIN ON DONE
- JMP .-1
- XDR /GET STATUS
- AND (232 /KEEPING READY, DENSITY ERROR, DOUBLE, QUAD
- DCA TMP8 /SAVE WHILE WE CLEAR UP DEVICE
- TAD (416 /DUMMY READ ERROR STATUS TO SET DONE AGAIN
- LCD
- SER /CLEAR POOSSIBLE ERROR FLAG
-L7600, 7600 /IT MAY SKIP!
- TAD TMP8 /GET BACK STATUS
- TAD L7600 /CHECK FOR READY
- SPA
- JMP STERR /NOT READY, PRINT ERROR
- CLL RTR /PUT QUAD BIT TO LINK
- SZL /SKIP ON NOT QUAD
- CLL CML CLA CMA /ALL BITS TO 1 !! FALLS THRU TO EXIT WITH 3
- RTR /PUT DOUBLE BIT TO LINK
- SNL /SKIP ON DOUBLE
- JMP REJOIN /JOIN WITH OTHER CASES, AC NOW 0
- CMA /MAKING SINGLE -2, DOUBLE -1, QUAD 0
- TAD (3 /MAKING SINGLE 1, DOUBLE 2, QUAD 3
-REJOIN, DCA I DEVSTT /RETURN 0-3 TYPE IN CALL+1
- TAD I DEVSTT /GET CODE BACK
- TAD (FNTAB /TURN CODE INTO FUNCTION BITS
- DCA TMP8
- TAD I TMP8 /4000 FOR DOUBLE DRIVE, 400 FOR DOUBLE TRANSFER
- TAD TMP7 /ORIGINAL CALLING BITS
- ISZ DEVSTT /HOP OVER RETURNED ARGUMENT
- JMP I DEVSTT /EXIT WITH CODE IN AC
-/
-/
-STERR, CLA /AC JUNK COMING IN
- TAD (MSG18-MSG19 /PRINT MESSAGE 18
-ERR19, TAD (MSG19-MSG15 /PRINT MESSAGE 19
-ERR15, TAD (MSG15 /PRINT MESSAGE 15
- JMP PERR
-/
-TMP7, 0
-TMP8, 0
-
-/
- PAGE
- /
-/ SPECIAL CODE FOR ONE DEVICE CASES; READ, SINGLE, DOUBLE
-/
-ONLY1,
- TAD OPTION /SEPARATE OUT READ
- AND (SINGLE+DOUBLE
- SNA /SKIP IF NOT READ (CAN ONLY BE ONE OF THREE BITS!)
- JMP READIT /READ CASE, FALL INTO OTHER CODE
- RAL /WATCH OUT! GOING TO SPLICE PROPER DENSITY BIT
- JMP TOUGH /INTO ROFN FOR LATER FORMAT
-/
-/ ENTER FROM DISPATCHER, AUTO-FORMAT, AND OK
-/
-CISZ, ISZ OPTION /SET CHANGE DENSITY BIT IN OPTION WORD
-SAME,
-/
-/ SET UP COUNT VARIABLES
-/
-IICNT4, TAD RIFN /PUT TRANSFER DENSITY BIT FROM INPUT INTO OUTPUT
-TOUGH, AND (400 /KEEPING THAT BIT; FORMAT ONLY CASE JOINS HERE
- DCA ISDOUB /TERMPORARY USE OF LATER VARIABLE
- TAD ROFN /OUTPUT CONTROL
- AND (7377 /KEEPING OTHER BITS
- TAD ISDOUB
- DCA ROFN /REPLACING MODIFIED OUTPUT WORD
-READIT, AC7776 /TAKE OFF READ BIT FOR OUTPUT WRITE FUNCTION
- TAD ROFN
- DCA WOFN
- AC7776 /
- TAD MEDIN /MAKE A TEMPORARY VARIABLE ISDOUB
- SMA CLA /SKIP IF SINGLE
- IAC
- DCA ISDOUB /WHICH IS 1 IF DOUBLE DENSITY MEDIA
- TAD ISDOUB /SIGNLE OR DOUBLE
- SZA CLA /SKIP IF SINGLE
- TAD (-10 /DOUBLE, MAKE -20
- TAD (-10 /SINGLE, MAKE -10
- DCA COUNT1
- TAD COUNT1 /NOW MULTIPLY BY FOUR
- CLL RAL
- CLL RAL
- DCA COUNT2
- TAD COUNT2 /NOW AGAIN BY FOUR
- CLL RAL
- CLL RAL
- DCA COUNT3
- AC7775
- TAD MEDIN /CHECK FOR QUAD SIZED
- SMA CLA /SKIP IF NOOT
- IAC
- CMA /MAKE A -2 IF YES, -1 IF NO
- DCA COUNT4
- TAD ISBIG /MAKE VARIABLE HLFTRK
- SNA CLA /MISSES COLLECT IN SZA CHAIN
- TAD OPTION
- SPA CLA /!!KNOWS!! THAT MATCH BIT IS AC0
- TAD ISDOUB
- SZA CLA
- IAC /HALF TRACK; SMALL MACHINE, MATCH OPTION, DOUBLE DENSITY
- CMA
- DCA COUNT5 /-2 IF HALF-TRACK, OTHERWISE -1
- TAD COUNT5 /FIND OUT IF ONE OR TWO FIELDS PER SWOOP
- AND ISDOUB /LEAVING 1 IN AC IF TWO FIELDS
- CMA /SO MAKE ANOTHER -2,-1 COUNTER
- DCA COUNT7
- TAD COUNT7 /NOW MULTIPLY IT BY -10 OCTAL TO MAKE FIELD SPAN
- CIA
- CLL RAL
- RTL
- DCA COUNT6
- TAD ISVT78 /NOW CONSTRUCT INTERLEAVE, TWO OR THREE
- AND ISDOUB /THREE IF DOUBLE DENSITY ON A VT78
- TAD (2
- DCA COUNT8
- AC7775 /REST OF JOB, MAKE SKP OR IAC
- TAD COUNT8
- SZA CLA /SKIP IF IT WAS THREE INTERLEAVE
- TAD (IAC-SKP /TWO INTERLEAVE, WANTS AN IAC
- TAD (SKP /THREE INTERLEAVE, WANTS A SKIP
- DCA COUNT9
- TAD OPTION /INITIALIZE ROFLD
- AND (READ /IS IT ONLY A READ
- SNA CLA /SKIP IF YES, CDF 0
- TAD COUNT6 /MATCH, INIT AT CDF SPAN
- TAD (CDF 0
- DCA ROFLD
- TAD OPTION /NEED TO REFORMAT OUTPUT DRIVE?
- AND (CHANGE+SINGLE+DOUBLE
- SNA CLA /SKIP IF YES
- JMP DO00 /NO, GO DO OPERATION
- JMP REFORM /GO TO REFORMATTER
-/
-/
-ISVT78, 0 /1 IF A VT78, OTHERWISE 0
-ISBIG, 0 /1 IF IT HAS 16K OF CORE, 0 IF LESS
-ISDOUB, 0 /1 IF TRANSFER DOUBLE DENSITY
-/
- FIELD 1
- *6000
-/
-/
-/ EQUATES FOR AUTO-INCR REG'S, SO THEY SHOW UP IN CREF
-/
-X10=10
-X11=11
-X17=17
-/
-/ ***** BEGIN ONCE ONLY CODE *****
-/
-/
-/ ENTER HERE AND GET USER INPUTS
-/
-START, CLA!SKP /NORMAL ENTRY (MUST CALL DECODER)
-CHAIN, JMP NODEC /CHAIN ENTRY
- CDF 10
- JMS I (USR /CALL IT
- 5
- 5200 /DEFAULT INPUT EXT.(SPECIAL MODE)
- 0 /PRESERVE TENTATIVE FILES
-/
-/ LOAD CONSOLE TTY HANDLER
-/
-NODEC, JMS I (USR /LOAD THE KL8E HANDLER
- 1
- DEVICE TTY
-TTYEP, 7201
- JMP ERRUSR /PRINT USER ERROR
- TAD TTYEP /MOVE ENTRY POINT FROM THIS PAGE
- DCA TTYENT
-/
-/ LOAD OUTPUT DEVICE IF SPECIFIED
-/
- JMS CTRLC /CHECK FOR CONTROL C TYPE-IN
- TAD I (7600 /GET OUTPUT DEV
- AND (17
- DCA OUTDEV
- TAD I (7605 /GET INPUT DEVICE
- AND (17
- DCA INDEV
- TAD OUTDEV /IF NO OUTPUT DEVICE
- SZA CLA /IS NAMED MOVE INPUT
- JMP LOC10 /TO OUTPUT DEVICE
- TAD INDEV /MOVE IT!
- DCA OUTDEV
- DCA INDEV /ZERO INPUT DEVICE
-/
-/ VALIDATE OUTPUT DEVICES AND FILES
-/
-LOC10, JMS CTRLC /CHECK FOR CONTROL C
- TAD (7601 /MAKE SURE THAT THERE ARE NO OUTPUT FILES
- DCA TMP1 /OR OTHER OUTPUT DEVICES
- TAD (-4
- DCA TMP2
-LOC1, TAD I TMP1 /GET DECODER ENTRY
- SZA!CLA /IS IT ZERO?
- JMP ERR2 /NO -- ERROR
- ISZ TMP1 /INCREMENT POINTER
- ISZ TMP2 /YES -- DONE WITH OUTPUT ENTRIES?
- JMP LOC1 /NO -- PROCEED
- /YES --
-/
- JMS CTRLC /CHECK FOR CONTROL C
- TAD I (7605 /WAS THERE ANY INPUT SPECIFICATION?
- SNA CLA
- JMP LOC3A /NO
- TAD (7606 /YES -- MAKE SURE THAT THERE ARE NO INPUT FILES
- DCA TMP1 /OR OTHER INPUT DEVICES
- TAD (-5
- DCA TMP2
-LOC2, TAD I TMP1 /GET DECODER ENTRY
- SZA!CLA /IS IT ZERO?
- JMP ERR2 /NO -- ERROR
- ISZ TMP1 /INCREMENT POINTER
- ISZ TMP2 /YES -- DONE WITH INPUT ENTRIES?
- JMP LOC2 /NO -- PROCEED
-LOC3A, JMP LOC3 /YES -- CONTINUE ON NEXT PAGE
-/
-OUTDEV, 0 /OUTPUT DEVICE NUMBER
-INDEV, 0 /INPUT DEVICE NUMBER
-TMP0, 0
-TMP1, 0 /TEMP STORE
-TMP2, 0 /TEMP STORE
-/
-ERR2, TAD (MSG2 /ILLEGAL SPECIFICATION
-PERR, JMS TYPE /PRINT ERROR MESSAGE
- JMP GOEXIT /LEAVE
-/
-ERRUSR, JMS I (USR /PRINT USER ERROR
- 7
- 2
- JMP GOEXIT
-/
-/
-/ CHCKRX
-/
-/ CALL WITH DEVICE # IN AC, RETURN IF REALLY AN RX
-/ RETURN WITH UNIT NUMBER IN AC; 20 IF RIGHT HAND DRIVE (#1)
-/ PLUS 1 IF A SECOND PAIR ON A VT78
-/ PLUS ALWAYS HAVING A 2 ADDED IN FOR A READ FUNCTION
-/
-OLDRX=TYP1^10
-NEWRX=TYP2^10 /TYPE CODES FOR RX HANDLERS
-/
-/
-/
-CHCKRX, 0
- DCA TMP0 /SAVE DEVICE NUMBER
- CLA CMA
- TAD TMP0 /CHECK IF IT IS SYS
- SZA CLA /SKIP IF YES
- JMP NONSYS /NO, GO TO NON-SYS PROCESSING
-CHCKSY, CDF 0 /FETCH SKELETON WORD FROM SYS
- AC0002 /PUT IN READ BIT (BIT NOT SET IN MAGIC)
- TAD I (MAGIC
- CDF 10
- JMP CHCKJ /JOIN UP TO MASK AND EXIT
-NONSYS, TAD (7757 /TABLE BASE
- TAD TMP0
- DCA TMP1 /HOLD FOR INDIRECT
- TAD I TMP1 /GET STORED CODE
- AND (770 /KEEP TYPE BITS
- TAD (-NEWRX /IS IT A NEW ONE
- SZA /SKIP IF YES, BOUNCE DOWN SZA'S
- TAD (-OLDRX+NEWRX /SO SEE IF OLD ONE
- SZA /SKIP IF GOT A MATCH
- JMP ERR3 /WRONG DEVICE TYPE, ERROR OUT
- TAD (4001 /RE-ESTABLISH LOAD ADDRESS ARGUMENT
- DCA LOADAD
- TAD TMP0 /TRY TO LOAD HANDLER
- JMS I (USR
- 1 /LOAD CODE
-LOADAD, 4001 /GETS WRITTEN OVER
- JMP ERR3 /ERROR OUT
- TAD LOADAD /OUCH!! ENTRY POINT FOR UNIT 1+3, HAS A 4 IN IT!!
-/ /ENTRY POINT FOR UNIT 2+3 HAS A 1 IN IT
- AND (5 /KEEP ONLY THE TWO RELEVANT BITS
- TAD (16 /SHIFT 4 TO 20, PUT IN 2 FOR READ CODE
-CHCKJ, AND (23 /KEEP 2 FOR READ CODE, 20 AND 1 FOR UNIT SPECIFIERS
- JMP I CHCKRX /OK, RETURN
-/
- PAGE
-/
-
-/
-/
- *6400
-/
-/ PUT TABLES HERE TO FIT
-/ BITTAB
-/
-/ TABLE FOR DETERMINING ILLEGAL CALLING OPTIONS
-/
-BITTAB, 6700 /WITH M; N,C,D,R,S ILLEGAL
- 5600 /WITH N; C,D,R,S ILLEGAL
- 3400 /WITH C; D,R,S ILLEGAL
- 0001 /WITH P; ALL ARE LEGAL
- 6000 /WITH D; R,S ILLEGAL
- 4000 /WITH R; S ILLEGAL
- 0 /LOOP STOPPER; ALL LEGAL WITH V, FALLS OUT OK
-/
-/ ACTAB
-/
-/ TABLE OF ACTION FOR 16 COMBINATIONS OF INPUT AND OUTPUT TYPES
-/
-ACTAB, SAME /IN TYPE 0, OUT TYPE 0
- SAME /0,1
- CISZ /0,2
- CISZ /0,3
- SAME /1,0
- SAME /1,1
- CISZ /1,2
- CISZ /1,3
- ERR15 /2,0
- CISZ /2,1
- SAME /2,2
- SAME /2,3 ?????
- ERR15 /3,0
- ERR15 /3,1
- ERR15 /3,2
- SAME /3,3
-/
-/
-FNTAB, 0 /FUNCTION BITS BY TYPE CODE 0-3
- 4000 /SINGLE MEDIA BUT 4000 DOUBLE DRIVE
- 4400 /DOUBLE ON DOUBLE
- 4400 /QUAD ON QUAD, LOOP HANDLES WHICH HEAD
-/
-/
-DO00, TAD (-115 /TRACK LOOP CONTROL COUNT
- DCA TRACK
-/
-/ ****** END OF ONCE ONLY CODE ******
- IFNZRO .-6420&4000 <*6420> /FORCE BEYOND BUFFER
-/
-/ ## MAIN LOOP ##
-/
-DO0, TAD COUNT4 /SET UP HEAD CONTROLLER
- DCA HEADER
-DO1, TAD COUNT5 /SET UP HALF-TRACK CONTROLLER
- DCA HFTRCK
-/
-/ WAS COPY SELECTED?
-/
-DO2, TAD HEADER /PLACE HEADER INFO TO COMMAND WORD
- CMA CLL RTR
- RTR /0 IF FIRST, 1000 IF SECOND
- TAD (100 /ALSO NEED EIGHT-BIT BIT
- DCA LOOPFN /FUNCTION FOR THIS LOOP
- TAD OPTION /SHOULD WE COPY?
- AND (COPY
- SNA!CLA
- JMP DO3 /NO
- JMS RI /YES -- READ INPUT DEVICE INTO FIELD 0
- JMS WO /WRITE OUTPUT DEVICE FROM FIELD 0
-/
-/ WAS READ SELECTED?
-/
-DO3, TAD OPTION /SHOULD WE READ?
- AND (READ
- SZA CLA /SKIP IF NOT NEEDED
- JMS RO
-/
-/ WAS MATCH SELECTED?
-/
-DO4, AC4000 /ADD PUTS MATCH BIT TO LINK
- TAD OPTION
- AND (COPY /MATCH IN LINK, COPY IN AC
- SNL /SKIP IF A MATCH
- JMP DO6 /NO MATCH, READY FOR LOOP CONTROL
- SNA CLA /HAS A COPY ALREADY BEEN DONE; IF SO DON'T READ TWICE
- JMS RI /READ FROM INPUT DEVICE
- JMS RO /READ FROM OUTPUT DEVICE
-/
-/ COMPARE BUFFERS
-/
-DO5, JMS COMP /CALL ACTION TO DO COMPARE
-/
-/ LOOP CONTROLLERS
-/
-DO6, CLA /MAY HIT WITH JUNK IN AC
- ISZ HFTRCK /GO AGAIN FOR OTHER HALF TRACK?
- JMP DO2 /YES
- ISZ HEADER /NEED TO GO TO OTHER HEAD?
- JMP DO1 /OTHER HEAD, LOOP AGAIN
- ISZ TRACK /INCREMENT TRACK, CHECK DONE
- JMP DO0 /NO
-EXITOK, TAD OPTION /DOES HE NEED TO REMOUNT SYS?
- AND (PAUS
- SNA CLA /SKIP IF YES
- JMP GOEXIT /NO, BACK TO SYSTEM
-SYSON, JMS QUEST /ASK HIM
- MSG11 /ADDR OF MESSAGE
- JMS SYSON /"N" ANSWER, ASK AGAIN
-/ /"Y" ANSWER, GO EXIT
-GOEXIT, JMS SELECT /FORCE BACK TO FIRST PAIR
- CDF CIF 0 /FIELDS FOR EXEC
- JMP I (7605
-/
-/ ## END OF MAIN LOOP ##
-/
-OPTION, 0 /OPTION BITS TOGETHER IN ONE WORD
-COUNT4, 0 /-1 IF ONE HEAD, -2 IF TWO
-COUNT5, 0 /-2 IF TRACK MUST BE DONE IN TWO PASSES
-/ /OTHERWISE -1
-HFTRCK, 0 /CONTROLS LOOP PASSES PER TRACK,FILL FROM COUNT5
-HEADER, 0 /FILL FROM COUNT4, CONTROLS HEAD
-LOOPFN, 0 /EIGHT-BIT MODE + WHICH HEAD TO USE
-/
-/ SUBROUTINE QUEST -- PRINT MSG AND ASK QUESTION
-/
-/ JMS QUEST
-/ ADDR OF MESSAGE
-/ "N" RETURN
-/ "Y" RETURN
-/
-QUEST, 0
-Q1, TAD I QUEST /GET ADDR OF MESSAGE
- JMS TYPE /PRINT IT
- TAD (BUFF /SELECT INPUT BUFFER
- JMS RDANS /READ ANSWER
- TAD I (BUFF /WHAT WAS IT?
- AND (177
- TAD (-116 /WAS IT A "N"
- SNA
- JMP Q3 /GO TO "N" EXIT
- TAD (-131+116 /WAS IT A "Y"
- SZA!CLA
- JMP Q1 /NO -- ASK AGAIN
-Q2, ISZ QUEST /"Y" RETURN AT JMS+3
-Q3, ISZ QUEST /"N" RETURN AT JMS+2
- JMP I QUEST
-/
-/ SUBROUTINE CTRLC -- CHECK FOR CONTROL C
-/
-CTRLC, 0
- KSF /SKIP IF A CHARACTER HAS BEEN TYPED
- JMP I CTRLC /NO
- KRS
- AND (177
- TAD (-3
- SNA!CLA
- JMP GOEXIT /IS A CONTROL C, EXIT
- JMP I CTRLC
-/
-
-/
- PAGE
-/
-
-/
-/ SUBROUTINE RI -- READ FROM INPUT DEVICE
-/
-RI, 0 /READ FROM INPUT DEVICE
- TAD RISEC /SET UP OUR SECTOR
- DCA SECTOR
- TAD RIFN /AND OUR FUNCTION (UNIT, READ, ETC.)
- TAD LOOPFN /AND LOOP CONTROLLER FUNCTION
-/ /DENSITY, HEAD, AND 8BIT MODE
- DCA FN
- TAD RIFLD /SET UP OUR FIELD
- JMS BUMPER /GO DO IT
- MSG8 /ERROR MESSAGE ADDRESS
- TAD SECTOR /GET OUR SECTOR BACK
- DCA RISEC
- JMP I RI /BACK TO MAIN LOOP
-/
-RISEC, -32 /START AT SECTOR 1 (OFFSET BY 33)
-RIFLD, CDF 0 /START AT FIELD 0
-RIFN, 0 /4000 IF DOUBLE DENSITY DRIVE, 20 IF ODD # UNIT
-/ /2 ALWAYS FOR READ, 1 IF SECOND PAIR ON VT78
-/ /400 IF DOUBLE DENSITY TRANSFER
-/
-/ SUBROUTINE RO -- READ FROM OUTPUT DEVICE
-/
-RO, 0 /READ FROM OUTDEV
- TAD ROSEC /SET UP OUR SECTOR
- DCA SECTOR
- TAD ROFN /SET UP OUR FUNCTION
- TAD LOOPFN
- DCA FN
- TAD ROFLD /SET UP OUR FIELD
- JMS BUMPER /GO DO IT
- MSG9
- TAD SECTOR /GET BACK OUR SECTOR
- DCA ROSEC
- JMP I RO /BACK TO MAIN
-/
-ROSEC, -32 /START AT SECTOR 1
-ROFLD, CDF 0 /SET AT INIT TIME
-ROFN, 0 /SET AT INIT TIME, SAME FORMAT AS RIFN
-
-/
-/ SUBROUTINE WO -- WRITE OUTPUT DEVICE
-/
-WO, 0 /WRITE TO OUTPUT DEVICE
- TAD WOSEC /SET UP OUR SECTOR
- DCA SECTOR
- TAD WOFN /SET UP OUR FUNCTION
- TAD LOOPFN
- DCA FN
- TAD WOFLD /SET UP OUR FIELD
- JMS BUMPER /GO DO IT
- MSG10
- TAD SECTOR /GET BACK OUR SECTOR
- DCA WOSEC
- JMP I WO /BACK TO MAIN LINE
-/
-WOFLD, CDF 0 /FIELD TO START OUR WRITE
-WOSEC, -32 /OUR SECTOR, START AT 1
-WOFN, 0 /SET FUNCTION AT INIT TIME
-/ /SAME FORMAT AS ROFN, BUT NO READ BIT
-
-/
-/
-/ SUBROUTINE COMP -- COMPARE BUFFERS
-/
-COMP, 0
- TAD COMSEC /OUR SECTOR
- DCA SECTOR
- DCA FN /0 IS COMPARE FUNCTION
- TAD COMFLD /SET OUR FIELD
- JMS BUMPER /DO IT
- MSG7
- TAD SECTOR /SAVE OUR SECTOR
- DCA COMSEC
- JMP I COMP
-/
-COMSEC, -32 /START AT 1
-COMFLD, CDF 0 /
-/
- /
-/ BUMPER
-/
-/ ROUTINE TO HANDLER SECTORING, CORE POINTER, AND FIELDS
-/
-/ CALLED BY RI, RO, WO, COMP;
-/ STARTING FIELD IN AC, ERROR MSG ADDR IN CALL+1
-/ BUMPER IN TURN CALLS ACTION
-/
-BUMPER, 0
- DCA BUMFLD /PLACE CDF SO SETS WHEN CALL ACTION
- JMS CTRLC /CHECK A CONTROL C
- TAD FN /NEED TO SELECT
- JMS SELECT /DO IF NECESSARY, AC.AND.7776
- DCA FN /REPLACE FUNCTION, SELECT ONCE PER BUMPER CALL
- TAD COUNT7 /HOW MANY FIELDS TO INCREMENT THRU
- DCA BUMCNT
-B0, TAD (BSTART-1 /SET AUTO INCREMENT REG'S
- DCA X10
- TAD X10
- DCA X11
- TAD BUMFLD /SET FIELD INTO ACTION
- DCA BFIELD
-BUMFLD, 0 /CDF PLACED HERE BY CALLER
- JMS ACTION /CALL ACTION ROUTIN
- JMS OOPS /ERROR, PRINTOUT SOMTHING
- TAD SECTOR /MOVE TO NEXT SECTOR
- TAD COUNT8 /ADD IN INTERLEAVE
- SPA /SKIP IF SPECIAL COMPUTING NEEDED
- JMP B2 /NO SPECIAL NEEDED, REPLACE SECTOR
-COUNT9, 0 /IAC OR SKP PLACED HERE !!
- AND (1 /FOR 2 INTERLEAVE, SWAP 0 AND 1
- TAD (-32 /WRAP BACK TO MINUS
-B2, DCA SECTOR
- TAD X10 /CHECK IF DONE WITH BUFFER
- TAD (-BSTART-BSIZE+1 /DONE IF POINTING TO LAST LOC
- SZA CLA /SKIP IF DONE
- JMP BUMFLD /NO, DO NEXT SECTOR
- TAD (10 /INCREMENT FIELD
- TAD BUMFLD
- DCA BUMFLD
- ISZ BUMCNT /DONE WITH ALL FIELDS
- JMP B0 /NO, DO NEXT ONE
- ISZ BUMPER /SKIP OVER ERROR POINTER
- JMP I BUMPER
-/
-COUNT7, 0 /MINUS NUMBER OF FIELDS PER PASS
-COUNT8, 0 /INTERLEAVE 2 OR 3 SET AT INIT TIME
-BUMCNT, 0 /LOOP CONTROL FOR FIELDS, FILL FROM COUNT7
-/
-/ CONSTRUCT ERROR MESSAGE
-/
-OOPS, 0
- TAD I BUMPER /GET ADDR OF MESSAGE
- JMS TYPE /PRINT TYPE OF FAILURE
- JMS ADPRNT /PRINT (HEAD), TRACK, SECTOR
- JMP I OOPS
-/
- PAGE
-
-/
-/ SUBROUTINE TYPE -- PRINT MESSAGE
-/ ON ENTRY AC HAS MESSAGE ADDRESS
-/
-TYPE, 0
- DCA TYPAD /SAVE ADDR
- CIF 0
- JMS I TTYENT
- 4100
-TYPAD, 0
- 0
- NOP
- JMP I TYPE
-/
-/ SUBROUTINE RDANS -- READ ANSWER FROM TTY
-/ ON ENTRY AC HAS BUFFER ADDR
-/
-RDANS, 0
- DCA RDAD /SAVE ADDR
- CIF 0
- JMS I TTYENT
- 0110
-RDAD, 0
- 0
- NOP
- JMP I RDANS
-/
-TTYENT, 0 /ENTRY POINT TO TTY HANDLER
-/
- /
-/ SUBROUTINE APRNT -- PRINT TRACK AND SECTOR
-/ ENTER WITH SECTOR IN AC
-/
-ADPRNT, 0
- TAD LOOPFN /WHICH HEAD
- CLL RTL
- RAL /HEAD BIT TO AC11
- CLA RAL /BUT CLEARING OUT OTHER BITS
- JMS SETIN /PUT TO MESSAGE
- MSG13A-1
- TAD TRACK /TRACK KEPT IN COMPLEMENT FORM
- CMA
- JMS SETIN
- MSG13B-1
- TAD SECTOR /SECTOR KEPT AS SECTOR-33
- TAD (33
- JMS SETIN
- MSG13C-1
- TAD COUNT4 /IS QUAD OPERATION
- IAC /COUNT4 COMES -2 FOR QUAD, -1 NOT
- SNA CLA /SKIP IF YES
- TAD (10 /NO, DON'T TALK ABOUT HEADS
- TAD (MSG13 /ADDR FOR PRINTOUT
- JMS TYPE
- JMP I ADPRNT
-
-/
-/ SUBROUTINE SETIN -- ENTER NUMBER INTO A MESSAGE
-/
-/ ON ENTRY AC HAS NUMBER AND JMS+1 HAS POINTER TO MESSAGE
-/ HOLE MINUS 1. (2 DECIMAL DIGIT NUMBERS ARE ASSUMED)
-/
-SETIN, 0
- DCA SETIN1 /SAVE NUMBER
- DCA SETCNT /ZERO 10'S COUNTER
- TAD I SETIN /GET MSG ADDR
- DCA X17 /ENTER INTO AUTOINC POINTER
- ISZ SETIN /BUMP RETURN ADDR
-SETINB, TAD SETIN1 /GET NUMBER
- TAD (-12 /SUBTRACT 10 DECIMAL
- SMA /DONE DIVIDING?
- JMP SETINA /NO
- CLA /YES
- TAD SETCNT /GET 10'S
- SNA /SKIP IF A LEADING DIGIT
- TAD (-20 /MAKE LEADING 0 A LEADING BLANK
- TAD (260 /MAKE IT ASCII
- CDF 0 /ERROR MESSAGES IN FIELD 0!
- DCA I X17 /STORE IN MESSAGE
- TAD SETIN1 /GET REMAINDER
- TAD (260 /MAKE IT ASCII
- DCA I X17 /STORE IN MESSAGE
- CDF 10 /POINT CDF BACK HERE
- JMP I SETIN
-SETINA, DCA SETIN1 /SAVE RESULT
- ISZ SETCNT /INCREMENT 10'S COUNT
- JMP SETINB /CONTINUE
-/
-SETIN1, 0 /NUMBER STORAGE
-SETCNT, 0 /10'S COUNTER
- /
-/ REFORMAT
-/
-/ BELONGING HERE ONLY FOR REASONS OF FIT
-/
-/
-REFORM, TAD ROFN /OK, WHAT OUTPUT DENSITY DO WE HAVE
- SMA CLA /SKIP IF DRIVE IS CAPABLE OF A REFORMAT
- JMP ERR15 /GO PRINT ILLEGAL TYPE
- TAD ROFN /GET FUNCTION BACK
- JMS SELECT /ALSO MUST CHECK WHICH PAIR; AC=AC.AND.7776
- TAD (4006 /TURN OFF TOP BIT, MAKE 2 READ INTO 10 REFORMAT
- SDN /CONTROLLER READY
- JMP .-1
- LCD
- STR /WAIT FOR READY TO TAKE CODE
- JMP .-1
- TAD (111 /SAFETY CODE
- XDR /PLACE TO DRIVE
- CLA
- SDN /WAIT FOR OVERALL DONE
- JMP .-1 /WIGGLE AC TO SHOW LIFE ??
- AC7776 /SET AC TO STRIP WHICH PAIR BIT
- SER /SKIP IF AN ERROR DURING FORMAT
- CLL /CLEAR LINK TO SHOW NO ERROR
- AND ROFN /SET DONE FLAG
- TAD (4014 /BY A DUMMY READ ERROR STATUS, FLIPS LINK!
- LCD
- SNL /SKIP IF REFORMAT HAD NO ERROR
- JMP ERR19 /ERROR DURING REFORMAT, FATAL
- TAD OPTION /WAS IT A REFORMAT ONLY?
- AND (SINGLE+DOUBLE
- SNA CLA /SKIP IF YES
- JMP DO00 /NO, GO DO OTHER STUFF
- JMS QUEST /ASK IF ANOTHER FORMAT OPERATION WANTED
- MSG16
- JMP EXITOK /"N" RETURN
- JMP REFORM /"Y" RETURN
-/
- PAGE
-/
- /
-/ ACTION ROUTINE ENTRY POINT
-/
-/ WATCH IT! WE CALLED WITH CDF POINTING TO BUFFER
-/ ALSO CDF IS PLACED IN BFIELD,
-/ SO WE CAN DO NO INDIRECTS EXCEPT THRU AUTO INCR TO BUFFER !!
-/
-/ RETURN WITH SKIP IF OK, DIRECT RETURN WITH ERROR
-/
-/ RESTORES DF TO 10 ON EITHER EXIT
-/
-/ DO A SECTOR AT A TIME FOR A SINGLE FUNCTION
-/
-ACTION, 0
- AC7775 /-3 ERROR RETRY COUNT
- DCA RETRY
- TAD FN /SORT FUNCTIONS
- SNA
- JMP COMPAR /GO DO COMPAR
- RTR /READ/WRITE BIT TO LINK
- SZL CLA /SKIP IF WRITE
- JMP READLP /GO TO READ
-/
-/ WRITE LOOP
-/
-WRITLP, TAD FN /SET UP SILO OPERATION
- JMS LDCMD
- JMP WRIT1 /OTHER PAGE TO MOVE DATA TO SILO
-WRIT2, JMS DOIO /RETURN FROM OTHER PAGE TO ACCESS I/O
- JMP REFILL /COMMON EXIT
-/
-/ READ LOOP
-/
-READLP, JMS DOIO /COME HERE TO RETRY I/O
- TAD FN
- JMS LDCMD
- TAD COUNT2 /RX01, 32 PASSES THRU 4 BYTES MOVED
- DCA RDCNT /RX02, 64 PASSES THRU
-ST5, STR
- JMP .-1
- XDR
- DCA I X10
- STR
- JMP .-1
- XDR
- DCA I X10
- STR
- JMP .-1
- XDR
- DCA I X10
- STR
- JMP .-1
- XDR
- DCA I X10
- ISZ RDCNT
- JMP ST5
-REFILL, ISZ ACTION /OK EXIT, ALSO A LITERAL
-ACTEND, CDF 10 /DATA FIELD NORMAL AGAIN
- JMP I ACTION
-/
-/ COMPAR
-/
-/ COMPARE THE TWO BUFFERS
-/
-COMPAR, TAD REFILL /RESTORE ERROR FLAG TO 'OK'
- DCA ZOT
- TAD BFIELD /CREATE OTHER FIELD POINTER
- TAD COUNT6
- DCA CFIELD
- TAD COUNT3 /SET UP LOOP CONTROL
- DCA COMCNT
-BFIELD, 0 /CDF PLACED HERE
- TAD I X10 /COMPARE
- CIA
-CFIELD, 0 /CDF PLACED HERE
- TAD I X11
- SZA CLA /SKIP IF OK
- DCA ZOT /NOT OK, MAKE NON-SKIP RETURN!!!!
- ISZ COMCNT /THRU?
- JMP BFIELD /NO
-ZOT, 0 /ISZ ACTION PLACED HERE
- JMP ACTEND /RESTORE FIELD, GO BACK
-/
-/
-/ DO I/O FUNCTION FOR READ OR WRITE
-/
-DOIO, 0
- TAD FN /SILO FUNCTION, CONVERTED TO READ-WRITE
- TAD (4 /CONVERT SILO OPERATION TO I/O OPERATION
- JMS LDCMD
- TAD SECTOR /REQUESTED SECTOR TO HARDWARE
- TAD (33 /STORED AS -32 TO -1
- STR
- JMP .-1
- XDR
- CLA
- TAD TRACK
- CMA /COMPLEMENT TO PLUS NUMBER
- STR
- JMP .-1
- XDR
- CLL CLA CMA RTL /AC=-3 TO KILL READ-WRITE BIT
- AND FN /I/O SKELETON WITHOUT READ-WRITE BIT
- TAD (16 /LOAD ERROR STATUS IS GOOD NO-OP
- JMS LDCMD
- JMP I DOIO
-/
-/ LOAD COMMAND REGISTER
-/
-RDCNT=.
-LDCMD, 0
- DCA CMDTMP /SAVE THE COMMAND
- TAD CMDTMP
- AND (376 /DOUBLE, KEEP ONLY 8 BITS, SINGLE NEVER HAD THEM
- SDN /SKIP ON DONE
- JMP .-1
- LCD /PUT THE COMMAND
- TAD CMDTMP /CHECKING TOP BIT FOR DOUBLE DRIVE
- SMA
- JMP CDCK /SINGLE, JUST GO CHECK ERROR
- RTL
- RTL
- RAL
- AND (7 /TOP FOUR BITS NOW SENT
- STR
- JMP .-1
- XDR
-CDCK, CLA
- SER /SKIP ON ERROR
- JMP I LDCMD
- ISZ RETRY /TRIED THREE TIMES YET
- JMP KEEPON /NO, KEEP ON TRYING
- TAD FN /DID WE ERROR OUT OF READ OR WRITE
- RTR /READ-WRITE BIT TO LINK
- SNL CLA /SKIP IF READ
- JMP ACTEND /WRITE IS ALL SET, GO TO ERROR RETURN
- TAD COUNT3 /READ MUST ADD APPROPRIATE AMOUNT TO X10
- CIA /SO LOOP CONTROL IN BUMPER WORKS RIGHT!
- TAD X10 /
- DCA X10
- JMP ACTEND /SET CDF BACK, AND ERROR EXIT
-/
-/ ENTRY TO CONTINUE AFTER ERROR
-/
-/
-KEEPON, TAD FN /RETRYING READ OR WRITE
- RTR /R/W BIT TO LINK
- SZL CLA /SKIP ON WRITE
- JMP READLP /RETRY A READ
- JMP WRIT2 /SO GO RETRY WRITE
-/
-COUNT2, 0 /MINUS NUMBER OF READ PASSES PER SECTOR
-COUNT3, 0 /MINUS NUMBER OF BYTES (WORDS AS WELL) PER SECTOR
-COUNT6, 0 /DELTA FIELDS FOR COMPARE
-TRACK, 0 /TRACK NUMBER IN COMPLEMENT FORM FOR ISZ
-SECTOR, 0 /SECTOR TO DO, SET BY INTERLEAVE ROUTINE
-FN, 0 /FUNCTION BITS: ALWAYS 100 FOR 8BIT MODE
-/ /+4000 FOR DOUBLE DRIVE, +1 FOR SECOND PAIR
-/ /NOTE, THE 1 IS STRIPPED PRIOR TO CALL TO ACTION
-RETRY, 0 /RETRY COUNTER -3 TO 0
-CMDTMP,
-COMCNT, 0 /TEMPORARY FOR COMPARE OR I/O
-/
- PAGE
-/
- / PART OF ACTION ROUTINE
-/
-/ FILL SILO FOR WRITE
-/
-/ SPREAD OUT TO SPEED UP
-/
-/
-/
-WRIT1, TAD COUNT1 /FOR RX01, 8 TIMES THRU 16 BYTE GIVES 128
- DCA WRTCNT /FOR RX02, 16 TIMES THRU FOR 256
-ST4, TAD I X10 /FETCH A BYTE
- STR /SKIP IF READY TO TRANSFER
- JMP .-1 /NO (SHOULDN'T HIT THIS ON VT78)
- XDR /MOVE BYTE TO SILO
- CLA /CLEAR THE MUMBLE AC
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- TAD I X10
- STR
- JMP .-1
- XDR
- CLA
- ISZ WRTCNT /THRU WITH SILO?
- JMP ST4 /NO
- JMP WRIT2 /REST OF LOOP ON OTHER PAGE
-/
-WRTCNT, 0 /CONTROL COUNT FOR FILL SILO LOOP
-COUNT1, 0 /FILLED AT INIT TIME, WRITE PASSES PER SECTOR!
-/
- /
-/ SELECT SUBROUTINE
-/
-/ CALL WITH AC11=0 TO SELECT FIRST PAIR, AC11=1 TO SELECT SECOND
-/
-/ RETURN AC.AND.7776
-/
-/ IF SELECT REQUESTED IS SAME AS LAST SELECT, NO ACTION TAKEN
-/
-SELECT, 0
- DCA WRTCNT /CONVENIENT TEMPORARY TO SAVE ARGUMENT
- TAD WRTCNT
- TAD LSTSEL /IS IT SAME AS LAST TIME
- RAR /TEST BIT TO LINK
- SNL CLA /SKIP IF DIFFERENT
- JMP NOSEL /NO SELECT NEEDED
- ISZ LSTSEL /CHANGE TO OTHER TYPE
- NOP /MAY INDEED SKIP
- CLA IAC
- AND LSTSEL /SELECT NEW TYPE
- 6750 /SELECT IOT
- SER /MUST CLEAR ERROR FLAG, MAY RANDOMLY SET
- NOP
- SDN /SAME FOR DONE
- NOP
- STR /AND TRANSFER
- NOP
- CLA
- TAD (16 /DUMMY READ ERROR STATUS TO SET DONE FLAG!!
- LCD
-NOSEL, AC7776 /RETURN ARGUMENT WITH LOW BIT CLEARED
- AND WRTCNT
- JMP I SELECT
-LSTSEL, 0 /START OFF ON FIRST PAIR
-/
- PAGE
-
- FIELD 0
- *6420
-/
-/ PUT ERROR MESSAGES IN FIELD 0 RIGHT AFTER BUFFER
-/
-/
-/ ERROR MESSAGES
-/
-VERBUF, "R; "X; "C; "O; "P; "Y; 240; "V; "4; "B; 240; 215; 212; 232
-MSG2, "I; "L; "L; "E; "G; "A; "L; 240; "S; "P; "E; "C; "I; "F; "I
- "C; "A; "T; "I; "O; "N; 215; 212; 232
-MSG3, "D; "E; "V; "I; "C; "E; 240; "I; "S; 240; "N; "O; "T; 240
- "R; "X; 215; 212; 232
-MSG5, "N; "O; 240; "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C;
- "E; 215; 212; 232
-MSG6, "N; "O; 240; "O; "U; "T; "P; "U; "T; 240
- "D; "E; "V; "I; "C; "E; 215; 212; 232
-MSG7, "C; "O; "M; "P; "A; "R; "E; 240
- "E; "R; "R; "O; "R; 232
-MSG8, "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
- "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
-MSG9, "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
- "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
-MSG10, "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
- "W; "R; "I; "T; "E; 240; "E; "R; "R; "O; "R; 232
-MSG11, "I; "S; 240; "M; "O; "N; "I; "T; "O; "R; 240
- "R; "E; "M; "O; "U; "N; "T; "E; "D
- "?; 232
-MSG12, "R; "E; "A; "D; "Y; "?; 232
-MSG13, 240; "H; "E; "A; "D;
-MSG13A, 0
- 0
- ",
- 240; "T; "R; "A; "C; "K; 240
-MSG13B, 0
- 0
- ",
- 240; "S; "E; "C; "T; "O; "R; 240
-MSG13C, 0
- 0
- 215; 212; 232
-MSG15, "I; "L; "L; "E; "G; "A; "L; 240; "F; "L; "O; "P; "P; "Y;
- 240; "T; "Y; "P; "E;
- 215; 212; 232
-MSG16, "F; "O; "R; "M; "A; "T; 240; "A; "N; "O; "T; "H; "E; "R;
- 240; "F; "L; "O; "P; "P; "Y; "?; 232
-MSG17, "I; "L; "L; "E; "G; "A; "L; 240; "S; "W; "I; "T; "C; "H;
- "(; "E; "S; "); 215; 212; 232
-MSG18, "F; "L; "O; "P; "P; "Y; 240; "N; "O; "T; 240; "R; "E; "A; "D; "Y;
- 215; 212; 232
-MSG19, "E; "R; "R; "O; "R; 240; "D; "U; "R; "I; "N; "G; 240;
- "F; "O; "R; "M; "A; "T; 215; 212; 232
-$
DELETED src/os8-v3f/RXNS.PA
Index: src/os8-v3f/RXNS.PA
==================================================================
--- src/os8-v3f/RXNS.PA
+++ /dev/null
@@ -1,426 +0,0 @@
-/RX NON-SYSTEM HANDLER, GENERAL CONTROLLER TYPE
-/FLOPPY DISK HANDLER FOR OS/8
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /DEFINITIONS OF RX8/E IOT'S
-
-RXVER= "N&77
-
-DEVCOD= 750 /DEVICECODE
-
-LCD= 6001+DEVCOD /LOAD COMMAND REGISTER
-XDR= 6002+DEVCOD /TRANSFER DATA REGISTER
-STR= 6003+DEVCOD /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
-SER= 6004+DEVCOD /SKIP ON ERROR FLAG, CLEAR FLAG
-SDN= 6005+DEVCOD /SKIP ON DONE FLAG, CLEAR FLAG
-INTR= 6006+DEVCOD /INTERRUPT ENABLE/DISABLE
-INIT= 6007+DEVCOD /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
-
-
-/NOTES ON THIS HANDLER:
-
-/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
-/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
-/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
-
-/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES RX01 DATA
-/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
-/ARE WRITTEN IN THE SEQUENCE:
-/ 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
-
-/DOUBLE DENSITY MEDIA ARE WRITTEN IN A THREE WAY INTERLEAVE
-/ 1,4,7,10,13,16,19,22,25,2,5,8,11,14,17,20,23,26,3,6,9,12,15,18,21,24
-
-/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO
-
-AC4000=CLL CLA CML RAR /SET AC TO 4000
-AC7776=CLL CLA CMA RAL /SET AC TO 7776
-AC0002=CLL CLA CML RTL /SET AC TO 0002
-AC7775=CLL CLA CMA RTL /SET AC TO 7775
- /
-/BUILD DATA
- *0
-/
- -2 /TWO ENTRY POINTS
- DEVICE RX02 /DEVICE GROUP NAME
- DEVICE RXA0 /ENTRY POINT NAME
- 4320 /CODE FOR MULTI-RX /CHANGED TO 32
- RXA0&177+4000 /ENTRY POINT OFFSET
- 0
- 0
- DEVICE RX02 /DEVICE GROUP NAME
- DEVICE RXA1 /ENTRY POINT NAME
- 4320 /THIS IS CHANGED TO 32 FROM 27 AS IT WAS CASSETTE
- RXA1&177+4000 /ENTRY POINT OFFSET
- 0
- 0
- *200
-/
-/
-/ INIT CODE
-/
-POINT, HLT /ADDR OF SECOND PAGE AT INIT TIME
-UNIT, JMS I POINT /GO TO SECOND PAGE TO INIT
-/
-/ LIST OF VECTORS TO SECOND PAGE
-/
-LQUO, QUO-. /LQUO MUST LEAD OFF LIST
-LRETRY, RETRY-.
-LREC, REC-.
-LSIZE, SIZE-.
-LREMD, REMD-.
-LFN, FN-.
-LDENSW, DENSW-.
-LENTRY, ENTRY-.
-VCOUNT=LQUO-. /FALLS THRU TO WHICH, HERE IS VECTOR COUNT
-/
-/ COME HERE FROM ZOO
-/
-/ PROCESS ENTRY POINT, DEVICE TYPE
-/
-WHICH, AC7775 /SET RETRY COUNTER
- DCA I LRETRY
- TAD I ZOO /GET UNIT NUMBER*20+402
- DCA UNIT /HOLD FOR LATER
- ISZ ZOO /MOVE TO TYPE CODE
- TAD I ZOO /HAS THIS DRIVE BEED INIT'ED
-L7700, SMA CLA /SKIP IF NO
- JMP NORMAL /GO TO NORMAL PATH
-RSTART, TAD UNIT /PICK UP UNIT BIT, DOUBLE DENSITY +2
- TAD L10 /MAKE A READ STATUS CODE
- SDN
- JMP .-1
- LCD
- SDN
- JMP .-1
- JMP BOUNCE /HOP OVER ENTRY POINT
- /
-/
- IFZERO .&177-33&4000 <_ERROR_>
-/
-/ ENTRY POINTS ARE AT 32, 36
-/
- *.&7600+32
-/
-RXA0, 0
- JMS ZOO /COMMON ENTRY ROUTINE
- 402 /UNIT 0, 402 FOR CONVENIENCE
- -1 /MINUS SAYS STILL HAVE TO INIT IT;
-/ /SINGLE=0, DOUBLE=20, QUAD=22
-RXA1, 0
- JMS ZOO
-L422, 422 /20 SAYS UNIT 1, 402 FOR CONVENIENCE
-DOOR, JMP WHICH /INIT TIME LITERAL (MUST BE MINUS)
-/ /GETS SAME TYPE CODE AS OTHER ENTRY POINT
-/
-/ REST OF SET UP CODE
-/
-BOUNCE, XDR /GET STATUS WORD
- AND L32 /KEEP DENSITY ERROR; DOUBLE; QUAD
- TAD L10 /SINGLE=10;SING/DOUB=40;DOUB=20;QUAD=22
- AND L422 /SINGLE=0;SING/DOUB=0;DOUB=20;QUAD=22
- DCA I ZOO /PLACE TYPE CODE
- SER /CLEAR ERROR FLAG
-L10, 10 /MAY SKIP
- TAD L416 /SET DONE FLAG AGAIN
- LCD
-NORMAL, TAD I ZOO /FETCH BACK TYPE CODE
- SZA CLA /SKIP IF A SINGLE DENSITY
- TAD L7700 /DOUBLE
- TAD L7700 /SINGLE=7700, DOUBLE=7600
- DCA I LDENSW /PLACE FOR LOOP CONTROL
- TAD I ZOO
- CLL RTR /PUT QUAD BIT TO LINK
- SNA CLA /SKIP IF DOUBLE OR QUAD
- TAD L1734 /SINGLE
- TAD L4110 /D&Q=4110, S=6044
- SNL /SKIP ON QUAD, IT'S OK RIGHT NOW
- CLL CML RAR /SINGLE AND DOUBLE DIVIDE BY 2
- DCA I LSIZE /S=7022, D=6044, Q=4110
- TAD I LDENSW /7700 IF SINGLE, 7600 IF DOUBLE
- CLL CMA RTL /375 IF SINGLE, 775 IF DOUBLE
- AND UNIT /VOILA, 400*DOUBLE + 20*UNIT
- DCA I LFN /PLACE INTO FUNCTION CONTROL WORD
- AC7775 /BACK UP ZOO TO FETCH CALLING ADDR
- TAD ZOO
- DCA T1 /HOLD TEMPORARY
- TAD I T1 /HERE IS CALLING ADDR
-CLLFLD, HLT /PUT CDF TO CALLING FIELD HERE
- JMS I LENTRY /GO TO SECOND PAGE, LEAVING POINTER TO DIVSUB
-/
-/ DIVSUB SUBROUTINE !!MUST!! FOLLOW IMMEDIATELY
-/
- /
-/ DIVSUB
-/
-/ CALL TO SET UP TRACK, SECTOR, FROM OVERALL SECTOR #
-/ ALSO, SET UNIT WITH HEAD COMMAND IF WE ARE ON TO SECOND SIDE
-/
-/ CALL WITH AC <0 IF IT IS REALLY AN ERROR RETRY
-/ CALL WITH AC >=0 IF CALL TO DIVSUB
-/
-DIVSUB, 0
- CDF 0 /AND DATA FIELD MUST BE TO HERE
- SPA CLA /SKIP IF REALLY A DIVIDE REQUEST
- JMP RSTART /NO, IT WAS AN ERROR RETRY!!
- DCA I LQUO /CLEAR DIVIDE QUOTIENT
- TAD I ZOO /IS IT A TWO HEADER
- RTR /PUT QUAD BIT TO LINK
- SNL CLA /SKIP IF YES
- JMP SHUNT /NO, GO DO DIVIDE
- TAD I LREC /WHICH RECORD ARE WE WORKING ON
- TAD LM3670 /NUMBER OF SECTORS ON FIRST SIDE
- SZL CLA /SKIP IF SECOND SIDED IT
- JMP SHUNT /NO, JUST REGULAR
- TAD I LFN /FORCE HEAD BIT ON
- AND L422 /KEEP DOUBLE, UNIT, READ-WRITE
- TAD L1000 /ADD IN SECOND SIDE
- DCA I LFN
- TAD LM3670 /BUT DECREASE RECORD NUMBER
-SHUNT, TAD I LREC /THIS FOR TRACK-SECTOR
-DIVLOO, ISZ I LQUO /MAIN DIIVIDIE LOOP
- TAD LM32 /DIVIDE BY 26 TO GET TRACK
- SMA /SKIP IF DONE
- JMP DIVLOO
- TAD L32 /REMAINDER 0-25
- DCA T1 /HOLD IT IN TEMPORARY
- TAD I ZOO /SINGLE DENSITY
- SZA CLA /SKIP IF YES
- TAD T1 /MULTIPLY BY THREE FOR DOUBLE
- TAD T1 /AND BY TWO FOR SINGLE
- TAD T1
- CLL IAC /LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
- TAD LM32 /DIVIDE BY 26 TO GET SECTOR
- SMA SZA /SKIP IF DONE
- JMP .-2
- TAD L32 /RESTORE POSITIVE VALUE TO BE SECTOR
- DCA I LREMD /WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
- RAL /IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
- TAD I ZOO /BUT WE HAVE 1,3,5,7,9,11,13,15... SO WE MUST INCREMENT!
- SNA CLA /SKIP IF SOME OTHER CASE
- ISZ I LREMD /NOW HAVE IT 2,4,6,8,10,12,14,16...
- JMP I DIVSUB /OUT
- /
-/
-L416, 416 /SOME LITERALS
-L1000, 1000
-L32, 32
-LM32, -32
-L1734, 1734
-L4110,
-LM3670, -3670
-/
-/
-/
- *.&7600+167 /FORCE TO END OF PAGE
-/ ZOO SUBROUTINE
-/
-/ TO SET UP ENTRY POINT PROCESSING, AND INIT CODE
-/
-ZOO, 0 /ADDR OF 'HIT' ENTRY POINT +2 COMES HERE
- CLA /FOR SAFETY
- RDF /SAVE CALLERS FIELD SETTING
- TAD LCDF0 /ADD IN CDF 0
- DCA CLLFLD /RESET WHEN GOING TO I/O SUB
-LCDF0, CDF 0 /DATA FIELD HERE FOR INDIRECTS
-CLOSE, TAD DOOR /CLOSE DOOR TO ONCE ONLY CODE (JMP WHICH
-T1, DCA CLOSE /USE ONCE-ONLY FOR TEMPORARY LOCATION
- JMS POINT /LEAVE ADDR OF SECOND PAGE
- /
-/
-/ VARIABLES, ALSO INIT CODE LIVES HERE
-/
-/
-BUF, 0 /POINTER TO CALLER'S BUFFER
-RETRY, 0 /RETRY COUNT
-SIZE, 0 /SIZE OF DEVICE
-SYS, 0 /POINTER TO CALL
-QUO, 0 /DIVIDE QUOTIENT, WHICH IS TRACK NUMBER
-REC, 0 /SECTOR NUMBER OF FLOPPY
-BC, 0 /CONTROL COUNT, WORDS TO TRANSFER
-FN, 0 /0 FOR WRITE; 2 FOR READ; HEAD, DENSITY, UNIT
-DENSW, 0 /7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
-ENTRY, 0 /ENTRY POINT, LEAVE ADDR OF DIVSUB HERE
-/
- IFNZRO .&177-10&4000 <_ERROR> /ENOUGH ROOM FOR INIT?
-/
- *.&7600
-/
-/ INIT TIME: FILL VECTOR TABLE
-/
-THERE, 0 /FILLED BY JMS, POINTS TO VECTOR
-ILOOP, TAD THERE /POINTER IS ALSO OFFSET!
- TAD I THERE /MAKING VECTOR
- DCA I THERE
- ISZ THERE /MOVE TO NEXT VECTOR
- ISZ LDCMD /CONTROL COUNT ON THIS PAGE
- JMP ILOOP
- JMP I THERE /BACK TO FIRST PAGE
- /
-/ IO SUBROUTINE
-/
-/ ENTRY POINT AT END OF LAST LISTING PAGE
-/
-/
- *ENTRY+1 /RESUME RUNTIME CODE
-/
- DCA SYS /POINTER TO ARG'S, EXIT
- RDF /DATA FIELD OF USER CALL
- TAD (CDF CIF 0 /MAKE CDF CIF TO CALLER'S FIELD
- DCA EXFLD /SET UP FOR CALL
- AC4000 /SET LINK=0, AC=4000
- TAD I SYS /CARRY READ-WRITE BIT TO LINK
- AND (70 /KEEP FIELD FOR BUFFER
- TAD LLCDF0 /MAKE CDF TO BUFFER FIELD
- DCA BUFCDF /PLACE INTO I/O LOOP
- CML RTL /MAKE FUNCTION CODE, 0=WRITE, 2=READ
- TAD FN /START-UP CODE HAS SET HEAD, DENSITY, UNIT ETC.
- DCA FN
- TAD I SYS /MAKE LOOP CONTROL COUNT
- RAL
- AND L7600
- CIA /0 FOR WHOLE FIELD
- DCA BC /MINUS TOTAL NUMBER OF WORDS
- ISZ SYS /NEXT
- TAD I SYS /IS BUFFER ADDRESS
- DCA BUF
- ISZ SYS /NEXT
- TAD (175 /CARRY WITH DENSW IF SINGLE DENSITY
- TAD DENSW /BLOCK # TO SECTOR #
- SMA CLA /SKIP IF DOUBLE, MULTIPLY BY 2
- TAD I SYS /SINGLE, MULTIPLY BY FOUR
- SMA /NEGATIVE BLOCK # ERROR, FORCE LINK TO BE ON
- TAD I SYS
- ISZ SYS /MOVE POINTER TO ERROR EXIT
- CLL RAL
- DCA REC /SAVE SECTOR NUMBER
- SZL /SKIP IF LEGAL BLOCK #
- JMP ERREX /FORCE DISK SIZE TO BE SET UP BEFORE EXIT!
- JMS I ENTRY /CALL DIVISION SUBROUTINE OTHER PAGE
- TAD FN /SPLIT READ AND WRITE
- RTR /READ-WRITE BIT TO LINK
- SZL CLA /WRITE SKIPS
- JMP STREAD /READ GOES TO START IN MIDDLE OF LOOP
-/ /WRITE FALLS THRU TO NEXT LISTING PAGE
- /WRITE FALLS THRU TO THIS LOOP
-/
-/ TOP OF MAIN LOOP
-/
-TOP, TAD FN /SET SILO TO LOAD-UNLOAD
- JMS LDCMD /COMMAND TO CONTROLLER
- TAD DENSW /MAKE SILO LOOP COUNT, S=7700, D=7600
- DCA FLPWC /LDCMD ENTRY SAFE TEMPORARY
-BUFCDF, HLT /CDF TO BUFFER FIELD PLACED HERE
-TRLOOP, TAD I BUF /IN CASE WRITE, FETCH A WORD
- STR /SKIP IF READY TO PASS DATA
- JMP .-1 /NO
- XDR /TO OR FROM AC
- DCA I BUF /PLACE WORD FOR READ, WRITE REPLACES SAME
- ISZ BUF /MOVE BUFFER POINTER, (MAY SKIP)
-REMD, 0 /DIVIDE REMAINDER, WHICH IS SECTOR NUMBER
- ISZ FLPWC /DONE YET
- JMP TRLOOP
- TAD DENSW /ADDING 77 (SINGLE) 177 (DOUBLE)
- CMA /ONCE WE CMA, THAT IS
- TAD BC /LOOP CONTROL TO FINISH READ
- SNA
- JMP OKEX /OK, DONE
- DCA BC /REPLACE AND KEEP GOING
-/
-/ MIDDLE OF MAIN LOOP
-/
-STREAD, TAD FN /READ STARTS HERE
- TAD (4 /TURN SILO COMMAND INTO READ-WRITE COMMAND
- JMS LDCMD /I/O COMMAND TO CONTROLLER
- TAD REMD /PRECOMPUTED SECTOR #
- STR
- JMP .-1
- XDR
-L7600, 7600 /CLEAR AC, AND IS LITERAL
- TAD QUO /TRACK #
- STR
- JMP .-1
- XDR /TRACK # IS ALWAYS NON0 !!
- ISZ REC /MOVE TO NEXT RECORD NUMBER
- JMS I ENTRY /DO TRACK SECTOR FOR NEXT OPERATION
- TAD (16 /WAIT FOR OPERATION TO COMPLETE
- JMS LDCMD
- ISZ BC /CHECK FOR WRITE EXIT
- JMP TOP /STILL MORE
-OKEX, ISZ SYS /KICK TO OK EXIT
-EXFLD, HLT /CDF CIF TO CALLER
- JMP I SYS /OUT
- /
-/
-/ LDCMD SUBROUTINE
-/
-/ CHECK FOR CONTROL C, LOAD A COMMAND
-/
-FLPWC=. /ENTRY POINT A TEMPORARY
-LDCMD, VCOUNT /INIT COUNTER
- DCA TRANS /SAVE COMMAND
-LLCDF0, CDF 0 /DATA FIELD HERE IN CASE CONTROL C TO MONITOR
-TSTTT, KSF /SKIP IF A TTY CHARACTER HAS HAPPENED
- JMP TSTSD /NOPE, GO CHECK RX CONTROLLER READY
- TAD L7600 /FORCE TOP BITS TO BE 1 TO ELIMINATE 3,203
- KRS /AMBIGUITY ON TEST
- TAD (175 /IS IT A CONTROL C
- SNA CLA /SKIP IF NOT
- JMP I L7600 /EXIT TO MONITOR
-TSTSD, SDN /IS RX CONTROLLER READY
- JMP TSTTT /NOPE, GO CHECK TTY
- TAD TRANS /GET BACK COMMAND
- LCD /TO CONTROLLER
- SER /SKIP IF AN ERROR
- JMP I LDCMD
- AC4000 /AC CODE FOR EXIT, ALSO TO TELL DIVSUB WE'RE A RETRY!
- SKP
-ERREX, TAD SIZE /BLOCK TOO LARGE ENTRY, SET AC CODE
- ISZ RETRY /TRY THREE TIMES?
- JMS I ENTRY /NO, AC ZERO SAYS RETRY NOT DIVIDE!!
- JMP EXFLD /BACK TO CALLER
-/
-TRANS, 0 /TEMPORARY FOR LDCMD TO SAVE COMMAND
-/
- PAGE
-/
DELETED src/os8-v3f/RXSY1.PA
Index: src/os8-v3f/RXSY1.PA
==================================================================
--- src/os8-v3f/RXSY1.PA
+++ /dev/null
@@ -1,529 +0,0 @@
-/RX01 (RX02) SYSTEM HANDLER
-/
-/ THIS HANDLER WAS DESIGNED TO WORK WITH RX01, RX02, RX03
-/
-/ HOWEVER, ONE SINGLE BINARY CANNOT SUCCESSFULLY BE USED IN A
-/ VIRGIN BUILD FOR ALL THREE DEVICES. IT IS CURRENTLY SET UP
-/ TO BUILD AN RX02.
-/ TO GENERATE A BINARY TO BUILD AN RX01, CHANGE THE RXTYP
-/ EQUATE TO 1. FOR AN RX03 BUILD, CHANGE RXTYP TO 3.
-/
-RXTYP=1 /THIS IS THE SINGLE DENSITY TWO PAGE HANDLER
-/
-/
-/
-VERSION="M&77
-/
-/
-AC1=CLL CLA IAC
-AC2=CLL CLA CML RTL
-AC6=CLL CLA CML IAC RTL /RX02'S MUST RUN ON AN OMNI-BUS !!
-AC4000=CLL CLA CML RAR
-AC3777=CLL CLA CMA RAR
-AC7775=CLL CLA CMA RTL
-/
-/ DEVICE IOT SYMBOLIC EQUATES
-/
-LCD=6751 /LOAD COMMAND
-XDR=6752 /TRANSFER DATA
-STR=6753 /SKIP IF READY TO TRANSFER
-SER=6754 /SKIP ON ERROR
-SDN=6755 /SKIP ON DONE
-/
-/ HEADER BLOCK FOR BUILD
-/
- *0
- -1 /ONE ENTRY
- DEVICE RX8E
- DEVICE SYS
- 4320 /MULTI-TYPE RX HANDLER ----- CHANGED FROM 4270
- SYS&177+6000 /TWO PAGE HANDLER
- 0 /UNUSED
- IFZERO RXTYP-1 <756> /SIZE FOR BUILD
- IFZERO RXTYP-2 <1734>
- IFZERO RXTYP-3 <3670>
-/
- STBOOT-NDBOOT+12 /-SIZE (+12 FOR GAP)
- /
-/ HERE IS A LISTING OF THE PRIMARY BOOT FOR CONVENIENCE
-/
- NOPUNCH
-/
- *20
-/
-READ, TAD UNIT /TRY NEXT COMBINATION OF DENSITY AND UNIT
- TAD CON360 /ADDING IN 360
- AND CON420 /KEEPING ONLY 420 BITS
- DCA UNIT /CYCLES 400,420,0,20,400,,,,,,,,
- AC6 /COMMAND TO READ DISK
- TAD UNIT /UNIT AND DENSITY
- LCD /COMMAND TO CONTROLLER
- AC1 /TO SET SECTOR AND TRACK TO 1
- JMS LOAD /SECTOR TO CONTROLLER, LEAVES AC ALONE
- JMS LOAD /AND TRACK
-LITRAL, 7004 /LEAVING A 2 IN AC; SERVES AS LITERAL
-/
-/ FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
-/
-START, SDN /HAS DONE COME UP; CODE STARTS HERE!
- JMP LOAD+1 /NO, GO CHECK FOR READY TO TRANSFER
-/
-/ NOW, DONE OR ERROR
-/
- SER /SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
- SNA /NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
- JMP READ /START-UP, GO SET UP UNIT, THEN READ TO SILO
- TAD UNIT /AC ALREADY 2, PUT IN UNIT, DENSITY
- LCD /TO EMPTY THE SILO
- TAD UNIT /SET UP LOC 60 FOR OLD SECONDARY BOOT
- AND CON360 /KEEPING UNLY DENSITY BIT
- TAD LITRAL /ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
- DCA RX1SAV /OLD SECONDARY BOOT MOVES IT TO HANDLER
-CON360, 360 /LITERAL; EXECUTES IN LINE AS A NO-OP
-/ /FALLS THRU TO NEXT PAGE OF LISTING
-/
- /
-/ FOLLOWING CODE SAME AS OLD PRIMARY BOOT
-/
- JMS LOAD /GRAB NEXT ITEM FROM SILO
- DCA 2 /TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
- ISZ 50 /INCREMENT LOAD ADDRESS
- JMP 47 /GO BACK FOR ANOTHER
-/
-/ SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
-/ THEN CONTROL PASSES TO SECONDARY BOOT
-/
-LOAD, 0 /SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
- STR /IS HE READY TO TALK TO US?
- JMP START /NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
- XDR /YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
- JMP I LOAD /NO MAGIC, JUST EXIT FROM SUBROUTINE
-/
-/ 60 GOES TO OLD SECONDARY BOOT
-/ 61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
-/
-/
-CON420, /USE IT TO HOLD 420 LITERAL TO START OUT
-RX1SAV, 420 /UNIT^20+7004 TO GO TO SYS HANDLER
-UNIT, 20 /<DENSITY^400>+<UNIT^20> THAT BOOTED OK
-/
- ENPUNCH
-/
- / ## SECONDARY BOOT ##
-/
- RELOC 2 /SECTION LOADING OVER PRIMARY BOOT 2 - 47
-/
-STBOOT=.
-/
-/ ONCE-ONLY CODE AFTER FIRST SECTOR IS TRANSFERED
-/
-ONCE, TAD XR /SINGLE=113, DOUBLE=213
- CLL RAR /SINGLE=45, DOUBLE=105
- TAD YR /SETTING UP POINTER TO SECTOR, TRACK, FIELD, ADDR DATA
- DCA YR /DAT01-1 OR DAT02-1
- TAD I YR /GETTING SINGLE=774, DOUBLE=1374 (IN CASE OLD
- TAD RX1SAV /ADD IN 20^UNIT+7004 PRIMARY BOOT)
- DCA UNIT /PUT INTO 61: <DENSITY^400>+<UNIT^20>
- JMS NEXSEC /DESTROY LINKAGE TO ONCE ONLY CODE!
-XTRA, 0 /EXTRA TO MAKE ALL FIT
-/
-/
-/ AUTO INCREMENT REGISTERS
-/
-XR, 61 /CONTINUE TO LOAD FIRST SECTOR AT 62
-YR, DAT01-45-1 /SET UP POINTER TO DATA AREA
-/
-/ SECTOR DONE, SET UP FOR NEXT
-/
-NEXSEC, JMP ONCE /END OF FIRST SECTOR, DO SET-UP CODE
- CDF 0 /DATA FIELD HERE TO USE AUTO INCR REGISTERS
- TAD I YR /GET DATA FIELD FOR PLACEMENT OF NEXT SECTOR
- SMA /SKIP IF MORE TO DO
- JMP EBOOT /END OF BOOT,
- DCA XFIELD /PLACE IN LINE TO SET DATA FIELD
- AC6 /GET AC OF 6 TO SET UP FLOPPY READ
- TAD UNIT /DENSITY AND UNIT NUMBER
- LCD
- TAD I YR /SECTOR FOR NEXT READ
- JMS LOAD /LOAD LEAVES AC ALONE
- TAD I YR /TRACK-SECTOR FOR NEXT READ
- JMS LOAD /LOAD REMAINS FROM PRIMARY BOOT
- TAD I YR /ADDRESS-TRACK-1 FOR NEXT READ
-/ /FALL TO HANGGG WITH AC NON0 TO SHOW READ
-/
- / FOLLOWING TWO LOCATIONS MUST MATCH PRIMARY BOOT
-/
-HANGGG, SDN /SKIP IF DONE
- JMP LOAD+1 /NO, GO CHECK FOR TRANSFER READY
-/
-/ SORT OUT ERROR, SILO DONE, READ DONE
-/
- SER /SKIP IF ERROR
- SKP /IS GOOD, CHECK WHETHER READ OR SILO
- HLT /ANY ERROR IS FATAL!!
- SNA /SKIP IF READY TO SILO (AC HAS LOAD ADDR)
- JMP NEXSEC /DONE WITH SILO (AC=0) GO TO NEXT SECTOR
- DCA XR /USE AUTO-INCR TO LOAD CORE
- JMP OVRFLW /GO TO LOCATIONS NOT FITTING UNDER 47
-/
-/ CODE TO EMPTY THE SILO TO CORE
-/
-XFIELD, CDF 0 /FIELD FOR TRANSFER PLACED HERE
- JMS LOAD /LOAD REMAINS FROM PRIMARY BOOT
- DCA I XR /PLACE NEXT WORD
- JMP XFIELD /WHEN THIS LOCATION IS PLACED, SECONDARY BOOT
-/ /TAKES CONTROL, CONTINUE FIRST SECTOR AT 62
-/
-/ PRIMARY BOOT LOCATIONS 50-61 REMAIN INTACT
-/
-STATUS=. /REUSE FOR TEMPORARY
-/
-/ ## REST OF SECONDARY BOOT ##
-/
- RELOC 62 /SECTION LOADING 62 - 213
-/
-/ LOCATIONS NOT FITTING WITHIN 2-47 SPACE
-/
-OVRFLW, XDR /FETCH READ STATUS FOR LATER
- DCA STATUS /TO FIGURE OUT IF A DOUBLE SIDED FLOPPY
- AC2 /CODE FOR SILO OPERATION
- TAD UNIT /UNIT AND DENSITY
- LCD /SET TO EMPTY SILO
- JMP XFIELD /GO TO SILO UNLOADING LOOP
-/
-/
- /
-/ SINGLE DENSITY LOADING DATA
-/
-DAT01, 774 /CANCEL OUT 7004 WHEN ADDED TO 70X4
- CDF 0 /2ND SECTOR FOR SINGLE DENSITY, FIELD 0
- 3 /SECTOR 3, INTERLEAVED AT 2
- 1-3 /TRACK 1 (MINUS SECTOR 3)
- 114-1-1 /2 THRU 47 + 62 THRU 113 FOR FIRST SECTOR
-/ /-1 FOR TRACK, -1 FOR AUTO INCR
- CDF 0 /3RD SECTOR TO 7600 FIELD 0
- 5
- 1-5
- 7600-1-1
- CDF 0 /4TH SECTOR, SECOND HALF OF PAGE
- 7
- 1-7
- 7700-1-1
- CDF 10 /5TH SECTOR, TOP OF FIELD 1
- 21 /SECTOR 21
- 11-21 /OF TRACK 11
- 7600-11-1 /TO 7600
- CDF 10 /6TH SECTOR, REST OF FIELD 1
- 23
- 11-23
- 7700-11-1
- CDF 20 /7TH SECTOR, TOP OF FIELD 2
- 25
- 11-25
- 7600-11-1
- CDF 20 /10TH SECTOR, REST OF FIELD 2
- 27
- 11-27
- 7700-11-1
- 16 /MARKER AND LITERALS TO MAKE DAT02=DAT01+40
-MAGIC, 7623 /THIS WORD IN HANDLER HAS DENSITY, UNIT WORD
-L7605, 7605 /STARTING ADDR FOR HANDLER
-/
-/ DOUBLE DENSITY LOADING DATA
-/
-DAT02, 1374 /MAKE 400+UNIT WHEN ADDED TO 70X4
- CDF 0 /2ND SECTOR TO 7600
- 4 /INTERLEAVE OF 3
- 1-4
- 7600-1-1
- CDF 10
- 15
- 5-15
- 7600-5-1
- CDF 20 /3RD SECTOR TO 7600 OF FIELD 2
- 20 /SECOND HALF OF BLOCK 66 OCTAL
- 5-20 /ON TRACK 5
- 7600-5-1
- 16 /MARKER TO STOP WHOLE THING, ALSO LITERAL 16
- /
-/ I/O DONE, GO TO HANDLER
-/
-EBOOT, TAD UNIT /ENTER WITH AC=16
- LCD /SET DONE FLAG FOR HANDLER
- TAD STATUS /FIND OUT IF DOUBLE SIDED DISK
- RTR /DOUBLE SIDED BIT TO LINK
- CLA RAR /DOUBLE SIDED BIT TO AC0
- TAD UNIT /REST OF CONTROL WORD
- DCA I MAGIC /TO 7623 OF SYSTEM HANDLER
- JMP I L7605 /TO START UP SYSTEM
-/
-NDBOOT=.
-/
- / CODE THAT IS LOCATION SPECIFIC HAS !! IN COMMENTS
-/
-/ ## CODE FOR SYSTEM HANDLER ##
-/
- RELOC
- *200
- RELOC 7600
-/
-/ /USE DATA BREAKS FOR TEMPORARIES
-/
-QUO=7750 /QUOTIENT FOR DIVIDE == TRACK
-REMD=7751 /REMAINDER FOR DIVIDE == SECTOR
-REC=7752 /CURRENT LOGICAL SECTOR NUMBER
-RETRY=7753 /RETRIES COUNT
-/
- ZBLOCK 7 /REQUIRED BY BUILD
-/
-/
-/ ENTRY POINT
-/
-SYS, VERSION
-L32, 32 /FALL THRU SOME LITERALS
-L1734, 1734 /WHICH MAY PUT STRAY STUFF IN AC
- 3 /!!REQUIRED AT 7612!! TO SHOW OS8 TWO PAGE HANDLER
- AC7775 /SET UP RETRY COUNTER
- DCA RETRY /RETRIES ARE OVER ENTIRE OPERATION
- RDF /GRAB CALLER'S FIELD
- TAD LLCDF0 /MAKE CDF TO IT
- DCA RESTOR /PUT IT BACK, GOING TO I/O ROUTINE ON PAGE 2
-IOTYP, JMP FIRST /GO TO ONCE ONLY CODE, LATER USED AS VARIABLE
-/ /HAS HEAD, DENSITY, UNIT FOR I/O REQUEST
- JMP RSTART /GO CALL SECOND PAGE, IOTYP FALLS THRU TO HERE
-/
-/ LITERALS ETC.
-/
-L5000, 5000 /
-BOOTYP, /!!MUST BE AT 7623!! SECONDARY BOOT PUTS AT BOOT TIME
-/ /4000 IF QUAD, 400 IF DOUBLE, AND 20 IF UNIT 1
- IFZERO RXTYP-1 <0> /INITIAL VALUE MATCHES DEVICE TO ALLOW
- IFZERO RXTYP-2 <400> /BUILD ONTO VIRGIN MEDIA
- IFZERO RXTYP-3 <4400> /OTHERWISE, SECONDARY BOOT PUTS IN RIGHT STUFF
-LDENSW, DENSW /LOCATION ON SECOND PAGE
-L4110,
-LM3670, 4110 /VALUE WITH TWO USES
-LM32, -32
-LLCDF0, CDF 0
- /
-/ ONCE ONLY CODE
-/
-FIRST, JMP MORE /LEAVING ADDITIONAL ONCE-ONLY SPACE
-/
-/ FIX CDF TO 7642
-/
- *7642 /!!CDF OR CIF MUST BE AT 7642!!
-MORE, CDF 20 /POINT TO OUR SECOND PAGE
- TAD BOOTYP /PICK UP BOOT WORD
-SNGDBL, CLL RAL /MAKE A WORD MINUS IF DOUBLE (OR QUAD) BOOTED
-SIZE, RTL /REUSE FOR CONSTANTS
- DCA SNGDBL /JUST FOR CONVENIENCE, THE BIT IS IN BOOTYP ANYHOW
- TAD QL3400 /ANY LITERAL IN RANGE 3400-3757 (LINK=0 HERE)
- TAD BOOTYP /FIGURE OUT SIZE OF MEDIA
- SMA SNL CLA /SKIP IF DOUBLE OR QUAD
- TAD L1734 /SINGLE
- TAD L4110 /S=6044, D&Q=4110
- SNL /SKIP IF QUAD, ITS SIZE ALREADY THERE
- CLL CML RAR /OTHER TWO CASES DIVIDE BY TWO
- DCA SIZE /STORE S=7022, D=6044, Q=4110
- TAD SNGDBL /MAKE DENSW, 7600 IF DOUBLE, 7700 IF SINGLE
- SPA CLA /SKIP IF SINGLE
- TAD L7700
- TAD L7700
-QL3400, DCA I LDENSW /MUST LIVE ON SECOND PAGE
-/
-/ END OF ONCE-ONLY, (RE)START I/O OPERATION
-/
-RSTART, /AC MAY HAVE JUNK COMING IN!!
- AC3777 /MAKE A WORD WITH DENSITY AND UNIT BITS ONLY
- AND BOOTYP /FOR CONTRUCTING LCD ARGUMENTS
- DCA IOTYP /ALSO SHUTS OFF PATH TO ONCE-ONLY CODE!
- TAD SYS /AC HAS THE CALL ADDR
-RESTOR, HLT /SET DATA FIELD TO THAT OF CALLER
- CIF 20
- JMP PAGE2
- /
-/
-/ CALL WITH AC NON0 TO DO DIVIDE
-/ CALL WITH AC ZERO TO DO I/O RETRY (WHOLE OPERATION)
-/
-DIVSUB, 0
- SNA CLA /SKIP IF REALLY A DIVIDE REQUEST
- JMP RSTART /NO, IT WAS AN ERROR RETRY!!
- DCA QUO /CLEAR DIVIDE QUOTIENT
- TAD BOOTYP /IS IT A TWO HEADER
- SKP /!!FAULTY USR CALL DOES JMS HERE (7700)
- HLT /HALT OUT SUCH AN OCCURRENCE!!
-L7700, SMA CLA /SKIP IF YES
- JMP SHUNT /NO, GO DO DIVIDE
- CLL /TO CHECK 12 BIT SIZE
- TAD REC /WHICH RECORD ARE WE WORKING ON
- TAD LM3670 /NUMBER OF SECTORS ON FIRST SIDE
- SNL CLA /SKIP IF SECOND SIDED IT
- JMP SHUNT /NO, JUST REGULAR
- TAD BOOTYP /MAKE IO FUNCTION WORD WITH SECOND HEAD BIT
- TAD L5000 /CONVERTS TO 20^UNIT +1400
- DCA IOTYP
- TAD LM3670 /BUT DECREASE RECORD NUMBER
-SHUNT, TAD REC /THIS FOR TRACK-SECTOR
-DIVLOO, ISZ QUO /MAIN DIVIDE LOOP
- TAD LM32 /DIVIDE BY 26 TO GET TRACK
- SMA /SKIP IF DONE
- JMP DIVLOO
- TAD L32 /REMAINDER 0-25
- DCA REMD /USE AS TEMPORARY UNTIL FINAL VALUE
- TAD SNGDBL /FIND OUT IF SINGLE BOOT
- SPA CLA /SKIP IF YES
- TAD REMD /MULTIPLY BY THREE FOR DOUBLE
- TAD REMD /AND BY TWO FOR SINGLE
- TAD REMD
- CLL IAC /LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
- TAD LM32 /DIVIDE BY 26 TO GET SECTOR
- SMA SZA /SKIP IF DONE
- JMP .-2
- TAD L32 /RESTORE POSITIVE VALUE TO BE SECTOR
- DCA REMD /WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
- TAD SNGDBL /IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
- SMA SNL CLA /SKIP IF NOT THE SINGLE DENS. 1,3,5,7,9,,, SERIES
- ISZ REMD /NOW HAVE IT 2,4,6,8,10,12,14,16...
- CIF 20 /POP BACK TO OTHER PAGE
- JMP I DIVSUB /!!THIS IS IN LAST USABLE LOCATION, EXEC NEEDS 7744!!
-/
-/
-
-/
-/ ## SECOND PAGE ##
-/
- RELOC
- *400
- RELOC 7600
-/
-/ FETCH ARGUMENTS, ETC.
-/
-PAGE2, DCA FETCH /ENTER WITH ARGUMENT LIST ADDR IN AC
- RDF /SAFE HERE?
- TAD LCDIF0 /SET UP EXIT TO CALLER
- DCA EXFLD
- AC4000 /SET UP TO PUT R/W BIT TO LINK
- TAD I FETCH /FIRST ARGUMENT HAS FIELD FOR TRANSFER
- AND L70 /KEEPING ONLY FIELD
- TAD LCDF0 /MAKE CDF TO TRANSFER FIELD
- DCA BUFCDF /PLACE IN LINE FOR SILO LOOP
- CML RTL /0=WRITE, 2=READ
- DCA FN
- TAD I FETCH /MAKE CONTROL COUNT FOR TRANSFER
- RAL
- AND L7600 /COUNT OF WORDS
- CIA /0 FOR WHOLE FIELD
- DCA BC
- ISZ FETCH /NEXT ARGUMENT
- TAD I FETCH /BUFFER ADDRESS
- DCA BUF
- ISZ FETCH /NEXT
- TAD L100 /CARRY WITH DENSW IF SINGLE DENSITY
- TAD DENSW /SET TO COMPUTE SECTOR# FOR BLOCK#
- SMA CLA /SKIP IF DOUBLE, MULTIPLE BY 2
- TAD I FETCH /SINGLE, MULTIPLY BY FOUR
- TAD I FETCH
- ISZ FETCH /MOVING POINTER TO ERROR EXIT
- CDF 0 /INDIRECT TO FIRST PAGE FOR CONSTANTS
- CLL RAL /FINAL PART OF MULTIPLY
- DCA I LREC /SAVE SECTOR NUMBER
- TAD I LSIZE /TOTAL SIZE OF MEDIA
- SZL /SKIP IF LEGAL BLOCK #
- JMP EXFLD /EXIT TO CALLER WITH BLOCK # IN AC
-LCDIF0, CIF CDF 0 /GO BACK TO FIRST PAGE
- JMS DIVSUB /SET UP TRACK AND SECTOR
- TAD FN /SPLIT READ AND WRITE
- SZA CLA /WRITE SKIPS
- JMP STREAD /READ STARTS IN MIDDLE OF LOOP
-/ /WRITE FALLS TO NEXT LISTING PAGE
-
-/
-/WRITE FALLS THRU TO THIS LOOP
-/
-/ TOP OF MAIN LOOP
-/
-TOP, TAD FN /SET SILO TO LOAD-UNLOAD
- JMS LDCMD /COMMAND TO CONTROLLER
- TAD DENSW /MAKE SILO LOOP COUNT, S=7700, D=7600
- DCA FLPWC /LDCMD ENTRY SAFE TEMPORARY
-BUFCDF, HLT /CDF TO BUFFER FIELD PLACED HERE
-TRLOOP, TAD I BUF /IN CASE WRITE, FETCH A WORD
- STR /SKIP IF READY TO PASS DATA
- JMP .-1 /NO
- XDR /TO OR FROM AC
- DCA I BUF /PLACE WORD FOR READ, WRITE REPLACES SAME
- ISZ BUF /MOVE BUFFER POINTER, (MAY SKIP)
-L70, 70
- ISZ FLPWC /DONE YET
- JMP TRLOOP
- TAD DENSW /ADDING 77 (SINGLE) 177 (DOUBLE)
- CMA /ONCE WE CMA, THAT IS
- TAD BC /LOOP CONTROL TO FINISH READ
- SNA
- JMP OKEX /OK, DONE
- DCA BC /REPLACE AND KEEP GOING
-/
-/ MIDDLE OF MAIN LOOP
-/
-STREAD, TAD FN /READ STARTS HERE
- TAD L4 /TURN SILO COMMAND INTO READ-WRITE COMMAND
- JMS LDCMD /I/O COMMAND TO CONTROLLER
- TAD I LREMD /PRECOMPUTED SECTOR #; LDCMD SET FIELD TO 0
- STR
- JMP .-1
- XDR
-L7600, 7600 /CLEAR AC, AND IS LITERAL
- TAD I LQUO /TRACK #
- STR
- JMP .-1
- XDR /TRACK # IS ALWAYS NON0 !!
- ISZ I LREC /MOVE TO NEXT RECORD NUMBER
-BACKER, CDF CIF 0 /GO BACK TO FIRST PAGE
- JMS DIVSUB /FOR TRACK AND SECTOR
- TAD L16 /WAIT FOR OPERATION TO COMPLETE
- JMS LDCMD
- ISZ BC /CHECK FOR WRITE EXIT
- JMP TOP /STILL MORE
-OKEX, ISZ FETCH /KICK TO OK EXIT
-EXFLD, HLT /CDF CIF TO CALLER
- JMP I FETCH /OUT
-
-/
-/ LDCMD SUBROUTINE
-/
-FLPWC=. /ENTRY POINT A SAFE COUNT TEMPORARY
-LDCMD, 0 /CALL TO GIVE COMMAND TO CONTROLLER
-LCDF0, CDF 0 /INDIRECTS BACK TO FIRST PAGE
- TAD I LIOTYP /PUT IN UNIT, DENSITY, HEAD
- SDN /SKIP IF CONTROLLER READY
- JMP .-1 /NO
- LCD /COMMAND
- SER /SKIP IF AN ERROR
- JMP I LDCMD /NO
- ISZ I LRETRY /TRIED ENOUGH TIMES ALREADY?
- JMP BACKER /TO DIVSUB WITH AC=0 TO RETRY !!!!!
- AC4000 /HARD ERROR, GIVE BACK MINUS RESULT
- JMP EXFLD
-/
-/ VARIABLES ETC.
-/
-BUF, 0 /POINTER TO CALLER'S BUFFER
-FETCH, 0 /POINTER TO CALL
-BC, 0 /CONTROL COUNT, WORDS TO TRANSFER
-FN, 0 /0 FOR WRITE, 2 FOR READ
-DENSW, 0 /7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
-/
-/ LITERALS
-/
-L4, 4
-L16, 16
-L100, 100
-LIOTYP, IOTYP /POINTERS BACK TO FIRST PAGE
-LRETRY, RETRY
-LSIZE, SIZE
-LQUO, QUO
-LREC, REC
-LREMD, REMD
-
DELETED src/os8-v3f/RXSY2.PA
Index: src/os8-v3f/RXSY2.PA
==================================================================
--- src/os8-v3f/RXSY2.PA
+++ /dev/null
@@ -1,529 +0,0 @@
-/RX02 SYSTEM HANDLER
-/
-/ THIS HANDLER WAS DESIGNED TO WORK WITH RX01, RX02, RX03
-/
-/ HOWEVER, ONE SINGLE BINARY CANNOT SUCCESSFULLY BE USED IN A
-/ VIRGIN BUILD FOR ALL THREE DEVICES. IT IS CURRENTLY SET UP
-/ TO BUILD AN RX02.
-/ TO GENERATE A BINARY TO BUILD AN RX01, CHANGE THE RXTYP
-/ EQUATE TO 1. FOR AN RX03 BUILD, CHANGE RXTYP TO 3.
-/
-RXTYP=2 /DEFAULT, BUILD ONTO AN RX02
-/
-/
-/
-VERSION="M&77
-/
-/
-AC1=CLL CLA IAC
-AC2=CLL CLA CML RTL
-AC6=CLL CLA CML IAC RTL /RX02'S MUST RUN ON AN OMNI-BUS !!
-AC4000=CLL CLA CML RAR
-AC3777=CLL CLA CMA RAR
-AC7775=CLL CLA CMA RTL
-/
-/ DEVICE IOT SYMBOLIC EQUATES
-/
-LCD=6751 /LOAD COMMAND
-XDR=6752 /TRANSFER DATA
-STR=6753 /SKIP IF READY TO TRANSFER
-SER=6754 /SKIP ON ERROR
-SDN=6755 /SKIP ON DONE
-/
-/ HEADER BLOCK FOR BUILD
-/
- *0
- -1 /ONE ENTRY
- DEVICE RX8E
- DEVICE SYS
- 4320 /MULTI-TYPE RX HANDLER
- SYS&177+6000 /TWO PAGE HANDLER
- 0 /UNUSED
- IFZERO RXTYP-1 <756> /SIZE FOR BUILD
- IFZERO RXTYP-2 <1734>
- IFZERO RXTYP-3 <3670>
-/
- STBOOT-NDBOOT+12 /-SIZE (+12 FOR GAP)
- /
-/ HERE IS A LISTING OF THE PRIMARY BOOT FOR CONVENIENCE
-/
- NOPUNCH
-/
- *20
-/
-READ, TAD UNIT /TRY NEXT COMBINATION OF DENSITY AND UNIT
- TAD CON360 /ADDING IN 360
- AND CON420 /KEEPING ONLY 420 BITS
- DCA UNIT /CYCLES 400,420,0,20,400,,,,,,,,
- AC6 /COMMAND TO READ DISK
- TAD UNIT /UNIT AND DENSITY
- LCD /COMMAND TO CONTROLLER
- AC1 /TO SET SECTOR AND TRACK TO 1
- JMS LOAD /SECTOR TO CONTROLLER, LEAVES AC ALONE
- JMS LOAD /AND TRACK
-LITRAL, 7004 /LEAVING A 2 IN AC; SERVES AS LITERAL
-/
-/ FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
-/
-START, SDN /HAS DONE COME UP; CODE STARTS HERE!
- JMP LOAD+1 /NO, GO CHECK FOR READY TO TRANSFER
-/
-/ NOW, DONE OR ERROR
-/
- SER /SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
- SNA /NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
- JMP READ /START-UP, GO SET UP UNIT, THEN READ TO SILO
- TAD UNIT /AC ALREADY 2, PUT IN UNIT, DENSITY
- LCD /TO EMPTY THE SILO
- TAD UNIT /SET UP LOC 60 FOR OLD SECONDARY BOOT
- AND CON360 /KEEPING UNLY DENSITY BIT
- TAD LITRAL /ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
- DCA RX1SAV /OLD SECONDARY BOOT MOVES IT TO HANDLER
-CON360, 360 /LITERAL; EXECUTES IN LINE AS A NO-OP
-/ /FALLS THRU TO NEXT PAGE OF LISTING
-/
- /
-/ FOLLOWING CODE SAME AS OLD PRIMARY BOOT
-/
- JMS LOAD /GRAB NEXT ITEM FROM SILO
- DCA 2 /TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
- ISZ 50 /INCREMENT LOAD ADDRESS
- JMP 47 /GO BACK FOR ANOTHER
-/
-/ SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
-/ THEN CONTROL PASSES TO SECONDARY BOOT
-/
-LOAD, 0 /SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
- STR /IS HE READY TO TALK TO US?
- JMP START /NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
- XDR /YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
- JMP I LOAD /NO MAGIC, JUST EXIT FROM SUBROUTINE
-/
-/ 60 GOES TO OLD SECONDARY BOOT
-/ 61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
-/
-/
-CON420, /USE IT TO HOLD 420 LITERAL TO START OUT
-RX1SAV, 420 /UNIT^20+7004 TO GO TO SYS HANDLER
-UNIT, 20 /<DENSITY^400>+<UNIT^20> THAT BOOTED OK
-/
- ENPUNCH
-/
- / ## SECONDARY BOOT ##
-/
- RELOC 2 /SECTION LOADING OVER PRIMARY BOOT 2 - 47
-/
-STBOOT=.
-/
-/ ONCE-ONLY CODE AFTER FIRST SECTOR IS TRANSFERED
-/
-ONCE, TAD XR /SINGLE=113, DOUBLE=213
- CLL RAR /SINGLE=45, DOUBLE=105
- TAD YR /SETTING UP POINTER TO SECTOR, TRACK, FIELD, ADDR DATA
- DCA YR /DAT01-1 OR DAT02-1
- TAD I YR /GETTING SINGLE=774, DOUBLE=1374 (IN CASE OLD
- TAD RX1SAV /ADD IN 20^UNIT+7004 PRIMARY BOOT)
- DCA UNIT /PUT INTO 61: <DENSITY^400>+<UNIT^20>
- JMS NEXSEC /DESTROY LINKAGE TO ONCE ONLY CODE!
-XTRA, 0 /EXTRA TO MAKE ALL FIT
-/
-/
-/ AUTO INCREMENT REGISTERS
-/
-XR, 61 /CONTINUE TO LOAD FIRST SECTOR AT 62
-YR, DAT01-45-1 /SET UP POINTER TO DATA AREA
-/
-/ SECTOR DONE, SET UP FOR NEXT
-/
-NEXSEC, JMP ONCE /END OF FIRST SECTOR, DO SET-UP CODE
- CDF 0 /DATA FIELD HERE TO USE AUTO INCR REGISTERS
- TAD I YR /GET DATA FIELD FOR PLACEMENT OF NEXT SECTOR
- SMA /SKIP IF MORE TO DO
- JMP EBOOT /END OF BOOT,
- DCA XFIELD /PLACE IN LINE TO SET DATA FIELD
- AC6 /GET AC OF 6 TO SET UP FLOPPY READ
- TAD UNIT /DENSITY AND UNIT NUMBER
- LCD
- TAD I YR /SECTOR FOR NEXT READ
- JMS LOAD /LOAD LEAVES AC ALONE
- TAD I YR /TRACK-SECTOR FOR NEXT READ
- JMS LOAD /LOAD REMAINS FROM PRIMARY BOOT
- TAD I YR /ADDRESS-TRACK-1 FOR NEXT READ
-/ /FALL TO HANGGG WITH AC NON0 TO SHOW READ
-/
- / FOLLOWING TWO LOCATIONS MUST MATCH PRIMARY BOOT
-/
-HANGGG, SDN /SKIP IF DONE
- JMP LOAD+1 /NO, GO CHECK FOR TRANSFER READY
-/
-/ SORT OUT ERROR, SILO DONE, READ DONE
-/
- SER /SKIP IF ERROR
- SKP /IS GOOD, CHECK WHETHER READ OR SILO
- HLT /ANY ERROR IS FATAL!!
- SNA /SKIP IF READY TO SILO (AC HAS LOAD ADDR)
- JMP NEXSEC /DONE WITH SILO (AC=0) GO TO NEXT SECTOR
- DCA XR /USE AUTO-INCR TO LOAD CORE
- JMP OVRFLW /GO TO LOCATIONS NOT FITTING UNDER 47
-/
-/ CODE TO EMPTY THE SILO TO CORE
-/
-XFIELD, CDF 0 /FIELD FOR TRANSFER PLACED HERE
- JMS LOAD /LOAD REMAINS FROM PRIMARY BOOT
- DCA I XR /PLACE NEXT WORD
- JMP XFIELD /WHEN THIS LOCATION IS PLACED, SECONDARY BOOT
-/ /TAKES CONTROL, CONTINUE FIRST SECTOR AT 62
-/
-/ PRIMARY BOOT LOCATIONS 50-61 REMAIN INTACT
-/
-STATUS=. /REUSE FOR TEMPORARY
-/
-/ ## REST OF SECONDARY BOOT ##
-/
- RELOC 62 /SECTION LOADING 62 - 213
-/
-/ LOCATIONS NOT FITTING WITHIN 2-47 SPACE
-/
-OVRFLW, XDR /FETCH READ STATUS FOR LATER
- DCA STATUS /TO FIGURE OUT IF A DOUBLE SIDED FLOPPY
- AC2 /CODE FOR SILO OPERATION
- TAD UNIT /UNIT AND DENSITY
- LCD /SET TO EMPTY SILO
- JMP XFIELD /GO TO SILO UNLOADING LOOP
-/
-/
- /
-/ SINGLE DENSITY LOADING DATA
-/
-DAT01, 774 /CANCEL OUT 7004 WHEN ADDED TO 70X4
- CDF 0 /2ND SECTOR FOR SINGLE DENSITY, FIELD 0
- 3 /SECTOR 3, INTERLEAVED AT 2
- 1-3 /TRACK 1 (MINUS SECTOR 3)
- 114-1-1 /2 THRU 47 + 62 THRU 113 FOR FIRST SECTOR
-/ /-1 FOR TRACK, -1 FOR AUTO INCR
- CDF 0 /3RD SECTOR TO 7600 FIELD 0
- 5
- 1-5
- 7600-1-1
- CDF 0 /4TH SECTOR, SECOND HALF OF PAGE
- 7
- 1-7
- 7700-1-1
- CDF 10 /5TH SECTOR, TOP OF FIELD 1
- 21 /SECTOR 21
- 11-21 /OF TRACK 11
- 7600-11-1 /TO 7600
- CDF 10 /6TH SECTOR, REST OF FIELD 1
- 23
- 11-23
- 7700-11-1
- CDF 20 /7TH SECTOR, TOP OF FIELD 2
- 25
- 11-25
- 7600-11-1
- CDF 20 /10TH SECTOR, REST OF FIELD 2
- 27
- 11-27
- 7700-11-1
- 16 /MARKER AND LITERALS TO MAKE DAT02=DAT01+40
-MAGIC, 7623 /THIS WORD IN HANDLER HAS DENSITY, UNIT WORD
-L7605, 7605 /STARTING ADDR FOR HANDLER
-/
-/ DOUBLE DENSITY LOADING DATA
-/
-DAT02, 1374 /MAKE 400+UNIT WHEN ADDED TO 70X4
- CDF 0 /2ND SECTOR TO 7600
- 4 /INTERLEAVE OF 3
- 1-4
- 7600-1-1
- CDF 10
- 15
- 5-15
- 7600-5-1
- CDF 20 /3RD SECTOR TO 7600 OF FIELD 2
- 20 /SECOND HALF OF BLOCK 66 OCTAL
- 5-20 /ON TRACK 5
- 7600-5-1
- 16 /MARKER TO STOP WHOLE THING, ALSO LITERAL 16
- /
-/ I/O DONE, GO TO HANDLER
-/
-EBOOT, TAD UNIT /ENTER WITH AC=16
- LCD /SET DONE FLAG FOR HANDLER
- TAD STATUS /FIND OUT IF DOUBLE SIDED DISK
- RTR /DOUBLE SIDED BIT TO LINK
- CLA RAR /DOUBLE SIDED BIT TO AC0
- TAD UNIT /REST OF CONTROL WORD
- DCA I MAGIC /TO 7623 OF SYSTEM HANDLER
- JMP I L7605 /TO START UP SYSTEM
-/
-NDBOOT=.
-/
- / CODE THAT IS LOCATION SPECIFIC HAS !! IN COMMENTS
-/
-/ ## CODE FOR SYSTEM HANDLER ##
-/
- RELOC
- *200
- RELOC 7600
-/
-/ /USE DATA BREAKS FOR TEMPORARIES
-/
-QUO=7750 /QUOTIENT FOR DIVIDE == TRACK
-REMD=7751 /REMAINDER FOR DIVIDE == SECTOR
-REC=7752 /CURRENT LOGICAL SECTOR NUMBER
-RETRY=7753 /RETRIES COUNT
-/
- ZBLOCK 7 /REQUIRED BY BUILD
-/
-/
-/ ENTRY POINT
-/
-SYS, VERSION
-L32, 32 /FALL THRU SOME LITERALS
-L1734, 1734 /WHICH MAY PUT STRAY STUFF IN AC
- 3 /!!REQUIRED AT 7612!! TO SHOW OS8 TWO PAGE HANDLER
- AC7775 /SET UP RETRY COUNTER
- DCA RETRY /RETRIES ARE OVER ENTIRE OPERATION
- RDF /GRAB CALLER'S FIELD
- TAD LLCDF0 /MAKE CDF TO IT
- DCA RESTOR /PUT IT BACK, GOING TO I/O ROUTINE ON PAGE 2
-IOTYP, JMP FIRST /GO TO ONCE ONLY CODE, LATER USED AS VARIABLE
-/ /HAS HEAD, DENSITY, UNIT FOR I/O REQUEST
- JMP RSTART /GO CALL SECOND PAGE, IOTYP FALLS THRU TO HERE
-/
-/ LITERALS ETC.
-/
-L5000, 5000 /
-BOOTYP, /!!MUST BE AT 7623!! SECONDARY BOOT PUTS AT BOOT TIME
-/ /4000 IF QUAD, 400 IF DOUBLE, AND 20 IF UNIT 1
- IFZERO RXTYP-1 <0> /INITIAL VALUE MATCHES DEVICE TO ALLOW
- IFZERO RXTYP-2 <400> /BUILD ONTO VIRGIN MEDIA
- IFZERO RXTYP-3 <4400> /OTHERWISE, SECONDARY BOOT PUTS IN RIGHT STUFF
-LDENSW, DENSW /LOCATION ON SECOND PAGE
-L4110,
-LM3670, 4110 /VALUE WITH TWO USES
-LM32, -32
-LLCDF0, CDF 0
- /
-/ ONCE ONLY CODE
-/
-FIRST, JMP MORE /LEAVING ADDITIONAL ONCE-ONLY SPACE
-/
-/ FIX CDF TO 7642
-/
- *7642 /!!CDF OR CIF MUST BE AT 7642!!
-MORE, CDF 20 /POINT TO OUR SECOND PAGE
- TAD BOOTYP /PICK UP BOOT WORD
-SNGDBL, CLL RAL /MAKE A WORD MINUS IF DOUBLE (OR QUAD) BOOTED
-SIZE, RTL /REUSE FOR CONSTANTS
- DCA SNGDBL /JUST FOR CONVENIENCE, THE BIT IS IN BOOTYP ANYHOW
- TAD QL3400 /ANY LITERAL IN RANGE 3400-3757 (LINK=0 HERE)
- TAD BOOTYP /FIGURE OUT SIZE OF MEDIA
- SMA SNL CLA /SKIP IF DOUBLE OR QUAD
- TAD L1734 /SINGLE
- TAD L4110 /S=6044, D&Q=4110
- SNL /SKIP IF QUAD, ITS SIZE ALREADY THERE
- CLL CML RAR /OTHER TWO CASES DIVIDE BY TWO
- DCA SIZE /STORE S=7022, D=6044, Q=4110
- TAD SNGDBL /MAKE DENSW, 7600 IF DOUBLE, 7700 IF SINGLE
- SPA CLA /SKIP IF SINGLE
- TAD L7700
- TAD L7700
-QL3400, DCA I LDENSW /MUST LIVE ON SECOND PAGE
-/
-/ END OF ONCE-ONLY, (RE)START I/O OPERATION
-/
-RSTART, /AC MAY HAVE JUNK COMING IN!!
- AC3777 /MAKE A WORD WITH DENSITY AND UNIT BITS ONLY
- AND BOOTYP /FOR CONTRUCTING LCD ARGUMENTS
- DCA IOTYP /ALSO SHUTS OFF PATH TO ONCE-ONLY CODE!
- TAD SYS /AC HAS THE CALL ADDR
-RESTOR, HLT /SET DATA FIELD TO THAT OF CALLER
- CIF 20
- JMP PAGE2
- /
-/
-/ CALL WITH AC NON0 TO DO DIVIDE
-/ CALL WITH AC ZERO TO DO I/O RETRY (WHOLE OPERATION)
-/
-DIVSUB, 0
- SNA CLA /SKIP IF REALLY A DIVIDE REQUEST
- JMP RSTART /NO, IT WAS AN ERROR RETRY!!
- DCA QUO /CLEAR DIVIDE QUOTIENT
- TAD BOOTYP /IS IT A TWO HEADER
- SKP /!!FAULTY USR CALL DOES JMS HERE (7700)
- HLT /HALT OUT SUCH AN OCCURRENCE!!
-L7700, SMA CLA /SKIP IF YES
- JMP SHUNT /NO, GO DO DIVIDE
- CLL /TO CHECK 12 BIT SIZE
- TAD REC /WHICH RECORD ARE WE WORKING ON
- TAD LM3670 /NUMBER OF SECTORS ON FIRST SIDE
- SNL CLA /SKIP IF SECOND SIDED IT
- JMP SHUNT /NO, JUST REGULAR
- TAD BOOTYP /MAKE IO FUNCTION WORD WITH SECOND HEAD BIT
- TAD L5000 /CONVERTS TO 20^UNIT +1400
- DCA IOTYP
- TAD LM3670 /BUT DECREASE RECORD NUMBER
-SHUNT, TAD REC /THIS FOR TRACK-SECTOR
-DIVLOO, ISZ QUO /MAIN DIVIDE LOOP
- TAD LM32 /DIVIDE BY 26 TO GET TRACK
- SMA /SKIP IF DONE
- JMP DIVLOO
- TAD L32 /REMAINDER 0-25
- DCA REMD /USE AS TEMPORARY UNTIL FINAL VALUE
- TAD SNGDBL /FIND OUT IF SINGLE BOOT
- SPA CLA /SKIP IF YES
- TAD REMD /MULTIPLY BY THREE FOR DOUBLE
- TAD REMD /AND BY TWO FOR SINGLE
- TAD REMD
- CLL IAC /LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
- TAD LM32 /DIVIDE BY 26 TO GET SECTOR
- SMA SZA /SKIP IF DONE
- JMP .-2
- TAD L32 /RESTORE POSITIVE VALUE TO BE SECTOR
- DCA REMD /WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
- TAD SNGDBL /IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
- SMA SNL CLA /SKIP IF NOT THE SINGLE DENS. 1,3,5,7,9,,, SERIES
- ISZ REMD /NOW HAVE IT 2,4,6,8,10,12,14,16...
- CIF 20 /POP BACK TO OTHER PAGE
- JMP I DIVSUB /!!THIS IS IN LAST USABLE LOCATION, EXEC NEEDS 7744!!
-/
-/
-
-/
-/ ## SECOND PAGE ##
-/
- RELOC
- *400
- RELOC 7600
-/
-/ FETCH ARGUMENTS, ETC.
-/
-PAGE2, DCA FETCH /ENTER WITH ARGUMENT LIST ADDR IN AC
- RDF /SAFE HERE?
- TAD LCDIF0 /SET UP EXIT TO CALLER
- DCA EXFLD
- AC4000 /SET UP TO PUT R/W BIT TO LINK
- TAD I FETCH /FIRST ARGUMENT HAS FIELD FOR TRANSFER
- AND L70 /KEEPING ONLY FIELD
- TAD LCDF0 /MAKE CDF TO TRANSFER FIELD
- DCA BUFCDF /PLACE IN LINE FOR SILO LOOP
- CML RTL /0=WRITE, 2=READ
- DCA FN
- TAD I FETCH /MAKE CONTROL COUNT FOR TRANSFER
- RAL
- AND L7600 /COUNT OF WORDS
- CIA /0 FOR WHOLE FIELD
- DCA BC
- ISZ FETCH /NEXT ARGUMENT
- TAD I FETCH /BUFFER ADDRESS
- DCA BUF
- ISZ FETCH /NEXT
- TAD L100 /CARRY WITH DENSW IF SINGLE DENSITY
- TAD DENSW /SET TO COMPUTE SECTOR# FOR BLOCK#
- SMA CLA /SKIP IF DOUBLE, MULTIPLE BY 2
- TAD I FETCH /SINGLE, MULTIPLY BY FOUR
- TAD I FETCH
- ISZ FETCH /MOVING POINTER TO ERROR EXIT
- CDF 0 /INDIRECT TO FIRST PAGE FOR CONSTANTS
- CLL RAL /FINAL PART OF MULTIPLY
- DCA I LREC /SAVE SECTOR NUMBER
- TAD I LSIZE /TOTAL SIZE OF MEDIA
- SZL /SKIP IF LEGAL BLOCK #
- JMP EXFLD /EXIT TO CALLER WITH BLOCK # IN AC
-LCDIF0, CIF CDF 0 /GO BACK TO FIRST PAGE
- JMS DIVSUB /SET UP TRACK AND SECTOR
- TAD FN /SPLIT READ AND WRITE
- SZA CLA /WRITE SKIPS
- JMP STREAD /READ STARTS IN MIDDLE OF LOOP
-/ /WRITE FALLS TO NEXT LISTING PAGE
-
-/
-/WRITE FALLS THRU TO THIS LOOP
-/
-/ TOP OF MAIN LOOP
-/
-TOP, TAD FN /SET SILO TO LOAD-UNLOAD
- JMS LDCMD /COMMAND TO CONTROLLER
- TAD DENSW /MAKE SILO LOOP COUNT, S=7700, D=7600
- DCA FLPWC /LDCMD ENTRY SAFE TEMPORARY
-BUFCDF, HLT /CDF TO BUFFER FIELD PLACED HERE
-TRLOOP, TAD I BUF /IN CASE WRITE, FETCH A WORD
- STR /SKIP IF READY TO PASS DATA
- JMP .-1 /NO
- XDR /TO OR FROM AC
- DCA I BUF /PLACE WORD FOR READ, WRITE REPLACES SAME
- ISZ BUF /MOVE BUFFER POINTER, (MAY SKIP)
-L70, 70
- ISZ FLPWC /DONE YET
- JMP TRLOOP
- TAD DENSW /ADDING 77 (SINGLE) 177 (DOUBLE)
- CMA /ONCE WE CMA, THAT IS
- TAD BC /LOOP CONTROL TO FINISH READ
- SNA
- JMP OKEX /OK, DONE
- DCA BC /REPLACE AND KEEP GOING
-/
-/ MIDDLE OF MAIN LOOP
-/
-STREAD, TAD FN /READ STARTS HERE
- TAD L4 /TURN SILO COMMAND INTO READ-WRITE COMMAND
- JMS LDCMD /I/O COMMAND TO CONTROLLER
- TAD I LREMD /PRECOMPUTED SECTOR #; LDCMD SET FIELD TO 0
- STR
- JMP .-1
- XDR
-L7600, 7600 /CLEAR AC, AND IS LITERAL
- TAD I LQUO /TRACK #
- STR
- JMP .-1
- XDR /TRACK # IS ALWAYS NON0 !!
- ISZ I LREC /MOVE TO NEXT RECORD NUMBER
-BACKER, CDF CIF 0 /GO BACK TO FIRST PAGE
- JMS DIVSUB /FOR TRACK AND SECTOR
- TAD L16 /WAIT FOR OPERATION TO COMPLETE
- JMS LDCMD
- ISZ BC /CHECK FOR WRITE EXIT
- JMP TOP /STILL MORE
-OKEX, ISZ FETCH /KICK TO OK EXIT
-EXFLD, HLT /CDF CIF TO CALLER
- JMP I FETCH /OUT
-
-/
-/ LDCMD SUBROUTINE
-/
-FLPWC=. /ENTRY POINT A SAFE COUNT TEMPORARY
-LDCMD, 0 /CALL TO GIVE COMMAND TO CONTROLLER
-LCDF0, CDF 0 /INDIRECTS BACK TO FIRST PAGE
- TAD I LIOTYP /PUT IN UNIT, DENSITY, HEAD
- SDN /SKIP IF CONTROLLER READY
- JMP .-1 /NO
- LCD /COMMAND
- SER /SKIP IF AN ERROR
- JMP I LDCMD /NO
- ISZ I LRETRY /TRIED ENOUGH TIMES ALREADY?
- JMP BACKER /TO DIVSUB WITH AC=0 TO RETRY !!!!!
- AC4000 /HARD ERROR, GIVE BACK MINUS RESULT
- JMP EXFLD
-/
-/ VARIABLES ETC.
-/
-BUF, 0 /POINTER TO CALLER'S BUFFER
-FETCH, 0 /POINTER TO CALL
-BC, 0 /CONTROL COUNT, WORDS TO TRANSFER
-FN, 0 /0 FOR WRITE, 2 FOR READ
-DENSW, 0 /7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
-/
-/ LITERALS
-/
-L4, 4
-L16, 16
-L100, 100
-LIOTYP, IOTYP /POINTERS BACK TO FIRST PAGE
-LRETRY, RETRY
-LSIZE, SIZE
-LQUO, QUO
-LREC, REC
-LREMD, REMD
-
DELETED src/os8-v3f/SAVECB.PA
Index: src/os8-v3f/SAVECB.PA
==================================================================
--- src/os8-v3f/SAVECB.PA
+++ /dev/null
@@ -1,658 +0,0 @@
-/SAVECB.PA DEMONSTRATION PROGRAM TO INCREASE THE NUMBER OF SAVE ARGUMENTS
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /SAVCB.PA INCREASES THE NUMBER OF SAVE ARGUMENTS JULY 1978
-/ MEMORY LOCATIONS UTILIZED
-/ 0000-1177 /PROGRAM CODE
-/ 1200-1377 /TTY INPUT BUFFER
-/ 1400-1577 /ORIGINAL CCB BUFFER
-/ 1600-1710 /ADJUSTED CCB BUFFER
-/ 1710-1777 /PROGRAM CODE
-
-
- /PAGE ZERO
- *0
-REDERR, JMS I [CRLF /ILLEGAL INPUT ERROR
- JMS I [PRMSG
- TEXT /INPUT?/
- JMP I ERR
- *10
-LXR, 1177 /AUTO INDEX FOR INPUT STORAGE
-CXR, 0 /AUTO INDEX
-XR, 1377
-NXR, 1577
-TX, 0
- *20
-SHNDLR, 7607
-ERR, 7605
-TEMP, 0 /INPUT NUMBER STORAGE
-TMP1, 0 /INPUT NUMBER STORAGE
-DIGFLG, 0 /NUMBER PRESENT FLAG
-TEMP1, 0 /INPUT FIELD STORAGE
-TEMP2, 0 /INPUT ADDRESS STORAGE
-CMND, 0
-CHARID, 0 /
-DLID, 0 /DELIMITER STORAGE
-FIRST1, 0 /STORAGE FOR SEGMENT FIELD INPUT
-FIRST2, 0 /STORAGE FOR SEGMENT ADDRESS INPUT
-CNT, 0 /SEGMENT COUNTER
-FLD, 0 /USED IN CCB FIELD PRINTING
-TMP, 0 /TEMPORARY STORAGE-TEXT PRINTING
-TCB, 0 /PRMSG CALL I.D.
-ORG, 0 /ORIGIN STORAGE
-COUNT, -110
-BUMP, -2 /USED AS TEST IN LOAD LOOP
-RBFLG, 0
-SEGCNT, -4
-
- *200
-START, CDF 0
- CIF 10 /CALL COMMAND DECODER
- JMS I [200
- 5
- 2326 /SV. EXTENSION---ASSUMED INPUT
- CIF 0
- CDF 10
- TAD I [7620 /STARTING BLOCK OF FILE
- CDF 0
- DCA STFLE /SET UP LOADING OF CCB BLOCK
-LOAD, JMS I [7607 /LOAD CCB
- 0101
-LOC, 1400 /INTO 1400
-STFLE, 0 /STARTING BLOCK OF FILE
- JMP REDERR /
- TAD I XR /MOVE CCB UP TO 1600
- DCA I NXR
- ISZ COUNT /ALL DONE?
- JMP .-3
- JMS I (VERMSG /PRINT CCB WRITING INFO
-CONT, JMS CRLF /INITIALIZE LINE
- JMS IDCHAR /PRINT INPUT SIGNAL CHARACTER
-REATTY, KSF /WAITING FOR FLAG TO DISAPPEAR
- JMP .-1
- JMS I [CTCTST /...CTRL/C?
- TAD [203 /NO-RE-INSTATE CHARACTER
- JMS I [RBLFT /TEST FOR LINE FEED,RUBOUT
- TAD [225
- DCA TEMP /STORE CHARACTER
- KCC /CLEAR KEYBOARD,AC
- TAD TEMP
- JMS I [TYPIT
- TAD TEMP
- TAD [-215 /IS IT THE END OF THE LINE?
- SNA
- JMP I [SAVE1
- TAD [-63 /IS IT THE END OF INPUT(@)?
- SNA
- JMP I [SAVE
- CLL CLA
- TAD TEMP
- DCA I LXR /STORE AWAY CHARACTER
- TAD LXR
- TAD [-1110
- SNA CLA /TEST FOR LINE OVERFLOW
- JMP I [BARG
- JMP REATTY
-
-
-CRLF, 0 /CARRAIGE RETURN--LINE FEED ROUTINE
- CLL CLA
- TAD [215
- JMS I [TYPIT
- TAD [212
- JMS I [TYPIT
- JMP I CRLF
-IDCHAR, 0 /PRINT A #, IT SIGNALS INPUT TIME
- CLA
- DCA RBFLG /INITIALIZE RUBOUT FLAG
- DCA TEMP1 /INITIALIZE INPUT STORAGE WORD
- TAD [243
- JMS I [TYPIT
- JMP I IDCHAR
-TYCCB, JMS CRLF
- TAD [211
- JMS I [TYPIT
- TAD [1377 /ROUTINE TO TYPE OUT CCB INFO
- DCA CXR
- TAD I CXR /ADJUST SEGMENT INFO
- CLL RAL
- STL RAR
- DCA CNT /NUMBER OF SEGS
- JMS I [PRMSG
- TEXT /START=/
-RTRN1, TAD I CXR /GET CIF CDF OF STARTING FIELD
- AND [174
- DCA FLD /STORE IT
- TAD FLD
- AND [104 /ISOLATE BANK BITS
- CLL RTR /SWITCH THEM AROUND
- RAR
- SZL
- TAD [4
- CLL RTR
- TAD [260
- JMS I [TYPIT
- TAD FLD /TIME TO TYPE FIELDS
- AND [70
- CLL RTR
- RAR
- TAD [260
- JMS I [TYPIT
-TYORG, TAD I CXR
- JMS I [PWORD /PROCESS ORIGIN WORD
- TAD [211 /PRINT ATAB TO SEPARATE HEADINGS
- JMS I [TYPIT
-TYJSW, /SET TYCCB CALL FLAG
- JMS I [PRMSG /PRINT JSW HEADING
- TEXT /JSW=/
-RTRN2, TAD I CXR
- JMS I [PWORD /PRINT JSW
- JMS CRLF
- JMS CRLF
-TYSEGS,
- JMS I [PRMSG
- TEXT /CORE SEGMENTS:/
- JMS CRLF
- JMS CRLF
- JMP I [SEGSM2 /PROCESS SEGMENTS
- *400
-PRINT, JMS PRWD
- ISZ PRMSG /GET MORE TEXT
- SKP
-PRMSG, 0 /ROUTINE TO PRINT TEXT
- CLA
- TAD I PRMSG
- SZA
- JMP PRINT
- TSF
- JMP .-1
- ISZ PRMSG /TYCCB RETURN
- JMP I PRMSG
-PRWD, 0 /ROUTINE TO ISOLATE AND PRINT TEXT CHARS
- DCA TMP /SAVE PACKED SIX BIT CHARS
- TAD TMP
- BSW /POSITION FIRST CHAR FOR PRINTING
- JMS PCHAR /PRINT IT
- TAD TMP /ISOLATE SECOND CHARACTER
- JMS PCHAR /PRINT IT
- JMP I PRWD
-PCHAR, 0 /ROUTINE FOR CONVERTING TEXT CHARS TO ASCII
- AND [77 /ISOLATE SIX BITS
- SNA
- JMP I PCHAR
- TAD [240 /CONVERSION TO ASCII
- AND [77
- TAD [240
- JMS TYPIT /PRINT CHARACTER
- JMP I PCHAR
-TYPIT, 0 /ROUTINE TO PRINT CHARACTERS
- TLS
- TSF
- JMP .-1
- CLA
- JMS CTCTST /TEST FOR CONTROL/C
- CLL CLA
- JMP I TYPIT
-CTCTST, 0 /SEE IF USER WANTS OUT, CTRL/C...
- TAD [200
- KSF
- STA
- KRS
- TAD [-203 /IS IT A CTRL/C?
- SNA
-CTLC, JMP I ERR / CTRL/C MEANS GETOUT...
- JMP I CTCTST /RETURN
-RBLFT, 0
- TAD [-377 /IS IT A DELETE?
-
- SNA
- JMP I [DELETE
- TAD [377-212 /IS IT A LINE FEED?
- SNA
-
- JMP I [LFEED
- TAD [212-225
- SZA /IS IT A CTRL/U?
- JMP I RBLFT
- TAD [225
- JMS I [TYPIT
- JMP I [NEXTLN
-
-SSTADR, TAD TEMP1 /ADJUST FIELD
- CLL RTR /TRANSFORM FOR CDF--"37" TO "174"
- RTR
- BSW
- SZL
- TAD [4
- TAD [6203
- DCA I [1401 /STORE STARTING FIELD CDF CIF
- TAD TEMP2
- DCA I [1402 /STORE AWAY STARTING ADDRESS
- JMP ENDTST
-SSBITS, TAD TEMP2
- DCA I [1403 /STORE AWAY JSW
-ENDTST, TAD LXR /TEST FOR END OF INPUT LINE
- CIA
- TAD CXR
- SMA CLA
- JMP TESTE /TEST FOR CR/LF OR @
- JMP I [SDFLG
-DASH, TAD TEMP1 /ROUTINE TO PROCESS TRIPLET
- CIA CLL CML
- TAD FIRST1
- SZA CLA /ARE THE FIELDS THE SAME?
- JMP I [BARG /NO ERROR
- TAD TEMP2
- AND [7600
- TAD [200
- DCA TEMP2
- TAD TEMP2
- CIA
- TAD FIRST2
- SZL CLA /ISI UPPER LIMIT > LOWER LIMIT?
- JMP I [BARG /NO ERROR
- TAD [1403 /SET INDEX REGISTER
- DCA XR
- STA
- TAD I [1400 /INITIALIZE SEGMENT COUNTER
- DCA COUNT
- JMP I [FLDTST /PROCESS SEGMENT
-TESTE, TAD TEMP /TEST FOR WHETHER END OF LINE OR INPUT
-ENTST, TAD [-215 /WAS IT ACARRAIGE RETURN?
- SNA
- JMP I [NEXTLN /YES PREPARE FOR NEXT LINE
- TAD [215-"@ /WAS IT EXIT TIME?
- SNA
- JMP I [WRCCB /EXIT ROUTINE
- JMP REDERR /ILLEGAL INPUT
-PWORD, 0 /ROUTINE TO PROCESS ORIGIN OR JSW WORDS
- DCA ORG
- TAD ORG
- BSW /PROCESS HIGHER BIT FIRST
- JMS SECT2
- TAD ORG /NOW PROCESS LOWER BITS
- JMS SECT2
- JMP I PWORD
-SECT2, 0 /ROUTINE TO PRINT DOUBLE DIGIT
- DCA TEMP1
- TAD TEMP1
- AND [70 /ISOLATE HIGHER DIGIT
- CLL RTR
- RAR
- TAD [260
- JMS I [TYPIT
- TAD TEMP1
- AND [7 /ISOLATE LOWER DIGIT
- TAD [260
- JMS I [TYPIT
- JMP I SECT2
-
-
- *600
-GTNM, DCA DIGFLG /RESET DIGIT FLAG
- DCA TEMP1 /CLEAR FIELD STORAGE
- DCA TEMP2 /CLEAR ADDRESS STORAGE
-GETNUM, TAD I CXR /ROUTINE TO ORGANIZE LINE INPUT
- TAD [-270 /TEST FOR NUMBER
- CLL
- TAD [10
- SNL
- JMS NOTNUM /NO NUMBER
- DCA TMP1 /STORE NUMBER
- ISZ DIGFLG /SET NUMBER FLAG
- JMS ROT /ORGANIZE ARGUMENT INTO TWO WORDS
- JMS ROT /TEMP1 FOR THE FIELD
- JMS ROT /TEMP2 FOR ADDRESS
- TAD TEMP2
- TAD TMP1 /TAD IN NEW DIGIT
- DCA TEMP2
- JMP GETNUM
-SDFLG, TAD CHARID /ADD DELIMITER
- DCA DLID /STORE IT
- TAD TEMP2 /STORE PRESENT ADDRESS AWAY
- AND [7600
- DCA FIRST2
- TAD TEMP1 /STORE FIELD ALSO
- AND [37
- DCA FIRST1
- JMP GTNM
-
-ROT, 0 /ROUTINE TO ROTATE FIELD AND ADDRESS
- TAD TEMP2 /ADDRESS REGISTER
- CLL RAL /MOVE POTENTIAL FIELD BIT INTO LINK
- DCA TEMP2 /NOW READY FOR NEW INPUT - TMP1
- TAD TEMP1
- RAL /STORE FIELD BITS
- DCA TEMP1
- JMP I ROT
-NOTNUM, 0
- CLL
- TAD [260 /CONVERT TO ASCII
- DCA CHARID
- TAD DIGFLG
- SNA CLA
- JMS ACORS /IF NO DIGIT,MUST BE A COMMAND
- TAD DLID /PROCESS INPUT NUMBER
- SNA /ZERO INDICATES FIRST NUMBER
- JMP SDFLG /PREPARE FOR NEXT NUMBER
- TAD [-"- /IS IT A DASH?
- SNA
- JMP I [DASH /PROCESS TRIPLET
- TAD ["--", /IS IT A COMMA?
- SNA
- JMP SDFLG /GET SECOND NUMBER
- TAD [",-"; /IS IT A SEMI-COLON?
- SNA
- JMP I [SSTADR /PROCESS START ADDRESS
- TAD [";-"= /IS IT AN EQUALS
- SNA CLA
- JMP I [SSBITS /PROCESS JSW
- JMP SDFLG
-ACORS, 0 /TEST FOR ADD,SUB,OR CHANGE
- TAD CHARID
- TAD [-"T /IS IT A TYPE INST?
- SNA
- JMP I [TYCCB /IF SO PROCESS IT
- TAD ["T-"A /IS IT AN ADDITION?
- SNA
- JMP CEND
- TAD ["A-"S /IS IT A DELETION?
- SZA CLA
- JMP SDFLG /TEST FOR @ OR CR/LF
- IAC
-CEND, DCA CMND /STORE COMMAND FLAG
-
- JMP GTNM
-SAVE1, JMS I [CRLF /PROCESS END OF LINE
-SAVE, TAD [1177
- DCA CXR /POINT TOWARD START OF LINE
- TAD LXR /WAS THEIR ANY INPUT?
- CIA
- TAD CXR
- SNA CLA /IF LXR EQUALS CXR, THERE WAS NONE
- JMP I [TESTE /TEST FOR CR/LF OR @
- DCA I LXR /SET DELIMITER
- JMP I [GETNUM /GET INPUT
-
-ATEST, CLA
- TAD CMND /WHAT IS THE COMMAND?
- SZA CLA /IF NOT THE ADD COMMAND...
- JMP I [BARG /THEN ERROR RETURN
- TAD COUNT /IS IT TO BE ADDED ON THE END?
- SZA CLA /IF COUNT IS ZERO, YES...
- TAD [-2 /PUSH BACK INDEX TO SAVE LAST SEGMENT
- TAD XR
- DCA XR
- TAD XR /ADDITION CODE
- AND [77 /ISOLATE WHERE WE ARE IN THE CCB
- TAD [1600 /REFERENCE SAME LOCATION IN ADD BUFFER
- DCA NXR /STORE FOR MOVE
- TAD FIRST2 /STORE INPUT'S ORIGIN
- DCA I NXR
- JMS I [SEGADJ /ADJUST SECOND WORD FOR CCB
- DCA I NXR
- STA
- DCA BUMP /SET ADD INDICATOR
- JMP I [MOVE /MOVE CCB
-STEST, STA /DELETION PROCESSOR
-
- TAD CMND
- SZA CLA /IS A DELETION?
- JMP I [BARG /IF NOT ERROR
- TAD XR /SET BACK POINTER FOR DELETION
- TAD [176 /ADD 200 TO REFERENCE 1600 BUFFER
- DCA NXR
- IAC /SET DELETION PARAMETER
- DCA BUMP
- JMP I [MOVE /MOVE CCB
- PAGE
-
-
- *1000
- /ROUTINE TO PROCESS CCB SEGMENTS FOR TYPING
-SEGSM2, TAD [-4
- DCA SEGCNT
-SEGS, TAD I CXR /GET FIRST SEGMENT
- DCA TMP1
- TAD I CXR /GET SECOND WORD OF SEGMENT
- DCA FLD
- JMS TFIELD
- JMS I [SECT2
- TAD TMP1 /TYPE ORIGIN OF SEGMENT
- JMS I [PWORD /TYPE IT
- TAD [255 /TYPE HYPHEN
- JMS I [TYPIT
- JMS TFIELD /TYPE FIELD
- JMS I [SECT2
- TAD FLD /CALCULATE HIGHER LIMIT
- AND [3700 /ISOLATE NUMBER OF PAGES
- TAD [-100 /MINUS A PAGE TO BE REPLACED BY
- CLL RAL
- TAD [177 /A PAGE FULL OF LOCATIONS
- TAD TMP1
- JMS I [PWORD
- ISZ CNT /IS THAT ALL THE SEGS?
- JMP .+5 /NO ... CONTINUE
- JMS I [CRLF
- TAD [1177
- DCA LXR /RESET INPUT POINTER
- JMP I [CONT /
- ISZ SEGCNT /IS THAT THE FOURTH SEGMENT?
- JMP .+4 /NO...CONTINUE
- JMS I [CRLF
- JMS I [CRLF
- JMP I [SEGSM2
- TAD [",
- JMS I [TYPIT
- TAD [240
- JMS I [TYPIT
- JMP SEGS
-FLDTST, ISZ COUNT /IS THAT ALL THE SEGS?
- SKP CLA
- JMP I [ATEST /IF SO PROCESS COMMAND
- TAD I XR /SEARCH FOR FIELD ETC. PAGE
- DCA TMP /STORE SEGMENT ORIGIN
- TAD I XR
- DCA FLD /STORE SEGMENT'S SECOND WORD
- JMS TFIELD /ADJUST FIELD...
- CIA /RETURNS WITH FIELD IN AC
- TAD TEMP1 /IS IT THE SAME FIELD AS INPUT?
- SPA /OR IS IT LESS THAN FIELD OF INPUT?
- JMP FLDTST /NEITHER...
- SZA CLA /IF IT IS LESS THAN INPUT'S FIELD
- JMP I [ATEST /IT SHOULD BE AN ADD
- TAD FIRST2 /TEST INPUT'S ORIGIN
- CIA /IS IT LESS THAN OR EQUAL TO SEGMENT'S ORIGIN?
- TAD TMP
- SNA
- JMP I [STEST /IF EQUAL TEST FOR DELETION
- SMA CLA
- JMP I [ATEST /IF LESS TEST FOR ADDITION
- JMP FLDTST /OTHERWISE CHECK NEXT SEGMENT
-TFIELD, 0 /ROUTINE TO TRANSFORM FIELDS FOR TYPING
- TAD FLD
- AND [76
- CLL RTR
- SZL /ISOLATE BANK BIT "A"
- TAD [40
- CLL RAR
- SZL /ISOLATE BANK BIT "B"
- TAD [10
- JMP I TFIELD
-SEGADJ, 0 /ROUTINE TO ORGANIZE CCB SEGMENT SECOND WORD
- TAD FIRST2 /CALCULATE NUMBER OF PAGES
- CIA
- TAD TEMP2 /BY DIFFERENCING THE INPUT ADDRESSES
- AND [7600
- CLL RAR /AND HALVING INTO PAGES
- DCA FIRST2 /STORE FOR CCB LOAD
-
- TAD TEMP1 /ADD IN FIELD
- JMS CCBFLD /RE-ORGANIZE IT FOR CCB
- TAD FIRST2 /COMBINE FIELD AND PAGES FOR CCB SEGMENT
- JMP I SEGADJ
-CCBFLD, 0 /ROUTINE TO CHANGE FIELD INTO CCB FORM
- CLL RTR /STARTS WITH A '37' IN AC
- RTR
- SZL /TEST FOR B BANK BIT
- TAD [400
- CLL RAR
- SZL /TEST FOR A BANK BIT
- TAD [100
- CLL RTR
- RTR
- RAR /RETURN WITH A '76' IN AC
- JMP I CCBFLD
-MOVE, JMS MOVA /MOVE TIME
- TAD BUMP /IF YES, RESET SEGMENT NUMBER
- TAD I [1400
- DCA I [1400
-REMOVE, TAD [1403 /REPLACE ORIGINAL SEGS
- DCA NXR
- TAD [1603 /WITH UPDATED ONES
- DCA XR
- TAD I [1400
- DCA COUNT /SET COUNT TO THE NUMBER OF SEGS
- JMS MOVA
- JMP I [ENDTST
-MOVA, 0
- TAD COUNT /WAS THE SEGMENT ADDED ON THE END?
- SNA CLA
- JMP I MOVA /IF SO, RETURN
- TAD I XR /MAKE THE MOVE
- DCA I NXR
- TAD I XR /BE SURE TO GET BOTH WORDS
- DCA I NXR
- ISZ COUNT /IS THAT ALL THE SEGMENTS?
- JMP .-5 /IF NO, CONTINUE
- JMP I MOVA
-NEXTLN, CLL CLA /ROUTINE TO ACCEPT NEW INPUT LINE
- DCA DIGFLG /ZERO DIGIT FLAG
- DCA DLID /CLEAR DELIMITER STORAGE
- TAD [1177 /RESET INPUT POINTER
- DCA LXR
- JMP I [CONT /CONTINUE INPUT CODE
- PAGE
- *1710
- /LOCATIONS 1600-1710 ARE USED AS THE CORE CONTROL BLOCK BUFFER
-DELETE, /TTY DELETION COMMAND
- CLL CLA
- TAD LXR
- TAD [-1177 /WAS THERE INPUT?
- SNA CLA
- JMP RBSPCL /NO INPUT--PREPARE FOR SOME...
- TAD ["\ /PRINT ERASE DELIMITER
- ISZ RBFLG /TEST TO SEE IF THIS IS THE FIRST RUBOUT
- JMS I [TYPIT /IT IS
- CLA CMA /SET RUBOUT FLAG
- DCA RBFLG
- CMA
- TAD LXR
- DCA TX /PRINT ERASED CHARACTER
- TAD I TX
- JMS I [TYPIT
-BACKUP, CLA CMA
- TAD LXR
- DCA LXR
- KCC
- JMP I [REATTY
-RBSPCL, ISZ RBFLG /HAVE ANY CHARACTERS BEEN ERASED?
- JMP I [CONT /NO...PREPARE FOR INPUT
- TAD ["\
- JMS I [TYPIT
- DCA DIGFLG /RESET DIGFLG
- JMP I [CONT
-LFEED, JMS I [CRLF
- TAD [243 /TYPE I.D.(#) CHARACTER
- JMS I [TYPIT
- TAD [1177
- DCA NXR
- JMP .+3
-FEEDER, TAD I NXR
- JMS I [TYPIT
- TAD LXR
- CIA
- TAD NXR
- SZA CLA
- JMP FEEDER
- KCC
- JMP I [REATTY
-BARG, JMS I [PRMSG
- TEXT /BAD ARGS/
- JMP I [NEXTLN
-SEGNO, 0
- TAD I [1400 /ACCES NUMBER OF SEGMENTS
- CLL RAL /ADJUST EXTENDED MEM BIT
- STL RAR
- TAD [32
- SPA CLA /ARE THERE MORE THAN 32?
- JMP REDERR
- JMP I SEGNO
- PAGE
-
-
- *2000
-
-VERMSG, 0
- JMS I [PRMSG
- TEXT / ATTENTION! THE NEW CCB WILL BE WRITTEN DIRECTLY ONTO /
- JMS I [CRLF
- JMS I [PRMSG
- TEXT /THE SPECIFIED INPUT FILE.(SEE SOURCE CODE)/
- JMP I VERMSG
-
-WRCCB, JMS I [SEGNO /DID WE EXCEED SEGMENT LIMIT?
- JMS I [7607 /WRITE CCB
- 4201
- 1200 /FROM 1200
- 37 /TO BLOCK '37'
- JMP REDERR
- TAD I (STFLE
- DCA WRFLE
- JMS I [7607
- 4101
- 1400
-WRFLE, 0
- JMP REDERR
- JMP I ERR
DELETED src/os8-v3f/TECO.PA
Index: src/os8-v3f/TECO.PA
==================================================================
--- src/os8-v3f/TECO.PA
+++ /dev/null
@@ -1,4222 +0,0 @@
-/10 OS/8 TECO VERSION 5
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1974,1975,1976,1977 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
- /BROUGHT TO YOU BY: RUSS HAMM, O.M.S.I., AND RICHARD LARY (IN THAT ORDER)
-/WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S
-/PATCHES INCORPORATED BY S.R. ON 5-AUGUST-75 FOR OS/8 V3C:
-
-/1. UPDATED VERSION # TO V4
-/2. INCORPORATED PATCHES #S 1 & 2 (V302 AND V303)
-/ PREVENTS \ FROM GOING OUTSIDE OF BUFFER
-/ RESETS CFLAG TO PREVENT ARGUMENT ERROR EVERY 4096 TIMES IN LOOP
-
-/ CHANGES FOR V5: -S.R.-
-
-/3. ADDED OVERLAYS
-/4. EXPANDED ERROR MESSAGES
-/5. DOCUMENTED CORE LAYOUT
-/6. ADDED "T, "S, "F, "U, AND "R
-/7. FIXED EG BUG
-/8. MADE DEFAULT ITERATION COUNT TRULY INFINITE
-/9. ADDED N^T
-/10. ADDED :=
-/11. ADDED SOME SAFETY ERROR MESSAGES
-/ (I) ERROR IF Y HAS A NUMERIC ARGUMENT
-/ (II) ERROR IF TWO ARGUMENTS ARE SPECIFIED TO D
-/12. REMOVE ^R (OBSOLETE COMMAND)
-/13. REMOVE "A AND "B (AFTER AND BEFORE)
-/14. ADDED 13-BIT ARITHMETIC
-/15. MADE = AND \ GIVE SIGNED RESULTS (DECIMAL ONLY)
-/16. ALLOW 13-BIT NUMERIC Q-REGISTERS.
-/ THIS IS ACCOMPLISHED BY RESERVING THE HIGH ORDER BIT
-/ OF THE LENGTH WORD. STRING PORTION OF Q-REGISTER
-/ NOW RESTRICTED TO 2047 CHARACTERS. IT GETS CHECKED BY
-/ ^U AND X. BELL RINGS WITHIN 12 CHARACTERS OF FILLING
-/ UP COMMAND STRING Q-REGISTER.
-/17. STORED LINK AS LOW ORDER BIT IN NLINK IN CASE WE EVER
-/ WANT TO GO TO 24-BIT ARITHMETIC.
-/18. ERROR ON A,B,C
-/19. P DOESN'T CREATE FORM FEEDS
-/20. ALLOW @ MODIFIER WITH ER, EW, EB.
-/21. EK
-/22. ^S FREEZE
-/23. EGTEXT$
-/24. GOT RID OF F_
-/25. F IS ILLEGAL IF NOT FOLLOWED BY S OR N
-/26. W IS NOW AN ILLEGAL COMMAND (EXCEPT ON -12)
-/27. ADDED :G
-/28. Y AND _ GIVE ERRORS IF DATA IS GOING TO BE LOST
-/ (IF OUTPUT FILE IS OPEN AND BUFFER IS NOT EMPTY)
-/29. CASE FLAGGING IMPLEMENTED
-/30. "< AND "> ARE SYNONYMOUS WITH "L AND "G
-/31. ^G<SPACE> AND ^G*
-/32. SCOPE RUBOUTS
-/33. == NOW PRINTS NUMBER IN OCTAL
-/34. EUFLAG AND ETFLAG IMPLEMENTED
-/35. CASE FLAGGING WORKS
-/36. IMAGE MODE (ET BIT 11) APPLIES TO T, ^A, AND N^T
-/ IT DOES NOT APPLY TO :G
-/37. ERROR IF TRY TO DO AN EB TO A .BK FILE (IT DOES AN ER)
-/38. VT AND FF ARE NOW LINE TERMINATORS
-/39. BELL ECHOES AS ^G AS WELL AS RINGING BELL
-/40. ^K IS AN ERROR
-/41. REMOVED ^Z COMMAND
-/42. CHANGED ^V TO EO
-/43. CHANGED ^W TO W
-/44. MEMORY RESIDENT OVERLAYS IF MORE THAN 12K
-/45. LONG FORM ERROR MESSAGES ON 1EH
-/46. ET FLAG 8'S BIT AFFECTS ECHOING OF ^T
-/47. NEGATIVE OR 0 ITERATION SKIPS
-/48. CTRL/N
-/49. CTRL/C TRAP
-
-/KNOWN BUGS
-/1. LARGE T OR X AND ONLY 1 BLOCK LEFT IN OUT DEV
-/2. ^S DOESN'T KEEP SCREEN ON
-/3. FIX BATCH INTERRACTION
-/4. MAKE VT AND FF SIMULATION INDEPENDENT OF TAB
-
- DECIMAL
-VERSN= 5 / VERSION NUMBER - CHANGE WITH EVERY EDIT
- OCTAL / LAST EDIT 12-FEB-76
- IN= 6200 /INPUT BUFFER AT 06200
-OUT= 5200 /OUTPUT BUFFER AT 05200
-ZMAX= 7640 /MAX 4000[10] CHARACTERS IN TEXT BUFFER
-QMAX= 3720 /MAX 2000[10] Q-REGISTER CHARS IN 8K
-Q12MAX= 5600 /MAX 2944[10] Q-REGISTER CHARS IN 12K
-CHNSTR= 46 /38 CHARACTER STRING PASSED ON CHAIN
-
-TWO= CLA CLL CML RTL
-MTWO= CLA CLL CMA RAL
-MTHREE= CLA CLL CMA RTL
-AC3777= CLL STA RAR
-SCPBIT= 7726
- /THINGS WE WOULD LIKE TO ADD:
-
-/:ER
-/:EB
-/NV
-/@^A
-/FR
-/-S
-/::S
-/^EQ
-/M,NS
-/[Q
-/]Q
-/NON-EXACT SEARCH MODE
-/*N
-/ERFILESPEC/S FOR SUPERTECO
-/^N
-/CHECK FOR $ ON NI$
-/CHECK INTO SEARCHES IN ITERATIONS
-/ERR MSG ON EA, EP
-/NV=(1-N)TNT
-/^C TRAP
-/:X
-
-/THINGS FOR -11:
-/^R
-/3EH
-/M,ND
-/ET BIT 15 SHOULD BE LOWER
-/ECHO OF NULL
- /*****************************************
-/ TECO ERROR MESSAGES:
-/*****************************************
-
-/ TECO ERROR MESSAGES CONSIST OF A QUESTION MARK AND THREE LETTERS
-/ TYPING "?" IMMEDIATELY AFTER AN ERROR MESSAGE PRINTOUT PRINTS
-/ THE CURRENT COMMAND LINE UP TO THE ERROR CHARACTER.
-
-/1 ?ILL ILLEGAL COMMAND
-/2 ?UTC INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF COMMAND STRING)
-/3 ?IQN NON-ALPHANUMERIC Q-REGISTER NAME
-/4 ?PDO PUSHDOWN OVERFLOW (MACROS & ITERATIONS NESTED TOO DEEPLY)
-/5 ?MEM TEXT BUFFER OVERFLOW
-/6 ?STL SEARCH STRING TOO LARGE ( >31 CHARS)
-/7 ?ARG NUMBER MISSING BEFORE COMMA
-/ OR TWO ARGUMENTS SPECIFIED TO D
-/ OR 3 NUMERIC ARGUMENTS
-/8 ?IFN ILLEGAL FILE NAME IN "ER","EW" OR "EB" COMMAND
-/9 ?SNI SEMICOLON ON COMMAND LEVEL
-/10 ?BNI ITERATION CLOSE (>) WITHOUT MATCHING OPEN (<)
-/11 ?POP ATTEMPT TO MOVE POINTER OUTSIDE OF TEXT BUFFER
-/12 ?QMO Q-REGISTER STORAGE OVERFLOW
-/13 ?UTM INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF MACRO)
-/14 ?OUT OUTPUT FILE TOO BIG OR OUTPUT PARITY ERROR
-/15 ?INP PARITY ERROR ON INPUT FILE
-/16 ?FER FILE ERROR: CAN MEAN EITHER
-/ A) INPUT FILE NOT FOUND ON "ER" COMMAND
-/ B) CANNOT ENTER OUTPUT FILE ON "EW" OR "EB" COMMAND
-/ C) DEVICE SPECIFIED FOR FILE DOES NOT EXIST
-/ D) "EB" COMMAND GIVEN ON NON-FILE-STRUCTURED DEVICE
-/17 ?FUL OUTPUT COMMAND WOULD HAVE OVERFLOWED OUTPUT FILE
-/ [PANIC MODE]
-/18 ?NAY NUMERIC ARGUMENT SPECIFIED WITH Y COMMAND
-/19 ?IEC E FOLLOWED BY AN ILLEGAL CHARACTER
-/20 ?IQC " FOLLOWED BY AN ILLEGAL CHARACTER
-/21 ?NAE NO NUMERIC ARGUMENT TO THE LEFT OF AN =
-/22 ?NAU NO NUMERIC ARGUMENT TO THE LEFT OF A U
-/23 ?NAQ NO NUMERIC ARGUMENT TO THE LEFT OF A "
-/24 ?SRH FAILING SEARCH AT COMMAND LEVEL
-/25 ?NAP NEGATIVE OR ZERO ARGUMENT TO P
-/26 ?NAC NEGATIVE ARGUMENT TO COMMA
-/27 ?NYI CASE SUPPORT NOT IMPL (USE W FOR WATCH)
-/28 ?
-/29 ?NAS NEGATIVE OR ZERO ARGUMENT WITH A SEARCH
-/30 ?WLO WRITE LOCKED SYSTEM DEVICE
-/31 ?IFC F FOLLOWED BY AN ILLEGAL CHARACTER
-/32 ?YCA Y (OR _) COMMAND ABORTED BECAUSE DATA WOULD BE LOST
-/33 ?CCL CCL NOT FOUND OR EG ARGUMENT TOO LONG
-/34 ?XAB EXECUTION ABORTED BY ^C
-/35 ?NYI CASE SUPPORT NOT IMPL (USE EO FOR VERSION)
-/36 ?NFO ATTEMPT TO OUTPUT WITHOUT OPENING AN OUTPUT FILE
- / CORE LAYOUT AND OVERLAY STRUCTURE
-
-/ BUFFER STRUCTURE:
-
-/BUFFER 8K VERSION 12K VERSION
-
-/INPUT BUFFER 06200-07200 25600-27600
-/OUTPUT BUFFER 05200-06200 05200-07200
-/Q-REG STORAGE OVER TEXT BFR 20000-25600
-
-/ HANDLER LOCATIONS:
-
-/HANDLER PDP-8 VERSION PDP-12 VERSION
-
-/INPUT HANDLER 7200-7600 7200-7400
-/OUTPUT HANDLER 4000-4400 7400-7600
-/SIZE OF HNDLR 2-PAGES 1-PAGE
-/DISPLAY CODE NONE 4000-4400
-
-/ OVERLAY STRUCTURE
-
-/ALL OVERLAYS ARE TWO PAGES LONG AND RESIDE IN CORE
-/AT LOCATIONS 3200-3600 WHEN RUNNING. THE I-OVERLAY
-/INITIALLY RESIDES IN THESE LOCATIONS.
-
-/OVERLAY BLOCK INITIAL LOCATION CONTENTS
-
-/ I-OVERLAY 40 3200-3600 ER,EW,EB
-/ Q-OVERLAY 41 5600-6200 ", O, SKPSET
-/ E-OVERLAY 42 6200-6600 ERROR MESSAGE PROCESSOR
-/ X-OVERLAY 43 6600-7200 EX,EC,EG,EK,EF (EA,EI,EN,EP)
-/ F-OVERLAY 44 7200-7600 ED,EH,EO,ES,ET,EU (EV)
-
- IOVRLC=40
- QOVRLC=41
- EOVRLC=42
- XOVRLC=43
- FOVRLC=44
-
- IOVRLY=3200
- QOVRLY=3201
- EOVRLY=3202
- XOVRLY=3203
- FOVRLY=3204
-
-/EACH OVERLAY IS ASSIGNED A LOCATION AT THE BEGINNING OF PAGE 3200.
-/IF THIS LOCATION IS 0 (AS IT ALWAYS IS), THEN THAT OVERLAY IS NOT
-/IN CORE. IF IT IS NOT 0, THEN THIS LOCATION CONTAINS THE
-/BLOCK NUMBER TO READ IN THAT OVERLAY.
-/THUS EACH OVERLAY HAS POINTERS TO ALL THE OTHER OVERLAYS.
- MEMLOC=2000
-
-/IN 16K MACHINES, FIELD 3 IS USED TO HOLD OVERLAYS
-
-/NAME BLOCK MEMORY
-
-/I 40 2000
-/Q 41 2400
-/E 42 3000
-/X 43 3400
-/F 44 4000
-
-
-/INITIAL MEMORY LAYOUT
-
-/0000-3177 TECO
-/3200-3577 OVERLAY AREA (INITIALLY I-OVERLAY)
-/3600-3777 TECO
-/4000-4377 PDP-12 DISPLAY ROUTINE
-/4400-5177 TECO
-/5200-5577 INITIALIZATION CODE
-/5600-6177 Q-OVERLAY CODE
-/6200-6577 E-OVERLAY CODE
-/6600-7177 X-OVERLAY CODE
-/7200-7577 F-OVERLAY CODE
-
-/FIELD 1:
-
-/4400-7377 EXTENDED ERROR MESSAGES
-/ MOVES TO FIELD 3
- /** TECO KLUDGES ** /7/27/73
-/ONE OF THE REASONS WHY TECO GETS SO MANY OPERATIONS
-/INTO SUCH A SMALL AMOUNT OF CORE IS THAT IT
-/IS FULL OF *K*L*U*D*G*E*S*. THESE SHOULD BE KEPT IN MIND WHEN
-/MODIFYING THE PROGRAM. SOME OF THEM ARE:
-
-/ THE "SORT" ROUTINE COMPARE LIST MUST END WITH A NEGATIVE NUMBER.
-/ USUALLY A FORTITUOUS JMS OR OPR INSTRUCTION IS USED
-
-/ THE "SORT" JUMP LIST ENTRIES ARE TREATED AS JUMP ADDRESSES
-/ IF THEY ARE POSITIVE AND SUBSTITUTE VALUES IF THEY ARE
-/ NEGATIVE - THEREFORE ALL LOCS JUMPED TO MUST BE BELOW 4000
-/ ANOTHER CONSEQUENCE IS THAT "QUOTST" CANNOT BE CALLED FROM
-/ ABOVE 4000
-
-/ THERE ARE OTHER LOCALIZED KLUDGES - THEY CAN GENERALLY
-/ BE IDENTIFIED BY THE APPEARANCE OF A DOUBLE-ASTERISK IN THE
-/ COMMENTS FIELD ALONG WITH A TERSE DESCRIPTIVE COMMENT
-
-
-
-/ OS/8 EQUIVALENCES:
-
-JSBITS= 7746 /JOB STATUS BITS - IN FIELD 0
-OSHNDT= 7647 /OS/8 DEVICE HANDLER TABLE - IN FIELD 1
-OSDCBT= 7760 /OS/8 DEVICE CONTROL TABLE - IN FIELD 1
-CCLADR= 400 /CCL OVERLAY LOAD ADDRESS
-CCLOVL= 67 /BLOCK OF CCL OVERLAY
-CCLOST= 602 /CCL OVERLAY SECONDARY START ADDRESS
- *0
-NAME, ZBLOCK 4 /NAME BUILD BUFFER - MUST BE AT LOCATION 0
- /LOCS 4,5&6 ARE RESERVED SO WE CAN USE OS/8 ODT
-
- *10 /CONSTANTS & NON-INDIRECT TEMPS STORED IN AUTO-XRS!
-QUOTE, 33 /QUOTE CHAR - SINGLE WORD SORT LIST
-ERR01,
-SERR, ERR /END OF LIST
-INRSIZ, 2 /4 IF 12K MACHINE
-NUMLNS, 3 /NUMBER OF LINES (+ AND -) TO DISPLAY ON VR12 SCOPE
-DX, 7577 /DISPLAY XR
-SXR, QPUT12-1/XR USED BY SEARCH PROCESSOR
-INXR, ASR33-1 /XR USED TO UNPACK INPUT BUFFER
-XR, ASR35-1 /WORK XR
-
-NMT, 0 /USED AS NUMBER TEMP AND SEARCH FAIL FLAG
-CFLG, 0 /COMMA FLAG
-CLNF, 0 /COLON FLAG
-TFLG, 0 /TRACE FLAG
-NFLG, 0 /NUMBER FLAG
-QFLG, 0 /QUOTED STRING FLAG
-M, 0 /NUMBER ARGS
-N, 0
-NLINK, 0 /LINK AFTER ARITH OPERATIONS - TESTED BY "A AND "B
-CHAR, 0 /CHARACTER BUFFER
-ITRST, 0 /ITERATION FLAG
-ITRCNT, 0 /ITERATION COUNT
-MPDL, 0 /MACRO FLAG
-SCHAR, 0 /LAST CHAR SORTED
-FFFLAG, 0 /FORM FEED FLAG - 7777 IF FORM FEED SEEN ON THIS READ
-REND, 0 /INPUT END-OF-FILE FLAG
-SCANP, 0 /COMMAND LINE EXECUTION POINTER
-OSCANP, 0 /BACKUP FOR SCANP
-PDLP, PDLBEG /PUSH-DOWN-LIST POINTER
-QCMND, 0 /COMM LINE OR MACRO POINTER
-P, 0 /CURRENT PNTR TO TEXT BUFFER
-ZZ, 0 /END OF TEXT BUFFER POINTER
-Q, 0 /EXTRA BUFFER POINTERS
- IFNZRO .-47 <_ERROR_>
-R, 0
-QP, 0 /Q REGISTER POINTER
-QZ, CHNSTR /END OF Q-REG POINTER
-Z7,
-CTLBEL, 7
-CACR, 15 /CR
-CAHT, 11 /HT
-CAAM, 33 /ALT MODE
-CAFF, 14 /FF: END OF PAGE
- 13 /VT
-CALF, 12 /LF
-ERR07,
-NERR, ERR /END OF LIST
-RADIX, DRAD /RADIX TABLE POINTER - DRAD OR ORAD
- MQ, 0
-DVT1, 0
-ODEV, 0 /OUTPUT DEVICE NUMBER
-OUTHND, 0
-INHND, 0
-EBFLG, 0 /EDIT BACKUP FLAG
-QNMBR, 0 /LAST Q-REG REFERENCED
-QBASE, 0 /BASE OF CURRENT COMMAND LINE
-QLENGT, 0 /LENGTH OF CURRENT COMMAND LINE
-QPTR, 0 /POINTER TO Q-REGISTER CONTROL BLOCK
-ICRCNT, 0 /INPUT DOUBLEWORD COUNTER
-OCRCNT, 0 /OUTPUT "
-OPTR2, 0 /OUTPUT BUFFER POINTER
-INRCNT, 0 /NUMBER OF INPUT RECORDS LEFT
-OCMDLN, 0 /LENGTH OF OLD COMMAND LINE
-CDT, 0
-KTYPE, TYPE /*ET SET TO PUTT IF NO CONVERSION
-TEMPT, 0 /TEMP. GET RID OF WHEN FIND ROOM ON PAGE
-MEMSIZ, 0 /HIGHEST MEMORY FIELD IN BITS 9-11
-LASTC, 0 /LAST CHARACTER GOTTEN OUT OF COMMAND LINE
-
-/NFLG: 0'ED BY COMMANDS WHICH EAT ARGUMENTS OR DON'T RETURN
-/ VALUES; SUCH AS C,R,J,L,^A,X,$,',>,'U,G,O AND
-/ NON-COLON MODIFIED SEARCHES
-/ SET TO -1 TO INDICATE THATWWE'VE SEEN A NUMBER
- /TECO PSEUDO-OPERATIONS
-
-PUSH= JMS I .; PUSHXX
-POP= JMS I .; POPXX /** MUST BE ONE MORE THAN "PUSH"
-PUSHJ= JMS I .; PUSHJY
-POPJ= JMP I .; POPJXX
-PUSHL= JMS I .; PUSHLX
-POPL= PUSHL /** POPL CALLED WITH POSITIVE AC
-
-ERR= JMS I .;ERROR,ERRXX
-SORT= JMS I .; SORTB
-RESORT= JMP I .; SORTA2
-SCAN= JMS I .; SGET
-LISTEN= JMS I .; TYI
-TYPE= JMS I .; TYPCTV
-OUTPUT= JMS I .;OUTR, ERRXX /** MUST BE ONE MORE THAN "TYPE"
- /PROBABLY NOT ANY MORE (19-JUN-77)
-CRLF= JMS I .; TYCRLF
-GETQ= JMS I .; GETQX
-SKPSET= JMS I .; SETSKP
-NCHK= ISZ NFLG /USED TO BE A SUBROUTINE CALL
-CTCCHK= JMS I .; CHKCTC
-BZCHK= JMS I .; CHKBZ
-QCHK= JMS I .; CHKQF
-QSKP= JMS I .; QOVER
-QREF= JMS I .; QREFER
- QSUM= JMS I .; QSUMR
-QPUT= JMS I .; QPUTS
-QUOTST= JMS I .; QTST
-SETCMD= JMS I .; CMDSET
-GETN= JMS I .; NGET
-ADJQ= JMS I .; QADJ
-MQLDVI= JMS I .; DVIMQL
-UPPERC= JMS I .; CUPPER
-SCANUP= JMS I .; SCUPPR
-TSTSEP= JMS I .; SCHSRT
-DISPLY= JMS I .; DSPLAY
-NOTRCE= JMS I .; SAVTRA
-ENTRCE= JMS I .; RESTRA
-OVRLAY= JMS I .; OVERLY
-GETNUM= JMS I .; NUMGET /GET 13 BIT NUMBER INTO L,AC
-PUTT= JMS I .; TPUT
- PAGE
- /ENTER HERE TO USE AN ASR33 AS THE TELETYPE
-
-TECO, ISZ I SPUT /IF CALLED BY "R" OR "RUN" - CHANGED TO TLS
-TECO1, JMP I COMPAR /IF CALLED VIA "CHAIN" - CHANGED TO "JMP T0A"
-TBEL, JMS COMPAR /HERE ON ^G - 2 ^G'S KILL ENTIRE COMMAND
-
-T0, CRLF
-T0A, TAD (PDLBEG
- DCA PDLP /INITIALIZE PUSHDOWN LIST
-T1, TAD PDLP
- TAD (-PDLBEG
- SZA CLA
-ERR02, ERR /ERROR - PUSHDOWN LIST DID NOT BALANCE
- TAD (45
- QREF /SET UP POINTERS TO COMMAND LINE
- TAD I [QPNTR
- DCA OCMDLN /SAVE OLD COMMAND LINE LENGTH
- /** SAVE ONLY IF < 20?
- ADJQ /REDUCE COMMAND LINE LENGTH TO 0
- CLL
- PUSHJ
- NRET /CLEAR NUMBER AND LAST OPERATOR
- DCA CFLG
- DCA MPDL /DELETE MACRO FLAG
- DCA ITRST /ALSO ITERATION FLAG,
- DCA CLNF /AND COLON FLAG
- PUSHJ /KILL QUOTE FLAG
- ZROSPN /KILL QUOTE AND NUMBER FLAGS AND SCAN POINTER
- KCC /KILL ^O IF IN KEYBOARD BUFFER
- DCA I (CHOOPS /KILL FATAL ERROR RETURN
- TAD [52
- SKP
-ROCMND, JMS I (BACKUP /BACK UP AND GET LAST CHAR
- TYPE
-T2M1, DCA CHAR /KILL CHAR TO PREVENT SPURIOUS DOUBLE CHARACTERS
-T2, LISTEN /BUILD COMMAND LINE
- SORT
- COMLST
- COMTAB-COMLST
-T2A, DCA CHAR
- JMS SPUT /PUT INTO C.L. BUFFER
- JMP T2 /GO GET ANOTHER
- TCTLU, TAD SCHAR
- TYPE /PRINT "^U"
-TCTLUP, JMS I (BACKUP
- TAD [-12 /CHECK FOR LF
- SZA CLA
- JMP TCTLUP /LOOP UNTIL LF
- IAC
- JMP I (TSP9
-
-TCRLF, TAD CACR /CR IN COMM LINE
- DCA CHAR
- JMS SPUT /PUT INTO COMM LINE
- TAD CALF /THEN PUT IN A LF
- JMP T2A /AND GET SOME MORE
- /COMMAND EXECUTION LOOP
-
-TALTM, JMS COMPAR /2ND ALTM STARTS EXECUTION
- CRLF /START COMM EXECUTION
-CHTECO, TAD (45 /NUMBER OF INPUT COMMAND Q-REGISTER
- SETCMD /SET UP THE INPUT LINE AS THE CURRENT COMMAND LINE
-T6, SCANUP
-T6A, DCA CHAR /SAVE COMMAND CHAR
- TAD CHAR
- TAD (CDSP /ADD BASE OF DISPATCH TABLE
- DCA T7 /LOOK UP ENTRY IN
- TAD I T7 /COMMAND DISPATCH TABLE
- DCA T7 /CALL RECURSIVELY
- CLL
- PUSHJ
-T7, 0 /CALL TO ROUTINE
- CTCCHK /CHECK FOR ^C - ** AC MAY NOT BE 0 HERE **
- CLA /CTCCHK LEAVES AC NON-ZERO
- TAD NFLG
- SPA CLA
- JMP T6
- DCA N /IF WE ARE NOT ENTERING A NUMBER
- DCA NLINK /SET 13-BIT N TO 0
- JMP T6 /KEEP INTERPRETING
-TQMK, TAD I ERROR
- SNA CLA /ERROR ROUTINE ENTRY POINT NON-ZERO?
- RESORT /NO
- STA /AN ERROR PRINTOUT
- DCA QLENGT /SET QLENGT BIG SO WE CAN ACCESS ENTIRE LINE
- NOTRCE /TURN TRACE OFF
- SCAN
- TYPE /PRINT OUT THE LINE WHICH CAUSED THE ERROR
- ISZ I ERROR /UP TO THE ERROR CHAR ITSELF
- JMP .-3
- JMP T0 /RE-INITIALIZE
-
-CHUA, POP /^ COMMAND - POP OFF RETURN ADDRESS
- SCANUP /GET THE NEXT CHARACTER IN UPPER CASE
- AND [77 /MAKE IT A CONTROL CHARACTER
- JMP T6A /USE IT INSTEAD OF THE ^
- COMPAR, TCINIT /LOOK FOR DOUBLED COMM LINE CHARS
- TAD SCHAR /MOST RECENT
- CIA
- TAD CHAR /PREVIOUS
- SZA CLA
- RESORT /NOT THE SAME
- JMS SPUT /PUT THE CHAR INTO THE COMMAND LINE AND ECHO IT
- JMP I COMPAR /SAME-SPECIAL HANDLING
-
-SPUT, JTECO /PUT CHAR INTO COMM LINE
- TAD QZ
- DCA QP
- TAD CHAR
- QPUT /STORE CHARACTER AWAY
- TAD I [QPNTR
- IAC
- ADJQ /ADJUST COMMAND LINE REGISTER LENGTH
- DCA I ERROR /CLEAR "ERROR JUST OCCURRED" FLAG
- TAD CHAR
- TYPE /TYPE THE INSERTED CHARACTER
- TAD I [QPNTR
- TAD CALF /12
- SPA CLA
- JMP EMERG /TYPE BELL IF WITHIN 12 CHARACTERS OF 2048
- CLL
- TAD QZ
- TAD QLIMIT
- SNL CLA /TYPE A BELL IF THE LINE IS
- JMP I SPUT / WITHIN 12 CHARS OF OVERFLOW
-EMERG, TAD Z7
- TYPE
- JMP I SPUT
-QLIMIT, 12-QMAX
- PAGE
- /Q REGISTER PACK AND UNPACK
- /THE Q-REGISTERS ARE STORED IN THE UPPER 4 BITS OF THE WORDS
- /WHICH HAVE THE TEXT BUFFER CHARACTERS IN THEIR LOWER 8 BITS.
- /THEREFORE EACH Q-REGISTER CHARACTER TAKES 2 WORDS.
-
-QPUTS, 0 /STORE THROUGH POINTER "QP" AND BUMP POINTER
- CLL RTL
- RTL
- DCA GETQX /SAVE CHARACTER
- TAD QP
- CLL RAL
- DCA CHKCTC /COMPUTE CORE POINTER = 2*QP
- CDF 10
- TAD GETQX
- JMS ST4BTS /STORE HIGH ORDER 4 BITS
- ISZ CHKCTC
- TAD GETQX
- CLL RTL
- RTL
- JMS ST4BTS /STORE LOW ORDER 4 BITS
- CDF 0
- ISZ QP /BUMP POINTER
- JMP I QPUTS
-
-GETQX, 0
- CLL RAL
- DCA CHKCTC /COMPUTE CORE POINTER = 2*AC
- CDF 10
- TAD I CHKCTC
- AND [7400 /FETCH HIGH ORDER
- ISZ CHKCTC
- DCA QPUTS
- TAD I CHKCTC
- AND [7400 /FETCH LOW ORDER
- CLL RTR
- RTR
- TAD QPUTS /COMBINE TO FORM CHARACTER
- RTR
- RTR
- CDF 0
- JMP I GETQX
-
-ST4BTS, 0
- AND [7400
- DCA POPXX
- TAD I CHKCTC
- AND [377
- TAD POPXX
- DCA I CHKCTC /STORE HIGH ORDER
- JMP I ST4BTS
- CHKCTC, 0 /SUBROUTINE TO CHECK FOR ^C IN KEYBOARD
- CLA OSR /** AC MAY NOT BE 0 ON ENTRY
- DCA QPUTS /GET LOCATION FROM SWITCH REGISTER
- TAD I QPUTS
- 7421 /DISPLAY INDICATED LOCATION IN MQ
-C7600, 7600 /JUST IN CASE THERE IS NO MQ
- KSF
- JMP I CHKCTC /NO CHAR IN KEYBOARD BUFFER - EXIT
- KRS
- AND [177 /KILL PARITY BIT
- TAD [-20 /^P OUGHT TO GO AWAY
- SZA
- TAD CACR
- SZA /^C?
- JMP I CHKCTC /NO - RESUME WITH NON-ZERO AC
-ERR34, ERR /^C, EXECUTION ABORTED
-
-CTLC, TSF
- JMP CTLC /WAIT FOR TELETYPE TO DIE DOWN
- JMP I C7600 /RETURN TO OS/8
-
-
-POPJXX, DCA GETQX /POPJ ROUTINE
- POP
-POPJXY, DCA POPXX
- TAD GETQX
- JMP I POPXX
- /PUSH DOWN LIST ROUTINES
-
-POPXX, 0 /POP ROUTINE
- CLA CMA
- TAD PDLP
- DCA PDLP
- TAD I PDLP
- JMP I POPXX
-
-PUSHXX, 0 /PUSH ROUTINE (DOESN'T AFFECT LINK)
- DCA I PDLP
- ISZ PDLP /BUMP PUSHDOWN POINTER
- TAD PDLP /CHECK FOR EXACTLY FULL - THIS ALLOWS THE
- TAD (-PDLEND
- SNA CLA /** ERROR ROUTINE TO DO A PUSHJ
-ERR04, ERR /FULL - REPORT IT
- JMP I PUSHXX
-
-PUSHJY, 0 /PUSHJ ROUTINE (DOESN'T AFFECT LINK)
- DCA GETQX
- IAC /** LINK SHOULD BE PRESERVED ON EXIT
- TAD PUSHJY
- PUSH
- TAD I PUSHJY
- JMP POPJXY
-
-PUSHLX, 0 /PUSH AND CLEAR A LIST
- CLL
- SMA /PUSH LIST IF AC<0, POP IT IF >=0
- CMA STL
- DCA PUSHJY /SET COUNTER
- RAL /** DEPENDS ON FACT THAT POP=PUSH+1 **
- TAD PUSHYY
- DCA PUSHYX /STORE EITHER A "PUSH" OR A "POP"
- POP /SAVE RETURN POINTER
- DCA CHKCTC
-PUSHLP, TAD I PUSHLX
- DCA GETQX
- TAD I GETQX
-PUSHYX, PUSH /PUSH OR POP
- DCA I GETQX /IF PUSHYX=PUSH, THIS ZEROES THE PUSHED LOCATION
- ISZ PUSHLX
- ISZ PUSHJY
- JMP PUSHLP
- TAD CHKCTC /RESTORE RETURN POINTER
-PUSHYY, PUSH
- JMP I PUSHLX
- TPUT, 0 /TELETYPE OUTPUT
- DCA TEMPT
-TPUTX, CTCCHK /CHECK FOR ^C OR ^P
- TAD (3-17 /INHIBIT PRINTING AS LONG AS THERE
- SNA /IS A ^O IN THE KEYBOARD BUFFER.
- JMP I TPUT
- TAD (17-23 /CHECK FOR ^S
- SNA CLA
- JMP TPUTX
- TSF /WAIT FOR TELETYPE FLAG
-TSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE
- TAD TEMPT
- TLS
- CLA
- JMP I TPUT
- PAGE
- /POINTER MOVING COMMANDS - C,R,J,L
-
-CHRJ, DCA NFLG /COMMAND J
- GETNUM /CAUSE NEG ARGUMENT TO GIVE A POP
- JMP CLOQ
-
-CHRR, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
-CHR1, CML CIA /NEGATE 13-BIT NUMBER
- SKP
-CHRC, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
- TAD P /OFFSET RELATIVE TO .
-/
-/ *** LINK NOT ALWAYS SET RIGHT
-/
-CLOQ, BZCHK /SEE IF IN RANGE B,Z
- DCA P /IN RANGE
-DNN3, CDF 0
- POPJ
-
-CHRL, GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
-CHRL1, CDF 10
- SZL SNA
- JMP LNEG
- CIA
- DCA CDT
-CHRLP, TAD P
- CIA
- TAD ZZ
- SNA CLA /IF WE ARE AT THE END OF THE BUFFER,
- JMP DNN3 /RETURN
- JMS I (CHLCMP /COMPARE CHARACTER AGAINST LINE FEED
- ISZ P
- JMP CHRLP /KEEP GOING UNTIL WE GET THERE OR OVERFLOW BUFFER
-LNEG, TAD (-1
- DCA CDT
-CHRLM, CLA CMA CLL
- TAD P
- DCA P /MOVE POINTER BACKWARD 1
- SNL
- JMP I (CHRLI /OOPS - PAST THE BEGINNING OF THE BUFFER - RETURN
- JMS I (CHLCMP /COMPARE CHARACTER AGAINST LINE FEED
- JMP CHRLM /NOT SATISFIED YET - KEEP LOOPING
-
-NUMGET, 0 /PUT 13-BIT NUMBER IN L,AC
- TAD NLINK
- CLL RAR
- TAD N
- JMP I NUMGET
- /D COMMAND AND PART OF ADJUST ROUTINE
-
-CHRD, ISZ CFLG /WAS THERE A COMMA?
- SKP /NO
- JMP NERR /YES, 2 ARGS TO D
- GETN /GET LAST NUMBER, DEFAULT=(+ OR -)1
- SNL /SIGN BIT OF 13-BIT NUMBER IS IN LINK
- JMP PLUSND /+ND
- CLL CIA
- DCA CDT /-ND
- TAD CDT
- PUSHJ /DO (-)NC(+)ND
- CHR1
- TAD CDT
- JMP PLUSND
-
-ADJ, SNA /ADJUST BUFFER + OR - N CHARS
- /TEST FOR NOTHING
- POPJ /GO AWAY
- STL /MOVE UP N CHARACTERS
- TAD ZZ /ADD TO MAX CHARACTER
- DCA R /NEW HIGHEST
- TAD R /SEE IF TOO HIGH
- TAD (-ZMAX
- SNL SZA CLA /TWO PLACES FOR OVERFLOW THERE
-ERR05, ERR
- TAD ZZ
- DCA Q
- TAD R
- DCA ZZ
- CDF 10
-UPNL, TAD Q
- CIA
- TAD P
- SNA CLA /FINISHED?
- JMP DNN3 /YES
- CMA
- TAD Q
- DCA Q
- CMA
- TAD R
- DCA R
- TAD I Q /GET A CHAR
-L12K1, AND [377 /JMP .+5 IF 12K
- DCA CHLTMP
- TAD I R /BE CAREFUL NOT TO
- AND [7400 /DESTROY THE HIGH-
- TAD CHLTMP /ORDER 4 BITS
-J12K1= JMP .
- DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD
- JMP UPNL
- /K COMMAND AND MORE OF ADJUST ROUTINE
-
-CHRK, JMS I (NLINES /CONVERT LINES TO CHARS
- DCA CDT
- TAD M /SET POINTER
- DCA P /LOWER ARG
- TAD CDT
-PLUSND, SNA
- POPJ /IGNORE 0D
-ADJ2, CLL
- TAD P /MOVE DOWN N CHARACTERS
- SZL
- CLA CMA /DETECT GROSS OVERFLOWS
- /** CHECK
- BZCHK
- DCA Q /N IN AC
- TAD P
- DCA R
- CDF 10
-DNN1, TAD ZZ
- CIA
- TAD Q
- SNA CLA /FINISHED?
- JMP DNN2
- TAD I Q /GET A CHAR
-L12K2, AND [377 /JMP .+5 IF 12K
- DCA CHLTMP
- TAD I R /BE CAREFUL NOT TO
- AND [7400 /DESTROY THE HIGH-
- TAD CHLTMP /ORDER 4 BITS
-J12K2= JMP .
- DCA I R /AND PUT IT IN THE LOW PART OF THE TARGET WORD
- ISZ Q
- ISZ R
- JMP DNN1
-DNN2, TAD R
- DCA ZZ
- JMP DNN3
-
-CHLTMP, 0
-
-/GO TO ADJ TO MOVE UP TEXT
-/GOTO ADJ2 TO MOVE DOWN TEXT
-/IN EITHER CASE, AC CONTAINS NUMBER OF CHARS TO MOVE (0-4095)
-
-ERR27, ERR /^W
-ERR35, ERR /^V
- PAGE
- /SEARCH SUBROUTINE - CALLED BY N, S, AND _ COMMANDS
-
-SEARCH, 0
- DCA REPFLG /AC MAY BE NON-0 TO ALLOW A REPLACE
- GETN
- SZL SNA
-ERR29, ERR /NEG OR 0 ARG TO SEARCH
- CIA
- DCA CSN /GET NUMBER OF OCCURRANCES TO SEARCH FOR
- QCHK /GET REPLACEMENT FOR ALTMODE, IF ANY
- TAD (STABLE-1
- DCA SXR /INITIALIZE XR
- TAD [-40
- DCA CSP
-SGTLP, QUOTST /GET A CHARACTER FROM THE SEARCH STRING
- JMP SCHQUO /OOPS- NO MORE
- SORT /SEE IF ITS SPECIAL
- SCHLST
- SCHTAB-SCHLST
-SSTCHR, DCA I SXR /STORE THE CHAR IN THE SEARCH BUFFER
- ISZ CSP
- JMP SGTLP /LOOP
-ERR06, ERR /OOPS - SEARCH BUFFER FULL!
-
-SCHQUO, TAD CSP
- TAD [40 /A NULL SEARCH STRING MEANS USE THE
- SZA CLA /PREV CONTENTS OF THE SEARCH BUFFER, ELSE
- DCA I SXR /STORE TERMINATING 0 AND BEGIN THE SEARCH
-CSST, TAD P
- DCA CSP
- JMP CSF1
-SCHINV, TAD CSNCL /^N, INVERT SKIP SENSE
- DCA CSWT
-
-CSL, TAD I SXR /GET A CHAR FROM THE SEARCH BUFFER
- SPA SNA
- JMP SCCOMD /NEGATIVE CHARS AND 0 ARE SPECIAL
- CIA
- CDF 10
- TAD I P
- AND [377
-CSWT1, CDF 0
-CSWT, SZA CLA
- JMP CSF /FAIL TO MATCH ON THIS CHARACTER
- ISZ P
-CSG, TAD CSZCL
- DCA CSWT /RESTORE SEARCH TEST
- TAD ZZ
- CMA
- TAD P
-CSZCL, SZA CLA /CHECK FOR END OF BUFFER
- JMP CSL /NO
- DCA P
-CSZ, DCA NMT
- JMP I SEARCH
- /SEARCH SUBROUTINE - CONTINUED
-
-SCCOMD, DCA .+1 /SPECIAL CHARACTERS ARE JUMPS OR 0
- HLT /0 FALLS THROUGH INTO TERMINATION CODE
- ISZ CSN /GET NTH OCCURRENCE
- JMP CSF /MORE TO GO
- CMA
- JMP CSZ /GOT IT
-CSF, ISZ CSP /INDEX P
-CSF1, TAD (STABLE-1
- DCA SXR /INITIALIZE AUTO - INDEX
- TAD CSP
- DCA P
- JMP CSG
-
-/SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X
-
-SCHTAB, JMP SCHINV /^N: ANYTHING BUT
- SCHCTQ /^Q: LITERALLY
- JMP SCHSEP /^S: ANY SEPARATOR
- JMP CSWT1 /^X: ANYTHING
-
-SCHCTQ, SCAN /GET THE NEXT CHARACTER
- JMP SSTCHR /AND STORE IT IN PLACE OF THE ^Q
-
-SCHSEP, CDF 10 /^S, LOOK FOR SEPARATOR
- TAD I P
- AND [377
- TSTSEP /SHARED SORTING ROUTINE
- SKP
- CMA /SET AC = -1 IF NON-SEPARATOR
- JMP CSWT1 /GO CHECK RESULTS
-
-FN, DCA CNXT
- STA
- JMP CHRN1
- /S,N AND _ COMMANDS (ALSO FS AND FN)
-
-FS, STA /CHANGE S TO FS
-CHRS, JMS SEARCH /S COMMAND - DO A SEARCH
-CHKREP, ISZ REPFLG /WAS THERE A REPLACE SPECIFIED?
- JMP CHKCLN /NO - CHECK FOR COLON
- QSKP /COUNT UP STRING 2
- TAD NMT
- SMA CLA
- JMP CHKCLN /FAILED, SET VALUE & EXIT
- TAD CSP /FIGURE OUT OFFSET TO FAKE OUT "I" ROUTINE
- CIA /SO THAT WE HAVE THE RIGHT INSERTION COUNT
- TAD P /BUT THE SIZE OF THE HOLE WE NEED
- DCA DVT1 /IS DECREASED BY THE LENGTH OF THE SEARCH STRING.
- TAD CSP /RESET
- DCA P /TEXT POINTER
- PUSHJ /INSERT
- CIL2 /STRING 2
-CHKCLN, DCA REPFLG /CLEAR REPLACE FLAG
- TAD NMT
- PUSHJ /FORM NUMBER FROM "NMT"
- NNEW13 /(APPLYING OPERATOR, IF NECESSARY)
- ISZ CLNF /WAS THERE A COLON ON THIS SEARCH?
- SKP /NO
- JMP I [IREST /YES - GO AWAY REGARDLESS OF RESULTS
- DCA CLNF /RESET COLON FLAG TO 0
- ISZ N /DID WE SUCCEED?
- JMP I (CFSI /NO - SIMULATE A SEMICOLON
- DCA NFLG /YES - HOWEVER, NO COLON MEANS NO RESULT
- JMP I [IREST
-
-CHBA, CLA IAC /_ COMMAND
-CHRN, DCA CNXT /N COMMAND - SET OUTPUT FLAG
-CHRN1, JMS SEARCH /DO A SEARCH
- TAD REND
- CIA
- TAD ZZ
-CSNCL, SNA CLA /HAVE WE REACHED END-OF-FILE?
- JMP CHKREP /YES - STOP AND ASSIGN VALUE
- TAD NMT
- SZA CLA /HAVE WE SUCCEEDED?
- JMP CHKREP /YES - STOP AND ASSIGN VALUE
- TAD CNXT
- JMS I [NXTBUF /GET NEXT BUFFER
- JMP CSST /KEEP SEARCHING - RETURN TO CHRN+2
-CNXT, 0 /OUTPUT FLAG
-CSP, 0 /TEMP P
-CSN, 0
-REPFLG, 0 /REPLACE FLAG (-1 MEANS REPLACE)
- PAGE
- /NUMBER PROCESSORS:
-/COMMANDS B,H,Z,. AND DIGITS
-
-
-NMBR, TAD CHAR /NUMBER FOUND IN COMMAND STRING
- TAD [-60
-NMBR2, DCA NMT
- CLL
- NCHK /CHECK NUMBER FLAG
- JMP NNEW /NOT UP, NEW OPERAND
- TAD DOPR
- DCA NOPR /USE SAME OPERATOR AS FOR THE PREVIOUS DIGITS
- TAD NP /MULTIPLY PREV DIGITS BY 10
- CLL RTL
-NMRBAS, TAD NP /REPLACED BY "NOP" FOR OCTAL
- CLL RAL /** COULD CHECK FOR OVERFLOW IN THIS AREA
-NNEW, TAD NMT
-NCOM, DCA NP /CURRENT NUMBER
-/ RAL
-/ DCA NEWLNK
-/ TAD NEWLNK /GET NEW LINK
-/ CLL RAR /INTO LINK
-NCOM2, TAD NP
-
-NOPR, SKP /DISPATCH JUMP FOR OPERATOR
- CML CIA
- TAD NACC /CURRENT EXPRESSION VALUE
- DCA N
- RAL
- TAD NACCLK /ADD IN OLD LINK
- RAR
- SKP CLA
-NRET, DCA N
- RAL
- DCA NLINK /SAVE LINK FOR POSSIBLE COMPARISON TEST
- TAD NOPR
- DCA DOPR
- TAD NULLOP
- DCA NOPR /SET OPERATOR TO NULL OP
- STA
- JMP DCPOPJ /SET NUMBER FLAG AND EXIT
- CCPR, STL CLA RTL /2
- POPL
- NOPR
- NACC
- NACCLK
- GETNUM
- JMP NCOM /COMBINE OLD NUMBER AND PARENTHESIZED RESULT
-
-COPR, MTHREE
- PUSHL
- NACCLK
- NACC
- NOPR
- DCA N
- DCA NLINK
- JMP CPLS /CLEAN OUT INSIDE PARENS
-
-CDOT, TAD P /COMMAND .
-/** COULD CAUSE ERROR IF NFLG SET
- JMP NCOMCL
-/NEWLNK, 0
- /COMMANDS &,#,/,*,-,+,(,)
-
-CAMP, MTWO /*K* LOGICAL AND **
-CNBS, TAD (NIOR-NDIV /LOGICAL OR
-CVIR, TAD (NDIV-NMPY /DIVISION
-CAST, TAD (NMPY&177+5200-7400 /MULTIPLICATION
-CMIN, TAD [7400-SKP /SUBTRACTION
-CPLS, TAD (SKP /ADDITION
- DCA NOPR /COMMON TO ALL NUMERIC OPERATORS
- TAD N
- DCA NACC
- TAD NLINK
- DCA NACCLK
- DCA NP
-DCPOPJ, DCA NFLG /CLEAR NUMBER FLAG
- POPJ
-
-NAND, AND NACC /BITWISE AND OF BINARY NUMBERS
- JMP NRET /** KEEP THESE TWO OPNS TOGETHER
-NIOR, CMA /BITWISE OR OF BINARY VALUES
- AND NACC
- TAD NP
-NULLOP, JMP NRET
-
-NACCLK, 0 /LINK OF EXPRESSION WITHOUT NP
-NMPY, CIA /*** REALLY OUGHT TO IMPLEMENT 13-BIT MULTIPLY
- DCA ND
- TAD NACCLK
- RAR /SET UP OLD LINK
- TAD NACC
- ISZ ND
- JMP .-2
- JMP NRET
-NACC, 0 /VALUE OF EXPRESSION WITHOUT NP
-NDIV, DCA ND
- TAD NACC
- MQLDVI
-ND, 0
- JMP NRET
- /COMMANDS ^F,^^,^Z,^V, Q AND %, ^D, ^O
-
-CTLF, CLA OSR SKP /^F COMMAND - VALUE OF CONSOLE SWITCHES
-CTUA, SCAN /^^ COMMAND - VALUE OF NEXT CHAR IN COMMAND LINE
-NCOMCL, CLL
- JMP NCOM /GO INTO NUMBER PROCESSOR
-
-/CTLZ, TAD QZ /COMMAND ^Z
-/ JMP NCOM /RETURN NUMBER OF CHARACTERS IN ALL Q-REGS.
-/CTLV, TAD (VERSN /^V COMMAND - RETURNS THE CURRENT VERSION NUMBER
-/NCOM14, CLL
-/ JMP NCOM
-
-CTLD, TAD [4 /SET RADIX DECIMAL
-CTLO, TAD (ORAD /SET RADIX OCTAL
- DCA RADIX
- TAD I RADIX
- DCA NMRBAS /EITHER "NOP"(8) OR "TAD NP"(10)
- POPJ
-
-DOPR, 0 /PREVIOUS OPERATOR
-NP, 0 /VALUE OF CURRENT NUMBER
-
-SCPTAB, BBELL
- BCR
- BCR /TAB
- EASYRO /ALT
- BFF
- BVT
- BLF
-
-CTLN, TAD REND
- CMA
- JMP I (NNEW13
-
-CQSM, TAD TFLG
- CMA /TRACE FLAG ALTERNATES BETWEEN 0 AND 7777
- DCA TFLG
- POPJ
- FTAB, FN
- FS
-FLST, 116 /FN
- 123 /FS
-
-CHRF, SCANUP /COMMAND F
- SORT
- FLST
- FTAB-FLST
-ERR31, ERR /BAD F COMMAND
-
-CCLN, STA /: COMMAND - SET VALUE FLAG
- DCA CLNF
- POPJ /SO NEXT SEARCH WILL HAVE A NUMERIC VALUE
- PAGE
- /CURSOR RIGHT IS $C
-/CURSOR UP IS $A
-/ERASE LINE IS $K
-
-BUGFLG, 0 /-1 MEANS MUST RETYPE LINE ON NEXT RUBOUT
-
-BSP, 0
- TAD TTY10
- PUTT /TYPE BS, SPACE, BS
- TAD TTY40
- PUTT
- TAD TTY10
- PUTT
- STA
- TAD I (COLCT /FIX UP COLUMN COUNTER
- DCA I (COLCT
- JMP I BSP
- SCOPY, JMS I (BACKUP /BACK UP ONE CHAR IN CMD LINE
- TAD [-40 /LOOK AT CHAR WE BACKED OVER
- SMA
- JMP EASYRO /IT'S EASY TO RUB THIS ONE OUT
- TAD [40 /RESTORE CHARACTER
- SORT
- CTLBEL
- SCPTAB-CTLBEL
-BBELL, CLA
- JMS BSP /^X NEEDS TWO RUB OUTS
-EASYRO, CLA
- ISZ BUGFLG /MAYBE WE REALLY SHOULD REPRINT LINE
-TTY10, SKP /NOT NECESSARY
- JMP BCR /NECESSARY (PREVIOUS VERTICAL MOTION MAY
- /HAVE SCROLLED OFF TOP OF SCREEN)
- JMS BSP /RUB IT OUT
-SCOPGO, DCA BUGFLG
- JMP I (T2M1
-
-BCR, JMS BELLSP /REPRINT LINE
- JMS I SCAPE
- 113 /ERASE LINE
- JMP SCOPGO
-
-BLF, TAD CTLBEL /CURSOR UP 1
-BFF, TAD (-4 /CURSOR UP 8
-BVT, TAD (-4 /CURSOR UP 4
- DCA BSP
- JMS I (ESCAPE
- 101 /CURSOR UP
- ISZ BSP
- JMP .-3
-TTY40, STA
- JMP SCOPGO
- TSTAR, DCA BCHAR
-TSPACE, TAD CHAR /LOOK AT PREVIOUS CHARACTER
- TAD (-7
- SZA CLA /WAS IT ^G ?
- RESORT /NO
- STA /YES
-TSP9, TAD I [QPNTR /REDUCE CMD LINE BY 1 CHAR
- ADJQ /I.E. GET RID OF ^G
- JMS BELLSP
- JMP I (T2M1
-
-BELLSP, 0
-BLSP1, CRLF /TAD CACR
-BLSP2, NOP /TYPE
- TAD MQ
- DCA SAVMQ
- DCA MQ
- TAD QZ /START FROM END OF COMMAND LINE
-LFBLP, DCA QP /AND SEARCH FOR LF
- STA
- TAD MQ /COUNT HOW MANY
- DCA MQ
- STA
- TAD QP
- SPA
- JMP LFSTAR /AT BEGIN OF CMD LINE
- GETQ
- TAD BCHAR /LOOK FOR LF
- SNA CLA /IS IT LF?
- JMP LFB /YES
- STA /NO
- TAD QP /BUMP BACK ONE MORE CHAR
- JMP LFBLP
-
-LFSTAR, CLA
- TAD [52 /PRINT ANOTHER *
- TYPE
-LFB, PUSHJ
- COLG4 /REPRINT LINE TO END OF CMD LINE
- TAD SAVMQ /RESTORE MQ
- DCA MQ
-BLSP3, NOP /JMS I SCAPE
-BLSP4, NOP /113
- TAD [-12
- DCA BCHAR /SET UP FOR NEXT TIME
- KCC /CLEAR OUT ^O OR ^S
- JMP I BELLSP
-
-SAVMQ, 0
-BCHAR, -12 /CHAR WE'RE SEARCHING BACKWARDS FOR
-SCAPE, ESCAPE
- SORTB, 0 /SORT AND BRANCH ROUTINE
- DCA SCHAR /SAVE SORT CHAR
- STA
- TAD I SORTB /GET POINTER TO LIST
- ISZ SORTB
- DCA XR
-SORTA1, TAD I XR /GET ITEM IN TEST LIST
- SPA /END MARKED BY NEG VALUE
- JMP SORTA2 /FELL OUT BOTTOM
- CIA STL
- TAD SCHAR
- SZA CLA /COMPARE SORT CHAR
- JMP SORTA1 /NOT IT.
- TAD XR /GOT IT. NOW MAKE INDEX
- TAD I SORTB /TO JUMP TABLE
- DCA COUNT /THIS IS TABLE POINTER
- TAD I COUNT /GET JUMP ADDRESS FROM TABLE
- SPA /IF IT IS NEGATIVE,
- JMP SORTA3 /ITS NOT A JUMP ADDRESS - ITS A VALUE
- DCA COUNT
- CLA CLL
- JMP I COUNT
-SORTA2, CLA CLL /FELL OUT BOTTOM
- TAD SCHAR /CARRY CHARACTER BACK TO
-SORTA3, ISZ SORTB
- JMP I SORTB /DO SOMETHING ELSE
-
-CSMC, SCANUP /GET NEXT CHARACTER IN UPPER CASE
- AND [77 /MAKE IT A CONTROL CHARACTER
- DCA SCHAR
- JMP SORTA1 /SUBSTITUTE IT FOR THE UPARROW
-
-COUNT, 0
- PAGE
- /COMMANDS P AND T
-
-CHRP, JMS POKE /LOOK AHEAD ONE CHARACTER
- UPPERC /BUT IN UPPERCASE
- TAD (-127 /SEE IF IT'S "W"
- DCA TEMPT /SAVE KNOWLEDGE AS FLAG
- TAD TEMPT
- SNA CLA
- SCAN /PASS UP W
- CLA /CLEAR W FROM AC
- TAD CFLG
- SPA CLA /IS THIS COMMAND M,NP?
- JMP CHRW /YES - TREAT LIKE M,NPW
- GETN /COMMAND P - GET # OF PAGES
- SZL SNA
-ERR25, ERR /NEG OR 0 ARG TO P
- CIA
- DCA CPCT
-CPOA, PUSHJ
- CPOC /DO N<HPY>
- TAD TEMPT /IS NEXT CHARACTER W?
- SNA CLA
- JMP NOYANK /YES
-/ TAD REND /IF WANT P TO CREATE FF'S
-/ SZA CLA /WHEN NO MORE INPUT FILE
- ISZ FFFLAG /NO, SAW FF?
- JMP NOFF /NO
- TAD CAFF /YES
- OUTPUT /OUTPUT FF
-NOFF, DCA ZZ /FORCE Y COMMAND TO WORK
- PUSHJ
- CHRY /WHOEVER THOUGHT OF THE PW COMMAND SHOULD BE SHOT
-YANKY, ISZ CPCT
- JMP CPOA
- POPJ
-CPCT, 0
-
-POKE, 0 /RETURN NEXT CHARACTER (BY LOOKING AHEAD)
- TAD QLENGT
- CIA CLL
- TAD SCANP
- SZL CLA /MAKE SURE WE HAVEN'T RUN OFF END OF COMMAND LINE
- JMP I POKE /RETURN 0 IF NO CHAR
- TAD SCANP
- TAD QBASE
- GETQ
- JMP I POKE /LEAVE CHAR IN AC
-
-NOYANK, TAD CAFF /NPW OUTPUTS FFS
- OUTPUT
- JMP YANKY
- CPOC, PUSHJ
- CHRH
-CHRW, TAD (OUTPUT
-CHRT2, DCA CWOUT /W AND T COMMANDS - SAME THING, DIFFERENT DEVICES
- JMS NLINES /CONVERT LINES TO CHARS
-CWOA, CMA
- DCA NLINES /SET CHARACTER COUNT
- TAD NLINES
- CIA
- MQLDVI /COMPUTE HOW MANY WORDS THIS OUTPUT WILL USE
- 6 /(BY TAKING 2/3 OF THE NUMBER OF CHARACTERS,
- CLL CML RTL / BU THAT'S SLOW SO WE TAKE 4/6 AND ROUND)
- JMS I (FITS /DETERMINE WHETHER THE OUTPUT WILL FIT
-ERR17, ERR /NO - TELL THE USER
- CLA /CLEAR CRAP FROM AC
- JMP CWOC
-CWOB, CDF 10
- TAD I M
- AND [177
- CDF 0
-CWOUT, 0 /TYPE, OUTPUT, OR QPUT
- ISZ M
-CWOC, ISZ NLINES /DONE?
- JMP CWOB /NO
- POPJ
-
-CHRT, TAD KTYPE
- JMP CHRT2
- /X COMMAND AND LINES-TO-CHARACTER CONVERTOR
-
-CHRX, QREF /COMMAND X
- JMS NLINES /CONVERT LINES TO CHARS
- ADJQ /ADJUST Q-REGISTERS AND SET UP NEW LENGTH.
- TAD (QPUT
- DCA CWOUT /SET OUTPUT ROUTINE TO STORE INTO Q REG
- TAD MQ /LOAD THE CHARACTER COUNT
- JMP CWOA /GO TO TEXT OUTPUTTER
-
-NLINES, 0 /CONVERT + OR - N LINES AROUND . TO CHARS M,N
- ISZ CFLG /WAS THERE A COMMA?
- SKP /NO
- JMP MFROMN /YES - DON'T CONVERT LINES TO CHARS
- TAD P
- DCA M
- DCA CFLG /V3C
- PUSHJ /CHRL DOES A "GETN"
- CHRL /TO GET THE DEFAULT VALUES OF N
- TAD P
- DCA N
- TAD M
- DCA P
-MFROMN, DCA NFLG /CLEAR NFLG IN CASE COMMA FLAG WAS ON
- CLL /M AND N ARE KNOWN TO BE 12-BITS LONG
- /AND POSITIVE
- TAD N
- BZCHK /IS N OK?
- CMA CLL /YES - COMPUTE N-M
- TAD M /BY COMPUTING M-N-1
- CMA /AND COMPLEMENTING IT
- SNL /IS M>N?
- JMP I NLINES /NO - RETURN N-M
- TAD M /N-M+M=N NOW IN AC.
- DCA CPCT /INTERCHANGE M AND N
- TAD M
- DCA N
- TAD CPCT
- DCA M
- JMP MFROMN
- /COMMANDS ; < AND >
-
-CFSI, TAD ITRST
- SNA CLA
-ERR24, ERR /FAILING SEARCH NOT IN ITERATION
-CSEM, OVRLAY
- QOVRLY
- CSEMO
- / ^A ROUTINE
-
-CTLA, TAD KTYPE
-CEXP, DCA WHERTO
- TAD CHAR
- DCA QUOTE /TERMINATING CHAR SAME AS COMMAND CHAR
- DCA NFLG /KILL NUMBER IF PRESENT
-CTLALP, QUOTST
- JMP I [IREST
-WHERTO, 0 /TYPE OR IGNORE THE CHARACTER
- CLA
- JMP CTLALP
- PAGE
- /COMMANDS A AND Y
-
-CHRA, NCHK /COMMAND A
- JMP CHAA
- GETNUM
- TAD P
- DCA R
- SZL
- JMP I (ERR11 /ERROR IF POINTER OFF PAGE
- CDF 10
- TAD R
- CMA CLL
- TAD ZZ /RETURN 'POP' IF POINTER OUTSIDE RANGE [0,Z-1]
- SNL CLA /OTHERWISE VALUE OF CHARACTER AT POINTER POSITION
- JMP I (ERR11 /POP
- TAD I R
- AND [377
- CDF 0
-NCOM14, CLL
- JMP I (NCOM
- CHRY, TAD NFLG
- SZA CLA
-ERR18, ERR /NUMERIC ARGUMENT TO Y
- TAD OUTR
- CIA
- TAD ERROR
- SZA CLA
- TAD ZZ
-YSKP, SZA CLA /CHANGE TO SKP CLA TO NEVER ABORT Y COMMAND
-ERR32, ERR /Y COMMAND ABORTED
- DCA ZZ
- DCA P /WIPE OUT THE BUFFER
-CHAA, TAD (ZMAX-1
- AND REND
- CIA CLL
- TAD ZZ /IF WE HAVE ALREADY SEEN THE INPUT EOF,
- SZL CLA /OR IF WE'RE ALREADY FULL (OR NEARLY SO)
- JMP APLF /GET OUT
-DECGET, ISZ ICRCNT
- JMP I2 /NO NEED TO READ
- CLL
- TAD INRSIZ
- TAD INRCNT
-STECO1, SNL /"SKP!CLA" FOR SUPERTECO
- DCA INRCNT /UPDATE RECORD COUNT
-LFTAB, CLL CML CMA RTR /IF WE OVERFLOWED THE END OF THE FILE, !
- RTR /5 ENTRY TABLE: MUST BE - - - + + !
- RTR /SHORTEN THE READ BY THE CORRECT AMOUNT !
- TAD INCTLW / !
- DCA INCTRL /SO THAT WE WILL NOT READ TOO FAR !
- JMS I INHND
-I3,
-INCTRL, 0400
-BUFIN, IN /6200 IF 8K, 5600 IF 12K
-IBLK, 0
- SMA CLA
- SKP
- JMP INER /IGNORE END-OF-FILE ERRORS, WE'LL SEE THE ^Z.
- TAD IBLK
- TAD INRSIZ /BUMP RECORD NUMBER BY THE MAXIMUM NUMBER
- DCA IBLK /(IF WE READ SHORT ITS THE LAST ONE ANYWAY)
- CLA CMA
- TAD BUFIN
- DCA INXR /SET UP INPUT XR
- TAD INPCNT
- DCA ICRCNT
- MTHREE
- DCA I3
-I2, NOP /CDF 20 IF 12K
- ISZ I3
- JMP I1 /NORMAL CHARACTER
- MTHREE /WEIRD CHARACTER-RESET SWITCH
- DCA I3
- MTWO
- TAD INXR
- DCA INXR /MOVE INPUT XR BACK TO BEGINNING OF DBLWORD
- TAD I INXR
- AND [7400
- DCA FFFLAG /TEMP
- TAD I INXR
- AND [7400
- CLL RTR
- RTR
- TAD FFFLAG
- CLL RTR
- RTR
- SKP
-I1, TAD I INXR
-IC, NOP /CDF 0 IF 12K
- AND [177 /MASK OFF GARBAGE
- /INPUT CHARACTER IN AC
- SZA
- TAD (-177
- SNA /IGNORE BLANK TAPE AND RUBOUTS
- JMP DECGET
- TAD (177-32
-STECO2, SNA /"SKP" FOR SUPERTECO
- JMP APFS /IT'S A ^Z
- TAD (16
- SNA
- JMP APFF /ITS A FORM FEED
- TAD CAFF /RESTORE CHAR
- CDF 10
- DCA MQ /SAVE CHAR
- TAD I ZZ /PROTECT HIGH-
- AND [7400 /ORDER BITS
- TAD MQ /OF TARGET
- DCA I ZZ /STORE CHAR IN BUFFER
- TAD MQ
- CDF 0
- ISZ ZZ
- TAD [-12
- SNA CLA /IF THE CHAR IS A LINE FEED,
- TAD (-310 /CHECK THAT THE BUFFER IS NOT NEARLY FULL
- JMP CHAA
-APFS, DCA REND /SIGNAL END OF FILE
- SKP
-APFF, STA
-APLF, DCA FFFLAG /SET FORM FEED FLAG
- POPJ
- INER, DCA REND /INHIBIT FUTURE INPUTS
-ERR15, ERR
-
-INCTLW, 401 /1021 IF 12K MACHINE
-INPCNT, 6400 /5000 IF 12K MACHINE
- PAGE
- /TELETYPE ROUTINES
-
-TYPCTV, 0 /TELETYPE STUFFER
- SORT
- CTLBEL
- CTLTAB-CTLBEL
- DCA SCHAR /STORE (POSSIBLY TRANSLATED) CHAR
-OUTCC, TAD SCHAR
- ISZ COLCT /BUMP COLUMN COUNTER
- AND [7740
- SZA CLA /IS THE CHAR A CONTROL CHARACTER?
- JMP NOCON /NO
- TAD (136
- PUTT /OUTPUT "^"
- ISZ COLCT
- TAD [100
-OUTLF, TAD SCHAR
-OUTLF1, PUTT
- JMP I TYPCTV
- COLCT, 0
-
-OUTCR, DCA COLCT /RESET CHAR COUNT
- JMP OUTLF
-OUTVT, TAD [4
-OUTFF, TAD [7770 /FORM FEED IS 8 LINE FEEDS, VERT TAB IS 4
- DCA COLCT /*** BUG
-ASR33, TAD CALF /SIMULATE FORMFEEDS AND VERT TABS WITH LINEFEEDS
- JMP OUTCOM /*K* 8 LOCS AT ASR33 OVERLAYED BY ASR35 CODE
-
-OUTHT, TAD COLCT /COLUMN COUNTER, MOD 8
- AND [7
- TAD [7770 /SIMULATE TABS WITH SPACES
- DCA COLCT
- 40 /TAKE UP SPACE SO ASR-35 ROUTINE WILL JUST FIT
- TAD .-1 /USE SPACES FOR TABS
-OUTCOM, PUTT /PUT ONE OUT THE
- ISZ COLCT /WINDOW
- JMP I (TPUTX /STILL MORE INSIDE
- JMP I TYPCTV
-
-NOCON, TAD SCHAR
- AND [100
-EU1, SNA CLA /*EU SET TO CLA IF EUFLAG < 0 (NO CASE FLAGGING)
- JMP OUTLF /NOT ALPHANUMERIC
-EU2, NOP /*EU SET TO TAD [40 IF EUFLAG>0 (FLAG UPPER CASE)
- TAD SCHAR
- AND [40
- SNA CLA
- JMP OUTLF
- TAD SQUO
- PUTT
- ISZ COLCT
- TAD SCHAR
- AND [137
- JMP OUTLF1 /OUTPUT UPPER CASE VERSION
-
-OUTBEL, TAD SCHAR
- PUTT
- JMP OUTCC
- /ROUTINE TO MANIPULATE Q-REGISTER STORAGE
-
-/*** ALLOW : TO MEAN APPEND TO Q-REGISTER
-/APPLIES TO X AND ^U COMMANDS
-/MAKE SURE CMD LINE AND ^S ZERO CLNF
-
-QADJ, 0
- SPA
- JMP ERR12 /STRING TOO LONG FOR Q-REGISTER
- DCA MQ /SAVE NEW LENGTH OF Q-REGISTER
- QSUM /COMPUTE POINTER TO CURRENT Q-REGISTER
- AC3777
- AND I QPTR
- TAD QP
- DCA R
- AC3777
- AND I QPTR /GET ITS CURRENT LENGTH
- CIA CLL
- TAD MQ /COMPUTE DIFFERENCE
- SNL /ADJUST Q-REGS
- JMP QDNN /TO HOLD NEW STRING
- SNA /CHECK FOR ZERO
- JMP QADJDN /NOTHING TO DO
- TAD QZ /MOVE Q-REGISTERS UP TO INSERT CHARS
- DCA QP /(LINK IS 1 FROM PREVIOUS SNL)
- TAD QP
- TAD MQMAX /SEE IF OUT OF BOUNDS
- SNL CLA /TWO PLACES TO TOGGLE LINK THERE
-ERR12, ERR /GETTING TOO FULL
- TAD QZ
- DCA Q
- TAD QP
- DCA QZ
- ISZ QP
-QUPL, TAD Q
- CIA
-SQUO, TAD R /DOUBLES AS ASCII FOR '
- SNA CLA
- JMP QADJDN
- CMA
- TAD Q
- DCA Q
- MTWO
- TAD QP
- DCA QP
- TAD Q
- GETQ
- QPUT
- JMP QUPL
- QDNN, TAD R /MOVE Q-REGS DOWN TO ABSORB CHARACTERS
- DCA QP
-QDNN1, TAD QZ
- CIA
- TAD R /-NUMBER OF CHARS TO MOVE
- SNA CLA /DONE?
- JMP QDNNF /YES
- TAD R
- GETQ
- QPUT
- ISZ R
- JMP QDNN1 /LOOP AGAIN
-QDNNF, TAD QP /SET NEW VALUE
- DCA QZ /OF HIGHEST CHAR
-QADJDN, STL CLA RAR /4000
- AND I QPTR /SAVE HIGH ORDER PART
- TAD MQ
- DCA I QPTR /SAVE NEW LENGTH OF Q-REGISTER IN Q-REG TABLE
- TAD QCMND /SET UP COMMAND LINE AGAIN
- SETCMD /AS IT MAY HAVE BEEN SHUFFLED.
- QSUM /RECOMPUTE POINTER TO BEGINNING OF NEW Q-REG
- JMP I QADJ
-
-MQMAX, -QMAX
-
-QOVER, 0 /SUBROUTINE TO SKIP TO END OF STRING
- QCHK /GET THE QUOTE CHARACTER (IF ANY)
- TAD SCANP
- DCA OSCANP /SAVE BACKUP SCAN POINTER
-QOVERL, QUOTST
- JMP I QOVER /FOUND AN ALTM OR EQUIVALENT - RETURN
- JMP QOVERL /NOT END - SKIP ANOTHER CHAR
- PAGE
- /Q-REGISTER SUBROUTINES
-
-QSUMR, 0 /COMPUTE POINTER TO Q-REG
- SNA
- TAD QNMBR /NORMALLY USES QNMBR, BUT CAN BE OVERRIDDEN BY AC
- CIA
- DCA QKNT
- DCA QP
- TAD (QARRAY /BASE ADDR OF Q-REG POINTERS
- DCA QPTR
- JMP QSUMB
-QSUML, AC3777
- AND I QPTR /ADD # OF CHARS IN LOWER REG
- TAD QP
- DCA QP
- ISZ QPTR /SKIP VALUE WORD
- ISZ QPTR /POINT TO NEXT Q-REG
-QSUMB, ISZ QKNT /REACHED OUR Q-REGISTER YET?
- JMP QSUML /NO - ADD IN ANOTHER
- JMP I QSUMR
-QKNT, 0
- SGET, 0 /SCAN COMMAND LINE OR MACRO
-SGET1, CLA /** CALLED WITH AC NON-ZERO **
- TAD QLENGT
- CIA CLL
- TAD SCANP
- SZL CLA /CHECK THAT WE ARE STILL INSIDE THE COMMAND LINE
- JMP SGOVFL /NO - COMMAND DONE
- TAD SCANP /GET CHARACTER POSITION IN LINE
- TAD QBASE /ADD IT TO THE ADDRESS OF THE LINE
- GETQ /AND GET THAT CHARACTER.
- DCA LASTC
- TAD TFLG
- AND LASTC /IF THE TRACE FLAG IS ON,
- SZA
- TYPE /PRINT THE CHAR
- TAD LASTC
- ISZ SCANP /INCREMENT CHARACTER POINTER AFTER FETCH
- JMP I SGET /RETURN
-SGOVFL, TAD MPDL /"MPDL" IS THE PUSHDOWN POINTER ON ENTRY TO THIS
- SNA /MACRO. IF IT IS 0, WE ARE NOT IN A MACRO
- JMP I (T1 /SO RETURN TO THE USER
- TAD PDLP /CHECK THAT THE ENDING POINTER IS THE SAME
- IAC
- SZA CLA /AS THE ENTRY ONE - OTHERWISE WE HAVE
-ERR13, ERR /SCREWED UP SOMEHOW (EG WE ARE
- POP / IN THE MIDDLE OF A COMMAND)
- DCA SCANP
- POP
- DCA ITRST
- POP /RESTORE THE PREVIOUS VALUES OF
- DCA MPDL /MPDL, THE SCAN POINTER AND THE COMMAND LINE
- POP /POINTER FROM THE PUSHDOWN LIST
- SETCMD
- JMP SGET1 /AND FETCH A CHARACTER FROM THE UPPER LEVEL.
- CMDSET, 0 /SUBROUTINE TO SET UP COMMAND LINE POINTERS
- DCA QCMND /STORE IN COMMAND LINE NUMBER
- TAD QCMND
- QSUM
- TAD QP /GET FIRST LOCATION IN COMMAND LINE
- DCA QBASE /AND STORE IN "QBASE"
- AC3777
- AND I QPTR
- DCA QLENGT /STORE THE LINE LENGTH IN "QLENGT"
- JMP I CMDSET /RETURN
-
-QREFER, 0 /SET UP POINTERS FOR Q-REG REFERENCE
- SZA
- JMP QREFEX /AHA - WE ALREADY HAVE THE Q-REGISTER
- SCANUP /GET Q-REGISTER IDENTIFIER
- DCA QNMBR
- TAD QNMBR
- TSTSEP /TEST FOR ALPHANUMERIC (LOWER CASE LEGAL)
-ERR03, ERR /OOPS - BAD Q-REGISTER REFERENCE
- TAD QNMBR
- TAD [7700
- SPA /NUMERIC?
- TAD Z7 /YES - FORCE NUMBERS UP TO ABUT LETTERS
- TAD CALF /FORCE IDENTIFIER INTO THE RANGE 1-44 (OCTAL)
-QREFEX, DCA QNMBR /STORE AWAY NUMBER FOR FURTHER REFERENCE
- QSUM /COMPUTE QP AND QPTR
- JMP I QREFER /RETURN
-
-CDBQ, OVRLAY
- QOVRLY /READ IN Q-OVERLAY
- CDBQO
-
-CHRO, OVRLAY /READ IN Q-OVERLAY
- QOVRLY
- CHROO
- OVERLY, 0
- TAD I OVERLY /GET LOCATION TO CHECK
- ISZ OVERLY
- DCA TMP
- TAD I OVERLY
- DCA OVERLY /SET RETURN ADDRESS
- TAD I TMP /IS OUR OVERLAY IN CORE?
- SNA
- JMP I OVERLY /YES, BRANCH INTO IT
- DCA TMP /NO, SET BLOCK TO READ IN
-/** THE NEXT 5 WORDS ARE MODIFIED IF WE HAVE MORE THAN 12K
-OVREAD, JMS I (7607 /CALL SYSTEM HANDLER
- 0200 /READ 2 PAGES
- 3200 /INTO 3200
-TMP, 0 /FROM THIS BLOCK
- HLT /ERROR READING OVERLAY
- JMP I OVERLY /GO TO NEXT SPOT
-
-CTLTAB, OUTBEL /BELL
- OUTCR
-POUTHT, OUTHT
- 4044 /$ WITH SIGN BIT ON
- OUTFF
- OUTVT
- OUTLF
-
-ALTTAB, 4033
- 4033 /ALTMODE WITH SIGN BIT ON
-
-CATS, STA /@ COMMAND - FAKE OUT "IREST"
-IREST, DCA QFLG /RESET QUOTED STRING FLAG
- TAD CAAM
- DCA QUOTE /RESET QUOTE CHAR TO ALTMODE
-POPK, POPJ /RETURN
-
-QTST, 0 /SUBROUTINE TO GET A CHAR AND TEST FOR ALTMODE
- SCAN
- SORT
- QUOTE
- QTST-QUOTE /RETURN IF QUOTE FOUND
- ISZ QTST
- JMP I QTST /SKIP-RETURN WITH AC INTACT IF NOT FOUND
- /COMMANDS ^U AND E - ALSO ERROR ROUTINE
-
-CTLU, OVRLAY
- FOVRLY
- CTLUO
- PAGE
- ERRXX, ERR30+1 /ENTRY POINT ALSO SERVES AS A FLAG FOR "TQMK"
- KCC /CLEARS AC
- CDF 0 /JUST IN CASE
- TAD I ERRXX /GRAB SIGNAL '0' NOW
- DCA ERRTMP /BEFORE OVERLAY MIGHT DESTROY IT
- OVRLAY /GO TO ERROR OVERLAY
- EOVRLY
- ERRYY
-
-ERRRET, TAD ERRTMP /GET THE LOCATION AFTER THE CALL
- SNA CLA /IF IT'S ZERO AND WE WERE CHAINED TO,
-CHOOPS, NOP /ITS A FATAL ERROR - JMP CTLC
-FATALJ= JMP I (CTLC
-CTRLP, TAD SCANP
- CIA
- DCA ERRXX /SET ERRXX TO CHAR POSITION OF ERROR CHAR.
- KCC /ZAP KEYBOARD FLAG
- JMP I (T0 /CONTINUE AS NORMAL UNLESS USER TYPES "?"
-
-CHRE, SCANUP /COMMAND E
- DCA TYI
- TAD TYI
- SORT
- EFLST
- EFTAB-EFLST
- CLA
- OVRLAY
- FOVRLY
- CHRED
-ERRTMP, 0 /MUST BE INITIALLY 0
- /COMMANDS I AND <TAB>
-
-CHRI, NCHK /I COMMAND
- JMP CIL1
- TAD N /INSERT CHAR WHOSE VALUE IS N
- JMS UPOC
-/*** CHECK FOR $
- POPJ
-CTLI, DCA QFLG /CANNOT BE QUOTED
-/ CLA CMA /FOR TAB INSERT
-/ TAD SCANP
-/ DCA SCANP /BACK UP SCAN POINTER BY ONE
-/ /*** THIS IS A BUG
- TAD CAHT /TAB
- JMS UPOC
-CIL1, QSKP /COUNT LENGTH OF INSERTION
- DCA DVT1 /ZERO FUDGE USED BY FS COMMAND
-CIL2, TAD OSCANP
- TAD QBASE
- DCA QP /SET UP POINTER TO INSERTION STRING
- TAD SCANP
- CIA CLL
- TAD OSCANP
- DCA MQ /STORE CHAR COUNT TO INSERT (-1)
- TAD MQ
- TAD DVT1 /ADD FS FUDGE
- CMA
- SNL /DID WE INSERT MORE THAN WE DELETED?
- JMP EXPAND /YES - IGNORE SIGN BIT OF COUNT
- CIA
- PUSHJ
- ADJ2 /COMPRESS OUT EXCESS DELETED STUFF
- JMP CIL4
-CIL3, TAD QP
- GETQ /GET A CHAR
- DCA TYI
- JMS STOREC /STORE A CHARACTER
- ISZ QP
-CIL4, ISZ MQ
- JMP CIL3 /OF INSERTION
- JMP I [IREST
-
-STOREC, 0 /STORE CHAR IN "TYI" INTO TEXT BUFFER AT P
- CDF 10
- TAD I P
- AND [7400
- TAD TYI
- DCA I P
- CDF 0
- ISZ P
- JMP I STOREC
- /G COMMAND
-
-CHRG, QREF /G COMMAND - GET Q-REGISTER NUMBER
- DCA NFLG
- AC3777
- AND I QPTR /GET COUNT OF CHARS IN REGISTER
- CMA
- DCA MQ /SAVE AS TRANSFER COUNT
- ISZ CLNF
- SKP
- JMP COLG4
- DCA CLNF
- AC3777
- AND I QPTR
-EXPAND, PUSHJ /COME HERE FROM INSERT LOGIC
- ADJ /INCREASE TEXT BUFFER SIZE ( Q-REG LENGTH MAY
- JMP CIL4 /BE NEGATIVE) AND GO TRANSFER THE CHARS
-
-TYI, 0 /TELETYPE INPUT
-TYI1, KSF /WAIT FOR THE KEYBOARD FLAG
-KSFWT, JMP .-1 /WHILE WAITING, DISPLAY TEXT ON SCOPE
- CTCCHK /CHECK FOR ^C
- KRB /WATCH OUT - AC MAY NOT BE 0!
- AND [177
- SNA
- JMP TYI1 /IGNORE NULL CHARS AND LEADER
- SORT
- ALTLST
- ALTTAB-ALTLST /LOOK FOR NON-STANDARD ALTMODES
- AND [177 /IN CASE WE RETURNED A NEGATIVE VALUE
- JMP I TYI
-
-UPOC, 0 /MOVE TEXT BUFFER UP ONE CHAR
- AND [177
- DCA TYI
- CLA IAC
- PUSHJ
- ADJ
- JMS STOREC /STORE CHAR IN THE HOLE WE MADE
- JMP I UPOC
-
-CUPPER, 0 /FORCE CHARACTER TO UPPER CASE
- TAD [-100
- SMA /IF ITS >100
- AND (37 /REDUCE IT TO BE <140
- TAD [100
- JMP I CUPPER /RETURN
- COLG3, TAD QP
- GETQ /GET A CHAR
- TYPE
- ISZ QP
-COLG4, ISZ MQ
- JMP COLG3
- POPJ
- ESCAPE, 0
- TAD CAAM /TYPE ESCAPE
- PUTT
- TAD I ESCAPE
- PUTT /TYPE ARGUMENT
- JMP I ESCAPE /OK TO RETURN TO ARGUMENT
- PAGE
- TSAVE, TAD I [QPNTR
- SZA CLA /IF WE ARE NOT AT THE BEGINNING OF THE C.L.
- RESORT /TREAT THIS LIKE ANY OTHER ^S
- MTWO /DROP OFF THE TWO BELLS OR ALTMODES
- TAD OCMDLN
- ADJQ /SET COMMAND STRING LENGTH TO OLD VALUE
- TAD L44
- QREF /SET UP POINTERS TO Q-REG Z
- ADJQ /KILL CONTENTS OF Q-REG Z
- TAD I [QPNTR
- DCA I (QPNTR-2
- DCA I [QPNTR /DO A QUICK SHUFFLE OF Q-REG LENGTHS
- JMP I (TCTLU
- CHRQ, QREF /COMMAND Q
- CLL
- JMP CQOA
-
-CPCS, QREF /COMMAND %
- GETN
-CQOA, ISZ QPTR /POINT TO VALUE WORD
- TAD I QPTR /INCREMENT VALUE BY ARGUMENT
- DCA I QPTR
-/ADD LINKS
- STA
- TAD QPTR /GO BACK ONE
- DCA QPTR2 /ALSO COMPL LINK
- CML RAR
- TAD I QPTR2
- DCA I QPTR2
- TAD I QPTR2
- RAL
- CLA
- TAD I QPTR
- JMP I (NCOM /MAKE A NUMBER
-
-TYCRLF, 0 /TYPE A CR AND LF
- TAD CACR /CR
-XTYPE, TYPE
- TAD CALF /LF
- TYPE
- JMP I TYCRLF /RETURN
-
-QPTR2, 0
-
-CHGT, OVRLAY
- QOVRLY
- CHGTO
-CHLT, OVRLAY
- QOVRLY
- CHLTO
- CCMA, NCHK /COMMAND ,
- JMP NERR /NUMBER FLAG NOT SET
- TAD NLINK
- SZA CLA
-ERR26, ERR /NEG ARGUMENT TO ,
- ISZ CFLG
- SKP
- JMP NERR /3 NUMERIC ARGUMENTS
- TAD N /MOVE N TO M
-CCMA3, DCA M /ENTERED HERE BY "H" COMMAND
- DCA N /AND CLEAR N
- STA
- DCA CFLG /SET COMMA FLAG
- POPJ
- /RETURNS 13-BIT RESULT IN AC,LINK
-
-NGET, 0 /SUBROUTINE TO GET LAST NUMBER, WITH
-NGET1, NCHK /DEFAULT VALUES OF +1 (NO NUMBER),
- JMP NGET2 /OR -1 (JUST A MINUS SIGN)
- GETNUM
- JMP I NGET /DIGITS SEEN - RETURN THEM
-NGET2, CLA CLL IAC /NO DIGITS SEEN
- PUSHJ /MAKE BELIEVE WE SAW THE DIGIT "1"
- NCOM /AND CREATE A NUMBER FROM IT (TAKING ANY
- JMP NGET1 /OPERATORS INTO ACCOUNT) AND USE IT
-
-BACKUP, 0
- TAD I [QPNTR /SEE IF ANYTHING TO ERASE
- SNA CLA
- JMP I (T0 /NO, START ALL OVER
- STA
- TAD I [QPNTR /THEN THE CHARACTER COUNT
- ADJQ /REDUCE THE LENGTH OF THE COMMAND REGISTER BY 1
- TAD QZ
- GETQ /GET THE CHARACTER WE RUBBED OUT
- JMP I BACKUP
-
-CHLCMP, 0 /COMPARISON SUBROUTINE
- TAD I P /DATA FIELD IS 10
- AND [377
- CDF 0
- SORT
- CAFF
- LFTAB-CAFF
- SPA CLA /LINE TERMINATORS ARE CHANGED TO NEGATIVE NOS.
- ISZ CDT /IS COUNT EXHAUSTED?
- JMP CHLRET /NO
-CHRLI, ISZ P
-L44, 44
- CDF 0
- POPJ
-
-CHRH, PUSHJ /COMMAND H
- CCMA3 /SET M=0 AND COMMA FLAG ON AND FALL INTO "Z"
- /** COULD CAUSE ERROR ON B AND H IF NFLG SET
-CHRZ, TAD ZZ /COMMAND Z
-CTLH, /^H COMMAND - TIME OF DAY - NOT IMPLEMENTED
-CHRB, JMP I (NCOM14 /COMMAND B
-
-CHLRET, CDF 10
- JMP I CHLCMP
- EFTAB, IOV
- XOV
- XOV
- XOV
- XOV
- IOV
- IOV
- XOV
- XOV, OVRLAY
- XOVRLY
- CHREX
-
-IOV, OVRLAY
- IOVRLY
- CHRER
- /COMMANDS = AND \ DISPATCHER TO OVERLAY
-
-CEQL, OVRLAY
- FOVRLY
- CEQLO
-CBSL, OVRLAY
- FOVRLY
- CBSLO
-
-ZROSPN, DCA SCANP /RESET TO BEGINNING OF ITERATION
-ZRON, DCA NFLG /KILL NUMBER FLAG
- JMP I [IREST
- PAGE
- / I/O-OVERLAY
-
-/ IOVRLY XOVRLY FOVRLY
-/ ER EF EU
-/ EB EC ES
-/ EW EX ET
-/ EG EV
-/ EH
-/ EO
-
- *3200
-
-IOVRLY, 0
- QOVRLC
- EOVRLC
- XOVRLC
- FOVRLC
-
- /SUBROUTINE TO DO LOOKUPS AND ENTERS (LINK CRITICAL ON ENTRY)
-
-OPEN, 0 /CALLED WITH MONITOR CODE - 2 IN AC
- DCA RSTSW /ENTER OR LOOKUP
- SZL CLA /IF THIS IS THE OUTPUT SIDE OF AN "EB" COMMAND,
- JMP DEVLOD /SKIP THE STATEMENT SCAN
- QCHK
- TAD DSKNAM /PACKED SIXBIT FOR 'DSK:'
- DCA DEVC
- TAD (72 /RESTORE :
-NGOM1, DCA DEVLST+1
-NGO, DCA NAME /CLEAR NAME
- DCA NAME+1
- DCA NAME+2
- MTWO
- DCA PERDSW
-NAMCM1, DCA NAMCNT
- NAMEC, QUOTST /GET CHAR AND TEST FOR ALTM
- JMP DEVQOT /ALTM - END OF NAME
- SORT /NO - CHECK SPECIAL CHARS
- DEVLST /([,:,., AND SPACE
- DEVTAB-DEVLST
- TSTSEP /NO, SEE IF ALPHANUMERIC
-ERR08, ERR /ILLEGAL CHAR
- TAD NAMCNT
- TAD [-10
- SMA CLA /MORE THAN 6 CHARS?
- JMP NAMEC /YES, IGNORE
- TAD NAMCNT /NO, PACK IT
- CLL RAR
- DCA TEMP1 /*K* NOTE ASSUMPTION NAME STARTS AT LOC 0!
- TAD SCHAR
- UPPERC /** "UPPERC" ALWAYS COMPLEMENTS LINK
- AND [77
- SNL
- JMP .+4
- CLL RTL
- RTL
- RTL
- TAD I TEMP1
- DCA I TEMP1
- ISZ NAMCNT
- JMP NAMEC
-
-PERD, ISZ PERDSW /FOUND A PERIOD
- TAD NAME
- SNA CLA /ERROR IF WE HAVE
- JMP ERR08 /DOUBLE PERIODS OR NO FILE NAME
- DCA DEVLST+1 /DEVICE NO LONGER LEGAL
- DCA NAME+3 /ZERO EXTENSION OUT
- TAD [6 /AND SET POINTER TO 6TH CHARACTER
- JMP NAMCM1
-
-COLON, TAD NAME+1
- SNA /WE MUST PACK THE NAME INTO ONE WORD OURSELVES
- JMP .+5 /BECAUSE IF "OPEN" IS CALLED FROM THE OUTPUT
- TAD NAME /SIDE OF AN "EB" COMMAND, WE SKIP
- SMA CLA /THE NAME COLLECTOR.(WITH GOOD REASON -
- CLL CML RAR /THE USR OVERLAYS THE COMMAND LINE).
- TAD NAME+1 /SINCE THE OS/8 "ASSIGN" CALL TO THE USR
- TAD NAME /REPLACES THE 2ND NAME WORD WITH THE DEVICE
- DCA DEVC /NUMBER, ALL NAME INFO MUST BE HELD IN WORD 1.
- JMP NGOM1 /DEVICE NAME STORED - RESET FOR FILE NAME
-
-DEVLST, 56 /.
- 72 /:
-DSKNAM, 5723 /=0423+1300+4000 - SERVES AS LIST TERMINATOR
- DEVQOT, ISZ PERDSW /IF WE NEVER SAW A PERIOD,
- DCA NAME+3 /WIPE OUT THE EXTENSION
- JMS I (GETUSR /BRING USR INTO CORE
-
-DEVLOD, TAD I OPEN /MOVE HANDLER ADDRESS
- DCA DEVHND
- ISZ OPEN /AND BUMP POINTER
- TWO
- TAD RSTSW
- DCA CODE /ENTER OR LOOKUP
- CIF 10 /AND RESET TABLES
- JMS I [200
- 13
-RSTSW, 0 /DON'T ZAP OPEN FILES ON INPUT
- DCA DEVNO /ZERO SECOND NAME WORD
- CIF 10
- JMS I [200
- 1 /ASSIGN HANDLER
-DEVC, 0
-DEVNO, 0
-DEVHND, 0
- JMP OPNERR /ERROR - KICK USR OUT FIRST
- DCA STBLK
- TAD RSTSW /GET LOOKUP-ENTER SWITCH
- TAD NAME /IF NAME IS NULL AND THIS IS A LOOKUP,
- SNA CLA
- JMP OPSUCC /IT JUST SUCCEEDED
- TAD DEVNO /DEVICE #
- CIF 10
- JMS I [200
-CODE, 0 /ENTER OR LOOKUP
-STBLK, 0 /FILLED WITH STARTING BLOCK
-TEMP1,
-FLN, 0 /FILLED WITH -LENGTH
-/**** CHECK IF AC MUST = 0
- JMP OPNERR /ERROR
-OPSUCC, TAD DEVHND /HANDLER ADDRESS IN AC
- JMP I OPEN
-PERDSW, 7777 /FLIP FLOP FOR EXTENSION
-NAMCNT, 0 /CHARACTER COUNT
- /*** CHECK FOR : (SEE P.26) RETURN VALUE IF FNF, ALSO IF FOUND
-OPNERR, TAD RSTSW /WE SHOULD ONLY KILL THE OUTPUT FILE
- SNA CLA
- JMP .+3 /IF THIS IS AN OUTPUT ERROR
-EBERR, TAD ERROR
- DCA OUTR
- PUSHJ
-PECDSM, ECDISM /DISMISS THE USR
-ERR16, ERR
- 0 /*K* TELLS ERR RTN TO EXIT IF WE WERE CHAINED TO
-
- PAGE
- CHRER, TAD I (TYI
- SORT
- ERLST
- ERTAB-ERLST
- ERR /CAN'T HAPPEN
-
-ERTAB, EBAK /EB
- ROPEN /ER
- WOPEN /EW
-
-ERLST, 102 /EB
- 122 /ER
- 127 /EW
-
- /FILE OPEN COMMMANDS:
-
-EBAK, CLA CMA CLL /"EDIT BACKUP" COMMAND WITH LINK CLEAR
- PUSHJ /USE 'ROPEN' TO SET POINTERS
- ROPEN /WITHOUT KICKING OUT THE USR (AC=-1 ON ENTRY)
- TAD I (DEVNO /DEVICE #
- TAD (OSDCBT-1
- DCA R
- CDF 10
- TAD I R /GET DEVICE CODE FROM DCB TABLE
- CDF
- SMA CLA /NEGATIVE IF FILE-STRUCTURED
- JMP I (EBERR /YOU CAN'T DO THAT!
- TAD NAME+3 /EXTENSION
- TAD (-213
- SNA
- JMP I (EBERR /CAN'T EB A .BK FILE
- TAD DOTBK /RESTORE EXTENSION
- DCA R /SAVE IT
- TAD DOTBK /.BK EXTENSION
- DCA NAME+3
- CIF 10
- TAD I (DEVNO /DEVICE #
- JMS I [200 /DELETE THE OLD BACKUP
- 4
- NAME
- 0
-DOTBK, 213 /WHO CARES IF IT'S NOT THERE?
- TAD R /OLD EXTENSION
- DCA NAME+3
- CLA CLL CML IAC /SET EDIT BACKUP FLAG AND DO AN "ENTER"
- /LINK MUST BE SET HERE FOR OPEN
-WOPEN, DCA EBFLG /LINK NORMALLY 0 WHEN GOTTEN HERE
- CLA IAC /OPEN OUTPUT FILE
- JMS I (OPEN /ENTER CODE IN AC
-OUHNDL, 4001 /HANDLER ADDRESS
- DCA OUTHND /HANDLER ENTRY
- TAD I (DEVNO
- DCA ODEV /SAVE DEV #
- DCA I (OCNT /CLEAR BLOCK COUNT
- TAD I (FLN
- DCA I (OMAXLN /MAXIMUM FILE LENGTH
- TAD NAME
- DCA I (OUNAM
- TAD NAME+1
- DCA I (OUNAM+1
- TAD NAME+2
- DCA I (OUNAM+2
- TAD NAME+3
- DCA I (OUNAM+3
- TAD (DECPUT
- DCA OUTR /ENABLE CHARACTER OUTPUT ROUTINE
- TAD (ECDISM
- DCA I (DECPUT /FAKE RETURN FROM CHAR I/O ROUTINE
- TAD I (STBLK
- JMP I (OSETP /SET UP BLOCK NUMBER AND POINTERS
- /FILE OPEN ROUTINE
-
-ROPEN, DCA QPTR /ENTERED WITH AC=-1 IF MONITOR IS TO BE KEPT
- /ENTERED WITH LINK=0
- JMS I (OPEN /LOOKUP CODE IN AC
-INHNDL, 7201 /HANDLER ADDRESS
- DCA INHND /SAVE HANDLER ENTRY
- STA
- DCA ICRCNT /POINTER
- STA
- DCA REND /CLEAR END-OF-FILE FLAG
- TAD I (STBLK
- DCA I (IBLK /FIRST BLOCK
- TAD I (FLN
- DCA INRCNT /SET UP INPUT FILE LENGTH
- ISZ QPTR /SHOULD WE DISMISS THE MONITOR?
- JMP I (ECDISM /YES - KICK THE USR OUT AND POPJ
- JMP I [IREST /EXIT
-
-DEVTAB, PERD /.
- COLON /:
- PAGE
- NORMAL, TAD ODEV /CLOSE FILE
- CIF 10
- JMS I [200
- 4
- OUNAM
-OCNT, 0 /NUMBER OF BLOCKS
- HLT
- TAD ERROR /RESET OUTPUT SUBROUTINE POINTER
- DCA OUTR /TO ERROR
-ECDISM, CIF 10 /DISMISS OS/8 USR ROUTINE
- JMS I [200
- 11 /KICK USR OUT
- JMP I [IREST
-
-/*** REALLY SHOULD BREAK UP INTO 2 ROUTINES
-
-SCHSRT, 0 /SORT LETTERS AND NUMBERS
- UPPERC /CONVERT TO UPPER CASE TO REDUCE CASES
- CLL /THE LINK WILL ALTERNATE EACH TIME
- TAD [-60 /WE ADD ONE OF OUR NEGATIVE CONSTANTS.
- SMA /THE LINK AT THE END WILL TELL WHETHER
- TAD [-12 /THE CHARACTER WAS ALPHANUMERIC
- SMA /(I.E. BETWEEN 60-71,101-132 OR 140-172)
- TAD M7 /OR A SEPARATOR CHARACTER.
- SMA
- TAD (-32
- SZL CLA /WAS IT ALPHANUMERIC?
- ISZ SCHSRT /YES
- JMP I SCHSRT /SKIP RETURN IF ALPHANUMERIC
-
-RT, 0 /ROUTINE TO PACK THIRD CHAR INTO OUTPUT BUFFER
- CLL RTL
- RTL
- DCA DM /CALLED TWICE - FIRST TIME WITH CHAR IN AC,
- TAD DM /SECOND TIME WITH "DM" IN AC
- AND [7400
- TAD I OPTR2
- DCA I OPTR2
- ISZ OPTR2
- JMP I RT
- DVIMQL, 0 /FAKE MQL DVI
- DCA DVT1 /STORE DIVIDEND
- DCA MQ /INITIALIZE QUOTIENT
-DV1, TAD I DVIMQL /GET DIVISOR
- CIA
- CLL /SET UP TO TAKE IMMEDIATE EXIT ON ZERODIVIDE
- TAD DVT1 /SUBTRACT DIVISOR FROM DIVIDEND
- SNL /OVERFLOWED YET?
- JMP DV7200 /YES
- DCA DVT1 /NO - STORE IT BACK
- ISZ MQ /BUMP QUOTIENT
- JMP DV1 /AND LOOP
-DV7200, CLA
- TAD MQ
- ISZ DVIMQL /SKIP PAST DIVISOR
- JMP I DVIMQL /RETURN WITH QUOTIENT IN AC
-
-/SEARCH STRING MODIFIERS:
-
-SCHLST, 16 /^N - ANYTHING BUT
- 21 /^Q - LITERALLY
- 23 /^S - ANY SEPARATOR
- 30 /^X - ANYTHING
-M7, -7
- DECPUT, 0 /DEVICE INDEPENDENT I/O
- TAD [200 /ADD ON PARITY BIT
- ISZ O3 /3RD CHAR OF 3?
- JMP O2 /NO
- JMS RT /YES, SPECIAL HANDLING
- TAD DM /TEMP STORAGE
- JMS RT
-SETO3, MTHREE /RESET SWITCH
- DCA O3
- ISZ OCRCNT /END OF BUFFER?
- JMP I DECPUT /NO
- JMS FITS /CHECK FOR OUTPUT OVERFLOW
- JMP OERR /YUP
- DCA OCNT /NO - UPDATE OUTPUT COUNT
- JMS I OUTHND /OUTPUT THE BUFFER
-OUCTRL, 4400
-BUFOUT, OUT
-OBLK, 0
- JMP OERR
- TAD OBLK
- TAD INRSIZ /BUMP THE OUTPUT RECORD NUMBER BY THE MAXIMUM
-OSETP, DCA OBLK /SINCE ALL WRITES EXCEPT THE LAST ARE MAXIMAL
- TAD BUFOUT /BUFFER POINTERS
- DCA OPTR1
- TAD BUFOUT
- DCA OPTR2
- TAD OUTSIZ
- DCA OCRCNT /DOUBLEWORD COUNT (7377 IF 8K, 6777 IF 12K)
- JMP SETO3 /SET BYTE COUNTER AND RETURN
-OERR, CLA
- TAD ERROR
- DCA OUTR /INHIBIT FUTURE OUTPUT
-ERR14, ERR
-O2, DCA I OPTR1 /NORMAL HANDLING
- ISZ OPTR1 /BUMP POINTER
- JMP I DECPUT
-OPTR1, 0
-OMAXLN, 0 /SIZE OF HOLE FOR OUTPUT
-OUTSIZ, 7377 /6777
-O3, 0
- FITS, 0 /SUBROUTINE TO CHECK FOR OUTPUT OVERFLOW
- TAD OPTR1 /** AC MAY CONTAIN FUDGE ON INPUT **
- CIA
- TAD BUFOUT /COMPUTE NUMBER OF WORDS IN BUFFER
- AND [7400 /ROUND "UP" TO NEXT BUFFERLOAD
- CIA /MAKE POSITIVE
- CLL CML RAR
- DCA OUCTRL /AND SAVE IT AS A BUFFER CONTROL WORD
- TAD OUCTRL
- CLL RAL
- CLL RTL /ISOLATE THE BLOCK COUNT OF THE CONTROL WORD
- RTL /IN THE LOW ORDER PART OF THE AC
- RAL
- TAD OCNT /ADD IT TO THE CURRENT OUTPUT COUNT
- CLL CML
- TAD OMAXLN /SEE THAT WE DIDN'T OVERFLOW
- SNL SZA /THE ASSIGNED OUTPUT AREA
- JMP I FITS /OOPS - WE DID - ERROR RETURN
- CIA
- TAD OMAXLN /SUBTRACT OFF THE LIMIT
- CIA /TO ARRIVE AT THE UPDATED BLOCK COUNT
- ISZ FITS
- JMP I FITS /AND SKIP RETURN
-OUNAM, ZBLOCK 4 /NAME OF OPEN OUTPUT FILE GOES HERE
- PAGE
- /DISPLAY ROUTINE FOR PDP-12 SCOPE
-
-WASTE, 0 /** MUST BE AT MULTIPLE OF 2000
-XPOS, 0 /PDP-12 BETA REGISTER 1
-BETA2, 0 /PDP-12 BETA REGISTER 2
-
-DSPLAY, 0 /TEXT DISPLAY ROUTINE FOR TECO
- MTHREE /THIS ROUTINE DEPENDS ON THE FACT THAT THE
- TAD DSPLAY /HIGH ORDER BITS OF THE X-COORD ARE IGNORED
- DCA DX /BY THE VR12 HARDWARE
- TAD I DX /GET THE SKIP
- DCA DLPTST /PUT IT IN THE LOOP
- TAD P
- DCA DX
- TAD NUMLNS
- STL CIA /LOOK BACKWARD
- PUSHJ /FOR BEGINNING OF DISPLAY AREA
- CHRL1
-D360, STA STL /=7360
- TAD P
- DCA DM
- TAD DX
- DCA P /RESTORE POSITION
- TAD NUMLNS /NOW SCAN FORWARD
- CLL IAC
- PUSHJ /FOR THE END OF THE DISPLAY AREA
- CHRL1
- TAD P
- CIA
- TAD DM
- DCA R /*K* THIS NUMBER MUST GO IN R -
- TAD DX /THE ^W COMMAND NEEDS IT THERE
- DCA P /RESTORE ORIGINAL P
-DSETUP, TAD P
- CIA
- TAD DM
- DCA DQ /SAVE COUNT OF CHARS TO CURSOR POSITION
- TAD DM
- DCA DX
- TAD R
- DCA DR
- TAD D360
- DCA YPOS
-DISCR, TAD DISLF
-SETXPS, DCA XPOS /SET X POSITION/COLUMN COUNTER
- JMP DLPTST
- /DISPLAY LOOP
-
-DGETCH, CDF 10
- TAD I DX
- CDF 0 /GET THE CHARACTER FROM FIELD 1
- AND [177 /AND OFF THE HIGH ORDER BITS
- TAD (-33
- SNA /CHANGE ALTMODES
- TAD CAHT /TO DOLLAR SIGNS
- TAD (-5
- SMA SZA /IF NOT A CONTXRACTER
- JMP DLOOP /DISPLAY IT AND KEEP GOING
- SNA
- JMP DBLANK /DO BLANKS FAST
- TAD (40-15
- SNA /CR?
- JMP DISCR /YES - RESET X COORD
- STL
- TAD [4
- SNA /TAB?
- JMP DTABB
- SNL
- JMP DISLF /LINE FEED, VERTICAL TAB, OR FORM FEED
- TAD (51 /ORDINARY CONTROL CHAR - RESTORE IT + 40
- DCA WASTE /SAVE CHAR
- JMS DISCHR /DISPLAY ^
- TAD WASTE /NOW DISPLAY ALTERED CHAR
-DLOOP, JMS DISCHR
-
-DLPTST, HLT /EITHER KSF OR TSF OR "ISZ R"
- SKP
- JMP I DSPLAY /EXIT IMMEDIATELY IF TEST SKIPS
- ISZ DQ /ARE WE AT THE CURRENT POINTER POSITION?
- JMP TSTEDS /NO
- TAD (-5
- TAD XPOS
- DCA XPOS /BACK UP X POSITION A HALF-CHARACTER
- TAD DM20
- TAD YPOS
- 6141 /ENTER LINC MODE
-DM20, 1760 /DSC I
- 2000
- 1760 /DISPLAY A ^
- 2076
- 0002 /PDP
- MTHREE /AND MOVE X POSITION BACK TO WHERE IT WAS
- JMP DBLANK+1
-TSTEDS, ISZ DR /ARE WE THROUGH?
- JMP DGETCH /NO
- JMP DSETUP /YES - START OVER
- DTABB, TAD XPOS /DISPLAY TAB
- CMA
- AND Z7
- DCA WASTE /GET NUMBER OF COLUMNS TO GO (-1)
- TAD WASTE
- CLL RTL
- RAL
- TAD WASTE /MULTIPLY BY 9
-DBLANK, TAD CAHT /BUMP ONE MORE COLUMN
- TAD XPOS
- SZA /OVERFLOW?
- JMP SETXPS /NO - SET XPOS AND CONTINUE
- JMP LINOFL /YES - GO TO THE NEXT LINE
-
-/SUBROUTINE TO DISPLAY A CHARACTER
-
-DISCHR, DLPTST /*K* DISCHR MUST CONTAIN "DLPTST" WHEN WE
- CLL RAL /ARE EXAMINING CHARACTERS **
- TAD (DTABLE-1
- DCA BETA2 /STORE ADDRESS OF TABLE ENTRY FOR CHAR -1
- TAD YPOS
-
- 6141 /ENTER LINC MODE
- 1762 /DSC I 2
- 1762 /DSC I 2
- 0002 /RE-ENTER PDP-8 MODE
-
- CLA
- ISZ XPOS /BUMP THE X COORDINATE/COLUMN COUNTER
- JMP I DISCHR /RETURN
-LINOFL, TAD (7054 /INDENT ALL CONTINUATION LINES
- DCA XPOS
-DISLF, RAR /*K* RAR=7010 AC MAY HAVE A SMALL NUMBER
- TAD YPOS /IN IT HERE - THATS OK AS LONG AS ITS SMALL,
- TAD [-40 /SINCE ONLY THE HIGH 8 BITS OF YPOS COUNT.
- DCA YPOS
- JMP I DISCHR /*K* THIS ALWAYS RETURNS TO DLPTST **
-
-YPOS= NAME /USE SOME FREE PAGE ZERO LOCATIONS
-DR= NAME+1 /FOR OUR TEMPORARIES
-DQ= NAME+2
-DM= NAME+3
- PAGE
- DTABLE, 2000;2076; 7500;0000; 7000;0070; 7714;1477
- 5721;4671; 6661;4333; 5166;0526; 0000;0070
- 3600;0041; 4100;0036; 2050;0050; 0404;0437
- 0500;0006; 0404;0404; 0001;0000; 0601;4030
- 4536;3651; 2101;0177; 4523;2151; 4122;2651
- 2414;0477; 5172;0651; 1506;4225; 4443;6050
- 5126;2651; 5122;3651; 2200;0000; 4601;0000
- 1000;4224; 1212;1212; 2442;0010; 4020;2055
- 4077;5751; 4477;7744; 5177;2651; 4136;2241
- 4177;3641; 4577;4145; 4477;4044; 4136;2645
- 1077;7710; 7741;0041; 4142;4076; 1077;4324
- 0177;0301; 3077;7730; 3077;7706; 4177;7741
- 4477;3044; 4276;0376; 4477;3146; 5121;4651
- 4040;4077; 0177;7701; 0176;7402; 0677;7701
- 1463;6314; 0770;7007; 4543;6151; 4177;0000
- 3040;0106; 0000;7741; 2000;2076; 1604;0404
- STABLE, ZBLOCK 40 /SEARCH BUFFER
-
-CTLW, NCHK /^W COMMAND - IF THERE WAS A NUMBER BEFORE
- JMP CTLW2 /THE ^W, SET THE NUMBER OF LINES TO DISPLAY
- TAD N /EQUAL TO THAT NUMBER.
- DCA NUMLNS
- /DON'T WORRY ABOUT NEGATIVE N
-CTLW2, ISZ R /FAKE OUT! (MUST BE BEFORE CALL TO DISPLY)
- DISPLY /IN ANY CASE, GO THROUGH ONE DISPLAY CYCLE
- POPJ /THEN RETURN
-
-SAVTRA, 0 /SAVE TRACE MODE
- TAD TFLG
- DCA TFGTMP
- DCA TFLG
- JMP I SAVTRA /EXIT WITH TRACE OFF
-
-RESTRA, 0 /RESTORE TRACE MODE
- TAD TFGTMP
- DCA TFLG
- JMP I RESTRA
-TFGTMP, 0
-
-CHKQF, 0 /CHECK FOR EXPLICIT QUOTES
- ISZ QFLG /QUOTE FLAG SET?
- JMP .+3 /NO
- SCAN /GET QUOTING CHAR
- DCA QUOTE /PUT INTO SEARCH TABLE
- DCA QFLG /ZAP QUOTE FLAG
- JMP I CHKQF /RETURN
- NXTBUF, 0
- SZA CLA
- JMP NOWRIT /READ-ONLY IF AC NOT 0 ON ENTRY
- PUSHJ
- CPOC /HP
- DCA ZZ /FORCE Y TO WORK
- ISZ FFFLAG /IF WE DIDN'T SEE A FORM FEED ON INPUT
- JMP NOWRIT /DON'T OUTPUT ONE
- TAD CAFF
- OUTPUT
-NOWRIT, PUSHJ
- CHRY /READ NEW BUFFER
- CTCCHK /CHECK FOR ^C AND ^P
- CLA /*K* CTCCHK LEAVES AC NON-ZERO!
- JMP I NXTBUF
-
-GETUSR, 0 /ROUTINE TO LOCK THE USR INTO CORE
- CDF 0
- TAD ZZ /IF THE TEXT BUFFER IS EMPTY AND
- SNA CLA /WE HAVE 12K, SO Q-REGS ARE IN FIELD 2,
-NWRUSR, NOP /(CHANGED BY INIT CODE TO "TAD [4" IF 12K)
- STL RTR /THEN WE SHOULD NOT SAVE CORE ON A USR CALL.
- DCA I (JSBITS /THIS STORES A 2000 OR A 2001
- CIF 10
- JMS I [7700 /OK - NOW LOAD THE USR IN
- 10
- JMP I GETUSR
- /E COMMAND MODIFIERS
-
-EFLST, 102 /EB I
- 103 /EC X
- 106 /EF X
- 107 /EG X
- 113 /EK X
- 122 /ER I
- 127 /EW I
- 130 /EX I
-
-CHRU, QREF /COMMAND U
- NCHK
-ERR22, ERR /U MUST BE PRECEDED BY A NUMBER
- TAD NLINK
- CLL RTR
- DCA NLINK
- AC3777
- AND I QPTR
- TAD NLINK
- DCA I QPTR
- ISZ QPTR
- TAD N
- DCA I QPTR
- POPJ
-
-/RADIX TABLES:
-
-ORAD, NOP
- 1000
- 100
- 10
-DRAD, NP&177+1200 /"TAD NP"
- 1750
- 144
- 12
- /DISPATCH TABLE FOR COMMAND INPUT
-
-COMTAB, TBEL /^G
- TCRLF /CR
-RUBY, ROCMND /RUBOUT
- TCTLU /^U
- TALTM /ALTMODE
- TQMK /?
- TSAVE /^S
- TSTAR /*
- TSPACE /SPACE
-
-EDFLAG, 0 /MUST BE KEPT TOGETHER
-EHFLAG, 0
-EOFLAG, VERSN
-ESFLAG, 0
-ETFLAG, 0
-EUFLAG, 0
-/CXFLAG, 0
- PAGE
- /COMMAND M
-/AND Q-REGISTER STORAGE
-COMLST, 7 /^G, COMMAND LINE EDIT LIST
- 15 /CR, INSERT CR & LF
- 177 /RUBOUT
- 25 /^U - RUB OUT LINE
- 33 /^[, ALT MODE
- 77 /?
- 23 /^S - SAVE OLD COMMAND LINE IN Q-REG Z
- 52 /*
- 40 /SPACE
-
-CHRM, QREF /COMMAND M
- TAD M4 /4 ITEMS PUSHED TO
- PUSHL /SAVE CURRENT MACRO STATE
- QCMND
- MPDL
- ITRST /SO THE "O" COMMAND WILL WORK IN MACROS
- SCANP /ZEROED BY "PUSHL"
- TAD PDLP /MUST CHECK PDL AT END OF MACRO
- CIA
- DCA MPDL
- TAD QNMBR /Q-REGISTER TO EXECUTE
- SETCMD /SET COMMAND LINE TO THIS Q-REG
- POPJ /LEAVE NUMBER FLAG ALONE AND EXIT
-
-CHKBZ, 0 /SEE THAT B .LE. C(AC) .LE. ZZ
- SZL
- JMP ERR11 /POP
- CIA /ENTERED WITH LINK SET CORRECTLY
- TAD ZZ
- SNL /13-BIT ARITHMETIC
-ERR11, ERR /C(AC)>ZZ
- CIA
- TAD ZZ /RESTORE ORIGINAL AC
- JMP I CHKBZ
-
-ALTLST, 175 /ALT MODE
- 176 /ANOTHER ALTMODE
-M4, -4
- SCUPPR, 0 /SCAN AND CONVERT TO UPPER CASE
- SCAN
- UPPERC
- JMP I SCUPPR /THAT'S ALL?
-
-/Q-REGISTER STORAGE - EACH Q-REGISTER TAKES 2 WORDS.
-/WD 1 CONTAINS THE LENGTH OF THE CHARACTER PART OF THE REGISTER (IF ANY)
-/WD 2 CONTAINS THE VALUE OF THE NUMERIC PART OF THE REGISTER (IF ANY)
-
-QARRAY, ZBLOCK 110 /36 Q-REGISTERS * 2 WORDS/REGISTER = 72 WORDS
-QPNTR, CHNSTR /FAKE Q-REGISTER FOR INPUT LINE - LENGTH ONLY.
- CTLT, NCHK
- JMP CTLT2 /NO ARG
- TAD N
-ET1, TYPE /TYPE CHAR REPRESENTED BY ARGUMENT
- POPJ
-CTLT2, LISTEN /^T COMMAND - VALUE OF NEXT CHAR FROM TTY
-ET8, TYPE /*ET ECHO THE CHARACTER
- TAD SCHAR /GET THE CHARACTER
- JMP I (NCOM14 /JUMP INTO NUMBER PROCESSOR
-
-CTLE, TAD FFFLAG /^E COMMAND - RETURNS FORM FEED FLAG
-NNEW13, CLL
- SPA
- STL /EXTEND SIGN BIT TO LINK
- JMP I (NCOM /RETURN -1 IF F.F., 0 OTHERWISE
- PAGE
- *5000
-
-/COMMAND DISPATCH TABLE ** ALLOW EVEN/ODD FOR NOVICE SUBSET?
-
-CDSP, POPK;CTLA;SERR;CTLC;CTLD;CTLE;CTLF;CTLC /0-7
- CTLH;CTLI;POPK;SERR;POPK;POPK;CTLN;CTLO /10-17
- T0;SERR;SERR;SERR;CTLT;CTLU;ERR35;ERR27 /20-27
- SERR;SERR;SERR;ZRON;SERR;SERR;CTUA;SERR /30-37
- POPK;CEXP;CDBQ;CNBS;SERR;CPCS;CAMP;ZRON /40-47
- COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR /50-57
- NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR /60-67
- NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM /70-77
- CATS;CHRA;CHRB;CHRC;CHRD;CHRE;CHRF;CHRG /100-107
- CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO /110-117
- CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;SERR;SERR /120-127
- CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA /130-137
- /END OF DISPATCH TABLE
-
-PDLBEG, ZBLOCK 11 /BEGINNING OF PUSHDOWN LIST
-QPUT12, ZBLOCK 16 /ROUTINES INSERTED LATER - USED IN
-ASR35, ZBLOCK 10 /INITIALIZATION, OVERLAYED BY PUSHDOWN LIST
-PDLEND, 0 /END OF PUSHDOWN LIST
- PAGE
- *5200
-
-/ INITIALIZATION SECTION
-/ ENTER HERE AT 5200 TO MODIFY TECO TO USE A MODEL 35 TELETYPE
-/ SORRY - NO CURRENT PAGE LITERALS
-
-TECO35, ISZ JTECO /IF CALLED VIA "R" OR "RUN"
- TAD I XR /MOVE ASR-35 PATCH (WHICH OUTPUTS TABS AND
- DCA I INXR / FORM FEEDS) OVER PRINT ROUTINE
- ISZ ASRCNT
- JMP .-3
- TAD YOUTHTX
- DCA I YPOUTHT
- TAD [TECO
- DCA I Y7745 /CHANGE STARTING ADDRESS IN CASE WE'RE RESTARTED
- /AND FALL INTO INITIALIZATION ROUTINE
-
-TCINIT, TLS /INITIALIZATION ROUTINE - INITIALIZE THE TTY
- TAD .-1
- DCA I [TECO
- TAD YT0A /"JMP T0A"
- DCA I PTECO1 /CHANGE THE ENTRY AT 200 SO WE'RE NOT CALLED AGAIN
- CLA STL
- 6141 /ENTER LINC MODE (MAYBE)
- 4 /ESF - SET SMALL CHARACTERS FOR SCOPE
- 0261 /ROL I 1 - ROTATE LINK INTO AC11
- 0002 /BACK TO PDP-8 MODE
- SNA CLA /AC NON-ZERO IF WE ARE A PDP-12
- JMP NOTA12 /NO, JUST AN ORDINARY 8
- TAD YPDP12
- JMS CHANGE /TRADE OFF TWO PAGE HANDLERS FOR A SCOPE
-NOTA12, TAD I Y7777
- AND COR70
- SZA
- JMP SOFCOR
-COR0, CDF 0 /NEEDED FOR PDP-8L
- TAD CORSIZ /GET FIELD TO TEST
- RTL
- RAL
- AND COR70 /MASK USEFUL BITS
- TAD COREX
- DCA .+1 /SET UP CDF TO FIELD
-COR1, CDF /N /N IS FIELD TO TEST
- TAD I CORLOC /SAVE CURRENT CONTENTS
-COR2, NOP /HACK FOR PDP-8!
- DCA COR1
- TAD COR2 /7000 IS A "GOOD" PATTERN
- DCA I CORLOC
-COR70, 70 /HACK FOR PDP-8, NOP
- TAD I CORLOC /TRY TO READ BACK 7000
-CORX, 7400 /HACK FOR PDP-8, NOP
- TAD CORX /GUARD AGAINST WRAP-AROUND
- TAD CORV /TAD (1400
- SZA CLA
- JMP COREX /NON-EXISTENT FIELD EXIT
- TAD COR1 /RESTORE CONTENTS DESTROYED
- DCA I CORLOC
- ISZ CORSIZ /TRY NEXT HIGHER FIELD
- JMP COR0
-
-COREX, CDF 0 /LEAVE WITH DATA FIELD 0
- STA
- TAD CORSIZ /HIGHEST EXISTING FIELD
-COR999, DCA MEMSIZ
- TAD MEMSIZ
- SNA CLA
- JMP JTECOM /8K
- TAD YM7 /MORE THAN 8K
- JMS I YMOVE
- CDF 0
- QPUT12-1
- CDF 0
- QPUTS-1
- TAD YM7
- JMS I YMOVE
- CDF 0
- QPUT12+7-1
- CDF 0
- GETQX-1
- TAD YTWLVEK
- JMS CHANGE /AND CHANGE A WHOLE MESS OF LOCATIONS
-JTECOM, JMS I YOVINIT /WRITE OUT OVERLAYS
- CDF 10
- TAD I YSCPBIT
- CDF 0
- AND [200
- SNA CLA
- JMP JTECO
- TAD YSCOPE
- JMS CHANGE
-JTECO, JMP I .+1 /INCREMENTED IF WE WERE'NT CHAINED TO
- CHINIL
-PTECO1, TECO1
-
-CORLOC, CORX /ADDRESS TO TEST IN EACH FIELD
-CORV, 1400 /7000+7400+1400=0
-CORSIZ, 1 /CURRENT FIELD TO TEST
-
-SOFCOR, CLL RAR
- RTR
- JMP COR999
- /CHAINED INIT CODE - MOVE 17600 INTO Q-REGISTER SPACE
-
-CHINIL, CDF 10
- TAD I DX /GET A COMMAND LINE CHAR
- CDF 0
- QPUT
- ISZ INICT
- JMP CHINIL
- TAD YFATALJ /SET UP THE FATAL ERROR EXIT
- DCA I YCHOOPS /IN THE ERROR ROUTINE
- JMP I YCHTECO
-INICT, -CHNSTR
-
-ASRCNT,
-CHANGE, -10 /ROUTINE TO CHANGE SPECIFIC LOCATIONS
- DCA XR /STORE TABLE POINTER
-CHANGL, TAD I XR /GET LOCATION
- SNA
- JMP I CHANGE /END OF LIST - RETURN
- DCA TEMPT
- TAD I XR /GET CONTENTS
- DCA I TEMPT /ZAP!
- JMP CHANGL
-
-/CHECK FOR OS/8 SCOPE BIT, IF ON, PATCH TECO
-/ALSO SEND ESC SEQ TO TERMINAL TO SEE IF VT05 OR VT5X.
-
-
-YOUTHTX, OUTHTX
-YPOUTHT,POUTHT
-Y7745, 7745
-Y7777, 7777
-YM7, -7
-YMOVE, MOVE
-YOVINIT,OVINIT
-YSCPBIT,SCPBIT
-YFATALJ,FATALJ
-YCHOOPS,CHOOPS
-YCHTECO,CHTECO
-YPDP12, PDP12-1
-YTWLVEK,TWLVEK-1
-YSCOPE, SCOPE-1
-YT0A, T0A&177+5200
-/FLOW INTO NEXT PAGE
- SCOPE, RUBY; SCOPY /MAKE SCOPE RUBOUTS WORK
- BLSP1; TAD CACR /MAKE BELL SPACE WORK
- BLSP2; TYPE /AND MORE RUBOUTS
- BLSP3; SCAPE&177+4600 /JMS I (ESCAPE
- BLSP4; 113 /MORE BELL SPACE
- EUFLAG; -1 /SET EU TO -1
- EU1; CLA
- EU2; TAD [40
- 0
- /LOCATIONS TO CHANGE MUST BE CHANGED IN OVERLAY IMAGE
-/BEFORE OVERLAY IS WRITTEN OUT
-
-/LOCATIONS TO CHANGE IF WE HAVE 12K OF CORE
-
-TWLVEK, INRSIZ; 4 /INPUT BUFFER GROWS TO 4 BLOCKS LONG
- INCTLW; 1021 /AND LIVES IN FIELD 2
- INPCNT; 5000
- I2; CDF 20
- IC; CDF 0 /THIS WAS A NOP TO SPEED UP RTS-8 OPERATION
- L12K1; J12K1 /SPEED UP TEXT MOVE ROUTINES,
- L12K2; J12K2 /SINCE Q-REGISTERS DON'T SIT ON TOP OF TEXT.
- OUTSIZ; 6777 /OUTPUT BUFFER TAKES OVER OLD INPUT BUFFER SPACE
- BUFIN; 5600
- NWRUSR; TAD [4 /LET USR BE CALLED WITHOUT SAVING CORE
- MQMAX; -Q12MAX /ALLOW MORE Q-REGISTER STORAGE
- QLIMIT; 12-Q12MAX
- 0
-
-
-/LOCATIONS TO CHANGE IF WE'RE RUNNING ON A PDP-12
-
-PDP12, KSFWT; DISPLY /FIX KEYBOARD AND PRINTER WAITS
- TSFWT; DISPLY /SO THEY DISPLAY WHILE WAITING
- CDSP+127;CTLW /ENABLE W COMMAND
- INHNDL; 7200 /ONE PAGE INPUT HANDLER ONLY
- OUHNDL; 7400 /DITTO OUTPUT HANDLER
- /VALUE MUST BE 0 INITIALLY TO END LIST
-OVINIT, 0 /WRITE OUT OVERLAYS
-/IF MORE THAN 12K, MOVE OVERLAYS TO FIELD 3
- MTHREE
- TAD MEMSIZ
- SPA CLA
- JMP L16K /LESS THAN 16K
- TAD [-400
- JMS MOVE
- CDF 0
- 3200-1
- CDF 30
- MEMLOC-1
- TAD M2000
- JMS MOVE
- CDF 0
- 5600-1
- CDF 30
- MEMLOC+400-1
- TAD M5
- JMS MOVE
- CDF 10
- NEWERR-1
- CDF 0
- OVREAD-1
-/ TAD (COREAD-COREND-1
- TAD M3000
- JMS MOVE
- CDF 10
- 4400-1 / COREAD-1
- CDF 30
- 4400-1
- JMP G16K
-L16K, JMS I (7607
- 4200
- 3200 /WRITE OUT I/O-OVERLAY
- IOVRLC
- JMP OVERR /ERROR WRITING OVERLAY
-M3000, JMS I (7607
- 5400 /4 OVERLAYS
- 5600 /WRITE OUT Q-OVERLAY AND E-OVERLAY
- QOVRLC
- JMP OVERR /ERROR WRITING OUT OVERLAY
-G16K, DCA I (ERRXX
- JMP I OVINIT /RETURN
-
-OVERR, TAD [-400 /SWAP IN ERROR OVERLAY FROM CORE AND MAKE SURE
- JMS MOVE /WE RETURN TO MONITOR
- CDF 0
- 6200-1
- CDF 0
- 3200-1
-/ DCA I (ERRTMP /SET FATAL SWITCH
- TAD (FATALJ
- DCA I (CHOOPS
-ERR30, JMP I (ERRYY /CALL ERROR MESSAGE PROCESSOR
-
-M2000, -2000
-M5, -5
- MOVE, 0
- DCA MQ
- TAD I MOVE
- DCA MOVEL
- ISZ MOVE
- TAD I MOVE
- DCA INXR
- ISZ MOVE
- TAD I MOVE
- DCA MOVEC
- ISZ MOVE
- TAD I MOVE
- DCA XR
- ISZ MOVE
-MOVEL, HLT
- TAD I INXR
-MOVEC, HLT
- DCA I XR
- CDF 0
- ISZ MQ
- JMP MOVEL
- JMP I MOVE
- /ROUTINES TO BE (POSSIBLY) SWAPPED INTO TECO
-
- *QPUT12
- RELOC QPUTS
-QPUTS, 0 /12K Q-REGISTER PUT ROUTINE
- AND [377
- CDF 20
- DCA I QP
- CDF 0
- ISZ QP
- JMP I QPUTS
-
- RELOC GETQX
-GETQX, 0 /12K Q-REGISTER GET ROUTINE
- DCA CHKCTC
- CDF 20
- TAD I CHKCTC
- CDF 0
- AND [377
- JMP I GETQX
-
- RELOC ASR33
- JMP OUTCMX / FORM FEED/VERT. TAB - USE 8/4 FILLERS
-OUTHTX, TAD COLCT /GET COLUMN COUNTER
- RTR
- RAR
- CLA CMA RAL /OUTPUT 2 FILLERS IF MORE THAN 4 CHARS TO TAB
- DCA COLCT /OTHERWISE 1 (COLCT IS A MODULO 8 COUNTER)
-OUTCMX, TAD SCHAR /GET CONTROL CHAR TO TYPE
- PUTT /AND TYPE IT - WE WILL NOW FILL WITH NULLS
- RELOC
- PAGE
- / Q-OVERLAY
-
- *5600
-
- RELOC 3200
-
- IOVRLC
-QOVRLY, 0
- EOVRLC
- XOVRLC
- FOVRLC
-
-/O COMMAND
-
-CHROO, TAD SCANP /O COMMAND
- DCA COOQ /SAVE CURRENT SCAN POINTER
- DCA NFLG
-/??? DCA QFLG /QUOTED "O" COMMAND NOT ALLOWED
- QSKP /CHECK THAT THERE IS REALLY A STRING HERE
- /BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS
- /FROM THIS STRING IN THE SEARCH LOOP.
- TAD ITRST /"O" ONLY SCANS FROM THE BEGINNING OF THE
- DCA SCANP /CURRENT ITERATION LOOP.
- /(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN)
- SKPSET
-CS41, 41 /SEARCH FOR !
- TAD CS41
- DCA QUOTE /SET QUOTE CHAR TO !
- TAD COOQ
- TAD QBASE
- DCA QP /SET UP PTR TO ACCESS GOTO STRING
-COOC, TAD QP
- GETQ /GET CHAR FROM GOTO STRING
- CIA
- DCA MQ /SAVE IT
- QUOTST /GET CHAR FROM LABEL
- JMP COOB /LABEL EXHAUSTED
- TAD MQ
- SZA CLA /MATCH?
- JMP CSMQ /NO - REJOIN SEARCH ROUTINE FOR ANOTHER !
- ISZ QP
- JMP COOC
-COOB, TAD MQ
- TAD CAAM /IS GOTO STRING EXHAUSTED TOO?
- SZA CLA
- JMP CSMQ+1 /NO - REJOIN ! SEARCH ROUTINE
- ENTRCE /RE-ENABLE TRACE
- JMP I [IREST
-COOQ, 0
- /ROUTINE TO SKIP COMMANDS UP TO A CHARACTER
-
-SETSKP, 0 /SET UP TO SKIP COMMANDS
- TAD I SETSKP
- DCA SKPLST /CHAR TO TRAP ON
- NOTRCE /DISABLE TRACE MODE
-CSML1, DCA BRACKS /INITIALIZE BRACKET LEVEL
-CSML, SCANUP /GET A COMMAND CHAR
- SORT
- SKPLST
- SKPTAB-SKPLST
- JMP CSML /NOTHING SPECIAL - KEEP GOING
-CSMD, SCAN /CLEAR OUT MODIFIER
- JMP CSML
-
-CSMU, SCAN /SKIP ^U COMMAND
- SKP CLA /GET RID OF Q-REG NUMBER
-CSMFS, QSKP /FS COMMAND - SKIP FIRST STRING
-CSMQ, QSKP /SKIP OVER A QUOTED STRING
-CSMQ1, PUSHJ
- IREST /FIX UP QUOTE CHAR
- JMP CSML /KEEP GOING
-
-CSMY, TAD SCHAR /SKIP ROUTINE FOR ^A AND !
- DCA QUOTE /WE MUST SCAN UNTIL WE FIND
- JMP CSMQ /A COPY OF THE COMMAND CHARACTER.
- /SORT LIST FOR " COMMAND
-
-CNDLST, 103 /C
- 107 /G
- 116 /N
- 114 /L
- 105 /E
- 124 /T
- 123 /S
- 106 /F
- 125 /U
- 122 /R
- 74 /<
- 76 />
-
-CSME, SCANUP /FOUND E COMMAND
- SORT
- ESKLST /LOOK FOR ER & EW & EG
- ESKTAB-ESKLST /USE CSMQ TO SKIP
- JMP CSML /NO STRING
-
-CSMF, SCAN /F COMMAND - BETTER BE FOLLOWED BY S,N, OR _
- CLA
- JMP CSMFS /SCAN OFF TWO STRINGS
-
-CSMI, ISZ BRACKS /INCREMENT BRACKET LEVEL
- JMP CSML
-
-CSMO, STA
- TAD BRACKS /DECREMENT BRACKET LEVEL
- SPA
- JMS I (POPITR /IF WE EXIT <> POP OFF ITERATION VALUES
- JMP CSML1
-
-SKPRTN, TAD BRACKS /WE HAVE FOUND THE DESIRED CHARACTER
- SZA CLA /BUT IF THE BRACKET LEVEL IS NON-ZERO,
- JMP I XSORTA1 /WE CANNOT ACCEPT IT - KEEP SORTING
- JMP I SETSKP /EVERYTHING IS OK - RETURN
-
-BRACKS, 0
- /SORT LIST FOR SKIPPING OVER COMMANDS
-
-SKPLST, 0 /TRAP CHAR
- 41 /!
- 76 />
- 74 /<
- 42 /"
- 136 /^
- 100 /@
- 1 /^A
- 11 /TAB
- 25 /^U
- 36 /^^
- 105 /E
- 106 /F
- 111 /I
- 116 /N
- 117 /O
- 123 /S
- 137 /_
- 121 /Q
- 125 /U
- 130 /X
- 107 /G
- 115 /M
- 45 /%
- / SKIP LIST FOR E'S
-ESKLST, 122 /R
- 127 /W
- 102 /B
- 107 /G
-
-CSMA, STA /LIST TERMINATOR
- JMP CSMQ1 /FOUND @ - SET QUOTE FLAG AND CONTINUE
-
-
-XSORTA1,SORTA1
- PAGE
- /DISPATCH TABLE FOR SKIPPING OVER COMMANDS:
-
-SKPTAB, SKPRTN /DESIRED CHARACTER - RETURN
- CSMY /!
- CSMO />
- CSMI /<
- CNDI /"
- CSMC /^
- CSMA /@
- CSMY /^A
- CSMQ /TAB
- CSMU /^U
- CSMD /^^
- CSME /E
- CSMF /F
-ESKTAB, CSMQ /I OR ER
- CSMQ /N OR EW
- CSMQ /O OR EB
- CSMQ /S OR EG
- CSMQ /_
- CSMD /Q
- CSMD /U
- CSMD /X
- CSMD /G
- CSMD /M
- CSMD /%
- SEMO, SKPSET /PLOD THRU
- 76 /LOOKING FOR >
- ENTRCE /IT'S THE RIGHT ONE, TURN TRACE BACK ON
- JMP I ZCGSG
-ZCGSG, CGSG
-
-CNDTAB, TSTSEP /LEGAL CONSTITUENT OF SYMBOL FOR ASSEMBLER
- SZL SNA CLA /GT 0
- SNA CLA /NE 0
- SNL CLA /LT 0
- SZA CLA /EQ 0
- SNL CLA /TRUE
- SNL CLA /SUCCESSFUL
- SZA CLA /FALSE
- SZA CLA /UNSUCCESSFUL
- TSTSEP /ALPHANUMERIC
- SNL CLA /<
- SZL SNA CLA />
-
-/THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL
- /COMMANDS " AND '
-
-CDBQO, NCHK /COMMAND "
-ERR23, ERR /NO NUMBER TO TEST
- SCANUP
- SORT
- CNDLST
- CNDTAB-CNDLST
- SMA /CHECK THAT CHAR WAS TRANSLATED
-ERR20, ERR /NO - NO SUCH TEST
- DCA SKIP /STORE TEST INSTRUCTION
- GETNUM /PERFORM THE TEST
-SKIP, HLT /TEST SKIPS IF TRUE
- SKP CLA
- POPJ /CONDITION SATISFIED
- STA /NOT SATISFIED
- DCA SKIP /BEGINNING SKIPPING COMMANDS
- SKPSET /CALL SKIPPING ROUTINE
- 47 /FIND A '
- ISZ SKIP /FOUND A '
- RESORT /NEED ANOTHER: BACK TO CSML
- ENTRCE /RE-ENABLE TRACE
- JMP I [IREST /COMMAND ' NO ACTION TO TAKE
-
-CNDI, SCAN /HIT ANOTHER "
- STA /SO SKIP MATCHING '
- TAD SKIP
- DCA SKIP
- RESORT /GO BACK TO CSML
- /COMMANDS ; AND >
-
-CSEMO, TAD ITRST /COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH
- SNA CLA
-ERR09, ERR /IF NOT IN ITERATION
-CSEM2, TAD NLINK
- SNA CLA
- NCHK
- JMP I (ZRON /NO NUMBER - IGNORE IT, WE DID IT ALREADY
- JMP SEMO /SEARCH FOR >
-
-CHGTO, TAD ITRCNT
- SNA CLA
- JMP CGTC /0 MEANS INFINITY
- ISZ ITRCNT /LOOK FOR COUNT EXHAUSTED
- JMP CGTC /NO, CONTINUE
-CGSG, JMS POPITR /POP UP OLD ITERATION PARAMETERS
- JMP I [IREST
-CGTC, TAD ITRST
- SNA
-ERR10, ERR /IF NOT IN ITERATION
- JMP I (ZROSPN /BACK TO ROOT
-
-POPITR, 0
- CLA IAC /** AC NOT NECESSARILY 0 ON ENTRY
- POPL
- ITRCNT
- ITRST
- JMP I POPITR
- CHLTO, MTWO /COMMAND <
- PUSHL
- ITRST
- ITRCNT
- TAD NFLG
- SNA CLA /WAS A NUMBER SPECIFIED?
- JMP INF /NO, ASSUME INFINITY
- TAD NLINK
- SNA CLA
- TAD N
- SNA
- JMP SEMO /0 OR NEGATIVE MEANS SKIP ITERATION
- CIA /MAKE NEGATIVE
-INF, DCA ITRCNT /SET UP TERMINATION
- TAD SCANP /SAVE CURRENT SCAN PNTR
- DCA ITRST /ALWAYS .GE. 1 IN ITERATION
- DCA NFLG /CLEAR NUMBER FLAG
- POPJ
-
-/SHOULD WE TREAT 0<> SPECIAL?
- PAGE
- RELOC
- / ERROR-OVERLAY
-
- *6200
-
- RELOC 3200
-
- IOVRLC
- QOVRLC
-EOVRLY, 0
- XOVRLC
- FOVRLC
-
-ERRYY, DCA N
- TAD (ERLIST-1
- DCA XR
-ERLOOP, ISZ N /BUMP ERROR NUMBER
- TAD I XR
- SZA /END OF LIST?
- TAD I (ERRXX /NO - CHECK FOR MATCH
-Z40, SZA CLA /FOUND WHAT WE WANTED?
- JMP ERLOOP /NO - KEEP LOOKING
- TAD N
- CLL RAL /MULTIPLY BY 2
- TAD (ERBASE-2
- DCA PTR
- TAD I PTR /GET FIRST WORD OF ERR MSG
- SPA CLA
- JMP CTCT /^C TRAP
-ERL2, TAD [77
- TYPE
- TAD I PTR
- RTR
- RTR
- RTR
- JMS I (SIXTYP /TYPE LEFT CHARACTER
- TAD I PTR
- JMS I (SIXTYP /TYPE RIGHT CHARACTER
- ISZ PTR
- TAD I PTR
- RTR
- RTR
- RTR
- JMS I (SIXTYP /TYPE 3RD CHARACTER
- CLA IAC
- AND I (EHFLAG
- SZA CLA
- JMP I (ERRRET
- MTHREE
- TAD MEMSIZ
- SPA CLA
- JMP I (ERRRET /NO LONG ERROR MESSAGE UNLESS 16K OOR MORE
- TAD Z40 /TYPE EXTENDED ERROR MESSAGE
- TYPE
- TAD Z40
- TYPE
-/ TAD Z40
-/ TYPE
- TAD N
- TAD (XERBAS-1
- DCA PTR /GET PTR TO PTR TO ERROR MSG
- CDF 30
- TAD I PTR /GET PTR TO ERROR MESSAGE
- DCA PTR
-XLUP, TAD I PTR
- CDF 0
- SNA
- JMP I (ERRRET
- SPA
- JMS NEGCHR /NEGATIVE CHAR IS FLAG FOR ERRONEOUS CHARACTER
- PUTT
- ISZ PTR
- CDF 30
- JMP XLUP
-
-CTCT, KRS /CTRL/C ERROR MESSAGE
- AND [177 /ISOLATE ^C OR ^P INTO 7-BIT
- TYPE /READ CTRL/C FROM BUFFER
- CRLF /ECHO IT AND CR LF
- TAD I [QPNTR
- SZA CLA
- JMP ERL2 /PRINT XAB ERROR MESSAGE
-/ MTHREE
-/ TAD CHAR /LOOK AT PREVIOUS CHARACTER
-/ SZA CLA
-/ JMP I (ERRRET /ONE ^C DO NOTHING
- JMP I (CTLC /TWO ^C'S, ABORT
- NEGCHR, 0
- CLA
- TAD LASTC
- SORT
- CACR
- ERPTAB-CACR
- SPA
- DCA LASTC /SAVE $ FOR ALTMODE
- CLA
- TAD (""
- PUTT
- TAD LASTC
- AND [7740
- SNA CLA
- JMS WOW /USE CARRET FORM FOR CONTROL CHARS
- TAD LASTC /AC MAY BE NON-0
- PUTT
- TAD (""
- JMP I NEGCHR
-
-WOW, 0
- TAD ("^
- PUTT
- TAD [100
- JMP I WOW
-
-SPY, TAD LASTC
- TAD (-11+CNVTAB
- DCA WOW
- TAD ("<
- PUTT
- TAD I WOW
- RTR
- RTR
- RTR
- JMS I (SIXTYP
- TAD I WOW
- JMS I (SIXTYP
- TAD (">
- JMP I NEGCHR
- PTR, 0
-
- PAGE
- SIXTYP, 0
- AND [137 /IGNORE SIGN BIT OF BYTE
- TAD [40
- AND [77
- TAD [40
- PUTT
- JMP I SIXTYP
- ERLIST, -ERR01-1 /LIST OF POINTERS TO ALL POSSIBLE
- -ERR02-1 /CALLS TO THE ERROR ROUTINE.
- -ERR03-1
- -ERR04-1
- -ERR05-1
- -ERR06-1
- -ERR07-1
- -ERR08-1
- -ERR09-1
- -ERR10-1
- -ERR11-1
- -ERR12-1
- -ERR13-1
- -ERR14-1
- -ERR15-1
- -ERR16-1
- -ERR17-1
- -ERR18-1
- -ERR19-1
- -ERR20-1
- -ERR21-1
- -ERR22-1
- -ERR23-1
- -ERR24-1
- -ERR25-1
- -ERR26-1
- -ERR27-1
-ERR28, -ERR28-1
- -ERR29-1
- -ERR30-1
- -ERR31-1
- -ERR32-1
- -ERR33-1
- -ERR34-1
- -ERR35-1
- 0 /ERROR 36 - UNLABELED ERROR - NAMELY "JMS I OUTR"
- /** MUST BE LAST ERROR MESSAGE
- ERBASE, TEXT /ILL/ /1 ILLEGAL COMMAND
- TEXT /UTC/ /2 UNTERMINATED COMMAND
- TEXT /IQN/ /3 ILLEGAL Q-REGISTER NAME
- TEXT /PDO/ /4 INTERNAL PUSH DOWN OVERFLOW (RECURSION)
- TEXT /MEM/ /5 MEMORY OVERFLOW
- TEXT /STL/ /6 SEARCH STRING TOO LONG
- TEXT /ARG/ /7 ARGUMENT ERROR
- TEXT /IFN/ /8 ILLEGAL FILE NAME
- TEXT /SNI/ /9 SEMICOLON NOT IN ITERATION
- TEXT /BNI/ /10 CLOSE BRACKET NOT IN ITERATION
- TEXT /POP/ /11 POINTER OFF PAGE
- TEXT /QMO/ /12 Q-REGISTER MEMORY OVERFLOW
- TEXT /UTM/ /13 UNTERMINATED MACRO
- TEXT /OUT/ /14 OUTPUT ERROR
- TEXT /INP/ /15 INPUT ERROR
- TEXT /FER/ /16 FILE ERROR
- TEXT /FUL/ /17 OUTPUT COMMAND WOULD HAVE OVERFLOWED
- TEXT /NAY/ /18 NEGATIVE ARGUMENT TO Y
- TEXT /IEC/ /19 ILLEGAL E CHARACTER
- TEXT /IQC/ /20 ILLEGAL " CHARACTER
- TEXT /NAE/ /21 NO ARGUMENT BEFORE =
- TEXT /NAU/ /22 NO ARGUMENT BEFORE U
- TEXT /NAQ/ /23 NO ARGUMENT BEFORE "
- TEXT /SRH/ /24 FAILING SEARCH
- TEXT /NAP/ /25. NEGATIVE OR 0 ARGUMENT TO P
- TEXT /NAC/ /26. NEGATIVE ARGUMENT TO ,
- TEXT /NYI/ /27. ^W NOT IMPLEMENTED
- TEXT /DMY/ /28. NOT USED
- TEXT /NAS/ /29. NEGATIVE OR 0 COUNT TO SEARCH
- TEXT /WLO/ /30. CAN'T WRITE OUT ERROR MESSAGE OVERLAY
- TEXT /IFC/ /31. ILLEGAL F CHARACTER
- TEXT /YCA/ /32. Y COMMAND ABORTED
- TEXT /CCL/ /33. CCL NOT FOUND OR EG TOO BIG
-/ TEXT /XAB/ /34. EXECUTION ABORTED BY ^C
- 7001;0200
- TEXT /NYI/ /35. ^V NOT IMPLEMENTED
- TEXT /NFO/ /36. NO FILE FOR OUTPUT
- CNVTAB, TEXT /HTLFVTFFCR/
- *.-1
-ERPTAB, SPY /CR
- SPY /HT
- 4044 /$
- SPY /FF
- SPY /VT
- SPY /LF
- PAGE
- RELOC
- / X-OVERLAY
-
- *6600
-
- RELOC 3200
-
- IOVRLC
- QOVRLC
- EOVRLC
-XOVRLY, 0
- FOVRLC
-
-CHREX, TAD I (TYI
- SORT
- XLIS
- XTAB-XLIS
- ERR /CAN'T HAPPEN
-
-XLIS, 103 /EC
- 106 /EF
- 107 /EG
- 113 /EK
- 130 /EX
-
- /"EX" AND "EC" COMMANDS
-EXIT, PUSHJ /"EX" COMMAND
- EXITC /CLOSE OUT THE FILES
- JMP I (CTLC /AND GO AWAY
-
-EXITC, TAD OUTR /"EC" COMMAND
- CIA /CHECK FOR OPEN OUTPUT FILE
- TAD ERROR
- SNA CLA
- POPJ /NOPE, EXIT ALREADY
-EXLOOP, JMS I [NXTBUF /GET NEXT BUFFER
- TAD REND
- CIA
- TAD ZZ /CHECK FOR END-OF-FILE AND
- SZA CLA /TEXT BUFFER EMPTY
- JMP EXLOOP /NOT YET
- /ENDFILE PROCESSOR
-ENDFIL, TAD OCRCNT
- CMA /REDUCE THE OUTPUT DOUBLEWORD COUNT
- AND [177 /TO REFLECT ONLY THOSE WORDS REMAINING
- CMA /UNTIL THE NEXT BLOCK BOUNDARY
- DCA OCRCNT
- TAD (7200 /USED TO BE 'DV7200'
- DCA MQ /SET COUNTER FOR ONE BLOCK WORTH OF STUFF
- TAD (32 /^Z END-OF-FILE
- OUTPUT
- ISZ MQ
- JMP .-2 /FILL AT LEAST THE CURRENT BUFFER AND OUTPUT IT
- TAD ODEV /MAKE SURE THE USR KNOWS THE HANDLER
- TAD (OSHNDT-1 /*K* - POINTER INTO
- DCA TY / OS/8 DEVICE RESIDENCY TABLE
- CDF 10
- TAD OUTHND
- DCA I TY /MARK THE HANDLER AS IN CORE
- JMS I (GETUSR /LOCK THE USR INTO CORE
- TAD EBFLG /IS THIS AN EDIT BACKUP?
- SNA CLA
- JMP I (NORMAL /NO, JUST CLOSE FILE
- TAD I (OCNT-1 /YES, LOOKUP OLD FILE TO CHANGE NAME
- DCA TY-1
- CIF 10
- TAD ODEV /INPUT AND OUTPUT ARE ON SAME DEVICE
- JMS I [200
- 2
- OUNAM
-TY, 0 /USELESS LENGTH--USE IT FOR TEMPORARY
- JMP I (NORMAL /ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY
- CDF 10 /ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE
- STA /SO WE COULD FIDDLE WITH IT
- TAD I (17 /FORM POINTER TO DIRECTORY ENTRY
- TAD I (1404
- DCA TY
- TAD (213 /CHANGE EXTENSION TO .BK
- DCA I TY
- TAD I Z7 /DIRECTORY BLOCK IT CAME FROM
- AND Z7
- DCA ACI
- CDF 0
- JMS I OUTHND
- 4210 /WRITE IT BACK OUT
- 1400
-ACI, 0
- JMP .-4 /ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
- JMP I (NORMAL
- XTAB, EXITC /EC
- ENDFIL /EF
- EXITGO /EG
- EKILL /EK
- EXIT /EX
- EKILL, TAD ERROR
- DCA OUTR
- POPJ
- PAGE
- EXITGO, PUSHJ /DO AN EC TO CLOSE OUT FILE
- EXITC
- QCHK /ALLOW @
- DCA STOCD /MAKE REUSABLE IN CASE .START
- TAD (7600
- DCA CDPTR
- TAD (-47 /47 ENTRIES IN CD TABLE
- DCA EGCNT
-EG1, QUOTST
- JMP EG2
- TAD [200 /TURN ON PARITY BIT FOR OS/8
- JMS STOCD
- JMP EG1
-
-STOCD, 0
- ISZ EGCNT
- SKP
-ERR33, ERR /EG ARG TOO BIG
- CDF 10
- DCA I CDPTR
- CDF 0
- ISZ CDPTR
- JMP I STOCD
-
-CDPTR, 7600
-EGCNT, -41
-
-EG2, TAD STOCD
- SNA CLA /ANYTHING IS ARG
- JMP REGEG /NO
- JMS STOCD /STORE 0 AT END
- JMS I (GETUSR
- TAD (CCLNAM
- DCA ARG1 /JUST IN CASE PREVIOUS EG FAILED
- CLA IAC /SYS
- CIF 10
- JMS I [200
- 2 /LOOKUP
-ARG1, CCLNAM
- 0
- JMP CCLERR
- TAD (2001
- DCA I (JSBITS /KEEP USR IN CORE
- TAD ARG1
- DCA CHNBLK
- CIF 10
- JMS I [200
- 6 /CHAIN
-CHNBLK, 0
- CCLERR, PUSHJ
- ECDISM
- JMP ERR33
-
-CCLNAM, FILENAME CCL.SV
- REGEG, /EDIT AND GO - A CCL SPECIAL
- JMS I (7607 /CALL THE OS/8 SYSTEM HANDLER
- 0200 /TO READ IN THE CCL OVERLAY
- CCLADR
- CCLOVL
- JMP ERR33 /ERROR ON SYSTEM DEVICE!
- JMP I .+1 /GO TO THE OVERLAY
- CCLOST /AT OUR "SPECIAL" LOCATION
- RELOC
- / F-OVERLAY
-
- *7200
-
- RELOC 3200
-
- IOVRLC
- QOVRLC
- EOVRLC
- XOVRLC
-FOVRLY, 0
-
-CHRED, TAD I (TYI
- SORT
- DLIS
- DTAB2-DLIS /CHECK FOR LEGALITY
-ERR19, ERR /BAD CHAR AFTER E
-DTOK, TAD I (TYI
- SORT
- DLIS
- DTAB-DLIS
- DCA XXFLAG
- NCHK /ANY ARGUMENT?
- JMP XXNO /NO, RETURN VALUE
- TAD N /YES
- DCA I XXFLAG /SET NEW VALUE
- TAD XXFLAG
- TAD (-EDFLAG+XXSUBS
- DCA XXSUB
- TAD I XXSUB
- DCA XXSUB
- JMS I XXSUB /CALL IT
- POPJ /RETURN
-XXNO, TAD I XXFLAG /GET VALUE
- JMP I (NNEW13 /MAKE NEW 13-BIT VALUE
-
-DLIS, 104 /ED
- 110 /EH
- 117 /EO
- 123 /ES
- 124 /ET
- 125 /EU
-DTAB, EDFLAG /MUST BE NEGATIVE
- EHFLAG /TO CAUSE SUBSTITUTION
- EOFLAG
- ESFLAG
- ETFLAG
- EUFLAG
- XXFLAG, 0 /POINTS TO FLAG IN MEMORY ABOVE 4000
-
-DTAB2, DTOK
- DTOK
- DTOK
- DTOK
- DTOK
- DTOK
-
-XXSUB, 0
- / MASK;SKIP;LOC;VALUE IF SKIPS;VALUE IF NO SKIP
-
-EUSUB, 0
- JMS FIXUP
- 7777; SMA CLA; EU1; CLA; SNA CLA
- 7777; SPA SNA CLA; EU2; TAD [40;NOP
- 0
- JMP I EUSUB
-
-ETSUB, 0
- JMS FIXUP
- 1; SNA CLA; KTYPE; PUTT; TYPE
- 1; SNA CLA; ET1; PUTT; TYPE
- 10; SNA CLA; ET8; CLA; TYPE
- 0
- JMP I ETSUB
-
- LOC, 0
-MASK, 0
-
-FIXUP, 0
-FIXLUP, TAD I FIXUP
- SNA
- JMP I FIXUP /DONE, RETURN TO 0
- DCA MASK /SAVE MASK
- ISZ FIXUP
- TAD I FIXUP
- DCA SKIPY /SAVE SKIP CONDITION
- ISZ FIXUP
- TAD I FIXUP
- DCA LOC /SAVE LOC TO CHANGE
- ISZ FIXUP
- TAD I XXFLAG /LOOK AT FLAG
- AND MASK /'AND' WITH MASK
-SKIPY, HLT
- JMP SKPF
- TAD I FIXUP
- DCA I LOC
- ISZ FIXUP
-SKPT, ISZ FIXUP
- JMP FIXLUP
-SKPF, ISZ FIXUP
- TAD I FIXUP
- DCA I LOC
- JMP SKPT
- CTLUO, QREF /COMMAND ^U
- QSKP /COUNT UP STRING
- TAD OSCANP
- CMA
- TAD SCANP /LENGTH OF STRING
-/
-/ *** PROHIBIT STRING > 2047 CHARS
-/
- ADJQ /ADJUST Q-REGISTERS AND SET NEW LENGTH
- TAD OSCANP /RESET SCAN POINTER
- DCA SCANP
- DCA NFLG
- NOTRCE
-CCUB, QUOTST
- JMP CTLUND
- QPUT
- JMP CCUB
-CTLUND, ENTRCE
- JMP I [IREST
- PAGE
- /NUMERICAL OUTPUT ROUTINE
-
-ZEROD, 0
- DCA ZERFLG /INITIALIZE "LEADING ZEROS" FLAG
- TAD I ZEROD
- ISZ ZEROD
- DCA OUTDEV /SAVE OUTPUT ROUTINE ADDRESS
- TAD NLINK /POS OR NEGATIVE?
- SNA CLA
- JMP ZER2 /POSITIVE
- TAD RADIX
- TAD (-ORAD
- SNA CLA
- JMP PUTSGN /OCTAL
- TAD N /DECIMAL
- CIA
- DCA N /NEGATE
- SKP
-PUTSGN, TAD ["1-"-
- TAD ("-
- JMS I OUTDEV /OUTPUT MINUS SIGN
-ZER2, MTHREE
- DCA ZCOUNT /ITERATION COUNT
- TAD RADIX
- DCA RXR
-ZDIGIT, ISZ RXR
- TAD I RXR
- DCA DIV1 /GET DIVISOR
- TAD N
- MQLDVI /DIVIDE BY A POWER OF THE BASE
-DIV1, 0
- TAD ZERFLG
- SNA
- JMP LZ /IGNORE LEADING ZEROS
- TAD (60
- JMS I OUTDEV
- STL RAR
- DCA ZERFLG /SET LEADING ZEROS FLAG
-LZ, TAD DVT1 /GET REMAINDER
- DCA N
- ISZ ZCOUNT /GO AROUND AGAIN?
- JMP ZDIGIT /WHY NOT?
- TAD N
- TAD (60
- JMS I OUTDEV /OUTPUT LAST DIGIT NO MATTER WHAT
- JMP I ZEROD
-
-OUTDEV, 0 /WHERE WE'RE SENDING THE DIGITS
-ZERFLG, 0
-ZCOUNT, 0
-RXR, 0
- /COMMANDS = AND \
-
-/COMMANDS = AND \ - NUMERICAL OUTPUT
-
-CEQLO, NCHK /COMMAND =
-ERR21, ERR /NO NUMBER
- TAD RADIX
- DCA RADTMP
- JMS I (POKE /LOOK AHEAD ONE CHARACTER
- TAD (-75 /CHECK FOR = SIGN
- SZA CLA
- JMP SETRAD /SINGLE =
- SCAN /DOUBLE = (PASS UP SECOND ONE)
- SKP CLA /CLEAR AC
-SETRAD, TAD [4
- TAD (ORAD
- DCA RADIX /SET OCTAL RADIX TEMPORARILY
- JMS ZEROD
- TPUT
- TAD RADTMP
- DCA RADIX /RESTORE ORIGINAL RADIX
- ISZ CLNF /: SEEN?
- CRLF /NO, END WITH CRLF
- DCA CLNF
- POPJ
-
-CBSLO, NCHK /COMMAND \
- JMP CBSN
- JMS ZEROD
- UPOC
- POPJ
-
-RADTMP, 0
- CBSN, PUSHJ
- NMBR2 /INITIALIZE RESULT TO 0
- JMS PTCH
- TAD I P
- AND [377 /GET CURRENT CHARACTER
- CDF 0
- TAD (-55 /CHECK FOR MINUS SIGN
- SZA
- JMP .+3 /NOT MINUS
- PUSHJ
- CMIN /RECORD MINUS SIGN
- CIA
- CLL RTR
- SNA CLA /CHECK FOR PLUS SIGN
-CBSNP, ISZ P /BUMP POINTER PAST SIGN
- JMS PTCH
- TAD I P /GET A CHAR
- AND [377
- CDF 0
- TAD (-72
- CLL
- TAD CALF
- SNL /IS IT A DIGIT?
- POPJ /NO
- PUSHJ
- NMBR2 /YES - ACCUMULATE IT
- JMP CBSNP /AND LOOP
- PTCH, 0
- TAD P /V3C
- STL CIA /CHECK FOR END OF BUFFER
- TAD ZZ
- SZL SNA CLA
- POPJ
- CDF 10
- JMP I PTCH
-
-XXSUBS, EDSUB
- EHSUB
- EOSUB
- ESSUB
- ETSUB
- EUSUB
-/ CXSUB
-
-/CXSUB,
-EDSUB,
-EHSUB,
-ESSUB,
-EOSUB, 0
- JMP I EOSUB
- PAGE
- RELOC
- FIELD 1
-
- *4400
-
-XERBAS, XER1
- XER2
- XER3
- XER4
- XER5
- XER6
- XER7
- XER8
- XER9
- XER10
- XER11
- XER12
- XER13
- XER14
- XER15
- XER16
- XER17
- XER18
- XER19
- XER20
- XER21
- XER22
- XER23
- XER24
- XER25
- XER26
- XER27
- XER28
- XER29
- XER30
- XER31
- XER32
- XER33
- XER34
- XER35
- XER36
- XER1,
-"I;"l;"l;"e;"g;"a;"l;" ;"C;"o;"m;"m;"a;"n;"d;" ;4000;0
-XER2,
-"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"C;"o;"m;"m;"a;"n;"d;0
-XER3,
-"I;"l;"l;"e;"g;"a;"l;" ;"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"N;"a;"m;"e;" ;4000;0
-XER4,
-"I;"n;"t;"e;"r;"n;"a;"l;" ;"P;"u;"s;"h;" ;"D;"o;"w;"n;" ;"O;"v;"e;"r
-"f;"l;"o;"w;0
-XER5,
-"S;"t;"o;"r;"a;"g;"e;" ;"C;"a;"p;"a;"c;"i;"t;"y;" ;"E;"x;"c;"e;"e;"d;"e;"d;0
-XER6,
-"S;"e;"a;"r;"c;"h;" ;"S;"t;"r;"i;"n;"g;" ;"t;"o;"o;" ;"L;"o;"n;"g;0
-XER7,
-"I;"m;"p;"r;"o;"p;"e;"r;" ;"A;"r;"g;"u;"m;"e;"n;"t;"s;0
-XER8,
-"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
-" ;"i;"n;" ;"F;"i;"l;"e;"n;"a;"m;"e;0
-XER9,
-";;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
-XER10,
-">;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
-XER11,
-"A;"t;"t;"e;"m;"p;"t;" ;"t;"o;" ;"M;"o;"v;"e;" ;"P;"o;"i;"n;"t;"e;"r
-" ;"O;"f;"f;" ;"P;"a;"g;"e;0
-XER12,
-"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"M;"e;"m;"o;"r;"y;" ;"O;"v;"e;"r;"f;"l;"o;"w;0
-XER13,
-"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"M;"a;"c;"r;"o;0
-XER14,
-"O;"u;"t;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
-XER15,
-"I;"n;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
-XER16,
-"F;"i;"l;"e;" ;"E;"r;"r;"o;"r;0
-XER17,
-"O;"u;"t;"p;"u;"t;" ;"C;"o;"m;"m;"a;"n;"d;" ;"w;"o;"u;"l;"d;" ;"h;"a;"v;"e
-" ;"O;"v;"e;"r;"f;"l;"o;"w;"e;"d;0
-XER18,
-"N;"u;"m;"e;"r;"i;"c;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"Y;0
-XER19,
-"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
-" ;"a;"f;"t;"e;"r;" ;"E;0
-XER20,
-"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
-" ;"a;"f;"t;"e;"r;" ;"";0
-XER21,
-"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"=;0
-XER22,
-"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"U;0
-XER23,
-"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"q;"u;"o;"t;"e;0
-XER24,
-"S;"e;"a;"r;"c;"h;" ;"f;"a;"i;"l;"e;"d;0
-XER25,
-"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o
-" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"P;0
-XER26,
-"N;"e;"g;"a;"t;"i;"v;"e;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;",;0
-XER27,
-"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t
-" ;"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
-"[;"u;"s;"e;" ;"W;" ;"f;"o;"r;" ;"W;"a;"t;"c;"h;" ;"C;"o;"m;"m;"a;"n;"d;"];0
-/XER28,
-/"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;"
-/"I;"t;"e;"r;"a;"t;"i;"o;"n;" ;"C;"o;"u;"n;"t;0
-XER28,
-0
-XER29,
-"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;"
-"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"S;0
-XER30,
-"C;"a;"n;"n;"o;"t;" ;"W;"r;"i;"t;"e;" ;"O;"u;"t;" ;"E;"r;"r;"o;"r
-" ;"M;"e;"s;"s;"a;"g;"e;" ;"O;"v;"e;"r;"l;"a;"y;0
-XER31,
-"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
-" ;"a;"f;"t;"e;"r;" ;"F;0
-XER32,
-"Y;" ;"C;"o;"m;"m;"a;"n;"d;" ;"A;"b;"o;"r;"t;"e;"d;0
-XER33,
-"C;"C;"L;".;"S;"V;" ;"n;"o;"t;" ;"f;"o;"u;"n;"d;" ;"o;"r;"
-"E;"G;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;"o;" ;"b;"i;"g;0
-XER34,
-"E;"x;"e;"c;"u;"t;"i;"o;"n;" ;"a;"b;"o;"r;"t;"e;"d;0
-XER35,
-"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t;"
-"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
-"[;"u;"s;"e;" ;"E;"O;" ;"f;"o;"r
-" ;"V;"e;"r;"s;"i;"o;"n;" ;"n;"u;"m;"b;"e;"r;"];0
-XER36,
-"N;"o;" ;"F;"i;"l;"e;" ;"f;"o;"r;" ;"O;"u;"t;"p;"u;"t;0
- PAGE
- COREAD, 0
- ISZ COREAD
- TAD I COREAD /GET BLOCK #
- AND CO7
- CLL RTR
- RTR
- RAR /MULTIPLY BY 400
- TAD KMEM
- DCA FLO
- TAD M400
- DCA FLCNT
- TAD K3200
- DCA FTO
-FLOO, CDF 30
- TAD I FLO
- CDF 0
- DCA I FTO
- ISZ FLO
- ISZ FTO
- ISZ FLCNT
- JMP FLOO
- ISZ COREAD
- CIF CDF 0
- JMP I COREAD
-
-FLCNT, 0
-CO7, 7
-M400, -400
-K3200, 3200
-KMEM, MEMLOC
-FLO, 0
-FTO, 0
-COREND=.
- NEWERR, RELOC OVREAD
- CIF 30 /NEW CODE TO READ OVERLAY
- JMS I .+1 /MUST BE 5 LOCS LONG
- COREAD
-TMP, 0 /BLOCK #
- NOP
- RELOC
- PAGE
-
DELETED src/os8-v3f/VXNS.PA
Index: src/os8-v3f/VXNS.PA
==================================================================
--- src/os8-v3f/VXNS.PA
+++ /dev/null
@@ -1,243 +0,0 @@
-/EXTENDED MEMORY DEVICE HANDLER
-/
-/
-/PSEUDO DEVICE SIMILAR TO DF32
-/BUT IN RAM MEMORY USING FIELDS
-/10 TO 17 FOR PLATTER 1
-/20 TO 27 FOR PLATTER 2
-/30 TO 37 FOR PLATTER 3
-/
-/
-/ S.R.,J.R.,J.M.
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/BUILD DATA
- *0
-/
-/1 EXTENDED MEMORY HANDLER FOR OS/8
-
-
- IFNDEF SYS <SYS=0> /SET TO 1 TO GET SYSTEM HANDLER
-
-
- -1
- IFZERO SYS <DEVICE VXA0;DEVICE VXA0;4333;MEM&177;ZBLOCK 2>
- IFNZRO SYS <DEVICE VXA0;DEVICE SYS;4333;2007;0;200>
- VXVER="A&77
-
- IFNZRO SYS <
-
- 7737 /MINUS LENGTH OF BOOT
- RELOC 0
-
- CLL CLA CMA /CLEAR AC & SET TO 7777
- DCA X0
- TAD K7600
- DCA C1
- TAD K7600
- DCA C2
- TAD K7577
- DCA X1
- TAD K7577
- DCA X2
- JMP 20
-X0, 0
-X1, 0
-X2, 0
-C1, 0
-C2, 0
- CDF 4
- TAD I X0
- CDF 10
- DCA I X1
- ISZ C1
- JMP 20
- CDF 4
- TAD I X0
- CDF 0
- DCA I X2
- ISZ C2
- JMP 26
- CDF CIF 0
- JMP I .+1
- 7605
-K7600, 7600
-K7577, 7577
- RELOC
- >
- *200
-
- IFNZRO SYS < RELOC 7600
- ZBLOCK 7>
-
-MEM, VXVER
- CLA CLL CML RAR /SET AC TO 4000
- TAD I MEM /GET ARG 1 -- LINK WILL BE SET IF WRITE
- AND VX70 /MASK OFF FIELD
- TAD VCDF /FORM A CDF N
- DCA FLD /STORE AT INPUT
- TAD FLD
- DCA WR /AND AT OUTPUT
- RAR /GET WRITE BIT
- MQL /SAVE IN MQ
- IFZERO SYS <
- TAD K7000
- 6200 /SET MEM EXT BITS
- CLA CLL
- >
- TAD I MEM /AGAIN GET ARG 1
- RAL /MULT X 2 = PAGESX2=WORDS
- AND VX7600 /MASK OFF OTHER BITS
- CIA /MAKE NEGATIVE
- DCA WDCNT /STORE AT 7753
- CLL /CLEAR LINK IF IT WAS WRITE
- ISZ MEM /INCR POINTER
- TAD I MEM /GET ARG 2
- DCA BUFADR /STORE BUFFER POINTER IN 7750
- ISZ MEM /INCR POINTER
- TAD I MEM /GET ARG 3 -OS/8 BLOCK #
- DCA BLK /STORE IN 7752
- TAD BLK
- AND VX17 /GET BITS 8 TO 11 TO MAKE INTO START ADDR
- BSW
- RTL
- DCA SA /STORE START ADDR OF EXT MEM IN 7751
- TAD BLK
- RAR
- AND VX70
- TAD VCDF /THIS GET BITS 5 TO 7 FOR EXT MEM BIT CDE
- DCA RD /TEMP STORE UNTIL BITS A & B ARE EVALUATED
- RDF /NOW GRAB SENDING FIELD IN AC
- TAD VXCDI /FORM A CDI N OF SENDING FIELD
- DCA VXRET /STORE AT RETURN ROUTINE
- ISZ MEM /NOW RETURN POINTS TO ERROR
-VXCDI, CDF CIF 0 /PUT INTO CURRENT FIELD ALSO CONSTANT FOR CDI
- TAD BLK /NOW WE NEED TO KNOW BITS A & B IN EXT MEM
- TAD M200 /IS OS/8 BLOCK 0-177
- SPA
- JMP DOB /YES SO SET BIT B
- TAD M200 /IS OS/8 BLOCK 200-377
- SPA CLA
- JMP DOA /YES SO SET BIT A
- TAD VX4 /NO SO SET BIT B
- TAD VX100 /AND BIT A
-GO, TAD RD /PICK UP TEMP CDF
- DCA RD /STORE IT AT INPUT
- TAD RD
- DCA FLD2 /AND AT OUTPUT
- MQA /NOW GET WRITE BIT (IF ANY)
- SNA CLA
- JMP RD /NO WRITE BIT SO GO TO READ ROUTINE
-WR, HLT /WRITE ROUTINE - THIS BECOMES A CDF N
- TAD I BUFADR /GET DATA FROM INPUT BUFFER
-FLD2, HLT /THIS CHANGES TO CDF N (HIGH FIELDS)
- DCA I SA /DUMP INTO EXTEND MEM
- JMS VCK /CHECK FOR END OF ROUTINE & RESET FIELDS
- JMP WR /NOT DONE YET SO CONTINUE
-RD, HLT /READ ROUTINE - THIS BECOMES A CDF N (HIGH)
- TAD I SA /GET DATA FROM EXTENDED MEM
-FLD, HLT /CHANGES TO CDF N (LOW)
-
- DCA I BUFADR /PUT INTO BUFFER IN LOWER MEMORY
- JMS VCK /CHECK FOR END OF ROUTINE & RESET FIELDS
- JMP RD /NOT DONE SO CONTINUE
-M200,
-VX7600, 7600 /K7600 & M200 & CLA ON EXIT
- ISZ MEM /INCR POINTER TO GOOD EXIT
-VXRET, HLT /CHANGES TO CDF CIF N OF SENDING FIELD
- JMP I MEM /RETURN TO CALLING ROUNTINE
-VCK, 0 /THIS CHECKS READ AND WRITE FOR DONE
- IFZERO SYS <JMS CTRLC>
- ISZ WDCNT /AND FOR RESET OF FIELDS
- SKP /NO OVERFLOW SO SKIP TO CONTINUE
- JMP VX7600 /OVERFLOW SO DONE - GO TO EXIT ROUTINE
- ISZ BUFADR /INCR POINTER IF OVERFLOWS THEN WRAP MEMORY
-VX70, 70 /CONSTANT THAT DOES A NOP HERE IF NO OVERFLOW
- ISZ SA /INCR START ADDR IN EXT MEM
-
- JMP I VCK /NO OVERFLOW SO COONTINUE
- TAD VX10 /EXTEND MEM NEEDS NEW FIELD
- TAD RD
- DCA RD /PUT INCR FIELD AT INPUT
- TAD RD
- DCA FLD2 /AND WRITE
- JMP I VCK /NOW GO BACK AND TRY TO FINISH
-DOB, CLA /CLEAR AC
- TAD VX4 /SET BIT A
- JMP GO /GO TO ROUTINE TO UPDATE TEMP AND STORE
-DOA, TAD VX100 /SET BIT A
- JMP GO /GO TO ROUTINE TO UPDATE TEMP AND STORE
-VCDF, CDF 0 /CONSTANT TO FORM CDF N
-VX17, 17
-VX10, 10
-VX100, 100
-VX4, 4
- IFNZRO SYS <
-
-BUFADR=7750
-SA=7751
-BLK=7752
-WDCNT=7753>
- IFZERO SYS <
-
-BUFADR, 0
-SA, 0
-BLK, 0
-WDCNT, 0
-K7000, 7000
-CTRLC, 0
- TAD (200
- KRS
- TAD (-203
- SNA CLA
- KSF
- JMP I CTRLC
- CIF CDF 0
- JMP I VX7600
- >
-
-
- IFNZRO SYS <
- RELOC
- >
-$ $ $ $ $ $ $ $
-
DELETED src/os8-v3f/VXSY.PA
Index: src/os8-v3f/VXSY.PA
==================================================================
--- src/os8-v3f/VXSY.PA
+++ /dev/null
@@ -1,244 +0,0 @@
-/EXTENDED MEMORY DEVICE HANDLER
-/
-/
-/PSEUDO DEVICE SIMILAR TO DF32
-/BUT IN RAM MEMORY USING FIELDS
-/10 TO 17 FOR PLATTER 1
-/20 TO 27 FOR PLATTER 2
-/30 TO 37 FOR PLATTER 3
-/
-/
-/ S.R.,J.R.,J.M.
-/
-/
-/
-/
-/
-/
-/COPYRIGHT (C) 1978 BY DIGITAL EQUIPMENT CORPORATION
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
-/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
-/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
-/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
-/
-/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
-/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
-/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
-/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
-/
-/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
-/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
-/DIGITAL.
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/
-/BUILD DATA
- *0
-/
-/1 EXTENDED MEMORY HANDLER FOR OS/8
-
-
- SYS=1
- IFNDEF SYS <SYS=0> /SET TO 1 TO GET SYSTEM HANDLER
-
-
- -1
- IFZERO SYS <DEVICE VXA0;DEVICE VXA0;4333;MEM&177;ZBLOCK 2>
- IFNZRO SYS <DEVICE VXA0;DEVICE SYS;4333;2007;0;200>
- VXVER="A&77
-
- IFNZRO SYS <
-
- 7737 /MINUS LENGTH OF BOOT
- RELOC 0
-
- CLL CLA CMA /CLEAR AC & SET TO 7777
- DCA X0
- TAD K7600
- DCA C1
- TAD K7600
- DCA C2
- TAD K7577
- DCA X1
- TAD K7577
- DCA X2
- JMP 20
-X0, 0
-X1, 0
-X2, 0
-C1, 0
-C2, 0
- CDF 4
- TAD I X0
- CDF 10
- DCA I X1
- ISZ C1
- JMP 20
- CDF 4
- TAD I X0
- CDF 0
- DCA I X2
- ISZ C2
- JMP 26
- CDF CIF 0
- JMP I .+1
- 7605
-K7600, 7600
-K7577, 7577
- RELOC
- >
- *200
-
- IFNZRO SYS < RELOC 7600
- ZBLOCK 7>
-
-MEM, VXVER
- CLA CLL CML RAR /SET AC TO 4000
- TAD I MEM /GET ARG 1 -- LINK WILL BE SET IF WRITE
- AND VX70 /MASK OFF FIELD
- TAD VCDF /FORM A CDF N
- DCA FLD /STORE AT INPUT
- TAD FLD
- DCA WR /AND AT OUTPUT
- RAR /GET WRITE BIT
- MQL /SAVE IN MQ
- IFZERO SYS <
- TAD K7000
- 6200 /SET MEM EXT BITS
- CLA CLL
- >
- TAD I MEM /AGAIN GET ARG 1
- RAL /MULT X 2 = PAGESX2=WORDS
- AND VX7600 /MASK OFF OTHER BITS
- CIA /MAKE NEGATIVE
- DCA WDCNT /STORE AT 7753
- CLL /CLEAR LINK IF IT WAS WRITE
- ISZ MEM /INCR POINTER
- TAD I MEM /GET ARG 2
- DCA BUFADR /STORE BUFFER POINTER IN 7750
- ISZ MEM /INCR POINTER
- TAD I MEM /GET ARG 3 -OS/8 BLOCK #
- DCA BLK /STORE IN 7752
- TAD BLK
- AND VX17 /GET BITS 8 TO 11 TO MAKE INTO START ADDR
- BSW
- RTL
- DCA SA /STORE START ADDR OF EXT MEM IN 7751
- TAD BLK
- RAR
- AND VX70
- TAD VCDF /THIS GET BITS 5 TO 7 FOR EXT MEM BIT CDE
- DCA RD /TEMP STORE UNTIL BITS A & B ARE EVALUATED
- RDF /NOW GRAB SENDING FIELD IN AC
- TAD VXCDI /FORM A CDI N OF SENDING FIELD
- DCA VXRET /STORE AT RETURN ROUTINE
- ISZ MEM /NOW RETURN POINTS TO ERROR
-VXCDI, CDF CIF 0 /PUT INTO CURRENT FIELD ALSO CONSTANT FOR CDI
- TAD BLK /NOW WE NEED TO KNOW BITS A & B IN EXT MEM
- TAD M200 /IS OS/8 BLOCK 0-177
- SPA
- JMP DOB /YES SO SET BIT B
- TAD M200 /IS OS/8 BLOCK 200-377
- SPA CLA
- JMP DOA /YES SO SET BIT A
- TAD VX4 /NO SO SET BIT B
- TAD VX100 /AND BIT A
-GO, TAD RD /PICK UP TEMP CDF
- DCA RD /STORE IT AT INPUT
- TAD RD
- DCA FLD2 /AND AT OUTPUT
- MQA /NOW GET WRITE BIT (IF ANY)
- SNA CLA
- JMP RD /NO WRITE BIT SO GO TO READ ROUTINE
-WR, HLT /WRITE ROUTINE - THIS BECOMES A CDF N
- TAD I BUFADR /GET DATA FROM INPUT BUFFER
-FLD2, HLT /THIS CHANGES TO CDF N (HIGH FIELDS)
- DCA I SA /DUMP INTO EXTEND MEM
- JMS VCK /CHECK FOR END OF ROUTINE & RESET FIELDS
- JMP WR /NOT DONE YET SO CONTINUE
-RD, HLT /READ ROUTINE - THIS BECOMES A CDF N (HIGH)
- TAD I SA /GET DATA FROM EXTENDED MEM
-FLD, HLT /CHANGES TO CDF N (LOW)
-
- DCA I BUFADR /PUT INTO BUFFER IN LOWER MEMORY
- JMS VCK /CHECK FOR END OF ROUTINE & RESET FIELDS
- JMP RD /NOT DONE SO CONTINUE
-M200,
-VX7600, 7600 /K7600 & M200 & CLA ON EXIT
- ISZ MEM /INCR POINTER TO GOOD EXIT
-VXRET, HLT /CHANGES TO CDF CIF N OF SENDING FIELD
- JMP I MEM /RETURN TO CALLING ROUNTINE
-VCK, 0 /THIS CHECKS READ AND WRITE FOR DONE
- IFZERO SYS <JMS CTRLC>
- ISZ WDCNT /AND FOR RESET OF FIELDS
- SKP /NO OVERFLOW SO SKIP TO CONTINUE
- JMP VX7600 /OVERFLOW SO DONE - GO TO EXIT ROUTINE
- ISZ BUFADR /INCR POINTER IF OVERFLOWS THEN WRAP MEMORY
-VX70, 70 /CONSTANT THAT DOES A NOP HERE IF NO OVERFLOW
- ISZ SA /INCR START ADDR IN EXT MEM
-
- JMP I VCK /NO OVERFLOW SO COONTINUE
- TAD VX10 /EXTEND MEM NEEDS NEW FIELD
- TAD RD
- DCA RD /PUT INCR FIELD AT INPUT
- TAD RD
- DCA FLD2 /AND WRITE
- JMP I VCK /NOW GO BACK AND TRY TO FINISH
-DOB, CLA /CLEAR AC
- TAD VX4 /SET BIT A
- JMP GO /GO TO ROUTINE TO UPDATE TEMP AND STORE
-DOA, TAD VX100 /SET BIT A
- JMP GO /GO TO ROUTINE TO UPDATE TEMP AND STORE
-VCDF, CDF 0 /CONSTANT TO FORM CDF N
-VX17, 17
-VX10, 10
-VX100, 100
-VX4, 4
- IFNZRO SYS <
-
-BUFADR=7750
-SA=7751
-BLK=7752
-WDCNT=7753>
- IFZERO SYS <
-
-BUFADR, 0
-SA, 0
-BLK, 0
-WDCNT, 0
-K7000, 7000
-CTRLC, 0
- TAD (200
- KRS
- TAD (-203
- SNA CLA
- KSF
- JMP I CTRLC
- CIF CDF 0
- JMP I VX7600
- >
-
-
- IFNZRO SYS <
- RELOC
- >
-$ $ $ $ $ $ $ $
-
DELETED src/os8-v3f/actions.txt
Index: src/os8-v3f/actions.txt
==================================================================
--- src/os8-v3f/actions.txt
+++ /dev/null
@@ -1,57 +0,0 @@
-att rk1 os8-v3f-build.rk05
-a BLOAD.PA RKA1:
-a BOOT.PA RKA1:
-a BPAT.PA RKA1:
-a BUILD.PA RKA1:
-a CCL.BI RKA1:
-a CCL.MA RKA1:
-a CCLAT.MA RKA1:
-a CCLCD.MA RKA1:
-a CCLCDX.MA RKA1:
-a CCLCOR.MA RKA1:
-a CCLDAT.MA RKA1:
-a CCLDRV.MA RKA1:
-a CCLMSG.MA RKA1:
-a CCLPS.MA RKA1:
-a CCLREM.MA RKA1:
-a CCLRUN.MA RKA1:
-a CCLSB2.MA RKA1:
-a CCLSEM.MA RKA1:
-a CCLSIZ.MA RKA1:
-a CCLSUB.MA RKA1:
-a CCLTAB.MA RKA1:
-a CCLTBL.MA RKA1:
-a CD.PA RKA1:
-a FPAT.PA RKA1:
-a FUTIL.PA RKA1:
-a KL8E.PA RKA1:
-a OS78.BI RKA1:
-a OS8.PA RKA1:
-a PAL8.PA RKA1:
-a PIP.PA RKA1:
-a README.V3F RKA1:README.TX
-a RESORC.BI RKA1:
-a RESORC.MA RKA1:
-a RESOV0.MA RKA1:
-a RESOV1.MA RKA1:
-a RESOV2.MA RKA1:
-a RESOVD.MA RKA1:
-a RL0.PA RKA1:
-a RL1.PA RKA1:
-a RL2.PA RKA1:
-a RL3.PA RKA1:
-a RLC.PA RKA1:
-a RLFRMT.PA RKA1:
-a RLSY.PA RKA1:
-a RTL.PA RKA1:
-a RTS.PA RKA1:
-a RX78C.PA RKA1:
-a RXCOPY.PA RKA1:
-a RXNS.PA RKA1:
-a RXSY1.PA RKA1:
-a RXSY2.PA RKA1:
-a SAVECB.PA RKA1:
-a TECO.PA RKA1:
-a VXNS.PA RKA1:
-a VXSY.PA RKA1:
-