Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
rerun.mac
There are 21 other files named rerun.mac in the archive. Click here to see a list.
; UPD ID= 1607 on 1/2/79 at 4:23 PM by N:<NIXON>
TITLE RERUN V12A
;COPYRIGHT (C) 1973, 1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH FTDEFS ; FILE TABLE DEFINITIONS
%%FTDF==:%%FTDF ; CAUSE ERROR IF DEFINITIONS CHANGE
SEARCH LBLPRM,COMUNI
IFN TOPS20,<SEARCH MONSYM>
MLON
TWOSEG HI.ORG
VERSION==1201 ;VERSION
EDIT==6
LOC 137 ;.JBVER
XWD VERSION,EDIT
RELOC HI.ORG
; EDIT 6 MAKE COMPATIBLE WITH VERSION COBOL-68 V12 (NO SELOTS)
; EDIT 5 CHANGED TO TAKE ADVANTAGE OF NEW 603 FILOP. TO ALLOW DIRECT
; ADDRESSING OF FILES LARGER THAN 2**18-1
; EDIT 4 CHANGED LOCATION OF GETSEG CALL BECAUSE OF COMPILER CHANGE
; IN COBOLG AND PURE. ALSO ADDED ERROR MESSAGE WHICH SHOWS THAT
; A FILE OPEN ON CHANNEL 0 LOSES BECAUSE OF GETSEG'S
;EDIT 3 FIXES VARIOUS MONITOR PROBLEMS WITH RERUN,
;FOR EXAMPLE ILLEGAL DATA MODE
;EDIT 2 TTY BUFFER IS NOT SETUP BEFORE IT IS USED -- AC4 IS NOT SETUP FOR SDN WHEN CALLED FROM IDEV1 [EDIT#2]
;EDIT 1 A. THE CALLING SEQUENCE FOR SELOTS IS WRONG,
; B. SELOTS DOES A CALLI RESET I.E. RELEASES ALL IO CHANNELS THAT RERUN JUST SETUP.
FILOP.==CALLI 155 ;FOR USETI/O
AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
FLG=7
AC10=10
AC11=11
LEBLK=11
C=10
AC12=12
AC13=13
AC14=14
FLG1=14
AC15=15
AC16=16
I16=AC16
PP=17
EXTERN .JBFF,.JBDA,.JBREL,.JBREN,.JBDDT,.JB41,.JBSYM,.JBSA,.JBAPR,.JBVER,.JBHRL
NONSTD== 100000 ;NONSTANDARD LABELS
STNDRD== 40000 ;STANDARD LABELS
OPNIN== 20000 ;FILE IS OPEN FOR INPUT
OPNOUT== 10000 ;FILE IS OPEN FOR OUTPUT
OPNIO== 4000 ;FILE IS OPEN FOR INPUT/OUTPUT
RANFIL== 1 ;A RANDOM ACCESS FILE
; NOTE FOLLOWING MUST BE CHANGED IF COMPILER CHANGES STARTING CODE
GETSGA==2 ; LOCATION OF GETSEG INSTRUCTION WRT TO START ADDRESS
GETSGL==4 ; LOCATION OF MOVEI 16,%LIT00 INSTRUCTION WTR TO START ADDRESS
SELARG==1 ; LOACTION OF SELOTS ARG BLOCK WRT TOSTART ADDRESS
IFNDEF DDTFLG,<DDTFLG==0>
IFN DDTFLG,<
LOC 124 ;.JBREN
EXP WEN
RELOC
;LOADER SW FOR DDT = /1H/D/-H/1BRERUN$ - THEN TO
;RUN WITH DDT DO .GET RERUN
; .ST 140
;LINK COMMANDS
;/SYMSEG:HIGH,SYS:DDT/SEG:HIGH,RERUN/LOCAL,/G
EXTERN DDT
WEN: SETZ ;TURN ON THE WRITE ENABLE BIT
CALLI 36 ; SO DDT IS USEFUL
HALT .
JRST DDT
>
ST: CALLI ;RESET
SETZ AC0, ;SET TO WRITE ENABLE
CALLI AC0,36 ;DOIT
JRST [TTCALL 3,[ASCIZ /? SETUWP UUO FAILED FOR RERUN HI-SEG/]
CALLI 12] ;EXIT
HRLI PP,-20 ;LENGTH
HRR PP,.JBFF ;PD LIST
ADDI PP,100 ;
HRRZ AC0,PP ; MAKE SURE THERE IS ENOUGH CORE
CAML AC0,.JBREL ; IS THERE?
JRST ST1 ; YES
CALLI AC0,11 ; CORE UUO
JRST GETCO1 ; FAILED
ST1: INIT 17,17 ;INIT THE CHECKPOINT DEVICE
SIXBIT /DSK/ ;
Z ;NO HEADERS
JRST [TTCALL 3,[ASCIZ /? CANNOT INIT CHECKPOINT DEVICE/]
CALLI 12] ;EXIT
SETZ FLG, ;INIT FLG REG
PUSHJ PP,GETFN ;SETUP LOOKUP BLOCK AC3-6
MOVEM AC3,GSBLK+1 ;FILENAME FOR GETSEG
LOOKUP 17,AC3
JRST [TTCALL 3,[ASCIZ /? CHECKPOINT FILE LOOKUP FAILED/]
MOVEI AC1,17
AND AC1,AC4
TTCALL 3,@LEMSG(AC1)
CALLI 12] ;EXIT
SETZ AC4, ;IOWD TERMINATOR
MOVE AC3,.JBFF
IFE TOPS20,<
HRLI AC3,-2 ;TWO WORDS FOR TOPS10
>
IFN TOPS20,<
HRLI AC3,-3 ;THREE WORDS FOR TOPS-20
>
IN 17,AC3 ;READ IT
SKIPA AC2,1(AC3) ;(.JBFF)+1/ [TEMP.],,(.JBREL)
INERR: JRST [TTCALL 3,[ASCIZ /? INPUT ERROR FROM CHECKPOINT FILE./]
CALLI 12] ;EXIT
MOVE AC4,2(AC3)
MOVEM AC4,CBLVER ;SAVE VERSION # (0 BEFORE V12)
IFN TOPS20,<
MOVE AC4,3(AC3) ;GET JFN STRING
MOVEM AC4,SAVSTR ;SAVE UNTIL LOW SEG READ
>
HRRZ AC0,AC2 ;.JBREL
CAML AC0,.JBREL ;SKIP ATTEMPT TO SHRINK CORE
PUSHJ PP,GETCOR ;MAKE ROOM FOR THE CHECKPOINT FILE
MOVNI AC3,-140(AC2) ;NEGATE THE LENGTH - .JBDA
HRL AC3,AC3 ;
HRRI AC3,.JBDA-1
SETZ AC4, ;TERMINATOR
IN 17,AC3 ;THE LOW SEGMENT
SKIPA ; SAVED "JDA" STARTS AT (.JBFF)
JRST INERR ;ERROR
HLRZM AC2,AC4 ;ADR FOR TEMP.
MOVE AC0,2(AC4) ;(TEMP.2)=[START.]
MOVEM AC0,START. ;SAVE IT
MOVE PP,1(AC4) ;(TEMP.1)=PP SAVE
MOVE AC4,(AC4) ;FILES.
HLRM AC4,.JBFF ;
HRRZM AC4,FILES ;FILE TABLE POINTER
IFN TOPS20,<
GOTHS: SKIPN 2,SAVSTR ;GET THE STRING
JRST SCAN ;MUST BE V11 OR EARLIER
HRLZI 1,(1B2+1B17) ;SHORT GTJFN
GTJFN
JRST GETHS ;NOT AVAILABLE, ASK USER
HRLI 1,400000 ;THIS PROCESS
TRO 1,GT%ADR ;CHECK ADDRESS LIMITS
MOVE 2,[400,,577] ;ALL OF HIGH SEGMENT EXCEPT OTS
GET
JRST SCAN ;OK
GETHS: HRROI 1,[ASCIZ /TYPE FILE SPEC OF SAVE FILE
/]
PSOUT
MOVE 1,SAVSTR
MOVEI 2,20*5
SETZ 3,
RDTTY ;ACCEPT FILE SPEC
JRST GETHS ;ERROR
JRST GOTHS ;NOW TRY AGAIN
>
;SCAN THE FILE-TABLES FOR OPEN FILES
SCAN: SKIPA AC16,FILES ;FIRST FILE-TABLE
SCAN1: HRRZ AC16,F.RNFT(I16) ;NEXT FILE-TABLE
JUMPE AC16,GSEG ;NO MORE FILES, EXIT
MOVE FLG,F.WFLG(I16) ;SET FLAG REGISTER
MOVE FLG1,D.F1(I16) ; AND FLAG1
TLNN FLG,OPNIN!OPNOUT ;FILE OPEN?
JRST SCAN1 ;NO
MOVE AC15,D.DC(I16) ;DEVICE CHARACTERISTICS
PUSHJ PP,SBH ;SAVE THE BUFFER HEADERS
PUSHJ PP,SCHN ;SET THE CHANNEL NUMBER
PUSHJ PP,CCHR ;CHECK THE DEVICE CHARACTERISTICS
PUSHJ PP,IDEV ;INIT THE DEVICE
SCAN3: TLNE FLG,OPNIO!RANFIL ;IO FILE?
JRST PUDSK ;POSITION UNBUFFERED DSK, IO FILE
TLNE AC15,20 ;MAG-TAPE?
JRST PMTA ;YES, POSITION MTA
TLNE AC15,200000 ;DSK?
JRST PDSK ;POSITION BUFFERED DSK FILE
PUSHJ PP,RBH ;MUST BE TTY OR LPT
JRST SCAN1
;RESTORE THE CHECKPOINT FILE JOBDATA AREA
GSEG: TTCALL 11, ;CLEAR TTY BUFFER -- SELOTS NO LONGER DOES [EDIT#1]
MOVE AC2,GSBLK+1 ;CKP FILENAME
CALLI AC2,43 ;SETNAM UUO
MOVE AC2,.JBFF ;INDEX TO CKP JDA
POP PP,.JBFF ; RESTORE TO ORIGINAL STATE
MOVE AC1,.JBSA(AC2) ;
MOVEM AC1,.JBSA ;
MOVE AC1,.JB41(AC2) ;
MOVEM AC1,.JB41 ;
MOVE AC1,.JBDDT(AC2) ;
CALLI AC1,2 ;SETDDT UUO
MOVE AC1,.JBSYM(AC2) ;
MOVEM AC1,.JBSYM ;
MOVE AC1,.JBAPR(AC2) ;
MOVEM AC1,.JBAPR ;
MOVEI AC1,230000 ;
CALLI AC1,16 ;APRENB UUO
MOVE AC1,.JBVER(AC2) ;
MOVEM AC1,.JBVER ;
SKIPN CBLVER ;TEST FOR V12
JRST GSEG11 ;NO, V11 OR EARLIER
HRRZI AC1,GSBLK ;IN CASE WE'RE REENTRANT
HRRZ AC2,START. ;FIND "JSP 16,COBST."
MOVE AC3,(AC2) ; TO GET THE ADDRESS OF COBST.
CAMN AC3,[JFCL] ;IS FIRST INSTRUCTION OF PROGRAM "JFCL"?
MOVE AC3,1(AC2) ;YES, THEN NEXT INSTRUCTION WILL BE THE JSP
JRST 1(AC3) ;DISPATCH
;HERE FOR V11 OR EARLIER
GSEG11: MOVEM PP,(AC2) ;SAVE PP
HRRI AC3,1(AC2) ;TO (.JBFF)+1
HRLI AC3,GSEGCD ;FROM
BLT AC3,GS.LEN(AC2) ;DOIT [EDIT#1]
HRLZI AC1,(SIXBIT /DSK/)
MOVEM AC1,GSBLK ;CKP FILE'S DEVICE
HRRZI AC1,GSBLK ;INIT AC1 FOR GETSEG UUO
HRRZ AC3,START. ;STARTING ADR OF COBOL PROG.
MOVE AC4,GETSGA(AC3) ;GETSEG UUO IF NON-REENT COB-PROG [4]
CAME AC4,GSEGCD+GS.GET-GS.Z ;SKIP IF NON-REENT, AC4 = TO GETSEG
JRST GS.Z(AC2) ;DO THE GETSEG AND EXIT
HRLI AC1,GETSGL(AC3) ;SHARABLE [4]
HRRI AC1,GS.S1(AC2) ; SO SETUP THE CALLING [EDIT#1]
BLT AC1,GS.S2(AC2) ; SEQUENCE FOR "SELOTS"
MOVEI AC1,2 ;SKIP OVER "CALLI RESET" IN SELOTS [EDIT#1]
ADDM AC1,GS.S2(AC2) ; SO MAKE THE JSP GO TO 400010+2 [EDIT#1]
HRRZ AC1,SELARG(AC3) ;GO GETSEG SELOTS [4]
;SELARG(AC3) POINTS TO SELOTS GETSEG ARGUMENT BLOCK
;SELARG IS A COMPILER DETERMINED CONSTANT
JRST GS.Z(AC2) ;
;THE FOLLOWING CODE IS BLTED TO LOWSEG FREE CORE AND EXECUTED THERE
GSEGCD: PHASE 1
GS.Z:! MOVSI 16,1 ;GET RID OF RERUN
CALLI 16,11 ;FROM HIGH SEGMENT
HALT . ;CAN NEVER HAPPEN
GS.GET:!CALLI AC1,40 ;GETSEG PROGRM.HGH OR SELOTS
HALT ;LET MONITOR PRINT MESSAGE
GS.S1:! JFCL ;SAVE SOME SPACE FOR
GS.S2:! JFCL ; SELOTS CALLING SEQUENCE
MOVE AC2,.JBFF ;
MOVE PP,(AC2) ;RESTORE PP
POP PP,AC0 ;
POP PP,AC1 ;
POP PP,AC2 ;
POP PP,AC3 ;
POP PP,AC4 ;
POP PP,AC5 ;
POP PP,AC6 ;
POP PP,AC7 ;FLG
POP PP,AC10 ;
POP PP,AC11 ;C
POP PP,AC12 ;
POP PP,AC13 ;
POP PP,AC14 ;
POP PP,AC15 ;
POP PP,AC16 ;
POPJ PP, ;ANSWERS TO CKP FILE PUSHJ PP,RRDMP
GS.LEN:!
DEPHASE
;SAVE THE BUFFER HEADERS
SBH: HRLI AC0,-11(I16) ;FROM
HRRI AC0,BHSAV ;TO
BLT AC0,BHSAV+5
POPJ PP,
;RESTORE THE BUFFER HEADERS AND DO A DUMMY OUTPUT
RBH: TLNN FLG,OPNOUT ;SKIP IF OUTPUT FILE
JRST RBH2 ;INPUT
PUSHJ PP,RBH1 ;RESTORE HEADERS
HRRZ AC1,BHSAV ;CURRENT BUFFER
HRRZ AC1,(AC1) ;NEXT BUF
TLO AC1,400000 ;NEVER REFERENCED
MOVEM AC1,-11(I16) ;
XCT OUT ;DUMMY OUTPUT
;MOVE CURRENT BUFFER TO NEXT BUFFER
HRR AC2,BHSAV ;CURRENT BUF
HRLI AC1,1(AC2) ;FROM
ADDI AC1,1 ;TO
HLRZ AC2,(AC2) ;SIZE
ADDI AC2,-1(AC1) ;UNTIL
TRZ AC2,400000 ;TURN OFF NEVER REFFED BIT
BLT AC1,(AC2) ;DOIT!
;MODIFY THE SAVED BUFFER HEADER TO POINT TO NEXT BUFFER IN THE RING
MOVE AC1,BHSAV+1 ;OUTPUT BYTE POINTER
HRRZ AC2,BHSAV ;CURRENT BUFFER
SUB AC1,AC2 ;ADJ BPTR TO
ADD AC1,-11(I16) ; POINT TO NEXT BUF
MOVEM AC1,BHSAV+1 ;SAVE IT
MOVE AC1,-11(I16) ;MAKE NEXT BUFFER
MOVEM AC1,BHSAV ; BECOME THE CURRENT BUFFER
;RESTORE THE BUFFER HEADERS
RBH1: HRLI AC0,BHSAV ;FROM
HRRI AC0,-11(I16) ;TO
BLT AC0,-4(I16)
POPJ PP,
;SO WE DONT GET ADR-CHECK OR EXTRA BUFFERS
RBH2: HRRZ AC1,BHSAV+3 ;ADR OF CURRENT BUFFER
SKIPA AC2,AC1 ;DUPLICATE
RBH3: MOVE AC2,AC3 ;NEXT BUFFER
MOVE AC3,(AC2) ;
TLZ AC3,400000 ;CLEAR BUF-USE-BIT
MOVEM AC3,(AC2) ;SAVE IT
CAIE AC1,(AC3) ;PREVIOUS BUFFER?
JRST RBH3 ;NO
HRLI AC2,400000 ;SET NEVER REFERENCED BIT
MOVEM AC2,BHSAV+3 ;POINT AT PREVIOUS BUFFER
JRST RBH1 ;
;SET THE CHANNEL NUMBER
SCHN: LDB AC0,DTCN. ;CHAN FROM FILE-TABLE
JUMPE AC0,SCHNER ; CANNOT HAVE CHANNEL 0 OPEN [4]
MOVEI AC1,LUUO ;LAST UUO
MOVE AC2,[POINT 4,FUUO,12] ;FIRST UUO
DPB AC0,AC2 ;
CAIE AC1,(AC2) ;EXIT IF LUUO
AOJA AC2,.-2 ;ELSE LOOP
POPJ PP,
SCHNER: TTCALL 3,[ASCIZ/
? CANNOT RERUN WITH FILE OPEN ON CHANNEL 0/] ; [4]
CALLI 12 ; EXIT [4]
;CHECK DEVICE CHARACTERISTICS MAKE SURE ITS THE SAME TYPE
CCHR: MOVE AC1,D.RD(I16) ;DEVICE NAME
MOVEM AC1,OBLK+1 ;SAVE IT FOR THE OPEN
CALLI AC1,4 ;DEVCHR UUO
JUMPE AC1,ASSD ;ASSIGN DEVICE MESSAGE
TDZ AC1,[XWD 434000,-1] ;CLEAR UNWANTED BITS
TLNN AC1,40 ;AVAILABLE?
JRST ASSD ;NO, MESSAGE
TDZ AC1,AC15 ;OK?
JUMPN AC1,ASSD ;NO, MESSAGE
POPJ PP,
;INIT THE DEVICE WITH AN OPEN UUO
IDEV: SKIPGE FLG
TDZA AC6,AC6 ;ASCII MODE
MOVEI AC6,14 ;BINARY MODE
TLNE FLG,OPNIO!RANFIL ;
MOVEI AC6,17 ;DUMP MODE
HRRM AC6,OBLK ;
HRLI AC6,D.OBH(I16) ;OUTPUT HEADER
HRRI AC6,D.IBH(I16) ;INPUT HEADER
MOVEM AC6,OBLK+2 ;
XCT UOPEN
JRST IDEV1 ;OPEN ERROR
POPJ PP,
IDEV1: TTCALL 3,[ASCIZ /
? OPEN FAILED FOR/]
PUSHJ PP,SDN ;DEVICE DEV
CALLI 1,12 ;EXIT, WAIT FOR CONT
JRST IDEV ;SHOULD NOT HAPPEN
;POSITION THE BUFFERED DSK FILE
PDSK: PUSHJ PP,SLEBK ;SETUP LOOKUP/ENTER BLOCK
XCT ULOOK ;LOOKUP
JRST LKER ;LOOKUP ERROR
TLNN FLG,OPNOUT ;
JRST PDSKI ;INPUT
PUSHJ PP,SLEBK ;SET LOOKUP/ENTER BLOCK
XCT UENTR ;ENTER
JRST ENER ;ENTER ERROR
MOVE AC1,-21(I16) ;NUMBER OF OUTPUTS
TLNE AC1,-1 ;BLOCK # LARGER THAN 18 BITS?
PUSHJ PP,FUSO ;YES USE FILOP. TYPE USETO
XCT USETO ;
PUSHJ PP,RBH ;RESTORE THE BUFFER HEADER
JRST SCAN1 ;NEXT DEVICE
PDSKI: MOVE AC1,-22(16) ;NUMBER OF INPUTS
TLNE AC1,-1 ;BLOCK # LARGER THAN 18 BITS?
PUSHJ PP,FUSI ;YES USE FILOP. TYPE USETI
XCT USETI ;
PUSHJ PP,RBH ;RESTORE BUFFER HEADERS
JRST SCAN1 ;NEXT
;POSITION UNBUFFERED DSK
PUDSK: PUSHJ PP,SLEBK ;SETUP LOOKUP BLK
XCT ULOOK ;LOOKUP
JRST LKER ;ERROR RET
PUSHJ PP,SLEBK ;ENTER BLK
XCT UENTR ;ENTER
JRST ENER ;ERROR
MOVE AC1,-16(I16) ;BLOCK NUMBER FOR USETO
SUBI AC1,1 ;NOT BLOCK +1
TLNE AC1,-1 ;BLOCK # LARGER THAN 18 BITS?
PUSHJ PP,FUSO ;YES USE FILOP. TYPE USETO
XCT USETO ;
JRST SCAN1 ;NEXT
;POSITION MAGNETIC-TAPE
PMTA: XCT MREW ;REWIND
XCT MWAIT ;SO FOLLOWING MADVR WILL WORK *%$&!!
LDB AC1,F.BPMT ;FILE POSITION ON TAPE
SOJLE AC1,PMTA1 ;JUMP IF BEG OF FIRST FILE
TLNE FLG1,NONSTD!STNDRD ;
IMULI AC1,2 ;ACCOUNT FOR LABELS
XCT MADVF ;ADVANCE TO BEG OF CURRENT FILE
SOJG AC1,.-1 ;
PMTA1: TLNN FLG,OPNOUT ;SKIP IF OPEN FOR OUTPUT
SKIPA AC1,D.IE(I16) ;NUMBER OF INPUT RECORDS
MOVE AC1,D.OE(I16) ;NUMBER OF OUTPUT RECORDS
JUMPE AC1,PMTA2 ;JUMP, OPENED BUT NOT READ OR WRITTEN
XCT MADVR ;ADVANCE TO NEXT REC
SOJG AC1,.-1 ;
PMTA2: PUSHJ PP,RBH ;RESTORE BUFFER HEADERS
XCT MWAIT ;WAIT FOR POSITIONING
JRST SCAN1 ;...NEXT FILE
;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK
SLEBK: MOVE AC1,[POINT 6,LEBLK]
MOVE AC2,F.WVID(16) ;BP TO VALUE OF ID
HRRZ AC4,AC2 ;ADDRESS
CAIL AC4,ST ;IN HIGH SEG?
JRST SLEBK5 ;YES, MESS
MOVEI AC4,11 ;11 CHARS
SLEBK1: ILDB C,AC2 ;
TLNE AC2,100 ;
SUBI C,40 ;CONVERT TO SIXBIT
IDPB C,AC1 ;
SOJN AC4,SLEBK1 ;
SETZM LEBLK+3 ;PROJ,PROG
LDB AC1,F.BCVR ;COMPILER VERSION NUMBER
CAIGE AC1,3 ;VERSION 3 OR GREATER?
POPJ: POPJ PP, ;NO, SO NO PROJ,,PROG NUMBER
HRRZ AC1,F.RPPN(I16) ;GET ADR OF PP
JUMPE AC1,POPJ ;EXIT IF NONE SPECIFIED
MOVE LEBLK+3,(AC1) ;INSERT IN LOOKUP BLOCK
CAIGE AC1,ST ;ERROR IF IN HISEG
POPJ PP,
SLEBK5: TTCALL 3,[ASCIZ %
? VALUE-OF-ID OR USER-NUMBER IS INACCESSABLE.
? RECOMPILE WITHOUT "/R" SWITCH, OR USE "DATA-NAME" & NOT A "LITERAL" AS
? OBJECT OF "VALUE-OF-ID" OR "USER-NUMBER" CLAUSE.
%]
PUSHJ PP,CLSFIL
CALLI 12 ;EXIT
;CLOSE ALL FILES, BUT DONT SUPERCEDE
CLSFIL: MOVE AC1,[CLOSE 1,40]
CLSFI1: XCT AC1
ADD AC1,[40,,0]
SKIPGE AC1,[CLOSE 17,40]
JRST CLSFI1
POPJ PP,
;LOOKUP/ENTER ERROR MESSAGES
ENER: TTCALL 3,[ASCIZ /
? ENTER FAILED FOR FILE /]
SKIPA
LKER: TTCALL 3,[ASCIZ /
? LOOKUP FAILED FOR FILE /]
MOVE AC1,[POINT 6,LEBLK]
MOVEI AC4,6 ;6 CHAR NAME
PUSHJ PP,SOUT ;SIXBIT OUT
TTCALL 3,[ASCIZ /./]
MOVE AC1,[POINT 6,LEBLK+1]
MOVEI AC4,3 ;3 CHAR EXT
PUSHJ PP,SOUT ;
HRRZ AC1,LEBLK+1 ;PICKUP THE ERROR BITS
ANDI AC1,17 ;CLEAR OTHER BITS
TTCALL 3,LEMSG(AC1) ;COMPLAIN
PUSHJ PP,CLSFIL ;CLOSE FILES WITH NO SUPERCEEDING
CALLI 1,12 ;EXIT, WAIT FOR CONT
JRST SCAN3 ;START OVER AGAIN
;LOOKUP, ENTER, RENAME, RUN, AND GETSEG ERROR MESSAGES
LEMSG: [ASCIZ / FILE NOT FOUND/]
[ASCIZ / UFD DOES NOT EXIST/]
[ASCIZ / PROTECTION FAILURE OR DTA DIRECTORY FULL/]
[ASCIZ / FILE BEING MODIFIED/]
[ASCIZ /RNAM/]
[ASCIZ /RNAM/]
[ASCIZ . DEVICE OR UFD/RIB DATA ERROR.]
[ASCIZ / NOT A SAVED FILE/]
[ASCIZ / NOT ENOUGH CORE/]
[ASCIZ / DEVICE NOT AVAILABLE/]
[ASCIZ / NO SUCH DEVICE/]
[ASCIZ / GETSEG REQUIRES TWO RELOCATION REGISTERS/]
[ASCIZ / QUOTA EXCEEDED OR NO ROOM ON FILE STRUCTURE/]
[ASCIZ / WRITE LOCKED FILE STRUCTURE/]
[ASCIZ / NOT ENOUGH MONITOR TABLE SPACE/]
[ASCIZ / PARTIAL ALLOCATION ONLY/]
[ASCIZ / ALLOCATED BLOCK NOT FREE/]
;FAILED DEVCHR TEST, ASSIGN DEVICE LOGICAL NAME
ASSD: TTCALL 3,[ASCIZ /
ASSIGN /]
TLNE AC15,200000
MOVE AC1,[ASCIZ /DSK /]
TLNE AC15,40000
MOVE AC1,[ASCIZ /LPT /]
TLNE AC15,100
MOVE AC1,[ASCIZ /DTA /]
TLNE AC15,20
MOVE AC1,[ASCIZ /MTA /]
TLNE AC15,10
MOVE AC1,[ASCIZ /TTY /]
TTCALL 3,AC1
; MOVEI AC4,6 ; [EDIT#2]
PUSHJ PP,SDN1 ;TELL USER LOGICAL NAME
PUSHJ PP,OCRLF
TTCALL 3,[ASCIZ /TYPE CONTINUE WHEN DONE
/]
CALLI 1,12 ;EXIT, WAIT FOR CONT
JRST CCHR ;TRY AGAIN
;TYPE OUT THE DEVICE NAME
SDN: TTCALL 3,[ASCIZ / DEVICE /]
SDN1: MOVEI AC4,6 ;ALLOW 6 CHARS IN LOGICAL NAME [EDIT#2]
PUSHJ PP,OBUF1 ;INITIALIZE TTY POINTERS [EDIT#2]
MOVE AC3,D.RD(I16) ;LOGICAL DEVICE NAME
SKIPA AC1,[POINT 6,AC3]
SOUT: PUSHJ PP,O6BT ;OUTPUT A SIXBIT CHAR
SOUT1: ILDB C,AC1
CAIE C,0 ;TERMINATE ON SPACE
SOJGE AC4,SOUT ; OR ELEVENTH CHAR
JRST OBUF ;AND POPJ
IC: TTCALL 3,[ASCIZ /? ILLEGAL CHARACTER, /]
GETFN0: TTCALL 11,0 ;CLEAR THE BUFFER
GETFN: TTCALL 3,[ASCIZ /TYPE CHECKPOINT FILE NAME
/]
MOVE AC1,[POINT 6,AC3]
MOVEI AC0,6 ;6 FILENAME CHARS
HRLZI AC4,(SIXBIT /CKP/) ;CKP IS DEFAULT EXT
SETZ AC3, ;CLEAR THE LOOKUP BLK
SETZB AC5,AC6 ;
GETFN1: PUSHJ PP,GETC ;CHAR TO C
CAIL C,12 ;"LF"
CAILE C,15 ;"CR"
SKIPA
JRST LT ;LINE TERMINATOR
CAIN C,56 ;"."
JRST PD ;PERIOD
CAIL C,60 ;"0"
CAILE C,172 ;LOWER-CASE "Z"
JRST IC ;ILLEGAL CHARACTER
CAIL C,141 ;L-C "A"
SUBI C,40 ;L-C TO U-C
CAILE C,132 ;"Z"
JRST IC ;
SUBI C,40 ;ASCII TO SIXBIT
JUMPE AC0,GETFN1 ;ONLY FIRST SIX/THREE CHARS ARE REAL
IDPB C,AC1 ;C TO LOOKUP BLK
SOJA AC0,GETFN1 ;LOOP
PD: TLOE FLG,1 ;PERIOD FLAG
JRST IC ;ONLY ONE "."
SETZ AC4, ;REAL EXT COMING, ZERO THE DEFAULT
MOVEI AC0,3 ;3 REAL EXTENSION CHARS
MOVE AC1,[POINT 6,AC4]
JRST GETFN1 ;
LT: JUMPE AC3,GETFN0 ;NULL NAME?
POPJ PP,
GETC: TTCALL 2,C ;
TTCALL 4,C ;
POPJ PP,
O6BT: ADDI C,40 ;CONVERT TO ASCII
OCHR: IDPB C,OBP ;CHAR TO BUFFER
SOSLE OBC ;IS BUFFER FULL?
POPJ PP, ;NO, RETURN
OBUF: SETZ C, ;YES
IDPB C,OBP ;TERMINATE IT
TTCALL 3,OBF ;OUTPUT IT
OBUF1: MOVE C,[POINT 7,OBF] ;INITIALIZE
MOVEM C,OBP ;BYTE POINTER
MOVEI C,^D132 ;CHARS/LINE
MOVEM C,OBC ;BYTE COUNT
POPJ PP,
OCRLF: TTCALL 3,[ASCIZ /
/]
POPJ PP,
;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETI
FUSI: LDB AC0,DTCN. ; GET DATA FILE'S CHANNEL
HRLM AC0,FUSIA ; SET IT IN THE ARG-BLOCK
MOVEM AC1,FUSIA+1 ; SETUP THE BLOCK-NUMBER
MOVE AC0,[2,,FUSIA] ; POINT AT ARG-BLOCK
FILOP. AC0, ; DO THE USETI
JRST[ TTCALL 3,[ASCIZ /? UNABLE TO POSITION DATA FILE, USETI (FILOP.) FAILED./]
CALLI 12 ];EXIT
JRST RET.2 ; DONE
;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETO
FUSO: LDB AC0,DTCN. ; GET DATA FILE'S CHANNEL
HRLM AC0,FUSOA ; SET IT IN THE ARG-BLOCK
MOVEM AC1,FUSOA+1 ; SETUP THE BLOCK-NUMBER
MOVE AC0,[2,,FUSOA] ; POINT AT ARG-BLOCK
FILOP. AC0, ; DO THE USETO
JRST[ TTCALL 3,[ASCIZ /? UNABLE TO POSITION DATA FILE, USETO (FILOP.) FAILED./]
CALLI 12 ];EXIT
RET.2: AOS (PP) ;SKIP EXIT
POPJ PP,
GETCOR: CALLI AC0,11 ;CORE UUO
SKIPA ;ERROR RET
POPJ PP, ;NORM RET
GETCO1: TTCALL 3,[ASCIZ /? INSUFICIENT CORE./]
CALLI 12 ;EXIT
FUUO: ;FIRST UUO
MWAIT: MTAPE 0,0 ;WAIT
MREW: MTAPE 0,1 ;REWIND
MADVR: MTAPE 0,6 ;ADVANCE RECORD
MADVF: MTAPE 0,16 ;ADVANCE FILE
UOPEN: OPEN OBLK ;
ULOOK: LOOKUP LEBLK ;
UENTR: ENTER LEBLK ;
USETI: USETI 1(AC1) ;
USETO: USETO 1(AC1) ;
OUT: OUT ;DUMMY OUTPUT
OBLK: BLOCK 3 ;FOR OPEN UUO
;** EDIT 3 CHANGED 1 INSTRUCTION
LUUO== .-4 ;LAST UUO [EDIT#3]
;ARG BLOCKS FOR FILOP. TYPE USETI/O
FUSIA: EXP 11 ;FUNCTION = USETI
Z
FUSOA: EXP 12 ;FUNCTION = USETI
Z
BHSAV: BLOCK 6 ;SAVE AREA FOR BUFFER HEADERS
OBC: BLOCK 1 ;TTY BYTE COUNT
OBP: BLOCK 1 ;TTY BYTE POINTER
OBF: BLOCK ^D27 ;TTY OUTPUT BUFFER
GSBLK: BLOCK 6 ;FOR GETSEG UUO
FILES: BLOCK 1 ;POINTER TO FIRST FILE TABLE
START.: BLOCK 1 ;(OLD .JBSA) SAVED HERE I.E. START.
CBLVER: BLOCK 1 ;VERSION NO. OF FILE
IFN TOPS20,<
SAVSTR: BLOCK 1 ;POINTER TO JFN STRING FOR SAVE FILE
>
PAT: BLOCK 10
DTCN.: POINT 4,D.CN(I16),15 ; IO CHANNEL FOR THIS FILE
F.BCVR: F%BCVR ; COMPILER'S VERSION NUMBER
F.BPMT: F%BPMT ; FILES'S POSITION ON MAG-TAPE
END.: END ST