File: BUIL40.PA of Disk: Disks/Working/New-24-05-2015
(Source file text)
/33 OS/8 V3D BUILD
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/
/
/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 V40A/
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,TM8E 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=3400 /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,TM8E 11400-11777 26
/EXT 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
DCA ORGX /ALSO TEMP
SZL /IS IT AN ORIGIN?
JMP ORGTST /YES
TAD ORIGIN
TAD (200 /GIVE ERROR IF ORIGIN ADVANCES TO 7600
SNA CLA
JMP BADIN
TAD ORGX /GET WORD BACK
XFIELD, HLT /GETS CDF N
DCA I ORIGIN /STORE THIS WORD
CDF20, CDF 20
ISZ ORIGIN /SHOULD NEVER SKIP, BUT...
LD7, 7
NEXT, TAD WD1
TAD WD2 /MAKE UP CHECKSUM
TAD CKSUM
DCA CKSUM
TAD WD
JMP NEWWD
ORGTST, /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;4211;1400;26;ERROR /ENTER,TM8E OVERLAY
CIF 0;WRITEX;4701;2000;54;ERROR /SAVE, DATE, MON ERROR, CHAIN OVERLAYS
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
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
$