--- /dev/null
+/OS8 FORTRAN II RELOCATING LOADER V4
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1973, 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.
+/
+/
+/
+/
+/
+/
+\f/LOADER.07 DECEMBER 5, 1973
+/
+/
+/CHANGES MADE FOR V4 J.K. 1975
+/
+/ .VERSION NUMBER PRINTED ON MAP
+/ .BIT ZERO OF 17645 IS USED INSTEAD OF THE WHOLE
+/ WORD TO INDICATE THAT THE LOADER WAS CHAINED
+/ TO FROM SABR
+/ .CORE ROUTINE STANDARIZED
+/ .CHECK FOR BATCH CORRECTED
+/
+/
+/FIELD 0, PAGE 0
+
+ VERSION=6400 /PRINTS ON MAP
+ PATCH=01
+ JSTFLD= 7744
+ JSTADR= 7745
+ JSBITS= 7746
+ MOFILE= 7600
+ MIFILE= 7617
+ MPARAM= 7643
+ DCB= 7760
+ MSTCDF= 7772
+ MSTADR= 7775
+ SHNDLR= 7607
+ MGET= 7667
+ MTEMP= 27
+ OLDT9= 7 /LOCATION OF HANDLER ENTRY OF DEVICE
+ /WITH DIRECTORY IN CORE
+
+ *0
+ZERO, JMS I XSHNDLR
+ONE, 2010
+ 3600
+ MTEMP+11
+ HLT
+FIVE, JMP I .+1
+ 7600
+XSHNDLR,SHNDLR
+X1, 0
+X2, 0
+X3, 0
+X4, 0
+
+ *16
+ NOPUNC
+ *100
+ ENPUNC
+
+DFRSTR, CIF 10
+ JMS I DF200
+ 11 /KICK OUT MONITOR
+DFSAVE, 0 /RESTORE CALLING FIELD
+ JMP I CDZSKP /AND EXIT
+
+SAVEDF, 0 /COMMON SAVE-FIELD PROCESSOR FOR FORTRAN I/O
+ DCA CDZSKP /CALLING ADDRESS
+ RDF
+ TAD .+2
+ DCA DFSAVE /CALLING FIELD
+ CDF CIF 0
+ JMP I SAVEDF
+DF200, 200
+\f/RUN-TIME SYSTEM PAGE 0 - PROPAGATED TROUGH ALL FIELDS
+
+*33
+ BNK=00
+/
+/ COMMON SUBROUTINE CALL LINKAGE ROUTINE
+/
+LINK, 0
+K6201, CDF BNK /SET DATA FIELD TO THIS BANK
+K6202, CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MLINKP /EXIT TO MASTER LINKAGE ROUTINE
+MLINKP, MLINK
+/
+/ COMMON SUBROUTINE RETURN LINKAGE ROUTINE
+/
+RTN, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MRTNP /EXIT TO MASTER RETURN ROUTINE
+MRTNP, MRTN
+/
+/ CHANGE DATA FIELD TO CURRENT AND SKIP
+/
+CDFSKP, 0
+ ISZ CDFSKP /INDEX ADDRESS FOR SKIPPING
+ CDF BNK /CHANGE DATA FIELD TO CURRENT BANK
+ JMP I CDFSKP /EXIT
+/
+/ CHANGE DATA FIELD TO ZERO AND SKIP
+/
+CDZSKP, 0
+ ISZ CDZSKP /INDEX RETURN ADDRESS FOR SKIPPING
+ CDF 10 /CHANGE DATA FIELD TO ZERO
+ JMP I CDZSKP /EXIT
+/
+/ OFF BANK INDIRECT SUBROUTINE
+/
+OBISUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO ZERO
+ JMP I MOBIP /EXIT TO MASTER OFF BANK INDIRECT SUBROUTINE
+MOBIP, MOBI
+/
+/ OFF PAGE INDIRECT SUBROUTINE
+/
+OPISUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO BANK 0
+ JMP I MOPIP /EXIT TO MASTER OFF PAGE INDIRECT SUBROUTINE
+MOPIP, MOPI
+\f/
+/ ROUTINE TO HANDLE DUMMY ARGUMENTS
+/
+DUMSUB, 0
+ CDF BNK /SET DATA FIELD TO THIS BANK
+ CIF 00 /SET INSTRUCTION FIELD TO BANK 0
+ JMP I MDUMP /EXIT TO MASTER DUMMY ARGUMENT ROUTINE
+MDUMP, MDUM
+
+/ PAGE 0 CELLS FOR FORTRAN EXECUTION TIME I/O
+/ CELLS SET UP BY LINKING LOADER - CANNOT GO PAST 77
+
+INHNDL, 0 /PAGE FOR INPUT HANDLER IF /I SWITCH WAS ON
+OUHNDL, 0 /PAGE FOR OUTPUT HANDLER IF /O SWITCH WAS ON
+ELENGT, 0 /"DESIRED LENGTH" FOR FORTRAN OUTPUT FILES - USUALLY 0
+
+ *DF200+1
+/OTHER PAGE 0 LOCATIONS
+
+FOPOLD, 0
+FINPTR, 0
+FICHCT, 0 /MUST BE INIT. TO -1 AT LOOKUP
+FINTMP, 0 /MUST BE INIT. TO 10 AT LOOKUP
+OHNDLR, 0 /SET BY FENTER - CLEARED BY FCLOSE
+IHNDLR, 0 /SET BY FLUKUP - NEVER CLEARED
+FOUPTR, 0
+FOCHCT, 0
+\f *200
+LSTART, JMP I (LDRZZ1
+SSTART, CDF 10
+ TAD I (MPARAM+2
+ SMA CLA
+ JMP NOTSBR
+ TAD I (MPARAM+2
+ AND (3777
+ DCA I (MPARAM+2
+ TAD I (MOFILE
+ SNA CLA
+ JMP LDRYYY
+ TAD (MOFILE+11
+ DCA X1
+ TAD (MOFILE
+ DCA SEVEN
+ TAD (-5
+ DCA SIX
+ TAD (TEMP-1
+ DCA X2
+MOVLP1, TAD I SEVEN
+ CDF 0
+ DCA I X2
+ CDF 10
+ TAD I X1
+ DCA I SEVEN
+ ISZ SEVEN
+ ISZ SIX
+ JMP MOVLP1
+ TAD TEMP+1 /GET BLOCK NUMBER WHICH SABR PLACED HERE
+ DCA I (MIFILE+1
+ DCA I (MIFILE+2
+ CLA CLL CMA RAL
+ AND I (MPARAM
+ DCA I (MPARAM /REMOVE /L SWITCH FROM SABR INPUT
+ CDF 0
+ CIF 10
+ CLA IAC
+ JMS I (200
+ 4 /DELETE
+ FORTRL /THE FILE "FORTRL.TM" IF IT EXISTS
+ 0
+ NOP /IT DIDN'T EXIST - BIG DEAL
+ TAD TEMP
+LDRYYY, CDF 10
+ DCA I (MIFILE
+NOTSBR, CIF 10
+ CDF 0
+ JMS I (200
+ 12 /GET DEVICE NUMBER WITHOUT HANDLER
+ 2424 /TT
+TTYNUM, 3100 /Y
+ 1000 /RANDOM NUMBER
+ JMP LWOWIE /WHAT - NO TELETYPE???
+ CIF 10
+ CLA IAC /DEVICE "SYS"
+ JMS I (200
+ 2
+PTSLIB, SYSLIB
+ 0 /USELESS LENGTH WORD
+ CLA SKP
+ TAD PTSLIB
+ CDF 10
+ DCA I (PSYSLB
+ TAD TTYNUM
+ DCA I (TTYNO /STORE AWAY TTY DEVICE NUMBER
+ JMS I (BATCK
+CORO, TAD CORSIZ /GET FLD OF TEST
+ RTL
+ RAL
+ AND COR70
+ TAD COREX /MASK USEFUL BITS
+ DCA .+1
+COR1, CDF
+ TAD I CORLOC /SAVE CURRENT CONTENTS
+COR2, NOP
+ DCA COR1
+ TAD COR2
+ DCA I CORLOC
+COR70, 70
+ TAD I CORLOC /TRY TO READ BACK
+CORX, 7400
+ TAD CORX
+ TAD CORV /TAD (1400)
+ SZA CLA
+ JMP COREX /NON-EXISTENT FLD EXIT
+ TAD COR1
+ DCA I CORLOC /RESTORE LOC
+ ISZ CORSIZ
+ JMP CORO
+COREX, CDF 0
+ TAD CORSIZ
+ CIA
+FOUNDX, CDF CIF 10
+ DCA I (WROVLY /POSTPONE SPREADING FIELD ZERO RESIDENT
+ TAD (TTYOUT / THRU FIELDS UNTIL /I,/O AND /H ARE TESTED
+ DCA I (TYPE
+ JMP I .+1
+ LDRXXX
+\fSIX, 0
+SEVEN, 0
+
+LWOWIE, CDF CIF 10
+ JMP I (SIOERR
+CORLOC, CORX
+CORV, 1400
+CORSIZ, 1
+TEMP, 0;0;0;0
+ PAGE
+\f/FULL LINKAGE ROUTINES FOR RUN-TIME SYSTEM
+
+ *400
+K77A, 0077 /MUST BE FIRST LOC ON PAGE
+/
+/ MASTER OFF PAGE INDIRECT ROUTINE
+/
+MOPI, DCA AC /SAVE AC
+ TAD I OPIP /PICK UP ADDRESS OF PARAMETER
+ DCA DUMSUB
+ TAD I DUMSUB /ACTUAL PARAMETER
+ DCA 7 /TO A TEMP
+ TAD I 7 /PICK UP FINAL DATA
+ DCA I K7 /TO LOCATION 7 IN FROM BANK
+ RDF /FROM BANK
+ATVX, TAD K6202 /MAKE A CIF FROM INSTRUCTION
+ DCA ATV /SAVE IN THIS SEQUENCE
+ JMP ATV-1
+/
+/ MASTER OFF BANK INDIRECT ROUTINE
+/
+MOBI, DCA AC /SAVE AC
+ TAD I OBIP /ADDRESS OF PARAMETER
+ DCA DUMSUB
+ TAD I DUMSUB /ACTUAL COMMON ADDRESS
+ DCA 7 /SAVE IT
+ RDF /FROM BANK
+ TAD K6201 /MAKE A CDF FROM INSTRUCTION
+ DCA .+3 /PLACE IN THIS SEQUANCE
+ CDF 10 /CHANGE DATA FIELD TO COMMON
+ TAD I 7 /ACTUAL DATA
+ NOP /BECOMES CDF AND CIF FROM INSTRUCTION
+ DCA I K7 /TO LOCATION 7 IN FROM BANK
+ RDF
+ CDF 10
+ JMP ATVX
+\f/ MASTER INDIRECT DUMMY ARGUMENT SUBROUTINE
+
+MDUM, DCA AC /SAVE AC
+ TAD I DUMP /PICK UP ADDRESS OF PAR
+ DCA DUMSUB
+ TAD I DUMSUB /PICK UP POINTER TO 2 WORD VECTOR
+ DCA DUMTEM /TO A TEMPORARY
+ TAD I DUMTEM /FIELD DATA IS IN AS A CDF
+ DCA ABCRT /TO THIS SEQUANCE
+ RDF /FROM FIELD
+ TAD K6202 /MAKE A CIF INSTRUCTION
+ DCA ATV /TO THIS SEQUANCE FOR EXIT
+ ISZ DUMTEM /POINT TO LOCATION IN FIELD
+ TAD I DUMTEM /ACTUAL LOCATION IN UNKNOWN FIELD
+ DCA I K7 /TO FROM FIELD LOCATION 7
+ABCRT, NOP /BECOMES CDF UNKNOWN
+ ISZ DUMSUB /BUMP RETURN ADDRESS
+ATV, NOP /BECOMES CIF FROM
+ TAD AC /RESTORE AC
+ JMP I DUMSUB /EXIT
+AC= CDZSKP
+DUMTEM= OBISUB
+OPIP, OPISUB
+OBIP, OBISUB
+DUMP, DUMSUB
+/
+/ MASTER LINKAGE ROUTINE
+/
+MLINK, DCA AC /SAVE AC
+ RDF
+ TAD K6201 /MAKE A CDF
+ DCA DUMTEM
+ TAD I LINKP /ADDRESS OF CODE WORD
+ JMS RTS1
+ TAD DUMTEM /CDF FROM INSTRUCTION
+ DCA I DUMSUB /TO FIRST WORD OF 2 WORD VECTOR
+ ISZ DUMSUB /POINT TO DISPLACEMENT
+ TAD LINK /ADDRESS OF CODE WORD
+ IAC /INCR. TO FIRST ARG
+ DCA I DUMSUB /TO SECOND WORD OF 2 WORD VECTOR
+ JMP ATVX-1
+/
+/ MASTER RETURN ROUTINE
+/
+MRTN, DCA AC /SAVE AC
+ TAD I RTNP /ADDRESS OF CODE WORD
+ JMS RTS1
+ TAD I DUMSUB /FIELD TO RETURN TO AS A CDF INSTRUCTION
+ TAD K2
+ DCA ATV
+ ISZ DUMSUB
+ TAD I DUMSUB
+ DCA DUMSUB
+ JMP ATV
+\f/DATA
+
+K100A, 100
+K7700A, 7700
+LINKP, LINK
+RTNP, RTN
+/
+/SUBROUTINE 1
+/
+RTS1, 0
+ DCA LINK
+ TAD I LINK /CODE WORD
+K200A, AND K77A /MASK OUT NUMBER OF ARGUMENTS
+ TAD K200A /+DISPLACEMENT
+ DCA ABCRT /GIVES ADDRESS OF BCRT ENTRY
+ TAD ABCRT
+ TAD K100A /+DISPLACEMENT
+ DCA ATV /GIVES ADDRESS OF TV DISPLACEMENT
+ CDF CIF 0 /(TABLES IN FIELD 0!)
+ TAD I ABCRT /TO CDF INSTRUCTION
+ DCA RTSCDF /TO FIRST WORD OF 2 WORD VECTOR
+ TAD I ATV /TO BANK DISPLACEMENT
+ SNA /WAS IT LOADED?
+ JMP NOTIN /NO
+
+ DCA DUMSUB /TO SECOND WORD OF 2 WORD VECTOR
+RTSCDF, 0
+ JMP I RTS1
+
+NOTIN, CIF 10
+ JMS I K7700A
+K7, 7
+ 1 /USER ERROR 1 - PROGRAM NOT LOADED
+\fFASIGN, 0 /CALLED FROM SABR - DOES ASSIGN AND
+ DCA CDFSKP /EITHER LOOKUP,ENTER OR CLOSE
+ TAD FASIGN
+ JMS SAVEDF
+ CIF 10
+ JMS I K7700A
+ 10 /CALL USR IN
+ CIF 10
+ JMS I K200A
+ 1 /ASSIGN HANDLER
+ASDEV, 0;0 /SET UP BY SABR
+ASPAGE, 0 /DITTO
+ JMP ASERR /ASSIGN FAILURE
+ZRONAM, DCA FLUNAM /ZERO FILENAME FOR LOOKUP
+ TAD ASDEV+1 /PUT DEVICE NUMBER IN AC
+ JMP I CDFSKP /JUMP TO APPROPRIATE ROUTINE
+
+ *567 /MUST CROSS PAGE BOUNDARY JUST SO
+FLUKUP, CIF 10
+ JMS I K200A
+K2, 2 /LOOKUP FILE
+FLUNAM, 0 /REPLACED BY BLOCK NUMBER
+FLUCNT, 0 /REPLACED BY LENGTH (UNUSED)
+ASERR, ISZ CDZSKP /SKIP RETURN IF ERROR
+ TAD ASPAGE
+ DCA IHNDLR /SET UP INPUT HANDLER ENTRY AND FLAG
+ TAD FLUNAM
+FINRXX, DCA FINREC /***** THIS SHOULD BE AT LOC 600! *****
+ CLA CMA
+ DCA FICHCT
+ TAD FIN10
+ DCA FINTMP
+ JMP FRESET /RESET I/O AND RETURN FROM FASIGN
+ IFNZRO FINRXX-600 <FINERR,_ERROR>
+\f /GET A CHARACTER ROUTINE.
+ /RETURNS TO .+1 IF ERROR, .+2 IF NORMAL
+ /CHAR IN AC ON OUTPUT
+ /DOES NOT HANDLE END-OF-FILE VERY WELL
+
+FICHAR, 0
+ TAD FICHAR
+ JMS SAVEDF /SAVE RETURN FIELD AND ADDRESS
+FNXTCH, ISZ FICHCT /BUMP CHAR COUNT
+ JMP FIGET
+ JMS I IHNDLR /IT OVERFLOWED - READ IN A NEW BUFFER
+FI200, 200
+FINBUF, 1200
+FINREC, 0
+FI7700, SMA CLA
+ SKP /END - OF - FILE ERROR - IGNORE
+ JMP DFSAVE /ERROR RETURN
+ ISZ FINREC
+ CLA CMA
+ TAD FINBUF
+ DCA FINPTR
+ TAD FI7200
+ DCA FICHCT /INITIALIZE FOR NEW RECORD
+FIGET, TAD FINTMP /GET HIGH-ORDER-BIT BUFFER
+ SPA /IS IT FULL?
+ JMP FITHRD /YES - OUTPUT COMBINED HIGH-ORDER BITS
+FI7200, CLA
+ ISZ FINPTR
+ TAD I FINPTR /GET A LOC FROM THE BUFFER
+ AND FI7400
+ RAL CLL
+ TAD FINTMP /PUT THE HIGH ORDER BITS ONTO THE HOB BUFFER
+FINXX, RTL
+ RTL
+ DCA FINTMP
+ TAD I FINPTR
+ JMP DFEXIT /RETURN WITH SKIP
+FITHRD, DCA I FINPTR /FUDGE THIRD CHAR INTO BUFFER
+ CLL CML
+ JMP FINXX /RESET FINTMP TO 10
+\f /PUT A CHARACTER
+ /RETURNS TO .+1 IF ERR, .+2 IF NORMAL
+ /CALLED WITH CHAR IN AC
+
+FOCHAR, 0
+ DCA FOUTMP /SAVE CHAR
+ TAD FOCHAR
+ JMS SAVEDF /SAVE CALLING FIELD AND LOC
+FOLOOP, ISZ FOUJMP
+ ISZ FOCHCT /BUMP CHAR COUNT
+FOJMP, JMP FOUJMP /TAKE A BRANCH OF THE THREE-WAY JUMP
+ JMS I OHNDLR
+ 4200
+FOUBUF, 1200
+FOUREC, 0
+ JMP DFSAVE /OUTPUT ERROR
+ ISZ FOUREC
+ JMS FOSETP
+ ISZ FOCCNT /BUMP FILE LENGTH
+ ISZ FOOCNT /ALSO ENTER COUNT
+ JMP FOLOOP /NOW GO PUT THE CHAR INTO THE NEW BUFFER
+ JMP DFSAVE /ENTER COUNT OVERFLOWED - ERROR RETURN
+
+FOUJMP, JMP . /THREE-WAY SWITCH
+ JMP FOUCH1
+ JMP FOUCH2
+FOUCH3, TAD FOUTMP
+ RTL
+ RTL
+ DCA FOUTMP
+ TAD FOUTMP
+ AND FI7400
+ TAD I FOPOLD /PUT HIGH ORDER BITS OF CHAR3
+ DCA I FOPOLD /INTO HIGH ORDER BITS OF CHAR 1
+ TAD FOUTMP
+ RTL
+ RTL
+ AND FI7400
+ TAD I FOUPTR /PUT LOW ORDER BITS OF CHAR 3
+ DCA I FOUPTR /INTO HIGH ORDER BITS OF CHAR 2
+ TAD FOJMP
+ DCA FOUJMP
+ ISZ FOUPTR
+ JMP DFEXIT /RETURN NORMALLY
+FOUCH2, TAD FOUPTR
+ DCA FOPOLD /SAVE POINTER TO CHAR 1
+ ISZ FOUPTR
+FOUCH1, TAD FOUTMP
+ DCA I FOUPTR /STORE CHAR 1 OR 2
+DFEXIT, ISZ CDZSKP /INCREMENT RETURN ADDR
+ JMP DFSAVE /AND GO THERE
+\fFOSETP, 0
+ TAD FO7177
+ DCA FOCHCT
+ TAD FOUBUF
+ DCA FOUPTR
+ TAD FOJMP
+ DCA FOUJMP
+ JMP I FOSETP
+
+FO7177, 7177
+FIN10, 10
+
+FENTER, TAD ELENGT /ELENGT=0 UNLESS SOME KLUDGE SETS IT UP
+ CIF 10 /FENTER JUMPED TO BY FASIGN
+ JMS I FI200
+ 3
+FOONAM, 0 /FILE NAME IN LOCS 0-3
+FOOCNT, 0
+ ISZ CDZSKP /FOR ENTER, ERROR RETURN IS SKIP RETURN
+ TAD FOONAM
+ DCA FOUREC /INITIALIZE OUTPUT RECORD #
+ JMS FOSETP /SET UP CHARACTER POINTERS
+ DCA FOONAM /SET FOONAM FOR NEXT ENTER
+ TAD I PASPAG
+ JMP STOHND /GO TO COMMON CODE WITH "FCLOSE"
+PASPAG, ASPAGE
+
+FCLOSE, CIF 10 /JUMPED TO BY FASIGN
+ JMS I FI200 /CALL I/O MONITOR
+ 4
+FOCNAM, 0 /FILE NAME IN 0-3
+FOCCNT, 0 /CLOSING LENGTH
+ ISZ CDZSKP /ERROR - BUMP RETURN
+STOHND, DCA OHNDLR
+ DCA FOCCNT /INITIALIZE CLOSING COUNT FOR NEXT FILE
+FRESET, CIF 10
+ JMS I FI200
+ 13 /RESET ALL DEVICE HANDLER ENTRIES
+ 0 /BUT RETAIN ANY OPEN OUTPUT FILES
+ JMP DFRSTR /RETURN FROM FASIGN AFTER KICKING MONITOR OUT
+FOUTMP= FICHAR
+FI7400, 7400
+ PAGE
+\f *1000
+PROPGT, 0 /CALLED FROM FIELD 1 LOADER WHEN 1ST
+ CDF 10 /CHECKING FOR I/O SWITCHES.
+ DCA I LTOPCOR /-# OF CORE FIELDS IN AC
+ TAD I LTOPCOR
+ DCA I LFCTR
+ TAD I LTOPCOR
+ CDF 0
+ CMA /GET # OF HI CORE FIELD
+PROPLP, DCA FC
+ CLA CMA
+ TAD FC
+ SNA CLA
+ JMP FIELD1
+ TAD FC
+ JMS CHGBNK
+ JMS STOBNK
+ CLA CMA
+ TAD FC
+ JMP PROPLP
+FIELD1, CLA IAC
+ JMS CHGBNK
+ JMS I LSHNDLR
+ 4100
+ 0
+ MTEMP
+ JMP I LLWOWIE
+ JMS I LSHNDLR
+ 4201
+ 400
+ MTEMP+21 /WRITE OUT RUN-TIME ROUTINES
+ JMP I LLWOWIE
+ JMS CHGBNK
+ TAD L6001
+ DCA I LJSBITS
+ TAD L6213
+ DCA I LJSTFLD
+ TAD LLRSTRT
+ DCA I LJSTADR
+ CDF CIF 10 /PROPGT IS CALLED FROM FIELD 1 ONLY
+ JMP I PROPGT
+FC, 0
+\fCHGBNK, 0
+ CLL RTL
+ RAL
+ TAD LCDF
+ DCA X1
+ TAD X1
+ DCA LINK+1
+ TAD X1
+ DCA RTN+1
+ TAD X1
+ DCA CDFSKP+2
+ TAD X1
+ DCA OBISUB+1
+ TAD X1
+ DCA OPISUB+1
+ TAD X1
+ DCA DUMSUB+1
+ JMP I CHGBNK
+
+STOBNK, 0
+ TAD LLINK1
+ DCA X2
+ TAD X2
+ DCA X3
+ TAD LLINK2
+ DCA X4
+ TAD X1
+ DCA STOCDF
+STOLUP, CDF 0
+ TAD I X2
+STOCDF, HLT
+ DCA I X3
+ ISZ X4
+ JMP STOLUP
+ CDF 0
+ JMP I STOBNK
+SYSLIB, TEXT /LIB8/
+ 2214 /.RL
+
+LTOPCOR,TOPCOR
+LSHNDLR,SHNDLR
+LFCTR, FCTR
+LLWOWIE,LWOWIE
+L6001, 6001
+LJSBITS,JSBITS
+LJSTADR,JSTADR
+LJSTFLD,JSTFLD
+L6213, 6213
+LCDF, CDF
+LLINK1, LINK-1
+LLINK2, LINK-MDUMP-2
+\fLDRZZ1, CDF 10 /COME HERE IF NOT CHAINED TO
+ DCA I LMOFIL
+ ISZ LMOFIL
+ ISZ LMOCNT
+ JMP .-3
+ CLA CLL CMA RAL /-2
+ DCA I LDOPRP
+ CDF 00
+ JMP I .+1
+ LDRYYY
+LMOFIL, 7600
+LMOCNT, -47
+LLRSTRT,LRSTRT
+LDOPRP, DOPROP
+FORTRL, FILENAME FORTRL.TM
+ PAGE
+\f *1200 /LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS
+INPENB, 0
+ ISZ INPFLG
+ JMP INRTRN /ALREADY HAVE A /I
+ JMS TWOPAG /HAS USER SPECIFIED 2-PG. HNDLRS?
+ TAD OUPFLG
+ SPA CLA
+ JMP INVRGN
+ TAD K2200
+ DCA INHNDL
+ TAD (FINBUF
+ DCA I (ST1600 /MARK THE INPUT BUFFER IN PAGE 1600
+ TAD K2377
+ JMS SETHLA
+INRTRN, CDF CIF 10
+ JMP I INPENB
+
+INVRGN, TAD K1000
+ DCA INHNDL
+ TAD K1577
+ JMP INRTRN-1
+
+OUPENB, 0
+ ISZ OUPFLG
+ JMP OURTRN
+ JMS TWOPAG /HAS USER SPECIFIED 2 PG. HNDLRS?
+ TAD INPFLG
+ SPA CLA
+ JMP OUVRGN
+ TAD K2200
+ DCA OUHNDL
+ TAD (FOUBUF
+ DCA I (ST1600 /MARK OUTPUT BUFFER IN 1600
+ TAD K2377
+ JMS SETHLA
+OURTRN, CDF CIF 10
+ JMP I OUPENB
+
+OUVRGN, TAD K1000
+ DCA OUHNDL
+ TAD K1577
+ JMP OURTRN-1
+
+INPFLG, -1
+OUPFLG, -1
+K1000, 1000 /SET TO 1001 FOR 2 PAGE HANDLERS
+K2200, 2200 /SET TO 2401 FOR 2 PAGE HANDLERS.
+K2377, 2377 /SET TO 2577 FOR 2 PAGE HANDLERS.
+K1577, 1577 /SET TO 1777 FOR 2 PAGE HANDLERS.
+\f/SUBROUTINE TO CHECK FOR /H SWITCH MEANING USER
+/WANTS RUN TIME DEVICE INDEPENDENT I/O TO
+/BE ABLE TO USE 2 PAGE DEVICE HANDLERS
+/
+TWOPAG, 0
+ CDF 10
+ TAD I (MPARAM
+ AND (20 /IS /H SWITCH SET?
+ SNA CLA
+ JMP I TWOPAG /NO-RETURN (DATA FLD=1)
+ TAD (1001 /YES-RESET HANDLR FETCH TO ACCEPT
+ DCA K1000 /TWO PAGE HANDLERS
+ TAD (2401 /RESET FETCH FOR SECOND HANDLER
+ DCA K2200
+ TAD (2777
+ DCA K2377 /RESET HLA CONSTANT FOR 2 PG HANDLRS
+ TAD (1777
+ DCA K1577 /RESET 2ND HLA CONSTANT FOR 2 PG
+ TAD (2000
+ DCA I (K1600 /RESET BUFR. ADDRESS-SEE *LDRXIT*
+ CDF 00
+ TAD (1400
+ DCA I (FINBUF /RESET IN AND OUT BUFFER ADDRESSES
+ TAD (1400 /TO MAKE ROOM FOR 2 PG HANDLR
+ DCA I (FOUBUF
+ CDF 10
+ JMP I TWOPAG /RETN. DATA FLD=1
+
+SETHLA, 0
+ DCA I (HLAZ
+ TAD I (HLAZ
+ CIA
+ DCA I (HLAIO
+ CDF 0
+ JMP I SETHLA
+BATCK, 0
+ CDF 0
+ TAD I (7777
+ AND (70
+ SNA
+ JMP I BATCK
+ CLL RTR
+ RAR
+ CMA
+ DCA TMPC
+ TAD I (7777
+ RAL
+ SPA CLA
+ IAC
+ TAD TMPC
+ JMP I (FOUNDX
+TMPC, 0
+ PAGE
+\f FIELD 1
+/FIELD 1 PAGE 0 EQUIVALENCES - FIT INTO USR CRACKS
+
+ DEVHND=20
+ BANK=21
+ TM1=22
+ TM2=23
+ RECNO=24
+ OVLYFG=25
+ CUR=26
+ WORD=27
+ HLAPTR=30
+ HLA=31
+ RCON=32
+ COML=33 /HI COMMON LOC, 0 IF NONE
+ TYPE=34
+ CSUM=35
+ NSUB=36
+
+ *3600
+LRSTRT, DCA I (MIFILE
+LDRZZZ, JMS I (IONULL
+LDRXXX, TAD (MIFILE
+ DCA FILPTR
+ DCA OVLYFG
+ DCA I (WRBFSW
+ JMS I (START
+ JMP IOCHEK /GO TEST FOR /I, /O ALD /0-7
+LDRLP, DCA BANK
+ TAD I FILPTR
+ SNA
+ JMP GETCD
+ JMS GETHND
+ TAD I FILPTR
+ ISZ FILPTR
+ DCA RECNO
+ TAD I (MPARAM
+ RAR
+ SZL CLA
+ JMP I (LBRY
+ JMS I (LOAD
+ JMP LDRLP
+GETCD, TAD I (MPARAM+3
+ SNA
+ JMP LKATMP
+ DCA I (LSTADR
+ TAD I (MPARAM-1
+ CLL RAL
+ AND (17
+ CLL RTL
+ TAD (CDF CIF 0
+ DCA I (LSTFLD /FALL INTO NEXT PAGE
+\fLKATMP, JMS I (WRPGBF
+ TAD I (MPARAM
+ AND (40
+ SZA CLA
+ JMP BUILD
+ TAD I (MPARAM-1
+ SPA CLA
+ JMP BUILD
+ JMS MAP
+CDCALL, JMS I (200
+ 5
+ 2214
+ TAD I (MPARAM+1
+ AND (100
+ SZA CLA
+ JMP LDRZZZ
+IOCHEK, JMS I (IOTEST
+ DCA TM1
+ TAD (MIFILE
+ DCA FILPTR
+ TAD I (MPARAM+2
+ AND (1774
+ SNA
+ JMP LDRLP
+ RAL
+ ISZ TM1
+ SNL
+ JMP .-3
+ CLA CMA CLL RTL
+ TAD TM1
+ JMP LDRLP
+FILPTR, 0
+MAP, 0
+ TAD I (MPARAM+1
+ AND (4410 /"M","P" AND "U" OPTIONS
+ SNA
+MAPRTN, JMP I MAP
+ CLL RTR
+ RTR
+ AND (200
+ SZA CLA
+ CLL CML IAC
+ CML RAL /FORM 0 IF /U, 1 IF /P AND 2 IF /M
+ DCA TM1
+ JMP I (MAPIO
+\fBUILD, TAD (SHNDLR
+ DCA DEVHND
+ TAD PSYSLB
+ SZA
+ JMS I (LBSRCH
+ JMS MAP
+ JMP I (BUILDX
+PSYSLB, 0
+
+GETHND, 0
+ AND (17
+ DCA I (EASGN
+ TAD (401
+ DCA LASGN
+ TAD I (EASGN
+ ISZ FILPTR
+ JMS I (200
+ 1 /ASSIGN
+LASGN, 401
+ JMP I (HNDERR /BAD HANDLER
+ TAD LASGN
+ DCA DEVHND
+ JMP I GETHND
+ PAGE
+\fBUILDX, TAD LSTADR
+ SZA CLA
+ JMP ALREDY
+ TAD (MAIN-1
+ DCA X1
+ JMS I (SETS1
+ JMS I (SEARCH
+ JMP I (ERSTAD
+ TAD (TVEC-1
+ TAD I (SYMNUM
+ DCA TM1
+ CDF 0
+ TAD I TM1
+ SNA
+ JMP I (ERSTAD
+ DCA LSTADR
+ TAD TM1
+ TAD (7700
+ DCA TM1
+ CLA CLL CML RTL /CHANGE CDF TO CDF CIF
+ TAD I TM1
+ DCA LSTFLD
+ALREDY, CDF 10
+ JMS I (WROVLY
+ TAD (1400
+ JMS STOINF
+ DCA OLDT9
+ TAD (HLA7
+ DCA TM1
+ TAD (-10
+ DCA X3
+ DCA I X1
+ DCA X4
+BLDLP, CLA CLL CML RTL
+ TAD X3
+ SNA CLA
+ JMP BFLD1 /TREAT FIELD 1 (COMMON AREA) DIFFERENTLY
+BLDLPX, TAD I TM1
+ AND (7600
+ SNA
+ JMP BLDSKP
+BLDLPY, TAD (170
+ CLL CML CMA RTR
+ RTR
+ TAD X3
+ CLL CMA RTL
+ RAL
+ DCA I X1
+ DCA I X1
+ ISZ X4
+BLDSKP, CLA CMA
+ TAD TM1
+ DCA TM1
+ ISZ X3
+ JMP BLDLP
+ TAD X4
+ CIA
+ DCA I (1400
+ CIF 0
+ JMS I (SHNDLR
+ 4210
+ 1200
+ MTEMP+10
+ HLT
+ CDF 0
+ TAD (JSTFLD-1
+ JMS STOINF
+ TAD LSTADR
+ DCA I (MSTADR
+ TAD LSTFLD
+ DCA I (MSTCDF
+ JMP I (LDRXIT
+
+BFLD1, TAD COML
+ SNA /IS THERE ANY COMMON?
+ JMP BLDLPX /NO
+ CLL CMA
+ TAD I TM1
+ SNL CLA /IS THERE ANY CODE IN FIELD 1?
+ JMP BLDSKP /NO
+ TAD (110 /SAVE FIELD 1 IN TWO SEGMENTS - PAGE 0 AND
+ DCA I X1 /THE CODE FOLLOWING THE END OF THE COMMON AREA
+ ISZ X4 /(THIS IS TO ENABLE "CHAIN" TO WORK PROPERLY)
+ TAD COML
+ IAC
+ DCA I X1
+ TAD COML
+ CMA
+ TAD I TM1
+ AND (7600
+ JMP BLDLPY
+\fCVTREC, 0
+ TAD CUR
+ CLL RTL
+ RTL
+ RAL
+ AND (7
+ JMP I CVTREC
+
+STOINF, 0
+ DCA X1
+ TAD LSTFLD
+ DCA I X1
+ TAD LSTADR
+ DCA I X1
+ DCA I X1
+ JMP I STOINF
+LSTADR, 0
+LSTFLD, 0
+ PAGE
+
+\fMAPIO, TAD I ML7600
+ SNA
+ TAD TTYNO /TELETYPE IS DEFAULT LISTING DEVICE
+ JMS I (GETHND
+ TAD I ML7604 /PICK UP EXTENSION WORD.
+ SNA /NON-ZERO?
+ TAD (1520 /NO-SUPPLY '.MP' EXTENSION.
+ DCA I ML7604 /YES-LEAVE ALONE
+ TAD ML7601
+ DCA MNAME
+ TAD I (EASGN
+ TAD (100 /4 SHIFTED LEFT INTO THE "DESIRED LENGTH" POSITION
+ JMS I (200
+ 3
+MNAME, 0
+MECNT, 0
+ JMP I (OUERR
+ TAD MNAME
+ DCA ORECNO
+ JMS OUSETP
+ DCA MCCNT
+ TAD (OCHAR
+ DCA TYPE
+ TAD TM1
+ CLL CML RAR
+ JMP I (MAPX
+OCHAR, 0
+ DCA OUTEMP
+ ISZ OJMP
+ ISZ OCHCNT
+OJMPE, JMP OJMP
+ CIF 0
+ JMS I DEVHND
+ 4210
+OUBUF, 4600
+ORECNO, 0
+ JMP I (OUERR
+ ISZ ORECNO
+ ISZ MCCNT
+ JMS OUSETP
+ ISZ MECNT
+ JMP OCHAR+2
+ JMP I (OUERR
+\fOUSETP, 0
+ TAD (-601
+ DCA OCHCNT
+ TAD OUBUF
+ DCA OUPTR
+ TAD OJMPE
+ DCA OJMP
+ JMP I OUSETP
+
+OJMP, HLT /THREE-WAY JUMP FOR CHAR OUTPUT
+ JMP OCHAR1
+ JMP OCHAR2
+OCHAR3, TAD OJMPE
+ DCA OJMP
+ TAD OUTEMP
+ RTL
+ RTL
+ DCA OUTEMP
+ TAD OUTEMP
+ AND OU7400
+ TAD I OUPOLD
+ DCA I OUPOLD
+ TAD OUTEMP
+ RTL
+ RTL
+ AND OU7400
+ TAD I OUPTR
+ DCA I OUPTR
+ ISZ OUPTR
+ JMP OUCOM
+OCHAR2, TAD OUPTR
+ DCA OUPOLD
+ ISZ OUPTR
+OCHAR1, TAD OUTEMP
+ AND OU377
+ DCA I OUPTR
+OUCOM, JMP I OCHAR
+OCHCNT, 0
+ OUPOLD=OUSETP
+OUTEMP, 0
+OU7400, 7400
+OUPTR, 0
+OU377, 377
+\f/CLOSE OUTPUT FILE
+
+OCLOS, TAD (232
+ JMS OCHAR
+ TAD OCHCNT
+ CMA
+ SZA CLA
+ JMP .-4
+ JMS OCHAR
+ TAD I (EASGN
+ JMS I (200
+ 4
+ML7601, 7601
+MCCNT, 0
+ JMP I (OUERR
+ TAD (TTYOUT
+ DCA TYPE
+ JMP I (MAPRTN
+
+TTYOUT, 0
+ 6046
+ 6041
+ JMP .-1
+ML7600, 7600
+ JMP I TTYOUT
+TTYNO, 0 /SET TO TTY DEVICE NUMBER BY INITIALIZATION
+IONULL, 0
+ TAD ML7600
+ DCA I (HLASZA
+ML7604, 7604 /POINTER TO FILE EXT. WORD
+ JMP I IONULL
+ PAGE
+\fLOAD, 0
+ DCA LREQUR
+ TAD BANK
+ TAD (HLAZ
+ DCA HLAPTR
+ JMS I (SETRCN /SET UP HLA AND RCON
+ TAD RCON
+ CLL CML
+ TAD LREQUR
+ TAD (400
+ SNL SZA CLA
+ JMP LFAILD
+ TAD RECNO
+ DCA LRECNO
+ CLA CMA
+ DCA INCHCT
+ JMS ICHAR
+ SNA CLA
+ JMP .-2
+ JMP I (MORE
+
+ICHAR, 0
+ TAD XX7600 /PARITY TTY HACK
+ KRS
+ TAD (-7603
+ SNA CLA
+ KSF
+ SKP
+ JMP I (MGET /17667=07605
+ ISZ IJMP
+ ISZ INCHCT
+IJMPE, JMP IJMP
+ CIF 0
+ JMS I DEVHND
+INCTLW, 0410
+INBUF, 4600
+LRECNO, 0
+ JMP INCKEF
+INISZ, ISZ LRECNO
+ ISZ LRECNO
+ TAD IN6377
+ DCA INCHCT
+ TAD INBUF
+ DCA INPTR
+ TAD IJMPE
+ DCA IJMP
+ JMP ICHAR+1
+\fIJMP, HLT /THREE-WAY JUMP FOR CHAR INPUT
+ JMP ICHAR1
+ JMP ICHAR2
+ICHAR3, TAD IJMPE
+ DCA IJMP
+ TAD I INPTR
+ ISZ INPTR
+ AND IN7400
+ CLL RTR
+ RTR
+ TAD INTEMP
+ RTR
+ RTR
+ JMP INCOM
+ICHAR2, TAD I INPTR
+ ISZ INPTR
+ AND IN7400
+ DCA INTEMP
+ICHAR1, TAD I INPTR
+INCOM, AND IN377
+ JMP I ICHAR
+INCKEF, SMA CLA
+ JMP LRECNO+2
+ JMP I (INERR
+INPTR, 0
+INCHCT, 0
+INTEMP, 0
+IN7400, 7400
+IN377, 377
+IN6377, 6377
+\fXX7600,
+XER2, 7600
+ TAD EASGN
+ TAD (DCB-1
+ DCA TM2
+ TAD I TM2
+ SPA CLA
+ JMP DIRDEV
+ TAD (2205
+ JMS I (TTWO
+ TAD (1417
+ JMS I (TTWO
+ TAD (0104
+ JMS I (TTWO
+ JMS I (CRLF
+DIRDEV, TAD I HLAPTR
+ ISZ BANK
+ CMA
+ AND XX7600
+ JMP LOAD+1
+LFAILD, ISZ BANK
+ JMP LOAD+2
+EASGN, 0
+LREQUR, 0
+LOADOK, JMS I (WRPGBF
+ JMP I LOAD
+
+SETS1, 0
+ TAD (S1-1
+ DCA X2
+ TAD I X1
+ DCA I X2
+ TAD I X1
+ DCA I X2
+ TAD I X1
+ DCA I X2
+ JMP I SETS1
+ PAGE
+\f/ 4600-5177 USED FOR LOADER MAP OUTPUT BUFFER
+/ 5200-5577 USED FOR LIBRARY DIRECTORY BUFFER
+
+ *5600
+
+/** CAN ONLY USE FIRST HALF OF THIS PAGE - 2ND HALF IS PART OF MST
+/** NO LITERALS IN THIS PAGE!
+
+LBRY, TAD RECNO
+ JMS LBSRCH
+ JMP I .+1
+ GETCD
+
+LBSRCH, 0 /LIBRARY SEARCH ROUTINE
+ DCA LBREC /SAVE START BLK OF LIBRARY
+ CIF 0
+ JMS I DEVHND /READ LIBRARY DIRECTORY
+LBCTLW, 0210
+L5200, 5200
+LBREC, 0
+ JMP I LIOERR
+ TAD LBCTLW
+ DCA I LINCTL
+ TAD L7177
+ DCA I LIN6377
+ DCA I LINISZ
+ TAD L5177
+ DCA X1 /INITIALIZE FOR SEARCH
+LBRYLP, JMS I LSETS1 /GET NEXT DIRECTORY ENTRY
+ TAD I X1
+ SNA
+ JMP I LBSRCH /END OF DIRECTORY
+ TAD L5200
+ DCA LBFPTR
+ JMS I LSEARCH /IS IT IN SYMTAB?
+ JMP LBRYLP /NO
+ TAD I LSYMNUM
+ TAD LTVEC1
+ DCA TM1
+ CDF 0
+ TAD I TM1
+ CDF 10
+ SZA CLA /IS SYMBOL ALREADY DEFINED?
+ JMP LBRYLP /YES
+LBLDLP, TAD I LBFPTR /GET MODULE TO LOAD
+ SNA
+ JMP LBRYLP-2 /NO MORE MODULES TO LOAD
+ AND L177
+ IAC
+ TAD LBREC
+ DCA RECNO
+ DCA BANK
+ TAD I LBFPTR
+ AND L7600
+ JMS I LLOAD /LOAD LIBRARY MODULE
+ ISZ LBFPTR
+ JMP LBLDLP /GET NEXT MODULE
+
+LBFPTR, 0
+LIOERR, INERR
+LINCTL, INCTLW
+L7177, 7177
+LIN6377, IN6377
+L5177, 5177
+LSETS1, SETS1
+LSEARCH, SEARCH
+L177, 177
+L7600, 7600
+LLOAD, LOAD
+LSYMNUM, SYMNUM
+LINISZ, INISZ
+LTVEC1, TVEC-1
+ IFZERO .-5700&4000 <LBRERR, _ERROR>
+\f/MAIN LOADING CODE
+/MODIFIED VERSION OF
+/PAPER-TAPE LINKING LOADER
+
+/DEFINITIONS
+
+BCRT= 200
+TVEC= 300
+ORGT= 100 /LOCAL SYMBOL TABLE NOW IN FIELD 0
+MST= 6177 /MAIN SYMBOL TABLE
+
+*6200
+
+/START OF PROGRAM - INITIALIZATION
+
+START, 0
+ TAD K7600 /SET COUNTER FOR 200
+ DCA NSUB
+ TAD BCRTA /POINTER TO BANK TABLE
+ DCA X3
+ CDF 00
+ DCA I X3 /CLEAR BANK TABLE & TV TABLE
+ ISZ NSUB
+ JMP .-2 /NOT DONE
+ CDF 10
+ TAD M10
+ DCA NSUB
+ TAD HLAZA
+ DCA X3
+ TAD K777
+ DCA I X3 /BANK0 HIGHEST LOADED ADDR. =777
+ ISZ NSUB /NSUB INCREMENTS TO ZERO
+ JMP .-2
+ DCA COML /INIT. OLD COMMON AT 0000
+ JMP I START
+\f/REENTRY FOR NEXT ROUTINE TO BE LOADED
+
+MORE, DCA LMTC /CLR LOCAL SYMBOL COUNT
+ DCA CSUM /CLR CHECKSUM
+ TAD MORE1A /SET FOR RETURN TO MORE1 IF LEADER
+ DCA EOF
+MORE1, JMS RWORD
+ TAD RC10A /RESET EOF TO WATCH FOR TRAILER
+ DCA EOF
+ TAD CODE /CK FOR HIGH COMMON
+ TAD M12
+ SZA CLA
+ JMP I ER5P /NOT THERE
+ TAD COML
+ CIA
+ CLL CML /IF NO COMMON EXISTS, OR
+ TAD WORD /IF NEW COMMON .LE. OLD IT'S
+ SNL SZA CLA /OK, ELSE ERROR
+ JMP I ER3P
+ TAD COML
+ SNA CLA
+ TAD WORD /IF NO PREVIOUS COMMON AND IF
+ AND K7600 /THIS PROGRAM HAS COMMON ABOVE 177
+ SNA /THEN SET COMMON LIMIT TO LIMIT OF THIS PROG
+ JMP GETSW
+ AND K7400
+ TAD K377 /HIGH COMMON MUST BE AT A MULTIPLE OF 400
+ DCA COML
+ TAD I HLA1P /IF WE HAVE LOADED
+ SZA CLA /ANY CODE INTO FIELD 1
+ JMP I ER3P /IT'S AN ERROR
+ TAD COML /SET BANK1 HIGHEST LOADED ADDRESS
+ DCA I HLA1P
+ JMS I (SETRCN /SET UP HLA AND RCON AGAIN JUST IN CASE
+GETSW, TAD BANK /BANK NUMBER
+ TAD TOPCOR /OK FOR NON-EX. MEM.
+ SMA CLA
+ JMP I ER2I /TOO BIG
+/
+/MAIN LOADING LOOP
+/
+LOOP, JMS RWORD
+ TAD BASE /LOCATE CORRECT FUNCTION
+ TAD CODE /IN TRANSFER TABLE
+ DCA CODE
+CODE, 0 /TRANSFER TO APPROPRIATE ADDRESS
+\f/READ 12-BIT COMPUTER WORD & 4-BIT RELOCATION CODE
+/FROM 2 INPUT CHARACTERS
+
+RWORD, 0
+ JMS I HSRPA /FIRST FRAME
+ DCA WORD
+ TAD WORD /EXTRACT RELOC. CODE
+ RTR
+ RTR
+ AND K17
+ DCA CODE
+ TAD CODE /CK FOR LEADER
+ TAD M10
+ SNA CLA
+ JMP I EOF /YES
+ TAD WORD /ADD TO CHECKSUM
+ TAD CSUM
+ DCA CSUM
+ JMS FORMWD
+ JMS I RCHARP
+ TAD WORD
+ DCA WORD
+ JMP I RWORD
+
+FORMWD, 0
+ TAD WORD
+ RTR
+ RTR
+ RAR
+ AND K7400 /ISOLATE HI 4 BITS
+ DCA WORD /FROM 1ST CHAR
+ JMP I FORMWD
+
+/DATA
+
+EOF, 0
+LMTC, 0
+K17, 17
+K377, 377
+K777, 777
+K7400, 7400
+K7600, 7600
+M10, -10
+M12, -12
+BASE, JMP I TRTAB
+BCRTA, BCRT-1
+HLAZA, HLAZ-1
+HSRPA, ICHAR
+MORE1A, MORE1
+RCHARP, RCHAR
+TOPCOR, 0
+HLA1P, HLA1
+ER2I, ER2
+\f/RELOCATION CODE TRANSFER TABLE
+
+TRTAB, RC0 /LOAD AS IS
+ RC1 /ADD RELOCATION CONSTANT
+ ER5
+ RC3 /DEFINE SYMBOL
+ RC4 /ORIGIN
+ RC5 /CDF TO CURRENT BANK
+ RC6 /REPLACE LOCAL # WITH GLOBAL #
+ ER5
+RC10A, RC10 /LEADER-TRAILER
+ ER5
+ER3P, ER3 /HIGH COMMON
+ER5P, ER5
+ ER5
+ ER5
+ ER5
+ RC17 /EXTERNAL SYMBOL SPECIFICATION
+ PAGE
+\f/NEW ORIGIN
+
+RC4, TAD WORD /NEW ORIGIN
+ CLL
+ TAD RCON /+ RELOCATION CONSTANT
+ DCA CUR /= NEW LOADING ADDRESS
+ SZL
+ JMP I OVERFP /FIELD OVERFLOW
+ JMP I LOOPP1
+/
+/CHANGE CDF TO CURRENT BANK
+/
+RC5, TAD BANK /MOVE BANK TO BITS 6-8
+ CLL RTL
+ RAL
+ TAD WORD /PICK UP CDF
+ JMP RC1+2
+/
+/REPLACE LOCAL EXTERNAL SYMBOL NUMBER WITH GLOBAL EXT. SYM. NO.
+/
+RC6, TAD WORD
+ AND K77 /EXTRACT LOCAL NUMBER
+ DCA B1
+ TAD B1 /CK IF LOCAL # .LE. LOCAL SYM. COUNT
+ CIA
+ TAD I LMTCP1
+ SPA CLA
+ JMP I ER5I /NO
+ TAD B1 /ADD LOCAL # TO BASE OF TABLE
+ TAD ORGTA
+ DCA B1
+ TAD WORD /LOAD ARG COUNT
+ AND K7700
+KCDF, CDF 0
+ TAD I B1 /+ GLOBAL #
+ CDF 10
+ JMP RC1+2 /AT CURRENT LOADING ADDRESS
+\f/ADD RELOCATION CONSTANT TO WORD
+
+RC1, TAD WORD
+ TAD RCON
+ DCA WORD
+/
+/LOAD WORD DIRECTLY AS IT IS
+/
+RC0, TAD HLA /CK FOR CURRENT ADDRESS TO LOAD
+ CIA CLL /.GE. HIGHEST ALREADY LOADED
+ TAD CUR
+ SNL CLA
+ JMP .+3 /NO
+ TAD CUR /YES, RESET HIGHEST
+ DCA HLA
+ CLL
+ TAD CUR /CK FOR ATTEMPT TO LOAD TOP PAGE
+ TAD K200
+ SZL CLA
+ JMP I OVERFP /YES, ROUTINE IS TOO BIG
+ CLA CMA
+ TAD BANK
+ SZA CLA
+ JMP JUSTLD
+ CLL CML CLA RTR
+ TAD CUR
+ SZL SPA CLA
+ JMP GT2000
+ TAD OVLYFG
+K7700, SMA CLA
+ JMP OFFSET
+ JMS I (CVTREC
+ TAD (-11
+ JMP PAGEX2
+GT2000, TAD CUR
+ CLL
+ TAD (-3600
+ SZL CLA
+ JMP PAGEX1
+ JMS I (WROVLY
+ CLA CMA
+ DCA OVLYFG
+ JMP JUSTLD
+PAGEX1, TAD K200
+ JMS I (CVTREC
+PAGEX2, TAD (MTEMP+11
+ JMS I (WRPGBF
+ CLA CLL CML RTR
+ TAD CUR
+ SZL SPA CLA
+ TAD K200
+ TAD CUR
+ AND (377
+ TAD (1400
+ JMP JUSTLD+1
+OFFSET, CLA IAC
+ DCA OVLYFG
+ TAD (1600
+JUSTLD, TAD CUR
+ DCA CURX
+ TAD BANK
+ CLL RTL
+ RAL
+ TAD KCDF
+ DCA .+2
+ TAD WORD
+ HLT
+ DCA I CURX
+ CDF 10
+ ISZ CUR
+ JMP I LOOPP1
+CURX, 0
+/
+/DATA
+/
+K77, 77
+K200, 200
+ER5I, ER5
+LMTCP1, LMTC
+LOOPP1, LOOP
+ORGTA, ORGT
+OVERFP, OVERFL
+HLAZ, 0 /HLA GROUP MUST REMAIN IN GIVEN ORDER
+HLA1, 0
+HLA2, 0
+HLA3, 0
+HLA4, 0
+HLA5, 0
+HLA6, 0
+HLA7, 0
+B1,
+
+HLATST, 0
+ TAD HLAZ
+ TAD HLAIO
+HLASZA, SZA CLA /SET TO CLA BY /R AND RESTART
+ JMP I (UIOERR
+ JMP I HLATST
+HLAIO, -777
+ PAGE
+\f/SYMBOL DEFINITION
+
+RC3, JMS I GTSYMP
+ TAD TVM1 /ADJUSTED BASE OF TRANSFER VECTOR TABLE
+ TAD SYMNUM /+ NUM. OF SYMBOL IN MST
+ DCA C1
+ TAD RCON /LOADING ADDRESS OF THE SYMBOL
+ TAD WORD
+ CDF 00
+ DCA I C1 /TO THE TRANS. VEC. TABLE
+ TAD C1 /GET POINTER INTO TRANSFER VECTOR TABLE
+ TAD M100A /FORM CORRESPONDING POINTER INTO BANK TABLE
+ DCA C1 /=PTR. TO BANK TABLE STORAGE
+ TAD BANK /GET BANK IN BITS 6-8
+ CLL RTL
+ RAL
+ DCA I C1 /STORE IN BANK TABLE
+ CDF 10
+RC3A, TAD NSUB /CHECK FOR TOO MANY SYMBOLS
+ TAD M100A
+ SPA SNA CLA
+ JMP I LOOPP2 /NO
+ JMP ER1
+/
+/TRANSFER VECTOR
+/
+RC17, TAD WORD /COUNTER OF SYMBOLS TO COME
+ CIA
+ DCA C2
+RC17A, JMS I GTSYMP
+ ISZ I LMTCP2 /INC. LOCAL SYM. CTR.
+ TAD ORGTA2 /GET PTR TO STORAGE IN ORIG. TABLE
+ TAD I LMTCP2
+ DCA C1
+ CMA /SYM. # -1 TO ORIG. TABLE
+ TAD SYMNUM
+ CDF 0
+ DCA I C1
+ CDF 10
+ ISZ C2 /CK CTR.
+ JMP RC17A /NOT DONE
+ JMP RC3A
+\f/ERRORS
+
+SIOERR,
+H7600, 7600
+ DCA ERBACK
+ IAC
+HNDERR, IAC
+ERSTAD, IAC
+INERR, IAC
+OUERR, IAC
+ER5, IAC /ILLEGAL INPUT FORMAT
+ER4, IAC /CHECKSUM ERROR
+ER3, IAC /HIGHEST COMMON NOT FIRST
+ER2, IAC /PROGRAM TOO LARGE
+ER1, IAC /SYMBOL TABLE OVERFLOW
+UIOERR, DCA C3
+ JMS CRLF
+ TAD K0522 /"ER"
+ JMS TTWO
+ TAD K2217 /"RO"
+ JMS TTWO
+ TAD K2240 /"R "
+ JMS TTWO
+ TAD C3 /#
+ JMS TOCT
+ JMS I (WRPGBF
+ERBACK, JMP I (CDCALL
+ CDF CIF 0
+ JMP I H7600 /RETURN TO MONITOR
+/
+/TYPE A CARRIAGE RETURN & LINE FEED
+/
+CRLF, 0
+ TAD K215
+ JMS I TYPE
+ TAD K212
+ JMS I TYPE
+ JMP I CRLF
+/
+/UNPACK & TYPE 2 6-BIT CHARACTERS
+/
+TTWO, 0
+ DCA C1
+ CMA /SET FLAG FOR 1ST CHARACTER
+ DCA C2
+ TAD C1 /MOVE LEFT HALF DOWN
+ RTR
+ RTR
+ RTR
+ SKP
+TTWO1, TAD C1 /GET RIGHT HALF
+ AND C77
+ TAD M40 /200 OR 300 GROUP?
+ SPA
+ TAD K100 /300 + 6BIT
+ TAD K2240 /200 + 6BIT
+ JMS I TYPE
+ ISZ C2 /2ND CHARACTER DONE?
+ JMP I TTWO
+ JMP TTWO1 /NO
+/
+/TYPE OCTAL CONTENTS OF AC
+/
+TOCT, 0
+ DCA C1
+ TAD M4B
+ DCA C2
+TOCT1, TAD C1 /MOVE NEXT DIGIT INTO BITS 9-11
+ RTL
+ RAL
+ DCA C1
+ TAD C1 /GET DIGIT
+ RAL
+ AND KK7
+ TAD C260 /CONVERT TO ASCII
+ JMS I TYPE
+ ISZ C2
+ JMP TOCT1 /MORE TO GO
+ JMP I TOCT
+/
+/DATA
+/
+C1, 0
+C2, 0
+C3,
+SYMNUM, 0
+KK7, 7
+C77, 77
+K100, 100
+K212, 212
+K215, 215
+C260, 260
+K0522, 0522
+K2217, 2217
+K2240, 2240
+M4B, -4
+M40, -40
+M100A, -100
+GTSYMP, GETSYM
+LMTCP2, LMTC
+LOOPP2, LOOP
+ORGTA2, ORGT
+TVM1, TVEC-1
+ PAGE
+\f/STORE OR LOOK UP SYMBOL IN SYMBOL TABLE
+
+DEFN, 0
+
+/READ A SYMBOL FROM INPUT ASCII - 6 FRAMES
+
+ CLA CLL CMA RTL
+ DCA D1
+ TAD S1A /POINTER TO 3 WORD BUFFER
+ DCA X3
+RSYM1, JMS RCHAR
+ AND K0077 /EXTRACT 6-BIT
+ CLL RTL
+ RTL
+ RTL
+ DCA D3 /SAVE LEFT HALF
+ JMS RCHAR
+ AND K0077 /GET RIGHT HALF
+ TAD D3
+ DCA I X3
+ ISZ D1
+ JMP RSYM1 /NOT DONE
+ JMP I DEFN
+/
+/SEARCH SYMBOL TABLE FOR CURRENT SYMBOL (IN S1-S3)
+/
+SEARCH, 0
+ DCA I SYMNMP /CLR SYMBOL COUNTER
+ TAD MSTA /SET SYMBOL TABLE PTR
+ DCA D4
+ TAD NSUB /SET CTR FOR NUMBER OF SYMBOLS
+ CMA /+1 (IN CASE NSUB=0)
+ DCA D5
+ JMP SRCH2
+SRCH1, ISZ I SYMNMP /KEEP COUNT
+ TAD D4 /TEST TABLE ENTRY
+ DCA X4 /SYM. TAB. PTR
+ CLA CLL CMA RTL
+ DCA D2 /COUNTER
+ TAD S1A
+ DCA X3 /PTR TO S1/S3
+COMP1, TAD I X4 /COMPARE WORDS
+ CIA
+ TAD I X3
+ SZA CLA
+ JMP NOMACH /NOT ALIKE
+ ISZ D2
+ JMP COMP1 /TRY NEXT WORD OF TRIPLET
+ ISZ SEARCH
+ JMP I SEARCH
+NOMACH, CLA CLL CMA RTL
+ TAD D4
+ DCA D4
+SRCH2, ISZ D5
+ JMP SRCH1 /NOT DONE
+ JMP I SEARCH
+/
+/ENTER A SYMBOL IN THE SYMBOL TABLE
+/
+INSERT, 0
+ TAD NSUB /(NUMBER OF SYMBOLS)*3
+ CLL RAL
+ TAD NSUB
+ CIA /SUBTRACT FROM BASE OF TABLE
+ TAD MSTA
+ DCA X3 /FOR POINTER
+ TAD S1 /1ST WORD
+ DCA I X3
+ TAD S2 /2ND
+ DCA I X3
+ TAD S3 /3RD
+ DCA I X3
+ ISZ NSUB /COMPUTE SYM. TAB. NUMBER
+ TAD NSUB
+ DCA I SYMNMP
+ JMP I INSERT
+/
+/CORE OVERFLOW
+/
+OVERFL, TAD BCRTA3
+ DCA D1
+ TAD TVECA3
+ DCA D2
+ TAD M100
+ DCA D3
+ CDF 00
+OVERF2, TAD I D1 /CK FOR CDF IN BCRT
+ SPA CLA
+ JMP .+3 /YES
+ DCA I D1 /NO, CLEAR IT
+ DCA I D2 /CLEAR TV WORD
+ ISZ D1
+ ISZ D2
+ ISZ D3
+ JMP OVERF2 /MORE TO GO
+ CDF 10
+ JMP I ER2P
+
+GETSYM, 0 /GET SYMBOL AND SEARCH TABLE
+ JMS DEFN
+ JMS SEARCH
+ JMS INSERT
+ JMP I GETSYM
+\f/READ 1 FRAME & ADD TO CHECKSUM
+
+RCHAR, 0
+ JMS I HSRPB
+ DCA D4
+ TAD D4
+ TAD CSUM
+ DCA CSUM
+ TAD D4
+ JMP I RCHAR
+
+SETRCN, 0 /SUBR TO SET HIGHEST-LOADED ADDRESS (HLA)
+ TAD I HLAPTR /AND RELOCATION CONSTANT (RCON)
+ DCA HLA
+ TAD HLA
+ AND (7600
+ DCA RCON
+ JMP I SETRCN
+
+MAIN, 1501;1116;4040 /"MAIN"
+
+/
+/DATA
+/
+D1, 0
+D2, 0
+D3, 0
+D4, 0
+D5, 0
+S1, 0
+S2, 0
+S3, 0
+K0077, 77
+M100, -100
+BCRTA3, BCRT
+ER2P, XER2
+HSRPB, ICHAR
+MSTA, MST-3
+S1A, S1-1
+SYMNMP, SYMNUM
+TVECA3, TVEC
+ PAGE
+\f/TRAILER CODE EXIT
+
+RC10, JMS I (FORMWD
+ JMS I HSRP /GET LOW ORDER PART
+ TAD WORD
+ CIA
+ TAD CSUM /COMPARE WITH ACCUMULATED SUM
+ SZA CLA
+ JMP I ER4P /NOT EQUAL
+ TAD BCRTA4
+ DCA T1
+ TAD TVECA
+ DCA X2
+ TAD M100D
+ DCA T3
+K6201A, CDF 00
+RC10Z, TAD I X2 /GET TV ENTRY
+ SNA CLA
+ JMP .+5 /NOT DEFINED; IGNORE IT
+ TAD I T1 /GET BCRT WORD
+ AND K70 /EXTRACT BANK
+ TAD K6201A /COMBINE CDF
+ DCA I T1
+ ISZ T1
+ ISZ T3
+ JMP RC10Z /NOT DONE YET
+ CDF 10
+ TAD HLA /STORE HIGHEST LOADED ADDRESS
+ DCA I HLAPTR /IN PROPER LOC. (HLA0-7)
+ JMP I (LOADOK
+\f/LOADER MAP PRINT ROUTINE CONTINUED
+
+MAPX, SNL CLA /IF LINK=1 ONLY PRINT PAGE COUNTS,
+ TAD NSUB /OTHERWISE PRINT SYMBOLS
+ CMA
+ DCA T1 /CTR OF ROUTINES
+ TAD MSTA4 /SYMB. TAB. PTR.
+ DCA X1
+ TAD TVECA /TV PTR
+ DCA X2
+ TAD BCRTA4 /BCRT PTR
+ DCA T4
+ TAD (2640 /PRINT V#
+ JMS I TTWOP
+ TAD (VERSION+PATCH
+ JMS I TTWOP
+ JMS I CRLFP
+ JMP PRINT1
+PRINT, TAD TM1
+ RTR CLL
+ CDF 0
+ TAD I X2
+ CDF 10
+ DCA TM2
+ TAD TM2
+ SNL SZA CLA
+ JMP PIGNOR
+ TAD I X1
+ JMS I TTWOP
+ TAD I X1
+ JMS I TTWOP
+ TAD I X1
+ JMS I TTWOP
+ TAD K4040 /2 SPACES
+ JMS I TTWOP
+ CDF 00
+ TAD I T4 /PRINT BANK NUMBER
+ CDF 10
+ RTR
+ RAR
+ AND K7B
+ TAD K260
+ JMS I TYPE
+ TAD TM2 /PRINT SYMBOL VALUE
+ JMS I TOCTP
+ TAD TM2 /IF ADDRESS=0,IT IS UNDEFINED
+ SZA CLA
+ JMP .+3 /ITS OK
+ TAD K4025 /TYPE SPACE,U
+ JMS I TTWOP
+ JMS I CRLFP
+ TAD M03
+PIGNOR, TAD M03
+ TAD X1
+ DCA X1
+ ISZ T4
+PRINT1, ISZ T1
+ JMP PRINT /JUMP IF MORE SYMBOLS, ELSE FALL INTO NEXT PG
+\fPAGES, TAD FCTR /SET CTR FOR CORRECT # OF BANKS
+ DCA T1
+ TAD (HLAZ-1 /INIT. PTR. TO HLA LIST
+ DCA X1
+ TAD I X1 /GET HLA OF NEXT BANK
+ CMA RTL /DIVIDE BY 200 AND COMPLEMENT
+ RTL
+ RTL
+ AND K37 /=NUMBER OF PAGES LEFT + 1
+ SZA
+ TAD (-1 /REDUCE IF NON-ZERO
+ JMS I TOCTP
+ JMS I CRLFP
+ ISZ T1
+ JMP PAGES+4 /NOT DONE WITH ALL BANKS
+ JMP I (OCLOS
+
+/
+/DATA
+/
+FCTR, 0 /# OF HIGHEST MEM. FIELD
+K37, 37
+T1, 0
+T3, 0
+T4, 0
+K7B, 7
+K70, 70
+K260, 260
+K4025, 4025
+K4040, 4040
+M03, -3
+BCRTA4, BCRT
+CRLFP, CRLF
+ER4P, ER4
+HSRP, ICHAR
+MSTA4, MST-3
+TOCTP, TOCT
+TTWOP, TTWO
+TVECA, TVEC-1
+M100D, 7700
+ PAGE
+\f/WROVLY IS USED TO STORE THE FIELD COUNT FOR THE PROPGT
+/ROUTINE- PROPGT IS CALLED THE FIRST TIME THAT IOTEST IS
+/CALLED-SEE LOC.325 IN FIELD ZERO(APPROX.)
+
+BC1000, 1000
+WROVLY, 0
+ TAD OVLYFG
+ SPA SNA CLA
+ JMP I WROVLY
+ CIF 0
+ JMS I (SHNDLR
+ 0110
+ 1600
+ MTEMP
+ JMP I (SIOERR
+ CIF 0
+ JMS I (SHNDLR
+ 5010
+ 1600
+ MTEMP
+ JMP I (SIOERR
+ DCA OVLYFG
+ JMP I WROVLY
+
+WRPGBF, 0
+ DCA PRECNO
+ TAD WRBFSW
+ SNA
+ JMP PREAD
+ CIA
+ TAD PRECNO
+ SNA CLA
+ JMP I WRPGBF
+ CIF 0
+ JMS I (SHNDLR
+ 4210
+ 1400
+WRBFSW, 0
+ JMP I (SIOERR
+PREAD, DCA OLDT9
+ TAD PRECNO
+ SNA CLA
+ JMP SETBF
+ CIF 0
+ JMS I (SHNDLR
+ 0210
+ 1400
+PRECNO, 0
+ JMP I (SIOERR
+SETBF, TAD PRECNO
+ DCA WRBFSW
+ JMP I WRPGBF
+\f/LOADER CLEANUP CODE - PREPARES TO RETURN TO OS/8
+
+LDRXIT, CDF 10
+ TAD I (HLA1
+ TAD BC200
+L7700, SMA CLA /DID WE LOAD OVER THE LOADER?
+ TAD (FIVE /NO
+ DCA WROVLY /WROVLY=0 OR 5
+ CIF 0
+ JMS I (SHNDLR
+ 0201
+ 400
+ MTEMP+21 /READ BACK THE RUN-TIME ROUTINES
+ JMP I (SIOERR /BADDIE
+ TAD K1600
+ CDF 0
+ DCA I ST1600
+ TAD I P4
+ DCA I P5
+ ISZ P4
+ ISZ P5
+ ISZ P6
+ JMP .-5 /ALSO MOVE 16-32 INTO LOC 100
+ CDF 10
+ JMS I BC200
+ 13 /RESET EVERYTHING
+ TAD I (MPARAM
+ AND (40 /GET "/G" SWITCH
+ SNA CLA
+ JMP CALMON /GO SWITCH NOT ON
+ JMS I BC200
+ 11 /KICK MONITOR OUT
+ CDF CIF 0
+ TAD (MSTCDF
+ DCA I (FIVE+1 /GO TO PROGRAM START ADR INSTEAD OF 7600
+ ISZ I (ONE /OPTOMIZE READ A LITTLE ON DECTAPE
+ JMP I WROVLY
+
+CALMON, CLA CMA
+ DCA I L7700 /INDICATE I/O MONITOR IS IN CORE
+ CDF CIF 0
+ JMP I WROVLY /GET OUT
+
+ST1600, 177 /THIS IS SET TO "FINBUF" OR "FOUBUF" BY /I AND /O
+P4, 16
+P5, 100
+P6, -15
+\f/ROUTINE TO TEST FOR /I AND /O SWITCHES
+
+IOTEST, 0
+ TAD I (MPARAM
+ AND (10
+ SNA CLA //I?
+ JMP .+4
+ JMS I (HLATST
+ CDF CIF 0
+ JMS I (INPENB
+ TAD I (MPARAM+1
+BC200, AND BC1000
+ SNA CLA //O?
+ JMP .+4
+ JMS I (HLATST
+ CDF CIF 0
+ JMS I (OUPENB
+ ISZ DOPROP /SHOULD WE PROPAGATE RESIDENT(AND WRITE OUT
+ JMP .+4 /THE RUN-TIME ROUTINES?)--NO
+ TAD WROVLY /YES-FIELD COUNT IS IN WROVLY
+ CDF CIF 0
+ JMS I (PROPGT /DO IT
+ JMP I IOTEST
+K1600, 1600 /RESET TO 2000 IF TWO PG.DEV.HNDLRS AT RUN TIME
+DOPROP, 7777 /ONCE-ONLY FLAG FOR PROPAGATING FIELD ZERO
+ /RESIDENT AND WRITING OUT RUNTIME ROUTINES
+ /NOT RESET AFTER /R!!!!
+ /SET TO -2 IF CALLED BY ".R LOADER"
+ /BECAUSE OF USELESS INIT CALL TO IOTEST
+ PAGE
+ $
+\f
projects / pdp8.git / blobdiff