sw/os8/v3d/sources/system/dectapes/dectape2/FPATCH.PA

   1 /OS8 FORTRAN II COMPILER OVERLAY V5             ***FPATCH.05***
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 //
  10 /
  11 /
  12 /
  13 /
  14 /COPYRIGHT (C) 1974, 1975
  15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
  16 /
  17 /
  18 /
  19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
  20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
  21 /SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
  22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
  23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
  24 /AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
  25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
  26 /
  27 /
  28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
  29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
  30 /EQUIPMRNT COROPATION.
  31 /
  32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
  33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
  34 /
  35 /
  36 /
  37 /
  38 /
  39 /
  40 \f/
  41 /FIXES TO FPATCH FOR V4         J.K.  1975
  42 /
  43 / .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
  44 /       BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
  45 /       TO FORM FORT INSTEAD OF WHOLE WORD
  46 /
  47 /  .VERSION NUMBER VIA /V--OPTION
  48 /       WILL BE PASSED ONTO SABR
  49 /
  50 /
  51 /
  52         FIELD 0
  53         JSBITS=7746
  54         MOFILE=7600
  55         MPARAM=7643
  56         LLUNCH=7001     /TAKE OUT WHEN MERGING WITH COMPILER
  57         DO=7173         /"
  58         ELIST=1162      /"
  59         EMSG1=1270      /"
  60         EMSG14=1520     /"
  61         FLST=242        /"
  62         FORST=5362      /"
  63         FPROP=144       /"
  64         GOOON=5455      /"
  65         KOUNT=113       /"
  66         LPTRIN=545      /"
  67         LPUNCH=5333     /"
  68         LTTYPE=3372     /"
  69         L75=75          /"
  70         OSTOP=4052      /"
  71         XFINI=5354      /"
  72 \f       *200
  73 START,  CLA CMA
  74         DCA     FCHFLG
  75         CIF 10
  76         JMS I (7700
  77         10      /ESCAPE
  78         ISZ     FCHFLG
  79         JMP     .+5
  80         CIF 10
  81         JMS I (200
  82         5       /COMMAND DECODE
  83         0624    /.FT ASSUMED EXTENSION
  84         CDF     10
  85         TAD I   (MPARAM+1
  86         CDF 0
  87         AND     (4
  88         SZA CLA
  89         JMS     VERNUM
  90         CLA IAC
  91         CIF 10
  92         JMS I (200
  93         4               /CLOSE OPERATOR USED AS DELETE
  94         OUSNAME         /DELETE FORTRN.TM IF IT EXISTS
  95         0
  96         CLA             /IT DIDN'T EXIST
  97         CLA IAC         /ENTER A FILE ON "SYS" - MAXIMUM SIZE
  98         CIF 10
  99         JMS I (200
 100         3       /ENTER
 101 OUSREC, OUSNAME
 102 HOLSIZ, 0
 103         JMP I (OUERR    /WHATS GOING ON HERE?
 104         CLA IAC         /DEVICE "SYS"
 105         CIF 10
 106         JMS I (200
 107         2
 108 PTSABR, SABR
 109 FCHFLG, 0               /USELESS LENGTH WORD
 110         JMP I (BIGGIE
 111         TAD PTSABR
 112         DCA I (CLSABR
 113         TAD OUSREC
 114         DCA I (OUTREC
 115         TAD HOLSIZ
 116         DCA I (OURCNT
 117         TAD (1000
 118         TAD I (JSBITS
 119         DCA I (JSBITS   /SET "UNSTARTABLE" STATUS BIT
 120         JMS I (FNEWF    /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE
 121         CDF 10
 122         TAD OUSREC
 123         DCA I (7620
 124         CLA IAC
 125         DCA I (7617
 126         CLA CLL CML RTL
 127         AND I (MPARAM
 128         TAD I (MOFILE+5
 129         SNA CLA
 130         DCA I (FLST
 131         TAD I (7600
 132         SNA CLA
 133         TAD I (MPARAM
 134         AND (41
 135         SNA CLA         /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A
 136         JMP FCDF0-3     /RELOCATABLE OUTPUT FILE?
 137 FTADNM, TAD BDFALT      /YES - GIVE HIM ONE
 138         DCA I B7600     /NAMED "FORTRL.TM"
 139         ISZ FTADNM
 140         ISZ B7600
 141         ISZ B7773
 142         JMP FTADNM
 143         CLA CLL CML RAR
 144         TAD I   (7645
 145         DCA I (7645     /SABR IT WAS CHAINED TO BY FORT
 146 FCDF0,  CDF 0
 147         JMP I (1003     /START COMPILATION
 148
 149 BDFALT, 1               /DEVICE "SYS"
 150         TEXT    /FORTRLTM/
 151 B7600,  7600
 152 B7773,  7773
 153 /
 154 VERNUM, 0
 155         TAD I   POINT
 156         CDF CIF 10
 157         JMS I   VPRINT
 158         ISZ     POINT
 159         ISZ     COUNT
 160         JMP     .-5
 161         JMP I   VERNUM
 162 /
 163 POINT,  VERN
 164 COUNT,  -12
 165 VERN,   306
 166         317
 167         322
 168         324
 169         240
 170         326
 171         265
 172         301
 173         215
 174         212
 175 /
 176 VPRINT, VERPRT
 177
 178 \f       /ADDITIONS TO FORTRAN ERROR MESSAGES
 179
 180         *ELIST+1
 181         NUMSG1
 182         *EMSG1-2
 183         -ERR61-1;       EMSG15
 184         -ERR62-1;       EMSG16
 185         -ERR63-1;       EMSG17
 186         -ERR64-1;       EMSG20
 187         0       ;       EMSG14
 188         /DUMMY PAGES TO CONSOLIDATE CORE IMAGE
 189         *1600
 190         0
 191         *2000
 192         0
 193         *2400
 194         0
 195         *3000
 196         0
 197         *5600
 198         0
 199 \f       *5400
 200 FNEWF,  0
 201         CDF 10
 202         TAD I FILPTR
 203         SNA
 204         JMP EOFERR      /END OF INPUT REACHED BEFORE END STATEMENT
 205         DCA INWCNT
 206         TAD I FILPTR
 207         AND (7760
 208         SZA
 209         TAD (17
 210         CLL CML RTR
 211         RTR
 212         DCA INRCNT
 213         ISZ FILPTR
 214         TAD I FILPTR
 215         DCA INREC
 216         ISZ FILPTR
 217         TAD (5001       /FORTRAN ALLOWS TWO-PAGE HANDLERS
 218         DCA INHNDL
 219         TAD INWCNT
 220         CDF 0
 221         CIF 10
 222         JMS I (200
 223         1       /ASSIGN AND FETCH HANDLER
 224 INHNDL, 5000    /LOCATIONS 5000-5377 ARE FREE
 225         JMP IOERR       /SOMETHINGS SCREWY
 226         CLA CMA
 227         DCA INWCNT
 228         DCA INEOF
 229         JMS MOUCOR
 230         JMP I FNEWF
 231 FILPTR, 7617
 232 GETCH,  0
 233         KSF
 234         JMP .+5
 235         KRS
 236         TAD (-203
 237         SNA CLA
 238         JMP I (7600
 239         ISZ JMPGET
 240         ISZ INWCNT
 241 JMPG,   JMP JMPGET
 242         TAD INEOF
 243         SNA CLA
 244         JMP JUSTRD
 245 GETNXT, CIF 10
 246         JMS I G7700
 247         10      /ESCAPE
 248         JMS FNEWF
 249 JUSTRD, JMS I INHNDL    /INHNDL CONTAINS LOCN OF DEVICE HANDLER
 250         0200    /READ 2 HALF-RECORDS INTO FIELD 0
 251 INBFPT, INBUF
 252 INREC,  0
 253         JMP RERROR
 254         ISZ INREC
 255         ISZ INRCNT
 256         SKP
 257 ENDFIL, ISZ INEOF
 258         TAD (-601
 259         DCA INWCNT
 260         TAD JMPG
 261         DCA JMPGET
 262         TAD INBFPT
 263         DCA INPTR
 264         JMP GETCH+1
 265 JMPGET, JMP .
 266         JMP INCHR1
 267         JMP INCHR2
 268 INCHR3, TAD JMPG
 269         DCA JMPGET
 270         TAD I INPTR
 271         AND (7400
 272         CLL RTR
 273         RTR
 274         TAD INTMP
 275         RTR
 276         RTR
 277         ISZ INPTR
 278         JMP GCHCOM
 279 INCHR2, TAD I INPTR
 280         AND (7400
 281         DCA INTMP
 282         ISZ INPTR
 283 INCHR1, TAD I INPTR
 284 GCHCOM, AND (377
 285         TAD (-232
 286         SNA
 287         JMP GETNXT
 288         TAD (232
 289         CIF 10
 290         ISZ GETCH
 291         JMP I GETCH
 292 RERROR, SMA CLA
 293         G7700=RERROR
 294         JMP ENDFIL
 295 IOERR,  JMS I (SFATAL
 296         CIF 10
 297 ERR62,  JMS I (LLUNCH
 298 INPTR,  0
 299 INWCNT, 0
 300 INTMP,  0
 301 INRCNT, 0
 302 INEOF,  0
 303 EOFERR, JMS MOUCOR      /KICK MONITOR OUT
 304         JMS I (SFATAL
 305         CIF 10
 306 ERR61,  JMS I (LLUNCH
 307 MOUCOR, 0
 308         CDF 0
 309         CIF 10
 310         JMS I (200
 311         11
 312         JMP I MOUCOR
 313 \f       *3200
 314 P377,   377
 315 P7400,  7400            /WARNING ***DO NOT MOVE THIS***
 316
 317 PUTCH,  0
 318         DCA PUTMP
 319         RAL
 320         DCA PUTLNK
 321 PUTCHX, ISZ JMPPUT
 322         ISZ OUWDCT
 323 JMPP,   JMP JMPPUT
 324         CLA CLL CML RTL
 325         TAD OURCNT
 326         SZL
 327         JMP OUERR+1
 328         DCA OURCNT
 329         ISZ CLOSCT
 330         ISZ CLOSCT
 331         JMS I (7607
 332         4400
 333 OUBFPT, OUBUF
 334 OUTREC, 0
 335         JMP I (IOERR
 336         ISZ OUTREC
 337         ISZ OUTREC
 338         TAD (-1401
 339         DCA OUWDCT
 340         TAD OUBFPT
 341         DCA OUPTR
 342         TAD JMPP
 343         DCA JMPPUT
 344         JMP PUTCHX
 345 JMPPUT, JMP .
 346         JMP PUTCH1
 347         JMP PUTCH2
 348 PUTCH3, TAD PUTMP
 349         RTL
 350         RTL
 351         DCA PUTMP
 352         TAD JMPP
 353         DCA JMPPUT
 354         TAD PUTMP
 355         AND P7400
 356         TAD I OUPOLD
 357         DCA I OUPOLD
 358         TAD PUTMP
 359         RTL
 360         RTL
 361 P201,   AND P7400
 362         TAD I OUPTR
 363         DCA I OUPTR
 364         ISZ OUPTR
 365         JMP PCHCOM
 366 PUTCH2, TAD OUPTR
 367         DCA OUPOLD
 368         ISZ OUPTR
 369 PUTCH1, TAD PUTMP
 370 P200,   AND P377
 371         DCA I OUPTR
 372 PCHCOM, CIF 10
 373         TAD PUTLNK
 374         CLL RAR
 375         JMP I PUTCH
 376
 377 EOFORT, SZA CLA         /ANY ERRORS?
 378         JMP I SF7600    /YES, DO NOT ASSEMBLE
 379         DCA PCHCOM
 380         TAD (232
 381         JMS PUTCH
 382         TAD OUWDCT
 383         TAD (1400
 384         SZA CLA
 385         JMP .-5         /FILL BUFFER WITH ^Z
 386         TAD I (JSBITS
 387         RAR
 388         CLL CML RAL
 389         DCA I (JSBITS   /NO NEED TO SAVE CORE ON THIS MONITOR CALL
 390         CIF 10
 391         JMS I (7700
 392         10      /ESCAPE
 393         CLA IAC         /DEVICE "SYS"
 394         CIF 10
 395         JMS I P200
 396         4       /CLOSE
 397         OUSNAM
 398 CLOSCT, 0       /CLOSING LENGTH
 399         JMP OUERR-3
 400         CIF 10
 401         JMS I P200
 402         6               /RUN
 403 CLSABR, 0
 404 BIGGIE, JMS I (MOUCOR
 405         JMS SFATAL
 406         CIF 10
 407 ERR63,  JMS I (LLUNCH
 408         CLA CLL CMA RTL
 409         AND I (JSBITS
 410         DCA I (JSBITS   /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL
 411 OUERR,  JMS I (MOUCOR
 412         JMS SFATAL
 413         CIF 10
 414 ERR64,  JMS I (LLUNCH
 415         INBUF=1600
 416         OUBUF=3600
 417 OURCNT, 0
 418 OUPTR,  OUBUF
 419 OUWDCT, -1401
 420 PUTMP,  0
 421 OUPOLD, 0
 422 SFATAL, 0
 423         PUTLNK=SFATAL
 424 SF7600, 7600            /CLEAR AC
 425         CDF 10
 426         TAD SCDIF0
 427         DCA I (177
 428         TAD (5601
 429         DCA I P200
 430         TAD SF7600
 431         DCA I P201
 432 SCDIF0, CDF CIF 0
 433         JMP I SFATAL
 434 \f       *2200   /CANNOT GO PAST 2373
 435 SABR,   TEXT    /SABR/
 436         TEXT    /SV/
 437 OUSNAM, TEXT    /FORTRNTM/
 438 NUMSG1, TEXT    /ILLEGAL CONTINUATION/
 439 EMSG15, TEXT    /NO END STATEMENT/
 440 EMSG16, TEXT    #I/O ERROR#
 441 EMSG17, TEXT    /SABR.SV NOT FOUND/
 442 EMSG20, TEXT    /NO ROOM FOR OUTPUT/
 443 \f       FIELD 1
 444         /THESE ARE THE PATCHES OVER THE COMPILER.
 445
 446
 447         *FORST  /HEADER PRINTER
 448         NOP
 449         NOP
 450         NOP
 451
 452         *FORST+5        /LEADER OUTPUT
 453         CLA CLL CMA RTL /3 CHARACTERS OF LEADER
 454
 455         *LPTRIN+1       /HIGH-SPEED READER ROUTINE
 456         CIF 0
 457         JMS I .+1
 458         GETCH
 459
 460         *OSTOP+1
 461         JMS I FPROP     /PUNCH 'CALL 0,EXIT'
 462                 6253
 463         JMP I OSTOP
 464
 465         *LPUNCH+1       /PUNCH ROUTINE
 466         CIF 0
 467         JMS I .+2
 468         CLA SKP
 469         PUTCH
 470
 471         *XFINI-3        /TRAILER PRINTER
 472         CLA CLL CMA RTL /3 CHARACTERS OF TRAILER
 473
 474         *XFINI-1        /ENDING SEQUENCE
 475         CDF CIF 0
 476         TAD L75         /PICK UP ERROR FLAG
 477         JMP I .+1
 478         EOFORT
 479
 480         *GOOON+4        /TRAILER AFTER "END" STATEMENT
 481         CLA CLL CMA RTL /3 CHARS ETC.
 482
 483
 484         *LTTYPE+1       /REVERSE TTY WAIT MODE
 485         TLS
 486         TSF
 487         JMP .-1
 488
 489 /
 490 *4753
 491 VERPRT, 0
 492         JMS I   VPUNCH
 493         CDF CIF 0
 494         JMP I   VERPRT
 495 VPUNCH, 3372
 496 /
 497         $
 498 \f