sw/os8/v3d/sources/system/dectapes/dectape3/UTILTY.SB

   1 /UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 /UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
  46 \f/      VERSION 10A (APRIL 28, 1977)
  47 /       VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
  48 /
  49         ENTRY   OPEN         /INITIALIZING AND FLAG SETTING ROUTINE
  50         ENTRY   GENIO
  51         ENTRY   EXIT            /EXIT TO DISK MONITOR SYSTEM
  52         ENTRY   ERROR
  53         ENTRY   CKIO    /USELESS ROUTINE
  54         OPDEF   KRS     6034
  55         OPDEF   KCC     6032
  56         OPDEF TADI 1400
  57         OPDEF DCAI 3400
  58         OPDEF   JMSI    4400
  59         OPDEF JMPI 5400
  60 /       CARD READER IOT'S
  61         OPDEF   RCSE    6672
  62         OPDEF   RCSP    6671
  63         OPDEF   RCSF    6631
  64         OPDEF   RCRA    6632
  65 /LINE PRINTER IOT'S
  66         OPDEF   LLB     6666
  67         OPDEF   LSF     6661
  68
  69         LAP
  70
  71 U17,    17              /*** MUST BE FIRST LOC IN PAGE ***
  72
  73 IOER,   1117
  74         0522            /"IOER" ERROR
  75 GENIO,  BLOCK   1
  76         10                      /GENERAL INPUT/OUTPUT ROUTINE
  77         DCA     7       /SAVE ENTRY AC
  78 GENLP,  TAD     7
  79         RTL
  80         RTL
  81         RAL
  82 U200,   AND     U17
  83         TAD     JMPITB
  84         DCA     DSPACH  /INDEX JUMP TABLE BY DEVICE NUMBER
  85         TAD     U200
  86         KRS
  87         TAD     UM203
  88         SNA CLA
  89         KSF             /CHECK FOR ^C ON TELETYPE
  90 DSPACH, NOP             /NO ^C - DISPATCH TO I/O ROUTINE
  91         CALL    0,EXIT
  92
  93 JMPITB, JMPI    DEVTAB
  94 DEVTAB, TTYOUT
  95         HSPOUT
  96         LPTOUT
  97         GENOUT
  98         TTYIN
  99         HSRIN
 100         CDRIN
 101         GENIN
 102         TTYFUJ          /FUDGE - SEE TELETYPE INPUT ROUTINE
 103         IOERR
 104         IOERR
 105         IOERR
 106         IOERR
 107         IOERR
 108         IOERR
 109         IOERR
 110
 111 HSPOUT, PSF
 112         JMP     GENLP
 113         TAD     7
 114         PLS
 115 GENRTN, CLA
 116         RETRN   GENIO
 117
 118 TTYIN,  KSF
 119         JMP     GENLP
 120         CLA CLL CML RTR /****DEPENDS ON NUMBER OF DEVICES ****
 121         JMP     GENLP   /TEST FOR ^C ONE LAST TIME
 122
 123 HSRIN,  ISZ     T1
 124         JMP     HSRSF
 125         TAD     U336    /TIME OUT-PRINT '^'
 126         TLS
 127 HLP,    KSF
 128         JMP     HLP
 129         AND     U200    /GET 200 INTO AC
 130         KRS             /READ THE CHAR.
 131         TAD     UM203
 132         SZA     CLA     /IS IT CONTROL C?
 133         KCC             /NO-CLEAR FLAG
 134         RFC             /USER TYPED-TICKLE RDR-FALL THRU RFC
 135 HSRSF,  RSF
 136         JMP     GENLP
 137         DCA     T1
 138         RRB RFC
 139         JMP     GENRTN#
 140 U336,   336
 141 T1,     0
 142
 143 UM203,  -203
 144 PCDRGC, CDRGCH          /USED TO FORCE DF=CURRENT WHEN NECESSARY
 145 CDR215, 215
 146 CDR100, 100
 147 CDR240, 240
 148 PCDRTB, CDRTBL          /CONVERSION FROM CARD CODE TO ASCII-240
 149 CDRCT,  0
 150 CDRLEN, 0
 151 CDRIN,  TAD     CDRCT
 152         SNA CLA
 153         JMP     CDRNXT  /NEW CARD NECESSARY
 154         ISZ     CDRCT   /ADVANCE TO NEXT COLUMN
 155         JMP     CDRGET
 156         TAD     CDR215  /NO MORE - SEND A CARRIAGE RETURN
 157         JMP     GENRTN#
 158
 159 CDREST, KSF
 160         JMP     CDRTST
 161         KCC
 162 CDRNXT, RCSE
 163         JMP     GENLP   /CHECK FOR ^C WHILE WAITING FOR NEXT CARD
 164 CDRTST, RCSP
 165         JMP     CDRCOL  /NOT END OF CARD YET
 166         TAD     CDRCT   /END OF CARD - SET UP FOR EXTRACTION OF CHARS
 167         CIA
 168         DCA     CDRLEN
 169 CDRGET, TAD     CDRCT
 170         TAD     CDRLEN  /FORM CHAR POINTER INTO TABLE AT 10100
 171         CLL RAR
 172         TAD     CDR100
 173         6211
 174         JMSI    PCDRGCH /INDEX TABLE AND PULL OUT CHAR (DF=10)
 175         TAD     CDR240  /CHANGE TO ASCII
 176         JMP     GENRTN# /RETURN
 177 CDRCOL, RCSF            /ANYTHING YET?
 178         JMP     CDREST  /KEEP LOOKING
 179         RCRA            /READ IT
 180         CLL RAR
 181         TAD     PCDRTB
 182         JMS I   PCDRGC  /GET TABLE ENTRY, FORCING DATA FIELD CURRENT
 183         DCA     CDRLEN  /SAVE IT TEMPORARILY
 184         TAD     CDRCT
 185         CIA
 186         CLL RAR
 187         TAD     CDR100  /INDEX TABLE AT LOC 10100
 188         DCA     DSPACH
 189         6211            /CDF 10
 190         TAD     CDRLEN
 191         SZL             /WHICH HALF?
 192         JMP     CDNORT  /RIGHT HALF
 193         RTL
 194         RTL
 195         RTL
 196         SKP
 197 CDNORT, TADI    DSPACH  /ADD EXISTING LEFT HALF
 198         DCAI    DSPACH  /SAVE UPDATED ENTRY
 199         CLA CMA
 200         TAD     CDRCT
 201         DCA     CDRCT   /UPDATE COLUMN POINTER
 202         JMP     CDRCOL
 203
 204
 205         PAGE
 206 \fU377,  377             /MUST BE FIRST LOC IN THIS PAGE
 207 GENIN,  6201
 208         TADI    IHNDLR
 209         SNA CLA         /OPEN INPUT FILE?
 210         JMP     IOERR   /NO
 211         6202
 212         JMS I   FICHAR  /GET A CHAR
 213         JMP     IOERR   /INPUT ERROR
 214 UU200,  AND     U377
 215 GRTN2,  RETRN   GENIO
 216
 217 GENOUT, 6201
 218         TADI    OHNDLR
 219         SNA CLA         /OPEN OUTPUT FILE?
 220         JMP     IOERR   /NO
 221         6202
 222         TAD     7       /GET CHAR TO BE OUTPUT
 223         AND     U377
 224         JMS I   FOCHAR  /PUT A CHARACTER
 225         JMP     IOERR   /OUTPUT ERROR
 226         JMP     GRTN2
 227
 228 IHNDLR, 122             /***ALL THESE LOCATIONS ARE VERY VOLATILE!! ***
 229 FICHAR, 606             /*******
 230 OHNDLR, 121             /*******
 231 FOCHAR, 651             /******************
 232
 233 /
 234 /       INITIALIZING SUBROUTINE CALLED BY FORTRAN
 235 /       CLEARS FLOATING AC AND SETS FLAGS
 236 /
 237 OPEN,   BLOCK   1
 238         10
 239         TAD     (212
 240         TLS     /PUT LINE-FEED ON TTY
 241         LLB     /INITIALIZE LPT
 242         KCC     /CLEAR KEYBOARD FLAG (AND AC)
 243         PLS
 244         RFC
 245         CALL    0,CLEAR
 246         6201
 247         DCAI    IHNDLR
 248         DCAI    OHNDLR          /ZERO DEVICE-INDEPENDENT IO FLAGS
 249         RETRN   OPEN
 250
 251
 252 LPTOUT, LSF
 253         JMP     GENLP
 254         TAD     7
 255         ISZ     PFSTCH
 256         JMP     NOFST
 257         TAD     (-1262  /LOOK FOR CONTROL CHARS IN PRINT POSITION 1
 258         CLL IAC
 259         IAC
 260         SNL
 261         JMP     DCACH
 262         CLL RAL
 263         TAD     (212
 264 NOFST,  LLB
 265         TAD     (-1212
 266 DCACH,  SNA CLA         /IF LINE FEED
 267         CMA             /SET "FIRST CHAR" SWITCH ON
 268         DCA     PFSTCH
 269         JMP     GRTN2
 270 PFSTCH, -1
 271
 272 TTYFUJ, TAD     UU200
 273         KRS
 274         DCA     7       /SAVE KEYBOARD CHAR
 275         KCC             /CLEAR FLAG
 276         TAD     7
 277         TAD     (-212
 278         SZA CLA
 279         JMS     TYPE
 280         TAD     7
 281         TAD     (-215
 282         SZA CLA
 283         JMP     TYRTN
 284         CLA CLL CMA RTL
 285         JMS     TYPE
 286 TYRTN,  TAD     7
 287         JMP     GRTN2   /RETURN WITH CHAR IN AC
 288
 289 TYPE,   0
 290         TAD     7
 291 TYPELP, TSF
 292         JMP     TYPELP
 293         TLS
 294         CLA
 295         JMPI    TYPE
 296
 297 TTYOUT, JMS     TYPE
 298         JMP     GRTN2
 299
 300 IOERR,  CALL    1,ERROR
 301         ARG     IOER
 302
 303 CDRTBL, 0021;2223;2425;2627
 304         3031;3203;4007;3502
 305         2017;6364;6566;6770
 306         7172;7514;0577;3637
 307         1552;5354;5556;5760
 308         6162;0104;1211;3374
 309         0641;4243;4445;4647
 310         5051;7316;3410;1376
 311
 312         PAGE
 313 \f
 314 PMESG,  MESG
 315 MESG,   7777
 316         7777
 317         4005
 318         2222
 319         1722
 320         4001
 321         2440
 322         1417
 323         0340
 324 LIT7,   0007
 325
 326 ERROR,  BLOCK   1
 327         10                      /ERROR PROCESSOR
 328 U7600,  7600
 329         TAD     ERROR
 330         DCA     TEM1
 331 TEM1,   NOP             /SET DATA FIELD OF "CALL ERROR"
 332         TADI    ERROR#
 333         DCA     TEM3
 334         INC     ERROR#
 335 E60,    CLA CMA CML     /CML IS WINDOW DRESSING
 336         TADI    ERROR#
 337         DCA     10
 338         INC     ERROR#
 339 TEM3,   NOP             /DATA FIELD OF MESSAGE&ENTRY POINT
 340         DCA     CKIO    /ZERO "FATAL ERROR" FLAG
 341         TADI    10
 342         RAL
 343         SZL             /NON-FATAL BIT ON?
 344         ISZ     CKIO    /YES - SET "FATAL FLAG" TO NON-FATAL
 345         CLL RAR         /STRIP NON-FATAL BIT FROM MESSAGE
 346         DCA     MESG
 347         TADI    10      /SECOND WORD OF MESSAGE
 348         DCA     MESG#
 349         TADI    10
 350         DCA     TEM1
 351         TADI    10
 352         DCA     TEM3    /CALLING ADDRESS
 353         TAD     PMESG
 354         DCA     TEM2
 355
 356 ERLP,   TAD I   TEM2
 357         RTR
 358         RTR
 359         RTR
 360         JMS     PR6BIT
 361         TAD I   TEM2
 362         JMS     PR6BIT
 363         INC     TEM2
 364         JMP     ERLP
 365
 366 PRLOC,  TAD     TEM1
 367         RTR
 368         RTR
 369         JMS     ERTTY   /PRINT CALLING FIELD
 370         TAD     (-4
 371         DCA     TEM2
 372 NUMLP,  TAD     TEM3
 373         RTL
 374         RAL
 375         DCA     TEM3
 376         TAD     TEM3
 377         JMS     ERTTY
 378         ISZ     TEM2
 379         JMP     NUMLP
 380         TAD     (215
 381         DCA     7
 382         JMS     TYPE
 383         CLA CLL CMA RTL
 384         JMS     TYPE
 385         TAD     CKIO    /GET THE FATAL ERROR FLAG
 386         SNA CLA         /WHADDOWEDO??
 387         JMP     EXITX
 388         RETRN   ERROR   /HE SAYS ITS NON-FATAL - LET HIM HANDLE IT
 389
 390 ERTTY,  0       /DIGIT PRINTING ROUTINE
 391         RAL
 392         AND     LIT7
 393         TAD     E60
 394         JMS     PR6BIT
 395         JMP I   ERTTY
 396
 397 PR6BIT, 0               /6BIT TO 8BIT CONVERTOR
 398         AND     (77
 399         SNA
 400         JMP     PRLOC   /MESSAGE OVER
 401         TAD     (7740
 402         SPA
 403         TAD     (100
 404         TAD     (240
 405         CALL    0,GENIO /LOOK FOR ^C WHILE TYPING
 406         JMP I   PR6BIT
 407
 408 /
 409 /EXIT TO DISK MONITOR SYSTEM
 410 /
 411 EXIT,   BLOCK   1
 412         10
 413 EXITX,  CALL    0,CKIO
 414         6203
 415         JMPI    U7600   /RETURN TO MONITOR
 416
 417 CKIO,   0
 418 TEM2,   10      /DUMMY SUBROUTINE TO WAIT FOR I/O COMPLETE
 419 CKWAIT, 6041
 420         JMP     CKWAIT
 421         RETRN   CKIO
 422
 423 CDRGCH, 0       /GET A CHAR FROM A PACKED TABLE
 424         DCA     TEM2    /WORD PTR IN AC, LEFT/RIGHT SW IN LINK
 425         TADI    TEM2    /PRESERVE ENTRY FIELD
 426         SZL
 427         JMP     CDRAND  /RIGHT HALF
 428         RTR
 429         RTR
 430         RTR
 431 CDRAND, AND     CDR77
 432         JMP I CDRGCH    /RESTORE CURRENT FIELD AND GET OUT
 433 CDR77,  77
 434
 435         END
 436 \f